(sentence-end-double-space . t)
(fill-column . 70)))
(c-mode . ((c-file-style . "GNU")))
+ (objc-mode . ((c-file-style . "GNU")))
;; You must set bugtracker_debbugs_url in your bazaar.conf for this to work.
;; See admin/notes/bugtracker.
(log-edit-mode . ((log-edit-rewrite-fixes
- "[ \n](bug#\\([0-9]+\\))" . "debbugs:\\1")))
+ "[ \n](bug#\\([0-9]+\\))" . "debbugs:\\1")
+ (log-edit-font-lock-gnu-style . t)))
(change-log-mode . ((add-log-time-zone-rule . t)
(fill-column . 74)
(bug-reference-url-format . "http://debbugs.gnu.org/%s")
(2) how to write a useful bug report and what information it needs to have.
You can read the Bugs section of the manual from inside Emacs.
-Start Emacs, do C-h i to enter Info, then m Emacs RET to get to the
-Emacs manual, then m Bugs RET to get to the section on bugs.
-Or you can use the standalone Info program in a like manner.
+Start Emacs, and press
+ C-h r (to view the Emacs manual)
+ m Bugs RET (to go to the section on Bugs)
+Or you can use the standalone Info program:
+ info emacs
+ m Bugs RET
(Standalone Info is part of the Texinfo distribution, not part of the
Emacs distribution.)
If necessary, you can read the manual without an info program:
- cat info/emacs* | more "+/^File: emacs, Node: Bugs,"
+ cat info/emacs* | more "+/^File: emacs.*, Node: Bugs,"
Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-27 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.2 released.
+ Check more robustly for timer_settime.
+ This should fix an OS X build problem reported by Ivan Andrus in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00671.html>.
+ * configure.ac (gl_THREADLIB): Define to empty, since Emacs
+ does threads its own way.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
-2012-08-14 Ulrich Mueller <ulm@gentoo.org>
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
- * lib/gnulib.mk:
- * lib/stdio.in.h:
- * m4/stdio_h.m4: Do not assume that gets is defined (Bug#11873).
+ * Makefile.in (bootstrap): Set MAKEFILE_NAME when building Makefile,
+ to avoid problems with recursion when using GNU make.
+
+2012-09-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (bootstrap): Simplify build procedure.
+ Suggested by Wolfgang Jenker in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00456.html>.
+
+ Merge from gnulib, incorporating:
+ 2012-09-22 sockets, sys_stat: remove AC_C_INLINE in MSVC-only cases
+
+2012-09-19 Tassilo Horn <tsdh@gnu.org>
+
+ * doc/emacs/misc.texi (DocView Slicing): Document new slice from
+ BoundingBox feature.
+
+2012-09-18 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac (HAVE_GTK): Mention if we use GTK2 or GTK3.
+
+2012-09-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * Makefile.in (bootstrap): Revert last change. Run config.status
+ after config.status --recheck, run configure from $(srcdir).
+ (config.status): Run configure from $(srcdir).
+
+2012-09-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in: Fix build error on FreeBSD.
+ ($(MAKEFILE_NAME)): Pass MAKE='$(MAKE)' to config.status's env.
+ Suggested by Wolfgang Jenker in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00430.html>.
+ (MAKE_CONFIG_STATUS): Remove. Remaining use expanded.
+ This undoes part of the 2012-09-10 patch.
+ (bootstrap): Run ./configure, rather than trying to run config.status
+ if it exists. That builds src/epaths.h more reliably.
+ Run autogen/copy_autogen if autogen.sh fails,
+ to create 'configure'; problem reported by Andreas Schwab in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00438.html>.
+ * autogen.sh: Exit with status 1 when failing due to missing tools,
+ reverting the 2012-09-10 change to this file.
+ * autogen/copy_autogen: Fail if one of the subsidiary actions fail.
+ Use 'cp -f' for the build-aux files, since the destinations are
+ typically read-only.
+
+ Remove no-longer-needed Solaris 2.4 vfork bug workaround.
+ * configure.ac (ac_cv_func_vfork_works): Default to 'no' on
+ Solaris 2.4, so that AC_FUNC_VFORK doesn't think vfork works.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (copyright): New output variable.
+ (COPYRIGHT): New AC_DEFINE.
+
+2012-09-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove configure's --without-sync-input option (Bug#12450).
+ * configure.ac (SYNC_INPUT, BROKEN_SA_RESTART): Remove.
+
+2012-09-16 Glenn Morris <rgm@gnu.org>
+
+ Increase compartmentalization of Nextstep builds rules,
+ and store Emacs version number in fewer versioned files.
+ * configure.ac (ns_appsrc): Use relative names.
+ (ns_frag): Remove.
+ (Info-gnustep.plist, Emacs.desktop, Info.plist, InfoPlist.strings)
+ (nextstep/Makefile): Generate these nextstep files.
+ (SUBDIR_MAKEFILES): Add nextstep.
+ * Makefile.in (clean, distclean, bootstrap-clean): Add nextstep.
+ * make-dist (nextstep/templates): Add directory.
+ (nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj): Remove.
+ (nextstep/Cocoa/Emacs.base/Contents)
+ (nextstep, nextstep/GNUstep/Emacs.base/Resources): Update contents.
+
+2012-09-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port better to POSIX hosts lacking _setjmp (Bug#12446).
+ * configure.ac (HAVE__SETJMP, HAVE_SIGSETJMP): New symbols.
+ (_setjmp, _longjmp): Remove.
+
+2012-09-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (--without-sync-input): Fix typo in usage message.
+
+ * configure.ac: Port to hosts lacking gtk.
+ (PKG_CHECK_MODULES): Capture pkg-config diagnostics
+ better, in particular, problems in invoking pkg-config itself.
+ This is useful on hosts that don't have pkg-config.
+ (GTK_MODULES): Do not exit 'configure' simply because gtk3
+ and gtk2 are both missing. Problem found on Solaris 8.
+
+2012-09-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac: Reorder Xaw3d messages.
+ Report Gtk+ 3 as GTK.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify SIGIO usage (Bug#12408).
+ * configure.ac (NO_TERMIO, BROKEN_FIONREAD, BROKEN_SIGAIO)
+ (BROKEN_SIGPOLL, BROKEN_SIGPTY): Remove.
+ (USABLE_FIONREAD, USABLE_SIGIO): New symbols. All uses of
+ 'defined SIGIO' replaced with 'defined USABLE_SIGIO', with no need
+ to #undef SIGIO now (which was error-prone). Likewise, all uses
+ of 'defined FIONREAD' replaced with 'defined USABLE_FIONREAD'.
+
+2012-09-12 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac: No --with-x-toolkit given: Try gtk3 toolkit first
+ and then gtk2 if not found.
+ --with-x-toolkit=gtk|yes: As above, but fail if gtk2 or gt3 not found.
+ --with-x-toolkit=gtk2: Only try gtk2, fail if not found.
+ --with-x-toolkit=gtk3: Only try gtk3, fail if not found.
+
+2012-09-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-dep, install-arch-indep, install-doc):
+ Be more explicit about dependencies, for parallel `make install'.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ * configure.ac (logb, cbrt): Do not check for these functions,
+ as they are not being used.
+
+2012-09-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve robustness of 'make bootstrap' (Bug#12376).
+ Run autogen.sh after bootstrap-clean, to avoid bzr pull issues.
+ * INSTALL, README: Document autogen.sh.
+ * Makefile.in (Makefile): Mark it as precious, since it's updated
+ atomically.
+ (MAKE_CONFIG_STATUS): New macro.
+ (config.status, bootstrap): Use it. This causes 'make bootstrap'
+ to run config.status with the --recheck option, which is more
+ appropriate for a bootstrap.
+ (bootstrap): Run autogen.sh right after cleaning. Don't worry
+ about failures due to missing tools.
+ * autogen.sh: Exit with status 101 when failing due to missing tools.
+ * make-dist: Distribute autogen.sh.
+
+2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later for math functions (Bug#12381).
+ * configure.ac (frexp, fmod): Remove checks for these functions,
+ as we now assume them.
+ (FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC, NO_MATHERR)
+ (HAVE_EXCEPTION):
+ Remove; no longer needed.
+
+2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ More signal-handler cleanup (Bug#12327).
+ * configure.ac (FLOAT_CHECK_DOMAIN): Comment fix (Bug#12327).
+
+2012-09-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Signal-handler cleanup (Bug#12327).
+ * configure.ac (PTY_OPEN, PTY_TTY_NAME_SPRINTF):
+ Adjust to syssignal.h changes.
+ (SIGNAL_H_AB): Remove; no longer needed.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify redefinition of 'abort' (Bug#12316).
+ * configure.ac (NO_ABRT): Remove.
+
+ * configure.ac (_setjmp, _longjmp): Check by compiling
+ instead of by guessing. The guesses were wrong for
+ recent versions of Solaris, such as Solaris 11.
+
+2012-09-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (WARN_CFLAGS): Omit -Wjump-misses-init.
+ It generates false alarms in doc.c, regex.c, xdisp.c. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00040.html>.
+
+ Merge from gnulib, incorporating:
+ 2012-08-29 stdbool: be more compatible with mixed C/C++ compiles
+ 2011-11-30 manywarnings: update the list of "all" warnings
+
+2012-09-02 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac (HAVE_GOBJECT): Check for gobject-2.0 (Bug#12332).
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (_FORTIFY_SOURCE): Define only when optimizing.
+ This ports to glibc 2.15 or later, when configured with
+ --enable-gcc-warnings. See Eric Blake in
+ <http://lists.gnu.org/archive/html/bug-grep/2012-09/msg00000.html>.
+
+2012-09-01 Daniel Colascione <dan.colascione@gmail.com>
+
+ * configure.ac: Introduce term_header variable, which holds the
+ value which will become TERM_HEADER in code. We effect our choice
+ of window system by setting term_header and WINDOW_SYSTEM_OBJ
+ instead of using ad-hoc variables and flags for each window
+ system.
+
+2012-08-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (CFLAGS): Prefer -g3 to -g if -g3 works
+ and if the user has not specified CFLAGS. -g3 simplifies
+ debugging, since it makes macros visible to the debugger.
+
+2012-08-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * lib/makefile.w32-in ($(BLD)/execinfo.$(O)): Update dependencies.
+
+2012-08-25 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in ($(BLD)/execinfo.$(O), execinfo.h): New targets.
+ (GNULIBOBJS): Add $(BLD)/execinfo.$(O).
+
+2012-08-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ On assertion failure, print backtrace if available.
+ Merge from gnulib, incorporating:
+ 2012-08-24 execinfo: port to FreeBSD
+ 2012-08-22 execinfo: new module
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+ * lib/execinfo.c, lib/execinfo.in.h, m4/execinfo.m4: New files.
+
+2012-08-22 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-dep): If NO_BIN_LINK is non-null,
+ do not create the bin/emacs link. (Bug#12011)
+
+2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-08-20 extern-inline: support old GCC 'inline'
+
+2012-08-20 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (AC_PROG_LN_S): Test for ln.
+ * Makefile.in (LN_S): New, set by configure.
+ (install-arch-dep): Use $LN_S.
+
+2012-08-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-08-19 ignore-value, stat-time, timespec: omit AC_C_INLINE
+ 2012-08-19 mktime, sys_select: avoid 'static inline'
+ 2012-08-19 gnulib-tool: Fix indentation.
+
+2012-08-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/sigprocmask.c, m4/signalblocking.m4: Remove.
+ These files have been unused since the 2012-06-22 patch that
+ introduced high-resolution time stamps.
+
+2012-08-17 Jan Beich <jbeich@tormail.org> (tiny change)
+
+ * configure.ac (PTY_OPEN): Try posix_openpt on gnu-linux,
+ gnu-kfreebsd, freebsd, and netbsd. (Bug#12040)
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-08-05 extern-inline: also ignore -Wmissing-declarations
+
+2012-08-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * 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 <rgm@gnu.org>
+
+ * configure.ac (DIRECTORY_SEP): Move here from src/lisp.h.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.ac (--disable-features): Rename to --without-all.
+ (OPTION_DEFAULT_ON): Change to use with_features.
+ * INSTALL: Fix description.
+
+2012-08-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.ac: New option --disable-features.
+ (OPTION_DEFAULT_ON): Change to use enable_features.
+ * INSTALL: Explain --disable-features.
+
+2012-08-07 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac: Require automake 1.11 (fairly arbitrarily).
+ * autogen.sh (automake_min): Get it from configure.ac.
+
+2012-08-06 Glenn Morris <rgm@gnu.org>
+
+ * 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 <michael.albinus@gmx.de>
+
+ * INSTALL: Explain how to completely disable D-Bus. (Bug#12112)
+
+2012-08-05 Ulrich Müller <ulm@gentoo.org>
+
+ * configure.ac: Disable paxctl if binaries don't have a
+ PT_PAX_FLAGS program header. (Bug#11979)
+
+2012-08-03 Eli Zaretskii <eliz@gnu.org>
+
+ * 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 <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-08-02 stat-time, timespec, u64: support naive out-of-dir builds
+
+2012-08-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * lib/Makefile.am (DEFAULT_INCLUDES): Add -I$(top_srcdir)/lib for
+ out-of-tree build.
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: Remove src/s.
+
+ * lib/makefile.w32-in (MS_W32_H): Update for new ms-w32.h location.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ 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 <rgm@gnu.org>
+
+ * configure.ac (DOS_NT, MSDOS): New system type templates.
+
+2012-08-01 Ulrich Müller <ulm@gentoo.org>
+
+ * configure.ac (LIB_STANDARD, START_FILES) [FreeBSD]:
+ Don't include crtbegin.o and crtend.o. (Bug#12047)
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC)
+ (INTERNAL_TERMINAL): New.
+
+ * configure.ac (DEVICE_SEP, IS_DEVICE_SEP, IS_DIRECTORY_SEP)
+ (IS_ANY_SEP): Move here from src/lisp.h.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * lib/makefile.w32-in (CONFIG_H): Update dependencies.
+ (CONF_POST_H): New macro.
+
+2012-07-31 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (S_FILE): Remove output variable.
+
+ * configure.ac (opsysfile): Use AH_TEMPLATE. Doc fix.
+
+ * configure.ac (NULL_DEVICE, SEPCHAR, USER_FULL_NAME):
+ Move here from src.
+
+ * configure.ac (AMPERSAND_FULL_NAME, subprocesses):
+ Move here from conf_post.h.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Improve OpenMotif detection on GNU/Linux systems.
+ * configure.ac (MOTIF): Check for /usr/include/openmotif
+ and /usr/(lib|lib64)/openmotif if --with-x-toolkit=motif.
+
+2012-07-31 Andreas Schwab <schwab@linux-m68k.org>
+
+ * Makefile.in (install-arch-indep): Avoid eval.
+
+2012-07-31 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (opsysfile, S_FILE): Now they are always empty.
+
+ * configure.ac (opsysfile): Forgot to set it to empty on sol2-10
+ when removing src/s/sol2-6.h yesterday.
+
+ * configure.ac (USG5_4): Reintroduce this.
+ (opsysfile): Set to empty on irix6-5, sol2*, and unixware.
+
+ * configure.ac (wait3, WRETCODE): Move here from src/s/usg5-4-common.h.
+
+ * configure.ac (opsysfile): Set to empty on hpux*, darwin;
+ and to s/usg5-4-common.h on irix6-5.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (AH_BOTTOM): Use an include file, so that the
+ contents do not get processed by autoheader.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not overwrite config.status while executing it (Bug#11214).
+ * Makefile.in (MAKEFILE_NAME): New macro.
+ ($(MAKEFILE_NAME)): Rename rule from Makefile.
+ * configure.ac (epaths): Set MAKEFILE_NAME to a bogus value,
+ so that GNU 'make' isn't tempted to make the Makefile and then
+ regenerate config.status while config.status is running.
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, ${SUBDIR}, blessmail, epath-force,
+ FRC, install-arch-dep, install-arch-indep, install-doc,
+ install-info, install-man, install-etc, install-strip, uninstall,
+ bootstrap-clean, TAGS, tags, info-real, force-info, check-info-dir.
+ (.RECURSIVE): Remove; hasn't been needed for years.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (SIGNAL_H_AHB): New hack macro.
+ (opsysfile): Set to empty on netbsd, openbsd.
+ (AH_BOTTOM): Include signal.h if SIGNAL_H_AHB is defined.
+
+ * configure.ac (_longjmp, _setjmp, TIOCSIGSEND): Move here from src/s.
+
+2012-07-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * Makefile.in (install-arch-indep): Remove sh -x.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (opsysfile): Tweak message for null case.
+
+ * configure.ac (opsysfile): Set to empty on aix4-2, freebsd,
+ gnu-linux, gnu-kfreebsd; and to usg5-4-common.h on sol2*, unixware.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ * doc/misc/texinfo.tex: Update to 2012-07-29.17 version.
+
+2012-07-29 Jan Djärv <jan.h.d@swipnet.se>
+
+ * Makefile.in (install-arch-indep): Handle space in locallisppath.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib environ module (Bug#9772).
+ * m4/environ.m4: New file, from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+ Use Gnulib stdalign module (Bug#9772, Bug#9960).
+ This should improve portability of macros like alignof and DECL_ALIGN.
+ * lib/stdalign.in.h, m4/stdalign.m4: New files, from gnulib.
+ * .bzrignore: Add lib/stdalign.h.
+ * config.bat: Do not set NO_DECL_ALIGN; no longer needed.
+ Copy lib/stdalign.in.h to lib/stdalign.in-h as needed.
+ * configure.ac (HAVE_ATTRIBUTE_ALIGNED): Remove the code that
+ fiddles with this, as gnulib now does this for us.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix toolkit configuration report.
+ * configure.ac (USE_X_TOOLKIT): Report toolkit as GTK3 if
+ --with-x-toolkit=gtk3 is used.
+
+2012-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix regression with pthread_sigmask on FreeBSD (Bug#11884).
+ * configure.ac: Configure gnulib at the end, not before running
+ pkg-config. This restores the behavior before 2012-06-22, when
+ higher-resolution time stamps were added, and fixes a bug whereby
+ LIB_PTHREAD was not used and gnulib's part of 'configure'
+ therefore incorrectly assumed that pthread_sigmask wasn't working.
+ Fix the problem with -lrt and clock_gettime a different way.
+ This should complete the fix for Bug#11884.
+ (pre_PKG_CONFIG_CFLAGS, pre_PKG_CONFIG_LIBS): New shell vars.
+
+2012-07-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-07-15 pthread_sigmask: fix bug on FreeBSD 9 (Bug#11884)
+ 2012-07-11 gettext: do not assume '#define ... defined ...' behavior
+
+2012-07-14 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (GC_SETJMP_WORKS, GC_MARK_STACK): Move here from src/s.
+ (AH_BOTTOM): Move GC_SETJMP_WORKS GCC fallback to main body.
+
+2012-07-13 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (opsysfile): Set to empty on gnu, cygwin.
+
+ * configure.ac (BSD4_2, BSD_SYSTEM, USG, USG5, _AIX, CYGWIN)
+ (DARWIN_OS, GNU_LINUX, HPUX, IRIX6_5, SOLARIS2):
+ Move "system type" macros here from src/s.
+ (BSD_SYSTEM_AHB): New hack macro.
+ (AH_BOTTOM): Set BSD_SYSTEM, using BSD_SYSTEM_AHB.
+
+ * configure.ac (NSIG_MINIMUM, ULIMIT_BREAK_VALUE, SETUP_SLAVE_PTY)
+ (GC_MARK_SECONDARY_STACK): Move here from src/s.
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (AH_BOTTOM) [DARWIN_OS]: Move SYSTEM_PURESIZE_EXTRA
+ setting here from src/s/darwin.h.
+
+ * configure.ac (NO_MATHERR): Unconditionally define for Darwin;
+ as src/s/darwin.h used to.
+
+ * configure.ac (NARROWPROTO, NO_ABORT, BROKEN_GET_CURRENT_DIR_NAME)
+ (BROKEN_FIONREAD, BROKEN_PTY_READ_AFTER_EAGAIN, BROKEN_SIGAIO)
+ (BROKEN_SIGPOLL, BROKEN_SIGPTY, FIRST_PTY_LETTER, NO_EDITRES)
+ (G_SLICE_ALWAYS_MALLOC, PREFER_VSUSP, PTY_ITERATION, PTY_OPEN)
+ (PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF, RUN_TIME_REMAP)
+ (SETPGRP_RELEASES_CTTY, TAB3, TABDLY, RUN_TIME_REMAP, UNIX98_PTYS)
+ (XOS_NEEDS_TIME_H): Move here from src/s.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (INTERRUPT_INPUT): Move here from src/s.
+ (HAVE_PTYS, HAVE_SOCKETS): Define unconditionally.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (tzset): Remove check that's redundant with gnulib.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (CLASH_DETECTION): Define unconditionally.
+
+ * configure.ac (opsysfile): Use bsd-common on gnu systems.
+
+ * configure.ac (GNU_LIBRARY_PENDING_OUTPUT_COUNT):
+ (SIGNALS_VIA_CHARACTERS): Move here from src/s.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume mkdir, rename, rmdir, strerror.
+ * configure.ac (mkdir, rename, rmdir, strerror): Remove check.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (DONT_REOPEN_PTY): Move here from src/s.
+
+ * configure.ac (DEFAULT_SOUND_DEVICE): New definition.
+
+2012-07-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove "#define unix" that is no longer needed (Bug#11905).
+ Merge from gnulib to make "#define unix" unnecessary, incorporating:
+ 2012-07-10 getloadavg: clean out old Emacs and Autoconf cruft
+ 2012-07-09 getopt: Simplify after Emacs changed.
+
+2012-07-10 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (DATA_START, DATA_SEG_BITS, PENDING_OUTPUT_COUNT):
+ Move here from src/s.
+
+2012-07-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.ac (PNG_DEPSTRUCT): Define this instead of
+ PNG_DEPRECATED.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Add GCC-style 'const' attribute to functions that can use it.
+ * configure.ac (WARN_CFLAGS): Add -Wsuggest-attribute=const.
+ (ATTRIBUTE_CONST): New macro, in config.h.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * lib/makefile.w32-in: Rework dependencies.
+ (GNU_LIB, NT_INC, C_CTYPE_H, MS_W32_H, CONFIG_H, FILEMODE_H)
+ (FTOASTR_H, FTOASTR_C, GETOPT_INT_H, MD5_H, SHA1_H, SHA256_H)
+ (U64_H, SHA512_H): New macros.
+ (SRC): Redefine to point to src/, not current directory.
+ ($(BLD)/c-ctype.$(O), $(BLD)/c-strcasecmp.$(O))
+ ($(BLD)/c-strncasecmp.$(O), $(BLD)/dtoastr.$(O))
+ ($(BLD)/dtotimespec.$(O), $(BLD)/getopt.$(O), $(BLD)/getopt1.$(O))
+ ($(BLD)/gettime.$(O), $(BLD)/strftime.$(O), $(BLD)/time_r.$(O))
+ ($(BLD)/timespec-add.$(O), $(BLD)/timespec-sub.$(O), $(BLD)/md5.$(O))
+ ($(BLD)/sha1.$(O), $(BLD)/sha256.$(O), $(BLD)/sha512.$(O))
+ ($(BLD)/filemode.$(O)): Update dependencies.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, incorporating:
+ 2012-07-09 timespec: mark functions with const attributes
+
+ Rename configure.in to configure.ac (Bug#11603).
+ The name 'configure.in' has been obsolescent for quite some time,
+ and the next release of Autoconf will generate warnings for it.
+ See commit 'v2.69-4-g560f16b' of 2012-05-06, "general: deprecate
+ 'configure.in' as autoconf input" in the Autoconf git repository.
+ * configure.ac: Rename from configure.in.
+ * INSTALL, INSTALL.BZR, README, make-dist:
+ * Makefile.in (AUTOCONF_INPUTS):
+ * autogen.sh (autoconf_min):
+ * autogen/update_autogen (sources):
+ Adjust to reflect new name.
+
+2012-07-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Restore deprecation warnings, except for older libpng.
+ * configure.in (WARN_CFLAGS): Remove -Wno-deprecated-declarations.
+ (HAVE_LIBPNG_PNG_H): Don't bother checking for this if we have png.h.
+ (PNG_DEPRECATED): Define when compiling with older PNG versions.
+
+2012-07-07 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.in (WARN_CFLAGS): Add -Wno-deprecated-declarations.
+
+2012-07-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve static checking when configured --with-ns.
+ See Samuel Bronson's remarks in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00146.html>.
+ * configure.in (WARN_CFLAGS): Omit -Wunreachable-code, as it's
+ a no-op with recent GCC and harmful in earlier ones.
+ Omit -Wsync-nand, as it's irrelevant to Emacs and provokes a
+ warning when compiling with ObjC. Always omit
+ -Wunsafe-loop-optimizations, as we don't mind when optimization is
+ being done correctly.
+
+2012-07-07 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (BROKEN_SA_RESTART): Doc fix.
+
+ * configure.in: Rather than checking for things then undef'ing
+ them on some platforms, simply don't check for them.
+ (getwd): Don't check for it on unixware.
+ (random, rint): Don't check for these on hpux.
+ (res_init, libresolv): Don't check for these on darwin.
+
+2012-07-07 Juanma Barranquero <lekktu@gmail.com>
-2012-06-21 Ulrich Mueller <ulm@gentoo.org>
+ * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/c-ctype.$(O),
+ $(BLD)/c-strcasecmp.$(O) and $(BLD)/c-strncasecmp.$(O).
+ ($(BLD)/c-ctype.$(O), $(BLD)/c-strcasecmp.$(O))
+ ($(BLD)/c-strncasecmp.$(O)): New dependencies.
- * configure.in: Use m/intel386.h for amd64 with x32 ABI. (Bug#11669)
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
-2012-06-01 Chong Yidong <cyd@gnu.org>
+ * configure.in: Document --enable-gcc-warnings better.
- * Version 24.1 released.
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ This is safer than strcasecmp, which has unspecified behavior
+ outside the POSIX locale and in practice sometimes does not work
+ in multibyte locales. Similarly for c_strncasecmp and strncasecmp.
+ * configure.in (strcasecmp, strncasecmp): Remove checks.
+
+ * lib/c-ctype.c, lib/c-ctype.h, lib/c-strcase.h, lib/c-strcasecmp.c:
+ * lib/c-strncasecmp.c: New files, taken from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+ Merge from gnulib, incorporating:
+ 2012-07-06 timespec-sub: avoid duplicate include
+ Reported by Juanma Barranquero.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * make-dist [update]: Let autoreconf figure out what needs updating.
+ Use `make info-real'. leim/leim-list.el should always exist.
+ Check cd return value.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib. This is for OpenBSD 5.1 amd64.
+ * m4/sys_time_h.m4: New version from gnulib, incorporating:
+ 2012-07-05 sys_time: allow too-wide tv_sec
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib.
+ * lib/alloca.in.h: New version from gnulib, incorporating:
+ 2012-07-03 alloca: add support for HP NonStop TNS/E native
+
+2012-07-04 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in: If --enable-gcc-warnings, disable
+ -Wunsafe-loop-optimizations for -O1 optimization level.
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (standardlisppath): New output variable.
+ (lisppath): Use standardlisppath.
+ * Makefile.in (standardlisppath): New, set by configure.
+ (epaths-force): Use standardlisppath and locallisppath rather than
+ lisppath.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in: Fix previous change. Remove --enable-asserts.
+ (CPPFLAGS): Remove conditional -DXASSERTS=1.
+ Add --enable-link-time-optimization.
+ * INSTALL: Mention this.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in: Add glyphs category to --enable-checking option.
+ (GLYPH_DEBUG): Define if glyphs debugging is enabled.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in (ENABLE_CHECKING): Update comment.
+
+2012-06-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in: Don't check for sys/select.h, sys/time.h, utime.h.
+ Emacs proper no longer uses these headers, and can rely on Gnulib
+ for these checks.
+
+ Merge from gnulib.
+ * m4/getopt.m4: Copy new version from gnulib, incorporating:
+ getopt-posix: No longer guarantee that option processing is resettable.
+
+2012-06-27 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Only check for paxctl on gnu-linux. (Bug#11398#26)
+
+ * INSTALL: Remove references to paths.el.
+
+2012-06-26 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in ($(GNULIBOBJS)): Depend on stamp_BLD. This
+ replaces separate dependency for each object file, which required
+ the same object file to be mentioned twice, causing failures in
+ parallel builds.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * lib/makefile.w32-in (LOCAL_FLAGS): Remove -DHAVE_CONFIG_H.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in (AC_CHECK_FUNCS): Detect library functions
+ strcasecmp and strncasecmp.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ We might as well use the spelling standardized by C11,
+ as in the long run that should simplify maintenance.
+ * configure.in (NO_RETURN): Remove. All uses replaced by _Noreturn.
+
+2012-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ * lib/makefile.w32-in ($(BLD)/dtotimespec.$(O)):
+ ($(BLD)/timespec-add.$(O)):
+ ($(BLD)/timespec-sub.$(O)): Don't depend on
+ $(EMACS_ROOT)/nt/inc/sys/time.h.
+
+ * lib/stat-time.h:
+ * lib/timespec.h:
+ * lib/utimens.h: Revert last change.
+
+2012-06-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib.
+ * m4/getopt.m4: Copy new version from gnulib, incorporating:
+ getopt-gnu: Handle suboptimal getopt_long's abbreviation handling.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build broken by 2012-06-22T21:17:42Z!eggert@cs.ucla.edu.
+ * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/dtotimespec.$(O),
+ $(BLD)/gettime.$(O), $(BLD)/timespec-add.$(O), and
+ $(BLD)/timespec-sub.$(O).
+ ($(BLD)/dtotimespec.$(O)):
+ ($(BLD)/gettime.$(O)):
+ ($(BLD)/timespec-add.$(O)):
+ ($(BLD)/timespec-sub.$(O)): New dependencies.
+
+ * lib/stat-time.h:
+ * lib/timespec.h:
+ * lib/utimens.h: Include sys/time.h.
+
+2012-06-23 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.in: Don't use AC_CHECK_FUNCS_ONCE, which doesn't use
+ the correct CFLAGS and LIBS.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * configure.in (gl_ASSERT_NO_GNULIB_POSIXCHECK)
+ (gl_ASSERT_NO_GNULIB_TESTS, gl_INIT): Move these up earlier, so
+ that the new clock stuff doesn't clash with RSVG_LIBS.
+ (AC_CHECK_HEADERS): Don't check for sys/select.h, sys/time.h, utime.h,
+ as gnulib does that for us now.
+ (emacs_cv_struct_utimbuf, HAVE_STRUCT_UTIMBUF, HAVE_TIMEVAL)
+ (GETTIMEOFDAY_ONE_ARGUMENT): Remove; gnulib does these now.
+ (AC_CHECK_FUNCS): Remove utimes; no longer needed.
+ * lib/dtotimespec.c, lib/gettime.c, lib/gettimeofday.c, lib/pselect.c:
+ * lib/stat-time.h, lib/sys_select.in.h, lib/sys_time.in.h:
+ * lib/timespec-add.c, lib/timespec-sub.c, lib/timespec.h:
+ * lib/utimens.c, lib/utimens.h, m4/clock_time.m4, m4/gettime.m4:
+ * m4/gettimeofday.m4, m4/pselect.m4, m4/stat-time.m4:
+ * m4/sys_select_h.m4, m4/sys_socket_h.m4, m4/sys_time_h.m4:
+ * m4/timespec.m4, m4/utimbuf.m4, m4/utimens.m4, m4/utimes.m4:
+ New files, copied automatically from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Merge from gnulib.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib.
+ * lib/filemode.h, lib/signal.in.h, lib/stat.c, lib/stdint.in.h:
+ * lib/stdlib.in.h, lib/unistd.in.h, m4/extensions.m4, m4/getloadavg.m4:
+ * m4/getopt.m4, m4/gnulib-common.m4, m4/largefile.m4, m4/mktime.m4:
+ * m4/multiarch.m4, m4/nocrash.m4, m4/stdio_h.m4, m4/time_r.m4:
+ Copy new versions from gnulib, incorporating the following changes:
+ 2012-06-22 time_r: fix typo that always overrode localtime_r decl
+ 2012-06-22 Write "Mac OS X" instead of "MacOS X".
+ 2012-06-21 mktime: fix integer overflow in 'configure'-time test
+ 2012-06-21 nonblocking: Avoid compilation error on mingw64.
+ 2012-06-19 stat, fstat: Avoid warnings on mingw64.
+ 2012-06-19 getopt-gnu: Fix exit code overflow in autoconf test.
+
+2012-06-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * configure.in: Rename --enable-use-lisp-union-type to
+ --enable-check-lisp-object-type and define CHECK_LISP_OBJECT_TYPE
+ instead of USE_LISP_UNION_TYPE.
+
+2012-06-12 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (HAVE_PROCFS, _STRUCTURED_PROC): New AC_DEFINEs.
+ (opsysfile): Set specially for sol2-10.
+
+ * configure.in (BROKEN_SA_RESTART, USG_SUBTTY_WORKS):
+ New AC_DEFINEs, for hpux11.
+ (opsysfile): Set specially for hpux11.
+
+2012-06-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in: Coalesce some function checking.
+ This makes 'configure' a bit smaller.
+ Prefer AC_CHECK_FUNCS_ONCE for functions that we always check for.
+
+2012-06-12 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (opsysfile): Set specially for gnu-kfreebsd, openbsd.
+
+ * configure.in (NO_TERMIO, BROKEN_SIGIO): Move here from src/s.
+
+ * configure.in: Anticipate platforms with no src/s file.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * configure.in: Check for MagickMergeImageLayers (Bug#11678).
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (SYSTEM_TYPE): New AC_DEFINE.
+
+2012-06-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * configure.in (dbus_type_is_valid): Check for library function.
+
+2012-06-06 Glenn Morris <rgm@gnu.org>
+
+ * INSTALL, make-dist: Remove vcdiff.
+
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * INSTALL, make-dist: Remove rcs-checkin.
+
+2012-06-03 Ulrich Müller <ulm@gentoo.org>
+
+ * configure.in (PAXCTL): Check for paxctl. (Bug#11398)
+
+2012-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove --disable-maintainer-mode option from 'configure'. (Bug#11555)
+ It is confusingly named and rarely useful. See, for example,
+ <http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00089.html>.
+ * INSTALL.BZR: Don't mention --disable-maintainer-mode.
+ * Makefile.in (MAINTAINER_MODE_FLAG): Remove; all uses removed.
+ * configure.in: Remove --disable-maintainer-mode.
+ (USE_MAINTAINER_MODE, MAINT): Remove.
+
+2012-05-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make 'configure' a bit smaller and faster.
+ * configure.in (INSTALL_INFO): Set it with one call to
+ AC_PATH_PROG, not three.
+ (PKG_CONFIG): Hoist this out of PKG_CHECK_MODULES, since it's
+ so likely that it'll be needed.
+ (AC_CHECK_HEADERS_ONCE): Prefer to AC_CHECK_HEADERS where either works.
+ (AC_PROG_MAKE_SET): Remove; Automake does this.
+ (sysinfo): Do not check for this function, as it's never used.
+ (tzset): Check for this function just once.
+ * m4/manywarnings.m4: Sync from gnulib, incorporating the following:
+ 2012-05-27 manywarnings: remove duplicate -Wmultichar entry
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * config.bat (lib): Create/update lib/stdalign.in-h and
+ lib/sys_types.in-h.
+
+ * lib/makefile.w32-in ($(BLD)/md5.$(O)):
+ ($(BLD)/sha1.$(O)):
+ ($(BLD)/sha256.$(O)):
+ ($(BLD)/sha512.$(O)): Depend on $(EMACS_ROOT)/nt/inc/stdalign.h.
+ Suggested by Christoph Scholtes <cschol2112@googlemail.com>.
+
+ * lib/getopt_.h: Regenerate.
+
+2012-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume gnulib does largefile.
+ Gnulib does the largefile configuration anyway, so when configure.in
+ invokes AC_SYS_LARGEFILE, that bloats 'configure' unnecessarily.
+ * configure.in (AC_SYS_LARGEFILE): Remove.
+ * lib/gnulib.mk: Autoupdate.
+
+2012-05-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib. (Bug#11527)
+
+ The build procedure now creates <stdalign.h> and <sys/types.h> for
+ older hosts that lack a working <stdalign.h> or whose
+ <sys/types.h> does not define pid_t, size_t, ssize_t, mode_t. New
+ symbols such as WINDOWS_64_BIT_OFF_T may require attention in the
+ msdos and nt builds.
+
+ Here is a precis of gnulib changes that seem relevant; please see
+ the gnulib ChangeLog for details.
+
+ 2012-05-18 crypto: fix bug in large buffer handling
+ 2012-05-14 ignore-value.h: remove unused _GL_ATTRIBUTE_DEPRECATED
+ 2012-05-10 _Noreturn: port config.h to gcc -Wundef
+ 2012-05-08 warnings.m4: give a means to specify the program to compile
+ 2012-05-07 stdint: be more consistent with glibc, SunOS libc
+ 2012-04-21 Large File Support for native Windows platforms.
+ 2012-04-14 stat: Bypass buggy override in mingw64.
+ 2012-03-29 stdio: don't assume gets any more
+ 2012-03-24 Enable common subexpression optimization in GCC.
+ 2012-02-09 maint: replace FSF snail-mail addresses with URLs
+ 2012-01-30 sys_stat: Fix support for mingw64 and MSVC.
+ 2012-01-28 strtoimax: eliminate need for stdint.h, inttypes.h checks
+ 2012-01-21 stdint: Add support for Android.
+ 2012-01-15 Improve support for MSVC 9.
+ 2012-01-08 mktime: Avoid compilation error on Solaris 11.
+ 2012-01-05 Use ', not `, for quoting output.
+ 2012-01-05 strtoimax: Don't replace systems where intmax_t is int.
+ 2012-01-05 strtoimax: Work around AIX 5.1 bug.
+ 2012-01-05 inttypes: Modernize.
+ 2011-12-13 inttypes, stdint: add C++11 support
+ 2011-11-26 Fix conflict between two instantiations of module 'unistd'.
+ 2011-11-21 _Noreturn: Check that _MSC_VER is defined
+ 2011-11-10 ptsname_r: Avoid compilation error on OSF/1 5.1.
+ 2011-11-09 raise: fix mingw handling of SIGPIPE
+ 2011-10-27 Add stdalign module and use it in other modules.
+
+ * lib/stdalign.in.h, lib/sys_types.in.h, m4/off_t.m4, m4/stdalign.m4:
+ * m4/sys_types_h.m4:
+ New files.
+ * build-aux/move-if-change, build-aux/snippet/_Noreturn.h:
+ * build-aux/snippet/arg-nonnull.h, build-aux/snippet/c++defs.h:
+ * build-aux/snippet/warn-on-use.h, doc/misc/texinfo.tex:
+ * lib/alloca.in.h, lib/allocator.h, lib/careadlinkat.c:
+ * lib/careadlinkat.h, lib/dosname.h, lib/dup2.c, lib/filemode.c:
+ * lib/filemode.h, lib/ftoastr.c, lib/ftoastr.h, lib/getloadavg.c:
+ * lib/getopt.c, lib/getopt.in.h, lib/getopt1.c, lib/getopt_int.h:
+ * lib/gettext.h, lib/gnulib.mk, lib/ignore-value.h, lib/intprops.h:
+ * lib/inttypes.in.h, lib/lstat.c, lib/md5.c, lib/md5.h, lib/mktime.c:
+ * lib/pathmax.h, lib/pthread_sigmask.c, lib/readlink.c, lib/sha1.c:
+ * lib/sha1.h, lib/sha256.c, lib/sha256.h, lib/sha512.c, lib/sha512.h:
+ * lib/signal.in.h, lib/sigprocmask.c, lib/stat.c, lib/stdarg.in.h:
+ * lib/stdbool.in.h, lib/stddef.in.h, lib/stdint.in.h, lib/stdio.in.h:
+ * lib/stdlib.in.h, lib/strftime.c, lib/strftime.h, lib/strtoimax.c:
+ * lib/strtol.c, lib/strtoll.c, lib/strtoul.c, lib/strtoull.c:
+ * lib/symlink.c, lib/sys_stat.in.h, lib/time.in.h, lib/time_r.c:
+ * lib/u64.h, lib/unistd.in.h, lib/verify.h, m4/00gnulib.m4:
+ * m4/alloca.m4, m4/c-strtod.m4, m4/dup2.m4, m4/extensions.m4:
+ * m4/filemode.m4, m4/getloadavg.m4, m4/getopt.m4, m4/gl-comp.m4:
+ * m4/gnulib-common.m4, m4/gnulib-tool.m4, m4/include_next.m4:
+ * m4/inttypes.m4, m4/largefile.m4, m4/longlong.m4, m4/lstat.m4:
+ * m4/md5.m4, m4/mktime.m4, m4/multiarch.m4, m4/nocrash.m4:
+ * m4/pathmax.m4, m4/pthread_sigmask.m4, m4/readlink.m4, m4/sha1.m4:
+ * m4/sha256.m4, m4/sha512.m4, m4/signal_h.m4, m4/signalblocking.m4:
+ * m4/socklen.m4, m4/ssize_t.m4, m4/st_dm_mode.m4, m4/stat.m4:
+ * m4/stdarg.m4, m4/stdbool.m4, m4/stddef_h.m4, m4/stdint.m4:
+ * m4/stdio_h.m4, m4/stdlib_h.m4, m4/strftime.m4, m4/strtoimax.m4:
+ * m4/strtoll.m4, m4/strtoull.m4, m4/strtoumax.m4, m4/symlink.m4:
+ * m4/sys_stat_h.m4, m4/time_h.m4, m4/time_r.m4, m4/tm_gmtoff.m4:
+ * m4/unistd_h.m4, m4/warnings.m4, m4/wchar_t.m4:
+ Update from gnulib.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * configure.in: Remove all mention of src/m/*.
+ (machine, machfile, M_FILE, config_machfile, and_machfile): Remove.
+ All uses removed.
+ (BITS_PER_CHAR, BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG)
+ (BITS_PER_LONG_LONG): Move to src/lisp.h.
+ * lib/makefile.w32-in: Remove dependencies on
+ $(EMACS_ROOT)/src/m/intel386.h.
+ * make-dist: Don't make links to src/m.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (ACLOCAL_INPUTS): Fix up gnulib-comp.m4 name. (Bug#11529)
+ Without this further fix, aclocal was being invoked unnecessarily.
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (blessmail, install-arch-dep, uninstall):
+ Check cd lib-src works.
+ (install-arch-dep, uninstall): Remove unneeded subshells.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * update-subdirs: Move to build-aux/.
+ * make-dist, Makefile.in (install-arch-indep): Update for this change.
+
+ * Makefile.in (leimdir): New, set by configure.
+ (COPYDIR, COPYDESTS): Add leim directories.
+ (install-leim): Remove.
+ (install-arch-indep): Handle leim installation directly.
+
+ * vpath.sed: Remove unused file.
+ * make-dist: No more vpath.sed.
+
+2012-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use full name for m4/gnulib-comp.m4. (Bug#11529)
+ Previously the file was named m4/gl-comp.m4 due to DOS 8+3 restrictions,
+ even though the file's name in gnulib is m4/gnulib-comp.m4.
+ This had a problem when merging from gnulib, as the code temporarily
+ renamed it to the full name, causing problems when interrupted.
+ Now the file has its full name, with the idea that we will find
+ a solution for MS-DOS that does not affect the rest of Emacs.
+ * m4/gnulib-comp.m4: Rename from m4/gl-comp.m4.
+
+ Assume C89 or later.
+ * configure.in (AC_C_PROTOTYPES, AC_C_VOLATILE, AC_C_CONST)
+ (POINTER_TYPE, PROTOTYPES): Remove.
+
+ Make merging from gnulib a script, not a makefile action.
+ Putting it in a makefile has some problems with reflection, as
+ merging from gnulib updates 'configure', which can update the makefile.
+ Putting it in a standalone script breaks this loop.
+ * Makefile.in (gnulib_srcdir, $(gnulib_srcdir), DOS_gnulib_comp.m4)
+ (GNULIB_MODULES, GNULIB_TOOL_FLAGS, sync-from-gnulib):
+ Remove, moving the actions to the script admin/merge-gnulib.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (LEIM_INSTALLDIR):
+ Rename to leimdir, treat like lispdir.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep, install-doc, install-info)
+ (uninstall): Scrap superfluous subshells.
+
+2012-05-19 Ulrich Mueller <ulm@gentoo.org>
+
+ * Makefile.in (install-etc): Respect DESTDIR. (Bug#11518)
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in (AC_CHECK_FUNCS): Remove XSetWMProtocols,
+ getdomainname, mblen (twice), mbrlen (twice), mbsinit, ualarm,
+ getsockopt, setsockopt, mremap, mempcpy.
+
+ * configure.in (machine): Do not set to 'vax', since src/m/vax.h
+ is being removed.
+ (AC_CHECK_FUNCS): Remove ftime.
+
+2012-05-19 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep): Remove unneeded subshell.
+
+ * Makefile.in (install-arch-indep): Remove unneeded chmod.
+ Set permissions of lisp/subdirs.el.
+
+ * Makefile.in (SUBDIR): Add leim. Update users.
+
+ * Makefile.in (lib, lib-src, lisp): Check cd return value.
+
+ * Makefile.in (leim): No need to set PARALLEL.
+
+2012-05-18 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep, install-info, install-man):
+ Simplify some one-sided ifs.
+
+ * Makefile.in: Install only the relevant DOC file.
+ (install-arch-indep): Delete etc/DOC*.
+ (install-doc): No more need to delete etc/DOC.
+
+ * Makefile.in (install-arch-indep): Split into several rules.
+ (install-doc, innstall-info, install-man): New rules.
+
+ * configure.in (mandir): May as well include it in the NS app bundle.
+
+ * configure.in (INSTALL_ARCH_INDEP_EXTRA): New output variable.
+ * Makefile.in (INSTALL_ARCH_INDEP_EXTRA): New, set by configure.
+ (install-arch-indep): Don't install-etc for self-contained ns builds.
+
+ * configure.in (GCC_TEST_OPTIONS, NON_GCC_TEST_OPTIONS) <darwin>:
+ No longer unconditonally add /sw directories. (Bug#2280)
+
+ * Makefile.in (install-arch-dep): Depend on install-arch-indep.
+ (install-arch-indep): Depend on install-leim.
+ (install): Remove explicit install-leim dependence.
+
+ * Makefile.in (install-arch-indep):
+ Move last element of mkdir rule here.
+ (mkdir): Remove rule.
+
+ * Makefile.in (install-arch-indep): Remove unneeded chmods.
+ INSTALL_DATA does this for us.
+
+ * Makefile.in (install-arch-dep): Ensure bindir exists.
+ Drop mkdir dependency.
+ (install-arch-indep): Ensure docdir, infodir, mandir exist.
+ (install-leim): Drop mkdir dependency.
+ (mkdir): Remove most directories, now made in relevant rules.
+
+ * Makefile.in (install-arch-indep): Combine adjacent loops.
+
+2012-05-17 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-etc, mkdir):
+ Make relevant directories in install-etc rather than mkdir.
+
+ * Makefile.in (write_subdir): Create the directory if needed.
+ (install-arch-dep, mkdir): No need to make site-lisp directories.
+
+ * Makefile.in (write_subdir): New.
+ (install-arch-indep, install-arch-dep): Use $write_subdir.
+
+ * configure.in (docdir, etcdir, infodir, lispdir):
+ For a self-contained ns build, set these to the appropriate values.
+ * Makefile.in (install-arch-dep): No need to move info/ any more.
+
+ * configure.in (ns_self_contained): New output variable.
+ * Makefile.in (ns_self_contained): New, set by configure.
+ (install-arch-dep): For a self-contained ns build,
+ don't bother installing binaries then immediately deleting them.
+
+ * Makefile.in (ns_appbindir, ns_appresdir):
+ Move them before things that may refer to them.
+ (install-arch-dep): No need to relocate self-contained ns libexec.
+
+ * configure.in (archlibdir): Set it for self-contained ns builds.
+ (libexecdir): Don't expand it now (this is mainly cosmetic).
+
+2012-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in: Simplify by removing CPP etc.
+ (CPP_TEST_OPTIONS, NON_GNU_CPP, cc_specified, SPECIFIED_CFLAGS)
+ (SPECIFED_CPP, CPP, NON_GNU_CC, AC_PROG_CPP): Remove; not needed.
+ In particular we no longer need to fiddle with CPP, since we don't
+ use CPP specially any more.
+ (gl_EARLY): Invoke this after adjusting CC, so that it uses the
+ adjusted compiler.
+ (AC_PROG_INSTALL, AC_PROG_MKDIR_P, AC_PROG_RANLIB): Comment out,
+ since gl_EARLY and/or Autoconf already does these.
+
+2012-05-16 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Try to fix building with gcc >= 4.6 on Darwin.
+ (CPP): Do not unconditionally set it on Darwin.
+ Instead, try to test if -no-cpp-precomp is accepted.
+ (CPP_TEST_OPTIONS, SPECIFIED_CPP): New. (Bug#9755)
+
+2012-05-15 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-dep): Replace use of MV_DIRS.
+
+ * Makefile.in (install-arch-dep): Do not hard-code version number.
+
+ * Makefile.in (install-arch-dep): NS install no longer needs to
+ symlink libexec/* into bin/, since 2012-05-14 ns_init_paths change.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (ns_appbindir): Remove trailing "/".
+
+ * configure.in (AC_PROG_MKDIR_P): Call it, to set MKDIR_P.
+ (MKDEPDIR): Use $MKDIR_P.
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkdir): Use $MKDIR_P.
+
+2012-05-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep): There are no more Makefile.c files.
+ Use INSTALL_DATA for the DOC file.
+ Remove dead code for ./lisp that never executes.
+
+2012-05-10 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (LEIM_INSTALLDIR): New output variable.
+
+2012-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * .dir-locals.el (log-edit-mode): Enable gnu-style checks.
+
+2012-05-08 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: No more doc/lispref/*.el.
2012-05-05 Andreas Schwab <schwab@linux-m68k.org>
- * configure.in: Fix last change.
+ * configure.in: Fix quoting bugs.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (INFO_EXT, INFO_OPTS): New output variables.
2012-05-02 Glenn Morris <rgm@gnu.org>
+ * configure.in (LD_SWITCH_SYSTEM): Don't try to defeat
+ the choices made by FreeBSD and NetBSD. (Bug#10313)
+
+ * Makefile.in (INFO_FILES): Remove variable.
+ (INFO_NONMISC): New variable.
+ (install-arch-indep, uninstall): Don't use $INFO_FILES.
+
* Makefile.in (uninstall): Remove useless-use-of-for; that for
some reason caused problems on an old Solaris.
* Makefile.in (install-arch-indep, uninstall):
Ensure that INSTALL-type commands are run from top-level.
- * Makefile.in (INFO_FILES): Add emacs-gnutls; accidentally
- omitted from 2012-04-12 backport from trunk.
-
* info/dir: Make some entries consistent with the source texi files.
* configure.in (LIBS_TERMCAP): Fix netbsd logic, broken 2012-03-04.
-2012-04-18 Ludovic Courtès <ludo@gnu.org>
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-arch-indep):
+ Combine adjacent install-data and install-info loops.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MAN_PAGES): Remove.
+ (install-arch-indep, uninstall): Don't use $MAN_PAGES.
+
+ * configure.in: Try libtinfo for tputs.
+ (LIBS_TERMCAP) [gnu*]: Use libtinfo if it was found. (Bug#9741)
+
+ * configure.in: Combine adjacent $opsys case blocks.
+
+ * configure.in (LIBS_TERMCAP): Remove unreachable branch for sol2.
+
+ * configure.in: Invert the TERMINFO logic,
+ since "yes" is far more common than "no".
+
+ * configure.in (HAVE_LIBNCURSES): Remove; it is required to be true.
+
+ * configure.in (LD_SWITCH_X_SITE_RPATH):
+ Rename from LD_SWITCH_X_SITE_AUX_RPATH.
+
+ * configure.in (LD_SWITCH_X_SITE_AUX): Remove; no longer used.
+
+2012-04-26 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: No more doc/lispref/tindex.pl.
+
+2012-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * configure.in (dbus_validate_bus_name, dbus_validate_path)
+ (dbus_validate_interface, dbus_validate_member): Check also for
+ these library functions.
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.in (doug_lea_malloc): Check for __malloc_initialize_hook.
+ With glibc 2.14 or later, when compiled with GCC 4.7.0's
+ -Werror=deprecated-declarations flag, use of hooks like
+ __malloc_initialize_hook causes compilation to fail because these
+ hooks are deprecated. Modify 'configure' to check for these hooks too.
+ Simplify the 'configure' code to test for all the hooks at once.
+ (emacs_cv_var___after_morecore_hook): Remove, replacing with ...
+ (emacs_cv_var_doug_lea_malloc): ... this new var.
+
+2012-04-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Sync from gnulib version 4f11d6bebc3098c64ffde27079ab0d0cecfd0cdc
+ dated 2011-10-07. Regenerating from current gnulib would be a
+ pervasive change, and currently the trunk isn't open to such changes.
+ * configure.in (WARN_CFLAGS): Remove; no longer needed now
+ that gnulib does it.
+ * lib/gnulib.mk, m4/gl-comp.m4: Regenerate.
+
+2012-04-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * m4/gl-comp.m4: Update. (Bug#11285)
+
+2012-04-20 Ludovic Courtès <ludo@gnu.org>
* configure.in: Don't use the -R option (Bug#11251).
-2012-04-12 Teodor Zlatanov <tzz@lifelogs.com>
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ I have been using this change for many months in my private copy
+ of Emacs, and have used it to find several bugs. It's mature
+ enough to publish now.
+ * Makefile.in (GNULIB_MODULES): Add warnings, manywarnings.
+ * configure.in: Support --enable-gcc-warnings, in the style of
+ other GNU packages such as coreutils.
+ (C_WARNINGS_SWITCH): Remove, replacing with...
+ (WARN_CFLAGS, GNULIB_WARN_CFLAGS): New variable.
+ (PKG_CHECK_MODULES, C_SWITCH_X_SITE): Use -isystem rather than -I,
+ when including system files with GCC.
+ * etc/NEWS: Mention --enable-gcc-warnings.
+ * INSTALL (DETAILED BUILDING AND INSTALLATION): Likewise.
+ * lib/Makefile.am (AM_CFLAGS): New macro.
+ * m4/manywarnings.m4, m4/warnings.m4: New files, from gnulib.
+
+2012-04-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * configure.in (AC_CHECK_FUNCS):
+ Add getpwent, endpwent, getgrent, endgrent. (Bug#7900)
+
+2012-04-16 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (NS_HAVE_NSINTEGER): Remove unnecessary variable.
+
+ * configure.in: Remove X libs workaround for old autoconf.
+
+2012-04-12 Ken Brown <kbrown@cornell.edu>
+
+ * configure.in: Warn that Cygwin 1.5 is unsupported. (Bug#10398)
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * configure.in (GNUSTEP_CFLAGS): Rename from C_SWITCH_X_SYSTEM.
+
+2012-04-10 Glenn Morris <rgm@gnu.org>
+
+ * configure.in: Conditionally generate admin/unidata/Makefile.
+
+2012-04-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * info/dir, Makefile.in (INFO_FILES): Add emacs-gnutls manual.
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (leim): Check cd return value. Pass fewer variables.
+ (install-leim): Check cd return value. Pass $MFLAGS.
+ (install-strip): Pass $MFLAGS.
+
+ * configure.in: Require makeinfo >= 4.7. (Bug#10910)
+ Eg org.texi has been using 4.7 functions for some time.
+
+2012-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check pkg-config exit status when configuring (Bug#10626).
+ * configure.in (PKG_CHECK_MODULES): Do not assume that pkg-config
+ works; check its exit status. Problem reported by Jordi Gutiérrez
+ Hermoso in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-01/msg00787.html>.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * README, configure.in (AC_INIT): Bump version to 24.1.50.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
- * info/dir: Add emacs-gnutls.
+ * lib/makefile.w32-in (gnulib, all): Don't depend on stamp_BLD.
2012-03-04 Paul Eggert <eggert@cs.ucla.edu>
2011-12-17 Paul Eggert <eggert@cs.ucla.edu>
Port HAVE_PTHREAD configuration to MirBSD 10 (Bug#10201).
- * configure.in (HAVE_PTHREAD): Check for pthread_atfork if linking
+ * configure.in (HAVE_PTHREAD): Check for pthread_atfork if linking
to gmalloc.c. This should prevent a MirBSD 10 build failure reported
by Nelson H. F. Beebe in
<http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00065.html>.
2010-03-12 Eli Zaretskii <eliz@gnu.org>
- These changes remove termcap.c from the build on Posix platforms.
+ These changes remove termcap.c from the build on POSIX platforms.
* configure.in <AC_CHECK_HEADERS>: Remove termcap.h.
* configure: Regenerated.
2005-06-08 Steven Tamm <steventamm@mac.com>
- * configure.in: Support Darwin/MacOSX on Intel
+ * configure.in: Support Darwin/MacOSX on Intel.
2005-06-06 Jan Djärv <jan.h.d@swipnet.se>
2004-10-08 Steven Tamm <steventamm@mac.com>
- * configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h
+ * configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h.
2004-10-06 Jan Djärv <jan.h.d@swipnet.se>
2003-01-19 Jan Djärv <jan.h.d@swipnet.se>
- * configure.in: Add --with-gtk, --with-x-toolkit=gtk
+ * configure.in: Add --with-gtk, --with-x-toolkit=gtk.
* INSTALL (DETAILED BUILDING AND INSTALLATION): Add text about GTK.
* configure.in: New option, --enable-carbon-app, to specify
that the application should be installed
* Makefile.in (install-arch-dep): On Mac OS X, install the
- Emacs.app application if carbon-app is enabled
+ Emacs.app application if carbon-app is enabled.
2003-01-06 Dave Love <fx@gnu.org>
1995-09-30 Richard Stallman <rms@mole.gnu.ai.mit.edu>
- * configure.in (powerpc-*-solaris2): New alternative.x
+ * configure.in (powerpc-*-solaris2): New alternative.
1995-09-12 Karl Heuer <kwzh@gnu.ai.mit.edu>
1994-09-21 Richard Stallman <rms@mole.gnu.ai.mit.edu>
- * configure.in (i[345]86-sequent-ptx*): Handle
+ * configure.in (i[345]86-sequent-ptx*): Handle.
1994-09-20 Richard Stallman <rms@mole.gnu.ai.mit.edu>
- * Makefile.in (paths-force): Depend on src/paths.h
+ * Makefile.in (paths-force): Depend on src/paths.h.
1994-09-19 Karl Heuer <kwzh@hal.gnu.ai.mit.edu>
1994-09-18 Karl Heuer <kwzh@hal.gnu.ai.mit.edu>
- * Makefile.in (install-arch-indep): Copy DOC-*, not DOC*
+ * Makefile.in (install-arch-indep): Copy DOC-*, not DOC*.
* configure.in: Add AC_AIX.
Add checks to set HAVE_STRUCT_UTIMBUF, HAVE_TIMEVAL, HAVE_SELECT.
1993-09-12 Roland McGrath (roland@sugar-bombs.gnu.ai.mit.edu)
- * make-dist: Dist vpath.sed
+ * make-dist: Dist vpath.sed.
* Makefile.in (lib-src/Makefile, src/Makefile, oldXMenu/Makefile):
Depend on vpath.sed.
`--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
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.
+Use --enable-gcc-warnings to enable compile-time checks that warn
+about possibly-questionable C code. This is intended for developers
+and is useful with GNU-compatible compilers. On a recent GNU system
+there should be no warnings; on older and on non-GNU systems the
+generated warnings may still be useful.
+
+Use --enable-link-time-optimization to enable link-time optimizer, which
+is available in GNU compiler since version 4.5.0. If your compiler is not
+GNU or older than version 4.5.0, this option does nothing. If `configure'
+can determine number of online CPUS on your system, final link-time
+optimization and code generation is executed in parallel using one job
+per each available online CPU.
+
The `--prefix=PREFIXDIR' option specifies where the installation process
should put emacs and its data files. This defaults to `/usr/local'.
- Emacs (and the other utilities users run) go in PREFIXDIR/bin
to the real source directory--there is no need, and installation will
fail.)
-4) Look at `./lisp/paths.el'; if some of those values are not right
-for your system, set up the file `./lisp/site-init.el' with Emacs
-Lisp code to override them; it is not a good idea to edit paths.el
-itself. YOU MUST USE THE LISP FUNCTION `setq' TO ASSIGN VALUES,
-rather than `defvar', as used by `./lisp/paths.el'. For example,
+4) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs
+Lisp code you want Emacs to load before it is dumped out. Use
+site-load.el for additional libraries if you arrange for their
+documentation strings to be in the etc/DOC file (see
+src/Makefile.in if you wish to figure out how to do that). For all
+else, use site-init.el. Do not load byte-compiled code which
+was built with a non-nil value of `byte-compile-dynamic'.
+
+It is not a good idea to edit the normal .el files that come with Emacs.
+Instead, use a file like site-init.el to change settings.
+
+To change the value of a variable that is already defined in Emacs,
+you should use the Lisp function `setq', not `defvar'. For example,
(setq news-inews-program "/usr/bin/inews")
variable should have. If you don't pay attention to what you are
doing, you'll make a mistake.
-5) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs
-Lisp code you want Emacs to load before it is dumped out. Use
-site-load.el for additional libraries if you arrange for their
-documentation strings to be in the etc/DOC file (see
-src/Makefile.in if you wish to figure out how to do that). For all
-else, use site-init.el. Do not load byte-compiled code which
-was built with a non-nil value of `byte-compile-dynamic'.
-
If you set load-path to a different value in site-init.el or
site-load.el, Emacs will use *precisely* that value when it starts up
again. If you do this, you are on your own!
The `site-*.el' files are nonexistent in the distribution. You do not
need to create them if you have nothing to put in them.
-6) Refer to the file `./etc/TERMS' for information on fields you may
+5) Refer to the file `./etc/TERMS' for information on fields you may
wish to add to various termcap entries. (This is unlikely to be necessary.)
-7) Run `make' in the top directory of the Emacs distribution to finish
+6) Run `make' in the top directory of the Emacs distribution to finish
building Emacs in the standard way. The final executable file is
named `src/emacs'. You can execute this file "in place" without
copying it, if you wish; then it automatically uses the sibling
are installed in the following directories:
`/usr/local/bin' holds the executable programs users normally run -
- `emacs', `etags', `ctags', `emacsclient',
- `grep-changelog', and `rcs-checkin'.
+ `emacs', `etags', `ctags', `emacsclient', and
+ `grep-changelog'.
`/usr/local/share/emacs/VERSION/lisp' holds the Emacs Lisp library;
`VERSION' stands for the number of the Emacs version
the command. See the section below called `MAKE VARIABLES' for more
information on this.
-8) Check the file `dir' in your site's info directory (usually
+7) Check the file `dir' in your site's info directory (usually
/usr/local/share/info) to make sure that it has a menu entry for the
Emacs info files.
-9) If your system uses lock files to interlock access to mailer inbox files,
+8) If your system uses lock files to interlock access to mailer inbox files,
then you might need to make the movemail program setuid or setgid
to enable it to write the lock files. We believe this is safe.
-10) You are done! You can remove executables and object files from
+9) You are done! You can remove executables and object files from
the build directory by typing `make clean'. To also remove the files
that `configure' created (so you can compile Emacs for a different
configuration), type `make distclean'. If you don't need some, or all
1) Copy `./src/config.in' to `./src/config.h'.
-2) Consult `./etc/MACHINES' to see what configuration name you should
-use for your system. Look at the code of the `configure' script to
-see which operating system and architecture description files from
-`src/s' and `src/m' should be used for that configuration name. Edit
-`src/config.h', and change the two `#include' directives to include
-the appropriate system and architecture description files.
-
-2) Edit `./src/config.h' to set the right options for your system. If
-you need to override any of the definitions in the s/*.h and m/*.h
-files for your system and machine, do so by editing config.h, not by
-changing the s/*.h and m/*.h files.
+2) Edit `./src/config.h' to set the right options for your system.
3) Create `Makefile' files in various directories from the
corresponding `Makefile.in' files. This isn't so hard, just a matter
of editing in appropriate substitutions for the @...@ constructs.
-The `configure' script is built from `configure.in' by the `autoconf'
-program. You need at least the version of autoconf specified in the
-AC_PREREQ(...) command to rebuild `configure' from `configure.in'.
+The `configure' script is built from `configure.ac' by the
+`autogen.sh' script, which checks that `autoconf' and other build
+tools are sufficiently up to date and then runs the build tools.
BUILDING GNU EMACS BY HAND
in `./lib-src' to their final destinations, as selected in `./src/epaths.h'.
Strictly speaking, not all of the executables in `./lib-src' need be copied.
-- The programs `hexl', `movemail', `profile', `rcs2log', and `vcdiff'
+- The programs `hexl', `movemail', `profile', and `rcs2log'
are used by Emacs; they do need to be copied.
-- The programs `etags', `ctags', `emacsclient', and `rcs-checkin'
- are intended to be run by users; they are handled below.
+- The programs `etags', `ctags', and `emacsclient' are intended to be
+ run by users; they are handled below.
- The programs `make-docfile' and `test-distrib' were
used in building Emacs, and are not needed any more.
2) Copy the files in `./info' to the place specified in
-`./lisp/site-init.el' or `./lisp/paths.el'. Note that if the
+`./lisp/site-init.el' or `./lisp/info.el'. Note that if the
destination directory already contains a file named `dir', you
probably don't want to replace it with the `dir' file in the Emacs
distribution. Instead, you should make sure that the existing `dir'
You can delete `./src/temacs'.
-4) Copy the programs `emacsclient', `ctags', `etags', and `rcs-checkin'
-from `./lib-src' to `/usr/local/bin'. These programs are intended for
-users to run.
+4) Copy the programs `emacsclient', `ctags', and `etags' from `./lib-src'
+to `/usr/local/bin'. These programs are intended for users to run.
5) Copy the man pages in `./doc/man' into the appropriate man directory.
when building from a release. You will need:
autoconf - at least the version specified near the start of
- configure.in (in the AC_PREREQ command).
-automake - we recommend at least version 1.11.
+ configure.ac (in the AC_PREREQ command).
+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.
If you want later builds to go faster, at the expense of sometimes
doing the wrong thing if you update the build procedure, you can
-invoke "./configure -C --disable-maintainer-mode" instead.
+invoke "./configure -C" instead.
Some of the files that are included in the Emacs tarball, such as
byte-compiled Lisp files, are not stored in Bazaar. Therefore, to
# DIST: make most of the changes to this file you might want, so try
# DIST: that first.
-# Copyright (C) 1992-2012 Free Software Foundation, Inc.
+# Copyright (C) 1992-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
# ==================== Things `configure' Might Edit ====================
-MAINTAINER_MODE_FLAG = --disable-maintainer-mode
-@MAINT@MAINTAINER_MODE_FLAG = --enable-maintainer-mode
cache_file = @cache_file@
-CONFIGURE_FLAGS = --cache-file=$(cache_file) $(MAINTAINER_MODE_FLAG)
+CONFIGURE_FLAGS = --cache-file=$(cache_file)
CC=@CC@
CFLAGS=@CFLAGS@
# ==================== Where To Install Things ====================
+# Location to install Emacs.app under GNUstep / Mac OS X.
+# Later values may use these.
+ns_appbindir=@ns_appbindir@
+ns_appresdir=@ns_appresdir@
+# Either yes or no depending on whether this is a relocatable Emacs.app.
+ns_self_contained=@ns_self_contained@
+
# The default location for installation. Everything is placed in
# subdirectories of this directory. The default values for many of
# the variables below are expressed in terms of this one, so you may
sharedstatedir=@sharedstatedir@
# Where to install and expect executable files to be run by Emacs
-# rather than directly by users, and other architecture-dependent
-# data. ${archlibdir} is a subdirectory of this.
+# rather than directly by users (and other architecture-dependent
+# data, although Emacs does not have any). The executables
+# are actually installed in ${archlibdir}, which is (normally)
+# a subdirectory of this.
libexecdir=@libexecdir@
# Where to install Emacs's man pages.
-# This used to allow choice of the numeric extension, but this made
-# little sense since the files were always installed in man1/
-# (and they contain cross-references that expect them to be there).
+# Note they contain cross-references that expect them to be in section 1.
mandir=@mandir@
man1dir=$(mandir)/man1
-MAN_PAGES=ctags.1 ebrowse.1 emacs.1 emacsclient.1 etags.1 \
- grep-changelog.1 rcs-checkin.1
-# Where to install and expect the info files describing Emacs. In the
-# past, this defaulted to a subdirectory of ${prefix}/lib/emacs, but
-# since there are now many packages documented with the texinfo
-# system, it is inappropriate to imply that it is part of Emacs.
+# Where to install and expect the info files describing Emacs.
infodir=@infodir@
-INFO_FILES=ada-mode auth autotype calc ccmode cl dbus dired-x ebrowse \
- ede ediff edt eieio efaq eintr elisp emacs emacs-gnutls emacs-mime epa erc \
- ert eshell eudc flymake forms gnus idlwave info mairix-el \
- message mh-e newsticker nxml-mode org pcl-cvs pgg rcirc \
- reftex remember sasl sc semantic ses sieve smtpmail speedbar \
- tramp url vip viper widget woman
+# Info files not in the doc/misc directory (we get those via make echo-info).
+INFO_EXT=@INFO_EXT@
+INFO_NONMISC=emacs$(INFO_EXT) eintr$(INFO_EXT) elisp$(INFO_EXT)
# If no makeinfo was found and configured --without-makeinfo, "no"; else "yes".
HAVE_MAKEINFO=@HAVE_MAKEINFO@
# Where to find the application default.
x_default_search_path=@x_default_search_path@
-# Location to install Emacs.app under NeXT/Open/GNUstep / Cocoa
-ns_appbindir=@ns_appbindir@
-ns_appresdir=@ns_appresdir@
-
# Where the etc/emacs.desktop file is to be installed.
desktopdir=$(datarootdir)/applications
# These variables hold the values Emacs will actually use. They are
# based on the values of the standard Make variables above.
-# Where to install the lisp files distributed with
+# Where to install the lisp, leim files distributed with
# Emacs. This includes the Emacs version, so that the
# lisp files for different versions of Emacs will install
# themselves in separate directories.
lispdir=@lispdir@
+leimdir=@leimdir@
-# Directories Emacs should search for lisp files specific
-# to this site (i.e. customizations), before consulting
-# ${lispdir}. This should be a colon-separated list of
-# directories.
+# Directories Emacs should search for standard lisp files.
+# The default is ${lispdir}:${leimdir}.
+standardlisppath=@standardlisppath@
+
+# Directories Emacs should search for lisp files specific to this
+# site (i.e. customizations), before consulting ${standardlisppath}.
+# This should be a colon-separated list of directories.
locallisppath=@locallisppath@
# Where Emacs will search to find its lisp files. Before
# changing this, check to see if your purpose wouldn't
# better be served by changing locallisppath. This
# should be a colon-separated list of directories.
+# The default is ${locallisppath}:${standardlisppath}.
lisppath=@lisppath@
# Where Emacs will search for its lisp files while
# Note that if the system does not provide a suitable install,
# configure will use build-aux/install-sh. Annoyingly, it does
# not use an absolute path. So we must take care to always run
-# INSTALL-type commands from the top-level directory.
+# INSTALL-type commands from the directory containing the Makefile.
# This explains (I think) the cd thisdir seen in several install rules.
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_INFO = @INSTALL_INFO@
# By default, we uphold the dignity of our programs.
INSTALL_STRIP =
+MKDIR_P = @MKDIR_P@
+LN_S = @LN_S@
# We use gzip to compress installed .el files.
GZIP_PROG = @GZIP_PROG@
EMACS = `echo emacs${EXEEXT} | sed '$(TRANSFORM)'`
EMACSFULL = `echo emacs-${version}${EXEEXT} | sed '$(TRANSFORM)'`
-# Subdirectories to make recursively. `lisp' is not included
-# because the compiled lisp files are part of the distribution.
-# leim is not included because it needs special handling.
-#
-# Actually, we now include `lisp' as well, since the compiled files
-# are not included any more in case of bootstrap or in case Emacs was
-# checked out from a VCS.
-SUBDIR = lib lib-src src lisp
+# Subdirectories to make recursively.
+SUBDIR = lib lib-src src lisp leim
# The subdir makefiles created by config.status.
SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@
# Subdirectories to install, and where they'll go.
# lib-src's makefile knows how to install it, so we don't do that here.
-# leim's makefile also knows how to install it, so we don't do that here.
-# When installing the info files, we need to do special things to
-# avoid nuking an existing dir file, so we don't do that here;
-# instead, we have written out explicit code in the `install' targets.
-COPYDIR = ${srcdir}/etc ${srcdir}/lisp
-COPYDESTS = $(DESTDIR)${etcdir} $(DESTDIR)${lispdir}
+# Directories that cannot simply be copied, eg info,
+# are treated separately.
+# quail appears twice because in out-of-tree builds, it exists twice.
+COPYDIR = ${srcdir}/etc ${srcdir}/lisp ${srcdir}/leim/ja-dic ${srcdir}/leim/quail leim/quail
+COPYDESTS = $(DESTDIR)${etcdir} $(DESTDIR)${lispdir} $(DESTDIR)${leimdir}/ja-dic $(DESTDIR)${leimdir}/quail $(DESTDIR)${leimdir}/quail
-all: ${SUBDIR} leim
+all: ${SUBDIR}
+
+.PHONY: all ${SUBDIR} blessmail epaths-force FRC
removenullpaths=sed -e 's/^://g' -e 's/:$$//g' -e 's/::/:/g'
# Generate epaths.h from epaths.in. This target is invoked by `configure'.
-# See comments in configure.in for why it is done this way, as opposed
+# See comments in configure.ac for why it is done this way, as opposed
# to just letting configure generate epaths.h from epaths.in in a
# similar way to how Makefile is made from Makefile.in.
epaths-force: FRC
- @(lisppath=`echo ${lisppath} | ${removenullpaths}` ; \
- buildlisppath=`echo ${buildlisppath} | ${removenullpaths}` ; \
+ @(standardlisppath=`echo "${standardlisppath}" | ${removenullpaths}` ; \
+ locallisppath=`echo "${locallisppath}" | ${removenullpaths}` ; \
+ buildlisppath=`echo "${buildlisppath}" | ${removenullpaths}` ; \
x_default_search_path=`echo ${x_default_search_path}`; \
gamedir=`echo ${gamedir}`; \
sed < ${srcdir}/src/epaths.in > epaths.h.$$$$ \
- -e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "'"$${lisppath}"'";' \
+ -e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "'"$${standardlisppath}"'";' \
+ -e 's;\(#.*PATH_SITELOADSEARCH\).*$$;\1 "'"$${locallisppath}"'";' \
-e 's;\(#.*PATH_DUMPLOADSEARCH\).*$$;\1 "'"$${buildlisppath}"'";' \
-e 's;\(#.*PATH_EXEC\).*$$;\1 "${archlibdir}";' \
-e 's;\(#.*PATH_INFO\).*$$;\1 "${infodir}";' \
-e 's;\(#.*PATH_DOC\).*$$;\1 "${docdir}";') && \
${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h
-# For parallel make, src should be built before leim.
-# "export PARALLEL=0" is for SGI's Make, to prevent it from
-# running more than 1 process in the leim directory, especially for
-# the $TIT files there.
-leim: src Makefile FRC
- (export PARALLEL; PARALLEL=0; cd $@; $(MAKE) all $(MFLAGS) \
- CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \
- LDFLAGS='${LDFLAGS}' MAKE='${MAKE}')
-
lib-src src: lib
src: lib-src FRC
-.RECURSIVE: ${SUBDIR} leim
-
-# We need to build `emacs' in `src' to compile the *.elc files in `lisp'.
-lisp: src
-
-# Maintainers can put a copy of gnulib into $(gnulib_srcdir).
-gnulib_srcdir = ../gnulib
-$(gnulib_srcdir):
- git clone git://git.savannah.gnu.org/gnulib.git $@
-
-# A shorter name that satisfies MS-DOS 8+3 constraints.
-DOS_gnulib_comp.m4 = gl-comp.m4
-
-# Update modules from gnulib, for maintainers, who should have it in
-# $(gnulib_srcdir) (relative to $(srcdir) and should have build tools
-# as per $(gnulib_srcdir)/DEPENDENCIES.
-GNULIB_MODULES = \
- alloca-opt \
- careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr \
- dup2 \
- filemode getloadavg getopt-gnu ignore-value intprops lstat \
- mktime pthread_sigmask readlink \
- socklen stdarg stdio strftime strtoimax strtoumax symlink sys_stat
-GNULIB_TOOL_FLAGS = \
- --avoid=msvc-inval --avoid=msvc-nothrow \
- --avoid=raise --avoid=threadlib \
- --conditional-dependencies --import --no-changelog --no-vc-files \
- --makefile-name=gnulib.mk
-sync-from-gnulib: $(gnulib_srcdir)
- -cd $(srcdir)/m4 && cp $(DOS_gnulib_comp.m4) gnulib-comp.m4
- cd $(srcdir) && \
- $(gnulib_srcdir)/gnulib-tool $(GNULIB_TOOL_FLAGS) $(GNULIB_MODULES)
- cd $(srcdir)/m4 && rm gnulib-cache.m4 warn-on-use.m4
- cd $(srcdir)/m4 && mv gnulib-comp.m4 $(DOS_gnulib_comp.m4)
- cp $(gnulib_srcdir)/build-aux/texinfo.tex $(srcdir)/doc/misc
- cp \
- $(gnulib_srcdir)/build-aux/move-if-change \
- $(srcdir)/build-aux
- cd $(srcdir) && autoreconf -i -I m4
-.PHONY: sync-from-gnulib
+# We need to build `emacs' in `src' to compile the *.elc files in `lisp'
+# and `leim'.
+lisp leim: src
# These targets should be "${SUBDIR} without `src'".
-lib lib-src lisp: Makefile FRC
- cd $@; $(MAKE) all $(MFLAGS) \
+lib lib-src lisp leim: Makefile FRC
+ cd $@ && $(MAKE) all $(MFLAGS) \
CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \
LDFLAGS='${LDFLAGS}' MAKE='${MAKE}'
VCSWITNESS="$$vcswitness"
blessmail: Makefile src FRC
- cd lib-src; $(MAKE) maybe-blessmail $(MFLAGS) \
+ cd lib-src && $(MAKE) maybe-blessmail $(MFLAGS) \
MAKE='${MAKE}' archlibdir='$(archlibdir)'
# We used to have one rule per */Makefile.in, but that leads to race
# conditions with parallel makes, so let's assume that the time stamp on
# ./Makefile is representative of the time stamp on all the other Makefiles.
-Makefile: config.status $(srcdir)/src/config.in \
+#
+# config.status overrides MAKEFILE_NAME with a bogus name when creating
+# src/epaths.h, so that 'make epaths-force' does not recursively invoke
+# config.status and overwrite config.status while executing it (Bug#11214).
+#
+# 'make bootstrap' overrides MAKEFILE_NAME to a nonexistent file but
+# then attempts to build that file. This forces 'Makefile', 'lib/Makefile',
+# etc. to be built without running into similar recursion problems.
+MAKEFILE_NAME = Makefile
+$(MAKEFILE_NAME): config.status $(srcdir)/src/config.in \
$(srcdir)/Makefile.in $(SUBDIR_MAKEFILES_IN)
- ./config.status
+ MAKE='$(MAKE)' ./config.status
-# Don't erase config.status if make is interrupted while refreshing it.
-.PRECIOUS: config.status
+# Don't erase these files if make is interrupted while refreshing them.
+.PRECIOUS: Makefile config.status
config.status: ${srcdir}/configure ${srcdir}/lisp/version.el
if [ -x ./config.status ]; then \
./config.status --recheck; \
else \
- ./configure $(CONFIGURE_FLAGS); \
+ $(srcdir)/configure $(CONFIGURE_FLAGS); \
fi
-AUTOCONF_INPUTS = @MAINT@ $(srcdir)/configure.in $(srcdir)/aclocal.m4
+AUTOCONF_INPUTS = $(srcdir)/configure.ac $(srcdir)/aclocal.m4
$(srcdir)/configure: $(AUTOCONF_INPUTS)
cd ${srcdir} && autoconf
-ACLOCAL_INPUTS = @MAINT@ $(srcdir)/m4/$(DOS_gnulib_comp.m4)
+ACLOCAL_INPUTS = $(srcdir)/m4/gnulib-comp.m4
$(srcdir)/aclocal.m4: $(ACLOCAL_INPUTS)
cd $(srcdir) && aclocal -I m4
-AUTOMAKE_INPUTS = @MAINT@ $(srcdir)/aclocal.m4 $(srcdir)/lib/Makefile.am $(srcdir)/lib/gnulib.mk
+AUTOMAKE_INPUTS = $(srcdir)/aclocal.m4 $(srcdir)/lib/Makefile.am \
+ $(srcdir)/lib/gnulib.mk
$(srcdir)/lib/Makefile.in: $(AUTOMAKE_INPUTS)
cd $(srcdir) && automake --gnu -a -c lib/Makefile
+
+# Regenerate files that this makefile would have made, if this makefile
+# had been built by Automake. The name 'am--refresh' is for
+# compatibility with subsidiary Automake-generated makefiles.
am--refresh: $(srcdir)/aclocal.m4 $(srcdir)/configure $(srcdir)/src/config.in
.PHONY: am--refresh
# ==================== Installation ====================
+.PHONY: install install-arch-dep install-arch-indep install-doc install-info
+.PHONY: install-man install-etc install-strip uninstall
+
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
-## On AIX, use tar xBf.
-## On Xenix, use tar xpf.
-
-.PHONY: install mkdir
-
-## We delete each directory in ${COPYDESTS} before we copy into it;
-## that way, we can reinstall over directories that have been put in
-## place with their files read-only (perhaps because they are checked
-## into RCS). In order to make this safe, we make sure that the
-## source exists and is distinct from the destination.
-### We do install-arch-indep first because
-### the executable needs the Lisp files and DOC file to work properly.
-install: all install-arch-indep install-arch-dep install-leim blessmail
+install: all install-arch-indep install-doc install-arch-dep blessmail
@true
-MV_DIRS = for i in $$dir; do rm -fr `basename "$$i"` ; mv "$$i" . ; done
+## Ensure that $subdir contains a subdirs.el file.
+## Here and elsewhere, we set the umask so that any created files are
+## world-readable.
+## TODO it might be good to warn about non-standard permissions of
+## pre-existing directories, but that does not seem easy.
+write_subdir=if [ -f $${subdir}/subdirs.el ]; \
+ then true; \
+ else \
+ umask 022; \
+ ${MKDIR_P} $${subdir}; \
+ (echo "(if (fboundp 'normal-top-level-add-subdirs-to-load-path)"; \
+ echo " (normal-top-level-add-subdirs-to-load-path))") \
+ > $${subdir}/subdirs.el; \
+ fi
### Install the executables that were compiled specifically for this machine.
-### It would be nice to do something for a parallel make
-### to ensure that install-arch-indep finishes before this starts.
-install-arch-dep: mkdir
- (cd lib-src; \
+### We do install-arch-indep first because the executable needs the
+### Lisp files and DOC file to work properly.
+install-arch-dep: src install-arch-indep install-doc
+ umask 022; ${MKDIR_P} $(DESTDIR)${bindir}
+ cd lib-src && \
$(MAKE) install $(MFLAGS) prefix=${prefix} \
exec_prefix=${exec_prefix} bindir=${bindir} \
libexecdir=${libexecdir} archlibdir=${archlibdir} \
- INSTALL_STRIP=${INSTALL_STRIP})
- ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} $(DESTDIR)${bindir}/$(EMACSFULL)
- -chmod 1755 $(DESTDIR)${bindir}/$(EMACSFULL)
- rm -f $(DESTDIR)${bindir}/$(EMACS)
- -ln $(DESTDIR)${bindir}/$(EMACSFULL) $(DESTDIR)${bindir}/$(EMACS)
- if test "${ns_appresdir}" != ""; then \
- ( cd ${ns_appresdir} ; \
- if test -d share/emacs ; then dir=share/emacs/*/*; $(MV_DIRS); fi;\
- if test -d share/info ; then dir=share/info; $(MV_DIRS) ; fi ; \
- rm -fr share ) ; \
- ( cd ${ns_appbindir} ; \
- if cd libexec ; then dir=emacs/*/*/* ; $(MV_DIRS); \
- rm -fr emacs; if cd ../bin; then rm -f emacs emacs-24*; \
- ln -sf ../libexec/* . ; fi ; fi ) ; \
- else true ; fi
-
-## FIXME is the emacs-24* bit above really necessary and correct?
-## What if I have 24.1 and 24.2 installed at the same time?
-## In any case, it should use something like echo $version | sed 's/\..*//'
-## instead of hard-coding a version.
+ INSTALL_STRIP=${INSTALL_STRIP}
+ if test "${ns_self_contained}" = "no"; then \
+ ${INSTALL_PROGRAM} $(INSTALL_STRIP) src/emacs${EXEEXT} $(DESTDIR)${bindir}/$(EMACSFULL) || exit 1 ; \
+ chmod 1755 $(DESTDIR)${bindir}/$(EMACSFULL) ; \
+ if test "x${NO_BIN_LINK}" = x; then \
+ rm -f $(DESTDIR)${bindir}/$(EMACS) ; \
+ cd $(DESTDIR)${bindir} && $(LN_S) $(EMACSFULL) $(EMACS); \
+ fi; \
+ else \
+ subdir=${ns_appresdir}/site-lisp; \
+ ${write_subdir} || exit 1; \
+ rm -rf ${ns_appresdir}/share; \
+ fi
+
+## In the share directory, we are deleting:
+## applications (with emacs.desktop, also found in etc/)
+## emacs (basically empty except for unneeded site-lisp directories)
+## icons (duplicates etc/images/icons/hicolor)
+
+## This is install-etc for everything except self-contained-ns builds.
+## For them, it is empty.
+INSTALL_ARCH_INDEP_EXTRA = @INSTALL_ARCH_INDEP_EXTRA@
## http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg01672.html
## Needs to be the user running install, so configure can't set it.
done
### Install the files that are machine-independent.
-### Most of them come straight from the distribution;
-### the exception is the DOC-* files, which are copied
-### from the build directory.
+### Most of them come straight from the distribution; the exception is
+### the DOC file, which is copied from the build directory.
-## Note that we copy DOC* and then delete DOC
-## as a workaround for a bug in tar on Ultrix 4.2.
-
-## We install only the relevant DOC file if possible
-## (ie DOC-${version}.buildnumber), otherwise DOC-${version}*.
+## We delete each directory in ${COPYDESTS} before we copy into it;
+## that way, we can reinstall over directories that have been put in
+## place with their files read-only (perhaps because they are checked
+## into RCS). In order to make this safe, we make sure that the
+## source exists and is distinct from the destination.
-## If people complain about the h flag in tar command, take that out.
-## That flag is also used in leim/Makefile.in
+## We delete etc/DOC* because there may be irrelevant DOC files from
+## other builds in the source directory. This is ok because we just
+## deleted the entire installed etc/ directory and recreated it.
+## install-doc installs the relevant DOC.
## Note that the Makefiles in the etc directory are potentially useful
## in an installed Emacs, so should not be excluded.
-install-arch-indep: mkdir info install-etc
- -set ${COPYDESTS} ; \
- unset CDPATH; \
- for dir in ${COPYDIR} ; do \
- if [ `(cd $$1 && /bin/pwd)` != `(cd $${dir} && /bin/pwd)` ] ; then \
- rm -rf $$1 ; \
- fi ; \
- shift ; \
+## I'm not sure creating locallisppath here serves any useful purpose.
+## If it has the default value, then the later write_subdir commands
+## will ensure all these components exist.
+## This will only do something if locallisppath has a non-standard value.
+## Is it really Emacs's job to create those directories?
+## Should we also be ensuring they contain subdirs.el files?
+## It would be easy to do, just use write_subdir.
+
+## Note that we use tar instead of plain old cp -R/-r because the latter
+## is apparently not portable (even in 2012!).
+## http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00278.html
+## I have no idea which platforms Emacs supports where cp -R does not
+## work correctly, and therefore no idea when tar can be replaced.
+## See also these comments from 2004 about cp -r working fine:
+## http://lists.gnu.org/archive/html/autoconf-patches/2004-11/msg00005.html
+install-arch-indep: lisp leim install-info install-man ${INSTALL_ARCH_INDEP_EXTRA}
+ umask 022 ; \
+ locallisppath='${locallisppath}'; \
+ IFS=:; \
+ for d in $$locallisppath; do \
+ ${MKDIR_P} "$(DESTDIR)$$d"; \
done
-set ${COPYDESTS} ; \
- mkdir ${COPYDESTS} ; \
- chmod ugo+rx ${COPYDESTS} ; \
unset CDPATH; \
$(set_installuser); \
for dir in ${COPYDIR} ; do \
+ [ -d $${dir} ] || exit 1 ; \
dest=$$1 ; shift ; \
- [ -d $${dir} ] \
- && [ `(cd $${dir} && /bin/pwd)` != `(cd $${dest} && /bin/pwd)` ] \
- && (echo "Copying $${dir} to $${dest}..." ; \
- (cd $${dir}; tar -chf - . ) \
- | (cd $${dest}; umask 022; \
- tar -xvf - && cat > /dev/null) || exit 1; \
- find $${dest} -exec chown $${installuser} {} ';' ;\
- for subdir in `find $${dest} -type d -print` ; do \
- chmod a+rx $${subdir} ; \
- rm -f $${subdir}/.gitignore ; \
- rm -f $${subdir}/.arch-inventory ; \
- rm -f $${subdir}/.DS_Store ; \
- rm -f $${subdir}/\#* ; \
- rm -f $${subdir}/.\#* ; \
- rm -f $${subdir}/*~ ; \
- rm -f $${subdir}/*.orig ; \
- [ "$${dir}" != "${srcdir}/etc" ] && \
- rm -f $${subdir}/[mM]akefile*.c $${subdir}/[mM]akefile*[.-]in \
- $${subdir}/[mM]akefile ; \
- rm -f $${subdir}/ChangeLog* ; \
- done) ; \
+ [ -d $${dest} ] && \
+ [ `cd $${dest} && /bin/pwd` = `cd $${dir} && /bin/pwd` ] && \
+ continue ; \
+ if [ "$${dir}" = "leim/quail" ]; then \
+ [ `cd $${dir} && /bin/pwd` = `cd ${srcdir}/leim/quail && /bin/pwd` ] && \
+ continue ; \
+ else \
+ rm -rf $${dest} ; \
+ umask 022; ${MKDIR_P} $${dest} ; \
+ fi ; \
+ echo "Copying $${dir} to $${dest}..." ; \
+ (cd $${dir}; tar -chf - . ) \
+ | (cd $${dest}; umask 022; \
+ tar -xvf - && cat > /dev/null) || exit 1; \
+ [ "$${dir}" != "${srcdir}/etc" ] || rm -f $${dest}/DOC* ; \
+ for subdir in `find $${dest} -type d -print` ; do \
+ rm -f $${subdir}/.gitignore ; \
+ rm -f $${subdir}/.arch-inventory ; \
+ rm -f $${subdir}/.DS_Store ; \
+ rm -f $${subdir}/\#* ; \
+ rm -f $${subdir}/.\#* ; \
+ rm -f $${subdir}/*~ ; \
+ rm -f $${subdir}/*.orig ; \
+ rm -f $${subdir}/ChangeLog* ; \
+ [ "$${dir}" != "${srcdir}/etc" ] && \
+ rm -f $${subdir}/[mM]akefile*[.-]in $${subdir}/[mM]akefile ; \
+ done ; \
+ find $${dest} -exec chown $${installuser} {} ';' ;\
done
+ -rm -f $(DESTDIR)${leimdir}/leim-list.el
+ ${INSTALL_DATA} leim/leim-list.el $(DESTDIR)${leimdir}/leim-list.el
-rm -f $(DESTDIR)${lispdir}/subdirs.el
- $(srcdir)/update-subdirs $(DESTDIR)${lispdir}
- if [ -f $(DESTDIR)${datadir}/emacs/${version}/site-lisp/subdirs.el ]; \
- then true; \
- else \
- (echo "(if (fboundp 'normal-top-level-add-subdirs-to-load-path)"; \
- echo " (normal-top-level-add-subdirs-to-load-path))") \
- > $(DESTDIR)${datadir}/emacs/${version}/site-lisp/subdirs.el; \
- fi
- chmod a+r $(DESTDIR)${datadir}/emacs/${version}/site-lisp/subdirs.el
- -if [ -f $(DESTDIR)${datadir}/emacs/site-lisp/subdirs.el ]; \
- then true; \
- else \
- (echo "(if (fboundp 'normal-top-level-add-subdirs-to-load-path)"; \
- echo " (normal-top-level-add-subdirs-to-load-path))") \
- > $(DESTDIR)${datadir}/emacs/site-lisp/subdirs.el; \
- fi
- -chmod a+r $(DESTDIR)${datadir}/emacs/site-lisp/subdirs.el
+ umask 022; $(srcdir)/build-aux/update-subdirs $(DESTDIR)${lispdir}
+ subdir=$(DESTDIR)${datadir}/emacs/${version}/site-lisp ; \
+ ${write_subdir}
+ subdir=$(DESTDIR)${datadir}/emacs/site-lisp ; \
+ ${write_subdir} || true
+ [ -z "${GZIP_PROG}" ] || \
+ ( echo "Compressing *.el ..." ; \
+ unset CDPATH; \
+ thisdir=`/bin/pwd`; \
+ for dir in $(DESTDIR)${lispdir} $(DESTDIR)${leimdir}; do \
+ cd $${thisdir} ; \
+ cd $${dir} || exit 1 ; \
+ for f in `find . -name "*.elc" -print`; do \
+ ${GZIP_PROG} -9n `echo $$f|sed 's/.elc$$/.el/'` ; \
+ done ; \
+ done )
+ -chmod -R a+r $(DESTDIR)${datadir}/emacs/${version} ${COPYDESTS}
+
+# The last chmod isn't needed at present.
+
+## We install only the relevant DOC file if possible
+## (ie DOC-${version}.buildnumber), otherwise DOC-${version}*.
+## (Note "otherwise" is inaccurate since 2009-08-23.)
+
+## Note that install-arch-indep deletes and recreates the entire
+## installed etc/ directory, so we need it to run before this does.
+install-doc: src install-arch-indep
-unset CDPATH; \
- if [ `(cd ./etc; /bin/pwd)` != `(cd $(DESTDIR)${docdir}; /bin/pwd)` ]; \
+ umask 022; ${MKDIR_P} $(DESTDIR)${docdir} ; \
+ if [ `cd ./etc; /bin/pwd` != `cd $(DESTDIR)${docdir}; /bin/pwd` ]; \
then \
fullversion=`./src/emacs --version | sed -n '1 s/GNU Emacs *//p'`; \
if [ -f "./etc/DOC-$${fullversion}" ]; \
docfile="DOC"; \
fi; \
echo "Copying etc/$${docfile} to $(DESTDIR)${docdir} ..." ; \
- (cd ./etc; tar -chf - $${docfile}) \
- |(cd $(DESTDIR)${docdir}; umask 022; tar -xvf - && cat > /dev/null) || exit 1; \
- (cd $(DESTDIR)$(docdir); \
- $(set_installuser); \
- chown $${installuser} DOC*; chmod a+r DOC*; \
- if test "`echo DOC-*`" != "DOC-*"; then rm -f DOC; fi); \
- else true; fi
- -unset CDPATH; \
- if [ -r ./lisp ] \
- && [ -r ./lisp/simple.el ] \
- && [ x`(cd ./lisp; /bin/pwd)` != x`(cd $(DESTDIR)${lispdir}; /bin/pwd)` ] \
- && [ x`(cd ${srcdir}/lisp; /bin/pwd)` != x`(cd ./lisp; /bin/pwd)` ]; \
- then \
- echo "Copying lisp/*.el and lisp/*.elc to $(DESTDIR)${lispdir} ..." ; \
- (cd lisp; tar -chf - *.el *.elc) \
- |(cd $(DESTDIR)${lispdir}; umask 022; tar -xvf - && cat > /dev/null) || exit 1; \
- (cd $(DESTDIR)${lispdir}; \
- $(set_installuser); \
- find . -exec chown $${installuser} {} ';') ; \
- else true; fi
- -unset CDPATH; \
- if [ -n "${GZIP_PROG}" ]; \
- then \
- echo "Compressing *.el ..." ; \
- (cd $(DESTDIR)${lispdir}; for f in `find . -name "*.elc" -print`; do \
- ${GZIP_PROG} -9n `echo $$f|sed 's/.elc$$/.el/'` ; \
- done) \
+ ${INSTALL_DATA} etc/$${docfile} $(DESTDIR)${docdir}/$${docfile}; \
+ $(set_installuser); \
+ chown $${installuser} $(DESTDIR)${docdir}/$${docfile} || true ; \
else true; fi
+
+install-info: info
+ umask 022; ${MKDIR_P} $(DESTDIR)${infodir}
-unset CDPATH; \
thisdir=`/bin/pwd`; \
- if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd $(DESTDIR)${infodir} && /bin/pwd)` ]; \
- then \
+ [ `cd ${srcdir}/info && /bin/pwd` = `cd $(DESTDIR)${infodir} && /bin/pwd` ] || \
(cd $(DESTDIR)${infodir}; \
- if [ -f dir ]; then true; \
- else \
+ [ -f dir ] || \
(cd $${thisdir}; \
- ${INSTALL_DATA} ${srcdir}/info/dir $(DESTDIR)${infodir}/dir; \
- chmod a+r $(DESTDIR)${infodir}/dir); \
- fi; \
+ ${INSTALL_DATA} ${srcdir}/info/dir $(DESTDIR)${infodir}/dir) ; \
+ info_misc=`cd $${thisdir}/doc/misc; ${MAKE} echo-info | sed '/ing directory/d'`; \
cd ${srcdir}/info ; \
- for elt in $(INFO_FILES); do \
+ for elt in ${INFO_NONMISC} $${info_misc}; do \
test "$(HAVE_MAKEINFO)" = "no" && test ! -f $$elt && continue; \
for f in `ls $$elt $$elt-[1-9] $$elt-[1-9][0-9] 2>/dev/null`; do \
(cd $${thisdir}; \
${INSTALL_DATA} ${srcdir}/info/$$f $(DESTDIR)${infodir}/$$f); \
- chmod a+r $(DESTDIR)${infodir}/$$f; \
- if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
- rm -f $(DESTDIR)${infodir}/$$f.gz; \
- ${GZIP_PROG} -9n $(DESTDIR)${infodir}/$$f; \
- else true; fi; \
+ ( [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ] ) || continue ; \
+ rm -f $(DESTDIR)${infodir}/$$f.gz; \
+ ${GZIP_PROG} -9n $(DESTDIR)${infodir}/$$f; \
done; \
- done); \
- else true; fi
- -unset CDPATH; \
- thisdir=`/bin/pwd`; \
- if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd $(DESTDIR)${infodir} && /bin/pwd)` ]; \
- then \
- for elt in $(INFO_FILES); do \
- test "$(HAVE_MAKEINFO)" = "no" && test ! -f $$elt && continue; \
- (cd $${thisdir}; \
- ${INSTALL_INFO} --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \
- done; \
- else true; fi
- -chmod -R a+r $(DESTDIR)${datadir}/emacs/${version} ${COPYDESTS}
+ (cd $${thisdir}; \
+ ${INSTALL_INFO} --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \
+ done)
+
+install-man:
+ umask 022; ${MKDIR_P} $(DESTDIR)${man1dir}
thisdir=`/bin/pwd`; \
cd ${mansrcdir}; \
- for page in ${MAN_PAGES}; do \
+ for page in *.1; do \
(cd $${thisdir}; \
- ${INSTALL_DATA} ${mansrcdir}/$${page} $(DESTDIR)${man1dir}/$${page}; \
- chmod a+r $(DESTDIR)${man1dir}/$${page}; \
- if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
- rm -f $(DESTDIR)${man1dir}/$${page}.gz; \
- ${GZIP_PROG} -9n $(DESTDIR)${man1dir}/$${page}; \
- else true; fi ); \
+ ${INSTALL_DATA} ${mansrcdir}/$${page} $(DESTDIR)${man1dir}/$${page}); \
+ ( [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ] ) || continue ; \
+ rm -f $(DESTDIR)${man1dir}/$${page}.gz; \
+ ${GZIP_PROG} -9n $(DESTDIR)${man1dir}/$${page}; \
done
## Install those items from etc/ that need to end up elsewhere.
-install-etc: mkdir
+install-etc:
+ umask 022; ${MKDIR_P} $(DESTDIR)${desktopdir}
${INSTALL_DATA} ${srcdir}/etc/emacs.desktop \
$(DESTDIR)${desktopdir}/emacs.desktop
- for icon in $(iconsrcdir)/*/*/apps/*.* \
- $(iconsrcdir)/*/*/mimetypes/*.*; do \
- if [ -r $${icon} ]; then \
- iicon=`echo "$${icon}" | sed 's,$(srcdir)/etc/images/icons,$(DESTDIR)${icondir},'` ; \
- ${INSTALL_DATA} $${icon} $${iicon} ; \
- fi ; \
+ thisdir=`/bin/pwd`; \
+ cd ${iconsrcdir} || exit 1; umask 022 ; \
+ for dir in */*/apps */*/mimetypes; do \
+ [ -d $${dir} ] || continue ; \
+ ( cd $${thisdir}; ${MKDIR_P} $(DESTDIR)${icondir}/$${dir} ) ; \
+ for icon in $${dir}/*.*; do \
+ [ -r $${icon} ] || continue ; \
+ ( cd $${thisdir}; \
+ ${INSTALL_DATA} ${iconsrcdir}/$${icon} $(DESTDIR)${icondir}/$${icon} ) \
+ || exit 1; \
+ done ; \
done
-### Install LEIM files. Although they are machine-independent, we
-### have separate target here instead of including it in
-### `install-arch-indep'. People who extracted LEIM files after they
-### installed Emacs itself can install only LEIM files by this target.
-install-leim: leim/Makefile mkdir
- cd leim; $(MAKE) install
-
### Build Emacs and install it, stripping binaries while installing them.
install-strip:
- $(MAKE) INSTALL_STRIP=-s install
-
-### Build all the directories we're going to install Emacs in. Since
-### we may be creating several layers of directories (for example,
-### /usr/local/lib/emacs/19.0/mips-dec-ultrix4.2), we use install-sh -d
-### instead of mkdir. Not all systems' mkdir programs have the `-p' flag.
-### We set the umask so that any created directories are world-readable.
-### FIXME it would be good to warn about non-standard permissions of
-### pre-existing directories, but that does not seem easy.
-mkdir: FRC
- icondirs= ; \
- for dir in $(iconsrcdir)/*/*/apps $(iconsrcdir)/*/*/mimetypes; do \
- if [ -d $${dir} ]; then \
- icondirs="$${icondirs} $${dir}" ; \
- fi ; \
- done ; \
- icondirs=`echo "$${icondirs}" | sed 's,$(srcdir)/etc/images/icons,$(DESTDIR)${icondir},g'` ; \
- umask 022 ; \
- $(srcdir)/build-aux/install-sh -d $(DESTDIR)${datadir} ${COPYDESTS} \
- $(DESTDIR)${infodir} $(DESTDIR)${man1dir} \
- $(DESTDIR)${bindir} $(DESTDIR)${docdir} $(DESTDIR)${libexecdir} \
- $(DESTDIR)${datadir}/emacs/site-lisp \
- $(DESTDIR)${datadir}/emacs/${version}/site-lisp \
- $(DESTDIR)`echo ${locallisppath} | sed 's,:, $(DESTDIR),g'` \
- $(DESTDIR)${desktopdir} $${icondirs}
+ $(MAKE) $(MFLAGS) INSTALL_STRIP=-s install
### Delete all the installed files that the `install' target would
### create (but not the noninstalled files such as `make all' would create).
###
### Don't delete the lisp and etc directories if they're in the source tree.
uninstall:
- (cd lib-src; \
+ cd lib-src && \
$(MAKE) $(MFLAGS) uninstall \
prefix=${prefix} exec_prefix=${exec_prefix} \
- bindir=${bindir} libexecdir=${libexecdir} archlibdir=${archlibdir})
+ bindir=${bindir} libexecdir=${libexecdir} archlibdir=${archlibdir}
-unset CDPATH; \
for dir in $(DESTDIR)${lispdir} $(DESTDIR)${etcdir} ; do \
if [ -d $${dir} ]; then \
- case `(cd $${dir} ; /bin/pwd)` in \
- `(cd ${srcdir} ; /bin/pwd)`* ) ;; \
+ case `cd $${dir} ; /bin/pwd` in \
+ `cd ${srcdir} ; /bin/pwd`* ) ;; \
* ) rm -rf $${dir} ;; \
esac ; \
case $${dir} in \
done
-rm -rf $(DESTDIR)${libexecdir}/emacs/${version}
thisdir=`/bin/pwd`; \
- (cd $(DESTDIR)${infodir} && \
- for elt in $(INFO_FILES); do \
+ (info_misc=`cd doc/misc; ${MAKE} echo-info | sed '/ing directory/d'`; \
+ cd $(DESTDIR)${infodir} && \
+ for elt in ${INFO_NONMISC} $${info_misc}; do \
(cd $${thisdir}; \
$(INSTALL_INFO) --remove --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \
if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
done;)
(if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
ext=.gz; else ext=; fi; \
- cd $(DESTDIR)${man1dir} && for page in ${MAN_PAGES}; do \
- rm -f $$page$$ext; done )
+ cd ${mansrcdir} && for page in *.1; do \
+ rm -f $(DESTDIR)${man1dir}/$$page$$ext; done )
(cd $(DESTDIR)${bindir} && rm -f $(EMACSFULL) $(EMACS))
(cd $(DESTDIR)${icondir} && rm -f hicolor/*x*/apps/emacs.png hicolor/*x*/apps/emacs22.png hicolor/scalable/apps/emacs.svg hicolor/scalable/mimetypes/emacs-document.svg )
-rm -f $(DESTDIR)${desktopdir}/emacs.desktop
# ==================== Cleaning up and miscellanea ====================
-.PHONY: mostlyclean clean distclean maintainer-clean extraclean
+.PHONY: mostlyclean clean distclean bootstrap-clean maintainer-clean extraclean
### `mostlyclean'
### Like `clean', but may refrain from deleting a few files that people
-(cd doc/lispref && $(MAKE) $(MFLAGS) clean)
-(cd doc/lispintro && $(MAKE) $(MFLAGS) clean)
(cd leim; $(MAKE) $(MFLAGS) clean)
+ (cd nextstep && $(MAKE) $(MFLAGS) clean)
### `bootclean'
### Delete all files that need to be remade for a clean bootstrap.
(cd doc/lispintro && $(MAKE) $(MFLAGS) distclean)
(cd leim; $(MAKE) $(MFLAGS) distclean)
(cd lisp; $(MAKE) $(MFLAGS) distclean)
+ (cd nextstep && $(MAKE) $(MFLAGS) distclean)
${top_distclean}
### `bootstrap-clean'
-(cd doc/lispintro && $(MAKE) $(MFLAGS) maintainer-clean)
(cd leim; $(MAKE) $(MFLAGS) maintainer-clean)
(cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean)
+ (cd nextstep && $(MAKE) $(MFLAGS) maintainer-clean)
[ ! -f config.log ] || mv -f config.log config.log~
${top_bootclean}
-## configure; make bootstrap replaces the real config.log from configure
-## with the truncated one from config.status. The former is more useful.
### `maintainer-clean'
### Delete everything from the current directory that can be
### the coding standards seem to come from. It's like distclean, but
### it deletes backup and autosave files too.
extraclean:
- for i in ${SUBDIR} leim; do (cd $$i; $(MAKE) $(MFLAGS) extraclean); done
+ for i in ${SUBDIR}; do (cd $$i; $(MAKE) $(MFLAGS) extraclean); done
${top_maintainer_clean}
-rm -f config-tmp-*
-rm -f *~ \#*
# The src subdir knows how to do the right thing
# even when the build directory and source dir are different.
+.PHONY: TAGS tags
TAGS tags: lib lib-src src
cd src; $(MAKE) $(MFLAGS) tags
dist:
cd ${srcdir}; ./make-dist
-.PHONY: info dvi dist check html
+.PHONY: info dvi dist check html info-real force-info check-info-dir
info-real:
(cd doc/emacs; $(MAKE) $(MFLAGS) info)
case $${file} in \
*-[0-9]*|COPYING|dir) continue ;; \
esac ; \
+ file=`echo $${file} | sed 's/\.info//'` ; \
grep -q -F ": ($${file})." dir || missing="$${missing} $${file}" ; \
done ; \
if test -n "$${missing}"; then \
.PHONY: bootstrap
-## configure; make bootstrap replaces the real config.log from configure
-## with the truncated one from config.status. The former is more useful.
+# Bootstrapping does the following:
+# * Remove files to start from a bootstrap-clean slate.
+# * Run autogen.sh, falling back on copy_autogen if autogen.sh fails.
+# * Rebuild Makefile, to update the build procedure itself.
+# * Do the actual build.
bootstrap: bootstrap-clean FRC
- if [ -x ./config.status ]; then \
- ./config.status; \
- else \
- ./configure $(CONFIGURE_FLAGS); \
- fi
+ cd $(srcdir) && { ./autogen.sh || autogen/copy_autogen; }
+ $(MAKE) $(MFLAGS) MAKEFILE_NAME=force-Makefile force-Makefile
$(MAKE) $(MFLAGS) info all
.PHONY: check-declare
See the end of the file for license conditions.
-This directory tree holds version 24.2 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
process of building and installing Emacs. See INSTALL for more
detailed information.
-The file `configure.in' is the input used by the autoconf program to
+The file `configure.ac' is the input used by the autoconf program to
construct the `configure' script. Since Emacs has some configuration
requirements that autoconf can't meet directly, and for historical
-reasons, `configure.in' uses an unholy marriage of custom-baked
-configuration code and autoconf macros. If you want to rebuild
-`configure' from `configure.in', you will need to install a recent
-version of autoconf and GNU m4.
+reasons, `configure.ac' uses an unholy marriage of custom-baked
+configuration code and autoconf macros.
+
+The shell script `autogen.sh' generates 'configure' and other files by
+running the GNU build tools autoconf and automake, which in turn use
+GNU m4 and Perl. If you want to use it, you will need to install
+recent versions of these build tools. This should be needed only if
+you edit files like `configure.ac' that specify Emacs's autobuild
+procedure.
The file `Makefile.in' is a template used by `configure' to create
`Makefile'.
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.
__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 **
(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.
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.
-USE_LISP_UNION_TYPE Define it in lisp.h to make Lisp_Object be a union type instead of the default int.
+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
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.
-
-** Replace, the definition is trivial: SWITCH_ENUM_CAST
-
-** Defines from src/m/*.h and 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/[sm]/*.h.
+USER_FULL_NAME If defined, overrides the default pw->pw_gecos for
+getting at the full user name. Only MSDOS overrides the default.
+** Miscellaneous defines. Some of these might not be used in the code
+anymore, so they can be removed.
-AIX
AMPERSAND_FULL_NAME
-BITS_PER_EMACS_INT
-BITS_PER_LONG
-BITS_PER_CHAR
-BITS_PER_SHORT
-BITS_PER_INT
BROKEN_DATAGRAM_SOCKETS
BROKEN_FIONREAD
+BROKEN_GETWD
BROKEN_GET_CURRENT_DIR_NAME
BROKEN_NON_BLOCKING_CONNECT
BROKEN_PTY_READ_AFTER_EAGAIN
-BROKEN_SA_RESTART
-BROKEN_SIGAIO
-BROKEN_SIGIO
-BROKEN_SIGPOLL
-BROKEN_SIGPTY
-BSD4_2
-BSD4_3
-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_CBRT
+HAVE_ALARM
+HAVE_ALLOCA
+HAVE_ALLOCA_H
+HAVE_ALSA
+HAVE_ATTRIBUTE_ALIGNED
+HAVE_BDFFONT
+HAVE_BOXES
+HAVE_C99_STRTOLD
+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_FMOD
+HAVE_FCNTL_H
+HAVE_FORK
HAVE_FPATHCONF
-HAVE_FREXP
+HAVE_FREEIFADDRS
+HAVE_FREETYPE
+HAVE_FSEEKO
HAVE_FSYNC
-HAVE_FTIME
+HAVE_FUTIMENS
+HAVE_FUTIMES
+HAVE_FUTIMESAT
+HAVE_GAI_STRERROR
+HAVE_GCONF
+HAVE_GETADDRINFO
HAVE_GETCWD
-HAVE_GETDOMAINNAME
+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_INVERSE_HYPERBOLIC
+HAVE_INTTYPES_H
+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_LOGB
+HAVE_LOCALTIME_R
+HAVE_LOCAL_SOCKETS
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_MKDIR
-HAVE_MKTIME
+HAVE_MKSTEMP
+HAVE_MMAP
HAVE_MOUSE
-HAVE_PERROR
+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_RENAME
+HAVE_READLINK
+HAVE_READLINKAT
+HAVE_RECVFROM
HAVE_RES_INIT
HAVE_RINT
-HAVE_RMDIR
+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_STRERROR
-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_SYSINFO
-HAVE_SYSV_SIGPAUSE
+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
-LISP_FLOAT_TYPE
-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
-NO_MATHERR
-NO_TERMIO
NSIG
NSIG_MINIMUM
-NULL
NULL_DEVICE
ORDINARY_LINK
-O_APPEND
O_RDONLY
O_RDWR
PAGESIZE
PENDING_OUTPUT_COUNT
-POSIX
PREFER_VSUSP
PTY_ITERATION
PTY_NAME_SPRINTF
PTY_TTY_NAME_SPRINTF
PURESIZE
RUN_TIME_REMAP
-SA_RESTART
-SEGMENT_MASK
SETPGRP_RELEASES_CTTY
SETUP_SLAVE_PTY
SIGALRM
SIGPIPE
SIGQUIT
SIGTRAP
-SOLARIS2
STDC_HEADERS
SYSTEM_PURESIZE_EXTRA
SYSTEM_MALLOC
-SYSV_SYSTEM_DIR
TAB3
TABDLY
TERM
TM_IN_SYS_TIME
ULIMIT_BREAK_VALUE
UNIX98_PTYS
-USE_CRT_DLL
USE_TOOLKIT_SCROLL_BARS
-USG
-USG5
-USG5_4
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/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
-const
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
-strerror
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
+lseek
+mkdir
+mktemp
+open
+pclose
+pipe
+popen
+rmdir
+rindex
+sleep
+umask
+unlink
+utime
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-27 Glenn Morris <rgm@gnu.org>
- * Version 24.2 released.
+ * admin.el (set-version): Set msdos.c's Vwindow_system_version.
-2012-08-10 Glenn Morris <rgm@gnu.org>
+2012-09-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check more robustly for timer_settime.
+ * merge-gnulib (GNULIB_MODULES): Add timer-time.
+
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * unidata/BidiMirroring.txt:
+ * unidata/UnicodeData.txt: Update to Unicode 6.2.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (add-log-time-format): Declare.
+
+ * admin.el (cusver-scan, cusver-check): Bind local variables.
+
+ * admin.el (set-version): Set major version in
+ etc/refcards/ru-refcard.tex and etc/refcards/emacsver.tex.
+ (set-copyright): In etc/refcards, only change ru-refcard.tex
+ and emacsver.tex.
+
+ * admin.el (set-copyright): No more need to set copyrights for
+ nextstep, or .c files. Add configure.ac and config.nt.
+
+2012-09-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove configure's --without-sync-input option (Bug#12450).
+ * CPP-DEFINES (BROKEN_SA_RESTART, SA_RESTART): Remove.
+
+2012-09-16 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (set-version): No more need to set nextstep versions.
+ (set-copyright): Update for moved nextstep files.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify SIGIO usage (Bug#12408).
+ * CPP_DEFINES (BROKEN_SIGAIO, BROKEN_SIGIO, BROKEN_SIGPOLL)
+ (BROKEN_SIGPTY, NO_TERMIO): Remove.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ * CPP-DEFINES (HAVE_CBRT, HAVE_LOGB, logb): Remove.
+
+2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later for math functions (Bug#12381).
+ * CPP-DEFINES (HAVE_FMOD, HAVE_FREXP, FLOAT_CHECK_DOMAIN)
+ (HAVE_INVERSE_HYPERBOLIC, NO_MATHERR): Remove.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify redefinition of 'abort' (Bug#12316).
+ * CPP-DEFINES (NO_ABORT): Remove.
+
+2012-08-28 Glenn Morris <rgm@gnu.org>
+
+ * bzrmerge.el (bzrmerge-merges): Allow unversioned files in the tree.
+
+2012-08-28 Andreas Schwab <schwab@linux-m68k.org>
+
+ * charsets/mule-charsets.el (header): Fix typo.
+
+2012-08-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ On assertion failure, print backtrace if available.
+ * merge-gnulib (GNULIB_MODULES): Add execinfo.
+
+2012-08-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use ASCII tests for character types.
+ * merge-gnulib (GNULIB_MODULES): Add c-ctype. This documents a
+ new direct dependency; c-ctype was already being used indirectly
+ via other gnulib modules.
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ 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 <rgm@gnu.org>
* bzrmerge.el (bzrmerge-resolve): Disable local eval:.
-2012-07-14 Eli Zaretskii <eliz@gnu.org>
+2012-08-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/overlay.cocci, coccinelle/symbol.cocci: Remove.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to Solaris 8.
+ * CPP-DEFINES (WRETCODE): Remove.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/overlay.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct Lisp_Overlay to MVAR.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/symbol.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct Lisp_Symbol to SVAR.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/process.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct Lisp_Process to PVAR.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/window.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct window to WVAR.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/frame.cocci: Semantic patch to replace direct
+ access to Lisp_Object members of struct frame to FVAR.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib environ and stdalign modules (Bug#9772, Bug#9960).
+ * merge-gnulib: Add environ, stdalign.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/unibyte_string.cocci: Semantic patch to convert from
+ make_unibyte_string to build_unibyte_string where appropriate.
+
+2012-07-17 Eli Zaretskii <eliz@gnu.org>
* CPP-DEFINES: Remove FILE_SYSTEM_CASE.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-07-17 Chong Yidong <cyd@gnu.org>
* Version 24.1 released.
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume mkdir, perror, rename, rmdir, strerror.
+ * CPP-DEFINES (HAVE_MKDIR, HAVE_PERROR, HAVE_RENAME, HAVE_RMDIR)
+ (HAVE_STRERROR, strerror):
+ Remove.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/list_loop.cocci: Semantic patch to convert from Fcdr
+ to XCDR and consistently use CONSP in the list iteration loops.
+ * coccinelle/vector_contents.cocci: Fix indentation.
+
+2012-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * bzrmerge.el: Use cl-lib.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename configure.in to configure.ac (Bug#11603).
+ * admin.el (set-version):
+ * quick-install-emacs (VERSION):
+ Get version number from configure.ac, not configure.in.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ * merge-gnulib (GNULIB_MODULES): Add c-strcase.
+
+2012-07-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/xzalloc.cocci: Semantic patch to convert
+ calls to xmalloc with following memset to xzalloc.
+
+2012-07-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * CPP-DEFINES (LISP_FLOAT_TYPE): Remove, obsolete.
+
+2012-06-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * coccinelle/build_string.cocci: Semantic patch
+ to convert from make_string to build_string.
+
+2012-06-24 Dmitry Antipov <dmantipov@yandex.ru>
+
+ First Coccinelle semantic patch.
+ * coccinelle: New subdirectory
+ * coccinelle/README: Documentation stub.
+ * coccinelle/vector_contents.cocci: Semantic patch to replace direct
+ access to `contents' member of Lisp_Vector objects with AREF and ASET
+ where appropriate.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * merge-gnulib (GNULIB_MODULES): Add dtotimespec, gettime,
+ gettimeofday, pselect, stat-time, sys_time, time, timespec-add,
+ timespec-sub, utimens.
+ (GNULIB_TOOL_FLAGS): Add --avoid=select --avoid=sigprocmask.
+ This trims down the gnulib import, from the very latest gnulib.
+ Emacs does its own implementation of 'select' and 'sigprocmask'
+ on Windows, and it assumes 'select' and 'sigprocmask' on non-Windows
+ hosts, so it doesn't need these modules.
+ Similarly, avoid errno, fcntl, fcntl-h, fstat, and sys_types, as
+ these gnulib modules are only for Windows porting and Emacs ports
+ to Windows in a different way.
+
+2012-06-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * make-emacs: Rename --union-type to --check-lisp-type.
+ Define CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE.
+ * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Rename from
+ USE_LISP_UNION_TYPE.
+
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * quick-install-emacs (PUBLIC_LIBSRC_SCRIPTS): Remove rcs-checkin.
+
+2012-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove --disable-maintainer-mode option from 'configure'. (Bug#11555)
+ * make-tarball.txt: Don't worry about maintainer mode.
+
+2012-05-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * CPP-DEFINES: Remove HAVE_SYSINFO.
+
+2012-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume gnulib does largefile.
+ * merge-gnulib (GNULIB_MODULES): Add largefile.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * CPP-DEFINES: Do not mention src/m/*.h.
+ (BITS_PER_EMACS_INT, BITS_PER_LONG, BITS_PER_CHAR)
+ (BITS_PER_SHORT, BITS_PER_INT): Remove.
+ * MAINTAINERS: Remove src/m/.
+
+2012-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use full name for m4/gnulib-comp.m4. (Bug#11529)
+ * merge-gnulib: Leave m4/gnulib-comp.m4's name alone.
+
+ Assume C89 or later.
+ * CPP-DEFINES: Remove NULL, const.
+
+ Make merging from gnulib a script, not a makefile action.
+ * merge-gnulib: New script, with actions moved here from
+ ../Makefile.in.
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * CPP-DEFINES (HAVE_GETDOMAINNAME): Remove.
+
+ * CPP-DEFINES (HAVE_FTIME): Remove.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * bzrmerge.el (bzrmerge-skip-regexp): Add "Auto-commit".
+
+2012-04-10 Glenn Morris <rgm@gnu.org>
+
+ * bzrmerge.el (bzrmerge-skip-regexp): Add "from trunk".
+
+ * unidata/Makefile.in: Add FSF copyright.
+ Make it use autoconf features, and work for out-of-tree builds.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * unidata/README:
+ * unidata/copyright.html:
+ * unidata/BidiMirroring.txt:
+ * unidata/UnicodeData.txt: Update for the latest version 6.1 of
+ the Unicode Standard.
+
2012-02-16 Kenichi Handa <handa@m17n.org>
* unidata/unidata-gen.el (unidata-prop-alist): Change the default
* unidata/makefile.w32-in (all): Remove src/biditype.h and
src/bidimirror.h.
- (../../src/biditype.h, ../../src/bidimirror.h): Deleted.
+ (../../src/biditype.h, ../../src/bidimirror.h): Delete.
* unidata/Makefile.in (all): Remove src/biditype.h and
src/bidimirror.h.
- (../../src/biditype.h, ../../src/bidimirror.h): Deleted.
+ (../../src/biditype.h, ../../src/bidimirror.h): Delete.
2011-07-07 Juanma Barranquero <lekktu@gmail.com>
* unidata/unidata-gen.el (unidata-dir): New variable.
(unidata-setup-list): Expand unidata-text-file in unidata-dir.
- (unidata-prop-alist): INDEX element may be a function. New
- optional element VAL-LIST (for general-category and bidi-class).
+ (unidata-prop-alist): INDEX element may be a function.
+ New optional element VAL-LIST (for general-category and bidi-class).
New entry `mirroring'.
(unidata-prop-default, unidata-prop-val-list): New subst.
(unidata-get-character, unidata-put-character): Delete them.
2009-04-17 Kenichi Handa <handa@m17n.org>
- * unidata/unidata-gen.el (unidata-get-decomposition): Adjust
- Hangle decomposition rule to Unicode.
+ * unidata/unidata-gen.el (unidata-get-decomposition):
+ Adjust Hangle decomposition rule to Unicode.
2009-04-09 Kenichi Handa <handa@m17n.org>
- * unidata/unidata-gen.el (unidata-describe-decomposition): Return
- a string with a composition property to disable combining
+ * unidata/unidata-gen.el (unidata-describe-decomposition):
+ Return a string with a composition property to disable combining
characters being composed.
2009-03-11 Miles Bader <miles@gnu.org>
2009-02-23 Jason Rumney <jasonr@gnu.org>
- * nt/README-ftp-server: Update for 23.0.91
+ * nt/README-ftp-server: Update for 23.0.91.
* nt/README.W32: Remove ever expanding versions of Windows.
Shorten FAQ URL. Remove mention of obsolete lock directory.
2005-10-17 Bill Wohler <wohler@newt.com>
- * FOR-RELEASE (DOCUMENTATION): Removed lisp/toolbar from list
+ * FOR-RELEASE (DOCUMENTATION): Remove lisp/toolbar from list
since it's gone. Also marked mh-e as done.
2005-10-11 Juanma Barranquero <lekktu@gmail.com>
2005-03-30 Marcelo Toledo <marcelo@marcelotoledo.org>
- * FOR-RELEASE (Documentation): Added check the Emacs Tutorial.
+ * FOR-RELEASE (Documentation): Add check the Emacs Tutorial.
The first line of every tutorial must begin with a sentence saying
"Emacs Tutorial" in the respective language. This should be
followed by "See end for copying conditions", likewise in the
;; coding: utf-8
;; End:
- Copyright (C) 2001-2012 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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
src/image.c
src/lastfile.c
src/lread.c
-src/m/
src/macros.c
src/makefile.w32-in
src/marker.c
src/process.c
src/ralloc.c
src/region-cache.c
-src/s/
src/scroll.c
src/search.c
src/sound.c
src/xrdb.c
src/xselect.c
src/xterm.c
-
;;; Code:
+(defvar add-log-time-format) ; in add-log
+
(defun add-release-logs (root version)
"Add \"Version VERSION released.\" change log entries in ROOT.
Root must be the root of an Emacs source tree."
(set-version-in-file root "README" version
(rx (and "version" (1+ space)
(submatch (1+ (in "0-9."))))))
- (set-version-in-file root "configure.in" version
+ (set-version-in-file root "configure.ac" version
(rx (and "AC_INIT" (1+ (not (in ?,)))
?, (0+ space)
(submatch (1+ (in "0-9."))))))
(set-version-in-file root "nt/emacsclient.rc" comma-space-version
(rx (and "\"ProductVersion\"" (0+ space) ?,
(0+ space) ?\" (submatch (1+ (in "0-9, ")))
- "\\0\""))))
- ;; nextstep.
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Info.plist"
- version (rx (and "CFBundleGetInfoString" (1+ anything) "Emacs" (1+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Info.plist"
- version (rx (and "CFBundleShortVersionString" (1+ not-newline) ?\n
- (0+ not-newline) "<string>" (0+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings"
- version (rx (and "CFBundleShortVersionString" (0+ space) ?= (0+ space)
- ?\" (0+ space) "Version" (1+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings"
- version (rx (and "CFBundleGetInfoString" (0+ space) ?= (0+ space)
- ?\" (0+ space) "Emacs version" (1+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist"
- version (rx (and "ApplicationRelease" (0+ space) ?= (0+ space)
- ?\" (0+ space) (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist"
- version (rx (and "FullVersionID" (0+ space) ?= (0+ space)
- ?\" (0+ space) "Emacs" (1+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file
- root "nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop"
- version (rx (and "Version=" (submatch (1+ (in "0-9.")))))))
+ "\\0\"")))
+ ;; Major version only.
+ (when (string-match "\\([0-9]\\{2,\\}\\)" version)
+ (setq version (match-string 1 version))
+ (set-version-in-file root "src/msdos.c" version
+ (rx (and "Vwindow_system_version" (1+ not-newline)
+ ?\( (submatch (1+ (in "0-9"))) ?\))))
+ (set-version-in-file root "etc/refcards/ru-refcard.tex" version
+ "\\\\newcommand{\\\\versionemacs}\\[0\\]\
+{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs")
+ (set-version-in-file root "etc/refcards/emacsver.tex" version
+ "\\\\def\\\\versionemacs\
+{\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs"))))
+
;; Note this makes some assumptions about form of short copyright.
(defun set-copyright (root copyright)
(format-time-string "%Y")))))
(unless (file-exists-p (expand-file-name "src/emacs.c" root))
(error "%s doesn't seem to be the root of an Emacs source tree" root))
- (set-version-in-file root "src/emacs.c" copyright
- (rx (and "emacs_copyright" (0+ (not (in ?\")))
- ?\" (submatch (1+ (not (in ?\")))) ?\")))
- (set-version-in-file root "lib-src/ebrowse.c" copyright
- (rx (and "emacs_copyright" (0+ (not (in ?\")))
- ?\" (submatch (1+ (not (in ?\")))) ?\")))
- (set-version-in-file root "lib-src/etags.c" copyright
- (rx (and "emacs_copyright" (0+ (not (in ?\")))
+ (set-version-in-file root "configure.ac" copyright
+ (rx (and bol "copyright" (0+ (not (in ?\")))
?\" (submatch (1+ (not (in ?\")))) ?\")))
+ (set-version-in-file root "nt/config.nt" copyright
+ (rx (and bol "#" (0+ blank) "define" (1+ blank)
+ "COPYRIGHT" (1+ blank)
+ ?\" (submatch (1+ (not (in ?\")))) ?\")))
(set-version-in-file root "lib-src/rcs2log" copyright
(rx (and "Copyright" (0+ space) ?= (0+ space)
?\' (submatch (1+ nonl)))))
- ;; This one is a nuisance, as it needs to be split over two lines.
- (string-match "\\(.*[0-9]\\{4\\} *\\)\\(.*\\)" copyright)
- ;; nextstep.
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Info.plist"
- copyright (rx (and "CFBundleGetInfoString" (1+ anything) "Emacs" (1+ space)
- (1+ (in "0-9.")) (1+ space)
- (submatch (1+ (not (in ?\<)))))))
- (set-version-in-file
- root "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings"
- copyright (rx (and "NSHumanReadableCopyright" (0+ space) ?\= (0+ space)
- ?\" (submatch (1+ (not (in ?\")))))))
- (set-version-in-file
- root "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist"
- copyright (rx (and "Copyright" (0+ space) ?\= (0+ space)
- ?\" (submatch (1+ (not (in ?\")))))))
(when (string-match "\\([0-9]\\{4\\}\\)" copyright)
(setq copyright (match-string 1 copyright))
- (dolist (file (directory-files (expand-file-name "etc/refcards" root)
- t "\\.tex\\'"))
- (unless (string-match "gnus-refcard\\.tex" file)
- (set-version-in-file
- root file copyright
- (concat (if (string-match "ru-refcard\\.tex" file)
- "\\\\newcommand{\\\\cyear}\\[0\\]{"
- "\\\\def\\\\year{")
- "\\([0-9]\\{4\\}\\)}.+%.+copyright year"))))))
+ (set-version-in-file root "etc/refcards/ru-refcard.tex" copyright
+ "\\\\newcommand{\\\\cyear}\\[0\\]\
+{\\([0-9]\\{4\\}\\)}.+%.+copyright year")
+ (set-version-in-file root "etc/refcards/emacsver.tex" copyright
+ "\\\\def\\\\year\
+{\\([0-9]\\{4\\}\\)}.+%.+copyright year")))
;;; Various bits of magic for generating the web manuals
(manual-txt texi (expand-file-name "emacs.txt" txt-dir))
(manual-pdf texi (expand-file-name "emacs.pdf" dest))
(manual-dvi texi (expand-file-name "emacs.dvi" dvi-dir)
- (expand-file-name "emacs.ps" ps-dir)))
+ (expand-file-name "emacs.ps" ps-dir)))
;; Lisp manual
(let ((texi (expand-file-name "doc/lispref/elisp.texi" root)))
(manual-html-node texi (expand-file-name "elisp" html-node-dir))
(manual-txt texi (expand-file-name "elisp.txt" txt-dir))
(manual-pdf texi (expand-file-name "elisp.pdf" dest))
(manual-dvi texi (expand-file-name "elisp.dvi" dvi-dir)
- (expand-file-name "elisp.ps" ps-dir)))
+ (expand-file-name "elisp.ps" ps-dir)))
+ ;; Misc manuals
+ (let ((manuals '("ada-mode" "auth" "autotype" "calc" "cc-mode"
+ "cl" "dbus" "dired-x" "ebrowse" "ede" "ediff"
+ "edt" "eieio" "emacs-mime" "epa" "erc" "ert"
+ "eshell" "eudc" "faq" "flymake" "forms"
+ "gnus" "emacs-gnutls" "idlwave" "info"
+ "mairix-el" "message" "mh-e" "newsticker"
+ "nxml-mode" "org" "pcl-cvs" "pgg" "rcirc"
+ "remember" "reftex" "sasl" "sc" "semantic"
+ "ses" "sieve" "smtpmail" "speedbar" "tramp"
+ "url" "vip" "viper" "widget" "woman")))
+ (dolist (manual manuals)
+ (manual-misc-html manual root html-node-dir html-mono-dir)))
(message "Manuals created in %s" dest)))
(defconst manual-doctype-string
(defconst manual-style-string "<style type=\"text/css\">
@import url('/style.css');\n</style>\n")
+(defun manual-misc-html (name root html-node-dir html-mono-dir)
+ (let ((texi (expand-file-name (format "doc/misc/%s.texi" name) root)))
+ (manual-html-node texi (expand-file-name name html-node-dir))
+ (manual-html-mono texi (expand-file-name (concat name ".html")
+ html-mono-dir))))
+
(defun manual-html-mono (texi-file dest)
"Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST.
This function also edits the HTML files so that they validate as
(let (copyright-text)
(manual-html-fix-index-1)
;; Move copyright notice to the end.
- (re-search-forward "[ \t]*<p>Copyright ©")
- (setq opoint (match-beginning 0))
- (re-search-forward "</blockquote>")
- (setq copyright-text (buffer-substring opoint (point)))
- (delete-region opoint (point))
+ (when (re-search-forward "[ \t]*<p>Copyright ©" nil t)
+ (setq opoint (match-beginning 0))
+ (re-search-forward "</blockquote>")
+ (setq copyright-text (buffer-substring opoint (point)))
+ (delete-region opoint (point)))
(manual-html-fix-index-2)
- (insert copyright-text "\n</div>\n"))
+ (if copyright-text
+ (insert copyright-text))
+ (insert "\n</div>\n"))
;; For normal nodes, give the header div a blue bg.
(manual-html-fix-node-div))
(save-buffer))))))
(defun manual-html-fix-index-1 ()
(let (opoint)
- (re-search-forward "<body>\n\\(<h1 class=\"settitle\\)")
- (setq opoint (match-beginning 1))
- (search-forward "<h2 class=\"unnumbered")
+ (re-search-forward "<body>\n")
+ (setq opoint (match-end 0))
+ (search-forward "<h2 class=\"")
(goto-char (match-beginning 0))
(delete-region opoint (point))
(insert "<div id=\"content\" class=\"inner\">\n\n")))
"Replace the index list in the current buffer with a HTML table."
(let (done open-td tag desc)
;; Convert the list that Makeinfo made into a table.
- (search-forward "<ul class=\"menu\">")
+ (or (search-forward "<ul class=\"menu\">" nil t)
+ (search-forward "<ul>"))
(replace-match "<table style=\"float:left\" width=\"100%\">")
(forward-line 1)
(while (not done)
(replace-match " </td></tr></table>\n
<h3>Detailed Node Listing</h3>\n\n" t t)
(search-forward "<p>")
- (search-forward "<p>")
+ (search-forward "<p>" nil t)
(goto-char (match-beginning 0))
(skip-chars-backward "\n ")
(setq open-td nil)
(setq open-td nil))
(insert " <tr>
<th colspan=\"2\" align=\"left\" style=\"text-align:left\">")
- (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">")
- (replace-match " </th></tr>"))
+ (if (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">" nil t)
+ (replace-match " </th></tr>")))
((looking-at "[ \t]*</ul>[ \t]*$")
(replace-match
(if open-td
(setq done t))
(t
(if (eobp)
- (error "Parse error in %s" f))
+ (error "Parse error in %s" f)) ; f is bound in manual-html-node
(unless open-td
(setq done t))))
(forward-line 1))))
(let ((m (format "Scanning %s..." file))
(re (format "^[ \t]*\\((def%s\\)[ \t\n]"
(if old "\\(?:custom\\|var\\)" "custom")))
- alist var ver)
+ alist var ver form)
(message "%s" m)
(with-temp-buffer
(insert-file-contents file)
(mapcar
(lambda (file)
(cons file (cusver-scan file))) newfiles)))
- oldcus result thisfile)
+ oldcus result thisfile file)
(message "Reading old defcustoms...")
(dolist (file oldfiles)
(setq oldcus (append oldcus (cusver-scan file t))))
;;; bzrmerge.el --- help merge one Emacs bzr branch to another
-;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Keywords:
+;; Keywords: maint
;; 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
;;; Code:
-(eval-when-compile
- (require 'cl)) ; assert
+(eval-when-compile (require 'cl-lib))
(defvar bzrmerge-skip-regexp
- "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version"
+ "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\
+Auto-commit"
"Regexp matching logs of revisions that might be skipped.
`bzrmerge-missing' will ask you if it should skip any matches.")
(erase-buffer)
;; We generally want to make sure we start with a clean tree, but we also
;; want to allow restarts (i.e. with some part of FROM already merged but
- ;; not yet committed).
+ ;; not yet committed). Unversioned (unknown) files in the tree
+ ;; are also ok.
(call-process "bzr" nil t nil "status" "-v")
(goto-char (point-min))
(when (re-search-forward "^conflicts:\n" nil t)
(error "You still have unresolved conflicts"))
- (let ((merges ()))
+ (let ((merges ())
+ found)
(if (not (re-search-forward "^pending merges:\n" nil t))
(when (save-excursion
(goto-char (point-min))
- (re-search-forward "^[a-z ]*:\n" nil t))
+ (while (and
+ (re-search-forward "^\\([a-z ]*\\):\n" nil t)
+ (not
+ (setq found
+ (not (equal "unknown" (match-string 1)))))))
+ found)
(error "You still have uncommitted changes"))
;; This is really stupid, but it seems there's no easy way to figure
;; out which revisions have been merged already. The only info I can
`N' to include it and go on to the next revision,
`n' to not skip, but continue to search this log entry for skip regexps,
`q' to quit merging."))
- (case (save-excursion
+ (pcase (save-excursion
(read-char-choice
(format "%s: Skip (y/n/N/q/%s)? " str
(key-description (vector help-char)))
'(?y ?n ?N ?q)))
- (?y (setq skip t))
- (?q (keyboard-quit))
+ (`?y (setq skip t))
+ (`?q (keyboard-quit))
;; A single log entry can match skip-regexp multiple
;; times. If you are sure you don't want to skip it,
;; you don't want to be asked multiple times.
- (?N (setq skip 'no))))))
+ (`?N (setq skip 'no))))))
(if (eq skip t)
(push revno skipped)
(push revno revnos)))))
;; Do a "skip" (i.e. merge the meta-data only).
(setq beg (1- (car skip)))
(while (and skip (or (null merge) (< (car skip) (car merge))))
- (assert (> (car skip) (or end beg)))
+ (cl-assert (> (car skip) (or end beg)))
(setq end (pop skip)))
(message "Skipping %s..%s" beg end)
(bzrmerge-add-metadata from end))
(t
;; Do a "normal" merge.
- (assert (or (null skip) (< (car merge) (car skip))))
+ (cl-assert (or (null skip) (< (car merge) (car skip))))
(setq beg (1- (car merge)))
(while (and merge (or (null skip) (< (car merge) (car skip))))
- (assert (> (car merge) (or end beg)))
+ (cl-assert (> (car merge) (or end beg)))
(setq end (pop merge)))
(message "Merging %s..%s" beg end)
(if (with-temp-buffer
(defconst header
(format
- "# Generated by running amdin/charsets/mule-charsets.el in Emacs %d.%d.\n"
+ "# Generated by running admin/charsets/mule-charsets.el in Emacs %d.%d.\n"
emacs-major-version emacs-minor-version))
(dolist (elt charset-alist)
--- /dev/null
+This directory contains semantic patches for Coccinelle, a program matching
+and transformation tool for programs written in C. For more details, see
+http://coccinelle.lip6.fr.
--- /dev/null
+// Convert simple cases to build_string.
+@@
+identifier I;
+@@
+- make_string (I, strlen (I))
++ build_string (I)
--- /dev/null
+// Change direct access to Lisp_Object fields of struct frame to FVAR.
+@@
+expression F;
+@@
+(
+- F->icon_name
++ FVAR (F, icon_name)
+|
+- F->title
++ FVAR (F, title)
+|
+- F->focus_frame
++ FVAR (F, focus_frame)
+|
+- F->root_window
++ FVAR (F, root_window)
+|
+- F->selected_window
++ FVAR (F, selected_window)
+|
+- F->minibuffer_window
++ FVAR (F, minibuffer_window)
+|
+- F->param_alist
++ FVAR (F, param_alist)
+|
+- F->scroll_bars
++ FVAR (F, scroll_bars)
+|
+- F->condemned_scroll_bars
++ FVAR (F, condemned_scroll_bars)
+|
+- F->menu_bar_items
++ FVAR (F, menu_bar_items)
+|
+- F->face_alist
++ FVAR (F, face_alist)
+|
+- F->menu_bar_vector
++ FVAR (F, menu_bar_vector)
+|
+- F->buffer_predicate
++ FVAR (F, buffer_predicate)
+|
+- F->buffer_list
++ FVAR (F, buffer_list)
+|
+- F->buried_buffer_list
++ FVAR (F, buried_buffer_list)
+|
+- F->menu_bar_window
++ FVAR (F, menu_bar_window)
+|
+- F->tool_bar_window
++ FVAR (F, tool_bar_window)
+|
+- F->tool_bar_items
++ FVAR (F, tool_bar_items)
+|
+- F->tool_bar_position
++ FVAR (F, tool_bar_position)
+|
+- F->desired_tool_bar_string
++ FVAR (F, desired_tool_bar_string)
+|
+- F->current_tool_bar_string
++ FVAR (F, current_tool_bar_string)
+
+|
+
+- XFRAME (F)->icon_name
++ FVAR (XFRAME (F), icon_name)
+|
+- XFRAME (F)->title
++ FVAR (XFRAME (F), title)
+|
+- XFRAME (F)->focus_frame
++ FVAR (XFRAME (F), focus_frame)
+|
+- XFRAME (F)->root_window
++ FVAR (XFRAME (F), root_window)
+|
+- XFRAME (F)->selected_window
++ FVAR (XFRAME (F), selected_window)
+|
+- XFRAME (F)->minibuffer_window
++ FVAR (XFRAME (F), minibuffer_window)
+|
+- XFRAME (F)->param_alist
++ FVAR (XFRAME (F), param_alist)
+|
+- XFRAME (F)->scroll_bars
++ FVAR (XFRAME (F), scroll_bars)
+|
+- XFRAME (F)->condemned_scroll_bars
++ FVAR (XFRAME (F), condemned_scroll_bars)
+|
+- XFRAME (F)->menu_bar_items
++ FVAR (XFRAME (F), menu_bar_items)
+|
+- XFRAME (F)->face_alist
++ FVAR (XFRAME (F), face_alist)
+|
+- XFRAME (F)->menu_bar_vector
++ FVAR (XFRAME (F), menu_bar_vector)
+|
+- XFRAME (F)->buffer_predicate
++ FVAR (XFRAME (F), buffer_predicate)
+|
+- XFRAME (F)->buffer_list
++ FVAR (XFRAME (F), buffer_list)
+|
+- XFRAME (F)->buried_buffer_list
++ FVAR (XFRAME (F), buried_buffer_list)
+|
+- XFRAME (F)->menu_bar_window
++ FVAR (XFRAME (F), menu_bar_window)
+|
+- XFRAME (F)->tool_bar_window
++ FVAR (XFRAME (F), tool_bar_window)
+|
+- XFRAME (F)->tool_bar_items
++ FVAR (XFRAME (F), tool_bar_items)
+|
+- XFRAME (F)->tool_bar_position
++ FVAR (XFRAME (F), tool_bar_position)
+|
+- XFRAME (F)->desired_tool_bar_string
++ FVAR (XFRAME (F), desired_tool_bar_string)
+|
+- XFRAME (F)->current_tool_bar_string
++ FVAR (XFRAME (F), current_tool_bar_string)
+)
--- /dev/null
+// Omit redundant type check, consistently use CONSP.
+@@
+identifier A;
+expression X;
+statement S;
+@@
+(
+for (A = X;
+- !NILP (A);
++ CONSP (A);
+- A = Fcdr (A))
++ A = XCDR (A))
+S
+|
+for (A = X; CONSP (A);
+- A = Fcdr (A))
++ A = XCDR (A))
+S
+)
--- /dev/null
+// Change direct access to Lisp_Object fields of struct Lisp_Process to PVAR.
+@@
+struct Lisp_Process *P;
+Lisp_Object O;
+@@
+(
+- P->tty_name
++ PVAR (P, tty_name)
+|
+- P->name
++ PVAR (P, name)
+|
+- P->command
++ PVAR (P, command)
+|
+- P->filter
++ PVAR (P, filter)
+|
+- P->sentinel
++ PVAR (P, sentinel)
+|
+- P->log
++ PVAR (P, log)
+|
+- P->buffer
++ PVAR (P, buffer)
+|
+- P->childp
++ PVAR (P, childp)
+|
+- P->plist
++ PVAR (P, plist)
+|
+- P->type
++ PVAR (P, type)
+|
+- P->mark
++ PVAR (P, mark)
+|
+- P->status
++ PVAR (P, status)
+|
+- P->decode_coding_system
++ PVAR (P, decode_coding_system)
+|
+- P->decoding_buf
++ PVAR (P, decoding_buf)
+|
+- P->encode_coding_system
++ PVAR (P, encode_coding_system)
+|
+- P->encoding_buf
++ PVAR (P, encoding_buf)
+|
+- P->write_queue
++ PVAR (P, write_queue)
+
+|
+
+- XPROCESS (O)->tty_name
++ PVAR (XPROCESS (O), tty_name)
+|
+- XPROCESS (O)->name
++ PVAR (XPROCESS (O), name)
+|
+- XPROCESS (O)->command
++ PVAR (XPROCESS (O), command)
+|
+- XPROCESS (O)->filter
++ PVAR (XPROCESS (O), filter)
+|
+- XPROCESS (O)->sentinel
++ PVAR (XPROCESS (O), sentinel)
+|
+- XPROCESS (O)->log
++ PVAR (XPROCESS (O), log)
+|
+- XPROCESS (O)->buffer
++ PVAR (XPROCESS (O), buffer)
+|
+- XPROCESS (O)->childp
++ PVAR (XPROCESS (O), childp)
+|
+- XPROCESS (O)->plist
++ PVAR (XPROCESS (O), plist)
+|
+- XPROCESS (O)->type
++ PVAR (XPROCESS (O), type)
+|
+- XPROCESS (O)->mark
++ PVAR (XPROCESS (O), mark)
+|
+- XPROCESS (O)->status
++ PVAR (XPROCESS (O), status)
+|
+- XPROCESS (O)->decode_coding_system
++ PVAR (XPROCESS (O), decode_coding_system)
+|
+- XPROCESS (O)->decoding_buf
++ PVAR (XPROCESS (O), decoding_buf)
+|
+- XPROCESS (O)->encode_coding_system
++ PVAR (XPROCESS (O), encode_coding_system)
+|
+- XPROCESS (O)->encoding_buf
++ PVAR (XPROCESS (O), encoding_buf)
+|
+- XPROCESS (O)->write_queue
++ PVAR (XPROCESS (O), write_queue)
+)
--- /dev/null
+// make_unibyte_string (str, strlen (str)) -> build_unibyte_string (str)
+@@
+identifier I;
+@@
+- make_unibyte_string (I, strlen (I))
++ build_unibyte_string (I)
--- /dev/null
+// Avoid direct access to `contents' member of
+// Lisp_Vector, use AREF and ASET where possible.
+@expression@
+identifier I1, I2;
+expression E1, E2;
+@@
+(
+- XVECTOR (I1)->contents[I2++] = E1
++ ASET (I1, I2, E1), I2++
+|
+- XVECTOR (I1)->contents[E1] = E2
++ ASET (I1, E1, E2)
+|
+- XVECTOR (I1)->contents[E1]
++ AREF (I1, E1)
+)
--- /dev/null
+// Change direct access to Lisp_Object fields of struct window to WVAR.
+@@
+struct window *W;
+Lisp_Object O;
+@@
+(
+- W->frame
++ WVAR (W, frame)
+|
+- W->next
++ WVAR (W, next)
+|
+- W->prev
++ WVAR (W, prev)
+|
+- W->hchild
++ WVAR (W, hchild)
+|
+- W->vchild
++ WVAR (W, vchild)
+|
+- W->parent
++ WVAR (W, parent)
+|
+- W->left_col
++ WVAR (W, left_col)
+|
+- W->top_line
++ WVAR (W, top_line)
+|
+- W->total_lines
++ WVAR (W, total_lines)
+|
+- W->total_cols
++ WVAR (W, total_cols)
+|
+- W->normal_lines
++ WVAR (W, normal_lines)
+|
+- W->normal_cols
++ WVAR (W, normal_cols)
+|
+- W->new_total
++ WVAR (W, new_total)
+|
+- W->new_normal
++ WVAR (W, new_normal)
+|
+- W->buffer
++ WVAR (W, buffer)
+|
+- W->start
++ WVAR (W, start)
+|
+- W->pointm
++ WVAR (W, pointm)
+|
+- W->temslot
++ WVAR (W, temslot)
+|
+- W->vertical_scroll_bar
++ WVAR (W, vertical_scroll_bar)
+|
+- W->left_margin_cols
++ WVAR (W, left_margin_cols)
+|
+- W->right_margin_cols
++ WVAR (W, right_margin_cols)
+|
+- W->left_fringe_width
++ WVAR (W, left_fringe_width)
+|
+- W->right_fringe_width
++ WVAR (W, right_fringe_width)
+|
+- W->scroll_bar_width
++ WVAR (W, scroll_bar_width)
+|
+- W->vertical_scroll_bar_type
++ WVAR (W, vertical_scroll_bar_type)
+|
+- W->window_end_pos
++ WVAR (W, window_end_pos)
+|
+- W->window_end_vpos
++ WVAR (W, window_end_vpos)
+|
+- W->window_end_valid
++ WVAR (W, window_end_valid)
+|
+- W->display_table
++ WVAR (W, display_table)
+|
+- W->dedicated
++ WVAR (W, dedicated)
+|
+- W->base_line_number
++ WVAR (W, base_line_number)
+|
+- W->base_line_pos
++ WVAR (W, base_line_pos)
+|
+- W->region_showing
++ WVAR (W, region_showing)
+|
+- W->column_number_displayed
++ WVAR (W, column_number_displayed)
+|
+- W->redisplay_end_trigger
++ WVAR (W, redisplay_end_trigger)
+|
+- W->combination_limit
++ WVAR (W, combination_limit)
+|
+- W->prev_buffers
++ WVAR (W, prev_buffers)
+|
+- W->next_buffers
++ WVAR (W, next_buffers)
+|
+- W->window_parameters
++ WVAR (W, window_parameters)
+
+|
+
+- XWINDOW (O)->frame
++ WVAR (XWINDOW (O), frame)
+|
+- XWINDOW (O)->next
++ WVAR (XWINDOW (O), next)
+|
+- XWINDOW (O)->prev
++ WVAR (XWINDOW (O), prev)
+|
+- XWINDOW (O)->hchild
++ WVAR (XWINDOW (O), hchild)
+|
+- XWINDOW (O)->vchild
++ WVAR (XWINDOW (O), vchild)
+|
+- XWINDOW (O)->parent
++ WVAR (XWINDOW (O), parent)
+|
+- XWINDOW (O)->left_col
++ WVAR (XWINDOW (O), left_col)
+|
+- XWINDOW (O)->top_line
++ WVAR (XWINDOW (O), top_line)
+|
+- XWINDOW (O)->total_lines
++ WVAR (XWINDOW (O), total_lines)
+|
+- XWINDOW (O)->total_cols
++ WVAR (XWINDOW (O), total_cols)
+|
+- XWINDOW (O)->normal_lines
++ WVAR (XWINDOW (O), normal_lines)
+|
+- XWINDOW (O)->normal_cols
++ WVAR (XWINDOW (O), normal_cols)
+|
+- XWINDOW (O)->new_total
++ WVAR (XWINDOW (O), new_total)
+|
+- XWINDOW (O)->new_normal
++ WVAR (XWINDOW (O), new_normal)
+|
+- XWINDOW (O)->buffer
++ WVAR (XWINDOW (O), buffer)
+|
+- XWINDOW (O)->start
++ WVAR (XWINDOW (O), start)
+|
+- XWINDOW (O)->pointm
++ WVAR (XWINDOW (O), pointm)
+|
+- XWINDOW (O)->temslot
++ WVAR (XWINDOW (O), temslot)
+|
+- XWINDOW (O)->vertical_scroll_bar
++ WVAR (XWINDOW (O), vertical_scroll_bar)
+|
+- XWINDOW (O)->left_margin_cols
++ WVAR (XWINDOW (O), left_margin_cols)
+|
+- XWINDOW (O)->right_margin_cols
++ WVAR (XWINDOW (O), right_margin_cols)
+|
+- XWINDOW (O)->left_fringe_width
++ WVAR (XWINDOW (O), left_fringe_width)
+|
+- XWINDOW (O)->right_fringe_width
++ WVAR (XWINDOW (O), right_fringe_width)
+|
+- XWINDOW (O)->scroll_bar_width
++ WVAR (XWINDOW (O), scroll_bar_width)
+|
+- XWINDOW (O)->vertical_scroll_bar_type
++ WVAR (XWINDOW (O), vertical_scroll_bar_type)
+|
+- XWINDOW (O)->window_end_pos
++ WVAR (XWINDOW (O), window_end_pos)
+|
+- XWINDOW (O)->window_end_vpos
++ WVAR (XWINDOW (O), window_end_vpos)
+|
+- XWINDOW (O)->window_end_valid
++ WVAR (XWINDOW (O), window_end_valid)
+|
+- XWINDOW (O)->display_table
++ WVAR (XWINDOW (O), display_table)
+|
+- XWINDOW (O)->dedicated
++ WVAR (XWINDOW (O), dedicated)
+|
+- XWINDOW (O)->base_line_number
++ WVAR (XWINDOW (O), base_line_number)
+|
+- XWINDOW (O)->base_line_pos
++ WVAR (XWINDOW (O), base_line_pos)
+|
+- XWINDOW (O)->region_showing
++ WVAR (XWINDOW (O), region_showing)
+|
+- XWINDOW (O)->column_number_displayed
++ WVAR (XWINDOW (O), column_number_displayed)
+|
+- XWINDOW (O)->redisplay_end_trigger
++ WVAR (XWINDOW (O), redisplay_end_trigger)
+|
+- XWINDOW (O)->combination_limit
++ WVAR (XWINDOW (O), combination_limit)
+|
+- XWINDOW (O)->prev_buffers
++ WVAR (XWINDOW (O), prev_buffers)
+|
+- XWINDOW (O)->next_buffers
++ WVAR (XWINDOW (O), next_buffers)
+|
+- XWINDOW (O)->window_parameters
++ WVAR (XWINDOW (O), window_parameters)
+)
--- /dev/null
+@@
+expression x;
+expression E;
+@@
+ x =
+- xmalloc
++ xzalloc
+ (E)
+ ...
+- memset (x, 0, E);
"check-marked" => \$check_marked,
"all" => \$all,
"no-optim" => \$no_optim,
- "union-type" => \$union_type,
+ "check-lisp-type" => \$check_lisp_type,
"gprof" => \$profile,
"malloc-check" => \$malloc_check,
"no-mcheck" => \$no_mcheck,
--check-marked GC_CHECK_MARKED_OBJECTS=1
--optim no debug defines
--gprof make Emacs for profiling
- --union-type define USE_LISP_UNION_TYPE (bad for GDB)
+ --check-lisp-type define CHECK_LISP_OBJECT_TYPE
--malloc-check define GC_MALLOC_CHECK
--no-mcheck don't define GC_MCHECK
--wall compile with -Wall
}
}
-$defs = "$defs -DUSE_LISP_UNION_TYPE" if $union_type;
+$defs = "$defs -DCHECK_LISP_OBJECT_TYPE" if $check_lisp_type;
$defs = "$defs -DGC_MALLOC_CHECK=1 -DGC_PROTECT_MALLOC_STATE=1" if $malloc_check;
$defs = "$defs -DGC_MCHECK=1" unless $no_mcheck;
refer to a newer release of Emacs. (This is probably needed only
when preparing a major Emacs release, or branching for it.)
-5. Edit configure.in so that maintainer-mode is off by default.
- (FIXME - need to find a better way of dealing with this.
- Or maybe it's fine and indeed correct to leave it on?
- See http://lists.gnu.org/archive/html/emacs-devel/2011-03/msg00859.html
- and subsequent.)
-
- autoreconf -i -I m4 --force
+5. autoreconf -i -I m4 --force
make bootstrap
6. Commit etc/AUTHORS, all the files changed by M-x set-version, and
--- /dev/null
+#! /bin/sh
+# Merge gnulib sources into Emacs sources.
+# Typical usage:
+#
+# admin/merge-gnulib
+
+# Copyright 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 <http://www.gnu.org/licenses/>.
+
+# written by Paul Eggert
+
+GNULIB_URL=git://git.savannah.gnu.org/gnulib.git
+
+GNULIB_MODULES='
+ alloca-opt c-ctype c-strcase
+ careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512
+ dtoastr dtotimespec dup2 environ execinfo
+ filemode getloadavg getopt-gnu gettime gettimeofday
+ ignore-value intprops largefile lstat
+ manywarnings mktime pselect pthread_sigmask readlink
+ socklen stat-time stdalign stdarg stdbool stdio
+ strftime strtoimax strtoumax symlink sys_stat
+ sys_time time timer-time timespec-add timespec-sub utimens
+ warnings
+'
+
+GNULIB_TOOL_FLAGS='
+ --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat
+ --avoid=msvc-inval --avoid=msvc-nothrow
+ --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types
+ --avoid=threadlib
+ --conditional-dependencies --import --no-changelog --no-vc-files
+ --makefile-name=gnulib.mk
+'
+
+# The source directory, with a trailing '/'.
+# If empty, the source directory is the working directory.
+src=$2
+case $src in
+ */ | '') ;;
+ *) src=$src/ ;;
+esac
+
+# Gnulib's source directory.
+gnulib_srcdir=${1-$src../gnulib}
+
+case $gnulib_srcdir in
+ -*) src=- ;;
+esac
+case $src in
+ -*)
+ echo >&2 "$0: usage: $0 [GNULIB_SRCDIR [SRCDIR]]
+
+ SRCDIR is the Emacs source directory (default: working directory).
+ GNULIB_SRCDIR is the Gnulib source directory (default: SRCDIR/../gnulib)."
+ exit 1 ;;
+esac
+
+test -x "$src"autogen.sh || {
+ echo >&2 "$0: '${src:-.}' is not an Emacs source directory."
+ exit 1
+}
+
+test -d "$gnulib_srcdir" ||
+git clone -- "$GNULIB_URL" "$gnulib_srcdir" ||
+exit
+
+test -x "$gnulib_srcdir"/gnulib-tool || {
+ echo >&2 "$0: '$gnulib_srcdir' is not a Gnulib source directory."
+ exit 1
+}
+
+"$gnulib_srcdir"/gnulib-tool --dir="$src" $GNULIB_TOOL_FLAGS $GNULIB_MODULES &&
+rm -- "$src"m4/gnulib-cache.m4 "$src"m4/warn-on-use.m4 &&
+cp -- "$gnulib_srcdir"/build-aux/texinfo.tex "$src"doc/misc &&
+cp -- "$gnulib_srcdir"/build-aux/move-if-change "$src"build-aux &&
+autoreconf -i -I m4 -- ${src:+"$src"}
The "maintainer email address" is "bug-gnu-emacs@gnu.org" in most cases.
-** To not get acknowledgement mail from the tracker,
+** To not get acknowledgment mail from the tracker,
add an "X-Debbugs-No-Ack:" header (with any value). If you use Gnus,
you can add an element to gnus-posting-styles to do this automatically, eg:
All discarded messages are stored in /var/lib/mailman/spam.
If a non-spam message accidentally gets discarded, just do:
-cat /var/lib/mailman/spam/not-really-spam.msg | /usr/lib/debbugs/receive
+/usr/lib/debbugs/receive < /var/lib/mailman/spam/not-really-spam.msg
chown Debian-debbugs:Debian-debbugs /var/lib/debbugs/spool/incoming/*
... check it works ...
mv /var/lib/mailman/spam/not-really-spam.msg /var/lib/mailman/not-spam/
Also check that the sender was not added to the auto-discard/reject list
in the debbugs-submit Mailman interface.
+If you don't have the actual mail, just the mailman moderation mail
+version of it, you need to extract the original mail, and add the
+following headers:
+
+1) The leading envelope From line.
+2) Message-ID (get it from /var/log/mailman/vette).
+3) X-Debbugs-Envelope-To: submit
+
+Then pipe it to receive as above.
+
** Administrivia
The debbugs-submit list should have the administrivia option off,
read_avail_input.
(Fixed. This was caused by unconditionally including stdin in
- input_wait_mask in init_process. The select call in
+ input_wait_mask in init_process_emacs. The select call in
wait_reading_process_input always returned immediately, indicating
that there is pending input from stdin, which nobody read.
#!/bin/sh
### quick-install-emacs --- do a halfway-decent job of installing emacs quickly
-## Copyright (C) 2001-2012 Free Software Foundation, Inc.
+## Copyright (C) 2001-2012 Free Software Foundation, Inc.
## Author: Miles Bader <miles@gnu.org>
PUBLIC_LIBSRC_BINARIES='emacsclient etags ctags ebrowse'
-PUBLIC_LIBSRC_SCRIPTS='grep-changelog rcs-checkin'
+PUBLIC_LIBSRC_SCRIPTS='grep-changelog'
AVOID="CVS -DIC README COPYING ChangeLog ~ [.]orig$ [.]rej$ Makefile$ Makefile.in$ makefile$ makefile.w32-in$ stamp-subdir [.]cvsignore [.]arch-ids [{]arch[}] [.][cho]$ make-docfile testfile test-distrib"
test x"$ARCH" = x && { ARCH="`get_config_var host`" || exit 4 ; }
VERSION=`
- sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <$SRC/configure.in
+ sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <$SRC/configure.ac
` || exit 4
-test -n "$VERSION" || { echo >&2 "$me: no version in configure.in"; exit 4; }
+test -n "$VERSION" || { echo >&2 "$me: no version in configure.ac"; exit 4; }
DST_SHARE="$prefix/share/emacs/$VERSION"
DST_BIN="$prefix/bin"
-# BidiMirroring-6.0.0.txt
-# Date: 2010-06-21, 12:09:00 PDT [KW]
+# BidiMirroring-6.2.0.txt
+# Date: 2012-05-15, 24:19:00 GMT [KW, LI]
#
# Bidi_Mirroring_Glyph Property
#
# This file is an informative contributory data file in the
# Unicode Character Database.
#
-# Copyright (c) 1991-2010 Unicode, Inc.
+# Copyright (c) 1991-2012 Unicode, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
-# This data file lists characters that have the Bidi_Mirrored=True property
+# This data file lists characters that have the Bidi_Mirrored=Yes property
# value, for which there is another Unicode character that typically has a glyph
# that is the mirror image of the original character's glyph.
#
-# The repertoire covered by the file is Unicode 6.0.0.
+# The repertoire covered by the file is Unicode 6.2.0.
#
# The file contains a list of lines with mappings from one code point
# to another one for character-based mirroring.
# variable-length hexadecimal value with 4 to 6 digits.
# A comment indicates where the characters are "BEST FIT" mirroring.
#
-# Code points for which Bidi_Mirrored=True, but for which no appropriate
+# Code points for which Bidi_Mirrored=Yes, but for which no appropriate
# characters exist with mirrored glyphs, are
# listed as comments at the end of the file.
#
# Formally, the default value of the Bidi_Mirroring_Glyph property
-# for each code point is the code point itself, unless a mapping to
+# for each code point is <none>, unless a mapping to
# some other character is specified in this data file. When a code
# point has the default value for the Bidi_Mirroring_Glyph property,
# that means that no other character exists whose glyph is suitable
# at http://www.unicode.org/unicode/reports/tr9/
#
# This file was originally created by Markus Scherer.
-# Extended for Unicode 3.2, 4.0, 4.1, 5.0, 5.1, 5.2, and 6.0 by Ken Whistler.
+# Extended for Unicode 3.2, 4.0, 4.1, 5.0, 5.1, 5.2, and 6.0 by Ken Whistler,
+# and for Unicode 6.1 and 6.2 by Ken Whistler and Laurentiu Iancu.
#
# ############################################################
+#
+# Property: Bidi_Mirroring_Glyph
+#
+# @missing: 0000..10FFFF; <none>
0028; 0029 # LEFT PARENTHESIS
0029; 0028 # RIGHT PARENTHESIS
27C6; 27C5 # RIGHT S-SHAPED BAG DELIMITER
27C8; 27C9 # REVERSE SOLIDUS PRECEDING SUBSET
27C9; 27C8 # SUPERSET PRECEDING SOLIDUS
+27CB; 27CD # MATHEMATICAL RISING DIAGONAL
+27CD; 27CB # MATHEMATICAL FALLING DIAGONAL
27D5; 27D6 # LEFT OUTER JOIN
27D6; 27D5 # RIGHT OUTER JOIN
27DD; 27DE # LONG RIGHT TACK
# Makefile -- Makefile to generate character property tables.
+
+# Copyright (C) 2012 Free Software Foundation, Inc.
+
# Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
# Registration Number H13PRO009
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+SHELL = /bin/sh
+
+srcdir = @srcdir@
+abs_builddir = @abs_builddir@
+top_srcdir = @top_srcdir@
+abs_top_builddir = @abs_top_builddir@
-EMACS = ../../src/emacs
-DSTDIR = ../../lisp/international
-RUNEMACS = ${EMACS} -Q -batch
+EMACS = ${abs_top_builddir}/src/emacs
+DSTDIR = ${top_srcdir}/lisp/international
+emacs = ${EMACS} -batch --no-site-file --no-site-lisp
all: ${DSTDIR}/charprop.el
.el.elc:
- ${RUNEMACS} -batch -f batch-byte-compile $<
+ ${emacs} -f batch-byte-compile $<
-unidata.txt: UnicodeData.txt
- sed -e 's/\([^;]*\);\(.*\)/(#x\1 "\2")/' -e 's/;/" "/g' < UnicodeData.txt > $@
+unidata.txt: ${srcdir}/UnicodeData.txt
+ sed -e 's/\([^;]*\);\(.*\)/(#x\1 "\2")/' -e 's/;/" "/g' < ${srcdir}/UnicodeData.txt > $@
-${DSTDIR}/charprop.el: unidata-gen.elc unidata.txt
- ELC=`/bin/pwd`/unidata-gen.elc; \
- DATADIR=`/bin/pwd`; \
- DATA=unidata.txt; \
- cd ${DSTDIR}; \
- ${RUNEMACS} -batch --load $${ELC} -f unidata-gen-files $${DATADIR} $${DATA}
+${DSTDIR}/charprop.el: ${srcdir}/unidata-gen.elc unidata.txt
+ cd ${DSTDIR} && ${emacs} -l ${srcdir}/unidata-gen \
+ -f unidata-gen-files ${srcdir} ${abs_builddir}/unidata.txt
+
+## Like the above, but generate in PWD rather than lisp/international.
+charprop.el: ${srcdir}/unidata-gen.elc unidata.txt
+ ${emacs} -l ${srcdir}/unidata-gen \
+ -f unidata-gen-files ${srcdir} unidata.txt
install: charprop.el
cp charprop.el ${DSTDIR}
if test -f charprop.el; then \
rm -f `sed -n 's/^;; FILE: //p' < charprop.el`; \
fi
- rm -f charprop.el unidata-gen.elc unidata.txt
+ rm -f charprop.el ${srcdir}/unidata-gen.elc unidata.txt
+
+distclean: clean
+ -rm -f ./Makefile
+
+maintainer-clean: distclean
The file `UnicodeData.txt' in this directory is a copy of
-<http://www.unicode.org/Public/UNIDATA/UnicodeData.txt> on 2009.10.1,
+<http://www.unicode.org/Public/UNIDATA/UnicodeData.txt> on 2012.04.07,
and is a part of the Unicode Character Database governed by the "UCD
Terms of Use" shown in the file `copyright.html'.
00A4;CURRENCY SIGN;Sc;0;ET;;;;;N;;;;;
00A5;YEN SIGN;Sc;0;ET;;;;;N;;;;;
00A6;BROKEN BAR;So;0;ON;;;;;N;BROKEN VERTICAL BAR;;;;
-00A7;SECTION SIGN;So;0;ON;;;;;N;;;;;
+00A7;SECTION SIGN;Po;0;ON;;;;;N;;;;;
00A8;DIAERESIS;Sk;0;ON;<compat> 0020 0308;;;;N;SPACING DIAERESIS;;;;
00A9;COPYRIGHT SIGN;So;0;ON;;;;;N;;;;;
-00AA;FEMININE ORDINAL INDICATOR;Ll;0;L;<super> 0061;;;;N;;;;;
+00AA;FEMININE ORDINAL INDICATOR;Lo;0;L;<super> 0061;;;;N;;;;;
00AB;LEFT-POINTING DOUBLE ANGLE QUOTATION MARK;Pi;0;ON;;;;;Y;LEFT POINTING GUILLEMET;;;;
00AC;NOT SIGN;Sm;0;ON;;;;;N;;;;;
00AD;SOFT HYPHEN;Cf;0;BN;;;;;N;;;;;
00B3;SUPERSCRIPT THREE;No;0;EN;<super> 0033;;3;3;N;SUPERSCRIPT DIGIT THREE;;;;
00B4;ACUTE ACCENT;Sk;0;ON;<compat> 0020 0301;;;;N;SPACING ACUTE;;;;
00B5;MICRO SIGN;Ll;0;L;<compat> 03BC;;;;N;;;039C;;039C
-00B6;PILCROW SIGN;So;0;ON;;;;;N;PARAGRAPH SIGN;;;;
+00B6;PILCROW SIGN;Po;0;ON;;;;;N;PARAGRAPH SIGN;;;;
00B7;MIDDLE DOT;Po;0;ON;;;;;N;;;;;
00B8;CEDILLA;Sk;0;ON;<compat> 0020 0327;;;;N;SPACING CEDILLA;;;;
00B9;SUPERSCRIPT ONE;No;0;EN;<super> 0031;;1;1;N;SUPERSCRIPT DIGIT ONE;;;;
-00BA;MASCULINE ORDINAL INDICATOR;Ll;0;L;<super> 006F;;;;N;;;;;
+00BA;MASCULINE ORDINAL INDICATOR;Lo;0;L;<super> 006F;;;;N;;;;;
00BB;RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK;Pf;0;ON;;;;;Y;RIGHT POINTING GUILLEMET;;;;
00BC;VULGAR FRACTION ONE QUARTER;No;0;ON;<fraction> 0031 2044 0034;;;1/4;N;FRACTION ONE QUARTER;;;;
00BD;VULGAR FRACTION ONE HALF;No;0;ON;<fraction> 0031 2044 0032;;;1/2;N;FRACTION ONE HALF;;;;
0263;LATIN SMALL LETTER GAMMA;Ll;0;L;;;;;N;;;0194;;0194
0264;LATIN SMALL LETTER RAMS HORN;Ll;0;L;;;;;N;LATIN SMALL LETTER BABY GAMMA;;;;
0265;LATIN SMALL LETTER TURNED H;Ll;0;L;;;;;N;;;A78D;;A78D
-0266;LATIN SMALL LETTER H WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER H HOOK;;;;
+0266;LATIN SMALL LETTER H WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER H HOOK;;A7AA;;A7AA
0267;LATIN SMALL LETTER HENG WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER HENG HOOK;;;;
0268;LATIN SMALL LETTER I WITH STROKE;Ll;0;L;;;;;N;LATIN SMALL LETTER BARRED I;;0197;;0197
0269;LATIN SMALL LETTER IOTA;Ll;0;L;;;;;N;;;0196;;0196
0587;ARMENIAN SMALL LIGATURE ECH YIWN;Ll;0;L;<compat> 0565 0582;;;;N;;;;;
0589;ARMENIAN FULL STOP;Po;0;L;;;;;N;ARMENIAN PERIOD;;;;
058A;ARMENIAN HYPHEN;Pd;0;ON;;;;;N;;;;;
+058F;ARMENIAN DRAM SIGN;Sc;0;ET;;;;;N;;;;;
0591;HEBREW ACCENT ETNAHTA;Mn;220;NSM;;;;;N;;;;;
0592;HEBREW ACCENT SEGOL;Mn;230;NSM;;;;;N;;;;;
0593;HEBREW ACCENT SHALSHELET;Mn;230;NSM;;;;;N;;;;;
0601;ARABIC SIGN SANAH;Cf;0;AN;;;;;N;;;;;
0602;ARABIC FOOTNOTE MARKER;Cf;0;AN;;;;;N;;;;;
0603;ARABIC SIGN SAFHA;Cf;0;AN;;;;;N;;;;;
+0604;ARABIC SIGN SAMVAT;Cf;0;AN;;;;;N;;;;;
0606;ARABIC-INDIC CUBE ROOT;Sm;0;ON;;;;;N;;;;;
0607;ARABIC-INDIC FOURTH ROOT;Sm;0;ON;;;;;N;;;;;
0608;ARABIC RAY;Sm;0;AL;;;;;N;;;;;
070B;SYRIAC HARKLEAN OBELUS;Po;0;AL;;;;;N;;;;;
070C;SYRIAC HARKLEAN METOBELUS;Po;0;AL;;;;;N;;;;;
070D;SYRIAC HARKLEAN ASTERISCUS;Po;0;AL;;;;;N;;;;;
-070F;SYRIAC ABBREVIATION MARK;Cf;0;AN;;;;;N;;;;;
+070F;SYRIAC ABBREVIATION MARK;Cf;0;AL;;;;;N;;;;;
0710;SYRIAC LETTER ALAPH;Lo;0;AL;;;;;N;;;;;
0711;SYRIAC LETTER SUPERSCRIPT ALAPH;Mn;36;NSM;;;;;N;;;;;
0712;SYRIAC LETTER BETH;Lo;0;AL;;;;;N;;;;;
085A;MANDAIC VOCALIZATION MARK;Mn;220;NSM;;;;;N;;;;;
085B;MANDAIC GEMINATION MARK;Mn;220;NSM;;;;;N;;;;;
085E;MANDAIC PUNCTUATION;Po;0;R;;;;;N;;;;;
+08A0;ARABIC LETTER BEH WITH SMALL V BELOW;Lo;0;AL;;;;;N;;;;;
+08A2;ARABIC LETTER JEEM WITH TWO DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
+08A3;ARABIC LETTER TAH WITH TWO DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
+08A4;ARABIC LETTER FEH WITH DOT BELOW AND THREE DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
+08A5;ARABIC LETTER QAF WITH DOT BELOW;Lo;0;AL;;;;;N;;;;;
+08A6;ARABIC LETTER LAM WITH DOUBLE BAR;Lo;0;AL;;;;;N;;;;;
+08A7;ARABIC LETTER MEEM WITH THREE DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
+08A8;ARABIC LETTER YEH WITH TWO DOTS BELOW AND HAMZA ABOVE;Lo;0;AL;;;;;N;;;;;
+08A9;ARABIC LETTER YEH WITH TWO DOTS BELOW AND DOT ABOVE;Lo;0;AL;;;;;N;;;;;
+08AA;ARABIC LETTER REH WITH LOOP;Lo;0;AL;;;;;N;;;;;
+08AB;ARABIC LETTER WAW WITH DOT WITHIN;Lo;0;AL;;;;;N;;;;;
+08AC;ARABIC LETTER ROHINGYA YEH;Lo;0;AL;;;;;N;;;;;
+08E4;ARABIC CURLY FATHA;Mn;230;NSM;;;;;N;;;;;
+08E5;ARABIC CURLY DAMMA;Mn;230;NSM;;;;;N;;;;;
+08E6;ARABIC CURLY KASRA;Mn;220;NSM;;;;;N;;;;;
+08E7;ARABIC CURLY FATHATAN;Mn;230;NSM;;;;;N;;;;;
+08E8;ARABIC CURLY DAMMATAN;Mn;230;NSM;;;;;N;;;;;
+08E9;ARABIC CURLY KASRATAN;Mn;220;NSM;;;;;N;;;;;
+08EA;ARABIC TONE ONE DOT ABOVE;Mn;230;NSM;;;;;N;;;;;
+08EB;ARABIC TONE TWO DOTS ABOVE;Mn;230;NSM;;;;;N;;;;;
+08EC;ARABIC TONE LOOP ABOVE;Mn;230;NSM;;;;;N;;;;;
+08ED;ARABIC TONE ONE DOT BELOW;Mn;220;NSM;;;;;N;;;;;
+08EE;ARABIC TONE TWO DOTS BELOW;Mn;220;NSM;;;;;N;;;;;
+08EF;ARABIC TONE LOOP BELOW;Mn;220;NSM;;;;;N;;;;;
+08F0;ARABIC OPEN FATHATAN;Mn;27;NSM;;;;;N;;;;;
+08F1;ARABIC OPEN DAMMATAN;Mn;28;NSM;;;;;N;;;;;
+08F2;ARABIC OPEN KASRATAN;Mn;29;NSM;;;;;N;;;;;
+08F3;ARABIC SMALL HIGH WAW;Mn;230;NSM;;;;;N;;;;;
+08F4;ARABIC FATHA WITH RING;Mn;230;NSM;;;;;N;;;;;
+08F5;ARABIC FATHA WITH DOT ABOVE;Mn;230;NSM;;;;;N;;;;;
+08F6;ARABIC KASRA WITH DOT BELOW;Mn;220;NSM;;;;;N;;;;;
+08F7;ARABIC LEFT ARROWHEAD ABOVE;Mn;230;NSM;;;;;N;;;;;
+08F8;ARABIC RIGHT ARROWHEAD ABOVE;Mn;230;NSM;;;;;N;;;;;
+08F9;ARABIC LEFT ARROWHEAD BELOW;Mn;220;NSM;;;;;N;;;;;
+08FA;ARABIC RIGHT ARROWHEAD BELOW;Mn;220;NSM;;;;;N;;;;;
+08FB;ARABIC DOUBLE RIGHT ARROWHEAD ABOVE;Mn;230;NSM;;;;;N;;;;;
+08FC;ARABIC DOUBLE RIGHT ARROWHEAD ABOVE WITH DOT;Mn;230;NSM;;;;;N;;;;;
+08FD;ARABIC RIGHT ARROWHEAD ABOVE WITH DOT;Mn;230;NSM;;;;;N;;;;;
+08FE;ARABIC DAMMA WITH DOT;Mn;230;NSM;;;;;N;;;;;
0900;DEVANAGARI SIGN INVERTED CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0901;DEVANAGARI SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0902;DEVANAGARI SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
0AED;GUJARATI DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
0AEE;GUJARATI DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
0AEF;GUJARATI DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+0AF0;GUJARATI ABBREVIATION SIGN;Po;0;L;;;;;N;;;;;
0AF1;GUJARATI RUPEE SIGN;Sc;0;ET;;;;;N;;;;;
0B01;ORIYA SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0B02;ORIYA SIGN ANUSVARA;Mc;0;L;;;;;N;;;;;
0ED9;LAO DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
0EDC;LAO HO NO;Lo;0;L;<compat> 0EAB 0E99;;;;N;;;;;
0EDD;LAO HO MO;Lo;0;L;<compat> 0EAB 0EA1;;;;N;;;;;
+0EDE;LAO LETTER KHMU GO;Lo;0;L;;;;;N;;;;;
+0EDF;LAO LETTER KHMU NYO;Lo;0;L;;;;;N;;;;;
0F00;TIBETAN SYLLABLE OM;Lo;0;L;;;;;N;;;;;
0F01;TIBETAN MARK GTER YIG MGO TRUNCATED A;So;0;L;;;;;N;;;;;
0F02;TIBETAN MARK GTER YIG MGO -UM RNAM BCAD MA;So;0;L;;;;;N;;;;;
0F11;TIBETAN MARK RIN CHEN SPUNGS SHAD;Po;0;L;;;;;N;TIBETAN RINCHANPHUNGSHAD;;;;
0F12;TIBETAN MARK RGYA GRAM SHAD;Po;0;L;;;;;N;;;;;
0F13;TIBETAN MARK CARET -DZUD RTAGS ME LONG CAN;So;0;L;;;;;N;;;;;
-0F14;TIBETAN MARK GTER TSHEG;So;0;L;;;;;N;TIBETAN COMMA;;;;
+0F14;TIBETAN MARK GTER TSHEG;Po;0;L;;;;;N;TIBETAN COMMA;;;;
0F15;TIBETAN LOGOTYPE SIGN CHAD RTAGS;So;0;L;;;;;N;;;;;
0F16;TIBETAN LOGOTYPE SIGN LHAG RTAGS;So;0;L;;;;;N;;;;;
0F17;TIBETAN ASTROLOGICAL SIGN SGRA GCAN -CHAR RTAGS;So;0;L;;;;;N;;;;;
10C3;GEORGIAN CAPITAL LETTER WE;Lu;0;L;;;;;N;;;;2D23;
10C4;GEORGIAN CAPITAL LETTER HAR;Lu;0;L;;;;;N;;;;2D24;
10C5;GEORGIAN CAPITAL LETTER HOE;Lu;0;L;;;;;N;;;;2D25;
+10C7;GEORGIAN CAPITAL LETTER YN;Lu;0;L;;;;;N;;;;2D27;
+10CD;GEORGIAN CAPITAL LETTER AEN;Lu;0;L;;;;;N;;;;2D2D;
10D0;GEORGIAN LETTER AN;Lo;0;L;;;;;N;GEORGIAN SMALL LETTER AN;;;;
10D1;GEORGIAN LETTER BAN;Lo;0;L;;;;;N;GEORGIAN SMALL LETTER BAN;;;;
10D2;GEORGIAN LETTER GAN;Lo;0;L;;;;;N;GEORGIAN SMALL LETTER GAN;;;;
10FA;GEORGIAN LETTER AIN;Lo;0;L;;;;;N;;;;;
10FB;GEORGIAN PARAGRAPH SEPARATOR;Po;0;L;;;;;N;;;;;
10FC;MODIFIER LETTER GEORGIAN NAR;Lm;0;L;<super> 10DC;;;;N;;;;;
+10FD;GEORGIAN LETTER AEN;Lo;0;L;;;;;N;;;;;
+10FE;GEORGIAN LETTER HARD SIGN;Lo;0;L;;;;;N;;;;;
+10FF;GEORGIAN LETTER LABIAL SIGN;Lo;0;L;;;;;N;;;;;
1100;HANGUL CHOSEONG KIYEOK;Lo;0;L;;;;;N;;;;;
1101;HANGUL CHOSEONG SSANGKIYEOK;Lo;0;L;;;;;N;;;;;
1102;HANGUL CHOSEONG NIEUN;Lo;0;L;;;;;N;;;;;
135D;ETHIOPIC COMBINING GEMINATION AND VOWEL LENGTH MARK;Mn;230;NSM;;;;;N;;;;;
135E;ETHIOPIC COMBINING VOWEL LENGTH MARK;Mn;230;NSM;;;;;N;;;;;
135F;ETHIOPIC COMBINING GEMINATION MARK;Mn;230;NSM;;;;;N;;;;;
-1360;ETHIOPIC SECTION MARK;So;0;L;;;;;N;;;;;
+1360;ETHIOPIC SECTION MARK;Po;0;L;;;;;N;;;;;
1361;ETHIOPIC WORDSPACE;Po;0;L;;;;;N;;;;;
1362;ETHIOPIC FULL STOP;Po;0;L;;;;;N;;;;;
1363;ETHIOPIC COMMA;Po;0;L;;;;;N;;;;;
17B1;KHMER INDEPENDENT VOWEL QOO TYPE ONE;Lo;0;L;;;;;N;;;;;
17B2;KHMER INDEPENDENT VOWEL QOO TYPE TWO;Lo;0;L;;;;;N;;;;;
17B3;KHMER INDEPENDENT VOWEL QAU;Lo;0;L;;;;;N;;;;;
-17B4;KHMER VOWEL INHERENT AQ;Cf;0;L;;;;;N;;;;;
-17B5;KHMER VOWEL INHERENT AA;Cf;0;L;;;;;N;;;;;
+17B4;KHMER VOWEL INHERENT AQ;Mn;0;NSM;;;;;N;;;;;
+17B5;KHMER VOWEL INHERENT AA;Mn;0;NSM;;;;;N;;;;;
17B6;KHMER VOWEL SIGN AA;Mc;0;L;;;;;N;;;;;
17B7;KHMER VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
17B8;KHMER VOWEL SIGN II;Mn;0;NSM;;;;;N;;;;;
1BA8;SUNDANESE VOWEL SIGN PAMEPET;Mn;0;NSM;;;;;N;;;;;
1BA9;SUNDANESE VOWEL SIGN PANEULEUNG;Mn;0;NSM;;;;;N;;;;;
1BAA;SUNDANESE SIGN PAMAAEH;Mc;9;L;;;;;N;;;;;
+1BAB;SUNDANESE SIGN VIRAMA;Mn;9;NSM;;;;;N;;;;;
+1BAC;SUNDANESE CONSONANT SIGN PASANGAN MA;Mc;0;L;;;;;N;;;;;
+1BAD;SUNDANESE CONSONANT SIGN PASANGAN WA;Mc;0;L;;;;;N;;;;;
1BAE;SUNDANESE LETTER KHA;Lo;0;L;;;;;N;;;;;
1BAF;SUNDANESE LETTER SYA;Lo;0;L;;;;;N;;;;;
1BB0;SUNDANESE DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
1BB7;SUNDANESE DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
1BB8;SUNDANESE DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
1BB9;SUNDANESE DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+1BBA;SUNDANESE AVAGRAHA;Lo;0;L;;;;;N;;;;;
+1BBB;SUNDANESE LETTER REU;Lo;0;L;;;;;N;;;;;
+1BBC;SUNDANESE LETTER LEU;Lo;0;L;;;;;N;;;;;
+1BBD;SUNDANESE LETTER BHA;Lo;0;L;;;;;N;;;;;
+1BBE;SUNDANESE LETTER FINAL K;Lo;0;L;;;;;N;;;;;
+1BBF;SUNDANESE LETTER FINAL M;Lo;0;L;;;;;N;;;;;
1BC0;BATAK LETTER A;Lo;0;L;;;;;N;;;;;
1BC1;BATAK LETTER SIMALUNGUN A;Lo;0;L;;;;;N;;;;;
1BC2;BATAK LETTER HA;Lo;0;L;;;;;N;;;;;
1C7D;OL CHIKI AHAD;Lm;0;L;;;;;N;;;;;
1C7E;OL CHIKI PUNCTUATION MUCAAD;Po;0;L;;;;;N;;;;;
1C7F;OL CHIKI PUNCTUATION DOUBLE MUCAAD;Po;0;L;;;;;N;;;;;
+1CC0;SUNDANESE PUNCTUATION BINDU SURYA;Po;0;L;;;;;N;;;;;
+1CC1;SUNDANESE PUNCTUATION BINDU PANGLONG;Po;0;L;;;;;N;;;;;
+1CC2;SUNDANESE PUNCTUATION BINDU PURNAMA;Po;0;L;;;;;N;;;;;
+1CC3;SUNDANESE PUNCTUATION BINDU CAKRA;Po;0;L;;;;;N;;;;;
+1CC4;SUNDANESE PUNCTUATION BINDU LEU SATANGA;Po;0;L;;;;;N;;;;;
+1CC5;SUNDANESE PUNCTUATION BINDU KA SATANGA;Po;0;L;;;;;N;;;;;
+1CC6;SUNDANESE PUNCTUATION BINDU DA SATANGA;Po;0;L;;;;;N;;;;;
+1CC7;SUNDANESE PUNCTUATION BINDU BA SATANGA;Po;0;L;;;;;N;;;;;
1CD0;VEDIC TONE KARSHANA;Mn;230;NSM;;;;;N;;;;;
1CD1;VEDIC TONE SHARA;Mn;230;NSM;;;;;N;;;;;
1CD2;VEDIC TONE PRENKHA;Mn;230;NSM;;;;;N;;;;;
1CF0;VEDIC SIGN RTHANG LONG ANUSVARA;Lo;0;L;;;;;N;;;;;
1CF1;VEDIC SIGN ANUSVARA UBHAYATO MUKHA;Lo;0;L;;;;;N;;;;;
1CF2;VEDIC SIGN ARDHAVISARGA;Mc;0;L;;;;;N;;;;;
+1CF3;VEDIC SIGN ROTATED ARDHAVISARGA;Mc;0;L;;;;;N;;;;;
+1CF4;VEDIC TONE CANDRA ABOVE;Mn;230;NSM;;;;;N;;;;;
+1CF5;VEDIC SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;;
+1CF6;VEDIC SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;;
1D00;LATIN LETTER SMALL CAPITAL A;Ll;0;L;;;;;N;;;;;
1D01;LATIN LETTER SMALL CAPITAL AE;Ll;0;L;;;;;N;;;;;
1D02;LATIN SMALL LETTER TURNED AE;Ll;0;L;;;;;N;;;;;
1D5F;MODIFIER LETTER SMALL DELTA;Lm;0;L;<super> 03B4;;;;N;;;;;
1D60;MODIFIER LETTER SMALL GREEK PHI;Lm;0;L;<super> 03C6;;;;N;;;;;
1D61;MODIFIER LETTER SMALL CHI;Lm;0;L;<super> 03C7;;;;N;;;;;
-1D62;LATIN SUBSCRIPT SMALL LETTER I;Ll;0;L;<sub> 0069;;;;N;;;;;
-1D63;LATIN SUBSCRIPT SMALL LETTER R;Ll;0;L;<sub> 0072;;;;N;;;;;
-1D64;LATIN SUBSCRIPT SMALL LETTER U;Ll;0;L;<sub> 0075;;;;N;;;;;
-1D65;LATIN SUBSCRIPT SMALL LETTER V;Ll;0;L;<sub> 0076;;;;N;;;;;
-1D66;GREEK SUBSCRIPT SMALL LETTER BETA;Ll;0;L;<sub> 03B2;;;;N;;;;;
-1D67;GREEK SUBSCRIPT SMALL LETTER GAMMA;Ll;0;L;<sub> 03B3;;;;N;;;;;
-1D68;GREEK SUBSCRIPT SMALL LETTER RHO;Ll;0;L;<sub> 03C1;;;;N;;;;;
-1D69;GREEK SUBSCRIPT SMALL LETTER PHI;Ll;0;L;<sub> 03C6;;;;N;;;;;
-1D6A;GREEK SUBSCRIPT SMALL LETTER CHI;Ll;0;L;<sub> 03C7;;;;N;;;;;
+1D62;LATIN SUBSCRIPT SMALL LETTER I;Lm;0;L;<sub> 0069;;;;N;;;;;
+1D63;LATIN SUBSCRIPT SMALL LETTER R;Lm;0;L;<sub> 0072;;;;N;;;;;
+1D64;LATIN SUBSCRIPT SMALL LETTER U;Lm;0;L;<sub> 0075;;;;N;;;;;
+1D65;LATIN SUBSCRIPT SMALL LETTER V;Lm;0;L;<sub> 0076;;;;N;;;;;
+1D66;GREEK SUBSCRIPT SMALL LETTER BETA;Lm;0;L;<sub> 03B2;;;;N;;;;;
+1D67;GREEK SUBSCRIPT SMALL LETTER GAMMA;Lm;0;L;<sub> 03B3;;;;N;;;;;
+1D68;GREEK SUBSCRIPT SMALL LETTER RHO;Lm;0;L;<sub> 03C1;;;;N;;;;;
+1D69;GREEK SUBSCRIPT SMALL LETTER PHI;Lm;0;L;<sub> 03C6;;;;N;;;;;
+1D6A;GREEK SUBSCRIPT SMALL LETTER CHI;Lm;0;L;<sub> 03C7;;;;N;;;;;
1D6B;LATIN SMALL LETTER UE;Ll;0;L;;;;;N;;;;;
1D6C;LATIN SMALL LETTER B WITH MIDDLE TILDE;Ll;0;L;;;;;N;;;;;
1D6D;LATIN SMALL LETTER D WITH MIDDLE TILDE;Ll;0;L;;;;;N;;;;;
20B7;SPESMILO SIGN;Sc;0;ET;;;;;N;;;;;
20B8;TENGE SIGN;Sc;0;ET;;;;;N;;;;;
20B9;INDIAN RUPEE SIGN;Sc;0;ET;;;;;N;;;;;
+20BA;TURKISH LIRA SIGN;Sc;0;ET;;;;;N;;;;;
20D0;COMBINING LEFT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING LEFT HARPOON ABOVE;;;;
20D1;COMBINING RIGHT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING RIGHT HARPOON ABOVE;;;;
20D2;COMBINING LONG VERTICAL LINE OVERLAY;Mn;1;NSM;;;;;N;NON-SPACING LONG VERTICAL BAR OVERLAY;;;;
27C8;REVERSE SOLIDUS PRECEDING SUBSET;Sm;0;ON;;;;;Y;;;;;
27C9;SUPERSET PRECEDING SOLIDUS;Sm;0;ON;;;;;Y;;;;;
27CA;VERTICAL BAR WITH HORIZONTAL STROKE;Sm;0;ON;;;;;N;;;;;
+27CB;MATHEMATICAL RISING DIAGONAL;Sm;0;ON;;;;;Y;;;;;
27CC;LONG DIVISION;Sm;0;ON;;;;;Y;;;;;
+27CD;MATHEMATICAL FALLING DIAGONAL;Sm;0;ON;;;;;Y;;;;;
27CE;SQUARED LOGICAL AND;Sm;0;ON;;;;;N;;;;;
27CF;SQUARED LOGICAL OR;Sm;0;ON;;;;;N;;;;;
27D0;WHITE DIAMOND WITH CENTRED DOT;Sm;0;ON;;;;;N;;;;;
2C79;LATIN SMALL LETTER TURNED R WITH TAIL;Ll;0;L;;;;;N;;;;;
2C7A;LATIN SMALL LETTER O WITH LOW RING INSIDE;Ll;0;L;;;;;N;;;;;
2C7B;LATIN LETTER SMALL CAPITAL TURNED E;Ll;0;L;;;;;N;;;;;
-2C7C;LATIN SUBSCRIPT SMALL LETTER J;Ll;0;L;<sub> 006A;;;;N;;;;;
+2C7C;LATIN SUBSCRIPT SMALL LETTER J;Lm;0;L;<sub> 006A;;;;N;;;;;
2C7D;MODIFIER LETTER CAPITAL V;Lm;0;L;<super> 0056;;;;N;;;;;
2C7E;LATIN CAPITAL LETTER S WITH SWASH TAIL;Lu;0;L;;;;;N;;;;023F;
2C7F;LATIN CAPITAL LETTER Z WITH SWASH TAIL;Lu;0;L;;;;;N;;;;0240;
2CEF;COPTIC COMBINING NI ABOVE;Mn;230;NSM;;;;;N;;;;;
2CF0;COPTIC COMBINING SPIRITUS ASPER;Mn;230;NSM;;;;;N;;;;;
2CF1;COPTIC COMBINING SPIRITUS LENIS;Mn;230;NSM;;;;;N;;;;;
+2CF2;COPTIC CAPITAL LETTER BOHAIRIC KHEI;Lu;0;L;;;;;N;;;;2CF3;
+2CF3;COPTIC SMALL LETTER BOHAIRIC KHEI;Ll;0;L;;;;;N;;;2CF2;;2CF2
2CF9;COPTIC OLD NUBIAN FULL STOP;Po;0;ON;;;;;N;;;;;
2CFA;COPTIC OLD NUBIAN DIRECT QUESTION MARK;Po;0;ON;;;;;N;;;;;
2CFB;COPTIC OLD NUBIAN INDIRECT QUESTION MARK;Po;0;ON;;;;;N;;;;;
2D23;GEORGIAN SMALL LETTER WE;Ll;0;L;;;;;N;;;10C3;;10C3
2D24;GEORGIAN SMALL LETTER HAR;Ll;0;L;;;;;N;;;10C4;;10C4
2D25;GEORGIAN SMALL LETTER HOE;Ll;0;L;;;;;N;;;10C5;;10C5
+2D27;GEORGIAN SMALL LETTER YN;Ll;0;L;;;;;N;;;10C7;;10C7
+2D2D;GEORGIAN SMALL LETTER AEN;Ll;0;L;;;;;N;;;10CD;;10CD
2D30;TIFINAGH LETTER YA;Lo;0;L;;;;;N;;;;;
2D31;TIFINAGH LETTER YAB;Lo;0;L;;;;;N;;;;;
2D32;TIFINAGH LETTER YABH;Lo;0;L;;;;;N;;;;;
2D63;TIFINAGH LETTER YAZ;Lo;0;L;;;;;N;;;;;
2D64;TIFINAGH LETTER TAWELLEMET YAZ;Lo;0;L;;;;;N;;;;;
2D65;TIFINAGH LETTER YAZZ;Lo;0;L;;;;;N;;;;;
+2D66;TIFINAGH LETTER YE;Lo;0;L;;;;;N;;;;;
+2D67;TIFINAGH LETTER YO;Lo;0;L;;;;;N;;;;;
2D6F;TIFINAGH MODIFIER LETTER LABIALIZATION MARK;Lm;0;L;<super> 2D61;;;;N;;;;;
2D70;TIFINAGH SEPARATOR MARK;Po;0;L;;;;;N;;;;;
2D7F;TIFINAGH CONSONANT JOINER;Mn;9;NSM;;;;;N;;;;;
2E2F;VERTICAL TILDE;Lm;0;ON;;;;;N;;;;;
2E30;RING POINT;Po;0;ON;;;;;N;;;;;
2E31;WORD SEPARATOR MIDDLE DOT;Po;0;ON;;;;;N;;;;;
+2E32;TURNED COMMA;Po;0;ON;;;;;N;;;;;
+2E33;RAISED DOT;Po;0;ON;;;;;N;;;;;
+2E34;RAISED COMMA;Po;0;ON;;;;;N;;;;;
+2E35;TURNED SEMICOLON;Po;0;ON;;;;;N;;;;;
+2E36;DAGGER WITH LEFT GUARD;Po;0;ON;;;;;N;;;;;
+2E37;DAGGER WITH RIGHT GUARD;Po;0;ON;;;;;N;;;;;
+2E38;TURNED DAGGER;Po;0;ON;;;;;N;;;;;
+2E39;TOP HALF SECTION SIGN;Po;0;ON;;;;;N;;;;;
+2E3A;TWO-EM DASH;Pd;0;ON;;;;;N;;;;;
+2E3B;THREE-EM DASH;Pd;0;ON;;;;;N;;;;;
2E80;CJK RADICAL REPEAT;So;0;ON;;;;;N;;;;;
2E81;CJK RADICAL CLIFF;So;0;ON;;;;;N;;;;;
2E82;CJK RADICAL SECOND ONE;So;0;ON;;;;;N;;;;;
302B;IDEOGRAPHIC RISING TONE MARK;Mn;228;NSM;;;;;N;;;;;
302C;IDEOGRAPHIC DEPARTING TONE MARK;Mn;232;NSM;;;;;N;;;;;
302D;IDEOGRAPHIC ENTERING TONE MARK;Mn;222;NSM;;;;;N;;;;;
-302E;HANGUL SINGLE DOT TONE MARK;Mn;224;NSM;;;;;N;;;;;
-302F;HANGUL DOUBLE DOT TONE MARK;Mn;224;NSM;;;;;N;;;;;
+302E;HANGUL SINGLE DOT TONE MARK;Mc;224;L;;;;;N;;;;;
+302F;HANGUL DOUBLE DOT TONE MARK;Mc;224;L;;;;;N;;;;;
3030;WAVY DASH;Pd;0;ON;;;;;N;;;;;
3031;VERTICAL KANA REPEAT MARK;Lm;0;L;;;;;N;;;;;
3032;VERTICAL KANA REPEAT WITH VOICED SOUND MARK;Lm;0;L;;;;;N;;;;;
3245;CIRCLED IDEOGRAPH KINDERGARTEN;So;0;L;<circle> 5E7C;;;;N;;;;;
3246;CIRCLED IDEOGRAPH SCHOOL;So;0;L;<circle> 6587;;;;N;;;;;
3247;CIRCLED IDEOGRAPH KOTO;So;0;L;<circle> 7B8F;;;;N;;;;;
-3248;CIRCLED NUMBER TEN ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-3249;CIRCLED NUMBER TWENTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324A;CIRCLED NUMBER THIRTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324B;CIRCLED NUMBER FORTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324C;CIRCLED NUMBER FIFTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324D;CIRCLED NUMBER SIXTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324E;CIRCLED NUMBER SEVENTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
-324F;CIRCLED NUMBER EIGHTY ON BLACK SQUARE;So;0;L;;;;;N;;;;;
+3248;CIRCLED NUMBER TEN ON BLACK SQUARE;No;0;L;;;;10;N;;;;;
+3249;CIRCLED NUMBER TWENTY ON BLACK SQUARE;No;0;L;;;;20;N;;;;;
+324A;CIRCLED NUMBER THIRTY ON BLACK SQUARE;No;0;L;;;;30;N;;;;;
+324B;CIRCLED NUMBER FORTY ON BLACK SQUARE;No;0;L;;;;40;N;;;;;
+324C;CIRCLED NUMBER FIFTY ON BLACK SQUARE;No;0;L;;;;50;N;;;;;
+324D;CIRCLED NUMBER SIXTY ON BLACK SQUARE;No;0;L;;;;60;N;;;;;
+324E;CIRCLED NUMBER SEVENTY ON BLACK SQUARE;No;0;L;;;;70;N;;;;;
+324F;CIRCLED NUMBER EIGHTY ON BLACK SQUARE;No;0;L;;;;80;N;;;;;
3250;PARTNERSHIP SIGN;So;0;ON;<square> 0050 0054 0045;;;;N;;;;;
3251;CIRCLED NUMBER TWENTY ONE;No;0;ON;<circle> 0032 0031;;;21;N;;;;;
3252;CIRCLED NUMBER TWENTY TWO;No;0;ON;<circle> 0032 0032;;;22;N;;;;;
4DFE;HEXAGRAM FOR AFTER COMPLETION;So;0;ON;;;;;N;;;;;
4DFF;HEXAGRAM FOR BEFORE COMPLETION;So;0;ON;;;;;N;;;;;
4E00;<CJK Ideograph, First>;Lo;0;L;;;;;N;;;;;
-9FCB;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;;
+9FCC;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;;
A000;YI SYLLABLE IT;Lo;0;L;;;;;N;;;;;
A001;YI SYLLABLE IX;Lo;0;L;;;;;N;;;;;
A002;YI SYLLABLE I;Lo;0;L;;;;;N;;;;;
A671;COMBINING CYRILLIC HUNDRED MILLIONS SIGN;Me;0;NSM;;;;;N;;;;;
A672;COMBINING CYRILLIC THOUSAND MILLIONS SIGN;Me;0;NSM;;;;;N;;;;;
A673;SLAVONIC ASTERISK;Po;0;ON;;;;;N;;;;;
+A674;COMBINING CYRILLIC LETTER UKRAINIAN IE;Mn;230;NSM;;;;;N;;;;;
+A675;COMBINING CYRILLIC LETTER I;Mn;230;NSM;;;;;N;;;;;
+A676;COMBINING CYRILLIC LETTER YI;Mn;230;NSM;;;;;N;;;;;
+A677;COMBINING CYRILLIC LETTER U;Mn;230;NSM;;;;;N;;;;;
+A678;COMBINING CYRILLIC LETTER HARD SIGN;Mn;230;NSM;;;;;N;;;;;
+A679;COMBINING CYRILLIC LETTER YERU;Mn;230;NSM;;;;;N;;;;;
+A67A;COMBINING CYRILLIC LETTER SOFT SIGN;Mn;230;NSM;;;;;N;;;;;
+A67B;COMBINING CYRILLIC LETTER OMEGA;Mn;230;NSM;;;;;N;;;;;
A67C;COMBINING CYRILLIC KAVYKA;Mn;230;NSM;;;;;N;;;;;
A67D;COMBINING CYRILLIC PAYEROK;Mn;230;NSM;;;;;N;;;;;
A67E;CYRILLIC KAVYKA;Po;0;ON;;;;;N;;;;;
A695;CYRILLIC SMALL LETTER HWE;Ll;0;L;;;;;N;;;A694;;A694
A696;CYRILLIC CAPITAL LETTER SHWE;Lu;0;L;;;;;N;;;;A697;
A697;CYRILLIC SMALL LETTER SHWE;Ll;0;L;;;;;N;;;A696;;A696
+A69F;COMBINING CYRILLIC LETTER IOTIFIED E;Mn;230;NSM;;;;;N;;;;;
A6A0;BAMUM LETTER A;Lo;0;L;;;;;N;;;;;
A6A1;BAMUM LETTER KA;Lo;0;L;;;;;N;;;;;
A6A2;BAMUM LETTER U;Lo;0;L;;;;;N;;;;;
A78E;LATIN SMALL LETTER L WITH RETROFLEX HOOK AND BELT;Ll;0;L;;;;;N;;;;;
A790;LATIN CAPITAL LETTER N WITH DESCENDER;Lu;0;L;;;;;N;;;;A791;
A791;LATIN SMALL LETTER N WITH DESCENDER;Ll;0;L;;;;;N;;;A790;;A790
+A792;LATIN CAPITAL LETTER C WITH BAR;Lu;0;L;;;;;N;;;;A793;
+A793;LATIN SMALL LETTER C WITH BAR;Ll;0;L;;;;;N;;;A792;;A792
A7A0;LATIN CAPITAL LETTER G WITH OBLIQUE STROKE;Lu;0;L;;;;;N;;;;A7A1;
A7A1;LATIN SMALL LETTER G WITH OBLIQUE STROKE;Ll;0;L;;;;;N;;;A7A0;;A7A0
A7A2;LATIN CAPITAL LETTER K WITH OBLIQUE STROKE;Lu;0;L;;;;;N;;;;A7A3;
A7A7;LATIN SMALL LETTER R WITH OBLIQUE STROKE;Ll;0;L;;;;;N;;;A7A6;;A7A6
A7A8;LATIN CAPITAL LETTER S WITH OBLIQUE STROKE;Lu;0;L;;;;;N;;;;A7A9;
A7A9;LATIN SMALL LETTER S WITH OBLIQUE STROKE;Ll;0;L;;;;;N;;;A7A8;;A7A8
+A7AA;LATIN CAPITAL LETTER H WITH HOOK;Lu;0;L;;;;;N;;;;0266;
+A7F8;MODIFIER LETTER CAPITAL H WITH STROKE;Lm;0;L;<super> 0126;;;;N;;;;;
+A7F9;MODIFIER LETTER SMALL LIGATURE OE;Lm;0;L;<super> 0153;;;;N;;;;;
A7FA;LATIN LETTER SMALL CAPITAL TURNED M;Ll;0;L;;;;;N;;;;;
A7FB;LATIN EPIGRAPHIC LETTER REVERSED F;Lo;0;L;;;;;N;;;;;
A7FC;LATIN EPIGRAPHIC LETTER REVERSED P;Lo;0;L;;;;;N;;;;;
AADD;TAI VIET SYMBOL SAM;Lm;0;L;;;;;N;;;;;
AADE;TAI VIET SYMBOL HO HOI;Po;0;L;;;;;N;;;;;
AADF;TAI VIET SYMBOL KOI KOI;Po;0;L;;;;;N;;;;;
+AAE0;MEETEI MAYEK LETTER E;Lo;0;L;;;;;N;;;;;
+AAE1;MEETEI MAYEK LETTER O;Lo;0;L;;;;;N;;;;;
+AAE2;MEETEI MAYEK LETTER CHA;Lo;0;L;;;;;N;;;;;
+AAE3;MEETEI MAYEK LETTER NYA;Lo;0;L;;;;;N;;;;;
+AAE4;MEETEI MAYEK LETTER TTA;Lo;0;L;;;;;N;;;;;
+AAE5;MEETEI MAYEK LETTER TTHA;Lo;0;L;;;;;N;;;;;
+AAE6;MEETEI MAYEK LETTER DDA;Lo;0;L;;;;;N;;;;;
+AAE7;MEETEI MAYEK LETTER DDHA;Lo;0;L;;;;;N;;;;;
+AAE8;MEETEI MAYEK LETTER NNA;Lo;0;L;;;;;N;;;;;
+AAE9;MEETEI MAYEK LETTER SHA;Lo;0;L;;;;;N;;;;;
+AAEA;MEETEI MAYEK LETTER SSA;Lo;0;L;;;;;N;;;;;
+AAEB;MEETEI MAYEK VOWEL SIGN II;Mc;0;L;;;;;N;;;;;
+AAEC;MEETEI MAYEK VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+AAED;MEETEI MAYEK VOWEL SIGN AAI;Mn;0;NSM;;;;;N;;;;;
+AAEE;MEETEI MAYEK VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+AAEF;MEETEI MAYEK VOWEL SIGN AAU;Mc;0;L;;;;;N;;;;;
+AAF0;MEETEI MAYEK CHEIKHAN;Po;0;L;;;;;N;;;;;
+AAF1;MEETEI MAYEK AHANG KHUDAM;Po;0;L;;;;;N;;;;;
+AAF2;MEETEI MAYEK ANJI;Lo;0;L;;;;;N;;;;;
+AAF3;MEETEI MAYEK SYLLABLE REPETITION MARK;Lm;0;L;;;;;N;;;;;
+AAF4;MEETEI MAYEK WORD REPETITION MARK;Lm;0;L;;;;;N;;;;;
+AAF5;MEETEI MAYEK VOWEL SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+AAF6;MEETEI MAYEK VIRAMA;Mn;9;NSM;;;;;N;;;;;
AB01;ETHIOPIC SYLLABLE TTHU;Lo;0;L;;;;;N;;;;;
AB02;ETHIOPIC SYLLABLE TTHI;Lo;0;L;;;;;N;;;;;
AB03;ETHIOPIC SYLLABLE TTHAA;Lo;0;L;;;;;N;;;;;
FA2B;CJK COMPATIBILITY IDEOGRAPH-FA2B;Lo;0;L;98FC;;;;N;;;;;
FA2C;CJK COMPATIBILITY IDEOGRAPH-FA2C;Lo;0;L;9928;;;;N;;;;;
FA2D;CJK COMPATIBILITY IDEOGRAPH-FA2D;Lo;0;L;9DB4;;;;N;;;;;
+FA2E;CJK COMPATIBILITY IDEOGRAPH-FA2E;Lo;0;L;90DE;;;;N;;;;;
+FA2F;CJK COMPATIBILITY IDEOGRAPH-FA2F;Lo;0;L;96B7;;;;N;;;;;
FA30;CJK COMPATIBILITY IDEOGRAPH-FA30;Lo;0;L;4FAE;;;;N;;;;;
FA31;CJK COMPATIBILITY IDEOGRAPH-FA31;Lo;0;L;50E7;;;;N;;;;;
FA32;CJK COMPATIBILITY IDEOGRAPH-FA32;Lo;0;L;514D;;;;N;;;;;
100FA;LINEAR B IDEOGRAM VESSEL B305;Lo;0;L;;;;;N;;;;;
10100;AEGEAN WORD SEPARATOR LINE;Po;0;L;;;;;N;;;;;
10101;AEGEAN WORD SEPARATOR DOT;Po;0;ON;;;;;N;;;;;
-10102;AEGEAN CHECK MARK;So;0;L;;;;;N;;;;;
+10102;AEGEAN CHECK MARK;Po;0;L;;;;;N;;;;;
10107;AEGEAN NUMBER ONE;No;0;L;;;;1;N;;;;;
10108;AEGEAN NUMBER TWO;No;0;L;;;;2;N;;;;;
10109;AEGEAN NUMBER THREE;No;0;L;;;;3;N;;;;;
10938;LYDIAN LETTER NN;Lo;0;R;;;;;N;;;;;
10939;LYDIAN LETTER C;Lo;0;R;;;;;N;;;;;
1093F;LYDIAN TRIANGULAR MARK;Po;0;R;;;;;N;;;;;
+10980;MEROITIC HIEROGLYPHIC LETTER A;Lo;0;R;;;;;N;;;;;
+10981;MEROITIC HIEROGLYPHIC LETTER E;Lo;0;R;;;;;N;;;;;
+10982;MEROITIC HIEROGLYPHIC LETTER I;Lo;0;R;;;;;N;;;;;
+10983;MEROITIC HIEROGLYPHIC LETTER O;Lo;0;R;;;;;N;;;;;
+10984;MEROITIC HIEROGLYPHIC LETTER YA;Lo;0;R;;;;;N;;;;;
+10985;MEROITIC HIEROGLYPHIC LETTER WA;Lo;0;R;;;;;N;;;;;
+10986;MEROITIC HIEROGLYPHIC LETTER BA;Lo;0;R;;;;;N;;;;;
+10987;MEROITIC HIEROGLYPHIC LETTER BA-2;Lo;0;R;;;;;N;;;;;
+10988;MEROITIC HIEROGLYPHIC LETTER PA;Lo;0;R;;;;;N;;;;;
+10989;MEROITIC HIEROGLYPHIC LETTER MA;Lo;0;R;;;;;N;;;;;
+1098A;MEROITIC HIEROGLYPHIC LETTER NA;Lo;0;R;;;;;N;;;;;
+1098B;MEROITIC HIEROGLYPHIC LETTER NA-2;Lo;0;R;;;;;N;;;;;
+1098C;MEROITIC HIEROGLYPHIC LETTER NE;Lo;0;R;;;;;N;;;;;
+1098D;MEROITIC HIEROGLYPHIC LETTER NE-2;Lo;0;R;;;;;N;;;;;
+1098E;MEROITIC HIEROGLYPHIC LETTER RA;Lo;0;R;;;;;N;;;;;
+1098F;MEROITIC HIEROGLYPHIC LETTER RA-2;Lo;0;R;;;;;N;;;;;
+10990;MEROITIC HIEROGLYPHIC LETTER LA;Lo;0;R;;;;;N;;;;;
+10991;MEROITIC HIEROGLYPHIC LETTER KHA;Lo;0;R;;;;;N;;;;;
+10992;MEROITIC HIEROGLYPHIC LETTER HHA;Lo;0;R;;;;;N;;;;;
+10993;MEROITIC HIEROGLYPHIC LETTER SA;Lo;0;R;;;;;N;;;;;
+10994;MEROITIC HIEROGLYPHIC LETTER SA-2;Lo;0;R;;;;;N;;;;;
+10995;MEROITIC HIEROGLYPHIC LETTER SE;Lo;0;R;;;;;N;;;;;
+10996;MEROITIC HIEROGLYPHIC LETTER KA;Lo;0;R;;;;;N;;;;;
+10997;MEROITIC HIEROGLYPHIC LETTER QA;Lo;0;R;;;;;N;;;;;
+10998;MEROITIC HIEROGLYPHIC LETTER TA;Lo;0;R;;;;;N;;;;;
+10999;MEROITIC HIEROGLYPHIC LETTER TA-2;Lo;0;R;;;;;N;;;;;
+1099A;MEROITIC HIEROGLYPHIC LETTER TE;Lo;0;R;;;;;N;;;;;
+1099B;MEROITIC HIEROGLYPHIC LETTER TE-2;Lo;0;R;;;;;N;;;;;
+1099C;MEROITIC HIEROGLYPHIC LETTER TO;Lo;0;R;;;;;N;;;;;
+1099D;MEROITIC HIEROGLYPHIC LETTER DA;Lo;0;R;;;;;N;;;;;
+1099E;MEROITIC HIEROGLYPHIC SYMBOL VIDJ;Lo;0;R;;;;;N;;;;;
+1099F;MEROITIC HIEROGLYPHIC SYMBOL VIDJ-2;Lo;0;R;;;;;N;;;;;
+109A0;MEROITIC CURSIVE LETTER A;Lo;0;R;;;;;N;;;;;
+109A1;MEROITIC CURSIVE LETTER E;Lo;0;R;;;;;N;;;;;
+109A2;MEROITIC CURSIVE LETTER I;Lo;0;R;;;;;N;;;;;
+109A3;MEROITIC CURSIVE LETTER O;Lo;0;R;;;;;N;;;;;
+109A4;MEROITIC CURSIVE LETTER YA;Lo;0;R;;;;;N;;;;;
+109A5;MEROITIC CURSIVE LETTER WA;Lo;0;R;;;;;N;;;;;
+109A6;MEROITIC CURSIVE LETTER BA;Lo;0;R;;;;;N;;;;;
+109A7;MEROITIC CURSIVE LETTER PA;Lo;0;R;;;;;N;;;;;
+109A8;MEROITIC CURSIVE LETTER MA;Lo;0;R;;;;;N;;;;;
+109A9;MEROITIC CURSIVE LETTER NA;Lo;0;R;;;;;N;;;;;
+109AA;MEROITIC CURSIVE LETTER NE;Lo;0;R;;;;;N;;;;;
+109AB;MEROITIC CURSIVE LETTER RA;Lo;0;R;;;;;N;;;;;
+109AC;MEROITIC CURSIVE LETTER LA;Lo;0;R;;;;;N;;;;;
+109AD;MEROITIC CURSIVE LETTER KHA;Lo;0;R;;;;;N;;;;;
+109AE;MEROITIC CURSIVE LETTER HHA;Lo;0;R;;;;;N;;;;;
+109AF;MEROITIC CURSIVE LETTER SA;Lo;0;R;;;;;N;;;;;
+109B0;MEROITIC CURSIVE LETTER ARCHAIC SA;Lo;0;R;;;;;N;;;;;
+109B1;MEROITIC CURSIVE LETTER SE;Lo;0;R;;;;;N;;;;;
+109B2;MEROITIC CURSIVE LETTER KA;Lo;0;R;;;;;N;;;;;
+109B3;MEROITIC CURSIVE LETTER QA;Lo;0;R;;;;;N;;;;;
+109B4;MEROITIC CURSIVE LETTER TA;Lo;0;R;;;;;N;;;;;
+109B5;MEROITIC CURSIVE LETTER TE;Lo;0;R;;;;;N;;;;;
+109B6;MEROITIC CURSIVE LETTER TO;Lo;0;R;;;;;N;;;;;
+109B7;MEROITIC CURSIVE LETTER DA;Lo;0;R;;;;;N;;;;;
+109BE;MEROITIC CURSIVE LOGOGRAM RMT;Lo;0;R;;;;;N;;;;;
+109BF;MEROITIC CURSIVE LOGOGRAM IMN;Lo;0;R;;;;;N;;;;;
10A00;KHAROSHTHI LETTER A;Lo;0;R;;;;;N;;;;;
10A01;KHAROSHTHI VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
10A02;KHAROSHTHI VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
110BF;KAITHI DOUBLE SECTION MARK;Po;0;L;;;;;N;;;;;
110C0;KAITHI DANDA;Po;0;L;;;;;N;;;;;
110C1;KAITHI DOUBLE DANDA;Po;0;L;;;;;N;;;;;
+110D0;SORA SOMPENG LETTER SAH;Lo;0;L;;;;;N;;;;;
+110D1;SORA SOMPENG LETTER TAH;Lo;0;L;;;;;N;;;;;
+110D2;SORA SOMPENG LETTER BAH;Lo;0;L;;;;;N;;;;;
+110D3;SORA SOMPENG LETTER CAH;Lo;0;L;;;;;N;;;;;
+110D4;SORA SOMPENG LETTER DAH;Lo;0;L;;;;;N;;;;;
+110D5;SORA SOMPENG LETTER GAH;Lo;0;L;;;;;N;;;;;
+110D6;SORA SOMPENG LETTER MAH;Lo;0;L;;;;;N;;;;;
+110D7;SORA SOMPENG LETTER NGAH;Lo;0;L;;;;;N;;;;;
+110D8;SORA SOMPENG LETTER LAH;Lo;0;L;;;;;N;;;;;
+110D9;SORA SOMPENG LETTER NAH;Lo;0;L;;;;;N;;;;;
+110DA;SORA SOMPENG LETTER VAH;Lo;0;L;;;;;N;;;;;
+110DB;SORA SOMPENG LETTER PAH;Lo;0;L;;;;;N;;;;;
+110DC;SORA SOMPENG LETTER YAH;Lo;0;L;;;;;N;;;;;
+110DD;SORA SOMPENG LETTER RAH;Lo;0;L;;;;;N;;;;;
+110DE;SORA SOMPENG LETTER HAH;Lo;0;L;;;;;N;;;;;
+110DF;SORA SOMPENG LETTER KAH;Lo;0;L;;;;;N;;;;;
+110E0;SORA SOMPENG LETTER JAH;Lo;0;L;;;;;N;;;;;
+110E1;SORA SOMPENG LETTER NYAH;Lo;0;L;;;;;N;;;;;
+110E2;SORA SOMPENG LETTER AH;Lo;0;L;;;;;N;;;;;
+110E3;SORA SOMPENG LETTER EEH;Lo;0;L;;;;;N;;;;;
+110E4;SORA SOMPENG LETTER IH;Lo;0;L;;;;;N;;;;;
+110E5;SORA SOMPENG LETTER UH;Lo;0;L;;;;;N;;;;;
+110E6;SORA SOMPENG LETTER OH;Lo;0;L;;;;;N;;;;;
+110E7;SORA SOMPENG LETTER EH;Lo;0;L;;;;;N;;;;;
+110E8;SORA SOMPENG LETTER MAE;Lo;0;L;;;;;N;;;;;
+110F0;SORA SOMPENG DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+110F1;SORA SOMPENG DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+110F2;SORA SOMPENG DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+110F3;SORA SOMPENG DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+110F4;SORA SOMPENG DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+110F5;SORA SOMPENG DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+110F6;SORA SOMPENG DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+110F7;SORA SOMPENG DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+110F8;SORA SOMPENG DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+110F9;SORA SOMPENG DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+11100;CHAKMA SIGN CANDRABINDU;Mn;230;NSM;;;;;N;;;;;
+11101;CHAKMA SIGN ANUSVARA;Mn;230;NSM;;;;;N;;;;;
+11102;CHAKMA SIGN VISARGA;Mn;230;NSM;;;;;N;;;;;
+11103;CHAKMA LETTER AA;Lo;0;L;;;;;N;;;;;
+11104;CHAKMA LETTER I;Lo;0;L;;;;;N;;;;;
+11105;CHAKMA LETTER U;Lo;0;L;;;;;N;;;;;
+11106;CHAKMA LETTER E;Lo;0;L;;;;;N;;;;;
+11107;CHAKMA LETTER KAA;Lo;0;L;;;;;N;;;;;
+11108;CHAKMA LETTER KHAA;Lo;0;L;;;;;N;;;;;
+11109;CHAKMA LETTER GAA;Lo;0;L;;;;;N;;;;;
+1110A;CHAKMA LETTER GHAA;Lo;0;L;;;;;N;;;;;
+1110B;CHAKMA LETTER NGAA;Lo;0;L;;;;;N;;;;;
+1110C;CHAKMA LETTER CAA;Lo;0;L;;;;;N;;;;;
+1110D;CHAKMA LETTER CHAA;Lo;0;L;;;;;N;;;;;
+1110E;CHAKMA LETTER JAA;Lo;0;L;;;;;N;;;;;
+1110F;CHAKMA LETTER JHAA;Lo;0;L;;;;;N;;;;;
+11110;CHAKMA LETTER NYAA;Lo;0;L;;;;;N;;;;;
+11111;CHAKMA LETTER TTAA;Lo;0;L;;;;;N;;;;;
+11112;CHAKMA LETTER TTHAA;Lo;0;L;;;;;N;;;;;
+11113;CHAKMA LETTER DDAA;Lo;0;L;;;;;N;;;;;
+11114;CHAKMA LETTER DDHAA;Lo;0;L;;;;;N;;;;;
+11115;CHAKMA LETTER NNAA;Lo;0;L;;;;;N;;;;;
+11116;CHAKMA LETTER TAA;Lo;0;L;;;;;N;;;;;
+11117;CHAKMA LETTER THAA;Lo;0;L;;;;;N;;;;;
+11118;CHAKMA LETTER DAA;Lo;0;L;;;;;N;;;;;
+11119;CHAKMA LETTER DHAA;Lo;0;L;;;;;N;;;;;
+1111A;CHAKMA LETTER NAA;Lo;0;L;;;;;N;;;;;
+1111B;CHAKMA LETTER PAA;Lo;0;L;;;;;N;;;;;
+1111C;CHAKMA LETTER PHAA;Lo;0;L;;;;;N;;;;;
+1111D;CHAKMA LETTER BAA;Lo;0;L;;;;;N;;;;;
+1111E;CHAKMA LETTER BHAA;Lo;0;L;;;;;N;;;;;
+1111F;CHAKMA LETTER MAA;Lo;0;L;;;;;N;;;;;
+11120;CHAKMA LETTER YYAA;Lo;0;L;;;;;N;;;;;
+11121;CHAKMA LETTER YAA;Lo;0;L;;;;;N;;;;;
+11122;CHAKMA LETTER RAA;Lo;0;L;;;;;N;;;;;
+11123;CHAKMA LETTER LAA;Lo;0;L;;;;;N;;;;;
+11124;CHAKMA LETTER WAA;Lo;0;L;;;;;N;;;;;
+11125;CHAKMA LETTER SAA;Lo;0;L;;;;;N;;;;;
+11126;CHAKMA LETTER HAA;Lo;0;L;;;;;N;;;;;
+11127;CHAKMA VOWEL SIGN A;Mn;0;NSM;;;;;N;;;;;
+11128;CHAKMA VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
+11129;CHAKMA VOWEL SIGN II;Mn;0;NSM;;;;;N;;;;;
+1112A;CHAKMA VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+1112B;CHAKMA VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+1112C;CHAKMA VOWEL SIGN E;Mc;0;L;;;;;N;;;;;
+1112D;CHAKMA VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;;
+1112E;CHAKMA VOWEL SIGN O;Mn;0;NSM;11131 11127;;;;N;;;;;
+1112F;CHAKMA VOWEL SIGN AU;Mn;0;NSM;11132 11127;;;;N;;;;;
+11130;CHAKMA VOWEL SIGN OI;Mn;0;NSM;;;;;N;;;;;
+11131;CHAKMA O MARK;Mn;0;NSM;;;;;N;;;;;
+11132;CHAKMA AU MARK;Mn;0;NSM;;;;;N;;;;;
+11133;CHAKMA VIRAMA;Mn;9;NSM;;;;;N;;;;;
+11134;CHAKMA MAAYYAA;Mn;9;NSM;;;;;N;;;;;
+11136;CHAKMA DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+11137;CHAKMA DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+11138;CHAKMA DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+11139;CHAKMA DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+1113A;CHAKMA DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+1113B;CHAKMA DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+1113C;CHAKMA DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+1113D;CHAKMA DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+1113E;CHAKMA DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+1113F;CHAKMA DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+11140;CHAKMA SECTION MARK;Po;0;L;;;;;N;;;;;
+11141;CHAKMA DANDA;Po;0;L;;;;;N;;;;;
+11142;CHAKMA DOUBLE DANDA;Po;0;L;;;;;N;;;;;
+11143;CHAKMA QUESTION MARK;Po;0;L;;;;;N;;;;;
+11180;SHARADA SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
+11181;SHARADA SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+11182;SHARADA SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+11183;SHARADA LETTER A;Lo;0;L;;;;;N;;;;;
+11184;SHARADA LETTER AA;Lo;0;L;;;;;N;;;;;
+11185;SHARADA LETTER I;Lo;0;L;;;;;N;;;;;
+11186;SHARADA LETTER II;Lo;0;L;;;;;N;;;;;
+11187;SHARADA LETTER U;Lo;0;L;;;;;N;;;;;
+11188;SHARADA LETTER UU;Lo;0;L;;;;;N;;;;;
+11189;SHARADA LETTER VOCALIC R;Lo;0;L;;;;;N;;;;;
+1118A;SHARADA LETTER VOCALIC RR;Lo;0;L;;;;;N;;;;;
+1118B;SHARADA LETTER VOCALIC L;Lo;0;L;;;;;N;;;;;
+1118C;SHARADA LETTER VOCALIC LL;Lo;0;L;;;;;N;;;;;
+1118D;SHARADA LETTER E;Lo;0;L;;;;;N;;;;;
+1118E;SHARADA LETTER AI;Lo;0;L;;;;;N;;;;;
+1118F;SHARADA LETTER O;Lo;0;L;;;;;N;;;;;
+11190;SHARADA LETTER AU;Lo;0;L;;;;;N;;;;;
+11191;SHARADA LETTER KA;Lo;0;L;;;;;N;;;;;
+11192;SHARADA LETTER KHA;Lo;0;L;;;;;N;;;;;
+11193;SHARADA LETTER GA;Lo;0;L;;;;;N;;;;;
+11194;SHARADA LETTER GHA;Lo;0;L;;;;;N;;;;;
+11195;SHARADA LETTER NGA;Lo;0;L;;;;;N;;;;;
+11196;SHARADA LETTER CA;Lo;0;L;;;;;N;;;;;
+11197;SHARADA LETTER CHA;Lo;0;L;;;;;N;;;;;
+11198;SHARADA LETTER JA;Lo;0;L;;;;;N;;;;;
+11199;SHARADA LETTER JHA;Lo;0;L;;;;;N;;;;;
+1119A;SHARADA LETTER NYA;Lo;0;L;;;;;N;;;;;
+1119B;SHARADA LETTER TTA;Lo;0;L;;;;;N;;;;;
+1119C;SHARADA LETTER TTHA;Lo;0;L;;;;;N;;;;;
+1119D;SHARADA LETTER DDA;Lo;0;L;;;;;N;;;;;
+1119E;SHARADA LETTER DDHA;Lo;0;L;;;;;N;;;;;
+1119F;SHARADA LETTER NNA;Lo;0;L;;;;;N;;;;;
+111A0;SHARADA LETTER TA;Lo;0;L;;;;;N;;;;;
+111A1;SHARADA LETTER THA;Lo;0;L;;;;;N;;;;;
+111A2;SHARADA LETTER DA;Lo;0;L;;;;;N;;;;;
+111A3;SHARADA LETTER DHA;Lo;0;L;;;;;N;;;;;
+111A4;SHARADA LETTER NA;Lo;0;L;;;;;N;;;;;
+111A5;SHARADA LETTER PA;Lo;0;L;;;;;N;;;;;
+111A6;SHARADA LETTER PHA;Lo;0;L;;;;;N;;;;;
+111A7;SHARADA LETTER BA;Lo;0;L;;;;;N;;;;;
+111A8;SHARADA LETTER BHA;Lo;0;L;;;;;N;;;;;
+111A9;SHARADA LETTER MA;Lo;0;L;;;;;N;;;;;
+111AA;SHARADA LETTER YA;Lo;0;L;;;;;N;;;;;
+111AB;SHARADA LETTER RA;Lo;0;L;;;;;N;;;;;
+111AC;SHARADA LETTER LA;Lo;0;L;;;;;N;;;;;
+111AD;SHARADA LETTER LLA;Lo;0;L;;;;;N;;;;;
+111AE;SHARADA LETTER VA;Lo;0;L;;;;;N;;;;;
+111AF;SHARADA LETTER SHA;Lo;0;L;;;;;N;;;;;
+111B0;SHARADA LETTER SSA;Lo;0;L;;;;;N;;;;;
+111B1;SHARADA LETTER SA;Lo;0;L;;;;;N;;;;;
+111B2;SHARADA LETTER HA;Lo;0;L;;;;;N;;;;;
+111B3;SHARADA VOWEL SIGN AA;Mc;0;L;;;;;N;;;;;
+111B4;SHARADA VOWEL SIGN I;Mc;0;L;;;;;N;;;;;
+111B5;SHARADA VOWEL SIGN II;Mc;0;L;;;;;N;;;;;
+111B6;SHARADA VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+111B7;SHARADA VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+111B8;SHARADA VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;;
+111B9;SHARADA VOWEL SIGN VOCALIC RR;Mn;0;NSM;;;;;N;;;;;
+111BA;SHARADA VOWEL SIGN VOCALIC L;Mn;0;NSM;;;;;N;;;;;
+111BB;SHARADA VOWEL SIGN VOCALIC LL;Mn;0;NSM;;;;;N;;;;;
+111BC;SHARADA VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+111BD;SHARADA VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;;
+111BE;SHARADA VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+111BF;SHARADA VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+111C0;SHARADA SIGN VIRAMA;Mc;9;L;;;;;N;;;;;
+111C1;SHARADA SIGN AVAGRAHA;Lo;0;L;;;;;N;;;;;
+111C2;SHARADA SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;;
+111C3;SHARADA SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;;
+111C4;SHARADA OM;Lo;0;L;;;;;N;;;;;
+111C5;SHARADA DANDA;Po;0;L;;;;;N;;;;;
+111C6;SHARADA DOUBLE DANDA;Po;0;L;;;;;N;;;;;
+111C7;SHARADA ABBREVIATION SIGN;Po;0;L;;;;;N;;;;;
+111C8;SHARADA SEPARATOR;Po;0;L;;;;;N;;;;;
+111D0;SHARADA DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+111D1;SHARADA DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+111D2;SHARADA DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+111D3;SHARADA DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+111D4;SHARADA DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+111D5;SHARADA DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+111D6;SHARADA DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+111D7;SHARADA DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+111D8;SHARADA DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+111D9;SHARADA DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
+11680;TAKRI LETTER A;Lo;0;L;;;;;N;;;;;
+11681;TAKRI LETTER AA;Lo;0;L;;;;;N;;;;;
+11682;TAKRI LETTER I;Lo;0;L;;;;;N;;;;;
+11683;TAKRI LETTER II;Lo;0;L;;;;;N;;;;;
+11684;TAKRI LETTER U;Lo;0;L;;;;;N;;;;;
+11685;TAKRI LETTER UU;Lo;0;L;;;;;N;;;;;
+11686;TAKRI LETTER E;Lo;0;L;;;;;N;;;;;
+11687;TAKRI LETTER AI;Lo;0;L;;;;;N;;;;;
+11688;TAKRI LETTER O;Lo;0;L;;;;;N;;;;;
+11689;TAKRI LETTER AU;Lo;0;L;;;;;N;;;;;
+1168A;TAKRI LETTER KA;Lo;0;L;;;;;N;;;;;
+1168B;TAKRI LETTER KHA;Lo;0;L;;;;;N;;;;;
+1168C;TAKRI LETTER GA;Lo;0;L;;;;;N;;;;;
+1168D;TAKRI LETTER GHA;Lo;0;L;;;;;N;;;;;
+1168E;TAKRI LETTER NGA;Lo;0;L;;;;;N;;;;;
+1168F;TAKRI LETTER CA;Lo;0;L;;;;;N;;;;;
+11690;TAKRI LETTER CHA;Lo;0;L;;;;;N;;;;;
+11691;TAKRI LETTER JA;Lo;0;L;;;;;N;;;;;
+11692;TAKRI LETTER JHA;Lo;0;L;;;;;N;;;;;
+11693;TAKRI LETTER NYA;Lo;0;L;;;;;N;;;;;
+11694;TAKRI LETTER TTA;Lo;0;L;;;;;N;;;;;
+11695;TAKRI LETTER TTHA;Lo;0;L;;;;;N;;;;;
+11696;TAKRI LETTER DDA;Lo;0;L;;;;;N;;;;;
+11697;TAKRI LETTER DDHA;Lo;0;L;;;;;N;;;;;
+11698;TAKRI LETTER NNA;Lo;0;L;;;;;N;;;;;
+11699;TAKRI LETTER TA;Lo;0;L;;;;;N;;;;;
+1169A;TAKRI LETTER THA;Lo;0;L;;;;;N;;;;;
+1169B;TAKRI LETTER DA;Lo;0;L;;;;;N;;;;;
+1169C;TAKRI LETTER DHA;Lo;0;L;;;;;N;;;;;
+1169D;TAKRI LETTER NA;Lo;0;L;;;;;N;;;;;
+1169E;TAKRI LETTER PA;Lo;0;L;;;;;N;;;;;
+1169F;TAKRI LETTER PHA;Lo;0;L;;;;;N;;;;;
+116A0;TAKRI LETTER BA;Lo;0;L;;;;;N;;;;;
+116A1;TAKRI LETTER BHA;Lo;0;L;;;;;N;;;;;
+116A2;TAKRI LETTER MA;Lo;0;L;;;;;N;;;;;
+116A3;TAKRI LETTER YA;Lo;0;L;;;;;N;;;;;
+116A4;TAKRI LETTER RA;Lo;0;L;;;;;N;;;;;
+116A5;TAKRI LETTER LA;Lo;0;L;;;;;N;;;;;
+116A6;TAKRI LETTER VA;Lo;0;L;;;;;N;;;;;
+116A7;TAKRI LETTER SHA;Lo;0;L;;;;;N;;;;;
+116A8;TAKRI LETTER SA;Lo;0;L;;;;;N;;;;;
+116A9;TAKRI LETTER HA;Lo;0;L;;;;;N;;;;;
+116AA;TAKRI LETTER RRA;Lo;0;L;;;;;N;;;;;
+116AB;TAKRI SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+116AC;TAKRI SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+116AD;TAKRI VOWEL SIGN AA;Mn;0;NSM;;;;;N;;;;;
+116AE;TAKRI VOWEL SIGN I;Mc;0;L;;;;;N;;;;;
+116AF;TAKRI VOWEL SIGN II;Mc;0;L;;;;;N;;;;;
+116B0;TAKRI VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+116B1;TAKRI VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+116B2;TAKRI VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+116B3;TAKRI VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;;
+116B4;TAKRI VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+116B5;TAKRI VOWEL SIGN AU;Mn;0;NSM;;;;;N;;;;;
+116B6;TAKRI SIGN VIRAMA;Mc;9;L;;;;;N;;;;;
+116B7;TAKRI SIGN NUKTA;Mn;7;NSM;;;;;N;;;;;
+116C0;TAKRI DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+116C1;TAKRI DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+116C2;TAKRI DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+116C3;TAKRI DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+116C4;TAKRI DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+116C5;TAKRI DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+116C6;TAKRI DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+116C7;TAKRI DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+116C8;TAKRI DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+116C9;TAKRI DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
12000;CUNEIFORM SIGN A;Lo;0;L;;;;;N;;;;;
12001;CUNEIFORM SIGN A TIMES A;Lo;0;L;;;;;N;;;;;
12002;CUNEIFORM SIGN A TIMES BAD;Lo;0;L;;;;;N;;;;;
1242F;CUNEIFORM NUMERIC SIGN THREE SHARU VARIANT FORM;Nl;0;L;;;;3;N;;;;;
12430;CUNEIFORM NUMERIC SIGN FOUR SHARU;Nl;0;L;;;;4;N;;;;;
12431;CUNEIFORM NUMERIC SIGN FIVE SHARU;Nl;0;L;;;;5;N;;;;;
-12432;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS DISH;Nl;0;L;;;;;N;;;;;
-12433;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS MIN;Nl;0;L;;;;;N;;;;;
+12432;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS DISH;Nl;0;L;;;;216000;N;;;;;
+12433;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS MIN;Nl;0;L;;;;432000;N;;;;;
12434;CUNEIFORM NUMERIC SIGN ONE BURU;Nl;0;L;;;;1;N;;;;;
12435;CUNEIFORM NUMERIC SIGN TWO BURU;Nl;0;L;;;;2;N;;;;;
12436;CUNEIFORM NUMERIC SIGN THREE BURU;Nl;0;L;;;;3;N;;;;;
12453;CUNEIFORM NUMERIC SIGN FOUR BAN2 VARIANT FORM;Nl;0;L;;;;4;N;;;;;
12454;CUNEIFORM NUMERIC SIGN FIVE BAN2;Nl;0;L;;;;5;N;;;;;
12455;CUNEIFORM NUMERIC SIGN FIVE BAN2 VARIANT FORM;Nl;0;L;;;;5;N;;;;;
-12456;CUNEIFORM NUMERIC SIGN NIGIDAMIN;Nl;0;L;;;;;N;;;;;
-12457;CUNEIFORM NUMERIC SIGN NIGIDAESH;Nl;0;L;;;;;N;;;;;
+12456;CUNEIFORM NUMERIC SIGN NIGIDAMIN;Nl;0;L;;;;-1;N;;;;;
+12457;CUNEIFORM NUMERIC SIGN NIGIDAESH;Nl;0;L;;;;-1;N;;;;;
12458;CUNEIFORM NUMERIC SIGN ONE ESHE3;Nl;0;L;;;;1;N;;;;;
12459;CUNEIFORM NUMERIC SIGN TWO ESHE3;Nl;0;L;;;;2;N;;;;;
1245A;CUNEIFORM NUMERIC SIGN ONE THIRD DISH;Nl;0;L;;;;1/3;N;;;;;
16A36;BAMUM LETTER PHASE-F KPA;Lo;0;L;;;;;N;;;;;
16A37;BAMUM LETTER PHASE-F SAMBA;Lo;0;L;;;;;N;;;;;
16A38;BAMUM LETTER PHASE-F VUEQ;Lo;0;L;;;;;N;;;;;
+16F00;MIAO LETTER PA;Lo;0;L;;;;;N;;;;;
+16F01;MIAO LETTER BA;Lo;0;L;;;;;N;;;;;
+16F02;MIAO LETTER YI PA;Lo;0;L;;;;;N;;;;;
+16F03;MIAO LETTER PLA;Lo;0;L;;;;;N;;;;;
+16F04;MIAO LETTER MA;Lo;0;L;;;;;N;;;;;
+16F05;MIAO LETTER MHA;Lo;0;L;;;;;N;;;;;
+16F06;MIAO LETTER ARCHAIC MA;Lo;0;L;;;;;N;;;;;
+16F07;MIAO LETTER FA;Lo;0;L;;;;;N;;;;;
+16F08;MIAO LETTER VA;Lo;0;L;;;;;N;;;;;
+16F09;MIAO LETTER VFA;Lo;0;L;;;;;N;;;;;
+16F0A;MIAO LETTER TA;Lo;0;L;;;;;N;;;;;
+16F0B;MIAO LETTER DA;Lo;0;L;;;;;N;;;;;
+16F0C;MIAO LETTER YI TTA;Lo;0;L;;;;;N;;;;;
+16F0D;MIAO LETTER YI TA;Lo;0;L;;;;;N;;;;;
+16F0E;MIAO LETTER TTA;Lo;0;L;;;;;N;;;;;
+16F0F;MIAO LETTER DDA;Lo;0;L;;;;;N;;;;;
+16F10;MIAO LETTER NA;Lo;0;L;;;;;N;;;;;
+16F11;MIAO LETTER NHA;Lo;0;L;;;;;N;;;;;
+16F12;MIAO LETTER YI NNA;Lo;0;L;;;;;N;;;;;
+16F13;MIAO LETTER ARCHAIC NA;Lo;0;L;;;;;N;;;;;
+16F14;MIAO LETTER NNA;Lo;0;L;;;;;N;;;;;
+16F15;MIAO LETTER NNHA;Lo;0;L;;;;;N;;;;;
+16F16;MIAO LETTER LA;Lo;0;L;;;;;N;;;;;
+16F17;MIAO LETTER LYA;Lo;0;L;;;;;N;;;;;
+16F18;MIAO LETTER LHA;Lo;0;L;;;;;N;;;;;
+16F19;MIAO LETTER LHYA;Lo;0;L;;;;;N;;;;;
+16F1A;MIAO LETTER TLHA;Lo;0;L;;;;;N;;;;;
+16F1B;MIAO LETTER DLHA;Lo;0;L;;;;;N;;;;;
+16F1C;MIAO LETTER TLHYA;Lo;0;L;;;;;N;;;;;
+16F1D;MIAO LETTER DLHYA;Lo;0;L;;;;;N;;;;;
+16F1E;MIAO LETTER KA;Lo;0;L;;;;;N;;;;;
+16F1F;MIAO LETTER GA;Lo;0;L;;;;;N;;;;;
+16F20;MIAO LETTER YI KA;Lo;0;L;;;;;N;;;;;
+16F21;MIAO LETTER QA;Lo;0;L;;;;;N;;;;;
+16F22;MIAO LETTER QGA;Lo;0;L;;;;;N;;;;;
+16F23;MIAO LETTER NGA;Lo;0;L;;;;;N;;;;;
+16F24;MIAO LETTER NGHA;Lo;0;L;;;;;N;;;;;
+16F25;MIAO LETTER ARCHAIC NGA;Lo;0;L;;;;;N;;;;;
+16F26;MIAO LETTER HA;Lo;0;L;;;;;N;;;;;
+16F27;MIAO LETTER XA;Lo;0;L;;;;;N;;;;;
+16F28;MIAO LETTER GHA;Lo;0;L;;;;;N;;;;;
+16F29;MIAO LETTER GHHA;Lo;0;L;;;;;N;;;;;
+16F2A;MIAO LETTER TSSA;Lo;0;L;;;;;N;;;;;
+16F2B;MIAO LETTER DZZA;Lo;0;L;;;;;N;;;;;
+16F2C;MIAO LETTER NYA;Lo;0;L;;;;;N;;;;;
+16F2D;MIAO LETTER NYHA;Lo;0;L;;;;;N;;;;;
+16F2E;MIAO LETTER TSHA;Lo;0;L;;;;;N;;;;;
+16F2F;MIAO LETTER DZHA;Lo;0;L;;;;;N;;;;;
+16F30;MIAO LETTER YI TSHA;Lo;0;L;;;;;N;;;;;
+16F31;MIAO LETTER YI DZHA;Lo;0;L;;;;;N;;;;;
+16F32;MIAO LETTER REFORMED TSHA;Lo;0;L;;;;;N;;;;;
+16F33;MIAO LETTER SHA;Lo;0;L;;;;;N;;;;;
+16F34;MIAO LETTER SSA;Lo;0;L;;;;;N;;;;;
+16F35;MIAO LETTER ZHA;Lo;0;L;;;;;N;;;;;
+16F36;MIAO LETTER ZSHA;Lo;0;L;;;;;N;;;;;
+16F37;MIAO LETTER TSA;Lo;0;L;;;;;N;;;;;
+16F38;MIAO LETTER DZA;Lo;0;L;;;;;N;;;;;
+16F39;MIAO LETTER YI TSA;Lo;0;L;;;;;N;;;;;
+16F3A;MIAO LETTER SA;Lo;0;L;;;;;N;;;;;
+16F3B;MIAO LETTER ZA;Lo;0;L;;;;;N;;;;;
+16F3C;MIAO LETTER ZSA;Lo;0;L;;;;;N;;;;;
+16F3D;MIAO LETTER ZZA;Lo;0;L;;;;;N;;;;;
+16F3E;MIAO LETTER ZZSA;Lo;0;L;;;;;N;;;;;
+16F3F;MIAO LETTER ARCHAIC ZZA;Lo;0;L;;;;;N;;;;;
+16F40;MIAO LETTER ZZYA;Lo;0;L;;;;;N;;;;;
+16F41;MIAO LETTER ZZSYA;Lo;0;L;;;;;N;;;;;
+16F42;MIAO LETTER WA;Lo;0;L;;;;;N;;;;;
+16F43;MIAO LETTER AH;Lo;0;L;;;;;N;;;;;
+16F44;MIAO LETTER HHA;Lo;0;L;;;;;N;;;;;
+16F50;MIAO LETTER NASALIZATION;Lo;0;L;;;;;N;;;;;
+16F51;MIAO SIGN ASPIRATION;Mc;0;L;;;;;N;;;;;
+16F52;MIAO SIGN REFORMED VOICING;Mc;0;L;;;;;N;;;;;
+16F53;MIAO SIGN REFORMED ASPIRATION;Mc;0;L;;;;;N;;;;;
+16F54;MIAO VOWEL SIGN A;Mc;0;L;;;;;N;;;;;
+16F55;MIAO VOWEL SIGN AA;Mc;0;L;;;;;N;;;;;
+16F56;MIAO VOWEL SIGN AHH;Mc;0;L;;;;;N;;;;;
+16F57;MIAO VOWEL SIGN AN;Mc;0;L;;;;;N;;;;;
+16F58;MIAO VOWEL SIGN ANG;Mc;0;L;;;;;N;;;;;
+16F59;MIAO VOWEL SIGN O;Mc;0;L;;;;;N;;;;;
+16F5A;MIAO VOWEL SIGN OO;Mc;0;L;;;;;N;;;;;
+16F5B;MIAO VOWEL SIGN WO;Mc;0;L;;;;;N;;;;;
+16F5C;MIAO VOWEL SIGN W;Mc;0;L;;;;;N;;;;;
+16F5D;MIAO VOWEL SIGN E;Mc;0;L;;;;;N;;;;;
+16F5E;MIAO VOWEL SIGN EN;Mc;0;L;;;;;N;;;;;
+16F5F;MIAO VOWEL SIGN ENG;Mc;0;L;;;;;N;;;;;
+16F60;MIAO VOWEL SIGN OEY;Mc;0;L;;;;;N;;;;;
+16F61;MIAO VOWEL SIGN I;Mc;0;L;;;;;N;;;;;
+16F62;MIAO VOWEL SIGN IA;Mc;0;L;;;;;N;;;;;
+16F63;MIAO VOWEL SIGN IAN;Mc;0;L;;;;;N;;;;;
+16F64;MIAO VOWEL SIGN IANG;Mc;0;L;;;;;N;;;;;
+16F65;MIAO VOWEL SIGN IO;Mc;0;L;;;;;N;;;;;
+16F66;MIAO VOWEL SIGN IE;Mc;0;L;;;;;N;;;;;
+16F67;MIAO VOWEL SIGN II;Mc;0;L;;;;;N;;;;;
+16F68;MIAO VOWEL SIGN IU;Mc;0;L;;;;;N;;;;;
+16F69;MIAO VOWEL SIGN ING;Mc;0;L;;;;;N;;;;;
+16F6A;MIAO VOWEL SIGN U;Mc;0;L;;;;;N;;;;;
+16F6B;MIAO VOWEL SIGN UA;Mc;0;L;;;;;N;;;;;
+16F6C;MIAO VOWEL SIGN UAN;Mc;0;L;;;;;N;;;;;
+16F6D;MIAO VOWEL SIGN UANG;Mc;0;L;;;;;N;;;;;
+16F6E;MIAO VOWEL SIGN UU;Mc;0;L;;;;;N;;;;;
+16F6F;MIAO VOWEL SIGN UEI;Mc;0;L;;;;;N;;;;;
+16F70;MIAO VOWEL SIGN UNG;Mc;0;L;;;;;N;;;;;
+16F71;MIAO VOWEL SIGN Y;Mc;0;L;;;;;N;;;;;
+16F72;MIAO VOWEL SIGN YI;Mc;0;L;;;;;N;;;;;
+16F73;MIAO VOWEL SIGN AE;Mc;0;L;;;;;N;;;;;
+16F74;MIAO VOWEL SIGN AEE;Mc;0;L;;;;;N;;;;;
+16F75;MIAO VOWEL SIGN ERR;Mc;0;L;;;;;N;;;;;
+16F76;MIAO VOWEL SIGN ROUNDED ERR;Mc;0;L;;;;;N;;;;;
+16F77;MIAO VOWEL SIGN ER;Mc;0;L;;;;;N;;;;;
+16F78;MIAO VOWEL SIGN ROUNDED ER;Mc;0;L;;;;;N;;;;;
+16F79;MIAO VOWEL SIGN AI;Mc;0;L;;;;;N;;;;;
+16F7A;MIAO VOWEL SIGN EI;Mc;0;L;;;;;N;;;;;
+16F7B;MIAO VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+16F7C;MIAO VOWEL SIGN OU;Mc;0;L;;;;;N;;;;;
+16F7D;MIAO VOWEL SIGN N;Mc;0;L;;;;;N;;;;;
+16F7E;MIAO VOWEL SIGN NG;Mc;0;L;;;;;N;;;;;
+16F8F;MIAO TONE RIGHT;Mn;0;NSM;;;;;N;;;;;
+16F90;MIAO TONE TOP RIGHT;Mn;0;NSM;;;;;N;;;;;
+16F91;MIAO TONE ABOVE;Mn;0;NSM;;;;;N;;;;;
+16F92;MIAO TONE BELOW;Mn;0;NSM;;;;;N;;;;;
+16F93;MIAO LETTER TONE-2;Lm;0;L;;;;;N;;;;;
+16F94;MIAO LETTER TONE-3;Lm;0;L;;;;;N;;;;;
+16F95;MIAO LETTER TONE-4;Lm;0;L;;;;;N;;;;;
+16F96;MIAO LETTER TONE-5;Lm;0;L;;;;;N;;;;;
+16F97;MIAO LETTER TONE-6;Lm;0;L;;;;;N;;;;;
+16F98;MIAO LETTER TONE-7;Lm;0;L;;;;;N;;;;;
+16F99;MIAO LETTER TONE-8;Lm;0;L;;;;;N;;;;;
+16F9A;MIAO LETTER REFORMED TONE-1;Lm;0;L;;;;;N;;;;;
+16F9B;MIAO LETTER REFORMED TONE-2;Lm;0;L;;;;;N;;;;;
+16F9C;MIAO LETTER REFORMED TONE-4;Lm;0;L;;;;;N;;;;;
+16F9D;MIAO LETTER REFORMED TONE-5;Lm;0;L;;;;;N;;;;;
+16F9E;MIAO LETTER REFORMED TONE-6;Lm;0;L;;;;;N;;;;;
+16F9F;MIAO LETTER REFORMED TONE-8;Lm;0;L;;;;;N;;;;;
1B000;KATAKANA LETTER ARCHAIC E;Lo;0;L;;;;;N;;;;;
1B001;HIRAGANA LETTER ARCHAIC YE;Lo;0;L;;;;;N;;;;;
1D000;BYZANTINE MUSICAL SYMBOL PSILI;So;0;L;;;;;N;;;;;
1D7FD;MATHEMATICAL MONOSPACE DIGIT SEVEN;Nd;0;EN;<font> 0037;7;7;7;N;;;;;
1D7FE;MATHEMATICAL MONOSPACE DIGIT EIGHT;Nd;0;EN;<font> 0038;8;8;8;N;;;;;
1D7FF;MATHEMATICAL MONOSPACE DIGIT NINE;Nd;0;EN;<font> 0039;9;9;9;N;;;;;
+1EE00;ARABIC MATHEMATICAL ALEF;Lo;0;AL;<font> 0627;;;;N;;;;;
+1EE01;ARABIC MATHEMATICAL BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EE02;ARABIC MATHEMATICAL JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE03;ARABIC MATHEMATICAL DAL;Lo;0;AL;<font> 062F;;;;N;;;;;
+1EE05;ARABIC MATHEMATICAL WAW;Lo;0;AL;<font> 0648;;;;N;;;;;
+1EE06;ARABIC MATHEMATICAL ZAIN;Lo;0;AL;<font> 0632;;;;N;;;;;
+1EE07;ARABIC MATHEMATICAL HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE08;ARABIC MATHEMATICAL TAH;Lo;0;AL;<font> 0637;;;;N;;;;;
+1EE09;ARABIC MATHEMATICAL YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE0A;ARABIC MATHEMATICAL KAF;Lo;0;AL;<font> 0643;;;;N;;;;;
+1EE0B;ARABIC MATHEMATICAL LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EE0C;ARABIC MATHEMATICAL MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EE0D;ARABIC MATHEMATICAL NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE0E;ARABIC MATHEMATICAL SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE0F;ARABIC MATHEMATICAL AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE10;ARABIC MATHEMATICAL FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EE11;ARABIC MATHEMATICAL SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE12;ARABIC MATHEMATICAL QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE13;ARABIC MATHEMATICAL REH;Lo;0;AL;<font> 0631;;;;N;;;;;
+1EE14;ARABIC MATHEMATICAL SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE15;ARABIC MATHEMATICAL TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EE16;ARABIC MATHEMATICAL THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EE17;ARABIC MATHEMATICAL KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE18;ARABIC MATHEMATICAL THAL;Lo;0;AL;<font> 0630;;;;N;;;;;
+1EE19;ARABIC MATHEMATICAL DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE1A;ARABIC MATHEMATICAL ZAH;Lo;0;AL;<font> 0638;;;;N;;;;;
+1EE1B;ARABIC MATHEMATICAL GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EE1C;ARABIC MATHEMATICAL DOTLESS BEH;Lo;0;AL;<font> 066E;;;;N;;;;;
+1EE1D;ARABIC MATHEMATICAL DOTLESS NOON;Lo;0;AL;<font> 06BA;;;;N;;;;;
+1EE1E;ARABIC MATHEMATICAL DOTLESS FEH;Lo;0;AL;<font> 06A1;;;;N;;;;;
+1EE1F;ARABIC MATHEMATICAL DOTLESS QAF;Lo;0;AL;<font> 066F;;;;N;;;;;
+1EE21;ARABIC MATHEMATICAL INITIAL BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EE22;ARABIC MATHEMATICAL INITIAL JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE24;ARABIC MATHEMATICAL INITIAL HEH;Lo;0;AL;<font> 0647;;;;N;;;;;
+1EE27;ARABIC MATHEMATICAL INITIAL HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE29;ARABIC MATHEMATICAL INITIAL YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE2A;ARABIC MATHEMATICAL INITIAL KAF;Lo;0;AL;<font> 0643;;;;N;;;;;
+1EE2B;ARABIC MATHEMATICAL INITIAL LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EE2C;ARABIC MATHEMATICAL INITIAL MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EE2D;ARABIC MATHEMATICAL INITIAL NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE2E;ARABIC MATHEMATICAL INITIAL SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE2F;ARABIC MATHEMATICAL INITIAL AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE30;ARABIC MATHEMATICAL INITIAL FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EE31;ARABIC MATHEMATICAL INITIAL SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE32;ARABIC MATHEMATICAL INITIAL QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE34;ARABIC MATHEMATICAL INITIAL SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE35;ARABIC MATHEMATICAL INITIAL TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EE36;ARABIC MATHEMATICAL INITIAL THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EE37;ARABIC MATHEMATICAL INITIAL KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE39;ARABIC MATHEMATICAL INITIAL DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE3B;ARABIC MATHEMATICAL INITIAL GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EE42;ARABIC MATHEMATICAL TAILED JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE47;ARABIC MATHEMATICAL TAILED HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE49;ARABIC MATHEMATICAL TAILED YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE4B;ARABIC MATHEMATICAL TAILED LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EE4D;ARABIC MATHEMATICAL TAILED NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE4E;ARABIC MATHEMATICAL TAILED SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE4F;ARABIC MATHEMATICAL TAILED AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE51;ARABIC MATHEMATICAL TAILED SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE52;ARABIC MATHEMATICAL TAILED QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE54;ARABIC MATHEMATICAL TAILED SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE57;ARABIC MATHEMATICAL TAILED KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE59;ARABIC MATHEMATICAL TAILED DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE5B;ARABIC MATHEMATICAL TAILED GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EE5D;ARABIC MATHEMATICAL TAILED DOTLESS NOON;Lo;0;AL;<font> 06BA;;;;N;;;;;
+1EE5F;ARABIC MATHEMATICAL TAILED DOTLESS QAF;Lo;0;AL;<font> 066F;;;;N;;;;;
+1EE61;ARABIC MATHEMATICAL STRETCHED BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EE62;ARABIC MATHEMATICAL STRETCHED JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE64;ARABIC MATHEMATICAL STRETCHED HEH;Lo;0;AL;<font> 0647;;;;N;;;;;
+1EE67;ARABIC MATHEMATICAL STRETCHED HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE68;ARABIC MATHEMATICAL STRETCHED TAH;Lo;0;AL;<font> 0637;;;;N;;;;;
+1EE69;ARABIC MATHEMATICAL STRETCHED YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE6A;ARABIC MATHEMATICAL STRETCHED KAF;Lo;0;AL;<font> 0643;;;;N;;;;;
+1EE6C;ARABIC MATHEMATICAL STRETCHED MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EE6D;ARABIC MATHEMATICAL STRETCHED NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE6E;ARABIC MATHEMATICAL STRETCHED SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE6F;ARABIC MATHEMATICAL STRETCHED AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE70;ARABIC MATHEMATICAL STRETCHED FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EE71;ARABIC MATHEMATICAL STRETCHED SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE72;ARABIC MATHEMATICAL STRETCHED QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE74;ARABIC MATHEMATICAL STRETCHED SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE75;ARABIC MATHEMATICAL STRETCHED TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EE76;ARABIC MATHEMATICAL STRETCHED THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EE77;ARABIC MATHEMATICAL STRETCHED KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE79;ARABIC MATHEMATICAL STRETCHED DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE7A;ARABIC MATHEMATICAL STRETCHED ZAH;Lo;0;AL;<font> 0638;;;;N;;;;;
+1EE7B;ARABIC MATHEMATICAL STRETCHED GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EE7C;ARABIC MATHEMATICAL STRETCHED DOTLESS BEH;Lo;0;AL;<font> 066E;;;;N;;;;;
+1EE7E;ARABIC MATHEMATICAL STRETCHED DOTLESS FEH;Lo;0;AL;<font> 06A1;;;;N;;;;;
+1EE80;ARABIC MATHEMATICAL LOOPED ALEF;Lo;0;AL;<font> 0627;;;;N;;;;;
+1EE81;ARABIC MATHEMATICAL LOOPED BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EE82;ARABIC MATHEMATICAL LOOPED JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EE83;ARABIC MATHEMATICAL LOOPED DAL;Lo;0;AL;<font> 062F;;;;N;;;;;
+1EE84;ARABIC MATHEMATICAL LOOPED HEH;Lo;0;AL;<font> 0647;;;;N;;;;;
+1EE85;ARABIC MATHEMATICAL LOOPED WAW;Lo;0;AL;<font> 0648;;;;N;;;;;
+1EE86;ARABIC MATHEMATICAL LOOPED ZAIN;Lo;0;AL;<font> 0632;;;;N;;;;;
+1EE87;ARABIC MATHEMATICAL LOOPED HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EE88;ARABIC MATHEMATICAL LOOPED TAH;Lo;0;AL;<font> 0637;;;;N;;;;;
+1EE89;ARABIC MATHEMATICAL LOOPED YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EE8B;ARABIC MATHEMATICAL LOOPED LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EE8C;ARABIC MATHEMATICAL LOOPED MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EE8D;ARABIC MATHEMATICAL LOOPED NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EE8E;ARABIC MATHEMATICAL LOOPED SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EE8F;ARABIC MATHEMATICAL LOOPED AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EE90;ARABIC MATHEMATICAL LOOPED FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EE91;ARABIC MATHEMATICAL LOOPED SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EE92;ARABIC MATHEMATICAL LOOPED QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EE93;ARABIC MATHEMATICAL LOOPED REH;Lo;0;AL;<font> 0631;;;;N;;;;;
+1EE94;ARABIC MATHEMATICAL LOOPED SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EE95;ARABIC MATHEMATICAL LOOPED TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EE96;ARABIC MATHEMATICAL LOOPED THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EE97;ARABIC MATHEMATICAL LOOPED KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EE98;ARABIC MATHEMATICAL LOOPED THAL;Lo;0;AL;<font> 0630;;;;N;;;;;
+1EE99;ARABIC MATHEMATICAL LOOPED DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EE9A;ARABIC MATHEMATICAL LOOPED ZAH;Lo;0;AL;<font> 0638;;;;N;;;;;
+1EE9B;ARABIC MATHEMATICAL LOOPED GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EEA1;ARABIC MATHEMATICAL DOUBLE-STRUCK BEH;Lo;0;AL;<font> 0628;;;;N;;;;;
+1EEA2;ARABIC MATHEMATICAL DOUBLE-STRUCK JEEM;Lo;0;AL;<font> 062C;;;;N;;;;;
+1EEA3;ARABIC MATHEMATICAL DOUBLE-STRUCK DAL;Lo;0;AL;<font> 062F;;;;N;;;;;
+1EEA5;ARABIC MATHEMATICAL DOUBLE-STRUCK WAW;Lo;0;AL;<font> 0648;;;;N;;;;;
+1EEA6;ARABIC MATHEMATICAL DOUBLE-STRUCK ZAIN;Lo;0;AL;<font> 0632;;;;N;;;;;
+1EEA7;ARABIC MATHEMATICAL DOUBLE-STRUCK HAH;Lo;0;AL;<font> 062D;;;;N;;;;;
+1EEA8;ARABIC MATHEMATICAL DOUBLE-STRUCK TAH;Lo;0;AL;<font> 0637;;;;N;;;;;
+1EEA9;ARABIC MATHEMATICAL DOUBLE-STRUCK YEH;Lo;0;AL;<font> 064A;;;;N;;;;;
+1EEAB;ARABIC MATHEMATICAL DOUBLE-STRUCK LAM;Lo;0;AL;<font> 0644;;;;N;;;;;
+1EEAC;ARABIC MATHEMATICAL DOUBLE-STRUCK MEEM;Lo;0;AL;<font> 0645;;;;N;;;;;
+1EEAD;ARABIC MATHEMATICAL DOUBLE-STRUCK NOON;Lo;0;AL;<font> 0646;;;;N;;;;;
+1EEAE;ARABIC MATHEMATICAL DOUBLE-STRUCK SEEN;Lo;0;AL;<font> 0633;;;;N;;;;;
+1EEAF;ARABIC MATHEMATICAL DOUBLE-STRUCK AIN;Lo;0;AL;<font> 0639;;;;N;;;;;
+1EEB0;ARABIC MATHEMATICAL DOUBLE-STRUCK FEH;Lo;0;AL;<font> 0641;;;;N;;;;;
+1EEB1;ARABIC MATHEMATICAL DOUBLE-STRUCK SAD;Lo;0;AL;<font> 0635;;;;N;;;;;
+1EEB2;ARABIC MATHEMATICAL DOUBLE-STRUCK QAF;Lo;0;AL;<font> 0642;;;;N;;;;;
+1EEB3;ARABIC MATHEMATICAL DOUBLE-STRUCK REH;Lo;0;AL;<font> 0631;;;;N;;;;;
+1EEB4;ARABIC MATHEMATICAL DOUBLE-STRUCK SHEEN;Lo;0;AL;<font> 0634;;;;N;;;;;
+1EEB5;ARABIC MATHEMATICAL DOUBLE-STRUCK TEH;Lo;0;AL;<font> 062A;;;;N;;;;;
+1EEB6;ARABIC MATHEMATICAL DOUBLE-STRUCK THEH;Lo;0;AL;<font> 062B;;;;N;;;;;
+1EEB7;ARABIC MATHEMATICAL DOUBLE-STRUCK KHAH;Lo;0;AL;<font> 062E;;;;N;;;;;
+1EEB8;ARABIC MATHEMATICAL DOUBLE-STRUCK THAL;Lo;0;AL;<font> 0630;;;;N;;;;;
+1EEB9;ARABIC MATHEMATICAL DOUBLE-STRUCK DAD;Lo;0;AL;<font> 0636;;;;N;;;;;
+1EEBA;ARABIC MATHEMATICAL DOUBLE-STRUCK ZAH;Lo;0;AL;<font> 0638;;;;N;;;;;
+1EEBB;ARABIC MATHEMATICAL DOUBLE-STRUCK GHAIN;Lo;0;AL;<font> 063A;;;;N;;;;;
+1EEF0;ARABIC MATHEMATICAL OPERATOR MEEM WITH HAH WITH TATWEEL;Sm;0;ON;;;;;N;;;;;
+1EEF1;ARABIC MATHEMATICAL OPERATOR HAH WITH DAL;Sm;0;ON;;;;;N;;;;;
1F000;MAHJONG TILE EAST WIND;So;0;ON;;;;;N;;;;;
1F001;MAHJONG TILE SOUTH WIND;So;0;ON;;;;;N;;;;;
1F002;MAHJONG TILE WEST WIND;So;0;ON;;;;;N;;;;;
1F167;NEGATIVE CIRCLED LATIN CAPITAL LETTER X;So;0;L;;;;;N;;;;;
1F168;NEGATIVE CIRCLED LATIN CAPITAL LETTER Y;So;0;L;;;;;N;;;;;
1F169;NEGATIVE CIRCLED LATIN CAPITAL LETTER Z;So;0;L;;;;;N;;;;;
+1F16A;RAISED MC SIGN;So;0;ON;<super> 004D 0043;;;;N;;;;;
+1F16B;RAISED MD SIGN;So;0;ON;<super> 004D 0044;;;;N;;;;;
1F170;NEGATIVE SQUARED LATIN CAPITAL LETTER A;So;0;L;;;;;N;;;;;
1F171;NEGATIVE SQUARED LATIN CAPITAL LETTER B;So;0;L;;;;;N;;;;;
1F172;NEGATIVE SQUARED LATIN CAPITAL LETTER C;So;0;L;;;;;N;;;;;
1F489;SYRINGE;So;0;ON;;;;;N;;;;;
1F48A;PILL;So;0;ON;;;;;N;;;;;
1F48B;KISS MARK;So;0;ON;;;;;N;;;;;
-1F48C;LOVE LETTER;So;0;L;;;;;N;;;;;
+1F48C;LOVE LETTER;So;0;ON;;;;;N;;;;;
1F48D;RING;So;0;ON;;;;;N;;;;;
1F48E;GEM STONE;So;0;ON;;;;;N;;;;;
1F48F;KISS;So;0;ON;;;;;N;;;;;
1F521;INPUT SYMBOL FOR LATIN SMALL LETTERS;So;0;ON;;;;;N;;;;;
1F522;INPUT SYMBOL FOR NUMBERS;So;0;ON;;;;;N;;;;;
1F523;INPUT SYMBOL FOR SYMBOLS;So;0;ON;;;;;N;;;;;
-1F524;INPUT SYMBOL FOR LATIN LETTERS;So;0;L;;;;;N;;;;;
+1F524;INPUT SYMBOL FOR LATIN LETTERS;So;0;ON;;;;;N;;;;;
1F525;FIRE;So;0;ON;;;;;N;;;;;
1F526;ELECTRIC TORCH;So;0;ON;;;;;N;;;;;
1F527;WRENCH;So;0;ON;;;;;N;;;;;
1F53B;DOWN-POINTING RED TRIANGLE;So;0;ON;;;;;N;;;;;
1F53C;UP-POINTING SMALL RED TRIANGLE;So;0;ON;;;;;N;;;;;
1F53D;DOWN-POINTING SMALL RED TRIANGLE;So;0;ON;;;;;N;;;;;
+1F540;CIRCLED CROSS POMMEE;So;0;ON;;;;;N;;;;;
+1F541;CROSS POMMEE WITH HALF-CIRCLE BELOW;So;0;ON;;;;;N;;;;;
+1F542;CROSS POMMEE;So;0;ON;;;;;N;;;;;
+1F543;NOTCHED LEFT SEMICIRCLE WITH THREE DOTS;So;0;ON;;;;;N;;;;;
1F550;CLOCK FACE ONE OCLOCK;So;0;ON;;;;;N;;;;;
1F551;CLOCK FACE TWO OCLOCK;So;0;ON;;;;;N;;;;;
1F552;CLOCK FACE THREE OCLOCK;So;0;ON;;;;;N;;;;;
1F5FD;STATUE OF LIBERTY;So;0;ON;;;;;N;;;;;
1F5FE;SILHOUETTE OF JAPAN;So;0;ON;;;;;N;;;;;
1F5FF;MOYAI;So;0;ON;;;;;N;;;;;
+1F600;GRINNING FACE;So;0;ON;;;;;N;;;;;
1F601;GRINNING FACE WITH SMILING EYES;So;0;ON;;;;;N;;;;;
1F602;FACE WITH TEARS OF JOY;So;0;ON;;;;;N;;;;;
1F603;SMILING FACE WITH OPEN MOUTH;So;0;ON;;;;;N;;;;;
1F60E;SMILING FACE WITH SUNGLASSES;So;0;ON;;;;;N;;;;;
1F60F;SMIRKING FACE;So;0;ON;;;;;N;;;;;
1F610;NEUTRAL FACE;So;0;ON;;;;;N;;;;;
+1F611;EXPRESSIONLESS FACE;So;0;ON;;;;;N;;;;;
1F612;UNAMUSED FACE;So;0;ON;;;;;N;;;;;
1F613;FACE WITH COLD SWEAT;So;0;ON;;;;;N;;;;;
1F614;PENSIVE FACE;So;0;ON;;;;;N;;;;;
+1F615;CONFUSED FACE;So;0;ON;;;;;N;;;;;
1F616;CONFOUNDED FACE;So;0;ON;;;;;N;;;;;
+1F617;KISSING FACE;So;0;ON;;;;;N;;;;;
1F618;FACE THROWING A KISS;So;0;ON;;;;;N;;;;;
+1F619;KISSING FACE WITH SMILING EYES;So;0;ON;;;;;N;;;;;
1F61A;KISSING FACE WITH CLOSED EYES;So;0;ON;;;;;N;;;;;
+1F61B;FACE WITH STUCK-OUT TONGUE;So;0;ON;;;;;N;;;;;
1F61C;FACE WITH STUCK-OUT TONGUE AND WINKING EYE;So;0;ON;;;;;N;;;;;
1F61D;FACE WITH STUCK-OUT TONGUE AND TIGHTLY-CLOSED EYES;So;0;ON;;;;;N;;;;;
1F61E;DISAPPOINTED FACE;So;0;ON;;;;;N;;;;;
+1F61F;WORRIED FACE;So;0;ON;;;;;N;;;;;
1F620;ANGRY FACE;So;0;ON;;;;;N;;;;;
1F621;POUTING FACE;So;0;ON;;;;;N;;;;;
1F622;CRYING FACE;So;0;ON;;;;;N;;;;;
1F623;PERSEVERING FACE;So;0;ON;;;;;N;;;;;
1F624;FACE WITH LOOK OF TRIUMPH;So;0;ON;;;;;N;;;;;
1F625;DISAPPOINTED BUT RELIEVED FACE;So;0;ON;;;;;N;;;;;
+1F626;FROWNING FACE WITH OPEN MOUTH;So;0;ON;;;;;N;;;;;
+1F627;ANGUISHED FACE;So;0;ON;;;;;N;;;;;
1F628;FEARFUL FACE;So;0;ON;;;;;N;;;;;
1F629;WEARY FACE;So;0;ON;;;;;N;;;;;
1F62A;SLEEPY FACE;So;0;ON;;;;;N;;;;;
1F62B;TIRED FACE;So;0;ON;;;;;N;;;;;
+1F62C;GRIMACING FACE;So;0;ON;;;;;N;;;;;
1F62D;LOUDLY CRYING FACE;So;0;ON;;;;;N;;;;;
+1F62E;FACE WITH OPEN MOUTH;So;0;ON;;;;;N;;;;;
+1F62F;HUSHED FACE;So;0;ON;;;;;N;;;;;
1F630;FACE WITH OPEN MOUTH AND COLD SWEAT;So;0;ON;;;;;N;;;;;
1F631;FACE SCREAMING IN FEAR;So;0;ON;;;;;N;;;;;
1F632;ASTONISHED FACE;So;0;ON;;;;;N;;;;;
1F633;FLUSHED FACE;So;0;ON;;;;;N;;;;;
+1F634;SLEEPING FACE;So;0;ON;;;;;N;;;;;
1F635;DIZZY FACE;So;0;ON;;;;;N;;;;;
1F636;FACE WITHOUT MOUTH;So;0;ON;;;;;N;;;;;
1F637;FACE WITH MEDICAL MASK;So;0;ON;;;;;N;;;;;
<meta name="VI60_defaultClientScript" content="JavaScript">
-<meta name="GENERATOR" content="Microsoft FrontPage 6.0">
+<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
<meta name="keywords" content="Unicode Standard, copyright">
<body text="#330000">
-
-
-<form action="http://www.unicode.org/webscripts/POST">
-
<table width="100%" cellpadding="0" cellspacing="0" border="0">
<tr>
<td valign="top" class="navColCell"><a href="#4">Waiver of Damages</a></td>
</tr>
<tr>
- <td valign="top" class="navColCell"><a href="#5">Trademarks</a></td>
+ <td valign="top" class="navColCell"><a href="#5">Trademarks & Logos</a></td>
</tr>
<tr>
<td valign="top" class="navColCell"><a href="#7">Miscellaneous</a></td>
</tr>
<tr>
<td valign="top" class="navColCell">
- <a href="http://www.unicode.org/policies/logo_policy.html">The
- Unicode® Consortium Trademarks and Logo Policy</a></td>
+ <a href="http://www.unicode.org/policies/logo_policy.html">Trademark Policy</a></td>
</tr>
<tr>
<td valign="top" class="navColCell">
<a href="http://www.unicode.org/policies/privacy_policy.html">
Unicode Privacy Policy</a>. For trademark usage, see
<a href="http://www.unicode.org/policies/logo_policy.html">the
- Unicode Consortium® Trademarks and Logo Policy</a>.</p>
+ Unicode® Consortium Name and Trademark Usage Policy</a>.</p>
<table class="sidebar" align="right" width="50%" id="table1">
<tr>
<td class="sidebar">Carefully read the following legal agreement
("Agreement"). Use or copying of the software and/or codes
provided with this agreement (The "Software") constitutes your
- acceptance of these terms</td>
+ acceptance of these terms. If you have any questions about these terms of use, please <a href="http://www.unicode.org/contacts.html">contact the Unicode Consortium</a>.</td>
</tr>
</table>
<ol type="A">
<li><u><a name="1"></a>Unicode Copyright.</u>
<ol>
- <li>Copyright © 1991-2006 Unicode, Inc. All rights reserved.</li>
+ <li>Copyright © 1991-2012 Unicode, Inc. All rights reserved.</li>
<li>Certain documents and files on this website contain a legend
indicating that "Modification is permitted." Any person is
hereby authorized, without fee, to modify such documents and
to the use of the particular set of data files known as the
"Unicode Character Database" can be found in <a href="#Exhibit1">
Exhibit 1</a>.</li>
- <li>Each version of the Unicode Standard has further specifications of rights and restrictions
- of use. For the book editions, these are found on the back of
- the
- <a href="http://www.unicode.org/versions/Unicode4.0.0/Title.pdf">
- title page</a>. For the online edition, certain files (such as
- the PDF files for book chapters and code charts) carry specific
- restrictions. All other files are covered under these general
- Terms of Use. To request a permission to reproduce any
- part of the Unicode Standard, please
- <a href="http://www.unicode.org/contacts.html">contact the
- Unicode Consortium</a>.</li>
+ <li>Each version of the Unicode Standard has further
+ specifications of rights and restrictions of use. For the book
+ editions (Unicode 5.0 and earlier), these are found on the back
+ of the
+ <a href="http://www.unicode.org/versions/Unicode5.0.0/Title.pdf">title page</a>.
+ The online code charts carry specific restrictions. All other files, including online documentation of the core specification for Unicode 6.0 and later, are covered under these general Terms of Use.</li>
<li>No license is granted to "mirror" the Unicode website where
a fee is charged for access to the "mirror" site.</li>
<li>Modification is not permitted with respect to this document.
the following: loss of use, data or profits, in connection with
the use, modification or distribution of this information or its
derivatives.</li>
- <li><u><a name="5"></a>Trademarks.</u>
- <ol>
- <li>Unicode and the Unicode logo are registered trademarks of
- Unicode, Inc. </li>
- <li>This site contains product names and corporate names of
- other companies. All product names and company names and logos
- mentioned herein are the trademarks or registered trademarks of
- their respective owners. Other products and corporate names
- mentioned herein which are trademarks of a third party are used
- only for explanation and for the owners' benefit and with no
- intent to infringe.</li>
- <li>Use of third party products or information referred to
- herein is at the user’s risk.</li>
+ <li><u><a name="5"></a>Trademarks & Logos.</u>
+ <ol>
+ <li>The Unicode Word Mark and the Unicode Logo are trademarks of Unicode, Inc. “The Unicode Consortium” and “Unicode, Inc.” are trade names of Unicode, Inc. Use of the information and materials found on this website indicates your acknowledgement of Unicode, Inc.’s exclusive worldwide rights in the Unicode Word Mark, the Unicode Logo, and the Unicode trade names.</li>
+<li><a href="http://www.unicode.org/policies/logo_policy.html">The Unicode Consortium Name and Trademark Usage Policy</a> (“Trademark Policy”) are incorporated herein by reference and you agree to abide by the provisions of the Trademark Policy, which may be changed from time to time in the sole discretion of Unicode, Inc.</li>
+<li>All third party trademarks referenced herein are the property of their respective owners.
+</li>
</ol>
</li>
<a href="http://www.unicode.org/Public/">http://www.unicode.org/Public/</a>,
<a href="http://www.unicode.org/reports/">http://www.unicode.org/reports/</a>,
and
-<a title="http://www.unicode.org/cldr/data/" onclick="return top.js.OpenExtLink(window,event,this)" target="_blank" href="http://www.unicode.org/cldr/data/">
-http://www.unicode.org/cldr/data/ </a>. Unicode Software includes any source code
-published in the Unicode Standard or under the directories
-<a href="http://www.unicode.org/Public/">http://www.unicode.org/Public/</a>,
+<a title="http://www.unicode.org/cldr/data/" onClick="return top.js.OpenExtLink(window,event,this)" target="_blank" href="http://www.unicode.org/cldr/data/">
+http://www.unicode.org/cldr/data/</a>. Unicode Data Files do not include PDF online code charts under the directory <a href="http://www.unicode.org/Public/">http://www.unicode.org/Public/</a>. Software includes any source code
+published in the Unicode Standard or under the directories <a href="http://www.unicode.org/Public/">http://www.unicode.org/Public/</a>,
<a href="http://www.unicode.org/reports/">http://www.unicode.org/reports/</a>,
and
-<a title="http://www.unicode.org/cldr/data/" onclick="return top.js.OpenExtLink(window,event,this)" target="_blank" href="http://www.unicode.org/cldr/data/">
-http://www.unicode.org/cldr/data/.</a></p>
+<a title="http://www.unicode.org/cldr/data/" onClick="return top.js.OpenExtLink(window,event,this)" target="_blank" href="http://www.unicode.org/cldr/data/">
+http://www.unicode.org/cldr/data/</a>.</p>
<p>NOTICE TO USER: Carefully read the following legal agreement. BY DOWNLOADING, INSTALLING, COPYING OR OTHERWISE USING UNICODE INC.'S DATA FILES ("DATA FILES"), AND/OR SOFTWARE ("SOFTWARE"), YOU UNEQUIVOCALLY ACCEPT, AND AGREE TO BE BOUND BY, ALL OF THE TERMS AND CONDITIONS OF THIS AGREEMENT. IF YOU DO NOT AGREE, DO NOT DOWNLOAD, INSTALL, COPY, DISTRIBUTE OR USE THE DATA FILES OR SOFTWARE.</p>
<p>COPYRIGHT AND PERMISSION NOTICE</p>
-<p>Copyright © 1991-2005 Unicode, Inc. All rights reserved. Distributed under the Terms of Use in
+<p>Copyright © 1991-2012 Unicode, Inc. All rights reserved. Distributed under the Terms of Use in
<a href="http://www.unicode.org/copyright.html">http://www.unicode.org/copyright.html</a>.</p>
<p>Permission is hereby granted, free of charge, to any person obtaining a copy of the Unicode data files and
<hr width="80%">
-<p>Unicode and the Unicode logo are trademarks of Unicode, Inc., and may be registered in some jurisdictions. All other trademarks and registered trademarks mentioned herein are the property of their respective owners.</p>
+<p>Unicode and the Unicode logo are trademarks of Unicode, Inc. in the United States and other countries. All third party trademarks referenced herein are the property of their respective owners.</p>
</blockquote>
</tr>
</table>
-
-</form>
-
-
-
</body>
-
-
-
</html>
progs="autoconf automake"
## Minimum versions we need:
-autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.in`
+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".
## 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
@SET_MAKE@
-# Copyright (C) 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-2012 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dup2 filemode getloadavg getopt-gnu ignore-value intprops lstat mktime pthread_sigmask readlink socklen stdarg stdio strftime strtoimax strtoumax symlink sys_stat
+# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \
$(top_srcdir)/m4/alloca.m4 $(top_srcdir)/m4/c-strtod.m4 \
- $(top_srcdir)/m4/dup2.m4 $(top_srcdir)/m4/extensions.m4 \
- $(top_srcdir)/m4/filemode.m4 $(top_srcdir)/m4/getloadavg.m4 \
- $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gl-comp.m4 \
+ $(top_srcdir)/m4/clock_time.m4 $(top_srcdir)/m4/dup2.m4 \
+ $(top_srcdir)/m4/environ.m4 $(top_srcdir)/m4/execinfo.m4 \
+ $(top_srcdir)/m4/extensions.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 \
$(top_srcdir)/m4/largefile.m4 $(top_srcdir)/m4/longlong.m4 \
- $(top_srcdir)/m4/lstat.m4 $(top_srcdir)/m4/md5.m4 \
- $(top_srcdir)/m4/mktime.m4 $(top_srcdir)/m4/multiarch.m4 \
- $(top_srcdir)/m4/nocrash.m4 $(top_srcdir)/m4/pathmax.m4 \
+ $(top_srcdir)/m4/lstat.m4 $(top_srcdir)/m4/manywarnings.m4 \
+ $(top_srcdir)/m4/md5.m4 $(top_srcdir)/m4/mktime.m4 \
+ $(top_srcdir)/m4/multiarch.m4 $(top_srcdir)/m4/nocrash.m4 \
+ $(top_srcdir)/m4/off_t.m4 $(top_srcdir)/m4/pathmax.m4 \
+ $(top_srcdir)/m4/pselect.m4 \
$(top_srcdir)/m4/pthread_sigmask.m4 \
$(top_srcdir)/m4/readlink.m4 $(top_srcdir)/m4/sha1.m4 \
$(top_srcdir)/m4/sha256.m4 $(top_srcdir)/m4/sha512.m4 \
- $(top_srcdir)/m4/signal_h.m4 \
- $(top_srcdir)/m4/signalblocking.m4 $(top_srcdir)/m4/socklen.m4 \
+ $(top_srcdir)/m4/signal_h.m4 $(top_srcdir)/m4/socklen.m4 \
$(top_srcdir)/m4/ssize_t.m4 $(top_srcdir)/m4/st_dm_mode.m4 \
- $(top_srcdir)/m4/stat.m4 $(top_srcdir)/m4/stdarg.m4 \
+ $(top_srcdir)/m4/stat-time.m4 $(top_srcdir)/m4/stat.m4 \
+ $(top_srcdir)/m4/stdalign.m4 $(top_srcdir)/m4/stdarg.m4 \
$(top_srcdir)/m4/stdbool.m4 $(top_srcdir)/m4/stddef_h.m4 \
$(top_srcdir)/m4/stdint.m4 $(top_srcdir)/m4/stdio_h.m4 \
$(top_srcdir)/m4/stdlib_h.m4 $(top_srcdir)/m4/strftime.m4 \
$(top_srcdir)/m4/strtoimax.m4 $(top_srcdir)/m4/strtoll.m4 \
$(top_srcdir)/m4/strtoull.m4 $(top_srcdir)/m4/strtoumax.m4 \
- $(top_srcdir)/m4/symlink.m4 $(top_srcdir)/m4/sys_stat_h.m4 \
+ $(top_srcdir)/m4/symlink.m4 $(top_srcdir)/m4/sys_select_h.m4 \
+ $(top_srcdir)/m4/sys_socket_h.m4 \
+ $(top_srcdir)/m4/sys_stat_h.m4 $(top_srcdir)/m4/sys_time_h.m4 \
$(top_srcdir)/m4/time_h.m4 $(top_srcdir)/m4/time_r.m4 \
+ $(top_srcdir)/m4/timer_time.m4 $(top_srcdir)/m4/timespec.m4 \
$(top_srcdir)/m4/tm_gmtoff.m4 $(top_srcdir)/m4/unistd_h.m4 \
- $(top_srcdir)/m4/wchar_t.m4 $(top_srcdir)/configure.in
+ $(top_srcdir)/m4/utimbuf.m4 $(top_srcdir)/m4/utimens.m4 \
+ $(top_srcdir)/m4/utimes.m4 $(top_srcdir)/m4/warnings.m4 \
+ $(top_srcdir)/m4/wchar_t.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
LIBRARIES = $(noinst_LIBRARIES)
libgnu_a_AR = $(AR) $(ARFLAGS)
am__DEPENDENCIES_1 =
-am__libgnu_a_SOURCES_DIST = allocator.c careadlinkat.c md5.c sha1.c \
- sha256.c sha512.c dtoastr.c filemode.c gettext.h strftime.c
+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 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) careadlinkat.$(OBJEXT) \
- md5.$(OBJEXT) sha1.$(OBJEXT) sha256.$(OBJEXT) sha512.$(OBJEXT) \
- dtoastr.$(OBJEXT) filemode.$(OBJEXT) $(am__objects_1) \
- strftime.$(OBJEXT)
+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) 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
C_SWITCH_MACHINE = @C_SWITCH_MACHINE@
C_SWITCH_SYSTEM = @C_SWITCH_SYSTEM@
C_SWITCH_X_SITE = @C_SWITCH_X_SITE@
-C_SWITCH_X_SYSTEM = @C_SWITCH_X_SYSTEM@
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
DBUS_CFLAGS = @DBUS_CFLAGS@
DBUS_LIBS = @DBUS_LIBS@
DBUS_OBJ = @DBUS_OBJ@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
+EXECINFO_H = @EXECINFO_H@
EXEEXT = @EXEEXT@
FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@
FONTCONFIG_LIBS = @FONTCONFIG_LIBS@
GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@
GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@
GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@
+GNULIB_GETTIMEOFDAY = @GNULIB_GETTIMEOFDAY@
GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@
+GNULIB_GL_UNISTD_H_GETOPT = @GNULIB_GL_UNISTD_H_GETOPT@
GNULIB_GRANTPT = @GNULIB_GRANTPT@
GNULIB_GROUP_MEMBER = @GNULIB_GROUP_MEMBER@
GNULIB_IMAXABS = @GNULIB_IMAXABS@
GNULIB_IMAXDIV = @GNULIB_IMAXDIV@
+GNULIB_ISATTY = @GNULIB_ISATTY@
GNULIB_LCHMOD = @GNULIB_LCHMOD@
GNULIB_LCHOWN = @GNULIB_LCHOWN@
GNULIB_LINK = @GNULIB_LINK@
GNULIB_PIPE = @GNULIB_PIPE@
GNULIB_PIPE2 = @GNULIB_PIPE2@
GNULIB_POPEN = @GNULIB_POPEN@
+GNULIB_POSIX_OPENPT = @GNULIB_POSIX_OPENPT@
GNULIB_PREAD = @GNULIB_PREAD@
GNULIB_PRINTF = @GNULIB_PRINTF@
GNULIB_PRINTF_POSIX = @GNULIB_PRINTF_POSIX@
+GNULIB_PSELECT = @GNULIB_PSELECT@
GNULIB_PTHREAD_SIGMASK = @GNULIB_PTHREAD_SIGMASK@
GNULIB_PTSNAME = @GNULIB_PTSNAME@
+GNULIB_PTSNAME_R = @GNULIB_PTSNAME_R@
GNULIB_PUTC = @GNULIB_PUTC@
GNULIB_PUTCHAR = @GNULIB_PUTCHAR@
GNULIB_PUTENV = @GNULIB_PUTENV@
GNULIB_PUTS = @GNULIB_PUTS@
GNULIB_PWRITE = @GNULIB_PWRITE@
GNULIB_RAISE = @GNULIB_RAISE@
+GNULIB_RANDOM = @GNULIB_RANDOM@
GNULIB_RANDOM_R = @GNULIB_RANDOM_R@
GNULIB_READ = @GNULIB_READ@
GNULIB_READLINK = @GNULIB_READLINK@
GNULIB_RMDIR = @GNULIB_RMDIR@
GNULIB_RPMATCH = @GNULIB_RPMATCH@
GNULIB_SCANF = @GNULIB_SCANF@
+GNULIB_SELECT = @GNULIB_SELECT@
GNULIB_SETENV = @GNULIB_SETENV@
+GNULIB_SETHOSTNAME = @GNULIB_SETHOSTNAME@
GNULIB_SIGACTION = @GNULIB_SIGACTION@
GNULIB_SIGNAL_H_SIGPIPE = @GNULIB_SIGNAL_H_SIGPIPE@
GNULIB_SIGPROCMASK = @GNULIB_SIGPROCMASK@
GNULIB_TIME_R = @GNULIB_TIME_R@
GNULIB_TMPFILE = @GNULIB_TMPFILE@
GNULIB_TTYNAME_R = @GNULIB_TTYNAME_R@
-GNULIB_UNISTD_H_GETOPT = @GNULIB_UNISTD_H_GETOPT@
GNULIB_UNISTD_H_NONBLOCKING = @GNULIB_UNISTD_H_NONBLOCKING@
GNULIB_UNISTD_H_SIGPIPE = @GNULIB_UNISTD_H_SIGPIPE@
GNULIB_UNLINK = @GNULIB_UNLINK@
GNULIB_VSCANF = @GNULIB_VSCANF@
GNULIB_VSNPRINTF = @GNULIB_VSNPRINTF@
GNULIB_VSPRINTF_POSIX = @GNULIB_VSPRINTF_POSIX@
+GNULIB_WARN_CFLAGS = @GNULIB_WARN_CFLAGS@
GNULIB_WCTOMB = @GNULIB_WCTOMB@
GNULIB_WRITE = @GNULIB_WRITE@
GNULIB__EXIT = @GNULIB__EXIT@
+GNUSTEP_CFLAGS = @GNUSTEP_CFLAGS@
GNU_OBJC_CFLAGS = @GNU_OBJC_CFLAGS@
+GOBJECT_CFLAGS = @GOBJECT_CFLAGS@
+GOBJECT_LIBS = @GOBJECT_LIBS@
GREP = @GREP@
GSETTINGS_CFLAGS = @GSETTINGS_CFLAGS@
GSETTINGS_LIBS = @GSETTINGS_LIBS@
HAVE_DECL_LOCALTIME_R = @HAVE_DECL_LOCALTIME_R@
HAVE_DECL_OBSTACK_PRINTF = @HAVE_DECL_OBSTACK_PRINTF@
HAVE_DECL_SETENV = @HAVE_DECL_SETENV@
+HAVE_DECL_SETHOSTNAME = @HAVE_DECL_SETHOSTNAME@
HAVE_DECL_SNPRINTF = @HAVE_DECL_SNPRINTF@
HAVE_DECL_STRTOIMAX = @HAVE_DECL_STRTOIMAX@
HAVE_DECL_STRTOUMAX = @HAVE_DECL_STRTOUMAX@
HAVE_GETOPT_H = @HAVE_GETOPT_H@
HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@
HAVE_GETSUBOPT = @HAVE_GETSUBOPT@
+HAVE_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@
HAVE_GRANTPT = @HAVE_GRANTPT@
HAVE_GROUP_MEMBER = @HAVE_GROUP_MEMBER@
HAVE_INTTYPES_H = @HAVE_INTTYPES_H@
HAVE_PIPE = @HAVE_PIPE@
HAVE_PIPE2 = @HAVE_PIPE2@
HAVE_POPEN = @HAVE_POPEN@
+HAVE_POSIX_OPENPT = @HAVE_POSIX_OPENPT@
HAVE_POSIX_SIGNALBLOCKING = @HAVE_POSIX_SIGNALBLOCKING@
HAVE_PREAD = @HAVE_PREAD@
+HAVE_PSELECT = @HAVE_PSELECT@
HAVE_PTHREAD_SIGMASK = @HAVE_PTHREAD_SIGMASK@
HAVE_PTSNAME = @HAVE_PTSNAME@
+HAVE_PTSNAME_R = @HAVE_PTSNAME_R@
HAVE_PWRITE = @HAVE_PWRITE@
HAVE_RAISE = @HAVE_RAISE@
+HAVE_RANDOM = @HAVE_RANDOM@
HAVE_RANDOM_H = @HAVE_RANDOM_H@
HAVE_RANDOM_R = @HAVE_RANDOM_R@
HAVE_READLINK = @HAVE_READLINK@
HAVE_RENAMEAT = @HAVE_RENAMEAT@
HAVE_RPMATCH = @HAVE_RPMATCH@
HAVE_SETENV = @HAVE_SETENV@
+HAVE_SETHOSTNAME = @HAVE_SETHOSTNAME@
HAVE_SIGACTION = @HAVE_SIGACTION@
HAVE_SIGHANDLER_T = @HAVE_SIGHANDLER_T@
HAVE_SIGINFO_T = @HAVE_SIGINFO_T@
HAVE_STRTOULL = @HAVE_STRTOULL@
HAVE_STRUCT_RANDOM_DATA = @HAVE_STRUCT_RANDOM_DATA@
HAVE_STRUCT_SIGACTION_SA_SIGACTION = @HAVE_STRUCT_SIGACTION_SA_SIGACTION@
+HAVE_STRUCT_TIMEVAL = @HAVE_STRUCT_TIMEVAL@
HAVE_SYMLINK = @HAVE_SYMLINK@
HAVE_SYMLINKAT = @HAVE_SYMLINKAT@
HAVE_SYS_BITYPES_H = @HAVE_SYS_BITYPES_H@
HAVE_SYS_INTTYPES_H = @HAVE_SYS_INTTYPES_H@
HAVE_SYS_LOADAVG_H = @HAVE_SYS_LOADAVG_H@
HAVE_SYS_PARAM_H = @HAVE_SYS_PARAM_H@
+HAVE_SYS_SELECT_H = @HAVE_SYS_SELECT_H@
+HAVE_SYS_TIME_H = @HAVE_SYS_TIME_H@
HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@
HAVE_TIMEGM = @HAVE_TIMEGM@
HAVE_TYPE_VOLATILE_SIG_ATOMIC_T = @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@
HAVE_VDPRINTF = @HAVE_VDPRINTF@
HAVE_WCHAR_H = @HAVE_WCHAR_H@
HAVE_WCHAR_T = @HAVE_WCHAR_T@
+HAVE_WINSOCK2_H = @HAVE_WINSOCK2_H@
HAVE_XSERVER = @HAVE_XSERVER@
HAVE__BOOL = @HAVE__BOOL@
HAVE__EXIT = @HAVE__EXIT@
IMAGEMAGICK_LIBS = @IMAGEMAGICK_LIBS@
INCLUDE_NEXT = @INCLUDE_NEXT@
INCLUDE_NEXT_AS_FIRST_DIRECTIVE = @INCLUDE_NEXT_AS_FIRST_DIRECTIVE@
+INFO_EXT = @INFO_EXT@
+INFO_OPTS = @INFO_OPTS@
INSTALL = @INSTALL@
+INSTALL_ARCH_INDEP_EXTRA = @INSTALL_ARCH_INDEP_EXTRA@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_INFO = @INSTALL_INFO@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
LD_SWITCH_SYSTEM = @LD_SWITCH_SYSTEM@
LD_SWITCH_SYSTEM_TEMACS = @LD_SWITCH_SYSTEM_TEMACS@
LD_SWITCH_X_SITE = @LD_SWITCH_X_SITE@
-LD_SWITCH_X_SITE_AUX = @LD_SWITCH_X_SITE_AUX@
-LD_SWITCH_X_SITE_AUX_RPATH = @LD_SWITCH_X_SITE_AUX_RPATH@
+LD_SWITCH_X_SITE_RPATH = @LD_SWITCH_X_SITE_RPATH@
LIBGIF = @LIBGIF@
LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
LIBXTR6 = @LIBXTR6@
LIBXT_OTHER = @LIBXT_OTHER@
LIBX_OTHER = @LIBX_OTHER@
+LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
+LIB_EXECINFO = @LIB_EXECINFO@
LIB_GCC = @LIB_GCC@
LIB_MATH = @LIB_MATH@
LIB_PTHREAD = @LIB_PTHREAD@
LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@
LIB_STANDARD = @LIB_STANDARD@
+LIB_TIMER_TIME = @LIB_TIMER_TIME@
+LN_S = @LN_S@
LTLIBINTL = @LTLIBINTL@
LTLIBOBJS = @LTLIBOBJS@
M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@
M17N_FLT_LIBS = @M17N_FLT_LIBS@
-MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MKDEPDIR = @MKDEPDIR@
MKDIR_P = @MKDIR_P@
-M_FILE = @M_FILE@
NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@
NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H = @NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H@
NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H = @NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H@
NEXT_AS_FIRST_DIRECTIVE_STDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDINT_H@
NEXT_AS_FIRST_DIRECTIVE_STDIO_H = @NEXT_AS_FIRST_DIRECTIVE_STDIO_H@
NEXT_AS_FIRST_DIRECTIVE_STDLIB_H = @NEXT_AS_FIRST_DIRECTIVE_STDLIB_H@
+NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H@
NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H@
+NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H@
NEXT_AS_FIRST_DIRECTIVE_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_TIME_H@
NEXT_AS_FIRST_DIRECTIVE_UNISTD_H = @NEXT_AS_FIRST_DIRECTIVE_UNISTD_H@
NEXT_GETOPT_H = @NEXT_GETOPT_H@
NEXT_STDINT_H = @NEXT_STDINT_H@
NEXT_STDIO_H = @NEXT_STDIO_H@
NEXT_STDLIB_H = @NEXT_STDLIB_H@
+NEXT_SYS_SELECT_H = @NEXT_SYS_SELECT_H@
NEXT_SYS_STAT_H = @NEXT_SYS_STAT_H@
+NEXT_SYS_TIME_H = @NEXT_SYS_TIME_H@
NEXT_TIME_H = @NEXT_TIME_H@
NEXT_UNISTD_H = @NEXT_UNISTD_H@
NS_OBJ = @NS_OBJ@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
+PAXCTL = @PAXCTL@
PKG_CONFIG = @PKG_CONFIG@
POST_ALLOC_OBJ = @POST_ALLOC_OBJ@
PRAGMA_COLUMNS = @PRAGMA_COLUMNS@
REPLACE_FSTATAT = @REPLACE_FSTATAT@
REPLACE_FTELL = @REPLACE_FTELL@
REPLACE_FTELLO = @REPLACE_FTELLO@
+REPLACE_FTRUNCATE = @REPLACE_FTRUNCATE@
REPLACE_FUTIMENS = @REPLACE_FUTIMENS@
REPLACE_GETCWD = @REPLACE_GETCWD@
REPLACE_GETDELIM = @REPLACE_GETDELIM@
REPLACE_GETLINE = @REPLACE_GETLINE@
REPLACE_GETLOGIN_R = @REPLACE_GETLOGIN_R@
REPLACE_GETPAGESIZE = @REPLACE_GETPAGESIZE@
+REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@
+REPLACE_ISATTY = @REPLACE_ISATTY@
REPLACE_LCHOWN = @REPLACE_LCHOWN@
REPLACE_LINK = @REPLACE_LINK@
REPLACE_LINKAT = @REPLACE_LINKAT@
REPLACE_POPEN = @REPLACE_POPEN@
REPLACE_PREAD = @REPLACE_PREAD@
REPLACE_PRINTF = @REPLACE_PRINTF@
+REPLACE_PSELECT = @REPLACE_PSELECT@
REPLACE_PTHREAD_SIGMASK = @REPLACE_PTHREAD_SIGMASK@
+REPLACE_PTSNAME_R = @REPLACE_PTSNAME_R@
REPLACE_PUTENV = @REPLACE_PUTENV@
REPLACE_PWRITE = @REPLACE_PWRITE@
REPLACE_RAISE = @REPLACE_RAISE@
+REPLACE_RANDOM_R = @REPLACE_RANDOM_R@
REPLACE_READ = @REPLACE_READ@
REPLACE_READLINK = @REPLACE_READLINK@
REPLACE_REALLOC = @REPLACE_REALLOC@
REPLACE_RENAME = @REPLACE_RENAME@
REPLACE_RENAMEAT = @REPLACE_RENAMEAT@
REPLACE_RMDIR = @REPLACE_RMDIR@
+REPLACE_SELECT = @REPLACE_SELECT@
REPLACE_SETENV = @REPLACE_SETENV@
REPLACE_SLEEP = @REPLACE_SLEEP@
REPLACE_SNPRINTF = @REPLACE_SNPRINTF@
REPLACE_STDIO_READ_FUNCS = @REPLACE_STDIO_READ_FUNCS@
REPLACE_STDIO_WRITE_FUNCS = @REPLACE_STDIO_WRITE_FUNCS@
REPLACE_STRTOD = @REPLACE_STRTOD@
+REPLACE_STRTOIMAX = @REPLACE_STRTOIMAX@
+REPLACE_STRUCT_TIMEVAL = @REPLACE_STRUCT_TIMEVAL@
REPLACE_SYMLINK = @REPLACE_SYMLINK@
REPLACE_TIMEGM = @REPLACE_TIMEGM@
REPLACE_TMPFILE = @REPLACE_TMPFILE@
SIG_ATOMIC_T_SUFFIX = @SIG_ATOMIC_T_SUFFIX@
SIZE_T_SUFFIX = @SIZE_T_SUFFIX@
START_FILES = @START_FILES@
+STDALIGN_H = @STDALIGN_H@
STDARG_H = @STDARG_H@
STDBOOL_H = @STDBOOL_H@
STDDEF_H = @STDDEF_H@
STRIP = @STRIP@
SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@
SYS_TIME_H_DEFINES_STRUCT_TIMESPEC = @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@
-S_FILE = @S_FILE@
TEMACS_LDFLAGS2 = @TEMACS_LDFLAGS2@
TERMCAP_OBJ = @TERMCAP_OBJ@
TIME_H_DEFINES_STRUCT_TIMESPEC = @TIME_H_DEFINES_STRUCT_TIMESPEC@
UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS = @UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS@
VERSION = @VERSION@
VMLIMIT_OBJ = @VMLIMIT_OBJ@
+WARN_CFLAGS = @WARN_CFLAGS@
WCHAR_T_SUFFIX = @WCHAR_T_SUFFIX@
+WERROR_CFLAGS = @WERROR_CFLAGS@
WIDGET_OBJ = @WIDGET_OBJ@
+WINDOWS_64_BIT_OFF_T = @WINDOWS_64_BIT_OFF_T@
+WINDOWS_64_BIT_ST_SIZE = @WINDOWS_64_BIT_ST_SIZE@
+WINDOW_SYSTEM_OBJ = @WINDOW_SYSTEM_OBJ@
WINT_T_SUFFIX = @WINT_T_SUFFIX@
XFT_CFLAGS = @XFT_CFLAGS@
XFT_LIBS = @XFT_LIBS@
cache_file = @cache_file@
canonical = @canonical@
configuration = @configuration@
+copyright = @copyright@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
+leimdir = @leimdir@
libdir = @libdir@
libexecdir = @libexecdir@
liblockfile = @liblockfile@
ns_appdir = @ns_appdir@
ns_appresdir = @ns_appresdir@
ns_appsrc = @ns_appsrc@
+ns_self_contained = @ns_self_contained@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
+standardlisppath = @standardlisppath@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
# statements but through direct file reference. Therefore this snippet must be
# present in all Makefile.am that need it. This is ensured by the applicability
# 'all' defined above.
-BUILT_SOURCES = $(ALLOCA_H) $(GETOPT_H) inttypes.h signal.h \
- arg-nonnull.h c++defs.h warn-on-use.h $(STDARG_H) $(STDBOOL_H) \
- $(STDDEF_H) $(STDINT_H) stdio.h stdlib.h sys/stat.h time.h \
- unistd.h
+BUILT_SOURCES = $(ALLOCA_H) $(EXECINFO_H) $(GETOPT_H) inttypes.h \
+ signal.h arg-nonnull.h c++defs.h warn-on-use.h $(STDALIGN_H) \
+ $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) stdio.h \
+ stdlib.h sys/select.h sys/stat.h sys/time.h time.h unistd.h
EXTRA_DIST = alloca.in.h allocator.h careadlinkat.h md5.h sha1.h \
sha256.h sha512.h dosname.h ftoastr.c ftoastr.h dup2.c \
- filemode.h getloadavg.c getopt.c getopt.in.h getopt1.c \
- getopt_int.h ignore-value.h intprops.h inttypes.in.h lstat.c \
- mktime-internal.h mktime.c pathmax.h pthread_sigmask.c \
- readlink.c signal.in.h sigprocmask.c \
+ execinfo.c execinfo.in.h filemode.h getloadavg.c getopt.c \
+ getopt.in.h getopt1.c getopt_int.h gettimeofday.c \
+ ignore-value.h intprops.h inttypes.in.h lstat.c \
+ mktime-internal.h mktime.c pathmax.h pselect.c \
+ pthread_sigmask.c readlink.c signal.in.h \
$(top_srcdir)/build-aux/snippet/_Noreturn.h \
$(top_srcdir)/build-aux/snippet/arg-nonnull.h \
$(top_srcdir)/build-aux/snippet/c++defs.h \
$(top_srcdir)/build-aux/snippet/warn-on-use.h stat.c \
- stdarg.in.h stdbool.in.h stddef.in.h stdint.in.h stdio.in.h \
- stdlib.in.h strftime.h strtoimax.c strtol.c strtoll.c strtol.c \
- strtoul.c strtoull.c strtoimax.c strtoumax.c symlink.c \
- sys_stat.in.h time.in.h time_r.c u64.h unistd.in.h verify.h
-MOSTLYCLEANDIRS = sys
-MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t getopt.h \
- getopt.h-t inttypes.h inttypes.h-t signal.h signal.h-t \
- arg-nonnull.h arg-nonnull.h-t c++defs.h c++defs.h-t \
- warn-on-use.h warn-on-use.h-t stdarg.h stdarg.h-t stdbool.h \
- stdbool.h-t stddef.h stddef.h-t stdint.h stdint.h-t stdio.h \
- stdio.h-t stdlib.h stdlib.h-t sys/stat.h sys/stat.h-t time.h \
- time.h-t unistd.h unistd.h-t
+ stat-time.h stdalign.in.h stdarg.in.h stdbool.in.h stddef.in.h \
+ stdint.in.h stdio.in.h stdlib.in.h strftime.h strtoimax.c \
+ strtol.c strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \
+ strtoumax.c symlink.c sys_select.in.h sys_stat.in.h \
+ sys_time.in.h time.in.h time_r.c timespec.h u64.h unistd.in.h \
+ utimens.h verify.h
+MOSTLYCLEANDIRS = sys sys
+MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t execinfo.h \
+ execinfo.h-t getopt.h getopt.h-t inttypes.h inttypes.h-t \
+ signal.h signal.h-t arg-nonnull.h arg-nonnull.h-t c++defs.h \
+ c++defs.h-t warn-on-use.h warn-on-use.h-t stdalign.h \
+ stdalign.h-t stdarg.h stdarg.h-t stdbool.h stdbool.h-t \
+ stddef.h stddef.h-t stdint.h stdint.h-t stdio.h stdio.h-t \
+ stdlib.h stdlib.h-t sys/select.h sys/select.h-t sys/stat.h \
+ sys/stat.h-t sys/time.h sys/time.h-t time.h time.h-t unistd.h \
+ unistd.h-t
noinst_LIBRARIES = libgnu.a
-DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src
-libgnu_a_SOURCES = allocator.c careadlinkat.c md5.c sha1.c sha256.c \
- sha512.c dtoastr.c filemode.c $(am__append_1) strftime.c
+AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS)
+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 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 \
- getopt1.c lstat.c mktime.c pthread_sigmask.c readlink.c \
- sigprocmask.c stat.c strtoimax.c strtol.c strtoll.c strtol.c \
- strtoul.c strtoull.c strtoimax.c strtoumax.c symlink.c \
- time_r.c
+EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c execinfo.c getloadavg.c \
+ getopt.c getopt1.c gettimeofday.c lstat.c mktime.c pselect.c \
+ pthread_sigmask.c readlink.c stat.c strtoimax.c strtol.c \
+ strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \
+ strtoumax.c symlink.c time_r.c
# Because this Makefile snippet defines a variable used by other
# gnulib Makefile snippets, it must be present in all Makefile.am that
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/allocator.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-ctype.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strcasecmp.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strncasecmp.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/careadlinkat.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtotimespec.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dup2.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/execinfo.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/filemode.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getloadavg.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt1.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettime.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettimeofday.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lstat.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/md5.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pselect.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pthread_sigmask.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/readlink.Po@am__quote@
@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)/sigprocmask.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@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoumax.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/symlink.Po@am__quote@
@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:
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@GL_GENERATE_ALLOCA_H_FALSE@alloca.h: $(top_builddir)/config.status
@GL_GENERATE_ALLOCA_H_FALSE@ rm -f $@
+# We need the following in order to create <execinfo.h> when the system
+# doesn't have one that works.
+@GL_GENERATE_EXECINFO_H_TRUE@execinfo.h: execinfo.in.h $(top_builddir)/config.status
+@GL_GENERATE_EXECINFO_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \
+@GL_GENERATE_EXECINFO_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+@GL_GENERATE_EXECINFO_H_TRUE@ cat $(srcdir)/execinfo.in.h; \
+@GL_GENERATE_EXECINFO_H_TRUE@ } > $@-t && \
+@GL_GENERATE_EXECINFO_H_TRUE@ mv $@-t $@
+@GL_GENERATE_EXECINFO_H_FALSE@execinfo.h: $(top_builddir)/config.status
+@GL_GENERATE_EXECINFO_H_FALSE@ rm -f $@
+
# We need the following in order to create <getopt.h> when the system
# doesn't have one that works with the given compiler.
getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H)
# We need the following in order to create <inttypes.h> when the system
# doesn't have one that works with the given compiler.
-inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_NONNULL_H)
+inttypes.h: inttypes.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H) $(ARG_NONNULL_H)
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
sed -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \
-e 's/@''HAVE_DECL_IMAXDIV''@/$(HAVE_DECL_IMAXDIV)/g' \
-e 's/@''HAVE_DECL_STRTOIMAX''@/$(HAVE_DECL_STRTOIMAX)/g' \
-e 's/@''HAVE_DECL_STRTOUMAX''@/$(HAVE_DECL_STRTOUMAX)/g' \
+ -e 's/@''REPLACE_STRTOIMAX''@/$(REPLACE_STRTOIMAX)/g' \
-e 's/@''INT32_MAX_LT_INTMAX_MAX''@/$(INT32_MAX_LT_INTMAX_MAX)/g' \
-e 's/@''INT64_MAX_EQ_LONG_MAX''@/$(INT64_MAX_EQ_LONG_MAX)/g' \
-e 's/@''UINT32_MAX_LT_UINTMAX_MAX''@/$(UINT32_MAX_LT_UINTMAX_MAX)/g' \
-e 's/@''UINT64_MAX_EQ_ULONG_MAX''@/$(UINT64_MAX_EQ_ULONG_MAX)/g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
-e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
-e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
< $(srcdir)/inttypes.in.h; \
> $@-t && \
mv $@-t $@
+# We need the following in order to create <stdalign.h> when the system
+# doesn't have one that works.
+@GL_GENERATE_STDALIGN_H_TRUE@stdalign.h: stdalign.in.h $(top_builddir)/config.status
+@GL_GENERATE_STDALIGN_H_TRUE@ $(AM_V_GEN)rm -f $@-t $@ && \
+@GL_GENERATE_STDALIGN_H_TRUE@ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+@GL_GENERATE_STDALIGN_H_TRUE@ cat $(srcdir)/stdalign.in.h; \
+@GL_GENERATE_STDALIGN_H_TRUE@ } > $@-t && \
+@GL_GENERATE_STDALIGN_H_TRUE@ mv $@-t $@
+@GL_GENERATE_STDALIGN_H_FALSE@stdalign.h: $(top_builddir)/config.status
+@GL_GENERATE_STDALIGN_H_FALSE@ rm -f $@
+
# We need the following in order to create <stdarg.h> when the system
# doesn't have one that works with the given compiler.
@GL_GENERATE_STDARG_H_TRUE@stdarg.h: stdarg.in.h $(top_builddir)/config.status
-e 's/@''GNULIB_MKOSTEMPS''@/$(GNULIB_MKOSTEMPS)/g' \
-e 's/@''GNULIB_MKSTEMP''@/$(GNULIB_MKSTEMP)/g' \
-e 's/@''GNULIB_MKSTEMPS''@/$(GNULIB_MKSTEMPS)/g' \
+ -e 's/@''GNULIB_POSIX_OPENPT''@/$(GNULIB_POSIX_OPENPT)/g' \
-e 's/@''GNULIB_PTSNAME''@/$(GNULIB_PTSNAME)/g' \
+ -e 's/@''GNULIB_PTSNAME_R''@/$(GNULIB_PTSNAME_R)/g' \
-e 's/@''GNULIB_PUTENV''@/$(GNULIB_PUTENV)/g' \
+ -e 's/@''GNULIB_RANDOM''@/$(GNULIB_RANDOM)/g' \
-e 's/@''GNULIB_RANDOM_R''@/$(GNULIB_RANDOM_R)/g' \
-e 's/@''GNULIB_REALLOC_POSIX''@/$(GNULIB_REALLOC_POSIX)/g' \
-e 's/@''GNULIB_REALPATH''@/$(GNULIB_REALPATH)/g' \
-e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \
-e 's|@''HAVE_MKSTEMP''@|$(HAVE_MKSTEMP)|g' \
-e 's|@''HAVE_MKSTEMPS''@|$(HAVE_MKSTEMPS)|g' \
+ -e 's|@''HAVE_POSIX_OPENPT''@|$(HAVE_POSIX_OPENPT)|g' \
-e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \
+ -e 's|@''HAVE_PTSNAME_R''@|$(HAVE_PTSNAME_R)|g' \
+ -e 's|@''HAVE_RANDOM''@|$(HAVE_RANDOM)|g' \
-e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \
-e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \
-e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \
-e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \
-e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \
-e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \
+ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \
-e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \
+ -e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|g' \
-e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \
-e 's|@''REPLACE_REALPATH''@|$(REPLACE_REALPATH)|g' \
-e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \
} > $@-t && \
mv $@-t $@
+# We need the following in order to create <sys/select.h> when the system
+# doesn't have one that works with the given compiler.
+sys/select.h: sys_select.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_SELECT_H''@|$(NEXT_SYS_SELECT_H)|g' \
+ -e 's|@''HAVE_SYS_SELECT_H''@|$(HAVE_SYS_SELECT_H)|g' \
+ -e 's/@''GNULIB_PSELECT''@/$(GNULIB_PSELECT)/g' \
+ -e 's/@''GNULIB_SELECT''@/$(GNULIB_SELECT)/g' \
+ -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \
+ -e 's|@''HAVE_PSELECT''@|$(HAVE_PSELECT)|g' \
+ -e 's|@''REPLACE_PSELECT''@|$(REPLACE_PSELECT)|g' \
+ -e 's|@''REPLACE_SELECT''@|$(REPLACE_SELECT)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_select.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+
# We need the following in order to create <sys/stat.h> when the system
# has one that is incomplete.
sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \
+ -e 's|@''WINDOWS_64_BIT_ST_SIZE''@|$(WINDOWS_64_BIT_ST_SIZE)|g' \
-e 's/@''GNULIB_FCHMODAT''@/$(GNULIB_FCHMODAT)/g' \
-e 's/@''GNULIB_FSTAT''@/$(GNULIB_FSTAT)/g' \
-e 's/@''GNULIB_FSTATAT''@/$(GNULIB_FSTATAT)/g' \
} > $@-t && \
mv $@-t $@
+# We need the following in order to create <sys/time.h> when the system
+# doesn't have one that works with the given compiler.
+sys/time.h: sys_time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's/@''HAVE_SYS_TIME_H''@/$(HAVE_SYS_TIME_H)/g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_TIME_H''@|$(NEXT_SYS_TIME_H)|g' \
+ -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \
+ -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \
+ -e 's/@''HAVE_GETTIMEOFDAY''@/$(HAVE_GETTIMEOFDAY)/g' \
+ -e 's/@''HAVE_STRUCT_TIMEVAL''@/$(HAVE_STRUCT_TIMEVAL)/g' \
+ -e 's/@''REPLACE_GETTIMEOFDAY''@/$(REPLACE_GETTIMEOFDAY)/g' \
+ -e 's/@''REPLACE_STRUCT_TIMEVAL''@/$(REPLACE_STRUCT_TIMEVAL)/g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_time.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+
# We need the following in order to create <time.h> when the system
# doesn't have one that works with the given compiler.
time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_UNISTD_H''@|$(NEXT_UNISTD_H)|g' \
+ -e 's|@''WINDOWS_64_BIT_OFF_T''@|$(WINDOWS_64_BIT_OFF_T)|g' \
-e 's/@''GNULIB_CHDIR''@/$(GNULIB_CHDIR)/g' \
-e 's/@''GNULIB_CHOWN''@/$(GNULIB_CHOWN)/g' \
-e 's/@''GNULIB_CLOSE''@/$(GNULIB_CLOSE)/g' \
-e 's/@''GNULIB_GETPAGESIZE''@/$(GNULIB_GETPAGESIZE)/g' \
-e 's/@''GNULIB_GETUSERSHELL''@/$(GNULIB_GETUSERSHELL)/g' \
-e 's/@''GNULIB_GROUP_MEMBER''@/$(GNULIB_GROUP_MEMBER)/g' \
+ -e 's/@''GNULIB_ISATTY''@/$(GNULIB_ISATTY)/g' \
-e 's/@''GNULIB_LCHOWN''@/$(GNULIB_LCHOWN)/g' \
-e 's/@''GNULIB_LINK''@/$(GNULIB_LINK)/g' \
-e 's/@''GNULIB_LINKAT''@/$(GNULIB_LINKAT)/g' \
-e 's/@''GNULIB_READLINK''@/$(GNULIB_READLINK)/g' \
-e 's/@''GNULIB_READLINKAT''@/$(GNULIB_READLINKAT)/g' \
-e 's/@''GNULIB_RMDIR''@/$(GNULIB_RMDIR)/g' \
+ -e 's/@''GNULIB_SETHOSTNAME''@/$(GNULIB_SETHOSTNAME)/g' \
-e 's/@''GNULIB_SLEEP''@/$(GNULIB_SLEEP)/g' \
-e 's/@''GNULIB_SYMLINK''@/$(GNULIB_SYMLINK)/g' \
-e 's/@''GNULIB_SYMLINKAT''@/$(GNULIB_SYMLINKAT)/g' \
-e 's/@''GNULIB_TTYNAME_R''@/$(GNULIB_TTYNAME_R)/g' \
- -e 's/@''GNULIB_UNISTD_H_GETOPT''@/$(GNULIB_UNISTD_H_GETOPT)/g' \
+ -e 's/@''GNULIB_UNISTD_H_GETOPT''@/0$(GNULIB_GL_UNISTD_H_GETOPT)/g' \
-e 's/@''GNULIB_UNISTD_H_NONBLOCKING''@/$(GNULIB_UNISTD_H_NONBLOCKING)/g' \
-e 's/@''GNULIB_UNISTD_H_SIGPIPE''@/$(GNULIB_UNISTD_H_SIGPIPE)/g' \
-e 's/@''GNULIB_UNLINK''@/$(GNULIB_UNLINK)/g' \
-e 's|@''HAVE_PWRITE''@|$(HAVE_PWRITE)|g' \
-e 's|@''HAVE_READLINK''@|$(HAVE_READLINK)|g' \
-e 's|@''HAVE_READLINKAT''@|$(HAVE_READLINKAT)|g' \
+ -e 's|@''HAVE_SETHOSTNAME''@|$(HAVE_SETHOSTNAME)|g' \
-e 's|@''HAVE_SLEEP''@|$(HAVE_SLEEP)|g' \
-e 's|@''HAVE_SYMLINK''@|$(HAVE_SYMLINK)|g' \
-e 's|@''HAVE_SYMLINKAT''@|$(HAVE_SYMLINKAT)|g' \
-e 's|@''HAVE_DECL_GETLOGIN_R''@|$(HAVE_DECL_GETLOGIN_R)|g' \
-e 's|@''HAVE_DECL_GETPAGESIZE''@|$(HAVE_DECL_GETPAGESIZE)|g' \
-e 's|@''HAVE_DECL_GETUSERSHELL''@|$(HAVE_DECL_GETUSERSHELL)|g' \
+ -e 's|@''HAVE_DECL_SETHOSTNAME''@|$(HAVE_DECL_SETHOSTNAME)|g' \
-e 's|@''HAVE_DECL_TTYNAME_R''@|$(HAVE_DECL_TTYNAME_R)|g' \
-e 's|@''HAVE_OS_H''@|$(HAVE_OS_H)|g' \
-e 's|@''HAVE_SYS_PARAM_H''@|$(HAVE_SYS_PARAM_H)|g' \
-e 's|@''REPLACE_DUP''@|$(REPLACE_DUP)|g' \
-e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \
-e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \
+ -e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \
-e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \
-e 's|@''REPLACE_GETDOMAINNAME''@|$(REPLACE_GETDOMAINNAME)|g' \
-e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \
-e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \
-e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \
+ -e 's|@''REPLACE_ISATTY''@|$(REPLACE_ISATTY)|g' \
-e 's|@''REPLACE_LCHOWN''@|$(REPLACE_LCHOWN)|g' \
-e 's|@''REPLACE_LINK''@|$(REPLACE_LINK)|g' \
-e 's|@''REPLACE_LINKAT''@|$(REPLACE_LINKAT)|g' \
m4_include([m4/00gnulib.m4])
m4_include([m4/alloca.m4])
m4_include([m4/c-strtod.m4])
+m4_include([m4/clock_time.m4])
m4_include([m4/dup2.m4])
+m4_include([m4/environ.m4])
+m4_include([m4/execinfo.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])
-m4_include([m4/gl-comp.m4])
+m4_include([m4/gettime.m4])
+m4_include([m4/gettimeofday.m4])
m4_include([m4/gnulib-common.m4])
+m4_include([m4/gnulib-comp.m4])
m4_include([m4/include_next.m4])
m4_include([m4/inttypes.m4])
m4_include([m4/largefile.m4])
m4_include([m4/longlong.m4])
m4_include([m4/lstat.m4])
+m4_include([m4/manywarnings.m4])
m4_include([m4/md5.m4])
m4_include([m4/mktime.m4])
m4_include([m4/multiarch.m4])
m4_include([m4/nocrash.m4])
+m4_include([m4/off_t.m4])
m4_include([m4/pathmax.m4])
+m4_include([m4/pselect.m4])
m4_include([m4/pthread_sigmask.m4])
m4_include([m4/readlink.m4])
m4_include([m4/sha1.m4])
m4_include([m4/sha256.m4])
m4_include([m4/sha512.m4])
m4_include([m4/signal_h.m4])
-m4_include([m4/signalblocking.m4])
m4_include([m4/socklen.m4])
m4_include([m4/ssize_t.m4])
m4_include([m4/st_dm_mode.m4])
+m4_include([m4/stat-time.m4])
m4_include([m4/stat.m4])
+m4_include([m4/stdalign.m4])
m4_include([m4/stdarg.m4])
m4_include([m4/stdbool.m4])
m4_include([m4/stddef_h.m4])
m4_include([m4/strtoull.m4])
m4_include([m4/strtoumax.m4])
m4_include([m4/symlink.m4])
+m4_include([m4/sys_select_h.m4])
+m4_include([m4/sys_socket_h.m4])
m4_include([m4/sys_stat_h.m4])
+m4_include([m4/sys_time_h.m4])
m4_include([m4/time_h.m4])
m4_include([m4/time_r.m4])
+m4_include([m4/timer_time.m4])
+m4_include([m4/timespec.m4])
m4_include([m4/tm_gmtoff.m4])
m4_include([m4/unistd_h.m4])
+m4_include([m4/utimbuf.m4])
+m4_include([m4/utimens.m4])
+m4_include([m4/utimes.m4])
+m4_include([m4/warnings.m4])
m4_include([m4/wchar_t.m4])
-/* src/config.in. Generated from configure.in by autoheader. */
+/* src/config.in. Generated from configure.ac by autoheader. */
/* GNU Emacs site configuration template file.
/* Define if building universal (internal helper macro) */
#undef AC_APPLE_UNIVERSAL_BUILD
+/* Define to use the convention that & in the full name stands for the login
+ id. */
+#undef AMPERSAND_FULL_NAME
+
/* Define to the number of bits in type 'ptrdiff_t'. */
#undef BITSIZEOF_PTRDIFF_T
/* Define to the number of bits in type 'wint_t'. */
#undef BITSIZEOF_WINT_T
+/* 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
+
+/* Define on FreeBSD to work around an issue when reading from a PTY. */
+#undef BROKEN_PTY_READ_AFTER_EAGAIN
+
+/* Define if the system is compatible with BSD 4.2. */
+#undef BSD4_2
+
+/* Define if the system is compatible with BSD 4.2. */
+#undef BSD_SYSTEM
+
+/* Define if AH_BOTTOM should change BSD_SYSTEM. */
+#undef BSD_SYSTEM_AHB
+
/* Define if Emacs cannot be dumped on your system. */
#undef CANNOT_DUMP
-/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP
- systems. This function is required for `alloca.c' support on those systems.
+/* Define this to enable compile time checks for the Lisp_Object data type. */
+#undef CHECK_LISP_OBJECT_TYPE
+
+/* Define if you want lock files to be written, so that Emacs can tell
+ instantly when you try to modify a file that someone else has modified in
+ his/her Emacs. */
+#undef CLASH_DETECTION
+
+/* Short copyright string for this version of Emacs. */
+#undef COPYRIGHT
+
+/* Define to one of '_getb67', 'GETB67', 'getb67' for Cray-2 and Cray-YMP
+ systems. This function is required for 'alloca.c' support on those systems.
*/
#undef CRAY_STACKSEG_END
-/* Define to 1 if using `alloca.c'. */
+/* Define if the system is Cygwin. */
+#undef CYGWIN
+
+/* Define to 1 if using 'alloca.c'. */
#undef C_ALLOCA
+/* Define if the system is Darwin. */
+#undef DARWIN_OS
+
+/* Extra bits to be or'd in with any pointers stored in a Lisp_Object. */
+#undef DATA_SEG_BITS
+
+/* Address of the start of the data segment. */
+#undef DATA_START
+
+/* Name of the default sound device. */
+#undef DEFAULT_SOUND_DEVICE
+
+/* Character that separates a device in a file name. */
+#undef DEVICE_SEP
+
/* Define to 1 for DGUX with <sys/dg_sys_info.h>. */
#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
/* Define to the options passed to configure. */
#undef EMACS_CONFIG_OPTIONS
-/* Enable expensive run-time checking of data types? */
+/* Define to 1 if expensive run-time data type and consistency checks are
+ enabled. */
#undef ENABLE_CHECKING
+/* Letter to use in finding device name of first PTY, if PTYs are supported.
+ */
+#undef FIRST_PTY_LETTER
+
+/* Enable compile-time and run-time bounds-checking, and some warnings,
+ without upsetting glibc 2.15+. */
+ #if defined __OPTIMIZE__ && __OPTIMIZE__
+ # define _FORTIFY_SOURCE 2
+ #endif
+
+
+/* Define to 1 if futimesat mishandles a NULL file name. */
+#undef FUTIMESAT_NULL_BUG
+
/* Define this to check for errors in cons list. */
#undef GC_CHECK_CONS_LIST
/* Define this to check for short string overrun. */
#undef GC_CHECK_STRING_OVERRUN
+/* Mark a secondary stack, like the register stack on the ia64. */
+#undef GC_MARK_SECONDARY_STACK
+
+/* Define to GC_USE_GCPROS_AS_BEFORE if conservative garbage collection is not
+ known to work. */
+#undef GC_MARK_STACK
+
+/* Define if setjmp is known to save all registers relevant for conservative
+ garbage collection in the jmp_buf. */
+#undef GC_SETJMP_WORKS
+
/* Define to 1 if the `getpgrp' function requires zero arguments. */
#undef GETPGRP_VOID
-/* Define to 1 if gettimeofday accepts only one argument. */
-#undef GETTIMEOFDAY_ONE_ARGUMENT
+/* Define if gettimeofday clobbers the localtime buffer. */
+#undef GETTIMEOFDAY_CLOBBERS_LOCALTIME
+
+/* Define this to 'void' or 'struct timezone' to match the system's
+ declaration of the second argument to gettimeofday. */
+#undef GETTIMEOFDAY_TIMEZONE
+
+/* Define this to enable glyphs debugging code. */
+#undef GLYPH_DEBUG
+
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module fscanf shall be considered present. */
+#undef GNULIB_FSCANF
+
+/* enable some gnulib portability checks */
+#undef GNULIB_PORTCHECK
+
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module scanf shall be considered present. */
+#undef GNULIB_SCANF
-/* Define to make the limit macros in <stdint.h> visible. */
-#undef GL_TRIGGER_STDC_LIMIT_MACROS
+/* Define if ths system is compatible with GNU/Linux. */
+#undef GNU_LINUX
/* Define to 1 if you want to use the GNU memory allocator. */
#undef GNU_MALLOC
+/* Define to set the G_SLICE environment variable to "always-malloc" at
+ startup, if using GTK. */
+#undef G_SLICE_ALWAYS_MALLOC
+
/* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */
#undef HAVE_AIX_SMT_EXP
/* Define to 1 if ALSA is available. */
#undef HAVE_ALSA
-/* Define to 1 if GCC-style __attribute__ ((__aligned__ (expr))) works. */
-#undef HAVE_ATTRIBUTE_ALIGNED
-
/* Define to 1 if strtold conforms to C99. */
#undef HAVE_C99_STRTOLD
-/* Define to 1 if you have the `cbrt' function. */
-#undef HAVE_CBRT
-
/* Define to 1 if you have the `cfmakeraw' function. */
#undef HAVE_CFMAKERAW
/* Define to 1 if you have the `cfsetspeed' function. */
#undef HAVE_CFSETSPEED
+/* Define to 1 if you have the `clock_gettime' function. */
+#undef HAVE_CLOCK_GETTIME
+
+/* Define to 1 if you have the `clock_settime' function. */
+#undef HAVE_CLOCK_SETTIME
+
/* Define to 1 if you have the `closedir' function. */
#undef HAVE_CLOSEDIR
/* Define to 1 if using D-Bus. */
#undef HAVE_DBUS
+/* Define to 1 if you have the `dbus_type_is_valid' function. */
+#undef HAVE_DBUS_TYPE_IS_VALID
+
+/* Define to 1 if you have the `dbus_validate_bus_name' function. */
+#undef HAVE_DBUS_VALIDATE_BUS_NAME
+
+/* Define to 1 if you have the `dbus_validate_interface' function. */
+#undef HAVE_DBUS_VALIDATE_INTERFACE
+
+/* Define to 1 if you have the `dbus_validate_member' function. */
+#undef HAVE_DBUS_VALIDATE_MEMBER
+
+/* Define to 1 if you have the `dbus_validate_path' function. */
+#undef HAVE_DBUS_VALIDATE_PATH
+
/* Define to 1 if you have the `dbus_watch_get_unix_fd' function. */
#undef HAVE_DBUS_WATCH_GET_UNIX_FD
/* Define to 1 if you have the 'dup2' function. */
#undef HAVE_DUP2
+/* Define to 1 if you have the `endgrent' function. */
+#undef HAVE_ENDGRENT
+
+/* Define to 1 if you have the `endpwent' function. */
+#undef HAVE_ENDPWENT
+
+/* Define if you have the declaration of environ. */
+#undef HAVE_ENVIRON_DECL
+
/* Define to 1 if you have the `euidaccess' function. */
#undef HAVE_EUIDACCESS
+/* Define to 1 if you have the <execinfo.h> header file. */
+#undef HAVE_EXECINFO_H
+
/* Define to 1 if you have the <fcntl.h> header file. */
#undef HAVE_FCNTL_H
-/* Define to 1 if you have the `fmod' function. */
-#undef HAVE_FMOD
-
/* Define to 1 if you have the `fork' function. */
#undef HAVE_FORK
/* Define to 1 if using the freetype and fontconfig libraries. */
#undef HAVE_FREETYPE
-/* Define to 1 if you have the `frexp' function. */
-#undef HAVE_FREXP
-
/* Define to 1 if fseeko (and presumably ftello) exists and is declared. */
#undef HAVE_FSEEKO
/* Define to 1 if you have the `fsync' function. */
#undef HAVE_FSYNC
-/* Define to 1 if you have the `ftime' function. */
-#undef HAVE_FTIME
+/* Define to 1 if you have the `futimens' function. */
+#undef HAVE_FUTIMENS
+
+/* Define to 1 if you have the `futimes' function. */
+#undef HAVE_FUTIMES
+
+/* Define to 1 if you have the `futimesat' function. */
+#undef HAVE_FUTIMESAT
/* Define to 1 if you have the `gai_strerror' function. */
#undef HAVE_GAI_STRERROR
/* Define to 1 if you have the `getdelim' function. */
#undef HAVE_GETDELIM
-/* Define to 1 if you have the `getdomainname' function. */
-#undef HAVE_GETDOMAINNAME
+/* Define to 1 if you have the `getgrent' function. */
+#undef HAVE_GETGRENT
/* Define to 1 if you have the `gethostname' function. */
#undef HAVE_GETHOSTNAME
/* Define to 1 if you have the `getpt' function. */
#undef HAVE_GETPT
+/* Define to 1 if you have the `getpwent' function. */
+#undef HAVE_GETPWENT
+
/* Define to 1 if you have the `getrlimit' function. */
#undef HAVE_GETRLIMIT
/* Define to 1 if you have the `getsockname' function. */
#undef HAVE_GETSOCKNAME
-/* Define to 1 if you have the `getsockopt' function. */
-#undef HAVE_GETSOCKOPT
-
/* Define to 1 if you have the `gettimeofday' function. */
#undef HAVE_GETTIMEOFDAY
/* Define to 1 if you have the `mail' library (-lmail). */
#undef HAVE_LIBMAIL
-/* Define to 1 if you have the `ncurses' library (-lncurses). */
-#undef HAVE_LIBNCURSES
-
/* Define to 1 if using libotf. */
#undef HAVE_LIBOTF
/* Define to 1 if you have the <linux/version.h> header file. */
#undef HAVE_LINUX_VERSION_H
-/* Define to 1 if you have the <locale.h> header file. */
-#undef HAVE_LOCALE_H
-
/* Define to 1 if you have the `localtime_r' function. */
#undef HAVE_LOCALTIME_R
-/* Define to 1 if you have the `logb' function. */
-#undef HAVE_LOGB
-
/* Define to 1 if you support file names longer than 14 characters. */
#undef HAVE_LONG_FILE_NAMES
-/* Define to 1 if the system has the type `long long int'. */
+/* Define to 1 if the system has the type 'long long int'. */
#undef HAVE_LONG_LONG_INT
/* Define to 1 if you have the `lrand48' function. */
/* Define to 1 if you have the `lstat' function. */
#undef HAVE_LSTAT
+/* Define to 1 if you have the `lutimes' function. */
+#undef HAVE_LUTIMES
+
/* Define to 1 if using libm17n-flt. */
#undef HAVE_M17N_FLT
/* Define to 1 if you have the `MagickExportImagePixels' function. */
#undef HAVE_MAGICKEXPORTIMAGEPIXELS
+/* Define to 1 if you have the `MagickMergeImageLayers' function. */
+#undef HAVE_MAGICKMERGEIMAGELAYERS
+
/* Define to 1 if you have the <maillock.h> header file. */
#undef HAVE_MAILLOCK_H
/* Define to 1 if you have the <malloc/malloc.h> header file. */
#undef HAVE_MALLOC_MALLOC_H
-/* Define to 1 if you have the `mblen' function. */
-#undef HAVE_MBLEN
-
-/* Define to 1 if you have the `mbrlen' function. */
-#undef HAVE_MBRLEN
-
-/* Define to 1 if you have the `mbsinit' function. */
-#undef HAVE_MBSINIT
-
/* Define to 1 if <wchar.h> declares mbstate_t. */
#undef HAVE_MBSTATE_T
/* Define to 1 if you have the <memory.h> header file. */
#undef HAVE_MEMORY_H
-/* Define to 1 if you have the `mempcpy' function. */
-#undef HAVE_MEMPCPY
-
/* Define to 1 if you have mouse menus. (This is automatic if you use X, but
the option to specify it remains.) It is also defined with other window
systems that support xmenu.c. */
#undef HAVE_MENUS
-/* Define to 1 if you have the `mkdir' function. */
-#undef HAVE_MKDIR
-
/* Define to 1 if you have the `mkstemp' function. */
#undef HAVE_MKSTEMP
/* Define if you have mouse support. */
#undef HAVE_MOUSE
-/* Define to 1 if you have the `mremap' function. */
-#undef HAVE_MREMAP
+/* Define to 1 if you have the `nanotime' function. */
+#undef HAVE_NANOTIME
/* Define to 1 if you have the <net/if_dl.h> header file. */
#undef HAVE_NET_IF_DL_H
/* Define to 1 if you have the `posix_memalign' function. */
#undef HAVE_POSIX_MEMALIGN
+/* Define to 1 if you have the `posix_openpt' function. */
+#undef HAVE_POSIX_OPENPT
+
+/* Define if you have the /proc filesystem. */
+#undef HAVE_PROCFS
+
+/* Define to 1 if you have the `pselect' function. */
+#undef HAVE_PSELECT
+
/* Define to 1 if you have the `pstat_getdynamic' function. */
#undef HAVE_PSTAT_GETDYNAMIC
/* Define to 1 if the pthread_sigmask function can be used (despite bugs). */
#undef HAVE_PTHREAD_SIGMASK
+/* Define if the system supports pty devices. */
+#undef HAVE_PTYS
+
/* Define to 1 if you have the <pty.h> header file. */
#undef HAVE_PTY_H
/* Define to 1 if you have the `recvfrom' function. */
#undef HAVE_RECVFROM
-/* Define to 1 if you have the `rename' function. */
-#undef HAVE_RENAME
-
/* Define to 1 if res_init is available. */
#undef HAVE_RES_INIT
/* Define to 1 if you have the `rint' function. */
#undef HAVE_RINT
-/* Define to 1 if you have the `rmdir' function. */
-#undef HAVE_RMDIR
-
/* Define to 1 if using librsvg. */
#undef HAVE_RSVG
/* Define to 1 if you have the `setsid' function. */
#undef HAVE_SETSID
-/* Define to 1 if you have the `setsockopt' function. */
-#undef HAVE_SETSOCKOPT
-
/* Define to 1 if you have the `shutdown' function. */
#undef HAVE_SHUTDOWN
/* Define to 1 if 'wint_t' is a signed integer type. */
#undef HAVE_SIGNED_WINT_T
+/* Define to 1 if sigsetjmp and siglongjmp work. The value of this symbol is
+ irrelevant if HAVE__SETJMP is defined. */
+#undef HAVE_SIGSETJMP
+
/* Define to 1 if the system has the type `sigset_t'. */
#undef HAVE_SIGSET_T
/* Define to 1 if you have the `snprintf' function. */
#undef HAVE_SNPRINTF
+/* Define if the system supports 4.2-compatible sockets. */
+#undef HAVE_SOCKETS
+
/* Define to 1 if you have sound support. */
#undef HAVE_SOUND
/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
-/* Define to 1 if you have the `strerror' function. */
-#undef HAVE_STRERROR
-
/* Define to 1 if you have the <strings.h> header file. */
#undef HAVE_STRINGS_H
/* Define to 1 if `n_un.n_name' is a member of `struct nlist'. */
#undef HAVE_STRUCT_NLIST_N_UN_N_NAME
+/* Define to 1 if `st_atimensec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIMENSEC
+
+/* Define to 1 if `st_atimespec.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC
+
+/* Define to 1 if `st_atim.st__tim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC
+
+/* Define to 1 if `st_atim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
+
+/* Define to 1 if `st_birthtimensec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
+
+/* Define to 1 if `st_birthtimespec.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
+
+/* Define to 1 if `st_birthtim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC
+
/* Define to 1 if `tm_zone' is a member of `struct tm'. */
#undef HAVE_STRUCT_TM_TM_ZONE
-/* Define to 1 if `struct utimbuf' is declared by <utime.h>. */
+/* Define if struct utimbuf is declared -- usually in <utime.h>. Some systems
+ have utime.h but don't declare the struct anywhere. */
#undef HAVE_STRUCT_UTIMBUF
/* Define if struct stat has an st_dm_mode member. */
/* Define to 1 if you have the `sync' function. */
#undef HAVE_SYNC
-/* Define to 1 if you have the `sysinfo' function. */
-#undef HAVE_SYSINFO
-
/* Define to 1 if you have the <sys/bitypes.h> header file. */
#undef HAVE_SYS_BITYPES_H
/* Define to 1 if you have the <sys/loadavg.h> header file. */
#undef HAVE_SYS_LOADAVG_H
-/* Define to 1 if you have the <sys/mman.h> header file. */
-#undef HAVE_SYS_MMAN_H
-
/* Define to 1 if you have the <sys/param.h> header file. */
#undef HAVE_SYS_PARAM_H
/* Define to 1 if you have the <sys/systeminfo.h> header file. */
#undef HAVE_SYS_SYSTEMINFO_H
+/* Define to 1 if you have the <sys/timeb.h> header file. */
+#undef HAVE_SYS_TIMEB_H
+
/* Define to 1 if you have the <sys/time.h> header file. */
#undef HAVE_SYS_TIME_H
/* Define to 1 if you have <sys/wait.h> that is POSIX.1 compatible. */
#undef HAVE_SYS_WAIT_H
-/* Define to 1 if you have the <sys/_mbstate_t.h> header file. */
-#undef HAVE_SYS__MBSTATE_T_H
-
/* Define to 1 if you have the <term.h> header file. */
#undef HAVE_TERM_H
/* Define to 1 if you have the tiff library (-ltiff). */
#undef HAVE_TIFF
-/* Define to 1 if `struct timeval' is declared by <sys/time.h>. */
-#undef HAVE_TIMEVAL
+/* Define to 1 if you have the `timer_settime' function. */
+#undef HAVE_TIMER_SETTIME
/* Define if struct tm has the tm_gmtoff member. */
#undef HAVE_TM_GMTOFF
/* Define to 1 if you have the `tzset' function. */
#undef HAVE_TZSET
-/* Define to 1 if you have the `ualarm' function. */
-#undef HAVE_UALARM
-
/* Define to 1 if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H
-/* Define to 1 if the system has the type `unsigned long long int'. */
+/* Define to 1 if the system has the type 'unsigned long long int'. */
#undef HAVE_UNSIGNED_LONG_LONG_INT
/* Define to 1 if you have the <util.h> header file. */
#undef HAVE_UTIL_H
+/* Define to 1 if you have the `utimensat' function. */
+#undef HAVE_UTIMENSAT
+
/* Define to 1 if you have the `utimes' function. */
#undef HAVE_UTIMES
/* Define if you have a window system. */
#undef HAVE_WINDOW_SYSTEM
+/* Define to 1 if you have the <winsock2.h> header file. */
+#undef HAVE_WINSOCK2_H
+
/* Define to 1 if `fork' works. */
#undef HAVE_WORKING_FORK
+/* Define if utimes works properly. */
+#undef HAVE_WORKING_UTIMES
+
/* Define to 1 if `vfork' works. */
#undef HAVE_WORKING_VFORK
/* Define to 1 if you have the `XScreenResourceString' function. */
#undef HAVE_XSCREENRESOURCESTRING
-/* Define to 1 if you have the `XSetWMProtocols' function. */
-#undef HAVE_XSETWMPROTOCOLS
-
/* Define if you have usable i18n support. */
#undef HAVE_X_I18N
/* Define to 1 if the system has the type `_Bool'. */
#undef HAVE__BOOL
+/* Define to 1 if you have the `_ftime' function. */
+#undef HAVE__FTIME
+
+/* Define to 1 if _setjmp and _longjmp work. */
+#undef HAVE__SETJMP
+
/* Define to 1 if you have the `__builtin_unwind_init' function. */
#undef HAVE___BUILTIN_UNWIND_INIT
/* Define to support using a Hesiod database to find the POP server. */
#undef HESIOD
+/* 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. */
+#undef IS_ANY_SEP
+
+/* Returns true if character is a device separator. */
+#undef IS_DEVICE_SEP
+
+/* Returns true if character is a directory separator. */
+#undef IS_DIRECTORY_SEP
+
/* Define to support Kerberos-authenticated POP mail retrieval. */
#undef KERBEROS
/* Define to 1 if localtime caches TZ. */
#undef LOCALTIME_CACHE
-/* Define to 1 if `lstat' dereferences a symlink specified with a trailing
+/* Define to 1 if 'lstat' dereferences a symlink specified with a trailing
slash. */
#undef LSTAT_FOLLOWS_SLASHED_SYMLINK
/* Define to support POP mail retrieval. */
#undef MAIL_USE_POP
-/* Define to 1 if you don't have struct exception in math.h. */
-#undef NO_MATHERR
+/* Define if the system is MS DOS. */
+#undef MSDOS
+
+/* Define if system's imake configuration file defines `NeedWidePrototypes' as
+ `NO'. */
+#undef NARROWPROTO
+
+/* Define if XEditRes should not be used. */
+#undef NO_EDITRES
/* Define to 1 if your C compiler doesn't accept -c and -o together. */
#undef NO_MINUS_C_MINUS_O
+/* Minimum value of NSIG. */
+#undef NSIG_MINIMUM
+
/* Define to 1 if `NSInteger' is defined. */
#undef NS_HAVE_NSINTEGER
/* Define to 1 if you are using NS windowing under GNUstep. */
#undef NS_IMPL_GNUSTEP
+/* Name of the file to open to get a null file, or a data sink. */
+#undef NULL_DEVICE
+
/* Define to 1 if the nlist n_name member is a pointer */
#undef N_NAME_POINTER
/* Define to the version of this package. */
#undef PACKAGE_VERSION
-/* Define as `void' if your compiler accepts `void *'; otherwise define as
- `char'. */
-#undef POINTER_TYPE
+/* Number of chars of output in the buffer of a stdio stream. */
+#undef PENDING_OUTPUT_COUNT
+
+/* Define to empty to suppress deprecation warnings when building with
+ --enable-gcc-warnings and with libpng versions before 1.5, which lack
+ png_longjmp. */
+#undef PNG_DEPSTRUCT
-/* Define to 1 if the C compiler supports function prototypes. */
-#undef PROTOTYPES
+/* Define if process_send_signal should use VSUSP instead of VSWTCH. */
+#undef PREFER_VSUSP
/* Define to 1 if pthread_sigmask(), when it fails, returns -1 and sets errno.
*/
'ptrdiff_t'. */
#undef PTRDIFF_T_SUFFIX
+/* How to iterate over PTYs. */
+#undef PTY_ITERATION
+
+/* How to get the device name of the control end of a PTY, if non-standard. */
+#undef PTY_NAME_SPRINTF
+
+/* How to open a PTY, if non-standard. */
+#undef PTY_OPEN
+
+/* How to get device name of the tty end of a PTY, if non-standard. */
+#undef PTY_TTY_NAME_SPRINTF
+
/* Define to 1 if readlink fails to recognize a trailing slash. */
#undef READLINK_TRAILING_SLASH_BUG
slash */
#undef REPLACE_FUNC_STAT_FILE
+/* Define if emacs.c needs to call run_time_remap; for HPUX. */
+#undef RUN_TIME_REMAP
+
+/* Character that separates PATH elements. */
+#undef SEPCHAR
+
+/* Define if process.c:child_setup should not call setpgrp. */
+#undef SETPGRP_RELEASES_CTTY
+
+/* How to set up a slave PTY, if needed. */
+#undef SETUP_SLAVE_PTY
+
+/* Make process_send_signal work by "typing" a signal character on the pty. */
+#undef SIGNALS_VIA_CHARACTERS
+
/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
'sig_atomic_t'. */
#undef SIG_ATOMIC_T_SUFFIX
'size_t'. */
#undef SIZE_T_SUFFIX
+/* Define if the system is Solaris. */
+#undef SOLARIS2
+
/* If using the C implementation of alloca, define if you know the
direction of stack growth for your system; otherwise it will be
automatically deduced at runtime.
/* Define to 1 on System V Release 4. */
#undef SVR4
-/* Process async input synchronously. */
-#undef SYNC_INPUT
-
/* Define to use system malloc. */
#undef SYSTEM_MALLOC
+/* The type of system you are compiling for; sets `system-type'. */
+#undef SYSTEM_TYPE
+
+/* Undocumented. */
+#undef TAB3
+
+/* Undocumented. */
+#undef TABDLY
+
/* Define to 1 if you use terminfo instead of termcap. */
#undef TERMINFO
+/* Define to the header for the built-in window system. */
+#undef TERM_HEADER
+
/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
#undef TIME_WITH_SYS_TIME
+/* Some platforms redefine this. */
+#undef TIOCSIGSEND
+
/* Define to 1 if your <sys/time.h> declares `struct tm'. */
#undef TM_IN_SYS_TIME
+/* Define to 1 if the type of the st_atim member of a struct stat is struct
+ timespec. */
+#undef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC
+
+/* Undocumented. */
+#undef ULIMIT_BREAK_VALUE
+
/* Define to 1 for Encore UMAX. */
#undef UMAX
<sys/cpustats.h>. */
#undef UMAX4_3
+/* Define if the system has Unix98 PTYs. */
+#undef UNIX98_PTYS
+
+/* Define to 1 if FIONREAD is usable. */
+#undef USABLE_FIONREAD
+
+/* Define to 1 if SIGIO is usable. */
+#undef USABLE_SIGIO
+
+/* How to get a user's full name. */
+#undef USER_FULL_NAME
+
/* Define to 1 if using GTK. */
#undef USE_GTK
-/* Define this to use a lisp union for the Lisp_Object data type. */
-#undef USE_LISP_UNION_TYPE
-
/* Define to 1 if using the Lucid X toolkit. */
#undef USE_LUCID
/* Define to 1 if using an X toolkit. */
#undef USE_X_TOOLKIT
+/* Define if the system is compatible with System III. */
+#undef USG
+
+/* Define if the system is compatible with System V. */
+#undef USG5
+
+/* Define if the system is compatible with System V Release 4. */
+#undef USG5_4
+
+/* Define for USG systems where it works to open a pty's tty in the parent
+ process, then close and reopen it in the child. */
+#undef USG_SUBTTY_WORKS
+
/* Version number of package */
#undef VERSION
/* Define this to check for malloc buffer overrun. */
#undef XMALLOC_OVERRUN_CHECK
+/* Compensate for a bug in Xos.h on some systems, where it requires time.h. */
+#undef XOS_NEEDS_TIME_H
+
/* Define to the type of the 6th arg of XRegisterIMInstantiateCallback, either
XPointer or XPointer*. */
#undef XRegisterIMInstantiateCallback_arg6
+/* Define if the system is AIX. */
+#undef _AIX
+
/* Enable large inode numbers on Mac OS X. */
#ifndef _DARWIN_USE_64_BIT_INODE
# define _DARWIN_USE_64_BIT_INODE 1
/* Number of bits in a file offset, on hosts where this is settable. */
#undef _FILE_OFFSET_BITS
+/* Define to 1 if Gnulib overrides 'struct stat' on Windows so that struct
+ stat.st_size becomes 64-bit. */
+#undef _GL_WINDOWS_64_BIT_ST_SIZE
+
/* Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2). */
#undef _LARGEFILE_SOURCE
/* Define if GNUstep uses ObjC exceptions. */
#undef _NATIVE_OBJC_EXCEPTIONS
-/* The _Noreturn keyword of draft C1X. */
-#ifndef _Noreturn
+/* The _Noreturn keyword of C11. */
+#if ! (defined _Noreturn \
+ || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__))
# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__) \
|| 0x5110 <= __SUNPRO_C)
# define _Noreturn __attribute__ ((__noreturn__))
-# elif 1200 <= _MSC_VER
+# elif defined _MSC_VER && 1200 <= _MSC_VER
# define _Noreturn __declspec (noreturn)
# else
# define _Noreturn
this defined. */
#undef _POSIX_1_SOURCE
-/* Define to 1 if you need to in order for `stat' and other things to work. */
+/* Define to 1 if you need to in order for 'stat' and other things to work. */
#undef _POSIX_SOURCE
+/* Needed for system_process_attributes on Solaris. */
+#undef _STRUCTURED_PROC
+
/* Define to 500 only on HP-UX. */
#undef _XOPEN_SOURCE
#ifndef _ALL_SOURCE
# undef _ALL_SOURCE
#endif
-/* Enable general extensions on MacOS X. */
+/* Enable general extensions on Mac OS X. */
#ifndef _DARWIN_C_SOURCE
# undef _DARWIN_C_SOURCE
#endif
used. */
#undef __GETOPT_PREFIX
-/* Define like PROTOTYPES; this can be used by system headers. */
-#undef __PROTOTYPES
-
-/* Ensure that <stdint.h> defines the limit macros, since gnulib's
- <inttypes.h> relies on them. */
-#if defined __cplusplus && !defined __STDC_LIMIT_MACROS && GL_TRIGGER_STDC_LIMIT_MACROS
-# define __STDC_LIMIT_MACROS 1
-#endif
-
-
/* Define to compiler's equivalent of C99 restrict keyword in array
declarations. Define as empty for no equivalent. */
#undef __restrict_arr
-/* Define to the used machine dependent file. */
-#undef config_machfile
-
-/* Define to the used os dependent file. */
+/* Some platforms that do not use configure define this to include extra
+ configuration information. */
#undef config_opsysfile
-/* Define to empty if `const' does not conform to ANSI C. */
-#undef const
+/* _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
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>.
+ _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
+#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
+# if __GNUC_GNU_INLINE__
+ /* __gnu_inline__ suppresses a GCC 4.2 diagnostic. */
+# define _GL_INLINE extern inline __attribute__ ((__gnu_inline__))
+# else
+# define _GL_INLINE extern inline
+# endif
+# define _GL_EXTERN_INLINE extern
+#else
+# define _GL_INLINE static inline
+# define _GL_EXTERN_INLINE static inline
+#endif
+
+#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+# if __GNUC_STDC_INLINE__
+# define _GL_INLINE_HEADER_CONST_PRAGMA
+# else
+# define _GL_INLINE_HEADER_CONST_PRAGMA \
+ _Pragma ("GCC diagnostic ignored \"-Wsuggest-attribute=const\"")
+# endif
+# define _GL_INLINE_HEADER_BEGIN \
+ _Pragma ("GCC diagnostic push") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") \
+ _GL_INLINE_HEADER_CONST_PRAGMA
+# define _GL_INLINE_HEADER_END \
+ _Pragma ("GCC diagnostic pop")
+#else
+# 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))
+/* Define to rpl_gmtime if the replacement function should be used. */
+#undef gmtime
+
/* Define to `__inline__' or `__inline' if that's what the C compiler
calls it, or to nothing if 'inline' is not supported under any name. */
#ifndef __cplusplus
/* Work around a bug in Apple GCC 4.0.1 build 5465: In C99 mode, it supports
the ISO C 99 semantics of 'extern inline' (unlike the GNU C semantics of
earlier versions), but does not display it by setting __GNUC_STDC_INLINE__.
- __APPLE__ && __MACH__ test for MacOS X.
+ __APPLE__ && __MACH__ test for Mac OS X.
__APPLE_CC__ tests for the Apple compiler and its version.
__STDC_VERSION__ tests for the C99 mode. */
#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__
# define __GNUC_STDC_INLINE__ 1
#endif
+/* Define to 1 if the compiler is checking for lint. */
+#undef lint
+
+/* Define to rpl_localtime if the replacement function should be used. */
+#undef localtime
+
/* Define to a type if <wchar.h> does not define. */
#undef mbstate_t
/* Define as a signed type of the same size as size_t. */
#undef ssize_t
+/* Define to enable asynchronous subprocesses. */
+#undef subprocesses
+
/* Define to any substitute for sys_siglist. */
#undef sys_siglist
/* Define as `fork' if `vfork' does not work. */
#undef vfork
-/* Define to empty if the keyword `volatile' does not work. Warning: valid
- code using `volatile' can become incorrect without. Disable with care. */
-#undef volatile
-
-
-/* On AIX 3 this must be included before any other include file. */
-#include <alloca.h>
-#if ! HAVE_ALLOCA
-# error "alloca not available on this machine"
-#endif
-
-/* Define AMPERSAND_FULL_NAME if you use the convention
- that & in the full name stands for the login id. */
-/* Turned on June 1996 supposing nobody will mind it. */
-#define AMPERSAND_FULL_NAME
-
-/* `subprocesses' should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- Only MSDOS does not support this (it overrides
- this in its config_opsysfile below). */
-
-#define subprocesses
-
-/* Include the os and machine dependent files. */
-#include config_opsysfile
-#ifdef config_machfile
-# include config_machfile
-#endif
-
-/* GNUstep needs a bit more pure memory. Of the existing knobs,
- SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems.
- (There is probably a better place to do this, but right now the
- Cocoa side does this in s/darwin.h and we cannot parallel this
- exactly since GNUstep is multi-OS. */
-#if defined HAVE_NS && defined NS_IMPL_GNUSTEP
-# define SYSTEM_PURESIZE_EXTRA 30000
-#endif
-
-#ifdef emacs /* Don't do this for lib-src. */
-/* Tell regex.c to use a type compatible with Emacs. */
-#define RE_TRANSLATE_TYPE Lisp_Object
-#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C)
-#ifdef make_number
-/* If make_number is a macro, use it. */
-#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0)))
-#else
-/* If make_number is a function, avoid it. */
-#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0))
-#endif
-#endif
-
-/* These default definitions are good for almost all machines.
- Any exceptions should override them in m/MACHINE.h.
- They must be usable in preprocessor conditionals. */
-
-#ifndef BITS_PER_CHAR
-#define BITS_PER_CHAR 8
-#endif
-
-#ifndef BITS_PER_SHORT
-#define BITS_PER_SHORT 16
-#endif
-
-#ifndef BITS_PER_INT
-#define BITS_PER_INT 32
-#endif
-
-#ifndef BITS_PER_LONG
-#ifdef _LP64
-#define BITS_PER_LONG 64
-#else
-#define BITS_PER_LONG 32
-#endif
-#endif
-
-#if !defined BITS_PER_LONG_LONG && HAVE_LONG_LONG_INT
-#define BITS_PER_LONG_LONG 64
-#endif
-
-/* Define if the compiler supports function prototypes. It may do so but
- not define __STDC__ (e.g. DEC C by default) or may define it as zero. */
-#undef PROTOTYPES
-
-#include <string.h>
-#include <stdlib.h>
-
-#if defined __GNUC__ && (__GNUC__ > 2 \
- || (__GNUC__ == 2 && __GNUC_MINOR__ >= 5))
-#define NO_RETURN __attribute__ ((__noreturn__))
-#else
-#define NO_RETURN /* nothing */
-#endif
-
-#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
-#define NO_INLINE __attribute__((noinline))
-#else
-#define NO_INLINE
-#endif
-
-#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1))
-#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
-#else
-#define EXTERNALLY_VISIBLE
-#endif
-
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define ATTRIBUTE_FORMAT(spec) /* empty */
-#endif
-
-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
-#else
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
-#endif
-
-/* Some versions of GNU/Linux define noinline in their headers. */
-#ifdef noinline
-#undef noinline
-#endif
-
-/* These won't be used automatically yet. We also need to know, at least,
- that the stack is continuous. */
-#ifdef __GNUC__
-# ifndef GC_SETJMP_WORKS
- /* GC_SETJMP_WORKS is nearly always appropriate for GCC. */
-# define GC_SETJMP_WORKS 1
-# endif
-#endif
+#include <conf_post.h>
#endif /* EMACS_CONFIG_H */
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.65 for emacs 24.2.
+# Generated by GNU Autoconf 2.65 for emacs 24.2.50.
#
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# Identity of this package.
PACKAGE_NAME='emacs'
PACKAGE_TARNAME='emacs'
-PACKAGE_VERSION='24.2'
-PACKAGE_STRING='emacs 24.2'
+PACKAGE_VERSION='24.2.50'
+PACKAGE_STRING='emacs 24.2.50'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
LTLIBOBJS
LIBOBJS
SUBDIR_MAKEFILES_IN
+WINDOW_SYSTEM_OBJ
LIB_GCC
LD_FIRSTFLAG
LD_SWITCH_SYSTEM_TEMACS
gl_GNULIB_ENABLED_strtoll_TRUE
gl_GNULIB_ENABLED_stat_FALSE
gl_GNULIB_ENABLED_stat_TRUE
-gl_GNULIB_ENABLED_sigprocmask_FALSE
-gl_GNULIB_ENABLED_sigprocmask_TRUE
gl_GNULIB_ENABLED_pathmax_FALSE
gl_GNULIB_ENABLED_pathmax_TRUE
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE
gl_GNULIB_ENABLED_dosname_TRUE
LTLIBINTL
LIBINTL
+WINDOWS_64_BIT_OFF_T
HAVE_UNISTD_H
NEXT_AS_FIRST_DIRECTIVE_UNISTD_H
NEXT_UNISTD_H
+LIB_TIMER_TIME
PTHREAD_H_DEFINES_STRUCT_TIMESPEC
SYS_TIME_H_DEFINES_STRUCT_TIMESPEC
TIME_H_DEFINES_STRUCT_TIMESPEC
NEXT_AS_FIRST_DIRECTIVE_TIME_H
NEXT_TIME_H
+WINDOWS_64_BIT_ST_SIZE
NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H
NEXT_SYS_STAT_H
NEXT_AS_FIRST_DIRECTIVE_STDLIB_H
STDARG_H
NEXT_AS_FIRST_DIRECTIVE_STDARG_H
NEXT_STDARG_H
+GL_GENERATE_STDALIGN_H_FALSE
+GL_GENERATE_STDALIGN_H_TRUE
+STDALIGN_H
NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H
NEXT_SIGNAL_H
+LIB_PTHREAD_SIGMASK
REPLACE_RAISE
REPLACE_PTHREAD_SIGMASK
HAVE_SIGHANDLER_T
GNULIB_SIGNAL_H_SIGPIPE
GNULIB_RAISE
GNULIB_PTHREAD_SIGMASK
-LIB_PTHREAD_SIGMASK
+HAVE_SYS_SELECT_H
+NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H
+NEXT_SYS_SELECT_H
+REPLACE_SELECT
+REPLACE_PSELECT
+HAVE_PSELECT
+GNULIB_SELECT
+GNULIB_PSELECT
REPLACE_TIMEGM
REPLACE_NANOSLEEP
REPLACE_MKTIME
PRI_MACROS_BROKEN
INT64_MAX_EQ_LONG_MAX
INT32_MAX_LT_INTMAX_MAX
+REPLACE_STRTOIMAX
HAVE_DECL_STRTOUMAX
HAVE_DECL_STRTOIMAX
HAVE_DECL_IMAXDIV
HAVE_WCHAR_H
HAVE_UNSIGNED_LONG_LONG_INT
HAVE_LONG_LONG_INT
+HAVE_WINSOCK2_H
+NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H
+NEXT_SYS_TIME_H
+REPLACE_STRUCT_TIMEVAL
+REPLACE_GETTIMEOFDAY
+HAVE_SYS_TIME_H
+HAVE_STRUCT_TIMEVAL
+HAVE_GETTIMEOFDAY
+GNULIB_GETTIMEOFDAY
+GNULIB_GL_UNISTD_H_GETOPT
GETOPT_H
HAVE_GETOPT_H
NEXT_AS_FIRST_DIRECTIVE_GETOPT_H
REPLACE_SETENV
REPLACE_REALPATH
REPLACE_REALLOC
+REPLACE_RANDOM_R
REPLACE_PUTENV
+REPLACE_PTSNAME_R
REPLACE_MKSTEMP
REPLACE_MBTOWC
REPLACE_MALLOC
HAVE_REALPATH
HAVE_RANDOM_R
HAVE_RANDOM_H
+HAVE_RANDOM
+HAVE_PTSNAME_R
HAVE_PTSNAME
+HAVE_POSIX_OPENPT
HAVE_MKSTEMPS
HAVE_MKSTEMP
HAVE_MKOSTEMPS
GNULIB_REALPATH
GNULIB_REALLOC_POSIX
GNULIB_RANDOM_R
+GNULIB_RANDOM
GNULIB_PUTENV
+GNULIB_PTSNAME_R
GNULIB_PTSNAME
+GNULIB_POSIX_OPENPT
GNULIB_MKSTEMPS
GNULIB_MKSTEMP
GNULIB_MKOSTEMPS
GNULIB_CALLOC_POSIX
GNULIB_ATOLL
GNULIB__EXIT
+GL_GENERATE_EXECINFO_H_FALSE
+GL_GENERATE_EXECINFO_H_TRUE
+LIB_EXECINFO
+EXECINFO_H
UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS
UNISTD_H_HAVE_WINSOCK2_H
REPLACE_WRITE
REPLACE_LINKAT
REPLACE_LINK
REPLACE_LCHOWN
+REPLACE_ISATTY
REPLACE_GETPAGESIZE
REPLACE_GETGROUPS
REPLACE_GETLOGIN_R
REPLACE_GETDOMAINNAME
REPLACE_GETCWD
+REPLACE_FTRUNCATE
REPLACE_FCHOWNAT
REPLACE_DUP2
REPLACE_DUP
HAVE_SYS_PARAM_H
HAVE_OS_H
HAVE_DECL_TTYNAME_R
+HAVE_DECL_SETHOSTNAME
HAVE_DECL_GETUSERSHELL
HAVE_DECL_GETPAGESIZE
HAVE_DECL_GETLOGIN_R
HAVE_SYMLINKAT
HAVE_SYMLINK
HAVE_SLEEP
+HAVE_SETHOSTNAME
HAVE_READLINKAT
HAVE_READLINK
HAVE_PWRITE
GNULIB_UNLINK
GNULIB_UNISTD_H_SIGPIPE
GNULIB_UNISTD_H_NONBLOCKING
-GNULIB_UNISTD_H_GETOPT
GNULIB_TTYNAME_R
GNULIB_SYMLINKAT
GNULIB_SYMLINK
GNULIB_SLEEP
+GNULIB_SETHOSTNAME
GNULIB_RMDIR
GNULIB_READLINKAT
GNULIB_READLINK
GNULIB_LINKAT
GNULIB_LINK
GNULIB_LCHOWN
+GNULIB_ISATTY
GNULIB_GROUP_MEMBER
GNULIB_GETUSERSHELL
GNULIB_GETPAGESIZE
GNULIB_CLOSE
GNULIB_CHOWN
GNULIB_CHDIR
+LIB_CLOCK_GETTIME
GL_GENERATE_ALLOCA_H_FALSE
GL_GENERATE_ALLOCA_H_TRUE
ALLOCA_H
ns_appresdir
ns_appbindir
ns_appdir
-S_FILE
-M_FILE
X_TOOLKIT_TYPE
-C_SWITCH_X_SYSTEM
+GNUSTEP_CFLAGS
C_SWITCH_X_SITE
LD_SWITCH_X_SITE
gameuser
x_default_search_path
lisppath
locallisppath
+standardlisppath
+leimdir
lispdir
srcdir
canonical
configuration
version
+copyright
KRB4LIB
DESLIB
KRB5LIB
LIBSELINUX_LIBS
SETTINGS_LIBS
SETTINGS_CFLAGS
+GOBJECT_LIBS
+GOBJECT_CFLAGS
GCONF_LIBS
GCONF_CFLAGS
GSETTINGS_LIBS
LIB_STANDARD
NS_OBJC_OBJ
NS_OBJ
+ns_self_contained
+INSTALL_ARCH_INDEP_EXTRA
TEMACS_LDFLAGS2
-LD_SWITCH_X_SITE_AUX_RPATH
-LD_SWITCH_X_SITE_AUX
+LD_SWITCH_X_SITE_RPATH
XMKMF
DEPFLAGS
MKDEPDIR
CFLAGS_SOUND
ALSA_LIBS
ALSA_CFLAGS
-PKG_CONFIG
LIBSOUND
+PKG_CONFIG
CRT_DIR
START_FILES
LIB_MATH
C_SWITCH_MACHINE
LD_SWITCH_SYSTEM
CANNOT_DUMP
+INFO_OPTS
+INFO_EXT
HAVE_MAKEINFO
+PAXCTL
GZIP_PROG
INSTALL_INFO
-C_WARNINGS_SWITCH
+LN_S
+GNULIB_WARN_CFLAGS
+WARN_CFLAGS
+WERROR_CFLAGS
RANLIB
ARFLAGS
AR
build_cpu
build
PROFILING_CFLAGS
-MAINT
GZIP_INFO
cache_file
am__untar
PATH_SEPARATOR
SHELL'
ac_subst_files='deps_frag
-lisp_frag
-ns_frag'
+lisp_frag'
ac_user_opts='
enable_option_checking
+with_all
with_pop
with_kerberos
with_kerberos5
with_mail_unlink
with_mailhost
with_sound
-with_sync_input
with_x_toolkit
with_wide_int
with_xpm
with_gameuser
with_gnustep_conf
enable_ns_self_contained
-enable_asserts
-enable_maintainer_mode
enable_locallisppath
enable_checking
-enable_use_lisp_union_type
+enable_check_lisp_object_type
enable_profiling
enable_autodepend
enable_dependency_tracking
enable_largefile
+enable_gcc_warnings
+enable_link_time_optimization
with_x
'
ac_precious_vars='build_alias
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures emacs 24.2 to adapt to many kinds of systems.
+\`configure' configures emacs 24.2.50 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of emacs 24.2:";;
+ short | recursive ) echo "Configuration of emacs 24.2.50:";;
esac
cat <<\_ACEOF
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--disable-ns-self-contained
disable self contained build under NeXTstep
- --enable-asserts compile code with asserts enabled
- --disable-maintainer-mode
- disable make rules and dependencies not useful (and
- sometimes confusing) to the casual installer
--enable-locallisppath=PATH
directories Emacs should search for lisp files
specific to this site
enable expensive run-time checks. With LIST, enable
only specific categories of checks. Categories are:
all,yes,no. Flags are: stringbytes, stringoverrun,
- stringfreelist, xmallocoverrun, conslist
- --enable-use-lisp-union-type
- use a union for the Lisp_Object data type. This is
- only useful for development for catching certain
- types of bugs.
+ stringfreelist, xmallocoverrun, conslist, glyphs
+ --enable-check-lisp-object-type
+ enable compile time checks for the Lisp_Object data
+ type. This is useful for development for catching
+ certain types of bugs.
--enable-profiling build emacs with profiling support. This might not
work on all platforms
--enable-autodepend automatically generate dependencies to .h-files.
--disable-dependency-tracking speeds up one-time build
--enable-dependency-tracking do not reject slow dependency extractors
--disable-largefile omit support for large files
+ --enable-gcc-warnings turn on lots of GCC warnings. This is intended for
+ developers, and may generate false alarms when used
+ with older or non-GNU development tools.
+ --enable-link-time-optimization
+ build emacs with link-time optimization. This is
+ supported only for GCC since 4.5.0.
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
--with-mailhost=HOSTNAME
string giving default POP mail host
--without-sound don't compile with sound support
- --without-sync-input process async input synchronously
- --with-x-toolkit=KIT use an X toolkit (KIT one of: yes or gtk, gtk3,
- lucid or athena, motif, no)
+ --with-x-toolkit=KIT use an X toolkit (KIT one of: yes or gtk, gtk2,
+ gtk3, lucid or athena, motif, no)
--with-wide-int prefer wide Emacs integers (typically 62-bit)
--without-xpm don't compile with XPM image support
--without-jpeg don't compile with JPEG image support
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-emacs configure 24.2
+emacs configure 24.2.50
generated by GNU Autoconf 2.65
Copyright (C) 2009 Free Software Foundation, Inc.
} # ac_fn_c_check_header_preproc
+# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
+# ----------------------------------------------------
+# Tries to find if the field MEMBER exists in type AGGR, after including
+# INCLUDES, setting cache variable VAR accordingly.
+ac_fn_c_check_member ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5
+$as_echo_n "checking for $2.$3... " >&6; }
+if { as_var=$4; eval "test \"\${$as_var+set}\" = set"; }; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (ac_aggr.$3)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$4=yes"
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (sizeof ac_aggr.$3)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$4=yes"
+else
+ eval "$4=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$4
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+
+} # ac_fn_c_check_member
+
# ac_fn_c_check_func LINENO FUNC VAR
# ----------------------------------
# Tests whether FUNC exists, setting the cache variable VAR accordingly
} # ac_fn_c_check_func
-# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
-# ----------------------------------------------------
-# Tries to find if the field MEMBER exists in type AGGR, after including
-# INCLUDES, setting cache variable VAR accordingly.
-ac_fn_c_check_member ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5
-$as_echo_n "checking for $2.$3... " >&6; }
-if { as_var=$4; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$5
-int
-main ()
-{
-static $2 ac_aggr;
-if (ac_aggr.$3)
-return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- eval "$4=yes"
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$5
-int
-main ()
-{
-static $2 ac_aggr;
-if (sizeof ac_aggr.$3)
-return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- eval "$4=yes"
-else
- eval "$4=no"
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-eval ac_res=\$$4
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
-
-} # ac_fn_c_check_member
-
# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by emacs $as_me 24.2, which was
+It was created by emacs $as_me 24.2.50, which was
generated by GNU Autoconf 2.65. Invocation command line was
$ $0 $@
>$cache_file
fi
+as_fn_append ac_header_list " linux/version.h"
+as_fn_append ac_header_list " sys/systeminfo.h"
+as_fn_append ac_header_list " stdio_ext.h"
+as_fn_append ac_header_list " fcntl.h"
+as_fn_append ac_header_list " coff.h"
+as_fn_append ac_header_list " pty.h"
+as_fn_append ac_header_list " sys/vlimit.h"
+as_fn_append ac_header_list " sys/resource.h"
+as_fn_append ac_header_list " sys/utsname.h"
+as_fn_append ac_header_list " pwd.h"
+as_fn_append ac_header_list " utmp.h"
+as_fn_append ac_header_list " dirent.h"
+as_fn_append ac_header_list " util.h"
+as_fn_append ac_header_list " sys/socket.h"
as_fn_append ac_header_list " stdlib.h"
as_fn_append ac_header_list " unistd.h"
as_fn_append ac_header_list " sys/param.h"
+as_fn_append ac_header_list " pthread.h"
+as_fn_append ac_header_list " malloc/malloc.h"
+as_fn_append ac_header_list " maillock.h"
+as_fn_append ac_header_list " sys/un.h"
+as_fn_append ac_func_list " tzset"
as_fn_append ac_func_list " readlinkat"
+as_fn_append ac_header_list " execinfo.h"
gl_getopt_required=GNU
as_fn_append ac_header_list " getopt.h"
+as_fn_append ac_func_list " gettimeofday"
+as_fn_append ac_func_list " nanotime"
+as_fn_append ac_header_list " sys/time.h"
as_fn_append ac_header_list " wchar.h"
as_fn_append ac_header_list " stdint.h"
as_fn_append ac_header_list " inttypes.h"
as_fn_append ac_func_list " lstat"
as_fn_append ac_func_list " alarm"
+as_fn_append ac_header_list " sys/select.h"
+as_fn_append ac_func_list " pselect"
as_fn_append ac_func_list " pthread_sigmask"
as_fn_append ac_func_list " readlink"
-as_fn_append ac_header_list " sys/socket.h"
-as_fn_append ac_func_list " tzset"
as_fn_append ac_func_list " strtoimax"
as_fn_append ac_func_list " strtoumax"
as_fn_append ac_func_list " symlink"
as_fn_append ac_header_list " sys/stat.h"
-as_fn_append ac_header_list " sys/time.h"
as_fn_append ac_func_list " localtime_r"
+as_fn_append ac_header_list " utime.h"
+as_fn_append ac_func_list " futimes"
+as_fn_append ac_func_list " futimesat"
+as_fn_append ac_func_list " futimens"
+as_fn_append ac_func_list " utimensat"
+as_fn_append ac_func_list " lutimes"
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
# Define the identity of the package.
PACKAGE='emacs'
- VERSION='24.2'
+ VERSION='24.2.50'
cat >>confdefs.h <<_ACEOF
lispdir='${datadir}/emacs/${version}/lisp'
+leimdir='${datadir}/emacs/${version}/leim'
+standardlisppath='${lispdir}:${leimdir}'
locallisppath='${datadir}/emacs/${version}/site-lisp:'\
'${datadir}/emacs/site-lisp'
-lisppath='${locallisppath}:${lispdir}:${datadir}/emacs/${version}/leim'
+lisppath='${locallisppath}:${standardlisppath}'
etcdir='${datadir}/emacs/${version}/etc'
archlibdir='${libexecdir}/emacs/${version}/${configuration}'
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
if test "${with_sound+set}" = set; then :
withval=$with_sound;
else
- with_sound=yes
-fi
-
-
-
-# Check whether --with-sync-input was given.
-if test "${with_sync_input+set}" = set; then :
- withval=$with_sync_input;
-else
- with_sync_input=yes
+ with_sound=$with_features
fi
-if test "$with_sync_input" = yes; then
-
-$as_echo "#define SYNC_INPUT 1" >>confdefs.h
-
-fi
# Check whether --with-x-toolkit was given.
a | at | ath | athe | athen | athena ) val=athena ;;
m | mo | mot | moti | motif ) val=motif ;;
g | gt | gtk ) val=gtk ;;
+ gtk2 ) val=gtk2 ;;
gtk3 ) val=gtk3 ;;
* )
as_fn_error "\`--with-x-toolkit=$withval' is invalid;
-this option's value should be \`yes', \`no', \`lucid', \`athena', \`motif', \`gtk' or
-\`gtk3'. \`yes' and \`gtk' are synonyms. \`athena' and \`lucid' are synonyms." "$LINENO" 5
+this option's value should be \`yes', \`no', \`lucid', \`athena', \`motif', \`gtk',
+\`gtk2' or \`gtk3'. \`yes' and \`gtk' are synonyms.
+\`athena' and \`lucid' are synonyms." "$LINENO" 5
;;
esac
with_x_toolkit=$val
if test "${with_xpm+set}" = set; then :
withval=$with_xpm;
else
- with_xpm=yes
+ with_xpm=$with_features
fi
if test "${with_jpeg+set}" = set; then :
withval=$with_jpeg;
else
- with_jpeg=yes
+ with_jpeg=$with_features
fi
if test "${with_tiff+set}" = set; then :
withval=$with_tiff;
else
- with_tiff=yes
+ with_tiff=$with_features
fi
if test "${with_gif+set}" = set; then :
withval=$with_gif;
else
- with_gif=yes
+ with_gif=$with_features
fi
if test "${with_png+set}" = set; then :
withval=$with_png;
else
- with_png=yes
+ with_png=$with_features
fi
if test "${with_rsvg+set}" = set; then :
withval=$with_rsvg;
else
- with_rsvg=yes
+ with_rsvg=$with_features
fi
if test "${with_xml2+set}" = set; then :
withval=$with_xml2;
else
- with_xml2=yes
+ with_xml2=$with_features
fi
if test "${with_imagemagick+set}" = set; then :
withval=$with_imagemagick;
else
- with_imagemagick=yes
+ with_imagemagick=$with_features
fi
if test "${with_xft+set}" = set; then :
withval=$with_xft;
else
- with_xft=yes
+ with_xft=$with_features
fi
if test "${with_libotf+set}" = set; then :
withval=$with_libotf;
else
- with_libotf=yes
+ with_libotf=$with_features
fi
if test "${with_m17n_flt+set}" = set; then :
withval=$with_m17n_flt;
else
- with_m17n_flt=yes
+ with_m17n_flt=$with_features
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
if test "${with_xaw3d+set}" = set; then :
withval=$with_xaw3d;
else
- with_xaw3d=yes
+ with_xaw3d=$with_features
fi
if test "${with_xim+set}" = set; then :
withval=$with_xim;
else
- with_xim=yes
+ with_xim=$with_features
fi
if test "${with_gpm+set}" = set; then :
withval=$with_gpm;
else
- with_gpm=yes
+ with_gpm=$with_features
fi
if test "${with_dbus+set}" = set; then :
withval=$with_dbus;
else
- with_dbus=yes
+ with_dbus=$with_features
fi
if test "${with_gconf+set}" = set; then :
withval=$with_gconf;
else
- with_gconf=yes
+ with_gconf=$with_features
fi
if test "${with_gsettings+set}" = set; then :
withval=$with_gsettings;
else
- with_gsettings=yes
+ with_gsettings=$with_features
fi
if test "${with_selinux+set}" = set; then :
withval=$with_selinux;
else
- with_selinux=yes
+ with_selinux=$with_features
fi
if test "${with_gnutls+set}" = set; then :
withval=$with_gnutls;
else
- with_gnutls=yes
+ with_gnutls=$with_features
fi
if test "${with_makeinfo+set}" = set; then :
withval=$with_makeinfo;
else
- with_makeinfo=yes
+ with_makeinfo=$with_features
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
fi
-# Check whether --enable-asserts was given.
-if test "${enable_asserts+set}" = set; then :
- enableval=$enable_asserts; USE_XASSERTS=$enableval
-else
- USE_XASSERTS=no
-fi
-
-
-# Check whether --enable-maintainer-mode was given.
-if test "${enable_maintainer_mode+set}" = set; then :
- enableval=$enable_maintainer_mode; USE_MAINTAINER_MODE=$enableval
-else
- USE_MAINTAINER_MODE=yes
-fi
-
-if test $USE_MAINTAINER_MODE = yes; then
- MAINT=
-else
- MAINT=#
-fi
-
-
# Check whether --enable-locallisppath was given.
if test "${enable_locallisppath+set}" = set; then :
enableval=$enable_locallisppath; if test "${enableval}" = "no"; then
ac_gc_check_string_overrun= ;
ac_gc_check_string_free_list= ;
ac_xmalloc_overrun= ;
- ac_gc_check_cons_list= ;;
+ ac_gc_check_cons_list= ;
+ ac_glyphs_debug= ;;
all) ac_enable_checking=1 ;
ac_gc_check_stringbytes=1 ;
ac_gc_check_string_overrun=1 ;
ac_gc_check_string_free_list=1 ;
ac_xmalloc_overrun=1 ;
- ac_gc_check_cons_list=1 ;;
+ ac_gc_check_cons_list=1 ;
+ ac_glyphs_debug=1 ;;
# these enable particular checks
stringbytes) ac_gc_check_stringbytes=1 ;;
stringoverrun) ac_gc_check_string_overrun=1 ;;
stringfreelist) ac_gc_check_string_free_list=1 ;;
xmallocoverrun) ac_xmalloc_overrun=1 ;;
conslist) ac_gc_check_cons_list=1 ;;
+ glyphs) ac_glyphs_debug=1 ;;
*) as_fn_error "unknown check category $check" "$LINENO" 5 ;;
esac
done
$as_echo "#define GC_CHECK_CONS_LIST 1" >>confdefs.h
fi
+if test x$ac_glyphs_debug != x ; then
-# Check whether --enable-use-lisp-union-type was given.
-if test "${enable_use_lisp_union_type+set}" = set; then :
- enableval=$enable_use_lisp_union_type; if test "${enableval}" != "no"; then
+$as_echo "#define GLYPH_DEBUG 1" >>confdefs.h
-$as_echo "#define USE_LISP_UNION_TYPE 1" >>confdefs.h
+fi
+
+# Check whether --enable-check-lisp-object-type was given.
+if test "${enable_check_lisp_object_type+set}" = set; then :
+ enableval=$enable_check_lisp_object_type; if test "${enableval}" != "no"; then
+
+$as_echo "#define CHECK_LISP_OBJECT_TYPE 1" >>confdefs.h
fi
fi
* ) srcdir="`(cd ${srcdir}; pwd)`" ;;
esac
-#### Given the configuration name, set machfile and opsysfile to the
-#### names of the m/*.h and s/*.h files we should use.
-
### Canonicalize the configuration name.
# Make sure we can run config.sub.
### If you add support for a new configuration, add code to this
### switch statement to recognize your configuration name and select
-### the appropriate operating system and machine description files.
+### the appropriate operating system file.
-### You would hope that you could choose an m/*.h file pretty much
-### based on the machine portion of the configuration name, and an s/*.h
+### You would hope that you could choose an s/*.h
### file based on the operating system portion. However, it turns out
-### that each m/*.h file is pretty manufacturer-specific - for
-### example mips.h is MIPS
+### that each s/*.h file is pretty manufacturer-specific.
### So we basically have to have a special case for each
### configuration name.
###
### prepared to handle anything reasonably. If version numbers
### matter, be sure /etc/MACHINES says something about it.
-machine='' opsys='' unported=no
+opsys='' unported=no
case "${canonical}" in
## GNU/Linux and similar ports
*-*-linux* )
opsys=gnu-linux
- case ${canonical} in
- alpha*) machine=alpha ;;
- s390x-*) machine=ibms390x ;;
- powerpc*) machine=macppc ;;
- sparc*) machine=sparc ;;
- ia64*) machine=ia64 ;;
- m68k*) machine=m68k ;;
- x86_64*) machine=amdx86-64 ;;
- esac
;;
## FreeBSD ports
*-*-freebsd* )
opsys=freebsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- amd64-*|x86_64-*) machine=amdx86-64 ;;
- ia64-*) machine=ia64 ;;
- i[3456]86-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc-*) machine=sparc ;;
- sparc64-*) machine=sparc ;;
- esac
;;
## FreeBSD kernel + glibc based userland
*-*-kfreebsd*gnu* )
opsys=gnu-kfreebsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- amd64-*|x86_64-*) machine=amdx86-64 ;;
- ia64-*) machine=ia64 ;;
- i[3456]86-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc-*) machine=sparc ;;
- sparc64-*) machine=sparc ;;
- esac
;;
## NetBSD ports
*-*-netbsd* )
opsys=netbsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- x86_64-*) machine=amdx86-64 ;;
- i[3456]86-*) machine=intel386 ;;
- m68k-*) machine=m68k ;;
- powerpc-*) machine=macppc ;;
- sparc*-) machine=sparc ;;
- vax-*) machine=vax ;;
- esac
;;
## OpenBSD ports
*-*-openbsd* )
opsys=openbsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- x86_64-*) machine=amdx86-64 ;;
- i386-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc*) machine=sparc ;;
- vax-*) machine=vax ;;
- esac
;;
## Apple Darwin / Mac OS X
*-apple-darwin* )
case "${canonical}" in
- i[3456]86-* ) machine=intel386 ;;
- powerpc-* ) machine=macppc ;;
- x86_64-* ) machine=amdx86-64 ;;
+ i[3456]86-* ) ;;
+ powerpc-* ) ;;
+ x86_64-* ) ;;
* ) unported=yes ;;
esac
opsys=darwin
- # Define CPP as follows to make autoconf work correctly.
- CPP="${CC-cc} -E -no-cpp-precomp"
- # Use fink packages if available.
- if test -d /sw/include && test -d /sw/lib; then
- GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib"
- CPP="${CPP} ${GCC_TEST_OPTIONS}"
- NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS}
- fi
+ ## Use fink packages if available.
+ ## FIXME find a better way to do this: http://debbugs.gnu.org/11507
+## if test -d /sw/include && test -d /sw/lib; then
+## GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib"
+## NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS}
+## fi
;;
## HP 9000 series 700 and 800, running HP/UX
## IBM machines
rs6000-ibm-aix4.[23]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
powerpc-ibm-aix4.[23]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
rs6000-ibm-aix[56]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
powerpc-ibm-aix[56]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
## Silicon Graphics machines
# Without defining _LANGUAGE_C, things get masked out in the headers
# so that, for instance, grepping for `free' in stdlib.h fails and
# AC_HEADER_STD_C fails. (MIPSPro 7.2.1.2m compilers, Irix 6.5.3m).
- NON_GNU_CPP="/lib/cpp -D_LANGUAGE_C"
NON_GCC_TEST_OPTIONS="-D_LANGUAGE_C"
;;
| i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \
| x86_64-*-solaris2* | x86_64-*-sunos5*)
case "${canonical}" in
- i[3456]86-*-* ) machine=intel386 ;;
- amd64-*-*|x86_64-*-*) machine=amdx86-64 ;;
- sparc* ) machine=sparc ;;
+ i[3456]86-*-* ) ;;
+ amd64-*-*|x86_64-*-*) ;;
+ sparc* ) ;;
* ) unported=yes ;;
esac
case "${canonical}" in
*-sunos5.6* | *-solaris2.6* )
opsys=sol2-6
- NON_GNU_CPP=/usr/ccs/lib/cpp
RANLIB="ar -ts"
;;
*-sunos5.[7-9]* | *-solaris2.[7-9]* )
opsys=sol2-6
emacs_check_sunpro_c=yes
- NON_GNU_CPP=/usr/ccs/lib/cpp
;;
*-sunos5* | *-solaris* )
opsys=sol2-10
emacs_check_sunpro_c=yes
- NON_GNU_CPP=/usr/ccs/lib/cpp
;;
esac
## Watch out for a compiler that we know will not work.
## Intel 386 machines where we don't care about the manufacturer.
i[3456]86-*-* )
- machine=intel386
case "${canonical}" in
*-cygwin ) opsys=cygwin ;;
- *-darwin* ) opsys=darwin
- CPP="${CC-cc} -E -no-cpp-precomp"
- ;;
- *-sysv4.2uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
- *-sysv5uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
- *-sysv5OpenUNIX* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
+ *-darwin* ) opsys=darwin ;;
+ *-sysv4.2uw* ) opsys=unixware ;;
+ *-sysv5uw* ) opsys=unixware ;;
+ *-sysv5OpenUNIX* ) opsys=unixware ;;
## Otherwise, we'll fall through to the generic opsys code at the bottom.
esac
;;
Check \`etc/MACHINES' for recognized configuration names." "$LINENO" 5
fi
-if test -n "$machine"; then
- machfile="m/${machine}.h"
-else
- machfile=
-fi
-opsysfile="s/${opsys}.h"
-
#### Choose a compiler.
-test -n "$CC" && cc_specified=yes
-
-# Save the value of CFLAGS that the user specified.
-SPECIFIED_CFLAGS="$CFLAGS"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
-# Initialize gnulib right after verifying that the C compiler works.
+if test x$GCC = xyes; then
+ test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS"
+else
+ test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
+fi
+
+# Avoid gnulib's threadlib module, as we do threads our own way.
+
+
+# Initialize gnulib right after choosing the compiler.
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
# Code from module alloca-opt:
# Code from module allocator:
+ # Code from module c-ctype:
+ # Code from module c-strcase:
# Code from module careadlinkat:
+ # Code from module clock-time:
# Code from module crypto/md5:
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module crypto/sha512:
# Code from module dosname:
# Code from module dtoastr:
+ # Code from module dtotimespec:
# Code from module dup2:
+ # Code from module environ:
+ # Code from module execinfo:
# Code from module extensions:
+ # Code from module extern-inline:
# Code from module filemode:
# Code from module getloadavg:
# Code from module getopt-gnu:
# Code from module getopt-posix:
# Code from module gettext-h:
+ # Code from module gettime:
+ # Code from module gettimeofday:
# Code from module ignore-value:
# Code from module include_next:
# Code from module intprops:
# Code from module largefile:
# Code from module lstat:
+ # Code from module manywarnings:
# Code from module mktime:
# Code from module multiarch:
# Code from module nocrash:
# Code from module pathmax:
+ # Code from module pselect:
# Code from module pthread_sigmask:
# Code from module readlink:
# Code from module signal-h:
- # Code from module sigprocmask:
# Code from module snippet/_Noreturn:
# Code from module snippet/arg-nonnull:
# Code from module snippet/c++defs:
# Code from module socklen:
# Code from module ssize_t:
# Code from module stat:
+ # Code from module stat-time:
+ # Code from module stdalign:
# Code from module stdarg:
# Code from module strtoull:
# Code from module strtoumax:
# Code from module symlink:
+ # Code from module sys_select:
# Code from module sys_stat:
+ # Code from module sys_time:
# Code from module time:
# Code from module time_r:
+ # Code from module timer-time:
+ # Code from module timespec:
+ # Code from module timespec-add:
+ # Code from module timespec-sub:
# Code from module u64:
# Code from module unistd:
+ # Code from module utimens:
# Code from module verify:
-
-
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
-fi
-
-## If not using gcc, and on Solaris, and no CPP specified, see if
-## using a Sun compiler, which needs -Xs to prevent whitespace.
-if test x"$GCC" != xyes && test x"$emacs_check_sunpro_c" = xyes && \
- test x"$CPP" = x; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using a Sun C compiler" >&5
-$as_echo_n "checking whether we are using a Sun C compiler... " >&6; }
- if test "${emacs_cv_sunpro_c+set}" = set; then :
+ # Code from module warnings:
+
+
+# It's helpful to have C macros available to GDB, so prefer -g3 to -g
+# if -g3 works and the user does not specify CFLAGS.
+# This test must follow gl_EARLY; otherwise AC_LINK_IFELSE complains.
+if test "$ac_test_CFLAGS" != set; then
+ case $CFLAGS in
+ '-g')
+ emacs_g3_CFLAGS='-g3';;
+ '-g -O2')
+ emacs_g3_CFLAGS='-g3 -O2';;
+ *)
+ emacs_g3_CFLAGS='';;
+ esac
+ if test -n "$emacs_g3_CFLAGS"; then
+ emacs_save_CFLAGS=$CFLAGS
+ CFLAGS=$emacs_g3_CFLAGS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts $emacs_g3_CFLAGS" >&5
+$as_echo_n "checking whether $CC accepts $emacs_g3_CFLAGS... " >&6; }
+if test "${emacs_cv_prog_cc_g3+set}" = set; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
int
main ()
{
-#ifndef __SUNPRO_C
-fail;
-#endif
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_sunpro_c=yes
+ emacs_cv_prog_cc_g3=yes
else
- emacs_cv_sunpro_c=no
+ emacs_cv_prog_cc_g3=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_sunpro_c" >&5
-$as_echo "$emacs_cv_sunpro_c" >&6; }
-
- if test x"$emacs_cv_sunpro_c" = xyes; then
- NON_GNU_CPP="$CC -E -Xs"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_prog_cc_g3" >&5
+$as_echo "$emacs_cv_prog_cc_g3" >&6; }
+ if test $emacs_cv_prog_cc_g3 = yes; then
+ CFLAGS=$emacs_g3_CFLAGS
+ else
+ CFLAGS=$emacs_save_CFLAGS
+ fi
fi
fi
-#### Some systems specify a CPP to use unless we are using GCC.
-#### Now that we know whether we are using GCC, we can decide whether
-#### to use that one.
-if test "x$NON_GNU_CPP" != x && test x$GCC != xyes && test "x$CPP" = x
-then
- CPP="$NON_GNU_CPP"
-fi
+# Check whether --enable-gcc-warnings was given.
+if test "${enable_gcc_warnings+set}" = set; then :
+ enableval=$enable_gcc_warnings; case $enableval in
+ yes|no) ;;
+ *) as_fn_error "bad value $enableval for gcc-warnings option" "$LINENO" 5 ;;
+ esac
+ gl_gcc_warnings=$enableval
+else
+ gl_gcc_warnings=no
-#### Some systems specify a CC to use unless we are using GCC.
-#### Now that we know whether we are using GCC, we can decide whether
-#### to use that one.
-if test "x$NON_GNU_CC" != x && test x$GCC != xyes &&
- test x$cc_specified != xyes
-then
- CC="$NON_GNU_CC"
fi
-if test x$GCC = xyes; then
- test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS"
+
+# Check whether --enable-link-time-optimization was given.
+if test "${enable_link_time_optimization+set}" = set; then :
+ enableval=$enable_link_time_optimization; if test "${enableval}" != "no"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether link-time optimization is supported" >&5
+$as_echo_n "checking whether link-time optimization is supported... " >&6; }
+ ac_lto_supported=no
+ if test x$GCC = xyes; then
+ CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null`
+ if test x$CPUS != x; then
+ LTO="-flto=$CPUS"
+ else
+ LTO="-flto"
+ fi
+ old_CFLAGS=$CFLAGS
+ CFLAGS="$CFLAGS $LTO"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_lto_supported=yes
else
- test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
+ ac_lto_supported=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$old_CFLAGS"
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_lto_supported" >&5
+$as_echo "$ac_lto_supported" >&6; }
+ if test "$ac_lto_supported" = "yes"; then
+ CFLAGS="$CFLAGS $LTO"
+ fi
+fi
fi
-### Use -Wdeclaration-after-statement if the compiler supports it
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -Wdeclaration-after-statement" >&5
-$as_echo_n "checking whether gcc understands -Wdeclaration-after-statement... " >&6; }
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wdeclaration-after-statement"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+
+# gl_GCC_VERSION_IFELSE([major], [minor], [run-if-found], [run-if-not-found])
+# ------------------------------------------------
+# If $CPP is gcc-MAJOR.MINOR or newer, then run RUN-IF-FOUND.
+# Otherwise, run RUN-IF-NOT-FOUND.
+
+
+# When compiling with GCC, prefer -isystem to -I when including system
+# include files, to avoid generating useless diagnostics for the files.
+if test "$gl_gcc_warnings" != yes; then
+ isystem='-I'
+else
+ isystem='-isystem '
+
+ # This, $nw, is the list of warnings we disable.
+ nw=
+
+ case $with_x_toolkit in
+ lucid | athena | motif)
+ # Old toolkits mishandle 'const'.
+ nw="$nw -Wwrite-strings"
+ ;;
+ *)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Werror" >&5
+$as_echo_n "checking whether C compiler handles -Werror... " >&6; }
+if test "${gl_cv_warn_c__Werror+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Werror"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- has_option=yes
+ gl_cv_warn_c__Werror=yes
else
- has_option=no
+ gl_cv_warn_c__Werror=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wdeclaration-after-statement $C_WARNINGS_SWITCH"
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $has_option" >&5
-$as_echo "$has_option" >&6; }
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-### Use -Wold-style-definition if the compiler supports it
-# This can be removed when conversion to standard C is finished.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -Wold-style-definition" >&5
-$as_echo_n "checking whether gcc understands -Wold-style-definition... " >&6; }
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wold-style-definition"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Werror" >&5
+$as_echo "$gl_cv_warn_c__Werror" >&6; }
+if test "x$gl_cv_warn_c__Werror" = x""yes; then :
+ as_fn_append WERROR_CFLAGS " -Werror"
+fi
+
+
+ ;;
+ esac
+
+
+ nw="$nw -Waggregate-return" # anachronistic
+ nw="$nw -Wlong-long" # C90 is anachronistic
+ nw="$nw -Wc++-compat" # We don't care about C++ compilers
+ nw="$nw -Wundef" # Warns on '#if GNULIB_FOO' etc in gnulib
+ nw="$nw -Wtraditional" # Warns on #elif which we use often
+ nw="$nw -Wcast-qual" # Too many warnings for now
+ nw="$nw -Wconversion" # Too many warnings for now
+ nw="$nw -Wsystem-headers" # Don't let system headers trigger warnings
+ nw="$nw -Wsign-conversion" # Too many warnings for now
+ nw="$nw -Woverlength-strings" # Not a problem these days
+ nw="$nw -Wtraditional-conversion" # Too many warnings for now
+ nw="$nw -Wunreachable-code" # so buggy that it's now silently ignored
+ nw="$nw -Wpadded" # Our structs are not padded
+ nw="$nw -Wredundant-decls" # we regularly (re)declare functions
+ nw="$nw -Wlogical-op" # any use of fwrite provokes this
+ nw="$nw -Wformat-nonliteral" # we do this a lot
+ nw="$nw -Wvla" # warnings in gettext.h
+ nw="$nw -Wnested-externs" # use of XARGMATCH/verify_function__
+ nw="$nw -Wswitch-enum" # Too many warnings for now
+ nw="$nw -Wswitch-default" # Too many warnings for now
+ nw="$nw -Wfloat-equal" # warns about high-quality code
+ nw="$nw -Winline" # OK to ignore 'inline'
+ nw="$nw -Wjump-misses-init" # We sometimes safely jump over init.
+ nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning
+ nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations
+
+ # Emacs doesn't care about shadowing; see
+ # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>.
+ nw="$nw -Wshadow"
+
+ # The following lines should be removable at some point.
+ nw="$nw -Wstack-protector"
+ nw="$nw -Wstrict-overflow"
+ nw="$nw -Wsuggest-attribute=pure"
+
+
+
+ if test -n "$GCC"; then
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -Wno-missing-field-initializers is supported" >&5
+$as_echo_n "checking whether -Wno-missing-field-initializers is supported... " >&6; }
+ if test "${gl_cv_cc_nomfi_supported+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -W -Werror -Wno-missing-field-initializers"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- has_option=yes
+ gl_cv_cc_nomfi_supported=yes
else
- has_option=no
+ gl_cv_cc_nomfi_supported=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wold-style-definition $C_WARNINGS_SWITCH"
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $has_option" >&5
-$as_echo "$has_option" >&6; }
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-### Use -Wimplicit-function-declaration if the compiler supports it
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -Wimplicit-function-declaration" >&5
-$as_echo_n "checking whether gcc understands -Wimplicit-function-declaration... " >&6; }
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wimplicit-function-declaration"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ CFLAGS="$gl_save_CFLAGS"
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_nomfi_supported" >&5
+$as_echo "$gl_cv_cc_nomfi_supported" >&6; }
+
+ if test "$gl_cv_cc_nomfi_supported" = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -Wno-missing-field-initializers is needed" >&5
+$as_echo_n "checking whether -Wno-missing-field-initializers is needed... " >&6; }
+ if test "${gl_cv_cc_nomfi_needed+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -W -Werror"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+void f (void)
+ {
+ typedef struct { int a; int b; } s_t;
+ s_t s1 = { 0, };
+ }
int
main ()
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- has_option=yes
+ gl_cv_cc_nomfi_needed=no
else
- has_option=no
+ gl_cv_cc_nomfi_needed=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wimplicit-function-declaration $C_WARNINGS_SWITCH"
+ CFLAGS="$gl_save_CFLAGS"
+
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $has_option" >&5
-$as_echo "$has_option" >&6; }
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_cc_nomfi_needed" >&5
+$as_echo "$gl_cv_cc_nomfi_needed" >&6; }
+ fi
+ fi
+ gl_manywarn_set=
+ for gl_manywarn_item in \
+ -W \
+ -Wabi \
+ -Waddress \
+ -Wall \
+ -Warray-bounds \
+ -Wattributes \
+ -Wbad-function-cast \
+ -Wbuiltin-macro-redefined \
+ -Wcast-align \
+ -Wchar-subscripts \
+ -Wclobbered \
+ -Wcomment \
+ -Wcomments \
+ -Wcoverage-mismatch \
+ -Wcpp \
+ -Wdeprecated \
+ -Wdeprecated-declarations \
+ -Wdisabled-optimization \
+ -Wdiv-by-zero \
+ -Wdouble-promotion \
+ -Wempty-body \
+ -Wendif-labels \
+ -Wenum-compare \
+ -Wextra \
+ -Wformat-contains-nul \
+ -Wformat-extra-args \
+ -Wformat-nonliteral \
+ -Wformat-security \
+ -Wformat-y2k \
+ -Wformat-zero-length \
+ -Wformat=2 \
+ -Wfree-nonheap-object \
+ -Wignored-qualifiers \
+ -Wimplicit \
+ -Wimplicit-function-declaration \
+ -Wimplicit-int \
+ -Winit-self \
+ -Winline \
+ -Wint-to-pointer-cast \
+ -Winvalid-memory-model \
+ -Winvalid-pch \
+ -Wjump-misses-init \
+ -Wlogical-op \
+ -Wmain \
+ -Wmaybe-uninitialized \
+ -Wmissing-braces \
+ -Wmissing-declarations \
+ -Wmissing-field-initializers \
+ -Wmissing-format-attribute \
+ -Wmissing-include-dirs \
+ -Wmissing-noreturn \
+ -Wmissing-parameter-type \
+ -Wmissing-prototypes \
+ -Wmudflap \
+ -Wmultichar \
+ -Wnarrowing \
+ -Wnested-externs \
+ -Wnonnull \
+ -Wnormalized=nfc \
+ -Wold-style-declaration \
+ -Wold-style-definition \
+ -Woverflow \
+ -Woverlength-strings \
+ -Woverride-init \
+ -Wpacked \
+ -Wpacked-bitfield-compat \
+ -Wparentheses \
+ -Wpointer-arith \
+ -Wpointer-sign \
+ -Wpointer-to-int-cast \
+ -Wpragmas \
+ -Wreturn-type \
+ -Wsequence-point \
+ -Wshadow \
+ -Wsizeof-pointer-memaccess \
+ -Wstack-protector \
+ -Wstrict-aliasing \
+ -Wstrict-overflow \
+ -Wstrict-prototypes \
+ -Wsuggest-attribute=const \
+ -Wsuggest-attribute=format \
+ -Wsuggest-attribute=noreturn \
+ -Wsuggest-attribute=pure \
+ -Wswitch \
+ -Wswitch-default \
+ -Wsync-nand \
+ -Wsystem-headers \
+ -Wtrampolines \
+ -Wtrigraphs \
+ -Wtype-limits \
+ -Wuninitialized \
+ -Wunknown-pragmas \
+ -Wunreachable-code \
+ -Wunsafe-loop-optimizations \
+ -Wunused \
+ -Wunused-but-set-parameter \
+ -Wunused-but-set-variable \
+ -Wunused-function \
+ -Wunused-label \
+ -Wunused-local-typedefs \
+ -Wunused-macros \
+ -Wunused-parameter \
+ -Wunused-result \
+ -Wunused-value \
+ -Wunused-variable \
+ -Wvarargs \
+ -Wvariadic-macros \
+ -Wvector-operation-performance \
+ -Wvla \
+ -Wvolatile-register-var \
+ -Wwrite-strings \
+ \
+ ; do
+ gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item"
+ done
+ # Disable the missing-field-initializers warning if needed
+ if test "$gl_cv_cc_nomfi_needed" = yes; then
+ gl_manywarn_set="$gl_manywarn_set -Wno-missing-field-initializers"
+ fi
-#### Some other nice autoconf tests.
+ ws=$gl_manywarn_set
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
-$as_echo_n "checking how to run the C preprocessor... " >&6; }
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
-fi
-if test -z "$CPP"; then
- if test "${ac_cv_prog_CPP+set}" = set; then :
+
+ gl_warn_set=
+ set x $ws; shift
+ for gl_warn_item
+ do
+ case " $nw " in
+ *" $gl_warn_item "*)
+ ;;
+ *)
+ gl_warn_set="$gl_warn_set $gl_warn_item"
+ ;;
+ esac
+ done
+ ws=$gl_warn_set
+
+ for w in $ws; do
+ as_gl_Warn=`$as_echo "gl_cv_warn_c_$w" | $as_tr_sh`
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles $w" >&5
+$as_echo_n "checking whether C compiler handles $w... " >&6; }
+if { as_var=$as_gl_Warn; eval "test \"\${$as_var+set}\" = set"; }; then :
$as_echo_n "(cached) " >&6
else
- # Double quotes because CPP needs to be expanded
- for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
- do
- ac_preproc_ok=false
-for ac_c_preproc_warn_flag in '' yes
-do
- # Use a header file that comes with gcc, so configuring glibc
- # with a fresh cross-compiler works.
- # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- # <limits.h> exists even on freestanding compilers.
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp. "Syntax error" is here to catch this case.
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " $w"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
- Syntax error
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
-else
- # Broken: fails on valid input.
-continue
-fi
-rm -f conftest.err conftest.$ac_ext
+int
+main ()
+{
- # OK, works on sane cases. Now check whether nonexistent headers
- # can be detected and how.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <ac_nonexistent.h>
+ ;
+ return 0;
+}
_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- # Broken: success on invalid input.
-continue
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$as_gl_Warn=yes"
else
- # Passes both tests.
-ac_preproc_ok=:
-break
+ eval "$as_gl_Warn=no"
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
-done
-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then :
- break
+fi
+eval ac_res=\$$as_gl_Warn
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+eval as_val=\$$as_gl_Warn
+ if test "x$as_val" = x""yes; then :
+ as_fn_append WARN_CFLAGS " $w"
fi
- done
- ac_cv_prog_CPP=$CPP
-fi
- CPP=$ac_cv_prog_CPP
+ done
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-missing-field-initializers" >&5
+$as_echo_n "checking whether C compiler handles -Wno-missing-field-initializers... " >&6; }
+if test "${gl_cv_warn_c__Wno_missing_field_initializers+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- ac_cv_prog_CPP=$CPP
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
-$as_echo "$CPP" >&6; }
-ac_preproc_ok=false
-for ac_c_preproc_warn_flag in '' yes
-do
- # Use a header file that comes with gcc, so configuring glibc
- # with a fresh cross-compiler works.
- # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- # <limits.h> exists even on freestanding compilers.
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp. "Syntax error" is here to catch this case.
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-missing-field-initializers"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
- Syntax error
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_missing_field_initializers=yes
else
- # Broken: fails on valid input.
-continue
+ gl_cv_warn_c__Wno_missing_field_initializers=no
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
- # OK, works on sane cases. Now check whether nonexistent headers
- # can be detected and how.
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_missing_field_initializers" >&5
+$as_echo "$gl_cv_warn_c__Wno_missing_field_initializers" >&6; }
+if test "x$gl_cv_warn_c__Wno_missing_field_initializers" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-missing-field-initializers"
+fi
+
+ # We need this one
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-sign-compare" >&5
+$as_echo_n "checking whether C compiler handles -Wno-sign-compare... " >&6; }
+if test "${gl_cv_warn_c__Wno_sign_compare+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-sign-compare"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <ac_nonexistent.h>
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- # Broken: success on invalid input.
-continue
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_sign_compare=yes
else
- # Passes both tests.
-ac_preproc_ok=:
-break
+ gl_cv_warn_c__Wno_sign_compare=no
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
-done
-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then :
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_sign_compare" >&5
+$as_echo "$gl_cv_warn_c__Wno_sign_compare" >&6; }
+if test "x$gl_cv_warn_c__Wno_sign_compare" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-sign-compare"
+fi
+ # Too many warnings for now
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-type-limits" >&5
+$as_echo_n "checking whether C compiler handles -Wno-type-limits... " >&6; }
+if test "${gl_cv_warn_c__Wno_type_limits+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error "C preprocessor \"$CPP\" fails sanity check
-See \`config.log' for more details." "$LINENO" 5; }
-fi
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-type-limits"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+int
+main ()
+{
-if test "x$RANLIB" = x; then
- if test -n "$ac_tool_prefix"; then
- # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
-set dummy ${ac_tool_prefix}ranlib; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_prog_RANLIB+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- if test -n "$RANLIB"; then
- ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_type_limits=yes
else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
+ gl_cv_warn_c__Wno_type_limits=no
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
+
fi
-RANLIB=$ac_cv_prog_RANLIB
-if test -n "$RANLIB"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
-$as_echo "$RANLIB" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_type_limits" >&5
+$as_echo "$gl_cv_warn_c__Wno_type_limits" >&6; }
+if test "x$gl_cv_warn_c__Wno_type_limits" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-type-limits"
fi
-
-fi
-if test -z "$ac_cv_prog_RANLIB"; then
- ac_ct_RANLIB=$RANLIB
- # Extract the first word of "ranlib", so it can be a program name with args.
-set dummy ranlib; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then :
+ # Too many warnings for now
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-switch" >&5
+$as_echo_n "checking whether C compiler handles -Wno-switch... " >&6; }
+if test "${gl_cv_warn_c__Wno_switch+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- if test -n "$ac_ct_RANLIB"; then
- ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-switch"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_switch=yes
else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_prog_ac_ct_RANLIB="ranlib"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ gl_cv_warn_c__Wno_switch=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_switch" >&5
+$as_echo "$gl_cv_warn_c__Wno_switch" >&6; }
+if test "x$gl_cv_warn_c__Wno_switch" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-switch"
fi
-ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
-if test -n "$ac_ct_RANLIB"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
-$as_echo "$ac_ct_RANLIB" >&6; }
+
+ # Too many warnings for now
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-unused-parameter" >&5
+$as_echo_n "checking whether C compiler handles -Wno-unused-parameter... " >&6; }
+if test "${gl_cv_warn_c__Wno_unused_parameter+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
- if test "x$ac_ct_RANLIB" = x; then
- RANLIB=":"
- else
- case $cross_compiling:$ac_tool_warned in
-yes:)
-{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
-$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
-ac_tool_warned=yes ;;
-esac
- RANLIB=$ac_ct_RANLIB
- fi
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-unused-parameter"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_unused_parameter=yes
else
- RANLIB="$ac_cv_prog_RANLIB"
+ gl_cv_warn_c__Wno_unused_parameter=no
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_unused_parameter" >&5
+$as_echo "$gl_cv_warn_c__Wno_unused_parameter" >&6; }
+if test "x$gl_cv_warn_c__Wno_unused_parameter" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-unused-parameter"
+fi
+
+ # Too many warnings for now
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-format-nonliteral" >&5
+$as_echo_n "checking whether C compiler handles -Wno-format-nonliteral... " >&6; }
+if test "${gl_cv_warn_c__Wno_format_nonliteral+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-format-nonliteral"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-## Although we're running on an amd64 kernel, we're actually compiling for
-## the x86 architecture. The user should probably have provided an
-## explicit --build to `configure', but if everything else than the kernel
-## is running in i386 mode, we can help them out.
-if test "$machine" = "amdx86-64"; then
- ac_fn_c_check_decl "$LINENO" "i386" "ac_cv_have_decl_i386" "$ac_includes_default"
-if test "x$ac_cv_have_decl_i386" = x""yes; then :
+int
+main ()
+{
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_format_nonliteral=yes
+else
+ gl_cv_warn_c__Wno_format_nonliteral=no
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
- if test "$ac_cv_have_decl_i386" = "yes"; then
- canonical=`echo "$canonical" | sed -e 's/^amd64/i386/' -e 's/^x86_64/i386/'`
- machine=intel386
- machfile="m/${machine}.h"
- fi
- ac_fn_c_check_decl "$LINENO" "__ILP32__" "ac_cv_have_decl___ILP32__" "$ac_includes_default"
-if test "x$ac_cv_have_decl___ILP32__" = x""yes; then :
- machfile="m/intel386.h"
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_format_nonliteral" >&5
+$as_echo "$gl_cv_warn_c__Wno_format_nonliteral" >&6; }
+if test "x$gl_cv_warn_c__Wno_format_nonliteral" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-format-nonliteral"
+fi
+
+
+
+ # In spite of excluding -Wlogical-op above, it is enabled, as of
+ # gcc 4.5.0 20090517.
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-logical-op" >&5
+$as_echo_n "checking whether C compiler handles -Wno-logical-op... " >&6; }
+if test "${gl_cv_warn_c__Wno_logical_op+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -Wno-logical-op"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__Wno_logical_op=yes
+else
+ gl_cv_warn_c__Wno_logical_op=no
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
-# Extract the first word of "install-info", so it can be a program name with args.
-set dummy install-info; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_INSTALL_INFO+set}" = set; then :
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_logical_op" >&5
+$as_echo "$gl_cv_warn_c__Wno_logical_op" >&6; }
+if test "x$gl_cv_warn_c__Wno_logical_op" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -Wno-logical-op"
+fi
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -fdiagnostics-show-option" >&5
+$as_echo_n "checking whether C compiler handles -fdiagnostics-show-option... " >&6; }
+if test "${gl_cv_warn_c__fdiagnostics_show_option+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $INSTALL_INFO in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_INSTALL_INFO="$INSTALL_INFO" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_INSTALL_INFO="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -fdiagnostics-show-option"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__fdiagnostics_show_option=yes
+else
+ gl_cv_warn_c__fdiagnostics_show_option=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__fdiagnostics_show_option" >&5
+$as_echo "$gl_cv_warn_c__fdiagnostics_show_option" >&6; }
+if test "x$gl_cv_warn_c__fdiagnostics_show_option" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -fdiagnostics-show-option"
+fi
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -funit-at-a-time" >&5
+$as_echo_n "checking whether C compiler handles -funit-at-a-time... " >&6; }
+if test "${gl_cv_warn_c__funit_at_a_time+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ gl_save_compiler_FLAGS="$CFLAGS"
+ as_fn_append CFLAGS " -funit-at-a-time"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_warn_c__funit_at_a_time=yes
+else
+ gl_cv_warn_c__funit_at_a_time=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$gl_save_compiler_FLAGS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__funit_at_a_time" >&5
+$as_echo "$gl_cv_warn_c__funit_at_a_time" >&6; }
+if test "x$gl_cv_warn_c__funit_at_a_time" = x""yes; then :
+ as_fn_append WARN_CFLAGS " -funit-at-a-time"
+fi
+
+
+
+
+$as_echo "#define lint 1" >>confdefs.h
+
+
+
+$as_echo "#define GNULIB_PORTCHECK 1" >>confdefs.h
+
+
+ # We use a slightly smaller set of warning options for lib/.
+ # Remove the following and save the result in GNULIB_WARN_CFLAGS.
+ nw=
+ nw="$nw -Wunused-macros"
+
+
+ gl_warn_set=
+ set x $WARN_CFLAGS; shift
+ for gl_warn_item
+ do
+ case " $nw " in
+ *" $gl_warn_item "*)
+ ;;
+ *)
+ gl_warn_set="$gl_warn_set $gl_warn_item"
+ ;;
+ esac
done
-IFS=$as_save_IFS
+ GNULIB_WARN_CFLAGS=$gl_warn_set
+
- ;;
-esac
fi
-INSTALL_INFO=$ac_cv_path_INSTALL_INFO
-if test -n "$INSTALL_INFO"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL_INFO" >&5
-$as_echo "$INSTALL_INFO" >&6; }
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5
+$as_echo_n "checking whether ln -s works... " >&6; }
+LN_S=$as_ln_s
+if test "$LN_S" = "ln -s"; 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; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5
+$as_echo "no, using $LN_S" >&6; }
fi
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /usr/sbin
+for as_dir in $PATH$PATH_SEPARATOR/usr/sbin$PATH_SEPARATOR/sbin
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
done
IFS=$as_save_IFS
+ test -z "$ac_cv_path_INSTALL_INFO" && ac_cv_path_INSTALL_INFO=":"
;;
esac
fi
fi
-# Extract the first word of "install-info", so it can be a program name with args.
-set dummy install-info; ac_word=$2
+# Extract the first word of "gzip", so it can be a program name with args.
+set dummy gzip; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_INSTALL_INFO+set}" = set; then :
+if test "${ac_cv_path_GZIP_PROG+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $INSTALL_INFO in
+ case $GZIP_PROG in
[\\/]* | ?:[\\/]*)
- ac_cv_path_INSTALL_INFO="$INSTALL_INFO" # Let the user override the test with a path.
+ ac_cv_path_GZIP_PROG="$GZIP_PROG" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /sbin
+for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_INSTALL_INFO="$as_dir/$ac_word$ac_exec_ext"
+ ac_cv_path_GZIP_PROG="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
IFS=$as_save_IFS
- test -z "$ac_cv_path_INSTALL_INFO" && ac_cv_path_INSTALL_INFO=":"
;;
esac
fi
-INSTALL_INFO=$ac_cv_path_INSTALL_INFO
-if test -n "$INSTALL_INFO"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL_INFO" >&5
-$as_echo "$INSTALL_INFO" >&6; }
+GZIP_PROG=$ac_cv_path_GZIP_PROG
+if test -n "$GZIP_PROG"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GZIP_PROG" >&5
+$as_echo "$GZIP_PROG" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
-# Extract the first word of "gzip", so it can be a program name with args.
-set dummy gzip; ac_word=$2
+
+if test $opsys = gnu-linux; then
+ # Extract the first word of "paxctl", so it can be a program name with args.
+set dummy paxctl; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_GZIP_PROG+set}" = set; then :
+if test "${ac_cv_path_PAXCTL+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $GZIP_PROG in
+ case $PAXCTL in
[\\/]* | ?:[\\/]*)
- ac_cv_path_GZIP_PROG="$GZIP_PROG" # Let the user override the test with a path.
+ ac_cv_path_PAXCTL="$PAXCTL" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
+for as_dir in $PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_GZIP_PROG="$as_dir/$ac_word$ac_exec_ext"
+ ac_cv_path_PAXCTL="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
;;
esac
fi
-GZIP_PROG=$ac_cv_path_GZIP_PROG
-if test -n "$GZIP_PROG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GZIP_PROG" >&5
-$as_echo "$GZIP_PROG" >&6; }
+PAXCTL=$ac_cv_path_PAXCTL
+if test -n "$PAXCTL"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PAXCTL" >&5
+$as_echo "$PAXCTL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
+ 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
-## Need makeinfo >= 4.6 (?) to build the manuals.
+## Need makeinfo >= 4.7 (?) to build the manuals.
# Extract the first word of "makeinfo", so it can be a program name with args.
set dummy makeinfo; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
if test "$MAKEINFO" != "no" && \
- test x"`$MAKEINFO --version 2> /dev/null | $EGREP 'texinfo[^0-9]*([1-4][0-9]+|[5-9]|4\.[6-9]|4\.[1-5][0-9]+)'`" = x; then
+ test x"`$MAKEINFO --version 2> /dev/null | $EGREP 'texinfo[^0-9]*([1-4][0-9]+|[5-9]|4\.[7-9]|4\.[1-6][0-9]+)'`" = x; then
MAKEINFO=no
fi
if test "x${with_makeinfo}" = "xno"; then
HAVE_MAKEINFO=no
elif test ! -e $srcdir/info/emacs; then
- as_fn_error "You do not seem to have makeinfo >= 4.6, and your
+ as_fn_error "You do not seem to have makeinfo >= 4.7, and your
source tree does not seem to have pre-built manuals in the \`info' directory.
Either install a suitable version of makeinfo, or re-run configure
with the \`--without-makeinfo' option to build without the manuals. " "$LINENO" 5
fi
+INFO_EXT=.info
+INFO_OPTS=--no-split
+
+
+
if test x$GCC = xyes; then
test "x$GCC_LINK_TEST_OPTIONS" != x && \
conftest$ac_exeext conftest.$ac_ext
-# The value of CPP is a quoted variable reference, so we need to do this
-# to get its actual value...
-CPP=`eval "echo $CPP"`
-
-
test "x$CANNOT_DUMP" = "x" && CANNOT_DUMP=no
case "$opsys" in
your-opsys-here) CANNOT_DUMP=yes ;;
## Let `ld' find image libs and similar things in /usr/local/lib.
## The system compiler, GCC, has apparently been modified to not
## look there, contrary to what a stock GCC would do.
- LD_SWITCH_SYSTEM=-L/usr/local/lib
+### It's not our place to do this. See bug#10313#17.
+### LD_SWITCH_SYSTEM=-L/usr/local/lib
+ :
;;
gnu-linux)
;;
netbsd)
- LD_SWITCH_SYSTEM="-Wl,-rpath,/usr/pkg/lib -L/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib"
+### It's not our place to do this. See bug#10313#17.
+### LD_SWITCH_SYSTEM="-Wl,-rpath,/usr/pkg/lib -L/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib"
+ :
;;
openbsd)
ac_link="$ac_link $LD_SWITCH_SYSTEM"
-## This setting of LD_SWITCH_SYSTEM references LD_SWITCH_X_SITE_AUX,
+## This setting of LD_SWITCH_SYSTEM references LD_SWITCH_X_SITE_RPATH,
## which has not been defined yet. When this was handled with cpp,
## it was expanded to null when configure sourced the s/*.h file.
## Thus LD_SWITCH_SYSTEM had different values in configure and the Makefiles.
## LD_SWITCH_SYSTEM_TEMACS.
case "$opsys" in
netbsd|openbsd)
- ## _AUX_RPATH is like _AUX, but uses -rpath instead of -R.
- LD_SWITCH_SYSTEM="\$(LD_SWITCH_X_SITE_AUX_RPATH) $LD_SWITCH_SYSTEM" ;;
+ LD_SWITCH_SYSTEM="\$(LD_SWITCH_X_SITE_RPATH) $LD_SWITCH_SYSTEM" ;;
esac
C_SWITCH_MACHINE=
-if test "$machine" = "alpha"; then
+case $canonical in
+ alpha*)
ac_fn_c_check_decl "$LINENO" "__ELF__" "ac_cv_have_decl___ELF__" "$ac_includes_default"
if test "x$ac_cv_have_decl___ELF__" = x""yes; then :
else
UNEXEC_OBJ=unexalpha.o
fi
-fi
+ ;;
+esac
# Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them.
-# Check whether --enable-largefile was given.
-if test "${enable_largefile+set}" = set; then :
- enableval=$enable_largefile;
-fi
-
-if test "$enable_largefile" != no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5
-$as_echo_n "checking for special C compiler options needed for large files... " >&6; }
-if test "${ac_cv_sys_largefile_CC+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_cv_sys_largefile_CC=no
- if test "$GCC" != yes; then
- ac_save_CC=$CC
- while :; do
- # IRIX 6.2 and later do not support large files by default,
- # so use the C compiler's -n32 option if that helps.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
- if ac_fn_c_try_compile "$LINENO"; then :
- break
-fi
-rm -f core conftest.err conftest.$ac_objext
- CC="$CC -n32"
- if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_largefile_CC=' -n32'; break
-fi
-rm -f core conftest.err conftest.$ac_objext
- break
- done
- CC=$ac_save_CC
- rm -f conftest.$ac_ext
- fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5
-$as_echo "$ac_cv_sys_largefile_CC" >&6; }
- if test "$ac_cv_sys_largefile_CC" != no; then
- CC=$CC$ac_cv_sys_largefile_CC
- fi
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5
-$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; }
-if test "${ac_cv_sys_file_offset_bits+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- while :; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_file_offset_bits=no; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#define _FILE_OFFSET_BITS 64
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_file_offset_bits=64; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- ac_cv_sys_file_offset_bits=unknown
- break
-done
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5
-$as_echo "$ac_cv_sys_file_offset_bits" >&6; }
-case $ac_cv_sys_file_offset_bits in #(
- no | unknown) ;;
- *)
-cat >>confdefs.h <<_ACEOF
-#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits
-_ACEOF
-;;
-esac
-rm -rf conftest*
- if test $ac_cv_sys_file_offset_bits = unknown; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5
-$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; }
-if test "${ac_cv_sys_large_files+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- while :; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_large_files=no; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#define _LARGE_FILES 1
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_large_files=1; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- ac_cv_sys_large_files=unknown
- break
-done
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5
-$as_echo "$ac_cv_sys_large_files" >&6; }
-case $ac_cv_sys_large_files in #(
- no | unknown) ;;
- *)
-cat >>confdefs.h <<_ACEOF
-#define _LARGE_FILES $ac_cv_sys_large_files
-_ACEOF
-;;
-esac
-rm -rf conftest*
- fi
-
-
-fi
-
-
-
-LIB_MATH=-lm
-LIB_STANDARD=
-START_FILES=
+LIB_MATH=-lm
+LIB_STANDARD=
+START_FILES=
+SYSTEM_TYPE=`echo $opsys | sed -e 's/[0-9].*//' -e 's|-|/|'`
case $opsys in
cygwin )
START_FILES='pre-crt0.o'
;;
freebsd )
- LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtend.o $(CRT_DIR)/crtn.o'
- START_FILES='pre-crt0.o $(CRT_DIR)/crt1.o $(CRT_DIR)/crti.o $(CRT_DIR)/crtbegin.o'
+ LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtn.o'
+ START_FILES='pre-crt0.o $(CRT_DIR)/crt1.o $(CRT_DIR)/crti.o'
+ SYSTEM_TYPE=berkeley-unix
;;
gnu-linux | gnu-kfreebsd )
LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtn.o'
netbsd | openbsd )
LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtend.o'
START_FILES='pre-crt0.o $(CRT_DIR)/crt0.o $(CRT_DIR)/crtbegin.o'
+ SYSTEM_TYPE=berkeley-unix
+ ;;
+
+ sol2* | unixware )
+ SYSTEM_TYPE=usg-unix-v
;;
+
esac
+cat >>confdefs.h <<_ACEOF
+#define SYSTEM_TYPE "$SYSTEM_TYPE"
+_ACEOF
+
+
crt_files=
for file in x $LIB_STANDARD $START_FILES; do
esac
+pre_PKG_CONFIG_CFLAGS=$CFLAGS
+pre_PKG_CONFIG_LIBS=$LIBS
+
+# Extract the first word of "pkg-config", so it can be a program name with args.
+set dummy pkg-config; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ case $PKG_CONFIG in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+ test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
+ ;;
+esac
+fi
+PKG_CONFIG=$ac_cv_path_PKG_CONFIG
+if test -n "$PKG_CONFIG"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
+$as_echo "$PKG_CONFIG" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ if test "$PKG_CONFIG" = "no" ; then
+ HAVE_ALSA=no
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ALSA_MODULES" >&5
+$as_echo_n "checking for $ALSA_MODULES... " >&6; }
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
- if test "$PKG_CONFIG" = "no" ; then
- HAVE_ALSA=no
- else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ALSA_MODULES" >&5
-$as_echo_n "checking for $ALSA_MODULES... " >&6; }
-
- if $PKG_CONFIG --exists "$ALSA_MODULES" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "$ALSA_MODULES" 2>&5 &&
+ ALSA_CFLAGS=`$PKG_CONFIG --cflags "$ALSA_MODULES" 2>&5` &&
+ ALSA_LIBS=`$PKG_CONFIG --libs "$ALSA_MODULES" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ ALSA_CFLAGS=`$as_echo "$ALSA_CFLAGS" | sed -e "$edit_cflags"`
+ ALSA_LIBS=`$as_echo "$ALSA_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$ALSA_CFLAGS' LIBS='$ALSA_LIBS'" >&5
+$as_echo "yes CFLAGS='$ALSA_CFLAGS' LIBS='$ALSA_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking ALSA_CFLAGS" >&5
-$as_echo_n "checking ALSA_CFLAGS... " >&6; }
- ALSA_CFLAGS=`$PKG_CONFIG --cflags "$ALSA_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ALSA_CFLAGS" >&5
-$as_echo "$ALSA_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking ALSA_LIBS" >&5
-$as_echo_n "checking ALSA_LIBS... " >&6; }
- ALSA_LIBS=`$PKG_CONFIG --libs "$ALSA_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ALSA_LIBS" >&5
-$as_echo "$ALSA_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
ALSA_CFLAGS=""
ALSA_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- ALSA_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$ALSA_MODULES"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ ALSA_PKG_ERRORS=`($PKG_CONFIG --print-errors "$ALSA_MODULES") 2>&1`
fi
fi
-for ac_header in sys/select.h sys/time.h unistd.h utime.h \
- linux/version.h sys/systeminfo.h \
- stdio_ext.h fcntl.h coff.h pty.h sys/mman.h \
- sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \
- sys/utsname.h pwd.h utmp.h dirent.h util.h
+
+
+
+ for ac_header in $ac_header_list
do :
as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
-ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
eval as_val=\$$as_ac_Header
if test "x$as_val" = x""yes; then :
cat >>confdefs.h <<_ACEOF
done
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if personality LINUX32 can be set" >&5
$as_echo_n "checking if personality LINUX32 can be set... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct utimbuf" >&5
-$as_echo_n "checking for struct utimbuf... " >&6; }
-if test "${emacs_cv_struct_utimbuf+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif
-#ifdef HAVE_UTIME_H
-#include <utime.h>
-#endif
-int
-main ()
-{
-static struct utimbuf x; x.actime = x.modtime;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_struct_utimbuf=yes
-else
- emacs_cv_struct_utimbuf=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_struct_utimbuf" >&5
-$as_echo "$emacs_cv_struct_utimbuf" >&6; }
-if test $emacs_cv_struct_utimbuf = yes; then
-
-$as_echo "#define HAVE_STRUCT_UTIMBUF 1" >>confdefs.h
-
-fi
-
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for speed_t" >&5
$as_echo_n "checking for speed_t... " >&6; }
if test "${emacs_cv_speed_t+set}" = set; then :
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timeval" >&5
-$as_echo_n "checking for struct timeval... " >&6; }
-if test "${emacs_cv_struct_timeval+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif
-int
-main ()
-{
-static struct timeval x; x.tv_sec = x.tv_usec;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_struct_timeval=yes
-else
- emacs_cv_struct_timeval=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_struct_timeval" >&5
-$as_echo "$emacs_cv_struct_timeval" >&6; }
-HAVE_TIMEVAL=$emacs_cv_struct_timeval
-if test $emacs_cv_struct_timeval = yes; then
-
-$as_echo "#define HAVE_TIMEVAL 1" >>confdefs.h
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct exception" >&5
-$as_echo_n "checking for struct exception... " >&6; }
-if test "${emacs_cv_struct_exception+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <math.h>
-int
-main ()
-{
-static struct exception x; x.arg1 = x.arg2 = x.retval; x.name = ""; x.type = 1;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_struct_exception=yes
-else
- emacs_cv_struct_exception=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_struct_exception" >&5
-$as_echo "$emacs_cv_struct_exception" >&6; }
-HAVE_EXCEPTION=$emacs_cv_struct_exception
-if test $emacs_cv_struct_exception != yes; then
-
-$as_echo "#define NO_MATHERR 1" >>confdefs.h
-
-fi
-
-for ac_header in sys/socket.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "sys/socket.h" "ac_cv_header_sys_socket_h" "$ac_includes_default"
-if test "x$ac_cv_header_sys_socket_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_SYS_SOCKET_H 1
-_ACEOF
-fi
-done
for ac_header in net/if.h
do :
done
-for ac_func in getifaddrs freeifaddrs
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-eval as_val=\$$as_ac_var
- if test "x$as_val" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_flags" "ac_cv_member_struct_ifreq_ifr_flags" "$ac_includes_default
#if HAVE_SYS_SOCKET_H
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for function prototypes" >&5
-$as_echo_n "checking for function prototypes... " >&6; }
-if test "$ac_cv_prog_cc_c89" != no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-$as_echo "#define PROTOTYPES 1" >>confdefs.h
-
-
-$as_echo "#define __PROTOTYPES 1" >>confdefs.h
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working volatile" >&5
-$as_echo_n "checking for working volatile... " >&6; }
-if test "${ac_cv_c_volatile+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+DEPFLAGS=
+MKDEPDIR=":"
+deps_frag=deps.mk
+if test "$GCC" = yes && test "$ac_enable_autodepend" = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using GNU Make" >&5
+$as_echo_n "checking whether we are using GNU Make... " >&6; }
+ HAVE_GNU_MAKE=no
+ testval=`${MAKE-make} --version 2>/dev/null | grep 'GNU Make'`
+ if test "x$testval" != x; then
+ HAVE_GNU_MAKE=yes
+ else
+ ac_enable_autodepend=no
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $HAVE_GNU_MAKE" >&5
+$as_echo "$HAVE_GNU_MAKE" >&6; }
+ if test $HAVE_GNU_MAKE = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -MMD -MF" >&5
+$as_echo_n "checking whether gcc understands -MMD -MF... " >&6; }
+ SAVE_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -MMD -MF deps.d -MP"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
-volatile int x;
-int * volatile y = (int *) 0;
-return !x && !y;
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_volatile=yes
+
else
- ac_cv_c_volatile=no
+ ac_enable_autodepend=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$SAVE_CFLAGS"
+ test -f deps.d || ac_enable_autodepend=no
+ rm -rf deps.d
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_enable_autodepend" >&5
+$as_echo "$ac_enable_autodepend" >&6; }
+ fi
+ if test $ac_enable_autodepend = yes; then
+ DEPFLAGS='-MMD -MF ${DEPDIR}/$*.d -MP'
+ ## MKDIR_P is documented (see AC_PROG_MKDIR_P) to be parallel-safe.
+ MKDEPDIR='${MKDIR_P} ${DEPDIR}'
+ deps_frag=autodeps.mk
+ fi
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_volatile" >&5
-$as_echo "$ac_cv_c_volatile" >&6; }
-if test $ac_cv_c_volatile = no; then
+deps_frag=$srcdir/src/$deps_frag
-$as_echo "#define volatile /**/" >>confdefs.h
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for an ANSI C-conforming const" >&5
-$as_echo_n "checking for an ANSI C-conforming const... " >&6; }
-if test "${ac_cv_c_const+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-int
-main ()
-{
-/* FIXME: Include the comments suggested by Paul. */
-#ifndef __cplusplus
- /* Ultrix mips cc rejects this. */
- typedef int charset[2];
- const charset cs;
- /* SunOS 4.1.1 cc rejects this. */
- char const *const *pcpcc;
- char **ppc;
- /* NEC SVR4.0.2 mips cc rejects this. */
- struct point {int x, y;};
- static struct point const zero = {0,0};
- /* AIX XL C 1.02.0.0 rejects this.
- It does not let you subtract one const X* pointer from another in
- an arm of an if-expression whose if-part is not a constant
- expression */
- const char *g = "string";
- pcpcc = &g + (g ? g-g : 0);
- /* HPUX 7.0 cc rejects these. */
- ++pcpcc;
- ppc = (char**) pcpcc;
- pcpcc = (char const *const *) ppc;
- { /* SCO 3.2v4 cc rejects this. */
- char *t;
- char const *s = 0 ? (char *) 0 : (char const *) 0;
-
- *t++ = 0;
- if (s) return 0;
- }
- { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
- int x[] = {25, 17};
- const int *foo = &x[0];
- ++foo;
- }
- { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
- typedef const int *iptr;
- iptr p = 0;
- ++p;
- }
- { /* AIX XL C 1.02.0.0 rejects this saying
- "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
- struct s { int j; const int *ap[3]; };
- struct s *b; b->j = 5;
- }
- { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
- const int foo = 10;
- if (!foo) return 0;
- }
- return !cs[0] && !zero.x;
-#endif
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_const=yes
-else
- ac_cv_c_const=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_const" >&5
-$as_echo "$ac_cv_c_const" >&6; }
-if test $ac_cv_c_const = no; then
+lisp_frag=$srcdir/src/lisp.mk
-$as_echo "#define const /**/" >>confdefs.h
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for void * support" >&5
-$as_echo_n "checking for void * support... " >&6; }
-if test "${emacs_cv_void_star+set}" = set; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for long file names" >&5
+$as_echo_n "checking for long file names... " >&6; }
+if test "${ac_cv_sys_long_file_names+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-int
-main ()
-{
-void * foo;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_void_star=yes
-else
- emacs_cv_void_star=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_void_star" >&5
-$as_echo "$emacs_cv_void_star" >&6; }
-if test $emacs_cv_void_star = yes; then
- $as_echo "#define POINTER_TYPE void" >>confdefs.h
-
-else
- $as_echo "#define POINTER_TYPE char" >>confdefs.h
-
-fi
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
-$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
-if test "${ac_cv_c_bigendian+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_cv_c_bigendian=unknown
- # See if we're dealing with a universal compiler.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#ifndef __APPLE_CC__
- not a universal capable compiler
- #endif
- typedef int dummy;
+ ac_cv_sys_long_file_names=yes
+# Test for long file names in all the places we know might matter:
+# . the current directory, where building will happen
+# $prefix/lib where we will be installing things
+# $exec_prefix/lib likewise
+# $TMPDIR if set, where it might want to write temporary files
+# /tmp where it might want to write temporary files
+# /var/tmp likewise
+# /usr/tmp likewise
+for ac_dir in . "$TMPDIR" /tmp /var/tmp /usr/tmp "$prefix/lib" "$exec_prefix/lib"; do
+ # Skip $TMPDIR if it is empty or bogus, and skip $exec_prefix/lib
+ # in the usual case where exec_prefix is '${prefix}'.
+ case $ac_dir in #(
+ . | /* | ?:[\\/]*) ;; #(
+ *) continue;;
+ esac
+ test -w "$ac_dir/." || continue # It is less confusing to not echo anything here.
+ ac_xdir=$ac_dir/cf$$
+ (umask 077 && mkdir "$ac_xdir" 2>/dev/null) || continue
+ ac_tf1=$ac_xdir/conftest9012345
+ ac_tf2=$ac_xdir/conftest9012346
+ touch "$ac_tf1" 2>/dev/null && test -f "$ac_tf1" && test ! -f "$ac_tf2" ||
+ ac_cv_sys_long_file_names=no
+ rm -f -r "$ac_xdir" 2>/dev/null
+ test $ac_cv_sys_long_file_names = no && break
+done
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_long_file_names" >&5
+$as_echo "$ac_cv_sys_long_file_names" >&6; }
+if test $ac_cv_sys_long_file_names = yes; then
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
+$as_echo "#define HAVE_LONG_FILE_NAMES 1" >>confdefs.h
- # Check for potential -arch flags. It is not universal unless
- # there are at least two -arch flags with different values.
- ac_arch=
- ac_prev=
- for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do
- if test -n "$ac_prev"; then
- case $ac_word in
- i?86 | x86_64 | ppc | ppc64)
- if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then
- ac_arch=$ac_word
- else
- ac_cv_c_bigendian=universal
- break
- fi
- ;;
- esac
- ac_prev=
- elif test "x$ac_word" = "x-arch"; then
- ac_prev=arch
- fi
- done
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- if test $ac_cv_c_bigendian = unknown; then
- # See if sys/param.h defines the BYTE_ORDER macro.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- #include <sys/param.h>
-int
-main ()
-{
-#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \
- && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \
- && LITTLE_ENDIAN)
- bogus endian macros
- #endif
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- # It does; now see whether it defined to BIG_ENDIAN or not.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- #include <sys/param.h>
+#### Choose a window system.
-int
-main ()
-{
-#if BYTE_ORDER != BIG_ENDIAN
- not big endian
- #endif
+## We leave window_system equal to none if
+## we end up building without one. Any new window system should
+## set window_system to an appropriate value and add objects to
+## window-system-specific substs.
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_bigendian=yes
-else
- ac_cv_c_bigendian=no
+window_system=none
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5
+$as_echo_n "checking for X... " >&6; }
+
+
+# Check whether --with-x was given.
+if test "${with_x+set}" = set; then :
+ withval=$with_x;
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
+if test "x$with_x" = xno; then
+ # The user explicitly disabled X.
+ have_x=disabled
+else
+ case $x_includes,$x_libraries in #(
+ *\'*) as_fn_error "cannot use X directory names containing '" "$LINENO" 5;; #(
+ *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ # One or both of the vars are not set, and there is no cached value.
+ac_x_includes=no ac_x_libraries=no
+rm -f -r conftest.dir
+if mkdir conftest.dir; then
+ cd conftest.dir
+ cat >Imakefile <<'_ACEOF'
+incroot:
+ @echo incroot='${INCROOT}'
+usrlibdir:
+ @echo usrlibdir='${USRLIBDIR}'
+libdir:
+ @echo libdir='${LIBDIR}'
+_ACEOF
+ if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then
+ # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+ for ac_var in incroot usrlibdir libdir; do
+ eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`"
+ done
+ # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
+ for ac_extension in a so sl dylib la dll; do
+ if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" &&
+ test -f "$ac_im_libdir/libX11.$ac_extension"; then
+ ac_im_usrlibdir=$ac_im_libdir; break
+ fi
+ done
+ # Screen out bogus values from the imake configuration. They are
+ # bogus both because they are the default anyway, and because
+ # using them would break gcc on systems where it needs fixed includes.
+ case $ac_im_incroot in
+ /usr/include) ac_x_includes= ;;
+ *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;;
+ esac
+ case $ac_im_usrlibdir in
+ /usr/lib | /usr/lib64 | /lib | /lib64) ;;
+ *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;;
+ esac
+ fi
+ cd ..
+ rm -f -r conftest.dir
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- fi
- if test $ac_cv_c_bigendian = unknown; then
- # See if <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris).
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <limits.h>
-int
-main ()
-{
-#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN)
- bogus endian macros
- #endif
+# Standard set of common directories for X headers.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+ac_x_header_dirs='
+/usr/X11/include
+/usr/X11R7/include
+/usr/X11R6/include
+/usr/X11R5/include
+/usr/X11R4/include
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- # It does; now see whether it defined to _BIG_ENDIAN or not.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/usr/include/X11
+/usr/include/X11R7
+/usr/include/X11R6
+/usr/include/X11R5
+/usr/include/X11R4
+
+/usr/local/X11/include
+/usr/local/X11R7/include
+/usr/local/X11R6/include
+/usr/local/X11R5/include
+/usr/local/X11R4/include
+
+/usr/local/include/X11
+/usr/local/include/X11R7
+/usr/local/include/X11R6
+/usr/local/include/X11R5
+/usr/local/include/X11R4
+
+/usr/X386/include
+/usr/x386/include
+/usr/XFree86/include/X11
+
+/usr/include
+/usr/local/include
+/usr/unsupported/include
+/usr/athena/include
+/usr/local/x11r5/include
+/usr/lpp/Xamples/include
+
+/usr/openwin/include
+/usr/openwin/share/include'
+
+if test "$ac_x_includes" = no; then
+ # Guess where to find include files, by looking for Xlib.h.
+ # First, try using that file with no special directory specified.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <limits.h>
+#include <X11/Xlib.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ # We can compile using X headers with no special include directory.
+ac_x_includes=
+else
+ for ac_dir in $ac_x_header_dirs; do
+ if test -r "$ac_dir/X11/Xlib.h"; then
+ ac_x_includes=$ac_dir
+ break
+ fi
+done
+fi
+rm -f conftest.err conftest.$ac_ext
+fi # $ac_x_includes = no
+if test "$ac_x_libraries" = no; then
+ # Check for the libraries.
+ # See if we find them without any special options.
+ # Don't add to $LIBS permanently.
+ ac_save_LIBS=$LIBS
+ LIBS="-lX11 $LIBS"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <X11/Xlib.h>
int
main ()
{
-#ifndef _BIG_ENDIAN
- not big endian
- #endif
-
+XrmInitialize ()
;
return 0;
}
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_bigendian=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ LIBS=$ac_save_LIBS
+# We can link X programs with no special library path.
+ac_x_libraries=
else
- ac_cv_c_bigendian=no
+ LIBS=$ac_save_LIBS
+for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g`
+do
+ # Don't even attempt the hair of trying to link an X program!
+ for ac_extension in a so sl dylib la dll; do
+ if test -r "$ac_dir/libX11.$ac_extension"; then
+ ac_x_libraries=$ac_dir
+ break 2
+ fi
+ done
+done
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi # $ac_x_libraries = no
+
+case $ac_x_includes,$ac_x_libraries in #(
+ no,* | *,no | *\'*)
+ # Didn't find X, or a directory has "'" in its name.
+ ac_cv_have_x="have_x=no";; #(
+ *)
+ # Record where we found X for the cache.
+ ac_cv_have_x="have_x=yes\
+ ac_x_includes='$ac_x_includes'\
+ ac_x_libraries='$ac_x_libraries'"
+esac
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+;; #(
+ *) have_x=yes;;
+ esac
+ eval "$ac_cv_have_x"
+fi # $with_x != no
+
+if test "$have_x" != yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5
+$as_echo "$have_x" >&6; }
+ no_x=yes
+else
+ # If each of the values was on the command line, it overrides each guess.
+ test "x$x_includes" = xNONE && x_includes=$ac_x_includes
+ test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
+ # Update the cache value to reflect the command line values.
+ ac_cv_have_x="have_x=yes\
+ ac_x_includes='$x_includes'\
+ ac_x_libraries='$x_libraries'"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5
+$as_echo "libraries $x_libraries, headers $x_includes" >&6; }
+fi
+
+if test "$no_x" != yes; then
+ window_system=x11
+fi
+
+LD_SWITCH_X_SITE_RPATH=
+if test "${x_libraries}" != NONE; then
+ if test -n "${x_libraries}"; then
+ LD_SWITCH_X_SITE=-L`echo ${x_libraries} | sed -e "s/:/ -L/g"`
+ LD_SWITCH_X_SITE_RPATH=-Wl,-rpath,`echo ${x_libraries} | sed -e "s/:/ -Wl,-rpath,/g"`
+ fi
+ x_default_search_path=""
+ x_search_path=${x_libraries}
+ if test -z "${x_search_path}"; then
+ x_search_path=/usr/lib
+ fi
+ for x_library in `echo ${x_search_path}: | \
+ sed -e "s/:/ /g" -e p -e "s:/lib[^ /]* :/share :g"`; do
+ x_search_path="\
+${x_library}/X11/%L/%T/%N%C%S:\
+${x_library}/X11/%l/%T/%N%C%S:\
+${x_library}/X11/%T/%N%C%S:\
+${x_library}/X11/%L/%T/%N%S:\
+${x_library}/X11/%l/%T/%N%S:\
+${x_library}/X11/%T/%N%S"
+ if test x"${x_default_search_path}" = x; then
+ x_default_search_path=${x_search_path}
+ else
+ x_default_search_path="${x_search_path}:${x_default_search_path}"
fi
- if test $ac_cv_c_bigendian = unknown; then
- # Compile a test program.
- if test "$cross_compiling" = yes; then :
- # Try to guess by grepping values from an object file.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-short int ascii_mm[] =
- { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
- short int ascii_ii[] =
- { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
- int use_ascii (int i) {
- return ascii_mm[i] + ascii_ii[i];
- }
- short int ebcdic_ii[] =
- { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
- short int ebcdic_mm[] =
- { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
- int use_ebcdic (int i) {
- return ebcdic_mm[i] + ebcdic_ii[i];
- }
- extern int foo;
+ done
+fi
-int
-main ()
-{
-return use_ascii (foo) == use_ebcdic (foo);
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then
- ac_cv_c_bigendian=yes
- fi
- if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
- if test "$ac_cv_c_bigendian" = unknown; then
- ac_cv_c_bigendian=no
- else
- # finding both strings is unlikely to happen, but who knows?
- ac_cv_c_bigendian=unknown
- fi
- fi
+
+if test "${x_includes}" != NONE && test -n "${x_includes}"; then
+ C_SWITCH_X_SITE="$isystem"`echo ${x_includes} | sed -e "s/:/ $isystem/g"`
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test x"${x_includes}" = x; then
+ bitmapdir=/usr/include/X11/bitmaps
+else
+ # accumulate include directories that have X11 bitmap subdirectories
+ bmd_acc="dummyval"
+ for bmd in `echo ${x_includes} | sed -e "s/:/ /g"`; do
+ if test -d "${bmd}/X11/bitmaps"; then
+ bmd_acc="${bmd_acc}:${bmd}/X11/bitmaps"
+ fi
+ if test -d "${bmd}/bitmaps"; then
+ bmd_acc="${bmd_acc}:${bmd}/bitmaps"
+ fi
+ done
+ if test ${bmd_acc} != "dummyval"; then
+ bitmapdir=`echo ${bmd_acc} | sed -e "s/^dummyval://"`
+ fi
+fi
+
+HAVE_NS=no
+NS_IMPL_COCOA=no
+NS_IMPL_GNUSTEP=no
+tmp_CPPFLAGS="$CPPFLAGS"
+tmp_CFLAGS="$CFLAGS"
+CPPFLAGS="$CPPFLAGS -x objective-c"
+CFLAGS="$CFLAGS -x objective-c"
+TEMACS_LDFLAGS2="\${LDFLAGS}"
+GNU_OBJC_CFLAGS=
+if test "${with_ns}" != no; then
+ if test "${opsys}" = darwin; then
+ NS_IMPL_COCOA=yes
+ ns_appdir=`pwd`/nextstep/Emacs.app
+ ns_appbindir=${ns_appdir}/Contents/MacOS
+ ns_appresdir=${ns_appdir}/Contents/Resources
+ ns_appsrc=Cocoa/Emacs.base
+ elif test -f $GNUSTEP_CONFIG_FILE; then
+ NS_IMPL_GNUSTEP=yes
+ ns_appdir=`pwd`/nextstep/Emacs.app
+ ns_appbindir=${ns_appdir}
+ ns_appresdir=${ns_appdir}/Resources
+ ns_appsrc=GNUstep/Emacs.base
+ GNUSTEP_SYSTEM_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_HEADERS)"
+ GNUSTEP_SYSTEM_LIBRARIES="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_LIBRARIES)"
+ GNUSTEP_LOCAL_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_LOCAL_HEADERS)"
+ GNUSTEP_LOCAL_LIBRARIES="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_LOCAL_LIBRARIES)"
+ test "x${GNUSTEP_LOCAL_HEADERS}" != "x" && \
+ GNUSTEP_LOCAL_HEADERS="-I${GNUSTEP_LOCAL_HEADERS}"
+ test "x${GNUSTEP_LOCAL_LIBRARIES}" != "x" && \
+ GNUSTEP_LOCAL_LIBRARIES="-L${GNUSTEP_LOCAL_LIBRARIES}"
+ CPPFLAGS="$CPPFLAGS -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
+ CFLAGS="$CFLAGS -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
+ LDFLAGS="$LDFLAGS -L${GNUSTEP_SYSTEM_LIBRARIES} ${GNUSTEP_LOCAL_LIBRARIES}"
+ LIB_STANDARD=
+ START_FILES=
+ TEMACS_LDFLAGS2=
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if GNUstep defines BASE_NATIVE_OBJC_EXCEPTIONS" >&5
+$as_echo_n "checking if GNUstep defines BASE_NATIVE_OBJC_EXCEPTIONS... " >&6; }
+if test "${emacs_cv_objc_exceptions+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-$ac_includes_default
+#include <GNUstepBase/GSConfig.h>
int
main ()
{
-
- /* Are we little or big endian? From Harbison&Steele. */
- union
- {
- long int l;
- char c[sizeof (long int)];
- } u;
- u.l = 1;
- return u.c[sizeof (long int) - 1] == 1;
-
+#if defined BASE_NATIVE_OBJC_EXCEPTIONS && BASE_NATIVE_OBJC_EXCEPTIONS > 0
+1;
+#else
+fail;
+#endif
;
return 0;
}
_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_c_bigendian=no
+if ac_fn_c_try_compile "$LINENO"; then :
+ emacs_cv_objc_exceptions=yes
else
- ac_cv_c_bigendian=yes
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
+ emacs_cv_objc_exceptions=no
fi
-
- fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
-$as_echo "$ac_cv_c_bigendian" >&6; }
- case $ac_cv_c_bigendian in #(
- yes)
- $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h
-;; #(
- no)
- ;; #(
- universal)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_objc_exceptions" >&5
+$as_echo "$emacs_cv_objc_exceptions" >&6; }
+ if test $emacs_cv_objc_exceptions = yes; then
-$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h
+$as_echo "#define _NATIVE_OBJC_EXCEPTIONS 1" >>confdefs.h
- ;; #(
- *)
- as_fn_error "unknown endianness
- presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;;
- esac
+ GNU_OBJC_CFLAGS="-fobjc-exceptions"
+ fi
+ fi
+ CFLAGS="$CFLAGS $GNU_OBJC_CFLAGS"
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __attribute__ ((__aligned__ (expr)))" >&5
-$as_echo_n "checking for __attribute__ ((__aligned__ (expr)))... " >&6; }
-if test "${emacs_cv_attribute_aligned+set}" = set; then :
- $as_echo_n "(cached) " >&6
+ ac_fn_c_check_header_mongrel "$LINENO" "AppKit/AppKit.h" "ac_cv_header_AppKit_AppKit_h" "$ac_includes_default"
+if test "x$ac_cv_header_AppKit_AppKit_h" = x""yes; then :
+ HAVE_NS=yes
else
+ as_fn_error "\`--with-ns' was specified, but the include
+ files are missing or cannot be compiled." "$LINENO" 5
+fi
+
+
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-char __attribute__ ((__aligned__ (1 << 3))) c;
+#include <Foundation/NSObjCRuntime.h>
int
main ()
{
-
+NSInteger i;
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_attribute_aligned=yes
+ ns_have_nsinteger=yes
else
- emacs_cv_attribute_aligned=no
+ ns_have_nsinteger=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_attribute_aligned" >&5
-$as_echo "$emacs_cv_attribute_aligned" >&6; }
-if test $emacs_cv_attribute_aligned = yes; then
+ if test $ns_have_nsinteger = yes; then
-$as_echo "#define HAVE_ATTRIBUTE_ALIGNED 1" >>confdefs.h
+$as_echo "#define NS_HAVE_NSINTEGER 1" >>confdefs.h
+ fi
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
-$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
-set x ${MAKE-make}
-ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'`
-if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then :
+
+INSTALL_ARCH_INDEP_EXTRA=install-etc
+ns_self_contained=no
+NS_OBJ=
+NS_OBJC_OBJ=
+if test "${HAVE_NS}" = yes; then
+ if test "$with_toolkit_scroll_bars" = "no"; then
+ as_fn_error "Non-toolkit scroll bars are not implemented for Nextstep." "$LINENO" 5
+ fi
+
+ window_system=nextstep
+ # set up packaging dirs
+ if test "${EN_NS_SELF_CONTAINED}" = yes; then
+ ns_self_contained=yes
+ prefix=${ns_appresdir}
+ exec_prefix=${ns_appbindir}
+ libexecdir="\${ns_appbindir}/libexec"
+ archlibdir="\${ns_appbindir}/libexec"
+ docdir="\${ns_appresdir}/etc"
+ etcdir="\${ns_appresdir}/etc"
+ infodir="\${ns_appresdir}/info"
+ mandir="\${ns_appresdir}/man"
+ lispdir="\${ns_appresdir}/lisp"
+ leimdir="\${ns_appresdir}/leim"
+ INSTALL_ARCH_INDEP_EXTRA=
+ fi
+ NS_OBJC_OBJ="nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o"
+fi
+CFLAGS="$tmp_CFLAGS"
+CPPFLAGS="$tmp_CPPFLAGS"
+
+
+
+
+
+
+## $window_system is now set to the window system we will
+## ultimately use.
+
+term_header=
+HAVE_X_WINDOWS=no
+HAVE_X11=no
+USE_X_TOOLKIT=none
+
+case "${window_system}" in
+ x11 )
+ HAVE_X_WINDOWS=yes
+ HAVE_X11=yes
+ term_header=xterm.h
+ case "${with_x_toolkit}" in
+ athena | lucid ) USE_X_TOOLKIT=LUCID ;;
+ motif ) USE_X_TOOLKIT=MOTIF ;;
+ gtk ) with_gtk=yes
+ term_header=gtkutil.h
+ USE_X_TOOLKIT=none ;;
+ gtk2 ) with_gtk2=yes
+ term_header=gtkutil.h
+ USE_X_TOOLKIT=none ;;
+ gtk3 ) with_gtk3=yes
+ term_header=gtkutil.h
+ USE_X_TOOLKIT=none ;;
+ no ) USE_X_TOOLKIT=none ;;
+ * ) USE_X_TOOLKIT=maybe ;;
+ esac
+ ;;
+ nextstep )
+ term_header=nsterm.h
+ ;;
+esac
+
+if test -n "${term_header}"; then
+
+cat >>confdefs.h <<_ACEOF
+#define TERM_HEADER "${term_header}"
+_ACEOF
+
+fi
+
+if test "$window_system" = none && test "X$with_x" != "Xno"; then
+ # Extract the first word of "X", so it can be a program name with args.
+set dummy X; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_HAVE_XSERVER+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat >conftest.make <<\_ACEOF
-SHELL = /bin/sh
-all:
- @echo '@@@%%%=$(MAKE)=@@@%%%'
-_ACEOF
-# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
-case `${MAKE-make} -f conftest.make 2>/dev/null` in
- *@@@%%%=?*=@@@%%%*)
- eval ac_cv_prog_make_${ac_make}_set=yes;;
- *)
- eval ac_cv_prog_make_${ac_make}_set=no;;
-esac
-rm -f conftest.make
+ if test -n "$HAVE_XSERVER"; then
+ ac_cv_prog_HAVE_XSERVER="$HAVE_XSERVER" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ ac_cv_prog_HAVE_XSERVER="true"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+ test -z "$ac_cv_prog_HAVE_XSERVER" && ac_cv_prog_HAVE_XSERVER="false"
fi
-if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- SET_MAKE=
+fi
+HAVE_XSERVER=$ac_cv_prog_HAVE_XSERVER
+if test -n "$HAVE_XSERVER"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $HAVE_XSERVER" >&5
+$as_echo "$HAVE_XSERVER" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
- SET_MAKE="MAKE=${MAKE-make}"
fi
-DEPFLAGS=
-MKDEPDIR=":"
-deps_frag=deps.mk
-if test "$GCC" = yes && test "$ac_enable_autodepend" = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using GNU Make" >&5
-$as_echo_n "checking whether we are using GNU Make... " >&6; }
- HAVE_GNU_MAKE=no
- testval=`${MAKE-make} --version 2>/dev/null | grep 'GNU Make'`
- if test "x$testval" != x; then
- HAVE_GNU_MAKE=yes
- else
- ac_enable_autodepend=no
+ if test "$HAVE_XSERVER" = true ||
+ test -n "$DISPLAY" ||
+ test "`echo /usr/lib/libX11.*`" != "/usr/lib/libX11.*"; then
+ as_fn_error "You seem to be running X, but no X development libraries
+were found. You should install the relevant development files for X
+and for the toolkit you want, such as Gtk+, Lesstif or Motif. Also make
+sure you have development files for image handling, i.e.
+tiff, gif, jpeg, png and xpm.
+If you are sure you want Emacs compiled without X window support, pass
+ --without-x
+to configure." "$LINENO" 5
fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $HAVE_GNU_MAKE" >&5
-$as_echo "$HAVE_GNU_MAKE" >&6; }
- if test $HAVE_GNU_MAKE = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -MMD -MF" >&5
-$as_echo_n "checking whether gcc understands -MMD -MF... " >&6; }
- SAVE_CFLAGS="$CFLAGS"
- CFLAGS="$CFLAGS -MMD -MF deps.d -MP"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+fi
+
+### If we're using X11, we should use the X menu package.
+HAVE_MENUS=no
+case ${HAVE_X11} in
+ yes ) HAVE_MENUS=yes ;;
+esac
+# Does the opsystem file prohibit the use of the GNU malloc?
+# Assume not, until told otherwise.
+GNU_MALLOC=yes
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether malloc is Doug Lea style" >&5
+$as_echo_n "checking whether malloc is Doug Lea style... " >&6; }
+if test "${emacs_cv_var_doug_lea_malloc+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <malloc.h>
+ static void hook (void) {}
int
main ()
{
-
+malloc_set_state (malloc_get_state ());
+ __after_morecore_hook = hook;
+ __malloc_initialize_hook = hook;
;
return 0;
}
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
-
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_var_doug_lea_malloc=yes
else
- ac_enable_autodepend=no
+ emacs_cv_var_doug_lea_malloc=no
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- CFLAGS="$SAVE_CFLAGS"
- test -f deps.d || ac_enable_autodepend=no
- rm -rf deps.d
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_enable_autodepend" >&5
-$as_echo "$ac_enable_autodepend" >&6; }
- fi
- if test $ac_enable_autodepend = yes; then
- DEPFLAGS='-MMD -MF ${DEPDIR}/$*.d -MP'
- ## In parallel builds, another make might create depdir between
- ## the first test and mkdir, so stick another test on the end.
- ## Or use install-sh -d? mkdir -p is not portable.
- MKDEPDIR='test -d ${DEPDIR} || mkdir ${DEPDIR} || test -d ${DEPDIR}'
- deps_frag=autodeps.mk
- fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
-deps_frag=$srcdir/src/$deps_frag
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_var_doug_lea_malloc" >&5
+$as_echo "$emacs_cv_var_doug_lea_malloc" >&6; }
+doug_lea_malloc=$emacs_cv_var_doug_lea_malloc
+system_malloc=no
+case "$opsys" in
+ ## darwin ld insists on the use of malloc routines in the System framework.
+ darwin|sol2-10) system_malloc=yes ;;
+esac
+if test "${system_malloc}" = "yes"; then
+$as_echo "#define SYSTEM_MALLOC 1" >>confdefs.h
-lisp_frag=$srcdir/src/lisp.mk
+ GNU_MALLOC=no
+ GNU_MALLOC_reason="
+ (The GNU allocators don't work with this system configuration.)"
+ GMALLOC_OBJ=
+ VMLIMIT_OBJ=
+else
+ test "$doug_lea_malloc" != "yes" && GMALLOC_OBJ=gmalloc.o
+ VMLIMIT_OBJ=vm-limit.o
+fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for long file names" >&5
-$as_echo_n "checking for long file names... " >&6; }
-if test "${ac_cv_sys_long_file_names+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_cv_sys_long_file_names=yes
-# Test for long file names in all the places we know might matter:
-# . the current directory, where building will happen
-# $prefix/lib where we will be installing things
-# $exec_prefix/lib likewise
-# $TMPDIR if set, where it might want to write temporary files
-# /tmp where it might want to write temporary files
-# /var/tmp likewise
-# /usr/tmp likewise
-for ac_dir in . "$TMPDIR" /tmp /var/tmp /usr/tmp "$prefix/lib" "$exec_prefix/lib"; do
- # Skip $TMPDIR if it is empty or bogus, and skip $exec_prefix/lib
- # in the usual case where exec_prefix is '${prefix}'.
- case $ac_dir in #(
- . | /* | ?:[\\/]*) ;; #(
- *) continue;;
+if test "$doug_lea_malloc" = "yes" ; then
+ if test "$GNU_MALLOC" = yes ; then
+ GNU_MALLOC_reason="
+ (Using Doug Lea's new malloc from the GNU C Library.)"
+ fi
+
+$as_echo "#define DOUG_LEA_MALLOC 1" >>confdefs.h
+
+
+ ## Use mmap directly for allocating larger buffers.
+ ## FIXME this comes from src/s/{gnu,gnu-linux}.h:
+ ## #ifdef DOUG_LEA_MALLOC; #undef REL_ALLOC; #endif
+ ## Does the AC_FUNC_MMAP test below make this check unnecessary?
+ case "$opsys" in
+ gnu*) REL_ALLOC=no ;;
esac
- test -w "$ac_dir/." || continue # It is less confusing to not echo anything here.
- ac_xdir=$ac_dir/cf$$
- (umask 077 && mkdir "$ac_xdir" 2>/dev/null) || continue
- ac_tf1=$ac_xdir/conftest9012345
- ac_tf2=$ac_xdir/conftest9012346
- touch "$ac_tf1" 2>/dev/null && test -f "$ac_tf1" && test ! -f "$ac_tf2" ||
- ac_cv_sys_long_file_names=no
- rm -f -r "$ac_xdir" 2>/dev/null
- test $ac_cv_sys_long_file_names = no && break
-done
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_long_file_names" >&5
-$as_echo "$ac_cv_sys_long_file_names" >&6; }
-if test $ac_cv_sys_long_file_names = yes; then
-
-$as_echo "#define HAVE_LONG_FILE_NAMES 1" >>confdefs.h
+if test x"${REL_ALLOC}" = x; then
+ REL_ALLOC=${GNU_MALLOC}
fi
+use_mmap_for_buffers=no
+case "$opsys" in
+ cygwin|freebsd|irix6-5) use_mmap_for_buffers=yes ;;
+esac
-#### Choose a window system.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5
-$as_echo_n "checking for X... " >&6; }
-# Check whether --with-x was given.
-if test "${with_x+set}" = set; then :
- withval=$with_x;
+
+
+
+
+for ac_func in getpagesize
+do :
+ ac_fn_c_check_func "$LINENO" "getpagesize" "ac_cv_func_getpagesize"
+if test "x$ac_cv_func_getpagesize" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_GETPAGESIZE 1
+_ACEOF
+
fi
+done
-# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
-if test "x$with_x" = xno; then
- # The user explicitly disabled X.
- have_x=disabled
-else
- case $x_includes,$x_libraries in #(
- *\'*) as_fn_error "cannot use X directory names containing '" "$LINENO" 5;; #(
- *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mmap" >&5
+$as_echo_n "checking for working mmap... " >&6; }
+if test "${ac_cv_func_mmap_fixed_mapped+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- # One or both of the vars are not set, and there is no cached value.
-ac_x_includes=no ac_x_libraries=no
-rm -f -r conftest.dir
-if mkdir conftest.dir; then
- cd conftest.dir
- cat >Imakefile <<'_ACEOF'
-incroot:
- @echo incroot='${INCROOT}'
-usrlibdir:
- @echo usrlibdir='${USRLIBDIR}'
-libdir:
- @echo libdir='${LIBDIR}'
-_ACEOF
- if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then
- # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
- for ac_var in incroot usrlibdir libdir; do
- eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`"
- done
- # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
- for ac_extension in a so sl dylib la dll; do
- if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" &&
- test -f "$ac_im_libdir/libX11.$ac_extension"; then
- ac_im_usrlibdir=$ac_im_libdir; break
- fi
- done
- # Screen out bogus values from the imake configuration. They are
- # bogus both because they are the default anyway, and because
- # using them would break gcc on systems where it needs fixed includes.
- case $ac_im_incroot in
- /usr/include) ac_x_includes= ;;
- *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;;
- esac
- case $ac_im_usrlibdir in
- /usr/lib | /usr/lib64 | /lib | /lib64) ;;
- *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;;
- esac
- fi
- cd ..
- rm -f -r conftest.dir
-fi
+ if test "$cross_compiling" = yes; then :
+ ac_cv_func_mmap_fixed_mapped=no
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+/* malloc might have been renamed as rpl_malloc. */
+#undef malloc
-# Standard set of common directories for X headers.
-# Check X11 before X11Rn because it is often a symlink to the current release.
-ac_x_header_dirs='
-/usr/X11/include
-/usr/X11R7/include
-/usr/X11R6/include
-/usr/X11R5/include
-/usr/X11R4/include
+/* Thanks to Mike Haertel and Jim Avera for this test.
+ Here is a matrix of mmap possibilities:
+ mmap private not fixed
+ mmap private fixed at somewhere currently unmapped
+ mmap private fixed at somewhere already mapped
+ mmap shared not fixed
+ mmap shared fixed at somewhere currently unmapped
+ mmap shared fixed at somewhere already mapped
+ For private mappings, we should verify that changes cannot be read()
+ back from the file, nor mmap's back from the file at a different
+ address. (There have been systems where private was not correctly
+ implemented like the infamous i386 svr4.0, and systems where the
+ VM page cache was not coherent with the file system buffer cache
+ like early versions of FreeBSD and possibly contemporary NetBSD.)
+ For shared mappings, we should conversely verify that changes get
+ propagated back to all the places they're supposed to be.
-/usr/include/X11
-/usr/include/X11R7
-/usr/include/X11R6
-/usr/include/X11R5
-/usr/include/X11R4
+ Grep wants private fixed already mapped.
+ The main things grep needs to know about mmap are:
+ * does it exist and is it safe to write into the mmap'd area
+ * how to use it (BSD variants) */
-/usr/local/X11/include
-/usr/local/X11R7/include
-/usr/local/X11R6/include
-/usr/local/X11R5/include
-/usr/local/X11R4/include
+#include <fcntl.h>
+#include <sys/mman.h>
-/usr/local/include/X11
-/usr/local/include/X11R7
-/usr/local/include/X11R6
-/usr/local/include/X11R5
-/usr/local/include/X11R4
+#if !defined STDC_HEADERS && !defined HAVE_STDLIB_H
+char *malloc ();
+#endif
-/usr/X386/include
-/usr/x386/include
-/usr/XFree86/include/X11
+/* This mess was copied from the GNU getpagesize.h. */
+#ifndef HAVE_GETPAGESIZE
+# ifdef _SC_PAGESIZE
+# define getpagesize() sysconf(_SC_PAGESIZE)
+# else /* no _SC_PAGESIZE */
+# ifdef HAVE_SYS_PARAM_H
+# include <sys/param.h>
+# ifdef EXEC_PAGESIZE
+# define getpagesize() EXEC_PAGESIZE
+# else /* no EXEC_PAGESIZE */
+# ifdef NBPG
+# define getpagesize() NBPG * CLSIZE
+# ifndef CLSIZE
+# define CLSIZE 1
+# endif /* no CLSIZE */
+# else /* no NBPG */
+# ifdef NBPC
+# define getpagesize() NBPC
+# else /* no NBPC */
+# ifdef PAGESIZE
+# define getpagesize() PAGESIZE
+# endif /* PAGESIZE */
+# endif /* no NBPC */
+# endif /* no NBPG */
+# endif /* no EXEC_PAGESIZE */
+# else /* no HAVE_SYS_PARAM_H */
+# define getpagesize() 8192 /* punt totally */
+# endif /* no HAVE_SYS_PARAM_H */
+# endif /* no _SC_PAGESIZE */
-/usr/include
-/usr/local/include
-/usr/unsupported/include
-/usr/athena/include
-/usr/local/x11r5/include
-/usr/lpp/Xamples/include
+#endif /* no HAVE_GETPAGESIZE */
+
+int
+main ()
+{
+ char *data, *data2, *data3;
+ const char *cdata2;
+ int i, pagesize;
+ int fd, fd2;
+
+ pagesize = getpagesize ();
+
+ /* First, make a file with some known garbage in it. */
+ data = (char *) malloc (pagesize);
+ if (!data)
+ return 1;
+ for (i = 0; i < pagesize; ++i)
+ *(data + i) = rand ();
+ umask (0);
+ fd = creat ("conftest.mmap", 0600);
+ if (fd < 0)
+ return 2;
+ if (write (fd, data, pagesize) != pagesize)
+ return 3;
+ close (fd);
+
+ /* Next, check that the tail of a page is zero-filled. File must have
+ non-zero length, otherwise we risk SIGBUS for entire page. */
+ fd2 = open ("conftest.txt", O_RDWR | O_CREAT | O_TRUNC, 0600);
+ if (fd2 < 0)
+ return 4;
+ cdata2 = "";
+ if (write (fd2, cdata2, 1) != 1)
+ return 5;
+ data2 = (char *) mmap (0, pagesize, PROT_READ | PROT_WRITE, MAP_SHARED, fd2, 0L);
+ if (data2 == MAP_FAILED)
+ return 6;
+ for (i = 0; i < pagesize; ++i)
+ if (*(data2 + i))
+ return 7;
+ close (fd2);
+ if (munmap (data2, pagesize))
+ return 8;
+
+ /* Next, try to mmap the file at a fixed address which already has
+ something else allocated at it. If we can, also make sure that
+ we see the same garbage. */
+ fd = open ("conftest.mmap", O_RDWR);
+ if (fd < 0)
+ return 9;
+ if (data2 != mmap (data2, pagesize, PROT_READ | PROT_WRITE,
+ MAP_PRIVATE | MAP_FIXED, fd, 0L))
+ return 10;
+ for (i = 0; i < pagesize; ++i)
+ if (*(data + i) != *(data2 + i))
+ return 11;
+
+ /* Finally, make sure that changes to the mapped area do not
+ percolate back to the file as seen by read(). (This is a bug on
+ some variants of i386 svr4.0.) */
+ for (i = 0; i < pagesize; ++i)
+ *(data2 + i) = *(data2 + i) + 1;
+ data3 = (char *) malloc (pagesize);
+ if (!data3)
+ return 12;
+ if (read (fd, data3, pagesize) != pagesize)
+ return 13;
+ for (i = 0; i < pagesize; ++i)
+ if (*(data + i) != *(data3 + i))
+ return 14;
+ close (fd);
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_func_mmap_fixed_mapped=yes
+else
+ ac_cv_func_mmap_fixed_mapped=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_mmap_fixed_mapped" >&5
+$as_echo "$ac_cv_func_mmap_fixed_mapped" >&6; }
+if test $ac_cv_func_mmap_fixed_mapped = yes; then
+
+$as_echo "#define HAVE_MMAP 1" >>confdefs.h
+
+fi
+rm -f conftest.mmap conftest.txt
-/usr/openwin/include
-/usr/openwin/share/include'
+if test $use_mmap_for_buffers = yes; then
-if test "$ac_x_includes" = no; then
- # Guess where to find include files, by looking for Xlib.h.
- # First, try using that file with no special directory specified.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <X11/Xlib.h>
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- # We can compile using X headers with no special include directory.
-ac_x_includes=
-else
- for ac_dir in $ac_x_header_dirs; do
- if test -r "$ac_dir/X11/Xlib.h"; then
- ac_x_includes=$ac_dir
- break
- fi
-done
+$as_echo "#define USE_MMAP_FOR_BUFFERS 1" >>confdefs.h
+
+ REL_ALLOC=no
fi
-rm -f conftest.err conftest.$ac_ext
-fi # $ac_x_includes = no
-if test "$ac_x_libraries" = no; then
- # Check for the libraries.
- # See if we find them without any special options.
- # Don't add to $LIBS permanently.
- ac_save_LIBS=$LIBS
- LIBS="-lX11 $LIBS"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+LIBS="$LIBS_SYSTEM $LIBS"
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5
+$as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; }
+if test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldnet $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <X11/Xlib.h>
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dnet_ntoa ();
int
main ()
{
-XrmInitialize ()
+return dnet_ntoa ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- LIBS=$ac_save_LIBS
-# We can link X programs with no special library path.
-ac_x_libraries=
+ ac_cv_lib_dnet_dnet_ntoa=yes
else
- LIBS=$ac_save_LIBS
-for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g`
-do
- # Don't even attempt the hair of trying to link an X program!
- for ac_extension in a so sl dylib la dll; do
- if test -r "$ac_dir/libX11.$ac_extension"; then
- ac_x_libraries=$ac_dir
- break 2
- fi
- done
-done
+ ac_cv_lib_dnet_dnet_ntoa=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-fi # $ac_x_libraries = no
-
-case $ac_x_includes,$ac_x_libraries in #(
- no,* | *,no | *\'*)
- # Didn't find X, or a directory has "'" in its name.
- ac_cv_have_x="have_x=no";; #(
- *)
- # Record where we found X for the cache.
- ac_cv_have_x="have_x=yes\
- ac_x_includes='$ac_x_includes'\
- ac_x_libraries='$ac_x_libraries'"
-esac
+LIBS=$ac_check_lib_save_LIBS
fi
-;; #(
- *) have_x=yes;;
- esac
- eval "$ac_cv_have_x"
-fi # $with_x != no
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_dnet_ntoa" >&5
+$as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; }
+if test "x$ac_cv_lib_dnet_dnet_ntoa" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBDNET 1
+_ACEOF
-if test "$have_x" != yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5
-$as_echo "$have_x" >&6; }
- no_x=yes
-else
- # If each of the values was on the command line, it overrides each guess.
- test "x$x_includes" = xNONE && x_includes=$ac_x_includes
- test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
- # Update the cache value to reflect the command line values.
- ac_cv_have_x="have_x=yes\
- ac_x_includes='$x_includes'\
- ac_x_libraries='$x_libraries'"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5
-$as_echo "libraries $x_libraries, headers $x_includes" >&6; }
-fi
+ LIBS="-ldnet $LIBS"
-if test "$no_x" = yes; then
- window_system=none
-else
- window_system=x11
fi
-## Workaround for bug in autoconf <= 2.62.
-## http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg01551.html
-## No need to do anything special for these standard directories.
-if test -n "${x_libraries}" && test x"${x_libraries}" != xNONE; then
- x_libraries=`echo :${x_libraries}: | sed -e 's|:/usr/lib64:|:|g' -e 's|:/lib64:|:|g' -e 's|^:||' -e 's|:$||'`
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lXbsd" >&5
+$as_echo_n "checking for main in -lXbsd... " >&6; }
+if test "${ac_cv_lib_Xbsd_main+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lXbsd $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-fi
-LD_SWITCH_X_SITE_AUX=
-LD_SWITCH_X_SITE_AUX_RPATH=
-if test "${x_libraries}" != NONE; then
- if test -n "${x_libraries}"; then
- LD_SWITCH_X_SITE=-L`echo ${x_libraries} | sed -e "s/:/ -L/g"`
- LD_SWITCH_X_SITE_AUX=-R`echo ${x_libraries} | sed -e "s/:/ -R/g"`
- LD_SWITCH_X_SITE_AUX_RPATH=`echo ${LD_SWITCH_X_SITE_AUX} | sed -e 's/-R/-Wl,-rpath,/'`
- fi
- x_default_search_path=""
- x_search_path=${x_libraries}
- if test -z "${x_search_path}"; then
- x_search_path=/usr/lib
- fi
- for x_library in `echo ${x_search_path}: | \
- sed -e "s/:/ /g" -e p -e "s:/lib[^ /]* :/share :g"`; do
- x_search_path="\
-${x_library}/X11/%L/%T/%N%C%S:\
-${x_library}/X11/%l/%T/%N%C%S:\
-${x_library}/X11/%T/%N%C%S:\
-${x_library}/X11/%L/%T/%N%S:\
-${x_library}/X11/%l/%T/%N%S:\
-${x_library}/X11/%T/%N%S"
- if test x"${x_default_search_path}" = x; then
- x_default_search_path=${x_search_path}
- else
- x_default_search_path="${x_search_path}:${x_default_search_path}"
- fi
- done
+int
+main ()
+{
+return main ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_Xbsd_main=yes
+else
+ ac_cv_lib_Xbsd_main=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xbsd_main" >&5
+$as_echo "$ac_cv_lib_Xbsd_main" >&6; }
+if test "x$ac_cv_lib_Xbsd_main" = x""yes; then :
+ LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd"
fi
+LIB_PTHREAD=
-if test "${x_includes}" != NONE && test -n "${x_includes}"; then
- C_SWITCH_X_SITE=-I`echo ${x_includes} | sed -e "s/:/ -I/g"`
-fi
-if test x"${x_includes}" = x; then
- bitmapdir=/usr/include/X11/bitmaps
-else
- # accumulate include directories that have X11 bitmap subdirectories
- bmd_acc="dummyval"
- for bmd in `echo ${x_includes} | sed -e "s/:/ /g"`; do
- if test -d "${bmd}/X11/bitmaps"; then
- bmd_acc="${bmd_acc}:${bmd}/X11/bitmaps"
- fi
- if test -d "${bmd}/bitmaps"; then
- bmd_acc="${bmd_acc}:${bmd}/bitmaps"
- fi
- done
- if test ${bmd_acc} != "dummyval"; then
- bitmapdir=`echo ${bmd_acc} | sed -e "s/^dummyval://"`
+
+if test "$ac_cv_header_pthread_h"; then
+ if test "$GMALLOC_OBJ" = gmalloc.o; then
+ emacs_pthread_function=pthread_atfork
+ else
+ emacs_pthread_function=pthread_self
fi
-fi
+ as_ac_Lib=`$as_echo "ac_cv_lib_pthread_$emacs_pthread_function" | $as_tr_sh`
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $emacs_pthread_function in -lpthread" >&5
+$as_echo_n "checking for $emacs_pthread_function in -lpthread... " >&6; }
+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lpthread $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-HAVE_NS=no
-NS_IMPL_COCOA=no
-NS_IMPL_GNUSTEP=no
-tmp_CPPFLAGS="$CPPFLAGS"
-tmp_CFLAGS="$CFLAGS"
-CPPFLAGS="$CPPFLAGS -x objective-c"
-CFLAGS="$CFLAGS -x objective-c"
-TEMACS_LDFLAGS2="\${LDFLAGS}"
-GNU_OBJC_CFLAGS=
-if test "${with_ns}" != no; then
- if test "${opsys}" = darwin; then
- NS_IMPL_COCOA=yes
- ns_appdir=`pwd`/nextstep/Emacs.app
- ns_appbindir=${ns_appdir}/Contents/MacOS/
- ns_appresdir=${ns_appdir}/Contents/Resources
- ns_appsrc=${srcdir}/nextstep/Cocoa/Emacs.base
- elif test -f $GNUSTEP_CONFIG_FILE; then
- NS_IMPL_GNUSTEP=yes
- ns_appdir=`pwd`/nextstep/Emacs.app
- ns_appbindir=${ns_appdir}/
- ns_appresdir=${ns_appdir}/Resources
- ns_appsrc=${srcdir}/nextstep/GNUstep/Emacs.base
- GNUSTEP_SYSTEM_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_HEADERS)"
- GNUSTEP_SYSTEM_LIBRARIES="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_LIBRARIES)"
- GNUSTEP_LOCAL_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_LOCAL_HEADERS)"
- GNUSTEP_LOCAL_LIBRARIES="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_LOCAL_LIBRARIES)"
- test "x${GNUSTEP_LOCAL_HEADERS}" != "x" && \
- GNUSTEP_LOCAL_HEADERS="-I${GNUSTEP_LOCAL_HEADERS}"
- test "x${GNUSTEP_LOCAL_LIBRARIES}" != "x" && \
- GNUSTEP_LOCAL_LIBRARIES="-L${GNUSTEP_LOCAL_LIBRARIES}"
- CPPFLAGS="$CPPFLAGS -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
- CFLAGS="$CFLAGS -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
- LDFLAGS="$LDFLAGS -L${GNUSTEP_SYSTEM_LIBRARIES} ${GNUSTEP_LOCAL_LIBRARIES}"
- LIB_STANDARD=
- START_FILES=
- TEMACS_LDFLAGS2=
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking if GNUstep defines BASE_NATIVE_OBJC_EXCEPTIONS" >&5
-$as_echo_n "checking if GNUstep defines BASE_NATIVE_OBJC_EXCEPTIONS... " >&6; }
-if test "${emacs_cv_objc_exceptions+set}" = set; then :
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char $emacs_pthread_function ();
+int
+main ()
+{
+return $emacs_pthread_function ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ eval "$as_ac_Lib=yes"
+else
+ eval "$as_ac_Lib=no"
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+eval ac_res=\$$as_ac_Lib
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+eval as_val=\$$as_ac_Lib
+ if test "x$as_val" = x""yes; then :
+ HAVE_PTHREAD=yes
+fi
+
+fi
+if test "$HAVE_PTHREAD" = yes; then
+ case "${canonical}" in
+ *-hpux*) ;;
+ *) LIB_PTHREAD="-lpthread"
+ LIBS="$LIB_PTHREAD $LIBS" ;;
+ esac
+
+$as_echo "#define HAVE_PTHREAD 1" >>confdefs.h
+
+fi
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cma_open in -lpthreads" >&5
+$as_echo_n "checking for cma_open in -lpthreads... " >&6; }
+if test "${ac_cv_lib_pthreads_cma_open+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lpthreads $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <GNUstepBase/GSConfig.h>
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char cma_open ();
int
main ()
{
-#if defined BASE_NATIVE_OBJC_EXCEPTIONS && BASE_NATIVE_OBJC_EXCEPTIONS > 0
-1;
-#else
-fail;
-#endif
+return cma_open ();
;
return 0;
}
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_objc_exceptions=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_pthreads_cma_open=yes
else
- emacs_cv_objc_exceptions=no
+ ac_cv_lib_pthreads_cma_open=no
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_objc_exceptions" >&5
-$as_echo "$emacs_cv_objc_exceptions" >&6; }
- if test $emacs_cv_objc_exceptions = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_cma_open" >&5
+$as_echo "$ac_cv_lib_pthreads_cma_open" >&6; }
+if test "x$ac_cv_lib_pthreads_cma_open" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBPTHREADS 1
+_ACEOF
-$as_echo "#define _NATIVE_OBJC_EXCEPTIONS 1" >>confdefs.h
+ LIBS="-lpthreads $LIBS"
- GNU_OBJC_CFLAGS="-fobjc-exceptions"
- fi
- fi
+fi
- CFLAGS="$CFLAGS $GNU_OBJC_CFLAGS"
- ac_fn_c_check_header_mongrel "$LINENO" "AppKit/AppKit.h" "ac_cv_header_AppKit_AppKit_h" "$ac_includes_default"
-if test "x$ac_cv_header_AppKit_AppKit_h" = x""yes; then :
- HAVE_NS=yes
+## Note: when using cpp in s/aix4.2.h, this definition depended on
+## HAVE_LIBPTHREADS. That was not defined earlier in configure when
+## the system file was sourced. Hence the value of LIBS_SYSTEM
+## added to LIBS in configure would never contain the pthreads part,
+## but the value used in Makefiles might. FIXME?
+##
+## -lpthreads seems to be necessary for Xlib in X11R6, and should
+## be harmless on older versions of X where it happens to exist.
+test "$opsys" = "aix4-2" && \
+ test $ac_cv_lib_pthreads_cma_open = yes && \
+ LIBS_SYSTEM="$LIBS_SYSTEM -lpthreads"
+
+
+case ${host_os} in
+aix*)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -bbigtoc option" >&5
+$as_echo_n "checking for -bbigtoc option... " >&6; }
+if test "${gdb_cv_bigtoc+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- as_fn_error "\`--with-ns' was specified, but the include
- files are missing or cannot be compiled." "$LINENO" 5
-fi
+ case $GCC in
+ yes) gdb_cv_bigtoc=-Wl,-bbigtoc ;;
+ *) gdb_cv_bigtoc=-bbigtoc ;;
+ esac
- NS_HAVE_NSINTEGER=yes
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ LDFLAGS=$LDFLAGS\ $gdb_cv_bigtoc
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <Foundation/NSObjCRuntime.h>
+
int
main ()
{
-NSInteger i;
+int i;
;
return 0;
}
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ns_have_nsinteger=yes
+if ac_fn_c_try_link "$LINENO"; then :
+
else
- ns_have_nsinteger=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- if test $ns_have_nsinteger = no; then
- NS_HAVE_NSINTEGER=no
- fi
+ gdb_cv_bigtoc=
fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
-
-ns_frag=/dev/null
-NS_OBJ=
-NS_OBJC_OBJ=
-if test "${HAVE_NS}" = yes; then
- if test "$with_toolkit_scroll_bars" = "no"; then
- as_fn_error "Non-toolkit scroll bars are not implemented for Nextstep." "$LINENO" 5
- fi
-
- window_system=nextstep
- with_xft=no
- # set up packaging dirs
- if test "${EN_NS_SELF_CONTAINED}" = yes; then
- prefix=${ns_appresdir}
- exec_prefix=${ns_appbindir}
- libexecdir=${ns_appbindir}/libexec
- fi
- ns_frag=$srcdir/src/ns.mk
- NS_OBJ="fontset.o fringe.o image.o"
- NS_OBJC_OBJ="nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o"
fi
-CFLAGS="$tmp_CFLAGS"
-CPPFLAGS="$tmp_CPPFLAGS"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gdb_cv_bigtoc" >&5
+$as_echo "$gdb_cv_bigtoc" >&6; }
+ ;;
+esac
+# Change CFLAGS and CPPFLAGS temporarily so that C_SWITCH_X_SITE gets
+# used for the tests that follow. We set them back to REAL_CFLAGS and
+# REAL_CPPFLAGS later on.
+REAL_CFLAGS="$CFLAGS"
+REAL_CPPFLAGS="$CPPFLAGS"
+if test "${HAVE_X11}" = "yes"; then
+ DEFS="$C_SWITCH_X_SITE $DEFS"
+ LDFLAGS="$LDFLAGS $LD_SWITCH_X_SITE"
+ LIBS="-lX11 $LIBS"
+ CFLAGS="$C_SWITCH_X_SITE $CFLAGS"
+ CPPFLAGS="$C_SWITCH_X_SITE $CPPFLAGS"
+ # On Solaris, arrange for LD_RUN_PATH to point to the X libraries for tests.
+ # This is handled by LD_SWITCH_X_SITE_RPATH during the real build,
+ # but it's more convenient here to set LD_RUN_PATH since this
+ # also works on hosts that don't understand LD_SWITCH_X_SITE_RPATH.
+ if test "${x_libraries}" != NONE && test -n "${x_libraries}"; then
+ LD_RUN_PATH=$x_libraries${LD_RUN_PATH+:}$LD_RUN_PATH
+ export LD_RUN_PATH
+ fi
-case "${window_system}" in
- x11 )
- HAVE_X_WINDOWS=yes
- HAVE_X11=yes
- case "${with_x_toolkit}" in
- athena | lucid ) USE_X_TOOLKIT=LUCID ;;
- motif ) USE_X_TOOLKIT=MOTIF ;;
- gtk ) with_gtk=yes
- USE_X_TOOLKIT=none ;;
- gtk3 ) with_gtk3=yes
- USE_X_TOOLKIT=none ;;
- no ) USE_X_TOOLKIT=none ;;
- * ) USE_X_TOOLKIT=maybe ;;
- esac
- ;;
- nextstep | none )
- HAVE_X_WINDOWS=no
- HAVE_X11=no
- USE_X_TOOLKIT=none
- ;;
-esac
+ if test "${opsys}" = "gnu-linux"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether X on GNU/Linux needs -b to link" >&5
+$as_echo_n "checking whether X on GNU/Linux needs -b to link... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-if test "$window_system" = none && test "X$with_x" != "Xno"; then
- # Extract the first word of "X", so it can be a program name with args.
-set dummy X; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_prog_HAVE_XSERVER+set}" = set; then :
- $as_echo_n "(cached) " >&6
+int
+main ()
+{
+XOpenDisplay ("foo");
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ xgnu_linux_first_failure=no
else
- if test -n "$HAVE_XSERVER"; then
- ac_cv_prog_HAVE_XSERVER="$HAVE_XSERVER" # Let the user override the test.
+ xgnu_linux_first_failure=yes
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ if test "${xgnu_linux_first_failure}" = "yes"; then
+ OLD_LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE"
+ OLD_C_SWITCH_X_SITE="$C_SWITCH_X_SITE"
+ OLD_CPPFLAGS="$CPPFLAGS"
+ OLD_LIBS="$LIBS"
+ LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout"
+ C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout"
+ CPPFLAGS="$CPPFLAGS -b i486-linuxaout"
+ LIBS="$LIBS -b i486-linuxaout"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+XOpenDisplay ("foo");
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ xgnu_linux_second_failure=no
else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_prog_HAVE_XSERVER="true"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
+ xgnu_linux_second_failure=yes
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ if test "${xgnu_linux_second_failure}" = "yes"; then
+ # If we get the same failure with -b, there is no use adding -b.
+ # So take it out. This plays safe.
+ LD_SWITCH_X_SITE="$OLD_LD_SWITCH_X_SITE"
+ C_SWITCH_X_SITE="$OLD_C_SWITCH_X_SITE"
+ CPPFLAGS="$OLD_CPPFLAGS"
+ LIBS="$OLD_LIBS"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ fi
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ fi
fi
-done
- done
-IFS=$as_save_IFS
- test -z "$ac_cv_prog_HAVE_XSERVER" && ac_cv_prog_HAVE_XSERVER="false"
-fi
-fi
-HAVE_XSERVER=$ac_cv_prog_HAVE_XSERVER
-if test -n "$HAVE_XSERVER"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $HAVE_XSERVER" >&5
-$as_echo "$HAVE_XSERVER" >&6; }
+ # Reportedly, some broken Solaris systems have XKBlib.h but are missing
+ # header files included from there.
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Xkb" >&5
+$as_echo_n "checking for Xkb... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <X11/Xlib.h>
+#include <X11/XKBlib.h>
+int
+main ()
+{
+XkbDescPtr kb = XkbGetKeyboard (0, XkbAllComponentsMask, XkbUseCoreKbd);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_xkb=yes
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ emacs_xkb=no
fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_xkb" >&5
+$as_echo "$emacs_xkb" >&6; }
+ if test $emacs_xkb = yes; then
+$as_echo "#define HAVE_XKBGETKEYBOARD 1" >>confdefs.h
- if test "$HAVE_XSERVER" = true ||
- test -n "$DISPLAY" ||
- test "`echo /usr/lib/libX11.*`" != "/usr/lib/libX11.*"; then
- as_fn_error "You seem to be running X, but no X development libraries
-were found. You should install the relevant development files for X
-and for the toolkit you want, such as Gtk+, Lesstif or Motif. Also make
-sure you have development files for image handling, i.e.
-tiff, gif, jpeg, png and xpm.
-If you are sure you want Emacs compiled without X window support, pass
- --without-x
-to configure." "$LINENO" 5
- fi
-fi
-
-### If we're using X11, we should use the X menu package.
-HAVE_MENUS=no
-case ${HAVE_X11} in
- yes ) HAVE_MENUS=yes ;;
-esac
+ fi
-# Do the opsystem or machine files prohibit the use of the GNU malloc?
-# Assume not, until told otherwise.
-GNU_MALLOC=yes
-doug_lea_malloc=yes
-ac_fn_c_check_func "$LINENO" "malloc_get_state" "ac_cv_func_malloc_get_state"
-if test "x$ac_cv_func_malloc_get_state" = x""yes; then :
+ for ac_func in XrmSetDatabase XScreenResourceString \
+XScreenNumberOfScreen
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
-else
- doug_lea_malloc=no
fi
+done
-ac_fn_c_check_func "$LINENO" "malloc_set_state" "ac_cv_func_malloc_set_state"
-if test "x$ac_cv_func_malloc_set_state" = x""yes; then :
-
-else
- doug_lea_malloc=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether __after_morecore_hook exists" >&5
-$as_echo_n "checking whether __after_morecore_hook exists... " >&6; }
-if test "${emacs_cv_var___after_morecore_hook+set}" = set; then :
+if test "${window_system}" = "x11"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 version 6" >&5
+$as_echo_n "checking X11 version 6... " >&6; }
+ if test "${emacs_cv_x11_version_6+set}" = set; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-extern void (* __after_morecore_hook)();
+#include <X11/Xlib.h>
int
main ()
{
-__after_morecore_hook = 0
+#if XlibSpecificationRelease < 6
+fail;
+#endif
+
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_var___after_morecore_hook=yes
+ emacs_cv_x11_version_6=yes
else
- emacs_cv_var___after_morecore_hook=no
+ emacs_cv_x11_version_6=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_var___after_morecore_hook" >&5
-$as_echo "$emacs_cv_var___after_morecore_hook" >&6; }
-if test $emacs_cv_var___after_morecore_hook = no; then
- doug_lea_malloc=no
-fi
+ if test $emacs_cv_x11_version_6 = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: 6 or newer" >&5
+$as_echo "6 or newer" >&6; }
-system_malloc=no
-case "$opsys" in
- ## darwin ld insists on the use of malloc routines in the System framework.
- darwin|sol2-10) system_malloc=yes ;;
-esac
+$as_echo "#define HAVE_X11R6 1" >>confdefs.h
-if test "${system_malloc}" = "yes"; then
-$as_echo "#define SYSTEM_MALLOC 1" >>confdefs.h
+$as_echo "#define HAVE_X_I18N 1" >>confdefs.h
- GNU_MALLOC=no
- GNU_MALLOC_reason="
- (The GNU allocators don't work with this system configuration.)"
- GMALLOC_OBJ=
- VMLIMIT_OBJ=
-else
- test "$doug_lea_malloc" != "yes" && GMALLOC_OBJ=gmalloc.o
- VMLIMIT_OBJ=vm-limit.o
+ ## inoue@ainet.or.jp says Solaris has a bug related to X11R6-style
+ ## XIM support.
+ case "$opsys" in
+ sol2-*) : ;;
+ *)
+$as_echo "#define HAVE_X11R6_XIM 1" >>confdefs.h
+
+ ;;
+ esac
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: before 6" >&5
+$as_echo "before 6" >&6; }
+ fi
fi
+### Use -lrsvg-2 if available, unless `--with-rsvg=no' is specified.
+HAVE_RSVG=no
+if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes"; then
+ if test "${with_rsvg}" != "no"; then
+ RSVG_REQUIRED=2.11.0
+ RSVG_MODULE="librsvg-2.0 >= $RSVG_REQUIRED"
-if test "$doug_lea_malloc" = "yes" ; then
- if test "$GNU_MALLOC" = yes ; then
- GNU_MALLOC_reason="
- (Using Doug Lea's new malloc from the GNU C Library.)"
+
+ succeeded=no
+
+ if test "$PKG_CONFIG" = "no" ; then
+ :
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $RSVG_MODULE" >&5
+$as_echo_n "checking for $RSVG_MODULE... " >&6; }
+
+ if $PKG_CONFIG --exists "$RSVG_MODULE" 2>&5 &&
+ RSVG_CFLAGS=`$PKG_CONFIG --cflags "$RSVG_MODULE" 2>&5` &&
+ RSVG_LIBS=`$PKG_CONFIG --libs "$RSVG_MODULE" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ RSVG_CFLAGS=`$as_echo "$RSVG_CFLAGS" | sed -e "$edit_cflags"`
+ RSVG_LIBS=`$as_echo "$RSVG_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$RSVG_CFLAGS' LIBS='$RSVG_LIBS'" >&5
+$as_echo "yes CFLAGS='$RSVG_CFLAGS' LIBS='$RSVG_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ RSVG_CFLAGS=""
+ RSVG_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ RSVG_PKG_ERRORS=`($PKG_CONFIG --print-errors "$RSVG_MODULE") 2>&1`
+
+ fi
+
+
+
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
fi
-$as_echo "#define DOUG_LEA_MALLOC 1" >>confdefs.h
+ if test $succeeded = yes; then
+ HAVE_RSVG=yes
+ else
+ :
+ fi
- ## Use mmap directly for allocating larger buffers.
- ## FIXME this comes from src/s/{gnu,gnu-linux}.h:
- ## #ifdef DOUG_LEA_MALLOC; #undef REL_ALLOC; #endif
- ## Does the AC_FUNC_MMAP test below make this check unnecessary?
- case "$opsys" in
- gnu*) REL_ALLOC=no ;;
- esac
-fi
-if test x"${REL_ALLOC}" = x; then
- REL_ALLOC=${GNU_MALLOC}
+
+ if test $HAVE_RSVG = yes; then
+
+$as_echo "#define HAVE_RSVG 1" >>confdefs.h
+
+ CFLAGS="$CFLAGS $RSVG_CFLAGS"
+ LIBS="$RSVG_LIBS $LIBS"
+ fi
+ fi
fi
-use_mmap_for_buffers=no
-case "$opsys" in
- cygwin|freebsd|irix6-5) use_mmap_for_buffers=yes ;;
-esac
+HAVE_IMAGEMAGICK=no
+if test "${HAVE_X11}" = "yes"; then
+ if test "${with_imagemagick}" != "no"; then
+ ## 6.2.8 is the earliest version known to work, but earlier versions
+ ## might work - let us know if you find one.
+ ## 6.0.7 does not work. See bug#7955.
+ IMAGEMAGICK_MODULE="Wand >= 6.2.8"
+
+ succeeded=no
+
+ if test "$PKG_CONFIG" = "no" ; then
+ :
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $IMAGEMAGICK_MODULE" >&5
+$as_echo_n "checking for $IMAGEMAGICK_MODULE... " >&6; }
+
+ if $PKG_CONFIG --exists "$IMAGEMAGICK_MODULE" 2>&5 &&
+ IMAGEMAGICK_CFLAGS=`$PKG_CONFIG --cflags "$IMAGEMAGICK_MODULE" 2>&5` &&
+ IMAGEMAGICK_LIBS=`$PKG_CONFIG --libs "$IMAGEMAGICK_MODULE" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ IMAGEMAGICK_CFLAGS=`$as_echo "$IMAGEMAGICK_CFLAGS" | sed -e "$edit_cflags"`
+ IMAGEMAGICK_LIBS=`$as_echo "$IMAGEMAGICK_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$IMAGEMAGICK_CFLAGS' LIBS='$IMAGEMAGICK_LIBS'" >&5
+$as_echo "yes CFLAGS='$IMAGEMAGICK_CFLAGS' LIBS='$IMAGEMAGICK_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ IMAGEMAGICK_CFLAGS=""
+ IMAGEMAGICK_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ IMAGEMAGICK_PKG_ERRORS=`($PKG_CONFIG --print-errors "$IMAGEMAGICK_MODULE") 2>&1`
+ fi
- for ac_header in $ac_header_list
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
+ fi
+
+ if test $succeeded = yes; then
+ HAVE_IMAGEMAGICK=yes
+ else
+ :
+ fi
+
+
+
+
+ if test $HAVE_IMAGEMAGICK = yes; then
+
+$as_echo "#define HAVE_IMAGEMAGICK 1" >>confdefs.h
+
+ CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS"
+ LIBS="$IMAGEMAGICK_LIBS $LIBS"
+ for ac_func in MagickExportImagePixels MagickMergeImageLayers
do :
- as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
-ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
-"
-eval as_val=\$$as_ac_Header
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
if test "x$as_val" = x""yes; then :
cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
+done
+
+ fi
+ fi
+fi
+
+
+HAVE_GTK=no
+GTK_OBJ=
+check_gtk2=no
+gtk3_pkg_errors=
+if test "${with_gtk3}" = "yes" || test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
+ GLIB_REQUIRED=2.28
+ GTK_REQUIRED=3.0
+ GTK_MODULES="gtk+-3.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
+
+
+ succeeded=no
-done
+ if test "$PKG_CONFIG" = "no" ; then
+ pkg_check_gtk=no
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $GTK_MODULES" >&5
+$as_echo_n "checking for $GTK_MODULES... " >&6; }
+ if $PKG_CONFIG --exists "$GTK_MODULES" 2>&5 &&
+ GTK_CFLAGS=`$PKG_CONFIG --cflags "$GTK_MODULES" 2>&5` &&
+ GTK_LIBS=`$PKG_CONFIG --libs "$GTK_MODULES" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GTK_CFLAGS=`$as_echo "$GTK_CFLAGS" | sed -e "$edit_cflags"`
+ GTK_LIBS=`$as_echo "$GTK_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&5
+$as_echo "yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ GTK_CFLAGS=""
+ GTK_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GTK_PKG_ERRORS=`($PKG_CONFIG --print-errors "$GTK_MODULES") 2>&1`
+ fi
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
+ fi
+ if test $succeeded = yes; then
+ pkg_check_gtk=yes
+ else
+ pkg_check_gtk=no
+ fi
+ if test "$pkg_check_gtk" = "no" && test "$with_gtk3" = "yes"; then
+ as_fn_error "$GTK_PKG_ERRORS" "$LINENO" 5
+ fi
+ if test "$pkg_check_gtk" = "yes"; then
-for ac_func in getpagesize
-do :
- ac_fn_c_check_func "$LINENO" "getpagesize" "ac_cv_func_getpagesize"
-if test "x$ac_cv_func_getpagesize" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_GETPAGESIZE 1
-_ACEOF
+$as_echo "#define HAVE_GTK3 1" >>confdefs.h
+ GTK_OBJ=emacsgtkfixed.o
+ term_header=gtkutil.h
+ USE_GTK_TOOLKIT="GTK3"
+ else
+ check_gtk2=yes
+ gtk3_pkg_errors="$GTK_PKG_ERRORS "
+ fi
fi
-done
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mmap" >&5
-$as_echo_n "checking for working mmap... " >&6; }
-if test "${ac_cv_func_mmap_fixed_mapped+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- if test "$cross_compiling" = yes; then :
- ac_cv_func_mmap_fixed_mapped=no
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-/* malloc might have been renamed as rpl_malloc. */
-#undef malloc
+if test "${with_gtk2}" = "yes" || test "$check_gtk2" = "yes"; then
+ GLIB_REQUIRED=2.10
+ GTK_REQUIRED=2.10
+ GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
-/* Thanks to Mike Haertel and Jim Avera for this test.
- Here is a matrix of mmap possibilities:
- mmap private not fixed
- mmap private fixed at somewhere currently unmapped
- mmap private fixed at somewhere already mapped
- mmap shared not fixed
- mmap shared fixed at somewhere currently unmapped
- mmap shared fixed at somewhere already mapped
- For private mappings, we should verify that changes cannot be read()
- back from the file, nor mmap's back from the file at a different
- address. (There have been systems where private was not correctly
- implemented like the infamous i386 svr4.0, and systems where the
- VM page cache was not coherent with the file system buffer cache
- like early versions of FreeBSD and possibly contemporary NetBSD.)
- For shared mappings, we should conversely verify that changes get
- propagated back to all the places they're supposed to be.
- Grep wants private fixed already mapped.
- The main things grep needs to know about mmap are:
- * does it exist and is it safe to write into the mmap'd area
- * how to use it (BSD variants) */
+ succeeded=no
-#include <fcntl.h>
-#include <sys/mman.h>
+ if test "$PKG_CONFIG" = "no" ; then
+ pkg_check_gtk=no
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $GTK_MODULES" >&5
+$as_echo_n "checking for $GTK_MODULES... " >&6; }
-#if !defined STDC_HEADERS && !defined HAVE_STDLIB_H
-char *malloc ();
-#endif
+ if $PKG_CONFIG --exists "$GTK_MODULES" 2>&5 &&
+ GTK_CFLAGS=`$PKG_CONFIG --cflags "$GTK_MODULES" 2>&5` &&
+ GTK_LIBS=`$PKG_CONFIG --libs "$GTK_MODULES" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GTK_CFLAGS=`$as_echo "$GTK_CFLAGS" | sed -e "$edit_cflags"`
+ GTK_LIBS=`$as_echo "$GTK_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&5
+$as_echo "yes CFLAGS='$GTK_CFLAGS' LIBS='$GTK_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ GTK_CFLAGS=""
+ GTK_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GTK_PKG_ERRORS=`($PKG_CONFIG --print-errors "$GTK_MODULES") 2>&1`
-/* This mess was copied from the GNU getpagesize.h. */
-#ifndef HAVE_GETPAGESIZE
-# ifdef _SC_PAGESIZE
-# define getpagesize() sysconf(_SC_PAGESIZE)
-# else /* no _SC_PAGESIZE */
-# ifdef HAVE_SYS_PARAM_H
-# include <sys/param.h>
-# ifdef EXEC_PAGESIZE
-# define getpagesize() EXEC_PAGESIZE
-# else /* no EXEC_PAGESIZE */
-# ifdef NBPG
-# define getpagesize() NBPG * CLSIZE
-# ifndef CLSIZE
-# define CLSIZE 1
-# endif /* no CLSIZE */
-# else /* no NBPG */
-# ifdef NBPC
-# define getpagesize() NBPC
-# else /* no NBPC */
-# ifdef PAGESIZE
-# define getpagesize() PAGESIZE
-# endif /* PAGESIZE */
-# endif /* no NBPC */
-# endif /* no NBPG */
-# endif /* no EXEC_PAGESIZE */
-# else /* no HAVE_SYS_PARAM_H */
-# define getpagesize() 8192 /* punt totally */
-# endif /* no HAVE_SYS_PARAM_H */
-# endif /* no _SC_PAGESIZE */
+ fi
-#endif /* no HAVE_GETPAGESIZE */
-int
-main ()
-{
- char *data, *data2, *data3;
- const char *cdata2;
- int i, pagesize;
- int fd, fd2;
- pagesize = getpagesize ();
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
+ fi
- /* First, make a file with some known garbage in it. */
- data = (char *) malloc (pagesize);
- if (!data)
- return 1;
- for (i = 0; i < pagesize; ++i)
- *(data + i) = rand ();
- umask (0);
- fd = creat ("conftest.mmap", 0600);
- if (fd < 0)
- return 2;
- if (write (fd, data, pagesize) != pagesize)
- return 3;
- close (fd);
+ if test $succeeded = yes; then
+ pkg_check_gtk=yes
+ else
+ pkg_check_gtk=no
+ fi
- /* Next, check that the tail of a page is zero-filled. File must have
- non-zero length, otherwise we risk SIGBUS for entire page. */
- fd2 = open ("conftest.txt", O_RDWR | O_CREAT | O_TRUNC, 0600);
- if (fd2 < 0)
- return 4;
- cdata2 = "";
- if (write (fd2, cdata2, 1) != 1)
- return 5;
- data2 = (char *) mmap (0, pagesize, PROT_READ | PROT_WRITE, MAP_SHARED, fd2, 0L);
- if (data2 == MAP_FAILED)
- return 6;
- for (i = 0; i < pagesize; ++i)
- if (*(data2 + i))
- return 7;
- close (fd2);
- if (munmap (data2, pagesize))
- return 8;
+ if test "$pkg_check_gtk" = "no" &&
+ { test "$with_gtk" = yes || test "$with_gtk2" = "yes"; }
+ then
+ as_fn_error "$gtk3_pkg_errors$GTK_PKG_ERRORS" "$LINENO" 5
+ fi
+ test "$pkg_check_gtk" = "yes" && USE_GTK_TOOLKIT="GTK2"
+fi
- /* Next, try to mmap the file at a fixed address which already has
- something else allocated at it. If we can, also make sure that
- we see the same garbage. */
- fd = open ("conftest.mmap", O_RDWR);
- if (fd < 0)
- return 9;
- if (data2 != mmap (data2, pagesize, PROT_READ | PROT_WRITE,
- MAP_PRIVATE | MAP_FIXED, fd, 0L))
- return 10;
- for (i = 0; i < pagesize; ++i)
- if (*(data + i) != *(data2 + i))
- return 11;
+if test x"$pkg_check_gtk" = xyes; then
- /* Finally, make sure that changes to the mapped area do not
- percolate back to the file as seen by read(). (This is a bug on
- some variants of i386 svr4.0.) */
- for (i = 0; i < pagesize; ++i)
- *(data2 + i) = *(data2 + i) + 1;
- data3 = (char *) malloc (pagesize);
- if (!data3)
- return 12;
- if (read (fd, data3, pagesize) != pagesize)
- return 13;
- for (i = 0; i < pagesize; ++i)
- if (*(data + i) != *(data3 + i))
- return 14;
- close (fd);
- return 0;
-}
+
+
+ C_SWITCH_X_SITE="$C_SWITCH_X_SITE $GTK_CFLAGS"
+ CFLAGS="$CFLAGS $GTK_CFLAGS"
+ LIBS="$GTK_LIBS $LIBS"
+ GTK_COMPILES=no
+ for ac_func in gtk_main
+do :
+ ac_fn_c_check_func "$LINENO" "gtk_main" "ac_cv_func_gtk_main"
+if test "x$ac_cv_func_gtk_main" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_GTK_MAIN 1
_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_func_mmap_fixed_mapped=yes
-else
- ac_cv_func_mmap_fixed_mapped=no
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
+ GTK_COMPILES=yes
fi
+done
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_mmap_fixed_mapped" >&5
-$as_echo "$ac_cv_func_mmap_fixed_mapped" >&6; }
-if test $ac_cv_func_mmap_fixed_mapped = yes; then
+ if test "${GTK_COMPILES}" != "yes"; then
+ if test "$USE_X_TOOLKIT" != "maybe"; then
+ as_fn_error "Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?" "$LINENO" 5;
+ fi
+ else
+ HAVE_GTK=yes
-$as_echo "#define HAVE_MMAP 1" >>confdefs.h
+$as_echo "#define USE_GTK 1" >>confdefs.h
+
+ GTK_OBJ="gtkutil.o $GTK_OBJ"
+ USE_X_TOOLKIT=none
+ if $PKG_CONFIG --atleast-version=2.10 gtk+-2.0; then
+ :
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Your version of Gtk+ will have problems with
+ closing open displays. This is no problem if you just use
+ one display, but if you use more than one and close one of them
+ Emacs may crash." >&5
+$as_echo "$as_me: WARNING: Your version of Gtk+ will have problems with
+ closing open displays. This is no problem if you just use
+ one display, but if you use more than one and close one of them
+ Emacs may crash." >&2;}
+ sleep 3
+ fi
+ fi
fi
-rm -f conftest.mmap conftest.txt
-if test $use_mmap_for_buffers = yes; then
-$as_echo "#define USE_MMAP_FOR_BUFFERS 1" >>confdefs.h
- REL_ALLOC=no
-fi
+if test "${HAVE_GTK}" = "yes"; then
-LIBS="$LIBS_SYSTEM $LIBS"
+ if test "$with_toolkit_scroll_bars" != no; then
+ with_toolkit_scroll_bars=yes
+ fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5
-$as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; }
-if test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then :
- $as_echo_n "(cached) " >&6
+ HAVE_GTK_FILE_SELECTION=no
+ ac_fn_c_check_decl "$LINENO" "GTK_TYPE_FILE_SELECTION" "ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" "$ac_includes_default
+#include <gtk/gtk.h>
+"
+if test "x$ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" = x""yes; then :
+ HAVE_GTK_FILE_SELECTION=yes
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-ldnet $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ HAVE_GTK_FILE_SELECTION=no
+fi
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char dnet_ntoa ();
-int
-main ()
-{
-return dnet_ntoa ();
- ;
- return 0;
-}
+ if test "$HAVE_GTK_FILE_SELECTION" = yes; then
+ for ac_func in gtk_file_selection_new
+do :
+ ac_fn_c_check_func "$LINENO" "gtk_file_selection_new" "ac_cv_func_gtk_file_selection_new"
+if test "x$ac_cv_func_gtk_file_selection_new" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_GTK_FILE_SELECTION_NEW 1
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_dnet_dnet_ntoa=yes
-else
- ac_cv_lib_dnet_dnet_ntoa=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_dnet_ntoa" >&5
-$as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; }
-if test "x$ac_cv_lib_dnet_dnet_ntoa" = x""yes; then :
+done
+
+ fi
+
+
+ for ac_func in gtk_widget_get_window gtk_widget_set_has_window \
+ gtk_dialog_get_action_area gtk_widget_get_sensitive \
+ gtk_widget_get_mapped gtk_adjustment_get_page_size \
+ gtk_orientable_set_orientation \
+ gtk_window_set_has_resize_grip
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
cat >>confdefs.h <<_ACEOF
-#define HAVE_LIBDNET 1
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
- LIBS="-ldnet $LIBS"
+fi
+done
+
+ term_header=gtkutil.h
fi
+HAVE_DBUS=no
+DBUS_OBJ=
+if test "${with_dbus}" = "yes"; then
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lXbsd" >&5
-$as_echo_n "checking for main in -lXbsd... " >&6; }
-if test "${ac_cv_lib_Xbsd_main+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXbsd $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ succeeded=no
+ if test "$PKG_CONFIG" = "no" ; then
+ HAVE_DBUS=no
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dbus-1 >= 1.0" >&5
+$as_echo_n "checking for dbus-1 >= 1.0... " >&6; }
-int
-main ()
-{
-return main ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xbsd_main=yes
-else
- ac_cv_lib_Xbsd_main=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xbsd_main" >&5
-$as_echo "$ac_cv_lib_Xbsd_main" >&6; }
-if test "x$ac_cv_lib_Xbsd_main" = x""yes; then :
- LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd"
-fi
+ if $PKG_CONFIG --exists "dbus-1 >= 1.0" 2>&5 &&
+ DBUS_CFLAGS=`$PKG_CONFIG --cflags "dbus-1 >= 1.0" 2>&5` &&
+ DBUS_LIBS=`$PKG_CONFIG --libs "dbus-1 >= 1.0" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ DBUS_CFLAGS=`$as_echo "$DBUS_CFLAGS" | sed -e "$edit_cflags"`
+ DBUS_LIBS=`$as_echo "$DBUS_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$DBUS_CFLAGS' LIBS='$DBUS_LIBS'" >&5
+$as_echo "yes CFLAGS='$DBUS_CFLAGS' LIBS='$DBUS_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ DBUS_CFLAGS=""
+ DBUS_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ DBUS_PKG_ERRORS=`($PKG_CONFIG --print-errors "dbus-1 >= 1.0") 2>&1`
+ fi
-LIB_PTHREAD=
-for ac_header in pthread.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "pthread.h" "ac_cv_header_pthread_h" "$ac_includes_default"
-if test "x$ac_cv_header_pthread_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_PTHREAD_H 1
-_ACEOF
-fi
-done
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
+ fi
-if test "$ac_cv_header_pthread_h"; then
- if test "$GMALLOC_OBJ" = gmalloc.o; then
- emacs_pthread_function=pthread_atfork
+ if test $succeeded = yes; then
+ HAVE_DBUS=yes
else
- emacs_pthread_function=pthread_self
+ HAVE_DBUS=no
fi
- as_ac_Lib=`$as_echo "ac_cv_lib_pthread_$emacs_pthread_function" | $as_tr_sh`
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $emacs_pthread_function in -lpthread" >&5
-$as_echo_n "checking for $emacs_pthread_function in -lpthread... " >&6; }
-if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lpthread $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char $emacs_pthread_function ();
-int
-main ()
-{
-return $emacs_pthread_function ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- eval "$as_ac_Lib=yes"
-else
- eval "$as_ac_Lib=no"
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-eval ac_res=\$$as_ac_Lib
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
-eval as_val=\$$as_ac_Lib
+ if test "$HAVE_DBUS" = yes; then
+ LIBS="$LIBS $DBUS_LIBS"
+
+$as_echo "#define HAVE_DBUS 1" >>confdefs.h
+
+ for ac_func in dbus_watch_get_unix_fd \
+ dbus_type_is_valid \
+ dbus_validate_bus_name \
+ dbus_validate_path \
+ dbus_validate_interface \
+ dbus_validate_member
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
if test "x$as_val" = x""yes; then :
- HAVE_PTHREAD=yes
-fi
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
fi
-if test "$HAVE_PTHREAD" = yes; then
- case "${canonical}" in
- *-hpux*) ;;
- *) LIB_PTHREAD="-lpthread"
- LIBS="$LIB_PTHREAD $LIBS" ;;
- esac
-
-$as_echo "#define HAVE_PTHREAD 1" >>confdefs.h
+done
+ DBUS_OBJ=dbusbind.o
+ fi
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cma_open in -lpthreads" >&5
-$as_echo_n "checking for cma_open in -lpthreads... " >&6; }
-if test "${ac_cv_lib_pthreads_cma_open+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lpthreads $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+HAVE_GSETTINGS=no
+if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char cma_open ();
-int
-main ()
-{
-return cma_open ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_pthreads_cma_open=yes
-else
- ac_cv_lib_pthreads_cma_open=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_cma_open" >&5
-$as_echo "$ac_cv_lib_pthreads_cma_open" >&6; }
-if test "x$ac_cv_lib_pthreads_cma_open" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_LIBPTHREADS 1
-_ACEOF
+ succeeded=no
- LIBS="-lpthreads $LIBS"
+ if test "$PKG_CONFIG" = "no" ; then
+ HAVE_GSETTINGS=no
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gio-2.0 >= 2.26" >&5
+$as_echo_n "checking for gio-2.0 >= 2.26... " >&6; }
-fi
+ if $PKG_CONFIG --exists "gio-2.0 >= 2.26" 2>&5 &&
+ GSETTINGS_CFLAGS=`$PKG_CONFIG --cflags "gio-2.0 >= 2.26" 2>&5` &&
+ GSETTINGS_LIBS=`$PKG_CONFIG --libs "gio-2.0 >= 2.26" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GSETTINGS_CFLAGS=`$as_echo "$GSETTINGS_CFLAGS" | sed -e "$edit_cflags"`
+ GSETTINGS_LIBS=`$as_echo "$GSETTINGS_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GSETTINGS_CFLAGS' LIBS='$GSETTINGS_LIBS'" >&5
+$as_echo "yes CFLAGS='$GSETTINGS_CFLAGS' LIBS='$GSETTINGS_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ GSETTINGS_CFLAGS=""
+ GSETTINGS_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GSETTINGS_PKG_ERRORS=`($PKG_CONFIG --print-errors "gio-2.0 >= 2.26") 2>&1`
+ fi
-## Note: when using cpp in s/aix4.2.h, this definition depended on
-## HAVE_LIBPTHREADS. That was not defined earlier in configure when
-## the system file was sourced. Hence the value of LIBS_SYSTEM
-## added to LIBS in configure would never contain the pthreads part,
-## but the value used in Makefiles might. FIXME?
-##
-## -lpthreads seems to be necessary for Xlib in X11R6, and should
-## be harmless on older versions of X where it happens to exist.
-test "$opsys" = "aix4-2" && \
- test $ac_cv_lib_pthreads_cma_open = yes && \
- LIBS_SYSTEM="$LIBS_SYSTEM -lpthreads"
-case ${host_os} in
-aix*)
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -bbigtoc option" >&5
-$as_echo_n "checking for -bbigtoc option... " >&6; }
-if test "${gdb_cv_bigtoc+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
+ fi
- case $GCC in
- yes) gdb_cv_bigtoc=-Wl,-bbigtoc ;;
- *) gdb_cv_bigtoc=-bbigtoc ;;
- esac
+ if test $succeeded = yes; then
+ HAVE_GSETTINGS=yes
+ else
+ HAVE_GSETTINGS=no
+ fi
- LDFLAGS=$LDFLAGS\ $gdb_cv_bigtoc
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ if test "$HAVE_GSETTINGS" = "yes"; then
-int
-main ()
-{
-int i;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
+$as_echo "#define HAVE_GSETTINGS 1" >>confdefs.h
-else
- gdb_cv_bigtoc=
+ SETTINGS_CFLAGS="$GSETTINGS_CFLAGS"
+ SETTINGS_LIBS="$GSETTINGS_LIBS"
+ fi
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gdb_cv_bigtoc" >&5
-$as_echo "$gdb_cv_bigtoc" >&6; }
- ;;
-esac
+HAVE_GCONF=no
+if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then
-# Change CFLAGS and CPPFLAGS temporarily so that C_SWITCH_X_SITE gets
-# used for the tests that follow. We set them back to REAL_CFLAGS and
-# REAL_CPPFLAGS later on.
+ succeeded=no
-REAL_CFLAGS="$CFLAGS"
-REAL_CPPFLAGS="$CPPFLAGS"
+ if test "$PKG_CONFIG" = "no" ; then
+ HAVE_GCONF=no
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gconf-2.0 >= 2.13" >&5
+$as_echo_n "checking for gconf-2.0 >= 2.13... " >&6; }
-if test "${HAVE_X11}" = "yes"; then
- DEFS="$C_SWITCH_X_SITE $DEFS"
- LDFLAGS="$LDFLAGS $LD_SWITCH_X_SITE"
- LIBS="-lX11 $LIBS"
- CFLAGS="$C_SWITCH_X_SITE $CFLAGS"
- CPPFLAGS="$C_SWITCH_X_SITE $CPPFLAGS"
+ if $PKG_CONFIG --exists "gconf-2.0 >= 2.13" 2>&5 &&
+ GCONF_CFLAGS=`$PKG_CONFIG --cflags "gconf-2.0 >= 2.13" 2>&5` &&
+ GCONF_LIBS=`$PKG_CONFIG --libs "gconf-2.0 >= 2.13" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GCONF_CFLAGS=`$as_echo "$GCONF_CFLAGS" | sed -e "$edit_cflags"`
+ GCONF_LIBS=`$as_echo "$GCONF_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GCONF_CFLAGS' LIBS='$GCONF_LIBS'" >&5
+$as_echo "yes CFLAGS='$GCONF_CFLAGS' LIBS='$GCONF_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ GCONF_CFLAGS=""
+ GCONF_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GCONF_PKG_ERRORS=`($PKG_CONFIG --print-errors "gconf-2.0 >= 2.13") 2>&1`
- # On Solaris, arrange for LD_RUN_PATH to point to the X libraries for tests.
- # This is handled by LD_SWITCH_X_SITE_AUX during the real build,
- # but it's more convenient here to set LD_RUN_PATH
- # since this also works on hosts that don't understand LD_SWITCH_X_SITE_AUX.
- if test "${x_libraries}" != NONE && test -n "${x_libraries}"; then
- LD_RUN_PATH=$x_libraries${LD_RUN_PATH+:}$LD_RUN_PATH
- export LD_RUN_PATH
+ fi
+
+
+
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
fi
- if test "${opsys}" = "gnu-linux"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether X on GNU/Linux needs -b to link" >&5
-$as_echo_n "checking whether X on GNU/Linux needs -b to link... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ if test $succeeded = yes; then
+ HAVE_GCONF=yes
+ else
+ HAVE_GCONF=no
+ fi
-int
-main ()
-{
-XOpenDisplay ("foo");
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- xgnu_linux_first_failure=no
-else
- xgnu_linux_first_failure=yes
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- if test "${xgnu_linux_first_failure}" = "yes"; then
- OLD_LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE"
- OLD_C_SWITCH_X_SITE="$C_SWITCH_X_SITE"
- OLD_CPPFLAGS="$CPPFLAGS"
- OLD_LIBS="$LIBS"
- LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout"
- C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout"
- CPPFLAGS="$CPPFLAGS -b i486-linuxaout"
- LIBS="$LIBS -b i486-linuxaout"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ if test "$HAVE_GCONF" = yes; then
-int
-main ()
-{
-XOpenDisplay ("foo");
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- xgnu_linux_second_failure=no
-else
- xgnu_linux_second_failure=yes
+$as_echo "#define HAVE_GCONF 1" >>confdefs.h
+
+ SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GCONF_CFLAGS"
+ SETTINGS_LIBS="$SETTINGS_LIBS $GCONF_LIBS"
+ fi
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- if test "${xgnu_linux_second_failure}" = "yes"; then
- # If we get the same failure with -b, there is no use adding -b.
- # So take it out. This plays safe.
- LD_SWITCH_X_SITE="$OLD_LD_SWITCH_X_SITE"
- C_SWITCH_X_SITE="$OLD_C_SWITCH_X_SITE"
- CPPFLAGS="$OLD_CPPFLAGS"
- LIBS="$OLD_LIBS"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- fi
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+
+if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then
+
+ succeeded=no
+
+ if test "$PKG_CONFIG" = "no" ; then
+ HAVE_GOBJECT=no
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gobject-2.0 >= 2.0" >&5
+$as_echo_n "checking for gobject-2.0 >= 2.0... " >&6; }
+
+ if $PKG_CONFIG --exists "gobject-2.0 >= 2.0" 2>&5 &&
+ GOBJECT_CFLAGS=`$PKG_CONFIG --cflags "gobject-2.0 >= 2.0" 2>&5` &&
+ GOBJECT_LIBS=`$PKG_CONFIG --libs "gobject-2.0 >= 2.0" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ GOBJECT_CFLAGS=`$as_echo "$GOBJECT_CFLAGS" | sed -e "$edit_cflags"`
+ GOBJECT_LIBS=`$as_echo "$GOBJECT_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$GOBJECT_CFLAGS' LIBS='$GOBJECT_LIBS'" >&5
+$as_echo "yes CFLAGS='$GOBJECT_CFLAGS' LIBS='$GOBJECT_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
- fi
- fi
+ GOBJECT_CFLAGS=""
+ GOBJECT_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ GOBJECT_PKG_ERRORS=`($PKG_CONFIG --print-errors "gobject-2.0 >= 2.0") 2>&1`
+
+ fi
- # Reportedly, some broken Solaris systems have XKBlib.h but are missing
- # header files included from there.
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Xkb" >&5
-$as_echo_n "checking for Xkb... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <X11/Xlib.h>
-#include <X11/XKBlib.h>
-int
-main ()
-{
-XkbDescPtr kb = XkbGetKeyboard (0, XkbAllComponentsMask, XkbUseCoreKbd);
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- emacs_xkb=yes
-else
- emacs_xkb=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_xkb" >&5
-$as_echo "$emacs_xkb" >&6; }
- if test $emacs_xkb = yes; then
-$as_echo "#define HAVE_XKBGETKEYBOARD 1" >>confdefs.h
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
fi
- for ac_func in XrmSetDatabase XScreenResourceString \
-XScreenNumberOfScreen XSetWMProtocols
+ if test $succeeded = yes; then
+ HAVE_GOBJECT=yes
+ else
+ HAVE_GOBJECT=no
+ fi
+
+ if test "$HAVE_GOBJECT" = "yes"; then
+ SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GOBJECT_CFLAGS"
+ SETTINGS_LIBS="$SETTINGS_LIBS $GOBJECT_LIBS"
+ fi
+ SAVE_CFLAGS="$CFLAGS"
+ SAVE_LIBS="$LIBS"
+ CFLAGS="$SETTINGS_CFLAGS $CFLAGS"
+ LIBS="$SETTINGS_LIBS $LIBS"
+ for ac_func in g_type_init
do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-eval as_val=\$$as_ac_var
- if test "x$as_val" = x""yes; then :
+ ac_fn_c_check_func "$LINENO" "g_type_init" "ac_cv_func_g_type_init"
+if test "x$ac_cv_func_g_type_init" = x""yes; then :
cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+#define HAVE_G_TYPE_INIT 1
_ACEOF
fi
done
+ CFLAGS="$SAVE_CFLAGS"
+ LIBS="$SAVE_LIBS"
fi
-if test "${window_system}" = "x11"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 version 6" >&5
-$as_echo_n "checking X11 version 6... " >&6; }
- if test "${emacs_cv_x11_version_6+set}" = set; then :
+
+
+
+HAVE_LIBSELINUX=no
+LIBSELINUX_LIBS=
+if test "${with_selinux}" = "yes"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lgetfilecon in -lselinux" >&5
+$as_echo_n "checking for lgetfilecon in -lselinux... " >&6; }
+if test "${ac_cv_lib_selinux_lgetfilecon+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lselinux $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <X11/Xlib.h>
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char lgetfilecon ();
int
main ()
{
-#if XlibSpecificationRelease < 6
-fail;
-#endif
-
+return lgetfilecon ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_x11_version_6=yes
+ ac_cv_lib_selinux_lgetfilecon=yes
else
- emacs_cv_x11_version_6=no
+ ac_cv_lib_selinux_lgetfilecon=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_selinux_lgetfilecon" >&5
+$as_echo "$ac_cv_lib_selinux_lgetfilecon" >&6; }
+if test "x$ac_cv_lib_selinux_lgetfilecon" = x""yes; then :
+ HAVE_LIBSELINUX=yes
+else
+ HAVE_LIBSELINUX=no
fi
- if test $emacs_cv_x11_version_6 = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: 6 or newer" >&5
-$as_echo "6 or newer" >&6; }
-
-$as_echo "#define HAVE_X11R6 1" >>confdefs.h
-
-
-$as_echo "#define HAVE_X_I18N 1" >>confdefs.h
+ if test "$HAVE_LIBSELINUX" = yes; then
- ## inoue@ainet.or.jp says Solaris has a bug related to X11R6-style
- ## XIM support.
- case "$opsys" in
- sol2-*) : ;;
- *)
-$as_echo "#define HAVE_X11R6_XIM 1" >>confdefs.h
+$as_echo "#define HAVE_LIBSELINUX 1" >>confdefs.h
- ;;
- esac
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: before 6" >&5
-$as_echo "before 6" >&6; }
- fi
+ LIBSELINUX_LIBS=-lselinux
+ fi
fi
-### Use -lrsvg-2 if available, unless `--with-rsvg=no' is specified.
-HAVE_RSVG=no
-if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes"; then
- if test "${with_rsvg}" != "no"; then
- RSVG_REQUIRED=2.11.0
- RSVG_MODULE="librsvg-2.0 >= $RSVG_REQUIRED"
-
+HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
+if test "${with_gnutls}" = "yes" ; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
- :
+ HAVE_GNUTLS=no
else
PKG_CONFIG_MIN_VERSION=0.9.0
if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $RSVG_MODULE" >&5
-$as_echo_n "checking for $RSVG_MODULE... " >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gnutls >= 2.6.6" >&5
+$as_echo_n "checking for gnutls >= 2.6.6... " >&6; }
- if $PKG_CONFIG --exists "$RSVG_MODULE" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "gnutls >= 2.6.6" 2>&5 &&
+ LIBGNUTLS_CFLAGS=`$PKG_CONFIG --cflags "gnutls >= 2.6.6" 2>&5` &&
+ LIBGNUTLS_LIBS=`$PKG_CONFIG --libs "gnutls >= 2.6.6" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ LIBGNUTLS_CFLAGS=`$as_echo "$LIBGNUTLS_CFLAGS" | sed -e "$edit_cflags"`
+ LIBGNUTLS_LIBS=`$as_echo "$LIBGNUTLS_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$LIBGNUTLS_CFLAGS' LIBS='$LIBGNUTLS_LIBS'" >&5
+$as_echo "yes CFLAGS='$LIBGNUTLS_CFLAGS' LIBS='$LIBGNUTLS_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking RSVG_CFLAGS" >&5
-$as_echo_n "checking RSVG_CFLAGS... " >&6; }
- RSVG_CFLAGS=`$PKG_CONFIG --cflags "$RSVG_MODULE"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RSVG_CFLAGS" >&5
-$as_echo "$RSVG_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking RSVG_LIBS" >&5
-$as_echo_n "checking RSVG_LIBS... " >&6; }
- RSVG_LIBS=`$PKG_CONFIG --libs "$RSVG_MODULE"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RSVG_LIBS" >&5
-$as_echo "$RSVG_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
- RSVG_CFLAGS=""
- RSVG_LIBS=""
+ LIBGNUTLS_CFLAGS=""
+ LIBGNUTLS_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- RSVG_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$RSVG_MODULE"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ LIBGNUTLS_PKG_ERRORS=`($PKG_CONFIG --print-errors "gnutls >= 2.6.6") 2>&1`
fi
fi
if test $succeeded = yes; then
- HAVE_RSVG=yes
+ HAVE_GNUTLS=yes
else
- :
+ HAVE_GNUTLS=no
fi
+ if test "${HAVE_GNUTLS}" = "yes"; then
+$as_echo "#define HAVE_GNUTLS 1" >>confdefs.h
-
- if test $HAVE_RSVG = yes; then
-
-$as_echo "#define HAVE_RSVG 1" >>confdefs.h
-
- CFLAGS="$CFLAGS $RSVG_CFLAGS"
- LIBS="$RSVG_LIBS $LIBS"
- fi
fi
+
+ CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+ LIBS="$LIBGNUTLS_LIBS $LIBS"
+ for ac_func in gnutls_certificate_set_verify_function
+do :
+ ac_fn_c_check_func "$LINENO" "gnutls_certificate_set_verify_function" "ac_cv_func_gnutls_certificate_set_verify_function"
+if test "x$ac_cv_func_gnutls_certificate_set_verify_function" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION 1
+_ACEOF
+ HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes
fi
+done
-HAVE_IMAGEMAGICK=no
-if test "${HAVE_X11}" = "yes"; then
- if test "${with_imagemagick}" != "no"; then
- ## 6.2.8 is the earliest version known to work, but earlier versions
- ## might work - let us know if you find one.
- ## 6.0.7 does not work. See bug#7955.
- IMAGEMAGICK_MODULE="Wand >= 6.2.8"
- succeeded=no
+ if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+$as_echo "#define HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY 1" >>confdefs.h
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ fi
fi
- if test "$PKG_CONFIG" = "no" ; then
- :
- else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $IMAGEMAGICK_MODULE" >&5
-$as_echo_n "checking for $IMAGEMAGICK_MODULE... " >&6; }
-
- if $PKG_CONFIG --exists "$IMAGEMAGICK_MODULE" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- succeeded=yes
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking IMAGEMAGICK_CFLAGS" >&5
-$as_echo_n "checking IMAGEMAGICK_CFLAGS... " >&6; }
- IMAGEMAGICK_CFLAGS=`$PKG_CONFIG --cflags "$IMAGEMAGICK_MODULE"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $IMAGEMAGICK_CFLAGS" >&5
-$as_echo "$IMAGEMAGICK_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking IMAGEMAGICK_LIBS" >&5
-$as_echo_n "checking IMAGEMAGICK_LIBS... " >&6; }
- IMAGEMAGICK_LIBS=`$PKG_CONFIG --libs "$IMAGEMAGICK_MODULE"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $IMAGEMAGICK_LIBS" >&5
-$as_echo "$IMAGEMAGICK_LIBS" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- IMAGEMAGICK_CFLAGS=""
- IMAGEMAGICK_LIBS=""
- ## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- IMAGEMAGICK_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$IMAGEMAGICK_MODULE"`
+HAVE_XAW3D=no
+LUCID_LIBW=
+if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
+ if test "$with_xaw3d" != no; then
+ if test "${emacs_cv_xaw3d+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- fi
+#include <X11/Intrinsic.h>
+#include <X11/Xaw3d/Simple.h>
+int
+main ()
+{
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XawScrollbarSetThumb in -lXaw3d" >&5
+$as_echo_n "checking for XawScrollbarSetThumb in -lXaw3d... " >&6; }
+if test "${ac_cv_lib_Xaw3d_XawScrollbarSetThumb+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lXaw3d $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char XawScrollbarSetThumb ();
+int
+main ()
+{
+return XawScrollbarSetThumb ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_Xaw3d_XawScrollbarSetThumb=yes
+else
+ ac_cv_lib_Xaw3d_XawScrollbarSetThumb=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xaw3d_XawScrollbarSetThumb" >&5
+$as_echo "$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" >&6; }
+if test "x$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" = x""yes; then :
+ emacs_cv_xaw3d=yes
+else
+ emacs_cv_xaw3d=no
+fi
- else
- echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
- echo "*** See http://www.freedesktop.org/software/pkgconfig"
- fi
- fi
+else
+ emacs_cv_xaw3d=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
- if test $succeeded = yes; then
- HAVE_IMAGEMAGICK=yes
else
- :
+ emacs_cv_xaw3d=no
fi
+ if test $emacs_cv_xaw3d = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5
+$as_echo_n "checking for xaw3d... " >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes; using Lucid toolkit" >&5
+$as_echo "yes; using Lucid toolkit" >&6; }
+ USE_X_TOOLKIT=LUCID
+ HAVE_XAW3D=yes
+ LUCID_LIBW=-lXaw3d
+$as_echo "#define HAVE_XAW3D 1" >>confdefs.h
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5
+$as_echo_n "checking for xaw3d... " >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libXaw" >&5
+$as_echo_n "checking for libXaw... " >&6; }
+ if test "${emacs_cv_xaw+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <X11/Intrinsic.h>
+#include <X11/Xaw/Simple.h>
+int
+main ()
+{
- if test $HAVE_IMAGEMAGICK = yes; then
-
-$as_echo "#define HAVE_IMAGEMAGICK 1" >>confdefs.h
-
- CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS"
- LIBS="$IMAGEMAGICK_LIBS $LIBS"
- for ac_func in MagickExportImagePixels
-do :
- ac_fn_c_check_func "$LINENO" "MagickExportImagePixels" "ac_cv_func_MagickExportImagePixels"
-if test "x$ac_cv_func_MagickExportImagePixels" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_MAGICKEXPORTIMAGEPIXELS 1
+ ;
+ return 0;
+}
_ACEOF
-
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_xaw=yes
+else
+ emacs_cv_xaw=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
-done
+ if test $emacs_cv_xaw = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes; using Lucid toolkit" >&5
+$as_echo "yes; using Lucid toolkit" >&6; }
+ USE_X_TOOLKIT=LUCID
+ LUCID_LIBW=-lXaw
+ elif test x"${USE_X_TOOLKIT}" = xLUCID; then
+ as_fn_error "Lucid toolkit requires X11/Xaw include files" "$LINENO" 5
+ else
+ as_fn_error "No X toolkit could be found.
+If you are sure you want Emacs compiled without an X toolkit, pass
+ --with-x-toolkit=no
+to configure. Otherwise, install the development libraries for the toolkit
+that you want to use (e.g. Gtk+) and re-run configure." "$LINENO" 5
fi
fi
fi
+X_TOOLKIT_TYPE=$USE_X_TOOLKIT
-HAVE_GTK=no
-GTK_OBJ=
-if test "${with_gtk3}" = "yes"; then
- GLIB_REQUIRED=2.28
- GTK_REQUIRED=3.0
- GTK_MODULES="gtk+-3.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
-
-
- succeeded=no
-
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+LIBXTR6=
+if test "${USE_X_TOOLKIT}" != "none"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 toolkit version" >&5
+$as_echo_n "checking X11 toolkit version... " >&6; }
+ if test "${emacs_cv_x11_toolkit_version_6+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <X11/Intrinsic.h>
+int
+main ()
+{
+#if XtSpecificationRelease < 6
+fail;
+#endif
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_x11_toolkit_version_6=yes
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ emacs_cv_x11_toolkit_version_6=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
+ HAVE_X11XTR6=$emacs_cv_x11_toolkit_version_6
+ if test $emacs_cv_x11_toolkit_version_6 = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: 6 or newer" >&5
+$as_echo "6 or newer" >&6; }
+$as_echo "#define HAVE_X11XTR6 1" >>confdefs.h
- if test "$PKG_CONFIG" = "no" ; then
- pkg_check_gtk=no
+ LIBXTR6="-lSM -lICE"
+ case "$opsys" in
+ ## Use libw.a along with X11R6 Xt.
+ unixware) LIBXTR6="$LIBXTR6 -lw" ;;
+ esac
else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $GTK_MODULES" >&5
-$as_echo_n "checking for $GTK_MODULES... " >&6; }
-
- if $PKG_CONFIG --exists "$GTK_MODULES" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GTK_CFLAGS" >&5
-$as_echo_n "checking GTK_CFLAGS... " >&6; }
- GTK_CFLAGS=`$PKG_CONFIG --cflags "$GTK_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GTK_CFLAGS" >&5
-$as_echo "$GTK_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GTK_LIBS" >&5
-$as_echo_n "checking GTK_LIBS... " >&6; }
- GTK_LIBS=`$PKG_CONFIG --libs "$GTK_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GTK_LIBS" >&5
-$as_echo "$GTK_LIBS" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- GTK_CFLAGS=""
- GTK_LIBS=""
- ## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- GTK_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$GTK_MODULES"`
-
- fi
-
-
-
- else
- echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
- echo "*** See http://www.freedesktop.org/software/pkgconfig"
- fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: before 6" >&5
+$as_echo "before 6" >&6; }
fi
- if test $succeeded = yes; then
- pkg_check_gtk=yes
+ OLDLIBS="$LIBS"
+ if test x$HAVE_X11XTR6 = xyes; then
+ LIBS="-lXt -lSM -lICE $LIBS"
else
- pkg_check_gtk=no
- fi
-
- if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then
- as_fn_error "$GTK_PKG_ERRORS" "$LINENO" 5
+ LIBS="-lXt $LIBS"
fi
-
-$as_echo "#define HAVE_GTK3 1" >>confdefs.h
-
- GTK_OBJ=emacsgtkfixed.o
-fi
-
-if test "$pkg_check_gtk" != "yes"; then
- HAVE_GTK=no
-if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
- GLIB_REQUIRED=2.10
- GTK_REQUIRED=2.10
- GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
-
-
- succeeded=no
-
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmuConvertStandardSelection in -lXmu" >&5
+$as_echo_n "checking for XmuConvertStandardSelection in -lXmu... " >&6; }
+if test "${ac_cv_lib_Xmu_XmuConvertStandardSelection+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lXmu $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char XmuConvertStandardSelection ();
+int
+main ()
+{
+return XmuConvertStandardSelection ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_Xmu_XmuConvertStandardSelection=yes
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ ac_cv_lib_Xmu_XmuConvertStandardSelection=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xmu_XmuConvertStandardSelection" >&5
+$as_echo "$ac_cv_lib_Xmu_XmuConvertStandardSelection" >&6; }
+if test "x$ac_cv_lib_Xmu_XmuConvertStandardSelection" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBXMU 1
+_ACEOF
+
+ LIBS="-lXmu $LIBS"
+fi
+ test $ac_cv_lib_Xmu_XmuConvertStandardSelection = no && LIBS="$OLDLIBS"
+ fi
- if test "$PKG_CONFIG" = "no" ; then
- pkg_check_gtk=no
- else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $GTK_MODULES" >&5
-$as_echo_n "checking for $GTK_MODULES... " >&6; }
- if $PKG_CONFIG --exists "$GTK_MODULES" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- succeeded=yes
+LIBXMU=-lXmu
+case $opsys in
+ ## These systems don't supply Xmu.
+ hpux* | aix4-2 )
+ test "X$ac_cv_lib_Xmu_XmuConvertStandardSelection" != "Xyes" && LIBXMU=
+ ;;
+esac
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GTK_CFLAGS" >&5
-$as_echo_n "checking GTK_CFLAGS... " >&6; }
- GTK_CFLAGS=`$PKG_CONFIG --cflags "$GTK_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GTK_CFLAGS" >&5
-$as_echo "$GTK_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GTK_LIBS" >&5
-$as_echo_n "checking GTK_LIBS... " >&6; }
- GTK_LIBS=`$PKG_CONFIG --libs "$GTK_MODULES"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GTK_LIBS" >&5
-$as_echo "$GTK_LIBS" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- GTK_CFLAGS=""
- GTK_LIBS=""
- ## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- GTK_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$GTK_MODULES"`
- fi
+# On Irix 6.5, at least, we need XShapeQueryExtension from -lXext for Xaw3D.
+if test "${HAVE_X11}" = "yes"; then
+ if test "${USE_X_TOOLKIT}" != "none"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XShapeQueryExtension in -lXext" >&5
+$as_echo_n "checking for XShapeQueryExtension in -lXext... " >&6; }
+if test "${ac_cv_lib_Xext_XShapeQueryExtension+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lXext $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char XShapeQueryExtension ();
+int
+main ()
+{
+return XShapeQueryExtension ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_Xext_XShapeQueryExtension=yes
+else
+ ac_cv_lib_Xext_XShapeQueryExtension=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xext_XShapeQueryExtension" >&5
+$as_echo "$ac_cv_lib_Xext_XShapeQueryExtension" >&6; }
+if test "x$ac_cv_lib_Xext_XShapeQueryExtension" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBXEXT 1
+_ACEOF
+ LIBS="-lXext $LIBS"
+fi
- else
- echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
- echo "*** See http://www.freedesktop.org/software/pkgconfig"
- fi
fi
+fi
- if test $succeeded = yes; then
- pkg_check_gtk=yes
+LIBXP=
+if test "${USE_X_TOOLKIT}" = "MOTIF"; then
+ # OpenMotif may be installed in such a way on some GNU/Linux systems.
+ if test -d /usr/include/openmotif; then
+ CPPFLAGS="-I/usr/include/openmotif $CPPFLAGS"
+ emacs_cv_openmotif=yes
+ case "$canonical" in
+ x86_64-*-linux-gnu* | powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*)
+ test -d /usr/lib64/openmotif && LDFLAGS="-L/usr/lib64/openmotif $LDFLAGS"
+ ;;
+ *)
+ test -d /usr/lib/openmotif && LDFLAGS="-L/usr/lib/openmotif $LDFLAGS"
+ esac
else
- pkg_check_gtk=no
- fi
-
- if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then
- as_fn_error "$GTK_PKG_ERRORS" "$LINENO" 5
+ emacs_cv_openmotif=no
fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for (Open)Motif version 2.1" >&5
+$as_echo_n "checking for (Open)Motif version 2.1... " >&6; }
+if test "${emacs_cv_motif_version_2_1+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <Xm/Xm.h>
+int
+main ()
+{
+#if XmVERSION > 2 || (XmVERSION == 2 && XmREVISION >= 1)
+int x = 5;
+#else
+Motif version prior to 2.1.
+#endif
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ emacs_cv_motif_version_2_1=yes
+else
+ emacs_cv_motif_version_2_1=no
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_motif_version_2_1" >&5
+$as_echo "$emacs_cv_motif_version_2_1" >&6; }
+ if test $emacs_cv_motif_version_2_1 = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpCreateContext in -lXp" >&5
+$as_echo_n "checking for XpCreateContext in -lXp... " >&6; }
+if test "${ac_cv_lib_Xp_XpCreateContext+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lXp $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-if test x"$pkg_check_gtk" = xyes; then
-
-
-
- C_SWITCH_X_SITE="$C_SWITCH_X_SITE $GTK_CFLAGS"
- CFLAGS="$CFLAGS $GTK_CFLAGS"
- LIBS="$GTK_LIBS $LIBS"
- GTK_COMPILES=no
- for ac_func in gtk_main
-do :
- ac_fn_c_check_func "$LINENO" "gtk_main" "ac_cv_func_gtk_main"
-if test "x$ac_cv_func_gtk_main" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_GTK_MAIN 1
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char XpCreateContext ();
+int
+main ()
+{
+return XpCreateContext ();
+ ;
+ return 0;
+}
_ACEOF
- GTK_COMPILES=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_Xp_XpCreateContext=yes
+else
+ ac_cv_lib_Xp_XpCreateContext=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xp_XpCreateContext" >&5
+$as_echo "$ac_cv_lib_Xp_XpCreateContext" >&6; }
+if test "x$ac_cv_lib_Xp_XpCreateContext" = x""yes; then :
+ LIBXP=-lXp
fi
-done
- if test "${GTK_COMPILES}" != "yes"; then
- if test "$USE_X_TOOLKIT" != "maybe"; then
- as_fn_error "Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?" "$LINENO" 5;
+ if test x$emacs_cv_openmotif = xyes; then
+ REAL_CPPFLAGS="-I/usr/include/openmotif $REAL_CPPFLAGS"
fi
else
- HAVE_GTK=yes
-
-$as_echo "#define USE_GTK 1" >>confdefs.h
-
- GTK_OBJ="gtkutil.o $GTK_OBJ"
- USE_X_TOOLKIT=none
- if $PKG_CONFIG --atleast-version=2.10 gtk+-2.0; then
- :
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Your version of Gtk+ will have problems with
- closing open displays. This is no problem if you just use
- one display, but if you use more than one and close one of them
- Emacs may crash." >&5
-$as_echo "$as_me: WARNING: Your version of Gtk+ will have problems with
- closing open displays. This is no problem if you just use
- one display, but if you use more than one and close one of them
- Emacs may crash." >&2;}
- sleep 3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LessTif where some systems put it" >&5
+$as_echo_n "checking for LessTif where some systems put it... " >&6; }
+if test "${emacs_cv_lesstif+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ # We put this in CFLAGS temporarily to precede other -I options
+ # that might be in CFLAGS temporarily.
+ # We put this in CPPFLAGS where it precedes the other -I options.
+ OLD_CPPFLAGS=$CPPFLAGS
+ OLD_CFLAGS=$CFLAGS
+ CPPFLAGS="-I/usr/X11R6/LessTif/Motif1.2/include $CPPFLAGS"
+ CFLAGS="-I/usr/X11R6/LessTif/Motif1.2/include $CFLAGS"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include </usr/X11R6/LessTif/Motif1.2/include/Xm/Xm.h>
+int
+main ()
+{
+int x = 5;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ emacs_cv_lesstif=yes
+else
+ emacs_cv_lesstif=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_lesstif" >&5
+$as_echo "$emacs_cv_lesstif" >&6; }
+ if test $emacs_cv_lesstif = yes; then
+ # Make sure this -I option remains in CPPFLAGS after it is set
+ # back to REAL_CPPFLAGS.
+ # There is no need to change REAL_CFLAGS, because REAL_CFLAGS does not
+ # have those other -I options anyway. Ultimately, having this
+ # directory ultimately in CPPFLAGS will be enough.
+ REAL_CPPFLAGS="-I/usr/X11R6/LessTif/Motif1.2/include $REAL_CPPFLAGS"
+ LDFLAGS="-L/usr/X11R6/LessTif/Motif1.2/lib $LDFLAGS"
+ else
+ CFLAGS=$OLD_CFLAGS
+ CPPFLAGS=$OLD_CPPFLAGS
fi
fi
+ ac_fn_c_check_header_mongrel "$LINENO" "Xm/BulletinB.h" "ac_cv_header_Xm_BulletinB_h" "$ac_includes_default"
+if test "x$ac_cv_header_Xm_BulletinB_h" = x""yes; then :
-fi
-
-
-
-if test "${HAVE_GTK}" = "yes"; then
-
- if test "$with_toolkit_scroll_bars" != no; then
- with_toolkit_scroll_bars=yes
- fi
-
- HAVE_GTK_FILE_SELECTION=no
- ac_fn_c_check_decl "$LINENO" "GTK_TYPE_FILE_SELECTION" "ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" "$ac_includes_default
-#include <gtk/gtk.h>
-"
-if test "x$ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" = x""yes; then :
- HAVE_GTK_FILE_SELECTION=yes
else
- HAVE_GTK_FILE_SELECTION=no
+ as_fn_error "Motif toolkit requested but requirements not found." "$LINENO" 5
fi
- if test "$HAVE_GTK_FILE_SELECTION" = yes; then
- for ac_func in gtk_file_selection_new
-do :
- ac_fn_c_check_func "$LINENO" "gtk_file_selection_new" "ac_cv_func_gtk_file_selection_new"
-if test "x$ac_cv_func_gtk_file_selection_new" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_GTK_FILE_SELECTION_NEW 1
-_ACEOF
fi
-done
-
- fi
-
- for ac_func in gtk_widget_get_window gtk_widget_set_has_window \
- gtk_dialog_get_action_area gtk_widget_get_sensitive \
- gtk_widget_get_mapped gtk_adjustment_get_page_size \
- gtk_orientable_set_orientation \
- gtk_window_set_has_resize_grip
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-eval as_val=\$$as_ac_var
- if test "x$as_val" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-fi
-done
+USE_TOOLKIT_SCROLL_BARS=no
+if test "${with_toolkit_scroll_bars}" != "no"; then
+ if test "${USE_X_TOOLKIT}" != "none"; then
+ if test "${USE_X_TOOLKIT}" = "MOTIF"; then
+ $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
-fi
+ HAVE_XAW3D=no
+ USE_TOOLKIT_SCROLL_BARS=yes
+ elif test "${HAVE_XAW3D}" = "yes" || test "${USE_X_TOOLKIT}" = "LUCID"; then
+ $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
-HAVE_DBUS=no
-DBUS_OBJ=
-if test "${with_dbus}" = "yes"; then
+ USE_TOOLKIT_SCROLL_BARS=yes
+ fi
+ elif test "${HAVE_GTK}" = "yes"; then
+ $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
- succeeded=no
+ USE_TOOLKIT_SCROLL_BARS=yes
+ elif test "${HAVE_NS}" = "yes"; then
+ $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
+ USE_TOOLKIT_SCROLL_BARS=yes
fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+ #include <X11/Xlib.h>
+ #include <X11/Xresource.h>
+int
+main ()
+{
+XIMProc callback;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ HAVE_XIM=yes
- if test "$PKG_CONFIG" = "no" ; then
- HAVE_DBUS=no
- else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dbus-1 >= 1.0" >&5
-$as_echo_n "checking for dbus-1 >= 1.0... " >&6; }
+$as_echo "#define HAVE_XIM 1" >>confdefs.h
- if $PKG_CONFIG --exists "dbus-1 >= 1.0" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- succeeded=yes
+else
+ HAVE_XIM=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking DBUS_CFLAGS" >&5
-$as_echo_n "checking DBUS_CFLAGS... " >&6; }
- DBUS_CFLAGS=`$PKG_CONFIG --cflags "dbus-1 >= 1.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DBUS_CFLAGS" >&5
-$as_echo "$DBUS_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking DBUS_LIBS" >&5
-$as_echo_n "checking DBUS_LIBS... " >&6; }
- DBUS_LIBS=`$PKG_CONFIG --libs "dbus-1 >= 1.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DBUS_LIBS" >&5
-$as_echo "$DBUS_LIBS" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- DBUS_CFLAGS=""
- DBUS_LIBS=""
- ## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- DBUS_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "dbus-1 >= 1.0"`
- fi
+if test "${with_xim}" != "no"; then
+$as_echo "#define USE_XIM 1" >>confdefs.h
+fi
- else
- echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
- echo "*** See http://www.freedesktop.org/software/pkgconfig"
- fi
- fi
- if test $succeeded = yes; then
- HAVE_DBUS=yes
- else
- HAVE_DBUS=no
+if test "${HAVE_XIM}" != "no"; then
+ late_CFLAGS=$CFLAGS
+ if test "$GCC" = yes; then
+ CFLAGS="$CFLAGS --pedantic-errors"
fi
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- if test "$HAVE_DBUS" = yes; then
- LIBS="$LIBS $DBUS_LIBS"
-
-$as_echo "#define HAVE_DBUS 1" >>confdefs.h
-
- for ac_func in dbus_watch_get_unix_fd
-do :
- ac_fn_c_check_func "$LINENO" "dbus_watch_get_unix_fd" "ac_cv_func_dbus_watch_get_unix_fd"
-if test "x$ac_cv_func_dbus_watch_get_unix_fd" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_DBUS_WATCH_GET_UNIX_FD 1
+#include <X11/Xlib.h>
+#include <X11/Xresource.h>
+int
+main ()
+{
+Display *display;
+XrmDatabase db;
+char *res_name;
+char *res_class;
+XIMProc callback;
+XPointer *client_data;
+#ifndef __GNUC__
+/* If we're not using GCC, it's probably not XFree86, and this is
+ probably right, but we can't use something like --pedantic-errors. */
+extern Bool XRegisterIMInstantiateCallback(Display*, XrmDatabase, char*,
+ char*, XIMProc, XPointer*);
+#endif
+(void)XRegisterIMInstantiateCallback(display, db, res_name, res_class, callback,
+ client_data);
+ ;
+ return 0;
+}
_ACEOF
-
-fi
-done
-
- DBUS_OBJ=dbusbind.o
- fi
+if ac_fn_c_try_compile "$LINENO"; then :
+ emacs_cv_arg6_star=yes
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ if test "$emacs_cv_arg6_star" = yes; then
+ $as_echo "#define XRegisterIMInstantiateCallback_arg6 XPointer*" >>confdefs.h
+ else
+ $as_echo "#define XRegisterIMInstantiateCallback_arg6 XPointer" >>confdefs.h
-HAVE_GSETTINGS=no
-if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then
-
- succeeded=no
-
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ CFLAGS=$late_CFLAGS
fi
+### Start of font-backend (under any platform) section.
+# (nothing here yet -- this is a placeholder)
+### End of font-backend (under any platform) section.
+
+### Start of font-backend (under X11) section.
+if test "${HAVE_X11}" = "yes"; then
+ succeeded=no
if test "$PKG_CONFIG" = "no" ; then
- HAVE_GSETTINGS=no
+ HAVE_FC=no
else
PKG_CONFIG_MIN_VERSION=0.9.0
if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gio-2.0 >= 2.26" >&5
-$as_echo_n "checking for gio-2.0 >= 2.26... " >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fontconfig >= 2.2.0" >&5
+$as_echo_n "checking for fontconfig >= 2.2.0... " >&6; }
- if $PKG_CONFIG --exists "gio-2.0 >= 2.26" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "fontconfig >= 2.2.0" 2>&5 &&
+ FONTCONFIG_CFLAGS=`$PKG_CONFIG --cflags "fontconfig >= 2.2.0" 2>&5` &&
+ FONTCONFIG_LIBS=`$PKG_CONFIG --libs "fontconfig >= 2.2.0" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ FONTCONFIG_CFLAGS=`$as_echo "$FONTCONFIG_CFLAGS" | sed -e "$edit_cflags"`
+ FONTCONFIG_LIBS=`$as_echo "$FONTCONFIG_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$FONTCONFIG_CFLAGS' LIBS='$FONTCONFIG_LIBS'" >&5
+$as_echo "yes CFLAGS='$FONTCONFIG_CFLAGS' LIBS='$FONTCONFIG_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GSETTINGS_CFLAGS" >&5
-$as_echo_n "checking GSETTINGS_CFLAGS... " >&6; }
- GSETTINGS_CFLAGS=`$PKG_CONFIG --cflags "gio-2.0 >= 2.26"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GSETTINGS_CFLAGS" >&5
-$as_echo "$GSETTINGS_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GSETTINGS_LIBS" >&5
-$as_echo_n "checking GSETTINGS_LIBS... " >&6; }
- GSETTINGS_LIBS=`$PKG_CONFIG --libs "gio-2.0 >= 2.26"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GSETTINGS_LIBS" >&5
-$as_echo "$GSETTINGS_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
- GSETTINGS_CFLAGS=""
- GSETTINGS_LIBS=""
+ FONTCONFIG_CFLAGS=""
+ FONTCONFIG_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- GSETTINGS_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "gio-2.0 >= 2.26"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ FONTCONFIG_PKG_ERRORS=`($PKG_CONFIG --print-errors "fontconfig >= 2.2.0") 2>&1`
fi
fi
if test $succeeded = yes; then
- HAVE_GSETTINGS=yes
+ HAVE_FC=yes
else
- HAVE_GSETTINGS=no
+ HAVE_FC=no
fi
- if test "$HAVE_GSETTINGS" = "yes"; then
-
-$as_echo "#define HAVE_GSETTINGS 1" >>confdefs.h
- SETTINGS_CFLAGS="$GSETTINGS_CFLAGS"
- SETTINGS_LIBS="$GSETTINGS_LIBS"
- fi
-fi
+ ## Use -lXft if available, unless `--with-xft=no'.
+ HAVE_XFT=maybe
+ if test "${HAVE_FC}" = "no" || test "x${with_x}" = "xno"; then
+ with_xft="no";
+ fi
+ if test "x${with_xft}" != "xno"; then
-HAVE_GCONF=no
-if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then
succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
if test "$PKG_CONFIG" = "no" ; then
- HAVE_GCONF=no
+ HAVE_XFT=no
else
PKG_CONFIG_MIN_VERSION=0.9.0
if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gconf-2.0 >= 2.13" >&5
-$as_echo_n "checking for gconf-2.0 >= 2.13... " >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xft >= 0.13.0" >&5
+$as_echo_n "checking for xft >= 0.13.0... " >&6; }
- if $PKG_CONFIG --exists "gconf-2.0 >= 2.13" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "xft >= 0.13.0" 2>&5 &&
+ XFT_CFLAGS=`$PKG_CONFIG --cflags "xft >= 0.13.0" 2>&5` &&
+ XFT_LIBS=`$PKG_CONFIG --libs "xft >= 0.13.0" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ XFT_CFLAGS=`$as_echo "$XFT_CFLAGS" | sed -e "$edit_cflags"`
+ XFT_LIBS=`$as_echo "$XFT_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$XFT_CFLAGS' LIBS='$XFT_LIBS'" >&5
+$as_echo "yes CFLAGS='$XFT_CFLAGS' LIBS='$XFT_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GCONF_CFLAGS" >&5
-$as_echo_n "checking GCONF_CFLAGS... " >&6; }
- GCONF_CFLAGS=`$PKG_CONFIG --cflags "gconf-2.0 >= 2.13"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCONF_CFLAGS" >&5
-$as_echo "$GCONF_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking GCONF_LIBS" >&5
-$as_echo_n "checking GCONF_LIBS... " >&6; }
- GCONF_LIBS=`$PKG_CONFIG --libs "gconf-2.0 >= 2.13"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCONF_LIBS" >&5
-$as_echo "$GCONF_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
- GCONF_CFLAGS=""
- GCONF_LIBS=""
+ XFT_CFLAGS=""
+ XFT_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- GCONF_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "gconf-2.0 >= 2.13"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ XFT_PKG_ERRORS=`($PKG_CONFIG --print-errors "xft >= 0.13.0") 2>&1`
fi
fi
if test $succeeded = yes; then
- HAVE_GCONF=yes
+ :
else
- HAVE_GCONF=no
+ HAVE_XFT=no
fi
- if test "$HAVE_GCONF" = yes; then
-
-$as_echo "#define HAVE_GCONF 1" >>confdefs.h
-
- SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GCONF_CFLAGS"
- SETTINGS_LIBS="$SETTINGS_LIBS $GCONF_LIBS"
- fi
-fi
+ ## Because xftfont.c uses XRenderQueryExtension, we also
+ ## need to link to -lXrender.
+ HAVE_XRENDER=no
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XRenderQueryExtension in -lXrender" >&5
+$as_echo_n "checking for XRenderQueryExtension in -lXrender... " >&6; }
+if test "${ac_cv_lib_Xrender_XRenderQueryExtension+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lXrender $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then
- SAVE_CFLAGS="$CFLAGS"
- SAVE_LIBS="$LIBS"
- CFLAGS="$SETTINGS_CFLAGS $CFLAGS"
- LIBS="$SETTINGS_LIBS $LIBS"
- for ac_func in g_type_init
-do :
- ac_fn_c_check_func "$LINENO" "g_type_init" "ac_cv_func_g_type_init"
-if test "x$ac_cv_func_g_type_init" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_G_TYPE_INIT 1
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char XRenderQueryExtension ();
+int
+main ()
+{
+return XRenderQueryExtension ();
+ ;
+ return 0;
+}
_ACEOF
-
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_Xrender_XRenderQueryExtension=yes
+else
+ ac_cv_lib_Xrender_XRenderQueryExtension=no
fi
-done
-
- CFLAGS="$SAVE_CFLAGS"
- LIBS="$SAVE_LIBS"
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xrender_XRenderQueryExtension" >&5
+$as_echo "$ac_cv_lib_Xrender_XRenderQueryExtension" >&6; }
+if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = x""yes; then :
+ HAVE_XRENDER=yes
fi
-
-
-
-HAVE_LIBSELINUX=no
-LIBSELINUX_LIBS=
-if test "${with_selinux}" = "yes"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lgetfilecon in -lselinux" >&5
-$as_echo_n "checking for lgetfilecon in -lselinux... " >&6; }
-if test "${ac_cv_lib_selinux_lgetfilecon+set}" = set; then :
+ if test "$HAVE_XFT" != no && test "$HAVE_XRENDER" != no; then
+ OLD_CPPFLAGS="$CPPFLAGS"
+ OLD_CFLAGS="$CFLAGS"
+ OLD_LIBS="$LIBS"
+ CPPFLAGS="$CPPFLAGS $XFT_CFLAGS"
+ CFLAGS="$CFLAGS $XFT_CFLAGS"
+ XFT_LIBS="-lXrender $XFT_LIBS"
+ LIBS="$XFT_LIBS $LIBS"
+ ac_fn_c_check_header_mongrel "$LINENO" "X11/Xft/Xft.h" "ac_cv_header_X11_Xft_Xft_h" "$ac_includes_default"
+if test "x$ac_cv_header_X11_Xft_Xft_h" = x""yes; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XftFontOpen in -lXft" >&5
+$as_echo_n "checking for XftFontOpen in -lXft... " >&6; }
+if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lselinux $LIBS"
+LIBS="-lXft $XFT_LIBS $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char lgetfilecon ();
+char XftFontOpen ();
int
main ()
{
-return lgetfilecon ();
+return XftFontOpen ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_selinux_lgetfilecon=yes
+ ac_cv_lib_Xft_XftFontOpen=yes
else
- ac_cv_lib_selinux_lgetfilecon=no
+ ac_cv_lib_Xft_XftFontOpen=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_selinux_lgetfilecon" >&5
-$as_echo "$ac_cv_lib_selinux_lgetfilecon" >&6; }
-if test "x$ac_cv_lib_selinux_lgetfilecon" = x""yes; then :
- HAVE_LIBSELINUX=yes
-else
- HAVE_LIBSELINUX=no
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xft_XftFontOpen" >&5
+$as_echo "$ac_cv_lib_Xft_XftFontOpen" >&6; }
+if test "x$ac_cv_lib_Xft_XftFontOpen" = x""yes; then :
+ HAVE_XFT=yes
fi
- if test "$HAVE_LIBSELINUX" = yes; then
-
-$as_echo "#define HAVE_LIBSELINUX 1" >>confdefs.h
-
- LIBSELINUX_LIBS=-lselinux
- fi
fi
-HAVE_GNUTLS=no
-HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
-if test "${with_gnutls}" = "yes" ; then
- succeeded=no
+ if test "${HAVE_XFT}" = "yes"; then
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+$as_echo "#define HAVE_XFT 1" >>confdefs.h
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
+ C_SWITCH_X_SITE="$C_SWITCH_X_SITE $XFT_CFLAGS"
+ else
+ CPPFLAGS="$OLD_CPPFLAGS"
+ CFLAGS="$OLD_CFLAGS"
+ LIBS="$OLD_LIBS"
+ fi # "${HAVE_XFT}" = "yes"
+ fi # "$HAVE_XFT" != no
+ fi # "x${with_xft}" != "xno"
+ ## We used to allow building with FreeType and without Xft.
+ ## However, the ftx font backend driver is not in good shape.
+ if test "$HAVE_XFT" != "yes"; then
+ HAVE_XFT=no
+ HAVE_FREETYPE=no
+ else
+
+ succeeded=no
if test "$PKG_CONFIG" = "no" ; then
- HAVE_GNUTLS=no
+ HAVE_FREETYPE=no
else
PKG_CONFIG_MIN_VERSION=0.9.0
if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gnutls >= 2.6.6" >&5
-$as_echo_n "checking for gnutls >= 2.6.6... " >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for freetype2" >&5
+$as_echo_n "checking for freetype2... " >&6; }
- if $PKG_CONFIG --exists "gnutls >= 2.6.6" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "freetype2" 2>&5 &&
+ FREETYPE_CFLAGS=`$PKG_CONFIG --cflags "freetype2" 2>&5` &&
+ FREETYPE_LIBS=`$PKG_CONFIG --libs "freetype2" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ FREETYPE_CFLAGS=`$as_echo "$FREETYPE_CFLAGS" | sed -e "$edit_cflags"`
+ FREETYPE_LIBS=`$as_echo "$FREETYPE_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$FREETYPE_CFLAGS' LIBS='$FREETYPE_LIBS'" >&5
+$as_echo "yes CFLAGS='$FREETYPE_CFLAGS' LIBS='$FREETYPE_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBGNUTLS_CFLAGS" >&5
-$as_echo_n "checking LIBGNUTLS_CFLAGS... " >&6; }
- LIBGNUTLS_CFLAGS=`$PKG_CONFIG --cflags "gnutls >= 2.6.6"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBGNUTLS_CFLAGS" >&5
-$as_echo "$LIBGNUTLS_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBGNUTLS_LIBS" >&5
-$as_echo_n "checking LIBGNUTLS_LIBS... " >&6; }
- LIBGNUTLS_LIBS=`$PKG_CONFIG --libs "gnutls >= 2.6.6"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBGNUTLS_LIBS" >&5
-$as_echo "$LIBGNUTLS_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
- LIBGNUTLS_CFLAGS=""
- LIBGNUTLS_LIBS=""
+ FREETYPE_CFLAGS=""
+ FREETYPE_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- LIBGNUTLS_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "gnutls >= 2.6.6"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ FREETYPE_PKG_ERRORS=`($PKG_CONFIG --print-errors "freetype2") 2>&1`
fi
fi
if test $succeeded = yes; then
- HAVE_GNUTLS=yes
+ HAVE_FREETYPE=yes
else
- HAVE_GNUTLS=no
+ HAVE_FREETYPE=no
fi
- if test "${HAVE_GNUTLS}" = "yes"; then
-$as_echo "#define HAVE_GNUTLS 1" >>confdefs.h
+ test "$HAVE_FREETYPE" = "no" && as_fn_error "libxft requires libfreetype" "$LINENO" 5
+ fi
- fi
+ HAVE_LIBOTF=no
+ if test "${HAVE_FREETYPE}" = "yes"; then
- CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
- LIBS="$LIBGNUTLS_LIBS $LIBS"
- for ac_func in gnutls_certificate_set_verify_function
-do :
- ac_fn_c_check_func "$LINENO" "gnutls_certificate_set_verify_function" "ac_cv_func_gnutls_certificate_set_verify_function"
-if test "x$ac_cv_func_gnutls_certificate_set_verify_function" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION 1
-_ACEOF
- HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes
-fi
-done
+$as_echo "#define HAVE_FREETYPE 1" >>confdefs.h
+ if test "${with_libotf}" != "no"; then
- if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+ succeeded=no
-$as_echo "#define HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY 1" >>confdefs.h
+ if test "$PKG_CONFIG" = "no" ; then
+ HAVE_LIBOTF=no
+ else
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libotf" >&5
+$as_echo_n "checking for libotf... " >&6; }
- fi
-fi
+ if $PKG_CONFIG --exists "libotf" 2>&5 &&
+ LIBOTF_CFLAGS=`$PKG_CONFIG --cflags "libotf" 2>&5` &&
+ LIBOTF_LIBS=`$PKG_CONFIG --libs "libotf" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ LIBOTF_CFLAGS=`$as_echo "$LIBOTF_CFLAGS" | sed -e "$edit_cflags"`
+ LIBOTF_LIBS=`$as_echo "$LIBOTF_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$LIBOTF_CFLAGS' LIBS='$LIBOTF_LIBS'" >&5
+$as_echo "yes CFLAGS='$LIBOTF_CFLAGS' LIBS='$LIBOTF_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ LIBOTF_CFLAGS=""
+ LIBOTF_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ LIBOTF_PKG_ERRORS=`($PKG_CONFIG --print-errors "libotf") 2>&1`
+ fi
-HAVE_XAW3D=no
-LUCID_LIBW=
-if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
- if test "$with_xaw3d" != no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5
-$as_echo_n "checking for xaw3d... " >&6; }
- if test "${emacs_cv_xaw3d+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
+ fi
-#include <X11/Intrinsic.h>
-#include <X11/Xaw3d/Simple.h>
-int
-main ()
-{
+ if test $succeeded = yes; then
+ HAVE_LIBOTF=yes
+ else
+ HAVE_LIBOTF=no
+ fi
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XawScrollbarSetThumb in -lXaw3d" >&5
-$as_echo_n "checking for XawScrollbarSetThumb in -lXaw3d... " >&6; }
-if test "${ac_cv_lib_Xaw3d_XawScrollbarSetThumb+set}" = set; then :
+ if test "$HAVE_LIBOTF" = "yes"; then
+
+$as_echo "#define HAVE_LIBOTF 1" >>confdefs.h
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OTF_get_variation_glyphs in -lotf" >&5
+$as_echo_n "checking for OTF_get_variation_glyphs in -lotf... " >&6; }
+if test "${ac_cv_lib_otf_OTF_get_variation_glyphs+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXaw3d $LIBS"
+LIBS="-lotf $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char XawScrollbarSetThumb ();
+char OTF_get_variation_glyphs ();
int
main ()
{
-return XawScrollbarSetThumb ();
+return OTF_get_variation_glyphs ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xaw3d_XawScrollbarSetThumb=yes
+ ac_cv_lib_otf_OTF_get_variation_glyphs=yes
else
- ac_cv_lib_Xaw3d_XawScrollbarSetThumb=no
+ ac_cv_lib_otf_OTF_get_variation_glyphs=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xaw3d_XawScrollbarSetThumb" >&5
-$as_echo "$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" >&6; }
-if test "x$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" = x""yes; then :
- emacs_cv_xaw3d=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_otf_OTF_get_variation_glyphs" >&5
+$as_echo "$ac_cv_lib_otf_OTF_get_variation_glyphs" >&6; }
+if test "x$ac_cv_lib_otf_OTF_get_variation_glyphs" = x""yes; then :
+ HAVE_OTF_GET_VARIATION_GLYPHS=yes
else
- emacs_cv_xaw3d=no
+ HAVE_OTF_GET_VARIATION_GLYPHS=no
fi
-else
- emacs_cv_xaw3d=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
+ if test "${HAVE_OTF_GET_VARIATION_GLYPHS}" = "yes"; then
- else
- emacs_cv_xaw3d=no
- fi
- if test $emacs_cv_xaw3d = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes; using Lucid toolkit" >&5
-$as_echo "yes; using Lucid toolkit" >&6; }
- USE_X_TOOLKIT=LUCID
- HAVE_XAW3D=yes
- LUCID_LIBW=-lXaw3d
+$as_echo "#define HAVE_OTF_GET_VARIATION_GLYPHS 1" >>confdefs.h
-$as_echo "#define HAVE_XAW3D 1" >>confdefs.h
+ fi
+ fi
+ fi
+ fi
+
+ HAVE_M17N_FLT=no
+ if test "${HAVE_LIBOTF}" = yes; then
+ if test "${with_m17n_flt}" != "no"; then
+ succeeded=no
+
+ if test "$PKG_CONFIG" = "no" ; then
+ HAVE_M17N_FLT=no
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+ PKG_CONFIG_MIN_VERSION=0.9.0
+ if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for m17n-flt" >&5
+$as_echo_n "checking for m17n-flt... " >&6; }
+
+ if $PKG_CONFIG --exists "m17n-flt" 2>&5 &&
+ M17N_FLT_CFLAGS=`$PKG_CONFIG --cflags "m17n-flt" 2>&5` &&
+ M17N_FLT_LIBS=`$PKG_CONFIG --libs "m17n-flt" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ M17N_FLT_CFLAGS=`$as_echo "$M17N_FLT_CFLAGS" | sed -e "$edit_cflags"`
+ M17N_FLT_LIBS=`$as_echo "$M17N_FLT_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$M17N_FLT_CFLAGS' LIBS='$M17N_FLT_LIBS'" >&5
+$as_echo "yes CFLAGS='$M17N_FLT_CFLAGS' LIBS='$M17N_FLT_LIBS'" >&6; }
+ succeeded=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libXaw" >&5
-$as_echo_n "checking for libXaw... " >&6; }
- if test "${emacs_cv_xaw+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ M17N_FLT_CFLAGS=""
+ M17N_FLT_LIBS=""
+ ## If we have a custom action on failure, don't print errors, but
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ M17N_FLT_PKG_ERRORS=`($PKG_CONFIG --print-errors "m17n-flt") 2>&1`
-#include <X11/Intrinsic.h>
-#include <X11/Xaw/Simple.h>
-int
-main ()
-{
+ fi
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_xaw=yes
-else
- emacs_cv_xaw=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
- if test $emacs_cv_xaw = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes; using Lucid toolkit" >&5
-$as_echo "yes; using Lucid toolkit" >&6; }
- USE_X_TOOLKIT=LUCID
- LUCID_LIBW=-lXaw
- elif test x"${USE_X_TOOLKIT}" = xLUCID; then
- as_fn_error "Lucid toolkit requires X11/Xaw include files" "$LINENO" 5
- else
- as_fn_error "No X toolkit could be found.
-If you are sure you want Emacs compiled without an X toolkit, pass
- --with-x-toolkit=no
-to configure. Otherwise, install the development libraries for the toolkit
-that you want to use (e.g. Gtk+) and re-run configure." "$LINENO" 5
- fi
+
+ else
+ echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
+ echo "*** See http://www.freedesktop.org/software/pkgconfig"
+ fi
fi
-fi
-X_TOOLKIT_TYPE=$USE_X_TOOLKIT
+ if test $succeeded = yes; then
+ HAVE_M17N_FLT=yes
+ else
+ HAVE_M17N_FLT=no
+ fi
-LIBXTR6=
-if test "${USE_X_TOOLKIT}" != "none"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 toolkit version" >&5
-$as_echo_n "checking X11 toolkit version... " >&6; }
- if test "${emacs_cv_x11_toolkit_version_6+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <X11/Intrinsic.h>
-int
-main ()
-{
-#if XtSpecificationRelease < 6
-fail;
-#endif
+ if test "$HAVE_M17N_FLT" = "yes"; then
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_x11_toolkit_version_6=yes
+$as_echo "#define HAVE_M17N_FLT 1" >>confdefs.h
+
+ fi
+ fi
+ fi
else
- emacs_cv_x11_toolkit_version_6=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+ HAVE_XFT=no
+ HAVE_FREETYPE=no
+ HAVE_LIBOTF=no
+ HAVE_M17N_FLT=no
fi
- HAVE_X11XTR6=$emacs_cv_x11_toolkit_version_6
- if test $emacs_cv_x11_toolkit_version_6 = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: 6 or newer" >&5
-$as_echo "6 or newer" >&6; }
+### End of font-backend (under X11) section.
+
+
+
+
-$as_echo "#define HAVE_X11XTR6 1" >>confdefs.h
- LIBXTR6="-lSM -lICE"
- case "$opsys" in
- ## Use libw.a along with X11R6 Xt.
- unixware) LIBXTR6="$LIBXTR6 -lw" ;;
- esac
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: before 6" >&5
-$as_echo "before 6" >&6; }
- fi
- OLDLIBS="$LIBS"
- if test x$HAVE_X11XTR6 = xyes; then
- LIBS="-lXt -lSM -lICE $LIBS"
- else
- LIBS="-lXt $LIBS"
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmuConvertStandardSelection in -lXmu" >&5
-$as_echo_n "checking for XmuConvertStandardSelection in -lXmu... " >&6; }
-if test "${ac_cv_lib_Xmu_XmuConvertStandardSelection+set}" = set; then :
+
+
+
+### Use -lXpm if available, unless `--with-xpm=no'.
+HAVE_XPM=no
+LIBXPM=
+if test "${HAVE_X11}" = "yes"; then
+ if test "${with_xpm}" != "no"; then
+ ac_fn_c_check_header_mongrel "$LINENO" "X11/xpm.h" "ac_cv_header_X11_xpm_h" "$ac_includes_default"
+if test "x$ac_cv_header_X11_xpm_h" = x""yes; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReadFileToPixmap in -lXpm" >&5
+$as_echo_n "checking for XpmReadFileToPixmap in -lXpm... " >&6; }
+if test "${ac_cv_lib_Xpm_XpmReadFileToPixmap+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXmu $LIBS"
+LIBS="-lXpm -lX11 $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char XmuConvertStandardSelection ();
+char XpmReadFileToPixmap ();
int
main ()
{
-return XmuConvertStandardSelection ();
+return XpmReadFileToPixmap ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xmu_XmuConvertStandardSelection=yes
+ ac_cv_lib_Xpm_XpmReadFileToPixmap=yes
else
- ac_cv_lib_Xmu_XmuConvertStandardSelection=no
+ ac_cv_lib_Xpm_XpmReadFileToPixmap=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xmu_XmuConvertStandardSelection" >&5
-$as_echo "$ac_cv_lib_Xmu_XmuConvertStandardSelection" >&6; }
-if test "x$ac_cv_lib_Xmu_XmuConvertStandardSelection" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_LIBXMU 1
-_ACEOF
-
- LIBS="-lXmu $LIBS"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xpm_XpmReadFileToPixmap" >&5
+$as_echo "$ac_cv_lib_Xpm_XpmReadFileToPixmap" >&6; }
+if test "x$ac_cv_lib_Xpm_XpmReadFileToPixmap" = x""yes; then :
+ HAVE_XPM=yes
+fi
fi
- test $ac_cv_lib_Xmu_XmuConvertStandardSelection = no && LIBS="$OLDLIBS"
+
+ if test "${HAVE_XPM}" = "yes"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReturnAllocPixels preprocessor define" >&5
+$as_echo_n "checking for XpmReturnAllocPixels preprocessor define... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include "X11/xpm.h"
+#ifndef XpmReturnAllocPixels
+no_return_alloc_pixels
+#endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "no_return_alloc_pixels" >/dev/null 2>&1; then :
+ HAVE_XPM=no
+else
+ HAVE_XPM=yes
fi
+rm -f conftest*
-LIBXMU=-lXmu
-case $opsys in
- ## These systems don't supply Xmu.
- hpux* | aix4-2 )
- test "X$ac_cv_lib_Xmu_XmuConvertStandardSelection" != "Xyes" && LIBXMU=
- ;;
-esac
+ if test "${HAVE_XPM}" = "yes"; 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; }
+ fi
+ fi
+ fi
+ if test "${HAVE_XPM}" = "yes"; then
-# On Irix 6.5, at least, we need XShapeQueryExtension from -lXext for Xaw3D.
+$as_echo "#define HAVE_XPM 1" >>confdefs.h
+
+ LIBXPM=-lXpm
+ fi
+fi
+
+
+### Use -ljpeg if available, unless `--with-jpeg=no'.
+HAVE_JPEG=no
+LIBJPEG=
if test "${HAVE_X11}" = "yes"; then
- if test "${USE_X_TOOLKIT}" != "none"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XShapeQueryExtension in -lXext" >&5
-$as_echo_n "checking for XShapeQueryExtension in -lXext... " >&6; }
-if test "${ac_cv_lib_Xext_XShapeQueryExtension+set}" = set; then :
+ if test "${with_jpeg}" != "no"; then
+ ac_fn_c_check_header_mongrel "$LINENO" "jerror.h" "ac_cv_header_jerror_h" "$ac_includes_default"
+if test "x$ac_cv_header_jerror_h" = x""yes; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jpeg_destroy_compress in -ljpeg" >&5
+$as_echo_n "checking for jpeg_destroy_compress in -ljpeg... " >&6; }
+if test "${ac_cv_lib_jpeg_jpeg_destroy_compress+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXext $LIBS"
+LIBS="-ljpeg $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char XShapeQueryExtension ();
+char jpeg_destroy_compress ();
int
main ()
{
-return XShapeQueryExtension ();
+return jpeg_destroy_compress ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xext_XShapeQueryExtension=yes
+ ac_cv_lib_jpeg_jpeg_destroy_compress=yes
else
- ac_cv_lib_Xext_XShapeQueryExtension=no
+ ac_cv_lib_jpeg_jpeg_destroy_compress=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xext_XShapeQueryExtension" >&5
-$as_echo "$ac_cv_lib_Xext_XShapeQueryExtension" >&6; }
-if test "x$ac_cv_lib_Xext_XShapeQueryExtension" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_LIBXEXT 1
-_ACEOF
-
- LIBS="-lXext $LIBS"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_jpeg_jpeg_destroy_compress" >&5
+$as_echo "$ac_cv_lib_jpeg_jpeg_destroy_compress" >&6; }
+if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = x""yes; then :
+ HAVE_JPEG=yes
+fi
fi
+
fi
-fi
-LIBXP=
-if test "${USE_X_TOOLKIT}" = "MOTIF"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Motif version 2.1" >&5
-$as_echo_n "checking for Motif version 2.1... " >&6; }
-if test "${emacs_cv_motif_version_2_1+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ if test "${HAVE_JPEG}" = "yes"; then
+ $as_echo "#define HAVE_JPEG 1" >>confdefs.h
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <Xm/Xm.h>
-int
-main ()
-{
-#if XmVERSION > 2 || (XmVERSION == 2 && XmREVISION >= 1)
-int x = 5;
-#else
-Motif version prior to 2.1.
-#endif
- ;
- return 0;
-}
+#include <jpeglib.h>
+ version=JPEG_LIB_VERSION
+
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_motif_version_2_1=yes
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "version= *(6[2-9]|[7-9][0-9])" >/dev/null 2>&1; then :
+ $as_echo "#define HAVE_JPEG 1" >>confdefs.h
+
else
- emacs_cv_motif_version_2_1=no
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: libjpeg found, but not version 6b or later" >&5
+$as_echo "$as_me: WARNING: libjpeg found, but not version 6b or later" >&2;}
+ HAVE_JPEG=no
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f conftest*
+
+ fi
+ if test "${HAVE_JPEG}" = "yes"; then
+ LIBJPEG=-ljpeg
+ fi
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_motif_version_2_1" >&5
-$as_echo "$emacs_cv_motif_version_2_1" >&6; }
- if test $emacs_cv_motif_version_2_1 = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpCreateContext in -lXp" >&5
-$as_echo_n "checking for XpCreateContext in -lXp... " >&6; }
-if test "${ac_cv_lib_Xp_XpCreateContext+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXp $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char XpCreateContext ();
-int
-main ()
-{
-return XpCreateContext ();
- ;
- return 0;
-}
+
+### Use -lpng if available, unless `--with-png=no'.
+HAVE_PNG=no
+LIBPNG=
+if test "${HAVE_X11}" = "yes"; then
+ if test "${with_png}" != "no"; then
+ # Debian unstable as of July 2003 has multiple libpngs, and puts png.h
+ # in /usr/include/libpng.
+ for ac_header in png.h libpng/png.h
+do :
+ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
+eval as_val=\$$as_ac_Header
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xp_XpCreateContext=yes
-else
- ac_cv_lib_Xp_XpCreateContext=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xp_XpCreateContext" >&5
-$as_echo "$ac_cv_lib_Xp_XpCreateContext" >&6; }
-if test "x$ac_cv_lib_Xp_XpCreateContext" = x""yes; then :
- LIBXP=-lXp
+ break
fi
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LessTif where some systems put it" >&5
-$as_echo_n "checking for LessTif where some systems put it... " >&6; }
-if test "${emacs_cv_lesstif+set}" = set; then :
+done
+
+ if test "$ac_cv_header_png_h" = yes || test "$ac_cv_header_libpng_png_h" = yes ; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for png_get_channels in -lpng" >&5
+$as_echo_n "checking for png_get_channels in -lpng... " >&6; }
+if test "${ac_cv_lib_png_png_get_channels+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- # We put this in CFLAGS temporarily to precede other -I options
- # that might be in CFLAGS temporarily.
- # We put this in CPPFLAGS where it precedes the other -I options.
- OLD_CPPFLAGS=$CPPFLAGS
- OLD_CFLAGS=$CFLAGS
- CPPFLAGS="-I/usr/X11R6/LessTif/Motif1.2/include $CPPFLAGS"
- CFLAGS="-I/usr/X11R6/LessTif/Motif1.2/include $CFLAGS"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lpng -lz -lm $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include </usr/X11R6/LessTif/Motif1.2/include/Xm/Xm.h>
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char png_get_channels ();
int
main ()
{
-int x = 5;
+return png_get_channels ();
;
return 0;
}
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_lesstif=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_png_png_get_channels=yes
else
- emacs_cv_lesstif=no
+ ac_cv_lib_png_png_get_channels=no
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_lesstif" >&5
-$as_echo "$emacs_cv_lesstif" >&6; }
- if test $emacs_cv_lesstif = yes; then
- # Make sure this -I option remains in CPPFLAGS after it is set
- # back to REAL_CPPFLAGS.
- # There is no need to change REAL_CFLAGS, because REAL_CFLAGS does not
- # have those other -I options anyway. Ultimately, having this
- # directory ultimately in CPPFLAGS will be enough.
- REAL_CPPFLAGS="-I/usr/X11R6/LessTif/Motif1.2/include $REAL_CPPFLAGS"
- LDFLAGS="-L/usr/X11R6/LessTif/Motif1.2/lib $LDFLAGS"
- else
- CFLAGS=$OLD_CFLAGS
- CPPFLAGS=$OLD_CPPFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_png_png_get_channels" >&5
+$as_echo "$ac_cv_lib_png_png_get_channels" >&6; }
+if test "x$ac_cv_lib_png_png_get_channels" = x""yes; then :
+ HAVE_PNG=yes
+fi
+
fi
fi
- ac_fn_c_check_header_mongrel "$LINENO" "Xm/BulletinB.h" "ac_cv_header_Xm_BulletinB_h" "$ac_includes_default"
-if test "x$ac_cv_header_Xm_BulletinB_h" = x""yes; then :
-else
- as_fn_error "Motif toolkit requested but requirements not found." "$LINENO" 5
-fi
+ if test "${HAVE_PNG}" = "yes"; then
+$as_echo "#define HAVE_PNG 1" >>confdefs.h
-fi
+ LIBPNG="-lpng -lz -lm"
+ ac_fn_c_check_decl "$LINENO" "png_longjmp" "ac_cv_have_decl_png_longjmp" "#ifdef HAVE_LIBPNG_PNG_H
+ # include <libpng/png.h>
+ #else
+ # include <png.h>
+ #endif
-USE_TOOLKIT_SCROLL_BARS=no
-if test "${with_toolkit_scroll_bars}" != "no"; then
- if test "${USE_X_TOOLKIT}" != "none"; then
- if test "${USE_X_TOOLKIT}" = "MOTIF"; then
- $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
+"
+if test "x$ac_cv_have_decl_png_longjmp" = x""yes; then :
- HAVE_XAW3D=no
- USE_TOOLKIT_SCROLL_BARS=yes
- elif test "${HAVE_XAW3D}" = "yes" || test "${USE_X_TOOLKIT}" = "LUCID"; then
- $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
+else
- USE_TOOLKIT_SCROLL_BARS=yes
- fi
- elif test "${HAVE_GTK}" = "yes"; then
- $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
+$as_echo "#define PNG_DEPSTRUCT /**/" >>confdefs.h
- USE_TOOLKIT_SCROLL_BARS=yes
- elif test "${HAVE_NS}" = "yes"; then
- $as_echo "#define USE_TOOLKIT_SCROLL_BARS 1" >>confdefs.h
+fi
- USE_TOOLKIT_SCROLL_BARS=yes
fi
fi
+
+### Use -ltiff if available, unless `--with-tiff=no'.
+HAVE_TIFF=no
+LIBTIFF=
+if test "${HAVE_X11}" = "yes"; then
+ if test "${with_tiff}" != "no"; then
+ ac_fn_c_check_header_mongrel "$LINENO" "tiffio.h" "ac_cv_header_tiffio_h" "$ac_includes_default"
+if test "x$ac_cv_header_tiffio_h" = x""yes; then :
+ tifflibs="-lz -lm"
+ # At least one tiff package requires the jpeg library.
+ if test "${HAVE_JPEG}" = yes; then tifflibs="-ljpeg $tifflibs"; fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFGetVersion in -ltiff" >&5
+$as_echo_n "checking for TIFFGetVersion in -ltiff... " >&6; }
+if test "${ac_cv_lib_tiff_TIFFGetVersion+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ltiff $tifflibs $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
- #include <X11/Xlib.h>
- #include <X11/Xresource.h>
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char TIFFGetVersion ();
int
main ()
{
-XIMProc callback;
+return TIFFGetVersion ();
;
return 0;
}
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- HAVE_XIM=yes
-
-$as_echo "#define HAVE_XIM 1" >>confdefs.h
-
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_tiff_TIFFGetVersion=yes
else
- HAVE_XIM=no
+ ac_cv_lib_tiff_TIFFGetVersion=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tiff_TIFFGetVersion" >&5
+$as_echo "$ac_cv_lib_tiff_TIFFGetVersion" >&6; }
+if test "x$ac_cv_lib_tiff_TIFFGetVersion" = x""yes; then :
+ HAVE_TIFF=yes
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-
-
-if test "${with_xim}" != "no"; then
-
-$as_echo "#define USE_XIM 1" >>confdefs.h
fi
-if test "${HAVE_XIM}" != "no"; then
- late_CFLAGS=$CFLAGS
- if test "$GCC" = yes; then
- CFLAGS="$CFLAGS --pedantic-errors"
fi
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <X11/Xlib.h>
-#include <X11/Xresource.h>
-int
-main ()
-{
-Display *display;
-XrmDatabase db;
-char *res_name;
-char *res_class;
-XIMProc callback;
-XPointer *client_data;
-#ifndef __GNUC__
-/* If we're not using GCC, it's probably not XFree86, and this is
- probably right, but we can't use something like --pedantic-errors. */
-extern Bool XRegisterIMInstantiateCallback(Display*, XrmDatabase, char*,
- char*, XIMProc, XPointer*);
-#endif
-(void)XRegisterIMInstantiateCallback(display, db, res_name, res_class, callback,
- client_data);
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_arg6_star=yes
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- if test "$emacs_cv_arg6_star" = yes; then
- $as_echo "#define XRegisterIMInstantiateCallback_arg6 XPointer*" >>confdefs.h
+ if test "${HAVE_TIFF}" = "yes"; then
- else
- $as_echo "#define XRegisterIMInstantiateCallback_arg6 XPointer" >>confdefs.h
+$as_echo "#define HAVE_TIFF 1" >>confdefs.h
+ LIBTIFF=-ltiff
fi
- CFLAGS=$late_CFLAGS
fi
-### Start of font-backend (under any platform) section.
-# (nothing here yet -- this is a placeholder)
-### End of font-backend (under any platform) section.
-
-### Start of font-backend (under X11) section.
-if test "${HAVE_X11}" = "yes"; then
-
- succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+### Use -lgif or -lungif if available, unless `--with-gif=no'.
+HAVE_GIF=no
+LIBGIF=
+if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no"; then
+ ac_fn_c_check_header_mongrel "$LINENO" "gif_lib.h" "ac_cv_header_gif_lib_h" "$ac_includes_default"
+if test "x$ac_cv_header_gif_lib_h" = x""yes; then :
+ # EGifPutExtensionLast only exists from version libungif-4.1.0b1.
+# Earlier versions can crash Emacs.
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lgif" >&5
+$as_echo_n "checking for EGifPutExtensionLast in -lgif... " >&6; }
+if test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
- if test "$PKG_CONFIG" = "no" ; then
- HAVE_FC=no
- else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fontconfig >= 2.2.0" >&5
-$as_echo_n "checking for fontconfig >= 2.2.0... " >&6; }
-
- if $PKG_CONFIG --exists "fontconfig >= 2.2.0" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking FONTCONFIG_CFLAGS" >&5
-$as_echo_n "checking FONTCONFIG_CFLAGS... " >&6; }
- FONTCONFIG_CFLAGS=`$PKG_CONFIG --cflags "fontconfig >= 2.2.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FONTCONFIG_CFLAGS" >&5
-$as_echo "$FONTCONFIG_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking FONTCONFIG_LIBS" >&5
-$as_echo_n "checking FONTCONFIG_LIBS... " >&6; }
- FONTCONFIG_LIBS=`$PKG_CONFIG --libs "fontconfig >= 2.2.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FONTCONFIG_LIBS" >&5
-$as_echo "$FONTCONFIG_LIBS" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- FONTCONFIG_CFLAGS=""
- FONTCONFIG_LIBS=""
- ## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- FONTCONFIG_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "fontconfig >= 2.2.0"`
-
- fi
-
-
-
- else
- echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
- echo "*** See http://www.freedesktop.org/software/pkgconfig"
- fi
- fi
-
- if test $succeeded = yes; then
- HAVE_FC=yes
- else
- HAVE_FC=no
- fi
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lgif $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char EGifPutExtensionLast ();
+int
+main ()
+{
+return EGifPutExtensionLast ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_gif_EGifPutExtensionLast=yes
+else
+ ac_cv_lib_gif_EGifPutExtensionLast=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gif_EGifPutExtensionLast" >&5
+$as_echo "$ac_cv_lib_gif_EGifPutExtensionLast" >&6; }
+if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = x""yes; then :
+ HAVE_GIF=yes
+else
+ HAVE_GIF=maybe
+fi
- ## Use -lXft if available, unless `--with-xft=no'.
- HAVE_XFT=maybe
- if test "${HAVE_FC}" = "no" || test "x${with_x}" = "xno"; then
- with_xft="no";
- fi
- if test "x${with_xft}" != "xno"; then
+fi
- succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+ if test "$HAVE_GIF" = yes; then
+ LIBGIF=-lgif
+ elif test "$HAVE_GIF" = maybe; then
+# If gif_lib.h but no libgif, try libungif.
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lungif" >&5
+$as_echo_n "checking for EGifPutExtensionLast in -lungif... " >&6; }
+if test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lungif $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char EGifPutExtensionLast ();
+int
+main ()
+{
+return EGifPutExtensionLast ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_ungif_EGifPutExtensionLast=yes
+else
+ ac_cv_lib_ungif_EGifPutExtensionLast=no
fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ungif_EGifPutExtensionLast" >&5
+$as_echo "$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; }
+if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = x""yes; then :
+ HAVE_GIF=yes
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ HAVE_GIF=no
fi
+ test "$HAVE_GIF" = yes && LIBGIF=-lungif
+ fi
+ if test "${HAVE_GIF}" = "yes"; then
- if test "$PKG_CONFIG" = "no" ; then
- HAVE_XFT=no
- else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xft >= 0.13.0" >&5
-$as_echo_n "checking for xft >= 0.13.0... " >&6; }
-
- if $PKG_CONFIG --exists "xft >= 0.13.0" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking XFT_CFLAGS" >&5
-$as_echo_n "checking XFT_CFLAGS... " >&6; }
- XFT_CFLAGS=`$PKG_CONFIG --cflags "xft >= 0.13.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $XFT_CFLAGS" >&5
-$as_echo "$XFT_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking XFT_LIBS" >&5
-$as_echo_n "checking XFT_LIBS... " >&6; }
- XFT_LIBS=`$PKG_CONFIG --libs "xft >= 0.13.0"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $XFT_LIBS" >&5
-$as_echo "$XFT_LIBS" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- XFT_CFLAGS=""
- XFT_LIBS=""
- ## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- XFT_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "xft >= 0.13.0"`
-
- fi
+$as_echo "#define HAVE_GIF 1" >>confdefs.h
+ fi
+fi
- else
- echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
- echo "*** See http://www.freedesktop.org/software/pkgconfig"
- fi
- fi
+if test "${HAVE_X11}" = "yes"; then
+ MISSING=""
+ WITH_NO=""
+ test "${with_xpm}" != "no" && test "${HAVE_XPM}" != "yes" &&
+ MISSING="libXpm" && WITH_NO="--with-xpm=no"
+ test "${with_jpeg}" != "no" && test "${HAVE_JPEG}" != "yes" &&
+ MISSING="$MISSING libjpeg" && WITH_NO="$WITH_NO --with-jpeg=no"
+ test "${with_png}" != "no" && test "${HAVE_PNG}" != "yes" &&
+ MISSING="$MISSING libpng" && WITH_NO="$WITH_NO --with-png=no"
+ test "${with_gif}" != "no" && test "${HAVE_GIF}" != "yes" &&
+ MISSING="$MISSING libgif/libungif" && WITH_NO="$WITH_NO --with-gif=no"
+ test "${with_tiff}" != "no" && test "${HAVE_TIFF}" != "yes" &&
+ MISSING="$MISSING libtiff" && WITH_NO="$WITH_NO --with-tiff=no"
- if test $succeeded = yes; then
- :
- else
- HAVE_XFT=no
+ if test "X${MISSING}" != X; then
+ as_fn_error "The following required libraries were not found:
+ $MISSING
+Maybe some development libraries/packages are missing?
+If you don't want to link with them give
+ $WITH_NO
+as options to configure" "$LINENO" 5
fi
+fi
- ## Because xftfont.c uses XRenderQueryExtension, we also
- ## need to link to -lXrender.
- HAVE_XRENDER=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XRenderQueryExtension in -lXrender" >&5
-$as_echo_n "checking for XRenderQueryExtension in -lXrender... " >&6; }
-if test "${ac_cv_lib_Xrender_XRenderQueryExtension+set}" = set; then :
+### Use -lgpm if available, unless `--with-gpm=no'.
+HAVE_GPM=no
+LIBGPM=
+if test "${with_gpm}" != "no"; then
+ ac_fn_c_check_header_mongrel "$LINENO" "gpm.h" "ac_cv_header_gpm_h" "$ac_includes_default"
+if test "x$ac_cv_header_gpm_h" = x""yes; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Gpm_Open in -lgpm" >&5
+$as_echo_n "checking for Gpm_Open in -lgpm... " >&6; }
+if test "${ac_cv_lib_gpm_Gpm_Open+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXrender $LIBS"
+LIBS="-lgpm $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char XRenderQueryExtension ();
+char Gpm_Open ();
int
main ()
{
-return XRenderQueryExtension ();
+return Gpm_Open ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xrender_XRenderQueryExtension=yes
+ ac_cv_lib_gpm_Gpm_Open=yes
else
- ac_cv_lib_Xrender_XRenderQueryExtension=no
+ ac_cv_lib_gpm_Gpm_Open=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xrender_XRenderQueryExtension" >&5
-$as_echo "$ac_cv_lib_Xrender_XRenderQueryExtension" >&6; }
-if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = x""yes; then :
- HAVE_XRENDER=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gpm_Gpm_Open" >&5
+$as_echo "$ac_cv_lib_gpm_Gpm_Open" >&6; }
+if test "x$ac_cv_lib_gpm_Gpm_Open" = x""yes; then :
+ HAVE_GPM=yes
fi
- if test "$HAVE_XFT" != no && test "$HAVE_XRENDER" != no; then
- OLD_CPPFLAGS="$CPPFLAGS"
- OLD_CFLAGS="$CFLAGS"
- OLD_LIBS="$LIBS"
- CPPFLAGS="$CPPFLAGS $XFT_CFLAGS"
- CFLAGS="$CFLAGS $XFT_CFLAGS"
- XFT_LIBS="-lXrender $XFT_LIBS"
- LIBS="$XFT_LIBS $LIBS"
- ac_fn_c_check_header_mongrel "$LINENO" "X11/Xft/Xft.h" "ac_cv_header_X11_Xft_Xft_h" "$ac_includes_default"
-if test "x$ac_cv_header_X11_Xft_Xft_h" = x""yes; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XftFontOpen in -lXft" >&5
-$as_echo_n "checking for XftFontOpen in -lXft... " >&6; }
-if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then :
+fi
+
+
+
+ if test "${HAVE_GPM}" = "yes"; then
+
+$as_echo "#define HAVE_GPM 1" >>confdefs.h
+
+ LIBGPM=-lgpm
+ fi
+fi
+
+
+
+
+
+
+GNUSTEP_CFLAGS=
+### Use NeXTstep API to implement GUI.
+if test "${HAVE_NS}" = "yes"; then
+
+$as_echo "#define HAVE_NS 1" >>confdefs.h
+
+ if test "${NS_IMPL_COCOA}" = "yes"; then
+
+$as_echo "#define NS_IMPL_COCOA 1" >>confdefs.h
+
+ fi
+ if test "${NS_IMPL_GNUSTEP}" = "yes"; then
+
+$as_echo "#define NS_IMPL_GNUSTEP 1" >>confdefs.h
+
+ # See also .m.o rule in Makefile.in */
+ # FIXME: are all these flags really needed? Document here why. */
+ GNUSTEP_CFLAGS="-D_REENTRANT -fPIC -fno-strict-aliasing -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
+ ## Extra CFLAGS applied to src/*.m files.
+ GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fgnu-runtime -Wno-import -fconstant-string-class=NSConstantString -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 -DGNU_RUNTIME=1 -DGSWARN -DGSDIAGNOSE"
+ fi
+ # We also have mouse menus.
+ HAVE_MENUS=yes
+ OTHER_FILES=ns-app
+fi
+
+
+### Use session management (-lSM -lICE) if available
+HAVE_X_SM=no
+LIBXSM=
+if test "${HAVE_X11}" = "yes"; then
+ ac_fn_c_check_header_mongrel "$LINENO" "X11/SM/SMlib.h" "ac_cv_header_X11_SM_SMlib_h" "$ac_includes_default"
+if test "x$ac_cv_header_X11_SM_SMlib_h" = x""yes; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SmcOpenConnection in -lSM" >&5
+$as_echo_n "checking for SmcOpenConnection in -lSM... " >&6; }
+if test "${ac_cv_lib_SM_SmcOpenConnection+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXft $XFT_LIBS $LIBS"
+LIBS="-lSM -lICE $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char XftFontOpen ();
+char SmcOpenConnection ();
int
main ()
{
-return XftFontOpen ();
+return SmcOpenConnection ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xft_XftFontOpen=yes
+ ac_cv_lib_SM_SmcOpenConnection=yes
else
- ac_cv_lib_Xft_XftFontOpen=no
+ ac_cv_lib_SM_SmcOpenConnection=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xft_XftFontOpen" >&5
-$as_echo "$ac_cv_lib_Xft_XftFontOpen" >&6; }
-if test "x$ac_cv_lib_Xft_XftFontOpen" = x""yes; then :
- HAVE_XFT=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_SM_SmcOpenConnection" >&5
+$as_echo "$ac_cv_lib_SM_SmcOpenConnection" >&6; }
+if test "x$ac_cv_lib_SM_SmcOpenConnection" = x""yes; then :
+ HAVE_X_SM=yes
fi
fi
- if test "${HAVE_XFT}" = "yes"; then
-
-$as_echo "#define HAVE_XFT 1" >>confdefs.h
-
-
- C_SWITCH_X_SITE="$C_SWITCH_X_SITE $XFT_CFLAGS"
- else
- CPPFLAGS="$OLD_CPPFLAGS"
- CFLAGS="$OLD_CFLAGS"
- LIBS="$OLD_LIBS"
- fi # "${HAVE_XFT}" = "yes"
- fi # "$HAVE_XFT" != no
- fi # "x${with_xft}" != "xno"
-
- ## We used to allow building with FreeType and without Xft.
- ## However, the ftx font backend driver is not in good shape.
- if test "$HAVE_XFT" != "yes"; then
- HAVE_XFT=no
- HAVE_FREETYPE=no
- else
+ if test "${HAVE_X_SM}" = "yes"; then
- succeeded=no
+$as_echo "#define HAVE_X_SM 1" >>confdefs.h
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
+ LIBXSM="-lSM -lICE"
+ case "$LIBS" in
+ *-lSM*) ;;
+ *) LIBS="$LIBXSM $LIBS" ;;
+ esac
fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
fi
+### Use libxml (-lxml2) if available
+HAVE_LIBXML2=no
+if test "${with_xml2}" != "no"; then
+ ### I'm not sure what the version number should be, so I just guessed.
+
+ succeeded=no
if test "$PKG_CONFIG" = "no" ; then
- HAVE_FREETYPE=no
+ HAVE_LIBXML2=no
else
PKG_CONFIG_MIN_VERSION=0.9.0
if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for freetype2" >&5
-$as_echo_n "checking for freetype2... " >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0 > 2.6.17" >&5
+$as_echo_n "checking for libxml-2.0 > 2.6.17... " >&6; }
- if $PKG_CONFIG --exists "freetype2" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+ if $PKG_CONFIG --exists "libxml-2.0 > 2.6.17" 2>&5 &&
+ LIBXML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0 > 2.6.17" 2>&5` &&
+ LIBXML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0 > 2.6.17" 2>&5`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ LIBXML2_CFLAGS=`$as_echo "$LIBXML2_CFLAGS" | sed -e "$edit_cflags"`
+ LIBXML2_LIBS=`$as_echo "$LIBXML2_LIBS" | sed -e 's,///*,/,g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes CFLAGS='$LIBXML2_CFLAGS' LIBS='$LIBXML2_LIBS'" >&5
+$as_echo "yes CFLAGS='$LIBXML2_CFLAGS' LIBS='$LIBXML2_LIBS'" >&6; }
succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking FREETYPE_CFLAGS" >&5
-$as_echo_n "checking FREETYPE_CFLAGS... " >&6; }
- FREETYPE_CFLAGS=`$PKG_CONFIG --cflags "freetype2"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FREETYPE_CFLAGS" >&5
-$as_echo "$FREETYPE_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking FREETYPE_LIBS" >&5
-$as_echo_n "checking FREETYPE_LIBS... " >&6; }
- FREETYPE_LIBS=`$PKG_CONFIG --libs "freetype2"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FREETYPE_LIBS" >&5
-$as_echo "$FREETYPE_LIBS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
- FREETYPE_CFLAGS=""
- FREETYPE_LIBS=""
+ LIBXML2_CFLAGS=""
+ LIBXML2_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- FREETYPE_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "freetype2"`
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ LIBXML2_PKG_ERRORS=`($PKG_CONFIG --print-errors "libxml-2.0 > 2.6.17") 2>&1`
fi
fi
if test $succeeded = yes; then
- HAVE_FREETYPE=yes
+ HAVE_LIBXML2=yes
else
- HAVE_FREETYPE=no
+ HAVE_LIBXML2=no
fi
+ if test "${HAVE_LIBXML2}" = "yes"; then
+ LIBS="$LIBXML2_LIBS $LIBS"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for htmlReadMemory in -lxml2" >&5
+$as_echo_n "checking for htmlReadMemory in -lxml2... " >&6; }
+if test "${ac_cv_lib_xml2_htmlReadMemory+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lxml2 $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- test "$HAVE_FREETYPE" = "no" && as_fn_error "libxft requires libfreetype" "$LINENO" 5
- fi
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char htmlReadMemory ();
+int
+main ()
+{
+return htmlReadMemory ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_xml2_htmlReadMemory=yes
+else
+ ac_cv_lib_xml2_htmlReadMemory=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_htmlReadMemory" >&5
+$as_echo "$ac_cv_lib_xml2_htmlReadMemory" >&6; }
+if test "x$ac_cv_lib_xml2_htmlReadMemory" = x""yes; then :
+ HAVE_LIBXML2=yes
+else
+ HAVE_LIBXML2=no
+fi
- HAVE_LIBOTF=no
- if test "${HAVE_FREETYPE}" = "yes"; then
+ if test "${HAVE_LIBXML2}" = "yes"; then
-$as_echo "#define HAVE_FREETYPE 1" >>confdefs.h
+$as_echo "#define HAVE_LIBXML2 1" >>confdefs.h
- if test "${with_libotf}" != "no"; then
+ else
+ LIBXML2_LIBS=""
+ LIBXML2_CFLAGS=""
+ fi
+ fi
+fi
- succeeded=no
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+
+# If netdb.h doesn't declare h_errno, we must declare it by hand.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5
+$as_echo_n "checking whether netdb declares h_errno... " >&6; }
+if test "${emacs_cv_netdb_declares_h_errno+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <netdb.h>
+int
+main ()
+{
+return h_errno;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_netdb_declares_h_errno=yes
+else
+ emacs_cv_netdb_declares_h_errno=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_netdb_declares_h_errno" >&5
+$as_echo "$emacs_cv_netdb_declares_h_errno" >&6; }
+if test $emacs_cv_netdb_declares_h_errno = yes; then
+
+$as_echo "#define HAVE_H_ERRNO 1" >>confdefs.h
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
+
+# sqrt and other floating-point functions such as fmod and frexp
+# are found in -lm on most systems.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrt in -lm" >&5
+$as_echo_n "checking for sqrt in -lm... " >&6; }
+if test "${ac_cv_lib_m_sqrt+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char sqrt ();
+int
+main ()
+{
+return sqrt ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_m_sqrt=yes
+else
+ ac_cv_lib_m_sqrt=no
fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sqrt" >&5
+$as_echo "$ac_cv_lib_m_sqrt" >&6; }
+if test "x$ac_cv_lib_m_sqrt" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBM 1
+_ACEOF
+ LIBS="-lm $LIBS"
-
- if test "$PKG_CONFIG" = "no" ; then
- HAVE_LIBOTF=no
- else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libotf" >&5
-$as_echo_n "checking for libotf... " >&6; }
-
- if $PKG_CONFIG --exists "libotf" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- succeeded=yes
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBOTF_CFLAGS" >&5
-$as_echo_n "checking LIBOTF_CFLAGS... " >&6; }
- LIBOTF_CFLAGS=`$PKG_CONFIG --cflags "libotf"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBOTF_CFLAGS" >&5
-$as_echo "$LIBOTF_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBOTF_LIBS" >&5
-$as_echo_n "checking LIBOTF_LIBS... " >&6; }
- LIBOTF_LIBS=`$PKG_CONFIG --libs "libotf"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBOTF_LIBS" >&5
-$as_echo "$LIBOTF_LIBS" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- LIBOTF_CFLAGS=""
- LIBOTF_LIBS=""
- ## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- LIBOTF_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "libotf"`
-
- fi
-
+fi
- else
- echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
- echo "*** See http://www.freedesktop.org/software/pkgconfig"
- fi
- fi
+# Check for mail-locking functions in a "mail" library. Probably this should
+# have the same check as for liblockfile below.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -lmail" >&5
+$as_echo_n "checking for maillock in -lmail... " >&6; }
+if test "${ac_cv_lib_mail_maillock+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lmail $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- if test $succeeded = yes; then
- HAVE_LIBOTF=yes
- else
- HAVE_LIBOTF=no
- fi
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char maillock ();
+int
+main ()
+{
+return maillock ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_mail_maillock=yes
+else
+ ac_cv_lib_mail_maillock=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mail_maillock" >&5
+$as_echo "$ac_cv_lib_mail_maillock" >&6; }
+if test "x$ac_cv_lib_mail_maillock" = x""yes; then :
+ have_mail=yes
+else
+ have_mail=no
+fi
- if test "$HAVE_LIBOTF" = "yes"; then
+if test $have_mail = yes; then
+ LIBS_MAIL=-lmail
+ LIBS="$LIBS_MAIL $LIBS"
-$as_echo "#define HAVE_LIBOTF 1" >>confdefs.h
+$as_echo "#define HAVE_LIBMAIL 1" >>confdefs.h
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OTF_get_variation_glyphs in -lotf" >&5
-$as_echo_n "checking for OTF_get_variation_glyphs in -lotf... " >&6; }
-if test "${ac_cv_lib_otf_OTF_get_variation_glyphs+set}" = set; then :
+else
+ LIBS_MAIL=
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -llockfile" >&5
+$as_echo_n "checking for maillock in -llockfile... " >&6; }
+if test "${ac_cv_lib_lockfile_maillock+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lotf $LIBS"
+LIBS="-llockfile $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char OTF_get_variation_glyphs ();
+char maillock ();
int
main ()
{
-return OTF_get_variation_glyphs ();
+return maillock ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_otf_OTF_get_variation_glyphs=yes
+ ac_cv_lib_lockfile_maillock=yes
else
- ac_cv_lib_otf_OTF_get_variation_glyphs=no
+ ac_cv_lib_lockfile_maillock=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_otf_OTF_get_variation_glyphs" >&5
-$as_echo "$ac_cv_lib_otf_OTF_get_variation_glyphs" >&6; }
-if test "x$ac_cv_lib_otf_OTF_get_variation_glyphs" = x""yes; then :
- HAVE_OTF_GET_VARIATION_GLYPHS=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lockfile_maillock" >&5
+$as_echo "$ac_cv_lib_lockfile_maillock" >&6; }
+if test "x$ac_cv_lib_lockfile_maillock" = x""yes; then :
+ have_lockfile=yes
else
- HAVE_OTF_GET_VARIATION_GLYPHS=no
+ have_lockfile=no
fi
- if test "${HAVE_OTF_GET_VARIATION_GLYPHS}" = "yes"; then
-
-$as_echo "#define HAVE_OTF_GET_VARIATION_GLYPHS 1" >>confdefs.h
-
- fi
- fi
- fi
- fi
-
- HAVE_M17N_FLT=no
- if test "${HAVE_LIBOTF}" = yes; then
- if test "${with_m17n_flt}" != "no"; then
+if test $have_lockfile = yes; then
+ LIBS_MAIL=-llockfile
+ LIBS="$LIBS_MAIL $LIBS"
- succeeded=no
+$as_echo "#define HAVE_LIBLOCKFILE 1" >>confdefs.h
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
+else
+# If we have the shared liblockfile, assume we must use it for mail
+# locking (e.g. Debian). If we couldn't link against liblockfile
+# (no liblockfile.a installed), ensure that we don't need to.
+ # Extract the first word of "liblockfile.so", so it can be a program name with args.
+set dummy liblockfile.so; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
+if test "${ac_cv_prog_liblockfile+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
+ if test -n "$liblockfile"; then
+ ac_cv_prog_liblockfile="$liblockfile" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_dummy="/usr/lib:/lib:/usr/local/lib:$LD_LIBRARY_PATH"
+for as_dir in $as_dummy
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
+ ac_cv_prog_liblockfile="yes"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
IFS=$as_save_IFS
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
+ test -z "$ac_cv_prog_liblockfile" && ac_cv_prog_liblockfile="no"
fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
+fi
+liblockfile=$ac_cv_prog_liblockfile
+if test -n "$liblockfile"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $liblockfile" >&5
+$as_echo "$liblockfile" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
+ if test $ac_cv_prog_liblockfile = yes; then
+ as_fn_error "Shared liblockfile found but can't link against it.
+This probably means that movemail could lose mail.
+There may be a \`development' package to install containing liblockfile." "$LINENO" 5
+ fi
+fi
- if test "$PKG_CONFIG" = "no" ; then
- HAVE_M17N_FLT=no
- else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for m17n-flt" >&5
-$as_echo_n "checking for m17n-flt... " >&6; }
-
- if $PKG_CONFIG --exists "m17n-flt" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- succeeded=yes
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking M17N_FLT_CFLAGS" >&5
-$as_echo_n "checking M17N_FLT_CFLAGS... " >&6; }
- M17N_FLT_CFLAGS=`$PKG_CONFIG --cflags "m17n-flt"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $M17N_FLT_CFLAGS" >&5
-$as_echo "$M17N_FLT_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking M17N_FLT_LIBS" >&5
-$as_echo_n "checking M17N_FLT_LIBS... " >&6; }
- M17N_FLT_LIBS=`$PKG_CONFIG --libs "m17n-flt"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $M17N_FLT_LIBS" >&5
-$as_echo "$M17N_FLT_LIBS" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- M17N_FLT_CFLAGS=""
- M17N_FLT_LIBS=""
- ## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- M17N_FLT_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "m17n-flt"`
- fi
+## Define MAIL_USE_FLOCK (or LOCKF) if the mailer uses flock (or lockf) to
+## interlock access to the mail spool. The alternative is a lock file named
+## /usr/spool/mail/$USER.lock.
+mail_lock=no
+case "$opsys" in
+ aix4-2) mail_lock="lockf" ;;
- else
- echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
- echo "*** See http://www.freedesktop.org/software/pkgconfig"
- fi
- fi
+ gnu|freebsd|netbsd|openbsd|darwin|irix6-5) mail_lock="flock" ;;
- if test $succeeded = yes; then
- HAVE_M17N_FLT=yes
- else
- HAVE_M17N_FLT=no
- fi
+ ## On GNU/Linux systems, both methods are used by various mail programs.
+ ## I assume most people are using newer mailers that have heard of flock.
+ ## Change this if you need to.
+ ## Debian contains a patch which says: ``On Debian/GNU/Linux systems,
+ ## configure gets the right answers, and that means *NOT* using flock.
+ ## Using flock is guaranteed to be the wrong thing. See Debian Policy
+ ## for details.'' and then uses `#ifdef DEBIAN'. Unfortunately the
+ ## Debian maintainer hasn't provided a clean fix for Emacs.
+ ## movemail.c will use `maillock' when MAILDIR, HAVE_LIBMAIL and
+ ## HAVE_MAILLOCK_H are defined, so the following appears to be the
+ ## correct logic. -- fx
+ ## We must check for HAVE_LIBLOCKFILE too, as movemail does.
+ ## liblockfile is a Free Software replacement for libmail, used on
+ ## Debian systems and elsewhere. -rfr.
+ gnu-*)
+ mail_lock="flock"
+ if test $have_mail = yes || test $have_lockfile = yes; then
+ test $ac_cv_header_maillock_h = yes && mail_lock=no
+ fi
+ ;;
+esac
- if test "$HAVE_M17N_FLT" = "yes"; then
+BLESSMAIL_TARGET=
+case "$mail_lock" in
+ flock)
+$as_echo "#define MAIL_USE_FLOCK 1" >>confdefs.h
+ ;;
-$as_echo "#define HAVE_M17N_FLT 1" >>confdefs.h
+ lockf)
+$as_echo "#define MAIL_USE_LOCKF 1" >>confdefs.h
+ ;;
- fi
- fi
- fi
-else
- HAVE_XFT=no
- HAVE_FREETYPE=no
- HAVE_LIBOTF=no
- HAVE_M17N_FLT=no
-fi
+ *) BLESSMAIL_TARGET="need-blessmail" ;;
+esac
-### End of font-backend (under X11) section.
+for ac_func in gethostname \
+closedir getrusage get_current_dir_name \
+lrand48 setsid \
+fpathconf select euidaccess getpagesize setlocale \
+utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \
+__fpending strsignal setitimer \
+sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \
+gai_strerror mkstemp getline getdelim fsync sync \
+difftime posix_memalign \
+getpwent endpwent getgrent endgrent \
+touchlock \
+cfmakeraw cfsetspeed copysign __executable_start
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+fi
+done
+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"
+if test "x$ac_cv_func_getwd" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_GETWD 1
+_ACEOF
+fi
+done
+fi
-### Use -lXpm if available, unless `--with-xpm=no'.
-HAVE_XPM=no
-LIBXPM=
-if test "${HAVE_X11}" = "yes"; then
- if test "${with_xpm}" != "no"; then
- ac_fn_c_check_header_mongrel "$LINENO" "X11/xpm.h" "ac_cv_header_X11_xpm_h" "$ac_includes_default"
-if test "x$ac_cv_header_X11_xpm_h" = x""yes; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReadFileToPixmap in -lXpm" >&5
-$as_echo_n "checking for XpmReadFileToPixmap in -lXpm... " >&6; }
-if test "${ac_cv_lib_Xpm_XpmReadFileToPixmap+set}" = set; then :
+## Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines
+## has a broken `rint' in some library versions including math library
+## version number A.09.05.
+## You can fix the math library by installing patch number PHSS_4630.
+## But we can fix it more reliably for Emacs by just not using rint.
+## We also skip HAVE_RANDOM - see comments in src/conf_post.h.
+case $opsys in
+ hpux*) : ;;
+ *) for ac_func in random rint
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+ ;;
+esac
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __builtin_unwind_init" >&5
+$as_echo_n "checking for __builtin_unwind_init... " >&6; }
+if test "${emacs_cv_func___builtin_unwind_init+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXpm -lX11 $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char XpmReadFileToPixmap ();
int
main ()
{
-return XpmReadFileToPixmap ();
+__builtin_unwind_init ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xpm_XpmReadFileToPixmap=yes
+ emacs_cv_func___builtin_unwind_init=yes
else
- ac_cv_lib_Xpm_XpmReadFileToPixmap=no
+ emacs_cv_func___builtin_unwind_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xpm_XpmReadFileToPixmap" >&5
-$as_echo "$ac_cv_lib_Xpm_XpmReadFileToPixmap" >&6; }
-if test "x$ac_cv_lib_Xpm_XpmReadFileToPixmap" = x""yes; then :
- HAVE_XPM=yes
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_func___builtin_unwind_init" >&5
+$as_echo "$emacs_cv_func___builtin_unwind_init" >&6; }
+if test $emacs_cv_func___builtin_unwind_init = yes; then
-fi
-
-
- if test "${HAVE_XPM}" = "yes"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReturnAllocPixels preprocessor define" >&5
-$as_echo_n "checking for XpmReturnAllocPixels preprocessor define... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include "X11/xpm.h"
-#ifndef XpmReturnAllocPixels
-no_return_alloc_pixels
-#endif
+$as_echo "#define HAVE___BUILTIN_UNWIND_INIT 1" >>confdefs.h
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "no_return_alloc_pixels" >/dev/null 2>&1; then :
- HAVE_XPM=no
-else
- HAVE_XPM=yes
fi
-rm -f conftest*
-
- if test "${HAVE_XPM}" = "yes"; 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; }
- fi
- fi
- fi
-
- if test "${HAVE_XPM}" = "yes"; then
-$as_echo "#define HAVE_XPM 1" >>confdefs.h
- LIBXPM=-lXpm
- fi
-fi
-### Use -ljpeg if available, unless `--with-jpeg=no'.
-HAVE_JPEG=no
-LIBJPEG=
-if test "${HAVE_X11}" = "yes"; then
- if test "${with_jpeg}" != "no"; then
- ac_fn_c_check_header_mongrel "$LINENO" "jerror.h" "ac_cv_header_jerror_h" "$ac_includes_default"
-if test "x$ac_cv_header_jerror_h" = x""yes; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jpeg_destroy_compress in -ljpeg" >&5
-$as_echo_n "checking for jpeg_destroy_compress in -ljpeg... " >&6; }
-if test "${ac_cv_lib_jpeg_jpeg_destroy_compress+set}" = set; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGEFILE_SOURCE value needed for large files" >&5
+$as_echo_n "checking for _LARGEFILE_SOURCE value needed for large files... " >&6; }
+if test "${ac_cv_sys_largefile_source+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-ljpeg $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ while :; do
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char jpeg_destroy_compress ();
+#include <sys/types.h> /* for off_t */
+ #include <stdio.h>
int
main ()
{
-return jpeg_destroy_compress ();
+int (*fp) (FILE *, off_t, int) = fseeko;
+ return fseeko (stdin, 0, 0) && fp (stdin, 0, 0);
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_jpeg_jpeg_destroy_compress=yes
-else
- ac_cv_lib_jpeg_jpeg_destroy_compress=no
+ ac_cv_sys_largefile_source=no; break
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_jpeg_jpeg_destroy_compress" >&5
-$as_echo "$ac_cv_lib_jpeg_jpeg_destroy_compress" >&6; }
-if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = x""yes; then :
- HAVE_JPEG=yes
-fi
-
-fi
-
-
- fi
-
- if test "${HAVE_JPEG}" = "yes"; then
- $as_echo "#define HAVE_JPEG 1" >>confdefs.h
-
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <jpeglib.h>
- version=JPEG_LIB_VERSION
-
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "version= *(6[2-9]|[7-9][0-9])" >/dev/null 2>&1; then :
- $as_echo "#define HAVE_JPEG 1" >>confdefs.h
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: libjpeg found, but not version 6b or later" >&5
-$as_echo "$as_me: WARNING: libjpeg found, but not version 6b or later" >&2;}
- HAVE_JPEG=no
-fi
-rm -f conftest*
-
- fi
- if test "${HAVE_JPEG}" = "yes"; then
- LIBJPEG=-ljpeg
- fi
-fi
-
-
-### Use -lpng if available, unless `--with-png=no'.
-HAVE_PNG=no
-LIBPNG=
-if test "${HAVE_X11}" = "yes"; then
- if test "${with_png}" != "no"; then
- # Debian unstable as of July 2003 has multiple libpngs, and puts png.h
- # in /usr/include/libpng.
- for ac_header in png.h libpng/png.h
-do :
- as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
-ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
-eval as_val=\$$as_ac_Header
- if test "x$as_val" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-
-done
-
- if test "$ac_cv_header_png_h" = yes || test "$ac_cv_header_libpng_png_h" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for png_get_channels in -lpng" >&5
-$as_echo_n "checking for png_get_channels in -lpng... " >&6; }
-if test "${ac_cv_lib_png_png_get_channels+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lpng -lz -lm $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char png_get_channels ();
+#define _LARGEFILE_SOURCE 1
+#include <sys/types.h> /* for off_t */
+ #include <stdio.h>
int
main ()
{
-return png_get_channels ();
+int (*fp) (FILE *, off_t, int) = fseeko;
+ return fseeko (stdin, 0, 0) && fp (stdin, 0, 0);
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_png_png_get_channels=yes
-else
- ac_cv_lib_png_png_get_channels=no
+ ac_cv_sys_largefile_source=1; break
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_png_png_get_channels" >&5
-$as_echo "$ac_cv_lib_png_png_get_channels" >&6; }
-if test "x$ac_cv_lib_png_png_get_channels" = x""yes; then :
- HAVE_PNG=yes
+ ac_cv_sys_largefile_source=unknown
+ break
+done
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_source" >&5
+$as_echo "$ac_cv_sys_largefile_source" >&6; }
+case $ac_cv_sys_largefile_source in #(
+ no | unknown) ;;
+ *)
+cat >>confdefs.h <<_ACEOF
+#define _LARGEFILE_SOURCE $ac_cv_sys_largefile_source
+_ACEOF
+;;
+esac
+rm -rf conftest*
- fi
- fi
-
- if test "${HAVE_PNG}" = "yes"; then
+# We used to try defining _XOPEN_SOURCE=500 too, to work around a bug
+# in glibc 2.1.3, but that breaks too many other things.
+# If you want fseeko and ftello with glibc, upgrade to a fixed glibc.
+if test $ac_cv_sys_largefile_source != unknown; then
-$as_echo "#define HAVE_PNG 1" >>confdefs.h
+$as_echo "#define HAVE_FSEEKO 1" >>confdefs.h
- LIBPNG="-lpng -lz -lm"
- fi
fi
-### Use -ltiff if available, unless `--with-tiff=no'.
-HAVE_TIFF=no
-LIBTIFF=
-if test "${HAVE_X11}" = "yes"; then
- if test "${with_tiff}" != "no"; then
- ac_fn_c_check_header_mongrel "$LINENO" "tiffio.h" "ac_cv_header_tiffio_h" "$ac_includes_default"
-if test "x$ac_cv_header_tiffio_h" = x""yes; then :
- tifflibs="-lz -lm"
- # At least one tiff package requires the jpeg library.
- if test "${HAVE_JPEG}" = yes; then tifflibs="-ljpeg $tifflibs"; fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFGetVersion in -ltiff" >&5
-$as_echo_n "checking for TIFFGetVersion in -ltiff... " >&6; }
-if test "${ac_cv_lib_tiff_TIFFGetVersion+set}" = set; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getpgrp requires zero arguments" >&5
+$as_echo_n "checking whether getpgrp requires zero arguments... " >&6; }
+if test "${ac_cv_func_getpgrp_void+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-ltiff $tifflibs $LIBS"
+ # Use it with a single arg.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char TIFFGetVersion ();
+$ac_includes_default
int
main ()
{
-return TIFFGetVersion ();
+getpgrp (0);
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_tiff_TIFFGetVersion=yes
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_func_getpgrp_void=no
else
- ac_cv_lib_tiff_TIFFGetVersion=no
+ ac_cv_func_getpgrp_void=yes
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tiff_TIFFGetVersion" >&5
-$as_echo "$ac_cv_lib_tiff_TIFFGetVersion" >&6; }
-if test "x$ac_cv_lib_tiff_TIFFGetVersion" = x""yes; then :
- HAVE_TIFF=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getpgrp_void" >&5
+$as_echo "$ac_cv_func_getpgrp_void" >&6; }
+if test $ac_cv_func_getpgrp_void = yes; then
+
+$as_echo "#define GETPGRP_VOID 1" >>confdefs.h
+
+fi
+
+
+# UNIX98 PTYs.
+for ac_func in grantpt
+do :
+ ac_fn_c_check_func "$LINENO" "grantpt" "ac_cv_func_grantpt"
+if test "x$ac_cv_func_grantpt" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_GRANTPT 1
+_ACEOF
+
fi
+done
+
+
+# PTY-related GNU extensions.
+for ac_func in getpt posix_openpt
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
fi
+done
+
+# Check this now, so that we will NOT find the above functions in ncurses.
+# That is because we have not set up to link ncurses in lib-src.
+# It's better to believe a function is not available
+# than to expect to find it in ncurses.
+# Also we need tputs and friends to be able to build at all.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing tputs" >&5
+$as_echo_n "checking for library containing tputs... " >&6; }
+# Run a test program that contains a call to tputs, a call that is
+# never executed. This tests whether a pre-'main' dynamic linker
+# works with the library. It's too much trouble to actually call
+# tputs in the test program, due to portability hassles. When
+# cross-compiling, assume the test program will run if it links.
+# Maybe curses should be tried earlier?
+# See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35
+for tputs_library in '' tinfo ncurses terminfo termcap curses; do
+ OLIBS=$LIBS
+ if test -z "$tputs_library"; then
+ LIBS_TERMCAP=
+ msg='none required'
+ else
+ LIBS_TERMCAP=-l$tputs_library
+ msg=$LIBS_TERMCAP
+ LIBS="$LIBS_TERMCAP $LIBS"
fi
+ if test "$cross_compiling" = yes; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- if test "${HAVE_TIFF}" = "yes"; then
+ extern void tputs (const char *, int, int (*)(int));
+ int main (int argc, char **argv)
+ {
+ if (argc == 10000)
+ tputs (argv[0], 0, 0);
+ return 0;
+ }
-$as_echo "#define HAVE_TIFF 1" >>confdefs.h
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
- LIBTIFF=-ltiff
+else
+ msg=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ extern void tputs (const char *, int, int (*)(int));
+ int main (int argc, char **argv)
+ {
+ if (argc == 10000)
+ tputs (argv[0], 0, 0);
+ return 0;
+ }
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+
+else
+ msg=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+ LIBS=$OLIBS
+ if test "X$msg" != Xno; then
+ break
fi
+done
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $msg" >&5
+$as_echo "$msg" >&6; }
+if test "X$msg" = Xno; then
+ as_fn_error "The required function \`tputs' was not found in any library.
+The following libraries were tried (in order):
+ libtinfo, libncurses, libterminfo, libtermcap, libcurses
+Please try installing whichever of these libraries is most appropriate
+for your system, together with its header files.
+For example, a libncurses-dev(el) or similar package." "$LINENO" 5
fi
+## Use termcap instead of terminfo?
+## Only true for: freebsd < 40000, ms-w32, msdos, netbsd < 599002500.
+TERMINFO=yes
+## FIXME? In the cases below where we unconditionally set
+## LIBS_TERMCAP="-lncurses", this overrides LIBS_TERMCAP = -ltinfo,
+## if that was found above to have tputs.
+## Should we use the gnu* logic everywhere?
+case "$opsys" in
+ ## darwin: Prevents crashes when running Emacs in Terminal.app under 10.2.
+ ## The ncurses library has been moved out of the System framework in
+ ## Mac OS X 10.2. So if configure detects it, set the command-line
+ ## option to use it.
+ darwin) LIBS_TERMCAP="-lncurses" ;;
-### Use -lgif or -lungif if available, unless `--with-gif=no'.
-HAVE_GIF=no
-LIBGIF=
-if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no"; then
- ac_fn_c_check_header_mongrel "$LINENO" "gif_lib.h" "ac_cv_header_gif_lib_h" "$ac_includes_default"
-if test "x$ac_cv_header_gif_lib_h" = x""yes; then :
- # EGifPutExtensionLast only exists from version libungif-4.1.0b1.
-# Earlier versions can crash Emacs.
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lgif" >&5
-$as_echo_n "checking for EGifPutExtensionLast in -lgif... " >&6; }
-if test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then :
+ gnu*) test -z "$LIBS_TERMCAP" && LIBS_TERMCAP="-lncurses" ;;
+
+ freebsd)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FreeBSD is new enough to use terminfo" >&5
+$as_echo_n "checking whether FreeBSD is new enough to use terminfo... " >&6; }
+ if test "${emacs_cv_freebsd_terminfo+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lgif $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char EGifPutExtensionLast ();
+#include <osreldate.h>
int
main ()
{
-return EGifPutExtensionLast ();
+#if __FreeBSD_version < 400000
+fail;
+#endif
+
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_gif_EGifPutExtensionLast=yes
+ emacs_cv_freebsd_terminfo=yes
else
- ac_cv_lib_gif_EGifPutExtensionLast=no
+ emacs_cv_freebsd_terminfo=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gif_EGifPutExtensionLast" >&5
-$as_echo "$ac_cv_lib_gif_EGifPutExtensionLast" >&6; }
-if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = x""yes; then :
- HAVE_GIF=yes
-else
- HAVE_GIF=maybe
fi
-fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_freebsd_terminfo" >&5
+$as_echo "$emacs_cv_freebsd_terminfo" >&6; }
+ if test $emacs_cv_freebsd_terminfo = yes; then
+ LIBS_TERMCAP="-lncurses"
+ else
+ TERMINFO=no
+ LIBS_TERMCAP="-ltermcap"
+ fi
+ ;;
- if test "$HAVE_GIF" = yes; then
- LIBGIF=-lgif
- elif test "$HAVE_GIF" = maybe; then
-# If gif_lib.h but no libgif, try libungif.
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lungif" >&5
-$as_echo_n "checking for EGifPutExtensionLast in -lungif... " >&6; }
-if test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lungif $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ netbsd)
+ if test "x$LIBS_TERMCAP" != "x-lterminfo"; then
+ TERMINFO=no
+ LIBS_TERMCAP="-ltermcap"
+ fi
+ ;;
+
+ openbsd) LIBS_TERMCAP="-lncurses" ;;
+
+ ## hpux: Make sure we get select from libc rather than from libcurses
+ ## because libcurses on HPUX 10.10 has a broken version of select.
+ ## We used to use -lc -lcurses, but this may be cleaner.
+ ## FIXME? But TERMINFO = yes on hpux (it used to be explicitly
+ # set that way, now it uses the default). Isn't this a contradiction?
+ hpux*) LIBS_TERMCAP="-ltermcap" ;;
+
+esac
+
+TERMCAP_OBJ=tparam.o
+if test $TERMINFO = yes; then
+
+$as_echo "#define TERMINFO 1" >>confdefs.h
+
+ TERMCAP_OBJ=terminfo.o
+fi
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char EGifPutExtensionLast ();
+
+
+
+# Do we have res_init, for detecting changes in /etc/resolv.conf?
+# On Darwin, res_init appears not to be useful: see bug#562 and
+# http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html
+resolv=no
+
+if test $opsys != darwin; then
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <netinet/in.h>
+#include <arpa/nameser.h>
+#include <resolv.h>
int
main ()
{
-return EGifPutExtensionLast ();
+return res_init();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_ungif_EGifPutExtensionLast=yes
+ have_res_init=yes
else
- ac_cv_lib_ungif_EGifPutExtensionLast=no
+ have_res_init=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ungif_EGifPutExtensionLast" >&5
-$as_echo "$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; }
-if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = x""yes; then :
- HAVE_GIF=yes
+ if test "$have_res_init" = no; then
+ OLIBS="$LIBS"
+ LIBS="$LIBS -lresolv"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_init with -lresolv" >&5
+$as_echo_n "checking for res_init with -lresolv... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <netinet/in.h>
+#include <arpa/nameser.h>
+#include <resolv.h>
+int
+main ()
+{
+return res_init();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ have_res_init=yes
else
- HAVE_GIF=no
+ have_res_init=no
fi
-
- test "$HAVE_GIF" = yes && LIBGIF=-lungif
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_res_init" >&5
+$as_echo "$have_res_init" >&6; }
+ if test "$have_res_init" = yes ; then
+ resolv=yes
+ fi
+ LIBS="$OLIBS"
fi
- if test "${HAVE_GIF}" = "yes"; then
+ if test "$have_res_init" = yes; then
-$as_echo "#define HAVE_GIF 1" >>confdefs.h
+$as_echo "#define HAVE_RES_INIT 1" >>confdefs.h
fi
fi
+# Do we need the Hesiod library to provide the support routines?
+LIBHESIOD=
+if test "$with_hesiod" != no ; then
+ # Don't set $LIBS here -- see comments above. FIXME which comments?
+ ac_fn_c_check_func "$LINENO" "res_send" "ac_cv_func_res_send"
+if test "x$ac_cv_func_res_send" = x""yes; then :
+else
+ ac_fn_c_check_func "$LINENO" "__res_send" "ac_cv_func___res_send"
+if test "x$ac_cv_func___res_send" = x""yes; then :
-if test "${HAVE_X11}" = "yes"; then
- MISSING=""
- WITH_NO=""
- test "${with_xpm}" != "no" && test "${HAVE_XPM}" != "yes" &&
- MISSING="libXpm" && WITH_NO="--with-xpm=no"
- test "${with_jpeg}" != "no" && test "${HAVE_JPEG}" != "yes" &&
- MISSING="$MISSING libjpeg" && WITH_NO="$WITH_NO --with-jpeg=no"
- test "${with_png}" != "no" && test "${HAVE_PNG}" != "yes" &&
- MISSING="$MISSING libpng" && WITH_NO="$WITH_NO --with-png=no"
- test "${with_gif}" != "no" && test "${HAVE_GIF}" != "yes" &&
- MISSING="$MISSING libgif/libungif" && WITH_NO="$WITH_NO --with-gif=no"
- test "${with_tiff}" != "no" && test "${HAVE_TIFF}" != "yes" &&
- MISSING="$MISSING libtiff" && WITH_NO="$WITH_NO --with-tiff=no"
-
- if test "X${MISSING}" != X; then
- as_fn_error "The following required libraries were not found:
- $MISSING
-Maybe some development libraries/packages are missing?
-If you don't want to link with them give
- $WITH_NO
-as options to configure" "$LINENO" 5
- fi
-fi
-
-### Use -lgpm if available, unless `--with-gpm=no'.
-HAVE_GPM=no
-LIBGPM=
-if test "${with_gpm}" != "no"; then
- ac_fn_c_check_header_mongrel "$LINENO" "gpm.h" "ac_cv_header_gpm_h" "$ac_includes_default"
-if test "x$ac_cv_header_gpm_h" = x""yes; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Gpm_Open in -lgpm" >&5
-$as_echo_n "checking for Gpm_Open in -lgpm... " >&6; }
-if test "${ac_cv_lib_gpm_Gpm_Open+set}" = set; then :
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_send in -lresolv" >&5
+$as_echo_n "checking for res_send in -lresolv... " >&6; }
+if test "${ac_cv_lib_resolv_res_send+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lgpm $LIBS"
+LIBS="-lresolv $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char Gpm_Open ();
+char res_send ();
int
main ()
{
-return Gpm_Open ();
+return res_send ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_gpm_Gpm_Open=yes
+ ac_cv_lib_resolv_res_send=yes
else
- ac_cv_lib_gpm_Gpm_Open=no
+ ac_cv_lib_resolv_res_send=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gpm_Gpm_Open" >&5
-$as_echo "$ac_cv_lib_gpm_Gpm_Open" >&6; }
-if test "x$ac_cv_lib_gpm_Gpm_Open" = x""yes; then :
- HAVE_GPM=yes
-fi
-
-fi
-
-
-
- if test "${HAVE_GPM}" = "yes"; then
-
-$as_echo "#define HAVE_GPM 1" >>confdefs.h
-
- LIBGPM=-lgpm
- fi
-fi
-
-
-ac_fn_c_check_header_mongrel "$LINENO" "malloc/malloc.h" "ac_cv_header_malloc_malloc_h" "$ac_includes_default"
-if test "x$ac_cv_header_malloc_malloc_h" = x""yes; then :
-
-$as_echo "#define HAVE_MALLOC_MALLOC_H 1" >>confdefs.h
-
-fi
-
-
-
-C_SWITCH_X_SYSTEM=
-### Use NeXTstep API to implement GUI.
-if test "${HAVE_NS}" = "yes"; then
-
-$as_echo "#define HAVE_NS 1" >>confdefs.h
-
- if test "${NS_IMPL_COCOA}" = "yes"; then
-
-$as_echo "#define NS_IMPL_COCOA 1" >>confdefs.h
-
- fi
- if test "${NS_IMPL_GNUSTEP}" = "yes"; then
-
-$as_echo "#define NS_IMPL_GNUSTEP 1" >>confdefs.h
-
- # See also .m.o rule in Makefile.in */
- # FIXME: are all these flags really needed? Document here why. */
- C_SWITCH_X_SYSTEM="-D_REENTRANT -fPIC -fno-strict-aliasing -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
- ## Extra CFLAGS applied to src/*.m files.
- GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fgnu-runtime -Wno-import -fconstant-string-class=NSConstantString -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 -DGNU_RUNTIME=1 -DGSWARN -DGSDIAGNOSE"
- fi
- if test "${NS_HAVE_NSINTEGER}" = "yes"; then
-
-$as_echo "#define NS_HAVE_NSINTEGER 1" >>confdefs.h
-
- fi
- # We also have mouse menus.
- HAVE_MENUS=yes
- OTHER_FILES=ns-app
-fi
-
-
-### Use session management (-lSM -lICE) if available
-HAVE_X_SM=no
-LIBXSM=
-if test "${HAVE_X11}" = "yes"; then
- ac_fn_c_check_header_mongrel "$LINENO" "X11/SM/SMlib.h" "ac_cv_header_X11_SM_SMlib_h" "$ac_includes_default"
-if test "x$ac_cv_header_X11_SM_SMlib_h" = x""yes; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SmcOpenConnection in -lSM" >&5
-$as_echo_n "checking for SmcOpenConnection in -lSM... " >&6; }
-if test "${ac_cv_lib_SM_SmcOpenConnection+set}" = set; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_resolv_res_send" >&5
+$as_echo "$ac_cv_lib_resolv_res_send" >&6; }
+if test "x$ac_cv_lib_resolv_res_send" = x""yes; then :
+ resolv=yes
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __res_send in -lresolv" >&5
+$as_echo_n "checking for __res_send in -lresolv... " >&6; }
+if test "${ac_cv_lib_resolv___res_send+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lSM -lICE $LIBS"
+LIBS="-lresolv $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char SmcOpenConnection ();
+char __res_send ();
int
main ()
{
-return SmcOpenConnection ();
+return __res_send ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_SM_SmcOpenConnection=yes
+ ac_cv_lib_resolv___res_send=yes
else
- ac_cv_lib_SM_SmcOpenConnection=no
+ ac_cv_lib_resolv___res_send=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_SM_SmcOpenConnection" >&5
-$as_echo "$ac_cv_lib_SM_SmcOpenConnection" >&6; }
-if test "x$ac_cv_lib_SM_SmcOpenConnection" = x""yes; then :
- HAVE_X_SM=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_resolv___res_send" >&5
+$as_echo "$ac_cv_lib_resolv___res_send" >&6; }
+if test "x$ac_cv_lib_resolv___res_send" = x""yes; then :
+ resolv=yes
fi
fi
-
-
- if test "${HAVE_X_SM}" = "yes"; then
-
-$as_echo "#define HAVE_X_SM 1" >>confdefs.h
-
- LIBXSM="-lSM -lICE"
- case "$LIBS" in
- *-lSM*) ;;
- *) LIBS="$LIBXSM $LIBS" ;;
- esac
- fi
fi
+fi
-### Use libxml (-lxml2) if available
-HAVE_LIBXML2=no
-if test "${with_xml2}" != "no"; then
- ### I'm not sure what the version number should be, so I just guessed.
-
- succeeded=no
+ if test "$resolv" = yes ; then
+ RESOLVLIB=-lresolv
+ else
+ RESOLVLIB=
+ fi
+ ac_fn_c_check_func "$LINENO" "hes_getmailhost" "ac_cv_func_hes_getmailhost"
+if test "x$ac_cv_func_hes_getmailhost" = x""yes; then :
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_path_PKG_CONFIG+set}" = set; then :
- $as_echo_n "(cached) " >&6
else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for hes_getmailhost in -lhesiod" >&5
+$as_echo_n "checking for hes_getmailhost in -lhesiod... " >&6; }
+if test "${ac_cv_lib_hesiod_hes_getmailhost+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lhesiod $RESOLVLIB $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char hes_getmailhost ();
+int
+main ()
+{
+return hes_getmailhost ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_hesiod_hes_getmailhost=yes
+else
+ ac_cv_lib_hesiod_hes_getmailhost=no
fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_hesiod_hes_getmailhost" >&5
+$as_echo "$ac_cv_lib_hesiod_hes_getmailhost" >&6; }
+if test "x$ac_cv_lib_hesiod_hes_getmailhost" = x""yes; then :
+ hesiod=yes
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ :
fi
+fi
- if test "$PKG_CONFIG" = "no" ; then
- HAVE_LIBXML2=no
- else
- PKG_CONFIG_MIN_VERSION=0.9.0
- if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0 > 2.6.17" >&5
-$as_echo_n "checking for libxml-2.0 > 2.6.17... " >&6; }
+ if test x"$hesiod" = xyes; then
- if $PKG_CONFIG --exists "libxml-2.0 > 2.6.17" 2>&5; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- succeeded=yes
+$as_echo "#define HAVE_LIBHESIOD 1" >>confdefs.h
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_CFLAGS" >&5
-$as_echo_n "checking LIBXML2_CFLAGS... " >&6; }
- LIBXML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0 > 2.6.17"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_CFLAGS" >&5
-$as_echo "$LIBXML2_CFLAGS" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_LIBS" >&5
-$as_echo_n "checking LIBXML2_LIBS... " >&6; }
- LIBXML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0 > 2.6.17"|sed -e 's,///*,/,g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_LIBS" >&5
-$as_echo "$LIBXML2_LIBS" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- LIBXML2_CFLAGS=""
- LIBXML2_LIBS=""
- ## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- LIBXML2_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "libxml-2.0 > 2.6.17"`
+ LIBHESIOD=-lhesiod
+ fi
+fi
- fi
+# Do we need libresolv (due to res_init or Hesiod)?
+if test "$resolv" = yes && test $opsys != darwin; then
+$as_echo "#define HAVE_LIBRESOLV 1" >>confdefs.h
- else
- echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer."
- echo "*** See http://www.freedesktop.org/software/pkgconfig"
- fi
- fi
+ LIBRESOLV=-lresolv
+else
+ LIBRESOLV=
+fi
- if test $succeeded = yes; then
- HAVE_LIBXML2=yes
- else
- HAVE_LIBXML2=no
- fi
- if test "${HAVE_LIBXML2}" = "yes"; then
- LIBS="$LIBXML2_LIBS $LIBS"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for htmlReadMemory in -lxml2" >&5
-$as_echo_n "checking for htmlReadMemory in -lxml2... " >&6; }
-if test "${ac_cv_lib_xml2_htmlReadMemory+set}" = set; then :
+# These tell us which Kerberos-related libraries to use.
+COM_ERRLIB=
+CRYPTOLIB=
+KRB5LIB=
+DESLIB=
+KRB4LIB=
+
+if test "${with_kerberos}" != no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for com_err in -lcom_err" >&5
+$as_echo_n "checking for com_err in -lcom_err... " >&6; }
+if test "${ac_cv_lib_com_err_com_err+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lxml2 $LIBS"
+LIBS="-lcom_err $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char htmlReadMemory ();
+char com_err ();
int
main ()
{
-return htmlReadMemory ();
+return com_err ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_xml2_htmlReadMemory=yes
+ ac_cv_lib_com_err_com_err=yes
else
- ac_cv_lib_xml2_htmlReadMemory=no
+ ac_cv_lib_com_err_com_err=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_htmlReadMemory" >&5
-$as_echo "$ac_cv_lib_xml2_htmlReadMemory" >&6; }
-if test "x$ac_cv_lib_xml2_htmlReadMemory" = x""yes; then :
- HAVE_LIBXML2=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_com_err_com_err" >&5
+$as_echo "$ac_cv_lib_com_err_com_err" >&6; }
+if test "x$ac_cv_lib_com_err_com_err" = x""yes; then :
+ have_com_err=yes
else
- HAVE_LIBXML2=no
+ have_com_err=no
fi
- if test "${HAVE_LIBXML2}" = "yes"; then
+ if test $have_com_err = yes; then
+ COM_ERRLIB=-lcom_err
+ LIBS="$COM_ERRLIB $LIBS"
-$as_echo "#define HAVE_LIBXML2 1" >>confdefs.h
+$as_echo "#define HAVE_LIBCOM_ERR 1" >>confdefs.h
- else
- LIBXML2_LIBS=""
- LIBXML2_CFLAGS=""
- fi
fi
-fi
-
-
-
-# If netdb.h doesn't declare h_errno, we must declare it by hand.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5
-$as_echo_n "checking whether netdb declares h_errno... " >&6; }
-if test "${emacs_cv_netdb_declares_h_errno+set}" = set; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lcrypto" >&5
+$as_echo_n "checking for mit_des_cbc_encrypt in -lcrypto... " >&6; }
+if test "${ac_cv_lib_crypto_mit_des_cbc_encrypt+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lcrypto $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <netdb.h>
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char mit_des_cbc_encrypt ();
int
main ()
{
-return h_errno;
+return mit_des_cbc_encrypt ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_netdb_declares_h_errno=yes
+ ac_cv_lib_crypto_mit_des_cbc_encrypt=yes
else
- emacs_cv_netdb_declares_h_errno=no
+ ac_cv_lib_crypto_mit_des_cbc_encrypt=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_crypto_mit_des_cbc_encrypt" >&5
+$as_echo "$ac_cv_lib_crypto_mit_des_cbc_encrypt" >&6; }
+if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = x""yes; then :
+ have_crypto=yes
+else
+ have_crypto=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_netdb_declares_h_errno" >&5
-$as_echo "$emacs_cv_netdb_declares_h_errno" >&6; }
-if test $emacs_cv_netdb_declares_h_errno = yes; then
-$as_echo "#define HAVE_H_ERRNO 1" >>confdefs.h
+ if test $have_crypto = yes; then
+ CRYPTOLIB=-lcrypto
+ LIBS="$CRYPTOLIB $LIBS"
-fi
+$as_echo "#define HAVE_LIBCRYPTO 1" >>confdefs.h
-# fmod, logb, and frexp are found in -lm on most systems.
-# On HPUX 9.01, -lm does not contain logb, so check for sqrt.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrt in -lm" >&5
-$as_echo_n "checking for sqrt in -lm... " >&6; }
-if test "${ac_cv_lib_m_sqrt+set}" = set; then :
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lk5crypto" >&5
+$as_echo_n "checking for mit_des_cbc_encrypt in -lk5crypto... " >&6; }
+if test "${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $LIBS"
+LIBS="-lk5crypto $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char sqrt ();
+char mit_des_cbc_encrypt ();
int
main ()
{
-return sqrt ();
+return mit_des_cbc_encrypt ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_sqrt=yes
+ ac_cv_lib_k5crypto_mit_des_cbc_encrypt=yes
else
- ac_cv_lib_m_sqrt=no
+ ac_cv_lib_k5crypto_mit_des_cbc_encrypt=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sqrt" >&5
-$as_echo "$ac_cv_lib_m_sqrt" >&6; }
-if test "x$ac_cv_lib_m_sqrt" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_LIBM 1
-_ACEOF
-
- LIBS="-lm $LIBS"
-
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&5
+$as_echo "$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&6; }
+if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = x""yes; then :
+ have_k5crypto=yes
+else
+ have_k5crypto=no
fi
+ if test $have_k5crypto = yes; then
+ CRYPTOLIB=-lk5crypto
+ LIBS="$CRYPTOLIB $LIBS"
+
+$as_echo "#define HAVE_LIBK5CRYPTO 1" >>confdefs.h
-# Check for mail-locking functions in a "mail" library. Probably this should
-# have the same check as for liblockfile below.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -lmail" >&5
-$as_echo_n "checking for maillock in -lmail... " >&6; }
-if test "${ac_cv_lib_mail_maillock+set}" = set; then :
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb5_init_context in -lkrb5" >&5
+$as_echo_n "checking for krb5_init_context in -lkrb5... " >&6; }
+if test "${ac_cv_lib_krb5_krb5_init_context+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lmail $LIBS"
+LIBS="-lkrb5 $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char maillock ();
+char krb5_init_context ();
int
main ()
{
-return maillock ();
+return krb5_init_context ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_mail_maillock=yes
+ ac_cv_lib_krb5_krb5_init_context=yes
else
- ac_cv_lib_mail_maillock=no
+ ac_cv_lib_krb5_krb5_init_context=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mail_maillock" >&5
-$as_echo "$ac_cv_lib_mail_maillock" >&6; }
-if test "x$ac_cv_lib_mail_maillock" = x""yes; then :
- have_mail=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb5_krb5_init_context" >&5
+$as_echo "$ac_cv_lib_krb5_krb5_init_context" >&6; }
+if test "x$ac_cv_lib_krb5_krb5_init_context" = x""yes; then :
+ have_krb5=yes
else
- have_mail=no
+ have_krb5=no
fi
-if test $have_mail = yes; then
- LIBS_MAIL=-lmail
- LIBS="$LIBS_MAIL $LIBS"
+ if test $have_krb5=yes; then
+ KRB5LIB=-lkrb5
+ LIBS="$KRB5LIB $LIBS"
-$as_echo "#define HAVE_LIBMAIL 1" >>confdefs.h
+$as_echo "#define HAVE_LIBKRB5 1" >>confdefs.h
-else
- LIBS_MAIL=
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -llockfile" >&5
-$as_echo_n "checking for maillock in -llockfile... " >&6; }
-if test "${ac_cv_lib_lockfile_maillock+set}" = set; then :
+ fi
+ if test "${with_kerberos5}" = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes425" >&5
+$as_echo_n "checking for des_cbc_encrypt in -ldes425... " >&6; }
+if test "${ac_cv_lib_des425_des_cbc_encrypt+set}" = set; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-llockfile $LIBS"
+LIBS="-ldes425 $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __cplusplus
extern "C"
#endif
-char maillock ();
+char des_cbc_encrypt ();
int
main ()
{
-return maillock ();
+return des_cbc_encrypt ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_lockfile_maillock=yes
+ ac_cv_lib_des425_des_cbc_encrypt=yes
else
- ac_cv_lib_lockfile_maillock=no
+ ac_cv_lib_des425_des_cbc_encrypt=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lockfile_maillock" >&5
-$as_echo "$ac_cv_lib_lockfile_maillock" >&6; }
-if test "x$ac_cv_lib_lockfile_maillock" = x""yes; then :
- have_lockfile=yes
-else
- have_lockfile=no
-fi
-
-if test $have_lockfile = yes; then
- LIBS_MAIL=-llockfile
- LIBS="$LIBS_MAIL $LIBS"
-
-$as_echo "#define HAVE_LIBLOCKFILE 1" >>confdefs.h
-
-else
-# If we have the shared liblockfile, assume we must use it for mail
-# locking (e.g. Debian). If we couldn't link against liblockfile
-# (no liblockfile.a installed), ensure that we don't need to.
- # Extract the first word of "liblockfile.so", so it can be a program name with args.
-set dummy liblockfile.so; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if test "${ac_cv_prog_liblockfile+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- if test -n "$liblockfile"; then
- ac_cv_prog_liblockfile="$liblockfile" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-as_dummy="/usr/lib:/lib:/usr/local/lib:$LD_LIBRARY_PATH"
-for as_dir in $as_dummy
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_prog_liblockfile="yes"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_prog_liblockfile" && ac_cv_prog_liblockfile="no"
-fi
-fi
-liblockfile=$ac_cv_prog_liblockfile
-if test -n "$liblockfile"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $liblockfile" >&5
-$as_echo "$liblockfile" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_des425_des_cbc_encrypt" >&5
+$as_echo "$ac_cv_lib_des425_des_cbc_encrypt" >&6; }
+if test "x$ac_cv_lib_des425_des_cbc_encrypt" = x""yes; then :
+ have_des425=yes
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
- if test $ac_cv_prog_liblockfile = yes; then
- as_fn_error "Shared liblockfile found but can't link against it.
-This probably means that movemail could lose mail.
-There may be a \`development' package to install containing liblockfile." "$LINENO" 5
- fi
-fi
-for ac_func in touchlock
-do :
- ac_fn_c_check_func "$LINENO" "touchlock" "ac_cv_func_touchlock"
-if test "x$ac_cv_func_touchlock" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_TOUCHLOCK 1
-_ACEOF
-
-fi
-done
-
-for ac_header in maillock.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "maillock.h" "ac_cv_header_maillock_h" "$ac_includes_default"
-if test "x$ac_cv_header_maillock_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_MAILLOCK_H 1
-_ACEOF
-
+ have_des425=no
fi
-done
-
-
-
-## Define MAIL_USE_FLOCK (or LOCKF) if the mailer uses flock (or lockf) to
-## interlock access to the mail spool. The alternative is a lock file named
-## /usr/spool/mail/$USER.lock.
-mail_lock=no
-case "$opsys" in
- aix4-2) mail_lock="lockf" ;;
-
- gnu|freebsd|netbsd|openbsd|darwin|irix6-5) mail_lock="flock" ;;
-
- ## On GNU/Linux systems, both methods are used by various mail programs.
- ## I assume most people are using newer mailers that have heard of flock.
- ## Change this if you need to.
- ## Debian contains a patch which says: ``On Debian/GNU/Linux systems,
- ## configure gets the right answers, and that means *NOT* using flock.
- ## Using flock is guaranteed to be the wrong thing. See Debian Policy
- ## for details.'' and then uses `#ifdef DEBIAN'. Unfortunately the
- ## Debian maintainer hasn't provided a clean fix for Emacs.
- ## movemail.c will use `maillock' when MAILDIR, HAVE_LIBMAIL and
- ## HAVE_MAILLOCK_H are defined, so the following appears to be the
- ## correct logic. -- fx
- ## We must check for HAVE_LIBLOCKFILE too, as movemail does.
- ## liblockfile is a Free Software replacement for libmail, used on
- ## Debian systems and elsewhere. -rfr.
- gnu-*)
- mail_lock="flock"
- if test $have_mail = yes || test $have_lockfile = yes; then
- test $ac_cv_header_maillock_h = yes && mail_lock=no
- fi
- ;;
-esac
-
-BLESSMAIL_TARGET=
-case "$mail_lock" in
- flock)
-$as_echo "#define MAIL_USE_FLOCK 1" >>confdefs.h
- ;;
-
- lockf)
-$as_echo "#define MAIL_USE_LOCKF 1" >>confdefs.h
- ;;
-
- *) BLESSMAIL_TARGET="need-blessmail" ;;
-esac
-
-
-
-for ac_func in gethostname getdomainname \
-rename closedir mkdir rmdir sysinfo getrusage get_current_dir_name \
-random lrand48 logb frexp fmod rint cbrt ftime setsid \
-strerror fpathconf select euidaccess getpagesize tzset setlocale \
-utimes getrlimit setrlimit setpgid getcwd getwd shutdown getaddrinfo \
-__fpending mblen mbrlen mbsinit strsignal setitimer ualarm \
-sendto recvfrom getsockopt setsockopt getsockname getpeername \
-gai_strerror mkstemp getline getdelim mremap fsync sync \
-difftime mempcpy mblen mbrlen posix_memalign \
-cfmakeraw cfsetspeed copysign __executable_start
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-eval as_val=\$$as_ac_var
- if test "x$as_val" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
+ if test $have_des425 = yes; then
+ DESLIB=-ldes425
+ LIBS="$DESLIB $LIBS"
+$as_echo "#define HAVE_LIBDES425 1" >>confdefs.h
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __builtin_unwind_init" >&5
-$as_echo_n "checking for __builtin_unwind_init... " >&6; }
-if test "${emacs_cv_func___builtin_unwind_init+set}" = set; then :
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes" >&5
+$as_echo_n "checking for des_cbc_encrypt in -ldes... " >&6; }
+if test "${ac_cv_lib_des_des_cbc_encrypt+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldes $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char des_cbc_encrypt ();
int
main ()
{
-__builtin_unwind_init ();
+return des_cbc_encrypt ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_func___builtin_unwind_init=yes
+ ac_cv_lib_des_des_cbc_encrypt=yes
else
- emacs_cv_func___builtin_unwind_init=no
+ ac_cv_lib_des_des_cbc_encrypt=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_func___builtin_unwind_init" >&5
-$as_echo "$emacs_cv_func___builtin_unwind_init" >&6; }
-if test $emacs_cv_func___builtin_unwind_init = yes; then
-
-$as_echo "#define HAVE___BUILTIN_UNWIND_INIT 1" >>confdefs.h
-
-fi
-
-for ac_header in sys/un.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "sys/un.h" "ac_cv_header_sys_un_h" "$ac_includes_default"
-if test "x$ac_cv_header_sys_un_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_SYS_UN_H 1
-_ACEOF
-
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_des_des_cbc_encrypt" >&5
+$as_echo "$ac_cv_lib_des_des_cbc_encrypt" >&6; }
+if test "x$ac_cv_lib_des_des_cbc_encrypt" = x""yes; then :
+ have_des=yes
+else
+ have_des=no
fi
-done
+ if test $have_des = yes; then
+ DESLIB=-ldes
+ LIBS="$DESLIB $LIBS"
+$as_echo "#define HAVE_LIBDES 1" >>confdefs.h
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGEFILE_SOURCE value needed for large files" >&5
-$as_echo_n "checking for _LARGEFILE_SOURCE value needed for large files... " >&6; }
-if test "${ac_cv_sys_largefile_source+set}" = set; then :
+ fi
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb4" >&5
+$as_echo_n "checking for krb_get_cred in -lkrb4... " >&6; }
+if test "${ac_cv_lib_krb4_krb_get_cred+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- while :; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lkrb4 $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <sys/types.h> /* for off_t */
- #include <stdio.h>
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char krb_get_cred ();
int
main ()
{
-int (*fp) (FILE *, off_t, int) = fseeko;
- return fseeko (stdin, 0, 0) && fp (stdin, 0, 0);
+return krb_get_cred ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_sys_largefile_source=no; break
+ ac_cv_lib_krb4_krb_get_cred=yes
+else
+ ac_cv_lib_krb4_krb_get_cred=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb4_krb_get_cred" >&5
+$as_echo "$ac_cv_lib_krb4_krb_get_cred" >&6; }
+if test "x$ac_cv_lib_krb4_krb_get_cred" = x""yes; then :
+ have_krb4=yes
+else
+ have_krb4=no
+fi
+
+ if test $have_krb4 = yes; then
+ KRB4LIB=-lkrb4
+ LIBS="$KRB4LIB $LIBS"
+
+$as_echo "#define HAVE_LIBKRB4 1" >>confdefs.h
+
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb" >&5
+$as_echo_n "checking for krb_get_cred in -lkrb... " >&6; }
+if test "${ac_cv_lib_krb_krb_get_cred+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lkrb $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#define _LARGEFILE_SOURCE 1
-#include <sys/types.h> /* for off_t */
- #include <stdio.h>
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char krb_get_cred ();
int
main ()
{
-int (*fp) (FILE *, off_t, int) = fseeko;
- return fseeko (stdin, 0, 0) && fp (stdin, 0, 0);
+return krb_get_cred ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_sys_largefile_source=1; break
+ ac_cv_lib_krb_krb_get_cred=yes
+else
+ ac_cv_lib_krb_krb_get_cred=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
- ac_cv_sys_largefile_source=unknown
- break
-done
+LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_source" >&5
-$as_echo "$ac_cv_sys_largefile_source" >&6; }
-case $ac_cv_sys_largefile_source in #(
- no | unknown) ;;
- *)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb_krb_get_cred" >&5
+$as_echo "$ac_cv_lib_krb_krb_get_cred" >&6; }
+if test "x$ac_cv_lib_krb_krb_get_cred" = x""yes; then :
+ have_krb=yes
+else
+ have_krb=no
+fi
+
+ if test $have_krb = yes; then
+ KRB4LIB=-lkrb
+ LIBS="$KRB4LIB $LIBS"
+
+$as_echo "#define HAVE_LIBKRB 1" >>confdefs.h
+
+ fi
+ fi
+ fi
+
+ if test "${with_kerberos5}" != no; then
+ for ac_header in krb5.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "krb5.h" "ac_cv_header_krb5_h" "$ac_includes_default"
+if test "x$ac_cv_header_krb5_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KRB5_H 1
+_ACEOF
+ ac_fn_c_check_member "$LINENO" "krb5_error" "text" "ac_cv_member_krb5_error_text" "#include <krb5.h>
+"
+if test "x$ac_cv_member_krb5_error_text" = x""yes; then :
+
cat >>confdefs.h <<_ACEOF
-#define _LARGEFILE_SOURCE $ac_cv_sys_largefile_source
+#define HAVE_KRB5_ERROR_TEXT 1
_ACEOF
-;;
-esac
-rm -rf conftest*
-# We used to try defining _XOPEN_SOURCE=500 too, to work around a bug
-# in glibc 2.1.3, but that breaks too many other things.
-# If you want fseeko and ftello with glibc, upgrade to a fixed glibc.
-if test $ac_cv_sys_largefile_source != unknown; then
-$as_echo "#define HAVE_FSEEKO 1" >>confdefs.h
+fi
+ac_fn_c_check_member "$LINENO" "krb5_error" "e_text" "ac_cv_member_krb5_error_e_text" "#include <krb5.h>
+"
+if test "x$ac_cv_member_krb5_error_e_text" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_KRB5_ERROR_E_TEXT 1
+_ACEOF
+
fi
+fi
+
+done
+
+ else
+ for ac_header in des.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "des.h" "ac_cv_header_des_h" "$ac_includes_default"
+if test "x$ac_cv_header_des_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_DES_H 1
+_ACEOF
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getpgrp requires zero arguments" >&5
-$as_echo_n "checking whether getpgrp requires zero arguments... " >&6; }
-if test "${ac_cv_func_getpgrp_void+set}" = set; then :
- $as_echo_n "(cached) " >&6
else
- # Use it with a single arg.
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-getpgrp (0);
- ;
- return 0;
-}
+ for ac_header in kerberosIV/des.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/des.h" "ac_cv_header_kerberosIV_des_h" "$ac_includes_default"
+if test "x$ac_cv_header_kerberosIV_des_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KERBEROSIV_DES_H 1
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_func_getpgrp_void=no
+
else
- ac_cv_func_getpgrp_void=yes
+ for ac_header in kerberos/des.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "kerberos/des.h" "ac_cv_header_kerberos_des_h" "$ac_includes_default"
+if test "x$ac_cv_header_kerberos_des_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KERBEROS_DES_H 1
+_ACEOF
+
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+done
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getpgrp_void" >&5
-$as_echo "$ac_cv_func_getpgrp_void" >&6; }
-if test $ac_cv_func_getpgrp_void = yes; then
-$as_echo "#define GETPGRP_VOID 1" >>confdefs.h
+done
fi
+done
-# UNIX98 PTYs.
-for ac_func in grantpt
+ for ac_header in krb.h
do :
- ac_fn_c_check_func "$LINENO" "grantpt" "ac_cv_func_grantpt"
-if test "x$ac_cv_func_grantpt" = x""yes; then :
+ ac_fn_c_check_header_mongrel "$LINENO" "krb.h" "ac_cv_header_krb_h" "$ac_includes_default"
+if test "x$ac_cv_header_krb_h" = x""yes; then :
cat >>confdefs.h <<_ACEOF
-#define HAVE_GRANTPT 1
+#define HAVE_KRB_H 1
+_ACEOF
+
+else
+ for ac_header in kerberosIV/krb.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/krb.h" "ac_cv_header_kerberosIV_krb_h" "$ac_includes_default"
+if test "x$ac_cv_header_kerberosIV_krb_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KERBEROSIV_KRB_H 1
+_ACEOF
+
+else
+ for ac_header in kerberos/krb.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "kerberos/krb.h" "ac_cv_header_kerberos_krb_h" "$ac_includes_default"
+if test "x$ac_cv_header_kerberos_krb_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_KERBEROS_KRB_H 1
_ACEOF
fi
+
done
+fi
-# PTY-related GNU extensions.
-for ac_func in getpt
+done
+
+fi
+
+done
+
+ fi
+ for ac_header in com_err.h
do :
- ac_fn_c_check_func "$LINENO" "getpt" "ac_cv_func_getpt"
-if test "x$ac_cv_func_getpt" = x""yes; then :
+ ac_fn_c_check_header_mongrel "$LINENO" "com_err.h" "ac_cv_header_com_err_h" "$ac_includes_default"
+if test "x$ac_cv_header_com_err_h" = x""yes; then :
cat >>confdefs.h <<_ACEOF
-#define HAVE_GETPT 1
+#define HAVE_COM_ERR_H 1
_ACEOF
fi
+
done
+fi
-# Check this now, so that we will NOT find the above functions in ncurses.
-# That is because we have not set up to link ncurses in lib-src.
-# It's better to believe a function is not available
-# than to expect to find it in ncurses.
-# Also we need tputs and friends to be able to build at all.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing tputs" >&5
-$as_echo_n "checking for library containing tputs... " >&6; }
-# Run a test program that contains a call to tputs, a call that is
-# never executed. This tests whether a pre-'main' dynamic linker
-# works with the library. It's too much trouble to actually call
-# tputs in the test program, due to portability hassles. When
-# cross-compiling, assume the test program will run if it links.
-# Maybe curses should be tried earlier?
-# See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35
-for tputs_library in '' ncurses terminfo termcap curses; do
- OLIBS=$LIBS
- if test -z "$tputs_library"; then
- LIBS_TERMCAP=
- msg='none required'
- else
- LIBS_TERMCAP=-l$tputs_library
- msg=$LIBS_TERMCAP
- LIBS="$LIBS_TERMCAP $LIBS"
- fi
- if test "$cross_compiling" = yes; then :
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
- extern void tputs (const char *, int, int (*)(int));
- int main (int argc, char **argv)
- {
- if (argc == 10000)
- tputs (argv[0], 0, 0);
- return 0;
- }
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-else
- msg=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
- extern void tputs (const char *, int, int (*)(int));
- int main (int argc, char **argv)
- {
- if (argc == 10000)
- tputs (argv[0], 0, 0);
- return 0;
- }
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
-else
- msg=no
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
- LIBS=$OLIBS
- if test "X$msg" != Xno; then
- break
- fi
-done
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $msg" >&5
-$as_echo "$msg" >&6; }
-if test "X$msg" = Xno; then
- as_fn_error "The required function \`tputs' was not found in any library.
-These libraries were tried: libncurses, libterminfo, libtermcap, libcurses.
-Please try installing whichever of these libraries is most appropriate
-for your system, together with its header files.
-For example, a libncurses-dev(el) or similar package." "$LINENO" 5
-fi
-# Must define this when any termcap library is found.
-$as_echo "#define HAVE_LIBNCURSES 1" >>confdefs.h
+ for ac_func in $ac_func_list
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
-## FIXME This was the cpp logic, but I am not sure it is right.
-## The above test has not necessarily found libncurses.
-HAVE_LIBNCURSES=yes
-## Use terminfo instead of termcap?
-## Note only system files NOT using terminfo are:
-## freebsd < 40000, ms-w32, msdos, netbsd < 599002500, and
-## darwin|gnu without ncurses.
-TERMINFO=no
-case "$opsys" in
- ## cygwin: Fewer environment variables to go wrong, more terminal types.
- ## hpux10-20: Use the system provided termcap(3) library.
- ## openbsd: David Mazieres <dm@reeducation-labor.lcs.mit.edu> says this
- ## is necessary. Otherwise Emacs dumps core when run -nw.
- aix4-2|cygwin|hpux*|irix6-5|openbsd|sol2*|unixware) TERMINFO=yes ;;
- ## darwin: Prevents crashes when running Emacs in Terminal.app under 10.2.
- ## The ncurses library has been moved out of the System framework in
- ## Mac OS X 10.2. So if configure detects it, set the command-line
- ## option to use it.
- darwin|gnu*)
- ## (HAVE_LIBNCURSES was not always true, but is since 2010-03-18.)
- if test "x$HAVE_LIBNCURSES" = "xyes"; then
- TERMINFO=yes
- LIBS_TERMCAP="-lncurses"
- fi
- ;;
- freebsd)
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FreeBSD is new enough to use terminfo" >&5
-$as_echo_n "checking whether FreeBSD is new enough to use terminfo... " >&6; }
- if test "${emacs_cv_freebsd_terminfo+set}" = set; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime caches TZ" >&5
+$as_echo_n "checking whether localtime caches TZ... " >&6; }
+if test "${emacs_cv_localtime_cache+set}" = set; then :
$as_echo_n "(cached) " >&6
+else
+ if test x$ac_cv_func_tzset = xyes; then
+if test "$cross_compiling" = yes; then :
+ # If we have tzset, assume the worst when cross-compiling.
+emacs_cv_localtime_cache=yes
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <osreldate.h>
-int
-main ()
+#include <time.h>
+char TZ_GMT0[] = "TZ=GMT0";
+char TZ_PST8[] = "TZ=PST8";
+main()
{
-#if __FreeBSD_version < 400000
-fail;
-#endif
-
- ;
- return 0;
+ time_t now = time ((time_t *) 0);
+ int hour_GMT0, hour_unset;
+ if (putenv (TZ_GMT0) != 0)
+ exit (1);
+ hour_GMT0 = localtime (&now)->tm_hour;
+ unsetenv("TZ");
+ hour_unset = localtime (&now)->tm_hour;
+ if (putenv (TZ_PST8) != 0)
+ exit (1);
+ if (localtime (&now)->tm_hour == hour_GMT0)
+ exit (1);
+ unsetenv("TZ");
+ if (localtime (&now)->tm_hour != hour_unset)
+ exit (1);
+ exit (0);
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_freebsd_terminfo=yes
+if ac_fn_c_try_run "$LINENO"; then :
+ emacs_cv_localtime_cache=no
else
- emacs_cv_freebsd_terminfo=no
+ emacs_cv_localtime_cache=yes
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
+else
+ # If we lack tzset, report that localtime does not cache TZ,
+ # since we can't invalidate the cache if we don't have tzset.
+ emacs_cv_localtime_cache=no
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_localtime_cache" >&5
+$as_echo "$emacs_cv_localtime_cache" >&6; }
+if test $emacs_cv_localtime_cache = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_freebsd_terminfo" >&5
-$as_echo "$emacs_cv_freebsd_terminfo" >&6; }
-
- if test $emacs_cv_freebsd_terminfo = yes; then
- TERMINFO=yes
- LIBS_TERMCAP="-lncurses"
- else
- LIBS_TERMCAP="-ltermcap"
- fi
- ;;
+$as_echo "#define LOCALTIME_CACHE 1" >>confdefs.h
- netbsd)
- if test "x$LIBS_TERMCAP" = "x-lterminfo"; then
- TERMINFO=yes
- else
- LIBS_TERMCAP="-ltermcap"
- fi
- ;;
+fi
-esac
+ok_so_far=yes
+ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket"
+if test "x$ac_cv_func_socket" = x""yes; then :
-case "$opsys" in
- ## hpux: Make sure we get select from libc rather than from libcurses
- ## because libcurses on HPUX 10.10 has a broken version of select.
- ## We used to use -lc -lcurses, but this may be cleaner.
- hpux*) LIBS_TERMCAP="-ltermcap" ;;
+else
+ ok_so_far=no
+fi
- openbsd) LIBS_TERMCAP="-lncurses" ;;
+if test $ok_so_far = yes; then
+ ac_fn_c_check_header_mongrel "$LINENO" "netinet/in.h" "ac_cv_header_netinet_in_h" "$ac_includes_default"
+if test "x$ac_cv_header_netinet_in_h" = x""yes; then :
- ## Must use system termcap, if we use any termcap. It does special things.
- sol2*) test "$TERMINFO" != yes && LIBS_TERMCAP="-ltermcap" ;;
-esac
+else
+ ok_so_far=no
+fi
-TERMCAP_OBJ=tparam.o
-if test $TERMINFO = yes; then
-$as_echo "#define TERMINFO 1" >>confdefs.h
+fi
+if test $ok_so_far = yes; then
+ ac_fn_c_check_header_mongrel "$LINENO" "arpa/inet.h" "ac_cv_header_arpa_inet_h" "$ac_includes_default"
+if test "x$ac_cv_header_arpa_inet_h" = x""yes; then :
- TERMCAP_OBJ=terminfo.o
+else
+ ok_so_far=no
fi
+fi
+if test $ok_so_far = yes; then
+$as_echo "#define HAVE_INET_SOCKETS 1" >>confdefs.h
-# Do we have res_init, for detecting changes in /etc/resolv.conf?
-resolv=no
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <netinet/in.h>
-#include <arpa/nameser.h>
-#include <resolv.h>
-int
-main ()
-{
-return res_init();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- have_res_init=yes
-else
- have_res_init=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-if test "$have_res_init" = no; then
- OLIBS="$LIBS"
- LIBS="$LIBS -lresolv"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_init with -lresolv" >&5
-$as_echo_n "checking for res_init with -lresolv... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <netinet/in.h>
-#include <arpa/nameser.h>
-#include <resolv.h>
-int
-main ()
-{
-return res_init();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- have_res_init=yes
-else
- have_res_init=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_res_init" >&5
-$as_echo "$have_res_init" >&6; }
- if test "$have_res_init" = yes ; then
- resolv=yes
- fi
- LIBS="$OLIBS"
fi
-if test "$have_res_init" = yes; then
+if test -f /usr/lpp/X11/bin/smt.exp; then
-$as_echo "#define HAVE_RES_INIT 1" >>confdefs.h
+$as_echo "#define HAVE_AIX_SMT_EXP 1" >>confdefs.h
fi
-# Do we need the Hesiod library to provide the support routines?
-LIBHESIOD=
-if test "$with_hesiod" != no ; then
- # Don't set $LIBS here -- see comments above. FIXME which comments?
- ac_fn_c_check_func "$LINENO" "res_send" "ac_cv_func_res_send"
-if test "x$ac_cv_func_res_send" = x""yes; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system supports dynamic ptys" >&5
+$as_echo_n "checking whether system supports dynamic ptys... " >&6; }
+if test -d /dev/pts && ls -d /dev/ptmx > /dev/null 2>&1 ; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
-else
- ac_fn_c_check_func "$LINENO" "__res_send" "ac_cv_func___res_send"
-if test "x$ac_cv_func___res_send" = x""yes; then :
+$as_echo "#define HAVE_DEV_PTMX 1" >>confdefs.h
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_send in -lresolv" >&5
-$as_echo_n "checking for res_send in -lresolv... " >&6; }
-if test "${ac_cv_lib_resolv_res_send+set}" = set; then :
- $as_echo_n "(cached) " >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+case $canonical in
+ *-solaris2.4 | *-solaris2.4.*)
+ : ${ac_cv_func_vfork_works=no};;
+esac
+
+ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default"
+if test "x$ac_cv_type_pid_t" = x""yes; then :
+
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lresolv $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char res_send ();
-int
-main ()
-{
-return res_send ();
- ;
- return 0;
-}
+cat >>confdefs.h <<_ACEOF
+#define pid_t int
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_resolv_res_send=yes
-else
- ac_cv_lib_resolv_res_send=no
+
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+
+for ac_header in vfork.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "vfork.h" "ac_cv_header_vfork_h" "$ac_includes_default"
+if test "x$ac_cv_header_vfork_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_VFORK_H 1
+_ACEOF
+
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_resolv_res_send" >&5
-$as_echo "$ac_cv_lib_resolv_res_send" >&6; }
-if test "x$ac_cv_lib_resolv_res_send" = x""yes; then :
- resolv=yes
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __res_send in -lresolv" >&5
-$as_echo_n "checking for __res_send in -lresolv... " >&6; }
-if test "${ac_cv_lib_resolv___res_send+set}" = set; then :
+
+done
+
+for ac_func in fork vfork
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+if test "x$ac_cv_func_fork" = xyes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working fork" >&5
+$as_echo_n "checking for working fork... " >&6; }
+if test "${ac_cv_func_fork_works+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lresolv $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ if test "$cross_compiling" = yes; then :
+ ac_cv_func_fork_works=cross
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char __res_send ();
+$ac_includes_default
int
main ()
{
-return __res_send ();
+
+ /* By Ruediger Kuhlmann. */
+ return fork () < 0;
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_resolv___res_send=yes
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_func_fork_works=yes
else
- ac_cv_lib_resolv___res_send=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+ ac_cv_func_fork_works=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_resolv___res_send" >&5
-$as_echo "$ac_cv_lib_resolv___res_send" >&6; }
-if test "x$ac_cv_lib_resolv___res_send" = x""yes; then :
- resolv=yes
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_fork_works" >&5
+$as_echo "$ac_cv_func_fork_works" >&6; }
+else
+ ac_cv_func_fork_works=$ac_cv_func_fork
fi
-
+if test "x$ac_cv_func_fork_works" = xcross; then
+ case $host in
+ *-*-amigaos* | *-*-msdosdjgpp*)
+ # Override, as these systems have only a dummy fork() stub
+ ac_cv_func_fork_works=no
+ ;;
+ *)
+ ac_cv_func_fork_works=yes
+ ;;
+ esac
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&5
+$as_echo "$as_me: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&2;}
fi
-
- if test "$resolv" = yes ; then
- RESOLVLIB=-lresolv
- else
- RESOLVLIB=
- fi
- ac_fn_c_check_func "$LINENO" "hes_getmailhost" "ac_cv_func_hes_getmailhost"
-if test "x$ac_cv_func_hes_getmailhost" = x""yes; then :
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for hes_getmailhost in -lhesiod" >&5
-$as_echo_n "checking for hes_getmailhost in -lhesiod... " >&6; }
-if test "${ac_cv_lib_hesiod_hes_getmailhost+set}" = set; then :
+ac_cv_func_vfork_works=$ac_cv_func_vfork
+if test "x$ac_cv_func_vfork" = xyes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working vfork" >&5
+$as_echo_n "checking for working vfork... " >&6; }
+if test "${ac_cv_func_vfork_works+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lhesiod $RESOLVLIB $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ if test "$cross_compiling" = yes; then :
+ ac_cv_func_vfork_works=cross
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
+/* Thanks to Paul Eggert for this test. */
+$ac_includes_default
+#include <sys/wait.h>
+#ifdef HAVE_VFORK_H
+# include <vfork.h>
+#endif
+/* On some sparc systems, changes by the child to local and incoming
+ argument registers are propagated back to the parent. The compiler
+ is told about this with #include <vfork.h>, but some compilers
+ (e.g. gcc -O) don't grok <vfork.h>. Test for this by using a
+ static variable whose address is put into a register that is
+ clobbered by the vfork. */
+static void
#ifdef __cplusplus
-extern "C"
+sparc_address_test (int arg)
+# else
+sparc_address_test (arg) int arg;
#endif
-char hes_getmailhost ();
+{
+ static pid_t child;
+ if (!child) {
+ child = vfork ();
+ if (child < 0) {
+ perror ("vfork");
+ _exit(2);
+ }
+ if (!child) {
+ arg = getpid();
+ write(-1, "", 0);
+ _exit (arg);
+ }
+ }
+}
+
int
main ()
{
-return hes_getmailhost ();
- ;
- return 0;
+ pid_t parent = getpid ();
+ pid_t child;
+
+ sparc_address_test (0);
+
+ child = vfork ();
+
+ if (child == 0) {
+ /* Here is another test for sparc vfork register problems. This
+ test uses lots of local variables, at least as many local
+ variables as main has allocated so far including compiler
+ temporaries. 4 locals are enough for gcc 1.40.3 on a Solaris
+ 4.1.3 sparc, but we use 8 to be safe. A buggy compiler should
+ reuse the register of parent for one of the local variables,
+ since it will think that parent can't possibly be used any more
+ in this routine. Assigning to the local variable will thus
+ munge parent in the parent process. */
+ pid_t
+ p = getpid(), p1 = getpid(), p2 = getpid(), p3 = getpid(),
+ p4 = getpid(), p5 = getpid(), p6 = getpid(), p7 = getpid();
+ /* Convince the compiler that p..p7 are live; otherwise, it might
+ use the same hardware register for all 8 local variables. */
+ if (p != p1 || p != p2 || p != p3 || p != p4
+ || p != p5 || p != p6 || p != p7)
+ _exit(1);
+
+ /* On some systems (e.g. IRIX 3.3), vfork doesn't separate parent
+ from child file descriptors. If the child closes a descriptor
+ before it execs or exits, this munges the parent's descriptor
+ as well. Test for this by closing stdout in the child. */
+ _exit(close(fileno(stdout)) != 0);
+ } else {
+ int status;
+ struct stat st;
+
+ while (wait(&status) != child)
+ ;
+ return (
+ /* Was there some problem with vforking? */
+ child < 0
+
+ /* Did the child fail? (This shouldn't happen.) */
+ || status
+
+ /* Did the vfork/compiler bug occur? */
+ || parent != getpid()
+
+ /* Did the file descriptor bug occur? */
+ || fstat(fileno(stdout), &st) != 0
+ );
+ }
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_hesiod_hes_getmailhost=yes
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_func_vfork_works=yes
else
- ac_cv_lib_hesiod_hes_getmailhost=no
+ ac_cv_func_vfork_works=no
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_hesiod_hes_getmailhost" >&5
-$as_echo "$ac_cv_lib_hesiod_hes_getmailhost" >&6; }
-if test "x$ac_cv_lib_hesiod_hes_getmailhost" = x""yes; then :
- hesiod=yes
-else
- :
+
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_vfork_works" >&5
+$as_echo "$ac_cv_func_vfork_works" >&6; }
+fi;
+if test "x$ac_cv_func_fork_works" = xcross; then
+ ac_cv_func_vfork_works=$ac_cv_func_vfork
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&5
+$as_echo "$as_me: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&2;}
fi
+if test "x$ac_cv_func_vfork_works" = xyes; then
- if test x"$hesiod" = xyes; then
+$as_echo "#define HAVE_WORKING_VFORK 1" >>confdefs.h
-$as_echo "#define HAVE_LIBHESIOD 1" >>confdefs.h
+else
+
+$as_echo "#define vfork fork" >>confdefs.h
- LIBHESIOD=-lhesiod
- fi
fi
+if test "x$ac_cv_func_fork_works" = xyes; then
+$as_echo "#define HAVE_WORKING_FORK 1" >>confdefs.h
-# Do we need libresolv (due to res_init or Hesiod)?
-if test "$resolv" = yes ; then
+fi
-$as_echo "#define HAVE_LIBRESOLV 1" >>confdefs.h
- LIBRESOLV=-lresolv
-else
- LIBRESOLV=
-fi
+for ac_func in snprintf
+do :
+ ac_fn_c_check_func "$LINENO" "snprintf" "ac_cv_func_snprintf"
+if test "x$ac_cv_func_snprintf" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_SNPRINTF 1
+_ACEOF
+fi
+done
-# These tell us which Kerberos-related libraries to use.
-COM_ERRLIB=
-CRYPTOLIB=
-KRB5LIB=
-DESLIB=
-KRB4LIB=
-if test "${with_kerberos}" != no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for com_err in -lcom_err" >&5
-$as_echo_n "checking for com_err in -lcom_err... " >&6; }
-if test "${ac_cv_lib_com_err_com_err+set}" = set; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5
+$as_echo_n "checking for nl_langinfo and CODESET... " >&6; }
+if test "${emacs_cv_langinfo_codeset+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lcom_err $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char com_err ();
+#include <langinfo.h>
int
main ()
{
-return com_err ();
+char* cs = nl_langinfo(CODESET);
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_com_err_com_err=yes
+ emacs_cv_langinfo_codeset=yes
else
- ac_cv_lib_com_err_com_err=no
+ emacs_cv_langinfo_codeset=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_com_err_com_err" >&5
-$as_echo "$ac_cv_lib_com_err_com_err" >&6; }
-if test "x$ac_cv_lib_com_err_com_err" = x""yes; then :
- have_com_err=yes
-else
- have_com_err=no
+
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_langinfo_codeset" >&5
+$as_echo "$emacs_cv_langinfo_codeset" >&6; }
+if test $emacs_cv_langinfo_codeset = yes; then
- if test $have_com_err = yes; then
- COM_ERRLIB=-lcom_err
- LIBS="$COM_ERRLIB $LIBS"
+$as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h
-$as_echo "#define HAVE_LIBCOM_ERR 1" >>confdefs.h
+fi
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lcrypto" >&5
-$as_echo_n "checking for mit_des_cbc_encrypt in -lcrypto... " >&6; }
-if test "${ac_cv_lib_crypto_mit_des_cbc_encrypt+set}" = set; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mbstate_t" >&5
+$as_echo_n "checking for mbstate_t... " >&6; }
+if test "${ac_cv_type_mbstate_t+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lcrypto $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char mit_des_cbc_encrypt ();
+$ac_includes_default
+# include <wchar.h>
int
main ()
{
-return mit_des_cbc_encrypt ();
+mbstate_t x; return sizeof x;
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_crypto_mit_des_cbc_encrypt=yes
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_type_mbstate_t=yes
else
- ac_cv_lib_crypto_mit_des_cbc_encrypt=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+ ac_cv_type_mbstate_t=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_crypto_mit_des_cbc_encrypt" >&5
-$as_echo "$ac_cv_lib_crypto_mit_des_cbc_encrypt" >&6; }
-if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = x""yes; then :
- have_crypto=yes
-else
- have_crypto=no
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_mbstate_t" >&5
+$as_echo "$ac_cv_type_mbstate_t" >&6; }
+ if test $ac_cv_type_mbstate_t = yes; then
- if test $have_crypto = yes; then
- CRYPTOLIB=-lcrypto
- LIBS="$CRYPTOLIB $LIBS"
+$as_echo "#define HAVE_MBSTATE_T 1" >>confdefs.h
-$as_echo "#define HAVE_LIBCRYPTO 1" >>confdefs.h
+ else
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lk5crypto" >&5
-$as_echo_n "checking for mit_des_cbc_encrypt in -lk5crypto... " >&6; }
-if test "${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+set}" = set; then :
+$as_echo "#define mbstate_t int" >>confdefs.h
+
+ fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C restricted array declarations" >&5
+$as_echo_n "checking for C restricted array declarations... " >&6; }
+if test "${emacs_cv_c_restrict_arr+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lk5crypto $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char mit_des_cbc_encrypt ();
+void fred (int x[__restrict]);
int
main ()
{
-return mit_des_cbc_encrypt ();
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_k5crypto_mit_des_cbc_encrypt=yes
+if ac_fn_c_try_compile "$LINENO"; then :
+ emacs_cv_c_restrict_arr=yes
else
- ac_cv_lib_k5crypto_mit_des_cbc_encrypt=no
+ emacs_cv_c_restrict_arr=no
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&5
-$as_echo "$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&6; }
-if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = x""yes; then :
- have_k5crypto=yes
-else
- have_k5crypto=no
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_c_restrict_arr" >&5
+$as_echo "$emacs_cv_c_restrict_arr" >&6; }
+if test "$emacs_cv_c_restrict_arr" = yes; then
+
+$as_echo "#define __restrict_arr __restrict" >>confdefs.h
+
fi
- if test $have_k5crypto = yes; then
- CRYPTOLIB=-lk5crypto
- LIBS="$CRYPTOLIB $LIBS"
-$as_echo "#define HAVE_LIBK5CRYPTO 1" >>confdefs.h
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb5_init_context in -lkrb5" >&5
-$as_echo_n "checking for krb5_init_context in -lkrb5... " >&6; }
-if test "${ac_cv_lib_krb5_krb5_init_context+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lkrb5 $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+$as_echo "#define AMPERSAND_FULL_NAME 1" >>confdefs.h
+
+
+
+$as_echo "#define CLASH_DETECTION 1" >>confdefs.h
+
+
+## Note: PTYs are broken on darwin <6. Use at your own risk.
+
+$as_echo "#define HAVE_PTYS 1" >>confdefs.h
+
+
+
+$as_echo "#define HAVE_SOCKETS 1" >>confdefs.h
+
+
+
+
+
+$as_echo "#define NULL_DEVICE \"/dev/null\"" >>confdefs.h
+
+
+
+$as_echo "#define SEPCHAR ':'" >>confdefs.h
+
+
+
+$as_echo "#define subprocesses 1" >>confdefs.h
+
+
+
+$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
+
+
+
+$as_echo "#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)" >>confdefs.h
+
+
+
+$as_echo "#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_))" >>confdefs.h
+
+
+
+
+
+case $opsys in
+ aix4-2)
+ if test x$ac_cv_lib_Xmu_XmuConvertStandardSelection != xyes; then
+ $as_echo "#define NO_EDITRES 1" >>confdefs.h
+
+ fi
+ ;;
+
+ hpux*)
+ $as_echo "#define NO_EDITRES 1" >>confdefs.h
+
+ ;;
+esac
+
+
+case $opsys in
+ irix6-5 | sol2* | unixware )
+
+$as_echo "#define NSIG_MINIMUM 32" >>confdefs.h
+
+ ;;
+esac
+
+emacs_broken_SIGIO=no
+
+case $opsys in
+ hpux* | irix6-5 | openbsd | sol2* | unixware )
+ emacs_broken_SIGIO=yes
+ ;;
+
+ aix4-2)
+
+$as_echo "#define BROKEN_GET_CURRENT_DIR_NAME 1" >>confdefs.h
+
+ ;;
+
+ freebsd)
+
+$as_echo "#define BROKEN_PTY_READ_AFTER_EAGAIN 1" >>confdefs.h
+
+ ;;
+esac
+
+case $opsys in
+ gnu-* | sol2-10 )
+
+$as_echo "#define HAVE_PROCFS 1" >>confdefs.h
+
+ ;;
+esac
+
+case $opsys in
+ darwin | freebsd | netbsd | openbsd )
+
+$as_echo "#define DONT_REOPEN_PTY 1" >>confdefs.h
+
+ ;;
+esac
+
+case $opsys in
+ netbsd | openbsd) sound_device="/dev/audio" ;;
+ *) sound_device="/dev/dsp" ;;
+esac
+
+
+cat >>confdefs.h <<_ACEOF
+#define DEFAULT_SOUND_DEVICE "$sound_device"
+_ACEOF
+
+
+
+case $opsys in
+ darwin | gnu-linux | gnu-kfreebsd )
+
+$as_echo "#define INTERRUPT_INPUT 1" >>confdefs.h
+
+ ;;
+esac
+
+
+case $opsys in
+ cygwin|gnu|gnu-linux|gnu-kfreebsd|irix6-5|freebsd|netbsd|openbsd)
+
+$as_echo "#define NARROWPROTO 1" >>confdefs.h
+
+ ;;
+esac
+
+
+
+
+
+
+
+
+case $opsys in
+ aix4-2 )
+ $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_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_OPEN do { int dummy; sigset_t blocked, procmask; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, &procmask); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; pthread_sigmask (SIG_SETMASK, &procmask, 0); if (fd >= 0) emacs_close (dummy); } while (0)" >>confdefs.h
+
+ $as_echo "#define PTY_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 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_NAME_SPRINTF /**/" >>confdefs.h
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char krb5_init_context ();
-int
-main ()
-{
-return krb5_init_context ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_krb5_krb5_init_context=yes
-else
- ac_cv_lib_krb5_krb5_init_context=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb5_krb5_init_context" >&5
-$as_echo "$ac_cv_lib_krb5_krb5_init_context" >&6; }
-if test "x$ac_cv_lib_krb5_krb5_init_context" = x""yes; then :
- have_krb5=yes
-else
- have_krb5=no
-fi
+ $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h
- if test $have_krb5=yes; then
- KRB5LIB=-lkrb5
- LIBS="$KRB5LIB $LIBS"
+ ;;
-$as_echo "#define HAVE_LIBKRB5 1" >>confdefs.h
+ gnu | openbsd )
+ $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h
- fi
- if test "${with_kerberos5}" = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes425" >&5
-$as_echo_n "checking for des_cbc_encrypt in -ldes425... " >&6; }
-if test "${ac_cv_lib_des425_des_cbc_encrypt+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-ldes425 $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ ;;
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char des_cbc_encrypt ();
-int
-main ()
-{
-return des_cbc_encrypt ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_des425_des_cbc_encrypt=yes
-else
- ac_cv_lib_des425_des_cbc_encrypt=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_des425_des_cbc_encrypt" >&5
-$as_echo "$ac_cv_lib_des425_des_cbc_encrypt" >&6; }
-if test "x$ac_cv_lib_des425_des_cbc_encrypt" = x""yes; then :
- have_des425=yes
-else
- have_des425=no
-fi
+ gnu-linux | gnu-kfreebsd | freebsd | netbsd )
+ if test "x$ac_cv_func_grantpt" = xyes; then
- if test $have_des425 = yes; then
- DESLIB=-ldes425
- LIBS="$DESLIB $LIBS"
+$as_echo "#define UNIX98_PTYS 1" >>confdefs.h
-$as_echo "#define HAVE_LIBDES425 1" >>confdefs.h
+ $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes" >&5
-$as_echo_n "checking for des_cbc_encrypt in -ldes... " >&6; }
-if test "${ac_cv_lib_des_des_cbc_encrypt+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-ldes $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char des_cbc_encrypt ();
-int
-main ()
-{
-return des_cbc_encrypt ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_des_des_cbc_encrypt=yes
-else
- ac_cv_lib_des_des_cbc_encrypt=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_des_des_cbc_encrypt" >&5
-$as_echo "$ac_cv_lib_des_des_cbc_encrypt" >&6; }
-if test "x$ac_cv_lib_des_des_cbc_encrypt" = x""yes; then :
- have_des=yes
-else
- have_des=no
-fi
+ if test "x$ac_cv_func_posix_openpt" = xyes; then
+ $as_echo "#define PTY_OPEN fd = posix_openpt (O_RDWR | O_NOCTTY)" >>confdefs.h
- if test $have_des = yes; then
- DESLIB=-ldes
- LIBS="$DESLIB $LIBS"
+ $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h
-$as_echo "#define HAVE_LIBDES 1" >>confdefs.h
+ elif 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
+
+ else
+ $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptmx\");" >>confdefs.h
fi
+ else
+ $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h
+
fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb4" >&5
-$as_echo_n "checking for krb_get_cred in -lkrb4... " >&6; }
-if test "${ac_cv_lib_krb4_krb_get_cred+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lkrb4 $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ;;
+
+ 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_TTY_NAME_SPRINTF sprintf (pty_name, \"/dev/pty/tty%c%x\", c, i);" >>confdefs.h
+
+ ;;
+
+ irix6-5 )
+ $as_echo "#define PTY_ITERATION /**/" >>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_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; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(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; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal(\"could not grant slave pty\"); 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
+
+
+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 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
+
+ ;;
+esac
+
+
+
+
+case $opsys in
+ aix4-2 | cygwin | gnu | irix6-5 | freebsd | netbsd | openbsd )
+ $as_echo "#define SIGNALS_VIA_CHARACTERS 1" >>confdefs.h
+
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for signals via characters" >&5
+$as_echo_n "checking for signals via characters... " >&6; }
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
+#include <linux/version.h>
+#if LINUX_VERSION_CODE < 0x20400
+# error "Linux version too old"
#endif
-char krb_get_cred ();
+
int
main ()
{
-return krb_get_cred ();
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_krb4_krb_get_cred=yes
-else
- ac_cv_lib_krb4_krb_get_cred=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb4_krb_get_cred" >&5
-$as_echo "$ac_cv_lib_krb4_krb_get_cred" >&6; }
-if test "x$ac_cv_lib_krb4_krb_get_cred" = x""yes; then :
- have_krb4=yes
+if ac_fn_c_try_cpp "$LINENO"; then :
+ emacs_signals_via_chars=yes
else
- have_krb4=no
+ emacs_signals_via_chars=no
fi
+rm -f conftest.err conftest.$ac_ext
- if test $have_krb4 = yes; then
- KRB4LIB=-lkrb4
- LIBS="$KRB4LIB $LIBS"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_signals_via_chars" >&5
+$as_echo "$emacs_signals_via_chars" >&6; }
+ test $emacs_signals_via_chars = yes && $as_echo "#define SIGNALS_VIA_CHARACTERS 1" >>confdefs.h
-$as_echo "#define HAVE_LIBKRB4 1" >>confdefs.h
+ ;;
+esac
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb" >&5
-$as_echo_n "checking for krb_get_cred in -lkrb... " >&6; }
-if test "${ac_cv_lib_krb_krb_get_cred+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lkrb $LIBS"
+
+
+
+{ $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. */
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
+#include <features.h>
+#ifndef __GNU_LIBRARY__
+# error "this is not the GNU C library"
#endif
-char krb_get_cred ();
+
int
main ()
{
-return krb_get_cred ();
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_krb_krb_get_cred=yes
-else
- ac_cv_lib_krb_krb_get_cred=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb_krb_get_cred" >&5
-$as_echo "$ac_cv_lib_krb_krb_get_cred" >&6; }
-if test "x$ac_cv_lib_krb_krb_get_cred" = x""yes; then :
- have_krb=yes
+if ac_fn_c_try_cpp "$LINENO"; then :
+ emacs_glibc=yes
else
- have_krb=no
+ 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; }
- if test $have_krb = yes; then
- KRB4LIB=-lkrb
- LIBS="$KRB4LIB $LIBS"
-
-$as_echo "#define HAVE_LIBKRB 1" >>confdefs.h
-
- fi
- fi
- fi
+if test $emacs_glibc = yes; then
- if test "${with_kerberos5}" != no; then
- for ac_header in krb5.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "krb5.h" "ac_cv_header_krb5_h" "$ac_includes_default"
-if test "x$ac_cv_header_krb5_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KRB5_H 1
-_ACEOF
- ac_fn_c_check_member "$LINENO" "krb5_error" "text" "ac_cv_member_krb5_error_text" "#include <krb5.h>
-"
-if test "x$ac_cv_member_krb5_error_text" = x""yes; then :
+ emacs_pending_output=unknown
-cat >>confdefs.h <<_ACEOF
-#define HAVE_KRB5_ERROR_TEXT 1
-_ACEOF
+ 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
+/* end confdefs.h. */
+#include <stdio.h>
+#if !defined (_IO_STDIO_H) && !defined (_STDIO_USES_IOSTREAM)
+# error "stdio definitions not found"
+#endif
-fi
-ac_fn_c_check_member "$LINENO" "krb5_error" "e_text" "ac_cv_member_krb5_error_e_text" "#include <krb5.h>
-"
-if test "x$ac_cv_member_krb5_error_e_text" = x""yes; then :
+int
+main ()
+{
-cat >>confdefs.h <<_ACEOF
-#define HAVE_KRB5_ERROR_E_TEXT 1
+ ;
+ return 0;
+}
_ACEOF
-
-
+if ac_fn_c_try_cpp "$LINENO"; then :
+ emacs_pending_output=new
fi
+rm -f conftest.err conftest.$ac_ext
-fi
+ if test $emacs_pending_output = unknown; then
+ case $opsys in
+ gnu-linux | gnu-kfreebsd)
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-done
+#include <stdio.h>
+#ifndef __UCLIBC__
+# error "not using uclibc"
+#endif
- else
- for ac_header in des.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "des.h" "ac_cv_header_des_h" "$ac_includes_default"
-if test "x$ac_cv_header_des_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_DES_H 1
-_ACEOF
+int
+main ()
+{
-else
- for ac_header in kerberosIV/des.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/des.h" "ac_cv_header_kerberosIV_des_h" "$ac_includes_default"
-if test "x$ac_cv_header_kerberosIV_des_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KERBEROSIV_DES_H 1
+ ;
+ return 0;
+}
_ACEOF
-
+if ac_fn_c_try_cpp "$LINENO"; then :
+ emacs_pending_output=uclibc
else
- for ac_header in kerberos/des.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "kerberos/des.h" "ac_cv_header_kerberos_des_h" "$ac_includes_default"
-if test "x$ac_cv_header_kerberos_des_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KERBEROS_DES_H 1
-_ACEOF
-
+ emacs_pending_output=old
fi
+rm -f conftest.err conftest.$ac_ext
+ ;;
+ esac
+ fi
-done
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_pending_output" >&5
+$as_echo "$emacs_pending_output" >&6; }
-fi
+ case $emacs_pending_output in
+ new)
+ $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)" >>confdefs.h
-done
+ ;;
+ uclibc)
+ $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufpos - (FILE)->__bufstart)" >>confdefs.h
-fi
+ ;;
+ old)
+ $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_pptr - (FILE)->_pbase)" >>confdefs.h
-done
+ ;;
+ esac
+ ;;
+ esac
+ if test $emacs_pending_output = unknown; then
+ $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufp - (FILE)->__buffer)" >>confdefs.h
- for ac_header in krb.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "krb.h" "ac_cv_header_krb_h" "$ac_includes_default"
-if test "x$ac_cv_header_krb_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KRB_H 1
-_ACEOF
+ fi
else
- for ac_header in kerberosIV/krb.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/krb.h" "ac_cv_header_kerberosIV_krb_h" "$ac_includes_default"
-if test "x$ac_cv_header_kerberosIV_krb_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KERBEROSIV_KRB_H 1
-_ACEOF
+ case $opsys in
+ cygwin | darwin | freebsd | netbsd | openbsd )
+ $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)" >>confdefs.h
-else
- for ac_header in kerberos/krb.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "kerberos/krb.h" "ac_cv_header_kerberos_krb_h" "$ac_includes_default"
-if test "x$ac_cv_header_kerberos_krb_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_KERBEROS_KRB_H 1
-_ACEOF
+ ;;
-fi
+ unixware)
+ $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base)" >>confdefs.h
-done
+ ;;
-fi
+ *)
+ 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
-done
+$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
-done
- fi
- for ac_header in com_err.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "com_err.h" "ac_cv_header_com_err_h" "$ac_includes_default"
-if test "x$ac_cv_header_com_err_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_COM_ERR_H 1
-_ACEOF
-fi
-done
+case $opsys in
+ gnu)
+ $as_echo "#define DATA_START ({ extern int data_start; (char *) &data_start; })" >>confdefs.h
-fi
+ ;;
+ hpux*)
+ $as_echo "#define DATA_START 0x40000000" >>confdefs.h
+ $as_echo "#define DATA_SEG_BITS 0x40000000" >>confdefs.h
+ ;;
+ irix6-5)
+ $as_echo "#define DATA_START 0x10000000" >>confdefs.h
+ $as_echo "#define DATA_SEG_BITS 0x10000000" >>confdefs.h
+ ;;
+esac
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime caches TZ" >&5
-$as_echo_n "checking whether localtime caches TZ... " >&6; }
-if test "${emacs_cv_localtime_cache+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- if test x$ac_cv_func_tzset = xyes; then
-if test "$cross_compiling" = yes; then :
- # If we have tzset, assume the worst when cross-compiling.
-emacs_cv_localtime_cache=yes
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <time.h>
-char TZ_GMT0[] = "TZ=GMT0";
-char TZ_PST8[] = "TZ=PST8";
-main()
-{
- time_t now = time ((time_t *) 0);
- int hour_GMT0, hour_unset;
- if (putenv (TZ_GMT0) != 0)
- exit (1);
- hour_GMT0 = localtime (&now)->tm_hour;
- unsetenv("TZ");
- hour_unset = localtime (&now)->tm_hour;
- if (putenv (TZ_PST8) != 0)
- exit (1);
- if (localtime (&now)->tm_hour == hour_GMT0)
- exit (1);
- unsetenv("TZ");
- if (localtime (&now)->tm_hour != hour_unset)
- exit (1);
- exit (0);
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- emacs_cv_localtime_cache=no
-else
- emacs_cv_localtime_cache=yes
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-else
- # If we lack tzset, report that localtime does not cache TZ,
- # since we can't invalidate the cache if we don't have tzset.
- emacs_cv_localtime_cache=no
-fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_localtime_cache" >&5
-$as_echo "$emacs_cv_localtime_cache" >&6; }
-if test $emacs_cv_localtime_cache = yes; then
-$as_echo "#define LOCALTIME_CACHE 1" >>confdefs.h
-fi
+case $opsys in
+ darwin) $as_echo "#define TAB3 OXTABS" >>confdefs.h
+ ;;
-if test "x$HAVE_TIMEVAL" = xyes; then
- for ac_func in gettimeofday
-do :
- ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday"
-if test "x$ac_cv_func_gettimeofday" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_GETTIMEOFDAY 1
-_ACEOF
+ gnu | freebsd | netbsd | openbsd )
-fi
-done
+$as_echo "#define TABDLY OXTABS" >>confdefs.h
- if test $ac_cv_func_gettimeofday = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gettimeofday can accept two arguments" >&5
-$as_echo_n "checking whether gettimeofday can accept two arguments... " >&6; }
-if test "${emacs_cv_gettimeofday_two_arguments+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ $as_echo "#define TAB3 OXTABS" >>confdefs.h
+
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
+#ifndef __i386__
+# error "not i386"
#endif
+
int
main ()
{
-struct timeval time;
- gettimeofday (&time, 0);
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_gettimeofday_two_arguments=yes
-else
- emacs_cv_gettimeofday_two_arguments=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_gettimeofday_two_arguments" >&5
-$as_echo "$emacs_cv_gettimeofday_two_arguments" >&6; }
- if test $emacs_cv_gettimeofday_two_arguments = no; then
-
-$as_echo "#define GETTIMEOFDAY_ONE_ARGUMENT 1" >>confdefs.h
+if ac_fn_c_try_cpp "$LINENO"; then :
+ $as_echo "#define ULIMIT_BREAK_VALUE (32*1024*1024)" >>confdefs.h
- fi
- fi
fi
+rm -f conftest.err conftest.$ac_ext
-ok_so_far=yes
-ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket"
-if test "x$ac_cv_func_socket" = x""yes; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-else
- ok_so_far=no
-fi
+#ifndef __ia64__
+# error "not ia64"
+#endif
-if test $ok_so_far = yes; then
- ac_fn_c_check_header_mongrel "$LINENO" "netinet/in.h" "ac_cv_header_netinet_in_h" "$ac_includes_default"
-if test "x$ac_cv_header_netinet_in_h" = x""yes; then :
+int
+main ()
+{
-else
- ok_so_far=no
-fi
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+$as_echo "#define GC_MARK_SECONDARY_STACK() do { extern void *__libc_ia64_register_backing_store_base; __builtin_ia64_flushrs (); mark_memory (__libc_ia64_register_backing_store_base, __builtin_ia64_bsp ());} while (0)" >>confdefs.h
fi
-if test $ok_so_far = yes; then
- ac_fn_c_check_header_mongrel "$LINENO" "arpa/inet.h" "ac_cv_header_arpa_inet_h" "$ac_includes_default"
-if test "x$ac_cv_header_arpa_inet_h" = x""yes; then :
+rm -f conftest.err conftest.$ac_ext
+ ;;
-else
- ok_so_far=no
-fi
+ hpux*)
+$as_echo "#define RUN_TIME_REMAP 1" >>confdefs.h
-fi
-if test $ok_so_far = yes; then
+ ;;
-$as_echo "#define HAVE_INET_SOCKETS 1" >>confdefs.h
+ irix6-5)
+ $as_echo "#define ULIMIT_BREAK_VALUE 0x14000000" >>confdefs.h
-fi
+ ;;
+esac
-if test -f /usr/lpp/X11/bin/smt.exp; then
-$as_echo "#define HAVE_AIX_SMT_EXP 1" >>confdefs.h
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system supports dynamic ptys" >&5
-$as_echo_n "checking whether system supports dynamic ptys... " >&6; }
-if test -d /dev/pts && ls -d /dev/ptmx > /dev/null 2>&1 ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-$as_echo "#define HAVE_DEV_PTMX 1" >>confdefs.h
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default"
-if test "x$ac_cv_type_pid_t" = x""yes; then :
+case $opsys in
+ aix4-2 | hpux* | unixware)
+ $as_echo "#define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE" >>confdefs.h
-else
+ ;;
-cat >>confdefs.h <<_ACEOF
-#define pid_t int
-_ACEOF
+ gnu-linux | gnu-kfreebsd )
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-fi
+#if defined __i386__ || defined __sparc__ || defined __mc68000__ \
+ || defined __alpha__ || defined __mips__ || defined __s390__ \
+ || defined __arm__ || defined __powerpc__ || defined __amd64__ \
+ || defined __ia64__ || defined __sh__
+/* ok */
+#else
+# error "setjmp not known to work on this arch"
+#endif
-for ac_header in vfork.h
-do :
- ac_fn_c_check_header_mongrel "$LINENO" "vfork.h" "ac_cv_header_vfork_h" "$ac_includes_default"
-if test "x$ac_cv_header_vfork_h" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_VFORK_H 1
+int
+main ()
+{
+
+ ;
+ return 0;
+}
_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ $as_echo "#define GC_SETJMP_WORKS 1" >>confdefs.h
+
+else
+ $as_echo "#define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE" >>confdefs.h
fi
+rm -f conftest.err conftest.$ac_ext
+ ;;
+esac
-done
-for ac_func in fork vfork
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-eval as_val=\$$as_ac_var
- if test "x$as_val" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
+if test x$GCC = xyes; then
+ $as_echo "#define GC_SETJMP_WORKS 1" >>confdefs.h
-fi
-done
+else
+ case $opsys in
+ freebsd | netbsd | openbsd | irix6-5 | sol2* )
+ $as_echo "#define GC_SETJMP_WORKS 1" >>confdefs.h
-if test "x$ac_cv_func_fork" = xyes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working fork" >&5
-$as_echo_n "checking for working fork... " >&6; }
-if test "${ac_cv_func_fork_works+set}" = set; then :
+ ;;
+ esac
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _setjmp" >&5
+$as_echo_n "checking for _setjmp... " >&6; }
+if test "${emacs_cv_func__setjmp+set}" = set; then :
$as_echo_n "(cached) " >&6
-else
- if test "$cross_compiling" = yes; then :
- ac_cv_func_fork_works=cross
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-$ac_includes_default
+#include <setjmp.h>
+
int
main ()
{
-
- /* By Ruediger Kuhlmann. */
- return fork () < 0;
-
+jmp_buf j;
+ if (! _setjmp (j))
+ _longjmp (j, 1);
;
return 0;
}
_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_func_fork_works=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_func__setjmp=yes
else
- ac_cv_func_fork_works=no
+ emacs_cv_func__setjmp=no
fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_func__setjmp" >&5
+$as_echo "$emacs_cv_func__setjmp" >&6; }
+if test $emacs_cv_func__setjmp = yes; then
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_fork_works" >&5
-$as_echo "$ac_cv_func_fork_works" >&6; }
+$as_echo "#define HAVE__SETJMP 1" >>confdefs.h
else
- ac_cv_func_fork_works=$ac_cv_func_fork
-fi
-if test "x$ac_cv_func_fork_works" = xcross; then
- case $host in
- *-*-amigaos* | *-*-msdosdjgpp*)
- # Override, as these systems have only a dummy fork() stub
- ac_cv_func_fork_works=no
- ;;
- *)
- ac_cv_func_fork_works=yes
- ;;
- esac
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&5
-$as_echo "$as_me: WARNING: result $ac_cv_func_fork_works guessed because of cross compilation" >&2;}
-fi
-ac_cv_func_vfork_works=$ac_cv_func_vfork
-if test "x$ac_cv_func_vfork" = xyes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working vfork" >&5
-$as_echo_n "checking for working vfork... " >&6; }
-if test "${ac_cv_func_vfork_works+set}" = set; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigsetjmp" >&5
+$as_echo_n "checking for sigsetjmp... " >&6; }
+if test "${emacs_cv_func_sigsetjmp+set}" = set; then :
$as_echo_n "(cached) " >&6
-else
- if test "$cross_compiling" = yes; then :
- ac_cv_func_vfork_works=cross
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Thanks to Paul Eggert for this test. */
-$ac_includes_default
-#include <sys/wait.h>
-#ifdef HAVE_VFORK_H
-# include <vfork.h>
-#endif
-/* On some sparc systems, changes by the child to local and incoming
- argument registers are propagated back to the parent. The compiler
- is told about this with #include <vfork.h>, but some compilers
- (e.g. gcc -O) don't grok <vfork.h>. Test for this by using a
- static variable whose address is put into a register that is
- clobbered by the vfork. */
-static void
-#ifdef __cplusplus
-sparc_address_test (int arg)
-# else
-sparc_address_test (arg) int arg;
-#endif
-{
- static pid_t child;
- if (!child) {
- child = vfork ();
- if (child < 0) {
- perror ("vfork");
- _exit(2);
- }
- if (!child) {
- arg = getpid();
- write(-1, "", 0);
- _exit (arg);
- }
- }
-}
+#include <setjmp.h>
int
main ()
{
- pid_t parent = getpid ();
- pid_t child;
+sigjmp_buf j;
+ if (! sigsetjmp (j, 1))
+ siglongjmp (j, 1);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ emacs_cv_func_sigsetjmp=yes
+else
+ emacs_cv_func_sigsetjmp=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_func_sigsetjmp" >&5
+$as_echo "$emacs_cv_func_sigsetjmp" >&6; }
+ if test $emacs_cv_func_sigsetjmp = yes; then
- sparc_address_test (0);
+$as_echo "#define HAVE_SIGSETJMP 1" >>confdefs.h
- child = vfork ();
+ fi
+fi
- if (child == 0) {
- /* Here is another test for sparc vfork register problems. This
- test uses lots of local variables, at least as many local
- variables as main has allocated so far including compiler
- temporaries. 4 locals are enough for gcc 1.40.3 on a Solaris
- 4.1.3 sparc, but we use 8 to be safe. A buggy compiler should
- reuse the register of parent for one of the local variables,
- since it will think that parent can't possibly be used any more
- in this routine. Assigning to the local variable will thus
- munge parent in the parent process. */
- pid_t
- p = getpid(), p1 = getpid(), p2 = getpid(), p3 = getpid(),
- p4 = getpid(), p5 = getpid(), p6 = getpid(), p7 = getpid();
- /* Convince the compiler that p..p7 are live; otherwise, it might
- use the same hardware register for all 8 local variables. */
- if (p != p1 || p != p2 || p != p3 || p != p4
- || p != p5 || p != p6 || p != p7)
- _exit(1);
+case $opsys in
+ sol2* | unixware )
- /* On some systems (e.g. IRIX 3.3), vfork doesn't separate parent
- from child file descriptors. If the child closes a descriptor
- before it execs or exits, this munges the parent's descriptor
- as well. Test for this by closing stdout in the child. */
- _exit(close(fileno(stdout)) != 0);
- } else {
- int status;
- struct stat st;
+$as_echo "#define TIOCSIGSEND TIOCSIGNAL" >>confdefs.h
- while (wait(&status) != child)
- ;
- return (
- /* Was there some problem with vforking? */
- child < 0
+ ;;
+esac
- /* Did the child fail? (This shouldn't happen.) */
- || status
- /* Did the vfork/compiler bug occur? */
- || parent != getpid()
+case $opsys in
+ hpux* | sol2* )
- /* Did the file descriptor bug occur? */
- || fstat(fileno(stdout), &st) != 0
- );
- }
+$as_echo "#define XOS_NEEDS_TIME_H 1" >>confdefs.h
+
+ ;;
+esac
+
+
+
+
+
+
+
+
+
+
+case $opsys in
+ aix4-2)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#ifndef _AIX
+# error "_AIX not defined"
+#endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
}
_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_func_vfork_works=yes
+if ac_fn_c_try_cpp "$LINENO"; then :
+
else
- ac_cv_func_vfork_works=no
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_vfork_works" >&5
-$as_echo "$ac_cv_func_vfork_works" >&6; }
+$as_echo "#define _AIX /**/" >>confdefs.h
-fi;
-if test "x$ac_cv_func_fork_works" = xcross; then
- ac_cv_func_vfork_works=$ac_cv_func_vfork
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&5
-$as_echo "$as_me: WARNING: result $ac_cv_func_vfork_works guessed because of cross compilation" >&2;}
fi
+rm -f conftest.err conftest.$ac_ext
+ ;;
-if test "x$ac_cv_func_vfork_works" = xyes; then
+ cygwin)
-$as_echo "#define HAVE_WORKING_VFORK 1" >>confdefs.h
+$as_echo "#define CYGWIN 1" >>confdefs.h
-else
+ ;;
-$as_echo "#define vfork fork" >>confdefs.h
+ darwin)
+ $as_echo "#define BSD4_2 /**/" >>confdefs.h
-fi
-if test "x$ac_cv_func_fork_works" = xyes; then
+ $as_echo "#define BSD_SYSTEM /**/" >>confdefs.h
-$as_echo "#define HAVE_WORKING_FORK 1" >>confdefs.h
-fi
+$as_echo "#define DARWIN_OS /**/" >>confdefs.h
+ ;;
-for ac_func in snprintf
-do :
- ac_fn_c_check_func "$LINENO" "snprintf" "ac_cv_func_snprintf"
-if test "x$ac_cv_func_snprintf" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_SNPRINTF 1
-_ACEOF
+ freebsd)
+ $as_echo "#define BSD4_2 /**/" >>confdefs.h
-fi
-done
+$as_echo "#define BSD_SYSTEM_AHB 1" >>confdefs.h
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5
-$as_echo_n "checking for nl_langinfo and CODESET... " >&6; }
-if test "${emacs_cv_langinfo_codeset+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ;;
+
+ gnu | netbsd | openbsd )
+ $as_echo "#define BSD4_2 /**/" >>confdefs.h
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <langinfo.h>
+
+#ifndef BSD_SYSTEM
+# error "BSD_SYSTEM not defined"
+#endif
+
int
main ()
{
-char* cs = nl_langinfo(CODESET);
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- emacs_cv_langinfo_codeset=yes
+if ac_fn_c_try_cpp "$LINENO"; then :
+
else
- emacs_cv_langinfo_codeset=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+ $as_echo "#define BSD_SYSTEM 43" >>confdefs.h
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_langinfo_codeset" >&5
-$as_echo "$emacs_cv_langinfo_codeset" >&6; }
-if test $emacs_cv_langinfo_codeset = yes; then
+rm -f conftest.err conftest.$ac_ext
+ ;;
-$as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h
+ gnu-linux | gnu-kfreebsd )
+ $as_echo "#define USG /**/" >>confdefs.h
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mbstate_t" >&5
-$as_echo_n "checking for mbstate_t... " >&6; }
-if test "${ac_cv_type_mbstate_t+set}" = set; then :
+$as_echo "#define GNU_LINUX /**/" >>confdefs.h
+
+ ;;
+
+ hpux*)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+
+$as_echo "#define HPUX /**/" >>confdefs.h
+
+ ;;
+
+ irix6-5)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+ $as_echo "#define USG5_4 /**/" >>confdefs.h
+
+
+$as_echo "#define IRIX6_5 /**/" >>confdefs.h
+
+ ;;
+
+ sol2*)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+ $as_echo "#define USG5_4 /**/" >>confdefs.h
+
+
+$as_echo "#define SOLARIS2 /**/" >>confdefs.h
+
+ ;;
+
+ unixware)
+ $as_echo "#define USG /**/" >>confdefs.h
+
+ $as_echo "#define USG5 /**/" >>confdefs.h
+
+ $as_echo "#define USG5_4 /**/" >>confdefs.h
+
+ ;;
+esac
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable FIONREAD" >&5
+$as_echo_n "checking for usable FIONREAD... " >&6; }
+if test "${emacs_cv_usable_FIONREAD+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ case $opsys in
+ aix4-2)
+ emacs_cv_usable_FIONREAD=no
+ ;;
+
+ *)
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-$ac_includes_default
-# include <wchar.h>
+#include <sys/types.h>
+ #include <sys/ioctl.h>
+ #ifdef USG5_4
+ # include <sys/filio.h>
+ #endif
+
int
main ()
{
-mbstate_t x; return sizeof x;
+int foo = ioctl (0, FIONREAD, &foo);
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_type_mbstate_t=yes
+ emacs_cv_usable_FIONREAD=yes
else
- ac_cv_type_mbstate_t=no
+ emacs_cv_usable_FIONREAD=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ ;;
+ esac
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_mbstate_t" >&5
-$as_echo "$ac_cv_type_mbstate_t" >&6; }
- if test $ac_cv_type_mbstate_t = yes; then
-
-$as_echo "#define HAVE_MBSTATE_T 1" >>confdefs.h
-
- else
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_usable_FIONREAD" >&5
+$as_echo "$emacs_cv_usable_FIONREAD" >&6; }
+if test $emacs_cv_usable_FIONREAD = yes; then
-$as_echo "#define mbstate_t int" >>confdefs.h
+$as_echo "#define USABLE_FIONREAD 1" >>confdefs.h
- fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C restricted array declarations" >&5
-$as_echo_n "checking for C restricted array declarations... " >&6; }
-if test "${emacs_cv_c_restrict_arr+set}" = set; then :
+ if test $emacs_broken_SIGIO = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for usable SIGIO" >&5
+$as_echo_n "checking for usable SIGIO... " >&6; }
+if test "${emacs_cv_usable_SIGIO+set}" = set; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-void fred (int x[__restrict]);
+#include <fcntl.h>
+ #include <signal.h>
+
int
main ()
{
-
+int foo = SIGIO | F_SETFL | FASYNC;
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- emacs_cv_c_restrict_arr=yes
+ emacs_cv_usable_SIGIO=yes
else
- emacs_cv_c_restrict_arr=no
+ emacs_cv_usable_SIGIO=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_c_restrict_arr" >&5
-$as_echo "$emacs_cv_c_restrict_arr" >&6; }
-if test "$emacs_cv_c_restrict_arr" = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_cv_usable_SIGIO" >&5
+$as_echo "$emacs_cv_usable_SIGIO" >&6; }
+ if test $emacs_cv_usable_SIGIO = yes; then
-$as_echo "#define __restrict_arr __restrict" >>confdefs.h
+$as_echo "#define USABLE_SIGIO 1" >>confdefs.h
+ fi
+ fi
fi
+case $opsys in
+ cygwin)
+
+$as_echo "#define G_SLICE_ALWAYS_MALLOC 1" >>confdefs.h
+
+ ;;
+
+ hpux11)
+
+$as_echo "#define USG_SUBTTY_WORKS 1" >>confdefs.h
+
+ ;;
+
+ irix6-5)
+
+$as_echo "#define PREFER_VSUSP 1" >>confdefs.h
+
+
+$as_echo "#define SETPGRP_RELEASES_CTTY 1" >>confdefs.h
+
+ ;;
+
+ sol2-10)
+
+$as_echo "#define _STRUCTURED_PROC 1" >>confdefs.h
+
+ ;;
+esac
+
# Set up the CFLAGS for real compilation, so we can substitute it.
CFLAGS="$REAL_CFLAGS"
CPPFLAGS="$REAL_CPPFLAGS"
version=$PACKAGE_VERSION
+copyright="Copyright (C) 2012 Free Software Foundation, Inc."
+
+cat >>confdefs.h <<_ACEOF
+#define COPYRIGHT "$copyright"
+_ACEOF
+
+
+
### Specify what sort of things we'll be editing into Makefile and config.h.
### Use configuration here uncanonicalized to avoid exceeding size limits.
+
+
## FIXME? Nothing uses @LD_SWITCH_X_SITE@.
## Used in lwlib/Makefile.in.
-if test -n "${machfile}"; then
- M_FILE="\$(srcdir)/${machfile}"
-else
- M_FILE=
-fi
-S_FILE="\$(srcdir)/${opsysfile}"
-
-
+if test -n "${term_header}"; then
cat >>confdefs.h <<_ACEOF
-#define EMACS_CONFIGURATION "${canonical}"
+#define TERM_HEADER "${term_header}"
_ACEOF
+fi
-cat >>confdefs.h <<_ACEOF
-#define EMACS_CONFIG_OPTIONS "${ac_configure_args}"
-_ACEOF
-
-if test -n "$machfile"; then
cat >>confdefs.h <<_ACEOF
-#define config_machfile "${machfile}"
+#define EMACS_CONFIGURATION "${canonical}"
_ACEOF
-fi
cat >>confdefs.h <<_ACEOF
-#define config_opsysfile "${opsysfile}"
+#define EMACS_CONFIG_OPTIONS "${ac_configure_args}"
_ACEOF
+
XMENU_OBJ=
XOBJ=
FONT_OBJ=
$as_echo "#define HAVE_X_WINDOWS 1" >>confdefs.h
XMENU_OBJ=xmenu.o
- XOBJ="xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o fringe.o image.o xsettings.o xgselect.o"
+ XOBJ="xterm.o xfns.o xselect.o xrdb.o xsmfns.o xsettings.o xgselect.o"
FONT_OBJ=xfont.o
if test "$HAVE_XFT" = "yes"; then
FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o"
-# Configure gnulib here, now that we know LIBS.
+# Configure gnulib. Although this does not affect CFLAGS or LIBS permanently.
+# it temporarily reverts them to their pre-pkg-config values,
+# because gnulib needs to work with both src (which uses the
+# pkg-config stuff) and lib-src (which does not). For example, gnulib
+# may need to determine whether LIB_CLOCK_GETTIME should contain -lrt,
+# and it therefore needs to run in an environment where LIBS does not
+# already contain -lrt merely because 'pkg-config --libs' printed '-lrt'
+# for some package unrelated to lib-src.
+SAVE_CFLAGS=$CFLAGS
+SAVE_LIBS=$LIBS
+CFLAGS=$pre_PKG_CONFIG_CFLAGS
+LIBS="$LIB_PTHREAD $pre_PKG_CONFIG_LIBS"
$as_echo "#define C_ALLOCA 1" >>confdefs.h
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether \`alloca.c' needs Cray hooks" >&5
-$as_echo_n "checking whether \`alloca.c' needs Cray hooks... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether 'alloca.c' needs Cray hooks" >&5
+$as_echo_n "checking whether 'alloca.c' needs Cray hooks... " >&6; }
if test "${ac_cv_os_cray+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- for ac_func in $ac_func_list
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-eval as_val=\$$as_ac_var
- if test "x$as_val" = x""yes; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
-
-
-
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
if test "${ac_cv_c_bigendian+set}" = set; then :
GNULIB_GETPAGESIZE=0;
GNULIB_GETUSERSHELL=0;
GNULIB_GROUP_MEMBER=0;
+ GNULIB_ISATTY=0;
GNULIB_LCHOWN=0;
GNULIB_LINK=0;
GNULIB_LINKAT=0;
GNULIB_READLINK=0;
GNULIB_READLINKAT=0;
GNULIB_RMDIR=0;
+ GNULIB_SETHOSTNAME=0;
GNULIB_SLEEP=0;
GNULIB_SYMLINK=0;
GNULIB_SYMLINKAT=0;
GNULIB_TTYNAME_R=0;
- GNULIB_UNISTD_H_GETOPT=0;
GNULIB_UNISTD_H_NONBLOCKING=0;
GNULIB_UNISTD_H_SIGPIPE=0;
GNULIB_UNLINK=0;
HAVE_PWRITE=1;
HAVE_READLINK=1;
HAVE_READLINKAT=1;
+ HAVE_SETHOSTNAME=1;
HAVE_SLEEP=1;
HAVE_SYMLINK=1;
HAVE_SYMLINKAT=1;
HAVE_DECL_GETLOGIN_R=1;
HAVE_DECL_GETPAGESIZE=1;
HAVE_DECL_GETUSERSHELL=1;
+ HAVE_DECL_SETHOSTNAME=1;
HAVE_DECL_TTYNAME_R=1;
HAVE_OS_H=0;
HAVE_SYS_PARAM_H=0;
REPLACE_DUP=0;
REPLACE_DUP2=0;
REPLACE_FCHOWNAT=0;
+ REPLACE_FTRUNCATE=0;
REPLACE_GETCWD=0;
REPLACE_GETDOMAINNAME=0;
REPLACE_GETLOGIN_R=0;
REPLACE_GETGROUPS=0;
REPLACE_GETPAGESIZE=0;
+ REPLACE_ISATTY=0;
REPLACE_LCHOWN=0;
REPLACE_LINK=0;
REPLACE_LINKAT=0;
UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS=0;
+
+
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if environ is properly declared" >&5
+$as_echo_n "checking if environ is properly declared... " >&6; }
+ if test "${gt_cv_var_environ_declaration+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#if HAVE_UNISTD_H
+ #include <unistd.h>
+ #endif
+ /* mingw, BeOS, Haiku declare environ in <stdlib.h>, not in <unistd.h>. */
+ #include <stdlib.h>
+
+ extern struct { int foo; } environ;
+int
+main ()
+{
+environ.foo = 1;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gt_cv_var_environ_declaration=no
+else
+ gt_cv_var_environ_declaration=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_var_environ_declaration" >&5
+$as_echo "$gt_cv_var_environ_declaration" >&6; }
+ if test $gt_cv_var_environ_declaration = yes; then
+
+$as_echo "#define HAVE_ENVIRON_DECL 1" >>confdefs.h
+
+ fi
+
+
+ if test $gt_cv_var_environ_declaration != yes; then
+ 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 :
GNULIB_MKOSTEMPS=0;
GNULIB_MKSTEMP=0;
GNULIB_MKSTEMPS=0;
+ GNULIB_POSIX_OPENPT=0;
GNULIB_PTSNAME=0;
+ GNULIB_PTSNAME_R=0;
GNULIB_PUTENV=0;
+ GNULIB_RANDOM=0;
GNULIB_RANDOM_R=0;
GNULIB_REALLOC_POSIX=0;
GNULIB_REALPATH=0;
HAVE_MKOSTEMPS=1;
HAVE_MKSTEMP=1;
HAVE_MKSTEMPS=1;
+ HAVE_POSIX_OPENPT=1;
HAVE_PTSNAME=1;
+ HAVE_PTSNAME_R=1;
+ HAVE_RANDOM=1;
HAVE_RANDOM_H=1;
HAVE_RANDOM_R=1;
HAVE_REALPATH=1;
REPLACE_MALLOC=0;
REPLACE_MBTOWC=0;
REPLACE_MKSTEMP=0;
+ REPLACE_PTSNAME_R=0;
REPLACE_PUTENV=0;
+ REPLACE_RANDOM_R=0;
REPLACE_REALLOC=0;
REPLACE_REALPATH=0;
REPLACE_SETENV=0;
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'getopt.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'getopt.h\)".*|\1|
+ gl_header_literal_regex=`echo 'getopt.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
fi
- if test -z "$gl_replace_getopt"; then
+ if test -z "$gl_replace_getopt"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getopt is POSIX compatible" >&5
$as_echo_n "checking whether getopt is POSIX compatible... " >&6; }
if test "${gl_cv_func_getopt_posix+set}" = set; then :
$as_echo_n "(cached) " >&6
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ if test $cross_compiling = no; then
+ if test "$cross_compiling" = yes; then :
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot run test program while cross compiling
+See \`config.log' for more details." "$LINENO" 5; }
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+
#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
+
int
main ()
{
-int *p = &optreset; return optreset;
- ;
+ static char program[] = "program";
+ static char a[] = "-a";
+ static char foo[] = "foo";
+ static char bar[] = "bar";
+ char *argv[] = { program, a, foo, bar, NULL };
+ int c;
+
+ c = getopt (4, argv, "ab");
+ if (!(c == 'a'))
+ return 1;
+ c = getopt (4, argv, "ab");
+ if (!(c == -1))
+ return 2;
+ if (!(optind == 2))
+ return 3;
return 0;
}
+
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- gl_optind_min=1
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_getopt_posix=maybe
+else
+ gl_cv_func_getopt_posix=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+ if test $gl_cv_func_getopt_posix = maybe; then
+ if test "$cross_compiling" = yes; then :
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot run test program while cross compiling
+See \`config.log' for more details." "$LINENO" 5; }
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <getopt.h>
+
+#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
+
int
main ()
{
-return !getopt_clip;
- ;
+ static char program[] = "program";
+ static char donald[] = "donald";
+ static char p[] = "-p";
+ static char billy[] = "billy";
+ static char duck[] = "duck";
+ static char a[] = "-a";
+ static char bar[] = "bar";
+ char *argv[] = { program, donald, p, billy, duck, a, bar, NULL };
+ int c;
+
+ c = getopt (7, argv, "+abp:q:");
+ if (!(c == -1))
+ return 4;
+ if (!(strcmp (argv[0], "program") == 0))
+ return 5;
+ if (!(strcmp (argv[1], "donald") == 0))
+ return 6;
+ if (!(strcmp (argv[2], "-p") == 0))
+ return 7;
+ if (!(strcmp (argv[3], "billy") == 0))
+ return 8;
+ if (!(strcmp (argv[4], "duck") == 0))
+ return 9;
+ if (!(strcmp (argv[5], "-a") == 0))
+ return 10;
+ if (!(strcmp (argv[6], "bar") == 0))
+ return 11;
+ if (!(optind == 1))
+ return 12;
return 0;
}
+
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- gl_optind_min=1
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_getopt_posix=maybe
else
- gl_optind_min=0
+ gl_cv_func_getopt_posix=no
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- gl_save_CPPFLAGS=$CPPFLAGS
- CPPFLAGS="$CPPFLAGS -DOPTIND_MIN=$gl_optind_min"
- if test "$cross_compiling" = yes; then :
- case "$host_os" in
- mingw*) gl_cv_func_getopt_posix="guessing no";;
- darwin* | aix*) gl_cv_func_getopt_posix="guessing no";;
- *) gl_cv_func_getopt_posix="guessing yes";;
- esac
+ fi
+ if test $gl_cv_func_getopt_posix = maybe; then
+ if test "$cross_compiling" = yes; then :
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot run test program while cross compiling
+See \`config.log' for more details." "$LINENO" 5; }
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
- {
- static char program[] = "program";
- static char a[] = "-a";
- static char foo[] = "foo";
- static char bar[] = "bar";
- char *argv[] = { program, a, foo, bar, NULL };
- int c;
-
- optind = OPTIND_MIN;
- opterr = 0;
-
- c = getopt (4, argv, "ab");
- if (!(c == 'a'))
- return 1;
- c = getopt (4, argv, "ab");
- if (!(c == -1))
- return 2;
- if (!(optind == 2))
- return 3;
- }
- /* Some internal state exists at this point. */
- {
- static char program[] = "program";
- static char donald[] = "donald";
- static char p[] = "-p";
- static char billy[] = "billy";
- static char duck[] = "duck";
- static char a[] = "-a";
- static char bar[] = "bar";
- char *argv[] = { program, donald, p, billy, duck, a, bar, NULL };
- int c;
-
- optind = OPTIND_MIN;
- opterr = 0;
-
- c = getopt (7, argv, "+abp:q:");
- if (!(c == -1))
- return 4;
- if (!(strcmp (argv[0], "program") == 0))
- return 5;
- if (!(strcmp (argv[1], "donald") == 0))
- return 6;
- if (!(strcmp (argv[2], "-p") == 0))
- return 7;
- if (!(strcmp (argv[3], "billy") == 0))
- return 8;
- if (!(strcmp (argv[4], "duck") == 0))
- return 9;
- if (!(strcmp (argv[5], "-a") == 0))
- return 10;
- if (!(strcmp (argv[6], "bar") == 0))
- return 11;
- if (!(optind == 1))
- return 12;
- }
- /* Detect MacOS 10.5, AIX 7.1 bug. */
- {
- static char program[] = "program";
- static char ab[] = "-ab";
- char *argv[3] = { program, ab, NULL };
- optind = OPTIND_MIN;
- opterr = 0;
- if (getopt (2, argv, "ab:") != 'a')
- return 13;
- if (getopt (2, argv, "ab:") != '?')
- return 14;
- if (optopt != 'b')
- return 15;
- if (optind != 2)
- return 16;
- }
-
+ static char program[] = "program";
+ static char ab[] = "-ab";
+ char *argv[3] = { program, ab, NULL };
+ if (getopt (2, argv, "ab:") != 'a')
+ return 13;
+ if (getopt (2, argv, "ab:") != '?')
+ return 14;
+ if (optopt != 'b')
+ return 15;
+ if (optind != 2)
+ return 16;
return 0;
}
conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
- CPPFLAGS=$gl_save_CPPFLAGS
+ fi
+ else
+ case "$host_os" in
+ darwin* | aix* | mingw*) gl_cv_func_getopt_posix="guessing no";;
+ *) gl_cv_func_getopt_posix="guessing yes";;
+ esac
+ fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getopt_posix" >&5
POSIXLY_CORRECT=1
export POSIXLY_CORRECT
if test "$cross_compiling" = yes; then :
- case $host_os:$ac_cv_have_decl_optreset in
- *-gnu*:* | mingw*:*) gl_cv_func_getopt_gnu=no;;
- *:yes) gl_cv_func_getopt_gnu=no;;
- *) gl_cv_func_getopt_gnu=yes;;
- esac
+ gl_cv_func_getopt_gnu="guessing no"
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
#include <stdlib.h>
#if defined __MACH__ && defined __APPLE__
-/* Avoid a crash on MacOS X. */
+/* Avoid a crash on Mac OS X. */
#include <mach/mach.h>
#include <mach/mach_error.h>
#include <mach/thread_status.h>
nocrash_init();
/* This code succeeds on glibc 2.8, OpenBSD 4.0, Cygwin, mingw,
- and fails on MacOS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
+ and fails on Mac OS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
OSF/1 5.1, Solaris 10. */
{
static char conftest[] = "conftest";
result |= 1;
}
/* This code succeeds on glibc 2.8, mingw,
- and fails on MacOS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11,
+ and fails on Mac OS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11,
IRIX 6.5, OSF/1 5.1, Solaris 10, Cygwin 1.5.x. */
{
static char program[] = "program";
if (getopt (3, argv, "-p") != 1)
result |= 16;
else if (getopt (3, argv, "-p") != 'p')
- result |= 32;
+ result |= 16;
}
/* This code fails on glibc 2.11. */
{
char *argv[] = { program, b, a, NULL };
optind = opterr = 0;
if (getopt (3, argv, "+:a:b") != 'b')
- result |= 64;
+ result |= 32;
else if (getopt (3, argv, "+:a:b") != ':')
- result |= 64;
+ result |= 32;
}
/* This code dumps core on glibc 2.14. */
{
char *argv[] = { program, w, dummy, NULL };
optind = opterr = 1;
if (getopt (3, argv, "W;") != 'W')
- result |= 128;
+ result |= 64;
}
return result;
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getopt_gnu" >&5
$as_echo "$gl_cv_func_getopt_gnu" >&6; }
- if test "$gl_cv_func_getopt_gnu" = "no"; then
+ if test "$gl_cv_func_getopt_gnu" != yes; then
gl_replace_getopt=yes
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working GNU getopt_long function" >&5
+$as_echo_n "checking for working GNU getopt_long function... " >&6; }
+if test "${gl_cv_func_getopt_long_gnu+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in
+ openbsd*) gl_cv_func_getopt_long_gnu="guessing no";;
+ *) gl_cv_func_getopt_long_gnu="guessing yes";;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <getopt.h>
+ #include <stddef.h>
+ #include <string.h>
+
+int
+main ()
+{
+static const struct option long_options[] =
+ {
+ { "xtremely-",no_argument, NULL, 1003 },
+ { "xtra", no_argument, NULL, 1001 },
+ { "xtreme", no_argument, NULL, 1002 },
+ { "xtremely", no_argument, NULL, 1003 },
+ { NULL, 0, NULL, 0 }
+ };
+ /* This code fails on OpenBSD 5.0. */
+ {
+ static char program[] = "program";
+ static char xtremel[] = "--xtremel";
+ char *argv[] = { program, xtremel, NULL };
+ int option_index;
+ optind = 1; opterr = 0;
+ if (getopt_long (2, argv, "", long_options, &option_index) != 1003)
+ return 1;
+ }
+ return 0;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_getopt_long_gnu=yes
+else
+ gl_cv_func_getopt_long_gnu=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getopt_long_gnu" >&5
+$as_echo "$gl_cv_func_getopt_long_gnu" >&6; }
+ case "$gl_cv_func_getopt_long_gnu" in
+ *yes) ;;
+ *) gl_replace_getopt=yes ;;
+ esac
fi
fi
+
REPLACE_GETOPT=0
+ if test -n "$gl_replace_getopt"; then
+ REPLACE_GETOPT=1
+ fi
+
+ if test $REPLACE_GETOPT = 1; then
+
+ GETOPT_H=getopt.h
+
+$as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h
+
+
+
+ fi
+
+ac_fn_c_check_decl "$LINENO" "getenv" "ac_cv_have_decl_getenv" "$ac_includes_default"
+if test "x$ac_cv_have_decl_getenv" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_GETENV $ac_have_decl
+_ACEOF
+
+:
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C/C++ restrict keyword" >&5
+$as_echo_n "checking for C/C++ restrict keyword... " >&6; }
+if test "${ac_cv_c_restrict+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_cv_c_restrict=no
+ # The order here caters to the fact that C++ does not require restrict.
+ for ac_kw in __restrict __restrict__ _Restrict restrict; do
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+typedef int * int_ptr;
+ int foo (int_ptr $ac_kw ip) {
+ return ip[0];
+ }
+int
+main ()
+{
+int s[1];
+ int * $ac_kw t = s;
+ t[0] = 0;
+ return foo(t)
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_c_restrict=$ac_kw
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$ac_cv_c_restrict" != no && break
+ done
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_restrict" >&5
+$as_echo "$ac_cv_c_restrict" >&6; }
+
+ case $ac_cv_c_restrict in
+ restrict) ;;
+ no) $as_echo "#define restrict /**/" >>confdefs.h
+ ;;
+ *) cat >>confdefs.h <<_ACEOF
+#define restrict $ac_cv_c_restrict
+_ACEOF
+ ;;
+ esac
+
+
+ GNULIB_GETTIMEOFDAY=0;
+ HAVE_GETTIMEOFDAY=1;
+ HAVE_STRUCT_TIMEVAL=1;
+ HAVE_SYS_TIME_H=1;
+ REPLACE_GETTIMEOFDAY=0;
+ REPLACE_STRUCT_TIMEVAL=0;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_sys_time_h='<'sys/time.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <sys/time.h>" >&5
+$as_echo_n "checking absolute name of <sys/time.h>... " >&6; }
+if test "${gl_cv_next_sys_time_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ if test $ac_cv_header_sys_time_h = yes; then
+
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/time.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+
+ case "$host_os" in
+ mingw*)
+ gl_dirsep_regex='[/\\]'
+ ;;
+ *)
+ gl_dirsep_regex='\/'
+ ;;
+ esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
+
+ gl_header_literal_regex=`echo 'sys/time.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
+ s|^/[^/]|//&|
+ p
+ q
+ }'
+ gl_cv_next_sys_time_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n "$gl_absolute_header_sed"`'"'
+ else
+ gl_cv_next_sys_time_h='<'sys/time.h'>'
+ fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_time_h" >&5
+$as_echo "$gl_cv_next_sys_time_h" >&6; }
+ fi
+ NEXT_SYS_TIME_H=$gl_cv_next_sys_time_h
+
+ if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
+ gl_next_as_first_directive='<'sys/time.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_sys_time_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H=$gl_next_as_first_directive
+
+
+
+
+
+ if test $ac_cv_header_sys_time_h != yes; then
+ HAVE_SYS_TIME_H=0
+ fi
+
+
+
+
+
+ if test $ac_cv_header_sys_socket_h != yes; then
+ for ac_header in winsock2.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "winsock2.h" "ac_cv_header_winsock2_h" "$ac_includes_default"
+if test "x$ac_cv_header_winsock2_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_WINSOCK2_H 1
+_ACEOF
+
+fi
+
+done
+
+ fi
+ if test "$ac_cv_header_winsock2_h" = yes; then
+ HAVE_WINSOCK2_H=1
+ UNISTD_H_HAVE_WINSOCK2_H=1
+ SYS_IOCTL_H_HAVE_WINSOCK2_H=1
+ else
+ HAVE_WINSOCK2_H=0
+ fi
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timeval" >&5
+$as_echo_n "checking for struct timeval... " >&6; }
+if test "${gl_cv_sys_struct_timeval+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #if HAVE_WINSOCK2_H
+ # include <winsock2.h>
+ #endif
+int
+main ()
+{
+static struct timeval x; x.tv_sec = x.tv_usec;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_sys_struct_timeval=yes
+else
+ gl_cv_sys_struct_timeval=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- if test -n "$gl_replace_getopt"; then :
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_timeval" >&5
+$as_echo "$gl_cv_sys_struct_timeval" >&6; }
+ if test $gl_cv_sys_struct_timeval != yes; then
+ HAVE_STRUCT_TIMEVAL=0
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for wide-enough struct timeval.tv_sec member" >&5
+$as_echo_n "checking for wide-enough struct timeval.tv_sec member... " >&6; }
+if test "${gl_cv_sys_struct_timeval_tv_sec+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #if HAVE_WINSOCK2_H
+ # include <winsock2.h>
+ #endif
- REPLACE_GETOPT=1
+int
+main ()
+{
+static struct timeval x;
+ typedef int verify_tv_sec_type[
+ sizeof (time_t) <= sizeof x.tv_sec ? 1 : -1
+ ];
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_sys_struct_timeval_tv_sec=yes
+else
+ gl_cv_sys_struct_timeval_tv_sec=no
fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-
- if test $REPLACE_GETOPT = 1; then
-
- GETOPT_H=getopt.h
-
-$as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_timeval_tv_sec" >&5
+$as_echo "$gl_cv_sys_struct_timeval_tv_sec" >&6; }
+ if test $gl_cv_sys_struct_timeval_tv_sec != yes; then
+ REPLACE_STRUCT_TIMEVAL=1
+ fi
+ fi
- GNULIB_UNISTD_H_GETOPT=1
- fi
-ac_fn_c_check_decl "$LINENO" "getenv" "ac_cv_have_decl_getenv" "$ac_includes_default"
-if test "x$ac_cv_have_decl_getenv" = x""yes; then :
- ac_have_decl=1
-else
- ac_have_decl=0
-fi
-cat >>confdefs.h <<_ACEOF
-#define HAVE_DECL_GETENV $ac_have_decl
-_ACEOF
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsigned long long int" >&5
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stdint.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stdint.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stdint.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
/* end confdefs.h. */
-#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
-#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
#include <stdint.h>
/* Dragonfly defines WCHAR_MIN, WCHAR_MAX only in <wchar.h>. */
/* end confdefs.h. */
-#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
-#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
#include <stdint.h>
HAVE_DECL_IMAXDIV=1;
HAVE_DECL_STRTOIMAX=1;
HAVE_DECL_STRTOUMAX=1;
+ REPLACE_STRTOIMAX=0;
INT32_MAX_LT_INTMAX_MAX=1;
INT64_MAX_EQ_LONG_MAX='defined _LP64';
PRI_MACROS_BROKEN=0;
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'inttypes.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'inttypes.h\)".*|\1|
+ gl_header_literal_regex=`echo 'inttypes.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
-$as_echo "#define GL_TRIGGER_STDC_LIMIT_MACROS 1" >>confdefs.h
+ case "$host_os" in
+ mingw*)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit off_t" >&5
+$as_echo_n "checking for 64-bit off_t... " >&6; }
+if test "${gl_cv_type_off_t_64+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/types.h>
+ int verify_off_t_size[sizeof (off_t) >= 8 ? 1 : -1];
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_type_off_t_64=yes
+else
+ gl_cv_type_off_t_64=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_type_off_t_64" >&5
+$as_echo "$gl_cv_type_off_t_64" >&6; }
+ if test $gl_cv_type_off_t_64 = no; then
+ WINDOWS_64_BIT_OFF_T=1
+ else
+ WINDOWS_64_BIT_OFF_T=0
+ fi
+ WINDOWS_64_BIT_ST_SIZE=1
+ ;;
+ *)
+ WINDOWS_64_BIT_OFF_T=0
+ WINDOWS_64_BIT_ST_SIZE=0
+ ;;
+ esac
GNULIB_FCHMODAT=0;
echo >conftest.file
if test "$as_ln_s" = "ln -s" && ln -s conftest.file conftest.sym; then
if test "$cross_compiling" = yes; then :
- # When cross-compiling, be pessimistic so we will end up using the
- # replacement version of lstat that checks for trailing slashes and
- # calls lstat a second time when necessary.
- gl_cv_func_lstat_dereferences_slashed_symlink=no
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;;
+ esac
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
else
# If the 'ln -s' command failed, then we probably don't even
# have an lstat function.
- gl_cv_func_lstat_dereferences_slashed_symlink=no
+ gl_cv_func_lstat_dereferences_slashed_symlink="guessing no"
fi
rm -f conftest.sym conftest.file
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_lstat_dereferences_slashed_symlink" >&5
$as_echo "$gl_cv_func_lstat_dereferences_slashed_symlink" >&6; }
- test $gl_cv_func_lstat_dereferences_slashed_symlink = yes &&
+ case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ *yes)
cat >>confdefs.h <<_ACEOF
#define LSTAT_FOLLOWS_SLASHED_SYMLINK 1
_ACEOF
+ ;;
+ esac
GNULIB_MKTIME=0;
+ GNULIB_PSELECT=0;
+ GNULIB_SELECT=0;
+ HAVE_PSELECT=1;
+ REPLACE_PSELECT=0;
+ REPLACE_SELECT=0;
+
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether <sys/select.h> is self-contained" >&5
+$as_echo_n "checking whether <sys/select.h> is self-contained... " >&6; }
+if test "${gl_cv_header_sys_select_h_selfcontained+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+struct timeval b;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_header_sys_select_h_selfcontained=yes
+else
+ gl_cv_header_sys_select_h_selfcontained=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ if test $gl_cv_header_sys_select_h_selfcontained = yes; then
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+int memset; int bzero;
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+
+ #undef memset
+ #define memset nonexistent_memset
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void *memset (void *, int, unsigned long);
+ #undef bzero
+ #define bzero nonexistent_bzero
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void bzero (void *, unsigned long);
+ fd_set fds;
+ FD_ZERO (&fds);
+
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+else
+ gl_cv_header_sys_select_h_selfcontained=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_sys_select_h_selfcontained" >&5
+$as_echo "$gl_cv_header_sys_select_h_selfcontained" >&6; }
+
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_sys_select_h='<'sys/select.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <sys/select.h>" >&5
+$as_echo_n "checking absolute name of <sys/select.h>... " >&6; }
+if test "${gl_cv_next_sys_select_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ if test $ac_cv_header_sys_select_h = yes; then
+
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+
+ case "$host_os" in
+ mingw*)
+ gl_dirsep_regex='[/\\]'
+ ;;
+ *)
+ gl_dirsep_regex='\/'
+ ;;
+ esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
+
+ gl_header_literal_regex=`echo 'sys/select.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
+ s|^/[^/]|//&|
+ p
+ q
+ }'
+ gl_cv_next_sys_select_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n "$gl_absolute_header_sed"`'"'
+ else
+ gl_cv_next_sys_select_h='<'sys/select.h'>'
+ fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_select_h" >&5
+$as_echo "$gl_cv_next_sys_select_h" >&6; }
+ fi
+ NEXT_SYS_SELECT_H=$gl_cv_next_sys_select_h
+
+ if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
+ gl_next_as_first_directive='<'sys/select.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_sys_select_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H=$gl_next_as_first_directive
+
+
+
+
+ if test $ac_cv_header_sys_select_h = yes; then
+ HAVE_SYS_SELECT_H=1
+ else
+ HAVE_SYS_SELECT_H=0
+ fi
+
+
+
+
+
+ if test $ac_cv_header_sys_socket_h != yes; then
+ for ac_header in winsock2.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "winsock2.h" "ac_cv_header_winsock2_h" "$ac_includes_default"
+if test "x$ac_cv_header_winsock2_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_WINSOCK2_H 1
+_ACEOF
+
+fi
+
+done
+
+ fi
+ if test "$ac_cv_header_winsock2_h" = yes; then
+ HAVE_WINSOCK2_H=1
+ UNISTD_H_HAVE_WINSOCK2_H=1
+ SYS_IOCTL_H_HAVE_WINSOCK2_H=1
+ else
+ HAVE_WINSOCK2_H=0
+ fi
+
+
+
+
+
+
GNULIB_PTHREAD_SIGMASK=0;
+
+
+
ac_fn_c_check_type "$LINENO" "sigset_t" "ac_cv_type_sigset_t" "
#include <signal.h>
/* Mingw defines sigset_t not in <signal.h>, but in <sys/types.h>. */
-
-
if test $ac_cv_header_sys_socket_h = no; then
for ac_header in ws2tcpip.h
do :
-
-
ac_fn_c_check_decl "$LINENO" "strtoimax" "ac_cv_have_decl_strtoimax" "$ac_includes_default"
if test "x$ac_cv_have_decl_strtoimax" = x""yes; then :
ac_have_decl=1
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stat_broken" >&5
-$as_echo "$ac_cv_header_stat_broken" >&6; }
-if test $ac_cv_header_stat_broken = yes; then
-
-$as_echo "#define STAT_MACROS_BROKEN 1" >>confdefs.h
-
-fi
-
-
-
-ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default"
-if test "x$ac_cv_type_mode_t" = x""yes; then :
-
-else
-
-cat >>confdefs.h <<_ACEOF
-#define mode_t int
-_ACEOF
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C/C++ restrict keyword" >&5
-$as_echo_n "checking for C/C++ restrict keyword... " >&6; }
-if test "${ac_cv_c_restrict+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- ac_cv_c_restrict=no
- # The order here caters to the fact that C++ does not require restrict.
- for ac_kw in __restrict __restrict__ _Restrict restrict; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-typedef int * int_ptr;
- int foo (int_ptr $ac_kw ip) {
- return ip[0];
- }
-int
-main ()
-{
-int s[1];
- int * $ac_kw t = s;
- t[0] = 0;
- return foo(t)
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_restrict=$ac_kw
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- test "$ac_cv_c_restrict" != no && break
- done
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stat_broken" >&5
+$as_echo "$ac_cv_header_stat_broken" >&6; }
+if test $ac_cv_header_stat_broken = yes; then
+
+$as_echo "#define STAT_MACROS_BROKEN 1" >>confdefs.h
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_restrict" >&5
-$as_echo "$ac_cv_c_restrict" >&6; }
- case $ac_cv_c_restrict in
- restrict) ;;
- no) $as_echo "#define restrict /**/" >>confdefs.h
- ;;
- *) cat >>confdefs.h <<_ACEOF
-#define restrict $ac_cv_c_restrict
-_ACEOF
- ;;
- esac
+ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default"
+if test "x$ac_cv_type_mode_t" = x""yes; then :
+
+else
+
+cat >>confdefs.h <<_ACEOF
+#define mode_t int
+_ACEOF
+
+fi
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'time.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'time.h\)".*|\1|
+ gl_header_literal_regex=`echo 'time.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
-ac_fn_c_check_decl "$LINENO" "localtime_r" "ac_cv_have_decl_localtime_r" "$ac_includes_default"
-if test "x$ac_cv_have_decl_localtime_r" = x""yes; then :
- ac_have_decl=1
+
+
+
+
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the utimes function works" >&5
+$as_echo_n "checking whether the utimes function works... " >&6; }
+if test "${gl_cv_func_working_utimes+set}" = set; then :
+ $as_echo_n "(cached) " >&6
else
- ac_have_decl=0
+
+ if test "$cross_compiling" = yes; then :
+ gl_cv_func_working_utimes=no
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <sys/time.h>
+#include <time.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <utime.h>
+
+static int
+inorder (time_t a, time_t b, time_t c)
+{
+ return a <= b && b <= c;
+}
+
+int
+main ()
+{
+ int result = 0;
+ char const *file = "conftest.utimes";
+ static struct timeval timeval[2] = {{9, 10}, {999999, 999999}};
+
+ /* Test whether utimes() essentially works. */
+ {
+ struct stat sbuf;
+ FILE *f = fopen (file, "w");
+ if (f == NULL)
+ result |= 1;
+ else if (fclose (f) != 0)
+ result |= 1;
+ else if (utimes (file, timeval) != 0)
+ result |= 2;
+ else if (lstat (file, &sbuf) != 0)
+ result |= 1;
+ else if (!(sbuf.st_atime == timeval[0].tv_sec
+ && sbuf.st_mtime == timeval[1].tv_sec))
+ result |= 4;
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ /* Test whether utimes() with a NULL argument sets the file's timestamp
+ to the current time. Use 'fstat' as well as 'time' to
+ determine the "current" time, to accommodate NFS file systems
+ if there is a time skew between the host and the NFS server. */
+ {
+ int fd = open (file, O_WRONLY|O_CREAT, 0644);
+ if (fd < 0)
+ result |= 1;
+ else
+ {
+ time_t t0, t2;
+ struct stat st0, st1, st2;
+ if (time (&t0) == (time_t) -1)
+ result |= 1;
+ else if (fstat (fd, &st0) != 0)
+ result |= 1;
+ else if (utimes (file, timeval) != 0)
+ result |= 2;
+ else if (utimes (file, NULL) != 0)
+ result |= 8;
+ else if (fstat (fd, &st1) != 0)
+ result |= 1;
+ else if (write (fd, "\n", 1) != 1)
+ result |= 1;
+ else if (fstat (fd, &st2) != 0)
+ result |= 1;
+ else if (time (&t2) == (time_t) -1)
+ result |= 1;
+ else
+ {
+ int m_ok_POSIX = inorder (t0, st1.st_mtime, t2);
+ int m_ok_NFS = inorder (st0.st_mtime, st1.st_mtime, st2.st_mtime);
+ if (! (st1.st_atime == st1.st_mtime))
+ result |= 16;
+ if (! (m_ok_POSIX || m_ok_NFS))
+ result |= 32;
+ }
+ if (close (fd) != 0)
+ result |= 1;
+ }
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ /* Test whether utimes() with a NULL argument works on read-only files. */
+ {
+ int fd = open (file, O_WRONLY|O_CREAT, 0444);
+ if (fd < 0)
+ result |= 1;
+ else if (close (fd) != 0)
+ result |= 1;
+ else if (utimes (file, NULL) != 0)
+ result |= 64;
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ return result;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_working_utimes=yes
+else
+ gl_cv_func_working_utimes=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
-cat >>confdefs.h <<_ACEOF
-#define HAVE_DECL_LOCALTIME_R $ac_have_decl
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_working_utimes" >&5
+$as_echo "$gl_cv_func_working_utimes" >&6; }
+
+ if test $gl_cv_func_working_utimes = yes; then
+
+$as_echo "#define HAVE_WORKING_UTIMES 1" >>confdefs.h
+
+ fi
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct utimbuf" >&5
+$as_echo_n "checking for struct utimbuf... " >&6; }
+if test "${gl_cv_sys_struct_utimbuf+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #ifdef HAVE_UTIME_H
+ #include <utime.h>
+ #endif
+
+int
+main ()
+{
+static struct utimbuf x; x.actime = x.modtime;
+ ;
+ return 0;
+}
_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_sys_struct_utimbuf=yes
+else
+ gl_cv_sys_struct_utimbuf=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sys_struct_utimbuf" >&5
+$as_echo "$gl_cv_sys_struct_utimbuf" >&6; }
+
+ if test $gl_cv_sys_struct_utimbuf = yes; then
+
+$as_echo "#define HAVE_STRUCT_UTIMBUF 1" >>confdefs.h
+
+ fi
+
+
+
+
+
+
+
+
+ # Solaris 2.5.1 needs -lposix4 to get the clock_gettime function.
+ # Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4.
+
+ # Save and restore LIBS so e.g., -lrt, isn't added to it. Otherwise, *all*
+ # programs in the package would end up linked with that potentially-shared
+ # library, inducing unnecessary run-time overhead.
+ LIB_CLOCK_GETTIME=
+
+ gl_saved_libs=$LIBS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing clock_gettime" >&5
+$as_echo_n "checking for library containing clock_gettime... " >&6; }
+if test "${ac_cv_search_clock_gettime+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char clock_gettime ();
+int
+main ()
+{
+return clock_gettime ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' rt posix4; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_clock_gettime=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if test "${ac_cv_search_clock_gettime+set}" = set; then :
+ break
+fi
+done
+if test "${ac_cv_search_clock_gettime+set}" = set; then :
+
+else
+ ac_cv_search_clock_gettime=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_clock_gettime" >&5
+$as_echo "$ac_cv_search_clock_gettime" >&6; }
+ac_res=$ac_cv_search_clock_gettime
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ test "$ac_cv_search_clock_gettime" = "none required" ||
+ LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime
+fi
+
+ for ac_func in clock_gettime clock_settime
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+ LIBS=$gl_saved_libs
+
+
+
+
:
if test "$cross_compiling" = yes; then :
case "$host_os" in
mingw*) # on this platform, dup2 always returns 0 for success
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
linux*) # On linux between 2008-07-27 and 2009-05-11, dup2 of a
# closed fd may yield -EBADF instead of -1 / errno=EBADF.
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF.
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
- gl_cv_func_dup2_works=no;;
- *) gl_cv_func_dup2_works=yes;;
+ gl_cv_func_dup2_works="guessing no" ;;
+ *) gl_cv_func_dup2_works="guessing yes" ;;
esac
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
;
return 0;
}
-
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_dup2_works=yes
+else
+ gl_cv_func_dup2_works=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_dup2_works" >&5
+$as_echo "$gl_cv_func_dup2_works" >&6; }
+ case "$gl_cv_func_dup2_works" in
+ *yes) ;;
+ *)
+ REPLACE_DUP2=1
+ ;;
+ esac
+ fi
+
+
+ if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS dup2.$ac_objext"
+
+
+ fi
+
+
+
+
+
+ GNULIB_DUP2=1
+
+
+
+
+
+
+
+
+
+
+
+ GNULIB_ENVIRON=1
+
+
+
+
+
+
+
+
+ LIB_EXECINFO=''
+ EXECINFO_H='execinfo.h'
+
+ if test $ac_cv_header_execinfo_h = yes; then
+ gl_saved_libs=$LIBS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing backtrace_symbols_fd" >&5
+$as_echo_n "checking for library containing backtrace_symbols_fd... " >&6; }
+if test "${ac_cv_search_backtrace_symbols_fd+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char backtrace_symbols_fd ();
+int
+main ()
+{
+return backtrace_symbols_fd ();
+ ;
+ return 0;
+}
_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- gl_cv_func_dup2_works=yes
-else
- gl_cv_func_dup2_works=no
+for ac_lib in '' execinfo; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_backtrace_symbols_fd=$ac_res
fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if test "${ac_cv_search_backtrace_symbols_fd+set}" = set; then :
+ break
fi
+done
+if test "${ac_cv_search_backtrace_symbols_fd+set}" = set; then :
-
+else
+ ac_cv_search_backtrace_symbols_fd=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_backtrace_symbols_fd" >&5
+$as_echo "$ac_cv_search_backtrace_symbols_fd" >&6; }
+ac_res=$ac_cv_search_backtrace_symbols_fd
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ test "$ac_cv_search_backtrace_symbols_fd" = "none required" ||
+ LIB_EXECINFO=$ac_cv_search_backtrace_symbols_fd
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_dup2_works" >&5
-$as_echo "$gl_cv_func_dup2_works" >&6; }
- if test "$gl_cv_func_dup2_works" = no; then
- REPLACE_DUP2=1
- fi
- fi
-
-
-if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
-
-
-
+ LIBS=$gl_saved_libs
+ test "$ac_cv_search_backtrace_symbols_fd" = no || EXECINFO_H=''
+ fi
+ if test -n "$EXECINFO_H"; then
- gl_LIBOBJS="$gl_LIBOBJS dup2.$ac_objext"
-fi
+ gl_LIBOBJS="$gl_LIBOBJS execinfo.$ac_objext"
+ fi
- GNULIB_DUP2=1
+ if test -n "$EXECINFO_H"; then
+ GL_GENERATE_EXECINFO_H_TRUE=
+ GL_GENERATE_EXECINFO_H_FALSE='#'
+else
+ GL_GENERATE_EXECINFO_H_TRUE='#'
+ GL_GENERATE_EXECINFO_H_FALSE=
+fi
gl_save_LIBS=$LIBS
-# getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0,
+# getloadvg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0,
# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7.
HAVE_GETLOADAVG=1
ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg"
fi
-if test $HAVE_GETLOADAVG = 0; then
+ if test $HAVE_GETLOADAVG = 0; then
# Figure out what our getloadavg.c needs.
+
+
# On HPUX9, an unprivileged user can get load averages this way.
if test $gl_func_getloadavg_done = no; then
for ac_func in pstat_getdynamic
done
-fi
+ fi
-if test $REPLACE_GETOPT = 1; then
+ if test $REPLACE_GETOPT = 1; then
-fi
-
+ GNULIB_GL_UNISTD_H_GETOPT=1
+ fi
- REPLACE_GETOPT=0
- if test -n "$gl_replace_getopt"; then :
+ REPLACE_GETOPT=0
+ if test -n "$gl_replace_getopt"; then
REPLACE_GETOPT=1
-
-fi
-
+ fi
if test $REPLACE_GETOPT = 1; then
- GNULIB_UNISTD_H_GETOPT=1
fi
-if test $REPLACE_GETOPT = 1; then
+ if test $REPLACE_GETOPT = 1; then
+ GNULIB_GL_UNISTD_H_GETOPT=1
+ fi
+
+
+
+
+
+
+
+
+
+
+
+
+ gl_gettimeofday_timezone=void
+ if test $ac_cv_func_gettimeofday != yes; then
+ HAVE_GETTIMEOFDAY=0
+ else
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gettimeofday clobbers localtime buffer" >&5
+$as_echo_n "checking whether gettimeofday clobbers localtime buffer... " >&6; }
+if test "${gl_cv_func_gettimeofday_clobber+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ # When cross-compiling:
+ case "$host_os" in
+ # Guess all is fine on glibc systems.
+ *-gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_gettimeofday_clobber="guessing yes" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <string.h>
+ #include <sys/time.h>
+ #include <time.h>
+ #include <stdlib.h>
+
+int
+main ()
+{
+
+ time_t t = 0;
+ struct tm *lt;
+ struct tm saved_lt;
+ struct timeval tv;
+ lt = localtime (&t);
+ saved_lt = *lt;
+ gettimeofday (&tv, NULL);
+ return memcmp (lt, &saved_lt, sizeof (struct tm)) != 0;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_gettimeofday_clobber=no
+else
+ gl_cv_func_gettimeofday_clobber=yes
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_gettimeofday_clobber" >&5
+$as_echo "$gl_cv_func_gettimeofday_clobber" >&6; }
+ case "$gl_cv_func_gettimeofday_clobber" in
+ *yes)
+ REPLACE_GETTIMEOFDAY=1
+$as_echo "#define gmtime rpl_gmtime" >>confdefs.h
- if test $ac_cv_func_lstat = yes; then
+$as_echo "#define localtime rpl_localtime" >>confdefs.h
- if test $gl_cv_func_lstat_dereferences_slashed_symlink = no; then
- REPLACE_LSTAT=1
+
+
+$as_echo "#define GETTIMEOFDAY_CLOBBERS_LOCALTIME 1" >>confdefs.h
+
+ ;;
+ esac
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gettimeofday with POSIX signature" >&5
+$as_echo_n "checking for gettimeofday with POSIX signature... " >&6; }
+if test "${gl_cv_func_gettimeofday_posix_signature+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/time.h>
+ struct timeval c;
+ int gettimeofday (struct timeval *restrict, void *restrict);
+
+int
+main ()
+{
+/* glibc uses struct timezone * rather than the POSIX void *
+ if _GNU_SOURCE is defined. However, since the only portable
+ use of gettimeofday uses NULL as the second parameter, and
+ since the glibc definition is actually more typesafe, it is
+ not worth wrapping this to get a compliant signature. */
+ int (*f) (struct timeval *restrict, void *restrict)
+ = gettimeofday;
+ int x = f (&c, 0);
+ return !(x | c.tv_sec | c.tv_usec);
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_func_gettimeofday_posix_signature=yes
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/time.h>
+int gettimeofday (struct timeval *restrict, struct timezone *restrict);
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_func_gettimeofday_posix_signature=almost
+else
+ gl_cv_func_gettimeofday_posix_signature=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_gettimeofday_posix_signature" >&5
+$as_echo "$gl_cv_func_gettimeofday_posix_signature" >&6; }
+ if test $gl_cv_func_gettimeofday_posix_signature = almost; then
+ gl_gettimeofday_timezone='struct timezone'
+ elif test $gl_cv_func_gettimeofday_posix_signature != yes; then
+ REPLACE_GETTIMEOFDAY=1
+ fi
+ if test $REPLACE_STRUCT_TIMEVAL = 1; then
+ REPLACE_GETTIMEOFDAY=1
fi
+
+ fi
+
+cat >>confdefs.h <<_ACEOF
+#define GETTIMEOFDAY_TIMEZONE $gl_gettimeofday_timezone
+_ACEOF
+
+
+ if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS gettimeofday.$ac_objext"
+
+
+ for ac_header in sys/timeb.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/timeb.h" "ac_cv_header_sys_timeb_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_timeb_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_SYS_TIMEB_H 1
+_ACEOF
+
+fi
+
+done
+
+ for ac_func in _ftime
+do :
+ ac_fn_c_check_func "$LINENO" "_ftime" "ac_cv_func__ftime"
+if test "x$ac_cv_func__ftime" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE__FTIME 1
+_ACEOF
+
+fi
+done
+
+
+ fi
+
+
+
+
+
+ GNULIB_GETTIMEOFDAY=1
+
+
+
+
+
+
+
+
+
+
+ if test $ac_cv_func_lstat = yes; then
+
+ case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ *no)
+ REPLACE_LSTAT=1
+ ;;
+ esac
else
HAVE_LSTAT=0
fi
-if test $REPLACE_LSTAT = 1; then
+ if test $REPLACE_LSTAT = 1; then
:
-fi
+ fi
if test $APPLE_UNIVERSAL_BUILD = 1; then
- # A universal build on Apple MacOS X platforms.
+ # A universal build on Apple Mac OS X platforms.
# The test result would be 'yes' in 32-bit mode and 'no' in 64-bit mode.
# But we need a configuration result that is valid in both modes.
gl_cv_func_working_mktime=no
if (tz_strings[i])
putenv (tz_strings[i]);
- for (t = 0; t <= time_t_max - delta; t += delta)
+ for (t = 0; t <= time_t_max - delta && (result & 1) == 0; t += delta)
if (! mktime_test (t))
result |= 1;
- if (! (mktime_test ((time_t) 1)
- && mktime_test ((time_t) (60 * 60))
- && mktime_test ((time_t) (60 * 60 * 24))))
+ if ((result & 2) == 0
+ && ! (mktime_test ((time_t) 1)
+ && mktime_test ((time_t) (60 * 60))
+ && mktime_test ((time_t) (60 * 60 * 24))))
result |= 2;
- for (j = 1; ; j <<= 1)
- if (! bigtime_test (j))
- result |= 4;
- else if (INT_MAX / 2 < j)
- break;
- if (! bigtime_test (INT_MAX))
- result |= 8;
- }
- if (! irix_6_4_bug ())
- result |= 16;
- if (! spring_forward_gap ())
- result |= 32;
- if (! year_2050_test ())
- result |= 64;
- return result;
+ for (j = 1; (result & 4) == 0; j <<= 1)
+ {
+ if (! bigtime_test (j))
+ result |= 4;
+ if (INT_MAX / 2 < j)
+ break;
+ }
+ if ((result & 8) == 0 && ! bigtime_test (INT_MAX))
+ result |= 8;
+ }
+ if (! irix_6_4_bug ())
+ result |= 16;
+ if (! spring_forward_gap ())
+ result |= 32;
+ if (! year_2050_test ())
+ result |= 64;
+ return result;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_working_mktime=yes
+else
+ gl_cv_func_working_mktime=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_working_mktime" >&5
+$as_echo "$gl_cv_func_working_mktime" >&6; }
+
+ if test $gl_cv_func_working_mktime = no; then
+ REPLACE_MKTIME=1
+ else
+ REPLACE_MKTIME=0
+ fi
+
+ if test $REPLACE_MKTIME = 1; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS mktime.$ac_objext"
+
+ :
+ fi
+
+
+
+
+
+ GNULIB_MKTIME=1
+
+
+
+
+
+
+
+
+
+
+
+ if test $ac_cv_func_pselect = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether signature of pselect conforms to POSIX" >&5
+$as_echo_n "checking whether signature of pselect conforms to POSIX... " >&6; }
+if test "${gl_cv_sig_pselect+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+
+int
+main ()
+{
+int (*p) (int, fd_set *, fd_set *, fd_set *restrict,
+ struct timespec const *restrict,
+ sigset_t const *restrict) = pselect;
+ return !p;
+ ;
+ return 0;
}
_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- gl_cv_func_working_mktime=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ gl_cv_sig_pselect=yes
else
- gl_cv_func_working_mktime=no
+ gl_cv_sig_pselect=no
fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_sig_pselect" >&5
+$as_echo "$gl_cv_sig_pselect" >&6; }
+ fi
+ if test $ac_cv_func_pselect = no || test $gl_cv_sig_pselect = no; then
+ REPLACE_PSELECT=1
+ fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_working_mktime" >&5
-$as_echo "$gl_cv_func_working_mktime" >&6; }
+ if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then
- if test $gl_cv_func_working_mktime = no; then
- REPLACE_MKTIME=1
- else
- REPLACE_MKTIME=0
- fi
-if test $REPLACE_MKTIME = 1; then
+ gl_LIBOBJS="$gl_LIBOBJS pselect.$ac_objext"
+ fi
- gl_LIBOBJS="$gl_LIBOBJS mktime.$ac_objext"
-fi
+ GNULIB_PSELECT=1
- GNULIB_MKTIME=1
+ LIB_PTHREAD_SIGMASK=
- LIB_PTHREAD_SIGMASK=
+ if test "$gl_threads_api" = posix; then
+ if test $ac_cv_func_pthread_sigmask = yes; then
+ :
+ else
+ if test -n "$LIBMULTITHREAD"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_sigmask in $LIBMULTITHREAD" >&5
+$as_echo_n "checking for pthread_sigmask in $LIBMULTITHREAD... " >&6; }
+if test "${gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ gl_save_LIBS="$LIBS"
+ LIBS="$LIBS $LIBMULTITHREAD"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <pthread.h>
+ #include <signal.h>
+int
+main ()
+{
+return pthread_sigmask (0, (sigset_t *) 0, (sigset_t *) 0);
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=yes
+else
+ gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ LIBS="$gl_save_LIBS"
- if test $ac_cv_func_pthread_sigmask = yes; then
- :
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD" >&5
+$as_echo "$gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD" >&6; }
+ if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then
+ LIB_PTHREAD_SIGMASK="$LIBMULTITHREAD"
+ else
+ HAVE_PTHREAD_SIGMASK=0
+ fi
+ else
+ HAVE_PTHREAD_SIGMASK=0
+ fi
+ fi
else
- HAVE_PTHREAD_SIGMASK=0
- REPLACE_PTHREAD_SIGMASK=1
+ if test $ac_cv_func_pthread_sigmask = yes; then
+ REPLACE_PTHREAD_SIGMASK=1
+ else
+ HAVE_PTHREAD_SIGMASK=0
+ fi
fi
esac
fi
-if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
+ if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
fi
-fi
+ fi
ln -s conftest.no-such conftest.link
ln -s conftest.link conftest.lnk2
if test "$cross_compiling" = yes; then :
- gl_cv_func_readlink_works="guessing no"
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_readlink_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_readlink_works="guessing no" ;;
+ esac
+
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_readlink_works" >&5
$as_echo "$gl_cv_func_readlink_works" >&6; }
- if test "$gl_cv_func_readlink_works" != yes; then
+ case "$gl_cv_func_readlink_works" in
+ *yes)
+ if test "$gl_cv_decl_readlink_works" != yes; then
+ REPLACE_READLINK=1
+ fi
+ ;;
+ *)
$as_echo "#define READLINK_TRAILING_SLASH_BUG 1" >>confdefs.h
- REPLACE_READLINK=1
- elif test "$gl_cv_decl_readlink_works" != yes; then
- REPLACE_READLINK=1
- fi
+ REPLACE_READLINK=1
+ ;;
+ esac
fi
-if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
+ if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
:
-fi
+ fi
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'signal.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'signal.h\)".*|\1|
+ gl_header_literal_regex=`echo 'signal.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
"
if test "x$ac_cv_type_volatile_sig_atomic_t" = x""yes; then :
-else
- HAVE_TYPE_VOLATILE_SIG_ATOMIC_T=0
+else
+ HAVE_TYPE_VOLATILE_SIG_ATOMIC_T=0
+fi
+
+
+
+
+
+
+
+ ac_fn_c_check_type "$LINENO" "sighandler_t" "ac_cv_type_sighandler_t" "
+#include <signal.h>
+
+"
+if test "x$ac_cv_type_sighandler_t" = x""yes; then :
+
+else
+ HAVE_SIGHANDLER_T=0
+fi
+
+
+
+
+ ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "
+/* <sys/types.h> is not needed according to POSIX, but the
+ <sys/socket.h> in i386-unknown-freebsd4.10 and
+ powerpc-apple-darwin5.5 required it. */
+#include <sys/types.h>
+#if HAVE_SYS_SOCKET_H
+# include <sys/socket.h>
+#elif HAVE_WS2TCPIP_H
+# include <ws2tcpip.h>
+#endif
+
+"
+if test "x$ac_cv_type_socklen_t" = x""yes; then :
+
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for socklen_t equivalent" >&5
+$as_echo_n "checking for socklen_t equivalent... " >&6; }
+ if test "${gl_cv_socklen_t_equiv+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ # Systems have either "struct sockaddr *" or
+ # "void *" as the second argument to getpeername
+ gl_cv_socklen_t_equiv=
+ for arg2 in "struct sockaddr" void; do
+ for t in int size_t "unsigned int" "long int" "unsigned long int"; do
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/types.h>
+ #include <sys/socket.h>
+
+ int getpeername (int, $arg2 *, $t *);
+int
+main ()
+{
+$t len;
+ getpeername (0, 0, &len);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_socklen_t_equiv="$t"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$gl_cv_socklen_t_equiv" != "" && break
+ done
+ test "$gl_cv_socklen_t_equiv" != "" && break
+ done
+
+fi
+
+ if test "$gl_cv_socklen_t_equiv" = ""; then
+ as_fn_error "Cannot find a type to use in place of socklen_t" "$LINENO" 5
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_socklen_t_equiv" >&5
+$as_echo "$gl_cv_socklen_t_equiv" >&6; }
+
+cat >>confdefs.h <<_ACEOF
+#define socklen_t $gl_cv_socklen_t_equiv
+_ACEOF
+
+fi
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ssize_t" >&5
+$as_echo_n "checking for ssize_t... " >&6; }
+if test "${gt_cv_ssize_t+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/types.h>
+int
+main ()
+{
+int x = sizeof (ssize_t *) + sizeof (ssize_t);
+ return !x;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gt_cv_ssize_t=yes
+else
+ gt_cv_ssize_t=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_ssize_t" >&5
+$as_echo "$gt_cv_ssize_t" >&6; }
+ if test $gt_cv_ssize_t = no; then
+
+$as_echo "#define ssize_t int" >>confdefs.h
+
+ fi
+
+
+
+
+
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.tv_nsec" "ac_cv_member_struct_stat_st_atim_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_atim_tv_nsec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC 1
+_ACEOF
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct stat.st_atim is of type struct timespec" >&5
+$as_echo_n "checking whether struct stat.st_atim is of type struct timespec... " >&6; }
+if test "${ac_cv_typeof_struct_stat_st_atim_is_struct_timespec+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ #include <sys/types.h>
+ #include <sys/stat.h>
+ #if HAVE_SYS_TIME_H
+ # include <sys/time.h>
+ #endif
+ #include <time.h>
+ struct timespec ts;
+ struct stat st;
+
+int
+main ()
+{
+
+ st.st_atim = ts;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=yes
+else
+ ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec" >&5
+$as_echo "$ac_cv_typeof_struct_stat_st_atim_is_struct_timespec" >&6; }
+ if test $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec = yes; then
+
+$as_echo "#define TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC 1" >>confdefs.h
+
+ fi
+else
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_atimespec.tv_nsec" "ac_cv_member_struct_stat_st_atimespec_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_atimespec_tv_nsec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC 1
+_ACEOF
+
+
+else
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_atimensec" "ac_cv_member_struct_stat_st_atimensec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_atimensec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_ATIMENSEC 1
+_ACEOF
+
+
+else
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.st__tim.tv_nsec" "ac_cv_member_struct_stat_st_atim_st__tim_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_atim_st__tim_tv_nsec" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC 1
+_ACEOF
+
+
fi
+fi
+fi
+fi
- ac_fn_c_check_type "$LINENO" "sighandler_t" "ac_cv_type_sighandler_t" "
-#include <signal.h>
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtimespec.tv_nsec" "ac_cv_member_struct_stat_st_birthtimespec_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
"
-if test "x$ac_cv_type_sighandler_t" = x""yes; then :
-
-else
- HAVE_SIGHANDLER_T=0
-fi
+if test "x$ac_cv_member_struct_stat_st_birthtimespec_tv_nsec" = x""yes; then :
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC 1
+_ACEOF
+else
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtimensec" "ac_cv_member_struct_stat_st_birthtimensec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_birthtimensec" = x""yes; then :
- ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "
-/* <sys/types.h> is not needed according to POSIX, but the
- <sys/socket.h> in i386-unknown-freebsd4.10 and
- powerpc-apple-darwin5.5 required it. */
-#include <sys/types.h>
-#if HAVE_SYS_SOCKET_H
-# include <sys/socket.h>
-#elif HAVE_WS2TCPIP_H
-# include <ws2tcpip.h>
-#endif
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC 1
+_ACEOF
-"
-if test "x$ac_cv_type_socklen_t" = x""yes; then :
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for socklen_t equivalent" >&5
-$as_echo_n "checking for socklen_t equivalent... " >&6; }
- if test "${gl_cv_socklen_t_equiv+set}" = set; then :
- $as_echo_n "(cached) " >&6
-else
- # Systems have either "struct sockaddr *" or
- # "void *" as the second argument to getpeername
- gl_cv_socklen_t_equiv=
- for arg2 in "struct sockaddr" void; do
- for t in int size_t "unsigned int" "long int" "unsigned long int"; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- #include <sys/socket.h>
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_birthtim.tv_nsec" "ac_cv_member_struct_stat_st_birthtim_tv_nsec" "#include <sys/types.h>
+ #include <sys/stat.h>
+"
+if test "x$ac_cv_member_struct_stat_st_birthtim_tv_nsec" = x""yes; then :
- int getpeername (int, $arg2 *, $t *);
-int
-main ()
-{
-$t len;
- getpeername (0, 0, &len);
- ;
- return 0;
-}
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC 1
_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- gl_cv_socklen_t_equiv="$t"
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- test "$gl_cv_socklen_t_equiv" != "" && break
- done
- test "$gl_cv_socklen_t_equiv" != "" && break
- done
-fi
- if test "$gl_cv_socklen_t_equiv" = ""; then
- as_fn_error "Cannot find a type to use in place of socklen_t" "$LINENO" 5
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_socklen_t_equiv" >&5
-$as_echo "$gl_cv_socklen_t_equiv" >&6; }
+fi
-cat >>confdefs.h <<_ACEOF
-#define socklen_t $gl_cv_socklen_t_equiv
-_ACEOF
+fi
fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ssize_t" >&5
-$as_echo_n "checking for ssize_t... " >&6; }
-if test "${gt_cv_ssize_t+set}" = set; then :
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working stdalign.h" >&5
+$as_echo_n "checking for working stdalign.h... " >&6; }
+if test "${gl_cv_header_working_stdalign_h+set}" = set; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <sys/types.h>
+#include <stdalign.h>
+ #include <stddef.h>
+
+ /* Test that alignof yields a result consistent with offsetof.
+ This catches GCC bug 52023
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
+ #ifdef __cplusplus
+ template <class t> struct alignof_helper { char a; t b; };
+ # define ao(type) offsetof (alignof_helper<type>, b)
+ #else
+ # define ao(type) offsetof (struct { char a; type b; }, b)
+ #endif
+ char test_double[ao (double) % _Alignof (double) == 0 ? 1 : -1];
+ char test_long[ao (long int) % _Alignof (long int) == 0 ? 1 : -1];
+ char test_alignof[alignof (double) == _Alignof (double) ? 1 : -1];
+
+ /* Test _Alignas only on platforms where gnulib can help. */
+ #if \
+ (__GNUC__ || __IBMC__ || __IBMCPP__ \
+ || 0x5110 <= __SUNPRO_C || 1300 <= _MSC_VER)
+ int alignas (8) alignas_int = 1;
+ char test_alignas[_Alignof (alignas_int) == 8 ? 1 : -1];
+ #endif
+
int
main ()
{
-int x = sizeof (ssize_t *) + sizeof (ssize_t);
- return !x;
+
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- gt_cv_ssize_t=yes
+ gl_cv_header_working_stdalign_h=yes
else
- gt_cv_ssize_t=no
+ gl_cv_header_working_stdalign_h=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_ssize_t" >&5
-$as_echo "$gt_cv_ssize_t" >&6; }
- if test $gt_cv_ssize_t = no; then
-
-$as_echo "#define ssize_t int" >>confdefs.h
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_working_stdalign_h" >&5
+$as_echo "$gl_cv_header_working_stdalign_h" >&6; }
+ if test $gl_cv_header_working_stdalign_h = yes; then
+ STDALIGN_H=''
+ else
+ STDALIGN_H='stdalign.h'
fi
+ if test -n "$STDALIGN_H"; then
+ GL_GENERATE_STDALIGN_H_TRUE=
+ GL_GENERATE_STDALIGN_H_FALSE='#'
+else
+ GL_GENERATE_STDALIGN_H_TRUE='#'
+ GL_GENERATE_STDALIGN_H_FALSE=
+fi
+
+
+
STDARG_H=''
NEXT_STDARG_H='<stdarg.h>'
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for va_copy" >&5
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stdarg.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stdarg.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stdarg.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stddef.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stddef.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stddef.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stdio.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stdio.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stdio.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
GNULIB_FSCANF=1
+
+
+cat >>confdefs.h <<_ACEOF
+#define GNULIB_FSCANF 1
+_ACEOF
+
+
GNULIB_SCANF=1
+
+
+cat >>confdefs.h <<_ACEOF
+#define GNULIB_SCANF 1
+_ACEOF
+
+
GNULIB_FGETC=1
GNULIB_GETC=1
GNULIB_GETCHAR=1
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'stdlib.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'stdlib.h\)".*|\1|
+ gl_header_literal_regex=`echo 'stdlib.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
HAVE_DECL_STRTOIMAX=0
fi
-if test $ac_cv_func_strtoimax = no; then
+ if test $ac_cv_func_strtoimax = yes; then
+ HAVE_STRTOIMAX=1
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether strtoimax works" >&5
+$as_echo_n "checking whether strtoimax works... " >&6; }
+if test "${gl_cv_func_strtoimax+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in
+ # Guess no on AIX 5.
+ aix5*) gl_cv_func_strtoimax="guessing no" ;;
+ # Guess yes otherwise.
+ *) gl_cv_func_strtoimax="guessing yes" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <errno.h>
+#include <string.h>
+#include <inttypes.h>
+int main ()
+{
+ if (sizeof (intmax_t) > sizeof (int))
+ {
+ const char *s = "4294967295";
+ char *p;
+ intmax_t res;
+ errno = 0;
+ res = strtoimax (s, &p, 10);
+ if (p != s + strlen (s))
+ return 1;
+ if (errno != 0)
+ return 2;
+ if (res != (intmax_t) 65535 * (intmax_t) 65537)
+ return 3;
+ }
+ else
+ {
+ const char *s = "2147483647";
+ char *p;
+ intmax_t res;
+ errno = 0;
+ res = strtoimax (s, &p, 10);
+ if (p != s + strlen (s))
+ return 1;
+ if (errno != 0)
+ return 2;
+ if (res != 2147483647)
+ return 3;
+ }
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_strtoimax=yes
+else
+ gl_cv_func_strtoimax=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_strtoimax" >&5
+$as_echo "$gl_cv_func_strtoimax" >&6; }
+ case "$gl_cv_func_strtoimax" in
+ *no) REPLACE_STRTOIMAX=1 ;;
+ esac
+ else
+ HAVE_STRTOIMAX=0
+ fi
+
+ if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
-fi
+ fi
HAVE_DECL_STRTOUMAX=0
fi
-if test $ac_cv_func_strtoumax = no; then
+ if test $ac_cv_func_strtoumax = no; then
-fi
+ fi
$as_echo_n "(cached) " >&6
else
if test "$cross_compiling" = yes; then :
- gl_cv_func_symlink_works="guessing no"
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_symlink_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_symlink_works="guessing no" ;;
+ esac
+
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
- rm -f conftest.f conftest.link conftest.lnk2
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_symlink_works" >&5
-$as_echo "$gl_cv_func_symlink_works" >&6; }
- if test "$gl_cv_func_symlink_works" != yes; then
- REPLACE_SYMLINK=1
- fi
- fi
+ rm -f conftest.f conftest.link conftest.lnk2
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_symlink_works" >&5
+$as_echo "$gl_cv_func_symlink_works" >&6; }
+ case "$gl_cv_func_symlink_works" in
+ *yes) ;;
+ *)
+ REPLACE_SYMLINK=1
+ ;;
+ esac
+ fi
+
+ if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
+
+
+
+
+
+
+
+
+ gl_LIBOBJS="$gl_LIBOBJS symlink.$ac_objext"
+
+ fi
+
+
+
+
+
+ GNULIB_SYMLINK=1
+
+
+
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether <sys/select.h> is self-contained" >&5
+$as_echo_n "checking whether <sys/select.h> is self-contained... " >&6; }
+if test "${gl_cv_header_sys_select_h_selfcontained+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+struct timeval b;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ gl_cv_header_sys_select_h_selfcontained=yes
+else
+ gl_cv_header_sys_select_h_selfcontained=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ if test $gl_cv_header_sys_select_h_selfcontained = yes; then
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+int memset; int bzero;
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+int
+main ()
+{
+
+ #undef memset
+ #define memset nonexistent_memset
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void *memset (void *, int, unsigned long);
+ #undef bzero
+ #define bzero nonexistent_bzero
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void bzero (void *, unsigned long);
+ fd_set fds;
+ FD_ZERO (&fds);
+
+ ;
+ return 0;
+}
+
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+else
+ gl_cv_header_sys_select_h_selfcontained=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_sys_select_h_selfcontained" >&5
+$as_echo "$gl_cv_header_sys_select_h_selfcontained" >&6; }
+
+
+
+
+
+
+
+
+
+ if test $gl_cv_have_include_next = yes; then
+ gl_cv_next_sys_select_h='<'sys/select.h'>'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <sys/select.h>" >&5
+$as_echo_n "checking absolute name of <sys/select.h>... " >&6; }
+if test "${gl_cv_next_sys_select_h+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ if test $ac_cv_header_sys_select_h = yes; then
+
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/select.h>
+
+_ACEOF
+ case "$host_os" in
+ aix*) gl_absname_cpp="$ac_cpp -C" ;;
+ *) gl_absname_cpp="$ac_cpp" ;;
+ esac
+
+ case "$host_os" in
+ mingw*)
+ gl_dirsep_regex='[/\\]'
+ ;;
+ *)
+ gl_dirsep_regex='\/'
+ ;;
+ esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
-if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
+ gl_header_literal_regex=`echo 'sys/select.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
+ s|^/[^/]|//&|
+ p
+ q
+ }'
+ gl_cv_next_sys_select_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 |
+ sed -n "$gl_absolute_header_sed"`'"'
+ else
+ gl_cv_next_sys_select_h='<'sys/select.h'>'
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_select_h" >&5
+$as_echo "$gl_cv_next_sys_select_h" >&6; }
+ fi
+ NEXT_SYS_SELECT_H=$gl_cv_next_sys_select_h
+ if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
+ gl_next_as_first_directive='<'sys/select.h'>'
+ else
+ # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+ gl_next_as_first_directive=$gl_cv_next_sys_select_h
+ fi
+ NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H=$gl_next_as_first_directive
+ if test $ac_cv_header_sys_select_h = yes; then
+ HAVE_SYS_SELECT_H=1
+ else
+ HAVE_SYS_SELECT_H=0
+ fi
- gl_LIBOBJS="$gl_LIBOBJS symlink.$ac_objext"
-fi
+ if test $ac_cv_header_sys_socket_h != yes; then
+ for ac_header in winsock2.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "winsock2.h" "ac_cv_header_winsock2_h" "$ac_includes_default"
+if test "x$ac_cv_header_winsock2_h" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_WINSOCK2_H 1
+_ACEOF
+fi
- GNULIB_SYMLINK=1
+done
+ fi
+ if test "$ac_cv_header_winsock2_h" = yes; then
+ HAVE_WINSOCK2_H=1
+ UNISTD_H_HAVE_WINSOCK2_H=1
+ SYS_IOCTL_H_HAVE_WINSOCK2_H=1
+ else
+ HAVE_WINSOCK2_H=0
+ fi
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'sys/stat.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'sys/stat.h\)".*|\1|
+ gl_header_literal_regex=`echo 'sys/stat.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
+
+
+
+
+ if test $WINDOWS_64_BIT_ST_SIZE = 1; then
+
+$as_echo "#define _GL_WINDOWS_64_BIT_ST_SIZE 1" >>confdefs.h
+
+ fi
+
ac_fn_c_check_type "$LINENO" "nlink_t" "ac_cv_type_nlink_t" "#include <sys/types.h>
#include <sys/stat.h>
"
+
+
+
+ ac_fn_c_check_decl "$LINENO" "localtime_r" "ac_cv_have_decl_localtime_r" "#include <time.h>
+"
+if test "x$ac_cv_have_decl_localtime_r" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_LOCALTIME_R $ac_have_decl
+_ACEOF
+
if test $ac_cv_have_decl_localtime_r = no; then
HAVE_DECL_LOCALTIME_R=0
fi
HAVE_LOCALTIME_R=0
fi
-if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
+ if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
:
-fi
+ fi
+ LIB_TIMER_TIME=
+
+ gl_saved_libs=$LIBS
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing timer_settime" >&5
+$as_echo_n "checking for library containing timer_settime... " >&6; }
+if test "${ac_cv_search_timer_settime+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char timer_settime ();
+int
+main ()
+{
+return timer_settime ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' rt posix4; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_timer_settime=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if test "${ac_cv_search_timer_settime+set}" = set; then :
+ break
+fi
+done
+if test "${ac_cv_search_timer_settime+set}" = set; then :
+
+else
+ ac_cv_search_timer_settime=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_timer_settime" >&5
+$as_echo "$ac_cv_search_timer_settime" >&6; }
+ac_res=$ac_cv_search_timer_settime
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ test "$ac_cv_search_timer_settime" = "none required" ||
+ LIB_TIMER_TIME=$ac_cv_search_timer_settime
+fi
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <features.h>
+#ifdef __GNU_LIBRARY__
+ #if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || (__GLIBC__ > 2)) \
+ && !defined __UCLIBC__
+ Thread emulation available
+ #endif
+#endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "Thread" >/dev/null 2>&1; then :
+ LIB_TIMER_TIME="$LIB_TIMER_TIME $LIBMULTITHREAD"
+fi
+rm -f conftest*
+
+ for ac_func in timer_settime
+do :
+ ac_fn_c_check_func "$LINENO" "timer_settime" "ac_cv_func_timer_settime"
+if test "x$ac_cv_func_timer_settime" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_TIMER_SETTIME 1
+_ACEOF
+
+fi
+done
+
+ LIBS=$gl_saved_libs
+
+ :
+
+
+
+
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"'unistd.h|{
- s|.*"\(.*'"${gl_dirsep_regex}"'unistd.h\)".*|\1|
+ gl_header_literal_regex=`echo 'unistd.h' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
s|^/[^/]|//&|
p
q
+
+
+
+
+
+
+
+
+ if test $ac_cv_func_futimens = no && test $ac_cv_func_futimesat = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether futimesat handles NULL file" >&5
+$as_echo_n "checking whether futimesat handles NULL file... " >&6; }
+if test "${gl_cv_func_futimesat_works+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ touch conftest.file
+ if test "$cross_compiling" = yes; then :
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_futimesat_works="guessing no" ;;
+ esac
+
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <stddef.h>
+#include <sys/times.h>
+#include <fcntl.h>
+
+int
+main ()
+{
+ int fd = open ("conftest.file", O_RDWR);
+ if (fd < 0) return 1;
+ if (futimesat (fd, NULL, NULL)) return 2;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ gl_cv_func_futimesat_works=yes
+else
+ gl_cv_func_futimesat_works=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+ rm -f conftest.file
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_futimesat_works" >&5
+$as_echo "$gl_cv_func_futimesat_works" >&6; }
+ case "$gl_cv_func_futimesat_works" in
+ *yes) ;;
+ *)
+
+$as_echo "#define FUTIMESAT_NULL_BUG 1" >>confdefs.h
+
+ ;;
+ esac
+ fi
+
gl_gnulib_enabled_dosname=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
gl_gnulib_enabled_pathmax=false
- gl_gnulib_enabled_sigprocmask=false
gl_gnulib_enabled_stat=false
gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_strtoull=false
gl_gnulib_enabled_pathmax=true
fi
}
- func_gl_gnulib_m4code_sigprocmask ()
- {
- if ! $gl_gnulib_enabled_sigprocmask; then
-
-
-
- if test $gl_cv_type_sigset_t = yes; then
- ac_fn_c_check_func "$LINENO" "sigprocmask" "ac_cv_func_sigprocmask"
-if test "x$ac_cv_func_sigprocmask" = x""yes; then :
- gl_cv_func_sigprocmask=1
-fi
-
- fi
- if test -z "$gl_cv_func_sigprocmask"; then
- HAVE_POSIX_SIGNALBLOCKING=0
- fi
-
-if test $HAVE_POSIX_SIGNALBLOCKING = 0; then
-
-
-
-
-
-
-
-
- gl_LIBOBJS="$gl_LIBOBJS sigprocmask.$ac_objext"
-
-
-
-
-fi
-
-
-
-
-
- GNULIB_SIGPROCMASK=1
-
-
-
-
-
- gl_gnulib_enabled_sigprocmask=true
- fi
- }
func_gl_gnulib_m4code_stat ()
{
if ! $gl_gnulib_enabled_stat; then
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_stat_dir_slash" >&5
$as_echo "$gl_cv_func_stat_dir_slash" >&6; }
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on files" >&5
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on files" >&5
$as_echo_n "checking whether stat handles trailing slashes on files... " >&6; }
if test "${gl_cv_func_stat_file_slash+set}" = set; then :
$as_echo_n "(cached) " >&6
ln -s conftest.tmp conftest.lnk
fi
if test "$cross_compiling" = yes; then :
- gl_cv_func_stat_file_slash="guessing no"
+ case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_stat_file_slash="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_stat_file_slash="guessing no" ;;
+ esac
+
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
;;
esac
-if test $REPLACE_STAT = 1; then
+ if test $REPLACE_STAT = 1; then
:
-fi
+ fi
fi
fi
-if test $HAVE_STRTOLL = 0; then
+ if test $HAVE_STRTOLL = 0; then
:
-fi
+ fi
fi
fi
-if test $HAVE_STRTOULL = 0; then
+ if test $HAVE_STRTOULL = 0; then
:
-fi
+ fi
if test $REPLACE_LSTAT = 1; then
func_gl_gnulib_m4code_stat
fi
- if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
- func_gl_gnulib_m4code_sigprocmask
- fi
if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
func_gl_gnulib_m4code_stat
fi
- if test $ac_cv_func_strtoimax = no; then
- func_gl_gnulib_m4code_verify
- fi
- if test $ac_cv_func_strtoimax = no && test $ac_cv_type_long_long_int = yes; then
+ if { test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then
func_gl_gnulib_m4code_strtoll
fi
- if test $ac_cv_func_strtoumax = no; then
+ if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
func_gl_gnulib_m4code_verify
fi
if test $ac_cv_func_strtoumax = no && test $ac_cv_type_unsigned_long_long_int = yes; then
func_gl_gnulib_m4code_strtoull
fi
+ if test $ac_cv_func_strtoumax = no; then
+ func_gl_gnulib_m4code_verify
+ fi
if $gl_gnulib_enabled_dosname; then
gl_GNULIB_ENABLED_dosname_TRUE=
gl_GNULIB_ENABLED_pathmax_FALSE=
fi
- if $gl_gnulib_enabled_sigprocmask; then
- gl_GNULIB_ENABLED_sigprocmask_TRUE=
- gl_GNULIB_ENABLED_sigprocmask_FALSE='#'
-else
- gl_GNULIB_ENABLED_sigprocmask_TRUE='#'
- gl_GNULIB_ENABLED_sigprocmask_FALSE=
-fi
-
if $gl_gnulib_enabled_stat; then
gl_GNULIB_ENABLED_stat_TRUE=
gl_GNULIB_ENABLED_stat_FALSE='#'
LIBGNU_LTLIBDEPS="$gl_ltlibdeps"
+CFLAGS=$SAVE_CFLAGS
+LIBS=$SAVE_LIBS
case "$opsys" in
aix4-2) LD_SWITCH_SYSTEM_TEMACS="-Wl,-bnodelcsect" ;;
## #ifndef LD_SWITCH_SYSTEM
## #if !defined (__GNUC__) && ((defined (BSD_SYSTEM) && !defined (COFF)))
## Since all the *bsds define LD_SWITCH_SYSTEM, this simplifies to:
- ## not using gcc, darwin system not on an alpha (ie darwin, since
- ## darwin + alpha does not occur).
+ ## not using gcc, darwin.
## Because this was done in src/Makefile.in, the resulting part of
## LD_SWITCH_SYSTEM was not used in configure (ie, in ac_link).
## It therefore seems cleaner to put this in LD_SWITCH_SYSTEM_TEMACS,
LD_SWITCH_SYSTEM_TEMACS="-X $LD_SWITCH_SYSTEM_TEMACS"
;;
- ## LD_SWITCH_X_SITE_AUX is a -R option saying where to find X at run-time.
- ## When handled by cpp, this was in LD_SWITCH_SYSTEM. However, at
- ## the point where configure sourced the s/*.h file, LD_SWITCH_X_SITE_AUX
+ ## LD_SWITCH_X_SITE_RPATH is a -rpath option saying where to
+ ## find X at run-time.
+ ## When handled by cpp, this was in LD_SWITCH_SYSTEM. However, at the
+ ## point where configure sourced the s/*.h file, LD_SWITCH_X_SITE_RPATH
## had not yet been defined and was expanded to null. Hence LD_SWITCH_SYSTEM
## had different values in configure (in ac_link) and src/Makefile.in.
## It seems clearer therefore to put this piece in LD_SWITCH_SYSTEM_TEMACS.
- gnu*) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_AUX_RPATH)" ;;
+ gnu*) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_RPATH)" ;;
*) LD_SWITCH_SYSTEM_TEMACS= ;;
esac
## will also work on earlier NetBSD releases.
netbsd|openbsd) LD_FIRSTFLAG="-nostartfiles" ;;
- ## macpcc: NAKAJI Hiroyuki <nakaji@tutrp.tut.ac.jp> says
+ ## powerpc*: NAKAJI Hiroyuki <nakaji@tutrp.tut.ac.jp> says
## MkLinux/LinuxPPC needs this.
- ## ibms390x only supports opsys = gnu-linux so it can be added here.
+ ## s390x-* only supports opsys = gnu-linux so it can be added here.
gnu-*)
- case "$machine" in
- macppc|ibms390x) LD_FIRSTFLAG="-nostdlib" ;;
+ case "$canonical" in
+ powerpc*|s390x-*) LD_FIRSTFLAG="-nostdlib" ;;
esac
;;
esac
## The system files defining neither ORDINARY_LINK nor LD_FIRSTFLAG are:
-## freebsd, gnu-* not on macppc|ibms390x.
+## freebsd, gnu-* not on powerpc*|s390x*.
elif test "x$GCC" = "xyes" && test "x$LD_FIRSTFLAG" = "x"; then
## Versions of GCC >= 2.0 put their library, libgcc.a, in obscure
esac
fi
-
-## If we're using X11/GNUstep, define some consequences.
-if test "$HAVE_X_WINDOWS" = "yes" || test "$HAVE_NS" = "yes"; then
+## Common for all window systems
+if test "$window_system" != "none"; then
$as_echo "#define HAVE_WINDOW_SYSTEM 1" >>confdefs.h
$as_echo "#define HAVE_MOUSE 1" >>confdefs.h
+ WINDOW_SYSTEM_OBJ="fontset.o fringe.o image.o"
fi
+
#### Report on what we decided to do.
#### Report GTK as a toolkit, even if it doesn't use Xt.
#### It makes printing result more understandable as using GTK sets
#### toolkit_scroll_bars to yes by default.
if test "${HAVE_GTK}" = "yes"; then
- USE_X_TOOLKIT=GTK
-fi
-
-and_machfile=
-if test -n "$machfile"; then
- and_machfile=" and \`${machfile}'"
+ USE_X_TOOLKIT="$USE_GTK_TOOLKIT"
fi
echo "
Configured for \`${canonical}'.
Where should the build process find the source code? ${srcdir}
- What operating system and machine description files should Emacs use?
- \`${opsysfile}'${and_machfile}
What compiler should emacs be built with? ${CC} ${CFLAGS}
Should Emacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason}
Should Emacs use a relocating allocator for buffers? ${REL_ALLOC}
echo " Environment variable EMACSDOC set to: $EMACSDOC"
fi
-if test $USE_XASSERTS = yes; then
- echo " Compiling with asserts turned on."
- CPPFLAGS="$CPPFLAGS -DXASSERTS=1"
-fi
-
echo
if test "$HAVE_NS" = "yes"; then
echo
fi
+if test "${opsys}" = "cygwin"; then
+ case `uname -r` in
+ 1.5.*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: building Emacs on Cygwin 1.5 is not supported." >&5
+$as_echo "$as_me: WARNING: building Emacs on Cygwin 1.5 is not supported." >&2;}
+ echo
+ ;;
+ esac
+fi
# Remove any trailing slashes in these variables.
test "${prefix}" != NONE &&
test "${exec_prefix}" != NONE &&
exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'`
-SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile"
+if test "$HAVE_NS" = "yes"; then
+ if test "$NS_IMPL_GNUSTEP" = yes; then
+ ac_config_files="$ac_config_files nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in"
+
+ else
+ ac_config_files="$ac_config_files nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in"
+
+ fi
+fi
+
+SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile"
-ac_config_files="$ac_config_files Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile"
+ac_config_files="$ac_config_files Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile"
opt_makefile=test/automated/Makefile
fi
+
+opt_makefile=admin/unidata/Makefile
+
+if test -f $srcdir/${opt_makefile}.in; then
+ SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile"
+ ac_config_files="$ac_config_files admin/unidata/Makefile"
+
+fi
+
+
SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e 's|Makefile|Makefile.in|g'`
as_fn_error "conditional \"am__fastdepCC\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
-
if test -z "${GL_COND_LIBTOOL_TRUE}" && test -z "${GL_COND_LIBTOOL_FALSE}"; then
as_fn_error "conditional \"GL_COND_LIBTOOL\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${GL_GENERATE_EXECINFO_H_TRUE}" && test -z "${GL_GENERATE_EXECINFO_H_FALSE}"; then
+ as_fn_error "conditional \"GL_GENERATE_EXECINFO_H\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
if test -z "${GL_GENERATE_STDINT_H_TRUE}" && test -z "${GL_GENERATE_STDINT_H_FALSE}"; then
as_fn_error "conditional \"GL_GENERATE_STDINT_H\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
+if test -z "${GL_GENERATE_STDALIGN_H_TRUE}" && test -z "${GL_GENERATE_STDALIGN_H_FALSE}"; then
+ as_fn_error "conditional \"GL_GENERATE_STDALIGN_H\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
if test -z "${GL_GENERATE_STDARG_H_TRUE}" && test -z "${GL_GENERATE_STDARG_H_FALSE}"; then
as_fn_error "conditional \"GL_GENERATE_STDARG_H\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
as_fn_error "conditional \"gl_GNULIB_ENABLED_pathmax\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
-if test -z "${gl_GNULIB_ENABLED_sigprocmask_TRUE}" && test -z "${gl_GNULIB_ENABLED_sigprocmask_FALSE}"; then
- as_fn_error "conditional \"gl_GNULIB_ENABLED_sigprocmask\" was never defined.
-Usually this means the macro was only invoked conditionally." "$LINENO" 5
-fi
if test -z "${gl_GNULIB_ENABLED_stat_TRUE}" && test -z "${gl_GNULIB_ENABLED_stat_FALSE}"; then
as_fn_error "conditional \"gl_GNULIB_ENABLED_stat\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by emacs $as_me 24.2, which was
+This file was extended by emacs $as_me 24.2.50, which was
generated by GNU Autoconf 2.65. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-emacs config.status 24.2
+emacs config.status 24.2.50
configured by $0, generated by GNU Autoconf 2.65,
with options \\"\$ac_cs_config\\"
# INIT-COMMANDS
#
AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"
-GCC="$GCC" NON_GNU_CPP="$NON_GNU_CPP" CPP="$CPP" CPPFLAGS="$CPPFLAGS"
+GCC="$GCC" CPPFLAGS="$CPPFLAGS"
_ACEOF
case $ac_config_target in
"src/config.h") CONFIG_HEADERS="$CONFIG_HEADERS src/config.h:src/config.in" ;;
"depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;;
+ "nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist") CONFIG_FILES="$CONFIG_FILES nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in" ;;
+ "nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop") CONFIG_FILES="$CONFIG_FILES nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in" ;;
+ "nextstep/Cocoa/Emacs.base/Contents/Info.plist") CONFIG_FILES="$CONFIG_FILES nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in" ;;
+ "nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings") CONFIG_FILES="$CONFIG_FILES nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in" ;;
"Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
"lib/Makefile") CONFIG_FILES="$CONFIG_FILES lib/Makefile" ;;
"lib-src/Makefile") CONFIG_FILES="$CONFIG_FILES lib-src/Makefile" ;;
"lwlib/Makefile") CONFIG_FILES="$CONFIG_FILES lwlib/Makefile" ;;
"lisp/Makefile") CONFIG_FILES="$CONFIG_FILES lisp/Makefile" ;;
"leim/Makefile") CONFIG_FILES="$CONFIG_FILES leim/Makefile" ;;
+ "nextstep/Makefile") CONFIG_FILES="$CONFIG_FILES nextstep/Makefile" ;;
"test/automated/Makefile") CONFIG_FILES="$CONFIG_FILES test/automated/Makefile" ;;
+ "admin/unidata/Makefile") CONFIG_FILES="$CONFIG_FILES admin/unidata/Makefile" ;;
"mkdirs") CONFIG_COMMANDS="$CONFIG_COMMANDS mkdirs" ;;
"epaths") CONFIG_COMMANDS="$CONFIG_COMMANDS epaths" ;;
"gdbinit") CONFIG_COMMANDS="$CONFIG_COMMANDS gdbinit" ;;
;;
"epaths":C)
echo creating src/epaths.h
-${MAKE-make} epaths-force
+${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force
;;
"gdbinit":C)
if test ! -f src/.gdbinit && test -f $srcdir/src/.gdbinit; then
$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi
-
## Helper script for those building Emacs from bzr without autoconf etc.
## This installs some pre-generated versions of the automatically
## generated files. It is highly recommended to install the necessary
-## tools instead of using this. Note that if eg configure.in
+## tools instead of using this. Note that if eg configure.ac
## is updated, the next time you run make it will attempt to
## regenerate configure and will fail if you do not have the required
## tools. You will have to run this script again.
-test -d autogen && cd autogen
+test ! -d autogen || cd autogen || exit
if test ! -e config.in; then
echo "Cannot find autogen/ directory."
fi
## Order implied by top-level Makefile's rules, for time-stamps.
-cp compile config.guess config.sub depcomp install-sh missing ../build-aux
-cp aclocal.m4 ../
-cp configure ../
-touch ../src/stamp-h.in
-cp config.in ../src/
-cp Makefile.in ../lib/
+cp -f compile config.guess config.sub depcomp install-sh missing \
+ ../build-aux &&
+cp aclocal.m4 ../ &&
+cp configure ../ &&
+touch ../src/stamp-h.in &&
+cp config.in ../src/ &&
+cp Makefile.in ../lib/ &&
echo "You can now run configure"
## Parameters.
ldefs_in=lisp/loaddefs.el
ldefs_out=lisp/ldefs-boot.el
-sources="configure.in lib/Makefile.am"
+sources="configure.ac lib/Makefile.am"
genfiles="
configure aclocal.m4 src/config.in lib/Makefile.in
build-aux/compile build-aux/config.guess build-aux/config.sub
# Like mv $1 $2, but if the files are the same, just delete $1.
# Status is zero if successful, nonzero otherwise.
-VERSION='2011-01-28 20:09'; # UTC
+VERSION='2012-01-06 07:23'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
# do its job. Otherwise, update this string manually.
-# Copyright (C) 2002-2007, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-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
--help display this help and exit
--version output version information and exit
-The variable CMPPROG can be used to specify an alternative to \`cmp'.
+The variable CMPPROG can be used to specify an alternative to 'cmp'.
Report bugs to <bug-gnulib@gnu.org>."
-#ifndef _Noreturn
+#if !defined _Noreturn && __STDC_VERSION__ < 201112
# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__) \
|| 0x5110 <= __SUNPRO_C)
# define _Noreturn __attribute__ ((__noreturn__))
/* A C macro for declaring that specific arguments must not be NULL.
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
/* C++ compatible function declaration macros.
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-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
/* A C macro for emitting warnings if a function is used.
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-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
if exist ..\autogen\config.in sed -f ../msdos/sed2x.inp < ..\autogen\config.in > config.tmp\r
:src4\r
sed -f ../msdos/sed2v2.inp <config.tmp >config.h2\r
-Rem See if DECL_ALIGN can be supported with this GCC\r
-rm -f junk.c junk.o junk junk.exe\r
-echo struct { int i; char *p; } __attribute__((__aligned__(8))) foo; >junk.c\r
-rem Two percent signs because it is a special character for COMMAND.COM/CMD\r
-rem Filter thru Sed because "&" is special for CMD.EXE\r
-echo int main(void) { return (unsigned long)"&"foo %% 8; } | sed "s/.&./\&/" >>junk.c\r
-gcc -o junk junk.c\r
-if not exist junk.exe coff2exe junk\r
-junk\r
-If Not ErrorLevel 1 Goto alignOk\r
-Echo WARNING: Your GCC does not support 8-byte aligned variables.\r
-Echo WARNING: Therefore Emacs cannot support buffers larger than 128MB.\r
-rem The following line disables DECL_ALIGN which in turn disables USE_LSB_TAG\r
-rem For details see lisp.h where it defines USE_LSB_TAG\r
-echo #define NO_DECL_ALIGN >>config.h2\r
-:alignOk\r
Rem See if they have libxml2 later than v2.2.0 installed\r
Echo Checking whether libxml2 v2.2.1 or later is installed ...\r
rm -f junk.c junk.o junk junk.exe\r
If Exist build-aux\snippet\c++defs.h update build-aux/snippet/c++defs.h build-aux/snippet/cxxdefs.h\r
If Exist alloca.in.h update alloca.in.h alloca.in-h\r
If Exist getopt.in.h update getopt.in.h getopt.in-h\r
+If Exist stdalign.in.h update stdalign.in.h stdalign.in-h\r
If Exist stdbool.in.h update stdbool.in.h stdbool.in-h\r
If Exist signal.in.h update signal.in.h signal.in-h\r
+If Exist stdalign.in.h update stdalign.in.h stdalign.in-h\r
If Exist stddef.in.h update stddef.in.h stddef.in-h\r
If Exist stdint.in.h update stdint.in.h stdint.in-h\r
If Exist stdio.in.h update stdio.in.h stdio.in-h\r
If Exist stdlib.in.h update stdlib.in.h stdlib.in-h\r
If Exist sys_stat.in.h update sys_stat.in.h sys_stat.in-h\r
+If Exist sys_types.in.h update sys_types.in.h sys_types.in-h\r
If Exist time.in.h update time.in.h time.in-h\r
If Exist unistd.in.h update unistd.in.h unistd.in-h\r
If Exist Makefile.in sed -f ../msdos/sedlibcf.inp < Makefile.in > makefile.tmp\r
set djgpp_ver=\r
set sys_malloc=\r
set libxml=\r
-\r
dnl in the directory containing this script.
dnl If you changed any AC_DEFINES, also run autoheader.
dnl
-dnl Copyright (C) 1994-1996, 1999-2012 Free Software Foundation, Inc.
+dnl Copyright (C) 1994-1996, 1999-2012 Free Software Foundation, Inc.
dnl
dnl This file is part of GNU Emacs.
dnl
dnl along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
AC_PREREQ(2.65)
-AC_INIT(emacs, 24.2)
+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
dnl (autoconf) Installation Directory Variables
dnl See also epaths.h below.
lispdir='${datadir}/emacs/${version}/lisp'
+leimdir='${datadir}/emacs/${version}/leim'
+standardlisppath='${lispdir}:${leimdir}'
locallisppath='${datadir}/emacs/${version}/site-lisp:'\
'${datadir}/emacs/site-lisp'
-lisppath='${locallisppath}:${lispdir}:${datadir}/emacs/${version}/leim'
+lisppath='${locallisppath}:${standardlisppath}'
etcdir='${datadir}/emacs/${version}/etc'
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
])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
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])
OPTION_DEFAULT_ON([sound],[don't compile with sound support])
-OPTION_DEFAULT_ON([sync-input],[process async input synchronously])
-if test "$with_sync_input" = yes; then
- AC_DEFINE(SYNC_INPUT, 1, [Process async input synchronously.])
-fi
-
dnl FIXME currently it is not the last.
dnl This should be the last --with option, because --with-x is
dnl added later on when we find the path of X, and it's best to
dnl keep them together visually.
AC_ARG_WITH([x-toolkit],[AS_HELP_STRING([--with-x-toolkit=KIT],
- [use an X toolkit (KIT one of: yes or gtk, gtk3, lucid or athena, motif, no)])],
+ [use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena, motif, no)])],
[ case "${withval}" in
y | ye | yes ) val=gtk ;;
n | no ) val=no ;;
a | at | ath | athe | athen | athena ) val=athena ;;
m | mo | mot | moti | motif ) val=motif ;;
g | gt | gtk ) val=gtk ;;
+ gtk2 ) val=gtk2 ;;
gtk3 ) val=gtk3 ;;
* )
AC_MSG_ERROR([`--with-x-toolkit=$withval' is invalid;
-this option's value should be `yes', `no', `lucid', `athena', `motif', `gtk' or
-`gtk3'. `yes' and `gtk' are synonyms. `athena' and `lucid' are synonyms.])
+this option's value should be `yes', `no', `lucid', `athena', `motif', `gtk',
+`gtk2' or `gtk3'. `yes' and `gtk' are synonyms.
+`athena' and `lucid' are synonyms.])
;;
esac
with_x_toolkit=$val
EN_NS_SELF_CONTAINED=$enableval,
EN_NS_SELF_CONTAINED=yes)
-AC_ARG_ENABLE(asserts,
-[AS_HELP_STRING([--enable-asserts], [compile code with asserts enabled])],
- USE_XASSERTS=$enableval,
- USE_XASSERTS=no)
-
-AC_ARG_ENABLE(maintainer-mode,
-[AS_HELP_STRING([--disable-maintainer-mode],
- [disable make rules and dependencies not useful (and sometimes
- confusing) to the casual installer])],
- USE_MAINTAINER_MODE=$enableval,
- USE_MAINTAINER_MODE=yes)
-if test $USE_MAINTAINER_MODE = yes; then
- MAINT=
-else
- MAINT=#
-fi
-AC_SUBST(MAINT)
-
AC_ARG_ENABLE(locallisppath,
[AS_HELP_STRING([--enable-locallisppath=PATH],
[directories Emacs should search for lisp files specific
enable only specific categories of checks.
Categories are: all,yes,no.
Flags are: stringbytes, stringoverrun, stringfreelist,
- xmallocoverrun, conslist])],
+ xmallocoverrun, conslist, glyphs])],
[ac_checking_flags="${enableval}"],[])
IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="$IFS,"
for check in $ac_checking_flags
ac_gc_check_string_overrun= ;
ac_gc_check_string_free_list= ;
ac_xmalloc_overrun= ;
- ac_gc_check_cons_list= ;;
+ ac_gc_check_cons_list= ;
+ ac_glyphs_debug= ;;
all) ac_enable_checking=1 ;
ac_gc_check_stringbytes=1 ;
ac_gc_check_string_overrun=1 ;
ac_gc_check_string_free_list=1 ;
ac_xmalloc_overrun=1 ;
- ac_gc_check_cons_list=1 ;;
+ ac_gc_check_cons_list=1 ;
+ ac_glyphs_debug=1 ;;
# these enable particular checks
stringbytes) ac_gc_check_stringbytes=1 ;;
stringoverrun) ac_gc_check_string_overrun=1 ;;
stringfreelist) ac_gc_check_string_free_list=1 ;;
xmallocoverrun) ac_xmalloc_overrun=1 ;;
conslist) ac_gc_check_cons_list=1 ;;
+ glyphs) ac_glyphs_debug=1 ;;
*) AC_MSG_ERROR(unknown check category $check) ;;
esac
done
if test x$ac_enable_checking != x ; then
AC_DEFINE(ENABLE_CHECKING, 1,
-[Enable expensive run-time checking of data types?])
+[Define to 1 if expensive run-time data type and consistency checks are enabled.])
fi
if test x$ac_gc_check_stringbytes != x ; then
AC_DEFINE(GC_CHECK_STRING_BYTES, 1,
AC_DEFINE(GC_CHECK_CONS_LIST, 1,
[Define this to check for errors in cons list.])
fi
+if test x$ac_glyphs_debug != x ; then
+ AC_DEFINE(GLYPH_DEBUG, 1,
+[Define this to enable glyphs debugging code.])
+fi
-AC_ARG_ENABLE(use-lisp-union-type,
-[AS_HELP_STRING([--enable-use-lisp-union-type],
- [use a union for the Lisp_Object data type.
- This is only useful for development for catching certain types of bugs.])],
+AC_ARG_ENABLE(check-lisp-object-type,
+[AS_HELP_STRING([--enable-check-lisp-object-type],
+ [enable compile time checks for the Lisp_Object data type.
+ This is useful for development for catching certain types of bugs.])],
if test "${enableval}" != "no"; then
- AC_DEFINE(USE_LISP_UNION_TYPE, 1,
- [Define this to use a lisp union for the Lisp_Object data type.])
+ AC_DEFINE(CHECK_LISP_OBJECT_TYPE, 1,
+ [Define this to enable compile time checks for the Lisp_Object data type.])
fi)
* ) srcdir="`(cd ${srcdir}; pwd)`" ;;
esac
-#### Given the configuration name, set machfile and opsysfile to the
-#### names of the m/*.h and s/*.h files we should use.
-
### Canonicalize the configuration name.
AC_CANONICAL_HOST
### If you add support for a new configuration, add code to this
### switch statement to recognize your configuration name and select
-### the appropriate operating system and machine description files.
+### the appropriate operating system file.
-### You would hope that you could choose an m/*.h file pretty much
-### based on the machine portion of the configuration name, and an s/*.h
+### You would hope that you could choose an s/*.h
### file based on the operating system portion. However, it turns out
-### that each m/*.h file is pretty manufacturer-specific - for
-### example mips.h is MIPS
+### that each s/*.h file is pretty manufacturer-specific.
### So we basically have to have a special case for each
### configuration name.
###
### prepared to handle anything reasonably. If version numbers
### matter, be sure /etc/MACHINES says something about it.
-machine='' opsys='' unported=no
+opsys='' unported=no
case "${canonical}" in
## GNU/Linux and similar ports
*-*-linux* )
opsys=gnu-linux
- case ${canonical} in
- alpha*) machine=alpha ;;
- s390x-*) machine=ibms390x ;;
- powerpc*) machine=macppc ;;
- sparc*) machine=sparc ;;
- ia64*) machine=ia64 ;;
- m68k*) machine=m68k ;;
- x86_64*) machine=amdx86-64 ;;
- esac
;;
## FreeBSD ports
*-*-freebsd* )
opsys=freebsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- amd64-*|x86_64-*) machine=amdx86-64 ;;
- ia64-*) machine=ia64 ;;
- i[3456]86-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc-*) machine=sparc ;;
- sparc64-*) machine=sparc ;;
- esac
;;
## FreeBSD kernel + glibc based userland
*-*-kfreebsd*gnu* )
opsys=gnu-kfreebsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- amd64-*|x86_64-*) machine=amdx86-64 ;;
- ia64-*) machine=ia64 ;;
- i[3456]86-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc-*) machine=sparc ;;
- sparc64-*) machine=sparc ;;
- esac
;;
## NetBSD ports
*-*-netbsd* )
opsys=netbsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- x86_64-*) machine=amdx86-64 ;;
- i[3456]86-*) machine=intel386 ;;
- m68k-*) machine=m68k ;;
- powerpc-*) machine=macppc ;;
- sparc*-) machine=sparc ;;
- vax-*) machine=vax ;;
- esac
;;
## OpenBSD ports
*-*-openbsd* )
opsys=openbsd
- case "${canonical}" in
- alpha*) machine=alpha ;;
- x86_64-*) machine=amdx86-64 ;;
- i386-*) machine=intel386 ;;
- powerpc-*) machine=macppc ;;
- sparc*) machine=sparc ;;
- vax-*) machine=vax ;;
- esac
;;
## Apple Darwin / Mac OS X
*-apple-darwin* )
case "${canonical}" in
- i[3456]86-* ) machine=intel386 ;;
- powerpc-* ) machine=macppc ;;
- x86_64-* ) machine=amdx86-64 ;;
+ i[3456]86-* ) ;;
+ powerpc-* ) ;;
+ x86_64-* ) ;;
* ) unported=yes ;;
esac
opsys=darwin
- # Define CPP as follows to make autoconf work correctly.
- CPP="${CC-cc} -E -no-cpp-precomp"
- # Use fink packages if available.
- if test -d /sw/include && test -d /sw/lib; then
- GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib"
- CPP="${CPP} ${GCC_TEST_OPTIONS}"
- NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS}
- fi
+ ## Use fink packages if available.
+ ## FIXME find a better way to do this: http://debbugs.gnu.org/11507
+## if test -d /sw/include && test -d /sw/lib; then
+## GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib"
+## NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS}
+## fi
;;
## HP 9000 series 700 and 800, running HP/UX
## IBM machines
rs6000-ibm-aix4.[23]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
powerpc-ibm-aix4.[23]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
rs6000-ibm-aix[56]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
powerpc-ibm-aix[56]* )
- machine=ibmrs6000 opsys=aix4-2
+ opsys=aix4-2
;;
## Silicon Graphics machines
# Without defining _LANGUAGE_C, things get masked out in the headers
# so that, for instance, grepping for `free' in stdlib.h fails and
# AC_HEADER_STD_C fails. (MIPSPro 7.2.1.2m compilers, Irix 6.5.3m).
- NON_GNU_CPP="/lib/cpp -D_LANGUAGE_C"
NON_GCC_TEST_OPTIONS="-D_LANGUAGE_C"
;;
| i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \
| x86_64-*-solaris2* | x86_64-*-sunos5*)
case "${canonical}" in
- i[3456]86-*-* ) machine=intel386 ;;
- amd64-*-*|x86_64-*-*) machine=amdx86-64 ;;
- sparc* ) machine=sparc ;;
+ i[3456]86-*-* ) ;;
+ amd64-*-*|x86_64-*-*) ;;
+ sparc* ) ;;
* ) unported=yes ;;
esac
case "${canonical}" in
*-sunos5.6* | *-solaris2.6* )
opsys=sol2-6
- NON_GNU_CPP=/usr/ccs/lib/cpp
RANLIB="ar -ts"
;;
*-sunos5.[7-9]* | *-solaris2.[7-9]* )
opsys=sol2-6
emacs_check_sunpro_c=yes
- NON_GNU_CPP=/usr/ccs/lib/cpp
;;
*-sunos5* | *-solaris* )
opsys=sol2-10
emacs_check_sunpro_c=yes
- NON_GNU_CPP=/usr/ccs/lib/cpp
;;
esac
## Watch out for a compiler that we know will not work.
## Intel 386 machines where we don't care about the manufacturer.
i[3456]86-*-* )
- machine=intel386
case "${canonical}" in
*-cygwin ) opsys=cygwin ;;
- *-darwin* ) opsys=darwin
- CPP="${CC-cc} -E -no-cpp-precomp"
- ;;
- *-sysv4.2uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
- *-sysv5uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
- *-sysv5OpenUNIX* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
+ *-darwin* ) opsys=darwin ;;
+ *-sysv4.2uw* ) opsys=unixware ;;
+ *-sysv5uw* ) opsys=unixware ;;
+ *-sysv5OpenUNIX* ) opsys=unixware ;;
## Otherwise, we'll fall through to the generic opsys code at the bottom.
esac
;;
Check `etc/MACHINES' for recognized configuration names.])
fi
-if test -n "$machine"; then
- machfile="m/${machine}.h"
-else
- machfile=
-fi
-opsysfile="s/${opsys}.h"
-
#### Choose a compiler.
-test -n "$CC" && cc_specified=yes
-
-# Save the value of CFLAGS that the user specified.
-SPECIFIED_CFLAGS="$CFLAGS"
dnl Sets GCC=yes if using gcc.
AC_PROG_CC
AM_PROG_CC_C_O
-# Initialize gnulib right after verifying that the C compiler works.
+if test x$GCC = xyes; then
+ test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS"
+else
+ test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
+fi
+
+# Avoid gnulib's threadlib module, as we do threads our own way.
+AC_DEFUN([gl_THREADLIB])
+
+# Initialize gnulib right after choosing the compiler.
gl_EARLY
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
+# It's helpful to have C macros available to GDB, so prefer -g3 to -g
+# if -g3 works and the user does not specify CFLAGS.
+# This test must follow gl_EARLY; otherwise AC_LINK_IFELSE complains.
+if test "$ac_test_CFLAGS" != set; then
+ case $CFLAGS in
+ '-g')
+ emacs_g3_CFLAGS='-g3';;
+ '-g -O2')
+ emacs_g3_CFLAGS='-g3 -O2';;
+ *)
+ emacs_g3_CFLAGS='';;
+ esac
+ if test -n "$emacs_g3_CFLAGS"; then
+ emacs_save_CFLAGS=$CFLAGS
+ CFLAGS=$emacs_g3_CFLAGS
+ AC_CACHE_CHECK([whether $CC accepts $emacs_g3_CFLAGS],
+ [emacs_cv_prog_cc_g3],
+ [AC_LINK_IFELSE([AC_LANG_PROGRAM()],
+ [emacs_cv_prog_cc_g3=yes],
+ [emacs_cv_prog_cc_g3=no])])
+ if test $emacs_cv_prog_cc_g3 = yes; then
+ CFLAGS=$emacs_g3_CFLAGS
+ else
+ CFLAGS=$emacs_save_CFLAGS
+ fi
+ fi
fi
-## If not using gcc, and on Solaris, and no CPP specified, see if
-## using a Sun compiler, which needs -Xs to prevent whitespace.
-if test x"$GCC" != xyes && test x"$emacs_check_sunpro_c" = xyes && \
- test x"$CPP" = x; then
- AC_MSG_CHECKING([whether we are using a Sun C compiler])
- AC_CACHE_VAL(emacs_cv_sunpro_c,
- [AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],
-[[#ifndef __SUNPRO_C
-fail;
+AC_ARG_ENABLE([gcc-warnings],
+ [AS_HELP_STRING([--enable-gcc-warnings],
+ [turn on lots of GCC warnings. This is intended for
+ developers, and may generate false alarms when used
+ with older or non-GNU development tools.])],
+ [case $enableval in
+ yes|no) ;;
+ *) AC_MSG_ERROR([bad value $enableval for gcc-warnings option]) ;;
+ esac
+ gl_gcc_warnings=$enableval],
+ [gl_gcc_warnings=no]
+)
+
+AC_ARG_ENABLE(link-time-optimization,
+[AS_HELP_STRING([--enable-link-time-optimization],
+ [build emacs with link-time optimization.
+ This is supported only for GCC since 4.5.0.])],
+if test "${enableval}" != "no"; then
+ AC_MSG_CHECKING([whether link-time optimization is supported])
+ ac_lto_supported=no
+ if test x$GCC = xyes; then
+ CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null`
+ if test x$CPUS != x; then
+ LTO="-flto=$CPUS"
+ else
+ LTO="-flto"
+ fi
+ old_CFLAGS=$CFLAGS
+ CFLAGS="$CFLAGS $LTO"
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
+ [ac_lto_supported=yes], [ac_lto_supported=no])
+ CFLAGS="$old_CFLAGS"
+ fi
+ AC_MSG_RESULT([$ac_lto_supported])
+ if test "$ac_lto_supported" = "yes"; then
+ CFLAGS="$CFLAGS $LTO"
+ fi
+fi)
+
+# gl_GCC_VERSION_IFELSE([major], [minor], [run-if-found], [run-if-not-found])
+# ------------------------------------------------
+# If $CPP is gcc-MAJOR.MINOR or newer, then run RUN-IF-FOUND.
+# Otherwise, run RUN-IF-NOT-FOUND.
+AC_DEFUN([gl_GCC_VERSION_IFELSE],
+ [AC_PREPROC_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[
+#if ($1) < __GNUC__ || (($1) == __GNUC__ && ($2) <= __GNUC_MINOR__)
+/* ok */
+#else
+# error "your version of gcc is older than $1.$2"
#endif
-]])], emacs_cv_sunpro_c=yes, emacs_cv_sunpro_c=no)])
- AC_MSG_RESULT($emacs_cv_sunpro_c)
+ ]]),
+ ], [$3], [$4])
+ ]
+)
+
+# When compiling with GCC, prefer -isystem to -I when including system
+# include files, to avoid generating useless diagnostics for the files.
+if test "$gl_gcc_warnings" != yes; then
+ isystem='-I'
+else
+ isystem='-isystem '
+
+ # This, $nw, is the list of warnings we disable.
+ nw=
+
+ case $with_x_toolkit in
+ lucid | athena | motif)
+ # Old toolkits mishandle 'const'.
+ nw="$nw -Wwrite-strings"
+ ;;
+ *)
+ gl_WARN_ADD([-Werror], [WERROR_CFLAGS])
+ ;;
+ esac
+ AC_SUBST([WERROR_CFLAGS])
+
+ nw="$nw -Waggregate-return" # anachronistic
+ nw="$nw -Wlong-long" # C90 is anachronistic
+ nw="$nw -Wc++-compat" # We don't care about C++ compilers
+ nw="$nw -Wundef" # Warns on '#if GNULIB_FOO' etc in gnulib
+ nw="$nw -Wtraditional" # Warns on #elif which we use often
+ nw="$nw -Wcast-qual" # Too many warnings for now
+ nw="$nw -Wconversion" # Too many warnings for now
+ nw="$nw -Wsystem-headers" # Don't let system headers trigger warnings
+ nw="$nw -Wsign-conversion" # Too many warnings for now
+ nw="$nw -Woverlength-strings" # Not a problem these days
+ nw="$nw -Wtraditional-conversion" # Too many warnings for now
+ nw="$nw -Wunreachable-code" # so buggy that it's now silently ignored
+ nw="$nw -Wpadded" # Our structs are not padded
+ nw="$nw -Wredundant-decls" # we regularly (re)declare functions
+ nw="$nw -Wlogical-op" # any use of fwrite provokes this
+ nw="$nw -Wformat-nonliteral" # we do this a lot
+ nw="$nw -Wvla" # warnings in gettext.h
+ nw="$nw -Wnested-externs" # use of XARGMATCH/verify_function__
+ nw="$nw -Wswitch-enum" # Too many warnings for now
+ nw="$nw -Wswitch-default" # Too many warnings for now
+ nw="$nw -Wfloat-equal" # warns about high-quality code
+ nw="$nw -Winline" # OK to ignore 'inline'
+ nw="$nw -Wjump-misses-init" # We sometimes safely jump over init.
+ nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning
+ nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations
+
+ # Emacs doesn't care about shadowing; see
+ # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>.
+ nw="$nw -Wshadow"
+
+ # The following lines should be removable at some point.
+ nw="$nw -Wstack-protector"
+ nw="$nw -Wstrict-overflow"
+ nw="$nw -Wsuggest-attribute=pure"
+
+ gl_MANYWARN_ALL_GCC([ws])
+ gl_MANYWARN_COMPLEMENT([ws], [$ws], [$nw])
+ for w in $ws; do
+ gl_WARN_ADD([$w])
+ done
+ gl_WARN_ADD([-Wno-missing-field-initializers]) # We need this one
+ gl_WARN_ADD([-Wno-sign-compare]) # Too many warnings for now
+ gl_WARN_ADD([-Wno-type-limits]) # Too many warnings for now
+ gl_WARN_ADD([-Wno-switch]) # Too many warnings for now
+ gl_WARN_ADD([-Wno-unused-parameter]) # Too many warnings for now
+ gl_WARN_ADD([-Wno-format-nonliteral])
+
+ # In spite of excluding -Wlogical-op above, it is enabled, as of
+ # gcc 4.5.0 20090517.
+ gl_WARN_ADD([-Wno-logical-op])
+
+ gl_WARN_ADD([-fdiagnostics-show-option])
+ gl_WARN_ADD([-funit-at-a-time])
+
+ AC_DEFINE([lint], [1], [Define to 1 if the compiler is checking for lint.])
+ AH_VERBATIM([FORTIFY_SOURCE],
+ [/* Enable compile-time and run-time bounds-checking, and some warnings,
+ without upsetting glibc 2.15+. */
+ #if defined __OPTIMIZE__ && __OPTIMIZE__
+ # define _FORTIFY_SOURCE 2
+ #endif
+ ])
+ AC_DEFINE([GNULIB_PORTCHECK], [1], [enable some gnulib portability checks])
- if test x"$emacs_cv_sunpro_c" = xyes; then
- NON_GNU_CPP="$CC -E -Xs"
- fi
-fi
+ # We use a slightly smaller set of warning options for lib/.
+ # Remove the following and save the result in GNULIB_WARN_CFLAGS.
+ nw=
+ nw="$nw -Wunused-macros"
-#### Some systems specify a CPP to use unless we are using GCC.
-#### Now that we know whether we are using GCC, we can decide whether
-#### to use that one.
-if test "x$NON_GNU_CPP" != x && test x$GCC != xyes && test "x$CPP" = x
-then
- CPP="$NON_GNU_CPP"
+ gl_MANYWARN_COMPLEMENT([GNULIB_WARN_CFLAGS], [$WARN_CFLAGS], [$nw])
+ AC_SUBST([GNULIB_WARN_CFLAGS])
fi
-#### Some systems specify a CC to use unless we are using GCC.
-#### Now that we know whether we are using GCC, we can decide whether
-#### to use that one.
-if test "x$NON_GNU_CC" != x && test x$GCC != xyes &&
- test x$cc_specified != xyes
-then
- CC="$NON_GNU_CC"
-fi
-if test x$GCC = xyes; then
- test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS"
-else
- test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
-fi
-### Use -Wdeclaration-after-statement if the compiler supports it
-AC_MSG_CHECKING([whether gcc understands -Wdeclaration-after-statement])
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wdeclaration-after-statement"
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], has_option=yes, has_option=no)
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wdeclaration-after-statement $C_WARNINGS_SWITCH"
-fi
-AC_MSG_RESULT($has_option)
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-### Use -Wold-style-definition if the compiler supports it
-# This can be removed when conversion to standard C is finished.
-AC_MSG_CHECKING([whether gcc understands -Wold-style-definition])
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wold-style-definition"
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], has_option=yes, has_option=no)
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wold-style-definition $C_WARNINGS_SWITCH"
-fi
-AC_MSG_RESULT($has_option)
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-### Use -Wimplicit-function-declaration if the compiler supports it
-AC_MSG_CHECKING([whether gcc understands -Wimplicit-function-declaration])
-SAVE_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -Wimplicit-function-declaration"
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], has_option=yes, has_option=no)
-if test $has_option = yes; then
- C_WARNINGS_SWITCH="-Wimplicit-function-declaration $C_WARNINGS_SWITCH"
-fi
-AC_MSG_RESULT($has_option)
-CFLAGS="$SAVE_CFLAGS"
-unset has_option
-unset SAVE_CFLAGS
-
-AC_SUBST(C_WARNINGS_SWITCH)
-
-
-#### Some other nice autoconf tests.
-
-dnl checks for programs
-AC_PROG_CPP
-AC_PROG_INSTALL
-if test "x$RANLIB" = x; then
- AC_PROG_RANLIB
-fi
-
-## Although we're running on an amd64 kernel, we're actually compiling for
-## the x86 architecture. The user should probably have provided an
-## explicit --build to `configure', but if everything else than the kernel
-## is running in i386 mode, we can help them out.
-if test "$machine" = "amdx86-64"; then
- AC_CHECK_DECL([i386])
- if test "$ac_cv_have_decl_i386" = "yes"; then
- canonical=`echo "$canonical" | sed -e 's/^amd64/i386/' -e 's/^x86_64/i386/'`
- machine=intel386
- machfile="m/${machine}.h"
- fi
- AC_CHECK_DECL([__ILP32__], [machfile="m/intel386.h"])
-fi
-
-AC_PATH_PROG(INSTALL_INFO, install-info)
-AC_PATH_PROG(INSTALL_INFO, install-info,, /usr/sbin)
-AC_PATH_PROG(INSTALL_INFO, install-info,:, /sbin)
+dnl Some other nice autoconf tests.
+dnl These are commented out, since gl_EARLY and/or Autoconf already does them.
+dnl AC_PROG_INSTALL
+dnl AC_PROG_MKDIR_P
+dnl if test "x$RANLIB" = x; then
+dnl AC_PROG_RANLIB
+dnl fi
+AC_PROG_LN_S
+
+AC_PATH_PROG(INSTALL_INFO, install-info, :,
+ $PATH$PATH_SEPARATOR/usr/sbin$PATH_SEPARATOR/sbin)
dnl Don't use GZIP, which is used by gzip for additional parameters.
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.6 (?) to build the manuals.
+## Need makeinfo >= 4.7 (?) to build the manuals.
AC_PATH_PROG(MAKEINFO, makeinfo, no)
dnl By this stage, configure has already checked for egrep and set EGREP,
dnl or exited with an error if no egrep was found.
if test "$MAKEINFO" != "no" && \
- test x"`$MAKEINFO --version 2> /dev/null | $EGREP 'texinfo[[^0-9]]*([[1-4]][[0-9]]+|[[5-9]]|4\.[[6-9]]|4\.[[1-5]][[0-9]]+)'`" = x; then
+ test x"`$MAKEINFO --version 2> /dev/null | $EGREP 'texinfo[[^0-9]]*([[1-4]][[0-9]]+|[[5-9]]|4\.[[7-9]]|4\.[[1-6]][[0-9]]+)'`" = x; then
MAKEINFO=no
fi
if test "x${with_makeinfo}" = "xno"; then
HAVE_MAKEINFO=no
elif test ! -e $srcdir/info/emacs; then
- AC_MSG_ERROR( [You do not seem to have makeinfo >= 4.6, and your
+ AC_MSG_ERROR( [You do not seem to have makeinfo >= 4.7, and your
source tree does not seem to have pre-built manuals in the `info' directory.
Either install a suitable version of makeinfo, or re-run configure
with the `--without-makeinfo' option to build without the manuals.] )
fi
AC_SUBST(HAVE_MAKEINFO)
+dnl Just so that there is only a single place we need to edit.
+INFO_EXT=.info
+INFO_OPTS=--no-split
+AC_SUBST(INFO_EXT)
+AC_SUBST(INFO_OPTS)
+
dnl Add our options to ac_link now, after it is set up.
if test x$GCC = xyes; then
[AC_MSG_RESULT(no)])
-# The value of CPP is a quoted variable reference, so we need to do this
-# to get its actual value...
-CPP=`eval "echo $CPP"`
-
-
dnl The function dump-emacs will not be defined and temacs will do
dnl (load "loadup") automatically unless told otherwise.
test "x$CANNOT_DUMP" = "x" && CANNOT_DUMP=no
## Let `ld' find image libs and similar things in /usr/local/lib.
## The system compiler, GCC, has apparently been modified to not
## look there, contrary to what a stock GCC would do.
- LD_SWITCH_SYSTEM=-L/usr/local/lib
+### It's not our place to do this. See bug#10313#17.
+### LD_SWITCH_SYSTEM=-L/usr/local/lib
+ :
;;
gnu-linux)
;;
netbsd)
- LD_SWITCH_SYSTEM="-Wl,-rpath,/usr/pkg/lib -L/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib"
+### It's not our place to do this. See bug#10313#17.
+### LD_SWITCH_SYSTEM="-Wl,-rpath,/usr/pkg/lib -L/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib"
+ :
;;
openbsd)
ac_link="$ac_link $LD_SWITCH_SYSTEM"
-## This setting of LD_SWITCH_SYSTEM references LD_SWITCH_X_SITE_AUX,
+## This setting of LD_SWITCH_SYSTEM references LD_SWITCH_X_SITE_RPATH,
## which has not been defined yet. When this was handled with cpp,
## it was expanded to null when configure sourced the s/*.h file.
## Thus LD_SWITCH_SYSTEM had different values in configure and the Makefiles.
## LD_SWITCH_SYSTEM_TEMACS.
case "$opsys" in
netbsd|openbsd)
- ## _AUX_RPATH is like _AUX, but uses -rpath instead of -R.
- LD_SWITCH_SYSTEM="\$(LD_SWITCH_X_SITE_AUX_RPATH) $LD_SWITCH_SYSTEM" ;;
+ LD_SWITCH_SYSTEM="\$(LD_SWITCH_X_SITE_RPATH) $LD_SWITCH_SYSTEM" ;;
esac
C_SWITCH_MACHINE=
-if test "$machine" = "alpha"; then
+case $canonical in
+ alpha*)
AC_CHECK_DECL([__ELF__])
if test "$ac_cv_have_decl___ELF__" = "yes"; then
## With ELF, make sure that all common symbols get allocated to in the
else
UNEXEC_OBJ=unexalpha.o
fi
-fi
+ ;;
+esac
AC_SUBST(C_SWITCH_MACHINE)
AC_SUBST(UNEXEC_OBJ)
# Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them.
AC_DEFUN([AC_TYPE_UID_T])
-dnl Do this early because it can frob feature test macros for Unix-98 &c.
-AC_SYS_LARGEFILE
-
LIB_MATH=-lm
LIB_STANDARD=
START_FILES=
+dnl Current possibilities handled by sed (aix4-2 -> aix,
+dnl gnu-linux -> gnu/linux, etc.):
+dnl gnu, gnu/linux, gnu/kfreebsd, aix, cygwin, darwin, hpux, irix.
+dnl And special cases: berkeley-unix, usg-unix-v, ms-dos, windows-nt.
+SYSTEM_TYPE=`echo $opsys | sed -e 's/[[0-9]].*//' -e 's|-|/|'`
dnl NB do not use CRT_DIR unquoted here, since it might not be set yet.
case $opsys in
START_FILES='pre-crt0.o'
;;
freebsd )
- LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtend.o $(CRT_DIR)/crtn.o'
- START_FILES='pre-crt0.o $(CRT_DIR)/crt1.o $(CRT_DIR)/crti.o $(CRT_DIR)/crtbegin.o'
+ LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtn.o'
+ START_FILES='pre-crt0.o $(CRT_DIR)/crt1.o $(CRT_DIR)/crti.o'
+ SYSTEM_TYPE=berkeley-unix
;;
gnu-linux | gnu-kfreebsd )
LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtn.o'
netbsd | openbsd )
LIB_STANDARD='-lgcc -lc -lgcc $(CRT_DIR)/crtend.o'
START_FILES='pre-crt0.o $(CRT_DIR)/crt0.o $(CRT_DIR)/crtbegin.o'
+ SYSTEM_TYPE=berkeley-unix
+ ;;
+
+ sol2* | unixware )
+ SYSTEM_TYPE=usg-unix-v
;;
+
esac
AC_SUBST(LIB_MATH)
AC_SUBST(START_FILES)
+AC_DEFINE_UNQUOTED(SYSTEM_TYPE, "$SYSTEM_TYPE",
+ [The type of system you are compiling for; sets `system-type'.])
dnl Not all platforms use crtn.o files. Check if the current one does.
crt_files=
esac
+pre_PKG_CONFIG_CFLAGS=$CFLAGS
+pre_PKG_CONFIG_LIBS=$LIBS
+
+AC_PATH_PROG(PKG_CONFIG, pkg-config, no)
+
dnl This function definition taken from Gnome 2.0
dnl PKG_CHECK_MODULES(GSTUFF, gtk+-2.0 >= 1.3 glib = 1.3.4, action-if, action-not)
dnl defines GSTUFF_LIBS, GSTUFF_CFLAGS, see pkg-config man page
AC_DEFUN([PKG_CHECK_MODULES], [
succeeded=no
- AC_PATH_PROG(PKG_CONFIG, pkg-config, no)
-
if test "$PKG_CONFIG" = "no" ; then
ifelse([$4], , [AC_MSG_ERROR([
*** The pkg-config script could not be found. Make sure it is in your path, or give the full path to pkg-config with the PKG_CONFIG environment variable or --with-pkg-config-prog. Or see http://www.freedesktop.org/software/pkgconfig to get pkg-config.])], [$4])
if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then
AC_MSG_CHECKING(for $2)
- if $PKG_CONFIG --exists "$2" 2>&AS_MESSAGE_LOG_FD; then
- AC_MSG_RESULT(yes)
+ if $PKG_CONFIG --exists "$2" 2>&AS_MESSAGE_LOG_FD &&
+ $1_CFLAGS=`$PKG_CONFIG --cflags "$2" 2>&AS_MESSAGE_LOG_FD` &&
+ $1_LIBS=`$PKG_CONFIG --libs "$2" 2>&AS_MESSAGE_LOG_FD`; then
+ edit_cflags="
+ s,///*,/,g
+ s/^/ /
+ s/ -I/ $isystem/g
+ s/^ //
+ "
+ $1_CFLAGS=`AS_ECHO(["$$1_CFLAGS"]) | sed -e "$edit_cflags"`
+ $1_LIBS=`AS_ECHO(["$$1_LIBS"]) | sed -e 's,///*,/,g'`
+ AC_MSG_RESULT([yes CFLAGS='$$1_CFLAGS' LIBS='$$1_LIBS'])
succeeded=yes
-
- AC_MSG_CHECKING($1_CFLAGS)
- $1_CFLAGS=`$PKG_CONFIG --cflags "$2"|sed -e 's,///*,/,g'`
- AC_MSG_RESULT($$1_CFLAGS)
-
- AC_MSG_CHECKING($1_LIBS)
- $1_LIBS=`$PKG_CONFIG --libs "$2"|sed -e 's,///*,/,g'`
- AC_MSG_RESULT($$1_LIBS)
else
AC_MSG_RESULT(no)
$1_CFLAGS=""
$1_LIBS=""
## If we have a custom action on failure, don't print errors, but
- ## do set a variable so people can do so.
- $1_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$2"`
- ifelse([$4], ,echo $$1_PKG_ERRORS,)
+ ## do set a variable so people can do so. Do it in a subshell
+ ## to capture any diagnostics in invoking pkg-config.
+ $1_PKG_ERRORS=`($PKG_CONFIG --print-errors "$2") 2>&1`
+ ifelse([$4], ,echo "$$1_PKG_ERRORS",)
fi
AC_SUBST($1_CFLAGS)
fi
dnl checks for header files
-AC_CHECK_HEADERS(sys/select.h sys/time.h unistd.h utime.h \
- linux/version.h sys/systeminfo.h \
- stdio_ext.h fcntl.h coff.h pty.h sys/mman.h \
- sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \
+AC_CHECK_HEADERS_ONCE(
+ linux/version.h sys/systeminfo.h
+ stdio_ext.h fcntl.h coff.h pty.h
+ sys/vlimit.h sys/resource.h
sys/utsname.h pwd.h utmp.h dirent.h util.h)
AC_MSG_CHECKING(if personality LINUX32 can be set)
fi
AC_HEADER_SYS_WAIT
-dnl Some systems have utime.h but don't declare the struct anyplace.
-AC_CACHE_CHECK(for struct utimbuf, emacs_cv_struct_utimbuf,
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif
-#ifdef HAVE_UTIME_H
-#include <utime.h>
-#endif]], [[static struct utimbuf x; x.actime = x.modtime;]])],
- emacs_cv_struct_utimbuf=yes, emacs_cv_struct_utimbuf=no))
-if test $emacs_cv_struct_utimbuf = yes; then
- AC_DEFINE(HAVE_STRUCT_UTIMBUF, 1, [Define to 1 if `struct utimbuf' is declared by <utime.h>.])
-fi
-
dnl Check for speed_t typedef.
AC_CACHE_CHECK(for speed_t, emacs_cv_speed_t,
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <termios.h>]], [[speed_t x = 1;]])],
[Define to 1 if `speed_t' is declared by <termios.h>.])
fi
-AC_CACHE_CHECK(for struct timeval, emacs_cv_struct_timeval,
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif]], [[static struct timeval x; x.tv_sec = x.tv_usec;]])],
- emacs_cv_struct_timeval=yes, emacs_cv_struct_timeval=no))
-HAVE_TIMEVAL=$emacs_cv_struct_timeval
-if test $emacs_cv_struct_timeval = yes; then
- AC_DEFINE(HAVE_TIMEVAL, 1, [Define to 1 if `struct timeval' is declared by <sys/time.h>.])
-fi
-
-AC_CACHE_CHECK(for struct exception, emacs_cv_struct_exception,
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <math.h>]],
-[[static struct exception x; x.arg1 = x.arg2 = x.retval; x.name = ""; x.type = 1;]])],
- emacs_cv_struct_exception=yes, emacs_cv_struct_exception=no))
-HAVE_EXCEPTION=$emacs_cv_struct_exception
-if test $emacs_cv_struct_exception != yes; then
- AC_DEFINE(NO_MATHERR, 1, [Define to 1 if you don't have struct exception in math.h.])
-fi
-
-AC_CHECK_HEADERS(sys/socket.h)
+AC_CHECK_HEADERS_ONCE(sys/socket.h)
AC_CHECK_HEADERS(net/if.h, , , [AC_INCLUDES_DEFAULT
#if HAVE_SYS_SOCKET_H
#include <sys/socket.h>
#if HAVE_SYS_SOCKET_H
#include <sys/socket.h>
#endif])
-AC_CHECK_FUNCS(getifaddrs freeifaddrs)
dnl checks for structure members
AC_CHECK_MEMBERS([struct ifreq.ifr_flags, struct ifreq.ifr_hwaddr,
#include <net/if.h>
#endif])
-dnl checks for compiler characteristics
-
-dnl Testing __STDC__ to determine prototype support isn't good enough.
-dnl DEC C, for instance, doesn't define it with default options, and
-dnl is used on 64-bit systems (OSF Alphas). Similarly for volatile
-dnl and void *.
-AC_C_PROTOTYPES
-AC_C_VOLATILE
-AC_C_CONST
-AC_CACHE_CHECK([for void * support], emacs_cv_void_star,
- [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[void * foo;]])],
- emacs_cv_void_star=yes, emacs_cv_void_star=no)])
-if test $emacs_cv_void_star = yes; then
- AC_DEFINE(POINTER_TYPE, void)
-else
- AC_DEFINE(POINTER_TYPE, char)
-fi
-AH_TEMPLATE(POINTER_TYPE,
- [Define as `void' if your compiler accepts `void *'; otherwise
- define as `char'.])dnl
-
dnl Check for endianness.
-AC_C_BIGENDIAN
-
-AC_CACHE_CHECK([for __attribute__ ((__aligned__ (expr)))],
- [emacs_cv_attribute_aligned],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM(
- [[char __attribute__ ((__aligned__ (1 << 3))) c;]],
- [[]])],
- [emacs_cv_attribute_aligned=yes],
- [emacs_cv_attribute_aligned=no])])
-if test $emacs_cv_attribute_aligned = yes; then
- AC_DEFINE([HAVE_ATTRIBUTE_ALIGNED], 1,
- [Define to 1 if GCC-style __attribute__ ((__aligned__ (expr))) works.])
-fi
+dnl AC_C_BIGENDIAN is done by gnulib.
dnl check for Make feature
-AC_PROG_MAKE_SET
+dnl AC_PROG_MAKE_SET is done by Automake.
DEPFLAGS=
MKDEPDIR=":"
fi
if test $ac_enable_autodepend = yes; then
DEPFLAGS='-MMD -MF ${DEPDIR}/$*.d -MP'
- ## In parallel builds, another make might create depdir between
- ## the first test and mkdir, so stick another test on the end.
- ## Or use install-sh -d? mkdir -p is not portable.
- MKDEPDIR='test -d ${DEPDIR} || mkdir ${DEPDIR} || test -d ${DEPDIR}'
+ ## MKDIR_P is documented (see AC_PROG_MKDIR_P) to be parallel-safe.
+ MKDEPDIR='${MKDIR_P} ${DEPDIR}'
deps_frag=autodeps.mk
fi
fi
#### Choose a window system.
+## We leave window_system equal to none if
+## we end up building without one. Any new window system should
+## set window_system to an appropriate value and add objects to
+## window-system-specific substs.
+
+window_system=none
AC_PATH_X
-if test "$no_x" = yes; then
- window_system=none
-else
+if test "$no_x" != yes; then
window_system=x11
fi
-## Workaround for bug in autoconf <= 2.62.
-## http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg01551.html
-## No need to do anything special for these standard directories.
-if test -n "${x_libraries}" && test x"${x_libraries}" != xNONE; then
-
- x_libraries=`echo :${x_libraries}: | sed -e 's|:/usr/lib64:|:|g' -e 's|:/lib64:|:|g' -e 's|^:||' -e 's|:$||'`
-
-fi
-
-LD_SWITCH_X_SITE_AUX=
-LD_SWITCH_X_SITE_AUX_RPATH=
+LD_SWITCH_X_SITE_RPATH=
if test "${x_libraries}" != NONE; then
if test -n "${x_libraries}"; then
LD_SWITCH_X_SITE=-L`echo ${x_libraries} | sed -e "s/:/ -L/g"`
- LD_SWITCH_X_SITE_AUX=-R`echo ${x_libraries} | sed -e "s/:/ -R/g"`
- LD_SWITCH_X_SITE_AUX_RPATH=`echo ${LD_SWITCH_X_SITE_AUX} | sed -e 's/-R/-Wl,-rpath,/'`
+ LD_SWITCH_X_SITE_RPATH=-Wl,-rpath,`echo ${x_libraries} | sed -e "s/:/ -Wl,-rpath,/g"`
fi
x_default_search_path=""
x_search_path=${x_libraries}
fi
done
fi
-AC_SUBST(LD_SWITCH_X_SITE_AUX)
-AC_SUBST(LD_SWITCH_X_SITE_AUX_RPATH)
+AC_SUBST(LD_SWITCH_X_SITE_RPATH)
if test "${x_includes}" != NONE && test -n "${x_includes}"; then
- C_SWITCH_X_SITE=-I`echo ${x_includes} | sed -e "s/:/ -I/g"`
+ C_SWITCH_X_SITE="$isystem"`echo ${x_includes} | sed -e "s/:/ $isystem/g"`
fi
if test x"${x_includes}" = x; then
CFLAGS="$CFLAGS -x objective-c"
TEMACS_LDFLAGS2="\${LDFLAGS}"
GNU_OBJC_CFLAGS=
-dnl I don't think it's especially important, but src/Makefile.in
-dnl (now the only user of ns_appdir) used to go to the trouble of adding a
-dnl trailing "/" to it, so now we do it here.
if test "${with_ns}" != no; then
if test "${opsys}" = darwin; then
NS_IMPL_COCOA=yes
ns_appdir=`pwd`/nextstep/Emacs.app
- ns_appbindir=${ns_appdir}/Contents/MacOS/
+ ns_appbindir=${ns_appdir}/Contents/MacOS
ns_appresdir=${ns_appdir}/Contents/Resources
- ns_appsrc=${srcdir}/nextstep/Cocoa/Emacs.base
+ ns_appsrc=Cocoa/Emacs.base
elif test -f $GNUSTEP_CONFIG_FILE; then
NS_IMPL_GNUSTEP=yes
ns_appdir=`pwd`/nextstep/Emacs.app
- ns_appbindir=${ns_appdir}/
+ ns_appbindir=${ns_appdir}
ns_appresdir=${ns_appdir}/Resources
- ns_appsrc=${srcdir}/nextstep/GNUstep/Emacs.base
+ ns_appsrc=GNUstep/Emacs.base
dnl FIXME sourcing this several times in subshells seems inefficient.
GNUSTEP_SYSTEM_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_HEADERS)"
GNUSTEP_SYSTEM_LIBRARIES="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_LIBRARIES)"
AC_CHECK_HEADER([AppKit/AppKit.h], [HAVE_NS=yes],
[AC_MSG_ERROR([`--with-ns' was specified, but the include
files are missing or cannot be compiled.])])
- NS_HAVE_NSINTEGER=yes
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include <Foundation/NSObjCRuntime.h>],
[NSInteger i;])],
ns_have_nsinteger=yes,
ns_have_nsinteger=no)
- if test $ns_have_nsinteger = no; then
- NS_HAVE_NSINTEGER=no
+ if test $ns_have_nsinteger = yes; then
+ AC_DEFINE(NS_HAVE_NSINTEGER, 1, [Define to 1 if `NSInteger' is defined.])
fi
fi
AC_SUBST(TEMACS_LDFLAGS2)
-ns_frag=/dev/null
+INSTALL_ARCH_INDEP_EXTRA=install-etc
+ns_self_contained=no
NS_OBJ=
NS_OBJC_OBJ=
if test "${HAVE_NS}" = yes; then
fi
window_system=nextstep
- with_xft=no
# set up packaging dirs
if test "${EN_NS_SELF_CONTAINED}" = yes; then
+ ns_self_contained=yes
prefix=${ns_appresdir}
exec_prefix=${ns_appbindir}
- libexecdir=${ns_appbindir}/libexec
+ dnl This one isn't really used, only archlibdir is.
+ libexecdir="\${ns_appbindir}/libexec"
+ archlibdir="\${ns_appbindir}/libexec"
+ docdir="\${ns_appresdir}/etc"
+ etcdir="\${ns_appresdir}/etc"
+ dnl FIXME maybe set datarootdir instead.
+ dnl That would also get applications, icons, man.
+ infodir="\${ns_appresdir}/info"
+ mandir="\${ns_appresdir}/man"
+ lispdir="\${ns_appresdir}/lisp"
+ leimdir="\${ns_appresdir}/leim"
+ INSTALL_ARCH_INDEP_EXTRA=
fi
- ns_frag=$srcdir/src/ns.mk
- NS_OBJ="fontset.o fringe.o image.o"
NS_OBJC_OBJ="nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o"
fi
CFLAGS="$tmp_CFLAGS"
CPPFLAGS="$tmp_CPPFLAGS"
+AC_SUBST(INSTALL_ARCH_INDEP_EXTRA)
+AC_SUBST(ns_self_contained)
AC_SUBST(NS_OBJ)
AC_SUBST(NS_OBJC_OBJ)
AC_SUBST(LIB_STANDARD)
-AC_SUBST_FILE(ns_frag)
+
+## $window_system is now set to the window system we will
+## ultimately use.
+
+term_header=
+HAVE_X_WINDOWS=no
+HAVE_X11=no
+USE_X_TOOLKIT=none
case "${window_system}" in
x11 )
HAVE_X_WINDOWS=yes
HAVE_X11=yes
+ term_header=xterm.h
case "${with_x_toolkit}" in
athena | lucid ) USE_X_TOOLKIT=LUCID ;;
motif ) USE_X_TOOLKIT=MOTIF ;;
gtk ) with_gtk=yes
+ term_header=gtkutil.h
dnl Don't set this for GTK. A lot of tests below assumes Xt when
dnl USE_X_TOOLKIT is set.
USE_X_TOOLKIT=none ;;
+ gtk2 ) with_gtk2=yes
+ term_header=gtkutil.h
+ USE_X_TOOLKIT=none ;;
gtk3 ) with_gtk3=yes
+ term_header=gtkutil.h
USE_X_TOOLKIT=none ;;
no ) USE_X_TOOLKIT=none ;;
dnl If user did not say whether to use a toolkit, make this decision later:
* ) USE_X_TOOLKIT=maybe ;;
esac
;;
- nextstep | none )
- HAVE_X_WINDOWS=no
- HAVE_X11=no
- USE_X_TOOLKIT=none
+ nextstep )
+ term_header=nsterm.h
;;
esac
+if test -n "${term_header}"; then
+ AC_DEFINE_UNQUOTED(TERM_HEADER, "${term_header}",
+ [Define to the header for the built-in window system.])
+fi
+
if test "$window_system" = none && test "X$with_x" != "Xno"; then
AC_CHECK_PROG(HAVE_XSERVER, X, true, false)
if test "$HAVE_XSERVER" = true ||
yes ) HAVE_MENUS=yes ;;
esac
-# Do the opsystem or machine files prohibit the use of the GNU malloc?
+# Does the opsystem file prohibit the use of the GNU malloc?
# Assume not, until told otherwise.
GNU_MALLOC=yes
-doug_lea_malloc=yes
-AC_CHECK_FUNC(malloc_get_state, ,doug_lea_malloc=no)
-AC_CHECK_FUNC(malloc_set_state, ,doug_lea_malloc=no)
-AC_CACHE_CHECK(whether __after_morecore_hook exists,
- emacs_cv_var___after_morecore_hook,
-[AC_LINK_IFELSE([AC_LANG_PROGRAM([[extern void (* __after_morecore_hook)();]],[[__after_morecore_hook = 0]])],
- emacs_cv_var___after_morecore_hook=yes,
- emacs_cv_var___after_morecore_hook=no)])
-if test $emacs_cv_var___after_morecore_hook = no; then
- doug_lea_malloc=no
-fi
+
+AC_CACHE_CHECK(
+ [whether malloc is Doug Lea style],
+ [emacs_cv_var_doug_lea_malloc],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <malloc.h>
+ static void hook (void) {}]],
+ [[malloc_set_state (malloc_get_state ());
+ __after_morecore_hook = hook;
+ __malloc_initialize_hook = hook;]])],
+ [emacs_cv_var_doug_lea_malloc=yes],
+ [emacs_cv_var_doug_lea_malloc=no])])
+doug_lea_malloc=$emacs_cv_var_doug_lea_malloc
dnl See comments in aix4-2.h about maybe using system malloc there.
dnl Check if pthreads is available.
LIB_PTHREAD=
-AC_CHECK_HEADERS(pthread.h)
+AC_CHECK_HEADERS_ONCE(pthread.h)
if test "$ac_cv_header_pthread_h"; then
dnl gmalloc.c uses pthread_atfork, which is not available on older-style
dnl hosts such as MirBSD 10, so test for pthread_atfork instead of merely
CPPFLAGS="$C_SWITCH_X_SITE $CPPFLAGS"
# On Solaris, arrange for LD_RUN_PATH to point to the X libraries for tests.
- # This is handled by LD_SWITCH_X_SITE_AUX during the real build,
- # but it's more convenient here to set LD_RUN_PATH
- # since this also works on hosts that don't understand LD_SWITCH_X_SITE_AUX.
+ # This is handled by LD_SWITCH_X_SITE_RPATH during the real build,
+ # but it's more convenient here to set LD_RUN_PATH since this
+ # also works on hosts that don't understand LD_SWITCH_X_SITE_RPATH.
if test "${x_libraries}" != NONE && test -n "${x_libraries}"; then
LD_RUN_PATH=$x_libraries${LD_RUN_PATH+:}$LD_RUN_PATH
export LD_RUN_PATH
fi
AC_CHECK_FUNCS(XrmSetDatabase XScreenResourceString \
-XScreenNumberOfScreen XSetWMProtocols)
+XScreenNumberOfScreen)
fi
if test "${window_system}" = "x11"; then
AC_DEFINE(HAVE_IMAGEMAGICK, 1, [Define to 1 if using imagemagick.])
CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS"
LIBS="$IMAGEMAGICK_LIBS $LIBS"
- AC_CHECK_FUNCS(MagickExportImagePixels)
+ AC_CHECK_FUNCS(MagickExportImagePixels MagickMergeImageLayers)
fi
fi
fi
HAVE_GTK=no
GTK_OBJ=
-if test "${with_gtk3}" = "yes"; then
+check_gtk2=no
+gtk3_pkg_errors=
+if test "${with_gtk3}" = "yes" || test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
GLIB_REQUIRED=2.28
GTK_REQUIRED=3.0
GTK_MODULES="gtk+-3.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
dnl Checks for libraries.
PKG_CHECK_MODULES(GTK, $GTK_MODULES, pkg_check_gtk=yes, pkg_check_gtk=no)
- if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then
+ if test "$pkg_check_gtk" = "no" && test "$with_gtk3" = "yes"; then
AC_MSG_ERROR($GTK_PKG_ERRORS)
fi
- AC_DEFINE(HAVE_GTK3, 1, [Define to 1 if using GTK 3 or later.])
- GTK_OBJ=emacsgtkfixed.o
+ if test "$pkg_check_gtk" = "yes"; then
+ AC_DEFINE(HAVE_GTK3, 1, [Define to 1 if using GTK 3 or later.])
+ GTK_OBJ=emacsgtkfixed.o
+ term_header=gtkutil.h
+ USE_GTK_TOOLKIT="GTK3"
+ else
+ check_gtk2=yes
+ gtk3_pkg_errors="$GTK_PKG_ERRORS "
+ fi
fi
-if test "$pkg_check_gtk" != "yes"; then
- HAVE_GTK=no
-if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then
+if test "${with_gtk2}" = "yes" || test "$check_gtk2" = "yes"; then
GLIB_REQUIRED=2.10
GTK_REQUIRED=2.10
GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
dnl Checks for libraries.
PKG_CHECK_MODULES(GTK, $GTK_MODULES, pkg_check_gtk=yes, pkg_check_gtk=no)
- if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then
- AC_MSG_ERROR($GTK_PKG_ERRORS)
+ if test "$pkg_check_gtk" = "no" &&
+ { test "$with_gtk" = yes || test "$with_gtk2" = "yes"; }
+ then
+ AC_MSG_ERROR($gtk3_pkg_errors$GTK_PKG_ERRORS)
fi
-fi
+ test "$pkg_check_gtk" = "yes" && USE_GTK_TOOLKIT="GTK2"
fi
if test x"$pkg_check_gtk" = xyes; then
gtk_widget_get_mapped gtk_adjustment_get_page_size \
gtk_orientable_set_orientation \
gtk_window_set_has_resize_grip)
+
+ term_header=gtkutil.h
fi
dnl D-Bus has been tested under GNU/Linux only. Must be adapted for
-dnl other platforms. Support for higher D-Bus versions than 1.0 is
-dnl also not configured.
+dnl other platforms.
HAVE_DBUS=no
DBUS_OBJ=
if test "${with_dbus}" = "yes"; then
if test "$HAVE_DBUS" = yes; then
LIBS="$LIBS $DBUS_LIBS"
AC_DEFINE(HAVE_DBUS, 1, [Define to 1 if using D-Bus.])
- AC_CHECK_FUNCS([dbus_watch_get_unix_fd])
+ dnl dbus_watch_get_unix_fd has been introduced in D-Bus 1.1.1.
+ dnl dbus_type_is_valid and dbus_validate_* have been introduced in
+ dnl D-Bus 1.5.12.
+ AC_CHECK_FUNCS(dbus_watch_get_unix_fd \
+ dbus_type_is_valid \
+ dbus_validate_bus_name \
+ dbus_validate_path \
+ dbus_validate_interface \
+ dbus_validate_member)
DBUS_OBJ=dbusbind.o
fi
fi
fi
if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then
+ PKG_CHECK_MODULES(GOBJECT, gobject-2.0 >= 2.0, HAVE_GOBJECT=yes, HAVE_GOBJECT=no)
+ if test "$HAVE_GOBJECT" = "yes"; then
+ SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GOBJECT_CFLAGS"
+ SETTINGS_LIBS="$SETTINGS_LIBS $GOBJECT_LIBS"
+ fi
SAVE_CFLAGS="$CFLAGS"
SAVE_LIBS="$LIBS"
CFLAGS="$SETTINGS_CFLAGS $CFLAGS"
LUCID_LIBW=
if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
if test "$with_xaw3d" != no; then
- AC_MSG_CHECKING(for xaw3d)
AC_CACHE_VAL(emacs_cv_xaw3d,
[AC_LINK_IFELSE([AC_LANG_PROGRAM([[
#include <X11/Intrinsic.h>
emacs_cv_xaw3d=no
fi
if test $emacs_cv_xaw3d = yes; then
+ AC_MSG_CHECKING(for xaw3d)
AC_MSG_RESULT([yes; using Lucid toolkit])
USE_X_TOOLKIT=LUCID
HAVE_XAW3D=yes
AC_DEFINE(HAVE_XAW3D, 1,
[Define to 1 if you have the Xaw3d library (-lXaw3d).])
else
+ AC_MSG_CHECKING(for xaw3d)
AC_MSG_RESULT(no)
AC_MSG_CHECKING(for libXaw)
AC_CACHE_VAL(emacs_cv_xaw,
fi
AC_CHECK_LIB(Xmu, XmuConvertStandardSelection)
test $ac_cv_lib_Xmu_XmuConvertStandardSelection = no && LIBS="$OLDLIBS"
+ dnl ac_cv_lib_Xmu_XmuConvertStandardSelection is also referenced below.
fi
AC_SUBST(LIBXTR6)
LIBXP=
if test "${USE_X_TOOLKIT}" = "MOTIF"; then
- AC_CACHE_CHECK(for Motif version 2.1, emacs_cv_motif_version_2_1,
+ # OpenMotif may be installed in such a way on some GNU/Linux systems.
+ if test -d /usr/include/openmotif; then
+ CPPFLAGS="-I/usr/include/openmotif $CPPFLAGS"
+ emacs_cv_openmotif=yes
+ case "$canonical" in
+ x86_64-*-linux-gnu* | powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*)
+ test -d /usr/lib64/openmotif && LDFLAGS="-L/usr/lib64/openmotif $LDFLAGS"
+ ;;
+ *)
+ test -d /usr/lib/openmotif && LDFLAGS="-L/usr/lib/openmotif $LDFLAGS"
+ esac
+ else
+ emacs_cv_openmotif=no
+ fi
+ AC_CACHE_CHECK(for (Open)Motif version 2.1, emacs_cv_motif_version_2_1,
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <Xm/Xm.h>]],
[[#if XmVERSION > 2 || (XmVERSION == 2 && XmREVISION >= 1)
int x = 5;
emacs_cv_motif_version_2_1=yes, emacs_cv_motif_version_2_1=no)])
if test $emacs_cv_motif_version_2_1 = yes; then
AC_CHECK_LIB(Xp, XpCreateContext, LIBXP=-lXp)
+ if test x$emacs_cv_openmotif = xyes; then
+ REAL_CPPFLAGS="-I/usr/include/openmotif $REAL_CPPFLAGS"
+ fi
else
AC_CACHE_CHECK(for LessTif where some systems put it, emacs_cv_lesstif,
# We put this in CFLAGS temporarily to precede other -I options
if test "${with_png}" != "no"; then
# Debian unstable as of July 2003 has multiple libpngs, and puts png.h
# in /usr/include/libpng.
- AC_CHECK_HEADERS(png.h libpng/png.h)
+ AC_CHECK_HEADERS(png.h libpng/png.h, break)
if test "$ac_cv_header_png_h" = yes || test "$ac_cv_header_libpng_png_h" = yes ; then
AC_CHECK_LIB(png, png_get_channels, HAVE_PNG=yes, , -lz -lm)
fi
if test "${HAVE_PNG}" = "yes"; then
AC_DEFINE(HAVE_PNG, 1, [Define to 1 if you have the png library (-lpng).])
LIBPNG="-lpng -lz -lm"
+
+ AC_CHECK_DECL(png_longjmp,
+ [],
+ [AC_DEFINE(PNG_DEPSTRUCT, [],
+ [Define to empty to suppress deprecation warnings when building
+ with --enable-gcc-warnings and with libpng versions before 1.5,
+ which lack png_longjmp.])],
+ [[#ifdef HAVE_LIBPNG_PNG_H
+ # include <libpng/png.h>
+ #else
+ # include <png.h>
+ #endif
+ ]])
fi
fi
AC_SUBST(LIBPNG)
AC_SUBST(LIBGPM)
dnl Check for malloc/malloc.h on darwin
-AC_CHECK_HEADER(malloc/malloc.h, [AC_DEFINE(HAVE_MALLOC_MALLOC_H, 1, [Define to 1 if you have the <malloc/malloc.h> header file.])])
+AC_CHECK_HEADERS_ONCE(malloc/malloc.h)
-C_SWITCH_X_SYSTEM=
+GNUSTEP_CFLAGS=
### Use NeXTstep API to implement GUI.
if test "${HAVE_NS}" = "yes"; then
AC_DEFINE(HAVE_NS, 1, [Define to 1 if you are using the NeXTstep API, either GNUstep or Cocoa on Mac OS X.])
AC_DEFINE(NS_IMPL_GNUSTEP, 1, [Define to 1 if you are using NS windowing under GNUstep.])
# See also .m.o rule in Makefile.in */
# FIXME: are all these flags really needed? Document here why. */
- dnl FIXME this should be renamed to GNUSTEP_CFLAGS, and only
- dnl used in src/Makefile.in.
- C_SWITCH_X_SYSTEM="-D_REENTRANT -fPIC -fno-strict-aliasing -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
+ GNUSTEP_CFLAGS="-D_REENTRANT -fPIC -fno-strict-aliasing -I${GNUSTEP_SYSTEM_HEADERS} ${GNUSTEP_LOCAL_HEADERS}"
## Extra CFLAGS applied to src/*.m files.
GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fgnu-runtime -Wno-import -fconstant-string-class=NSConstantString -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 -DGNU_RUNTIME=1 -DGSWARN -DGSDIAGNOSE"
fi
- if test "${NS_HAVE_NSINTEGER}" = "yes"; then
- AC_DEFINE(NS_HAVE_NSINTEGER, 1, [Define to 1 if `NSInteger' is defined.])
- fi
# We also have mouse menus.
HAVE_MENUS=yes
OTHER_FILES=ns-app
AC_DEFINE(HAVE_H_ERRNO, 1, [Define to 1 if netdb.h declares h_errno.])
fi
-# fmod, logb, and frexp are found in -lm on most systems.
-# On HPUX 9.01, -lm does not contain logb, so check for sqrt.
+# sqrt and other floating-point functions such as fmod and frexp
+# are found in -lm on most systems.
AC_CHECK_LIB(m, sqrt)
# Check for mail-locking functions in a "mail" library. Probably this should
There may be a `development' package to install containing liblockfile.])
fi
fi
-AC_CHECK_FUNCS(touchlock)
-AC_CHECK_HEADERS(maillock.h)
+AC_CHECK_HEADERS_ONCE(maillock.h)
AC_SUBST(LIBS_MAIL)
## Define MAIL_USE_FLOCK (or LOCKF) if the mailer uses flock (or lockf) to
AC_SUBST(BLESSMAIL_TARGET)
-AC_CHECK_FUNCS(gethostname getdomainname \
-rename closedir mkdir rmdir sysinfo getrusage get_current_dir_name \
-random lrand48 logb frexp fmod rint cbrt ftime setsid \
-strerror fpathconf select euidaccess getpagesize tzset setlocale \
-utimes getrlimit setrlimit setpgid getcwd getwd shutdown getaddrinfo \
-__fpending mblen mbrlen mbsinit strsignal setitimer ualarm \
-sendto recvfrom getsockopt setsockopt getsockname getpeername \
-gai_strerror mkstemp getline getdelim mremap fsync sync \
-difftime mempcpy mblen mbrlen posix_memalign \
+AC_CHECK_FUNCS(gethostname \
+closedir getrusage get_current_dir_name \
+lrand48 setsid \
+fpathconf select euidaccess getpagesize setlocale \
+utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \
+__fpending strsignal setitimer \
+sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \
+gai_strerror mkstemp getline getdelim fsync sync \
+difftime posix_memalign \
+getpwent endpwent getgrent endgrent \
+touchlock \
cfmakeraw cfsetspeed copysign __executable_start)
+dnl getwd appears to be buggy on SVR4.2, so we don't use it.
+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
+
+## Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines
+## has a broken `rint' in some library versions including math library
+## version number A.09.05.
+## You can fix the math library by installing patch number PHSS_4630.
+## But we can fix it more reliably for Emacs by just not using rint.
+## We also skip HAVE_RANDOM - see comments in src/conf_post.h.
+case $opsys in
+ hpux*) : ;;
+ *) AC_CHECK_FUNCS(random rint) ;;
+esac
+
dnl Cannot use AC_CHECK_FUNCS
AC_CACHE_CHECK([for __builtin_unwind_init],
emacs_cv_func___builtin_unwind_init,
[Define to 1 if you have the `__builtin_unwind_init' function.])
fi
-AC_CHECK_HEADERS(sys/un.h)
+AC_CHECK_HEADERS_ONCE(sys/un.h)
AC_FUNC_FSEEKO
AC_CHECK_FUNCS(grantpt)
# PTY-related GNU extensions.
-AC_CHECK_FUNCS(getpt)
+AC_CHECK_FUNCS(getpt posix_openpt)
# Check this now, so that we will NOT find the above functions in ncurses.
# That is because we have not set up to link ncurses in lib-src.
])
# Maybe curses should be tried earlier?
# See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35
-for tputs_library in '' ncurses terminfo termcap curses; do
+for tputs_library in '' tinfo ncurses terminfo termcap curses; do
OLIBS=$LIBS
if test -z "$tputs_library"; then
LIBS_TERMCAP=
AC_MSG_RESULT([$msg])
if test "X$msg" = Xno; then
AC_MSG_ERROR([The required function `tputs' was not found in any library.
-These libraries were tried: libncurses, libterminfo, libtermcap, libcurses.
+The following libraries were tried (in order):
+ libtinfo, libncurses, libterminfo, libtermcap, libcurses
Please try installing whichever of these libraries is most appropriate
for your system, together with its header files.
For example, a libncurses-dev(el) or similar package.])
fi
-# Must define this when any termcap library is found.
-AC_DEFINE(HAVE_LIBNCURSES, 1,
- [Define to 1 if you have the `ncurses' library (-lncurses).])
-## FIXME This was the cpp logic, but I am not sure it is right.
-## The above test has not necessarily found libncurses.
-HAVE_LIBNCURSES=yes
-
-## Use terminfo instead of termcap?
-## Note only system files NOT using terminfo are:
-## freebsd < 40000, ms-w32, msdos, netbsd < 599002500, and
-## darwin|gnu without ncurses.
-TERMINFO=no
-case "$opsys" in
- ## cygwin: Fewer environment variables to go wrong, more terminal types.
- ## hpux10-20: Use the system provided termcap(3) library.
- ## openbsd: David Mazieres <dm@reeducation-labor.lcs.mit.edu> says this
- ## is necessary. Otherwise Emacs dumps core when run -nw.
- aix4-2|cygwin|hpux*|irix6-5|openbsd|sol2*|unixware) TERMINFO=yes ;;
+## Use termcap instead of terminfo?
+## Only true for: freebsd < 40000, ms-w32, msdos, netbsd < 599002500.
+TERMINFO=yes
+## FIXME? In the cases below where we unconditionally set
+## LIBS_TERMCAP="-lncurses", this overrides LIBS_TERMCAP = -ltinfo,
+## if that was found above to have tputs.
+## Should we use the gnu* logic everywhere?
+case "$opsys" in
## darwin: Prevents crashes when running Emacs in Terminal.app under 10.2.
## The ncurses library has been moved out of the System framework in
## Mac OS X 10.2. So if configure detects it, set the command-line
## option to use it.
- darwin|gnu*)
- ## (HAVE_LIBNCURSES was not always true, but is since 2010-03-18.)
- if test "x$HAVE_LIBNCURSES" = "xyes"; then
- TERMINFO=yes
- LIBS_TERMCAP="-lncurses"
- fi
- ;;
+ darwin) LIBS_TERMCAP="-lncurses" ;;
+
+ gnu*) test -z "$LIBS_TERMCAP" && LIBS_TERMCAP="-lncurses" ;;
freebsd)
AC_MSG_CHECKING([whether FreeBSD is new enough to use terminfo])
AC_MSG_RESULT($emacs_cv_freebsd_terminfo)
if test $emacs_cv_freebsd_terminfo = yes; then
- TERMINFO=yes
LIBS_TERMCAP="-lncurses"
else
+ TERMINFO=no
LIBS_TERMCAP="-ltermcap"
fi
;;
netbsd)
- if test "x$LIBS_TERMCAP" = "x-lterminfo"; then
- TERMINFO=yes
- else
+ if test "x$LIBS_TERMCAP" != "x-lterminfo"; then
+ TERMINFO=no
LIBS_TERMCAP="-ltermcap"
fi
;;
-esac
+ openbsd) LIBS_TERMCAP="-lncurses" ;;
-case "$opsys" in
## hpux: Make sure we get select from libc rather than from libcurses
## because libcurses on HPUX 10.10 has a broken version of select.
## We used to use -lc -lcurses, but this may be cleaner.
+ ## FIXME? But TERMINFO = yes on hpux (it used to be explicitly
+ # set that way, now it uses the default). Isn't this a contradiction?
hpux*) LIBS_TERMCAP="-ltermcap" ;;
- openbsd) LIBS_TERMCAP="-lncurses" ;;
-
- ## Must use system termcap, if we use any termcap. It does special things.
- sol2*) test "$TERMINFO" != yes && LIBS_TERMCAP="-ltermcap" ;;
esac
TERMCAP_OBJ=tparam.o
# Do we have res_init, for detecting changes in /etc/resolv.conf?
+# On Darwin, res_init appears not to be useful: see bug#562 and
+# http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html
resolv=no
-AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
+
+if test $opsys != darwin; then
+
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
#include <arpa/nameser.h>
#include <resolv.h>]],
[[return res_init();]])],
have_res_init=yes, have_res_init=no)
-if test "$have_res_init" = no; then
- OLIBS="$LIBS"
- LIBS="$LIBS -lresolv"
- AC_MSG_CHECKING(for res_init with -lresolv)
- AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
+ if test "$have_res_init" = no; then
+ OLIBS="$LIBS"
+ LIBS="$LIBS -lresolv"
+ AC_MSG_CHECKING(for res_init with -lresolv)
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
#include <arpa/nameser.h>
#include <resolv.h>]],
- [[return res_init();]])],
- have_res_init=yes, have_res_init=no)
- AC_MSG_RESULT($have_res_init)
- if test "$have_res_init" = yes ; then
- resolv=yes
+ [[return res_init();]])],
+ have_res_init=yes, have_res_init=no)
+ AC_MSG_RESULT($have_res_init)
+ if test "$have_res_init" = yes ; then
+ resolv=yes
+ fi
+ LIBS="$OLIBS"
fi
- LIBS="$OLIBS"
-fi
-if test "$have_res_init" = yes; then
- AC_DEFINE(HAVE_RES_INIT, 1, [Define to 1 if res_init is available.])
-fi
+ if test "$have_res_init" = yes; then
+ AC_DEFINE(HAVE_RES_INIT, 1, [Define to 1 if res_init is available.])
+ fi
+fi dnl !darwin
# Do we need the Hesiod library to provide the support routines?
+dnl FIXME? Should we be skipping this on Darwin too?
LIBHESIOD=
if test "$with_hesiod" != no ; then
# Don't set $LIBS here -- see comments above. FIXME which comments?
AC_SUBST(LIBHESIOD)
# Do we need libresolv (due to res_init or Hesiod)?
-if test "$resolv" = yes ; then
+if test "$resolv" = yes && test $opsys != darwin; then
AC_DEFINE(HAVE_LIBRESOLV, 1,
[Define to 1 if you have the resolv library (-lresolv).])
LIBRESOLV=-lresolv
AC_SUBST(DESLIB)
AC_SUBST(KRB4LIB)
+AC_CHECK_FUNCS_ONCE(tzset)
AC_MSG_CHECKING(whether localtime caches TZ)
AC_CACHE_VAL(emacs_cv_localtime_cache,
[if test x$ac_cv_func_tzset = xyes; then
[Define to 1 if localtime caches TZ.])
fi
-if test "x$HAVE_TIMEVAL" = xyes; then
- AC_CHECK_FUNCS(gettimeofday)
- if test $ac_cv_func_gettimeofday = yes; then
- AC_CACHE_CHECK(whether gettimeofday can accept two arguments,
- emacs_cv_gettimeofday_two_arguments,
- [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif]],
- [[struct timeval time;
- gettimeofday (&time, 0);]])],
- emacs_cv_gettimeofday_two_arguments=yes,
- emacs_cv_gettimeofday_two_arguments=no)])
- if test $emacs_cv_gettimeofday_two_arguments = no; then
- AC_DEFINE(GETTIMEOFDAY_ONE_ARGUMENT, 1,
- [Define to 1 if gettimeofday accepts only one argument.])
- fi
- fi
-fi
-
ok_so_far=yes
AC_CHECK_FUNC(socket, , ok_so_far=no)
if test $ok_so_far = yes; then
AC_MSG_RESULT(no)
fi
+dnl Check for a Solaris 2.4 vfork bug that Autoconf misses (through 2.69).
+dnl This can be removed once we assume Autoconf 2.70.
+case $canonical in
+ *-solaris2.4 | *-solaris2.4.*)
+ dnl Disable the Autoconf-generated vfork test.
+ : ${ac_cv_func_vfork_works=no};;
+esac
+
AC_FUNC_FORK
AC_CHECK_FUNCS(snprintf)
dnl AC_DEFINE(HAVE_TCATTR, 1, [Define to 1 if you have tcgetattr and tcsetattr.])
dnl fi
+dnl Turned on June 1996 supposing nobody will mind it.
+AC_DEFINE(AMPERSAND_FULL_NAME, 1, [Define to use the convention that &
+ in the full name stands for the login id.])
+
+dnl Every platform that uses configure (ie every non-MS platform)
+dnl supports this. There is a create-lockfiles option you can
+dnl customize if you do not want the lock files to be written.
+dnl So it is not clear that this #define still needs to exist.
+AC_DEFINE(CLASH_DETECTION, 1, [Define if you want lock files to be written,
+ so that Emacs can tell instantly when you try to modify a file that
+ someone else has modified in his/her Emacs.])
+
+dnl Everybody supports this, except MS.
+dnl Seems like the kind of thing we should be testing for, though.
+## Note: PTYs are broken on darwin <6. Use at your own risk.
+AC_DEFINE(HAVE_PTYS, 1, [Define if the system supports pty devices.])
+
+dnl Everybody supports this, except MS-DOS.
+dnl Seems like the kind of thing we should be testing for, though.
+dnl Compare with HAVE_INET_SOCKETS (which is unused...) above.
+AC_DEFINE(HAVE_SOCKETS, 1, [Define if the system supports
+ 4.2-compatible sockets.])
+
+AH_TEMPLATE(INTERNAL_TERMINAL, [This is substituted when $TERM is "internal".])
+
+AC_DEFINE(NULL_DEVICE, ["/dev/null"], [Name of the file to open to get
+ a null file, or a data sink.])
+
+AC_DEFINE(SEPCHAR, [':'], [Character that separates PATH elements.])
+
+dnl Everybody supports this, except MS-DOS.
+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.])
+
+AC_DEFINE(IS_DEVICE_SEP(_c_), 0,
+ [Returns true if character is a device separator.])
+
+AC_DEFINE(IS_DIRECTORY_SEP(_c_), [((_c_) == DIRECTORY_SEP)],
+ [Returns true if character is a directory separator.])
+
+dnl On MS, this also accepts IS_DEVICE_SEP.
+AC_DEFINE(IS_ANY_SEP(_c_), [(IS_DIRECTORY_SEP (_c_))],
+ [Returns true if character is any form of separator.])
+
+
+AH_TEMPLATE(NO_EDITRES, [Define if XEditRes should not be used.])
+
+case $opsys in
+ aix4-2)
+ dnl Unfortunately without libXmu we cannot support EditRes.
+ if test x$ac_cv_lib_Xmu_XmuConvertStandardSelection != xyes; then
+ AC_DEFINE(NO_EDITRES, 1)
+ fi
+ ;;
+
+ hpux*)
+ dnl Assar Westerlund <assar@sics.se> says this is necessary for
+ dnl HP-UX 10.20, and that it works for HP-UX 0 as well.
+ AC_DEFINE(NO_EDITRES, 1)
+ ;;
+esac
+
+
+case $opsys in
+ irix6-5 | sol2* | unixware )
+ dnl Some SVr4s don't define NSIG in sys/signal.h for ANSI environments;
+ dnl instead, there's a system variable _sys_nsig. Unfortunately, we
+ dnl need the constant to dimension an array. So wire in the appropriate
+ dnl value here.
+ AC_DEFINE(NSIG_MINIMUM, 32, [Minimum value of NSIG.])
+ ;;
+esac
+
+emacs_broken_SIGIO=no
+
+case $opsys in
+ dnl SIGIO exists, but the feature doesn't work in the way Emacs needs.
+ dnl See eg <http://article.gmane.org/gmane.os.openbsd.ports/46831>.
+ hpux* | irix6-5 | openbsd | sol2* | unixware )
+ emacs_broken_SIGIO=yes
+ ;;
+
+ aix4-2)
+ dnl On AIX Emacs uses the gmalloc.c malloc implementation. But given
+ dnl the way this system works, libc functions that return malloced
+ dnl memory use the libc malloc implementation. Calling xfree or
+ dnl xrealloc on the results of such functions results in a crash.
+ dnl
+ dnl One solution for this could be to define SYSTEM_MALLOC in configure,
+ dnl but that does not currently work on this system.
+ dnl
+ dnl It is possible to completely override the malloc implementation on
+ dnl AIX, but that involves putting the malloc functions in a shared
+ dnl library and setting the MALLOCTYPE environment variable to point to
+ dnl that shared library.
+ dnl
+ dnl Emacs currently calls xrealloc on the results of get_current_dir name,
+ dnl to avoid a crash just use the Emacs implementation for that function.
+ dnl
+ dnl FIXME We could change the AC_CHECK_FUNCS call near the start
+ dnl of this file, so that we do not check for get_current_dir_name
+ dnl on AIX. But that might be fragile if something else ends
+ dnl up testing for get_current_dir_name as a dependency.
+ AC_DEFINE(BROKEN_GET_CURRENT_DIR_NAME, 1, [Define if
+ get_current_dir_name should not be used.])
+ ;;
+
+ freebsd)
+ dnl Circumvent a bug in FreeBSD. In the following sequence of
+ dnl writes/reads on a PTY, read(2) returns bogus data:
+ dnl
+ dnl write(2) 1022 bytes
+ dnl write(2) 954 bytes, get EAGAIN
+ dnl read(2) 1024 bytes in process_read_output
+ dnl read(2) 11 bytes in process_read_output
+ dnl
+ dnl That is, read(2) returns more bytes than have ever been written
+ dnl successfully. The 1033 bytes read are the 1022 bytes written
+ dnl successfully after processing (for example with CRs added if the
+ dnl terminal is set up that way which it is here). The same bytes will
+ dnl be seen again in a later read(2), without the CRs.
+ AC_DEFINE(BROKEN_PTY_READ_AFTER_EAGAIN, 1, [Define on FreeBSD to
+ work around an issue when reading from a PTY.])
+ ;;
+esac
+
+case $opsys in
+ gnu-* | sol2-10 )
+ dnl FIXME Can't we test if this exists (eg /proc/$$)?
+ AC_DEFINE(HAVE_PROCFS, 1, [Define if you have the /proc filesystem.])
+ ;;
+esac
+
+case $opsys in
+ darwin | freebsd | netbsd | openbsd )
+ AC_DEFINE(DONT_REOPEN_PTY, 1, [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).])
+ ;;
+esac
+
+dnl FIXME Surely we can test for this rather than hard-code it.
+case $opsys in
+ netbsd | openbsd) sound_device="/dev/audio" ;;
+ *) sound_device="/dev/dsp" ;;
+esac
+
+dnl Used in sound.c
+AC_DEFINE_UNQUOTED(DEFAULT_SOUND_DEVICE, "$sound_device",
+ [Name of the default sound device.])
+
+
+dnl Emacs can read input using SIGIO and buffering characters itself,
+dnl or using CBREAK mode and making C-g cause SIGINT.
+dnl The choice is controlled by the variable interrupt_input.
+dnl
+dnl Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO)
+dnl
+dnl Emacs uses the presence of the USABLE_SIGIO macro
+dnl to indicate whether or not signal-driven I/O is possible. It uses
+dnl INTERRUPT_INPUT to decide whether to use it by default.
+dnl
+dnl SIGIO can be used only on systems that implement it (4.2 and 4.3).
+dnl CBREAK mode has two disadvantages
+dnl 1) At least in 4.2, it is impossible to handle the Meta key properly.
+dnl I hear that in system V this problem does not exist.
+dnl 2) Control-G causes output to be discarded.
+dnl I do not know whether this can be fixed in system V.
+dnl
+dnl Another method of doing input is planned but not implemented.
+dnl It would have Emacs fork off a separate process
+dnl to read the input and send it to the true Emacs process
+dnl through a pipe.
+case $opsys in
+ darwin | gnu-linux | gnu-kfreebsd )
+ AC_DEFINE(INTERRUPT_INPUT, 1, [Define to read input using SIGIO.])
+ ;;
+esac
+
+
+dnl If the system's imake configuration file defines `NeedWidePrototypes'
+dnl as `NO', we must define NARROWPROTO manually. Such a define is
+dnl generated in the Makefile generated by `xmkmf'. If we don't define
+dnl NARROWPROTO, we will see the wrong function prototypes for X functions
+dnl taking float or double parameters.
+case $opsys in
+ cygwin|gnu|gnu-linux|gnu-kfreebsd|irix6-5|freebsd|netbsd|openbsd)
+ AC_DEFINE(NARROWPROTO, 1, [Define if system's imake configuration
+ file defines `NeedWidePrototypes' as `NO'.])
+ ;;
+esac
+
+
+dnl Used in process.c, this must be a loop, even if it only runs once.
+dnl (Except on SGI; see below. Take that, clarity and consistency!)
+AH_TEMPLATE(PTY_ITERATION, [How to iterate over PTYs.])
+dnl Only used if !PTY_ITERATION. Iterate from FIRST_PTY_LETTER to z,
+dnl trying suffixes 0-16.
+AH_TEMPLATE(FIRST_PTY_LETTER, [Letter to use in finding device name of
+ first PTY, if PTYs are supported.])
+AH_TEMPLATE(PTY_OPEN, [How to open a PTY, if non-standard.])
+AH_TEMPLATE(PTY_NAME_SPRINTF, [How to get the device name of the control
+ end of a PTY, if non-standard.])
+AH_TEMPLATE(PTY_TTY_NAME_SPRINTF, [How to get device name of the tty
+ end of a PTY, if non-standard.])
+
+case $opsys in
+ aix4-2 )
+ 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));])
+ ;;
+
+ cygwin )
+ 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; sigset_t blocked, procmask; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, &procmask); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; pthread_sigmask (SIG_SETMASK, &procmask, 0); if (fd >= 0) emacs_close (dummy); } while (0)])
+ AC_DEFINE(PTY_NAME_SPRINTF, [])
+ AC_DEFINE(PTY_TTY_NAME_SPRINTF, [])
+ ;;
+
+ dnl FIXME? Maybe use same as freebsd - see bug#12040.
+ darwin )
+ 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, [])
+ ;;
+
+ gnu | openbsd )
+ AC_DEFINE(FIRST_PTY_LETTER, ['p'])
+ ;;
+
+ gnu-linux | gnu-kfreebsd | freebsd | netbsd )
+ 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++)])
+ 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 = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }])
+ dnl if HAVE_POSIX_OPENPT
+ if test "x$ac_cv_func_posix_openpt" = xyes; then
+ AC_DEFINE(PTY_OPEN, [fd = posix_openpt (O_RDWR | O_NOCTTY)])
+ AC_DEFINE(PTY_NAME_SPRINTF, [])
+ dnl if HAVE_GETPT
+ elif test "x$ac_cv_func_getpt" = xyes; then
+ AC_DEFINE(PTY_OPEN, [fd = getpt ()])
+ AC_DEFINE(PTY_NAME_SPRINTF, [])
+ else
+ AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");])
+ fi
+ else
+ AC_DEFINE(FIRST_PTY_LETTER, ['p'])
+ fi
+ ;;
+
+ 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);])
+ ;;
+
+ irix6-5 )
+ dnl It looks like this cannot be right, because it is not a loop.
+ dnl However, process.c actually does this:
+ dnl # ifndef __sgi
+ dnl continue;
+ dnl # else
+ dnl return -1;
+ dnl # endif
+ dnl which presumably makes it OK, since irix == sgi (?).
+ dnl FIXME it seems like this special treatment is unnecessary?
+ dnl Why can't irix use a single-trip loop like eg cygwin?
+ 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); }])
+ dnl No need to get the pty name at all.
+ 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, [])
+ ;;
+
+ sol2* )
+ 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; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(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; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); 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
+
+
+case $opsys in
+ sol2* | unixware )
+ 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");])
+ 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.])
+ ;;
+esac
+
+
+AH_TEMPLATE(SIGNALS_VIA_CHARACTERS, [Make process_send_signal work by
+"typing" a signal character on the pty.])
+
+case $opsys in
+ dnl Perry Smith <pedz@ddivt1.austin.ibm.com> says this is correct for AIX.
+ dnl thomas@mathematik.uni-bremen.de says this is needed for IRIX.
+ aix4-2 | cygwin | gnu | irix6-5 | freebsd | netbsd | openbsd )
+ AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1)
+ ;;
+
+ dnl 21 Jun 06: Eric Hanchrow <offby1@blarg.net> says this works.
+ dnl FIXME Does gnu-kfreebsd have linux/version.h? It seems unlikely...
+ gnu-linux | gnu-kfreebsd )
+
+ AC_MSG_CHECKING([for signals via characters])
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#include <linux/version.h>
+#if LINUX_VERSION_CODE < 0x20400
+# error "Linux version too old"
+#endif
+ ]], [[]])], emacs_signals_via_chars=yes, emacs_signals_via_chars=no)
+
+ AC_MSG_RESULT([$emacs_signals_via_chars])
+ test $emacs_signals_via_chars = yes && AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1)
+ ;;
+esac
+
+
+dnl Used in dispnew.c
+AH_TEMPLATE(PENDING_OUTPUT_COUNT, [Number of chars of output in the
+ buffer of a stdio stream.])
+
+AC_MSG_CHECKING([whether we are using the GNU C library])
+AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#include <features.h>
+#ifndef __GNU_LIBRARY__
+# error "this is not the GNU C library"
+#endif
+ ]], [[]])], emacs_glibc=yes, emacs_glibc=no)
+AC_MSG_RESULT([$emacs_glibc])
+
+if test $emacs_glibc = yes; then
+
+ emacs_pending_output=unknown
+
+ 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 <stdio.h>
+#if !defined (_IO_STDIO_H) && !defined (_STDIO_USES_IOSTREAM)
+# error "stdio definitions not found"
+#endif
+ ]], [[]])], emacs_pending_output=new, [])
+
+ if test $emacs_pending_output = unknown; then
+ case $opsys in
+ gnu-linux | gnu-kfreebsd)
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#include <stdio.h>
+#ifndef __UCLIBC__
+# error "not using uclibc"
+#endif
+ ]], [[]])], emacs_pending_output=uclibc, emacs_pending_output=old)
+ ;;
+ esac
+ fi
+
+ AC_MSG_RESULT([$emacs_pending_output])
+
+ case $emacs_pending_output in
+ new)
+ dnl New C libio names.
+ AC_DEFINE(PENDING_OUTPUT_COUNT(FILE),
+ [((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)])
+ ;;
+ uclibc)
+ dnl Using the uClibc library.
+ AC_DEFINE(PENDING_OUTPUT_COUNT(FILE),
+ [((FILE)->__bufpos - (FILE)->__bufstart)])
+ ;;
+ old)
+ dnl Old C++ iostream names.
+ AC_DEFINE(PENDING_OUTPUT_COUNT(FILE),
+ [((FILE)->_pptr - (FILE)->_pbase)])
+ ;;
+ 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
+AH_TEMPLATE(DATA_START, [Address of the start of the data segment.])
+dnl Used in lisp.h, emacs.c, mem-limits.h
+dnl NEWS.18 describes this as "a number which contains
+dnl the high bits to be inclusive or'ed with pointers that are unpacked."
+AH_TEMPLATE(DATA_SEG_BITS, [Extra bits to be or'd in with any pointers
+stored in a Lisp_Object.])
+dnl if Emacs uses fewer than 32 bits for the value field of a LISP_OBJECT.
+
+case $opsys in
+ gnu)
+ dnl libc defines data_start.
+ AC_DEFINE(DATA_START, [({ extern int data_start; (char *) &data_start; })])
+ ;;
+
+ hpux*)
+ dnl The data segment on this machine always starts at address 0x40000000.
+ AC_DEFINE(DATA_START, [0x40000000])
+ AC_DEFINE(DATA_SEG_BITS, [0x40000000])
+ ;;
+ irix6-5)
+ AC_DEFINE(DATA_START, [0x10000000])
+ AC_DEFINE(DATA_SEG_BITS, [0x10000000])
+ ;;
+esac
+
+
+AH_TEMPLATE(ULIMIT_BREAK_VALUE, [Undocumented.])
+AH_TEMPLATE(TAB3, [Undocumented.])
+
+case $opsys in
+ darwin) AC_DEFINE(TAB3, OXTABS) ;;
+
+ gnu | freebsd | netbsd | openbsd )
+ AC_DEFINE(TABDLY, OXTABS, [Undocumented.])
+ AC_DEFINE(TAB3, OXTABS)
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+ dnl libc-linux/sysdeps/linux/i386/ulimit.c says that due to shared
+ dnl library, we cannot get the maximum address for brk.
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#ifndef __i386__
+# error "not i386"
+#endif
+ ]], [[]])], AC_DEFINE(ULIMIT_BREAK_VALUE, [(32*1024*1024)]), [])
+
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#ifndef __ia64__
+# error "not ia64"
+#endif
+ ]], [[]])], AC_DEFINE(GC_MARK_SECONDARY_STACK(),
+ [do { extern void *__libc_ia64_register_backing_store_base; __builtin_ia64_flushrs (); mark_memory (__libc_ia64_register_backing_store_base, __builtin_ia64_bsp ());} while (0)],
+ [Mark a secondary stack, like the register stack on the ia64.]), [])
+ ;;
+
+ hpux*)
+ AC_DEFINE(RUN_TIME_REMAP, 1, [Define if emacs.c needs to call
+ run_time_remap; for HPUX.])
+ ;;
+
+ irix6-5)
+ dnl Ulimit(UL_GMEMLIM) is busted...
+ AC_DEFINE(ULIMIT_BREAK_VALUE, [0x14000000])
+ ;;
+esac
+
+
+dnl These won't be used automatically yet. We also need to know, at least,
+dnl that the stack is continuous.
+AH_TEMPLATE(GC_SETJMP_WORKS, [Define if setjmp is known to save all
+ registers relevant for conservative garbage collection in the jmp_buf.])
+
+AH_TEMPLATE(GC_MARK_STACK, [Define to GC_USE_GCPROS_AS_BEFORE if
+ conservative garbage collection is not known to work.])
+
+
+case $opsys in
+ aix4-2 | hpux* | unixware)
+ dnl Conservative garbage collection has not been tested, so for now
+ dnl play it safe and stick with the old-fashioned way of marking.
+ AC_DEFINE(GC_MARK_STACK, [GC_USE_GCPROS_AS_BEFORE])
+ ;;
+
+ dnl Not all the architectures are tested, but there are Debian packages
+ dnl for SCM and/or Guile on them, so the technique must work. See also
+ dnl comments in alloc.c concerning setjmp and gcc.
+ dnl Fixme: it's probably safe to just use the GCC conditional below.
+ gnu-linux | gnu-kfreebsd )
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#if defined __i386__ || defined __sparc__ || defined __mc68000__ \
+ || defined __alpha__ || defined __mips__ || defined __s390__ \
+ || defined __arm__ || defined __powerpc__ || defined __amd64__ \
+ || defined __ia64__ || defined __sh__
+/* ok */
+#else
+# error "setjmp not known to work on this arch"
+#endif
+ ]], [[]])], AC_DEFINE(GC_SETJMP_WORKS, 1),
+ AC_DEFINE(GC_MARK_STACK, [GC_USE_GCPROS_AS_BEFORE]) )
+ ;;
+esac
+
+
+if test x$GCC = xyes; then
+ dnl GC_SETJMP_WORKS is nearly always appropriate for GCC.
+ AC_DEFINE(GC_SETJMP_WORKS, 1)
+else
+ case $opsys in
+ dnl irix: Tested on Irix 6.5. SCM worked on earlier versions.
+ freebsd | netbsd | openbsd | irix6-5 | sol2* )
+ AC_DEFINE(GC_SETJMP_WORKS, 1)
+ ;;
+ esac
+fi dnl GCC?
+
+AC_CACHE_CHECK([for _setjmp], [emacs_cv_func__setjmp],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <setjmp.h>
+ ]],
+ [[jmp_buf j;
+ if (! _setjmp (j))
+ _longjmp (j, 1);]])],
+ [emacs_cv_func__setjmp=yes],
+ [emacs_cv_func__setjmp=no])])
+if test $emacs_cv_func__setjmp = yes; then
+ AC_DEFINE([HAVE__SETJMP], 1, [Define to 1 if _setjmp and _longjmp work.])
+else
+ AC_CACHE_CHECK([for sigsetjmp], [emacs_cv_func_sigsetjmp],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <setjmp.h>
+ ]],
+ [[sigjmp_buf j;
+ if (! sigsetjmp (j, 1))
+ siglongjmp (j, 1);]])],
+ [emacs_cv_func_sigsetjmp=yes],
+ [emacs_cv_func_sigsetjmp=no])])
+ if test $emacs_cv_func_sigsetjmp = yes; then
+ AC_DEFINE([HAVE_SIGSETJMP], 1,
+ [Define to 1 if sigsetjmp and siglongjmp work.
+ The value of this symbol is irrelevant if HAVE__SETJMP is defined.])
+ fi
+fi
+
+case $opsys in
+ sol2* | unixware )
+ dnl TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY
+ dnl subprocesses the usual way. But TIOCSIGNAL does work for PTYs,
+ dnl and this is all we need.
+ AC_DEFINE(TIOCSIGSEND, TIOCSIGNAL, [Some platforms redefine this.])
+ ;;
+esac
+
+
+case $opsys in
+ hpux* | sol2* )
+ dnl Used in xfaces.c.
+ AC_DEFINE(XOS_NEEDS_TIME_H, 1, [Compensate for a bug in Xos.h on
+ some systems, where it requires time.h.])
+ ;;
+esac
+
+
+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.])
+
+case $opsys in
+ aix4-2)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ dnl This symbol should be defined on AIX Version 3 ???????
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#ifndef _AIX
+# error "_AIX not defined"
+#endif
+ ]], [[]])], [], AC_DEFINE(_AIX, [], [Define if the system is AIX.]))
+ ;;
+
+ cygwin)
+ AC_DEFINE(CYGWIN, 1, [Define if the system is Cygwin.])
+ ;;
+
+ darwin)
+ dnl BSD4_3 and BSD4_4 are already defined in sys/param.h.
+ AC_DEFINE(BSD4_2, [])
+ AC_DEFINE(BSD_SYSTEM, [])
+ dnl More specific than the above two. We cannot use __APPLE__ as this
+ dnl may not be defined on non-OSX Darwin, and we cannot define DARWIN
+ dnl here because Panther and lower CoreFoundation.h uses DARWIN to
+ dnl distinguish OS X from pure Darwin.
+ AC_DEFINE(DARWIN_OS, [], [Define if the system is Darwin.])
+ ;;
+
+ freebsd)
+ AC_DEFINE(BSD4_2, [])
+ dnl Hack to avoid calling AC_PREPROC_IFELSE multiple times.
+ dnl Would not be needed with autoconf >= 2.67, where the
+ dnl preprocessed output is accessible in "conftest.i".
+ AC_DEFINE(BSD_SYSTEM_AHB, 1, [Define if AH_BOTTOM should change BSD_SYSTEM.])
+ ;;
+
+ gnu | netbsd | openbsd )
+ AC_DEFINE(BSD4_2, [])
+ AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+#ifndef BSD_SYSTEM
+# error "BSD_SYSTEM not defined"
+#endif
+ ]], [[]])], [], AC_DEFINE(BSD_SYSTEM, 43) )
+ ;;
+
+ gnu-linux | gnu-kfreebsd )
+ AC_DEFINE(USG, [])
+ AC_DEFINE(GNU_LINUX, [], [Define if ths system is compatible with GNU/Linux.])
+ ;;
+
+ hpux*)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ AC_DEFINE(HPUX, [], [Define if the system is HPUX.])
+ ;;
+
+ irix6-5)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ AC_DEFINE(USG5_4, [])
+ AC_DEFINE(IRIX6_5, [], [Define if the system is IRIX.])
+ ;;
+
+ sol2*)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ AC_DEFINE(USG5_4, [])
+ AC_DEFINE(SOLARIS2, [], [Define if the system is Solaris.])
+ ;;
+
+ unixware)
+ AC_DEFINE(USG, [])
+ AC_DEFINE(USG5, [])
+ AC_DEFINE(USG5_4, [])
+ ;;
+esac
+
+AC_CACHE_CHECK([for usable FIONREAD], [emacs_cv_usable_FIONREAD],
+ [case $opsys in
+ aix4-2)
+ dnl BUILD 9008 - FIONREAD problem still exists in X-Windows.
+ emacs_cv_usable_FIONREAD=no
+ ;;
+
+ *)
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/types.h>
+ #include <sys/ioctl.h>
+ #ifdef USG5_4
+ # include <sys/filio.h>
+ #endif
+ ]],
+ [[int foo = ioctl (0, FIONREAD, &foo);]])],
+ [emacs_cv_usable_FIONREAD=yes],
+ [emacs_cv_usable_FIONREAD=no])
+ ;;
+ esac])
+if test $emacs_cv_usable_FIONREAD = yes; then
+ AC_DEFINE([USABLE_FIONREAD], [1], [Define to 1 if FIONREAD is usable.])
+
+ if test $emacs_broken_SIGIO = no; then
+ AC_CACHE_CHECK([for usable SIGIO], [emacs_cv_usable_SIGIO],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <fcntl.h>
+ #include <signal.h>
+ ]],
+ [[int foo = SIGIO | F_SETFL | FASYNC;]])],
+ [emacs_cv_usable_SIGIO=yes],
+ [emacs_cv_usable_SIGIO=no])],
+ [emacs_cv_usable_SIGIO=yes],
+ [emacs_cv_usable_SIGIO=no])
+ if test $emacs_cv_usable_SIGIO = yes; then
+ AC_DEFINE([USABLE_SIGIO], [1], [Define to 1 if SIGIO is usable.])
+ fi
+ fi
+fi
+
+
+case $opsys in
+ dnl Emacs supplies its own malloc, but glib (part of Gtk+) calls
+ dnl memalign and on Cygwin, that becomes the Cygwin-supplied memalign.
+ dnl As malloc is not the Cygwin malloc, the Cygwin memalign always
+ dnl returns ENOSYS. A workaround is to set G_SLICE=always-malloc. */
+ cygwin)
+ AC_DEFINE(G_SLICE_ALWAYS_MALLOC, 1, [Define to set the
+ G_SLICE environment variable to "always-malloc" at startup, if
+ using GTK.])
+ ;;
+
+ hpux11)
+ dnl It works to open the pty's tty in the parent (Emacs), then
+ dnl close and reopen it in the child.
+ AC_DEFINE(USG_SUBTTY_WORKS, 1, [Define for USG systems where it
+ works to open a pty's tty in the parent process, then close and
+ reopen it in the child.])
+ ;;
+
+ irix6-5)
+ AC_DEFINE(PREFER_VSUSP, 1, [Define if process_send_signal should
+ use VSUSP instead of VSWTCH.])
+ AC_DEFINE(SETPGRP_RELEASES_CTTY, 1, [Define if process.c:child_setup
+ should not call setpgrp.])
+ ;;
+
+ sol2-10)
+ AC_DEFINE(_STRUCTURED_PROC, 1, [Needed for system_process_attributes
+ on Solaris.])
+ ;;
+esac
+
# Set up the CFLAGS for real compilation, so we can substitute it.
CFLAGS="$REAL_CFLAGS"
CPPFLAGS="$REAL_CPPFLAGS"
version=$PACKAGE_VERSION
+copyright="Copyright (C) 2012 Free Software Foundation, Inc."
+AC_DEFINE_UNQUOTED(COPYRIGHT, ["$copyright"],
+ [Short copyright string for this version of Emacs.])
+AC_SUBST(copyright)
+
### Specify what sort of things we'll be editing into Makefile and config.h.
### Use configuration here uncanonicalized to avoid exceeding size limits.
AC_SUBST(version)
AC_SUBST(mandir)
AC_SUBST(infodir)
AC_SUBST(lispdir)
+AC_SUBST(leimdir)
+AC_SUBST(standardlisppath)
AC_SUBST(locallisppath)
AC_SUBST(lisppath)
AC_SUBST(x_default_search_path)
## end of LIBX_BASE, but nothing ever set it.
AC_SUBST(LD_SWITCH_X_SITE)
AC_SUBST(C_SWITCH_X_SITE)
-AC_SUBST(C_SWITCH_X_SYSTEM)
+AC_SUBST(GNUSTEP_CFLAGS)
AC_SUBST(CFLAGS)
## Used in lwlib/Makefile.in.
AC_SUBST(X_TOOLKIT_TYPE)
-if test -n "${machfile}"; then
- M_FILE="\$(srcdir)/${machfile}"
-else
- M_FILE=
-fi
-S_FILE="\$(srcdir)/${opsysfile}"
-AC_SUBST(M_FILE)
-AC_SUBST(S_FILE)
AC_SUBST(ns_appdir)
AC_SUBST(ns_appbindir)
AC_SUBST(ns_appresdir)
AC_SUBST(GNU_OBJC_CFLAGS)
AC_SUBST(OTHER_FILES)
+if test -n "${term_header}"; then
+ AC_DEFINE_UNQUOTED(TERM_HEADER, "${term_header}",
+ [Define to the header for the built-in window system.])
+fi
+
AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "${canonical}",
[Define to the canonical Emacs configuration name.])
AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "${ac_configure_args}",
[Define to the options passed to configure.])
-if test -n "$machfile"; then
- AC_DEFINE_UNQUOTED(config_machfile, "${machfile}",
- [Define to the used machine dependent file.])
-fi
-AC_DEFINE_UNQUOTED(config_opsysfile, "${opsysfile}",
- [Define to the used os dependent file.])
+AH_TEMPLATE(config_opsysfile, [Some platforms that do not use configure
+ define this to include extra configuration information.])
XMENU_OBJ=
XOBJ=
AC_DEFINE(HAVE_X_WINDOWS, 1,
[Define to 1 if you want to use the X window system.])
XMENU_OBJ=xmenu.o
- XOBJ="xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o fringe.o image.o xsettings.o xgselect.o"
+ XOBJ="xterm.o xfns.o xselect.o xrdb.o xsmfns.o xsettings.o xgselect.o"
FONT_OBJ=xfont.o
if test "$HAVE_XFT" = "yes"; then
FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o"
AC_SUBST(PRE_ALLOC_OBJ)
AC_SUBST(POST_ALLOC_OBJ)
-# Configure gnulib here, now that we know LIBS.
+# Configure gnulib. Although this does not affect CFLAGS or LIBS permanently.
+# it temporarily reverts them to their pre-pkg-config values,
+# because gnulib needs to work with both src (which uses the
+# pkg-config stuff) and lib-src (which does not). For example, gnulib
+# may need to determine whether LIB_CLOCK_GETTIME should contain -lrt,
+# and it therefore needs to run in an environment where LIBS does not
+# already contain -lrt merely because 'pkg-config --libs' printed '-lrt'
+# for some package unrelated to lib-src.
+SAVE_CFLAGS=$CFLAGS
+SAVE_LIBS=$LIBS
+CFLAGS=$pre_PKG_CONFIG_CFLAGS
+LIBS="$LIB_PTHREAD $pre_PKG_CONFIG_LIBS"
gl_ASSERT_NO_GNULIB_POSIXCHECK
gl_ASSERT_NO_GNULIB_TESTS
gl_INIT
+CFLAGS=$SAVE_CFLAGS
+LIBS=$SAVE_LIBS
case "$opsys" in
aix4-2) LD_SWITCH_SYSTEM_TEMACS="-Wl,-bnodelcsect" ;;
## #ifndef LD_SWITCH_SYSTEM
## #if !defined (__GNUC__) && ((defined (BSD_SYSTEM) && !defined (COFF)))
## Since all the *bsds define LD_SWITCH_SYSTEM, this simplifies to:
- ## not using gcc, darwin system not on an alpha (ie darwin, since
- ## darwin + alpha does not occur).
+ ## not using gcc, darwin.
## Because this was done in src/Makefile.in, the resulting part of
## LD_SWITCH_SYSTEM was not used in configure (ie, in ac_link).
## It therefore seems cleaner to put this in LD_SWITCH_SYSTEM_TEMACS,
LD_SWITCH_SYSTEM_TEMACS="-X $LD_SWITCH_SYSTEM_TEMACS"
;;
- ## LD_SWITCH_X_SITE_AUX is a -R option saying where to find X at run-time.
- ## When handled by cpp, this was in LD_SWITCH_SYSTEM. However, at
- ## the point where configure sourced the s/*.h file, LD_SWITCH_X_SITE_AUX
+ ## LD_SWITCH_X_SITE_RPATH is a -rpath option saying where to
+ ## find X at run-time.
+ ## When handled by cpp, this was in LD_SWITCH_SYSTEM. However, at the
+ ## point where configure sourced the s/*.h file, LD_SWITCH_X_SITE_RPATH
## had not yet been defined and was expanded to null. Hence LD_SWITCH_SYSTEM
## had different values in configure (in ac_link) and src/Makefile.in.
## It seems clearer therefore to put this piece in LD_SWITCH_SYSTEM_TEMACS.
- gnu*) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_AUX_RPATH)" ;;
+ gnu*) LD_SWITCH_SYSTEM_TEMACS="\$(LD_SWITCH_X_SITE_RPATH)" ;;
*) LD_SWITCH_SYSTEM_TEMACS= ;;
esac
## will also work on earlier NetBSD releases.
netbsd|openbsd) LD_FIRSTFLAG="-nostartfiles" ;;
- ## macpcc: NAKAJI Hiroyuki <nakaji@tutrp.tut.ac.jp> says
+ ## powerpc*: NAKAJI Hiroyuki <nakaji@tutrp.tut.ac.jp> says
## MkLinux/LinuxPPC needs this.
- ## ibms390x only supports opsys = gnu-linux so it can be added here.
+ ## s390x-* only supports opsys = gnu-linux so it can be added here.
gnu-*)
- case "$machine" in
- macppc|ibms390x) LD_FIRSTFLAG="-nostdlib" ;;
+ case "$canonical" in
+ powerpc*|s390x-*) LD_FIRSTFLAG="-nostdlib" ;;
esac
;;
esac
AC_DEFINE(ORDINARY_LINK, 1, [Define if the C compiler is the linker.])
## The system files defining neither ORDINARY_LINK nor LD_FIRSTFLAG are:
-## freebsd, gnu-* not on macppc|ibms390x.
+## freebsd, gnu-* not on powerpc*|s390x*.
elif test "x$GCC" = "xyes" && test "x$LD_FIRSTFLAG" = "x"; then
## Versions of GCC >= 2.0 put their library, libgcc.a, in obscure
fi dnl if $GCC
AC_SUBST(LIB_GCC)
-
-## If we're using X11/GNUstep, define some consequences.
-if test "$HAVE_X_WINDOWS" = "yes" || test "$HAVE_NS" = "yes"; then
+## Common for all window systems
+if test "$window_system" != "none"; then
AC_DEFINE(HAVE_WINDOW_SYSTEM, 1, [Define if you have a window system.])
AC_DEFINE(HAVE_MOUSE, 1, [Define if you have mouse support.])
+ WINDOW_SYSTEM_OBJ="fontset.o fringe.o image.o"
fi
+AC_SUBST(WINDOW_SYSTEM_OBJ)
AH_TOP([/* GNU Emacs site configuration template file.
#define EMACS_CONFIG_H
])dnl
-AH_BOTTOM([
-/* On AIX 3 this must be included before any other include file. */
-#include <alloca.h>
-#if ! HAVE_ALLOCA
-# error "alloca not available on this machine"
-#endif
-
-/* Define AMPERSAND_FULL_NAME if you use the convention
- that & in the full name stands for the login id. */
-/* Turned on June 1996 supposing nobody will mind it. */
-#define AMPERSAND_FULL_NAME
-
-/* `subprocesses' should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- Only MSDOS does not support this (it overrides
- this in its config_opsysfile below). */
-
-#define subprocesses
-
-/* Include the os and machine dependent files. */
-#include config_opsysfile
-#ifdef config_machfile
-# include config_machfile
-#endif
-
-/* GNUstep needs a bit more pure memory. Of the existing knobs,
- SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems.
- (There is probably a better place to do this, but right now the
- Cocoa side does this in s/darwin.h and we cannot parallel this
- exactly since GNUstep is multi-OS. */
-#if defined HAVE_NS && defined NS_IMPL_GNUSTEP
-# define SYSTEM_PURESIZE_EXTRA 30000
-#endif
-
-#ifdef emacs /* Don't do this for lib-src. */
-/* Tell regex.c to use a type compatible with Emacs. */
-#define RE_TRANSLATE_TYPE Lisp_Object
-#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C)
-#ifdef make_number
-/* If make_number is a macro, use it. */
-#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0)))
-#else
-/* If make_number is a function, avoid it. */
-#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0))
-#endif
-#endif
-
-/* These default definitions are good for almost all machines.
- Any exceptions should override them in m/MACHINE.h.
- They must be usable in preprocessor conditionals. */
-
-#ifndef BITS_PER_CHAR
-#define BITS_PER_CHAR 8
-#endif
-
-#ifndef BITS_PER_SHORT
-#define BITS_PER_SHORT 16
-#endif
-
-#ifndef BITS_PER_INT
-#define BITS_PER_INT 32
-#endif
-
-#ifndef BITS_PER_LONG
-#ifdef _LP64
-#define BITS_PER_LONG 64
-#else
-#define BITS_PER_LONG 32
-#endif
-#endif
-
-#if !defined BITS_PER_LONG_LONG && HAVE_LONG_LONG_INT
-#define BITS_PER_LONG_LONG 64
-#endif
-
-/* Define if the compiler supports function prototypes. It may do so but
- not define __STDC__ (e.g. DEC C by default) or may define it as zero. */
-#undef PROTOTYPES
-
-#include <string.h>
-#include <stdlib.h>
-
-#if defined __GNUC__ && (__GNUC__ > 2 \
- || (__GNUC__ == 2 && __GNUC_MINOR__ >= 5))
-#define NO_RETURN __attribute__ ((__noreturn__))
-#else
-#define NO_RETURN /* nothing */
-#endif
-
-#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
-#define NO_INLINE __attribute__((noinline))
-#else
-#define NO_INLINE
-#endif
-
-#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1))
-#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
-#else
-#define EXTERNALLY_VISIBLE
-#endif
-
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define ATTRIBUTE_FORMAT(spec) /* empty */
-#endif
-
-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
-#else
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
-#endif
-
-/* Some versions of GNU/Linux define noinline in their headers. */
-#ifdef noinline
-#undef noinline
-#endif
-
-/* These won't be used automatically yet. We also need to know, at least,
- that the stack is continuous. */
-#ifdef __GNUC__
-# ifndef GC_SETJMP_WORKS
- /* GC_SETJMP_WORKS is nearly always appropriate for GCC. */
-# define GC_SETJMP_WORKS 1
-# endif
-#endif
+AH_BOTTOM([#include <conf_post.h>
#endif /* EMACS_CONFIG_H */
#### It makes printing result more understandable as using GTK sets
#### toolkit_scroll_bars to yes by default.
if test "${HAVE_GTK}" = "yes"; then
- USE_X_TOOLKIT=GTK
-fi
-
-and_machfile=
-if test -n "$machfile"; then
- and_machfile=" and \`${machfile}'"
+ USE_X_TOOLKIT="$USE_GTK_TOOLKIT"
fi
echo "
Configured for \`${canonical}'.
Where should the build process find the source code? ${srcdir}
- What operating system and machine description files should Emacs use?
- \`${opsysfile}'${and_machfile}
What compiler should emacs be built with? ${CC} ${CFLAGS}
Should Emacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason}
Should Emacs use a relocating allocator for buffers? ${REL_ALLOC}
echo " Environment variable EMACSDOC set to: $EMACSDOC"
fi
-if test $USE_XASSERTS = yes; then
- echo " Compiling with asserts turned on."
- CPPFLAGS="$CPPFLAGS -DXASSERTS=1"
-fi
-
echo
if test "$HAVE_NS" = "yes"; then
echo
fi
+if test "${opsys}" = "cygwin"; then
+ case `uname -r` in
+ 1.5.*) AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]])
+ echo
+ ;;
+ esac
+fi
# Remove any trailing slashes in these variables.
[test "${prefix}" != NONE &&
test "${exec_prefix}" != NONE &&
exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'`]
+if test "$HAVE_NS" = "yes"; then
+ if test "$NS_IMPL_GNUSTEP" = yes; then
+ AC_CONFIG_FILES([nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in \
+ nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in])
+ else
+ AC_CONFIG_FILES([nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in \
+ nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in])
+ fi
+fi
+
dnl Obviously there is duplication here wrt $SUBDIR_MAKEFILES.
dnl You _can_ use that variable in AC_CONFIG_FILES, so long as any directory
dnl using automake (ie lib/) is explicitly listed and not "hidden" in a variable
dnl (see http://lists.gnu.org/archive/html/bug-autoconf/2008-08/msg00028.html).
dnl That doesn't have any obvious consequences for Emacs, but on the whole
dnl it seems better to just live with the duplication.
-SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile"
+SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile"
AC_CONFIG_FILES([Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile \
doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile \
doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile \
- leim/Makefile])
+ leim/Makefile nextstep/Makefile])
dnl test/ is not present in release tarfiles.
opt_makefile=test/automated/Makefile
AC_CONFIG_FILES([test/automated/Makefile])
fi
+
+dnl admin/ may or may not be present.
+opt_makefile=admin/unidata/Makefile
+
+if test -f $srcdir/${opt_makefile}.in; then
+ SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile"
+ AC_CONFIG_FILES([admin/unidata/Makefile])
+fi
+
+
SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e 's|Makefile|Makefile.in|g'`
AC_SUBST(SUBDIR_MAKEFILES_IN)
dnl the use of force in the `epaths-force' rule in Makefile.in.
AC_CONFIG_COMMANDS([epaths], [
echo creating src/epaths.h
-${MAKE-make} epaths-force
-], [GCC="$GCC" NON_GNU_CPP="$NON_GNU_CPP" CPP="$CPP" CPPFLAGS="$CPPFLAGS"])
+${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force
+], [GCC="$GCC" CPPFLAGS="$CPPFLAGS"])
AC_CONFIG_COMMANDS([gdbinit], [
if test ! -f src/.gdbinit && test -f $srcdir/src/.gdbinit; then
])
AC_OUTPUT
-
-dnl configure.in ends here
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-27 Glenn Morris <rgm@gnu.org>
- * Version 24.2 released.
+ * cal-xtra.texi (Advanced Calendar/Diary Usage):
+ Rename the section to be more general.
+ * emacs.texi: Update menu.
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * buffers.texi (Misc Buffer): Replace toggle-read-only with
+ read-only-mode.
+
+ * files.texi (Visiting): Likewise.
+
+2012-09-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * trouble.texi (Crashing): Document ulimit -c.
+
+2012-09-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * trouble.texi (Crashing): Document addr2line.
+
+2012-09-19 Chong Yidong <cyd@gnu.org>
+
+ * killing.texi (Yanking): Minor clarification (Bug#12469).
+
+2012-09-17 Chong Yidong <cyd@gnu.org>
+
+ * building.texi (GDB User Interface Layout): Remove reference to
+ removed variable gdb-use-separate-io-buffer (Bug#12454).
+
+2012-09-08 Jambunathan K <kjambunathan@gmail.com>
+
+ * regs.texi (Text Registers): `C-x r +' can now be used instead of
+ M-x append-to-register. New option `register-separator'.
+ (Number Registers): Mention that `C-x r +' is polymorphic.
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * windows.texi (Window Choice): Don't mention obsolete
+ display-buffer-reuse-frames.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Give more-useful info on a fatal error (Bug#12328).
+ * trouble.texi (Crashing): New section, documenting this.
+
+2012-08-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * cmdargs.texi (General Variables):
+ Setting $DBUS_SESSION_BUS_ADDRESS to a dummy value suppresses
+ connections to the D-Bus session bus. (Bug#12112)
+
+2012-08-14 Eli Zaretskii <eliz@gnu.org>
+
+ * building.texi (Debugger Operation): Correct and improve
+ documentation of the GUD Tooltip mode.
2012-07-31 Chong Yidong <cyd@gnu.org>
* emacs.texi: Fix ISBN (Bug#12080).
-2012-07-21 Eli Zaretskii <eliz@gnu.org>
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * 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 <eliz@gnu.org>
* frames.texi (Mouse Commands): Fix the description of mouse-2.
(Bug#11958)
* emacs.texi: Update ISBN.
+2012-07-17 Chong Yidong <cyd@gnu.org>
+
+ * basic.texi (Inserting Text): Replace ucs-insert with
+ insert-char. Provide more details of input.
+
+ * mule.texi (International Chars, Input Methods): Likewise.
+
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * custom.texi (Examining): Update C-h v message.
+
+ * buffers.texi (Misc Buffer): Document view-read-only.
+
+2012-07-07 Chong Yidong <cyd@gnu.org>
+
+ * custom.texi (Init File): Index site-lisp (Bug#11435).
+
+2012-07-06 Chong Yidong <cyd@gnu.org>
+
+ * emacs.texi: Re-order top-level menu to correspond to logical
+ order, to avoid makeinfo warnings.
+
+ * ack.texi (Acknowledgments): Note new python.el.
+
2012-06-29 Chong Yidong <cyd@gnu.org>
* maintaining.texi (Basic VC Editing, VC Pull, Merging):
* basic.texi (Erasing, Basic Undo): Fix markup.
-2012-06-26 Glenn Morris <rgm@gnu.org>
+2012-06-29 Glenn Morris <rgm@gnu.org>
* fixit.texi (Undo): Grammar fixes. (Bug#11779)
-2012-06-24 Michael Witten <mfwitten@gmail.com> (tiny change)
+2012-06-29 Michael Witten <mfwitten@gmail.com> (tiny change)
* fixit.texi (Undo): Fix typo. (Bug#11775)
-2012-06-19 Glenn Morris <rgm@gnu.org>
+2012-06-27 Glenn Morris <rgm@gnu.org>
- * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
+ * ack.texi (Acknowledgments): Tiny update.
-2012-06-11 Chong Yidong <cyd@gnu.org>
+2012-06-21 Glenn Morris <rgm@gnu.org>
- * emacs.texi: Remove urlcolor setting.
+ * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
-2012-06-10 Chong Yidong <cyd@gnu.org>
+2012-06-17 Chong Yidong <cyd@gnu.org>
- * emacs.texi: Update ISBN and edition number.
+ * emacs.texi: Remove urlcolor setting. Update ISBN and edition number.
* anti.texi:
* building.texi:
* sending.texi:
* text.texi: Copyedits to avoid underfull/overfull in 7x9 manual.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-06-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * custom.texi (Directory Variables): Mention enable-remote-dir-locals.
+
+2012-05-28 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi, building.texi, calendar.texi, custom.texi:
+ * maintaining.texi, text.texi: Use @LaTeX rather than La@TeX.
+
+2012-05-27 Glenn Morris <rgm@gnu.org>
+
+ * emacs.texi: Simplify following removal of node pointers.
+
+ * ack.texi, anti.texi, basic.texi, buffers.texi, building.texi:
+ * cmdargs.texi, commands.texi, display.texi, emacs.texi:
+ * entering.texi, files.texi, fixit.texi, frames.texi, glossary.texi:
+ * gnu.texi, help.texi, indent.texi, killing.texi, kmacro.texi:
+ * m-x.texi, macos.texi, maintaining.texi, mark.texi, mini.texi:
+ * misc.texi, modes.texi, msdog.texi, mule.texi, programs.texi:
+ * regs.texi, screen.texi, search.texi, text.texi, trouble.texi:
+ * windows.texi, xresources.texi: Nuke hand-written node pointers.
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * emacs.texi (Acknowledgments): Add another contributor.
- * Version 24.1 released.
+2012-05-12 Glenn Morris <rgm@gnu.org>
-2012-05-06 Chong Yidong <cyd@gnu.org>
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkinfodir): Use $MKDIR_P.
+
+2012-05-10 Glenn Morris <rgm@gnu.org>
+
+ * mule.texi (Disabling Multibyte): Replace the obsolete "unibyte: t"
+ with "coding: raw-text".
+
+ * files.texi (Interlocking): Mention create-lockfiles option.
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
* frames.texi (Mouse References, Mouse Commands): Fix index
entries (Bug#11362).
-2012-05-03 Glenn Morris <rgm@gnu.org>
+2012-05-05 Glenn Morris <rgm@gnu.org>
* custom.texi (Customization Groups, Custom Themes, Examining):
Improve page breaks.
* fixit.texi (Fixit, Undo): Reword to improve page-breaks.
-2012-05-01 Glenn Morris <rgm@gnu.org>
+2012-05-04 Glenn Morris <rgm@gnu.org>
- * emacs.texi (@copying): Only print EDITION in the TeX version.
+ * Makefile.in (INFO_EXT, INFO_OPTS): New, set by configure.
+ (info, infoclean): Use $INFO_EXT.
+ ($(infodir)/emacs$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+ * makefile.w32-in (INFO_EXT, INFO_OPTS): New.
+ (INFO_TARGETS): Use $INFO_EXT.
+ ($(infodir)/emacs$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT, and -o.
-2012-04-30 Glenn Morris <rgm@gnu.org>
+2012-05-02 Glenn Morris <rgm@gnu.org>
+
+ * emacs.texi (@copying): Only print EDITION in the TeX version.
* search.texi (Regexp Search): Just say "Emacs".
* display.texi (Auto Scrolling):
Reword to avoid repetition and improve page break.
-2012-04-28 Glenn Morris <rgm@gnu.org>
-
* xresources.texi (Resources):
* mule.texi (Language Environments):
* misc.texi (Amusements):
* emacs.texi: Some fixes for detailed menu.
-2012-04-26 Glenn Morris <rgm@gnu.org>
-
* emacs.texi: Add "et al." to authors.
* ack.texi, basic.texi, buffers.texi, building.texi:
* search.texi, trouble.texi, windows.texi:
Use Texinfo recommended convention for quotes+punctuation.
-2012-04-25 Eli Zaretskii <eliz@gnu.org>
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
- * mule.texi (Bidirectional Editing): Improve indexing. Minor
- wording tweaks.
+ * mule.texi (Bidirectional Editing): Improve indexing.
+ Minor wording tweaks.
2012-04-15 Chong Yidong <cyd@gnu.org>
* misc.texi (emacsclient Options): More clarifications.
-2012-04-14 Glenn Morris <rgm@gnu.org>
+2012-04-15 Glenn Morris <rgm@gnu.org>
* msdog.texi (Windows Printing): It doesn't set printer-name.
(Defining Fontsets, Modifying Fontsets, Undisplayable Characters)
(Unibyte Mode, Charsets, Bidirectional Editing): Copyedits.
-2012-04-14 Chong Yidong <cyd@gnu.org>
+2012-04-15 Chong Yidong <cyd@gnu.org>
* glossary.texi (Glossary): Standardize on "text terminal"
terminology. All callers changed.
* misc.texi (emacsclient Options): Document "client frame" concept
and its effect on C-x C-c more carefully.
-2012-04-14 Glenn Morris <rgm@gnu.org>
+2012-04-15 Glenn Morris <rgm@gnu.org>
* frames.texi (Scroll Bars):
* glossary.texi (Glossary): Use consistent case for "X Window System".
(Text Coding, Communication Coding, File Name Coding, Terminal Coding):
Copyedits.
-2012-04-13 Glenn Morris <rgm@gnu.org>
+2012-04-14 Glenn Morris <rgm@gnu.org>
* mule.texi (Select Input Method, Coding Systems, Recognize Coding):
Copyedits.
auto-coding-functions does not override coding: tags.
Remove rmail-decode-mime-charset; it no longer has any effect.
-2012-04-12 Chong Yidong <cyd@gnu.org>
+2012-04-14 Chong Yidong <cyd@gnu.org>
* custom.texi (Creating Custom Themes): Add reference to Custom
Themes node in Lisp manual.
-2012-04-12 Glenn Morris <rgm@gnu.org>
+2012-04-14 Glenn Morris <rgm@gnu.org>
* mule.texi (International): Copyedits.
(International Chars): Update C-x = example output.
(Input Methods): Copyedits. Use "^" for the postfix example,
because it is less confusing inside Info's `quotes'.
- * custom.texi (Specifying File Variables): Fix "unibyte" description.
+ * custom.texi (Specifying File Variables): Fix "unibyte" description.
Update for "Disabling Multibyte" node name change.
* emacs.texi: Update for "Disabling Multibyte" node name change.
-2012-04-10 Glenn Morris <rgm@gnu.org>
-
* abbrevs.texi, arevert-xtra.texi, buffers.texi, building.texi:
* cmdargs.texi, custom.texi, entering.texi, files.texi, frames.texi:
* glossary.texi, help.texi, macos.texi, maintaining.texi, mini.texi:
* entering.texi (Entering Emacs):
Do not mention initial-buffer-choice = t.
-2012-04-08 Glenn Morris <rgm@gnu.org>
-
* misc.texi (Gnus Startup): Use @env for environment variables.
+ * Makefile.in: Replace non-portable use of $< in ordinary rules.
+
+2012-04-12 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments): Don't mention obsolete mailpost.el.
+
2012-04-07 Glenn Morris <rgm@gnu.org>
- * Makefile.in: Replace non-portable use of $< in ordinary rules.
+ * emacsver.texi (EMACSVER): Bump version to 24.1.50.
2012-04-05 Glenn Morris <rgm@gnu.org>
2012-01-09 Chong Yidong <cyd@gnu.org>
- * custom.texi (Custom Themes): Switched custom-safe-themes to use
+ * custom.texi (Custom Themes): Switch custom-safe-themes to use
SHA-256.
2012-01-07 Chong Yidong <cyd@gnu.org>
(Screen Garbled): Don't refer to terminal "manufacturers".
(Total Frustration): Node deleted. Eliza is documented in
Amusements now.
- (Known Problems): More info about using the bug tracker. Mention
- debbugs package.
+ (Known Problems): More info about using the bug tracker.
+ Mention debbugs package.
(Bug Criteria): Copyedits.
(Understanding Bug Reporting): Mention emacs -Q.
Document browse-url-mailto-function.
(Goto Address mode): Add index entries. Add xref to Browse-URL.
(FFAP): FFAP is not a minor mode.
- (Amusements): M-x lm was renamed to M-x landmark. Document
- nato-region.
+ (Amusements): M-x lm was renamed to M-x landmark.
+ Document nato-region.
2012-01-01 Chong Yidong <cyd@gnu.org>
2011-12-26 Chong Yidong <cyd@gnu.org>
- * dired.texi (Dired Enter, Misc Dired Features): Document
- dired-use-ls-dired changes. Mention quit-window.
+ * dired.texi (Dired Enter, Misc Dired Features):
+ Document dired-use-ls-dired changes. Mention quit-window.
(Dired Navigation): Add index entries.
(Dired Visiting): Fix View Mode xref.
(Marks vs Flags): Prefer C-/ binding for undo.
* vc1-xtra.texi (Version Headers): Note that these are for
Subversion, CVS, etc. only.
- (General VC Options): De-document vc-keep-workfiles. Fix
- RCS-isms.
+ (General VC Options): De-document vc-keep-workfiles.
+ Fix RCS-isms.
2011-12-22 Eli Zaretskii <eliz@gnu.org>
* vc1-xtra.texi (Remote Repositories): Update introduction.
(Local Version Control): Node deleted (obsolete with DVCSes).
- (Remote Repositories, Version Backups): Node deleted. Move
- documentation of vc-cvs-stay-local to CVS Options.
+ (Remote Repositories, Version Backups): Node deleted.
+ Move documentation of vc-cvs-stay-local to CVS Options.
(CVS Options): Reduce verbosity of description of obscure CVS
locking feature.
(Making Revision Tags, Revision Tag Caveats): Merge into Revision
less CVS-specific.
(VC With A Merging VCS, VC With A Locking VCS): Add xref to
Registering node.
- (Secondary VC Commands): Deleted. Promote subnodes.
+ (Secondary VC Commands): Delete. Promote subnodes.
(Log Buffer): Add command name for C-c C-c. Fix the name of the
log buffer. Add index entries.
- (VCS Changesets, Types of Log File, VC With A Merging VCS): Use
- "commit" terminology.
+ (VCS Changesets, Types of Log File, VC With A Merging VCS):
+ Use "commit" terminology.
(Old Revisions): Move it to just before VC Change Log. "Tag" here
doesn't refer to tags tables. Note other possible forms of the
revision ID. C-x v = does not save.
(Lisp Eval): Note that listed commands are available globally.
Explain the meaning of "defun" in the C-M-x context.
(Lisp Interaction): Copyedits.
- (External Lisp): Fix name of inferior Lisp buffer. Mention
- Scheme.
+ (External Lisp): Fix name of inferior Lisp buffer.
+ Mention Scheme.
(Compilation): Define "inferior process".
2011-12-10 Eli Zaretskii <eliz@gnu.org>
(Compilation Mode): Add xref for grep, occur, and mouse
references. Define "locus".
(Grep Searching): Use @command.
- (Debuggers, Commands of GUD, GDB Graphical Interface): Clarify
- intro.
+ (Debuggers, Commands of GUD, GDB Graphical Interface):
+ Clarify intro.
(Starting GUD): Clarify how arguments are specified.
(Debugger Operation): Index entry for "GUD interaction buffer",
and move basic description here from Commands of GUD node.
(Source Buffers): Remove gdb-find-source-frame, which is not in
gdb-mi.el.
(Other GDB Buffers): Remove gdb-use-separate-io-buffer and
- toggle-gdb-all-registers, which are not in gdb-mi.el. Don't
- re-document GUD interaction buffers.
+ toggle-gdb-all-registers, which are not in gdb-mi.el.
+ Don't re-document GUD interaction buffers.
* programs.texi (Symbol Completion): M-TAB can now use Semantic.
(Semantic): Add cindex entries for Semantic.
* programs.texi (Program Modes): Mention modes that are not
included with Emacs. Fix references to other manuals for tex.
- Add index entry for backward-delete-char-untabify. Mention
- prog-mode-hook.
+ Add index entry for backward-delete-char-untabify.
+ Mention prog-mode-hook.
(Which Function): Use "global minor mode" terminology.
(Basic Indent, Multi-line Indent): Refer to previous descriptions
in Indentation chapter to avoid duplication.
(TeX Editing): Add xref to documentation for Occur.
(LaTeX Editing): Add xref to Completion node.
(TeX Print): Fix description of tex-directory.
- (Enriched Text): Renamed from Formatted Text. Make this node and
+ (Enriched Text): Rename from Formatted Text. Make this node and
its subnodes less verbose, since text/enriched files are
practically unused.
- (Enriched Mode): Renamed from Requesting Formatted Text.
+ (Enriched Mode): Rename from Requesting Formatted Text.
(Format Colors): Node deleted.
- (Enriched Faces): Renamed from Format Faces. Describe commands
+ (Enriched Faces): Rename from Format Faces. Describe commands
for applying colors too.
(Forcing Enriched Mode): Node deleted; merged into Enriched Mode.
2011-10-18 Chong Yidong <cyd@gnu.org>
* display.texi (Faces): Simplify discussion. Move documentation
- of list-faces-display here, from Standard Faces node. Note
- special role of `default' background.
- (Standard Faces): Note special role of `default' background. Note
- that region face may be taken fom GTK. Add xref to Text Display.
- (Text Scale): Rename from "Temporary Face Changes". Callers
- changed. Don't bother documenting variable-pitch-mode.
+ of list-faces-display here, from Standard Faces node.
+ Note special role of `default' background.
+ (Standard Faces): Note special role of `default' background.
+ Note that region face may be taken fom GTK. Add xref to Text Display.
+ (Text Scale): Rename from "Temporary Face Changes".
+ Callers changed. Don't bother documenting variable-pitch-mode.
(Font Lock): Copyedits. Remove font-lock-maximum-size.
(Useless Whitespace): Simplify description of
delete-trailing-whitespace. Note active region case.
2011-10-13 Chong Yidong <cyd@stupidchicken.com>
- * killing.texi (Deletion): Add xref to Using Region. Document
- delete-forward-char.
+ * killing.texi (Deletion): Add xref to Using Region.
+ Document delete-forward-char.
(Yanking): Move yank-excluded-properties to Lisp manual. Move C-y
description here. Recommend C-u C-SPC for jumping to mark.
(Kill Ring): Move kill ring variable documentation here.
selection changes. Mention that commands like C-y set the mark.
(Marking Objects): Add xref to Words node. Note that mark-word
and mark-sexp also have the "extend region" behavior.
- (Using Region): Mention M-$ in the table. Document
- mark-even-if-inactive here instead of in Mark Ring.
- (Mark Ring): Move mark-even-if-inactive to Using Region. Take
- note of the "Mark Set" behavior.
+ (Using Region): Mention M-$ in the table.
+ Document mark-even-if-inactive here instead of in Mark Ring.
+ (Mark Ring): Move mark-even-if-inactive to Using Region.
+ Take note of the "Mark Set" behavior.
(Disabled Transient Mark): Rename from "Persistent Mark"
(Bug#9688). Callers changed.
(Name Help): Remove an over-long joke.
(Apropos): Document prefix args. Remove duplicated descriptions.
(Help Mode): Add C-c C-b to table. Update TAB binding.
- (Package Keywords): Rename from "Library by Keyword". Describe
- new package menu interface.
+ (Package Keywords): Rename from "Library by Keyword".
+ Describe new package menu interface.
(Help Files, Help Echo): Tweak description.
* mini.texi (Completion Options): Add completion-cycle-threshold.
2011-10-08 Chong Yidong <cyd@stupidchicken.com>
- * basic.texi (Position Info): Omit page commands. Document
- count-words-region and count-words.
+ * basic.texi (Position Info): Omit page commands.
+ Document count-words-region and count-words.
* text.texi (Pages): Move what-page documentation here.
2011-10-07 Chong Yidong <cyd@stupidchicken.com>
- * basic.texi (Inserting Text): Add xref to Completion. Add
- ucs-insert example, and document prefix argument.
+ * basic.texi (Inserting Text): Add xref to Completion.
+ Add ucs-insert example, and document prefix argument.
(Moving Point): Fix introduction; C-f/C-b are no longer equivalent
to left/right. Tweak left-char and right-char descriptions.
M-left and M-right are now bound to left-word/right-word.
* custom.texi (Mouse Buttons):
* rmail.texi (Rmail Scrolling):
* search.texi (Isearch Scroll):
-
* display.texi (Scrolling): Replace scroll-up/down with
scroll-up/down-command. Fix scroll-preserve-screen-position
description. Document scroll-error-top-bottom.
2011-04-24 Chong Yidong <cyd@stupidchicken.com>
- * maintaining.texi (List Tags): Document next-file. Suggested by
- Uday S Reddy.
+ * maintaining.texi (List Tags): Document next-file.
+ Suggested by Uday S Reddy.
2011-04-23 Juanma Barranquero <lekktu@gmail.com>
* ack.texi (Acknowledgments): General update based on AUTHORS,
including removal of some stuff no longer distributed.
-2008-12-19 Agust
in Martin <agustin.martin@hispalinux.es>
+2008-12-19 Agust
ín Martín <agustin.martin@hispalinux.es>
- * fixit.texi: Mention hunspell
+ * fixit.texi: Mention hunspell.
2008-12-19 Glenn Morris <rgm@gnu.org>
# Directory with the (customized) texinfo.tex file.
texinfodir = $(srcdir)/../misc
+MKDIR_P = @MKDIR_P@
+
+INFO_EXT=@INFO_EXT@
+# Options used only when making info output.
+# --no-split is only needed because of MS-DOS.
+# For a possible alternative, see
+# http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg01182.html
+INFO_OPTS=@INFO_OPTS@
+
# The makeinfo program is part of the Texinfo distribution.
# Use --force so that it generates output even if there are errors.
MAKEINFO = @MAKEINFO@
$(EMACS_XTRA)
## This seems pointless. The info/ directory exists in both the
-## repository and the release tarfiles. We do not use any
-## equivalent of mkdir -p/install-sh -d, so this is not a general
-## solution anyway. The second test -d is for parallel builds.
-mkinfodir = @test -d ${buildinfodir} || mkdir ${buildinfodir} || test -d ${buildinfodir}
+## repository and the release tarfiles.
+mkinfodir = @${MKDIR_P} ${buildinfodir}
.PHONY: info dvi html pdf ps
-info: $(buildinfodir)/emacs
+info: $(buildinfodir)/emacs$(INFO_EXT)
dvi: emacs.dvi
html: emacs.html
pdf: emacs.pdf
# There is no provision for Info files to exist in the build directory.
# In a distribution of Emacs, the Info files should be up to date.
# Note: "<" is not portable in ordinary make rules.
-$(buildinfodir)/emacs: ${EMACSSOURCES}
+$(buildinfodir)/emacs$(INFO_EXT): ${EMACSSOURCES}
$(mkinfodir)
- $(MAKEINFO) $(MAKEINFO_OPTS) -o $@ ${srcdir}/emacs.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs.texi
emacs.dvi: ${EMACSSOURCES}
$(ENVADD) $(TEXI2DVI) ${srcdir}/emacs.texi
## In the standalone tarfile, the clean rule runs this.
infoclean:
- -cd $(buildinfodir) && rm -f emacs emacs-[1-9] emacs-[1-9][0-9]
+ -cd $(buildinfodir) && rm -f emacs$(INFO_EXT) emacs$(INFO_EXT)-[1-9] emacs$(INFO_EXT)-[1-9][0-9]
maintainer-clean: distclean infoclean
@c Copyright (C) 1994-1997, 1999-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
-@node Acknowledgments, Screen, Concept Index, Top
+@node Acknowledgments
@unnumbered Acknowledgments
Many people have contributed code included in the Free Software
Vivek Dasmohapatra wrote @file{htmlfontify.el}, to convert a buffer or
source tree to HTML.
-@item
-Gary Delp wrote @file{mailpost.el}, an interface between RMAIL and the
-@file{/usr/uci/post} mailer.
-
@item
Matthieu Devin wrote @file{delsel.el}, a package to make newly-typed
text replace the current selection.
@item
Carsten Dominik wrote Ref@TeX{}, a package for setting up labels and
-cross-references in La@TeX{} documents; and co-wrote IDLWAVE mode
+cross-references in @LaTeX{} documents; and co-wrote IDLWAVE mode
(q.v.@:). He was the original author of Org mode, for maintaining notes,
todo lists, and project planning. Bastien Guerry subsequently took
over maintainership. Benjamin Andresen, Thomas Baumann, Joel Boehland, Jan Böcker, Lennart
@file{flow-ctrl.el}, a package for coping with unsuppressible XON/XOFF
flow control.
+@item
+Fabián E. Gallina rewrote @file{python.el}, the major mode for the
+Python programming language used in Emacs 24.3 onwards.
+
@item
Kevin Gallo added multiple-frame support for Windows NT and wrote
@file{w32-win.el}, support functions for the MS-Windows window system.
@item
Arne Jørgensen wrote @file{latexenc.el}, a package to
-automatically guess the correct coding system in La@TeX{} files.
+automatically guess the correct coding system in @LaTeX{} files.
@item
Alexandre Julliard wrote @file{vc-git.el}, support for the Git version
Henry Kautz wrote @file{bib-mode.el}, a mode for maintaining
bibliography databases compatible with @code{refer} (the @code{troff}
version) and @code{lookbib}, and @file{refbib.el}, a package to convert
-those databases to the format used by the La@TeX{} text formatting package.
+those databases to the format used by the @LaTeX{} text formatting package.
@item
Taichi Kawabata added support for Devanagari script and the Indian
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; @file{python.el}, a major mode
-for the Python programming language; @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 the display of
-the Emacs tool bar. With Riccardo Murri he wrote @file{vc-bzr.el},
-support for the Bazaar version control system.
+by setting up appropriate display tables; the version of
+@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
+the display of the Emacs tool bar. With Riccardo Murri he wrote
+@file{vc-bzr.el}, support for the Bazaar version control system.
@item
Eric Ludlam wrote the Speedbar package; @file{checkdoc.el}, for checking
@file{bibtex-style.el} for Bib@TeX{} Style files; @file{mpc.el}, a
client for the ``Music Player Daemon''; @file{smie.el}, a generic
indentation engine; and @file{pcase.el}, implementing ML-style pattern
-matching. He integrated the lexical binding code in Emacs 24.
+matching. In Emacs 24, he integrated the lexical binding code,
+and cleaned up the CL namespace (making it acceptable to use CL
+functions at runtime).
@item
Morioka Tomohiko wrote several packages for MIME support in Gnus and
@c Copyright (C) 2005-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Antinews, Mac OS / GNUstep, X Resources, Top
+@node Antinews
@appendix Emacs 23 Antinews
@c Update the emacs.texi Antinews menu entry with the above version number.
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Basic, Minibuffer, Exiting, Top
+@node Basic
@chapter Basic Editing Commands
@kindex C-h t
the letters @kbd{a} to @kbd{f} serve as part of a character code,
just like digits. Case is ignored.
-@findex ucs-insert
+@findex insert-char
@kindex C-x 8 RET
@cindex Unicode characters, inserting
@cindex insert Unicode character
@cindex characters, inserting by name or code-point
- Instead of @kbd{C-q}, you can use the command @kbd{C-x 8 @key{RET}}
-(@code{ucs-insert}). This prompts for the Unicode name or code-point
+ Alternatively, you can use the command @kbd{C-x 8 @key{RET}}
+(@code{insert-char}). This prompts for the Unicode name or code-point
of a character, using the minibuffer. If you enter a name, the
command provides completion (@pxref{Completion}). If you enter a
-code-point, it should be a hexadecimal number (which is the convention
-for Unicode). The command then inserts the corresponding character
-into the buffer. For example, both of the following insert the
-infinity sign (Unicode code-point @code{U+221E}):
+code-point, it should be as a hexadecimal number (the convention for
+Unicode), or a number with a specified radix, e.g.@: @code{#o23072}
+(octal); @xref{Integer Basics,,, elisp, The Emacs Lisp Reference
+Manual}. The command then inserts the corresponding character into
+the buffer. For example, both of the following insert the infinity
+sign (Unicode code-point @code{U+221E}):
@example
@kbd{C-x 8 @key{RET} infinity @key{RET}}
@kbd{C-x 8 @key{RET} 221e @key{RET}}
@end example
- A numeric argument to either @kbd{C-q} or @kbd{C-x 8 @key{RET}}
-specifies how many copies of the character to insert
-(@pxref{Arguments}).
+ A numeric argument to @kbd{C-q} or @kbd{C-x 8 @key{RET}} specifies
+how many copies of the character to insert (@pxref{Arguments}).
@node Moving Point
@section Changing the Location of Point
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Buffers, Windows, Files, Top
+@node Buffers
@chapter Using Multiple Buffers
@cindex buffers
@table @kbd
@item C-x C-q
-Toggle read-only status of buffer (@code{toggle-read-only}).
+Toggle read-only status of buffer (@code{read-only-mode}).
@item M-x rename-buffer @key{RET} @var{name} @key{RET}
Change the name of the current buffer.
@item M-x rename-uniquely
have special commands to operate on the text; also by visiting a file
whose access control says you cannot write it.
-@findex toggle-read-only
- The command @kbd{C-x C-q} (@code{toggle-read-only}) makes a read-only
+@findex read-only-mode
+@vindex view-read-only
+ The command @kbd{C-x C-q} (@code{read-only-mode}) makes a read-only
buffer writable, and makes a writable buffer read-only. This works by
setting the variable @code{buffer-read-only}, which has a local value
in each buffer and makes the buffer read-only if its value is
-non-@code{nil}.
+non-@code{nil}. If you change the option @code{view-read-only} to a
+non-@code{nil} value, making the buffer read-only with @kbd{C-x C-q}
+also enables View mode in the buffer (@pxref{View Mode}).
@findex rename-buffer
@kbd{M-x rename-buffer} changes the name of the current buffer. You
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Building, Maintaining, Programs, Top
+@node Building
@chapter Compiling and Testing Programs
@cindex building programs
@cindex program building
Flymake mode is a minor mode that performs on-the-fly syntax
checking for many programming and markup languages, including C, C++,
-Perl, HTML, and @TeX{}/La@TeX{}. It is somewhat analogous to Flyspell
+Perl, HTML, and @TeX{}/@LaTeX{}. It is somewhat analogous to Flyspell
mode, which performs spell checking for ordinary human languages in a
similar fashion (@pxref{Spelling}). As you edit a file, Flymake mode
runs an appropriate syntax checking tool in the background, using a
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.
-
- 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.
+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}, 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
@end group
@end smallexample
- However, if @code{gdb-use-separate-io-buffer} is @code{nil}, the I/O
-buffer does not appear and the primary source buffer occupies the full
-width of the frame.
-
@findex gdb-restore-windows
@findex gdb-many-windows
If you ever change the window layout, you can restore the ``many
@c Moved here from the Emacs Lisp Reference Manual, 2005-03-26.
@node Advanced Calendar/Diary Usage
-@section Customizing the Calendar and Diary
+@section More advanced features of the Calendar and Diary
- There are many ways in which you can customize the calendar and
-diary to suit your personal tastes.
+ This section describes some of the more advanced/specialized
+features of the calendar and diary. It starts with some of the
+many ways in which you can customize the calendar and diary to suit
+your personal tastes.
@menu
* Calendar Customizing:: Calendar layout and hooks.
@node Writing Calendar Files
@section Writing Calendar Files
- You can write calendars and diary entries to HTML and La@TeX{} files.
+ You can write calendars and diary entries to HTML and @LaTeX{} files.
@cindex calendar and HTML
The Calendar HTML commands produce files of HTML code that contain
number. The variable @code{cal-html-year-index-cols} specifies the
number of columns in the yearly index page.
-@cindex calendar and La@TeX{}
- The Calendar La@TeX{} commands produce a buffer of La@TeX{} code that
+@cindex calendar and @LaTeX{}
+ The Calendar @LaTeX{} commands produce a buffer of @LaTeX{} code that
prints as a calendar. Depending on the command you use, the printed
calendar covers the day, week, month or year that point is in.
features.
You can use the variable @code{cal-tex-preamble-extra} to insert extra
-La@TeX{} commands in the preamble of the generated document if you need
+@LaTeX{} commands in the preamble of the generated document if you need
to.
@node Holidays
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Emacs Invocation, X Resources, GNU Free Documentation License, Top
+@node Emacs Invocation
@appendix Command Line Arguments for Emacs Invocation
@cindex command line arguments
@cindex arguments (command line)
@item CDPATH
Used by the @code{cd} command to search for the directory you specify,
when you specify a relative directory name.
+@item DBUS_SESSION_BUS_ADDRESS
+Used by D-Bus when Emacs is compiled with it. Usually, there is no
+need to change it. Setting it to a dummy address, like
+@samp{unix:path=/tmp/foo}, suppresses connections to the D-Bus session
+bus.
@item EMACSDATA
Directory for the architecture-independent files that come with Emacs.
This is used to initialize the variable @code{data-directory}.
@raisesections
@end ifnottex
-@node User Input, Keys, Screen, Top
+@node User Input
@section Kinds of User Input
@cindex input with the keyboard
@cindex keyboard input
input events, see @ref{Input Events,,, elisp, The Emacs Lisp Reference
Manual}.
-@node Keys, Commands, User Input, Top
+@node Keys
@section Keys
Some Emacs commands are invoked by just one input event; for
to @kbd{C-M-h}, which does something else entirely. You can, however,
use @key{F1} to display a list of commands starting with @key{ESC}.
-@node Commands, Entering Emacs, Keys, Top
+@node Commands
@section Keys and Commands
@cindex binding
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
fill-column is a variable defined in `C source code'.
fill-column's value is 70
-Automatically becomes buffer-local when set in any fashion.
+Automatically becomes buffer-local when set.
This variable is safe as a file local variable if its value
satisfies the predicate `integerp'.
@noindent
This works by calling @code{auto-fill-mode}, which enables the minor
mode when no argument is supplied (@pxref{Minor Modes}). Next,
-suppose you don't want Auto Fill mode turned on in La@TeX{} mode,
+suppose you don't want Auto Fill mode turned on in @LaTeX{} mode,
which is one of the modes based on Text mode. You can do this with
the following additional line:
Here we have used the special macro @code{lambda} to construct an
anonymous function (@pxref{Lambda Expressions,,, elisp, The Emacs Lisp
Reference Manual}), which calls @code{auto-fill-mode} with an argument
-of @code{-1} to disable the minor mode. Because La@TeX{} mode runs
+of @code{-1} to disable the minor mode. Because @LaTeX{} mode runs
@code{latex-mode-hook} after running @code{text-mode-hook}, the result
leaves Auto Fill mode disabled.
file-local variables for that file (@pxref{File Variables}). Emacs
searches for @file{.dir-locals.el} starting in the directory of the
visited file, and moving up the directory tree. To avoid slowdown,
-this search is skipped for remote files.
+this search is skipped for remote files. If needed, the search can be
+extended for remote files by setting the variable
+@code{enable-remote-dir-locals} to @code{t}.
The @file{.dir-locals.el} file should hold a specially-constructed
list, which maps major mode names (symbols) to alists
better to put them in @file{default.el}, so that users can more easily
override them.
+@cindex site-lisp directories
You can place @file{default.el} and @file{site-start.el} in any of
the directories which Emacs searches for Lisp libraries. The variable
@code{load-path} (@pxref{Lisp Libraries}) specifies these directories.
-Many sites put these files in the @file{site-lisp} subdirectory of the
-Emacs installation directory, typically
+Many sites put these files in a subdirectory named @file{site-lisp} in
+the Emacs installation directory, such as
@file{/usr/local/share/emacs/site-lisp}.
Byte-compiling your init file is not recommended (@pxref{Byte
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Display, Search, Registers, Top
+@node Display
@chapter Controlling the Display
Since only part of a large buffer fits in the window, Emacs has to
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
@ifnottex
-@node Top, Distrib, (dir), (dir)
+@node Top
@top The Emacs Editor
Emacs is the extensible, customizable, self-documenting real-time
@menu
* Distrib:: How to get the latest Emacs distribution.
* Intro:: An introduction to Emacs concepts.
-@c Note that in the printed manual, the glossary and indices come last.
-* Glossary:: Terms used in this manual.
-
-Indexes (each index contains a large menu)
-* Key Index:: An item for each standard Emacs key sequence.
-* Option Index:: An item for every command-line option.
-* Command Index:: An item for each command name.
-* Variable Index:: An item for each documented variable.
-* Concept Index:: An item for each concept.
-
-* Acknowledgments:: Major contributors to GNU Emacs.
Important General Concepts
* Screen:: How to interpret what you see on the screen.
* Microsoft Windows:: Using Emacs on Microsoft Windows and MS-DOS.
* Manifesto:: What's GNU? Gnu's Not Unix!
+* Glossary:: Terms used in this manual.
+@ifnottex
+* Acknowledgments:: Major contributors to GNU Emacs.
+@end ifnottex
+
+Indexes (each index contains a large menu)
+* Key Index:: An item for each standard Emacs key sequence.
+* Option Index:: An item for every command-line option.
+* Command Index:: An item for each command name.
+* Variable Index:: An item for each documented variable.
+* Concept Index:: An item for each concept.
+
@c Do NOT modify the following 3 lines! They must have this form to
@c be correctly identified by `texinfo-multiple-files-update'. In
@c particular, the detailed menu header line MUST be identical to the
* Special Diary Entries:: Anniversaries, blocks of dates, cyclic entries, etc.
@ifnottex
-Customizing the Calendar and Diary
+More advanced features of the Calendar and Diary
* Calendar Customizing:: Calendar layout and hooks.
* Holiday Customizing:: Defining your own holidays.
* Screen Garbled:: Garbage on the screen.
* Text Garbled:: Garbage in the text.
* Memory Full:: How to cope when you run out of memory.
+* Crashing:: What Emacs does when it crashes.
* After a Crash:: Recovering editing in an Emacs session that crashed.
* Emergency Escape:: What to do if Emacs stops responding.
on Macintosh (and GNUstep).
@end iftex
-@node Distrib, Intro, Top, Top
+@node Distrib
@unnumbered Distribution
GNU Emacs is @dfn{free software}; this means that everyone is free to
If you find GNU Emacs useful, please @strong{send a donation} to the
Free Software Foundation to support our work. Donations to the Free
Software Foundation are tax deductible in the US. If you use GNU Emacs
-at your workplace, please suggest that the company make a donation.
+at your workplace, please suggest that the company make a donation.
For more information on how you can help, see
@url{http://www.gnu.org/help/help.html}.
@end display
@iftex
-@node Acknowledgments, Intro, Distrib, Top
+@node Acknowledgments
@unnumberedsec Acknowledgments
Contributors to GNU Emacs include Jari Aalto, Per Abrahamsen, Tomas
Abrahamsson, Jay K.@: Adams, Alon Albert, Michael Albinus, Nagy
-Andras, Benjamin Andresen, Ralf Angeli, Joe Arceneaux, Emil Åström,
+Andras, Benjamin Andresen, Ralf Angeli, Dmitry Antipov, Joe Arceneaux, Emil Åström,
Miles Bader, David Bakhash, Juanma Barranquero, Eli Barzilay, Thomas
Baumann, Steven L.@: Baur, Jay Belanger, Alexander L.@: Belikoff,
Thomas Bellman, Scott Bender, Boaz Ben-Zvi, Sergey Berezin, Karl
Neal Ziring, Teodor Zlatanov, and Detlev Zundel.
@end iftex
-@node Intro, Glossary, Distrib, Top
+@node Intro
@unnumbered Introduction
You are reading about GNU Emacs, the GNU incarnation of the
@include custom.texi
@include trouble.texi
-@node Copying, GNU Free Documentation License, Service, Top
+@node Copying
@appendix GNU GENERAL PUBLIC LICENSE
@include gpl.texi
-@node GNU Free Documentation License, Emacs Invocation, Copying, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
@c The Option Index is produced only in the on-line version,
@c because the index entries related to command-line options
@c tend to point to the same pages and all begin with a dash.
-@c This, and the need to keep the node links consistent, are
-@c the reasons for the funky @iftex/@ifnottex dance below.
-@c The Option Index is _not_ before Key Index, because that
-@c would require changes in the glossary.texi's @node line.
-@c It is not after Concept Index for similar reasons.
-@iftex
-@node Key Index, Command Index, Glossary, Top
+@node Key Index
@unnumbered Key (Character) Index
@printindex ky
-@end iftex
@ifnottex
-@node Key Index, Option Index, Glossary, Top
-@unnumbered Key (Character) Index
-@printindex ky
-
-@node Option Index, Command Index, Key Index, Top
+@node Option Index
@unnumbered Command-Line Options Index
@printindex op
-
-@node Command Index, Variable Index, Option Index, Top
-@unnumbered Command and Function Index
-@printindex fn
@end ifnottex
-@iftex
-@node Command Index, Variable Index, Key Index, Top
+@node Command Index
@unnumbered Command and Function Index
@printindex fn
-@end iftex
-@node Variable Index, Concept Index, Command Index, Top
+@node Variable Index
@unnumbered Variable Index
@printindex vr
-@node Concept Index, Acknowledgments, Variable Index, Top
+@node Concept Index
@unnumbered Concept Index
@printindex cp
@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.2
+@set EMACSVER 24.2.50
@raisesections
@end ifnottex
-@node Entering Emacs, Exiting, Commands, Top
+@node Entering Emacs
@section Entering Emacs
@cindex entering Emacs
@cindex starting Emacs
or @code{t}, which means to display the @file{*scratch*} buffer.
@end ignore
-@node Exiting, Basic, Entering Emacs, Top
+@node Exiting
@section Exiting Emacs
@cindex exiting
@cindex killing Emacs
@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Files, Buffers, Keyboard Macros, Top
+@node Files
@chapter File Handling
@cindex files
or that is marked read-only, Emacs makes the buffer read-only too, so
that you won't go ahead and make changes that you'll have trouble
saving afterward. You can make the buffer writable with @kbd{C-x C-q}
-(@code{toggle-read-only}). @xref{Misc Buffer}.
+(@code{read-only-mode}). @xref{Misc Buffer}.
@kindex C-x C-r
@findex find-file-read-only
idea is that the file is locked whenever an Emacs buffer visiting it
has unsaved changes.
+@vindex create-lockfiles
+ You can prevent the creation of lock files by setting the variable
+@code{create-lockfiles} to @code{nil}. @strong{Caution:} by
+doing so you will lose the benefits that this feature provides.
+
@cindex collision
If you begin to modify the buffer while the visited file is locked by
someone else, this constitutes a @dfn{collision}. When Emacs detects a
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Fixit, Keyboard Macros, Search, Top
+@node Fixit
@chapter Commands for Fixing Typos
@cindex typos, fixing
@cindex mistakes, correcting
@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Frames, International, Windows, Top
+@node Frames
@chapter Frames and Graphical Displays
@cindex frames
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Glossary, Key Index, Intro, Top
+@node Glossary
@unnumbered Glossary
@table @asis
@c Modified versions may not be made.
@ifclear justgnu
-@node Manifesto,, Microsoft Windows, Top
+@node Manifesto
@unnumbered The GNU Manifesto
@end ifclear
@ifset justgnu
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Help, Mark, M-x, Top
+@node Help
@chapter Help
@kindex Help
@cindex help
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Indentation, Text, Modes, Top
+@node Indentation
@chapter Indentation
@cindex indentation
@cindex tabs
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Killing, Registers, Mark, Top
+@node Killing
@chapter Killing and Moving Text
In Emacs, @dfn{killing} means erasing text and copying it into the
On graphical displays, @kbd{C-y} first checks if another application
has placed any text in the system clipboard more recently than the
-last Emacs kill. If so, it inserts the text in the clipboard instead.
+last Emacs kill. If so, it inserts the clipboard's text instead.
Thus, Emacs effectively treats ``cut'' or ``copy'' clipboard
operations performed in other applications like Emacs kills, except
that they are not recorded in the kill ring. @xref{Cut and Paste},
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Keyboard Macros, Files, Fixit, Top
+@node Keyboard Macros
@chapter Keyboard Macros
@cindex defining keyboard macros
@cindex keyboard macro
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node M-x, Help, Minibuffer, Top
+@node M-x
@chapter Running Commands by Name
Every Emacs command has a name that you can use to run it. For
@c This is part of the Emacs manual.
@c Copyright (C) 2000-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Mac OS / GNUstep, Microsoft Windows, Antinews, Top
+@node Mac OS / GNUstep
@appendix Emacs and Mac OS / GNUstep
@cindex Mac OS X
@cindex Macintosh
* GNUstep Support:: Details on status of GNUstep support.
@end menu
-@node Mac / GNUstep Basics, Mac / GNUstep Customization, , Mac OS / GNUstep
+@node Mac / GNUstep Basics
@section Basic Emacs usage under Mac OS and GNUstep
By default, the @key{alt} and @key{option} keys are the same as
of setting PATH is recommended on Mac OS X 10.5 and later, using the
@file{/etc/paths} files and the @file{/etc/paths.d} directory.
-@node Mac / GNUstep Customization, Mac / GNUstep Events, Mac / GNUstep Basics, Mac OS / GNUstep
+@node Mac / GNUstep Customization
@section Mac / GNUstep Customization
Emacs can be customized in several ways in addition to the standard
@end table
-@node Mac / GNUstep Events, GNUstep Support, Mac / GNUstep Customization, Mac OS / GNUstep
+@node Mac / GNUstep Events
@section Windowing System Events under Mac OS / GNUstep
Nextstep applications receive a number of special events which have
services and receive the results back. Note that you may need to
restart Emacs to access newly-available services.
-@node GNUstep Support, , Mac / GNUstep Events, Mac OS / GNUstep
+@node GNUstep Support
@section GNUstep Support
Emacs can be built and run under GNUstep, but there are still
@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Maintaining, Abbrevs, Building, Top
+@node Maintaining
@chapter Maintaining Large Programs
This chapter describes Emacs features for maintaining large
@samp{@var{class}.@var{variable}} and @samp{@var{class}.@var{function}}.
@item
-In La@TeX{} documents, the arguments for @code{\chapter},
+In @LaTeX{} documents, the arguments for @code{\chapter},
@code{\section}, @code{\subsection}, @code{\subsubsection},
@code{\eqno}, @code{\label}, @code{\ref}, @code{\cite},
@code{\bibitem}, @code{\part}, @code{\appendix}, @code{\entry},
#### -*- Makefile -*- for the Emacs Manual
-# Copyright (C) 2003-2012 Free Software Foundation, Inc.
+# Copyright (C) 2003-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
MAKEINFO = makeinfo
MAKEINFO_OPTS = --force --enable-encoding -I$(srcdir)
MULTI_INSTALL_INFO = $(srcdir)\..\..\nt\multi-install-info.bat
-INFO_TARGETS = $(infodir)/emacs
+INFO_EXT=.info
+INFO_OPTS=--no-split
+INFO_TARGETS = $(infodir)/emacs$(INFO_EXT)
DVI_TARGETS = emacs.dvi
INFOSOURCES = info.texi
$(infodir)/dir:
$(MULTI_INSTALL_INFO) --info-dir=$(infodir) $(INFO_TARGETS)
-$(infodir)/emacs: $(EMACSSOURCES)
- $(MAKEINFO) $(MAKEINFO_OPTS) emacs.texi
+$(infodir)/emacs$(INFO_EXT): $(EMACSSOURCES)
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ emacs.texi
emacs.dvi: $(EMACSSOURCES)
$(ENVADD) $(TEXI2DVI) $(srcdir)/emacs.texi
mostlyclean:
- $(DEL) *.log *.cp *.fn *.ky *.pg *.vr core *.tp *.core gnustmp.*
+## FIXME $(infodir)/emacs* deletes too much, eg emacs-mime.
clean: mostlyclean
- $(DEL) *.dvi
- $(DEL) $(infodir)/emacs*
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Mark, Killing, Help, Top
+@node Mark
@chapter The Mark and the Region
@cindex mark
@cindex setting a mark
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Minibuffer, M-x, Basic, Top
+@node Minibuffer
@chapter The Minibuffer
@cindex minibuffer
select the slice.
@c ??? How does this work?
+ The most convenient way is to set the optimal slice by using
+BoundingBox information automatically determined from the document by
+typing @kbd{s b} (@code{doc-view-set-slice-using-mouse}).
+
@findex doc-view-reset-slice
To cancel the selected slice, type @kbd{s r}
(@code{doc-view-reset-slice}). Then DocView shows the entire page
with your device and will probably only see garbage output in the
window.
-@node Emacs Server, Printing, Shell, Top
+@node Emacs Server
@section Using Emacs as a Server
@pindex emacsclient
@cindex Emacs as a server
files(s) in an existing frame rather than a new client frame, negating
the effect of @samp{-t}.
-@node Printing, Sorting, Emacs Server, Top
+@node Printing
@section Printing Hard Copies
@cindex hardcopy
@cindex printing
* Printing Package:: An optional advanced printing interface.
@end menu
-@node PostScript, PostScript Variables,, Printing
+@node PostScript
@subsection PostScript Hardcopy
These commands convert buffer contents to PostScript,
can be customized in group @code{handwrite}. This function only
supports ISO 8859-1 characters.
-@node PostScript Variables, Printing Package, PostScript, Printing
+@node PostScript Variables
@subsection Variables for PostScript Hardcopy
@vindex ps-lpr-command
Many other customization variables for these commands are defined and
described in the Lisp files @file{ps-print.el} and @file{ps-mule.el}.
-@node Printing Package,, PostScript Variables, Printing
+@node Printing Package
@subsection Printing Package
@cindex Printing package
hexl-@key{RET}} for details.
-@node Saving Emacs Sessions, Recursive Edit, Editing Binary Files, Top
+@node Saving Emacs Sessions
@section Saving Emacs Sessions
@cindex saving sessions
@cindex restore session
If you want to save minibuffer history from one session to
another, use the @code{savehist} library.
-@node Recursive Edit, Emulation, Saving Emacs Sessions, Top
+@node Recursive Edit
@section Recursive Editing Levels
@cindex recursive editing level
@cindex editing level, recursive
approaches give you more flexibility to go back to unfinished tasks in
the order you choose.
-@node Emulation, Hyperlinking, Recursive Edit, Top
+@node Emulation
@section Emulation
@cindex emulating other editors
@cindex other editors
key bindings.
@end table
-@node Hyperlinking, Amusements, Emulation, Top
+@node Hyperlinking
@section Hyperlinking and Navigation Features
The following subsections describe convenience features for handling
find the one you select (@code{ffap-menu}).
@end table
-@node Amusements, Packages, Hyperlinking, Top
+@node Amusements
@section Other Amusements
@cindex boredom
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Modes, Indentation, International, Top
+@node Modes
@chapter Major and Minor Modes
Emacs contains many @dfn{editing modes} that alter its basic
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Microsoft Windows, Manifesto, Mac OS / GNUstep, Top
+@node Microsoft Windows
@appendix Emacs and Microsoft Windows/MS-DOS
@cindex Microsoft Windows
@cindex MS-Windows, Emacs peculiarities
@c This is part of the Emacs manual.
@c Copyright (C) 1997, 1999-2012 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node International, Modes, Frames, Top
+@node International
@chapter International Character Set Support
@c This node is referenced in the tutorial. When renaming or deleting
@c it, the tutorial needs to be adjusted. (TUTORIAL.de)
used, generally don't have keys for all the characters in them. You
can insert characters that your keyboard does not support, using
@kbd{C-q} (@code{quoted-insert}) or @kbd{C-x 8 @key{RET}}
-(@code{ucs-insert}). @xref{Inserting Text}. Emacs also supports
+(@code{insert-char}). @xref{Inserting Text}. Emacs also supports
various @dfn{input methods}, typically one for each script or
language, which make it easier to type characters in the script.
@xref{Input Methods}.
This includes the Emacs initialization
file, @file{.emacs}, and the initialization files of packages
such as Gnus. However, you can specify unibyte loading for a
-particular Lisp file, by adding an entry @samp{unibyte: t} in a file
-local variables section (@pxref{File Variables}). Then that file is
-always loaded as unibyte text. Note that this does not represent a
-real @code{unibyte} variable, rather it just acts as an indicator
-to Emacs in the same way as @code{coding} does (@pxref{Specify Coding}).
+particular Lisp file, by adding an entry @samp{coding: raw-text} in a file
+local variables section. @xref{Specify Coding}.
+Then that file is always loaded as unibyte text.
@ignore
@c I don't see the point of this statement:
The motivation for these conventions is that it is more reliable to
always load any particular Lisp file in the same way.
@end ignore
-Note also that this feature only applies to @emph{loading} Lisp files
-for evaluation, not to visiting them for editing. You can also load a
-Lisp file as unibyte, on any one occasion, by typing @kbd{C-x
-@key{RET} c raw-text @key{RET}} immediately before loading it.
+You can also load a Lisp file as unibyte, on any one occasion, by
+typing @kbd{C-x @key{RET} c raw-text @key{RET}} immediately before
+loading it.
@c See http://debbugs.gnu.org/11226 for lack of unibyte tooltip.
@vindex enable-multibyte-characters
not when you are in the minibuffer).
Another facility for typing characters not on your keyboard is by
-using @kbd{C-x 8 @key{RET}} (@code{ucs-insert}) to insert a single
+using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single
character based on its Unicode name or code-point; see @ref{Inserting
Text}.
@c Copyright (C) 1985-1987, 1993-1995, 1997, 1999-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Programs, Building, Text, Top
+@node Programs
@chapter Editing Programs
@cindex Lisp editing
@cindex C editing
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Registers, Display, Killing, Top
+@node Registers
@chapter Registers
@cindex registers
Insert text from register @var{r} (@code{insert-register}).
@item M-x append-to-register @key{RET} @var{r}
Append region to text in register @var{r}.
+
+@kindex C-x r +
+When register @var{r} contains text, you can use @kbd{C-x r +}
+(@code{increment-register}) to append to that register. Note that
+command @kbd{C-x r +} behaves differently if @var{r} contains a
+number. @xref{Number Registers}.
+
@item M-x prepend-to-register @key{RET} @var{r}
Prepend region to text in register @var{r}.
@end table
the region text to the text in the register instead of
@emph{appending} it.
+@vindex register-separator
+ When you are collecting text using @code{append-to-register} and
+@code{prepend-to-register}, you may want to separate individual
+collected pieces using a separator. In that case, configure a
+@code{register-separator} and store the separator text in to that
+register. For example, to get double newlines as text separator
+during the collection process, you can use the following setting.
+
+@example
+(setq register-separator ?+)
+(set-register register-separator "\n\n")
+@end example
+
@kindex C-x r i
@findex insert-register
@kbd{C-x r i @var{r}} inserts in the buffer the text from register
@item C-u @var{number} C-x r + @var{r}
@kindex C-x r +
@findex increment-register
-Increment the number in register @var{r} by @var{number}
-(@code{increment-register}).
+If @var{r} contains a number, increment the number in that register by
+@var{number}. Note that command @kbd{C-x r +}
+(@code{increment-register}) behaves differently if @var{r} contains
+text. @xref{Text Registers}.
@item C-x r i @var{r}
Insert the number from register @var{r} into the buffer.
@end table
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Screen, User Input, Acknowledgments, Top
+@node Screen
@chapter The Organization of the Screen
@cindex screen
@cindex frame
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Search, Fixit, Display, Top
+@node Search
@chapter Searching and Replacement
@cindex searching
@cindex finding strings within text
* Query Replace:: How to use querying.
@end menu
-@node Unconditional Replace, Regexp Replace, Replace, Replace
+@node Unconditional Replace
@subsection Unconditional Replacement
@findex replace-string
@xref{Replacement and Case}, for details about case-sensitivity in
replace commands.
-@node Regexp Replace, Replacement and Case, Unconditional Replace, Replace
+@node Regexp Replace
@subsection Regexp Replacement
@findex replace-regexp
\,(format "%-72sABC%05d" \& \#) @key{RET}
@end example
-@node Replacement and Case, Query Replace, Regexp Replace, Replace
+@node Replacement and Case
@subsection Replace Commands and Case
If the first argument of a replace command is all lower case, the
@code{case-replace} or @code{case-fold-search} is set to @code{nil},
replacement is done without case conversion.
-@node Query Replace,, Replacement and Case, Replace
+@node Query Replace
@subsection Query Replace
@cindex query replace
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Text, Programs, Indentation, Top
+@node Text
@chapter Commands for Human Languages
@cindex text
@cindex manipulating text
@cindex mode, nXML
@findex nxml-mode
Emacs has other major modes for text which contains ``embedded''
-commands, such as @TeX{} and La@TeX{} (@pxref{TeX Mode}); HTML and
+commands, such as @TeX{} and @LaTeX{} (@pxref{TeX Mode}); HTML and
SGML (@pxref{HTML Mode}); XML
@ifinfo
(@pxref{Top,The nXML Mode Manual,,nxml-mode, nXML Mode});
export and publication. To export the current buffer, type @kbd{C-c
C-e} (@code{org-export}) anywhere in an Org buffer. This command
prompts for an export format; currently supported formats include
-HTML, La@TeX{}, OpenDocument (@file{.odt}), and PDF. Some formats,
+HTML, @LaTeX{}, OpenDocument (@file{.odt}), and PDF. Some formats,
such as PDF, require certain system tools to be installed.
@vindex org-publish-project-alist
@node TeX Mode
@section @TeX{} Mode
@cindex @TeX{} mode
-@cindex La@TeX{} mode
+@cindex @LaTeX{} mode
@cindex Sli@TeX{} mode
@cindex Doc@TeX{} mode
@cindex mode, @TeX{}
-@cindex mode, La@TeX{}
+@cindex mode, @LaTeX{}
@cindex mode, Sli@TeX{}
@cindex mode, Doc@TeX{}
@findex tex-mode
Emacs provides special major modes for editing files written in
@TeX{} and its related formats. @TeX{} is a powerful text formatter
written by Donald Knuth; like GNU Emacs, it is free software.
-La@TeX{} is a simplified input format for @TeX{}, implemented using
+@LaTeX{} is a simplified input format for @TeX{}, implemented using
@TeX{} macros. Doc@TeX{} is a special file format in which the
-La@TeX{} sources are written, combining sources with documentation.
-Sli@TeX{} is an obsolete special form of La@TeX{}.@footnote{It has
+@LaTeX{} sources are written, combining sources with documentation.
+Sli@TeX{} is an obsolete special form of @LaTeX{}.@footnote{It has
been replaced by the @samp{slides} document class, which comes with
-La@TeX{}.}
+@LaTeX{}.}
@vindex tex-default-mode
- @TeX{} mode has four variants: Plain @TeX{} mode, La@TeX{} mode,
+ @TeX{} mode has four variants: Plain @TeX{} mode, @LaTeX{} mode,
Doc@TeX{} mode, and Sli@TeX{} mode. These distinct major modes differ
only slightly, and are designed for editing the four different
formats. Emacs selects the appropriate mode by looking at the
@itemize @bullet
@item
Bib@TeX{} mode is a major mode for Bib@TeX{} files, which are commonly
-used for keeping bibliographic references for La@TeX{} documents. For
+used for keeping bibliographic references for @LaTeX{} documents. For
more information, see the documentation string for the command
@code{bibtex-mode}.
@item
The Ref@TeX{} package provides a minor mode which can be used with
-La@TeX{} mode to manage bibliographic references.
+@LaTeX{} mode to manage bibliographic references.
@ifinfo
@xref{Top,The Ref@TeX{} Manual,,reftex}.
@end ifinfo
to work with them.
@node LaTeX Editing
-@subsection La@TeX{} Editing Commands
+@subsection @LaTeX{} Editing Commands
- La@TeX{} mode provides a few extra features not applicable to plain
+ @LaTeX{} mode provides a few extra features not applicable to plain
@TeX{}:
@table @kbd
@item C-c C-o
-Insert @samp{\begin} and @samp{\end} for La@TeX{} block and position
+Insert @samp{\begin} and @samp{\end} for @LaTeX{} block and position
point on a line between them (@code{tex-latex-block}).
@item C-c C-e
-Close the innermost La@TeX{} block not yet closed
+Close the innermost @LaTeX{} block not yet closed
(@code{tex-close-latex-block}).
@end table
@findex tex-latex-block
-@kindex C-c C-o @r{(La@TeX{} mode)}
- In La@TeX{} input, @samp{\begin} and @samp{\end} tags are used to
+@kindex C-c C-o @r{(@LaTeX{} mode)}
+ In @LaTeX{} input, @samp{\begin} and @samp{\end} tags are used to
group blocks of text. To insert a block, type @kbd{C-c C-o}
(@code{tex-latex-block}). This prompts for a block type, and inserts
the appropriate matching @samp{\begin} and @samp{\end} tags, leaving a
@vindex latex-block-names
When entering the block type argument to @kbd{C-c C-o}, you can use
the usual completion commands (@pxref{Completion}). The default
-completion list contains the standard La@TeX{} block types. If you
+completion list contains the standard @LaTeX{} block types. If you
want additional block types for completion, customize the list
variable @code{latex-block-names}.
@findex tex-close-latex-block
-@kindex C-c C-e @r{(La@TeX{} mode)}
+@kindex C-c C-e @r{(@LaTeX{} mode)}
@findex latex-electric-env-pair-mode
- In La@TeX{} input, @samp{\begin} and @samp{\end} tags must balance.
+ In @LaTeX{} input, @samp{\begin} and @samp{\end} tags must balance.
You can use @kbd{C-c C-e} (@code{tex-close-latex-block}) to insert an
@samp{\end} tag which matches the last unmatched @samp{\begin}. It
also indents the @samp{\end} to match the corresponding @samp{\begin},
The buffer's @TeX{} variant determines what shell command @kbd{C-c
C-b} actually runs. In Plain @TeX{} mode, it is specified by the
variable @code{tex-run-command}, which defaults to @code{"tex"}. In
-La@TeX{} mode, it is specified by @code{latex-run-command}, which
+@LaTeX{} mode, it is specified by @code{latex-run-command}, which
defaults to @code{"latex"}. The shell command that @kbd{C-c C-v} runs
to view the @file{.dvi} output is determined by the variable
@code{tex-dvi-view-command}, regardless of the @TeX{} variant. The
If @samp{%**start of header} does not appear within the first 100 lines of
the buffer, @kbd{C-c C-r} assumes that there is no header.
- In La@TeX{} mode, the header begins with @samp{\documentclass} or
+ In @LaTeX{} mode, the header begins with @samp{\documentclass} or
@samp{\documentstyle} and ends with @samp{\begin@{document@}}. These
-are commands that La@TeX{} requires you to use in any case, so nothing
+are commands that @LaTeX{} requires you to use in any case, so nothing
special needs to be done to identify the header.
@findex tex-file
@findex tex-bibtex-file
@kindex C-c TAB @r{(@TeX{} mode)}
@vindex tex-bibtex-command
- For La@TeX{} files, you can use Bib@TeX{} to process the auxiliary
+ For @LaTeX{} files, you can use Bib@TeX{} to process the auxiliary
file for the current buffer's file. Bib@TeX{} looks up bibliographic
citations in a data base and prepares the cited references for the
bibliography section. The command @kbd{C-c @key{TAB}}
finished executing. @xref{Undo}, for more information about the undo
facility.
-@node Lossage, Bugs, Quitting, Top
+@node Lossage
@section Dealing with Emacs Trouble
This section describes how to recognize and deal with situations in
* Screen Garbled:: Garbage on the screen.
* Text Garbled:: Garbage in the text.
* Memory Full:: How to cope when you run out of memory.
+* Crashing:: What Emacs does when it crashes.
* After a Crash:: Recovering editing in an Emacs session that crashed.
* Emergency Escape:: What to do if Emacs stops responding.
@end menu
out of memory, because the buffer menu needs a fair amount of memory
itself, and the reserve supply may not be enough.
+@node Crashing
+@subsection When Emacs Crashes
+
+ Emacs is not supposed to crash, but if it does, before it exits it
+reports a brief summary of the crash to the standard error stream
+@code{stderr}. If enabled, a crashed Emacs also generates a core dump
+containing voluminous data about the crash. On many platforms you can
+enable core dumps by putting the shell command @samp{ulimit -c unlimited}
+into your shell startup script. The crash report and core dump can be
+used when debugging the same version of Emacs on the same platform.
+
+The format of the crash report depends on the platform, and some
+platforms support backtraces.
+Here is an example, generated on x86-64 GNU/Linux with version 2.15 of
+the GNU C Library:
+
+@example
+Fatal error 11: Segmentation fault
+Backtrace:
+emacs[0x5094e4]
+emacs[0x4ed3e6]
+emacs[0x4ed504]
+/lib64/libpthread.so.0[0x375220efe0]
+/lib64/libpthread.so.0(read+0xe)[0x375220e08e]
+emacs[0x509af6]
+emacs[0x5acc26]
+emacs[0x5adbfb]
+emacs[0x56566b]
+emacs[0x59bac3]
+emacs[0x565151]
+...
+@end example
+
+@noindent
+The number @samp{11} is the system signal number that corresponds to
+the problem, a segmentation fault here. The three dots at the end
+indicate that Emacs suppressed further backtrace entries, in the
+interest of brevity.
+
+The hexadecimal program addresses can be useful in debugging sessions.
+For example, the GDB command @samp{list *0x509af6} prints the
+source-code lines corresponding to the @samp{emacs[0x509af6]} entry in
+the backtrace. Or, if your system has @command{addr2line}, the
+following shell command outputs a backtrace with source-code line
+numbers:
+
+@example
+sed -n 's/.*\[\(.*\)]$/\1/p' @var{backtrace} |
+ addr2line -Cfip -e @var{bindir}/emacs
+@end example
+
+@noindent
+Here, @var{backtrace} is the name of a text file containing a copy of
+the backtrace, and @var{bindir} is the name of the directory that
+contains the Emacs executable.
+
@node After a Crash
@subsection Recovery After a Crash
emergency escape---but there are cases where it won't work, when
system call hangs or when Emacs is stuck in a tight loop in C code.
-@node Bugs, Contributing, Lossage, Top
+@node Bugs
@section Reporting Bugs
@cindex bugs
form that is clearly safe to install.
@end itemize
-@node Contributing, Service, Bugs, Top
+@node Contributing
@section Contributing to Emacs Development
@cindex contributing to Emacs
For more information on how to contribute, see the @file{etc/CONTRIBUTE}
file in the Emacs distribution.
-@node Service, Copying, Contributing, Top
+@node Service
@section How To Get Help with GNU Emacs
If you need help installing, using or changing GNU Emacs, there are two
@c Copyright (C) 1985-1987, 1993-1995, 1997, 2000-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Windows, Frames, Buffers, Top
+@node Windows
@chapter Multiple Windows
@cindex windows in Emacs
@cindex multiple windows in Emacs
expression to the list @code{same-window-regexps}. By default, these
variables are @code{nil}, so this step is skipped.
-@vindex display-buffer-reuse-frames
@item
Otherwise, if the buffer is already displayed in an existing window,
``reuse'' that window. Normally, only windows on the selected frame
are considered, but windows on other frames are also reusable if you
-change @code{display-buffer-reuse-frames} to @code{t}, or if you
change @code{pop-up-frames} (see below) to @code{t}.
@item
@c Copyright (C) 1987, 1993-1995, 1997, 2001-2012
@c Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node X Resources, Antinews, Emacs Invocation, Top
+@node X Resources
@appendix X Options and Resources
You can customize some X-related aspects of Emacs behavior using X
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-06-21 Glenn Morris <rgm@gnu.org>
- * Version 24.2 released.
+ * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
-2012-06-19 Glenn Morris <rgm@gnu.org>
+2012-05-29 Glenn Morris <rgm@gnu.org>
- * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
+ * emacs-lisp-intro.texi: Nuke hand-written node pointers.
+ (dolist, dotimes): Fix sectioning.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-05-12 Glenn Morris <rgm@gnu.org>
- * Version 24.1 released.
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkinfodir): Use $MKDIR_P.
-2012-05-04 Glenn Morris <rgm@gnu.org>
+2012-05-05 Glenn Morris <rgm@gnu.org>
* emacs-lisp-intro.texi (Making Errors): Don't mention Emacs 20.
(Void Function, Wrong Type of Argument, Recursion with list)
(Simple Extension): Assume a non-ancient Emacs.
(Void Variable, Switching Buffers): Improve page breaks.
-2012-05-03 Glenn Morris <rgm@gnu.org>
-
* emacs-lisp-intro.texi: Update GNU Press contact details.
-2012-04-28 Glenn Morris <rgm@gnu.org>
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (INFO_EXT, INFO_OPTS): New, set by configure.
+ (info, infoclean): Use $INFO_EXT.
+ (${infodir}/eintr$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+ * makefile.w32-in (INFO_EXT, INFO_OPTS): New.
+ (INFO_TARGETS, clean): Use $INFO_EXT.
+ ($(infodir)/eintr$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
* emacs-lisp-intro.texi (Syntax): Reword to avoid underfull hbox.
-2012-04-07 Glenn Morris <rgm@gnu.org>
+2012-04-14 Glenn Morris <rgm@gnu.org>
* Makefile.in: Replace non-portable use of $< in ordinary rules.
`named' to `selected'.
(lengths-list-file): Remove extraneous parenthesis from reference.
(lengths-list-many-files): Explain `expand-file-name' better.
- (Files List): Rephrase sentence regarding Lisp sources directory
+ (Files List): Rephrase sentence regarding Lisp sources directory.
2006-11-04 Robert J. Chassell <bob@rattlesnake.com>
# Directory with the (customized) texinfo.tex file.
texinfodir = $(srcdir)/../misc
+MKDIR_P = @MKDIR_P@
+
+INFO_EXT=@INFO_EXT@
+# Options used only when making info output.
+INFO_OPTS=@INFO_OPTS@
+
MAKEINFO = @MAKEINFO@
MAKEINFO_OPTS = --force -I $(srcdir)
TEXI2DVI = texi2dvi
ENVADD = TEXINPUTS="$(srcdir):$(texinfodir):$(TEXINPUTS)" \
MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)"
-mkinfodir = @test -d ${buildinfodir} || mkdir ${buildinfodir} || test -d ${buildinfodir}
+mkinfodir = @${MKDIR_P} ${buildinfodir}
.PHONY: info dvi html pdf ps
-info: ${buildinfodir}/eintr
+info: ${buildinfodir}/eintr$(INFO_EXT)
dvi: emacs-lisp-intro.dvi
html: emacs-lisp-intro.html
# The file name eintr must fit within 5 characters, to allow for
# -NN extensions to fit into DOS 8+3 limits without clashing.
# Note: "<" is not portable in ordinary make rules.
-${buildinfodir}/eintr: ${srcdir}/emacs-lisp-intro.texi
+${buildinfodir}/eintr$(INFO_EXT): ${srcdir}/emacs-lisp-intro.texi
$(mkinfodir)
- $(MAKEINFO) $(MAKEINFO_OPTS) -o $@ ${srcdir}/emacs-lisp-intro.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs-lisp-intro.texi
emacs-lisp-intro.dvi: ${srcdir}/emacs-lisp-intro.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-lisp-intro.texi
distclean: clean
infoclean:
- -cd $(buildinfodir) && rm -f eintr eintr-[1-9]
+ -cd $(buildinfodir) && rm -f eintr$(INFO_EXT) eintr$(INFO_EXT)-[1-9]
maintainer-clean: distclean infoclean
@contents
@ifnottex
-@node Top, Preface, (dir), (dir)
+@node Top
@top An Introduction to Programming in Emacs Lisp
@insertcopying
@end detailmenu
@end menu
-@node Preface, List Processing, Top, Top
-@comment node-name, next, previous, up
+@node Preface
@unnumbered Preface
Most of the GNU Emacs integrated environment is written in the programming
* Thank You::
@end menu
-@node Why, On Reading this Text, Preface, Preface
@ifnottex
+@node Why
@unnumberedsec Why Study Emacs Lisp?
@end ifnottex
fundamentals of programming, and more importantly, to show you how you
can teach yourself to go further.
-@node On Reading this Text, Who You Are, Why, Preface
-@comment node-name, next, previous, up
+@node On Reading this Text
@unnumberedsec On Reading this Text
All through this document, you will see little sample programs you can
something new. This self-reliance is not only a pleasure, but an
advantage.
-@node Who You Are, Lisp History, On Reading this Text, Preface
-@comment node-name, next, previous, up
+@node Who You Are
@unnumberedsec For Whom This is Written
This text is written as an elementary introduction for people who are
@cite{Introduction}, you will find the @cite{Reference Manual} useful
when you are writing your own programs.
-@node Lisp History, Note for Novices, Who You Are, Preface
+@node Lisp History
@unnumberedsec Lisp History
@cindex Lisp history
Lisp. (The standard Emacs distribution contains an optional extensions
file, @file{cl.el}, that adds many Common Lisp features to Emacs Lisp.)
-@node Note for Novices, Thank You, Lisp History, Preface
-@comment node-name, next, previous, up
+@node Note for Novices
@unnumberedsec A Note for Novices
If you don't know GNU Emacs, you can still read this document
referring to the various dialects of Lisp in general, but when I speak
of Emacs Lisp, I am referring to GNU Emacs Lisp in particular.
-@node Thank You, , Note for Novices, Preface
-@comment node-name, next, previous, up
+@node Thank You
@unnumberedsec Thank You
My thanks to all who helped me with this book. My especial thanks to
@global@pageno = 1
@end iftex
-@node List Processing, Practicing Evaluation, Preface, Top
-@comment node-name, next, previous, up
+@node List Processing
@chapter List Processing
To the untutored eye, Lisp is a strange programming language. In Lisp
* Error Message Exercises::
@end menu
-@node Lisp Lists, Run a Program, List Processing, List Processing
-@comment node-name, next, previous, up
+@node Lisp Lists
@section Lisp Lists
@cindex Lisp Lists
* Typing Lists:: How GNU Emacs helps you type lists.
@end menu
-@node Numbers Lists, Lisp Atoms, Lisp Lists, Lisp Lists
@ifnottex
+@node Numbers Lists
@unnumberedsubsec Numbers, Lists inside of Lists
@end ifnottex
list is made up of the words @samp{a}, @samp{list}, @samp{inside},
@samp{of}, @samp{it}.
-@node Lisp Atoms, Whitespace in Lists, Numbers Lists, Lisp Lists
-@comment node-name, next, previous, up
+@node Lisp Atoms
@subsection Lisp Atoms
@cindex Lisp Atoms
Strings are a different kind of atom than numbers or symbols and are
used differently.
-@node Whitespace in Lists, Typing Lists, Lisp Atoms, Lisp Lists
-@comment node-name, next, previous, up
+@node Whitespace in Lists
@subsection Whitespace in Lists
@cindex Whitespace in lists
(For certain situations, square brackets, dots and a few other special
characters may be used; however, we will go quite far without them.)
-@node Typing Lists, , Whitespace in Lists, Lisp Lists
-@comment node-name, next, previous, up
+@node Typing Lists
@subsection GNU Emacs Helps You Type Lists
@cindex Help typing lists
@cindex Formatting help
parenthesis. (@xref{Major Modes, , Major Modes, emacs, The GNU Emacs
Manual}, for more information about Emacs's modes.)
-@node Run a Program, Making Errors, Lisp Lists, List Processing
-@comment node-name, next, previous, up
+@node Run a Program
@section Run a Program
@cindex Run a program
@cindex Program, running one
But before discussing this (@pxref{Variables}), we will discuss what the
Lisp interpreter does when you make an error.
-@node Making Errors, Names & Definitions, Run a Program, List Processing
-@comment node-name, next, previous, up
+@node Making Errors
@section Generate an Error Message
@cindex Generate an error message
@cindex Error message generation
definition is void:@: this}. The symbol (that is, the word
@samp{this}) lacks instructions for the computer to carry out.
-@node Names & Definitions, Lisp Interpreter, Making Errors, List Processing
-@comment node-name, next, previous, up
+@node Names & Definitions
@section Symbol Names and Function Definitions
@cindex Symbol names
@samp{texinfo-} and those for functions that deal with reading mail
start with @samp{rmail-}.
-@node Lisp Interpreter, Evaluation, Names & Definitions, List Processing
-@comment node-name, next, previous, up
+@node Lisp Interpreter
@section The Lisp Interpreter
@cindex Lisp interpreter, what it does
@cindex Interpreter, what it does
* Byte Compiling:: Specially processing code for speed.
@end menu
-@node Complications, Byte Compiling, Lisp Interpreter, Lisp Interpreter
@ifnottex
+@node Complications
@unnumberedsubsec Complications
@end ifnottex
Otherwise, the interpreter works left to right, from one expression to
the next.
-@node Byte Compiling, , Complications, Lisp Interpreter
+@node Byte Compiling
@subsection Byte Compiling
@cindex Byte compiling
The GNU Emacs Lisp Reference Manual}, for a full description of byte
compilation.
-@node Evaluation, Variables, Lisp Interpreter, List Processing
-@comment node-name, next, previous, up
+@node Evaluation
@section Evaluation
@cindex Evaluation
* Evaluating Inner Lists:: Lists within lists...
@end menu
-@node How the Interpreter Acts, Evaluating Inner Lists, Evaluation, Evaluation
@ifnottex
+@node How the Interpreter Acts
@unnumberedsubsec How the Lisp Interpreter Acts
@end ifnottex
Lisp interpreter to return a value and perhaps carry out a side effect;
or else produce an error.
-@node Evaluating Inner Lists, , How the Interpreter Acts, Evaluation
-@comment node-name, next, previous, up
+@node Evaluating Inner Lists
@subsection Evaluating Inner Lists
@cindex Inner list evaluation
@cindex Evaluating inner lists
symbol by itself is evaluated, something different happens, as we will
see in the next section.
-@node Variables, Arguments, Evaluation, List Processing
-@comment node-name, next, previous, up
+@node Variables
@section Variables
@cindex Variables
* Void Variable:: The error message for a symbol without a value.
@end menu
-@node fill-column Example, Void Function, Variables, Variables
@ifnottex
+@node fill-column Example
@unnumberedsubsec @code{fill-column}, an Example Variable
@end ifnottex
Setting the Value of a Variable}, for information about one way to do
this.
-@node Void Function, Void Variable, fill-column Example, Variables
-@comment node-name, next, previous, up
+@node Void Function
@subsection Error Message for a Symbol Without a Function
@cindex Symbol without function error
@cindex Error for symbol without function
another key.)
@end ignore
-@node Void Variable, , Void Function, Variables
-@comment node-name, next, previous, up
+@node Void Variable
@subsection Error Message for a Symbol Without a Value
@cindex Symbol without value error
@cindex Error for symbol without value
The meaning is the same as in GNU Emacs 22.
@end ignore
-@node Arguments, set & setq, Variables, List Processing
-@comment node-name, next, previous, up
+@node Arguments
@section Arguments
@cindex Arguments
@cindex Passing information to functions
* message:: A useful function for sending messages.
@end menu
-@node Data types, Args as Variable or List, Arguments, Arguments
-@comment node-name, next, previous, up
+@node Data types
@subsection Arguments' Data Types
@cindex Data types
@cindex Types of data
a substring from an argument that is a string, not from another type of
atom such as a number or symbol.
-@node Args as Variable or List, Variable Number of Arguments, Data types, Arguments
-@comment node-name, next, previous, up
+@node Args as Variable or List
@subsection An Argument as the Value of a Variable or List
An argument can be a symbol that returns a value when it is evaluated.
integer that the addition function returns to a string.
@code{number-to-string} is also known as @code{int-to-string}.)
-@node Variable Number of Arguments, Wrong Type of Argument, Args as Variable or List, Arguments
-@comment node-name, next, previous, up
+@node Variable Number of Arguments
@subsection Variable Number of Arguments
@cindex Variable number of arguments
@cindex Arguments, variable number of
@end group
@end smallexample
-@node Wrong Type of Argument, message, Variable Number of Arguments, Arguments
-@comment node-name, next, previous, up
+@node Wrong Type of Argument
@subsection Using the Wrong Type Object as an Argument
@cindex Wrong type of argument
@cindex Argument, wrong type of
@file{*Backtrace*} buffer.
@end ignore
-@node message, , Wrong Type of Argument, Arguments
-@comment node-name, next, previous, up
+@node message
@subsection The @code{message} Function
@findex message
message @code{"He saw 38 red foxes leaping."} appears in your echo
area.
-@node set & setq, Summary, Arguments, List Processing
-@comment node-name, next, previous, up
+@node set & setq
@section Setting the Value of a Variable
@cindex Variable, setting value
@cindex Setting value of variable
* Counting:: Using @code{setq} to count.
@end menu
-@node Using set, Using setq, set & setq, set & setq
-@comment node-name, next, previous, up
+@node Using set
@subsection Using @code{set}
@findex set
the value that was returned. There are situations where this is the
right thing for the function to do; but such situations are rare.)
-@node Using setq, Counting, Using set, set & setq
-@comment node-name, next, previous, up
+@node Using setq
@subsection Using @code{setq}
@findex setq
specifically a list, attached to it; or, expressed another way,
the symbol is set to ``point'' to the list.
-@node Counting, , Using setq, set & setq
-@comment node-name, next, previous, up
+@node Counting
@subsection Counting
@cindex Counting
@code{setq} which sets the variable @code{counter} to this new value.
Thus, the value of the variable, @code{counter}, is changed.
-@node Summary, Error Message Exercises, set & setq, List Processing
-@comment node-name, next, previous, up
+@node Summary
@section Summary
Learning Lisp is like climbing a hill in which the first part is the
create a side effect.
@end itemize
-@node Error Message Exercises, , Summary, List Processing
-@comment node-name, next, previous, up
+@node Error Message Exercises
@section Exercises
A few simple exercises:
evaluated.
@end itemize
-@node Practicing Evaluation, Writing Defuns, List Processing, Top
-@comment node-name, next, previous, up
+@node Practicing Evaluation
@chapter Practicing Evaluation
@cindex Practicing evaluation
@cindex Evaluation practice
* Evaluation Exercise::
@end menu
-@node How to Evaluate, Buffer Names, Practicing Evaluation, Practicing Evaluation
@ifnottex
+@node How to Evaluate
@unnumberedsec How to Evaluate
@end ifnottex
functions makes clear the distinction between buffers and files, how to
switch to a buffer, and how to determine a location within it.
-@node Buffer Names, Getting Buffers, How to Evaluate, Practicing Evaluation
-@comment node-name, next, previous, up
+@node Buffer Names
@section Buffer Names
@findex buffer-name
@findex buffer-file-name
buffer you can edit; and when you write code or documentation (such as
this book), this feature is very useful.
-@node Getting Buffers, Switching Buffers, Buffer Names, Practicing Evaluation
-@comment node-name, next, previous, up
+@node Getting Buffers
@section Getting Buffers
@findex current-buffer
@findex other-buffer
will choose the most recent buffer that you cannot see; this is a
subtlety that I often forget.}.
-@node Switching Buffers, Buffer Size & Locations, Getting Buffers, Practicing Evaluation
-@comment node-name, next, previous, up
+@node Switching Buffers
@section Switching Buffers
@findex switch-to-buffer
@findex set-buffer
it---just as a plumber is an entity who can fix a leak if you call him
or her.
-@node Buffer Size & Locations, Evaluation Exercise, Switching Buffers, Practicing Evaluation
-@comment node-name, next, previous, up
+@node Buffer Size & Locations
@section Buffer Size and the Location of Point
@cindex Size of buffer
@cindex Buffer size
function @code{point-max} returns the value of the maximum permissible
value of point in the current buffer.
-@node Evaluation Exercise, , Buffer Size & Locations, Practicing Evaluation
+@node Evaluation Exercise
@section Exercise
Find a file with which you are working and move towards its middle.
Find its buffer name, file name, length, and your position in the file.
-@node Writing Defuns, Buffer Walk Through, Practicing Evaluation, Top
-@comment node-name, next, previous, up
+@node Writing Defuns
@chapter How To Write Function Definitions
@cindex Definition writing
@cindex Function definition writing
* defun Exercises::
@end menu
-@node Primitive Functions, defun, Writing Defuns, Writing Defuns
@ifnottex
+@node Primitive Functions
@unnumberedsec An Aside about Primitive Functions
@end ifnottex
@cindex Primitive functions
unless you investigate, you won't know whether an already-written
function is written in Emacs Lisp or C.
-@node defun, Install, Primitive Functions, Writing Defuns
-@comment node-name, next, previous, up
+@node defun
@section The @code{defun} Special Form
@findex defun
@cindex Special form of @code{defun}
definition of the function. Installation is described in the next
section.
-@node Install, Interactive, defun, Writing Defuns
-@comment node-name, next, previous, up
+@node Install
@section Install a Function Definition
@cindex Install a Function Definition
@cindex Definition installation
* Change a defun:: How to change a function definition.
@end menu
-@node Effect of installation, Change a defun, Install, Install
@ifnottex
+@node Effect of installation
@unnumberedsubsec The effect of installation
@end ifnottex
@noindent
(To return to a single window on your screen, type @kbd{C-x 1}.)
-@node Change a defun, , Effect of installation, Install
-@comment node-name, next, previous, up
+@node Change a defun
@subsection Change a Function Definition
@cindex Changing a function definition
@cindex Function definition, how to change
function; install it; test it; and then make fixes or enhancements and
install it again.
-@node Interactive, Interactive Options, Install, Writing Defuns
-@comment node-name, next, previous, up
+@node Interactive
@section Make a Function Interactive
@cindex Interactive functions
@findex interactive
* multiply-by-seven in detail:: The interactive version.
@end menu
-@node Interactive multiply-by-seven, multiply-by-seven in detail, Interactive, Interactive
@ifnottex
+@node Interactive multiply-by-seven
@unnumberedsubsec An Interactive @code{multiply-by-seven}, An Overview
@end ifnottex
typing @kbd{C-u} and then a number, for example, @kbd{C-u 3 M-e} (if you
type @kbd{C-u} without a number, it defaults to 4).
-@node multiply-by-seven in detail, , Interactive multiply-by-seven, Interactive
-@comment node-name, next, previous, up
+@node multiply-by-seven in detail
@subsection An Interactive @code{multiply-by-seven}
Let's look at the use of the special form @code{interactive} and then at
function, @code{message} prints the text as a side effect without
quotes.)
-@node Interactive Options, Permanent Installation, Interactive, Writing Defuns
-@comment node-name, next, previous, up
+@node Interactive Options
@section Different Options for @code{interactive}
@cindex Options for @code{interactive}
@cindex Interactive options
elisp, The GNU Emacs Lisp Reference Manual}, for a more complete
explanation about this technique.
-@node Permanent Installation, let, Interactive Options, Writing Defuns
-@comment node-name, next, previous, up
+@node Permanent Installation
@section Install Code Permanently
@cindex Install code permanently
@cindex Permanent code installation
others, it may be included in the next release of Emacs. In large
part, this is how Emacs has grown over the past years, by donations.
-@node let, if, Permanent Installation, Writing Defuns
-@comment node-name, next, previous, up
+@node let
@section @code{let}
@findex let
* Uninitialized let Variables::
@end menu
-@node Prevent confusion, Parts of let Expression, let, let
@ifnottex
+@node Prevent confusion
@unnumberedsubsec @code{let} Prevents Confusion
@end ifnottex
Dictionary}). Since you evaluate an expression to perform an action,
`execute' has evolved as a synonym to `evaluate'.)
-@node Parts of let Expression, Sample let Expression, Prevent confusion, let
-@comment node-name, next, previous, up
+@node Parts of let Expression
@subsection The Parts of a @code{let} Expression
@cindex @code{let} expression, parts of
@cindex Parts of @code{let} expression
@end group
@end smallexample
-@node Sample let Expression, Uninitialized let Variables, Parts of let Expression, let
-@comment node-name, next, previous, up
+@node Sample let Expression
@subsection Sample @code{let} Expression
@cindex Sample @code{let} expression
@cindex @code{let} expression sample
value of the variable @code{tiger} is printed at the location of the
second @samp{%s}.
-@node Uninitialized let Variables, , Sample let Expression, let
-@comment node-name, next, previous, up
+@node Uninitialized let Variables
@subsection Uninitialized Variables in a @code{let} Statement
@cindex Uninitialized @code{let} variables
@cindex @code{let} variables uninitialized
@samp{%s}.) The four variables as a group are put into a list to
delimit them from the body of the @code{let}.
-@node if, else, let, Writing Defuns
-@comment node-name, next, previous, up
+@node if
@section The @code{if} Special Form
@findex if
@cindex Conditional with @code{if}
* type-of-animal in detail:: An example of an @code{if} expression.
@end menu
-@node if in more detail, type-of-animal in detail, if, if
@ifnottex
+@node if in more detail
@unnumberedsubsec @code{if} in more detail
@end ifnottex
when you evaluate @code{(type-of-animal 'zebra)} you will see @code{nil}
printed in the echo area.
-@node type-of-animal in detail, , if in more detail, if
-@comment node-name, next, previous, up
+@node type-of-animal in detail
@subsection The @code{type-of-animal} Function in Detail
Let's look at the @code{type-of-animal} function in detail.
is not equal to @code{fierce}, so the then-part is not evaluated and
@code{nil} is returned by the @code{if} expression.
-@node else, Truth & Falsehood, if, Writing Defuns
-@comment node-name, next, previous, up
+@node else
@section If--then--else Expressions
@cindex Else
possibility that some such argument will be tested by the @code{if}
and write your program accordingly.)
-@node Truth & Falsehood, save-excursion, else, Writing Defuns
-@comment node-name, next, previous, up
+@node Truth & Falsehood
@section Truth and Falsehood in Emacs Lisp
@cindex Truth and falsehood in Emacs Lisp
@cindex Falsehood and truth in Emacs Lisp
* nil explained:: @code{nil} has two meanings.
@end menu
-@node nil explained, , Truth & Falsehood, Truth & Falsehood
@ifnottex
+@node nil explained
@unnumberedsubsec An explanation of @code{nil}
@end ifnottex
(> 4 5)
@end smallexample
-@node save-excursion, Review, Truth & Falsehood, Writing Defuns
-@comment node-name, next, previous, up
+@node save-excursion
@section @code{save-excursion}
@findex save-excursion
@cindex Region, what it is
* Template for save-excursion::
@end menu
-@node Point and mark, Template for save-excursion, save-excursion, save-excursion
@ifnottex
+@node Point and mark
@unnumberedsubsec Point and Mark
@end ifnottex
This is how @code{save-excursion} is used in @code{append-to-buffer}.
(@xref{append-to-buffer, , The Definition of @code{append-to-buffer}}.)
-@node Template for save-excursion, , Point and mark, save-excursion
-@comment node-name, next, previous, up
+@node Template for save-excursion
@subsection Template for a @code{save-excursion} Expression
@need 800
@end group
@end smallexample
-@node Review, defun Exercises, save-excursion, Writing Defuns
-@comment node-name, next, previous, up
+@node Review
@section Review
In the last few chapters we have introduced a fair number of functions
@end table
@need 1500
-@node defun Exercises, , Review, Writing Defuns
+@node defun Exercises
@section Exercises
@itemize @bullet
and if so, prints an appropriate message.
@end itemize
-@node Buffer Walk Through, More Complex, Writing Defuns, Top
-@comment node-name, next, previous, up
+@node Buffer Walk Through
@chapter A Few Buffer--Related Functions
In this chapter we study in detail several of the functions used in GNU
* Buffer Exercises::
@end menu
-@node Finding More, simplified-beginning-of-buffer, Buffer Walk Through, Buffer Walk Through
+@node Finding More
@section Finding More Information
@findex describe-function, @r{introduced}
@kbd{C-h p} command lets you search the standard Emacs Lisp libraries
by topic keywords.''
-@node simplified-beginning-of-buffer, mark-whole-buffer, Finding More, Buffer Walk Through
-@comment node-name, next, previous, up
+@node simplified-beginning-of-buffer
@section A Simplified @code{beginning-of-buffer} Definition
@findex simplified-beginning-of-buffer
function contains the expression @code{(goto-char (point-max))} in place
of @code{(goto-char (point-min))}.
-@node mark-whole-buffer, append-to-buffer, simplified-beginning-of-buffer, Buffer Walk Through
-@comment node-name, next, previous, up
+@node mark-whole-buffer
@section The Definition of @code{mark-whole-buffer}
@findex mark-whole-buffer
* Body of mark-whole-buffer:: Only three lines of code.
@end menu
-@node mark-whole-buffer overview, Body of mark-whole-buffer, mark-whole-buffer, mark-whole-buffer
@ifnottex
+@node mark-whole-buffer overview
@unnumberedsubsec An overview of @code{mark-whole-buffer}
@end ifnottex
previous section.
@need 1250
-@node Body of mark-whole-buffer, , mark-whole-buffer overview, mark-whole-buffer
-@comment node-name, next, previous, up
+@node Body of mark-whole-buffer
@subsection Body of @code{mark-whole-buffer}
The body of the @code{mark-whole-buffer} function consists of three
is set at the end of the buffer. The whole buffer is, therefore, the
region.
-@node append-to-buffer, Buffer Related Review, mark-whole-buffer, Buffer Walk Through
-@comment node-name, next, previous, up
+@node append-to-buffer
@section The Definition of @code{append-to-buffer}
@findex append-to-buffer
* append save-excursion:: How the @code{save-excursion} works.
@end menu
-@node append-to-buffer overview, append interactive, append-to-buffer, append-to-buffer
@ifnottex
+@node append-to-buffer overview
@unnumberedsubsec An Overview of @code{append-to-buffer}
@end ifnottex
Note that the documentation distinguishes between a buffer and its
name. (The function can handle either.)
-@node append interactive, append-to-buffer body, append-to-buffer overview, append-to-buffer
-@comment node-name, next, previous, up
+@node append interactive
@subsection The @code{append-to-buffer} Interactive Expression
Since the @code{append-to-buffer} function will be used interactively,
argument list (that is, @code{start} and @code{end}) to the values of
point and mark. That argument worked fine.)
-@node append-to-buffer body, append save-excursion, append interactive, append-to-buffer
-@comment node-name, next, previous, up
+@node append-to-buffer body
@subsection The Body of @code{append-to-buffer}
@ignore
boundary of the varlist and the second parenthesis marks the beginning
of the two-element list, @code{(oldbuf (current-buffer))}.
-@node append save-excursion, , append-to-buffer body, append-to-buffer
-@comment node-name, next, previous, up
+@node append save-excursion
@subsection @code{save-excursion} in @code{append-to-buffer}
The body of the @code{let} expression in @code{append-to-buffer}
buffer. Many function definitions use @code{let},
@code{save-excursion}, and @code{set-buffer} this way.
-@node Buffer Related Review, Buffer Exercises, append-to-buffer, Buffer Walk Through
-@comment node-name, next, previous, up
+@node Buffer Related Review
@section Review
Here is a brief summary of the various functions discussed in this chapter.
@end table
@need 1500
-@node Buffer Exercises, , Buffer Related Review, Buffer Walk Through
+@node Buffer Exercises
@section Exercises
@itemize @bullet
function.
@end itemize
-@node More Complex, Narrowing & Widening, Buffer Walk Through, Top
-@comment node-name, next, previous, up
+@node More Complex
@chapter A Few More Complex Functions
In this chapter, we build on what we have learned in previous chapters
* optional Exercise::
@end menu
-@node copy-to-buffer, insert-buffer, More Complex, More Complex
-@comment node-name, next, previous, up
+@node copy-to-buffer
@section The Definition of @code{copy-to-buffer}
@findex copy-to-buffer
@end group
@end smallexample
-@node insert-buffer, beginning-of-buffer, copy-to-buffer, More Complex
-@comment node-name, next, previous, up
+@node insert-buffer
@section The Definition of @code{insert-buffer}
@findex insert-buffer
* New insert-buffer::
@end menu
-@node insert-buffer code, insert-buffer interactive, insert-buffer, insert-buffer
@ifnottex
+@node insert-buffer code
@unnumberedsubsec The Code for @code{insert-buffer}
@end ifnottex
@end group
@end smallexample
-@node insert-buffer interactive, insert-buffer body, insert-buffer code, insert-buffer
-@comment node-name, next, previous, up
+@node insert-buffer interactive
@subsection The Interactive Expression in @code{insert-buffer}
@findex interactive, @r{example use of}
* b for interactive:: An existing buffer or else its name.
@end menu
-@node Read-only buffer, b for interactive, insert-buffer interactive, insert-buffer interactive
-@comment node-name, next, previous, up
+@node Read-only buffer
@unnumberedsubsubsec A Read-only Buffer
@cindex Read-only buffer
@cindex Asterisk for read-only buffer
into current buffer. The asterisk does not need to be followed by a
newline to separate it from the next argument.
-@node b for interactive, , Read-only buffer, insert-buffer interactive
-@comment node-name, next, previous, up
+@node b for interactive
@unnumberedsubsubsec @samp{b} in an Interactive Expression
The next argument in the interactive expression starts with a lower
functions with which we are already familiar and the @code{progn}
special form with which we are not. (It will be described later.)
-@node insert-buffer body, if & or, insert-buffer interactive, insert-buffer
-@comment node-name, next, previous, up
+@node insert-buffer body
@subsection The Body of the @code{insert-buffer} Function
The body of the @code{insert-buffer} function has two major parts: an
Before doing this, let me rewrite this part of the function using
@code{if} so that you can see what is done in a manner that will be familiar.
-@node if & or, Insert or, insert-buffer body, insert-buffer
-@comment node-name, next, previous, up
+@node if & or
@subsection @code{insert-buffer} With an @code{if} Instead of an @code{or}
The job to be done is to make sure the value of @code{buffer} is a
@code{buffer} to the value of the buffer itself, replacing its previous
value (which was the name of the buffer).
-@node Insert or, Insert let, if & or, insert-buffer
-@comment node-name, next, previous, up
+@node Insert or
@subsection The @code{or} in the Body
The purpose of the @code{or} expression in the @code{insert-buffer}
(or (holding-on-to-guest) (find-and-take-arm-of-guest))
@end smallexample
-@node Insert let, New insert-buffer, Insert or, insert-buffer
-@comment node-name, next, previous, up
+@node Insert let
@subsection The @code{let} Expression in @code{insert-buffer}
After ensuring that the variable @code{buffer} refers to a buffer itself
use @code{or}. All these functions are building blocks that we will
find and use again and again.
-@node New insert-buffer, , Insert let, insert-buffer
-@comment node-name, next, previous, up
+@node New insert-buffer
@subsection New Body for @code{insert-buffer}
@findex insert-buffer, new version body
@findex new version body for insert-buffer
exists only to produce a side effect, inserting another buffer, not to
return any value.
-@node beginning-of-buffer, Second Buffer Related Review, insert-buffer, More Complex
-@comment node-name, next, previous, up
+@node beginning-of-buffer
@section Complete Definition of @code{beginning-of-buffer}
@findex beginning-of-buffer
* beginning-of-buffer complete::
@end menu
-@node Optional Arguments, beginning-of-buffer opt arg, beginning-of-buffer, beginning-of-buffer
+@node Optional Arguments
@subsection Optional Arguments
Unless told otherwise, Lisp expects that a function with an argument in
is how we saw the @code{beginning-of-buffer} function in its
simplified form.
-@node beginning-of-buffer opt arg, beginning-of-buffer complete, Optional Arguments, beginning-of-buffer
+@node beginning-of-buffer opt arg
@subsection @code{beginning-of-buffer} with an Argument
When @code{beginning-of-buffer} is called with an argument, an
* Small buffer case::
@end menu
-@node Disentangle beginning-of-buffer, Large buffer case, beginning-of-buffer opt arg, beginning-of-buffer opt arg
@ifnottex
+@node Disentangle beginning-of-buffer
@unnumberedsubsubsec Disentangle @code{beginning-of-buffer}
@end ifnottex
There are two cases: if the buffer is large and if it is not.
-@node Large buffer case, Small buffer case, Disentangle beginning-of-buffer, beginning-of-buffer opt arg
-@comment node-name, next, previous, up
+@node Large buffer case
@unnumberedsubsubsec What happens in a large buffer
In @code{beginning-of-buffer}, the inner @code{if} expression tests
This puts the cursor where we want it.
-@node Small buffer case, , Large buffer case, beginning-of-buffer opt arg
-@comment node-name, next, previous, up
+@node Small buffer case
@unnumberedsubsubsec What happens in a small buffer
If the buffer contains fewer than 10,000 characters, a slightly
the cursor is moved to that point.
@need 1500
-@node beginning-of-buffer complete, , beginning-of-buffer opt arg, beginning-of-buffer
-@comment node-name, next, previous, up
+@node beginning-of-buffer complete
@subsection The Complete @code{beginning-of-buffer}
@need 1000
intended or whether no one has dealt with the code to avoid this
happening.
-@node Second Buffer Related Review, optional Exercise, beginning-of-buffer, More Complex
-@comment node-name, next, previous, up
+@node Second Buffer Related Review
@section Review
Here is a brief summary of some of the topics covered in this chapter.
Return @code{t} if its argument is a buffer; otherwise return @code{nil}.
@end table
-@node optional Exercise, , Second Buffer Related Review, More Complex
+@node optional Exercise
@section @code{optional} Argument Exercise
Write an interactive function with an optional argument that tests
message. However, if you do not pass an argument to the function, use
56 as a default value.
-@node Narrowing & Widening, car cdr & cons, More Complex, Top
-@comment node-name, next, previous, up
+@node Narrowing & Widening
@chapter Narrowing and Widening
@cindex Focusing attention (narrowing)
@cindex Narrowing
* narrow Exercise::
@end menu
-@node Narrowing advantages, save-restriction, Narrowing & Widening, Narrowing & Widening
@ifnottex
+@node Narrowing advantages
@unnumberedsec The Advantages of Narrowing
@end ifnottex
of the buffer in which it is interested and then restores the previous
situation.
-@node save-restriction, what-line, Narrowing advantages, Narrowing & Widening
-@comment node-name, next, previous, up
+@node save-restriction
@section The @code{save-restriction} Special Form
@findex save-restriction
(- (buffer-size) (forward-line (buffer-size)))))))
@end ignore
-@node what-line, narrow Exercise, save-restriction, Narrowing & Widening
-@comment node-name, next, previous, up
+@node what-line
@section @code{what-line}
@findex what-line
@cindex Widening, example of
mark to their original positions; and @code{save-restriction} restores
the original narrowing, if any.
-@node narrow Exercise, , what-line, Narrowing & Widening
+@node narrow Exercise
@section Exercise with Narrowing
Write a function that will display the first 60 characters of the
Additionally, do you really need @code{goto-char} or @code{point-min}?
Or can you write the function without them?
-@node car cdr & cons, Cutting & Storing Text, Narrowing & Widening, Top
-@comment node-name, next, previous, up
+@node car cdr & cons
@chapter @code{car}, @code{cdr}, @code{cons}: Fundamental Functions
@findex car, @r{introduced}
@findex cdr, @r{introduced}
* cons Exercise::
@end menu
-@node Strange Names, car & cdr, car cdr & cons, car cdr & cons
@ifnottex
+@node Strange Names
@unnumberedsec Strange Names
@end ifnottex
terms are used in the Emacs Lisp source code, we will use them in this
introduction.
-@node car & cdr, cons, Strange Names, car cdr & cons
-@comment node-name, next, previous, up
+@node car & cdr
@section @code{car} and @code{cdr}
The @sc{car} of a list is, quite simply, the first item in the list.
by array-specific functions. @xref{Arrays, , Arrays, elisp, The GNU
Emacs Lisp Reference Manual}.)
-@node cons, nthcdr, car & cdr, car cdr & cons
-@comment node-name, next, previous, up
+@node cons
@section @code{cons}
@findex cons, @r{introduced}
* length:: How to find the length of a list.
@end menu
-@node Build a list, length, cons, cons
@ifnottex
+@node Build a list
@unnumberedsubsec Build a list
@end ifnottex
and the third example constructs a three element list by putting
@code{violet} in front of @code{daisy} and @code{buttercup}.
-@node length, , Build a list, cons
-@comment node-name, next, previous, up
+@node length
@subsection Find the Length of a List: @code{length}
@findex length
about subroutines.
@end ignore
-@node nthcdr, nth, cons, car cdr & cons
-@comment node-name, next, previous, up
+@node nthcdr
@section @code{nthcdr}
@findex nthcdr
@end group
@end smallexample
-@node nth, setcar, nthcdr, car cdr & cons
-@comment node-name, next, previous, up
+@node nth
@section @code{nth}
@findex nth
non-destructive. This is in sharp contrast to the @code{setcar} and
@code{setcdr} functions.
-@node setcar, setcdr, nth, car cdr & cons
-@comment node-name, next, previous, up
+@node setcar
@section @code{setcar}
@findex setcar
as @code{cons} would have; it replaced @code{antelope} with
@code{hippopotamus}; it @emph{changed} the list.
-@node setcdr, cons Exercise, setcar, car cdr & cons
-@comment node-name, next, previous, up
+@node setcdr
@section @code{setcdr}
@findex setcdr
@code{(horse cat dog)}. The @sc{cdr} of the list is changed from
@code{(cow sheep goat)} to @code{(cat dog)}.
-@node cons Exercise, , setcdr, car cdr & cons
+@node cons Exercise
@section Exercise
Construct a list of four birds by evaluating several expressions with
itself. Replace the first element of the list of four birds with a
fish. Replace the rest of that list with a list of other fish.
-@node Cutting & Storing Text, List Implementation, car cdr & cons, Top
-@comment node-name, next, previous, up
+@node Cutting & Storing Text
@chapter Cutting and Storing Text
@cindex Cutting and storing text
@cindex Storing and cutting text
* search Exercises::
@end menu
-@node Storing Text, zap-to-char, Cutting & Storing Text, Cutting & Storing Text
@ifnottex
+@node Storing Text
@unnumberedsec Storing Text in a List
@end ifnottex
A subsequent chapter describes how text that is cut from the buffer is
retrieved. @xref{Yanking, , Yanking Text Back}.
-@node zap-to-char, kill-region, Storing Text, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node zap-to-char
@section @code{zap-to-char}
@findex zap-to-char
* Summing up zap-to-char:: Using @code{point} and @code{search-forward}.
@end menu
-@node Complete zap-to-char, zap-to-char interactive, zap-to-char, zap-to-char
@ifnottex
+@node Complete zap-to-char
@unnumberedsubsec The Complete @code{zap-to-char} Implementation
@end ifnottex
The documentation is thorough. You do need to know the jargon meaning
of the word `kill'.
-@node zap-to-char interactive, zap-to-char body, Complete zap-to-char, zap-to-char
-@comment node-name, next, previous, up
+@node zap-to-char interactive
@subsection The @code{interactive} Expression
@need 800
message saying that the buffer is read-only. Also, the terminal may
beep or blink at you.
-@node zap-to-char body, search-forward, zap-to-char interactive, zap-to-char
-@comment node-name, next, previous, up
+@node zap-to-char body
@subsection The Body of @code{zap-to-char}
The body of the @code{zap-to-char} function contains the code that
@code{search-forward}, so we will look at @code{search-forward} and
then at @code{progn}.
-@node search-forward, progn, zap-to-char body, zap-to-char
-@comment node-name, next, previous, up
+@node search-forward
@subsection The @code{search-forward} Function
@findex search-forward
We will look at @code{progn} next.
-@node progn, Summing up zap-to-char, search-forward, zap-to-char
-@comment node-name, next, previous, up
+@node progn
@subsection The @code{progn} Special Form
@findex progn
returned by the @code{progn} expression and is passed to
@code{kill-region} as @code{kill-region}'s second argument.
-@node Summing up zap-to-char, , progn, zap-to-char
-@comment node-name, next, previous, up
+@node Summing up zap-to-char
@subsection Summing up @code{zap-to-char}
Now that we have seen how @code{search-forward} and @code{progn} work,
a single argument to @code{kill-region} and returns the one value that
@code{kill-region} needs for its second argument.
-@node kill-region, copy-region-as-kill, zap-to-char, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node kill-region
@section @code{kill-region}
@findex kill-region
* Lisp macro::
@end menu
-@node Complete kill-region, condition-case, kill-region, kill-region
@ifnottex
+@node Complete kill-region
@unnumberedsubsec The Complete @code{kill-region} Definition
@end ifnottex
@end smallexample
@end ignore
-@node condition-case, Lisp macro, Complete kill-region, kill-region
-@comment node-name, next, previous, up
+@node condition-case
@subsection @code{condition-case}
@findex condition-case
Initializing a Variable with @code{defvar} includes line 8350
@end ignore
-@node Lisp macro, , condition-case, kill-region
-@comment node-name, next, previous, up
+@node Lisp macro
@subsection Lisp macro
@cindex Macro, lisp
@cindex Lisp macro
concatenates a copy of the newly clipped text to the just previously
clipped text in the kill ring.
-@node copy-region-as-kill, Digression into C, kill-region, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node copy-region-as-kill
@section @code{copy-region-as-kill}
@findex copy-region-as-kill
@findex nthcdr
* copy-region-as-kill body:: The body of @code{copy-region-as-kill}.
@end menu
-@node Complete copy-region-as-kill, copy-region-as-kill body, copy-region-as-kill, copy-region-as-kill
@ifnottex
+@node Complete copy-region-as-kill
@unnumberedsubsec The complete @code{copy-region-as-kill} function definition
@end ifnottex
The body of @code{copy-region-as-kill} merits discussion in detail.
-@node copy-region-as-kill body, , Complete copy-region-as-kill, copy-region-as-kill
-@comment node-name, next, previous, up
+@node copy-region-as-kill body
@subsection The Body of @code{copy-region-as-kill}
The @code{copy-region-as-kill} function works in much the same way as
* kill-new function::
@end menu
-@node last-command & this-command, kill-append function, copy-region-as-kill body, copy-region-as-kill body
@ifnottex
+@node last-command & this-command
@unnumberedsubsubsec @code{last-command} and @code{this-command}
@end ifnottex
If the previous command was @code{kill-region}, then the Emacs Lisp
interpreter calls the @code{kill-append} function
-@node kill-append function, kill-new function, last-command & this-command, copy-region-as-kill body
+@node kill-append function
@unnumberedsubsubsec The @code{kill-append} function
@findex kill-append
saved text. The @code{kill-append} function uses the @code{kill-new}
function which in turn uses the @code{setcar} function.
-@node kill-new function, , kill-append function, copy-region-as-kill body
+@node kill-new function
@unnumberedsubsubsec The @code{kill-new} function
@findex kill-new
see Initializing a Variable with @code{defvar}
@end ignore
-@node Digression into C, defvar, copy-region-as-kill, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node Digression into C
@section Digression into C
@findex delete-and-extract-region
@cindex C, a digression into
simple; but hidden underneath is a great deal of complexity to make it
all work.
-@node defvar, cons & search-fwd Review, Digression into C, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node defvar
@section Initializing a Variable with @code{defvar}
@findex defvar
@cindex Initializing a variable
* defvar and asterisk::
@end menu
-@node See variable current value, defvar and asterisk, defvar, defvar
@ifnottex
+@node See variable current value
@unnumberedsubsec Seeing the Current Value of a Variable
@end ifnottex
Succeeding lines should not be indented; otherwise they look odd when
you use @kbd{C-h v} (@code{describe-variable}).
-@node defvar and asterisk, , See variable current value, defvar
+@node defvar and asterisk
@subsection @code{defvar} and an asterisk
@findex defvar @r{for a user customizable variable}
@findex defvar @r{with an asterisk}
The GNU Emacs Manual}.)
@need 1250
-@node cons & search-fwd Review, search Exercises, defvar, Cutting & Storing Text
-@comment node-name, next, previous, up
+@node cons & search-fwd Review
@section Review
Here is a brief summary of some recently introduced functions.
(This is not an interactive command.)
@need 1500
-@node search Exercises, , cons & search-fwd Review, Cutting & Storing Text
+@node search Exercises
@section Searching Exercises
@itemize @bullet
print an appropriate message.
@end itemize
-@node List Implementation, Yanking, Cutting & Storing Text, Top
-@comment node-name, next, previous, up
+@node List Implementation
@chapter How Lists are Implemented
@cindex Lists in a computer
* List Exercise::
@end menu
-@node Lists diagrammed, Symbols as Chest, List Implementation, List Implementation
@ifnottex
+@node Lists diagrammed
@unnumberedsec Lists diagrammed
@end ifnottex
In summary, when a Lisp variable is set to a value, it is provided with
the address of the list to which the variable refers.
-@node Symbols as Chest, List Exercise, Lists diagrammed, List Implementation
+@node Symbols as Chest
@section Symbols as a Chest of Drawers
@cindex Symbols as a Chest of Drawers
@cindex Chest of Drawers, metaphor for a symbol
@end iftex
@end ifclear
-@node List Exercise, , Symbols as Chest, List Implementation
+@node List Exercise
@section Exercise
Set @code{flowers} to @code{violet} and @code{buttercup}. Cons two
@code{more-flowers}. Set the @sc{car} of @code{flowers} to a fish.
What does the @code{more-flowers} list now contain?
-@node Yanking, Loops & Recursion, List Implementation, Top
-@comment node-name, next, previous, up
+@node Yanking
@chapter Yanking Text Back
@findex yank
@cindex Text retrieval
* yank nthcdr Exercises:: The @code{kill-ring-yank-pointer} variable.
@end menu
-@node Kill Ring Overview, kill-ring-yank-pointer, Yanking, Yanking
-@comment node-name, next, previous, up
+@node Kill Ring Overview
@section Kill Ring Overview
@cindex Kill ring overview
To begin to understand how @code{yank} and @code{yank-pop} work, it is
first necessary to look at the @code{kill-ring-yank-pointer} variable.
-@node kill-ring-yank-pointer, yank nthcdr Exercises, Kill Ring Overview, Yanking
-@comment node-name, next, previous, up
+@node kill-ring-yank-pointer
@section The @code{kill-ring-yank-pointer} Variable
@code{kill-ring-yank-pointer} is a variable, just as @code{kill-ring} is
@end ignore
@need 1500
-@node yank nthcdr Exercises, , kill-ring-yank-pointer, Yanking
+@node yank nthcdr Exercises
@section Exercises with @code{yank} and @code{nthcdr}
@itemize @bullet
to return the first, second, third, and fourth elements of a list.
@end itemize
-@node Loops & Recursion, Regexp Search, Yanking, Top
-@comment node-name, next, previous, up
+@node Loops & Recursion
@chapter Loops and Recursion
@cindex Loops and recursion
@cindex Recursion and loops
* Looping exercise::
@end menu
-@node while, dolist dotimes, Loops & Recursion, Loops & Recursion
-@comment node-name, next, previous, up
+@node while
@section @code{while}
@cindex Loops
@findex while
* Decrementing Loop:: A loop with a decrementing counter.
@end menu
-@node Looping with while, Loop Example, while, while
@ifnottex
+@node Looping with while
@unnumberedsubsec Looping with @code{while}
@end ifnottex
but the consequences of what happens when the expressions in the loop
are repeatedly evaluated.
-@node Loop Example, print-elements-of-list, Looping with while, while
-@comment node-name, next, previous, up
+@node Loop Example
@subsection A @code{while} Loop and a List
A common way to control a @code{while} loop is to test whether a list
goes through a list and prints each element of the list on a line of its
own.
-@node print-elements-of-list, Incrementing Loop, Loop Example, while
+@node print-elements-of-list
@subsection An Example: @code{print-elements-of-list}
@findex print-elements-of-list
@code{while} loop, and since @code{while} loops always return
@code{nil}, a @code{nil} is printed after the last element of the list.
-@node Incrementing Loop, Incrementing Loop Details, print-elements-of-list, while
-@comment node-name, next, previous, up
+@node Incrementing Loop
@subsection A Loop with an Incrementing Counter
A loop is not useful unless it stops when it ought. Besides
have a counter---an expression that counts how many times the loop
repeats itself.
-@node Incrementing Loop Details, Decrementing Loop, Incrementing Loop, while
@ifnottex
+@node Incrementing Loop Details
@unnumberedsubsec Details of an Incrementing Loop
@end ifnottex
* Inc Example altogether:: Putting the function definition together.
@end menu
-@node Incrementing Example, Inc Example parts, Incrementing Loop Details, Incrementing Loop Details
+@node Incrementing Example
@unnumberedsubsubsec Example with incrementing counter
Suppose you are playing on the beach and decide to make a triangle of
complex loop the repetitive action might not be so simple, but it will
be simpler than doing everything all at once.
-@node Inc Example parts, Inc Example altogether, Incrementing Example, Incrementing Loop Details
+@node Inc Example parts
@unnumberedsubsubsec The parts of the function definition
The preceding analysis gives us the bones of our function definition:
(setq row-number (1+ row-number))
@end smallexample
-@node Inc Example altogether, , Inc Example parts, Incrementing Loop Details
+@node Inc Example altogether
@unnumberedsubsubsec Putting the function definition together
We have created the parts for the function definition; now we need to
The sum of the first four numbers is 10 and the sum of the first seven
numbers is 28.
-@node Decrementing Loop, , Incrementing Loop Details, while
-@comment node-name, next, previous, up
+@node Decrementing Loop
@subsection Loop with a Decrementing Counter
Another common way to write a @code{while} loop is to write the test
* Dec Example altogether:: Putting the function definition together.
@end menu
-@node Decrementing Example, Dec Example parts, Decrementing Loop, Decrementing Loop
+@node Decrementing Example
@unnumberedsubsubsec Example with decrementing counter
To illustrate a loop with a decrementing counter, we will rewrite the
many pebbles are in the preceding row: it is one less than the number in
the row.
-@node Dec Example parts, Dec Example altogether, Decrementing Example, Decrementing Loop
+@node Dec Example parts
@unnumberedsubsubsec The parts of the function definition
We start with three variables: the total number of rows in the
(while (> number-of-pebbles-in-row 0)
@end smallexample
-@node Dec Example altogether, , Dec Example parts, Decrementing Loop
+@node Dec Example altogether
@unnumberedsubsubsec Putting the function definition together
We can put these expressions together to create a function definition
number of times.
@end enumerate
-@node dolist dotimes, Recursion, while, Loops & Recursion
-@comment node-name, next, previous, up
+@node dolist dotimes
@section Save your time: @code{dolist} and @code{dotimes}
In addition to @code{while}, both @code{dolist} and @code{dotimes}
* dotimes::
@end menu
-@node dolist, dotimes, dolist dotimes, dolist dotimes
-@unnumberedsubsubsec The @code{dolist} Macro
+@node dolist
+@unnumberedsubsec The @code{dolist} Macro
@findex dolist
Suppose, for example, you want to reverse a list, so that
the expression; and repeats the loop. The result is returned in
@code{value}.
-@node dotimes, , dolist, dolist dotimes
-@unnumberedsubsubsec The @code{dotimes} Macro
+@node dotimes
+@unnumberedsubsec The @code{dotimes} Macro
@findex dotimes
The @code{dotimes} macro is similar to @code{dolist}, except that it
@end group
@end smallexample
-@node Recursion, Looping exercise, dolist dotimes, Loops & Recursion
-@comment node-name, next, previous, up
+@node Recursion
@section Recursion
@cindex Recursion
* No deferment solution::
@end menu
-@node Building Robots, Recursive Definition Parts, Recursion, Recursion
-@comment node-name, next, previous, up
+@node Building Robots
@subsection Building Robots: Extending the Metaphor
@cindex Building robots
@cindex Robots, building
It is important that the arguments differ from one instance to the
next; otherwise, the process will never stop.
-@node Recursive Definition Parts, Recursion with list, Building Robots, Recursion
-@comment node-name, next, previous, up
+@node Recursive Definition Parts
@subsection The Parts of a Recursive Definition
@cindex Parts of a Recursive Definition
@cindex Recursive Definition Parts
The do-again-test is sometimes called the @dfn{stop condition},
since it stops the repetitions when it tests false.
-@node Recursion with list, Recursive triangle function, Recursive Definition Parts, Recursion
-@comment node-name, next, previous, up
+@node Recursion with list
@subsection Recursion with a List
The example of a @code{while} loop that printed the elements of a list
@end smallexample
@need 2000
-@node Recursive triangle function, Recursion with cond, Recursion with list, Recursion
-@comment node-name, next, previous, up
+@node Recursive triangle function
@subsection Recursion in Place of a Counter
@findex triangle-recursively
* Recursive Example arg of 3 or 4::
@end menu
-@node Recursive Example arg of 1 or 2, Recursive Example arg of 3 or 4, Recursive triangle function, Recursive triangle function
@ifnottex
+@node Recursive Example arg of 1 or 2
@unnumberedsubsubsec An argument of 1 or 2
@end ifnottex
pebbles in it.
@end table
-@node Recursive Example arg of 3 or 4, , Recursive Example arg of 1 or 2, Recursive triangle function
+@node Recursive Example arg of 3 or 4
@unnumberedsubsubsec An argument of 3 or 4
Suppose that @code{triangle-recursively} is called with an argument of
There is a way around this kind of waiting, which we will discuss in
@ref{No Deferment, , Recursion without Deferments}.
-@node Recursion with cond, Recursive Patterns, Recursive triangle function, Recursion
-@comment node-name, next, previous, up
+@node Recursion with cond
@subsection Recursion Example Using @code{cond}
@findex cond
number (triangle-using-cond (1- number)))} if the number is greater than
1.
-@node Recursive Patterns, No Deferment, Recursion with cond, Recursion
-@comment node-name, next, previous, up
+@node Recursive Patterns
@subsection Recursive Patterns
@cindex Recursive Patterns
* Keep::
@end menu
-@node Every, Accumulate, Recursive Patterns, Recursive Patterns
-@comment node-name, next, previous, up
+@node Every
@unnumberedsubsubsec Recursive Pattern: @emph{every}
@cindex Every, type of recursive pattern
@cindex Recursive pattern: every
@end itemize
@end itemize
-@node Accumulate, Keep, Every, Recursive Patterns
-@comment node-name, next, previous, up
+@node Accumulate
@unnumberedsubsubsec Recursive Pattern: @emph{accumulate}
@cindex Accumulate, type of recursive pattern
@cindex Recursive pattern: accumulate
@xref{Files List, , Making a List of Files}, for an example of the
accumulate pattern.
-@node Keep, , Accumulate, Recursive Patterns
-@comment node-name, next, previous, up
+@node Keep
@unnumberedsubsubsec Recursive Pattern: @emph{keep}
@cindex Keep, type of recursive pattern
@cindex Recursive pattern: keep
It goes without saying that you need not use @code{nil} as the test for
when to stop; and you can, of course, combine these patterns.
-@node No Deferment, No deferment solution, Recursive Patterns, Recursion
+@node No Deferment
@subsection Recursion without Deferments
@cindex Deferment in recursion
@cindex Recursion without Deferments
steps, as in this example. But it can be a problem when there are
more steps.
-@node No deferment solution, , No Deferment, Recursion
+@node No deferment solution
@subsection No Deferment Solution
@cindex No deferment solution
@cindex Defermentless solution
many resources in a computer.
@need 1500
-@node Looping exercise, , Recursion, Loops & Recursion
+@node Looping exercise
@section Looping Exercise
@itemize @bullet
@end iftex
@end itemize
-@node Regexp Search, Counting Words, Loops & Recursion, Top
-@comment node-name, next, previous, up
+@node Regexp Search
@chapter Regular Expression Searches
@cindex Searches, illustrating
@cindex Regular expression searches
* re-search Exercises::
@end menu
-@node sentence-end, re-search-forward, Regexp Search, Regexp Search
-@comment node-name, next, previous, up
+@node sentence-end
@section The Regular Expression for @code{sentence-end}
@findex sentence-end
@end table
@end ignore
-@node re-search-forward, forward-sentence, sentence-end, Regexp Search
-@comment node-name, next, previous, up
+@node re-search-forward
@section The @code{re-search-forward} Function
@findex re-search-forward
function will return @code{nil}; and the repeat count will be provided
by the argument to the @code{forward-sentence} function.
-@node forward-sentence, forward-paragraph, re-search-forward, Regexp Search
-@comment node-name, next, previous, up
+@node forward-sentence
@section @code{forward-sentence}
@findex forward-sentence
* fwd-sentence re-search:: A regular expression search.
@end menu
-@node Complete forward-sentence, fwd-sentence while loops, forward-sentence, forward-sentence
@ifnottex
+@node Complete forward-sentence
@unnumberedsubsec Complete @code{forward-sentence} function definition
@end ifnottex
equivalents. The @code{sentence-end} variable is set by the
@code{sentence-end} function.
-@node fwd-sentence while loops, fwd-sentence re-search, Complete forward-sentence, forward-sentence
+@node fwd-sentence while loops
@unnumberedsubsec The @code{while} loops
Two @code{while} loops follow. The first @code{while} has a
the @code{forward-sentence} function buried here, but this is a common
way this kind of operation is carried out in Lisp.
-@node fwd-sentence re-search, , fwd-sentence while loops, forward-sentence
+@node fwd-sentence re-search
@unnumberedsubsec The regular expression search
The @code{re-search-forward} function searches for the end of the
test of an @code{if} expression, is handy. You will see or write code
incorporating this pattern often.
-@node forward-paragraph, etags, forward-sentence, Regexp Search
-@comment node-name, next, previous, up
+@node forward-paragraph
@section @code{forward-paragraph}: a Goldmine of Functions
@findex forward-paragraph
* fwd-para while:: The forward motion @code{while} loop.
@end menu
-@node forward-paragraph in brief, fwd-para let, forward-paragraph, forward-paragraph
@ifnottex
+@node forward-paragraph in brief
@unnumberedsubsec Shortened @code{forward-paragraph} function definition
@end ifnottex
@code{forward-sentence} function}.) Now we reach the end of the
familiar part of this function.
-@node fwd-para let, fwd-para while, forward-paragraph in brief, forward-paragraph
+@node fwd-para let
@unnumberedsubsec The @code{let*} expression
The next line of the @code{forward-paragraph} function begins a
negative argument and is therefore moving backwards. We will skip this
section.
-@node fwd-para while, , fwd-para let, forward-paragraph
+@node fwd-para while
@unnumberedsubsec The forward motion @code{while} loop
The second part of the body of the @code{let*} deals with forward
your sources! Without them, you are like a person who tries to drive
a car with his eyes shut!)
-@node etags, Regexp Review, forward-paragraph, Regexp Search
+@node etags
@section Create Your Own @file{TAGS} File
@findex etags
@cindex @file{TAGS} file, create own
For more information, see @ref{Tags, , Tag Tables, emacs, The GNU Emacs
Manual}.
-@node Regexp Review, re-search Exercises, etags, Regexp Search
-@comment node-name, next, previous, up
+@node Regexp Review
@section Review
Here is a brief summary of some recently introduced functions.
@end table
@need 1500
-@node re-search Exercises, , Regexp Review, Regexp Search
+@node re-search Exercises
@section Exercises with @code{re-search-forward}
@itemize @bullet
regexps. @xref{the-the, , @code{the-the} Duplicated Words Function}.
@end itemize
-@node Counting Words, Words in a defun, Regexp Search, Top
+@node Counting Words
@chapter Counting: Repetition and Regexps
@cindex Repetition for word counting
@cindex Regular expressions for word counting
* Counting Exercise::
@end menu
-@node Why Count Words, @value{COUNT-WORDS}, Counting Words, Counting Words
@ifnottex
+@node Why Count Words
@unnumberedsec Counting words
@end ifnottex
some examples, which you may wish to compare with the standard Emacs
command, @code{count-words-region}.
-@node @value{COUNT-WORDS}, recursive-count-words, Why Count Words, Counting Words
-@comment node-name, next, previous, up
+@node @value{COUNT-WORDS}
@section The @code{@value{COUNT-WORDS}} Function
@findex @value{COUNT-WORDS}
* Whitespace Bug:: The Whitespace Bug in @code{@value{COUNT-WORDS}}.
@end menu
-@node Design @value{COUNT-WORDS}, Whitespace Bug, @value{COUNT-WORDS}, @value{COUNT-WORDS}
@ifnottex
+@node Design @value{COUNT-WORDS}
@unnumberedsubsec Designing @code{@value{COUNT-WORDS}}
@end ifnottex
@noindent
As written, the function works, but not in all circumstances.
-@node Whitespace Bug, , Design @value{COUNT-WORDS}, @value{COUNT-WORDS}
-@comment node-name, next, previous, up
+@node Whitespace Bug
@subsection The Whitespace Bug in @code{@value{COUNT-WORDS}}
The @code{@value{COUNT-WORDS}} command described in the preceding
@end group
@end smallexample
-@node recursive-count-words, Counting Exercise, @value{COUNT-WORDS}, Counting Words
-@comment node-name, next, previous, up
+@node recursive-count-words
@section Count Words Recursively
@cindex Count words recursively
@cindex Recursively counting words
@end group
@end smallexample
-@node Counting Exercise, , recursive-count-words, Counting Words
+@node Counting Exercise
@section Exercise: Counting Punctuation
Using a @code{while} loop, write a function to count the number of
punctuation marks in a region---period, comma, semicolon, colon,
exclamation mark, and question mark. Do the same using recursion.
-@node Words in a defun, Readying a Graph, Counting Words, Top
+@node Words in a defun
@chapter Counting Words in a @code{defun}
@cindex Counting words in a @code{defun}
@cindex Word counting in a @code{defun}
* Prepare the data:: Prepare the data for display in a graph.
@end menu
-@node Divide and Conquer, Words and Symbols, Words in a defun, Words in a defun
@ifnottex
+@node Divide and Conquer
@unnumberedsec Divide and Conquer
@end ifnottex
This is quite a project! But if we take each step slowly, it will not
be difficult.
-@node Words and Symbols, Syntax, Divide and Conquer, Words in a defun
+@node Words and Symbols
@section What to Count?
@cindex Words and symbols in defun
characters' brings us to the issue of syntax, which is worth a section
of its own.
-@node Syntax, count-words-in-defun, Words and Symbols, Words in a defun
+@node Syntax
@section What Constitutes a Word or Symbol?
@cindex Syntax categories and tables
"\\(\\w\\|\\s_\\)+[^ \t\n]*[ \t\n]*"
@end smallexample
-@node count-words-in-defun, Several defuns, Syntax, Words in a defun
+@node count-words-in-defun
@section The @code{count-words-in-defun} Function
@cindex Counting words in a @code{defun}
The next problem is to count the numbers of words and symbols in
several definitions within a single file.
-@node Several defuns, Find a File, count-words-in-defun, Words in a defun
+@node Several defuns
@section Count Several @code{defuns} Within a File
A file such as @file{simple.el} may have a hundred or more function
Finding a file is a new process that we have not yet discussed.
-@node Find a File, lengths-list-file, Several defuns, Words in a defun
-@comment node-name, next, previous, up
+@node Find a File
@section Find a File
@cindex Find a File
The task is easy: use @code{find-file-noselect} and @code{set-buffer}.
-@node lengths-list-file, Several files, Find a File, Words in a defun
+@node lengths-list-file
@section @code{lengths-list-file} in Detail
The core of the @code{lengths-list-file} function is a @code{while}
Note that the length of the last definition in the file is first in
the list.
-@node Several files, Several files recursively, lengths-list-file, Words in a defun
+@node Several files
@section Count Words in @code{defuns} in Different Files
In the previous section, we created a function that returns a list of
* append:: Attach one list to another.
@end menu
-@node lengths-list-many-files, append, Several files, Several files
@ifnottex
+@node lengths-list-many-files
@unnumberedsubsec Determine the lengths of @code{defuns}
@end ifnottex
unstudied function @code{append}, which merits a short section for
itself.
-@node append, , lengths-list-many-files, Several files
+@node append
@subsection The @code{append} Function
@need 800
((1 2 3 4) 5 6 7 8)
@end smallexample
-@node Several files recursively, Prepare the data, Several files, Words in a defun
+@node Several files recursively
@section Recursively Count Words in Different Files
Besides a @code{while} loop, you can work on each of a list of files
The next step is to prepare the data in the list for display in a graph.
-@node Prepare the data, , Several files recursively, Words in a defun
+@node Prepare the data
@section Prepare the Data for Display in a Graph
The @code{recursive-lengths-list-many-files} function returns a list
* Counting function definitions::
@end menu
-@node Data for Display in Detail, Sorting, Prepare the data, Prepare the data
@ifnottex
+@node Data for Display in Detail
@unnumberedsubsec The Data for Display in Detail
@end ifnottex
number, and thereby determine the largest and smallest length range
that we will need.
-@node Sorting, Files List, Data for Display in Detail, Prepare the data
+@node Sorting
@subsection Sorting Lists
@findex sort
quoted, since the expression must be evaluated so as to produce the
list that is passed to @code{sort}.)
-@node Files List, Counting function definitions, Sorting, Prepare the data
+@node Files List
@subsection Making a List of Files
The @code{recursive-lengths-list-many-files} function requires a list
(insert (format "%s" (current-time-string))))
@end ignore
-@node Counting function definitions, , Files List, Prepare the data
+@node Counting function definitions
@subsection Counting function definitions
Our immediate goal is to generate a list that tells us how many
of 200 or larger.
@c The next step is to turn this numbers' list into a graph.
-@node Readying a Graph, Emacs Initialization, Words in a defun, Top
+@node Readying a Graph
@chapter Readying a Graph
@cindex Readying a graph
@cindex Graph prototype
* Line Graph Exercise::
@end menu
-@node Columns of a graph, graph-body-print, Readying a Graph, Readying a Graph
@ifnottex
+@node Columns of a graph
@unnumberedsec Printing the Columns of a Graph
@end ifnottex
This prints the body of a graph, not the labels for the vertical and
horizontal axes, so we can call this @code{graph-body-print}.
-@node graph-body-print, recursive-graph-body-print, Columns of a graph, Readying a Graph
+@node graph-body-print
@section The @code{graph-body-print} Function
@findex graph-body-print
@end group
@end smallexample
-@node recursive-graph-body-print, Printed Axes, graph-body-print, Readying a Graph
+@node recursive-graph-body-print
@section The @code{recursive-graph-body-print} Function
@findex recursive-graph-body-print
Either of these two functions, @code{graph-body-print} or
@code{recursive-graph-body-print}, create the body of a graph.
-@node Printed Axes, Line Graph Exercise, recursive-graph-body-print, Readying a Graph
+@node Printed Axes
@section Need for Printed Axes
A graph needs printed axes, so you can orient yourself. For a do-once
do not contain much new material, I have placed their description in
an appendix. @xref{Full Graph, , A Graph with Labeled Axes}.
-@node Line Graph Exercise, , Printed Axes, Readying a Graph
+@node Line Graph Exercise
@section Exercise
Write a line graph version of the graph printing functions.
-@node Emacs Initialization, Debugging, Readying a Graph, Top
+@node Emacs Initialization
@chapter Your @file{.emacs} File
@cindex @file{.emacs} file
@cindex Customizing your @file{.emacs} file
* Mode Line:: How to customize your mode line.
@end menu
-@node Default Configuration, Site-wide Init, Emacs Initialization, Emacs Initialization
@ifnottex
+@node Default Configuration
@unnumberedsec Emacs's Default Configuration
@end ifnottex
@ref{Init File, , The Init File, elisp, The GNU Emacs Lisp Reference
Manual}.
-@node Site-wide Init, defcustom, Default Configuration, Emacs Initialization
+@node Site-wide Init
@section Site-wide Initialization Files
@cindex @file{default.el} init file
what to put into your own @file{.emacs} file, or into a site-wide
initialization file.
-@node defcustom, Beginning a .emacs File, Site-wide Init, Emacs Initialization
+@node defcustom
@section Specifying Variables using @code{defcustom}
@findex defcustom
set by @code{defconst}. (You can change it; the value set is a
variable; but please do not.)
-@node Beginning a .emacs File, Text and Auto-fill, defcustom, Emacs Initialization
+@node Beginning a .emacs File
@section Beginning a @file{.emacs} File
@cindex @file{.emacs} file, beginning of
about Mode help or the conventions for comments---but I was able to
remember to look here to remind myself.
-@node Text and Auto-fill, Mail Aliases, Beginning a .emacs File, Emacs Initialization
+@node Text and Auto-fill
@section Text and Auto Fill Mode
Now we come to the part that `turns on' Text mode and
(setq colon-double-space t)
@end smallexample
-@node Mail Aliases, Indent Tabs Mode, Text and Auto-fill, Emacs Initialization
+@node Mail Aliases
@section Mail Aliases
Here is a @code{setq} that `turns on' mail aliases, along with more
When you write a message to George, address it to @samp{geo}; the
mailer will automatically expand @samp{geo} to the full address.
-@node Indent Tabs Mode, Keybindings, Mail Aliases, Emacs Initialization
+@node Indent Tabs Mode
@section Indent Tabs Mode
@cindex Tabs, preventing
@findex indent-tabs-mode
@end iftex
@need 1700
-@node Keybindings, Keymaps, Indent Tabs Mode, Emacs Initialization
+@node Keybindings
@section Some Keybindings
Now for some personal keybindings:
command, which not only lists the buffers,
but moves point into that window.
-@node Keymaps, Loading Files, Keybindings, Emacs Initialization
+@node Keymaps
@section Keymaps
@cindex Keymaps
@cindex Rebinding keys
Manual}, and @ref{Keymaps, , Keymaps, elisp, The GNU Emacs Lisp
Reference Manual}, for more information about keymaps.
-@node Loading Files, Autoload, Keymaps, Emacs Initialization
+@node Loading Files
@section Loading Files
@cindex Loading files
@c findex load
Emacs, emacs, The GNU Emacs Manual}, for information on the
distinction between @code{load-library} and this command.
-@node Autoload, Simple Extension, Loading Files, Emacs Initialization
+@node Autoload
@section Autoloading
@findex autoload
@xref{Autoload, , Autoload, elisp, The GNU Emacs Lisp Reference
Manual}, for more information.
-@node Simple Extension, X11 Colors, Autoload, Emacs Initialization
+@node Simple Extension
@section A Simple Extension: @code{line-to-top-of-window}
@findex line-to-top-of-window
@cindex Simple extension in @file{.emacs} file
@end group
@end smallexample
-@node X11 Colors, Miscellaneous, Simple Extension, Emacs Initialization
+@node X11 Colors
@section X11 Colors
You can specify colors when you use Emacs with the MIT X Windowing
@end smallexample
@need 1700
-@node Miscellaneous, Mode Line, X11 Colors, Emacs Initialization
+@node Miscellaneous
@section Miscellaneous Settings for a @file{.emacs} File
@need 1250
@end smallexample
@need 1700
-@node Mode Line, , Miscellaneous, Emacs Initialization
+@node Mode Line
@section A Modified Mode Line
@vindex mode-line-format
@cindex Mode line format
@file{~/.emacs} initialization file. A plain, default Emacs. Nothing
more.
-@node Debugging, Conclusion, Emacs Initialization, Top
+@node Debugging
@chapter Debugging
@cindex debugging
* Debugging Exercises::
@end menu
-@node debug, debug-on-entry, Debugging, Debugging
+@node debug
@section @code{debug}
@findex debug
You can correct the mistake, re-evaluate the function definition, and
then run your test again.
-@node debug-on-entry, debug-on-quit, debug, Debugging
+@node debug-on-entry
@section @code{debug-on-entry}
@findex debug-on-entry
@noindent
(If you are reading this in Info, cancel @code{debug-on-entry} now.)
-@node debug-on-quit, edebug, debug-on-entry, Debugging
+@node debug-on-quit
@section @code{debug-on-quit} and @code{(debug)}
In addition to setting @code{debug-on-error} or calling @code{debug-on-entry},
The @code{debug} function is described in detail in @ref{Debugger, ,
The Lisp Debugger, elisp, The GNU Emacs Lisp Reference Manual}.
-@node edebug, Debugging Exercises, debug-on-quit, Debugging
+@node edebug
@section The @code{edebug} Source Level Debugger
@cindex Source level debugger
@findex edebug
Lisp Reference Manual}.
@need 1500
-@node Debugging Exercises, , edebug, Debugging
+@node Debugging Exercises
@section Debugging Exercises
@itemize @bullet
stopping point.
@end itemize
-@node Conclusion, the-the, Debugging, Top
+@node Conclusion
@chapter Conclusion
We have now reached the end of this Introduction. You have now
@c ================ Appendix ================
-@node the-the, Kill Ring, Conclusion, Top
+@node the-the
@appendix The @code{the-the} Function
@findex the-the
@cindex Duplicated words function
You can substitute the other regular expressions shown above in the
function definition and try each of them on this list.
-@node Kill Ring, Full Graph, the-the, Top
+@node Kill Ring
@appendix Handling the Kill Ring
@cindex Kill ring handling
@cindex Handling the kill ring
* ring file::
@end menu
-@node What the Kill Ring Does, current-kill, Kill Ring, Kill Ring
@ifnottex
+@node What the Kill Ring Does
@unnumberedsec What the Kill Ring Does
@end ifnottex
(setq kill-ring-max old-kill-ring-max)
@end smallexample
-@node current-kill, yank, What the Kill Ring Does, Kill Ring
-@comment node-name, next, previous, up
+@node current-kill
@appendixsec The @code{current-kill} Function
@findex current-kill
* Understanding current-kill::
@end menu
-@node Code for current-kill, Understanding current-kill, current-kill, current-kill
@ifnottex
+@node Code for current-kill
@unnumberedsubsec The code for @code{current-kill}
@end ifnottex
(setq kill-ring-yank-pointer kill-ring)
@end smallexample
-@node Understanding current-kill, , Code for current-kill, current-kill
@ifnottex
+@node Understanding current-kill
@unnumberedsubsec @code{current-kill} in Outline
@end ifnottex
* Determining the Element::
@end menu
-@node Body of current-kill, Digression concerning error, Understanding current-kill, Understanding current-kill
@ifnottex
+@node Body of current-kill
@unnumberedsubsubsec The Body of @code{current-kill}
@end ifnottex
list. Finally, another expression returns the first element of the
list even if the @code{do-not-move} argument is true.
-@node Digression concerning error, Determining the Element, Body of current-kill, Understanding current-kill
@ifnottex
+@node Digression concerning error
@unnumberedsubsubsec Digression about the word `error'
@end ifnottex
takes the same steps as it does when there is an `error', a term such as
`cancel' would have a clearer connotation.
-@node Determining the Element, , Digression concerning error, Understanding current-kill
@ifnottex
+@node Determining the Element
@unnumberedsubsubsec Determining the Element
@end ifnottex
@ref{defun, , The @code{defun} Special Form}.)
@end ignore
-@node yank, yank-pop, current-kill, Kill Ring
-@comment node-name, next, previous, up
+@node yank
@appendixsec @code{yank}
@findex yank
The last part of the function tells what to do when it succeeds.
-@node yank-pop, ring file, yank, Kill Ring
-@comment node-name, next, previous, up
+@node yank-pop
@appendixsec @code{yank-pop}
@findex yank-pop
There is more, but that is the hardest part.
-@node ring file, , yank-pop, Kill Ring
-@comment node-name, next, previous, up
+@node ring file
@appendixsec The @file{ring.el} File
@cindex @file{ring.el} file
as @code{kill-ring-yank-pointer} do not use this library, possibly
because they were written earlier.
-@node Full Graph, Free Software and Free Manuals, Kill Ring, Top
+@node Full Graph
@appendix A Graph with Labeled Axes
Printed axes help you understand a graph. They convey scale. In an
* Print Whole Graph:: The function to print a complete graph.
@end menu
-@node Labeled Example, print-graph Varlist, Full Graph, Full Graph
@ifnottex
+@node Labeled Example
@unnumberedsec Labeled Example Graph
@end ifnottex
We can work on each part of the @code{print-graph} function definition
in turn.
-@node print-graph Varlist, print-Y-axis, Labeled Example, Full Graph
-@comment node-name, next, previous, up
+@node print-graph Varlist
@appendixsec The @code{print-graph} Varlist
@cindex @code{print-graph} varlist
As we shall see, this expression is not quite right.
@need 2000
-@node print-Y-axis, print-X-axis, print-graph Varlist, Full Graph
-@comment node-name, next, previous, up
+@node print-Y-axis
@appendixsec The @code{print-Y-axis} Function
@cindex Axis, print vertical
@cindex Y axis printing
* print-Y-axis Penultimate:: A not quite final version.
@end menu
-@node print-Y-axis in Detail, Height of label, print-Y-axis, print-Y-axis
@ifnottex
+@node print-Y-axis in Detail
@unnumberedsubsec The @code{print-Y-axis} Function in Detail
@end ifnottex
the fifth line from the bottom and on every line that is a multiple of
five.
-@node Height of label, Compute a Remainder, print-Y-axis in Detail, print-Y-axis
@ifnottex
+@node Height of label
@unnumberedsubsec What height should the label be?
@end ifnottex
once, with a remainder of two. However, five goes into ten twice,
with no remainder: ten is an integral multiple of five.
-@node Compute a Remainder, Y Axis Element, Height of label, print-Y-axis
+@node Compute a Remainder
@appendixsubsec Side Trip: Compute a Remainder
@findex % @r{(remainder function)}
final value. @xref{fwd-para let, , The @code{let*} expression}, for
more about @code{let*}.)
-@node Y Axis Element, Y-axis-column, Compute a Remainder, print-Y-axis
+@node Y Axis Element
@appendixsubsec Construct a Y Axis Element
When we print the vertical axis, we want to insert strings such as
expression, to convert the number to a string that is concatenated
with the leading spaces and the tic mark.
-@node Y-axis-column, print-Y-axis Penultimate, Y Axis Element, print-Y-axis
+@node Y-axis-column
@appendixsubsec Create a Y Axis Column
The preceding functions provide all the tools needed to construct a
consists of the number one followed by a tic mark.
@need 2000
-@node print-Y-axis Penultimate, , Y-axis-column, print-Y-axis
+@node print-Y-axis Penultimate
@appendixsubsec The Not Quite Final Version of @code{print-Y-axis}
The list constructed by the @code{Y-axis-column} function is passed to
thereby getting rid of what might appear as a bug.)
@need 2000
-@node print-X-axis, Print Whole Graph, print-Y-axis, Full Graph
+@node print-X-axis
@appendixsec The @code{print-X-axis} Function
@cindex Axis, print horizontal
@cindex X axis printing
* X Axis Tic Marks:: Create tic marks for the horizontal axis.
@end menu
-@node Similarities differences, X Axis Tic Marks, print-X-axis, print-X-axis
@ifnottex
+@node Similarities differences
@unnumberedsubsec Similarities and differences
@end ifnottex
@code{print-X-axis-numbered-line}.
@end enumerate
-@node X Axis Tic Marks, , Similarities differences, print-X-axis
+@node X Axis Tic Marks
@appendixsubsec X Axis Tic Marks
The first function should print the X axis tic marks. We must specify
@end group
@end smallexample
-@node Print Whole Graph, , print-X-axis, Full Graph
+@node Print Whole Graph
@appendixsec Printing the Whole Graph
@cindex Printing the whole graph
@cindex Whole graph printing
* Final printed graph:: The graph itself!
@end menu
-@node The final version, Test print-graph, Print Whole Graph, Print Whole Graph
@ifnottex
+@node The final version
@unnumberedsubsec Changes for the Final Version
@end ifnottex
@end group
@end smallexample
-@node Test print-graph, Graphing words in defuns, The final version, Print Whole Graph
+@node Test print-graph
@appendixsubsec Testing @code{print-graph}
@need 1250
feature? If you think it is a bug, and should be a `1' instead, (or
even a `0'), you can modify the sources.)
-@node Graphing words in defuns, lambda, Test print-graph, Print Whole Graph
+@node Graphing words in defuns
@appendixsubsec Graphing Numbers of Words and Symbols
Now for the graph for which all this code was written: a graph that
@end group
@end smallexample
-@node lambda, mapcar, Graphing words in defuns, Print Whole Graph
+@node lambda
@appendixsubsec A @code{lambda} Expression: Useful Anonymity
@cindex Anonymous function
@findex lambda
Lisp Reference Manual}, for more about @code{lambda}. Lisp and lambda
expressions derive from the Lambda Calculus.
-@node mapcar, Another Bug, lambda, Print Whole Graph
+@node mapcar
@appendixsubsec The @code{mapcar} Function
@findex mapcar
50 defuns had that many words or symbols---but not necessarily meaning
that none had that many words or symbols.)
-@node Another Bug, Final printed graph, mapcar, Print Whole Graph
+@node Another Bug
@appendixsubsec Another Bug @dots{} Most Insidious
@cindex Bug, most insidious type
@cindex Insidious type of bug
@end ignore
@page
-@node Final printed graph, , Another Bug, Print Whole Graph
+@node Final printed graph
@appendixsubsec The Printed Graph
When made and installed, you can call the @code{print-graph} command
@noindent
The largest group of functions contain 10 -- 19 words and symbols each.
-@node Free Software and Free Manuals, GNU Free Documentation License, Full Graph, Top
+@node Free Software and Free Manuals
@appendix Free Software and Free Manuals
@strong{by Richard M. Stallman}
that lists free books available from other publishers:@*
@uref{http://www.gnu.org/doc/other-free-books.html}
-@node GNU Free Documentation License, Index, Free Software and Free Manuals, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@cindex FDL, GNU Free Documentation License
@include doclicense.texi
-@node Index, About the Author, GNU Free Documentation License, Top
-@comment node-name, next, previous, up
+@node Index
@unnumbered Index
@ignore
@end iftex
@ifnottex
-@node About the Author, , Index, Top
+@node About the Author
@unnumbered About the Author
@end ifnottex
#### -*- Makefile -*- for the Emacs Lisp Introduction manual.
-# Copyright (C) 2003-2012 Free Software Foundation, Inc.
+# Copyright (C) 2003-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
# Directory with the (customized) texinfo.tex file.
texinfodir = $(srcdir)/../misc
+INFO_EXT=.info
+INFO_OPTS=--no-split
INFO_SOURCES = $(srcdir)/emacs-lisp-intro.texi $(srcdir)/doclicense.texi
# The file name eintr must fit within 5 characters, to allow for
# -NN extensions to fit into DOS 8+3 limits without clashing
-INFO_TARGETS = $(infodir)/eintr
+INFO_TARGETS = $(infodir)/eintr$(INFO_EXT)
DVI_TARGETS = emacs-lisp-intro.dvi
MAKEINFO = makeinfo
dvi: $(DVI_TARGETS)
-$(infodir)/eintr: $(INFO_SOURCES)
- $(MAKEINFO) -o $@ $(srcdir)/emacs-lisp-intro.texi
+$(infodir)/eintr$(INFO_EXT): $(INFO_SOURCES)
+ $(MAKEINFO) $(INFO_OPTS) -o $@ $(srcdir)/emacs-lisp-intro.texi
emacs-lisp-intro.dvi: $(INFO_SOURCES)
$(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-lisp-intro.texi
- $(DEL) *.log *.cp *.fn *.ky *.pg *.vr *.tp
clean: mostlyclean
- - $(DEL) *.dvi $(infodir)/eintr*
+ - $(DEL) *.dvi $(infodir)/eintr$(INFO_EXT)*
distclean: clean
- $(DEL) makefile
-2012-09-25 Leo Liu <sdl.web@gmail.com>
+2012-09-28 Leo Liu <sdl.web@gmail.com>
* files.texi (Files): Fix typo.
-2012-09-12 Glenn Morris <rgm@gnu.org>
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * buffers.texi (Read Only Buffers): Document read-only-mode.
+
+ * keymaps.texi (Alias Menu Items): Replace toggle-read-only with
+ read-only-mode.
+
+ * backups.texi (Auto-Saving): Refer to Minor Mode Conventions for
+ calling conventions.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * searching.texi (Replacing Match): Minor clarification.
+
+2012-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ * edebug.texi (Instrumenting): Improve indexing.
+
+ * os.texi (Idle Timers): Warn against reinvoking an idle timer
+ from within its own timer action. (Bug#12447)
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * frames.texi (Pop-Up Menus): Minor clarification (Bug#11148).
+
+2012-09-21 Glenn Morris <rgm@gnu.org>
* debugging.texi (Using Debugger): Fix typo.
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-18 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Faces): Discuss anonymous faces.
+ (Face Attributes): Tweak intro.
+ (Defining Faces): Move after the Face Attributes node. Copyedits.
+ (Displaying Faces): Describe role of inheritance.
+
+ * customize.texi (Customization): Define customization more
+ carefully (Bug#11440).
+ (Common Keywords): Add xref to Constant Variables.
+
+ * variables.texi (Defining Variables): Link to defcustom's node
+ instead of the higher-level Customization chapter.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ * numbers.texi (Float Basics, Arithmetic Operations, Math Functions):
+ Document that / and mod (with floating point arguments), along
+ with asin, acos, log, log10, expt and sqrt, return special values
+ instead of signaling exceptions.
+ (Float Basics): Document that logb operates on the absolute value
+ of its argument.
+ (Math Functions): Document that (log ARG BASE) also returns NaN if
+ BASE is negative. Document that (expt X Y) returns NaN if X is a
+ finite negative number and Y a finite non-integer.
+
+2012-09-09 Chong Yidong <cyd@gnu.org>
+
+ * lists.texi (Sets And Lists): Explain that the return value for
+ delete should be used, like for delq.
+
+ * minibuf.texi (Yes-or-No Queries): Document recentering and
+ scrolling in y-or-n-p. Remove gratuitous example.
+
+ * searching.texi (Search and Replace): Document window scrolling
+ entries in query-replace-map.
+
+2012-09-08 Chong Yidong <cyd@gnu.org>
- * Version 24.2 released.
+ * syntax.texi (Syntax Table Internals): Define "raw syntax
+ descriptor" terminology (Bug#12383).
+ (Syntax Descriptors): Mention raw syntax descriptors.
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * variables.texi (Creating Buffer-Local): Fix description of
+ local-variable-if-set-p (Bug#10713).
+
+ * eval.texi (Intro Eval): Add index entry for sexp (Bug#12233).
+
+ * windows.texi (Display Action Functions)
+ (Choosing Window Options): Remove obsolete variable
+ display-buffer-reuse-frames.
+ (Switching Buffers): Minor doc tweak for switch-to-buffer.
+
+ * positions.texi (Narrowing): Document buffer-narrowed-p.
+
+ * markers.texi (Moving Markers): Add xref to Point (Bug#7151).
+
+ * syntax.texi (Low-Level Parsing): Add xref to Parser State
+ (Bug#12269).
+
+2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * debugging.texi (Explicit Debug): Document `debug-on-message'.
+
+2012-09-02 Chong Yidong <cyd@gnu.org>
+
+ * windows.texi (Window Configurations): Recommend against using
+ save-window-excursion (Bug#12075).
+
+ * control.texi (Catch and Throw):
+ * positions.texi (Excursions): Don't mention it.
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seed support for (random).
+ * numbers.texi (Random Numbers): Document new behavior of
+ the calls (random) and (random STRING).
+
+2012-08-21 Martin Rudalics <rudalics@gmx.at>
+
+ * windows.texi (Window Point): Document recent changes in
+ window-point and set-window-point.
+ (Selecting Windows): Document recent change in select-window.
2012-08-06 Eli Zaretskii <eliz@gnu.org>
* variables.texi (Lexical Binding): Disambiguate the index entry
for "closures".
-2012-06-19 Glenn Morris <rgm@gnu.org>
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Defining Faces): Move documentation of
+ frame-background-mode to the Emacs manual (Bug#7774).
+
+2012-08-04 Chong Yidong <cyd@gnu.org>
+
+ * 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 <eliz@gnu.org>
+
+ * nonascii.texi (Character Sets): Fix a typo. (Bug#12062)
+
+2012-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer typical American spelling for "acknowledgment".
+ * intro.texi (Acknowledgments): Rename from Acknowledgements.
+
+2012-07-21 Eli Zaretskii <eliz@gnu.org>
+
+ * commands.texi (Special Events): Mention language-change event.
+ (Input Events, Interactive Codes):
+ * keymaps.texi (Key Sequences): Mention events that are
+ non-keyboard but also non-mouse events.
+
+2012-07-17 Chong Yidong <cyd@gnu.org>
+
+ * text.texi (Insertion): Document insert-char changes.
+
+2012-07-15 Leo Liu <sdl.web@gmail.com>
+
+ * display.texi (Fringe Bitmaps): Add exclamation-mark.
+
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * buffers.texi (Read Only Buffers): Document toggle-read-only
+ changes. Reword to account for the fact that read-only is
+ currently not supported in overlay properties.
+
+2012-07-07 Chong Yidong <cyd@gnu.org>
+
+ * loading.texi (Library Search): Index site-lisp directories.
+
+2012-07-06 Chong Yidong <cyd@gnu.org>
+
+ * intro.texi (A Sample Function Description): Fix incorrect
+ markup, undoing previous change.
+ (A Sample Variable Description): Minor clarifications and markup
+ improvements.
+
+ * elisp.texi (Top):
+ * text.texi (Text): Fix menu order.
+
+2012-07-06 Richard Stallman <rms@gnu.org>
+
+ * intro.texi (Evaluation Notation, A Sample Function Description):
+ (A Sample Variable Description): Improve/undo previous changes.
+
+2012-07-05 Glenn Morris <rgm@gnu.org>
+
+ * intro.texi (A Sample Function Description): Fix cross-refs.
+
+2012-07-05 Michael Witten <mfwitten@gmail.com> (tiny change)
+
+ * intro.texi (Evaluation Notation, A Sample Function Description)
+ (A Sample Variable Description, Version Info): Copy edits (bug#11862).
+
+2012-06-27 Chong Yidong <cyd@gnu.org>
+
+ * processes.texi (Asynchronous Processes, Input to Processes):
+ * internals.texi (Process Internals): Don't capitalize "pty".
+
+2012-06-24 Thien-Thi Nguyen <ttn@gnuvola.org>
+
+ * processes.texi (Asynchronous Processes): Make the pty vs pipe
+ discussion more prominent.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ * commands.texi (Misc Events): Document the language-change event.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * os.texi (Time of Day, Time Parsing, Processor Run Time, Idle Timers):
+ * processes.texi (System Processes):
+ Time stamp resolution is now picosecond, not microsecond.
+
+2012-06-21 Glenn Morris <rgm@gnu.org>
* Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
+2012-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * functions.texi (Defining Functions):
+ * macros.texi (Defining Macros): Un-define the return value of `defun',
+ `defmacro' and `defalias'.
+
+2012-06-17 Chong Yidong <cyd@gnu.org>
+
+ * elisp.texi: Remove urlcolor setting.
+
+2012-06-17 Glenn Morris <rgm@gnu.org>
+
+ * display.texi (Face Attributes): Copyedits. Add a few cindex entries.
+ Overlining no longer behaves exactly like underlining.
+
+2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com>
+
+ * display.texi (Face Attributes):
+ Document wave-style underline face attribute.
+
2012-06-11 Chong Yidong <cyd@gnu.org>
- * elisp.texi, vol1.texi, vol2.texi: Remove urlcolor setting.
+ * display.texi (ImageMagick Images): ImageMagick now supports the
+ :background property.
+
+2012-06-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * internals.texi (Garbage Collection): Typo fix.
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * text.texi (Special Properties): Clarify the meaning of a list of
+ faces in the `face' property.
- * vol2.texi: Include package.texi.
+ * display.texi (Face Remapping): Minor clarification.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-06-08 Chong Yidong <cyd@gnu.org>
- * Version 24.1 released.
+ * display.texi (Face Attributes): Font family does not accept
+ wildcards. De-document obsolete :bold and :italic attributes.
+ (Defining Faces): Use new-style face spec format.
-2012-05-15 Chong Yidong <cyd@gnu.org>
+2012-06-08 Dmitry Antipov <dmantipov@yandex.ru>
- * functions.texi (Obsolete Functions): Fix doc for
- set-advertised-calling-convention.
+ * internals.texi (Garbage Collection): Document new
+ vector management code and vectorlike_header structure.
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * modes.texi (Mode Line Data): Use "mode line construct"
+ terminology for consistency.
+
+2012-05-27 Glenn Morris <rgm@gnu.org>
+
+ * abbrevs.texi, advice.texi, anti.texi, backups.texi:
+ * buffers.texi, commands.texi, compile.texi, control.texi:
+ * customize.texi, debugging.texi, display.texi, doclicense.texi:
+ * edebug.texi, elisp.texi, errors.texi, eval.texi, files.texi:
+ * frames.texi, functions.texi, gpl.texi, hash.texi, help.texi:
+ * hooks.texi, index.texi, internals.texi, intro.texi, keymaps.texi:
+ * lists.texi, loading.texi, macros.texi, maps.texi, markers.texi:
+ * minibuf.texi, modes.texi, nonascii.texi, numbers.texi:
+ * objects.texi, os.texi, package.texi, positions.texi:
+ * processes.texi, searching.texi, sequences.texi, streams.texi:
+ * strings.texi, symbols.texi, syntax.texi, text.texi, tips.texi:
+ * variables.texi, windows.texi: Nuke hand-written node pointers.
+
+2012-05-27 Chong Yidong <cyd@gnu.org>
+
+ * functions.texi (Obsolete Functions):
+ Fix doc for set-advertised-calling-convention.
* modes.texi (Mode Help): Fix describe-mode.
* variables.texi (Variable Aliases): Fix make-obsolete-variable.
-2012-05-15 Martin Rudalics <rudalics@gmx.at>
+2012-05-27 Martin Rudalics <rudalics@gmx.at>
- * commands.texi (Recursive Editing): recursive-edit is a
- command.
+ * commands.texi (Recursive Editing): recursive-edit is a command.
* compile.texi (Docs and Compilation):
byte-compile-dynamic-docstrings is an option.
progress-reporter-force-update have VALUE argument optional.
(Animated Images): Use non-@code{nil} instead of non-nil.
- * files.texi (Format Conversion Round-Trip): Use non-@code{nil}
- instead of non-nil.
+ * files.texi (Format Conversion Round-Trip):
+ Use non-@code{nil} instead of non-nil.
* frames.texi (Creating Frames): make-frame is a command.
(Input Focus): select-frame is a command.
(Pointer Shape): void-text-area-pointer is an option.
- * help.texi (Describing Characters): read-kbd-macro is a
- command.
+ * help.texi (Describing Characters): read-kbd-macro is a command.
(Help Functions): describe-prefix-bindings is a command.
* markers.texi (Creating Markers): Both arguments of copy-marker
* modes.texi (Mode Line Variables): mode-line-remote and
mode-line-client are not options.
(Imenu): imenu-add-to-menubar is a command.
- (SMIE Indentation Helpers): Use non-@code{nil} instead of
- non-nil.
+ (SMIE Indentation Helpers): Use non-@code{nil} instead of non-nil.
* os.texi (Sound Output): play-sound-file is a command.
- * package.texi (Package Archives): Use @key{RET} instead of
- @kbd{RET}.
+ * package.texi (Package Archives): Use @key{RET} instead of @kbd{RET}.
- * processes.texi (Signals to Processes): Use @key{RET} instead
- of @code{RET}.
+ * processes.texi (Signals to Processes):
+ Use @key{RET} instead of @code{RET}.
(Signals to Processes): signal-process is a command.
- * text.texi (Clickable Text): Use @key{RET} instead of
- @kbd{RET}.
+ * text.texi (Clickable Text): Use @key{RET} instead of @kbd{RET}.
(Base 64): base64-encode-string is not a command while
base64-decode-region is.
* windows.texi (Switching Buffers): pop-to-buffer is a command.
-2012-05-08 Glenn Morris <rgm@gnu.org>
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkinfodir): Use $MKDIR_P.
+
+2012-05-10 Glenn Morris <rgm@gnu.org>
+
+ * loading.texi (Loading Non-ASCII): Replace the obsolete "unibyte: t"
+ with "coding: raw-text".
+ Concept of multibyte sessions no longer exists.
+
+ * files.texi (File Locks): Mention create-lockfiles option.
+
+2012-05-09 Glenn Morris <rgm@gnu.org>
+
+ * vol1.texi, vol2.texi: Remove files.
+ * elisp.texi: Add VOL1,2 conditionals equivalent to vol1,2.texi
+ * two-volume.make: Use elisp.texi as input rather than vol1,2.texi.
* Makefile.in (clean, mostlyclean): Add some more vol1/2 items.
* two-volume.make (emacsdir): New.
(tex): Add directory with emacsver.texi to TEXINPUTS.
-2012-05-05 Glenn Morris <rgm@gnu.org>
-
* minibuf.texi (Minibuffer History, Basic Completion):
Tweak page breaks.
(Sequencing, Conditionals, Signaling Errors, Handling Errors):
Tweak page breaks.
-2012-05-04 Glenn Morris <rgm@gnu.org>
+2012-05-08 Glenn Morris <rgm@gnu.org>
- * lists.texi (List-related Predicates, List Variables):
- Tweak page-breaks.
- (Sets And Lists): Convert inforef to xref.
+ * two.el: Remove; unused since creation of two-volume.make.
- * text.texi (Auto Filling): Don't mention Emacs 19.
+ * vol1.texi, vol2.texi: No need to keep menus in these files.
- * commands.texi (Event Input Misc): Don't mention unread-command-char.
- * numbers.texi (Predicates on Numbers): Don't mention Emacs 18.
+2012-05-05 Glenn Morris <rgm@gnu.org>
* objects.texi (Process Type, Overlay Type): Tweak page-breaks.
(Lisp History): Convert inforef to xref.
(Lisp History, Printing Notation, Version Info): Improve page-breaks.
+ * text.texi (Auto Filling): Don't mention Emacs 19.
+
+ * commands.texi (Event Input Misc): Don't mention unread-command-char.
+ * numbers.texi (Predicates on Numbers): Don't mention Emacs 18.
+
* elisp.texi (DATE): Forgot to change the month in 2012-04-21 change.
-2012-05-01 Glenn Morris <rgm@gnu.org>
+ * lists.texi (List-related Predicates, List Variables):
+ Tweak page-breaks.
+ (Sets And Lists): Convert inforef to xref.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (INFO_EXT, INFO_OPTS): New, set by configure.
+ (info, infoclean): Use $INFO_EXT.
+ ($(infodir)/elisp$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+ * makefile.w32-in (INFO_EXT, INFO_OPTS): New.
+ (info, maintainer-clean): Use $INFO_EXT.
+ ($(infodir)/elisp$(INFO_EXT)): Use $INFO_EXT and $INFO_OPT.
+
+2012-05-04 Chong Yidong <cyd@gnu.org>
+
+ * os.texi (Timers): Use defopt for timer-max-repeats.
+
+2012-05-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * os.texi (Time of Day): Do not limit current-time-string
+ to years 1000..9999.
+
+2012-05-02 Chong Yidong <cyd@gnu.org>
+
+ * display.texi (Font Lookup):
+ * frames.texi (Pointer Shape):
+ * processes.texi (Subprocess Creation): Use defopt for options.
+
+2012-05-02 Glenn Morris <rgm@gnu.org>
* elisp.texi (@copying):
* intro.texi (Introduction): Only print VERSION in the TeX version.
-2012-04-29 Chong Yidong <cyd@gnu.org>
+2012-05-02 Chong Yidong <cyd@gnu.org>
* text.texi (Change Hooks): Minor fix for after-change-functions.
-2012-04-28 Glenn Morris <rgm@gnu.org>
+2012-05-02 Glenn Morris <rgm@gnu.org>
* package.texi (Packaging Basics):
* loading.texi (Autoload):
* files.texi (Magic File Names):
Reword to remove/reduce some overly long/short lines.
-2012-04-26 Glenn Morris <rgm@gnu.org>
+2012-04-27 Glenn Morris <rgm@gnu.org>
* elisp.texi, vol1.texi, vol2.texi: Some fixes for detailed menu.
* modes.texi (Major Modes, Auto-Indentation):
* buffers.texi (Buffers): Some fixes for menu descriptions.
-2012-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
+2012-04-27 Stefan Monnier <monnier@iro.umontreal.ca>
* functions.texi (Simple Lambda, Argument List):
* eval.texi (Function Indirection): Avoid deprecated form.
-2012-04-26 Glenn Morris <rgm@gnu.org>
+2012-04-27 Glenn Morris <rgm@gnu.org>
* book-spine.texi, elisp.texi, vol1.texi, vol2.texi:
Add "et al." to authors.
* symbols.texi, syntax.texi, text.texi, tips.texi, variables.texi:
Use Texinfo recommended convention for quotes+punctuation.
-2012-04-23 Chong Yidong <cyd@gnu.org>
+2012-04-27 Chong Yidong <cyd@gnu.org>
* keymaps.texi (Scanning Keymaps): Fix description of NO-REMAP arg
to where-is-internal (Bug#10872).
-2012-04-21 Glenn Morris <rgm@gnu.org>
+2012-04-27 Glenn Morris <rgm@gnu.org>
* macros.texi (Indenting Macros): Fix typo.
* minibuf.texi (Intro to Minibuffers):
Tweak discussion of resizing minibuffer window.
+2012-04-26 Glenn Morris <rgm@gnu.org>
+
+ * elisp-covers.texi, front-cover-1.texi: Remove files.
+
+ * tindex.pl: Remove file.
+
+ * makefile.w32-in (srcs):
+ * Makefile.in (srcs): Remove back.texi (which is unused).
+
+2012-04-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * os.texi (Notifications): Extend possible notification hints.
+ Add notifications-get-capabilities.
+
2012-04-20 Chong Yidong <cyd@gnu.org>
* processes.texi (Asynchronous Processes): Mention nil argument to
* elisp.texi, vol1.texi, vol2.texi, minibuf.texi (Completion):
Update "High-Level Completion" description.
-2012-04-19 Glenn Morris <rgm@gnu.org>
-
* minibuf.texi (Minibuffers):
* elisp.texi, vol1.texi, vol2.texi: Fix minibuffer subsection order.
(Minibuffer Misc): Mention minibuffer-message-timeout, and
minibuffer-inactive-mode.
-2012-04-18 Glenn Morris <rgm@gnu.org>
-
* processes.texi (Serial Ports, Byte Packing, Bindat Spec)
(Bindat Functions): Copyedits.
-2012-04-18 Christopher Schmidt <christopher@ch.ristopher.com>
+2012-04-20 Christopher Schmidt <christopher@ch.ristopher.com>
* files.texi (Saving Buffers): Document `visit and `visit-save'
values of require-final-newline.
-2012-04-18 Glenn Morris <rgm@gnu.org>
+2012-04-20 Glenn Morris <rgm@gnu.org>
* processes.texi (Output from Processes, Filter Functions):
Mention waiting-for-user-input-p.
(Network): Add encrypted network overview paragraph.
Cross-reference the Emacs-GnuTLS manual. Use @acronym.
-2012-04-17 Chong Yidong <cyd@gnu.org>
+2012-04-20 Chong Yidong <cyd@gnu.org>
* help.texi (Keys in Documentation): Mention :advertised-binding.
* keymaps.texi (Menu Bar): Move most of the :advertised-binding
description to help.texi.
-2012-04-16 Glenn Morris <rgm@gnu.org>
+2012-04-20 Glenn Morris <rgm@gnu.org>
* processes.texi (Process Information, Input to Processes)
(Signals to Processes, Output from Processes, Process Buffers)
(Process Information): Fix typo.
(Bindat Spec): Use Texinfo-recommended form of quote+punctuation.
-2012-04-14 Glenn Morris <rgm@gnu.org>
+2012-04-15 Glenn Morris <rgm@gnu.org>
* anti.texi (Antinews): Copyedits. Don't @dfn anything here.
open-network-stream does exist in Emacs 23, but is simpler.
-2012-04-13 Chong Yidong <cyd@gnu.org>
+2012-04-15 Chong Yidong <cyd@gnu.org>
* customize.texi (Custom Themes): Also document load-theme etc.
-2012-04-12 Chong Yidong <cyd@gnu.org>
+2012-04-14 Chong Yidong <cyd@gnu.org>
* customize.texi (Applying Customizations):
(Custom Themes): New nodes.
* modes.texi (Defining Minor Modes, Defining Minor Modes):
* os.texi (Startup Summary): Copyedits.
-2012-04-12 Glenn Morris <rgm@gnu.org>
+2012-04-14 Glenn Morris <rgm@gnu.org>
* loading.texi (Loading Non-ASCII): "unibyte:" can also be at the end.
-2012-04-10 Glenn Morris <rgm@gnu.org>
-
* strings.texi (Case Tables):
* objects.texi (General Escape Syntax):
* keymaps.texi (Key Sequences): Use @acronym with "ASCII".
* compile.texi (Compiler Errors): Add missing space in buffer name.
-2012-04-08 Chong Yidong <cyd@gnu.org>
+2012-04-14 Chong Yidong <cyd@gnu.org>
* processes.texi (Query Before Exit): Remove obsolete function
process-kill-without-query (Bug#11190).
-2012-04-08 Glenn Morris <rgm@gnu.org>
+2012-04-14 Glenn Morris <rgm@gnu.org>
* files.texi, frames.texi, loading.texi, os.texi, processes.texi:
Use @env for environment variables.
-2012-04-07 Glenn Morris <rgm@gnu.org>
-
* Makefile.in: Replace non-portable use of $< in ordinary rules.
+2012-04-12 Jari Aalto <jari.aalto@cante.net>
+
+ * processes.texi (Synchronous Processes): Mention
+ `default-directory' (bug#7515).
+
+2012-04-09 Chong Yidong <cyd@gnu.org>
+
+ * customize.texi (Variable Definitions): Remove user-variable-p.
+
+ * commands.texi (Interactive Codes):
+ * help.texi (Accessing Documentation):
+ * minibuf.texi (High-Level Completion): Callers changed.
+
2012-04-06 Chong Yidong <cyd@gnu.org>
* minibuf.texi (Programmed Completion): Document metadata method.
* functions.texi (Function Safety): Texinfo usage fix.
-2009-01-04 Eduard Wiebe <usenet@pusto.de> (tiny patch)
+2009-01-04 Eduard Wiebe <usenet@pusto.de> (tiny change)
* objects.texi (General Escape Syntax): Fix typo.
(Recording Input): Document that clear-this-command-keys clears
the vector to be returned by recent-keys.
- * keymaps.texi (Scanning Keymaps) <where-is-internal>: The
- argument keymap can be a list.
+ * keymaps.texi (Scanning Keymaps) <where-is-internal>:
+ The argument keymap can be a list.
* nonascii.texi (User-Chosen Coding Systems)
<select-safe-coding-system>: Document the new argument
* Makefile (dist): Don't bother excluding autosave files; they'll
never make it into the temp directory anyway, and the hash marks
in the name are problematic for make and the Bourne shell.
- (srcs):
+ (srcs): ???
1993-02-12 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
;; coding: utf-8
;; End:
- Copyright (C) 1998-2012 Free Software Foundation, Inc.
+ Copyright (C) 1998-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
# Directory with emacsver.texi.
emacsdir = $(srcdir)/../emacs
+MKDIR_P = @MKDIR_P@
+
+INFO_EXT=@INFO_EXT@
+# Options used only when making info output.
+INFO_OPTS=@INFO_OPTS@
+
MAKEINFO = @MAKEINFO@
MAKEINFO_OPTS = --force --enable-encoding -I $(emacsdir) -I $(srcdir)
TEXI2DVI = texi2dvi
$(srcdir)/abbrevs.texi \
$(srcdir)/advice.texi \
$(srcdir)/anti.texi \
- $(srcdir)/back.texi \
$(srcdir)/backups.texi \
$(srcdir)/buffers.texi \
$(srcdir)/commands.texi \
$(srcdir)/gpl.texi \
$(srcdir)/doclicense.texi
-mkinfodir = @test -d ${buildinfodir} || mkdir ${buildinfodir} || test -d ${buildinfodir}
+mkinfodir = @${MKDIR_P} ${buildinfodir}
.PHONY: info dvi pdf ps
-info: $(buildinfodir)/elisp
+info: $(buildinfodir)/elisp$(INFO_EXT)
dvi: elisp.dvi
html: elisp.html
pdf: elisp.pdf
ps: elisp.ps
## Note: "<" is not portable in ordinary make rules.
-$(buildinfodir)/elisp: $(srcs)
+$(buildinfodir)/elisp$(INFO_EXT): $(srcs)
$(mkinfodir)
- $(MAKEINFO) $(MAKEINFO_OPTS) -o $@ $(srcdir)/elisp.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $(srcdir)/elisp.texi
elisp.dvi: $(srcs)
$(ENVADD) $(TEXI2DVI) $(srcdir)/elisp.texi
distclean: clean
infoclean:
- -cd $(buildinfodir) && rm -f elisp elisp-[1-9] elisp-[1-9][0-9]
+ -cd $(buildinfodir) && rm -f elisp$(INFO_EXT) elisp$(INFO_EXT)-[1-9] elisp$(INFO_EXT)-[1-9][0-9]
maintainer-clean: distclean infoclean
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1994, 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/abbrevs
-@node Abbrevs, Processes, Syntax Tables, Top
+@node Abbrevs
@chapter Abbrevs and Abbrev Expansion
@cindex abbrev
@c @cindex abbrev table Redundant with "abbrev".
Which properties have which effect.
@end menu
-@node Abbrev Tables, Defining Abbrevs, Abbrevs, Abbrevs
+@node Abbrev Tables
@section Abbrev Tables
This section describes how to create and manipulate abbrev tables.
to add these to @var{name} separately.)
@end defun
-@node Defining Abbrevs, Abbrev Files, Abbrev Tables, Abbrevs
-@comment node-name, next, previous, up
+@node Defining Abbrevs
@section Defining Abbrevs
@code{define-abbrev} is the low-level basic function for defining an
callers.
@end defopt
-@node Abbrev Files, Abbrev Expansion, Defining Abbrevs, Abbrevs
+@node Abbrev Files
@section Saving Abbrevs in Files
A file of saved abbrev definitions is actually a file of Lisp code.
@code{abbrev-file-name} is used. This function returns @code{nil}.
@end deffn
-@node Abbrev Expansion, Standard Abbrev Tables, Abbrev Files, Abbrevs
-@comment node-name, next, previous, up
+@node Abbrev Expansion
@section Looking Up and Expanding Abbreviations
Abbrevs are usually expanded by certain interactive commands,
nil t)))
@end smallexample
-@node Standard Abbrev Tables, Abbrev Properties, Abbrev Expansion, Abbrevs
-@comment node-name, next, previous, up
+@node Standard Abbrev Tables
@section Standard Abbrev Tables
Here we list the variables that hold the abbrev tables for the
Properties}.
@end defvar
-@node Abbrev Properties, Abbrev Table Properties, Standard Abbrev Tables, Abbrevs
+@node Abbrev Properties
@section Abbrev Properties
Abbrevs have properties, some of which influence the way they work.
modifies the capitalization of the expansion.
@end table
-@node Abbrev Table Properties, , Abbrev Properties, Abbrevs
+@node Abbrev Table Properties
@section Abbrev Table Properties
Like abbrevs, abbrev tables have properties, some of which influence
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/advising
-@node Advising Functions, Debugging, Byte Compilation, Top
+@node Advising Functions
@chapter Advising Emacs Lisp Functions
@cindex advising functions
@c This node must have no pointers.
-@node Antinews, GNU Free Documentation License, Packaging, Top
+@node Antinews
@appendix Emacs 23 Antinews
-@c Update the elisp.texi, vol1.texi, vol2.texi Antinews menu entries
-@c with the above version number.
+@c Update the elisp.texi Antinews menu entry with the above version number.
For those users who live backwards in time, here is information about
downgrading to Emacs version 23.4. We hope you will enjoy the greater
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1999, 2001-2012 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/backups
-@node Backups and Auto-Saving, Buffers, Files, Top
+@node Backups and Auto-Saving
@chapter Backups and Auto-Saving
@cindex backups and auto-saving
@end defvar
@deffn Command auto-save-mode arg
-When used interactively without an argument, this command is a toggle
-switch: it turns on auto-saving of the current buffer if it is off,
-and vice versa. When called from Lisp with no argument, it turns
-auto-saving on. With an argument @var{arg}, it turns auto-saving on
-if the value of @var{arg} is @code{t}, a nonempty list, or a positive
-integer; otherwise, it turns auto-saving off.
+This is the mode command for Auto Save mode, a buffer-local minor
+mode. When Auto Save mode is enabled, auto-saving is enabled in the
+buffer. The calling convention is the same as for other minor mode
+commands (@pxref{Minor Mode Conventions}).
+
+Unlike most minor modes, there is no @code{auto-save-mode} variable.
+Auto Save mode is enabled if @code{buffer-auto-save-file-name} is
+non-@code{nil} and @code{buffer-saved-size} (see below) is non-zero.
@end deffn
@defun auto-save-file-name-p filename
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/buffers
-@node Buffers, Windows, Backups and Auto-Saving, Top
+@node Buffers
@chapter Buffers
@cindex buffer
@end menu
@node Buffer Basics
-@comment node-name, next, previous, up
@section Buffer Basics
@ifnottex
@end defun
@node Modification Time
-@comment node-name, next, previous, up
@section Buffer Modification Time
@cindex comparing file modification time
@cindex modification time of buffer
@defvar inhibit-read-only
If this variable is non-@code{nil}, then read-only buffers and,
depending on the actual value, some or all read-only characters may be
-modified. Read-only characters in a buffer are those that have
-non-@code{nil} @code{read-only} properties (either text properties or
-overlay properties). @xref{Special Properties}, for more information
-about text properties. @xref{Overlays}, for more information about
-overlays and their properties.
+modified. Read-only characters in a buffer are those that have a
+non-@code{nil} @code{read-only} text property. @xref{Special
+Properties}, for more information about text properties.
If @code{inhibit-read-only} is @code{t}, all @code{read-only} character
properties have no effect. If @code{inhibit-read-only} is a list, then
of the list (comparison is done with @code{eq}).
@end defvar
-@deffn Command toggle-read-only &optional arg
-This command toggles whether the current buffer is read-only. It is
-intended for interactive use; do not use it in programs (it may have
-side-effects, such as enabling View mode, and does not affect
-read-only text properties). To change the read-only state of a buffer in
-a program, explicitly set @code{buffer-read-only} to the proper value.
-To temporarily ignore a read-only state, bind @code{inhibit-read-only}.
-
-If @var{arg} is non-@code{nil}, it should be a raw prefix argument.
-@code{toggle-read-only} sets @code{buffer-read-only} to @code{t} if
-the numeric value of that prefix argument is positive and to
-@code{nil} otherwise. @xref{Prefix Command Arguments}.
+@deffn Command read-only-mode &optional arg
+This is the mode command for Read Only minor mode, a buffer-local
+minor mode. When the mode is enabled, @code{buffer-read-only} is
+non-@code{nil} in the buffer; when disabled, @code{buffer-read-only}
+is @code{nil} in the buffer. The calling convention is the same as
+for other minor mode commands (@pxref{Minor Mode Conventions}).
+
+This minor mode mainly serves as a wrapper for
+@code{buffer-read-only}; unlike most minor modes, there is no separate
+@code{read-only-mode} variable. Even when Read Only mode is disabled,
+characters with non-@code{nil} @code{read-only} text properties remain
+read-only. To temporarily ignore all read-only states, bind
+@code{inhibit-read-only}, as described above.
+
+When enabling Read Only mode, this mode command also enables View mode
+if the option @code{view-read-only} is non-@code{nil}. @xref{Misc
+Buffer,,Miscellaneous Buffer Operations, emacs, The GNU Emacs Manual}.
+When disabling Read Only mode, it disables View mode if View mode was
+enabled.
@end deffn
@defun barf-if-buffer-read-only
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/commands
-@node Command Loop, Keymaps, Minibuffers, Top
+@node Command Loop
@chapter Command Loop
@cindex editor command loop
@cindex command loop
@end defun
@node Interactive Codes
-@comment node-name, next, previous, up
@subsection Code Characters for @code{interactive}
@cindex interactive code description
@cindex description for interactive codes
Existing, Completion, Default, Prompt.
@item e
-The first or next mouse event in the key sequence that invoked the command.
-More precisely, @samp{e} gets events that are lists, so you can look at
-the data in the lists. @xref{Input Events}. No I/O.
+The first or next non-keyboard event in the key sequence that invoked
+the command. More precisely, @samp{e} gets events that are lists, so
+you can look at the data in the lists. @xref{Input Events}. No I/O.
+
+You use @samp{e} for mouse events and for special system events
+(@pxref{Misc Events}). The event list that the command receives
+depends on the event. @xref{Input Events}, which describes the forms
+of the list for each event in the corresponding subsections.
You can use @samp{e} more than once in a single command's interactive
specification. If the key sequence that invoked the command has
@item v
A variable declared to be a user option (i.e., satisfying the
-predicate @code{user-variable-p}). This reads the variable using
+predicate @code{custom-variable-p}). This reads the variable using
@code{read-variable}. @xref{Definition of read-variable}. Existing,
Completion, Prompt.
@end table
@node Interactive Examples
-@comment node-name, next, previous, up
@subsection Examples of Using @code{interactive}
@cindex examples of using @code{interactive}
@cindex @code{interactive}, examples of using
@end example
@node Command Loop Info
-@comment node-name, next, previous, up
@section Information from the Command Loop
The editor command loop sets several Lisp variables to keep status
@cindex input events
The Emacs command loop reads a sequence of @dfn{input events} that
-represent keyboard or mouse activity. The events for keyboard activity
-are characters or symbols; mouse events are always lists. This section
-describes the representation and meaning of input events in detail.
+represent keyboard or mouse activity, or system events sent to Emacs.
+The events for keyboard activity are characters or symbols; other
+events are always lists. This section describes the representation
+and meaning of input events in detail.
@defun eventp object
This function returns non-@code{nil} if @var{object} is an input event
@smallexample
(signal-process (emacs-pid) 'sigusr1)
@end smallexample
+
+@cindex @code{language-change} event
+@item language-change
+This kind of event is generated on MS-Windows when the input language
+has changed. This typically means that the keyboard keys will send to
+Emacs characters from a different language. The generated event has
+this form:
+
+@smallexample
+(language-change @var{frame} @var{codepage} @var{language-id})
+@end smallexample
+
+@noindent
+Here @var{frame} is the frame which was current when the input
+language changed; @var{codepage} is the new codepage number; and
+@var{language-id} is the numerical ID of the new input language. The
+coding-system (@pxref{Coding Systems}) that corresponds to
+@var{codepage} is @code{cp@var{codepage}} or
+@code{windows-@var{codepage}}. To convert @var{language-id} to a
+string (e.g., to use it for various language-dependent features, such
+as @code{set-language-environment}), use the
+@code{w32-get-locale-info} function, like this:
+
+@smallexample
+;; Get the abbreviated language name, such as "ENU" for English
+(w32-get-locale-info language-id)
+;; Get the full English name of the language,
+;; such as "English (United States)"
+(w32-get-locale-info language-id 4097)
+;; Get the full localized name of the language
+(w32-get-locale-info language-id t)
+@end smallexample
@end table
If one of these events arrives in the middle of a key sequence---that
individual events, which you can put in @code{unread-command-events}.
@end defun
-@ignore
-@defvar unread-command-char
-This variable holds a character to be read as command input.
-A value of -1 means ``empty''.
-
-This variable is mostly obsolete now that you can use
-@code{unread-command-events} instead; it exists only to support programs
-written for Emacs versions 18 and earlier.
-@end defvar
-@end ignore
-
@defun input-pending-p
@cindex waiting for command key input
This function determines whether any command input is currently
definition to find the actual event.
The events types @code{iconify-frame}, @code{make-frame-visible},
-@code{delete-frame}, @code{drag-n-drop}, and user signals like
-@code{sigusr1} are normally handled in this way. The keymap which
-defines how to handle special events---and which events are
-special---is in the variable @code{special-event-map} (@pxref{Active
-Keymaps}).
+@code{delete-frame}, @code{drag-n-drop}, @code{language-change}, and
+user signals like @code{sigusr1} are normally handled in this way.
+The keymap which defines how to handle special events---and which
+events are special---is in the variable @code{special-event-map}
+(@pxref{Active Keymaps}).
@node Waiting
@section Waiting for Elapsed Time or Input
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1994, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/compile
-@node Byte Compilation, Advising Functions, Loading, Top
+@node Byte Compilation
@chapter Byte Compilation
@cindex byte compilation
@cindex byte-code
results are representative, but actual results may vary.
@node Compilation Functions
-@comment node-name, next, previous, up
@section Byte-Compilation Functions
@cindex compilation functions
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/control
-@node Control Structures, Variables, Evaluation, Top
+@node Control Structures
@chapter Control Structures
@cindex special forms for control structures
@cindex control structures
@code{catch} in between).
Executing @code{throw} exits all Lisp constructs up to the matching
-@code{catch}, including function calls. When binding constructs such as
-@code{let} or function calls are exited in this way, the bindings are
-unbound, just as they are when these constructs exit normally
+@code{catch}, including function calls. When binding constructs such
+as @code{let} or function calls are exited in this way, the bindings
+are unbound, just as they are when these constructs exit normally
(@pxref{Local Variables}). Likewise, @code{throw} restores the buffer
and position saved by @code{save-excursion} (@pxref{Excursions}), and
-the narrowing status saved by @code{save-restriction} and the window
-selection saved by @code{save-window-excursion} (@pxref{Window
-Configurations}). It also runs any cleanups established with the
-@code{unwind-protect} special form when it exits that form
-(@pxref{Cleanups}).
+the narrowing status saved by @code{save-restriction}. It also runs
+any cleanups established with the @code{unwind-protect} special form
+when it exits that form (@pxref{Cleanups}).
The @code{throw} need not appear lexically within the @code{catch}
that it jumps to. It can equally well be called from another function
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1997-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/customize
-@node Customization, Loading, Macros, Top
+@node Customization
@chapter Customization Settings
@cindex customization item
- This chapter describes how to declare customizable variables and
-customization groups for classifying them. We use the term
-@dfn{customization item} to include customizable variables,
-customization groups, as well as faces.
-
- @xref{Defining Faces}, for the @code{defface} macro, which is used
-for declaring customizable faces.
+ Users of Emacs can customize variables and faces without writing
+Lisp code, by using the Customize interface. @xref{Easy
+Customization,,, emacs, The GNU Emacs Manual}. This chapter describes
+how to define @dfn{customization items} that users can interact with
+through the Customize interface.
+
+ Customization items include customizable variables, which are
+defined with the
+@ifinfo
+@code{defcustom} macro (@pxref{Variable Definitions});
+@end ifinfo
+@ifnotinfo
+@code{defcustom} macro;
+@end ifnotinfo
+customizable faces, which are defined with @code{defface} (described
+separately in @ref{Defining Faces}); and @dfn{customization groups},
+defined with
+@ifinfo
+@code{defgroup} (@pxref{Group Definitions}),
+@end ifinfo
+@ifnotinfo
+@code{defgroup},
+@end ifnotinfo
+which act as containers for groups of related customization items.
@menu
* Common Keywords:: Common keyword arguments for all kinds of
@cindex customization keywords
The customization declarations that we will describe in the next few
-sections (@code{defcustom}, @code{defgroup}, etc.) all accept keyword
-arguments for specifying various information. This section describes
-keywords that apply to all types of customization declarations.
+sections---@code{defcustom}, @code{defgroup}, etc.---all accept
+keyword arguments (@pxref{Constant Variables}) for specifying various
+information. This section describes keywords that apply to all types
+of customization declarations.
All of these keywords, except @code{:tag}, can be used more than once
in a given item. Each use of the keyword has an independent effect.
@cindex define customization group
@cindex customization groups, defining
- Each Emacs Lisp package should have one main customization group which
-contains all the options, faces and other groups in the package. If the
-package has a small number of options and faces, use just one group and
-put everything in it. When there are more than twelve or so options and
-faces, then you should structure them into subgroups, and put the
-subgroups under the package's main customization group. It is OK to
-put some of the options and faces in the package's main group alongside
-the subgroups.
+ Each Emacs Lisp package should have one main customization group
+which contains all the options, faces and other groups in the package.
+If the package has a small number of options and faces, use just one
+group and put everything in it. When there are more than twenty or so
+options and faces, then you should structure them into subgroups, and
+put the subgroups under the package's main customization group. It is
+OK to put some of the options and faces in the package's main group
+alongside the subgroups.
The package's main or only group should be a member of one or more of
the standard customization groups. (To display the full list of them,
@node Variable Definitions
@section Defining Customization Variables
@cindex define customization options
-@cindex customization variables, how to define
+@cindex customizable variables, how to define
+@cindex user options, how to define
+
+ @dfn{Customizable variables}, also called @dfn{user options}, are
+global Lisp variables whose values can be set through the Customize
+interface. Unlike other global variables, which are defined with
+@code{defvar} (@pxref{Defining Variables}), customizable variables are
+defined using the @code{defcustom} macro. In addition to calling
+@code{defvar} as a subroutine, @code{defcustom} states how the
+variable should be displayed in the Customize interface, the values it
+is allowed to take, etc.
@defmac defcustom option standard doc [keyword value]@dots{}
This macro declares @var{option} as a user option (i.e.@: a
standard value after Emacs starts up.
@end defmac
- @code{defcustom} accepts the following additional keywords:
+ In addition to the keywords listed in @ref{Common Keywords}, this
+macro accepts the following keywords:
@table @code
@item :type @var{type}
Use @var{type} as the data type for this option. It specifies which
-values are legitimate, and how to display the value.
-@xref{Customization Types}, for more information.
+values are legitimate, and how to display the value
+(@pxref{Customization Types}).
@item :options @var{value-list}
@kindex options@r{, @code{defcustom} keyword}
another customizable variable.
@end defun
-@defun user-variable-p arg
-This function is like @code{custom-variable-p}, except it also returns
-@code{t} if the first character of the variable's documentation string
-is the character @samp{*}. That is an obsolete way of indicating a
-user option, so for most purposes you may consider
-@code{user-variable-p} as equivalent to @code{custom-variable-p}.
-@end defun
-
@node Customization Types
@section Customization Types
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1994, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/debugging
-@node Debugging, Read and Print, Advising Functions, Top
+@node Debugging
@chapter Debugging Lisp Programs
There are several ways to find and investigate problems in an Emacs
program!) The most common suitable places are inside a @code{progn} or
an implicit @code{progn} (@pxref{Sequencing}).
+ If you don't know exactly where in the source code you want to put
+the debug statement, but you want to display a backtrace when a
+certain message is displayed, you can set @code{debug-on-message} to a
+regular expression matching the desired message.
+
@node Using Debugger
@subsection Using the Debugger
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/display
-@node Display, System Interface, Processes, Top
+@node Display
@chapter Emacs Display
This chapter describes a number of features related to the display
A @dfn{face} is a collection of graphical @dfn{attributes} for
displaying text: font, foreground color, background color, optional
-underlining, and so on. Faces control how Emacs displays text in
-buffers, as well as other parts of the frame such as the mode line.
-@xref{Standard Faces,,, emacs, The GNU Emacs Manual}, for the list of
-faces Emacs normally comes with.
-
-@cindex face id
- For most purposes, you refer to a face in Lisp programs using its
-@dfn{face name}, which is usually a Lisp symbol. For backward
-compatibility, a face name can also be a string, which is equivalent
-to a Lisp symbol of the same name.
+underlining, etc. Faces control how Emacs displays text in buffers,
+as well as other parts of the frame such as the mode line.
+
+@cindex anonymous face
+ One way to represent a face is as a property list of attributes,
+like @code{(:foreground "red" :weight bold)}. For example, you can
+assign such an @dfn{anonymous face} as the value of the @code{face}
+text property; this causes Emacs to display the underlying text with
+the specified attributes. @xref{Special Properties}.
+
+@cindex face name
+ More commonly, a face is referred to via a @dfn{face name}: a Lisp
+symbol which is associated with a set of face attributes. Named faces
+are defined using the @code{defface} macro (@pxref{Defining Faces}).
+Emacs defines several standard named faces; @xref{Standard Faces,,,
+emacs, The GNU Emacs Manual}.
+
+ Many parts of Emacs require named faces, and do not accept anonymous
+faces. These include the functions documented in @ref{Attribute
+Functions}, and the variable @code{font-lock-keywords}
+(@pxref{Search-based Fontification}). Unless otherwise stated, we
+will use the term @dfn{face} to refer only to named faces.
+
+ For backward compatibility, you can also use a string to specify a
+face name; that is equivalent to a Lisp symbol with the same name.
@defun facep object
-This function returns a non-@code{nil} value if @var{object} is a Lisp
-symbol or string that names a face. Otherwise, it returns @code{nil}.
+This function returns a non-@code{nil} value if @var{object} is a
+named face: a Lisp symbol or string which serves as a face name.
+Otherwise, it returns @code{nil}.
@end defun
By default, each face name corresponds to the same set of attributes
attributes in one frame (@pxref{Attribute Functions}).
@menu
-* Defining Faces:: How to define a face.
* Face Attributes:: What is in a face?
+* Defining Faces:: How to define a face.
* Attribute Functions:: Functions to examine and set face attributes.
* Displaying Faces:: How Emacs combines the faces specified for a character.
* Face Remapping:: Remapping faces to alternative definitions.
* Low-Level Font:: Lisp representation for character display fonts.
@end menu
-@node Defining Faces
-@subsection Defining Faces
-
- The @code{defface} macro defines a face and specifies its default
-appearance. The user can subsequently customize the face using the
-Customize interface (@pxref{Customization}).
-
-@defmac defface face spec doc [keyword value]@dots{}
-This macro declares @var{face} as a customizable face whose default
-attributes are given by @var{spec}. You should not quote the symbol
-@var{face}, and it should not end in @samp{-face} (that would be
-redundant). The argument @var{doc} is a documentation string for the
-face. The additional @var{keyword} arguments have the same meanings
-as in @code{defgroup} and @code{defcustom} (@pxref{Common Keywords}).
-
-When @code{defface} executes, it defines the face according to
-@var{spec}, then uses any customizations that were read from the
-init file (@pxref{Init File}) to override that specification.
-
-When you evaluate a @code{defface} form with @kbd{C-M-x} in Emacs
-Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun}
-overrides any customizations of the face. This way, the face reflects
-exactly what the @code{defface} says.
-
-@cindex face specification
-The @var{spec} argument is a @dfn{face specification}, which states
-how the face should appear on different kinds of terminals. It should
-be an alist whose elements each have the form @code{(@var{display}
-@var{atts})}. @var{display} specifies a class of terminals (see
-below), while @var{atts} is a property list of face attributes and
-their values, specifying the appearance of the face on matching
-terminals
-@iftex
-(see the next section for details about face attributes).
-@end iftex
-@ifnottex
-(@pxref{Face Attributes}, for details about face attributes).
-@end ifnottex
-
-The @var{display} part of an element of @var{spec} determines which
-frames the element matches. If more than one element of @var{spec}
-matches a given frame, the first element that matches is the one used
-for that frame. There are three possibilities for @var{display}:
-
-@table @asis
-@item @code{default}
-This element of @var{spec} doesn't match any frames; instead, it
-specifies defaults that apply to all frames. This kind of element, if
-used, must be the first element of @var{spec}. Each of the following
-elements can override any or all of these defaults.
-
-@item @code{t}
-This element of @var{spec} matches all frames. Therefore, any
-subsequent elements of @var{spec} are never used. Normally
-@code{t} is used in the last (or only) element of @var{spec}.
-
-@item a list
-If @var{display} is a list, each element should have the form
-@code{(@var{characteristic} @var{value}@dots{})}. Here
-@var{characteristic} specifies a way of classifying frames, and the
-@var{value}s are possible classifications which @var{display} should
-apply to. Here are the possible values of @var{characteristic}:
-
-@table @code
-@item type
-The kind of window system the frame uses---either @code{graphic} (any
-graphics-capable display), @code{x}, @code{pc} (for the MS-DOS console),
-@code{w32} (for MS Windows 9X/NT/2K/XP), or @code{tty}
-(a non-graphics-capable display).
-@xref{Window Systems, window-system}.
-
-@item class
-What kinds of colors the frame supports---either @code{color},
-@code{grayscale}, or @code{mono}.
-
-@item background
-The kind of background---either @code{light} or @code{dark}.
-
-@item min-colors
-An integer that represents the minimum number of colors the frame
-should support. This matches a frame if its
-@code{display-color-cells} value is at least the specified integer.
-
-@item supports
-Whether or not the frame can display the face attributes given in
-@var{value}@dots{} (@pxref{Face Attributes}). @xref{Display Face
-Attribute Testing}, for more information on exactly how this testing
-is done.
-@end table
-
-If an element of @var{display} specifies more than one @var{value} for a
-given @var{characteristic}, any of those values is acceptable. If
-@var{display} has more than one element, each element should specify a
-different @var{characteristic}; then @emph{each} characteristic of the
-frame must match one of the @var{value}s specified for it in
-@var{display}.
-@end table
-@end defmac
-
- Here's how the standard face @code{highlight} is defined:
-
-@example
-(defface highlight
- '((((class color) (min-colors 88) (background light))
- :background "darkseagreen2")
- (((class color) (min-colors 88) (background dark))
- :background "darkolivegreen")
- (((class color) (min-colors 16) (background light))
- :background "darkseagreen2")
- (((class color) (min-colors 16) (background dark))
- :background "darkolivegreen")
- (((class color) (min-colors 8))
- :background "green" :foreground "black")
- (t :inverse-video t))
- "Basic face for highlighting."
- :group 'basic-faces)
-@end example
-
- Internally, Emacs stores the face's default specification in its
-@code{face-defface-spec} symbol property (@pxref{Property Lists}).
-The @code{saved-face} property stores the face specification saved by
-the user, using the customization buffer; the @code{customized-face}
-property stores the face specification customized for the current
-session, but not saved; and the @code{theme-face} property stores an
-alist associating the active customization settings and Custom themes
-with their specifications for that face. The face's documentation
-string is stored in the @code{face-documentation} property. But
-normally you should not try to set any of these properties directly.
-@xref{Applying Customizations}, for the @code{custom-set-faces}
-function, which is used to apply customized face settings.
-
- People are sometimes tempted to create variables whose values
-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
- The effect of using a face is determined by a fixed set of @dfn{face
-attributes}. This table lists all the face attributes, their possible
-values, and their effects. You can specify more than one face for a
-given piece of text; Emacs merges the attributes of all the faces to
-determine how to display the text. @xref{Displaying Faces}.
+ @dfn{Face attributes} determine the visual appearance of a face.
+The following table lists all the face attributes, their possible
+values, and their effects.
- In addition to the values given below, each face attribute can also
-have the value @code{unspecified}. This special value means the face
-doesn't specify that attribute. In face merging, when the first face
-fails to specify a particular attribute, the next face gets a chance.
-However, the @code{default} face must specify all attributes.
+ Apart from the values given below, each face attribute can have the
+value @code{unspecified}. This special value means that the face
+doesn't specify that attribute directly. An @code{unspecified}
+attribute tells Emacs to refer instead to a parent face (see the
+description @code{:inherit} attribute below); or, failing that, to an
+underlying face (@pxref{Displaying Faces}). The @code{default} face
+must specify all attributes.
Some of these attributes are meaningful only on certain kinds of
displays. If your display cannot handle a certain attribute, the
@table @code
@item :family
Font family or fontset (a string). @xref{Fonts,,, emacs, The GNU
-Emacs Manual}. If you specify a font family name, the wild-card
-characters @samp{*} and @samp{?} are allowed. The function
-@code{font-family-list}, described below, returns a list of available
-family names. @xref{Fontsets}, for information about fontsets.
+Emacs Manual}, for more information about font families. The function
+@code{font-family-list} (see below) returns a list of available family
+names. @xref{Fontsets}, for information about fontsets.
@item :foundry
The name of the @dfn{font foundry} for the font family specified by
-the @code{:family} attribute (a string). The wild-card characters
-@samp{*} and @samp{?} are allowed. @xref{Fonts,,, emacs, The GNU
-Emacs Manual}.
+the @code{:family} attribute (a string). @xref{Fonts,,, emacs, The
+GNU Emacs Manual}.
@item :width
Relative character width. This should be one of the symbols
units of 1/10 point.
The value can also be a floating point number or a function, which
-specifies the height relative to an @dfn{underlying face} (i.e., a
-face that has a lower priority in the list described in
-@ref{Displaying Faces}). If the value is a floating point number,
+specifies the height relative to an @dfn{underlying face}
+(@pxref{Displaying Faces}). If the value is a floating point number,
that specifies the amount by which to scale the height of the
underlying face. If the value is a function, that function is called
with one argument, the height of the underlying face, and returns the
as extra bright, and any weight less than normal is displayed as
half-bright.
+@cindex italic text
@item :slant
Font slant---one of the symbols @code{italic}, @code{oblique},
@code{normal}, @code{reverse-italic}, or @code{reverse-oblique}. On
Background color, a string. The value can be a system-defined color
name, or a hexadecimal color specification. @xref{Color Names}.
+@cindex underlined text
@item :underline
-Whether or not characters should be underlined, and in what color. If
-the value is @code{t}, underlining uses the foreground color of the
-face. If the value is a string, underlining uses that color. The
-value @code{nil} means do not underline.
+Whether or not characters should be underlined, and in what
+way. The possible values of the @code{:underline} attribute are:
+
+@table @asis
+@item @code{nil}
+Don't underline.
+
+@item @code{t}
+Underline with the foreground color of the face.
+@item @var{color}
+Underline in color @var{color}; which should be either a string
+specifying a color, or the symbol @code{foreground-color}, meaning the
+foreground color of the face.
+
+@item @code{(:color @var{color} :style @var{style})}
+@var{color} is as described above. Omitting the attribute
+@code{:color} means to use the foreground color of the face.
+@var{style} should be a symbol @code{line} or @code{wave}, meaning to
+use a straight or wavy line. Omitting the attribute @code{:style}
+means to use a straight line.
+@end table
+
+@cindex overlined text
@item :overline
Whether or not characters should be overlined, and in what color.
-The value is used like that of @code{:underline}.
+If the value is @code{t}, overlining uses the foreground color of the
+face. If the value is a string, overlining uses that color. The
+value @code{nil} means do not overline.
+@cindex strike-through text
@item :strike-through
Whether or not characters should be strike-through, and in what
-color. The value is used like that of @code{:underline}.
+color. The value is used like that of @code{:overline}.
@item :box
Whether or not a box should be drawn around characters, its color, the
faces.
@end table
-For compatibility with Emacs 20, you can also specify values for two
-``fake'' face attributes: @code{:bold} and @code{:italic}. Their
-values must be either @code{t} or @code{nil}; a value of
-@code{unspecified} is not allowed. Setting @code{:bold} to @code{t}
-is equivalent to setting the @code{:weight} attribute to @code{bold},
-and setting it to @code{nil} is equivalent to setting @code{:weight}
-to @code{normal}. Setting @code{:italic} to @code{t} is equivalent to
-setting the @code{:slant} attribute to @code{italic}, and setting it
-to @code{nil} is equivalent to setting @code{:slant} to @code{normal}.
-
@defun font-family-list &optional frame
This function returns a list of available font family names. The
optional argument @var{frame} specifies the frame on which the text is
@code{nil} otherwise.
@end defun
+@node Defining Faces
+@subsection Defining Faces
+
+ The usual way to define a face is through the @code{defface} macro.
+This macro defines a face name, and associates that name with a set of
+face attributes. It also sets up the face so that the user can
+customize it via the Customize interface (@pxref{Customization}).
+
+@defmac defface face spec doc [keyword value]@dots{}
+This macro declares @var{face} as a customizable face whose default
+attributes are given by @var{spec}. You should not quote the symbol
+@var{face}, and it should not end in @samp{-face} (that would be
+redundant). The argument @var{doc} is a documentation string for the
+face. The additional @var{keyword} arguments have the same meanings
+as in @code{defgroup} and @code{defcustom} (@pxref{Common Keywords}).
+
+When @code{defface} executes, it defines the face according to
+@var{spec}, then uses any customizations that were read from the
+init file (@pxref{Init File}) to override that specification.
+
+When you evaluate a @code{defface} form with @kbd{C-M-x} in Emacs
+Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun}
+overrides any customizations of the face. This way, the face reflects
+exactly what the @code{defface} says.
+
+@cindex face specification
+The @var{spec} argument is a @dfn{face specification}, which states
+how the face should appear on different kinds of terminals. It should
+be an alist whose elements each have the form
+
+@example
+(@var{display} . @var{plist})
+@end example
+
+@noindent
+@var{display} specifies a class of terminals (see below). @var{plist}
+is a property list of face attributes and their values, specifying how
+the face appears on such terminals. For backward compatibility, you
+can also write an element as @code{(@var{display} @var{plist})}.
+
+The @var{display} part of an element of @var{spec} determines which
+terminals the element matches. If more than one element of @var{spec}
+matches a given terminal, the first element that matches is the one
+used for that terminal. There are three possibilities for
+@var{display}:
+
+@table @asis
+@item @code{default}
+This element of @var{spec} doesn't match any terminal; instead, it
+specifies defaults that apply to all terminals. This element, if
+used, must be the first element of @var{spec}. Each of the following
+elements can override any or all of these defaults.
+
+@item @code{t}
+This element of @var{spec} matches all terminals. Therefore, any
+subsequent elements of @var{spec} are never used. Normally @code{t}
+is used in the last (or only) element of @var{spec}.
+
+@item a list
+If @var{display} is a list, each element should have the form
+@code{(@var{characteristic} @var{value}@dots{})}. Here
+@var{characteristic} specifies a way of classifying terminals, and the
+@var{value}s are possible classifications which @var{display} should
+apply to. Here are the possible values of @var{characteristic}:
+
+@table @code
+@item type
+The kind of window system the terminal uses---either @code{graphic}
+(any graphics-capable display), @code{x}, @code{pc} (for the MS-DOS
+console), @code{w32} (for MS Windows 9X/NT/2K/XP), or @code{tty} (a
+non-graphics-capable display). @xref{Window Systems, window-system}.
+
+@item class
+What kinds of colors the terminal supports---either @code{color},
+@code{grayscale}, or @code{mono}.
+
+@item background
+The kind of background---either @code{light} or @code{dark}.
+
+@item min-colors
+An integer that represents the minimum number of colors the terminal
+should support. This matches a terminal if its
+@code{display-color-cells} value is at least the specified integer.
+
+@item supports
+Whether or not the terminal can display the face attributes given in
+@var{value}@dots{} (@pxref{Face Attributes}). @xref{Display Face
+Attribute Testing}, for more information on exactly how this testing
+is done.
+@end table
+
+If an element of @var{display} specifies more than one @var{value} for
+a given @var{characteristic}, any of those values is acceptable. If
+@var{display} has more than one element, each element should specify a
+different @var{characteristic}; then @emph{each} characteristic of the
+terminal must match one of the @var{value}s specified for it in
+@var{display}.
+@end table
+@end defmac
+
+ Here's how the standard face @code{highlight} is defined:
+
+@example
+(defface highlight
+ '((((class color) (min-colors 88) (background light))
+ :background "darkseagreen2")
+ (((class color) (min-colors 88) (background dark))
+ :background "darkolivegreen")
+ (((class color) (min-colors 16) (background light))
+ :background "darkseagreen2")
+ (((class color) (min-colors 16) (background dark))
+ :background "darkolivegreen")
+ (((class color) (min-colors 8))
+ :background "green" :foreground "black")
+ (t :inverse-video t))
+ "Basic face for highlighting."
+ :group 'basic-faces)
+@end example
+
+ Internally, Emacs stores the face's default specification in its
+@code{face-defface-spec} symbol property (@pxref{Property Lists}).
+The @code{saved-face} property stores the face specification saved by
+the user, using the customization buffer; the @code{customized-face}
+property stores the face specification customized for the current
+session, but not saved; and the @code{theme-face} property stores an
+alist associating the active customization settings and Custom themes
+with their specifications for that face. The face's documentation
+string is stored in the @code{face-documentation} property. But
+normally you should not try to set any of these properties directly.
+@xref{Applying Customizations}, for the @code{custom-set-faces}
+function, which is used to apply customized face settings.
+
+ People are sometimes tempted to create variables whose values
+specify a face to use. In the vast majority of cases, this is not
+necessary; it is preferable to simply use faces directly.
+
@node Attribute Functions
@subsection Face Attribute Functions
This section describes the functions for accessing and modifying the
-attributes of an existing face.
+attributes of an existing named face.
@defun set-face-attribute face frame &rest arguments
This function sets one or more attributes of @var{face} for
@node Displaying Faces
@subsection Displaying Faces
- Here is how Emacs determines the face to use for displaying any
-given piece of text:
+ When Emacs displays a given piece of text, the visual appearance of
+the text may be determined by faces drawn from different sources. If
+these various sources together specify more than one face for a
+particular character, Emacs merges the attributes of the various
+faces. Here is the order in which Emacs merges the faces, from
+highest to lowest priority:
@itemize @bullet
@item
@item
If the text lies within an overlay with a non-@code{nil} @code{face}
-property, Emacs applies the face or face attributes specified by that
-property. If the overlay has a @code{mouse-face} property and the
-mouse is ``near enough'' to the overlay, Emacs applies the face or
-face attributes specified by the @code{mouse-face} property instead.
-@xref{Overlay Properties}.
+property, Emacs applies the face(s) specified by that property. If
+the overlay has a @code{mouse-face} property and the mouse is ``near
+enough'' to the overlay, Emacs applies the face or face attributes
+specified by the @code{mouse-face} property instead. @xref{Overlay
+Properties}.
When multiple overlays cover one character, an overlay with higher
priority overrides those with lower priority. @xref{Overlays}.
steps, Emacs applies the attribute of the @code{default} face.
@end itemize
- If these various sources together specify more than one face for a
-particular character, Emacs merges the attributes of the various faces
-specified. For each attribute, Emacs tries using the above order
-(i.e.@: first the face of any special glyph; then the face for region
-highlighting, if appropriate; and so on).
+ At each stage, if a face has a valid @code{:inherit} attribute,
+Emacs treats any attribute with an @code{unspecified} value as having
+the corresponding value drawn from the parent face(s). @pxref{Face
+Attributes}. Note that the parent face(s) may also leave the
+attribute unspecified; in that case, the attribute remains unspecified
+at the next level of face merging.
@node Face Remapping
@subsection Face Remapping
The value of this variable is an alist whose elements have the form
@code{(@var{face} . @var{remapping})}. This causes Emacs to display
any text having the face @var{face} with @var{remapping}, rather than
-the ordinary definition of @var{face}. @var{remapping} may be any
-face specification suitable for a @code{face} text property: either a
-face name, or a property list of attribute/value pairs, or a list in
-which each element is either a face name or a property list
-(@pxref{Special Properties}).
+the ordinary definition of @var{face}.
+
+@var{remapping} may be any face specification suitable for a
+@code{face} text property: either a face (i.e.@: a face name or a
+property list of attribute/value pairs), or a list of faces. For
+details, see the description of the @code{face} text property in
+@ref{Special Properties}. @var{remapping} serves as the complete
+specification for the remapped face---it replaces the normal
+definition of @var{face}, instead of modifying it.
If @code{face-remapping-alist} is buffer-local, its local value takes
effect only within that buffer.
-Two points bear emphasizing:
-
-@enumerate
-@item
-@var{remapping} serves as the complete specification for the remapped
-face---it replaces the normal definition of @var{face}, instead of
-modifying it.
-
-@item
-If @var{remapping} references the same face name @var{face}, either
-directly or via the @code{:inherit} attribute of some other face in
-@var{remapping}, that reference uses the normal definition of
-@var{face}. In other words, the remapping cannot be recursive.
+Note: face remapping is non-recursive. If @var{remapping} references
+the same face name @var{face}, either directly or via the
+@code{:inherit} attribute of some other face in @var{remapping}, that
+reference uses the normal definition of @var{face}. For instance, if
+the @code{mode-line} face is remapped using this entry in
+@code{face-remapping-alist}:
-For instance, if the @code{mode-line} face is remapped using this
-entry in @code{face-remapping-alist}:
@example
(mode-line italic mode-line)
@end example
+
@noindent
then the new definition of the @code{mode-line} face inherits from the
@code{italic} face, and the @emph{normal} (non-remapped) definition of
@code{mode-line} face.
-@end enumerate
@end defvar
The following functions implement a higher-level interface to
encoding of the font.
@end defun
-@defvar font-list-limit
+@defopt font-list-limit
This variable specifies maximum number of fonts to consider in font
-matching. The function @code{x-family-fonts} will not return more than
-that many fonts, and font selection will consider only that many fonts
-when searching a matching font for face attributes. The default is
-currently 100.
-@end defvar
+matching. The function @code{x-family-fonts} will not return more
+than that many fonts, and font selection will consider only that many
+fonts when searching a matching font for face attributes. The default
+is 100.
+@end defopt
@node Fontsets
@subsection Fontsets
@itemx @code{vertical-bar}, @code{horizontal-bar}
Used for different types of fringe cursors.
-@item @code{empty-line}, @code{question-mark}
+@item @code{empty-line}, @code{question-mark}, @code{exclamation-mark}
Unused.
@end table
image descriptor properties:
@table @code
+@item :background @var{background}
+@var{background}, if non-@code{nil}, should be a string specifying a
+color, which is used as the image's background color if the image
+supports transparency. If the value is @code{nil}, it defaults to the
+frame's background color.
+
@item :width, :height
The @code{:width} and @code{:height} keywords are used for scaling the
image. If only one of them is specified, the other one will be
@c -*-texinfo-*-
@c The GNU Free Documentation License.
-@node GNU Free Documentation License, GPL, Antinews, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@center Version 1.3, 3 November 2008
@c , Bugs and Todo List, Top, Top
-@node Edebug, Syntax Errors, Debugger, Debugging
+@node Edebug
@section Edebug
@cindex Edebug debugging facility
@node Instrumenting
@subsection Instrumenting for Edebug
+@cindex instrumenting for Edebug
In order to use Edebug to debug Lisp code, you must first
@dfn{instrument} the code. Instrumenting code inserts additional code
edebug-all-forms} toggles this option.
@findex edebug-eval-top-level-form
+@findex edebug-defun
Another command, @kbd{M-x edebug-eval-top-level-form}, is available to
instrument any top-level form regardless of the values of
@code{edebug-all-defs} and @code{edebug-all-forms}.
+@code{edebug-defun} is an alias for @code{edebug-eval-top-level-form}.
While Edebug is active, the command @kbd{I}
(@code{edebug-instrument-callee}) instruments the definition of the
+++ /dev/null
-\input texinfo @c -*-texinfo-*-
-@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2001-2012 Free Software Foundation, Inc.
-@c See the file elisp.texi for copying conditions.
-@c
-@comment %**start of header
-@setfilename covers.info
-@settitle GNU Emacs Lisp Reference Manual
-@comment %**end of header
-
-@titlepage
-@c ================ Volume 1 ================
-@w{ }
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@page
-@c ================ Volume 2 ================
-@w{ }
-@sp 5
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 2}
-@sp 2
-@center by Bil Lewis,
-@center Dan LaLiberte, and
-@center the GNU Manual Group
-
-@page
-@c ================ Volume 1 with baseline skip 16pt ================
-
-@tex
-\global\baselineskip = 16pt
-@end tex
-
-16 pts baseline skip:
-
-@w{ }
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@page
-@c ================ Volume 1 with baseline skip 18pt ================
-
-@tex
-\global\baselineskip = 18pt
-@end tex
-
-18 pts baseline skip, with 15pts between sections
-
-@w{ }
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@tex
-\global\baselineskip = 15pt
-@end tex
-
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis,
-@center Dan LaLiberte, and
-@center the GNU Manual Group
-
-@page
-@c ================ Volume 1 with more baseline skip 24 pts ================
-
-@tex
-\global\baselineskip = 24pt
-@end tex
-
-24 pts baseline skip:
-
-@w{ }
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@page
-@c ================ Volume 2 with more baseline skip 18 pts ================
-
-@tex
-\global\baselineskip = 18pt
-@end tex
-
-18 pts baseline skip:
-
-@w{ }
-@sp 5
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 2}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@page
-@c ================ Volume 2 with more baseline skip 24 pts ================
-
-@tex
-\global\baselineskip = 24pt
-@end tex
-
-24 pts baseline skip:
-
-@w{ }
-@sp 5
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 2
-@center @titlefont{Volume 2}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-
-@page
-@c ================ Spine 1 ================
-
-@w{@titlefont{The GNU Emacs Lisp Reference Manual --- Vol. 1}}
-@sp 4
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 4
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@sp 4
-@author The GNU Emacs Lisp Reference Manual --- Vol. 1
-@sp 3
-@author FSF
-
-@author
-
-@page
-@c ================ Spine 2 ================
-
-@w{@titlefont{The GNU Emacs Lisp Reference Manual --- Vol. 2}}
-@sp 4
-@center GNU Emacs Version 19
-@center for Unix Users
-@center Edition 2.3, June 1994
-@sp 4
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-
-@sp 4
-@author The GNU Emacs Lisp Reference Manual --- Vol. 2
-@sp 3
-@author FSF
-
-@end titlepage
-@bye
\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename elisp
+
+@ifset VOL1
+@set volflag
+@set voltitle Volume 1
+@end ifset
+
+@ifset VOL2
+@set volflag
+@set voltitle Volume 2
+@end ifset
+
+@ifset volflag
+@settitle GNU Emacs Lisp Reference Manual: @value{voltitle}
+@end ifset
+@ifclear volflag
@settitle GNU Emacs Lisp Reference Manual
+@end ifclear
+
@c %**end of header
+@c See two-volume-cross-refs.txt.
+@tex
+@ifset VOL1
+\message{Formatting for two volume edition...Volume 1...}
+%
+% Read special toc file, set up in two-volume.make.
+\gdef\tocreadfilename{elisp1-toc-ready.toc}
+%
+% Don't make outlines, they're not needed and \readdatafile can't pay
+% attention to the special definition above.
+\global\let\pdfmakeoutlines=\relax
+%
+% Start volume 1 chapter numbering at 1; this must be listed as chapno0.
+\global\chapno=0
+@end ifset
+@ifset VOL2
+\message{Formatting for two volume edition...Volume 2...}
+%
+% Read special toc file, set up in two-volume.make.
+\gdef\tocreadfilename{elisp2-toc-ready.toc}
+%
+% Don't make outlines, they're not needed and \readdatafile can't pay
+% attention to the special definition above.
+\global\let\pdfmakeoutlines=\relax
+%
+% Start volume 2 chapter numbering at 27; this must be listed as chapno26
+\global\chapno=26
+@end ifset
+@end tex
+
+
@c Version of the manual and of Emacs.
-@c Please remember to update these in vol1.texi and vol2.texi as well.
@c (See comments for EDITION in emacs.texi)
@set VERSION 3.1
@include emacsver.texi
@c onto the distribution in the full, 8.5 x 11" size.
@c @set smallbook
+@ifset volflag
+@smallbook
+@end ifset
+
@ifset smallbook
@smallbook
@end ifset
@titlepage
@title GNU Emacs Lisp Reference Manual
+@ifset volflag
+@subtitle @value{voltitle}
+@end ifset
@subtitle For Emacs Version @value{EMACSVER}
@subtitle Revision @value{VERSION}, @value{DATE}
@ifnottex
-@node Top, Introduction, (dir), (dir)
+@node Top
@top Emacs Lisp
@insertcopying
@end ifnottex
-@c Copy any updates to vol1.texi and vol2.texi.
@menu
* Introduction:: Introduction and conventions used.
@c be correctly identified by `texinfo-multiple-files-update'. In
@c particular, the detailed menu header line MUST be identical to the
@c value of `texinfo-master-menu-header'. See texnfo-upd.el.
-@c Copy any updates to vol1.texi and vol2.texi.
@detailmenu
--- The Detailed Node Listing ---
* Lisp History:: Emacs Lisp is descended from Maclisp.
* Conventions:: How the manual is formatted.
* Version Info:: Which Emacs version is running?
-* Acknowledgements:: The authors, editors, and sponsors of this manual.
+* Acknowledgments:: The authors, editors, and sponsors of this manual.
Conventions
* Case Changes:: Case conversion of parts of the buffer.
* Text Properties:: Assigning Lisp property lists to text characters.
* Substitution:: Replacing a given character wherever it appears.
-* Transposition:: Swapping two portions of a buffer.
* Registers:: How registers are implemented. Accessing
the text or position stored in a register.
+* Transposition:: Swapping two portions of a buffer.
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
* Parsing HTML/XML:: Parsing HTML and XML.
* 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.
Faces
-* Defining Faces:: How to define a face.
* Face Attributes:: What is in a face?
+* Defining Faces:: How to define a face.
* Attribute Functions:: Functions to examine and set face attributes.
* Displaying Faces:: How Emacs combines the faces specified for
a character.
@end detailmenu
@end menu
+@ifclear VOL2
@include intro.texi
@include objects.texi
@include numbers.texi
@include files.texi
@include backups.texi
+
+@end ifclear
+
+@c ================ Beginning of Volume 2 ================
+@ifclear VOL1
+
@include buffers.texi
@include windows.texi
@include frames.texi
@include index.texi
+@end ifclear
+
@ignore
-@node New Symbols, , Index, Top
+@node New Symbols
@unnumbered New Symbols Since the Previous Edition
@printindex tp
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1993, 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/errors
-@node Standard Errors, Standard Keymaps, GNU Emacs Internals, Top
+@node Standard Errors
@appendix Standard Errors
@cindex standard errors
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1994, 1998, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/eval
-@node Evaluation, Control Structures, Symbols, Top
+@node Evaluation
@chapter Evaluation
@cindex evaluation
@cindex interpreter
@cindex form
@cindex expression
@cindex S-expression
+@cindex sexp
A Lisp object that is intended for evaluation is called a @dfn{form}
or @dfn{expression}@footnote{It is sometimes also referred to as an
@dfn{S-expression} or @dfn{sexp}, but we generally do not use this
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/files
-@node Files, Backups and Auto-Saving, Documentation, Top
-@comment node-name, next, previous, up
+@node Files
@chapter Files
This chapter describes the Emacs Lisp functions and variables to
@end defvar
@node Subroutines of Visiting
-@comment node-name, next, previous, up
@subsection Subroutines of Visiting
The @code{find-file-noselect} function uses two important subroutines
Name}).
@node Reading from Files
-@comment node-name, next, previous, up
@section Reading from Files
@cindex reading from files
@ref{Magic File Names}.
@node Writing to Files
-@comment node-name, next, previous, up
@section Writing to Files
@cindex writing to files
File locking is not supported on some systems. On systems that do not
support it, the functions @code{lock-buffer}, @code{unlock-buffer} and
-@code{file-locked-p} do nothing and return @code{nil}.
+@code{file-locked-p} do nothing and return @code{nil}. It is also
+possible to disable locking, by setting the variable @code{create-lockfiles}.
+
+@defopt create-lockfiles
+If this variable is @code{nil}, Emacs does not lock files.
+@end defopt
@defun ask-user-about-lock file other-user
This function is called when the user tries to modify @var{file}, but it
@end menu
@node Testing Accessibility
-@comment node-name, next, previous, up
@subsection Testing Accessibility
@cindex accessibility of a file
@cindex file accessibility
@end defun
@node Kinds of Files
-@comment node-name, next, previous, up
@subsection Distinguishing Kinds of Files
This section describes how to distinguish various kinds of files, such
@xref{Buffer File Name}, for related information.
@node File Attributes
-@comment node-name, next, previous, up
@subsection Other Information about Files
This section describes the functions for getting detailed
not an extension.
@end defun
+@defun file-name-base &optional filename
+This function is the composition of @code{file-name-sans-extension}
+and @code{file-name-nondirectory}. For example,
+
+@example
+(file-name-base "/my/home/foo.c")
+ @result{} "foo"
+@end example
+
+The @var{filename} argument defaults to @code{buffer-file-name}.
+@end defun
@node Relative File Names
@subsection Absolute and Relative File Names
@end defun
@node Directory Names
-@comment node-name, next, previous, up
@subsection Directory Names
@cindex directory name
@cindex file name of directory
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/frames
-@node Frames, Positions, Windows, Top
+@node Frames
@chapter Frames
@cindex frame
(@var{title} @var{item1} @var{item2}...)
@end example
-Each item should normally be a cons cell @code{(@var{line} . @var{value})},
-where @var{line} is a string, and @var{value} is the value to return if
-that @var{line} is chosen. An item can also be a string; this makes a
-non-selectable line in the menu.
+Each @var{item} should be a cons cell, @code{(@var{line} . @var{value})},
+where @var{line} is a string and @var{value} is the value to return if
+that @var{line} is chosen. Unlike in a menu keymap, a @code{nil}
+@var{value} does not make the menu item non-selectable.
+Alternatively, each @var{item} can be a string rather than a cons
+cell; this makes a non-selectable menu item.
If the user gets rid of the menu without making a valid choice, for
instance by clicking the mouse away from a valid choice or by typing
+++ /dev/null
-\input texinfo @c -*-texinfo-*-
-@comment %**start of header
-@setfilename front1.info
-@settitle GNU Emacs Lisp Reference Manual
-@smallbook
-@comment %**end of header
-
-@titlepage
-.
-@sp 2
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19.29
-@center for Unix Users
-@center Edition 2.4, June 1995
-@sp 2
-@center @titlefont{Volume 1}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-@page
-.
-@sp 5
-@center @titlefont{The}
-@sp 1
-@center @titlefont{GNU}
-@sp 1
-@center @titlefont{Emacs Lisp}
-@sp 1
-@center @titlefont{Reference}
-@sp 1
-@center @titlefont{Manual}
-@sp 2
-@center GNU Emacs Version 19.29
-@center for Unix Users
-@center Edition 2.4, June 1995
-@sp 2
-@center @titlefont{Volume 2}
-@sp 2
-@center by Bil Lewis, Dan LaLiberte,
-@center and the GNU Manual Group
-
-@end titlepage
-@bye
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/functions
-@node Functions, Macros, Variables, Top
+@node Functions
@chapter Functions
A Lisp program is composed mainly of Lisp functions. This chapter
@end example
@code{defun} stores this lambda expression in the function cell of
-@var{name}. It returns the value @var{name}, but usually we ignore this
-value.
+@var{name}. Its return value is @emph{undefined}.
As described previously, @var{argument-list} is a list of argument
names and may include the keywords @code{&optional} and @code{&rest}.
@example
@group
(defun foo () 5)
- @result{} foo
-@end group
-@group
(foo)
@result{} 5
@end group
@group
(defun bar (a &optional b &rest c)
(list a b c))
- @result{} bar
-@end group
-@group
(bar 1 2 3 4 5)
@result{} (1 2 (3 4 5))
@end group
(forward-word 1)
(backward-char 1)
(capitalize-word 1))
- @result{} capitalize-backwards
@end group
@end example
@anchor{Definition of defalias}
This special form defines the symbol @var{name} as a function, with
definition @var{definition} (which can be any valid Lisp function).
-It returns @var{definition}.
+Its return value is @emph{undefined}.
If @var{docstring} is non-@code{nil}, it becomes the function
documentation of @var{name}. Otherwise, any documentation provided by
@example
@group
(defun bar (n) (+ n 2))
- @result{} bar
-@end group
-@group
(symbol-function 'bar)
@result{} (lambda (n) (+ n 2))
@end group
@example
@group
(defun foo (x) x)
- @result{} foo
-@end group
-@group
(foo 1)
@result{}1
@end group
(@pxref{Anonymous Functions}), is automatically converted into a
@dfn{closure}.
-@cindex closures
+@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
@c -*-texinfo-*-
-@setfilename ../../info/gpl
-@node GPL, Tips, GNU Free Documentation License, Top
-@comment node-name, next, previous, up
+@node GPL
@appendix GNU General Public License
@c The GNU General Public License.
@center Version 3, 29 June 2007
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
+@c Copyright (C) 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/hash
-@node Hash Tables, Symbols, Sequences Arrays Vectors, Top
+@node Hash Tables
@chapter Hash Tables
@cindex hash tables
@cindex lookup tables
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/help
-@node Documentation, Files, Modes, Top
+@node Documentation
@chapter Documentation
@cindex documentation strings
@end menu
@node Documentation Basics
-@comment node-name, next, previous, up
@section Documentation Basics
@cindex documentation conventions
@cindex writing a documentation string
@group
(princ
(format "%s\t%s\n%s\n\n" s
- (if (user-variable-p s)
+ (if (custom-variable-p s)
"Option " "Variable")
@end group
@group
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1993, 1998, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/hooks
-@node Standard Hooks, Index, Standard Keymaps, Top
+@node Standard Hooks
@appendix Standard Hooks
@cindex standard hooks
@cindex hook variables, list of
completion-at-point-functions
completion-in-region-functions
completion-list-insert-choice-function
+deactivate-current-input-method-function
describe-current-input-method-function
filter-buffer-substring-functions
font-lock-function
-inactivate-current-input-method-function
menu-bar-select-buffer-function
read-file-name-function
replace-re-search-function
@c -*-texinfo-*-
-@setfilename ../../info/index
@c Indexing guidelines
@c pindex is used for .el files and Unix programs
-@node Index, , Standard Hooks, Top
+@node Index
@unnumbered Index
@c Print the indices
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1993, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/internals
-@node GNU Emacs Internals, Standard Errors, Tips, Top
-@comment node-name, next, previous, up
+@node GNU Emacs Internals
@appendix GNU Emacs Internals
This chapter describes how the runnable Emacs executable is dumped with
(such as by loading a library), that data is placed in normal storage.
If normal storage runs low, then Emacs asks the operating system to
allocate more memory. Different types of Lisp objects, such as
-symbols, cons cells, markers, etc., are segregated in distinct blocks
-in memory. (Vectors, long strings, buffers and certain other editing
-types, which are fairly large, are allocated in individual blocks, one
-per object, while small strings are packed into blocks of 8k bytes.)
+symbols, cons cells, small vectors, markers, etc., are segregated in
+distinct blocks in memory. (Large vectors, long strings, buffers and
+certain other editing types, which are fairly large, are allocated in
+individual blocks, one per object; small strings are packed into blocks
+of 8k bytes, and small vectors are packed into blocks of 4k bytes).
+
+@cindex vector-like objects, storage
+@cindex storage of vector-like Lisp objects
+ Beyond the basic vector, a lot of objects like window, buffer, and
+frame are managed as if they were vectors. The corresponding C data
+structures include the @code{struct vectorlike_header} field whose
+@code{next} field points to the next object in the chain:
+@code{header.next.buffer} points to the next buffer (which could be
+a killed buffer), and @code{header.next.vector} points to the next
+vector in a free list. If a vector is small (smaller than or equal to
+@code{VBLOCK_BYTES_MAX} bytes, see @file{alloc.c}), then
+@code{header.next.nbytes} contains the vector size in bytes.
@cindex garbage collection
It is quite common to use some storage for a while, then release it
The sweep phase puts unused cons cells onto a @dfn{free list}
for future allocation; likewise for symbols and markers. It compacts
the accessible strings so they occupy fewer 8k blocks; then it frees the
-other 8k blocks. Vectors, buffers, windows, and other large objects are
-individually allocated and freed using @code{malloc} and @code{free}.
+other 8k blocks. Unreachable vectors from vector blocks are coalesced
+to create largest possible free areas; if a free area spans a complete
+4k block, that block is freed. Otherwise, the free area is recorded
+in a free list array, where each entry corresponds to a free list
+of areas of the same size. Large vectors, buffers, and other large
+objects are allocated and freed individually.
@cindex CL note---allocate more storage
@quotation
message in the process buffer.
@item pty_flag
-Non-@code{nil} if communication with the subprocess uses a @acronym{PTY};
+Non-@code{nil} if communication with the subprocess uses a pty;
@code{nil} if it uses a pipe.
@item infd
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1994, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/intro
-@node Introduction, Lisp Data Types, Top, Top
-@comment node-name, next, previous, up
+@node Introduction
@chapter Introduction
Most of the GNU Emacs text editor is written in the programming
* Lisp History:: Emacs Lisp is descended from Maclisp.
* Conventions:: How the manual is formatted.
* Version Info:: Which Emacs version is running?
-* Acknowledgements:: The authors, editors, and sponsors of this manual.
+* Acknowledgments:: The authors, editors, and sponsors of this manual.
@end menu
@node Caveats
@result{} c
@end example
- Sometimes to help describe one form we show another form that
+ To help describe one form, we sometimes show another form that
produces identical results. The exact equivalence of two forms is
indicated with @samp{@equiv{}}.
The keyword @code{&rest} (which must be followed by a single
argument name) indicates that any number of arguments can follow. The
-single argument name following @code{&rest} will receive, as its
+single argument name following @code{&rest} receives, as its
value, a list of all the remaining arguments passed to the function.
Do not write @code{&rest} when you call the function.
@end example
@end defun
- Any argument whose name contains the name of a type (e.g.,
-@var{integer}, @var{integer1} or @var{buffer}) is expected to be of that
-type. A plural of a type (such as @var{buffers}) often means a list of
-objects of that type. Arguments named @var{object} may be of any type.
-(@xref{Lisp Data Types}, for a list of Emacs object types.) Arguments
-with other sorts of names (e.g., @var{new-file}) are discussed
-specifically in the description of the function. In some sections,
-features common to the arguments of several functions are described at
-the beginning.
+ By convention, any argument whose name contains the name of a type
+(e.g.@: @var{integer}, @var{integer1} or @var{buffer}) is expected to
+be of that type. A plural of a type (such as @var{buffers}) often
+means a list of objects of that type. An argument named @var{object}
+may be of any type. (For a list of Emacs object types, @pxref{Lisp
+Data Types}.) An argument with any other sort of name
+(e.g.@: @var{new-file}) is specific to the function; if the function
+has a documentation string, the type of the argument should be
+described there (@pxref{Documentation}).
- @xref{Lambda Expressions}, for a more complete description of optional
-and rest arguments.
+ @xref{Lambda Expressions}, for a more complete description of
+arguments modified by @code{&optional} and @code{&rest}.
Command, macro, and special form descriptions have the same format,
-but the word `Function' is replaced by `Command', `Macro', or `Special
-Form', respectively. Commands are simply functions that may be called
-interactively; macros process their arguments differently from functions
-(the arguments are not evaluated), but are presented the same way.
+but the word @samp{Function} is replaced by @samp{Command},
+@samp{Macro}, or @samp{Special Form}, respectively. Commands are
+simply functions that may be called interactively; macros process
+their arguments differently from functions (the arguments are not
+evaluated), but are presented the same way.
The descriptions of macros and special forms use a more complex
notation to specify optional and repeated arguments, because they can
@cindex variable descriptions
@cindex option descriptions
- A @dfn{variable} is a name that can hold a value. Although nearly
-all variables can be set by the user, certain variables exist
-specifically so that users can change them; these are called @dfn{user
-options}. Ordinary variables and user options are described using a
-format like that for functions except that there are no arguments.
+ A @dfn{variable} is a name that can be @dfn{bound} (or @dfn{set}) to
+an object. The object to which a variable is bound is called a
+@dfn{value}; we say also that variable holds that value.
+Although nearly all variables can be set by the user, certain
+variables exist specifically so that users can change them; these are
+called @dfn{user options}. Ordinary variables and user options are
+described using a format like that for functions, except that there
+are no arguments.
Here is a description of the imaginary @code{electric-future-map}
variable.@refill
have not yet thought about executing.
@end defvar
- User option descriptions have the same format, but `Variable' is
-replaced by `User Option'.
+ User option descriptions have the same format, but @samp{Variable}
+is replaced by @samp{User Option}.
@node Version Info
@section Version Information
The value of this variable is the version of Emacs being run. It is a
string such as @code{"23.1.1"}. The last number in this string is not
really part of the Emacs release version number; it is incremented
-each time you build Emacs in any given directory. A value with four
+each time Emacs is built in any given directory. A value with four
numeric components, such as @code{"22.0.91.1"}, indicates an
unreleased test version.
@end defvar
23.1, the value is 1.
@end defvar
-@node Acknowledgements
-@section Acknowledgements
+@node Acknowledgments
+@section Acknowledgments
This manual was originally written by Robert Krawitz, Bil Lewis, Dan
LaLiberte, Richard@tie{}M. Stallman and Chris Welty, the volunteers of
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1994, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/keymaps
-@node Keymaps, Modes, Command Loop, Top
+@node Keymaps
@chapter Keymaps
@cindex keymap
A @dfn{key sequence}, or @dfn{key} for short, is a sequence of one
or more input events that form a unit. Input events include
-characters, function keys, and mouse actions (@pxref{Input Events}).
+characters, function keys, mouse actions, or system events external to
+Emacs, such as @code{iconify-frame} (@pxref{Input Events}).
The Emacs Lisp representation for a key sequence is a string or
vector. Unless otherwise stated, any Emacs Lisp function that accepts
a key sequence as an argument can handle both representations.
constituent events; thus, @code{"\C-xl"} represents the key sequence
@kbd{C-x l}.
- Key sequences containing function keys, mouse button events, or
-non-@acronym{ASCII} characters such as @kbd{C-=} or @kbd{H-a} cannot be
-represented as strings; they have to be represented as vectors.
+ Key sequences containing function keys, mouse button events, system
+events, or non-@acronym{ASCII} characters such as @kbd{C-=} or
+@kbd{H-a} cannot be represented as strings; they have to be
+represented as vectors.
In the vector representation, each element of the vector represents
an input event, in its Lisp form. @xref{Input Events}. For example,
@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:
in Emacs now is with extended menu items; before that feature existed,
it could be done by defining alias commands and using them in menu
items. Here's an example that makes two aliases for
-@code{toggle-read-only} and gives them different enable conditions:
+@code{read-only-mode} and gives them different enable conditions:
@example
-(defalias 'make-read-only 'toggle-read-only)
+(defalias 'make-read-only 'read-only-mode)
(put 'make-read-only 'menu-enable '(not buffer-read-only))
-(defalias 'make-writable 'toggle-read-only)
+(defalias 'make-writable 'read-only-mode)
(put 'make-writable 'menu-enable 'buffer-read-only)
@end example
@noindent
causes menu items for @code{make-read-only} and @code{make-writable} to
-show the keyboard bindings for @code{toggle-read-only}.
+show the keyboard bindings for @code{read-only-mode}.
@node Toolkit Differences
@subsubsection Toolkit Differences
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/lists
-@node Lists, Sequences Arrays Vectors, Strings and Characters, Top
+@node Lists
@chapter Lists
@cindex lists
@cindex element (of list)
@end defun
@node Building Lists
-@comment node-name, next, previous, up
@section Building Cons Cells and Lists
@cindex cons cells
@cindex building lists
@defun delq object list
@cindex deleting list elements
This function destructively removes all elements @code{eq} to
-@var{object} from @var{list}. The letter @samp{q} in @code{delq} says
-that it uses @code{eq} to compare @var{object} against the elements of
-the list, like @code{memq} and @code{remq}.
+@var{object} from @var{list}, and returns the resulting list. The
+letter @samp{q} in @code{delq} says that it uses @code{eq} to compare
+@var{object} against the elements of the list, like @code{memq} and
+@code{remq}.
+
+Typically, when you invoke @code{delq}, you should use the return
+value by assigning it to the variable which held the original list.
+The reason for this is explained below.
@end defun
-When @code{delq} deletes elements from the front of the list, it does so
-simply by advancing down the list and returning a sublist that starts
-after those elements:
+The @code{delq} function deletes elements from the front of the list
+by simply advancing down the list, and returning a sublist that starts
+after those elements. For example:
@example
@group
@end group
@end example
+@noindent
When an element to be deleted appears in the middle of the list,
removing it involves changing the @sc{cdr}s (@pxref{Setcdr}).
@end defun
@defun delete object sequence
-If @code{sequence} is a list, this function destructively removes all
-elements @code{equal} to @var{object} from @var{sequence}. For lists,
-@code{delete} is to @code{delq} as @code{member} is to @code{memq}: it
-uses @code{equal} to compare elements with @var{object}, like
-@code{member}; when it finds an element that matches, it cuts the
-element out just as @code{delq} would.
+This function removes all elements @code{equal} to @var{object} from
+@var{sequence}, and returns the resulting sequence.
+
+If @var{sequence} is a list, @code{delete} is to @code{delq} as
+@code{member} is to @code{memq}: it uses @code{equal} to compare
+elements with @var{object}, like @code{member}; when it finds an
+element that matches, it cuts the element out just as @code{delq}
+would. As with @code{delq}, you should typically use the return value
+by assigning it to the variable which held the original list.
If @code{sequence} is a vector or string, @code{delete} returns a copy
of @code{sequence} with all elements @code{equal} to @code{object}
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/loading
-@node Loading, Byte Compilation, Customization, Top
+@node Loading
@chapter Loading
@cindex loading
@cindex library
setenv EMACSLOADPATH /home/foo/.emacs.d/lisp:/opt/emacs/lisp
@end example
+@cindex site-lisp directories
If @env{EMACSLOADPATH} is not set (which is usually the case), Emacs
initializes @code{load-path} with the following two directories:
inserting them in unibyte buffers converts them to unibyte
automatically. However, if this does make a difference, you can force
a particular Lisp file to be interpreted as unibyte by writing
-@samp{unibyte: t} in a local variables section. With
+@samp{coding: raw-text} in a local variables section. With
that designator, the file will unconditionally be interpreted as
-unibyte, even in an ordinary multibyte Emacs session. This can matter
-when making keybindings to non-@acronym{ASCII} characters written as
-@code{?v@var{literal}}.
+unibyte. This can matter when making keybindings to
+non-@acronym{ASCII} characters written as @code{?v@var{literal}}.
@node Autoload
@section Autoload
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1995, 1998, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/macros
-@node Macros, Customization, Functions, Top
+@node Macros
@chapter Macros
@cindex macros
@group
(defmacro inc (var)
(list 'setq var (list '1+ var)))
- @result{} inc
@end group
@group
@group
(defmacro inc2 (var1 var2)
(list 'progn (list 'inc var1) (list 'inc var2)))
- @result{} inc2
@end group
@group
@end example
(Note that the @sc{cdr} of this list is a function---a lambda expression.)
-This macro object is stored in the function cell of @var{name}. The
-value returned by evaluating the @code{defmacro} form is @var{name}, but
-usually we ignore this value.
+This macro object is stored in the function cell of @var{name}. Its return
+value is @emph{undefined}.
The shape and meaning of @var{argument-list} is the same as in a
function, and the keywords @code{&rest} and @code{&optional} may be used
(cons (list '<= var final)
(append body (list (list 'inc var)))))))
@end group
-@result{} for
@group
(for i from 1 to 3 do
@group
(defmacro foo (a)
(list 'setq (eval a) t))
- @result{} foo
@end group
@group
(setq x 'b)
# Directory with the (customized) texinfo.tex file.
texinfodir = $(srcdir)/../misc
+INFO_EXT=.info
+INFO_OPTS=--no-split
+
# Redefine `TEX' if `tex' does not invoke plain TeX. For example:
# TEX=platex
TEX=tex
$(srcdir)/abbrevs.texi \
$(srcdir)/advice.texi \
$(srcdir)/anti.texi \
- $(srcdir)/back.texi \
$(srcdir)/backups.texi \
$(srcdir)/buffers.texi \
$(srcdir)/commands.texi \
# The info file is named `elisp'.
-info: $(infodir)/elisp
+info: $(infodir)/elisp$(INFO_EXT)
$(infodir)/dir:
$(INSTALL_INFO) --info-dir=$(infodir) $(infodir)/elisp
-$(infodir)/elisp: $(srcs)
- $(MAKEINFO) $(MAKEINFO_OPTS) -o $(infodir)/elisp $(srcdir)/elisp.texi
+$(infodir)/elisp$(INFO_EXT): $(srcs)
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $(srcdir)/elisp.texi
elisp.dvi: $(srcs)
$(texinputdir) $(TEX) $(srcdir)/elisp.texi
- $(DEL) makefile
maintainer-clean: distclean
- - $(DEL) elisp elisp-? elisp-?? elisp.dvi elisp.oaux
+ - $(DEL) elisp$(INFO_EXT) elisp$(INFO_EXT)-? elisp$(INFO_EXT)-?? elisp.dvi elisp.oaux
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1993, 1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/maps
-@node Standard Keymaps, Standard Hooks, Standard Errors, Top
+@node Standard Keymaps
@appendix Standard Keymaps
@cindex keymaps, standard
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/markers
-@node Markers, Text, Positions, Top
+@node Markers
@chapter Markers
@cindex markers
If @var{position} is less than 1, @code{set-marker} moves @var{marker}
to the beginning of the buffer. If @var{position} is greater than the
-size of the buffer, @code{set-marker} moves marker to the end of the
-buffer. If @var{position} is @code{nil} or a marker that points
-nowhere, then @var{marker} is set to point nowhere.
+size of the buffer (@pxref{Point}), @code{set-marker} moves marker to
+the end of the buffer. If @var{position} is @code{nil} or a marker
+that points nowhere, then @var{marker} is set to point nowhere.
The value returned is @var{marker}.
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/minibuf
-@node Minibuffers, Command Loop, Read and Print, Top
+@node Minibuffers
@chapter Minibuffers
@cindex arguments, reading
@cindex complex arguments
@defun read-variable prompt &optional default
@anchor{Definition of read-variable}
-This function reads the name of a user variable and returns it as a
-symbol. Its arguments have the same form as those of @code{read-command}.
-In general, this function is similar to @code{read-command}, but uses
-the predicate @code{user-variable-p} instead of @code{commandp}.
+This function reads the name of a customizable variable and returns it
+as a symbol. Its arguments have the same form as those of
+@code{read-command}. It behaves just like @code{read-command}, except
+that it uses the predicate @code{custom-variable-p} instead of
+@code{commandp}.
@end defun
@deffn Command read-color &optional prompt convert allow-empty display
cursor moves to the echo area while the question is being asked.
The answers and their meanings, even @samp{y} and @samp{n}, are not
-hardwired. The keymap @code{query-replace-map} specifies them.
-@xref{Search and Replace}.
-
-In the following example, the user first types @kbd{q}, which is
-invalid. At the next prompt the user types @kbd{y}.
-
-@c Need an interactive example, because otherwise the return value
-@c obscures the display of the valid answer.
-@smallexample
-@group
-(defun ask ()
- (interactive)
- (y-or-n-p "Do you need a lift? "))
-
-;; @r{After evaluation of the preceding definition, @kbd{M-x ask}}
-;; @r{causes the following prompt to appear in the echo area:}
-@end group
-
-@group
----------- Echo area ----------
-Do you need a lift? (y or n)
----------- Echo area ----------
-@end group
-
-;; @r{If the user then types @kbd{q}, the following appears:}
-
-@group
----------- Echo area ----------
-Please answer y or n. Do you need a lift? (y or n)
----------- Echo area ----------
-@end group
-
-;; @r{When the user types a valid answer,}
-;; @r{it is displayed after the question:}
-
-@group
----------- Echo area ----------
-Do you need a lift? (y or n) y
----------- Echo area ----------
-@end group
-@end smallexample
+hardwired, and are specified by the keymap @code{query-replace-map}
+(@pxref{Search and Replace}). In particular, if the user enters the
+special responses @code{recenter}, @code{scroll-up},
+@code{scroll-down}, @code{scroll-other-window}, or
+@code{scroll-other-window-down} (respectively bound to @kbd{C-l},
+@kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in
+@code{query-replace-map}), this function performs the specified window
+recentering or scrolling operation, and poses the question again.
@noindent
We show successive lines of echo area messages, but only one actually
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/modes
-@node Modes, Documentation, Keymaps, Top
+@node Modes
@chapter Major and Minor Modes
@cindex mode
A list whose first element is a symbol that is not a keyword specifies
a conditional. Its meaning depends on the value of @var{symbol}. If
@var{symbol} has a non-@code{nil} value, the second element,
-@var{then}, is processed recursively as a mode line element.
+@var{then}, is processed recursively as a mode line construct.
Otherwise, the third element, @var{else}, is processed recursively.
-You may omit @var{else}; then the mode line element displays nothing
+You may omit @var{else}; then the mode line construct displays nothing
if the value of @var{symbol} is @code{nil} or void.
@item (@var{width} @var{rest}@dots{})
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
+@c Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/characters
-@node Non-ASCII Characters, Searching and Matching, Text, Top
+@node Non-ASCII Characters
@chapter Non-@acronym{ASCII} Characters
@cindex multibyte characters
@cindex characters, multi-byte
@end defvar
@defun charset-priority-list &optional highestp
-This functions returns a list of all defined character sets ordered by
+This function returns a list of all defined character sets ordered by
their priority. If @var{highestp} is non-@code{nil}, the function
returns a single character set of the highest priority.
@end defun
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/numbers
-@node Numbers, Strings and Characters, Lisp Data Types, Top
+@node Numbers
@chapter Numbers
@cindex integers
@cindex numbers
@end menu
@node Integer Basics
-@comment node-name, next, previous, up
@section Integer Basics
The range of values for an integer depends on the machine. The
correct answer. For example, @code{(/ 0.0 0.0)} returns a NaN. (NaN
values can also carry a sign, but for practical purposes there's no
significant difference between different NaN values in Emacs Lisp.)
+
+When a function is documented to return a NaN, it returns an
+implementation-defined value when Emacs is running on one of the
+now-rare platforms that do not use @acronym{IEEE} floating point. For
+example, @code{(log -1.0)} typically returns a NaN, but on
+non-@acronym{IEEE} platforms it returns an implementation-defined
+value.
+
Here are the read syntaxes for these special floating point values:
@table @asis
@defun logb number
This function returns the binary exponent of @var{number}. More
-precisely, the value is the logarithm of @var{number} base 2, rounded
+precisely, the value is the logarithm of |@var{number}| base 2, rounded
down to an integer.
@example
quotient downward (towards minus infinity) to an integer, and uses that
quotient to compute the remainder.
-An @code{arith-error} results if @var{divisor} is 0.
+If @var{divisor} is zero, @code{mod} signals an @code{arith-error}
+error if both arguments are integers, and returns a NaN otherwise.
@example
@group
@tex
@math{\pi/2}
@end tex
-(inclusive) whose sine is @var{arg}; if, however, @var{arg} is out of
-range (outside [@minus{}1, 1]), it signals a @code{domain-error} error.
+(inclusive) whose sine is @var{arg}. If @var{arg} is out of range
+(outside [@minus{}1, 1]), @code{asin} returns a NaN.
@end defun
@defun acos arg
@tex
@math{\pi}
@end tex
-(inclusive) whose cosine is @var{arg}; if, however, @var{arg} is out
-of range (outside [@minus{}1, 1]), it signals a @code{domain-error} error.
+(inclusive) whose cosine is @var{arg}. If @var{arg} is out of range
+(outside [@minus{}1, 1]), @code{acos} returns a NaN.
@end defun
@defun atan y &optional x
@defun log arg &optional base
This function returns the logarithm of @var{arg}, with base
@var{base}. If you don't specify @var{base}, the natural base
-@math{e} is used. If @var{arg} is negative, it signals a
-@code{domain-error} error.
+@math{e} is used. If @var{arg} or @var{base} is negative, @code{log}
+returns a NaN.
@end defun
@ignore
@end ignore
@defun log10 arg
-This function returns the logarithm of @var{arg}, with base 10. If
-@var{arg} is negative, it signals a @code{domain-error} error.
-@code{(log10 @var{x})} @equiv{} @code{(log @var{x} 10)}, at least
-approximately.
+This function returns the logarithm of @var{arg}, with base 10:
+@code{(log10 @var{x})} @equiv{} @code{(log @var{x} 10)}.
@end defun
@defun expt x y
This function returns @var{x} raised to power @var{y}. If both
arguments are integers and @var{y} is positive, the result is an
integer; in this case, overflow causes truncation, so watch out.
+If @var{x} is a finite negative number and @var{y} is a finite
+non-integer, @code{expt} returns a NaN.
@end defun
@defun sqrt arg
This returns the square root of @var{arg}. If @var{arg} is negative,
-it signals a @code{domain-error} error.
+@code{sqrt} returns a NaN.
@end defun
In addition, Emacs defines the following common mathematical
mimic a random series. For example, all possible values occur equally
often in a pseudo-random series.
-In Emacs, pseudo-random numbers are generated from a ``seed'' number.
+In Emacs, pseudo-random numbers are generated from a ``seed''.
Starting from any given seed, the @code{random} function always
-generates the same sequence of numbers. Emacs always starts with the
-same seed value, so the sequence of values of @code{random} is actually
-the same in each Emacs run! For example, in one operating system, the
-first call to @code{(random)} after you start Emacs always returns
-@minus{}1457731, and the second one always returns @minus{}7692030. This
-repeatability is helpful for debugging.
-
-If you want random numbers that don't always come out the same, execute
-@code{(random t)}. This chooses a new seed based on the current time of
-day and on Emacs's process @acronym{ID} number.
+generates the same sequence of numbers. Emacs typically starts with a
+different seed each time, so the sequence of values of @code{random}
+typically differs in each Emacs run.
+
+Sometimes you want the random number sequence to be repeatable. For
+example, when debugging a program whose behavior depends on the random
+number sequence, it is helpful to get the same behavior in each
+program run. To make the sequence repeat, execute @code{(random "")}.
+This sets the seed to a constant value for your particular Emacs
+executable (though it may differ for other Emacs builds). You can use
+other strings to choose various seed values.
@defun random &optional limit
This function returns a pseudo-random integer. Repeated calls return a
series of pseudo-random integers.
If @var{limit} is a positive integer, the value is chosen to be
-nonnegative and less than @var{limit}.
+nonnegative and less than @var{limit}. Otherwise, the value
+might be any integer representable in Lisp.
If @var{limit} is @code{t}, it means to choose a new seed based on the
current time of day and on Emacs's process @acronym{ID} number.
-On some machines, any integer representable in Lisp may be the result
-of @code{random}. On other machines, the result can never be larger
-than a certain maximum or less than a certain (negative) minimum.
+If @var{limit} is a string, it means to choose a new seed based on the
+string's contents.
+
@end defun
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/objects
-@node Lisp Data Types, Numbers, Introduction, Top
+@node Lisp Data Types
@chapter Lisp Data Types
@cindex object
@cindex Lisp object
@end menu
@node Printed Representation
-@comment node-name, next, previous, up
@section Printed Representation and Read Syntax
@cindex printed representation
@cindex read syntax
@code{read}, the basic function for reading objects.
@node Comments
-@comment node-name, next, previous, up
@section Comments
@cindex comments
@cindex @samp{;} in comment
@end ifnottex
@node Association List Type
-@comment node-name, next, previous, up
@subsubsection Association List Type
An @dfn{association list} or @dfn{alist} is a specially-constructed
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/os
-@node System Interface, Packaging, Display, Top
+@node System Interface
@chapter Operating System Interface
This chapter is about starting and getting out of Emacs, access to
@end menu
@node Killing Emacs
-@comment node-name, next, previous, up
@subsection Killing Emacs
@cindex killing Emacs
zone.
@cindex epoch
- Most of these functions represent time as a list of either three
+ Most of these functions represent time as a list of either four
+integers, @code{(@var{sec-high} @var{sec-low} @var{microsec}
+@var{picosec})}, or of three
integers, @code{(@var{sec-high} @var{sec-low} @var{microsec})}, or of
two integers, @code{(@var{sec-high} @var{sec-low})}. The integers
@var{sec-high} and @var{sec-low} give the high and low bits of an
UTC) to the specified time. The third list element @var{microsec}, if
present, gives the number of microseconds from the start of that
second to the specified time.
+Similarly, the fourth list element @var{picosec}, if present, gives
+the number of picoseconds from the start of that microsecond to the
+specified time.
The return value of @code{current-time} represents time using three
-integers, while the timestamps in the return value of
-@code{file-attributes} use two integers (@pxref{Definition of
+integers, as do the timestamps in the return value of
+@code{file-attributes} (@pxref{Definition of
file-attributes}). In function arguments, e.g.@: the @var{time-value}
-argument to @code{current-time-string}, both two- and three-integer
+argument to @code{current-time-string}, two-, three-, and four-integer
lists are accepted. You can convert times from the list
representation into standard human-readable strings using
@code{current-time}, or to other forms using the @code{decode-time}
@defun current-time-string &optional time-value
This function returns the current time and date as a human-readable
-string. The format of the string is unvarying; the number of
-characters used for each part is always the same, so you can reliably
-use @code{substring} to extract pieces of it. You should count
+string. The format does not vary for the initial part of the string,
+which contains the day of week, month, day of month, and time of day
+in that order: the number of characters used for these fields is
+always the same, so you can reliably
+use @code{substring} to extract them. You should count
characters from the beginning of the string rather than from the end,
-as additional information may some day be added at the end.
+as the year might not have exactly four digits, and additional
+information may some day be added at the end.
The argument @var{time-value}, if given, specifies a time to format
(represented as a list of integers), instead of the current time.
@end defun
@defun current-time
-This function returns the current time, represented as a list of three
-integers @code{(@var{sec-high} @var{sec-low} @var{microsec})}. On
-systems with only one-second time resolutions, @var{microsec} is 0.
+This function returns the current time, represented as a list of four
+integers @code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}.
+These integers have trailing zeros on systems that return time with
+lower resolutions. On all current machines @var{picosec} is a
+multiple of 1000, but this may change as higher-resolution clocks
+become available.
@end defun
@defun float-time &optional time-value
@node Time Conversion
@section Time Conversion
- These functions convert time values (lists of two or three integers,
+ These functions convert time values (lists of two to four integers,
as explained in the previous section) into calendrical information and
vice versa.
This stands for the nanoseconds (000000000-999999999). To ask for
fewer digits, use @samp{%3N} for milliseconds, @samp{%6N} for
microseconds, etc. Any excess digits are discarded, without rounding.
-Currently Emacs time stamps are at best microsecond resolution so the
-last three digits generated by plain @samp{%N} are always zero.
@item %p
This stands for @samp{AM} or @samp{PM}, as appropriate.
@item %r
@defun get-internal-run-time
This function returns the processor run time used by Emacs as a list
-of three integers: @code{(@var{high} @var{low} @var{microsec})}. The
-integers @var{high} and @var{low} combine to give the number of
-seconds, which is
-@ifnottex
-@var{high} * 2**16 + @var{low}.
-@end ifnottex
-@tex
-$high*2^{16}+low$.
-@end tex
-
-The third element, @var{microsec}, gives the microseconds (or 0 for
-systems that return time with the resolution of only one second).
+of four integers: @code{(@var{high} @var{low} @var{microsec}
+@var{picosec})}, using the same format as @code{current-time}
+(@pxref{Time of Day}).
Note that the time returned by this function excludes the time Emacs
was not using the processor, and if the Emacs process has several
seconds after the last invocation, don't use the @var{repeat} argument.
Instead, the timer function should explicitly reschedule the timer.
-@defvar timer-max-repeats
+@defopt timer-max-repeats
This variable's value specifies the maximum number of times to repeat
calling a timer function in a row, when many previously scheduled
calls were unavoidably delayed.
-@end defvar
+@end defopt
@defmac with-timeout (seconds timeout-forms@dots{}) body@dots{}
Execute @var{body}, but give up after @var{seconds} seconds. If
@defun current-idle-time
If Emacs is idle, this function returns the length of time Emacs has
-been idle, as a list of three integers: @code{(@var{sec-high}
-@var{sec-low} @var{microsec})}, where @var{high} and @var{low} are the
-high and low bits for the number of seconds and @var{microsec} is the
-additional number of microseconds (@pxref{Time of Day}).
+been idle, as a list of four integers: @code{(@var{sec-high}
+@var{sec-low} @var{microsec} @var{picosec})}, using the same format as
+@code{current-time} (@pxref{Time of Day}).
When Emacs is not idle, @code{current-idle-time} returns @code{nil}.
This is a convenient way to test whether Emacs is idle.
It blocks out any idle timers that ought to run during that time.
@end itemize
+@noindent
+For similar reasons, do not write an idle timer function that sets
+up another idle time (including the same idle timer) with the
+@var{secs} argument less or equal to the current idleness time. Such
+a timer will run almost immediately, and continue running again and
+again, instead of waiting for the next time Emacs becomes idle.
+
@noindent
The correct approach is for the idle timer to reschedule itself after
a brief pause, using the method in the @code{timer-function} example
@item :body @var{text}
The notification body text. Depending on the implementation of the
notification server, the text could contain HTML markups, like
-@samp{"<b>bold text</b>"}, or hyperlinks.
+@samp{"<b>bold text</b>"}, hyperlinks, or images.
@item :app-name @var{name}
The name of the application sending the notification. The default is
@item :urgency @var{urgency}
The urgency level. It can be @code{low}, @code{normal}, or @code{critical}.
+@item :action-items
+When this keyword is given, the @var{title} string of the actions is
+interpreted as icon name.
+
@item :category @var{category}
The type of notification this is, a string.
Causes the server to suppress playing any sounds, if it has that
ability.
+@item :resident
+When set the server will not automatically remove the notification
+when an action has been invoked. The notification will remain resident
+in the server until it is explicitly removed by the user or by the
+sender. This hint is likely only useful when the server has the
+@code{:persistence} capability.
+
+@item :transient
+When set the server will treat the notification as transient and
+by-pass the server's persistence capability, if it should exist.
+
@item :x @var{position}
@itemx :y @var{position}
Specifies the X, Y location on the screen that the
@end itemize
@end table
+Which parameters are accepted by the notification server can be
+checked via @code{notifications-get-capabilities}.
+
This function returns a notification id, an integer, which can be used
to manipulate the notification item with
@code{notifications-close-notification} or the @code{:replaces-id}
This function closes a notification with identifier @var{id}.
@end defun
+@defun notifications-get-capabilities
+Returns the capabilities of the notification server, a list of strings.
+The following capabilities can be expected:
+
+@table @code
+@item :actions
+The server will provide the specified actions to the user.
+
+@item :body
+Supports body text.
+
+@item :body-hyperlinks
+The server supports hyperlinks in the notifications.
+
+@item :body-images
+The server supports images in the notifications.
+
+@item :body-markup
+Supports markup in the body text.
+
+@item :icon-multi
+The server will render an animation of all the frames in a given image
+array.
+
+@item :icon-static
+Supports display of exactly 1 frame of any given image array. This
+value is mutually exclusive with @code{:icon-multi}.
+
+@item :persistence
+The server supports persistence of notifications.
+
+@item :sound
+The server supports sounds on notifications.
+@end table
+
+Further vendor-specific caps start with @code{:x-vendor}, like
+@code{:x-gnome-foo-cap}.
+@end defun
+
+
@node Dynamic Libraries
@section Dynamically Loaded Libraries
@cindex dynamic libraries
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2010-2012 Free Software Foundation, Inc.
+@c Copyright (C) 2010-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/package
-@node Packaging, Antinews, System Interface, Top
+@node Packaging
@chapter Preparing Lisp code for distribution
@cindex package
@cindex Lisp package
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/positions
-@node Positions, Markers, Frames, Top
+@node Positions
@chapter Positions
@cindex position (in buffer)
@end defun
@node List Motion
-@comment node-name, next, previous, up
@subsection Moving over Balanced Expressions
@cindex sexp motion
@cindex Lisp expression motion
@end defvar
@node Skipping Characters
-@comment node-name, next, previous, up
@subsection Skipping Characters
@cindex skipping characters
@cindex window excursions
Likewise, @code{save-excursion} does not restore window-buffer
correspondences altered by functions such as @code{switch-to-buffer}.
-One way to restore these correspondences, and the selected window, is to
-use @code{save-window-excursion} inside @code{save-excursion}
-(@pxref{Window Configurations}).
@strong{Warning:} Ordinary insertion of text adjacent to the saved
point value relocates the saved value, just as it relocates all
remains addressable is called the @dfn{accessible portion} of the
buffer.
- Narrowing is specified with two buffer positions which become the
-beginning and end of the accessible portion. For most editing commands
-and most Emacs primitives, these positions replace the values of the
-beginning and end of the buffer. While narrowing is in effect, no text
-outside the accessible portion is displayed, and point cannot move
-outside the accessible portion.
-
- Values such as positions or line numbers, which usually count from the
-beginning of the buffer, do so despite narrowing, but the functions
-which use them refuse to operate on text that is inaccessible.
-
- The commands for saving buffers are unaffected by narrowing; they save
+ Narrowing is specified with two buffer positions, which become the
+beginning and end of the accessible portion. For most editing
+commands and primitives, these positions replace the values of the
+beginning and end of the buffer. While narrowing is in effect, no
+text outside the accessible portion is displayed, and point cannot
+move outside the accessible portion. Note that narrowing does not
+alter actual buffer positions (@pxref{Point}); it only determines
+which positions are considered the accessible portion of the buffer.
+Most functions refuse to operate on text that is outside the
+accessible portion.
+
+ Commands for saving buffers are unaffected by narrowing; they save
the entire buffer regardless of any narrowing.
If you need to display in a single buffer several very different
@end example
@end deffn
+@defun buffer-narrowed-p
+This function returns non-@code{nil} if the buffer is narrowed, and
+@code{nil} otherwise.
+@end defun
+
@defspec save-restriction body@dots{}
This special form saves the current bounds of the accessible portion,
evaluates the @var{body} forms, and finally restores the saved bounds,
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/processes
-@node Processes, Display, Abbrevs, Top
+@node Processes
@chapter Processes
@cindex child process
@cindex parent process
Executing a program can also try adding suffixes to the specified
name:
-@defvar exec-suffixes
+@defopt exec-suffixes
This variable is a list of suffixes (strings) to try adding to the
specified program file name. The list should include @code{""} if you
want the name to be tried exactly as specified. The default value is
system-dependent.
-@end defvar
+@end defopt
@strong{Please note:} The argument @var{program} contains only the
name of the program; it may not contain any command-line arguments. You
@defun call-process program &optional infile destination display &rest args
This function calls @var{program} and waits for it to finish.
+The current working directory of the subprocess is
+@code{default-directory}.
+
The standard input for the new process comes from file @var{infile} if
@var{infile} is not @code{nil}, and from the null device otherwise.
The argument @var{destination} says where to put the process output.
@section Creating an Asynchronous Process
@cindex asynchronous subprocess
- After an @dfn{asynchronous process} is created, Emacs and the subprocess
-both continue running immediately. The process thereafter runs
-in parallel with Emacs, and the two can communicate with each other
-using the functions described in the following sections. However,
+ In this section, we describe how to create an @dfn{asynchronous
+process}. After an asynchronous process is created, it runs in
+parallel with Emacs, and Emacs can communicate with it using the
+functions described in the following sections (@pxref{Input to
+Processes}, and @pxref{Output from Processes}). Note that process
communication is only partially asynchronous: Emacs sends data to the
process only when certain functions are called, and Emacs accepts data
-from the process only when Emacs is waiting for input or for a time
-delay.
-
- Here we describe how to create an asynchronous process.
+from the process only while waiting for input or for a time delay.
+
+@cindex pty
+@cindex pipe
+ An asynchronous process is controlled either via a @dfn{pty}
+(pseudo-terminal) or a @dfn{pipe}. The choice of pty or pipe is made
+when creating the process, based on the value of the variable
+@code{process-connection-type} (see below). Ptys are usually
+preferable for processes visible to the user, as in Shell mode,
+because they allow for job control (@kbd{C-c}, @kbd{C-z}, etc.)
+between the process and its children, whereas pipes do not. For
+subprocesses used for internal purposes by programs, it is often
+better to use a pipe, because they are more efficient, and because
+they are immune to stray character injections that ptys introduce for
+large (around 500 byte) messages. Also, the total number of ptys is
+limited on many systems and it is good not to waste them.
@defun start-process name buffer-or-name program &rest args
This function creates a new asynchronous subprocess and starts the
@end defun
@defvar process-connection-type
-@cindex pipes
-@cindex @acronym{PTY}s
This variable controls the type of device used to communicate with
-asynchronous subprocesses. If it is non-@code{nil}, then @acronym{PTY}s are
+asynchronous subprocesses. If it is non-@code{nil}, then ptys are
used, when available. Otherwise, pipes are used.
-@acronym{PTY}s are usually preferable for processes visible to the user, as
-in Shell mode, because they allow job control (@kbd{C-c}, @kbd{C-z},
-etc.) to work between the process and its children, whereas pipes do
-not. For subprocesses used for internal purposes by programs, it is
-often better to use a pipe, because they are more efficient. In
-addition, the total number of @acronym{PTY}s is limited on many systems and
-it is good not to waste them.
-
The value of @code{process-connection-type} takes effect when
@code{start-process} is called. So you can specify how to communicate
with one subprocess by binding the variable around the call to
@end group
@end smallexample
-To determine whether a given subprocess actually got a pipe or a
-@acronym{PTY}, use the function @code{process-tty-name} (@pxref{Process
+To determine whether a given subprocess actually got a pipe or a pty,
+use the function @code{process-tty-name} (@pxref{Process
Information}).
@end defvar
@c FIXME which?
Some operating systems have limited space for buffered input in a
-@acronym{PTY}. On these systems, Emacs sends an @acronym{EOF}
-periodically amidst the other characters, to force them through. For
-most programs, these @acronym{EOF}s do no harm.
+pty. On these systems, Emacs sends an @acronym{EOF} periodically
+amidst the other characters, to force them through. For most
+programs, these @acronym{EOF}s do no harm.
Subprocess input is normally encoded using a coding system before the
subprocess receives it, much like text written into a file. You can use
@item utime
Time spent by the process in the user context, for running the
application's code. The corresponding @var{value} is in the
-@w{@code{(@var{high} @var{low} @var{microsec})}} format, the same
+@w{@code{(@var{high} @var{low} @var{microsec} @var{picosec})}} format, the same
format used by functions @code{current-time} (@pxref{Time of Day,
current-time}) and @code{file-attributes} (@pxref{File Attributes}).
@item start
The time when the process was started, in the same
-@w{@code{(@var{high} @var{low} @var{microsec})}} format used by
+@w{@code{(@var{high} @var{low} @var{microsec} @var{picosec})}} format used by
@code{current-time} and by @code{file-attributes}.
@item etime
The time elapsed since the process started, in the @w{@code{(@var{high}
-@var{low} @var{microsec})}} format.
+@var{low} @var{microsec} @var{picosec})}} format.
@item vsize
The virtual memory size of the process, measured in kilobytes.
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/searching
-@node Searching and Matching, Syntax Tables, Non-ASCII Characters, Top
+@node Searching and Matching
@chapter Searching and Matching
@cindex searching
an @code{invalid-regexp} error is signaled.
@node Regexp Example
-@comment node-name, next, previous, up
@subsection Complex Regexp Example
Here is a complicated regexp which was formerly used by Emacs to
@cindex case in replacements
@defun replace-match replacement &optional fixedcase literal string subexp
-This function replaces the text in the buffer (or in @var{string}) that
-was matched by the last search. It replaces that text with
-@var{replacement}.
+This function performs a replacement operation on a buffer or string.
-If you did the last search in a buffer, you should specify @code{nil}
-for @var{string} and make sure that the current buffer when you call
-@code{replace-match} is the one in which you did the searching or
-matching. Then @code{replace-match} does the replacement by editing
-the buffer; it leaves point at the end of the replacement text, and
-returns @code{t}.
+If you did the last search in a buffer, you should omit the
+@var{string} argument or specify @code{nil} for it, and make sure that
+the current buffer is the one in which you performed the last search.
+Then this function edits the buffer, replacing the matched text with
+@var{replacement}. It leaves point at the end of the replacement
+text, and returns @code{t}.
-If you did the search in a string, pass the same string as @var{string}.
-Then @code{replace-match} does the replacement by constructing and
-returning a new string.
+If you performed the last search on a string, pass the same string as
+@var{string}. Then this function returns a new string, in which the
+matched text is replaced by @var{replacement}.
If @var{fixedcase} is non-@code{nil}, then @code{replace-match} uses
the replacement text without case conversion; otherwise, it converts
it.
@item recenter
-Redisplay and center the window, then ask the same question again.
+@itemx scroll-up
+@itemx scroll-down
+@itemx scroll-other-window
+@itemx scroll-other-window-down
+Perform the specified window scroll operation, then ask the same
+question again. Only @code{y-or-n-p} and related functions use this
+answer.
@item quit
Perform a quit right away. Only @code{y-or-n-p} and related functions
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/sequences
-@node Sequences Arrays Vectors, Hash Tables, Lists, Top
+@node Sequences Arrays Vectors
@chapter Sequences, Arrays, and Vectors
@cindex sequence
ARPA
Abbrev
-Acknowledgements
Alan
Arnold
Autoloading
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1994, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/streams
-@node Read and Print, Minibuffers, Debugging, Top
-@comment node-name, next, previous, up
+@node Read and Print
@chapter Reading and Printing Lisp Objects
@dfn{Printing} and @dfn{reading} are the operations of converting Lisp
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/strings
-@node Strings and Characters, Lists, Numbers, Top
-@comment node-name, next, previous, up
+@node Strings and Characters
@chapter Strings and Characters
@cindex strings
@cindex character arrays
@ref{Regexp Search}.
@node String Conversion
-@comment node-name, next, previous, up
@section Conversion of Characters and Strings
@cindex conversion of strings
@end table
@node Formatting Strings
-@comment node-name, next, previous, up
@section Formatting Strings
@cindex formatting strings
@cindex strings, formatting them
characters.
@node Case Conversion
-@comment node-name, next, previous, up
@section Case Conversion in Lisp
@cindex upper case
@cindex lower case
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/symbols
-@node Symbols, Evaluation, Hash Tables, Top
+@node Symbols
@chapter Symbols
@cindex symbol
for recording miscellaneous information.
@end menu
-@node Symbol Components, Definitions, Symbols, Symbols
+@node Symbol Components
@section Symbol Components
@cindex symbol components
@result{} #<subr buffer-file-name>
@end example
-@node Definitions, Creating Symbols, Symbol Components, Symbols
+@node Definitions
@section Defining Symbols
@cindex definitions of symbols
containing links to the relevant variable, function, or macro
definitions. @xref{Name Help,,, emacs, The GNU Emacs Manual}.
-@node Creating Symbols, Property Lists, Definitions, Symbols
+@node Creating Symbols
@section Creating and Interning Symbols
@cindex reading symbols
it returns @code{nil}.
@end defun
-@node Property Lists,, Creating Symbols, Symbols
+@node Property Lists
@section Property Lists
@cindex property list
@cindex plist
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/syntax
-@node Syntax Tables, Abbrevs, Searching and Matching, Top
+@node Syntax Tables
@chapter Syntax Tables
@cindex parsing buffer text
@cindex syntax table
* 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
@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.
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}).
-
- 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.
+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 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.
punctuation, matching character slot unused, first character of a
comment-starter, second character of a comment-ender).
+ Emacs also defines @dfn{raw syntax descriptors}, which are used to
+describe syntax classes at a lower level. @xref{Syntax Table
+Internals}.
+
@menu
* Syntax Class Table:: Table of syntax classes.
* Syntax Flags:: Additional flags each character can have.
@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
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}.
-
-Most major mode syntax tables are created in this way.
+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.
+
+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
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.
@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.
-
-An error is signaled if @var{char} is not a character.
+by its designator character (@pxref{Syntax Class Table}). This
+returns @emph{only} the class, not its matching character or syntax
+flags.
-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
underlying text character.
@item @code{(@var{syntax-code} . @var{matching-char})}
-A cons cell of this format specifies the syntax for the underlying
-text character. (@pxref{Syntax Table Internals})
+A cons cell of this format is a raw syntax descriptor (@pxref{Syntax
+Table Internals}), which directly specifies a syntax class for the
+underlying text character.
@item @code{nil}
If the property is @code{nil}, the character's syntax is determined from
@var{start}, not scanning past @var{limit}. It stops at position
@var{limit} or when certain criteria described below are met, and sets
point to the location where parsing stops. It returns a parser state
+@ifinfo
+(@pxref{Parser State})
+@end ifinfo
describing the status of the parse at the point where it stops.
@cindex parenthesis depth
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.
-
- 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.
-
- This table gives the value of @var{syntax-code} which corresponds
-to each syntactic type.
-
-@multitable @columnfractions .05 .3 .3 .31
+ 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}).
+
+@cindex syntax code
+@cindex raw syntax descriptor
+ Each entry in a syntax table is a @dfn{raw syntax descriptor}: a
+cons cell of the form @code{(@var{syntax-code}
+. @var{matching-char})}. @var{syntax-code} is an integer which
+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).
+
+ Here are the syntax codes corresponding to the various syntax
+classes:
+
+@multitable @columnfractions .2 .3 .2 .3
+@item
+@i{Code} @tab @i{Class} @tab @i{Code} @tab @i{Class}
@item
-@tab
-@i{Integer} @i{Class}
-@tab
-@i{Integer} @i{Class}
-@tab
-@i{Integer} @i{Class}
+0 @tab whitespace @tab 8 @tab paired delimiter
@item
-@tab
-0 @ @ whitespace
-@tab
-5 @ @ close parenthesis
-@tab
-10 @ @ character quote
+1 @tab punctuation @tab 9 @tab escape
@item
-@tab
-1 @ @ punctuation
-@tab
-6 @ @ expression prefix
-@tab
-11 @ @ comment-start
+2 @tab word @tab 10 @tab character quote
@item
-@tab
-2 @ @ word
-@tab
-7 @ @ string quote
-@tab
-12 @ @ comment-end
+3 @tab symbol @tab 11 @tab comment-start
@item
-@tab
-3 @ @ symbol
-@tab
-8 @ @ paired delimiter
-@tab
-13 @ @ inherit
+4 @tab open parenthesis @tab 12 @tab comment-end
@item
-@tab
-4 @ @ open parenthesis
-@tab
-9 @ @ escape
-@tab
-14 @ @ generic comment
+5 @tab close parenthesis @tab 13 @tab inherit
@item
-@tab
-15 @ generic string
+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}
-. @var{matching-char})}.
+Given a syntax descriptor @var{desc} (a string), this function returns
+the corresponding raw syntax descriptor.
@end defun
@defun syntax-after pos
-This function returns the syntax code of the character in the buffer
-after position @var{pos}, taking account of syntax properties as well
-as the syntax table. If @var{pos} is outside the buffer's accessible
-portion (@pxref{Narrowing, accessible portion}), this function returns
-@code{nil}.
+This function returns the raw syntax descriptor for the character in
+the buffer after position @var{pos}, taking account of syntax
+properties as well as the syntax table. If @var{pos} is outside the
+buffer's accessible portion (@pxref{Narrowing, accessible portion}),
+the return value is @code{nil}.
@end defun
@defun syntax-class syntax
-This function returns the syntax class of the syntax code
-@var{syntax}. (It masks off the high 16 bits that hold the flags
-encoded in the syntax descriptor.) If @var{syntax} is @code{nil}, it
-returns @code{nil}; this is so evaluating the expression
+This function returns the syntax code for the raw syntax descriptor
+@var{syntax}. More precisely, it takes the raw syntax descriptor's
+@var{syntax-code} component, masks off the high 16 bits which record
+the syntax flags, and returns the resulting integer.
+
+If @var{syntax} is @code{nil}, the return value is returns @code{nil}.
+This is so that the expression
@example
(syntax-class (syntax-after pos))
@end example
@noindent
-where @code{pos} is outside the buffer's accessible portion, will
-yield @code{nil} without throwing errors or producing wrong syntax
-class codes.
+evaluates to @code{nil} if @code{pos} is outside the buffer's
+accessible portion, without throwing errors or returning an incorrect
+code.
@end defun
@node Categories
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
+@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/text
-@node Text, Non-ASCII Characters, Markers, Top
+@node Text
@chapter Text
@cindex text
* Case Changes:: Case conversion of parts of the buffer.
* Text Properties:: Assigning Lisp property lists to text characters.
* Substitution:: Replacing a given character wherever it appears.
-* Transposition:: Swapping two portions of a buffer.
* Registers:: How registers are implemented. Accessing the text or
position stored in a register.
+* Transposition:: Swapping two portions of a buffer.
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
* Parsing HTML/XML:: Parsing HTML and XML.
overlay.
@end defun
-@defun insert-char character count &optional inherit
-This function inserts @var{count} instances of @var{character} into the
-current buffer before point. The argument @var{count} should be an
-integer, and @var{character} must be a character. The value is @code{nil}.
+@deffn Command insert-char character &optional count inherit
+This command inserts @var{count} instances of @var{character} into the
+current buffer before point. The argument @var{count} must be an
+integer, and @var{character} must be a character.
+
+If called interactively, this command prompts for @var{character}
+using its Unicode name or its code point. @xref{Inserting Text,,,
+emacs, The GNU Emacs Manual}.
This function does not convert unibyte character codes 128 through 255
to multibyte characters, not even if the current buffer is a multibyte
buffer. @xref{Converting Representations}.
-If @var{inherit} is non-@code{nil}, then the inserted characters inherit
+If @var{inherit} is non-@code{nil}, the inserted characters inherit
sticky text properties from the two characters before and after the
insertion point. @xref{Sticky Properties}.
-@end defun
+@end deffn
@defun insert-buffer-substring from-buffer-or-name &optional start end
This function inserts a portion of buffer @var{from-buffer-or-name}
@end menu
@node Kill Ring Concepts
-@comment node-name, next, previous, up
@subsection Kill Ring Concepts
The kill ring records killed text as strings in a list, most recent
list.
@node Kill Functions
-@comment node-name, next, previous, up
@subsection Functions for Killing
@code{kill-region} is the usual subroutine for killing text. Any
@end defopt
@node Yank Commands
-@comment node-name, next, previous, up
@subsection Functions for Yanking
This section describes higher-level commands for yanking, which are
@end defvar
@node Internals of Kill Ring
-@comment node-name, next, previous, up
@subsection Internals of the Kill Ring
The variable @code{kill-ring} holds the kill ring contents, in the
@end defopt
@node Undo
-@comment node-name, next, previous, up
@section Undo
@cindex redo
@end defopt
@node Filling
-@comment node-name, next, previous, up
@section Filling
@cindex filling text
@end defopt
@node Auto Filling
-@comment node-name, next, previous, up
@section Auto Filling
@cindex filling, automatic
@cindex Auto Fill mode
@end deffn
@node Columns
-@comment node-name, next, previous, up
@section Counting Columns
@cindex columns
@cindex counting columns
@end deffn
@node Indent Tabs
-@comment node-name, next, previous, up
@subsection Adjustable ``Tab Stops''
@cindex tabs stops for indentation
@end deffn
@node Case Changes
-@comment node-name, next, previous, up
@section Case Changes
@cindex case conversion in buffers
A face name (a symbol or string).
@item
-A property list of face attributes. This has the
-form (@var{keyword} @var{value} @dots{}), where each @var{keyword} is a
-face attribute name and @var{value} is a meaningful value for that
-attribute. With this feature, you do not need to create a face each
-time you want to specify a particular attribute for certain text.
-@xref{Face Attributes}.
+A property list of face attributes. This has the form (@var{keyword}
+@var{value} @dots{}), where each @var{keyword} is a face attribute
+name and @var{value} is a meaningful value for that attribute. With
+this feature, you do not need to create a face each time you want to
+specify a particular attribute for certain text.
@item
-A list, where each element uses one of the two forms listed above.
+A list of faces. This specifies a face which is an aggregate of the
+attributes of each of the listed faces. Faces occurring earlier in
+the list have higher priority. Each list element must have one of the
+two above forms (i.e.@: either a face name or a property list of face
+attributes).
@end itemize
Font Lock mode (@pxref{Font Lock Mode}) works in most buffers by
@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.
+++ /dev/null
-#! /usr/bin/perl
-
-# Copyright (C) 2000-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 <http://www.gnu.org/licenses/>.
-
-
-require 5;
-use Getopt::Long;
-
-my $USAGE = <<ENDUSAGE;
-Remove \@tindex lines from files that were already present in previous
-versions.
-
-Usage: $0 [--old=EXT] FILE...
- $0 --help
- $0 --version
-
- --help display this help and exit
- --version print version and exit
- --old=DIR find old files in DIR
-
-The script performs two passes. In the first pass, Texinfo files from
-DIR are scanned for \@tindex lines, and identifiers in them are
-recorded. In a second pass, Texinfo files in the current directory
-are scanned, and \@tindex lines for identifiers that were recorded in
-the first pass are removed. Old file contents are saved in files
-with extension ".orig". A list of modified files and removed \@tindex
-identifiers is printed to stdout at the end.
-ENDUSAGE
-
-sub fatal {
- print STDERR "$0: ", @_, ".\n";
- exit 1;
-}
-
-my $help = 0;
-my $version = 0;
-my $old;
-
-my $rc = GetOptions ('help' => \$help, 'version' => \$version,
- 'old=s' => \$old);
-if ($version) {
- print "0.1\n";
- exit 0;
-} elsif (!$rc || !$old || @ARGV) {
- print $USAGE;
- exit 1;
-} elsif ($help) {
- print $USAGE;
- exit 0;
-}
-
-# Fill the hash %tindex with associations VAR -> COUNT where
-# the keys VAR are identifiers mentioned in @tindex lines in the older
-# files to process and COUNT is the number of times they are seen in
-# the files.
-
-my %tindex;
-my %removed;
-my @old_files = glob "$old/*.texi";
-my @new_files = glob "*.texi";
-fatal ("No Texinfo files found in `$old'") unless @old_files;
-fatal ("No Texinfo files found in current directory") unless @new_files;
-
-print "Scanning old files for \@tindex lines\n";
-foreach $file (@old_files) {
- open (IN, "<$file") or fatal "Cannot open $file: $!";
- while (<IN>) {
- ++$tindex{$1} if /^\s*\@tindex\s+(\S+)/;
- }
- close IN;
-}
-
-# Process current files and remove those @tindex lines which we
-# know were already present in the files scanned above.
-
-print "Removing old \@tindex lines\n";
-foreach $file (@new_files) {
- my $modified = 0;
- my $contents = "";
-
- open (IN, "< $file") or fatal "Cannot open $file.orig for reading: $!";
- while (<IN>) {
- if (/^\s*\@tindex\s+(\S+)/ && $tindex{$1}) {
- ++$removed{$1};
- $modified = 1;
- } else {
- $contents = $contents . $_;
- }
- }
-
- close IN;
-
- if ($modified) {
- print " $file\n";
- system ("cp $file $file.orig") == 0 or fatal "Cannot backup $file: $!";
- open (OUT, ">$file") or fatal "Cannot open $file for writing: $!";
- print OUT $contents;
- close OUT;
- }
-}
-
-# Print a list of identifiers removed.
-
-print "Removed \@tindex commands for:\n";
-my $key;
-foreach $key (keys %removed) {
- print " $key\n";
-}
-
@c Copyright (C) 1990-1993, 1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/tips
-@node Tips, GNU Emacs Internals, GPL, Top
+@node Tips
@appendix Tips and Conventions
@cindex tips for writing Lisp
@cindex standards of coding style
# colors, spurious warnings about names being referenced but not
# existing, etc., dvips | ps2pdf doesn't preserve the page size.
# Instead of creating a special dvips config file, put up with the warnings.
+# (Note added 2012/05: for me, using texlive-2007-57, pdftex
+# doesn't work for reason, but tex does.)
texinfodir=../misc
emacsdir=../emacs
all: vol1.pdf vol2.pdf
-# vol1.texi and vol2.texi specially define \tocreadfilename so we can
-# use our premade .toc's.
+# There's probably a better way to do this, without using a temp file.
+# Something like:
+# tex -jobname=vol1 '\def\SETVOL1 \input{elisp.texi}'
+# but I don't know what to use for "\def\SETVOL1".
+tex1 = sed '/^@setfilename/a\
+@set VOL1' elisp.texi > elisp1tmp.tex && $(tex) -jobname=vol1 elisp1tmp.tex
+
+tex2 = sed '/^@setfilename/a\
+@set VOL2' elisp.texi > elisp2tmp.tex && $(tex) -jobname=vol2 elisp2tmp.tex
+
+# elisp.texi specially defines \tocreadfilename when VOL1 or VOL2 is
+# set, so we can use our premade .toc's.
#
vol1.pdf: elisp1med-fns-ready elisp1med-aux-ready elisp1med-toc-ready
@echo -e "\f Final TeX run for volume 1..."
cp elisp1med-toc-ready elisp1-toc-ready.toc
cp elisp1med-fns-ready vol1.fns
cp elisp1med-aux-ready vol1.aux
- $(tex) vol1.texi
+ $(tex1)
#
vol2.pdf: elisp2med-fns-ready elisp2med-aux-ready elisp2med-toc-ready
@echo "Final TeX run for volume 2..."
cp elisp2med-toc-ready elisp2-toc-ready.toc
cp elisp2med-fns-ready vol2.fns
cp elisp2med-aux-ready vol2.aux
- $(tex) vol2.texi
+ $(tex2)
# \f intermediate toc files.
#
cp elisp1init-toc-ready elisp1-toc-ready.toc
cp elisp1-fns-ready vol1.fns
cp elisp1-aux-ready vol1.aux
- $(tex) vol1.texi
+ $(tex1)
texindex vol1.??
mv vol1.aux elisp1med-aux
mv vol1.toc elisp1med-toc
cp elisp2init-toc-ready elisp2-toc-ready.toc
cp elisp2-fns-ready vol2.fns
cp elisp2-aux-ready vol2.aux
- $(tex) vol2.texi
+ $(tex2)
texindex vol2.??
mv vol2.aux elisp2med-aux
mv vol2.toc elisp2med-toc
# but we run texindex and TeX a second time just to get them closer.
# Otherwise it might take even longer for them to converge.
#
-elisp1-init: vol1.texi
+elisp1-init: elisp.texi
@echo -e "\f Initial TeX run for volume 1..."
rm -f vol1.aux vol1.toc
- $(tex) $<
+ $(tex1)
texindex vol1.??
mv vol1.aux elisp1-aux
mv vol1.toc elisp1-toc
touch $@
#
-elisp2-init: vol2.texi
+elisp2-init: elisp.texi
@echo "Initial TeX run for volume 2..."
rm -f vol2.aux vol2.toc
- $(tex) $<
+ $(tex2)
texindex vol2.??
mv vol2.aux elisp2-aux
mv vol2.toc elisp2-toc
+++ /dev/null
-;; Auxiliary functions for preparing a two volume manual.
-
-;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
-
-;; --rjc 30mar92
-
-;; This file 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.
-
-;; This file 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 file. If not, see <http://www.gnu.org/licenses/>.
-
-
-(defun volume-aux-markup (arg)
- "Append `vol. NUMBER' to page number.
-Apply to aux file that you save.
-Then insert marked file into other volume's .aux file."
- (interactive "sType volume number, 1 or 2: " )
- (goto-char (point-min))
- (while (search-forward "-pg" nil t)
- (end-of-line 1)
- (delete-backward-char 1 nil)
- (insert ", vol.'tie" arg "}")))
-
-(defun volume-index-markup (arg)
- "Prepend `NUMBER:' to page number. Use Roman Numeral.
-Apply only to unsorted index file,
-Then insert marked file into other volume's unsorted index file.
-Then run texindex on that file and save."
- (interactive
- "sType volume number, roman number I or II: " )
- (goto-char (point-min))
- (while (search-forward "\\entry" nil t)
- (search-forward "}{" (save-excursion (end-of-line) (point)) nil)
- (insert arg ":")))
-
-(defun volume-numbers-toc-markup (arg)
- (interactive
- "sType volume number, roman number I or II: " )
- (goto-char (point-min))
- (while (search-forward "chapentry" nil t)
- (end-of-line)
- (search-backward "{" nil t)
- (forward-char 1)
- (insert arg ":")))
-
-(defun volume-header-toc-markup ()
- "Insert Volume I and Volume II text into .toc file.
-NOTE: this auxiliary function is file specific.
-This is for the *Elisp Ref Manual*."
- (interactive)
- (goto-char (point-min))
- (insert "\\unnumbchapentry {Volume 1}{}\n\\unnumbchapentry {}{}\n")
- (search-forward "\\unnumbchapentry {Index}")
- (forward-line 1)
- (insert
- "\\unnumbchapentry {}{}\n\\unnumbchapentry {}{}\n\\unnumbchapentry {}{}\n\\unnumbchapentry {}{}\n\\unnumbchapentry {Volume 2}{}\n\\unnumbchapentry {}{}\n"))
-
-
-;;; In batch mode, you cannot call functions with args; hence this kludge:
-
-(defun volume-aux-markup-1 () (volume-aux-markup "1"))
-(defun volume-aux-markup-2 () (volume-aux-markup "2"))
-
-(defun volume-index-markup-I () (volume-index-markup "I"))
-(defun volume-index-markup-II () (volume-index-markup "II"))
-
-(defun volume-numbers-toc-markup-I () (volume-numbers-toc-markup "I"))
-(defun volume-numbers-toc-markup-II () (volume-numbers-toc-markup "II"))
-
-;;; two.el ends here
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990-1995, 1998-2012 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/variables
-@node Variables, Functions, Control Structures, Top
+@node Variables
@chapter Variables
@cindex variable
initializes it only if it is originally void.
To define a customizable variable, you should use @code{defcustom}
-(which calls @code{defvar} as a subroutine). @xref{Customization}.
+(which calls @code{defvar} as a subroutine). @xref{Variable
+Definitions}.
@defspec defvar symbol [value [doc-string]]
This special form defines @var{symbol} as a variable. Note that
@end defun
@defun local-variable-if-set-p variable &optional buffer
-This returns @code{t} if @var{variable} will become buffer-local in
-buffer @var{buffer} (which defaults to the current buffer) if it is
-set there.
+This returns @code{t} if @var{variable} either has a buffer-local
+value in buffer @var{buffer}, or is automatically buffer-local.
+Otherwise, it returns @code{nil}. If omitted or @code{nil},
+@var{buffer} defaults to the current buffer.
@end defun
@defun buffer-local-value variable buffer
+++ /dev/null
-\input texinfo @c -*-texinfo-*-
-@c This file is used for printing the GNU Emacs Lisp Reference Manual
-@c in two volumes. It is a modified version of elisp.texi.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
-@c Free Software Foundation, Inc.
-@c %**start of header
-@setfilename elisp
-@settitle GNU Emacs Lisp Reference Manual: Volume 1
-@c %**end of header
-
-@c See two-volume-cross-refs.txt.
-@tex
-\message{Formatting for two volume edition...Volume 1...}
-%
-% Read special toc file, set up in two-volume.make.
-\gdef\tocreadfilename{elisp1-toc-ready.toc}
-%
-% Don't make outlines, they're not needed and \readdatafile can't pay
-% attention to the special definition above.
-\global\let\pdfmakeoutlines=\relax
-%
-% Start volume 1 chapter numbering at 1; this must be listed as chapno0.
-\global\chapno=0
-@end tex
-
-@c Version of the manual and of Emacs.
-@set VERSION 3.1
-@include emacsver.texi
-@set DATE May 2012
-
-@dircategory Emacs
-@direntry
-* Elisp: (elisp). The Emacs Lisp Reference Manual.
-@end direntry
-
-@c in general, keep the following line commented out, unless doing a
-@c copy of this manual that will be published. the manual should go
-@c onto the distribution in the full, 8.5 x 11" size.
-@set smallbook
-
-@ifset smallbook
-@smallbook
-@end ifset
-
-@c per rms and peterb, use 10pt fonts for the main text, mostly to
-@c save on paper cost.
-@c Do this inside @tex for now, so current makeinfo does not complain.
-@tex
-@ifset smallbook
-@fonttextsize 10
-@end ifset
-\global\hbadness=6666 % don't worry about not-too-underfull boxes
-@end tex
-
-@c Combine indices.
-@synindex cp fn
-@syncodeindex vr fn
-@syncodeindex ky fn
-@syncodeindex pg fn
-@c We use the "type index" to index new functions and variables.
-@c @syncodeindex tp fn
-
-@copying
-This is edition @value{VERSION} of the GNU Emacs Lisp Reference Manual,@*
-corresponding to Emacs version @value{EMACSVER}.
-
-Copyright @copyright{} 1990-1996, 1998-2012 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.3 or
-any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License,'' with the
-Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover
-Texts as in (a) below. A copy of the license is included in the
-section entitled ``GNU Free Documentation License.''
-
-(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
-modify this GNU manual. Buying copies from the FSF supports it in
-developing GNU and promoting software freedom.''
-@end quotation
-@end copying
-
-@titlepage
-@title GNU Emacs Lisp Reference Manual
-@subtitle Volume 1
-@subtitle For Emacs Version @value{EMACSVER}
-@subtitle Revision @value{VERSION}, @value{DATE}
-
-@author by Bil Lewis, Dan LaLiberte, Richard Stallman,
-@author the GNU Manual Group, et al.
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-
-@sp 2
-
-Published by the Free Software Foundation @*
-51 Franklin St, Fifth Floor @*
-Boston, MA 02110-1301 @*
-USA @*
-ISBN 1-882114-74-4
-
-@sp 2
-Cover art by Etienne Suvasa.
-@end titlepage
-
-
-@c Print the tables of contents
-@summarycontents
-@contents
-
-
-@ifnottex
-@node Top, Introduction, (dir), (dir)
-@top Emacs Lisp
-
-This Info file contains edition @value{VERSION} of the GNU Emacs Lisp
-Reference Manual, corresponding to GNU Emacs version @value{EMACSVER}.
-@end ifnottex
-
-@menu
-* Introduction:: Introduction and conventions used.
-
-* Lisp Data Types:: Data types of objects in Emacs Lisp.
-* Numbers:: Numbers and arithmetic functions.
-* Strings and Characters:: Strings, and functions that work on them.
-* Lists:: Lists, cons cells, and related functions.
-* Sequences Arrays Vectors:: Lists, strings and vectors are called sequences.
- Certain functions act on any kind of sequence.
- The description of vectors is here as well.
-* Hash Tables:: Very fast lookup-tables.
-* Symbols:: Symbols represent names, uniquely.
-
-* Evaluation:: How Lisp expressions are evaluated.
-* Control Structures:: Conditionals, loops, nonlocal exits.
-* Variables:: Using symbols in programs to stand for values.
-* Functions:: A function is a Lisp program
- that can be invoked from other functions.
-* Macros:: Macros are a way to extend the Lisp language.
-* Customization:: Making variables and faces customizable.
-
-* Loading:: Reading files of Lisp code into Lisp.
-* Byte Compilation:: Compilation makes programs run faster.
-* Advising Functions:: Adding to the definition of a function.
-* Debugging:: Tools and tips for debugging Lisp programs.
-
-* Read and Print:: Converting Lisp objects to text and back.
-* Minibuffers:: Using the minibuffer to read input.
-* Command Loop:: How the editor command loop works,
- and how you can call its subroutines.
-* Keymaps:: Defining the bindings from keys to commands.
-* Modes:: Defining major and minor modes.
-* Documentation:: Writing and using documentation strings.
-
-* Files:: Accessing files.
-* Backups and Auto-Saving:: Controlling how backups and auto-save
- files are made.
-* Buffers:: Creating and using buffer objects.
-* Windows:: Manipulating windows and displaying buffers.
-* Frames:: Making multiple system-level windows.
-* Positions:: Buffer positions and motion functions.
-* Markers:: Markers represent positions and update
- automatically when the text is changed.
-
-* Text:: Examining and changing text in buffers.
-* Non-ASCII Characters:: Non-ASCII text in buffers and strings.
-* Searching and Matching:: Searching buffers for strings or regexps.
-* Syntax Tables:: The syntax table controls word and list parsing.
-* Abbrevs:: How Abbrev mode works, and its data structures.
-
-* Processes:: Running and communicating with subprocesses.
-* Display:: Features for controlling the screen display.
-* System Interface:: Getting the user id, system type, environment
- variables, and other such things.
-
-* Packaging:: Preparing Lisp code for distribution.
-
-Appendices
-
-* Antinews:: Info for users downgrading to Emacs 23.
-* GNU Free Documentation License:: The license for this documentation.
-* GPL:: Conditions for copying and changing GNU Emacs.
-* Tips:: Advice and coding conventions for Emacs Lisp.
-* GNU Emacs Internals:: Building and dumping Emacs;
- internal data structures.
-* Standard Errors:: List of some standard error symbols.
-* Standard Keymaps:: List of some standard keymaps.
-* Standard Hooks:: List of some standard hook variables.
-
-* Index:: Index including concepts, functions, variables,
- and other terms.
-
-@ignore
-* New Symbols:: New functions and variables in Emacs @value{EMACSVER}.
-@end ignore
-
-@c Do NOT modify the following 3 lines! They must have this form to
-@c be correctly identified by `texinfo-multiple-files-update'. In
-@c particular, the detailed menu header line MUST be identical to the
-@c value of `texinfo-master-menu-header'. See texnfo-upd.el.
-
-@detailmenu
- --- The Detailed Node Listing ---
- ---------------------------------
-
-Here are other nodes that are subnodes of those already listed,
-mentioned here so you can get to them in one step:
-
-Introduction
-
-* Caveats:: Flaws and a request for help.
-* Lisp History:: Emacs Lisp is descended from Maclisp.
-* Conventions:: How the manual is formatted.
-* Version Info:: Which Emacs version is running?
-* Acknowledgements:: The authors, editors, and sponsors of this manual.
-
-Conventions
-
-* Some Terms:: Explanation of terms we use in this manual.
-* nil and t:: How the symbols @code{nil} and @code{t} are used.
-* Evaluation Notation:: The format we use for examples of evaluation.
-* Printing Notation:: The format we use when examples print text.
-* Error Messages:: The format we use for examples of errors.
-* Buffer Text Notation:: The format we use for buffer contents in examples.
-* Format of Descriptions:: Notation for describing functions, variables, etc.
-
-Format of Descriptions
-
-* A Sample Function Description:: A description of an imaginary
- function, @code{foo}.
-* A Sample Variable Description:: A description of an imaginary
- variable, @code{electric-future-map}.
-
-Lisp Data Types
-
-* Printed Representation:: How Lisp objects are represented as text.
-* Comments:: Comments and their formatting conventions.
-* Programming Types:: Types found in all Lisp systems.
-* Editing Types:: Types specific to Emacs.
-* Circular Objects:: Read syntax for circular structure.
-* Type Predicates:: Tests related to types.
-* Equality Predicates:: Tests of equality between any two objects.
-
-Programming Types
-
-* Integer Type:: Numbers without fractional parts.
-* Floating Point Type:: Numbers with fractional parts and with a large range.
-* Character Type:: The representation of letters, numbers and
- control characters.
-* Symbol Type:: A multi-use object that refers to a function,
- variable, or property list, and has a unique identity.
-* Sequence Type:: Both lists and arrays are classified as sequences.
-* Cons Cell Type:: Cons cells, and lists (which are made from cons cells).
-* Array Type:: Arrays include strings and vectors.
-* String Type:: An (efficient) array of characters.
-* Vector Type:: One-dimensional arrays.
-* Char-Table Type:: One-dimensional sparse arrays indexed by characters.
-* Bool-Vector Type:: One-dimensional arrays of @code{t} or @code{nil}.
-* Hash Table Type:: Super-fast lookup tables.
-* Function Type:: A piece of executable code you can call from elsewhere.
-* Macro Type:: A method of expanding an expression into another
- expression, more fundamental but less pretty.
-* Primitive Function Type:: A function written in C, callable from Lisp.
-* Byte-Code Type:: A function written in Lisp, then compiled.
-* Autoload Type:: A type used for automatically loading seldom-used
- functions.
-
-Character Type
-
-* Basic Char Syntax:: Syntax for regular characters.
-* General Escape Syntax:: How to specify characters by their codes.
-* Ctl-Char Syntax:: Syntax for control characters.
-* Meta-Char Syntax:: Syntax for meta-characters.
-* Other Char Bits:: Syntax for hyper-, super-, and alt-characters.
-
-Cons Cell and List Types
-
-* Box Diagrams:: Drawing pictures of lists.
-* Dotted Pair Notation:: A general syntax for cons cells.
-* Association List Type:: A specially constructed list.
-
-String Type
-
-* Syntax for Strings:: How to specify Lisp strings.
-* Non-ASCII in Strings:: International characters in strings.
-* Nonprinting Characters:: Literal unprintable characters in strings.
-* Text Props and Strings:: Strings with text properties.
-
-Editing Types
-
-* Buffer Type:: The basic object of editing.
-* Marker Type:: A position in a buffer.
-* Window Type:: Buffers are displayed in windows.
-* Frame Type:: Windows subdivide frames.
-* Terminal Type:: A terminal device displays frames.
-* Window Configuration Type:: Recording the way a frame is subdivided.
-* Frame Configuration Type:: Recording the status of all frames.
-* Process Type:: A subprocess of Emacs running on the underlying OS.
-* Stream Type:: Receive or send characters.
-* Keymap Type:: What function a keystroke invokes.
-* Overlay Type:: How an overlay is represented.
-* Font Type:: Fonts for displaying text.
-
-Numbers
-
-* Integer Basics:: Representation and range of integers.
-* Float Basics:: Representation and range of floating point.
-* Predicates on Numbers:: Testing for numbers.
-* Comparison of Numbers:: Equality and inequality predicates.
-* Numeric Conversions:: Converting float to integer and vice versa.
-* Arithmetic Operations:: How to add, subtract, multiply and divide.
-* Rounding Operations:: Explicitly rounding floating point numbers.
-* Bitwise Operations:: Logical and, or, not, shifting.
-* Math Functions:: Trig, exponential and logarithmic functions.
-* Random Numbers:: Obtaining random integers, predictable or not.
-
-Strings and Characters
-
-* String Basics:: Basic properties of strings and characters.
-* Predicates for Strings:: Testing whether an object is a string or char.
-* Creating Strings:: Functions to allocate new strings.
-* Modifying Strings:: Altering the contents of an existing string.
-* Text Comparison:: Comparing characters or strings.
-* String Conversion:: Converting to and from characters and strings.
-* Formatting Strings:: @code{format}: Emacs's analogue of @code{printf}.
-* Case Conversion:: Case conversion functions.
-* Case Tables:: Customizing case conversion.
-
-Lists
-
-* Cons Cells:: How lists are made out of cons cells.
-* List-related Predicates:: Is this object a list? Comparing two lists.
-* List Elements:: Extracting the pieces of a list.
-* Building Lists:: Creating list structure.
-* List Variables:: Modifying lists stored in variables.
-* Modifying Lists:: Storing new pieces into an existing list.
-* Sets And Lists:: A list can represent a finite mathematical set.
-* Association Lists:: A list can represent a finite relation or mapping.
-* Rings:: Managing a fixed-size ring of objects.
-
-Modifying Existing List Structure
-
-* Setcar:: Replacing an element in a list.
-* Setcdr:: Replacing part of the list backbone.
- This can be used to remove or add elements.
-* Rearrangement:: Reordering the elements in a list; combining lists.
-
-Sequences, Arrays, and Vectors
-
-* Sequence Functions:: Functions that accept any kind of sequence.
-* Arrays:: Characteristics of arrays in Emacs Lisp.
-* Array Functions:: Functions specifically for arrays.
-* Vectors:: Special characteristics of Emacs Lisp vectors.
-* Vector Functions:: Functions specifically for vectors.
-* Char-Tables:: How to work with char-tables.
-* Bool-Vectors:: How to work with bool-vectors.
-
-Hash Tables
-
-* Creating Hash:: Functions to create hash tables.
-* Hash Access:: Reading and writing the hash table contents.
-* Defining Hash:: Defining new comparison methods.
-* Other Hash:: Miscellaneous.
-
-Symbols
-
-* Symbol Components:: Symbols have names, values, function definitions
- and property lists.
-* Definitions:: A definition says how a symbol will be used.
-* Creating Symbols:: How symbols are kept unique.
-* Property Lists:: Each symbol has a property list
- for recording miscellaneous information.
-
-Property Lists
-
-* Plists and Alists:: Comparison of the advantages of property
- lists and association lists.
-* Symbol Plists:: Functions to access symbols' property lists.
-* Other Plists:: Accessing property lists stored elsewhere.
-
-Evaluation
-
-* Intro Eval:: Evaluation in the scheme of things.
-* Forms:: How various sorts of objects are evaluated.
-* Quoting:: Avoiding evaluation (to put constants in
- the program).
-* Backquote:: Easier construction of list structure.
-* Eval:: How to invoke the Lisp interpreter explicitly.
-
-Kinds of Forms
-
-* Self-Evaluating Forms:: Forms that evaluate to themselves.
-* Symbol Forms:: Symbols evaluate as variables.
-* Classifying Lists:: How to distinguish various sorts of list forms.
-* Function Indirection:: When a symbol appears as the car of a list,
- we find the real function via the symbol.
-* Function Forms:: Forms that call functions.
-* Macro Forms:: Forms that call macros.
-* Special Forms:: "Special forms" are idiosyncratic primitives,
- most of them extremely important.
-* Autoloading:: Functions set up to load files
- containing their real definitions.
-
-Control Structures
-
-* Sequencing:: Evaluation in textual order.
-* Conditionals:: @code{if}, @code{cond}, @code{when}, @code{unless}.
-* Combining Conditions:: @code{and}, @code{or}, @code{not}.
-* Iteration:: @code{while} loops.
-* Nonlocal Exits:: Jumping out of a sequence.
-
-Nonlocal Exits
-
-* Catch and Throw:: Nonlocal exits for the program's own purposes.
-* Examples of Catch:: Showing how such nonlocal exits can be written.
-* Errors:: How errors are signaled and handled.
-* Cleanups:: Arranging to run a cleanup form if an
- error happens.
-
-Errors
-
-* Signaling Errors:: How to report an error.
-* Processing of Errors:: What Emacs does when you report an error.
-* Handling Errors:: How you can trap errors and continue execution.
-* Error Symbols:: How errors are classified for trapping them.
-
-Variables
-
-* Global Variables:: Variable values that exist permanently, everywhere.
-* Constant Variables:: Certain "variables" have values that never change.
-* Local Variables:: Variable values that exist only temporarily.
-* Void Variables:: Symbols that lack values.
-* Defining Variables:: A definition says a symbol is used as a variable.
-* Tips for Defining:: Things you should think about when you
- define a variable.
-* Accessing Variables:: Examining values of variables whose names
- are known only at run time.
-* Setting Variables:: Storing new values in variables.
-* Variable Scoping:: How Lisp chooses among local and global values.
-* Buffer-Local Variables:: Variable values in effect only in one buffer.
-* File Local Variables:: Handling local variable lists in files.
-* Directory Local Variables:: Local variables common to all files in a
- directory.
-* Frame-Local Variables:: Frame-local bindings for variables.
-* Variable Aliases:: Variables that are aliases for other variables.
-* Variables with Restricted Values:: Non-constant variables whose value can
- @emph{not} be an arbitrary Lisp object.
-
-Scoping Rules for Variable Bindings
-
-* Scope:: Scope means where in the program a value
- is visible. Comparison with other languages.
-* Extent:: Extent means how long in time a value exists.
-* Impl of Scope:: Two ways to implement dynamic scoping.
-* Using Scoping:: How to use dynamic scoping carefully and
- avoid problems.
-
-Buffer-Local Variables
-
-* Intro to Buffer-Local:: Introduction and concepts.
-* Creating Buffer-Local:: Creating and destroying buffer-local bindings.
-* Default Value:: The default value is seen in buffers
- that don't have their own buffer-local values.
-
-Functions
-
-* What Is a Function:: Lisp functions vs. primitives; terminology.
-* Lambda Expressions:: How functions are expressed as Lisp objects.
-* Function Names:: A symbol can serve as the name of a function.
-* Defining Functions:: Lisp expressions for defining functions.
-* Calling Functions:: How to use an existing function.
-* Mapping Functions:: Applying a function to each element of a list, etc.
-* Anonymous Functions:: Lambda expressions are functions with no names.
-* Function Cells:: Accessing or setting the function definition
- of a symbol.
-* Closures:: Functions that enclose a lexical environment.
-* Obsolete Functions:: Declaring functions obsolete.
-* Inline Functions:: Defining functions that the compiler
- will expand inline.
-* Declaring Functions:: Telling the compiler that a function is defined.
-* Function Safety:: Determining whether a function is safe to call.
-* Related Topics:: Cross-references to specific Lisp primitives
- that have a special bearing on how
- functions work.
-
-Lambda Expressions
-
-* Lambda Components:: The parts of a lambda expression.
-* Simple Lambda:: A simple example.
-* Argument List:: Details and special features of argument lists.
-* Function Documentation:: How to put documentation in a function.
-
-Macros
-
-* Simple Macro:: A basic example.
-* Expansion:: How, when and why macros are expanded.
-* Compiling Macros:: How macros are expanded by the compiler.
-* Defining Macros:: How to write a macro definition.
-* Problems with Macros:: Don't evaluate the macro arguments too many times.
- Don't hide the user's variables.
-* Indenting Macros:: Specifying how to indent macro calls.
-
-Common Problems Using Macros
-
-* Wrong Time:: Do the work in the expansion, not in the macro.
-* Argument Evaluation:: The expansion should evaluate each macro arg once.
-* Surprising Local Vars:: Local variable bindings in the expansion
- require special care.
-* Eval During Expansion:: Don't evaluate them; put them in the expansion.
-* Repeated Expansion:: Avoid depending on how many times expansion is done.
-
-Customization Settings
-
-* Common Keywords:: Common keyword arguments for all kinds of
- customization declarations.
-* Group Definitions:: Writing customization group definitions.
-* Variable Definitions:: Declaring user options.
-* Customization Types:: Specifying the type of a user option.
-* Applying Customizations:: Functions to apply customization settings.
-* Custom Themes:: Writing Custom themes.
-
-Customization Types
-
-* Simple Types:: Simple customization types: sexp, integer, number,
- string, file, directory, alist.
-* Composite Types:: Build new types from other types or data.
-* Splicing into Lists:: Splice elements into list with @code{:inline}.
-* Type Keywords:: Keyword-argument pairs in a customization type.
-* Defining New Types:: Give your type a name.
-
-Loading
-
-* How Programs Do Loading:: The @code{load} function and others.
-* Load Suffixes:: Details about the suffixes that @code{load} tries.
-* Library Search:: Finding a library to load.
-* Loading Non-ASCII:: Non-@acronym{ASCII} characters in Emacs Lisp files.
-* Autoload:: Setting up a function to autoload.
-* Repeated Loading:: Precautions about loading a file twice.
-* Named Features:: Loading a library if it isn't already loaded.
-* Where Defined:: Finding which file defined a certain symbol.
-* Unloading:: How to "unload" a library that was loaded.
-* Hooks for Loading:: Providing code to be run when
- particular libraries are loaded.
-
-Byte Compilation
-
-* Speed of Byte-Code:: An example of speedup from byte compilation.
-* Compilation Functions:: Byte compilation functions.
-* Docs and Compilation:: Dynamic loading of documentation strings.
-* Dynamic Loading:: Dynamic loading of individual functions.
-* Eval During Compile:: Code to be evaluated when you compile.
-* Compiler Errors:: Handling compiler error messages.
-* Byte-Code Objects:: The data type used for byte-compiled functions.
-* Disassembly:: Disassembling byte-code; how to read byte-code.
-
-Advising Emacs Lisp Functions
-
-* Simple Advice:: A simple example to explain the basics of advice.
-* Defining Advice:: Detailed description of @code{defadvice}.
-* Around-Advice:: Wrapping advice around a function's definition.
-* Computed Advice:: ...is to @code{defadvice} as @code{fset} is to @code{defun}.
-* Activation of Advice:: Advice doesn't do anything until you activate it.
-* Enabling Advice:: You can enable or disable each piece of advice.
-* Preactivation:: Preactivation is a way of speeding up the
- loading of compiled advice.
-* Argument Access in Advice:: How advice can access the function's arguments.
-* Combined Definition:: How advice is implemented.
-
-Debugging Lisp Programs
-
-* Debugger:: A debugger for the Emacs Lisp evaluator.
-* Edebug:: A source-level Emacs Lisp debugger.
-* Syntax Errors:: How to find syntax errors.
-* Test Coverage:: Ensuring you have tested all branches in your code.
-
-The Lisp Debugger
-
-* Error Debugging:: Entering the debugger when an error happens.
-* Infinite Loops:: Stopping and debugging a program that doesn't exit.
-* Function Debugging:: Entering it when a certain function is called.
-* Explicit Debug:: Entering it at a certain point in the program.
-* Using Debugger:: What the debugger does; what you see while in it.
-* Debugger Commands:: Commands used while in the debugger.
-* Invoking the Debugger:: How to call the function @code{debug}.
-* Internals of Debugger:: Subroutines of the debugger, and global variables.
-
-Edebug
-
-* Using Edebug:: Introduction to use of Edebug.
-* Instrumenting:: You must instrument your code
- in order to debug it with Edebug.
-* Edebug Execution Modes:: Execution modes, stopping more or less often.
-* Jumping:: Commands to jump to a specified place.
-* Edebug Misc:: Miscellaneous commands.
-* Breaks:: Setting breakpoints to make the program stop.
-* Trapping Errors:: Trapping errors with Edebug.
-* Edebug Views:: Views inside and outside of Edebug.
-* Edebug Eval:: Evaluating expressions within Edebug.
-* Eval List:: Expressions whose values are displayed
- each time you enter Edebug.
-* Printing in Edebug:: Customization of printing.
-* Trace Buffer:: How to produce trace output in a buffer.
-* Coverage Testing:: How to test evaluation coverage.
-* The Outside Context:: Data that Edebug saves and restores.
-* Edebug and Macros:: Specifying how to handle macro calls.
-* Edebug Options:: Option variables for customizing Edebug.
-
-Breaks
-
-* Breakpoints:: Breakpoints at stop points.
-* Global Break Condition:: Breaking on an event.
-* Source Breakpoints:: Embedding breakpoints in source code.
-
-The Outside Context
-
-* Checking Whether to Stop::When Edebug decides what to do.
-* Edebug Display Update:: When Edebug updates the display.
-* Edebug Recursive Edit:: When Edebug stops execution.
-
-Edebug and Macros
-
-* Instrumenting Macro Calls::The basic problem.
-* Specification List:: How to specify complex patterns of evaluation.
-* Backtracking:: What Edebug does when matching fails.
-* Specification Examples:: To help understand specifications.
-
-Debugging Invalid Lisp Syntax
-
-* Excess Open:: How to find a spurious open paren or missing close.
-* Excess Close:: How to find a spurious close paren or missing open.
-
-Reading and Printing Lisp Objects
-
-* Streams Intro:: Overview of streams, reading and printing.
-* Input Streams:: Various data types that can be used as
- input streams.
-* Input Functions:: Functions to read Lisp objects from text.
-* Output Streams:: Various data types that can be used as
- output streams.
-* Output Functions:: Functions to print Lisp objects as text.
-* Output Variables:: Variables that control what the printing
- functions do.
-
-Minibuffers
-
-* Intro to Minibuffers:: Basic information about minibuffers.
-* Text from Minibuffer:: How to read a straight text string.
-* Object from Minibuffer:: How to read a Lisp object or expression.
-* Minibuffer History:: Recording previous minibuffer inputs
- so the user can reuse them.
-* Initial Input:: Specifying initial contents for the minibuffer.
-* Completion:: How to invoke and customize completion.
-* Yes-or-No Queries:: Asking a question with a simple answer.
-* Multiple Queries:: Asking a series of similar questions.
-* Reading a Password:: Reading a password from the terminal.
-* Minibuffer Commands:: Commands used as key bindings in minibuffers.
-* Minibuffer Windows:: Operating on the special minibuffer windows.
-* Minibuffer Contents:: How such commands access the minibuffer text.
-* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
-* Minibuffer Misc:: Various customization hooks and variables.
-
-Completion
-
-* Basic Completion:: Low-level functions for completing strings.
- (These are too low level to use the minibuffer.)
-* Minibuffer Completion:: Invoking the minibuffer with completion.
-* Completion Commands:: Minibuffer commands that do completion.
-* High-Level Completion:: Convenient special cases of completion
- (reading buffer names, variable names, etc.).
-* Reading File Names:: Using completion to read file names and
- shell commands.
-* Completion Variables:: Variables controlling completion behavior.
-* Programmed Completion:: Writing your own completion function.
-* Completion in Buffers:: Completing text in ordinary buffers.
-
-Command Loop
-
-* Command Overview:: How the command loop reads commands.
-* Defining Commands:: Specifying how a function should read arguments.
-* Interactive Call:: Calling a command, so that it will read arguments.
-* Distinguish Interactive:: Making a command distinguish interactive calls.
-* Command Loop Info:: Variables set by the command loop for you to examine.
-* Adjusting Point:: Adjustment of point after a command.
-* Input Events:: What input looks like when you read it.
-* Reading Input:: How to read input events from the keyboard or mouse.
-* Special Events:: Events processed immediately and individually.
-* Waiting:: Waiting for user input or elapsed time.
-* Quitting:: How @kbd{C-g} works. How to catch or defer quitting.
-* Prefix Command Arguments:: How the commands to set prefix args work.
-* Recursive Editing:: Entering a recursive edit,
- and why you usually shouldn't.
-* Disabling Commands:: How the command loop handles disabled commands.
-* Command History:: How the command history is set up, and how accessed.
-* Keyboard Macros:: How keyboard macros are implemented.
-
-Defining Commands
-
-* Using Interactive:: General rules for @code{interactive}.
-* Interactive Codes:: The standard letter-codes for reading arguments
- in various ways.
-* Interactive Examples:: Examples of how to read interactive arguments.
-
-Input Events
-
-* Keyboard Events:: Ordinary characters--keys with symbols on them.
-* Function Keys:: Function keys--keys with names, not symbols.
-* Mouse Events:: Overview of mouse events.
-* Click Events:: Pushing and releasing a mouse button.
-* Drag Events:: Moving the mouse before releasing the button.
-* Button-Down Events:: A button was pushed and not yet released.
-* Repeat Events:: Double and triple click (or drag, or down).
-* Motion Events:: Just moving the mouse, not pushing a button.
-* Focus Events:: Moving the mouse between frames.
-* Misc Events:: Other events the system can generate.
-* Event Examples:: Examples of the lists for mouse events.
-* Classifying Events:: Finding the modifier keys in an event symbol.
- Event types.
-* Accessing Mouse:: Functions to extract info from mouse events.
-* Accessing Scroll:: Functions to get info from scroll bar events.
-* Strings of Events:: Special considerations for putting
- keyboard character events in a string.
-
-Reading Input
-
-* Key Sequence Input:: How to read one key sequence.
-* Reading One Event:: How to read just one event.
-* Event Mod:: How Emacs modifies events as they are read.
-* Invoking the Input Method:: How reading an event uses the input method.
-* Quoted Character Input:: Asking the user to specify a character.
-* Event Input Misc:: How to reread or throw away input events.
-
-Keymaps
-
-* Key Sequences:: Key sequences as Lisp objects.
-* Keymap Basics:: Basic concepts of keymaps.
-* Format of Keymaps:: What a keymap looks like as a Lisp object.
-* Creating Keymaps:: Functions to create and copy keymaps.
-* Inheritance and Keymaps:: How one keymap can inherit the bindings
- of another keymap.
-* Prefix Keys:: Defining a key with a keymap as its definition.
-* Active Keymaps:: How Emacs searches the active keymaps
- for a key binding.
-* Searching Keymaps:: A pseudo-Lisp summary of searching active maps.
-* Controlling Active Maps:: Each buffer has a local keymap
- to override the standard (global) bindings.
- A minor mode can also override them.
-* Key Lookup:: Finding a key's binding in one keymap.
-* Functions for Key Lookup:: How to request key lookup.
-* Changing Key Bindings:: Redefining a key in a keymap.
-* Remapping Commands:: A keymap can translate one command to another.
-* Translation Keymaps:: Keymaps for translating sequences of events.
-* Key Binding Commands:: Interactive interfaces for redefining keys.
-* Scanning Keymaps:: Looking through all keymaps, for printing help.
-* Menu Keymaps:: Defining a menu as a keymap.
-
-Menu Keymaps
-
-* Defining Menus:: How to make a keymap that defines a menu.
-* Mouse Menus:: How users actuate the menu with the mouse.
-* Keyboard Menus:: How users actuate the menu with the keyboard.
-* Menu Example:: Making a simple menu.
-* Menu Bar:: How to customize the menu bar.
-* Tool Bar:: A tool bar is a row of images.
-* Modifying Menus:: How to add new items to a menu.
-
-Defining Menus
-
-* Simple Menu Items:: A simple kind of menu key binding,
- limited in capabilities.
-* Extended Menu Items:: More powerful menu item definitions
- let you specify keywords to enable
- various features.
-* Menu Separators:: Drawing a horizontal line through a menu.
-* Alias Menu Items:: Using command aliases in menu items.
-* Toolkit Differences:: Not all toolkits provide the same features.
-
-Major and Minor Modes
-
-* Hooks:: How to use hooks; how to write code that provides hooks.
-* Major Modes:: Defining major modes.
-* Minor Modes:: Defining minor modes.
-* Mode Line Format:: Customizing the text that appears in the mode line.
-* Imenu:: Providing a menu of definitions made in a buffer.
-* Font Lock Mode:: How modes can highlight text according to syntax.
-* Auto-Indentation:: How to teach Emacs to indent for a major mode.
-* Desktop Save Mode:: How modes can have buffer state saved between
- Emacs sessions.
-
-Hooks
-
-* Running Hooks:: How to run a hook.
-* Setting Hooks:: How to put functions on a hook, or remove them.
-
-Major Modes
-
-* Major Mode Conventions:: Coding conventions for keymaps, etc.
-* Auto Major Mode:: How Emacs chooses the major mode automatically.
-* Mode Help:: Finding out how to use a mode.
-* Derived Modes:: Defining a new major mode based on another major
- mode.
-* Basic Major Modes:: Modes that other modes are often derived from.
-* Mode Hooks:: Hooks run at the end of major mode functions.
-* Tabulated List Mode:: Parent mode for buffers containing tabulated data.
-* Generic Modes:: Defining a simple major mode that supports
- comment syntax and Font Lock mode.
-* Example Major Modes:: Text mode and Lisp modes.
-
-Minor Modes
-
-* Minor Mode Conventions:: Tips for writing a minor mode.
-* Keymaps and Minor Modes:: How a minor mode can have its own keymap.
-* Defining Minor Modes:: A convenient facility for defining minor modes.
-
-Mode Line Format
-
-* Mode Line Basics:: Basic ideas of mode line control.
-* Mode Line Data:: The data structure that controls the mode line.
-* Mode Line Top:: The top level variable, mode-line-format.
-* Mode Line Variables:: Variables used in that data structure.
-* %-Constructs:: Putting information into a mode line.
-* Properties in Mode:: Using text properties in the mode line.
-* Header Lines:: Like a mode line, but at the top.
-* Emulating Mode Line:: Formatting text as the mode line would.
-
-Font Lock Mode
-
-* Font Lock Basics:: Overview of customizing Font Lock.
-* Search-based Fontification:: Fontification based on regexps.
-* Customizing Keywords:: Customizing search-based fontification.
-* Other Font Lock Variables:: Additional customization facilities.
-* Levels of Font Lock:: Each mode can define alternative levels
- so that the user can select more or less.
-* Precalculated Fontification:: How Lisp programs that produce the buffer
- contents can also specify how to fontify it.
-* Faces for Font Lock:: Special faces specifically for Font Lock.
-* Syntactic Font Lock:: Fontification based on syntax tables.
-* Multiline Font Lock:: How to coerce Font Lock into properly
- highlighting multiline constructs.
-
-Multiline Font Lock Constructs
-
-* Font Lock Multiline:: Marking multiline chunks with a text property.
-* Region to Refontify:: Controlling which region gets refontified
- after a buffer change.
-
-Automatic Indentation of code
-
-* SMIE:: A simple minded indentation engine.
-
-Simple Minded Indentation Engine
-
-* SMIE setup:: SMIE setup and features.
-* Operator Precedence Grammars:: A very simple parsing technique.
-* SMIE Grammar:: Defining the grammar of a language.
-* SMIE Lexer:: Defining tokens.
-* SMIE Tricks:: Working around the parser's limitations.
-* SMIE Indentation:: Specifying indentation rules.
-* SMIE Indentation Helpers:: Helper functions for indentation rules.
-* SMIE Indentation Example:: Sample indentation rules.
-
-Documentation
-
-* Documentation Basics:: Where doc strings are defined and stored.
-* Accessing Documentation:: How Lisp programs can access doc strings.
-* Keys in Documentation:: Substituting current key bindings.
-* Describing Characters:: Making printable descriptions of
- non-printing characters and key sequences.
-* Help Functions:: Subroutines used by Emacs help facilities.
-
-Files
-
-* Visiting Files:: Reading files into Emacs buffers for editing.
-* Saving Buffers:: Writing changed buffers back into files.
-* Reading from Files:: Reading files into buffers without visiting.
-* Writing to Files:: Writing new files from parts of buffers.
-* File Locks:: Locking and unlocking files, to prevent
- simultaneous editing by two people.
-* Information about Files:: Testing existence, accessibility, size of files.
-* Changing Files:: Renaming files, changing permissions, etc.
-* File Names:: Decomposing and expanding file names.
-* Contents of Directories:: Getting a list of the files in a directory.
-* Create/Delete Dirs:: Creating and Deleting Directories.
-* Magic File Names:: Special handling for certain file names.
-* Format Conversion:: Conversion to and from various file formats.
-
-Visiting Files
-
-* Visiting Functions:: The usual interface functions for visiting.
-* Subroutines of Visiting:: Lower-level subroutines that they use.
-
-Information about Files
-
-* Testing Accessibility:: Is a given file readable? Writable?
-* Kinds of Files:: Is it a directory? A symbolic link?
-* Truenames:: Eliminating symbolic links from a file name.
-* File Attributes:: How large is it? Any other names? Etc.
-* Locating Files:: How to find a file in standard places.
-
-File Names
-
-* File Name Components:: The directory part of a file name, and the rest.
-* Relative File Names:: Some file names are relative to a current directory.
-* Directory Names:: A directory's name as a directory
- is different from its name as a file.
-* File Name Expansion:: Converting relative file names to absolute ones.
-* Unique File Names:: Generating names for temporary files.
-* File Name Completion:: Finding the completions for a given file name.
-* Standard File Names:: If your package uses a fixed file name,
- how to handle various operating systems simply.
-
-File Format Conversion
-
-* Format Conversion Overview:: @code{insert-file-contents} and @code{write-region}.
-* Format Conversion Round-Trip:: Using @code{format-alist}.
-* Format Conversion Piecemeal:: Specifying non-paired conversion.
-
-Backups and Auto-Saving
-
-* Backup Files:: How backup files are made; how their names
- are chosen.
-* Auto-Saving:: How auto-save files are made; how their
- names are chosen.
-* Reverting:: @code{revert-buffer}, and how to customize
- what it does.
-
-Backup Files
-
-* Making Backups:: How Emacs makes backup files, and when.
-* Rename or Copy:: Two alternatives: renaming the old file
- or copying it.
-* Numbered Backups:: Keeping multiple backups for each source file.
-* Backup Names:: How backup file names are computed; customization.
-
-Buffers
-
-* Buffer Basics:: What is a buffer?
-* Current Buffer:: Designating a buffer as current
- so that primitives will access its contents.
-* Buffer Names:: Accessing and changing buffer names.
-* Buffer File Name:: The buffer file name indicates which file
- is visited.
-* Buffer Modification:: A buffer is @dfn{modified} if it needs to be saved.
-* Modification Time:: Determining whether the visited file was changed
- "behind Emacs's back".
-* Read Only Buffers:: Modifying text is not allowed in a
- read-only buffer.
-* The Buffer List:: How to look at all the existing buffers.
-* Creating Buffers:: Functions that create buffers.
-* Killing Buffers:: Buffers exist until explicitly killed.
-* Indirect Buffers:: An indirect buffer shares text with some
- other buffer.
-* Swapping Text:: Swapping text between two buffers.
-* Buffer Gap:: The gap in the buffer.
-
-Windows
-
-* Basic Windows:: Basic information on using windows.
-* Splitting Windows:: Splitting one window into two windows.
-* Deleting Windows:: Deleting a window gives its space to other windows.
-* Selecting Windows:: The selected window is the one that you edit in.
-* Cyclic Window Ordering:: Moving around the existing windows.
-* Buffers and Windows:: Each window displays the contents of a buffer.
-* Switching Buffers:: Higher-level functions for switching to a buffer.
-* Choosing Window:: How to choose a window for displaying a buffer.
-* Display Action Functions:: Subroutines for @code{display-buffer}.
-* Choosing Window Options:: Extra options affecting how buffers are displayed.
-* Window History:: Each window remembers the buffers displayed in it.
-* Dedicated Windows:: How to avoid displaying another buffer in
- a specific window.
-* Window Point:: Each window has its own location of point.
-* Window Start and End:: Buffer positions indicating which text is
- on-screen in a window.
-* Textual Scrolling:: Moving text up and down through the window.
-* Vertical Scrolling:: Moving the contents up and down on the window.
-* Horizontal Scrolling:: Moving the contents sideways on the window.
-* Size of Window:: Accessing the size of a window.
-* Resizing Windows:: Changing the size of a window.
-* Coordinates and Windows:: Converting coordinates to windows.
-* Window Tree:: The layout and sizes of all windows in a frame.
-* Window Configurations:: Saving and restoring the state of the screen.
-* Window Parameters:: Associating additional information with windows.
-* Window Hooks:: Hooks for scrolling, window size changes,
- redisplay going past a certain point,
- or window configuration changes.
-
-Frames
-
-* Creating Frames:: Creating additional frames.
-* Multiple Terminals:: Displaying on several different devices.
-* Frame Parameters:: Controlling frame size, position, font, etc.
-* Terminal Parameters:: Parameters common for all frames on terminal.
-* Frame Titles:: Automatic updating of frame titles.
-* Deleting Frames:: Frames last until explicitly deleted.
-* Finding All Frames:: How to examine all existing frames.
-* Frames and Windows:: A frame contains windows;
- display of text always works through windows.
-* Minibuffers and Frames:: How a frame finds the minibuffer to use.
-* Input Focus:: Specifying the selected frame.
-* Visibility of Frames:: Frames may be visible or invisible, or icons.
-* Raising and Lowering:: Raising a frame makes it hide other windows;
- lowering it makes the others hide it.
-* Frame Configurations:: Saving the state of all frames.
-* Mouse Tracking:: Getting events that say when the mouse moves.
-* Mouse Position:: Asking where the mouse is, or moving it.
-* Pop-Up Menus:: Displaying a menu for the user to select from.
-* Dialog Boxes:: Displaying a box to ask yes or no.
-* Pointer Shape:: Specifying the shape of the mouse pointer.
-* Window System Selections::Transferring text to and from other X clients.
-* Drag and Drop:: Internals of Drag-and-Drop implementation.
-* Color Names:: Getting the definitions of color names.
-* Text Terminal Colors:: Defining colors for text terminals.
-* Resources:: Getting resource values from the server.
-* Display Feature Testing:: Determining the features of a terminal.
-
-Frame Parameters
-
-* Parameter Access:: How to change a frame's parameters.
-* Initial Parameters:: Specifying frame parameters when you make a frame.
-* Window Frame Parameters:: List of frame parameters for window systems.
-* Size and Position:: Changing the size and position of a frame.
-* Geometry:: Parsing geometry specifications.
-
-Window Frame Parameters
-
-* Basic Parameters:: Parameters that are fundamental.
-* Position Parameters:: The position of the frame on the screen.
-* Size Parameters:: Frame's size.
-* Layout Parameters:: Size of parts of the frame, and
- enabling or disabling some parts.
-* Buffer Parameters:: Which buffers have been or should be shown.
-* Management Parameters:: Communicating with the window manager.
-* Cursor Parameters:: Controlling the cursor appearance.
-* Font and Color Parameters:: Fonts and colors for the frame text.
-
-Positions
-
-* Point:: The special position where editing takes place.
-* Motion:: Changing point.
-* Excursions:: Temporary motion and buffer changes.
-* Narrowing:: Restricting editing to a portion of the buffer.
-
-Motion
-
-* Character Motion:: Moving in terms of characters.
-* Word Motion:: Moving in terms of words.
-* Buffer End Motion:: Moving to the beginning or end of the buffer.
-* Text Lines:: Moving in terms of lines of text.
-* Screen Lines:: Moving in terms of lines as displayed.
-* List Motion:: Moving by parsing lists and sexps.
-* Skipping Characters:: Skipping characters belonging to a certain set.
-
-Markers
-
-* Overview of Markers:: The components of a marker, and how it relocates.
-* Predicates on Markers:: Testing whether an object is a marker.
-* Creating Markers:: Making empty markers or markers at certain places.
-* Information from Markers::Finding the marker's buffer or character position.
-* Marker Insertion Types:: Two ways a marker can relocate when you
- insert where it points.
-* Moving Markers:: Moving the marker to a new buffer or position.
-* The Mark:: How "the mark" is implemented with a marker.
-* The Region:: How to access "the region".
-
-Text
-
-* Near Point:: Examining text in the vicinity of point.
-* Buffer Contents:: Examining text in a general fashion.
-* Comparing Text:: Comparing substrings of buffers.
-* Insertion:: Adding new text to a buffer.
-* Commands for Insertion:: User-level commands to insert text.
-* Deletion:: Removing text from a buffer.
-* User-Level Deletion:: User-level commands to delete text.
-* The Kill Ring:: Where removed text sometimes is saved for
- later use.
-* Undo:: Undoing changes to the text of a buffer.
-* Maintaining Undo:: How to enable and disable undo information.
- How to control how much information is kept.
-* Filling:: Functions for explicit filling.
-* Margins:: How to specify margins for filling commands.
-* Adaptive Fill:: Adaptive Fill mode chooses a fill prefix
- from context.
-* Auto Filling:: How auto-fill mode is implemented to break lines.
-* Sorting:: Functions for sorting parts of the buffer.
-* Columns:: Computing horizontal positions, and using them.
-* Indentation:: Functions to insert or adjust indentation.
-* Case Changes:: Case conversion of parts of the buffer.
-* Text Properties:: Assigning Lisp property lists to text characters.
-* Substitution:: Replacing a given character wherever it appears.
-* Transposition:: Swapping two portions of a buffer.
-* Registers:: How registers are implemented. Accessing
- the text or position stored in a register.
-* Base 64:: Conversion to or from base 64 encoding.
-* Checksum/Hash:: Computing cryptographic hashes.
-* Parsing HTML/XML:: Parsing HTML and XML.
-* Atomic Changes:: Installing several buffer changes "atomically".
-* Change Hooks:: Supplying functions to be run when text is changed.
-
-The Kill Ring
-
-* Kill Ring Concepts:: What text looks like in the kill ring.
-* Kill Functions:: Functions that kill text.
-* Yanking:: How yanking is done.
-* Yank Commands:: Commands that access the kill ring.
-* Low-Level Kill Ring:: Functions and variables for kill ring access.
-* Internals of Kill Ring:: Variables that hold kill ring data.
-
-Indentation
-
-* Primitive Indent:: Functions used to count and insert indentation.
-* Mode-Specific Indent:: Customize indentation for different modes.
-* Region Indent:: Indent all the lines in a region.
-* Relative Indent:: Indent the current line based on previous lines.
-* Indent Tabs:: Adjustable, typewriter-like tab stops.
-* Motion by Indent:: Move to first non-blank character.
-
-Text Properties
-
-* Examining Properties:: Looking at the properties of one character.
-* Changing Properties:: Setting the properties of a range of text.
-* Property Search:: Searching for where a property changes value.
-* Special Properties:: Particular properties with special meanings.
-* Format Properties:: Properties for representing formatting of text.
-* Sticky Properties:: How inserted text gets properties from
- neighboring text.
-* Lazy Properties:: Computing text properties in a lazy fashion
- only when text is examined.
-* Clickable Text:: Using text properties to make regions of text
- do something when you click on them.
-* Fields:: The @code{field} property defines
- fields within the buffer.
-* Not Intervals:: Why text properties do not use
- Lisp-visible text intervals.
-
-Non-@acronym{ASCII} Characters
-
-* Text Representations:: How Emacs represents text.
-* Converting Representations:: Converting unibyte to multibyte and vice versa.
-* Selecting a Representation:: Treating a byte sequence as unibyte or multi.
-* Character Codes:: How unibyte and multibyte relate to
- codes of individual characters.
-* Character Properties:: Character attributes that define their
- behavior and handling.
-* Character Sets:: The space of possible character codes
- is divided into various character sets.
-* Scanning Charsets:: Which character sets are used in a buffer?
-* Translation of Characters:: Translation tables are used for conversion.
-* Coding Systems:: Coding systems are conversions for saving files.
-* Input Methods:: Input methods allow users to enter various
- non-ASCII characters without special keyboards.
-* Locales:: Interacting with the POSIX locale.
-
-Coding Systems
-
-* Coding System Basics:: Basic concepts.
-* Encoding and I/O:: How file I/O functions handle coding systems.
-* Lisp and Coding Systems:: Functions to operate on coding system names.
-* User-Chosen Coding Systems:: Asking the user to choose a coding system.
-* Default Coding Systems:: Controlling the default choices.
-* Specifying Coding Systems:: Requesting a particular coding system
- for a single file operation.
-* Explicit Encoding:: Encoding or decoding text without doing I/O.
-* Terminal I/O Encoding:: Use of encoding for terminal I/O.
-* MS-DOS File Types:: How DOS "text" and "binary" files
- relate to coding systems.
-
-Searching and Matching
-
-* String Search:: Search for an exact match.
-* Searching and Case:: Case-independent or case-significant searching.
-* Regular Expressions:: Describing classes of strings.
-* Regexp Search:: Searching for a match for a regexp.
-* POSIX Regexps:: Searching POSIX-style for the longest match.
-* Match Data:: Finding out which part of the text matched,
- after a string or regexp search.
-* Search and Replace:: Commands that loop, searching and replacing.
-* Standard Regexps:: Useful regexps for finding sentences, pages,...
-
-Regular Expressions
-
-* Syntax of Regexps:: Rules for writing regular expressions.
-* Regexp Example:: Illustrates regular expression syntax.
-* Regexp Functions:: Functions for operating on regular expressions.
-
-Syntax of Regular Expressions
-
-* Regexp Special:: Special characters in regular expressions.
-* Char Classes:: Character classes used in regular expressions.
-* Regexp Backslash:: Backslash-sequences in regular expressions.
-
-The Match Data
-
-* Replacing Match:: Replacing a substring that was matched.
-* Simple Match Data:: Accessing single items of match data,
- such as where a particular subexpression started.
-* Entire Match Data:: Accessing the entire match data at once, as a list.
-* Saving Match Data:: Saving and restoring the match data.
-
-Syntax Tables
-
-* Syntax Basics:: Basic concepts of syntax tables.
-* Syntax Descriptors:: How characters are classified.
-* Syntax Table Functions:: How to create, examine and alter syntax tables.
-* Syntax Properties:: Overriding syntax with text properties.
-* 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.
-
-Syntax Descriptors
-
-* Syntax Class Table:: Table of syntax classes.
-* Syntax Flags:: Additional flags each character can have.
-
-Parsing Expressions
-
-* Motion via Parsing:: Motion functions that work by parsing.
-* Position Parse:: Determining the syntactic state of a position.
-* Parser State:: How Emacs represents a syntactic state.
-* Low-Level Parsing:: Parsing across a specified region.
-* Control Parsing:: Parameters that affect parsing.
-
-Abbrevs and Abbrev Expansion
-
-* Abbrev Tables:: Creating and working with abbrev tables.
-* Defining Abbrevs:: Specifying abbreviations and their expansions.
-* Abbrev Files:: Saving abbrevs in files.
-* Abbrev Expansion:: Controlling expansion; expansion subroutines.
-* Standard Abbrev Tables:: Abbrev tables used by various major modes.
-* Abbrev Properties:: How to read and set abbrev properties.
- Which properties have which effect.
-* Abbrev Table Properties:: How to read and set abbrev table properties.
- Which properties have which effect.
-
-Processes
-
-* Subprocess Creation:: Functions that start subprocesses.
-* Shell Arguments:: Quoting an argument to pass it to a shell.
-* Synchronous Processes:: Details of using synchronous subprocesses.
-* Asynchronous Processes:: Starting up an asynchronous subprocess.
-* Deleting Processes:: Eliminating an asynchronous subprocess.
-* Process Information:: Accessing run-status and other attributes.
-* Input to Processes:: Sending input to an asynchronous subprocess.
-* Signals to Processes:: Stopping, continuing or interrupting
- an asynchronous subprocess.
-* Output from Processes:: Collecting output from an asynchronous subprocess.
-* Sentinels:: Sentinels run when process run-status changes.
-* Query Before Exit:: Whether to query if exiting will kill a process.
-* System Processes:: Accessing other processes running on your system.
-* Transaction Queues:: Transaction-based communication with subprocesses.
-* Network:: Opening network connections.
-* Network Servers:: Network servers let Emacs accept net connections.
-* Datagrams:: UDP network connections.
-* Low-Level Network:: Lower-level but more general function
- to create connections and servers.
-* Misc Network:: Additional relevant functions for net connections.
-* Serial Ports:: Communicating with serial ports.
-* Byte Packing:: Using bindat to pack and unpack binary data.
-
-Receiving Output from Processes
-
-* Process Buffers:: If no filter, output is put in a buffer.
-* Filter Functions:: Filter functions accept output from the process.
-* Decoding Output:: Filters can get unibyte or multibyte strings.
-* Accepting Output:: How to wait until process output arrives.
-
-Low-Level Network Access
-
-* Network Processes:: Using @code{make-network-process}.
-* Network Options:: Further control over network connections.
-* Network Feature Testing:: Determining which network features work on
- the machine you are using.
-
-Packing and Unpacking Byte Arrays
-
-* Bindat Spec:: Describing data layout.
-* Bindat Functions:: Doing the unpacking and packing.
-* Bindat Examples:: Samples of what bindat.el can do for you!
-
-Emacs Display
-
-* Refresh Screen:: Clearing the screen and redrawing everything on it.
-* Forcing Redisplay:: Forcing redisplay.
-* Truncation:: Folding or wrapping long text lines.
-* The Echo Area:: Displaying messages at the bottom of the screen.
-* Warnings:: Displaying warning messages for the user.
-* Invisible Text:: Hiding part of the buffer text.
-* Selective Display:: Hiding part of the buffer text (the old way).
-* Temporary Displays:: Displays that go away automatically.
-* Overlays:: Use overlays to highlight parts of the buffer.
-* Width:: How wide a character or string is on the screen.
-* Line Height:: Controlling the height of lines.
-* Faces:: A face defines a graphics style
- for text characters: font, colors, etc.
-* Fringes:: Controlling window fringes.
-* Scroll Bars:: Controlling vertical scroll bars.
-* Display Property:: Enabling special display features.
-* Images:: Displaying images in Emacs buffers.
-* Buttons:: Adding clickable buttons to Emacs buffers.
-* Abstract Display:: Emacs's Widget for Object Collections.
-* Blinking:: How Emacs shows the matching open parenthesis.
-* Character Display:: How Emacs displays individual characters.
-* Beeping:: Audible signal to the user.
-* Window Systems:: Which window system is being used.
-* Bidirectional Display:: Display of bidirectional scripts, such as
- Arabic and Farsi.
-
-The Echo Area
-
-* Displaying Messages:: Explicitly displaying text in the echo area.
-* Progress:: Informing user about progress of a long operation.
-* Logging Messages:: Echo area messages are logged for the user.
-* Echo Area Customization:: Controlling the echo area.
-
-Reporting Warnings
-
-* Warning Basics:: Warnings concepts and functions to report them.
-* Warning Variables:: Variables programs bind to customize
- their warnings.
-* Warning Options:: Variables users set to control display of warnings.
-* Delayed Warnings:: Deferring warning display until the end of a command.
-
-Overlays
-
-* Managing Overlays:: Creating and moving overlays.
-* Overlay Properties:: How to read and set properties.
- What properties do to the screen display.
-* Finding Overlays:: Searching for overlays.
-
-Faces
-
-* Defining Faces:: How to define a face.
-* Face Attributes:: What is in a face?
-* Attribute Functions:: Functions to examine and set face attributes.
-* Displaying Faces:: How Emacs combines the faces specified for
- a character.
-* Face Remapping:: Remapping faces to alternative definitions.
-* Face Functions:: How to define and examine faces.
-* Auto Faces:: Hook for automatic face assignment.
-* Basic Faces:: Faces that are defined by default.
-* Font Selection:: Finding the best available font for a face.
-* Font Lookup:: Looking up the names of available fonts
- and information about them.
-* Fontsets:: A fontset is a collection of fonts
- that handle a range of character sets.
-* Low-Level Font:: Lisp representation for character display fonts.
-
-Fringes
-
-* Fringe Size/Pos:: Specifying where to put the window fringes.
-* Fringe Indicators:: Displaying indicator icons in the window fringes.
-* Fringe Cursors:: Displaying cursors in the right fringe.
-* Fringe Bitmaps:: Specifying bitmaps for fringe indicators.
-* Customizing Bitmaps:: Specifying your own bitmaps to use in the fringes.
-* Overlay Arrow:: Display of an arrow to indicate position.
-
-The @code{display} Property
-
-* Replacing Specs:: Display specs that replace the text.
-* Specified Space:: Displaying one space with a specified width.
-* Pixel Specification:: Specifying space width or height in pixels.
-* Other Display Specs:: Displaying an image; adjusting the height,
- spacing, and other properties of text.
-* Display Margins:: Displaying text or images to the side of
- the main text.
-
-Images
-
-* Image Formats:: Supported image formats.
-* Image Descriptors:: How to specify an image for use in @code{:display}.
-* XBM Images:: Special features for XBM format.
-* XPM Images:: Special features for XPM format.
-* GIF Images:: Special features for GIF format.
-* TIFF Images:: Special features for TIFF format.
-* PostScript Images:: Special features for PostScript format.
-* ImageMagick Images:: Special features available through ImageMagick.
-* Other Image Types:: Various other formats are supported.
-* Defining Images:: Convenient ways to define an image for later use.
-* Showing Images:: Convenient ways to display an image once
- it is defined.
-* Animated Images:: Some image formats can be animated.
-* Image Cache:: Internal mechanisms of image display.
-
-Buttons
-
-* Button Properties:: Button properties with special meanings.
-* Button Types:: Defining common properties for classes of buttons.
-* Making Buttons:: Adding buttons to Emacs buffers.
-* Manipulating Buttons:: Getting and setting properties of buttons.
-* Button Buffer Commands:: Buffer-wide commands and bindings for buttons.
-
-Abstract Display
-
-* Abstract Display Functions:: Functions in the Ewoc package.
-* Abstract Display Example:: Example of using Ewoc.
-
-Character Display
-
-* Usual Display:: The usual conventions for displaying characters.
-* Display Tables:: What a display table consists of.
-* Active Display Table:: How Emacs selects a display table to use.
-* Glyphs:: How to define a glyph, and what glyphs mean.
-* Glyphless Chars:: How glyphless characters are drawn.
-
-Operating System Interface
-
-* Starting Up:: Customizing Emacs startup processing.
-* Getting Out:: How exiting works (permanent or temporary).
-* System Environment:: Distinguish the name and kind of system.
-* User Identification:: Finding the name and user id of the user.
-* Time of Day:: Getting the current time.
-* Time Conversion:: Converting a time from numeric form to
- calendrical data and vice versa.
-* Time Parsing:: Converting a time from numeric form to text
- and vice versa.
-* Processor Run Time:: Getting the run time used by Emacs.
-* Time Calculations:: Adding, subtracting, comparing times, etc.
-* Timers:: Setting a timer to call a function at a
- certain time.
-* Idle Timers:: Setting a timer to call a function when Emacs has
- been idle for a certain length of time.
-* Terminal Input:: Accessing and recording terminal input.
-* Terminal Output:: Controlling and recording terminal output.
-* Sound Output:: Playing sounds on the computer's speaker.
-* X11 Keysyms:: Operating on key symbols for X Windows.
-* Batch Mode:: Running Emacs without terminal interaction.
-* Session Management:: Saving and restoring state with
- X Session Management.
-* Notifications:: Desktop notifications.
-* Dynamic Libraries:: On-demand loading of support libraries.
-
-Starting Up Emacs
-
-* Startup Summary:: Sequence of actions Emacs performs at startup.
-* Init File:: Details on reading the init file.
-* Terminal-Specific:: How the terminal-specific Lisp file is read.
-* Command-Line Arguments:: How command-line arguments are processed,
- and how you can customize them.
-
-Getting Out of Emacs
-
-* Killing Emacs:: Exiting Emacs irreversibly.
-* Suspending Emacs:: Exiting Emacs reversibly.
-
-Terminal Input
-
-* Input Modes:: Options for how input is processed.
-* Recording Input:: Saving histories of recent or all input events.
-
-Preparing Lisp code for distribution
-
-* Packaging Basics:: The basic concepts of Emacs Lisp packages.
-* Simple Packages:: How to package a single .el file.
-* Multi-file Packages:: How to package multiple files.
-* Package Archives:: Maintaining package archives.
-
-Tips and Conventions
-
-* Coding Conventions:: Conventions for clean and robust programs.
-* Key Binding Conventions:: Which keys should be bound by which programs.
-* Programming Tips:: Making Emacs code fit smoothly in Emacs.
-* Compilation Tips:: Making compiled code run fast.
-* Warning Tips:: Turning off compiler warnings.
-* Documentation Tips:: Writing readable documentation strings.
-* Comment Tips:: Conventions for writing comments.
-* Library Headers:: Standard headers for library packages.
-
-GNU Emacs Internals
-
-* Building Emacs:: How the dumped Emacs is made.
-* Pure Storage:: Kludge to make preloaded Lisp functions shareable.
-* Garbage Collection:: Reclaiming space for Lisp objects no longer used.
-* Memory Usage:: Info about total size of Lisp objects made so far.
-* Writing Emacs Primitives:: Writing C code for Emacs.
-* Object Internals:: Data formats of buffers, windows, processes.
-
-Object Internals
-
-* Buffer Internals:: Components of a buffer structure.
-* Window Internals:: Components of a window structure.
-* Process Internals:: Components of a process structure.
-@end detailmenu
-@end menu
-
-@include intro.texi
-@include objects.texi
-@include numbers.texi
-@include strings.texi
-
-@include lists.texi
-@include sequences.texi
-@include hash.texi
-@include symbols.texi
-@include eval.texi
-
-@include control.texi
-@include variables.texi
-@include functions.texi
-@include macros.texi
-
-@include customize.texi
-@include loading.texi
-@include compile.texi
-@include advice.texi
-
-@c This includes edebug.texi.
-@include debugging.texi
-@include streams.texi
-@include minibuf.texi
-@include commands.texi
-
-@include keymaps.texi
-@include modes.texi
-@include help.texi
-@include files.texi
-
-@include backups.texi
-
-@c ================ Beginning of Volume 2 ================
-@c include buffers.texi
-@c include windows.texi
-@c include frames.texi
-
-@c include positions.texi
-@c include markers.texi
-@c include text.texi
-@c include nonascii.texi
-
-@c include searching.texi
-@c include syntax.texi
-@c include abbrevs.texi
-@c include processes.texi
-
-@c include display.texi
-@c include os.texi
-
-@c appendices
-
-@c include anti.texi
-@c include doclicense.texi
-@c include gpl.texi
-@c include tips.texi
-@c include internals.texi
-@c include errors.texi
-@c include maps.texi
-@c include hooks.texi
-
-@include index.texi
-
-@ignore
-@node New Symbols, , Index, Top
-@unnumbered New Symbols Since the Previous Edition
-
-@printindex tp
-@end ignore
-
-@bye
-
-\f
-These words prevent "local variables" above from confusing Emacs.
+++ /dev/null
-\input texinfo @c -*-texinfo-*-
-@c This file is used for printing the GNU Emacs Lisp Reference Manual
-@c in two volumes. It is a modified version of elisp.texi.
-@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
-@c Free Software Foundation, Inc.
-@c %**start of header
-@setfilename elisp
-@settitle GNU Emacs Lisp Reference Manual: Volume 2
-@c %**end of header
-
-@c See two-volume-cross-refs.txt.
-@tex
-\message{Formatting for two volume edition...Volume 2...}
-%
-% Read special toc file, set up in two-volume.make.
-\gdef\tocreadfilename{elisp2-toc-ready.toc}
-%
-% Don't make outlines, they're not needed and \readdatafile can't pay
-% attention to the special definition above.
-\global\let\pdfmakeoutlines=\relax
-%
-% Start volume 2 chapter numbering at 27; this must be listed as chapno26
-\global\chapno=26
-@end tex
-
-@c Version of the manual and of Emacs.
-@set VERSION 3.1
-@include emacsver.texi
-@set DATE May 2012
-
-@dircategory Emacs
-@direntry
-* Elisp: (elisp). The Emacs Lisp Reference Manual.
-@end direntry
-
-@c in general, keep the following line commented out, unless doing a
-@c copy of this manual that will be published. the manual should go
-@c onto the distribution in the full, 8.5 x 11" size.
-@set smallbook
-
-@ifset smallbook
-@smallbook
-@end ifset
-
-@c per rms and peterb, use 10pt fonts for the main text, mostly to
-@c save on paper cost.
-@c Do this inside @tex for now, so current makeinfo does not complain.
-@tex
-@ifset smallbook
-@fonttextsize 10
-@end ifset
-\global\hbadness=6666 % don't worry about not-too-underfull boxes
-@end tex
-
-@c Combine indices.
-@synindex cp fn
-@syncodeindex vr fn
-@syncodeindex ky fn
-@syncodeindex pg fn
-@c We use the "type index" to index new functions and variables.
-@c @syncodeindex tp fn
-
-@copying
-This is edition @value{VERSION} of the GNU Emacs Lisp Reference Manual,@*
-corresponding to Emacs version @value{EMACSVER}.
-
-Copyright @copyright{} 1990-1996, 1998-2012 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.3 or
-any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License,'' with the
-Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover
-Texts as in (a) below. A copy of the license is included in the
-section entitled ``GNU Free Documentation License.''
-
-(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
-modify this GNU manual. Buying copies from the FSF supports it in
-developing GNU and promoting software freedom.''
-@end quotation
-@end copying
-
-@titlepage
-@title GNU Emacs Lisp Reference Manual
-@subtitle Volume 2
-@subtitle For Emacs Version @value{EMACSVER}
-@subtitle Revision @value{VERSION}, @value{DATE}
-
-@author by Bil Lewis, Dan LaLiberte, Richard Stallman,
-@author the GNU Manual Group, et al.
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-
-@sp 2
-Published by the Free Software Foundation @*
-51 Franklin St, Fifth Floor @*
-Boston, MA 02110-1301 @*
-USA @*
-ISBN 1-882114-74-4
-
-@sp 2
-Cover art by Etienne Suvasa.
-@end titlepage
-
-
-@c Print the tables of contents
-@summarycontents
-@contents
-
-
-@ifnottex
-@node Top, Introduction, (dir), (dir)
-@top Emacs Lisp
-
-This Info file contains edition @value{VERSION} of the GNU Emacs Lisp
-Reference Manual, corresponding to GNU Emacs version @value{EMACSVER}.
-@end ifnottex
-
-@menu
-* Introduction:: Introduction and conventions used.
-
-* Lisp Data Types:: Data types of objects in Emacs Lisp.
-* Numbers:: Numbers and arithmetic functions.
-* Strings and Characters:: Strings, and functions that work on them.
-* Lists:: Lists, cons cells, and related functions.
-* Sequences Arrays Vectors:: Lists, strings and vectors are called sequences.
- Certain functions act on any kind of sequence.
- The description of vectors is here as well.
-* Hash Tables:: Very fast lookup-tables.
-* Symbols:: Symbols represent names, uniquely.
-
-* Evaluation:: How Lisp expressions are evaluated.
-* Control Structures:: Conditionals, loops, nonlocal exits.
-* Variables:: Using symbols in programs to stand for values.
-* Functions:: A function is a Lisp program
- that can be invoked from other functions.
-* Macros:: Macros are a way to extend the Lisp language.
-* Customization:: Making variables and faces customizable.
-
-* Loading:: Reading files of Lisp code into Lisp.
-* Byte Compilation:: Compilation makes programs run faster.
-* Advising Functions:: Adding to the definition of a function.
-* Debugging:: Tools and tips for debugging Lisp programs.
-
-* Read and Print:: Converting Lisp objects to text and back.
-* Minibuffers:: Using the minibuffer to read input.
-* Command Loop:: How the editor command loop works,
- and how you can call its subroutines.
-* Keymaps:: Defining the bindings from keys to commands.
-* Modes:: Defining major and minor modes.
-* Documentation:: Writing and using documentation strings.
-
-* Files:: Accessing files.
-* Backups and Auto-Saving:: Controlling how backups and auto-save
- files are made.
-* Buffers:: Creating and using buffer objects.
-* Windows:: Manipulating windows and displaying buffers.
-* Frames:: Making multiple system-level windows.
-* Positions:: Buffer positions and motion functions.
-* Markers:: Markers represent positions and update
- automatically when the text is changed.
-
-* Text:: Examining and changing text in buffers.
-* Non-ASCII Characters:: Non-ASCII text in buffers and strings.
-* Searching and Matching:: Searching buffers for strings or regexps.
-* Syntax Tables:: The syntax table controls word and list parsing.
-* Abbrevs:: How Abbrev mode works, and its data structures.
-
-* Processes:: Running and communicating with subprocesses.
-* Display:: Features for controlling the screen display.
-* System Interface:: Getting the user id, system type, environment
- variables, and other such things.
-
-* Packaging:: Preparing Lisp code for distribution.
-
-Appendices
-
-* Antinews:: Info for users downgrading to Emacs 23.
-* GNU Free Documentation License:: The license for this documentation.
-* GPL:: Conditions for copying and changing GNU Emacs.
-* Tips:: Advice and coding conventions for Emacs Lisp.
-* GNU Emacs Internals:: Building and dumping Emacs;
- internal data structures.
-* Standard Errors:: List of some standard error symbols.
-* Standard Keymaps:: List of some standard keymaps.
-* Standard Hooks:: List of some standard hook variables.
-
-* Index:: Index including concepts, functions, variables,
- and other terms.
-
-@ignore
-* New Symbols:: New functions and variables in Emacs @value{EMACSVER}.
-@end ignore
-
-@c Do NOT modify the following 3 lines! They must have this form to
-@c be correctly identified by `texinfo-multiple-files-update'. In
-@c particular, the detailed menu header line MUST be identical to the
-@c value of `texinfo-master-menu-header'. See texnfo-upd.el.
-
-@detailmenu
- --- The Detailed Node Listing ---
- ---------------------------------
-
-Here are other nodes that are subnodes of those already listed,
-mentioned here so you can get to them in one step:
-
-Introduction
-
-* Caveats:: Flaws and a request for help.
-* Lisp History:: Emacs Lisp is descended from Maclisp.
-* Conventions:: How the manual is formatted.
-* Version Info:: Which Emacs version is running?
-* Acknowledgements:: The authors, editors, and sponsors of this manual.
-
-Conventions
-
-* Some Terms:: Explanation of terms we use in this manual.
-* nil and t:: How the symbols @code{nil} and @code{t} are used.
-* Evaluation Notation:: The format we use for examples of evaluation.
-* Printing Notation:: The format we use when examples print text.
-* Error Messages:: The format we use for examples of errors.
-* Buffer Text Notation:: The format we use for buffer contents in examples.
-* Format of Descriptions:: Notation for describing functions, variables, etc.
-
-Format of Descriptions
-
-* A Sample Function Description:: A description of an imaginary
- function, @code{foo}.
-* A Sample Variable Description:: A description of an imaginary
- variable, @code{electric-future-map}.
-
-Lisp Data Types
-
-* Printed Representation:: How Lisp objects are represented as text.
-* Comments:: Comments and their formatting conventions.
-* Programming Types:: Types found in all Lisp systems.
-* Editing Types:: Types specific to Emacs.
-* Circular Objects:: Read syntax for circular structure.
-* Type Predicates:: Tests related to types.
-* Equality Predicates:: Tests of equality between any two objects.
-
-Programming Types
-
-* Integer Type:: Numbers without fractional parts.
-* Floating Point Type:: Numbers with fractional parts and with a large range.
-* Character Type:: The representation of letters, numbers and
- control characters.
-* Symbol Type:: A multi-use object that refers to a function,
- variable, or property list, and has a unique identity.
-* Sequence Type:: Both lists and arrays are classified as sequences.
-* Cons Cell Type:: Cons cells, and lists (which are made from cons cells).
-* Array Type:: Arrays include strings and vectors.
-* String Type:: An (efficient) array of characters.
-* Vector Type:: One-dimensional arrays.
-* Char-Table Type:: One-dimensional sparse arrays indexed by characters.
-* Bool-Vector Type:: One-dimensional arrays of @code{t} or @code{nil}.
-* Hash Table Type:: Super-fast lookup tables.
-* Function Type:: A piece of executable code you can call from elsewhere.
-* Macro Type:: A method of expanding an expression into another
- expression, more fundamental but less pretty.
-* Primitive Function Type:: A function written in C, callable from Lisp.
-* Byte-Code Type:: A function written in Lisp, then compiled.
-* Autoload Type:: A type used for automatically loading seldom-used
- functions.
-
-Character Type
-
-* Basic Char Syntax:: Syntax for regular characters.
-* General Escape Syntax:: How to specify characters by their codes.
-* Ctl-Char Syntax:: Syntax for control characters.
-* Meta-Char Syntax:: Syntax for meta-characters.
-* Other Char Bits:: Syntax for hyper-, super-, and alt-characters.
-
-Cons Cell and List Types
-
-* Box Diagrams:: Drawing pictures of lists.
-* Dotted Pair Notation:: A general syntax for cons cells.
-* Association List Type:: A specially constructed list.
-
-String Type
-
-* Syntax for Strings:: How to specify Lisp strings.
-* Non-ASCII in Strings:: International characters in strings.
-* Nonprinting Characters:: Literal unprintable characters in strings.
-* Text Props and Strings:: Strings with text properties.
-
-Editing Types
-
-* Buffer Type:: The basic object of editing.
-* Marker Type:: A position in a buffer.
-* Window Type:: Buffers are displayed in windows.
-* Frame Type:: Windows subdivide frames.
-* Terminal Type:: A terminal device displays frames.
-* Window Configuration Type:: Recording the way a frame is subdivided.
-* Frame Configuration Type:: Recording the status of all frames.
-* Process Type:: A subprocess of Emacs running on the underlying OS.
-* Stream Type:: Receive or send characters.
-* Keymap Type:: What function a keystroke invokes.
-* Overlay Type:: How an overlay is represented.
-* Font Type:: Fonts for displaying text.
-
-Numbers
-
-* Integer Basics:: Representation and range of integers.
-* Float Basics:: Representation and range of floating point.
-* Predicates on Numbers:: Testing for numbers.
-* Comparison of Numbers:: Equality and inequality predicates.
-* Numeric Conversions:: Converting float to integer and vice versa.
-* Arithmetic Operations:: How to add, subtract, multiply and divide.
-* Rounding Operations:: Explicitly rounding floating point numbers.
-* Bitwise Operations:: Logical and, or, not, shifting.
-* Math Functions:: Trig, exponential and logarithmic functions.
-* Random Numbers:: Obtaining random integers, predictable or not.
-
-Strings and Characters
-
-* String Basics:: Basic properties of strings and characters.
-* Predicates for Strings:: Testing whether an object is a string or char.
-* Creating Strings:: Functions to allocate new strings.
-* Modifying Strings:: Altering the contents of an existing string.
-* Text Comparison:: Comparing characters or strings.
-* String Conversion:: Converting to and from characters and strings.
-* Formatting Strings:: @code{format}: Emacs's analogue of @code{printf}.
-* Case Conversion:: Case conversion functions.
-* Case Tables:: Customizing case conversion.
-
-Lists
-
-* Cons Cells:: How lists are made out of cons cells.
-* List-related Predicates:: Is this object a list? Comparing two lists.
-* List Elements:: Extracting the pieces of a list.
-* Building Lists:: Creating list structure.
-* List Variables:: Modifying lists stored in variables.
-* Modifying Lists:: Storing new pieces into an existing list.
-* Sets And Lists:: A list can represent a finite mathematical set.
-* Association Lists:: A list can represent a finite relation or mapping.
-* Rings:: Managing a fixed-size ring of objects.
-
-Modifying Existing List Structure
-
-* Setcar:: Replacing an element in a list.
-* Setcdr:: Replacing part of the list backbone.
- This can be used to remove or add elements.
-* Rearrangement:: Reordering the elements in a list; combining lists.
-
-Sequences, Arrays, and Vectors
-
-* Sequence Functions:: Functions that accept any kind of sequence.
-* Arrays:: Characteristics of arrays in Emacs Lisp.
-* Array Functions:: Functions specifically for arrays.
-* Vectors:: Special characteristics of Emacs Lisp vectors.
-* Vector Functions:: Functions specifically for vectors.
-* Char-Tables:: How to work with char-tables.
-* Bool-Vectors:: How to work with bool-vectors.
-
-Hash Tables
-
-* Creating Hash:: Functions to create hash tables.
-* Hash Access:: Reading and writing the hash table contents.
-* Defining Hash:: Defining new comparison methods.
-* Other Hash:: Miscellaneous.
-
-Symbols
-
-* Symbol Components:: Symbols have names, values, function definitions
- and property lists.
-* Definitions:: A definition says how a symbol will be used.
-* Creating Symbols:: How symbols are kept unique.
-* Property Lists:: Each symbol has a property list
- for recording miscellaneous information.
-
-Property Lists
-
-* Plists and Alists:: Comparison of the advantages of property
- lists and association lists.
-* Symbol Plists:: Functions to access symbols' property lists.
-* Other Plists:: Accessing property lists stored elsewhere.
-
-Evaluation
-
-* Intro Eval:: Evaluation in the scheme of things.
-* Forms:: How various sorts of objects are evaluated.
-* Quoting:: Avoiding evaluation (to put constants in
- the program).
-* Backquote:: Easier construction of list structure.
-* Eval:: How to invoke the Lisp interpreter explicitly.
-
-Kinds of Forms
-
-* Self-Evaluating Forms:: Forms that evaluate to themselves.
-* Symbol Forms:: Symbols evaluate as variables.
-* Classifying Lists:: How to distinguish various sorts of list forms.
-* Function Indirection:: When a symbol appears as the car of a list,
- we find the real function via the symbol.
-* Function Forms:: Forms that call functions.
-* Macro Forms:: Forms that call macros.
-* Special Forms:: "Special forms" are idiosyncratic primitives,
- most of them extremely important.
-* Autoloading:: Functions set up to load files
- containing their real definitions.
-
-Control Structures
-
-* Sequencing:: Evaluation in textual order.
-* Conditionals:: @code{if}, @code{cond}, @code{when}, @code{unless}.
-* Combining Conditions:: @code{and}, @code{or}, @code{not}.
-* Iteration:: @code{while} loops.
-* Nonlocal Exits:: Jumping out of a sequence.
-
-Nonlocal Exits
-
-* Catch and Throw:: Nonlocal exits for the program's own purposes.
-* Examples of Catch:: Showing how such nonlocal exits can be written.
-* Errors:: How errors are signaled and handled.
-* Cleanups:: Arranging to run a cleanup form if an
- error happens.
-
-Errors
-
-* Signaling Errors:: How to report an error.
-* Processing of Errors:: What Emacs does when you report an error.
-* Handling Errors:: How you can trap errors and continue execution.
-* Error Symbols:: How errors are classified for trapping them.
-
-Variables
-
-* Global Variables:: Variable values that exist permanently, everywhere.
-* Constant Variables:: Certain "variables" have values that never change.
-* Local Variables:: Variable values that exist only temporarily.
-* Void Variables:: Symbols that lack values.
-* Defining Variables:: A definition says a symbol is used as a variable.
-* Tips for Defining:: Things you should think about when you
- define a variable.
-* Accessing Variables:: Examining values of variables whose names
- are known only at run time.
-* Setting Variables:: Storing new values in variables.
-* Variable Scoping:: How Lisp chooses among local and global values.
-* Buffer-Local Variables:: Variable values in effect only in one buffer.
-* File Local Variables:: Handling local variable lists in files.
-* Directory Local Variables:: Local variables common to all files in a
- directory.
-* Frame-Local Variables:: Frame-local bindings for variables.
-* Variable Aliases:: Variables that are aliases for other variables.
-* Variables with Restricted Values:: Non-constant variables whose value can
- @emph{not} be an arbitrary Lisp object.
-
-Scoping Rules for Variable Bindings
-
-* Scope:: Scope means where in the program a value
- is visible. Comparison with other languages.
-* Extent:: Extent means how long in time a value exists.
-* Impl of Scope:: Two ways to implement dynamic scoping.
-* Using Scoping:: How to use dynamic scoping carefully and
- avoid problems.
-
-Buffer-Local Variables
-
-* Intro to Buffer-Local:: Introduction and concepts.
-* Creating Buffer-Local:: Creating and destroying buffer-local bindings.
-* Default Value:: The default value is seen in buffers
- that don't have their own buffer-local values.
-
-Functions
-
-* What Is a Function:: Lisp functions vs. primitives; terminology.
-* Lambda Expressions:: How functions are expressed as Lisp objects.
-* Function Names:: A symbol can serve as the name of a function.
-* Defining Functions:: Lisp expressions for defining functions.
-* Calling Functions:: How to use an existing function.
-* Mapping Functions:: Applying a function to each element of a list, etc.
-* Anonymous Functions:: Lambda expressions are functions with no names.
-* Function Cells:: Accessing or setting the function definition
- of a symbol.
-* Closures:: Functions that enclose a lexical environment.
-* Obsolete Functions:: Declaring functions obsolete.
-* Inline Functions:: Defining functions that the compiler
- will expand inline.
-* Declaring Functions:: Telling the compiler that a function is defined.
-* Function Safety:: Determining whether a function is safe to call.
-* Related Topics:: Cross-references to specific Lisp primitives
- that have a special bearing on how
- functions work.
-
-Lambda Expressions
-
-* Lambda Components:: The parts of a lambda expression.
-* Simple Lambda:: A simple example.
-* Argument List:: Details and special features of argument lists.
-* Function Documentation:: How to put documentation in a function.
-
-Macros
-
-* Simple Macro:: A basic example.
-* Expansion:: How, when and why macros are expanded.
-* Compiling Macros:: How macros are expanded by the compiler.
-* Defining Macros:: How to write a macro definition.
-* Problems with Macros:: Don't evaluate the macro arguments too many times.
- Don't hide the user's variables.
-* Indenting Macros:: Specifying how to indent macro calls.
-
-Common Problems Using Macros
-
-* Wrong Time:: Do the work in the expansion, not in the macro.
-* Argument Evaluation:: The expansion should evaluate each macro arg once.
-* Surprising Local Vars:: Local variable bindings in the expansion
- require special care.
-* Eval During Expansion:: Don't evaluate them; put them in the expansion.
-* Repeated Expansion:: Avoid depending on how many times expansion is done.
-
-Customization Settings
-
-* Common Keywords:: Common keyword arguments for all kinds of
- customization declarations.
-* Group Definitions:: Writing customization group definitions.
-* Variable Definitions:: Declaring user options.
-* Customization Types:: Specifying the type of a user option.
-* Applying Customizations:: Functions to apply customization settings.
-* Custom Themes:: Writing Custom themes.
-
-Customization Types
-
-* Simple Types:: Simple customization types: sexp, integer, number,
- string, file, directory, alist.
-* Composite Types:: Build new types from other types or data.
-* Splicing into Lists:: Splice elements into list with @code{:inline}.
-* Type Keywords:: Keyword-argument pairs in a customization type.
-* Defining New Types:: Give your type a name.
-
-Loading
-
-* How Programs Do Loading:: The @code{load} function and others.
-* Load Suffixes:: Details about the suffixes that @code{load} tries.
-* Library Search:: Finding a library to load.
-* Loading Non-ASCII:: Non-@acronym{ASCII} characters in Emacs Lisp files.
-* Autoload:: Setting up a function to autoload.
-* Repeated Loading:: Precautions about loading a file twice.
-* Named Features:: Loading a library if it isn't already loaded.
-* Where Defined:: Finding which file defined a certain symbol.
-* Unloading:: How to "unload" a library that was loaded.
-* Hooks for Loading:: Providing code to be run when
- particular libraries are loaded.
-
-Byte Compilation
-
-* Speed of Byte-Code:: An example of speedup from byte compilation.
-* Compilation Functions:: Byte compilation functions.
-* Docs and Compilation:: Dynamic loading of documentation strings.
-* Dynamic Loading:: Dynamic loading of individual functions.
-* Eval During Compile:: Code to be evaluated when you compile.
-* Compiler Errors:: Handling compiler error messages.
-* Byte-Code Objects:: The data type used for byte-compiled functions.
-* Disassembly:: Disassembling byte-code; how to read byte-code.
-
-Advising Emacs Lisp Functions
-
-* Simple Advice:: A simple example to explain the basics of advice.
-* Defining Advice:: Detailed description of @code{defadvice}.
-* Around-Advice:: Wrapping advice around a function's definition.
-* Computed Advice:: ...is to @code{defadvice} as @code{fset} is to @code{defun}.
-* Activation of Advice:: Advice doesn't do anything until you activate it.
-* Enabling Advice:: You can enable or disable each piece of advice.
-* Preactivation:: Preactivation is a way of speeding up the
- loading of compiled advice.
-* Argument Access in Advice:: How advice can access the function's arguments.
-* Combined Definition:: How advice is implemented.
-
-Debugging Lisp Programs
-
-* Debugger:: A debugger for the Emacs Lisp evaluator.
-* Edebug:: A source-level Emacs Lisp debugger.
-* Syntax Errors:: How to find syntax errors.
-* Test Coverage:: Ensuring you have tested all branches in your code.
-
-The Lisp Debugger
-
-* Error Debugging:: Entering the debugger when an error happens.
-* Infinite Loops:: Stopping and debugging a program that doesn't exit.
-* Function Debugging:: Entering it when a certain function is called.
-* Explicit Debug:: Entering it at a certain point in the program.
-* Using Debugger:: What the debugger does; what you see while in it.
-* Debugger Commands:: Commands used while in the debugger.
-* Invoking the Debugger:: How to call the function @code{debug}.
-* Internals of Debugger:: Subroutines of the debugger, and global variables.
-
-Edebug
-
-* Using Edebug:: Introduction to use of Edebug.
-* Instrumenting:: You must instrument your code
- in order to debug it with Edebug.
-* Edebug Execution Modes:: Execution modes, stopping more or less often.
-* Jumping:: Commands to jump to a specified place.
-* Edebug Misc:: Miscellaneous commands.
-* Breaks:: Setting breakpoints to make the program stop.
-* Trapping Errors:: Trapping errors with Edebug.
-* Edebug Views:: Views inside and outside of Edebug.
-* Edebug Eval:: Evaluating expressions within Edebug.
-* Eval List:: Expressions whose values are displayed
- each time you enter Edebug.
-* Printing in Edebug:: Customization of printing.
-* Trace Buffer:: How to produce trace output in a buffer.
-* Coverage Testing:: How to test evaluation coverage.
-* The Outside Context:: Data that Edebug saves and restores.
-* Edebug and Macros:: Specifying how to handle macro calls.
-* Edebug Options:: Option variables for customizing Edebug.
-
-Breaks
-
-* Breakpoints:: Breakpoints at stop points.
-* Global Break Condition:: Breaking on an event.
-* Source Breakpoints:: Embedding breakpoints in source code.
-
-The Outside Context
-
-* Checking Whether to Stop::When Edebug decides what to do.
-* Edebug Display Update:: When Edebug updates the display.
-* Edebug Recursive Edit:: When Edebug stops execution.
-
-Edebug and Macros
-
-* Instrumenting Macro Calls::The basic problem.
-* Specification List:: How to specify complex patterns of evaluation.
-* Backtracking:: What Edebug does when matching fails.
-* Specification Examples:: To help understand specifications.
-
-Debugging Invalid Lisp Syntax
-
-* Excess Open:: How to find a spurious open paren or missing close.
-* Excess Close:: How to find a spurious close paren or missing open.
-
-Reading and Printing Lisp Objects
-
-* Streams Intro:: Overview of streams, reading and printing.
-* Input Streams:: Various data types that can be used as
- input streams.
-* Input Functions:: Functions to read Lisp objects from text.
-* Output Streams:: Various data types that can be used as
- output streams.
-* Output Functions:: Functions to print Lisp objects as text.
-* Output Variables:: Variables that control what the printing
- functions do.
-
-Minibuffers
-
-* Intro to Minibuffers:: Basic information about minibuffers.
-* Text from Minibuffer:: How to read a straight text string.
-* Object from Minibuffer:: How to read a Lisp object or expression.
-* Minibuffer History:: Recording previous minibuffer inputs
- so the user can reuse them.
-* Initial Input:: Specifying initial contents for the minibuffer.
-* Completion:: How to invoke and customize completion.
-* Yes-or-No Queries:: Asking a question with a simple answer.
-* Multiple Queries:: Asking a series of similar questions.
-* Reading a Password:: Reading a password from the terminal.
-* Minibuffer Commands:: Commands used as key bindings in minibuffers.
-* Minibuffer Windows:: Operating on the special minibuffer windows.
-* Minibuffer Contents:: How such commands access the minibuffer text.
-* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
-* Minibuffer Misc:: Various customization hooks and variables.
-
-Completion
-
-* Basic Completion:: Low-level functions for completing strings.
- (These are too low level to use the minibuffer.)
-* Minibuffer Completion:: Invoking the minibuffer with completion.
-* Completion Commands:: Minibuffer commands that do completion.
-* High-Level Completion:: Convenient special cases of completion
- (reading buffer names, variable names, etc.).
-* Reading File Names:: Using completion to read file names and
- shell commands.
-* Completion Variables:: Variables controlling completion behavior.
-* Programmed Completion:: Writing your own completion function.
-* Completion in Buffers:: Completing text in ordinary buffers.
-
-Command Loop
-
-* Command Overview:: How the command loop reads commands.
-* Defining Commands:: Specifying how a function should read arguments.
-* Interactive Call:: Calling a command, so that it will read arguments.
-* Distinguish Interactive:: Making a command distinguish interactive calls.
-* Command Loop Info:: Variables set by the command loop for you to examine.
-* Adjusting Point:: Adjustment of point after a command.
-* Input Events:: What input looks like when you read it.
-* Reading Input:: How to read input events from the keyboard or mouse.
-* Special Events:: Events processed immediately and individually.
-* Waiting:: Waiting for user input or elapsed time.
-* Quitting:: How @kbd{C-g} works. How to catch or defer quitting.
-* Prefix Command Arguments:: How the commands to set prefix args work.
-* Recursive Editing:: Entering a recursive edit,
- and why you usually shouldn't.
-* Disabling Commands:: How the command loop handles disabled commands.
-* Command History:: How the command history is set up, and how accessed.
-* Keyboard Macros:: How keyboard macros are implemented.
-
-Defining Commands
-
-* Using Interactive:: General rules for @code{interactive}.
-* Interactive Codes:: The standard letter-codes for reading arguments
- in various ways.
-* Interactive Examples:: Examples of how to read interactive arguments.
-
-Input Events
-
-* Keyboard Events:: Ordinary characters--keys with symbols on them.
-* Function Keys:: Function keys--keys with names, not symbols.
-* Mouse Events:: Overview of mouse events.
-* Click Events:: Pushing and releasing a mouse button.
-* Drag Events:: Moving the mouse before releasing the button.
-* Button-Down Events:: A button was pushed and not yet released.
-* Repeat Events:: Double and triple click (or drag, or down).
-* Motion Events:: Just moving the mouse, not pushing a button.
-* Focus Events:: Moving the mouse between frames.
-* Misc Events:: Other events the system can generate.
-* Event Examples:: Examples of the lists for mouse events.
-* Classifying Events:: Finding the modifier keys in an event symbol.
- Event types.
-* Accessing Mouse:: Functions to extract info from mouse events.
-* Accessing Scroll:: Functions to get info from scroll bar events.
-* Strings of Events:: Special considerations for putting
- keyboard character events in a string.
-
-Reading Input
-
-* Key Sequence Input:: How to read one key sequence.
-* Reading One Event:: How to read just one event.
-* Event Mod:: How Emacs modifies events as they are read.
-* Invoking the Input Method:: How reading an event uses the input method.
-* Quoted Character Input:: Asking the user to specify a character.
-* Event Input Misc:: How to reread or throw away input events.
-
-Keymaps
-
-* Key Sequences:: Key sequences as Lisp objects.
-* Keymap Basics:: Basic concepts of keymaps.
-* Format of Keymaps:: What a keymap looks like as a Lisp object.
-* Creating Keymaps:: Functions to create and copy keymaps.
-* Inheritance and Keymaps:: How one keymap can inherit the bindings
- of another keymap.
-* Prefix Keys:: Defining a key with a keymap as its definition.
-* Active Keymaps:: How Emacs searches the active keymaps
- for a key binding.
-* Searching Keymaps:: A pseudo-Lisp summary of searching active maps.
-* Controlling Active Maps:: Each buffer has a local keymap
- to override the standard (global) bindings.
- A minor mode can also override them.
-* Key Lookup:: Finding a key's binding in one keymap.
-* Functions for Key Lookup:: How to request key lookup.
-* Changing Key Bindings:: Redefining a key in a keymap.
-* Remapping Commands:: A keymap can translate one command to another.
-* Translation Keymaps:: Keymaps for translating sequences of events.
-* Key Binding Commands:: Interactive interfaces for redefining keys.
-* Scanning Keymaps:: Looking through all keymaps, for printing help.
-* Menu Keymaps:: Defining a menu as a keymap.
-
-Menu Keymaps
-
-* Defining Menus:: How to make a keymap that defines a menu.
-* Mouse Menus:: How users actuate the menu with the mouse.
-* Keyboard Menus:: How users actuate the menu with the keyboard.
-* Menu Example:: Making a simple menu.
-* Menu Bar:: How to customize the menu bar.
-* Tool Bar:: A tool bar is a row of images.
-* Modifying Menus:: How to add new items to a menu.
-
-Defining Menus
-
-* Simple Menu Items:: A simple kind of menu key binding,
- limited in capabilities.
-* Extended Menu Items:: More powerful menu item definitions
- let you specify keywords to enable
- various features.
-* Menu Separators:: Drawing a horizontal line through a menu.
-* Alias Menu Items:: Using command aliases in menu items.
-* Toolkit Differences:: Not all toolkits provide the same features.
-
-Major and Minor Modes
-
-* Hooks:: How to use hooks; how to write code that provides hooks.
-* Major Modes:: Defining major modes.
-* Minor Modes:: Defining minor modes.
-* Mode Line Format:: Customizing the text that appears in the mode line.
-* Imenu:: Providing a menu of definitions made in a buffer.
-* Font Lock Mode:: How modes can highlight text according to syntax.
-* Auto-Indentation:: How to teach Emacs to indent for a major mode.
-* Desktop Save Mode:: How modes can have buffer state saved between
- Emacs sessions.
-
-Hooks
-
-* Running Hooks:: How to run a hook.
-* Setting Hooks:: How to put functions on a hook, or remove them.
-
-Major Modes
-
-* Major Mode Conventions:: Coding conventions for keymaps, etc.
-* Auto Major Mode:: How Emacs chooses the major mode automatically.
-* Mode Help:: Finding out how to use a mode.
-* Derived Modes:: Defining a new major mode based on another major
- mode.
-* Basic Major Modes:: Modes that other modes are often derived from.
-* Mode Hooks:: Hooks run at the end of major mode functions.
-* Tabulated List Mode:: Parent mode for buffers containing tabulated data.
-* Generic Modes:: Defining a simple major mode that supports
- comment syntax and Font Lock mode.
-* Example Major Modes:: Text mode and Lisp modes.
-
-Minor Modes
-
-* Minor Mode Conventions:: Tips for writing a minor mode.
-* Keymaps and Minor Modes:: How a minor mode can have its own keymap.
-* Defining Minor Modes:: A convenient facility for defining minor modes.
-
-Mode Line Format
-
-* Mode Line Basics:: Basic ideas of mode line control.
-* Mode Line Data:: The data structure that controls the mode line.
-* Mode Line Top:: The top level variable, mode-line-format.
-* Mode Line Variables:: Variables used in that data structure.
-* %-Constructs:: Putting information into a mode line.
-* Properties in Mode:: Using text properties in the mode line.
-* Header Lines:: Like a mode line, but at the top.
-* Emulating Mode Line:: Formatting text as the mode line would.
-
-Font Lock Mode
-
-* Font Lock Basics:: Overview of customizing Font Lock.
-* Search-based Fontification:: Fontification based on regexps.
-* Customizing Keywords:: Customizing search-based fontification.
-* Other Font Lock Variables:: Additional customization facilities.
-* Levels of Font Lock:: Each mode can define alternative levels
- so that the user can select more or less.
-* Precalculated Fontification:: How Lisp programs that produce the buffer
- contents can also specify how to fontify it.
-* Faces for Font Lock:: Special faces specifically for Font Lock.
-* Syntactic Font Lock:: Fontification based on syntax tables.
-* Multiline Font Lock:: How to coerce Font Lock into properly
- highlighting multiline constructs.
-
-Multiline Font Lock Constructs
-
-* Font Lock Multiline:: Marking multiline chunks with a text property.
-* Region to Refontify:: Controlling which region gets refontified
- after a buffer change.
-
-Automatic Indentation of code
-
-* SMIE:: A simple minded indentation engine.
-
-Simple Minded Indentation Engine
-
-* SMIE setup:: SMIE setup and features.
-* Operator Precedence Grammars:: A very simple parsing technique.
-* SMIE Grammar:: Defining the grammar of a language.
-* SMIE Lexer:: Defining tokens.
-* SMIE Tricks:: Working around the parser's limitations.
-* SMIE Indentation:: Specifying indentation rules.
-* SMIE Indentation Helpers:: Helper functions for indentation rules.
-* SMIE Indentation Example:: Sample indentation rules.
-
-Documentation
-
-* Documentation Basics:: Where doc strings are defined and stored.
-* Accessing Documentation:: How Lisp programs can access doc strings.
-* Keys in Documentation:: Substituting current key bindings.
-* Describing Characters:: Making printable descriptions of
- non-printing characters and key sequences.
-* Help Functions:: Subroutines used by Emacs help facilities.
-
-Files
-
-* Visiting Files:: Reading files into Emacs buffers for editing.
-* Saving Buffers:: Writing changed buffers back into files.
-* Reading from Files:: Reading files into buffers without visiting.
-* Writing to Files:: Writing new files from parts of buffers.
-* File Locks:: Locking and unlocking files, to prevent
- simultaneous editing by two people.
-* Information about Files:: Testing existence, accessibility, size of files.
-* Changing Files:: Renaming files, changing permissions, etc.
-* File Names:: Decomposing and expanding file names.
-* Contents of Directories:: Getting a list of the files in a directory.
-* Create/Delete Dirs:: Creating and Deleting Directories.
-* Magic File Names:: Special handling for certain file names.
-* Format Conversion:: Conversion to and from various file formats.
-
-Visiting Files
-
-* Visiting Functions:: The usual interface functions for visiting.
-* Subroutines of Visiting:: Lower-level subroutines that they use.
-
-Information about Files
-
-* Testing Accessibility:: Is a given file readable? Writable?
-* Kinds of Files:: Is it a directory? A symbolic link?
-* Truenames:: Eliminating symbolic links from a file name.
-* File Attributes:: How large is it? Any other names? Etc.
-* Locating Files:: How to find a file in standard places.
-
-File Names
-
-* File Name Components:: The directory part of a file name, and the rest.
-* Relative File Names:: Some file names are relative to a current directory.
-* Directory Names:: A directory's name as a directory
- is different from its name as a file.
-* File Name Expansion:: Converting relative file names to absolute ones.
-* Unique File Names:: Generating names for temporary files.
-* File Name Completion:: Finding the completions for a given file name.
-* Standard File Names:: If your package uses a fixed file name,
- how to handle various operating systems simply.
-
-File Format Conversion
-
-* Format Conversion Overview:: @code{insert-file-contents} and @code{write-region}.
-* Format Conversion Round-Trip:: Using @code{format-alist}.
-* Format Conversion Piecemeal:: Specifying non-paired conversion.
-
-Backups and Auto-Saving
-
-* Backup Files:: How backup files are made; how their names
- are chosen.
-* Auto-Saving:: How auto-save files are made; how their
- names are chosen.
-* Reverting:: @code{revert-buffer}, and how to customize
- what it does.
-
-Backup Files
-
-* Making Backups:: How Emacs makes backup files, and when.
-* Rename or Copy:: Two alternatives: renaming the old file
- or copying it.
-* Numbered Backups:: Keeping multiple backups for each source file.
-* Backup Names:: How backup file names are computed; customization.
-
-Buffers
-
-* Buffer Basics:: What is a buffer?
-* Current Buffer:: Designating a buffer as current
- so that primitives will access its contents.
-* Buffer Names:: Accessing and changing buffer names.
-* Buffer File Name:: The buffer file name indicates which file
- is visited.
-* Buffer Modification:: A buffer is @dfn{modified} if it needs to be saved.
-* Modification Time:: Determining whether the visited file was changed
- "behind Emacs's back".
-* Read Only Buffers:: Modifying text is not allowed in a
- read-only buffer.
-* The Buffer List:: How to look at all the existing buffers.
-* Creating Buffers:: Functions that create buffers.
-* Killing Buffers:: Buffers exist until explicitly killed.
-* Indirect Buffers:: An indirect buffer shares text with some
- other buffer.
-* Swapping Text:: Swapping text between two buffers.
-* Buffer Gap:: The gap in the buffer.
-
-Windows
-
-* Basic Windows:: Basic information on using windows.
-* Splitting Windows:: Splitting one window into two windows.
-* Deleting Windows:: Deleting a window gives its space to other windows.
-* Selecting Windows:: The selected window is the one that you edit in.
-* Cyclic Window Ordering:: Moving around the existing windows.
-* Buffers and Windows:: Each window displays the contents of a buffer.
-* Switching Buffers:: Higher-level functions for switching to a buffer.
-* Choosing Window:: How to choose a window for displaying a buffer.
-* Display Action Functions:: Subroutines for @code{display-buffer}.
-* Choosing Window Options:: Extra options affecting how buffers are displayed.
-* Window History:: Each window remembers the buffers displayed in it.
-* Dedicated Windows:: How to avoid displaying another buffer in
- a specific window.
-* Window Point:: Each window has its own location of point.
-* Window Start and End:: Buffer positions indicating which text is
- on-screen in a window.
-* Textual Scrolling:: Moving text up and down through the window.
-* Vertical Scrolling:: Moving the contents up and down on the window.
-* Horizontal Scrolling:: Moving the contents sideways on the window.
-* Size of Window:: Accessing the size of a window.
-* Resizing Windows:: Changing the size of a window.
-* Coordinates and Windows:: Converting coordinates to windows.
-* Window Tree:: The layout and sizes of all windows in a frame.
-* Window Configurations:: Saving and restoring the state of the screen.
-* Window Parameters:: Associating additional information with windows.
-* Window Hooks:: Hooks for scrolling, window size changes,
- redisplay going past a certain point,
- or window configuration changes.
-
-Frames
-
-* Creating Frames:: Creating additional frames.
-* Multiple Terminals:: Displaying on several different devices.
-* Frame Parameters:: Controlling frame size, position, font, etc.
-* Terminal Parameters:: Parameters common for all frames on terminal.
-* Frame Titles:: Automatic updating of frame titles.
-* Deleting Frames:: Frames last until explicitly deleted.
-* Finding All Frames:: How to examine all existing frames.
-* Frames and Windows:: A frame contains windows;
- display of text always works through windows.
-* Minibuffers and Frames:: How a frame finds the minibuffer to use.
-* Input Focus:: Specifying the selected frame.
-* Visibility of Frames:: Frames may be visible or invisible, or icons.
-* Raising and Lowering:: Raising a frame makes it hide other windows;
- lowering it makes the others hide it.
-* Frame Configurations:: Saving the state of all frames.
-* Mouse Tracking:: Getting events that say when the mouse moves.
-* Mouse Position:: Asking where the mouse is, or moving it.
-* Pop-Up Menus:: Displaying a menu for the user to select from.
-* Dialog Boxes:: Displaying a box to ask yes or no.
-* Pointer Shape:: Specifying the shape of the mouse pointer.
-* Window System Selections::Transferring text to and from other X clients.
-* Drag and Drop:: Internals of Drag-and-Drop implementation.
-* Color Names:: Getting the definitions of color names.
-* Text Terminal Colors:: Defining colors for text terminals.
-* Resources:: Getting resource values from the server.
-* Display Feature Testing:: Determining the features of a terminal.
-
-Frame Parameters
-
-* Parameter Access:: How to change a frame's parameters.
-* Initial Parameters:: Specifying frame parameters when you make a frame.
-* Window Frame Parameters:: List of frame parameters for window systems.
-* Size and Position:: Changing the size and position of a frame.
-* Geometry:: Parsing geometry specifications.
-
-Window Frame Parameters
-
-* Basic Parameters:: Parameters that are fundamental.
-* Position Parameters:: The position of the frame on the screen.
-* Size Parameters:: Frame's size.
-* Layout Parameters:: Size of parts of the frame, and
- enabling or disabling some parts.
-* Buffer Parameters:: Which buffers have been or should be shown.
-* Management Parameters:: Communicating with the window manager.
-* Cursor Parameters:: Controlling the cursor appearance.
-* Font and Color Parameters:: Fonts and colors for the frame text.
-
-Positions
-
-* Point:: The special position where editing takes place.
-* Motion:: Changing point.
-* Excursions:: Temporary motion and buffer changes.
-* Narrowing:: Restricting editing to a portion of the buffer.
-
-Motion
-
-* Character Motion:: Moving in terms of characters.
-* Word Motion:: Moving in terms of words.
-* Buffer End Motion:: Moving to the beginning or end of the buffer.
-* Text Lines:: Moving in terms of lines of text.
-* Screen Lines:: Moving in terms of lines as displayed.
-* List Motion:: Moving by parsing lists and sexps.
-* Skipping Characters:: Skipping characters belonging to a certain set.
-
-Markers
-
-* Overview of Markers:: The components of a marker, and how it relocates.
-* Predicates on Markers:: Testing whether an object is a marker.
-* Creating Markers:: Making empty markers or markers at certain places.
-* Information from Markers::Finding the marker's buffer or character position.
-* Marker Insertion Types:: Two ways a marker can relocate when you
- insert where it points.
-* Moving Markers:: Moving the marker to a new buffer or position.
-* The Mark:: How "the mark" is implemented with a marker.
-* The Region:: How to access "the region".
-
-Text
-
-* Near Point:: Examining text in the vicinity of point.
-* Buffer Contents:: Examining text in a general fashion.
-* Comparing Text:: Comparing substrings of buffers.
-* Insertion:: Adding new text to a buffer.
-* Commands for Insertion:: User-level commands to insert text.
-* Deletion:: Removing text from a buffer.
-* User-Level Deletion:: User-level commands to delete text.
-* The Kill Ring:: Where removed text sometimes is saved for
- later use.
-* Undo:: Undoing changes to the text of a buffer.
-* Maintaining Undo:: How to enable and disable undo information.
- How to control how much information is kept.
-* Filling:: Functions for explicit filling.
-* Margins:: How to specify margins for filling commands.
-* Adaptive Fill:: Adaptive Fill mode chooses a fill prefix
- from context.
-* Auto Filling:: How auto-fill mode is implemented to break lines.
-* Sorting:: Functions for sorting parts of the buffer.
-* Columns:: Computing horizontal positions, and using them.
-* Indentation:: Functions to insert or adjust indentation.
-* Case Changes:: Case conversion of parts of the buffer.
-* Text Properties:: Assigning Lisp property lists to text characters.
-* Substitution:: Replacing a given character wherever it appears.
-* Transposition:: Swapping two portions of a buffer.
-* Registers:: How registers are implemented. Accessing
- the text or position stored in a register.
-* Base 64:: Conversion to or from base 64 encoding.
-* Checksum/Hash:: Computing cryptographic hashes.
-* Parsing HTML/XML:: Parsing HTML and XML.
-* Atomic Changes:: Installing several buffer changes "atomically".
-* Change Hooks:: Supplying functions to be run when text is changed.
-
-The Kill Ring
-
-* Kill Ring Concepts:: What text looks like in the kill ring.
-* Kill Functions:: Functions that kill text.
-* Yanking:: How yanking is done.
-* Yank Commands:: Commands that access the kill ring.
-* Low-Level Kill Ring:: Functions and variables for kill ring access.
-* Internals of Kill Ring:: Variables that hold kill ring data.
-
-Indentation
-
-* Primitive Indent:: Functions used to count and insert indentation.
-* Mode-Specific Indent:: Customize indentation for different modes.
-* Region Indent:: Indent all the lines in a region.
-* Relative Indent:: Indent the current line based on previous lines.
-* Indent Tabs:: Adjustable, typewriter-like tab stops.
-* Motion by Indent:: Move to first non-blank character.
-
-Text Properties
-
-* Examining Properties:: Looking at the properties of one character.
-* Changing Properties:: Setting the properties of a range of text.
-* Property Search:: Searching for where a property changes value.
-* Special Properties:: Particular properties with special meanings.
-* Format Properties:: Properties for representing formatting of text.
-* Sticky Properties:: How inserted text gets properties from
- neighboring text.
-* Lazy Properties:: Computing text properties in a lazy fashion
- only when text is examined.
-* Clickable Text:: Using text properties to make regions of text
- do something when you click on them.
-* Fields:: The @code{field} property defines
- fields within the buffer.
-* Not Intervals:: Why text properties do not use
- Lisp-visible text intervals.
-
-Non-@acronym{ASCII} Characters
-
-* Text Representations:: How Emacs represents text.
-* Converting Representations:: Converting unibyte to multibyte and vice versa.
-* Selecting a Representation:: Treating a byte sequence as unibyte or multi.
-* Character Codes:: How unibyte and multibyte relate to
- codes of individual characters.
-* Character Properties:: Character attributes that define their
- behavior and handling.
-* Character Sets:: The space of possible character codes
- is divided into various character sets.
-* Scanning Charsets:: Which character sets are used in a buffer?
-* Translation of Characters:: Translation tables are used for conversion.
-* Coding Systems:: Coding systems are conversions for saving files.
-* Input Methods:: Input methods allow users to enter various
- non-ASCII characters without special keyboards.
-* Locales:: Interacting with the POSIX locale.
-
-Coding Systems
-
-* Coding System Basics:: Basic concepts.
-* Encoding and I/O:: How file I/O functions handle coding systems.
-* Lisp and Coding Systems:: Functions to operate on coding system names.
-* User-Chosen Coding Systems:: Asking the user to choose a coding system.
-* Default Coding Systems:: Controlling the default choices.
-* Specifying Coding Systems:: Requesting a particular coding system
- for a single file operation.
-* Explicit Encoding:: Encoding or decoding text without doing I/O.
-* Terminal I/O Encoding:: Use of encoding for terminal I/O.
-* MS-DOS File Types:: How DOS "text" and "binary" files
- relate to coding systems.
-
-Searching and Matching
-
-* String Search:: Search for an exact match.
-* Searching and Case:: Case-independent or case-significant searching.
-* Regular Expressions:: Describing classes of strings.
-* Regexp Search:: Searching for a match for a regexp.
-* POSIX Regexps:: Searching POSIX-style for the longest match.
-* Match Data:: Finding out which part of the text matched,
- after a string or regexp search.
-* Search and Replace:: Commands that loop, searching and replacing.
-* Standard Regexps:: Useful regexps for finding sentences, pages,...
-
-Regular Expressions
-
-* Syntax of Regexps:: Rules for writing regular expressions.
-* Regexp Example:: Illustrates regular expression syntax.
-* Regexp Functions:: Functions for operating on regular expressions.
-
-Syntax of Regular Expressions
-
-* Regexp Special:: Special characters in regular expressions.
-* Char Classes:: Character classes used in regular expressions.
-* Regexp Backslash:: Backslash-sequences in regular expressions.
-
-The Match Data
-
-* Replacing Match:: Replacing a substring that was matched.
-* Simple Match Data:: Accessing single items of match data,
- such as where a particular subexpression started.
-* Entire Match Data:: Accessing the entire match data at once, as a list.
-* Saving Match Data:: Saving and restoring the match data.
-
-Syntax Tables
-
-* Syntax Basics:: Basic concepts of syntax tables.
-* Syntax Descriptors:: How characters are classified.
-* Syntax Table Functions:: How to create, examine and alter syntax tables.
-* Syntax Properties:: Overriding syntax with text properties.
-* 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.
-
-Syntax Descriptors
-
-* Syntax Class Table:: Table of syntax classes.
-* Syntax Flags:: Additional flags each character can have.
-
-Parsing Expressions
-
-* Motion via Parsing:: Motion functions that work by parsing.
-* Position Parse:: Determining the syntactic state of a position.
-* Parser State:: How Emacs represents a syntactic state.
-* Low-Level Parsing:: Parsing across a specified region.
-* Control Parsing:: Parameters that affect parsing.
-
-Abbrevs and Abbrev Expansion
-
-* Abbrev Tables:: Creating and working with abbrev tables.
-* Defining Abbrevs:: Specifying abbreviations and their expansions.
-* Abbrev Files:: Saving abbrevs in files.
-* Abbrev Expansion:: Controlling expansion; expansion subroutines.
-* Standard Abbrev Tables:: Abbrev tables used by various major modes.
-* Abbrev Properties:: How to read and set abbrev properties.
- Which properties have which effect.
-* Abbrev Table Properties:: How to read and set abbrev table properties.
- Which properties have which effect.
-
-Processes
-
-* Subprocess Creation:: Functions that start subprocesses.
-* Shell Arguments:: Quoting an argument to pass it to a shell.
-* Synchronous Processes:: Details of using synchronous subprocesses.
-* Asynchronous Processes:: Starting up an asynchronous subprocess.
-* Deleting Processes:: Eliminating an asynchronous subprocess.
-* Process Information:: Accessing run-status and other attributes.
-* Input to Processes:: Sending input to an asynchronous subprocess.
-* Signals to Processes:: Stopping, continuing or interrupting
- an asynchronous subprocess.
-* Output from Processes:: Collecting output from an asynchronous subprocess.
-* Sentinels:: Sentinels run when process run-status changes.
-* Query Before Exit:: Whether to query if exiting will kill a process.
-* System Processes:: Accessing other processes running on your system.
-* Transaction Queues:: Transaction-based communication with subprocesses.
-* Network:: Opening network connections.
-* Network Servers:: Network servers let Emacs accept net connections.
-* Datagrams:: UDP network connections.
-* Low-Level Network:: Lower-level but more general function
- to create connections and servers.
-* Misc Network:: Additional relevant functions for
- network connections.
-* Serial Ports:: Communicating with serial ports.
-* Byte Packing:: Using bindat to pack and unpack binary data.
-
-Receiving Output from Processes
-
-* Process Buffers:: If no filter, output is put in a buffer.
-* Filter Functions:: Filter functions accept output from the process.
-* Decoding Output:: Filters can get unibyte or multibyte strings.
-* Accepting Output:: How to wait until process output arrives.
-
-Low-Level Network Access
-
-* Network Processes:: Using @code{make-network-process}.
-* Network Options:: Further control over network connections.
-* Network Feature Testing:: Determining which network features work on
- the machine you are using.
-
-Packing and Unpacking Byte Arrays
-
-* Bindat Spec:: Describing data layout.
-* Bindat Functions:: Doing the unpacking and packing.
-* Bindat Examples:: Samples of what bindat.el can do for you!
-
-Emacs Display
-
-* Refresh Screen:: Clearing the screen and redrawing everything on it.
-* Forcing Redisplay:: Forcing redisplay.
-* Truncation:: Folding or wrapping long text lines.
-* The Echo Area:: Displaying messages at the bottom of the screen.
-* Warnings:: Displaying warning messages for the user.
-* Invisible Text:: Hiding part of the buffer text.
-* Selective Display:: Hiding part of the buffer text (the old way).
-* Temporary Displays:: Displays that go away automatically.
-* Overlays:: Use overlays to highlight parts of the buffer.
-* Width:: How wide a character or string is on the screen.
-* Line Height:: Controlling the height of lines.
-* Faces:: A face defines a graphics style
- for text characters: font, colors, etc.
-* Fringes:: Controlling window fringes.
-* Scroll Bars:: Controlling vertical scroll bars.
-* Display Property:: Enabling special display features.
-* Images:: Displaying images in Emacs buffers.
-* Buttons:: Adding clickable buttons to Emacs buffers.
-* Abstract Display:: Emacs's Widget for Object Collections.
-* Blinking:: How Emacs shows the matching open parenthesis.
-* Character Display:: How Emacs displays individual characters.
-* Beeping:: Audible signal to the user.
-* Window Systems:: Which window system is being used.
-* Bidirectional Display:: Display of bidirectional scripts, such as
- Arabic and Farsi.
-
-The Echo Area
-
-* Displaying Messages:: Explicitly displaying text in the echo area.
-* Progress:: Informing user about progress of a long operation.
-* Logging Messages:: Echo area messages are logged for the user.
-* Echo Area Customization:: Controlling the echo area.
-
-Reporting Warnings
-
-* Warning Basics:: Warnings concepts and functions to report them.
-* Warning Variables:: Variables programs bind to customize
- their warnings.
-* Warning Options:: Variables users set to control display of warnings.
-* Delayed Warnings:: Deferring a warning until the end of a command.
-
-Overlays
-
-* Managing Overlays:: Creating and moving overlays.
-* Overlay Properties:: How to read and set properties.
- What properties do to the screen display.
-* Finding Overlays:: Searching for overlays.
-
-Faces
-
-* Defining Faces:: How to define a face.
-* Face Attributes:: What is in a face?
-* Attribute Functions:: Functions to examine and set face attributes.
-* Displaying Faces:: How Emacs combines the faces specified for
- a character.
-* Face Remapping:: Remapping faces to alternative definitions.
-* Face Functions:: How to define and examine faces.
-* Auto Faces:: Hook for automatic face assignment.
-* Basic Faces:: Faces that are defined by default.
-* Font Selection:: Finding the best available font for a face.
-* Font Lookup:: Looking up the names of available fonts
- and information about them.
-* Fontsets:: A fontset is a collection of fonts
- that handle a range of character sets.
-* Low-Level Font:: Lisp representation for character display fonts.
-
-Fringes
-
-* Fringe Size/Pos:: Specifying where to put the window fringes.
-* Fringe Indicators:: Displaying indicator icons in the window fringes.
-* Fringe Cursors:: Displaying cursors in the right fringe.
-* Fringe Bitmaps:: Specifying bitmaps for fringe indicators.
-* Customizing Bitmaps:: Specifying your own bitmaps to use in the fringes.
-* Overlay Arrow:: Display of an arrow to indicate position.
-
-The @code{display} Property
-
-* Replacing Specs:: Display specs that replace the text.
-* Specified Space:: Displaying one space with a specified width.
-* Pixel Specification:: Specifying space width or height in pixels.
-* Other Display Specs:: Displaying an image; adjusting the height,
- spacing, and other properties of text.
-* Display Margins:: Displaying text or images to the side of
- the main text.
-
-Images
-
-* Image Formats:: Supported image formats.
-* Image Descriptors:: How to specify an image for use in @code{:display}.
-* XBM Images:: Special features for XBM format.
-* XPM Images:: Special features for XPM format.
-* GIF Images:: Special features for GIF format.
-* TIFF Images:: Special features for TIFF format.
-* PostScript Images:: Special features for PostScript format.
-* ImageMagick Images:: Special features available through ImageMagick.
-* Other Image Types:: Various other formats are supported.
-* Defining Images:: Convenient ways to define an image for later use.
-* Showing Images:: Convenient ways to display an image once
- it is defined.
-* Animated Images:: Some image formats can be animated.
-* Image Cache:: Internal mechanisms of image display.
-
-Buttons
-
-* Button Properties:: Button properties with special meanings.
-* Button Types:: Defining common properties for classes of buttons.
-* Making Buttons:: Adding buttons to Emacs buffers.
-* Manipulating Buttons:: Getting and setting properties of buttons.
-* Button Buffer Commands:: Buffer-wide commands and bindings for buttons.
-
-Abstract Display
-
-* Abstract Display Functions:: Functions in the Ewoc package.
-* Abstract Display Example:: Example of using Ewoc.
-
-Character Display
-
-* Usual Display:: The usual conventions for displaying characters.
-* Display Tables:: What a display table consists of.
-* Active Display Table:: How Emacs selects a display table to use.
-* Glyphs:: How to define a glyph, and what glyphs mean.
-* Glyphless Chars:: How glyphless characters are drawn.
-
-Operating System Interface
-
-* Starting Up:: Customizing Emacs startup processing.
-* Getting Out:: How exiting works (permanent or temporary).
-* System Environment:: Distinguish the name and kind of system.
-* User Identification:: Finding the name and user id of the user.
-* Time of Day:: Getting the current time.
-* Time Conversion:: Converting a time from numeric form to
- calendrical data and vice versa.
-* Time Parsing:: Converting a time from numeric form to text
- and vice versa.
-* Processor Run Time:: Getting the run time used by Emacs.
-* Time Calculations:: Adding, subtracting, comparing times, etc.
-* Timers:: Setting a timer to call a function at a
- certain time.
-* Idle Timers:: Setting a timer to call a function when Emacs has
- been idle for a certain length of time.
-* Terminal Input:: Accessing and recording terminal input.
-* Terminal Output:: Controlling and recording terminal output.
-* Sound Output:: Playing sounds on the computer's speaker.
-* X11 Keysyms:: Operating on key symbols for X Windows.
-* Batch Mode:: Running Emacs without terminal interaction.
-* Session Management:: Saving and restoring state with
- X Session Management.
-* Notifications:: Desktop notifications.
-* Dynamic Libraries:: On-demand loading of support libraries.
-
-Starting Up Emacs
-
-* Startup Summary:: Sequence of actions Emacs performs at startup.
-* Init File:: Details on reading the init file.
-* Terminal-Specific:: How the terminal-specific Lisp file is read.
-* Command-Line Arguments:: How command-line arguments are processed,
- and how you can customize them.
-
-Getting Out of Emacs
-
-* Killing Emacs:: Exiting Emacs irreversibly.
-* Suspending Emacs:: Exiting Emacs reversibly.
-
-Terminal Input
-
-* Input Modes:: Options for how input is processed.
-* Recording Input:: Saving histories of recent or all input events.
-
-Preparing Lisp code for distribution
-
-* Packaging Basics:: The basic concepts of Emacs Lisp packages.
-* Simple Packages:: How to package a single .el file.
-* Multi-file Packages:: How to package multiple files.
-
-Tips and Conventions
-
-* Coding Conventions:: Conventions for clean and robust programs.
-* Key Binding Conventions:: Which keys should be bound by which programs.
-* Programming Tips:: Making Emacs code fit smoothly in Emacs.
-* Compilation Tips:: Making compiled code run fast.
-* Warning Tips:: Turning off compiler warnings.
-* Documentation Tips:: Writing readable documentation strings.
-* Comment Tips:: Conventions for writing comments.
-* Library Headers:: Standard headers for library packages.
-
-GNU Emacs Internals
-
-* Building Emacs:: How the dumped Emacs is made.
-* Pure Storage:: Kludge to make preloaded Lisp functions shareable.
-* Garbage Collection:: Reclaiming space for Lisp objects no longer used.
-* Memory Usage:: Info about total size of Lisp objects made so far.
-* Writing Emacs Primitives:: Writing C code for Emacs.
-* Object Internals:: Data formats of buffers, windows, processes.
-
-Object Internals
-
-* Buffer Internals:: Components of a buffer structure.
-* Window Internals:: Components of a window structure.
-* Process Internals:: Components of a process structure.
-@end detailmenu
-@end menu
-
-@c include intro.texi
-@c include objects.texi
-@c include numbers.texi
-@c include strings.texi
-
-@c include lists.texi
-@c include sequences.texi
-@c include hash.texi
-@c include symbols.texi
-@c include eval.texi
-
-@c include control.texi
-@c include variables.texi
-@c include functions.texi
-@c include macros.texi
-
-@c include customize.texi
-@c include loading.texi
-@c include compile.texi
-@c include advice.texi
-
-@c This includes edebug.texi.
-@c include debugging.texi
-@c include streams.texi
-@c include minibuf.texi
-@c include commands.texi
-
-@c include keymaps.texi
-@c include modes.texi
-@c include help.texi
-@c include files.texi
-
-@c include backups.texi
-
-@c ================ Beginning of Volume 2 ================
-@include buffers.texi
-@include windows.texi
-@include frames.texi
-
-@include positions.texi
-@include markers.texi
-@include text.texi
-@include nonascii.texi
-
-@include searching.texi
-@include syntax.texi
-@include abbrevs.texi
-@include processes.texi
-
-@include display.texi
-@include os.texi
-@include package.texi
-
-@c appendices
-
-@include anti.texi
-@include doclicense.texi
-@include gpl.texi
-@include tips.texi
-@include internals.texi
-@include errors.texi
-@include maps.texi
-@include hooks.texi
-
-@include index.texi
-
-@ignore
-@node New Symbols, , Index, Top
-@unnumbered New Symbols Since the Previous Edition
-
-@printindex tp
-@end ignore
-
-@bye
-
-\f
-These words prevent "local variables" above from confusing Emacs.
@c Copyright (C) 1990-1995, 1998-1999, 2001-2012
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
-@setfilename ../../info/windows
-@node Windows, Frames, Buffers, Top
+@node Windows
@chapter Windows
This chapter describes the functions and variables related to Emacs
@defun select-window window &optional norecord
This function makes @var{window} the selected window, as well as the
-window selected within its frame (@pxref{Basic Windows}).
-@var{window} must be a live window. Unless @var{window} already is the
-selected window, its buffer becomes the current buffer (@pxref{Buffers
-and Windows}). The return value is @var{window}.
+window selected within its frame (@pxref{Basic Windows}). @var{window}
+must be a live window. This function makes also @var{window}'s buffer
+current (@pxref{Buffers and Windows}). The return value is
+@var{window}.
-By default, this function also moves @var{window}'s selected buffer to
-the front of the buffer list (@pxref{The Buffer List}), and makes
-@var{window} the most recently selected window. However, if the
-optional argument @var{norecord} is non-@code{nil}, these additional
-actions are omitted.
+By default, this function also moves @var{window}'s buffer to the front
+of the buffer list (@pxref{The Buffer List}), and makes @var{window} the
+most recently selected window. However, if the optional argument
+@var{norecord} is non-@code{nil}, these additional actions are omitted.
@end defun
@cindex most recently selected windows
@code{set-buffer}. @xref{Current Buffer}.
@deffn Command switch-to-buffer buffer-or-name &optional norecord force-same-window
-This function displays @var{buffer-or-name} in the selected window,
-and makes it the current buffer. (In contrast, @code{set-buffer}
-makes the buffer current but does not display it; @pxref{Current
-Buffer}). It is often used interactively (as the binding of @kbd{C-x
-b}), as well as in Lisp programs. The return value is the buffer
-switched to.
+This command attempts to display @var{buffer-or-name} in the selected
+window, and makes it the current buffer. It is often used
+interactively (as the binding of @kbd{C-x b}), as well as in Lisp
+programs. The return value is the buffer switched to.
If @var{buffer-or-name} is @code{nil}, it defaults to the buffer
returned by @code{other-buffer} (@pxref{The Buffer List}). If
buffer's major mode is determined by the variable @code{major-mode}
(@pxref{Major Modes}).
-Normally the specified buffer is put at the front of the buffer
+Normally, the specified buffer is put at the front of the buffer
list---both the global buffer list and the selected frame's buffer
list (@pxref{The Buffer List}). However, this is not done if the
optional argument @var{norecord} is non-@code{nil}.
-If this function is unable to display the buffer in the selected
-window---usually because the selected window is a minibuffer window or
-is strongly dedicated to its buffer (@pxref{Dedicated Windows})---then
-it normally tries to display the buffer in some other window, in the
-manner of @code{pop-to-buffer} (see below). However, if the optional
-argument @var{force-same-window} is non-@code{nil}, it signals an error
+Sometimes, @code{switch-to-buffer} may be unable to display the buffer
+in the selected window. This happens if the selected window is a
+minibuffer window, or if the selected window is strongly dedicated to
+its buffer (@pxref{Dedicated Windows}). In that case, the command
+normally tries to display the buffer in some other window, by invoking
+@code{pop-to-buffer} (see below). However, if the optional argument
+@var{force-same-window} is non-@code{nil}, it signals an error
instead.
@end deffn
@end itemize
If @var{alist} contains no @code{reusable-frames} entry, this function
-normally searches just the selected frame; however, if either the
-variable @code{display-buffer-reuse-frames} or the variable
+normally searches just the selected frame; however, if the variable
@code{pop-up-frames} is non-@code{nil}, it searches all frames on the
current terminal. @xref{Choosing Window Options}.
(@pxref{Choosing Window}) can be modified by a variety of user
options.
-@defopt display-buffer-reuse-frames
-If the value of this variable is non-@code{nil}, @code{display-buffer}
-may search all frames on the current terminal when looking for a
-window already displaying the specified buffer. The default is
-@code{nil}. This variable is consulted by the action function
-@code{display-buffer-reuse-window} (@pxref{Display Action Functions}).
-@end defopt
-
@defopt pop-up-windows
If the value of this variable is non-@code{nil}, @code{display-buffer}
is allowed to split an existing window to make a new window for
window's buffer) if that window were selected. The default for
@var{window} is the selected window.
-When @var{window} is the selected window and its buffer is also the
-current buffer, the value returned is the same as point in that buffer.
-Strictly speaking, it would be more correct to return the ``top-level''
-value of point, outside of any @code{save-excursion} forms. But that
-value is hard to find.
+When @var{window} is the selected window, the value returned is the
+value of point in that window's buffer. Strictly speaking, it would be
+more correct to return the ``top-level'' value of point, outside of any
+@code{save-excursion} forms. But that value is hard to find.
@end defun
@defun set-window-point window position
This function positions point in @var{window} at position
@var{position} in @var{window}'s buffer. It returns @var{position}.
-If @var{window} is selected, and its buffer is current,
-this simply does @code{goto-char}.
+If @var{window} is selected, this simply does @code{goto-char} in
+@var{window}'s buffer.
@end defun
@defvar window-point-insertion-type
@end defun
@defmac save-window-excursion forms@dots{}
-This special form records the window configuration, executes @var{forms}
-in sequence, then restores the earlier window configuration. The window
-configuration includes, for each window, the value of point and the
-portion of the buffer that is visible. It also includes the choice of
-selected window. However, it does not include the value of point in
-the current buffer; use @code{save-excursion} also, if you wish to
-preserve that.
-
-Don't use this construct when @code{save-selected-window} is sufficient.
-
-Exit from @code{save-window-excursion} always triggers execution of
-@code{window-size-change-functions}. (It doesn't know how to tell
-whether the restored configuration actually differs from the one in
-effect at the end of the @var{forms}.)
-
-The return value is the value of the final form in @var{forms}.
-For example:
-
-@example
-@group
-(split-window)
- @result{} #<window 25 on control.texi>
-@end group
-@group
-(setq w (selected-window))
- @result{} #<window 19 on control.texi>
-@end group
-@group
-(save-window-excursion
- (delete-other-windows w)
- (switch-to-buffer "foo")
- 'do-something)
- @result{} do-something
- ;; @r{The screen is now split again.}
-@end group
-@end example
+This macro records the window configuration of the selected frame,
+executes @var{forms} in sequence, then restores the earlier window
+configuration. The return value is the value of the final form in
+@var{forms}.
+
+Most Lisp code should not use this macro; @code{save-selected-window}
+is typically sufficient. In particular, this macro cannot reliably
+prevent the code in @var{forms} from opening new windows, because new
+windows might be opened in other frames (@pxref{Choosing Window}), and
+@code{save-window-excursion} only saves and restores the window
+configuration on the current frame.
+
+Do not use this macro in @code{window-size-change-functions}; exiting
+the macro triggers execution of @code{window-size-change-functions},
+leading to an endless loop.
@end defmac
@defun window-configuration-p object
causes these functions to be called. Changing the frame size also
counts, because it changes the sizes of the existing windows.
-It is not a good idea to use @code{save-window-excursion} (@pxref{Window
-Configurations}) in these functions, because that always counts as a
-size change, and it would cause these functions to be called over and
-over. In most cases, @code{save-selected-window} (@pxref{Selecting
-Windows}) is what you need here.
+You may use @code{save-selected-window} in these functions
+(@pxref{Selecting Windows}). However, do not use
+@code{save-window-excursion} (@pxref{Window Configurations}); exiting
+that macro counts as a size change, which would cause these functions
+to be called over and over.
@end defvar
@defvar window-configuration-change-hook
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-06-03 Glenn Morris <rgm@gnu.org>
- * Version 24.2 released.
+ * rcs-checkin.1: Remove.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-04-07 Glenn Morris <rgm@gnu.org>
- * Version 24.1 released.
+ * emacs.1: Bump version to 24.1.50.
2011-11-16 Juanma Barranquero <lekktu@gmail.com>
;; Local Variables:
;; coding: utf-8
-;; fill-column: 79
-;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2007-2012 Free Software Foundation, Inc.
+ Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
.\" See section COPYING for copyright and redistribution information.
-.TH EMACS 1 "2007 April 13" "GNU Emacs 24.2"
+.TH EMACS 1 "2007 April 13" "GNU Emacs 24.2.50"
.
.
.SH NAME
.SH AUTHORS
.I Emacs
was written by Richard Stallman and the Free Software Foundation.
-For detailed credits and acknowledgements, see the GNU Emacs manual.
+For detailed credits and acknowledgments, see the GNU Emacs manual.
.
.
.
+++ /dev/null
-.\" See section COPYING for copyright and redistribution information.
-.TH rcs-checkin 1
-.SH NAME
-rcs-checkin \- check files into RCS
-.SH SYNOPSIS
-.B rcs-checkin
-.RI [ FILE .\|.\|.]
-.SH DESCRIPTION
-.B rcs-checkin
-is a helper script for checking files into RCS. This program is
-distributed with
-.BR "GNU Emacs" .
-
-This program converts files with an old
-.BR Emacs -style
-version history for use with the
-.B "Emacs 19"
-version control interface
-.BR VC ,
-which likes to use RCS as its back end.
-
-For each file to be processed, the script looks for
-.B Emacs
-version files related to it. These files are checked in as deltas,
-oldest first, so that the contents of the file itself becomes the
-latest revision in the master.
-
-The first line of each file is used as its description. The file
-itself is not deleted, as under
-.B VC
-with
-.B vc-keep-workfiles
-at its default of
-.BR t ,
-but all the version files are.
-
-If an argument file is already version-controlled under RCS, any
-version files are added to the list of deltas and deleted, and then
-the workfile is checked in again as the latest version. This is
-probably not quite what was wanted, and is the main reason VC doesn't
-simply call this to do checkins.
-
-In order to make it easier to use
-.BR "rcs-checkin *" ,
-files which are detectably either RCS masters (with names ending in
-.BR ,v )
-or Emacs version files (with names containing
-.BR ~ )
-are ignored.
-.
-.PP
-.SH OPTIONS
-The program accepts no options.
-.
-.SH SEE ALSO
-The Emacs version control interface is documented in the GNU Emacs manual,
-which you can read using
-.BR Info ,
-either from Emacs or as a standalone program.
-.
-.SH AUTHORS
-.I rcs-checkin
-was originally written by Paul Eggert. It was revised for use with
-.B "GNU Emacs"
-.B VC
-by Eric S. Raymond.
-.
-.SH COPYING
-Copyright
-.if t \(co
-.if n (C)
-2008-2012 Free Software Foundation, Inc.
-.PP
-Permission is granted to make and distribute verbatim copies of this
-document provided the copyright notice and this permission notice are
-preserved on all copies.
-.PP
-Permission is granted to copy and distribute modified versions of
-this document under the conditions for verbatim copying, provided that
-the entire resulting derived work is distributed under the terms of
-a permission notice identical to this one.
-.PP
-Permission is granted to copy and distribute translations of this
-document into another language, under the above conditions for
-modified versions, except that this permission notice may be stated
-in a translation approved by the Free Software Foundation.
-.
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.2 released.
+ * texinfo.tex: Merge from gnulib.
+
+2012-09-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6.
+
+ * tramp.texi (Bug Reports): Cleanup caches before a test run.
+
+ * trampver.texi: Update release number.
+
+2012-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Merge from gnulib.
2012-08-06 Aurélien Aptel <aurelien.aptel@gmail.com>
* url.texi (Parsed URLs): Adjust to the code's use of defstruct
(bug#12096).
+2012-08-01 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * 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 <jay.p.belanger@gmail.com>
+
+ * calc.texi (Getting Started, Tutorial): Change simulated
+ Calc output to match actual output.
+ (Simplifying Formulas): Mention that algebraic simplification is now
+ the default.
+
2012-07-28 Eli Zaretskii <eliz@gnu.org>
* faq.texi (Right-to-left alphabets): Update for Emacs 24.
(Bug#12073)
-2012-06-19 Glenn Morris <rgm@gnu.org>
+2012-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer typical American spelling for "acknowledgment".
+ * calc.texi (History and Acknowledgments): Rename from
+ History and Acknowledgements.
+ * idlwave.texi (Acknowledgments):
+ * ses.texi (Acknowledgments):
+ * woman.texi (Acknowledgments): Rename from Acknowledgements.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename configure.in to configure.ac (Bug#11603).
+ * ede.texi (Compiler and Linker objects, ede-proj-project)
+ (ede-step-project): Prefer the name configure.ac to configure.in.
+
+2012-07-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * tramp.texi (Multi-hops): Introduce
+ `tramp-restricted-shell-hosts-alist'.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (POP before SMTP): POP-before-SMTP works with all sending
+ methods, so don't mention smtpmail here.
+
+2012-06-26 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus.texi (Picons): Document gnus-picon-properties.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi: Remove mention of compilation, as that's no longer
+ supported.
+
+2012-06-26 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * gnus.texi (Archived Messages): Mention
+ gnus-gcc-pre-body-encode-hook and gnus-gcc-post-body-encode-hook.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Various Summary Stuff):
+ Remove mention of `gnus-propagate-marks'.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi: Remove mentions of nnml/nnfolder/nntp backend marks,
+ which no longer exist.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.texi (Archived Messages):
+ Document gnus-gcc-self-resent-messages.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.texi (Mail Variables):
+ Mention the optional user parameter for X-Message-SMTP-Method.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Posting Styles): Mention X-Message-SMTP-Method.
+
+ * message.texi (Mail Variables): Document X-Message-SMTP-Method.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Key Index): Change encoding to utf-8.
+
+2012-06-21 Glenn Morris <rgm@gnu.org>
* Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-06-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Group Timestamp): Mention where to find documentation for
+ the `gnus-tmp-' variables (bug#11601).
- * Version 24.1 released.
+2012-06-11 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6-pre.
+
+ * tramp.texi (all): Use consequently @command{}, @env{} and @kbd{}
+ where appropriate.
+ (Ad-hoc multi-hops): New section.
+ (Remote processes): New subsection "Running remote processes on
+ Windows hosts".
+ (History): Add remote commands on Windows, and ad-hoc multi-hop
+ methods.
+ (External methods): "ControlPersist" must be set to "no" for the
+ `scpc' method.
+ (Remote processes): Add a note about `auto-revert-tail-mode'.
+ (Frequently Asked Questions): Use "scpx" in combination with
+ "ControlPersist". Reported by Adam Spiers <emacs@adamspiers.org>.
+
+ * trampver.texi: Update release number.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-06-10 Chong Yidong <cyd@gnu.org>
* sc.texi: Remove bogus @ifinfo commands which prevent makeinfo
compilation for html-mono.
-2012-05-16 Bastien Guerry <bzg@gnu.org>
+2012-06-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Merge from gnulib.
+
+2012-05-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * Makefile.in (echo-info): Don't try to install info files named
+ just ".info".
+
+2012-05-28 Glenn Morris <rgm@gnu.org>
+
+ * calc.texi, dired-x.texi: Use @LaTeX rather than La@TeX. (Bug#10910)
+
+ * sc.texi: Nuke hand-written node pointers.
+ Fix top-level menu to match actual node order.
+
+2012-05-27 Glenn Morris <rgm@gnu.org>
+
+ * cl.texi, dired-x.texi: Nuke hand-written node pointers.
+ Some associated fixes, including not messing with chapno in cl.texi.
+
+2012-05-27 Bastien Guerry <bzg@gnu.org>
* org.texi (Durations and time values): Fix typo.
-2012-05-12 Andreas Schwab <schwab@linux-m68k.org>
+2012-05-19 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * doc/misc/calc.texi (Basic Operations on Units, Customizing Calc):
+ Mention `calc-ensure-consistent-units'.
+
+2012-05-14 Andreas Schwab <schwab@linux-m68k.org>
* cc-mode.texi: Avoid space before macro in 4th argument of cross
reference commands. (Bug#11461)
* Makefile.in (gnus.dvi): Use $@ instead of $*.dvi.
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (mostlyclean): Add more TeX intermediates.
+
+ * Makefile.in: Make it look more like the other doc Makefiles.
+ Use explicit $srcdir in all dependencies.
+ Remove cd $srcdir from rules.
+ (VPATH): Remove.
+ (infodir): Set to an absolute path.
+ (INFO_TARGETS): Use short names.
+ (mkinfodir): infodir is now absolute.
+ (echo-info, maintainer-clean): Update for new format of INFO_TARGETS.
+
+ * Makefile.in (info.info): Rename from info, to avoid duplication.
+ (.SUFFIXES): Disable implicit rules.
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (mkinfodir): Use $MKDIR_P.
+
+2012-05-07 Glenn Morris <rgm@gnu.org>
+
+ * forms.texi (Long Example): Update for changed location of files.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (INFO_EXT, INFO_OPTS): New, set by configure.
+ (INFO_TARGETS): Use $INFO_EXT.
+ Make all rules generating info files use $INFO_EXT, $INFO_OPT, and -o.
+ * makefile.w32-in (INFO_EXT, INFO_OPTS): New.
+ (INFO_TARGETS): Use $INFO_EXT.
+ Make all rules generating info files use $INFO_EXT, $INFO_OPT, and -o.
+
2012-05-02 Glenn Morris <rgm@gnu.org>
+ * Makefile.in (echo-info): New phony target, used by top-level.
+
* viper.texi: Make direntry shorter (also it is no longer "newest").
* emacs-gnutls.texi, ert.texi, org.texi:
Fix dircategory, direntry to match info/dir.
-2012-04-28 Glenn Morris <rgm@gnu.org>
-
* faq.texi: Convert @inforefs to @xrefs.
Fix some malformed cross-references.
(File-name conventions): Shorten section name to avoid overfull line.
(How to add fonts): Use smallexample to avoid overfull lines.
-2012-04-26 Ippei Furuhashi <top.tuna+orgmode@gmail.com> (tiny change)
+2012-05-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth.texi (Help for users): Update for .gpg file being second.
+
+2012-04-27 Ippei Furuhashi <top.tuna+orgmode@gmail.com> (tiny change)
* org.texi (Agenda commands): Fix two typos: give corresponding
function names, according to `org-agenda-view-mode-dispatch'.
-2012-04-21 Glenn Morris <rgm@gnu.org>
+2012-04-27 Glenn Morris <rgm@gnu.org>
* faq.texi (Major packages and programs): Remove section.
There is no point listing 6 packages (cf etc/MORE.STUFF).
(Finding Emacs and related packages): Move "Spell-checkers" here.
+2012-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbus.texi (Version): New node.
+ (Properties and Annotations): Mention the object manager
+ interface. Describe dbus-get-all-managed-objects.
+ (Type Conversion): Floating point numbers are allowed, if an
+ anteger does not fit Emacs's integer range.
+ (Synchronous Methods): Remove obsolete dbus-call-method-non-blocking.
+ (Asynchronous Methods): Fix description of
+ dbus-call-method-asynchronously.
+ (Receiving Method Calls): Fix some minor errors. Add
+ dbus-interface-emacs.
+ (Signals): Describe unicast signals and the new match rules.
+ (Alternative Buses): Add the PRIVATE optional argument to
+ dbus-init-bus. Describe its new return value. Add dbus-setenv.
+
2012-04-20 Glenn Morris <rgm@gnu.org>
* faq.texi (New in Emacs 24): New section.
(Packages that do not come with Emacs): Mention M-x list-packages.
-2012-04-13 Glenn Morris <rgm@gnu.org>
-
- * Makefile.in: Replace non-portable use of $< in emacs-gnutls rules.
-
-2012-04-12 Eli Zaretskii <eliz@gnu.org>
-
- * makefile.w32-in (INFO_TARGETS, DVI_TARGETS, clean): Add emacs-gnutls.
- ($(infodir)/emacs-gnutls, emacs-gnutls.dvi): New targets.
-
-2012-04-12 Teodor Zlatanov <tzz@lifelogs.com>
-
- * emacs-gnutls.texi: Add documentation for the GnuTLS integration.
- * Makefile.in: Add emacs-gnutls.texi to build.
-
-2012-04-11 Alan Mackenzie <acm@muc.de>
+2012-04-14 Alan Mackenzie <acm@muc.de>
* cc-mode.texi (c-offsets-alist): Correct a typo.
-2012-04-11 Jérémie Courrèges-Anglas <jca@wxcvbn.org> (tiny change)
+2012-04-14 Jérémie Courrèges-Anglas <jca@wxcvbn.org> (tiny change)
* org.texi (Deadlines and scheduling): Fix the example: the
DEADLINE item should come right after the headline. We enforce
this convention, so it is a bug not to illustrate it correctly in
the manual.
-2012-04-11 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change)
+2012-04-14 Ippei FURUHASHI <top.tuna+orgmode@gmail.com> (tiny change)
* org.texi (Agenda commands): Fix documentation bug by swapping
the equivalent keybindings to `org-agenda-next-line' with the ones
to `org-agenda-previous-line'.
-2012-04-07 Glenn Morris <rgm@gnu.org>
+2012-04-14 Glenn Morris <rgm@gnu.org>
* Makefile.in: Replace non-portable use of $< in ordinary rules.
+2012-04-09 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (INFO_TARGETS, DVI_TARGETS, clean): Add
+ emacs-gnutls.
+ ($(infodir)/emacs-gnutls, emacs-gnutls.dvi): New targets.
+
+2012-04-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * Makefile.in: Add emacs-gnutls.texi to build.
+
+ * emacs-gnutls.texi: Add documentation for the GnuTLS integration.
+
2012-04-05 Teodor Zlatanov <tzz@lifelogs.com>
* auth.texi (Secret Service API): Edit further and give examples.
* mh-e.texi (VERSION, EDITION, UPDATED, UPDATE-MONTH): Update for
release 8.3.
(Preface): Updated support information.
- (From Bill Wohler): Reset text to original version. As a
+ (From Bill Wohler): Reset text to original version. As a
historical quote, the tense should be correct in the time that it
was written.
2011-08-15 Suvayu Ali <fatkasuvayu+linux@gmail.com> (tiny change)
- * org.texi (Images in LaTeX export): rewrite.
+ * org.texi (Images in LaTeX export): Rewrite.
2011-08-15 Bastien Guerry <bzg@gnu.org>
- * org.texi (Using the mapping API): mention 'region as a possible
+ * org.texi (Using the mapping API): Mention 'region as a possible
scope for `org-map-entries'.
2011-08-15 Carsten Dominik <carsten.dominik@gmail.com>
2011-08-15 Bastien Guerry <bzg@gnu.org>
- * org.texi (Template expansion): order template sequences in the
+ * org.texi (Template expansion): Order template sequences in the
proper order.
2011-08-15 Eric Schulte <schulte.eric@gmail.com>
2011-08-15 Achim Gratz <stromeko@nexgo.de>
- * org.texi: document that both CLOCK_INTO_DRAWER and
+ * org.texi: Document that both CLOCK_INTO_DRAWER and
LOG_INTO_DRAWER can be used to override the contents of variable
org-clock-into-drawer (or if unset, org-log-into-drawer).
- * org.texi: replace @xref->@pxref.
+ * org.texi: Replace @xref->@pxref.
2011-08-15 Eric Schulte <schulte.eric@gmail.com>
2011-08-15 Eric Schulte <schulte.eric@gmail.com>
- * org.texi (Structure of code blocks): explicitly state that the
- behavior of multiple blocks of the same name is undefined
+ * org.texi (Structure of code blocks): Explicitly state that the
+ behavior of multiple blocks of the same name is undefined.
2011-08-15 Christian Egli <christian.egli@sbszh.ch>
2011-08-15 Bastien Guerry <bzg@gnu.org>
- * org.texi (LaTeX and PDF export): add a note about a limitation
+ * org.texi (LaTeX and PDF export): Add a note about a limitation
of the LaTeX export: the org file has to be properly structured.
2011-08-15 Bastien Guerry <bzg@gnu.org>
2011-03-19 Antoine Levitt <antoine.levitt@gmail.com>
- * gnus.texi (Listing Groups): Document gnus-group-list-ticked
+ * gnus.texi (Listing Groups): Document gnus-group-list-ticked.
2011-03-17 Jay Belanger <jay.p.belanger@gmail.com>
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
- * org.texi: multi-line header arguments :PROPERTIES: :ID:
+ * org.texi: Multi-line header arguments :PROPERTIES: :ID:
b77c8857-6c76-4ea9-8a61-ddc2648d96c4 :END:.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
2009-07-29 Jay Belanger <jay.p.belanger@gmail.com>
* calc.texi (Stack Manipulation Commands): Add documentation for
- `calc-transpose-lines'
+ `calc-transpose-lines'.
2009-07-27 Michael Albinus <michael.albinus@gmx.de>
2007-11-07 Michael Albinus <michael.albinus@gmx.de>
* tramp.texi (Overview): Mention also the PuTTY integration under
- Win32. Remove paragraphs about Tramp's experimental status.
+ w32. Remove paragraphs about Tramp's experimental status.
(Frequently Asked Questions): Add code example for highlighting the
mode line.
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2012 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
# set by the configure script's `--srcdir' option.
srcdir=@srcdir@
-# Tell make where to find source files; this is needed for the makefiles.
-# Note the other doc Makefiles do not use VPATH anymore, instead
-# they set buildinfodir to an absolute path. Not doing that here in
-# case INFO_TARGETS gets too long for some feeble shells.
-# (cf src/Makefile.in's passing of $lisp to make-docfile)
-VPATH=@srcdir@
-
## Where the output files go.
-## Note that the setfilename command in the .texi files assumes this.
-buildinfodir=../../info
+buildinfodir = $(srcdir)/../../info
## Directory with emacsver.texi.
## Currently only used by efaq and calc.
emacsdir = $(srcdir)/../emacs
+MKDIR_P = @MKDIR_P@
+
+INFO_EXT=@INFO_EXT@
+# Options used only when making info output.
+INFO_OPTS=@INFO_OPTS@
+
# The makeinfo program is part of the Texinfo distribution.
# Use --force so that it generates output even if there are errors.
MAKEINFO = @MAKEINFO@
MAKEINFO_OPTS = --force -I$(emacsdir)
-# Also add new entries to INFO_FILES in the top-level Makefile.in.
-INFO_TARGETS = \
- $(buildinfodir)/ada-mode \
- $(buildinfodir)/auth \
- $(buildinfodir)/autotype \
- $(buildinfodir)/calc \
- $(buildinfodir)/ccmode \
- $(buildinfodir)/cl \
- $(buildinfodir)/dbus \
- $(buildinfodir)/dired-x \
- $(buildinfodir)/ebrowse \
- $(buildinfodir)/ede \
- $(buildinfodir)/ediff \
- $(buildinfodir)/edt \
- $(buildinfodir)/eieio \
- $(buildinfodir)/emacs-mime \
- $(buildinfodir)/epa \
- $(buildinfodir)/erc \
- $(buildinfodir)/ert \
- $(buildinfodir)/eshell \
- $(buildinfodir)/eudc \
- $(buildinfodir)/efaq \
- $(buildinfodir)/flymake \
- $(buildinfodir)/forms \
- $(buildinfodir)/gnus \
- $(buildinfodir)/emacs-gnutls \
- $(buildinfodir)/idlwave \
- $(buildinfodir)/info \
- $(buildinfodir)/mairix-el \
- $(buildinfodir)/message \
- $(buildinfodir)/mh-e \
- $(buildinfodir)/newsticker \
- $(buildinfodir)/nxml-mode \
- $(buildinfodir)/org \
- $(buildinfodir)/pcl-cvs \
- $(buildinfodir)/pgg \
- $(buildinfodir)/rcirc \
- $(buildinfodir)/remember \
- $(buildinfodir)/reftex \
- $(buildinfodir)/sasl \
- $(buildinfodir)/sc \
- $(buildinfodir)/semantic \
- $(buildinfodir)/ses \
- $(buildinfodir)/sieve \
- $(buildinfodir)/smtpmail \
- $(buildinfodir)/speedbar \
- $(buildinfodir)/tramp \
- $(buildinfodir)/url \
- $(buildinfodir)/vip \
- $(buildinfodir)/viper \
- $(buildinfodir)/widget \
- $(buildinfodir)/woman
+INFO_TARGETS = ada-mode auth autotype calc ccmode cl \
+ dbus dired-x ebrowse ede ediff edt eieio \
+ emacs-mime epa erc ert eshell eudc efaq \
+ flymake forms gnus emacs-gnutls idlwave info.info \
+ mairix-el message mh-e newsticker nxml-mode \
+ org pcl-cvs pgg rcirc remember reftex sasl \
+ sc semantic ses sieve smtpmail speedbar tramp \
+ url vip viper widget woman
DVI_TARGETS = \
ada-mode.dvi \
ENVADD = TEXINPUTS="$(srcdir):$(emacsdir):$(TEXINPUTS)" \
MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)"
-mkinfodir = @cd ${srcdir}; test -d ${buildinfodir} || mkdir ${buildinfodir} || test -d ${buildinfodir}
+mkinfodir = @${MKDIR_P} ${buildinfodir}
-.PHONY: info dvi pdf
+.PHONY: info dvi pdf echo-info
+## Prevent implicit rule triggering for foo.info.
+.SUFFIXES:
+# Default.
info: $(INFO_TARGETS)
+## Used by top-level Makefile.
+## Base file names of output info files.
+echo-info:
+ @echo "$(INFO_TARGETS) " | \
+ sed -e 's|[^ ]*/||g' -e 's/\.info//g' -e "s/ */$(INFO_EXT) /g"
+
# please modify this for all the web manual targets
webhack: clean
$(MAKE) pdf MAKEINFO_OPTS="-DWEBHACKDEVEL $(MAKEINFO_OPTS)"
pdf: $(PDF_TARGETS)
-# Note that all the Info targets build the Info files
-# in srcdir. There is no provision for Info files
-# to exist in the build directory.
+# Note that all the Info targets build the Info files in srcdir.
+# There is no provision for Info files to exist in the build directory.
# In a distribution of Emacs, the Info files should be up to date.
# Note: "<" is not portable in ordinary make rules.
-## "short" target names for convenience, to just rebuild one manual.
-ada-mode : $(buildinfodir)/ada-mode
-$(buildinfodir)/ada-mode: ada-mode.texi
+ada-mode : $(buildinfodir)/ada-mode$(INFO_EXT)
+$(buildinfodir)/ada-mode$(INFO_EXT): ${srcdir}/ada-mode.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) ada-mode.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ada-mode.texi
ada-mode.dvi: ${srcdir}/ada-mode.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/ada-mode.texi
ada-mode.pdf: ${srcdir}/ada-mode.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/ada-mode.texi
-auth : $(buildinfodir)/auth
-$(buildinfodir)/auth: auth.texi
+auth : $(buildinfodir)/auth$(INFO_EXT)
+$(buildinfodir)/auth$(INFO_EXT): ${srcdir}/auth.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) auth.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/auth.texi
auth.dvi: ${srcdir}/auth.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/auth.texi
auth.pdf: ${srcdir}/auth.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/auth.texi
-autotype : $(buildinfodir)/autotype
-$(buildinfodir)/autotype: autotype.texi
+autotype : $(buildinfodir)/autotype$(INFO_EXT)
+$(buildinfodir)/autotype$(INFO_EXT): ${srcdir}/autotype.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) autotype.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/autotype.texi
autotype.dvi: ${srcdir}/autotype.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/autotype.texi
autotype.pdf: ${srcdir}/autotype.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/autotype.texi
-calc : $(buildinfodir)/calc
-$(buildinfodir)/calc: calc.texi $(emacsdir)/emacsver.texi
+calc : $(buildinfodir)/calc$(INFO_EXT)
+$(buildinfodir)/calc$(INFO_EXT): ${srcdir}/calc.texi $(emacsdir)/emacsver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) calc.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/calc.texi
calc.dvi: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/calc.texi
calc.pdf: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/calc.texi
-ccmode : $(buildinfodir)/ccmode
-$(buildinfodir)/ccmode: cc-mode.texi
+ccmode : $(buildinfodir)/ccmode$(INFO_EXT)
+$(buildinfodir)/ccmode$(INFO_EXT): ${srcdir}/cc-mode.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) cc-mode.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/cc-mode.texi
cc-mode.dvi: ${srcdir}/cc-mode.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/cc-mode.texi
cc-mode.pdf: ${srcdir}/cc-mode.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/cc-mode.texi
-cl : $(buildinfodir)/cl
-$(buildinfodir)/cl: cl.texi
+cl : $(buildinfodir)/cl$(INFO_EXT)
+$(buildinfodir)/cl$(INFO_EXT): ${srcdir}/cl.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) cl.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/cl.texi
cl.dvi: ${srcdir}/cl.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/cl.texi
cl.pdf: ${srcdir}/cl.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/cl.texi
-dbus : $(buildinfodir)/dbus
-$(buildinfodir)/dbus: dbus.texi
+dbus : $(buildinfodir)/dbus$(INFO_EXT)
+$(buildinfodir)/dbus$(INFO_EXT): ${srcdir}/dbus.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) dbus.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/dbus.texi
dbus.dvi: ${srcdir}/dbus.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/dbus.texi
dbus.pdf: ${srcdir}/dbus.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/dbus.texi
-dired-x : $(buildinfodir)/dired-x
-$(buildinfodir)/dired-x: dired-x.texi $(emacsdir)/emacsver.texi
+dired-x : $(buildinfodir)/dired-x$(INFO_EXT)
+$(buildinfodir)/dired-x$(INFO_EXT): ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) dired-x.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/dired-x.texi
dired-x.dvi: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/dired-x.texi
dired-x.pdf: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/dired-x.texi
-ebrowse : $(buildinfodir)/ebrowse
-$(buildinfodir)/ebrowse: ebrowse.texi
+ebrowse : $(buildinfodir)/ebrowse$(INFO_EXT)
+$(buildinfodir)/ebrowse$(INFO_EXT): ${srcdir}/ebrowse.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) ebrowse.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ebrowse.texi
ebrowse.dvi: ${srcdir}/ebrowse.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/ebrowse.texi
ebrowse.pdf: ${srcdir}/ebrowse.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/ebrowse.texi
-ede : $(buildinfodir)/ede
-$(buildinfodir)/ede: ede.texi
+ede : $(buildinfodir)/ede$(INFO_EXT)
+$(buildinfodir)/ede$(INFO_EXT): ${srcdir}/ede.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) ede.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ede.texi
ede.dvi: ${srcdir}/ede.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/ede.texi
ede.pdf: ${srcdir}/ede.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/ede.texi
-ediff : $(buildinfodir)/ediff
-$(buildinfodir)/ediff: ediff.texi
+ediff : $(buildinfodir)/ediff$(INFO_EXT)
+$(buildinfodir)/ediff$(INFO_EXT): ${srcdir}/ediff.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) ediff.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ediff.texi
ediff.dvi: ${srcdir}/ediff.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/ediff.texi
ediff.pdf: ${srcdir}/ediff.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/ediff.texi
-edt : $(buildinfodir)/edt
-$(buildinfodir)/edt: edt.texi
+edt : $(buildinfodir)/edt$(INFO_EXT)
+$(buildinfodir)/edt$(INFO_EXT): ${srcdir}/edt.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) edt.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/edt.texi
edt.dvi: ${srcdir}/edt.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/edt.texi
edt.pdf: ${srcdir}/edt.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/edt.texi
-eieio : $(buildinfodir)/eieio
-$(buildinfodir)/eieio: eieio.texi
+eieio : $(buildinfodir)/eieio$(INFO_EXT)
+$(buildinfodir)/eieio$(INFO_EXT): ${srcdir}/eieio.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) eieio.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eieio.texi
eieio.dvi: ${srcdir}/eieio.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/eieio.texi
eieio.pdf: ${srcdir}/eieio.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/eieio.texi
-emacs-gnutls : $(buildinfodir)/emacs-gnutls
-$(buildinfodir)/emacs-gnutls: emacs-gnutls.texi
+emacs-gnutls : $(buildinfodir)/emacs-gnutls$(INFO_EXT)
+$(buildinfodir)/emacs-gnutls$(INFO_EXT): ${srcdir}/emacs-gnutls.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) emacs-gnutls.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs-gnutls.texi
emacs-gnutls.dvi: ${srcdir}/emacs-gnutls.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-gnutls.texi
emacs-gnutls.pdf: ${srcdir}/emacs-gnutls.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-gnutls.texi
-emacs-mime : $(buildinfodir)/emacs-mime
-$(buildinfodir)/emacs-mime: emacs-mime.texi
+emacs-mime : $(buildinfodir)/emacs-mime$(INFO_EXT)
+$(buildinfodir)/emacs-mime$(INFO_EXT): ${srcdir}/emacs-mime.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) --enable-encoding emacs-mime.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) --enable-encoding -o $@ ${srcdir}/emacs-mime.texi
emacs-mime.dvi: ${srcdir}/emacs-mime.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi
emacs-mime.pdf: ${srcdir}/emacs-mime.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-mime.texi
-epa : $(buildinfodir)/epa
-$(buildinfodir)/epa: epa.texi
+epa : $(buildinfodir)/epa$(INFO_EXT)
+$(buildinfodir)/epa$(INFO_EXT): ${srcdir}/epa.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) epa.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/epa.texi
epa.dvi: ${srcdir}/epa.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/epa.texi
epa.pdf: ${srcdir}/epa.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/epa.texi
-erc : $(buildinfodir)/erc
-$(buildinfodir)/erc: erc.texi
+erc : $(buildinfodir)/erc$(INFO_EXT)
+$(buildinfodir)/erc$(INFO_EXT): ${srcdir}/erc.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) erc.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/erc.texi
erc.dvi: ${srcdir}/erc.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/erc.texi
erc.pdf: ${srcdir}/erc.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/erc.texi
-ert : $(buildinfodir)/ert
-$(buildinfodir)/ert: ert.texi
+ert : $(buildinfodir)/ert$(INFO_EXT)
+$(buildinfodir)/ert$(INFO_EXT): ${srcdir}/ert.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) ert.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ert.texi
ert.dvi: ${srcdir}/ert.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/ert.texi
ert.pdf: ${srcdir}/ert.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/ert.texi
-eshell : $(buildinfodir)/eshell
-$(buildinfodir)/eshell: eshell.texi
+eshell : $(buildinfodir)/eshell$(INFO_EXT)
+$(buildinfodir)/eshell$(INFO_EXT): ${srcdir}/eshell.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) eshell.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eshell.texi
eshell.dvi: ${srcdir}/eshell.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/eshell.texi
eshell.pdf: ${srcdir}/eshell.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/eshell.texi
-eudc : $(buildinfodir)/eudc
-$(buildinfodir)/eudc: eudc.texi
+eudc : $(buildinfodir)/eudc$(INFO_EXT)
+$(buildinfodir)/eudc$(INFO_EXT): ${srcdir}/eudc.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) eudc.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eudc.texi
eudc.dvi: ${srcdir}/eudc.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/eudc.texi
eudc.pdf: ${srcdir}/eudc.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/eudc.texi
-efaq : $(buildinfodir)/efaq
-$(buildinfodir)/efaq: faq.texi $(emacsdir)/emacsver.texi
+efaq : $(buildinfodir)/efaq$(INFO_EXT)
+$(buildinfodir)/efaq$(INFO_EXT): ${srcdir}/faq.texi $(emacsdir)/emacsver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) faq.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/faq.texi
faq.dvi: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/faq.texi
faq.pdf: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi
emacs-faq.text: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi
$(MAKEINFO) $(MAKEINFO_OPTS) --plaintext -o $@ ${srcdir}/faq.texi
-flymake : $(buildinfodir)/flymake
-$(buildinfodir)/flymake: flymake.texi
+flymake : $(buildinfodir)/flymake$(INFO_EXT)
+$(buildinfodir)/flymake$(INFO_EXT): ${srcdir}/flymake.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) flymake.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/flymake.texi
flymake.dvi: ${srcdir}/flymake.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/flymake.texi
flymake.pdf: ${srcdir}/flymake.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/flymake.texi
-forms : $(buildinfodir)/forms
-$(buildinfodir)/forms: forms.texi
+forms : $(buildinfodir)/forms$(INFO_EXT)
+$(buildinfodir)/forms$(INFO_EXT): ${srcdir}/forms.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) forms.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/forms.texi
forms.dvi: ${srcdir}/forms.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/forms.texi
forms.pdf: ${srcdir}/forms.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/forms.texi
# gnus/message/emacs-mime/sieve/pgg are part of Gnus:
-gnus : $(buildinfodir)/gnus
-$(buildinfodir)/gnus: gnus.texi gnus-faq.texi
+gnus : $(buildinfodir)/gnus$(INFO_EXT)
+$(buildinfodir)/gnus$(INFO_EXT): ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) gnus.texi
-gnus.dvi: ${srcdir}/gnus.texi gnus-faq.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/gnus.texi
+gnus.dvi: ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi
sed -e '/@iflatex/,/@end iflatex/d' ${srcdir}/gnus.texi > gnustmp.texi
$(ENVADD) $(TEXI2DVI) gnustmp.texi
cp gnustmp.dvi $@
rm gnustmp.*
-gnus.pdf: ${srcdir}/gnus.texi gnus-faq.texi
+gnus.pdf: ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi
sed -e '/@iflatex/,/@end iflatex/d' ${srcdir}/gnus.texi > gnustmp.texi
$(ENVADD) $(TEXI2PDF) gnustmp.texi
cp gnustmp.pdf $@
rm gnustmp.*
-# This is produced with --no-split to avoid making files whose
-# names clash on DOS 8+3 filesystems
-idlwave : $(buildinfodir)/idlwave
-$(buildinfodir)/idlwave: idlwave.texi
+# NB this one needs --no-split even without a .info extension.
+idlwave : $(buildinfodir)/idlwave$(INFO_EXT)
+$(buildinfodir)/idlwave$(INFO_EXT): ${srcdir}/idlwave.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) --no-split idlwave.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/idlwave.texi
idlwave.dvi: ${srcdir}/idlwave.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/idlwave.texi
idlwave.pdf: ${srcdir}/idlwave.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/idlwave.texi
-# The following target uses an explicit -o switch to work around
-# the @setfilename directive in info.texi, which is required for
-# the Texinfo distribution.
-###info : $(buildinfodir)/info # circular!
-$(buildinfodir)/info: info.texi
+# NB this one needs --no-split even without a .info extension.
+# Avoid name clash with overall "info" target.
+info.info : $(buildinfodir)/info$(INFO_EXT)
+$(buildinfodir)/info$(INFO_EXT): ${srcdir}/info.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) --no-split -o $@ info.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/info.texi
info.dvi: ${srcdir}/info.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/info.texi
info.pdf: ${srcdir}/info.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/info.texi
-mairix-el : $(buildinfodir)/mairix-el
-$(buildinfodir)/mairix-el: mairix-el.texi
+mairix-el : $(buildinfodir)/mairix-el$(INFO_EXT)
+$(buildinfodir)/mairix-el$(INFO_EXT): ${srcdir}/mairix-el.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) mairix-el.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/mairix-el.texi
mairix-el.dvi: ${srcdir}/mairix-el.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/mairix-el.texi
mairix-el.pdf: ${srcdir}/mairix-el.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/mairix-el.texi
-message : $(buildinfodir)/message
-$(buildinfodir)/message: message.texi
+message : $(buildinfodir)/message$(INFO_EXT)
+$(buildinfodir)/message$(INFO_EXT): ${srcdir}/message.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) message.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/message.texi
message.dvi: ${srcdir}/message.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/message.texi
message.pdf: ${srcdir}/message.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/message.texi
-mh-e : $(buildinfodir)/mh-e
-$(buildinfodir)/mh-e: mh-e.texi
+mh-e : $(buildinfodir)/mh-e$(INFO_EXT)
+$(buildinfodir)/mh-e$(INFO_EXT): ${srcdir}/mh-e.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) mh-e.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/mh-e.texi
mh-e.dvi: ${srcdir}/mh-e.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/mh-e.texi
mh-e.pdf: ${srcdir}/mh-e.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/mh-e.texi
-newsticker : $(buildinfodir)/newsticker
-$(buildinfodir)/newsticker: newsticker.texi
+newsticker : $(buildinfodir)/newsticker$(INFO_EXT)
+$(buildinfodir)/newsticker$(INFO_EXT): ${srcdir}/newsticker.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) newsticker.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/newsticker.texi
newsticker.dvi: ${srcdir}/newsticker.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/newsticker.texi
newsticker.pdf: ${srcdir}/newsticker.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/newsticker.texi
-nxml-mode : $(buildinfodir)/nxml-mode
-$(buildinfodir)/nxml-mode: nxml-mode.texi
+nxml-mode : $(buildinfodir)/nxml-mode$(INFO_EXT)
+$(buildinfodir)/nxml-mode$(INFO_EXT): ${srcdir}/nxml-mode.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) nxml-mode.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/nxml-mode.texi
nxml-mode.dvi: ${srcdir}/nxml-mode.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/nxml-mode.texi
nxml-mode.pdf: ${srcdir}/nxml-mode.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/nxml-mode.texi
-org : $(buildinfodir)/org
-$(buildinfodir)/org: org.texi
+org : $(buildinfodir)/org$(INFO_EXT)
+$(buildinfodir)/org$(INFO_EXT): ${srcdir}/org.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) org.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/org.texi
org.dvi: ${srcdir}/org.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/org.texi
org.pdf: ${srcdir}/org.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/org.texi
-pcl-cvs : $(buildinfodir)/pcl-cvs
-$(buildinfodir)/pcl-cvs: pcl-cvs.texi
+pcl-cvs : $(buildinfodir)/pcl-cvs$(INFO_EXT)
+$(buildinfodir)/pcl-cvs$(INFO_EXT): ${srcdir}/pcl-cvs.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) pcl-cvs.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/pcl-cvs.texi
pcl-cvs.dvi: ${srcdir}/pcl-cvs.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/pcl-cvs.texi
pcl-cvs.pdf: ${srcdir}/pcl-cvs.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/pcl-cvs.texi
-pgg : $(buildinfodir)/pgg
-$(buildinfodir)/pgg: pgg.texi
+pgg : $(buildinfodir)/pgg$(INFO_EXT)
+$(buildinfodir)/pgg$(INFO_EXT): ${srcdir}/pgg.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) pgg.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/pgg.texi
pgg.dvi: ${srcdir}/pgg.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/pgg.texi
pgg.pdf: ${srcdir}/pgg.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/pgg.texi
-rcirc : $(buildinfodir)/rcirc
-$(buildinfodir)/rcirc: rcirc.texi
+rcirc : $(buildinfodir)/rcirc$(INFO_EXT)
+$(buildinfodir)/rcirc$(INFO_EXT): ${srcdir}/rcirc.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) rcirc.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/rcirc.texi
rcirc.dvi: ${srcdir}/rcirc.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/rcirc.texi
rcirc.pdf: ${srcdir}/rcirc.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/rcirc.texi
-reftex : $(buildinfodir)/reftex
-$(buildinfodir)/reftex: reftex.texi
+reftex : $(buildinfodir)/reftex$(INFO_EXT)
+$(buildinfodir)/reftex$(INFO_EXT): ${srcdir}/reftex.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) reftex.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/reftex.texi
reftex.dvi: ${srcdir}/reftex.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/reftex.texi
reftex.pdf: ${srcdir}/reftex.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/reftex.texi
-remember : $(buildinfodir)/remember
-$(buildinfodir)/remember: remember.texi
+remember : $(buildinfodir)/remember$(INFO_EXT)
+$(buildinfodir)/remember$(INFO_EXT): ${srcdir}/remember.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) remember.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/remember.texi
remember.dvi: ${srcdir}/remember.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/remember.texi
remember.pdf: ${srcdir}/remember.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/remember.texi
-sasl : $(buildinfodir)/sasl
-$(buildinfodir)/sasl: sasl.texi
+sasl : $(buildinfodir)/sasl$(INFO_EXT)
+$(buildinfodir)/sasl$(INFO_EXT): ${srcdir}/sasl.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) sasl.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sasl.texi
sasl.dvi: ${srcdir}/sasl.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/sasl.texi
sasl.pdf: ${srcdir}/sasl.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/sasl.texi
-sc : $(buildinfodir)/sc
-$(buildinfodir)/sc: sc.texi
+sc : $(buildinfodir)/sc$(INFO_EXT)
+$(buildinfodir)/sc$(INFO_EXT): ${srcdir}/sc.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) sc.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sc.texi
sc.dvi: ${srcdir}/sc.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/sc.texi
sc.pdf: ${srcdir}/sc.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/sc.texi
-semantic : $(buildinfodir)/semantic
-$(buildinfodir)/semantic: semantic.texi sem-user.texi
+semantic : $(buildinfodir)/semantic$(INFO_EXT)
+$(buildinfodir)/semantic$(INFO_EXT): ${srcdir}/semantic.texi ${srcdir}/sem-user.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) semantic.texi
-semantic.dvi: ${srcdir}/semantic.texi sem-user.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/semantic.texi
+semantic.dvi: ${srcdir}/semantic.texi ${srcdir}/sem-user.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/semantic.texi
-semantic.pdf: ${srcdir}/semantic.texi sem-user.texi
+semantic.pdf: ${srcdir}/semantic.texi ${srcdir}/sem-user.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/semantic.texi
-ses : $(buildinfodir)/ses
-$(buildinfodir)/ses: ses.texi
+ses : $(buildinfodir)/ses$(INFO_EXT)
+$(buildinfodir)/ses$(INFO_EXT): ${srcdir}/ses.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) ses.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ses.texi
ses.dvi: ${srcdir}/ses.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/ses.texi
ses.pdf: ${srcdir}/ses.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/ses.texi
-sieve : $(buildinfodir)/sieve
-$(buildinfodir)/sieve: sieve.texi
+sieve : $(buildinfodir)/sieve$(INFO_EXT)
+$(buildinfodir)/sieve$(INFO_EXT): ${srcdir}/sieve.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) sieve.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sieve.texi
sieve.dvi: ${srcdir}/sieve.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/sieve.texi
sieve.pdf: ${srcdir}/sieve.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/sieve.texi
-smtpmail : $(buildinfodir)/smtpmail
-$(buildinfodir)/smtpmail: smtpmail.texi
+smtpmail : $(buildinfodir)/smtpmail$(INFO_EXT)
+$(buildinfodir)/smtpmail$(INFO_EXT): ${srcdir}/smtpmail.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) smtpmail.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/smtpmail.texi
smtpmail.dvi: ${srcdir}/smtpmail.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/smtpmail.texi
smtpmail.pdf: ${srcdir}/smtpmail.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/smtpmail.texi
-speedbar : $(buildinfodir)/speedbar
-$(buildinfodir)/speedbar: speedbar.texi
+speedbar : $(buildinfodir)/speedbar$(INFO_EXT)
+$(buildinfodir)/speedbar$(INFO_EXT): ${srcdir}/speedbar.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) speedbar.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/speedbar.texi
speedbar.dvi: ${srcdir}/speedbar.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/speedbar.texi
speedbar.pdf: ${srcdir}/speedbar.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/speedbar.texi
-tramp : $(buildinfodir)/tramp
-$(buildinfodir)/tramp: tramp.texi trampver.texi
+tramp : $(buildinfodir)/tramp$(INFO_EXT)
+$(buildinfodir)/tramp$(INFO_EXT): ${srcdir}/tramp.texi ${srcdir}/trampver.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) -D emacs tramp.texi
-tramp.dvi: ${srcdir}/tramp.texi trampver.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ -D emacs ${srcdir}/tramp.texi
+tramp.dvi: ${srcdir}/tramp.texi ${srcdir}/trampver.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/tramp.texi
-tramp.pdf: ${srcdir}/tramp.texi trampver.texi
+tramp.pdf: ${srcdir}/tramp.texi ${srcdir}/trampver.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/tramp.texi
-url : $(buildinfodir)/url
-$(buildinfodir)/url: url.texi
+url : $(buildinfodir)/url$(INFO_EXT)
+$(buildinfodir)/url$(INFO_EXT): ${srcdir}/url.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) url.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/url.texi
url.dvi: ${srcdir}/url.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/url.texi
url.pdf: ${srcdir}/url.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/url.texi
-vip : $(buildinfodir)/vip
-$(buildinfodir)/vip: vip.texi
+vip : $(buildinfodir)/vip$(INFO_EXT)
+$(buildinfodir)/vip$(INFO_EXT): ${srcdir}/vip.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) vip.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/vip.texi
vip.dvi: ${srcdir}/vip.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/vip.texi
vip.pdf: ${srcdir}/vip.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/vip.texi
-viper : $(buildinfodir)/viper
-$(buildinfodir)/viper: viper.texi
+viper : $(buildinfodir)/viper$(INFO_EXT)
+$(buildinfodir)/viper$(INFO_EXT): ${srcdir}/viper.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) viper.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/viper.texi
viper.dvi: ${srcdir}/viper.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/viper.texi
viper.pdf: ${srcdir}/viper.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/viper.texi
-widget : $(buildinfodir)/widget
-$(buildinfodir)/widget: widget.texi
+widget : $(buildinfodir)/widget$(INFO_EXT)
+$(buildinfodir)/widget$(INFO_EXT): ${srcdir}/widget.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) widget.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/widget.texi
widget.dvi: ${srcdir}/widget.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/widget.texi
widget.pdf: ${srcdir}/widget.texi
$(ENVADD) $(TEXI2PDF) ${srcdir}/widget.texi
-woman : $(buildinfodir)/woman
-$(buildinfodir)/woman: woman.texi
+woman : $(buildinfodir)/woman$(INFO_EXT)
+$(buildinfodir)/woman$(INFO_EXT): ${srcdir}/woman.texi
$(mkinfodir)
- cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) woman.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/woman.texi
woman.dvi: ${srcdir}/woman.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/woman.texi
woman.pdf: ${srcdir}/woman.texi
.PHONY: mostlyclean clean distclean maintainer-clean
mostlyclean:
- rm -f *.aux *.log *.toc *.cp *.cps *.fn *.fns *.ky *.kys \
- *.op *.ops *.pg *.pgs *.tp *.tps *.vr *.vrs
+ rm -f *.aux *.log *.toc *.c[mp] *.c[mp]s *.fn *.fns \
+ *.ky *.kys *.op *.ops *.p[gj] *.p[gj]s *.sc *.scs *.ss \
+ *.t[gp] *.t[gp]s *.vr *.vrs
rm -f gnustmp.*
clean: mostlyclean
## buildinfodir is relative to srcdir.
maintainer-clean: distclean
- cd $(srcdir); for file in $(INFO_TARGETS); do \
+ cd $(buildinfodir); for file in $(INFO_TARGETS); do \
+ file=`echo $${file} | sed 's/\.info$$//'`${INFO_EXT}; \
rm -f $${file} $${file}-[1-9] $${file}-[1-9][0-9]; \
done
@end defvar
If you don't customize @code{auth-sources}, you'll have to live with
-the defaults: any host and any port are looked up in the netrc
-file @file{~/.authinfo.gpg}, which is a GnuPG encrypted file
-(@pxref{GnuPG and EasyPG Assistant Configuration}).
+the defaults: the unencrypted netrc file @file{~/.authinfo} will be
+used for any host and any port.
-If that fails, the unencrypted netrc files @file{~/.authinfo} and
-@file{~/.netrc} will be used.
+If that fails, any host and any port are looked up in the netrc file
+@file{~/.authinfo.gpg}, which is a GnuPG encrypted file (@pxref{GnuPG
+and EasyPG Assistant Configuration}).
+
+Finally, the unencrypted netrc file @file{~/.netrc} will be used for
+any host and any port.
The typical netrc line example is without a port.
* Notations Used in This Manual::
* Demonstration of Calc::
* Using Calc::
-* History and Acknowledgements::
+* History and Acknowledgments::
@end menu
@node What is Calc, About This Manual, Getting Started, Getting Started
Type @kbd{d B} to view the solutions in more readable notation.
Type @w{@kbd{d C}} to view them in C language notation, @kbd{d T}
to view them in the notation for the @TeX{} typesetting system,
-and @kbd{d L} to view them in the notation for the La@TeX{} typesetting
+and @kbd{d L} to view them in the notation for the @LaTeX{} typesetting
system. Type @kbd{d N} to return to normal notation.
@noindent
Press @key{DEL} repeatedly to remove any leftover results from the stack.
To exit from Calc, press @kbd{q} or @kbd{C-x * c} again.
-@node Using Calc, History and Acknowledgements, Demonstration of Calc, Getting Started
+@node Using Calc, History and Acknowledgments, Demonstration of Calc, Getting Started
@section Using Calc
@noindent
is
-1 / ln(x) x
+1 / x ln(x)
@end group
@end smallexample
(Note that by default, Calc gives division lower precedence than multiplication,
-so that @samp{1 / ln(x) x} is equivalent to @samp{1 / (ln(x) x)}.)
+so that @samp{1 / x ln(x)} is equivalent to @samp{1 / (x ln(x))}.)
To make this look nicer, you might want to press @kbd{d =} to center
the formula, and even @kbd{d B} to use Big display mode.
1
-------
- ln(x) x
+ x ln(x)
@end group
@end smallexample
Calc has added annotations to the file to help it remember the modes
that were used for this formula. They are formatted like comments
in the @TeX{} typesetting language, just in case you are using @TeX{} or
-La@TeX{}. (In this example @TeX{} is not being used, so you might want
+@LaTeX{}. (In this example @TeX{} is not being used, so you might want
to move these comments up to the top of the file or otherwise put them
out of the way.)
The related command @kbd{C-x * w} operates on a single word, which
generally means a single number, inside text. It searches for an
expression which ``looks'' like a number containing the point.
-Here's an example of its use:
+Here's an example of its use (before you try this, remove the Calc
+annotations or use a new buffer so that the extra settings in the
+annotations don't take effect):
@smallexample
A slope of one-third corresponds to an angle of 1 degrees.
its initial state: Empty stack, and initial mode settings.
@end table
-@node History and Acknowledgements, , Using Calc, Getting Started
-@section History and Acknowledgements
+@node History and Acknowledgments, , Using Calc, Getting Started
+@section History and Acknowledgments
@noindent
Calc was originally started as a two-week project to occupy a lull
Emacs Lisp didn't have built-in floating point math (now it does), so
this had to be simulated in software. In fact, Emacs integers would
-only comfortably fit six decimal digits or so---not enough for a decent
-calculator. So I had to write my own high-precision integer code as
-well, and once I had this I figured that arbitrary-size integers were
-just as easy as large integers. Arbitrary floating-point precision was
-the logical next step. Also, since the large integer arithmetic was
-there anyway it seemed only fair to give the user direct access to it,
-which in turn made it practical to support fractions as well as floats.
-All these features inspired me to look around for other data types that
-might be worth having.
+only comfortably fit six decimal digits or so (at the time)---not
+enough for a decent calculator. So I had to write my own
+high-precision integer code as well, and once I had this I figured
+that arbitrary-size integers were just as easy as large integers.
+Arbitrary floating-point precision was the logical next step. Also,
+since the large integer arithmetic was there anyway it seemed only
+fair to give the user direct access to it, which in turn made it
+practical to support fractions as well as floats. All these features
+inspired me to look around for other data types that might be worth
+having.
Around this time, my friend Rick Koshi showed me his nifty new HP-28
calculator. It allowed the user to manipulate formulas as well as
@subsection RPN Calculations and the Stack
@cindex RPN notation
-@ifnottex
@noindent
+@ifnottex
Calc normally uses RPN notation. You may be familiar with the RPN
system from Hewlett-Packard calculators, FORTH, or PostScript.
(Reverse Polish Notation, RPN, is named after the Polish mathematician
Jan Lukasiewicz.)
@end ifnottex
@tex
-\noindent
Calc normally uses RPN notation. You may be familiar with the RPN
system from Hewlett-Packard calculators, FORTH, or PostScript.
(Reverse Polish Notation, RPN, is named after the Polish mathematician
if you're right. @xref{RPN Answer 1, 1}. (@bullet{})
(@bullet{}) @strong{Exercise 2.} Compute
-@texline @math{(2\times4) + (7\times9.4) + {5\over4}}
+@texline @math{(2\times4) + (7\times9.5) + {5\over4}}
@infoline @expr{2*4 + 7*9.5 + 5/4}
using the stack. @xref{RPN Answer 2, 2}. (@bullet{})
@smallexample
@group
-1: 2 a + 2 b 1: 34 + 2 b
+1: 2 a + 2 b 1: 2 b + 34
. .
' 2a+2b @key{RET} =
@smallexample
@group
-1: 2 + log10(0) + log10(x) + log10(5, 6) + foo(3)
+1: log10(0) + log10(x) + log10(5, 6) + foo(3) + 2
.
' log10(100) + log10(0) + log10(x) + log10(5,6) + foo(3) @key{RET}
@cindex Fermat, primality test of
(@bullet{}) @strong{Exercise 10.} A theorem of Pierre de Fermat
says that
-@texline @w{@math{x^{n-1} \bmod n = 1}}
+@texline @math{x^{n-1} \bmod n = 1}
@infoline @expr{x^(n-1) mod n = 1}
if @expr{n} is a prime number and @expr{x} is an integer less than
@expr{n}. If @expr{n} is @emph{not} a prime number, this will
@smallexample
@group
-1: 20 degF 1: 11.1111 degC 1: -20:3 degC 1: -6.666 degC
+1: 20 degF 1: 11.1111 degC 1: -6.666 degC
. . . .
- ' 20 degF @key{RET} u c degC @key{RET} U u t degC @key{RET} c f
+ ' 20 degF @key{RET} u c degC @key{RET} U u t degC @key{RET}
@end group
@end smallexample
@noindent
First we convert a change of 20 degrees Fahrenheit into an equivalent
change in degrees Celsius (or Centigrade). Then, we convert the
-absolute temperature 20 degrees Fahrenheit into Celsius. Since
-this comes out as an exact fraction, we then convert to floating-point
-for easier comparison with the other result.
+absolute temperature 20 degrees Fahrenheit into Celsius.
For simple unit conversions, you can put a plain number on the stack.
Then @kbd{u c} and @kbd{u t} will prompt for both old and new units.
@smallexample
@group
-1: 2 x^2 - 6 1: 6 - 2 x^2 1: (6 - 2 x^2) (3 x^2 + y)
+1: 2 x^2 - 6 1: 6 - 2 x^2 1: (3 x^2 + y) (6 - 2 x^2)
. . .
' 2x^2-6 @key{RET} n ' 3x^2+y @key{RET} *
@smallexample
@group
-1: 18 x^2 + 6 y - 6 x^4 - 2 x^2 y 1: (18 - 2 y) x^2 - 6 x^4 + 6 y
+1: 18 x^2 - 6 x^4 + 6 y - 2 y x^2 1: (18 - 2 y) x^2 - 6 x^4 + 6 y
. .
a x a c x @key{RET}
@smallexample
@group
-1: (34 x - 24 x^3) / x 1: 34 x / x - 24 x^3 / x 1: 34 - 24 x^2
- . . .
+1: (34 x - 24 x^3) / x 1: 34 - 24 x^2
+ . .
- ' x @key{RET} / a x a s
+ ' x @key{RET} / a x
@end group
@end smallexample
@noindent
@smallexample
@group
-1: 34 - 24 x^2 = 0 1: x = 1.19023
+1: 0.70588 x^2 = 1 1: x = 1.19023
. .
0 a = s 3 a S x @key{RET}
@end smallexample
@noindent
-Notice the use of @kbd{a s} to ``simplify'' the formula. When the
-default algebraic simplifications don't do enough, you can use
-@kbd{a s} to tell Calc to spend more time on the job.
-
Now we compute the second derivative and plug in our values of @expr{x}:
@smallexample
local @emph{minimum} at @expr{x = 0}.)
When we solved for @expr{x}, we got only one value even though
-@expr{34 - 24 x^2 = 0} is a quadratic equation that ought to have
+@expr{0.70588 x^2 = 1} is a quadratic equation that ought to have
two solutions. The reason is that @w{@kbd{a S}} normally returns a
single ``principal'' solution. If it needs to come up with an
arbitrary sign (as occurs in the quadratic formula) it picks @expr{+}.
@smallexample
@group
-1: 34 - 24 x^2 = 0 1: x = 1.19023 s1 1: x = -1.19023
+1: 0.70588 x^2 = 1 1: x = 1.19023 s1 1: x = -1.19023
. . .
r 3 H a S x @key{RET} s 5 1 n s l s1 @key{RET}
Here things like powers, square roots, and quotients and fractions
are displayed in a two-dimensional pictorial form. Calc has other
language modes as well, such as C mode, FORTRAN mode, @TeX{} mode
-and La@TeX{} mode.
+and @LaTeX{} mode.
@smallexample
@group
@smallexample
@group
2: [1, 1.1, ... ] 1: [0., 0.084941, 0.16993, ... ]
-1: sin(x) ln(x) .
+1: ln(x) sin(x) .
.
' sin(x) ln(x) @key{RET} s 1 m r p 5 @key{RET} V M $ @key{RET}
@smallexample
@group
-1: sin(x) ln(x) 1: 0.84147 x - 0.84147 + 0.11957 (x - 1)^2 - ...
+1: ln(x) sin(x) 1: 0.84147 x + 0.11957 (x - 1)^2 - ...
. .
r 1 a t x=1 @key{RET} 4 @key{RET}
@smallexample
@group
-1: 2 / cos(x)^2 - 2 tan(x)^2
+1: 2 sec(x)^2 / tan(x)^2 - 2 / tan(x)^2
.
- ' 2/cos(x)^2 - 2tan(x)^2 @key{RET} s 1
+ ' 2sec(x)^2/tan(x)^2 - 2/tan(x)^2 @key{RET} s 1
@end group
@end smallexample
@noindent
-If we were simplifying this by hand, we'd probably replace the
-@samp{tan} with a @samp{sin/cos} first, then combine over a common
-denominator. The @kbd{I a s} command will do the former and the @kbd{a n}
-algebra command will do the latter, but we'll do both with rewrite
-rules just for practice.
+If we were simplifying this by hand, we'd probably combine over the common
+denominator. The @kbd{a n} algebra command will do this, but we'll do
+it with a rewrite rule just for practice.
Rewrite rules are written with the @samp{:=} symbol.
@smallexample
@group
-1: 2 / cos(x)^2 - 2 sin(x)^2 / cos(x)^2
+1: (2 sec(x)^2 - 2) / tan(x)^2
.
- a r tan(a) := sin(a)/cos(a) @key{RET}
+ a r a/x + b/x := (a+b)/x @key{RET}
@end group
@end smallexample
@noindent
(The ``assignment operator'' @samp{:=} has several uses in Calc. All
-by itself the formula @samp{tan(a) := sin(a)/cos(a)} doesn't do anything,
+by itself the formula @samp{a/x + b/x := (a+b)/x} doesn't do anything,
but when it is given to the @kbd{a r} command, that command interprets
it as a rewrite rule.)
-The lefthand side, @samp{tan(a)}, is called the @dfn{pattern} of the
+The lefthand side, @samp{a/x + b/x}, is called the @dfn{pattern} of the
rewrite rule. Calc searches the formula on the stack for parts that
match the pattern. Variables in a rewrite pattern are called
@dfn{meta-variables}, and when matching the pattern each meta-variable
can match any sub-formula. Here, the meta-variable @samp{a} matched
-the actual variable @samp{x}.
-
-When the pattern part of a rewrite rule matches a part of the formula,
-that part is replaced by the righthand side with all the meta-variables
-substituted with the things they matched. So the result is
-@samp{sin(x) / cos(x)}. Calc's normal algebraic simplifications then
-mix this in with the rest of the original formula.
-
-To merge over a common denominator, we can use another simple rule:
-
-@smallexample
-@group
-1: (2 - 2 sin(x)^2) / cos(x)^2
- .
-
- a r a/x + b/x := (a+b)/x @key{RET}
-@end group
-@end smallexample
+the expression @samp{2 sec(x)^2}, the meta-variable @samp{b} matched
+the constant @samp{-2} and the meta-variable @samp{x} matched
+the expression @samp{tan(x)^2}.
This rule points out several interesting features of rewrite patterns.
First, if a meta-variable appears several times in a pattern, it must
Second, meta-variable names are independent from variables in the
target formula. Notice that the meta-variable @samp{x} here matches
-the subformula @samp{cos(x)^2}; Calc never confuses the two meanings of
+the subformula @samp{tan(x)^2}; Calc never confuses the two meanings of
@samp{x}.
And third, rewrite patterns know a little bit about the algebraic
properties of formulas. The pattern called for a sum of two quotients;
Calc was able to match a difference of two quotients by matching
-@samp{a = 2}, @samp{b = -2 sin(x)^2}, and @samp{x = cos(x)^2}.
+@samp{a = 2 sec(x)^2}, @samp{b = -2}, and @samp{x = tan(x)^2}.
+
+When the pattern part of a rewrite rule matches a part of the formula,
+that part is replaced by the righthand side with all the meta-variables
+substituted with the things they matched. So the result is
+@samp{(2 sec(x)^2 - 2) / tan(x)^2}.
@c [fix-ref Algebraic Properties of Rewrite Rules]
We could just as easily have written @samp{a/x - b/x := (a-b)/x} for
of Rewrite Rules}, for some examples of this.)
One more rewrite will complete the job. We want to use the identity
-@samp{sin(x)^2 + cos(x)^2 = 1}, but of course we must first rearrange
+@samp{tan(x)^2 + 1 = sec(x)^2}, but of course we must first rearrange
the identity in a way that matches our formula. The obvious rule
-would be @samp{@w{2 - 2 sin(x)^2} := 2 cos(x)^2}, but a little thought shows
-that the rule @samp{sin(x)^2 := 1 - cos(x)^2} will also work. The
+would be @samp{@w{2 sec(x)^2 - 2} := 2 tan(x)^2}, but a little thought shows
+that the rule @samp{sec(x)^2 := 1 + tan(x)^2} will also work. The
latter rule has a more general pattern so it will work in many other
situations, too.
@smallexample
@group
-1: (2 + 2 cos(x)^2 - 2) / cos(x)^2 1: 2
- . .
+1: 2
+ .
- a r sin(x)^2 := 1 - cos(x)^2 @key{RET} a s
+ a r sec(x)^2 := 1 + tan(x)^2 @key{RET}
@end group
@end smallexample
@smallexample
@group
-' tan(x) := sin(x)/cos(x) @key{RET} s t tsc @key{RET}
-' a/x + b/x := (a+b)/x @key{RET} s t merge @key{RET}
-' sin(x)^2 := 1 - cos(x)^2 @key{RET} s t sinsqr @key{RET}
+' a/x + b/x := (a+b)/x @key{RET} s t merge @key{RET}
+' sec(x)^2 := 1 + tan(x)^2 @key{RET} s t secsqr @key{RET}
-1: 2 / cos(x)^2 - 2 tan(x)^2 1: 2
+1: 2 sec(x)^2 / tan(x)^2 - 2 / tan(x)^2 1: 2
. .
- r 1 a r tsc @key{RET} a r merge @key{RET} a r sinsqr @key{RET} a s
+ r 1 a r merge @key{RET} a r secsqr @key{RET}
@end group
@end smallexample
@smallexample
@group
-1: [tsc, merge, sinsqr] 1: [tan(x) := sin(x) / cos(x), ... ]
+1: [merge, secsqr] 1: [a/x + b/x := (a + b)/x, ... ]
. .
- ' [tsc,merge,sinsqr] @key{RET} =
+ ' [merge,sinsqr] @key{RET} =
@end group
@end smallexample
@noindent
@smallexample
@group
-1: 1 / cos(x) - sin(x) tan(x) 1: cos(x)
+1: 2 sec(x)^2 / tan(x)^2 - 2 / tan(x)^2 1: 2
. .
- s t trig @key{RET} r 1 a r trig @key{RET} a s
+ s t trig @key{RET} r 1 a r trig @key{RET}
@end group
@end smallexample
@smallexample
@group
-1: 1 / cos(x) - sin(x)^2 / cos(x) 1: (1 - sin(x)^2) / cos(x)
- . .
+1: (2 sec(x)^2 - 2) / tan(x)^2 1: 2
+ . .
- r 1 M-1 a r trig @key{RET} M-1 a r trig @key{RET}
+ r 1 M-1 a r trig @key{RET} M-1 a r trig @key{RET}
@end group
@end smallexample
@smallexample
@group
-1: exp(2 pi i) + exp(3 pi i) + exp(4 pi i)
+1: sin(x + 2 pi) + sin(x + 3 pi) + sin(x + 4 pi)
.
- ' exp(2 pi i) + exp(3 pi i) + exp(4 pi i) @key{RET}
+ ' sin(x+2pi) + sin(x+3pi) + sin(x+4pi) @key{RET}
@end group
@end smallexample
@noindent
@smallexample
@group
-1: 1 + exp(3 pi i) + 1
+1: sin(x + 3 pi) + 2 sin(x)
.
- a r exp(k pi i) := 1 :: k % 2 = 0 @key{RET}
+ a r sin(a + k pi) := sin(a) :: k % 2 = 0 @key{RET}
@end group
@end smallexample
(Recall, @samp{k % 2} is the remainder from dividing @samp{k} by 2,
which will be zero only when @samp{k} is an even integer.)
-An interesting point is that the variables @samp{pi} and @samp{i}
-were matched literally rather than acting as meta-variables.
-This is because they are special-constant variables. The special
-constants @samp{e}, @samp{phi}, and so on also match literally.
+An interesting point is that the variable @samp{pi} was matched
+literally rather than acting as a meta-variable.
+This is because it is a special-constant variable. The special
+constants @samp{e}, @samp{i}, @samp{phi}, and so on also match literally.
A common error with rewrite
rules is to write, say, @samp{f(a,b,c,d,e) := g(a+b+c+d+e)}, expecting
to match any @samp{f} with five arguments but in fact matching
@smallexample
@group
-1: fib(6) + fib(x) + fib(0) 1: 8 + fib(x) + fib(0)
+1: fib(6) + fib(x) + fib(0) 1: fib(x) + fib(0) + 8
. .
' fib(6)+fib(x)+fib(0) @key{RET} a r fib @key{RET}
For example, given @samp{1 - x^2 / 2 + O(x^3)} and @samp{x - x^3 / 6 + O(x^4)}
on the stack, we want to be able to type @kbd{*} and get the result
@samp{x - 2:3 x^3 + O(x^4)}. Don't worry if the terms of the sum are
-rearranged or if @kbd{a s} needs to be typed after rewriting. (This one
-is rather tricky; the solution at the end of this chapter uses 6 rewrite
-rules. Hint: The @samp{constant(x)} condition tests whether @samp{x} is
-a number.) @xref{Rewrites Answer 6, 6}. (@bullet{})
+rearranged. (This one is rather tricky; the solution at the end of
+this chapter uses 6 rewrite rules. Hint: The @samp{constant(x)}
+condition tests whether @samp{x} is a number.) @xref{Rewrites Answer
+6, 6}. (@bullet{})
Just for kicks, try adding the rule @code{2+3 := 6} to @code{EvalRules}.
What happens? (Be sure to remove this rule afterward, or you might get
@smallexample
@group
-1: 1 + x + x^2 / 2 + x^3 / 6 1: 1 + x + x^2 / 2 + x^3 / 6
+1: x + x^2 / 2 + x^3 / 6 + 1 1: x + x^2 / 2 + x^3 / 6 + 1
. .
' 1 + x + x^2/2! + x^3/3! @key{RET} Z F e myexp @key{RET} @key{RET} @key{RET} y
' y=sqrt(x) @key{RET} C-x ( H a S x @key{RET} C-x )
-1: y = cos(x) 1: x = s1 arccos(y) + 2 pi n1
+1: y = cos(x) 1: x = s1 arccos(y) + 2 n1 pi
. .
' y=cos(x) @key{RET} X
@smallexample
@group
-1: [6, 10] 2: [6, 10] 1: [6 - 4 a / (b - a), 4 / (b - a) ]
+1: [6, 10] 2: [6, 10] 1: [4 a / (a - b) + 6, 4 / (b - a) ]
. 1: [ [ 1, a ] .
[ 1, b ] ]
.
@smallexample
@group
- 4 a 4
-1: [6 - -----, -----]
- b - a b - a
+ 4 a 4
+1: [----- + 6, -----]
+ a - b b - a
@end group
@end smallexample
@smallexample
@group
-1: 3.3356 ns 1: 0.81356 ns / ns 1: 0.81356
-2: 4.1 ns . .
+1: 3.3356 ns 1: 0.81356
+2: 4.1 ns .
.
- ' 4.1 ns @key{RET} / u s
+ ' 4.1 ns @key{RET} /
@end group
@end smallexample
@noindent
@smallexample
@group
-1: [x - 1.19023, x + 1.19023, x] 1: (x - 1.19023) (x + 1.19023) x
+1: [x - 1.19023, x + 1.19023, x] 1: x*(x + 1.19023) (x - 1.19023)
. .
V M ' x-$ @key{RET} V R *
@smallexample
@group
-1: x sin(pi x) 1: (sin(pi x) - pi x cos(pi x)) / pi^2
+1: x sin(pi x) 1: sin(pi x) / pi^2 - x cos(pi x) / pi
. .
' x sin(pi x) @key{RET} m r a i x @key{RET}
@smallexample
@group
1: [y, 1]
-2: (sin(pi x) - pi x cos(pi x)) / pi^2
+2: sin(pi x) / pi^2 - x cos(pi x) / pi
.
' [y,1] @key{RET} @key{TAB}
@noindent
@smallexample
@group
-1: [(sin(pi y) - pi y cos(pi y)) / pi^2, (sin(pi) - pi cos(pi)) / pi^2]
+1: [sin(pi y) / pi^2 - y cos(pi y) / pi, 1 / pi]
.
V M $ @key{RET}
@noindent
@smallexample
@group
-1: (sin(pi y) - pi y cos(pi y)) / pi^2 + (pi cos(pi) - sin(pi)) / pi^2
+1: sin(pi y) / pi^2 - y cos(pi y) / pi - 1 / pi
.
V R -
@noindent
@smallexample
@group
-1: (sin(3.14159 y) - 3.14159 y cos(3.14159 y)) / 9.8696 - 0.3183
+1: sin(3.14159 y) / 9.8696 - y cos(3.14159 y) / 3.14159 - 0.3183
.
=
@smallexample
@group
- ___
- 2 + V 2
-1: (2 + sqrt(2)) / (1 + sqrt(2)) 1: --------
- . ___
- 1 + V 2
+ ___
+ V 2 + 2
+1: (2 + sqrt(2)) / (1 + sqrt(2)) 1: ---------
+ . ___
+ V 2 + 1
.
@noindent
@smallexample
@group
- ___ ___
-1: 2 + V 2 - 2 1: V 2
- . .
+ ___
+1: V 2
+ .
- a r a*(b+c) := a*b + a*c a s
+ a r a*(b+c) := a*b + a*c
@end group
@end smallexample
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};
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
The @kbd{m O} (@code{calc-no-simplify-mode}) command turns off all optional
simplifications. These would leave a formula like @expr{2+3} alone. In
fact, nothing except simple numbers are ever affected by normalization
-in this mode.
+in this mode. Explicit simplification commands, such as @kbd{=} or
+@kbd{a s}, can still be given to simplify any formulas.
+@xref{Algebraic Definitions}, for a sample use of
+No-Simplification mode.
+
@kindex m N
@pindex calc-num-simplify-mode
error form or modulo form), or a vector all of whose
elements are constant.
-@kindex m D
-@pindex calc-default-simplify-mode
-The @kbd{m D} (@code{calc-default-simplify-mode}) command restores the
-default simplifications for all formulas. This includes many easy and
+@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
@expr{@tfn{deriv}(x^2, x)} to @expr{2 x}.
@kindex m B
@pindex calc-bin-simplify-mode
-The @kbd{m B} (@code{calc-bin-simplify-mode}) mode applies the default
+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 A
@pindex calc-alg-simplify-mode
-The @kbd{m A} (@code{calc-alg-simplify-mode}) mode does algebraic
-simplification; it applies all the default simplifications, and also
-the more powerful (and slower) simplifications made by @kbd{a s}
-(@code{calc-simplify}). @xref{Algebraic Simplifications}.
+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.
A common technique is to set the simplification mode down to the lowest
amount of simplification you will allow to be applied automatically, then
use manual commands like @kbd{a s} and @kbd{c c} (@code{calc-clean}) to
-perform higher types of simplifications on demand. @xref{Algebraic
-Definitions}, for another sample use of No-Simplification mode.
-
+perform higher types of simplifications on demand.
@node Declarations, Display Modes, Simplification Modes, Mode Settings
@section Declarations
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,
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
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
@noindent
The commands in this section change Calc to use a different notation for
entry and display of formulas, corresponding to the conventions of some
-other common language such as Pascal or La@TeX{}. Objects displayed on the
+other common language such as Pascal or @LaTeX{}. Objects displayed on the
stack or yanked from the Calculator to an editing buffer will be formatted
in the current language; objects entered in algebraic entry or yanked from
another buffer will be interpreted according to the current language.
and would have written the formula back with notations (like implicit
multiplication) which would not have been valid for a C program.
-As another example, suppose you are maintaining a C program and a La@TeX{}
+As another example, suppose you are maintaining a C program and a @LaTeX{}
document, each of which needs a copy of the same formula. You can grab the
-formula from the program in C mode, switch to La@TeX{} mode, and yank the
-formula into the document in La@TeX{} math-mode format.
+formula from the program in C mode, switch to @LaTeX{} mode, and yank the
+formula into the document in @LaTeX{} math-mode format.
Language modes are selected by typing the letter @kbd{d} followed by a
shifted letter key.
convert to lower-case for display and input.
@node TeX and LaTeX Language Modes, Eqn Language Mode, C FORTRAN Pascal, Language Modes
-@subsection @TeX{} and La@TeX{} Language Modes
+@subsection @TeX{} and @LaTeX{} Language Modes
@noindent
@kindex d T
The @kbd{d T} (@code{calc-tex-language}) command selects the conventions
of ``math mode'' in Donald Knuth's @TeX{} typesetting language,
and the @kbd{d L} (@code{calc-latex-language}) command selects the
-conventions of ``math mode'' in La@TeX{}, a typesetting language that
-uses @TeX{} as its formatting engine. Calc's La@TeX{} language mode can
-read any formula that the @TeX{} language mode can, although La@TeX{}
+conventions of ``math mode'' in @LaTeX{}, a typesetting language that
+uses @TeX{} as its formatting engine. Calc's @LaTeX{} language mode can
+read any formula that the @TeX{} language mode can, although @LaTeX{}
mode may display it differently.
Formulas are entered and displayed in the appropriate notation;
@texline @math{\sin(a/b)}
@infoline @expr{sin(a/b)}
will appear as @samp{\sin\left( @{a \over b@} \right)} in @TeX{} mode and
-@samp{\sin\left(\frac@{a@}@{b@}\right)} in La@TeX{} mode.
+@samp{\sin\left(\frac@{a@}@{b@}\right)} in @LaTeX{} mode.
Math formulas are often enclosed by @samp{$ $} signs in @TeX{} and
-La@TeX{}; these should be omitted when interfacing with Calc. To Calc,
+@LaTeX{}; these should be omitted when interfacing with Calc. To Calc,
the @samp{$} sign has the same meaning it always does in algebraic
formulas (a reference to an existing entry on the stack).
Complex numbers are displayed as in @samp{3 + 4i}. Fractions and
quotients are written using @code{\over} in @TeX{} mode (as in
-@code{@{a \over b@}}) and @code{\frac} in La@TeX{} mode (as in
+@code{@{a \over b@}}) and @code{\frac} in @LaTeX{} mode (as in
@code{\frac@{a@}@{b@}}); binomial coefficients are written with
@code{\choose} in @TeX{} mode (as in @code{@{a \choose b@}}) and
-@code{\binom} in La@TeX{} mode (as in @code{\binom@{a@}@{b@}}).
+@code{\binom} in @LaTeX{} mode (as in @code{\binom@{a@}@{b@}}).
Interval forms are written with @code{\ldots}, and error forms are
written with @code{\pm}. Absolute values are written as in
@samp{|x + 1|}, and the floor and ceiling functions are written with
@code{\lfloor}, @code{\rfloor}, etc. The words @code{\left} and
-@code{\right} are ignored when reading formulas in @TeX{} and La@TeX{}
+@code{\right} are ignored when reading formulas in @TeX{} and @LaTeX{}
modes. Both @code{inf} and @code{uinf} are written as @code{\infty};
when read, @code{\infty} always translates to @code{inf}.
Function calls are written the usual way, with the function name followed
by the arguments in parentheses. However, functions for which @TeX{}
-and La@TeX{} have special names (like @code{\sin}) will use curly braces
+and @LaTeX{} have special names (like @code{\sin}) will use curly braces
instead of parentheses for very simple arguments. During input, curly
braces and parentheses work equally well for grouping, but when the
document is formatted the curly braces will be invisible. Thus the
the @samp{tex} prefix; the unit name for a @TeX{} point will be
@samp{pt} instead of @samp{texpt}, for example.
-Function and variable names not treated specially by @TeX{} and La@TeX{}
+Function and variable names not treated specially by @TeX{} and @LaTeX{}
are simply written out as-is, which will cause them to come out in
italic letters in the printed document. If you invoke @kbd{d T} or
@kbd{d L} with a positive numeric prefix argument, names of more than
one character will instead be enclosed in a protective commands that
will prevent them from being typeset in the math italics; they will be
written @samp{\hbox@{@var{name}@}} in @TeX{} mode and
-@samp{\text@{@var{name}@}} in La@TeX{} mode. The
+@samp{\text@{@var{name}@}} in @LaTeX{} mode. The
@samp{\hbox@{ @}} and @samp{\text@{ @}} notations are ignored during
reading. If you use a negative prefix argument, such function names are
written @samp{\@var{name}}, and function names that begin with @code{\} during
During reading, text of the form @samp{\matrix@{ ...@: @}} is replaced
by @samp{[ ...@: ]}. The same also applies to @code{\pmatrix} and
-@code{\bmatrix}. In La@TeX{} mode this also applies to
+@code{\bmatrix}. In @LaTeX{} mode this also applies to
@samp{\begin@{matrix@} ... \end@{matrix@}},
@samp{\begin@{bmatrix@} ... \end@{bmatrix@}},
@samp{\begin@{pmatrix@} ... \end@{pmatrix@}}, as well as
During output, matrices are displayed in @samp{\matrix@{ a & b \\ c & d@}}
format in @TeX{} mode and in
@samp{\begin@{pmatrix@} a & b \\ c & d \end@{pmatrix@}} format in
-La@TeX{} mode; you may need to edit this afterwards to change to your
+@LaTeX{} mode; you may need to edit this afterwards to change to your
preferred matrix form. If you invoke @kbd{d T} or @kbd{d L} with an
argument of 2 or -2, then matrices will be displayed in two-dimensional
form, such as
@end example
@noindent
-While this wouldn't bother Calc, it is incorrect La@TeX{}.
+While this wouldn't bother Calc, it is incorrect @LaTeX{}.
(Similarly for @TeX{}.)
Accents like @code{\tilde} and @code{\bar} translate into function
sequence is treated as an accent. The @code{\vec} accent corresponds
to the function name @code{Vec}, because @code{vec} is the name of
a built-in Calc function. The following table shows the accents
-in Calc, @TeX{}, La@TeX{} and @dfn{eqn} (described in the next section):
+in Calc, @TeX{}, @LaTeX{} and @dfn{eqn} (described in the next section):
@ignore
@iftex
@end example
Note that, because these symbols are ignored, reading a @TeX{} or
-La@TeX{} formula into Calc and writing it back out may lose spacing and
+@LaTeX{} formula into Calc and writing it back out may lose spacing and
font information.
Also, the ``discretionary multiplication sign'' @samp{\*} is read
symbol (these are used to introduce spaces of various widths into
the typeset output of @dfn{eqn}).
-As in La@TeX{} mode, Calc's formatter omits parentheses around the
+As in @LaTeX{} mode, Calc's formatter omits parentheses around the
arguments of functions like @code{ln} and @code{sin} if they are
``simple-looking''; in this case Calc surrounds the argument with
braces, separated by a @samp{~} from the function name: @samp{sin~@{x@}}.
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
@item BinSimp@var{w}
Binary-integer simplification mode; word size @var{w} (@kbd{m B}, @kbd{b w}).
-@item AlgSimp
-Algebraic simplification mode (@kbd{m A}).
+@item BasicSimp
+Basic simplification mode (@kbd{m I}).
@item ExtSimp
Extended algebraic simplification mode (@kbd{m E}).
@TeX{} language mode (@kbd{d T}; @pxref{TeX and LaTeX Language Modes}).
@item LaTeX
-La@TeX{} language mode (@kbd{d L}; @pxref{TeX and LaTeX Language Modes}).
+@LaTeX{} language mode (@kbd{d L}; @pxref{TeX and LaTeX Language Modes}).
@item Eqn
@dfn{Eqn} language mode (@kbd{d E}; @pxref{Eqn Language Mode}).
operation. Vectors and formulas are cleaned by cleaning each component
number (i.e., pervasively).
-If the simplification mode is set below the default level, it is raised
-to the default level for the purposes of this command. Thus, @kbd{c c}
-applies the default 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
Also, the symbolic variable @code{pi} is not ordinarily recognized in
arguments to trigonometric functions, as in @samp{sin(3 pi / 4)}, but
-the @kbd{a s} (@code{calc-simplify}) command recognizes many such
+the default algebraic simplifications recognize many such
formulas when the current angular mode is Radians @emph{and} Symbolic
mode is enabled; this example would be replaced by @samp{sqrt(2) / 2}.
@xref{Symbolic Mode}. Beware, this simplification occurs even if you
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.
@pindex calc-sel-div-both-sides
The @kbd{j *} (@code{calc-sel-mult-both-sides}) command prompts for a
formula using algebraic entry, then multiplies both sides of the
-selected quotient or equation by that formula. It simplifies each
-side with @kbd{a s} (@code{calc-simplify}) before re-forming the
+selected quotient or equation by that formula. It performs the
+default algebraic simplifications before re-forming the
quotient or equation. You can suppress this simplification by
providing a prefix argument: @kbd{C-u j *}. There is also a @kbd{j /}
(@code{calc-sel-div-both-sides}) which is similar to @kbd{j *} but
@kindex j v
@pindex calc-sel-evaluate
The @kbd{j v} (@code{calc-sel-evaluate}) command performs the
-normal default simplifications on the selected sub-formula.
-These are the simplifications that are normally done automatically
-on all results, but which may have been partially inhibited by
+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
by the @kbd{m O} command. This command is just an auto-selecting
version of the @w{@kbd{a v}} command (@pxref{Algebraic Manipulation}).
With a numeric prefix argument of 2, @kbd{C-u 2 j v} applies
-the @kbd{a s} (@code{calc-simplify}) command to the selected
+the default algebraic simplifications to the selected
sub-formula. With a prefix argument of 3 or more, e.g., @kbd{C-u j v}
applies the @kbd{a e} (@code{calc-simplify-extended}) command.
@xref{Simplifying Formulas}. With a negative prefix argument
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
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.
@kindex H a s
@pindex calc-simplify
@tindex simplify
-The @kbd{a s} (@code{calc-simplify}) [@code{simplify}] command applies
-various algebraic rules to simplify a formula. This includes rules which
-are not part of the default simplifications because they may be too slow
-to apply all the time, or may not be desirable all of the time. For
-example, non-adjacent terms of sums are combined, as in @samp{a + b + 2 a}
-to @samp{b + 3 a}, and some formulas like @samp{sin(arcsin(x))} are
-simplified to @samp{x}.
-
-The sections below describe all the various kinds of algebraic
+
+The sections below describe all the various kinds of
simplifications Calc provides in full detail. None of Calc's
simplification commands are designed to pull rabbits out of hats;
they simply apply certain specific rules to put formulas into
@xref{Rewrite Rules}.
@xref{Simplification Modes}, for commands to control what level of
-simplification occurs automatically. Normally only the ``default
-simplifications'' occur.
+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
@menu
-* Default Simplifications::
+* Basic Simplifications::
* Algebraic Simplifications::
* Unsafe Simplifications::
* Simplification of Units::
@end menu
-@node Default Simplifications, Algebraic Simplifications, Simplifying Formulas, Simplifying Formulas
-@subsection Default Simplifications
+@node Basic Simplifications, Algebraic Simplifications, Simplifying Formulas, Simplifying Formulas
+@subsection Basic Simplifications
@noindent
-@cindex Default simplifications
-This section describes the ``default simplifications,'' those which are
-normally applied to all results. For example, if you enter the variable
-@expr{x} on the stack twice and push @kbd{+}, Calc's default
-simplifications automatically change @expr{x + x} to @expr{2 x}.
-
-The @kbd{m O} command turns off the default simplifications, so that
-@expr{x + x} will remain in this form unless you give an explicit
-``simplify'' command like @kbd{=} or @kbd{a v}. @xref{Algebraic
-Manipulation}. The @kbd{m D} command turns the default simplifications
-back on.
+@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 default simplification is the evaluation of functions.
+The most basic simplification is the evaluation of functions.
For example, @expr{2 + 3} is evaluated to @expr{5}, and @expr{@tfn{sqrt}(9)}
is evaluated to @expr{3}. Evaluation does not occur if the arguments
to a function are somehow of the wrong type @expr{@tfn{tan}([2,3,4])}),
operator) does not evaluate all of its arguments, and @code{evalto}
does not evaluate its lefthand argument.
-Most commands apply the default 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 @kbd{Q} [@code{sqrt}],
-the arguments are simply popped from the stack and collected into a
-suitable function call, which is then simplified (the arguments being
-simplified first as part of the process, as described above).
-
-The default simplifications are too numerous to describe completely
-here, but this section will describe the ones that apply to the
+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
+@kbd{Q} [@code{sqrt}], the arguments are simply popped from the stack
+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 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
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 default 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
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
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
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
@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, Default Simplifications, Simplifying Formulas
+@node Algebraic Simplifications, Unsafe Simplifications, Basic Simplifications, Simplifying Formulas
@subsection Algebraic Simplifications
@noindent
@cindex Algebraic simplifications
-The @kbd{a s} command makes simplifications that may be too slow to
-do all the time, or that may not be desirable all of the time.
-If you find these simplifications are worthwhile, you can type
-@kbd{m A} to have Calc apply them automatically.
-
+@kindex a s
+@kindex m A
This section describes all simplifications that are performed by
-the @kbd{a s} command. Note that these occur in addition to the
-default simplifications; even if the default simplifications have
-been turned off by an @kbd{m O} command, @kbd{a s} will turn them
-back on temporarily while it 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 by @kbd{a s}. Its use is analogous to @code{EvalRules},
+to be applied. Its use is analogous to @code{EvalRules},
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 default
+the original expression, the process repeats with the basic
simplifications (including @code{EvalRules}), then @code{AlgSimpRules},
then the built-in simplifications, and so on.
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
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 default
+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 @kbd{a s} will; it first rewrites the sum to @expr{x y + x y},
-and then the default simplifications are able to recognize a sum
-of identical terms.
+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
+terms.
The canonical ordering used to sort terms of products has the
property that real-valued numbers, interval forms and infinities
factor in the numerator and denominator, it is canceled out;
for example, @expr{(4 x + 6) / 8 x} simplifies to @expr{(2 x + 3) / 4 x}.
-Non-constant common factors are not found even by @kbd{a s}. To
-cancel the factor @expr{a} in @expr{(a x + a) / a^2} you could first
-use @kbd{j M} on the product @expr{a x} to Merge the numerator to
-@expr{a (1+x)}, which can then be simplified successfully.
+Non-constant common factors are not found even by algebraic
+simplifications. To cancel the factor @expr{a} in
+@expr{(a x + a) / a^2} you could first use @kbd{j M} on the product
+@expr{a x} to Merge the numerator to @expr{a (1+x)}, which can then be
+simplified successfully.
@tex
\bigskip
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 done by @kbd{a s} instead of by default
-in case someone (unwisely) uses the name @code{i} for a variable
-unrelated to complex numbers; it would be unfortunate if Calc
-quietly and automatically changed this formula for reasons the
-user might not have been thinking of.
+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
+basic simplification mode.
Square roots of integer or rational arguments are simplified in
several ways. (Note that these will be left unevaluated only in
@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
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
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.
@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.
@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
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},
@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
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.
@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
@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}
@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
@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
``fundamental'' units like @samp{m} and @samp{s}, regardless of the
input units.
+If you want to disallow using inconsistent units, you can set the customizable variable
+@code{calc-ensure-consistent-units} to @code{t} (@pxref{Customizing Calc}). In this case,
+if you request units which are inconsistent with the original units, you will be warned about
+it and no conversion will occur.
+
One special exception is that if you specify a single unit name, and
a compatible unit appears somewhere in the units expression, then
that compatible unit will be converted to the new unit and the
@code{texcc} (a Cicero) and @code{texsp} (a scaled @TeX{} point,
all dimensions representable in @TeX{} are multiples of this value).
-When Calc is using the @TeX{} or La@TeX{} language mode (@pxref{TeX
+When Calc is using the @TeX{} or @LaTeX{} language mode (@pxref{TeX
and LaTeX Language Modes}), the @TeX{} specific unit names will not
use the @samp{tex} prefix; the unit name for a @TeX{} point will be
@samp{pt} instead of @samp{texpt}, for example. To avoid conflicts,
@item s D
Edit @code{Decls}. @xref{Declarations}.
@item s E
-Edit @code{EvalRules}. @xref{Default Simplifications}.
+Edit @code{EvalRules}. @xref{Basic Simplifications}.
@item s F
Edit @code{FitRules}. @xref{Curve Fitting}.
@item s G
@cindex @samp{=>} operator
The special algebraic symbol @samp{=>} is known as the @dfn{evaluates-to
operator}. (It will show up as an @code{evalto} function call in
-other language modes like Pascal and La@TeX{}.) This is a binary
+other language modes like Pascal and @LaTeX{}.) This is a binary
operator, that is, it has a lefthand and a righthand argument,
although it can be entered with the righthand argument omitted.
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
Calc will try to guess an appropriate language based on the major mode
of the editing buffer. (@xref{Language Modes}.) If the current buffer is
-in @code{latex-mode}, for example, Calc will set its language to La@TeX{}.
+in @code{latex-mode}, for example, Calc will set its language to @LaTeX{}.
Similarly, Calc will use @TeX{} language for @code{tex-mode},
@code{plain-tex-mode} and @code{context-mode}, C language for
@code{c-mode} and @code{c++-mode}, FORTRAN language for
@enumerate
@item
-The @TeX{} and La@TeX{} math delimiters @samp{$ $}, @samp{$$ $$},
+The @TeX{} and @LaTeX{} math delimiters @samp{$ $}, @samp{$$ $$},
@samp{\[ \]}, and @samp{\( \)};
@item
Lines beginning with @samp{\begin} and @samp{\end} (except matrix delimiters);
When Embedded mode ``activates'' a formula, i.e., when it examines
the formula for the first time since the buffer was created or
loaded, Calc tries to sense the language in which the formula was
-written. If the formula contains any La@TeX{}-like @samp{\} sequences,
-it is parsed (i.e., read) in La@TeX{} mode. If the formula appears to
+written. If the formula contains any @LaTeX{}-like @samp{\} sequences,
+it is parsed (i.e., read) in @LaTeX{} mode. If the formula appears to
be written in multi-line Big mode, it is parsed in Big mode. Otherwise,
it is parsed according to the current language mode.
Note that Calc does not change the current language mode according
-the formula it reads in. Even though it can read a La@TeX{} formula when
-not in La@TeX{} mode, it will immediately rewrite this formula using
+the formula it reads in. Even though it can read a @LaTeX{} formula when
+not in @LaTeX{} mode, it will immediately rewrite this formula using
whatever language mode is in effect.
@tex
Plain formulas are preceded and followed by @samp{%%%} signs
by default. This notation has the advantage that the @samp{%}
-character begins a comment in @TeX{} and La@TeX{}, so if your formula is
-embedded in a @TeX{} or La@TeX{} document its plain version will be
+character begins a comment in @TeX{} and @LaTeX{}, so if your formula is
+embedded in a @TeX{} or @LaTeX{} document its plain version will be
invisible in the final printed copy. Certain major modes have different
delimiters to ensure that the ``plain'' version will be
in a comment for those modes, also.
@noindent
where the leading and trailing @samp{---} can be replaced by
any suitable strings (which must be the same on all three lines)
-or omitted altogether; in a @TeX{} or La@TeX{} file, @samp{%} would be a good
+or omitted altogether; in a @TeX{} or @LaTeX{} file, @samp{%} would be a good
leading string and no trailing string would be necessary. In a
C program, @samp{/*} and @samp{*/} would be good leading and
trailing strings.
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
@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
Embedded mode understands by default are:
@enumerate
@item
-The @TeX{} and La@TeX{} math delimiters @samp{$ $}, @samp{$$ $$},
+The @TeX{} and @LaTeX{} math delimiters @samp{$ $}, @samp{$$ $$},
@samp{\[ \]}, and @samp{\( \)};
@item
Lines beginning with @samp{\begin} and @samp{\end} (except matrix delimiters);
of @code{calc-multiplication-has-precedence} is @code{t}.
@end defvar
+@defvar calc-ensure-consistent-units
+When converting units, the variable @code{calc-ensure-consistent-units}
+determines whether or not the target units need to be consistent with the
+original units. If @code{calc-ensure-consistent-units} is @code{nil}, then
+the target units don't need to have the same dimensions as the original units;
+for example, converting @samp{100 ft/s} to @samp{m} will produce @samp{30.48 m/s}.
+If @code{calc-ensure-consistent-units} is non-@code{nil}, then the target units
+need to have the same dimensions as the original units; for example, converting
+@samp{100 ft/s} to @samp{m} will result in an error, since @samp{ft/s} and @samp{m}
+have different dimensions. The default value of @code{calc-ensure-consistent-units}
+is @code{nil}.
+@end defvar
+
@defvar calc-undo-length
The variable @code{calc-undo-length} determines the number of undo
steps that Calc will keep track of when @code{calc-quit} is called.
@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
@contents
-@node Top, Overview, (dir), (dir)
-@chapter Introduction
-
-@noindent
-This document describes a set of Emacs Lisp facilities borrowed from
-Common Lisp. All the facilities are described here in detail. While
-this document does not assume any prior knowledge of Common Lisp, it
-does assume a basic familiarity with Emacs Lisp.
-
@ifnottex
+@node Top
+@top GNU Emacs Common Lisp Emulation
+
@insertcopying
@end ifnottex
* Variable Index::
@end menu
-@node Overview, Program Structure, Top, Top
-@ifnottex
+@node Overview
@chapter Overview
-@end ifnottex
@noindent
+This document describes a set of Emacs Lisp facilities borrowed from
+Common Lisp. All the facilities are described here in detail. While
+this document does not assume any prior knowledge of Common Lisp, it
+does assume a basic familiarity with Emacs Lisp.
+
Common Lisp is a huge language, and Common Lisp systems tend to be
massive and extremely complex. Emacs Lisp, by contrast, is rather
minimalist in the choice of Lisp features it offers the programmer.
* Naming Conventions:: Notes on CL function names
@end menu
-@node Usage, Organization, Overview, Overview
+@node Usage
@section Usage
@noindent
in your @file{.emacs} file. But it's a good idea, for portability,
to @code{(require 'cl)} in your code even if you do this.
-@node Organization, Installation, Usage, Overview
+@node Organization
@section Organization
@noindent
multiple-values feature. This file is obsolete and should not be used
in new code. @xref{Old CL Compatibility}.
-@node Installation, Naming Conventions, Organization, Overview
+@node Installation
@section Installation
@noindent
file and put the resulting Info files into a directory in your
@code{Info-directory-list}.
-@node Naming Conventions, , Installation, Overview
+@node Naming Conventions
@section Naming Conventions
@noindent
@noindent
[4] Only when @var{place} is a plain variable name.
-@iftex
-@chapno=4
-@end iftex
-
-@node Program Structure, Predicates, Overview, Top
+@node Program Structure
@chapter Program Structure
@noindent
@secno=1
@end iftex
-@node Argument Lists, Time of Evaluation, Program Structure, Program Structure
+@node Argument Lists
@section Argument Lists
@noindent
arguments and invalid keyword arguments is disabled. By default,
argument lists are rigorously checked.
-@node Time of Evaluation, , Argument Lists, Program Structure
+@node Time of Evaluation
@section Time of Evaluation
@noindent
@end example
@end defspec
-@node Predicates, Control Structure, Program Structure, Top
+@node Predicates
@chapter Predicates
@noindent
* Equality Predicates:: @code{equalp}
@end menu
-@node Type Predicates, Equality Predicates, Predicates, Predicates
+@node Type Predicates
@section Type Predicates
@noindent
@code{concatenate}, and @code{merge} functions take type-name
arguments to specify the type of sequence to return. @xref{Sequences}.
-@node Equality Predicates, , Type Predicates, Predicates
+@node Equality Predicates
@section Equality Predicates
@noindent
In Emacs, use @code{member*} and @code{assoc*} to get functions
which use @code{eql} for comparisons.
-@node Control Structure, Macros, Predicates, Top
+@node Control Structure
@chapter Control Structure
@noindent
* Multiple Values:: @code{values}, @code{multiple-value-bind}, etc.
@end menu
-@node Assignment, Generalized Variables, Control Structure, Control Structure
+@node Assignment
@section Assignment
@noindent
@code{psetq} always returns @code{nil}.
@end defspec
-@node Generalized Variables, Variable Bindings, Assignment, Control Structure
+@node Generalized Variables
@section Generalized Variables
@noindent
* Customizing Setf:: @code{define-modify-macro}, @code{defsetf}, @code{define-setf-method}
@end menu
-@node Basic Setf, Modify Macros, Generalized Variables, Generalized Variables
+@node Basic Setf
@subsection Basic Setf
@noindent
to @code{wrong-order}.
@end defspec
-@node Modify Macros, Customizing Setf, Basic Setf, Generalized Variables
+@node Modify Macros
@subsection Modify Macros
@noindent
macros are used in the processing of symbol macros;
@pxref{Macro Bindings}.
-@node Customizing Setf, , Modify Macros, Generalized Variables
+@node Customizing Setf
@subsection Customizing Setf
@noindent
@secno=4
@end iftex
-@node Variable Bindings, Conditionals, Generalized Variables, Control Structure
+@node Variable Bindings
@section Variable Bindings
@noindent
* Macro Bindings:: @code{macrolet} and @code{symbol-macrolet}
@end menu
-@node Dynamic Bindings, Lexical Bindings, Variable Bindings, Variable Bindings
+@node Dynamic Bindings
@subsection Dynamic Bindings
@noindent
are ignored.
@end defspec
-@node Lexical Bindings, Function Bindings, Dynamic Bindings, Variable Bindings
+@node Lexical Bindings
@subsection Lexical Bindings
@noindent
are made sequentially in the manner of @code{let*}.
@end defspec
-@node Function Bindings, Macro Bindings, Lexical Bindings, Variable Bindings
+@node Function Bindings
@subsection Function Bindings
@noindent
@code{function} to be passed on to, say, @code{mapcar}.
@end defspec
-@node Macro Bindings, , Function Bindings, Variable Bindings
+@node Macro Bindings
@subsection Macro Bindings
@noindent
works much like @code{my-dolist}.
@end defspec
-@node Conditionals, Blocks and Exits, Variable Bindings, Control Structure
+@node Conditionals
@section Conditionals
@noindent
simply returning @code{nil}.
@end defspec
-@node Blocks and Exits, Iteration, Conditionals, Control Structure
+@node Blocks and Exits
@section Blocks and Exits
@noindent
themselves in @code{nil} blocks.
@end defspec
-@node Iteration, Loop Facility, Blocks and Exits, Control Structure
+@node Iteration
@section Iteration
@noindent
@xref{Mapping over Sequences}, for some more functions for
iterating over vectors or lists.
-@node Loop Facility, Multiple Values, Iteration, Control Structure
+@node Loop Facility
@section Loop Facility
@noindent
* Other Clauses:: @code{with}, @code{if}, @code{initially}, @code{finally}
@end menu
-@node Loop Basics, Loop Examples, Loop Facility, Loop Facility
+@node Loop Basics
@subsection Loop Basics
@noindent
Consult the second edition of Steele's @dfn{Common Lisp, the Language},
for additional discussion and examples of the @code{loop} macro.
-@node Loop Examples, For Clauses, Loop Basics, Loop Facility
+@node Loop Examples
@subsection Loop Examples
@noindent
rather than some sort of triple-nested loop. You must explicitly
nest your @code{loop} constructs if you want nested loops.
-@node For Clauses, Iteration Clauses, Loop Examples, Loop Facility
+@node For Clauses
@subsection For Clauses
@noindent
@result{} (1 2)
@end example
-@node Iteration Clauses, Accumulation Clauses, For Clauses, Loop Facility
+@node Iteration Clauses
@subsection Iteration Clauses
@noindent
values were @code{nil}, the loop returns @code{nil}.
@end table
-@node Accumulation Clauses, Other Clauses, Iteration Clauses, Loop Facility
+@node Accumulation Clauses
@subsection Accumulation Clauses
@noindent
@result{} (fred bob ken sue alice joe kris sunshine june)
@end example
-@node Other Clauses, , Accumulation Clauses, Loop Facility
+@node Other Clauses
@subsection Other Clauses
@noindent
iterate over keymaps, overlays, intervals, frames, windows, and
buffers are Emacs-specific extensions.
-@node Multiple Values, , Loop Facility, Control Structure
+@node Multiple Values
@section Multiple Values
@noindent
Since a perfect emulation is not feasible in Emacs Lisp, this
package opts to keep it as simple and predictable as possible.
-@node Macros, Declarations, Control Structure, Top
+@node Macros
@chapter Macros
@noindent
and @code{symbol-macrolet} forms for making ``local'' macro
definitions.
-@node Declarations, Symbols, Macros, Top
+@node Declarations
@chapter Declarations
@noindent
See the documentation for the optimizing byte compiler for details.
@end table
-@node Symbols, Numbers, Declarations, Top
+@node Symbols
@chapter Symbols
@noindent
* Creating Symbols:: @code{gensym}, @code{gentemp}
@end menu
-@node Property Lists, Creating Symbols, Symbols, Symbols
+@node Property Lists
@section Property Lists
@noindent
@secno=2
@end iftex
-@node Creating Symbols, , Property Lists, Symbols
+@node Creating Symbols
@section Creating Symbols
@noindent
keywords as data unrelated to keyword arguments, so the
@code{defkeyword} form has been discontinued.
-@iftex
-@chapno=11
-@end iftex
-
-@node Numbers, Sequences, Symbols, Top
+@node Numbers
@chapter Numbers
@noindent
@secno=1
@end iftex
-@node Predicates on Numbers, Numerical Functions, Numbers, Numbers
+@node Predicates on Numbers
@section Predicates on Numbers
@noindent
@secno=3
@end iftex
-@node Numerical Functions, Random Numbers, Predicates on Numbers, Numbers
+@node Numerical Functions
@section Numerical Functions
@noindent
@secno=8
@end iftex
-@node Random Numbers, Implementation Parameters, Numerical Functions, Numbers
+@node Random Numbers
@section Random Numbers
@noindent
@code{random-state} object, or @code{nil} otherwise.
@end defun
-@node Implementation Parameters, , Random Numbers, Numbers
+@node Implementation Parameters
@section Implementation Parameters
@noindent
@code{1.11e-16}.
@end defvar
-@iftex
-@chapno=13
-@end iftex
-
-@node Sequences, Lists, Numbers, Top
+@node Sequences
@chapter Sequences
@noindent
* Sorting Sequences:: @code{sort*}, @code{stable-sort}, @code{merge}
@end menu
-@node Sequence Basics, Mapping over Sequences, Sequences, Sequences
+@node Sequence Basics
@section Sequence Basics
@noindent
the properties of the characters copied from @var{str} into the
result.
-@node Mapping over Sequences, Sequence Functions, Sequence Basics, Sequences
+@node Mapping over Sequences
@section Mapping over Sequences
@noindent
be faster since it generates the loop as in-line code with no
function calls.
-@node Sequence Functions, Searching Sequences, Mapping over Sequences, Sequences
+@node Sequence Functions
@section Sequence Functions
@noindent
and @code{nsubstitute-if-not} functions are defined similarly. For
these, a @var{predicate} is given in place of the @var{old} argument.
-@node Searching Sequences, Sorting Sequences, Sequence Functions, Sequences
+@node Searching Sequences
@section Searching Sequences
@noindent
function finds the @emph{rightmost} matching subsequence.
@end defun
-@node Sorting Sequences, , Searching Sequences, Sequences
+@node Sorting Sequences
@section Sorting Sequences
@defun sort* seq predicate @t{&key :key}
@var{predicate}.
@end defun
-@node Lists, Structures, Sequences, Top
+@node Lists
@chapter Lists
@noindent
* Association Lists:: @code{assoc*}, @code{rassoc*}, @code{acons}, @code{pairlis}
@end menu
-@node List Functions, Substitution of Expressions, Lists, Lists
+@node List Functions
@section List Functions
@noindent
@secno=3
@end iftex
-@node Substitution of Expressions, Lists as Sets, List Functions, Lists
+@node Substitution of Expressions
@section Substitution of Expressions
@noindent
This is a destructive version of @code{sublis}.
@end defun
-@node Lists as Sets, Association Lists, Substitution of Expressions, Lists
+@node Lists as Sets
@section Lists as Sets
@noindent
also appears in @var{list2}.
@end defun
-@node Association Lists, , Lists as Sets, Lists
+@node Association Lists
@section Association Lists
@noindent
@var{alist})}.
@end defun
-@iftex
-@chapno=18
-@end iftex
-
-@node Structures, Assertions, Lists, Top
+@node Structures
@chapter Structures
@noindent
Except as noted, the @code{defstruct} facility of this package is
entirely compatible with that of Common Lisp.
-@iftex
-@chapno=23
-@end iftex
-
-@node Assertions, Efficiency Concerns, Structures, Top
+@node Assertions
@chapter Assertions and Errors
@noindent
returns the result of the last @var{form}.
@end defspec
-@node Efficiency Concerns, Common Lisp Compatibility, Assertions, Top
+@node Efficiency Concerns
@appendix Efficiency Concerns
@appendixsec Macros
optimizing compiler removes @code{block}s which are not actually
referenced by @code{return} or @code{return-from} inside the block.
-@node Common Lisp Compatibility, Old CL Compatibility, Efficiency Concerns, Top
+@node Common Lisp Compatibility
@appendix Common Lisp Compatibility
@noindent
The second argument of @code{check-type} is treated differently.
-@node Old CL Compatibility, Porting Common Lisp, Common Lisp Compatibility, Top
+@node Old CL Compatibility
@appendix Old CL Compatibility
@noindent
@code{floor}, @code{ceiling}, etc.; @code{cl-compat} cannot use
these names because they conflict with Emacs built-ins.
-@node Porting Common Lisp, GNU Free Documentation License, Old CL Compatibility, Top
+@node Porting Common Lisp
@appendix Porting Common Lisp
@noindent
recursion.
@end itemize
-@node GNU Free Documentation License, Function Index, Porting Common Lisp, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
-@node Function Index, Variable Index, GNU Free Documentation License, Top
+@node Function Index
@unnumbered Function Index
@printindex fn
-@node Variable Index, , Function Index, Top
+@node Variable Index
@unnumbered Variable Index
@printindex vr
* Asynchronous Methods:: Calling methods non-blocking.
* Receiving Method Calls:: Offering own methods.
* Signals:: Sending and receiving signals.
-* Alternative Buses:: Alternative buses.
+* Alternative Buses:: Alternative buses and environments.
* Errors and Events:: Errors and events.
* Index:: Index including concepts, functions, variables.
@cindex inspection
@menu
+* Version:: Determining the D-Bus version.
* Bus names:: Discovering D-Bus names.
* Introspection:: Knowing the details of D-Bus services.
* Nodes and Interfaces:: Detecting object paths and interfaces.
@end menu
+@node Version
+@section D-Bus version.
+
+D-Bus has evolved over the years. New features have been added with
+new D-Bus versions. There are two variables, which allow to determine
+the used D-Bus version.
+
+@defvar dbus-compiled-version
+This variable, a string, determines the version of D-Bus Emacs is
+compiled against. If it cannot be determined the value is @code{nil}.
+@end defvar
+
+@defvar dbus-runtime-version
+The other D-Bus version to be checked is the version of D-Bus Emacs
+runs with. This string can be different from @code{dbus-compiled-version}.
+It is also @code{nil}, if it cannot be determined at runtime.
+@end defvar
+
+
@node Bus names
@section Bus names.
(member "org.gnome.evince.Daemon"
(dbus-list-activatable-names :session))
@end lisp
-
@end defun
@defun dbus-list-names bus
That is, properties can be retrieved and changed during lifetime of an
element.
+A generalized interface is
+@samp{org.freedesktop.DBus.Objectmanager}@footnote{See
+@uref{http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager}},
+which returns objects, their interfaces and properties for a given
+service in just one call.
+
Annotations, on the other hand, are static values for an element.
Often, they are used to instruct generators, how to generate code from
the interface for a given language binding.
@end lisp
@end defun
+@defun dbus-get-all-managed-objects bus service path
+This functions returns all objects at @var{bus}, @var{service},
+@var{path}, and the children of @var{path}. The result is a list of
+objects. Every object is a cons of an existing path name, and the
+list of available interface objects. An interface object is another
+cons, which car is the interface name, and the cdr is the list of
+properties as returned by @code{dbus-get-all-properties} for that path
+and interface. Example:
+
+@lisp
+(dbus-get-all-managed-objects
+ :session "org.gnome.SettingsDaemon" "/")
+
+@result{} (("/org/gnome/SettingsDaemon/MediaKeys"
+ ("org.gnome.SettingsDaemon.MediaKeys")
+ ("org.freedesktop.DBus.Peer")
+ ("org.freedesktop.DBus.Introspectable")
+ ("org.freedesktop.DBus.Properties")
+ ("org.freedesktop.DBus.ObjectManager"))
+ ("/org/gnome/SettingsDaemon/Power"
+ ("org.gnome.SettingsDaemon.Power.Keyboard")
+ ("org.gnome.SettingsDaemon.Power.Screen")
+ ("org.gnome.SettingsDaemon.Power"
+ ("Icon" . ". GThemedIcon battery-full-charged-symbolic ")
+ ("Tooltip" . "Laptop battery is charged"))
+ ("org.freedesktop.DBus.Peer")
+ ("org.freedesktop.DBus.Introspectable")
+ ("org.freedesktop.DBus.Properties")
+ ("org.freedesktop.DBus.ObjectManager"))
+ @dots{})
+@end lisp
+
+If possible, @samp{org.freedesktop.DBus.ObjectManager.GetManagedObjects}
+is used for retrieving the information. Otherwise, the information
+is collected via @samp{org.freedesktop.DBus.Introspectable.Introspect}
+and @samp{org.freedesktop.DBus.Properties.GetAll}, which is slow.
+
+An overview of all existing object paths, their interfaces and
+properties could be retrieved by the following code:
+
+@lisp
+(with-current-buffer (switch-to-buffer "*objectmanager*")
+ (erase-buffer)
+ (let (result)
+ (dolist (service (dbus-list-known-names :session) result)
+ (message "%s" service)
+ (add-to-list
+ 'result
+ (cons service
+ (dbus-get-all-managed-objects :session service "/"))))
+ (insert (message "%s" (pp result)))
+ (redisplay t)))
+@end lisp
+@end defun
+
@defun dbus-introspect-get-annotation-names bus service path interface &optional name
Return a list of all annotation names as list of strings. If
@var{name} is @code{nil}, the annotations are children of
@code{:byte ?x} is equal to @code{:byte ?\M-x}, but it is not equal to
@code{:byte ?\C-x} or @code{:byte ?\M-\C-x}.
+Signed and unsigned integer D-Bus types expect a corresponding integer
+value. If the value does not fit Emacs's integer range, it is also
+possible to use an equivalent floating point number.
+
A D-Bus compound type is always represented as a list. The @sc{car}
of this list can be the type symbol @code{:array}, @code{:variant},
@code{:struct} or @code{:dict-entry}, which would result in a
@end lisp
@end defun
-@defun dbus-call-method-non-blocking bus service path interface method &optional :timeout timeout &rest args
-Call @var{method} on the D-Bus @var{bus}, but don't block the event queue.
-This is necessary for communicating to registered D-Bus methods,
-which are running in the same Emacs process.
-
-The arguments are the same as in @code{dbus-call-method}. Example:
-
-@lisp
-(dbus-call-method-non-blocking
- :system "org.freedesktop.Hal"
- "/org/freedesktop/Hal/devices/computer"
- "org.freedesktop.Hal.Device" "GetPropertyString"
- "system.kernel.machine")
-
-@result{} "i686"
-@end lisp
-@end defun
-
@node Asynchronous Methods
@chapter Calling methods non-blocking.
They are converted into D-Bus types as described in @ref{Type
Conversion}.
-Unless @var{handler} is @code{nil}, the function returns a key into
+If @var{handler} is a Lisp function, the function returns a key into
the hash table @code{dbus-registered-objects-table}. The
corresponding entry in the hash table is removed, when the return
message has been arrived, and @var{handler} is called. Example:
"org.freedesktop.Hal.Device" "GetPropertyString" 'message
"system.kernel.machine")
-@result{} (:system 2)
+@result{} (:serial :system 2)
@print{} i686
@end lisp
It could be also an implementation of an own interface. In this case,
the service name must be @samp{org.gnu.Emacs}. The object path shall
-begin with @samp{/org/gnu/Emacs/@strong{Application}/}, and the
+begin with @samp{/org/gnu/Emacs/@strong{Application}}, and the
interface name shall be @code{org.gnu.Emacs.@strong{Application}}.
@samp{@strong{Application}} is the name of the application which
provides the interface.
@deffn Constant dbus-service-emacs
-The well known service name of Emacs.
+The well known service name @samp{org.gnu.Emacs} of Emacs.
@end deffn
@deffn Constant dbus-path-emacs
-The object path head "/org/gnu/Emacs" used by Emacs. All object
-paths, used by offered methods or signals, shall start with this
-string.
+The object path namespace @samp{/org/gnu/Emacs} used by Emacs.
+@end deffn
+
+@deffn Constant dbus-interface-emacs
+The interface namespace @code{org.gnu.Emacs} used by Emacs.
@end deffn
@defun dbus-register-method bus service path interface method handler dont-register-service
"org.freedesktop.TextEditor" "OpenFile"
'my-dbus-method-handler)
-@result{} ((:session "org.freedesktop.TextEditor" "OpenFile")
+@result{} ((:method :session "org.freedesktop.TextEditor" "OpenFile")
("org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"
my-dbus-method-handler))
@end lisp
:session "org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"
"org.freedesktop.TextEditor" "name" :read "GNU Emacs")
-@result{} ((:session "org.freedesktop.TextEditor" "name")
+@result{} ((:property :session "org.freedesktop.TextEditor" "name")
("org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"))
(dbus-register-property
:session "org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"
"org.freedesktop.TextEditor" "version" :readwrite emacs-version t)
-@result{} ((:session "org.freedesktop.TextEditor" "version")
+@result{} ((:property :session "org.freedesktop.TextEditor" "version")
("org.freedesktop.TextEditor" "/org/freedesktop/TextEditor"))
@end lisp
@chapter Sending and receiving signals.
@cindex signals
-Signals are broadcast messages. They carry input parameters, which
-are received by all objects which have registered for such a signal.
+Signals are one way messages. They carry input parameters, which are
+received by all objects which have registered for such a signal.
@defun dbus-send-signal bus service path interface signal &rest args
This function is similar to @code{dbus-call-method}. The difference
either the symbol @code{:system} or the symbol @code{:session}. It
doesn't matter whether another object has registered for @var{signal}.
-@var{service} is the D-Bus service name of the object the signal is
-emitted from. @var{path} is the corresponding D-Bus object path,
-@var{service} is registered at. @var{interface} is an interface
-offered by @var{service}. It must provide @var{signal}.
+Signals can be unicast or broadcast messages. For broadcast messages,
+@var{service} must be @code{nil}. Otherwise, @var{service} is the
+D-Bus service name the signal is sent to as unicast
+message.@footnote{For backward compatibility, a broadcast message is
+also emitted if @var{service} is the known or unique name Emacs is
+registered at D-Bus @var{bus}.} @var{path} is the D-Bus object path
+@var{signal} is sent from. @var{interface} is an interface available
+at @var{path}. It must provide @var{signal}.
All other arguments args are passed to @var{signal} as arguments.
They are converted into D-Bus types as described in @ref{Type
@lisp
(dbus-send-signal
- :session dbus-service-emacs dbus-path-emacs
- (concat dbus-service-emacs ".FileManager") "FileModified"
+ :session nil dbus-path-emacs
+ (concat dbus-interface-emacs ".FileManager") "FileModified"
"/home/albinus/.emacs")
@end lisp
@end defun
@defun dbus-register-signal bus service path interface signal handler &rest args
-With this function, an application registers for @var{signal} on the
-D-Bus @var{bus}.
+With this function, an application registers for a signal on the D-Bus
+@var{bus}.
@var{bus} is either the symbol @code{:system} or the symbol
@code{:session}.
When the corresponding D-Bus object disappears, signals won't be
received any longer.
-When @var{service} is @code{nil}, related signals from all D-Bus
-objects shall be accepted.
-
@var{path} is the corresponding D-Bus object path, @var{service} is
-registered at. It can also be @code{nil} if the path name of incoming
-signals shall not be checked.
+registered at. @var{interface} is an interface offered by
+@var{service}. It must provide @var{signal}.
-@var{interface} is an interface offered by @var{service}. It must
-provide @var{signal}.
+@var{service}, @var{path}, @var{interface} and @var{signal} can be
+@code{nil}. This is interpreted as a wildcard for the respective
+argument.
@var{handler} is a Lisp function to be called when the @var{signal} is
received. It must accept as arguments the output parameters
@var{signal} is sending.
-All other arguments @var{args}, if specified, must be strings. They
-stand for the respective arguments of @var{signal} in their order, and
-are used for filtering as well. A @code{nil} argument might be used
-to preserve the order.
+The remaining arguments @var{args} can be keywords or keyword string
+pairs.@footnote{For backward compatibility, the arguments @var{args}
+can also be just strings. They stand for the respective arguments of
+@var{signal} in their order, and are used for filtering as well. A
+@code{nil} argument might be used to preserve the order.} The meaning
+is as follows:
+
+@itemize
+@item @code{:argN} @var{string}:@*
+@code{:pathN} @var{string}:@*
+This stands for the Nth argument of the signal. @code{:pathN}
+arguments can be used for object path wildcard matches as specified by
+D-Bus, while an @code{:argN} argument requires an exact match.
+
+@item @code{:arg-namespace} @var{string}:@*
+Register for the signals, which first argument defines the service or
+interface namespace @var{string}.
+
+@item @code{:path-namespace} @var{string}:@*
+Register for the object path namespace @var{string}. All signals sent
+from an object path, which has @var{string} as the preceding string,
+are matched. This requires @var{path} to be @code{nil}.
+
+@item @code{:eavesdrop}:@*
+Register for unicast signals which are not directed to the D-Bus
+object Emacs is registered at D-Bus BUS, if the security policy of BUS
+allows this. Otherwise, this argument is ignored.
+@end itemize
@code{dbus-register-signal} returns a Lisp object, which can be used
as argument in @code{dbus-unregister-object} for removing the
"org.freedesktop.Hal.Manager" "DeviceAdded"
'my-dbus-signal-handler)
-@result{} ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
+@result{} ((:signal :system "org.freedesktop.Hal.Manager" "DeviceAdded")
("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
my-signal-handler))
@end lisp
single string argument therefore. Plugging an USB device to your
machine, when registered for signal @samp{DeviceAdded}, will show you
which objects the GNU/Linux @code{hal} daemon adds.
+
+Some of the match rules have been added to a later version of D-Bus.
+In order to test the availability of such features, you could register
+for a dummy signal, and check the result:
+
+@lisp
+(dbus-ignore-errors
+ (dbus-register-signal
+ :system nil nil nil nil 'ignore :path-namespace "/invalid/path"))
+
+@result{} nil
+@end lisp
@end defun
@node Alternative Buses
-@chapter Alternative buses.
+@chapter Alternative buses and environments.
@cindex bus names
@cindex UNIX domain socket
+@cindex TCP/IP socket
Until now, we have spoken about the system and the session buses,
which are the default buses to be connected to. However, it is
possible to connect to any bus, from which the address is known. This
-is a UNIX domain socket. Everywhere, where a @var{bus} is mentioned
-as argument of a function (the symbol @code{:system} or the symbol
-@code{:session}), this address can be used instead. The connection to
-this bus must be initialized first.
+is a UNIX domain or TCP/IP socket. Everywhere, where a @var{bus} is
+mentioned as argument of a function (the symbol @code{:system} or the
+symbol @code{:session}), this address can be used instead. The
+connection to this bus must be initialized first.
-@defun dbus-init-bus bus
+@defun dbus-init-bus bus &optional private
Establish the connection to D-Bus @var{bus}.
@var{bus} can be either the symbol @code{:system} or the symbol
is called when loading @file{dbus.el}, there is no need to call it
again.
-Example: You open another session bus in a terminal window on your host:
+The function returns a number, which counts the connections this Emacs
+session has established to the @var{bus} under the same unique name
+(see @code{dbus-get-unique-name}). It depends on the libraries Emacs
+is linked with, and on the environment Emacs is running. For example,
+if Emacs is linked with the gtk toolkit, and it runs in a GTK-aware
+environment like Gnome, another connection might already be
+established.
-@example
-# eval `dbus-launch --auto-syntax`
-# echo $DBUS_SESSION_BUS_ADDRESS
+When @var{private} is non-@code{nil}, a new connection is established
+instead of reusing an existing one. It results in a new unique name
+at the bus. This can be used, if it is necessary to distinguish from
+another connection used in the same Emacs process, like the one
+established by GTK+. It should be used with care for at least the
+@code{:system} and @code{:session} buses, because other Emacs Lisp
+packages might already use this connection to those buses.
-@print{} unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e
-@end example
-
-In Emacs, you can access to this bus via its address:
+Example: You initialize a connection to the AT-SPI bus on your host:
@lisp
(setq my-bus
- "unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e")
+ (dbus-call-method
+ :session "org.a11y.Bus" "/org/a11y/bus"
+ "org.a11y.Bus" "GetAddress"))
-@result{} "unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e"
+@result{} "unix:abstract=/tmp/dbus-2yzWHOCdSD,guid=a490dd26625870ca1298b6e10000fd7f"
+;; If Emacs is built with gtk support, and you run in a GTK enabled
+;; environment (like a GNOME session), the initialization reuses the
+;; connection established by GTK's atk bindings.
(dbus-init-bus my-bus)
-@result{} nil
+@result{} 2
(dbus-get-unique-name my-bus)
-@result{} ":1.0"
+@result{} ":1.19"
+
+;; Open a new connection to the same bus. This obsoletes the
+;; previous one.
+(dbus-init-bus my-bus 'private)
+
+@result{} 1
+
+(dbus-get-unique-name my-bus)
+
+@result{} ":1.20"
+@end lisp
+
+D-Bus addresses can specify different transport. A possible address
+could be based on TCP/IP sockets, see next example. However, it
+depends on the bus daemon configuration, which transport is supported.
+@end defun
+
+@defun dbus-setenv bus variable value
+Set the value of the @var{bus} environment variable @var{variable} to
+@var{value}.
+
+@var{bus} is either a Lisp symbol, @code{:system} or @code{:session},
+or a string denoting the bus address. Both @var{variable} and
+@var{value} should be strings.
+
+Normally, services inherit the environment of the bus daemon. This
+function adds to or modifies that environment when activating services.
+
+Some bus instances, such as @code{:system}, may disable setting the
+environment. In such cases, or if this feature is not available in
+older D-Bus versions, a @code{dbus-error} error is raised.
+
+As an example, it might be desirable to start X11 enabled services on
+a remote host's bus on the same X11 server the local Emacs is
+running. This could be achieved by
+
+@lisp
+(setq my-bus "unix:host=example.gnu.org,port=4711")
+
+@result{} "unix:host=example.gnu.org,port=4711"
+
+(dbus-init-bus my-bus)
+
+@result{} 1
+
+(dbus-setenv my-bus "DISPLAY" (getenv "DISPLAY"))
+
+@result{} nil
@end lisp
@end defun
@end defvar
Input parameters of @code{dbus-call-method},
-@code{dbus-call-method-non-blocking},
-@code{dbus-call-method-asynchronously}, and
+@code{dbus-call-method-asynchronously}, @code{dbus-send-signal},
+@code{dbus-register-method}, @code{dbus-register-property} and
@code{dbus-register-signal} are checked for correct D-Bus types. If
there is a type mismatch, the Lisp error @code{wrong-type-argument}
@code{D-Bus ARG} is raised.
@lisp
(defun my-dbus-event-error-handler (event error)
- (when (string-equal (concat dbus-service-emacs ".FileManager")
+ (when (string-equal (concat dbus-interface-emacs ".FileManager")
(dbus-event-interface-name event))
(message "my-dbus-event-error-handler: %S %S" event error)
(signal 'file-error (cdr error))))
@end ifnottex
-@node Introduction, Installation, Top, Top
+@node Introduction
@chapter Introduction
This documents some @emph{extra} features for GNU Emacs's Dired Mode
@end menu
@end ifnottex
-@node Features, Technical Details, , Introduction
+@node Features
@section Features
@cindex Features
@code{dired-x-find-file} and @code{dired-x-find-file-other-window},
respectively (@pxref{Find File At Point}).
-@node Technical Details, , Features, Introduction
+@node Technical Details
@section Technical Details
@cindex Modified functions
@cindex @file{dired-aux.el}
@code{dired-guess-shell-command} (@pxref{Shell Command Guessing}) to
offer a smarter default command.
-@node Installation, Omitting Files in Dired, Introduction, Top
+@node Installation
@chapter Installation
@noindent
@end menu
@end ifnottex
-@node Optional Installation Dired Jump, Optional Installation File At Point, , Installation
+@node Optional Installation Dired Jump
@section Optional Installation Dired Jump
@cindex Autoloading @code{dired-jump} and @code{dired-jump-other-window}
(define-key global-map "\C-x4\C-j" 'dired-jump-other-window)
@end example
-@node Optional Installation File At Point, , Optional Installation Dired Jump, Installation
+@node Optional Installation File At Point
@section Optional Installation File At Point
@cindex Binding @code{dired-x-find-file}
))
@end example
-@node Omitting Files in Dired, Local Variables, Installation, Top
+@node Omitting Files in Dired
@chapter Omitting Files in Dired
@cindex Omitting Files in Dired
@end menu
@end ifnottex
-@node Omitting Variables, Omitting Examples, , Omitting Files in Dired
+@node Omitting Variables
@section Omitting Variables
@cindex Customizing file omitting
@end table
-@node Omitting Examples, Omitting Technical, Omitting Variables, Omitting Files in Dired
+@node Omitting Examples
@section Examples of Omitting Various File Types
@itemize @bullet
@cindex Tib files, how to omit them in Dired
@cindex Omitting tib files in Dired
If you use @code{tib}, the bibliography program for use with @TeX{} and
-La@TeX{}, and you
+@LaTeX{}, and you
want to omit the @file{INDEX} and the @file{*-t.tex} files, then put
@example
@end itemize
-@node Omitting Technical, , Omitting Examples, Omitting Files in Dired
+@node Omitting Technical
@section Some Technical Details of Omitting
Loading @file{dired-x.el} will install Dired Omit by putting
call @code{dired-extra-startup}, which in turn calls @code{dired-omit-startup}
in your @code{dired-mode-hook}.
-@node Local Variables, Shell Command Guessing, Omitting Files in Dired, Top
+@node Local Variables
@chapter Local Variables for Dired Directories
@cindex Local Variables for Dired Directories
variable. A value of @code{nil} means to ignore any Dired Local Variables.
@end table
-@node Shell Command Guessing, Virtual Dired, Local Variables, Top
+@node Shell Command Guessing
@chapter Shell Command Guessing
@cindex Guessing shell commands for files.
History list for commands that read dired-shell commands.
@end table
-@node Virtual Dired, Advanced Mark Commands, Shell Command Guessing, Top
+@node Virtual Dired
@chapter Virtual Dired
@cindex Virtual Dired
The regexp is a bit more complicated than usual to exclude @file{.dired}
local-variable files.
-@node Advanced Mark Commands, Multiple Dired Directories, Virtual Dired, Top
+@node Advanced Mark Commands
@chapter Advanced Mark Commands
@table @kbd
@end menu
@end ifnottex
-@node Advanced Cleaning Functions, Advanced Cleaning Variables, , Advanced Mark Commands
+@node Advanced Cleaning Functions
@section Advanced Cleaning Functions
@table @code
@item dired-clean-tex
@findex dired-clean-tex
-Flag dispensable files created by @TeX{}, La@TeX{}, and @samp{texinfo} for
+Flag dispensable files created by @TeX{}, @LaTeX{}, and @samp{texinfo} for
deletion. See the following variables (@pxref{Advanced Cleaning Variables}):
@itemize @bullet
@item dired-very-clean-tex
@findex dired-very-clean-tex
-Flag dispensable files created by @TeX{}, La@TeX{}, @samp{texinfo},
+Flag dispensable files created by @TeX{}, @LaTeX{}, @samp{texinfo},
and @file{*.dvi} files for deletion.
@end table
-@node Advanced Cleaning Variables, Special Marking Function, Advanced Cleaning Functions, Advanced Mark Commands
+@node Advanced Cleaning Variables
@section Advanced Cleaning Variables
@noindent Variables used by the above cleaning commands (and in the default value for
@vindex dired-latex-unclean-extensions
Default: @code{(".idx" ".lof" ".lot" ".glo")}
-List of extensions of dispensable files created by La@TeX{}.
+List of extensions of dispensable files created by @LaTeX{}.
@item dired-bibtex-unclean-extensions
@vindex dired-bibtex-unclean-extensions
List of extensions of dispensable files created by Bib@TeX{}.
@end table
-@node Special Marking Function, , Advanced Cleaning Variables, Advanced Mark Commands
+@node Special Marking Function
@section Special Marking Function
@table @kbd
@end table
-@node Multiple Dired Directories, Find File At Point, Advanced Mark Commands, Top
+@node Multiple Dired Directories
@chapter Multiple Dired Directories and Non-Dired Commands
@cindex Multiple Dired directories
Dired buffers, is like @code{shell-command}, but it runs with
@code{default-directory} bound to the current Dired directory.
-@node Find File At Point, Miscellaneous Commands, Multiple Dired Directories, Top
-@section Find File At Point
+@node Find File At Point
+@chapter Find File At Point
@cindex Visiting a file mentioned in a buffer
@cindex Finding a file at point
@code{find-file-other-window}. See @xref{Optional Installation File At Point}.
@end table
-@node Miscellaneous Commands, Bugs, Find File At Point, Top
+@node Miscellaneous Commands
@chapter Miscellaneous Commands
Miscellaneous features not fitting anywhere else:
info.
@end table
-@node Bugs, GNU Free Documentation License, Miscellaneous Commands, Top
+@node Bugs
@chapter Bugs
@cindex Bugs
If you encounter a bug in this package, or wish to suggest an
enhancement, then please use @kbd{M-x report-emacs-bug} to report it.
-@node GNU Free Documentation License, Concept Index, Bugs, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
-@node Concept Index, Command Index, GNU Free Documentation License, Top
+@node Concept Index
@unnumbered Concept Index
@printindex cp
-@node Command Index, Key Index, Concept Index, Top
+@node Command Index
@unnumbered Function Index
@printindex fn
-@node Key Index, Variable Index, Command Index, Top
+@node Key Index
@unnumbered Key Index
@printindex ky
-@node Variable Index, , Key Index, Top
+@node Variable Index
@unnumbered Variable Index
@printindex vr
Compiler instantiations must also insert variables specifying the
compiler it plans to use, in addition to creating Automake settings for
-@file{configure.in} when appropriate.
+@file{configure.ac} when appropriate.
Compiler objects are stored in the target objects as a list of
symbols, where the symbols value is the object. This enables the
@deffn Method ede-proj-setup-buildenvironment :AFTER this &optional force
Setup the build environment for project @var{THIS}.
-Handles the Makefile, or a Makefile.am configure.in combination.
+Handles the Makefile, or a Makefile.am configure.ac combination.
Optional argument @var{FORCE} will force items to be regenerated.
@end deffn
@end deffn
@deffn Method ede-proj-configure-synchronize :AFTER this
-Synchronize what we know about project @var{THIS} into configure.in.
+Synchronize what we know about project @var{THIS} into configure.ac.
@end deffn
@deffn Method ede-proj-makefile-insert-variables-new :AFTER this
@end deffn
@deffn Method ede-proj-configure-file :AFTER this
-The configure.in script used by project @var{THIS}.
+The configure.ac script used by project @var{THIS}.
@end deffn
@deffn Method ede-commit-project :AFTER proj
@deffn Method ede-proj-setup-buildenvironment :AFTER this &optional force
Setup the build environment for project @var{THIS}.
-Handles the Makefile, or a Makefile.am configure.in combination.
+Handles the Makefile, or a Makefile.am configure.ac combination.
Optional argument @var{FORCE} will force items to be regenerated.
@end deffn
@chapter Long Example
The following example exploits most of the features of Forms mode.
-This example is included in the distribution as file @file{forms-d2.el}.
+This example is included in the distribution as file @file{etc/forms/forms-d2.el}.
@example
;; demo2 -- demo forms-mode -*- emacs-lisp -*-
;; @r{This sample forms exploit most of the features of forms mode.}
;; @r{Set the name of the data file.}
-(setq forms-file "forms-d2.dat")
+(setq forms-file
+ (expand-file-name "forms/forms-d2.dat" data-directory))
;; @r{Use @code{forms-enumerate} to set field names and number thereof.}
(setq forms-number-of-fields
The first thing you've got to do is to
create a suitable directory (no blanks in directory name
please) e.g. c:\myhome. Then you must set the environment
-variable HOME to this directory. To do this under Win9x
+variable HOME to this directory. To do this under Windows 9x
or Me include the line
@example
@syncodeindex vr cp
@syncodeindex pg cp
-@documentencoding ISO-8859-1
+@documentencoding UTF-8
@copying
Copyright @copyright{} 1995-2012 Free Software Foundation, Inc.
* Direct Functions:: Connecting directly to the server.
* Indirect Functions:: Connecting indirectly to the server.
* Common Variables:: Understood by several connection functions.
-* NNTP marks:: Storing marks for @acronym{NNTP} servers.
Getting Mail
* Formatting Variables:: You can specify what buffers should look like.
* Window Layout:: Configuring the Gnus buffer windows.
* Faces and Fonts:: How to change how faces look.
-* Compilation:: How to speed Gnus up.
* Mode Lines:: Displaying information in the mode lines.
* Highlighting and Menus:: Making buffers look all nice and cozy.
* Daemons:: Gnus can do things behind your back.
* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
-* No Gnus:: Very punny.
+* No Gnus:: Very punny. Gnus 5.12/5.13
+* Ma Gnus:: Celebrating 25 years of Gnus.
Customization
(setq gnus-secondary-select-methods '((nnmbox "")))
@end lisp
-Note: the @acronym{NNTP} back end stores marks in marks files
-(@pxref{NNTP marks}). This feature makes it easy to share marks between
-several Gnus installations, but may slow down things a bit when fetching
-new articles. @xref{NNTP marks}, for more information.
@node The Server is Down
generated, if @code{(gcc-self . "string")} is present, this string will
be inserted literally as a @code{gcc} header. This parameter takes
precedence over any default @code{Gcc} rules as described later
-(@pxref{Archived Messages}).
+(@pxref{Archived Messages}), with the exception for messages to resend.
@strong{Caveat}: Adding @code{(gcc-self . t)} to the parameter list of
@code{nntp} groups (or the like) isn't valid. An @code{nntp} server
@example
(posting-style
(name "Funky Name")
+ ("X-Message-SMTP-Method" "smtp smtp.example.org 587")
("X-My-Header" "Funky Value")
(signature "Funky Signature"))
@end example
named @code{file-name} (a certain coding system of which an alias is
@code{file-name}) in XEmacs.
-The @code{nnml} back end, the @code{nnrss} back end, the @acronym{NNTP}
-marks feature (@pxref{NNTP marks}), the agent, and the cache use
-non-@acronym{ASCII} group names in those files and directories. This
-variable overrides the value of @code{file-name-coding-system} which
-specifies the coding system used when encoding and decoding those file
-names and directory names.
+The @code{nnml} back end, the @code{nnrss} back end, the agent, and
+the cache use non-@acronym{ASCII} group names in those files and
+directories. This variable overrides the value of
+@code{file-name-coding-system} which specifies the coding system used
+when encoding and decoding those file names and directory names.
In XEmacs (with the @code{mule} feature), @code{file-name-coding-system}
is the only means to specify the coding system used to encode and decode
"")))
@end lisp
+To see what variables are dynamically bound (like
+@code{gnus-tmp-group}), you have to look at the source code. The
+variable names aren't guaranteed to be stable over Gnus versions,
+either.
+
@node File Commands
@subsection File Commands
@acronym{ASCII} equivalents (@code{gnus-article-treat-non-ascii}).
This is mostly useful if you're on a terminal that has a limited font
and doesn't show accented characters, ``advanced'' punctuation, and the
-like. For instance, @samp{»} is translated into @samp{>>}, and so on.
+like. For instance, @samp{»} is translated into @samp{>>}, and so on.
@item W Y f
@kindex W Y f (Summary)
Also @pxref{Group Parameters}.
-@vindex gnus-propagate-marks
-@item gnus-propagate-marks
-If non-@code{nil}, propagate marks to the backends for possible
-storing. @xref{NNTP marks}, and friends, for a more fine-grained
-sieve.
-
@end table
@xref{Mail Variables, ,Mail Variables,message,Message manual}, for more
information.
+
@node POP before SMTP
@section POP before SMTP
@cindex pop before smtp
-@findex message-smtpmail-send-it
@findex mail-source-touch-pop
-Does your @acronym{ISP} require the @acronym{POP}-before-@acronym{SMTP}
-authentication? It is whether you need to connect to the @acronym{POP}
-mail server within a certain time before sending mails. If so, there is
-a convenient way. To do that, put the following lines in your
-@file{~/.gnus.el} file:
+Does your @acronym{ISP} use @acronym{POP}-before-@acronym{SMTP}
+authentication? This authentication method simply requires you to
+contact the @acronym{POP} server before sending email. To do that,
+put the following lines in your @file{~/.gnus.el} file:
@lisp
-(setq message-send-mail-function 'message-smtpmail-send-it)
(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
@end lisp
@noindent
-It means to let Gnus connect to the @acronym{POP} mail server in advance
-whenever you send a mail. The @code{mail-source-touch-pop} function
-does only a @acronym{POP} authentication according to the value of
-@code{mail-sources} without fetching mails, just before sending a mail.
-Note that you have to use @code{message-smtpmail-send-it} which runs
-@code{message-send-mail-hook} rather than @code{smtpmail-send-it} and
-set the value of @code{mail-sources} for a @acronym{POP} connection
-correctly. @xref{Mail Sources}.
+The @code{mail-source-touch-pop} function does @acronym{POP}
+authentication according to the value of @code{mail-sources} without
+fetching mails, just before sending a mail. @xref{Mail Sources}.
If you have two or more @acronym{POP} mail servers set in
@code{mail-sources}, you may want to specify one of them to
(mail-source-touch-pop))))
@end lisp
+
@node Mail and Post
@section Mail and Post
non-@code{nil}, the behavior is the same as @code{all}, but it may be
changed in the future.
+@item gnus-gcc-self-resent-messages
+@vindex gnus-gcc-self-resent-messages
+Like the @code{gcc-self} group parameter, applied only for unmodified
+messages that @code{gnus-summary-resend-message} (@pxref{Summary Mail
+Commands}) resends. Non-@code{nil} value of this variable takes
+precedence over any existing @code{Gcc} header.
+
+If this is @code{none}, no @code{Gcc} copy will be made. If this is
+@code{t}, messages resent will be @code{Gcc} copied to the current
+group. If this is a string, it specifies a group to which resent
+messages will be @code{Gcc} copied. If this is @code{nil}, @code{Gcc}
+will be done according to existing @code{Gcc} header(s), if any. If
+this is @code{no-gcc-self}, that is the default, resent messages will be
+@code{Gcc} copied to groups that existing @code{Gcc} header specifies,
+except for the current group.
+
+@item gnus-gcc-pre-body-encode-hook
+@vindex gnus-gcc-pre-body-encode-hook
+@itemx gnus-gcc-post-body-encode-hook
+@vindex gnus-gcc-post-body-encode-hook
+
+These hooks are run before/after encoding the message body of the Gcc
+copy of a sent message. The current buffer (when the hook is run)
+contains the message including the message header. Changes made to
+the message will only affect the Gcc copy, but not the original
+message. You can use these hooks to edit the copy (and influence
+subsequent transformations), e.g. remove MML secure tags
+(@pxref{Signing and encrypting}).
+
@end table
(signature-file "~/.work-signature")
(address "user@@bar.foo")
(body "You are fired.\n\nSincerely, your boss.")
+ ("X-Message-SMTP-Method" "smtp smtp.example.org 587")
(organization "Important Work, Inc"))
("nnml:.*"
(From (with-current-buffer gnus-article-buffer
You may also use @code{message-alternative-emails} instead.
@xref{Message Headers, ,Message Headers, message, Message Manual}.
+Of particular interest in the ``work-mail'' style is the
+@samp{X-Message-SMTP-Method} header. It specifies how to send the
+outgoing email. You may want to sent certain emails through certain
+@acronym{SMTP} servers due to company policies, for instance.
+@xref{Mail Variables, ,Message Variables, message, Message Manual}.
+
+
@node Drafts
@section Drafts
@cindex drafts
* Direct Functions:: Connecting directly to the server.
* Indirect Functions:: Connecting indirectly to the server.
* Common Variables:: Understood by several connection functions.
-* NNTP marks:: Storing marks for @acronym{NNTP} servers.
@end menu
@end table
-@node NNTP marks
-@subsubsection NNTP marks
-@cindex storing NNTP marks
-
-Gnus stores marks (@pxref{Marking Articles}) for @acronym{NNTP}
-servers in marks files. A marks file records what marks you have set
-in a group and each file is specific to the corresponding server.
-Marks files are stored in @file{~/News/marks}
-(@code{nntp-marks-directory}) under a classic hierarchy resembling
-that of a news server, for example marks for the group
-@samp{gmane.discuss} on the news.gmane.org server will be stored in
-the file @file{~/News/marks/news.gmane.org/gmane/discuss/.marks}.
-
-Marks files are useful because you can copy the @file{~/News/marks}
-directory (using rsync, scp or whatever) to another Gnus installation,
-and it will realize what articles you have read and marked. The data
-in @file{~/News/marks} has priority over the same data in
-@file{~/.newsrc.eld}.
-
-Note that marks files are very much server-specific: Gnus remembers
-the article numbers so if you don't use the same servers on both
-installations things are most likely to break (most @acronym{NNTP}
-servers do not use the same article numbers as any other server).
-However, if you use servers A, B, C on one installation and servers A,
-D, E on the other, you can sync the marks files for A and then you'll
-get synchronization for that server between the two installations.
-
-Using @acronym{NNTP} marks can possibly incur a performance penalty so
-if Gnus feels sluggish, try setting the @code{nntp-marks-is-evil}
-variable to @code{t}. Marks will then be stored in @file{~/.newsrc.eld}.
-
-Related variables:
-
-@table @code
-
-@item nntp-marks-is-evil
-@vindex nntp-marks-is-evil
-If non-@code{nil}, this back end will ignore any marks files. The
-default is @code{nil}.
-
-@item nntp-marks-directory
-@vindex nntp-marks-directory
-The directory where marks for nntp groups will be stored.
-
-@end table
-
-
@node News Spool
@subsection News Spool
@cindex nnspool
@acronym{NOV} databases for the incoming mails. This makes it possibly the
fastest back end when it comes to reading mail.
-@cindex self contained nnml servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnml}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnml} server) and have all your marks be preserved. Marks
-for a group are usually stored in the @code{.marks} file (but see
-@code{nnml-marks-file-name}) within each @code{nnml} group's directory.
-Individual @code{nnml} groups are also possible to backup, use @kbd{G m}
-to restore the group (after restoring the backup into the nnml
-directory).
-
-If for some reason you believe your @file{.marks} files are screwed
-up, you can just delete them all. Gnus will then correctly regenerate
-them next time it starts.
-
Virtual server settings:
@table @code
@vindex nnml-prepare-save-mail-hook
Hook run narrowed to an article before saving.
-@item nnml-marks-is-evil
-@vindex nnml-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files. The
-default is @code{nil}.
-
-@item nnml-marks-file-name
-@vindex nnml-marks-file-name
-The name of the @dfn{marks} files. The default is @file{.marks}.
-
@item nnml-use-compressed-files
@vindex nnml-use-compressed-files
If non-@code{nil}, @code{nnml} will allow using compressed message
@code{nnfolder} will add extra headers to keep track of article
numbers and arrival dates.
-@cindex self contained nnfolder servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnfolder}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnfolder} server) and have all your marks be preserved.
-Marks for a group are usually stored in a file named as the mbox file
-with @code{.mrk} concatenated to it (but see
-@code{nnfolder-marks-file-suffix}) within the @code{nnfolder}
-directory. Individual @code{nnfolder} groups are also possible to
-backup, use @kbd{G m} to restore the group (after restoring the backup
-into the @code{nnfolder} directory).
-
Virtual server settings:
@table @code
The directory where the @acronym{NOV} files should be stored. If
@code{nil}, @code{nnfolder-directory} is used.
-@item nnfolder-marks-is-evil
-@vindex nnfolder-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files. The
-default is @code{nil}.
-
-@item nnfolder-marks-file-suffix
-@vindex nnfolder-marks-file-suffix
-The extension for @sc{marks} files. The default is @file{.mrk}.
-
-@item nnfolder-marks-directory
-@vindex nnfolder-marks-directory
-The directory where the @sc{marks} files should be stored. If
-@code{nil}, @code{nnfolder-directory} is used.
-
@end table
@code{nnmaildir} stores article marks for a given group in the
corresponding maildir, in a way designed so that it's easy to manipulate
them from outside Gnus. You can tar up a maildir, unpack it somewhere
-else, and still have your marks. @code{nnml} also stores marks, but
-it's not as easy to work with them from outside Gnus as with
-@code{nnmaildir}.
+else, and still have your marks.
@code{nnmaildir} uses a significant amount of memory to speed things up.
(It keeps in memory some of the things that @code{nnml} stores in files
might interfere with overwriting data, so you may want to shut down Gnus
before you restore the data.
-It is also possible to archive individual @code{nnml},
-@code{nnfolder}, or @code{nnmaildir} groups, while preserving marks.
-For @code{nnml} or @code{nnmaildir}, you copy all files in the group's
-directory. For @code{nnfolder} you need to copy both the base folder
-file itself (@file{FOO}, say), and the marks file (@file{FOO.mrk} in
-this example). Restoring the group is done with @kbd{G m} from the Group
-buffer. The last step makes Gnus notice the new directory.
-@code{nnmaildir} notices the new directory automatically, so @kbd{G m}
-is unnecessary in that case.
-
@node Web Searches
@subsection Web Searches
@cindex nnweb
@item !
@itemx not
-@itemx ¬
+@itemx ¬
This logical operator only takes a single argument. It returns the
logical negation of the value of its argument.
* Formatting Variables:: You can specify what buffers should look like.
* Window Layout:: Configuring the Gnus buffer windows.
* Faces and Fonts:: How to change how faces look.
-* Compilation:: How to speed Gnus up.
* Mode Lines:: Displaying information in the mode lines.
* Highlighting and Menus:: Making buffers look all nice and cozy.
* Daemons:: Gnus can do things behind your back.
Ignoring is done first; then cutting; then maxing; and then as the very
last operation, padding.
-If you use lots of these advanced thingies, you'll find that Gnus gets
-quite slow. This can be helped enormously by running @kbd{M-x
-gnus-compile} when you are satisfied with the look of your lines.
-@xref{Compilation}.
-
@node User-Defined Specs
@subsection User-Defined Specs
@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
@cindex %<<, %>>, guillemets
-@c @cindex %<<, %>>, %«, %», guillemets
+@c @cindex %<<, %>>, %«, %», guillemets
@vindex gnus-balloon-face-0
Text inside the @samp{%<<} and @samp{%>>} specifiers will get the
special @code{balloon-help} property set to
interface.
-@node Compilation
-@section Compilation
-@cindex compilation
-@cindex byte-compilation
-
-@findex gnus-compile
-
-Remember all those line format specification variables?
-@code{gnus-summary-line-format}, @code{gnus-group-line-format}, and so
-on. Now, Gnus will of course heed whatever these variables are, but,
-unfortunately, changing them will mean a quite significant slow-down.
-(The default values of these variables have byte-compiled functions
-associated with them, while the user-generated versions do not, of
-course.)
-
-To help with this, you can run @kbd{M-x gnus-compile} after you've
-fiddled around with the variables and feel that you're (kind of)
-satisfied. This will result in the new specs being byte-compiled, and
-you'll get top speed again. Gnus will save these compiled specs in the
-@file{.newsrc.eld} file. (User-defined functions aren't compiled by
-this function, though---you should compile them yourself by sticking
-them into the @file{~/.gnus.el} file and byte-compiling that file.)
-
-
@node Mode Lines
@section Mode Lines
@cindex mode lines
If @code{inline}, the textual representation is replaced. If
@code{right}, picons are added right to the textual representation.
+@vindex gnus-picon-properties
+The value of the variable @code{gnus-picon-properties} is a list of
+properties applied to picons.
+
The following variables offer control over where things are located.
@table @code
@cindex Pterodactyl Gnus
@cindex Oort Gnus
@cindex No Gnus
+@cindex Ma Gnus
@cindex Gnus versions
The first ``proper'' release of Gnus 5 was done in November 1995 when it
http://git.gnus.org for details (http://www.gnus.org will be updated
with the information when possible).
+On the January 31th 2012, Ma Gnus was begun.
+
If you happen upon a version of Gnus that has a prefixed name --
``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'',
-``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'' -- don't panic.
-Don't let it know that you're frightened. Back away. Slowly. Whatever
-you do, don't run. Walk away, calmly, until you're out of its reach.
-Find a proper released version of Gnus and snuggle up to that instead.
+``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'', ``Ma Gnus'' -- don't
+panic. Don't let it know that you're frightened. Back away. Slowly.
+Whatever you do, don't run. Walk away, calmly, until you're out of
+its reach. Find a proper released version of Gnus and snuggle up to
+that instead.
@node Why?
* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
-* No Gnus:: Very punny.
+* No Gnus:: Very punny. Gnus 5.12/5.13.
+* Ma Gnus:: Celebrating 25 years of Gnus.
@end menu
These lists are, of course, just @emph{short} overviews of the
@include gnus-news.texi
+@node Ma Gnus
+@subsubsection Ma Gnus
+@cindex Ma Gnus
+
+I'm sure there will be lots of text here. It's really spelled 真
+Gnus.
+
+New features in Ma Gnus:
+
+@itemize @bullet
+
+@item Changes in Message mode and related Gnus features
+@c ****************************************************
+
+@itemize @bullet
+
+@item
+The new hooks @code{gnus-gcc-pre-body-encode-hook} and
+@code{gnus-gcc-post-body-encode-hook} are run before/after encoding
+the message body of the Gcc copy of a sent message. See
+@xref{Archived Messages}.
+
+@end itemize
+
+@end itemize
+
@iftex
@page
@lisp
(("summary"
- ("win95" -10000 nil s)
+ ("Windows 95" -10000 nil s)
("Gnus"))
("from"
("Lars" -1000))
@c Local Variables:
@c mode: texinfo
-@c coding: iso-8859-1
+@c coding: utf-8
@c End:
* Getting Started:: Tutorial
* The IDLWAVE Major Mode:: The mode for editing IDL programs
* The IDLWAVE Shell:: The mode for running IDL as an inferior program
-* Acknowledgements:: Who did what
+* Acknowledgments:: Who did what
* Sources of Routine Info:: How does IDLWAVE know about routine XYZ
* HTML Help Browser Tips::
* Configuration Examples:: The user is king
Normal hook. Executed when @file{idlwave.el} is loaded.
@end defopt
-@node The IDLWAVE Shell, Acknowledgements, The IDLWAVE Major Mode, Top
+@node The IDLWAVE Shell, Acknowledgments, The IDLWAVE Major Mode, Top
@chapter The IDLWAVE Shell
@cindex IDLWAVE shell
@cindex Major mode, @code{idlwave-shell-mode}
(three underscores) are replaced by the indicated expression.
@end defopt
-@node Acknowledgements, Sources of Routine Info, The IDLWAVE Shell, Top
-@chapter Acknowledgements
-@cindex Acknowledgements
+@node Acknowledgments, Sources of Routine Info, The IDLWAVE Shell, Top
+@chapter Acknowledgments
+@cindex Acknowledgments
@cindex Maintainer, of IDLWAVE
@cindex Authors, of IDLWAVE
@cindex Contributors, to IDLWAVE
@noindent
Thanks to everyone!
-@node Sources of Routine Info, HTML Help Browser Tips, Acknowledgements, Top
+@node Sources of Routine Info, HTML Help Browser Tips, Acknowledgments, Top
@appendix Sources of Routine Info
@cindex Sources of routine information
@end example
@html
-<A NAME="WIN_MAC"></A>
+<A NAME="WINDOWS_MAC"></A>
@end html
@node Windows and MacOS, Troubleshooting, Configuration Examples, Top
@appendix Windows and MacOS
#### -*- Makefile -*- for documentation other than the Emacs manual.
-# Copyright (C) 2003-2012 Free Software Foundation, Inc.
+# Copyright (C) 2003-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
## Currently only used by efaq; could be added to MAKEINFO.
emacsdir = $(srcdir)/../emacs
+INFO_EXT=.info
+INFO_OPTS=--no-split
+
# The makeinfo program is part of the Texinfo distribution.
MAKEINFO = makeinfo
MAKEINFO_OPTS = --force -I$(emacsdir)
MULTI_INSTALL_INFO = $(srcdir)\..\..\nt\multi-install-info.bat
-INFO_TARGETS = $(infodir)/ccmode \
- $(infodir)/cl $(infodir)/dbus $(infodir)/dired-x \
- $(infodir)/ediff $(infodir)/forms $(infodir)/gnus \
- $(infodir)/message $(infodir)/sieve $(infodir)/pgg \
- $(infodir)/emacs-mime $(infodir)/info $(infodir)/mh-e \
- $(infodir)/reftex $(infodir)/sc $(infodir)/vip \
- $(infodir)/viper $(infodir)/widget $(infodir)/efaq \
- $(infodir)/ada-mode $(infodir)/autotype $(infodir)/calc \
- $(infodir)/idlwave $(infodir)/eudc $(infodir)/ebrowse \
- $(infodir)/pcl-cvs $(infodir)/woman $(infodir)/eshell \
- $(infodir)/org $(infodir)/url $(infodir)/speedbar \
- $(infodir)/tramp $(infodir)/ses $(infodir)/smtpmail \
- $(infodir)/flymake $(infodir)/newsticker $(infodir)/rcirc \
- $(infodir)/erc $(infodir)/ert \
- $(infodir)/remember $(infodir)/nxml-mode \
- $(infodir)/epa $(infodir)/mairix-el $(infodir)/sasl \
- $(infodir)/auth $(infodir)/eieio $(infodir)/ede \
- $(infodir)/semantic $(infodir)/edt $(infodir)/emacs-gnutls
+INFO_TARGETS = $(infodir)/ccmode$(INFO_EXT) \
+ $(infodir)/cl$(INFO_EXT) $(infodir)/dbus$(INFO_EXT) $(infodir)/dired-x$(INFO_EXT) \
+ $(infodir)/ediff$(INFO_EXT) $(infodir)/forms$(INFO_EXT) $(infodir)/gnus$(INFO_EXT) \
+ $(infodir)/message$(INFO_EXT) $(infodir)/sieve$(INFO_EXT) $(infodir)/pgg$(INFO_EXT) \
+ $(infodir)/emacs-mime$(INFO_EXT) $(infodir)/info$(INFO_EXT) $(infodir)/mh-e$(INFO_EXT) \
+ $(infodir)/reftex$(INFO_EXT) $(infodir)/sc$(INFO_EXT) $(infodir)/vip$(INFO_EXT) \
+ $(infodir)/viper$(INFO_EXT) $(infodir)/widget$(INFO_EXT) $(infodir)/efaq$(INFO_EXT) \
+ $(infodir)/ada-mode$(INFO_EXT) $(infodir)/autotype$(INFO_EXT) $(infodir)/calc$(INFO_EXT) \
+ $(infodir)/idlwave$(INFO_EXT) $(infodir)/eudc$(INFO_EXT) $(infodir)/ebrowse$(INFO_EXT) \
+ $(infodir)/pcl-cvs$(INFO_EXT) $(infodir)/woman$(INFO_EXT) $(infodir)/eshell$(INFO_EXT) \
+ $(infodir)/org$(INFO_EXT) $(infodir)/url$(INFO_EXT) $(infodir)/speedbar$(INFO_EXT) \
+ $(infodir)/tramp$(INFO_EXT) $(infodir)/ses$(INFO_EXT) $(infodir)/smtpmail$(INFO_EXT) \
+ $(infodir)/flymake$(INFO_EXT) $(infodir)/newsticker$(INFO_EXT) $(infodir)/rcirc$(INFO_EXT) \
+ $(infodir)/erc$(INFO_EXT) $(infodir)/ert$(INFO_EXT) \
+ $(infodir)/remember$(INFO_EXT) $(infodir)/nxml-mode$(INFO_EXT) \
+ $(infodir)/epa$(INFO_EXT) $(infodir)/mairix-el$(INFO_EXT) $(infodir)/sasl$(INFO_EXT) \
+ $(infodir)/auth$(INFO_EXT) $(infodir)/eieio$(INFO_EXT) $(infodir)/ede$(INFO_EXT) \
+ $(infodir)/semantic$(INFO_EXT) $(infodir)/edt$(INFO_EXT) $(infodir)/emacs-gnutls$(INFO_EXT)
DVI_TARGETS = calc.dvi cc-mode.dvi cl.dvi dbus.dvi dired-x.dvi \
ediff.dvi forms.dvi gnus.dvi message.dvi emacs-mime.dvi \
sieve.dvi pgg.dvi mh-e.dvi \
# Some Windows ports of makeinfo seem to require -o to come before the
# texi filename, contrary to GNU standards.
-$(infodir)/info: $(INFOSOURCES)
- $(MAKEINFO) $(MAKEINFO_OPTS) --no-split -o $@ info.texi
+$(infodir)/info$(INFO_EXT): $(INFOSOURCES)
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ info.texi
info.dvi: $(INFOSOURCES)
$(ENVADD) $(TEXI2DVI) $(srcdir)/info.texi
-$(infodir)/ccmode: cc-mode.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) cc-mode.texi
+$(infodir)/ccmode$(INFO_EXT): cc-mode.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ cc-mode.texi
cc-mode.dvi: cc-mode.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/cc-mode.texi
-$(infodir)/ada-mode: ada-mode.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ada-mode.texi
+$(infodir)/ada-mode$(INFO_EXT): ada-mode.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ada-mode.texi
ada-mode.dvi: ada-mode.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ada-mode.texi
-$(infodir)/pcl-cvs: pcl-cvs.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) pcl-cvs.texi
+$(infodir)/pcl-cvs$(INFO_EXT): pcl-cvs.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ pcl-cvs.texi
pcl-cvs.dvi: pcl-cvs.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/pcl-cvs.texi
-$(infodir)/eshell: eshell.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) eshell.texi
+$(infodir)/eshell$(INFO_EXT): eshell.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ eshell.texi
eshell.dvi: eshell.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/eshell.texi
-$(infodir)/cl: cl.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) cl.texi
+$(infodir)/cl$(INFO_EXT): cl.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ cl.texi
cl.dvi: cl.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/cl.texi
-$(infodir)/dbus: dbus.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) dbus.texi
+$(infodir)/dbus$(INFO_EXT): dbus.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ dbus.texi
dbus.dvi: dbus.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/dbus.texi
-$(infodir)/dired-x: dired-x.texi $(emacsdir)/emacsver.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) dired-x.texi
+$(infodir)/dired-x$(INFO_EXT): dired-x.texi $(emacsdir)/emacsver.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ dired-x.texi
dired-x.dvi: dired-x.texi $(emacsdir)/emacsver.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/dired-x.texi
-$(infodir)/ediff: ediff.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ediff.texi
+$(infodir)/ediff$(INFO_EXT): ediff.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ediff.texi
ediff.dvi: ediff.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ediff.texi
-$(infodir)/flymake: flymake.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) flymake.texi
+$(infodir)/flymake$(INFO_EXT): flymake.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ flymake.texi
flymake.dvi: flymake.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/flymake.texi
-$(infodir)/forms: forms.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) forms.texi
+$(infodir)/forms$(INFO_EXT): forms.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ forms.texi
forms.dvi: forms.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/forms.texi
# gnus/message/emacs-mime/sieve/pgg are part of Gnus:
-$(infodir)/gnus: gnus.texi gnus-overrides.texi message.texi emacs-mime.texi \
+$(infodir)/gnus$(INFO_EXT): gnus.texi gnus-overrides.texi message.texi emacs-mime.texi \
sieve.texi pgg.texi sasl.texi gnus-news.texi gnus-faq.texi \
doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) gnus.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ gnus.texi
gnus.dvi: gnus.texi gnus-overrides.texi message.texi emacs-mime.texi \
sieve.texi pgg.texi sasl.texi gnus-news.texi gnus-faq.texi \
doclicense.texi
cp gnustmp.dvi $*.dvi
rm gnustmp.*
#
-$(infodir)/message: message.texi gnus-overrides.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) message.texi
+$(infodir)/message$(INFO_EXT): message.texi gnus-overrides.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ message.texi
message.dvi: message.texi gnus-overrides.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/message.texi
#
-$(infodir)/emacs-mime: emacs-mime.texi gnus-overrides.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) --enable-encoding emacs-mime.texi
+$(infodir)/emacs-mime$(INFO_EXT): emacs-mime.texi gnus-overrides.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ --enable-encoding emacs-mime.texi
emacs-mime.dvi: emacs-mime.texi gnus-overrides.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-mime.texi
#
-$(infodir)/sieve: sieve.texi gnus-overrides.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) sieve.texi
+$(infodir)/sieve$(INFO_EXT): sieve.texi gnus-overrides.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ sieve.texi
sieve.dvi: sieve.texi gnus-overrides.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/sieve.texi
#
-$(infodir)/pgg: pgg.texi gnus-overrides.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) pgg.texi
+$(infodir)/pgg$(INFO_EXT): pgg.texi gnus-overrides.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ pgg.texi
pgg.dvi: pgg.texi gnus-overrides.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/pgg.texi
-$(infodir)/mh-e: mh-e.texi doclicense.texi gpl.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) mh-e.texi
+$(infodir)/mh-e$(INFO_EXT): mh-e.texi doclicense.texi gpl.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ mh-e.texi
mh-e.dvi: mh-e.texi doclicense.texi gpl.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/mh-e.texi
-$(infodir)/reftex: reftex.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) reftex.texi
+$(infodir)/reftex$(INFO_EXT): reftex.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ reftex.texi
reftex.dvi: reftex.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/reftex.texi
-$(infodir)/remember: remember.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) remember.texi
+$(infodir)/remember$(INFO_EXT): remember.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ remember.texi
remember.dvi: remember.texi doclicense.texix
$(ENVADD) $(TEXI2DVI) $(srcdir)/remember.texi
-$(infodir)/sasl: sasl.texi gnus-overrides.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) sasl.texi
+$(infodir)/sasl$(INFO_EXT): sasl.texi gnus-overrides.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ sasl.texi
sasl.dvi: sasl.texi gnus-overrides.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/sasl.texi
-$(infodir)/sc: sc.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) sc.texi
+$(infodir)/sc$(INFO_EXT): sc.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ sc.texi
sc.dvi: sc.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/sc.texi
-$(infodir)/vip: vip.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) vip.texi
+$(infodir)/vip$(INFO_EXT): vip.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ vip.texi
vip.dvi: vip.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/vip.texi
-$(infodir)/viper: viper.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) viper.texi
+$(infodir)/viper$(INFO_EXT): viper.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ viper.texi
viper.dvi: viper.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/viper.texi
-$(infodir)/widget: widget.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) widget.texi
+$(infodir)/widget$(INFO_EXT): widget.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ widget.texi
widget.dvi: widget.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/widget.texi
-$(infodir)/efaq: faq.texi $(emacsdir)/emacsver.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) faq.texi
+$(infodir)/efaq$(INFO_EXT): faq.texi $(emacsdir)/emacsver.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ faq.texi
faq.dvi: faq.texi $(emacsdir)/emacsver.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/faq.texi
-$(infodir)/autotype: autotype.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) autotype.texi
+$(infodir)/autotype$(INFO_EXT): autotype.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ autotype.texi
autotype.dvi: autotype.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/autotype.texi
-$(infodir)/calc: calc.texi $(emacsdir)/emacsver.texi gpl.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) calc.texi
+$(infodir)/calc$(INFO_EXT): calc.texi $(emacsdir)/emacsver.texi gpl.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ calc.texi
calc.dvi: calc.texi $(emacsdir)/emacsver.texi gpl.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/calc.texi
# This is produced with --no-split to avoid making files whose
# names clash on DOS 8+3 filesystems
-$(infodir)/idlwave: idlwave.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) --no-split idlwave.texi
+$(infodir)/idlwave$(INFO_EXT): idlwave.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ idlwave.texi
idlwave.dvi: idlwave.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/idlwave.texi
-$(infodir)/eudc: eudc.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) eudc.texi
+$(infodir)/eudc$(INFO_EXT): eudc.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ eudc.texi
eudc.dvi: eudc.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/eudc.texi
-$(infodir)/ebrowse: ebrowse.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ebrowse.texi
+$(infodir)/ebrowse$(INFO_EXT): ebrowse.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ebrowse.texi
ebrowse.dvi: ebrowse.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ebrowse.texi
-$(infodir)/woman: woman.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) woman.texi
+$(infodir)/woman$(INFO_EXT): woman.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ woman.texi
woman.dvi: woman.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/woman.texi
-$(infodir)/speedbar: speedbar.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) speedbar.texi
+$(infodir)/speedbar$(INFO_EXT): speedbar.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ speedbar.texi
speedbar.dvi: speedbar.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/speedbar.texi
-$(infodir)/tramp: tramp.texi trampver.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) tramp.texi
+$(infodir)/tramp$(INFO_EXT): tramp.texi trampver.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ tramp.texi
tramp.dvi: tramp.texi trampver.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/tramp.texi
-$(infodir)/ses: ses.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ses.texi
+$(infodir)/ses$(INFO_EXT): ses.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ses.texi
ses.dvi: ses.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ses.texi
-$(infodir)/smtpmail: smtpmail.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) smtpmail.texi
+$(infodir)/smtpmail$(INFO_EXT): smtpmail.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ smtpmail.texi
smtpmail.dvi: smtpmail.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/smtpmail.texi
-$(infodir)/org: org.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) org.texi
+$(infodir)/org$(INFO_EXT): org.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ org.texi
org.dvi: org.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/org.texi
-$(infodir)/url: url.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) url.texi
+$(infodir)/url$(INFO_EXT): url.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ url.texi
url.dvi: url.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/url.texi
-$(infodir)/newsticker: newsticker.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) newsticker.texi
+$(infodir)/newsticker$(INFO_EXT): newsticker.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ newsticker.texi
newsticker.dvi: newsticker.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/newsticker.texi
-$(infodir)/nxml-mode: nxml-mode.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) nxml-mode.texi
+$(infodir)/nxml-mode$(INFO_EXT): nxml-mode.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ nxml-mode.texi
nxml-mod.dvi: nxml-mode.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/nxml-mode.texi
-$(infodir)/rcirc: rcirc.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) rcirc.texi
+$(infodir)/rcirc$(INFO_EXT): rcirc.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ rcirc.texi
rcirc.dvi: rcirc.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/rcirc.texi
-$(infodir)/erc: erc.texi gpl.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) erc.texi
+$(infodir)/erc$(INFO_EXT): erc.texi gpl.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ erc.texi
erc.dvi: erc.texi gpl.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/erc.texi
-$(infodir)/ert: ert.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ert.texi
+$(infodir)/ert$(INFO_EXT): ert.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ert.texi
ert.dvi: ert.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ert.texi
-$(infodir)/epa: epa.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) epa.texi
+$(infodir)/epa$(INFO_EXT): epa.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ epa.texi
epa.dvi: epa.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/epa.texi
-$(infodir)/mairix-el: mairix-el.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) mairix-el.texi
+$(infodir)/mairix-el$(INFO_EXT): mairix-el.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ mairix-el.texi
mairix-el.dvi: mairix-el.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/mairix-el.texi
-$(infodir)/auth: auth.texi gnus-overrides.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) auth.texi
+$(infodir)/auth$(INFO_EXT): auth.texi gnus-overrides.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ auth.texi
auth.dvi: auth.texi gnus-overrides.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/auth.texi
-$(infodir)/eieio: eieio.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) eieio.texi
+$(infodir)/eieio$(INFO_EXT): eieio.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ eieio.texi
eieio.dvi: eieio.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/eieio.texi
-$(infodir)/ede: ede.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) ede.texi
+$(infodir)/ede$(INFO_EXT): ede.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ede.texi
ede.dvi: ede.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/ede.texi
-$(infodir)/semantic: semantic.texi sem-user.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) semantic.texi
+$(infodir)/semantic$(INFO_EXT): semantic.texi sem-user.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ semantic.texi
semantic.dvi: semantic.texi sem-user.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/semantic.texi
-$(infodir)/edt: edt.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) edt.texi
+$(infodir)/edt$(INFO_EXT): edt.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ edt.texi
edt.dvi: edt.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/edt.texi
-$(infodir)/emacs-gnutls: emacs-gnutls.texi doclicense.texi
- $(MAKEINFO) $(MAKEINFO_OPTS) emacs-gnutls.texi
+$(infodir)/emacs-gnutls$(INFO_EXT): emacs-gnutls.texi doclicense.texi
+ $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ emacs-gnutls.texi
emacs-gnutls.dvi: emacs-gnutls.texi doclicense.texi
$(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-gnutls.texi
requires the @acronym{POP}-before-@acronym{SMTP} authentication.
@xref{POP before SMTP, , POP before SMTP, gnus, The Gnus Manual}.
+@cindex X-Message-SMTP-Method
+If you have a complex @acronym{SMTP} setup, and want some messages to
+go via one mail server, and other messages to go through another, you
+can use the @samp{X-Message-SMTP-Method} header. These are the
+supported values:
+
+@table @samp
+@item smtpmail
+
+@example
+X-Message-SMTP-Method: smtp smtp.fsf.org 587
+@end example
+
+This will send the message via @samp{smtp.fsf.org}, using port 587.
+
+@example
+X-Message-SMTP-Method: smtp smtp.fsf.org 587 other-user
+@end example
+
+This is the same as the above, but uses @samp{other-user} as the user
+name when authenticating. This is handy if you have several
+@acronym{SMTP} accounts on the same server.
+
+@item sendmail
+
+@example
+X-Message-SMTP-Method: sendmail
+@end example
+
+This will send the message via the locally installed sendmail/exim/etc
+installation.
+
+@end table
+
@item message-mh-deletable-headers
@vindex message-mh-deletable-headers
Most versions of MH doesn't like being fed messages that contain the
MAILDIR=$HOME/`mhparam Path`
#
-# Filter messages with win32 executables/virii.
+# Filter messages with w32 executables/virii.
#
# These attachments are base64 and have a TVqQAAMAAAAEAAAA//8AALg
# pattern. The string "this program cannot be run in MS-DOS mode"
@c Local Variables:
@c sentence-end-double-space: nil
@c End:
-
-
@contents
@ifnottex
-@node Top, Introduction, (dir), (dir)
+@node Top
@top Supercite
-@comment node-name, next, previous, up
@insertcopying
@menu
* Introduction::
* Citations::
+* Information Keys and the Info Alist::
+* Reference Headers::
* Getting Connected::
* Replying and Yanking::
* Selecting an Attribution::
* Configuring the Citation Engine::
* Post-yank Formatting Commands::
-* Information Keys and the Info Alist::
-* Reference Headers::
* Hints to MUA Authors::
* Thanks and History::
@end ifnottex
-@node Introduction, Usage Overview, Top, Top
+@node Introduction
@chapter Introduction
Supercite is a GNU Emacs package written entirely in Emacs Lisp. It
sent. Supercite is re-initialized in each new reply buffer.
-@node Usage Overview, What Supercite Does Not Do, Introduction, Introduction
+@node Usage Overview
+@section Usage Overview
@kindex r
@kindex f
@kindex C-c C-y
@cindex yank
@cindex cite, citing
@cindex attribute, attributing
-@section Usage Overview
Typical usage is as follows. You want to reply or followup to a message
in your MUA. You will probably hit @kbd{r} (i.e., ``reply'') or @kbd{f}
using Supercite you gain a wider flexibility in the look and style of
citations. Supercite's only job is to cite the original message.
-@node What Supercite Does Not Do, What Supercite Does, Usage Overview, Introduction
+@node What Supercite Does Not Do
@section What Supercite Doesn't Do
Because of this clear division of labor, there are useful features which
outside the designated region. @xref{Hints to MUA Authors}, for more
details.@refill
-@node What Supercite Does, Citations, What Supercite Does Not Do, Introduction
-@findex sc-cite-original
+@node What Supercite Does
@section What Supercite Does
+@findex sc-cite-original
Supercite is invoked for the first time on a reply buffer via your MUA's
reply or forward command. This command will actually perform citations
it has been properly connected to your MUA. @xref{Getting Connected},
for more details.@refill
-@node Citations, Citation Elements, What Supercite Does, Top
+@node Citations
+@chapter Citations
@cindex nested citations
@cindex citation
-@chapter Citations
-A @dfn{citation} is the acknowledgement of the original author of a mail
+A @dfn{citation} is the acknowledgment of the original author of a mail
message in the body of the reply. There are two basic citation styles
which Supercite supports. The first, called @dfn{nested citations} is
an anonymous form of citation; in other words, an indication is made
are used.
-@node Citation Elements, Recognizing Citations, Citations, Citations
-@cindex citation string
+@node Citation Elements
@section Citation Elements
+@cindex citation string
@dfn{Citation strings} are composed of one or more elements. Non-nested
citations are composed of four elements, three of which are directly
enough to not put additional spaces between citation delimiters for
multi-level nested citations.
-@node Recognizing Citations, Getting Connected, Citation Elements, Citations
+@node Recognizing Citations
@section Recognizing Citations
Supercite also recognizes citations in the original article, and can
change @code{sc-citation-root-regexp} you should always also change
@code{sc-citation-nonnested-root-regexp}.@refill
-@node Information Keys and the Info Alist, Reference Headers, Miscellaneous Commands, Top
+@node Information Keys and the Info Alist
+@chapter Information Keys and the Info Alist
@cindex information keys
@cindex Info Alist
@cindex information extracted from mail fields
@findex sc-mail-field
@findex mail-field (sc-)
-@chapter Information Keys and the Info Alist
@dfn{Mail header information keys} are nuggets of information that
Supercite extracts from the various mail headers of the original
info keys with the appropriate index (e.g., @code{"sc-middlename-2"},
@dots{}). @xref{Selecting an Attribution}.@refill
-@node Reference Headers, The Built-in Header Rewrite Functions, Information Keys and the Info Alist, Top
-@cindex reference headers
+@node Reference Headers
@chapter Reference Headers
+@cindex reference headers
Supercite will insert an informative @dfn{reference header} at the
beginning of the cited body of text, which display more detail about the
integer which is an index into the @code{sc-rewrite-header-list},
beginning at zero.
-@node The Built-in Header Rewrite Functions, Electric References, Reference Headers, Reference Headers
-@cindex header rewrite functions, built-in
+@node The Built-in Header Rewrite Functions
@section The Built-in Header Rewrite Functions
+@cindex header rewrite functions, built-in
Below are examples of the various built-in header rewrite functions.
Please note the following:@: first, the text which appears in the
@code{>>>>> see @var{references} for more details}
@end table
-@node Electric References, Hints to MUA Authors, The Built-in Header Rewrite Functions, Reference Headers
-@cindex electric references
+@node Electric References
@section Electric References
+@cindex electric references
By default, when Supercite cites the original message for the first
time, it just goes ahead and inserts the reference header indexed by
Supercite will execute the hook @code{sc-electric-mode-hook} before
entering electric reference mode.
-@node Getting Connected, Replying and Yanking, Recognizing Citations, Top
-@cindex citation interface specification
+@node Getting Connected
@chapter Getting Connected
-
+@cindex citation interface specification
@vindex mail-citation-hook
@cindex .emacs file
get executed every time @code{sc-cite-original} is called. @xref{Reply
Buffer Initialization}.@refill
-@node Replying and Yanking, Reply Buffer Initialization, Getting Connected, Top
+@node Replying and Yanking
@chapter Replying and Yanking
This chapter explains what happens when you reply and yank an original
* Filling Cited Text::
@end menu
-@node Reply Buffer Initialization, Filling Cited Text, Replying and Yanking, Replying and Yanking
+@node Reply Buffer Initialization
+@section Reply Buffer Initialization
@findex sc-cite-original
@findex cite-original (sc-)
-@section Reply Buffer Initialization
Executing @code{sc-cite-original} performs the following steps as it
initializes the reply buffer:
reset certain variables set in @code{sc-pre-hook}.@refill
@end enumerate
-@node Filling Cited Text, Selecting an Attribution, Reply Buffer Initialization, Replying and Yanking
+@node Filling Cited Text
+@section Filling Cited Text
@cindex filling paragraphs
@vindex sc-auto-fill-region-p
@vindex auto-fill-region-p (sc-)
@findex setup-filladapt (sc-)
@vindex sc-load-hook
@vindex load-hook (sc-)
-@section Filling Cited Text
Supercite will automatically fill newly cited text from the original
message unless the variable @code{sc-auto-fill-region-p} has a
containing lines greater than about 72 characters. So the default is to
fill cited text.
-@node Selecting an Attribution, Attribution Preferences, Filling Cited Text, Top
+@node Selecting an Attribution
+@chapter Selecting an Attribution
@cindex attribution list
@vindex sc-preferred-attribution-list
@vindex preferred-attribution-list (sc-)
-@chapter Selecting an Attribution
As you know, the attribution string is the part of the author's name
that will be used to composed a non-nested citation string. Supercite
* Author Names::
@end menu
-@node Attribution Preferences, Anonymous Attributions, Selecting an Attribution, Selecting an Attribution
+@node Attribution Preferences
@section Attribution Preferences
When you cite an original message, you can tell Supercite which part of
match against a specific mail field, e.g., @samp{From:@:}, allowing you
to cite your friend's message with the appropriate attribution.
-@node Anonymous Attributions, Author Names, Attribution Preferences, Selecting an Attribution
+@node Anonymous Attributions
+@section Anonymous Attributions
@vindex sc-default-author-name
@vindex default-author-name (sc-)
@vindex sc-default-attribution
@vindex default-attribution (sc-)
-@section Anonymous Attributions
When the author's name cannot be found in the @samp{From:@:} mail
header, a fallback author name and attribution string must be supplied.
one character long; e.g. you prefer to use @code{"initials"} but the
author only has one name.@refill
-@node Author Names, Configuring the Citation Engine, Anonymous Attributions, Selecting an Attribution
-@cindex author names
+@node Author Names
@section Author Names
+@cindex author names
Supercite employs a number of heuristics to decipher the author's name
based on value of the @samp{From:@:} mail field of the original message.
word in the name field, while @code{any} matches against every word in
the name field.
-@node Configuring the Citation Engine, Using Regi, Author Names, Top
+@node Configuring the Citation Engine
+@chapter Configuring the Citation Engine
@cindex Regi
@cindex frames (Regi)
@cindex entries (Regi)
-@chapter Configuring the Citation Engine
At the heart of Supercite is a regular expression interpreting engine
called @dfn{Regi}. Regi operates by interpreting a data structure
cite or fill those differently than normal text. None of this is
currently part of Supercite, but contributions are welcome!
-@node Using Regi, Frames You Can Customize, Configuring the Citation Engine, Configuring the Citation Engine
+@node Using Regi
+@section Using Regi
@findex regi-interpret
@findex eval
@findex looking-at
-@section Using Regi
Regi works by interpreting frames with the function
@code{regi-interpret}. A frame is a list of arbitrary size where each
The current frame entry being interpreted.
@end table
-@node Frames You Can Customize, Post-yank Formatting Commands, Using Regi, Configuring the Citation Engine
-@vindex sc-nuke-mail-header
+@node Frames You Can Customize
@section Frames You Can Customize
+@vindex sc-nuke-mail-header
As mentioned earlier, Supercite uses various frames to perform
certain jobs such as mail header information extraction and mail header
the appropriate alist and attempts to find a frame to use. If one
is not found from the alist, then the appropriate default frame is used.
-@node Post-yank Formatting Commands, Citing Commands, Frames You Can Customize, Top
+@node Post-yank Formatting Commands
+@chapter Post-yank Formatting Commands
@vindex sc-mode-map-prefix
@vindex mode-map-prefix (sc-)
@kindex C-c C-p
-@chapter Post-yank Formatting Commands
Once the original message has been yanked into the reply buffer, and
@code{sc-cite-original} has had a chance to do its thing, a number of
* Miscellaneous Commands::
@end menu
-@node Citing Commands, Insertion Commands, Post-yank Formatting Commands, Post-yank Formatting Commands
-@vindex sc-cite-region-limit
+@node Citing Commands
@section Commands to Manually Cite, Recite, and Uncite
+@vindex sc-cite-region-limit
Probably the three most common post-yank formatting operations that you
will perform will be the manual citing, reciting, and unciting of
region, regardless of the value of @code{sc-confirm-always-p}.
@end table
-@node Insertion Commands, Variable Toggling Shortcuts, Citing Commands, Post-yank Formatting Commands
+@node Insertion Commands
@section Insertion Commands
These two functions insert various strings into the reply buffer.
an error and will not cite the line.
@end table
-@node Variable Toggling Shortcuts, Mail Field Commands, Insertion Commands, Post-yank Formatting Commands
-@cindex toggling variables
+@node Variable Toggling Shortcuts
@section Variable Toggling Shortcuts
+@cindex toggling variables
Supercite defines a number of commands that make it easier for you to
toggle and set various Supercite variables as you are editing the reply
brings up a Help message on the toggling keymap.
-@node Mail Field Commands, Miscellaneous Commands, Variable Toggling Shortcuts, Post-yank Formatting Commands
+@node Mail Field Commands
@section Mail Field Commands
These commands allow you to view, modify, add, and delete various bits
old information is lost.@refill
@end table
-@node Miscellaneous Commands, Information Keys and the Info Alist, Mail Field Commands, Post-yank Formatting Commands
+@node Miscellaneous Commands
@section Miscellaneous Commands
@table @asis
an optional numeric argument inserts that many new lines.@refill
@end table
-@node Hints to MUA Authors, Thanks and History, Electric References, Top
+@node Hints to MUA Authors
@chapter Hints to MUA Authors
In June of 1989, some discussion was held between the various MUA
If you do all this your MUA will join the ranks of those that conform to
this interface ``out of the box.''
-@node Thanks and History, GNU Free Documentation License, Hints to MUA Authors, Top
+@node Thanks and History
@chapter Thanks and History
The Supercite package was derived from its predecessor Superyank 1.11
Supercite was written by Barry Warsaw.
-@node GNU Free Documentation License, Concept Index, Thanks and History, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
-@node Concept Index, Command Index, GNU Free Documentation License, Top
+@node Concept Index
@unnumbered Concept Index
@printindex cp
-@node Command Index, Key Index, Concept Index, Top
+@node Command Index
@unnumbered Command Index
Since all supercite commands are prepended with the string
@end iftex
@printindex fn
-@node Key Index, Variable Index, Command Index, Top
+@node Key Index
@unnumbered Key Index
@printindex ky
-@node Variable Index, , Key Index, Top
+@node Variable Index
@unnumbered Variable Index
Since all supercite variables are prepended with the string
* Advanced Features:: Want to know more?
* For Gurus:: Want to know @emph{even more}?
* Index:: Concept, Function and Variable Index
-* Acknowledgements:: Acknowledgements
+* Acknowledgments:: Acknowledgments
* GNU Free Documentation License:: The license for this documentation.
@end menu
@end table
@c ===================================================================
-@node Index, Acknowledgements, For Gurus, Top
+@node Index, Acknowledgments, For Gurus, Top
@unnumbered Index
@printindex cp
@c ===================================================================
-@node Acknowledgements, GNU Free Documentation License, Index, Top
-@chapter Acknowledgements
+@node Acknowledgments, GNU Free Documentation License, Index, Top
+@chapter Acknowledgments
Coding by:
@quotation
@c ===================================================================
-@node GNU Free Documentation License, , Acknowledgements, Top
+@node GNU Free Documentation License, , Acknowledgments, Top
@appendix GNU Free Documentation License
@include doclicense.texi
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2011-09-23.09}
+\def\texinfoversion{2012-09-12.16}
%
% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-% 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+% 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
%
% This texinfo.tex file is free software: you can redistribute it and/or
% modify it under the terms of the GNU General Public License as
%
% Please try the latest version of texinfo.tex before submitting bug
% reports; you can get the latest version from:
-% http://www.gnu.org/software/texinfo/ (the Texinfo home page), or
-% ftp://tug.org/tex/texinfo.tex
-% (and all CTAN mirrors, see http://www.ctan.org).
+% http://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or
+% http://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or
+% http://www.gnu.org/software/texinfo/ (the Texinfo home page)
% The texinfo.tex in any given distribution could well be out
% of date, so if that's what you're using, please check.
%
% Set up fixed words for English if not already set.
\ifx\putwordAppendix\undefined \gdef\putwordAppendix{Appendix}\fi
\ifx\putwordChapter\undefined \gdef\putwordChapter{Chapter}\fi
+\ifx\putworderror\undefined \gdef\putworderror{error}\fi
\ifx\putwordfile\undefined \gdef\putwordfile{file}\fi
\ifx\putwordin\undefined \gdef\putwordin{in}\fi
\ifx\putwordIndexIsEmpty\undefined \gdef\putwordIndexIsEmpty{(Index is empty)}\fi
\errorcontextlines16
}%
+% @errormsg{MSG}. Do the index-like expansions on MSG, but if things
+% aren't perfect, it's not the end of the world, being an error message,
+% after all.
+%
+\def\errormsg{\begingroup \indexnofonts \doerrormsg}
+\def\doerrormsg#1{\errmessage{#1}}
+
% add check for \lastpenalty to plain's definitions. If the last thing
% we did was a \nobreak, we don't want to insert more space.
%
\def\:{\spacefactor=1000 }
% @* forces a line break.
-\def\*{\hfil\break\hbox{}\ignorespaces}
+\def\*{\unskip\hfil\break\hbox{}\ignorespaces}
% @/ allows a line break.
\let\/=\allowbreak
\def\popthisfilestack{\errthisfilestackempty}
\def\errthisfilestackempty{\errmessage{Internal error:
the stack of filenames is empty.}}
-
+%
\def\thisfile{}
% @center line
%
\parseargdef\center{%
\ifhmode
- \let\next\centerH
+ \let\centersub\centerH
\else
- \let\next\centerV
+ \let\centersub\centerV
\fi
- \next{\hfil \ignorespaces#1\unskip \hfil}%
+ \centersub{\hfil \ignorespaces#1\unskip \hfil}%
+ \let\centersub\relax % don't let the definition persist, just in case
}
-\def\centerH#1{%
- {%
- \hfil\break
- \advance\hsize by -\leftskip
- \advance\hsize by -\rightskip
- \line{#1}%
- \break
- }%
+\def\centerH#1{{%
+ \hfil\break
+ \advance\hsize by -\leftskip
+ \advance\hsize by -\rightskip
+ \line{#1}%
+ \break
+}}
+%
+\newcount\centerpenalty
+\def\centerV#1{%
+ % The idea here is the same as in \startdefun, \cartouche, etc.: if
+ % @center is the first thing after a section heading, we need to wipe
+ % out the negative parskip inserted by \sectionheading, but still
+ % prevent a page break here.
+ \centerpenalty = \lastpenalty
+ \ifnum\centerpenalty>10000 \vskip\parskip \fi
+ \ifnum\centerpenalty>9999 \penalty\centerpenalty \fi
+ \line{\kern\leftskip #1\kern\rightskip}%
}
-\def\centerV#1{\line{\kern\leftskip #1\kern\rightskip}}
% @sp n outputs n lines of vertical space
-
+%
\parseargdef\sp{\vskip #1\baselineskip}
% @comment ...line which is ignored...
% @c is the same as @comment
% @ignore ... @end ignore is another way to write a comment
-
+%
\def\comment{\begingroup \catcode`\^^M=\other%
\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other%
\commentxxx}
{\catcode`\^^M=\other \gdef\commentxxx#1^^M{\endgroup}}
-
+%
\let\c=\comment
% @paragraphindent NCHARS
% for display in the outlines, and in other places. Thus, we have to
% double any backslashes. Otherwise, a name like "\node" will be
% interpreted as a newline (\n), followed by o, d, e. Not good.
-% http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html
-% (and related messages, the final outcome is that it is up to the TeX
-% user to double the backslashes and otherwise make the string valid, so
-% that's what we do).
-
-% double active backslashes.
-%
-{\catcode`\@=0 \catcode`\\=\active
- @gdef@activebackslashdouble{%
- @catcode`@\=@active
- @let\=@doublebackslash}
-}
-
-% To handle parens, we must adopt a different approach, since parens are
-% not active characters. hyperref.dtx (which has the same problem as
-% us) handles it with this amazing macro to replace tokens, with minor
-% changes for Texinfo. It is included here under the GPL by permission
-% from the author, Heiko Oberdiek.
-%
-% #1 is the tokens to replace.
-% #2 is the replacement.
-% #3 is the control sequence with the string.
-%
-\def\HyPsdSubst#1#2#3{%
- \def\HyPsdReplace##1#1##2\END{%
- ##1%
- \ifx\\##2\\%
- \else
- #2%
- \HyReturnAfterFi{%
- \HyPsdReplace##2\END
- }%
- \fi
- }%
- \xdef#3{\expandafter\HyPsdReplace#3#1\END}%
-}
-\long\def\HyReturnAfterFi#1\fi{\fi#1}
-
-% #1 is a control sequence in which to do the replacements.
-\def\backslashparens#1{%
- \xdef#1{#1}% redefine it as its expansion; the definition is simply
- % \lastnode when called from \setref -> \pdfmkdest.
- \HyPsdSubst{(}{\realbackslash(}{#1}%
- \HyPsdSubst{)}{\realbackslash)}{#1}%
+%
+% See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and
+% related messages. The final outcome is that it is up to the TeX user
+% to double the backslashes and otherwise make the string valid, so
+% that's what we do. pdftex 1.30.0 (ca.2005) introduced a primitive to
+% do this reliably, so we use it.
+
+% #1 is a control sequence in which to do the replacements,
+% which we \xdef.
+\def\txiescapepdf#1{%
+ \ifx\pdfescapestring\thisisundefined
+ % No primitive available; should we give a warning or log?
+ % Many times it won't matter.
+ \else
+ % The expandable \pdfescapestring primitive escapes parentheses,
+ % backslashes, and other special chars.
+ \xdef#1{\pdfescapestring{#1}}%
+ \fi
}
\newhelp\nopdfimagehelp{Texinfo supports .png, .jpg, .jpeg, and .pdf images
%
% #1 is image name, #2 width (might be empty/whitespace), #3 height (ditto).
\def\dopdfimage#1#2#3{%
- \def\imagewidth{#2}\setbox0 = \hbox{\ignorespaces #2}%
- \def\imageheight{#3}\setbox2 = \hbox{\ignorespaces #3}%
+ \def\pdfimagewidth{#2}\setbox0 = \hbox{\ignorespaces #2}%
+ \def\pdfimageheight{#3}\setbox2 = \hbox{\ignorespaces #3}%
%
- % pdftex (and the PDF format) support .png, .jpg, .pdf (among
- % others). Let's try in that order.
+ % pdftex (and the PDF format) support .pdf, .png, .jpg (among
+ % others). Let's try in that order, PDF first since if
+ % someone has a scalable image, presumably better to use that than a
+ % bitmap.
\let\pdfimgext=\empty
\begingroup
- \openin 1 #1.png \ifeof 1
- \openin 1 #1.jpg \ifeof 1
- \openin 1 #1.jpeg \ifeof 1
- \openin 1 #1.JPG \ifeof 1
- \openin 1 #1.pdf \ifeof 1
- \openin 1 #1.PDF \ifeof 1
+ \openin 1 #1.pdf \ifeof 1
+ \openin 1 #1.PDF \ifeof 1
+ \openin 1 #1.png \ifeof 1
+ \openin 1 #1.jpg \ifeof 1
+ \openin 1 #1.jpeg \ifeof 1
+ \openin 1 #1.JPG \ifeof 1
\errhelp = \nopdfimagehelp
\errmessage{Could not find image file #1 for pdf}%
- \else \gdef\pdfimgext{PDF}%
+ \else \gdef\pdfimgext{JPG}%
\fi
- \else \gdef\pdfimgext{pdf}%
+ \else \gdef\pdfimgext{jpeg}%
\fi
- \else \gdef\pdfimgext{JPG}%
+ \else \gdef\pdfimgext{jpg}%
\fi
- \else \gdef\pdfimgext{jpeg}%
+ \else \gdef\pdfimgext{png}%
\fi
- \else \gdef\pdfimgext{jpg}%
+ \else \gdef\pdfimgext{PDF}%
\fi
- \else \gdef\pdfimgext{png}%
+ \else \gdef\pdfimgext{pdf}%
\fi
\closein 1
\endgroup
\else
\immediate\pdfximage
\fi
- \ifdim \wd0 >0pt width \imagewidth \fi
- \ifdim \wd2 >0pt height \imageheight \fi
+ \ifdim \wd0 >0pt width \pdfimagewidth \fi
+ \ifdim \wd2 >0pt height \pdfimageheight \fi
\ifnum\pdftexversion<13
#1.\pdfimgext
\else
% such as \, aren't expanded when present in a section title.
\indexnofonts
\turnoffactive
- \activebackslashdouble
\makevalueexpandable
\def\pdfdestname{#1}%
- \backslashparens\pdfdestname
+ \txiescapepdf\pdfdestname
\safewhatsit{\pdfdest name{\pdfdestname} xyz}%
}}
%
% page number. We could generate a destination for the section
% text in the case where a section has no node, but it doesn't
% seem worth the trouble, since most documents are normally structured.
- \def\pdfoutlinedest{#3}%
+ \edef\pdfoutlinedest{#3}%
\ifx\pdfoutlinedest\empty
\def\pdfoutlinedest{#4}%
\else
- % Doubled backslashes in the name.
- {\activebackslashdouble \xdef\pdfoutlinedest{#3}%
- \backslashparens\pdfoutlinedest}%
+ \txiescapepdf\pdfoutlinedest
\fi
%
- % Also double the backslashes in the display string.
- {\activebackslashdouble \xdef\pdfoutlinetext{#1}%
- \backslashparens\pdfoutlinetext}%
+ % Also escape PDF chars in the display string.
+ \edef\pdfoutlinetext{#1}%
+ \txiescapepdf\pdfoutlinetext
%
\pdfoutline goto name{\pdfmkpgn{\pdfoutlinedest}}#2{\pdfoutlinetext}%
}
%
\def\pdfmakeoutlines{%
\begingroup
- % Thanh's hack / proper braces in bookmarks
- \edef\mylbrace{\iftrue \string{\else}\fi}\let\{=\mylbrace
- \edef\myrbrace{\iffalse{\else\string}\fi}\let\}=\myrbrace
- %
% Read toc silently, to get counts of subentries for \pdfoutline.
\def\partentry##1##2##3##4{}% ignore parts in the outlines
\def\numchapentry##1##2##3##4{%
% Latin 2 (0xea) gets translated to a | character. Info from
% Staszek Wawrykiewicz, 19 Jan 2004 04:09:24 +0100.
%
- % xx to do this right, we have to translate 8-bit characters to
- % their "best" equivalent, based on the @documentencoding. Right
- % now, I guess we'll just let the pdf reader have its way.
+ % TODO this right, we have to translate 8-bit characters to
+ % their "best" equivalent, based on the @documentencoding. Too
+ % much work for too little return. Just use the ASCII equivalents
+ % we use for the index sort strings.
+ %
\indexnofonts
\setupdatafile
+ % We can have normal brace characters in the PDF outlines, unlike
+ % Texinfo index files. So set that up.
+ \def\{{\lbracecharliteral}%
+ \def\}{\rbracecharliteral}%
\catcode`\\=\active \otherbackslash
\input \tocreadfilename
\endgroup
}
+ {\catcode`[=1 \catcode`]=2
+ \catcode`{=\other \catcode`}=\other
+ \gdef\lbracecharliteral[{]%
+ \gdef\rbracecharliteral[}]%
+ ]
%
\def\skipspaces#1{\def\PP{#1}\def\D{|}%
\ifx\PP\D\let\nextsp\relax
\else\let\nextsp\skipspaces
- \ifx\p\space\else\addtokens{\filename}{\PP}%
- \advance\filenamelength by 1
- \fi
+ \addtokens{\filename}{\PP}%
+ \advance\filenamelength by 1
\fi
\nextsp}
- \def\getfilename#1{\filenamelength=0\expandafter\skipspaces#1|\relax}
+ \def\getfilename#1{%
+ \filenamelength=0
+ % If we don't expand the argument now, \skipspaces will get
+ % snagged on things like "@value{foo}".
+ \edef\temp{#1}%
+ \expandafter\skipspaces\temp|\relax
+ }
\ifnum\pdftexversion < 14
\let \startlink \pdfannotlink
\else
\def\ttsl{\setfontstyle{ttsl}}
-% Default leading.
-\newdimen\textleading \textleading = 13.2pt
-
% Set the baselineskip to #1, and the lineskip and strut size
% correspondingly. There is no deep meaning behind these magic numbers
% used as factors; they just match (closely enough) what Knuth defined.
% can get a sort of poor man's double spacing by redefining this.
\def\baselinefactor{1}
%
+\newdimen\textleading
\def\setleading#1{%
\dimen0 = #1\relax
\normalbaselineskip = \baselinefactor\dimen0
\fi\fi
-% Set the font macro #1 to the font named #2, adding on the
-% specified font prefix (normally `cm').
+% Set the font macro #1 to the font named \fontprefix#2.
% #3 is the font's design size, #4 is a scale factor, #5 is the CMap
-% encoding (currently only OT1, OT1IT and OT1TT are allowed, pass
-% empty to omit).
+% encoding (only OT1, OT1IT and OT1TT are allowed, or empty to omit).
+% Example:
+% #1 = \textrm
+% #2 = \rmshape
+% #3 = 10
+% #4 = \mainmagstep
+% #5 = OT1
+%
\def\setfont#1#2#3#4#5{%
\font#1=\fontprefix#2#3 scaled #4
\csname cmap#5\endcsname#1%
}
% This is what gets called when #5 of \setfont is empty.
\let\cmap\gobble
-% emacs-page end of cmaps
+%
+% (end of cmaps)
% Use cm as the default font prefix.
% To specify the font prefix, you must define \fontprefix
\fi
% Support font families that don't use the same naming scheme as CM.
\def\rmshape{r}
-\def\rmbshape{bx} %where the normal face is bold
+\def\rmbshape{bx} % where the normal face is bold
\def\bfshape{b}
\def\bxshape{bx}
\def\ttshape{tt}
\def\scshape{csc}
\def\scbshape{csc}
-% Definitions for a main text size of 11pt. This is the default in
-% Texinfo.
+% Definitions for a main text size of 11pt. (The default in Texinfo.)
%
\def\definetextfontsizexi{%
% Text fonts (11.2pt, magstep1).
\textleading = 13.2pt % line spacing for 11pt CM
\textfonts % reset the current fonts
\rm
-} % end of 11pt text font size definitions
+} % end of 11pt text font size definitions, \definetextfontsizexi
% Definitions to make the main text be 10pt Computer Modern, with
\textleading = 12pt % line spacing for 10pt CM
\textfonts % reset the current fonts
\rm
-} % end of 10pt text font size definitions
+} % end of 10pt text font size definitions, \definetextfontsizex
% We provide the user-level command
\gdef\markupsetcodequoteleft{\let`\codequoteleft}
\gdef\markupsetcodequoteright{\let'\codequoteright}
-
-\gdef\markupsetnoligaturesquoteleft{\let`\noligaturesquoteleft}
}
\let\markupsetuplqcode \markupsetcodequoteleft
\let\markupsetuplqexample \markupsetcodequoteleft
\let\markupsetuprqexample \markupsetcodequoteright
%
+\let\markupsetuplqkbd \markupsetcodequoteleft
+\let\markupsetuprqkbd \markupsetcodequoteright
+%
\let\markupsetuplqsamp \markupsetcodequoteleft
\let\markupsetuprqsamp \markupsetcodequoteright
%
\let\markupsetuplqverbatim \markupsetcodequoteleft
\let\markupsetuprqverbatim \markupsetcodequoteright
-\let\markupsetuplqkbd \markupsetnoligaturesquoteleft
-
% Allow an option to not use regular directed right quote/apostrophe
% (char 0x27), but instead the undirected quote from cmtt (char 0x0d).
% The undirected quote is ugly, so don't make it the default, but it
\else\ifx\next-%
\else\ifx\next.%
\else\ptexslash
- \fi\fi\fi}
+ \fi\fi\fi
+ \aftersmartic
+}
-% like \smartslanted except unconditionally uses \ttsl, and no ic.
-% @var is set to this for defun arguments.
+% Unconditional use \ttsl, and no ic. @var is set to this for defuns.
\def\ttslanted#1{{\ttsl #1}}
% @cite is like \smartslanted except unconditionally use \sl. We never want
% ttsl for book titles, do we?
\def\cite#1{{\sl #1}\futurelet\next\smartitaliccorrection}
+\def\aftersmartic{}
+\def\var#1{%
+ \let\saveaftersmartic = \aftersmartic
+ \def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}%
+ \smartslanted{#1}%
+}
+
\let\i=\smartitalic
\let\slanted=\smartslanted
-\def\var#1{\smartslanted{#1}}
\let\dfn=\smartslanted
\let\emph=\smartitalic
% @samp.
\def\samp#1{{\setupmarkupstyle{samp}\lq\tclose{#1}\rq\null}}
-% definition of @key that produces a lozenge. Doesn't adjust to text size.
-%\setfont\keyrm\rmshape{8}{1000}{OT1}
-%\font\keysy=cmsy9
-%\def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{%
-% \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{%
-% \vbox{\hrule\kern-0.4pt
-% \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}%
-% \kern-0.4pt\hrule}%
-% \kern-.06em\raise0.4pt\hbox{\angleright}}}}
+% @indicateurl is \samp, that is, with quotes.
+\let\indicateurl=\samp
-% definition of @key with no lozenge. If the current font is already
-% monospace, don't change it; that way, we respect @kbdinputstyle. But
-% if it isn't monospace, then use \tt.
-%
-\def\key#1{{\setupmarkupstyle{key}%
- \nohyphenation
- \ifmonospace\else\tt\fi
- #1}\null}
-
-% ctrl is no longer a Texinfo command.
-\def\ctrl #1{{\tt \rawbackslash \hat}#1}
-
-% @file, @option are the same as @samp.
-\let\file=\samp
-\let\option=\samp
-
-% @code is a modification of @t,
-% which makes spaces the same size as normal in the surrounding text.
+% @code (and similar) prints in typewriter, but with spaces the same
+% size as normal in the surrounding text, without hyphenation, etc.
+% This is a subroutine for that.
\def\tclose#1{%
{%
% Change normal interword space to be same as for the current font.
\plainfrenchspacing
#1%
}%
- \null
+ \null % reset spacefactor to 1000
}
% We *must* turn on hyphenation at `-' and `_' in @code.
% Otherwise, it is too hard to avoid overfull hboxes
% in the Emacs manual, the Library manual, etc.
-
+%
% Unfortunately, TeX uses one parameter (\hyphenchar) to control
% both hyphenation at - and hyphenation within words.
% We must therefore turn them both off (\tclose does that)
\fi\fi
}
+% For @command, @env, @file, @option quotes seem unnecessary,
+% so use \code rather than \samp.
+\let\command=\code
+\let\env=\code
+\let\file=\code
+\let\option=\code
+
% @uref (abbreviation for `urlref') takes an optional (comma-separated)
% second argument specifying the text to display and an optional third
% arg as text to display instead of (rather than in addition to) the url
\let\email=\uref
\fi
-% @kbd is like @code, except that if the argument is just one @key command,
-% then @kbd has no effect.
-\def\kbd#1{{\setupmarkupstyle{kbd}\def\look{#1}\expandafter\kbdfoo\look??\par}}
-
% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always),
% `example' (@kbd uses ttsl only inside of @example and friends),
% or `code' (@kbd uses normal tty font always).
% Default is `distinct'.
\kbdinputstyle distinct
+% @kbd is like @code, except that if the argument is just one @key command,
+% then @kbd has no effect.
+\def\kbd#1{{\def\look{#1}\expandafter\kbdsub\look??\par}}
+
\def\xkey{\key}
-\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}%
-\ifx\one\xkey\ifx\threex\three \key{#2}%
-\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
-\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi}
+\def\kbdsub#1#2#3\par{%
+ \def\one{#1}\def\three{#3}\def\threex{??}%
+ \ifx\one\xkey\ifx\threex\three \key{#2}%
+ \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
+ \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
+}
-% For @indicateurl, @env, @command quotes seem unnecessary, so use \code.
-\let\indicateurl=\code
-\let\env=\code
-\let\command=\code
+% definition of @key that produces a lozenge. Doesn't adjust to text size.
+%\setfont\keyrm\rmshape{8}{1000}{OT1}
+%\font\keysy=cmsy9
+%\def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{%
+% \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{%
+% \vbox{\hrule\kern-0.4pt
+% \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}%
+% \kern-0.4pt\hrule}%
+% \kern-.06em\raise0.4pt\hbox{\angleright}}}}
+
+% definition of @key with no lozenge. If the current font is already
+% monospace, don't change it; that way, we respect @kbdinputstyle. But
+% if it isn't monospace, then use \tt.
+%
+\def\key#1{{\setupmarkupstyle{key}%
+ \nohyphenation
+ \ifmonospace\else\tt\fi
+ #1}\null}
% @clicksequence{File @click{} Open ...}
\def\clicksequence#1{\begingroup #1\endgroup}
\ifx\temp\empty \else
\space ({\unsepspaces \ignorespaces \temp \unskip})%
\fi
+ \null % reset \spacefactor=1000
}
% @abbr for "Comput. J." and the like.
\ifx\temp\empty \else
\space ({\unsepspaces \ignorespaces \temp \unskip})%
\fi
+ \null % reset \spacefactor=1000
}
% @asis just yields its argument. Used with @table, for example.
}
}
+% ctrl is no longer a Texinfo command, but leave this definition for fun.
+\def\ctrl #1{{\tt \rawbackslash \hat}#1}
+
+% @inlinefmt{FMTNAME,PROCESSED-TEXT} and @inlineraw{FMTNAME,RAW-TEXT}.
+% Ignore unless FMTNAME == tex; then it is like @iftex and @tex,
+% except specified as a normal braced arg, so no newlines to worry about.
+%
+\def\outfmtnametex{tex}
+%
+\long\def\inlinefmt#1{\doinlinefmt #1,\finish}
+\long\def\doinlinefmt#1,#2,\finish{%
+ \def\inlinefmtname{#1}%
+ \ifx\inlinefmtname\outfmtnametex \ignorespaces #2\fi
+}
+% For raw, must switch into @tex before parsing the argument, to avoid
+% setting catcodes prematurely. Doing it this way means that, for
+% example, @inlineraw{html, foo{bar} gets a parse error instead of being
+% ignored. But this isn't important because if people want a literal
+% *right* brace they would have to use a command anyway, so they may as
+% well use a command to get a left brace too. We could re-use the
+% delimiter character idea from \verb, but it seems like overkill.
+%
+\long\def\inlineraw{\tex \doinlineraw}
+\long\def\doinlineraw#1{\doinlinerawtwo #1,\finish}
+\def\doinlinerawtwo#1,#2,\finish{%
+ \def\inlinerawname{#1}%
+ \ifx\inlinerawname\outfmtnametex \ignorespaces #2\fi
+ \endgroup % close group opened by \tex.
+}
+
\message{glyphs,}
% and logos.
-% @@ prints an @.
+% @@ prints an @, as does @atchar{}.
\def\@{\char64 }
+\let\atchar=\@
-% Used to generate quoted braces. Unless we're in typewriter, use
-% \ecfont because the CM text fonts do not have braces, and we don't
-% want to switch into math.
+% @{ @} @lbracechar{} @rbracechar{} all generate brace characters.
+% Unless we're in typewriter, use \ecfont because the CM text fonts do
+% not have braces, and we don't want to switch into math.
\def\mylbrace{{\ifmonospace\else\ecfont\fi \char123}}
\def\myrbrace{{\ifmonospace\else\ecfont\fi \char125}}
-\let\{=\mylbrace
-\let\}=\myrbrace
+\let\{=\mylbrace \let\lbracechar=\{
+\let\}=\myrbrace \let\rbracechar=\}
\begingroup
% Definitions to produce \{ and \} commands for indices,
% and @{ and @} for the aux/toc files.
{\tentt \global\dimen0 = 3em}% Width of the box.
\dimen2 = .55pt % Thickness of rules
% The text. (`r' is open on the right, `e' somewhat less so on the left.)
-\setbox0 = \hbox{\kern-.75pt \reducedsf error\kern-1.5pt}
+\setbox0 = \hbox{\kern-.75pt \reducedsf \putworderror\kern-1.5pt}
%
\setbox\errorbox=\hbox to \dimen0{\hfil
\hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right.
% 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
}
\finishedtitlepagetrue
}
+% Settings used for typesetting titles: no hyphenation, no indentation,
+% don't worry much about spacing, ragged right. This should be used
+% inside a \vbox, and fonts need to be set appropriately first. Because
+% it is always used for titles, nothing else, we call \rmisbold. \par
+% should be specified before the end of the \vbox, since a vbox is a group.
+%
+\def\raggedtitlesettings{%
+ \rmisbold
+ \hyphenpenalty=10000
+ \parindent=0pt
+ \tolerance=5000
+ \ptexraggedright
+}
+
% Macros to be used within @titlepage:
\let\subtitlerm=\tenrm
\parseargdef\title{%
\checkenv\titlepage
- \leftline{\titlefonts\rmisbold #1}
+ \vbox{\titlefonts \raggedtitlesettings #1\par}%
% print a rule at the page bottom also.
\finishedtitlepagefalse
\vskip4pt \hrule height 4pt width \hsize \vskip4pt
}
\def\ifsetfail{\doignore{ifset}}
-% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been
+% @ifclear VAR ... @end executes the `...' iff VAR has never been
% defined with @set, or has been undefined with @clear.
%
% The `\else' inside the `\doifset' parameter is a trick to reuse the
\def\ifclear{\parsearg{\doifset{\else \let\next=\ifclearfail}}}
\def\ifclearfail{\doignore{ifclear}}
+% @ifcommandisdefined CMD ... @end executes the `...' if CMD (written
+% without the @) is in fact defined. We can only feasibly check at the
+% TeX level, so something like `mathcode' is going to considered
+% defined even though it is not a Texinfo command.
+%
+\makecond{ifcommanddefined}
+\def\ifcommanddefined{\parsearg{\doifcmddefined{\let\next=\ifcmddefinedfail}}}
+%
+\def\doifcmddefined#1#2{{%
+ \makevalueexpandable
+ \let\next=\empty
+ \expandafter\ifx\csname #2\endcsname\relax
+ #1% If not defined, \let\next as above.
+ \fi
+ \expandafter
+ }\next
+}
+\def\ifcmddefinedfail{\doignore{ifcommanddefined}}
+
+% @ifcommandnotdefined CMD ... handled similar to @ifclear above.
+\makecond{ifcommandnotdefined}
+\def\ifcommandnotdefined{%
+ \parsearg{\doifcmddefined{\else \let\next=\ifcmdnotdefinedfail}}}
+\def\ifcmdnotdefinedfail{\doignore{ifcommandnotdefined}}
+
+% Set the `txicommandconditionals' variable, so documents have a way to
+% test if the @ifcommand...defined conditionals are available.
+\set txicommandconditionals
+
% @dircategory CATEGORY -- specify a category of the dir file
% which this file should belong to. Ignore this in TeX.
\let\dircategory=\comment
\definedummyword\guillemetright
\definedummyword\guilsinglleft
\definedummyword\guilsinglright
+ \definedummyword\lbracechar
\definedummyword\leq
\definedummyword\minus
\definedummyword\ogonek
\definedummyword\quoteleft
\definedummyword\quoteright
\definedummyword\quotesinglbase
+ \definedummyword\rbracechar
\definedummyword\result
\definedummyword\textdegree
%
\definedummyword\t
%
% Commands that take arguments.
+ \definedummyword\abbr
\definedummyword\acronym
+ \definedummyword\anchor
\definedummyword\cite
\definedummyword\code
\definedummyword\command
\definedummyword\emph
\definedummyword\env
\definedummyword\file
+ \definedummyword\image
\definedummyword\indicateurl
+ \definedummyword\inforef
\definedummyword\kbd
\definedummyword\key
\definedummyword\math
% content at all. So for index sorting, we map @{ and @} to strings
% starting with |, since that ASCII character is between ASCII { and }.
\def\{{|a}%
+ \def\lbracechar{|a}%
+ %
\def\}{|b}%
+ \def\rbracechar{|b}%
%
% Non-English letters.
\def\AA{AA}%
%
% ..., ready, GO:
%
-\def\safewhatsit#1{%
-\ifhmode
+\def\safewhatsit#1{\ifhmode
#1%
-\else
+ \else
% \lastskip and \lastpenalty cannot both be nonzero simultaneously.
\whatsitskip = \lastskip
\edef\lastskipmacro{\the\lastskip}%
% to re-insert the same penalty (values >10000 are used for various
% signals); since we just inserted a non-discardable item, any
% following glue (such as a \parskip) would be a breakpoint. For example:
- %
% @deffn deffn-whatever
% @vindex index-whatever
% Description.
% (the whatsit from the \write), so we must insert a \nobreak.
\nobreak\vskip\whatsitskip
\fi
-\fi
-}
+\fi}
% The index entry written in the file actually looks like
% \entry {sortstring}{page}{topic}
% Define @majorheading, @heading and @subheading
-% NOTE on use of \vbox for chapter headings, section headings, and such:
-% 1) We use \vbox rather than the earlier \line to permit
-% overlong headings to fold.
-% 2) \hyphenpenalty is set to 10000 because hyphenation in a
-% heading is obnoxious; this forbids it.
-% 3) Likewise, headings look best if no \parindent is used, and
-% if justification is not attempted. Hence \raggedright.
-
\def\majorheading{%
{\advance\chapheadingskip by 10pt \chapbreak }%
\parsearg\chapheadingzzz
\def\chapheading{\chapbreak \parsearg\chapheadingzzz}
\def\chapheadingzzz#1{%
- {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
- \parindent=0pt\ptexraggedright
- \rmisbold #1\hfill}}%
- \bigskip \par\penalty 200\relax
+ \vbox{\chapfonts \raggedtitlesettings #1\par}%
+ \nobreak\bigskip \nobreak
\suppressfirstparagraphindent
}
%
% Typeset the actual heading.
\nobreak % Avoid page breaks at the interline glue.
- \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \ptexraggedright
- \hangindent=\wd0 \centerparametersmaybe
+ \vbox{\raggedtitlesettings \hangindent=\wd0 \centerparametersmaybe
\unhbox0 #1\par}%
}%
\nobreak\bigskip % no page break after a chapter title
\def\setchapterstyle #1 {\csname CHAPF#1\endcsname}
%
\def\unnchfopen #1{%
-\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
- \parindent=0pt\ptexraggedright
- \rmisbold #1\hfill}}\bigskip \par\nobreak
+ \chapoddpage
+ \vbox{\chapfonts \raggedtitlesettings #1\par}%
+ \nobreak\bigskip\nobreak
}
\def\chfopen #1#2{\chapoddpage {\chapfonts
\vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}%
\par\penalty 5000 %
}
\def\centerchfopen #1{%
-\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
- \parindent=0pt
- \hfill {\rmisbold #1}\hfill}}\bigskip \par\nobreak
+ \chapoddpage
+ \vbox{\chapfonts \raggedtitlesettings \hfill #1\hfill}%
+ \nobreak\bigskip \nobreak
}
\def\CHAPFopen{%
\global\let\chapmacro=\chfopen
%
% We'll almost certainly start a paragraph next, so don't let that
% glue accumulate. (Not a breakpoint because it's preceded by a
- % discardable item.)
+ % discardable item.) However, when a paragraph is not started next
+ % (\startdefun, \cartouche, \center, etc.), this needs to be wiped out
+ % or the negative glue will cause weirdly wrong output, typically
+ % obscuring the section heading with something else.
\vskip-\parskip
%
- % This is purely so the last item on the list is a known \penalty >
- % 10000. This is so \startdefun can avoid allowing breakpoints after
- % section headings. Otherwise, it would insert a valid breakpoint between:
- % @section sec-whatever
- % @deffn def-whatever
+ % This is so the last item on the main vertical list is a known
+ % \penalty > 10000, so \startdefun, etc., can recognize the situation
+ % and do the needful.
\penalty 10001
}
% If this cartouche directly follows a sectioning command, we need the
% \parskip glue (backspaced over by default) or the cartouche can
% collide with the section heading.
- \ifnum\lastpenalty>10000 \vskip\parskip \fi
+ \ifnum\lastpenalty>10000 \vskip\parskip \penalty\lastpenalty \fi
%
\vbox\bgroup
\baselineskip=0pt\parskip=0pt\lineskip=0pt
\df \sl \hyphenchar\font=0
%
% On the other hand, if an argument has two dashes (for instance), we
- % want a way to get ttsl. Let's try @var for that.
+ % want a way to get ttsl. We used to recommend @var for that, so
+ % leave the code in, but it's strange for @var to lead to typewriter.
+ % Nowadays we recommend @code, since the difference between a ttsl hyphen
+ % and a tt hyphen is pretty tiny. @code also disables ?` !`.
\def\var##1{{\setupmarkupstyle{var}\ttslanted{##1}}}%
#1%
\sl\hyphenchar\font=45
\fi\fi
}
-
+% \f
% @xref, @pxref, and @ref generate cross-references. For \xrefX, #1 is
% the node name, #2 the name of the Info cross-reference, #3 the printed
% node name, #4 the name of the Info file, #5 the name of the printed
\def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]}
\def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]}
\def\ref#1{\xrefX[#1,,,,,,,]}
+%
+\newbox\toprefbox
+\newbox\printedrefnamebox
+\newbox\infofilenamebox
+\newbox\printedmanualbox
+%
\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup
\unsepspaces
- \def\printedmanual{\ignorespaces #5}%
+ %
+ % Get args without leading/trailing spaces.
\def\printedrefname{\ignorespaces #3}%
- \setbox1=\hbox{\printedmanual\unskip}%
- \setbox0=\hbox{\printedrefname\unskip}%
- \ifdim \wd0 = 0pt
+ \setbox\printedrefnamebox = \hbox{\printedrefname\unskip}%
+ %
+ \def\infofilename{\ignorespaces #4}%
+ \setbox\infofilenamebox = \hbox{\infofilename\unskip}%
+ %
+ \def\printedmanual{\ignorespaces #5}%
+ \setbox\printedmanualbox = \hbox{\printedmanual\unskip}%
+ %
+ % If the printed reference name (arg #3) was not explicitly given in
+ % the @xref, figure out what we want to use.
+ \ifdim \wd\printedrefnamebox = 0pt
% No printed node name was explicitly given.
\expandafter\ifx\csname SETxref-automatic-section-title\endcsname \relax
- % Use the node name inside the square brackets.
+ % Not auto section-title: use node name inside the square brackets.
\def\printedrefname{\ignorespaces #1}%
\else
- % Use the actual chapter/section title appear inside
- % the square brackets. Use the real section title if we have it.
- \ifdim \wd1 > 0pt
- % It is in another manual, so we don't have it.
+ % Auto section-title: use chapter/section title inside
+ % the square brackets if we have it.
+ \ifdim \wd\printedmanualbox > 0pt
+ % It is in another manual, so we don't have it; use node name.
\def\printedrefname{\ignorespaces #1}%
\else
\ifhavexrefs
- % We know the real title if we have the xref values.
+ % We (should) know the real title if we have the xref values.
\def\printedrefname{\refx{#1-title}{}}%
\else
% Otherwise just copy the Info node name.
\ifpdf
{\indexnofonts
\turnoffactive
+ \makevalueexpandable
% This expands tokens, so do it after making catcode changes, so _
- % etc. don't get their TeX definitions.
+ % etc. don't get their TeX definitions. This ignores all spaces in
+ % #4, including (wrongly) those in the middle of the filename.
\getfilename{#4}%
%
- % See comments at \activebackslashdouble.
- {\activebackslashdouble \xdef\pdfxrefdest{#1}%
- \backslashparens\pdfxrefdest}%
+ % This (wrongly) does not take account of leading or trailing
+ % spaces in #1, which should be ignored.
+ \edef\pdfxrefdest{#1}%
+ \ifx\pdfxrefdest\empty
+ \def\pdfxrefdest{Top}% no empty targets
+ \else
+ \txiescapepdf\pdfxrefdest % escape PDF special chars
+ \fi
%
\leavevmode
\startlink attr{/Border [0 0 0]}%
\iffloat\Xthisreftitle
% If the user specified the print name (third arg) to the ref,
% print it instead of our usual "Figure 1.2".
- \ifdim\wd0 = 0pt
+ \ifdim\wd\printedrefnamebox = 0pt
\refx{#1-snt}{}%
\else
\printedrefname
\fi
%
- % if the user also gave the printed manual name (fifth arg), append
+ % If the user also gave the printed manual name (fifth arg), append
% "in MANUALNAME".
- \ifdim \wd1 > 0pt
+ \ifdim \wd\printedmanualbox > 0pt
\space \putwordin{} \cite{\printedmanual}%
\fi
\else
% node/anchor (non-float) references.
+ %
+ % If we use \unhbox to print the node names, TeX does not insert
+ % empty discretionaries after hyphens, which means that it will not
+ % find a line break at a hyphen in a node names. Since some manuals
+ % are best written with fairly long node names, containing hyphens,
+ % this is a loss. Therefore, we give the text of the node name
+ % again, so it is as if TeX is seeing it for the first time.
+ %
+ \ifdim \wd\printedmanualbox > 0pt
+ % Cross-manual reference with a printed manual name.
+ %
+ \crossmanualxref{\cite{\printedmanual\unskip}}%
+ %
+ \else\ifdim \wd\infofilenamebox > 0pt
+ % Cross-manual reference with only an info filename (arg 4), no
+ % printed manual name (arg 5). This is essentially the same as
+ % the case above; we output the filename, since we have nothing else.
+ %
+ \crossmanualxref{\code{\infofilename\unskip}}%
%
- % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not
- % insert empty discretionaries after hyphens, which means that it will
- % not find a line break at a hyphen in a node names. Since some manuals
- % are best written with fairly long node names, containing hyphens, this
- % is a loss. Therefore, we give the text of the node name again, so it
- % is as if TeX is seeing it for the first time.
- \ifdim \wd1 > 0pt
- \putwordSection{} ``\printedrefname'' \putwordin{} \cite{\printedmanual}%
\else
+ % Reference within this manual.
+ %
% _ (for example) has to be the character _ for the purposes of the
% control sequence corresponding to the node, but it has to expand
% into the usual \leavevmode...\vrule stuff for purposes of
\setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}%
\ifdim \wd2 > 0pt \refx{#1-snt}\space\fi
}%
- % output the `[mynode]' via a macro so it can be overridden.
+ % output the `[mynode]' via the macro below so it can be overridden.
\xrefprintnodename\printedrefname
%
% But we always want a comma and a space:
%
% output the `page 3'.
\turnoffactive \putwordpage\tie\refx{#1-pg}{}%
- \fi
+ \fi\fi
\fi
\endlink
\endgroup}
+% Output a cross-manual xref to #1. Used just above (twice).
+%
+% Only include the text "Section ``foo'' in" if the foo is neither
+% missing or Top. Thus, @xref{,,,foo,The Foo Manual} outputs simply
+% "see The Foo Manual", the idea being to refer to the whole manual.
+%
+% But, this being TeX, we can't easily compare our node name against the
+% string "Top" while ignoring the possible spaces before and after in
+% the input. By adding the arbitrary 7sp below, we make it much less
+% likely that a real node name would have the same width as "Top" (e.g.,
+% in a monospaced font). Hopefully it will never happen in practice.
+%
+% For the same basic reason, we retypeset the "Top" at every
+% reference, since the current font is indeterminate.
+%
+\def\crossmanualxref#1{%
+ \setbox\toprefbox = \hbox{Top\kern7sp}%
+ \setbox2 = \hbox{\ignorespaces \printedrefname \unskip \kern7sp}%
+ \ifdim \wd2 > 7sp % nonempty?
+ \ifdim \wd2 = \wd\toprefbox \else % same as Top?
+ \putwordSection{} ``\printedrefname'' \putwordin{}\space
+ \fi
+ \fi
+ #1%
+}
+
% This macro is called from \xrefX for the `[nodename]' part of xref
% output. It's a separate macro only so it can be changed more easily,
% since square brackets don't work well in some documents. Particularly
% space to prevent strange expansion errors.)
\def\supereject{\par\penalty -20000\footnoteno =0 }
-% @footnotestyle is meaningful for info output only.
+% @footnotestyle is meaningful for Info output only.
\let\footnotestyle=\comment
{\catcode `\@=11
% expands into a box, it must come within the paragraph, lest it
% provide a place where TeX can split the footnote.
\footstrut
+ %
+ % Invoke rest of plain TeX footnote routine.
\futurelet\next\fo@t
}
}%end \catcode `\@=11
it from ftp://tug.org/tex/epsf.tex.}
%
\def\image#1{%
- \ifx\epsfbox\thisiundefined
+ \ifx\epsfbox\thisisundefined
\ifwarnednoepsf \else
\errhelp = \noepsfhelp
\errmessage{epsf.tex not found, images will be ignored}%
% If the image is by itself, center it.
\ifvmode
\imagevmodetrue
+ \else \ifx\centersub\centerV
+ % for @center @image, we need a vbox so we can have our vertical space
+ \imagevmodetrue
+ \vbox\bgroup % vbox has better behavior than vtop herev
+ \fi\fi
+ %
+ \ifimagevmode
\nobreak\medskip
% Usually we'll have text after the image which will insert
% \parskip glue, so insert it here too to equalize the space
\fi
%
% Leave vertical mode so that indentation from an enclosing
- % environment such as @quotation is respected. On the other hand, if
- % it's at the top level, we don't want the normal paragraph indentation.
- \noindent
+ % environment such as @quotation is respected.
+ % However, if we're at the top level, we don't want the
+ % normal paragraph indentation.
+ % On the other hand, if we are in the case of @center @image, we don't
+ % want to start a paragraph, which will create a hsize-width box and
+ % eradicate the centering.
+ \ifx\centersub\centerV\else \noindent \fi
%
% Output the image.
\ifpdf
\epsfbox{#1.eps}%
\fi
%
- \ifimagevmode \medskip \fi % space after the standalone image
+ \ifimagevmode
+ \medskip % space after a standalone image
+ \fi
+ \ifx\centersub\centerV \egroup \fi
\endgroup}
% In texinfo, backslash is an active character; it prints the backslash
% in fixed width font.
-\catcode`\\=\active
-@def@normalbackslash{{@tt@backslashcurfont}}
+\catcode`\\=\active % @ for escape char from now on.
+
+% The story here is that in math mode, the \char of \backslashcurfont
+% ends up printing the roman \ from the math symbol font (because \char
+% in math mode uses the \mathcode, and plain.tex sets
+% \mathcode`\\="026E). It seems better for @backslashchar{} to always
+% print a typewriter backslash, hence we use an explicit \mathchar,
+% which is the decimal equivalent of "715c (class 7, e.g., use \fam;
+% ignored family value; char position "5C). We can't use " for the
+% usual hex value because it has already been made active.
+@def@normalbackslash{{@tt @ifmmode @mathchar29020 @else @backslashcurfont @fi}}
+@let@backslashchar = @normalbackslash % @backslashchar{} is for user documents.
+
% On startup, @fixbackslash assigns:
% @let \ = @normalbackslash
-
% \rawbackslash defines an active \ to do \backslashcurfont.
% \otherbackslash defines an active \ to be a literal `\' character with
-% catcode other.
+% catcode other. We switch back and forth between these.
@gdef@rawbackslash{@let\=@backslashcurfont}
@gdef@otherbackslash{@let\=@realbackslash}
@def@normalslash{/}
% These look ok in all fonts, so just make them not special.
+% @hashchar{} gets its own user-level command, because of #line.
@catcode`@& = @other @def@normalamp{&}
@catcode`@# = @other @def@normalhash{#}
@catcode`@% = @other @def@normalpercent{%}
+@let @hashchar = @normalhash
+
@c Finally, make ` and ' active, so that txicodequoteundirected and
@c txicodequotebacktick work right in, e.g., @w{@code{`foo'}}. If we
@c don't make ` and ' active, @code will not get them as active chars.
* Filename Syntax:: @value{tramp} filename conventions.
* Alternative Syntax:: URL-like filename syntax.
* Filename completion:: Filename completion.
+* Ad-hoc multi-hops:: Declaring multiple hops in the file name.
* Remote processes:: Integration with other @value{emacsname} packages.
* Cleanup remote connections:: Cleanup remote connections.
@ifset emacsgvfs
GVFS integration started in February 2009.
@end ifset
+@ifset emacs
+Remote commands on Windows hosts are available since September 2011.
+@end ifset
+Ad-hoc multi-hop methods (with a changed syntax) have been reenabled
+in November 2011.
In December 2001, @value{tramp} has been added to the XEmacs package
repository. Being part of the Emacs repository happened in June 2002,
@node Connection types
-@section Types of connections made to remote machines.
+@section Types of connections made to remote machines
@cindex connection types, overview
There are two basic types of transfer methods, each with its own
command-line: line 0: Bad configuration option: ControlMaster
@end example
-then you cannot use it.
+then you cannot use it. Note, that the option
+@option{ControlPersist}, if it is supported by your @option{ssh}
+version, must be set to @option{no}.
This method supports the @samp{-p} argument.
@command{smbclient} command on different Unices in order to connect to
an SMB server. An SMB server might be a Samba (or CIFS) server on
another UNIX host or, more interesting, a host running MS Windows. So
-far, it is tested against MS Windows NT, MS Windows 2000, and MS
-Windows XP.
+far, it is tested against MS Windows NT, MS Windows 2000, MS Windows
+XP, MS Windows Vista, and MS Windows 7.
The first directory in the localname must be a share name on the remote
host. Remember that the @code{$} character, in which default shares
One trap to fall in must be known. If @value{tramp} finds a default
user, this user will be passed always to the connection command as
-parameter (for example @samp{ssh here.somewhere.else -l john}. If you
-have specified another user for your command in its configuration
+parameter (for example @command{ssh here.somewhere.else -l john}. If
+you have specified another user for your command in its configuration
files, @value{tramp} cannot know it, and the remote access will fail.
If you have specified in the given example in @file{~/.ssh/config} the
lines
@cindex multi-hop
@cindex proxy hosts
-Sometimes, the methods described before are not sufficient. Sometimes,
-it is not possible to connect to a remote host using a simple command.
-For example, if you are in a secured network, you might have to log in
-to a `bastion host' first before you can connect to the outside world.
-Of course, the target host may also require a bastion host.
+Sometimes, the methods described before are not sufficient.
+Sometimes, it is not possible to connect to a remote host using a
+simple command. For example, if you are in a secured network, you
+might have to log in to a bastion host first before you can connect to
+the outside world. Of course, the target host may also require a
+bastion host.
@vindex tramp-default-proxies-alist
-In order to specify such multiple hops, it is possible to define a proxy
+@defopt tramp-default-proxies-alist
+In order to specify multiple hops, it is possible to define a proxy
host to pass through, via the variable
@code{tramp-default-proxies-alist}. This variable keeps a list of
triples (@var{host} @var{user} @var{proxy}).
- The first matching item specifies the proxy host to be passed for a
+The first matching item specifies the proxy host to be passed for a
file name located on a remote target matching @var{user}@@@var{host}.
@var{host} and @var{user} are regular expressions or @code{nil}, which
is interpreted as a regular expression which always matches.
@var{host}, @var{user} and @var{proxy} can also be Lisp forms. These
forms are evaluated, and must return a string, or @code{nil}. The
previous example could be generalized then: For all hosts except my
-local one connect via @code{ssh} first, and apply @code{sudo -u root}
-afterwards:
+local one connect via @command{ssh} first, and apply @command{sudo -u
+root} afterwards:
@lisp
(add-to-list 'tramp-default-proxies-alist
Gateway methods can be declared as first hop only in a multiple hop
chain.
@end ifset
+@end defopt
+
+Hops to be passed tend to be restricted firewalls and alike.
+Sometimes they offer limited features only, like running @command{rbash}
+(restricted bash). This must be told to @value{tramp}.
+
+@vindex tramp-restricted-shell-hosts-alist
+@defopt tramp-restricted-shell-hosts-alist
+This variable keeps a list of regular expressions, which denote hosts
+running a registered shell like "rbash". Those hosts can be used as
+proxies only.
+
+If the bastion host from the example above runs a restricted shell,
+you shall apply
+
+@lisp
+(add-to-list 'tramp-restricted-shell-hosts-alist
+ "\\`bastion\\.your\\.domain\\'")
+@end lisp
+@end defopt
@node Customizing Methods
@node Password handling
-@section Reusing passwords for several connections.
+@section Reusing passwords for several connections
@cindex passwords
Sometimes it is necessary to connect to the same remote host several
@node Connection caching
-@section Reusing connection related information.
+@section Reusing connection related information
@cindex caching
@vindex tramp-persistency-file-name
@node Remote Programs
-@section How @value{tramp} finds and uses programs on the remote machine.
+@section How @value{tramp} finds and uses programs on the remote machine
@value{tramp} depends on a number of programs on the remote host in order to
function, including @command{ls}, @command{test}, @command{find} and
@value{tramp} does not know how to answer these questions. There are
two approaches for dealing with this problem. One approach is to take
care that the shell does not ask any questions when invoked from
-@value{tramp}. You can do this by checking the @code{TERM}
+@value{tramp}. You can do this by checking the @env{TERM}
environment variable, it will be set to @code{dumb} when connecting.
@vindex tramp-terminal-type
@item Environment variables named like users in @file{.profile}
-If you have a user named frumple and set the variable @code{FRUMPLE} in
+If you have a user named frumple and set the variable @env{FRUMPLE} in
your shell environment, then this might cause trouble. Maybe rename
-the variable to @code{FRUMPLE_DIR} or the like.
+the variable to @env{FRUMPLE_DIR} or the like.
This weird effect was actually reported by a @value{tramp} user!
this line.
Another example is the tilde (@code{~}) character, say when adding
-@file{~/bin} to @code{PATH}. Many Bourne shells will not expand this
+@file{~/bin} to @env{PATH}. Many Bourne shells will not expand this
character, and since there is usually no directory whose name consists
of the single character tilde, strange things will happen.
shell}, this doesn't look nice.
You can redefine the shell prompt by checking the environment variable
-@code{INSIDE_EMACS}, which is set by @value{tramp}, in your startup
-script @file{~/.emacs_SHELLNAME}. @code{SHELLNAME} might be the string
+@env{INSIDE_EMACS}, which is set by @value{tramp}, in your startup
+script @file{~/.emacs_SHELLNAME}. @env{SHELLNAME} might be the string
@code{bash} or similar, in case of doubt you could set it the
-environment variable @code{ESHELL} in your @file{.emacs}:
+environment variable @env{ESHELL} in your @file{.emacs}:
@lisp
(setenv "ESHELL" "bash")
you might encounter problems with @command{ssh-agent}. Using this
program, you can avoid typing the pass-phrase every time you log in.
However, if you start @value{emacsname} from a desktop shortcut, then
-the environment variable @code{SSH_AUTH_SOCK} is not set and so
+the environment variable @env{SSH_AUTH_SOCK} is not set and so
@value{emacsname} and thus @value{tramp} and thus @command{ssh} and
@command{scp} started from @value{tramp} cannot communicate with
@command{ssh-agent}. It works better to start @value{emacsname} from
* Filename Syntax:: @value{tramp} filename conventions.
* Alternative Syntax:: URL-like filename syntax.
* Filename completion:: Filename completion.
+* Ad-hoc multi-hops:: Declaring multiple hops in the file name.
* Remote processes:: Integration with other @value{emacsname} packages.
* Cleanup remote connections:: Cleanup remote connections.
@end menu
@end defopt
+@node Ad-hoc multi-hops
+@section Declaring multiple hops in the file name
+@cindex multi-hop, ad-hoc
+@cindex proxy hosts, ad-hoc
+
+Multiple hops are configured with the variable
+@code{tramp-default-proxies-alist} (@pxref{Multi-hops}). However,
+sometimes it is desirable to reach a remote host immediately, without
+configuration changes. This can be reached by an ad-hoc specification
+of the proxies.
+
+A proxy looks like a remote file name specification without the local
+file name part. It is prepended to the target remote file name,
+separated by @samp{|}. As an example, a remote file on
+@samp{you@@remotehost}, passing the proxy @samp{bird@@bastion}, could
+be opened by
+
+@example
+@c @kbd{C-x C-f @trampfn{ssh@value{postfixhop}bird@@bastion|ssh, you,
+@c remotehost, /path}}
+@kbd{C-x C-f @value{prefix}ssh@value{postfixhop}bird@@bastion|ssh@value{postfixhop}you@@remotehost@value{postfix}/path}
+@end example
+
+Multiple hops can be cascaded, separating all proxies by @samp{|}.
+The proxies can also contain the patterns @code{%h} or @code{%u}.
+
+The ad-hoc definition is added on the fly to
+@code{tramp-default-proxies-alist}. Therefore, during the lifetime of
+the @value{emacsname} session it is not necessary to enter this ad-hoc
+specification, again. The remote file name @samp{@trampfn{ssh, you,
+remotehost, /path}} would be sufficient from now on.
+
+@vindex tramp-save-ad-hoc-proxies
+@defopt tramp-save-ad-hoc-proxies
+This customer option controls whether ad-hoc definitions are kept
+persistently in @code{tramp-default-proxies-alist}. That means, those
+definitions are available also for future @value{emacsname} sessions.
+@end defopt
+
+
@node Remote processes
-@section Integration with other @value{emacsname} packages.
+@section Integration with other @value{emacsname} packages
@cindex compile
@cindex recompile
@value{tramp} supports running processes on a remote host. This
allows to exploit @value{emacsname} packages without modification for
-remote file names. It does not work for the @option{ftp} and
-@option{smb} methods. Association of a pty, as specified in
-@code{start-file-process}, is not supported.
+remote file names. It does not work for the @option{ftp} method.
+Association of a pty, as specified in @code{start-file-process}, is
+not supported.
@code{process-file} and @code{start-file-process} work on the remote
host when the variable @code{default-directory} is remote:
The environment for your program can be adapted by customizing
@code{tramp-remote-process-environment}. This variable is a list of
strings. It is structured like @code{process-environment}. Each
-element is a string of the form ENVVARNAME=VALUE. An entry
-ENVVARNAME= disables the corresponding environment variable, which
-might have been set in your init file like @file{~/.profile}.
+element is a string of the form @code{"ENVVARNAME=VALUE"}. An entry
+@code{"ENVVARNAME="} disables the corresponding environment variable,
+which might have been set in your init file like @file{~/.profile}.
@noindent
Adding an entry can be performed via @code{add-to-list}:
Changing or removing an existing entry is not encouraged. The default
values are chosen for proper @value{tramp} work. Nevertheless, if for
example a paranoid system administrator disallows changing the
-@code{HISTORY} environment variable, you can customize
+@env{HISTORY} environment variable, you can customize
@code{tramp-remote-process-environment}, or you can apply the
following code in your @file{.emacs}:
If you want to run a remote program, which shall connect the X11
server you are using with your local host, you can set the
-@code{DISPLAY} environment variable on the remote host:
+@env{DISPLAY} environment variable on the remote host:
@lisp
(add-to-list 'tramp-remote-process-environment
@subsection Running @code{shell} on a remote host
@cindex shell
-Calling @code{M-x shell} in a buffer related to a remote host runs the
+Calling @kbd{M-x shell} in a buffer related to a remote host runs the
local shell as defined in @option{shell-file-name}. This might be
also a valid path name for a shell to be applied on the remote host,
but it will fail at least when your local and remote hosts belong to
You will see the buffer @file{*Async Shell Command*}, containing the
continuous output of the @command{tail} command.
+@ifset emacs
+A similar behaviour can be reached by @kbd{M-x auto-revert-tail-mode},
+if available.
+@end ifset
+
@subsection Running @code{eshell} on a remote host
@cindex eshell
@value{tramp} is integrated into @file{eshell.el}. That is, you can
open an interactive shell on your remote host, and run commands there.
-After you have started @code{M-x eshell}, you could perform commands
+After you have started @kbd{M-x eshell}, you could perform commands
like this:
@example
absolute file names, without any remote specification.
+@subsection Running remote processes on Windows hosts
+@cindex winexe
+@cindex powershell
+
+With the help of the @command{winexe} it is possible tu run processes
+on a remote Windows host. @value{tramp} has implemented this for
+@code{process-file} and @code{start-file-process}.
+
+The variable @code{tramp-smb-winexe-program} must contain the file
+name of your local @command{winexe} command. On the remote host,
+Powershell V2.0 must be installed; it is used to run the remote
+process.
+
+In order to open a remote shell on the Windows host via @kbd{M-x
+shell}, you must set the variables @option{explicit-shell-file-name}
+and @option{explicit-*-args}. If you want, for example, run
+@command{cmd}, you must set:
+
+@lisp
+(setq explicit-shell-file-name "cmd"
+ explicit-cmd-args '("/q"))
+@end lisp
+
+@noindent
+In case of running @command{powershell} as remote shell, the settings are
+
+@lisp
+(setq explicit-shell-file-name "powershell"
+ explicit-powershell-args '("-file" "-"))
+@end lisp
+
+
@node Cleanup remote connections
-@section Cleanup remote connections.
+@section Cleanup remote connections
@cindex cleanup
Sometimes it is useful to cleanup remote connections. The following
include that with your bug report. This will make it much easier for
the development team to analyze and correct the problem.
+Sometimes, there might be also problems due to Tramp caches. Flush
+all caches before running the test, @ref{Cleanup remote connections}.
+
Before reporting the bug, you should set the verbosity level to 6
(@pxref{Traces and Profiles, Traces}) in the @file{~/.emacs} file and
repeat the bug. Then, include the contents of the @file{*tramp/foo*}
When the remote machine opens an echoing shell, there might be control
characters in the welcome message. @value{tramp} tries to suppress
-such echoes via the @code{stty -echo} command, but sometimes this
+such echoes via the @command{stty -echo} command, but sometimes this
command is not reached, because the echoed output has confused
@value{tramp} already. In such situations it might be helpful to use
the @option{sshx} or @option{scpx} methods, which allocate a pseudo tty.
@end example
+@item
+How can I use @samp{ControlPersist}?
+
+When @samp{ControlPersist} is set to @samp{yes}, the @option{scpc}
+method does not work. You can use @option{scpx} instead with the
+following settings in @file{~/.ssh/config}:
+
+@example
+Host *
+ ControlMaster auto
+ ControlPersist yes
+@end example
+
+
@item
File name completion does not work with @value{tramp}
emacsclient @trampfn{ssh, $(whoami), $(hostname --fqdn), $1}
@end example
-Then you must set the environment variable @code{EDITOR} pointing to
+Then you must set the environment variable @env{EDITOR} pointing to
that script:
@example
@node Localname deconstruction
-@section Breaking a localname into its components.
+@section Breaking a localname into its components
@value{tramp} file names are somewhat different, obviously, to ordinary file
names. As such, the lisp functions @code{file-name-directory} and
@ifset emacs
@node External packages
-@section Integration with external Lisp packages.
+@section Integration with external Lisp packages
@subsection Filename completion.
While reading filenames in the minibuffer, @value{tramp} must decide
@c In the Tramp CVS, the version number is auto-frobbed from
@c configure.ac, so you should edit that file and run
@c "autoconf && ./configure" to change the version number.
-@set trampver 2.2.3-24.1
+@set trampver 2.2.6
@c Other flags from configuration
@set instprefix /usr/local
* Log:: The *WoMan-Log* Buffer
* Technical:: Technical Details
* Bugs:: Reporting Bugs
-* Acknowledgements:: Acknowledgements
+* Acknowledgments:: Acknowledgments
* GNU Free Documentation License:: The license for this documentation.
* Command Index:: Command Index
* Variable Index:: Variable Index
@c ===================================================================
-@node Bugs, Acknowledgements, Technical, Top
+@node Bugs, Acknowledgments, Technical, Top
@comment node-name, next, previous, up
@chapter Reporting Bugs
@cindex reporting bugs
@c ===================================================================
-@node Acknowledgements, GNU Free Documentation License, Bugs, Top
+@node Acknowledgments, GNU Free Documentation License, Bugs, Top
@comment node-name, next, previous, up
-@chapter Acknowledgements
-@cindex acknowledgements
+@chapter Acknowledgments
+@cindex acknowledgments
For Heather, Kathryn and Madelyn, the women in my life (although they
will probably never use it)!
@page
-@node GNU Free Documentation License, Command Index, Acknowledgements, Top
+@node GNU Free Documentation License, Command Index, Acknowledgments, Top
@appendix GNU Free Documentation License
@include doclicense.texi
and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-fonts.el
cc-langs.el cc-mode.el cc-styles.el cc-vars.el
and changed cc-mode.texi lread.c programs.texi font-lock.el font-core.el
- isearch.el lisp.el modes.texi cc-menus.el cc-subword.el display.texi
- os.texi search.texi startup.el subr.el text.texi INSTALL.BZR add-log.el
- buffers.texi bytecomp.el callint.c and 22 other files
+ isearch.el lisp.el modes.texi cc-subword.el display.texi os.texi
+ search.texi startup.el subr.el text.texi INSTALL.BZR add-log.el
+ buffers.texi bytecomp.el callint.c cc-fix.el and 22 other files
Alan Shutko: changed diary-lib.el calendar.el bindings.el cal-hebrew.el
easy-mmode.el gnus-sum.el ibuf-ext.el ibuffer.el lunar.el macros.el
Andreas Schwab: changed Makefile.in configure.in lisp.h xdisp.c alloc.c
process.c coding.c files.el keyboard.c xterm.c editfns.c emacs.c fns.c
print.c eval.c fileio.c lread.c sysdep.c dired.el xfns.c buffer.c
- and 579 other files
+ and 577 other files
Andreas Seltenreich: changed nnweb.el gnus.texi message.el gnus-sum.el
gnus.el nnslashdot.el gnus-srvr.el gnus-util.el mm-url.el mm-uu.el
Ashwin Ram: wrote refer.el
-Atsuo Ohki: changed lread.c
-
Aubrey Jaffer: changed info.el unexelf.c
Axel Boldt: changed ehelp.el electric.el
Bastien Guerry: wrote gnus-bookmark.el org-latex.el
and co-wrote org-bibtex.el org-list.el org-protocol.el org-src.el
-and changed org.el org-agenda.el org-html.el org-clock.el org-table.el
- org.texi org-exp.el org-capture.el org-publish.el org-timer.el
+and changed org.el org-agenda.el org-html.el org-clock.el org-exp.el
+ org.texi org-table.el org-capture.el org-publish.el org-timer.el
org-export-latex.el org-archive.el org-ascii.el org-colview.el
- org-exp-blocks.el org-faces.el org-mobile.el ob.el org-eshell.el
- org-pcomplete.el bookmark.el and 37 other files
+ org-exp-blocks.el org-mobile.el ob.el org-eshell.el bookmark.el info.el
+ org-attach.el and 36 other files
Ben A. Mesander: co-wrote erc-dcc.el
org-bibtex.el org-entities.el org-gnus.el org-list.el org-pcomplete.el
org-src.el
and changed org-latex.el org.texi org-publish.el orgcard.tex
- org-export-latex.el org-docbook.el org-attach.el org-mouse.el
- org-protocol.el org-mac-message.el org-wl.el org-crypt.el
+ org-export-latex.el org-colview-xemacs.el org-docbook.el org-attach.el
+ org-mouse.el org-protocol.el org-mac-message.el org-wl.el org-crypt.el
org-freemind.el idlw-rinfo.el org-exp-blocks.el org-habit.el org-mhe.el
- org-plot.el org-special-blocks.el reftex.texi ob.el and 23 other files
+ org-plot.el org-special-blocks.el reftex.texi and 24 other files
Caveh Jalali: changed configure.in intel386.h sol2-4.h
Chong Yidong: wrote compile-tests.el dichromacy-theme.el
font-parse-tests.el redisplay-testsuite.el tabulated-list.el
and co-wrote longlines.el tango-dark-theme.el tango-theme.el
-and changed xdisp.c display.texi simple.el files.el frames.texi
+and changed xdisp.c simple.el display.texi files.el frames.texi
files.texi cus-edit.el keyboard.c custom.el text.texi package.el
- startup.el faces.el misc.texi subr.el xterm.c emacs.texi custom.texi
- image.c mouse.el xfns.c and 847 other files
+ startup.el faces.el xterm.c emacs.texi misc.texi subr.el image.c
+ mouse.el custom.texi xfns.c and 845 other files
Chris Chase: co-wrote idlw-shell.el idlwave.el
Christopher Oliver: changed mouse.el
-Christopher Schmidt: changed ibuffer.el files.texi
+Christopher Schmidt: changed ibuffer.el
Christopher Suckling: co-wrote org-mac-message.el
and changed vc.el Makefile.in configure.in vc-hg.el vc-git.el vc-bzr.el
sysdep.c emacs.c process.c vc-cvs.el lisp.h term.c vc-hooks.el xterm.c
keyboard.c vc-svn.el xterm.el callproc.c darwin.h term.el gnu-linux.h
- and 919 other files
+ and 918 other files
Dan Rosenberg: changed movemail.c
-Dani Moncayo: changed buffers.texi lists.texi makefile.w32-in custom.texi
- dired.texi text.texi
+Dani Moncayo: changed buffers.texi lists.texi custom.texi dired.texi
+ makefile.w32-in text.texi
Daniel Brockman: changed cus-start.el format-spec.el ibuffer.el rcirc.el
Eli Zaretskii: wrote [bidirectional display in xdisp.c] bidi.c rxvt.el
tty-colors.el
and changed makefile.w32-in xdisp.c msdos.c Makefile.in files.el
- config.bat simple.el fileio.c msdos.h rmail.el info.el mainmake.v2
+ config.bat fileio.c simple.el msdos.h info.el mainmake.v2 rmail.el
sed1v2.inp display.texi w32.c pc-win.el process.c dispnew.c startup.el
- dispextern.h dired.c and 703 other files
+ dispextern.h dired.c and 702 other files
Elias Oltmanns: changed tls.el gnus-agent.el gnus-int.el gnus-srvr.el
gnus.el
G Dinesh Dutt: changed etags.el
-Gabor Vida: changed ido.el
-
Gareth Jones: changed fns.c gnus-score.el
Garrett Wollman: changed sendmail.el
Glenn Morris: wrote automated/f90.el automated/vc-bzr.el check-declare.el
and changed Makefile.in configure.in calendar.el diary-lib.el rmail.el
- files.el progmodes/f90.el cal-menu.el appt.el cal-hebrew.el emacs.texi
- fortran.el bytecomp.el holidays.el calendar.texi ack.texi simple.el
- make-dist sed1v2.inp cal-islam.el dired-x.el and 1257 other files
+ progmodes/f90.el files.el cal-menu.el appt.el cal-hebrew.el fortran.el
+ bytecomp.el holidays.el emacs.texi calendar.texi ack.texi make-dist
+ simple.el sed1v2.inp cal-islam.el dired-x.el and 1249 other files
Glynn Clements: wrote gamegrid.el snake.el tetris.el
International Business Machines: changed emacs.c fileio.c process.c
sysdep.c unexcoff.c
-Ippei Furuhashi: changed org.texi
-
Irie Shinsuke: changed subr.el
Irie Tetsuya: changed gnus.texi message.texi
Jambunathan K: wrote org-lparse.el org-odt.el
and changed org.el org-exp.el org.texi OrgOdtContentTemplate.xml
- OrgOdtStyles.xml org-footnote.el org-inlinetask.el htmlfontify.el
+ org-footnote.el org-inlinetask.el OrgOdtStyles.xml htmlfontify.el
org-html.el package-x.el quail/indian.el tar-mode.el
James Clark: wrote nxml-enc.el nxml-glyph.el nxml-maint.el nxml-mode.el
James R. Van Zandt: changed sh-script.el
James TD Smith: changed org.el org-colview.el org-clock.el
- org-remember.el org-plot.el org-agenda.el org-compat.el org-habit.el
- org.texi
+ org-remember.el org-colview-xemacs.el org-plot.el org-agenda.el
+ org-compat.el org-habit.el org.texi
James Troup: changed gnus-sum.el
Jason Dunsmore: changed org-html.el org.el
-Jason L. Wright: changed smtpmail.el
-
Jason Merrill: changed gnus-sum.el add-log.el gnus-salt.el imap.el
nnfolder.el
Jim Kingdon: changed emacsclient.c emacs.tex functions.texinfo hp300bsd.h
rmail.el
-Jim Meyering: changed lread.c w32.c w32font.c copyright.el ebrowse.c
- emacs.c make-docfile.c nsfont.m pop.c term.c xfaces.c xselect.c
- Makefile.in alloc.c artist.el autoinsert.el buffer.h character.h
- charset.c configure configure.in and 54 other files
+Jim Meyering: changed lread.c w32.c copyright.el ebrowse.c emacs.c
+ make-docfile.c nsfont.m term.c w32font.c xfaces.c xselect.c Makefile.in
+ alloc.c artist.el autoinsert.el buffer.h character.h charset.c
+ configure configure.in doprnt.c and 53 other files
Jim Radford: changed gnus-start.el
and changed ob-octave.el
Juanma Barranquero: wrote emacs-lock.el
-and changed makefile.w32-in subr.el w32fns.c files.el emacsclient.c
- server.el bs.el help-fns.el faces.el org.el simple.el buffer.c xdisp.c
+and changed makefile.w32-in subr.el w32fns.c files.el server.el bs.el
+ emacsclient.c help-fns.el faces.el org.el simple.el buffer.c xdisp.c
keyboard.c desktop.el process.c w32term.c window.c ido.el w32.c
allout.el and 1089 other files
and changed shr.el org-agenda.el gnus-art.el gnus-html.el gnus.el
mm-decode.el gnus-group.el gnus-util.el message.el org.el gnus-sum.el
gnus.texi mm-view.el nnimap.el mm-uu.el nnir.el sieve-manage.el
- color-lab.el url-cache.el auth-source.el gnus-ems.el and 80 other files
+ color-lab.el url-cache.el auth-source.el gnus-ems.el and 82 other files
Julien Gilles: wrote gnus-ml.el
Justus Piater: changed smtpmail.el
-Jérémie Courrèges-Anglas: changed org.texi
-
Jérémy Compostella: changed battery.el windmove.el window.el
Jérôme Marant: changed Makefile.in make-dist bindings.el configure.in
and changed gnus.texi gnus-cite.el pop3.el smtpmail.el gnus-xmas.el
auth-source.el proto-stream.el url-http.el gnutls.c subr.el xml.c
dired.el editfns.c nnultimate.el gnus-nocem.el imap.el nnkiboze.el
- nnrss.el nnslashdot.el simple.el spam-report.el and 211 other files
+ nnrss.el nnslashdot.el simple.el spam-report.el and 210 other files
Lars Rasmusson: changed ebrowse.c
Ludovic Courtes: changed nnregistry.el
Ludovic Courtès: wrote nnregistry.el
-and changed configure.in gnus.texi
+and changed gnus.texi
Lukas Huonker: changed tetris.el
Maciek Pasternacki: changed nnrss.el
-Madan Ramakrishnan: changed org-agenda.el
-
Magnus Henoch: changed url-http.el ispell.el url.el dbusbind.c dns.el
url-gw.el url-parse.el url-proxy.el autoinsert.el cl.texi configure.in
dbus.el gnus.texi hashcash.el log-edit.el message.el org-clock.el
Mark Diekhans: changed files.el progmodes/compile.el subr.el
-Mark E. Shoulson: changed org.el
-
Mark H. Weaver: changed comint.el
Mark Hood: changed gnus-uu.el
Martin Rudalics: changed window.el window.c windows.texi frame.c buffer.c
help.el window.h cus-start.el frame.el cus-edit.el files.el
- buffers.texi dired.el subr.el add-log.el mouse.el xdisp.c display.texi
- font-lock.el help-fns.el help.texi and 143 other files
+ buffers.texi dired.el subr.el add-log.el xdisp.c font-lock.el
+ help-fns.el lisp.h mouse.el wid-edit.el and 137 other files
Martin Stjernholm: wrote cc-bytecomp.el
and co-wrote cc-align.el cc-cmds.el cc-compat.el cc-defs.el cc-engine.el
edebug.texi eldoc.el em-hist.el em-pred.el fixit.texi icon.el ido.el
locate.el paragraphs.el pcomplete.el repeat.el and 3 other files
-Matt Lundin: changed org-agenda.el org-bibtex.el org.el org-footnote.el
+Matt Lundin: changed org-agenda.el org-bibtex.el org-footnote.el org.el
Matt Pharr: changed message.el
and co-wrote tramp-cache.el tramp-sh.el tramp.el
and changed tramp.texi dbusbind.c trampver.texi dbus.texi trampver.el
ange-ftp.el tramp-fish.el files.el files.texi tramp-imap.el Makefile.in
- tramp-vc.el notifications.el tramp-util.el tramp-uu.el simple.el
+ tramp-vc.el tramp-util.el tramp-uu.el notifications.el simple.el
auth-source.el dired-aux.el configure.in em-unix.el fileio.c
- and 71 other files
+ and 66 other files
Michael Ben-Gershon: changed acorn.h configure.in riscix1-1.h riscix1-2.h
unexec.c
ediff-merge.el menu-bar.el appt.el desktop.el ediff-meta.el
viper-mouse.el
-Michael Markert: changed ob.el org-agenda.el org-ascii.el org-docbook.el
- org-html.el org-latex.el org-table.el org.el
+Michael Markert: changed ob.el org-agenda.el org-ascii.el
+ org-contacts-wl.el org-docbook.el org-html.el org-latex.el org-table.el
+ org.el
Michael McNamara: co-wrote verilog-mode.el
Mike Rowan: changed process.c alloc.c dispnew.c keyboard.c process.h
sysdep.c xdisp.c
-Mike Sperber: changed org-footnote.el
-
Mike Williams: wrote mouse-sel.el thingatpt.el
and changed sgml-mode.el xml-lite.el
Nicolas Goaziou: changed org-list.el org.el org-footnote.el org-exp.el
org-latex.el org-html.el org-inlinetask.el org-indent.el org-docbook.el
org-timer.el ob-asymptote.el org-ascii.el org-capture.el ob.el
- org-agenda.el org-archive.el org-mouse.el ob-exp.el org-clock.el
- org-macs.el org-table.el and 3 other files
+ org-agenda.el org-archive.el ob-exp.el org-clock.el org-macs.el
+ org-mouse.el org.texi and 3 other files
Niels Giesen: changed icalendar.el org-agenda.el org-clock.el
org-docbook.el org-icalendar.el
and changed vc.el subr.el simple.el lisp.h keyboard.c files.el
bytecomp.el keymap.c Makefile.in progmodes/compile.el xdisp.c pcvs.el
alloc.c newcomment.el vc-hooks.el tex-mode.el buffer.c fileio.c eval.c
- sh-script.el fill.el and 1035 other files
+ sh-script.el fill.el and 1033 other files
Stefan Reichör: changed gnus-agent.el
gnus-art.el gnus.texi nnimap.el files.el gnus-sum.el info.el
org-footnote.el org.el reftex-ref.el saveplace.el simple.el
tsdh-dark-theme.el tsdh-light-theme.el ack.texi artist.el bindings.el
- and 25 other files
+ and 26 other files
Tatsuya Ichikawa: changed gnus-agent.el gnus-cache.el
Teodor Zlatanov: wrote auth-source.el gnus-registry.el gnus-sync.el
gnus-tests.el gnutls.el registry.el spam-report.el url-future-tests.el
url-future.el
-and changed spam.el gnus.el nnimap.el gnus.texi gnus-sum.el auth.texi
- gnus-util.el gnutls.c netrc.el gnus-start.el message.el spam-stat.el
- encrypt.el nnir.el nnmail.el Makefile.in gnutls.h imap.el
- mail-source.el nnmairix.el nntp.el and 99 other files
+and changed spam.el gnus.el nnimap.el gnus.texi gnus-sum.el gnus-util.el
+ auth.texi netrc.el gnus-start.el gnutls.c message.el spam-stat.el
+ encrypt.el nnir.el nnmail.el imap.el mail-source.el nnmairix.el nntp.el
+ Makefile.in gnus-encrypt.el and 97 other files
Terje Rosten: changed xfns.c version.el xterm.c xterm.h
Toby Allsopp: changed ldap.el eudc.el
Toby Cubitt: co-wrote avl-tree.el
-and changed org.el
+
+Toby S. Cubitt: changed org.el
Toby Speight: changed generic-x.el window.el
Triet Hoai Lai: changed vntelex.el viet-util.el vietnamese.el
-Troels Nielsen: changed process.c progmodes/compile.el
+Troels Nielsen: changed process.c
Trung Tran-Duc: changed nntp.el
sysdep.c config.in dired.el emacs.c fill.el fns.c gmalloc.c gnu-linux.h
indent.h process.c simple.el term.c window.c
-Zachary Kanfer: changed cus-edit.el keyboard.c org.el
+Zachary Kanfer: changed cus-edit.el keyboard.c
Zhang Wei: changed chinese.el characters.el mule-cmds.el xfns.c erc.el
faces.el fontset.el makefile.w32-in mm-util.el mule.el org-publish.el
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-17 Glenn Morris <rgm@gnu.org>
- * Version 24.2 released.
+ * refcards/emacsver.tex: New file.
+ * refcards/calccard.tex, refcards/cs-dired-ref.tex:
+ * refcards/cs-refcard.tex, refcards/cs-survival.tex:
+ * refcards/de-refcard.tex, refcards/dired-ref.tex:
+ * refcards/emacsver.tex, refcards/fr-dired-ref.tex:
+ * refcards/fr-refcard.tex, refcards/fr-survival.tex:
+ * refcards/orgcard.tex, refcards/pl-refcard.tex:
+ * refcards/pt-br-refcard.tex, refcards/refcard.tex:
+ * refcards/sk-dired-ref.tex, refcards/sk-refcard.tex:
+ * refcards/sk-survival.tex, refcards/survival.tex:
+ * refcards/vipcard.tex, refcards/viperCard.tex: Include emacsver.tex.
+ * refcards/calccard.tex (\emacsversionnumber):
+ Rename to \versionemacs, same as all the other refcards.
+ * refcards/Makefile (ENVADD): New variable.
+ (sk-dired-ref.pdf, sk-survival.pdf, pl-refcard.pdf)
+ (%.pdf, %,dvi, sk-dired-ref.dvi, sk-survival.dvi, pl-refcard.dvi):
+ Depend on emacsver.tex. Add "." to TEXINPUTS for TeX commands.
+
+2012-09-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove configure's --without-sync-input option (Bug#12450).
+ * TODO (Make SYNC_INPUT the default): Remove, as the code now
+ behaves as if SYNC_INPUT is always true.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use a more backwards-compatible timer format (Bug#12430).
+ * NEWS: Document it, plus fix a typo.
+
+2012-09-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * NEWS (--with-x-toolkit): Mention that Gtk+ 3 is now default.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ * NEWS: Document timer format change (Bug#12430).
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ * NEWS: Document NaNs versus signaling-error change.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Give more-useful info on a fatal error (Bug#12328).
+ * NEWS: Document the change.
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seeds for (random).
+ * NEWS: Document new behavior of (random), (random "string").
+
+2012-08-28 Andreas Schwab <schwab@linux-m68k.org>
+
+ * charsets/MULE-ethiopic.map: Fix typo in comment.
+ * charsets/MULE-ipa.map: Likewise.
+ * charsets/MULE-is13194.map: Likewise.
+ * charsets/MULE-lviscii.map: Likewise.
+ * charsets/MULE-sisheng.map: Likewise.
+ * charsets/MULE-tibetan.map: Likewise.
+ * charsets/MULE-uviscii.map: Likewise.
+
+2012-08-09 Chong Yidong <cyd@gnu.org>
+
+ * images/splash.svg, images/splash.png: Tweak SVG paths to improve
+ legibility.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * NEWS: Mention --without-all and --enable-link-time-optimization.
+
+2012-07-31 Jan Djärv <jan.h.d@swipnet.se>
+
+ * TODO (NS port): Add text about event loop.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ deactive->inactive, inactivate->deactivate spelling fixes (Bug#10150)
+ * NEWS: Document these changes.
+
+2012-07-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * NEWS: Fix typo.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-07-26 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.1 released.
+ Simplify export of symbols to GDB.
+ * emacs-buffer.gdb ($tagmask, $valmask): Remove.
+ (ygetptr): Adjust to recent changes in lisp.h and emacs.c,
+ by using VALMASK instead of $valmask, CHECK_LISP_OBJECT_TYPE
+ instead of gdb_use_union, and DATA_SEG_BITS instead of
+ gdb_data_seg_bits. Also, use $ptr.i rather than $ptr.u.val.
-2012-04-26 Jambunathan K <kjambunathan@gmail.com>
+2012-07-20 Eli Zaretskii <eliz@gnu.org>
- * org/OrgOdtStyles.xml (OrgDescriptionList): Modify style. With
- this change, in a description list, if the description paragraph
+ * tutorials/TUTORIAL.he: Make the first sentence display correctly
+ in a left-to-right paragraph, such as what is shown on the fancy
+ splash screen.
+
+2012-07-15 Leo Liu <sdl.web@gmail.com>
+
+ * NEWS: Mention exclamation-mark and flymake.
+
+2012-07-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * tutorials/TUTORIAL.es: Sync with changes in 2012-07-07T10:34:37Z!cyd@gnu.org.
+
+2012-07-07 Michael Witten <mfwitten@gmail.com> (tiny change)
+
+ * tutorials/TUTORIAL: Copyedits (Bug#11689).
+
+2012-06-28 Glenn Morris <rgm@gnu.org>
+
+ * emacs.py, emacs2.py, emacs3.py: Remove files, no longer used.
+
+2012-06-24 Lawrence Mitchell <wence@gmx.li>
+
+ * NEWS: Move and improve the defun/defalias changes (bug#11686).
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * NEWS: Mention addition of picoseconds to time stamp format.
+
+2012-06-13 Deniz Dogan <deniz@dogan.se>
+
+ * tutorials/TUTORIAL.sv: Fix grammar and a couple of typos.
+
+2012-06-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * PROBLEMS (68000 C compiler problems): Remove obsolete section.
+ Not only are the compilers long-dead, the obsolete advice
+ typically doesn't apply to current Emacs sources.
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * themes/wheatgrass-theme.el:
+ * themes/deeper-blue-theme.el:
+ * themes/tango-dark-theme.el:
+ * themes/tsdh-dark-theme.el: Add compilation-mode-line-fail,
+ compilation-mode-line-run, and compilation-mode-line-exit faces.
+
+ * themes/manoj-dark-theme.el: Remove :family attributes.
+
+2012-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove --disable-maintainer-mode option from 'configure'. (Bug#11555)
+ * NEWS: Mention this.
+
+2012-06-01 Andrew Beals <andrew.beals@gmail.com> (tiny change)
+
+ * spook.lines: Additions. (Bug#11598)
+
+2012-05-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ * PROBLEMS: Remove obsolete '#define static' cruft.
+
+2012-05-07 Glenn Morris <rgm@gnu.org>
+
+ * forms/forms-d2.el, forms/forms-pass.el: Move here from ../lisp.
+ * forms/forms-d2.dat: Move to forms/ subdirectory.
+ * forms/README: New.
+
+2012-05-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * NEWS: Do not limit current-time-string to years 1000..9999.
+
+2012-04-27 Jambunathan K <kjambunathan@gmail.com>
+
+ * org/OrgOdtStyles.xml (OrgDescriptionList): Modify style.
+ With this change, in a description list, if the description paragraph
spawns multiple lines then it will correctly indented.
2012-04-20 Glenn Morris <rgm@gnu.org>
* MORE.STUFF: General update. Mention list-packages.
Remove many old/outdated URLs.
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * publicsuffix.txt: New file (bug#1401).
2012-04-02 Alan Mackenzie <acm@muc.de>
* org/OrgOdtContentTemplate.xml (OrgIndentedSection-Level-*):
New section styles. These sections are indented to the same
level as the corresponding list entries. These sections hold
- tables that occur within a list. (OrgTable): Increased
- relative width from 90% to 96% for aesthetic reasons.
+ tables that occur within a list. (OrgTable):
+ Increased relative width from 90% to 96% for aesthetic reasons.
2012-03-16 Glenn Morris <rgm@gnu.org>
2012-01-10 Chong Yidong <cyd@gnu.org>
* tutorials/TUTORIAL: Don't give instructions for old-style X
- scrollbars. Use DEL terminology instead of DelBack. Improve
- description of graphical continuation lines and mode-line.
+ scrollbars. Use DEL terminology instead of DelBack.
+ Improve description of graphical continuation lines and mode-line.
Promote use of C-/ and C-SPC. Remove discussion of flow control.
2012-01-05 Glenn Morris <rgm@gnu.org>
POSIX does not allow "-" in Makefile variable names.
Reported by Bruno Haible in
<http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00990.html>.
- * refcards/Makefile (DIRED_REFCARDS_PDF): Renamed from
+ * refcards/Makefile (DIRED_REFCARDS_PDF): Rename from
DIRED-REFCARDS_PDF.
- (MISC_REFCARDS_PDF): Renamed from MISC-REFCARDS_PDF.
- (SURVIVAL_CARDS_PDF): Renamed from SURVIVAL-CARDS_PDF.
- (VIPER_CARDS_PDF): Renamed from VIPER-CARDS_PDF.
+ (MISC_REFCARDS_PDF): Rename from MISC-REFCARDS_PDF.
+ (SURVIVAL_CARDS_PDF): Rename from SURVIVAL-CARDS_PDF.
+ (VIPER_CARDS_PDF): Rename from VIPER-CARDS_PDF.
2011-01-18 Glenn Morris <rgm@gnu.org>
2009-09-27 Teodor Zlatanov <tzz@lifelogs.com>
- * NEWS: Mention new library imap-hash.el
+ * NEWS: Mention new library imap-hash.el.
2009-09-22 Juanma Barranquero <lekktu@gmail.com>
2009-08-08 Dmitry Dzhus <dima@sphinx.net.ru>
* images/gud/all.xpm, images/gud/thread.xpm: New icons for
- gdb-mi.el
+ gdb-mi.el.
2009-08-07 Dan Nicolaescu <dann@ics.uci.edu>
* refcards/refcard.tex: Updates for printing.
(\versionyear): Update to 2007.
- (\copyrightnotice): Modified or unmodified ok.
+ (\copyrightnotice): Modify or unmodified ok.
(Simple Customization): Don't use goto-line, since now it's bound.
Also, use now-preferred (kbd ...) syntax.
2007-07-02 Carsten Dominik <dominik@science.uva.nl>
- * orgcard.tex: Version 5.01
+ * orgcard.tex: Version 5.01.
2007-06-27 Michael Albinus <michael.albinus@gmx.de>
2006-09-15 Richard Stallman <rms@gnu.org>
* THE-GNU-PROJECT: Update with the latest footnotes
- from www.gnu.org/gnu/the-gnu-project.html
+ from www.gnu.org/gnu/the-gnu-project.html.
2006-09-15 David Kastrup <dak@gnu.org>
2006-09-03 Diane Murray <disumu@x3y2z1.net>
- * erc.texi (Getting Started, Connecting): Changed erc-select to erc.
+ * erc.texi (Getting Started, Connecting): Change erc-select to erc.
2006-09-02 Juri Linkov <juri@jurta.org>
2006-07-05 Kenichi Handa <handa@m17n.org>
- * HELLO: Add a paragraph for non-ASCII examples at the head. Add
- Bulgarian and Hungarian. Add more "hello"s to Danish and Swedish.
+ * HELLO: Add a paragraph for non-ASCII examples at the head.
+ Add Bulgarian and Hungarian. Add more "hello"s to Danish and Swedish.
2006-07-03 Bill Wohler <wohler@newt.com>
2006-05-24 Carsten Dominik <dominik@science.uva.nl>
- * orgcard.tex (section{Motion}): Added the item navigation commands.
+ * orgcard.tex (section{Motion}): Add the item navigation commands.
(section{Publishing}): New section.
(section{Links}): Documented elisp and shell links.
New bitmaps for new images.
* images/refresh.xpm, images/sort-ascending.xpm,
- * images/sort-descending.xpm: Update with GTK 2.x images. Note
- that the default GTK icons are not overridden by the GNOME theme
+ * images/sort-descending.xpm: Update with GTK 2.x images.
+ Note that the default GTK icons are not overridden by the GNOME theme
due to a bug which was fixed in GNOME 2.15. Once GNOME 2.16 is in
wide circulation, then the GTK icons should be replaced with the
equivalent GNOME icons. Until then, we should be consistent with
2005-11-18 Carsten Dominik <dominik@science.uva.nl>
- * orgcard.tex: Version 3.20
+ * orgcard.tex: Version 3.20.
2005-11-16 Nick Roberts <nickrob@snap.net.nz>
2001-11-22 Colin Walters <walters@debian.org>
- * PROBLEMS: Remove already applied calc info patches. Clarify
- that there is no such thing as Debian GNU/Linux 2.4.3. ftpd is
+ * PROBLEMS: Remove already applied calc info patches.
+ Clarify that there is no such thing as Debian GNU/Linux 2.4.3. ftpd is
not handled by alternatives in Debian, the reporter surely meant
just "--config ftp".
* ps-prin1.ps: Footer implementation. Doc fix.
(doLineNumber): Code fix for line number color.
- (BeginPage, BeginSheet, HeaderFramePath, HeaderFrame, HeaderText): Code
- fix for footer implementation.
+ (BeginPage, BeginSheet, HeaderFramePath, HeaderFrame, HeaderText):
+ Code fix for footer implementation.
(TextStart, SetFooterLines, FooterFrameStart, doFramePath)
(FooterFramePath, doFrame, FooterFrame, FooterStart)
(HeaderOrFooterTextLines, HeaderOrFooterText, FooterText): New funs.
* ps-prin0.ps: Insert a version number comment (5.2.2).
Indentation fix.
- * ps-prin1.ps: Insert a version number comment (5.2.2). Can
- select page size with/without giving an error if PostScript
+ * ps-prin1.ps: Insert a version number comment (5.2.2).
+ Can select page size with/without giving an error if PostScript
printer doesn't have this kind of page size. Zebra Stripe
continues or restarts on next page. Indentation fix.
(BeginSheet): If necessary, rescale n-up to fit on the sheet of
* termcap.dat, termcap.ucb: Deleted and replaced.
* termcap: New termcap file from the ncurses project; bigger,
- better, brighter, does away with waxy yellow buildup. Email
- me at terminfo@ccil.org if you have any trouble with this.
+ better, brighter, does away with waxy yellow buildup.
+ Email me at terminfo@ccil.org if you have any trouble with this.
* README: Changed to track above change.
1995-04-26 Karl Heuer <kwzh@nutrimat.gnu.ai.mit.edu>
- * Makefile (maintainer-clean): Renamed from realclean.
+ * Makefile (maintainer-clean): Rename from realclean.
1995-04-09 Richard Stallman <rms@mole.gnu.ai.mit.edu>
1993-03-19 Eric S. Raymond (eric@geech.gnu.ai.mit.edu)
- * sex.6: Added 900-line support
+ * sex.6: Added 900-line support.
* NEWS: Added news about the package finder.
* DISTRIB: The actual domestic order form is now ORDERS.USA.
The DISTRIB text now mentions 19.
- * ORDERS.USA: Created. This is just the order form. DISTRIB
- has a pointer to it at the beginning.
+ * ORDERS.USA: Created. This is just the order form.
+ DISTRIB has a pointer to it at the beginning.
* EUROPE: Renamed to ORDERS.EUROPE. DISTRIB now has a pointer
to it at the beginning.
1992-04-06 Jim Blandy (jimb@pogo.cs.oberlin.edu)
- * etags.c (C_entries): Removed comment saying that \" in a string
+ * etags.c (C_entries): Remove comment saying that \" in a string
isn't recognized as magic, because it is correctly handled.
* getopt.c, getopt.h: New files, from GNU C library.
optind.
(main): Argument processing loop rewritten to call getopt to get
next option. Options which take parameters (-o and -i) rewritten
- to get parameter from optarg instead of argv[1]. Filename
- preprocessing loop and update command changed similarly.
+ to get parameter from optarg instead of argv[1].
+ Filename preprocessing loop and update command changed similarly.
* Makefile (etags, ctags): Depend on and link with getopt.h,
getopt.o, and getopt1.o.
(getopt.o, getopt1.o): New targets for the GNU getopt routines.
1991-01-25 Jim Blandy (jimb@churchy.ai.mit.edu)
* make-docfile: Find the arguments to a C function correctly,
- by not ignoring the character that read_c_string returns. Don't
- even try to find argument names for functions that take MANY
+ by not ignoring the character that read_c_string returns.
+ Don't even try to find argument names for functions that take MANY
or UNEVALLED arguments, since they're a figment of the docstring's
imagination.
1988-12-31 Richard Mlynarik (mly@rice-chex.ai.mit.edu)
* env.c: Add decl for my-index.
- * etags.c (file-entries): .oak => scheme
+ * etags.c (file-entries): .oak => scheme.
1988-12-30 Richard Stallman (rms@sugar-bombs.ai.mit.edu)
For older news, see Gnus info node "New Features".
\f
-* Installation changes
+* New features
-** Upgrading from previous (stable) version if you have used No Gnus.
+** If you have the "tnef" program installed, Gnus will display ms-tnef
+ files, aka "winmail.dat".
-If you have tried No Gnus (the unstable Gnus branch leading to this
-release) but went back to a stable version, be careful when upgrading to
-this version. In particular, you will probably want to remove the
-`~/News/marks' directory (perhaps selectively), so that flags are read
-from your `~/.newsrc.eld' instead of from the stale marks file, where
-this release will store flags for nntp. See a later entry for more
-information about nntp marks. Note that downgrading isn't safe in
-general.
+** Archives (like tar and zip files) will be automatically unpacked,
+ and the files inside the packages will be displayed as MIME parts.
-** Incompatibility when switching from Emacs 23 to Emacs 22 In Emacs 23,
-Gnus uses Emacs' new internal coding system `utf-8-emacs' for saving
-articles drafts and `~/.newsrc.eld'. These files may not be read
-correctly in Emacs 22 and below. If you want to use Gnus across
-different Emacs versions, you may set `mm-auto-save-coding-system' to
-`emacs-mule'.
+** shr has a new command `z' that cycles through image sizes.
-** Lisp files are now installed in `.../site-lisp/gnus/' by default. It
-defaulted to `.../site-lisp/' formerly. In addition to this, the new
-installer issues a warning if other Gnus installations which will shadow
-the latest one are detected. You can then remove those shadows manually
-or remove them using `make remove-installed-shadows'.
+** `backtab' in the summary buffer now selects the previous link in
+ the article buffer.
-** The installation directory name is allowed to have spaces and/or tabs.
+** Using the "X-Message-SMTP-Method" header in Message buffers now
+ allows specifying how messages are to be sent. For example:
-\f
-* New packages and libraries within Gnus
-
-** Gnus includes the Emacs Lisp SASL library.
-
-This provides a clean API to SASL mechanisms from within Emacs. The
-user visible aspects of this, compared to the earlier situation, include
-support for DIGEST-MD5 and NTLM. *Note Emacs SASL: (sasl)Top.
-
-** ManageSieve connections uses the SASL library by default.
-
-The primary change this brings is support for DIGEST-MD5 and NTLM, when
-the server supports it.
-
-** Gnus includes a password cache mechanism in password-cache.el.
-
-It is enabled by default (see `password-cache'), with a short timeout of
-16 seconds (see `password-cache-expiry'). If PGG is used as the PGP
-back end, the PGP passphrase is managed by this mechanism. Passwords
-for ManageSieve connections are managed by this mechanism, after
-querying the user about whether to do so.
-
-** Using EasyPG with Gnus When EasyPG, is available, Gnus will use it
-instead of PGG. EasyPG is an Emacs user interface to GNU Privacy Guard.
- *Note EasyPG Assistant user's manual: (epa)Top. EasyPG is included in
-Emacs 23 and available separately as well.
-
-\f
-* Changes in group mode
-
-** Old intermediate incoming mail files (`Incoming*') are deleted after a
-couple of days, not immediately. *Note Mail Source Customization::.
-(New in Gnus 5.10.10 / Emacs 22.2)
-
-
-\f
-* Changes in summary and article mode
-
-** Gnus now supports sticky article buffers. Those are article buffers
-that are not reused when you select another article. *Note Sticky
-Articles::.
-
-** Gnus can selectively display `text/html' articles with a WWW browser
-with `K H'. *Note MIME Commands::.
-
-** International host names (IDNA) can now be decoded inside article bodies
-using `W i' (`gnus-summary-idna-message'). This requires that GNU Libidn
-(`http://www.gnu.org/software/libidn/') has been installed.
-
-** The non-ASCII group names handling has been much improved. The back
-ends that fully support non-ASCII group names are now `nntp', `nnml',
-and `nnrss'. Also the agent, the cache, and the marks features work
-with those back ends. *Note Non-ASCII Group Names::.
+ X-Message-SMTP-Method: smtp smtp.fsf.org 587
-** Gnus now displays DNS master files sent as text/dns using dns-mode.
+** Gnus keeps track of non-existent articles for nnimap groups, so
+ that sparse IMAP folders now list a correct number of messages in
+ them.
-** Gnus supports new limiting commands in the Summary buffer: `/ r'
-(`gnus-summary-limit-to-replied') and `/ R'
-(`gnus-summary-limit-to-recipient'). *Note Limiting::.
-
-** You can now fetch all ticked articles from the server using `Y t'
-(`gnus-summary-insert-ticked-articles'). *Note Summary Generation
-Commands::.
-
-** Gnus supports a new sort command in the Summary buffer: `C-c C-s C-t'
-(`gnus-summary-sort-by-recipient'). *Note Summary Sorting::.
-
-** S/MIME now features LDAP user certificate searches. You need to
-configure the server in `smime-ldap-host-list'.
-
-** URLs inside OpenPGP headers are retrieved and imported to your PGP key
-ring when you click on them.
-
-** Picons can be displayed right from the textual address, see
-`gnus-picon-style'. *Note Picons::.
-
-** ANSI SGR control sequences can be transformed using `W A'.
-
-ANSI sequences are used in some Chinese hierarchies for highlighting
-articles (`gnus-article-treat-ansi-sequences').
-
-** Gnus now MIME decodes articles even when they lack "MIME-Version" header.
-This changes the default of `gnus-article-loose-mime'.
-
-** `gnus-decay-scores' can be a regexp matching score files. For example,
-set it to `\\.ADAPT\\'' and only adaptive score files will be decayed.
- *Note Score Decays::.
-
-** Strings prefixing to the `To' and `Newsgroup' headers in summary lines
-when using `gnus-ignored-from-addresses' can be customized with
-`gnus-summary-to-prefix' and `gnus-summary-newsgroup-prefix'. *Note To
-From Newsgroups::.
-
-** You can replace MIME parts with external bodies. See
-`gnus-mime-replace-part' and `gnus-article-replace-part'. *Note MIME
-Commands::, *note Using MIME::.
-
-** The option `mm-fill-flowed' can be used to disable treatment of
-format=flowed messages. Also, flowed text is disabled when sending
-inline PGP signed messages. *Note Flowed text: (emacs-mime)Flowed text.
-(New in Gnus 5.10.7)
-
-** Now the new command `S W' (`gnus-article-wide-reply-with-original') for
-a wide reply in the article buffer yanks a text that is in the active
-region, if it is set, as well as the `R'
-(`gnus-article-reply-with-original') command. Note that the `R' command
-in the article buffer no longer accepts a prefix argument, which was
-used to make it do a wide reply. *Note Article Keymap::.
-
-** The new command `C-h b' (`gnus-article-describe-bindings') used in the
-article buffer now shows not only the article commands but also the real
-summary commands that are accessible from the article buffer.
-
-
-\f
-* Changes in Message mode
+** Gnus will guess the real type of MIME parts of type
+ application/octet-stream based on the file suffix. So an
+ application/octet-stream with a name of "rms.jpg" will be displayed
+ as an image/jpeg type by default, for instance.
-** Gnus now supports the "hashcash" client puzzle anti-spam mechanism. Use
-`(setq message-generate-hashcash t)' to enable. *Note Hashcash::.
-
-** You can now drag and drop attachments to the Message buffer. See
-`mml-dnd-protocol-alist' and `mml-dnd-attach-options'. *Note MIME:
-(message)MIME.
-
-** The option `message-yank-empty-prefix' now controls how empty lines are
-prefixed in cited text. *Note Insertion Variables: (message)Insertion
-Variables.
-
-** Gnus uses narrowing to hide headers in Message buffers. The
-`References' header is hidden by default. To make all headers visible,
-use `(setq message-hidden-headers nil)'. *Note Message Headers:
-(message)Message Headers.
-
-** You can highlight different levels of citations like in the article
-buffer. See `gnus-message-highlight-citation'.
-
-** `auto-fill-mode' is enabled by default in Message mode. See
-`message-fill-column'. *Note Message Headers: (message)Various Message
-Variables.
-
-** You can now store signature files in a special directory named
-`message-signature-directory'.
-
-** The option `message-citation-line-format' controls the format of the
-"Whomever writes:" line. You need to set
-`message-citation-line-function' to
-`message-insert-formatted-citation-line' as well.
-
-\f
-* Changes in back ends
-
-** The nntp back end stores article marks in `~/News/marks'.
-
-The directory can be changed using the (customizable) variable
-`nntp-marks-directory', and marks can be disabled using the (back end)
-variable `nntp-marks-is-evil'. The advantage of this is that you can
-copy `~/News/marks' (using rsync, scp or whatever) to another Gnus
-installation, and it will realize what articles you have read and
-marked. The data in `~/News/marks' has priority over the same data in
-`~/.newsrc.eld'.
-
-** You can import and export your RSS subscriptions from OPML files. *Note
-RSS::.
-
-** IMAP identity (RFC 2971) is supported.
-
-By default, Gnus does not send any information about itself, but you can
-customize it using the variable `nnimap-id'.
-
-** The `nnrss' back end now supports multilingual text. Non-ASCII group
-names for the `nnrss' groups are also supported. *Note RSS::.
-
-** Retrieving mail with POP3 is supported over SSL/TLS and with StartTLS.
-
-** The nnml back end allows other compression programs beside `gzip' for
-compressed message files. *Note Mail Spool::.
-
-** The nnml back end supports group compaction.
-
-This feature, accessible via the functions `gnus-group-compact-group'
-(`G z' in the group buffer) and `gnus-server-compact-server' (`z' in the
-server buffer) renumbers all articles in a group, starting from 1 and
-removing gaps. As a consequence, you get a correct total article count
-(until messages are deleted again).
-
-
-\f
-* Appearance
-
-** The tool bar has been updated to use GNOME icons. You can also
-customize the tool bars: `M-x customize-apropos RET -tool-bar$' should
-get you started. (Only for Emacs, not in XEmacs.)
-
-** The tool bar icons are now (de)activated correctly in the group buffer,
-see the variable `gnus-group-update-tool-bar'. Its default value
-depends on your Emacs version.
-
-** You can change the location of XEmacs' toolbars in Gnus buffers. See
-`gnus-use-toolbar' and `message-use-toolbar'.
-
-
-\f
-* Miscellaneous changes
-
-** Having edited the select-method for the foreign server in the server
-buffer is immediately reflected to the subscription of the groups which
-use the server in question. For instance, if you change
-`nntp-via-address' into `bar.example.com' from `foo.example.com', Gnus
-will connect to the news host by way of the intermediate host
-`bar.example.com' from next time.
-
-** The `all.SCORE' file can be edited from the group buffer using `W e'.
-
-** You can set `gnus-mark-copied-or-moved-articles-as-expirable' to a
-non-`nil' value so that articles that have been read may be marked as
-expirable automatically when copying or moving them to a group that has
-auto-expire turned on. The default is `nil' and copying and moving of
-articles behave as before; i.e., the expirable marks will be unchanged
-except that the marks will be removed when copying or moving articles to
-a group that has not turned auto-expire on. *Note Expiring Mail::.
-
-
-\f
+** `nnimap-inbox' can now be a list of mail box names.
+
* For older news, see Gnus info node "New Features".
----------------------------------------------------------------------
supported, has been removed. Consult older versions of this file if
you are interested in this information.
-The `configure' script uses the configuration name to decide which
-machine and operating system description files `src/config.h' should
-include. The machine description files are all in `src/m', and have
-names similar to, but not identical to, the machine names used in
-configuration names. The operating system files are all in `src/s',
-and are named similarly. See the `configure' script if you need to
-know which configuration names use which machine and operating system
-description files.
+The `configure' script uses the configuration name, and the results of
+testing the system, to decide which options to use in src/config.h and
+elsewhere (eg Makefiles).
If you add support for a new configuration, add a section to this
-file, and then edit the `configure' script to tell it which
-configuration name(s) should select your new machine description and
-system description files.
+file, and edit the `configure.ac' source as needed.
Some obsolete platforms are unsupported beginning with Emacs 23.1. See
the list at the end of this file.
Local Variables:
mode: text
-mode: view
-mode: goto-address
+eval: (view-mode 1)
+eval: (goto-address-mode 1)
End:
This file is part of GNU Emacs.
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2010-2012 Free Software Foundation, Inc.
+Copyright (C) 2010-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
You can narrow news to a specific version by calling `view-emacs-news'
with a prefix argument or by typing C-u C-h C-n.
+Temporary note:
++++ indicates that the appropriate manual has already been updated.
+--- means no change in the manuals is called for.
+When you add a new item, please add it without either +++ or ---
+so we will look at it and add it to the manual.
+
+\f
+* Installation Changes in Emacs 24.3
+
+** New configure option '--without-all' to disable additional 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
+possibly-questionable C code. On a recent GNU system there should be
+no warnings; on older and on non-GNU systems the generated warnings
+may be useful.
+
+** The configure option '--disable-maintainer-mode' has been removed,
+as it was confusingly-named and rarely useful.
+
+---
+** You can use `NO_BIN_LINK=t make install' to prevent the installation
+overwriting "emacs" in the installation bin/ directory with a link
+to emacs-VERSION.
+
+---
+** Emacs uses libtinfo in preference to libncurses, if available.
+
+---
+** On FreeBSD and NetBSD, configure no longer adds /usr/local/lib and
+/usr/pkg/lib to the linker search path. You must add them yourself if
+you want them.
+
+---
+** On Mac OS X, configure no longer automatically adds the Fink /sw
+directories to the search path. You must add them yourself if you want them.
+
+---
+** The standalone scripts rcs-checkin and vcdiff have been removed
+(from the bin and libexec directories, respectively). The former is
+no longer relevant, the latter is replaced by lisp (in vc-sccs.el).
+
+** The configuration option '--enable-use-lisp-union-type' has been
+renamed to '--enable-check-lisp-object-type', as the resulting
+Lisp_Object type no longer uses a union to implement the compile time
+check that this option enables.
+
+---
+** The default toolkit has been changed to Gtk+ version 3.
+If you don't pass --with-x-toolkit to configure or if you pass
+--with-x-toolkit=gtk or --with-x-toolkit=yes, configure will try to build
+with Gtk+ version 3, and if that fails, try Gtk+ version 2.
+You can explicitly require a specific version by passing
+--with-x-toolkit=gtk2 or --with-x-toolkit=gtk3 to configure.
+
+\f
+* 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
+been adding them there, put them somewhere else, eg site-lisp.
+
+---
+** The `--no-site-lisp' command line option now works for Nextstep builds.
+
+\f
+* Changes in Emacs 24.3
+
+** minibuffer-electric-default-mode can rewrite (default ...) to [...].
+Just set minibuffer-eldef-shorten-default to t before enabling the mode.
+
+** Most y-or-n prompts now allow you to scroll the selected window.
+Typing C-v or M-v at a y-or-n prompt scrolls forward or backward
+respectively, without exiting from the prompt.
+
+** In minibuffer filename prompts, `C-M-f' and `C-M-b' now move to the
+next and previous path separator, respectively.
+
+** Mode line changes
+---
+*** New option `mode-line-default-help-echo' specifies the help text
+(shown in a tooltip or in the echo area) for any part of the mode line
+that does not have its own specialized help text.
+
+*** You can now click mouse-3 in the coding system indicator to
+invokes `set-buffer-file-coding-system'.
+
+** Help changes
+
+*** `C-h f' (describe-function) can now perform autoloading.
+When this command is called for an autoloaded function whose docstring
+contains a key substitution construct, that function's library is
+automatically loaded, so that the documentation can be shown
+correctly. To disable this, set `help-enable-auto-load' to nil.
+
+*** `C-h f' now reports previously-autoloaded functions as "autoloaded",
+even after their associated libraries have been loaded (and the
+autoloads have been redefined as functions).
+
+** ImageMagick support, if available, is automatically enabled.
+It is no longer necessary to call `imagemagick-register-types'
+explicitly to install ImageMagick image types; that function is called
+automatically at startup, or when customizing a relevant imagemagick-
+option.
+
+*** Setting `imagemagick-types-inhibit' to t now disables the use of
+ImageMagick to view images. You must call imagemagick-register-types
+afterwards if you do not use customize to change this.
+
+*** The new variable `imagemagick-enabled-types' also affects which
+ImageMagick types are treated as images. The function
+`imagemagick-filter-types' returns the list of types that will be
+treated as images.
+
+*** Images displayed via ImageMagick now support transparency and the
+:background image spec property.
+
+** Server and client changes
+
+*** emacsclient now obeys string values for `initial-buffer-choice',
+if it is told to open a new frame without specifying any file to visit
+or expression to evaluate.
+
+*** New option `server-auth-key' specifies a shared server key.
+
+** In the Package Menu, newly-available packages are listed as "new",
+and sorted above the other "available" packages by default.
+
++++
+** `C-x C-q' is now bound to the new minor mode `read-only-mode'.
+This minor mode replaces `toggle-read-only', which is now obsolete.
+
+** Emacs now generates backtraces on fatal errors.
+On encountering a fatal error, Emacs now outputs a textual description
+of the fatal signal, and a short backtrace on platforms like glibc
+that support backtraces.
+
+** If your Emacs was built from a bzr checkout, the new variable
+`emacs-bzr-version' contains information about the bzr revision used.
+
++++
+** New variable `create-lockfiles' specifies usage of lockfiles.
+It defaults to t. Changing it to nil inhibits the creation of lock
+files (use this with caution).
+
++++
+** Using "unibyte: t" in Lisp source files is obsolete.
+Use "coding: raw-text" instead.
+
++++
+** Setting `enable-remote-dir-locals' to non-nil allows directory
+local variables on remote hosts.
+
+---
+** The entry for PCL-CVS has been removed from the Tools menu.
+The PCL-CVS commands are still available via the keyboard.
+
+** Internationalization changes
+---
+*** New language environment: Persian.
+---
+*** New input method `vietnamese-vni'.
+
+\f
+* Editing Changes in Emacs 24.3
+
++++
+** `C-x 8 RET' is now bound to `insert-char', which is now a command.
+`ucs-insert' is now an obsolete alias for `insert-char'.
+
+---
+** The `z' key no longer has a binding in most special modes.
+It used to be bound to `kill-this-buffer', but `z' is too easy to
+accidentally type.
+
+** New option `delete-trailing-lines' specifies whether
+M-x delete-trailing-whitespace should delete trailing lines at the end
+of the buffer. It defaults to t.
+
+** Search and Replace changes
+
+*** Non-regexp Isearch now performs "lax" space matching.
+Each sequence of spaces in the supplied search string may match any
+sequence of one or more whitespace characters, as specified by the
+variable `search-whitespace-regexp'. (This variable is also used by a
+similar existing feature for regexp Isearch).
+
+*** New Isearch command `M-s SPC' toggles lax space matching.
+This applies to both ordinary and regexp Isearch.
+
+*** New option `replace-lax-whitespace'.
+If non-nil, `query-replace' uses flexible whitespace matching too.
+The default is nil.
+
+*** Global `M-s _' starts a symbol (identifier) incremental search,
+and `M-s _' in Isearch toggles symbol search mode.
+`M-s c' in Isearch toggles search case-sensitivity.
+
+** Register changes
++++
+*** `C-x r +' is now overloaded to invoke `append-to-register.
++++
+*** New option `register-separator' specifies the register containing
+the text to put between collected texts for use with M-x
+append-to-register and M-x prepend-to-register.
+
+** `C-u M-=' now counts lines/words/characters in the entire buffer.
+
+** New binding `M-g c' for `goto-char'.
+
+** M-x move-to-column, if called interactively with no prefix arg, now
+prompts for a column number.
+
+** New command `C-x r M-w' (copy-rectangle-as-kill).
+It copies the region-rectangle as the last rectangle kill.
+
+** New option `yank-handled-properties' allows processing of text
+properties on yanked text, in more ways that are more general than
+just removing them, as done by `yank-excluded-properties'.
+
+\f
+* Changes in Specialized Modes and Packages in Emacs 24.3
+
+** Apropos
+
+*** The faces used by Apropos are now directly customizable.
+These faces are named `apropos-symbol', `apropos-keybinding', and so on;
+see the `apropos' Custom group for details.
+
+**** The old options whose values specified faces to use were removed
+(i.e. `apropos-symbol-face', `apropos-keybinding-face', etc.).
+
+** Buffer Menu
+This package has been rewritten to use Tabulated List mode.
+
+*** Option `Buffer-menu-buffer+size-width' is now obsolete.
+Use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead.
+
+** Calendar
+
+*** You can customize the header text that appears above each calendar month.
+See the variable `calendar-month-header'.
+
+*** The calendars produced by cal-html include holidays.
+Customize cal-html-holidays to change this.
+
+** 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 (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 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.
+
+** Compilation mode
+
+*** New option `compilation-always-kill'.
+
+** Customize
+
+*** `custom-reset-button-menu' now defaults to t.
+
+*** Non-option variables are never matched in `customize-apropos' and
+`customize-apropos-options' (i.e. the prefix argument does nothing for
+these commands now).
+
+** Desktop
+
+*** `desktop-path' no longer includes the "." directory. Desktop
+files are now located in ~/.emacs.d by default.
+
+** D-Bus
+
++++
+*** New variables `dbus-compiled-version' and `dbus-runtime-version'.
+
++++
+*** The D-Bus object manager interface is implemented.
+
++++
+*** Variables of type :(u)int32 and :(u)int64 accept floating points,
+if their value does not fit into Emacs's integer range.
+
++++
+*** The function `dbus-call-method' works non-blocking now, it can be
+interrupted by C-g. `dbus-call-method-non-blocking' is obsolete.
+
++++
+*** Signals can be sent also as unicast message.
+
++++
+*** The argument list of `dbus-register-signal' has been extended,
+according to the new match rule types of D-Bus. See the manual for
+details.
+
++++
+*** `dbus-init-bus' supports private connections.
+
++++
+*** There is a new function `dbus-setenv'.
+
+** Diff mode
+
+*** Changes are now highlighted using the same color scheme as in
+modern VCSes. Deletions are displayed in red (new faces
+`diff-refine-removed' and `smerge-refined-removed' and new definition
+of `diff-removed'), insertions in green (new faces `diff-refine-added'
+and `smerge-refined-added' and new definition of `diff-added').
+
+*** The variable `diff-use-changed-face' defines whether to use the
+face `diff-changed', or `diff-removed' and `diff-added' to highlight
+changes in context diffs.
+
+*** The new command `diff-remove-trailing-whitespace' fixes trailing
+whitespace problems introduced by the diff.
+
+** Dired
+
+*** `dired-do-async-shell-command' executes each file sequentially
+if the command ends in `;' (when operating on multiple files).
+Otherwise, it executes the command on each file in parallel.
+
+*** Typing M-n in the minibuffer of `dired-do-chmod', `dired-do-chgrp',
+`dired-do-chown', `dired-do-touch' pulls the file attributes of the
+file at point.
+
+*** When the region is active, `m' (`dired-mark'), `u' (`dired-unmark'),
+`DEL' (`dired-unmark-backward'), `d' (`dired-flag-file-deletion')
+mark/unmark/flag all files in the active region.
+
+*** The minibuffer default for `=' (`dired-diff) has changed.
+It is now the backup file for the file at point, if one exists.
+In Transient Mark mode the default is the file at the active mark.
+
+*** `M-=' is no longer bound to `dired-backup-diff' in Dired buffers.
+The global binding for `M-=', `count-words-region' is in effect.
+
+** Ediff now uses the same color scheme as Diff mode.
+
+** erc will look up server/channel names via auth-source and use the
+channel keys found, if any.
+
+** Flymake uses fringe bitmaps to indicate errors and warnings.
+See flymake-fringe-indicator-position, flymake-error-bitmap and
+flymake-warning-bitmap.
+
+** Follow mode
+
+*** The obsolete variable `follow-mode-off-hook' has been removed.
+
+*** Follow mode no longer works by using advice.
+The option `follow-intercept-processes' has been removed.
+
+** FFAP
+
+*** The option `ffap-url-unwrap-remote' can now be a list of strings,
+specifying URL types which should be converted to remote file names at
+the FFAP prompt. The default is now '("ftp").
+
+** Ibuffer
+
+*** New `derived-mode' filter, bound to `/ M'.
+The old binding for `/ M' (filter by used-mode) is now bound to `/ m'.
+
+** Mouse Avoidance mode
+
+The new variable `mouse-avoidance-banish-position' can now be used to
+customize Mouse Avoidance mode further.
+
++++
+** notifications.el supports now version 1.2 of the Notifications API.
+The function `notifications-get-capabilities' returns the supported
+server properties.
+
+** In Perl mode, new option `perl-indent-parens-as-block' causes non-block
+closing brackets to be aligned with the line of the opening bracket.
+
+** In Proced mode, new command `proced-renice' renices marked processes.
+
+** Python mode
+
+A new version of python.el, which provides several new features, including:
+per-buffer shells, better indentation, Python 3 support, and improved
+shell-interaction compatible with iPython (and virtually any other
+text based shell).
+
+*** Some user options have been replaced/renamed:
+Old defcustom: | New defcustom:
+python-indent | python-indent-offset
+python-guess-indent | python-indent-guess-indent-offset
+python-pdbtrack-do-tracking-p | python-pdbtrack-activate
+python-use-skeletons | python-skeleton-autoinsert
+
+*** Some user options have been removed:
+
+**** `python-indent-string-contents': Strings are never indented.
+
+**** `python-honour-comment-indentation':
+Comments are never considered as indentation markers themselves.
+
+**** `python-continuation-offset': Indentation is automatically
+calculated in a pep8 compliant way depending on the context.
+
+**** `python-shell-prompt-alist', `python-shell-continuation-prompt-alist':
+Have no direct mapping as the shell interaction is completely different.
+
+**** `python-python-command', `python-jython-command':
+Replaced by `python-shell-interpreter'.
+
+**** `inferior-python-filter-regexp', `python-remove-cwd-from-path',
+`python-pdbtrack-minor-mode-string', `python-source-modes':
+No longer relevant.
+
+*** Some commands have been replaced:
+Old command | New command
+python-insert-class | python-skeleton-class
+python-insert-def | python-skeleton-def
+python-insert-for | python-skeleton-for
+python-insert-if | python-skeleton-if
+python-insert-try/except | python-skeleton-try
+python-insert-try/finally | python-skeleton-try
+python-insert-while | python-skeleton-while
+python-find-function | python-nav-jump-to-defun
+python-next-statement | python-nav-forward-sentence
+python-previous-statement | python-nav-backward-sentence
+python-send-buffer | python-shell-send-buffer
+python-send-defun | python-shell-send-defun
+python-send-region | python-shell-send-region
+python-send-region-and-go | Emulate with python-shell-send-region and
+ python-shell-switch-to-shell
+python-send-string | python-shell-send-string
+python-switch-to-python | python-shell-switch-to-shell
+python-describe-symbol | python-eldoc-at-point
+
+** reStructuredText mode
+
+*** Rebind nearly all keys making room for more keys and complying
+better to usage in other modes. Describe bindings with C-c C-h.
+
+*** Major revision of indentation working very similar to other
+modes. TAB is your friend.
+
+*** Major revision of filling working fine with most of
+reStructuredText syntax. Support auto-filling.
+
+*** Major revision of comment handling.
+
+*** Major revision of fontification working with `jit-lock-mode'.
+
+*** Cover reStructuredText syntax more closely. Improve
+the experience for Sphinx users.
+
+*** `rst-insert-list' inserts new list or continues existing lists.
+
+*** Extend correct and improve customization.
+
+*** Negative prefix argument always works for `rst-adjust'.
+
+*** Reset window configuration after displaying TOC.
+
+*** Package version in `rst-version'.
+
+*** Support `imenu' and `which-func'.
+
+** SH Script mode
+
+*** Pairing of parens/quotes uses electric-pair-mode instead of skeleton-pair.
+
+*** `sh-electric-here-document-mode' now controls auto-insertion of here-docs.
+
+*** `sh-use-smie' lets you choose a new indentation and navigation code.
+
+** Shell
+
+*** New option `async-shell-command-buffer' specifies what buffer to use
+for a new asynchronous shell command when the default output buffer
+`*Async Shell Command*' is already taken by another running command.
+
+** SQL Mode
+
+*** DB2 added `sql-db2-escape-newlines'
+
+If non-nil, newlines sent to the command interpreter will be escaped
+by a backslash. The default does not escape the newlines and assumes
+that the sql statement will be terminated by a semicolon.
+
+** Tabulated List and packages derived from it
+
+*** New command `tabulated-list-sort', bound to `S', sorts the column
+at point, or the Nth column if a numeric prefix argument is given.
+
+** Term
+
+The variables `term-default-fg-color' and `term-default-bg-color' are
+now deprecated in favor of the `term-face' face, that you can
+customize. Also, it is now possible to customize how are displayed the
+ANSI terminal colors and styles by customizing the corresponding
+`term-color-<COLOR>', `term-color-underline' and `term-color-bold'
+faces.
+
+** Tramp
++++
+*** The syntax has been extended in order to allow ad-hoc proxy
+definitions. See the manual for details.
++++
+*** Remote processes are now supported also on remote Windows host.
+
+** URL
+
+*** Structs made by `url-generic-parse-url' have nil `attributes' slot.
+Previously, this slot stored semicolon-separated attribute-value pairs
+appended to some imap URLs, but this is not compatible with RFC 3986.
+So now the `filename' slot stores the entire path and query components
+and the `attributes' slot is always nil.
+
+*** New function `url-encode-url' for encoding a URI string.
+The `url-retrieve' function now uses this to encode its URL argument,
+in case that is not properly encoded.
+
+** VHDL mode
+
+*** The free software compiler GHDL is supported (and now the default).
+
+*** Support for the VHDL-AMS packages has been added/updated.
+
+*** Updated to the 2002 revision of the VHDL standard.
+
+*** Accepts \r and \f as whitespace.
+
+** which-function-mode now applies to all applicable major modes by default.
+
+
+** FIXME something happened to ses.el, 2012-04-17.
+
+
+** Obsolete packages:
+
+*** assoc.el
+In most cases, assoc+member+push+delq work just as well.
+And in any case it's just a terrible package: ugly semantics, terrible
+inefficiency, and not namespace-clean.
+
+*** bruce.el
+
+*** ledit.el
+
+*** mailpost.el
+
+*** mouse-sel.el
+
+*** patcomp.el
+
+*** cust-print.el
+
+\f
+* New Modes and Packages in Emacs 24.3
+\f
+* Incompatible Lisp Changes in Emacs 24.3
+
+** (random) by default now returns a different random sequence in
+every Emacs run. Use (random S), where S is a string, to set the
+random seed to a value based on S, in order to get a repeatable
+sequence in later calls.
+
+** 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.
+Only variables defined using `defcustom' are considered user options.
+The function `user-variable-p' is now an obsolete alias for
+`custom-variable-p'.
+
++++
+** The return values of `defalias', `defun' and `defmacro' have changed,
+and are now undefined. For backwards compatibility, defun and
+defmacro currently return the name of the newly defined function/macro
+but this should not be relied upon.
+
+** `face-spec-set' no longer sets frame-specific attributes when the
+third argument is a frame (that usage was obsolete since Emacs 22.2).
+
++++
+** The arguments of `dbus-register-signal' are no longer just strings,
+but keywords or keyword-string pairs. The old argument list will
+still be supported for Emacs 24.x.
+
+** Spelling changes.
+Some Lisp symbols have been renamed to avoid problems with spelling
+that is incorrect or inconsistent with how Emacs normally spells a word.
+
+*** Renamed functions
+
+**** hangul-input-method-inactivate -> hangul-input-method-deactivate
+**** inactivate-input-method -> deactivate-input-method
+**** quail-inactivate -> quail-deactivate
+**** robin-inactivate -> robin-deactivate
+**** viper-inactivate-input-method -> viper-deactivate-input-method
+**** viper-inactivate-input-method-action ->
+ viper-deactivate-input-method-action
+**** ucs-input-inactivate -> ucs-input-deactivate
+
+*** Renamed hooks
+The old hooks are still supported for backward compatibility, but they
+are deprecated and will be removed eventually.
+
+**** input-method-inactivate-hook -> input-method-deactivate-hook
+**** robin-inactivate-hook -> robin-deactivate-hook
+**** quail-inactivate-hook -> quail-deactivate-hook
+
+*** Renamed Lisp variables
+
+**** follow-deactive-menu -> follow-inactive-menu
+**** inactivate-current-input-method-function ->
+ deactivate-current-input-method-function
+
+** Some obsolete functions and variables were removed:
+
+*** `facemenu-unlisted-faces'
+*** `rmail-decode-mime-charset'
+*** `last-input-char', `last-command-char', `unread-command-char'.
+*** `iswitchb-read-buffer'
+*** `sc-version', `sc-submit-bug-report'
+*** `set-char-table-default'
+*** `string-to-sequence' (use `string-to-list' or `string-to-vector').
+*** `compile-internal'
+*** `mode-line-inverse-video'
+*** `cvs-commit-buffer-require-final-newline'
+(use `'log-edit-require-final-newline'instead)
+*** `cvs-changelog-full-paragraphs'
+(use `log-edit-changelog-full-paragraphs' instead)
+*** `cvs-diff-ignore-marks', `cvs-diff-buffer-name'
+*** `vc-ignore-vc-files' (use `vc-handled-backends' instead)
+*** `vc-master-templates' (use `vc-handled-backends' instead)
+*** `vc-checkout-carefully'
+
+\f
+* Lisp changes in Emacs 24.3
+
+** New sampling-based Elisp profiler.
+Try M-x profiler-start ... M-x profiler-stop; and then M-x profiler-report.
+The sampling rate can be based on CPU time (only supported on some
+systems), or based on memory allocations.
+
+** CL-style generalized variables are now in core Elisp.
+`setf' is autoloaded; `push' and `pop' accept generalized variables.
+
+** `defun' also accepts a (declare DECLS) form, like `defmacro'.
+The interpretation of the DECLS is determined by `defun-declarations-alist'.
+
+** Completion
+
+*** New function `completion-table-with-quoting' to handle completion
+in the presence of quoting, such as file completion in shell buffers.
+
+*** New function `completion-table-subvert' to use an existing completion
+table, but with a different prefix.
+
+** Debugger changes
+
+*** New error type and new function `user-error'.
+These do not trigger the debugger.
+
+*** New option `debugger-bury-or-kill'.
+
+*** Set `debug-on-message' to enter the debugger when a certain
+message is displayed in the echo area. This can be useful when trying
+to work out which code is doing something.
+
+*** New var `inhibit-debugger', automatically set to prevent accidental
+recursive invocations.
+
+** Minibuffer
+
+*** `read-regexp' has a new argument HISTORY; the first argument PROMPT
+of `read-regexp' accepts a string ending with a colon and space, and its
+second argument DEFAULTS can be a list of strings accessible via M-n
+in the minibuffer ahead of other hard-coded useful regexp-related values.
+More commands use `read-regexp' now to read their regexp arguments.
+
+** 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.
+
+*** Additional values recognized for option `window-combination-limit'.
+
+*** New macro `with-temp-buffer-window'.
+
+*** New options `temp-buffer-resize-frames' and
+`temp-buffer-resize-regexps'.
+
+*** `temp-buffer-resize-mode' no longer resizes windows that have been
+reused.
+
+*** New function `fit-frame-to-buffer' and new option
+`fit-frame-to-buffer-bottom-margin'.
+
+*** New display action functions `display-buffer-below-selected',
+`display-buffer-at-bottom' and `display-buffer-in-previous-window'.
+
+*** New display action alist entry `inhibit-switch-frame', if non-nil,
+tells display action functions to avoid changing which frame is
+selected.
+
+*** New display action alist entry `pop-up-frame-parameters', if
+non-nil, specifies frame parameters to give any newly-created frame.
+
+*** New display action alist entry `previous-window', if non-nil,
+specifies window to reuse in `display-buffer-in-previous-window'.
+
+*** The following variables are obsolete, as they can be replaced by
+appropriate entries in the `display-buffer-alist' function introduced
+in Emacs 24.1:
++++
+**** `display-buffer-reuse-frames'
+**** `special-display-regexps'
+**** `special-display-frame-alist'
+**** `special-display-buffer-names'
+**** `special-display-function'
+**** `display-buffer-function'
+
+** Time
+
+*** `current-time-string' no longer requires that its argument's year
+must be in the range 1000..9999. It now works with any year supported
+by the underlying C implementation.
+
+*** `current-time' now returns extended-format time stamps
+(HIGH LOW USEC PSEC), where the new PSEC slot specifies picoseconds.
+PSEC is typically a multiple of 1000 on current machines. Other
+functions that use this format, such as file-attributes and
+format-time-string, have been changed accordingly. Old-format time
+stamps are still accepted.
+
+*** The format of timers in timer-list and timer-idle-list is now
+[TRIGGERED-P HI-SECS LO-SECS USECS REPEAT-DELAY FUNCTION ARGS IDLE-DELAY PSECS].
+The PSECS slot is new, and uses picosecond resolution. It can be
+accessed via the new timer--psecs accessor.
+
+** Floating point functions now always return special values like NaN,
+instead of signaling errors, if given invalid args, e.g. (log -1.0).
+Previously, they returned NaNs on some platforms but signaled errors
+on others. The affected functions are acos, asin, tan, exp, expt,
+log, log10, sqrt, and mod.
+
+** Interpreted files are eagerly macro-expanded during load.
+This can significantly speed up execution of non-byte-compiled code,
+but can also bump into harmless and previously unnoticed cyclic
+dependencies. These should not be fatal: they will simply cause the
+macro-calls to be left for later expansion (as before), but will also
+result in a warning describing the cycle.
+
+** Misc new functions:
+
+*** `autoloadp'
+*** `autoload-do-load'.
+*** `buffer-narrowed-p' tests if the buffer is narrowed.
+*** `file-name-base' returns a file name sans directory and extension.
+*** `function-get' fetches a function property, following aliases.
+*** `posnp' tests if an object is a `posn'.
+*** `set-temporary-overlay-map' sets up a temporary overlay map.
+*** `system-users' returns the user names on the system.
+*** `system-groups' returns the group names on the system.
+*** `tty-top-frame' returns the topmost frame of a text terminal.
+
+** New macros `setq-local' and `defvar-local'.
+
+** New fringe bitmap exclamation-mark.
+
+** Face underlining can now use a wave.
+See the "Face Attributes" section of the Elisp manual.
+
+** The following functions and variables are obsolete:
+
+*** `automount-dir-prefix'
+*** `buffer-has-markers-at'
+*** `macro-declaration-function' (use `macro-declarations-alist').
+*** `window-system-version'
+
+\f
+* Changes in Emacs 24.3 on non-free operating systems
+
+** New configure.bat options on MS-Windows:
+
+*** --without-libxml2 omits support for libxml2, even if its presence
+is detected.
+
+** When invoked with the -nw switch to run on the Windows text-mode terminal,
+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.
\f
* Changes in Emacs 24.2
in your ~/.authinfo file instead.
+*** SMTPmail defaults to using the address in the From: header as the
+SMTP MAIL FROM envelope. To override this, set `mail-envelope-from'
+to the address you wish to use instead.
+
** SQL mode
*** New options `sql-port', `sql-connection-alist', `sql-send-terminator',
:PROPERTIES:
:OrgVersion: 7.4
:END:
-
+
The variable =org-agenda-ndays= is obsolete - please use
=org-agenda-span= instead.
:OrgVersion: 7.5
:END:
- You can now create links from messages. This is particularily
+ You can now create links from messages. This is particularly
useful when the user wants to stored messages that he sends, for
later check. Thanks to Ulf Stegemann for the patch.
: Percent escaping is used in Org mode to escape certain characters
: in links that would either break the parser (e.g. square brackets
-: in link target oder description) or are not allowed to appear in
+: in link target or description) or are not allowed to appear in
: a particular link type (e.g. non-ascii characters in a http:
: link).
:
** Completion
-*** In-buffer completion is now done using John Wiegleys pcomplete.el
+*** In-buffer completion is now done using John Wiegley's pcomplete.el
:PROPERTIES:
:OrgVersion: 7.4
:END:
the `flock' system call. The other involves creating a lock file;
`movemail' must be able to write in /usr/spool/mail in order to do
this. You control which one is used by defining, or not defining,
-the macro MAIL_USE_FLOCK in config.h or the m/ or s/ file it includes.
+the macro MAIL_USE_FLOCK in config.h.
IF YOU DON'T USE THE FORM OF INTERLOCKING THAT IS NORMAL ON YOUR
SYSTEM, YOU CAN LOSE MAIL!
#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
with +t bit, the directory owner becomes the owner of the symbolic
link, so that it cannot be removed by anyone else.
-If you don't like those useless links, you can let Emacs not to using
-file lock by adding #undef CLASH_DETECTION to config.h.
+If you don't like those useless links, you can customize
+the option `create-lockfiles'.
*** FreeBSD: Getting a Meta key on the console.
*** The dumped Emacs crashes when run, trying to write pure data.
-Two causes have been seen for such problems.
-
-1) On a system where getpagesize is not a system call, it is defined
+On a system where getpagesize is not a system call, it is defined
as a macro. If the definition (in both unex*.c and malloc.c) is wrong,
it can cause problems like this. You might be able to find the correct
value in the man page for a.out (5).
-2) Some systems allocate variables declared static among the
-initialized variables. Emacs makes all initialized variables in most
-of its files pure after dumping, but the variables declared static and
-not initialized are not supposed to be pure. On these systems you
-may need to add "#define static" to config.h.
-
* Runtime problems on legacy systems
This section covers bugs reported on very old hardware or software.
pen@lysator.liu.se says (Feb 1998) that the Compose key does work
if you link with the MIT X11 libraries instead of the Solaris X11 libraries.
-*** HP/UX 10: Large file support is disabled.
-(HP/UX 10 was end-of-lifed in May 1999.)
-See the comments in src/s/hpux10-20.h.
-
*** HP/UX: Emacs is slow using X11R5.
This happens if you use the MIT versions of the X libraries--it
The `contents' field of a Lisp vector is an array of Lisp_Objects,
so you may see the problem happening with indexed references to that.
-** 68000 C compiler problems
-
-Various 68000 compilers have different problems.
-These are some that have been observed.
-
-*** Using value of assignment expression on union type loses.
-This means that x = y = z; or foo (x = z); does not work
-if x is of type Lisp_Object.
-
-*** "cannot reclaim" error.
-
-This means that an expression is too complicated. You get the correct
-line number in the error message. The code must be rewritten with
-simpler expressions.
-
-*** XCONS, XSTRING, etc macros produce incorrect code.
-
-If temacs fails to run at all, this may be the cause.
-Compile this test program and look at the assembler code:
-
-struct foo { char x; unsigned int y : 24; };
-
-lose (arg)
- struct foo arg;
-{
- test ((int *) arg.y);
-}
-
-If the code is incorrect, your compiler has this problem.
-In the XCONS, etc., macros in lisp.h you must replace (a).u.val with
-((a).u.val + coercedummy) where coercedummy is declared as int.
-
-This problem will only happen if USE_LISP_UNION_TYPE is manually
-defined in lisp.h.
-
-** C compilers lose on returning unions.
-
-I hear that some C compilers cannot handle returning a union type.
-Most of the functions in GNU Emacs return type Lisp_Object, which is
-defined as a union on some rare architectures.
-
-This problem will only happen if USE_LISP_UNION_TYPE is manually
-defined in lisp.h.
-
\f
This file is part of GNU Emacs.
Emacs TODO List -*-outline-*-
-Copyright (C) 2001-2012 Free Software Foundation, Inc.
+Copyright (C) 2001-2012 Free Software Foundation, Inc.
See the end of the file for license conditions.
"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,
and expand.el (any other?) and then advertise/use/improve it.
** Improve VC: yes, there's a lot of work to be done there :-(
- And most of it could/should make it into Emacs-23.3.
** Random things that cross my mind right now that I'd like to see (some of
them from my local hacks), but it's not obvious at all whether they'll
** Highlight rectangles (`mouse-track-rectangle-p' in XEmacs). Already in CUA,
but it's a valuable feature worth making more general.
-** Provide MIME support for Rmail using the Gnus MIME library. [Maybe
- not now feasible, given Gnus maintenance decisions. fx looked at
- this and can say where some of the problems are.]
-
** Eliminate the storm of warnings concerning char/unsigned char
mismatches that we get with GCC 4.x and proprietary compilers on
various systems. They make it difficult to spot the important warnings.
** Fix anything necessary to use `long long' EMACS_INTs with GCC.
-** Split out parts of lisp.h [and generate Makefile dependencies automatically.]
-[the last bit is done, see DEPFLAGS etc in src/Makefile.in ]
+** Split out parts of lisp.h.
** Update the FAQ.
artist, ansi-color, array, battery, calculator, cdl, cmuscheme,
completion, cua, delim-col, dirtrack, double, echistory, elide-head,
easymenu, expand, flow-ctrl, format [format-alist],
- generic/generic-x [various modes], kermit, log-edit, ledit
- [obsolete?], makesum, midnight [other than in Kill Buffer node],
+ generic/generic-x [various modes], kermit, log-edit,
+ makesum, midnight [other than in Kill Buffer node],
mouse-copy [?], mouse-drag, mouse-sel, net-utils, rcompile,
snmp-mode [?], soundex [should be interactive?], strokes [start from
the web page], talk, thingatpt [interactive functions?], type-break,
- vcursor, xscheme, zone-mode [?], mlconvert [?], iso-cvt, iso-swed,
- swedish, feedmail [?], uce, bruce, gametree, meese, page-ext,
+ vcursor, xscheme, zone-mode [?], mlconvert [?], iso-cvt,
+ feedmail [?], uce, gametree, meese, page-ext,
refbib, refer, scribe, sgml-mode, spell, texinfo, underline,
- cmacexp, hideif, mantemp [obsolete?], pcomplete, assoc, xml,
+ cmacexp, hideif, mantemp [obsolete?], pcomplete, xml,
cvs-status (should be described in PCL-CVS manual); other progmodes,
probably in separate manual.
*** Bugs
+**** The event loop relies on polling and that hurts performance.
+ A better strategy is to have the select part in its own thread and let
+ the main thread communicate with that thread (see how Gdk does it for
+ inspiration). A problem is that redraw don't happen during resize,
+ because we can't break out from the NSapp loop during resize.
+ There is a special trick to detect mouse press in the lower right
+ corner and track mouse movements, but this does not work well, and is
+ not scalable to the new Lion "resize on every window edge" behavior.
+
**** (mouse-avoidance-mode 'banish) then minimize Emacs, will pop window back
up on top of all others
this.]
** Rewrite make-docfile to be clean and maintainable.
+ It might be better to replace it with Lisp, using the byte compiler.
+ http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00037.html
** Add an inferior-comint-minor-mode to capture the common set of operations
offered by major modes that offer an associated inferior
For use by sml-mode, python-mode, tex-mode, scheme-mode, lisp-mode,
haskell-mode, tuareg-mode, ...
-** Make SYNC_INPUT the default. [true since 2008-03-11]
- All loops using immediate_quit need to be checked to ensure that
- C-g can interrupt them, in case of an infinite loop. Once we
- switch to using SYNC_INPUT, we can remove the BLOCK_INPUTs in the
- allocation functions (allocate_string etc.) without worrying about
- data munging.
-
** Add "link" button class
Add a standard button-class named "link", and make all other link-like
button classes inherit from it. Set the default face of the "link" button
class to the standard "link" face.
+* Wishlist items:
+
+** Maybe replace etags.c with a Lisp implementation.
+http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00354.html
+
+** Maybe replace lib-src/rcs2log with a Lisp implementation.
+It wouldn't have to be a complete replacement, just enough
+for vc-rcs-update-changelog.
+
* Other known bugs:
** `make-frame' forgets unhandled parameters, at least for X11 frames.
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x2121 0x1200
0x2122 0x1201
0x2123 0x1202
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x20 0x0069
0x21 0x026A
0x22 0x0065
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x0901
0x22 0x0902
0x23 0x0903
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x1EAF
0x22 0x1EB1
0x23 0x1EB7
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x0101
0x22 0x00E1
0x23 0x01CE
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x2130 0x0F00
0x2131 0x0F01
0x2132 0x0F02
-# Generated by running amdin/charsets/mule-charsets.el in Emacs 22.3.
+# Generated by running admin/charsets/mule-charsets.el in Emacs 22.3.
0x21 0x1EAE
0x22 0x1EB0
0x23 0x1EB6
# Code:
-# Force loading of symbols, enough to give us gdb_valbits etc.
+# Force loading of symbols, enough to give us VALMASK etc.
set main
# When nonzero, display some extra diagnostics in various commands
set $yverbose = 1
set $yfile_buffers_only = 0
-set $tagmask = (((long)1 << gdb_gctypebits) - 1)
-# The consing_since_gc business widens the 1 to EMACS_INT,
-# a symbol not directly visible to GDB.
-set $valmask = gdb_use_lsb ? ~($tagmask) : ((consing_since_gc - consing_since_gc + 1) << gdb_valbits) - 1
-
define ygetptr
set $ptr = $arg0
- set $ptr = (gdb_use_union ? $ptr.u.val : $ptr & $valmask) | gdb_data_seg_bits
+ set $ptr = ((CHECK_LISP_OBJECT_TYPE ? $ptr.i : $ptr) & VALMASK) | DATA_SEG_BITS
end
define ybuffer-list
+++ /dev/null
-"""Wrapper for version-specific implementations of python.el helper
-functions """
-
-import sys
-
-if sys.version_info[0] == 3:
- from emacs3 import *
-else:
- from emacs2 import *
-
+++ /dev/null
-"""Definitions used by commands sent to inferior Python in python.el."""
-
-# Copyright (C) 2004-2012 Free Software Foundation, Inc.
-# Author: Dave Love <fx@gnu.org>
-
-# 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 <http://www.gnu.org/licenses/>.
-
-import os, sys, traceback, inspect, __main__
-
-try:
- set
-except:
- from sets import Set as set
-
-__all__ = ["eexecfile", "eargs", "complete", "ehelp", "eimport", "modpath"]
-
-def format_exception (filename, should_remove_self):
- type, value, tb = sys.exc_info ()
- sys.last_type = type
- sys.last_value = value
- sys.last_traceback = tb
- if type is SyntaxError:
- try: # parse the error message
- msg, (dummy_filename, lineno, offset, line) = value
- except:
- pass # Not the format we expect; leave it alone
- else:
- # Stuff in the right filename
- value = SyntaxError(msg, (filename, lineno, offset, line))
- sys.last_value = value
- res = traceback.format_exception_only (type, value)
- # There are some compilation errors which do not provide traceback so we
- # should not massage it.
- if should_remove_self:
- tblist = traceback.extract_tb (tb)
- del tblist[:1]
- res = traceback.format_list (tblist)
- if res:
- res.insert(0, "Traceback (most recent call last):\n")
- res[len(res):] = traceback.format_exception_only (type, value)
- # traceback.print_exception(type, value, tb)
- for line in res: print line,
-
-def eexecfile (file):
- """Execute FILE and then remove it.
- Execute the file within the __main__ namespace.
- If we get an exception, print a traceback with the top frame
- (ourselves) excluded."""
- # We cannot use real execfile since it has a bug where the file stays
- # locked forever (under w32) if SyntaxError occurs.
- # --- code based on code.py and PyShell.py.
- try:
- try:
- source = open (file, "r").read()
- code = compile (source, file, "exec")
- # Other exceptions (shouldn't be any...) will (correctly) fall
- # through to "final".
- except (OverflowError, SyntaxError, ValueError):
- # FIXME: When can compile() raise anything else than
- # SyntaxError ????
- format_exception (file, False)
- return
- try:
- exec code in __main__.__dict__
- except:
- format_exception (file, True)
- finally:
- os.remove (file)
-
-def eargs (name, imports):
- "Get arglist of NAME for Eldoc &c."
- try:
- if imports: exec imports
- parts = name.split ('.')
- if len (parts) > 1:
- exec 'import ' + parts[0] # might fail
- func = eval (name)
- if inspect.isbuiltin (func) or type(func) is type:
- doc = func.__doc__
- if doc.find (' ->') != -1:
- print '_emacs_out', doc.split (' ->')[0]
- else:
- print '_emacs_out', doc.split ('\n')[0]
- return
- if inspect.ismethod (func):
- func = func.im_func
- if not inspect.isfunction (func):
- print '_emacs_out '
- return
- (args, varargs, varkw, defaults) = inspect.getargspec (func)
- # No space between name and arglist for consistency with builtins.
- print '_emacs_out', \
- func.__name__ + inspect.formatargspec (args, varargs, varkw,
- defaults)
- except:
- print "_emacs_out "
-
-def all_names (object):
- """Return (an approximation to) a list of all possible attribute
- names reachable via the attributes of OBJECT, i.e. roughly the
- leaves of the dictionary tree under it."""
-
- def do_object (object, names):
- if inspect.ismodule (object):
- do_module (object, names)
- elif inspect.isclass (object):
- do_class (object, names)
- # Might have an object without its class in scope.
- elif hasattr (object, '__class__'):
- names.add ('__class__')
- do_class (object.__class__, names)
- # Probably not a good idea to try to enumerate arbitrary
- # dictionaries...
- return names
-
- def do_module (module, names):
- if hasattr (module, '__all__'): # limited export list
- names.update(module.__all__)
- for i in module.__all__:
- do_object (getattr (module, i), names)
- else: # use all names
- names.update(dir (module))
- for i in dir (module):
- do_object (getattr (module, i), names)
- return names
-
- def do_class (object, names):
- ns = dir (object)
- names.update(ns)
- if hasattr (object, '__bases__'): # superclasses
- for i in object.__bases__: do_object (i, names)
- return names
-
- return do_object (object, set([]))
-
-def complete (name, imports):
- """Complete TEXT in NAMESPACE and print a Lisp list of completions.
- Exec IMPORTS first."""
- import __main__, keyword
-
- def class_members(object):
- names = dir (object)
- if hasattr (object, '__bases__'):
- for super in object.__bases__:
- names = class_members (super)
- return names
-
- names = set([])
- base = None
- try:
- dict = __main__.__dict__.copy()
- if imports: exec imports in dict
- l = len (name)
- if not "." in name:
- for src in [dir (__builtins__), keyword.kwlist, dict.keys()]:
- for elt in src:
- if elt[:l] == name: names.add(elt)
- else:
- base = name[:name.rfind ('.')]
- name = name[name.rfind('.')+1:]
- try:
- object = eval (base, dict)
- names = set(dir (object))
- if hasattr (object, '__class__'):
- names.add('__class__')
- names.update(class_members (object))
- except: names = all_names (dict)
- except:
- print sys.exc_info()
- names = []
-
- l = len(name)
- print '_emacs_out (',
- for n in names:
- if name == n[:l]:
- if base: print '"%s.%s"' % (base, n),
- else: print '"%s"' % n,
- print ')'
-
-def ehelp (name, imports):
- """Get help on string NAME.
- First try to eval name for, e.g. user definitions where we need
- the object. Otherwise try the string form."""
- locls = {}
- if imports:
- try: exec imports in locls
- except: pass
- try: help (eval (name, globals(), locls))
- except: help (name)
-
-def eimport (mod, dir):
- """Import module MOD with directory DIR at the head of the search path.
- NB doesn't load from DIR if MOD shadows a system module."""
- from __main__ import __dict__
-
- path0 = sys.path[0]
- sys.path[0] = dir
- try:
- try:
- if __dict__.has_key(mod) and inspect.ismodule (__dict__[mod]):
- reload (__dict__[mod])
- else:
- __dict__[mod] = __import__ (mod)
- except:
- (type, value, tb) = sys.exc_info ()
- print "Traceback (most recent call last):"
- traceback.print_exception (type, value, tb.tb_next)
- finally:
- sys.path[0] = path0
-
-def modpath (module):
- """Return the source file for the given MODULE (or None).
-Assumes that MODULE.py and MODULE.pyc are in the same directory."""
- try:
- path = __import__ (module).__file__
- if path[-4:] == '.pyc' and os.path.exists (path[0:-1]):
- path = path[:-1]
- print "_emacs_out", path
- except:
- print "_emacs_out ()"
-
-# print '_emacs_ok' # ready for input and can call continuation
-
+++ /dev/null
-# Copyright (C) 2004-2012 Free Software Foundation, Inc.
-# Author: Dave Love <fx@gnu.org>
-
-# 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 <http://www.gnu.org/licenses/>.
-
-import os, sys, traceback, inspect, imp, __main__
-
-try:
- set
-except:
- from sets import Set as set
-
-__all__ = ["eexecfile", "eargs", "complete", "ehelp", "eimport", "modpath"]
-
-def format_exception (filename, should_remove_self):
- type, value, tb = sys.exc_info ()
- sys.last_type = type
- sys.last_value = value
- sys.last_traceback = tb
- if type is SyntaxError:
- try: # parse the error message
- msg, (dummy_filename, lineno, offset, line) = value
- except:
- pass # Not the format we expect; leave it alone
- else:
- # Stuff in the right filename
- value = SyntaxError(msg, (filename, lineno, offset, line))
- sys.last_value = value
- res = traceback.format_exception_only (type, value)
- # There are some compilation errors which do not provide traceback so we
- # should not massage it.
- if should_remove_self:
- tblist = traceback.extract_tb (tb)
- del tblist[:1]
- res = traceback.format_list (tblist)
- if res:
- res.insert(0, "Traceback (most recent call last):\n")
- res[len(res):] = traceback.format_exception_only (type, value)
- # traceback.print_exception(type, value, tb)
- for line in res: print(line, end=' ')
-
-def eexecfile (file):
- """Execute FILE and then remove it.
- Execute the file within the __main__ namespace.
- If we get an exception, print a traceback with the top frame
- (ourselves) excluded."""
- # We cannot use real execfile since it has a bug where the file stays
- # locked forever (under w32) if SyntaxError occurs.
- # --- code based on code.py and PyShell.py.
- try:
- try:
- source = open (file, "r").read()
- code = compile (source, file, "exec")
- # Other exceptions (shouldn't be any...) will (correctly) fall
- # through to "final".
- except (OverflowError, SyntaxError, ValueError):
- # FIXME: When can compile() raise anything else than
- # SyntaxError ????
- format_exception (file, False)
- return
- try:
- exec(code, __main__.__dict__)
- except:
- format_exception (file, True)
- finally:
- os.remove (file)
-
-def eargs (name, imports):
- "Get arglist of NAME for Eldoc &c."
- try:
- if imports: exec(imports)
- parts = name.split ('.')
- if len (parts) > 1:
- exec('import ' + parts[0]) # might fail
- func = eval (name)
- if inspect.isbuiltin (func) or type(func) is type:
- doc = func.__doc__
- if doc.find (' ->') != -1:
- print('_emacs_out', doc.split (' ->')[0])
- else:
- print('_emacs_out', doc.split ('\n')[0])
- return
- if inspect.ismethod (func):
- func = func.im_func
- if not inspect.isfunction (func):
- print('_emacs_out ')
- return
- (args, varargs, varkw, defaults) = inspect.getargspec (func)
- # No space between name and arglist for consistency with builtins.
- print('_emacs_out', \
- func.__name__ + inspect.formatargspec (args, varargs, varkw,
- defaults))
- except:
- print("_emacs_out ")
-
-def all_names (object):
- """Return (an approximation to) a list of all possible attribute
- names reachable via the attributes of OBJECT, i.e. roughly the
- leaves of the dictionary tree under it."""
-
- def do_object (object, names):
- if inspect.ismodule (object):
- do_module (object, names)
- elif inspect.isclass (object):
- do_class (object, names)
- # Might have an object without its class in scope.
- elif hasattr (object, '__class__'):
- names.add ('__class__')
- do_class (object.__class__, names)
- # Probably not a good idea to try to enumerate arbitrary
- # dictionaries...
- return names
-
- def do_module (module, names):
- if hasattr (module, '__all__'): # limited export list
- names.update(module.__all__)
- for i in module.__all__:
- do_object (getattr (module, i), names)
- else: # use all names
- names.update(dir (module))
- for i in dir (module):
- do_object (getattr (module, i), names)
- return names
-
- def do_class (object, names):
- ns = dir (object)
- names.update(ns)
- if hasattr (object, '__bases__'): # superclasses
- for i in object.__bases__: do_object (i, names)
- return names
-
- return do_object (object, set([]))
-
-def complete (name, imports):
- """Complete TEXT in NAMESPACE and print a Lisp list of completions.
- Exec IMPORTS first."""
- import __main__, keyword
-
- def class_members(object):
- names = dir (object)
- if hasattr (object, '__bases__'):
- for super in object.__bases__:
- names = class_members (super)
- return names
-
- names = set([])
- base = None
- try:
- dict = __main__.__dict__.copy()
- if imports: exec(imports, dict)
- l = len (name)
- if not "." in name:
- for src in [dir (__builtins__), keyword.kwlist, list(dict.keys())]:
- for elt in src:
- if elt[:l] == name: names.add(elt)
- else:
- base = name[:name.rfind ('.')]
- name = name[name.rfind('.')+1:]
- try:
- object = eval (base, dict)
- names = set(dir (object))
- if hasattr (object, '__class__'):
- names.add('__class__')
- names.update(class_members (object))
- except: names = all_names (dict)
- except:
- print(sys.exc_info())
- names = []
-
- l = len(name)
- print('_emacs_out (', end=' ')
- for n in names:
- if name == n[:l]:
- if base: print('"%s.%s"' % (base, n), end=' ')
- else: print('"%s"' % n, end=' ')
- print(')')
-
-def ehelp (name, imports):
- """Get help on string NAME.
- First try to eval name for, e.g. user definitions where we need
- the object. Otherwise try the string form."""
- locls = {}
- if imports:
- try: exec(imports, locls)
- except: pass
- try: help (eval (name, globals(), locls))
- except: help (name)
-
-def eimport (mod, dir):
- """Import module MOD with directory DIR at the head of the search path.
- NB doesn't load from DIR if MOD shadows a system module."""
- from __main__ import __dict__
-
- path0 = sys.path[0]
- sys.path[0] = dir
- try:
- try:
- if mod in __dict__ and inspect.ismodule (__dict__[mod]):
- imp.reload (__dict__[mod])
- else:
- __dict__[mod] = __import__ (mod)
- except:
- (type, value, tb) = sys.exc_info ()
- print("Traceback (most recent call last):")
- traceback.print_exception (type, value, tb.tb_next)
- finally:
- sys.path[0] = path0
-
-def modpath (module):
- """Return the source file for the given MODULE (or None).
-Assumes that MODULE.py and MODULE.pyc are in the same directory."""
- try:
- path = __import__ (module).__file__
- if path[-4:] == '.pyc' and os.path.exists (path[0:-1]):
- path = path[:-1]
- print("_emacs_out", path)
- except:
- print("_emacs_out ()")
-
-# print '_emacs_ok' # ready for input and can call continuation
-
--- /dev/null
+This directory contains some example files for the forms.el library.
-;;; forms-d2.el --- demo forms-mode -*- no-byte-compile: t -*-
+;;; forms-d2.el --- demo forms-mode
;; Copyright (C) 1991, 1994-1997, 2001-2012 Free Software Foundation, Inc.
;;; Code:
;; Set the name of the data file.
-(setq forms-file (expand-file-name "forms-d2.dat" data-directory))
+(setq forms-file (expand-file-name "forms/forms-d2.dat" data-directory))
;; Use 'forms-enumerate' to set field names and number thereof.
(setq forms-number-of-fields
-;;; forms-pass.el --- passwd file demo for forms-mode -*- no-byte-compile: t -*-
+;;; forms-pass.el --- passwd file demo for forms-mode
;; This file is part of GNU Emacs.
P.S. You'll be pleased to know that since (time-forward N) still works
- for N >= 0, we've used it to pre-emptively update configure.in.
+ for N >= 0, we've used it to pre-emptively update configure.ac.
Emacs now configures and builds on every platform that will ever
be made. It wasn't easy, but at least that's one problem out of
the way for good. If you'd like the patch, just ask.
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-->
-<!-- Created with Inkscape (http://www.inkscape.org/) -->
+
<svg
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:cc="http://creativecommons.org/ns#"
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:xlink="http://www.w3.org/1999/xlink"
- xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
- xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
- id="svg6706"
- sodipodi:version="0.32"
- inkscape:version="0.46"
- width="271"
- height="217"
version="1.0"
- sodipodi:docname="splash.svg"
- inkscape:label="fg"
- inkscape:output_extension="org.inkscape.output.svg.inkscape"
- sodipodi:docbase="/home/rocher/local/fret/devel/emacs/etc/images"
+ width="275.96875"
+ height="190.40625"
+ id="svg6706"
style="display:inline">
<metadata
id="metadata2314">
<dc:format>image/svg+xml</dc:format>
<dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
- <dc:title>splash</dc:title>
+ <dc:title></dc:title>
<dc:date>2008/06/28</dc:date>
<dc:creator>
<cc:Agent>
</metadata>
<defs
id="defs6709">
- <inkscape:perspective
- sodipodi:type="inkscape:persp3d"
- inkscape:vp_x="0 : 108.5 : 1"
- inkscape:vp_y="0 : 1000 : 0"
- inkscape:vp_z="271 : 108.5 : 1"
- inkscape:persp3d-origin="135.5 : 72.333333 : 1"
- id="perspective2498" />
- <linearGradient
- id="linearGradient2558">
- <stop
- style="stop-color:#000000;stop-opacity:1;"
- offset="0"
- id="stop2560" />
- <stop
- style="stop-color:#000000;stop-opacity:1;"
- offset="1"
- id="stop2562" />
- </linearGradient>
<linearGradient
id="linearGradient2550">
<stop
- style="stop-color:#2997f6;stop-opacity:0.78431374;"
- offset="0"
- id="stop2552" />
+ id="stop2552"
+ style="stop-color:#4c94f1;stop-opacity:0.78431374"
+ offset="0" />
<stop
- style="stop-color:#2997f6;stop-opacity:0.78431374;"
- offset="1"
- id="stop2554" />
- </linearGradient>
- <linearGradient
- id="linearGradient8019">
- <stop
- style="stop-color:#000000;stop-opacity:1;"
- offset="0"
- id="stop8021" />
- <stop
- style="stop-color:#000000;stop-opacity:1;"
- offset="1"
- id="stop8023" />
+ id="stop2554"
+ style="stop-color:#4c94f1;stop-opacity:0.78431374"
+ offset="1" />
</linearGradient>
<linearGradient
id="linearGradient7896">
<stop
- style="stop-color:#fc644b;stop-opacity:0.78431374;"
- offset="0"
- id="stop7898" />
+ id="stop7898"
+ style="stop-color:#fc644b;stop-opacity:0.78431374"
+ offset="0" />
<stop
- style="stop-color:#fc644b;stop-opacity:0.78431374;"
- offset="1"
- id="stop7900" />
+ id="stop7900"
+ style="stop-color:#fc644b;stop-opacity:0.78431374"
+ offset="1" />
</linearGradient>
<linearGradient
- inkscape:collect="always"
xlink:href="#linearGradient2550"
id="linearGradient2556"
x1="147.62743"
y2="203.60176"
gradientUnits="userSpaceOnUse" />
<linearGradient
- inkscape:collect="always"
- xlink:href="#linearGradient2558"
- id="linearGradient2564"
- x1="130.93193"
- y1="92.09787"
- x2="129.53438"
- y2="203.60176"
- gradientUnits="userSpaceOnUse" />
- <linearGradient
- inkscape:collect="always"
- xlink:href="#linearGradient7896"
- id="linearGradient2567"
- gradientUnits="userSpaceOnUse"
- x1="148.13887"
- y1="145.57669"
- x2="179.22762"
- y2="44.272839"
- gradientTransform="translate(-2.4002643e-7,-2.6398943e-6)" />
- <linearGradient
- inkscape:collect="always"
- xlink:href="#linearGradient8019"
- id="linearGradient2569"
- gradientUnits="userSpaceOnUse"
- gradientTransform="translate(0.3535448,0.3535474)"
- x1="91.959305"
- y1="48.593826"
- x2="74.102982"
- y2="153.43918" />
- <linearGradient
- inkscape:collect="always"
xlink:href="#linearGradient7896"
id="linearGradient2425"
gradientUnits="userSpaceOnUse"
y1="0.92070419"
x2="147.12886"
y2="211.99936" />
- <linearGradient
- inkscape:collect="always"
- xlink:href="#linearGradient8019"
- id="linearGradient2427"
- gradientUnits="userSpaceOnUse"
- gradientTransform="translate(0.3535448,0.3535474)"
- x1="131.99864"
- y1="0.56715417"
- x2="131.99864"
- y2="211.64581" />
</defs>
- <sodipodi:namedview
- inkscape:window-height="973"
- inkscape:window-width="1280"
- inkscape:pageshadow="2"
- inkscape:pageopacity="0"
- guidetolerance="10.0"
- gridtolerance="10.0"
- objecttolerance="10.0"
- borderopacity="1.0"
- bordercolor="#666666"
- pagecolor="#000000"
- id="base"
- inkscape:zoom="2.8284271"
- inkscape:cx="125.4227"
- inkscape:cy="119.51264"
- inkscape:window-x="1280"
- inkscape:window-y="0"
- inkscape:current-layer="layer4"
- showguides="false"
- inkscape:guide-bbox="true"
- width="271px"
- height="217px"
- showgrid="false">
- <sodipodi:guide
- orientation="1,0"
- position="15.291184,193.74726"
- id="guide3598" />
- <sodipodi:guide
- orientation="0,1"
- position="20.4375,213.5"
- id="guide3600" />
- <inkscape:grid
- type="xygrid"
- id="grid3602" />
- <sodipodi:guide
- orientation="1,0"
- position="268.5238,3.0935922"
- id="guide3604" />
- </sodipodi:namedview>
<g
- inkscape:groupmode="layer"
- id="layer5"
- inkscape:label="bg-emacs"
+ transform="translate(5.34375,-11.4375)"
+ id="layer2"
style="display:inline">
<path
- style="opacity:1;fill:#000000;display:inline"
- d="M 6.1695811,203.2763 C 1.8388869,199.67523 2.1127919,195.96424 7.4902622,185.38334 C 11.360302,177.76853 13.266697,175.4371 23.932576,165.27521 C 31.613767,157.95698 35.347917,153.77925 34.210011,153.77692 C 33.227002,153.77489 30.969631,152.89774 29.193641,151.82767 C 23.060428,148.13228 25.538468,143.16627 40.345042,129.48016 C 50.392956,120.19262 61.808486,111.61667 70.72365,106.65814 C 82.250389,100.24706 96.306288,95.980687 100.16995,97.720313 C 104.08818,99.484523 103.03488,102.63111 96.454855,108.81859 C 90.856953,114.08255 78.904354,121.98483 77.956715,121.04837 C 77.726566,120.82094 80.412877,118.60777 83.926288,116.13022 C 88.080496,113.20081 90.545462,110.71551 90.975316,109.02305 C 91.33886,107.59164 91.404962,106.19187 91.122204,105.91245 C 90.458257,105.25633 77.249121,109.36745 72.429356,111.73027 C 59.551532,118.04343 39.874422,133.36949 39.874422,137.08657 C 39.874422,142.86737 51.14064,143.84144 61.015932,138.91444 C 67.925573,135.46708 72.661938,133.89327 72.661938,135.04468 C 72.661938,137.28595 60.432861,146.98956 53.740114,150.05889 C 43.112945,154.93258 35.762073,159.85609 27.416547,167.69001 C 19.721397,174.91343 16.028956,180.83255 16.028956,185.94475 C 16.028956,189.40325 18.963121,192.0724 22.764992,192.0724 C 30.62106,192.0724 35.876253,188.9229 58.932752,170.39661 C 64.024743,166.30511 70.24216,161.77637 72.749233,160.33274 C 77.152328,157.79733 81.603988,156.8733 81.603988,158.49475 C 81.603988,159.39101 71.902629,175.78836 68.545674,180.56606 L 66.324887,183.72675 L 68.710427,181.76307 C 70.022484,180.68304 72.455695,178.4739 74.117585,176.85386 C 86.700092,164.58817 95.303775,158.6898 100.61269,158.6898 C 103.05577,158.6898 104.71944,159.20786 105.0555,160.0733 C 105.56783,161.39265 104.60656,165.7543 102.87196,169.98097 C 102.34023,171.27663 103.90906,170.40701 107.48361,167.4247 C 114.82361,161.30083 121.37103,157.70795 125.19076,157.70795 C 129.70556,157.70795 129.95775,159.64928 126.41484,167.131 C 122.70859,174.95765 122.24133,181.95468 125.24549,184.64134 C 127.07268,186.27542 127.36995,186.23152 131.95202,183.65102 C 134.58906,182.16591 137.86439,179.99005 139.23053,178.81577 C 149.46228,170.02101 177.9823,153.45154 179.79411,155.24929 C 180.60737,156.05623 178.12436,157.94916 169.4855,163.10808 C 155.42407,171.50523 147.19459,179.74778 147.18403,185.44497 C 147.17845,188.45426 147.44709,188.59782 150.28011,187.09951 C 154.812,184.70273 153.8964,186.99676 148.9992,190.30881 C 136.22123,198.95077 131.99912,197.37717 137.76983,186.12356 L 140.28337,181.22184 L 132.44653,186.55593 C 118.74115,195.88442 113.35412,197.77987 109.99145,194.45687 C 107.41491,191.91072 108.0274,184.95007 111.41082,178.32662 C 114.12045,173.02219 115.23973,168.50821 113.84539,168.50821 C 111.49183,168.50821 106.46299,172.71228 100.63284,179.55382 C 90.793753,191.09971 83.05265,198.34612 81.276958,197.67276 C 80.089364,197.22241 80.775746,195.19677 84.767238,187.37233 C 87.499959,182.01541 90.812332,176.39446 92.128056,174.88131 C 96.600938,169.7373 95.099966,167.92406 88.497732,170.49572 C 84.81171,171.93148 80.128461,175.82237 68.486498,187.12126 C 54.869574,200.3369 49.810033,204.05197 49.810033,200.83481 C 49.810033,200.25402 51.598443,196.75276 53.784278,193.05424 C 55.970112,189.35572 57.758522,186.10662 57.758522,185.83402 C 57.758522,185.56141 59.483841,182.76661 61.592555,179.62335 C 63.701269,176.48009 65.762511,172.85458 66.17309,171.56667 C 66.919324,169.22591 66.918152,169.22607 63.084238,171.99663 C 60.974779,173.52102 57.460454,176.37942 55.274619,178.34864 C 53.088785,180.31787 50.128748,182.77536 48.696748,183.80974 C 47.264758,184.84412 43.017285,188.15826 39.257918,191.17449 C 35.498561,194.19072 28.855244,198.71947 24.495001,201.23837 C 15.041456,206.69965 10.847465,207.16605 6.1695811,203.2763 z M 164.29064,193.48948 C 159.4721,190.15427 162.86071,176.51691 170.15765,169.87785 C 173.44029,166.89116 182.32808,160.65348 183.30102,160.65348 C 183.57191,160.65348 182.26182,163.55747 180.38971,167.10679 C 174.95449,177.41134 176.14222,185.19951 183.14894,185.19951 C 189.0246,185.19951 194.10068,182.21811 204.1072,172.88981 C 215.28273,162.47177 224.96686,156.86895 233.29431,156.00343 C 239.43659,155.36503 238.29588,156.74072 229.57959,160.48342 C 220.35337,164.44507 217.59282,166.29563 213.98901,170.93468 C 209.42368,176.81148 208.87974,180.47831 212.1011,183.66166 C 214.13209,185.66868 215.62028,186.18012 219.41545,186.1753 C 222.03596,186.17198 225.40955,185.53543 226.91231,184.76077 C 228.41507,183.9861 229.6446,183.7216 229.6446,184.173 C 229.6446,185.28011 220.19356,190.10495 217.98855,190.12349 C 217.02219,190.13162 214.44312,190.77498 212.25728,191.55316 C 210.07145,192.33135 205.7225,192.98744 202.59297,193.01114 C 197.62523,193.04877 196.70033,192.74874 195.30725,190.64771 C 194.36788,189.23094 193.97736,187.41378 194.35775,186.22942 C 195.17832,183.67453 194.67478,183.70501 190.13081,186.4853 C 176.77802,194.6554 169.0151,196.7596 164.29064,193.48948 z M 234.61241,194.08755 C 233.24626,193.62688 230.67542,193.20594 228.89943,193.15211 C 222.98176,192.97275 225.31175,190.63745 233.95678,188.08324 C 236.17336,187.42834 236.66631,187.53872 236.25502,188.59786 C 235.1982,191.31943 244.23779,192.08477 249.79613,189.74434 C 255.20132,187.46838 257.82958,183.84491 257.89957,178.57248 C 257.95845,174.13691 257.81176,173.88692 254.48363,172.75123 C 252.57103,172.09857 245.97626,171.53962 239.82861,171.50915 C 227.02389,171.44566 225.67995,170.38628 232.78291,165.95527 C 242.22085,160.06764 252.77878,155.74427 257.71879,155.74427 C 263.253,155.74427 263.25585,157.15717 257.72368,158.1684 C 253.89831,158.86764 244.11025,163.87967 242.95139,165.73264 C 241.73834,167.67225 245.04566,168.47814 254.2804,168.49317 C 262.75089,168.50696 263.71804,168.70786 265.95474,170.91818 C 269.71614,174.6352 269.37098,180.55553 265.16441,184.47426 C 257.75353,191.37807 241.6262,196.45259 234.61241,194.08755 z"
id="bg-emacs"
- inkscape:label="bg-emacs" />
- </g>
- <g
- inkscape:groupmode="layer"
- id="layer2"
- inkscape:label="emacs"
- style="opacity:1;display:inline">
- <path
- style="opacity:1;fill:url(#linearGradient2556);fill-opacity:1;stroke:url(#linearGradient2564);display:inline"
- d="M 4.931694,200.50384 C 0.57293401,196.83617 0.84861401,193.05655 6.260934,182.27996 C 10.156054,174.52432 12.074804,172.14977 22.809804,161.79994 C 30.540774,154.34636 34.299124,150.09137 33.153844,150.08899 C 32.164464,150.08693 29.892464,149.19355 28.104964,148.10369 C 21.932004,144.33996 24.426104,139.2821 39.328634,125.34288 C 49.441664,115.88357 60.931174,107.14901 69.904114,102.09877 C 81.505554,95.569112 95.652544,91.223832 99.541235,92.995632 C 103.48487,94.792472 102.42474,97.997262 95.802074,104.29918 C 90.167894,109.66049 78.137834,117.70892 77.184054,116.75514 C 76.952414,116.52351 79.656134,114.26941 83.192314,111.74604 C 87.373444,108.76245 89.854384,106.23118 90.287024,104.50742 C 90.652924,103.04954 90.719454,101.62388 90.434864,101.33929 C 89.766614,100.67104 76.471874,104.85819 71.620874,107.26471 C 58.659594,113.69463 38.854964,129.30414 38.854964,133.08996 C 38.854964,138.97768 50.194194,139.96976 60.133484,134.95164 C 67.087904,131.44052 71.854964,129.8376 71.854964,131.01031 C 71.854964,133.29303 59.546634,143.1761 52.810514,146.3022 C 42.114474,151.26603 34.715964,156.28059 26.316354,164.2594 C 18.571334,171.61641 14.854964,177.645 14.854964,182.85175 C 14.854964,186.37421 17.808144,189.09273 21.634654,189.09273 C 29.541634,189.09273 34.830884,185.88498 58.036804,167.01606 C 63.161794,162.84889 69.419504,158.23639 71.942824,156.76606 C 76.374454,154.18376 80.854964,153.24264 80.854964,154.89408 C 80.854964,155.80691 71.090734,172.50752 67.712024,177.37359 L 65.476844,180.59273 L 67.877844,178.59273 C 69.198404,177.49273 71.647384,175.24273 73.320044,173.59273 C 85.984094,161.10019 94.643534,155.09273 99.986845,155.09273 C 102.44577,155.09273 104.12022,155.62038 104.45846,156.50182 C 104.97411,157.84557 104.00661,162.28789 102.26076,166.59273 C 101.72558,167.91235 103.30459,167.02665 106.90231,163.98918 C 114.28987,157.75205 120.87972,154.09273 124.72421,154.09273 C 129.26827,154.09273 129.52209,156.06996 125.95622,163.69005 C 122.22595,171.66145 121.75566,178.78789 124.77929,181.52424 C 126.61832,183.18854 126.91752,183.14383 131.52929,180.5156 C 134.18342,179.00302 137.47997,176.78692 138.85497,175.59092 C 149.15302,166.63351 177.85787,149.7576 179.68142,151.58859 C 180.49995,152.41046 178.00085,154.3384 169.30601,159.59273 C 155.15345,168.14518 146.87064,176.54017 146.86001,182.34273 C 146.85439,185.40767 147.12477,185.55389 149.97615,184.02787 C 154.53741,181.58676 153.61588,183.92322 148.68694,187.29652 C 135.82616,196.09831 131.57669,194.49561 137.3848,183.03387 L 139.91463,178.04149 L 132.027,183.47424 C 118.2328,192.97525 112.81086,194.90576 109.4264,191.5213 C 106.83316,188.92806 107.44962,181.83868 110.85497,175.09273 C 113.58216,169.6902 114.70869,165.09273 113.30531,165.09273 C 110.9365,165.09273 105.87507,169.37455 100.00713,176.34262 C 90.104284,188.10205 82.313014,195.48248 80.525814,194.79667 C 79.330524,194.33799 80.021354,192.27488 84.038714,184.30573 C 86.789144,178.84974 90.122984,173.12483 91.447234,171.5837 C 95.949104,166.34455 94.438404,164.49778 87.793384,167.117 C 84.083474,168.57931 79.369874,172.54216 67.652464,184.05002 C 53.947294,197.51008 48.854964,201.29386 48.854964,198.0172 C 48.854964,197.42566 50.654964,193.85965 52.854964,190.09273 C 55.054964,186.32581 56.854964,183.01662 56.854964,182.73897 C 56.854964,182.46132 58.591464,179.61483 60.713844,176.41344 C 62.836224,173.21205 64.910824,169.51949 65.324064,168.20776 C 66.075134,165.8237 66.073954,165.82387 62.215194,168.64567 C 60.092064,170.19825 56.554964,173.10952 54.354964,175.11516 C 52.154964,177.12081 49.175744,179.62375 47.734464,180.67726 C 46.293194,181.73077 42.018194,185.1062 38.234464,188.17821 C 34.450744,191.25023 27.764374,195.86273 23.375874,198.42822 C 13.861064,203.9905 9.6398944,204.46553 4.931694,200.50384 z M 164.07748,190.53602 C 159.22771,187.13912 162.63828,173.24955 169.98251,166.4877 C 173.28643,163.44577 182.23181,157.09273 183.21106,157.09273 C 183.48371,157.09273 182.16513,160.05043 180.28088,163.66539 C 174.81044,174.16052 176.00587,182.09273 183.05799,182.09273 C 188.97173,182.09273 194.08071,179.05619 204.15208,169.55537 C 215.40003,158.94465 225.14692,153.23821 233.52834,152.35668 C 239.71042,151.70647 238.56232,153.10761 229.78954,156.91953 C 220.50353,160.95445 217.72509,162.83923 214.09793,167.56408 C 209.50301,173.54957 208.95555,177.28421 212.19778,180.52644 C 214.24193,182.57058 215.73977,183.09147 219.55953,183.08657 C 222.19703,183.08318 225.59248,182.43486 227.10498,181.64587 C 228.61748,180.85688 229.85498,180.58749 229.85498,181.04723 C 229.85498,182.17482 220.34269,187.08889 218.12339,187.10778 C 217.15076,187.11606 214.55498,187.77131 212.35498,188.56389 C 210.15498,189.35647 205.77785,190.02469 202.62803,190.04883 C 197.6281,190.08716 196.69721,189.78158 195.2951,187.64169 C 194.34964,186.19872 193.95659,184.34795 194.33944,183.14169 C 195.16533,180.53954 194.65853,180.57059 190.08511,183.4023 C 176.64579,191.7235 168.83256,193.86662 164.07748,190.53602 z M 234.85498,191.14515 C 233.47998,190.67596 230.89248,190.24723 229.10498,190.19241 C 223.14896,190.00973 225.49405,187.63124 234.1951,185.02979 C 236.42605,184.36278 236.92219,184.4752 236.50824,185.55393 C 235.44457,188.32583 244.54274,189.10533 250.1371,186.72161 C 255.57732,184.40356 258.22261,180.71308 258.29306,175.34313 C 258.35232,170.82553 258.20468,170.57092 254.85498,169.41422 C 252.92998,168.74949 246.29248,168.18021 240.10498,168.14917 C 227.21728,168.08451 225.86463,167.00554 233.01362,162.49258 C 242.51273,156.49606 253.13908,152.09273 258.1111,152.09273 C 263.68118,152.09273 263.68405,153.53176 258.11603,154.56169 C 254.26587,155.27386 244.41437,160.37859 243.248,162.26583 C 242.02709,164.24131 245.35584,165.0621 254.65043,165.07741 C 263.17582,165.09146 264.14923,165.29607 266.40043,167.54727 C 270.1862,171.33304 269.83881,177.36286 265.60498,181.35407 C 258.14607,188.38556 241.91422,193.55393 234.85498,191.14515 z"
- id="emacs"
- inkscape:label="emacs" />
- </g>
- <g
- inkscape:groupmode="layer"
- id="layer4"
- inkscape:label="bg-gnu"
- style="display:inline">
+ d="M -0.54734668,196.72853 C -10.238062,181.78405 5.3965305,167.92976 14.809201,161.97512 c 6.963497,-4.40524 14.224571,-9.82272 13.070957,-9.82483 -0.996579,-0.002 -3.28511,-0.79177 -5.085617,-1.75545 -6.217876,-3.328 -7.955628,-16.0503 7.055337,-28.37575 16.709358,-12.01621 42.570706,-26.817295 64.900729,-20.35237 3.972323,1.58882 2.904483,4.42259 -3.766368,9.99493 -5.675178,4.74062 -17.792772,11.85728 -18.753492,11.01391 -0.233326,-0.20481 2.490068,-2.19795 6.051979,-4.42919 3.551812,-2.45188 6.827,-5.57228 6.234589,-9.02517 -1.977492,-3.21848 -14.566202,0.87624 -19.657994,3.11812 -8.980399,3.95401 -30.419617,17.3969 -29.389287,24.77996 0.719552,5.15612 9.095912,7.16542 19.107524,2.72826 7.005023,-3.10464 12.660323,-6.60409 12.285323,-4.56715 -0.365454,1.98509 -12.574667,10.22701 -19.359801,12.99119 -10.773868,4.38916 -18.049435,9.35351 -26.510163,16.40859 -7.801376,6.50528 -6.794788,9.58593 -6.794788,14.18989 0,3.11466 2.974668,5.51843 6.829021,5.51843 7.964514,0 8.895804,0.12074 32.270578,-16.56369 5.162282,-3.68473 10.228089,-7.76323 13.653652,-9.77045 4.326017,-2.53484 9.463124,-4.13198 8.976988,-1.65526 -3.779364,7.61077 -5.74585,10.67934 -9.167556,16.15546 8.11118,-6.33235 15.840916,-14.71763 24.306604,-15.7298 2.101063,-0.25121 7.741174,-0.49516 8.636184,0.99596 0.66736,1.11183 -0.45512,5.1162 -2.21368,8.92266 -0.53908,1.16685 1.05142,0.38368 4.67533,-2.30213 7.4413,-5.51505 14.07911,-8.75072 17.95157,-8.75072 4.57712,0 4.83279,1.74832 1.24097,8.48622 -3.75741,7.04855 -6.75962,17.21422 -4.65148,19.88378 1.46622,1.85669 7.96734,-2.91147 10.3276,-4.31865 2.42293,-1.44454 6.05649,-3.67201 7.44149,-4.72955 10.37298,-7.92039 39.1617,-23.15505 40.99851,-21.53603 0.82449,0.72672 -1.6928,2.43145 -10.4509,7.07749 -14.25554,7.56231 -22.59862,14.9854 -22.60932,20.11619 -0.006,2.71011 4.1743,2.15203 7.26381,1.4275 4.40695,-1.03349 12.41622,-3.9676 -0.1736,3.14023 -13.16001,7.42973 -22.48474,6.17812 -16.63437,-3.95665 l 3.73574,-6.16441 -9.13253,6.55379 c -13.1916,9.46671 -19.35595,10.10807 -22.76505,7.11544 -2.6121,-2.29301 -1.99116,-8.56165 1.43897,-14.5266 2.74703,-4.77707 3.88176,-8.84229 2.46817,-8.84229 -2.38604,0 -7.35931,4.53611 -13.269938,10.69747 -9.974903,10.39803 -8.541011,15.10079 -10.591215,15.36937 -1.2597,0.16503 -6.977484,-1.59412 -4.555892,-8.64067 1.80805,-5.26122 4.692881,-8.68747 6.822262,-11.55279 3.866732,-5.2031 1.480467,-5.97342 -3.790272,-3.77097 -3.05613,1.27704 -5.350157,4.83814 -17.152826,15.01371 -13.804895,11.90177 -18.199091,17.31988 -20.790434,11.99663 -1.273249,-2.61557 1.017602,-5.97434 3.23361,-9.57032 4.367498,-7.21552 10.687821,-13.92473 8.632844,-16.40082 -2.050191,0.66573 -5.701417,3.94706 -7.917424,5.72051 -2.216008,1.77344 -5.216905,3.98662 -6.668674,4.91816 -1.451757,0.93154 -5.757863,3.9162 -9.569125,6.63254 -3.811251,2.71637 -10.546273,6.79489 -14.966706,9.06335 -9.584043,4.91833 -13.8359278,5.33836 -18.57838668,1.83533 z M 159.75643,187.9147 c -4.88506,-3.00364 -1.44968,-15.28517 5.948,-21.2642 3.32796,-2.68976 12.33843,-8.3073 13.32481,-8.3073 0.27463,0 -1.05354,2.61529 -2.9515,5.81174 -5.51025,9.28008 -4.30612,16.29397 2.79731,16.29397 5.95677,0 10.60291,-1.935 15.24759,-9.21089 3.95762,-6.19961 10.07679,-10.04817 15.75277,-13.07984 4.88528,-2.60934 15.49103,-5.23799 19.83723,-4.00272 6.01532,1.70966 5.07061,0.66399 -3.766,4.03459 -9.35359,3.5678 -12.15223,5.23437 -15.80579,9.41222 -4.62835,5.29254 -5.17979,8.5948 -1.91397,11.46168 2.05902,1.80749 3.56776,2.26807 7.41531,2.26374 2.65669,-0.003 5.81168,-1.7253 7.33518,-2.42296 1.52351,-0.69765 3.03519,0.21321 3.03519,0.61971 -5.88638,3.94569 -11.44839,6.45882 -14.00234,7.27145 -2.61375,0.96599 -7.35132,2.03318 -10.23523,1.93803 -5.03631,0.0339 -9.16147,-1.48631 -10.57379,-3.37846 -0.79608,-1.43217 -1.3268,-2.70381 -0.96262,-3.97903 1.0679,-3.73939 0.16517,-2.52343 -4.28527,0.23044 -13.102,8.10733 -21.40719,9.25285 -26.19688,6.30784 z m 75.29251,0.53861 c -1.38501,-0.41487 -3.99134,-0.79396 -5.79185,-0.84243 -5.99934,-0.16153 -3.6372,-2.26466 5.12716,-4.56493 2.24719,-0.58979 2.74693,-0.49039 2.32997,0.46346 -1.0714,2.45099 8.09297,3.14024 13.72804,1.0325 5.4798,-2.04969 7.70684,-5.31293 8.2153,-10.06119 0.16756,-8.34719 -12.6158,-6.31988 -18.32043,-6.36109 -12.98146,-0.0572 -14.34396,-1.01124 -7.14295,-5.00172 9.56822,-5.3023 20.88185,-11.1336 25.8426,-10.44585 5.86061,0.8125 5.42599,3.39743 -0.5575,3.43312 -3.92889,0.0234 -13.80136,5.14348 -14.97622,6.81223 -1.22979,1.74676 2.12319,2.47254 11.4854,2.48607 8.58743,0.0125 9.56792,0.19334 11.8355,2.18392 3.81332,3.3475 3.46341,8.67923 -0.80123,12.20836 -7.5132,6.21743 -19.30064,10.28748 -30.97375,8.65755 z"
+ style="opacity:1;fill:#000000;display:inline" />
<path
id="bg-gnu"
- d="M 57.964139,213.18663 C 60.419089,204.75722 65.429969,194.08978 70.273479,186.98184 C 75.998719,178.57993 77.670749,176.26272 99.036976,147.11956 C 115.95228,124.04737 118.30926,120.64653 121.64961,114.49211 C 123.19636,111.6423 124.83543,109.31064 125.29198,109.31064 C 126.47686,109.31064 126.39522,109.66459 123.65471,116.40903 C 122.29766,119.74874 121.18735,122.85645 121.18735,123.31503 C 121.18735,123.7736 118.20323,128.91551 114.55597,134.74148 C 105.54448,149.13603 103.76812,151.84051 101.44011,154.71012 C 100.3392,156.06717 97.576726,159.84224 95.301296,163.09916 C 93.025866,166.35608 90.702336,169.52146 90.137886,170.13334 C 89.573446,170.74522 87.335119,173.78537 85.163849,176.88923 C 78.455459,186.47891 69.027339,199.54123 67.687459,201.10211 C 66.985889,201.9194 64.635389,205.57568 62.464109,209.22717 C 58.292149,216.24324 56.654209,217.68444 57.964139,213.18663 z M 124.61625,186.04563 C 124.83962,185.36711 126.14939,181.15242 127.52686,176.67964 C 130.98125,165.46294 141.22429,145.66263 147.31637,138.42553 L 149.80876,135.46469 L 152.06645,138.17879 C 154.75072,141.40568 155.95939,141.52233 160.11276,138.95541 C 163.2081,137.04239 167.82894,129.56665 180.26663,106.34981 C 184.82883,97.833765 185.29178,97.282245 185.31415,100.33657 C 185.35582,106.02506 163.04187,147.45245 155.89413,154.95686 C 151.76625,159.29073 149.69002,159.57951 147.02425,156.19054 C 145.95679,154.83349 144.70321,153.72397 144.23852,153.72494 C 142.61294,153.72834 132.1245,172.68283 127.71922,183.57827 C 126.89618,185.61384 125.76994,187.27931 125.21646,187.27931 C 124.66298,187.27931 124.39289,186.72416 124.61625,186.04563 z M 209.02547,157.62164 C 209.02547,149.06737 216.70827,114.14492 221.39068,101.41508 C 224.44307,93.116695 228.74413,77.605995 229.73782,71.313245 C 230.16639,68.599145 231.23241,62.603446 232.10672,57.989476 C 232.98105,53.375516 233.69701,44.783596 233.69775,38.896326 C 233.69933,26.407625 232.49195,23.375465 226.57475,21.007875 C 218.92783,17.948175 216.38102,19.325695 213.53943,28.058435 C 211.79252,33.427035 209.80633,35.888836 208.08175,34.822986 C 206.18062,33.648025 207.02503,29.812025 210.98936,21.614295 C 219.14998,4.7391768 225.58607,0.53542684 235.51027,5.5983768 C 241.178,8.4898368 244.5555,15.424745 244.5555,24.170665 C 244.5555,34.830366 237.51803,64.304686 230.236,84.143525 C 225.74887,96.368055 218.63951,124.4602 215.34281,142.99293 C 213.23722,154.8297 212.18359,158.67625 210.81231,159.53262 C 209.23367,160.5185 209.02547,160.29584 209.02547,157.62164 z M 112.30406,95.774855 C 112.30335,86.107635 112.04448,84.586865 109.48419,79.208805 C 106.81201,73.595725 102.18346,67.858935 100.32692,67.858935 C 99.858122,67.858935 99.474552,67.299035 99.474552,66.614716 C 99.474552,64.835656 108.19817,52.067806 109.41371,52.067806 C 111.15723,52.067806 116.88946,58.299936 118.94539,62.430736 C 121.55774,67.679455 122.31172,75.379195 121.23073,85.768925 C 120.26817,95.020455 117.08016,103.86358 114.14025,105.43697 C 112.40375,106.36632 112.30479,105.84561 112.30406,95.774855 z M 42.858299,98.382615 C 38.870809,95.246035 39.403889,91.231535 45.304209,79.963515 C 50.287489,70.446755 55.424119,62.397976 66.798189,46.283706 C 73.416469,36.907226 75.458009,34.630905 76.402269,35.575166 C 77.203719,36.376616 73.776549,41.731156 64.898629,53.548226 C 47.914999,76.154535 46.116239,84.637005 58.306059,84.637005 C 61.619079,84.637005 64.380449,83.932335 66.788859,82.472295 C 73.165649,78.606515 85.039239,69.582285 90.356266,64.560456 C 93.212106,61.863176 95.826996,59.934616 96.167146,60.274766 C 97.215066,61.322676 91.247486,71.864225 88.330109,74.118685 C 86.814629,75.289785 82.440909,78.912715 78.610739,82.169635 C 74.780549,85.426555 70.024799,89.201625 68.042379,90.558675 C 66.059969,91.915725 63.630929,93.753035 62.644519,94.641595 C 60.390529,96.671985 50.693159,100.42814 47.705199,100.42814 C 46.469649,100.42814 44.288549,99.507655 42.858299,98.382615 z M 169.7749,60.406226 C 165.40905,57.348266 165.38722,55.857466 169.58131,47.184626 L 173.49686,39.087756 L 176.05125,42.123476 C 179.08264,45.726076 182.7945,46.065336 188.79309,43.288076 C 193.61332,41.056386 197.11837,37.355796 200.57535,30.848485 L 203.19691,25.913765 L 202.7015,29.722235 C 201.96128,35.412666 192.58555,51.658577 187.75951,55.613156 C 180.48049,61.577766 173.9372,63.321616 169.7749,60.406226 z M 136.97847,54.083106 C 135.0786,53.068216 128.47651,46.850616 122.30716,40.266216 C 110.74484,27.926045 102.95202,22.459455 96.922976,22.459455 C 92.611736,22.459455 87.006919,26.267795 85.102389,30.491285 C 82.350399,36.594116 81.142179,37.013716 78.889729,32.648845 C 75.725529,26.517155 66.110359,18.511675 61.909959,18.511675 C 61.279849,18.511675 55.705859,23.640995 49.523299,29.910165 C 38.010599,41.584146 32.761459,45.096006 26.763059,45.137516 C 23.263229,45.161736 18.999129,42.054906 16.400189,37.587106 C 14.809579,34.852746 14.849989,34.512975 17.497749,28.357115 C 19.009679,24.841995 20.584839,21.077735 20.998129,19.992085 C 21.652009,18.274415 21.991459,18.555015 23.613259,22.153815 C 25.529349,26.405655 29.950509,30.355015 32.794169,30.355015 C 36.955659,30.355015 44.328219,24.959145 54.247879,14.653345 C 63.827629,4.7006968 65.105539,3.7074968 68.331459,3.7074968 C 72.636069,3.7074968 77.912339,6.8782868 83.025429,12.537855 C 85.100189,14.834365 86.897599,16.562795 87.019689,16.378815 C 87.141779,16.194835 87.967249,14.881735 88.854049,13.460805 C 89.740846,12.039875 92.549116,9.6567568 95.094626,8.1649868 C 98.790816,5.9988768 100.57197,5.5483668 103.93934,5.9279268 C 110.80604,6.7018968 118.98765,12.481855 129.22745,23.792885 C 138.48067,34.014145 146.97435,40.224466 151.70045,40.224466 C 155.50397,40.224466 161.22658,36.521316 164.17375,32.152895 C 166.60256,28.552815 167.0995,28.209095 167.36029,29.948825 C 167.53023,31.082475 166.07293,35.512926 164.12185,39.794286 C 160.75337,47.185936 157.19211,51.363797 151.37603,54.746936 C 148.31837,56.525536 140.9114,56.184026 136.97847,54.083106 z"
- style="opacity:1;fill:#000000;display:inline"
- inkscape:label="bg-gnu" />
+ 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" />
</g>
<g
- inkscape:groupmode="layer"
+ transform="translate(5.34375,-11.4375)"
id="layer3"
- inkscape:label="gnu"
- style="opacity:1;display:inline">
+ style="display:inline">
<path
- style="fill:url(#linearGradient2425);fill-opacity:1;stroke:url(#linearGradient2427);stroke-width:0.97730815"
- d="M 61.076106,208.96096 C 63.507076,200.61386 68.469036,190.05059 73.265246,183.01206 C 78.934586,174.69219 80.590286,172.3976 101.74788,143.53901 C 118.49803,120.69211 120.83199,117.32446 124.13972,111.23014 C 125.67137,108.40816 127.29443,106.09927 127.74652,106.09927 C 128.91983,106.09927 128.83899,106.44977 126.12524,113.12835 C 124.78145,116.43545 123.68197,119.51281 123.68197,119.96691 C 123.68197,120.42101 120.727,125.51271 117.11535,131.28179 C 108.19185,145.5358 106.43283,148.21386 104.12755,151.05546 C 103.03739,152.39925 100.30189,156.13747 98.048676,159.36258 C 95.795466,162.58769 93.494626,165.72216 92.935686,166.32808 C 92.376756,166.93398 90.160296,169.94445 88.010216,173.018 C 81.367336,182.51404 72.031276,195.44882 70.704486,196.99445 C 70.009766,197.80377 67.682206,201.42433 65.532126,205.04018 C 61.400906,211.98774 59.778956,213.41486 61.076106,208.96096 z M 127.0774,182.08499 C 127.29858,181.41309 128.59556,177.23956 129.95958,172.81045 C 133.38024,161.70328 143.52325,142.0963 149.55585,134.92988 L 152.02391,131.99795 L 154.25955,134.68555 C 156.91761,137.88092 158.11448,137.99645 162.2273,135.45458 C 165.29241,133.56025 169.86813,126.15749 182.18437,103.16735 C 186.70202,94.734476 187.16045,94.188338 187.18261,97.212831 C 187.22387,102.84577 165.1278,143.86866 158.04986,151.29979 C 153.96228,155.59134 151.90633,155.8773 149.26659,152.52142 C 148.20955,151.17762 146.96821,150.07893 146.50805,150.0799 C 144.89835,150.08326 134.51232,168.85268 130.15006,179.64172 C 129.33506,181.65742 128.21981,183.30663 127.67174,183.30663 C 127.12367,183.30663 126.85621,182.7569 127.0774,182.08499 z M 210.6624,153.93855 C 210.6624,145.46781 218.27017,110.88634 222.90686,98.280809 C 225.92945,90.063464 230.18852,74.704222 231.1725,68.472911 C 231.59689,65.785315 232.65248,59.848166 233.51827,55.279251 C 234.38405,50.710335 235.09303,42.202312 235.09375,36.372532 C 235.09532,24.005777 233.89974,21.003224 228.04031,18.65875 C 220.46806,15.628931 217.94613,16.993 215.13227,25.640465 C 213.40243,30.956652 211.43564,33.394405 209.7279,32.338969 C 207.84533,31.175475 208.68148,27.37694 212.60711,19.259251 C 220.68804,2.5489063 227.06129,-1.6137938 236.88858,3.3997163 C 242.50098,6.2629463 245.84549,13.130142 245.84549,21.790666 C 245.84549,32.346272 238.87674,61.532787 231.66581,81.177917 C 227.22251,93.283081 220.18256,121.1009 216.91805,139.45268 C 214.83302,151.17387 213.78968,154.98286 212.43178,155.83087 C 210.86856,156.80712 210.6624,156.58663 210.6624,153.93855 z M 114.88542,92.695674 C 114.88472,83.122844 114.62838,81.616923 112.09309,76.291377 C 109.447,70.733105 104.86364,65.052333 103.02522,65.052333 C 102.561,65.052333 102.18119,64.497902 102.18119,63.820263 C 102.18119,62.058579 110.81963,49.415401 112.0233,49.415401 C 113.7498,49.415401 119.42604,55.586675 121.4619,59.677138 C 124.04875,64.874602 124.79536,72.499162 123.72493,82.787443 C 122.77177,91.948632 119.61489,100.7054 116.70368,102.26342 C 114.98414,103.1837 114.88615,102.66807 114.88542,92.695674 z M 46.117766,95.277953 C 42.169206,92.172018 42.697086,88.196715 48.539786,77.038724 C 53.474416,67.61489 58.560886,59.644698 69.823886,43.687774 C 76.377556,34.40285 78.399156,32.148763 79.334196,33.083797 C 80.127816,33.877423 76.734116,39.179682 67.942886,50.881363 C 51.125096,73.266927 49.343886,81.666573 61.414686,81.666573 C 64.695356,81.666573 67.429756,80.968786 69.814656,79.523 C 76.129176,75.694973 87.886836,66.758858 93.151936,61.786064 C 95.979886,59.115122 98.569246,57.205392 98.906066,57.542219 C 99.943756,58.579901 94.034456,69.018517 91.145556,71.250958 C 89.644886,72.410631 85.313876,75.998184 81.521096,79.223302 C 77.728306,82.448419 73.018996,86.186623 71.055936,87.530422 C 69.092886,88.87422 66.687566,90.693597 65.710786,91.57348 C 63.478806,93.584045 53.876116,97.303502 50.917336,97.303502 C 49.693856,97.303502 47.534056,96.392006 46.117766,95.277953 z M 171.79508,57.6724 C 167.47186,54.644298 167.45024,53.16805 171.60338,44.5799 L 175.48071,36.562094 L 178.01015,39.56817 C 181.01195,43.135591 184.68755,43.471543 190.62758,40.721402 C 195.40074,38.511498 198.87156,34.847043 202.29479,28.403277 L 204.89074,23.516737 L 204.40017,27.288026 C 203.66718,32.922889 194.383,49.01016 189.60409,52.926128 C 182.39615,58.832494 175.91674,60.559318 171.79508,57.6724 z M 139.3189,51.411018 C 137.43758,50.406042 130.89996,44.249152 124.79084,37.729043 C 113.34143,25.509367 105.62471,20.096158 99.654526,20.096158 C 95.385376,20.096158 89.835296,23.867317 87.949366,28.04956 C 85.224246,34.092801 84.027826,34.5083 81.797366,30.186057 C 78.664066,24.11424 69.142776,16.186925 64.983386,16.186925 C 64.359436,16.186925 58.839876,21.266163 52.717686,27.474119 C 41.317406,39.034109 36.119516,42.511671 30.179686,42.552781 C 26.714036,42.576765 22.491566,39.500273 19.917996,35.076099 C 18.342936,32.368437 18.382946,32.031988 21.004846,25.936231 C 22.502016,22.45543 24.061796,18.727927 24.471046,17.652887 C 25.118546,15.951984 25.454676,16.229839 27.060646,19.793504 C 28.958026,24.003825 33.336016,27.914623 36.151906,27.914623 C 40.272756,27.914623 47.573326,22.571437 57.396126,12.36627 C 66.882336,2.5108063 68.147766,1.5273063 71.342186,1.5273063 C 75.604766,1.5273063 80.829526,4.6671363 85.892686,10.271446 C 87.947186,12.54552 89.727046,14.257073 89.847936,14.07489 C 89.968836,13.892711 90.786246,12.59243 91.664386,11.185376 C 92.542526,9.7783256 95.323366,7.4184763 97.844026,5.9412663 C 101.50413,3.7963063 103.26788,3.3502063 106.60239,3.7260463 C 113.40203,4.4924663 121.50375,10.215986 131.64357,21.416572 C 140.80643,31.538025 149.21716,37.687703 153.89713,37.687703 C 157.6635,37.687703 163.33024,34.020716 166.24863,29.69495 C 168.65373,26.130021 169.14581,25.789654 169.40405,27.5124 C 169.57233,28.634976 168.12927,33.022171 166.19724,37.261722 C 162.86165,44.581197 159.33516,48.718266 153.57588,52.068368 C 150.54808,53.829602 143.21343,53.491422 139.3189,51.411018 z"
id="gnu"
- inkscape:label="gnu" />
+ 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" />
+ <path
+ id="emacs"
+ d="M -0.94705426,195.12806 C -10.63777,180.18357 4.9968228,166.32928 14.409493,160.37464 c 6.963497,-4.40524 14.224571,-9.82272 13.070957,-9.82483 -0.996579,-0.002 -3.28511,-0.79177 -5.085617,-1.75545 -6.217876,-3.328 -7.955628,-16.0503 7.055337,-28.37575 16.709358,-12.01621 42.570706,-26.817291 64.900729,-20.35236 3.972325,1.58882 2.904485,4.42259 -3.766368,9.99492 -5.675178,4.74062 -17.792772,11.85728 -18.753492,11.01391 -0.233326,-0.20481 2.490068,-2.19795 6.051979,-4.42919 3.551812,-2.45188 6.827,-5.57228 6.234589,-9.02516 -1.977492,-3.21848 -14.566202,0.87623 -19.657994,3.11811 -8.980399,3.95401 -30.419617,17.3969 -29.389287,24.77996 0.719552,5.15612 9.095912,7.16542 19.107524,2.72826 7.005023,-3.10464 12.660323,-6.60409 12.285323,-4.56715 -0.365454,1.98509 -12.574667,10.22701 -19.359801,12.99119 -10.773868,4.38916 -18.049435,9.35351 -26.510163,16.40859 -7.801376,6.50528 -6.794788,9.58593 -6.794788,14.18989 0,3.11466 2.974668,5.51844 6.829021,5.51844 7.964514,0 8.895804,0.12074 32.270578,-16.5637 5.162282,-3.68473 10.228089,-7.76323 13.653652,-9.77045 4.326017,-2.53484 9.463124,-4.13198 8.976988,-1.65526 -3.779364,7.61077 -5.74585,10.67934 -9.167556,16.15546 8.11118,-6.33235 15.840916,-14.71763 24.306604,-15.7298 2.101063,-0.25121 7.741176,-0.49516 8.636186,0.99596 0.66736,1.11183 -0.45512,5.1162 -2.21368,8.92266 -0.53908,1.16685 1.05142,0.38368 4.675326,-2.30213 7.4413,-5.51505 14.07911,-8.75072 17.95157,-8.75072 4.57712,0 4.83279,1.74832 1.24097,8.48622 -3.75741,7.04855 -6.75962,17.21422 -4.65148,19.88378 1.46622,1.85669 7.96734,-2.91147 10.3276,-4.31865 2.42293,-1.44454 6.05649,-3.67201 7.44149,-4.72955 10.37298,-7.92039 39.1617,-23.15505 40.99851,-21.53603 0.82449,0.72672 -1.6928,2.43145 -10.4509,7.07749 -14.25554,7.56231 -22.59862,14.9854 -22.60932,20.11619 -0.006,2.71011 4.1743,2.15203 7.26381,1.4275 4.40695,-1.03349 12.41622,-3.9676 -0.1736,3.14023 -13.16001,7.42974 -22.48474,6.17813 -16.63437,-3.95665 l 3.73574,-6.16441 -9.13253,6.55379 c -13.1916,9.46671 -19.35595,10.10807 -22.76505,7.11544 -2.6121,-2.29301 -1.99116,-8.56165 1.43897,-14.5266 2.74703,-4.77707 3.88176,-8.84229 2.46817,-8.84229 -2.38604,0 -7.35931,4.53611 -13.269936,10.69747 -9.974903,10.39803 -8.541011,15.10079 -10.591215,15.36938 -1.2597,0.16503 -6.977484,-1.59412 -4.555892,-8.64068 1.80805,-5.26122 4.692881,-8.68747 6.822262,-11.55279 3.866732,-5.2031 1.480467,-5.97342 -3.790272,-3.77097 -3.05613,1.27704 -5.350157,4.83814 -17.152826,15.01371 -13.804895,11.90178 -18.199091,17.31989 -20.790434,11.99664 -1.273249,-2.61557 1.017602,-5.97434 3.23361,-9.57032 4.367498,-7.21553 10.687821,-13.92474 8.632844,-16.40083 -2.050191,0.66573 -5.701417,3.94706 -7.917424,5.72051 -2.216008,1.77344 -5.216905,3.98662 -6.668674,4.91816 -1.451757,0.93154 -5.757863,3.9162 -9.569125,6.63255 -3.811251,2.71637 -10.546273,6.79488 -14.966706,9.06335 -9.5840432,4.91833 -13.8359275,5.33836 -18.57838626,1.83533 z M 159.35672,186.31423 c -4.88506,-3.00364 -1.44968,-15.28518 5.948,-21.26421 3.32796,-2.68976 12.33843,-8.3073 13.32481,-8.3073 0.27463,0 -1.05354,2.61529 -2.9515,5.81174 -5.51025,9.28008 -4.30612,16.29397 2.79731,16.29397 5.95677,0 10.60291,-1.935 15.24759,-9.21089 3.95762,-6.19961 10.07679,-10.04817 15.75277,-13.07984 4.88528,-2.60934 15.49103,-5.23799 19.83723,-4.00272 6.01532,1.70966 5.07061,0.66399 -3.766,4.03459 -9.35359,3.5678 -12.15223,5.23437 -15.80579,9.41222 -4.62835,5.29254 -5.17979,8.5948 -1.91397,11.46168 2.05902,1.80749 3.56776,2.26807 7.41531,2.26374 2.65669,-0.003 5.81168,-1.7253 7.33518,-2.42296 1.52351,-0.69765 3.03519,0.21321 3.03519,0.61971 -5.88638,3.94569 -11.44839,6.45882 -14.00234,7.27145 -2.61375,0.96599 -7.35132,2.03318 -10.23523,1.93803 -5.03631,0.0339 -9.16147,-1.48631 -10.57379,-3.37846 -0.79608,-1.43217 -1.3268,-2.70381 -0.96262,-3.97903 1.0679,-3.73939 0.16517,-2.52343 -4.28527,0.23044 -13.102,8.10733 -21.40719,9.25285 -26.19688,6.30784 z m 75.29251,0.5386 c -1.38501,-0.41486 -3.99134,-0.79396 -5.79185,-0.84243 -5.99934,-0.16153 -3.6372,-2.26466 5.12716,-4.56493 2.24719,-0.58979 2.74693,-0.49039 2.32997,0.46346 -1.0714,2.45099 8.09297,3.14025 13.72804,1.0325 5.4798,-2.04969 7.70684,-5.31293 8.2153,-10.06119 0.16756,-8.34719 -12.6158,-6.31988 -18.32043,-6.36109 -12.98146,-0.0572 -14.34396,-1.01124 -7.14295,-5.00172 9.56822,-5.3023 20.88185,-11.1336 25.8426,-10.44585 5.86061,0.8125 5.42599,3.39743 -0.5575,3.43312 -3.92889,0.0234 -13.80136,5.14348 -14.97622,6.81223 -1.22979,1.74676 2.12319,2.47254 11.4854,2.48607 8.58743,0.0125 9.56792,0.19334 11.8355,2.18392 3.81332,3.3475 3.46341,8.67923 -0.80123,12.20836 -7.5132,6.21744 -19.30064,10.28748 -30.97375,8.65755 z"
+ style="opacity:1;fill:url(#linearGradient2556);fill-opacity:1;stroke:#000000;display:inline" />
</g>
</svg>
--- /dev/null
+// ***** BEGIN LICENSE BLOCK *****
+// Version: MPL 1.1/GPL 2.0/LGPL 2.1
+//
+// The contents of this file are subject to the Mozilla Public License Version
+// 1.1 (the "License"); you may not use this file except in compliance with
+// the License. You may obtain a copy of the License at
+// http://www.mozilla.org/MPL/
+//
+// Software distributed under the License is distributed on an "AS IS" basis,
+// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+// for the specific language governing rights and limitations under the
+// License.
+//
+// The Original Code is the Public Suffix List.
+//
+// The Initial Developer of the Original Code is
+// Jo Hermans <jo.hermans@gmail.com>.
+// Portions created by the Initial Developer are Copyright (C) 2007
+// the Initial Developer. All Rights Reserved.
+//
+// Contributor(s):
+// Ruben Arakelyan <ruben@rubenarakelyan.com>
+// Gervase Markham <gerv@gerv.net>
+// Pamela Greene <pamg.bugs@gmail.com>
+// David Triendl <david@triendl.name>
+// Jothan Frakes <jothan@gmail.com>
+// The kind representatives of many TLD registries
+//
+// Alternatively, the contents of this file may be used under the terms of
+// either the GNU General Public License Version 2 or later (the "GPL"), or
+// the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
+// in which case the provisions of the GPL or the LGPL are applicable instead
+// of those above. If you wish to allow use of your version of this file only
+// under the terms of either the GPL or the LGPL, and not to allow others to
+// use your version of this file under the terms of the MPL, indicate your
+// decision by deleting the provisions above and replace them with the notice
+// and other provisions required by the GPL or the LGPL. If you do not delete
+// the provisions above, a recipient may use your version of this file under
+// the terms of any one of the MPL, the GPL or the LGPL.
+//
+// ***** END LICENSE BLOCK *****
+
+// ac : http://en.wikipedia.org/wiki/.ac
+ac
+com.ac
+edu.ac
+gov.ac
+net.ac
+mil.ac
+org.ac
+
+// ad : http://en.wikipedia.org/wiki/.ad
+ad
+nom.ad
+
+// ae : http://en.wikipedia.org/wiki/.ae
+// see also: "Domain Name Eligibility Policy" at http://www.aeda.ae/eng/aepolicy.php
+ae
+co.ae
+net.ae
+org.ae
+sch.ae
+ac.ae
+gov.ae
+mil.ae
+
+// aero : see http://www.information.aero/index.php?id=66
+aero
+accident-investigation.aero
+accident-prevention.aero
+aerobatic.aero
+aeroclub.aero
+aerodrome.aero
+agents.aero
+aircraft.aero
+airline.aero
+airport.aero
+air-surveillance.aero
+airtraffic.aero
+air-traffic-control.aero
+ambulance.aero
+amusement.aero
+association.aero
+author.aero
+ballooning.aero
+broker.aero
+caa.aero
+cargo.aero
+catering.aero
+certification.aero
+championship.aero
+charter.aero
+civilaviation.aero
+club.aero
+conference.aero
+consultant.aero
+consulting.aero
+control.aero
+council.aero
+crew.aero
+design.aero
+dgca.aero
+educator.aero
+emergency.aero
+engine.aero
+engineer.aero
+entertainment.aero
+equipment.aero
+exchange.aero
+express.aero
+federation.aero
+flight.aero
+freight.aero
+fuel.aero
+gliding.aero
+government.aero
+groundhandling.aero
+group.aero
+hanggliding.aero
+homebuilt.aero
+insurance.aero
+journal.aero
+journalist.aero
+leasing.aero
+logistics.aero
+magazine.aero
+maintenance.aero
+marketplace.aero
+media.aero
+microlight.aero
+modelling.aero
+navigation.aero
+parachuting.aero
+paragliding.aero
+passenger-association.aero
+pilot.aero
+press.aero
+production.aero
+recreation.aero
+repbody.aero
+res.aero
+research.aero
+rotorcraft.aero
+safety.aero
+scientist.aero
+services.aero
+show.aero
+skydiving.aero
+software.aero
+student.aero
+taxi.aero
+trader.aero
+trading.aero
+trainer.aero
+union.aero
+workinggroup.aero
+works.aero
+
+// af : http://www.nic.af/help.jsp
+af
+gov.af
+com.af
+org.af
+net.af
+edu.af
+
+// ag : http://www.nic.ag/prices.htm
+ag
+com.ag
+org.ag
+net.ag
+co.ag
+nom.ag
+
+// ai : http://nic.com.ai/
+ai
+off.ai
+com.ai
+net.ai
+org.ai
+
+// al : http://www.ert.gov.al/ert_alb/faq_det.html?Id=31
+al
+com.al
+edu.al
+gov.al
+mil.al
+net.al
+org.al
+
+// am : http://en.wikipedia.org/wiki/.am
+am
+
+// an : http://www.una.an/an_domreg/default.asp
+an
+com.an
+net.an
+org.an
+edu.an
+
+// ao : http://en.wikipedia.org/wiki/.ao
+// http://www.dns.ao/REGISTR.DOC
+ao
+ed.ao
+gv.ao
+og.ao
+co.ao
+pb.ao
+it.ao
+
+// aq : http://en.wikipedia.org/wiki/.aq
+aq
+
+// ar : http://en.wikipedia.org/wiki/.ar
+*.ar
+!congresodelalengua3.ar
+!educ.ar
+!gobiernoelectronico.ar
+!mecon.ar
+!nacion.ar
+!nic.ar
+!promocion.ar
+!retina.ar
+!uba.ar
+
+// arpa : http://en.wikipedia.org/wiki/.arpa
+// Confirmed by registry <iana-questions@icann.org> 2008-06-18
+e164.arpa
+in-addr.arpa
+ip6.arpa
+iris.arpa
+uri.arpa
+urn.arpa
+
+// as : http://en.wikipedia.org/wiki/.as
+as
+gov.as
+
+// asia: http://en.wikipedia.org/wiki/.asia
+asia
+
+// at : http://en.wikipedia.org/wiki/.at
+// Confirmed by registry <it@nic.at> 2008-06-17
+at
+ac.at
+co.at
+gv.at
+or.at
+
+// http://www.info.at/
+biz.at
+info.at
+
+// priv.at : http://www.nic.priv.at/
+// Submitted by registry <lendl@nic.at> 2008-06-09
+priv.at
+
+// au : http://en.wikipedia.org/wiki/.au
+*.au
+// au geographical names (vic.au etc... are covered above)
+act.edu.au
+nsw.edu.au
+nt.edu.au
+qld.edu.au
+sa.edu.au
+tas.edu.au
+vic.edu.au
+wa.edu.au
+act.gov.au
+// Removed at request of Shae.Donelan@services.nsw.gov.au, 2010-03-04
+// nsw.gov.au
+nt.gov.au
+qld.gov.au
+sa.gov.au
+tas.gov.au
+vic.gov.au
+wa.gov.au
+// CGDNs - http://www.aucd.org.au/
+act.au
+nsw.au
+nt.au
+qld.au
+sa.au
+tas.au
+vic.au
+wa.au
+
+// aw : http://en.wikipedia.org/wiki/.aw
+aw
+com.aw
+
+// ax : http://en.wikipedia.org/wiki/.ax
+ax
+
+// az : http://en.wikipedia.org/wiki/.az
+az
+com.az
+net.az
+int.az
+gov.az
+org.az
+edu.az
+info.az
+pp.az
+mil.az
+name.az
+pro.az
+biz.az
+
+// ba : http://en.wikipedia.org/wiki/.ba
+ba
+org.ba
+net.ba
+edu.ba
+gov.ba
+mil.ba
+unsa.ba
+unbi.ba
+co.ba
+com.ba
+rs.ba
+
+// bb : http://en.wikipedia.org/wiki/.bb
+bb
+biz.bb
+com.bb
+edu.bb
+gov.bb
+info.bb
+net.bb
+org.bb
+store.bb
+
+// bd : http://en.wikipedia.org/wiki/.bd
+*.bd
+
+// be : http://en.wikipedia.org/wiki/.be
+// Confirmed by registry <tech@dns.be> 2008-06-08
+be
+ac.be
+
+// bf : http://en.wikipedia.org/wiki/.bf
+bf
+gov.bf
+
+// bg : http://en.wikipedia.org/wiki/.bg
+// https://www.register.bg/user/static/rules/en/index.html
+bg
+a.bg
+b.bg
+c.bg
+d.bg
+e.bg
+f.bg
+g.bg
+h.bg
+i.bg
+j.bg
+k.bg
+l.bg
+m.bg
+n.bg
+o.bg
+p.bg
+q.bg
+r.bg
+s.bg
+t.bg
+u.bg
+v.bg
+w.bg
+x.bg
+y.bg
+z.bg
+0.bg
+1.bg
+2.bg
+3.bg
+4.bg
+5.bg
+6.bg
+7.bg
+8.bg
+9.bg
+
+// bh : http://en.wikipedia.org/wiki/.bh
+bh
+com.bh
+edu.bh
+net.bh
+org.bh
+gov.bh
+
+// bi : http://en.wikipedia.org/wiki/.bi
+// http://whois.nic.bi/
+bi
+co.bi
+com.bi
+edu.bi
+or.bi
+org.bi
+
+// biz : http://en.wikipedia.org/wiki/.biz
+biz
+
+// bj : http://en.wikipedia.org/wiki/.bj
+bj
+asso.bj
+barreau.bj
+gouv.bj
+
+// bm : http://www.bermudanic.bm/dnr-text.txt
+bm
+com.bm
+edu.bm
+gov.bm
+net.bm
+org.bm
+
+// bn : http://en.wikipedia.org/wiki/.bn
+*.bn
+
+// bo : http://www.nic.bo/
+bo
+com.bo
+edu.bo
+gov.bo
+gob.bo
+int.bo
+org.bo
+net.bo
+mil.bo
+tv.bo
+
+// br : http://registro.br/dominio/dpn.html
+// Updated by registry <fneves@registro.br> 2011-03-01
+br
+adm.br
+adv.br
+agr.br
+am.br
+arq.br
+art.br
+ato.br
+b.br
+bio.br
+blog.br
+bmd.br
+can.br
+cim.br
+cng.br
+cnt.br
+com.br
+coop.br
+ecn.br
+edu.br
+emp.br
+eng.br
+esp.br
+etc.br
+eti.br
+far.br
+flog.br
+fm.br
+fnd.br
+fot.br
+fst.br
+g12.br
+ggf.br
+gov.br
+imb.br
+ind.br
+inf.br
+jor.br
+jus.br
+lel.br
+mat.br
+med.br
+mil.br
+mus.br
+net.br
+nom.br
+not.br
+ntr.br
+odo.br
+org.br
+ppg.br
+pro.br
+psc.br
+psi.br
+qsl.br
+radio.br
+rec.br
+slg.br
+srv.br
+taxi.br
+teo.br
+tmp.br
+trd.br
+tur.br
+tv.br
+vet.br
+vlog.br
+wiki.br
+zlg.br
+
+// bs : http://www.nic.bs/rules.html
+bs
+com.bs
+net.bs
+org.bs
+edu.bs
+gov.bs
+
+// bt : http://en.wikipedia.org/wiki/.bt
+bt
+com.bt
+edu.bt
+gov.bt
+net.bt
+org.bt
+
+// bv : No registrations at this time.
+// Submitted by registry <jarle@uninett.no> 2006-06-16
+
+// bw : http://en.wikipedia.org/wiki/.bw
+// http://www.gobin.info/domainname/bw.doc
+// list of other 2nd level tlds ?
+bw
+co.bw
+org.bw
+
+// by : http://en.wikipedia.org/wiki/.by
+// http://tld.by/rules_2006_en.html
+// list of other 2nd level tlds ?
+by
+gov.by
+mil.by
+// Official information does not indicate that com.by is a reserved
+// second-level domain, but it's being used as one (see www.google.com.by and
+// www.yahoo.com.by, for example), so we list it here for safety's sake.
+com.by
+
+// http://hoster.by/
+of.by
+
+// bz : http://en.wikipedia.org/wiki/.bz
+// http://www.belizenic.bz/
+bz
+com.bz
+net.bz
+org.bz
+edu.bz
+gov.bz
+
+// ca : http://en.wikipedia.org/wiki/.ca
+ca
+// ca geographical names
+ab.ca
+bc.ca
+mb.ca
+nb.ca
+nf.ca
+nl.ca
+ns.ca
+nt.ca
+nu.ca
+on.ca
+pe.ca
+qc.ca
+sk.ca
+yk.ca
+// gc.ca: http://en.wikipedia.org/wiki/.gc.ca
+// see also: http://registry.gc.ca/en/SubdomainFAQ
+gc.ca
+
+// cat : http://en.wikipedia.org/wiki/.cat
+cat
+
+// cc : http://en.wikipedia.org/wiki/.cc
+cc
+
+// cd : http://en.wikipedia.org/wiki/.cd
+// see also: https://www.nic.cd/domain/insertDomain_2.jsp?act=1
+cd
+gov.cd
+
+// cf : http://en.wikipedia.org/wiki/.cf
+cf
+
+// cg : http://en.wikipedia.org/wiki/.cg
+cg
+
+// ch : http://en.wikipedia.org/wiki/.ch
+ch
+
+// ci : http://en.wikipedia.org/wiki/.ci
+// http://www.nic.ci/index.php?page=charte
+ci
+org.ci
+or.ci
+com.ci
+co.ci
+edu.ci
+ed.ci
+ac.ci
+net.ci
+go.ci
+asso.ci
+aéroport.ci
+int.ci
+presse.ci
+md.ci
+gouv.ci
+
+// ck : http://en.wikipedia.org/wiki/.ck
+*.ck
+
+// cl : http://en.wikipedia.org/wiki/.cl
+cl
+gov.cl
+gob.cl
+
+// cm : http://en.wikipedia.org/wiki/.cm
+cm
+gov.cm
+
+// cn : http://en.wikipedia.org/wiki/.cn
+// Submitted by registry <tanyaling@cnnic.cn> 2008-06-11
+cn
+ac.cn
+com.cn
+edu.cn
+gov.cn
+net.cn
+org.cn
+mil.cn
+公司.cn
+网络.cn
+網絡.cn
+// cn geographic names
+ah.cn
+bj.cn
+cq.cn
+fj.cn
+gd.cn
+gs.cn
+gz.cn
+gx.cn
+ha.cn
+hb.cn
+he.cn
+hi.cn
+hl.cn
+hn.cn
+jl.cn
+js.cn
+jx.cn
+ln.cn
+nm.cn
+nx.cn
+qh.cn
+sc.cn
+sd.cn
+sh.cn
+sn.cn
+sx.cn
+tj.cn
+xj.cn
+xz.cn
+yn.cn
+zj.cn
+hk.cn
+mo.cn
+tw.cn
+
+// co : http://en.wikipedia.org/wiki/.co
+// Submitted by registry <tecnico@uniandes.edu.co> 2008-06-11
+co
+arts.co
+com.co
+edu.co
+firm.co
+gov.co
+info.co
+int.co
+mil.co
+net.co
+nom.co
+org.co
+rec.co
+web.co
+
+// com : http://en.wikipedia.org/wiki/.com
+com
+
+// CentralNic names : http://www.centralnic.com/names/domains
+// Confirmed by registry <gavin.brown@centralnic.com> 2008-06-09
+ar.com
+br.com
+cn.com
+de.com
+eu.com
+gb.com
+hu.com
+jpn.com
+kr.com
+no.com
+qc.com
+ru.com
+sa.com
+se.com
+uk.com
+us.com
+uy.com
+za.com
+
+// Requested by Yngve Pettersen <yngve@opera.com> 2009-11-26
+operaunite.com
+
+// Requested by Eduardo Vela <evn@google.com> 2010-09-06
+appspot.com
+
+// coop : http://en.wikipedia.org/wiki/.coop
+coop
+
+// cr : http://www.nic.cr/niccr_publico/showRegistroDominiosScreen.do
+cr
+ac.cr
+co.cr
+ed.cr
+fi.cr
+go.cr
+or.cr
+sa.cr
+
+// cu : http://en.wikipedia.org/wiki/.cu
+cu
+com.cu
+edu.cu
+org.cu
+net.cu
+gov.cu
+inf.cu
+
+// cv : http://en.wikipedia.org/wiki/.cv
+cv
+
+// cx : http://en.wikipedia.org/wiki/.cx
+// list of other 2nd level tlds ?
+cx
+gov.cx
+
+// cy : http://en.wikipedia.org/wiki/.cy
+*.cy
+
+// cz : http://en.wikipedia.org/wiki/.cz
+cz
+
+// de : http://en.wikipedia.org/wiki/.de
+// Confirmed by registry <ops@denic.de> (with technical
+// reservations) 2008-07-01
+de
+
+// dj : http://en.wikipedia.org/wiki/.dj
+dj
+
+// dk : http://en.wikipedia.org/wiki/.dk
+// Confirmed by registry <robert@dk-hostmaster.dk> 2008-06-17
+dk
+
+// dm : http://en.wikipedia.org/wiki/.dm
+dm
+com.dm
+net.dm
+org.dm
+edu.dm
+gov.dm
+
+// do : http://en.wikipedia.org/wiki/.do
+do
+art.do
+com.do
+edu.do
+gob.do
+gov.do
+mil.do
+net.do
+org.do
+sld.do
+web.do
+
+// dz : http://en.wikipedia.org/wiki/.dz
+dz
+com.dz
+org.dz
+net.dz
+gov.dz
+edu.dz
+asso.dz
+pol.dz
+art.dz
+
+// ec : http://www.nic.ec/reg/paso1.asp
+// Submitted by registry <vabboud@nic.ec> 2008-07-04
+ec
+com.ec
+info.ec
+net.ec
+fin.ec
+k12.ec
+med.ec
+pro.ec
+org.ec
+edu.ec
+gov.ec
+gob.ec
+mil.ec
+
+// edu : http://en.wikipedia.org/wiki/.edu
+edu
+
+// ee : http://www.eenet.ee/EENet/dom_reeglid.html#lisa_B
+ee
+edu.ee
+gov.ee
+riik.ee
+lib.ee
+med.ee
+com.ee
+pri.ee
+aip.ee
+org.ee
+fie.ee
+
+// eg : http://en.wikipedia.org/wiki/.eg
+eg
+com.eg
+edu.eg
+eun.eg
+gov.eg
+mil.eg
+name.eg
+net.eg
+org.eg
+sci.eg
+
+// er : http://en.wikipedia.org/wiki/.er
+*.er
+
+// es : https://www.nic.es/site_ingles/ingles/dominios/index.html
+es
+com.es
+nom.es
+org.es
+gob.es
+edu.es
+
+// et : http://en.wikipedia.org/wiki/.et
+*.et
+
+// eu : http://en.wikipedia.org/wiki/.eu
+eu
+
+// fi : http://en.wikipedia.org/wiki/.fi
+fi
+// aland.fi : http://en.wikipedia.org/wiki/.ax
+// This domain is being phased out in favor of .ax. As there are still many
+// domains under aland.fi, we still keep it on the list until aland.fi is
+// completely removed.
+// TODO: Check for updates (expected to be phased out around Q1/2009)
+aland.fi
+// iki.fi : Submitted by Hannu Aronsson <haa@iki.fi> 2009-11-05
+iki.fi
+
+// fj : http://en.wikipedia.org/wiki/.fj
+*.fj
+
+// fk : http://en.wikipedia.org/wiki/.fk
+*.fk
+
+// fm : http://en.wikipedia.org/wiki/.fm
+fm
+
+// fo : http://en.wikipedia.org/wiki/.fo
+fo
+
+// fr : http://www.afnic.fr/
+// domaines descriptifs : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-descriptifs
+fr
+com.fr
+asso.fr
+nom.fr
+prd.fr
+presse.fr
+tm.fr
+// domaines sectoriels : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-sectoriels
+aeroport.fr
+assedic.fr
+avocat.fr
+avoues.fr
+cci.fr
+chambagri.fr
+chirurgiens-dentistes.fr
+experts-comptables.fr
+geometre-expert.fr
+gouv.fr
+greta.fr
+huissier-justice.fr
+medecin.fr
+notaires.fr
+pharmacien.fr
+port.fr
+veterinaire.fr
+
+// ga : http://en.wikipedia.org/wiki/.ga
+ga
+
+// gb : This registry is effectively dormant
+// Submitted by registry <Damien.Shaw@ja.net> 2008-06-12
+
+// gd : http://en.wikipedia.org/wiki/.gd
+gd
+
+// ge : http://www.nic.net.ge/policy_en.pdf
+ge
+com.ge
+edu.ge
+gov.ge
+org.ge
+mil.ge
+net.ge
+pvt.ge
+
+// gf : http://en.wikipedia.org/wiki/.gf
+gf
+
+// gg : http://www.channelisles.net/applic/avextn.shtml
+gg
+co.gg
+org.gg
+net.gg
+sch.gg
+gov.gg
+
+// gh : http://en.wikipedia.org/wiki/.gh
+// see also: http://www.nic.gh/reg_now.php
+// Although domains directly at second level are not possible at the moment,
+// they have been possible for some time and may come back.
+gh
+com.gh
+edu.gh
+gov.gh
+org.gh
+mil.gh
+
+// gi : http://www.nic.gi/rules.html
+gi
+com.gi
+ltd.gi
+gov.gi
+mod.gi
+edu.gi
+org.gi
+
+// gl : http://en.wikipedia.org/wiki/.gl
+// http://nic.gl
+gl
+
+// gm : http://www.nic.gm/htmlpages%5Cgm-policy.htm
+gm
+
+// gn : http://psg.com/dns/gn/gn.txt
+// Submitted by registry <randy@psg.com> 2008-06-17
+ac.gn
+com.gn
+edu.gn
+gov.gn
+org.gn
+net.gn
+
+// gov : http://en.wikipedia.org/wiki/.gov
+gov
+
+// gp : http://www.nic.gp/index.php?lang=en
+gp
+com.gp
+net.gp
+mobi.gp
+edu.gp
+org.gp
+asso.gp
+
+// gq : http://en.wikipedia.org/wiki/.gq
+gq
+
+// gr : https://grweb.ics.forth.gr/english/1617-B-2005.html
+// Submitted by registry <segred@ics.forth.gr> 2008-06-09
+gr
+com.gr
+edu.gr
+net.gr
+org.gr
+gov.gr
+
+// gs : http://en.wikipedia.org/wiki/.gs
+gs
+
+// gt : http://www.gt/politicas.html
+*.gt
+
+// gu : http://gadao.gov.gu/registration.txt
+*.gu
+
+// gw : http://en.wikipedia.org/wiki/.gw
+gw
+
+// gy : http://en.wikipedia.org/wiki/.gy
+// http://registry.gy/
+gy
+co.gy
+com.gy
+net.gy
+
+// hk : https://www.hkdnr.hk
+// Submitted by registry <hk.tech@hkirc.hk> 2008-06-11
+hk
+com.hk
+edu.hk
+gov.hk
+idv.hk
+net.hk
+org.hk
+公司.hk
+教育.hk
+敎育.hk
+政府.hk
+個人.hk
+个人.hk
+箇人.hk
+網络.hk
+网络.hk
+组織.hk
+網絡.hk
+网絡.hk
+组织.hk
+組織.hk
+組织.hk
+
+// hm : http://en.wikipedia.org/wiki/.hm
+hm
+
+// hn : http://www.nic.hn/politicas/ps02,,05.html
+hn
+com.hn
+edu.hn
+org.hn
+net.hn
+mil.hn
+gob.hn
+
+// hr : http://www.dns.hr/documents/pdf/HRTLD-regulations.pdf
+hr
+iz.hr
+from.hr
+name.hr
+com.hr
+
+// ht : http://www.nic.ht/info/charte.cfm
+ht
+com.ht
+shop.ht
+firm.ht
+info.ht
+adult.ht
+net.ht
+pro.ht
+org.ht
+med.ht
+art.ht
+coop.ht
+pol.ht
+asso.ht
+edu.ht
+rel.ht
+gouv.ht
+perso.ht
+
+// hu : http://www.domain.hu/domain/English/sld.html
+// Confirmed by registry <pasztor@iszt.hu> 2008-06-12
+hu
+co.hu
+info.hu
+org.hu
+priv.hu
+sport.hu
+tm.hu
+2000.hu
+agrar.hu
+bolt.hu
+casino.hu
+city.hu
+erotica.hu
+erotika.hu
+film.hu
+forum.hu
+games.hu
+hotel.hu
+ingatlan.hu
+jogasz.hu
+konyvelo.hu
+lakas.hu
+media.hu
+news.hu
+reklam.hu
+sex.hu
+shop.hu
+suli.hu
+szex.hu
+tozsde.hu
+utazas.hu
+video.hu
+
+// id : http://en.wikipedia.org/wiki/.id
+// see also: https://register.pandi.or.id/
+id
+ac.id
+co.id
+go.id
+mil.id
+net.id
+or.id
+sch.id
+web.id
+
+// ie : http://en.wikipedia.org/wiki/.ie
+ie
+gov.ie
+
+// il : http://en.wikipedia.org/wiki/.il
+*.il
+
+// im : https://www.nic.im/pdfs/imfaqs.pdf
+im
+co.im
+ltd.co.im
+plc.co.im
+net.im
+gov.im
+org.im
+nic.im
+ac.im
+
+// in : http://en.wikipedia.org/wiki/.in
+// see also: http://www.inregistry.in/policies/
+// Please note, that nic.in is not an offical eTLD, but used by most
+// government institutions.
+in
+co.in
+firm.in
+net.in
+org.in
+gen.in
+ind.in
+nic.in
+ac.in
+edu.in
+res.in
+gov.in
+mil.in
+
+// info : http://en.wikipedia.org/wiki/.info
+info
+
+// int : http://en.wikipedia.org/wiki/.int
+// Confirmed by registry <iana-questions@icann.org> 2008-06-18
+int
+eu.int
+
+// io : http://www.nic.io/rules.html
+// list of other 2nd level tlds ?
+io
+com.io
+
+// iq : http://www.cmc.iq/english/iq/iqregister1.htm
+iq
+gov.iq
+edu.iq
+mil.iq
+com.iq
+org.iq
+net.iq
+
+// ir : http://www.nic.ir/Terms_and_Conditions_ir,_Appendix_1_Domain_Rules
+// Also see http://www.nic.ir/Internationalized_Domain_Names
+// Two <iran>.ir entries added at request of <tech-team@nic.ir>, 2010-04-16
+ir
+ac.ir
+co.ir
+gov.ir
+id.ir
+net.ir
+org.ir
+sch.ir
+// xn--mgba3a4f16a.ir (<iran>.ir, Persian YEH)
+ایران.ir
+// xn--mgba3a4fra.ir (<iran>.ir, Arabic YEH)
+ايران.ir
+
+// is : http://www.isnic.is/domain/rules.php
+// Confirmed by registry <marius@isgate.is> 2008-12-06
+is
+net.is
+com.is
+edu.is
+gov.is
+org.is
+int.is
+
+// it : http://en.wikipedia.org/wiki/.it
+it
+gov.it
+edu.it
+// list of reserved geo-names :
+// http://www.nic.it/documenti/regolamenti-e-linee-guida/regolamento-assegnazione-versione-6.0.pdf
+// (There is also a list of reserved geo-names corresponding to Italian
+// municipalities : http://www.nic.it/documenti/appendice-c.pdf , but it is
+// not included here.)
+agrigento.it
+ag.it
+alessandria.it
+al.it
+ancona.it
+an.it
+aosta.it
+aoste.it
+ao.it
+arezzo.it
+ar.it
+ascoli-piceno.it
+ascolipiceno.it
+ap.it
+asti.it
+at.it
+avellino.it
+av.it
+bari.it
+ba.it
+andria-barletta-trani.it
+andriabarlettatrani.it
+trani-barletta-andria.it
+tranibarlettaandria.it
+barletta-trani-andria.it
+barlettatraniandria.it
+andria-trani-barletta.it
+andriatranibarletta.it
+trani-andria-barletta.it
+traniandriabarletta.it
+bt.it
+belluno.it
+bl.it
+benevento.it
+bn.it
+bergamo.it
+bg.it
+biella.it
+bi.it
+bologna.it
+bo.it
+bolzano.it
+bozen.it
+balsan.it
+alto-adige.it
+altoadige.it
+suedtirol.it
+bz.it
+brescia.it
+bs.it
+brindisi.it
+br.it
+cagliari.it
+ca.it
+caltanissetta.it
+cl.it
+campobasso.it
+cb.it
+carboniaiglesias.it
+carbonia-iglesias.it
+iglesias-carbonia.it
+iglesiascarbonia.it
+ci.it
+caserta.it
+ce.it
+catania.it
+ct.it
+catanzaro.it
+cz.it
+chieti.it
+ch.it
+como.it
+co.it
+cosenza.it
+cs.it
+cremona.it
+cr.it
+crotone.it
+kr.it
+cuneo.it
+cn.it
+dell-ogliastra.it
+dellogliastra.it
+ogliastra.it
+og.it
+enna.it
+en.it
+ferrara.it
+fe.it
+fermo.it
+fm.it
+firenze.it
+florence.it
+fi.it
+foggia.it
+fg.it
+forli-cesena.it
+forlicesena.it
+cesena-forli.it
+cesenaforli.it
+fc.it
+frosinone.it
+fr.it
+genova.it
+genoa.it
+ge.it
+gorizia.it
+go.it
+grosseto.it
+gr.it
+imperia.it
+im.it
+isernia.it
+is.it
+laquila.it
+aquila.it
+aq.it
+la-spezia.it
+laspezia.it
+sp.it
+latina.it
+lt.it
+lecce.it
+le.it
+lecco.it
+lc.it
+livorno.it
+li.it
+lodi.it
+lo.it
+lucca.it
+lu.it
+macerata.it
+mc.it
+mantova.it
+mn.it
+massa-carrara.it
+massacarrara.it
+carrara-massa.it
+carraramassa.it
+ms.it
+matera.it
+mt.it
+medio-campidano.it
+mediocampidano.it
+campidano-medio.it
+campidanomedio.it
+vs.it
+messina.it
+me.it
+milano.it
+milan.it
+mi.it
+modena.it
+mo.it
+monza.it
+monza-brianza.it
+monzabrianza.it
+monzaebrianza.it
+monzaedellabrianza.it
+monza-e-della-brianza.it
+mb.it
+napoli.it
+naples.it
+na.it
+novara.it
+no.it
+nuoro.it
+nu.it
+oristano.it
+or.it
+padova.it
+padua.it
+pd.it
+palermo.it
+pa.it
+parma.it
+pr.it
+pavia.it
+pv.it
+perugia.it
+pg.it
+pescara.it
+pe.it
+pesaro-urbino.it
+pesarourbino.it
+urbino-pesaro.it
+urbinopesaro.it
+pu.it
+piacenza.it
+pc.it
+pisa.it
+pi.it
+pistoia.it
+pt.it
+pordenone.it
+pn.it
+potenza.it
+pz.it
+prato.it
+po.it
+ragusa.it
+rg.it
+ravenna.it
+ra.it
+reggio-calabria.it
+reggiocalabria.it
+rc.it
+reggio-emilia.it
+reggioemilia.it
+re.it
+rieti.it
+ri.it
+rimini.it
+rn.it
+roma.it
+rome.it
+rm.it
+rovigo.it
+ro.it
+salerno.it
+sa.it
+sassari.it
+ss.it
+savona.it
+sv.it
+siena.it
+si.it
+siracusa.it
+sr.it
+sondrio.it
+so.it
+taranto.it
+ta.it
+tempio-olbia.it
+tempioolbia.it
+olbia-tempio.it
+olbiatempio.it
+ot.it
+teramo.it
+te.it
+terni.it
+tr.it
+torino.it
+turin.it
+to.it
+trapani.it
+tp.it
+trento.it
+trentino.it
+tn.it
+treviso.it
+tv.it
+trieste.it
+ts.it
+udine.it
+ud.it
+varese.it
+va.it
+venezia.it
+venice.it
+ve.it
+verbania.it
+vb.it
+vercelli.it
+vc.it
+verona.it
+vr.it
+vibo-valentia.it
+vibovalentia.it
+vv.it
+vicenza.it
+vi.it
+viterbo.it
+vt.it
+
+// je : http://www.channelisles.net/applic/avextn.shtml
+je
+co.je
+org.je
+net.je
+sch.je
+gov.je
+
+// jm : http://www.com.jm/register.html
+*.jm
+
+// jo : http://www.dns.jo/Registration_policy.aspx
+jo
+com.jo
+org.jo
+net.jo
+edu.jo
+sch.jo
+gov.jo
+mil.jo
+name.jo
+
+// jobs : http://en.wikipedia.org/wiki/.jobs
+jobs
+
+// jp : http://en.wikipedia.org/wiki/.jp
+// http://jprs.co.jp/en/jpdomain.html
+// Submitted by registry <yone@jprs.co.jp> 2008-06-11
+// Updated by registry <yone@jprs.co.jp> 2008-12-04
+jp
+// jp organizational type names
+ac.jp
+ad.jp
+co.jp
+ed.jp
+go.jp
+gr.jp
+lg.jp
+ne.jp
+or.jp
+// jp geographic type names
+// http://jprs.jp/doc/rule/saisoku-1.html
+*.aichi.jp
+*.akita.jp
+*.aomori.jp
+*.chiba.jp
+*.ehime.jp
+*.fukui.jp
+*.fukuoka.jp
+*.fukushima.jp
+*.gifu.jp
+*.gunma.jp
+*.hiroshima.jp
+*.hokkaido.jp
+*.hyogo.jp
+*.ibaraki.jp
+*.ishikawa.jp
+*.iwate.jp
+*.kagawa.jp
+*.kagoshima.jp
+*.kanagawa.jp
+*.kawasaki.jp
+*.kitakyushu.jp
+*.kobe.jp
+*.kochi.jp
+*.kumamoto.jp
+*.kyoto.jp
+*.mie.jp
+*.miyagi.jp
+*.miyazaki.jp
+*.nagano.jp
+*.nagasaki.jp
+*.nagoya.jp
+*.nara.jp
+*.niigata.jp
+*.oita.jp
+*.okayama.jp
+*.okinawa.jp
+*.osaka.jp
+*.saga.jp
+*.saitama.jp
+*.sapporo.jp
+*.sendai.jp
+*.shiga.jp
+*.shimane.jp
+*.shizuoka.jp
+*.tochigi.jp
+*.tokushima.jp
+*.tokyo.jp
+*.tottori.jp
+*.toyama.jp
+*.wakayama.jp
+*.yamagata.jp
+*.yamaguchi.jp
+*.yamanashi.jp
+*.yokohama.jp
+!metro.tokyo.jp
+!pref.aichi.jp
+!pref.akita.jp
+!pref.aomori.jp
+!pref.chiba.jp
+!pref.ehime.jp
+!pref.fukui.jp
+!pref.fukuoka.jp
+!pref.fukushima.jp
+!pref.gifu.jp
+!pref.gunma.jp
+!pref.hiroshima.jp
+!pref.hokkaido.jp
+!pref.hyogo.jp
+!pref.ibaraki.jp
+!pref.ishikawa.jp
+!pref.iwate.jp
+!pref.kagawa.jp
+!pref.kagoshima.jp
+!pref.kanagawa.jp
+!pref.kochi.jp
+!pref.kumamoto.jp
+!pref.kyoto.jp
+!pref.mie.jp
+!pref.miyagi.jp
+!pref.miyazaki.jp
+!pref.nagano.jp
+!pref.nagasaki.jp
+!pref.nara.jp
+!pref.niigata.jp
+!pref.oita.jp
+!pref.okayama.jp
+!pref.okinawa.jp
+!pref.osaka.jp
+!pref.saga.jp
+!pref.saitama.jp
+!pref.shiga.jp
+!pref.shimane.jp
+!pref.shizuoka.jp
+!pref.tochigi.jp
+!pref.tokushima.jp
+!pref.tottori.jp
+!pref.toyama.jp
+!pref.wakayama.jp
+!pref.yamagata.jp
+!pref.yamaguchi.jp
+!pref.yamanashi.jp
+!city.chiba.jp
+!city.fukuoka.jp
+!city.hiroshima.jp
+!city.kawasaki.jp
+!city.kitakyushu.jp
+!city.kobe.jp
+!city.kyoto.jp
+!city.nagoya.jp
+!city.niigata.jp
+!city.okayama.jp
+!city.osaka.jp
+!city.saitama.jp
+!city.sapporo.jp
+!city.sendai.jp
+!city.shizuoka.jp
+!city.yokohama.jp
+
+// ke : http://www.kenic.or.ke/index.php?option=com_content&task=view&id=117&Itemid=145
+*.ke
+
+// kg : http://www.domain.kg/dmn_n.html
+kg
+org.kg
+net.kg
+com.kg
+edu.kg
+gov.kg
+mil.kg
+
+// kh : http://www.mptc.gov.kh/dns_registration.htm
+*.kh
+
+// ki : http://www.ki/dns/index.html
+ki
+edu.ki
+biz.ki
+net.ki
+org.ki
+gov.ki
+info.ki
+com.ki
+
+// km : http://en.wikipedia.org/wiki/.km
+// http://www.domaine.km/documents/charte.doc
+km
+org.km
+nom.km
+gov.km
+prd.km
+tm.km
+edu.km
+mil.km
+ass.km
+com.km
+// These are only mentioned as proposed suggestions at domaine.km, but
+// http://en.wikipedia.org/wiki/.km says they're available for registration:
+coop.km
+asso.km
+presse.km
+medecin.km
+notaires.km
+pharmaciens.km
+veterinaire.km
+gouv.km
+
+// kn : http://en.wikipedia.org/wiki/.kn
+// http://www.dot.kn/domainRules.html
+kn
+net.kn
+org.kn
+edu.kn
+gov.kn
+
+// kp : http://www.kcce.kp/en_index.php
+com.kp
+edu.kp
+gov.kp
+org.kp
+rep.kp
+tra.kp
+
+// kr : http://en.wikipedia.org/wiki/.kr
+// see also: http://domain.nida.or.kr/eng/registration.jsp
+kr
+ac.kr
+co.kr
+es.kr
+go.kr
+hs.kr
+kg.kr
+mil.kr
+ms.kr
+ne.kr
+or.kr
+pe.kr
+re.kr
+sc.kr
+// kr geographical names
+busan.kr
+chungbuk.kr
+chungnam.kr
+daegu.kr
+daejeon.kr
+gangwon.kr
+gwangju.kr
+gyeongbuk.kr
+gyeonggi.kr
+gyeongnam.kr
+incheon.kr
+jeju.kr
+jeonbuk.kr
+jeonnam.kr
+seoul.kr
+ulsan.kr
+
+// kw : http://en.wikipedia.org/wiki/.kw
+*.kw
+
+// ky : http://www.icta.ky/da_ky_reg_dom.php
+// Confirmed by registry <kysupport@perimeterusa.com> 2008-06-17
+ky
+edu.ky
+gov.ky
+com.ky
+org.ky
+net.ky
+
+// kz : http://en.wikipedia.org/wiki/.kz
+// see also: http://www.nic.kz/rules/index.jsp
+kz
+org.kz
+edu.kz
+net.kz
+gov.kz
+mil.kz
+com.kz
+
+// la : http://en.wikipedia.org/wiki/.la
+// Submitted by registry <gavin.brown@nic.la> 2008-06-10
+la
+int.la
+net.la
+info.la
+edu.la
+gov.la
+per.la
+com.la
+org.la
+// see http://www.c.la/
+c.la
+
+// lb : http://en.wikipedia.org/wiki/.lb
+// Submitted by registry <randy@psg.com> 2008-06-17
+com.lb
+edu.lb
+gov.lb
+net.lb
+org.lb
+
+// lc : http://en.wikipedia.org/wiki/.lc
+// see also: http://www.nic.lc/rules.htm
+lc
+com.lc
+net.lc
+co.lc
+org.lc
+edu.lc
+gov.lc
+
+// li : http://en.wikipedia.org/wiki/.li
+li
+
+// lk : http://www.nic.lk/seclevpr.html
+lk
+gov.lk
+sch.lk
+net.lk
+int.lk
+com.lk
+org.lk
+edu.lk
+ngo.lk
+soc.lk
+web.lk
+ltd.lk
+assn.lk
+grp.lk
+hotel.lk
+
+// local : http://en.wikipedia.org/wiki/.local
+local
+
+// lr : http://psg.com/dns/lr/lr.txt
+// Submitted by registry <randy@psg.com> 2008-06-17
+com.lr
+edu.lr
+gov.lr
+org.lr
+net.lr
+
+// ls : http://en.wikipedia.org/wiki/.ls
+ls
+co.ls
+org.ls
+
+// lt : http://en.wikipedia.org/wiki/.lt
+lt
+// gov.lt : http://www.gov.lt/index_en.php
+gov.lt
+
+// lu : http://www.dns.lu/en/
+lu
+
+// lv : http://www.nic.lv/DNS/En/generic.php
+lv
+com.lv
+edu.lv
+gov.lv
+org.lv
+mil.lv
+id.lv
+net.lv
+asn.lv
+conf.lv
+
+// ly : http://www.nic.ly/regulations.php
+ly
+com.ly
+net.ly
+gov.ly
+plc.ly
+edu.ly
+sch.ly
+med.ly
+org.ly
+id.ly
+
+// ma : http://en.wikipedia.org/wiki/.ma
+// http://www.anrt.ma/fr/admin/download/upload/file_fr782.pdf
+ma
+co.ma
+net.ma
+gov.ma
+org.ma
+ac.ma
+press.ma
+
+// mc : http://www.nic.mc/
+mc
+tm.mc
+asso.mc
+
+// md : http://en.wikipedia.org/wiki/.md
+md
+
+// me : http://en.wikipedia.org/wiki/.me
+me
+co.me
+net.me
+org.me
+edu.me
+ac.me
+gov.me
+its.me
+priv.me
+
+// mg : http://www.nic.mg/tarif.htm
+mg
+org.mg
+nom.mg
+gov.mg
+prd.mg
+tm.mg
+edu.mg
+mil.mg
+com.mg
+
+// mh : http://en.wikipedia.org/wiki/.mh
+mh
+
+// mil : http://en.wikipedia.org/wiki/.mil
+mil
+
+// mk : http://en.wikipedia.org/wiki/.mk
+// see also: http://dns.marnet.net.mk/postapka.php
+mk
+com.mk
+org.mk
+net.mk
+edu.mk
+gov.mk
+inf.mk
+name.mk
+
+// ml : http://www.gobin.info/domainname/ml-template.doc
+// see also: http://en.wikipedia.org/wiki/.ml
+ml
+com.ml
+edu.ml
+gouv.ml
+gov.ml
+net.ml
+org.ml
+presse.ml
+
+// mm : http://en.wikipedia.org/wiki/.mm
+*.mm
+
+// mn : http://en.wikipedia.org/wiki/.mn
+mn
+gov.mn
+edu.mn
+org.mn
+
+// mo : http://www.monic.net.mo/
+mo
+com.mo
+net.mo
+org.mo
+edu.mo
+gov.mo
+
+// mobi : http://en.wikipedia.org/wiki/.mobi
+mobi
+
+// mp : http://www.dot.mp/
+// Confirmed by registry <dcamacho@saipan.com> 2008-06-17
+mp
+
+// mq : http://en.wikipedia.org/wiki/.mq
+mq
+
+// mr : http://en.wikipedia.org/wiki/.mr
+mr
+gov.mr
+
+// ms : http://en.wikipedia.org/wiki/.ms
+ms
+
+// mt : https://www.nic.org.mt/dotmt/
+*.mt
+
+// mu : http://en.wikipedia.org/wiki/.mu
+mu
+com.mu
+net.mu
+org.mu
+gov.mu
+ac.mu
+co.mu
+or.mu
+
+// museum : http://about.museum/naming/
+// http://index.museum/
+museum
+academy.museum
+agriculture.museum
+air.museum
+airguard.museum
+alabama.museum
+alaska.museum
+amber.museum
+ambulance.museum
+american.museum
+americana.museum
+americanantiques.museum
+americanart.museum
+amsterdam.museum
+and.museum
+annefrank.museum
+anthro.museum
+anthropology.museum
+antiques.museum
+aquarium.museum
+arboretum.museum
+archaeological.museum
+archaeology.museum
+architecture.museum
+art.museum
+artanddesign.museum
+artcenter.museum
+artdeco.museum
+arteducation.museum
+artgallery.museum
+arts.museum
+artsandcrafts.museum
+asmatart.museum
+assassination.museum
+assisi.museum
+association.museum
+astronomy.museum
+atlanta.museum
+austin.museum
+australia.museum
+automotive.museum
+aviation.museum
+axis.museum
+badajoz.museum
+baghdad.museum
+bahn.museum
+bale.museum
+baltimore.museum
+barcelona.museum
+baseball.museum
+basel.museum
+baths.museum
+bauern.museum
+beauxarts.museum
+beeldengeluid.museum
+bellevue.museum
+bergbau.museum
+berkeley.museum
+berlin.museum
+bern.museum
+bible.museum
+bilbao.museum
+bill.museum
+birdart.museum
+birthplace.museum
+bonn.museum
+boston.museum
+botanical.museum
+botanicalgarden.museum
+botanicgarden.museum
+botany.museum
+brandywinevalley.museum
+brasil.museum
+bristol.museum
+british.museum
+britishcolumbia.museum
+broadcast.museum
+brunel.museum
+brussel.museum
+brussels.museum
+bruxelles.museum
+building.museum
+burghof.museum
+bus.museum
+bushey.museum
+cadaques.museum
+california.museum
+cambridge.museum
+can.museum
+canada.museum
+capebreton.museum
+carrier.museum
+cartoonart.museum
+casadelamoneda.museum
+castle.museum
+castres.museum
+celtic.museum
+center.museum
+chattanooga.museum
+cheltenham.museum
+chesapeakebay.museum
+chicago.museum
+children.museum
+childrens.museum
+childrensgarden.museum
+chiropractic.museum
+chocolate.museum
+christiansburg.museum
+cincinnati.museum
+cinema.museum
+circus.museum
+civilisation.museum
+civilization.museum
+civilwar.museum
+clinton.museum
+clock.museum
+coal.museum
+coastaldefence.museum
+cody.museum
+coldwar.museum
+collection.museum
+colonialwilliamsburg.museum
+coloradoplateau.museum
+columbia.museum
+columbus.museum
+communication.museum
+communications.museum
+community.museum
+computer.museum
+computerhistory.museum
+comunicações.museum
+contemporary.museum
+contemporaryart.museum
+convent.museum
+copenhagen.museum
+corporation.museum
+correios-e-telecomunicações.museum
+corvette.museum
+costume.museum
+countryestate.museum
+county.museum
+crafts.museum
+cranbrook.museum
+creation.museum
+cultural.museum
+culturalcenter.museum
+culture.museum
+cyber.museum
+cymru.museum
+dali.museum
+dallas.museum
+database.museum
+ddr.museum
+decorativearts.museum
+delaware.museum
+delmenhorst.museum
+denmark.museum
+depot.museum
+design.museum
+detroit.museum
+dinosaur.museum
+discovery.museum
+dolls.museum
+donostia.museum
+durham.museum
+eastafrica.museum
+eastcoast.museum
+education.museum
+educational.museum
+egyptian.museum
+eisenbahn.museum
+elburg.museum
+elvendrell.museum
+embroidery.museum
+encyclopedic.museum
+england.museum
+entomology.museum
+environment.museum
+environmentalconservation.museum
+epilepsy.museum
+essex.museum
+estate.museum
+ethnology.museum
+exeter.museum
+exhibition.museum
+family.museum
+farm.museum
+farmequipment.museum
+farmers.museum
+farmstead.museum
+field.museum
+figueres.museum
+filatelia.museum
+film.museum
+fineart.museum
+finearts.museum
+finland.museum
+flanders.museum
+florida.museum
+force.museum
+fortmissoula.museum
+fortworth.museum
+foundation.museum
+francaise.museum
+frankfurt.museum
+franziskaner.museum
+freemasonry.museum
+freiburg.museum
+fribourg.museum
+frog.museum
+fundacio.museum
+furniture.museum
+gallery.museum
+garden.museum
+gateway.museum
+geelvinck.museum
+gemological.museum
+geology.museum
+georgia.museum
+giessen.museum
+glas.museum
+glass.museum
+gorge.museum
+grandrapids.museum
+graz.museum
+guernsey.museum
+halloffame.museum
+hamburg.museum
+handson.museum
+harvestcelebration.museum
+hawaii.museum
+health.museum
+heimatunduhren.museum
+hellas.museum
+helsinki.museum
+hembygdsforbund.museum
+heritage.museum
+histoire.museum
+historical.museum
+historicalsociety.museum
+historichouses.museum
+historisch.museum
+historisches.museum
+history.museum
+historyofscience.museum
+horology.museum
+house.museum
+humanities.museum
+illustration.museum
+imageandsound.museum
+indian.museum
+indiana.museum
+indianapolis.museum
+indianmarket.museum
+intelligence.museum
+interactive.museum
+iraq.museum
+iron.museum
+isleofman.museum
+jamison.museum
+jefferson.museum
+jerusalem.museum
+jewelry.museum
+jewish.museum
+jewishart.museum
+jfk.museum
+journalism.museum
+judaica.museum
+judygarland.museum
+juedisches.museum
+juif.museum
+karate.museum
+karikatur.museum
+kids.museum
+koebenhavn.museum
+koeln.museum
+kunst.museum
+kunstsammlung.museum
+kunstunddesign.museum
+labor.museum
+labour.museum
+lajolla.museum
+lancashire.museum
+landes.museum
+lans.museum
+läns.museum
+larsson.museum
+lewismiller.museum
+lincoln.museum
+linz.museum
+living.museum
+livinghistory.museum
+localhistory.museum
+london.museum
+losangeles.museum
+louvre.museum
+loyalist.museum
+lucerne.museum
+luxembourg.museum
+luzern.museum
+mad.museum
+madrid.museum
+mallorca.museum
+manchester.museum
+mansion.museum
+mansions.museum
+manx.museum
+marburg.museum
+maritime.museum
+maritimo.museum
+maryland.museum
+marylhurst.museum
+media.museum
+medical.museum
+medizinhistorisches.museum
+meeres.museum
+memorial.museum
+mesaverde.museum
+michigan.museum
+midatlantic.museum
+military.museum
+mill.museum
+miners.museum
+mining.museum
+minnesota.museum
+missile.museum
+missoula.museum
+modern.museum
+moma.museum
+money.museum
+monmouth.museum
+monticello.museum
+montreal.museum
+moscow.museum
+motorcycle.museum
+muenchen.museum
+muenster.museum
+mulhouse.museum
+muncie.museum
+museet.museum
+museumcenter.museum
+museumvereniging.museum
+music.museum
+national.museum
+nationalfirearms.museum
+nationalheritage.museum
+nativeamerican.museum
+naturalhistory.museum
+naturalhistorymuseum.museum
+naturalsciences.museum
+nature.museum
+naturhistorisches.museum
+natuurwetenschappen.museum
+naumburg.museum
+naval.museum
+nebraska.museum
+neues.museum
+newhampshire.museum
+newjersey.museum
+newmexico.museum
+newport.museum
+newspaper.museum
+newyork.museum
+niepce.museum
+norfolk.museum
+north.museum
+nrw.museum
+nuernberg.museum
+nuremberg.museum
+nyc.museum
+nyny.museum
+oceanographic.museum
+oceanographique.museum
+omaha.museum
+online.museum
+ontario.museum
+openair.museum
+oregon.museum
+oregontrail.museum
+otago.museum
+oxford.museum
+pacific.museum
+paderborn.museum
+palace.museum
+paleo.museum
+palmsprings.museum
+panama.museum
+paris.museum
+pasadena.museum
+pharmacy.museum
+philadelphia.museum
+philadelphiaarea.museum
+philately.museum
+phoenix.museum
+photography.museum
+pilots.museum
+pittsburgh.museum
+planetarium.museum
+plantation.museum
+plants.museum
+plaza.museum
+portal.museum
+portland.museum
+portlligat.museum
+posts-and-telecommunications.museum
+preservation.museum
+presidio.museum
+press.museum
+project.museum
+public.museum
+pubol.museum
+quebec.museum
+railroad.museum
+railway.museum
+research.museum
+resistance.museum
+riodejaneiro.museum
+rochester.museum
+rockart.museum
+roma.museum
+russia.museum
+saintlouis.museum
+salem.museum
+salvadordali.museum
+salzburg.museum
+sandiego.museum
+sanfrancisco.museum
+santabarbara.museum
+santacruz.museum
+santafe.museum
+saskatchewan.museum
+satx.museum
+savannahga.museum
+schlesisches.museum
+schoenbrunn.museum
+schokoladen.museum
+school.museum
+schweiz.museum
+science.museum
+scienceandhistory.museum
+scienceandindustry.museum
+sciencecenter.museum
+sciencecenters.museum
+science-fiction.museum
+sciencehistory.museum
+sciences.museum
+sciencesnaturelles.museum
+scotland.museum
+seaport.museum
+settlement.museum
+settlers.museum
+shell.museum
+sherbrooke.museum
+sibenik.museum
+silk.museum
+ski.museum
+skole.museum
+society.museum
+sologne.museum
+soundandvision.museum
+southcarolina.museum
+southwest.museum
+space.museum
+spy.museum
+square.museum
+stadt.museum
+stalbans.museum
+starnberg.museum
+state.museum
+stateofdelaware.museum
+station.museum
+steam.museum
+steiermark.museum
+stjohn.museum
+stockholm.museum
+stpetersburg.museum
+stuttgart.museum
+suisse.museum
+surgeonshall.museum
+surrey.museum
+svizzera.museum
+sweden.museum
+sydney.museum
+tank.museum
+tcm.museum
+technology.museum
+telekommunikation.museum
+television.museum
+texas.museum
+textile.museum
+theater.museum
+time.museum
+timekeeping.museum
+topology.museum
+torino.museum
+touch.museum
+town.museum
+transport.museum
+tree.museum
+trolley.museum
+trust.museum
+trustee.museum
+uhren.museum
+ulm.museum
+undersea.museum
+university.museum
+usa.museum
+usantiques.museum
+usarts.museum
+uscountryestate.museum
+usculture.museum
+usdecorativearts.museum
+usgarden.museum
+ushistory.museum
+ushuaia.museum
+uslivinghistory.museum
+utah.museum
+uvic.museum
+valley.museum
+vantaa.museum
+versailles.museum
+viking.museum
+village.museum
+virginia.museum
+virtual.museum
+virtuel.museum
+vlaanderen.museum
+volkenkunde.museum
+wales.museum
+wallonie.museum
+war.museum
+washingtondc.museum
+watchandclock.museum
+watch-and-clock.museum
+western.museum
+westfalen.museum
+whaling.museum
+wildlife.museum
+williamsburg.museum
+windmill.museum
+workshop.museum
+york.museum
+yorkshire.museum
+yosemite.museum
+youth.museum
+zoological.museum
+zoology.museum
+ירושלים.museum
+иком.museum
+
+// mv : http://en.wikipedia.org/wiki/.mv
+// "mv" included because, contra Wikipedia, google.mv exists.
+mv
+aero.mv
+biz.mv
+com.mv
+coop.mv
+edu.mv
+gov.mv
+info.mv
+int.mv
+mil.mv
+museum.mv
+name.mv
+net.mv
+org.mv
+pro.mv
+
+// mw : http://www.registrar.mw/
+mw
+ac.mw
+biz.mw
+co.mw
+com.mw
+coop.mw
+edu.mw
+gov.mw
+int.mw
+museum.mw
+net.mw
+org.mw
+
+// mx : http://www.nic.mx/
+// Submitted by registry <farias@nic.mx> 2008-06-19
+mx
+com.mx
+org.mx
+gob.mx
+edu.mx
+net.mx
+
+// my : http://www.mynic.net.my/
+my
+com.my
+net.my
+org.my
+gov.my
+edu.my
+mil.my
+name.my
+
+// mz : http://www.gobin.info/domainname/mz-template.doc
+*.mz
+
+// na : http://www.na-nic.com.na/
+// http://www.info.na/domain/
+na
+info.na
+pro.na
+name.na
+school.na
+or.na
+dr.na
+us.na
+mx.na
+ca.na
+in.na
+cc.na
+tv.na
+ws.na
+mobi.na
+co.na
+com.na
+org.na
+
+// name : has 2nd-level tlds, but there's no list of them
+name
+
+// nc : http://www.cctld.nc/
+nc
+asso.nc
+
+// ne : http://en.wikipedia.org/wiki/.ne
+ne
+
+// net : http://en.wikipedia.org/wiki/.net
+net
+
+// CentralNic names : http://www.centralnic.com/names/domains
+// Submitted by registry <gavin.brown@centralnic.com> 2008-06-17
+gb.net
+se.net
+uk.net
+
+// ZaNiC names : http://www.za.net/
+// Confirmed by registry <hostmaster@nic.za.net> 2009-10-03
+za.net
+
+// nf : http://en.wikipedia.org/wiki/.nf
+nf
+com.nf
+net.nf
+per.nf
+rec.nf
+web.nf
+arts.nf
+firm.nf
+info.nf
+other.nf
+store.nf
+
+// ng : http://psg.com/dns/ng/
+// Submitted by registry <randy@psg.com> 2008-06-17
+ac.ng
+com.ng
+edu.ng
+gov.ng
+net.ng
+org.ng
+
+// ni : http://www.nic.ni/dominios.htm
+*.ni
+
+// nl : http://www.domain-registry.nl/ace.php/c,728,122,,,,Home.html
+// Confirmed by registry <Antoin.Verschuren@sidn.nl> (with technical
+// reservations) 2008-06-08
+nl
+
+// BV.nl will be a registry for dutch BV's (besloten vennootschap)
+bv.nl
+
+// the co.nl domain is managed by CoDNS B.V. Added 2010-05-23.
+co.nl
+
+// no : http://www.norid.no/regelverk/index.en.html
+// The Norwegian registry has declined to notify us of updates. The web pages
+// referenced below are the official source of the data. There is also an
+// announce mailing list:
+// https://postlister.uninett.no/sympa/info/norid-diskusjon
+no
+// Norid generic domains : http://www.norid.no/regelverk/vedlegg-c.en.html
+fhs.no
+vgs.no
+fylkesbibl.no
+folkebibl.no
+museum.no
+idrett.no
+priv.no
+// Non-Norid generic domains : http://www.norid.no/regelverk/vedlegg-d.en.html
+mil.no
+stat.no
+dep.no
+kommune.no
+herad.no
+// no geographical names : http://www.norid.no/regelverk/vedlegg-b.en.html
+// counties
+aa.no
+ah.no
+bu.no
+fm.no
+hl.no
+hm.no
+jan-mayen.no
+mr.no
+nl.no
+nt.no
+of.no
+ol.no
+oslo.no
+rl.no
+sf.no
+st.no
+svalbard.no
+tm.no
+tr.no
+va.no
+vf.no
+// primary and lower secondary schools per county
+gs.aa.no
+gs.ah.no
+gs.bu.no
+gs.fm.no
+gs.hl.no
+gs.hm.no
+gs.jan-mayen.no
+gs.mr.no
+gs.nl.no
+gs.nt.no
+gs.of.no
+gs.ol.no
+gs.oslo.no
+gs.rl.no
+gs.sf.no
+gs.st.no
+gs.svalbard.no
+gs.tm.no
+gs.tr.no
+gs.va.no
+gs.vf.no
+// cities
+akrehamn.no
+åkrehamn.no
+algard.no
+ålgård.no
+arna.no
+brumunddal.no
+bryne.no
+bronnoysund.no
+brønnøysund.no
+drobak.no
+drøbak.no
+egersund.no
+fetsund.no
+floro.no
+florø.no
+fredrikstad.no
+hokksund.no
+honefoss.no
+hønefoss.no
+jessheim.no
+jorpeland.no
+jørpeland.no
+kirkenes.no
+kopervik.no
+krokstadelva.no
+langevag.no
+langevåg.no
+leirvik.no
+mjondalen.no
+mjøndalen.no
+mo-i-rana.no
+mosjoen.no
+mosjøen.no
+nesoddtangen.no
+orkanger.no
+osoyro.no
+osøyro.no
+raholt.no
+råholt.no
+sandnessjoen.no
+sandnessjøen.no
+skedsmokorset.no
+slattum.no
+spjelkavik.no
+stathelle.no
+stavern.no
+stjordalshalsen.no
+stjørdalshalsen.no
+tananger.no
+tranby.no
+vossevangen.no
+// communities
+afjord.no
+åfjord.no
+agdenes.no
+al.no
+ål.no
+alesund.no
+ålesund.no
+alstahaug.no
+alta.no
+áltá.no
+alaheadju.no
+álaheadju.no
+alvdal.no
+amli.no
+åmli.no
+amot.no
+åmot.no
+andebu.no
+andoy.no
+andøy.no
+andasuolo.no
+ardal.no
+årdal.no
+aremark.no
+arendal.no
+ås.no
+aseral.no
+åseral.no
+asker.no
+askim.no
+askvoll.no
+askoy.no
+askøy.no
+asnes.no
+åsnes.no
+audnedaln.no
+aukra.no
+aure.no
+aurland.no
+aurskog-holand.no
+aurskog-høland.no
+austevoll.no
+austrheim.no
+averoy.no
+averøy.no
+balestrand.no
+ballangen.no
+balat.no
+bálát.no
+balsfjord.no
+bahccavuotna.no
+báhccavuotna.no
+bamble.no
+bardu.no
+beardu.no
+beiarn.no
+bajddar.no
+bájddar.no
+baidar.no
+báidár.no
+berg.no
+bergen.no
+berlevag.no
+berlevåg.no
+bearalvahki.no
+bearalváhki.no
+bindal.no
+birkenes.no
+bjarkoy.no
+bjarkøy.no
+bjerkreim.no
+bjugn.no
+bodo.no
+bodø.no
+badaddja.no
+bådåddjå.no
+budejju.no
+bokn.no
+bremanger.no
+bronnoy.no
+brønnøy.no
+bygland.no
+bykle.no
+barum.no
+bærum.no
+bo.telemark.no
+bø.telemark.no
+bo.nordland.no
+bø.nordland.no
+bievat.no
+bievát.no
+bomlo.no
+bømlo.no
+batsfjord.no
+båtsfjord.no
+bahcavuotna.no
+báhcavuotna.no
+dovre.no
+drammen.no
+drangedal.no
+dyroy.no
+dyrøy.no
+donna.no
+dønna.no
+eid.no
+eidfjord.no
+eidsberg.no
+eidskog.no
+eidsvoll.no
+eigersund.no
+elverum.no
+enebakk.no
+engerdal.no
+etne.no
+etnedal.no
+evenes.no
+evenassi.no
+evenášši.no
+evje-og-hornnes.no
+farsund.no
+fauske.no
+fuossko.no
+fuoisku.no
+fedje.no
+fet.no
+finnoy.no
+finnøy.no
+fitjar.no
+fjaler.no
+fjell.no
+flakstad.no
+flatanger.no
+flekkefjord.no
+flesberg.no
+flora.no
+fla.no
+flå.no
+folldal.no
+forsand.no
+fosnes.no
+frei.no
+frogn.no
+froland.no
+frosta.no
+frana.no
+fræna.no
+froya.no
+frøya.no
+fusa.no
+fyresdal.no
+forde.no
+førde.no
+gamvik.no
+gangaviika.no
+gáŋgaviika.no
+gaular.no
+gausdal.no
+gildeskal.no
+gildeskål.no
+giske.no
+gjemnes.no
+gjerdrum.no
+gjerstad.no
+gjesdal.no
+gjovik.no
+gjøvik.no
+gloppen.no
+gol.no
+gran.no
+grane.no
+granvin.no
+gratangen.no
+grimstad.no
+grong.no
+kraanghke.no
+kråanghke.no
+grue.no
+gulen.no
+hadsel.no
+halden.no
+halsa.no
+hamar.no
+hamaroy.no
+habmer.no
+hábmer.no
+hapmir.no
+hápmir.no
+hammerfest.no
+hammarfeasta.no
+hámmárfeasta.no
+haram.no
+hareid.no
+harstad.no
+hasvik.no
+aknoluokta.no
+ákŋoluokta.no
+hattfjelldal.no
+aarborte.no
+haugesund.no
+hemne.no
+hemnes.no
+hemsedal.no
+heroy.more-og-romsdal.no
+herøy.møre-og-romsdal.no
+heroy.nordland.no
+herøy.nordland.no
+hitra.no
+hjartdal.no
+hjelmeland.no
+hobol.no
+hobøl.no
+hof.no
+hol.no
+hole.no
+holmestrand.no
+holtalen.no
+holtålen.no
+hornindal.no
+horten.no
+hurdal.no
+hurum.no
+hvaler.no
+hyllestad.no
+hagebostad.no
+hægebostad.no
+hoyanger.no
+høyanger.no
+hoylandet.no
+høylandet.no
+ha.no
+hå.no
+ibestad.no
+inderoy.no
+inderøy.no
+iveland.no
+jevnaker.no
+jondal.no
+jolster.no
+jølster.no
+karasjok.no
+karasjohka.no
+kárášjohka.no
+karlsoy.no
+galsa.no
+gálsá.no
+karmoy.no
+karmøy.no
+kautokeino.no
+guovdageaidnu.no
+klepp.no
+klabu.no
+klæbu.no
+kongsberg.no
+kongsvinger.no
+kragero.no
+kragerø.no
+kristiansand.no
+kristiansund.no
+krodsherad.no
+krødsherad.no
+kvalsund.no
+rahkkeravju.no
+ráhkkerávju.no
+kvam.no
+kvinesdal.no
+kvinnherad.no
+kviteseid.no
+kvitsoy.no
+kvitsøy.no
+kvafjord.no
+kvæfjord.no
+giehtavuoatna.no
+kvanangen.no
+kvænangen.no
+navuotna.no
+návuotna.no
+kafjord.no
+kåfjord.no
+gaivuotna.no
+gáivuotna.no
+larvik.no
+lavangen.no
+lavagis.no
+loabat.no
+loabát.no
+lebesby.no
+davvesiida.no
+leikanger.no
+leirfjord.no
+leka.no
+leksvik.no
+lenvik.no
+leangaviika.no
+leaŋgaviika.no
+lesja.no
+levanger.no
+lier.no
+lierne.no
+lillehammer.no
+lillesand.no
+lindesnes.no
+lindas.no
+lindås.no
+lom.no
+loppa.no
+lahppi.no
+láhppi.no
+lund.no
+lunner.no
+luroy.no
+lurøy.no
+luster.no
+lyngdal.no
+lyngen.no
+ivgu.no
+lardal.no
+lerdal.no
+lærdal.no
+lodingen.no
+lødingen.no
+lorenskog.no
+lørenskog.no
+loten.no
+løten.no
+malvik.no
+masoy.no
+måsøy.no
+muosat.no
+muosát.no
+mandal.no
+marker.no
+marnardal.no
+masfjorden.no
+meland.no
+meldal.no
+melhus.no
+meloy.no
+meløy.no
+meraker.no
+meråker.no
+moareke.no
+moåreke.no
+midsund.no
+midtre-gauldal.no
+modalen.no
+modum.no
+molde.no
+moskenes.no
+moss.no
+mosvik.no
+malselv.no
+målselv.no
+malatvuopmi.no
+málatvuopmi.no
+namdalseid.no
+aejrie.no
+namsos.no
+namsskogan.no
+naamesjevuemie.no
+nååmesjevuemie.no
+laakesvuemie.no
+nannestad.no
+narvik.no
+narviika.no
+naustdal.no
+nedre-eiker.no
+nes.akershus.no
+nes.buskerud.no
+nesna.no
+nesodden.no
+nesseby.no
+unjarga.no
+unjárga.no
+nesset.no
+nissedal.no
+nittedal.no
+nord-aurdal.no
+nord-fron.no
+nord-odal.no
+norddal.no
+nordkapp.no
+davvenjarga.no
+davvenjárga.no
+nordre-land.no
+nordreisa.no
+raisa.no
+ráisa.no
+nore-og-uvdal.no
+notodden.no
+naroy.no
+nærøy.no
+notteroy.no
+nøtterøy.no
+odda.no
+oksnes.no
+øksnes.no
+oppdal.no
+oppegard.no
+oppegård.no
+orkdal.no
+orland.no
+ørland.no
+orskog.no
+ørskog.no
+orsta.no
+ørsta.no
+os.hedmark.no
+os.hordaland.no
+osen.no
+osteroy.no
+osterøy.no
+ostre-toten.no
+østre-toten.no
+overhalla.no
+ovre-eiker.no
+øvre-eiker.no
+oyer.no
+øyer.no
+oygarden.no
+øygarden.no
+oystre-slidre.no
+øystre-slidre.no
+porsanger.no
+porsangu.no
+porsáŋgu.no
+porsgrunn.no
+radoy.no
+radøy.no
+rakkestad.no
+rana.no
+ruovat.no
+randaberg.no
+rauma.no
+rendalen.no
+rennebu.no
+rennesoy.no
+rennesøy.no
+rindal.no
+ringebu.no
+ringerike.no
+ringsaker.no
+rissa.no
+risor.no
+risør.no
+roan.no
+rollag.no
+rygge.no
+ralingen.no
+rælingen.no
+rodoy.no
+rødøy.no
+romskog.no
+rømskog.no
+roros.no
+røros.no
+rost.no
+røst.no
+royken.no
+røyken.no
+royrvik.no
+røyrvik.no
+rade.no
+råde.no
+salangen.no
+siellak.no
+saltdal.no
+salat.no
+sálát.no
+sálat.no
+samnanger.no
+sande.more-og-romsdal.no
+sande.møre-og-romsdal.no
+sande.vestfold.no
+sandefjord.no
+sandnes.no
+sandoy.no
+sandøy.no
+sarpsborg.no
+sauda.no
+sauherad.no
+sel.no
+selbu.no
+selje.no
+seljord.no
+sigdal.no
+siljan.no
+sirdal.no
+skaun.no
+skedsmo.no
+ski.no
+skien.no
+skiptvet.no
+skjervoy.no
+skjervøy.no
+skierva.no
+skiervá.no
+skjak.no
+skjåk.no
+skodje.no
+skanland.no
+skånland.no
+skanit.no
+skánit.no
+smola.no
+smøla.no
+snillfjord.no
+snasa.no
+snåsa.no
+snoasa.no
+snaase.no
+snåase.no
+sogndal.no
+sokndal.no
+sola.no
+solund.no
+songdalen.no
+sortland.no
+spydeberg.no
+stange.no
+stavanger.no
+steigen.no
+steinkjer.no
+stjordal.no
+stjørdal.no
+stokke.no
+stor-elvdal.no
+stord.no
+stordal.no
+storfjord.no
+omasvuotna.no
+strand.no
+stranda.no
+stryn.no
+sula.no
+suldal.no
+sund.no
+sunndal.no
+surnadal.no
+sveio.no
+svelvik.no
+sykkylven.no
+sogne.no
+søgne.no
+somna.no
+sømna.no
+sondre-land.no
+søndre-land.no
+sor-aurdal.no
+sør-aurdal.no
+sor-fron.no
+sør-fron.no
+sor-odal.no
+sør-odal.no
+sor-varanger.no
+sør-varanger.no
+matta-varjjat.no
+mátta-várjjat.no
+sorfold.no
+sørfold.no
+sorreisa.no
+sørreisa.no
+sorum.no
+sørum.no
+tana.no
+deatnu.no
+time.no
+tingvoll.no
+tinn.no
+tjeldsund.no
+dielddanuorri.no
+tjome.no
+tjøme.no
+tokke.no
+tolga.no
+torsken.no
+tranoy.no
+tranøy.no
+tromso.no
+tromsø.no
+tromsa.no
+romsa.no
+trondheim.no
+troandin.no
+trysil.no
+trana.no
+træna.no
+trogstad.no
+trøgstad.no
+tvedestrand.no
+tydal.no
+tynset.no
+tysfjord.no
+divtasvuodna.no
+divttasvuotna.no
+tysnes.no
+tysvar.no
+tysvær.no
+tonsberg.no
+tønsberg.no
+ullensaker.no
+ullensvang.no
+ulvik.no
+utsira.no
+vadso.no
+vadsø.no
+cahcesuolo.no
+čáhcesuolo.no
+vaksdal.no
+valle.no
+vang.no
+vanylven.no
+vardo.no
+vardø.no
+varggat.no
+várggát.no
+vefsn.no
+vaapste.no
+vega.no
+vegarshei.no
+vegårshei.no
+vennesla.no
+verdal.no
+verran.no
+vestby.no
+vestnes.no
+vestre-slidre.no
+vestre-toten.no
+vestvagoy.no
+vestvågøy.no
+vevelstad.no
+vik.no
+vikna.no
+vindafjord.no
+volda.no
+voss.no
+varoy.no
+værøy.no
+vagan.no
+vågan.no
+voagat.no
+vagsoy.no
+vågsøy.no
+vaga.no
+vågå.no
+valer.ostfold.no
+våler.østfold.no
+valer.hedmark.no
+våler.hedmark.no
+
+// the co.no domain is managed by CoDNS B.V. Added 2010-05-23.
+co.no
+
+// np : http://www.mos.com.np/register.html
+*.np
+
+// nr : http://cenpac.net.nr/dns/index.html
+// Confirmed by registry <technician@cenpac.net.nr> 2008-06-17
+nr
+biz.nr
+info.nr
+gov.nr
+edu.nr
+org.nr
+net.nr
+com.nr
+
+// nu : http://en.wikipedia.org/wiki/.nu
+nu
+
+// nz : http://en.wikipedia.org/wiki/.nz
+*.nz
+
+// om : http://en.wikipedia.org/wiki/.om
+*.om
+!mediaphone.om
+!nawrastelecom.om
+!nawras.om
+!omanmobile.om
+!omanpost.om
+!omantel.om
+!rakpetroleum.om
+!siemens.om
+!songfest.om
+!statecouncil.om
+
+// org : http://en.wikipedia.org/wiki/.org
+org
+
+// CentralNic names : http://www.centralnic.com/names/domains
+// Submitted by registry <gavin.brown@centralnic.com> 2008-06-17
+ae.org
+
+// ZaNiC names : http://www.za.net/
+// Confirmed by registry <hostmaster@nic.za.net> 2009-10-03
+za.org
+
+// pa : http://www.nic.pa/
+// Some additional second level "domains" resolve directly as hostnames, such as
+// pannet.pa, so we add a rule for "pa".
+pa
+ac.pa
+gob.pa
+com.pa
+org.pa
+sld.pa
+edu.pa
+net.pa
+ing.pa
+abo.pa
+med.pa
+nom.pa
+
+// pe : https://www.nic.pe/InformeFinalComision.pdf
+pe
+edu.pe
+gob.pe
+nom.pe
+mil.pe
+org.pe
+com.pe
+net.pe
+
+// pf : http://www.gobin.info/domainname/formulaire-pf.pdf
+pf
+com.pf
+org.pf
+edu.pf
+
+// pg : http://en.wikipedia.org/wiki/.pg
+*.pg
+
+// ph : http://www.domains.ph/FAQ2.asp
+// Submitted by registry <jed@email.com.ph> 2008-06-13
+ph
+com.ph
+net.ph
+org.ph
+gov.ph
+edu.ph
+ngo.ph
+mil.ph
+i.ph
+
+// pk : http://pk5.pknic.net.pk/pk5/msgNamepk.PK
+pk
+com.pk
+net.pk
+edu.pk
+org.pk
+fam.pk
+biz.pk
+web.pk
+gov.pk
+gob.pk
+gok.pk
+gon.pk
+gop.pk
+gos.pk
+info.pk
+
+// pl : http://www.dns.pl/english/
+pl
+// NASK functional domains (nask.pl / dns.pl) : http://www.dns.pl/english/dns-funk.html
+aid.pl
+agro.pl
+atm.pl
+auto.pl
+biz.pl
+com.pl
+edu.pl
+gmina.pl
+gsm.pl
+info.pl
+mail.pl
+miasta.pl
+media.pl
+mil.pl
+net.pl
+nieruchomosci.pl
+nom.pl
+org.pl
+pc.pl
+powiat.pl
+priv.pl
+realestate.pl
+rel.pl
+sex.pl
+shop.pl
+sklep.pl
+sos.pl
+szkola.pl
+targi.pl
+tm.pl
+tourism.pl
+travel.pl
+turystyka.pl
+// ICM functional domains (icm.edu.pl)
+6bone.pl
+art.pl
+mbone.pl
+// Government domains (administered by ippt.gov.pl)
+gov.pl
+uw.gov.pl
+um.gov.pl
+ug.gov.pl
+upow.gov.pl
+starostwo.gov.pl
+so.gov.pl
+sr.gov.pl
+po.gov.pl
+pa.gov.pl
+// other functional domains
+ngo.pl
+irc.pl
+usenet.pl
+// NASK geographical domains : http://www.dns.pl/english/dns-regiony.html
+augustow.pl
+babia-gora.pl
+bedzin.pl
+beskidy.pl
+bialowieza.pl
+bialystok.pl
+bielawa.pl
+bieszczady.pl
+boleslawiec.pl
+bydgoszcz.pl
+bytom.pl
+cieszyn.pl
+czeladz.pl
+czest.pl
+dlugoleka.pl
+elblag.pl
+elk.pl
+glogow.pl
+gniezno.pl
+gorlice.pl
+grajewo.pl
+ilawa.pl
+jaworzno.pl
+jelenia-gora.pl
+jgora.pl
+kalisz.pl
+kazimierz-dolny.pl
+karpacz.pl
+kartuzy.pl
+kaszuby.pl
+katowice.pl
+kepno.pl
+ketrzyn.pl
+klodzko.pl
+kobierzyce.pl
+kolobrzeg.pl
+konin.pl
+konskowola.pl
+kutno.pl
+lapy.pl
+lebork.pl
+legnica.pl
+lezajsk.pl
+limanowa.pl
+lomza.pl
+lowicz.pl
+lubin.pl
+lukow.pl
+malbork.pl
+malopolska.pl
+mazowsze.pl
+mazury.pl
+mielec.pl
+mielno.pl
+mragowo.pl
+naklo.pl
+nowaruda.pl
+nysa.pl
+olawa.pl
+olecko.pl
+olkusz.pl
+olsztyn.pl
+opoczno.pl
+opole.pl
+ostroda.pl
+ostroleka.pl
+ostrowiec.pl
+ostrowwlkp.pl
+pila.pl
+pisz.pl
+podhale.pl
+podlasie.pl
+polkowice.pl
+pomorze.pl
+pomorskie.pl
+prochowice.pl
+pruszkow.pl
+przeworsk.pl
+pulawy.pl
+radom.pl
+rawa-maz.pl
+rybnik.pl
+rzeszow.pl
+sanok.pl
+sejny.pl
+siedlce.pl
+slask.pl
+slupsk.pl
+sosnowiec.pl
+stalowa-wola.pl
+skoczow.pl
+starachowice.pl
+stargard.pl
+suwalki.pl
+swidnica.pl
+swiebodzin.pl
+swinoujscie.pl
+szczecin.pl
+szczytno.pl
+tarnobrzeg.pl
+tgory.pl
+turek.pl
+tychy.pl
+ustka.pl
+walbrzych.pl
+warmia.pl
+warszawa.pl
+waw.pl
+wegrow.pl
+wielun.pl
+wlocl.pl
+wloclawek.pl
+wodzislaw.pl
+wolomin.pl
+wroclaw.pl
+zachpomor.pl
+zagan.pl
+zarow.pl
+zgora.pl
+zgorzelec.pl
+// TASK geographical domains (www.task.gda.pl/uslugi/dns)
+gda.pl
+gdansk.pl
+gdynia.pl
+med.pl
+sopot.pl
+// other geographical domains
+gliwice.pl
+krakow.pl
+poznan.pl
+wroc.pl
+zakopane.pl
+
+// co.pl : Mainseek Sp. z o.o. http://www.co.pl
+co.pl
+
+// pn : http://www.government.pn/PnRegistry/policies.htm
+pn
+gov.pn
+co.pn
+org.pn
+edu.pn
+net.pn
+
+// pr : http://www.nic.pr/index.asp?f=1
+pr
+com.pr
+net.pr
+org.pr
+gov.pr
+edu.pr
+isla.pr
+pro.pr
+biz.pr
+info.pr
+name.pr
+// these aren't mentioned on nic.pr, but on http://en.wikipedia.org/wiki/.pr
+est.pr
+prof.pr
+ac.pr
+
+// pro : http://www.nic.pro/support_faq.htm
+pro
+aca.pro
+bar.pro
+cpa.pro
+jur.pro
+law.pro
+med.pro
+eng.pro
+
+// ps : http://en.wikipedia.org/wiki/.ps
+// http://www.nic.ps/registration/policy.html#reg
+ps
+edu.ps
+gov.ps
+sec.ps
+plo.ps
+com.ps
+org.ps
+net.ps
+
+// pt : http://online.dns.pt/dns/start_dns
+pt
+net.pt
+gov.pt
+org.pt
+edu.pt
+int.pt
+publ.pt
+com.pt
+nome.pt
+
+// pw : http://en.wikipedia.org/wiki/.pw
+pw
+co.pw
+ne.pw
+or.pw
+ed.pw
+go.pw
+belau.pw
+
+// py : http://www.nic.py/faq_a.html#faq_b
+*.py
+
+// qa : http://www.qatar.net.qa/services/virtual.htm
+*.qa
+
+// re : http://www.afnic.re/obtenir/chartes/nommage-re/annexe-descriptifs
+re
+com.re
+asso.re
+nom.re
+
+// ro : http://www.rotld.ro/
+ro
+com.ro
+org.ro
+tm.ro
+nt.ro
+nom.ro
+info.ro
+rec.ro
+arts.ro
+firm.ro
+store.ro
+www.ro
+
+// rs : http://en.wikipedia.org/wiki/.rs
+rs
+co.rs
+org.rs
+edu.rs
+ac.rs
+gov.rs
+in.rs
+
+// ru : http://www.cctld.ru/ru/docs/aktiv_8.php
+// Industry domains
+ru
+ac.ru
+com.ru
+edu.ru
+int.ru
+net.ru
+org.ru
+pp.ru
+// Geographical domains
+adygeya.ru
+altai.ru
+amur.ru
+arkhangelsk.ru
+astrakhan.ru
+bashkiria.ru
+belgorod.ru
+bir.ru
+bryansk.ru
+buryatia.ru
+cbg.ru
+chel.ru
+chelyabinsk.ru
+chita.ru
+chukotka.ru
+chuvashia.ru
+dagestan.ru
+dudinka.ru
+e-burg.ru
+grozny.ru
+irkutsk.ru
+ivanovo.ru
+izhevsk.ru
+jar.ru
+joshkar-ola.ru
+kalmykia.ru
+kaluga.ru
+kamchatka.ru
+karelia.ru
+kazan.ru
+kchr.ru
+kemerovo.ru
+khabarovsk.ru
+khakassia.ru
+khv.ru
+kirov.ru
+koenig.ru
+komi.ru
+kostroma.ru
+krasnoyarsk.ru
+kuban.ru
+kurgan.ru
+kursk.ru
+lipetsk.ru
+magadan.ru
+mari.ru
+mari-el.ru
+marine.ru
+mordovia.ru
+mosreg.ru
+msk.ru
+murmansk.ru
+nalchik.ru
+nnov.ru
+nov.ru
+novosibirsk.ru
+nsk.ru
+omsk.ru
+orenburg.ru
+oryol.ru
+palana.ru
+penza.ru
+perm.ru
+pskov.ru
+ptz.ru
+rnd.ru
+ryazan.ru
+sakhalin.ru
+samara.ru
+saratov.ru
+simbirsk.ru
+smolensk.ru
+spb.ru
+stavropol.ru
+stv.ru
+surgut.ru
+tambov.ru
+tatarstan.ru
+tom.ru
+tomsk.ru
+tsaritsyn.ru
+tsk.ru
+tula.ru
+tuva.ru
+tver.ru
+tyumen.ru
+udm.ru
+udmurtia.ru
+ulan-ude.ru
+vladikavkaz.ru
+vladimir.ru
+vladivostok.ru
+volgograd.ru
+vologda.ru
+voronezh.ru
+vrn.ru
+vyatka.ru
+yakutia.ru
+yamal.ru
+yaroslavl.ru
+yekaterinburg.ru
+yuzhno-sakhalinsk.ru
+// More geographical domains
+amursk.ru
+baikal.ru
+cmw.ru
+fareast.ru
+jamal.ru
+kms.ru
+k-uralsk.ru
+kustanai.ru
+kuzbass.ru
+magnitka.ru
+mytis.ru
+nakhodka.ru
+nkz.ru
+norilsk.ru
+oskol.ru
+pyatigorsk.ru
+rubtsovsk.ru
+snz.ru
+syzran.ru
+vdonsk.ru
+zgrad.ru
+// State domains
+gov.ru
+mil.ru
+// Technical domains
+test.ru
+
+// rw : http://www.nic.rw/cgi-bin/policy.pl
+rw
+gov.rw
+net.rw
+edu.rw
+ac.rw
+com.rw
+co.rw
+int.rw
+mil.rw
+gouv.rw
+
+// sa : http://www.nic.net.sa/
+sa
+com.sa
+net.sa
+org.sa
+gov.sa
+med.sa
+pub.sa
+edu.sa
+sch.sa
+
+// sb : http://www.sbnic.net.sb/
+// Submitted by registry <lee.humphries@telekom.com.sb> 2008-06-08
+sb
+com.sb
+edu.sb
+gov.sb
+net.sb
+org.sb
+
+// sc : http://www.nic.sc/
+sc
+com.sc
+gov.sc
+net.sc
+org.sc
+edu.sc
+
+// sd : http://www.isoc.sd/sudanic.isoc.sd/billing_pricing.htm
+// Submitted by registry <admin@isoc.sd> 2008-06-17
+sd
+com.sd
+net.sd
+org.sd
+edu.sd
+med.sd
+gov.sd
+info.sd
+
+// se : http://en.wikipedia.org/wiki/.se
+// Submitted by registry <Patrik.Wallstrom@iis.se> 2008-06-24
+se
+a.se
+ac.se
+b.se
+bd.se
+brand.se
+c.se
+d.se
+e.se
+f.se
+fh.se
+fhsk.se
+fhv.se
+g.se
+h.se
+i.se
+k.se
+komforb.se
+kommunalforbund.se
+komvux.se
+l.se
+lanbib.se
+m.se
+n.se
+naturbruksgymn.se
+o.se
+org.se
+p.se
+parti.se
+pp.se
+press.se
+r.se
+s.se
+sshn.se
+t.se
+tm.se
+u.se
+w.se
+x.se
+y.se
+z.se
+
+// sg : http://www.nic.net.sg/sub_policies_agreement/2ld.html
+sg
+com.sg
+net.sg
+org.sg
+gov.sg
+edu.sg
+per.sg
+
+// sh : http://www.nic.sh/rules.html
+// list of 2nd level domains ?
+sh
+
+// si : http://en.wikipedia.org/wiki/.si
+si
+
+// sj : No registrations at this time.
+// Submitted by registry <jarle@uninett.no> 2008-06-16
+
+// sk : http://en.wikipedia.org/wiki/.sk
+// list of 2nd level domains ?
+sk
+
+// sl : http://www.nic.sl
+// Submitted by registry <adam@neoip.com> 2008-06-12
+sl
+com.sl
+net.sl
+edu.sl
+gov.sl
+org.sl
+
+// sm : http://en.wikipedia.org/wiki/.sm
+sm
+
+// sn : http://en.wikipedia.org/wiki/.sn
+sn
+art.sn
+com.sn
+edu.sn
+gouv.sn
+org.sn
+perso.sn
+univ.sn
+
+// so : http://www.soregistry.com/
+so
+com.so
+net.so
+org.so
+
+// sr : http://en.wikipedia.org/wiki/.sr
+sr
+
+// st : http://www.nic.st/html/policyrules/
+st
+co.st
+com.st
+consulado.st
+edu.st
+embaixada.st
+gov.st
+mil.st
+net.st
+org.st
+principe.st
+saotome.st
+store.st
+
+// su : http://en.wikipedia.org/wiki/.su
+su
+
+// sv : http://www.svnet.org.sv/svpolicy.html
+*.sv
+
+// sy : http://en.wikipedia.org/wiki/.sy
+// see also: http://www.gobin.info/domainname/sy.doc
+sy
+edu.sy
+gov.sy
+net.sy
+mil.sy
+com.sy
+org.sy
+
+// sz : http://en.wikipedia.org/wiki/.sz
+// http://www.sispa.org.sz/
+sz
+co.sz
+ac.sz
+org.sz
+
+// tc : http://en.wikipedia.org/wiki/.tc
+tc
+
+// td : http://en.wikipedia.org/wiki/.td
+td
+
+// tel: http://en.wikipedia.org/wiki/.tel
+// http://www.telnic.org/
+tel
+
+// tf : http://en.wikipedia.org/wiki/.tf
+tf
+
+// tg : http://en.wikipedia.org/wiki/.tg
+// http://www.nic.tg/nictg/index.php implies no reserved 2nd-level domains,
+// although this contradicts wikipedia.
+tg
+
+// th : http://en.wikipedia.org/wiki/.th
+// Submitted by registry <krit@thains.co.th> 2008-06-17
+th
+ac.th
+co.th
+go.th
+in.th
+mi.th
+net.th
+or.th
+
+// tj : http://www.nic.tj/policy.htm
+tj
+ac.tj
+biz.tj
+co.tj
+com.tj
+edu.tj
+go.tj
+gov.tj
+int.tj
+mil.tj
+name.tj
+net.tj
+nic.tj
+org.tj
+test.tj
+web.tj
+
+// tk : http://en.wikipedia.org/wiki/.tk
+tk
+
+// tl : http://en.wikipedia.org/wiki/.tl
+tl
+gov.tl
+
+// tm : http://www.nic.tm/rules.html
+// list of 2nd level tlds ?
+tm
+
+// tn : http://en.wikipedia.org/wiki/.tn
+// http://whois.ati.tn/
+tn
+com.tn
+ens.tn
+fin.tn
+gov.tn
+ind.tn
+intl.tn
+nat.tn
+net.tn
+org.tn
+info.tn
+perso.tn
+tourism.tn
+edunet.tn
+rnrt.tn
+rns.tn
+rnu.tn
+mincom.tn
+agrinet.tn
+defense.tn
+turen.tn
+
+// to : http://en.wikipedia.org/wiki/.to
+// Submitted by registry <egullich@colo.to> 2008-06-17
+to
+com.to
+gov.to
+net.to
+org.to
+edu.to
+mil.to
+
+// tr : http://en.wikipedia.org/wiki/.tr
+*.tr
+!nic.tr
+// Used by government in the TRNC
+// http://en.wikipedia.org/wiki/.nc.tr
+gov.nc.tr
+
+// travel : http://en.wikipedia.org/wiki/.travel
+travel
+
+// tt : http://www.nic.tt/
+tt
+co.tt
+com.tt
+org.tt
+net.tt
+biz.tt
+info.tt
+pro.tt
+int.tt
+coop.tt
+jobs.tt
+mobi.tt
+travel.tt
+museum.tt
+aero.tt
+name.tt
+gov.tt
+edu.tt
+
+// tv : http://en.wikipedia.org/wiki/.tv
+// Not listing any 2LDs as reserved since none seem to exist in practice,
+// Wikipedia notwithstanding.
+tv
+
+// tw : http://en.wikipedia.org/wiki/.tw
+tw
+edu.tw
+gov.tw
+mil.tw
+com.tw
+net.tw
+org.tw
+idv.tw
+game.tw
+ebiz.tw
+club.tw
+網路.tw
+組織.tw
+商業.tw
+
+// tz : http://en.wikipedia.org/wiki/.tz
+// Submitted by registry <randy@psg.com> 2008-06-17
+// Updated from http://www.tznic.or.tz/index.php/domains.html 2010-10-25
+ac.tz
+co.tz
+go.tz
+mil.tz
+ne.tz
+or.tz
+sc.tz
+
+// ua : http://www.nic.net.ua/
+ua
+com.ua
+edu.ua
+gov.ua
+in.ua
+net.ua
+org.ua
+// ua geo-names
+cherkassy.ua
+chernigov.ua
+chernovtsy.ua
+ck.ua
+cn.ua
+crimea.ua
+cv.ua
+dn.ua
+dnepropetrovsk.ua
+donetsk.ua
+dp.ua
+if.ua
+ivano-frankivsk.ua
+kh.ua
+kharkov.ua
+kherson.ua
+khmelnitskiy.ua
+kiev.ua
+kirovograd.ua
+km.ua
+kr.ua
+ks.ua
+kv.ua
+lg.ua
+lugansk.ua
+lutsk.ua
+lviv.ua
+mk.ua
+nikolaev.ua
+od.ua
+odessa.ua
+pl.ua
+poltava.ua
+rovno.ua
+rv.ua
+sebastopol.ua
+sumy.ua
+te.ua
+ternopil.ua
+uzhgorod.ua
+vinnica.ua
+vn.ua
+zaporizhzhe.ua
+zp.ua
+zhitomir.ua
+zt.ua
+
+// ug : http://www.registry.co.ug/
+ug
+co.ug
+ac.ug
+sc.ug
+go.ug
+ne.ug
+or.ug
+
+// uk : http://en.wikipedia.org/wiki/.uk
+*.uk
+*.sch.uk
+!bl.uk
+!british-library.uk
+!icnet.uk
+!jet.uk
+!mod.uk
+!nel.uk
+!nhs.uk
+!nic.uk
+!nls.uk
+!national-library-scotland.uk
+!parliament.uk
+!police.uk
+
+// us : http://en.wikipedia.org/wiki/.us
+us
+dni.us
+fed.us
+isa.us
+kids.us
+nsn.us
+// us geographic names
+ak.us
+al.us
+ar.us
+as.us
+az.us
+ca.us
+co.us
+ct.us
+dc.us
+de.us
+fl.us
+ga.us
+gu.us
+hi.us
+ia.us
+id.us
+il.us
+in.us
+ks.us
+ky.us
+la.us
+ma.us
+md.us
+me.us
+mi.us
+mn.us
+mo.us
+ms.us
+mt.us
+nc.us
+nd.us
+ne.us
+nh.us
+nj.us
+nm.us
+nv.us
+ny.us
+oh.us
+ok.us
+or.us
+pa.us
+pr.us
+ri.us
+sc.us
+sd.us
+tn.us
+tx.us
+ut.us
+vi.us
+vt.us
+va.us
+wa.us
+wi.us
+wv.us
+wy.us
+// The registrar notes several more specific domains available in each state,
+// such as state.*.us, dst.*.us, etc., but resolution of these is somewhat
+// haphazard; in some states these domains resolve as addresses, while in others
+// only subdomains are available, or even nothing at all. We include the
+// most common ones where it's clear that different sites are different
+// entities.
+k12.ak.us
+k12.al.us
+k12.ar.us
+k12.as.us
+k12.az.us
+k12.ca.us
+k12.co.us
+k12.ct.us
+k12.dc.us
+k12.de.us
+k12.fl.us
+k12.ga.us
+k12.gu.us
+// k12.hi.us Hawaii has a state-wide DOE login: bug 614565
+k12.ia.us
+k12.id.us
+k12.il.us
+k12.in.us
+k12.ks.us
+k12.ky.us
+k12.la.us
+k12.ma.us
+k12.md.us
+k12.me.us
+k12.mi.us
+k12.mn.us
+k12.mo.us
+k12.ms.us
+k12.mt.us
+k12.nc.us
+k12.nd.us
+k12.ne.us
+k12.nh.us
+k12.nj.us
+k12.nm.us
+k12.nv.us
+k12.ny.us
+k12.oh.us
+k12.ok.us
+k12.or.us
+k12.pa.us
+k12.pr.us
+k12.ri.us
+k12.sc.us
+k12.sd.us
+k12.tn.us
+k12.tx.us
+k12.ut.us
+k12.vi.us
+k12.vt.us
+k12.va.us
+k12.wa.us
+k12.wi.us
+k12.wv.us
+k12.wy.us
+
+cc.ak.us
+cc.al.us
+cc.ar.us
+cc.as.us
+cc.az.us
+cc.ca.us
+cc.co.us
+cc.ct.us
+cc.dc.us
+cc.de.us
+cc.fl.us
+cc.ga.us
+cc.gu.us
+cc.hi.us
+cc.ia.us
+cc.id.us
+cc.il.us
+cc.in.us
+cc.ks.us
+cc.ky.us
+cc.la.us
+cc.ma.us
+cc.md.us
+cc.me.us
+cc.mi.us
+cc.mn.us
+cc.mo.us
+cc.ms.us
+cc.mt.us
+cc.nc.us
+cc.nd.us
+cc.ne.us
+cc.nh.us
+cc.nj.us
+cc.nm.us
+cc.nv.us
+cc.ny.us
+cc.oh.us
+cc.ok.us
+cc.or.us
+cc.pa.us
+cc.pr.us
+cc.ri.us
+cc.sc.us
+cc.sd.us
+cc.tn.us
+cc.tx.us
+cc.ut.us
+cc.vi.us
+cc.vt.us
+cc.va.us
+cc.wa.us
+cc.wi.us
+cc.wv.us
+cc.wy.us
+
+lib.ak.us
+lib.al.us
+lib.ar.us
+lib.as.us
+lib.az.us
+lib.ca.us
+lib.co.us
+lib.ct.us
+lib.dc.us
+lib.de.us
+lib.fl.us
+lib.ga.us
+lib.gu.us
+lib.hi.us
+lib.ia.us
+lib.id.us
+lib.il.us
+lib.in.us
+lib.ks.us
+lib.ky.us
+lib.la.us
+lib.ma.us
+lib.md.us
+lib.me.us
+lib.mi.us
+lib.mn.us
+lib.mo.us
+lib.ms.us
+lib.mt.us
+lib.nc.us
+lib.nd.us
+lib.ne.us
+lib.nh.us
+lib.nj.us
+lib.nm.us
+lib.nv.us
+lib.ny.us
+lib.oh.us
+lib.ok.us
+lib.or.us
+lib.pa.us
+lib.pr.us
+lib.ri.us
+lib.sc.us
+lib.sd.us
+lib.tn.us
+lib.tx.us
+lib.ut.us
+lib.vi.us
+lib.vt.us
+lib.va.us
+lib.wa.us
+lib.wi.us
+lib.wv.us
+lib.wy.us
+
+// k12.ma.us contains school districts in Massachusetts. The 4LDs are
+// managed indepedently except for private (PVT), charter (CHTR) and
+// parochial (PAROCH) schools. Those are delegated dorectly to the
+// 5LD operators. <k12-ma-hostmaster _ at _ rsuc.gweep.net>
+pvt.k12.ma.us
+chtr.k12.ma.us
+paroch.k12.ma.us
+
+// uy : http://www.antel.com.uy/
+*.uy
+
+// uz : http://www.reg.uz/registerr.html
+// are there other 2nd level tlds ?
+uz
+com.uz
+co.uz
+
+// va : http://en.wikipedia.org/wiki/.va
+va
+
+// vc : http://en.wikipedia.org/wiki/.vc
+// Submitted by registry <kshah@ca.afilias.info> 2008-06-13
+vc
+com.vc
+net.vc
+org.vc
+gov.vc
+mil.vc
+edu.vc
+
+// ve : http://registro.nic.ve/nicve/registro/index.html
+*.ve
+
+// vg : http://en.wikipedia.org/wiki/.vg
+vg
+
+// vi : http://www.nic.vi/newdomainform.htm
+// http://www.nic.vi/Domain_Rules/body_domain_rules.html indicates some other
+// TLDs are "reserved", such as edu.vi and gov.vi, but doesn't actually say they
+// are available for registration (which they do not seem to be).
+vi
+co.vi
+com.vi
+k12.vi
+net.vi
+org.vi
+
+// vn : https://www.dot.vn/vnnic/vnnic/domainregistration.jsp
+vn
+com.vn
+net.vn
+org.vn
+edu.vn
+gov.vn
+int.vn
+ac.vn
+biz.vn
+info.vn
+name.vn
+pro.vn
+health.vn
+
+// vu : http://en.wikipedia.org/wiki/.vu
+// list of 2nd level tlds ?
+vu
+
+// ws : http://en.wikipedia.org/wiki/.ws
+// http://samoanic.ws/index.dhtml
+ws
+com.ws
+net.ws
+org.ws
+gov.ws
+edu.ws
+
+// IDN ccTLDs
+// Please sort by ISO 3166 ccTLD, then punicode string
+// when submitting patches and follow this format:
+// <Punicode> ("<english word>" <language>) : <ISO 3166 ccTLD>
+// [optional sponsoring org]
+// <URL>
+
+// xn--mgbaam7a8h ("Emerat" Arabic) : AE
+//http://nic.ae/english/arabicdomain/rules.jsp
+امارات
+
+// xn--54b7fta0cc ("Bangla" Bangla) : BD
+বাংলা
+
+// xn--fiqs8s ("China" Chinese-Han-Simplified <.Zhonggou>) : CN
+// CNNIC
+// http://cnnic.cn/html/Dir/2005/10/11/3218.htm
+中国
+
+// xn--fiqz9s ("China" Chinese-Han-Traditional <.Zhonggou>) : CN
+// CNNIC
+// http://cnnic.cn/html/Dir/2005/10/11/3218.htm
+中國
+
+// xn--lgbbat1ad8j ("Algeria / Al Jazair" Arabic) : DZ
+الجزائر
+
+// xn--wgbh1c ("Egypt" Arabic .masr) : EG
+// http://www.dotmasr.eg/
+مصر
+
+// xn--node ("ge" Georgian (Mkhedruli)) : GE
+გე
+
+// xn--j6w193g ("Hong Kong" Chinese-Han) : HK
+// https://www2.hkirc.hk/register/rules.jsp
+香港
+
+// xn--h2brj9c ("Bharat" Devanagari) : IN
+// India
+भारत
+
+// xn--mgbbh1a71e ("Bharat" Arabic) : IN
+// India
+بھارت
+
+// xn--fpcrj9c3d ("Bharat" Telugu) : IN
+// India
+భారత్
+
+// xn--gecrj9c ("Bharat" Gujarati) : IN
+// India
+ભારત
+
+// xn--s9brj9c ("Bharat" Gurmukhi) : IN
+// India
+ਭਾਰਤ
+
+// xn--45brj9c ("Bharat" Bengali) : IN
+// India
+ভারত
+
+// xn--xkc2dl3a5ee0h ("India" Tamil) : IN
+// India
+இந்தியா
+
+// xn--mgba3a4f16a ("Iran" Persian) : IR
+ایران
+
+// xn--mgba3a4fra ("Iran" Arabic) : IR
+ايران
+
+//xn--mgbayh7gpa ("al-Ordon" Arabic) JO
+//National Information Technology Center (NITC)
+//Royal Scientific Society, Al-Jubeiha
+الاردن
+
+// xn--3e0b707e ("Republic of Korea" Hangul) : KR
+한국
+
+// xn--fzc2c9e2c ("Lanka" Sinhalese-Sinhala) : LK
+// http://nic.lk
+ලංකා
+
+// xn--xkc2al3hye2a ("Ilangai" Tamil) : LK
+// http://nic.lk
+இலங்கை
+
+// xn--mgbc0a9azcg ("Morocco / al-Maghrib" Arabic) : MA
+المغرب
+
+// xn--mgb9awbf ("Oman" Arabic) : OM
+عمان
+
+// xn--ygbi2ammx ("Falasteen" Arabic) : PS
+// The Palestinian National Internet Naming Authority (PNINA)
+// http://www.pnina.ps
+فلسطين
+
+// xn--90a3ac ("srb" Cyrillic) : RS
+срб
+
+// xn--p1ai ("rf" Russian-Cyrillic) : RU
+// http://www.cctld.ru/en/docs/rulesrf.php
+рф
+
+// xn--wgbl6a ("Qatar" Arabic) : QA
+// http://www.ict.gov.qa/
+قطر
+
+// xn--mgberp4a5d4ar ("AlSaudiah" Arabic) : SA
+// http://www.nic.net.sa/
+السعودية
+
+// xn--mgberp4a5d4a87g ("AlSaudiah" Arabic) variant : SA
+السعودیة
+
+// xn--mgbqly7c0a67fbc ("AlSaudiah" Arabic) variant : SA
+السعودیۃ
+
+// xn--mgbqly7cvafr ("AlSaudiah" Arabic) variant : SA
+السعوديه
+
+// xn--ogbpf8fl ("Syria" Arabic) : SY
+سورية
+
+// xn--mgbtf8fl ("Syria" Arabic) variant : SY
+سوريا
+
+// xn--yfro4i67o Singapore ("Singapore" Chinese-Han) : SG
+新加坡
+
+// xn--clchc0ea0b2g2a9gcd ("Singapore" Tamil) : SG
+சிங்கப்பூர்
+
+// xn--o3cw4h ("Thai" Thai) : TH
+// http://www.thnic.co.th
+ไทย
+
+// xn--pgbs0dh ("Tunis") : TN
+// http://nic.tn
+تونس
+
+// xn--kpry57d ("Taiwan" Chinese-Han-Traditional) : TW
+// http://www.twnic.net/english/dn/dn_07a.htm
+台灣
+
+// xn--kprw13d ("Taiwan" Chinese-Han-Simplified) : TW
+// http://www.twnic.net/english/dn/dn_07a.htm
+台湾
+
+// xn--nnx388a ("Taiwan") variant : TW
+臺灣
+
+// xn--j1amh ("ukr" Cyrillic) : UA
+укр
+
+// xn--mgb2ddes ("AlYemen" Arabic) : YE
+اليمن
+
+// xxx : http://icmregistry.com
+xxx
+
+// ye : http://www.y.net.ye/services/domain_name.htm
+*.ye
+
+// yu : http://www.nic.yu/pravilnik-e.html
+*.yu
+
+// za : http://www.zadna.org.za/slds.html
+*.za
+
+// zm : http://en.wikipedia.org/wiki/.zm
+*.zm
+
+// zw : http://en.wikipedia.org/wiki/.zw
+*.zw
+
+// DynDNS.com Dynamic DNS zones : http://www.dyndns.com/services/dns/dyndns/
+dyndns-at-home.com
+dyndns-at-work.com
+dyndns-blog.com
+dyndns-free.com
+dyndns-home.com
+dyndns-ip.com
+dyndns-mail.com
+dyndns-office.com
+dyndns-pics.com
+dyndns-remote.com
+dyndns-server.com
+dyndns-web.com
+dyndns-wiki.com
+dyndns-work.com
+dyndns.biz
+dyndns.info
+dyndns.org
+dyndns.tv
+at-band-camp.net
+ath.cx
+barrel-of-knowledge.info
+barrell-of-knowledge.info
+better-than.tv
+blogdns.com
+blogdns.net
+blogdns.org
+blogsite.org
+boldlygoingnowhere.org
+broke-it.net
+buyshouses.net
+cechire.com
+dnsalias.com
+dnsalias.net
+dnsalias.org
+dnsdojo.com
+dnsdojo.net
+dnsdojo.org
+does-it.net
+doesntexist.com
+doesntexist.org
+dontexist.com
+dontexist.net
+dontexist.org
+doomdns.com
+doomdns.org
+dvrdns.org
+dyn-o-saur.com
+dynalias.com
+dynalias.net
+dynalias.org
+dynathome.net
+dyndns.ws
+endofinternet.net
+endofinternet.org
+endoftheinternet.org
+est-a-la-maison.com
+est-a-la-masion.com
+est-le-patron.com
+est-mon-blogueur.com
+for-better.biz
+for-more.biz
+for-our.info
+for-some.biz
+for-the.biz
+forgot.her.name
+forgot.his.name
+from-ak.com
+from-al.com
+from-ar.com
+from-az.net
+from-ca.com
+from-co.net
+from-ct.com
+from-dc.com
+from-de.com
+from-fl.com
+from-ga.com
+from-hi.com
+from-ia.com
+from-id.com
+from-il.com
+from-in.com
+from-ks.com
+from-ky.com
+from-la.net
+from-ma.com
+from-md.com
+from-me.org
+from-mi.com
+from-mn.com
+from-mo.com
+from-ms.com
+from-mt.com
+from-nc.com
+from-nd.com
+from-ne.com
+from-nh.com
+from-nj.com
+from-nm.com
+from-nv.com
+from-ny.net
+from-oh.com
+from-ok.com
+from-or.com
+from-pa.com
+from-pr.com
+from-ri.com
+from-sc.com
+from-sd.com
+from-tn.com
+from-tx.com
+from-ut.com
+from-va.com
+from-vt.com
+from-wa.com
+from-wi.com
+from-wv.com
+from-wy.com
+ftpaccess.cc
+fuettertdasnetz.de
+game-host.org
+game-server.cc
+getmyip.com
+gets-it.net
+go.dyndns.org
+gotdns.com
+gotdns.org
+groks-the.info
+groks-this.info
+ham-radio-op.net
+here-for-more.info
+hobby-site.com
+hobby-site.org
+home.dyndns.org
+homedns.org
+homeftp.net
+homeftp.org
+homeip.net
+homelinux.com
+homelinux.net
+homelinux.org
+homeunix.com
+homeunix.net
+homeunix.org
+iamallama.com
+in-the-band.net
+is-a-anarchist.com
+is-a-blogger.com
+is-a-bookkeeper.com
+is-a-bruinsfan.org
+is-a-bulls-fan.com
+is-a-candidate.org
+is-a-caterer.com
+is-a-celticsfan.org
+is-a-chef.com
+is-a-chef.net
+is-a-chef.org
+is-a-conservative.com
+is-a-cpa.com
+is-a-cubicle-slave.com
+is-a-democrat.com
+is-a-designer.com
+is-a-doctor.com
+is-a-financialadvisor.com
+is-a-geek.com
+is-a-geek.net
+is-a-geek.org
+is-a-green.com
+is-a-guru.com
+is-a-hard-worker.com
+is-a-hunter.com
+is-a-knight.org
+is-a-landscaper.com
+is-a-lawyer.com
+is-a-liberal.com
+is-a-libertarian.com
+is-a-linux-user.org
+is-a-llama.com
+is-a-musician.com
+is-a-nascarfan.com
+is-a-nurse.com
+is-a-painter.com
+is-a-patsfan.org
+is-a-personaltrainer.com
+is-a-photographer.com
+is-a-player.com
+is-a-republican.com
+is-a-rockstar.com
+is-a-socialist.com
+is-a-soxfan.org
+is-a-student.com
+is-a-teacher.com
+is-a-techie.com
+is-a-therapist.com
+is-an-accountant.com
+is-an-actor.com
+is-an-actress.com
+is-an-anarchist.com
+is-an-artist.com
+is-an-engineer.com
+is-an-entertainer.com
+is-by.us
+is-certified.com
+is-found.org
+is-gone.com
+is-into-anime.com
+is-into-cars.com
+is-into-cartoons.com
+is-into-games.com
+is-leet.com
+is-lost.org
+is-not-certified.com
+is-saved.org
+is-slick.com
+is-uberleet.com
+is-very-bad.org
+is-very-evil.org
+is-very-good.org
+is-very-nice.org
+is-very-sweet.org
+is-with-theband.com
+isa-geek.com
+isa-geek.net
+isa-geek.org
+isa-hockeynut.com
+issmarterthanyou.com
+isteingeek.de
+istmein.de
+kicks-ass.net
+kicks-ass.org
+knowsitall.info
+land-4-sale.us
+lebtimnetz.de
+leitungsen.de
+likes-pie.com
+likescandy.com
+merseine.nu
+mine.nu
+misconfused.org
+mypets.ws
+myphotos.cc
+neat-url.com
+office-on-the.net
+on-the-web.tv
+podzone.net
+podzone.org
+readmyblog.org
+saves-the-whales.com
+scrapper-site.net
+scrapping.cc
+selfip.biz
+selfip.com
+selfip.info
+selfip.net
+selfip.org
+sells-for-less.com
+sells-for-u.com
+sells-it.net
+sellsyourhome.org
+servebbs.com
+servebbs.net
+servebbs.org
+serveftp.net
+serveftp.org
+servegame.org
+shacknet.nu
+simple-url.com
+space-to-rent.com
+stuff-4-sale.org
+stuff-4-sale.us
+teaches-yoga.com
+thruhere.net
+traeumtgerade.de
+webhop.biz
+webhop.info
+webhop.net
+webhop.org
+worse-than.tv
+writesthisblog.com
viper-cards_pdf: ${VIPER_CARDS_PDF}
viper-cards_ps: ${VIPER_CARDS_PDF:.pdf=.ps}
+ENVADD = TEXINPUTS=".:"
## PDF files.
## The page layouts (a4/letter) are written directly in the .tex files.
cs-refcard.pdf cs-dired-ref.pdf cs-survival.pdf sk-refcard.pdf \
-sk-dired-ref.pdf sk-survival.pdf: %.pdf: %.tex
+sk-dired-ref.pdf sk-survival.pdf: %.pdf: %.tex emacsver.tex
if pdfcsplain --version > /dev/null 2> /dev/null; then \
- pdfcsplain $<; \
+ ${ENVADD} pdfcsplain $<; \
else \
- csplain "\pdfoutput=1\input $<"; \
+ ${ENVADD} csplain "\pdfoutput=1\input $<"; \
fi
## Some versions of pdfmex seem to create dvi by default, hence output-format.
-pl-refcard.pdf: %.pdf: %.tex
+pl-refcard.pdf: %.pdf: %.tex emacsver.tex
if ! kpsewhich -format=fmt mex > /dev/null && \
! pdfmex --version > /dev/null 2> /dev/null; then \
echo "No mex format found."; false; \
fi
- pdftex -output-format=pdf $<
+ ${ENVADD} pdftex -output-format=pdf $<
ru-refcard.pdf: %.pdf: %.tex
pdflatex $<
pdflatex -jobname=gnus-booklet '\def\booklettrue{}\def\letterpapertrue{}\input{gnus-refcard}'
## Everything not explicitly listed above.
-%.pdf: %.tex
- pdftex $<
+%.pdf: %.tex emacsver.tex
+ ${ENVADD} pdftex $<
## dvi files.
cs-refcard.dvi cs-dired-ref.dvi cs-survival.dvi sk-refcard.dvi \
-sk-dired-ref.dvi sk-survival.dvi: %.dvi: %.tex
- csplain $<
+sk-dired-ref.dvi sk-survival.dvi: %.dvi: %.tex emacsver.tex
+ ${ENVADD} csplain $<
-pl-refcard.dvi: %.dvi: %.tex
+pl-refcard.dvi: %.dvi: %.tex emacsver.tex
if ! kpsewhich -format=fmt mex > /dev/null; then \
echo "No mex format found."; false; \
fi
- tex $<
+ ${ENVADD} tex $<
ru-refcard.dvi gnus-refcard.dvi: %.dvi: %.tex
latex $<
mv gnus-refcard.dvi $@
## Everything not explicitly listed above.
-%.dvi: %.tex
- tex $<
+%.dvi: %.tex emacsver.tex
+ ${ENVADD} tex $<
## PostScript files.
% UUCP: mit-erl!gildea
% Internet: gildea@stop.mail-abuse.org
-\def\emacsversionnumber{24}
-\def\year{2012} % latest copyright year
+\input emacsver.tex
\def\shortcopyrightnotice{\vskip 1ex plus 2 fill
\centerline{\small \copyright\ \year\ Free Software Foundation, Inc.
\title{GNU Calc Reference Card}
-\centerline{(for GNU Emacs version \emacsversionnumber)}
+\centerline{(for GNU Emacs version \versionemacs)}
\section{Starting and Stopping}
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
% Czech hyphenation rules applied
\chyph
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
\def\copyrightnotice{\penalty-1\vfill
\vbox{\smallfont\baselineskip=0.8\baselineskip\raggedcenter
\input german.sty
\mdqoff % deactivates the "-char
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed below this line.
\input pdflayout.sty
\pdflayout=(1)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
--- /dev/null
+%% This file is not generated by configure, because then the provided
+%% pdf files would always appear out-of-date.
+\def\versionemacs{24} % major version of emacs
+\def\year{2012} % latest copyright year
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
\input pdflayout.sty
\pdflayout=(0l)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed below this line.
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
\def\copyrightnotice{\penalty-1\vfill
\vbox{\smallfont\baselineskip=0.8\baselineskip\raggedcenter
% Reference Card for Org Mode
\def\orgversionnumber{7.8.11}
\def\versionyear{2012} % latest update
-\def\year{2012} % latest copyright year
+\input emacsver.tex
%**start of header
\newcount\columnsperpage
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
\input pdflayout.sty
\pdflayout=(0l)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed below this line.
% Nothing else needs to be changed below this line.
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % copyright year
+\input emacsver.tex
\def\shortcopyrightnotice{\vskip 1ex plus 2 fill
\centerline{\small \copyright\ \year\ Free Software Foundation, Inc.
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
\input pdflayout.sty
\pdflayout=(0)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
% Nothing else needs to be changed.
% Slovak hyphenation rules applied
\shyph
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
\def\copyrightnotice{\penalty-1\vfill
\vbox{\smallfont\baselineskip=0.8\baselineskip\raggedcenter
\input pdflayout.sty
\pdflayout=(1)
-\def\versionemacs{24} % version of Emacs this is for
-\def\year{2012} % latest copyright year
+\input emacsver.tex
\def\copyrightnotice{\penalty-1\vfill
\vbox{\smallfont\baselineskip=0.8\baselineskip\raggedcenter
\input pdflayout.sty
\pdflayout=(1)
+\input emacsver.tex
\def\versionemacs{18} % version of Emacs this is for
-\def\year{2012} % latest copyright year
\def\versionvip{3.5}
% Nothing else needs to be changed.
\input pdflayout.sty
\pdflayout=(1)
+\input emacsver.tex
\def\versionemacs{21} % version of Emacs this is for
-\def\year{2012} % latest copyright year
\def\versionxemacs{20} % version of XEmacs this is for
\def\versionviper{3.0} % version of Viper this is for
`(compilation-error ((,class (:foreground "Red1"))))
`(compilation-info ((,class (:weight normal :foreground "LightSkyBlue"))))
`(compilation-line-number ((,class (:foreground "LightGreen"))))
+ `(compilation-mode-line-exit ((,class (:foreground "blue4"))))
`(cperl-array-face ((,class (:foreground "yellow2"))))
`(cperl-hash-face ((,class (:foreground "coral1"))))
`(cursor ((,class (:background "green"))))
'(org-agenda-structure ((t (:foreground "LightSkyBlue"))))
'(org-archived ((t (:foreground "grey70"))))
'(org-code ((t (:foreground "grey70"))))
- '(org-column ((t (:background "grey30" :slant normal :weight normal :height 81 :family "unknown-DejaVu Sans Mono"))))
+ '(org-column ((t (:background "grey30" :slant normal :weight normal :height 81))))
'(org-column-title ((t (:bold t :background "grey30" :underline t :weight bold))))
'(org-date ((t (:foreground "Cyan" :underline t))))
'(org-done ((t (:bold t :foreground "PaleGreen" :weight bold))))
'(CUA-global-mark-face ((t (:background "cyan" :foreground "black"))))
'(CUA-rectangle-face ((t (:background "maroon" :foreground "white"))))
'(CUA-rectangle-noselect-face ((t (:background "dimgray" :foreground "white"))))
- '(Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728))))
- '(Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44))))
- '(Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2))))
- '(Info-title-4-face ((t (:bold t :family "helv" :weight bold))))
+ '(Info-title-1-face ((t (:bold t :weight bold :height 1.728))))
+ '(Info-title-2-face ((t (:bold t :weight bold :height 1.44))))
+ '(Info-title-3-face ((t (:bold t :weight bold :height 1.2))))
+ '(Info-title-4-face ((t (:bold t :weight bold))))
'(align-highlight-nochange-face ((t (:background "SkyBlue4"))))
'(antlr-font-lock-keyword-face ((t (:foreground "SteelBlue")))) ;%
'(change-log-conditionals-face ((t (:foreground "Aquamarine"))))
'(change-log-date-face ((t (:italic t :slant oblique :foreground "BurlyWood"))))
'(change-log-email-face ((t (:foreground "Aquamarine"))))
- '(change-log-file-face ((t (:bold t :family "Verdana" :weight bold :foreground "LightSkyBlue" :height 0.9))))
+ '(change-log-file-face ((t (:bold t :weight bold :foreground "LightSkyBlue" :height 0.9))))
'(change-log-function-face ((t (:foreground "Aquamarine"))))
'(change-log-list-face ((t (:foreground "LightSkyBlue"))))
'(change-log-name-face ((t (:bold t :weight bold :foreground "Gold"))))
'(compilation-message-face ((t (:underline t))))
'(compilation-warning ((t (:bold t :foreground "Orange" :weight bold))))
'(compilation-warning-face ((t (:bold t :foreground "Orange" :weight bold))))
- '(completions-common-part ((t (:family "unknown-DejaVu Sans Mono"
- :width normal :weight normal
- :slant normal :foreground "WhiteSmoke"
- :background "black" :height 81))))
+ '(completions-common-part ((t (:width normal :weight normal
+ :slant normal :foreground "WhiteSmoke"
+ :background "black" :height 81))))
'(completions-first-difference ((t (:bold t :weight bold))))
'(css-selector ((t (:foreground "LightSteelBlue"))))
'(custom-changed-face ((t (:foreground "wheat" :background "blue"))))
'(custom-comment-face ((t (:background "dim gray"))))
'(custom-comment-tag-face ((t (:foreground "gray80"))))
- '(custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.1))))
- '(custom-group-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.1))))
- '(custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.1))))
+ '(custom-face-tag-face ((t (:bold t :weight bold :height 1.1))))
+ '(custom-group-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.1))))
+ '(custom-group-tag-face-1 ((t (:bold t :foreground "pink" :weight bold :height 1.1))))
'(custom-invalid-face ((t (:background "red" :foreground "yellow"))))
'(custom-modified-face ((t (:background "blue" :foreground "white"))))
'(custom-rogue-face ((t (:background "black" :foreground "pink"))))
:background "lightgrey"
:foreground "black"
:box '(:line-width 2 :style released-button)))))
- '(custom-variable-tag-face ((t (:bold t :family "helv"
- :foreground "light blue"
- :weight bold :height 1.2))))
+ '(custom-variable-tag-face ((t (:bold t :foreground "light blue"
+ :weight bold :height 1.2))))
'(diary ((t (:foreground "IndianRed"))))
'(diary-anniversary ((t (:foreground "Cyan1"))))
'(excerpt ((t (:italic t))))
'(file-name-shadow ((t (:foreground "grey70"))))
'(fixed ((t (:bold t))))
- '(fixed-pitch ((t (:family "courier"))))
'(flyspell-duplicate-face ((t (:foreground "IndianRed" :bold t :underline t))))
'(flyspell-incorrect-face ((t (:foreground "Pink" :bold t :underline t))))
'(ido-only-match ((t (:foreground "ForestGreen"))))
'(ido-subdir ((t (:foreground "red1"))))
'(info-menu-5 ((t (:underline t))))
- '(info-menu-header ((t (:bold t :family "helv" :weight bold))))
+ '(info-menu-header ((t (:bold t :weight bold))))
'(info-node ((t (:bold t :italic t :foreground "yellow"))))
'(info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold))))
'(info-xref ((t (:bold t :foreground "DodgerBlue1"))))
'(table-cell ((t (:background "blue1" :foreground "gray90"))))
'(tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button)))))
- '(tooltip ((t (:family "helv" :background "lightyellow" :foreground "black"))))
+ '(tooltip ((t (:background "lightyellow" :foreground "black"))))
'(trailing-whitespace ((t (:background "red1"))))
'(underline ((t (:underline t))))
- '(variable-pitch ((t (:family "helv"))))
'(vcursor ((t (:foreground "blue" :background "cyan" :underline t))))
'(vertical-border ((t (:background "dim gray"))))
'(vhdl-font-lock-attribute-face ((t (:foreground "Orchid"))))
`(mode-line-inactive ((,class
(:box (:line-width -1 :style released-button)
:background ,alum-5 :foreground ,alum-1))))
+ `(compilation-mode-line-fail ((,class (:foreground ,red-3))))
+ `(compilation-mode-line-run ((,class (:foreground ,orange-3))))
+ `(compilation-mode-line-exit ((,class (:foreground ,cham-3))))
;; Escape and prompt faces
`(minibuffer-prompt ((,class (:foreground ,cham-0))))
`(escape-glyph ((,class (:foreground ,butter-3))))
(custom-theme-set-faces
'tsdh-dark
'(default ((t (:background "gray20" :foreground "white smoke"))))
+ '(compilation-mode-line-fail ((t (:foreground "red"))))
+ '(compilation-mode-line-run ((t (:foreground "dark orange"))))
+ '(compilation-mode-line-exit ((t (:foreground "sea green"))))
'(diff-added ((t (:inherit diff-changed :background "dark green"))))
'(diff-changed ((t (:background "midnight blue"))))
'(diff-indicator-added ((t (:inherit diff-indicator-changed))))
'(message-header-subject ((t (:foreground "SkyBlue"))))
'(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold))))
'(mode-line ((t (:box (:line-width -1 :color "red" :style released-button) :family "DejaVu Sans"))))
- '(mode-line-inactive ((t (:inherit mode-line :foreground "dim gray"))))
+ '(mode-line-inactive ((t (:inherit mode-line :foreground "gray"))))
'(org-agenda-date ((t (:inherit org-agenda-structure))))
'(org-agenda-date-today ((t (:inherit org-agenda-date :underline t))))
'(org-agenda-date-weekend ((t (:inherit org-agenda-date :foreground "dark green"))))
`(error ((,class (:foreground "salmon1"))))
`(warning ((,class (:foreground "orange"))))
`(success ((,class (:foreground "yellow green"))))
+ ;; Compilation faces
+ `(compilation-mode-line-fail ((,class (:foreground "dark green"))))
+ `(compilation-mode-line-run ((,class (:foreground "dark goldenrod"))))
+ `(compilation-mode-line-exit ((,class (:foreground "SpringGreen4"))))
;; Highlighting faces
`(highlight ((,class (:foreground "white" :background "dark green"))))
`(region ((,class (:foreground "white" :background "dark green"))))
try using a command. For instance:
<<Blank lines inserted around following line by help-with-tutorial>>
[Middle of page left blank for didactic purposes. Text continues below]
->> Now type C-v (View next screen) to move to the next screen.
+>> Now type C-v (View next screen) to move to the next screen.
(go ahead, do it by holding down the CONTROL key while typing v).
From now on, you should do this again whenever you finish
reading the screen.
with C-v. To move backwards one screen, type M-v (hold down the META key
and type v, or type <ESC>v if you do not have a META, EDIT, or ALT key).
->> Try typing M-v and then C-v, a few times.
+>> Try typing M-v and then C-v, a few times.
* SUMMARY
something different.
C-v and M-v are another kind of exception. When given an argument,
-they scroll the screen up or down by that many lines, rather than by a
-screenful. For example, C-u 8 C-v scrolls the screen by 8 lines.
+they scroll the text up or down by that many lines, rather than by a
+screenful. For example, C-u 8 C-v scrolls by 8 lines.
>> Try typing C-u 8 C-v now.
-This should have scrolled the screen up by 8 lines. If you would like
+This should have scrolled the text up by 8 lines. If you would like
to scroll it down again, you can give an argument to M-v.
If you are using a graphical display, such as X or MS-Windows, there
>> Type C-x 1 and see the documentation listing window disappear.
-This command is unlike the other commands you have learned in that it
-consists of two characters. It starts with the character CONTROL-x.
There is a whole series of commands that start with CONTROL-x; many of
them have to do with windows, files, buffers, and related things.
These commands are two, three or four characters long.
this includes text characters. Repeating a text character inserts
it several times.
->> Try that now -- type C-u 8 * to insert ********.
+>> Try that now -- type C-u 8 * to insert ********.
You've now learned the most basic way of typing something in
Emacs and correcting errors. You can delete by words or lines
This copies the text within Emacs into the file. The first time you
do this, Emacs renames the original file to a new name so that it is
not lost. The new name is made by adding "~" to the end of the
-original file's name.
-
-When saving is finished, Emacs displays the name of the file written.
-You should save fairly often, so that you will not lose very much
-work if the system should crash (see the section "Auto Save" below).
+original file's name. When saving is finished, Emacs displays the
+name of the file written.
>> Type C-x C-s TUTORIAL <Return>.
This should save this tutorial to a file named TUTORIAL, and show
You can find an existing file, to view it or edit it. You can also
find a file which does not already exist. This is the way to create a
-file with Emacs: find the file, which will start out empty, and then
-begin inserting the text for the file. When you ask to "save" the
-file, Emacs will really create the file with the text that you have
-inserted. From then on, you can consider yourself to be editing an
-already existing file.
+file with Emacs: find the file, which starts out empty, and then begin
+inserting the text for the file. When you ask to "save" the file,
+Emacs actually creates the file with the text that you have inserted.
+From then on, you can consider yourself to be editing an already
+existing file.
* BUFFERS
in that file's buffer. The creation or editing of the second file's
buffer has no effect on the first file's buffer. This is very useful,
but it also means that you need a convenient way to save the first
-file's buffer. It would be a nuisance to have to switch back to
-it with C-x C-f in order to save it with C-x C-s. So we have
+file's buffer. Having to switch back to that buffer, in order to save
+it with C-x C-s, would be a nuisance. So we have
C-x s Save some buffers
command to move from Emacs to another application. You can do this
with the mouse or with window manager commands. However, if you're
using a text terminal which can only show one application at a time,
-you need to "suspend" Emacs to move to any other program.
+you need to "suspend" Emacs to move to any other application.
C-z is the command to exit Emacs *temporarily*--so that you can go
back to the same Emacs session afterward. When Emacs is running on a
can resume Emacs with the `fg' command or with `%emacs'.
The time to use C-x C-c is when you are about to log out. It's also
-the right thing to use to exit an Emacs invoked under mail handling
-programs and other miscellaneous utilities.
+the right thing to use to exit an Emacs invoked for a quick edit, such
+as by a mail handling utility.
There are many C-x commands. Here is a list of the ones you have learned:
Named eXtended commands are commands which are used even less
frequently, or commands which are used only in certain modes. An
-example is the command replace-string, which globally replaces one
-string with another. When you type M-x, Emacs prompts you at the
+example is the command replace-string, which replaces one string with
+another in the buffer. When you type M-x, Emacs prompts you at the
bottom of the screen with M-x and you should type the name of the
command; in this case, "replace-string". Just type "repl s<TAB>" and
Emacs will complete the name. (<TAB> is the Tab key, usually found
>> Move the cursor to the blank line two lines below this one.
Then type M-x repl s<Return>changed<Return>altered<Return>.
- Notice how this line has changed: you've replaced
- the word c-h-a-n-g-e-d with "altered" wherever it occurred,
- after the initial position of the cursor.
+ Notice how this line has changed: you've replaced the word
+ "changed" with "altered" wherever it occurred, after the
+ initial position of the cursor.
* AUTO SAVE
To view documentation on your current major mode, type C-h m.
+>> Move the cursor to the line following this line.
>> Type C-l C-l to bring this line to the top of screen.
>> Type C-h m, to see how Text mode differs from Fundamental mode.
>> Type C-x 1 to remove the documentation from the screen.
The command C-M-v is very useful when you are editing text in one
window and using the other window just for reference. Without leaving
-the selected window, you can scroll the other window with C-M-v.
+the selected window, you can scroll the text in the other window with
+C-M-v.
C-M-v is an example of a CONTROL-META character. If you have a META
(or Alt) key, you can type C-M-v by holding down both CONTROL and META
>> Type C-h a file <Return>.
This displays in another window a list of all M-x commands with "file"
-in their names. You will see character-commands like C-x C-f listed
-beside the corresponding command names such as find-file.
+in their names. You will see character-commands listed beside the
+corresponding command names (such as C-x C-f beside find-file).
>> Type C-M-v to scroll the help window. Do this a few times.
valor, hace que el comando actúe de forma diferente.
C-v y M-v son otro tipo de excepción. Cuando se les da un argumento,
-desplazan la pantalla arriba o abajo esa cantidad de líneas, en vez de
+desplazan el texto arriba o abajo esa cantidad de líneas, en vez de
una pantalla completa. Por ejemplo, C-u 8 C-v desplaza la pantalla 8
líneas.
>> Pruebe tecleando C-u 8 C-v ahora.
-Esto debió haber desplazado la pantalla hacia arriba 8 líneas. Si
+Esto debería haber desplazado el texto hacia arriba 8 líneas. Si
quisiera desplazarla hacia abajo de nuevo, puede dar un argumento a
M-v.
>> Escriba C-x 1 y vea que la ventana de listado de documentación
desaparece.
-Este comando es diferente a los otros que ha aprendido en que éste
-consiste de dos caracteres. Comienza con el carácter CONTROL-x. Hay
-toda una serie de comandos que comienzan con CONTROL-x; muchos de
+Hay toda una serie de comandos que comienzan con CONTROL-x; muchos de
ellos tienen que ver con ventanas, archivos, buffers y cosas
relacionadas. Estos comandos son de una longitud de dos, tres o
cuatro caracteres.
Esto copia el texto dentro de Emacs al archivo. La primera vez que
haga esto, Emacs renombrará el archivo original con un nuevo nombre
para que éste no se pierda. El nuevo nombre se hace agregando "~" al
-final del nombre del archivo original.
-
-Cuando guardar haya terminado, Emacs mostrará el nombre del archivo
-escrito. Deberá guardar frecuentemente, para que no pierda mucho
-trabajo si el sistema falla (vea la sección "AUTO GUARDADO", más
-adelante).
+final del nombre del archivo original. Cuando guardar haya terminado,
+Emacs mostrará el nombre del archivo escrito.
>> Teclee C-x C-s TUTORIAL.es <Return>
Esto guardará el tutorial en un archivo llamado TUTORIAL.es, y
Puede encontrar un archivo existente, para verlo o editarlo. También
puede hacerlo con un archivo que no exista. Ésta es la forma de crear
-un archivo en Emacs: encuentre el archivo, que comenzará vacío, luego
-comience a insertar el texto para ese archivo. Cuando invoque
+un archivo en Emacs: encuentre el archivo, que está inicialmente vacío,
+luego comience a insertar el texto para ese archivo. Cuando invoque
"guardar" el archivo, Emacs creará realmente el archivo con el texto
-que ha insertado. De ahí en adelante, puede considerarse estar
+que ha insertado. De ahí en adelante, puede considerar que está
editando un archivo existente.
dentro de Emacs en ese buffer del archivo. La creación o edición del
segundo buffer de archivo no afecta al primero. Esto es muy útil,
pero también significa que necesita una forma conveniente para guardar
-el archivo del primer buffer. Sería una molestia tener que volver a
-éste con C-x C-f para guardarlo con C-x C-s. Así tenemos
+el archivo del primer buffer. Tener que volver a él para guardarlo
+con C-x C-s sería una molestia. Por tanto, tenemos
C-x s Guardar algunos buffers
especial para cambiar de Emacs a otra aplicación. Puede hacerlo con
el ratón, o mediante el gestor de ventanas. Sin embargo, si está
usando una terminal que solo puede mostrar una aplicación a la vez,
-tendrá que "suspender" Emacs para poder acceder a otros programas.
+tendrá que "suspender" Emacs para poder acceder a otras aplicaciones.
C-z es el comando para salir de Emacs *temporalmente*: para que pueda
regresar a la misma sesión de Emacs después. Cuando Emacs está
comando `fg' o con `%emacs'.
El momento para usar C-x C-c es cuando está listo para salir del
-sistema. Es además el paso correcto para salir de un Emacs llamado
-bajo programas de gestión de correo y otras utilidades diversas.
+sistema. Es además el paso correcto para salir de un Emacs invocado
+para editar algo rápidamente, como por ejemplo desde un programa de
+gestión de correo.
Existen muchos comandos C-x. He aquí la lista de los que ya ha
aprendido:
Los comandos eXtendidos por nombre son comandos que se utilizan aún
con menos frecuencia, o únicamente en ciertos modos. Un ejemplo es el
-comando replace-string, el cual substituye globalmente una cadena de
-caracteres por otra. Cuando teclea M-x, Emacs le pregunta al final de
-la pantalla con M-x y debe escribir el nombre del comando; en este
-caso "replace-string". Solo teclee "repl s<TAB>" y Emacs completará
-el nombre. (<TAB> es la tecla del tabulador, que habitualmenté está
-situada sobre la tecla de bloquear mayúsculas o la de shift, en el
-lado izquierdo del teclado.) Para aceptar el comando y ejecutarlo,
-pulse <Return>.
+comando replace-string, el cual substituye una cadena de caracteres
+por otra en todo el buffer. Cuando teclea M-x, Emacs le pregunta al
+final de la pantalla con M-x y debe escribir el nombre del comando; en
+este caso "replace-string". Solo teclee "repl s<TAB>" y Emacs
+completará el nombre. (<TAB> es la tecla del tabulador, que
+habitualmenté está situada sobre la tecla de bloquear mayúsculas o la
+de shift, en el lado izquierdo del teclado.) Para aceptar el comando
+y ejecutarlo, pulse <Return>.
El comando replace-string requiere dos argumentos: la cadena de
caracteres a reemplazar, y la cadena de caracteres para reemplazarla.
A continuación escriba
M-x repl s<Return>cambiado<Return>alterado<Return>.
- Note cómo esta línea ha cambiado: ha substituido la palabra
- c-a-m-b-i-a-d-o por "alterado" en cada ocurrencia, después de la
+ Note cómo ha cambiado la línea: ha substituido la palabra
+ "cambiado" por "alterado" en cada ocurrencia, después de la
posición inicial del cursor.
Para ver la documentación del modo mayor actual, teclee C-h m.
->> Use C-l C-l para traer esta línea en la parte superior de la
+>> Mueva el cursor a la línea siguiente a la actual.
+
+>> Use C-l C-l para traer esta línea a la parte superior de la
pantalla.
>> Teclee C-h m, para ver como el modo de Texto difiere del modo
>> Teclee C-h a file <Return>.
Esto muestra en otra ventana una lista de todos los comandos M-x con
-la palabra "file" en sus nombres. Verá comandos de caracteres como
-C-x C-f listados además de los nombres de los comandos
-correspondientes tales como find-file.
+la palabra "file" en sus nombres. Verá los comandos de caracteres
+listados junto a los nombres de los comandos correspondientes (por
+ejemplo, C-x C-f junto a find-file).
>> Teclee C-M-v para desplazar la ventana de ayuda. Haga esto unas
cuantas veces.
indiquent les directions à suivre pour essayer une commande. Ainsi :
<<Lignes blanches insérées après cette ligne par help-with-tutorial>>
[Centre de page delibérément vide. Le texte continue ci-dessous.]
->> Tapez C-v (Voir l'écran suivant) pour passer à l'écran suivant
- (faites-le, pressez la touche CTRL tout en pressant la touche v).
- À partir de maintenant, vous devrez le faire à chaque fois que
- vous avez fini de lire l'écran.
+>> Tapez C-v (Voir l'écran suivant) pour passer à l'écran suivant
+ (faites-le, pressez la touche CTRL tout en pressant la touche v).
+ À partir de maintenant, vous devrez le faire à chaque fois que
+ vous avez fini de lire l'écran.
Vous remarquerez qu'il y a un recouvrement de deux lignes lorsque l'on
passe d'un écran à un autre : cela permet une certaine continuité dans
META tout en appuyant sur v ou faites <ESC>v si vous n'avez pas de
touche META, EDIT ou ALT).
->> Faites M-v, puis C-v plusieurs fois.
+>> Faites M-v, puis C-v plusieurs fois.
* RÉSUMÉ
agir différemment.
C-v et M-v constituent un autre type d'exception. Lorsqu'on leur donne
-un paramètre, elles font défiler l'écran vers le haut ou vers le bas
+un paramètre, elles font défiler le texte vers le haut ou vers le bas
du nombre de lignes indiqué au lieu de passer d'un écran complet à
-l'autre. C-u 8 C-v, par exemple, fait défiler l'écran de 8 lignes.
+l'autre. C-u 8 C-v, par exemple, fait défiler le texte de 8 lignes.
>> Faites C-u 8 C-v.
-Cela a dû déplacer l'écran de 8 lignes vers le haut. Si vous voulez
+Cela a dû déplacer le texte de 8 lignes vers le haut. Si vous voulez
redescendre de 8 lignes, il suffit de passer ce nombre comme paramètre
de M-v.
>> Faites C-x 1 et la fenêtre de documentation disparaît.
-Cette commande est différente de celles que nous avons déjà vues car
-elle est formée de deux caractères. Elle commence par le caractère
-CONTROLE-x, comme le font de nombreuses commandes de manipulation de
-fenêtres, fichiers, tampons et autres entités associées. Ces commandes
-font deux, trois ou quatre caractères.
+Il y a toute une série de commandes qui commencent par CONTROL-x;
+nombre d'entre elles ont à voir avec la manipulation de fenêtres,
+fichiers, tampons et autres entités associées. Ces commandes font
+deux, trois ou quatre caractères de long.
* INSERTION ET SUPPRESSION
nombre de répétitions ; les caractères de texte font de même. La
répétition d'un caractère de texte l'insère plusieurs fois.
->> Faites C-u 8 * pour insérer ********.
+>> Faites C-u 8 * pour insérer ********.
Vous connaissez maintenant la méthode la plus simple pour taper du
texte dans Emacs et pour corriger les erreurs. Vous pouvez également
Cette commande copie dans le fichier le texte qui est dans Emacs. La
première fois, Emacs renomme le fichier original afin qu'il ne soit
pas perdu. Le nom de cette sauvegarde est construit en ajoutant « ~ »
-à la fin du nom initial.
-
-Lorsque la sauvegarde est finie, Emacs affiche le nom du fichier
-écrit. Sauvegardez à intervalles réguliers afin de perdre le moins
-possible de travail au cas où votre système se planterait.
+à la fin du nom initial. Lorsque la sauvegarde est finie, Emacs
+affiche le nom du fichier écrit.
>> Faites C-x C-s pour sauvegarder votre copie du didacticiel.
Cela devrait écrire "Wrote ...TUTORIAL.fr" en bas de l'écran.
Vous pouvez le faire à l'aide de la souris ou avec les commandes du
gestionnaire de fenêtres. Cependant, si vous utilisez un terminal
texte ne pouvant afficher qu'une application à la fois, vous devez
-« suspendre » Emacs pour passer à n'importe quel autre programme.
+« suspendre » Emacs pour passer à n'importe quelle autre application.
C-z est la commande permettant de quitter *temporairement* Emacs --
afin de pouvoir revenir à la même session plus tard. Sur les systèmes
Le moment idéal pour utiliser C-x C-c est lorsque l'on se
déconnecte. C'est aussi la commande adaptée pour sortir d'un Emacs
-invoqué par un programme de courrier ou tout autre utilitaire.
+invoqué pour une modification rapide, par exemple par un programme de
+courrier ou tout autre utilitaire.
Il existe de nombreuses commandes C-x. Voici une liste de celles que
vous avez apprises :
Les eXtensions de commandes nommées sont des commandes utilisées
encore moins souvent, ou des commandes qui ne servent que dans
certains modes. Un exemple est la commande replace-string, qui
-remplace globalement une chaîne par une autre. Lorsque vous faites
+remplace une chaîne par une autre dans un tampon. Lorsque vous faites
M-x, Emacs affiche M-x en bas de l'écran et vous demande de taper le
nom de la commande, « replace-string » ici. Contentez-vous de faire
«repl s<TAB> » et Emacs complétera le nom (<TAB> représente la touche
Puis, faites M-x repl s<Entrée>changée<Entrée>modifiée<Entrée>.
Notez comment cette ligne a été changée : vous avez remplacé le mot
- c-h-a-n-g-é-e par « modifiée » à chaque fois qu'il apparaissait après
+ « changée » par « modifiée » à chaque fois qu'il apparaissait après
la position initiale du curseur.
fenêtres. Toutes les deux affichent ce didacticiel et le curseur
reste dans celle du haut.
->> Faites C-M-v pour faire défiler la fenêtre du bas
+>> Faites C-M-v pour faire défiler le texte de la fenêtre du bas
(Si vous n'avez pas de touche Meta, faites <ESC> C-v).
>> Tapez C-x o (« o » pour « other ») afin de placer le curseur dans
>> Faites C-h a file<Entrée>.
Cela affiche dans une autre fenêtre une liste de toutes les commandes
-M-x ayant « file » dans leurs noms. Vous verrez des commandes
-caractères, comme C-x C-f, apparaître à côté des noms de commandes qui
-leur correspondent, comme find-file.
+M-x ayant « file » dans leurs noms. Vous verrez listée des commandes
+caractères à côté des noms de commandes qui leur correspondent (comme
+C-x C-f à côté de find-file).
>> Faites C-M-v pour faire défiler la fenêtre d'aide. Faites-le
plusieurs fois.
-שיעור ראשון בשימוש ב־Emacs. זכויות שימוש ראה בסוף המסמך.
+שיעור ראשון בשימוש ב־Emacs. זכויות שימוש ראה בסוף המסמך.
פקודות רבות של Emacs משתמשות במקש CONTROL (לפעמים הוא מסומן ב־CTRL או CTL)
או במקש META (לפעמים מסומן EDIT או ALT). במקום לציין את כל השמות האפשריים
den och trycker sedan <chr>.
Viktigt: För att avsluta Emacs trycker du C-x C-c (två tecken).
-För att avsluta kommandon som inte skrivits in fullt, tryck C-g.
+För att avsluta kommandon som inte skrivits in fullt, tryck C-g.
Tecknen ">>" i vänstermarginalen anger att du kan prova ett
kommando. Till exempel:
<<Tomma rader sätts in runt nästa rad när help-with-tutorial aktiveras>>
>> Slå C-x 1 och se hur dokumentationsfönstret nu försvinner.
Kommandot skiljer sig lite från andra kommandon du har lärt dig
-eftersom det består av två tecken. Det startar med tecknet
-KONTROLL-x. Det är faktisk många kommandon som startar med KONTROLL-x
-och många av dem har med filer, skärmbilder och liknande saker att
-göra. Dessa kommandon är två, tre eller fyra tecken långa.
+eftersom det består av två tecken. Det startar med tecknet KONTROLL-x.
+Det finns många kommandon som startar med KONTROLL-x och många av dem
+har med filer, skärmbilder och liknande saker att göra. Dessa
+kommandon är två, tre eller fyra tecken långa.
* SKRIVA OCH TA BORT TEXT
-------------------------
-Om du önskar att sätta in text är det bara att skriva in texten.
-Vanliga tecken, som A, 7, *, etc., sätts in direkt när du skriver dem.
+Om du önskar att sätta in text är det bara att skriva in texten.
+Vanliga tecken, som A, 7, *, etc., sätts in direkt när du skriver dem.
Tryck på <Return> för att sätta in en radbrytning. (Det är den tangent
på tangentbordet som ibland är märkt med "Enter")
-För att radera <DEL> tecknet omedelbart före aktuell markörposition,
-skriv <DEL>. Det är tangenten på tangentbordet som vanligtvis är
-markerad med "Backspace" -- det är samma tangent som du normal
-använder för att radera det sist inmatade tecknet utanför Emacs.
+För att radera tecknet omedelbart före aktuell markörposition, tryck
+på <DEL>. Det är tangenten på tangentbordet som vanligtvis är markerad
+med "Backspace" -- det är samma tangent som du normal använder för att
+radera det sist inmatade tecknet utanför Emacs.
Det kan finnas en annan tangent på ditt tangentbordet som är märkt med
"Delete", men det är inte den vi menar med <DEL>.
>> Flytta markören till den här raden och tryck C-l C-l.
>> Skriv nu C-x 2, som leder till att skärmen delas i två
- fönster. Bägge fönstren visar den här vägledningen.
+ fönster. Bägge fönstren visar den här vägledningen.
Redigeringsmarkören stannar i det övre fönstret.
>> Skriv C-M-v för att rulla det nedre fönstret.
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-05 Eli Zaretskii <eliz@gnu.org>
- * Version 24.2 released.
+ * quail/hebrew.el ("yiddish-royal"): Fix several bogus entries.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-08-17 Daniel Bergey <bergey@alum.mit.edu> (tiny change)
- * Version 24.1 released.
+ * quail/indian.el (quail-define-inscript-package):
+ Set kbd-translate for all Inscript layouts. It's a positional
+ layout: vowels should be on the left hand regardless of the
+ underlying characters produced by those keys. (Bug#12072)
+
+2012-08-06 Mohsen BANAN <libre@mohsen.1.banan.byname.net>
+
+ * quail/persian.el: Add some mappings. (Bug#11812)
+ (farsi-isiri-9147, farsi-transliterate-banan): Doc fixes.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, compile-main, clean, mostlyclean,
+ bootstrap-clean, distclean, maintainer-clean, extraclean.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ deactive->inactive, inactivate->deactivate spelling fixes (Bug#10150)
+ * quail/uni-input.el (ucs-input-deactivate):
+ Rename from ucs-input-inactivate.
+ * quail/hangul.el (hangul-input-method-deactivate):
+ Rename from hangul-input-method-inactivate.
+
+2012-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * quail/ipa.el: Use cl-lib.
+
+ * quail/hangul.el: Don't require CL.
+
+2012-06-12 Nguyen Thai Ngoc Duy <pclouds@gmail.com>
+
+ * quail/vnvi.el: New file (Bug#4747).
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (SUBDIRS): Remove variable and rule.
+ (MKDIR_P): Add it back.
+ (all, changed.tit, changed.misc, leim-list.el):
+ Don't depend on SUBDIRS.
+ (changed.tit, changed.misc): Ensure output directory exists.
+ (distclean): Don't use SUBDIRS.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install): Remove, let top-level do it.
+ (version, prefix, datarootdir, datadir, ns_appresdir, leimdir):
+ (MKDIR_P, GZIP_PROG): Remove, no longer used.
+
+ * Makefile.in (install_prefix): Remove.
+ (LEIM_INSTALLDIR): Rename to leimdir.
+ (install): Update for this change.
+
+ * Makefile.in (leim-list.el, install): Scrap superfluous subshells.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ (install): Use $MKDIR_P.
+
+2012-05-10 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Install self-contained ns files directly to
+ their final destination.
+ (install_prefix): New.
+ (LEIM_INSTALLDIR): New, set by configure.
+ (install): Use LEIM_INSTALLDIR.
+
+ * Makefile.in (MV_DIRS): Remove.
+ (install): Simplify the --with-ns case.
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (EMACS): Rename from BUILT_EMACS.
+ (RUN_EMACS, compile-main): Update for this change.
+
+ * Makefile.in (../src/emacs): Remove this rule, no longer relevant
+ since leim distributed with Emacs (eg lisp/ has no such rule).
+ (all): Remove $BUILT_EMACS dependence.
+
+2012-04-09 Eli Zaretskii <eliz@gnu.org>
+
+ * quail/latin-ltx.el (latin-ltx--define-rules): Comment out
+ debugging messages.
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Compute list of .el files to be compiled dynamically,
+ as the lisp/ directory does, rather than hard-coding it.
+ Also, separate leim-list generation from byte-compilation.
+ (TIT_GB, TIT_BIG5, CHINESE_TIT, MISC, TIT_MISC):
+ Make them store the .el files rather than the .elc files.
+ (NON_TIT_GB, NON_TIT_BIG5, CHINESE_NON_TIT, CHINESE_GB)
+ (CHINESE_GB, CHINESE_BIG5, JAPANESE, KOREAN, THAI, VIETNAMESE)
+ (LAO, INDIAN, TIBETAN, LATIN, UNICODE, SLAVIC, GREEK, RUSSIAN)
+ (OTHERS, CHINESE, EASTASIA, ASIA, EUROPEAN, WORLD, NON_TIT_MISC):
+ Remove variables listing the non-generated .el files.
+ (.el.elc): Add explicit load-path for quail.
+ (all): Depend on compile-main rule rather than $WORLD.
+ (changed.tit, changed.misc): Also depend on $SUBDIRS.
+ (leim-list.el): Don't depend on changed.tit or changed.misc.
+ Remove unnecessary compilation check.
+ (setwins, compile-targets, compile-main): New.
+ (clean, mostlyclean): Update for change in TIT_MISC contents.
+ (bootstrap-clean): Use a glob match to delete .elc, not a fixed list.
+
+2012-04-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * quail/latin-ltx.el: Auto-generate some of the entries.
+ (latin-ltx--ascii-p): New function.
+ (latin-ltx--define-rules): New macro.
+ (define-rules): Use it.
2012-03-25 Eli Zaretskii <eliz@gnu.org>
;; coding: utf-8
;; End:
- Copyright (C) 1997-1999, 2001-2012 Free Software Foundation, Inc.
+ Copyright (C) 1997-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
# Makefile for leim subdirectory in GNU Emacs.
-# Copyright (C) 1997-2012 Free Software Foundation, Inc.
+# Copyright (C) 1997-2012 Free Software Foundation, Inc.
# Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
SHELL = /bin/sh
# Here are the things that we expect ../configure to edit.
-version=@version@
-prefix=@prefix@
-datarootdir=@datarootdir@
-datadir=@datadir@
srcdir=@srcdir@
-ns_appresdir=@ns_appresdir@
-
-# Where to install LEIM files.
-INSTALLDIR=$(DESTDIR)${datadir}/emacs/${version}/leim
-
-GZIP_PROG = @GZIP_PROG@
# Which Emacs to use to convert TIT files to Emacs Lisp files,
# byte-compile Emacs Lisp files, and generate the file leim-list.el.
-BUILT_EMACS = ../src/emacs
+EMACS = ../src/emacs
buildlisppath=${srcdir}/../lisp
# How to run Emacs.
RUN_EMACS = EMACSLOADPATH=$(buildlisppath) LC_ALL=C \
- ${BUILT_EMACS} -batch --no-site-file --no-site-lisp
+ ${EMACS} -batch --no-site-file --no-site-lisp
-# Subdirectories to be made if ${srcdir} is different from the current
-# directory.
-SUBDIRS=quail
+MKDIR_P = @MKDIR_P@
# Files generated from TIT dictionaries for Chinese GB character set.
TIT_GB=\
- quail/CCDOSPY.elc \
- quail/Punct.elc \
- quail/QJ.elc \
- quail/SW.elc \
- quail/TONEPY.elc
+ quail/CCDOSPY.el \
+ quail/Punct.el \
+ quail/QJ.el \
+ quail/SW.el \
+ quail/TONEPY.el
# Files generated from TIT dictionaries for Chinese BIG5 character set.
TIT_BIG5=\
- quail/4Corner.elc \
- quail/ARRAY30.elc \
- quail/ECDICT.elc \
- quail/ETZY.elc \
- quail/Punct-b5.elc \
- quail/PY-b5.elc \
- quail/QJ-b5.elc \
- quail/ZOZY.elc
+ quail/4Corner.el \
+ quail/ARRAY30.el \
+ quail/ECDICT.el \
+ quail/ETZY.el \
+ quail/Punct-b5.el \
+ quail/PY-b5.el \
+ quail/QJ-b5.el \
+ quail/ZOZY.el
CHINESE_TIT=${TIT_GB} ${TIT_BIG5}
-NON_TIT_GB=${srcdir}/quail/py-punct.elc
-
-NON_TIT_BIG5=${srcdir}/quail/pypunct-b5.elc
-
-CHINESE_NON_TIT=${NON_TIT_GB} ${NON_TIT_BIG5}
-
-CHINESE_GB=${TIT_GB} ${NON_TIT_GB}
-
-CHINESE_BIG5=${TIT_BIG5} ${NON_TIT_BIG5}
-
-JAPANESE=${srcdir}/quail/japanese.elc ${srcdir}/ja-dic/ja-dic.elc
-
-KOREAN= ${srcdir}/quail/hangul.elc \
- ${srcdir}/quail/hanja.elc \
- ${srcdir}/quail/hanja3.elc \
- ${srcdir}/quail/hanja-jis.elc \
- ${srcdir}/quail/symbol-ksc.elc
-
-THAI=${srcdir}/quail/thai.elc
-
-VIETNAMESE=${srcdir}/quail/viqr.elc ${srcdir}/quail/vntelex.elc
-
-LAO=${srcdir}/quail/lao.elc ${srcdir}/quail/lrt.elc
-
-INDIAN=${srcdir}/quail/indian.elc
-
-TIBETAN=${srcdir}/quail/tibetan.elc
-
-LATIN= ${srcdir}/quail/latin-pre.elc \
- ${srcdir}/quail/latin-post.elc \
- ${srcdir}/quail/latin-alt.elc \
- ${srcdir}/quail/latin-ltx.elc \
- ${srcdir}/quail/welsh.elc
-
-UNICODE=${srcdir}/quail/sgml-input.elc ${srcdir}/quail/rfc1345.elc \
- ${srcdir}/quail/uni-input.elc
-
-SLAVIC= \
- ${srcdir}/quail/czech.elc \
- ${srcdir}/quail/croatian.elc \
- ${srcdir}/quail/slovak.elc
-
-GREEK=${srcdir}/quail/greek.elc
-
-RUSSIAN=${srcdir}/quail/cyrillic.elc ${srcdir}/quail/cyril-jis.elc
-
-OTHERS= \
- ${srcdir}/quail/arabic.elc \
- ${srcdir}/quail/ethiopic.elc \
- ${srcdir}/quail/ipa.elc \
- ${srcdir}/quail/ipa-praat.elc \
- ${srcdir}/quail/hebrew.elc \
- ${srcdir}/quail/georgian.elc \
- $(srcdir)/quail/persian.elc \
- ${srcdir}/quail/sisheng.elc
-
MISC= \
- quail/tsang-b5.elc \
- quail/quick-b5.elc \
- quail/tsang-cns.elc \
- quail/quick-cns.elc \
- quail/PY.elc \
- quail/ZIRANMA.elc \
- quail/CTLau.elc \
- quail/CTLau-b5.elc
-
-CHINESE=${CHINESE_GB} ${CHINESE_BIG5}
-EASTASIA=${CHINESE} ${JAPANESE} ${KOREAN}
-ASIA=${EASTASIA} ${THAI} ${VIETNAMESE} ${LAO} ${INDIAN} ${TIBETAN}
-EUROPEAN=${LATIN} ${SLAVIC} ${GREEK} ${RUSSIAN}
-WORLD=${ASIA} ${EUROPEAN} ${OTHERS} ${MISC} ${UNICODE}
-
+ quail/tsang-b5.el \
+ quail/quick-b5.el \
+ quail/tsang-cns.el \
+ quail/quick-cns.el \
+ quail/PY.el \
+ quail/ZIRANMA.el \
+ quail/CTLau.el \
+ quail/CTLau-b5.el
+
+## The generated .el files.
TIT_MISC=${CHINESE_TIT} ${MISC}
-NON_TIT_MISC=${CHINESE_NON_TIT} ${JAPANESE} ${KOREAN} ${EUROPEAN} ${OTHERS}
.SUFFIXES: .elc .el
.el.elc:
@echo Compiling $<
- @${RUN_EMACS} -f batch-byte-compile $<
-
-all: ${BUILT_EMACS} ${SUBDIRS} leim-list.el ${WORLD}
-
-# To ensure that we can run Emacs. This target is ignored (never
-# being hit) if a user changes default value of EMACS.
-../src/emacs:
- cd ../src; ${MAKE} ${MFLAGS} emacs
+ @${RUN_EMACS} -l ${buildlisppath}/international/quail -f batch-byte-compile $<
-${SUBDIRS}:
- mkdir $@
- touch stamp-subdir
+all: leim-list.el compile-main
+.PHONY: all
TIT_SOURCES= \
${srcdir}/CXTERM-DIC/4Corner.tit \
${srcdir}/CXTERM-DIC/TONEPY.tit \
${srcdir}/CXTERM-DIC/ZOZY.tit
-${CHINESE_TIT:.elc=.el}: changed.tit
+${CHINESE_TIT}: changed.tit
@true
+## The changed.* files act to serialize this part of the build.
+## A single Emacs invocation creates all the CHINESE_TIT files.
+## Otherwise in a parallel build multiple Emacs instances could
+## interfere with each other. If we used GNU make we could probably
+## parallelize this without the need for an explicit rule for each
+## file. Something like the pattern rule:
+## quail/%.el: CXTERM-DIC/%.tit
+## It doesn't seem possible to do this with VPATH and suffix rules.
changed.tit: ${TIT_SOURCES}
+ @${MKDIR_P} quail
${RUN_EMACS} -l ${buildlisppath}/international/titdic-cnv \
-f batch-titdic-convert -dir quail ${srcdir}/CXTERM-DIC; \
echo "changed" > $@
${srcdir}/MISC-DIC/pinyin.map \
${srcdir}/MISC-DIC/ziranma.cin
-${MISC:.elc=.el}: changed.misc
+${MISC}: changed.misc
@true
changed.misc: ${MISC_SOURCES}
+ @${MKDIR_P} quail
${RUN_EMACS} -l ${buildlisppath}/international/titdic-cnv \
-f batch-miscdic-convert -dir quail ${srcdir}/MISC-DIC; \
echo "changed" > $@
-leim-list.el: ${SUBDIRS} ${TIT_MISC} changed.tit changed.misc ${srcdir}/leim-ext.el
+leim-list.el: ${TIT_MISC} ${srcdir}/leim-ext.el
rm -f leim-list.el
- ${RUN_EMACS} -l ${buildlisppath}/international/quail \
- -f batch-byte-compile-if-not-done ${TIT_MISC:.elc=.el}
- if [ x`(cd ${srcdir} && /bin/pwd)` = x`(/bin/pwd)` ] ; then \
+ if [ x`cd ${srcdir} && /bin/pwd` = x`/bin/pwd` ] ; then \
${RUN_EMACS} -l ${buildlisppath}/international/quail \
--eval "(update-leim-list-file \".\")" ; \
else \
fi
sed -n '/^[^;]/ p' < ${srcdir}/leim-ext.el >> $@
-MV_DIRS = for i in $$dir; do rm -fr `basename "$$i"` ; mv "$$i" . ; done
-
-install: all
- if [ ! -d ${INSTALLDIR} ] ; then \
- umask 022; ${srcdir}/../build-aux/install-sh -d ${INSTALLDIR}; \
- else true; fi
- if [ x`(cd ${INSTALLDIR} && /bin/pwd)` != x`(/bin/pwd)` ] ; then \
- rm -f ${INSTALLDIR}/leim-list.el; \
- rm -rf ${INSTALLDIR}/quail ${INSTALLDIR}/ja-dic ; \
- echo "Copying leim files to ${INSTALLDIR} ..." ; \
- if [ x`(cd ${srcdir} && /bin/pwd)` = x`(/bin/pwd)` ] ; then \
- tar -chf - leim-list.el quail ja-dic \
- | (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\
- else \
- tar -chf - leim-list.el quail \
- | (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\
- cd ${srcdir}; \
- tar -chf - quail/* ja-dic \
- | (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\
- fi; \
- rm -f ${INSTALLDIR}/.gitignore ${INSTALLDIR}/*/.gitignore; \
- rm -f ${INSTALLDIR}/.arch-inventory ${INSTALLDIR}/*/.arch-inventory; \
- rm -f ${INSTALLDIR}/\#* ${INSTALLDIR}/*/\#* ; \
- rm -f ${INSTALLDIR}/.\#* ${INSTALLDIR}/*/.\#* ; \
- rm -f ${INSTALLDIR}/*~ ${INSTALLDIR}/*/*~ ; \
- rm -f ${INSTALLDIR}/*.orig ${INSTALLDIR}/*/*.orig ; \
- else true; fi
- -unset CDPATH; \
- if [ -n "${GZIP_PROG}" ]; \
- then \
- echo "Compressing *.el ..." ; \
- (cd ${INSTALLDIR}; for f in `find . -name "*.elc" -print`; do \
- ${GZIP_PROG} -9n `echo $$f|sed 's/.elc$$/.el/'` ; \
- done) \
- else true; fi
- -chmod -R a+r ${INSTALLDIR}
- for installuser in $${LOGNAME} $${USERNAME} $${USER} \
- `id -un 2> /dev/null`; do \
- [ -n "$${installuser}" ] && break ; \
- done ; \
- find ${INSTALLDIR} -exec chown $${installuser} '{}' ';'
- if [ "${ns_appresdir}" != "" ]; then \
- ( cd ${ns_appresdir} ; \
- if test -d share/emacs ; then dir=share/emacs/*/*; $(MV_DIRS); fi;\
- rm -fr share ) ; \
- else true ; fi
+## Following adapted from lisp/Makefile.in.
+setwins=wins="${srcdir}/ja-dic quail"; \
+ [ `cd ${srcdir} && /bin/pwd` != `/bin/pwd` ] && \
+ wins="$$wins ${srcdir}/quail"
+
+.PHONY: compile-targets
+# TARGETS is set dynamically in the recursive call from `compile-main'.
+compile-targets: $(TARGETS)
+
+# Compile all the Elisp files that need it. Beware: it approximates
+# `no-byte-compile', so watch out for false-positives!
+.PHONY: compile-main
+compile-main: ${TIT_MISC}
+ @($(setwins); \
+ els=`echo "$$wins " | sed -e 's| |/*.el |g'`; \
+ for el in $$els; do \
+ test -f $$el || continue; \
+ test ! -f $${el}c && GREP_OPTIONS= grep '^;.*no-byte-compile: t' $$el > /dev/null && continue; \
+ echo "$${el}c"; \
+ done | xargs echo) | \
+ while read chunk; do \
+ $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \
+ done
+
+.PHONY: clean mostlyclean bootstrap-clean distclean maintainer-clean extraclean
clean mostlyclean:
- rm -f ${TIT_MISC} ${TIT_MISC:.elc=.el} \
+ rm -f ${TIT_MISC} ${TIT_MISC:.el=.elc} \
leim-list.el changed.tit changed.misc
# The following target is needed because the `clean' target only removes
# TIT-generated files and doesn't touch compiled Quail packages. But
# bootstrapping should not leave non-fresh .elc files behind.
bootstrap-clean: clean
- rm -f ${WORLD}
-## FIXME some compiled files go to srcdir, some don't?
-# cd ${srcdir}; rm -f *.elc */*.elc
+ $(setwins); for w in $$wins; do rm -f $$w/*.elc; done
distclean: clean
- if test -f stamp-subdir; then rm -rf ${SUBDIRS} stamp-subdir; fi
+ -[ `cd ${srcdir} && /bin/pwd` != `/bin/pwd` ] && rm -rf quail
rm -f Makefile
maintainer-clean: distclean bootstrap-clean
;; the Free Software Foundation Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
-;; ACKNOWLEDGEMENT
+;; ACKNOWLEDGMENT
;;
;; ¤³¤Î¼½ñ¤Ï¡¢SKK ¸¶ºî¼Ô¤Îº´Æ£²íɧÀèÀ¸¤¬¡¢Âè 1 ÈǺîÀ®¤Î¤¿¤á¤ËÅìËÌÂç³Ø
;; Åŵ¤ÄÌ¿®¸¦µæ½êº´Æ£¸¦µæ¼¼ (Åö»þ) ¤Î³ØÀ¸¤µ¤óã¤È¤È¤â¤Ë scratch ¤«¤éºî
;; the Free Software Foundation Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
-;; ACKNOWLEDGEMENT
+;; ACKNOWLEDGMENT
;;
;; ¤³¤Î¼½ñ¤Ï¡¢SKK ¸¶ºî¼Ô¤Îº´Æ£²íɧÀèÀ¸¤¬¡¢Âè 1 ÈǺîÀ®¤Î¤¿¤á¤ËÅìËÌÂç³Ø
;; Åŵ¤ÄÌ¿®¸¦µæ½êº´Æ£¸¦µæ¼¼ (Åö»þ) ¤Î³ØÀ¸¤µ¤óã¤È¤È¤â¤Ë scratch ¤«¤éºî
-# -*- Makefile -*- for leim subdirectory in GNU Emacs on the Microsoft W32 API.
+# -*- Makefile -*- for leim subdirectory in GNU Emacs on the Microsoft Windows API.
# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;;; Code:
(require 'quail)
-(eval-when-compile (require 'cl)) ; for setf
(require 'hanja-util)
;; Hangul double Jamo table.
"Activate Hangul input method INPUT-METHOD.
FUNC is a function to handle input key.
HELP-TEXT is a text set in `hangul-input-method-help-text'."
- (setq inactivate-current-input-method-function 'hangul-input-method-inactivate
+ (setq deactivate-current-input-method-function 'hangul-input-method-deactivate
describe-current-input-method-function 'hangul-input-method-help
hangul-input-method-help-text help-text)
(quail-delete-overlays)
(add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
(set (make-local-variable 'input-method-function) func))
-(defun hangul-input-method-inactivate ()
- "Inactivate the current Hangul input method."
+(defun hangul-input-method-deactivate ()
+ "Deactivate the current Hangul input method."
(interactive)
(unwind-protect
(progn
(setq describe-current-input-method-function nil))
(kill-local-variable 'input-method-function)))
+(define-obsolete-function-alias
+ 'hangul-input-method-inactivate
+ 'hangul-input-method-deactivate "24.3")
+
(defun hangul-input-method-help ()
"Describe the current Hangul input method."
(interactive)
("@" ?\e,Y%\e(B) ; Double Low-9 Quotation Mark
("(" ?\)) ; mirroring
(")" ?\() ; mirroring
- ("Q" ?\e,A=\e(B) ; Right Double Quotation Mark
- ("W" ?\e,A<\e(B)
- ("E" ?\e,A>\e(B) ; Yiddish Double Yod (x2)
+ ("Q" ?\e,Y4\e(B) ; Left Double Quotation Mark
+ ("W" ?\e,Y!\e(B) ; Right Double Quotation Mark
+ ("E" ?\e$,1-2\e(B) ; Yiddish Double Yod (x2)
("R" [ "\e,H`\e$,1,W\e(B" ]) ; Patah Alef (Pasekh Alef)
; ("T" "")
("Y" ?\e$,1-1\e(B) ; Ligature Yiddish Vav Yod (vov yud)
(defun quail-define-inscript-package (char-tables key-tables pkgname lang
title docstring)
(funcall 'quail-define-package pkgname lang title nil docstring
- nil nil nil nil nil nil nil nil)
+ nil nil nil t nil nil nil nil)
(let (char-table key-table char key)
(while (and char-tables key-tables)
(setq char-table (car char-tables)
;;; Code:
(require 'quail)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(quail-define-package
"ipa" "IPA" "IPA" t
(setq quail-keymap (list (string quail-keymap)))
(if (stringp quail-keymap)
(setq quail-keymap (list quail-keymap))
- (assert (vectorp quail-keymap) t)
+ (cl-assert (vectorp quail-keymap) t)
(setq quail-keymap (append quail-keymap nil))))
(list
(apply 'vector
(mapcar
#'(lambda (entry)
- (assert (char-or-string-p entry) t)
+ (cl-assert (char-or-string-p entry) t)
(format "%s%s" to-prepend
(if (integerp entry) (string entry) entry)))
quail-keymap))))
(dolist (underscoring underscore-map)
(cond ((null underscoring))
((eq (length underscoring) 2)
- (setq underscore-map-entry (second underscoring))
+ (setq underscore-map-entry (cl-second underscoring))
(setcdr underscoring (ipa-x-sampa-prepend-to-keymap-entry
pre-underscore-map underscore-map-entry)))
((eq (length underscoring) 3)
- (setq underscore-map-entry (second (third underscoring)))
- (setcdr (third underscoring)
+ (setq underscore-map-entry (cl-second (cl-third underscoring)))
+ (setcdr (cl-third underscoring)
(ipa-x-sampa-prepend-to-keymap-entry
pre-underscore-map underscore-map-entry)))
(t
- (assert (null t) t
- "Can't handle subtrees of this level right now."))))
- (append underscore-map (list (list ?< (second x-sampa-submap-entry))))))
+ (cl-assert (null t) t
+ "Can't handle subtrees of this level right now."))))
+ (append underscore-map (list (list ?< (cl-second x-sampa-submap-entry))))))
(quail-define-package
"ipa-x-sampa" "IPA" "IPA-X" t
'(("\t" . quail-completion))
t t nil nil nil nil nil nil nil t)
-(quail-define-rules
+(eval-when-compile
+ (defun latin-ltx--ascii-p (char)
+ (and (characterp char) (< char 128)))
+
+ (defmacro latin-ltx--define-rules (&rest rules)
+ (load "uni-name")
+ (let ((newrules ()))
+ (dolist (rule rules)
+ (pcase rule
+ (`(,_ ,(pred characterp)) (push rule newrules)) ;; Normal quail rule.
+ (`(,seq ,re)
+ (let ((count 0))
+ (dolist (pair (ucs-names))
+ (let ((name (car pair))
+ (char (cdr pair)))
+ (when (and (characterp char) ;; Ignore char-ranges.
+ (string-match re name))
+ (let ((keys (if (stringp seq)
+ (replace-match seq nil nil name)
+ (funcall seq name char))))
+ (if (listp keys)
+ (dolist (x keys)
+ (setq count (1+ count))
+ (push (list x char) newrules))
+ (setq count (1+ count))
+ (push (list keys char) newrules))))))
+ ;(message "latin-ltx: %d mapping for %S" count re)
+ ))))
+ `(quail-define-rules ,@(nreverse (delete-dups newrules))))))
+
+(latin-ltx--define-rules
("!`" ?¡)
("\\pounds" ?£) ;; ("{\\pounds}" ?£)
("\\S" ?§) ;; ("{\\S}" ?§)
- ("\\\"{}" ?¨)
- ("\\copyright" ?©) ;; ("{\\copyright}" ?©)
("$^a$" ?ª)
- ("\\={}" ?¯)
("$\\pm$" ?±) ("\\pm" ?±)
("$^2$" ?²)
("$^3$" ?³)
- ("\\'{}" ?´)
("\\P" ?¶) ;; ("{\\P}" ?¶)
;; Fixme: Yudit has the equivalent of ("\\cdot" ?⋅), for U+22C5, DOT
;; OPERATOR, whereas · is MIDDLE DOT. JadeTeX translates both to
;; \cdot.
("$\\cdot$" ?·) ("\\cdot" ?·)
- ("\\c{}" ?¸)
("$^1$" ?¹)
("$^o$" ?º)
("?`" ?¿)
- ("\\`{A}" ?À) ("\\`A" ?À)
- ("\\'{A}" ?Á) ("\\'A" ?Á)
- ("\\^{A}" ?Â) ("\\^A" ?Â)
- ("\\~{A}" ?Ã) ("\\~A" ?Ã)
- ("\\\"{A}" ?Ä) ("\\\"A" ?Ä)
- ("\\\k{A}" ?Ą)
+ ("\\`" ?̀)
+ ("\\`{}" ?`)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\`{%s}" c) (format "\\`%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH GRAVE")
+
+ ("\\'" ?́)
+ ("\\'{}" ?´)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\'{%s}" c) (format "\\'%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH ACUTE")
+
+ ("\\^" ?̂)
+ ("\\^{}" ?^)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\^{%s}" c) (format "\\^%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH CIRCUMFLEX")
+
+ ("\\~" ?̃)
+ ("\\~{}" ?˜)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\~{%s}" c) (format "\\~%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH TILDE")
+
+ ("\\\"" ?̈)
+ ("\\\"{}" ?¨)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\\"{%s}" c) (format "\\\"%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH DIAERESIS")
+
+ ("\\k" ?̨)
+ ("\\k{}" ?˛)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\k{%s}" c) ;; (format "\\k%s" c)
+ )))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH OGONEK")
+
+ ("\\c" ?̧)
+ ("\\c{}" ?¸)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\c{%s}" c) (format "\\c%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH CEDILLA")
+
("\\AA" ?Å) ;; ("{\\AA}" ?Å)
("\\AE" ?Æ) ;; ("{\\AE}" ?Æ)
- ("\\c{C}" ?Ç) ("\\cC" ?Ç)
- ("\\`{E}" ?È) ("\\`E" ?È)
- ("\\'{E}" ?É) ("\\'E" ?É)
- ("\\^{E}" ?Ê) ("\\^E" ?Ê)
- ("\\\"{E}" ?Ë) ("\\\"E" ?Ë)
- ("\\\k{E}" ?Ę)
- ("\\`{I}" ?Ì) ("\\`I" ?Ì)
- ("\\'{I}" ?Í) ("\\'I" ?Í)
- ("\\^{I}" ?Î) ("\\^I" ?Î)
- ("\\\"{I}" ?Ï) ("\\\"I" ?Ï)
- ("\\\k{I}" ?Į)
- ("\\~{N}" ?Ñ) ("\\~N" ?Ñ)
- ("\\`{O}" ?Ò) ("\\`O" ?Ò)
- ("\\'{O}" ?Ó) ("\\'O" ?Ó)
- ("\\^{O}" ?Ô) ("\\^O" ?Ô)
- ("\\~{O}" ?Õ) ("\\~O" ?Õ)
- ("\\\"{O}" ?Ö) ("\\\"O" ?Ö)
- ("\\\k{O}" ?Ǫ)
("$\\times$" ?×) ("\\times" ?×)
("\\O" ?Ø) ;; ("{\\O}" ?Ø)
- ("\\`{U}" ?Ù) ("\\`U" ?Ù)
- ("\\'{U}" ?Ú) ("\\'U" ?Ú)
- ("\\^{U}" ?Û) ("\\^U" ?Û)
- ("\\\"{U}" ?Ü) ("\\\"U" ?Ü)
- ("\\\k{U}" ?Ų)
- ("\\'{Y}" ?Ý) ("\\'Y" ?Ý)
("\\ss" ?ß) ;; ("{\\ss}" ?ß)
- ("\\`{a}" ?à) ("\\`a" ?à)
- ("\\'{a}" ?á) ("\\'a" ?á)
- ("\\^{a}" ?â) ("\\^a" ?â)
- ("\\~{a}" ?ã) ("\\~a" ?ã)
- ("\\\"{a}" ?ä) ("\\\"a" ?ä)
- ("\\\k{a}" ?ą)
("\\aa" ?å) ;; ("{\\aa}" ?å)
("\\ae" ?æ) ;; ("{\\ae}" ?æ)
- ("\\c{c}" ?ç) ("\\cc" ?ç)
- ("\\`{e}" ?è) ("\\`e" ?è)
- ("\\'{e}" ?é) ("\\'e" ?é)
- ("\\^{e}" ?ê) ("\\^e" ?ê)
- ("\\\"{e}" ?ë) ("\\\"e" ?ë)
- ("\\\k{e}" ?ę)
- ("\\`{\\i}" ?ì) ("\\`i" ?ì)
- ("\\'{\\i}" ?í) ("\\'i" ?í)
- ("\\^{\\i}" ?î) ("\\^i" ?î)
- ("\\\"{\\i}" ?ï) ("\\\"i" ?ï)
- ("\\\k{i}" ?į)
- ("\\~{n}" ?ñ) ("\\~n" ?ñ)
- ("\\`{o}" ?ò) ("\\`o" ?ò)
- ("\\'{o}" ?ó) ("\\'o" ?ó)
- ("\\^{o}" ?ô) ("\\^o" ?ô)
- ("\\~{o}" ?õ) ("\\~o" ?õ)
- ("\\\"{o}" ?ö) ("\\\"o" ?ö)
- ("\\\k{o}" ?ǫ)
("$\\div$" ?÷) ("\\div" ?÷)
("\\o" ?ø) ;; ("{\\o}" ?ø)
- ("\\`{u}" ?ù) ("\\`u" ?ù)
- ("\\'{u}" ?ú) ("\\'u" ?ú)
- ("\\^{u}" ?û) ("\\^u" ?û)
- ("\\\"{u}" ?ü) ("\\\"u" ?ü)
- ("\\\k{u}" ?ų)
- ("\\'{y}" ?ý) ("\\'y" ?ý)
- ("\\\"{y}" ?ÿ) ("\\\"y" ?ÿ)
- ("\\={A}" ?Ā) ("\\=A" ?Ā)
- ("\\={a}" ?ā) ("\\=a" ?ā)
- ("\\u{A}" ?Ă) ("\\uA" ?Ă)
- ("\\u{a}" ?ă) ("\\ua" ?ă)
- ("\\'{C}" ?Ć) ("\\'C" ?Ć)
- ("\\'{c}" ?ć) ("\\'c" ?ć)
- ("\\^{C}" ?Ĉ) ("\\^C" ?Ĉ)
- ("\\^{c}" ?ĉ) ("\\^c" ?ĉ)
- ("\\.{C}" ?Ċ) ("\\.C" ?Ċ)
- ("\\.{c}" ?ċ) ("\\.c" ?ċ)
- ("\\v{C}" ?Č) ("\\vC" ?Č)
- ("\\v{c}" ?č) ("\\vc" ?č)
- ("\\v{D}" ?Ď) ("\\vD" ?Ď)
- ("\\v{d}" ?ď) ("\\vd" ?ď)
+ ("\\=" ?̄)
+ ("\\={}" ?¯)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\={%s}" c) (format "\\=%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH MACRON")
- ("\\={E}" ?Ē) ("\\=E" ?Ē)
- ("\\={e}" ?ē) ("\\=e" ?ē)
- ("\\u{E}" ?Ĕ) ("\\uE" ?Ĕ)
- ("\\u{e}" ?ĕ) ("\\ue" ?ĕ)
- ("\\.{E}" ?Ė) ("\\.E" ?Ė)
- ("\\e{e}" ?ė) ("\\ee" ?ė)
- ("\\v{E}" ?Ě) ("\\vE" ?Ě)
- ("\\v{e}" ?ě) ("\\ve" ?ě)
- ("\\^{G}" ?Ĝ) ("\\^G" ?Ĝ)
- ("\\^{g}" ?ĝ) ("\\^g" ?ĝ)
- ("\\u{G}" ?Ğ) ("\\uG" ?Ğ)
- ("\\u{g}" ?ğ) ("\\ug" ?ğ)
+ ("\\u" ?̆)
+ ("\\u{}" ?˘)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\u{%s}" c) (format "\\u%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH BREVE")
- ("\\.{G}" ?Ġ) ("\\.G" ?Ġ)
- ("\\.{g}" ?ġ) ("\\.g" ?ġ)
- ("\\c{G}" ?Ģ) ("\\cG" ?Ģ)
- ("\\c{g}" ?ģ) ("\\cg" ?ģ)
- ("\\^{H}" ?Ĥ) ("\\^H" ?Ĥ)
- ("\\^{h}" ?ĥ) ("\\^h" ?ĥ)
- ("\\~{I}" ?Ĩ) ("\\~I" ?Ĩ)
- ("\\~{\\i}" ?ĩ) ("\\~i" ?ĩ)
- ("\\={I}" ?Ī) ("\\=I" ?Ī)
- ("\\={\\i}" ?ī) ("\\=i" ?ī)
- ("\\u{I}" ?Ĭ) ("\\uI" ?Ĭ)
- ("\\u{\\i}" ?ĭ) ("\\ui" ?ĭ)
+ ("\\." ?̇)
+ ("\\.{}" ?˙)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\.{%s}" c) (format "\\.%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH DOT ABOVE")
+
+ ("\\v" ?̌)
+ ("\\v{}" ?ˇ)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\v{%s}" c) (format "\\v%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH CARON")
+
+ ("\\~{\\i}" ?ĩ)
+ ("\\={\\i}" ?ī)
+ ("\\u{\\i}" ?ĭ)
- ("\\.{I}" ?İ) ("\\.I" ?İ)
("\\i" ?ı) ;; ("{\\i}" ?ı)
- ("\\^{J}" ?Ĵ) ("\\^J" ?Ĵ)
- ("\\^{\\j}" ?ĵ) ("\\^j" ?ĵ)
- ("\\c{K}" ?Ķ) ("\\cK" ?Ķ)
- ("\\c{k}" ?ķ) ("\\ck" ?ķ)
- ("\\'{L}" ?Ĺ) ("\\'L" ?Ĺ)
- ("\\'{l}" ?ĺ) ("\\'l" ?ĺ)
- ("\\c{L}" ?Ļ) ("\\cL" ?Ļ)
- ("\\c{l}" ?ļ) ("\\cl" ?ļ)
+ ("\\^{\\j}" ?ĵ)
("\\L" ?Ł) ;; ("{\\L}" ?Ł)
("\\l" ?ł) ;; ("{\\l}" ?ł)
- ("\\'{N}" ?Ń) ("\\'N" ?Ń)
- ("\\'{n}" ?ń) ("\\'n" ?ń)
- ("\\c{N}" ?Ņ) ("\\cN" ?Ņ)
- ("\\c{n}" ?ņ) ("\\cn" ?ņ)
- ("\\v{N}" ?Ň) ("\\vN" ?Ň)
- ("\\v{n}" ?ň) ("\\vn" ?ň)
- ("\\={O}" ?Ō) ("\\=O" ?Ō)
- ("\\={o}" ?ō) ("\\=o" ?ō)
- ("\\u{O}" ?Ŏ) ("\\uO" ?Ŏ)
- ("\\u{o}" ?ŏ) ("\\uo" ?ŏ)
- ("\\H{O}" ?Ő) ("\\HO" ?Ő)
- ("\\U{o}" ?ő) ("\\Uo" ?ő)
+ ("\\H" ?̋)
+ ("\\H{}" ?˝)
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\H{%s}" c) (format "\\H%s" c))))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH DOUBLE ACUTE")
+ ("\\U{o}" ?ő) ("\\Uo" ?ő) ;; FIXME: Was it just a typo?
+
("\\OE" ?Œ) ;; ("{\\OE}" ?Œ)
("\\oe" ?œ) ;; ("{\\oe}" ?œ)
- ("\\'{R}" ?Ŕ) ("\\'R" ?Ŕ)
- ("\\'{r}" ?ŕ) ("\\'r" ?ŕ)
- ("\\c{R}" ?Ŗ) ("\\cR" ?Ŗ)
- ("\\c{r}" ?ŗ) ("\\cr" ?ŗ)
- ("\\v{R}" ?Ř) ("\\vR" ?Ř)
- ("\\v{r}" ?ř) ("\\vr" ?ř)
- ("\\'{S}" ?Ś) ("\\'S" ?Ś)
- ("\\'{s}" ?ś) ("\\'s" ?ś)
- ("\\^{S}" ?Ŝ) ("\\^S" ?Ŝ)
- ("\\^{s}" ?ŝ) ("\\^s" ?ŝ)
- ("\\c{S}" ?Ş) ("\\cS" ?Ş)
- ("\\c{s}" ?ş) ("\\cs" ?ş)
-
- ("\\v{S}" ?Š) ("\\vS" ?Š)
- ("\\v{s}" ?š) ("\\vs" ?š)
- ("\\c{T}" ?Ţ) ("\\cT" ?Ţ)
- ("\\c{t}" ?ţ) ("\\ct" ?ţ)
- ("\\v{T}" ?Ť) ("\\vT" ?Ť)
- ("\\v{t}" ?ť) ("\\vt" ?ť)
- ("\\~{U}" ?Ũ) ("\\~U" ?Ũ)
- ("\\~{u}" ?ũ) ("\\~u" ?ũ)
- ("\\={U}" ?Ū) ("\\=U" ?Ū)
- ("\\={u}" ?ū) ("\\=u" ?ū)
- ("\\u{U}" ?Ŭ) ("\\uU" ?Ŭ)
- ("\\u{u}" ?ŭ) ("\\uu" ?ŭ)
- ("\\H{U}" ?Ű) ("\\HU" ?Ű)
- ("\\H{u}" ?ű) ("\\Hu" ?ű)
- ("\\^{W}" ?Ŵ) ("\\^W" ?Ŵ)
- ("\\^{w}" ?ŵ) ("\\^w" ?ŵ)
- ("\\^{Y}" ?Ŷ) ("\\^Y" ?Ŷ)
- ("\\^{y}" ?ŷ) ("\\^y" ?ŷ)
- ("\\\"{Y}" ?Ÿ) ("\\\"Y" ?Ÿ)
- ("\\'{Z}" ?Ź) ("\\'Z" ?Ź)
- ("\\'{z}" ?ź) ("\\'z" ?ź)
- ("\\.{Z}" ?Ż) ("\\.Z" ?Ż)
- ("\\.{z}" ?ż) ("\\.z" ?ż)
- ("\\v{Z}" ?Ž) ("\\vZ" ?Ž)
- ("\\v{z}" ?ž) ("\\vz" ?ž)
-
- ("\\v{A}" ?Ǎ) ("\\vA" ?Ǎ)
- ("\\v{a}" ?ǎ) ("\\va" ?ǎ)
- ("\\v{I}" ?Ǐ) ("\\vI" ?Ǐ)
- ("\\v{\\i}" ?ǐ) ("\\vi" ?ǐ)
- ("\\v{O}" ?Ǒ) ("\\vO" ?Ǒ)
- ("\\v{o}" ?ǒ) ("\\vo" ?ǒ)
- ("\\v{U}" ?Ǔ) ("\\vU" ?Ǔ)
- ("\\v{u}" ?ǔ) ("\\vu" ?ǔ)
+ ("\\v{\\i}" ?ǐ)
("\\={\\AE}" ?Ǣ) ("\\=\\AE" ?Ǣ)
("\\={\\ae}" ?ǣ) ("\\=\\ae" ?ǣ)
- ("\\v{G}" ?Ǧ) ("\\vG" ?Ǧ)
- ("\\v{g}" ?ǧ) ("\\vg" ?ǧ)
- ("\\v{K}" ?Ǩ) ("\\vK" ?Ǩ)
- ("\\v{k}" ?ǩ) ("\\vk" ?ǩ)
- ("\\v{\\j}" ?ǰ) ("\\vj" ?ǰ)
- ("\\'{G}" ?Ǵ) ("\\'G" ?Ǵ)
- ("\\'{g}" ?ǵ) ("\\'g" ?ǵ)
- ("\\`{N}" ?Ǹ) ("\\`N" ?Ǹ)
- ("\\`{n}" ?ǹ) ("\\`n" ?ǹ)
+ ("\\v{\\j}" ?ǰ)
("\\'{\\AE}" ?Ǽ) ("\\'\\AE" ?Ǽ)
("\\'{\\ae}" ?ǽ) ("\\'\\ae" ?ǽ)
("\\'{\\O}" ?Ǿ) ("\\'\\O" ?Ǿ)
("\\'{\\o}" ?ǿ) ("\\'\\o" ?ǿ)
- ("\\v{H}" ?Ȟ) ("\\vH" ?Ȟ)
- ("\\v{h}" ?ȟ) ("\\vh" ?ȟ)
- ("\\.{A}" ?Ȧ) ("\\.A" ?Ȧ)
- ("\\.{a}" ?ȧ) ("\\.a" ?ȧ)
- ("\\c{E}" ?Ȩ) ("\\cE" ?Ȩ)
- ("\\c{e}" ?ȩ) ("\\ce" ?ȩ)
- ("\\.{O}" ?Ȯ) ("\\.O" ?Ȯ)
- ("\\.{o}" ?ȯ) ("\\.o" ?ȯ)
- ("\\={Y}" ?Ȳ) ("\\=Y" ?Ȳ)
- ("\\={y}" ?ȳ) ("\\=y" ?ȳ)
-
- ("\\v{}" ?ˇ)
- ("\\u{}" ?˘)
- ("\\.{}" ?˙)
- ("\\~{}" ?˜)
- ("\\H{}" ?˝)
-
- ("\\'" ?́)
- ("\\'K" ?Ḱ)
- ("\\'M" ?Ḿ)
- ("\\'P" ?Ṕ)
- ("\\'W" ?Ẃ)
- ("\\'k" ?ḱ)
- ("\\'m" ?ḿ)
- ("\\'p" ?ṕ)
- ("\\'w" ?ẃ)
("\\," ? )
- ("\\." ?̇)
- ("\\.B" ?Ḃ)
- ("\\.D" ?Ḋ)
- ("\\.F" ?Ḟ)
- ("\\.H" ?Ḣ)
- ("\\.M" ?Ṁ)
- ("\\.N" ?Ṅ)
- ("\\.P" ?Ṗ)
- ("\\.R" ?Ṙ)
- ("\\.S" ?Ṡ)
- ("\\.T" ?Ṫ)
- ("\\.W" ?Ẇ)
- ("\\.X" ?Ẋ)
- ("\\.Y" ?Ẏ)
- ("\\.b" ?ḃ)
- ("\\.d" ?ḋ)
- ("\\.e" ?ė)
- ("\\.f" ?ḟ)
- ("\\.h" ?ḣ)
- ("\\.m" ?ṁ)
- ("\\.n" ?ṅ)
- ("\\.p" ?ṗ)
- ("\\.r" ?ṙ)
- ("\\.s" ?ṡ)
- ("\\.t" ?ṫ)
- ("\\.w" ?ẇ)
- ("\\.x" ?ẋ)
- ("\\.y" ?ẏ)
("\\/" ?)
("\\:" ? )
("\\;" ? )
- ("\\=" ?̄)
- ("\\=G" ?Ḡ)
- ("\\=g" ?ḡ)
- ("^(" ?⁽)
- ("^)" ?⁾)
- ("^+" ?⁺)
- ("^-" ?⁻)
- ("^0" ?⁰)
- ("^1" ?¹)
- ("^2" ?²)
- ("^3" ?³)
- ("^4" ?⁴)
- ("^5" ?⁵)
- ("^6" ?⁶)
- ("^7" ?⁷)
- ("^8" ?⁸)
- ("^9" ?⁹)
- ("^=" ?⁼)
+ ((lambda (name char)
+ (let* ((base (concat (match-string 1 name) (match-string 3 name)))
+ (basechar (cdr (assoc base (ucs-names)))))
+ (when (latin-ltx--ascii-p basechar)
+ (string (if (match-end 2) ?^ ?_) basechar))))
+ "\\(.*\\)SU\\(?:B\\|\\(PER\\)\\)SCRIPT \\(.*\\)")
+
("^\\gamma" ?ˠ)
- ;; FIXME: It'd be nicer to generate some of these rules via something like
- ;; (map (lambda (name char)
- ;; (cond ((string-match "MODIFIER SMALL LETTER \\(.\\)" name)
- ;; (list (string ?^ (downcase (aref name (match-beginning 1))))
- ;; char)))
- ;; ...)))
- ("^a" ?ᵃ)
- ("^b" ?ᵇ)
- ("^c" ?ᶜ)
- ("^d" ?ᵈ)
- ("^e" ?ᵉ)
- ("^f" ?ᶠ)
- ("^g" ?ᵍ)
- ("^h" ?ʰ)
- ;; ("^i" ?) ;; FIXME: can't find MODIFIER SMALL LETTER I !?!
- ("^j" ?ʲ)
- ("^k" ?ᵏ)
- ("^l" ?ˡ)
- ("^m" ?ᵐ)
- ("^n" ?ⁿ)
- ("^o" ?ᵒ)
+
+ ((lambda (name char)
+ (let* ((base (format "LATIN %s LETTER %s"
+ (match-string 1 name) (match-string 2 name)))
+ (basechar (cdr (assoc base (ucs-names)))))
+ (when (latin-ltx--ascii-p basechar)
+ (string ?^ basechar))))
+ "MODIFIER LETTER \\(SMALL\\|CAPITAL\\) \\(.*\\)")
+
+ ;; ((lambda (name char) (format "^%s" (downcase (match-string 1 name))))
+ ;; "\\`MODIFIER LETTER SMALL \\(.\\)\\'")
+ ;; ("^\\1" "\\`MODIFIER LETTER CAPITAL \\(.\\)\\'")
("^o_" ?º)
- ("^p" ?ᵖ)
- ;; ("^q" ?) ;; FIXME: can't find MODIFIER SMALL LETTER Q !?!
- ("^r" ?ʳ)
- ("^s" ?ˢ)
- ("^t" ?ᵗ)
- ("^u" ?ᵘ)
- ("^v" ?ᵛ)
- ("^w" ?ʷ)
- ("^x" ?ˣ)
- ("^y" ?ʸ)
- ("^z" ?ᶻ)
- ("^A" ?ᴬ)
- ("^B" ?ᴮ)
- ;; ("^C" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER C !?!
- ("^D" ?ᴰ)
- ("^E" ?ᴱ)
- ;; ("^F" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER F !?!
- ("^G" ?ᴳ)
- ("^H" ?ᴴ)
- ("^I" ?ᴵ)
- ("^J" ?ᴶ)
- ("^K" ?ᴷ)
- ("^L" ?ᴸ)
- ("^M" ?ᴹ)
- ("^N" ?ᴺ)
- ("^O" ?ᴼ)
- ("^P" ?ᴾ)
- ;; ("^Q" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER Q !?!
- ("^R" ?ᴿ)
- ;; ("^S" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER S !?!
- ("^T" ?ᵀ)
- ("^U" ?ᵁ)
- ("^V" ?ⱽ)
- ("^W" ?ᵂ)
- ;; ("^X" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER X !?!
- ;; ("^Y" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER Y !?!
- ;; ("^Z" ?) ;; FIXME: can't find MODIFIER CAPITAL LETTER Z !?!
("^{SM}" ?℠)
("^{TEL}" ?℡)
("^{TM}" ?™)
- ("_(" ?₍)
- ("_)" ?₎)
- ("_+" ?₊)
- ("_-" ?₋)
- ("_0" ?₀)
- ("_1" ?₁)
- ("_2" ?₂)
- ("_3" ?₃)
- ("_4" ?₄)
- ("_5" ?₅)
- ("_6" ?₆)
- ("_7" ?₇)
- ("_8" ?₈)
- ("_9" ?₉)
- ("_=" ?₌)
- ("\\~" ?̃)
- ("\\~E" ?Ẽ)
- ("\\~V" ?Ṽ)
- ("\\~Y" ?Ỹ)
- ("\\~e" ?ẽ)
- ("\\~v" ?ṽ)
- ("\\~y" ?ỹ)
-
- ("\\\"" ?̈)
- ("\\\"H" ?Ḧ)
- ("\\\"W" ?Ẅ)
- ("\\\"X" ?Ẍ)
- ("\\\"h" ?ḧ)
- ("\\\"t" ?ẗ)
- ("\\\"w" ?ẅ)
- ("\\\"x" ?ẍ)
- ("\\^" ?̂)
- ("\\^Z" ?Ẑ)
- ("\\^z" ?ẑ)
- ("\\`" ?̀)
- ("\\`W" ?Ẁ)
- ("\\`Y" ?Ỳ)
- ("\\`w" ?ẁ)
- ("\\`y" ?ỳ)
("\\b" ?̱)
- ("\\c" ?̧)
- ("\\c{D}" ?Ḑ)
- ("\\c{H}" ?Ḩ)
- ("\\c{d}" ?ḑ)
- ("\\c{h}" ?ḩ)
+
("\\d" ?̣)
- ("\\d{A}" ?Ạ)
- ("\\d{B}" ?Ḅ)
- ("\\d{D}" ?Ḍ)
- ("\\d{E}" ?Ẹ)
- ("\\d{H}" ?Ḥ)
- ("\\d{I}" ?Ị)
- ("\\d{K}" ?Ḳ)
- ("\\d{L}" ?Ḷ)
- ("\\d{M}" ?Ṃ)
- ("\\d{N}" ?Ṇ)
- ("\\d{O}" ?Ọ)
- ("\\d{R}" ?Ṛ)
- ("\\d{S}" ?Ṣ)
- ("\\d{T}" ?Ṭ)
- ("\\d{U}" ?Ụ)
- ("\\d{V}" ?Ṿ)
- ("\\d{W}" ?Ẉ)
- ("\\d{Y}" ?Ỵ)
- ("\\d{Z}" ?Ẓ)
- ("\\d{a}" ?ạ)
- ("\\d{b}" ?ḅ)
- ("\\d{d}" ?ḍ)
- ("\\d{e}" ?ẹ)
- ("\\d{h}" ?ḥ)
- ("\\d{i}" ?ị)
- ("\\d{k}" ?ḳ)
- ("\\d{l}" ?ḷ)
- ("\\d{m}" ?ṃ)
- ("\\d{n}" ?ṇ)
- ("\\d{o}" ?ọ)
- ("\\d{r}" ?ṛ)
- ("\\d{s}" ?ṣ)
- ("\\d{t}" ?ṭ)
- ("\\d{u}" ?ụ)
- ("\\d{v}" ?ṿ)
- ("\\d{w}" ?ẉ)
- ("\\d{y}" ?ỵ)
- ("\\d{z}" ?ẓ)
+ ;; ("\\d{}" ?) ;; FIXME: can't find the DOT BELOW character.
+ ((lambda (name char)
+ (let ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name))))
+ (list (format "\\d{%s}" c) ;; (format "\\d%s" c)
+ )))
+ "\\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH DOT BELOW")
+
("\\rq" ?’)
- ("\\u" ?̆)
- ("\\v" ?̌)
- ("\\v{L}" ?Ľ)
- ("\\v{i}" ?ǐ)
- ("\\v{j}" ?ǰ)
- ("\\v{l}" ?ľ)
- ("\\yen" ?¥)
+
+ ;; FIXME: Provides some useful entries (yen, euro, copyright, registered,
+ ;; currency, minus, micro), but also a lot of dubious ones.
+ ((lambda (name char)
+ (unless (latin-ltx--ascii-p char)
+ (concat "\\" (downcase (match-string 1 name)))))
+ "\\`\\([^- ]+\\) SIGN\\'")
+
+ ((lambda (name char)
+ (concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase)
+ (match-string 2 name))))
+ "\\`GREEK \\(?:SMALL\\|CAPITA\\(L\\)\\) LETTER \\([^- ]+\\)\\'")
("\\Box" ?□)
("\\Bumpeq" ?≎)
("\\Cap" ?⋒)
("\\Cup" ?⋓)
- ("\\Delta" ?Δ)
("\\Diamond" ?◇)
("\\Downarrow" ?⇓)
- ("\\Gamma" ?Γ)
- ("\\H" ?̋)
("\\H{o}" ?ő)
("\\Im" ?ℑ)
("\\Join" ?⋈)
- ("\\Lambda" ?Λ)
("\\Leftarrow" ?⇐)
("\\Leftrightarrow" ?⇔)
("\\Ll" ?⋘)
("\\Longleftrightarrow" ?⇔)
("\\Longrightarrow" ?⇒)
("\\Lsh" ?↰)
- ("\\Omega" ?Ω)
- ("\\Phi" ?Φ)
- ("\\Pi" ?Π)
- ("\\Psi" ?Ψ)
("\\Re" ?ℜ)
("\\Rightarrow" ?⇒)
("\\Rrightarrow" ?⇛)
("\\Rsh" ?↱)
- ("\\Sigma" ?Σ)
("\\Subset" ?⋐)
("\\Supset" ?⋑)
- ("\\Theta" ?Θ)
("\\Uparrow" ?⇑)
("\\Updownarrow" ?⇕)
- ("\\Upsilon" ?Υ)
("\\Vdash" ?⊩)
("\\Vert" ?‖)
("\\Vvdash" ?⊪)
- ("\\Xi" ?Ξ)
("\\aleph" ?ℵ)
- ("\\alpha" ?α)
("\\amalg" ?∐)
("\\angle" ?∠)
("\\approx" ?≈)
("\\backslash" ?\\)
("\\barwedge" ?⊼)
("\\because" ?∵)
- ("\\beta" ?β)
("\\beth" ?ℶ)
("\\between" ?≬)
("\\bigcap" ?⋂)
("\\circledcirc" ?⊚)
("\\circleddash" ?⊝)
("\\clubsuit" ?♣)
- ("\\colon" ?:)
+ ("\\colon" ?:) ;FIXME: Conflict with "COLON SIGN" ₡.
("\\coloneq" ?≔)
("\\complement" ?∁)
("\\cong" ?≅)
("\\ddag" ?‡)
("\\ddagger" ?‡)
("\\ddots" ?⋱)
- ("\\delta" ?δ)
("\\diamond" ?⋄)
("\\diamondsuit" ?♢)
("\\digamma" ?Ϝ)
("\\downrightharpoon" ?⇂)
("\\ell" ?ℓ)
("\\emptyset" ?∅)
- ("\\epsilon" ?ε)
("\\eqcirc" ?≖)
("\\eqcolon" ?≕)
("\\eqslantgtr" ?⋝)
("\\eqslantless" ?⋜)
("\\equiv" ?≡)
- ("\\eta" ?η)
- ("\\euro" ?€)
("\\exists" ?∃)
("\\fallingdotseq" ?≒)
("\\flat" ?♭)
("\\frac58" ?⅝)
("\\frac78" ?⅞)
("\\frown" ?⌢)
- ("\\gamma" ?γ)
("\\ge" ?≥)
("\\geq" ?≥)
("\\geqq" ?≧)
("\\infty" ?∞)
("\\int" ?∫)
("\\intercal" ?⊺)
- ("\\iota" ?ι)
- ("\\kappa" ?κ)
- ("\\lambda" ?λ)
("\\langle" ?〈)
("\\lbrace" ?{)
("\\lbrack" ?\[)
("\\nleqslant" ?≰)
("\\nless" ?≮)
("\\nmid" ?∤)
- ("\\not" ?̸)
+ ("\\not" ?̸) ;FIXME: conflict with "NOT SIGN" ¬.
("\\notin" ?∉)
("\\nparallel" ?∦)
("\\nprec" ?⊀)
("\\ntrianglelefteq" ?⋬)
("\\ntriangleright" ?⋫)
("\\ntrianglerighteq" ?⋭)
- ("\\nu" ?ν)
("\\nvDash" ?⊭)
("\\nvdash" ?⊬)
("\\nwarrow" ?↖)
("\\odot" ?⊙)
("\\oint" ?∮)
- ("\\omega" ?ω)
("\\ominus" ?⊖)
("\\oplus" ?⊕)
("\\oslash" ?⊘)
("\\parallel" ?∥)
("\\partial" ?∂)
("\\perp" ?⊥)
- ("\\phi" ?φ)
- ("\\pi" ?π)
("\\pitchfork" ?⋔)
("\\prec" ?≺)
("\\precapprox" ?≾)
("\\prime" ?′)
("\\prod" ?∏)
("\\propto" ?∝)
- ("\\psi" ?ψ)
("\\qed" ?∎)
("\\quad" ? )
("\\rangle" ?〉)
("\\sharp" ?♯)
("\\shortmid" ?∣)
("\\shortparallel" ?∥)
- ("\\sigma" ?σ)
("\\sim" ?∼)
("\\simeq" ?≃)
("\\smallamalg" ?∐)
("\\supsetneqq" ?⊋)
("\\surd" ?√)
("\\swarrow" ?↙)
- ("\\tau" ?τ)
("\\therefore" ?∴)
- ("\\theta" ?θ)
("\\thickapprox" ?≈)
("\\thicksim" ?∼)
("\\to" ?→)
("\\upleftharpoon" ?↿)
("\\uplus" ?⊎)
("\\uprightharpoon" ?↾)
- ("\\upsilon" ?υ)
("\\upuparrows" ?⇈)
("\\urcorner" ?⌝)
("\\u{i}" ?ĭ)
("\\vDash" ?⊨)
- ("\\varkappa" ?ϰ)
- ("\\varphi" ?ϕ)
- ("\\varpi" ?ϖ)
+
+ ((lambda (name char)
+ (concat "\\var" (downcase (match-string 1 name))))
+ "\\`GREEK \\([^- ]+\\) SYMBOL\\'")
+
("\\varprime" ?′)
("\\varpropto" ?∝)
- ("\\varrho" ?ϱ)
- ("\\varsigma" ?ς)
- ("\\vartheta" ?ϑ)
+ ("\\varsigma" ?ς) ;FIXME: Looks reversed with the non\var.
("\\vartriangleleft" ?⊲)
("\\vartriangleright" ?⊳)
("\\vdash" ?⊢)
("\\wedge" ?∧)
("\\wp" ?℘)
("\\wr" ?≀)
- ("\\xi" ?ξ)
- ("\\zeta" ?ζ)
("\\Bbb{N}" ?ℕ) ; AMS commands for blackboard bold
("\\Bbb{P}" ?ℙ) ; Also sometimes \mathbb.
;; a bug where the user finds his ~ key doesn't insert a ~ any more.
("\\ " ? )
("\\\\" ?\\)
- ("\\mu" ?μ)
- ("\\rho" ?ρ)
("\\mathscr{I}" ?ℐ) ; moment of inertia
("\\Smiley" ?☺)
("\\blacksmiley" ?☻)
;; ("\\Writinghand" ?✍)
;; ("\\Yinyang" ?☯)
;; ("\\Heart" ?♡)
- ("\\registered" ?®)
- ("\\currency" ?¤)
("\\dh" ?ð)
("\\DH" ?Ð)
("\\th" ?þ)
("\\TH" ?Þ)
- ("\\micro" ?µ)
("\\lnot" ?¬)
("\\ordfeminine" ?ª)
("\\ordmasculine" ?º)
;; by analogy with lq, rq:
("\\ldq" ?\“)
("\\rdq" ?\”)
- ("\\minus" ?−)
("\\defs" ?≙) ; per fuzz/zed
;; ("\\sqrt[3]" ?∛)
("\\llbracket" ?\〚) ; stmaryrd
;;; 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 <libre@mohsen.1.banan.byname.net>
-;; http://mohsen.1.banan.byname.net/contact
+;; Author: Mohsen BANAN <libre@mohsen.1.banan.byname.net>
+;; X-URL: http://mohsen.1.banan.byname.net/contact
;; Keywords: multilingual, input method, Farsi, Persian, keyboard
;;
;; 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:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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
(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
;;
;; 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:
;;
;;
;; 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 & الف
("cc" ?ث)
("j" ?ج)
("ch" ?چ)
- ("h" ?ح)
+ ("H" ?ح)
+ ("hh" ?ح)
("kh" ?خ)
("d" ?د)
("Z" ?ذ)
("X" ?ظ)
("w" ?ع)
("q" ?غ)
+ ("G" ?غ)
+ ("Gh" ?غ)
+ ("GG" ?غ)
("f" ?ف)
("Q" ?ق)
("gh" ?ق)
("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
("+" ?\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: علامتِ بزرگتر
;;;;;;;;;;; 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
;; 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: جداکنندهی سطرها
("&lro;" ?\u202D) ;; (ucs-insert #x202D) named: زیرمتنِ اکیداً چپبهراست
("&rlo;" ?\u202D) ;; (ucs-insert #x202E) named: زیرمتنِ اکیداً راستبهچپ
("&bom;" ?\uFEFF) ;; (ucs-insert #xFEFF) named: نشانهی ترتیبِ بایتها
-
+
;;;;;;;;;;; isiri-6219 Table 7 -- جدول ۷ - نشانههایِ فارسی
("^" ?َ) ;; zbar ;; زبر فارسى
("@" ?ْ) ;; ساکن فارسى
("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
("\\~" ?~)
("\\@" ?@)
("\\#" ?#)
- ("\\$" ?\uFDFC) ;; (ucs-insert #xFDFC)﷼ named:
+ ("\\$" ?\uFDFC) ;; (ucs-insert #xFDFC)﷼ named:
("\\^" ?^)
("\\1" ?1)
("\\2" ?2)
(quail-delete-overlays)
(setq describe-current-input-method-function nil))
(kill-local-variable 'input-method-function))
- (setq inactivate-current-input-method-function 'ucs-input-inactivate)
+ (setq deactivate-current-input-method-function 'ucs-input-deactivate)
(setq describe-current-input-method-function 'ucs-input-help)
(quail-delete-overlays)
(if (eq (selected-window) (minibuffer-window))
(set (make-local-variable 'input-method-function)
'ucs-input-method)))
-(defun ucs-input-inactivate ()
- "Inactivate UCS input method."
+(defun ucs-input-deactivate ()
+ "Deactivate UCS input method."
(interactive)
(ucs-input-activate -1))
+(define-obsolete-function-alias
+ 'ucs-input-inactivate
+ 'ucs-input-deactivate "24.3")
+
(defun ucs-input-help ()
(interactive)
(with-output-to-temp-buffer "*Help*"
--- /dev/null
+;;; vnvni.el --- Quail package for Vietnamese by VNI method
+
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
+
+;; Author: Werner Lemberg <wl@gnu.org>
+;; Nguyen Thai Ngoc Duy <pclouds@gmail.com>
+;; Keywords: multilingual, input method, Vietnamese
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; There are two commonly-used input methods for Vietnamese: Telex
+;; (implemented in vntelex.el) and VNI (implemented in this file,
+;; which was based on vntelex.el).
+
+;;; Code:
+
+(require 'quail)
+
+
+(quail-define-package
+ "vietnamese-vni" ; NAME
+ "Vietnamese" ; LANGUAGE
+ "VV" ; TITLE
+ t ; GUIDANCE
+ "Vietnamese VNI input method
+
+Diacritics:
+
+ effect postfix examples
+ ------------------------------
+ circumflex 6 a6 -> \e,Ab\e(B
+ breve 8 a8 -> \e,1e\e(B
+ horn 7 o7 -> \e,1=\e(B
+
+ acute 1 a1 -> \e,1a\e(B
+ grave 2 a2 -> \e,1`\e(B
+ hook above 3 a3 -> \e,1d\e(B
+ tilde 4 a4 -> \e,1c\e(B
+ dot below 5 a5 -> \e,1U\e(B
+
+ d bar 9 d9 -> \e,1p\e(B
+
+Combinations:
+
+ A82 -> \e,2"\e(B, o74 -> \e,1^\e(B, etc.
+
+Doubling the postfix (but not in combinations) separates the letter
+and postfix: E66 -> E6, a55 -> a5, etc.
+" ; DOCSTRING
+ nil ; TRANSLATION-KEYS
+ t ; FORGET-LAST-SELECTION
+ nil ; DETERMINISTIC
+ nil ; KBD-TRANSLATE
+ nil ; SHOW-LAYOUT
+ nil ; CREATE-DECODE-MAP
+ nil ; MAXIMUM-SHORTEST
+ nil ; OVERLAY-PLIST
+ nil ; UPDATE-TRANSLATION-FUNCTION
+ nil ; CONVERSION-KEYS
+ t) ; SIMPLE
+
+(quail-define-rules
+ ("a2" ?\e,1`\e(B) ; LATIN SMALL LETTER A WITH GRAVE
+ ("A2" ?\e,2`\e(B) ; LATIN CAPITAL LETTER A WITH GRAVE
+ ("a1" ?\e,1a\e(B) ; LATIN SMALL LETTER A WITH ACUTE
+ ("A1" ?\e,2a\e(B) ; LATIN CAPITAL LETTER A WITH ACUTE
+ ("a6" ?\e,1b\e(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
+ ("A6" ?\e,2b\e(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+ ("a4" ?\e,1c\e(B) ; LATIN SMALL LETTER A WITH TILDE
+ ("A4" ?\e,2c\e(B) ; LATIN CAPITAL LETTER A WITH TILDE
+ ("e2" ?\e,1h\e(B) ; LATIN SMALL LETTER E WITH GRAVE
+ ("E2" ?\e,2h\e(B) ; LATIN CAPITAL LETTER E WITH GRAVE
+ ("e1" ?\e,1i\e(B) ; LATIN SMALL LETTER E WITH ACUTE
+ ("E1" ?\e,2i\e(B) ; LATIN CAPITAL LETTER E WITH ACUTE
+ ("e6" ?\e,1j\e(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
+ ("E6" ?\e,2j\e(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+ ("i2" ?\e,1l\e(B) ; LATIN SMALL LETTER I WITH GRAVE
+ ("I2" ?\e,2l\e(B) ; LATIN CAPITAL LETTER I WITH GRAVE
+ ("i1" ?\e,1m\e(B) ; LATIN SMALL LETTER I WITH ACUTE
+ ("I1" ?\e,2m\e(B) ; LATIN CAPITAL LETTER I WITH ACUTE
+ ("o2" ?\e,1r\e(B) ; LATIN SMALL LETTER O WITH GRAVE
+ ("O2" ?\e,2r\e(B) ; LATIN CAPITAL LETTER O WITH GRAVE
+ ("o1" ?\e,1s\e(B) ; LATIN SMALL LETTER O WITH ACUTE
+ ("O1" ?\e,2s\e(B) ; LATIN CAPITAL LETTER O WITH ACUTE
+ ("o6" ?\e,1t\e(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
+ ("O6" ?\e,2t\e(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+ ("o4" ?\e,1u\e(B) ; LATIN SMALL LETTER O WITH TILDE
+ ("O4" ?\e,2u\e(B) ; LATIN CAPITAL LETTER O WITH TILDE
+ ("u2" ?\e,1y\e(B) ; LATIN SMALL LETTER U WITH GRAVE
+ ("U2" ?\e,2y\e(B) ; LATIN CAPITAL LETTER U WITH GRAVE
+ ("u1" ?\e,1z\e(B) ; LATIN SMALL LETTER U WITH ACUTE
+ ("U1" ?\e,2z\e(B) ; LATIN CAPITAL LETTER U WITH ACUTE
+ ("y1" ?\e,1}\e(B) ; LATIN SMALL LETTER Y WITH ACUTE
+ ("Y1" ?\e,2}\e(B) ; LATIN CAPITAL LETTER Y WITH ACUTE
+ ("a8" ?\e,1e\e(B) ; LATIN SMALL LETTER A WITH BREVE
+ ("A8" ?\e,2e\e(B) ; LATIN CAPITAL LETTER A WITH BREVE
+ ("i4" ?\e,1n\e(B) ; LATIN SMALL LETTER I WITH TILDE
+ ("I4" ?\e,2n\e(B) ; LATIN CAPITAL LETTER I WITH TILDE
+ ("u4" ?\e,1{\e(B) ; LATIN SMALL LETTER U WITH TILDE
+ ("U4" ?\e,2{\e(B) ; LATIN CAPITAL LETTER U WITH TILDE
+ ("o7" ?\e,1=\e(B) ; LATIN SMALL LETTER O WITH HORN
+ ("O7" ?\e,2=\e(B) ; LATIN CAPITAL LETTER O WITH HORN
+ ("u7" ?\e,1_\e(B) ; LATIN SMALL LETTER U WITH HORN
+ ("U7" ?\e,2_\e(B) ; LATIN CAPITAL LETTER U WITH HORN
+ ("a5" ?\e,1U\e(B) ; LATIN SMALL LETTER A WITH DOT BELOW
+ ("A5" ?\e,2U\e(B) ; LATIN CAPITAL LETTER A WITH DOT BELOW
+ ("a3" ?\e,1d\e(B) ; LATIN SMALL LETTER A WITH HOOK ABOVE
+ ("A3" ?\e,2d\e(B) ; LATIN CAPITAL LETTER A WITH HOOK ABOVE
+ ("a61" ?\e,1$\e(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
+ ("A61" ?\e,2$\e(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
+ ("a62" ?\e,1%\e(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
+ ("A62" ?\e,2%\e(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
+ ("a63" ?\e,1&\e(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
+ ("A63" ?\e,2&\e(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
+ ("a64" ?\e,1g\e(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
+ ("A64" ?\e,2g\e(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
+ ("a65" ?\e,1'\e(B) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+ ("A65" ?\e,2'\e(B) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+ ("a81" ?\e,1!\e(B) ; LATIN SMALL LETTER A WITH BREVE AND ACUTE
+ ("A81" ?\e,2!\e(B) ; LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
+ ("a82" ?\e,1"\e(B) ; LATIN SMALL LETTER A WITH BREVE AND GRAVE
+ ("A82" ?\e,2"\e(B) ; LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
+ ("a83" ?\e,1F\e(B) ; LATIN SMALL LETTER A WITH BREVE AND HO6K ABOVE
+ ("A83" ?\e,2F\e(B) ; LATIN CAPITAL LETTER A WITH BREVE AND HO6K ABOVE
+ ("a84" ?\e,1G\e(B) ; LATIN SMALL LETTER A WITH BREVE AND TILDE
+ ("A84" ?\e,2G\e(B) ; LATIN CAPITAL LETTER A WITH BREVE AND TILDE
+ ("a85" ?\e,1#\e(B) ; LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
+ ("A85" ?\e,2#\e(B) ; LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
+ ("e5" ?\e,1)\e(B) ; LATIN SMALL LETTER E WITH DOT BELOW
+ ("E5" ?\e,2)\e(B) ; LATIN CAPITAL LETTER E WITH DOT BELOW
+ ("e3" ?\e,1k\e(B) ; LATIN SMALL LETTER E WITH HO6K ABOVE
+ ("E3" ?\e,2k\e(B) ; LATIN CAPITAL LETTER E WITH HO6K ABOVE
+ ("e4" ?\e,1(\e(B) ; LATIN SMALL LETTER E WITH TILDE
+ ("E4" ?\e,2(\e(B) ; LATIN CAPITAL LETTER E WITH TILDE
+ ("e61" ?\e,1*\e(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
+ ("E61" ?\e,2*\e(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
+ ("e62" ?\e,1+\e(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
+ ("E62" ?\e,2+\e(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
+ ("e63" ?\e,1,\e(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
+ ("E63" ?\e,2,\e(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
+ ("e64" ?\e,1-\e(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
+ ("E64" ?\e,2-\e(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
+ ("e65" ?\e,1.\e(B) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+ ("E65" ?\e,2.\e(B) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+ ("i3" ?\e,1o\e(B) ; LATIN SMALL LETTER I WITH HO6K ABOVE
+ ("I3" ?\e,2o\e(B) ; LATIN CAPITAL LETTER I WITH HO6K ABOVE
+ ("i5" ?\e,18\e(B) ; LATIN SMALL LETTER I WITH DOT BELOW
+ ("I5" ?\e,28\e(B) ; LATIN CAPITAL LETTER I WITH DOT BELOW
+ ("o5" ?\e,1w\e(B) ; LATIN SMALL LETTER O WITH DOT BELOW
+ ("O5" ?\e,2w\e(B) ; LATIN CAPITAL LETTER O WITH DOT BELOW
+ ("o3" ?\e,1v\e(B) ; LATIN SMALL LETTER O WITH HO6K ABOVE
+ ("O3" ?\e,2v\e(B) ; LATIN CAPITAL LETTER O WITH HO6K ABOVE
+ ("o61" ?\e,1/\e(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
+ ("O61" ?\e,2/\e(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
+ ("o62" ?\e,10\e(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
+ ("O62" ?\e,20\e(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
+ ("o63" ?\e,11\e(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
+ ("O63" ?\e,21\e(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
+ ("o64" ?\e,12\e(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
+ ("O64" ?\e,22\e(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
+ ("o65" ?\e,15\e(B) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELO7
+ ("O65" ?\e,25\e(B) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELO7
+ ("o71" ?\e,1>\e(B) ; LATIN SMALL LETTER O WITH HORN AND ACUTE
+ ("O71" ?\e,2>\e(B) ; LATIN CAPITAL LETTER O WITH HORN AND ACUTE
+ ("o72" ?\e,16\e(B) ; LATIN SMALL LETTER O WITH HORN AND GRAVE
+ ("O72" ?\e,26\e(B) ; LATIN CAPITAL LETTER O WITH HORN AND GRAVE
+ ("o73" ?\e,17\e(B) ; LATIN SMALL LETTER O WITH HORN AND HO6K ABOVE
+ ("O73" ?\e,27\e(B) ; LATIN CAPITAL LETTER O WITH HORN AND HO6K ABOVE
+ ("o74" ?\e,1^\e(B) ; LATIN SMALL LETTER O WITH HORN AND TILDE
+ ("O74" ?\e,2^\e(B) ; LATIN CAPITAL LETTER O WITH HORN AND TILDE
+ ("o75" ?\e,1~\e(B) ; LATIN SMALL LETTER O WITH HORN AND DOT BELO7
+ ("O75" ?\e,2~\e(B) ; LATIN CAPITAL LETTER O WITH HORN AND DOT BELO7
+ ("u5" ?\e,1x\e(B) ; LATIN SMALL LETTER U WITH DOT BELO7
+ ("U5" ?\e,2x\e(B) ; LATIN CAPITAL LETTER U WITH DOT BELO7
+ ("u3" ?\e,1|\e(B) ; LATIN SMALL LETTER U WITH HO6K ABOVE
+ ("U3" ?\e,2|\e(B) ; LATIN CAPITAL LETTER U WITH HO6K ABOVE
+ ("u71" ?\e,1Q\e(B) ; LATIN SMALL LETTER U WITH HORN AND ACUTE
+ ("U71" ?\e,2Q\e(B) ; LATIN CAPITAL LETTER U WITH HORN AND ACUTE
+ ("u72" ?\e,1W\e(B) ; LATIN SMALL LETTER U WITH HORN AND GRAVE
+ ("U72" ?\e,2W\e(B) ; LATIN CAPITAL LETTER U WITH HORN AND GRAVE
+ ("u73" ?\e,1X\e(B) ; LATIN SMALL LETTER U WITH HORN AND HO6K ABOVE
+ ("U73" ?\e,2X\e(B) ; LATIN CAPITAL LETTER U WITH HORN AND HO6K ABOVE
+ ("u74" ?\e,1f\e(B) ; LATIN SMALL LETTER U WITH HORN AND TILDE
+ ("U74" ?\e,2f\e(B) ; LATIN CAPITAL LETTER U WITH HORN AND TILDE
+ ("u75" ?\e,1q\e(B) ; LATIN SMALL LETTER U WITH HORN AND DOT BELO7
+ ("U75" ?\e,2q\e(B) ; LATIN CAPITAL LETTER U WITH HORN AND DOT BELO7
+ ("y2" ?\e,1O\e(B) ; LATIN SMALL LETTER Y WITH GRAVE
+ ("Y2" ?\e,2O\e(B) ; LATIN CAPITAL LETTER Y WITH GRAVE
+ ("y5" ?\e,1\\e(B) ; LATIN SMALL LETTER Y WITH DOT BELO7
+ ("Y5" ?\e,2\\e(B) ; LATIN CAPITAL LETTER Y WITH DOT BELO7
+ ("y3" ?\e,1V\e(B) ; LATIN SMALL LETTER Y WITH HO6K ABOVE
+ ("Y3" ?\e,2V\e(B) ; LATIN CAPITAL LETTER Y WITH HO6K ABOVE
+ ("y4" ?\e,1[\e(B) ; LATIN SMALL LETTER Y WITH TILDE
+ ("Y4" ?\e,2[\e(B) ; LATIN CAPITAL LETTER Y WITH TILDE
+ ("d9" ?\e,1p\e(B) ; LATIN SMALL LETTER D WITH STROKE
+ ("D9" ?\e,2p\e(B) ; LATIN CAPITAL LETTER D WITH STROKE
+;("$$" ?\e$,1tK\e(B) ; U+20AB DONG SIGN (#### check)
+
+ ("a22" ["a22"])
+ ("A22" ["A2"])
+ ("a11" ["a1"])
+ ("A11" ["A1"])
+ ("a66"' ["a6"])
+ ("A66"' ["A6"])
+ ("a44" ["a4"])
+ ("A44" ["A4"])
+ ("e22" ["e2"])
+ ("E22" ["E2"])
+ ("e11" ["e1"])
+ ("E11" ["E1"])
+ ("e66" ["e6"])
+ ("E66" ["E6"])
+ ("i22" ["i2"])
+ ("I22" ["I2"])
+ ("i11" ["i1"])
+ ("I11" ["I1"])
+ ("o22" ["o2"])
+ ("O22" ["O2"])
+ ("o11" ["o1"])
+ ("O11" ["O1"])
+ ("o66" ["o6"])
+ ("O66" ["O6"])
+ ("o44" ["o4"])
+ ("O44" ["O4"])
+ ("u22" ["u2"])
+ ("U22" ["U2"])
+ ("u11" ["u1"])
+ ("U11" ["U1"])
+ ("y11" ["y1"])
+ ("Y11" ["Y1"])
+ ("a88" ["a8"])
+ ("A88" ["A8"])
+ ("i44" ["i4"])
+ ("I44" ["I4"])
+ ("u44" ["u4"])
+ ("U44" ["u4"])
+ ("o77" ["o7"])
+ ("O77" ["O7"])
+ ("u77" ["u7"])
+ ("U77" ["U7"])
+ ("a55" ["a5"])
+ ("A55" ["A5"])
+ ("a33" ["a3"])
+ ("A33" ["A3"])
+ ("e55" ["e5"])
+ ("E55" ["E5"])
+ ("e33" ["e3"])
+ ("E33" ["E3"])
+ ("e44" ["e4"])
+ ("E44" ["E4"])
+ ("i33" ["i3"])
+ ("I33" ["I3"])
+ ("i55" ["i5"])
+ ("I55" ["I5"])
+ ("o55" ["o5"])
+ ("O55" ["O5"])
+ ("o33" ["o3"])
+ ("O33" ["O3"])
+ ("u55" ["u5"])
+ ("U55" ["U5"])
+ ("u33" ["u3"])
+ ("U33" ["U3"])
+ ("y22" ["y2"])
+ ("Y22" ["Y2"])
+ ("y55" ["y5"])
+ ("Y55" ["Y5"])
+ ("y33" ["y3"])
+ ("Y33" ["Y3"])
+ ("y44" ["y4"])
+ ("Y44" ["Y4"])
+ ("d9" ["d9"])
+ ("D99" ["D9"])
+;("$$$" ["$$"])
+
+ ;; escape from composition
+ ("\\1" ?1)
+ ("\\2" ?2)
+ ("\\3" ?3)
+ ("\\4" ?4)
+ ("\\5" ?5)
+ ("\\6" ?6)
+ ("\\7" ?7)
+ ("\\8" ?8)
+ ("\\9" ?9)
+ ("\\\\" ?\\)) ; literal backslash
+
+
+;; Local Variables:
+;; coding: iso-2022-7bit
+;; End:
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
- * Version 24.2 released.
+ * makefile.w32-in (obj): Add profiler.o.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-09-17 Glenn Morris <rgm@gnu.org>
- * Version 24.1 released.
+ * ebrowse.c (version):
+ * etags.c (print_version): Use COPYRIGHT.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * pop.c (socket_connection) [HAVE_GETADDRINFO]:
+ Prefer assignment to memcpy when either will do.
+
+2012-08-31 Andreas Schwab <schwab@linux-m68k.org>
+
+ * etags.c (consider_token): Always zero-terminate token buffer.
+ (Bug#12306)
+
+2012-08-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rely on <config.h> + <unistd.h> to declare 'environ'.
+ * emacsclient.c (environ): Remove decl.
+
+2012-08-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/regex.$(O)): Update dependencies.
+
+2012-08-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * etags.c (Pascal_functions): Fix parenthesization typo.
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * 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 <rgm@gnu.org>
+
+ * 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 <lekktu@gmail.com>
+
+ * makefile.w32-in (LOCAL_FLAGS): Remove WINDOWSNT and DOS_NT,
+ they are always defined in config.h.
+
+2012-08-03 Eli Zaretskii <eliz@gnu.org>
+
+ * ntlib.c (lstat): New function, calls 'stat'.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use C99-style 'extern inline' if available.
+ * profile.c (SYSTIME_INLINE): Define.
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in (MS_W32_H): Update for new ms-w32.h location.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (config_h): New variable.
+ Use throughout in place of ../src/config.h.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (CONFIG_H): Update dependencies.
+ (CONF_POST_H): New macro.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, need-blessmail, maybe-blessmail,
+ install, uninstall, mostlyclean, clean, distclean,
+ maintainer-clean, extraclean, check, tags.
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(BLD)/profile.$(O)): Depend on stamp_BLD.
+
+2012-07-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * movemail.c: Add missing 'defined'.
+ Suggested by Sven Joachim in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00218.html>.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port 'movemail' again to Solaris and similar hosts.
+ See Susan Cragin's report in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00199.html>.
+ * movemail.c (xmalloc): Also define if !DISABLE_DIRECT_ACCESS &&
+ !MAIL_USE_MMDF && !MAIL_USE_SYSTEM_LOCK. Move up, so it doesn't
+ need a forward declaration.
+ (main): Rewrite to avoid no-longer-present function 'concat', if
+ !DISABLE_DIRECT_ACCESS && !MAIL_USE_MMDF && !MAIL_USE_SYSTEM_LOCK.
+
+ Assume strerror.
+ * emacsclient.c, movemail.c, update-game-score.c (strerror)
+ [!HAVE_STRERROR]: Remove.
+
+2012-07-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ EMACS_TIME simplification (Bug#11875).
+ * profile.c (TV2): Remove no-longer-needed static var.
+
+ Simplify by avoiding confusing use of strncpy etc.
+ * etags.c (write_classname, C_entries):
+ Use sprintf rather than strncpy or strncat.
+ * etags.c (consider_token, C_entries, HTML_labels, Prolog_functions)
+ (Erlang_functions, substitute, readline_internal, savenstr):
+ * movemail.c (mail_spool_name):
+ Use memcpy rather than strncpy or strncat when either will do.
+ * make-docfile.c (write_c_args):
+ Use memcmp rather than strncmp when either will do.
+ * movemail.c (pop_retr):
+ * pop.c (pop_stat, pop_list, pop_multi_first, pop_last)
+ (socket_connection, pop_getline, sendline, getok):
+ Use snprintf rather than strncpy or strncat.
+ * movemail.c (concat): Remove; no longer needed.
+ (xmalloc): Define only if needed, now that concat has gone away.
+ Return void *. All uses changed.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Add GCC-style 'const' attribute to functions that can use it.
+ * etags.c (number_len): Add ATTRIBUTE_CONST.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacsclient.c (w32_execvp): Declare execvp to silence the compiler.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/test-distrib.exe): Use LIB_SRC, not SRC.
+ (LIB_SRC, NT_INC, GNU_LIB, MS_W32_H, CONFIG_H, INTTYPES_H, NTLIB_H)
+ (SYSTIME_H): New macros.
+ (SRC): Redefine to point to src/, not current directory.
+ ($(BLD)/ctags.$(O), $(BLD)/ebrowse.$(O), $(BLD)/emacsclient.$(O))
+ ($(BLD)/etags.$(O), $(BLD)/hexl.$(O), $(BLD)/make-docfile.$(O))
+ ($(BLD)/movemail.$(O), $(BLD)/ntlib.$(O), $(BLD)/pop.$(O))
+ ($(BLD)/profile.$(O), $(BLD)/test-distrib.$(O)): Update dependencies.
+ ($(BLD)/regex.$(O)): New dependency.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (ALL): Add profile.exe.
+ (PROFILEOBJS): New macro.
+ ($(BLD)/profile.exe): New target.
+ (install): Copy profile.exe.
+ ($(BLD)/alloca.$(O), $(BLD)/tcp.$(O)): Remove, obsolete.
+
+2012-07-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/ctags.$(O), $(BLD)/etags.$(O)):
+ Update dependencies.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ * etags.c: Include c-strcase.h.
+ (etags_strcasecmp, etags_strncasecmp): Remove.
+ All uses replaced with c_strcasecmp and c_strncasecmp.
+
+2012-07-06 Andreas Schwab <schwab@linux-m68k.org>
+
+ * make-docfile.c (write_globals): Warn about duplicate function
+ definitions with differing signatures.
+
+2012-07-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * make-docfile.c (scan_c_file): Suppress GCC warning.
+
+2012-06-29 Tom Tromey <tromey@redhat.com>
+
+ * make-docfile.c (enum global_type) <FUNCTION>: New constant.
+ (struct global) <value>: New field.
+ (add_global): Add 'value' argument.
+ (compare_globals): Sort functions at the end.
+ (close_emacs_globals): New function.
+ (write_globals): Handle functions.
+ (scan_c_file): Call add_global for DEFUN.
+
+2012-06-30 Juanma Barranquero <lekktu@gmail.com>
-2012-05-29 Eli Zaretskii <eliz@gnu.org>
+ * makefile.w32-in (CTAGS_CFLAGS): Remove EMACS_NAME;
+ already defined in ETAGS_CFLAGS.
+
+2012-06-27 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in (lisp2): Remove paths.el.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * Makefile.in (BASE_CFLAGS):
+ * makefile.w32-in (LOCAL_FLAGS): Remove -DHAVE_CONFIG_H.
+ * etags.c, hexl.c, pop.c: Include <config.h> unconditionally.
+ * etags.c (DOS_NT):
+ * pop.c (MAIL_USE_POP, h_errno):
+ Remove code that was conditioned on !HAVE_CONFIG_H.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * etags.c (etags_strcasecmp, etags_strncasecmp): Define to
+ library functions strcasecmp and strncasecmp if available.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ * ebrowse.c (usage, version):
+ * emacsclient.c (print_help_and_exit, fail):
+ * etags.c (suggest_asking_for_help, fatal, pfatal):
+ * hexl.c (usage):
+ * make-docfile.c (fatal):
+ * movemail.c (fatal, pfatal_with_name, pfatal_and_delete):
+ * update-game-score.c (usage):
+ * ebrowse.c (usage, version):
+ * emacsclient.c (print_help_and_exit, fail):
+ Use _Noreturn rather than NO_RETURN.
+ No need for separate decl merely because of _Noreturn.
+
+2012-06-24 Samuel Bronson <naesten@gmail.com> (tiny change)
+
+ * emacsclient.c (set_local_socket): Fix compiler warning (Bug#7838).
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ * Makefile.in (LIB_CLOCK_GETTIME): New macro.
+ (profile${EXEEXT}): Use it.
+ * profile.c: Include inttypes.h, intprops.h.
+ (time_string): Size conservatively; do not guess size.
+ (get_time): Now prints nanoseconds.
+ (gettimeofday): Remove replacement function; gnulib now does this.
+
+2012-06-08 Andreas Schwab <schwab@linux-m68k.org>
+
+ * make-docfile.c (search_lisp_doc_at_eol): Unget last read
+ character.
+
+2012-06-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (STAMP_INST_SCRIPTS, STAMP_SCRIPTS, insrcdir)
+ (stamp-rcs2log, stamp-grep-changelog): Remove.
+ (all, clean): Remove references to stamps.
+
+ * vcdiff: Remove file.
+ * Makefile.in (SCRIPTS, STAMP_SCRIPTS): Remove vcdiff.
+ (stamp-vcdiff): Remove.
+
+2012-06-05 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in ($(BLD)/getdate.$(O), $(BLD)/leditcfns.$(O)):
+ ($(BLD)/make-path.$(O), $(BLD)/qsort.$(O)):
+ ($(BLD)/timer.$(O)): Remove cruft.
+
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * rcs-checkin: Remove file.
+ * Makefile.in (INSTALLABLE_SCRIPTS, STAMP_INST_SCRIPTS):
+ Remove rcs-checkin.
+ (stamp-rcs-checkin): Remove.
+
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
* makefile.w32-in ($(BLD)/emacsclientw.exe): Use $(MWINDOWS)
instead of a literal -mwindows, which is not supported by MSVC.
(Bug#11405)
+2012-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * make-docfile.c: Improve comment style.
+ (search_lisp_doc_at_eol): New function.
+ (scan_lisp_file): Use it.
+
+2012-05-26 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (INSTALL_DATA): Remove; unused.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * makefile.w32-in: Remove dependencies on
+ $(EMACS_ROOT)/src/m/intel386.h.
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install): Remove unneeded chmods.
+
+2012-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later.
+ * etags.c (static, const): Remove macros.
+ (PTR): Remove; all uses replaced with void *. Omit needless casts.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (insrcdir, $(DESTDIR)${archlibdir}):
+ Scrap superfluous subshells.
+
+2012-05-18 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install): Ensure $bindir exists.
+
+2012-05-17 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (ns_appbindir): New, set by configure.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ ($(DESTDIR)${archlibdir}): Use $MKDIR_P.
+
+2012-05-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ etags: pacify gcc -Wstack-protector on Ubuntu 12.04 x86
+ * etags.c: Include <stdarg.h>.
+ (error): Declare as printf-style, as that's what it really is.
+ All uses changed.
+ (add_regex): Use single char rather than array-of-one char.
+
+2012-05-05 Jim Meyering <meyering@redhat.com>
+
+ * lib-src/pop.c (pop_stat, pop_list, pop_multi_first, pop_last):
+ NUL-terminate the error buffer (Bug#11372).
+
2012-05-02 Juanma Barranquero <lekktu@gmail.com>
* emacsclient.c (min): Undef before redefining it.
* emacsclient.c (send_to_emacs): Avoid invalid strcpy upon partial
send (Bug#11374).
- * lib-src/pop.c (pop_stat, pop_list, pop_multi_first, pop_last):
- NUL-terminate the error buffer (Bug#11372).
+2012-04-29 Andreas Schwab <schwab@linux-m68k.org>
-2012-04-15 Chong Yidong <cyd@gnu.org>
+ * make-docfile.c (scan_lisp_file) [DEBUG]: Also skip if and
+ byte-code forms. (Bug#11380)
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
* emacsclient.c (decode_options): Move -t -n corner case handling
into server.el (Bug#11102).
+ (main): Send -tty to Emacs under more circumstances (Bug#8314).
+
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
-2012-04-12 Juanma Barranquero <lekktu@gmail.com>
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * Makefile.in (C_WARNINGS_SWITCH): Remove.
+ (WARN_CFLAGS, WERROR_CFLAGS): New macros.
+ (BASE_CFLAGS): Use new macros rather than old.
+
+2012-04-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume less-ancient POSIX support.
+ * update-game-score.c: Include <getopt.h> rather than rolling our
+ own decls for optarg, optind, opterr. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html>.
+
+2012-04-14 Juanma Barranquero <lekktu@gmail.com>
* emacsclient.c (decode_options) [WINDOWSNT]:
Call ttyname instead of passing its address (typo in 2011-12-04T17:13:01Z!lekktu@gmail.com).
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (obj): Add xml.o.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (ALL): Now the list of executables, not of phony
+ targets.
+ (.PHONY): Only make-docfile is its prerequisite now.
+ (make-docfile): Don't depend on stamp_BLD. Add a comment about
+ the need in this target.
+ (ctags, etags, ebrowse, hexl, movemail, emacsclient)
+ (test-distrib): Phony targets removed.
+ ($(BLD)/test-distrib.exe): Run test-distrib as part of the recipe.
+ (all): Don't depend on stamp_BLD.
+ (ALL): Include $(BLD)/test-distrib.exe.
+
2012-03-11 Andreas Schwab <schwab@linux-m68k.org>
* emacsclient.c (main): Handle -print-nonl command.
* makefile.w32-in (LOCAL_FLAGS): Add $(EMACS_EXTRA_C_FLAGS).
* emacsclient.c (main) <environ>: Remove declaration, already
- pulled in by unistd.h on Posix hosts and stdlib.h on MS-Windows.
+ pulled in by unistd.h on POSIX hosts and stdlib.h on MS-Windows.
2011-11-24 Glenn Morris <rgm@gnu.org>
* etags.c (canonicalize_filename, ISUPPER): Fix last change.
- * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)): Depend
- on ../lib/min-max.h.
+ * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)):
+ Depend on ../lib/min-max.h.
2011-02-22 Paul Eggert <eggert@cs.ucla.edu>
(Asm_help, default_C_suffixes, default_C_help, Cplusplus_suffixes)
(Cplusplus_help, Cjava_suffixes, Cobol_suffixes, Cstar_suffixes)
(Erlang_suffixes, Erlang_help, Forth_suffixes, Forth_help)
- (Fortran_suffixes, Fortran_help, HTML_suffixes, HTML_help)
+ (Fortran_suffixes, Fortran_help, HTML_suffixes, HTML_help)
(Lisp_suffixes, Lisp_help, Lua_suffixes, Lua_help)
(Makefile_filenames, Makefile_help, Objc_suffixes, Objc_help)
(Pascal_suffixes, Pascal_help, Perl_suffixes, Perl_interpreters)
* make-docfile.c (read_c_string_or_comment): Declare msgno.
- * Makefile.in (YACC): Deleted.
+ * Makefile.in (YACC): Delete.
2002-10-19 Andreas Schwab <schwab@suse.de>
(TeX_commands): Names now include the initial backslash.
(TeX_commands): Names do not include numeric args #n.
(TeX_commands): Correct line char number in tags.
- (TEX_tabent, TEX_token): Deleted.
+ (TEX_tabent, TEX_token): Delete.
(TeX_commands, TEX_decode_env): Streamlined.
2002-06-05 Francesco Potortì <pot@gnu.org>
(main): New argument -d, for specifying directory.
(usage): Document.
(get_user_id): Compute.
- (get_home_dir): Deleted.
+ (get_home_dir): Delete.
(get_prefix): New function, taken from main.
(main): Check whether or not we are running setuid. Move prefix
computation to get_prefix. Don't call getpwent; we don't need to
(LOOKING_AT, get_tag, PHP_functions): Use notinname.
(Ada_getit, Ada_funcs, Python_functions, Scheme_functions):
Clarified, using strneq or notinname.
- (L_isdef, L_isquote): Removed.
+ (L_isdef, L_isquote): Remove.
(Lisp_functions, L_getit): Clarified.
* etags.c (P_): Rename to __P for consistency with config.h.
comma when --declarations is used.
(C_entries): More accurate tagging of members and declarations.
(yacc_rules): Was global, made local to C_entries.
- (next_token_is_func): Removed.
+ (next_token_is_func): Remove.
(fvdef): New constants fdefunkey, fdefunname.
(consider_token, C_entries): Use them.
(C_entries): Build proper lisp names for Emacs DEFUNs.
(find_entries, takeprec, getit, Fortran_functions, Perl_functions)
(Python_functions, L_getit, Lisp_functions, Scheme_functions)
(prolog_pred, erlanf_func, erlang_attribute): Use them.
- (eat_white): Deleted.
+ (eat_white): Delete.
* etags.c (CHAR, init): Keep into account non US-ASCII
characters and compilers with default signed chars.
1997-05-13 Francesco Potortì <F.Potorti@cnuce.cnr.it>
* etags.c (TeX_functions): Cleaned up.
- (tex_getit): Removed.
+ (tex_getit): Remove.
1997-05-13 Paul Eggert <eggert@twinsun.com>
* etags.c: Prolog language totally rewritten.
(Prolog_functions): Rewritten from scratch.
- (skip_comment, prolog_getit): Removed.
+ (skip_comment, prolog_getit): Remove.
(prolog_skip_comment): New function, like old skip_comment.
(prolog_pred, prolog_atom, prolog_white): New functions.
(erlang_func, erlang_attributes): Forward declarations added.
1995-01-12 Francesco Potortì (pot@cnuce.cnr.it)
- * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Deleted.
+ * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Delete.
(append_to_tagfile, typedefs, typedefs_and_cplusplus)
(constantypedefs, update, vgrind_style, no_warnings)
(cxref_style, cplusplus, noindentypedefs): Were int, now logical.
(consider_token): Don't take a token as argument. Use savenstr
when saving a tag in structtag. Callers changed.
(TOKEN): Structure changed. Now used only in C_entries.
- (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Deleted.
+ (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Delete.
(C_entries): nameb and savenameb deleted. Use dinamic allocation.
- (pfcnt): Deleted. Users updated.
+ (pfcnt): Delete. Users updated.
(getit, Asm_labels, Pascal_functions, L_getit, get_scheme)
(TEX_getit, prolog_getit): Use dinamic allocation for storing
the tag instead of a fixed size buffer.
1994-03-25 Francesco Potortì (pot@cnuce.cnr.it)
- * etags.c (emacs_tags_format, ETAGS): Removed. Use CTAGS instead.
+ * etags.c (emacs_tags_format, ETAGS): Remove. Use CTAGS instead.
(main): Don't allow the use of -t and -T in etags mode.
(print_help): Don't show options enabled by default.
(print_version): Show the emacs version number if VERSION is #defined.
1994-01-14 Francesco Potortì (pot@cnuce.cnr.it)
* etags.c (stab_entry, stab_create, stab_find, stab_search,
- stab_type, add_keyword, C_reate_stab, C_create_stabs): Deleted.
+ stab_type, add_keyword, C_reate_stab, C_create_stabs): Delete.
Use gperf generated hash table instead of linked list.
- (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Added.
+ (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Add.
Mostly code generated by gperf.
(consider_token): Remove unused parameter `lp'.
(PF_funcs, getit): Allow subroutine and similar declarations
1993-08-25 Paul Eggert (eggert@twinsun.com)
- * rcs2log: Change /{/ to /\{/ for Posix ERE compatibility;
+ * rcs2log: Change /{/ to /\{/ for POSIX ERE compatibility;
otherwise, HP awk complains.
* vcdiff: Append /usr/ccs/bin and /usr/sccs to PATH, since these
* etags.c (consider_token): Was `==', now is `='.
(consider_token): DEFUNs now treated like funcs in ctags mode.
- * etags.c (LEVEL_OK_FOR_FUNCDEF): Removed.
+ * etags.c (LEVEL_OK_FOR_FUNCDEF): Remove.
(C_entries): Optimized the test that used LEVEL_OK_FOR_FUNCDEF.
(C_entries): Remove a piece of useless code.
(C_entries): Making typedef tags is delayed until a semicolon
* rcs2log: mawk, SunOS 4.1.3 nawk, and Ultrix/MKS nawk all barf on
/[/]/, so change it to /[\/]/. This should work on all
- Posix-compliant awks. It's slightly wrong with traditional awk,
+ POSIX-compliant awks. It's slightly wrong with traditional awk,
since it matches \ too, but that's a minor problem compared to awk
syntax errors.
* etags.c (GET_COOKIE): And related macros removed.
(logical): Is now int, no more a char.
(reg): Define deleted.
- (isgood, _gd, notgd): Deleted.
- (gotone): Deleted.
+ (isgood, _gd, notgd): Delete.
+ (gotone): Delete.
(TOKEN): Member linestart removed.
- (linepos, prev_linepos, lb1): Deleted.
+ (linepos, prev_linepos, lb1): Delete.
(main): Call initbuffer on lbs array instead of lb1.
(init): Remove the initialization of the logical _gd array.
(find_entries): A .sa suffix means assembler file.
All C state machines rewritten.
(C_entries): Complete rewrite.
(condider_token): Complete rewrite.
- (getline): Deleted.
+ (getline): Delete.
1993-03-01 Francesco Potortì (pot@fly.CNUCE.CNR.IT)
EXEEXT=@EXEEXT@
C_SWITCH_SYSTEM=@C_SWITCH_SYSTEM@
C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
+WARN_CFLAGS = @WARN_CFLAGS@
+WERROR_CFLAGS = @WERROR_CFLAGS@
# Program name transformation.
TRANSFORM = @program_transform_name@
# ==================== Where To Install Things ====================
+# Location to install Emacs.app under GNUstep / Mac OS X.
+# Later values may use this.
+ns_appbindir=@ns_appbindir@
+
# The default location for installation. Everything is placed in
# subdirectories of this directory. The default values for many of
# the variables below are expressed in terms of this one, so you may
# ../configure figures out the correct values for these.
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_DATA = @INSTALL_DATA@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
# By default, we uphold the dignity of our programs.
INSTALL_STRIP =
+MKDIR_P = @MKDIR_P@
# ========================== Lists of Files ===========================
INSTALLABLES = etags${EXEEXT} ctags${EXEEXT} emacsclient${EXEEXT} \
ebrowse${EXEEXT}
-INSTALLABLE_SCRIPTS = rcs-checkin grep-changelog
-STAMP_INST_SCRIPTS = stamp-rcs-checkin stamp-grep-changelog
+INSTALLABLE_SCRIPTS = grep-changelog
# Things that Emacs runs internally, or during the build process,
# which should not be installed in bindir.
# Like UTILITIES, but they're not system-dependent, and should not be
# deleted by the distclean target.
-SCRIPTS= rcs2log vcdiff
-STAMP_SCRIPTS= stamp-rcs2log stamp-vcdiff
+SCRIPTS= rcs2log
# All files that are created by the linker, i.e., whose names end in ${EXEEXT}.
EXE_FILES = ${INSTALLABLES} ${UTILITIES} ${DONT_INSTALL}
LIBRESOLV=@LIBRESOLV@
## -llockfile if HAVE_LIBLOCKFILE or -lmail if HAVE_LIBMAIL
LIBS_MAIL=@LIBS_MAIL@
+## empty or -lrt or -lposix4 if HAVE_CLOCK_GETTIME
+LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
## Extra libraries to use when linking movemail.
LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \
## Some systems define this to request special libraries.
LIBS_SYSTEM = @LIBS_SYSTEM@
-# Those files shared with other GNU utilities need HAVE_CONFIG_H
-# defined before they know they can take advantage of the information
-# in ../src/config.h.
-BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) ${C_WARNINGS_SWITCH} \
- -DHAVE_CONFIG_H -I. -I../src -I../lib \
+BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+ -I. -I../src -I../lib \
-I${srcdir} -I${srcdir}/../src -I${srcdir}/../lib
ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS}
LINK_CFLAGS = ${BASE_CFLAGS} ${LDFLAGS} ${CFLAGS}
CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS}
-all: ${EXE_FILES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS} ${STAMP_INST_SCRIPTS} ${STAMP_SCRIPTS}
-
-LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM)
-$(EXE_FILES): ../lib/libgnu.a
-
-## These targets copy the scripts into the build directory so that
-## they can be run from there in an uninstalled Emacs.
-## Nothing to do if pwd = srcdir.
-insrcdir=[ "`/bin/pwd`" = "`(cd $(srcdir) && /bin/pwd)`" ]
+# Configuration files for .o files to depend on.
+config_h = ../src/config.h $(srcdir)/../src/conf_post.h
-stamp-rcs2log: $(srcdir)/rcs2log
- $(insrcdir) || cp -p $(srcdir)/rcs2log rcs2log
- touch $@
+all: ${EXE_FILES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS}
-stamp-rcs-checkin: $(srcdir)/rcs-checkin
- $(insrcdir) || cp -p $(srcdir)/rcs-checkin rcs-checkin
- touch $@
+.PHONY: all need-blessmail maybe-blessmail
-stamp-grep-changelog: $(srcdir)/grep-changelog
- $(insrcdir) || cp -p $(srcdir)/grep-changelog grep-changelog
- touch $@
-
-stamp-vcdiff: $(srcdir)/vcdiff
- $(insrcdir) || cp -p $(srcdir)/vcdiff vcdiff
- touch $@
+LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM)
+$(EXE_FILES): ../lib/libgnu.a
## Only used if we need blessmail, but no harm in always defining.
## This makes the actual blessmail executable.
$(DESTDIR)${archlibdir}: all
@echo
@echo "Installing utilities run internally by Emacs."
- umask 022; $(top_srcdir)/build-aux/install-sh -d $(DESTDIR)${archlibdir}
- if [ `(cd $(DESTDIR)${archlibdir} && /bin/pwd)` != `/bin/pwd` ]; then \
+ umask 022; ${MKDIR_P} $(DESTDIR)${archlibdir}
+ if [ `cd $(DESTDIR)${archlibdir} && /bin/pwd` != `/bin/pwd` ]; then \
for file in ${UTILITIES}; do \
$(INSTALL_PROGRAM) $(INSTALL_STRIP) $$file $(DESTDIR)${archlibdir}/$$file ; \
done ; \
fi
- umask 022; $(top_srcdir)/build-aux/install-sh -d $(DESTDIR)${gamedir}; \
+ umask 022; ${MKDIR_P} $(DESTDIR)${gamedir}; \
touch $(DESTDIR)${gamedir}/snake-scores; \
touch $(DESTDIR)${gamedir}/tetris-scores
-if chown ${gameuser} $(DESTDIR)${archlibdir}/update-game-score && chmod u+s $(DESTDIR)${archlibdir}/update-game-score; then \
chown ${gameuser} $(DESTDIR)${gamedir}; \
chmod u=rwx,g=rwx,o=rx $(DESTDIR)${gamedir}; \
fi
- if [ `(cd $(DESTDIR)${archlibdir} && /bin/pwd)` \
- != `(cd ${srcdir} && /bin/pwd)` ]; then \
+ if [ `cd $(DESTDIR)${archlibdir} && /bin/pwd` \
+ != `cd ${srcdir} && /bin/pwd` ]; then \
for file in ${SCRIPTS}; do \
$(INSTALL_SCRIPT) ${srcdir}/$$file $(DESTDIR)${archlibdir}/$$file; \
done ; \
fi
+.PHONY: install uninstall mostlyclean clean distclean maintainer-clean
+.PHONY: extraclean check tags
+
install: $(DESTDIR)${archlibdir}
@echo
@echo "Installing utilities for users to run."
+ umask 022; ${MKDIR_P} $(DESTDIR)${bindir}
for file in ${INSTALLABLES} ; do \
$(INSTALL_PROGRAM) $(INSTALL_STRIP) $${file} $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'` ; \
- chmod a+rx $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'`; \
done
for file in ${INSTALLABLE_SCRIPTS} ; do \
$(INSTALL_SCRIPT) ${srcdir}/$${file} $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'` ; \
- chmod a+rx $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'`; \
done
uninstall:
clean: mostlyclean
-rm -f ${EXE_FILES}
- -rm -f ${STAMP_INST_SCRIPTS} ${STAMP_SCRIPTS}
distclean: clean
-rm -f TAGS
$(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
-DVERSION="\"${version}\"" ${srcdir}/etags.c \
regex.o $(LOADLIBES) -o ctags
-profile${EXEEXT}: ${srcdir}/profile.c ../src/config.h
- $(CC) ${ALL_CFLAGS} ${srcdir}/profile.c $(LOADLIBES) -o profile
+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
#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
static void class_definition (struct sym *, int, int, int);
static char *operator_name (int *);
static void parse_qualified_param_ident_or_type (char **);
-static void usage (int) NO_RETURN;
-static void version (void) NO_RETURN;
-
-
\f
/***********************************************************************
Utilities
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);
else
search_path = search_path_tail = p;
- while (*path_list == PATH_LIST_SEPARATOR)
+ while (*path_list == SEPCHAR)
++path_list;
}
}
--version display version info\n\
"
-static void
+static _Noreturn void
usage (int error)
{
puts (USAGE);
# define VERSION "21"
#endif
-static void
+static _Noreturn void
version (void)
{
- /* Makes it easier to update automatically. */
- char emacs_copyright[] = "Copyright (C) 2012 Free Software Foundation, Inc.";
+ char emacs_copyright[] = COPYRIGHT;
printf ("ebrowse %s\n", VERSION);
puts (emacs_copyright);
/* 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.
#ifdef WINDOWSNT
-/* config.h defines these, which disables sockets altogether! */
+/* ms-w32.h defines these, which disables sockets altogether! */
# undef _WINSOCKAPI_
# undef _WINSOCK_H
/* 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
be used for the new frame */
const char *frame_parameters = NULL;
-static void print_help_and_exit (void) NO_RETURN;
-static void fail (void) NO_RETURN;
+static _Noreturn void print_help_and_exit (void);
struct option longopts[] =
/* 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.
return window_app;
}
-/*
- execvp wrapper for Windows. Quotes arguments with embedded spaces.
+/* execvp wrapper for Windows. Quotes arguments with embedded spaces.
This is necessary due to the broken implementation of exec* routines in
the Microsoft libraries: they concatenate the arguments together without
quoting special characters, and pass the result to CreateProcess, with
predictably bad results. By contrast, POSIX execvp passes the arguments
- directly into the argv array of the child process.
-*/
+ directly into the argv array of the child process. */
+
int
w32_execvp (const char *path, char **argv)
{
int i;
+ extern int execvp (const char*, char **);
/* Required to allow a .BAT script as alternate editor. */
argv[0] = (char *) alternate_editor;
}
\f
-static void
+static _Noreturn void
print_help_and_exit (void)
{
/* Spaces and tabs are significant in this message; they're chosen so the
exit (EXIT_SUCCESS);
}
-/*
- Try to run a different command, or --if no alternate editor is
- defined-- exit with an errorcode.
- Uses argv, but gets it from the global variable main_argv.
-*/
-static void
+/* Try to run a different command, or --if no alternate editor is
+ defined-- exit with an errorcode.
+ Uses argv, but gets it from the global variable main_argv. */
+
+static _Noreturn void
fail (void)
{
if (alternate_editor)
#define AUTH_KEY_LENGTH 64
#define SEND_BUFFER_SIZE 4096
-extern char *strerror (int);
-
/* Buffer to accumulate data to send in TCP connections. */
char send_buffer[SEND_BUFFER_SIZE + 1];
int sblen = 0; /* Fill pointer for the send buffer. */
/* Socket used to communicate with the Emacs server process. */
HSOCKET emacs_socket = 0;
-/* On Windows, the socket library was historically separate from the standard
- C library, so errors are handled differently. */
+/* On Windows, the socket library was historically separate from the
+ standard C library, so errors are handled differently. */
+
static void
sock_err_message (const char *function_name)
{
/* The inverse of quote_argument. Removes quoting in string STR by
- modifying the string in place. Returns STR. */
+ modifying the string in place. Returns STR. */
static char *
unquote_argument (char *str)
#endif /* WINDOWSNT */
\f
-/*
- * Read the information needed to set up a TCP comm channel with
- * the Emacs server: host, port, and authentication string.
- */
+/* Read the information needed to set up a TCP comm channel with
+ the Emacs server: host, port, and authentication string. */
+
static int
get_server_config (const char *config_file, struct sockaddr_in *server,
char *authentication)
message (FALSE, "%s: connected to remote socket at %s\n",
progname, inet_ntoa (server.sin_addr));
- /*
- * Open up an AF_INET socket
- */
+ /* Open up an AF_INET socket. */
if ((s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0)
{
sock_err_message ("socket");
return INVALID_SOCKET;
}
- /*
- * Set up the socket
- */
+ /* Set up the socket. */
if (connect (s, (struct sockaddr *) &server, sizeof server) < 0)
{
sock_err_message ("connect");
setsockopt (s, SOL_SOCKET, SO_LINGER, (char *) &l_arg, sizeof l_arg);
- /*
- * Send the authentication
- */
+ /* Send the authentication. */
auth_string[AUTH_KEY_LENGTH] = '\0';
send_to_emacs (s, "-auth ");
going to sleep. Normally the suspend is initiated by Emacs via
server-handle-suspend-tty, but if the server gets out of sync with
reality, we may get a SIGTSTP on C-z. Handling this signal and
- notifying Emacs about it should get things under control again. */
+ notifying Emacs about it should get things under control again. */
static void
handle_sigtstp (int signalnum)
HSOCKET s;
struct sockaddr_un server;
- /*
- * Open up an AF_UNIX socket in this person's home directory
- */
-
+ /* Open up an AF_UNIX socket in this person's home directory. */
if ((s = socket (AF_UNIX, SOCK_STREAM, 0)) < 0)
{
message (TRUE, "%s: socket: %s\n", progname, strerror (errno));
if (n > 0)
{
tmpdir = tmpdir_storage = xmalloc (n);
- confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir, n);
+ confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir_storage, n);
}
else
#endif
return FALSE;
}
-/*
- * Search for a window of class "Emacs" and owned by a process with
- * process id = emacs_pid. If found, allow it to grab the focus.
- */
+/* Search for a window of class "Emacs" and owned by a process with
+ process id = emacs_pid. If found, allow it to grab the focus. */
+
void
w32_give_focus (void)
{
/* Send over our environment and current directory. */
if (!current_frame)
{
-#ifndef WINDOWSNT
- /* This is defined in stdlib.h on MS-Windows. It's defined in
- unistd.h on some POSIX hosts, but not all (Bug#10155). */
- extern char **environ;
-#endif
int i;
for (i = 0; environ[i]; i++)
{
send_to_emacs (emacs_socket, " ");
}
- /* If using the current frame, send tty information to Emacs anyway.
- In daemon mode, Emacs may need to occupy this tty if no other
- frame is available. */
- if (tty || (current_frame && !eval))
+ /* Unless we are certain we don't want to occupy the tty, send our
+ tty information to Emacs. For example, in daemon mode Emacs may
+ need to occupy this tty if no other frame is available. */
+ if (!current_frame || !eval)
{
const char *tty_type, *tty_name;
}
#endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */
-
-\f
-#ifndef HAVE_STRERROR
-char *
-strerror (errnum)
- int errnum;
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-
-#endif /* ! HAVE_STRERROR */
-
-
-/* emacsclient.c ends here */
# define NDEBUG /* disable assert */
#endif
-#ifdef HAVE_CONFIG_H
-# include <config.h>
- /* This is probably not necessary any more. On some systems, config.h
- used to define static as nothing for the sake of unexec. We don't
- want that here since we don't use unexec. None of these systems
- are supported any more, but the idea is still mentioned in
- etc/PROBLEMS. */
-# undef static
-# ifndef PTR /* for XEmacs */
-# define PTR void *
-# endif
-#else /* no config.h */
-# if defined (__STDC__) && (__STDC__ || defined (__SUNPRO_C))
-# define PTR void * /* for generic pointers */
-# else /* not standard C */
-# define const /* remove const for old compilers' sake */
-# define PTR long * /* don't use void* */
-# endif
-#endif /* !HAVE_CONFIG_H */
+#include <config.h>
#ifndef _GNU_SOURCE
# define _GNU_SOURCE 1 /* enables some compiler checks on GNU */
# include <fcntl.h>
# include <sys/param.h>
# include <io.h>
-# ifndef HAVE_CONFIG_H
-# define DOS_NT
-# include <sys/config.h>
-# endif
#else
# define MSDOS FALSE
#endif /* MSDOS */
# endif
#endif /* HAVE_UNISTD_H */
+#include <stdarg.h>
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
+#include <c-strcase.h>
#include <assert.h>
#ifdef NDEBUG
# include <getopt.h>
#endif /* NO_LONG_OPTIONS */
-#ifndef HAVE_CONFIG_H /* this is a standalone compilation */
-# ifdef __CYGWIN__ /* compiling on Cygwin */
- !!! NOTICE !!!
- the regex.h distributed with Cygwin is not compatible with etags, alas!
-If you want regular expression support, you should delete this notice and
- arrange to use the GNU regex.h and regex.c.
-# endif
-#endif
#include <regex.h>
/* Define CTAGS to make the program "ctags" compatible with the usual one.
#endif
#define streq(s,t) (assert ((s)!=NULL || (t)!=NULL), !strcmp (s, t))
-#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=NULL), !etags_strcasecmp (s, t))
+#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=NULL), !c_strcasecmp (s, t))
#define strneq(s,t,n) (assert ((s)!=NULL || (t)!=NULL), !strncmp (s, t, n))
-#define strncaseeq(s,t,n) (assert ((s)!=NULL && (t)!=NULL), !etags_strncasecmp (s, t, n))
+#define strncaseeq(s,t,n) (assert ((s)!=NULL && (t)!=NULL), !c_strncasecmp (s, t, n))
#define CHARS 256 /* 2^sizeof(char) */
#define CHAR(x) ((unsigned int)(x) & (CHARS - 1))
static void analyse_regex (char *);
static void free_regexps (void);
static void regex_tag_multiline (void);
-static void error (const char *, const char *);
-static void suggest_asking_for_help (void) NO_RETURN;
-void fatal (const char *, const char *) NO_RETURN;
-static void pfatal (const char *) NO_RETURN;
+static void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
+static _Noreturn void suggest_asking_for_help (void);
+_Noreturn void fatal (const char *, const char *);
+static _Noreturn void pfatal (const char *);
static void add_node (node *, node **);
static void init (void);
static char *savestr (const char *);
static char *etags_strchr (const char *, int);
static char *etags_strrchr (const char *, int);
-static int etags_strcasecmp (const char *, const char *);
-static int etags_strncasecmp (const char *, const char *, int);
static char *etags_getcwd (void);
static char *relative_filename (char *, char *);
static char *absolute_filename (char *, char *);
static void canonicalize_filename (char *);
static void linebuffer_init (linebuffer *);
static void linebuffer_setlen (linebuffer *, int);
-static PTR xmalloc (size_t);
-static PTR xrealloc (char *, size_t);
+static void *xmalloc (size_t);
+static void *xrealloc (char *, size_t);
\f
static char searchar = '/'; /* use /.../ searches */
static void
print_version (void)
{
- /* Makes it easier to update automatically. */
- char emacs_copyright[] = "Copyright (C) 2012 Free Software Foundation, Inc.";
+ char emacs_copyright[] = COPYRIGHT;
printf ("%s (%s %s)\n", (CTAGS) ? "ctags" : "etags", EMACS_NAME, VERSION);
puts (emacs_copyright);
case 'o':
if (tagfile)
{
- error ("-o option may only be given once.", (char *)NULL);
+ error ("-o option may only be given once.");
suggest_asking_for_help ();
/* NOTREACHED */
}
if (nincluded_files == 0 && file_count == 0)
{
- error ("no input files specified.", (char *)NULL);
+ error ("no input files specified.");
suggest_asking_for_help ();
/* NOTREACHED */
}
language *lang;
if (name == NULL)
- error ("empty language name", (char *)NULL);
+ error ("empty language name");
else
{
for (lang = lang_names; lang->name != NULL; lang++)
\f
static int total_size_of_entries (node *);
-static int number_len (long);
+static int number_len (long) ATTRIBUTE_CONST;
/* Length of a non-negative number's decimal representation. */
static int
{
/* Ctags mode */
if (np->name == NULL)
- error ("internal error: NULL name in ctags mode.", (char *)NULL);
+ error ("internal error: NULL name in ctags mode.");
if (cxref_style)
{
}
for (i = 1; i < cstack.nl; i++)
{
- char *s;
- int slen;
-
- s = cstack.cname[i];
+ char *s = cstack.cname[i];
if (s == NULL)
continue;
- slen = strlen (s);
- len += slen + qlen;
- linebuffer_setlen (cn, len);
- strncat (cn->buffer, qualifier, qlen);
- strncat (cn->buffer, s, slen);
+ linebuffer_setlen (cn, len + qlen + strlen (s));
+ len += sprintf (cn->buffer + len, "%s%s", qualifier, s);
}
}
case dignorerest:
return FALSE;
default:
- error ("internal error: definedef value.", (char *)NULL);
+ error ("internal error: definedef value.");
}
/*
fvdef = fvnone;
objdef = omethodtag;
linebuffer_setlen (&token_name, len);
- strncpy (token_name.buffer, str, len);
+ memcpy (token_name.buffer, str, len);
token_name.buffer[len] = '\0';
return TRUE;
}
case omethodparm:
if (parlev == 0)
{
+ int oldlen = token_name.len;
fvdef = fvnone;
objdef = omethodtag;
- linebuffer_setlen (&token_name, token_name.len + len);
- strncat (token_name.buffer, str, len);
+ linebuffer_setlen (&token_name, oldlen + len);
+ memcpy (token_name.buffer + oldlen, str, len);
+ token_name.buffer[oldlen + len] = '\0';
return TRUE;
}
return FALSE;
make_tag (concat ("INVALID TOKEN:-->", token_name.buffer, ""),
token_name.len + 17, isfun, token.line,
token.offset+token.length+1, token.lineno, token.linepos);
- error ("INVALID TOKEN", NULL);
+ error ("INVALID TOKEN");
}
token.valid = FALSE;
&& nestlev > 0 && definedef == dnone)
/* in struct body */
{
+ int len;
write_classname (&token_name, qualifier);
- linebuffer_setlen (&token_name,
- token_name.len+qlen+toklen);
- strcat (token_name.buffer, qualifier);
- strncat (token_name.buffer,
- newlb.buffer + tokoff, toklen);
+ len = token_name.len;
+ linebuffer_setlen (&token_name, len+qlen+toklen);
+ sprintf (token_name.buffer + len, "%s%.*s",
+ qualifier, toklen, newlb.buffer + tokoff);
token.named = TRUE;
}
else if (objdef == ocatseen)
{
int len = strlen (objtag) + 2 + toklen;
linebuffer_setlen (&token_name, len);
- strcpy (token_name.buffer, objtag);
- strcat (token_name.buffer, "(");
- strncat (token_name.buffer,
- newlb.buffer + tokoff, toklen);
- strcat (token_name.buffer, ")");
+ sprintf (token_name.buffer, "%s(%.*s)",
+ objtag, toklen, newlb.buffer + tokoff);
token.named = TRUE;
}
else if (objdef == omethodtag
len -= 1;
}
linebuffer_setlen (&token_name, len);
- strncpy (token_name.buffer,
- newlb.buffer + off, len);
+ memcpy (token_name.buffer,
+ newlb.buffer + off, len);
token_name.buffer[len] = '\0';
if (defun)
while (--len >= 0)
else
{
linebuffer_setlen (&token_name, toklen);
- strncpy (token_name.buffer,
- newlb.buffer + tokoff, toklen);
+ memcpy (token_name.buffer,
+ newlb.buffer + tokoff, toklen);
token_name.buffer[toklen] = '\0';
/* Name macros and members. */
token.named = (structdef == stagseen
/* 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! */
{
for (end = dbp; *end != '\0' && intoken (*end); end++)
continue;
linebuffer_setlen (&token_name, end - dbp);
- strncpy (token_name.buffer, dbp, end - dbp);
+ memcpy (token_name.buffer, dbp, end - dbp);
token_name.buffer[end - dbp] = '\0';
dbp = end;
else if (len + 1 > allocated)
xrnew (last, len + 1, char);
allocated = len + 1;
- strncpy (last, cp, len);
+ memcpy (last, cp, len);
last[len] = '\0';
}
}
else if (len + 1 > allocated)
xrnew (last, len + 1, char);
allocated = len + 1;
- strncpy (last, cp, len);
+ memcpy (last, cp, len);
last[len] = '\0';
}
}
{
static struct re_pattern_buffer zeropattern;
char sep, *pat, *name, *modifiers;
- char empty[] = "";
+ char empty = '\0';
const char *err;
struct re_pattern_buffer *patbuf;
regexp *rp;
if (strlen (regexp_pattern) < 3)
{
- error ("null regexp", (char *)NULL);
+ error ("null regexp");
return;
}
sep = regexp_pattern[0];
if (modifiers == NULL) /* no terminating separator --> no name */
{
modifiers = name;
- name = empty;
+ name = ∅
}
else
modifiers += 1; /* skip separator */
{
case 'N':
if (modifiers == name)
- error ("forcing explicit tag name but no name, ignoring", NULL);
+ error ("forcing explicit tag name but no name, ignoring");
force_explicit_name = TRUE;
break;
case 'i':
need_filebuf = TRUE;
break;
default:
- {
- char wrongmod [2];
- wrongmod[0] = modifiers[0];
- wrongmod[1] = '\0';
- error ("invalid regexp modifier `%s', ignoring", wrongmod);
- }
+ error ("invalid regexp modifier `%c', ignoring", modifiers[0]);
break;
}
{
dig = *out - '0';
diglen = regs->end[dig] - regs->start[dig];
- strncpy (t, in + regs->start[dig], diglen);
+ memcpy (t, in + regs->start[dig], diglen);
t += diglen;
}
else
filebuf.size *= 2;
xrnew (filebuf.buffer, filebuf.size, char);
}
- strncpy (filebuf.buffer + filebuf.len, lbp->buffer, lbp->len);
+ memcpy (filebuf.buffer + filebuf.len, lbp->buffer, lbp->len);
filebuf.len += lbp->len;
filebuf.buffer[filebuf.len++] = '\n';
filebuf.buffer[filebuf.len] = '\0';
register char *dp;
dp = xnew (len + 1, char);
- strncpy (dp, cp, len);
+ memcpy (dp, cp, len);
dp[len] = '\0';
return dp;
}
return NULL;
}
-/*
- * Compare two strings, ignoring case for alphabetic characters.
- *
- * Same as BSD's strcasecmp, included for portability.
- */
-static int
-etags_strcasecmp (register const char *s1, register const char *s2)
-{
- while (*s1 != '\0'
- && (ISALPHA (*s1) && ISALPHA (*s2)
- ? lowcase (*s1) == lowcase (*s2)
- : *s1 == *s2))
- s1++, s2++;
-
- return (ISALPHA (*s1) && ISALPHA (*s2)
- ? lowcase (*s1) - lowcase (*s2)
- : *s1 - *s2);
-}
-
-/*
- * Compare two strings, ignoring case for alphabetic characters.
- * Stop after a given number of characters
- *
- * Same as BSD's strncasecmp, included for portability.
- */
-static int
-etags_strncasecmp (register const char *s1, register const char *s2, register int n)
-{
- while (*s1 != '\0' && n-- > 0
- && (ISALPHA (*s1) && ISALPHA (*s2)
- ? lowcase (*s1) == lowcase (*s2)
- : *s1 == *s2))
- s1++, s2++;
-
- if (n < 0)
- return 0;
- else
- return (ISALPHA (*s1) && ISALPHA (*s2)
- ? lowcase (*s1) - lowcase (*s2)
- : *s1 - *s2);
-}
-
/* Skip spaces (end of string is not space), return new pointer. */
static char *
skip_spaces (char *cp)
exit (EXIT_FAILURE);
}
-/* Print error message. `s1' is printf control string, `s2' is arg for it. */
+/* Output a diagnostic with printf-style FORMAT and args. */
static void
-error (const char *s1, const char *s2)
+error (const char *format, ...)
{
+ va_list ap;
+ va_start (ap, format);
fprintf (stderr, "%s: ", progname);
- fprintf (stderr, s1, s2);
+ vfprintf (stderr, format, ap);
fprintf (stderr, "\n");
+ va_end (ap);
}
/* Return a newly-allocated string whose contents
}
/* Like malloc but get fatal error if memory is exhausted. */
-static PTR
+static void *
xmalloc (size_t size)
{
- PTR result = (PTR) malloc (size);
+ void *result = malloc (size);
if (result == NULL)
fatal ("virtual memory exhausted", (char *)NULL);
return result;
}
-static PTR
+static void *
xrealloc (char *ptr, size_t size)
{
- PTR result = (PTR) realloc (ptr, size);
+ void *result = realloc (ptr, size);
if (result == NULL)
fatal ("virtual memory exhausted", (char *)NULL);
return result;
along with this program. If not, see <http://www.gnu.org/licenses/>. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <stdio.h>
#include <ctype.h>
int group_by = DEFAULT_GROUPING;
char *progname;
-void usage (void) NO_RETURN;
+_Noreturn void usage (void);
int
main (int argc, char **argv)
/* 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.
#include <config.h>
-/* defined to be emacs_main, sys_fopen, etc. in config.h */
-#undef main
-#undef fopen
-#undef chdir
-
#include <stdio.h>
-#include <stdlib.h>
+#include <stdlib.h> /* config.h unconditionally includes this anyway */
#ifdef MSDOS
#include <fcntl.h>
#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 <fcntl.h>
#include <direct.h>
#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 */
#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 fatal (const char *s1, const char *s2) NO_RETURN;
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 <unistd.h>
/* Stdio stream for output to the DOC file. */
/* Print error message and exit. */
/* VARARGS1 */
-static void
+static _Noreturn void
fatal (const char *s1, const char *s2)
{
error (s1, s2);
for (tmp = filename; *tmp; tmp++)
{
- if (IS_DIRECTORY_SEP(*tmp))
+ if (IS_DIRECTORY_SEP (*tmp))
filename = tmp + 1;
}
/* In C code, `default' is a reserved word, so we spell it
`defalt'; demangle that here. */
- if (ident_length == 6 && strncmp (ident_start, "defalt", 6) == 0)
+ if (ident_length == 6 && memcmp (ident_start, "defalt", 6) == 0)
fprintf (out, "DEFAULT");
else
while (ident_length-- > 0)
putc (')', out);
}
\f
-/* 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
{
+ INVALID,
+ LISP_OBJECT,
EMACS_INTEGER,
BOOLEAN,
- LISP_OBJECT,
- INVALID
+ FUNCTION,
};
/* A single global. */
{
enum global_type type;
char *name;
+ int value;
};
/* All the variable names we saw while scanning C sources in `-g'
struct global *globals;
static void
-add_global (enum global_type type, char *name)
+add_global (enum global_type type, char *name, int value)
{
/* Ignore the one non-symbol that can occur. */
if (strcmp (name, "..."))
globals[num_globals - 1].type = type;
globals[num_globals - 1].name = name;
+ globals[num_globals - 1].value = value;
}
}
{
const struct global *ga = a;
const struct global *gb = b;
+
+ if (ga->type != gb->type)
+ return ga->type - gb->type;
+
return strcmp (ga->name, gb->name);
}
+static void
+close_emacs_globals (void)
+{
+ fprintf (outfile, "};\n");
+ fprintf (outfile, "extern struct emacs_globals globals;\n");
+}
+
static void
write_globals (void)
{
- int i;
+ int i, seen_defun = 0;
qsort (globals, num_globals, sizeof (struct global), compare_globals);
for (i = 0; i < num_globals; ++i)
{
type = "EMACS_INT";
break;
case BOOLEAN:
- type = "int";
+ type = "bool";
break;
case LISP_OBJECT:
type = "Lisp_Object";
break;
+ case FUNCTION:
+ if (!seen_defun)
+ {
+ close_emacs_globals ();
+ fprintf (outfile, "\n");
+ seen_defun = 1;
+ }
+ break;
default:
fatal ("not a recognized DEFVAR_", 0);
}
- fprintf (outfile, " %s f_%s;\n", type, globals[i].name);
- fprintf (outfile, "#define %s globals.f_%s\n",
- globals[i].name, globals[i].name);
+ if (globals[i].type != FUNCTION)
+ {
+ fprintf (outfile, " %s f_%s;\n", type, globals[i].name);
+ fprintf (outfile, "#define %s globals.f_%s\n",
+ globals[i].name, globals[i].name);
+ }
+ else
+ {
+ /* It would be nice to have a cleaner way to deal with these
+ special hacks. */
+ if (strcmp (globals[i].name, "Fthrow") == 0
+ || strcmp (globals[i].name, "Ftop_level") == 0
+ || strcmp (globals[i].name, "Fkill_emacs") == 0)
+ fprintf (outfile, "_Noreturn ");
+ fprintf (outfile, "EXFUN (%s, ", globals[i].name);
+ if (globals[i].value == -1)
+ fprintf (outfile, "MANY");
+ else if (globals[i].value == -2)
+ fprintf (outfile, "UNEVALLED");
+ else
+ fprintf (outfile, "%d", globals[i].value);
+ fprintf (outfile, ");\n");
+ }
+
while (i + 1 < num_globals
&& !strcmp (globals[i].name, globals[i + 1].name))
- ++i;
+ {
+ if (globals[i].type == FUNCTION
+ && globals[i].value != globals[i + 1].value)
+ error ("function '%s' defined twice with differing signatures",
+ globals[i].name);
+ ++i;
+ }
}
- fprintf (outfile, "};\n");
- fprintf (outfile, "extern struct emacs_globals globals;\n");
+ if (!seen_defun)
+ close_emacs_globals ();
}
\f
if (infile == NULL && extension == 'o')
{
- /* try .m */
+ /* Try .m. */
filename[strlen (filename) - 1] = 'm';
infile = fopen (filename, mode);
if (infile == NULL)
- filename[strlen (filename) - 1] = 'c'; /* don't confuse people */
+ filename[strlen (filename) - 1] = 'c'; /* Don't confuse people. */
}
- /* No error if non-ex input file */
+ /* No error if non-ex input file. */
if (infile == NULL)
{
perror (filename);
int defvarperbufferflag = 0;
int defvarflag = 0;
enum global_type type = INVALID;
+ char *name IF_LINT (= 0);
if (c != '\n' && c != '\r')
{
}
else continue;
- if (generate_globals && (!defvarflag || defvarperbufferflag
- || type == INVALID))
+ if (generate_globals
+ && (!defvarflag || defvarperbufferflag || type == INVALID)
+ && !defunflag)
continue;
while (c != '(')
if (generate_globals)
{
int i = 0;
- char *name;
/* Skip "," and whitespace. */
do
input_buffer[i++] = c;
c = getc (infile);
}
- while (! (c == ',' || c == ' ' || c == '\t' ||
- c == '\n' || c == '\r'));
+ while (! (c == ',' || c == ' ' || c == '\t'
+ || c == '\n' || c == '\r'));
input_buffer[i] = '\0';
name = xmalloc (i + 1);
memcpy (name, input_buffer, i + 1);
- add_global (type, name);
- continue;
+
+ if (!defunflag)
+ {
+ add_global (type, name, 0);
+ continue;
+ }
}
/* DEFVAR_LISP ("name", addr, "doc")
DEFVAR_LISP ("name", addr, doc: /\* doc *\/) */
if (defunflag)
- commas = 5;
+ commas = generate_globals ? 4 : 5;
else if (defvarperbufferflag)
commas = 3;
else if (defvarflag)
commas = 1;
- else /* For DEFSIMPLE and DEFPRED */
+ else /* For DEFSIMPLE and DEFPRED. */
commas = 2;
while (commas)
if (c < 0)
goto eof;
ungetc (c, infile);
- if (commas == 2) /* pick up minargs */
+ if (commas == 2) /* Pick up minargs. */
scanned = fscanf (infile, "%d", &minargs);
- else /* pick up maxargs */
+ else /* Pick up maxargs. */
if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
- maxargs = -1;
+ {
+ if (generate_globals)
+ maxargs = (c == 'M') ? -1 : -2;
+ else
+ maxargs = -1;
+ }
else
scanned = fscanf (infile, "%d", &maxargs);
if (scanned < 0)
c = getc (infile);
}
+ if (generate_globals)
+ {
+ add_global (FUNCTION, name, maxargs);
+ continue;
+ }
+
while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
c = getc (infile);
fprintf (outfile, "%s\n", input_buffer);
if (comment)
- getc (infile); /* Skip past `*' */
+ getc (infile); /* Skip past `*'. */
c = read_c_string_or_comment (infile, 1, comment, &saw_usage);
/* If this is a defun, find the arguments and print them. If
problem because byte-compiler output follows this convention.
The NAME and DOCSTRING are output.
NAME is preceded by `F' for a function or `V' for a variable.
- An entry is output only if DOCSTRING has \ newline just after the opening "
+ An entry is output only if DOCSTRING has \ newline just after the opening ".
*/
static void
skip_white (infile);
}
+static int
+search_lisp_doc_at_eol (FILE *infile)
+{
+ char c = 0, c1 = 0, c2 = 0;
+
+ /* Skip until the end of line; remember two previous chars. */
+ while (c != '\n' && c != '\r' && c != EOF)
+ {
+ c2 = c1;
+ c1 = c;
+ c = getc (infile);
+ }
+
+ /* If two previous characters were " and \,
+ this is a doc string. Otherwise, there is none. */
+ if (c2 != '"' || c1 != '\\')
+ {
+#ifdef DEBUG
+ fprintf (stderr, "## non-docstring in %s (%s)\n",
+ buffer, filename);
+#endif
+ if (c != EOF)
+ ungetc (c, infile);
+ return 0;
+ }
+ return 1;
+}
+
static int
scan_lisp_file (const char *filename, const char *mode)
{
if (infile == NULL)
{
perror (filename);
- return 0; /* No error */
+ return 0; /* No error. */
}
c = '\n';
type = 'F';
read_lisp_symbol (infile, buffer);
- /* Skip the arguments: either "nil" or a list in parens */
+ /* Skip the arguments: either "nil" or a list in parens. */
c = getc (infile);
if (c == 'n') /* nil */
|| ! strcmp (buffer, "defconst")
|| ! strcmp (buffer, "defcustom"))
{
- char c1 = 0, c2 = 0;
type = 'V';
read_lisp_symbol (infile, buffer);
if (saved_string == 0)
- {
-
- /* Skip until the end of line; remember two previous chars. */
- while (c != '\n' && c != '\r' && c >= 0)
- {
- c2 = c1;
- c1 = c;
- c = getc (infile);
- }
-
- /* If two previous characters were " and \,
- this is a doc string. Otherwise, there is none. */
- if (c2 != '"' || c1 != '\\')
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring in %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
- }
+ if (!search_lisp_doc_at_eol (infile))
+ continue;
}
else if (! strcmp (buffer, "custom-declare-variable")
|| ! strcmp (buffer, "defvaralias")
)
{
- char c1 = 0, c2 = 0;
type = 'V';
c = getc (infile);
}
if (saved_string == 0)
- {
- /* Skip to end of line; remember the two previous chars. */
- while (c != '\n' && c != '\r' && c >= 0)
- {
- c2 = c1;
- c1 = c;
- c = getc (infile);
- }
-
- /* If two previous characters were " and \,
- this is a doc string. Otherwise, there is none. */
- if (c2 != '"' || c1 != '\\')
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring in %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
- }
+ if (!search_lisp_doc_at_eol (infile))
+ continue;
}
else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
{
- char c1 = 0, c2 = 0;
type = 'F';
c = getc (infile);
}
if (saved_string == 0)
- {
- /* Skip to end of line; remember the two previous chars. */
- while (c != '\n' && c != '\r' && c >= 0)
- {
- c2 = c1;
- c1 = c;
- c = getc (infile);
- }
-
- /* If two previous characters were " and \,
- this is a doc string. Otherwise, there is none. */
- if (c2 != '"' || c1 != '\\')
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring in %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
- }
+ if (!search_lisp_doc_at_eol (infile))
+ continue;
}
else if (! strcmp (buffer, "autoload"))
continue;
}
read_c_string_or_comment (infile, 0, 0, 0);
- skip_white (infile);
if (saved_string == 0)
- {
- /* If the next three characters aren't `dquote bslash newline'
- then we're not reading a docstring. */
- if ((c = getc (infile)) != '"'
- || (c = getc (infile)) != '\\'
- || ((c = getc (infile)) != '\n' && c != '\r'))
- {
-#ifdef DEBUG
- fprintf (stderr, "## non-docstring in %s (%s)\n",
- buffer, filename);
-#endif
- continue;
- }
- }
+ if (!search_lisp_doc_at_eol (infile))
+ continue;
}
#ifdef DEBUG
else if (! strcmp (buffer, "if")
|| ! strcmp (buffer, "byte-code"))
- ;
+ continue;
#endif
else
continue;
}
- /* At this point, we should either use the previous
- dynamic doc string in saved_string
- or gobble a doc string from the input file.
-
- In the latter case, the opening quote (and leading
- backslash-newline) have already been read. */
+ /* At this point, we should either use the previous dynamic doc string in
+ saved_string or gobble a doc string from the input file.
+ In the latter case, the opening quote (and leading backslash-newline)
+ have already been read. */
putc (037, outfile);
putc (type, outfile);
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-ALL = make-docfile hexl ctags etags movemail ebrowse emacsclient
+ALL = $(BLD)/test-distrib.exe $(BLD)/make-docfile.exe $(BLD)/hexl.exe\
+ $(BLD)/ctags.exe $(BLD)/etags.exe $(BLD)/movemail.exe $(BLD)/ebrowse.exe\
+ $(BLD)/emacsclient.exe $(BLD)/emacsclientw.exe $(BLD)/profile.exe
-.PHONY: $(ALL)
+.PHONY: make-docfile
-LOCAL_FLAGS = -DWINDOWSNT -DDOS_NT -DNO_LDAV=1 \
- -DNO_ARCHIVES=1 -DHAVE_CONFIG_H=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)
+# The following target is used by makefile.w32-in files in other directories.
+make-docfile: $(BLD)/make-docfile.exe
+
$(BLD)/make-docfile.exe: $(BLD)/make-docfile.$(O) $(BLD)/ntlib.$(O)
$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/make-docfile.$(O) $(BLD)/ntlib.$(O) $(LIBS)
$(BLD)/hexl.exe: $(BLD)/hexl.$(O)
$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/hexl.$(O) $(LIBS)
$(BLD)/test-distrib.exe: $(BLD)/test-distrib.$(O)
$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/test-distrib.$(O) $(LIBS)
-
-make-docfile: stamp_BLD $(BLD)/make-docfile.exe
-ctags: stamp_BLD $(BLD)/ctags.exe
-etags: stamp_BLD $(BLD)/etags.exe
-ebrowse: stamp_BLD $(BLD)/ebrowse.exe
-hexl: stamp_BLD $(BLD)/hexl.exe
-movemail: stamp_BLD $(BLD)/movemail.exe
-emacsclient: stamp_BLD $(BLD)/emacsclient.exe $(BLD)/emacsclientw.exe
-
-test-distrib: stamp_BLD $(BLD)/test-distrib.exe
- "$(BLD)/test-distrib.exe" "$(SRC)/testfile"
+ "$(BLD)/test-distrib.exe" "$(LIB_SRC)/testfile"
MOVEMAILOBJS = $(BLD)/movemail.$(O) \
$(BLD)/pop.$(O) \
- $(DEL) ctags.c
$(CP) etags.c ctags.c
-CTAGS_CFLAGS = -DCTAGS $(ETAGS_CFLAGS) -DEMACS_NAME="\"GNU Emacs\""
+CTAGS_CFLAGS = -DCTAGS $(ETAGS_CFLAGS)
$(BLD)/ctags.$(O): ctags.c
$(CC) $(CFLAGS) $(CTAGS_CFLAGS) $(CC_OUT)$@ ctags.c
+PROFILEOBJS = $(BLD)/profile.$(O) \
+ ../lib/$(BLD)/libgnu.$(A) \
+ $(BLD)/ntlib.$(O)
+$(BLD)/profile.exe: $(PROFILEOBJS)
+ $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(PROFILEOBJS) $(LIBS)
+
#
# From ..\src\Makefile.in
# It doesn't matter if the real name is *.obj for the files in this list,
process.o callproc.o unexw32.o \
region-cache.o sound.o atimer.o \
doprnt.o intervals.o textprop.o composite.o \
- gnutls.o
+ gnutls.o xml.o profiler.o
#
# These are the lisp files that are loaded up in loadup.el
$(lispsource)language/georgian.el \
$(lispsource)language/khmer.el \
$(lispsource)language/burmese.el \
- $(lispsource)paths.el \
$(lispsource)register.elc \
$(lispsource)replace.elc \
$(lispsource)simple.elc \
#
# Build the executables
#
-all: stamp_BLD $(ALL) $(DOC)
+all: $(ALL) $(DOC)
#
# Assuming INSTALL_DIR is defined, build and install emacs in it.
$(CP) $(BLD)/movemail.exe $(INSTALL_DIR)/bin
$(CP) $(BLD)/emacsclient.exe $(INSTALL_DIR)/bin
$(CP) $(BLD)/emacsclientw.exe $(INSTALL_DIR)/bin
+ $(CP) $(BLD)/profile.exe $(INSTALL_DIR)/bin
- mkdir "$(INSTALL_DIR)/etc"
$(CP) $(DOC) $(INSTALL_DIR)/etc
### DEPENDENCIES ###
EMACS_ROOT = ..
-SRC = .
-
-$(BLD)/alloca.$(O) : \
- $(SRC)/alloca.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h \
- $(EMACS_ROOT)/src/blockinput.h
+LIB_SRC = .
+SRC = $(EMACS_ROOT)/src
+NT_INC = $(EMACS_ROOT)/nt/inc
+GNU_LIB = $(EMACS_ROOT)/lib
+
+MS_W32_H = $(NT_INC)/ms-w32.h \
+ $(NT_INC)/sys/stat.h
+CONF_POST_H = $(SRC)/conf_post.h \
+ $(MS_W32_H)
+CONFIG_H = $(SRC)/config.h \
+ $(CONF_POST_H)
+INTTYPES_H = $(NT_INC)/inttypes.h \
+ $(NT_INC)/stdint.h
+NTLIB_H = $(LIB_SRC)/ntlib.h \
+ $(NT_INC)/pwd.h
+SYSTIME_H = $(SRC)/systime.h \
+ $(NT_INC)/sys/time.h \
+ $(GNU_LIB)/timespec.h
$(BLD)/ctags.$(O) : \
- $(SRC)/ctags.c \
- $(EMACS_ROOT)/nt/inc/sys/param.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h \
- $(SRC)/ntlib.h \
- $(EMACS_ROOT)/lib/getopt.h
+ $(LIB_SRC)/ctags.c \
+ $(SRC)/regex.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/c-strcase.h \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H)
$(BLD)/ebrowse.$(O) : \
- $(SRC)/ebrowse.c \
- $(EMACS_ROOT)/lib/min-max.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h
+ $(LIB_SRC)/ebrowse.c \
+ $(GNU_LIB)/getopt.h \
+ $(GNU_LIB)/min-max.h \
+ $(CONFIG_H)
$(BLD)/emacsclient.$(O) : \
- $(SRC)/emacsclient.c \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h
+ $(LIB_SRC)/emacsclient.c \
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H)
$(BLD)/etags.$(O) : \
- $(SRC)/etags.c \
- $(EMACS_ROOT)/nt/inc/sys/param.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h \
- $(SRC)/ntlib.h \
- $(EMACS_ROOT)/lib/getopt.h
-
-$(BLD)/getdate.$(O) : \
- $(SRC)/getdate.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h \
- $(MSTOOLS_SYS)/types.h
+ $(LIB_SRC)/etags.c \
+ $(SRC)/regex.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/c-strcase.h \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H)
$(BLD)/hexl.$(O) : \
- $(SRC)/hexl.c
-
-$(BLD)/leditcfns.$(O) : \
- $(SRC)/leditcfns.c
+ $(LIB_SRC)/hexl.c \
+ $(CONFIG_H)
$(BLD)/make-docfile.$(O) : \
- $(SRC)/make-docfile.c \
- $(EMACS_ROOT)/src/config.h
-
-$(BLD)/make-path.$(O) : \
- $(SRC)/make-path.c
+ $(LIB_SRC)/make-docfile.c \
+ $(NT_INC)/unistd.h \
+ $(CONFIG_H)
$(BLD)/movemail.$(O) : \
- $(SRC)/movemail.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h \
- $(EMACS_ROOT)/nt/inc/sys/file.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/lib-src/../src/syswait.h \
- $(EMACS_ROOT)/nt/inc/pwd.h \
- $(SRC)/ntlib.h
- $(CC) $(CFLAGS) -DUSG $(CC_OUT)$@ movemail.c
+ $(LIB_SRC)/movemail.c \
+ $(LIB_SRC)/pop.h \
+ $(SRC)/syswait.h \
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/sys/file.h \
+ $(NT_INC)/sys/stat.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H) \
+ $(NTLIB_H)
$(BLD)/ntlib.$(O) : \
- $(SRC)/ntlib.c \
- $(SRC)/ntlib.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/nt/inc/pwd.h
+ $(LIB_SRC)/ntlib.c \
+ $(NT_INC)/sys/stat.h \
+ $(NTLIB_H)
$(BLD)/pop.$(O) : \
- $(SRC)/pop.c \
- $(SRC)/pop.h \
- $(EMACS_ROOT)/lib/min-max.h \
- $(SRC)/ntlib.h
+ $(LIB_SRC)/pop.c \
+ $(LIB_SRC)/pop.h \
+ $(NT_INC)/netdb.h \
+ $(NT_INC)/pwd.h \
+ $(NT_INC)/unistd.h \
+ $(GNU_LIB)/min-max.h \
+ $(CONFIG_H) \
+ $(NTLIB_H)
$(BLD)/profile.$(O) : \
- $(SRC)/profile.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h \
- $(EMACS_ROOT)/lib-src/../src/systime.h
-
-$(BLD)/qsort.$(O) : \
- $(SRC)/qsort.c
-
-$(BLD)/tcp.$(O) : \
- $(SRC)/tcp.c
+ $(LIB_SRC)/profile.c \
+ $(GNU_LIB)/intprops.h \
+ $(CONFIG_H) \
+ $(INTTYPES_H) \
+ $(SYSTIME_H)
+
+$(BLD)/regex.$(O) : \
+ $(SRC)/regex.c \
+ $(SRC)/regex.h \
+ $(NT_INC)/stdbool.h \
+ $(NT_INC)/unistd.h \
+ $(CONFIG_H)
$(BLD)/test-distrib.$(O) : \
- $(SRC)/test-distrib.c
-
-$(BLD)/timer.$(O) : \
- $(SRC)/timer.c \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/lib-src/../src/config.h
+ $(LIB_SRC)/test-distrib.c \
+ $(NT_INC)/unistd.h \
+ $(CONFIG_H)
# The following dependencies are for supporting parallel builds, where
# we must make sure $(BLD) exists before any compilation starts.
$(BLD)/emacsclient.$(O) $(BLD)/etags.$(O) $(BLD)/regex.$(O): stamp_BLD
-$(BLD)/ebrowse.$(O) $(BLD)/ctags.$(O): stamp_BLD
+$(BLD)/ebrowse.$(O) $(BLD)/ctags.$(O) $(BLD)/profile.$(O): stamp_BLD
/* 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.
#include <sys/locking.h>
#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
#endif
#endif
-#ifndef HAVE_STRERROR
-char *strerror (int);
-#endif
-
-static void fatal (const char *s1, const char *s2, const char *s3) NO_RETURN;
+static _Noreturn void fatal (const char *s1, const char *s2, const char *s3);
static void error (const char *s1, const char *s2, const char *s3);
-static void pfatal_with_name (char *name) NO_RETURN;
-static void pfatal_and_delete (char *name) NO_RETURN;
-static char *concat (const char *s1, const char *s2, const char *s3);
-static long *xmalloc (unsigned int size);
+static _Noreturn void pfatal_with_name (char *name);
+static _Noreturn void pfatal_and_delete (char *name);
#ifdef MAIL_USE_POP
static int popmail (char *mailbox, char *outfile, int preserve, char *password, int reverse_order);
static int pop_retr (popserver server, int msgno, FILE *arg);
static int mbx_delimit_end (FILE *mbf);
#endif
+#if (defined MAIL_USE_MAILLOCK \
+ || (!defined DISABLE_DIRECT_ACCESS && !defined MAIL_USE_MMDF \
+ && !defined MAIL_USE_SYSTEM_LOCK))
+/* Like malloc but get fatal error if memory is exhausted. */
+
+static void *
+xmalloc (size_t size)
+{
+ void *result = malloc (size);
+ if (!result)
+ fatal ("virtual memory exhausted", 0, 0);
+ return result;
+}
+#endif
+
/* Nonzero means this is name of a lock file to delete on fatal error. */
static char *delete_lockname;
int tem;
char *lockname;
char *tempname;
- size_t inname_dirlen;
+ size_t inname_len, inname_dirlen;
int desc;
#endif /* not MAIL_USE_SYSTEM_LOCK */
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
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.
+ 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. */
-
- lockname = concat (inname, ".lock", "");
- for (inname_dirlen = strlen (inname);
+ inname_len = strlen (inname);
+ lockname = xmalloc (inname_len + sizeof ".lock");
+ strcpy (lockname, inname);
+ strcpy (lockname + inname_len, ".lock");
+ for (inname_dirlen = inname_len;
inname_dirlen && !IS_DIRECTORY_SEP (inname[inname_dirlen - 1]);
inname_dirlen--)
continue;
- tempname = (char *) xmalloc (inname_dirlen + sizeof "EXXXXXX");
+ tempname = xmalloc (inname_dirlen + sizeof "EXXXXXX");
while (1)
{
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
if (stat (MAILDIR, &stat1) < 0)
return NULL;
- indir = (char *) xmalloc (fname - inname + 1);
- strncpy (indir, inname, fname - inname);
+ indir = xmalloc (fname - inname + 1);
+ memcpy (indir, inname, fname - inname);
indir[fname-inname] = '\0';
unlink (name);
fatal ("%s for %s", s, name);
}
-
-/* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */
-
-static char *
-concat (const char *s1, const char *s2, const char *s3)
-{
- size_t len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3);
- char *result = (char *) xmalloc (len1 + len2 + len3 + 1);
-
- strcpy (result, s1);
- strcpy (result + len1, s2);
- strcpy (result + len1 + len2, s3);
- *(result + len1 + len2 + len3) = 0;
-
- return result;
-}
-
-/* Like malloc but get fatal error if memory is exhausted. */
-
-static long *
-xmalloc (unsigned int size)
-{
- long *result = (long *) malloc (size);
- if (!result)
- fatal ("virtual memory exhausted", 0, 0);
- return result;
-}
\f
/* This is the guts of the interface to the Post Office Protocol. */
if (pop_retrieve_first (server, msgno, &line))
{
- char *msg = concat ("Error from POP server: ", pop_error, "");
- strncpy (Errmsg, msg, sizeof (Errmsg));
- Errmsg[sizeof (Errmsg)-1] = '\0';
- free (msg);
+ snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error);
return (NOTOK);
}
if (ret)
{
- char *msg = concat ("Error from POP server: ", pop_error, "");
- strncpy (Errmsg, msg, sizeof (Errmsg));
- Errmsg[sizeof (Errmsg)-1] = '\0';
- free (msg);
+ snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error);
return (NOTOK);
}
}
#endif /* MAIL_USE_POP */
-\f
-#ifndef HAVE_STRERROR
-char *
-strerror (errnum)
- int errnum;
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-
-#endif /* ! HAVE_STRERROR */
-
-
-/* movemail.c ends here */
/* 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.
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 <http://www.gnu.org/licenses/>.
-
-
- Geoff Voelker (voelker@cs.washington.edu) 10-8-94
-*/
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <windows.h>
#include <stdlib.h>
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
return 0;
}
+int
+lstat (const char * path, struct stat * buf)
+{
+ return stat (path, buf);
+}
+
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#else
-#define MAIL_USE_POP
-#endif
#ifdef MAIL_USE_POP
#endif /* KERBEROS */
#ifndef WINDOWSNT
-#if !defined (HAVE_H_ERRNO) || !defined (HAVE_CONFIG_H)
+#ifndef HAVE_H_ERRNO
extern int h_errno;
#endif
#endif
if (strncmp (fromserver, "+OK ", 4))
{
if (0 == strncmp (fromserver, "-ERR", 4))
- {
- strncpy (pop_error, fromserver, ERROR_MAX);
- pop_error[ERROR_MAX-1] = '\0';
- }
+ snprintf (pop_error, ERROR_MAX, "%s", fromserver);
else
{
strcpy (pop_error,
if (strncmp (fromserver, "+OK ", 4))
{
if (! strncmp (fromserver, "-ERR", 4))
- {
- strncpy (pop_error, fromserver, ERROR_MAX);
- pop_error[ERROR_MAX-1] = '\0';
- }
+ snprintf (pop_error, ERROR_MAX, "%s", fromserver);
else
{
strcpy (pop_error,
if (0 == strncmp (*response, "-ERR", 4))
{
- strncpy (pop_error, *response, ERROR_MAX);
- pop_error[ERROR_MAX-1] = '\0';
+ snprintf (pop_error, ERROR_MAX, "%s", *response);
return (-1);
}
else if (0 == strncmp (*response, "+OK", 3))
if (! strncmp (fromserver, "-ERR", 4))
{
- strncpy (pop_error, fromserver, ERROR_MAX);
- pop_error[ERROR_MAX-1] = '\0';
+ snprintf (pop_error, ERROR_MAX, "%s", fromserver);
return (-1);
}
else if (strncmp (fromserver, "+OK ", 4))
sock = socket (PF_INET, SOCK_STREAM, 0);
if (sock < 0)
{
- strcpy (pop_error, POP_SOCKET_ERROR);
- strncat (pop_error, strerror (errno),
- ERROR_MAX - sizeof (POP_SOCKET_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s",
+ POP_SOCKET_ERROR, strerror (errno));
return (-1);
}
if (it->ai_addrlen == sizeof (addr))
{
struct sockaddr_in *in_a = (struct sockaddr_in *) it->ai_addr;
- memcpy (&addr.sin_addr, &in_a->sin_addr, sizeof (addr.sin_addr));
+ addr.sin_addr = in_a->sin_addr;
if (! connect (sock, (struct sockaddr *) &addr, sizeof (addr)))
break;
}
if (! connect_ok)
{
CLOSESOCKET (sock);
- strcpy (pop_error, CONNECT_ERROR);
- strncat (pop_error, strerror (errno),
- ERROR_MAX - sizeof (CONNECT_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s", CONNECT_ERROR, strerror (errno));
return (-1);
}
krb5_auth_con_free (kcontext, auth_context);
if (kcontext)
krb5_free_context (kcontext);
- strcpy (pop_error, KRB_ERROR);
- strncat (pop_error, error_message (rem),
- ERROR_MAX - sizeof (KRB_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s",
+ KRB_ERROR, error_message (rem));
CLOSESOCKET (sock);
return (-1);
}
krb5_free_principal (kcontext, server);
if (rem)
{
- strcpy (pop_error, KRB_ERROR);
- strncat (pop_error, error_message (rem),
- ERROR_MAX - sizeof (KRB_ERROR));
+ int pop_error_len = snprintf (pop_error, ERROR_MAX, "%s%s",
+ KRB_ERROR, error_message (rem));
#if defined HAVE_KRB5_ERROR_TEXT
if (err_ret && err_ret->text.length)
{
- strncat (pop_error, " [server says '",
- ERROR_MAX - strlen (pop_error) - 1);
- strncat (pop_error, err_ret->text.data,
- min (ERROR_MAX - strlen (pop_error) - 1,
- err_ret->text.length));
- strncat (pop_error, "']",
- ERROR_MAX - strlen (pop_error) - 1);
+ int errlen = err_ret->text.length;
+ snprintf (pop_error + pop_error_len, ERROR_MAX - pop_error_len,
+ " [server says '.*%s']", errlen, err_ret->text.data);
}
#elif defined HAVE_KRB5_ERROR_E_TEXT
- if (err_ret && err_ret->e_text && strlen (*err_ret->e_text))
- {
- strncat (pop_error, " [server says '",
- ERROR_MAX - strlen (pop_error) - 1);
- strncat (pop_error, *err_ret->e_text,
- ERROR_MAX - strlen (pop_error) - 1);
- strncat (pop_error, "']",
- ERROR_MAX - strlen (pop_error) - 1);
- }
+ if (err_ret && err_ret->e_text && **err_ret->e_text)
+ snprintf (pop_error + pop_error_len, ERRMAX - pop_error_len,
+ " [server says '%s']", *err_ret->e_text);
#endif
if (err_ret)
krb5_free_error (kcontext, err_ret);
free ((char *) ticket);
if (rem != KSUCCESS)
{
- strcpy (pop_error, KRB_ERROR);
- strncat (pop_error, krb_err_txt[rem],
- ERROR_MAX - sizeof (KRB_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s", KRB_ERROR, krb_err_txt[rem]);
CLOSESOCKET (sock);
return (-1);
}
server->buffer_size - server->data - 1, 0);
if (ret < 0)
{
- strcpy (pop_error, GETLINE_ERROR);
- strncat (pop_error, strerror (errno),
- ERROR_MAX - sizeof (GETLINE_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s",
+ GETLINE_ERROR, strerror (errno));
pop_trash (server);
return (-1);
}
if (ret < 0)
{
pop_trash (server);
- strcpy (pop_error, SENDLINE_ERROR);
- strncat (pop_error, strerror (errno),
- ERROR_MAX - sizeof (SENDLINE_ERROR));
+ snprintf (pop_error, ERROR_MAX, "%s%s", SENDLINE_ERROR, strerror (errno));
return (ret);
}
return (0);
else if (! strncmp (fromline, "-ERR", 4))
{
- strncpy (pop_error, fromline, ERROR_MAX);
- pop_error[ERROR_MAX-1] = '\0';
+ snprintf (pop_error, ERROR_MAX, "%s", fromline);
return (-1);
}
else
/**
- ** To be run as an emacs process. Input string that starts with:
+ ** To be run as an emacs subprocess. Input string that starts with:
** 'z' -- resets the watch (to zero).
** 'p' -- return time (on stdout) as string with format <sec>.<micro-sec>
** 'q' -- exit.
** operations: reset_watch, get_time
*/
#include <config.h>
+
+#define SYSTIME_INLINE EXTERN_INLINE
+
+#include <inttypes.h>
#include <stdio.h>
+
+#include <intprops.h>
#include <systime.h>
-static EMACS_TIME TV1, TV2;
+static EMACS_TIME TV1;
static int watch_not_started = 1; /* flag */
-static char time_string[30];
+static char time_string[INT_STRLEN_BOUND (uintmax_t) + sizeof "."
+ + LOG10_EMACS_TIME_RESOLUTION];
/* Reset the stopwatch to zero. */
static void
reset_watch (void)
{
- EMACS_GET_TIME (TV1);
+ TV1 = current_emacs_time ();
watch_not_started = 0;
}
/* This call returns the time since the last reset_watch call. The time
- is returned as a string with the format <seconds>.<micro-seconds>
+ is returned as a string with the format <seconds>.<nanoseconds>
If reset_watch was not called yet, exit. */
static char *
get_time (void)
{
+ EMACS_TIME TV2 = sub_emacs_time (current_emacs_time (), TV1);
+ uintmax_t s = EMACS_SECS (TV2);
+ int ns = EMACS_NSECS (TV2);
if (watch_not_started)
exit (EXIT_FAILURE); /* call reset_watch first ! */
- EMACS_GET_TIME (TV2);
- EMACS_SUB_TIME (TV2, TV2, TV1);
- sprintf (time_string, "%lu.%06lu", (unsigned long)EMACS_SECS (TV2), (unsigned long)EMACS_USECS (TV2));
+ sprintf (time_string, "%"PRIuMAX".%0*d", s, LOG10_EMACS_TIME_RESOLUTION, ns);
return time_string;
}
-
-#if ! defined (HAVE_GETTIMEOFDAY) && defined (HAVE_TIMEVAL)
-
-/* ARGSUSED */
-gettimeofday (tp, tzp)
- struct timeval *tp;
- struct timezone *tzp;
-{
- extern long time ();
-
- tp->tv_sec = time ((long *)0);
- tp->tv_usec = 0;
- if (tzp != 0)
- tzp->tz_minuteswest = -1;
-}
-
-#endif
\f
int
main (void)
+++ /dev/null
-#! /bin/sh
-
-# This script accepts any number of file arguments and checks them into RCS.
-
-# Copyright (C) 1993-1995, 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 <http://www.gnu.org/licenses/>.
-
-
-# Arguments which are detectably either RCS masters (with names ending in ,v)
-# or Emacs version files (with names of the form foo.~<number>~) are ignored.
-# For each file foo, the script looks for Emacs version files related to it.
-# These files are checked in as deltas, oldest first, so that the contents of
-# the file itself becomes the latest revision in the master.
-#
-# The first line of each file is used as its description text. The file itself
-# is not deleted, as under VC with vc-keep-workfiles at its default of t, but
-# all the version files are.
-#
-# If an argument file is already version-controlled under RCS, any version
-# files are added to the list of deltas and deleted, and then the workfile
-# is checked in again as the latest version. This is probably not quite
-# what was wanted, and is the main reason VC doesn't simply call this to
-# do checkins.
-#
-# This script is intended to be used to convert files with an old-Emacs-style
-# version history for use with VC (the Emacs 19 version-control interface),
-# which likes to use RCS as its back end. It was written by Paul Eggert
-# and revised/documented for use with VC by Eric S. Raymond, Mar 19 1993.
-
-case $# in
-0)
- echo "rcs-checkin: usage: rcs-checkin file ..."
- echo "rcs-checkin: function: checks file.~*~ and file into a new RCS file"
- echo "rcs-checkin: function: uses the file's first line for the description"
-esac
-
-# expr pattern to extract owner from ls -l output
-ls_owner_pattern='[^ ][^ ]* *[^ ][^ ]* *\([^ ][^ ]*\)'
-
-for file
-do
- # Make it easier to say `rcs-checkin *'
- # by ignoring file names that already contain `~', or end in `,v'.
- case $file in
- *~* | *,v) continue
- esac
- # Ignore non-files too.
- test -f "$file" || continue
-
- # Check that file is readable.
- test -r "$file" || exit
-
- # If the RCS file does not already exist,
- # initialize it with a description from $file's first line.
- rlog -R "$file" >/dev/null 2>&1 ||
- rcs -i -q -t-"`sed 1q $file`" "$file" || exit
-
- # Get list of old files.
- oldfiles=`
- ls $file.~[0-9]*~ 2>/dev/null |
- sort -t~ -n -k 2
- `
-
- # Check that they are properly sorted by date.
- case $oldfiles in
- ?*)
- oldfiles_by_date=`ls -rt $file $oldfiles`
- test " $oldfiles
-$file" = " $oldfiles_by_date" || {
- echo >&2 "rcs-checkin: skipping $file, because its mod times are out of order.
-
-Sorted by mod time:
-$oldfiles_by_date
-
-Sorted by name:
-$oldfiles
-$file"
- continue
- }
- esac
-
- echo >&2 rcs-checkin: checking in: $oldfiles $file
-
- # Save $file as $file.~-~ temporarily.
- mv "$file" "$file.~-~" || exit
-
- # Rename each old file to $file, and check it in.
- for oldfile in $oldfiles
- do
- mv "$oldfile" "$file" || exit
- ls_l=`ls -l "$file"` || exit
- owner=-w`expr " $ls_l" : " $ls_owner_pattern"` || owner=
- echo "Formerly ${oldfile}" | ci -d -l -q $owner "$file" || exit
- done
-
- # Bring $file back from $file.~-~, and check it in.
- mv "$file.~-~" "$file" || exit
- ls_l=`ls -l "$file"` || exit
- owner=-w`expr " $ls_l" : " $ls_owner_pattern"` || owner=
- ci -d -q -u $owner -m"entered into RCS" "$file" || exit
-done
-
#include <fcntl.h>
#endif
#include <sys/stat.h>
-
-/* Needed for SunOS4, for instance. */
-extern char *optarg;
-extern int optind, opterr;
-
-static int usage (int err) NO_RETURN;
+#include <getopt.h>
#define MAX_ATTEMPTS 5
#define MAX_SCORES 200
#define difftime(t1, t0) (double)((t1) - (t0))
#endif
-static int
+static _Noreturn void
usage (int err)
{
fprintf (stdout, "Usage: update-game-score [-m MAX] [-r] [-d DIR] game/scorefile SCORE DATA\n");
static int write_scores (const char *filename,
const struct score_entry *scores, int count);
-static void lose (const char *msg) NO_RETURN;
-
-static void
+static _Noreturn void
lose (const char *msg)
{
fprintf (stderr, "%s\n", msg);
exit (EXIT_FAILURE);
}
-static void lose_syserr (const char *msg) NO_RETURN;
-
-/* Taken from sysdep.c. */
-#ifndef HAVE_STRERROR
-#ifndef WINDOWSNT
-char *
-strerror (int errnum)
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-#endif /* not WINDOWSNT */
-#endif /* ! HAVE_STRERROR */
-
-static void
+static _Noreturn void
lose_syserr (const char *msg)
{
fprintf (stderr, "%s: %s\n", msg, strerror (errno));
+++ /dev/null
-#! /bin/sh
-
-# Enhanced sccs diff utility for use with vc mode.
-# This version is more compatible with rcsdiff(1).
-
-# Copyright (C) 1992-1993, 1995, 1997, 2001-2012
-# Free Software Foundation, Inc.
-
-# Author: Paul Eggert
-# (according to authors.el)
-
-# 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 <http://www.gnu.org/licenses/>.
-
-
-DIFF="diff"
-usage="$0: Usage: vcdiff [--brief] [-q] [-r<sid1>] [-r<sid2>] [diffopts] sccsfile..."
-
-# Now that we use `sccs get' rather than just `get', we don't need this.
-# PATH=$PATH:/usr/ccs/bin:/usr/sccs:/usr/xpg4/bin # common SCCS hangouts
-
-echo="echo"
-sid1= sid2=
-
-for f
-do
- case $f in
- -*)
- case $f in
- --brief)
- DIFF=cmp;;
- -q)
- echo=:;;
- -r?*)
- case $sid1 in
- '')
- sid1=$f
- ;;
- *)
- case $sid2 in
- ?*) echo "$usage" >&2; exit 2 ;;
- esac
- sid2=$f
- ;;
- esac
- ;;
- *)
- options="$options $f"
- ;;
- esac
- shift
- ;;
- *)
- break
- ;;
- esac
-done
-
-case $# in
-0)
- echo "$usage" >&2
- exit 2
-esac
-
-
-rev1= rev2= status=0
-trap 'status=2; exit' 1 2 13 15
-trap 'rm -f $rev1 $rev2 || status=2; exit $status' 0
-
-for f
-do
- s=2
-
- case $f in
- s.* | */s.*)
- if
- rev1=`mktemp /tmp/geta.XXXXXXXX`
- sccs get -s -p -k $sid1 "$f" > $rev1 &&
- case $sid2 in
- '')
- workfile=`expr " /$f" : '.*/s.\(.*\)'`
- ;;
- *)
- rev2=`mktemp /tmp/getb.XXXXXXXX`
- sccs get -s -p -k $sid2 "$f" > $rev2
- workfile=$rev2
- esac
- then
- $echo $DIFF $options $rev1 $workfile >&2
- $DIFF $options $rev1 $workfile
- s=$?
- fi
- ;;
- *)
- echo "$0: $f is not an SCCS file" >&2
- esac
-
- if test $status -lt $s
- then status=$s
- fi
-done
-
MOSTLYCLEANFILES =
noinst_LIBRARIES =
-DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src
+AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS)
+DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src
include gnulib.mk
/* Memory allocation on the stack.
- Copyright (C) 1995, 1999, 2001-2004, 2006-2011 Free Software Foundation,
+ Copyright (C) 1995, 1999, 2001-2004, 2006-2012 Free Software Foundation,
Inc.
This program is free software; you can redistribute it and/or modify it
General Public License for more details.
You should have received a copy of the GNU General Public
- License along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
- USA. */
+ License along with this program; if not, see
+ <http://www.gnu.org/licenses/>.
+ */
/* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H
means there is a real alloca function. */
# define alloca _alloca
# elif defined __DECC && defined __VMS
# define alloca __ALLOCA
+# elif defined __TANDEM && defined _TNS_E_TARGET
+# ifdef __cplusplus
+extern "C"
+# endif
+void *_alloca (unsigned short);
+# pragma intrinsic (_alloca)
+# define alloca _alloca
# else
# include <stddef.h>
# ifdef __cplusplus
/* Memory allocators such as malloc+free.
- Copyright (C) 2011 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
--- /dev/null
+/* Character handling in C locale.
+
+ Copyright 2000-2003, 2006, 2009-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
+(at your option) 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 <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+/* Specification. */
+#define NO_C_CTYPE_MACROS
+#include "c-ctype.h"
+
+/* The function isascii is not locale dependent. Its use in EBCDIC is
+ questionable. */
+bool
+c_isascii (int c)
+{
+ return (c >= 0x00 && c <= 0x7f);
+}
+
+bool
+c_isalnum (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+ && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+ return ((c >= '0' && c <= '9')
+ || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z'));
+#else
+ return ((c >= '0' && c <= '9')
+ || (c >= 'A' && c <= 'Z')
+ || (c >= 'a' && c <= 'z'));
+#endif
+#else
+ switch (c)
+ {
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isalpha (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+ return ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z');
+#else
+ return ((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z'));
+#endif
+#else
+ switch (c)
+ {
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isblank (int c)
+{
+ return (c == ' ' || c == '\t');
+}
+
+bool
+c_iscntrl (int c)
+{
+#if C_CTYPE_ASCII
+ return ((c & ~0x1f) == 0 || c == 0x7f);
+#else
+ switch (c)
+ {
+ case ' ': case '!': case '"': case '#': case '$': case '%':
+ case '&': case '\'': case '(': case ')': case '*': case '+':
+ case ',': case '-': case '.': case '/':
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case ':': case ';': case '<': case '=': case '>': case '?':
+ case '@':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case '[': case '\\': case ']': case '^': case '_': case '`':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ case '{': case '|': case '}': case '~':
+ return 0;
+ default:
+ return 1;
+ }
+#endif
+}
+
+bool
+c_isdigit (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS
+ return (c >= '0' && c <= '9');
+#else
+ switch (c)
+ {
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_islower (int c)
+{
+#if C_CTYPE_CONSECUTIVE_LOWERCASE
+ return (c >= 'a' && c <= 'z');
+#else
+ switch (c)
+ {
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isgraph (int c)
+{
+#if C_CTYPE_ASCII
+ return (c >= '!' && c <= '~');
+#else
+ switch (c)
+ {
+ case '!': case '"': case '#': case '$': case '%': case '&':
+ case '\'': case '(': case ')': case '*': case '+': case ',':
+ case '-': case '.': case '/':
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case ':': case ';': case '<': case '=': case '>': case '?':
+ case '@':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case '[': case '\\': case ']': case '^': case '_': case '`':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ case '{': case '|': case '}': case '~':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isprint (int c)
+{
+#if C_CTYPE_ASCII
+ return (c >= ' ' && c <= '~');
+#else
+ switch (c)
+ {
+ case ' ': case '!': case '"': case '#': case '$': case '%':
+ case '&': case '\'': case '(': case ')': case '*': case '+':
+ case ',': case '-': case '.': case '/':
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case ':': case ';': case '<': case '=': case '>': case '?':
+ case '@':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ case '[': case '\\': case ']': case '^': case '_': case '`':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+ case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+ case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+ case 'y': case 'z':
+ case '{': case '|': case '}': case '~':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_ispunct (int c)
+{
+#if C_CTYPE_ASCII
+ return ((c >= '!' && c <= '~')
+ && !((c >= '0' && c <= '9')
+ || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z')));
+#else
+ switch (c)
+ {
+ case '!': case '"': case '#': case '$': case '%': case '&':
+ case '\'': case '(': case ')': case '*': case '+': case ',':
+ case '-': case '.': case '/':
+ case ':': case ';': case '<': case '=': case '>': case '?':
+ case '@':
+ case '[': case '\\': case ']': case '^': case '_': case '`':
+ case '{': case '|': case '}': case '~':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isspace (int c)
+{
+ return (c == ' ' || c == '\t'
+ || c == '\n' || c == '\v' || c == '\f' || c == '\r');
+}
+
+bool
+c_isupper (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE
+ return (c >= 'A' && c <= 'Z');
+#else
+ switch (c)
+ {
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+ case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+ case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+ case 'Y': case 'Z':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+bool
+c_isxdigit (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+ && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+ return ((c >= '0' && c <= '9')
+ || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'F'));
+#else
+ return ((c >= '0' && c <= '9')
+ || (c >= 'A' && c <= 'F')
+ || (c >= 'a' && c <= 'f'));
+#endif
+#else
+ switch (c)
+ {
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ return 1;
+ default:
+ return 0;
+ }
+#endif
+}
+
+int
+c_tolower (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+ return (c >= 'A' && c <= 'Z' ? c - 'A' + 'a' : c);
+#else
+ switch (c)
+ {
+ case 'A': return 'a';
+ case 'B': return 'b';
+ case 'C': return 'c';
+ case 'D': return 'd';
+ case 'E': return 'e';
+ case 'F': return 'f';
+ case 'G': return 'g';
+ case 'H': return 'h';
+ case 'I': return 'i';
+ case 'J': return 'j';
+ case 'K': return 'k';
+ case 'L': return 'l';
+ case 'M': return 'm';
+ case 'N': return 'n';
+ case 'O': return 'o';
+ case 'P': return 'p';
+ case 'Q': return 'q';
+ case 'R': return 'r';
+ case 'S': return 's';
+ case 'T': return 't';
+ case 'U': return 'u';
+ case 'V': return 'v';
+ case 'W': return 'w';
+ case 'X': return 'x';
+ case 'Y': return 'y';
+ case 'Z': return 'z';
+ default: return c;
+ }
+#endif
+}
+
+int
+c_toupper (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+ return (c >= 'a' && c <= 'z' ? c - 'a' + 'A' : c);
+#else
+ switch (c)
+ {
+ case 'a': return 'A';
+ case 'b': return 'B';
+ case 'c': return 'C';
+ case 'd': return 'D';
+ case 'e': return 'E';
+ case 'f': return 'F';
+ case 'g': return 'G';
+ case 'h': return 'H';
+ case 'i': return 'I';
+ case 'j': return 'J';
+ case 'k': return 'K';
+ case 'l': return 'L';
+ case 'm': return 'M';
+ case 'n': return 'N';
+ case 'o': return 'O';
+ case 'p': return 'P';
+ case 'q': return 'Q';
+ case 'r': return 'R';
+ case 's': return 'S';
+ case 't': return 'T';
+ case 'u': return 'U';
+ case 'v': return 'V';
+ case 'w': return 'W';
+ case 'x': return 'X';
+ case 'y': return 'Y';
+ case 'z': return 'Z';
+ default: return c;
+ }
+#endif
+}
--- /dev/null
+/* Character handling in C locale.
+
+ These functions work like the corresponding functions in <ctype.h>,
+ except that they have the C (POSIX) locale hardwired, whereas the
+ <ctype.h> functions' behaviour depends on the current locale set via
+ setlocale.
+
+ Copyright (C) 2000-2003, 2006, 2008-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
+(at your option) 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 <http://www.gnu.org/licenses/>. */
+
+#ifndef C_CTYPE_H
+#define C_CTYPE_H
+
+#include <stdbool.h>
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* The functions defined in this file assume the "C" locale and a character
+ set without diacritics (ASCII-US or EBCDIC-US or something like that).
+ Even if the "C" locale on a particular system is an extension of the ASCII
+ character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it
+ is ISO-8859-1), the functions in this file recognize only the ASCII
+ characters. */
+
+
+/* Check whether the ASCII optimizations apply. */
+
+/* ANSI C89 (and ISO C99 5.2.1.3 too) already guarantees that
+ '0', '1', ..., '9' have consecutive integer values. */
+#define C_CTYPE_CONSECUTIVE_DIGITS 1
+
+#if ('A' <= 'Z') \
+ && ('A' + 1 == 'B') && ('B' + 1 == 'C') && ('C' + 1 == 'D') \
+ && ('D' + 1 == 'E') && ('E' + 1 == 'F') && ('F' + 1 == 'G') \
+ && ('G' + 1 == 'H') && ('H' + 1 == 'I') && ('I' + 1 == 'J') \
+ && ('J' + 1 == 'K') && ('K' + 1 == 'L') && ('L' + 1 == 'M') \
+ && ('M' + 1 == 'N') && ('N' + 1 == 'O') && ('O' + 1 == 'P') \
+ && ('P' + 1 == 'Q') && ('Q' + 1 == 'R') && ('R' + 1 == 'S') \
+ && ('S' + 1 == 'T') && ('T' + 1 == 'U') && ('U' + 1 == 'V') \
+ && ('V' + 1 == 'W') && ('W' + 1 == 'X') && ('X' + 1 == 'Y') \
+ && ('Y' + 1 == 'Z')
+#define C_CTYPE_CONSECUTIVE_UPPERCASE 1
+#endif
+
+#if ('a' <= 'z') \
+ && ('a' + 1 == 'b') && ('b' + 1 == 'c') && ('c' + 1 == 'd') \
+ && ('d' + 1 == 'e') && ('e' + 1 == 'f') && ('f' + 1 == 'g') \
+ && ('g' + 1 == 'h') && ('h' + 1 == 'i') && ('i' + 1 == 'j') \
+ && ('j' + 1 == 'k') && ('k' + 1 == 'l') && ('l' + 1 == 'm') \
+ && ('m' + 1 == 'n') && ('n' + 1 == 'o') && ('o' + 1 == 'p') \
+ && ('p' + 1 == 'q') && ('q' + 1 == 'r') && ('r' + 1 == 's') \
+ && ('s' + 1 == 't') && ('t' + 1 == 'u') && ('u' + 1 == 'v') \
+ && ('v' + 1 == 'w') && ('w' + 1 == 'x') && ('x' + 1 == 'y') \
+ && ('y' + 1 == 'z')
+#define C_CTYPE_CONSECUTIVE_LOWERCASE 1
+#endif
+
+#if (' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+ && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+ && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+ && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+ && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+ && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+ && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+ && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+ && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+ && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+ && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+ && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+ && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+ && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+ && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+ && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+ && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+ && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+ && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+ && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+ && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+ && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+ && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126)
+/* The character set is ASCII or one of its variants or extensions, not EBCDIC.
+ Testing the value of '\n' and '\r' is not relevant. */
+#define C_CTYPE_ASCII 1
+#endif
+
+
+/* Function declarations. */
+
+/* Unlike the functions in <ctype.h>, which require an argument in the range
+ of the 'unsigned char' type, the functions here operate on values that are
+ in the 'unsigned char' range or in the 'char' range. In other words,
+ when you have a 'char' value, you need to cast it before using it as
+ argument to a <ctype.h> function:
+
+ const char *s = ...;
+ if (isalpha ((unsigned char) *s)) ...
+
+ but you don't need to cast it for the functions defined in this file:
+
+ const char *s = ...;
+ if (c_isalpha (*s)) ...
+ */
+
+extern bool c_isascii (int c) _GL_ATTRIBUTE_CONST; /* not locale dependent */
+
+extern bool c_isalnum (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isalpha (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isblank (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_iscntrl (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isdigit (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_islower (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isgraph (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isprint (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_ispunct (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isspace (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isupper (int c) _GL_ATTRIBUTE_CONST;
+extern bool c_isxdigit (int c) _GL_ATTRIBUTE_CONST;
+
+extern int c_tolower (int c) _GL_ATTRIBUTE_CONST;
+extern int c_toupper (int c) _GL_ATTRIBUTE_CONST;
+
+
+#if defined __GNUC__ && defined __OPTIMIZE__ && !defined __OPTIMIZE_SIZE__ && !defined NO_C_CTYPE_MACROS
+
+/* ASCII optimizations. */
+
+#undef c_isascii
+#define c_isascii(c) \
+ ({ int __c = (c); \
+ (__c >= 0x00 && __c <= 0x7f); \
+ })
+
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+ && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isalnum
+#define c_isalnum(c) \
+ ({ int __c = (c); \
+ ((__c >= '0' && __c <= '9') \
+ || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z')); \
+ })
+#else
+#undef c_isalnum
+#define c_isalnum(c) \
+ ({ int __c = (c); \
+ ((__c >= '0' && __c <= '9') \
+ || (__c >= 'A' && __c <= 'Z') \
+ || (__c >= 'a' && __c <= 'z')); \
+ })
+#endif
+#endif
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isalpha
+#define c_isalpha(c) \
+ ({ int __c = (c); \
+ ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z'); \
+ })
+#else
+#undef c_isalpha
+#define c_isalpha(c) \
+ ({ int __c = (c); \
+ ((__c >= 'A' && __c <= 'Z') || (__c >= 'a' && __c <= 'z')); \
+ })
+#endif
+#endif
+
+#undef c_isblank
+#define c_isblank(c) \
+ ({ int __c = (c); \
+ (__c == ' ' || __c == '\t'); \
+ })
+
+#if C_CTYPE_ASCII
+#undef c_iscntrl
+#define c_iscntrl(c) \
+ ({ int __c = (c); \
+ ((__c & ~0x1f) == 0 || __c == 0x7f); \
+ })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_DIGITS
+#undef c_isdigit
+#define c_isdigit(c) \
+ ({ int __c = (c); \
+ (__c >= '0' && __c <= '9'); \
+ })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_LOWERCASE
+#undef c_islower
+#define c_islower(c) \
+ ({ int __c = (c); \
+ (__c >= 'a' && __c <= 'z'); \
+ })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_isgraph
+#define c_isgraph(c) \
+ ({ int __c = (c); \
+ (__c >= '!' && __c <= '~'); \
+ })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_isprint
+#define c_isprint(c) \
+ ({ int __c = (c); \
+ (__c >= ' ' && __c <= '~'); \
+ })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_ispunct
+#define c_ispunct(c) \
+ ({ int _c = (c); \
+ (c_isgraph (_c) && ! c_isalnum (_c)); \
+ })
+#endif
+
+#undef c_isspace
+#define c_isspace(c) \
+ ({ int __c = (c); \
+ (__c == ' ' || __c == '\t' \
+ || __c == '\n' || __c == '\v' || __c == '\f' || __c == '\r'); \
+ })
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE
+#undef c_isupper
+#define c_isupper(c) \
+ ({ int __c = (c); \
+ (__c >= 'A' && __c <= 'Z'); \
+ })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+ && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isxdigit
+#define c_isxdigit(c) \
+ ({ int __c = (c); \
+ ((__c >= '0' && __c <= '9') \
+ || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'F')); \
+ })
+#else
+#undef c_isxdigit
+#define c_isxdigit(c) \
+ ({ int __c = (c); \
+ ((__c >= '0' && __c <= '9') \
+ || (__c >= 'A' && __c <= 'F') \
+ || (__c >= 'a' && __c <= 'f')); \
+ })
+#endif
+#endif
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#undef c_tolower
+#define c_tolower(c) \
+ ({ int __c = (c); \
+ (__c >= 'A' && __c <= 'Z' ? __c - 'A' + 'a' : __c); \
+ })
+#undef c_toupper
+#define c_toupper(c) \
+ ({ int __c = (c); \
+ (__c >= 'a' && __c <= 'z' ? __c - 'a' + 'A' : __c); \
+ })
+#endif
+
+#endif /* optimizing for speed */
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* C_CTYPE_H */
--- /dev/null
+/* Case-insensitive string comparison functions in C locale.
+ Copyright (C) 1995-1996, 2001, 2003, 2005, 2009-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, or (at your option)
+ 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 <http://www.gnu.org/licenses/>. */
+
+#ifndef C_STRCASE_H
+#define C_STRCASE_H
+
+#include <stddef.h>
+
+
+/* The functions defined in this file assume the "C" locale and a character
+ set without diacritics (ASCII-US or EBCDIC-US or something like that).
+ Even if the "C" locale on a particular system is an extension of the ASCII
+ character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it
+ is ISO-8859-1), the functions in this file recognize only the ASCII
+ characters. More precisely, one of the string arguments must be an ASCII
+ string; the other one can also contain non-ASCII characters (but then
+ the comparison result will be nonzero). */
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Compare strings S1 and S2, ignoring case, returning less than, equal to or
+ greater than zero if S1 is lexicographically less than, equal to or greater
+ than S2. */
+extern int c_strcasecmp (const char *s1, const char *s2) _GL_ATTRIBUTE_PURE;
+
+/* Compare no more than N characters of strings S1 and S2, ignoring case,
+ returning less than, equal to or greater than zero if S1 is
+ lexicographically less than, equal to or greater than S2. */
+extern int c_strncasecmp (const char *s1, const char *s2, size_t n)
+ _GL_ATTRIBUTE_PURE;
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* C_STRCASE_H */
--- /dev/null
+/* c-strcasecmp.c -- case insensitive string comparator in C locale
+ Copyright (C) 1998-1999, 2005-2006, 2009-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, or (at your option)
+ 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 <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+/* Specification. */
+#include "c-strcase.h"
+
+#include <limits.h>
+
+#include "c-ctype.h"
+
+int
+c_strcasecmp (const char *s1, const char *s2)
+{
+ register const unsigned char *p1 = (const unsigned char *) s1;
+ register const unsigned char *p2 = (const unsigned char *) s2;
+ unsigned char c1, c2;
+
+ if (p1 == p2)
+ return 0;
+
+ do
+ {
+ c1 = c_tolower (*p1);
+ c2 = c_tolower (*p2);
+
+ if (c1 == '\0')
+ break;
+
+ ++p1;
+ ++p2;
+ }
+ while (c1 == c2);
+
+ if (UCHAR_MAX <= INT_MAX)
+ return c1 - c2;
+ else
+ /* On machines where 'char' and 'int' are types of the same size, the
+ difference of two 'unsigned char' values - including the sign bit -
+ doesn't fit in an 'int'. */
+ return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}
--- /dev/null
+/* c-strncasecmp.c -- case insensitive string comparator in C locale
+ Copyright (C) 1998-1999, 2005-2006, 2009-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, or (at your option)
+ 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 <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+/* Specification. */
+#include "c-strcase.h"
+
+#include <limits.h>
+
+#include "c-ctype.h"
+
+int
+c_strncasecmp (const char *s1, const char *s2, size_t n)
+{
+ register const unsigned char *p1 = (const unsigned char *) s1;
+ register const unsigned char *p2 = (const unsigned char *) s2;
+ unsigned char c1, c2;
+
+ if (p1 == p2 || n == 0)
+ return 0;
+
+ do
+ {
+ c1 = c_tolower (*p1);
+ c2 = c_tolower (*p2);
+
+ if (--n == 0 || c1 == '\0')
+ break;
+
+ ++p1;
+ ++p2;
+ }
+ while (c1 == c2);
+
+ if (UCHAR_MAX <= INT_MAX)
+ return c1 - c2;
+ else
+ /* On machines where 'char' and 'int' are types of the same size, the
+ difference of two 'unsigned char' values - including the sign bit -
+ doesn't fit in an 'int'. */
+ return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}
/* Read symbolic links into a buffer without size limitation, relative to fd.
- Copyright (C) 2001, 2003-2004, 2007, 2009-2011 Free Software Foundation,
+ Copyright (C) 2001, 2003-2004, 2007, 2009-2012 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
/* Read symbolic links into a buffer without size limitation, relative to fd.
- Copyright (C) 2011 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
/* File names on MS-DOS/Windows systems.
- Copyright (C) 2000-2001, 2004-2006, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2000-2001, 2004-2006, 2009-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
--- /dev/null
+/* Convert double to timespec.
+
+ Copyright (C) 2011-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
+ (at your option) 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 <http://www.gnu.org/licenses/>. */
+
+/* written by Paul Eggert */
+
+/* Convert the double value SEC to a struct timespec. Round toward
+ positive infinity. On overflow, return an extremal value. */
+
+#include <config.h>
+
+#include "timespec.h"
+
+#include "intprops.h"
+
+struct timespec
+dtotimespec (double sec)
+{
+ enum { BILLION = 1000 * 1000 * 1000 };
+ double min_representable = TYPE_MINIMUM (time_t);
+ double max_representable =
+ ((TYPE_MAXIMUM (time_t) * (double) BILLION + (BILLION - 1))
+ / BILLION);
+ struct timespec r;
+
+ if (! (min_representable < sec))
+ {
+ r.tv_sec = TYPE_MINIMUM (time_t);
+ r.tv_nsec = 0;
+ }
+ else if (! (sec < max_representable))
+ {
+ r.tv_sec = TYPE_MAXIMUM (time_t);
+ r.tv_nsec = BILLION - 1;
+ }
+ else
+ {
+ time_t s = sec;
+ double frac = BILLION * (sec - s);
+ long ns = frac;
+ ns += ns < frac;
+ s += ns / BILLION;
+ ns %= BILLION;
+
+ if (ns < 0)
+ {
+ s--;
+ ns += BILLION;
+ }
+
+ r.tv_sec = s;
+ r.tv_nsec = ns;
+ }
+
+ return r;
+}
/* Duplicate an open file descriptor to a specified file descriptor.
- Copyright (C) 1999, 2004-2007, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2004-2007, 2009-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
# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
-/* Get declarations of the Win32 API functions. */
+/* Get declarations of the native Windows API functions. */
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
--- /dev/null
+#include <config.h>
+#define _GL_EXECINFO_INLINE _GL_EXTERN_INLINE
+#include "execinfo.h"
--- /dev/null
+/* Information about executables.
+
+ Copyright (C) 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
+ (at your option) 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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+#ifndef _GL_EXECINFO_H
+#define _GL_EXECINFO_H
+
+_GL_INLINE_HEADER_BEGIN
+#ifndef _GL_EXECINFO_INLINE
+# define _GL_EXECINFO_INLINE _GL_INLINE
+#endif
+
+_GL_EXECINFO_INLINE int
+backtrace (void **buffer, int size)
+{
+ (void) buffer;
+ (void) size;
+ return 0;
+}
+
+_GL_EXECINFO_INLINE char **
+backtrace_symbols (void *const *buffer, int size)
+{
+ (void) buffer;
+ (void) size;
+ return 0;
+}
+
+_GL_EXECINFO_INLINE void
+backtrace_symbols_fd (void *const *buffer, int size, int fd)
+{
+ (void) buffer;
+ (void) size;
+ (void) fd;
+}
+
+_GL_INLINE_HEADER_END
+
+#endif
/* filemode.c -- make a string describing file modes
- Copyright (C) 1985, 1990, 1993, 1998-2000, 2004, 2006, 2009-2011 Free
+ Copyright (C) 1985, 1990, 1993, 1998-2000, 2004, 2006, 2009-2012 Free
Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
#include "filemode.h"
/* The following is for Cray DMF (Data Migration Facility), which is a
- HSM file system. A migrated file has a `st_dm_mode' that is
- different from the normal `st_mode', so any tests for migrated
+ HSM file system. A migrated file has a 'st_dm_mode' that is
+ different from the normal 'st_mode', so any tests for migrated
files should use the former. */
#if HAVE_ST_DM_MODE
# define IS_MIGRATED_FILE(statp) \
/* Make a string describing file modes.
- Copyright (C) 1998-1999, 2003, 2006, 2009-2011 Free Software Foundation,
+ Copyright (C) 1998-1999, 2003, 2006, 2009-2012 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
/* Get the declaration of strmode. */
# if HAVE_DECL_STRMODE
-# include <string.h> /* MacOS X, FreeBSD, OpenBSD */
+# include <string.h> /* Mac OS X, FreeBSD, OpenBSD */
# include <unistd.h> /* NetBSD */
# endif
/* floating point to accurate string
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-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
#include "ftoastr.h"
-#include "intprops.h"
#include <float.h>
#include <stdio.h>
#include <stdlib.h>
/* floating point to accurate string
- Copyright (C) 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2010-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
FTOASTR_ALWAYS_SIGNED = 2,
/* Output " " before positive numbers; ignored if
- FTOASTER_ALWAYS_SIGNED is also given. */
+ FTOASTR_ALWAYS_SIGNED is also given. */
FTOASTR_SPACE_POSITIVE = 4,
/* Pad with zeros instead of spaces; ignored if FTOASTR_LEFT_JUSTIFY
/* Get the system load averages.
- Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2011 Free Software
+ Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2012 Free Software
Foundation, Inc.
NOTE: The canonical source of this file is maintained with gnulib.
macro that comes with autoconf 2.13 or newer.
If that isn't an option, then just put
AC_CHECK_FUNCS(pstat_getdynamic) in your
- configure.in file.
+ configure.ac file.
HAVE_LIBPERFSTAT Define this if your system has the
perfstat_cpu_total function in libperfstat (AIX).
FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist.
NLIST_STRUCT Include nlist.h, not a.out.h.
N_NAME_POINTER The nlist n_name element is a pointer,
not an array.
- HAVE_STRUCT_NLIST_N_UN_N_NAME `n_un.n_name' is member of `struct nlist'.
+ HAVE_STRUCT_NLIST_N_UN_N_NAME 'n_un.n_name' is member of 'struct nlist'.
LINUX_LDAV_FILE [__linux__, __CYGWIN__]: File containing
load averages.
We also #define LDAV_PRIVILEGED if a program will require
special installation to be able to call getloadavg. */
-/* "configure" defines CONFIGURING_GETLOADAVG to sidestep problems
- with partially-configured source directories. */
-
-#ifndef CONFIGURING_GETLOADAVG
-# include <config.h>
-# include <stdbool.h>
-#endif
+#include <config.h>
/* Specification. */
#include <stdlib.h>
#include <errno.h>
+#include <stdbool.h>
#include <stdio.h>
# include <sys/types.h>
-/* Both the Emacs and non-Emacs sections want this. Some
- configuration files' definitions for the LOAD_AVE_CVT macro (like
- sparc.h's) use macros like FSCALE, defined here. */
-# if defined (unix) || defined (__unix)
+# if HAVE_SYS_PARAM_H
# include <sys/param.h>
# endif
# include "intprops.h"
-/* The existing Emacs configuration files define a macro called
- LOAD_AVE_CVT, which accepts a value of type LOAD_AVE_TYPE, and
- returns the load average multiplied by 100. What we actually want
- is a macro called LDAV_CVT, which returns the load average as an
- unmultiplied double.
-
- For backwards compatibility, we'll define LDAV_CVT in terms of
- LOAD_AVE_CVT, but future machine config files should just define
- LDAV_CVT directly. */
-
-# if !defined (LDAV_CVT) && defined (LOAD_AVE_CVT)
-# define LDAV_CVT(n) (LOAD_AVE_CVT (n) / 100.0)
-# endif
-
# if !defined (BSD) && defined (ultrix)
/* Ultrix behaves like BSD on Vaxen. */
# define BSD
# define LDAV_DONE
/* This call can return -1 for an error, but with good args
it's not supposed to fail. The first argument is for no
- apparent reason of type `long int *'. */
+ apparent reason of type 'long int *'. */
dg_sys_info ((long int *) &load_info,
DG_SYS_INFO_LOAD_INFO_TYPE,
DG_SYS_INFO_LOAD_VERSION_0);
NOTE: getopt is part of the C library, so if you don't know what
"Keep this file name-space clean" means, talk to drepper@gnu.org
before changing it!
- Copyright (C) 1987-1996, 1998-2004, 2006, 2008-2011 Free Software
+ Copyright (C) 1987-1996, 1998-2004, 2006, 2008-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
# include <wchar.h>
#endif
-/* This version of `getopt' appears to the caller like standard Unix `getopt'
+/* This version of 'getopt' appears to the caller like standard Unix 'getopt'
but it behaves differently for the user, since it allows the user
to intersperse the options with the other arguments.
- As `getopt_long' works, it permutes the elements of ARGV so that,
+ As 'getopt_long' works, it permutes the elements of ARGV so that,
when it is done, all the options precede everything else. Thus
all application programs are extended to handle flexible argument order.
- Using `getopt' or setting the environment variable POSIXLY_CORRECT
+ Using 'getopt' or setting the environment variable POSIXLY_CORRECT
disables permutation.
Then the behavior is completely standard.
#include "getopt_int.h"
-/* For communication from `getopt' to the caller.
- When `getopt' finds an option that takes an argument,
+/* For communication from 'getopt' to the caller.
+ When 'getopt' finds an option that takes an argument,
the argument value is returned here.
- Also, when `ordering' is RETURN_IN_ORDER,
+ Also, when 'ordering' is RETURN_IN_ORDER,
each non-option ARGV-element is returned here. */
char *optarg;
/* Index in ARGV of the next element to be scanned.
This is used for communication to and from the caller
- and for communication between successive calls to `getopt'.
+ and for communication between successive calls to 'getopt'.
- On entry to `getopt', zero means this is the first call; initialize.
+ On entry to 'getopt', zero means this is the first call; initialize.
- When `getopt' returns -1, this is the index of the first of the
+ When 'getopt' returns -1, this is the index of the first of the
non-option elements that the caller should itself scan.
- Otherwise, `optind' communicates from one call to the next
+ Otherwise, 'optind' communicates from one call to the next
how much of ARGV has been scanned so far. */
/* 1003.2 says this must be 1 before any call. */
The other is elements [last_nonopt,optind), which contains all
the options processed since those non-options were skipped.
- `first_nonopt' and `last_nonopt' are relocated so that they describe
+ 'first_nonopt' and 'last_nonopt' are relocated so that they describe
the new indices of the non-options in ARGV after they are moved. */
static void
but it consists of two parts that need to be swapped next. */
#if defined _LIBC && defined USE_NONOPTION_FLAGS
- /* First make sure the handling of the `__getopt_nonoption_flags'
+ /* First make sure the handling of the '__getopt_nonoption_flags'
string can work normally. Our top argument must be in the range
of the string. */
if (d->__nonoption_flags_len > 0 && top >= d->__nonoption_flags_max_len)
If an element of ARGV starts with '-', and is not exactly "-" or "--",
then it is an option element. The characters of this element
- (aside from the initial '-') are option characters. If `getopt'
+ (aside from the initial '-') are option characters. If 'getopt'
is called repeatedly, it returns successively each of the option characters
from each of the option elements.
- If `getopt' finds another option character, it returns that character,
- updating `optind' and `nextchar' so that the next call to `getopt' can
+ If 'getopt' finds another option character, it returns that character,
+ updating 'optind' and 'nextchar' so that the next call to 'getopt' can
resume the scan with the following option character or ARGV-element.
- If there are no more option characters, `getopt' returns -1.
- Then `optind' is the index in ARGV of the first ARGV-element
+ If there are no more option characters, 'getopt' returns -1.
+ Then 'optind' is the index in ARGV of the first ARGV-element
that is not an option. (The ARGV-elements have been permuted
so that those that are not options now come last.)
OPTSTRING is a string containing the legitimate option characters.
If an option character is seen that is not listed in OPTSTRING,
- return '?' after printing an error message. If you set `opterr' to
+ return '?' after printing an error message. If you set 'opterr' to
zero, the error message is suppressed but we still return '?'.
If a char in OPTSTRING is followed by a colon, that means it wants an arg,
so the following text in the same ARGV-element, or the text of the following
- ARGV-element, is returned in `optarg'. Two colons mean an option that
+ ARGV-element, is returned in 'optarg'. Two colons mean an option that
wants an optional arg; if there is text in the current ARGV-element,
- it is returned in `optarg', otherwise `optarg' is set to zero.
+ it is returned in 'optarg', otherwise 'optarg' is set to zero.
- If OPTSTRING starts with `-' or `+', it requests different methods of
+ If OPTSTRING starts with '-' or '+', it requests different methods of
handling the non-option ARGV-elements.
See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above.
- Long-named options begin with `--' instead of `-'.
+ Long-named options begin with '--' instead of '-'.
Their names may be abbreviated as long as the abbreviation is unique
or is an exact match for some defined option. If they have an
argument, it follows the option name in the same ARGV-element, separated
- from the option name by a `=', or else the in next ARGV-element.
- When `getopt' finds a long-named option, it returns 0 if that option's
- `flag' field is nonzero, the value of the option's `val' field
- if the `flag' field is zero.
+ from the option name by a '=', or else the in next ARGV-element.
+ When 'getopt' finds a long-named option, it returns 0 if that option's
+ 'flag' field is nonzero, the value of the option's 'val' field
+ if the 'flag' field is zero.
The elements of ARGV aren't really const, because we permute them.
But we pretend they're const in the prototype to be compatible
with other systems.
- LONGOPTS is a vector of `struct option' terminated by an
+ LONGOPTS is a vector of 'struct option' terminated by an
element containing a name which is zero.
LONGIND returns the index in LONGOPT of the long-named option found.
d->__last_nonopt = d->optind;
}
- /* The special ARGV-element `--' means premature end of options.
+ /* The special ARGV-element '--' means premature end of options.
Skip it like a null option,
then exchange with previous non-options as if it were an option,
then skip everything else like a non-option. */
char c = *d->__nextchar++;
const char *temp = strchr (optstring, c);
- /* Increment `optind' when we start to process its last character. */
+ /* Increment 'optind' when we start to process its last character. */
if (*d->__nextchar == '\0')
++d->optind;
return c;
}
else
- /* We already incremented `d->optind' once;
+ /* We already incremented 'd->optind' once;
increment it again when taking next ARGV-elt as argument. */
d->optarg = argv[d->optind++];
c = '?';
}
else
- /* We already incremented `optind' once;
+ /* We already incremented 'optind' once;
increment it again when taking next ARGV-elt as argument. */
d->optarg = argv[d->optind++];
d->__nextchar = NULL;
#ifdef TEST
/* Compile with -DTEST to make an executable for use in testing
- the above definition of `getopt'. */
+ the above definition of 'getopt'. */
int
main (int argc, char **argv)
/* Declarations for getopt.
- Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2011 Free Software
+ Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
getopt_long_only can permute argv; this is required for backward
compatibility (e.g., for LSB 2.0.1).
- This used to be `#if defined __GETOPT_PREFIX && !defined __need_getopt',
+ This used to be '#if defined __GETOPT_PREFIX && !defined __need_getopt',
but it caused redefinition warnings if both unistd.h and getopt.h were
included, since unistd.h includes getopt.h having previously defined
__need_getopt.
extern "C" {
#endif
-/* For communication from `getopt' to the caller.
- When `getopt' finds an option that takes an argument,
+/* For communication from 'getopt' to the caller.
+ When 'getopt' finds an option that takes an argument,
the argument value is returned here.
- Also, when `ordering' is RETURN_IN_ORDER,
+ Also, when 'ordering' is RETURN_IN_ORDER,
each non-option ARGV-element is returned here. */
extern char *optarg;
/* Index in ARGV of the next element to be scanned.
This is used for communication to and from the caller
- and for communication between successive calls to `getopt'.
+ and for communication between successive calls to 'getopt'.
- On entry to `getopt', zero means this is the first call; initialize.
+ On entry to 'getopt', zero means this is the first call; initialize.
- When `getopt' returns -1, this is the index of the first of the
+ When 'getopt' returns -1, this is the index of the first of the
non-option elements that the caller should itself scan.
- Otherwise, `optind' communicates from one call to the next
+ Otherwise, 'optind' communicates from one call to the next
how much of ARGV has been scanned so far. */
extern int optind;
-/* Callers store zero here to inhibit the error message `getopt' prints
+/* Callers store zero here to inhibit the error message 'getopt' prints
for unrecognized options. */
extern int opterr;
#ifndef __need_getopt
/* Describe the long-named options requested by the application.
The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
- of `struct option' terminated by an element containing a name which is
+ of 'struct option' terminated by an element containing a name which is
zero.
- The field `has_arg' is:
+ The field 'has_arg' is:
no_argument (or 0) if the option does not take an argument,
required_argument (or 1) if the option requires an argument,
optional_argument (or 2) if the option takes an optional argument.
- If the field `flag' is not NULL, it points to a variable that is set
- to the value given in the field `val' when the option is found, but
+ If the field 'flag' is not NULL, it points to a variable that is set
+ to the value given in the field 'val' when the option is found, but
left unchanged if the option is not found.
- To have a long-named option do something other than set an `int' to
- a compiled-in constant, such as set a value from `optarg', set the
- option's `flag' field to zero and its `val' field to a nonzero
+ To have a long-named option do something other than set an 'int' to
+ a compiled-in constant, such as set a value from 'optarg', set the
+ option's 'flag' field to zero and its 'val' field to a nonzero
value (the equivalent single-letter option character, if there is
- one). For long options that have a zero `flag' field, `getopt'
- returns the contents of the `val' field. */
+ one). For long options that have a zero 'flag' field, 'getopt'
+ returns the contents of the 'val' field. */
# if !GNULIB_defined_struct_option
struct option
# define GNULIB_defined_struct_option 1
# endif
-/* Names for the values of the `has_arg' field of `struct option'. */
+/* Names for the values of the 'has_arg' field of 'struct option'. */
# define no_argument 0
# define required_argument 1
Return the option character from OPTS just read. Return -1 when
there are no more options. For unrecognized options, or options
- missing arguments, `optopt' is set to the option letter, and '?' is
+ missing arguments, 'optopt' is set to the option letter, and '?' is
returned.
The OPTS string is a list of characters which are recognized option
letters, optionally followed by colons, specifying that that letter
- takes an argument, to be placed in `optarg'.
+ takes an argument, to be placed in 'optarg'.
If a letter in OPTS is followed by two colons, its argument is
- optional. This behavior is specific to the GNU `getopt'.
+ optional. This behavior is specific to the GNU 'getopt'.
- The argument `--' causes premature termination of argument
- scanning, explicitly telling `getopt' that there are no more
+ The argument '--' causes premature termination of argument
+ scanning, explicitly telling 'getopt' that there are no more
options.
- If OPTS begins with `-', then non-option arguments are treated as
+ If OPTS begins with '-', then non-option arguments are treated as
arguments to the option '\1'. This behavior is specific to the GNU
- `getopt'. If OPTS begins with `+', or POSIXLY_CORRECT is set in
+ 'getopt'. If OPTS begins with '+', or POSIXLY_CORRECT is set in
the environment, then do not permute arguments. */
extern int getopt (int ___argc, char *const *___argv, const char *__shortopts)
/* getopt_long and getopt_long_only entry points for GNU getopt.
- Copyright (C) 1987-1994, 1996-1998, 2004, 2006, 2009-2011 Free Software
+ Copyright (C) 1987-1994, 1996-1998, 2004, 2006, 2009-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
break;
case 'c':
- printf ("option c with value `%s'\n", optarg);
+ printf ("option c with value '%s'\n", optarg);
break;
case 'd':
- printf ("option d with value `%s'\n", optarg);
+ printf ("option d with value '%s'\n", optarg);
break;
case '?':
-/* Declarations for getopt.\r
- Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2011 Free Software\r
- Foundation, Inc.\r
- This file is part of the GNU C Library.\r
-\r
- This program is free software: you can redistribute it and/or modify\r
- it under the terms of the GNU General Public License as published by\r
- the Free Software Foundation; either version 3 of the License, or\r
- (at your option) any later version.\r
-\r
- This program is distributed in the hope that it will be useful,\r
- but WITHOUT ANY WARRANTY; without even the implied warranty of\r
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
- GNU General Public License for more details.\r
-\r
- You should have received a copy of the GNU General Public License\r
- along with this program. If not, see <http://www.gnu.org/licenses/>. */\r
-\r
-#ifndef _GL_GETOPT_H\r
-\r
-#if __GNUC__ >= 3\r
-#pragma GCC system_header\r
-#endif\r
-\r
-\r
-/* The include_next requires a split double-inclusion guard. We must\r
- also inform the replacement unistd.h to not recursively use\r
- <getopt.h>; our definitions will be present soon enough. */\r
-#if HAVE_GETOPT_H\r
-# define _GL_SYSTEM_GETOPT\r
-# ifndef __GNUC__\r
-# include <next_getopt.h>\r
-# else\r
-# include_next <getopt.h>\r
-# endif\r
-# undef _GL_SYSTEM_GETOPT\r
-#endif\r
-\r
-#ifndef _GL_GETOPT_H\r
-\r
-#ifndef __need_getopt\r
-# define _GL_GETOPT_H 1\r
-#endif\r
-\r
-/* Standalone applications should #define __GETOPT_PREFIX to an\r
- identifier that prefixes the external functions and variables\r
- defined in this header. When this happens, include the\r
- headers that might declare getopt so that they will not cause\r
- confusion if included after this file (if the system had <getopt.h>,\r
- we have already included it). Then systematically rename\r
- identifiers so that they do not collide with the system functions\r
- and variables. Renaming avoids problems with some compilers and\r
- linkers. */\r
-#if defined __GETOPT_PREFIX && !defined __need_getopt\r
-# if !HAVE_GETOPT_H\r
-# include <stdlib.h>\r
-# include <stdio.h>\r
-# include <unistd.h>\r
-# endif\r
-# undef __need_getopt\r
-# undef getopt\r
-# undef getopt_long\r
-# undef getopt_long_only\r
-# undef optarg\r
-# undef opterr\r
-# undef optind\r
-# undef optopt\r
-# undef option\r
-# define __GETOPT_CONCAT(x, y) x ## y\r
-# define __GETOPT_XCONCAT(x, y) __GETOPT_CONCAT (x, y)\r
-# define __GETOPT_ID(y) __GETOPT_XCONCAT (__GETOPT_PREFIX, y)\r
-# define getopt __GETOPT_ID (getopt)\r
-# define getopt_long __GETOPT_ID (getopt_long)\r
-# define getopt_long_only __GETOPT_ID (getopt_long_only)\r
-# define optarg __GETOPT_ID (optarg)\r
-# define opterr __GETOPT_ID (opterr)\r
-# define optind __GETOPT_ID (optind)\r
-# define optopt __GETOPT_ID (optopt)\r
-# define option __GETOPT_ID (option)\r
-# define _getopt_internal __GETOPT_ID (getopt_internal)\r
-#endif\r
-\r
-/* Standalone applications get correct prototypes for getopt_long and\r
- getopt_long_only; they declare "char **argv". libc uses prototypes\r
- with "char *const *argv" that are incorrect because getopt_long and\r
- getopt_long_only can permute argv; this is required for backward\r
- compatibility (e.g., for LSB 2.0.1).\r
-\r
- This used to be `#if defined __GETOPT_PREFIX && !defined __need_getopt',\r
- but it caused redefinition warnings if both unistd.h and getopt.h were\r
- included, since unistd.h includes getopt.h having previously defined\r
- __need_getopt.\r
-\r
- The only place where __getopt_argv_const is used is in definitions\r
- of getopt_long and getopt_long_only below, but these are visible\r
- only if __need_getopt is not defined, so it is quite safe to rewrite\r
- the conditional as follows:\r
-*/\r
-#if !defined __need_getopt\r
-# if defined __GETOPT_PREFIX\r
-# define __getopt_argv_const /* empty */\r
-# else\r
-# define __getopt_argv_const const\r
-# endif\r
-#endif\r
-\r
-/* If __GNU_LIBRARY__ is not already defined, either we are being used\r
- standalone, or this is the first header included in the source file.\r
- If we are being used with glibc, we need to include <features.h>, but\r
- that does not exist if we are standalone. So: if __GNU_LIBRARY__ is\r
- not defined, include <ctype.h>, which will pull in <features.h> for us\r
- if it's from glibc. (Why ctype.h? It's guaranteed to exist and it\r
- doesn't flood the namespace with stuff the way some other headers do.) */\r
-#if !defined __GNU_LIBRARY__\r
-# include <ctype.h>\r
-#endif\r
-\r
-#ifndef __THROW\r
-# ifndef __GNUC_PREREQ\r
-# define __GNUC_PREREQ(maj, min) (0)\r
-# endif\r
-# if defined __cplusplus && __GNUC_PREREQ (2,8)\r
-# define __THROW throw ()\r
-# else\r
-# define __THROW\r
-# endif\r
-#endif\r
-\r
-/* The definition of _GL_ARG_NONNULL is copied here. */\r
-/* A C macro for declaring that specific arguments must not be NULL.\r
- Copyright (C) 2009-2011 Free Software Foundation, Inc.\r
-\r
- This program is free software: you can redistribute it and/or modify it\r
- under the terms of the GNU General Public License as published\r
- by the Free Software Foundation; either version 3 of the License, or\r
- (at your option) any later version.\r
-\r
- This program is distributed in the hope that it will be useful,\r
- but WITHOUT ANY WARRANTY; without even the implied warranty of\r
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\r
- General Public License for more details.\r
-\r
- You should have received a copy of the GNU General Public License\r
- along with this program. If not, see <http://www.gnu.org/licenses/>. */\r
-\r
-/* _GL_ARG_NONNULL((n,...,m)) tells the compiler and static analyzer tools\r
- that the values passed as arguments n, ..., m must be non-NULL pointers.\r
- n = 1 stands for the first argument, n = 2 for the second argument etc. */\r
-#ifndef _GL_ARG_NONNULL\r
-# if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || __GNUC__ > 3\r
-# define _GL_ARG_NONNULL(params) __attribute__ ((__nonnull__ params))\r
-# else\r
-# define _GL_ARG_NONNULL(params)\r
-# endif\r
-#endif\r
-\r
-#ifdef __cplusplus\r
-extern "C" {\r
-#endif\r
-\r
-/* For communication from `getopt' to the caller.\r
- When `getopt' finds an option that takes an argument,\r
- the argument value is returned here.\r
- Also, when `ordering' is RETURN_IN_ORDER,\r
- each non-option ARGV-element is returned here. */\r
-\r
-extern char *optarg;\r
-\r
-/* Index in ARGV of the next element to be scanned.\r
- This is used for communication to and from the caller\r
- and for communication between successive calls to `getopt'.\r
-\r
- On entry to `getopt', zero means this is the first call; initialize.\r
-\r
- When `getopt' returns -1, this is the index of the first of the\r
- non-option elements that the caller should itself scan.\r
-\r
- Otherwise, `optind' communicates from one call to the next\r
- how much of ARGV has been scanned so far. */\r
-\r
-extern int optind;\r
-\r
-/* Callers store zero here to inhibit the error message `getopt' prints\r
- for unrecognized options. */\r
-\r
-extern int opterr;\r
-\r
-/* Set to an option character which was unrecognized. */\r
-\r
-extern int optopt;\r
-\r
-#ifndef __need_getopt\r
-/* Describe the long-named options requested by the application.\r
- The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector\r
- of `struct option' terminated by an element containing a name which is\r
- zero.\r
-\r
- The field `has_arg' is:\r
- no_argument (or 0) if the option does not take an argument,\r
- required_argument (or 1) if the option requires an argument,\r
- optional_argument (or 2) if the option takes an optional argument.\r
-\r
- If the field `flag' is not NULL, it points to a variable that is set\r
- to the value given in the field `val' when the option is found, but\r
- left unchanged if the option is not found.\r
-\r
- To have a long-named option do something other than set an `int' to\r
- a compiled-in constant, such as set a value from `optarg', set the\r
- option's `flag' field to zero and its `val' field to a nonzero\r
- value (the equivalent single-letter option character, if there is\r
- one). For long options that have a zero `flag' field, `getopt'\r
- returns the contents of the `val' field. */\r
-\r
-# if !GNULIB_defined_struct_option\r
-struct option\r
-{\r
- const char *name;\r
- /* has_arg can't be an enum because some compilers complain about\r
- type mismatches in all the code that assumes it is an int. */\r
- int has_arg;\r
- int *flag;\r
- int val;\r
-};\r
-# define GNULIB_defined_struct_option 1\r
-# endif\r
-\r
-/* Names for the values of the `has_arg' field of `struct option'. */\r
-\r
-# define no_argument 0\r
-# define required_argument 1\r
-# define optional_argument 2\r
-#endif /* need getopt */\r
-\r
-\r
-/* Get definitions and prototypes for functions to process the\r
- arguments in ARGV (ARGC of them, minus the program name) for\r
- options given in OPTS.\r
-\r
- Return the option character from OPTS just read. Return -1 when\r
- there are no more options. For unrecognized options, or options\r
- missing arguments, `optopt' is set to the option letter, and '?' is\r
- returned.\r
-\r
- The OPTS string is a list of characters which are recognized option\r
- letters, optionally followed by colons, specifying that that letter\r
- takes an argument, to be placed in `optarg'.\r
-\r
- If a letter in OPTS is followed by two colons, its argument is\r
- optional. This behavior is specific to the GNU `getopt'.\r
-\r
- The argument `--' causes premature termination of argument\r
- scanning, explicitly telling `getopt' that there are no more\r
- options.\r
-\r
- If OPTS begins with `-', then non-option arguments are treated as\r
- arguments to the option '\1'. This behavior is specific to the GNU\r
- `getopt'. If OPTS begins with `+', or POSIXLY_CORRECT is set in\r
- the environment, then do not permute arguments. */\r
-\r
-extern int getopt (int ___argc, char *const *___argv, const char *__shortopts)\r
- __THROW _GL_ARG_NONNULL ((2, 3));\r
-\r
-#ifndef __need_getopt\r
-extern int getopt_long (int ___argc, char *__getopt_argv_const *___argv,\r
- const char *__shortopts,\r
- const struct option *__longopts, int *__longind)\r
- __THROW _GL_ARG_NONNULL ((2, 3));\r
-extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv,\r
- const char *__shortopts,\r
- const struct option *__longopts, int *__longind)\r
- __THROW _GL_ARG_NONNULL ((2, 3));\r
-\r
-#endif\r
-\r
-#ifdef __cplusplus\r
-}\r
-#endif\r
-\r
-/* Make sure we later can get all the definitions and declarations. */\r
-#undef __need_getopt\r
-\r
-#endif /* _GL_GETOPT_H */\r
-#endif /* _GL_GETOPT_H */\r
+/* Declarations for getopt.
+ Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2012 Free Software
+ Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ 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
+ (at your option) 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 <http://www.gnu.org/licenses/>. */
+
+#ifndef _GL_GETOPT_H
+
+#if __GNUC__ >= 3
+#pragma GCC system_header
+#endif
+
+
+/* The include_next requires a split double-inclusion guard. We must
+ also inform the replacement unistd.h to not recursively use
+ <getopt.h>; our definitions will be present soon enough. */
+#if HAVE_GETOPT_H
+# define _GL_SYSTEM_GETOPT
+# ifndef __GNUC__
+# include <next_getopt.h>
+# else
+# include_next <getopt.h>
+# endif
+# undef _GL_SYSTEM_GETOPT
+#endif
+
+#ifndef _GL_GETOPT_H
+
+#ifndef __need_getopt
+# define _GL_GETOPT_H 1
+#endif
+
+/* Standalone applications should #define __GETOPT_PREFIX to an
+ identifier that prefixes the external functions and variables
+ defined in this header. When this happens, include the
+ headers that might declare getopt so that they will not cause
+ confusion if included after this file (if the system had <getopt.h>,
+ we have already included it). Then systematically rename
+ identifiers so that they do not collide with the system functions
+ and variables. Renaming avoids problems with some compilers and
+ linkers. */
+#if defined __GETOPT_PREFIX && !defined __need_getopt
+# if !HAVE_GETOPT_H
+# include <stdlib.h>
+# include <stdio.h>
+# include <unistd.h>
+# endif
+# undef __need_getopt
+# undef getopt
+# undef getopt_long
+# undef getopt_long_only
+# undef optarg
+# undef opterr
+# undef optind
+# undef optopt
+# undef option
+# define __GETOPT_CONCAT(x, y) x ## y
+# define __GETOPT_XCONCAT(x, y) __GETOPT_CONCAT (x, y)
+# define __GETOPT_ID(y) __GETOPT_XCONCAT (__GETOPT_PREFIX, y)
+# define getopt __GETOPT_ID (getopt)
+# define getopt_long __GETOPT_ID (getopt_long)
+# define getopt_long_only __GETOPT_ID (getopt_long_only)
+# define optarg __GETOPT_ID (optarg)
+# define opterr __GETOPT_ID (opterr)
+# define optind __GETOPT_ID (optind)
+# define optopt __GETOPT_ID (optopt)
+# define option __GETOPT_ID (option)
+# define _getopt_internal __GETOPT_ID (getopt_internal)
+#endif
+
+/* Standalone applications get correct prototypes for getopt_long and
+ getopt_long_only; they declare "char **argv". libc uses prototypes
+ with "char *const *argv" that are incorrect because getopt_long and
+ getopt_long_only can permute argv; this is required for backward
+ compatibility (e.g., for LSB 2.0.1).
+
+ This used to be '#if defined __GETOPT_PREFIX && !defined __need_getopt',
+ but it caused redefinition warnings if both unistd.h and getopt.h were
+ included, since unistd.h includes getopt.h having previously defined
+ __need_getopt.
+
+ The only place where __getopt_argv_const is used is in definitions
+ of getopt_long and getopt_long_only below, but these are visible
+ only if __need_getopt is not defined, so it is quite safe to rewrite
+ the conditional as follows:
+*/
+#if !defined __need_getopt
+# if defined __GETOPT_PREFIX
+# define __getopt_argv_const /* empty */
+# else
+# define __getopt_argv_const const
+# endif
+#endif
+
+/* If __GNU_LIBRARY__ is not already defined, either we are being used
+ standalone, or this is the first header included in the source file.
+ If we are being used with glibc, we need to include <features.h>, but
+ that does not exist if we are standalone. So: if __GNU_LIBRARY__ is
+ not defined, include <ctype.h>, which will pull in <features.h> for us
+ if it's from glibc. (Why ctype.h? It's guaranteed to exist and it
+ doesn't flood the namespace with stuff the way some other headers do.) */
+#if !defined __GNU_LIBRARY__
+# include <ctype.h>
+#endif
+
+#ifndef __THROW
+# ifndef __GNUC_PREREQ
+# define __GNUC_PREREQ(maj, min) (0)
+# endif
+# if defined __cplusplus && __GNUC_PREREQ (2,8)
+# define __THROW throw ()
+# else
+# define __THROW
+# endif
+#endif
+
+/* The definition of _GL_ARG_NONNULL is copied here. */
+/* A C macro for declaring that specific arguments must not be NULL.
+ Copyright (C) 2009-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
+ (at your option) 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 <http://www.gnu.org/licenses/>. */
+
+/* _GL_ARG_NONNULL((n,...,m)) tells the compiler and static analyzer tools
+ that the values passed as arguments n, ..., m must be non-NULL pointers.
+ n = 1 stands for the first argument, n = 2 for the second argument etc. */
+#ifndef _GL_ARG_NONNULL
+# if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || __GNUC__ > 3
+# define _GL_ARG_NONNULL(params) __attribute__ ((__nonnull__ params))
+# else
+# define _GL_ARG_NONNULL(params)
+# endif
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* For communication from 'getopt' to the caller.
+ When 'getopt' finds an option that takes an argument,
+ the argument value is returned here.
+ Also, when 'ordering' is RETURN_IN_ORDER,
+ each non-option ARGV-element is returned here. */
+
+extern char *optarg;
+
+/* Index in ARGV of the next element to be scanned.
+ This is used for communication to and from the caller
+ and for communication between successive calls to 'getopt'.
+
+ On entry to 'getopt', zero means this is the first call; initialize.
+
+ When 'getopt' returns -1, this is the index of the first of the
+ non-option elements that the caller should itself scan.
+
+ Otherwise, 'optind' communicates from one call to the next
+ how much of ARGV has been scanned so far. */
+
+extern int optind;
+
+/* Callers store zero here to inhibit the error message 'getopt' prints
+ for unrecognized options. */
+
+extern int opterr;
+
+/* Set to an option character which was unrecognized. */
+
+extern int optopt;
+
+#ifndef __need_getopt
+/* Describe the long-named options requested by the application.
+ The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
+ of 'struct option' terminated by an element containing a name which is
+ zero.
+
+ The field 'has_arg' is:
+ no_argument (or 0) if the option does not take an argument,
+ required_argument (or 1) if the option requires an argument,
+ optional_argument (or 2) if the option takes an optional argument.
+
+ If the field 'flag' is not NULL, it points to a variable that is set
+ to the value given in the field 'val' when the option is found, but
+ left unchanged if the option is not found.
+
+ To have a long-named option do something other than set an 'int' to
+ a compiled-in constant, such as set a value from 'optarg', set the
+ option's 'flag' field to zero and its 'val' field to a nonzero
+ value (the equivalent single-letter option character, if there is
+ one). For long options that have a zero 'flag' field, 'getopt'
+ returns the contents of the 'val' field. */
+
+# if !GNULIB_defined_struct_option
+struct option
+{
+ const char *name;
+ /* has_arg can't be an enum because some compilers complain about
+ type mismatches in all the code that assumes it is an int. */
+ int has_arg;
+ int *flag;
+ int val;
+};
+# define GNULIB_defined_struct_option 1
+# endif
+
+/* Names for the values of the 'has_arg' field of 'struct option'. */
+
+# define no_argument 0
+# define required_argument 1
+# define optional_argument 2
+#endif /* need getopt */
+
+
+/* Get definitions and prototypes for functions to process the
+ arguments in ARGV (ARGC of them, minus the program name) for
+ options given in OPTS.
+
+ Return the option character from OPTS just read. Return -1 when
+ there are no more options. For unrecognized options, or options
+ missing arguments, 'optopt' is set to the option letter, and '?' is
+ returned.
+
+ The OPTS string is a list of characters which are recognized option
+ letters, optionally followed by colons, specifying that that letter
+ takes an argument, to be placed in 'optarg'.
+
+ If a letter in OPTS is followed by two colons, its argument is
+ optional. This behavior is specific to the GNU 'getopt'.
+
+ The argument '--' causes premature termination of argument
+ scanning, explicitly telling 'getopt' that there are no more
+ options.
+
+ If OPTS begins with '-', then non-option arguments are treated as
+ arguments to the option '\1'. This behavior is specific to the GNU
+ 'getopt'. If OPTS begins with '+', or POSIXLY_CORRECT is set in
+ the environment, then do not permute arguments. */
+
+extern int getopt (int ___argc, char *const *___argv, const char *__shortopts)
+ __THROW _GL_ARG_NONNULL ((2, 3));
+
+#ifndef __need_getopt
+extern int getopt_long (int ___argc, char *__getopt_argv_const *___argv,
+ const char *__shortopts,
+ const struct option *__longopts, int *__longind)
+ __THROW _GL_ARG_NONNULL ((2, 3));
+extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv,
+ const char *__shortopts,
+ const struct option *__longopts, int *__longind)
+ __THROW _GL_ARG_NONNULL ((2, 3));
+
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+/* Make sure we later can get all the definitions and declarations. */
+#undef __need_getopt
+
+#endif /* _GL_GETOPT_H */
+#endif /* _GL_GETOPT_H */
/* Internal declarations for getopt.
- Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2004, 2009-2011 Free Software
+ Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2004, 2009-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
stop option processing when the first non-option is seen.
This is what Unix does.
This mode of operation is selected by either setting the environment
- variable POSIXLY_CORRECT, or using `+' as the first character
+ variable POSIXLY_CORRECT, or using '+' as the first character
of the list of option characters, or by calling getopt.
PERMUTE is the default. We permute the contents of ARGV as we
written to expect options and other ARGV-elements in any order
and that care about the ordering of the two. We describe each
non-option ARGV-element as if it were the argument of an option
- with character code 1. Using `-' as the first character of the
+ with character code 1. Using '-' as the first character of the
list of option characters selects this mode of operation.
- The special argument `--' forces an end of option-scanning regardless
- of the value of `ordering'. In the case of RETURN_IN_ORDER, only
- `--' can cause `getopt' to return -1 with `optind' != ARGC. */
+ The special argument '--' forces an end of option-scanning regardless
+ of the value of 'ordering'. In the case of RETURN_IN_ORDER, only
+ '--' can cause 'getopt' to return -1 with 'optind' != ARGC. */
enum __ord
{
/* Handle permutation of arguments. */
/* Describe the part of ARGV that contains non-options that have
- been skipped. `first_nonopt' is the index in ARGV of the first
- of them; `last_nonopt' is the index after the last of them. */
+ been skipped. 'first_nonopt' is the index in ARGV of the first
+ of them; 'last_nonopt' is the index after the last of them. */
int __first_nonopt;
int __last_nonopt;
/* Convenience header for conditional use of GNU <libintl.h>.
- Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2011 Free Software
+ Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2012 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef _LIBGETTEXT_H
#define _LIBGETTEXT_H 1
#include <string.h>
-#define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS \
- (((__GNUC__ >= 3 || __GNUG__ >= 2) && !__STRICT_ANSI__) \
- /* || __STDC_VERSION__ >= 199901L */ )
+#if (((__GNUC__ >= 3 || __GNUG__ >= 2) && !defined __STRICT_ANSI__) \
+ /* || __STDC_VERSION__ >= 199901L */ )
+# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 1
+#else
+# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 0
+#endif
#if !_LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS
#include <stdlib.h>
--- /dev/null
+/* gettime -- get the system clock
+
+ Copyright (C) 2002, 2004-2007, 2009-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
+ (at your option) 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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+#include <config.h>
+
+#include "timespec.h"
+
+#include <sys/time.h>
+
+/* Get the system time into *TS. */
+
+void
+gettime (struct timespec *ts)
+{
+#if HAVE_NANOTIME
+ nanotime (ts);
+#else
+
+# if defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME
+ if (clock_gettime (CLOCK_REALTIME, ts) == 0)
+ return;
+# endif
+
+ {
+ struct timeval tv;
+ gettimeofday (&tv, NULL);
+ ts->tv_sec = tv.tv_sec;
+ ts->tv_nsec = tv.tv_usec * 1000;
+ }
+
+#endif
+}
--- /dev/null
+/* Provide gettimeofday for systems that don't have it or for which it's broken.
+
+ Copyright (C) 2001-2003, 2005-2007, 2009-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, or (at your option)
+ 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 <http://www.gnu.org/licenses/>. */
+
+/* written by Jim Meyering */
+
+#include <config.h>
+
+/* Specification. */
+#include <sys/time.h>
+
+#include <time.h>
+
+#if HAVE_SYS_TIMEB_H
+# include <sys/timeb.h>
+#endif
+
+#if GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME
+
+/* Work around the bug in some systems whereby gettimeofday clobbers
+ the static buffer that localtime uses for its return value. The
+ gettimeofday function from Mac OS X 10.0.4 (i.e., Darwin 1.3.7) has
+ this problem. The tzset replacement is necessary for at least
+ Solaris 2.5, 2.5.1, and 2.6. */
+
+static struct tm tm_zero_buffer;
+static struct tm *localtime_buffer_addr = &tm_zero_buffer;
+
+# undef localtime
+extern struct tm *localtime (time_t const *);
+
+# undef gmtime
+extern struct tm *gmtime (time_t const *);
+
+/* This is a wrapper for localtime. It is used only on systems for which
+ gettimeofday clobbers the static buffer used for localtime's result.
+
+ On the first call, record the address of the static buffer that
+ localtime uses for its result. */
+
+struct tm *
+rpl_localtime (time_t const *timep)
+{
+ struct tm *tm = localtime (timep);
+
+ if (localtime_buffer_addr == &tm_zero_buffer)
+ localtime_buffer_addr = tm;
+
+ return tm;
+}
+
+/* Same as above, since gmtime and localtime use the same buffer. */
+struct tm *
+rpl_gmtime (time_t const *timep)
+{
+ struct tm *tm = gmtime (timep);
+
+ if (localtime_buffer_addr == &tm_zero_buffer)
+ localtime_buffer_addr = tm;
+
+ return tm;
+}
+
+#endif /* GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME */
+
+#if TZSET_CLOBBERS_LOCALTIME
+
+# undef tzset
+extern void tzset (void);
+
+/* This is a wrapper for tzset, for systems on which tzset may clobber
+ the static buffer used for localtime's result. */
+void
+rpl_tzset (void)
+{
+ /* Save and restore the contents of the buffer used for localtime's
+ result around the call to tzset. */
+ struct tm save = *localtime_buffer_addr;
+ tzset ();
+ *localtime_buffer_addr = save;
+}
+#endif
+
+/* This is a wrapper for gettimeofday. It is used only on systems
+ that lack this function, or whose implementation of this function
+ causes problems. */
+
+int
+gettimeofday (struct timeval *restrict tv, void *restrict tz)
+{
+#undef gettimeofday
+#if HAVE_GETTIMEOFDAY
+# if GETTIMEOFDAY_CLOBBERS_LOCALTIME
+ /* Save and restore the contents of the buffer used for localtime's
+ result around the call to gettimeofday. */
+ struct tm save = *localtime_buffer_addr;
+# endif
+
+# if defined timeval /* 'struct timeval' overridden by gnulib? */
+# undef timeval
+ struct timeval otv;
+ int result = gettimeofday (&otv, (struct timezone *) tz);
+ if (result == 0)
+ {
+ tv->tv_sec = otv.tv_sec;
+ tv->tv_usec = otv.tv_usec;
+ }
+# else
+ int result = gettimeofday (tv, (struct timezone *) tz);
+# endif
+
+# if GETTIMEOFDAY_CLOBBERS_LOCALTIME
+ *localtime_buffer_addr = save;
+# endif
+
+ return result;
+
+#else
+
+# if HAVE__FTIME
+
+ struct _timeb timebuf;
+ _ftime (&timebuf);
+ tv->tv_sec = timebuf.time;
+ tv->tv_usec = timebuf.millitm * 1000;
+
+# else
+
+# if !defined OK_TO_USE_1S_CLOCK
+# error "Only 1-second nominal clock resolution found. Is that intended?" \
+ "If so, compile with the -DOK_TO_USE_1S_CLOCK option."
+# endif
+ tv->tv_sec = time (NULL);
+ tv->tv_usec = 0;
+
+# endif
+
+ return 0;
+
+#endif
+}
## DO NOT EDIT! GENERATED AUTOMATICALLY!
## Process this file with automake to produce Makefile.in.
-# Copyright (C) 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-2012 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dup2 filemode getloadavg getopt-gnu ignore-value intprops lstat mktime pthread_sigmask readlink socklen stdarg stdio strftime strtoimax strtoumax symlink sys_stat
+# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings
MOSTLYCLEANFILES += core *.stackdump
## end gnulib module allocator
+## begin gnulib module c-ctype
+
+libgnu_a_SOURCES += c-ctype.h c-ctype.c
+
+## end gnulib module c-ctype
+
+## begin gnulib module c-strcase
+
+libgnu_a_SOURCES += c-strcase.h c-strcasecmp.c c-strncasecmp.c
+
+## end gnulib module c-strcase
+
## begin gnulib module careadlinkat
libgnu_a_SOURCES += careadlinkat.c
## end gnulib module dtoastr
+## begin gnulib module dtotimespec
+
+libgnu_a_SOURCES += dtotimespec.c
+
+## end gnulib module dtotimespec
+
## begin gnulib module dup2
## end gnulib module dup2
+## begin gnulib module execinfo
+
+BUILT_SOURCES += $(EXECINFO_H)
+
+# We need the following in order to create <execinfo.h> when the system
+# doesn't have one that works.
+if GL_GENERATE_EXECINFO_H
+execinfo.h: execinfo.in.h $(top_builddir)/config.status
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ cat $(srcdir)/execinfo.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+else
+execinfo.h: $(top_builddir)/config.status
+ rm -f $@
+endif
+MOSTLYCLEANFILES += execinfo.h execinfo.h-t
+
+EXTRA_DIST += execinfo.c execinfo.in.h
+
+EXTRA_libgnu_a_SOURCES += execinfo.c
+
+## end gnulib module execinfo
+
## begin gnulib module filemode
libgnu_a_SOURCES += filemode.c
endif
## end gnulib module gettext-h
+## begin gnulib module gettime
+
+libgnu_a_SOURCES += gettime.c
+
+## end gnulib module gettime
+
+## begin gnulib module gettimeofday
+
+
+EXTRA_DIST += gettimeofday.c
+
+EXTRA_libgnu_a_SOURCES += gettimeofday.c
+
+## end gnulib module gettimeofday
+
## begin gnulib module ignore-value
# We need the following in order to create <inttypes.h> when the system
# doesn't have one that works with the given compiler.
-inttypes.h: inttypes.in.h $(top_builddir)/config.status $(WARN_ON_USE_H) $(ARG_NONNULL_H)
+inttypes.h: inttypes.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H) $(ARG_NONNULL_H)
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
sed -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \
-e 's/@''HAVE_DECL_IMAXDIV''@/$(HAVE_DECL_IMAXDIV)/g' \
-e 's/@''HAVE_DECL_STRTOIMAX''@/$(HAVE_DECL_STRTOIMAX)/g' \
-e 's/@''HAVE_DECL_STRTOUMAX''@/$(HAVE_DECL_STRTOUMAX)/g' \
+ -e 's/@''REPLACE_STRTOIMAX''@/$(REPLACE_STRTOIMAX)/g' \
-e 's/@''INT32_MAX_LT_INTMAX_MAX''@/$(INT32_MAX_LT_INTMAX_MAX)/g' \
-e 's/@''INT64_MAX_EQ_LONG_MAX''@/$(INT64_MAX_EQ_LONG_MAX)/g' \
-e 's/@''UINT32_MAX_LT_UINTMAX_MAX''@/$(UINT32_MAX_LT_UINTMAX_MAX)/g' \
-e 's/@''UINT64_MAX_EQ_ULONG_MAX''@/$(UINT64_MAX_EQ_ULONG_MAX)/g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
-e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
-e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
< $(srcdir)/inttypes.in.h; \
## end gnulib module pathmax
+## begin gnulib module pselect
+
+
+EXTRA_DIST += pselect.c
+
+EXTRA_libgnu_a_SOURCES += pselect.c
+
+## end gnulib module pselect
+
## begin gnulib module pthread_sigmask
## end gnulib module signal-h
-## begin gnulib module sigprocmask
-
-if gl_GNULIB_ENABLED_sigprocmask
-
-endif
-EXTRA_DIST += sigprocmask.c
-
-EXTRA_libgnu_a_SOURCES += sigprocmask.c
-
-## end gnulib module sigprocmask
-
## begin gnulib module snippet/_Noreturn
# Because this Makefile snippet defines a variable used by other
## end gnulib module stat
+## begin gnulib module stat-time
+
+libgnu_a_SOURCES += stat-time.c
+
+EXTRA_DIST += stat-time.h
+
+## end gnulib module stat-time
+
+## begin gnulib module stdalign
+
+BUILT_SOURCES += $(STDALIGN_H)
+
+# We need the following in order to create <stdalign.h> when the system
+# doesn't have one that works.
+if GL_GENERATE_STDALIGN_H
+stdalign.h: stdalign.in.h $(top_builddir)/config.status
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ cat $(srcdir)/stdalign.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+else
+stdalign.h: $(top_builddir)/config.status
+ rm -f $@
+endif
+MOSTLYCLEANFILES += stdalign.h stdalign.h-t
+
+EXTRA_DIST += stdalign.in.h
+
+## end gnulib module stdalign
+
## begin gnulib module stdarg
BUILT_SOURCES += $(STDARG_H)
-e 's/@''GNULIB_MKOSTEMPS''@/$(GNULIB_MKOSTEMPS)/g' \
-e 's/@''GNULIB_MKSTEMP''@/$(GNULIB_MKSTEMP)/g' \
-e 's/@''GNULIB_MKSTEMPS''@/$(GNULIB_MKSTEMPS)/g' \
+ -e 's/@''GNULIB_POSIX_OPENPT''@/$(GNULIB_POSIX_OPENPT)/g' \
-e 's/@''GNULIB_PTSNAME''@/$(GNULIB_PTSNAME)/g' \
+ -e 's/@''GNULIB_PTSNAME_R''@/$(GNULIB_PTSNAME_R)/g' \
-e 's/@''GNULIB_PUTENV''@/$(GNULIB_PUTENV)/g' \
+ -e 's/@''GNULIB_RANDOM''@/$(GNULIB_RANDOM)/g' \
-e 's/@''GNULIB_RANDOM_R''@/$(GNULIB_RANDOM_R)/g' \
-e 's/@''GNULIB_REALLOC_POSIX''@/$(GNULIB_REALLOC_POSIX)/g' \
-e 's/@''GNULIB_REALPATH''@/$(GNULIB_REALPATH)/g' \
-e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \
-e 's|@''HAVE_MKSTEMP''@|$(HAVE_MKSTEMP)|g' \
-e 's|@''HAVE_MKSTEMPS''@|$(HAVE_MKSTEMPS)|g' \
+ -e 's|@''HAVE_POSIX_OPENPT''@|$(HAVE_POSIX_OPENPT)|g' \
-e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \
+ -e 's|@''HAVE_PTSNAME_R''@|$(HAVE_PTSNAME_R)|g' \
+ -e 's|@''HAVE_RANDOM''@|$(HAVE_RANDOM)|g' \
-e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \
-e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \
-e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \
-e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \
-e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \
-e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \
+ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \
-e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \
+ -e 's|@''REPLACE_RANDOM_R''@|$(REPLACE_RANDOM_R)|g' \
-e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \
-e 's|@''REPLACE_REALPATH''@|$(REPLACE_REALPATH)|g' \
-e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \
## end gnulib module symlink
+## begin gnulib module sys_select
+
+BUILT_SOURCES += sys/select.h
+
+# We need the following in order to create <sys/select.h> when the system
+# doesn't have one that works with the given compiler.
+sys/select.h: sys_select.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_SELECT_H''@|$(NEXT_SYS_SELECT_H)|g' \
+ -e 's|@''HAVE_SYS_SELECT_H''@|$(HAVE_SYS_SELECT_H)|g' \
+ -e 's/@''GNULIB_PSELECT''@/$(GNULIB_PSELECT)/g' \
+ -e 's/@''GNULIB_SELECT''@/$(GNULIB_SELECT)/g' \
+ -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \
+ -e 's|@''HAVE_PSELECT''@|$(HAVE_PSELECT)|g' \
+ -e 's|@''REPLACE_PSELECT''@|$(REPLACE_PSELECT)|g' \
+ -e 's|@''REPLACE_SELECT''@|$(REPLACE_SELECT)|g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_select.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+MOSTLYCLEANFILES += sys/select.h sys/select.h-t
+MOSTLYCLEANDIRS += sys
+
+EXTRA_DIST += sys_select.in.h
+
+## end gnulib module sys_select
+
## begin gnulib module sys_stat
BUILT_SOURCES += sys/stat.h
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \
+ -e 's|@''WINDOWS_64_BIT_ST_SIZE''@|$(WINDOWS_64_BIT_ST_SIZE)|g' \
-e 's/@''GNULIB_FCHMODAT''@/$(GNULIB_FCHMODAT)/g' \
-e 's/@''GNULIB_FSTAT''@/$(GNULIB_FSTAT)/g' \
-e 's/@''GNULIB_FSTATAT''@/$(GNULIB_FSTATAT)/g' \
## end gnulib module sys_stat
+## begin gnulib module sys_time
+
+BUILT_SOURCES += sys/time.h
+
+# We need the following in order to create <sys/time.h> when the system
+# doesn't have one that works with the given compiler.
+sys/time.h: sys_time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H)
+ $(AM_V_at)$(MKDIR_P) sys
+ $(AM_V_GEN)rm -f $@-t $@ && \
+ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+ sed -e 's|@''GUARD_PREFIX''@|GL|g' \
+ -e 's/@''HAVE_SYS_TIME_H''@/$(HAVE_SYS_TIME_H)/g' \
+ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
+ -e 's|@''NEXT_SYS_TIME_H''@|$(NEXT_SYS_TIME_H)|g' \
+ -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \
+ -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \
+ -e 's/@''HAVE_GETTIMEOFDAY''@/$(HAVE_GETTIMEOFDAY)/g' \
+ -e 's/@''HAVE_STRUCT_TIMEVAL''@/$(HAVE_STRUCT_TIMEVAL)/g' \
+ -e 's/@''REPLACE_GETTIMEOFDAY''@/$(REPLACE_GETTIMEOFDAY)/g' \
+ -e 's/@''REPLACE_STRUCT_TIMEVAL''@/$(REPLACE_STRUCT_TIMEVAL)/g' \
+ -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
+ -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
+ -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
+ < $(srcdir)/sys_time.in.h; \
+ } > $@-t && \
+ mv $@-t $@
+MOSTLYCLEANFILES += sys/time.h sys/time.h-t
+
+EXTRA_DIST += sys_time.in.h
+
+## end gnulib module sys_time
+
## begin gnulib module time
BUILT_SOURCES += time.h
## end gnulib module time_r
+## begin gnulib module timespec
+
+libgnu_a_SOURCES += timespec.c
+
+EXTRA_DIST += timespec.h
+
+## end gnulib module timespec
+
+## begin gnulib module timespec-add
+
+libgnu_a_SOURCES += timespec-add.c
+
+## end gnulib module timespec-add
+
+## begin gnulib module timespec-sub
+
+libgnu_a_SOURCES += timespec-sub.c
+
+## end gnulib module timespec-sub
+
## begin gnulib module u64
+libgnu_a_SOURCES += u64.c
EXTRA_DIST += u64.h
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_UNISTD_H''@|$(NEXT_UNISTD_H)|g' \
+ -e 's|@''WINDOWS_64_BIT_OFF_T''@|$(WINDOWS_64_BIT_OFF_T)|g' \
-e 's/@''GNULIB_CHDIR''@/$(GNULIB_CHDIR)/g' \
-e 's/@''GNULIB_CHOWN''@/$(GNULIB_CHOWN)/g' \
-e 's/@''GNULIB_CLOSE''@/$(GNULIB_CLOSE)/g' \
-e 's/@''GNULIB_GETPAGESIZE''@/$(GNULIB_GETPAGESIZE)/g' \
-e 's/@''GNULIB_GETUSERSHELL''@/$(GNULIB_GETUSERSHELL)/g' \
-e 's/@''GNULIB_GROUP_MEMBER''@/$(GNULIB_GROUP_MEMBER)/g' \
+ -e 's/@''GNULIB_ISATTY''@/$(GNULIB_ISATTY)/g' \
-e 's/@''GNULIB_LCHOWN''@/$(GNULIB_LCHOWN)/g' \
-e 's/@''GNULIB_LINK''@/$(GNULIB_LINK)/g' \
-e 's/@''GNULIB_LINKAT''@/$(GNULIB_LINKAT)/g' \
-e 's/@''GNULIB_READLINK''@/$(GNULIB_READLINK)/g' \
-e 's/@''GNULIB_READLINKAT''@/$(GNULIB_READLINKAT)/g' \
-e 's/@''GNULIB_RMDIR''@/$(GNULIB_RMDIR)/g' \
+ -e 's/@''GNULIB_SETHOSTNAME''@/$(GNULIB_SETHOSTNAME)/g' \
-e 's/@''GNULIB_SLEEP''@/$(GNULIB_SLEEP)/g' \
-e 's/@''GNULIB_SYMLINK''@/$(GNULIB_SYMLINK)/g' \
-e 's/@''GNULIB_SYMLINKAT''@/$(GNULIB_SYMLINKAT)/g' \
-e 's/@''GNULIB_TTYNAME_R''@/$(GNULIB_TTYNAME_R)/g' \
- -e 's/@''GNULIB_UNISTD_H_GETOPT''@/$(GNULIB_UNISTD_H_GETOPT)/g' \
+ -e 's/@''GNULIB_UNISTD_H_GETOPT''@/0$(GNULIB_GL_UNISTD_H_GETOPT)/g' \
-e 's/@''GNULIB_UNISTD_H_NONBLOCKING''@/$(GNULIB_UNISTD_H_NONBLOCKING)/g' \
-e 's/@''GNULIB_UNISTD_H_SIGPIPE''@/$(GNULIB_UNISTD_H_SIGPIPE)/g' \
-e 's/@''GNULIB_UNLINK''@/$(GNULIB_UNLINK)/g' \
-e 's|@''HAVE_PWRITE''@|$(HAVE_PWRITE)|g' \
-e 's|@''HAVE_READLINK''@|$(HAVE_READLINK)|g' \
-e 's|@''HAVE_READLINKAT''@|$(HAVE_READLINKAT)|g' \
+ -e 's|@''HAVE_SETHOSTNAME''@|$(HAVE_SETHOSTNAME)|g' \
-e 's|@''HAVE_SLEEP''@|$(HAVE_SLEEP)|g' \
-e 's|@''HAVE_SYMLINK''@|$(HAVE_SYMLINK)|g' \
-e 's|@''HAVE_SYMLINKAT''@|$(HAVE_SYMLINKAT)|g' \
-e 's|@''HAVE_DECL_GETLOGIN_R''@|$(HAVE_DECL_GETLOGIN_R)|g' \
-e 's|@''HAVE_DECL_GETPAGESIZE''@|$(HAVE_DECL_GETPAGESIZE)|g' \
-e 's|@''HAVE_DECL_GETUSERSHELL''@|$(HAVE_DECL_GETUSERSHELL)|g' \
+ -e 's|@''HAVE_DECL_SETHOSTNAME''@|$(HAVE_DECL_SETHOSTNAME)|g' \
-e 's|@''HAVE_DECL_TTYNAME_R''@|$(HAVE_DECL_TTYNAME_R)|g' \
-e 's|@''HAVE_OS_H''@|$(HAVE_OS_H)|g' \
-e 's|@''HAVE_SYS_PARAM_H''@|$(HAVE_SYS_PARAM_H)|g' \
-e 's|@''REPLACE_DUP''@|$(REPLACE_DUP)|g' \
-e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \
-e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \
+ -e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \
-e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \
-e 's|@''REPLACE_GETDOMAINNAME''@|$(REPLACE_GETDOMAINNAME)|g' \
-e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \
-e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \
-e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \
+ -e 's|@''REPLACE_ISATTY''@|$(REPLACE_ISATTY)|g' \
-e 's|@''REPLACE_LCHOWN''@|$(REPLACE_LCHOWN)|g' \
-e 's|@''REPLACE_LINK''@|$(REPLACE_LINK)|g' \
-e 's|@''REPLACE_LINKAT''@|$(REPLACE_LINKAT)|g' \
## end gnulib module unistd
+## begin gnulib module utimens
+
+libgnu_a_SOURCES += utimens.c
+
+EXTRA_DIST += utimens.h
+
+## end gnulib module utimens
+
## begin gnulib module verify
if gl_GNULIB_ENABLED_verify
/* ignore a function return without a compiler warning
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-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
#ifndef _GL_IGNORE_VALUE_H
# define _GL_IGNORE_VALUE_H
-# ifndef _GL_ATTRIBUTE_DEPRECATED
-/* The __attribute__((__deprecated__)) feature
- is available in gcc versions 3.1 and newer. */
-# if __GNUC__ < 3 || (__GNUC__ == 3 && __GNUC_MINOR__ < 1)
-# define _GL_ATTRIBUTE_DEPRECATED /* empty */
-# else
-# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__))
-# endif
-# endif
-
/* The __attribute__((__warn_unused_result__)) feature
is available in gcc versions 3.4 and newer,
while the typeof feature has been available since 2.7 at least. */
# define ignore_value(x) (({ __typeof__ (x) __x = (x); (void) __x; }))
# endif
-/* ignore_value works for scalars, pointers and aggregates;
- deprecate ignore_ptr. */
-static inline void _GL_ATTRIBUTE_DEPRECATED
-ignore_ptr (void *p) { (void) p; } /* deprecated: use ignore_value */
-
#endif
/* intprops.h -- properties of integer types
- Copyright (C) 2001-2005, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2005, 2009-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
-/* Copyright (C) 2006-2011 Free Software Foundation, Inc.
+/* Copyright (C) 2006-2012 Free Software Foundation, Inc.
Written by Paul Eggert, Bruno Haible, Derek Price.
This file is part of gnulib.
The include_next requires a split double-inclusion guard. */
#if ! defined INTTYPES_H || defined _GL_JUST_INCLUDE_SYSTEM_INTTYPES_H
# if @HAVE_INTTYPES_H@
+
+ /* Some pre-C++11 <stdint.h> implementations need this. */
+# if defined __cplusplus && ! defined __STDC_FORMAT_MACROS
+# define __STDC_FORMAT_MACROS 1
+# endif
+
# @INCLUDE_NEXT@ @NEXT_INTTYPES_H@
# endif
#endif
# error "This file assumes that 'int' has exactly 32 bits. Please report your platform and compiler to <bug-gnulib@gnu.org>."
#endif
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
/* The definition of _GL_ARG_NONNULL is copied here. */
/* The definition of _GL_WARN_ON_USE is copied here. */
/* 7.8.1 Macros for format specifiers */
-#if ! defined __cplusplus || defined __STDC_FORMAT_MACROS
-
-# if defined _TNS_R_TARGET
+#if defined _TNS_R_TARGET
/* Tandem NonStop R series and compatible platforms released before
July 2005 support %Ld but not %lld. */
-# define _LONG_LONG_FORMAT_PREFIX "L"
-# else
-# define _LONG_LONG_FORMAT_PREFIX "ll"
-# endif
+# define _LONG_LONG_FORMAT_PREFIX "L"
+#else
+# define _LONG_LONG_FORMAT_PREFIX "ll"
+#endif
-# if !defined PRId8 || @PRI_MACROS_BROKEN@
-# undef PRId8
-# ifdef INT8_MAX
-# define PRId8 "d"
-# endif
+#if !defined PRId8 || @PRI_MACROS_BROKEN@
+# undef PRId8
+# ifdef INT8_MAX
+# define PRId8 "d"
# endif
-# if !defined PRIi8 || @PRI_MACROS_BROKEN@
-# undef PRIi8
-# ifdef INT8_MAX
-# define PRIi8 "i"
-# endif
+#endif
+#if !defined PRIi8 || @PRI_MACROS_BROKEN@
+# undef PRIi8
+# ifdef INT8_MAX
+# define PRIi8 "i"
# endif
-# if !defined PRIo8 || @PRI_MACROS_BROKEN@
-# undef PRIo8
-# ifdef UINT8_MAX
-# define PRIo8 "o"
-# endif
+#endif
+#if !defined PRIo8 || @PRI_MACROS_BROKEN@
+# undef PRIo8
+# ifdef UINT8_MAX
+# define PRIo8 "o"
# endif
-# if !defined PRIu8 || @PRI_MACROS_BROKEN@
-# undef PRIu8
-# ifdef UINT8_MAX
-# define PRIu8 "u"
-# endif
+#endif
+#if !defined PRIu8 || @PRI_MACROS_BROKEN@
+# undef PRIu8
+# ifdef UINT8_MAX
+# define PRIu8 "u"
# endif
-# if !defined PRIx8 || @PRI_MACROS_BROKEN@
-# undef PRIx8
-# ifdef UINT8_MAX
-# define PRIx8 "x"
-# endif
+#endif
+#if !defined PRIx8 || @PRI_MACROS_BROKEN@
+# undef PRIx8
+# ifdef UINT8_MAX
+# define PRIx8 "x"
# endif
-# if !defined PRIX8 || @PRI_MACROS_BROKEN@
-# undef PRIX8
-# ifdef UINT8_MAX
-# define PRIX8 "X"
-# endif
+#endif
+#if !defined PRIX8 || @PRI_MACROS_BROKEN@
+# undef PRIX8
+# ifdef UINT8_MAX
+# define PRIX8 "X"
# endif
-# if !defined PRId16 || @PRI_MACROS_BROKEN@
-# undef PRId16
-# ifdef INT16_MAX
-# define PRId16 "d"
-# endif
+#endif
+#if !defined PRId16 || @PRI_MACROS_BROKEN@
+# undef PRId16
+# ifdef INT16_MAX
+# define PRId16 "d"
# endif
-# if !defined PRIi16 || @PRI_MACROS_BROKEN@
-# undef PRIi16
-# ifdef INT16_MAX
-# define PRIi16 "i"
-# endif
+#endif
+#if !defined PRIi16 || @PRI_MACROS_BROKEN@
+# undef PRIi16
+# ifdef INT16_MAX
+# define PRIi16 "i"
# endif
-# if !defined PRIo16 || @PRI_MACROS_BROKEN@
-# undef PRIo16
-# ifdef UINT16_MAX
-# define PRIo16 "o"
-# endif
+#endif
+#if !defined PRIo16 || @PRI_MACROS_BROKEN@
+# undef PRIo16
+# ifdef UINT16_MAX
+# define PRIo16 "o"
# endif
-# if !defined PRIu16 || @PRI_MACROS_BROKEN@
-# undef PRIu16
-# ifdef UINT16_MAX
-# define PRIu16 "u"
-# endif
+#endif
+#if !defined PRIu16 || @PRI_MACROS_BROKEN@
+# undef PRIu16
+# ifdef UINT16_MAX
+# define PRIu16 "u"
# endif
-# if !defined PRIx16 || @PRI_MACROS_BROKEN@
-# undef PRIx16
-# ifdef UINT16_MAX
-# define PRIx16 "x"
-# endif
+#endif
+#if !defined PRIx16 || @PRI_MACROS_BROKEN@
+# undef PRIx16
+# ifdef UINT16_MAX
+# define PRIx16 "x"
# endif
-# if !defined PRIX16 || @PRI_MACROS_BROKEN@
-# undef PRIX16
-# ifdef UINT16_MAX
-# define PRIX16 "X"
-# endif
+#endif
+#if !defined PRIX16 || @PRI_MACROS_BROKEN@
+# undef PRIX16
+# ifdef UINT16_MAX
+# define PRIX16 "X"
# endif
-# if !defined PRId32 || @PRI_MACROS_BROKEN@
-# undef PRId32
-# ifdef INT32_MAX
-# define PRId32 "d"
-# endif
+#endif
+#if !defined PRId32 || @PRI_MACROS_BROKEN@
+# undef PRId32
+# ifdef INT32_MAX
+# define PRId32 "d"
# endif
-# if !defined PRIi32 || @PRI_MACROS_BROKEN@
-# undef PRIi32
-# ifdef INT32_MAX
-# define PRIi32 "i"
-# endif
+#endif
+#if !defined PRIi32 || @PRI_MACROS_BROKEN@
+# undef PRIi32
+# ifdef INT32_MAX
+# define PRIi32 "i"
# endif
-# if !defined PRIo32 || @PRI_MACROS_BROKEN@
-# undef PRIo32
-# ifdef UINT32_MAX
-# define PRIo32 "o"
-# endif
+#endif
+#if !defined PRIo32 || @PRI_MACROS_BROKEN@
+# undef PRIo32
+# ifdef UINT32_MAX
+# define PRIo32 "o"
# endif
-# if !defined PRIu32 || @PRI_MACROS_BROKEN@
-# undef PRIu32
-# ifdef UINT32_MAX
-# define PRIu32 "u"
-# endif
+#endif
+#if !defined PRIu32 || @PRI_MACROS_BROKEN@
+# undef PRIu32
+# ifdef UINT32_MAX
+# define PRIu32 "u"
# endif
-# if !defined PRIx32 || @PRI_MACROS_BROKEN@
-# undef PRIx32
-# ifdef UINT32_MAX
-# define PRIx32 "x"
-# endif
+#endif
+#if !defined PRIx32 || @PRI_MACROS_BROKEN@
+# undef PRIx32
+# ifdef UINT32_MAX
+# define PRIx32 "x"
# endif
-# if !defined PRIX32 || @PRI_MACROS_BROKEN@
-# undef PRIX32
-# ifdef UINT32_MAX
-# define PRIX32 "X"
-# endif
+#endif
+#if !defined PRIX32 || @PRI_MACROS_BROKEN@
+# undef PRIX32
+# ifdef UINT32_MAX
+# define PRIX32 "X"
# endif
-# ifdef INT64_MAX
-# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @INT64_MAX_EQ_LONG_MAX@)
-# define _PRI64_PREFIX "l"
-# elif defined _MSC_VER || defined __MINGW32__
-# define _PRI64_PREFIX "I64"
-# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
-# define _PRI64_PREFIX _LONG_LONG_FORMAT_PREFIX
-# endif
-# if !defined PRId64 || @PRI_MACROS_BROKEN@
-# undef PRId64
-# define PRId64 _PRI64_PREFIX "d"
-# endif
-# if !defined PRIi64 || @PRI_MACROS_BROKEN@
-# undef PRIi64
-# define PRIi64 _PRI64_PREFIX "i"
-# endif
+#endif
+#ifdef INT64_MAX
+# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @INT64_MAX_EQ_LONG_MAX@)
+# define _PRI64_PREFIX "l"
+# elif defined _MSC_VER || defined __MINGW32__
+# define _PRI64_PREFIX "I64"
+# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# define _PRI64_PREFIX _LONG_LONG_FORMAT_PREFIX
+# endif
+# if !defined PRId64 || @PRI_MACROS_BROKEN@
+# undef PRId64
+# define PRId64 _PRI64_PREFIX "d"
+# endif
+# if !defined PRIi64 || @PRI_MACROS_BROKEN@
+# undef PRIi64
+# define PRIi64 _PRI64_PREFIX "i"
# endif
-# ifdef UINT64_MAX
-# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @UINT64_MAX_EQ_ULONG_MAX@)
-# define _PRIu64_PREFIX "l"
-# elif defined _MSC_VER || defined __MINGW32__
-# define _PRIu64_PREFIX "I64"
-# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
-# define _PRIu64_PREFIX _LONG_LONG_FORMAT_PREFIX
-# endif
-# if !defined PRIo64 || @PRI_MACROS_BROKEN@
-# undef PRIo64
-# define PRIo64 _PRIu64_PREFIX "o"
-# endif
-# if !defined PRIu64 || @PRI_MACROS_BROKEN@
-# undef PRIu64
-# define PRIu64 _PRIu64_PREFIX "u"
-# endif
-# if !defined PRIx64 || @PRI_MACROS_BROKEN@
-# undef PRIx64
-# define PRIx64 _PRIu64_PREFIX "x"
-# endif
-# if !defined PRIX64 || @PRI_MACROS_BROKEN@
-# undef PRIX64
-# define PRIX64 _PRIu64_PREFIX "X"
-# endif
+#endif
+#ifdef UINT64_MAX
+# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @UINT64_MAX_EQ_ULONG_MAX@)
+# define _PRIu64_PREFIX "l"
+# elif defined _MSC_VER || defined __MINGW32__
+# define _PRIu64_PREFIX "I64"
+# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# define _PRIu64_PREFIX _LONG_LONG_FORMAT_PREFIX
+# endif
+# if !defined PRIo64 || @PRI_MACROS_BROKEN@
+# undef PRIo64
+# define PRIo64 _PRIu64_PREFIX "o"
+# endif
+# if !defined PRIu64 || @PRI_MACROS_BROKEN@
+# undef PRIu64
+# define PRIu64 _PRIu64_PREFIX "u"
+# endif
+# if !defined PRIx64 || @PRI_MACROS_BROKEN@
+# undef PRIx64
+# define PRIx64 _PRIu64_PREFIX "x"
+# endif
+# if !defined PRIX64 || @PRI_MACROS_BROKEN@
+# undef PRIX64
+# define PRIX64 _PRIu64_PREFIX "X"
# endif
+#endif
-# if !defined PRIdLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST8
-# define PRIdLEAST8 "d"
-# endif
-# if !defined PRIiLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST8
-# define PRIiLEAST8 "i"
-# endif
-# if !defined PRIoLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST8
-# define PRIoLEAST8 "o"
-# endif
-# if !defined PRIuLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST8
-# define PRIuLEAST8 "u"
-# endif
-# if !defined PRIxLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST8
-# define PRIxLEAST8 "x"
-# endif
-# if !defined PRIXLEAST8 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST8
-# define PRIXLEAST8 "X"
-# endif
-# if !defined PRIdLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST16
-# define PRIdLEAST16 "d"
-# endif
-# if !defined PRIiLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST16
-# define PRIiLEAST16 "i"
-# endif
-# if !defined PRIoLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST16
-# define PRIoLEAST16 "o"
-# endif
-# if !defined PRIuLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST16
-# define PRIuLEAST16 "u"
-# endif
-# if !defined PRIxLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST16
-# define PRIxLEAST16 "x"
-# endif
-# if !defined PRIXLEAST16 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST16
-# define PRIXLEAST16 "X"
-# endif
-# if !defined PRIdLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST32
-# define PRIdLEAST32 "d"
-# endif
-# if !defined PRIiLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST32
-# define PRIiLEAST32 "i"
-# endif
-# if !defined PRIoLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST32
-# define PRIoLEAST32 "o"
-# endif
-# if !defined PRIuLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST32
-# define PRIuLEAST32 "u"
-# endif
-# if !defined PRIxLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST32
-# define PRIxLEAST32 "x"
-# endif
-# if !defined PRIXLEAST32 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST32
-# define PRIXLEAST32 "X"
-# endif
-# ifdef INT64_MAX
-# if !defined PRIdLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIdLEAST64
-# define PRIdLEAST64 PRId64
-# endif
-# if !defined PRIiLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIiLEAST64
-# define PRIiLEAST64 PRIi64
-# endif
+#if !defined PRIdLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIdLEAST8
+# define PRIdLEAST8 "d"
+#endif
+#if !defined PRIiLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIiLEAST8
+# define PRIiLEAST8 "i"
+#endif
+#if !defined PRIoLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIoLEAST8
+# define PRIoLEAST8 "o"
+#endif
+#if !defined PRIuLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIuLEAST8
+# define PRIuLEAST8 "u"
+#endif
+#if !defined PRIxLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIxLEAST8
+# define PRIxLEAST8 "x"
+#endif
+#if !defined PRIXLEAST8 || @PRI_MACROS_BROKEN@
+# undef PRIXLEAST8
+# define PRIXLEAST8 "X"
+#endif
+#if !defined PRIdLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIdLEAST16
+# define PRIdLEAST16 "d"
+#endif
+#if !defined PRIiLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIiLEAST16
+# define PRIiLEAST16 "i"
+#endif
+#if !defined PRIoLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIoLEAST16
+# define PRIoLEAST16 "o"
+#endif
+#if !defined PRIuLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIuLEAST16
+# define PRIuLEAST16 "u"
+#endif
+#if !defined PRIxLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIxLEAST16
+# define PRIxLEAST16 "x"
+#endif
+#if !defined PRIXLEAST16 || @PRI_MACROS_BROKEN@
+# undef PRIXLEAST16
+# define PRIXLEAST16 "X"
+#endif
+#if !defined PRIdLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIdLEAST32
+# define PRIdLEAST32 "d"
+#endif
+#if !defined PRIiLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIiLEAST32
+# define PRIiLEAST32 "i"
+#endif
+#if !defined PRIoLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIoLEAST32
+# define PRIoLEAST32 "o"
+#endif
+#if !defined PRIuLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIuLEAST32
+# define PRIuLEAST32 "u"
+#endif
+#if !defined PRIxLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIxLEAST32
+# define PRIxLEAST32 "x"
+#endif
+#if !defined PRIXLEAST32 || @PRI_MACROS_BROKEN@
+# undef PRIXLEAST32
+# define PRIXLEAST32 "X"
+#endif
+#ifdef INT64_MAX
+# if !defined PRIdLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIdLEAST64
+# define PRIdLEAST64 PRId64
# endif
-# ifdef UINT64_MAX
-# if !defined PRIoLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIoLEAST64
-# define PRIoLEAST64 PRIo64
-# endif
-# if !defined PRIuLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIuLEAST64
-# define PRIuLEAST64 PRIu64
-# endif
-# if !defined PRIxLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIxLEAST64
-# define PRIxLEAST64 PRIx64
-# endif
-# if !defined PRIXLEAST64 || @PRI_MACROS_BROKEN@
-# undef PRIXLEAST64
-# define PRIXLEAST64 PRIX64
-# endif
+# if !defined PRIiLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIiLEAST64
+# define PRIiLEAST64 PRIi64
+# endif
+#endif
+#ifdef UINT64_MAX
+# if !defined PRIoLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIoLEAST64
+# define PRIoLEAST64 PRIo64
+# endif
+# if !defined PRIuLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIuLEAST64
+# define PRIuLEAST64 PRIu64
+# endif
+# if !defined PRIxLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIxLEAST64
+# define PRIxLEAST64 PRIx64
# endif
+# if !defined PRIXLEAST64 || @PRI_MACROS_BROKEN@
+# undef PRIXLEAST64
+# define PRIXLEAST64 PRIX64
+# endif
+#endif
-# if !defined PRIdFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST8
-# if INT_FAST8_MAX > INT32_MAX
-# define PRIdFAST8 PRId64
-# else
-# define PRIdFAST8 "d"
-# endif
+#if !defined PRIdFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIdFAST8
+# if INT_FAST8_MAX > INT32_MAX
+# define PRIdFAST8 PRId64
+# else
+# define PRIdFAST8 "d"
# endif
-# if !defined PRIiFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST8
-# if INT_FAST8_MAX > INT32_MAX
-# define PRIiFAST8 PRIi64
-# else
-# define PRIiFAST8 "i"
-# endif
+#endif
+#if !defined PRIiFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIiFAST8
+# if INT_FAST8_MAX > INT32_MAX
+# define PRIiFAST8 PRIi64
+# else
+# define PRIiFAST8 "i"
# endif
-# if !defined PRIoFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define PRIoFAST8 PRIo64
-# else
-# define PRIoFAST8 "o"
-# endif
+#endif
+#if !defined PRIoFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIoFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define PRIoFAST8 PRIo64
+# else
+# define PRIoFAST8 "o"
# endif
-# if !defined PRIuFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define PRIuFAST8 PRIu64
-# else
-# define PRIuFAST8 "u"
-# endif
+#endif
+#if !defined PRIuFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIuFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define PRIuFAST8 PRIu64
+# else
+# define PRIuFAST8 "u"
# endif
-# if !defined PRIxFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define PRIxFAST8 PRIx64
-# else
-# define PRIxFAST8 "x"
-# endif
+#endif
+#if !defined PRIxFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIxFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define PRIxFAST8 PRIx64
+# else
+# define PRIxFAST8 "x"
# endif
-# if !defined PRIXFAST8 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define PRIXFAST8 PRIX64
-# else
-# define PRIXFAST8 "X"
-# endif
+#endif
+#if !defined PRIXFAST8 || @PRI_MACROS_BROKEN@
+# undef PRIXFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define PRIXFAST8 PRIX64
+# else
+# define PRIXFAST8 "X"
# endif
-# if !defined PRIdFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST16
-# if INT_FAST16_MAX > INT32_MAX
-# define PRIdFAST16 PRId64
-# else
-# define PRIdFAST16 "d"
-# endif
+#endif
+#if !defined PRIdFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIdFAST16
+# if INT_FAST16_MAX > INT32_MAX
+# define PRIdFAST16 PRId64
+# else
+# define PRIdFAST16 "d"
# endif
-# if !defined PRIiFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST16
-# if INT_FAST16_MAX > INT32_MAX
-# define PRIiFAST16 PRIi64
-# else
-# define PRIiFAST16 "i"
-# endif
+#endif
+#if !defined PRIiFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIiFAST16
+# if INT_FAST16_MAX > INT32_MAX
+# define PRIiFAST16 PRIi64
+# else
+# define PRIiFAST16 "i"
# endif
-# if !defined PRIoFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define PRIoFAST16 PRIo64
-# else
-# define PRIoFAST16 "o"
-# endif
+#endif
+#if !defined PRIoFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIoFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define PRIoFAST16 PRIo64
+# else
+# define PRIoFAST16 "o"
# endif
-# if !defined PRIuFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define PRIuFAST16 PRIu64
-# else
-# define PRIuFAST16 "u"
-# endif
+#endif
+#if !defined PRIuFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIuFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define PRIuFAST16 PRIu64
+# else
+# define PRIuFAST16 "u"
# endif
-# if !defined PRIxFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define PRIxFAST16 PRIx64
-# else
-# define PRIxFAST16 "x"
-# endif
+#endif
+#if !defined PRIxFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIxFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define PRIxFAST16 PRIx64
+# else
+# define PRIxFAST16 "x"
# endif
-# if !defined PRIXFAST16 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define PRIXFAST16 PRIX64
-# else
-# define PRIXFAST16 "X"
-# endif
+#endif
+#if !defined PRIXFAST16 || @PRI_MACROS_BROKEN@
+# undef PRIXFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define PRIXFAST16 PRIX64
+# else
+# define PRIXFAST16 "X"
# endif
-# if !defined PRIdFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST32
-# if INT_FAST32_MAX > INT32_MAX
-# define PRIdFAST32 PRId64
-# else
-# define PRIdFAST32 "d"
-# endif
+#endif
+#if !defined PRIdFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIdFAST32
+# if INT_FAST32_MAX > INT32_MAX
+# define PRIdFAST32 PRId64
+# else
+# define PRIdFAST32 "d"
# endif
-# if !defined PRIiFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST32
-# if INT_FAST32_MAX > INT32_MAX
-# define PRIiFAST32 PRIi64
-# else
-# define PRIiFAST32 "i"
-# endif
+#endif
+#if !defined PRIiFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIiFAST32
+# if INT_FAST32_MAX > INT32_MAX
+# define PRIiFAST32 PRIi64
+# else
+# define PRIiFAST32 "i"
# endif
-# if !defined PRIoFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define PRIoFAST32 PRIo64
-# else
-# define PRIoFAST32 "o"
-# endif
+#endif
+#if !defined PRIoFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIoFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define PRIoFAST32 PRIo64
+# else
+# define PRIoFAST32 "o"
# endif
-# if !defined PRIuFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define PRIuFAST32 PRIu64
-# else
-# define PRIuFAST32 "u"
-# endif
+#endif
+#if !defined PRIuFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIuFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define PRIuFAST32 PRIu64
+# else
+# define PRIuFAST32 "u"
# endif
-# if !defined PRIxFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define PRIxFAST32 PRIx64
-# else
-# define PRIxFAST32 "x"
-# endif
+#endif
+#if !defined PRIxFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIxFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define PRIxFAST32 PRIx64
+# else
+# define PRIxFAST32 "x"
# endif
-# if !defined PRIXFAST32 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define PRIXFAST32 PRIX64
-# else
-# define PRIXFAST32 "X"
-# endif
+#endif
+#if !defined PRIXFAST32 || @PRI_MACROS_BROKEN@
+# undef PRIXFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define PRIXFAST32 PRIX64
+# else
+# define PRIXFAST32 "X"
# endif
-# ifdef INT64_MAX
-# if !defined PRIdFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIdFAST64
-# define PRIdFAST64 PRId64
-# endif
-# if !defined PRIiFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIiFAST64
-# define PRIiFAST64 PRIi64
-# endif
+#endif
+#ifdef INT64_MAX
+# if !defined PRIdFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIdFAST64
+# define PRIdFAST64 PRId64
# endif
-# ifdef UINT64_MAX
-# if !defined PRIoFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIoFAST64
-# define PRIoFAST64 PRIo64
-# endif
-# if !defined PRIuFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIuFAST64
-# define PRIuFAST64 PRIu64
-# endif
-# if !defined PRIxFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIxFAST64
-# define PRIxFAST64 PRIx64
-# endif
-# if !defined PRIXFAST64 || @PRI_MACROS_BROKEN@
-# undef PRIXFAST64
-# define PRIXFAST64 PRIX64
-# endif
+# if !defined PRIiFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIiFAST64
+# define PRIiFAST64 PRIi64
+# endif
+#endif
+#ifdef UINT64_MAX
+# if !defined PRIoFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIoFAST64
+# define PRIoFAST64 PRIo64
+# endif
+# if !defined PRIuFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIuFAST64
+# define PRIuFAST64 PRIu64
+# endif
+# if !defined PRIxFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIxFAST64
+# define PRIxFAST64 PRIx64
# endif
+# if !defined PRIXFAST64 || @PRI_MACROS_BROKEN@
+# undef PRIXFAST64
+# define PRIXFAST64 PRIX64
+# endif
+#endif
-# if !defined PRIdMAX || @PRI_MACROS_BROKEN@
-# undef PRIdMAX
-# if @INT32_MAX_LT_INTMAX_MAX@
-# define PRIdMAX PRId64
-# else
-# define PRIdMAX "ld"
-# endif
+#if !defined PRIdMAX || @PRI_MACROS_BROKEN@
+# undef PRIdMAX
+# if @INT32_MAX_LT_INTMAX_MAX@
+# define PRIdMAX PRId64
+# else
+# define PRIdMAX "ld"
# endif
-# if !defined PRIiMAX || @PRI_MACROS_BROKEN@
-# undef PRIiMAX
-# if @INT32_MAX_LT_INTMAX_MAX@
-# define PRIiMAX PRIi64
-# else
-# define PRIiMAX "li"
-# endif
+#endif
+#if !defined PRIiMAX || @PRI_MACROS_BROKEN@
+# undef PRIiMAX
+# if @INT32_MAX_LT_INTMAX_MAX@
+# define PRIiMAX PRIi64
+# else
+# define PRIiMAX "li"
# endif
-# if !defined PRIoMAX || @PRI_MACROS_BROKEN@
-# undef PRIoMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define PRIoMAX PRIo64
-# else
-# define PRIoMAX "lo"
-# endif
+#endif
+#if !defined PRIoMAX || @PRI_MACROS_BROKEN@
+# undef PRIoMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define PRIoMAX PRIo64
+# else
+# define PRIoMAX "lo"
# endif
-# if !defined PRIuMAX || @PRI_MACROS_BROKEN@
-# undef PRIuMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define PRIuMAX PRIu64
-# else
-# define PRIuMAX "lu"
-# endif
+#endif
+#if !defined PRIuMAX || @PRI_MACROS_BROKEN@
+# undef PRIuMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define PRIuMAX PRIu64
+# else
+# define PRIuMAX "lu"
# endif
-# if !defined PRIxMAX || @PRI_MACROS_BROKEN@
-# undef PRIxMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define PRIxMAX PRIx64
-# else
-# define PRIxMAX "lx"
-# endif
+#endif
+#if !defined PRIxMAX || @PRI_MACROS_BROKEN@
+# undef PRIxMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define PRIxMAX PRIx64
+# else
+# define PRIxMAX "lx"
# endif
-# if !defined PRIXMAX || @PRI_MACROS_BROKEN@
-# undef PRIXMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define PRIXMAX PRIX64
-# else
-# define PRIXMAX "lX"
-# endif
+#endif
+#if !defined PRIXMAX || @PRI_MACROS_BROKEN@
+# undef PRIXMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define PRIXMAX PRIX64
+# else
+# define PRIXMAX "lX"
# endif
+#endif
-# if !defined PRIdPTR || @PRI_MACROS_BROKEN@
-# undef PRIdPTR
-# ifdef INTPTR_MAX
-# define PRIdPTR @PRIPTR_PREFIX@ "d"
-# endif
+#if !defined PRIdPTR || @PRI_MACROS_BROKEN@
+# undef PRIdPTR
+# ifdef INTPTR_MAX
+# define PRIdPTR @PRIPTR_PREFIX@ "d"
# endif
-# if !defined PRIiPTR || @PRI_MACROS_BROKEN@
-# undef PRIiPTR
-# ifdef INTPTR_MAX
-# define PRIiPTR @PRIPTR_PREFIX@ "i"
-# endif
+#endif
+#if !defined PRIiPTR || @PRI_MACROS_BROKEN@
+# undef PRIiPTR
+# ifdef INTPTR_MAX
+# define PRIiPTR @PRIPTR_PREFIX@ "i"
# endif
-# if !defined PRIoPTR || @PRI_MACROS_BROKEN@
-# undef PRIoPTR
-# ifdef UINTPTR_MAX
-# define PRIoPTR @PRIPTR_PREFIX@ "o"
-# endif
+#endif
+#if !defined PRIoPTR || @PRI_MACROS_BROKEN@
+# undef PRIoPTR
+# ifdef UINTPTR_MAX
+# define PRIoPTR @PRIPTR_PREFIX@ "o"
# endif
-# if !defined PRIuPTR || @PRI_MACROS_BROKEN@
-# undef PRIuPTR
-# ifdef UINTPTR_MAX
-# define PRIuPTR @PRIPTR_PREFIX@ "u"
-# endif
+#endif
+#if !defined PRIuPTR || @PRI_MACROS_BROKEN@
+# undef PRIuPTR
+# ifdef UINTPTR_MAX
+# define PRIuPTR @PRIPTR_PREFIX@ "u"
# endif
-# if !defined PRIxPTR || @PRI_MACROS_BROKEN@
-# undef PRIxPTR
-# ifdef UINTPTR_MAX
-# define PRIxPTR @PRIPTR_PREFIX@ "x"
-# endif
+#endif
+#if !defined PRIxPTR || @PRI_MACROS_BROKEN@
+# undef PRIxPTR
+# ifdef UINTPTR_MAX
+# define PRIxPTR @PRIPTR_PREFIX@ "x"
# endif
-# if !defined PRIXPTR || @PRI_MACROS_BROKEN@
-# undef PRIXPTR
-# ifdef UINTPTR_MAX
-# define PRIXPTR @PRIPTR_PREFIX@ "X"
-# endif
+#endif
+#if !defined PRIXPTR || @PRI_MACROS_BROKEN@
+# undef PRIXPTR
+# ifdef UINTPTR_MAX
+# define PRIXPTR @PRIPTR_PREFIX@ "X"
# endif
+#endif
-# if !defined SCNd8 || @PRI_MACROS_BROKEN@
-# undef SCNd8
-# ifdef INT8_MAX
-# define SCNd8 "hhd"
-# endif
+#if !defined SCNd8 || @PRI_MACROS_BROKEN@
+# undef SCNd8
+# ifdef INT8_MAX
+# define SCNd8 "hhd"
# endif
-# if !defined SCNi8 || @PRI_MACROS_BROKEN@
-# undef SCNi8
-# ifdef INT8_MAX
-# define SCNi8 "hhi"
-# endif
+#endif
+#if !defined SCNi8 || @PRI_MACROS_BROKEN@
+# undef SCNi8
+# ifdef INT8_MAX
+# define SCNi8 "hhi"
# endif
-# if !defined SCNo8 || @PRI_MACROS_BROKEN@
-# undef SCNo8
-# ifdef UINT8_MAX
-# define SCNo8 "hho"
-# endif
+#endif
+#if !defined SCNo8 || @PRI_MACROS_BROKEN@
+# undef SCNo8
+# ifdef UINT8_MAX
+# define SCNo8 "hho"
# endif
-# if !defined SCNu8 || @PRI_MACROS_BROKEN@
-# undef SCNu8
-# ifdef UINT8_MAX
-# define SCNu8 "hhu"
-# endif
+#endif
+#if !defined SCNu8 || @PRI_MACROS_BROKEN@
+# undef SCNu8
+# ifdef UINT8_MAX
+# define SCNu8 "hhu"
# endif
-# if !defined SCNx8 || @PRI_MACROS_BROKEN@
-# undef SCNx8
-# ifdef UINT8_MAX
-# define SCNx8 "hhx"
-# endif
+#endif
+#if !defined SCNx8 || @PRI_MACROS_BROKEN@
+# undef SCNx8
+# ifdef UINT8_MAX
+# define SCNx8 "hhx"
# endif
-# if !defined SCNd16 || @PRI_MACROS_BROKEN@
-# undef SCNd16
-# ifdef INT16_MAX
-# define SCNd16 "hd"
-# endif
+#endif
+#if !defined SCNd16 || @PRI_MACROS_BROKEN@
+# undef SCNd16
+# ifdef INT16_MAX
+# define SCNd16 "hd"
# endif
-# if !defined SCNi16 || @PRI_MACROS_BROKEN@
-# undef SCNi16
-# ifdef INT16_MAX
-# define SCNi16 "hi"
-# endif
+#endif
+#if !defined SCNi16 || @PRI_MACROS_BROKEN@
+# undef SCNi16
+# ifdef INT16_MAX
+# define SCNi16 "hi"
# endif
-# if !defined SCNo16 || @PRI_MACROS_BROKEN@
-# undef SCNo16
-# ifdef UINT16_MAX
-# define SCNo16 "ho"
-# endif
+#endif
+#if !defined SCNo16 || @PRI_MACROS_BROKEN@
+# undef SCNo16
+# ifdef UINT16_MAX
+# define SCNo16 "ho"
# endif
-# if !defined SCNu16 || @PRI_MACROS_BROKEN@
-# undef SCNu16
-# ifdef UINT16_MAX
-# define SCNu16 "hu"
-# endif
+#endif
+#if !defined SCNu16 || @PRI_MACROS_BROKEN@
+# undef SCNu16
+# ifdef UINT16_MAX
+# define SCNu16 "hu"
# endif
-# if !defined SCNx16 || @PRI_MACROS_BROKEN@
-# undef SCNx16
-# ifdef UINT16_MAX
-# define SCNx16 "hx"
-# endif
+#endif
+#if !defined SCNx16 || @PRI_MACROS_BROKEN@
+# undef SCNx16
+# ifdef UINT16_MAX
+# define SCNx16 "hx"
# endif
-# if !defined SCNd32 || @PRI_MACROS_BROKEN@
-# undef SCNd32
-# ifdef INT32_MAX
-# define SCNd32 "d"
-# endif
+#endif
+#if !defined SCNd32 || @PRI_MACROS_BROKEN@
+# undef SCNd32
+# ifdef INT32_MAX
+# define SCNd32 "d"
# endif
-# if !defined SCNi32 || @PRI_MACROS_BROKEN@
-# undef SCNi32
-# ifdef INT32_MAX
-# define SCNi32 "i"
-# endif
+#endif
+#if !defined SCNi32 || @PRI_MACROS_BROKEN@
+# undef SCNi32
+# ifdef INT32_MAX
+# define SCNi32 "i"
# endif
-# if !defined SCNo32 || @PRI_MACROS_BROKEN@
-# undef SCNo32
-# ifdef UINT32_MAX
-# define SCNo32 "o"
-# endif
+#endif
+#if !defined SCNo32 || @PRI_MACROS_BROKEN@
+# undef SCNo32
+# ifdef UINT32_MAX
+# define SCNo32 "o"
# endif
-# if !defined SCNu32 || @PRI_MACROS_BROKEN@
-# undef SCNu32
-# ifdef UINT32_MAX
-# define SCNu32 "u"
-# endif
+#endif
+#if !defined SCNu32 || @PRI_MACROS_BROKEN@
+# undef SCNu32
+# ifdef UINT32_MAX
+# define SCNu32 "u"
# endif
-# if !defined SCNx32 || @PRI_MACROS_BROKEN@
-# undef SCNx32
-# ifdef UINT32_MAX
-# define SCNx32 "x"
-# endif
+#endif
+#if !defined SCNx32 || @PRI_MACROS_BROKEN@
+# undef SCNx32
+# ifdef UINT32_MAX
+# define SCNx32 "x"
# endif
-# ifdef INT64_MAX
-# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @INT64_MAX_EQ_LONG_MAX@)
-# define _SCN64_PREFIX "l"
-# elif defined _MSC_VER || defined __MINGW32__
-# define _SCN64_PREFIX "I64"
-# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
-# define _SCN64_PREFIX _LONG_LONG_FORMAT_PREFIX
-# endif
-# if !defined SCNd64 || @PRI_MACROS_BROKEN@
-# undef SCNd64
-# define SCNd64 _SCN64_PREFIX "d"
-# endif
-# if !defined SCNi64 || @PRI_MACROS_BROKEN@
-# undef SCNi64
-# define SCNi64 _SCN64_PREFIX "i"
-# endif
+#endif
+#ifdef INT64_MAX
+# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @INT64_MAX_EQ_LONG_MAX@)
+# define _SCN64_PREFIX "l"
+# elif defined _MSC_VER || defined __MINGW32__
+# define _SCN64_PREFIX "I64"
+# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# define _SCN64_PREFIX _LONG_LONG_FORMAT_PREFIX
+# endif
+# if !defined SCNd64 || @PRI_MACROS_BROKEN@
+# undef SCNd64
+# define SCNd64 _SCN64_PREFIX "d"
+# endif
+# if !defined SCNi64 || @PRI_MACROS_BROKEN@
+# undef SCNi64
+# define SCNi64 _SCN64_PREFIX "i"
# endif
-# ifdef UINT64_MAX
-# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @UINT64_MAX_EQ_ULONG_MAX@)
-# define _SCNu64_PREFIX "l"
-# elif defined _MSC_VER || defined __MINGW32__
-# define _SCNu64_PREFIX "I64"
-# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
-# define _SCNu64_PREFIX _LONG_LONG_FORMAT_PREFIX
-# endif
-# if !defined SCNo64 || @PRI_MACROS_BROKEN@
-# undef SCNo64
-# define SCNo64 _SCNu64_PREFIX "o"
-# endif
-# if !defined SCNu64 || @PRI_MACROS_BROKEN@
-# undef SCNu64
-# define SCNu64 _SCNu64_PREFIX "u"
-# endif
-# if !defined SCNx64 || @PRI_MACROS_BROKEN@
-# undef SCNx64
-# define SCNx64 _SCNu64_PREFIX "x"
-# endif
+#endif
+#ifdef UINT64_MAX
+# if (@APPLE_UNIVERSAL_BUILD@ ? defined _LP64 : @UINT64_MAX_EQ_ULONG_MAX@)
+# define _SCNu64_PREFIX "l"
+# elif defined _MSC_VER || defined __MINGW32__
+# define _SCNu64_PREFIX "I64"
+# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# define _SCNu64_PREFIX _LONG_LONG_FORMAT_PREFIX
+# endif
+# if !defined SCNo64 || @PRI_MACROS_BROKEN@
+# undef SCNo64
+# define SCNo64 _SCNu64_PREFIX "o"
+# endif
+# if !defined SCNu64 || @PRI_MACROS_BROKEN@
+# undef SCNu64
+# define SCNu64 _SCNu64_PREFIX "u"
+# endif
+# if !defined SCNx64 || @PRI_MACROS_BROKEN@
+# undef SCNx64
+# define SCNx64 _SCNu64_PREFIX "x"
# endif
+#endif
-# if !defined SCNdLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST8
-# define SCNdLEAST8 "hhd"
-# endif
-# if !defined SCNiLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST8
-# define SCNiLEAST8 "hhi"
-# endif
-# if !defined SCNoLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST8
-# define SCNoLEAST8 "hho"
-# endif
-# if !defined SCNuLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST8
-# define SCNuLEAST8 "hhu"
-# endif
-# if !defined SCNxLEAST8 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST8
-# define SCNxLEAST8 "hhx"
-# endif
-# if !defined SCNdLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST16
-# define SCNdLEAST16 "hd"
-# endif
-# if !defined SCNiLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST16
-# define SCNiLEAST16 "hi"
-# endif
-# if !defined SCNoLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST16
-# define SCNoLEAST16 "ho"
-# endif
-# if !defined SCNuLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST16
-# define SCNuLEAST16 "hu"
-# endif
-# if !defined SCNxLEAST16 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST16
-# define SCNxLEAST16 "hx"
-# endif
-# if !defined SCNdLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST32
-# define SCNdLEAST32 "d"
-# endif
-# if !defined SCNiLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST32
-# define SCNiLEAST32 "i"
-# endif
-# if !defined SCNoLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST32
-# define SCNoLEAST32 "o"
-# endif
-# if !defined SCNuLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST32
-# define SCNuLEAST32 "u"
-# endif
-# if !defined SCNxLEAST32 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST32
-# define SCNxLEAST32 "x"
-# endif
-# ifdef INT64_MAX
-# if !defined SCNdLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNdLEAST64
-# define SCNdLEAST64 SCNd64
-# endif
-# if !defined SCNiLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNiLEAST64
-# define SCNiLEAST64 SCNi64
-# endif
+#if !defined SCNdLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNdLEAST8
+# define SCNdLEAST8 "hhd"
+#endif
+#if !defined SCNiLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNiLEAST8
+# define SCNiLEAST8 "hhi"
+#endif
+#if !defined SCNoLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNoLEAST8
+# define SCNoLEAST8 "hho"
+#endif
+#if !defined SCNuLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNuLEAST8
+# define SCNuLEAST8 "hhu"
+#endif
+#if !defined SCNxLEAST8 || @PRI_MACROS_BROKEN@
+# undef SCNxLEAST8
+# define SCNxLEAST8 "hhx"
+#endif
+#if !defined SCNdLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNdLEAST16
+# define SCNdLEAST16 "hd"
+#endif
+#if !defined SCNiLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNiLEAST16
+# define SCNiLEAST16 "hi"
+#endif
+#if !defined SCNoLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNoLEAST16
+# define SCNoLEAST16 "ho"
+#endif
+#if !defined SCNuLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNuLEAST16
+# define SCNuLEAST16 "hu"
+#endif
+#if !defined SCNxLEAST16 || @PRI_MACROS_BROKEN@
+# undef SCNxLEAST16
+# define SCNxLEAST16 "hx"
+#endif
+#if !defined SCNdLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNdLEAST32
+# define SCNdLEAST32 "d"
+#endif
+#if !defined SCNiLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNiLEAST32
+# define SCNiLEAST32 "i"
+#endif
+#if !defined SCNoLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNoLEAST32
+# define SCNoLEAST32 "o"
+#endif
+#if !defined SCNuLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNuLEAST32
+# define SCNuLEAST32 "u"
+#endif
+#if !defined SCNxLEAST32 || @PRI_MACROS_BROKEN@
+# undef SCNxLEAST32
+# define SCNxLEAST32 "x"
+#endif
+#ifdef INT64_MAX
+# if !defined SCNdLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNdLEAST64
+# define SCNdLEAST64 SCNd64
# endif
-# ifdef UINT64_MAX
-# if !defined SCNoLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNoLEAST64
-# define SCNoLEAST64 SCNo64
-# endif
-# if !defined SCNuLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNuLEAST64
-# define SCNuLEAST64 SCNu64
-# endif
-# if !defined SCNxLEAST64 || @PRI_MACROS_BROKEN@
-# undef SCNxLEAST64
-# define SCNxLEAST64 SCNx64
-# endif
+# if !defined SCNiLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNiLEAST64
+# define SCNiLEAST64 SCNi64
+# endif
+#endif
+#ifdef UINT64_MAX
+# if !defined SCNoLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNoLEAST64
+# define SCNoLEAST64 SCNo64
+# endif
+# if !defined SCNuLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNuLEAST64
+# define SCNuLEAST64 SCNu64
+# endif
+# if !defined SCNxLEAST64 || @PRI_MACROS_BROKEN@
+# undef SCNxLEAST64
+# define SCNxLEAST64 SCNx64
# endif
+#endif
-# if !defined SCNdFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST8
-# if INT_FAST8_MAX > INT32_MAX
-# define SCNdFAST8 SCNd64
-# elif INT_FAST8_MAX == 0x7fff
-# define SCNdFAST8 "hd"
-# elif INT_FAST8_MAX == 0x7f
-# define SCNdFAST8 "hhd"
-# else
-# define SCNdFAST8 "d"
-# endif
+#if !defined SCNdFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNdFAST8
+# if INT_FAST8_MAX > INT32_MAX
+# define SCNdFAST8 SCNd64
+# elif INT_FAST8_MAX == 0x7fff
+# define SCNdFAST8 "hd"
+# elif INT_FAST8_MAX == 0x7f
+# define SCNdFAST8 "hhd"
+# else
+# define SCNdFAST8 "d"
# endif
-# if !defined SCNiFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST8
-# if INT_FAST8_MAX > INT32_MAX
-# define SCNiFAST8 SCNi64
-# elif INT_FAST8_MAX == 0x7fff
-# define SCNiFAST8 "hi"
-# elif INT_FAST8_MAX == 0x7f
-# define SCNiFAST8 "hhi"
-# else
-# define SCNiFAST8 "i"
-# endif
+#endif
+#if !defined SCNiFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNiFAST8
+# if INT_FAST8_MAX > INT32_MAX
+# define SCNiFAST8 SCNi64
+# elif INT_FAST8_MAX == 0x7fff
+# define SCNiFAST8 "hi"
+# elif INT_FAST8_MAX == 0x7f
+# define SCNiFAST8 "hhi"
+# else
+# define SCNiFAST8 "i"
# endif
-# if !defined SCNoFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define SCNoFAST8 SCNo64
-# elif UINT_FAST8_MAX == 0xffff
-# define SCNoFAST8 "ho"
-# elif UINT_FAST8_MAX == 0xff
-# define SCNoFAST8 "hho"
-# else
-# define SCNoFAST8 "o"
-# endif
+#endif
+#if !defined SCNoFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNoFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define SCNoFAST8 SCNo64
+# elif UINT_FAST8_MAX == 0xffff
+# define SCNoFAST8 "ho"
+# elif UINT_FAST8_MAX == 0xff
+# define SCNoFAST8 "hho"
+# else
+# define SCNoFAST8 "o"
# endif
-# if !defined SCNuFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define SCNuFAST8 SCNu64
-# elif UINT_FAST8_MAX == 0xffff
-# define SCNuFAST8 "hu"
-# elif UINT_FAST8_MAX == 0xff
-# define SCNuFAST8 "hhu"
-# else
-# define SCNuFAST8 "u"
-# endif
+#endif
+#if !defined SCNuFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNuFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define SCNuFAST8 SCNu64
+# elif UINT_FAST8_MAX == 0xffff
+# define SCNuFAST8 "hu"
+# elif UINT_FAST8_MAX == 0xff
+# define SCNuFAST8 "hhu"
+# else
+# define SCNuFAST8 "u"
# endif
-# if !defined SCNxFAST8 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST8
-# if UINT_FAST8_MAX > UINT32_MAX
-# define SCNxFAST8 SCNx64
-# elif UINT_FAST8_MAX == 0xffff
-# define SCNxFAST8 "hx"
-# elif UINT_FAST8_MAX == 0xff
-# define SCNxFAST8 "hhx"
-# else
-# define SCNxFAST8 "x"
-# endif
+#endif
+#if !defined SCNxFAST8 || @PRI_MACROS_BROKEN@
+# undef SCNxFAST8
+# if UINT_FAST8_MAX > UINT32_MAX
+# define SCNxFAST8 SCNx64
+# elif UINT_FAST8_MAX == 0xffff
+# define SCNxFAST8 "hx"
+# elif UINT_FAST8_MAX == 0xff
+# define SCNxFAST8 "hhx"
+# else
+# define SCNxFAST8 "x"
# endif
-# if !defined SCNdFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST16
-# if INT_FAST16_MAX > INT32_MAX
-# define SCNdFAST16 SCNd64
-# elif INT_FAST16_MAX == 0x7fff
-# define SCNdFAST16 "hd"
-# else
-# define SCNdFAST16 "d"
-# endif
+#endif
+#if !defined SCNdFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNdFAST16
+# if INT_FAST16_MAX > INT32_MAX
+# define SCNdFAST16 SCNd64
+# elif INT_FAST16_MAX == 0x7fff
+# define SCNdFAST16 "hd"
+# else
+# define SCNdFAST16 "d"
# endif
-# if !defined SCNiFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST16
-# if INT_FAST16_MAX > INT32_MAX
-# define SCNiFAST16 SCNi64
-# elif INT_FAST16_MAX == 0x7fff
-# define SCNiFAST16 "hi"
-# else
-# define SCNiFAST16 "i"
-# endif
+#endif
+#if !defined SCNiFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNiFAST16
+# if INT_FAST16_MAX > INT32_MAX
+# define SCNiFAST16 SCNi64
+# elif INT_FAST16_MAX == 0x7fff
+# define SCNiFAST16 "hi"
+# else
+# define SCNiFAST16 "i"
# endif
-# if !defined SCNoFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define SCNoFAST16 SCNo64
-# elif UINT_FAST16_MAX == 0xffff
-# define SCNoFAST16 "ho"
-# else
-# define SCNoFAST16 "o"
-# endif
+#endif
+#if !defined SCNoFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNoFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define SCNoFAST16 SCNo64
+# elif UINT_FAST16_MAX == 0xffff
+# define SCNoFAST16 "ho"
+# else
+# define SCNoFAST16 "o"
# endif
-# if !defined SCNuFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define SCNuFAST16 SCNu64
-# elif UINT_FAST16_MAX == 0xffff
-# define SCNuFAST16 "hu"
-# else
-# define SCNuFAST16 "u"
-# endif
+#endif
+#if !defined SCNuFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNuFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define SCNuFAST16 SCNu64
+# elif UINT_FAST16_MAX == 0xffff
+# define SCNuFAST16 "hu"
+# else
+# define SCNuFAST16 "u"
# endif
-# if !defined SCNxFAST16 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST16
-# if UINT_FAST16_MAX > UINT32_MAX
-# define SCNxFAST16 SCNx64
-# elif UINT_FAST16_MAX == 0xffff
-# define SCNxFAST16 "hx"
-# else
-# define SCNxFAST16 "x"
-# endif
+#endif
+#if !defined SCNxFAST16 || @PRI_MACROS_BROKEN@
+# undef SCNxFAST16
+# if UINT_FAST16_MAX > UINT32_MAX
+# define SCNxFAST16 SCNx64
+# elif UINT_FAST16_MAX == 0xffff
+# define SCNxFAST16 "hx"
+# else
+# define SCNxFAST16 "x"
# endif
-# if !defined SCNdFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST32
-# if INT_FAST32_MAX > INT32_MAX
-# define SCNdFAST32 SCNd64
-# else
-# define SCNdFAST32 "d"
-# endif
+#endif
+#if !defined SCNdFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNdFAST32
+# if INT_FAST32_MAX > INT32_MAX
+# define SCNdFAST32 SCNd64
+# else
+# define SCNdFAST32 "d"
# endif
-# if !defined SCNiFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST32
-# if INT_FAST32_MAX > INT32_MAX
-# define SCNiFAST32 SCNi64
-# else
-# define SCNiFAST32 "i"
-# endif
+#endif
+#if !defined SCNiFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNiFAST32
+# if INT_FAST32_MAX > INT32_MAX
+# define SCNiFAST32 SCNi64
+# else
+# define SCNiFAST32 "i"
# endif
-# if !defined SCNoFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define SCNoFAST32 SCNo64
-# else
-# define SCNoFAST32 "o"
-# endif
+#endif
+#if !defined SCNoFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNoFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define SCNoFAST32 SCNo64
+# else
+# define SCNoFAST32 "o"
# endif
-# if !defined SCNuFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define SCNuFAST32 SCNu64
-# else
-# define SCNuFAST32 "u"
-# endif
+#endif
+#if !defined SCNuFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNuFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define SCNuFAST32 SCNu64
+# else
+# define SCNuFAST32 "u"
# endif
-# if !defined SCNxFAST32 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST32
-# if UINT_FAST32_MAX > UINT32_MAX
-# define SCNxFAST32 SCNx64
-# else
-# define SCNxFAST32 "x"
-# endif
+#endif
+#if !defined SCNxFAST32 || @PRI_MACROS_BROKEN@
+# undef SCNxFAST32
+# if UINT_FAST32_MAX > UINT32_MAX
+# define SCNxFAST32 SCNx64
+# else
+# define SCNxFAST32 "x"
# endif
-# ifdef INT64_MAX
-# if !defined SCNdFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNdFAST64
-# define SCNdFAST64 SCNd64
-# endif
-# if !defined SCNiFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNiFAST64
-# define SCNiFAST64 SCNi64
-# endif
+#endif
+#ifdef INT64_MAX
+# if !defined SCNdFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNdFAST64
+# define SCNdFAST64 SCNd64
# endif
-# ifdef UINT64_MAX
-# if !defined SCNoFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNoFAST64
-# define SCNoFAST64 SCNo64
-# endif
-# if !defined SCNuFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNuFAST64
-# define SCNuFAST64 SCNu64
-# endif
-# if !defined SCNxFAST64 || @PRI_MACROS_BROKEN@
-# undef SCNxFAST64
-# define SCNxFAST64 SCNx64
-# endif
+# if !defined SCNiFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNiFAST64
+# define SCNiFAST64 SCNi64
+# endif
+#endif
+#ifdef UINT64_MAX
+# if !defined SCNoFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNoFAST64
+# define SCNoFAST64 SCNo64
# endif
+# if !defined SCNuFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNuFAST64
+# define SCNuFAST64 SCNu64
+# endif
+# if !defined SCNxFAST64 || @PRI_MACROS_BROKEN@
+# undef SCNxFAST64
+# define SCNxFAST64 SCNx64
+# endif
+#endif
-# if !defined SCNdMAX || @PRI_MACROS_BROKEN@
-# undef SCNdMAX
-# if @INT32_MAX_LT_INTMAX_MAX@
-# define SCNdMAX SCNd64
-# else
-# define SCNdMAX "ld"
-# endif
+#if !defined SCNdMAX || @PRI_MACROS_BROKEN@
+# undef SCNdMAX
+# if @INT32_MAX_LT_INTMAX_MAX@
+# define SCNdMAX SCNd64
+# else
+# define SCNdMAX "ld"
# endif
-# if !defined SCNiMAX || @PRI_MACROS_BROKEN@
-# undef SCNiMAX
-# if @INT32_MAX_LT_INTMAX_MAX@
-# define SCNiMAX SCNi64
-# else
-# define SCNiMAX "li"
-# endif
+#endif
+#if !defined SCNiMAX || @PRI_MACROS_BROKEN@
+# undef SCNiMAX
+# if @INT32_MAX_LT_INTMAX_MAX@
+# define SCNiMAX SCNi64
+# else
+# define SCNiMAX "li"
# endif
-# if !defined SCNoMAX || @PRI_MACROS_BROKEN@
-# undef SCNoMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define SCNoMAX SCNo64
-# else
-# define SCNoMAX "lo"
-# endif
+#endif
+#if !defined SCNoMAX || @PRI_MACROS_BROKEN@
+# undef SCNoMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define SCNoMAX SCNo64
+# else
+# define SCNoMAX "lo"
# endif
-# if !defined SCNuMAX || @PRI_MACROS_BROKEN@
-# undef SCNuMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define SCNuMAX SCNu64
-# else
-# define SCNuMAX "lu"
-# endif
+#endif
+#if !defined SCNuMAX || @PRI_MACROS_BROKEN@
+# undef SCNuMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define SCNuMAX SCNu64
+# else
+# define SCNuMAX "lu"
# endif
-# if !defined SCNxMAX || @PRI_MACROS_BROKEN@
-# undef SCNxMAX
-# if @UINT32_MAX_LT_UINTMAX_MAX@
-# define SCNxMAX SCNx64
-# else
-# define SCNxMAX "lx"
-# endif
+#endif
+#if !defined SCNxMAX || @PRI_MACROS_BROKEN@
+# undef SCNxMAX
+# if @UINT32_MAX_LT_UINTMAX_MAX@
+# define SCNxMAX SCNx64
+# else
+# define SCNxMAX "lx"
# endif
+#endif
-# if !defined SCNdPTR || @PRI_MACROS_BROKEN@
-# undef SCNdPTR
-# ifdef INTPTR_MAX
-# define SCNdPTR @PRIPTR_PREFIX@ "d"
-# endif
+#if !defined SCNdPTR || @PRI_MACROS_BROKEN@
+# undef SCNdPTR
+# ifdef INTPTR_MAX
+# define SCNdPTR @PRIPTR_PREFIX@ "d"
# endif
-# if !defined SCNiPTR || @PRI_MACROS_BROKEN@
-# undef SCNiPTR
-# ifdef INTPTR_MAX
-# define SCNiPTR @PRIPTR_PREFIX@ "i"
-# endif
+#endif
+#if !defined SCNiPTR || @PRI_MACROS_BROKEN@
+# undef SCNiPTR
+# ifdef INTPTR_MAX
+# define SCNiPTR @PRIPTR_PREFIX@ "i"
# endif
-# if !defined SCNoPTR || @PRI_MACROS_BROKEN@
-# undef SCNoPTR
-# ifdef UINTPTR_MAX
-# define SCNoPTR @PRIPTR_PREFIX@ "o"
-# endif
+#endif
+#if !defined SCNoPTR || @PRI_MACROS_BROKEN@
+# undef SCNoPTR
+# ifdef UINTPTR_MAX
+# define SCNoPTR @PRIPTR_PREFIX@ "o"
# endif
-# if !defined SCNuPTR || @PRI_MACROS_BROKEN@
-# undef SCNuPTR
-# ifdef UINTPTR_MAX
-# define SCNuPTR @PRIPTR_PREFIX@ "u"
-# endif
+#endif
+#if !defined SCNuPTR || @PRI_MACROS_BROKEN@
+# undef SCNuPTR
+# ifdef UINTPTR_MAX
+# define SCNuPTR @PRIPTR_PREFIX@ "u"
# endif
-# if !defined SCNxPTR || @PRI_MACROS_BROKEN@
-# undef SCNxPTR
-# ifdef UINTPTR_MAX
-# define SCNxPTR @PRIPTR_PREFIX@ "x"
-# endif
+#endif
+#if !defined SCNxPTR || @PRI_MACROS_BROKEN@
+# undef SCNxPTR
+# ifdef UINTPTR_MAX
+# define SCNxPTR @PRIPTR_PREFIX@ "x"
# endif
-
#endif
/* 7.8.2 Functions for greatest-width integer types */
#endif
#if @GNULIB_STRTOIMAX@
-# if !@HAVE_DECL_STRTOIMAX@
-# undef strtoimax
-extern intmax_t strtoimax (const char *, char **, int) _GL_ARG_NONNULL ((1));
+# if @REPLACE_STRTOIMAX@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef strtoimax
+# define strtoimax rpl_strtoimax
+# endif
+_GL_FUNCDECL_RPL (strtoimax, intmax_t,
+ (const char *, char **, int) _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (strtoimax, intmax_t, (const char *, char **, int));
+# else
+# if !@HAVE_DECL_STRTOIMAX@
+# undef strtoimax
+_GL_FUNCDECL_SYS (strtoimax, intmax_t,
+ (const char *, char **, int) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (strtoimax, intmax_t, (const char *, char **, int));
# endif
+_GL_CXXALIASWARN (strtoimax);
#elif defined GNULIB_POSIXCHECK
# undef strtoimax
# if HAVE_RAW_DECL_STRTOIMAX
#if @GNULIB_STRTOUMAX@
# if !@HAVE_DECL_STRTOUMAX@
# undef strtoumax
-extern uintmax_t strtoumax (const char *, char **, int) _GL_ARG_NONNULL ((1));
+_GL_FUNCDECL_SYS (strtoumax, uintmax_t,
+ (const char *, char **, int) _GL_ARG_NONNULL ((1)));
# endif
+_GL_CXXALIAS_SYS (strtoumax, uintmax_t, (const char *, char **, int));
+_GL_CXXALIASWARN (strtoumax);
#elif defined GNULIB_POSIXCHECK
# undef strtoumax
# if HAVE_RAW_DECL_STRTOUMAX
/* Work around a bug of lstat on some systems
- Copyright (C) 1997-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 1997-2006, 2008-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
# include <errno.h>
/* lstat works differently on Linux and Solaris systems. POSIX (see
- `pathname resolution' in the glossary) requires that programs like
- `ls' take into consideration the fact that FILE has a trailing slash
+ "pathname resolution" in the glossary) requires that programs like
+ 'ls' take into consideration the fact that FILE has a trailing slash
when FILE is a symbolic link. On Linux and Solaris 10 systems, the
lstat function already has the desired semantics (in treating
- `lstat ("symlink/", sbuf)' just like `lstat ("symlink/.", sbuf)',
+ 'lstat ("symlink/", sbuf)' just like 'lstat ("symlink/.", sbuf)',
but on Solaris 9 and earlier it does not.
If FILE has a trailing slash and specifies a symbolic link,
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
-# Copyright (C) 2011 Free Software Foundation, Inc.
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
+# Copyright (C) 2011-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
.PHONY: $(ALL)
-LOCAL_FLAGS = -DHAVE_CONFIG_H=1 -I. -I../nt/inc -I../src
+LOCAL_FLAGS = -I. -I../nt/inc -I../src
LIBS =
-GNULIBOBJS = $(BLD)/dtoastr.$(O) \
+GNULIBOBJS = $(BLD)/c-ctype.$(O) \
+ $(BLD)/c-strcasecmp.$(O) \
+ $(BLD)/c-strncasecmp.$(O) \
+ $(BLD)/dtoastr.$(O) \
+ $(BLD)/dtotimespec.$(O) \
+ $(BLD)/execinfo.$(O) \
$(BLD)/getopt.$(O) \
$(BLD)/getopt1.$(O) \
+ $(BLD)/gettime.$(O) \
$(BLD)/strftime.$(O) \
$(BLD)/time_r.$(O) \
+ $(BLD)/timespec-add.$(O) \
+ $(BLD)/timespec-sub.$(O) \
$(BLD)/md5.$(O) \
$(BLD)/sha1.$(O) \
$(BLD)/sha256.$(O) \
$(BLD)/sha512.$(O) \
+ $(BLD)/stat-time.$(O) \
+ $(BLD)/timespec.$(O) \
+ $(BLD)/u64.$(O) \
$(BLD)/filemode.$(O)
#
- $(DEL) $@
$(AR) $(AR_OUT)$@ $(ALL_DEPS)
-gnulib: stamp_BLD $(BLD)/libgnu.$(A)
+gnulib: $(BLD)/libgnu.$(A)
#
# Build everything
#
-all: stamp_BLD $(ALL)
+all: $(ALL)
### TAGS ###
### DEPENDENCIES ###
EMACS_ROOT = ..
-SRC = .
+GNU_LIB = .
+SRC = $(EMACS_ROOT)/src
+NT_INC = $(EMACS_ROOT)/nt/inc
+
+C_CTYPE_H = $(GNU_LIB)/c-ctype.h \
+ $(NT_INC)/stdbool.h
+MS_W32_H = $(NT_INC)/ms-w32.h \
+ $(NT_INC)/sys/stat.h
+CONF_POST_H = $(SRC)/conf_post.h \
+ $(MS_W32_H)
+CONFIG_H = $(SRC)/config.h \
+ $(CONF_POST_H)
+FILEMODE_H = $(GNU_LIB)/filemode.h \
+ $(NT_INC)/sys/stat.h
+FTOASTR_H = $(GNU_LIB)/ftoastr.h \
+ $(GNU_LIB)/intprops.h
+FTOASTR_C = $(GNU_LIB)/ftoastr.c \
+ $(CONFIG_H) \
+ $(FTOASTR_H)
+GETOPT_INT_H = $(GNU_LIB)/getopt_int.h \
+ $(GNU_LIB)/getopt.h
+MD5_H = $(GNU_LIB)/md5.h \
+ $(NT_INC)/stdint.h
+SHA1_H = $(GNU_LIB)/sha1.h \
+ $(NT_INC)/stdint.h
+SHA256_H = $(GNU_LIB)/sha256.h \
+ $(NT_INC)/stdint.h
+U64_H = $(GNU_LIB)/u64.h \
+ $(NT_INC)/stdint.h
+SHA512_H = $(GNU_LIB)/sha512.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 \
+ $(CONFIG_H) \
+ $(C_CTYPE_H)
+
+$(BLD)/c-strcasecmp.$(O) : \
+ $(GNU_LIB)/c-strcasecmp.c \
+ $(GNU_LIB)/c-strcase.h \
+ $(CONFIG_H) \
+ $(C_CTYPE_H)
+
+$(BLD)/c-strncasecmp.$(O) : \
+ $(GNU_LIB)/c-strncasecmp.c \
+ $(GNU_LIB)/c-strcase.h \
+ $(CONFIG_H) \
+ $(C_CTYPE_H)
$(BLD)/dtoastr.$(O) : \
- $(SRC)/dtoastr.c \
- $(SRC)/ftoastr.c \
- $(SRC)/ftoastr.h \
- $(SRC)/intprops.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/dtoastr.c \
+ $(FTOASTR_C)
+
+$(BLD)/dtotimespec.$(O) : \
+ $(GNU_LIB)/dtotimespec.c \
+ $(GNU_LIB)/intprops.h \
+ $(GNU_LIB)/timespec.h \
+ $(CONFIG_H)
+
+$(BLD)/execinfo.$(O) : \
+ $(GNU_LIB)/execinfo.c \
+ $(GNU_LIB)/execinfo.h \
+ $(CONFIG_H)
$(BLD)/getopt.$(O) : \
- $(SRC)/getopt.c \
- $(SRC)/getopt.h \
- $(SRC)/getopt_int.h \
- $(SRC)/gettext.h \
- $(EMACS_ROOT)/nt/inc/unistd.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/getopt.c \
+ $(GNU_LIB)/getopt.h \
+ $(GNU_LIB)/gettext.h \
+ $(NT_INC)/unistd.h \
+ $(CONFIG_H) \
+ $(GETOPT_INT_H)
$(BLD)/getopt1.$(O) : \
- $(SRC)/getopt1.c \
- $(SRC)/getopt.h \
- $(SRC)/getopt_int.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/getopt1.c \
+ $(GNU_LIB)/getopt.h \
+ $(CONFIG_H) \
+ $(GETOPT_INT_H)
+
+$(BLD)/gettime.$(O) : \
+ $(GNU_LIB)/gettime.c \
+ $(GNU_LIB)/timespec.h \
+ $(NT_INC)/sys/time.h \
+ $(CONFIG_H)
$(BLD)/strftime.$(O) : \
- $(SRC)/strftime.c \
- $(SRC)/strftime.h \
- $(EMACS_ROOT)/nt/inc/stdbool.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/strftime.c \
+ $(GNU_LIB)/strftime.h \
+ $(NT_INC)/stdbool.h \
+ $(CONFIG_H)
$(BLD)/time_r.$(O) : \
- $(SRC)/time_r.c \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/time_r.c \
+ $(CONFIG_H)
+
+$(BLD)/timespec-add.$(O) : \
+ $(GNU_LIB)/timespec-add.c \
+ $(GNU_LIB)/intprops.h \
+ $(GNU_LIB)/timespec.h \
+ $(CONFIG_H)
+
+$(BLD)/timespec-sub.$(O) : \
+ $(GNU_LIB)/timespec-sub.c \
+ $(GNU_LIB)/intprops.h \
+ $(GNU_LIB)/timespec.h \
+ $(CONFIG_H)
$(BLD)/md5.$(O) : \
- $(SRC)/md5.c \
- $(SRC)/md5.h \
- $(EMACS_ROOT)/nt/inc/stdint.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/md5.c \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdint.h \
+ $(CONFIG_H) \
+ $(MD5_H)
$(BLD)/sha1.$(O) : \
- $(SRC)/sha1.c \
- $(SRC)/sha1.h \
- $(EMACS_ROOT)/nt/inc/stdint.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/sha1.c \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdint.h \
+ $(CONFIG_H) \
+ $(SHA1_H)
$(BLD)/sha256.$(O) : \
- $(SRC)/sha256.c \
- $(SRC)/sha256.h \
- $(EMACS_ROOT)/nt/inc/stdint.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/sha256.c \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdint.h \
+ $(CONFIG_H) \
+ $(SHA256_H)
$(BLD)/sha512.$(O) : \
- $(SRC)/sha512.c \
- $(SRC)/sha512.h \
- $(EMACS_ROOT)/nt/inc/stdint.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/sha512.c \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdint.h \
+ $(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) : \
- $(SRC)/filemode.c \
- $(SRC)/filemode.h \
- $(EMACS_ROOT)/nt/inc/sys/stat.h \
- $(EMACS_ROOT)/src/s/ms-w32.h \
- $(EMACS_ROOT)/src/m/intel386.h \
- $(EMACS_ROOT)/src/config.h
+ $(GNU_LIB)/filemode.c \
+ $(CONFIG_H) \
+ $(FILEMODE_H)
# The following dependencies are for supporting parallel builds, where
# we must make sure $(BLD) exists before any compilation starts.
#
-$(BLD)/dtoastr.$(O) $(BLD)/getopt.$(O) $(BLD)/getopt1.$(O): stamp_BLD
-$(BLD)/strftime.$(O) $(BLD)/time_r.$(O) $(BLD)/md5.$(O): stamp_BLD
-$(BLD)/sha1.$(O) $(BLD)/sha256.$(O) $(BLD)/sha512.$(O): stamp_BLD
-$(BLD)/filemode.$(O): stamp_BLD
+$(GNULIBOBJS): stamp_BLD
#
# Headers we would preprocess if we could.
< getopt.in.h > getopt_.h-t
$(CP) getopt_.h-t getopt_.h
- $(DEL) getopt_.h-t
+
+execinfo.h: execinfo.in.h
+ $(CP) execinfo.in.h $@
+
/* Functions to compute MD5 message digest of files or memory blocks.
according to the definition of MD5 in RFC 1321 from April 1992.
- Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2011 Free Software
+ Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Ulrich Drepper <drepper@gnu.ai.mit.edu>, 1995. */
#include "md5.h"
-#include <stddef.h>
+#include <stdalign.h>
+#include <stdint.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
if (len >= 64)
{
#if !_STRING_ARCH_unaligned
-# define alignof(type) offsetof (struct { char c; type x; }, x)
-# define UNALIGNED_P(p) (((size_t) p) % alignof (uint32_t) != 0)
+# define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (uint32_t) != 0)
if (UNALIGNED_P (buffer))
while (len > 64)
{
uint32_t B = ctx->B;
uint32_t C = ctx->C;
uint32_t D = ctx->D;
+ uint32_t lolen = len;
/* First increment the byte count. RFC 1321 specifies the possible
length of the file up to 2^64 bits. Here we only compute the
number of bytes. Do a double word increment. */
- ctx->total[0] += len;
- if (ctx->total[0] < len)
- ++ctx->total[1];
+ ctx->total[0] += lolen;
+ ctx->total[1] += (len >> 31 >> 1) + (ctx->total[0] < lolen);
/* Process all bytes in the buffer with 64 bytes in each round of
the loop. */
/* Declaration of functions and data types used for MD5 sum computing
library functions.
- Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2011 Free Software
+ Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2012 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef _MD5_H
#define _MD5_H 1
/*
* The following three functions are build up the low level used in
- * the functions `md5_stream' and `md5_buffer'.
+ * the functions 'md5_stream' and 'md5_buffer'.
*/
/* Initialize structure containing state of computation.
-/* Convert a `struct tm' to a time_t value.
- Copyright (C) 1993-1999, 2002-2007, 2009-2011 Free Software Foundation, Inc.
+/* Convert a 'struct tm' to a time_t value.
+ Copyright (C) 1993-2012 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Paul Eggert <eggert@twinsun.com>.
- 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, or (at your option)
- any later version.
+ The GNU C Library 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.
- This program is distributed in the hope that it will be useful,
+ The GNU C Library 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.
+ 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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ You should have received a copy of the GNU General Public
+ License along with the GNU C Library; if not, see
+ <http://www.gnu.org/licenses/>. */
/* Define this to have a standalone program to test this implementation of
mktime. */
# include <config.h>
#endif
-/* Some of the code in this file assumes that signed integer overflow
- silently wraps around. This assumption can't easily be programmed
- around, nor can it be checked for portably at compile-time or
- easily eliminated at run-time.
-
- Define WRAPV to 1 if the assumption is valid. Otherwise, define it
- to 0; this forces the use of slower code that, while not guaranteed
- by the C Standard, works on all production platforms that we know
- about. */
-#ifndef WRAPV
-# if (__GNUC__ == 4 && 4 <= __GNUC_MINOR__) || 4 < __GNUC__
-# pragma GCC optimize ("wrapv")
-# define WRAPV 1
-# else
-# define WRAPV 0
-# endif
-#endif
-
/* Assume that leap seconds are possible, unless told otherwise.
- If the host has a `zic' command with a `-L leapsecondfilename' option,
+ If the host has a 'zic' command with a '-L leapsecondfilename' option,
then it supports leap seconds; otherwise it probably doesn't. */
#ifndef LEAP_SECONDS_POSSIBLE
# define LEAP_SECONDS_POSSIBLE 1
#include <limits.h>
-#include <string.h> /* For the real memcpy prototype. */
+#include <string.h> /* For the real memcpy prototype. */
#if DEBUG
# include <stdio.h>
# define mktime my_mktime
#endif /* DEBUG */
+/* Some of the code in this file assumes that signed integer overflow
+ silently wraps around. This assumption can't easily be programmed
+ around, nor can it be checked for portably at compile-time or
+ easily eliminated at run-time.
+
+ Define WRAPV to 1 if the assumption is valid and if
+ #pragma GCC optimize ("wrapv")
+ does not trigger GCC bug 51793
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=51793>.
+ Otherwise, define it to 0; this forces the use of slower code that,
+ while not guaranteed by the C Standard, works on all production
+ platforms that we know about. */
+#ifndef WRAPV
+# if (((__GNUC__ == 4 && 4 <= __GNUC_MINOR__) || 4 < __GNUC__) \
+ && defined __GLIBC__)
+# pragma GCC optimize ("wrapv")
+# define WRAPV 1
+# else
+# define WRAPV 0
+# endif
+#endif
+
/* Verify a requirement at compile-time (unlike assert, which is runtime). */
#define verify(name, assertion) struct name { char a[(assertion) ? 1 : -1]; }
your host. */
#define TYPE_MINIMUM(t) \
((t) (! TYPE_SIGNED (t) \
- ? (t) 0 \
- : ~ TYPE_MAXIMUM (t)))
+ ? (t) 0 \
+ : ~ TYPE_MAXIMUM (t)))
#define TYPE_MAXIMUM(t) \
((t) (! TYPE_SIGNED (t) \
- ? (t) -1 \
- : ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1)))
+ ? (t) -1 \
+ : ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1)))
#ifndef TIME_T_MIN
# define TIME_T_MIN TYPE_MINIMUM (time_t)
verify (time_t_is_integer, TYPE_IS_INTEGER (time_t));
verify (twos_complement_arithmetic,
- (TYPE_TWOS_COMPLEMENT (int)
- && TYPE_TWOS_COMPLEMENT (long_int)
- && TYPE_TWOS_COMPLEMENT (time_t)));
+ (TYPE_TWOS_COMPLEMENT (int)
+ && TYPE_TWOS_COMPLEMENT (long_int)
+ && TYPE_TWOS_COMPLEMENT (time_t)));
#define EPOCH_YEAR 1970
#define TM_YEAR_BASE 1900
verify (base_year_is_a_multiple_of_100, TM_YEAR_BASE % 100 == 0);
/* Return 1 if YEAR + TM_YEAR_BASE is a leap year. */
-static inline int
+static int
leapyear (long_int year)
{
/* Don't add YEAR to TM_YEAR_BASE, as that might overflow.
return
((year & 3) == 0
&& (year % 100 != 0
- || ((year / 100) & 3) == (- (TM_YEAR_BASE / 100) & 3)));
+ || ((year / 100) & 3) == (- (TM_YEAR_BASE / 100) & 3)));
}
/* How many days come before each month (0-12). */
static int
isdst_differ (int a, int b)
{
- return (!a != !b) & (0 <= a) & (0 <= b);
+ return (!a != !b) && (0 <= a) && (0 <= b);
}
/* Return an integer value measuring (YEAR1-YDAY1 HOUR1:MIN1:SEC1) -
The result may overflow. It is the caller's responsibility to
detect overflow. */
-static inline time_t
+static time_t
ydhms_diff (long_int year1, long_int yday1, int hour1, int min1, int sec1,
- int year0, int yday0, int hour0, int min0, int sec0)
+ int year0, int yday0, int hour0, int min0, int sec0)
{
verify (C99_integer_division, -1 / 2 == 0);
yield a value equal to *T. */
static time_t
guess_time_tm (long_int year, long_int yday, int hour, int min, int sec,
- const time_t *t, const struct tm *tp)
+ const time_t *t, const struct tm *tp)
{
if (tp)
{
time_t d = ydhms_diff (year, yday, hour, min, sec,
- tp->tm_year, tp->tm_yday,
- tp->tm_hour, tp->tm_min, tp->tm_sec);
+ tp->tm_year, tp->tm_yday,
+ tp->tm_hour, tp->tm_min, tp->tm_sec);
if (time_t_add_ok (*t, d))
- return *t + d;
+ return *t + d;
}
/* Overflow occurred one way or another. Return the nearest result
match; and don't oscillate between two values, as that would
confuse the spring-forward gap detector. */
return (*t < TIME_T_MIDPOINT
- ? (*t <= TIME_T_MIN + 1 ? *t + 1 : TIME_T_MIN)
- : (TIME_T_MAX - 1 <= *t ? *t - 1 : TIME_T_MAX));
+ ? (*t <= TIME_T_MIN + 1 ? *t + 1 : TIME_T_MIN)
+ : (TIME_T_MAX - 1 <= *t ? *t - 1 : TIME_T_MAX));
}
/* Use CONVERT to convert *T to a broken down time in *TP.
it is the nearest in-range value and then convert that. */
static struct tm *
ranged_convert (struct tm *(*convert) (const time_t *, struct tm *),
- time_t *t, struct tm *tp)
+ time_t *t, struct tm *tp)
{
struct tm *r = convert (t, tp);
time_t ok = 0;
/* BAD is a known unconvertible time_t, and OK is a known good one.
- Use binary search to narrow the range between BAD and OK until
- they differ by 1. */
+ Use binary search to narrow the range between BAD and OK until
+ they differ by 1. */
while (bad != ok + (bad < 0 ? -1 : 1))
- {
- time_t mid = *t = time_t_avg (ok, bad);
- r = convert (t, tp);
- if (r)
- ok = mid;
- else
- bad = mid;
- }
+ {
+ time_t mid = *t = time_t_avg (ok, bad);
+ r = convert (t, tp);
+ if (r)
+ ok = mid;
+ else
+ bad = mid;
+ }
if (!r && ok)
- {
- /* The last conversion attempt failed;
- revert to the most recent successful attempt. */
- *t = ok;
- r = convert (t, tp);
- }
+ {
+ /* The last conversion attempt failed;
+ revert to the most recent successful attempt. */
+ *t = ok;
+ r = convert (t, tp);
+ }
}
return r;
This function is external because it is used also by timegm.c. */
time_t
__mktime_internal (struct tm *tp,
- struct tm *(*convert) (const time_t *, struct tm *),
- time_t *offset)
+ struct tm *(*convert) (const time_t *, struct tm *),
+ time_t *offset)
{
time_t t, gt, t0, t1, t2;
struct tm tm;
/* Calculate day of year from year, month, and day of month.
The result need not be in range. */
int mon_yday = ((__mon_yday[leapyear (year)]
- [mon_remainder + 12 * negative_mon_remainder])
- - 1);
+ [mon_remainder + 12 * negative_mon_remainder])
+ - 1);
long_int lmday = mday;
long_int yday = mon_yday + lmday;
if (LEAP_SECONDS_POSSIBLE)
{
/* Handle out-of-range seconds specially,
- since ydhms_tm_diff assumes every minute has 60 seconds. */
+ since ydhms_tm_diff assumes every minute has 60 seconds. */
if (sec < 0)
- sec = 0;
+ sec = 0;
if (59 < sec)
- sec = 59;
+ sec = 59;
}
/* Invert CONVERT by probing. First assume the same offset as last
time. */
t0 = ydhms_diff (year, yday, hour, min, sec,
- EPOCH_YEAR - TM_YEAR_BASE, 0, 0, 0, - guessed_offset);
+ EPOCH_YEAR - TM_YEAR_BASE, 0, 0, 0, - guessed_offset);
if (TIME_T_MAX / INT_MAX / 366 / 24 / 60 / 60 < 3)
{
/* time_t isn't large enough to rule out overflows, so check
- for major overflows. A gross check suffices, since if t0
- has overflowed, it is off by a multiple of TIME_T_MAX -
- TIME_T_MIN + 1. So ignore any component of the difference
- that is bounded by a small value. */
+ for major overflows. A gross check suffices, since if t0
+ has overflowed, it is off by a multiple of TIME_T_MAX -
+ TIME_T_MIN + 1. So ignore any component of the difference
+ that is bounded by a small value. */
/* Approximate log base 2 of the number of time units per
- biennium. A biennium is 2 years; use this unit instead of
- years to avoid integer overflow. For example, 2 average
- Gregorian years are 2 * 365.2425 * 24 * 60 * 60 seconds,
- which is 63113904 seconds, and rint (log2 (63113904)) is
- 26. */
+ biennium. A biennium is 2 years; use this unit instead of
+ years to avoid integer overflow. For example, 2 average
+ Gregorian years are 2 * 365.2425 * 24 * 60 * 60 seconds,
+ which is 63113904 seconds, and rint (log2 (63113904)) is
+ 26. */
int ALOG2_SECONDS_PER_BIENNIUM = 26;
int ALOG2_MINUTES_PER_BIENNIUM = 20;
int ALOG2_HOURS_PER_BIENNIUM = 14;
int LOG2_YEARS_PER_BIENNIUM = 1;
int approx_requested_biennia =
- (SHR (year_requested, LOG2_YEARS_PER_BIENNIUM)
- - SHR (EPOCH_YEAR - TM_YEAR_BASE, LOG2_YEARS_PER_BIENNIUM)
- + SHR (mday, ALOG2_DAYS_PER_BIENNIUM)
- + SHR (hour, ALOG2_HOURS_PER_BIENNIUM)
- + SHR (min, ALOG2_MINUTES_PER_BIENNIUM)
- + (LEAP_SECONDS_POSSIBLE
- ? 0
- : SHR (sec, ALOG2_SECONDS_PER_BIENNIUM)));
+ (SHR (year_requested, LOG2_YEARS_PER_BIENNIUM)
+ - SHR (EPOCH_YEAR - TM_YEAR_BASE, LOG2_YEARS_PER_BIENNIUM)
+ + SHR (mday, ALOG2_DAYS_PER_BIENNIUM)
+ + SHR (hour, ALOG2_HOURS_PER_BIENNIUM)
+ + SHR (min, ALOG2_MINUTES_PER_BIENNIUM)
+ + (LEAP_SECONDS_POSSIBLE
+ ? 0
+ : SHR (sec, ALOG2_SECONDS_PER_BIENNIUM)));
int approx_biennia = SHR (t0, ALOG2_SECONDS_PER_BIENNIUM);
int diff = approx_biennia - approx_requested_biennia;
- int abs_diff = diff < 0 ? -1 - diff : diff;
+ int approx_abs_diff = diff < 0 ? -1 - diff : diff;
/* IRIX 4.0.5 cc miscalculates TIME_T_MIN / 3: it erroneously
- gives a positive value of 715827882. Setting a variable
- first then doing math on it seems to work.
- (ghazi@caip.rutgers.edu) */
+ gives a positive value of 715827882. Setting a variable
+ first then doing math on it seems to work.
+ (ghazi@caip.rutgers.edu) */
time_t time_t_max = TIME_T_MAX;
time_t time_t_min = TIME_T_MIN;
time_t overflow_threshold =
- (time_t_max / 3 - time_t_min / 3) >> ALOG2_SECONDS_PER_BIENNIUM;
-
- if (overflow_threshold < abs_diff)
- {
- /* Overflow occurred. Try repairing it; this might work if
- the time zone offset is enough to undo the overflow. */
- time_t repaired_t0 = -1 - t0;
- approx_biennia = SHR (repaired_t0, ALOG2_SECONDS_PER_BIENNIUM);
- diff = approx_biennia - approx_requested_biennia;
- abs_diff = diff < 0 ? -1 - diff : diff;
- if (overflow_threshold < abs_diff)
- return -1;
- guessed_offset += repaired_t0 - t0;
- t0 = repaired_t0;
- }
+ (time_t_max / 3 - time_t_min / 3) >> ALOG2_SECONDS_PER_BIENNIUM;
+
+ if (overflow_threshold < approx_abs_diff)
+ {
+ /* Overflow occurred. Try repairing it; this might work if
+ the time zone offset is enough to undo the overflow. */
+ time_t repaired_t0 = -1 - t0;
+ approx_biennia = SHR (repaired_t0, ALOG2_SECONDS_PER_BIENNIUM);
+ diff = approx_biennia - approx_requested_biennia;
+ approx_abs_diff = diff < 0 ? -1 - diff : diff;
+ if (overflow_threshold < approx_abs_diff)
+ return -1;
+ guessed_offset += repaired_t0 - t0;
+ t0 = repaired_t0;
+ }
}
/* Repeatedly use the error to improve the guess. */
for (t = t1 = t2 = t0, dst2 = 0;
(gt = guess_time_tm (year, yday, hour, min, sec, &t,
- ranged_convert (convert, &t, &tm)),
- t != gt);
+ ranged_convert (convert, &t, &tm)),
+ t != gt);
t1 = t2, t2 = t, t = gt, dst2 = tm.tm_isdst != 0)
if (t == t1 && t != t2
- && (tm.tm_isdst < 0
- || (isdst < 0
- ? dst2 <= (tm.tm_isdst != 0)
- : (isdst != 0) != (tm.tm_isdst != 0))))
+ && (tm.tm_isdst < 0
+ || (isdst < 0
+ ? dst2 <= (tm.tm_isdst != 0)
+ : (isdst != 0) != (tm.tm_isdst != 0))))
/* We can't possibly find a match, as we are oscillating
- between two values. The requested time probably falls
- within a spring-forward gap of size GT - T. Follow the common
- practice in this case, which is to return a time that is GT - T
- away from the requested time, preferring a time whose
- tm_isdst differs from the requested value. (If no tm_isdst
- was requested and only one of the two values has a nonzero
- tm_isdst, prefer that value.) In practice, this is more
- useful than returning -1. */
+ between two values. The requested time probably falls
+ within a spring-forward gap of size GT - T. Follow the common
+ practice in this case, which is to return a time that is GT - T
+ away from the requested time, preferring a time whose
+ tm_isdst differs from the requested value. (If no tm_isdst
+ was requested and only one of the two values has a nonzero
+ tm_isdst, prefer that value.) In practice, this is more
+ useful than returning -1. */
goto offset_found;
else if (--remaining_probes == 0)
return -1;
if (isdst_differ (isdst, tm.tm_isdst))
{
/* tm.tm_isdst has the wrong value. Look for a neighboring
- time with the right value, and use its UTC offset.
+ time with the right value, and use its UTC offset.
- Heuristic: probe the adjacent timestamps in both directions,
- looking for the desired isdst. This should work for all real
- time zone histories in the tz database. */
+ Heuristic: probe the adjacent timestamps in both directions,
+ looking for the desired isdst. This should work for all real
+ time zone histories in the tz database. */
/* Distance between probes when looking for a DST boundary. In
- tzdata2003a, the shortest period of DST is 601200 seconds
- (e.g., America/Recife starting 2000-10-08 01:00), and the
- shortest period of non-DST surrounded by DST is 694800
- seconds (Africa/Tunis starting 1943-04-17 01:00). Use the
- minimum of these two values, so we don't miss these short
- periods when probing. */
+ tzdata2003a, the shortest period of DST is 601200 seconds
+ (e.g., America/Recife starting 2000-10-08 01:00), and the
+ shortest period of non-DST surrounded by DST is 694800
+ seconds (Africa/Tunis starting 1943-04-17 01:00). Use the
+ minimum of these two values, so we don't miss these short
+ periods when probing. */
int stride = 601200;
/* The longest period of DST in tzdata2003a is 536454000 seconds
- (e.g., America/Jujuy starting 1946-10-01 01:00). The longest
- period of non-DST is much longer, but it makes no real sense
- to search for more than a year of non-DST, so use the DST
- max. */
+ (e.g., America/Jujuy starting 1946-10-01 01:00). The longest
+ period of non-DST is much longer, but it makes no real sense
+ to search for more than a year of non-DST, so use the DST
+ max. */
int duration_max = 536454000;
/* Search in both directions, so the maximum distance is half
- the duration; add the stride to avoid off-by-1 problems. */
+ the duration; add the stride to avoid off-by-1 problems. */
int delta_bound = duration_max / 2 + stride;
int delta, direction;
for (delta = stride; delta < delta_bound; delta += stride)
- for (direction = -1; direction <= 1; direction += 2)
- if (time_t_int_add_ok (t, delta * direction))
- {
- time_t ot = t + delta * direction;
- struct tm otm;
- ranged_convert (convert, &ot, &otm);
- if (! isdst_differ (isdst, otm.tm_isdst))
- {
- /* We found the desired tm_isdst.
- Extrapolate back to the desired time. */
- t = guess_time_tm (year, yday, hour, min, sec, &ot, &otm);
- ranged_convert (convert, &t, &tm);
- goto offset_found;
- }
- }
+ for (direction = -1; direction <= 1; direction += 2)
+ if (time_t_int_add_ok (t, delta * direction))
+ {
+ time_t ot = t + delta * direction;
+ struct tm otm;
+ ranged_convert (convert, &ot, &otm);
+ if (! isdst_differ (isdst, otm.tm_isdst))
+ {
+ /* We found the desired tm_isdst.
+ Extrapolate back to the desired time. */
+ t = guess_time_tm (year, yday, hour, min, sec, &ot, &otm);
+ ranged_convert (convert, &t, &tm);
+ goto offset_found;
+ }
+ }
}
offset_found:
if (LEAP_SECONDS_POSSIBLE && sec_requested != tm.tm_sec)
{
/* Adjust time to reflect the tm_sec requested, not the normalized value.
- Also, repair any damage from a false match due to a leap second. */
+ Also, repair any damage from a false match due to a leap second. */
int sec_adjustment = (sec == 0 && tm.tm_sec == 60) - sec;
if (! time_t_int_add_ok (t, sec_requested))
- return -1;
+ return -1;
t1 = t + sec_requested;
if (! time_t_int_add_ok (t1, sec_adjustment))
- return -1;
+ return -1;
t2 = t1 + sec_adjustment;
if (! convert (&t2, &tm))
- return -1;
+ return -1;
t = t2;
}
{
#ifdef _LIBC
/* POSIX.1 8.1.1 requires that whenever mktime() is called, the
- time zone names contained in the external variable `tzname' shall
+ time zone names contained in the external variable 'tzname' shall
be set as if the tzset() function had been called. */
__tzset ();
#endif
not_equal_tm (const struct tm *a, const struct tm *b)
{
return ((a->tm_sec ^ b->tm_sec)
- | (a->tm_min ^ b->tm_min)
- | (a->tm_hour ^ b->tm_hour)
- | (a->tm_mday ^ b->tm_mday)
- | (a->tm_mon ^ b->tm_mon)
- | (a->tm_year ^ b->tm_year)
- | (a->tm_yday ^ b->tm_yday)
- | isdst_differ (a->tm_isdst, b->tm_isdst));
+ | (a->tm_min ^ b->tm_min)
+ | (a->tm_hour ^ b->tm_hour)
+ | (a->tm_mday ^ b->tm_mday)
+ | (a->tm_mon ^ b->tm_mon)
+ | (a->tm_year ^ b->tm_year)
+ | (a->tm_yday ^ b->tm_yday)
+ | isdst_differ (a->tm_isdst, b->tm_isdst));
}
static void
{
if (tp)
printf ("%04d-%02d-%02d %02d:%02d:%02d yday %03d wday %d isdst %d",
- tp->tm_year + TM_YEAR_BASE, tp->tm_mon + 1, tp->tm_mday,
- tp->tm_hour, tp->tm_min, tp->tm_sec,
- tp->tm_yday, tp->tm_wday, tp->tm_isdst);
+ tp->tm_year + TM_YEAR_BASE, tp->tm_mon + 1, tp->tm_mday,
+ tp->tm_hour, tp->tm_min, tp->tm_sec,
+ tp->tm_yday, tp->tm_wday, tp->tm_isdst);
else
printf ("0");
}
if ((argc == 3 || argc == 4)
&& (sscanf (argv[1], "%d-%d-%d%c",
- &tm.tm_year, &tm.tm_mon, &tm.tm_mday, &trailer)
- == 3)
+ &tm.tm_year, &tm.tm_mon, &tm.tm_mday, &trailer)
+ == 3)
&& (sscanf (argv[2], "%d:%d:%d%c",
- &tm.tm_hour, &tm.tm_min, &tm.tm_sec, &trailer)
- == 3))
+ &tm.tm_hour, &tm.tm_min, &tm.tm_sec, &trailer)
+ == 3))
{
tm.tm_year -= TM_YEAR_BASE;
tm.tm_mon--;
tl = mktime (&tmk);
lt = localtime (&tl);
if (lt)
- {
- tml = *lt;
- lt = &tml;
- }
+ {
+ tml = *lt;
+ lt = &tml;
+ }
printf ("mktime returns %ld == ", (long int) tl);
print_tm (&tmk);
printf ("\n");
time_t to = atol (argv[3]);
if (argc == 4)
- for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1)
- {
- lt = localtime (&tl);
- if (lt)
- {
- tmk = tml = *lt;
- tk = mktime (&tmk);
- status |= check_result (tk, tmk, tl, &tml);
- }
- else
- {
- printf ("localtime (%ld) yields 0\n", (long int) tl);
- status = 1;
- }
- tl1 = tl + by;
- if ((tl1 < tl) != (by < 0))
- break;
- }
+ for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1)
+ {
+ lt = localtime (&tl);
+ if (lt)
+ {
+ tmk = tml = *lt;
+ tk = mktime (&tmk);
+ status |= check_result (tk, tmk, tl, &tml);
+ }
+ else
+ {
+ printf ("localtime (%ld) yields 0\n", (long int) tl);
+ status = 1;
+ }
+ tl1 = tl + by;
+ if ((tl1 < tl) != (by < 0))
+ break;
+ }
else
- for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1)
- {
- /* Null benchmark. */
- lt = localtime (&tl);
- if (lt)
- {
- tmk = tml = *lt;
- tk = tl;
- status |= check_result (tk, tmk, tl, &tml);
- }
- else
- {
- printf ("localtime (%ld) yields 0\n", (long int) tl);
- status = 1;
- }
- tl1 = tl + by;
- if ((tl1 < tl) != (by < 0))
- break;
- }
+ for (tl = from; by < 0 ? to <= tl : tl <= to; tl = tl1)
+ {
+ /* Null benchmark. */
+ lt = localtime (&tl);
+ if (lt)
+ {
+ tmk = tml = *lt;
+ tk = tl;
+ status |= check_result (tk, tmk, tl, &tml);
+ }
+ else
+ {
+ printf ("localtime (%ld) yields 0\n", (long int) tl);
+ status = 1;
+ }
+ tl1 = tl + by;
+ if ((tl1 < tl) != (by < 0))
+ break;
+ }
}
else
printf ("Usage:\
\t%s YYYY-MM-DD HH:MM:SS [ISDST] # Test given time.\n\
\t%s FROM BY TO # Test values FROM, FROM+BY, ..., TO.\n\
\t%s FROM BY TO - # Do not test those values (for benchmark).\n",
- argv[0], argv[0], argv[0]);
+ argv[0], argv[0], argv[0]);
return status;
}
/* Define PATH_MAX somehow. Requires sys/types.h.
- Copyright (C) 1992, 1999, 2001, 2003, 2005, 2009-2011 Free Software
+ Copyright (C) 1992, 1999, 2001, 2003, 2005, 2009-2012 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef _PATHMAX_H
# define _PATHMAX_H
--- /dev/null
+/* pselect - synchronous I/O multiplexing
+
+ Copyright 2011-2012 Free Software Foundation, Inc.
+
+ This file is part of gnulib.
+
+ 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, or (at your option)
+ 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 <http://www.gnu.org/licenses/>. */
+
+/* written by Paul Eggert */
+
+#include <config.h>
+
+#include <sys/select.h>
+
+#include <errno.h>
+#include <signal.h>
+
+/* Examine the size-NFDS file descriptor sets in RFDS, WFDS, and XFDS
+ to see whether some of their descriptors are ready for reading,
+ ready for writing, or have exceptions pending. Wait for at most
+ TIMEOUT seconds, and use signal mask SIGMASK while waiting. A null
+ pointer parameter stands for no descriptors, an infinite timeout,
+ or an unaffected signal mask. */
+
+int
+pselect (int nfds, fd_set *restrict rfds,
+ fd_set *restrict wfds, fd_set *restrict xfds,
+ struct timespec const *restrict timeout,
+ sigset_t const *restrict sigmask)
+{
+ int select_result;
+ sigset_t origmask;
+ struct timeval tv, *tvp;
+
+ if (timeout)
+ {
+ if (! (0 <= timeout->tv_nsec && timeout->tv_nsec < 1000000000))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+
+ tv.tv_sec = timeout->tv_sec;
+ tv.tv_usec = (timeout->tv_nsec + 999) / 1000;
+ tvp = &tv;
+ }
+ else
+ tvp = NULL;
+
+ /* Signal mask munging should be atomic, but this is the best we can
+ do in this emulation. */
+ if (sigmask)
+ pthread_sigmask (SIG_SETMASK, sigmask, &origmask);
+
+ select_result = select (nfds, rfds, wfds, xfds, tvp);
+
+ if (sigmask)
+ {
+ int select_errno = errno;
+ pthread_sigmask (SIG_SETMASK, &origmask, NULL);
+ errno = select_errno;
+ }
+
+ return select_result;
+}
/* POSIX compatible signal blocking for threads.
- Copyright (C) 2011 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
#include <errno.h>
#include <stddef.h>
+#if PTHREAD_SIGMASK_INEFFECTIVE
+# include <string.h>
+#endif
+
#if PTHREAD_SIGMASK_UNBLOCK_BUG
# include <unistd.h>
#endif
#undef pthread_sigmask
{
#if HAVE_PTHREAD_SIGMASK
- int ret = pthread_sigmask (how, new_mask, old_mask);
+ int ret;
+
+# if PTHREAD_SIGMASK_INEFFECTIVE
+ sigset_t omask, omask_copy;
+ sigset_t *old_mask_ptr = &omask;
+ sigemptyset (&omask);
+ /* Add a signal unlikely to be blocked, so that OMASK_COPY
+ is unlikely to match the actual mask. */
+ sigaddset (&omask, SIGILL);
+ memcpy (&omask_copy, &omask, sizeof omask);
+# else
+ sigset_t *old_mask_ptr = old_mask;
+# endif
+
+ ret = pthread_sigmask (how, new_mask, old_mask_ptr);
+
# if PTHREAD_SIGMASK_INEFFECTIVE
if (ret == 0)
{
Don't cache the information: libpthread.so could be dynamically
loaded after the program started and after pthread_sigmask was
called for the first time. */
- if (pthread_sigmask (1729, NULL, NULL) == 0)
+ if (memcmp (&omask_copy, &omask, sizeof omask) == 0
+ && pthread_sigmask (1729, &omask_copy, NULL) == 0)
{
/* pthread_sigmask is currently ineffective. The program is not
linked to -lpthread. So use sigprocmask instead. */
return (sigprocmask (how, new_mask, old_mask) < 0 ? errno : 0);
}
+
+ if (old_mask)
+ memcpy (old_mask, &omask, sizeof omask);
}
# endif
# if PTHREAD_SIGMASK_FAILS_WITH_ERRNO
/* Stub for readlink().
- Copyright (C) 2003-2007, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2003-2007, 2009-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
/* sha1.c - Functions to compute SHA1 message digest of files or
memory blocks according to the NIST specification FIPS-180-1.
- Copyright (C) 2000-2001, 2003-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2000-2001, 2003-2006, 2008-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
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Scott G. Miller
Credits:
#include "sha1.h"
-#include <stddef.h>
+#include <stdalign.h>
+#include <stdint.h>
#include <stdlib.h>
#include <string.h>
if (len >= 64)
{
#if !_STRING_ARCH_unaligned
-# define alignof(type) offsetof (struct { char c; type x; }, x)
-# define UNALIGNED_P(p) (((size_t) p) % alignof (uint32_t) != 0)
+# define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (uint32_t) != 0)
if (UNALIGNED_P (buffer))
while (len > 64)
{
uint32_t c = ctx->C;
uint32_t d = ctx->D;
uint32_t e = ctx->E;
+ uint32_t lolen = len;
/* First increment the byte count. RFC 1321 specifies the possible
length of the file up to 2^64 bits. Here we only compute the
number of bytes. Do a double word increment. */
- ctx->total[0] += len;
- if (ctx->total[0] < len)
- ++ctx->total[1];
+ ctx->total[0] += lolen;
+ ctx->total[1] += (len >> 31 >> 1) + (ctx->total[0] < lolen);
#define rol(x, n) (((x) << (n)) | ((uint32_t) (x) >> (32 - (n))))
/* Declarations of functions and data types used for SHA1 sum
library functions.
- Copyright (C) 2000-2001, 2003, 2005-2006, 2008-2011 Free Software
+ Copyright (C) 2000-2001, 2003, 2005-2006, 2008-2012 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify it
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef SHA1_H
# define SHA1_H 1
/* sha256.c - Functions to compute SHA256 and SHA224 message digest of files or
memory blocks according to the NIST specification FIPS-180-2.
- Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-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
#include "sha256.h"
-#include <stddef.h>
+#include <stdalign.h>
+#include <stdint.h>
#include <stdlib.h>
#include <string.h>
if (len >= 64)
{
#if !_STRING_ARCH_unaligned
-# define alignof(type) offsetof (struct { char c; type x; }, x)
-# define UNALIGNED_P(p) (((size_t) p) % alignof (uint32_t) != 0)
+# define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (uint32_t) != 0)
if (UNALIGNED_P (buffer))
while (len > 64)
{
uint32_t f = ctx->state[5];
uint32_t g = ctx->state[6];
uint32_t h = ctx->state[7];
+ uint32_t lolen = len;
/* First increment the byte count. FIPS PUB 180-2 specifies the possible
length of the file up to 2^64 bits. Here we only compute the
number of bytes. Do a double word increment. */
- ctx->total[0] += len;
- if (ctx->total[0] < len)
- ++ctx->total[1];
+ ctx->total[0] += lolen;
+ ctx->total[1] += (len >> 31 >> 1) + (ctx->total[0] < lolen);
#define rol(x, n) (((x) << (n)) | ((x) >> (32 - (n))))
#define S0(x) (rol(x,25)^rol(x,14)^(x>>3))
/* Declarations of functions and data types used for SHA256 and SHA224 sum
library functions.
- Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-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
/* sha512.c - Functions to compute SHA512 and SHA384 message digest of files or
memory blocks according to the NIST specification FIPS-180-2.
- Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-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
#include "sha512.h"
-#include <stddef.h>
+#include <stdalign.h>
+#include <stdint.h>
#include <stdlib.h>
#include <string.h>
if (len >= 128)
{
#if !_STRING_ARCH_unaligned
-# define alignof(type) offsetof (struct { char c; type x; }, x)
-# define UNALIGNED_P(p) (((size_t) p) % alignof (u64) != 0)
+# define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (u64) != 0)
if (UNALIGNED_P (buffer))
while (len > 128)
{
u64 f = ctx->state[5];
u64 g = ctx->state[6];
u64 h = ctx->state[7];
+ u64 lolen = u64size (len);
/* First increment the byte count. FIPS PUB 180-2 specifies the possible
length of the file up to 2^128 bits. Here we only compute the
number of bytes. Do a double word increment. */
- ctx->total[0] = u64plus (ctx->total[0], u64lo (len));
- if (u64lt (ctx->total[0], u64lo (len)))
- ctx->total[1] = u64plus (ctx->total[1], u64lo (1));
+ ctx->total[0] = u64plus (ctx->total[0], lolen);
+ ctx->total[1] = u64plus (ctx->total[1],
+ u64plus (u64size (len >> 31 >> 31 >> 2),
+ u64lo (u64lt (ctx->total[0], lolen))));
#define S0(x) u64xor (u64rol(x, 63), u64xor (u64rol (x, 56), u64shr (x, 7)))
#define S1(x) u64xor (u64rol (x, 45), u64xor (u64rol (x, 3), u64shr (x, 6)))
/* Declarations of functions and data types used for SHA512 and SHA384 sum
library functions.
- Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-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
/* A GNU-like <signal.h>.
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006-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
#ifndef _@GUARD_PREFIX@_SIGNAL_H
#define _@GUARD_PREFIX@_SIGNAL_H
-/* MacOS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6 declare
+/* Mac OS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6 declare
pthread_sigmask in <pthread.h>, not in <signal.h>.
But avoid namespace pollution on glibc systems.*/
#if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \
/* Test whether a given signal is contained in a signal set. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigismember
# endif
/* Initialize a signal set to the empty set. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigemptyset
# endif
/* Add a signal to a signal set. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigaddset
# endif
/* Remove a signal from a signal set. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigdelset
# endif
/* Fill a signal set with all possible signals. */
# if @HAVE_POSIX_SIGNALBLOCKING@
-/* This function is defined as a macro on MacOS X. */
+/* This function is defined as a macro on Mac OS X. */
# if defined __cplusplus && defined GNULIB_NAMESPACE
# undef sigfillset
# endif
+++ /dev/null
-/* POSIX compatible signal blocking.
- Copyright (C) 2006-2011 Free Software Foundation, Inc.
- Written by Bruno Haible <bruno@clisp.org>, 2006.
-
- 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
- (at your option) 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 <http://www.gnu.org/licenses/>. */
-
-#include <config.h>
-
-/* Specification. */
-#include <signal.h>
-
-#include <errno.h>
-#include <stdint.h>
-#include <stdlib.h>
-
-#if HAVE_MSVC_INVALID_PARAMETER_HANDLER
-# include "msvc-inval.h"
-#endif
-
-/* We assume that a platform without POSIX signal blocking functions
- also does not have the POSIX sigaction() function, only the
- signal() function. We also assume signal() has SysV semantics,
- where any handler is uninstalled prior to being invoked. This is
- true for Woe32 platforms. */
-
-/* We use raw signal(), but also provide a wrapper rpl_signal() so
- that applications can query or change a blocked signal. */
-#undef signal
-
-/* Provide invalid signal numbers as fallbacks if the uncatchable
- signals are not defined. */
-#ifndef SIGKILL
-# define SIGKILL (-1)
-#endif
-#ifndef SIGSTOP
-# define SIGSTOP (-1)
-#endif
-
-/* On native Windows, as of 2008, the signal SIGABRT_COMPAT is an alias
- for the signal SIGABRT. Only one signal handler is stored for both
- SIGABRT and SIGABRT_COMPAT. SIGABRT_COMPAT is not a signal of its own. */
-#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
-# undef SIGABRT_COMPAT
-# define SIGABRT_COMPAT 6
-#endif
-#ifdef SIGABRT_COMPAT
-# define SIGABRT_COMPAT_MASK (1U << SIGABRT_COMPAT)
-#else
-# define SIGABRT_COMPAT_MASK 0
-#endif
-
-typedef void (*handler_t) (int);
-
-#if HAVE_MSVC_INVALID_PARAMETER_HANDLER
-static inline handler_t
-signal_nothrow (int sig, handler_t handler)
-{
- handler_t result;
-
- TRY_MSVC_INVAL
- {
- result = signal (sig, handler);
- }
- CATCH_MSVC_INVAL
- {
- result = SIG_ERR;
- errno = EINVAL;
- }
- DONE_MSVC_INVAL;
-
- return result;
-}
-# define signal signal_nothrow
-#endif
-
-/* Handling of gnulib defined signals. */
-
-#if GNULIB_defined_SIGPIPE
-static handler_t SIGPIPE_handler = SIG_DFL;
-#endif
-
-#if GNULIB_defined_SIGPIPE
-static handler_t
-ext_signal (int sig, handler_t handler)
-{
- switch (sig)
- {
- case SIGPIPE:
- {
- handler_t old_handler = SIGPIPE_handler;
- SIGPIPE_handler = handler;
- return old_handler;
- }
- default: /* System defined signal */
- return signal (sig, handler);
- }
-}
-# undef signal
-# define signal ext_signal
-#endif
-
-int
-sigismember (const sigset_t *set, int sig)
-{
- if (sig >= 0 && sig < NSIG)
- {
- #ifdef SIGABRT_COMPAT
- if (sig == SIGABRT_COMPAT)
- sig = SIGABRT;
- #endif
-
- return (*set >> sig) & 1;
- }
- else
- return 0;
-}
-
-int
-sigemptyset (sigset_t *set)
-{
- *set = 0;
- return 0;
-}
-
-int
-sigaddset (sigset_t *set, int sig)
-{
- if (sig >= 0 && sig < NSIG)
- {
- #ifdef SIGABRT_COMPAT
- if (sig == SIGABRT_COMPAT)
- sig = SIGABRT;
- #endif
-
- *set |= 1U << sig;
- return 0;
- }
- else
- {
- errno = EINVAL;
- return -1;
- }
-}
-
-int
-sigdelset (sigset_t *set, int sig)
-{
- if (sig >= 0 && sig < NSIG)
- {
- #ifdef SIGABRT_COMPAT
- if (sig == SIGABRT_COMPAT)
- sig = SIGABRT;
- #endif
-
- *set &= ~(1U << sig);
- return 0;
- }
- else
- {
- errno = EINVAL;
- return -1;
- }
-}
-
-
-int
-sigfillset (sigset_t *set)
-{
- *set = ((2U << (NSIG - 1)) - 1) & ~ SIGABRT_COMPAT_MASK;
- return 0;
-}
-
-/* Set of currently blocked signals. */
-static volatile sigset_t blocked_set /* = 0 */;
-
-/* Set of currently blocked and pending signals. */
-static volatile sig_atomic_t pending_array[NSIG] /* = { 0 } */;
-
-/* Signal handler that is installed for blocked signals. */
-static void
-blocked_handler (int sig)
-{
- /* Reinstall the handler, in case the signal occurs multiple times
- while blocked. There is an inherent race where an asynchronous
- signal in between when the kernel uninstalled the handler and
- when we reinstall it will trigger the default handler; oh
- well. */
- signal (sig, blocked_handler);
- if (sig >= 0 && sig < NSIG)
- pending_array[sig] = 1;
-}
-
-int
-sigpending (sigset_t *set)
-{
- sigset_t pending = 0;
- int sig;
-
- for (sig = 0; sig < NSIG; sig++)
- if (pending_array[sig])
- pending |= 1U << sig;
- *set = pending;
- return 0;
-}
-
-/* The previous signal handlers.
- Only the array elements corresponding to blocked signals are relevant. */
-static volatile handler_t old_handlers[NSIG];
-
-int
-sigprocmask (int operation, const sigset_t *set, sigset_t *old_set)
-{
- if (old_set != NULL)
- *old_set = blocked_set;
-
- if (set != NULL)
- {
- sigset_t new_blocked_set;
- sigset_t to_unblock;
- sigset_t to_block;
-
- switch (operation)
- {
- case SIG_BLOCK:
- new_blocked_set = blocked_set | *set;
- break;
- case SIG_SETMASK:
- new_blocked_set = *set;
- break;
- case SIG_UNBLOCK:
- new_blocked_set = blocked_set & ~*set;
- break;
- default:
- errno = EINVAL;
- return -1;
- }
- to_unblock = blocked_set & ~new_blocked_set;
- to_block = new_blocked_set & ~blocked_set;
-
- if (to_block != 0)
- {
- int sig;
-
- for (sig = 0; sig < NSIG; sig++)
- if ((to_block >> sig) & 1)
- {
- pending_array[sig] = 0;
- if ((old_handlers[sig] = signal (sig, blocked_handler)) != SIG_ERR)
- blocked_set |= 1U << sig;
- }
- }
-
- if (to_unblock != 0)
- {
- sig_atomic_t received[NSIG];
- int sig;
-
- for (sig = 0; sig < NSIG; sig++)
- if ((to_unblock >> sig) & 1)
- {
- if (signal (sig, old_handlers[sig]) != blocked_handler)
- /* The application changed a signal handler while the signal
- was blocked, bypassing our rpl_signal replacement.
- We don't support this. */
- abort ();
- received[sig] = pending_array[sig];
- blocked_set &= ~(1U << sig);
- pending_array[sig] = 0;
- }
- else
- received[sig] = 0;
-
- for (sig = 0; sig < NSIG; sig++)
- if (received[sig])
- raise (sig);
- }
- }
- return 0;
-}
-
-/* Install the handler FUNC for signal SIG, and return the previous
- handler. */
-handler_t
-rpl_signal (int sig, handler_t handler)
-{
- /* We must provide a wrapper, so that a user can query what handler
- they installed even if that signal is currently blocked. */
- if (sig >= 0 && sig < NSIG && sig != SIGKILL && sig != SIGSTOP
- && handler != SIG_ERR)
- {
- #ifdef SIGABRT_COMPAT
- if (sig == SIGABRT_COMPAT)
- sig = SIGABRT;
- #endif
-
- if (blocked_set & (1U << sig))
- {
- /* POSIX states that sigprocmask and signal are both
- async-signal-safe. This is not true of our
- implementation - there is a slight data race where an
- asynchronous interrupt on signal A can occur after we
- install blocked_handler but before we have updated
- old_handlers for signal B, such that handler A can see
- stale information if it calls signal(B). Oh well -
- signal handlers really shouldn't try to manipulate the
- installed handlers of unrelated signals. */
- handler_t result = old_handlers[sig];
- old_handlers[sig] = handler;
- return result;
- }
- else
- return signal (sig, handler);
- }
- else
- {
- errno = EINVAL;
- return SIG_ERR;
- }
-}
-
-#if GNULIB_defined_SIGPIPE
-/* Raise the signal SIGPIPE. */
-int
-_gl_raise_SIGPIPE (void)
-{
- if (blocked_set & (1U << SIGPIPE))
- pending_array[SIGPIPE] = 1;
- else
- {
- handler_t handler = SIGPIPE_handler;
- if (handler == SIG_DFL)
- exit (128 + SIGPIPE);
- else if (handler != SIG_IGN)
- (*handler) (SIGPIPE);
- }
-}
-#endif
--- /dev/null
+#include <config.h>
+#define _GL_STAT_TIME_INLINE _GL_EXTERN_INLINE
+#include "stat-time.h"
--- /dev/null
+/* stat-related time functions.
+
+ Copyright (C) 2005, 2007, 2009-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
+ (at your option) 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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+#ifndef STAT_TIME_H
+#define STAT_TIME_H 1
+
+#include <sys/stat.h>
+#include <time.h>
+
+_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,
+ if available. ST_XTIM can be st_atim, st_ctim, st_mtim, or st_birthtim
+ for access, status change, data modification, or birth (creation)
+ time respectively.
+
+ These macros are private to stat-time.h. */
+#if defined HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
+# ifdef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC
+# define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim)
+# else
+# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim.tv_nsec)
+# endif
+#elif defined HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC
+# define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim##espec)
+#elif defined HAVE_STRUCT_STAT_ST_ATIMENSEC
+# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim##ensec)
+#elif defined HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC
+# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim.st__tim.tv_nsec)
+#endif
+
+/* Return the nanosecond component of *ST's access time. */
+_GL_STAT_TIME_INLINE long int
+get_stat_atime_ns (struct stat const *st)
+{
+# if defined STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_atim).tv_nsec;
+# elif defined STAT_TIMESPEC_NS
+ return STAT_TIMESPEC_NS (st, st_atim);
+# else
+ return 0;
+# endif
+}
+
+/* Return the nanosecond component of *ST's status change time. */
+_GL_STAT_TIME_INLINE long int
+get_stat_ctime_ns (struct stat const *st)
+{
+# if defined STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_ctim).tv_nsec;
+# elif defined STAT_TIMESPEC_NS
+ return STAT_TIMESPEC_NS (st, st_ctim);
+# else
+ return 0;
+# endif
+}
+
+/* Return the nanosecond component of *ST's data modification time. */
+_GL_STAT_TIME_INLINE long int
+get_stat_mtime_ns (struct stat const *st)
+{
+# if defined STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_mtim).tv_nsec;
+# elif defined STAT_TIMESPEC_NS
+ return STAT_TIMESPEC_NS (st, st_mtim);
+# else
+ return 0;
+# endif
+}
+
+/* Return the nanosecond component of *ST's birth time. */
+_GL_STAT_TIME_INLINE long int
+get_stat_birthtime_ns (struct stat const *st)
+{
+# if defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
+ return STAT_TIMESPEC (st, st_birthtim).tv_nsec;
+# elif defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
+ return STAT_TIMESPEC_NS (st, st_birthtim);
+# else
+ /* Avoid a "parameter unused" warning. */
+ (void) st;
+ return 0;
+# endif
+}
+
+/* Return *ST's access time. */
+_GL_STAT_TIME_INLINE struct timespec
+get_stat_atime (struct stat const *st)
+{
+#ifdef STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_atim);
+#else
+ struct timespec t;
+ t.tv_sec = st->st_atime;
+ t.tv_nsec = get_stat_atime_ns (st);
+ return t;
+#endif
+}
+
+/* Return *ST's status change time. */
+_GL_STAT_TIME_INLINE struct timespec
+get_stat_ctime (struct stat const *st)
+{
+#ifdef STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_ctim);
+#else
+ struct timespec t;
+ t.tv_sec = st->st_ctime;
+ t.tv_nsec = get_stat_ctime_ns (st);
+ return t;
+#endif
+}
+
+/* Return *ST's data modification time. */
+_GL_STAT_TIME_INLINE struct timespec
+get_stat_mtime (struct stat const *st)
+{
+#ifdef STAT_TIMESPEC
+ return STAT_TIMESPEC (st, st_mtim);
+#else
+ struct timespec t;
+ t.tv_sec = st->st_mtime;
+ t.tv_nsec = get_stat_mtime_ns (st);
+ return t;
+#endif
+}
+
+/* Return *ST's birth time, if available; otherwise return a value
+ with tv_sec and tv_nsec both equal to -1. */
+_GL_STAT_TIME_INLINE struct timespec
+get_stat_birthtime (struct stat const *st)
+{
+ struct timespec t;
+
+#if (defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC \
+ || defined HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC)
+ t = STAT_TIMESPEC (st, st_birthtim);
+#elif defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
+ t.tv_sec = st->st_birthtime;
+ t.tv_nsec = st->st_birthtimensec;
+#elif (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+ /* Native Windows platforms (but not Cygwin) put the "file creation
+ time" in st_ctime (!). See
+ <http://msdn2.microsoft.com/de-de/library/14h5k7ff(VS.80).aspx>. */
+ t.tv_sec = st->st_ctime;
+ t.tv_nsec = 0;
+#else
+ /* Birth time is not supported. */
+ t.tv_sec = -1;
+ t.tv_nsec = -1;
+ /* Avoid a "parameter unused" warning. */
+ (void) st;
+#endif
+
+#if (defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC \
+ || defined HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC \
+ || defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC)
+ /* FreeBSD and NetBSD sometimes signal the absence of knowledge by
+ using zero. Attempt to work around this problem. Alas, this can
+ report failure even for valid time stamps. Also, NetBSD
+ sometimes returns junk in the birth time fields; work around this
+ bug if it is detected. */
+ if (! (t.tv_sec && 0 <= t.tv_nsec && t.tv_nsec < 1000000000))
+ {
+ t.tv_sec = -1;
+ t.tv_nsec = -1;
+ }
+#endif
+
+ return t;
+}
+
+_GL_INLINE_HEADER_END
+
+#endif
/* Work around platform bugs in stat.
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
#include <sys/stat.h>
#undef __need_system_sys_stat_h
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+# if _GL_WINDOWS_64_BIT_ST_SIZE
+# undef stat /* avoid warning on mingw64 with _FILE_OFFSET_BITS=64 */
+# define stat _stati64
+# define REPLACE_FUNC_STAT_DIR 1
+# undef REPLACE_FUNC_STAT_FILE
+# elif REPLACE_FUNC_STAT_FILE
+/* mingw64 has a broken stat() function, based on _stat(), in libmingwex.a.
+ Bypass it. */
+# define stat _stat
+# define REPLACE_FUNC_STAT_DIR 1
+# undef REPLACE_FUNC_STAT_FILE
+# endif
+#endif
+
static inline int
orig_stat (const char *filename, struct stat *buf)
{
--- /dev/null
+/* A substitute for ISO C11 <stdalign.h>.
+
+ Copyright 2011-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, or (at your option)
+ 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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert and Bruno Haible. */
+
+#ifndef _GL_STDALIGN_H
+#define _GL_STDALIGN_H
+
+/* ISO C11 <stdalign.h> for platforms that lack it.
+
+ References:
+ ISO C11 (latest free draft
+ <http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1570.pdf>)
+ sections 6.5.3.4, 6.7.5, 7.15.
+ C++11 (latest free draft
+ <http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2011/n3242.pdf>)
+ section 18.10. */
+
+/* alignof (TYPE), also known as _Alignof (TYPE), yields the alignment
+ requirement of a structure member (i.e., slot or field) that is of
+ type TYPE, as an integer constant expression.
+
+ This differs from GCC's __alignof__ operator, which can yield a
+ better-performing alignment for an object of that type. For
+ example, on x86 with GCC, __alignof__ (double) and __alignof__
+ (long long) are 8, whereas alignof (double) and alignof (long long)
+ are 4 unless the option '-malign-double' is used.
+
+ The result cannot be used as a value for an 'enum' constant, if you
+ want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */
+#include <stddef.h>
+#if defined __cplusplus
+ template <class __t> struct __alignof_helper { char __a; __t __b; };
+# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
+#else
+# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b)
+#endif
+#define alignof _Alignof
+#define __alignof_is_defined 1
+
+/* alignas (A), also known as _Alignas (A), aligns a variable or type
+ to the alignment A, where A is an integer constant expression. For
+ example:
+
+ int alignas (8) foo;
+ struct s { int a; int alignas (8) bar; };
+
+ aligns the address of FOO and the offset of BAR to be multiples of 8.
+
+ A should be a power of two that is at least the type's alignment
+ and at most the implementation's alignment limit. This limit is
+ 2**28 on typical GNUish hosts, and 2**13 on MSVC. To be portable
+ to MSVC through at least version 10.0, A should be an integer
+ constant, as MSVC does not support expressions such as 1 << 3.
+ To be portable to Sun C 5.11, do not align auto variables to
+ anything stricter than their default alignment.
+
+ The following C11 requirements are not supported here:
+
+ - If A is zero, alignas has no effect.
+ - alignas can be used multiple times; the strictest one wins.
+ - alignas (TYPE) is equivalent to alignas (alignof (TYPE)).
+
+ */
+
+#if __GNUC__ || __IBMC__ || __IBMCPP__ || 0x5110 <= __SUNPRO_C
+# define _Alignas(a) __attribute__ ((__aligned__ (a)))
+#elif 1300 <= _MSC_VER
+# define _Alignas(a) __declspec (align (a))
+#endif
+#ifdef _Alignas
+# define alignas _Alignas
+# define __alignas_is_defined 1
+#endif
+
+#endif /* _GL_STDALIGN_H */
/* Substitute for and wrapper around <stdarg.h>.
- Copyright (C) 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2008-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
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef _@GUARD_PREFIX@_STDARG_H
-/* Copyright (C) 2001-2003, 2006-2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001-2003, 2006-2012 Free Software Foundation, Inc.
Written by Bruno Haible <haible@clisp.cons.org>, 2001.
This program is free software; you can redistribute it and/or modify
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#ifndef _GL_STDBOOL_H
#define _GL_STDBOOL_H
# undef true
#endif
-/* For the sake of symbolic names in gdb, we define true and false as
- enum constants, not only as macros.
- It is tempting to write
- typedef enum { false = 0, true = 1 } _Bool;
- so that gdb prints values of type 'bool' symbolically. But if we do
- this, values of type '_Bool' may promote to 'int' or 'unsigned int'
- (see ISO C 99 6.7.2.2.(4)); however, '_Bool' must promote to 'int'
- (see ISO C 99 6.3.1.1.(2)). So we add a negative value to the
- enum; this ensures that '_Bool' promotes to 'int'. */
-#if defined __cplusplus || (defined __BEOS__ && !defined __HAIKU__)
+#ifdef __cplusplus
+# define _Bool bool
+# define bool bool
+#else
+# if defined __BEOS__ && !defined __HAIKU__
/* A compiler known to have 'bool'. */
/* If the compiler already has both 'bool' and '_Bool', we can assume they
are the same types. */
-# if !@HAVE__BOOL@
+# if !@HAVE__BOOL@
typedef bool _Bool;
-# endif
-#else
-# if !defined __GNUC__
+# endif
+# else
+# if !defined __GNUC__
/* If @HAVE__BOOL@:
Some HP-UX cc and AIX IBM C compiler versions have compiler bugs when
the built-in _Bool type is used. See
"Invalid enumerator. (badenum)" with HP-UX cc on Tru64.
The only benefit of the enum, debuggability, is not important
with these compilers. So use 'signed char' and no enum. */
-# define _Bool signed char
-# else
+# define _Bool signed char
+# else
/* With this compiler, trust the _Bool type if the compiler has it. */
-# if !@HAVE__BOOL@
+# if !@HAVE__BOOL@
+ /* For the sake of symbolic names in gdb, define true and false as
+ enum constants, not only as macros.
+ It is tempting to write
+ typedef enum { false = 0, true = 1 } _Bool;
+ so that gdb prints values of type 'bool' symbolically. But then
+ values of type '_Bool' might promote to 'int' or 'unsigned int'
+ (see ISO C 99 6.7.2.2.(4)); however, '_Bool' must promote to 'int'
+ (see ISO C 99 6.3.1.1.(2)). So add a negative value to the
+ enum; this ensures that '_Bool' promotes to 'int'. */
typedef enum { _Bool_must_promote_to_int = -1, false = 0, true = 1 } _Bool;
+# endif
# endif
# endif
+# define bool _Bool
#endif
-#define bool _Bool
/* The other macros must be usable in preprocessor directives. */
-#define false 0
-#define true 1
+#ifdef __cplusplus
+# define false false
+# define true true
+#else
+# define false 0
+# define true 1
+#endif
+
#define __bool_true_false_are_defined 1
#endif /* _GL_STDBOOL_H */
/* A substitute for POSIX 2008 <stddef.h>, for platforms that have issues.
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Eric Blake. */
-/* Copyright (C) 2001-2002, 2004-2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001-2002, 2004-2012 Free Software Foundation, Inc.
Written by Paul Eggert, Bruno Haible, Sam Steingold, Peter Burwood.
This file is part of gnulib.
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/*
* ISO C 99 <stdint.h> for platforms that lack it.
<inttypes.h>. */
#define _GL_JUST_INCLUDE_SYSTEM_INTTYPES_H
+/* On Android (Bionic libc), <sys/types.h> includes this file before
+ having defined 'time_t'. Therefore in this case avoid including
+ other system header files; just include the system's <stdint.h>.
+ Ideally we should test __BIONIC__ here, but it is only defined after
+ <sys/cdefs.h> has been included; hence test __ANDROID__ instead. */
+#if defined __ANDROID__ \
+ && defined _SYS_TYPES_H_ && !defined _SSIZE_T_DEFINED_
+# @INCLUDE_NEXT@ @NEXT_STDINT_H@
+#else
+
/* Get those types that are already defined in other system include
files, so that we can "#define int8_t signed char" below without
worrying about a later system include file containing a "typedef
diagnostics. */
# define __STDINT_H__
# endif
+
+ /* Some pre-C++11 <stdint.h> implementations need this. */
+# ifdef __cplusplus
+# ifndef __STDC_CONSTANT_MACROS
+# define __STDC_CONSTANT_MACROS 1
+# endif
+# ifndef __STDC_LIMIT_MACROS
+# define __STDC_LIMIT_MACROS 1
+# endif
+# endif
+
/* Other systems may have an incomplete or buggy <stdint.h>.
Include it before <inttypes.h>, since any "#include <stdint.h>"
in <inttypes.h> would reinclude us, skipping our contents because
/* <sys/types.h> defines some of the stdint.h types as well, on glibc,
IRIX 6.5, and OpenBSD 3.8 (via <machine/types.h>).
AIX 5.2 <sys/types.h> isn't needed and causes troubles.
- MacOS X 10.4.6 <sys/types.h> includes <stdint.h> (which is us), but
+ Mac OS X 10.4.6 <sys/types.h> includes <stdint.h> (which is us), but
relies on the system <stdint.h> definitions, so include
<sys/types.h> after @NEXT_STDINT_H@. */
#if @HAVE_SYS_TYPES_H@ && ! defined _AIX
# include <sys/types.h>
#endif
-/* Get LONG_MIN, LONG_MAX, ULONG_MAX. */
+/* Get SCHAR_MIN, SCHAR_MAX, UCHAR_MAX, INT_MIN, INT_MAX,
+ LONG_MIN, LONG_MAX, ULONG_MAX. */
#include <limits.h>
#if @HAVE_INTTYPES_H@
/* Here we assume a standard architecture where the hardware integer
types have 8, 16, 32, optionally 64 bits. Therefore the fastN_t types
- are taken from the same list of types. Assume that 'long int'
- is fast enough for all narrower integers. */
+ are taken from the same list of types. The following code normally
+ uses types consistent with glibc, as that lessens the chance of
+ incompatibility with older GNU hosts. */
#undef int_fast8_t
#undef uint_fast8_t
#undef uint_fast32_t
#undef int_fast64_t
#undef uint_fast64_t
-typedef long int gl_int_fast8_t;
-typedef unsigned long int gl_uint_fast8_t;
-typedef long int gl_int_fast16_t;
-typedef unsigned long int gl_uint_fast16_t;
+typedef signed char gl_int_fast8_t;
+typedef unsigned char gl_uint_fast8_t;
+
+#ifdef __sun
+/* Define types compatible with SunOS 5.10, so that code compiled under
+ earlier SunOS versions works with code compiled under SunOS 5.10. */
+typedef int gl_int_fast32_t;
+typedef unsigned int gl_uint_fast32_t;
+#else
typedef long int gl_int_fast32_t;
typedef unsigned long int gl_uint_fast32_t;
+#endif
+typedef gl_int_fast32_t gl_int_fast16_t;
+typedef gl_uint_fast32_t gl_uint_fast16_t;
+
#define int_fast8_t gl_int_fast8_t
#define uint_fast8_t gl_uint_fast8_t
#define int_fast16_t gl_int_fast16_t
/* 7.18.2. Limits of specified-width integer types */
-#if ! defined __cplusplus || defined __STDC_LIMIT_MACROS
-
/* 7.18.2.1. Limits of exact-width integer types */
/* Here we assume a standard architecture where the hardware integer
#undef INT_FAST8_MIN
#undef INT_FAST8_MAX
#undef UINT_FAST8_MAX
-#define INT_FAST8_MIN LONG_MIN
-#define INT_FAST8_MAX LONG_MAX
-#define UINT_FAST8_MAX ULONG_MAX
+#define INT_FAST8_MIN SCHAR_MIN
+#define INT_FAST8_MAX SCHAR_MAX
+#define UINT_FAST8_MAX UCHAR_MAX
#undef INT_FAST16_MIN
#undef INT_FAST16_MAX
#undef UINT_FAST16_MAX
-#define INT_FAST16_MIN LONG_MIN
-#define INT_FAST16_MAX LONG_MAX
-#define UINT_FAST16_MAX ULONG_MAX
+#define INT_FAST16_MIN INT_FAST32_MIN
+#define INT_FAST16_MAX INT_FAST32_MAX
+#define UINT_FAST16_MAX UINT_FAST32_MAX
#undef INT_FAST32_MIN
#undef INT_FAST32_MAX
#undef UINT_FAST32_MAX
-#define INT_FAST32_MIN LONG_MIN
-#define INT_FAST32_MAX LONG_MAX
-#define UINT_FAST32_MAX ULONG_MAX
+#ifdef __sun
+# define INT_FAST32_MIN INT_MIN
+# define INT_FAST32_MAX INT_MAX
+# define UINT_FAST32_MAX UINT_MAX
+#else
+# define INT_FAST32_MIN LONG_MIN
+# define INT_FAST32_MAX LONG_MAX
+# define UINT_FAST32_MAX ULONG_MAX
+#endif
#undef INT_FAST64_MIN
#undef INT_FAST64_MAX
#define WINT_MAX \
_STDINT_MAX (@HAVE_SIGNED_WINT_T@, @BITSIZEOF_WINT_T@, 0@WINT_T_SUFFIX@)
-#endif /* !defined __cplusplus || defined __STDC_LIMIT_MACROS */
-
/* 7.18.4. Macros for integer constants */
-#if ! defined __cplusplus || defined __STDC_CONSTANT_MACROS
-
/* 7.18.4.1. Macros for minimum-width integer constants */
/* According to ISO C 99 Technical Corrigendum 1 */
# endif
#endif
-#endif /* !defined __cplusplus || defined __STDC_CONSTANT_MACROS */
-
#endif /* _@GUARD_PREFIX@_STDINT_H */
+#endif /* !(defined __ANDROID__ && ...) */
#endif /* !defined _@GUARD_PREFIX@_STDINT_H && !defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H */
/* A GNU-like <stdio.h>.
- Copyright (C) 2004, 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2007-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
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
#include <stddef.h>
/* Get off_t and ssize_t. Needed on many systems, including glibc 2.8
- and eglibc 2.11.2. */
+ and eglibc 2.11.2.
+ May also define off_t to a 64-bit type on native Windows. */
#include <sys/types.h>
/* The __attribute__ feature is available in gcc versions 2.5 and later.
#elif defined GNULIB_POSIXCHECK
# undef fdopen
/* Assume fdopen is always declared. */
-_GL_WARN_ON_USE (fdopen, "fdopen on Win32 platforms is not POSIX compatible - "
+_GL_WARN_ON_USE (fdopen, "fdopen on native Windows platforms is not POSIX compliant - "
"use gnulib module fdopen for portability");
#endif
#elif defined GNULIB_POSIXCHECK
# undef fopen
/* Assume fopen is always declared. */
-_GL_WARN_ON_USE (fopen, "fopen on Win32 platforms is not POSIX compatible - "
+_GL_WARN_ON_USE (fopen, "fopen on native Windows platforms is not POSIX compliant - "
"use gnulib module fopen for portability");
#endif
# undef freopen
/* Assume freopen is always declared. */
_GL_WARN_ON_USE (freopen,
- "freopen on Win32 platforms is not POSIX compatible - "
+ "freopen on native Windows platforms is not POSIX compliant - "
"use gnulib module freopen for portability");
#endif
#endif
/* It is very rare that the developer ever has full control of stdin,
- so any use of gets warrants an unconditional warning. Besides, C11
+ so any use of gets warrants an unconditional warning; besides, C11
removed it. */
#undef gets
#if HAVE_RAW_DECL_GETS
#elif defined GNULIB_POSIXCHECK
# undef pclose
# if HAVE_RAW_DECL_PCLOSE
-_GL_WARN_ON_USE (pclose, "popen is unportable - "
+_GL_WARN_ON_USE (pclose, "pclose is unportable - "
"use gnulib module pclose for more portability");
# endif
#endif
# endif
#endif
-/* Some people would argue that sprintf uses should be warned about
- (for example, OpenBSD issues a link warning for both functions),
- since both can cause security holes due to buffer overruns.
+/* Some people would argue that all sprintf uses should be warned about
+ (for example, OpenBSD issues a link warning for it),
+ since it can cause security holes due to buffer overruns.
However, we believe that sprintf can be used safely, and is more
efficient than snprintf in those safe cases; and as proof of our
belief, we use sprintf in several gnulib modules. So this header
/* A GNU-like <stdlib.h>.
- Copyright (C) 1995, 2001-2004, 2006-2011 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2004, 2006-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
# include <sys/loadavg.h>
#endif
+/* Native Windows platforms declare mktemp() in <io.h>. */
+#if 0 && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
+# include <io.h>
+#endif
+
#if @GNULIB_RANDOM_R@
/* OSF/1 5.1 declares 'struct random_data' in <random.h>, which is included
# include <random.h>
# endif
-# if !@HAVE_STRUCT_RANDOM_DATA@ || !@HAVE_RANDOM_R@
+# if !@HAVE_STRUCT_RANDOM_DATA@ || @REPLACE_RANDOM_R@ || !@HAVE_RANDOM_R@
# include <stdint.h>
# endif
#endif
#if (@GNULIB_MKSTEMP@ || @GNULIB_MKSTEMPS@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
-/* On MacOS X 10.3, only <unistd.h> declares mkstemp. */
-/* On MacOS X 10.5, only <unistd.h> declares mkstemps. */
+/* On Mac OS X 10.3, only <unistd.h> declares mkstemp. */
+/* On Mac OS X 10.5, only <unistd.h> declares mkstemps. */
/* On Cygwin 1.7.1, only <unistd.h> declares getsubopt. */
/* But avoid namespace pollution on glibc systems and native Windows. */
# include <unistd.h>
#endif
+/* The __attribute__ feature is available in gcc versions 2.5 and later.
+ The attribute __pure__ was added in gcc 2.96. */
+#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+#else
+# define _GL_ATTRIBUTE_PURE /* empty */
+#endif
+
/* The definition of _Noreturn is copied here. */
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
/* Parse a signed decimal integer.
Returns the value of the integer. Errors are not detected. */
# if !@HAVE_ATOLL@
-_GL_FUNCDECL_SYS (atoll, long long, (const char *string) _GL_ARG_NONNULL ((1)));
+_GL_FUNCDECL_SYS (atoll, long long, (const char *string)
+ _GL_ATTRIBUTE_PURE
+ _GL_ARG_NONNULL ((1)));
# endif
_GL_CXXALIAS_SYS (atoll, long long, (const char *string));
_GL_CXXALIASWARN (atoll);
#elif defined GNULIB_POSIXCHECK
# undef grantpt
# if HAVE_RAW_DECL_GRANTPT
-_GL_WARN_ON_USE (ptsname, "grantpt is not portable - "
+_GL_WARN_ON_USE (grantpt, "grantpt is not portable - "
"use gnulib module grantpt for portability");
# endif
#endif
# endif
#endif
+#if @GNULIB_POSIX_OPENPT@
+/* Return an FD open to the master side of a pseudo-terminal. Flags should
+ include O_RDWR, and may also include O_NOCTTY. */
+# if !@HAVE_POSIX_OPENPT@
+_GL_FUNCDECL_SYS (posix_openpt, int, (int flags));
+# endif
+_GL_CXXALIAS_SYS (posix_openpt, int, (int flags));
+_GL_CXXALIASWARN (posix_openpt);
+#elif defined GNULIB_POSIXCHECK
+# undef posix_openpt
+# if HAVE_RAW_DECL_POSIX_OPENPT
+_GL_WARN_ON_USE (posix_openpt, "posix_openpt is not portable - "
+ "use gnulib module posix_openpt for portability");
+# endif
+#endif
+
#if @GNULIB_PTSNAME@
/* Return the pathname of the pseudo-terminal slave associated with
the master FD is open on, or NULL on errors. */
# endif
#endif
+#if @GNULIB_PTSNAME_R@
+/* Set the pathname of the pseudo-terminal slave associated with
+ the master FD is open on and return 0, or set errno and return
+ non-zero on errors. */
+# if @REPLACE_PTSNAME_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef ptsname_r
+# define ptsname_r rpl_ptsname_r
+# endif
+_GL_FUNCDECL_RPL (ptsname_r, int, (int fd, char *buf, size_t len));
+_GL_CXXALIAS_RPL (ptsname_r, int, (int fd, char *buf, size_t len));
+# else
+# if !@HAVE_PTSNAME_R@
+_GL_FUNCDECL_SYS (ptsname_r, int, (int fd, char *buf, size_t len));
+# endif
+_GL_CXXALIAS_SYS (ptsname_r, int, (int fd, char *buf, size_t len));
+# endif
+_GL_CXXALIASWARN (ptsname_r);
+#elif defined GNULIB_POSIXCHECK
+# undef ptsname_r
+# if HAVE_RAW_DECL_PTSNAME_R
+_GL_WARN_ON_USE (ptsname_r, "ptsname_r is not portable - "
+ "use gnulib module ptsname_r for portability");
+# endif
+#endif
+
#if @GNULIB_PUTENV@
# if @REPLACE_PUTENV@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# endif
#endif
+
+#if @GNULIB_RANDOM@
+# if !@HAVE_RANDOM@
+_GL_FUNCDECL_SYS (random, long, (void));
+# endif
+_GL_CXXALIAS_SYS (random, long, (void));
+_GL_CXXALIASWARN (random);
+#elif defined GNULIB_POSIXCHECK
+# undef random
+# if HAVE_RAW_DECL_RANDOM
+_GL_WARN_ON_USE (random, "random is unportable - "
+ "use gnulib module random for portability");
+# endif
+#endif
+
+#if @GNULIB_RANDOM@
+# if !@HAVE_RANDOM@
+_GL_FUNCDECL_SYS (srandom, void, (unsigned int seed));
+# endif
+_GL_CXXALIAS_SYS (srandom, void, (unsigned int seed));
+_GL_CXXALIASWARN (srandom);
+#elif defined GNULIB_POSIXCHECK
+# undef srandom
+# if HAVE_RAW_DECL_SRANDOM
+_GL_WARN_ON_USE (srandom, "srandom is unportable - "
+ "use gnulib module random for portability");
+# endif
+#endif
+
+#if @GNULIB_RANDOM@
+# if !@HAVE_RANDOM@
+_GL_FUNCDECL_SYS (initstate, char *,
+ (unsigned int seed, char *buf, size_t buf_size)
+ _GL_ARG_NONNULL ((2)));
+# endif
+_GL_CXXALIAS_SYS (initstate, char *,
+ (unsigned int seed, char *buf, size_t buf_size));
+_GL_CXXALIASWARN (initstate);
+#elif defined GNULIB_POSIXCHECK
+# undef initstate
+# if HAVE_RAW_DECL_INITSTATE_R
+_GL_WARN_ON_USE (initstate, "initstate is unportable - "
+ "use gnulib module random for portability");
+# endif
+#endif
+
+#if @GNULIB_RANDOM@
+# if !@HAVE_RANDOM@
+_GL_FUNCDECL_SYS (setstate, char *, (char *arg_state) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (setstate, char *, (char *arg_state));
+_GL_CXXALIASWARN (setstate);
+#elif defined GNULIB_POSIXCHECK
+# undef setstate
+# if HAVE_RAW_DECL_SETSTATE_R
+_GL_WARN_ON_USE (setstate, "setstate is unportable - "
+ "use gnulib module random for portability");
+# endif
+#endif
+
+
#if @GNULIB_RANDOM_R@
-# if !@HAVE_RANDOM_R@
+# if @REPLACE_RANDOM_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef random_r
+# define random_r rpl_random_r
+# endif
+_GL_FUNCDECL_RPL (random_r, int, (struct random_data *buf, int32_t *result)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (random_r, int, (struct random_data *buf, int32_t *result));
+# else
+# if !@HAVE_RANDOM_R@
_GL_FUNCDECL_SYS (random_r, int, (struct random_data *buf, int32_t *result)
_GL_ARG_NONNULL ((1, 2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (random_r, int, (struct random_data *buf, int32_t *result));
+# endif
_GL_CXXALIASWARN (random_r);
#elif defined GNULIB_POSIXCHECK
# undef random_r
#endif
#if @GNULIB_RANDOM_R@
-# if !@HAVE_RANDOM_R@
+# if @REPLACE_RANDOM_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef srandom_r
+# define srandom_r rpl_srandom_r
+# endif
+_GL_FUNCDECL_RPL (srandom_r, int,
+ (unsigned int seed, struct random_data *rand_state)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (srandom_r, int,
+ (unsigned int seed, struct random_data *rand_state));
+# else
+# if !@HAVE_RANDOM_R@
_GL_FUNCDECL_SYS (srandom_r, int,
(unsigned int seed, struct random_data *rand_state)
_GL_ARG_NONNULL ((2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (srandom_r, int,
(unsigned int seed, struct random_data *rand_state));
+# endif
_GL_CXXALIASWARN (srandom_r);
#elif defined GNULIB_POSIXCHECK
# undef srandom_r
#endif
#if @GNULIB_RANDOM_R@
-# if !@HAVE_RANDOM_R@
+# if @REPLACE_RANDOM_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef initstate_r
+# define initstate_r rpl_initstate_r
+# endif
+_GL_FUNCDECL_RPL (initstate_r, int,
+ (unsigned int seed, char *buf, size_t buf_size,
+ struct random_data *rand_state)
+ _GL_ARG_NONNULL ((2, 4)));
+_GL_CXXALIAS_RPL (initstate_r, int,
+ (unsigned int seed, char *buf, size_t buf_size,
+ struct random_data *rand_state));
+# else
+# if !@HAVE_RANDOM_R@
_GL_FUNCDECL_SYS (initstate_r, int,
(unsigned int seed, char *buf, size_t buf_size,
struct random_data *rand_state)
_GL_ARG_NONNULL ((2, 4)));
-# endif
+# endif
_GL_CXXALIAS_SYS (initstate_r, int,
(unsigned int seed, char *buf, size_t buf_size,
struct random_data *rand_state));
+# endif
_GL_CXXALIASWARN (initstate_r);
#elif defined GNULIB_POSIXCHECK
# undef initstate_r
#endif
#if @GNULIB_RANDOM_R@
-# if !@HAVE_RANDOM_R@
+# if @REPLACE_RANDOM_R@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef setstate_r
+# define setstate_r rpl_setstate_r
+# endif
+_GL_FUNCDECL_RPL (setstate_r, int,
+ (char *arg_state, struct random_data *rand_state)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (setstate_r, int,
+ (char *arg_state, struct random_data *rand_state));
+# else
+# if !@HAVE_RANDOM_R@
_GL_FUNCDECL_SYS (setstate_r, int,
(char *arg_state, struct random_data *rand_state)
_GL_ARG_NONNULL ((1, 2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (setstate_r, int,
(char *arg_state, struct random_data *rand_state));
+# endif
_GL_CXXALIASWARN (setstate_r);
#elif defined GNULIB_POSIXCHECK
# undef setstate_r
-/* Copyright (C) 1991-2001, 2003-2007, 2009-2011 Free Software Foundation, Inc.
+/* Copyright (C) 1991-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C Library.
Bugs can be reported to bug-glibc@prep.ai.mit.edu.
extern char *tzname[];
#endif
-/* Do multibyte processing if multibytes are supported, unless
+/* Do multibyte processing if multibyte encodings are supported, unless
multibyte sequences are safe in formats. Multibyte sequences are
safe if they cannot contain byte sequences that look like format
conversion specifications. The multibyte encodings used by the
# define TOLOWER(Ch, L) tolower (Ch)
# endif
#endif
-/* We don't use `isdigit' here since the locale dependent
+/* We don't use 'isdigit' here since the locale dependent
interpretation is not what we want here. We only need to accept
the arabic digits in the ASCII range. One day there is perhaps a
more reliable way to accept other sets of digits. */
#ifdef _NL_CURRENT
/* We cannot make the following values variables since we must delay
the evaluation of these values until really needed since some
- expressions might not be valid in every situation. The `struct tm'
+ expressions might not be valid in every situation. The 'struct tm'
might be generated by a strptime() call that initialized
only a few elements. Dereference the pointers only if the format
requires this. Then it is ok to fail if the pointers are invalid. */
goto do_number_body;
do_number_spacepad:
- /* Force `_' flag unless overridden by `0' or `-' flag. */
+ /* Force '_' flag unless overridden by '0' or '-' flag. */
if (pad != L_('0') && pad != L_('-'))
pad = L_('_');
/* declarations for strftime.c
- Copyright (C) 2002, 2004, 2008-2011 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2004, 2008-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
/* Convert string representation of a number into an intmax_t value.
- Copyright (C) 1999, 2001-2004, 2006, 2009-2011 Free Software Foundation,
+ Copyright (C) 1999, 2001-2004, 2006, 2009-2012 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
/* Convert string representation of a number into an integer value.
- Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2011 Free Software
+ Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2012 Free Software
Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
# include "../locale/localeinfo.h"
#endif
-/* Nonzero if we are defining `strtoul' or `strtoull', operating on
+/* Nonzero if we are defining 'strtoul' or 'strtoull', operating on
unsigned integers. */
#ifndef UNSIGNED
# define UNSIGNED 0
# endif
#endif
-/* If QUAD is defined, we are defining `strtoll' or `strtoull',
- operating on `long long int's. */
+/* If QUAD is defined, we are defining 'strtoll' or 'strtoull',
+ operating on 'long long int's. */
#ifdef QUAD
# define LONG long long
# define STRTOL_LONG_MIN LLONG_MIN
-/* Convert NPTR to an `unsigned long int' or `long int' in base BASE.
+/* Convert NPTR to an 'unsigned long int' or 'long int' in base BASE.
If BASE is 0 the base is determined by the presence of a leading
zero, indicating octal or a leading "0x" or "0X", indicating hexadecimal.
If BASE is < 2 or > 36, it is reset to 10.
#if !UNSIGNED
/* Check for a value that is within the range of
- `unsigned LONG int', but outside the range of `LONG int'. */
+ 'unsigned LONG int', but outside the range of 'LONG int'. */
if (overflow == 0
&& i > (negative
? -((unsigned LONG int) (STRTOL_LONG_MIN + 1)) + 1
/* We must handle a special case here: the base is 0 or 16 and the
first two characters are '0' and 'x', but the rest are no
hexadecimal digits. This is no error case. We return 0 and
- ENDPTR points to the `x`. */
+ ENDPTR points to the 'x'. */
if (endptr != NULL)
{
if (save - nptr >= 2 && TOUPPER (save[-1]) == L_('X')
-/* Function to parse a `long long int' from text.
- Copyright (C) 1995-1997, 1999, 2001, 2009-2011 Free Software Foundation,
+/* Function to parse a 'long long int' from text.
+ Copyright (C) 1995-1997, 1999, 2001, 2009-2012 Free Software Foundation,
Inc.
This file is part of the GNU C Library.
-/* Copyright (C) 1991, 1997, 2009-2011 Free Software Foundation, Inc.
+/* Copyright (C) 1991, 1997, 2009-2012 Free Software Foundation, Inc.
This file is part of the GNU C Library.
This program is free software: you can redistribute it and/or modify
-/* Function to parse an `unsigned long long int' from text.
- Copyright (C) 1995-1997, 1999, 2009-2011 Free Software Foundation, Inc.
+/* Function to parse an 'unsigned long long int' from text.
+ Copyright (C) 1995-1997, 1999, 2009-2012 Free Software Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
Library. Bugs can be reported to bug-glibc@gnu.org.
/* Stub for symlink().
- Copyright (C) 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
--- /dev/null
+/* Substitute for <sys/select.h>.
+ Copyright (C) 2007-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, or (at your option)
+ 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 <http://www.gnu.org/licenses/>. */
+
+# if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+# endif
+@PRAGMA_COLUMNS@
+
+/* On OSF/1, <sys/types.h> and <sys/time.h> include <sys/select.h>.
+ Simply delegate to the system's header in this case. */
+#if @HAVE_SYS_SELECT_H@ && defined __osf__ && (defined _SYS_TYPES_H_ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H) && defined _OSF_SOURCE
+
+# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+#elif @HAVE_SYS_SELECT_H@ && defined __osf__ && (defined _SYS_TIME_H_ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H) && defined _OSF_SOURCE
+
+# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+/* On IRIX 6.5, <sys/timespec.h> includes <sys/types.h>, which includes
+ <sys/bsd_types.h>, which includes <sys/select.h>. At this point we cannot
+ include <signal.h>, because that includes <internal/signal_core.h>, which
+ gives a syntax error because <sys/timespec.h> has not been completely
+ processed. Simply delegate to the system's header in this case. */
+#elif @HAVE_SYS_SELECT_H@ && defined __sgi && (defined _SYS_BSD_TYPES_H && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H)
+
+# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+/* On OpenBSD 5.0, <pthread.h> includes <sys/types.h>, which includes
+ <sys/select.h>. At this point we cannot include <signal.h>, because that
+ includes gnulib's pthread.h override, which gives a syntax error because
+ /usr/include/pthread.h has not been completely processed. Simply delegate
+ to the system's header in this case. */
+#elif @HAVE_SYS_SELECT_H@ && defined __OpenBSD__ && (defined _PTHREAD_H_ && !defined PTHREAD_MUTEX_INITIALIZER)
+
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+#else
+
+#ifndef _@GUARD_PREFIX@_SYS_SELECT_H
+
+/* On many platforms, <sys/select.h> assumes prior inclusion of
+ <sys/types.h>. Also, mingw defines sigset_t there, instead of
+ in <signal.h> where it belongs. */
+#include <sys/types.h>
+
+#if @HAVE_SYS_SELECT_H@
+
+/* On OSF/1 4.0, <sys/select.h> provides only a forward declaration
+ of 'struct timeval', and no definition of this type.
+ Also, Mac OS X, AIX, HP-UX, IRIX, Solaris, Interix declare select()
+ in <sys/time.h>.
+ But avoid namespace pollution on glibc systems. */
+# ifndef __GLIBC__
+# include <sys/time.h>
+# endif
+
+/* On AIX 7 and Solaris 10, <sys/select.h> provides an FD_ZERO implementation
+ that relies on memset(), but without including <string.h>.
+ But in any case avoid namespace pollution on glibc systems. */
+# if (defined __OpenBSD__ || defined _AIX || defined __sun || defined __osf__ || defined __BEOS__) \
+ && ! defined __GLIBC__
+# include <string.h>
+# endif
+
+/* The include_next requires a split double-inclusion guard. */
+# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@
+
+#endif
+
+/* Get definition of 'sigset_t'.
+ But avoid namespace pollution on glibc systems.
+ Do this after the include_next (for the sake of OpenBSD 5.0) but before
+ the split double-inclusion guard (for the sake of Solaris). */
+#if !(defined __GLIBC__ && !defined __UCLIBC__)
+# include <signal.h>
+#endif
+
+#ifndef _@GUARD_PREFIX@_SYS_SELECT_H
+#define _@GUARD_PREFIX@_SYS_SELECT_H
+
+#if !@HAVE_SYS_SELECT_H@
+/* A platform that lacks <sys/select.h>. */
+/* Get the 'struct timeval' and 'fd_set' types and the FD_* macros
+ on most platforms. */
+# include <sys/time.h>
+/* On HP-UX 11, <sys/time.h> provides an FD_ZERO implementation
+ that relies on memset(), but without including <string.h>. */
+# if defined __hpux
+# include <string.h>
+# endif
+/* On native Windows platforms:
+ Get the 'fd_set' type.
+ Get the close() declaration before we override it. */
+# if @HAVE_WINSOCK2_H@
+# if !defined _GL_INCLUDING_WINSOCK2_H
+# define _GL_INCLUDING_WINSOCK2_H
+# include <winsock2.h>
+# undef _GL_INCLUDING_WINSOCK2_H
+# endif
+# include <io.h>
+# endif
+#endif
+
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+
+/* Fix some definitions from <winsock2.h>. */
+
+#if @HAVE_WINSOCK2_H@
+
+# if !GNULIB_defined_rpl_fd_isset
+
+/* Re-define FD_ISSET to avoid a WSA call while we are not using
+ network sockets. */
+static int
+rpl_fd_isset (SOCKET fd, fd_set * set)
+{
+ u_int i;
+ if (set == NULL)
+ return 0;
+
+ for (i = 0; i < set->fd_count; i++)
+ if (set->fd_array[i] == fd)
+ return 1;
+
+ return 0;
+}
+
+# define GNULIB_defined_rpl_fd_isset 1
+# endif
+
+# undef FD_ISSET
+# define FD_ISSET(fd, set) rpl_fd_isset(fd, set)
+
+#endif
+
+/* Hide some function declarations from <winsock2.h>. */
+
+#if @HAVE_WINSOCK2_H@
+# if !defined _@GUARD_PREFIX@_UNISTD_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef close
+# define close close_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (close,
+ "close() used without including <unistd.h>");
+# endif
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gethostname
+# define gethostname gethostname_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (gethostname,
+ "gethostname() used without including <unistd.h>");
+# endif
+# endif
+# if !defined _@GUARD_PREFIX@_SYS_SOCKET_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef socket
+# define socket socket_used_without_including_sys_socket_h
+# undef connect
+# define connect connect_used_without_including_sys_socket_h
+# undef accept
+# define accept accept_used_without_including_sys_socket_h
+# undef bind
+# define bind bind_used_without_including_sys_socket_h
+# undef getpeername
+# define getpeername getpeername_used_without_including_sys_socket_h
+# undef getsockname
+# define getsockname getsockname_used_without_including_sys_socket_h
+# undef getsockopt
+# define getsockopt getsockopt_used_without_including_sys_socket_h
+# undef listen
+# define listen listen_used_without_including_sys_socket_h
+# undef recv
+# define recv recv_used_without_including_sys_socket_h
+# undef send
+# define send send_used_without_including_sys_socket_h
+# undef recvfrom
+# define recvfrom recvfrom_used_without_including_sys_socket_h
+# undef sendto
+# define sendto sendto_used_without_including_sys_socket_h
+# undef setsockopt
+# define setsockopt setsockopt_used_without_including_sys_socket_h
+# undef shutdown
+# define shutdown shutdown_used_without_including_sys_socket_h
+# else
+ _GL_WARN_ON_USE (socket,
+ "socket() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (connect,
+ "connect() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (accept,
+ "accept() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (bind,
+ "bind() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getpeername,
+ "getpeername() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockname,
+ "getsockname() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockopt,
+ "getsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (listen,
+ "listen() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recv,
+ "recv() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (send,
+ "send() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recvfrom,
+ "recvfrom() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (sendto,
+ "sendto() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (setsockopt,
+ "setsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (shutdown,
+ "shutdown() used without including <sys/socket.h>");
+# endif
+# endif
+#endif
+
+
+#if @GNULIB_PSELECT@
+# if @REPLACE_PSELECT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef pselect
+# define pselect rpl_pselect
+# endif
+_GL_FUNCDECL_RPL (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+_GL_CXXALIAS_RPL (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+# else
+# if !@HAVE_PSELECT@
+_GL_FUNCDECL_SYS (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+# endif
+_GL_CXXALIAS_SYS (pselect, int,
+ (int, fd_set *restrict, fd_set *restrict, fd_set *restrict,
+ struct timespec const *restrict, const sigset_t *restrict));
+# endif
+_GL_CXXALIASWARN (pselect);
+#elif defined GNULIB_POSIXCHECK
+# undef pselect
+# if HAVE_RAW_DECL_PSELECT
+_GL_WARN_ON_USE (pselect, "pselect is not portable - "
+ "use gnulib module pselect for portability");
+# endif
+#endif
+
+#if @GNULIB_SELECT@
+# if @REPLACE_SELECT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef select
+# define select rpl_select
+# endif
+_GL_FUNCDECL_RPL (select, int,
+ (int, fd_set *, fd_set *, fd_set *, struct timeval *));
+_GL_CXXALIAS_RPL (select, int,
+ (int, fd_set *, fd_set *, fd_set *, struct timeval *));
+# else
+_GL_CXXALIAS_SYS (select, int,
+ (int, fd_set *, fd_set *, fd_set *, struct timeval *));
+# endif
+_GL_CXXALIASWARN (select);
+#elif @HAVE_WINSOCK2_H@
+# undef select
+# define select select_used_without_requesting_gnulib_module_select
+#elif defined GNULIB_POSIXCHECK
+# undef select
+# if HAVE_RAW_DECL_SELECT
+_GL_WARN_ON_USE (select, "select is not always POSIX compliant - "
+ "use gnulib module select for portability");
+# endif
+#endif
+
+
+#endif /* _@GUARD_PREFIX@_SYS_SELECT_H */
+#endif /* _@GUARD_PREFIX@_SYS_SELECT_H */
+#endif /* OSF/1 */
/* Provide a more complete sys/stat header file.
- Copyright (C) 2005-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-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
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Eric Blake, Paul Eggert, and Jim Meyering. */
#ifndef _@GUARD_PREFIX@_SYS_STAT_H
-/* Get nlink_t. */
+/* Get nlink_t.
+ May also define off_t to a 64-bit type on native Windows. */
#include <sys/types.h>
/* Get struct timespec. */
# include <direct.h> /* mingw64, MSVC 9 */
#endif
+/* Native Windows platforms declare umask() in <io.h>. */
+#if 0 && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
+# include <io.h>
+#endif
+
+/* Large File Support on native Windows. */
+#if @WINDOWS_64_BIT_ST_SIZE@
+# define stat _stati64
+#endif
+
#ifndef S_IFIFO
# ifdef _S_IFIFO
# define S_IFIFO _S_IFIFO
_GL_CXXALIAS_SYS (fstat, int, (int fd, struct stat *buf));
# endif
_GL_CXXALIASWARN (fstat);
+#elif @WINDOWS_64_BIT_ST_SIZE@
+/* Above, we define stat to _stati64. */
+# define fstat _fstati64
#elif defined GNULIB_POSIXCHECK
# undef fstat
# if HAVE_RAW_DECL_FSTAT
/* We can't use the object-like #define stat rpl_stat, because of
struct stat. This means that rpl_stat will not be used if the user
does (stat)(a,b). Oh well. */
-# undef stat
-# ifdef _LARGE_FILES
+# if defined _AIX && defined stat && defined _LARGE_FILES
/* With _LARGE_FILES defined, AIX (only) defines stat to stat64,
so we have to replace stat64() instead of stat(). */
-# define stat stat64
# undef stat64
# define stat64(name, st) rpl_stat (name, st)
-# else /* !_LARGE_FILES */
+# elif @WINDOWS_64_BIT_ST_SIZE@
+ /* Above, we define stat to _stati64. */
+# if defined __MINGW32__ && defined _stati64
+# ifndef _USE_32BIT_TIME_T
+ /* The system headers define _stati64 to _stat64. */
+# undef _stat64
+# define _stat64(name, st) rpl_stat (name, st)
+# endif
+# elif defined _MSC_VER && defined _stati64
+# ifdef _USE_32BIT_TIME_T
+ /* The system headers define _stati64 to _stat32i64. */
+# undef _stat32i64
+# define _stat32i64(name, st) rpl_stat (name, st)
+# else
+ /* The system headers define _stati64 to _stat64. */
+# undef _stat64
+# define _stat64(name, st) rpl_stat (name, st)
+# endif
+# else
+# undef _stati64
+# define _stati64(name, st) rpl_stat (name, st)
+# endif
+# elif defined __MINGW32__ && defined stat
+# ifdef _USE_32BIT_TIME_T
+ /* The system headers define stat to _stat32i64. */
+# undef _stat32i64
+# define _stat32i64(name, st) rpl_stat (name, st)
+# else
+ /* The system headers define stat to _stat64. */
+# undef _stat64
+# define _stat64(name, st) rpl_stat (name, st)
+# endif
+# elif defined _MSC_VER && defined stat
+# ifdef _USE_32BIT_TIME_T
+ /* The system headers define stat to _stat32. */
+# undef _stat32
+# define _stat32(name, st) rpl_stat (name, st)
+# else
+ /* The system headers define stat to _stat64i32. */
+# undef _stat64i32
+# define _stat64i32(name, st) rpl_stat (name, st)
+# endif
+# else /* !(_AIX ||__MINGW32__ || _MSC_VER) */
+# undef stat
# define stat(name, st) rpl_stat (name, st)
# endif /* !_LARGE_FILES */
_GL_EXTERN_C int stat (const char *name, struct stat *buf)
--- /dev/null
+/* Provide a more complete sys/time.h.
+
+ Copyright (C) 2007-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, or (at your option)
+ 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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+@PRAGMA_COLUMNS@
+
+#if defined _@GUARD_PREFIX@_SYS_TIME_H
+
+/* Simply delegate to the system's header, without adding anything. */
+# if @HAVE_SYS_TIME_H@
+# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@
+# endif
+
+#else
+
+# define _@GUARD_PREFIX@_SYS_TIME_H
+
+# if @HAVE_SYS_TIME_H@
+# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@
+# else
+# include <time.h>
+# endif
+
+/* On native Windows with MSVC, get the 'struct timeval' type.
+ Also, on native Windows with a 64-bit time_t, where we are overriding the
+ 'struct timeval' type, get all declarations of system functions whose
+ signature contains 'struct timeval'. */
+# if (defined _MSC_VER || @REPLACE_STRUCT_TIMEVAL@) && @HAVE_WINSOCK2_H@ && !defined _GL_INCLUDING_WINSOCK2_H
+# define _GL_INCLUDING_WINSOCK2_H
+# include <winsock2.h>
+# undef _GL_INCLUDING_WINSOCK2_H
+# endif
+
+/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
+
+/* The definition of _GL_ARG_NONNULL is copied here. */
+
+/* The definition of _GL_WARN_ON_USE is copied here. */
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+# if !@HAVE_STRUCT_TIMEVAL@ || @REPLACE_STRUCT_TIMEVAL@
+
+# if @REPLACE_STRUCT_TIMEVAL@
+# define timeval rpl_timeval
+# endif
+
+# if !GNULIB_defined_struct_timeval
+struct timeval
+{
+ time_t tv_sec;
+ long int tv_usec;
+};
+# define GNULIB_defined_struct_timeval 1
+# endif
+
+# endif
+
+# ifdef __cplusplus
+}
+# endif
+
+# if @GNULIB_GETTIMEOFDAY@
+# if @REPLACE_GETTIMEOFDAY@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gettimeofday
+# define gettimeofday rpl_gettimeofday
+# endif
+_GL_FUNCDECL_RPL (gettimeofday, int,
+ (struct timeval *restrict, void *restrict)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (gettimeofday, int,
+ (struct timeval *restrict, void *restrict));
+# else
+# if !@HAVE_GETTIMEOFDAY@
+_GL_FUNCDECL_SYS (gettimeofday, int,
+ (struct timeval *restrict, void *restrict)
+ _GL_ARG_NONNULL ((1)));
+# endif
+/* Need to cast, because on glibc systems, by default, the second argument is
+ struct timezone *. */
+_GL_CXXALIAS_SYS_CAST (gettimeofday, int,
+ (struct timeval *restrict, void *restrict));
+# endif
+_GL_CXXALIASWARN (gettimeofday);
+# elif defined GNULIB_POSIXCHECK
+# undef gettimeofday
+# if HAVE_RAW_DECL_GETTIMEOFDAY
+_GL_WARN_ON_USE (gettimeofday, "gettimeofday is unportable - "
+ "use gnulib module gettimeofday for portability");
+# endif
+# endif
+
+/* Hide some function declarations from <winsock2.h>. */
+
+# if defined _MSC_VER && @HAVE_WINSOCK2_H@
+# if !defined _@GUARD_PREFIX@_UNISTD_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef close
+# define close close_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (close,
+ "close() used without including <unistd.h>");
+# endif
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gethostname
+# define gethostname gethostname_used_without_including_unistd_h
+# else
+ _GL_WARN_ON_USE (gethostname,
+ "gethostname() used without including <unistd.h>");
+# endif
+# endif
+# if !defined _@GUARD_PREFIX@_SYS_SOCKET_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef socket
+# define socket socket_used_without_including_sys_socket_h
+# undef connect
+# define connect connect_used_without_including_sys_socket_h
+# undef accept
+# define accept accept_used_without_including_sys_socket_h
+# undef bind
+# define bind bind_used_without_including_sys_socket_h
+# undef getpeername
+# define getpeername getpeername_used_without_including_sys_socket_h
+# undef getsockname
+# define getsockname getsockname_used_without_including_sys_socket_h
+# undef getsockopt
+# define getsockopt getsockopt_used_without_including_sys_socket_h
+# undef listen
+# define listen listen_used_without_including_sys_socket_h
+# undef recv
+# define recv recv_used_without_including_sys_socket_h
+# undef send
+# define send send_used_without_including_sys_socket_h
+# undef recvfrom
+# define recvfrom recvfrom_used_without_including_sys_socket_h
+# undef sendto
+# define sendto sendto_used_without_including_sys_socket_h
+# undef setsockopt
+# define setsockopt setsockopt_used_without_including_sys_socket_h
+# undef shutdown
+# define shutdown shutdown_used_without_including_sys_socket_h
+# else
+ _GL_WARN_ON_USE (socket,
+ "socket() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (connect,
+ "connect() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (accept,
+ "accept() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (bind,
+ "bind() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getpeername,
+ "getpeername() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockname,
+ "getsockname() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (getsockopt,
+ "getsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (listen,
+ "listen() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recv,
+ "recv() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (send,
+ "send() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (recvfrom,
+ "recvfrom() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (sendto,
+ "sendto() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (setsockopt,
+ "setsockopt() used without including <sys/socket.h>");
+ _GL_WARN_ON_USE (shutdown,
+ "shutdown() used without including <sys/socket.h>");
+# endif
+# endif
+# if !defined _@GUARD_PREFIX@_SYS_SELECT_H
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef select
+# define select select_used_without_including_sys_select_h
+# else
+ _GL_WARN_ON_USE (select,
+ "select() used without including <sys/select.h>");
+# endif
+# endif
+# endif
+
+#endif /* _@GUARD_PREFIX@_SYS_TIME_H */
--- /dev/null
+/* Provide a more complete sys/types.h.
+
+ Copyright (C) 2011-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, or (at your option)
+ 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 <http://www.gnu.org/licenses/>. */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+@PRAGMA_COLUMNS@
+
+#ifndef _@GUARD_PREFIX@_SYS_TYPES_H
+
+/* The include_next requires a split double-inclusion guard. */
+#@INCLUDE_NEXT@ @NEXT_SYS_TYPES_H@
+
+#ifndef _@GUARD_PREFIX@_SYS_TYPES_H
+#define _@GUARD_PREFIX@_SYS_TYPES_H
+
+/* Override off_t if Large File Support is requested on native Windows. */
+#if @WINDOWS_64_BIT_OFF_T@
+/* Same as int64_t in <stdint.h>. */
+# if defined _MSC_VER
+# define off_t __int64
+# else
+# define off_t long long int
+# endif
+/* Indicator, for gnulib internal purposes. */
+# define _GL_WINDOWS_64_BIT_OFF_T 1
+#endif
+
+/* MSVC 9 defines size_t in <stddef.h>, not in <sys/types.h>. */
+/* But avoid namespace pollution on glibc systems. */
+#if ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) \
+ && ! defined __GLIBC__
+# include <stddef.h>
+#endif
+
+#endif /* _@GUARD_PREFIX@_SYS_TYPES_H */
+#endif /* _@GUARD_PREFIX@_SYS_TYPES_H */
/* A more-standard <time.h>.
- Copyright (C) 2007-2011 Free Software Foundation, Inc.
+ Copyright (C) 2007-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
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
/* Reentrant time functions like localtime_r.
- Copyright (C) 2003, 2006-2007, 2010-2011 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2006-2007, 2010-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
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ with this program; if not, see <http://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
--- /dev/null
+/* Add two struct timespec values.
+
+ Copyright (C) 2011-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
+ (at your option) 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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+/* Return the sum of two timespec values A and B. On overflow, return
+ an extremal value. This assumes 0 <= tv_nsec <= 999999999. */
+
+#include <config.h>
+#include "timespec.h"
+
+#include "intprops.h"
+
+struct timespec
+timespec_add (struct timespec a, struct timespec b)
+{
+ struct timespec r;
+ time_t rs = a.tv_sec;
+ time_t bs = b.tv_sec;
+ int ns = a.tv_nsec + b.tv_nsec;
+ int nsd = ns - 1000000000;
+ int rns = ns;
+
+ if (0 <= nsd)
+ {
+ rns = nsd;
+ if (rs == TYPE_MAXIMUM (time_t))
+ {
+ if (0 <= bs)
+ goto high_overflow;
+ bs++;
+ }
+ else
+ rs++;
+ }
+
+ if (INT_ADD_OVERFLOW (rs, bs))
+ {
+ if (rs < 0)
+ {
+ rs = TYPE_MINIMUM (time_t);
+ rns = 0;
+ }
+ else
+ {
+ high_overflow:
+ rs = TYPE_MAXIMUM (time_t);
+ rns = 999999999;
+ }
+ }
+ else
+ rs += bs;
+
+ r.tv_sec = rs;
+ r.tv_nsec = rns;
+ return r;
+}
--- /dev/null
+/* Subtract two struct timespec values.
+
+ Copyright (C) 2011-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
+ (at your option) 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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+/* Return the difference between two timespec values A and B. On
+ overflow, return an extremal value. This assumes 0 <= tv_nsec <=
+ 999999999. */
+
+#include <config.h>
+#include "timespec.h"
+
+#include "intprops.h"
+
+struct timespec
+timespec_sub (struct timespec a, struct timespec b)
+{
+ struct timespec r;
+ time_t rs = a.tv_sec;
+ time_t bs = b.tv_sec;
+ int ns = a.tv_nsec - b.tv_nsec;
+ int rns = ns;
+
+ if (ns < 0)
+ {
+ rns = ns + 1000000000;
+ if (rs == TYPE_MINIMUM (time_t))
+ {
+ if (bs <= 0)
+ goto low_overflow;
+ bs--;
+ }
+ else
+ rs--;
+ }
+
+ if (INT_SUBTRACT_OVERFLOW (rs, bs))
+ {
+ if (rs < 0)
+ {
+ low_overflow:
+ rs = TYPE_MINIMUM (time_t);
+ rns = 0;
+ }
+ else
+ {
+ rs = TYPE_MAXIMUM (time_t);
+ rns = 999999999;
+ }
+ }
+ else
+ rs -= bs;
+
+ r.tv_sec = rs;
+ r.tv_nsec = rns;
+ return r;
+}
--- /dev/null
+#include <config.h>
+#define _GL_TIMESPEC_INLINE _GL_EXTERN_INLINE
+#include "timespec.h"
--- /dev/null
+/* timespec -- System time interface
+
+ Copyright (C) 2000, 2002, 2004-2005, 2007, 2009-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
+ (at your option) 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 <http://www.gnu.org/licenses/>. */
+
+#if ! defined TIMESPEC_H
+# define TIMESPEC_H
+
+# include <time.h>
+
+_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:
+
+ * T.tv_nsec is in the range 0..999999999; or
+ * T.tv_sec corresponds to a valid leap second on a host that supports
+ leap seconds, and T.tv_nsec is in the range 1000000000..1999999999; or
+ * T.tv_sec is the minimum time_t value and T.tv_nsec is -1; or
+ T.tv_sec is the maximum time_t value and T.tv_nsec is 2000000000.
+ This allows for special struct timespec values that are less or
+ greater than all possible valid time stamps.
+
+ In all these cases, it is safe to subtract two tv_nsec values and
+ convert the result to integer without worrying about overflow on
+ any platform of interest to the GNU project, since all such
+ platforms have 32-bit int or wider.
+
+ Replacing "(int) (a.tv_nsec - b.tv_nsec)" with something like
+ "a.tv_nsec < b.tv_nsec ? -1 : a.tv_nsec > b.tv_nsec" would cause
+ this function to work in some cases where the above assumption is
+ violated, but not in all cases (e.g., a.tv_sec==1, a.tv_nsec==-2,
+ b.tv_sec==0, b.tv_nsec==999999999) and is arguably not worth the
+ extra instructions. Using a subtraction has the advantage of
+ detecting some invalid cases on platforms that detect integer
+ overflow.
+
+ The (int) cast avoids a gcc -Wconversion warning. */
+
+_GL_TIMESPEC_INLINE int
+timespec_cmp (struct timespec a, struct timespec b)
+{
+ return (a.tv_sec < b.tv_sec ? -1
+ : a.tv_sec > b.tv_sec ? 1
+ : (int) (a.tv_nsec - b.tv_nsec));
+}
+
+/* Return -1, 0, 1, depending on the sign of A. A.tv_nsec must be
+ nonnegative. */
+_GL_TIMESPEC_INLINE int
+timespec_sign (struct timespec a)
+{
+ return a.tv_sec < 0 ? -1 : a.tv_sec || a.tv_nsec;
+}
+
+struct timespec timespec_add (struct timespec, struct timespec)
+ _GL_ATTRIBUTE_CONST;
+struct timespec timespec_sub (struct timespec, struct timespec)
+ _GL_ATTRIBUTE_CONST;
+struct timespec dtotimespec (double)
+ _GL_ATTRIBUTE_CONST;
+
+/* Return an approximation to A, of type 'double'. */
+_GL_TIMESPEC_INLINE double
+timespectod (struct timespec a)
+{
+ return a.tv_sec + a.tv_nsec / 1e9;
+}
+
+void gettime (struct timespec *);
+int settime (struct timespec const *);
+
+_GL_INLINE_HEADER_END
+
+#endif
--- /dev/null
+#include <config.h>
+#define _GL_U64_INLINE _GL_EXTERN_INLINE
+#include "u64.h"
/* uint64_t-like operations that work even on hosts lacking uint64_t
- Copyright (C) 2006, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-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
#include <stdint.h>
+_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))
# define u64hilo(hi, lo) ((u64) (((u64) (hi) << 32) + (lo)))
# define u64init(hi, lo) u64hilo (hi, lo)
# define u64lo(x) ((u64) (x))
+# define u64size(x) u64lo (x)
# define u64lt(x, y) ((x) < (y))
# define u64and(x, y) ((x) & (y))
# define u64or(x, y) ((x) | (y))
/* 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;
}
/* Return a u64 value representing LO. */
-static inline u64
+_GL_U64_INLINE u64
u64lo (uint32_t lo)
{
u64 r;
return r;
}
+/* Return a u64 value representing SIZE. */
+_GL_U64_INLINE u64
+u64size (size_t size)
+{
+ u64 r;
+ r.hi = size >> 31 >> 1;
+ r.lo = size;
+ return r;
+}
+
/* 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;
}
/* Return X | Y. */
-static inline u64
+_GL_U64_INLINE u64
u64or (u64 x, u64 y)
{
u64 r;
}
/* Return X ^ Y. */
-static inline u64
+_GL_U64_INLINE u64
u64xor (u64 x, u64 y)
{
u64 r;
}
/* Return X + Y. */
-static inline u64
+_GL_U64_INLINE u64
u64plus (u64 x, u64 y)
{
u64 r;
}
/* Return X << N. */
-static inline u64
+_GL_U64_INLINE u64
u64shl (u64 x, int n)
{
u64 r;
}
/* Return X >> N. */
-static inline u64
+_GL_U64_INLINE u64
u64shr (u64 x, int n)
{
u64 r;
}
#endif
+
+_GL_INLINE_HEADER_END
/* Substitute for and wrapper around <unistd.h>.
- Copyright (C) 2003-2011 Free Software Foundation, Inc.
+ Copyright (C) 2003-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
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, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+ along with this program; if not, see <http://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
#endif
/* Native Windows platforms declare chdir, getcwd, rmdir in
- <io.h> and/or <direct.h>, not in <unistd.h>. */
+ <io.h> and/or <direct.h>, not in <unistd.h>.
+ They also declare access(), chmod(), close(), dup(), dup2(), isatty(),
+ lseek(), read(), unlink(), write() in <io.h>. */
#if ((@GNULIB_CHDIR@ || @GNULIB_GETCWD@ || @GNULIB_RMDIR@ \
|| defined GNULIB_POSIXCHECK) \
&& ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__))
# include <io.h> /* mingw32, mingw64 */
# include <direct.h> /* mingw64, MSVC 9 */
+#elif (@GNULIB_CLOSE@ || @GNULIB_DUP@ || @GNULIB_DUP2@ || @GNULIB_ISATTY@ \
+ || @GNULIB_LSEEK@ || @GNULIB_READ@ || @GNULIB_UNLINK@ || @GNULIB_WRITE@ \
+ || defined GNULIB_POSIXCHECK) \
+ && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__)
+# include <io.h>
#endif
/* AIX and OSF/1 5.1 declare getdomainname in <netdb.h>, not in <unistd.h>.
# include <netdb.h>
#endif
-/* MSVC defines off_t in <sys/types.h>. */
-#if !@HAVE_UNISTD_H@
+/* MSVC defines off_t in <sys/types.h>.
+ May also define off_t to a 64-bit type on native Windows. */
+#if !@HAVE_UNISTD_H@ || @WINDOWS_64_BIT_OFF_T@
/* Get off_t. */
# include <sys/types.h>
#endif
Return 0 if successful, otherwise -1 and errno set.
See the POSIX:2008 specification
<http://pubs.opengroup.org/onlinepubs/9699919799/functions/ftruncate.html>. */
-# if !@HAVE_FTRUNCATE@
+# if @REPLACE_FTRUNCATE@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef ftruncate
+# define ftruncate rpl_ftruncate
+# endif
+_GL_FUNCDECL_RPL (ftruncate, int, (int fd, off_t length));
+_GL_CXXALIAS_RPL (ftruncate, int, (int fd, off_t length));
+# else
+# if !@HAVE_FTRUNCATE@
_GL_FUNCDECL_SYS (ftruncate, int, (int fd, off_t length));
-# endif
+# endif
_GL_CXXALIAS_SYS (ftruncate, int, (int fd, off_t length));
+# endif
_GL_CXXALIASWARN (ftruncate);
#elif defined GNULIB_POSIXCHECK
# undef ftruncate
#endif
+#if @GNULIB_ISATTY@
+# if @REPLACE_ISATTY@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef isatty
+# define isatty rpl_isatty
+# endif
+_GL_FUNCDECL_RPL (isatty, int, (int fd));
+_GL_CXXALIAS_RPL (isatty, int, (int fd));
+# else
+_GL_CXXALIAS_SYS (isatty, int, (int fd));
+# endif
+_GL_CXXALIASWARN (isatty);
+#elif defined GNULIB_POSIXCHECK
+# undef isatty
+# if HAVE_RAW_DECL_ISATTY
+_GL_WARN_ON_USE (isatty, "isatty has portability problems on native Windows - "
+ "use gnulib module isatty for portability");
+# endif
+#endif
+
+
#if @GNULIB_LCHOWN@
/* Change the owner of FILE to UID (if UID is not -1) and the group of FILE
to GID (if GID is not -1). Do not follow symbolic links.
#endif
+#if @GNULIB_SETHOSTNAME@
+/* Set the host name of the machine.
+ The host name may or may not be fully qualified.
+
+ Put LEN bytes of NAME into the host name.
+ Return 0 if successful, otherwise, set errno and return -1.
+
+ Platforms with no ability to set the hostname return -1 and set
+ errno = ENOSYS. */
+# if !@HAVE_SETHOSTNAME@ || !@HAVE_DECL_SETHOSTNAME@
+_GL_FUNCDECL_SYS (sethostname, int, (const char *name, size_t len)
+ _GL_ARG_NONNULL ((1)));
+# endif
+/* Need to cast, because on Solaris 11 2011-10, Mac OS X 10.5, IRIX 6.5
+ and FreeBSD 6.4 the second parameter is int. On Solaris 11
+ 2011-10, the first parameter is not const. */
+_GL_CXXALIAS_SYS_CAST (sethostname, int, (const char *name, size_t len));
+_GL_CXXALIASWARN (sethostname);
+#elif defined GNULIB_POSIXCHECK
+# undef sethostname
+# if HAVE_RAW_DECL_SETHOSTNAME
+_GL_WARN_ON_USE (sethostname, "sethostname is unportable - "
+ "use gnulib module sethostname for portability");
+# endif
+#endif
+
+
#if @GNULIB_SLEEP@
/* Pause the execution of the current thread for N seconds.
Returns the number of seconds left to sleep.
--- /dev/null
+/* Set file access and modification times.
+
+ Copyright (C) 2003-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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+/* derived from a function in touch.c */
+
+#include <config.h>
+
+#define _GL_UTIMENS_INLINE _GL_EXTERN_INLINE
+#include "utimens.h"
+
+#include <assert.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <stdbool.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <unistd.h>
+
+#include "stat-time.h"
+#include "timespec.h"
+
+#if HAVE_UTIME_H
+# include <utime.h>
+#endif
+
+/* Some systems (even some that do have <utime.h>) don't declare this
+ structure anywhere. */
+#ifndef HAVE_STRUCT_UTIMBUF
+struct utimbuf
+{
+ long actime;
+ long modtime;
+};
+#endif
+
+/* Avoid recursion with rpl_futimens or rpl_utimensat. */
+#undef futimens
+#undef utimensat
+
+/* Solaris 9 mistakenly succeeds when given a non-directory with a
+ trailing slash. Force the use of rpl_stat for a fix. */
+#ifndef REPLACE_FUNC_STAT_FILE
+# define REPLACE_FUNC_STAT_FILE 0
+#endif
+
+#if HAVE_UTIMENSAT || HAVE_FUTIMENS
+/* Cache variables for whether the utimensat syscall works; used to
+ avoid calling the syscall if we know it will just fail with ENOSYS,
+ and to avoid unnecessary work in massaging timestamps if the
+ syscall will work. Multiple variables are needed, to distinguish
+ between the following scenarios on Linux:
+ utimensat doesn't exist, or is in glibc but kernel 2.6.18 fails with ENOSYS
+ kernel 2.6.22 and earlier rejects AT_SYMLINK_NOFOLLOW
+ kernel 2.6.25 and earlier reject UTIME_NOW/UTIME_OMIT with non-zero tv_sec
+ kernel 2.6.32 used with xfs or ntfs-3g fail to honor UTIME_OMIT
+ utimensat completely works
+ For each cache variable: 0 = unknown, 1 = yes, -1 = no. */
+static int utimensat_works_really;
+static int lutimensat_works_really;
+#endif /* HAVE_UTIMENSAT || HAVE_FUTIMENS */
+
+/* Validate the requested timestamps. Return 0 if the resulting
+ timespec can be used for utimensat (after possibly modifying it to
+ work around bugs in utimensat). Return a positive value if the
+ timespec needs further adjustment based on stat results: 1 if any
+ adjustment is needed for utimes, and 2 if any adjustment is needed
+ for Linux utimensat. Return -1, with errno set to EINVAL, if
+ timespec is out of range. */
+static int
+validate_timespec (struct timespec timespec[2])
+{
+ int result = 0;
+ int utime_omit_count = 0;
+ assert (timespec);
+ if ((timespec[0].tv_nsec != UTIME_NOW
+ && timespec[0].tv_nsec != UTIME_OMIT
+ && (timespec[0].tv_nsec < 0 || 1000000000 <= timespec[0].tv_nsec))
+ || (timespec[1].tv_nsec != UTIME_NOW
+ && timespec[1].tv_nsec != UTIME_OMIT
+ && (timespec[1].tv_nsec < 0 || 1000000000 <= timespec[1].tv_nsec)))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ /* Work around Linux kernel 2.6.25 bug, where utimensat fails with
+ EINVAL if tv_sec is not 0 when using the flag values of tv_nsec.
+ Flag a Linux kernel 2.6.32 bug, where an mtime of UTIME_OMIT
+ fails to bump ctime. */
+ if (timespec[0].tv_nsec == UTIME_NOW
+ || timespec[0].tv_nsec == UTIME_OMIT)
+ {
+ timespec[0].tv_sec = 0;
+ result = 1;
+ if (timespec[0].tv_nsec == UTIME_OMIT)
+ utime_omit_count++;
+ }
+ if (timespec[1].tv_nsec == UTIME_NOW
+ || timespec[1].tv_nsec == UTIME_OMIT)
+ {
+ timespec[1].tv_sec = 0;
+ result = 1;
+ if (timespec[1].tv_nsec == UTIME_OMIT)
+ utime_omit_count++;
+ }
+ return result + (utime_omit_count == 1);
+}
+
+/* Normalize any UTIME_NOW or UTIME_OMIT values in *TS, using stat
+ buffer STATBUF to obtain the current timestamps of the file. If
+ both times are UTIME_NOW, set *TS to NULL (as this can avoid some
+ permissions issues). If both times are UTIME_OMIT, return true
+ (nothing further beyond the prior collection of STATBUF is
+ necessary); otherwise return false. */
+static bool
+update_timespec (struct stat const *statbuf, struct timespec *ts[2])
+{
+ struct timespec *timespec = *ts;
+ if (timespec[0].tv_nsec == UTIME_OMIT
+ && timespec[1].tv_nsec == UTIME_OMIT)
+ return true;
+ if (timespec[0].tv_nsec == UTIME_NOW
+ && timespec[1].tv_nsec == UTIME_NOW)
+ {
+ *ts = NULL;
+ return false;
+ }
+
+ if (timespec[0].tv_nsec == UTIME_OMIT)
+ timespec[0] = get_stat_atime (statbuf);
+ else if (timespec[0].tv_nsec == UTIME_NOW)
+ gettime (×pec[0]);
+
+ if (timespec[1].tv_nsec == UTIME_OMIT)
+ timespec[1] = get_stat_mtime (statbuf);
+ else if (timespec[1].tv_nsec == UTIME_NOW)
+ gettime (×pec[1]);
+
+ return false;
+}
+
+/* Set the access and modification time stamps of FD (a.k.a. FILE) to be
+ TIMESPEC[0] and TIMESPEC[1], respectively.
+ FD must be either negative -- in which case it is ignored --
+ or a file descriptor that is open on FILE.
+ If FD is nonnegative, then FILE can be NULL, which means
+ use just futimes (or equivalent) instead of utimes (or equivalent),
+ and fail if on an old system without futimes (or equivalent).
+ If TIMESPEC is null, set the time stamps to the current time.
+ Return 0 on success, -1 (setting errno) on failure. */
+
+int
+fdutimens (int fd, char const *file, struct timespec const timespec[2])
+{
+ struct timespec adjusted_timespec[2];
+ struct timespec *ts = timespec ? adjusted_timespec : NULL;
+ int adjustment_needed = 0;
+ struct stat st;
+
+ if (ts)
+ {
+ adjusted_timespec[0] = timespec[0];
+ adjusted_timespec[1] = timespec[1];
+ adjustment_needed = validate_timespec (ts);
+ }
+ if (adjustment_needed < 0)
+ return -1;
+
+ /* Require that at least one of FD or FILE are potentially valid, to avoid
+ a Linux bug where futimens (AT_FDCWD, NULL) changes "." rather
+ than failing. */
+ if (fd < 0 && !file)
+ {
+ errno = EBADF;
+ return -1;
+ }
+
+ /* Some Linux-based NFS clients are buggy, and mishandle time stamps
+ of files in NFS file systems in some cases. We have no
+ configure-time test for this, but please see
+ <http://bugs.gentoo.org/show_bug.cgi?id=132673> for references to
+ some of the problems with Linux 2.6.16. If this affects you,
+ compile with -DHAVE_BUGGY_NFS_TIME_STAMPS; this is reported to
+ help in some cases, albeit at a cost in performance. But you
+ really should upgrade your kernel to a fixed version, since the
+ problem affects many applications. */
+
+#if HAVE_BUGGY_NFS_TIME_STAMPS
+ if (fd < 0)
+ sync ();
+ else
+ fsync (fd);
+#endif
+
+ /* POSIX 2008 added two interfaces to set file timestamps with
+ nanosecond resolution; newer Linux implements both functions via
+ a single syscall. We provide a fallback for ENOSYS (for example,
+ compiling against Linux 2.6.25 kernel headers and glibc 2.7, but
+ running on Linux 2.6.18 kernel). */
+#if HAVE_UTIMENSAT || HAVE_FUTIMENS
+ if (0 <= utimensat_works_really)
+ {
+ int result;
+# if __linux__
+ /* As recently as Linux kernel 2.6.32 (Dec 2009), several file
+ systems (xfs, ntfs-3g) have bugs with a single UTIME_OMIT,
+ but work if both times are either explicitly specified or
+ UTIME_NOW. Work around it with a preparatory [f]stat prior
+ to calling futimens/utimensat; fortunately, there is not much
+ timing impact due to the extra syscall even on file systems
+ where UTIME_OMIT would have worked. FIXME: Simplify this in
+ 2012, when file system bugs are no longer common. */
+ if (adjustment_needed == 2)
+ {
+ if (fd < 0 ? stat (file, &st) : fstat (fd, &st))
+ return -1;
+ if (ts[0].tv_nsec == UTIME_OMIT)
+ ts[0] = get_stat_atime (&st);
+ else if (ts[1].tv_nsec == UTIME_OMIT)
+ ts[1] = get_stat_mtime (&st);
+ /* Note that st is good, in case utimensat gives ENOSYS. */
+ adjustment_needed++;
+ }
+# endif /* __linux__ */
+# if HAVE_UTIMENSAT
+ if (fd < 0)
+ {
+ result = utimensat (AT_FDCWD, file, ts, 0);
+# ifdef __linux__
+ /* Work around a kernel bug:
+ http://bugzilla.redhat.com/442352
+ http://bugzilla.redhat.com/449910
+ It appears that utimensat can mistakenly return 280 rather
+ than -1 upon ENOSYS failure.
+ FIXME: remove in 2010 or whenever the offending kernels
+ are no longer in common use. */
+ if (0 < result)
+ errno = ENOSYS;
+# endif /* __linux__ */
+ if (result == 0 || errno != ENOSYS)
+ {
+ utimensat_works_really = 1;
+ return result;
+ }
+ }
+# endif /* HAVE_UTIMENSAT */
+# if HAVE_FUTIMENS
+ if (0 <= fd)
+ {
+ result = futimens (fd, ts);
+# ifdef __linux__
+ /* Work around the same bug as above. */
+ if (0 < result)
+ errno = ENOSYS;
+# endif /* __linux__ */
+ if (result == 0 || errno != ENOSYS)
+ {
+ utimensat_works_really = 1;
+ return result;
+ }
+ }
+# endif /* HAVE_FUTIMENS */
+ }
+ utimensat_works_really = -1;
+ lutimensat_works_really = -1;
+#endif /* HAVE_UTIMENSAT || HAVE_FUTIMENS */
+
+ /* The platform lacks an interface to set file timestamps with
+ nanosecond resolution, so do the best we can, discarding any
+ fractional part of the timestamp. */
+
+ if (adjustment_needed || (REPLACE_FUNC_STAT_FILE && fd < 0))
+ {
+ if (adjustment_needed != 3
+ && (fd < 0 ? stat (file, &st) : fstat (fd, &st)))
+ return -1;
+ if (ts && update_timespec (&st, &ts))
+ return 0;
+ }
+
+ {
+#if HAVE_FUTIMESAT || HAVE_WORKING_UTIMES
+ struct timeval timeval[2];
+ struct timeval *t;
+ if (ts)
+ {
+ timeval[0].tv_sec = ts[0].tv_sec;
+ timeval[0].tv_usec = ts[0].tv_nsec / 1000;
+ timeval[1].tv_sec = ts[1].tv_sec;
+ timeval[1].tv_usec = ts[1].tv_nsec / 1000;
+ t = timeval;
+ }
+ else
+ t = NULL;
+
+ if (fd < 0)
+ {
+# if HAVE_FUTIMESAT
+ return futimesat (AT_FDCWD, file, t);
+# endif
+ }
+ else
+ {
+ /* If futimesat or futimes fails here, don't try to speed things
+ up by returning right away. glibc can incorrectly fail with
+ errno == ENOENT if /proc isn't mounted. Also, Mandrake 10.0
+ in high security mode doesn't allow ordinary users to read
+ /proc/self, so glibc incorrectly fails with errno == EACCES.
+ If errno == EIO, EPERM, or EROFS, it's probably safe to fail
+ right away, but these cases are rare enough that they're not
+ worth optimizing, and who knows what other messed-up systems
+ are out there? So play it safe and fall back on the code
+ below. */
+
+# if (HAVE_FUTIMESAT && !FUTIMESAT_NULL_BUG) || HAVE_FUTIMES
+# if HAVE_FUTIMESAT && !FUTIMESAT_NULL_BUG
+# undef futimes
+# define futimes(fd, t) futimesat (fd, NULL, t)
+# endif
+ if (futimes (fd, t) == 0)
+ {
+# if __linux__ && __GLIBC__
+ /* Work around a longstanding glibc bug, still present as
+ of 2010-12-27. On older Linux kernels that lack both
+ utimensat and utimes, glibc's futimes rounds instead of
+ truncating when falling back on utime. The same bug
+ occurs in futimesat with a null 2nd arg. */
+ if (t)
+ {
+ bool abig = 500000 <= t[0].tv_usec;
+ bool mbig = 500000 <= t[1].tv_usec;
+ if ((abig | mbig) && fstat (fd, &st) == 0)
+ {
+ /* If these two subtractions overflow, they'll
+ track the overflows inside the buggy glibc. */
+ time_t adiff = st.st_atime - t[0].tv_sec;
+ time_t mdiff = st.st_mtime - t[1].tv_sec;
+
+ struct timeval *tt = NULL;
+ struct timeval truncated_timeval[2];
+ truncated_timeval[0] = t[0];
+ truncated_timeval[1] = t[1];
+ if (abig && adiff == 1 && get_stat_atime_ns (&st) == 0)
+ {
+ tt = truncated_timeval;
+ tt[0].tv_usec = 0;
+ }
+ if (mbig && mdiff == 1 && get_stat_mtime_ns (&st) == 0)
+ {
+ tt = truncated_timeval;
+ tt[1].tv_usec = 0;
+ }
+ if (tt)
+ futimes (fd, tt);
+ }
+ }
+# endif
+
+ return 0;
+ }
+# endif
+ }
+#endif /* HAVE_FUTIMESAT || HAVE_WORKING_UTIMES */
+
+ if (!file)
+ {
+#if ! ((HAVE_FUTIMESAT && !FUTIMESAT_NULL_BUG) \
+ || (HAVE_WORKING_UTIMES && HAVE_FUTIMES))
+ errno = ENOSYS;
+#endif
+ return -1;
+ }
+
+#if HAVE_WORKING_UTIMES
+ return utimes (file, t);
+#else
+ {
+ struct utimbuf utimbuf;
+ struct utimbuf *ut;
+ if (ts)
+ {
+ utimbuf.actime = ts[0].tv_sec;
+ utimbuf.modtime = ts[1].tv_sec;
+ ut = &utimbuf;
+ }
+ else
+ ut = NULL;
+
+ return utime (file, ut);
+ }
+#endif /* !HAVE_WORKING_UTIMES */
+ }
+}
+
+/* Set the access and modification time stamps of FILE to be
+ TIMESPEC[0] and TIMESPEC[1], respectively. */
+int
+utimens (char const *file, struct timespec const timespec[2])
+{
+ return fdutimens (-1, file, timespec);
+}
+
+/* Set the access and modification time stamps of FILE to be
+ TIMESPEC[0] and TIMESPEC[1], respectively, without dereferencing
+ symlinks. Fail with ENOSYS if the platform does not support
+ changing symlink timestamps, but FILE was a symlink. */
+int
+lutimens (char const *file, struct timespec const timespec[2])
+{
+ struct timespec adjusted_timespec[2];
+ struct timespec *ts = timespec ? adjusted_timespec : NULL;
+ int adjustment_needed = 0;
+ struct stat st;
+
+ if (ts)
+ {
+ adjusted_timespec[0] = timespec[0];
+ adjusted_timespec[1] = timespec[1];
+ adjustment_needed = validate_timespec (ts);
+ }
+ if (adjustment_needed < 0)
+ return -1;
+
+ /* The Linux kernel did not support symlink timestamps until
+ utimensat, in version 2.6.22, so we don't need to mimic
+ fdutimens' worry about buggy NFS clients. But we do have to
+ worry about bogus return values. */
+
+#if HAVE_UTIMENSAT
+ if (0 <= lutimensat_works_really)
+ {
+ int result;
+# if __linux__
+ /* As recently as Linux kernel 2.6.32 (Dec 2009), several file
+ systems (xfs, ntfs-3g) have bugs with a single UTIME_OMIT,
+ but work if both times are either explicitly specified or
+ UTIME_NOW. Work around it with a preparatory lstat prior to
+ calling utimensat; fortunately, there is not much timing
+ impact due to the extra syscall even on file systems where
+ UTIME_OMIT would have worked. FIXME: Simplify this in 2012,
+ when file system bugs are no longer common. */
+ if (adjustment_needed == 2)
+ {
+ if (lstat (file, &st))
+ return -1;
+ if (ts[0].tv_nsec == UTIME_OMIT)
+ ts[0] = get_stat_atime (&st);
+ else if (ts[1].tv_nsec == UTIME_OMIT)
+ ts[1] = get_stat_mtime (&st);
+ /* Note that st is good, in case utimensat gives ENOSYS. */
+ adjustment_needed++;
+ }
+# endif /* __linux__ */
+ result = utimensat (AT_FDCWD, file, ts, AT_SYMLINK_NOFOLLOW);
+# ifdef __linux__
+ /* Work around a kernel bug:
+ http://bugzilla.redhat.com/442352
+ http://bugzilla.redhat.com/449910
+ It appears that utimensat can mistakenly return 280 rather
+ than -1 upon ENOSYS failure.
+ FIXME: remove in 2010 or whenever the offending kernels
+ are no longer in common use. */
+ if (0 < result)
+ errno = ENOSYS;
+# endif
+ if (result == 0 || errno != ENOSYS)
+ {
+ utimensat_works_really = 1;
+ lutimensat_works_really = 1;
+ return result;
+ }
+ }
+ lutimensat_works_really = -1;
+#endif /* HAVE_UTIMENSAT */
+
+ /* The platform lacks an interface to set file timestamps with
+ nanosecond resolution, so do the best we can, discarding any
+ fractional part of the timestamp. */
+
+ if (adjustment_needed || REPLACE_FUNC_STAT_FILE)
+ {
+ if (adjustment_needed != 3 && lstat (file, &st))
+ return -1;
+ if (ts && update_timespec (&st, &ts))
+ return 0;
+ }
+
+ /* On Linux, lutimes is a thin wrapper around utimensat, so there is
+ no point trying lutimes if utimensat failed with ENOSYS. */
+#if HAVE_LUTIMES && !HAVE_UTIMENSAT
+ {
+ struct timeval timeval[2];
+ struct timeval *t;
+ int result;
+ if (ts)
+ {
+ timeval[0].tv_sec = ts[0].tv_sec;
+ timeval[0].tv_usec = ts[0].tv_nsec / 1000;
+ timeval[1].tv_sec = ts[1].tv_sec;
+ timeval[1].tv_usec = ts[1].tv_nsec / 1000;
+ t = timeval;
+ }
+ else
+ t = NULL;
+
+ result = lutimes (file, t);
+ if (result == 0 || errno != ENOSYS)
+ return result;
+ }
+#endif /* HAVE_LUTIMES && !HAVE_UTIMENSAT */
+
+ /* Out of luck for symlinks, but we still handle regular files. */
+ if (!(adjustment_needed || REPLACE_FUNC_STAT_FILE) && lstat (file, &st))
+ return -1;
+ if (!S_ISLNK (st.st_mode))
+ return fdutimens (-1, file, ts);
+ errno = ENOSYS;
+ return -1;
+}
--- /dev/null
+/* 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 <http://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+#include <time.h>
+int fdutimens (int, char const *, struct timespec const [2]);
+int utimens (char const *, struct timespec const [2]);
+int lutimens (char const *, struct timespec const [2]);
+
+#if GNULIB_FDUTIMENSAT
+# include <fcntl.h>
+# include <sys/stat.h>
+
+_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. */
+_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
/* Compile-time assert-like macros.
- Copyright (C) 2005-2006, 2009-2011 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2009-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
# define _GL_VERIFY_H
-/* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert works as per the
- C1X draft N1548 section 6.7.10. This is supported by GCC 4.6.0 and
- later, in C mode, and its use here generates easier-to-read diagnostics
- when verify (R) fails.
+/* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert works as per C11.
+ This is supported by GCC 4.6.0 and later, in C mode, and its use
+ here generates easier-to-read diagnostics when verify (R) fails.
- Define _GL_HAVE_STATIC_ASSERT to 1 if static_assert works as per the
- C++0X draft N3242 section 7.(4).
+ Define _GL_HAVE_STATIC_ASSERT to 1 if static_assert works as per C++11.
This will likely be supported by future GCC versions, in C++ mode.
Use this only with GCC. If we were willing to slow 'configure'
extern int (*dummy (void)) [sizeof (struct {...})];
* GCC warns about duplicate declarations of the dummy function if
- -Wredundant_decls is used. GCC 4.3 and later have a builtin
+ -Wredundant-decls is used. GCC 4.3 and later have a builtin
__COUNTER__ macro that can let us generate unique identifiers for
each dummy function, to suppress this warning.
which do not support _Static_assert, also do not warn about the
last declaration mentioned above.
+ * GCC warns if -Wnested-externs is enabled and verify() is used
+ within a function body; but inside a function, you can always
+ arrange to use verify_expr() instead.
+
* In C++, any struct definition inside sizeof is invalid.
Use a template type to work around the problem. */
trailing ';'. If R is false, fail at compile-time, preferably
with a diagnostic that includes the string-literal DIAGNOSTIC.
- Unfortunately, unlike C1X, this implementation must appear as an
+ Unfortunately, unlike C11, this implementation must appear as an
ordinary declaration, and cannot appear inside struct { ... }. */
# ifdef _GL_HAVE__STATIC_ASSERT
# define _Static_assert(R, DIAGNOSTIC) _GL_VERIFY (R, DIAGNOSTIC)
# endif
# if !defined _GL_HAVE_STATIC_ASSERT && !defined static_assert
-# define static_assert _Static_assert /* Draft C1X requires this #define. */
+# define static_assert _Static_assert /* C11 requires this #define. */
# endif
# endif
* ido.el (ido-set-matches-1): Fix 2012-09-11 change.
-2012-09-16 Leo Liu <sdl.web@gmail.com>
+2012-09-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * type-break.el: Use lexical-binding.
+ (type-break-mode): Use define-minor-mode.
+
+ * emacs-lisp/pcase.el (pcase--mark-used): New.
+ (pcase--u1): Use it (bug#12512).
+
+ * custom.el (load-theme): Set buffer-file-name so the load is recorded
+ in load-history with the right file name.
+
+2012-09-28 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el (doc-view-current-cache-doc-pdf): New function.
+ (doc-view-doc->txt, doc-view-convert-current-doc): Use it.
+ (doc-view-get-bounding-box): Make bounding box slicing work for
+ ODF and DVI documents.
+
+2012-09-28 Glenn Morris <rgm@gnu.org>
+
+ * type-break.el (type-break-mode, type-break-interval)
+ (type-break-good-rest-interval, type-break-keystroke-threshold):
+ No need to autoload.
+ (type-break-good-rest-interval, type-break-keystroke-threshold):
+ Add :set-after.
+
+2012-09-28 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/verilog-mode.el (verilog-auto-inst-interfaced-ports):
+ Add :version tag.
+
+2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * json.el (json-encode-char): Codes 127-160 aren't "ASCII printable".
+
+2012-09-27 Glenn Morris <rgm@gnu.org>
+
+ * faces.el (x-display-name): Declare (for without-x builds).
+
+ * linum.el (linum-format): Don't autoload it. Improve :type.
+
+ * progmodes/tcl.el: Don't require outline when compiling.
+ (outline-regexp, outline-level): Declare.
+ * textmodes/sgml-mode.el: Don't require outline when compiling.
+ (outline-regexp, outline-heading-end-regexp, outline-level): Declare.
+
+ * term.el (term-ansi-reset):
+ Try setting term-ansi-face-already-done to nil. (Bug#11785)
+
+ * vc/vc.el (vc-next-action): Only gripe about committing read-only
+ files for RCS and SCCS. (Bug#9781)
+
+2012-09-27 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/verilog-mode.el (verilog-mode-release-emacs): Fix last
+ change; value should be t.
+
+2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * image-mode.el: Use lexical-binding.
+ (image-mode-winprops): Use t to stand for the window of
+ a buffer that's not displayed.
+ * doc-view.el (doc-view-new-window-function): Handle the new
+ t in winprops.
+ (doc-view-enlarge): Make it a real nop if the size is not changed.
+ (doc-view-display): Handle the case where the buffer is not (yet?)
+ displayed in any window.
+ (doc-view-saved-settings): New var.
+ (doc-view-mode): Use it.
+ (doc-view-fallback-mode): Set it.
+
+ * minibuf-eldef.el: Make it possible to replace (default ...) with [...].
+ Set lexical-binding.
+ (minibuffer-eldef-shorten-default): New var.
+ (minibuffer-default-in-prompt-regexps): Use it for new default.
+ (minibuf-eldef-setup-minibuffer): Add replacement functionality.
+
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * international/uni-bidi.el:
+ * international/uni-category.el:
+ * international/uni-name.el:
+ * international/uni-numeric.el: Regenerate.
+
+2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * profiler.el: New file.
+
+2012-09-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/testcover.el (testcover-after): Add gv-expander.
+ (testcover-reinstrument): Simplify with CSE.
+
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * window.el (temp-buffer-window-setup): Fix typo in docstring.
+
+2012-09-25 Wilson Snyder <wsnyder@wsnyder.org>
+
+ * verilog-mode.el (verilog-auto-ascii-enum, verilog-auto-inout)
+ (verilog-auto-input, verilog-auto-insert-lisp)
+ (verilog-auto-output, verilog-auto-output-every, verilog-auto-reg)
+ (verilog-auto-reg-input, verilog-auto-tieoff, verilog-auto-undef)
+ (verilog-auto-unused, verilog-auto-wire)
+ (verilog-forward-or-insert-line): Fix AUTOs with no trailing
+ newline. Reported by Andrew Jones.
+ (verilog-auto-inst) Support expanding $clog2 in AUTOINST.
+ Reported by Brad Dobbie.
+ (verilog-batch-delete-trailing-whitespace):
+ Create verilog-batch-delete-trailing-whitespace.
+ Reported by Brad Dobbie.
+ (verilog-auto-inout-param): Support AUTOINOUTPARAM for copying
+ parameters from another module. Reported by Dan Katz.
+ (verilog-auto, verilog-auto-assign-modport)
+ (verilog-auto-inout-modport): Add AUTOASSIGNMODPORT and
+ AUTOINOUTMODPORT for UVM interface module shell generation.
+ Reported by Brad Dobbie.
+ (verilog-auto-inst-interfaced-ports): Make default nil, as more
+ standard behavior.
+ (verilog-auto): Fix AUTO parameters with parenthesis arguments.
+ Reported by Matt Martin.
+
+2012-09-25 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--resize-child-windows): When resizing child
+ windows proportionally, process them in reverse order to
+ preserve the "when splitting a window the new one gets the odd
+ line" behavior.
+ (window--resize-root-window-vertically): When resizing the
+ minibuffer window try to affect only windows at the bottom of the
+ frame. (Bug#12419)
+
+2012-09-25 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (declare): Doc fix.
+
+ * help-fns.el (help-fns--obsolete): Handle macros properly.
+
+2012-09-25 Chong Yidong <cyd@gnu.org>
+
+ * bookmark.el (bookmark-jump-noselect): Use a declare form to mark
+ this function obsolete.
+
+ * calendar/cal-x.el (calendar-two-frame-setup)
+ (calendar-only-one-frame-setup, calendar-one-frame-setup):
+ * calendar/calendar.el (american-calendar, european-calendar)
+ (calendar-for-loop):
+ * comint.el (comint-dynamic-simple-complete)
+ (comint-dynamic-complete-as-filename, comint-unquote-filename):
+ * desktop.el (desktop-load-default):
+ * dired-x.el (dired-omit-here-always)
+ (dired-hack-local-variables, dired-default-directory):
+ * emacs-lisp/derived.el (derived-mode-class):
+ * emacs-lisp/timer.el (timer-set-time-with-usecs):
+ * emacs-lock.el (toggle-emacs-lock):
+ * epa.el (epa-display-verify-result):
+ * epg.el (epg-sign-keys, epg-start-sign-keys)
+ (epg-passphrase-callback-function):
+ * eshell/esh-util.el (eshell-for):
+ * eshell/eshell.el (eshell-remove-from-window-buffer-names)
+ (eshell-add-to-window-buffer-names):
+ * files.el (locate-file-completion):
+ * imenu.el (imenu-example--create-c-index)
+ (imenu-example--create-lisp-index)
+ (imenu-example--lisp-extract-index-name)
+ (imenu-example--name-and-position):
+ * international/mule-cmds.el (princ-list):
+ * international/mule-diag.el (decode-codepage-char):
+ * international/mule-util.el (detect-coding-with-priority):
+ * iswitchb.el (iswitchb-read-buffer):
+ * mail/mailalias.el (mail-complete):
+ * mail/sendmail.el (mail-sent-via):
+ * mouse.el (mouse-popup-menubar-stuff, mouse-popup-menubar)
+ (mouse-major-mode-menu):
+ * password-cache.el (password-read-and-add):
+ * pcomplete.el (pcomplete-parse-comint-arguments):
+ * progmodes/sh-script.el (sh-maybe-here-document):
+ * replace.el (query-replace-regexp-eval):
+ * savehist.el (savehist-load):
+ * simple.el (choose-completion-delete-max-match):
+ * term.el (term-dynamic-simple-complete):
+ * vc/ediff-init.el (ediff-check-version):
+ * vc/ediff-wind.el (ediff-choose-window-setup-function-automatically):
+ * vc/vc.el (vc-diff-switches-list):
+ * view.el (view-return-to-alist-update): Likewise.
+
+ * subr.el (eval-next-after-load, makehash, insert-string)
+ (assoc-ignore-representation, assoc-ignore-case): Use declare to
+ mark obsolete.
+ (mode-line-inverse-video): Variable deleted.
+
+ * international/mule-util.el (string-to-sequence): Remove.
+
+ * calendar/calendar.el (calendar-version):
+ * calendar/icalendar.el (icalendar-extract-ical-from-buffer)
+ (icalendar-convert-diary-to-ical):
+ * cus-edit.el (custom-mode):
+ * ansi-color.el (ansi-color-unfontify-region):
+ * international/latin1-disp.el (latin1-char-displayable-p):
+ * progmodes/cwarn.el (turn-on-cwarn-mode):
+ * progmodes/which-func.el (which-func-update-1):
+ Use define-obsolete-function-alias.
+
+ * net/newst-backend.el (newsticker-cache-filename):
+ * net/newst-treeview.el (newsticker-groups-filename):
+ Fix incorrect obsolescence declaration.
+
+ * allout.el (allout-passphrase-hint-string): Likewise.
+ (allout-init): Use a declare form to mark obsolete.
+
+ * emacs-lisp/byte-run.el (make-obsolete): Doc fix; emphasize that
+ this applies to functions.
+
+ * iswitchb.el (iswitchb-read-buffer): Move code of
+ iswitchb-define-mode-map here, and delete that obsolete function.
+
+ * net/snmp-mode.el (snmp-font-lock-keywords-3): Don't use obsolete
+ font-lock-reference-face.
+
+2012-09-25 Glenn Morris <rgm@gnu.org>
+
+ * buff-menu.el (Buffer-menu-name-width, Buffer-menu-size-width):
+ Doc fixes.
+
+ * eshell/em-term.el (eshell-term-name):
+ Default to term-term-name. (Bug#12485)
+
+2012-09-24 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-shell-send-buffer): Better handling
+ of "if __name__ == '__main__':" conditionals when sending the buffer.
+
+2012-09-24 Glenn Morris <rgm@gnu.org>
+
+ * eshell/esh-cmd.el (eshell-find-alias-function):
+ Tighten up file-name regexp. (Bug#12499)
+
+2012-09-24 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Enhancements for triple-quote string syntax.
+ * progmodes/python.el (python-quote-syntax): Remove.
+ (python-syntax-propertize-function): New value.
+ (python-syntax-count-quotes, python-syntax-stringify):
+ New functions.
+
+2012-09-24 Chong Yidong <cyd@gnu.org>
+
+ * mail/supercite.el (sc-version): Remove obsolete function.
+ (sc-describe): Don't mark as obsolete, since it is bound.
+ (sc-submit-bug-report): Remove.
+
+ * vc/log-edit.el (cvs-changelog-full-paragraphs)
+ (cvs-commit-buffer-require-final-newline): Remove.
+ (log-edit-require-final-newline)
+ (log-edit-changelog-full-paragraphs): Default to t.
+
+ * vc/pcvs-defs.el (cvs-diff-buffer-name, cvs-diff-ignore-marks)
+ * vc/vc-hooks.el (vc-ignore-vc-files, vc-master-templates)
+ * vc/vc.el (vc-checkout-carefully): Likewise.
+
+ * vc/emerge.el (emerge-mode): Make it an obsolete alias.
+ (emerge-version): Remove.
+
+ * progmodes/compile.el (compile-internal): Remove.
+ (compilation-parse-errors-function): Fix typo.
+
+ * international/mule.el (set-char-table-default): Remove.
+ (set-coding-priority, make-coding-system, generic-char-p)
+ (charset-list, charset-bytes, charset-id): Use declare to mark
+ functions as obsolete.
+
+ * vc/pcvs-defs.el (cvs-buffer-name-alist)
+ (cvs-invert-ignore-marks): Remove references to obsolete vars.
+ * vc/vc-hooks.el (vc-default-registered): Don't use
+ vc-master-templates.
+
+ * font-lock.el (font-lock-reference-face):
+ Use define-obsolete-variable-alias.
+
+ * generic-x.el (rul-generic-mode): Use font-lock-constant-face.
+ * calendar/calendar.el (calendar-font-lock-keywords):
+ * calendar/diary-lib.el (diary-font-lock-keywords)
+ (diary-fancy-font-lock-keywords):
+ * textmodes/reftex-sel.el (reftex-insert-docstruct):
+ * textmodes/reftex-index.el (reftex-insert-index):
+ * textmodes/reftex-cite.el (reftex-format-bib-entry):
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ * progmodes/ps-mode.el (ps-mode-font-lock-keywords-1):
+ * progmodes/prolog.el (prolog-font-lock-keywords):
+ * progmodes/idlwave.el (idlwave-idl-keywords):
+ * progmodes/ada-mode.el (ada-font-lock-keywords):
+ * net/snmp-mode.el (snmp-font-lock-keywords-3): Likewise.
+
+2012-09-24 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug): Include `lsb_release -d'.
+
+2012-09-23 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-indent-line): More consistent cursor
+ movement behavior.
+
+2012-09-23 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Fix compiler warning.
+
+2012-09-23 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-autokey-transcriptions):
+ Transcribe also LaTeX hyphenation.
+ (bibtex-reformat): Bug fix. Do not quote twice the elements of
+ bibtex-reformat-previous-options.
+
+2012-09-23 Roland Winkler <winkler@gnu.org>
+
+ * proced.el (proced-renice-command): New variable.
+ (proced-marked-processes): New function.
+ (proced-with-processes-buffer): New macro.
+ (proced-send-signal): Use them.
+ (proced-renice): New command bound to r.
+
+2012-09-23 Roland Winkler <winkler@gnu.org>
+
+ * ibuf-ext.el (ibuffer-switch-to-saved-filter-groups): If list
+ ibuffer-saved-filter-groups has one element, shortcut the call of
+ completing-read. (Bug#12331)
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el (mode-line-toggle-read-only):
+ * bs.el (bs-toggle-readonly):
+ * buff-menu.el (Buffer-menu-toggle-read-only):
+ * dired.el (dired-toggle-read-only):
+ * ibuffer.el (ibuffer-do-toggle-read-only): Use read-only-mode.
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * image.el (image-type-available-p): Adapt to init-image-library
+ argument changes.
+
+2012-09-22 Juri Linkov <juri@jurta.org>
+
+ * dired.el (dired-mode-map): Add [remap read-only-mode] for
+ `dired-toggle-read-only'. (Bug#12462)
+
+2012-09-22 Martin Rudalics <rudalics@gmx.at>
+
+ * subr.el (temp-output-buffer-show): New function.
+ (with-output-to-temp-buffer): Call temp-output-buffer-show
+ instead of internal-temp-output-buffer-show.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * files.el (ctl-x-map): Bind C-x C-q to read-only-mode
+ (Bug#12462).
+
+ * repeat.el (repeat): Doc fix (Bug#12348).
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix
+ (Bug#10909).
+
+ * simple.el (shell-command-on-region): Doc fix.
+ (read-only-mode): Doc fix.
+
+2012-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs-lisp/timer.el (run-with-idle-timer)
+ (timer-activate-when-idle): Warn against reinvoking an idle timer
+ from within its own timer action. (Bug#12447)
+
+2012-09-22 Martin Rudalics <rudalics@gmx.at>
+
+ * cus-start.el (window-combination-limit): Add new optional
+ values.
+ * window.el (temp-buffer-window-show)
+ (window--try-to-split-window): Handle new values of
+ window-combination-limit (Bug#1806).
+ (split-window): Test window-combination-limit for t instead of
+ non-nil.
+ (display-buffer-at-bottom): New buffer display action function.
+ * help.el (temp-buffer-resize-regexps): New option.
+ (temp-buffer-resize-mode): Rewrite doc-string.
+ (resize-temp-buffer-window): Obey temp-buffer-resize-regexps.
+ Don't resize reused window. Suggested by Glenn Morris.
+
+2012-09-22 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Revamp section title faces.
+ (rst-official-version)
+ (rst-package-emacs-version-alist): Sync with official version
+ V1.4.0.
+ (rst-faces-defaults, rst-set-level-default)
+ (rst-level-face-max, rst-level-face-base-color)
+ (rst-level-face-base-light, rst-level-face-format-light)
+ (rst-level-face-step-light, rst-define-level-faces): Obsolete.
+ (rst-adornment-faces-alist): Match new setup.
+ (rst-level-1, rst-level-2, rst-level-3, rst-level-4)
+ (rst-level-5, rst-level-6): New faces.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (undo): Handle indirect buffers (Bug#8207).
+
+2012-09-21 Leo Liu <sdl.web@gmail.com>
IDO: Disable match re-ordering for buffer switching.
* ido.el (ido-buffer-disable-smart-matches): New variable.
(ido-set-matches-1): Use it. (Bug#2042)
-2012-09-12 Jose Marino <marinoj@nso.edu> (tiny change)
+2012-09-21 Jose Marino <marinoj@nso.edu> (tiny change)
* progmodes/idlw-shell.el (idlwave-shell-complete-filename):
Fix 2011-05-17 change. (Bug#12418)
-2012-09-11 Leo Liu <sdl.web@gmail.com>
+2012-09-21 Leo Liu <sdl.web@gmail.com>
* subr.el (ignore-errors): Mention with-demoted-errors in doc-string.
-2012-09-11 Glenn Morris <rgm@gnu.org>
+2012-09-21 Glenn Morris <rgm@gnu.org>
* emacs-lisp/shadow.el (load-path-shadows-font-lock-keywords):
Be more robust about locating simple.el.
-2012-09-10 Glenn Morris <rgm@gnu.org>
+2012-09-21 Glenn Morris <rgm@gnu.org>
* mail/emacsbug.el (report-emacs-bug): Trap load-path-shadows errors.
+2012-09-21 Joel Bion <jpbion@westvi.com> (tiny change)
+
+ * pcmpl-gnu.el (pcmpl-gnu-tarfile-regexp): Add tar.xz. (Bug#12382)
+
+2012-09-20 Juri Linkov <juri@jurta.org>
+
+ * replace.el (query-replace-read-from): Use `read-regexp' instead
+ of `read-from-minibuffer' when `regexp-flag' is non-nil.
+ (occur-read-primary-args): Use `read-regexp' instead of
+ `read-string'.
+ (multi-occur-in-matching-buffers): Use `read-regexp' instead of
+ `read-from-minibuffer'.
+ * isearch.el (isearch-occur): Use `read-regexp' instead of
+ `read-string'.
+ * dired.el (dired-read-regexp): Use `read-regexp' instead of
+ `read-from-minibuffer'.
+ * progmodes/grep.el (grep-read-regexp): Use `read-regexp' instead
+ of `read-string'. (Bug#7567)
+
+ * replace.el (read-regexp): Rename DEFAULT-VALUE arg to DEFAULTS
+ and allow accepting a list of strings prepended to a list of
+ standard default values. Doc fix. (Bug#12321)
+
+ * replace.el (read-regexp): Add HISTORY arg. (Bug#7567)
+
+ * replace.el (read-regexp): Don't add ": " when PROMPT already
+ ends with a colon and space. (Bug#12321)
+
+2012-09-20 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el (doc-view-display): Better fix for the cl-assertion
+ error.
+
+2012-09-20 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Integrate support for `imenu' and `which-function'.
+ Fixes feature request bug#11711.
+ (rst-mode): Create `imenu-create-index-function'.
+ (rst-get-stripped-line): Delete after refactoring.
+ (rst-section-tree, rst-section-tree-rec)
+ (rst-section-tree-point): Refactor and document properly.
+ (rst-imenu-find-adornments-for-position)
+ (rst-imenu-convert-cell, rst-imenu-create-index):
+ New function.
+
+2012-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp--obsolete-warning): New function.
+ (macroexp--expand-all): Use it.
+ (macroexp--funcall-and-return): Remove by folding it into its sole
+ caller (macroexp--warn-and-return).
+ * emacs-lisp/bytecomp.el (byte-compile-warn-obsolete):
+ Use macroexp--obsolete-warning.
+
+ * calc/calc.el: Fix last change by removing the whole chunk, since it
+ was only needed back when Calc was not bundled.
+
+2012-09-20 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debug): Restore assignment to
+ debugger-old-buffer removed on 2012-09-08.
+
+2012-09-20 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-diff): Remove (require 'diff) since
+ `diff-latest-backup-file' is now autoloaded.
+
+2012-09-20 Chong Yidong <cyd@gnu.org>
+
+ * vc/diff.el (diff-latest-backup-file): Autoload.
+
+2012-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * calc/calc.el: Remove redundant autoload shape check.
+ (sel-mode): Don't defvar.
+ (calc-get-stack-element): Add `sel-mode' arg instead.
+ (calc-top, calc-top-list): Pass it this additional argument.
+ * calc/calc-store.el (calc-store-map):
+ * calc/calc-map.el (calc-apply, calc-reduce, calc-map)
+ (calc-map-equation, calc-outer-product, calc-inner-product):
+ * calc/calc-aent.el (calc-alg-entry): Don't bind sel-mode.
+
+ * emacs-lisp/macroexp.el (macroexp--expand-all): Fix last change.
+
+2012-09-19 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-diff): Add (require 'diff) because
+ `diff-latest-backup-file' is not autoloaded.
+ (dired-do-chxxx, dired-do-chmod): Set `no-error-if-not-filep' arg
+ of `dired-get-filename' to t to not report error when there is
+ no default file on the current line.
+
+2012-09-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp--funcall-if-compiled): Rename from
+ macroexp--eval-if-compile.
+ (macroexp--funcall-and-return, macroexp--warn-and-return): New funs.
+ (macroexp--expand-all): Use them (bug#12371).
+
+ * doc-view.el (doc-view-guess-paper-size)
+ (doc-view-scale-bounding-box): Fix unbound `caddr'.
+
+2012-09-19 Tassilo Horn <tsdh@gnu.org>
+
+ New feature: set optimal slice from BoundingBox information.
+ * doc-view.el (doc-view-mode-map): Add keybinding.
+ (doc-view-menu): Add menu entry.
+ (doc-view-set-slice): Adapt docstring.
+ (doc-view-get-bounding-box, doc-view-guess-paper-size)
+ (doc-view-scale-bounding-box)
+ (doc-view-set-slice-from-bounding-box): New functions.
+ (doc-view-paper-sizes): New defvar.
+
+2012-09-19 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/macroexp.el (byte-compile-warn-obsolete)
+ (byte-compile-log-warning): Autoload. (Bug#12371)
+
+ * calendar/calendar.el (calendar-american-month-header)
+ (calendar-european-month-header, calendar-iso-month-header)
+ (calendar-month-header): New options.
+ (calendar-set-date-style): Set calendar-month-header. Redraw calendar.
+ (calendar-generate-month): Use calendar-month-header. (Bug#9510)
+
+2012-09-19 Jan Djärv <jan.h.d@swipnet.se>
+
+ * startup.el (command-line-ns-option-alist): Add -g and --geometry.
+
+2012-09-18 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-diff): Restore original functionality of
+ getting the default value, but keep new feature of using the
+ latest existing backup file (`diff-latest-backup-file').
+
+2012-09-18 Juri Linkov <juri@jurta.org>
+
+ * dired.el (dired-mark): If the region is active in Transient Mark
+ mode, mark all files in the active region. Doc fix.
+ (dired-unmark, dired-flag-file-deletion, dired-unmark-backward):
+ Doc fix. (Bug#10624)
+
+2012-09-18 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-do-chxxx, dired-do-chmod): Default file
+ attributes for M-n are pulled from the file at point.
+ (dired-do-chgrp, dired-do-chown, dired-do-touch): Doc fix.
+ Suggested by Drew Adams. (Bug#10624)
+
+2012-09-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-brace-to-do-end): Don't add extra
+ whitespace after "end".
+ (ruby-do-end-to-brace): Collapse block to one line if it fits
+ within fill-column.
+
+2012-09-18 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debugger-bury-or-kill): Fix customization
+ value.
+ (debug): Don't remove debugger window when debugger is expected
+ to be back.
+
+2012-09-18 Chong Yidong <cyd@gnu.org>
+
+ * custom.el (defface): Doc fix.
+
+ * cus-edit.el (custom-unlispify-remove-prefixes): Add warning.
+
+2012-09-18 Martin Blais <blais@furius.ca> (tiny change)
+
+ * progmodes/compile.el (compilation-start): Use compilation-always-kill
+ to initialize query-on-exit; then test that instead (bug#12288).
+
+2012-09-17 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Add support for `testcover'.
+ (rst-defcustom-testcover, rst-testcover-add-compose)
+ (rst-testcover-add-1value): New functions.
+ (rst-portable-mark-active-p): Replace by `use-region-p'.
+ (rst-update-section, rst-classify-adornment)
+ (rst-find-title-line): Mark `1value' forms.
+ (rst-classify-adornment): Remove superfluous form.
+ (rst-update-section, rst-get-adornments-around)
+ (rst-adornment-complete-p, rst-get-next-adornment)
+ (rst-adjust, rst-promote-region)
+ (rst-display-adornments-hierarchy, rst-straighten-adornments)
+ (rst-find-pfx-in-region, rst-section-tree-rec)
+ (rst-section-tree-point, rst-toc-insert, rst-toc-insert-node)
+ (rst-toc-node, rst-toc, rst-forward-section)
+ (rst-iterate-leftmost-paragraphs)
+ (rst-iterate-leftmost-paragraphs-2, rst-enumerate-region)
+ (rst-bullet-list-region)
+ (rst-convert-bullets-to-enumeration, rst-font-lock-keywords)
+ (rst-compile-find-conf, rst-compile)
+ (rst-repeat-last-character): Fix style.
+
+2012-09-17 Chong Yidong <cyd@gnu.org>
+
+ * comint.el (comint--complete-file-name-data): Don't add a space
+ if the status is `sole'; that adds a gratuitous space in the
+ completion-cycling case (Bug#12092).
+
+ * pcomplete.el (pcomplete-completions-at-point): Likewise.
+
+2012-09-17 Richard Stallman <rms@gnu.org>
+
+ * mail/rmailmm.el (rmail-mime-toggle-raw): Do rmail-mime-insert
+ only in the mime-shown mode, not in raw mode.
+ (rmail-mime): Toggle off mime by displaying the message without
+ mime processing. (Bug#12305)
+
+ * mail/rmail.el (rmail-retry-failure):
+ Turn off mime processing first. (Bug#12037)
+
+ * epa-mail.el (epa-mail-encrypt): Fix bug when a name has no key.
+
+2012-09-17 Chong Yidong <cyd@gnu.org>
+
+ * shell.el (shell-file-name-chars, shell-file-name-quote-list)
+ (shell-dynamic-complete-functions): Convert to defcustom.
+ (shell-prompt-pattern, shell-completion-fignore): Doc fix.
+
+ * bookmark.el (bookmark-bmenu-toggle-filenames): Doc fixes.
+ * comint.el (comint-prompt-read-only):
+ * custom.el (defcustom):
+ * hi-lock.el (hi-lock-mode):
+ * ibuffer.el (ibuffer-formats):
+ * ielm.el (ielm-prompt-read-only):
+ * novice.el (disable-command):
+ * saveplace.el (toggle-save-place):
+ * speedbar.el (speedbar-supported-extension-expressions):
+ * startup.el (auto-save-list-file-prefix, init-file-user)
+ (after-init-hook, inhibit-startup-echo-area-message):
+ * strokes.el (strokes-help):
+ * time-stamp.el (time-stamp):
+ * calendar/calendar.el (calendar, diary-file):
+ * calendar/diary-lib.el (diary-mail-entries, diary)
+ (diary-list-entries-hook):
+ * calendar/holidays.el (holidays, calendar-holidays):
+ * calendar/lunar.el (lunar-phases):
+ * calendar/solar.el (sunrise-sunset):
+ * emulation/edt.el (edt-load-keys):
+ * emulation/viper.el (viper-mode):
+ * eshell/em-alias.el (eshell-command-aliases-list):
+ * eshell/esh-util.el (eshell-convert-numeric-arguments):
+ * international/ogonek.el (ogonek-information):
+ * net/tramp-cmds.el (tramp-bug):
+ * net/quickurl.el (quickurl-reread-hook-postfix):
+ * play/decipher.el (decipher-font-lock-keywords):
+ * progmodes/cc-styles.el (c-set-style):
+ * progmodes/idlw-shell.el (idlwave-shell-prompt-pattern):
+ * progmodes/inf-lisp.el (inferior-lisp-prompt):
+ * progmodes/octave-mod.el (octave-mode):
+ * progmodes/sql.el (sql-mode, sql-interactive-mode, sql-password):
+ * progmodes/verilog-mode.el (verilog-read-defines):
+ * textmodes/two-column.el (2C-mode): Likewise.
+
+2012-09-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mail/mailabbrev.el (mail-abbrev-expand-hook): Work for a mail aliasee
+ that holds many addresses.
+
+2012-09-16 Chong Yidong <cyd@gnu.org>
+
+ * align.el (align-areas): Call the indication function with
+ positions instead of markers for arguments (Bug#12343).
+
+ * files.el (parse-colon-path): Use split-string (Bug#12351).
+
+ * window.el (special-display-popup-frame): Doc fix (Bug#8853).
+ (display-buffer-function): Mark as obsolete.
+
+ * progmodes/compile.el (compilation-parse-errors): Accept list
+ values similar to font-lock-keywords (Bug#12136).
+ Suggested by Oleksandr Manzyuk.
+ (compilation-error-regexp-alist): Doc fix.
+
+2012-09-15 Glenn Morris <rgm@gnu.org>
+
+ * version.el (emacs-bzr-version-bzr): New function.
+ (emacs-bzr-get-version): Add optional EXTERNAL argument.
+
+ * vc/vc-bzr.el (vc-bzr-working-revision): For lightweight local
+ checkouts, check the parent dirstate matches the branch.
+ Add "--tree" to "bzr revno" arguments. Don't try to shorten the
+ empty string.
+
+ * version.el (emacs-bzr-version): Doc fix.
+ (emacs-bzr-version-dirstate): New function.
+ (emacs-bzr-get-version): For lightweight checkouts, if the parent
+ is local try and check that it matches the branch. If not, just
+ use dirstate information. (Bug#12441)
+
+2012-09-14 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-do-chmod): Use `eq' to detect empty input.
+ (Bug#12399)
+
+2012-09-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/advice.el (ad-prognify): Remove, use macroexp-progn.
+
+ * emacs-lisp/edebug.el: Miscellaneous cleanup.
+ Remove obsolete byte-compiler hack that tried to silence some warnings.
+ (edebug-submit-bug-report): Remove.
+ (edebug-get-buffer-window, edebug-sit-for, edebug-input-pending-p):
+ Remove aliases, use the un-prefixed name instead.
+ (edebug-pop-to-buffer): Consider other frames.
+ (edebug-original-read):: Make it more obvious that it's always defined.
+ (edebug--make-form-data-entry, edebug--form-data-name)
+ (edebug--form-data-begin, edebug--form-data-end): Rename from the
+ single-dashed name, and implement with cl-defstruct.
+ (edebug-set-form-data-entry): Use the standard accessors.
+ (edebug-make-top-form-data-entry): Use push.
+ (edebug-no-match): Drop useless `funcall'.
+ (mapcar, mapconcat, mapatoms, apply, funcall): Don't add debug specs
+ to functions.
+ (defsubst, dont-compile, eval-when-compile, eval-and-compile)
+ (delay-mode-hooks, with-temp-file, with-temp-message, ad-dolist)
+ (with-syntax-table, push, pop, 1value, noreturn, defadvice)
+ (easy-menu-define, with-custom-print): Remove redundant specs.
+ (edebug-outside-overriding-local-map)
+ (edebug-outside-overriding-terminal-local-map): Remove, unused.
+ (edebug--display): Bind unread-command-events directly to nil rather
+ than binding it to unread-command-events and later setting it to nil.
+ (edebug--display): Kill edebug-eval-buffer here...
+ (edebug--recursive-edit): ...rather than here.
+ Bind standard-output and standard-input.
+ (edebug-eval): Check cl-macroexpand-all is fboundp.
+ (edebug-temp-display-freq-count): Fix last change.
+
+ * emacs-lisp/easymenu.el (easy-menu-define): Add `debug' spec.
+ * subr.el (noreturn, 1value): Add `debug' spec.
+ * emacs-lisp/advice.el: Require cl-lib.
+ (ad-copy-tree): Remove, use copy-tree instead.
+ (ad-dolist): Remove use dolist or cl-dolist instead.
+ (ad-do-return): Remove, use cl-return instead.
+ (defadvice): Add `debug' spec.
+
+2012-09-13 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-do-chxxx): Use `eq' to detect empty input.
+ (Bug#12399)
+
+2012-09-13 Glenn Morris <rgm@gnu.org>
+
+ * calc/calc.el (math-compose-expr):
+ * calc/calc-ext.el (math-compose-expr):
+ * progmodes/cc-defs.el (cl-macroexpand-all):
+ * progmodes/cc-langs.el (delete-duplicates, mapcan)
+ (cl-macroexpand-all): Update declarations.
+
+ * vc/vc.el: No need to require ediff.
+ (ediff-load-version-control): Declare.
+ (ediff-vc-internal): Fix declaration.
+ (vc-version-ediff): Require ediff.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use a more backwards-compatible timer format (Bug#12430).
+ * emacs-lisp/timer.el (timer): PSECS is now at the end, rather than
+ being right after USECS, as that better supports old code that
+ inadvisedly looked directly at the timer vector.
+
+2012-09-13 Kenichi Handa <handa@gnu.org>
+
+ * language/chinese.el ("Chinese-GB", "Chinese-BIG5")
+ ("Chinese-CNS", "Chinese-EUC-TW"): Add chinese-gbk to
+ `coding-priority' property of these language environment.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix glitches caused by addition of psec to timers (Bug#12430).
+ * image.el (image-animate-timer):
+ * time.el (display-time-world-timer):
+ Use timer--function and timer--args rather than raw access to
+ timer vector.
+
+2012-09-13 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-warning-prefix):
+ If not compiling a file, try using load-file-name.
+
+2012-09-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug-outside-unread-command-events):
+ Fix last change.
+ (edebug-update-eval-list): Use `push'.
+
+ * emacs-lisp/edebug.el: Use lexical-binding.
+ Remove the "edebug-" prefix from non-dynamically-scoped variables.
+ Mark unused args with underscore.
+ (edebug-save-restriction, edebug-outside-excursion): Use `declare'.
+ (edebug-form-data): Use defvar-local.
+ (edebug-make-before-and-after-form, edebug-make-after-form):
+ Use backquote.
+ (edebug-args, edebug-value, edebug-after-index, edebug-arg-mode):
+ Not dynamically scoped any more.
+ (edebug--enter-trace): Add arguments `function' and `args'.
+ Rename from edebug-enter-trace.
+ (edebug-enter): Call it accordingly. Bind edebug-function explicitly.
+ (edebug--update-coverage): Add `after-index' and `value' args.
+ Rename from edebug-update-coverage.
+ (edebug-slow-after): Call it accordingly.
+ (edebug--recursive-edit): Add arg `arg-mode'. Rename from
+ edebug-recursive-edit.
+ (edebug--display): Call it accordingly. Add args `value',
+ `offset-index', and `arg-mode'. Rename from edebug-display.
+ (edebug-debugger, edebug): Call it accordingly.
+ (edebug-eval-display-list): Use dolist.
+
+2012-09-12 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-search): Don't check for isearch-mode and
+ isearch-regexp before let-binding search-spaces-regexp to
+ Info-search-whitespace-regexp.
+ (Info-isearch-search): Let-bind Info-search-whitespace-regexp to
+ search-whitespace-regexp if isearch-lax-whitespace or
+ isearch-regexp-lax-whitespace is non-nil.
+ (Info-mode): Don't set local variable search-whitespace-regexp.
+ http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00811.html
+
+2012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/debug.el (debugger-outer-unread-command-char, debug)
+ (debugger-env-macro): Remove support for unread-command-char.
+
+ * subr.el (set-temporary-overlay-map): Minimize slightly the impact of
+ the temporary map re-appearing on emulation-mode-map-alists.
+
+ * emacs-lisp/edebug.el (def-edebug-form-spec): Remove, it's been broken
+ since 22.1.
+
+ * ehelp.el (with-electric-help): Accept functions in
+ electric-help-form-to-execute.
+ (electric-help-execute-extended, electric-help-ctrl-x-prefix): Use it.
+ And replace unread-command-char -> unread-command-events.
+
+2012-09-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6.
+
+ * net/tramp.el (tramp-accept-process-output): Don't use
+ JUST-THIS-ONE in the XEmacs case.
+
+ * net/trampver.el: Update release number.
+
+2012-09-12 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debugger-previous-window-height):
+ New variable.
+ (debug): When debugger-jumping-flag is non-nil try to restore
+ height of debugger window. (Bug#8789)
+
+2012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug-enter): Don't mess with
+ overriding-local-map and pre/post-command-hook here.
+ (edebug-recursive-edit): Do it here instead (bug#12345).
+ (edebug-outside-unread-command-char): Remove all uses of
+ unread-command-char.
+
+ * emacs-lisp/debug.el (debug): Don't bind debug-on-error since
+ inhibit-debugger is bound instead.
+
+2012-09-11 Bastien Guerry <bzg@gnu.org>
+
+ * subr.el (set-temporary-overlay-map): Add a docstring.
+ (Bug#12346)
+
+2012-09-11 Bastien Guerry <bzg@gnu.org>
+
+ * minibuffer.el (completion-table-subvert): Fix docstring.
+ (Bug#12347)
+
+2012-09-11 Bastien Guerry <bzg@gnu.org>
+
+ * help-fns.el (describe-variable): Fix typo. (Bug#12346)
+
+2012-09-10 Michael R. Mauger <mmaug@yahoo.com>
+
+ * progmodes/sql.el: Version 3.1
+ (sql-db2-escape-newlines): New variable.
+ (sql-escape-newlines-filter): Use it.
+
+2012-09-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * custom.el (custom-theme-load-confirm): Remove unneeded assignment.
+
+2012-09-10 Dan Nicolaescu <dann@gnu.org>
+
+ * vc/diff-mode.el (diff-mode-menu):
+ Bind diff-remove-trailing-whitespace.
+
+2012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp-mode.el (emacs-list-byte-code-comment-re): New var.
+ (emacs-lisp-byte-code-comment, emacs-lisp-byte-code-syntax-propertize)
+ (emacs-lisp-byte-code-mode): New functions.
+ (eval-sexp-add-defvars): Don't skip defvars in column >0.
+ (eval-defun-2): Remove bogus interactive spec.
+ (lisp-indent-line): Remove redundant whole-exp code, now done in
+ indent-according-to-mode.
+ (save-match-data): Remove redundant indent data.
+
+ * emacs-lisp/benchmark.el (benchmark-run, benchmark-run-compiled):
+ Use `declare'.
+
+2012-09-09 Juri Linkov <juri@jurta.org>
+
+ * replace.el (replace-regexp-lax-whitespace): New defcustom.
+ (replace-lax-whitespace, query-replace-regexp)
+ (query-replace-regexp-eval, replace-regexp): Doc fix.
+ (perform-replace, replace-highlight): Let-bind
+ isearch-lax-whitespace to replace-lax-whitespace and
+ isearch-regexp-lax-whitespace to replace-regexp-lax-whitespace.
+
+ * isearch.el (isearch-query-replace): Let-bind
+ replace-lax-whitespace to isearch-lax-whitespace and
+ replace-regexp-lax-whitespace to
+ isearch-regexp-lax-whitespace. (Bug#10885)
+
+2012-09-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell/em-unix.el (eshell/sudo): Explicitly drop return value.
+
+2012-09-09 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-engine.el (c-state-cache-init):
+ Initialise c-state-semi-nonlit-pos-cache\(-limit\)? properly.
+ (c-record-parse-state-state):
+ Record c-state-semi-nonlit-pos-cache\(-limit\)?.
+
+2012-09-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * register.el (register-separator): Rename from
+ separator-register. All uses changed. Doc fix.
+ (register): Fix version.
+
+2012-09-09 Chong Yidong <cyd@gnu.org>
+
+ * replace.el (query-replace-map): Bind four new symbols for
+ requesting window scrolling.
+
+ * subr.el (y-or-n-p): Handle the window-scrolling bindings in
+ query-replace-map (Bug#8948).
+
+ * custom.el (custom-theme-load-confirm): Use y-or-n-p.
+
+ * emacs-lisp/map-ynp.el (map-y-or-n-p): Don't bind scrolling keys
+ since they are now in query-replace-map.
+
+ * window.el (scroll-other-window-down): Make the arg optional.
+
+2012-09-09 Chong Yidong <cyd@gnu.org>
+
+ * files.el (hack-local-variables-confirm): Use quit-window to kill
+ the *Local Variables* buffer.
+
+2012-09-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-toggle-block): Guess the current block,
+ not just expect to be at its beginning. Adjust callees.
+ Succeed when do-end block has no space before the pipe character.
+ (ruby-brace-to-do-end): When the original block is one-liner,
+ convert to multiline. Reindent the result.
+
+2012-09-08 Jambunathan K <kjambunathan@gmail.com>
+
+ * register.el (register): New group.
+ (register-separator): New user option.
+ (increment-register): Route it to `append-to-register', if
+ register contains text. Implication is that `C-x r +' can now be
+ used for appending to a text register (bug#12217).
+ (append-to-register, prepend-to-register): Add separator based on
+ `register-separator.
+
2012-09-08 Alan Mackenzie <acm@muc.de>
AWK Mode: make auto-newline work when there's "==" in the pattern.
* progmodes/cc-cmds.el (c-point-syntax): Handle virtual semicolons
correctly.
- * progmodes/cc-engine.el (c-guess-basic-syntax CASE 5A.3): Test
- more rigorously for "=" token.
+ * progmodes/cc-engine.el (c-guess-basic-syntax CASE 5A.3):
+ Test more rigorously for "=" token.
-2012-09-08 Joel Bion <jpbion@westvi.com> (tiny change)
+2012-09-08 Dmitry Gutov <dgutov@yandex.ru>
- * pcmpl-gnu.el (pcmpl-gnu-tarfile-regexp): Add tar.xz. (Bug#12382)
+ * progmodes/ruby-mode.el (ruby-match-expression-expansion):
+ Only fail when reached LIMIT.
-2012-08-31 Glenn Morris <rgm@gnu.org>
+2012-09-08 Chong Yidong <cyd@gnu.org>
- * emulation/cua-rect.el (cua--init-rectangles):
- * textmodes/picture.el (picture-mode-map):
- * play/blackbox.el (blackbox-mode-map): Remap right-char and left-char
- like forward-char and backward-char. (Bug#12317)
+ * dired.el (dired-mode-map): Don't bind M-=.
-2012-08-30 Leo Liu <sdl.web@gmail.com>
+ * dired-aux.el (dired-diff): Use backup file as default.
- * progmodes/flymake.el (flymake-warning-re): New variable.
- (flymake-parse-line): Use it.
+2012-09-08 Drew Adams <drew.adams@oracle.com>
-2012-08-30 Glenn Morris <rgm@gnu.org>
+ * subr.el (add-to-history): Fix delete usage (Bug#12314).
- * calendar/holidays.el (holiday-christian-holidays):
- Rename an entry. (Bug#12289)
+2012-09-08 Chong Yidong <cyd@gnu.org>
-2012-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
+ * subr.el (syntax-after, syntax-class): Doc fix.
- * progmodes/sh-script.el (sh-font-lock-paren): Don't burp at BOB
- (bug#12222).
+2012-09-08 Martin Rudalics <rudalics@gmx.at>
-2012-08-27 Leo Liu <sdl.web@gmail.com>
+ * window.el (display-buffer-in-previous-window): New buffer
+ display action function.
- * progmodes/sh-script.el (sh-dynamic-complete-functions): Adapt to
- completion-at-point. (Bug#12220)
+ * emacs-lisp/debug.el (debugger-bury-or-kill): New option.
+ (debugger-previous-window): New variable.
+ (debug): Rewrite using display-buffer-in-previous-window,
+ quit-restore-window and debugger-bury-or-kill. (Bug#8789)
- * skeleton.el (skeleton-untabify): Change to nil (bug#12223).
+2012-09-07 Stefan Monnier <monnier@iro.umontreal.ca>
- * progmodes/sh-script.el (sh-indent-comment): Change to t (bug#12267).
+ * emacs-lisp/byte-run.el (defun): Tweak message. Simplify code.
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-07 Matt McClure <mlm@aya.yale.edu> (tiny change)
- * Version 24.2 released.
+ * progmodes/python.el (python-shell-send-string):
+ When default-directory is remote, create temp file on remote
+ filesystem.
+ (python-shell-send-file): When file is remote, pass local view of
+ file paths to remote Python interpreter. (Bug#12340)
-2012-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-09-07 Chong Yidong <cyd@gnu.org>
- * files.el (safe-local-eval-forms): Fix before-save-hook entry to
- be buffer-local; add delete-trailing-whitespace (bug#12259).
+ * window.el (switch-to-buffer): Doc fix (Bug#12181).
-2012-08-22 Jeremy Moore <jmoore@ieee.org> (tiny change)
+ * files.el (after-find-file): Don't fail on a read-only buffer if
+ require-final-newline is `visit' or `visit-save' (Bug#11156).
- * progmodes/hideif.el (hif-compress-define-list):
- Fix typo. (Bug#11951)
+ * subr.el (read-char-choice): Allow quitting via ESC ESC.
-2012-08-20 Dan Nicolaescu <dann@gnu.org>
+ * userlock.el (ask-user-about-supersession-threat):
+ Use read-char-choice (Bug#12093).
- * progmodes/hideshow.el (hs-block-end-regexp): Restore lost
- buffer local setting.
+2012-09-07 Chong Yidong <cyd@gnu.org>
-2012-08-15 Glenn Morris <rgm@gnu.org>
+ * subr.el (buffer-narrowed-p): New function.
- * vc/log-edit.el (log-edit-font-lock-gnu-style): Mark safe if boolean.
+ * ses.el (ses-widen):
+ * simple.el (count-words--buffer-message):
+ * net/browse-url.el (browse-url-of-buffer): Use it
-2012-08-15 Leo Liu <sdl.web@gmail.com>
+ * simple.el (count-words-region): Don't signal an error if there
+ is a non-nil prefix arg and the mark is not set.
- * net/rcirc.el (rcirc-split-message): Fix for buffer-local
- rcirc-encode-coding-system.
+ * help.el (describe-key-briefly): Allow the message to be seen
+ when invoked from the minibuffer (Bug#7014).
-2012-08-13 Leo Liu <sdl.web@gmail.com>
+2012-09-07 Dmitry Gutov <dgutov@yandex.ru>
- * net/rcirc.el (rcirc-split-message): New function.
- (rcirc-send-message): Use it. (Bug#12051)
+ * progmodes/ruby-mode.el (ruby-end-of-defun)
+ (ruby-beginning-of-defun): Simplify, allow indentation before
+ block beginning and end keywords.
+ (ruby-beginning-of-defun): Only consider 3 keywords defun beginners.
+ (ruby-end-of-defun): Expect that the point is at the beginning of
+ the defun.
-2012-08-10 Glenn Morris <rgm@gnu.org>
+2012-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
- * emacs-lisp/copyright.el (copyright-update-directory): Logic fix.
+ * emacs-lisp/cl-macs.el (cl--do-arglist): Understand _ on &key args
+ (bug#12367).
+ (cl--make-usage-args): Strip _ from argument names.
- * 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).
+2012-09-06 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
-2012-08-07 Glenn Morris <rgm@gnu.org>
+ * progmodes/vhdl-mode.el (vhdl-speedbar-initialize): Don't use
+ obsolete alias speedbar-key-map.
+ (vhdl-doc-variable, vhdl-doc-mode): Use called-interactively-p.
+ (vhdl-index-menu-init): Don't use obsolete variable
+ font-lock-maximum-size.
- * 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)
- This is CVE-2012-3479.
+2012-09-06 Chong Yidong <cyd@gnu.org>
-2012-08-07 Chong Yidong <cyd@gnu.org>
+ * frame.el (window-system-version): Mark as obsolete.
- * mouse.el (mouse-drag-track): Deactivate the mark before popping.
+ * speedbar.el (speedbar-update-flag, speedbar-mode): Remove uses
+ of obsolete variable speedbar-key-map.
-2012-08-06 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-09-06 Juri Linkov <juri@jurta.org>
- * progmodes/cperl-mode.el (cperl-mode): Yet another fix for
- syntax-propertize-function (bug#10095).
+ * replace.el (replace-lax-whitespace): New defcustom.
+ (query-replace, query-replace-regexp, query-replace-regexp-eval)
+ (replace-string, replace-regexp): Mention it in docstrings.
+ (perform-replace, replace-highlight): Let-bind
+ isearch-lax-whitespace and isearch-regexp-lax-whitespace according
+ to the values of replace-lax-whitespace and regexp-flag.
+ Don't let-bind search-whitespace-regexp. (Bug#10885)
-2012-07-28 Chong Yidong <cyd@gnu.org>
+ * isearch.el (isearch-query-replace): Let-bind
+ replace-lax-whitespace instead of let-binding
+ replace-search-function and replace-re-search-function.
+ (isearch-lazy-highlight-search): Let-bind isearch-lax-whitespace
+ and isearch-regexp-lax-whitespace to lazy-highlight variables.
+ (isearch-toggle-symbol): Set isearch-regexp to nil
+ in isearch-word mode (like in isearch-toggle-word).
- * progmodes/gdb-mi.el (gdb-place-breakpoints): Fix the call to
- gdb-get-location.
+2012-09-06 Juri Linkov <juri@jurta.org>
-2012-07-25 Leo Liu <sdl.web@gmail.com>
+ * replace.el (replace-search-function)
+ (replace-re-search-function): Set default values to nil.
+ (perform-replace): Let-bind isearch-related variables based on
+ replace-related values, call `isearch-search-fun' and let-bind
+ the result to `search-function'. Remove code that sets
+ `search-function' and `search-string' separately for
+ `delimited-flag'.
+ (replace-highlight): Add new argument `delimited-flag' and
+ rename other arguments to the names used in `perform-replace'.
+ Let-bind `isearch-word' to the argument `delimited-flag'.
+ (Bug#10885, bug#10887)
- * progmodes/cc-menus.el (cc-imenu-objc-function): Avoid leaving nil in
- the alist (bug#12029).
+2012-09-07 Dmitry Gutov <dgutov@yandex.ru>
-2012-07-25 Chong Yidong <cyd@gnu.org>
+ * progmodes/ruby-mode.el (ruby-indent-beg-re): Add pieces from
+ ruby-beginning-of-indent, simplify, allow all keywords to have
+ indentation before them.
+ (ruby-beginning-of-indent): Adjust for above. Search until the
+ found point is not inside a string or comment.
+ (ruby-font-lock-keywords): Allow symbols to start with "@"
+ character, give them higher priority than variables.
+ (ruby-syntax-propertize-function)
+ (ruby-font-lock-syntactic-keywords): Remove the "not comments"
+ matchers. Expression expansions are not comments when inside a
+ string, and there comment syntax status is irrelevant.
+ (ruby-match-expression-expansion): New function. Check that
+ expression expansion is inside a string, and it's not escaped.
+ (ruby-font-lock-keywords): Use it.
- * mouse.el (mouse-drag-track): Do not set the mark if the user
- releases the mouse without selecting anything (Bug#11588).
+2012-09-05 Martin Rudalics <rudalics@gmx.at>
-2012-07-21 Leo Liu <sdl.web@gmail.com>
+ * help.el (temp-buffer-max-height): New default value.
+ (temp-buffer-resize-frames): New option.
+ (resize-temp-buffer-window): Optionally resize frame.
- * progmodes/cc-cmds.el (c-defun-name):
- Use match-string-no-properties instead for consistency.
+ * window.el (fit-frame-to-buffer-bottom-margin): New option.
+ (fit-frame-to-buffer): New function.
-2012-07-20 Leo Liu <sdl.web@gmail.com>
+2012-09-05 Glenn Morris <rgm@gnu.org>
+
+ * emulation/cua-rect.el (cua--init-rectangles):
+ * textmodes/picture.el (picture-mode-map):
+ * play/blackbox.el (blackbox-mode-map): Remap right-char and left-char
+ like forward-char and backward-char. (Bug#12317)
+
+2012-09-05 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/flymake.el (flymake-warning-re): New variable.
+ (flymake-parse-line): Use it.
+
+2012-09-05 Glenn Morris <rgm@gnu.org>
+
+ * calendar/holidays.el (holiday-christian-holidays):
+ Rename an entry. (Bug#12289)
+
+2012-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-font-lock-paren): Don't burp at BOB
+ (bug#12222).
+
+2012-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * loadup.el: Load macroexp. Remove hack.
+ * emacs-lisp/macroexp.el (macroexp--eval-if-compile): New function.
+ (macroexp--expand-all): Use it to get better warnings.
+ (macroexp--backtrace, macroexp--trim-backtrace-frame)
+ (internal-macroexpand-for-load): New functions.
+ (macroexp--pending-eager-loads): New var.
+ (emacs-startup-hook): New hack to replace one in loadup.el.
+ * emacs-lisp/cl-macs.el (cl--compiler-macro-list*)
+ (cl--compiler-macro-cXXr): Move to top, before they can be used.
+ (cl-psetf): Simplify.
+ (cl-defstruct): Add indent rule.
+
+2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mail/smtpmail.el (smtpmail-send-it): Prefer the From: header
+ over `user-mail-address' for the SMTP MAIL FROM envelope.
+ (smtpmail-via-smtp): Ditto.
+
+2012-09-04 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el: Clean up keybindings.
+ (ruby-mode-map): Don't bind ruby-electric-brace,
+ ruby-beginning-of-defun, ruby-end-of-defun, ruby-mark-defun,
+ backward-kill-word, reindent-then-newline-and-indent.
+ (ruby-mark-defun): Remove.
+ (ruby-electric-brace): Remove. Obsoleted by electric-indent-chars.
+ (ruby-mode): Set local beginning-of-defun-function and
+ end-of-defun-function values.
+
+2012-09-03 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (temp-buffer-window-setup-hook)
+ (temp-buffer-window-show-hook): New hooks.
+ (temp-buffer-window-setup, temp-buffer-window-show)
+ (with-temp-buffer-window): New functions.
+ (fit-window-to-buffer): Remove unused optional argument OVERRIDE.
+ (special-display-popup-frame): Make sure the window used shows BUFFER.
+
+ * help.el (temp-buffer-resize-mode): Fix doc-string.
+ (resize-temp-buffer-window): New optional argument WINDOW.
+
+ * files.el (recover-file, save-buffers-kill-emacs):
+ * dired.el (dired-mark-pop-up): Use with-temp-buffer-window.
+
+2012-09-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/em-unix.el (eshell/sudo): When we have an ad-hoc
+ remote definition of `default-directory', ensure we can connect.
+
+2012-09-02 Juri Linkov <juri@jurta.org>
+
+ Toggle whitespace matching mode with M-s SPC.
+ http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00008.html
+
+ * isearch.el (search-whitespace-regexp): Doc fix.
+ Remove cons cell customization.
+ (isearch-mode-map): Bind "\M-s " to isearch-toggle-lax-whitespace.
+ (isearch-lax-whitespace, isearch-regexp-lax-whitespace):
+ New variables.
+ (isearch-forward, isearch-forward-regexp): Doc fix.
+ (isearch-toggle-lax-whitespace): New command.
+ (search-forward-lax-whitespace, search-backward-lax-whitespace)
+ (re-search-forward-lax-whitespace)
+ (re-search-backward-lax-whitespace): New functions.
+ (isearch-whitespace-regexp): Remove function.
+ (isearch-query-replace): Let-bind replace-search-function and
+ replace-re-search-function.
+ (isearch-occur): Let-bind search-spaces-regexp according to the
+ value of isearch-lax-whitespace and isearch-regexp-lax-whitespace.
+ (isearch-quote-char): Check isearch-regexp-lax-whitespace in the
+ condition for C-q SPC.
+ (isearch-search-fun-default): Use new functions mentioned above.
+ (isearch-search-forward, isearch-search-backward): Remove functions.
+ (isearch-search): Don't let-bind search-spaces-regexp.
+ (isearch-lazy-highlight-space-regexp): Remove variable.
+ (isearch-lazy-highlight-lax-whitespace)
+ (isearch-lazy-highlight-regexp-lax-whitespace): New variables.
+ (isearch-lazy-highlight-new-loop): Use them.
+ (isearch-lazy-highlight-search): Don't let-bind search-spaces-regexp.
+
+2012-09-02 Chong Yidong <cyd@gnu.org>
+
+ * dired.el (dired-mode-map): Menu string fixes (Bug#11616).
+
+2012-09-02 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (undo): Tweak message in undo-only case. (Bug#12283)
+
+2012-09-01 Glenn Morris <rgm@gnu.org>
+
+ * term.el: Tidy up menu definitions.
+ (term-mode-map): Use easymenu for In/Out, Complete menus.
+ (term-pager-break-map): Initialize in the defvar.
+ (term-terminal-menu, term-signals-menu): Define with easymenu.
+ (term-terminal-menu): Also show it in line-mode. (Bug#11957)
+ (term-pager-menu): New, extracted from term-process-pager.
+ (term-mode, term-char-mode, term-process-pager): Use easymenu-add.
+ (term-update-mode-line): Propertize line/char and page items.
+ (term-process-pager): Move keymap initialization elsewhere.
+
+2012-09-01 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (switch-to-prev-buffer): Handle additional values of
+ BURY-OR-KILL argument. Don't switch in minibuffer window.
+ (switch-to-next-buffer): Don't switch in minibuffer window.
+ (quit-restore-window): New function based on quit-window.
+ Handle additional values of former KILL argument.
+ (quit-window): Call quit-restore-window with appropriate
+ interpretation of KILL argument.
+ (display-buffer-below-selected): New buffer display action
+ function.
+
+2012-09-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-at-point-functions): Complete docstring
+ (bug#12254).
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seed support for (random).
+ * play/5x5.el, play/animate.el, play/cookie1.el, play/dissociate.el:
+ * play/doctor.el, play/dunnet.el, play/gomoku.el, play/landmark.el:
+ * play/mpuz.el, play/tetris.el, play/zone.el:
+ * calc/calc-comb.el (math-init-random-base):
+ * play/blackbox.el (bb-init-board):
+ * play/life.el (life):
+ * server.el (server-use-tcp):
+ * type-break.el (type-break):
+ Remove unnecessary call to (random t).
+ * net/sasl.el (sasl-unique-id-function):
+ Change (random t) to (random), now that the latter is more random.
+ * play/life.el (life-initialized): Remove no-longer-needed var.
+
+2012-08-31 Alp Aker <alp.tekin.aker@gmail.com>
+
+ * window.el (switch-to-prev-buffer, switch-to-next-buffer):
+ Consider frame's buffer predicate when choosing the buffer.
+ (Bug#12081)
+
+2012-08-30 Richard Stallman <rms@gnu.org>
+
+ * simple.el (special-mode-map): Delete binding for `z'.
+
+2012-08-30 Andreas Schwab <schwab@linux-m68k.org>
+
+ * progmodes/compile.el (compilation-always-kill): Doc fix.
+
+2012-08-30 Chong Yidong <cyd@gnu.org>
+
+ * window.el (display-buffer-reuse-frames): Make the obsolescence
+ message more informative.
+
+2012-08-30 Glenn Morris <rgm@gnu.org>
+
+ * paren.el (show-paren-delay):
+ Add a :set function. Doc fix. (Bug#12297)
+
+2012-08-29 Martin Blais <blais@furius.ca> (tiny change)
+
+ * progmodes/compile.el (compilation-always-kill): New var.
+ (compilation-start): Use it.
+
+2012-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (read-only-mode): Move from files.el for bootstrapping.
+ * files.el (read-only-mode): Move to simple.el.
+
+ * files.el (read-only-mode): New minor mode.
+ (toggle-read-only): Use it and mark obsolete.
+ (find-file--read-only):
+ * vc/vc.el (vc-next-action, vc-checkout):
+ * vc/vc-cvs.el (vc-cvs-checkout):
+ * obsolete/vc-mcvs.el (vc-mcvs-update):
+ * ffap.el (ffap--toggle-read-only): Update callers.
+
+2012-08-29 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/esh-ext.el (eshell-external-command): Do not examine
+ remote shell scripts.
+ See <https://bugs.launchpad.net/ubuntu/+source/emacs23/+bug/1035790>.
+
+ * net/tramp-sh.el (tramp-remote-path): Add "/sbin" and
+ "/usr/local/sbin".
+
+2012-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el (buffer-string): Fix setter macro (bug#12293).
+
+2012-08-28 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/sh-script.el (sh-dynamic-complete-functions): Adapt to
+ completion-at-point. (Bug#12220)
+
+ * skeleton.el (skeleton-untabify): Change to nil (bug#12223).
+
+ * progmodes/sh-script.el (sh-indent-comment): Change to t (bug#12267).
+
+2012-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (safe-local-eval-forms): Fix before-save-hook entry to
+ be buffer-local; add delete-trailing-whitespace (bug#12259).
+
+2012-08-28 Jeremy Moore <jmoore@ieee.org> (tiny change)
+
+ * progmodes/hideif.el (hif-compress-define-list):
+ Fix typo. (Bug#11951)
+
+2012-08-28 Dan Nicolaescu <dann@gnu.org>
+
+ * progmodes/hideshow.el (hs-block-end-regexp): Restore lost
+ buffer local setting.
+
+ * net/rcirc.el (rcirc-split-message): Fix for buffer-local
+ rcirc-encode-coding-system.
+
+2012-08-28 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-split-message): New function.
+ (rcirc-send-message): Use it. (Bug#12051)
+
+2012-08-28 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-fontify-node): Hide empty lines at the end of
+ the node. (Bug#12272)
+
+2012-08-27 Drew Adams <drew.adams@oracle.com>
+
+ * dired.el (dired-pop-to-buffer): Make window start at beginning
+ of buffer (Bug#12281).
+
+2012-08-26 Chong Yidong <cyd@gnu.org>
+
+ * window.el (special-display-regexps, special-display-frame-alist)
+ (special-display-buffer-names, special-display-function)
+ (display-buffer-reuse-frames): Mark as obsolete.
+
+ * progmodes/compile.el: Don't use display-buffer-reuse-frames.
+
+ * help.el (help-print-return-message): Don't treat
+ display-buffer-reuse-frames specially.
+
+2012-08-26 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-display-buffer-other-frame-action):
+ New variable, replacing gdb-frame-parameters.
+ (gdb-frame-io-buffer, gdb-frame-breakpoints-buffer)
+ (gdb-frame-threads-buffer, gdb-frame-memory-buffer)
+ (gdb-frame-disassembly-buffer, gdb-frame-stack-buffer)
+ (gdb-frame-locals-buffer, gdb-frame-registers-buffer): Use it.
+ (def-gdb-frame-for-buffer): Macro deleted. It is easier to define
+ the functions directly with gdb-display-buffer-other-frame-action.
+ (gdb-display-breakpoints-buffer, gdb-display-threads-buffer)
+ (gdb-display-memory-buffer, gdb-display-disassembly-buffer)
+ (gdb-display-stack-buffer, gdb-display-locals-buffer)
+ (gdb-display-registers-buffer): Define directly.
+ (def-gdb-display-buffer): Macro deleted.
+ (gdb-display-buffer): Remove second and third args, callers don't
+ use them. Defer to the default display-buffer behavior, apart
+ from making windows dedicated.
+ (gdb-setup-windows): Don't call display-buffer unnecessarily.
+
+ * progmodes/gud.el (gud-display-line): Just use display-buffer.
+
+ * window.el (display-buffer-pop-up-frame): Handle a
+ pop-up-frame-parameters alist entry.
+ (display-buffer): Document it.
+
+2012-08-26 Chong Yidong <cyd@gnu.org>
+
+ * isearch.el (search-whitespace-regexp): Make string and nil
+ values apply to both ordinary and regexp search. Allow a cons
+ cell value to distinguish between the two.
+ (isearch-whitespace-regexp, isearch-search-forward)
+ (isearch-search-backward): New functions.
+ (isearch-occur, isearch-search-fun-default, isearch-search)
+ (isearch-lazy-highlight-new-loop): Use them.
+ (isearch-forward, isearch-forward-regexp): Doc fix.
+
+2012-08-26 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (help-argument-name): Always inherit from italic
+ (Bug#12213).
+
+2012-08-25 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--even-window-heights): Even heights when
+ WINDOW and the selected window form a vertical combination.
+ (display-buffer-use-some-window): Provide that window used gets
+ sized back by quit-window. (Bug#11880) and (Bug#12091)
+
+2012-08-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix file time stamp problem with bzr and CVS (Bug#12001).
+ * vc/vc-cvs.el (vc-cvs-parse-entry): Ignore subsecond information
+ in the file's time stamp, since the version control system loses
+ that information.
+
+2012-08-22 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-fontify-node): Hide the suffix of the
+ Info file name in the header line. (Bug#12187)
+
+2012-08-22 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-tex.el (cal-tex-weekly-common):
+ Restore leading blank page.
+
+2012-08-22 Le Wang <l26wang@gmail.com> (tiny change)
+
+ * misc.el (forward-to-word, backward-to-word): Activate or extend
+ the region under `shift-select-mode'. (Bug#12231)
+
+2012-08-22 Bastien Guerry <bzg@gnu.org>
+
+ * progmodes/executable.el (executable-prefix): Set to "#!" instead
+ of "#! ". http://www.in-ulm.de/~mascheck/various/shebang/#details
+ gives details on why the space is never needed.
+
+2012-08-22 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (walk-window-tree, window-with-parameter):
+ New optional argument MINIBUF to control whether these functions
+ should run on the minibuffer window.
+ (window-at-side-list): Don't operate on minibuffer window.
+ (window-in-direction): Simplify and rewrite doc-string.
+ (window--size-ignore): Rename to window--size-ignore-p.
+ Update callers.
+ (display-buffer-in-atom-window, window--major-non-side-window)
+ (window--major-side-window, display-buffer-in-major-side-window)
+ (delete-side-window, display-buffer-in-side-window):
+ New functions.
+ (window--side-check, window-deletable-p, delete-window)
+ (delete-other-windows, split-window): Handle side windows and
+ atomic windows appropriately.
+ (window--display-buffer): Call display-buffer-record-window also
+ when the window buffer did not change.
+
+2012-08-22 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * help-fns.el (help-fns--key-bindings):
+ Abbreviate non-symbol remap targets. (Bug#12174)
+
+2012-08-22 Martin Rudalics <rudalics@gmx.at>
+
+ * dired.el (dired-mark-remembered): Don't clobber point.
+ (Bug#11795)
+
+2012-08-22 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/bug-reference.el (bug-reference): New custom group.
+ (bug-reference-bug-regexp): Make it a defcustom.
+
+2012-08-22 Daiki Ueno <ueno@unixuser.org>
+
+ * progmodes/js.el (js-indent-level, js-expr-indent-offset)
+ (js-paren-indent-offset, js-square-indent-offset)
+ (js-curly-indent-offset): Add :safe (Bug#12257).
+
+2012-08-22 Edward O'Connor <hober0@gmail.com>
+
+ * json.el (json-key-format): Add error properties.
+ (json-encode-key): New function.
+ (json-encode-hash-table, json-encode-alist, json-encode-plist):
+ Use json-encode-key.
+
+2012-08-22 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-tex.el (cal-tex-longday): New function, replacing...
+ (cal-tex-leftday, cal-tex-rightday): Remove functions.
+ (cal-tex-weekly-common, cal-tex-cursor-filofax-2week):
+ Update for above change.
+
+2012-08-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * cus-face.el (custom-face-attributes): Fix customize type for the
+ :underline attribute. (Bug#11805)
+
+2012-08-21 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-point-1, set-window-point-1): Remove.
+ (window-in-direction, record-window-buffer)
+ (set-window-buffer-start-and-point, split-window-below)
+ (window--state-get-1, display-buffer-record-window):
+ Replace calls to window-point-1 and set-window-point-1 by calls to
+ window-point and set-window-point respectively.
+
+2012-08-21 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-tex.el (cal-tex-weekly-common): New function.
+ (cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-week):
+ Use it.
+
+ * calendar/cal-tex.el (cal-tex-rightday): Add optional funcname arg.
+ (cal-tex-shortday): New function.
+ (cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-week)
+ (cal-tex-cursor-filofax-daily): Use the above.
+
+ * calendar/cal-tex.el (cal-tex-leftday, cal-tex-rightday):
+ New functions.
+ (cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-2week)
+ (cal-tex-cursor-filofax-week): Use them.
+
+ * calendar/cal-tex.el (cal-tex-lefthead, cal-tex-righthead):
+ New constants.
+ (cal-tex-cursor-week-at-a-glance, cal-tex-cursor-filofax-2week)
+ (cal-tex-cursor-filofax-week, cal-tex-cursor-filofax-daily): Use them.
+
+ * calendar/cal-tex.el (cal-tex-preamble): Generate new buffers.
+ (cal-tex-end-document): Don't rely on buffer name.
+
+ * calendar/cal-tex.el (cal-tex-cursor-filofax-year):
+ Use cal-tex-vspace.
+ (cal-tex-vspace, cal-tex-hspace, cal-tex-em, cal-tex-bf)
+ (cal-tex-Huge-bf, cal-tex-large-bf): Use cal-tex-cmd.
+ (cal-tex-scriptsize, cal-tex-huge, cal-tex-Huge, cal-tex-large):
+ Use cal-tex-arg.
+
+ * calendar/cal-tex.el (cal-tex-cursor-filofax-year)
+ (cal-tex-cursor-week, cal-tex-cursor-week2)
+ (cal-tex-cursor-week-iso, cal-tex-cursor-week-at-a-glance)
+ (cal-tex-cursor-filofax-2week, cal-tex-cursor-filofax-week)
+ (cal-tex-cursor-filofax-daily, cal-tex-cursor-day)
+ (cal-tex-insert-preamble, cal-tex-b-document)
+ (cal-tex-e-document, cal-tex-b-center, cal-tex-e-center):
+ Improve cal-tex-cmd usage.
+
+ * calendar/cal-tex.el (cal-tex-filofax-paper): New function.
+ (cal-tex-cursor-filofax-year, cal-tex-cursor-filofax-2week)
+ (cal-tex-cursor-filofax-week, cal-tex-cursor-filofax-daily): Use it.
+ (cal-tex-weekly-paper): New function.
+ (cal-tex-cursor-week, cal-tex-cursor-week2)
+ (cal-tex-cursor-week-iso, cal-tex-cursor-week-monday)
+ (cal-tex-cursor-day): Use it.
+
+ * calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance)
+ (cal-tex-cursor-filofax-week): Remove leading blank page.
+
+ * calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance):
+ Add autoload cookie. For now at least, don't use color, since
+ no other cal-tex function does.
+
+ * calendar/cal-tex.el (cal-tex-cursor-week-iso)
+ (cal-tex-cursor-filofax-2week, cal-tex-cursor-filofax-week)
+ (cal-tex-cursor-filofax-daily): Correct start date for diary entries.
+
+2012-08-21 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-file-attributes): New variable.
+ (info-insert-file-contents): Add file attributes to
+ `Info-file-attributes'. Clear the caches `Info-index-nodes' and
+ `Info-toc-nodes' when previous modtime of the Info file is less
+ than new modtime.
+ (Info-toc-nodes, Info-index-nodes): Move definitions up to the top
+ of info.el. (Bug#12230)
+
+2012-08-20 Glenn Morris <rgm@gnu.org>
+
+ * calendar/diary-lib.el (diary-include-files, diary-sexp-entry):
+ * calendar/holidays.el (calendar-holiday-list):
+ Report errors with display-warning rather than beep'n'sleep.
+
+2012-08-20 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-accept-process-output): Accept only output
+ from PROC. Otherwise, process filters and sentinels might be
+ confused. (Bug#12145)
+
+2012-08-20 Chong Yidong <cyd@gnu.org>
+
+ * descr-text.el (describe-text-properties-1): Use overlays-in to
+ report on empty overlays (Bug#3322).
+
+2012-08-20 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailout.el (rmail-output-read-file-name):
+ Trap and report errors in rmail-output-file-alist elements.
+
+ * font-lock.el (font-lock-add-keywords): Doc fix (quote face names
+ since most non-font-lock faces are not also variables).
+
+2012-08-20 Edward Reingold <reingold@iit.edu>
+
+ * calendar/cal-tex.el (cal-tex-cursor-week-at-a-glance):
+ New function. (Bug12160)
+
+2012-08-19 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailout.el (rmail-output-read-file-name):
+ Fix previous change (when the alist is nil or does not match).
+
+2012-08-19 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml-escape-string): Don't refer to xml-entity-alist
+ (Bug#12228).
+
+2012-08-18 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (yank-handled-properties): New defcustom.
+ (yank-excluded-properties): Add font-lock-face and category.
+ (yank): Doc fix.
+
+ * subr.el (remove-yank-excluded-properties):
+ Obey yank-handled-properties. The special handling of font-lock-face
+ and category is now done this way, instead of being hard-coded.
+ (insert-for-yank-1): Remove font-lock-face handling.
+ (yank-handle-font-lock-face-property)
+ (yank-handle-category-property): New function.
+
+2012-08-17 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailout.el (rmail-output-read-file-name):
+ Check rmail-output-file-alist against the full message body
+ in the correct rmail buffer. (Bug#12214)
+
+2012-08-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-start-file-process):
+ Eliminate superfluous prompt. (Bug#12203)
+
+2012-08-17 Chong Yidong <cyd@gnu.org>
+
+ * mouse.el (mouse-appearance-menu): If x-select-font returns a
+ font spec, set the font directly (Bug#3228).
+
+2012-08-17 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (delete-window): Fix last fix.
+
+2012-08-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-valid-p): Move to window.c.
+ (window-child, window-child-count, window-last-child)
+ (window-normalize-window, window-combined-p)
+ (window-combinations, window-atom-root, window-min-size)
+ (window-sizable, window-sizable-p, window-size-fixed-p)
+ (window-min-delta, window-max-delta, window--resizable)
+ (window--resizable-p, window-resizable, window-total-size)
+ (window-full-height-p, window-full-width-p, window-body-size)
+ (window-at-side-p, adjust-window-trailing-edge, maximize-window)
+ (minimize-window, window-deletable-p, delete-window)
+ (delete-other-windows, set-window-buffer-start-and-point)
+ (next-buffer, previous-buffer, split-window, balance-windows-2)
+ (set-window-text-height, window-buffer-height)
+ (fit-window-to-buffer, shrink-window-if-larger-than-buffer)
+ (truncated-partial-width-window-p): Minor code adjustments.
+ In doc-strings state whether the argument window has to denote a
+ live, valid or any window.
+
+2012-08-16 Phil Sainty <psainty@orcon.net.nz> (tiny change)
+
+ * progmodes/subword.el (subword-forward-function)
+ (subword-backward-function, subword-forward-regexp)
+ (subword-backward-regexp): New variables.
+ (subword-forward, subword-forward-internal, subword-backward-internal):
+ Use new variables, eg so that different "word" definitions
+ can be easily used. (Bug#11411)
+
+2012-08-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * 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 <cyd@gnu.org>
+
+ * frame.el (set-frame-font): Accept font objects.
+
+2012-08-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/tex-mode.el (tex-insert-quote): ~ is a space (bug#12137).
+
+2012-08-15 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * 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 <monnier@iro.umontreal.ca>
+
+ * subr.el (read-passwd): Allow use from a minibuffer.
+
+2012-08-14 Eli Zaretskii <eliz@gnu.org>
+
+ * 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 <rgm@gnu.org>
+
+ * 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 <cyd@gnu.org>
+
+ * 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 <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-recompile-file): Doc fix.
+
+2012-08-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * 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 <fgallina@cuca>
+
+ * progmodes/python.el (python-shell-send-string):
+ (python-shell-send-setup-code): Do not use `format' with `message'.
+
+2012-08-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * 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 <schwab@linux-m68k.org>
+
+ * 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 <cyd@gnu.org>
+
+ * 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 <ueno@unixuser.org>
+
+ * subr.el (internal--after-with-selected-window): Fix typo
+ (Bug#12193).
+
+2012-08-14 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ 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 <kjambunathan@gmail.com>
+
+ * 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 <monnier@iro.umontreal.ca>
+
+ * 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 <dgutov@yandex.ru>.
+
+2012-08-13 Bastien Guerry <bzg@gnu.org>
+
+ * window.el (special-display-popup-frame): Minor docstring
+ enhancement. (Bug#12172)
+
+2012-08-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * 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 <rudalics@gmx.at>
+
+ * subr.el (with-selected-window): Fix last change.
+
+2012-08-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * 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 <nobu@ruby-lang.org>
+
+ * 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 <monnier@iro.umontreal.ca>
+
+ * 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 <schwab@linux-m68k.org>
+
+ * descr-text.el (describe-char): Put the overlays over the
+ "displayed as" character.
+
+2012-08-12 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * 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 <rgm@gnu.org>
+
+ * 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)
+ This is CVE-2012-3479.
+
+2012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/rx.el (rx-constituents): Don't define as constant.
+ (rx-form): Simplify.
+
+2012-08-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * 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 <nobu@ruby-lang.org>
+
+ * 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 <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-loop): Improve debug spec.
+
+2012-08-10 Chong Yidong <cyd@gnu.org>
+
+ * 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 <cyd@gnu.org>
+
+ * 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 <monnier@iro.umontreal.ca>
+
+ * 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 <yamato@redhat.com>
+
+ * 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 <jay.p.belanger@gmail.com>
+
+ * 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 <cyd@gnu.org>
+
+ * 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 <fgallina@cuca>
+
+ * 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 <fgallina@cuca>
+
+ * 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 <jay.p.belanger@gmail.com>
+
+ * calc/calc-menu.el (calc-modes-menu): Add entries for matrix
+ modes and simplification modes.
+
+2012-08-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * delsel.el (delete-selection-pre-hook): Don't propagate the
+ file-supersession signals (bug#12161).
+
+2012-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl.el (cl-map-keymap-recursively, cl-map-intervals)
+ (cl-map-extents): Add compatibility aliases (bug#12135).
+
+2012-08-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * 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 <cabo@tzi.org>. (Bug#12148)
+
+2012-08-08 Juri Linkov <juri@jurta.org>
+
+ * 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 <juri@jurta.org>
+
+ * 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 <juri@jurta.org>
+
+ * 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 <rgm@gnu.org>
+
+ * 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 <ofv@wanadoo.es>
+
+ * vc/diff-mode.el (diff-remove-trailing-whitespace): New function.
+
+2012-08-08 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * 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 <jay.p.belanger@gmail.com>
+
+ * calc/calc-misc.el (calc-record-why): Don't record a message twice.
+
+2012-08-07 Andreas Schwab <schwab@linux-m68k.org>
+
+ * 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 <cyd@gnu.org>
+
+ * simple.el (deactivate-mark): Preserve text properties when
+ saving the primary selection (Bug#8384).
+
+2012-08-07 Kevin Ryde <user42@zip.com.au>
+
+ * 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 <monnier@iro.umontreal.ca>
+
+ * progmodes/cperl-mode.el (cperl-mode): Yet another fix for
+ syntax-propertize-function (bug#10095).
+
+2012-08-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * 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 <libre@mohsen.1.banan.byname.net>
+
+ * language/persian.el: New file. (Bug#11812)
+ * loadup.el: Add language/persian.el.
+
+2012-08-06 Chong Yidong <cyd@gnu.org>
+
+ * 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 <fgallina@cuca>
+
+ 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 <rgm@gnu.org>
+
+ * eshell/esh-ext.el (eshell/addpath): Use dolist and mapconcat.
+ Do less getting and setting of environment variables.
+
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * 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 <vegard_oye@hotmail.com> (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 <cyd@gnu.org>
+
+ * 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 <rgm@gnu.org>
+
+ * eshell/esh-ext.el (eshell/addpath):
+ Also update eshell-path-env. (Bug#12013)
+
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * 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 <monnier@iro.umontreal.ca>
+
+ * 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 <schwab@linux-m68k.org>
+
+ * simple.el (list-processes--refresh): For a server use :host or
+ :local as the address.
+ (list-processes): Doc fix.
+
+2012-08-04 Michal Nazarewicz <mina86@mina86.com>
+
+ * 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 <eliz@gnu.org>
+
+ * 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 <cyd@gnu.org>
+
+ * menu-bar.el (menu-bar-tools-menu): Remove PCL-CVS.
+
+ * sort.el (sort-regexp-fields): Doc fix.
+
+2012-08-03 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex.el (reftex-compile-variables): Make keyvals
+ labels regex position point at the expected place.
+
+2012-08-03 MON KEY <monkey@sandpframing.com>
+
+ * 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 <joaotavora@gmail.com>
+
+ * textmodes/tex-mode.el (latex-forward-sexp): Terminate the loop
+ if sexp scanning does not move point (Bug#5734).
+
+2012-08-02 Tassilo Horn <tsdh@gnu.org>
+
+ * 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 <bzg@gnu.org>
+
+ * replace.el (occur): Fix docstring (bug#12122).
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-renamed-files-alist): Add ms-w32.h.
+
+2012-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ 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
+ <http://bugs.gnu.org/10150#46>.
+
+2012-08-01 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-mode.el (calc-set-simplify-mode): Use `cond' instead
+ of nested `if's.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/autoconf.el (autoconf-definition-regexp):
+ Add AH_TEMPLATE, adjust submatch numbering.
+ (autoconf-font-lock-keywords, autoconf-imenu-generic-expression)
+ (autoconf-current-defun-function): Update for above change.
+ (autoconf-current-defun-function): First skip to end of current word.
+
+2012-08-01 Rupert Swarbrick <rswarbrick@gmail.com> (tiny change)
+
+ * calendar/cal-html.el (cal-html-insert-agenda-days):
+ Fix typo. (Bug#12018)
+
+2012-07-31 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Shell processes: enhancements to startup and CEDET compatibility.
+ * progmodes/python.el (python-shell-send-setup-max-wait): Delete var.
+ (python-shell-make-comint): accept-process-output at startup.
+ (run-python-internal): Set inferior-python-mode-hook to nil.
+ (python-shell-internal-get-or-create-process): call sit-for.
+ (python-preoutput-result): Add obsolete alias.
+ (python-shell-internal-send-string): Use it.
+ (python-shell-send-setup-code): Remove call to
+ accept-process-output.
+
+2012-07-31 Andreas Schwab <schwab@linux-m68k.org>
+
+ * buff-menu.el (list-buffers-noselect): Use prefix-numeric-value.
+ (Bug#12108)
+
+2012-07-31 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc-mode.el (calc-basic-simplification-mode): Rename from
+ `calc-limited-simplification-mode'.
+ (calc-alg-simplification-mode): New function.
+ (calc-set-simplify-mode): Adjust message.
+
+ * calc.el (calc-set-mode-line): Adjust mode line display for
+ basic simplification mode.
+
+ * calc-help.el (calc-m-prefix-help): Update help message.
+
+ * calc-ext.el (calc-init-extensions): Add bindings and autoloads
+ for `calc-basic-simplify-mode' and `calc-alg-simplify-mode'.
+
+2012-07-31 Bastien Guerry <bzg@gnu.org>
+
+ * man.el (man): Fix comment. (bug#12101)
+
+2012-07-31 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (switch-to-prev-buffer, switch-to-next-buffer):
+ Don't return a non-nil value when no suitable buffer was found.
+
+2012-07-31 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (run-python-internal): Disable font lock for
+ internal shells.
+
+2012-07-30 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Silence `checkdoc-ispell'.
+ (rst-cvs-header, rst-svn-rev, rst-svn-timestamp)
+ (rst-official-version, rst-official-cvs-rev)
+ (rst-package-emacs-version-alist): Update to upstream V1.3.1.
+ (rst-mode-map): New key binding.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, doit, custom-deps, finder-data,
+ autoloads, update-subdirs, updates, bzr-update, update-authors,
+ compile-onefile, compile-calc, backup-compiled-files,
+ compile-after-backup, compile-one-process, mh-autoloads,
+ bootstrap-clean, distclean, maintainer-clean.
+
+2012-07-29 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-simplify-mode): Make 'alg the default value.
+ (calc-set-mode-line): Don't display "AlgSimp ".
+
+ * calc/calc-mode.el (calc-alg-simplify-mode): Remove function.
+ (calc-lim-simplify-mode): New function.
+ (calc-set-simplify-mode): Default to 'alg.
+ (calc-default-simplify-mode): Make algebraic simplifications
+ the default.
+
+ * calc/calc-ext.el (calc-init-extensions): Remove binding for
+ `calc-alg-simplify-mode'. Add binding for `calc-lim-simplify-mode'.
+
+ * calc/calc-help.el (calc-m-prefix-help): Change messages to
+ indicate new simplification modes.
+
+ * calc/README: Mention new default simplification mode.
+
+ * calc/calc.el (math-normalize-error): New variable.
+ (math-normalize): Set `math-normalize-error' to t
+ when there's an error.
+
+ * calc/calc-alg.el (math-simplify): Don't simplify when
+ `math-normalize' returns an error.
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * international/mule-cmds.el (set-locale-environment): Revert last
+ change, since display-graphic-p returns nil when this function is
+ called during startup. Instead...
+
+ * term/w32console.el (terminal-init-w32console): ...setup the
+ keyboard and terminal encoding for TTY sessions here. (Bug#12082)
+
+2012-07-29 Juri Linkov <juri@jurta.org>
+
+ * simple.el (goto-line): Don't display default line number in the
+ prompt because it should be displayed by `read-number' (bug#9952).
+ Add the current line number to the defaults of `goto-line' to
+ allow its easier modification by users with `M-n' (bug#9201).
+
+ * subr.el (read-number): Support multiple default values like in
+ other minibuffer reading functions. Replace `read' with
+ `string-to-number' for consistency with `number-to-string'.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ deactive->inactive, inactivate->deactivate spelling fixes (Bug#10150)
+ * emulation/viper-init.el (viper-deactivate-input-method-action):
+ Rename from viper-inactivate-input-method-action.
+ (viper-deactivate-input-method):
+ Rename from viper-inactivate-input-method.
+ * follow.el (follow-inactive-menu): Rename from follow-deactive-menu.
+ * international/mule-cmds.el (deactivate-input-method):
+ Rename from inactivate-input-method.
+ Also run input-method-deactivate-hook.
+ (deactivate-current-input-method-function):
+ Rename from inactivate-current-input-method-function.
+ (input-method-deactivate-hook): New hook.
+ (input-method-inactivate-hook): Mark obsolete.
+ (inactivate-input-method): Mark obsolete.
+
+ * international/quail.el (quail-activate):
+ Also run quail-deactivate-hook.
+ (quail-deactivate): Rename from quail-inactivate.
+ * international/robin.el (robin-activate):
+ Also run robin-deactivate-hook.
+ (robin-deactivate): Rename from robin-inactivate.
+
+2012-07-29 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (indicate-copied-region): New function.
+ (kill-ring-save): Split off from here.
+
+ * rect.el (copy-rectangle-as-kill): Call indicate-copied-region.
+ (kill-rectangle): Set deactivate-mark to t on read-only error.
+
+ * 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 <juri@jurta.org>
+
+ * simple.el (async-shell-command-buffer): New defcustom.
+ (shell-command): Use it. (Bug#4719)
+
+2012-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ * international/mule-cmds.el (set-locale-environment): In a
+ console session on MS-Windows, set up keyboard and terminal
+ encoding from the OEM codepage, not the ANSI codepage.
+ (Bug#12055)
+
+2012-07-28 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-place-breakpoints): Fix the call to
+ gdb-get-location.
+
+2012-07-28 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/cc-menus.el (cc-imenu-objc-function): Avoid leaving nil in
+ the alist (bug#12029).
+
+2012-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (custom-deps, finder-data, updates, compile)
+ (compile-always, compile-first)
+ ($(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, bootstrap)
+ ($(lisp)/progmodes/cc-mode.elc): Depend on $(lisp)subdirs.el,
+ instead of on update-subdirs.
+ (bootstrap-clean): Delete $(lisp)/subdirs.el.
+
+2012-07-28 Chong Yidong <cyd@gnu.org>
+
+ * vc/vc.el (vc-root-diff, vc-print-root-log): Prompt for a
+ directory if vc-deduce-backend returns nil (Bug#7350).
+
+ * simple.el (delete-trailing-lines): New option.
+ (delete-trailing-whitespace): Obey it (Bug#11879).
+
+2012-07-28 David Engster <deng@randomsample.de>
+
+ * xml.el (xml-node-name, xml-parse-file, xml-parse-region):
+ Explanation of new 'symbol-qnames feature in doc-strings.
+ (xml-maybe-do-ns): Return expanded names as plain symbols if
+ 'symbol-qnames was provided in XML-NS argument (Bug#11916).
+ (xml-parse-tag-1): Deal with new definition of PARSE-NS argument.
+
+2012-07-27 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Consistent completion in inferior python with emacs -nw.
+ * progmodes/python.el (inferior-python-mode): replace "<tab>"
+ binding in inferior-python-mode-map with "\t".
+ (python-shell-completion-complete-at-point)
+ (python-completion-complete-at-point): Remove interactive spec.
+
+2012-07-27 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calccomp.el (math-compose-expr): Undo previous change.
+
+2012-07-27 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * 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.
+ (python-shell-get-or-create-process): Do not pop python process
+ buffer.
+
+2012-07-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * notifications.el (notifications-on-action-signal)
+ (notifications-on-closed-signal): Use also the bus address for the map.
+ (notifications-notify, notifications-close-notification)
+ (notifications-get-capabilities): Add optional argument BUS.
+
+2012-07-27 Tassilo Horn <tsdh@gnu.org>
+
+ * 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.
+
+2012-07-27 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calccomp.el (math-compose-expr): Use parentheses when
+ there is a product in the denominator of a fraction.
+
+2012-07-26 Eli Zaretskii <eliz@gnu.org>
+
+ * 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
+ rewritten while the autoload files are built at the same time,
+ which needs to load subdirs.el.
+
+2012-07-26 Martin Rudalics <rudalics@gmx.at>
+
+ * mouse.el (popup-menu): Fix doc-string and re-indent code.
+ (mouse-drag-line): Don't exit tracking when a switch-frame or
+ switch-window event occurs (Bug#12006).
+
+2012-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el (popup-menu): Fix last change.
+
+2012-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Autoload from Lisp with more care. Follow aliases when looking for
+ function properties.
+ * subr.el (autoloadp): New function.
+ (symbol-file): Use it.
+ (function-get): New function.
+ * emacs-lisp/macroexp.el (macroexp--expand-all): Use function-get and
+ autoload-do-load.
+ * emacs-lisp/lisp-mode.el (lisp-font-lock-syntactic-face-function)
+ (lisp-indent-function):
+ * emacs-lisp/gv.el (gv-get):
+ * emacs-lisp/edebug.el (get-edebug-spec, edebug-basic-spec):
+ * emacs-lisp/byte-opt.el (byte-optimize-form):
+ * emacs-lisp/bytecomp.el (byte-compile-arglist-warn):
+ * emacs-lisp/autoload.el (make-autoload, autoload-print-form):
+ Use function-get.
+ * emacs-lisp/cl.el: Don't propagate function properties any more.
+
+ * speedbar.el (speedbar-add-localized-speedbar-support):
+ * emacs-lisp/disass.el (disassemble-internal):
+ * desktop.el (desktop-load-file):
+ * help-fns.el (help-function-arglist, find-lisp-object-file-name)
+ (describe-function-1):
+ * emacs-lisp/find-func.el (find-function-noselect):
+ * emacs-lisp/elp.el (elp-instrument-function):
+ * emacs-lisp/advice.el (ad-has-proper-definition):
+ * apropos.el (apropos-safe-documentation, apropos-macrop):
+ * emacs-lisp/debug.el (debug-on-entry):
+ * emacs-lisp/cl-macs.el (cl-compiler-macroexpand):
+ * emacs-lisp/byte-opt.el (byte-compile-inline-expand):
+ * calc/calc.el (name): Use autoloadp & autoload-do-load.
+
+2012-07-25 Alp Aker <alp.tekin.aker@gmail.com>
+
+ * international/mule-cmds.el (ucs-insert): Mark it as an obsolete
+ function, not an obsolete variable (Bug#12046).
+
+2012-07-25 Andreas Schwab <schwab@linux-m68k.org>
+
+ * faces.el (face-spec-reset-face): Fix last change. (Bug#12042)
+
+2012-07-25 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * emacs-lisp/pp.el (pp-display-expression): Select old selected
+ window only if it is still live (Bug#12034).
+
+2012-07-25 Martin Rudalics <rudalics@gmx.at>
+
+ * subr.el (redirect-frame-focus): Add advertised calling
+ convention (Bug#12030).
+
+2012-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer typical American spelling for "acknowledgment".
+ * vc/add-log.el (change-log-acknowledgment): Rename from
+ change-log-acknowledgement, with an alias for the old name.
+
+2012-07-25 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc-alg.el (math-simplify-divide): Don't cross multiply
+ in an equation when the lhs is a variable.
+
+2012-07-24 Julien Danjou <julien@danjou.info>
+
+ * net/netrc.el (netrc-find-service-number, netrc-store-data):
+ Remove, unused.
+
+2012-07-23 Eli Zaretskii <eliz@gnu.org>
+
+ * startup.el (command-line): Don't display an empty user name in
+ the error message about non-existent home directory, when
+ init-file-user was set to an empty string. See
+ http://lists.gnu.org/archive/html/bug-gnu-emacs/2012-07/msg00835.html
+ for the details and context.
+
+2012-07-22 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-cell-formula-aset): New macro.
+ (ses-cell-references-aset): New macro.
+ (ses-cell-p): New function.
+ (ses-rename-cell): Do no longer rely on complex operations like
+ ses-cell-set-formula or ses-set-cell to change the cell and handle
+ the undo at the same time, but rather use lower level new macros
+ `ses-cell-formula-aset' and `ses-cell-references-aset' and handle
+ the undo directly. Refresh the mode line.
+
+2012-07-21 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/cc-cmds.el (c-defun-name):
+ Use match-string-no-properties instead for consistency.
+
+2012-07-20 Leo Liu <sdl.web@gmail.com>
* progmodes/cc-cmds.el (c-defun-name): Handle objc selectors properly.
(Bug#7879)
- * progmodes/cc-langs.el (c-symbol-start): Include char _ (bug#11986).
+ * progmodes/cc-langs.el (c-symbol-start): Include char _ (bug#11986).
+
+2012-07-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * userlock.el, emacs-lisp/map-ynp.el: Declare part of `emacs' package.
+ * progmodes/bug-reference.el, misearch.el: Provide themselves
+ (bug#11915).
+
+ * progmodes/cperl-mode.el (cperl-unwind-to-safe): Don't inf-loop at end
+ of narrowed buffer (bug#11966).
+
+2012-07-20 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-rename-cell): Set new name also in reference list of
+ cells of which the renamed cell depends.
+
+2012-07-20 Masatake YAMATO <yamato@redhat.com>
+
+ * term/x-win.el (x-menu-bar-open): Use `frame-parameter'
+ to check whether menu-bar is shown or not. If not shown,
+ show the menu-bar as a popup menu instead of using tmm.
+ * mouse.el (popup-menu): Accept `point' as `position' argument.
+
+2012-07-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-parse-partial): No error when end
+ up inside string symbol literal (bug#11923).
+
+2012-07-20 Eli Zaretskii <eliz@gnu.org>
+
+ * startup.el (fancy-startup-text): Read the whole tutorial, not
+ just its first 256 bytes. Prevents gibberish in display of the
+ tutorial title.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Drop idle buffer compaction due to an absence of the
+ proved efficiency.
+ * compact.el: Remove.
+
+2012-07-19 Sam Steingold <sds@gnu.org>
+
+ * vc/vc-dispatcher.el (vc-compilation-mode): Add, based on
+ vc-bzr-pull & vc-bzr-merge-branch.
+ * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Use it.
+ (vc-bzr-error-regexp-alist): Rename from vc-bzr-error-regex-alist
+ for consistency with compilation-error-regexp-alist.
+ * vc/vc-git.el (vc-git-error-regexp-alist): Add.
+ (vc-git-pull, vc-git-merge-branch): Call vc-compilation-mode.
+ * vc/vc-hg.el (vc-hg-error-regexp-alist): Add.
+ (vc-hg-pull, vc-hg-merge-branch): Call vc-compilation-mode.
+
+2012-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/chart.el: Use lexical-binding.
+ (chart-emacs-storage): Don't hardcode the list of entries.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Next round of tweaks caused by Fgarbage_collect changes.
+ * emacs-lisp/chart.el (chart-emacs-storage): Adjust again.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Compact buffers when idle.
+ * compact.el: New file.
+
+2012-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (eventp): Presume that if it looks vaguely like an event,
+ it's an event (bug#10190).
+
+2012-07-19 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Enhancements to ppss related code (thanks Stefan).
+ * progmodes/python.el (python-indent-context)
+ (python-indent-calculate-indentation, python-indent-dedent-line)
+ (python-indent-electric-colon, python-nav-forward-block)
+ (python-mode-abbrev-table)
+ (python-info-assignment-continuation-line-p): Simplify checks
+ for ppss context.
+ (python-info-continuation-line-p): Cleanup.
+ (python-info-ppss-context): Do not catch 'quote.
+ (python-info-ppss-context-type)
+ (python-info-ppss-comment-or-string-p): Simplify.
+
+2012-07-18 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el: Enhancements to eldoc support.
+ (python-info-current-symbol): New function.
+ (python-eldoc-at-point): Use python-info-current-symbol.
+ (python-info-current-defun): Fix cornercase on first defun scan.
+ (python-eldoc--get-doc-at-point): Use python-info-current-symbol
+ and signal error when no inferior python process is available.
+
+2012-07-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-git.el (vc-git-state): Don't call `vc-git-registered',
+ assume it's always t.
+ (vc-git-registered): Remove caching, the function is only called
+ once.
+ (vc-git-branches): Use `vc-git--call' instead of `call-process'.
+
+2012-07-18 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (last-input-char, last-command-char): Remove (Bug#9195).
+
+ * simple.el (count-words): Report on narrowing (Bug#9959).
+
+ * bindings.el: Bind M-= to count-words.
+
+ * faces.el (face-spec-reset-face): Handle reverse video (Bug#4238).
+
+2012-07-18 Masatake YAMATO <yamato@redhat.com>
+
+ * progmodes/sh-script.el (sh-imenu-generic-expression):
+ Capture a function with `function' keyword and without parentheses
+ like "function FOO" (bug#11856).
+
+2012-07-18 Tassilo Horn <tassilo@member.fsf.org>
+
+ * window.el (split-window-sensibly): Make WINDOW argument
+ optional.
+
+2012-07-18 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (keyboard-translate): Doc fix (Bug#7261).
+
+ * isearch.el (isearch-mode-map): Handle C-x 8 key translations,
+ and make C-x 8 RET exit isearch (Bug#11439).
+
+ * international/iso-transl.el: Move isearch-mode-map key
+ definitions to isearch.el.
+
+2012-07-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el: Adapt further to gv.el (bug#11970).
+ (eieio-defclass): Use gv-define-setter when possible.
+
+2012-07-18 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Reflect recent changes in Fgarbage_collect.
+ * emacs-lisp/chart.el (chart-emacs-storage): Change to
+ reflect new format of data returned by Fgarbage_collect.
+
+2012-07-17 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ New utility functions + python-info-ppss-context fix (Bug#11910).
+ * progmodes/python.el (python-info-beginning-of-block-statement-p)
+ (python-info-ppss-comment-or-string-p): New functions.
+ (python-info-ppss-context): Small fix for string check.
+
+2012-07-17 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-do-async-shell-command): Doc fix.
+ (dired-do-async-shell-command): Don't add `*' at the end of the
+ command (Bug#11815).
+ (dired-do-shell-command): Doc fix.
+ (dired-shell-stuff-it): Strip the trailing "&" and ";" if any.
+ Join the individual commands using either "&" or ";" as the
+ separator depending on the values of these trailing characters.
+ At the end re-add the trailing "&". (Bug#10598)
+
+ * simple.el (async-shell-command): Sync the interactive spec with
+ `shell-command'. Doc fix.
+ (shell-command): Doc fix.
+
+2012-07-17 Juri Linkov <juri@jurta.org>
+
+ * descr-text.el (describe-char): Fix format args. (Bug#10129)
+
+2012-07-17 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ Final renames and doc fixes for movement commands (bug#11899).
+ * progmodes/python.el (python-nav-beginning-of-statement):
+ Rename from python-nav-statement-start.
+ (python-nav-end-of-statement): Rename from
+ python-nav-statement-end.
+ (python-nav-beginning-of-block): Rename from
+ python-nav-block-start.
+ (python-nav-end-of-block): Rename from python-nav-block-end.
+
+2012-07-17 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el (python-shell-send-string-no-output):
+ Allow accept-process-output to quit, keeping shell process ready for
+ future interactions (Bug#11868).
+
+2012-07-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-progv): Use a properly prefixed var name.
+
+ * emacs-lisp/elint.el (elint-find-args-in-code):
+ Use help-function-arglist, so as to handle lexical byte-code.
+
+ * progmodes/sh-script.el (sh-syntax-propertize-function): Fix last
+ change (bug#11826).
+
+2012-07-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cc-engine.el (c-forward-sws, c-backward-sws):
+ Avoid spuriously marking the buffer as modified because of c-is-sws.
+
+ * progmodes/sh-script.el (sh-syntax-propertize-function): Mark "${#VAR"
+ as not-a-comment (bug#11946).
+
+ * emacs-lisp/macroexp.el (macroexp-let2): Use more informative names
+ for uninterned vars.
+
+ * xt-mouse.el (xterm-mouse-translate-1, xterm-mouse-event-read):
+ Use read-event since we don't really want to read chars but bytes.
+
+ * textmodes/tex-mode.el (tex-font-lock-keywords-1): Highlight not only
+ $$..$$ but also $..$ using regexps (bug#11953).
+ Use tex-verbatim for \url and \path.
+ (tex-font-lock-keywords): Define as defconst like the others.
+ (tex-common-initialization): Don't use font-lock-syntax-table any more.
+
+2012-07-16 René Kyllingstad <Rene@Kyllingstad.com> (tiny change)
+
+ * international/mule-cmds.el (ucs-insert): Make it an obsolete
+ alias for insert-char.
+
+2012-07-16 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el: Simplified imenu implementation.
+ (python-nav-jump-to-defun): Remove command.
+ (python-mode-map): Use `imenu' instead.
+ (python-nav-list-defun-positions-cache)
+ (python-imenu-include-defun-type, python-imenu-make-tree)
+ (python-imenu-subtree-root-label, python-imenu-index-alist):
+ Remove vars.
+ (python-nav-list-defun-positions, python-nav-read-defun)
+ (python-imenu-tree-assoc, python-imenu-make-element-tree)
+ (python-imenu-make-tree, python-imenu-create-index):
+ Remove functions.
+ (python-mode): Update to interact with imenu by setting
+ `imenu-extract-index-name-function' only.
+
+2012-07-16 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el: Enhancements to navigation commands.
+ (python-nav-backward-sentence)
+ (python-nav-forward-sentence): Remove.
+ (python-nav-backward-statement, python-nav-forward-statement)
+ (python-nav-statement-start, python-nav-statement-end)
+ (python-nav-backward-block, python-nav-forward-block)
+ (python-nav-block-start, python-nav-block-end)
+ (python-nav-forward-sexp-function)
+ (python-info-current-line-comment-p)
+ (python-info-current-line-empty-p): New functions.
+ (python-indent-context): Use `python-nav-statement-start'.
+
+2012-07-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/em-ls.el (eshell/ls): Use `apply'.
+
+ * eshell/em-unix.el (eshell/su, eshell/sudo): Apply Tramp's ad-hoc
+ multi-hops, instead of Tramp internals.
+
+ * vc/ediff.el (ediff-directories): Add trailing space to prompts.
+
+ * vc/ediff-diff.el (ediff-same-file-contents): Handle the case,
+ when F1 and F2 are located on different hosts.
+
+2012-07-14 Chong Yidong <cyd@gnu.org>
+
+ * xt-mouse.el: Implement extended mouse coordinates (Bug#10642).
+ (xterm-mouse-translate): Move code into xterm-mouse-translate-1.
+ (xterm-mouse-translate-extended, xterm-mouse-translate-1)
+ (xterm-mouse--read-event-sequence-1000)
+ (xterm-mouse--read-event-sequence-1006): New functions. For old
+ mouse protocol, handle M-mouse-X events correctly.
+ (xterm-mouse-event): New arg specifying mouse protocol.
+ (turn-on-xterm-mouse-tracking-on-terminal)
+ (turn-off-xterm-mouse-tracking-on-terminal): Send DEC 1006
+ sequence to toggle extended coordinates on newer XTerms.
+ This appears to be harmless on terminals which do not support this.
+
+2012-07-14 Leo Liu <sdl.web@gmail.com>
+
+ Add fringe bitmap indicators for flymake. (Bug#11253)
+ * progmodes/flymake.el (flymake-highlight-line): Use fringe bitmaps.
+ (flymake-make-overlay): New arg BITMAP.
+ (flymake-error-bitmap, flymake-warning-bitmap)
+ (flymake-fringe-indicator-position): New user variables.
+
+ * fringe.el: New bitmap exclamation-mark.
+
+2012-07-14 Jan Djärv <jan.h.d@swipnet.se>
+
+ * progmodes/cc-cmds.el (c-defun-name): Recognize Objective-C methods
+ also (Bug#7879).
+
+2012-07-14 Chong Yidong <cyd@gnu.org>
+
+ * electric.el (electric-pair-post-self-insert-function): Fix pair
+ insertion in empty-region case (Bug#11520).
+
+2012-07-14 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el: Consolidate ctl-x-r-map bindings.
+ Bind copy-rectangle-as-kill to C-x r w.
+
+ * rect.el, register.el: Move bindings to bindings.el.
+
+2012-07-14 Reuben Thomas <rrt@sc3d.org>
+
+ * rect.el (copy-rectangle-as-kill): New command (Bug#739).
+
+2012-07-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacs-lisp/cl.el (labels): Remove spurious quote. (Bug#11938)
+
+2012-07-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * bindings.el (top): Use `mapc' instead of `mapcar'.
+
+ * loadup.el (top): Remove bogus `if' choice (brought by 2008-06-21T01:38:39Z!monnier@iro.umontreal.ca).
+
+2012-07-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * progmodes/sql.el (sql-comint): Suppress the check for program on
+ remote hosts. Reported by Francis Devereux <francis@devrx.org>.
+ (Bug#11908)
+
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el: Assign a non-nil permanent-local property to
+ per-buffer variables which lack a default value (Bug#11930).
+
+ * help-fns.el (describe-variable): In the "automatically becomes
+ local" notice, take note of permanent-local variables.
+
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * files.el (toggle-read-only): Doc fix and code cleanup. New arg
+ to allow printing the message when called from Lisp.
+
+ * emacs-lisp/bytecomp.el (byte-compile-interactive-only-functions):
+ Remove toggle-read-only.
+
+ * bs.el (bs-toggle-readonly):
+ * buff-menu.el (Buffer-menu-toggle-read-only):
+ Remove with-no-warnings around toggle-read-only.
+
+ * ffap.el (ffap--toggle-read-only): Accept a list of buffers.
+ Remove with-no-warnings around toggle-read-only.
+ (ffap-read-only, ffap-read-only-other-window)
+ (ffap-read-only-other-frame): Callers changed.
+
+ * help-mode.el: Don't require view package.
+ (help-mode-finish): Set buffer-read-only instead of calling
+ toggle-read-only.
+
+ * bindings.el (mode-line-toggle-read-only):
+ * dired.el (dired-toggle-read-only):
+ * ibuffer.el (ibuffer-do-toggle-read-only): Call toggle-read-only
+ with non-nil second arg.
+
+ * emacs-lisp/eieio-custom.el (eieio-customize-object):
+ * vc/ediff.el (ediff-set-read-only-in-buf-A): Set buffer-read-only
+ directly.
+
+2012-07-12 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-recompile-directory): Use cl-incf,
+ not incf.
+
+2012-07-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ More CL cleanups and reduction of use of cl.el.
+ * woman.el, winner.el, vc/vc-rcs.el, vc/vc-hooks.el, vc/vc-hg.el:
+ * vc/vc-git.el, vc/vc-dir.el, vc/vc-bzr.el, vc/vc-annotate.el:
+ * textmodes/tex-mode.el, textmodes/sgml-mode.el, tar-mode.el:
+ * strokes.el, ses.el, server.el, progmodes/js.el, progmodes/gdb-mi.el:
+ * progmodes/flymake.el, progmodes/ebrowse.el, progmodes/compile.el:
+ * play/tetris.el, play/snake.el, play/pong.el, play/landmark.el:
+ * play/hanoi.el, play/decipher.el, play/5x5.el, nxml/nxml-mode.el:
+ * net/secrets.el, net/quickurl.el, midnight.el, mail/footnote.el:
+ * image-dired.el, ibuffer.el, ibuf-macs.el, ibuf-ext.el, hexl.el:
+ * eshell/eshell.el, eshell/esh-io.el, eshell/esh-ext.el:
+ * eshell/esh-cmd.el, eshell/em-ls.el, eshell/em-hist.el:
+ * eshell/em-cmpl.el, eshell/em-banner.el:
+ * calendar/parse-time.el: Use cl-lib.
+ * wid-browse.el, wdired.el, vc/vc.el, vc/vc-mtn.el, vc/vc-cvs.el:
+ * vc/vc-arch.el, tree-widget.el, textmodes/texinfo.el:
+ * textmodes/refill.el, textmodes/css-mode.el, term/tvi970.el:
+ * term/ns-win.el, term.el, shell.el, ps-samp.el:
+ * progmodes/perl-mode.el, progmodes/pascal.el, progmodes/gud.el:
+ * progmodes/glasses.el, progmodes/etags.el, progmodes/cwarn.el:
+ * play/gamegrid.el, play/bubbles.el, novice.el, notifications.el:
+ * net/zeroconf.el, net/xesam.el, net/snmp-mode.el, net/mairix.el:
+ * net/ldap.el, net/eudc.el, net/browse-url.el, man.el:
+ * mail/mailheader.el, mail/feedmail.el: Don't use CL.
+ * ibuf-ext.el (ibuffer-mark-old-buffers): Use float-time.
+ * eshell/esh-opt.el (eshell-eval-using-options): Quote code with
+ `lambda' rather than with `quote'.
+ (eshell-do-opt): Adjust accordingly.
+ (eshell-process-option): Simplify.
+ * eshell/esh-var.el:
+ * eshell/em-script.el: Require `esh-opt' for eshell-eval-using-options.
+ * emacs-lisp/pcase.el (pcase--dontcare-upats, pcase--let*)
+ (pcase--expand, pcase--u1): Rename pcase's internal `dontcare' pattern
+ to `pcase--dontcare'.
+ * emacs-lisp/cl.el (labels): Mark obsolete.
+ (cl--letf, letf): Move to cl-lib.
+ (cl--letf*, letf*): Remove.
+ * emacs-lisp/cl-lib.el (cl-nth-value): Use defalias.
+ * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Add indent rule.
+ (cl-progv): Rewrite.
+ (cl--letf, cl-letf): Move from cl.el.
+ (cl-letf*): New macro.
+ * emacs-lisp/cl-extra.el (cl--progv-before, cl--progv-after): Remove.
+
+2012-07-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/ange-ftp.el (ange-ftp-cf1): Update the files cache.
+
+2012-07-11 Chong Yidong <cyd@gnu.org>
+
+ * vc/log-edit.el (log-edit-vc-backend): New variable.
+ (log-edit): Doc fix.
+
+ * vc/vc-dispatcher.el (vc-log-edit): New args. Use PARAMS
+ argument of log-edit to set up all local variables.
+ (vc-start-logentry): New optional arg specifying VC backend.
+
+ * vc/vc.el (vc-checkin): Use it.
+ (vc-deduce-fileset): Handle Log Edit buffers.
+ (vc-diff): Make first argument optional too.
+
+ * vc/log-view.el (log-view-vc-fileset, log-view-vc-backend): Doc fix.
+
+2012-07-10 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/esh-ext.el (eshell-remote-command): Remove remote part of
+ command, just in case. The function is not needed anymore.
+ (eshell-external-command): Do not call `eshell-remote-command'.
+
+2012-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Reduce use of (require 'cl).
+ * vc/smerge-mode.el, vc/pcvs.el, vc/pcvs-util.el, vc/pcvs-info.el:
+ * vc/diff-mode.el, vc/cvs-status.el, uniquify.el, scroll-bar.el:
+ * register.el, progmodes/sh-script.el, net/gnutls.el, net/dbus.el:
+ * msb.el, mpc.el, minibuffer.el, international/ucs-normalize.el:
+ * international/quail.el, info-xref.el, imenu.el, image-mode.el:
+ * font-lock.el, filesets.el, edmacro.el, doc-view.el, bookmark.el:
+ * battery.el, avoid.el, abbrev.el: Use cl-lib.
+ * vc/pcvs-parse.el, vc/pcvs-defs.el, vc/log-view.el, vc/log-edit.el:
+ * vc/diff.el, simple.el, pcomplete.el, lpr.el, comint.el, loadhist.el:
+ * jit-lock.el, international/iso-ascii.el, info.el, frame.el, bs.el:
+ * emulation/crisp.el, electric.el, dired.el, cus-dep.el, composite.el:
+ * calculator.el, autorevert.el, apropos.el: Don't require CL.
+ * emacs-lisp/bytecomp.el (byte-recompile-directory, display-call-tree)
+ (byte-compile-unfold-bcf, byte-compile-check-variable):
+ * emacs-lisp/byte-opt.el (byte-compile-trueconstp)
+ (byte-compile-nilconstp):
+ * emacs-lisp/autoload.el (make-autoload): Use pcase.
+ * face-remap.el (text-scale-adjust): Simplify pcase patterns.
+
+ * emacs-lisp/gv.el (cond): Make it a valid place.
+ (if): Simplify slightly.
+
+ * emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns".
+ (pcase--self-quoting-p): New function.
+ (pcase--u1): Use it.
+
+2012-07-10 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-fixed-entries):
+ (authors-renamed-files-alist): Update for configure.in -> configure.ac.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename configure.in to configure.ac (Bug#11603).
+ * emacs-lisp/authors.el (authors-canonical-file-name):
+ * progmodes/autoconf.el (autoconf-mode):
+ Prefer configure.ac to configure.in.
+
+2012-07-08 Chong Yidong <cyd@gnu.org>
+
+ * mouse.el (mouse-drag-line): Rewrite the track-mouse loop.
+ Implement the mouse-1-click-follows-link handling properly.
+
+ * info.el (Info-link-keymap): Use follow-link mechanism for
+ header-line links (Bug#374).
+
+ * simple.el (deactivate-mark): Do not set the primary selection
+ if another program has acquired it (Bug#11772).
+
+2012-07-07 Kevin Ryde <user42@zip.com.au>
+
+ * woman.el (woman-strings): Fix double-quote handling (Bug#1151).
+ (woman-decode-region): Replace escaped-escapes without destroying
+ bold or underline (Bug#11552).
+ (woman2-process-escapes): Handle nofill regions (Bug#11591).
+
+2012-07-07 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (yank-pop-change-selection): Doc fix (Bug#11361).
+ (interprogram-cut-function, interprogram-paste-function):
+ Mention that we typically mean the clipboard.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * kmacro.el (kmacro-call-macro): Restore repeat message. (Bug#11817)
+
+ * files.el (toggle-read-only): Restrict message to interactive use.
+
+2012-07-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-restricted-shell-hosts-alist): New defcustom.
+
+ * net/tramp-sh.el (tramp-maybe-open-connection): Handle it.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (compile-one-process): Rename from "recompile".
+
+ * Makefile.in (bzr-update): "compile" is the same as "recompile
+ autoloads", but parallelizable, so use that instead.
+
+2012-07-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ * window.el (quit-window): Always restore window height when
+ it's saved in quit-restore parameter (Bug#11810).
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (kill-whole-line): Doc tweak.
+
+2012-07-06 Eli Zaretskii <eliz@gnu.org>
+
+ * files.el (file-relative-name): Compare file names
+ case-insensitively if on MS-Windows or MS-DOS, or if
+ read-file-name-completion-ignore-case is non-nil. Don't use
+ case-fold-search for this purpose. (Bug#11827)
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * calendar/cal-dst.el (calendar-current-time-zone):
+ Return calendar-current-time-zone-cache if non-nil.
+
+2012-07-17 Masatake YAMATO <yamato@redhat.com>
+2012-07-06 Andreas Schwab <schwab@linux-m68k.org>
+
+ * calendar/cal-dst.el (calendar-current-time-zone):
+ Return calendar-current-time-zone-cache if non-nil.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (cvs-update): Remove old alias.
+
+2012-07-05 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6-pre.
+
+ * net/tramp.el (tramp-drop-volume-letter): Provide an XEmacs
+ compatible declaration.
+
+ * net/tramp-cmds.el (tramp-append-tramp-buffers):
+ Protect `list-load-path-shadows' call.
+
+ * net/tramp-compat.el (top): Require packages, which aren't
+ autoloaded anymore for XEmacs. Protect call of
+ `tramp-file-name-handler' by `tramp-compat-funcall', pacifying the
+ compiler. Do not require tramp-util.el and tramp-vc.el anymore,
+ it hurts at least for SXEmacs.
+ (tramp-compat-temporary-file-directory): In XEmacs, there is no
+ standard-value for `temporary-file-directory'.
+
+ * net/tramp-sh.el (tramp-do-directory-files-and-attributes-with-stat):
+ Redirect stderr to /dev/null.
+ (tramp-sh-handle-write-region): uid and gid can be floats.
+ Reported by Russell Sim <russell.sim@gmail.com>.
+ (tramp-sh-handle-vc-registered): Hide errors.
+ (tramp-vc-file-name-handler): Use dummy results for `process-file'
+ and `start-file-process'.
+ (tramp-maybe-open-connection): Check also whether `non-essential'
+ is bound.
+
+2012-07-04 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml--parse-buffer): Use xml-syntax-table.
+ (xml-parse-tag): Likewise, and avoid changing entity tables.
+ (xml-syntax-table): Define from scratch, making sure not to give
+ x2000 and other Unicode spaces whitespace syntax, since those are
+ not spaces in XML.
+ (xml-parse-fragment): Delete unused function.
+ (xml-name-start-char-re, xml-name-char-re, xml-name-re)
+ (xml-names-re, xml-nmtoken-re, xml-nmtokens-re, xml-char-ref-re)
+ (xml-entity-ref, xml-pe-reference-re)
+ (xml-reference-re,xml-att-value-re, xml-tokenized-type-re)
+ (xml-notation-type-re, xml-enumeration-re, xml-enumerated-type-re)
+ (xml-att-type-re, xml-default-decl-re, xml-att-def-re)
+ (xml-entity-value-re): Use syntax references in regexps where
+ possible; no need to define inside a let-binding.
+ (xml-parse-dtd): Use xml-pe-reference-re.
+ (xml-entity-or-char-ref-re): New defconst.
+ (xml-parse-string, xml-substitute-special): Use it.
+
+2012-07-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (locate-dominating-file): Allow `name' to be a predicate.
+ (find-file--read-only): New function.
+ (find-file-read-only, find-file-read-only-other-window)
+ (find-file-read-only-other-frame): Use it.
+ (insert-file-contents-literally): Don't `fset'.
+ (get-free-disk-space): Use locate-dominating-file.
+
+ * emacs-lisp/bytecomp.el (byte-compile): Don't signal an error if the
+ function is already compiled.
+
+ * xml.el (xml-name-regexp): Remove, redundant. Use xml-name-re.
+
+2012-07-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc/ediff-diff.el (ediff-same-file-contents): Fix it for remote
+ files on the same host.
+
+2012-07-03 Andreas Schwab <schwab@linux-m68k.org>
+
+ * help-fns.el (describe-function-1): Only call
+ help-fns--autoloaded-p when we have a file name. (Bug#11848)
+
+2012-07-03 Chong Yidong <cyd@gnu.org>
+
+ * xml.el: Protect parser against XML bombs.
+ (xml-entity-expansion-limit): New variable.
+ (xml-parse-string, xml-substitute-special): Use it.
+ (xml-parse-dtd): Avoid infloop if the DTD is not terminated.
+
+2012-07-03 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/bug-reference.el (bug-reference-bug-regexp):
+ Allow linking to specific messages in debbugs reports (eg 123#5).
+
+2012-07-02 Chong Yidong <cyd@gnu.org>
+
+ * xml.el: Fix entity and character reference expansion, allowing
+ them to expand into markup as per XML spec.
+ (xml-default-ns): New variable.
+ (xml-entity-alist): Use XML spec definitions for lt and amp.
+ (xml-parse-region): Make first two arguments optional.
+ Discard text properties.
+ (xml-parse-tag-1): New function, spun off from xml-parse-tag.
+ All callers changed.
+ (xml-parse-tag): Call xml-parse-tag-1. For backward
+ compatibility, this function should not modify buffer contents.
+ (xml-parse-tag-1): Fix opening-tag regexp.
+ (xml-parse-string): Rewrite, handling entity and character
+ references properly.
+ (xml--entity-replacement-text): Signal an error if a parameter
+ entity is undefined.
+
+2012-07-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * comint.el (comint-output-filter): Filter out repeated prompts.
+
+ * net/ange-ftp.el (ange-ftp-expand-file-name): Use ange-ftp-ftp-name
+ and file-name-absolute-p.
+ (ange-ftp-file-exists-p): Use ange-ftp-file-exists-p for
+ internal calls.
+
+2012-07-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * emacs-lisp/bytecomp.el (byte-compile--reify-function):
+ Rename from byte-compile--refiy-function. All uses changed.
+
+2012-07-01 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml--parse-buffer): New function. Move most of
+ xml-parse-region here.
+ (xml-parse-region): Copy region into a temporary buffer, since
+ parameter entity substitution requires changing buffer contents.
+ Use xml--parse-buffer.
+ (xml-parse-file): Use xml--parse-buffer.
+ (xml-parse-dtd): Make parameter entity substitution work right.
+ Use proper regexps for ELEMENT declarations (Bug#7172).
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * comint.el (follow-comint-scroll-to-bottom): Fix declaration.
+
+ * net/secrets.el, net/tramp-gvfs.el, net/xesam.el, net/zeroconf.el:
+ Remove outdated and unnecessary dbus declarations.
+
+2012-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs-lisp/timer.el (timer-until): Subtract results of
+ float-time, instead of taking float-time of the result of
+ time-subtract, since float-time signals an error for negative time
+ arguments.
+
+2012-06-30 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml-*-re): Convert defvars into defconsts, and
+ eval-and-compile them so eval-and-compile works on derivatives.
+ (xml--entity-replacement-text): Use eval-and-comple.
+
+2012-06-30 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc/vc-git.el (vc-git-registered): Use cache property
+ `git-registered'.
+ (vc-git-mode-line-string): Call `vc-working-revision' instead of
+ `vc-git-working-revision' in order to benefit from the cache.
+ (vc-git-root): Use cache property `git-root'. (Bug#11757)
+
+2012-06-30 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-hooks.el (vc-before-save): Clear cache if file has been
+ removed (likely outside Emacs). (Bug#11757)
+
+2012-06-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el: Require macroexp.
+
+2012-06-30 Chong Yidong <cyd@gnu.org>
+
+ * xml.el: Implement XML parameter entities.
+ (xml-parameter-entity-alist): New variable.
+ (xml-parse-region, xml-parse-fragment): Preserve previous values
+ of xml-entity-alist and xml-parameter-entity-alist, so that
+ repeated calls on different documents do not change them.
+ (xml-parse-tag): Fix doctype regexp.
+ (xml--entity-replacement-text): New function.
+ (xml-parse-dtd): Use it. Don't handle system entities; doing that
+ properly requires url retrieval which is unimplemented.
+ (xml-escape-string): Doc fix.
+
+2012-06-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el (cl-pushnew): Use macroexp-let2.
+
+2012-06-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * fringe.el (fringe-mode): Doc fix.
+
+2012-06-29 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/ange-ftp.el (ange-ftp-get-passwd): Throw if `non-essential'
+ is non-nil.
+ (ange-ftp-ignore-errors-if-non-essential): New defmacro.
+ (ange-ftp-file-name-all-completions): Use it. (Bug#11808)
+
+2012-06-29 Andreas Schwab <schwab@linux-m68k.org>
+
+ * calendar/cal-dst.el (calendar-current-time-zone):
+ Return calendar-current-time-zone-cache if non-nil.
+
+2012-06-29 Masatake YAMATO <yamato@redhat.com>
+
+ * progmodes/which-func.el (which-func-format):
+ Add mouse-face. (Bug#11698)
+
+2012-06-29 Leo Liu <sdl.web@gmail.com>
+
+ * textmodes/enriched.el (enriched-next-annotation): Use eq (Bug#11528).
+
+2012-06-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (minibuffer-confirm-exit-commands):
+ Add completion-at-point (bug#11725).
+
+2012-06-29 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/f90.el (f90-font-lock-keywords-2):
+ Add some preprocessor elements. (Bug#10499)
+
+2012-06-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cperl-mode.el (cperl-update-syntaxification):
+ Use syntax-propertize (bug#11739).
+
+2012-06-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/cl-lib.el (cl-pushnew): Don't capture X (bug#11811).
+
+2012-06-28 Julien Danjou <julien@danjou.info>
+
+ * term.el (term-handle-colors-array): Use a set of new faces to
+ color the terminal. Also uses :inverse-video property.
+ (term-default-fg-color): Set to nil by default, deprecate in favor
+ of `term-face'.
+ (term-default-bg-color): Set to nil by default, deprecate in favor
+ of `term-face'.
+ (term-current-face): Use `term-face' by default.
+ (term-bold-attribute): Variable deleted.
+
+2012-06-28 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (completion-list-mode-finish):
+ Don't use toggle-read-only. (Since completion-list-mode has
+ a special mode-class, it wasn't doing anything extra anyway.)
+
+2012-06-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Make inlining of other-mode interpreted functions work (bug#11799).
+ * emacs-lisp/bytecomp.el (byte-compile--refiy-function): New fun.
+ (byte-compile): Use it to fix compilation of lexical-binding closures.
+ * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Compile the
+ function, if needed.
+
+2012-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-mode.el (help-make-xrefs): Don't just withstand
+ cyclic-variable-indirection but any error in documentation-property.
+
+ * loadup.el (purify-flag): Pre-grow the hash-table to reduce the
+ memory use.
+ * bindings.el (bindings--define-key): New function.
+ * vc/vc-hooks.el, replace.el, menu-bar.el, international/mule-cmds.el:
+ * emacs-lisp/lisp-mode.el, buff-menu.el, bookmark.el:
+ * bindings.el: Use it to purecopy define-key bindings.
+
+ * textmodes/rst.el (rst-adornment-faces-alist): Avoid copy-list.
+
+ * emacs-lisp/cl.el (flet): Mark obsolete.
+ * emacs-lisp/cl-macs.el (cl-flet*): New macro.
+ * vc/vc-rcs.el (vc-rcs-annotate-command, vc-rcs-parse):
+ * progmodes/js.el (js-c-fill-paragraph):
+ * progmodes/ebrowse.el (ebrowse-switch-member-buffer-to-sibling-class)
+ (ebrowse-switch-member-buffer-to-derived-class):
+ * play/5x5.el (5x5-solver): Use cl-flet.
+
+ * emacs-lisp/cl.el: Use lexical-binding. Fix flet (bug#11780).
+ (cl--symbol-function): New macro.
+ (cl--letf, cl--letf*): Use it.
+
+ * emacs-lisp/easy-mmode.el (easy-mmode-pretty-mode-name):
+ Strip "toggle-" if any.
+
+2012-06-27 Glenn Morris <rgm@gnu.org>
+
+ * info.el (Info-default-directory-list): Move here from paths.el.
+ * paths.el: Remove file, which is now empty.
+ * loadup.el: No longer load "paths".
+
+ * custom.el (custom-initialize-delay): Doc fix.
+
+ * eshell/em-alias.el, eshell/em-banner.el, eshell/em-basic.el:
+ * eshell/em-cmpl.el, eshell/em-dirs.el, eshell/em-glob.el:
+ * eshell/em-hist.el, eshell/em-ls.el, eshell/em-pred.el:
+ * eshell/em-prompt.el, eshell/em-rebind.el, eshell/em-script.el:
+ * eshell/em-smart.el, eshell/em-term.el, eshell/em-unix.el:
+ * eshell/em-xtra.el: Replace eshell-defgroup with "(progn (defgroup".
+ * eshell/eshell.el (eshell-defgroup): Remove alias.
+
+2012-06-27 Chong Yidong <cyd@gnu.org>
+
+ * help.el (help-enable-auto-load): New variable.
+
+ * help-fns.el (help-fns--autoloaded-p): New function.
+ (describe-function-1): Refer to a function as "autoloaded" if it
+ was autoloaded at any time in the past. Perform autoloading if
+ help-enable-auto-load is non-nil.
+
+2012-06-26 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (compile, compile-always): Depend on
+ update-subdirs, not on subdirs.el. Otherwise, several different
+ sub-targets of 'bootstrap' running in parallel could
+ simultaneously write to subdirs.el, producing a garbled file.
+
+2012-06-26 Sam Steingold <sds@gnu.org>
+
+ * files.el (file-name-base): New convenience function.
+ * autoinsert.el, cus-dep.el, doc-view.el, image-dired.el:
+ * woman.el, eshell/esh-cmd.el, progmodes/ada-xref.el:
+ * progmodes/cc-defs.el, progmodes/cperl-mode.el:
+ * progmodes/flymake.el, progmodes/gud.el, progmodes/idlwave.el:
+ * textmodes/ispell.el, textmodes/reftex-ref.el:
+ * textmodes/tex-mode.el: Use it.
+ Did not touch cedet and org because they are maintained elsewhere.
+
+2012-06-26 Martin Rudalics <rudalics@gmx.at>
+
+ * calendar/calendar.el (calendar-exit): Don't try to delete or
+ iconify last frame. See:
+ http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00372.html
+
+2012-06-25 Jim Diamond <Jim.Diamond@AcadiaU.ca> (tiny change)
+
+ * server.el (server-process-filter): Remember dir in the
+ process's `server-client-directory' properties.
+
+2012-06-24 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml-parse-tag): Correctly handle comment embedded in
+ non-tag text.
+
+2012-06-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (COMPILE_FIRST): Synch with changes in 2012-06-22T21:24:54Z!monnier@iro.umontreal.ca.
+
+2012-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-fns.el (describe-variable): Don't croak when doc is not found.
+ * vc/pcvs.el (cvs-retrieve-revision): Avoid toggle-read-only.
+ * menu-bar.el (menu-bar-line-wrapping-menu): Purecopy a tiny bit more.
+ * emacs-lisp/syntax.el (syntax-ppss): Simplify with new `if' place.
+ * emacs-lisp/smie.el (smie-next-sexp): CSE.
+ * emacs-lisp/macroexp.el (macroexp-let2): Fix edebug spec and avoid
+ ((lambda ..) ..).
+ * emacs-lisp/eieio.el (eieio-oref, slot-value): Use simpler defsetf.
+
+2012-06-23 Chong Yidong <cyd@gnu.org>
+
+ * info.el (Info-mouse-follow-link): Accept symbol values of
+ link-args. Select window; suggested by Gerhard Kahl (Bug#11672).
+ (Info-fontify-node): Use Info-link-keymap for all navigation
+ buttons, with link-args property to perform the desired action.
+ (Info-link-keymap): Doc fix.
+ (Info-next-link-keymap, Info-prev-link-keymap)
+ (Info-up-link-keymap): Delete now-unused keymaps.
+
+2012-06-23 Chong Yidong <cyd@gnu.org>
+
+ * mouse.el (mouse-drag-track): Deactivate the mark before popping.
+
+ * progmodes/python.el (python-skeleton-define): Mark abbrevs as
+ system abbrevs.
+
+ * ansi-color.el (ansi-color-apply-on-region): Doc fix.
+
+2012-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--make-usage-args): Handle improper lists
+ (bug#11719).
+
+ * minibuffer.el (completion--twq-try): Try to fail more gracefully when
+ the requote function doesn't work properly (bug#11714).
+
+2012-06-23 Glenn Morris <rgm@gnu.org>
+
+ * pcmpl-rpm.el (pcmpl-rpm-packages): Give status messages.
+
+2012-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Further GV/CL cleanups.
+ * emacs-lisp/gv.el (gv-get): Autoload functions to find their
+ gv-expander.
+ (gv--defun-declaration): New function.
+ (defun-declarations-alist): Use it.
+ (gv-define-modify-macro, gv-pushnew!, gv-inc!, gv-dec!): Remove.
+ (gv-place): Autoload.
+ * emacs-lisp/cl.el (cl--dotimes, cl--dolist): Remember subr.el's
+ original definition of dotimes and dolist.
+ * emacs-lisp/cl-macs.el (cl-expr-access-order): Remove unused.
+ (cl-dolist, cl-dotimes): Use `dolist' and `dotimes'.
+ * emacs-lisp/cl-lib.el: Move gv handlers from cl-macs to here.
+ (cl-fifth, cl-sixth, cl-seventh, cl-eighth)
+ (cl-ninth, cl-tenth): Move gv handler to the function's definition.
+ * emacs-lisp/cl-extra.el (cl-subseq, cl-get, cl-getf): Move gv handler
+ to the function's definition.
+ * Makefile.in (COMPILE_FIRST): Re-order to speed it up by about 50%.
+ * window.el:
+ * files.el:
+ * faces.el:
+ * env.el: Don't use CL.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+
+ * calendar/time-date.el (with-decoded-time-value): New arg
+ PICO-SYMBOL in VARLIST. It's optional, for backward compatibility.
+ (encode-time-value): New optional arg PICO. New type 3.
+ (time-to-seconds) [!float-time]: Support the new picoseconds
+ component if it's used.
+ (seconds-to-time, time-subtract, time-add):
+ Support ps-resolution time stamps as well.
+
+ * emacs-lisp/timer.el (timer): New component psecs. All uses changed.
+ (timerp): Timer vectors now have length 9, not 8.
+ (timer--time): Support new-style (4-part) time stamps.
+ (timer-next-integral-multiple-of-time): Time stamps now have
+ picosecond resolution, so take a bit more care about rounding.
+ (timer-relative-time, timer-inc-time): New optional arg psecs.
+ (timer-set-time-with-usecs): Set psecs to 0.
+ (timer--activate): Check psecs component, too.
+
+ * proced.el (proced-time-lessp): Support ps-resolution stamps.
+
+2012-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * icomplete.el (icomplete-minibuffer-setup, icomplete-completions):
+ Move the non-essential binding to the post/pre-command-hook where it is
+ more obviously correct.
+
+ * subr.el (read-passwd): Don't use a history at all.
+ * savehist.el (savehist-save): Remove password saved accidentally
+ because of the above bug.
+
+2012-06-22 Bastien Guerry <bzg@gnu.org>
+
+ * files.el (toggle-read-only): Display a message telling whether
+ the buffer is read-only or not (bug#11726).
+
+2012-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/gv.el: New file.
+ * subr.el (push, pop): Extend to generalized variables.
+ * loadup.el (macroexp): Unload if preloaded and uncompiled (bug#11657).
+ * emacs-lisp/cl-lib.el (cl-pop, cl-push, cl--set-nthcdr): Remove.
+ * emacs-lisp/cl-macs.el: Require gv. Use gv-define-setter,
+ gv-define-simple-setter, and gv-define-expander.
+ Remove setf-methods defined in gv. Rename cl-setf -> setf.
+ (cl-setf, cl-do-pop, cl-get-setf-method): Remove.
+ (cl-letf, cl-letf*, cl-define-modify-macro, cl-defsetf)
+ (cl-define-setf-expander, cl-struct-setf-expander): Move to cl.el.
+ (cl-remf, cl-shiftf, cl-rotatef, cl-callf, cl-callf2): Rewrite with
+ gv-letplace.
+ (cl-defstruct): Don't define setf-method any more.
+ * emacs-lisp/cl.el (flet): Don't autoload.
+ (cl--letf, letf, cl--letf*, letf*, cl--gv-adapt)
+ (define-setf-expander, defsetf, define-modify-macro)
+ (cl-struct-setf-expander): Move from cl-lib.el.
+ * emacs-lisp/syntax.el:
+ * emacs-lisp/ewoc.el:
+ * emacs-lisp/smie.el:
+ * emacs-lisp/cconv.el:
+ * emacs-lisp/timer.el: Rename cl-setf -> setf, cl-push -> push.
+ (timer--time): Use gv-define-simple-setter.
+ * emacs-lisp/macroexp.el (macroexp-let2): Rename from macroexp-let²
+ to avoid coding-system problems in subr.el. Adjust all users.
+ (macroexp--maxsize, macroexp-small-p): New functions.
+ * emacs-lisp/bytecomp.el (byte-compile-file): Don't use cl-letf.
+ * scroll-bar.el (scroll-bar-mode):
+ * simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode)
+ (normal-erase-is-backspace-mode): Don't use the `eq' place.
+ * winner.el (winner-configuration, winner-make-point-alist)
+ (winner-set-conf, winner-get-point, winner-set): Don't abuse letf.
+ * files.el (locate-file-completion-table): Avoid list*.
+
+2012-06-22 Chong Yidong <cyd@gnu.org>
+
+ * dired-aux.el (dired-do-create-files): Doc fix (Bug#11327).
+ (dired-create-files): Doc fix (Bug#11329).
+ (dired-do-copy): Doc fix (Bug#11334).
+ (dired-mark-read-string): Doc fix (Bug#11553).
+
+ * dired.el (dired-recursive-copies, dired-recursive-deletes):
+ Doc fix (Bug#11326).
+ (dired-make-relative): Doc fix (Bug#11332). Remove unused arg.
+ (dired-dwim-target): Doc fix.
+
+ * wdired.el (wdired-mode): Doc fix.
+
+2012-06-22 Glenn Morris <rgm@gnu.org>
+
+ * pcmpl-rpm.el (pcmpl-rpm-cache): New option.
+ (pcmpl-rpm-cache-stamp-file): New constant.
+ (pcmpl-rpm-cache-time, pcmpl-rpm-packages): New variables.
+ (pcmpl-rpm-packages): Optionally cache list of packages.
+
+ * pcmpl-rpm.el (pcmpl-rpm): New group.
+ (pcmpl-rpm-query-options): New option.
+ (pcmpl-rpm-packages): No need to inline it.
+ Use pcmpl-rpm-query-options.
+
+ * calendar/calendar.el (calendar-in-read-only-buffer):
+ Avoid some needless mode changes.
+
+2012-06-21 Chong Yidong <cyd@gnu.org>
+
+ * desktop.el (desktop-read): Don't prompt if daemon (Bug#11674).
+ (desktop-path): Remove . from the default value (Bug#10977).
+ (desktop-read): Use user-emacs-directory if desktop-path is nil.
+
+2012-06-20 Chong Yidong <cyd@gnu.org>
+
+ * term.el (term-send-raw-meta): Make C-M-<char> keys work (Bug#8172).
+
+2012-06-20 David Röthlisberger <david@rothlis.net> (tiny change)
+
+ * ido.el (ido-switch-buffer, ido-find-file): Fix up doc of C-j
+ (bug#11201).
+
+2012-06-20 Chong Yidong <cyd@gnu.org>
+
+ * term.el (term-window-width): Handle the case of a missing right
+ fringe (Bug#8837).
+ (term-check-size): Use window-text-height (Bug#5445).
+ (term-mode): Use define-derived-mode. Minor cleanups.
+ Set font-lock-defaults (Bug#7692).
+ (term-move-columns, term-insert-char, term-emulate-terminal)
+ (term-erase-in-line, term-insert-spaces): Use font-lock-face.
+
+2012-06-20 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/ange-ftp.el (ange-ftp-get-passwd):
+ Bind `enable-recursive-minibuffers'.
+ (ange-ftp-get-process): Throw if `non-essential' is non-nil.
+
+2012-06-19 David Röthlisberger <david@rothlis.net> (tiny change)
+
+ * ido.el (ido-find-file): Mention C-d binding in docstring (bug#11244).
+
+2012-06-19 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/python.el (python-mode): Derive from prog-mode.
+
+2012-06-19 Kevin Gallagher <Kevin.Gallagher@boeing.com>
+
+ * emulation/edt.el (edt-default-menu-bar-update-buffers)
+ (edt-user-menu-bar-update-buffers): New functions.
+ (edt-default-emulation-setup, edt-user-emulation-setup): Use them.
+
+2012-06-19 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (with-selected-window): Preserve the selected window's
+ terminal's top-frame (Bug#4702).
+
+ * window.el (save-selected-window): Likewise.
+
+2012-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-rx-constituents): Move backquote.
+ (python-skeleton-define, python-define-auxiliary-skeleton):
+ Use `declare'.
+
+2012-06-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * minibuffer.el (read-file-name-default): Revert the patch from
+ 2012-06-17.
+
+2012-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--expand): Warn for unused pattern.
+ (pcase--u1, pcase--q1): Don't use apply-partially.
+
+2012-06-18 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/python.el (python-proc, python-buffer)
+ (python-send-receive, python-send-string): Fix obsolete versions.
+
+2012-06-18 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (special-display-p): Completely remove stringp
+ check. Suggested by Andreas Schwab <schwab@linux-m68k.org>.
+
+2012-06-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * minibuffer.el (read-file-name-default): Bind `non-essential' to `t'.
+
+ * net/tramp.el (tramp-file-name-handler): Catch 'non-essential.
+
+ * net/ange-ftp.el (ange-ftp-gwp-start, ange-ftp-start-process):
+ * net/tramp-sh.el (tramp-maybe-open-connection):
+ Throw if `non-essential' is non-nil.
+
+2012-06-17 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (special-display-p): Signal an error if BUFFER-NAME
+ is not a string (Bug#11713).
+
+2012-06-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * progmodes/python.el (python-info-beginning-of-backslash):
+ Rename from python-info-beginning-of-backlash, as a spelling fix.
+
+2012-06-17 Chong Yidong <cyd@gnu.org>
+
+ * term.el (term-emulate-terminal): If term-check-size is called,
+ move point to the process mark without resetting point (Bug#4635).
+
+2012-06-17 Glenn Morris <rgm@gnu.org>
+
+ * international/mule-cmds.el (mule-menu-keymap)
+ (set-language-environment, set-locale-environment): Doc tweaks.
+
+2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com>
+
+ * cus-face.el (custom-face-attributes): Add wave-style underline
+ attribute.
+ * faces.el (set-face-attribute): Update docstring to describe
+ wave-style underline attribute.
+
+2012-06-16 Chong Yidong <cyd@gnu.org>
+
+ * term/xterm.el (terminal-init-xterm): Discard input before
+ querying background mode (Bug#10959).
+
+2012-06-16 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Added and corrected some comments.
+ (rst-re-alist-def): Improve symbol syntax.
+ (rst-mode-syntax-table): Correct syntax entries.
+ (rst-cvs-header, rst-svn-rev, rst-svn-timestamp)
+ (rst-official-version, rst-official-cvs-rev): Update version
+ information.
+
+2012-06-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (COMPILE_FIRST): Synch with makefile.in changes
+ in 2008-06-22T13:57:28Z!monnier@iro.umontreal.ca.
+
+2012-06-15 Fabián Ezequiel Gallina <fgallina@cuca>
+
+ * progmodes/python.el: New python.el merge.
+ (python-guess-indent): Obsolete var.
+ (python-indent-guess-indent-offset): New defcustom.
+ (python-indent): Obsolete var.
+ (python-indent-offset): New defcustom.
+ (python-python-command, python-jython-command): Delete var.
+ (python-shell-interpreter): New defcustom.
+ (python-pdbtrack-do-tracking-p): Delete var.
+ (python-pdbtrack-activate): New defcustom.
+ (python-use-skeletons): Obsolete var.
+ (python-skeleton-autoinsert): New defcustom.
+ (inferior-python-filter-regexp, python-continuation-offset)
+ (python-honour-comment-indentation, python-indent-string-contents)
+ (python-jython-packages, python-mode-hook)
+ (python-pdbtrack-minor-mode-string, python-remove-cwd-from-path)
+ (python-shell-prompt-alist)
+ (python-source-modes): Delete defcustoms.
+ (python-check-buffer-name, python-eldoc-setup-code)
+ (python-eldoc-string-code, python-ffap-setup-code)
+ (python-ffap-string-code, python-fill-comment-function)
+ (python-fill-decorator-function, python-fill-paren-function)
+ (python-fill-string-function, python-imenu-include-defun-type)
+ (python-imenu-make-tree, python-imenu-subtree-root-label)
+ (python-pdbtrack-stacktrace-info-regexp, python-shell-buffer-name)
+ (python-shell-compilation-regexp-alist)
+ (python-shell-completion-module-string-code)
+ (python-shell-completion-pdb-string-code)
+ (python-shell-completion-setup-code)
+ (python-shell-completion-string-code)
+ (python-shell-enable-font-lock, python-shell-exec-path)
+ (python-shell-extra-pythonpaths)
+ (python-shell-internal-buffer-name, python-shell-interpreter-args)
+ (python-shell-process-environment)
+ (python-shell-prompt-block-regexp)
+ (python-shell-prompt-output-regexp)
+ (python-shell-prompt-pdb-regexp, python-shell-prompt-regexp)
+ (python-shell-send-setup-max-wait, python-shell-setup-codes)
+ (python-shell-virtualenv-path): New defcustoms.
+ (brm-menu, eldoc-documentation-function, inferior-python-mode-map)
+ (inferior-python-mode-syntax-table, python--prompt-regexp)
+ (python-buffer, python-command python-python-command)
+ (python-default-template, python-imports, python-indent-index)
+ (python-indent-list, python-indent-list-length)
+ (python-mode-running, python-pdbtrack-is-tracking-p)
+ (python-preoutput-continuation, python-preoutput-leftover)
+ (python-preoutput-result, python-preoutput-skip-next-prompt)
+ (python-prev-dir/file, python-recursing)
+ (python-saved-check-command, python-version-checked)
+ (python-which-func-length-limit)
+ (view-return-to-alist): Delete vars.
+ (python-check-custom-command, python-dotty-syntax-table)
+ (python-imenu-index-alist, python-indent-current-level)
+ (python-indent-dedenters, python-indent-levels)
+ (python-nav-beginning-of-defun-regexp)
+ (python-nav-list-defun-positions-cache)
+ (python-pdbtrack-buffers-to-kill, python-pdbtrack-tracked-buffer)
+ (python-shell-internal-buffer)
+ (python-skeleton-available): New vars.
+ (def-python-skeleton): Delete macro.
+ (python-skeleton-define): New macro.
+ (python-define-auxiliary-skeleton, python-rx): New macros.
+ (python-insert-class): Delete command.
+ (python-skeleton-class): New command.
+ (python-insert-def): Delete command.
+ (python-skeleton-def): New command.
+ (python-insert-for): Delete command.
+ (python-skeleton-for): New command.
+ (python-insert-if): Delete command.
+ (python-skeleton-if): New command.
+ (python-insert-try/except, python-insert-try/finally): Delete commands.
+ (python-skeleton-try): New command.
+ (python-insert-while): Delete command.
+ (python-skeleton-while): New command.
+ (python-backspace): Delete command.
+ (python-indent-dedent-line-backspace): New command.
+ (python-electric-colon): Delete command.
+ (python-indent-electric-colon): New command.
+ (python-guess-indent): Delete command.
+ (python-indent-guess-indent-offset): New command.
+ (python-shift-left): Delete command.
+ (python-indent-shift-left): New command.
+ (python-shift-right): Delete command.
+ (python-indent-shift-right): New command.
+ (python-find-function): Delete command.
+ (python-nav-jump-to-defun): New command.
+ (python-next-statement): Delete command.
+ (python-nav-forward-sentence): New command.
+ (python-previous-statement): Delete command.
+ (python-nav-backward-sentence): New command.
+ (python-fill-paragraph): Delete command.
+ (python-fill-paragraph-function): New command.
+ (python-send-buffer): Delete command.
+ (python-shell-send-buffer): New command.
+ (python-send-defun): Delete command.
+ (python-shell-send-defun): New command.
+ (python-send-region, python-send-region-and-go): Delete commands.
+ (python-shell-send-region)
+ (python-shell-switch-to-shell): New commands.
+ (python-send-string): Delete command.
+ (python-shell-send-string): New command.
+ (python-switch-to-python): Delete command.
+ (python-shell-switch-to-shell): New command.
+ (python-describe-symbol): Delete command.
+ (python-eldoc-at-point): New command.
+ (python--set-prompt-regexp, python-args-to-list)
+ (python-after-info-look, python-check-version)
+ (python-check-comint-prompt, python-find-imports)
+ (python-execute-file, turn-off-pdbtrack, turn-on-pdbtrack)
+ (python-unload-function, python-expand-template)
+ (python-maybe-jython, python-preoutput-filter)
+ (python-pdbtrack-get-source-buffer)
+ (python-pdbtrack-grub-for-buffer, python-pdbtrack-overlay-arrow)
+ (python-pdbtrack-toggle-stack-tracking)
+ (python-pdbtrack-track-stack-file, python-initial-text)
+ (python-first-word, python-comment-line-p, python-send-command)
+ (python-setup-brm, python-sentinel, python-set-proc)
+ (python-skip-out, python-input-filter, python-outdent-p)
+ (python-outline-level, python-backslash-continuation-line-p)
+ (python-end-of-block, python-end-of-statement, python-mark-block)
+ (python-beginning-of-block, python-beginning-of-statement)
+ (python-blank-line-p, python-beginning-of-string)
+ (python-open-block-statement-p): Delete functions.
+ (python-indent-line, python-indent-line-1): Delete functions.
+ (python-indent-line): New function.
+ (python-indentation-levels): Delete function.
+ (python-indent-calculate-levels): New function.
+ (python-proc): Delete function.
+ (python-shell-get-process): New function.
+ (python-send-receive): Delete function.
+ (python-shell-send-string-no-output): New function.
+ (python-module-path): Delete function.
+ (python-ffap-module-path): New function.
+ (python-completion-at-point)
+ (python-symbol-completions): Delete functions.
+ (python-completion-complete-at-point): New function.
+ (python-load-file): Delete function.
+ (python-shell-send-file): New function.
+ (python-calculate-indentation): Delete function.
+ (python-indent-calculate-indentation): New function.
+ (python-skip-comments/blanks): Delete function.
+ (python-util-forward-comment): New function.
+ (python-continuation-line-p): Delete function.
+ (python-info-continuation-line-p): New function.
+ (python-which-func, python-current-defun): Delete function.
+ (python-info-current-defun): New function.
+ (python-beginning-of-defun): Delete function.
+ (python-nav-beginning-of-defun): New function.
+ (python-close-block-statement-p)
+ (python-block-end-p): Delete function.
+ (python-info-closing-block): New function.
+ (python-comint-output-filter-function)
+ (python-eldoc--get-doc-at-point, python-end-of-defun-function)
+ (python-fill-comment, python-fill-decorator, python-fill-paren)
+ (python-fill-string, python-imenu-make-element-tree)
+ (python-imenu-make-tree, python-imenu-tree-assoc)
+ (python-indent-context, python-indent-dedent-line)
+ (python-indent-line-function)
+ (python-indent-post-self-insert-function)
+ (python-indent-toggle-levels)
+ (python-info-assignment-continuation-line-p)
+ (python-info-beginning-of-backlash)
+ (python-info-block-continuation-line-p)
+ (python-info-closing-block-message)
+ (python-info-line-ends-backslash-p)
+ (python-info-looking-at-beginning-of-defun)
+ (python-info-ppss-context, python-info-ppss-context-type)
+ (python-nav-list-defun-positions, python-nav-read-defun)
+ (python-nav-sentence-end, python-nav-sentence-start)
+ (python-pdbtrack-comint-output-filter-function)
+ (python-pdbtrack-set-tracked-buffer)
+ (python-shell-calculate-exec-path)
+ (python-shell-calculate-process-environment)
+ (python-shell-completion--do-completion-at-point)
+ (python-shell-completion--get-completions)
+ (python-shell-completion-complete-at-point)
+ (python-shell-completion-complete-or-indent)
+ (python-shell-get-or-create-process)
+ (python-shell-get-process-name)
+ (python-shell-internal-get-or-create-process)
+ (python-shell-internal-get-process-name)
+ (python-shell-internal-send-string, python-shell-make-comint)
+ (python-shell-parse-command, python-shell-send-setup-code)
+ (python-skeleton-add-menu-items)
+ (python-util-clone-local-variables, python-util-position)
+ (run-python-internal, python-indentation-levels)
+ (python-nav-beginning-of-defun)
+ (python-completion-complete-at-point): New functions.
+ (run-python): Change arguments. New API requirements.
+
+2012-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el (cl--defsubst-expand): Autoload inliner
+ (bug#11649).
+
+ * emacs-lisp/macroexp.el (macroexp--compiler-macro): New function.
+ (macroexp--expand-all): Use it.
+
+ * emacs-lisp/cl-macs.el (cl--transform-function-property): Remove.
+ (cl-define-setf-expander, cl-deftype, cl-define-compiler-macro):
+ Use `cl-function' instead.
+
+2012-06-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (COMPILE_FIRST): Remove subr.el.
+ Suggested by Stefan Monnier while discussing bug#11657.
+
+2012-06-14 Sam Steingold <sds@gnu.org>
+
+ * files.el (abort-if-file-too-large): Use `file-size-human-readable'.
+
+2012-06-14 Andreas Schwab <schwab@linux-m68k.org>
+
+ * play/doctor.el (doctor-doc): Remove parameter and use
+ doctor-sent instead of sent.
+ (doctor-read-print): Use doctor-sent instead of sent. (Bug#11708)
+
+2012-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el: Require cl-lib.
+ (file-name-non-special): Replace case -> cl-case.
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Don't add print-func.
+
+ * emacs-lisp/edebug.el (edebug-read-function): Remove old incorrect
+ mapping from #' to function*.
+
+2012-06-13 Chong Yidong <cyd@gnu.org>
+
+ * mouse.el (mouse-drag-track): Do not set the mark if the user
+ releases the mouse without selecting anything (Bug#11588).
+
+2012-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/tex-mode.el (latex-indent): Recognize tex-verbatim at EOB
+ as well (bug#11646).
+
+ * loadup.el: Count byte-code functions as well.
+
+ * emacs-lisp/byte-opt.el (featurep): Move compiler-macro...
+ * emacs-lisp/bytecomp.el (featurep): ...here (bug#11692).
+
+ * emacs-lisp/autoload.el (make-autoload): Accept nil doc-string-elt
+ (bug#11649). Add cl-defun and cl-defmacro.
+
+2012-06-13 Drew Adams <drew.adams@oracle.com>
+
+ * help-mode.el (help-bookmark-make-record, help-bookmark-jump):
+ Fix last change.
+
+2012-06-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-call-method): Use timeout for `read-event'.
+ Otherwise, it blocks in batch mode.
+
+2012-06-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * help-mode.el (bookmark-make-record-default): Declare.
+
+2012-06-13 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/package.el (list-packages): Compute a list of
+ packages that are newly-available since the last list-packages
+ invocation.
+ (package-menu--new-package-list): New var.
+ (package-menu--generate, package-menu--print-info)
+ (package-menu--status-predicate, package-menu-mark-install):
+ Handle new status label "new".
+
+2012-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-remf): Fix error in recent
+ conversion to backquotes.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/edebug.el (edebug-inhibit-emacs-lisp-mode-bindings):
+ Rename from gud-inhibit-global-bindings.
+
+ * emacs-lisp/eieio.el (eieio-pre-method-execution-hooks): Doc fix.
+
+ * nxml/nxml-glyph.el (nxml-glyph-set-functions): Rename abnormal
+ hook from nxml-glyph-set-hook.
+
+ * progmodes/cwarn.el (cwarn-mode): Remove redundant variable
+ declaration.
+
+ * progmodes/pascal.el (pascal-toggle-completions): Doc fix.
+
+ * textmodes/bibtex.el (bibtex-string-file-path, bibtex-file-path):
+ Convert to defcustom.
+
+2012-06-12 Drew Adams <drew.adams@oracle.com>
+
+ * help-mode.el (help-bookmark-make-record, help-bookmark-jump):
+ New functions.
+ (help-mode): Use them.
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/fortran.el (fortran-font-lock-keywords-3):
+ Use preprocessor face for directives.
+ (fortran-directive-re): Doc fix.
+
+2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-parse-loop-clause): Fix error in recent
+ conversion to backquotes (bug#11652).
+
+ Fix compiler-expansion of CL's cXXr functions (bug#11673).
+ * emacs-lisp/cl-lib.el (cl--defalias): New function.
+ (cl-values, cl-values-list, cl-copy-seq, cl-svref, cl-first)
+ (cl-second, cl-rest, cl-endp, cl-third, cl-fourth): Use it.
+ (cl-plusp, cl-minusp, cl-fifth, cl-sixth, cl-seventh, cl-eighth)
+ (cl-ninth, cl-tenth): Mark them as inlinable.
+ (cl-caaar, cl-caadr, cl-cadar, cl-caddr, cl-cdaar, cl-cdadr)
+ (cl-cddar, cl-cdddr, cl-caaaar, cl-caaadr, cl-caadar, cl-caaddr)
+ (cl-cadaar, cl-cadadr, cl-caddar, cl-cadddr, cl-cdaaar, cl-cdaadr)
+ (cl-cdadar, cl-cdaddr, cl-cddaar, cl-cddadr, cl-cdddar, cl-cddddr):
+ Add a compiler-macro declaration to use cl--compiler-macro-cXXr.
+ (cl-list*, cl-adjoin): Don't put an autoload manually.
+ * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin)
+ (cl--compiler-macro-list*): Add autoload cookie.
+ (cl--compiler-macro-cXXr): New function.
+
+ * help-fns.el (help-fns--compiler-macro): New function extracted from
+ describe-function-1; follow aliases and use `compiler-macro' property.
+ (describe-function-1): Use it.
+
+2012-06-11 Chong Yidong <cyd@gnu.org>
+
+ * startup.el (fancy-splash-head): Use splash.svg even if librsvg
+ is uninstalled, if imagemagick is installed.
+
+2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el: Use lexical-binding.
+ (cl-map-extents, cl-maclisp-member): Remove.
+ (cl--set-elt, cl--set-nthcdr, cl--set-buffer-substring)
+ (cl--set-substring, cl--block-wrapper, cl--block-throw)
+ (cl--compiling-file, cl--mapcar-many, cl--do-subst): Use "cl--" prefix.
+ * emacs-lisp/cl-extra.el: Use lexical-binding.
+ (cl--mapcar-many, cl--map-keymap-recursively, cl--map-intervals)
+ (cl--map-overlays, cl--set-frame-visible-p, cl--progv-save)
+ (cl--progv-before, cl--progv-after, cl--finite-do, cl--set-getf)
+ (cl--do-remf, cl--do-prettyprint): Use "cl--" prefix.
+ * emacs-lisp/cl-seq.el: Use lexical-binding.
+ (cl--parsing-keywords, cl--check-key, cl--check-test-nokey)
+ (cl--check-test, cl--check-match): Use "cl--" prefix and backquotes.
+ (cl--alist, cl--sublis-rec, cl--nsublis-rec, cl--tree-equal-rec):
+ * emacs-lisp/cl-macs.el (cl--lambda-list-keywords): Use "cl--" prefix.
+ * edmacro.el (edmacro-mismatch): Simplify to remove dependence on
+ CL's internals.
+
+2012-06-11 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.6-pre.
+
+ * net/tramp-cache.el (tramp-dump-connection-properties): Let-bind
+ `print-length' and `print-level' to nil, in order to avoid
+ truncation. Reported by Christopher Schmidt
+ <christopher@ristopher.com>.
+
+ * net/tramp-cmds.el (tramp-cleanup-connection): Delete also process.
+
+ * net/tramp-compat.el (tramp-compat-condition-case-unless-debug):
+ New defmacro.
+ (tramp-compat-copy-directory): Add optional argument
+ COPY-CONTENTS. It is not handled yet.
+
+ * net/tramp-ftp.el (tramp-disable-ange-ftp): Fix docstring.
+ (tramp-ftp-file-name-p): Simplify.
+
+ * net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name):
+ * net/tramp-gw.el (tramp-gw-open-connection): Add hop to
+ connection vector.
+
+ * net/tramp-sh.el (tramp-copy-size-limit): Fix docstring.
+ (tramp-methods): Do not use `tramp-password-end-of-line'.
+ (tramp-completion-function-alist-putty): Handle UNIX case.
+ (tramp-remote-path): Add "/opt/bin", "/opt/sbin" and "/opt/local/bin".
+ (tramp-do-file-attributes-with-stat)
+ (tramp-do-directory-files-and-attributes-with-stat) Return uid and
+ gid as real numbers. They could run out of integer range on cygwin.
+ (tramp-do-copy-or-rename-file-out-of-band): Better trace format.
+ (tramp-sh-handle-expand-file-name): Handle hops.
+ (tramp-open-connection-setup-interactive-shell):
+ Use `tramp-cleanup'. Move check for busyboxes ...
+ (tramp-find-shell): ... here. Simplify implementation.
+ Set "remote-shell" property also for alternative shells.
+ (tramp-remote-coding-commands): Check "test -c /dev/stdout".
+ If failing, a regular file would be written otherwise.
+ Reported by Dmitry Kurochkin <dmitry.kurochkin@gmail.com>.
+ (tramp-find-inline-encoding): Cache the coding commands in the
+ process cache. Apply test command on the remote side, if defined.
+ (tramp-find-inline-compress): Cache the compress commands in the
+ process cache.
+ (tramp-compute-multi-hops): Save `tramp-default-proxies-alist'
+ when requested. Handle hops.
+ (tramp-current-connection): New defvar.
+ (tramp-maybe-open-connection): Use `tramp-cleanup'.
+ Throw `suppress', if there was a failed connection shortly before.
+ Handle user interrupt. (Bug#10187)
+ (tramp-get-inline-compress, tramp-get-inline-coding):
+ Read connection properties from the process cache.
+
+ * net/tramp-smb.el (tramp-smb-server-version)
+ (tramp-smb-wrong-passwd-regexp, tramp-smb-actions-with-tar):
+ New defconsts.
+ (tramp-smb-prompt): Extend for powershell prompt.
+ (tramp-smb-file-name-handler-alist): Add handlers for
+ `process-file', `shell-command' and `start-file-process'.
+ (tramp-smb-winexe-program, tramp-smb-winexe-shell-command)
+ (tramp-smb-winexe-shell-command-switch): New defcustoms.
+ (tramp-smb-file-name-p): Simplify.
+ (tramp-smb-action-with-tar, tramp-smb-handle-process-file)
+ (tramp-smb-kill-winexe-function, tramp-smb-call-winexe)
+ (tramp-smb-shell-quote-argument): New defuns.
+ (tramp-smb-handle-copy-directory): Add COPY-CONTENTS argument.
+ Implement using "tar". By this, time-stamps are preserved.
+ (tramp-smb-handle-copy-file): Handle also the case of directories.
+ (tramp-smb-do-file-attributes-with-stat)
+ (tramp-smb-get-file-entries, tramp-smb-get-cifs-capabilities):
+ Use `tramp-get-connection-buffer').
+ (tramp-smb-handle-rename-file): Use "rename", when source and
+ target are on the same share.
+ (tramp-smb-maybe-open-connection): Handle wrong passwords.
+ Use `tramp-smb-server-version'.
+ (tramp-smb-wait-for-output): Remove prompt.
+
+ * net/tramp.el (top): Require 'cl.
+ (tramp-methods, tramp-rsh-end-of-line):
+ Remove `tramp-password-end-of-line' from docstring.
+ (tramp-save-ad-hoc-proxies): New defcustom.
+ (tramp-completion-function-alist): Adapt docstring.
+ (tramp-default-password-end-of-line): Remove defcustom.
+ (tramp-shell-prompt-pattern): Allow "[]" style prompts. (Bug#11065)
+ (tramp-user-regexp, tramp-file-name-regexp-unified)
+ (tramp-file-name-regexp-url): Extend regexp by hop separator.
+ (tramp-postfix-hop-format, tramp-postfix-hop-regexp)
+ (tramp-remote-file-name-spec-regexp): New defconst.
+ (tramp-file-name-structure): Extend structure for hops.
+ (tramp-get-method-parameter): Move up.
+ (tramp-file-name-p, tramp-dissect-file-name)
+ (with-parsed-tramp-file-name): Handle hops.
+ (tramp-file-name-hop): New defun.
+ (tramp-make-tramp-file-name): New optional arg HOP.
+ (tramp-message-show-progress-reporter-message): New defvar.
+ (tramp-with-progress-reporter): Use it. We cannot use
+ `tramp-message-show-message' here, because this suppresses also
+ error buffers.
+ (tramp-error-with-buffer): Suppress buffer view, if
+ `tramp-message-show-message' is nil.
+ Use `tramp-get-connection-buffer'.
+ (tramp-cleanup): New defun.
+ (tramp-rfn-eshadow-update-overlay): Let-bind `non-essential' to `t'.
+ (tramp-file-name-handler): If `debug-on-error' is set, propagate
+ an error unchanged.
+ (tramp-completion-handle-file-name-all-completions): Handle hops.
+ Fix an error when called from ido.
+ (tramp-completion-dissect-file-name): Use better local variable
+ name. Add hop to the vector.
+ (tramp-handle-insert-file-contents): Use progress-reporter for the
+ whole scenario.
+ (tramp-action-password): Let-bind `enable-recursive-minibuffers'
+ to `t'.
+ (tramp-check-for-regexp): Simplify search.
+ (tramp-enter-password): Remove it. Move implementation ...
+ (tramp-action-password): ... here.
+ (tramp-mode-string-to-int, tramp-local-host-p)
+ (tramp-make-tramp-temp-file, tramp-read-passwd)
+ (tramp-clear-passwd, tramp-time-less-p, tramp-time-diff):
+ Set tramp-autoload cookie.
+
+ * net/trampver.el: Update release number.
+
+2012-06-11 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+ Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-set-completion-function): Fix docstring.
+ (tramp-parse-group, tramp-parse-file)
+ (tramp-parse-shostkeys-sknownhosts): New defuns.
+ (tramp-parse-rhosts, tramp-parse-rhosts-group, tramp-parse-shosts)
+ (tramp-parse-shosts-group, tramp-parse-sconfig)
+ (tramp-parse-sconfig-group, tramp-parse-shostkeys)
+ (tramp-parse-sknownhosts, tramp-parse-hosts)
+ (tramp-parse-hosts-group, tramp-parse-passwd, tramp-parse-netrc):
+ Use them.
+ (tramp-parse-passwd-group, tramp-parse-netrc-group)
+ (tramp-parse-putty-group): Don't narrow.
+ (tramp-parse-putty): Make a loop.
+ (tramp-file-name-handler): Catch the `suppress' signal.
+
+2012-06-11 Chong Yidong <cyd@gnu.org>
+
+ * image.el (imagemagick-register-types): Put the ImageMagick entry
+ at the end of image-type-file-name-regexps.
+
+2012-06-11 Johan Bockgård <bojohan@gnu.org>
+
+ * emacs-lisp/pcase.el (pcase-UPAT, pcase-QPAT): New edebug specs.
+ (pcase, pcase-let*, pcase-dolist): Use them.
+
+2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--let*): New function.
+ (pcase-let*): Use it. Use pcase--memoize to avoid repeated expansions.
+ (pcase--expand): Use macroexp-let².
+
+2012-06-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/timer.el, emacs-lisp/syntax.el, emacs-lisp/smie.el:
+ * emacs-lisp/ewoc.el, emacs-lisp/cconv.el, emacs-lisp/bytecomp.el:
+ * emacs-lisp/byte-opt.el, emacs-lisp/autoload.el: Convert to cl-lib.
+ * emacs-lisp/easymenu.el, emacs-lisp/easy-mmode.el:
+ * emacs-lisp/derived.el: Use pcase instead of `cl'.
+ * emacs-lisp/cl-lib.el: Get rid of special cl-macs auto load.
+
+2012-06-10 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmail.el (rmail-yank-current-message): Leave point at
+ correct position. (Bug#11660)
+
+2012-06-10 Chong Yidong <cyd@gnu.org>
+
+ * allout-widgets.el: Fix code header.
+
+2012-06-10 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (customize-changed-options-previous-release):
+ Bump to 24.1.
+
+2012-06-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * Makefile.in (BIG_STACK_DEPTH): Enlarge to 2200.
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * ebuff-menu.el (electric-buffer-list): Preserve header line.
+
+2012-06-09 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (special-display-popup-frame): Don't use
+ window--display-buffer (Bug#11651).
+
+2012-06-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix parallel builds: make sure loaddefs.el is not being written
+ while Lisp files are compiled.
+ (compile): Don't depend on 'mh-autoloads'.
+ (compile-CMD, compile-SH): Depend on 'autoloads'.
+ (bootstrap): Don't depend on 'autoloads' and 'mh-autoloads'.
+
+ * makefile.w32-in (BIG_STACK_DEPTH): Enlarge to 2200. (Bug#11649)
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * face-remap.el (face-remap-add-relative, face-remap-set-base)
+ (buffer-face-set, buffer-face-toggle, buffer-face-mode-invoke):
+ Doc fixes (Bug#11225).
+
+2012-06-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp--expand-all): Only autoload
+ a function if there's a clear indication that it has a compiler-macro.
+ * emacs-lisp/byte-run.el (defun-declarations-alist, defmacro, defun)
+ (macro-declarations-alist): Add arglist to declaration functions.
+ (defun-declarations-alist): Add `obsolete' and `compiler-macro'.
+ * emacs-lisp/cl-seq.el (cl-member, cl-assoc):
+ * emacs-lisp/cl-lib.el (cl-list*, cl-adjoin):
+ * emacs-lisp/cl-extra.el (cl-get): Use the new `declare' statement.
+ Also add autoload to find the compiler macro.
+ * emacs-lisp/cl-macs.el (eql) [compiler-macro]: Remove.
+ (cl--compiler-macro-member, cl--compiler-macro-assoc)
+ (cl--compiler-macro-adjoin, cl--compiler-macro-list*)
+ (cl--compiler-macro-get): New functions, replacing calls to
+ cl-define-compiler-macro.
+ (cl-typep) [compiler-macro]: Use macroexp-let².
+
+2012-06-08 Nick Dokos <nicholas.dokos@hp.com> (tiny change)
+
+ * calendar/icalendar.el (icalendar--parse-vtimezone): Import TZID
+ string properly, fixes Bug#11473.
+
+2012-06-08 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (set-face-attribute): Doc fix.
+ (modify-face): Don't use :bold and :italic.
+ (error, warning, success): Tweak definitions.
+
+ * cus-edit.el (custom-modified, custom-invalid, custom-rogue)
+ (custom-modified, custom-set, custom-changed, custom-themed)
+ (custom-saved, custom-button, custom-button-mouse)
+ (custom-button-pressed, custom-state, custom-comment-tag)
+ (custom-variable-tag, custom-group-tag-1, custom-group-tag)
+ (custom-group-subtitle): Use new-style face specs.
+ (custom-invalid-face, custom-rogue-face, custom-modified-face)
+ (custom-set-face, custom-changed-face, custom-saved-face)
+ (custom-button-face, custom-button-pressed-face)
+ (custom-documentation-face, custom-state-face)
+ (custom-comment-face, custom-comment-tag-face)
+ (custom-variable-tag-face, custom-variable-button-face)
+ (custom-face-tag-face, custom-group-tag-face-1)
+ (custom-group-tag-face): Remove obsolete face alias.
+
+ * epa.el (epa-validity-high, epa-validity-medium)
+ (epa-validity-low, epa-mark, epa-field-name, epa-string)
+ (epa-field-name, epa-field-body):
+ * font-lock.el (font-lock-comment-face, font-lock-string-face)
+ (font-lock-keyword-face, font-lock-builtin-face)
+ (font-lock-function-name-face, font-lock-variable-name-face)
+ (font-lock-type-face, font-lock-constant-face):
+ * ido.el (ido-first-match, ido-only-match, ido-subdir)
+ (ido-virtual, ido-indicator, ido-incomplete-regexp):
+ * speedbar.el (speedbar-button-face, speedbar-file-face)
+ (speedbar-directory-face, speedbar-tag-face)
+ (speedbar-selected-face, speedbar-highlight-face)
+ (speedbar-separator-face):
+ * whitespace.el (whitespace-newline, whitespace-space)
+ (whitespace-hspace, whitespace-tab, whitespace-trailing)
+ (whitespace-line, whitespace-space-before-tab)
+ (whitespace-space-after-tab, whitespace-indentation)
+ (whitespace-empty):
+ * emulation/cua-base.el (cua-global-mark):
+ * eshell/em-prompt.el (eshell-prompt):
+ * net/newst-plainview.el (newsticker-new-item-face)
+ (newsticker-old-item-face, newsticker-immortal-item-face)
+ (newsticker-obsolete-item-face, newsticker-date-face)
+ (newsticker-statistics-face, newsticker-default-face):
+ * net/newst-reader.el (newsticker-feed-face)
+ (newsticker-extra-face, newsticker-enclosure-face):
+ * net/newst-treeview.el (newsticker-treeview-face)
+ (newsticker-treeview-new-face, newsticker-treeview-old-face)
+ (newsticker-treeview-immortal-face)
+ (newsticker-treeview-obsolete-face)
+ (newsticker-treeview-selection-face):
+ * net/rcirc.el (rcirc-my-nick, rcirc-other-nick)
+ (rcirc-bright-nick, rcirc-server, rcirc-timestamp)
+ (rcirc-nick-in-message, rcirc-nick-in-message-full-line)
+ (rcirc-prompt, rcirc-track-keyword, rcirc-url, rcirc-keyword):
+ * nxml/nxml-outln.el (nxml-heading, nxml-outline-indicator)
+ (nxml-outline-active-indicator, nxml-outline-ellipsis):
+ * play/mpuz.el (mpuz-unsolved, mpuz-solved, mpuz-trivial)
+ (mpuz-text):
+ * progmodes/vera-mode.el (vera-font-lock-number)
+ (vera-font-lock-function, vera-font-lock-interface):
+ * textmodes/table.el (table-cell): Use new-style face specs, and
+ don't use the old :bold and :italic attributes.
+
+ * progmodes/ebrowse.el (ebrowse-tree-mark, ebrowse-root-class)
+ (ebrowse-member-attribute, ebrowse-default, ebrowse-file-name)
+ (ebrowse-member-class, ebrowse-progress): Likewise.
+ (ebrowse-tree-mark-face, ebrowse-root-class-face)
+ (ebrowse-file-name-face, ebrowse-default-face)
+ (ebrowse-member-attribute-face, ebrowse-member-class-face)
+ (ebrowse-progress-face): Remove obsolete faces.
+
+ * progmodes/flymake.el (flymake-errline, flymake-warnline):
+ Inherit from error and warning faces respectively.
+
+ * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate):
+ Likewise.
+ (flyspell-incorrect-face, flyspell-duplicate-face):
+ Remove obsolete aliases.
+
+2012-06-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-compat.el (tramp-compat-temporary-file-directory):
+ Avoid infloop.
+
+2012-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * startup.el (argv, argi): Make lexically scoped.
+ * emacs-lisp/float-sup.el (pi): Use internal-make-var-non-special.
+ * emacs-lisp/cl-macs.el: Use lexical-binding.
+ Rename cl-bind-* to cl--bind-*.
+ * files.el: Don't require `cl' since it doesn't use it.
+ * emacs-lisp/pcase.el, emacs-lisp/macroexp.el: Add coding cookie.
+
+2012-06-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * textmodes/texinfmt.el: Fix bug#11640 (reverts part of 2008-07-31T05:33:56Z!dann@ics.uci.edu).
+ (texinfo-format-printindex): Use `texinfo-sort-region' in all platforms,
+ instead of calling external sort utility.
+ (texinfo-sort-region, texinfo-sort-startkeyfun): Restore functions.
+
+2012-06-08 Eli Zaretskii <eliz@gnu.org>
+
+ * descr-text.el (describe-char): Mention how to insert the
+ character, if the current input method doesn't support it.
+ See the discussion in this thread for the details:
+ http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00533.html.
+
+2012-06-08 Sam Steingold <sds@gnu.org>
+
+ * bindings.el (global-map): Bind XF86Forward to next-buffer and
+ XF86Back to previous-buffer.
+ (minibuffer-local-map): Bind them to next-history-element and
+ previous-history-element respectively.
+ * help-mode.el (help-mode-map): Bind them to help-go-forward and
+ help-go-back respectively.
+ * info.el (Info-mode-map): Bind them to Info-history-forward and
+ Info-history-back respectively.
+ These are the keys next to Up on the ThinkPad keyboard.
+
+2012-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Get rid of cl-lexical-let, keeping only lexical-let for compatibility.
+ * emacs-lisp/cl-macs.el: Provide itself.
+ (cl--labels-convert-cache): New var.
+ (cl--labels-convert): New function.
+ (cl-flet, cl-labels): New implementation with new semantics, relying on
+ lexical-binding.
+ * emacs-lisp/cl.el: Mark compatibility aliases as obsolete.
+ (cl-closure-vars, cl--function-convert-cache)
+ (cl--function-convert): Move from cl-macs.el.
+ (lexical-let, lexical-let*, flet, labels): Move from cl-macs.el and
+ rename by removing the "cl-" prefix.
+ * emacs-lisp/macroexp.el (macroexp-unprogn): New function.
+
+2012-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl.el (cl-macroexpand, cl-macro-environment)
+ (cl-macroexpand-all, cl-not-hash-table, cl-builtin-gethash)
+ (cl-builtin-remhash, cl-builtin-clrhash, cl-builtin-maphash)
+ (cl-map-keymap, cl-copy-tree, cl-gethash, cl-puthash, cl-remhash)
+ (cl-clrhash, cl-maphash, cl-make-hash-table, cl-hash-table-p)
+ (cl-hash-table-count): Add old compatibility aliases.
+
+ * emacs-lisp/cl-macs.el (cl-macro-environment): Remove var.
+ Use macroexpand-all-environment instead.
+ (cl--old-macroexpand): New var.
+ (cl--sm-macroexpand): New function.
+ (cl-symbol-macrolet): Use it during macro expansion.
+ (cl--function-convert-cache): New var.
+ (cl--function-convert): New function, extracted from
+ cl-macroexpand-all.
+ (cl-lexical-let): Use it.
+
+ * emacs-lisp/cl-lib.el (cl-macro-environment): Remove decl.
+ (cl-macroexpand): Move to cl-macs.el and rename to cl--sm-macroexpand.
+ (cl-member): Remove old alias.
+
+ * emacs-lisp/cl-extra.el (cl-map-keymap, cl-copy-tree)
+ (cl-not-hash-table, cl-builtin-gethash, cl-builtin-remhash)
+ (cl-builtin-clrhash, cl-builtin-maphash, cl-gethash, cl-puthash)
+ (cl-remhash, cl-clrhash, cl-maphash, cl-make-hash-table)
+ (cl-hash-table-p, cl-hash-table-count): Move to cl.el.
+ (cl-macroexpand-cmacs): Remove var.
+ (cl-macroexpand-all, cl-macroexpand-body): Remove funs.
+ Use macroexpand-all instead.
+
+2012-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp-progn, macroexp-let*, macroexp-if)
+ (macroexp-let², macroexp--const-symbol-p, macroexp-const-p)
+ (macroexp-copyable-p): New functions and macros.
+ * emacs-lisp/edebug.el (edebug-unwrap):
+ * emacs-lisp/disass.el (disassemble-internal): Use macroexp-progn.
+ * emacs-lisp/pcase.el: Use macroexp-let*, macroexp-if, ...
+ (pcase--let*): Remove.
+ * emacs-lisp/bytecomp.el (byte-compile-const-symbol-p)
+ (byte-compile-constp): Remove. Use macroexp--const-symbol-p and
+ macroexp-const-p instead.
+ * emacs-lisp/byte-opt.el: Use macroexp-const-p and macroexp-progn.
+
+ * emacs-lisp/cl-macs.el: Clean up the name space by using "cl--"
+ instead of "cl-" for internal definitions. Use macroexp-const-p.
+ (cl-old-bc-file-form): Remove var.
+ (cl-const-exprs-p): Remove fun.
+ (cl-labels, cl-macrolet): Use backquote.
+ (cl-lexical-let): Use cl-symbol-macrolet. Don't use cl-defun-expander.
+ (cl-defun-expander, cl-byte-compile-compiler-macro): Remove fun.
+ (cl-define-setf-expander): Rename from cl-define-setf-method.
+ * emacs-lisp/cl.el: Adjust alias for define-setf-method.
+
+ * international/mule-cmds.el: Don't require CL.
+ (view-hello-file): Don't use `letf'.
+
+2012-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * tmm.el (tmm-prompt): Use string-prefix-p.
+ (tmm-completion-delete-prompt): Don't affect current-buffer outside.
+ (tmm-add-prompt): Use minibuffer-completion-help.
+ (tmm-delete-map): Remove.
+
+ * subr.el (kbd): Make it its own function.
+
+2012-06-07 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Use `eval-when-compile' for requiring `cl.el'.
+ Silence compiler warnings. Fix versions.
+ (rst-position-if, rst-position, rst-some, rst-signum): New functions.
+ (rst-shift-region, rst-adornment-level, rst-compute-tabs)
+ (rst-indent-line, rst-shift-region, rst-forward-line): Use them.
+ (rst-package-emacs-version-alist): Correct Emacs version to
+ represent major merge with upstream.
+ (rst-transition, rst-adornment, rst-compile-toolsets): Fix versions.
+
+2012-06-06 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug): Add relevant EMACS env-vars.
+ Only print environment variables if set.
+
+2012-06-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el: Don't require CL since we don't use it.
+ (macroexp--cons): Rename from maybe-cons.
+ (macroexp--accumulate): Rename from macroexp-accumulate.
+ (macroexp--all-forms): Rename from macroexpand-all-forms.
+ (macroexp--all-clauses): Rename from macroexpand-all-clauses.
+ (macroexp--expand-all): Rename from macroexpand-all-1.
+
+2012-06-06 Sam Steingold <sds@gnu.org>
+
+ * calendar/calendar.el (calendar-in-read-only-buffer):
+ Call `special-mode' to enable the standard read-only keybindings.
+
+2012-06-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexpand-all-1): Don't spam the output
+ with "loading" messages (bug#11635).
+
+2012-06-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * files.el (enable-remote-dir-locals): New option.
+ (hack-dir-local-variables): Use it. (Bug#1933, Bug#6731)
+
+ * net/tramp-compat.el (tramp-compat-temporary-file-directory):
+ Ensure, that the temp directory is local.
+
+ * net/tramp-sh.el (tramp-sh-handle-write-region): Let-bind
+ `temporary-file-directory'.
+
+ * progmodes/python.el (python-send-region): Ensure, that the
+ temporary file is created also in the remote case.
+
+2012-06-06 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-rcs.el (vc-rcs-rcs2log-program): New.
+ (vc-rcs-update-changelog): Use it.
+
+ * emacs-lisp/authors.el (authors-fixed-entries): Remove vcdiff.
+
+ * vc/vc-sccs.el (vc-sccs-write-revision): New function.
+ (vc-sccs-workfile-unchanged-p): Use vc-sccs-write-revision.
+ (vc-sccs-diff): Replace use of the external vcdiff script.
+
+2012-06-05 Glenn Morris <rgm@gnu.org>
+
+ * ledit.el: Move to obsolete/.
+
+2012-06-05 Sam Steingold <sds@gnu.org>
+
+ * calendar/calendar.el (calendar-exit): Reinstate the 2012-03-28
+ patch (Bug#11140).
+
+2012-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cust-print.el: Move to obsolete.
+
+ * emacs-lisp/macroexp.el (macroexpand-all-1): Tolerate errors during
+ compiler-macro expansion.
+
+ Add native compiler-macro support.
+ * emacs-lisp/macroexp.el (macroexpand-all-1):
+ Support compiler-macros directly. Properly follow aliases and apply
+ the compiler macros more thoroughly.
+ * emacs-lisp/cl.el: Don't copy compiler-macro properties any more since
+ macroexpand now properly follows aliases.
+ * emacs-lisp/cl-macs.el (toplevel, cl-define-compiler-macro)
+ (cl-compiler-macroexpand): Use new prop.
+ * emacs-lisp/byte-opt.el (featurep): Optimize earlier.
+
+ * emacs-lisp/cl-lib.el (custom-print-functions): Add alias.
+
+2012-06-05 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (get-lru-window, get-mru-window, get-largest-window):
+ New argument NOT-SELECTED to avoid picking the selected window.
+ (window--display-buffer-1, window--display-buffer-2): Replace by
+ new function window--display-buffer
+ (display-buffer-same-window, display-buffer-reuse-window)
+ (display-buffer-pop-up-frame, display-buffer-pop-up-window):
+ Use window--display-buffer.
+ (display-buffer-use-some-window): Remove temporary dedication
+ hack by calling get-lru-window and get-largest-window with
+ NOT-SELECTED argument non-nil. Call window--display-buffer.
+
+2012-06-05 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-sccs.el (vc-sccs-workfile-unchanged-p):
+ Replace external vcdiff script.
+
+2012-06-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el (cl-values, cl-values-list): Fix up last change.
+
+2012-06-04 Chong Yidong <cyd@gnu.org>
+
+ * image.el (imagemagick-types-inhibit): Revert last change.
+ Add INFO and M.
+ (imagemagick-enabled-types): Remove CIN and EPS*.
+
+2012-06-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-lib.el: Rename from cl.el.
+ * emacs-lisp/cl.el: New compatibility file.
+ * emacs-lisp/cl-lib.el, emacs-lisp/cl-seq.el, emacs-lisp/cl-macs.el:
+ * emacs-lisp/cl-extra.el: Rename all top-level functions and variables
+ to obey the "cl-" prefix.
+ * emacs-lisp/macroexp.el (macroexpand-all-1): Adjust to new name.
+
+2012-06-03 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-aliases): Addition.
+
+ * cus-start.el (tool-bar-style, tool-bar-max-label-size):
+ Fix :version.
+
+2012-06-03 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Add comments.
+ (rst-transition, rst-adornment): New faces.
+ (rst-adornment-faces-alist): Make default safe to reevaluate.
+ Fixes
+ http://sourceforge.net/tracker/?func=detail&atid=422030&aid=3479603&group_id=38414.
+ Improve customization tags.
+ (rst-define-level-faces): Clarify meaning.
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/compile.el (compilation-mode-line-fail)
+ (compilation-mode-line-run, compilation-mode-line-exit):
+ New faces.
+ (compilation-start, compilation-handle-exit): Use them (Bug#11032).
+
+2012-06-03 Jack Duthen <duthen.mac.01@gmail.com> (tiny change)
+
+ * progmodes/which-func.el (which-func-update-ediff-windows):
+ New function. Use it in ediff-select-hook (Bug#11478).
+
+2012-06-03 Chong Yidong <cyd@gnu.org>
+
+ * bindings.el: Remove explicit help text from format-mode-line.
+ It is now supplied by mode-line-default-help-echo.
+ (mode-line-front-space, mode-line-end-spaces)
+ (mode-line-misc-info): New variables.
+ (mode-line-modes, mode-line-position): Move the default value to
+ the variable definition.
+ (mode-line-default-help-echo): New defcustom.
+ (mode-line-mule-info-help-echo, mode-line-read-only-help-echo)
+ (mode-line-modified-help-echo): New functions.
+ (mode-line-mule-info, mode-line-modified): Use them.
+ (mode-line-eol-desc, propertized-buffer-identification):
+ Consistency fixes for help text.
+ (mode-line-coding-system-map): Allow using mouse-3 to invoke
+ set-buffer-file-coding-system (Bug#289).
+ (mode-line-mule-info-help-echo): Update help text.
+
+2012-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (execute-extended-command): Set real-this-command
+ (bug#11506).
+
+2012-06-02 Chong Yidong <cyd@gnu.org>
+
+ Remove incorrect uses of "modeline" in comments, docstrings, and
+ function/variable names (Bug#10329).
+
+ * cus-edit.el (mode-line):
+ * dframe.el (dframe-mouse-hscroll):
+ * emacs-lisp/re-builder.el:
+ * emacs-lisp/easy-mmode.el (define-minor-mode):
+ * frame.el (set-frame-name):
+ * help.el (lookup-minor-mode-from-indicator):
+ * net/rcirc.el (rcirc-activity-string, rcirc-short-buffer-name):
+ * progmodes/cc-cmds.el (c-toggle-auto-newline)
+ (c-toggle-hungry-state):
+ * progmodes/antlr-mode.el (antlr-language-alist):
+ * progmodes/idlw-shell.el (idlwave-shell-electric-stop-line-face):
+ * progmodes/vhdl-mode.el (vhdl-mode):
+ * progmodes/which-func.el (which-func, which-func-cleanup-function):
+ * term/ns-win.el (ns-face-at-pos):
+ * term/sup-mouse.el (sup-mouse-report):
+ * textmodes/flyspell.el (flyspell-mode-line-string):
+ * textmodes/ispell.el (ispell-highlight-face):
+ * textmodes/reftex-global.el:
+ * vc/vc-arch.el (vc-arch-mode-line-string):
+ * vc/vc-cvs.el (vc-cvs-mode-line-string):
+ * vc/vc-git.el (vc-git-mode-line-string):
+ * vc/vc-hooks.el (vc-display-status)
+ (vc-default-mode-line-string):
+ * vc/vc-mtn.el (vc-mtn-mode-line-string): Doc fixes.
+
+ * ansi-color.el (ansi-color-faces-vector): Change default faces.
+
+ * dired.el (dired-sort-set-mode-line): Rename from
+ dired-sort-set-modeline. All callers changed.
+
+ * eshell/esh-mode.el (eshell-status-in-mode-line): Rename from
+ eshell-status-in-modeline.
+
+ * foldout.el (foldout-mode-line-string): Rename from
+ foldout-modeline-string. All callers changed.
+ (foldout-update-mode-line): Rename from foldout-update-modeline.
+
+ * subr.el (redraw-modeline): Make into obsolete alias.
+
+ * calendar/timeclock.el (timeclock-mode-line-display): Rename from
+ timeclock-modeline-display. Make old name an alias.
+ (timeclock-update-mode-line): Likewise. All callers changed.
+ (timeclock-mode-line-display): No need to check before using
+ add-hook.
+ (timeclock-relative, timeclock-day-over-hook)
+ (timeclock-use-elapsed, timeclock-mode-string)
+ (timeclock-mode-line-display): Doc fix, "modeline" -> "mode line".
+
+ * emulation/crisp.el (crisp-mode-mode-line-string): Rename from
+ crisp-mode-modeline-string.
+
+ * play/solitaire.el (solitaire-build-mode-line): Rename from
+ solitaire-build-modeline. All callers changed.
+
+ * play/zone.el (zone-hiding-mode-line): Rename from
+ zone-hiding-modeline. All callers changed.
+ (zone): Remove unusued `modeline-hidden-level' property.
+
+ * progmodes/xscheme.el (xscheme-mode-line-initialize): Rename from
+ xscheme-modeline-initialize. All callers changed.
+
+ * strokes.el (strokes-lighter): Rename from
+ strokes-modeline-string.
+
+ * textmodes/sgml-mode.el (html-face-tag-alist)
+ (html-tag-face-alist): Use mode-line face instead of obsolete
+ alias modeline.
+
+2012-06-02 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Always require `cl'.
+ (rst-mode-map): Fix meaning of C-M-a / C-M-e.
+
+2012-06-02 Chong Yidong <cyd@gnu.org>
+
+ * image.el (imagemagick-enabled-types): Rename from
+ imagemagick-types-enable. Add many more types.
+ (imagemagick-types-inhibit): Change default to nil.
+ (imagemagick-filter-types): Caller changed.
+
+2012-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el: Use backquotes.
+ (cl-transform-function-property): Use eval-and-compile rather than
+ abusing `require'.
+ (defstruct): Use declare-function instead of with-no-warnings.
+
+ * emacs-lisp/bytecomp.el: Fix last change (bug#11594).
+ (byte-compile-output-docform): Re-add the print-circle bindings.
+ (byte-compile-fix-header): Use #$ just because it's shorter.
+ (byte-compile-output-file-form): Remove defun/defmacro.
+
+2012-06-01 Martin Rudalics <rudalics@gmx.at>
+
+ * simple.el (choose-completion): Remove now obsolete binding for
+ owindow.
+
+2012-06-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-check-for-regexp): Search from buffer end,
+ in order to avoid "Stack overflow in regexp matcher".
+
+2012-05-31 Glenn Morris <rgm@gnu.org>
+
+ * image.el: For clarity, call imagemagick-register-types at
+ top-level, rather than relying on a custom :initialize.
+ (imagemagick-types-enable): New option. (Bug#11557)
+ (imagemagick-filter-types): New function. (Bug#7406)
+ (imagemagick-register-types): Use imagemagick-filter-types.
+ If disabling support, remove elements altogether rather
+ than using an impossible regexp.
+ (imagemagick-types-inhibit): Give it the default init function.
+
+2012-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-fix-header):
+ Handle arbitrary file name lengths (Bug#11585).
+
+2012-05-31 Martin Rudalics <rudalics@gmx.at>
+
+ * desktop.el (desktop-read): Clear previous and next buffers for
+ all windows and bury *Messages* buffer (bug#11556).
+
+2012-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add `declare' for `defun'. Align `defmacro's with it.
+ * emacs-lisp/easy-mmode.el (define-minor-mode)
+ (define-globalized-minor-mode): Don't autoload the var definitions.
+ * emacs-lisp/byte-run.el: Use lexical-binding.
+ (defun-declarations-alist, macro-declarations-alist): New vars.
+ (defmacro, defun): Use them.
+ (make-obsolete, define-obsolete-function-alias)
+ (make-obsolete-variable, define-obsolete-variable-alias):
+ Use `declare'.
+ (macro-declaration-function): Mark obsolete.
+ * emacs-lisp/autoload.el: Use lexical-binding.
+ (make-autoload): Add `expansion' arg. Rely more on macro expansion.
+
+2012-05-30 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-with-no-warnings):
+ Define as a macro.
+ (ispell-kill-ispell, ispell-change-dictionary):
+ Use `called-interactively-p' for Emacs instead of obsolete
+ `interactive-p'.
+
+2012-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/byte-run.el (defmacro, defun): Move from C.
+ (macro-declaration-function): Move var from C code.
+ (macro-declaration-function): Define function with defalias.
+ * emacs-lisp/macroexp.el (macroexpand-all-1):
+ * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form):
+ * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't handle
+ defun/defmacro any more.
+ * emacs-lisp/bytecomp.el (byte-compile-arglist-signature):
+ Provide fallback for unknown arglist.
+ (byte-compile-arglist-warn): Change calling convention.
+ (byte-compile-output-file-form): Move print-vars binding.
+ (byte-compile-output-docform): Simplify accordingly.
+ (byte-compile-file-form-defun, byte-compile-file-form-defmacro)
+ (byte-compile-defmacro-declaration): Remove.
+ (byte-compile-file-form-defmumble): Generalize to defalias.
+ (byte-compile-output-as-comment): Return byte-positions.
+ Simplify callers accordingly.
+ (byte-compile-lambda): Use `assert'.
+ (byte-compile-defun, byte-compile-defmacro): Remove.
+ (byte-compile-file-form-defalias):
+ Use byte-compile-file-form-defmumble.
+ (byte-compile-defalias-warn): Remove.
+
+2012-05-29 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Silence `checkdoc-ispell' errors where
+ possible. Fix authors. Improve comments. Improve loading of `cl'.
+
+ (rst-mode-abbrev-table): Merge definition.
+ (rst-mode): Make sure `font-lock-defaults' is buffer local.
+ (rst-define-key, rst-deprecated-keys, rst-call-deprecated): Refactor.
+
+2012-05-29 Ulf Jasper <ulf.jasper@web.de>
+
+ * calendar/icalendar.el
+ (icalendar-export-region): Export UID properly.
+
+2012-05-29 Leo Liu <sdl.web@gmail.com>
+ * calendar/icalendar.el (icalendar-import-format):
+ Add `icalendar-import-format-uid' (Bug#11525).
+ (icalendar-import-format-uid): New.
+ (icalendar--parse-summary-and-rest, icalendar--format-ical-event):
+ Export UID.
+
+2012-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--expand): Accept different sets of vars in
+ different alternative patterns.
+ (pcase-codegen): Be more careful to preserve identity.
+ (pcase--u1): Don't forget to mark vars as used.
+
+ * emacs-lisp/bytecomp.el (byte-compile-constp): Treat #'v as a constant.
+ (byte-compile-close-variables): Bind byte-compile--outbuffer here...
+ (byte-compile-from-buffer): ...rather than here.
+
+ * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Don't re-preprocess
+ functions from byte-compile-function-environment.
+
+2012-05-29 Troels Nielsen <bn.troels@gmail.com>
+
+ * window.el (window-deletable-p): Avoid deleting the root window
+ of a frame with an active minibuffer.
+
+2012-05-29 Martin Rudalics <rudalics@gmx.at>
+
+ * simple.el (choose-completion): Use quit-window (Bug#11567).
+
+2012-05-29 Chong Yidong <cyd@gnu.org>
+
+ * whitespace.el (whitespace-cleanup): Fix usage of
+ whitespace-empty-at-bob-regexp (Bug#11492).
+
+2012-05-29 Aaron S. Hawley <aaron.s.hawley@gmail.com>
+
+ * vc/vc.el (vc-revert, vc-rollback): Dont kill vc-diff buffer on
+ revert (Bug#11488).
+
+2012-05-29 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-mode-map): Bind `M-s _' to
+ `isearch-toggle-symbol'. Bind `M-s c' to
+ `isearch-toggle-case-fold'.
+ (search-map): Bind `M-s _' to `isearch-forward-symbol'.
+ (isearch-forward): Add `M-s _' to the docstring.
+ (isearch-forward-symbol, isearch-toggle-case-fold)
+ (isearch-symbol-regexp): New functions. (Bug#11381)
+
+2012-05-29 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-word): Add docstring. (Bug#11381)
+ (isearch-occur, isearch-search-and-update): If `isearch-word' is
+ a function, call it to get the regexp.
+ (isearch-message-prefix): If `isearch-word' holds a symbol, use its
+ property `isearch-message-prefix' instead of the string "word ".
+ (isearch-search-fun-default): For the case of `isearch-word',
+ return a lambda that calls re-search-forward/re-search-backward
+ with a regexp returned by `word-search-regexp' or by the function
+ in `isearch-word'.
+
+2012-05-29 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-search-fun-default): New function.
+ (isearch-search-fun): Move default part to the new function
+ `isearch-search-fun-default'.
+ (isearch-search-fun-function): Set the default value to
+ `isearch-search-fun-default'. (Bug#11381)
+
+ * comint.el (comint-history-isearch-end):
+ Use `isearch-search-fun-default'.
+ (comint-history-isearch-search): Use `isearch-search-fun-default'
+ and remove spacial case for `isearch-word'.
+ (comint-history-isearch-wrap): Remove spacial case for
+ `isearch-word'.
+
+ * hexl.el (hexl-isearch-search-function):
+ Use `isearch-search-fun-default'.
+
+ * info.el (Info-isearch-search): Use `isearch-search-fun-default'.
+ Use `word-search-regexp' for `isearch-word'.
+
+ * misearch.el (multi-isearch-search-fun):
+ Use `isearch-search-fun-default'.
+
+ * simple.el (minibuffer-history-isearch-search):
+ Use `isearch-search-fun-default' and remove spacial case for
+ `isearch-word'.
+ (minibuffer-history-isearch-wrap): Remove spacial case for
+ `isearch-word'.
+
+ * textmodes/reftex-global.el (reftex-isearch-wrap-function):
+ Remove spacial case for `isearch-word'.
+ (reftex-isearch-isearch-search): Use `isearch-search-fun-default'.
+
+2012-05-28 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ Decrease XEmacs incompatibilities.
+ * textmodes/flyspell.el (flyspell-check-pre-word-p):
+ Use `string-match'.
+ (flyspell-delete-region-overlays): Use alternative definition for
+ XEmacs.
+ (flyspell-delete-all-overlays): Use `flyspell-delete-region-overlays'.
+ (flyspell-word): Use `process-kill-without-query' if XEmacs.
+ (flyspell-mode-on): Use `interactive-p' if XEmacs.
+ (flyspell-incorrect-face, flyspell-duplicate-face): Do not use
+ `define-obsolete-face-alias' under XEmacs, but old method.
+
+ * textmodes/ispell.el (ispell-with-no-warnings): XEmacs alternative
+ `with-no-warnings' definition or Emacs alias.
+ (ispell-command-loop, ispell-message): Use `ispell-with-no-warnings'.
+ (ispell-word): Do not use `region-p' if XEmacs.
+
+2012-05-28 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-find-aspell-dictionaries):
+ Check for `ispell-dictionary-base-alist' instead of full
+ `ispell-dictionary-alist'.
+ (ispell-init-process): Show spellchecker when starting new Ispell
+ process.
+
+2012-05-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/vhdl-mode.el: Sync with upstream 3.33.28.
+ http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html#release-notes-3.33
+
+2012-05-27 Juanma Barranquero <lekktu@gmail.com>
+
+ * version.el (motif-version-string, gtk-version-string)
+ (ns-version-string): Declare.
+
+2012-05-27 Juri Linkov <juri@jurta.org>
+
+ * emacs-lisp/lisp-mode.el (eval-defun-2): Use `eval-sexp-add-defvars'
+ after the `eval-defun-1' specialcaseing
+ like in `edebug-eval-defun' (bug#10181).
+
+ * emacs-lisp/edebug.el (edebug-eval-defun): Set `face-documentation'
+ like in `eval-defun-1'.
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/sendmail.el (mail-yank-region):
+ Recognize rmail-yank-current-message in addition to insert-buffer.
+ Fixes mail-mode's "C-c C-r" that otherwise does nothing when invoked in
+ a *mail* buffer created through rmail-start-mail with sendmail as
+ mail-user-agent.
+
+2012-05-27 Chong Yidong <cyd@gnu.org>
+
+ * net/gnutls.el (gnutls-min-prime-bits): Improve docstring.
+ Default to 256 (Bug#11267).
+
+ * help.el (describe-mode): Doc fix.
+
+2012-05-26 Glenn Morris <rgm@gnu.org>
+
+ * w32-fns.el (w32-init-info): Remove.
+ * paths.el (Info-default-directory-list): Add w32-init-info equivalent.
+
+ * info.el (info-initialize): For self-contained NS builds, put the
+ included info/ directory at the front. (Bug#2791)
+
+ * paths.el (Info-default-directory-list): Make it a defcustom,
+ mainly so that we can use custom-initialize-delay.
+
+2012-05-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (buffer-has-markers-at): Mark obsolete.
+
+ * subr.el (lambda): Use declare.
+
+ * emacs-lisp/lisp-mode.el (lambda):
+ * emacs-lisp/edebug.el (lambda): Move properties to its definition.
+
+2012-05-26 Aaron S. Hawley <aaron.s.hawley@gmail.com>
+
+ * thingatpt.el (forward-same-syntax): Handle no ARG case. (Bug#11560)
+
+2012-05-26 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/cc-mode.el (auto-mode-alist): Fix typo.
+
+2012-05-25 Glenn Morris <rgm@gnu.org>
+
+ * paths.el: Remove no-byte-compile.
+ * loadup.el: No need to load paths.el uncompiled.
+
+ * image.el (imagemagick-types-inhibit): Doc fix.
+
+ * version.el: Remove no-byte-compile and associated formatting.
+ * loadup.el: No need to load version.el uncompiled. AFAICS, this
+ is ancient code from when there was an "inc-vers.el".
+
+2012-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/gdb-mi.el: Minor style changes.
+ (gdb-enable-debug, gdb-speedbar-auto-raise, gdb-many-windows):
+ Turn into minor modes.
+ (gdb--if-arrow): Rename from gdb-if-arrow, make it hygienic.
+ (gdb-mouse-until, gdb-mouse-jump): Adjust uses accordingly.
+ (gdb-shell): Remove unneeded let-binding.
+ (gdb-get-many-fields): Eliminate O(n²) behavior.
+
+2012-05-25 Eli Zaretskii <eliz@gnu.org>
+
+ * cus-start.el <vertical-centering-font-regexp>: Avoid warning on
+ platforms that don't link in fontset.c.
+
+2012-05-25 Juri Linkov <juri@jurta.org>
+
+ Use the same diff color scheme as in modern VCSes (bug#10181).
+
+ * vc/diff-mode.el (diff-header, diff-file-header): Remove "green"
+ to avoid confusion with `diff-added' that now uses green colors.
+ (diff-removed): Use shades of red.
+ (diff-added): Use shades of green.
+ (diff-changed): Leave just the yellow color.
+ (diff-use-changed-face): New variable.
+ (diff-font-lock-keywords): Use `diff-use-changed-face' to decide
+ how to highlight context diff changes.
+ (diff-refine-change): Use shades of yellow.
+ (diff-refine-removed): New face that uses shades of red.
+ (diff-refine-added): New face that uses shades of green.
+ (diff-refine-hunk): Use `diff-refine-change', `diff-refine-added',
+ `diff-refine-removed' in the call to `smerge-refine-subst'
+ depending on the value of `diff-use-changed-face'.
+
+ * vc/smerge-mode.el (smerge-mine): Use shades of red.
+ (smerge-other): Use shades of green.
+ (smerge-base): Use shades of yellow.
+ (smerge-refined-change): Empty face.
+ (smerge-refined-removed): New face that uses shades of red.
+ (smerge-refined-added): New face that uses shades of green.
+ (smerge-refine-subst): Rename arg `props' to `props-c'. Add new
+ args `props-r' and `props-a', and use them. Doc fix.
+ (smerge-refine): Evaluate `smerge-use-changed-face' and depending
+ on its value use different faces `smerge-refined-change',
+ `smerge-refined-removed', `smerge-refined-added' in the call to
+ `smerge-refine-subst'.
+
+ * vc/ediff-init.el (ediff-current-diff-A, ediff-fine-diff-A):
+ Add face condition `min-colors 88' with shades of red.
+ (ediff-current-diff-B, ediff-fine-diff-B): Add face condition
+ `min-colors 88' with shades of green.
+ (ediff-current-diff-C, ediff-fine-diff-C): Add face condition
+ `min-colors 88' with shades of yellow.
+
+2012-05-24 Glenn Morris <rgm@gnu.org>
+
+ * paths.el (prune-directory-list, remote-shell-program): Move to...
+ * files.el (prune-directory-list, remote-shell-program): ...here.
+ For the latter, delay initialization, prefer ssh, just search PATH.
+
+ * paths.el (term-file-prefix): Move to faces.el (the only user).
+ * faces.el (term-file-prefix): Move here, make it a defcustom.
+
+ * paths.el (news-directory, news-path, news-inews-program):
+ Move to gnus/nnspool.el.
+
+ * paths.el (gnus-default-nntp-server): Remove (gnus.el defines it).
+
+ * paths.el (rmail-file-name, rmail-spool-directory): Move from here...
+ * mail/rmail.el (rmail-file-name, rmail-spool-directory): ... to here.
+ Make the latter a defcustom, with a delayed initialization.
+
+ * paths.el (gnus-nntp-service, gnus-local-organization): Remove.
+ These were deleted from Gnus itself late 2010.
+
+2012-05-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/which-func.el (which-func-ff-hook):
+ Check against user-error, not error.
+
+ * emacs-lisp/edebug.el (top): Do not load or set up loading of
+ cl-specs.el, which no longer exists.
+
+2012-05-22 Glenn Morris <rgm@gnu.org>
+
+ * info.el (info-emacs-bug): New command.
+ * menu-bar.el (menu-bar-help-menu): Add "How to Report a Bug" to Help.
+ * mail/emacsbug.el (report-emacs-bug): Replace with info-emacs-bug.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * makefile.w32-in (update-subdirs-SH):
+ * Makefile.in (update-subdirs): Update for moved update-subdirs.
+
+2012-05-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * hi-lock.el (hi-lock-face-defaults): Move obsolete before definition.
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Simplify Maven regexp, and make sure the file can't start with a space
+ (bug#11517).
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (setwins, setwins_almost, setwins_for_subdirs):
+ Scrap superfluous subshells.
+
+2012-05-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-root-dir): New var.
+ (byte-compile-warning-prefix, batch-byte-compile-file): Use it.
+
+2012-05-19 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-ensure-consistent-units): New variable.
+
+ * calc/calc-units.el (math-consistent-units-p)
+ (math-check-unit-consistency): New functions.
+ (calc-quick-units, calc-convert-units):
+ Use `math-check-unit-consistency' when `calc-ensure-consistent-units'
+ is non-nil.
+ (calc-extract-units): Fix typo.
+
+2012-05-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-bzr.el (vc-bzr-state-heuristic): Save match-data around sha1.
+
+ * textmodes/flyspell.el: Commenting style, plus code simplifications.
+ (flyspell-default-deplacement-commands): Don't spell check after
+ repeated window/frame switches (e.g. triggered by mouse-movement).
+ (flyspell-delay-commands, flyspell-deplacement-commands): Use mapc.
+ (flyspell-debug-signal-word-checked): Simplify and fit in 80 cols.
+ (flyspell-casechars-cache, flyspell-ispell-casechars-cache)
+ (flyspell-not-casechars-cache, flyspell-ispell-not-casechars-cache):
+ Remove unused vars.
+ (flyspell-get-casechars, flyspell-get-not-casechars):
+ Simplify; Don't bother removing a ] just to add it back.
+ * textmodes/ispell.el (ispell-program-name): Use executable-find.
+
+2012-05-18 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * calc/calc-lang.el (math-C-parse-bess, math-C-parse-fma):
+ New functions.
+ (math-function-table): Add support for more C functions.
+
+2012-05-18 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/flyspell.el (flyspell-check-pre-word-p)
+ (flyspell-check-word-p, flyspell-debug-signal-word-checked):
+ Protect delay handling for otherchars against empty otherchars.
+
+2012-05-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp-mode.el (doc-string-elt): Move those properties to
+ their respective macro declarations.
+ * skeleton.el (define-skeleton):
+ * progmodes/compile.el (define-compilation-mode):
+ * ibuf-macs.el (define-ibuffer-sorter, define-ibuffer-op)
+ (define-ibuffer-filter):
+ * emacs-lisp/generic.el (define-generic-mode):
+ * emacs-lisp/easy-mmode.el (define-minor-mode)
+ (define-globalized-minor-mode):
+ * emacs-lisp/cl-macs.el (defun*, defmacro*, defstruct, deftype):
+ * emacs-lisp/byte-run.el (defsubst):
+ * custom.el (deftheme): Add doc-string metadata.
+
+2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el, emacs-lisp/cl.el: Move indent info.
+
+2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--u1): Avoid ((lambda ...) ...).
+
+ * emacs-lisp/cl.el: Add edebug specs from cl-specs.el.
+ * emacs-lisp/cl-macs.el: Idem.
+ * emacs-lisp/cl-specs.el: Remove.
+
+2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Minor renaming of internal CL functions and variables.
+ * emacs-lisp/cl-seq.el (cl--adjoin): Rename from cl-adjoin.
+ (cl--position): Rename from cl-position.
+ (cl--delete-duplicates): Rename from cl-delete-duplicates.
+ * emacs-lisp/cl.el (cl--gensym-counter): Rename from *gensym-counter*.
+ (cl--random-state): Rename from *random-state*.
+
+2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-transform-lambda): Don't add spurious
+ parens around the arg list (bug#11499).
+
+2012-05-17 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (word-search-regexp, word-search-backward)
+ (word-search-forward, word-search-backward-lax)
+ (word-search-forward-lax): Move functions from search.c
+ (bug#10145, bug#11381).
+
+2012-05-16 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/flyspell.el (flyspell-check-pre-word-p)
+ (flyspell-check-word-p, flyspell-debug-signal-word-checked):
+ Delay for otherchars as for normal word components.
+
+2012-05-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--sifn-requote): Fix last change.
+ (minibuffer-local-must-match-filename-map):
+ Move define-obsolete-variable-alias before its var.
+
+2012-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase-let*, pcase-let): Fix edebug spec.
+
+ * minibuffer.el (completion--sifn-requote): Handle sifn's truncation
+ behavior.
+ (completion--string-equal-p): New function.
+ (completion--twq-all): Use it to get better assertion failure data.
+
+ Only handle ".." and '..' quoting in shell-mode (bug#11466).
+ * shell.el (shell--unquote&requote-argument, shell--unquote-argument)
+ (shell--requote-argument): New functions.
+ (shell-completion-vars): Use them.
+ (shell--parse-pcomplete-arguments): Rename from
+ shell-parse-pcomplete-arguments.
+ * comint.el (comint-word): Obey comint-file-name-quote-list. Simplify.
+ (comint--unquote&requote-argument): Don't handle ".." and '..' quoting.
+ Obey comint-file-name-quote-list.
+
+ * emacs-lisp/smie.el (smie-indent--bolp-1): New function.
+ (smie-indent-keyword): Use it.
+
+2012-05-14 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el (rst-re-alist): Fix loading (bug#11462).
+
+2012-05-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/rlogin.el (rlogin-mode-map): Fix last change.
+
+2012-05-14 Jason L. Wright <jason.wright@inl.gov> (tiny change)
+
+ * mail/smtpmail.el (smtpmail-send-command): Send the command and
+ the following \r\n using a single `process-send-string', since the
+ Lotus SMTP server refuses to accept any commands if they are sent
+ with two `process-send-string's (Bug#11444).
+
+2012-05-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shell.el (shell-parse-pcomplete-arguments):
+ Obey pcomplete-arg-quote-list inside double-quoted args (Bug#11348).
+
+2012-05-14 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * image-mode.el: Fit to width/height for rotated images (Bug#11431).
+ (image-transform-scale, image-transform-right-angle-fudge): New vars.
+ (image-transform-width, image-transform-fit-width): New functions.
+ (image-transform-properties): Use them.
+ (image-transform-check-size): New function.
+ (image-toggle-display-image): Use it (for testing).
+ (image-transform-set-rotation): Reduce angle mod 360.
+ Delete obsolete comment.
+
+2012-05-14 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * image-mode.el: Fix scaling (bug#11399).
+ (image-transform-resize): Doc fix.
+ (image-transform-properties): Default scale is 1 and height should
+ be an integer.
+
+2012-05-13 Johan Bockgård <bojohan@gnu.org>
+
+ * emacs-lisp/smie.el (smie-next-sexp): Use accessor `op-forw' rather
+ than hard-coding `car', to fix misbehavior when moving forward.
+
+2012-05-13 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-format)
+ (tabulated-list-entries, tabulated-list-padding)
+ (tabulated-list-sort-key): Make permanent-local.
+
+ * ebuff-menu.el: Adapt to Buffer Menu changes (Bug#11455).
+ (electric-buffer-list): Put electric buffer menu
+ command descriptions in this docstring, instead of the docstring
+ of electric-buffer-menu-mode. Code cleanups.
+ (electric-buffer-menu-mode): Use define-derived-mode. Rename from
+ Electric-buffer-menu-mode.
+ (electric-buffer-update-highlight): Minor code cleanup.
+
+2012-05-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-call-method): Restore events not from D-Bus.
+ (Bug#11447)
+
+2012-05-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Move define-obsolete-variable-alias before the var's definition.
+ * vc/log-edit.el (vc-comment-ring, vc-comment-ring-index):
+ * tooltip.el (tooltip-hook):
+ * textmodes/reftex-toc.el (reftex-toc-map):
+ * textmodes/reftex-sel.el (reftex-select-label-map)
+ (reftex-select-bib-map):
+ * textmodes/reftex-index.el (reftex-index-map)
+ (reftex-index-phrases-map):
+ * speedbar.el (speedbar-syntax-table, speedbar-key-map):
+ * progmodes/meta-mode.el (meta-mode-map):
+ * novice.el (disabled-command-hook):
+ * loadhist.el (unload-hook-features-list):
+ * frame.el (blink-cursor):
+ * files.el (find-file-not-found-hooks, write-file-hooks)
+ (write-contents-hooks):
+ * emulation/tpu-edt.el (GOLD-map):
+ * emacs-lock.el (emacs-lock-from-exiting):
+ * emacs-lisp/generic.el (generic-font-lock-defaults):
+ * emacs-lisp/chart.el (chart-map):
+ * dos-fns.el (register-name-alist):
+ * dired-x.el (dired-omit-files-p):
+ * desktop.el (desktop-enable):
+ * cus-edit.el (custom-mode-hook):
+ * buff-menu.el (buffer-menu-mode-hook):
+ * bookmark.el (bookmark-read-annotation-text-func)
+ (bookmark-exit-hooks):
+ * allout.el (allout-mode-deactivate-hook)
+ (allout-exposure-change-hook, allout-structure-added-hook)
+ (allout-structure-deleted-hook, allout-structure-shifted-hook):
+ * dirtrack.el (dirtrack-toggle, dirtrackp, dirtrack-debug-toggle)
+ (dirtrack-debug): Move call to define-obsolete-variable-alias so it
+ comes before the corresponding variable's definition.
+
+2012-05-12 Chong Yidong <cyd@gnu.org>
+
+ * buff-menu.el (Buffer-menu-buffer+size-width): Doc fix (Bug#11454).
+ (Buffer-menu-mouse-select): Restore function (Bug#11459).
+ (Buffer-menu-mode-map): Bind it.
+ (Buffer-menu--pretty-name): Add a mouse-face property.
+
+2012-05-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/prolog.el: Use SMIE. Cleanup regexp setup.
+ (prolog-upper-case-string, prolog-lower-case-string)
+ (prolog-atom-char-regexp, prolog-atom-regexp): Initialize in defconst.
+ (prolog-use-smie, prolog-smie-grammar): New vars.
+ (prolog-smie-forward-token, prolog-smie-backward-token)
+ (prolog-smie-rules): New funs.
+ (prolog-comment-indent): Remove.
+ (prolog-mode-variables): Use default comment indentation instead.
+ Setup SMIE.
+ (prolog-build-case-strings, prolog-set-atom-regexps): Remove.
+ (prolog-mode): Don't call them any more.
+ (prolog-electric-colon, prolog-electric-dash)
+ (prolog-edit-menu-insert-move): Use indent-according-to-mode.
+
+ * dabbrev.el (dabbrev-expand): Make "no expansion found" a user-error.
+
+ * minibuffer.el (completion--twq-all): Again, allow case differences.
+
+ * term.el: Move keymap initialization code to be more idiomatic.
+ (term-signals-menu, term-mode-map, term-raw-map, term-raw-escape-map)
+ (term-terminal-menu): Move initialization into declaration.
+ (term-escape-char): Let the user set it in her .emacs.
+
+ * progmodes/sh-script.el: Use post-self-insert-hook&electric-pair-mode.
+ Provide SMIE-based indentation (not enabled by default yet).
+ (sh-mode-map): Don't bind electric keys.
+ Use electric-pair-mode instead of skeleton-pair.
+ (sh-assignment-regexp): Fit within 80 columns.
+ (sh-indent-supported): Specify actual shell name instead of boolean.
+ (sh--maybe-here-document): New fun, from sh-maybe-here-document.
+ (sh-maybe-here-document): Use it. Make obsolete.
+ (sh-electric-here-document-mode) New minor mode.
+ (sh-mode): Use it. Don't set sh-indent-supported-here here.
+ (sh-smie-sh-grammar, sh-smie--sh-operators, sh-smie--sh-operators-re)
+ (sh-smie--sh-operators-back-re, sh-indent-after-continuation)
+ (sh-smie-rc-grammar, sh-use-smie): New vars.
+ (sh-smie--keyword-p, sh-smie--newline-semi-p, sh-smie--sh-keyword-p)
+ (sh-smie-sh-forward-token, sh-smie--looking-back-at-continuation-p)
+ (sh-smie-sh-backward-token, sh-smie--continuation-start-indent)
+ (sh-smie-sh-rules, sh-smie-rc-rules, sh-smie--sh-keyword-in-p)
+ (sh-smie--rc-after-special-arg-p, sh-smie-rc-backward-token)
+ (sh-smie-sh-rules, sh-smie--rc-newline-semi-p): New functions.
+ (sh-set-shell): Use smie-setup if requested.
+
+ * term.el (term-set-escape-char): Properly set term-escape-char.
+ See http://stackoverflow.com/questions/10524656.
+
+2012-05-10 Chong Yidong <cyd@gnu.org>
+
+ * ffap.el (ffap-url-unwrap-local): Make it work right (Bug#9131).
+ Use url-generic-parse-url, and handle host names and Windows
+ filenames properly.
+ (ffap-url-unwrap-remote): Use url-generic-parse-url.
+ (ffap-url-unwrap-remote): Accept list values, specifying a list of
+ URL schemes to work on.
+ (ffap--toggle-read-only): New function.
+ (ffap-read-only, ffap-read-only-other-window)
+ (ffap-read-only-other-frame): Use it.
+ (ffap-fixup-url): Don't check ffap-ftp-regexp, since it is not
+ necessary for ffap-url-unwrap-remote.
+
+2012-05-10 Dave Abrahams <dave@boostpro.com>
+
+ * cus-start.el (create-lockfiles): Add it.
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
+
+ * net/browse-url.el (browse-url-url-encode-chars): Use upper-case.
+ (browse-url-encode-url): Encode spaces and quotes (Bug#6300).
+
+2012-05-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shell.el (shell-completion-vars): Fix last change (bug#11348).
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
+
+ * ansi-color.el (ansi-color-process-output): Check for validity of
+ comint-last-output-start before using it. This avoids a bad
+ interaction with gdb-mi's input/output buffer.
+
+2012-05-09 Glenn Morris <rgm@gnu.org>
+
+ * files.el (dir-locals-read-from-file):
+ Mention dir-locals in any error message.
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/package.el (package-built-in-p): Handle the `emacs'
+ package (Bug#11410).
+
+ * emacs-lisp/package.el (package-buffer-info): Avoid putting local
+ variables into description.
+
+2012-05-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shell.el (shell-completion-vars): Set pcomplete-arg-quote-list like
+ shell-delimiter-argument-list (bug#11348).
+ (shell-parse-pcomplete-arguments): Obey pcomplete-arg-quote-list.
+
+2012-05-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * textmodes/rst.el: Silence byte-compiler warnings.
+ (rst-re-alist, rst-reset-section-caches): Move around.
+ (rst-re): Use `characterp', not `char-valid-p'.
+ (font-lock-beg, font-lock-end): Declare.
+
+ * progmodes/idlw-shell.el (specs): Remove reference to deleted
+ variable `idlwave-shell-activate-alt-keybindings' and simplify.
+
+ * eshell/esh-cmd.el (eshell-debug-command): Fix typo in previous change.
+
+2012-05-08 Glenn Morris <rgm@gnu.org>
+
+ * files.el (auto-mode-alist): Treat ".make" like ".mk".
+
+2012-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/log-edit.el: Add GNU coding standards highlighting.
+ (log-edit-font-lock-gnu-style)
+ (log-edit-font-lock-gnu-keywords): New vars.
+ (log-edit-font-lock-keywords): New fun.
+ (log-edit-mode): Don't fold case in font-lock.
+ (log-edit-font-lock-keywords): Do not assume case-folding.
+
+ * imenu.el: Misc cleanup. Make docstrings out of comments.
+ Use lexical-binding.
+ (imenu--index-alist, imenu--last-menubar-index-alist)
+ (imenu-menubar-modified-tick): Use defvar-local.
+ (imenu--split-menu): Remove unused var.
+ (imenu--cleanup-seen): Declare as global.
+ (imenu--cleanup): Use dolist.
+
+ * subr.el (defvar-local): Add debug spec and doc-string position.
+
+2012-05-08 Glenn Morris <rgm@gnu.org>
+
+ * language/burmese.el, language/cham.el, language/czech.el:
+ * language/english.el, language/georgian.el, language/greek.el:
+ * language/japanese.el, language/khmer.el, language/korean.el:
+ * language/lao.el, language/misc-lang.el, language/romanian.el:
+ * language/sinhala.el, language/slovak.el, language/tai-viet.el:
+ * language/thai.el, language/utf-8-lang.el:
+ Remove no-byte-compile setting.
+
+ * play/zone.el (zone-pgm-stress): Don't pollute kill-ring. (Bug#11388)
+
+2012-05-08 Aaron S. Hawley <aaron.s.hawley@gmail.com>
+
+ * progmodes/make-mode.el (makefile-browse):
+ Remove unnecessary interactive. (Bug#11324)
+
+2012-05-07 Glenn Morris <rgm@gnu.org>
+
+ * forms-d2.el, forms-pass.el: Move to ../etc/forms directory.
+
+ * international/mule.el (find-auto-coding): Make "unibyte: t" obsolete.
+
+2012-05-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * loadup.el: Preload newcomment.el.
+ * newcomment.el: Move autoload-only code to toplevel.
+
+ * buff-menu.el (list-buffers--refresh): Mark `size' as right-align.
+ * emacs-lisp/tabulated-list.el (tabulated-list-init-header):
+ Handle new :right-align column property.
+ (tabulated-list-print-col): Idem, plus use `display' text-property to
+ try and preserve alignment for variable pitch fonts.
+
+2012-05-07 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/tabulated-list.el: Add no-header-line alternative.
+ (tabulated-list-use-header-line): New var.
+ (tabulated-list-init-header): Use it.
+ (tabulated-list-print-fake-header): New function.
+ (tabulated-list-print): Use it.
+ (tabulated-list-sort-button-map): Add non-header-line commands.
+ (tabulated-list-init-header): Add column name property to basic
+ labels as well.
+ (tabulated-list-col-sort): Handle non-header-line button case.
+ (tabulated-list--sort-by-column-name): Fix a corner case.
+
+ * buff-menu.el (list-buffers--refresh):
+ Handle Buffer-menu-use-header-line.
+
+2012-05-06 Chong Yidong <cyd@gnu.org>
+
+ * buff-menu.el: Convert to Tabulated List mode.
+ (Buffer-menu-buffer+size-width): Make obsolete.
+ (Buffer-menu-name-width, Buffer-menu-size-width): New variables.
+ (Buffer-menu-mode-map): Inherit from tabulated-list-mode-map.
+ (Buffer-menu-mode): Derive from tabulated-list-mode. Move command
+ documentation into docstring of buffer-menu.
+ (Buffer-menu-toggle-files-only): Add an informative message.
+ (Buffer-menu-sort): Convert to alias for tabulated-list-sort.
+ (Buffer-menu-buffer, Buffer-menu-beginning, Buffer-menu-mark)
+ (Buffer-menu-unmark, Buffer-menu-backup-unmark)
+ (Buffer-menu-delete, Buffer-menu-save, Buffer-menu-not-modified)
+ (Buffer-menu-execute, Buffer-menu-select)
+ (Buffer-menu-marked-buffers, Buffer-menu-toggle-read-only)
+ (Buffer-menu-bury): Use Tabulated List machinery.
+ (Buffer-menu-mouse-select, Buffer-menu-sort-by-column)
+ (Buffer-menu-sort-button-map, Buffer-menu-make-sort-button):
+ Delete.
+ (list-buffers--refresh): New function.
+ (list-buffers-noselect): Use it.
+ (tabulated-list-entry-size->, Buffer-menu--pretty-name)
+ (Buffer-menu--pretty-file-name): New helper functions.
+
+ * loadup.el: Preload tabulated-list.
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-sort): Rename from
+ tabulated-list-sort-column.
+ (tabulated-list-init-header): Add the initial aligning space even
+ if tabulated-list-padding is zero.
+
+2012-05-06 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * emacs-lisp/cl-macs.el (cl-expr-contains): Handle cons cells
+ whose cdr is not a cons cell correctly (bug#11038).
+
+2012-05-06 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-format):
+ Accept additional plist in column descriptors.
+ (tabulated-list-init-header): Obey it.
+ (tabulated-list-get-entry): New function.
+ (tabulated-list-put-tag): Use it. Use string-width instead of
+ length.
+ (tabulated-list--column-number): New function.
+ (tabulated-list-print): Use it.
+ (tabulated-list-print-col): New function.
+ Set `tabulated-list-column-name' property on each column's text.
+ (tabulated-list-print-entry): Use it.
+ (tabulated-list-delete-entry, tabulated-list-set-col):
+ New functions.
+ (tabulated-list-sort-column): New command (Bug#11337).
+
+ * buff-menu.el (list-buffers): Move C-x C-b binding from
+ buff-menu.el to bindings.el.
+
+ * ebuff-menu.el (Electric-buffer-menu-undefined): Use the
+ :advertised-binding feature.
+
+2012-05-06 Troels Nielsen <bn.troels@gmail.com> (tiny change)
+
+ * progmodes/compile.el (compilation-internal-error-properties):
+ Calculate start position correctly when end-col is set but
+ end-line is not (Bug#11382).
+
+2012-05-06 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * man.el (Man-unindent): Use text-property-default-nonsticky to
+ prevent untabify from inheriting face properties (Bug#11408).
+
+2012-05-05 Stefan Merten <smerten@oekonux.de>
+
+ * textmodes/rst.el: Major merge with upstream development up to
+ Docutils SVN r7399 / rst.el V1.2.1.
+
+ Clarify maintainership and authors.
+
+ (rst-extract-version, rst-cvs-header, rst-cvs-rev)
+ (rst-cvs-timestamp, rst-svn-rev, rst-svn-timestamp)
+ (rst-official-version, rst-official-cvs-rev, rst-version)
+ (rst-package-emacs-version-alist): New functions and variables
+ for version information.
+
+ (rst-bullets, rst-uri-schemes, rst-adornment-chars)
+ (rst-max-inline-length, rst-re-alist-def, rst-re-alist)
+ (rst-mode-syntax-table, rst-mode): New and corrected functions
+ and variables representing reStructuredText features.
+
+ (rst-re): New function for reStructuredText regexes. Use in
+ many places.
+
+ (rst-deprecated-keys, rst-call-deprecated, rst-define-key)
+ (rst-mode-map): Rebind keys.
+
+ (rst-mode-lazy, rst-font-lock-keywords)
+ (rst-font-lock-extend-region)
+ (rst-font-lock-extend-region-internal)
+ (rst-font-lock-extend-region-extend)
+ (rst-font-lock-find-unindented-line-limit)
+ (rst-font-lock-find-unindented-line-match)
+ (rst-adornment-level, rst-font-lock-adornment-level)
+ (rst-font-lock-adornment-match)
+ (rst-font-lock-handle-adornment-pre-match-form)
+ (rst-font-lock-handle-adornment-matcher): Major revision of
+ font-locking. Integrate with other code. Use `jit-lock-mode'.
+
+ (rst-preferred-adornments, rst-adjust-hook)
+ (rst-new-adornment-down, rst-preferred-bullets)
+ (rst-preferred-bullets, rst-indent, rst-indent-width)
+ (rst-indent-field, rst-indent-literal-normal)
+ (rst-indent-literal-minimized, rst-indent-comment): Change,
+ extend and improve customization.
+
+ (rst-line-homogeneous-p, rst-line-homogeneous-nodent-p)
+ (rst-normalize-cursor-position, rst-get-decoration)
+ (rst-straighten-deco-spacing, rst-re-bullets, rst-re-items)
+ (rst-rstrip, rst-toc-insert-find-delete-contents)
+ (rst-shift-fill-region, rst-compute-bullet-tabs)
+ (rst-debug-print-tabs, rst-debug-mark-found)
+ (rst-shift-region-guts, rst-shift-region-right)
+ (rst-shift-region-left, rst-use-char-classes)
+ (rst-font-lock-keywords-function)
+ (rst-font-lock-indentation-point)
+ (rst-font-lock-find-unindented-line-begin)
+ (rst-font-lock-find-unindented-line-end)
+ (rst-font-lock-find-unindented-line)
+ (rst-font-lock-adornment-point, rst-font-lock-level)
+ (rst-adornment-level-alist): Remove functions and variables.
+
+ (rst-compare-adornments, rst-get-adornment-match)
+ (rst-suggest-new-adornment, rst-get-adornments-around)
+ (rst-adornment-complete-p, rst-get-next-adornment)
+ (rst-adjust-adornment, rst-display-adornments-hierarchy)
+ (rst-straighten-adornments): Standardize function names to
+ use "adornment" instead of "decoration". Correct callers.
+ Similar standardizing in many places.
+
+ (rst-update-section, rst-adjust, rst-promote-region)
+ (rst-enumerate-region, rst-bullet-list-region)
+ (rst-repeat-last-character): Correct use of `interactive'.
+
+ (rst-classify-adornment, rst-find-all-adornments)
+ (rst-get-hierarchy, rst-adjust-adornment, rst-toc-update)
+ (rst-find-leftmost-column, rst-repeat-last-character):
+ Refactor functions.
+
+ (rst-find-title-line, rst-reset-section-caches)
+ (rst-get-adornments-around, rst-adjust-adornment-work)
+ (rst-arabic-to-roman, rst-roman-to-arabic)
+ (rst-insert-list-pos, rst-insert-list-new-item)
+ (rst-insert-list-continue, rst-insert-list, rst-forward-line):
+ New functions.
+
+ (rst-all-sections, rst-section-hierarchy)
+ (rst-arabic-to-roman, rst-initial-enums, rst-initial-items):
+ New variables.
+
+ (rst-toc-return-wincfg, rst-toc-quit-window): Use window
+ configuration instead of only buffer. Change where necessary.
+
+ (rst-line-tabs, rst-compute-tabs, rst-indent-line)
+ (rst-shift-region, rst-adaptive-fill): New functions for
+ indentation and filling.
+
+ (rst-comment-line-break, rst-comment-indent)
+ (rst-comment-insert-comment, rst-comment-region)
+ (rst-uncomment-region): New functions for handling comments.
+
+ (rst-compile): Quote shell arguments.
+
+ (rst-compile-pdf-preview, rst-compile-slides-preview):
+ Delete temporary files after use.
+
+2012-05-05 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-html.el: Optionally include holidays in the output.
+ Suggested by Ed Reingold <reingold@emr.cs.iit.edu>.
+ (cal-html-holidays): New option.
+ (cal-html-css-default): Add holiday entry.
+ (holiday-in-range): Autoload it.
+ (cal-html-htmlify-entry): Add optional class argument.
+ (cal-html-htmlify-list): Add optional holidays argument.
+ (cal-html-insert-agenda-days): Include holidays in the output.
+ (cal-html-one-month): Maybe include holidays.
+
+ * calendar/holidays.el (holiday-in-range):
+ Move here from cal-tex-list-holidays.
+ * calendar/cal-tex.el (cal-tex-list-holidays):
+ Make it an obsolete alias for holiday-in-range. Update all callers.
+
+2012-05-05 Chong Yidong <cyd@gnu.org>
+
+ * select.el (xselect--encode-string): Always use utf-8 for TEXT on
+ Nextstep.
+
+2012-05-05 Ransom Williams <auvergnerw@gmail.com> (tiny change)
+
+ * files.el (file-auto-mode-skip): New var.
+ (set-auto-mode-1): Use it.
+
+2012-05-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * repeat.el: Use lexical-binding.
+ (repeat-last-self-insert, repeat-num-input-keys-at-self-insert)
+ (repeat-undo-count): Remove.
+ (repeat):
+ * progmodes/octave-mod.el (octave-abbrev-start):
+ * progmodes/f90.el (f90-abbrev-start):
+ * face-remap.el (text-scale-adjust):
+ * kmacro.el (kmacro-call-macro): Use set-temporary-overlay-map.
+
+ * emacs-lisp/pcase.el (pcase--let*): New function.
+ (pcase--expand, pcase-codegen, pcase--q1): Use it to reduce nesting
+ a bit more.
+ (pcase--split-pred): Be more clever about ruling out overlap between
+ a predicate and some constant pattern.
+ (pcase--q1): Use `null' instead of (eq foo nil).
+
+ * subr.el (setq-local, defvar-local): New macros.
+ (kbd): Redefine as an alias.
+ (with-selected-window): Leave unrelated frames alone.
+ (set-temporary-overlay-map): New function.
+
+2012-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (user-error): New function.
+ * window.el (switch-to-buffer):
+ * vc/smerge-mode.el (smerge-resolve-function, smerge-resolve)
+ (smerge-match-conflict):
+ * simple.el (previous-matching-history-element)
+ (next-matching-history-element, goto-history-element, undo-more)
+ (undo-start):
+ * progmodes/etags.el (visit-tags-table-buffer, find-tag-tag)
+ (find-tag-noselect, find-tag-in-order, etags-goto-tag-location)
+ (next-file, tags-loop-scan, list-tags, complete-tag):
+ * progmodes/compile.el (compilation-loop):
+ * mouse.el (mouse-minibuffer-check):
+ * man.el (Man-bgproc-sentinel, Man-goto-page):
+ * info.el (Info-find-node-2, Info-extract-pointer, Info-history-back)
+ (Info-history-forward, Info-follow-reference, Info-menu)
+ (Info-extract-menu-item, Info-extract-menu-counting)
+ (Info-forward-node, Info-backward-node, Info-next-menu-item)
+ (Info-last-menu-item, Info-next-preorder, Info-last-preorder)
+ (Info-next-reference, Info-prev-reference, Info-index)
+ (Info-index-next, Info-follow-nearest-node)
+ (Info-copy-current-node-name):
+ * imenu.el (imenu--make-index-alist)
+ (imenu-default-create-index-function, imenu-add-to-menubar):
+ * files.el (basic-save-buffer, recover-file):
+ * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
+ * emacs-lisp/checkdoc.el (checkdoc-continue, checkdoc-comments)
+ (checkdoc-message-text, checkdoc-defun):
+ * dabbrev.el (dabbrev-completion, dabbrev--abbrev-at-point):
+ * cus-edit.el (customize-changed-options, customize-rogue)
+ (customize-saved, custom-variable-set, custom-variable-mark-to-save)
+ (custom-variable-mark-to-reset-standard)
+ (custom-variable-reset-backup, custom-face-mark-to-reset-standard)
+ (custom-file):
+ * completion.el (check-completion-length):
+ * comint.el (comint-search-arg)
+ (comint-previous-matching-input-string-position)
+ (comint-previous-matching-input)
+ (comint-replace-by-expanded-history-before-point, comint-send-input)
+ (comint-copy-old-input, comint-backward-matching-input)
+ (comint-goto-process-mark, comint-set-process-mark):
+ * calendar/calendar.el (calendar-cursor-to-date): Use it.
+ * bindings.el (debug-ignored-errors): Remove regexps, add `user-error'.
+
+2012-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * dabbrev.el (dabbrev--ignore-case-p): New function.
+ (dabbrev-completion, dabbrev-expand, dabbrev--substitute-expansion):
+ Use it.
+
+ * files.el (automount-dir-prefix): Mark as obsolete.
+
+2012-05-04 Glenn Morris <rgm@gnu.org>
+
+ * patcomp.el, play/bruce.el: Move to obsolete/.
+
+2012-05-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor Y10k bugs.
+ * arc-mode.el (archive-unixdate):
+ * autoinsert.el (auto-insert-alist):
+ * calc/calc-forms.el (math-this-year):
+ * emacs-lisp/copyright.el (copyright-current-year)
+ (copyright-update-year, copyright):
+ * tar-mode.el (tar-clip-time-string):
+ * time.el (display-time-update):
+ Don't assume years have 4 digits.
+
+2012-05-04 Chong Yidong <cyd@gnu.org>
+
+ * dos-w32.el (file-name-buffer-file-type-alist)
+ (direct-print-region-use-command-dot-com):
+ * ffap.el (ffap-menu-regexp):
+ * find-file.el (ff-special-constructs):
+ * follow.el (follow-debug):
+ * forms.el (forms--debug):
+ * iswitchb.el (iswitchb-all-frames):
+ * ido.el (ido-all-frames):
+ * emacs-lisp/timer.el (timer-max-repeats):
+ * mail/feedmail.el (feedmail-mail-send-hook)
+ (feedmail-mail-send-hook-queued):
+ * mail/footnote.el (footnote-signature-separator):
+ * mail/mailabbrev.el (mail-alias-separator-string)
+ (mail-abbrev-mode-regexp):
+ * mail/rmail.el (rmail-speedbar-match-folder-regexp):
+ * progmodes/idlwave.el (idlwave-libinfo-file)
+ (idlwave-default-completion-case-is-down)
+ (idlwave-library-routines): Convert defvars to defcustoms.
+
+ * mail/rmail.el (rmail-decode-mime-charset):
+ * progmodes/idlw-shell.el (idlwave-shell-print-expression-function)
+ (idlwave-shell-fix-inserted-breaks)
+ (idlwave-shell-activate-alt-keybindings)
+ (idlwave-shell-use-breakpoint-glyph):
+ * facemenu.el (facemenu-unlisted-faces): Delete obsolete vars.
+
+2012-05-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--twq-all): Beware completion-ignore-case.
+
+2012-05-03 Wilson Snyder <wsnyder@wsnyder.org>
+
+ * progmodes/verilog-mode.el (font-lock-keywords):
+ Fix mis-highligting auto. Reported by Craig Barner.
+ (verilog-auto, verilog-auto-undef): Add AUTOUNDEF to remove
+ defines from global name space. Reported by Dan Dever.
+ (verilog-auto-reset, verilog-auto-reset-widths)
+ (verilog-auto-tieoff): Support using unbased numbers for
+ AUTORESET and AUTOTIEOFF.
+ (verilog-submit-bug-report): Update variable list.
+ (verilog-read-auto-params): Fix AUTOINPUT regexps containing
+ parenthesis from not matching. Reported by Michael Rytting.
+ (verilog-auto-template-lint): Fix hash error when linting modules
+ with no used templates.
+ (verilog-warn, verilog-warn-error)
+ (verilog-warn-fatal): When non-interactive report multiple
+ warnings before exiting. Suggested by Brad Dobbie.
+ (verilog-auto-template-lint, verilog-auto-template-warn-unused)
+ (verilog-read-auto-template): Add `verilog-auto-template-warn-unused'
+ to report unused template errors. Reported by Brad Dobbie.
+ (verilog-read-decls): Fix AUTOWIRE etc on supply0, supply1 type
+ nets, bug438. Reported by Vns Blore.
+ (verilog-auto-inout-module, verilog-auto-reg)
+ (verilog-read-decls, verilog-read-sub-decls-sig)
+ (verilog-signals-edit-wire-reg, verilog-signals-with):
+ Fix passing of Verilog data types in ANSI input/output ports
+ such as "output logic" into the AUTOs. Special case "wire" and
+ "reg" for backwards compatibility presuming Verilog 2001.
+ (verilog-auto-ascii-enum): Add "auto enum" as alias.
+ (verilog-preprocess): Fix replication of preprocess output.
+ Reported by Brad Dobbie.
+ (verilog-auto-inst-interfaced-ports):
+ Create verilog-auto-inst-interfaced-ports, bug429.
+ Reported by Julian Gorfajn.
+ (verilog-after-save-font-hook)
+ (verilog-before-save-font-hook): New variable.
+ (verilog-modi-cache-results, verilog-save-font-mod-hooked)
+ (verilog-save-font-mods): Wrap disabling fontification, reported
+ by David Rogoff.
+ (verilog-do-indent, verilog-pretty-declarations-auto)
+ (verilog-sk-def-reg): Fix obeying `verilog-auto-lineup', bug305.
+ Reported by Pierre-David Pfister.
+ (verilog-set-auto-endcomments): Fix endtask auto comments outside
+ of class declarations, bug292. Reported by Kevin Heilman.
+ (verilog-read-decls): Fix 'parameter type' not appearing in
+ AUTOINSTPARAM, bug340. Reported by Jonathan Greenlaw.
+ (verilog-auto-logic): Fix when AUTOLOGIC present to properly do
+ AUTOINPUTs, bug411. Reported by Jonathan Greenlaw.
+ (verilog-read-auto-lisp): Avoid syntax-ppss warning on AUTOLISP.
+ Reported by David Kravitz.
+
+2012-05-03 Michael McNamara <mac@mail.brushroad.com>
+
+ * progmodes/verilog-mode.el (verilog-pretty-expr): Don't line up
+ assignment with tests in ifs and for loops.
+ (verilog-extended-complete-re, verilog-complete-reg): Change so
+ that DPI inport functions don't look like fuction declarations.
+ (verilog-pretty-expr): Don't line up assignment
+ operations to the test and increment in if and for loops
+ (verilog-extended-complete-re, verilog-complete-reg): Change so
+ that DPI inport functions don't look like fuction declarations.
+
+2012-05-03 Kenichi Handa <handa@m17n.org>
+
+ * mail/rmailmm.el (rmail-show-mime): Catch an error caused by text
+ decoding, and show a warning message without signaling an error
+ (Bug#11282).
+
+2012-05-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el
+ (byte-compile-file-form-custom-declare-variable): Compile all elements,
+ since cconv.el might have introduced :fun-body, internal-make-closure,
+ and friends for bytecomp to handle (bug#11391).
+ * custom.el (defcustom): Avoid ((λ ..) ..).
+
+2012-05-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (read-passwd): Better clean after ourselves (bug#11392).
+
+2012-05-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * notifications.el (dbus-debug):
+ * term/linux.el (gpm-mouse-enable):
+ * term/screen.el (xterm-register-default-colors): Declare.
+
+2012-05-02 Chong Yidong <cyd@gnu.org>
+
+ * cus-start.el (gc-cons-percentage, exec-suffixes)
+ (dos-display-scancodes, dos-hyper-key, dos-super-key)
+ (dos-keypad-mode, debug-on-signal, vertical-centering-font-regexp)
+ (make-cursor-line-fully-visible, void-text-area-pointer)
+ (font-list-limit): Add customization data.
+
+ * allout.el (allout-exposure-change-functions)
+ (allout-structure-added-functions)
+ (allout-structure-deleted-functions)
+ (allout-structure-shifted-functions): Rename abnormal hooks from
+ *-hook, and convert to defcustoms.
+ (allout-after-copy-or-kill-hook, allout-post-undo-hook):
+ Convert to defcustoms.
+ (allout-mode-hook, allout-mode-deactivate-hook): Doc fix.
+
+ * allout-widgets.el: Hook callers changed.
+
+2012-05-02 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/rmail.el (rmail-yank-current-message): Use the encoding of
+ the yanked message in preference to the default value of
+ buffer-file-coding-system.
+
+2012-05-02 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer--action-function-custom-type):
+ Fix entry.
+
+2012-05-02 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-defs.el (c-version): Update to 5.32.3.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * cus-start.el (suggest-key-bindings): Remove, now it is in Lisp.
+
+ * eshell/esh-cmd.el (eshell-debug-command): Doc fix. Add :set.
+
+ * cus-edit.el (custom-variable-documentation): Simplify with format.
+
+2012-05-01 Aaron S. Hawley <aaron.s.hawley@gmail.com>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (suggest-key-bindings, execute-extended-command):
+ Move from keyboard.c.
+
+2012-05-01 Chong Yidong <cyd@gnu.org>
+
+ * follow.el: Eliminate advice.
+ (set-process-filter, process-filter, sit-for): Advice deleted.
+ (follow-mode-off-hook): Obsolete hook removed.
+ (follow-avoid-tail-recenter-p, follow-process-filter-alist):
+ Vars deleted.
+ (follow-auto): Use a :set function.
+ (follow-mode): Rewritten. Don't advise process filters.
+ (follow-switch-to-current-buffer-all, follow-scroll-up)
+ (follow-scroll-down): Assume follow-mode is bound.
+ (follow-comint-scroll-to-bottom)
+ (follow-align-compilation-windows): New functions.
+ (follow--window-sorter): New function.
+ (follow-all-followers): Use it to explicitly sort windows by their
+ positions; don't make assumptions about next-window order.
+ (follow-windows-start-end, follow-delete-other-windows-and-split)
+ (follow-calc-win-start): Doc fix.
+ (follow-windows-aligned-p, follow-select-if-visible): Don't call
+ vertical-motion unnecessarily.
+ (follow-adjust-window): New function.
+ (follow-post-command-hook): Use it.
+ (follow-call-set-process-filter, follow-call-process-filter)
+ (follow-intercept-process-output, follow-tidy-process-filter-alist)
+ (follow-stop-intercept-process-output, follow-generic-filter):
+ Functions deleted.
+ (follow-scroll-bar-toolkit-scroll, follow-scroll-bar-drag)
+ (follow-scroll-bar-scroll-up, follow-scroll-bar-scroll-down):
+ New functions, replacing advice on scroll-bar-* commands.
+ (follow-mwheel-scroll): New function (Bug#4112).
+
+ * comint.el (comint-adjust-point): New function.
+ (comint-postoutput-scroll-to-bottom): Use it.
+ Call follow-comint-scroll-to-bottom for Follow mode buffers.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * term/AT386.el, term/apollo.el, term/bobcat.el, term/cygwin.el:
+ * term/iris-ansi.el, term/linux.el, term/lk201.el, term/news.el:
+ * term/screen.el, term/vt102.el, term/vt125.el, term/vt200.el:
+ * term/vt201.el, term/vt220.el, term/vt240.el, term/vt300.el:
+ * term/vt320.el, term/vt400.el, term/vt420.el, term/wyse50.el:
+ Remove no-byte-compile setting.
+
+2012-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-table-with-quoting): Fix compatibility
+ all-completions code to not return a number in the last cdr.
+
+2012-04-30 Leo Liu <sdl.web@gmail.com>
+
+ * ibuf-ext.el (ibuffer-diff-buffer-with-file-1): Avoid buffer
+ read-only error.
+
+2012-04-29 Chong Yidong <cyd@gnu.org>
+
+ * follow.el (follow-calc-win-end): Rewrite to handle partial
+ screen lines correctly (Bug#8390).
+ (follow-avoid-tail-recenter): Minor cleanup.
+
+2012-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Avoid the obsolete `assoc' package.
+ * speedbar.el (speedbar-refresh): Avoid adelete.
+ (speedbar-file-lists): Simplify and avoid aput.
+ * man.el (Man--sections, Man--refpages): New vars, replacing
+ Man-sections-alist and Man-refpages-alist.
+ (Man-build-section-alist, Man-build-references-alist):
+ Use them; avoid aput.
+ (Man--last-section, Man--last-refpage): New vars.
+ (Man-follow-manual-reference): Use them.
+ Use the `default' arg of completing-read.
+ (Man-goto-section): Idem. Move prompt to the `interactive' spec.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * vc/diff.el (diff-sentinel): Go to bob (Bug#10259).
+
+ * startup.el (x-apply-session-resources): New function.
+
+ * term/ns-win.el (ns-initialize-window-system):
+ * term/w32-win.el (w32-initialize-window-system):
+ * term/x-win.el (x-initialize-window-system): Use it to properly
+ set menu-bar-mode and other vars from X resources, even if the
+ initial frame is not a window-system frame (Bug#2299).
+
+ * subr.el (read-key): Avoid running filter function when setting
+ up temporary tool bar entries (Bug#9922).
+
+2012-04-27 Andreas Schwab <schwab@linux-m68k.org>
-2012-07-18 Stefan Monnier <monnier@iro.umontreal.ca>
+ * vc/vc-git.el (vc-git-state): Fix regexp matching diff output.
+ (Bug#11344)
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * select.el (xselect--encode-string): New function, split from
+ xselect-convert-to-string.
+ (xselect-convert-to-string): Use it.
+ (xselect-convert-to-filename, xselect-convert-to-os)
+ (xselect-convert-to-host, xselect-convert-to-user): Ensure that
+ returned strings are properly encoded (Bug#11315).
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (delete-active-region): Move to killing custom group.
+
+2012-04-27 Andreas Schwab <schwab@linux-m68k.org>
+
+ * progmodes/which-func.el (which-func-current): Quote %
+ characters for mode-line processing.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * xml.el (xml-parse-region, xml-parse-tag): Avoid errors due to
+ reaching eob (Bug#11286).
+
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-control-level): New variable.
+ (gdb): Make it buffer-local and init to zero.
+ (gdb-control-commands-regexp): New variable.
+ (gdb-send): Don't wrap in "-interpreter-exec console" if
+ gdb-control-level is positive. Increment gdb-control-level
+ whenever the command matches gdb-control-commands-regexp, and
+ decrement it each time the command is "end". (Bug#11279)
+
+2012-04-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (adjust-window-trailing-edge, enlarge-window)
+ (shrink-window, window-resize):
+ * mouse.el (mouse-drag-line): Fix resizing of minibuffer
+ windows (Bug#11276).
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/pascal.el (pascal--extra-indent): Rename from ind, to
+ fix "missing prefix" warning. All callers changed.
+
+2012-04-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/assoc.el: Move to obsolete/.
+
+2012-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/assoc.el (aget): Fix dynamic-scoping issue (bug#11352).
+
+ * term/ns-win.el (ns-define-service):
+ * progmodes/pascal.el (pascal-goto-defun):
+ * progmodes/js.el (js--read-tab):
+ * progmodes/etags.el (tags-lazy-completion-table):
+ * emacs-lisp/syntax.el (syntax-propertize-via-font-lock):
+ * emacs-lisp/ewoc.el (ewoc--wrap):
+ * emacs-lisp/assoc.el (aput, adelete, amake):
+ * doc-view.el (doc-view-convert-current-doc):
+ * vc/diff.el (diff-no-select): Replace lexical-let by lexical-binding.
+
+2012-04-26 Chong Yidong <cyd@gnu.org>
+
+ * image.el (image-type-from-buffer): Only return supported image
+ type (Bug#9045).
+
+ * vc/diff-mode.el (diff-beginning-of-hunk): Return a meaningful
+ value, for symmetry with diff-end-of-hunk.
+ (diff-split-hunk, diff-find-source-location)
+ (diff-ignore-whitespace-hunk, diff-refine-hunk): Use it.
+ (diff-bounds-of-hunk, diff-bounds-of-file): New functions.
+ (diff-restrict-view, diff-hunk-kill, diff-file-kill): Use them to
+ compute the relevant hunk or file properly (Bug#6005).
+ (diff-file-junk-re): Add bzr's "modified file" tag (Bug#6041).
+
+2012-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-mtn.el:
+ * vc/vc-hg.el:
+ * vc/vc-git.el:
+ * vc/vc-dir.el:
+ * vc/vc-cvs.el:
+ * vc/vc-bzr.el:
+ * vc/vc-arch.el:
+ * vc/vc.el: Replace lexical-let by lexical-binding.
+ * minibuffer.el (lazy-completion-table): Avoid ((λ ...) ...).
+ * emacs-lisp/cl-macs.el (lexical-let): Fix use in lexical-binding.
+ * emacs-lisp/cconv.el (cconv-analyse-form): Warn use of ((λ ...) ...).
+
+2012-04-26 Chong Yidong <cyd@gnu.org>
+
+ * vc/diff-mode.el (diff-undo): New command (Bug#5302).
+ (diff-mode-shared-map): Bind it to / and [remap undo].
+
+ * vc/ediff-wind.el (ediff-setup-windows-default): New function.
+ (ediff-window-setup-function): Use it as the default, to set up
+ windows based on whether the current frame is graphical (Bug#2138).
+ (ediff-choose-window-setup-function-automatically): Make obsolete.
+
+ * vc/ediff-init.el: Always define ediff-pixel-width/height.
+
+2012-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ffap.el: Remove old code for obsolete package.
+ (ffap-complete-as-file-p): Remove.
+
+ Use completion-table-with-quoting for comint and pcomplete.
+ * comint.el (comint--unquote&requote-argument)
+ (comint--unquote-argument, comint--requote-argument): New functions.
+ (comint--unquote&expand-filename, comint-unquote-filename): Obsolete.
+ (comint-quote-filename): Use regexp-opt-charset.
+ (comint--common-suffix, comint--common-quoted-suffix)
+ (comint--table-subvert): Remove.
+ (comint-unquote-function, comint-requote-function): New vars.
+ (comint--complete-file-name-data): Use them with
+ completion-table-with-quoting.
+ * pcmpl-unix.el (pcomplete/scp): Use completion-table-subvert.
+ * pcomplete.el (pcomplete-arg-quote-list)
+ (pcomplete-quote-arg-hook, pcomplete-quote-argument): Obsolete.
+ (pcomplete-unquote-argument-function): Default to non-nil.
+ (pcomplete-unquote-argument): Simplify.
+ (pcomplete--common-quoted-suffix): Remove.
+ (pcomplete-requote-argument-function): New var.
+ (pcomplete--common-suffix): New function.
+ (pcomplete-completions-at-point): Use completion-table-with-quoting
+ and completion-table-subvert.
+
+ * minibuffer.el: Use completion-table-with-quoting for read-file-name.
+ (minibuffer--double-dollars): Preserve properties.
+ (completion--sifn-requote): New function.
+ (completion--file-name-table): Rewrite using it and c-t-with-quoting.
+
+ * minibuffer.el: Add support for completion of quoted/escaped data.
+ (completion-table-with-quoting, completion-table-subvert): New funs.
+ (completion--twq-try, completion--twq-all): New functions.
+ (completion--nth-completion): New function.
+ (completion-try-completion, completion-all-completions): Use it.
+
+2012-04-25 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/python.el (python-pdbtrack-get-source-buffer):
+ Use compilation-message if available to find real filename.
+
+2012-04-25 Chong Yidong <cyd@gnu.org>
+
+ * vc/diff-mode.el (diff-setup-whitespace): New function.
+ (diff-mode): Use it.
+
+ * vc/diff.el (diff-sentinel):
+ * vc/vc.el (vc-diff-finish): Call diff-setup-whitespace to assign
+ Whitespace mode variables based on diff style (Bug#8612).
+
+2012-04-25 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/python.el (python-send-region): Add suffix .py to the
+ temp file.
+
+ * files.el (auto-mode-alist): Use javascript-mode instead.
+
+2012-04-25 Alex Harsanyi <AlexHarsanyi@gmail.com>
+
+ Sync with soap-client repository. Support SOAP simpleType (Bug#10331).
+
+ * net/soap-client.el (soap-resolve-references-for-sequence-type)
+ (soap-resolve-references-for-array-type): Hack to prevent self
+ references, see Bug#9.
+ (soap-parse-envelope): Report the contents of the 'detail' node
+ when receiving a fault reply.
+ (soap-parse-envelope): Report the contents of the entire 'detail' node.
+
+ * net/soap-inspect.el (soap-sample-value-for-simple-type)
+ (soap-inspect-simple-type): New function.
+
+ * net/soap-client.el (soap-simple-type): New struct.
+ (soap-default-xsd-types, soap-default-soapenc-types)
+ (soap-decode-basic-type, soap-encode-basic-type):
+ support unsignedInt and double basic types.
+ (soap-resolve-references-for-simple-type)
+ (soap-parse-simple-type, soap-encode-simple-type): New function.
+ (soap-parse-schema): Parse xsd:simpleType declarations.
+
+ * net/soap-client.el (soap-default-xsd-types)
+ (soap-default-soapenc-types): Add integer, byte and anyURI types.
+ (soap-parse-complex-type-complex-content): Use `soap-wk2l' to find
+ the local name of "soapenc:Array".
+ (soap-decode-basic-type, soap-encode-basic-type): Support encoding
+ decoding integer, byte and anyURI xsd types.
+
+2012-04-25 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (custom-buffer-create-internal): Update header text.
+
+2012-04-25 Eli Zaretskii <eliz@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-init-1): Condition Windows-specific
+ settings on 'system-type', not on 'window-system'. On MS-Windows,
+ set interactive-mode on in GDB.
+
+2012-04-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ruby-mode.el: Simplify last change, and cleanup code.
+ (ruby-syntax-propertize-regexp): Remove.
+ (ruby-syntax-propertize-function): Split regexp into chunks.
+ Match following code directly.
+
+2012-04-24 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el: Handle Cucumber defs (bug#6286).
+ (ruby-syntax-propertize-regexp): New function.
+ (ruby-syntax-propertize-function): Use it to handle regexp not preceded
+ by a special keyword.
+
+ * progmodes/ruby-mode.el: Handle general delimited literals (bug#6286).
+ (ruby-syntax-general-delimiters-goto-beg)
+ (ruby-syntax-propertize-general-delimiters): New functions.
+ (ruby-syntax-propertize-function): Use them to handle GDL.
+ (ruby-font-lock-keywords): Move old handling of GDL...
+ (ruby-font-lock-syntactic-keywords): .. to here.
+ (ruby-calculate-indent): Adjust indentation for GDL.
+
+2012-04-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * notifications.el (top): Remove unneeded declarations.
+ (notifications-specification-version): Change to "1.2".
+ (notifications-interface, notifications-notify-method)
+ (notifications-close-notification-method): Fix docstring.
+ (notifications-get-capabilities-method): New defconst.
+ (notifications-notify): Add :action-items, :resident and
+ :transient hints. Change "image_data" to "image-data" and
+ "image_path" to "image-path".
+ (notifications-get-capabilities): New defun.
+
+2012-04-24 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/python.el: Move hideshow setup to the end.
+
+2012-04-24 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (handle-select-window): Clear echo area since this is
+ no more done by read_char (Bug#11304).
+
+2012-04-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ibuffer.el (ibuffer-mode-map): Bind `/ m' to filter-used-mode
+ and `/ M' to filter-derived-mode.
+ * ibuf-ext.el (ibuffer-list-buffer-modes): Simplify; avoid add-to-list.
+ (ibuffer-filter-by-mode, ibuffer-filter-by-used-mode)
+ (ibuffer-mark-by-mode): Use default rather than initial-input.
+ (ibuffer-filter-by-derived-mode): Autoload and require-match.
+
+2012-04-24 Ivan Andrus <darthandrus@gmail.com> (tiny change)
+
+ * ibuf-ext.el (ibuffer-list-buffer-modes): Add `include-parents' arg.
+ (ibuffer-filter-by-derived-mode): New filter.
+ * ibuffer.el (ibuffer-mode-map): Bind to `/ w'.
+
+2012-04-23 Andreas Politz <politza@fh-trier.de>
+
+ * subr.el (accept-change-group): Fix arg usage (Bug#6095).
+
+2012-04-23 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (customize-apropos, customize-apropos-options):
+ Disable matching of non-option variables (Bug#11176).
+ (customize-option, customize-option-other-window)
+ (customize-changed-options): Doc fix.
+ (customize-apropos-options, customize-apropos-faces)
+ (customize-apropos-groups): Use apropos-read-pattern (Bug#11124).
+
+ * apropos.el (apropos-read-pattern): Make prompt less cryptic.
+ Fix word list splitting (Bug#11132).
+ (apropos-symbol, apropos-keybinding, apropos-label)
+ (apropos-property, apropos-function-button)
+ (apropos-variable-button, apropos-misc-button): New faces.
+ (apropos-symbol-face, apropos-keybinding-face)
+ (apropos-label-face, apropos-property-face, apropos-match-face):
+ Variables removed (Bug#8396).
+ (apropos-library-button, apropos-format-plist, apropos-print)
+ (apropos-print-doc, apropos-describe-plist): Callers changed.
+
+2012-04-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/xesam.el (xesam-mode-map): Use let-bound map in
+ initialization. (Bug#11292)
+
+2012-04-23 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ Preserve ispell session localwords when switching back to
+ original buffer.
+
+ * textmodes/ispell.el (ispell-buffer-session-localwords):
+ New buffer-local variable to hold buffer session localwords.
+ (ispell-kill-ispell): Add option 'clear to delete session
+ localwords.
+ (ispell-command-loop, ispell-change-dictionary)
+ (ispell-buffer-local-words): Preserve session localwords when
+ needed.
+
+ * textmodes/flyspell.el (flyspell-process-localwords)
+ (flyspell-do-correct): Preserve session localwords when needed.
+
+2012-04-23 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-insert-word) Remove unneeded function
+ using obsolete `translation-table-for-input'.
+ (ispell-word, ispell-process-line, ispell-complete-word):
+ Use plain `insert' instead of removed `ispell-insert-word'.
+
+2012-04-22 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (custom-variable-menu)
+ (custom-variable-reset-saved, custom-face-menu)
+ (custom-face-reset-saved): If there is no saved value, make the
+ "reset-saved" operation bring back the default (Bug#9509).
+ (custom-face-state): Properly detect themed faces.
+
+ * faces.el (face-spec-set): Stop supporting deprecated form of
+ third arg.
+
+2012-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Move functions from C to Lisp. Make non-blocking method calls
+ the default. Implement further D-Bus standard interfaces.
+
+ * net/dbus.el (dbus-message-internal): Declare function.
+ Remove unneeded function declarations.
+ (defvar dbus-message-type-invalid, dbus-message-type-method-call)
+ (dbus-message-type-method-return, dbus-message-type-error)
+ (dbus-message-type-signal): Declare variables. Remove local
+ definitions.
+ (dbus-interface-dbus, dbus-interface-peer)
+ (dbus-interface-introspectable, dbus-interface-properties)
+ (dbus-path-emacs, dbus-interface-emacs, dbus-return-values-table):
+ Adapt docstring.
+ (dbus-interface-objectmanager): New defconst.
+ (dbus-call-method, dbus-call-method-asynchronously)
+ (dbus-send-signal, dbus-method-return-internal)
+ (dbus-method-error-internal, dbus-register-service)
+ (dbus-register-signal, dbus-register-method): New defuns, moved
+ from dbusbind.c
+ (dbus-call-method-handler, dbus-setenv)
+ (dbus-get-all-managed-objects, dbus-managed-objects-handler):
+ New defuns.
+ (dbus-call-method-non-blocking): Make it an obsolete function.
+ (dbus-unregister-object, dbus-unregister-service)
+ (dbus-handle-event, dbus-register-property)
+ (dbus-property-handler): Obey the new structure of
+ `bus-registered-objects'.
+ (dbus-introspect): Use `dbus-call-method'. Use a timeout.
+ (dbus-get-property, dbus-set-property, dbus-get-all-properties):
+ Use `dbus-call-method'.
+
+2012-04-22 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (custom-commands, custom-reset-menu)
+ (Custom-reset-standard): Tweak labels.
+ (custom-reset-button-menu): Change default to t.
+ (custom-buffer-create-internal): For the custom-reset-button-menu
+ case, put the revert button first.
+ (custom-group-subtitle): New face.
+ (custom-group-value-create): Align docstring to a specific column.
+
+ * wid-edit.el (widget-documentation-link-add): Don't handle
+ indentation in this function.
+ (widget-documentation-string-indent-to): New function.
+ (widget-documentation-string-value-create): Use it.
+
+ * autorevert.el (auto-revert):
+ * epg-config.el (epg):
+ * ibuffer.el (ibuffer):
+ * mpc.el (mpc):
+ * ses.el (ses):
+ * eshell/eshell.el (eshell):
+ * net/ange-ftp.el (ange-ftp):
+ * progmodes/ebnf2ps.el (postscript):
+ * progmodes/flymake.el (flymake):
+ * progmodes/prolog.el (prolog):
+ * progmodes/verilog-mode.el (verilog-mode):
+ * progmodes/which-func.el (which-func):
+ * term/xterm.el (xterm):
+ * textmodes/picture.el (picture):
+ * textmodes/tildify.el (tildify):
+ * vc/ediff.el (ediff): Tweak defgroups to improve presentation in
+ customization buffers.
+
+2012-04-22 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-engine.el (c-append-lower-brace-pair-to-state-cache):
+ Adding a ) can hide the resulting (..) from searches. Fix it.
+ Bound the backward search to the position of the existing (.
+
+2012-04-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/verilog-mode.el (verilog-mode): Check whether
+ which-func-modes is t before adding verilog-mode.
+ Reported by Andy Moreton <andrewjmoreton@gmail.com>.
+
+2012-04-21 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc): Avoid error when process-contact returns t.
+
+2012-04-21 Michael Vehrs <Michael.Burschik@gmx.de>
+
+ * woman.el: Add support for "T{ T}" tbl syntax, and fix the
+ filling of the last column of a table (Bug#5635).
+ (woman-find-next-control-line): New arg, specifying an additional
+ regexp component for the control line.
+ (woman2-roff-buffer): Use it.
+ (woman-break-table): New function.
+ (woman2-TS): Use it.
+
+2012-04-21 Chong Yidong <cyd@gnu.org>
+
+ * woman.el (woman-set-buffer-display-table, woman-decode-region)
+ (woman-horizontal-escapes, woman-negative-vertical-space)
+ (woman-tab-to-tab-stop, woman2-fc, woman2-TS)
+ (WoMan-warn-ignored): Use ?\s instead of ?\ .
+
+2012-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-file-name-table): Complete user names.
+
+2012-04-20 Leo Liu <sdl.web@gmail.com>
+
+ * font-lock.el (lisp-font-lock-keywords-2): Add pcase, pcase-let
+ and pcase-let*.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * server.el (server-execute): Respect initial-buffer-choice if it
+ is a string and there are no files to open (Bug#2825).
+ (server-create-window-system-frame, server-create-tty-frame):
+ Don't switch buffers here.
+ (server-process-filter): Only try to open a window system frame if
+ compiled with graphical support (Bug#8314).
+
+2012-04-20 Dan Nicolaescu <dann@gnu.org>
+
+ * battery.el (battery-echo-area-format): Display remaining time
+ for sysfs backend too (Bug#11269).
+ (battery-linux-sysfs): Fix conditional for the charge.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb): Revert previous change.
+ (gdb-inferior-io--init-proc): New function.
+ (gdb-init-1): Use it.
+ (gdb-inferior-io-sentinel): New sentinel for the gdb-inferior pty,
+ responsible for allocating a new pty and hooking it to gdb when
+ the old pty gets an EIO due to process exit.
+ (gdb-delchar-or-quit): New command. Bind it in gdb-mi buffers.
+ (gdb-tooltip-print): Don't use obsolete tooltip-use-echo-area.
+ (gdb-inferior-io--maybe-delete-pty): Move into gdb-reset.
+
+2012-04-20 Eli Zaretskii <eliz@gnu.org>
+
+ * window.el (window-min-size, window-sizable, window-min-delta)
+ (window-max-delta, window--resizable, window-resizable)
+ (window-total-size, window-full-height-p, window-full-width-p)
+ (window-in-direction, window--resize-mini-window, window-resize)
+ (window--resize-child-windows-normal)
+ (window--resize-child-windows, window--resize-siblings)
+ (window--resize-this-window, adjust-window-trailing-edge)
+ (enlarge-window, shrink-window): Doc fixes.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-inferior-io--maybe-delete-pty):
+ New function to call delete-process on the gdb-inferior buffer's pty.
+ (gdb-reset): Use it, instead of relying on kill-buffer to kill the
+ pty process (Bug#11273).
+ (gdb-update): New arg to suppress talking to the gdb process.
+ (gdb-done-or-error): Use it.
+ (gdb-stopped-functions): Rename from gdb-stopped-hooks.
+ (gdb): Call gdb-inferior-io--maybe-delete-pty as a workaround for
+ sentinel not being called.
+
+ * comint.el (make-comint-in-buffer, comint-exec): Doc fix.
+
+ * progmodes/grep.el (grep, rgrep): Doc fix (Bug#11268).
+
+2012-04-20 Glenn Morris <rgm@gnu.org>
+
+ * net/network-stream.el (open-network-stream): Doc fix.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-print): Fix typos.
+
+2012-04-20 Alan Mackenzie <acm@muc.de>
+
+ Ensure searching for keywords is case sensitive.
+
+ * progmodes/cc-cmds.el (c-electric-brace, c-electric-lt-gt)
+ (c-electric-paren, c-beginning-of-defun, c-end-of-defun)
+ (c-defun-name, c-mark-function, c-cpp-define-name)
+ (c-comment-indent, c-scan-conditionals, c-indent-defun)
+ (c-context-line-break): Bind case-fold-search to nil.
+
+ * progmodes/cc-mode.el (c-font-lock-fontify-region):
+ Bind case-fold-search to nil.
+
+2012-04-20 Chong Yidong <cyd@gnu.org>
+
+ * mail/sendmail.el (mail-bury): Call return action with the right
+ Rmail buffer (Bug#11242).
+
+ * server.el (server-process-filter): Handle corner case where both
+ tty and nowait options are present (Bug#11102).
+
+2012-04-20 Eli Zaretskii <eliz@gnu.org>
+
+ * version.el (emacs-bzr-version, emacs-bzr-get-version): Doc fixes.
+ (top level): Put into the executable the ident-style '$Id:' tag on
+ windows-nt as well.
+
+2012-04-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-indent-post-self-insert-function): Check that
+ electric-indent-mode is enabled in current buffer.
+
+2012-04-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * imenu.el (imenu-progress-message): Restore; it is "used" in
+ erc/erc-imenu.el and net/snmp-mode.el.
+
+2012-04-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * avoid.el (mouse-avoidance-mode): Mark unused arg.
+ (mouse-avoidance-nudge-mouse): Remove unused binding.
+
+ * bs.el (bs-toggle-readonly): Call `toggle-read-only' interactively.
+
+ * descr-text.el (describe-char):
+ * progmodes/python.el (python-describe-symbol):
+ Don't call `toggle-read-only', set `buffer-read-only'.
+
+ * imenu.el (imenu-default-goto-function): Mark unused args.
+ (imenu-progress-message): Remove obsolete macro; all callers changed.
+
+ * subr.el (keymap-canonicalize): Remove unused binding.
+ (read-passwd): Mark unused arg.
+
+ * tutorial.el (tutorial--display-changes): Remove unused binding.
+ (tutorial--save-tutorial-to): Remove unused variable.
+
+ * emacs-lisp/package.el (define-package, package-menu-mark-delete)
+ (package-menu-mark-install, package-menu-mark-unmark): Mark unused args.
+ (package-generate-autoloads, package-menu--generate)
+ (package-menu--find-upgrades): Remove unused bindings.
+
+ * emulation/cua-rect.el (cua-restrict-regexp-rectangle)
+ (cua-restrict-prefix-rectangle): Doc fixes. Remove unused bindings.
+ (cua--mouse-ignore, cua--delete-rectangle, cua--extract-rectangle)
+ (cua--indent-rectangle, cua-open-rectangle, cua-close-rectangle)
+ (cua-blank-rectangle, cua-string-rectangle, cua-replace-in-rectangle)
+ (cua-incr-rectangle, cua-sequence-rectangle, cua--convert-rectangle-as)
+ (cua--rectangle-aux-replace, cua--left-fill-rectangle)
+ (cua-scroll-rectangle-up, cua-scroll-rectangle-down)
+ (cua-delete-char-rectangle): Mark unused args.
+ (cua-align-rectangle): Remove unused binding.
+
+ * mail/rmail.el (compilation--message->loc)
+ (epa--find-coding-system-for-mime-charset): Declare.
+
+ * net/dbus.el (dbus-register-service): Declare.
+ (dbus-name-owner-changed-handler): Remove unused binding.
+
+ * nxml/nxml-mode.el (nxml-electric-slash, nxml-in-mixed-content-p)
+ (nxml-compute-indent-from-matching-start-tag): Remove unused variables.
+ (nxml-scan-backward-within): Mark unused arg.
+ (nxml-dynamic-markup-word): Remove unused binding.
+
+ * mouse.el (mouse-menu-major-mode-map):
+ * emacs-lisp/authors.el (authors-scan-change-log)
+ (authors-add-to-author-list):
+ * emacs-lisp/avl-tree.el (avl-tree--enter-balance):
+ * emacs-lisp/smie.el (smie-auto-fill):
+ * mail/sendmail.el (mail-bury):
+ * mail/unrmail.el (unrmail):
+ * net/tls.el (open-tls-stream):
+ * textmodes/picture.el (picture-mouse-set-point):
+ Remove unused bindings.
+
+2012-04-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-action-password): Let-bind
+ `enable-recursive-minibuffers' to t.
+
+2012-04-18 Sam Steingold <sds@gnu.org>
+
+ * progmodes/gud.el (gud-key-prefix): Use :type 'key-sequence
+ instead of 'string to accommodate values like [f11].
+ Always use `vconcat' instead of `concat' on it, like in `gud-def'.
+ * progmodes/gdb-mi.el: Likewise.
+
+2012-04-18 Leo Liu <sdl.web@gmail.com>
+
+ * abbrev.el (edit-abbrevs): Move point to the abbrev table of
+ current buffer.
+ (prepare-abbrev-list-buffer): Enter edit-abbrevs-mode only if
+ LOCAL is nil.
+
+2012-04-18 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (line-move): Use forward-line if in batch mode
+ (Bug#11053).
+
+2012-04-18 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * files.el (after-find-file): Do not try to add a final newline if
+ the buffer is read-only (Bug#11156).
+
+2012-04-17 Richard Stallman <rms@gnu.org>
+
+ * mail/rmail.el (rmail-start-mail):
+ Pass (rmail-mail-return...) for the return-action.
+ Pass (rmail-yank-current-message...) for the yank-action.
+ (rmail-yank-current-message): New function.
+ (rmail-mail): Pass the Rmail buffer, not view buffer, for replybuffer.
+ (rmail-reply): Likewise.
+ (rmail-forward): Pass the Rmail buffer, not nil, for replybuffer.
+
+ * mail/sendmail.el (mail-bury): Choose the first rmail-mode
+ buffer, not the last. Reject temp buffers. Use the rmail-mode
+ buffer, not newbuf.
+
+2012-04-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * server.el (server-ensure-safe-dir): Simplify.
+
+2012-04-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el: Provide smarter auto-filling.
+ (smie-auto-fill): New function.
+ (smie-setup): Use it.
+
+ * newcomment.el (comment-choose-indent): Obey comment-inline-offset.
+
+2012-04-17 Philipp Haselwarter <philipp.haselwarter@gmx.de> (tiny change)
+
+ * newcomment.el (comment-inline-offset): New custom var (bug#11090).
+ (comment-indent): Use it.
+
+2012-04-17 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el: The overall change is to add cell renaming, that is
+ setting fancy names for cell symbols other than name matching
+ "\\`[A-Z]+[0-9]+\\'" regexp .
+ (ses-localvars): Add ses--renamed-cell-symb-list.
+ (ses-create-cell-variable): New defun.
+ (ses-destroy-cell-variable-range): Respect ses--numrows, ses--numcols.
+ (ses-relocate-formula): Relocate formulas only for cells the
+ symbols of which are not renamed, i.e. symbols whose names do not
+ match regexp "\\`[A-Z]+[0-9]+\\'".
+ (ses-relocate-all): Relocate values only for cells the symbols of
+ which are not renamed.
+ (ses-load): Create cells variables as the (ses-cell ...) are read,
+ in order to check row col consistency with cell symbol name only
+ for cells that are not renamed.
+ (ses-replace-name-in-formula): New defun.
+ (ses-rename-cell): New defun.
+
+2012-04-17 Peter Oliver <bzr@mavit.org.uk> (tiny change)
+
+ * progmodes/perl-mode.el (perl-indent-parens-as-block):
+ New option (bug#11118).
+ (perl-calculate-indent): Respect it.
+
+2012-04-17 Glenn Morris <rgm@gnu.org>
+
+ * dired-aux.el (dired-mark-read-string): Doc fix.
+
+2012-04-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * dired-aux.el (dired-mark-read-string): Offer optional completion.
+ (dired-do-chxxx): Complete chown, chgrp over users, groups. (Bug#7900)
+
+2012-04-17 Glenn Morris <rgm@gnu.org>
+
+ * mouse.el (mouse-drag-track):
+ * speedbar.el (speedbar-frame-mode):
+ Use auto-hscroll-mode rather than the alias automatic-hscrolling.
+
+2012-04-16 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/python.el: Trivial cleanup.
+
+2012-04-16 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc.el (vc-string-prefix-p):
+ * vc/pcvs-util.el (cvs-string-prefix-p):
+ * textmodes/tex-mode.el (latex-string-prefix-p, tex-string-prefix-p):
+ * mpc.el (mpc-string-prefix-p):
+ Make all of these into obsolete aliases for string-prefix-p.
+ Update callers.
+ * vc/pcvs.el, vc/vc-dispatcher.el, vc/vc-dir.el: Update callers.
- * userlock.el, emacs-lisp/map-ynp.el: Declare part of `emacs' package.
- * progmodes/bug-reference.el, misearch.el: Provide themselves
- (bug#11915).
+ * textmodes/two-column.el: Move custom options to the start.
+ (frame-width): Remove compat definition.
+ (2C-associate-buffer, 2C-dissociate):
+ Use with-current-buffer rather than save-excursion.
+ (2C-dissociate): Force a mode-line update.
+ (2C-autoscroll): Use ignore-errors.
- * progmodes/cperl-mode.el (cperl-unwind-to-safe): Don't inf-loop at end
- of narrowed buffer (bug#11966).
+ * emacs-lisp/eieio-opt.el (describe-class, describe-generic):
+ Autoload trivia.
-2012-07-14 Jan Djärv <jan.h.d@swipnet.se>
+ * emacs-lisp/cl-extra.el (*random-state*):
+ Remove unnecessary declaration.
- * progmodes/cc-cmds.el (c-defun-name): Recognize Objective-C methods
- also (Bug#7879).
+ * calendar/cal-tex.el (cal-tex-end-document): Trivial clarification.
-2012-07-09 Stefan Monnier <monnier@iro.umontreal.ca>
+ * play/cookie1.el (cookie-snarf):
+ Give an explicit error if input file cannot be read.
- * progmodes/sh-script.el (sh-syntax-propertize-function): Fix last
- change (bug#11826).
+ * play/yow.el (yow-file): Use expand-file-name rather than concat.
-2012-07-02 Glenn Morris <rgm@gnu.org>
+ * progmodes/perl-mode.el (c-macro-expand):
+ Remove unnecessary autoload (it is in loaddefs.el).
- * simple.el (kill-whole-line): Doc tweak.
+ * textmodes/picture.el (picture-desired-column)
+ (picture-update-desired-column): Convert comments to doc-strings.
+ (picture-substitute): Remove function.
+ (picture-mode-map): Initialize in the defvar.
-2012-07-01 Eli Zaretskii <eliz@gnu.org>
+ * woman.el: Remove eval-after-load for tar-mode.
+ * tar-mode.el (tar-mode-map): Add woman binding and menu entry.
+ (woman-tar-extract-file): Autoload it.
- * files.el (file-relative-name): Compare file names
- case-insensitively if on MS-Windows or MS-DOS, or if
- read-file-name-completion-ignore-case is non-nil. Don't use
- case-fold-search for this purpose. (Bug#11827)
+ * frame.el (automatic-hscrolling): Make this alias obsolete.
-2012-06-28 Andreas Schwab <schwab@linux-m68k.org>
+2012-04-12 Agustín Martín Domingo <agustin.martin@hispalinux.es>
- * calendar/cal-dst.el (calendar-current-time-zone):
- Return calendar-current-time-zone-cache if non-nil.
+ * textmodes/ispell.el (ispell-set-spellchecker-params): Post-process
+ `ispell-dictionary-alist' to use [:alpha:] and utf-8 if possible.
+ (ispell-dictionary-base-alist): Revert to original XEmacs
+ friendly version for default. [:alpha:] will be added in
+ `ispell-set-spellchecker-params' if needed.
-2012-06-25 Masatake YAMATO <yamato@redhat.com>
+2012-04-16 Chong Yidong <cyd@gnu.org>
- * progmodes/which-func.el (which-func-format):
- Add mouse-face. (Bug#11698)
+ * image.el (imagemagick--file-regexp): New variable.
+ (imagemagick-register-types): Use it.
+ (imagemagick-types-inhibit): Add :set function. Allow new value
+ of t to inhibit all types.
-2012-06-24 Leo Liu <sdl.web@gmail.com>
+ * emacs-lisp/regexp-opt.el (regexp-opt-charset): Avoid cl macros,
+ so we can preload it.
- * ibuf-ext.el (ibuffer-diff-buffer-with-file-1): Avoid buffer
- read-only error.
+ * loadup.el (fboundp): Preload regexp-opt, needed by
+ imagemagick-register-types.
- * net/rcirc.el (rcirc): Avoid error when process-contact returns t.
+2012-04-15 Chong Yidong <cyd@gnu.org>
- * vc/diff-mode.el (diff-file-prev/next): Fix typo.
+ * frame.el (scrolling): Remove nearly unused customization group.
-2012-06-23 Leo Liu <sdl.web@gmail.com>
+ * scroll-all.el (scroll-all-mode): Move to windows group.
- * textmodes/enriched.el (enriched-next-annotation):
- Use eq (Bug#11528).
+2012-04-15 Chong Yidong <cyd@gnu.org>
-2012-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
+ * bindings.el (goto-map): Bind goto-char to M-g c (Bug#11240).
- * minibuffer.el (minibuffer-confirm-exit-commands):
- Add completion-at-point (bug#11725).
+2012-04-15 Stefan Monnier <monnier@iro.umontreal.ca>
-2012-06-21 Glenn Morris <rgm@gnu.org>
+ Avoid the use of ((lambda ...) ...) in lexical-binding code.
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Use funcall (bug#11241).
- * progmodes/f90.el (f90-font-lock-keywords-2):
- Add some preprocessor elements. (Bug#10499)
+2012-04-15 Glenn Morris <rgm@gnu.org>
-2012-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+ * simple.el (process-file-side-effects): Doc fix.
- * progmodes/cperl-mode.el (cperl-update-syntaxification):
- Use syntax-propertize (bug#11739).
+2012-04-15 Glenn Morris <rgm@gnu.org>
-2012-06-13 Glenn Morris <rgm@gnu.org>
+ * international/mule-cmds.el (set-language-environment): Doc fix.
- * international/mule-cmds.el (mule-menu-keymap)
- (set-language-environment, set-locale-environment): Doc tweaks.
+2012-04-14 Juanma Barranquero <lekktu@gmail.com>
-2012-06-01 Chong Yidong <cyd@gnu.org>
+ * server.el (server-auth-key, server-generate-key): Doc fixes.
+ (server-get-auth-key): Doc fix. Use `string-match-p'.
+ (server-start): Reflow docstring.
- * Version 24.1 released.
+2012-04-14 Lars Ingebrigtsen <larsi@gnus.org>
-2012-06-01 Glenn Morris <rgm@gnu.org>
+ * server.el (server-generate-key): `called-interactively-p'
+ requires a parameter.
- * mail/rmail.el (rmail-yank-current-message):
- Leave point at correct position. (Bug#11660)
+2012-04-14 Michal Nazarewicz <mina86@mina86.com>
-2012-06-01 Chong Yidong <cyd@gnu.org>
+ * server.el (server-auth-key): New variable.
+ (server-generate-key, server-get-auth-key): New function.
+ (server-start): Use the new variable and functions to allow
+ setting a permanent server key (bug#9423).
- * allout-widgets.el: Fix code header
+2012-04-14 Leo Liu <sdl.web@gmail.com>
-2012-06-01 Chong Yidong <cyd@gnu.org>
+ * vc/diff-mode.el (diff-file-prev/next): Fix typo.
- * cus-edit.el (customize-changed-options-previous-release):
- Bump to 23.4.
+2012-04-14 Paul Eggert <eggert@cs.ucla.edu>
-2012-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
+ Spelling fixes.
+ * hexl.el (hexl-rulerize): Rename from hexl-rulerise, since
+ Emacs uses American spelling.
- * emacs-lisp/bytecomp.el (byte-compile-fix-header):
- Handle arbitrary file name lengths (Bug#11585).
+2012-04-14 Juanma Barranquero <lekktu@gmail.com>
-2012-05-28 Martin Rudalics <rudalics@gmx.at>
+ * emacs-lock.el (emacs-lock-locked-buffer-functions): New hook.
+ (emacs-lock--exit-locked-buffer): Return the locked buffer. Doc fix.
+ (emacs-lock--kill-emacs-hook, emacs-lock--kill-emacs-query-functions)
+ (emacs-lock--kill-buffer-query-functions): Run new hook. (Bug#11017)
- * desktop.el (desktop-read): Clear previous and next buffers for
- all windows and bury *Messages* buffer (bug#11556).
+2012-04-14 Stefan Monnier <monnier@iro.umontreal.ca>
-2012-05-18 Eli Zaretskii <eliz@gnu.org>
+ * progmodes/which-func.el (which-func-modes): Change default.
- * mail/sendmail.el (mail-yank-region):
- Recognize rmail-yank-current-message in addition to insert-buffer.
- Fixes mail-mode's "C-c C-r" that otherwise does nothing when invoked in
- a *mail* buffer created through rmail-start-mail with sendmail as
- mail-user-agent.
+2012-04-14 Kim F. Storm <storm@cua.dk>
-2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+ * emulation/cua-base.el (cua-exchange-point-and-mark): Just call
+ exchange-point-and-mark if cua-enable-cua-keys is nil (Bug#11191).
- * emacs-lisp/cl-macs.el (cl-transform-lambda): Don't add spurious
- parens around the arg list (bug#11499). Silly backport.
+2012-04-14 Chong Yidong <cyd@gnu.org>
-2012-05-16 Chong Yidong <cyd@gnu.org>
+ * custom.el (custom-theme-set-variables): Doc fix.
- * net/gnutls.el (gnutls-min-prime-bits): Improve docstring.
+2012-04-14 Glenn Morris <rgm@gnu.org>
-2012-05-15 Chong Yidong <cyd@gnu.org>
+ * international/mule.el (set-auto-coding-for-load): Doc fix.
- * help.el (describe-mode): Doc fix.
+2012-04-14 Alan Mackenzie <acm@muc.de>
- * net/gnutls.el (gnutls-min-prime-bits): Default to 256 (Bug#11267).
+ * progmodes/cc-menus.el (cc-imenu-objc-generic-expression): Make
+ imenu work again for Objective C Mode. Correct the *-index values,
+ these having been disturbed by a previous change in 2011-08.
-2012-05-06 Troels Nielsen <bn.troels@gmail.com> (tiny change)
+ * progmodes/cc-engine.el (c-before-change-check-<>-operators):
+ Correct two search limits.
- * progmodes/compile.el (compilation-internal-error-properties):
- Calculate start position correctly when end-col is set but
- end-line is not (Bug#11382).
+2012-04-14 Stefan Monnier <monnier@iro.umontreal.ca>
-2012-05-11 Stefan Monnier <monnier@iro.umontreal.ca>
+ * startup.el (command-line-1): Inhibit splash from daemon (bug#10996).
- * net/rlogin.el (rlogin-mode-map): Fix last change.
+2012-04-14 Andreas Schwab <schwab@linux-m68k.org>
-2012-05-09 Jason L. Wright <jason.wright@inl.gov> (tiny change)
+ * international/characters.el: Fix sorting.
- * mail/smtpmail.el (smtpmail-send-command): Send the command and
- the following \r\n using a single `process-send-string', since the
- Lotus SMTP server refuses to accept any commands if they are sent
- with two `process-send-string's (bug#11444).
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
-2012-05-09 Stefan Monnier <monnier@iro.umontreal.ca>
+ * international/characters.el: Add more missing Latin case pairs.
- * shell.el (shell-parse-pcomplete-arguments): Obey
- pcomplete-arg-quote-list inside double-quoted args as well (bug#11348).
+2012-04-14 Glenn Morris <rgm@gnu.org>
-2012-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+ * files.el (dir-locals-set-class-variables): Doc fix.
- * shell.el (shell-completion-vars): Fix last change (bug#11348).
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
-2012-05-07 Chong Yidong <cyd@gnu.org>
+ * international/characters.el: Add set-case-syntax-pair call for
+ LATIN CAPITAL LETTER Y WITH DIAERESIS RET and its lower-case
+ counterpart. (Bug#11209)
- * ansi-color.el (ansi-color-process-output): Check for validity of
- comint-last-output-start before using it. This avoids a bad
- interaction with gdb-mi's input/output buffer.
+ * simple.el (shell-command-on-region): Doc fix. (Bug#11208)
-2012-05-06 Glenn Morris <rgm@gnu.org>
+2012-04-14 Glenn Morris <rgm@gnu.org>
- * files.el (dir-locals-read-from-file):
- Mention dir-locals in any error message.
+ * calendar/holidays.el (calendar-check-holidays): Doc fix.
-2012-05-06 Chong Yidong <cyd@gnu.org>
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
- * emacs-lisp/package.el (package-built-in-p): Handle the `emacs'
- package (Bug#11410).
+ * textmodes/ispell.el (ispell-dictionary-base-alist):
+ Add data for Hebrew.
-2012-05-05 Chong Yidong <cyd@gnu.org>
+2012-04-14 Chong Yidong <cyd@gnu.org>
- * emacs-lisp/package.el (package-buffer-info): Avoid putting local
- variables into description.
+ * net/rcirc.el (rcirc-cmd-quit):
+ Revert 2012-03-18 change (Bug#11192).
-2012-05-05 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-04-14 Glenn Morris <rgm@gnu.org>
- * shell.el (shell-completion-vars): Set pcomplete-arg-quote-list like
- shell-delimiter-argument-list (bug#11348).
- (shell-parse-pcomplete-arguments): Obey pcomplete-arg-quote-list.
+ * pcmpl-rpm.el (pcomplete/rpm): Handle -qf.
-2012-05-04 Chong Yidong <cyd@gnu.org>
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
- * select.el (xselect--encode-string): Always use utf-8 for TEXT on
- Nextstep.
+ * minibuffer.el (completion-in-region-mode-map):
+ Bind completion-help-at-point to M-? rather than ?. (Bug#11182)
-2012-05-03 Kenichi Handa <handa@m17n.org>
+2012-04-13 Vivek Dasmohapatra <vivek@etla.org>
- * mail/rmailmm.el (rmail-show-mime): Catch an error caused by text
- decoding, and show a warning message without signalling an error
- (Bug#11282).
+ * hexl.el (hexl-insert-char): Make display sizes other than 16 work.
-2012-04-30 Eli Zaretskii <eliz@gnu.org>
+2012-04-13 Masatake YAMATO <yamato@redhat.com>
- * mail/rmail.el (rmail-yank-current-message): Use the encoding of
- the yanked message in preference to the default value of
- buffer-file-coding-system.
+ * minibuffer.el (minibuffer-local-filename-syntax): New variable
+ to allow `C-M-f' and `C-M-b' to move to the nearest path
+ separator (bug#9511).
-2012-04-30 Martin Rudalics <rudalics@gmx.at>
+2012-04-13 Lars Ingebrigtsen <larsi@gnus.org>
- * window.el (display-buffer--action-function-custom-type):
- Fix entry.
+ * avoid.el: Require cl when compiling. And also move the
+ `provide' to the end.
-2012-04-27 Alan Mackenzie <acm@muc.de>
+2012-04-13 Thierry Volpiatto <thierry.volpiatto@gmail.com>
- * progmodes/cc-defs.el (c-version): Update to 5.32.3.
+ * avoid.el (mouse-avoidance-banish-position): New variable.
+ (mouse-avoidance-banish-destination): Use it (bug#10165).
-2012-04-27 Chong Yidong <cyd@gnu.org>
+2012-04-13 Leo Liu <sdl.web@gmail.com>
- * subr.el (read-key): Avoid running filter function when setting
- up temporary tool bar entries (Bug#9922).
+ * progmodes/which-func.el (which-func-modes): Add objc-mode.
-2012-04-26 Andreas Schwab <schwab@linux-m68k.org>
+2012-04-13 Ken Brown <kbrown@cornell.edu>
- * vc/vc-git.el (vc-git-state): Fix regexp matching diff output.
- (Bug#11344)
+ * net/browse-url.el (browse-url-file-url): Remove Cygwin hack;
+ this is no longer needed now that cygstart understands file:// URLs.
+ (browse-url-filename-alist): For the same reason, don't modify
+ file:// URLs on Cygwin.
-2012-04-24 Chong Yidong <cyd@gnu.org>
+2012-04-13 Stefan Monnier <monnier@iro.umontreal.ca>
- * select.el (xselect--encode-string): New function, split from
- xselect-convert-to-string.
- (xselect-convert-to-string): Use it.
- (xselect-convert-to-filename, xselect-convert-to-os)
- (xselect-convert-to-host, xselect-convert-to-user): Ensure that
- returned strings are properly encoded (Bug#11315).
+ * emulation/cua-base.el (cua--pre-command-handler-1): Don't activate
+ the region on shift if the binding is already shifted (bug#11221).
-2012-04-22 Chong Yidong <cyd@gnu.org>
+2012-04-12 Glenn Morris <rgm@gnu.org>
- * simple.el (delete-active-region): Move to killing custom group.
+ * mail/mailpost.el: Move to obsolete/.
-2012-04-21 Andreas Schwab <schwab@linux-m68k.org>
+2012-04-12 Drew Adams <drew.adams@oracle.com>
- * progmodes/which-func.el (which-func-current): Quote %
- characters for mode-line processing.
+ * imenu.el (imenu--generic-function): Ignore invisible definitions
+ (bug#10123).
-2012-04-21 Chong Yidong <cyd@gnu.org>
+2012-04-12 Vivek Dasmohapatra <vivek@etla.org>
- * xml.el (xml-parse-region, xml-parse-tag): Avoid errors due to
- reaching eob (Bug#11286).
+ * hexl.el (hexl-bits): New variable.
+ (hexl-options): Mention the variable in the doc string.
+ (hexl-rulerise, hexl-line-displen): New functions.
+ (hexl-mode): Mention the new variable.
+ (hexl-mode, hexl-current-address, hexl-current-address):
+ Use the displen.
+ (hexl-ascii-start-column): New function.
+ (hexl-address-to-marker, hexl-beginning-of-line, hexl-options)
+ (hexl-insert-char, hexl-mode-ruler): Use the displen (bug#4941).
-2012-04-20 Richard Stallman <rms@gnu.org>
+2012-04-12 Agustín Martín Domingo <agustin.martin@hispalinux.es>
- Fix logic for returning to and yanking from Rmail buffer.
+ * textmodes/flyspell.el (flyspell-large-region): For hunspell, use
+ '("-i" ENCODING), in 2 separate command-line arguments, to specify
+ the encoding, as expected by hunspell.
- * mail/rmail.el (rmail-start-mail):
- Pass (rmail-mail-return...) for the return-action.
- Pass (rmail-yank-current-message...) for the yank-action.
- (rmail-yank-current-message): New function.
- (rmail-mail): Pass the Rmail buffer, not view buffer, for replybuffer.
- (rmail-reply): Likewise.
- (rmail-forward): Pass the Rmail buffer, not nil, for replybuffer.
+2012-04-12 Stefan Monnier <monnier@iro.umontreal.ca>
- * mail/sendmail.el (mail-bury): Choose the first rmail-mode
- buffer, not the last. Reject temp buffers. Use the rmail-mode
- buffer, not newbuf.
+ * battery.el (battery--linux-sysfs-regexp): New const.
+ (battery-status-function): Use it. Remove yeeloong special case.
+ (battery-yeeloong-sysfs): Remove.
+ (battery-echo-area-format): Remove yeeloong special case.
-2012-04-20 Eli Zaretskii <eliz@gnu.org>
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
- * progmodes/gdb-mi.el (gdb-control-level): New variable.
- (gdb): Make it buffer-local and init to zero.
- (gdb-control-commands-regexp): New variable.
- (gdb-send): Don't wrap in "-interpreter-exec console" if
- gdb-control-level is positive. Increment gdb-control-level
- whenever the command matches gdb-control-commands-regexp, and
- decrement it each time the command is "end". (Bug#11279)
+ * imenu.el (imenu-add-to-menubar): `current-local-map' can be nil.
+ Reported by Noah Friedman.
-2012-04-20 Martin Rudalics <rudalics@gmx.at>
+ * subr.el (read-passwd): Use read-string.
- * window.el (adjust-window-trailing-edge, enlarge-window)
- (shrink-window, window-resize):
- * mouse.el (mouse-drag-line): Fix resizing of minibuffer
- windows (Bug#11276).
+2012-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-2012-04-20 Dan Nicolaescu <dann@gnu.org>
+ * vcursor.el (vcursor-move): Increase the priority of the overlay
+ (bug#9663).
- * battery.el (battery-echo-area-format): Display remaining time
- for sysfs backend too (Bug#11269).
- (battery-linux-sysfs): Fix conditional for the charge.
+2012-04-11 Deniz Dogan <deniz.a.m.dogan@gmail.com>
-2012-04-20 Chong Yidong <cyd@gnu.org>
+ * net/rcirc.el (rcirc-kill-channel-buffers): New variable.
+ (rcirc-kill-buffer-hook): Use it to kill channel buffers (bug#5128).
- * progmodes/gdb-mi.el (gdb): Revert 2012-04-19 change.
- (gdb-inferior-io--init-proc): New function.
- (gdb-init-1): Use it.
- (gdb-inferior-io-sentinel): New sentinel for the gdb-inferior pty,
- responsible for allocating a new pty and hooking it to gdb when
- the old pty gets an EIO due to process exit.
- (gdb-delchar-or-quit): New command. Bind it in gdb-mi buffers.
- (gdb-tooltip-print): Don't use obsolete tooltip-use-echo-area.
- (gdb-inferior-io--maybe-delete-pty): Move into gdb-reset.
+2012-04-11 William Stevenson <yhvh2000@gmail.com>
-2012-04-20 Eli Zaretskii <eliz@gnu.org>
+ * textmodes/artist.el (artist-mode): Convert artist-mode to use
+ define-minor-mode (bug#10760).
- * window.el (window-min-size, window-sizable, window-min-delta)
- (window-max-delta, window--resizable, window-resizable)
- (window-total-size, window-full-height-p, window-full-width-p)
- (window-in-direction, window--resize-mini-window, window-resize)
- (window--resize-child-windows-normal)
- (window--resize-child-windows, window--resize-siblings)
- (window--resize-this-window, adjust-window-trailing-edge)
- (enlarge-window, shrink-window): Doc fixes.
+2012-04-11 Wolfgang Jenkner <wjenkner@inode.at> (tiny change)
-2012-04-19 Chong Yidong <cyd@gnu.org>
+ * progmodes/grep.el (rgrep): Tweak the find command line so
+ that directories matching `grep-find-ignored-files' won't be
+ pruned (bug#10351).
- * progmodes/gdb-mi.el (gdb-inferior-io--maybe-delete-pty):
- New function to call delete-process on the gdb-inferior buffer's pty.
- (gdb-reset): Use it, instead of relying on kill-buffer to kill the
- pty process (Bug#11273).
- (gdb-update): New arg to suppress talking to the gdb process.
- (gdb-done-or-error): Use it.
- (gdb-stopped-functions): Rename from gdb-stopped-hooks.
- (gdb): Call gdb-inferior-io--maybe-delete-pty as a workaround for
- sentinel not being called.
+2012-04-11 Chong Yidong <cyd@gnu.org>
- * comint.el (make-comint-in-buffer, comint-exec): Doc fix.
+ * startup.el (command-line): Remove support for long-obsolete
+ variable font-lock-face-attributes.
-2012-04-18 Chong Yidong <cyd@gnu.org>
+2012-04-11 Glenn Morris <rgm@gnu.org>
- * progmodes/grep.el (grep, rgrep): Doc fix (Bug#11268).
+ * vc/vc-bzr.el (vc-bzr-status): Avoid condition-case-unless-debug.
-2012-04-18 Glenn Morris <rgm@gnu.org>
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
- * net/network-stream.el (open-network-stream): Doc fix.
+ * window.el (window--state-get-1): Obey window-point-insertion-type.
-2012-04-17 Chong Yidong <cyd@gnu.org>
+2012-04-11 Lennart Borgman <lennart.borgman@gmail.com>
- * emacs-lisp/tabulated-list.el (tabulated-list-print): Fix typos.
+ * emacs-lisp/lisp.el (narrow-to-defun): `beginning-of-defun' goes
+ to previous function when point is on the first character of a
+ function. Take care of that in `narrow-to-defun' (bug#6157).
-2012-04-16 Alan Mackenzie <acm@muc.de>
+2012-04-11 Glenn Morris <rgm@gnu.org>
- Ensure searching for keywords is case sensitive.
+ * vc/vc-bzr.el (vc-bzr-status): Handle all errors,
+ not just file-errors.
- * progmodes/cc-cmds.el (c-electric-brace, c-electric-lt-gt)
- (c-electric-paren, c-beginning-of-defun, c-end-of-defun)
- (c-defun-name, c-mark-function, c-cpp-define-name)
- (c-comment-indent, c-scan-conditionals, c-indent-defun)
- (c-context-line-break): bind case-fold-search to nil.
+ * vc/vc-bzr.el (vc-bzr-sha1-program, sha1-program): Remove.
+ (vc-bzr-sha1): Use internal sha1.
- * progmodes/cc-mode.el (c-font-lock-fontify-region):
- bind case-fold-search to nil.
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
-2012-04-16 Chong Yidong <cyd@gnu.org>
+ * progmodes/flymake.el (flymake-mode): Beware read-only dirs (bug#8954).
- * mail/sendmail.el (mail-bury): Call return action with the right
- Rmail buffer (Bug#11242).
+2012-04-10 Sébastien Gross <seb@chezwam.org> (tiny change)
-2012-04-15 Chong Yidong <cyd@gnu.org>
+ * progmodes/hideshow.el (hs-hide-all): Don't infloop on comments
+ that start in the middle of the line (bug#10496).
- * server.el (server-process-filter): Handle corner case where both
- tty and nowait options are present (Bug#11102).
+2012-04-10 Dan Nicolaescu <dann@gnu.org>
-2012-04-15 Glenn Morris <rgm@gnu.org>
+ * battery.el (battery-linux-proc-acpi): Only one battery is
+ discharged at a time, but that seems to confuse battery.el when
+ computing `rate-type' for the battery not being discharged
+ (bug#10332).
- * simple.el (process-file-side-effects): Doc fix.
+2012-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
-2012-04-14 Glenn Morris <rgm@gnu.org>
+ * emacs-lisp/autoload.el (autoload-make-program): Remove, unused.
- * international/mule-cmds.el (set-language-environment): Doc fix.
+ * international/quail.el: Use dolist and simplify.
+ (quail-define-package, quail-update-keyboard-layout)
+ (quail-define-rules): Use dolist.
+ (quail-insert-kbd-layout, quail-get-translation): CSE.
-2012-04-14 Stefan Monnier <monnier@iro.umontreal.ca>
+ * tmm.el: Use dolist, remove left over hook.
+ (tmm-prompt, tmm-define-keys, tmm-shortcut, tmm-get-keybind):
+ Use dolist.
+ (calendar-load-hook): Don't mess with it.
- Avoid the use of ((lambda ...) ...) in lexical-binding code.
- * emacs-lisp/easy-mmode.el (define-minor-mode):Use funcall (bug#11241).
+ * vc/vc-annotate.el (vc-annotate-show-diff-revision-at-line-internal):
+ Use derived-mode-p. Run the diff asynchronously.
-2012-04-13 Kim F. Storm <storm@cua.dk>
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * emulation/cua-base.el (cua-exchange-point-and-mark): Just call
- exchange-point-and-mark if cua-enable-cua-keys is nil (Bug#11191).
+ * obsolete/mouse-sel.el: Add an Obsolete-since header.
-2012-04-12 Chong Yidong <cyd@gnu.org>
+2012-04-10 Juanma Barranquero <lekktu@gmail.com>
- * custom.el (custom-theme-set-variables): Doc fix.
+ * misc.el: Display absolute path of loaded DLLs (bug#10424).
+ (list-dynamic-libraries--loaded): New function.
+ (list-dynamic-libraries--refresh): Use it.
-2012-04-12 Glenn Morris <rgm@gnu.org>
+2012-04-10 Nathan Weizenbaum <nweiz@google.com>
- * international/mule.el (set-auto-coding-for-load): Doc fix.
+ * progmodes/python.el (python-fill-paragraph):
+ Make python-fill-region in a multiline string work when font-lock is
+ disabled (bug#7018).
-2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+2012-04-10 Laimonas Vėbra <laimonas.vebra@gmail.com> (tiny change)
- * imenu.el (imenu-add-to-menubar): `current-local-map' can be nil.
- Reported by Noah Friedman. Backport from trunk.
+ * language/european.el (cp775): Add oem/legacy (en)coding on
+ DOS/MS Windows for the Baltic languages. There are still plenty
+ of texts written in this encoding/codepage (bug#6519).
-2012-04-11 Alan Mackenzie <acm@muc.de>
+2012-04-10 Glenn Morris <rgm@gnu.org>
- * progmodes/cc-menus.el (cc-imenu-objc-generic-expression):
- Make imenu work again for Objective C Mode. Correct the *-index
- values, these having been disturbed by a previous change in 2011-08.
+ * cus-start.el (eol-mnemonic-unix, eol-mnemonic-dos, eol-mnemonic-mac):
+ Add :standard values, reducing "rogue" customs in emacs -Q a bit more.
- * progmodes/cc-engine.el (c-before-change-check-<>-operators):
- Correct two search limits.
+2012-04-10 Florian Adamsky <florian@adamsky.it> (tiny change)
-2012-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
+ * recentf.el (recentf-dialog-mode-map): Add two keybindings for
+ next-line "n" and previous-line "p" in order to make recentf more
+ consistent with ibuffer, dired or org-mode (bug#9387).
- * startup.el (command-line-1): Inhibit splash from daemon (bug#10996).
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-2012-04-10 Andreas Schwab <schwab@linux-m68k.org>
+ * image.el (put-image): Return the overlay created instead of the
+ optional input string (bug#7834). Note that this may break code
+ that is (for some reason or other) depending on `put-image'
+ returning the string.
- * international/characters.el: Fix sorting.
+ * mouse-sel.el (mouse-sel-mode): Mark as obsolete (bug#6174).
-2012-04-10 Eli Zaretskii <eliz@gnu.org>
+ * simple.el (zap-to-char): Allow zapping using input methods
+ (bug#1580).
- * international/characters.el: Add more missing Latin case pairs.
+ * textmodes/fill.el (fill-region): Leave point and mark where they
+ were before filling (bug#5399).
-2012-04-10 Andreas Schwab <schwab@linux-m68k.org>
+2012-04-09 Glenn Morris <rgm@gnu.org>
- * international/characters.el: Recover lost case pairs.
+ * version.el (emacs-bzr-get-version):
+ Handle lightweight checkouts of local branches.
-2012-04-10 Glenn Morris <rgm@gnu.org>
+2012-04-09 Andreas Schwab <schwab@linux-m68k.org>
- * files.el (dir-locals-set-class-variables): Doc fix.
+ * international/characters.el: Recover lost case pairs. (Bug#11209)
-2012-04-09 Eli Zaretskii <eliz@gnu.org>
+2012-04-09 Chong Yidong <cyd@gnu.org>
- * international/characters.el: Add set-case-syntax-pair call for
- LATIN CAPITAL LETTER Y WITH DIAERESIS RET and its lower-case
- counterpart. (Bug#11209)
+ * custom.el (custom-variable-p): Return nil for non-symbol
+ arguments instead of signaling an error.
+ (user-variable-p): Obsolete alias for custom-variable-p.
- * simple.el (shell-command-on-region): Doc fix. (Bug#11208)
+ * apropos.el (apropos-variable):
+ * files-x.el (read-file-local-variable):
+ * simple.el (set-variable):
+ * woman.el (woman-mini-help):
+ * emacs-lisp/byte-opt.el (side-effect-free-fns): Callers changed.
2012-04-09 Glenn Morris <rgm@gnu.org>
- * calendar/holidays.el (calendar-check-holidays): Doc fix.
+ * startup.el (normal-top-level): Don't look for leim-list.el
+ in places where it will not be found. (Bug#910)
+
+ * international/mule-cmds.el (set-default-coding-systems):
+ * files.el (normal-mode):
+ Remove guarded calls to ucs-set-table-for-input. (Bug#9821)
+ This function was removed with ucs-tables.el in 2008.
2012-04-08 Eli Zaretskii <eliz@gnu.org>
- * textmodes/ispell.el (ispell-dictionary-base-alist): Add data for
- Hebrew.
+ * textmodes/ispell.el (ispell-check-version): For hunspell, set
+ ispell-encoding8-command to "-i", without a trailing space.
+ (ispell-start-process): For hunspell, use '("-i" ENCODING), in 2
+ separate command-line arguments, to specify the encoding, since
+ that's how hunspell expects it.
-2012-04-08 Chong Yidong <cyd@gnu.org>
+2012-04-08 Glenn Morris <rgm@gnu.org>
- * net/rcirc.el (rcirc-cmd-quit): Revert 2012-03-18 change
- (Bug#11192).
+ * loadup.el: Load bindings before cus-start.
+ This reduces somewhat the number of "rogue" settings in emacs -Q.
2012-04-07 Glenn Morris <rgm@gnu.org>
- * pcmpl-rpm.el (pcomplete/rpm): Handle -qf.
+ * version.el (emacs-bzr-get-version): New function.
+ (emacs-bzr-version): New variable.
+ * loadup.el (emacs-bzr-version): Set it. (Bug#8054)
+ * mail/emacsbug.el (report-emacs-bug): Include bzr version.
2012-04-07 Eli Zaretskii <eliz@gnu.org>
- * minibuffer.el (completion-in-region-mode-map):
- Bind completion-help-at-point to M-? rather than ?. (Bug#11182)
+ * international/uni-bidi.el, international/uni-category.el:
+ * international/uni-combining.el, international/uni-decimal.el:
+ * international/uni-decomposition.el, international/uni-digit.el:
+ * international/uni-lowercase.el, international/uni-mirrored.el:
+ * international/uni-name.el, international/uni-numeric.el:
+ * international/uni-titlecase.el, international/uni-uppercase.el:
+ Update for Unicode 6.1.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (dynamic-library-alist): Add libxml2 DLLs.
2012-04-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
2012-03-30 Agustín Martín Domingo <agustin.martin@hispalinux.es>
- * ispell.el (ispell-get-extended-character-mode): Disable
- extended-char-mode for hunspell. hunspell does not support it and
- treats ~word as ordinary words in pipe mode.
+ * textmodes/ispell.el (ispell-get-extended-character-mode):
+ Disable extended-char-mode for hunspell. hunspell does not support it
+ and treats ~word as ordinary words in pipe mode.
2012-03-30 Glenn Morris <rgm@gnu.org>
(hfy-face-to-css-default): Same as the earlier `hfy-face-to-css'.
(hfy-face-to-css): Re-defined to be a variable.
(hfy-compile-stylesheet): Modify. Allow stylesheet to be built
- over multiple runs. This is made possible by having the caller let
+ over multiple runs. This is made possible by having the caller let
bind a special variable `hfy-user-sheet-assoc'.
(htmlfontify-string): New defun.
(hfy-compile-face-map): Make sure that the last char in the
2012-03-09 Michael Albinus <michael.albinus@gmx.de>
- * net/dbus.el: (dbus-property-handler): Return empty array if
+ * net/dbus.el (dbus-property-handler): Return empty array if
there are no properties.
2012-03-09 Leo Liu <sdl.web@gmail.com>
* term/x-win.el (x-initialize-window-system): Reduce default for
x-selection-timeout to 5 seconds (Bug#8869).
-2012-02-24 Thierry Volpiatto <thierry.volpiatto@gmail.com>
-
- * files.el (file-subdir-of-p): Fix typo.
-
2012-02-24 Thierry Volpiatto <thierry.volpiatto@gmail.com>
* files.el (files-equal-p, file-subdir-of-p): New functions.
files from Git, SVN, Bazaar, and Mercurial.
(save-place-to-alist): Use it.
-2012-02-17 Lawrence Mitchell <wence@gmx.li>
- Stefan Monnier <monnier@iro.umontreal.ca>
+2012-02-17 Lawrence Mitchell <wence@gmx.li>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* newcomment.el (uncomment-region-default): Don't leave extra space
when an arg is provided (bug#8150).
2012-02-12 Alan Mackenzie <acm@muc.de>
Fix infinite loop with long macros.
- * cc-engine.el (c-state-safe-place): Handle macros properly.
+ * progmodes/cc-engine.el (c-state-safe-place): Handle macros properly.
2012-02-12 Chong Yidong <cyd@gnu.org>
2012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
- * progmodes/cc-mode.el
- (c-standard-font-lock-fontify-region-function): Set the default at
- load time, too, so that `font-lock-fontify-buffer' can be called
- without setting up the entire mode first. This fixes a bug in
- `mm-inline-text' with C MIME parts.
+ * progmodes/cc-mode.el (c-standard-font-lock-fontify-region-function):
+ Set the default at load time, too, so that `font-lock-fontify-buffer'
+ can be called without setting up the entire mode first. This fixes
+ a bug in `mm-inline-text' with C MIME parts.
2012-02-06 Chong Yidong <cyd@gnu.org>
* net/tramp.el (tramp-action-login): Set connection property "login-as".
- * net/tramp-cache.el (tramp-dump-connection-properties): Do not dump
- properties, when "login-as" is set.
-
* net/tramp-sh.el (tramp-methods): Add user spec to "pscp" and "psftp".
(tramp-default-user-alist): Don't add "pscp".
(tramp-do-copy-or-rename-file-out-of-band): Use connection
Declare as obsolete.
(ns-get-pasteboard, ns-paste-secondary):
Use ns-get-selection-internal.
- (ns-set-pasteboard, ns-copy-including-secondary):
+ (ns-set-pasteboard, ns-copy-including-secondary):
Use ns-store-selection-internal.
2011-12-17 Chong Yidong <cyd@gnu.org>
2011-11-16 Michael Albinus <michael.albinus@gmx.de>
- * net/tramp-cache.el (tramp-flush-file-property): Flush also
- properties of linked files. (Bug#9879)
-
* net/tramp-sh.el (tramp-sh-handle-file-truename): Cache only the
local file name.
(tramp-completion-file-name-regexp-unified)
(tramp-completion-file-name-regexp-separate)
(tramp-completion-file-name-regexp-url): Don't use leading volume
- letter on win32 systems. (Bug#5303, Bug#9311)
+ letter on w32 systems. (Bug#5303, Bug#9311)
(tramp-drop-volume-letter): Simplify definition.
Suggested by Stefan Monnier <monnier@iro.umontreal.ca>.
insecure exception for current topic. Also note that auto-saves
are handled differently.
- (allout-auto-save-temporarily-disabled), (allout-just-did-undo):
+ (allout-auto-save-temporarily-disabled, allout-just-did-undo):
State variables for tracking auto-save inhibition situation.
(allout-write-contents-hook-handler): Rename from
(newsticker--plainview-tool-bar-map): Move tool-bar icons to
etc/images/newsticker.
- * net/newst-backend.el (newsticker--do-run-auto-mark-filter),
- (newsticker--process-auto-mark-filter-match): : Tell user about
+ * net/newst-backend.el (newsticker--do-run-auto-mark-filter)
+ (newsticker--process-auto-mark-filter-match): Tell user about
auto-marking.
2011-05-13 Didier Verna <didier@xemacs.org>
* textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a
2011-05-10 Glenn Morris <rgm@gnu.org>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* files.el (hack-one-local-variable-eval-safep):
Consider "eval: (foo-mode)" to be safe. (Bug#8613)
* vc/log-view.el:
* vc/smerge-mode.el:
* textmodes/bibtex-style.el:
- * textmodes/css.el:
+ * textmodes/css-mode.el:
* startup.el:
* uniquify.el:
* minibuffer.el:
2004-01-29 Jari Aalto <jari.aalto@poboxes.com>
* progmodes/executable.el (executable-command-find-posix-p):
- New. Check if find handles arguments Posix-style.
+ New. Check if find handles arguments POSIX-style.
* progmodes/grep.el (grep-compute-defaults):
Use executable-command-find-posix-p.
* calendar/appt.el (diary-selective-display): Add defvar.
- * sort.el (sort-columns): Use Posix arg syntax for `sort'.
+ * sort.el (sort-columns): Use POSIX arg syntax for `sort'.
* isearch.el (search-whitespace-regexp): Fix custom type.
* bookmark.el (bookmark-show-annotation): Use `when' instead of `if'.
This is also from Thierry Volpiatto's patch in bug #6444. However,
because it was extraneous to the functional change in that patch,
- and causes a re-indendation, I am committing it separately.
+ and causes a re-indentation, I am committing it separately.
2010-07-13 Thierry Volpiatto <thierry.volpiatto@gmail.com>
* ediff-diff.el (ediff-setup-fine-diff-regions):
Allow diff options to be passed to the diff program.
- (ediff-make-diff2-buffer): Don't run Posix diff on remote files.
+ (ediff-make-diff2-buffer): Don't run POSIX diff on remote files.
(ediff-make-diff2-buffer): Refuses to diff remote files.
(ediff-make-diff2-buffer, ediff-setup-diff-regions): Changed functions.
(ediff-make-diff2-buffer): New function.
(sh-mode-map): Added new bindings.
(sh-mode): Updated mode doc-string for new commands, added
make-local-variable calls, initialize mode-specific variables.
- (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line
+ (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line
is now a different function.
(sh-header-marker): Changed docstring.
(sh-set-shell): Initialize mode-specific variables.
standard `print' and `nprint' programs, as well as `lpr' and
similar programs. Only write directly to the printer port if no
print program is specified. Work around a bug in Windows 9x
- affecting Win32 version of Emacs by invoking command.com to write
+ affecting the w32 version of Emacs by invoking command.com to write
to the printer port instead of writing directly.
(direct-print-region-function): Use direct-print-region-helper to
do most of the work.
Don't bind mouse events or tab/backtab.
(help-function, help-variable, help-face, help-coding-system)
(help-input-method, help-character-set, help-back, help-info)
- (help-customize-variable, help-function-def, help-variable-def):
+ (help-customize-variable, help-function-def, help-variable-def):
New button types.
(help-button-action): New function.
(describe-function-1): Pass help button-types to
(antlr-downcase-literals): New command.
(antlr-upcase-literals): Ditto.
- * antlr-mode.el: Minor changes: indendation, mode-name.
+ * antlr-mode.el: Minor changes: indentation, mode-name.
(antlr-indent-line): Indent cpp directive at column 0.
(antlr-mode): Use mode-name prefix "Antlr." instead of "Antlr/".
* term/tty-colors.el (tty-defined-color-alist): Renamed from
tty-color-alist.
(tty-color-alist, tty-modify-color-alist): New functions.
- (tty-color-define, tty-color-clear, tty-color-approximate)
+ (tty-color-define, tty-color-clear, tty-color-approximate)
(tty-color-translate, tty-color-by-index, tty-color-desc): Accept an
optional parameter FRAME.
# Maintenance productions for the Lisp directory
-# Copyright (C) 2000-2012 Free Software Foundation, Inc.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
# During bootstrapping the byte-compiler is run interpreted when compiling
# itself, and uses more stack than usual.
#
-BIG_STACK_DEPTH = 1200
+BIG_STACK_DEPTH = 2200
BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
-# speed up the bootstrap process.
+# speed up the bootstrap process. They're ordered by size, so we use
+# the slowest-compiler on the smallest file and move to larger files as the
+# compiler gets faster. `autoload.elc' comes last because it is not used by
+# the compiler (so its compilation does not speed up subsequent compilations),
+# it's only placed here so as to speed up generation of the loaddefs.el file.
COMPILE_FIRST = \
- $(lisp)/emacs-lisp/bytecomp.elc \
- $(lisp)/emacs-lisp/byte-opt.elc \
$(lisp)/emacs-lisp/macroexp.elc \
- $(lisp)/emacs-lisp/cconv.elc \
+ $(lisp)/emacs-lisp/cconv.elc \
+ $(lisp)/emacs-lisp/byte-opt.elc \
+ $(lisp)/emacs-lisp/bytecomp.elc \
$(lisp)/emacs-lisp/autoload.elc
# The actual Emacs command run in the targets below.
emacs = EMACSLOADPATH=$(lisp) LC_ALL=C $(EMACS) $(EMACSOPT)
# Common command to find subdirectories
-setwins=subdirs=`(find . -type d -print)`; \
+setwins=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* ) ;; \
*) wins="$$wins $$file" ;; \
done
# Find all subdirectories except `obsolete' and `term'.
-setwins_almost=subdirs=`(find . -type d -print)`; \
+setwins_almost=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* | */obsolete | */term ) ;; \
*) wins="$$wins $$file" ;; \
done
# Find all subdirectories in which we might want to create subdirs.el
-setwins_for_subdirs=subdirs=`(find . -type d -print)`; \
+setwins_for_subdirs=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* | */cedet* ) ;; \
*) wins="$$wins $$file" ;; \
esac; \
done
-# `compile-main' tends to be slower than `recompile' but can be parallelized
-# with "make -j" and results in more deterministic compilation warnings.
# cus-load and finder-inf are not explicitly requested by anything, so
# we add them here to make sure they get built.
all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el
doit:
+.PHONY: all doit custom-deps finder-data autoloads update-subdirs
+
# custom-deps and finder-data both used to scan _all_ the *.el files.
# This could lead to problems in parallel builds if automatically
# generated *.el files (eg loaddefs etc) were being changed at the same time.
update-subdirs: doit
cd $(lisp); $(setwins_for_subdirs); \
for file in $$wins; do \
- $(top_srcdir)/update-subdirs $$file; \
+ $(top_srcdir)/build-aux/update-subdirs $$file; \
done;
-updates: update-subdirs autoloads finder-data custom-deps
+.PHONY: updates bzr-update update-authors
-# This is useful after "bzr up".
-bzr-update: recompile autoloads finder-data custom-deps
+# Some modes of make-dist use this.
+updates: update-subdirs autoloads finder-data custom-deps
-# For backwards compatibility:
-cvs-update: bzr-update
+# This is useful after "bzr up"; but it doesn't do anything that a
+# plain "make" at top-level doesn't.
+# The only difference between this and this directory's "all" rule
+# is that this runs "autoloads" as well (because it uses "compile"
+# rather than "compile-main"). In a bootstrap, $(lisp) in src/Makefile
+# triggers this directory's autoloads rule.
+bzr-update: compile finder-data custom-deps
# Update the AUTHORS file.
# src/Makefile.in to rebuild a particular Lisp file, no questions asked.
# Use byte-compile-refresh-preloaded to try and work around some of
# the most common problems of not bootstrapping from a clean state.
+.PHONY: compile-onefile
compile-onefile:
@echo Compiling $(THEFILE)
@# Use byte-compile-refresh-preloaded to try and work around some of
cd $(lisp); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc
$(MAKE) $(MFLAGS) compile EMACS=$(EMACS)
+.PHONY: compile-calc backup-compiled-files compile-after-backup
+
compile-calc:
for el in $(lisp)/calc/*.el; do \
echo Compiling $$el; \
compile-after-backup: backup-compiled-files compile-always
-# Recompile all Lisp files which are newer than their .elc files and compile
-# new ones.
-# This has the same effect as compile-main. recompile has some advantages:
-# i) It is faster (on a single processor), since it only has to start
-# Emacs once. It was 33% faster on a test with a random 10% of the .el
-# files needing recompilation.
-# ii) The explicit cc-mode dependency.
-# recompile's disadvantages are:
-# i) Not parallelizable.
-# ii) Compiling multiple files in the same instance of Emacs is wrong,
-# since the environment of later files is affected by definitions in
-# earlier ones.
-recompile: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc
+# This does the same job as the "compile" rule, but in a different way.
+# Rather than spawning a separate Emacs instance to compile each file,
+# it uses the same Emacs instance to compile everything.
+# This is faster on a single core, since it avoids the overhead of
+# starting Emacs many times (it was 33% faster on a test with a
+# random 10% of the .el files needing recompilation).
+# Unlike compile, this is not parallelizable; so if you have more than
+# one core and use make -j#, compile will be (much) faster.
+# This rule also produces less accurate compilation warnings.
+# The environment of later files is affected by definitions in
+# earlier ones, so it does not produce some warnings that it should.
+# It can also produces spurious warnings about "invalid byte code" if
+# files that use byte-compile-dynamic are updated.
+# There is no reason to use this rule unless you only have a single
+# core and CPU time is an issue.
+.PHONY: compile-one-process
+compile-one-process: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc
$(emacs) $(BYTE_COMPILE_FLAGS) \
--eval "(batch-byte-recompile-directory 0)" $(lisp)
$(MH_E_DIR)/mh-tool-bar.el $(MH_E_DIR)/mh-utils.el \
$(MH_E_DIR)/mh-xface.el
+.PHONY: mh-autoloads
mh-autoloads: $(MH_E_DIR)/mh-loaddefs.el
$(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
$(emacs) -l autoload \
--eval "(setq make-backup-files nil)" \
-f batch-update-autoloads $(CAL_DIR)
-# Prepare a bootstrap in the lisp subdirectory.
-#
-# Build loaddefs.el to make sure it's up-to-date. If it's not, that
-# might lead to errors during the bootstrap because something fails to
-# autoload as expected. If there is no emacs binary, then we can't
-# build autoloads yet. In that case we have to use ldefs-boot.el.
-# Bootstrap should always work with ldefs-boot.el. Therefore,
-# whenever a new autoload cookie gets added that is necessary during
-# bootstrapping, ldefs-boot.el should be updated by overwriting it with
-# an up-to-date copy of loaddefs.el that is uncorrupted by
-# local changes. (Because loaddefs.el is an automatically generated
-# file, we don't want to store it in the source repository).
+.PHONY: bootstrap-clean distclean maintainer-clean
bootstrap-clean:
cd $(lisp); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc $(AUTOGENEL)
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup abbrev-mode nil
"Word abbreviations mode."
(push table empty-tables)
(insert-abbrev-table-description table t)))
(dolist (table (nreverse empty-tables))
- (insert-abbrev-table-description table t))))
+ (insert-abbrev-table-description table t)))
+ ;; Note: `list-abbrevs' can display only local abbrevs, in
+ ;; which case editing could lose abbrevs of other tables. Thus
+ ;; enter `edit-abbrevs-mode' only if LOCAL is nil.
+ (edit-abbrevs-mode))
(goto-char (point-min))
(set-buffer-modified-p nil)
- (edit-abbrevs-mode)
(current-buffer))))
(defun edit-abbrevs-mode ()
(defun edit-abbrevs ()
"Alter abbrev definitions by editing a list of them.
-Selects a buffer containing a list of abbrev definitions.
+Selects a buffer containing a list of abbrev definitions with
+point located in the abbrev table of current buffer.
You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs
according to your editing.
Buffer contains a header line for each abbrev table,
USECOUNT is an integer, and HOOK is any valid function
or may be omitted (it is usually omitted)."
(interactive)
- (switch-to-buffer (prepare-abbrev-list-buffer)))
+ (let ((table-name (abbrev-table-name local-abbrev-table)))
+ (switch-to-buffer (prepare-abbrev-list-buffer))
+ (when (and table-name
+ (search-forward
+ (concat "(" (symbol-name table-name) ")\n\n") nil t))
+ (goto-char (match-end 0)))))
(defun edit-abbrevs-redefine ()
"Redefine abbrevs according to current buffer contents."
(dotimes (i (length table))
(aset table i 0))
;; Preserve the table's properties.
- (assert sym)
+ (cl-assert sym)
(let ((newsym (intern "" table)))
(set newsym nil) ; Make sure it won't be confused for an abbrev.
(setplist newsym (symbol-plist sym)))
\(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)."
(when (and (consp props) (or (null (car props)) (numberp (car props))))
;; Old-style calling convention.
- (setq props (list* :count (car props)
- (if (cadr props) (list :system (cadr props))))))
+ (setq props `(:count ,(car props)
+ ,@(if (cadr props) (list :system (cadr props))))))
(unless (plist-get props :count)
(setq props (plist-put props :count 0)))
(let ((system-flag (plist-get props :system))
(let ((badchars ())
(pos 0))
(while (string-match "\\W" abbrev pos)
- (pushnew (aref abbrev (match-beginning 0)) badchars)
+ (cl-pushnew (aref abbrev (match-beginning 0)) badchars)
(setq pos (1+ pos)))
(error "Some abbrev characters (%s) are not word constituents %s"
(apply 'string (nreverse badchars))
(interactive)
(run-hooks 'pre-abbrev-expand-hook)
(with-wrapper-hook abbrev-expand-functions ()
- (destructuring-bind (&optional sym name wordstart wordend)
- (abbrev--before-point)
+ (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point)))
(when sym
(let ((startpos (copy-marker (point) t))
(endmark (copy-marker wordend t)))
;; align-?-modes variables (for example, `align-dq-string-modes'), use
;; `add-to-list', or some similar function which checks first to see
;; if the value is already there. Since the user may customize that
-;; mode list, and then write your mode name into their .emacs file,
+;; mode list, and then write your mode name into their init file,
;; causing the symbol already to be present the next time they load
;; your package.
(gocol col) cur)
(when area
(if func
- (funcall func (car area) (cdr area) change)
+ (funcall func
+ (marker-position (car area))
+ (marker-position (cdr area))
+ change)
(if (not (and justify
(consp (cdr area))))
(goto-char (cdr area))
(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
(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)
(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
;; 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))
(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
;; 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
;; 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)
(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
(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"))))
)
;; ;;;_ = allout-widgets-allow-unruly-edits
;; (defcustom allout-widgets-allow-unruly-edits nil
-;; "*Control whether manual edits are restricted to maintain outline integrity.
+;; "Control whether manual edits are restricted to maintain outline integrity.
;; When nil, manual edits must either be within an item's body or encompass
;; one or more items completely - eg, killing topics as entities, rather than
;;;_ = allout-widgets-item-image-properties-emacs
(defcustom allout-widgets-item-image-properties-emacs
'(:ascent center :mask (heuristic t))
- "*Default properties item widget images in mainline Emacs."
+ "Default properties item widget images in mainline Emacs."
:version "24.1"
:type 'plist
:group 'allout-widgets)
;;;_ = allout-widgets-item-image-properties-xemacs
(defcustom allout-widgets-item-image-properties-xemacs
nil
- "*Default properties item widget images in XEmacs."
+ "Default properties item widget images in XEmacs."
:version "24.1"
:type 'plist
:group 'allout-widgets)
;;;_ . Developer
;;;_ = allout-widgets-run-unit-tests-on-load
(defcustom allout-widgets-run-unit-tests-on-load nil
- "*When non-nil, unit tests will be run at end of loading allout-widgets.
+ "When non-nil, unit tests will be run at end of loading allout-widgets.
Generally, allout widgets code developers are the only ones who'll want to
set this.
:group 'allout-widgets-developer)
;;;_ = allout-widgets-time-decoration-activity
(defcustom allout-widgets-time-decoration-activity nil
- "*Retain timing info of the last cooperative redecoration.
+ "Retain timing info of the last cooperative redecoration.
The details are retained as the value of
`allout-widgets-last-decoration-timing'.
:group 'allout-widgets-developer)
;;;_ = allout-widgets-hook-error-post-time 0
(defcustom allout-widgets-hook-error-post-time 0
- "*Amount of time to sit showing hook error messages.
+ "Amount of time to sit showing hook error messages.
0 is minimal, or nil to not post to the message area.
:group 'allout-widgets-developer)
;;;_ = allout-widgets-maintain-tally nil
(defcustom allout-widgets-maintain-tally nil
- "*If non-nil, maintain a collection of widgets, `allout-widgets-tally'.
+ "If non-nil, maintain a collection of widgets, `allout-widgets-tally'.
This is for debugging purposes.
(format ":%s" (hash-table-count allout-widgets-tally))))
;;;_ = allout-widgets-track-decoration nil
(defcustom allout-widgets-track-decoration nil
- "*If non-nil, show cursor position of each item decoration.
+ "If non-nil, show cursor position of each item decoration.
This is for debugging purposes, and generally set at need in a
buffer rather than as a prevailing configuration \(but it's handy
;;;_ , Widget-specific outline text format
;;;_ = allout-escaped-prefix-regexp
(defvar allout-escaped-prefix-regexp ""
- "*Regular expression for body text that would look like an item prefix if
+ "Regular expression for body text that would look like an item prefix if
not altered with an escape sequence.")
(make-variable-buffer-local 'allout-escaped-prefix-regexp)
;;;_ , Widget element formatting
(if (current-local-map)
(set-keymap-parent allout-item-body-keymap (current-local-map)))
- (add-hook 'allout-exposure-change-hook
+ (add-hook 'allout-exposure-change-functions
'allout-widgets-exposure-change-recorder nil 'local)
- (add-hook 'allout-structure-added-hook
+ (add-hook 'allout-structure-added-functions
'allout-widgets-additions-recorder nil 'local)
- (add-hook 'allout-structure-deleted-hook
+ (add-hook 'allout-structure-deleted-functions
'allout-widgets-deletions-recorder nil 'local)
- (add-hook 'allout-structure-shifted-hook
+ (add-hook 'allout-structure-shifted-functions
'allout-widgets-shifts-recorder nil 'local)
(add-hook 'allout-after-copy-or-kill-hook
'allout-widgets-after-copy-or-kill-function nil 'local)
(remove-hook 'after-change-functions
'allout-widgets-after-change-handler 'local)
- (remove-hook 'allout-exposure-change-hook
+ (remove-hook 'allout-exposure-change-functions
'allout-widgets-exposure-change-recorder 'local)
- (remove-hook 'allout-structure-added-hook
+ (remove-hook 'allout-structure-added-functions
'allout-widgets-additions-recorder 'local)
- (remove-hook 'allout-structure-deleted-hook
+ (remove-hook 'allout-structure-deleted-functions
'allout-widgets-deletions-recorder 'local)
- (remove-hook 'allout-structure-shifted-hook
+ (remove-hook 'allout-structure-shifted-functions
'allout-widgets-shifts-recorder 'local)
(remove-hook 'allout-after-copy-or-kill-hook
'allout-widgets-after-copy-or-kill-function 'local)
(defun allout-widgets-exposure-change-processor (changes)
"Widgetize and adjust item widgets tracking allout outline exposure changes.
-Generally invoked via `allout-exposure-change-hook'."
+Generally invoked via `allout-exposure-change-functions'."
(let ((changes (sort changes (function (lambda (this next)
(< (cadr this) (cadr next))))))
(defun allout-widgets-additions-recorder (from to)
"Record allout item additions for tracking during post-command processing.
-Intended for use on `allout-structure-added-hook'.
+Intended for use on `allout-structure-added-functions'.
FROM point at the start of the first new item and TO is point at the start
of the last one.
;;;_ > allout-widgets-deletions-recorder (depth from)
(defun allout-widgets-deletions-recorder (depth from)
"Record allout item deletions for tracking during post-command processing.
-
-Intended for use on `allout-structure-deleted-hook'.
+Intended for use on `allout-structure-deleted-functions'.
DEPTH is the depth of the deleted subtree, and FROM is the point from which
the subtree was deleted.
;;;_ > allout-widgets-shifts-recorder (shifted-amount at)
(defun allout-widgets-shifts-recorder (shifted-amount at)
"Record outline subtree shifts for tracking during post-command processing.
-
-Intended for use on `allout-structure-shifted-hook'.
+Intended for use on `allout-structure-shifted-functions'.
SHIFTED-AMOUNT is the depth change and AT is the point at the start of the
subtree that's been shifted.
;; (time-trial
;; '(let ((size 10000)
;; doing)
-;; (random t)
;; (dotimes (count size)
;; (setq doing (random size))
;; (funcall try doing (+ doing (random 5)))
;;;_ : Topic header format
;;;_ = allout-regexp
(defvar allout-regexp ""
- "*Regular expression to match the beginning of a heading line.
+ "Regular expression to match the beginning of a heading line.
Any line whose beginning matches this regexp is considered a
heading. This var is set according to the user configuration vars
(make-variable-buffer-local 'allout-bullets-string-len)
;;;_ = allout-depth-specific-regexp
(defvar allout-depth-specific-regexp ""
- "*Regular expression to match a heading line prefix for a particular depth.
+ "Regular expression to match a heading line prefix for a particular depth.
This expression is used to search for depth-specific topic
headers at depth 2 and greater. Use `allout-depth-one-regexp'
(make-variable-buffer-local 'allout-depth-specific-regexp)
;;;_ = allout-depth-one-regexp
(defvar allout-depth-one-regexp ""
- "*Regular expression to match a heading line prefix for depth one.
+ "Regular expression to match a heading line prefix for depth one.
This var is set according to the user configuration vars by
`set-allout-regexp'. It is prepared with format strings for two
,expr))
;;;_ = allout-mode-hook
(defvar allout-mode-hook nil
- "*Hook that's run when allout mode starts.")
+ "Hook run when allout mode starts.")
;;;_ = allout-mode-deactivate-hook
-(defvar allout-mode-deactivate-hook nil
- "*Hook that's run when allout mode ends.")
(define-obsolete-variable-alias 'allout-mode-deactivate-hook
'allout-mode-off-hook "24.1")
+(defvar allout-mode-deactivate-hook nil
+ "Hook run when allout mode ends.")
;;;_ = allout-exposure-category
(defvar allout-exposure-category nil
"Symbol for use as allout invisible-text overlay category.")
-;;;_ = allout-exposure-change-hook
-(defvar allout-exposure-change-hook nil
- "*Hook that's run after allout outline subtree exposure changes.
+;;;_ = allout-exposure-change-functions
+(define-obsolete-variable-alias 'allout-exposure-change-hook
+ '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'.
Functions on the hook must take three arguments:
- TO -- integer indicating the point of the end of the change.
- FLAG -- change mode: nil for exposure, otherwise concealment.
-This hook might be invoked multiple times by a single command.")
-;;;_ = allout-structure-added-hook
-(defvar allout-structure-added-hook nil
- "*Hook that's run after addition of items to the outline.
+This hook might be invoked multiple times by a single command."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
+;;;_ = allout-structure-added-functions
+(define-obsolete-variable-alias 'allout-structure-added-hook
+ '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:
- NEW-START -- integer indicating position of start of the first new item.
- NEW-END -- integer indicating position of end of the last new item.
-This hook might be invoked multiple times by a single command.")
-;;;_ = allout-structure-deleted-hook
-(defvar allout-structure-deleted-hook nil
- "*Hook that's run after disciplined deletion of subtrees from the outline.
+This hook might be invoked multiple times by a single command."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
+;;;_ = allout-structure-deleted-functions
+(define-obsolete-variable-alias 'allout-structure-deleted-hook
+ '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:
- DEPTH -- integer indicating the depth of the subtree that was deleted.
Some edits that remove or invalidate items may be missed by this hook:
specifically edits that native allout routines do not control.
-This hook might be invoked multiple times by a single command.")
-;;;_ = allout-structure-shifted-hook
-(defvar allout-structure-shifted-hook nil
- "*Hook that's run after shifting of items in the outline.
+This hook might be invoked multiple times by a single command."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
+;;;_ = allout-structure-shifted-functions
+(define-obsolete-variable-alias 'allout-structure-shifted-hook
+ '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:
- DEPTH-CHANGE -- integer indicating depth increase, negative for decrease
Some edits that shift items can be missed by this hook: specifically edits
that native allout routines do not control.
-This hook might be invoked multiple times by a single command.")
+This hook might be invoked multiple times by a single command."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
+
;;;_ = allout-after-copy-or-kill-hook
-(defvar allout-after-copy-or-kill-hook nil
- "*Hook that's run after copying outline text.
+(defcustom allout-after-copy-or-kill-hook nil
+ "Normal hook run after copying outline text.."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
-Functions on the hook should not require any arguments.")
;;;_ = allout-post-undo-hook
-(defvar allout-post-undo-hook nil
- "*Hook that's run after undo activity.
-
+(defcustom allout-post-undo-hook nil
+ "Normal hook run after undo activity.
The item that's current when the hook is run *may* be the one
-that was affected by the undo.
+that was affected by the undo.."
+ :type 'hook
+ :group 'allout
+ :version "24.3")
-Functions on the hook should not require any arguments.")
;;;_ = allout-outside-normal-auto-fill-function
(defvar allout-outside-normal-auto-fill-function nil
"Value of `normal-auto-fill-function' outside of allout mode.
the Emacs buffer state, if file variable adjustments are enabled. See
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-verifier-string)
-(make-obsolete 'allout-passphrase-verifier-string
- 'allout-passphrase-verifier-string "23.3")
+(make-obsolete-variable 'allout-passphrase-verifier-string
+ 'allout-passphrase-verifier-string "23.3")
;;;###autoload
(put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp)
;;;_ = allout-passphrase-hint-string
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-hint-string)
(setq-default allout-passphrase-hint-string "")
-(make-obsolete 'allout-passphrase-hint-string
- 'allout-passphrase-hint-string "23.3")
+(make-obsolete-variable 'allout-passphrase-hint-string
+ 'allout-passphrase-hint-string "23.3")
;;;###autoload
(put 'allout-passphrase-hint-string 'safe-local-variable 'stringp)
;;;_ = allout-after-save-decrypt
MODE is the activation mode - see `allout-auto-activation' for
valid values."
-
+ (declare (obsolete allout-auto-activation "23.3"))
(custom-set-variables (list 'allout-auto-activation (format "%s" mode)))
(format "%s" mode))
-(make-obsolete 'allout-init
- "customize 'allout-auto-activation' instead." "23.3")
+
;;;_ > allout-setup-menubar ()
(defun allout-setup-menubar ()
"Populate the current buffer's menubar with `allout-mode' stuff."
`allout-mode-hook'
`allout-mode-deactivate-hook' (deprecated)
`allout-mode-off-hook'
-`allout-exposure-change-hook'
-`allout-structure-added-hook'
-`allout-structure-deleted-hook'
-`allout-structure-shifted-hook'
+`allout-exposure-change-functions'
+`allout-structure-added-functions'
+`allout-structure-deleted-functions'
+`allout-structure-shifted-functions'
`allout-after-copy-or-kill-hook'
`allout-post-undo-hook'
(allout-show-children)))
(end-of-line)
- (run-hook-with-args 'allout-structure-added-hook start end)
+ (run-hook-with-args 'allout-structure-added-functions start end)
)
)
)
nil ;;; number-control
nil ;;; index
t) ;;; do-successors
- (run-hook-with-args 'allout-exposure-change-hook
+ (run-hook-with-args 'allout-exposure-change-functions
from to t))
(setq arg (1- arg))
(if (<= arg 0)
(not (allout-encrypted-topic-p)))
(allout-reindent-body current-depth new-depth))
- (run-hook-with-args 'allout-exposure-change-hook mb me nil)
+ (run-hook-with-args 'allout-exposure-change-functions mb me nil)
;; Recursively rectify successive siblings of orig topic if
;; caller elected for it:
(allout-show-children))))))
(let ((where (point)))
(allout-rebullet-topic 1 (and (> arg 1) 'sans-offspring))
- (run-hook-with-args 'allout-structure-shifted-hook arg where))))
+ (run-hook-with-args 'allout-structure-shifted-functions arg where))))
;;;_ > allout-shift-out (arg)
(defun allout-shift-out (arg)
"Decrease depth of current heading and any topics collapsed within it.
(goto-char child-point)
(allout-shift-out 1))))
(allout-rebullet-topic (* arg -1))))
- (run-hook-with-args 'allout-structure-shifted-hook (* arg -1) where))))
+ (run-hook-with-args 'allout-structure-shifted-functions (* arg -1) where))))
;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
;;;_ > allout-kill-line (&optional arg)
(defun allout-kill-line (&optional arg)
(if (not (save-match-data (looking-at allout-regexp)))
(allout-next-heading))
(allout-renumber-to-depth depth)))
- (run-hook-with-args 'allout-structure-deleted-hook depth (point))))))
+ (run-hook-with-args 'allout-structure-deleted-functions depth (point))))))
;;;_ > allout-copy-line-as-kill ()
(defun allout-copy-line-as-kill ()
"Like `allout-kill-topic', but save to kill ring instead of deleting."
(save-excursion
(allout-renumber-to-depth depth))
- (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
+ (run-hook-with-args 'allout-structure-deleted-functions depth (point)))))
;;;_ > allout-copy-topic-as-kill ()
(defun allout-copy-topic-as-kill ()
"Like `allout-kill-topic', but save to kill ring instead of deleting."
(allout-deannotate-hidden (allout-mark-marker t) (point)))
(if (not resituate)
(exchange-point-and-mark))
- (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
+ (run-hook-with-args 'allout-structure-added-functions subj-beg subj-end))))
;;;_ > allout-yank (&optional arg)
(defun allout-yank (&optional arg)
"`allout-mode' yank, with depth and numbering adjustment of yanked topics.
;;;_ > allout-flag-region (from to flag)
(defun allout-flag-region (from to flag)
"Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
-
-Exposure-change hook `allout-exposure-change-hook' is run with the same
-arguments as this function, after the exposure changes are made."
+After the exposure changes are made, run the abnormal hook
+`allout-exposure-change-functions' with the same arguments as
+this function."
;; We use outline invisibility spec.
(remove-overlays from to 'category 'allout-exposure-category)
(overlay-put o (pop props) (pop props))
(error nil))))))
(setq allout-this-command-hid-text t))
- (run-hook-with-args 'allout-exposure-change-hook from to flag))
+ (run-hook-with-args 'allout-exposure-change-functions from to flag))
;;;_ > allout-flag-current-subtree (flag)
(defun allout-flag-current-subtree (flag)
"Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
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
(allout-inhibit-auto-save-info-for-decryption was-buffer-saved-size)
(allout-maybe-resume-auto-save-info-after-encryption))
- (run-hook-with-args 'allout-structure-added-hook
+ (run-hook-with-args 'allout-structure-added-functions
bullet-pos subtree-end))))
;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue
;;; &optional rejected)
"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 <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>."
:version "21.1"
:group 'processes)
(defcustom ansi-color-faces-vector
- [default bold default italic underline bold bold-italic modeline]
+ [default bold default italic underline success warning error]
"Faces used for SGR control sequences determining a face.
This vector holds the faces used for SGR control sequence parameters 0
to 7.
2 faint default
3 italic italic
4 underlined underline
- 5 slowly blinking bold
- 6 rapidly blinking bold-italic
- 7 negative image modeline
+ 5 slowly blinking success
+ 6 rapidly blinking warning
+ 7 negative image error
Note that the symbol `default' is special: It will not be combined
with the current face.
(t
(ansi-color-apply-on-region start-marker end-marker)))))
-(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region)
-(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1")
+(define-obsolete-function-alias 'ansi-color-unfontify-region
+ 'font-lock-default-unfontify-region "24.1")
;; 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)
(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.
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.
(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.
(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)
(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)
"Translates SGR control sequences into overlays or extents.
Delete all other control sequences without processing them.
-SGR control sequences are applied by setting foreground and
-background colors to the text 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))
+SGR control sequences are applied by calling the function
+specified by `ansi-color-apply-face-function'. The default
+function sets foreground and background colors to the text
+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
+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))
;; 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.
;; Helper functions
-(defun ansi-color-apply-sequence (escape-sequence faces)
- "Apply ESCAPE-SEQ to FACES and return the new list of faces.
-
-ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'.
+(defsubst ansi-color-parse-sequence (escape-seq)
+ "Return the list of all the parameters in ESCAPE-SEQ.
-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.
+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 `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)))))
+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)))
+
+(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.
(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
;; Fixed bug, current-local-map can return nil.
;; Change, doesn't calculate key-bindings unless needed.
;; Added super-apropos capability, changed print functions.
-;;; Made fast-apropos and super-apropos share code.
-;;; Sped up fast-apropos again.
+;; Made fast-apropos and super-apropos share code.
+;; Sped up fast-apropos again.
;; Added apropos-do-all option.
-;;; Added fast-command-apropos.
+;; Added fast-command-apropos.
;; Changed doc strings to comments for helping functions.
-;;; Made doc file buffer read-only, buried it.
+;; Made doc file buffer read-only, buried it.
;; Only call substitute-command-keys if do-all set.
;; Optionally use configurable faces to make the output more legible.
;;; Code:
(require 'button)
-(eval-when-compile (require 'cl))
(defgroup apropos nil
"Apropos commands for users and programmers."
:group 'apropos
:type 'boolean)
+(defface apropos-symbol
+ '((t (:inherit bold)))
+ "Face for the symbol name in Apropos output."
+ :group 'apropos
+ :version "24.3")
-(defcustom apropos-symbol-face 'bold
- "Face for symbol name in Apropos output, or nil for none."
+(defface apropos-keybinding
+ '((t (:inherit underline)))
+ "Face for lists of keybinding in Apropos output."
:group 'apropos
- :type 'face)
+ :version "24.3")
-(defcustom apropos-keybinding-face 'underline
- "Face for lists of keybinding in Apropos output, or nil for none."
+(defface apropos-property
+ '((t (:inherit font-lock-builtin-face)))
+ "Face for property name in apropos output, or nil for none."
:group 'apropos
- :type 'face)
+ :version "24.3")
-(defcustom apropos-label-face '(italic)
- "Face for label (`Command', `Variable' ...) in Apropos output.
-A value of nil means don't use any special font for them, and also
-turns off mouse highlighting."
+(defface apropos-function-button
+ '((t (:inherit (font-lock-function-name-face button))))
+ "Button face indicating a function, macro, or command in Apropos."
:group 'apropos
- :type 'face)
+ :version "24.3")
-(defcustom apropos-property-face 'bold-italic
- "Face for property name in apropos output, or nil for none."
+(defface apropos-variable-button
+ '((t (:inherit (font-lock-variable-name-face button))))
+ "Button face indicating a variable in Apropos."
:group 'apropos
- :type 'face)
+ :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.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
- :type 'face)
+ :version "24.3")
(defcustom apropos-sort-by-scores nil
"Non-nil means sort matches by scores; best match is shown first.
;;; Button types used by apropos
(define-button-type 'apropos-symbol
- 'face apropos-symbol-face
+ 'face 'apropos-symbol
'help-echo "mouse-2, RET: Display more help on this symbol"
'follow-link t
'action #'apropos-symbol-button-display-help)
(define-button-type 'apropos-function
'apropos-label "Function"
'apropos-short-label "f"
- 'face '(font-lock-function-name-face button)
+ 'face 'apropos-function-button
'help-echo "mouse-2, RET: Display more help on this function"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-macro
'apropos-label "Macro"
'apropos-short-label "m"
- 'face '(font-lock-function-name-face button)
+ 'face 'apropos-function-button
'help-echo "mouse-2, RET: Display more help on this macro"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-command
'apropos-label "Command"
'apropos-short-label "c"
- 'face '(font-lock-function-name-face button)
+ 'face 'apropos-function-button
'help-echo "mouse-2, RET: Display more help on this command"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-variable
'apropos-label "Variable"
'apropos-short-label "v"
- 'face '(font-lock-variable-name-face button)
+ 'face 'apropos-variable-button
'help-echo "mouse-2, RET: Display more help on this variable"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-group
'apropos-label "Group"
'apropos-short-label "g"
- 'face '(font-lock-builtin-face button)
+ 'face 'apropos-misc-button
'help-echo "mouse-2, RET: Display more help on this group"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-widget
'apropos-label "Widget"
'apropos-short-label "w"
- 'face '(font-lock-builtin-face button)
+ 'face 'apropos-misc-button
'help-echo "mouse-2, RET: Display more help on this widget"
'follow-link t
'action (lambda (button)
(define-button-type 'apropos-plist
'apropos-label "Properties"
'apropos-short-label "p"
- 'face '(font-lock-keyword-face button)
+ 'face 'apropos-misc-button
'help-echo "mouse-2, RET: Display more help on this plist"
'follow-link t
'action (lambda (button)
SUBJECT is a string that is included in the prompt to identify what
kind of objects to search."
(let ((pattern
- (read-string (concat "Apropos " subject " (word list or regexp): "))))
+ (read-string (concat "Search for " subject " (word list or regexp): "))))
(if (string-equal (regexp-quote pattern) pattern)
;; Split into words
- (split-string pattern "[ \t]+")
+ (split-string pattern "[ \t]+" t)
pattern)))
(defun apropos-parse-pattern (pattern)
#'(lambda (symbol)
(and (boundp symbol)
(get symbol 'variable-documentation)))
- 'user-variable-p)))
+ 'custom-variable-p)))
;; For auld lang syne:
;;;###autoload
(let ((name (copy-sequence (symbol-name sym))))
(make-text-button name nil
'type 'apropos-library
- 'face apropos-symbol-face
+ 'face 'apropos-symbol
'apropos-symbol name)
name)))
(setq lh (cdr lh)))))
(unless lh-entry (error "Unknown library `%s'" file)))
(dolist (x (cdr lh-entry))
- (case (car-safe x)
+ (pcase (car-safe x)
;; (autoload (push (cdr x) autoloads))
- (require (push (cdr x) requires))
- (provide (push (cdr x) provides))
- (t (push (or (cdr-safe x) x) symbols))))
+ (`require (push (cdr x) requires))
+ (`provide (push (cdr x) provides))
+ (_ (push (or (cdr-safe x) x) symbols))))
(let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
(apropos-symbols-internal
symbols apropos-do-all
(while pl
(setq p (format "%s %S" (car pl) (nth 1 pl)))
(if (or (not compare) (string-match apropos-regexp p))
- (if apropos-property-face
- (put-text-property 0 (length (symbol-name (car pl)))
- 'face apropos-property-face p))
+ (put-text-property 0 (length (symbol-name (car pl)))
+ 'face 'apropos-property p)
(setq p nil))
(if p
(progn
(setq function (if (byte-code-function-p function)
(if (> (length function) 4)
(aref function 4))
- (if (eq (car-safe function) 'autoload)
+ (if (autoloadp function)
(nth 2 function)
(if (eq (car-safe function) 'lambda)
(if (stringp (nth 2 function))
(insert-text-button (symbol-name symbol)
'type 'apropos-symbol
'skip apropos-multi-type
- ;; Can't use default, since user may have
- ;; changed the variable!
- ;; Just say `no' to variables containing faces!
- 'face apropos-symbol-face)
+ 'face 'apropos-symbol)
(if (and (eq apropos-sort-by-scores 'verbose)
(cadr apropos-item))
(insert " (" (number-to-string (cadr apropos-item)) ") "))
(setq key (condition-case ()
(key-description key)
(error)))
- (if apropos-keybinding-face
- (put-text-property 0 (length key)
- 'face apropos-keybinding-face
- key))
+ (put-text-property 0 (length key)
+ 'face 'apropos-keybinding
+ key)
key)
item ", "))
(insert "M-x ... RET")
- (when apropos-keybinding-face
- (put-text-property (- (point) 11) (- (point) 8)
- 'face apropos-keybinding-face)
- (put-text-property (- (point) 3) (point)
- 'face apropos-keybinding-face))))
+ (put-text-property (- (point) 11) (- (point) 8)
+ 'face 'apropos-keybinding)
+ (put-text-property (- (point) 3) (point)
+ 'face 'apropos-keybinding)))
(terpri))
(apropos-print-doc 2
(if (commandp symbol)
(consp (setq symbol
(symbol-function symbol)))
(or (eq (car symbol) 'macro)
- (if (eq (car symbol) 'autoload)
+ (if (autoloadp symbol)
(memq (nth 4 symbol)
'(macro t))))))
(format "<%s>" (button-type-get type 'apropos-short-label))
(button-type-get type 'apropos-label))
'type type
- ;; Can't use the default button face, since user may have changed the
- ;; variable! Just say `no' to variables containing faces!
- 'face (append button-face apropos-label-face)
'apropos-symbol (car apropos-item))
(insert (if apropos-compact-layout " " ": ")))
(princ "Symbol ")
(prin1 symbol)
(princ "'s plist is\n (")
- (if apropos-symbol-face
- (put-text-property (+ (point-min) 7) (- (point) 14)
- 'face apropos-symbol-face))
+ (put-text-property (+ (point-min) 7) (- (point) 14)
+ 'face 'apropos-symbol)
(insert (apropos-format-plist symbol "\n "))
(princ ")")))
(defun archive-unixdate (low high)
"Stringify Unix (LOW HIGH) date."
- (let ((str (current-time-string (cons high low))))
+ (let* ((time (cons high low))
+ (str (current-time-string time)))
(format "%s-%s-%s"
(substring str 8 10)
(substring str 4 7)
- (substring str 20 24))))
+ (format-time-string "%Y" time))))
(defun archive-unixtime (low high)
"Stringify Unix (LOW HIGH) time."
;; setq auto-insert-directory to an appropriate slash-terminated value
;;
;; You can also customize the variable `auto-insert-mode' to load the
-;; package. Alternatively, add the following to your .emacs file:
+;; package. Alternatively, add the following to your init file:
;; (auto-insert-mode 1)
;;
;; Author: Charlie Martin
(("\\.[1-9]\\'" . "Man page skeleton")
"Short description: "
- ".\\\" Copyright (C), " (substring (current-time-string) -4) " "
+ ".\\\" Copyright (C), " (format-time-string "%Y") " "
(getenv "ORGANIZATION") | (progn user-full-name)
"
.\\\" You may distribute this file under the terms of the GNU Free
.\\\" Documentation License.
-.TH " (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
+.TH " (file-name-base)
" " (file-name-extension (buffer-file-name))
" " (format-time-string "%Y-%m-%d ")
"\n.SH NAME\n"
- (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
+ (file-name-base)
" \\- " str
"\n.SH SYNOPSIS
-.B " (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
+.B " (file-name-base)
"\n"
_
"
"Short description: "
";;; " (file-name-nondirectory (buffer-file-name)) " --- " str "
-;; Copyright (C) " (substring (current-time-string) -4) " "
+;; Copyright (C) " (format-time-string "%Y") " "
(getenv "ORGANIZATION") | (progn user-full-name) "
;; Author: " (user-full-name)
\(provide '"
- (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
+ (file-name-base)
")
\;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n")
(("\\.texi\\(nfo\\)?\\'" . "Texinfo file skeleton")
"\\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename "
- (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name))) ".info\n"
+ (file-name-base) ".info\n"
"@settitle " str "
@c %**end of header
@copying\n"
(setq short-description (read-string "Short description: "))
".\n\n"
- "Copyright @copyright{} " (substring (current-time-string) -4) " "
+ "Copyright @copyright{} " (format-time-string "%Y") " "
(getenv "ORGANIZATION") | (progn user-full-name) "
@quotation
(require 'timer)
-(eval-when-compile (require 'cl))
-
-
;; Custom Group:
;;
;; The two modes will be placed next to Auto Save Mode under the
(defgroup auto-revert nil
"Revert individual buffers when files on disk change.
-
-Auto-Revert Mode can be activated for individual buffer.
-Global Auto-Revert Mode applies to all buffers."
+Auto-Revert mode enables auto-revert in individual buffers.
+Global Auto-Revert mode does so in all buffers."
:group 'files
:group 'convenience)
;;; Code:
-(provide 'avoid)
+(eval-when-compile (require 'cl-lib))
(defgroup avoid nil
"Make mouse pointer stay out of the way of editing."
See function `mouse-avoidance-mode' for possible values.
Setting this variable directly does not take effect;
use either \\[customize] or the function `mouse-avoidance-mode'."
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
;; 'none below prevents toggling when value is nil.
(mouse-avoidance-mode (or value 'none)))
:initialize 'custom-initialize-default
:type 'integer
:group 'avoid)
+(defcustom mouse-avoidance-banish-position '((frame-or-window . frame)
+ (side . right)
+ (side-pos . 3)
+ (top-or-bottom . top)
+ (top-or-bottom-pos . 0))
+ "Position to which Mouse Avoidance mode `banish' moves the mouse.
+An alist where keywords mean:
+FRAME-OR-WINDOW: banish the mouse to corner of frame or window.
+SIDE: banish the mouse on right or left corner of frame or window.
+SIDE-POS: Distance from right or left edge of frame or window.
+TOP-OR-BOTTOM: banish the mouse to top or bottom of frame or window.
+TOP-OR-BOTTOM-POS: Distance from top or bottom edge of frame or window."
+ :group 'avoid
+ :type '(alist :key-type symbol :value-type symbol)
+ :options '(frame-or-window side (side-pos integer)
+ top-or-bottom (top-or-bottom-pos integer)))
+
;; Internal variables
(defvar mouse-avoidance-state nil)
(defvar mouse-avoidance-pointer-shapes nil)
(defun mouse-avoidance-banish-destination ()
"The position to which Mouse Avoidance mode `banish' moves the mouse.
-You can redefine this if you want the mouse banished to a different corner."
- (let* ((pos (window-edges)))
- (cons (- (nth 2 pos) 2)
- (nth 1 pos))))
+
+If you want the mouse banished to a different corner set
+`mouse-avoidance-banish-position' as you need."
+ (let* ((fra-or-win (assoc-default
+ 'frame-or-window
+ mouse-avoidance-banish-position 'eq))
+ (list-values (pcase fra-or-win
+ (`frame (list 0 0 (frame-width) (frame-height)))
+ (`window (window-edges))))
+ (alist (cl-loop for v in list-values
+ for k in '(left top right bottom)
+ collect (cons k v)))
+ (side (assoc-default
+ 'side
+ mouse-avoidance-banish-position #'eq))
+ (side-dist (assoc-default
+ 'side-pos
+ mouse-avoidance-banish-position #'eq))
+ (top-or-bottom (assoc-default
+ 'top-or-bottom
+ mouse-avoidance-banish-position #'eq))
+ (top-or-bottom-dist (assoc-default
+ 'top-or-bottom-pos
+ mouse-avoidance-banish-position #'eq))
+ (side-fn (pcase side
+ (`left '+)
+ (`right '-)))
+ (top-or-bottom-fn (pcase top-or-bottom
+ (`top '+)
+ (`bottom '-))))
+ (cons (funcall side-fn ; -/+
+ (assoc-default side alist 'eq) ; right or left
+ side-dist) ; distance from side
+ (funcall top-or-bottom-fn ; -/+
+ (assoc-default top-or-bottom alist 'eq) ; top/bottom
+ top-or-bottom-dist)))) ; distance from top/bottom
(defun mouse-avoidance-banish-mouse ()
- ;; Put the mouse pointer in the upper-right corner of the current frame.
+ "Put the mouse pointer to `mouse-avoidance-banish-position'."
(mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination)))
(defsubst mouse-avoidance-delta (cur delta dist var min max)
;; For these modes, state keeps track of the total offset that we've
;; accumulated, and tries to keep it close to zero.
(let* ((cur (mouse-position))
- (cur-frame (car cur))
(cur-pos (cdr cur))
(pos (window-edges))
(wleft (pop pos))
(if mouse-avoidance-mode
(mouse-avoidance-mode mouse-avoidance-mode))
+(provide 'avoid)
+
;;; avoid.el ends here
;;; Code:
(require 'timer)
-(eval-when-compile (require 'cl))
-
+(eval-when-compile (require 'cl-lib))
\f
(defgroup battery nil
"Display battery status information."
:prefix "battery-"
:group 'hardware)
+;; Either BATn or yeeloong-bat, basically.
+(defconst battery--linux-sysfs-regexp "[bB][aA][tT][0-9]?$")
+
(defcustom battery-status-function
(cond ((and (eq system-type 'gnu/linux)
(file-readable-p "/proc/apm"))
'battery-linux-proc-acpi)
((and (eq system-type 'gnu/linux)
(file-directory-p "/sys/class/power_supply/")
- (directory-files "/sys/class/power_supply/" nil "BAT[0-9]$"))
+ (directory-files "/sys/class/power_supply/" nil
+ battery--linux-sysfs-regexp))
'battery-linux-sysfs)
- ((and (eq system-type 'gnu/linux)
- (file-directory-p "/sys/class/power_supply/yeeloong-bat/")
- (directory-files "/sys/class/power_supply/yeeloong-bat/" nil "charge_"))
- 'battery-yeeloong-sysfs)
((and (eq system-type 'darwin)
(condition-case nil
(with-temp-buffer
"Power %L, battery %B (%p%% load, remaining time %t)")
((eq battery-status-function 'battery-pmset)
"%L power, battery %B (%p%% load, remaining time %t)")
- ((eq battery-status-function 'battery-yeeloong-sysfs)
- "%L power, battery %B (%p%% load, remaining time %t)")
(battery-status-function
"Power %L, battery %B (%p%% load, remaining time %t)"))
"Control string formatting the string to display in the echo area.
(setq charging-state (match-string 1)))
(when (re-search-forward "present rate: +\\([0-9]+\\) \\(m[AW]\\)$"
nil t)
- (setq rate (+ (or rate 0) (string-to-number (match-string 1)))
- rate-type (or (and rate-type
+ (setq rate (+ (or rate 0) (string-to-number (match-string 1))))
+ (when (> rate 0)
+ (setq rate-type (or (and rate-type
(if (string= rate-type (match-string 2))
rate-type
(error
"Inconsistent rate types (%s vs. %s)"
rate-type (match-string 2))))
- (match-string 2))))
+ (match-string 2)))))
(when (re-search-forward "remaining capacity: +\\([0-9]+\\) m[AW]h$"
nil t)
(setq capacity
(when (re-search-forward "present: +yes$" nil t)
(when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$"
nil t)
- (incf design-capacity (string-to-number (match-string 1))))
+ (cl-incf design-capacity (string-to-number (match-string 1))))
(when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$"
nil t)
- (incf last-full-capacity (string-to-number (match-string 1))))
+ (cl-incf last-full-capacity (string-to-number (match-string 1))))
(when (re-search-forward
"design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t)
- (incf warn (string-to-number (match-string 1))))
+ (cl-incf warn (string-to-number (match-string 1))))
(when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$"
nil t)
- (incf low (string-to-number (match-string 1)))))))
+ (cl-incf low (string-to-number (match-string 1)))))))
(setq full-capacity (if (> last-full-capacity 0)
last-full-capacity design-capacity))
(and capacity rate
(with-temp-buffer
(dolist (dir (ignore-errors
(directory-files
- "/sys/class/power_supply/" t "BAT[0-9]$")))
+ "/sys/class/power_supply/" t
+ battery--linux-sysfs-regexp)))
(erase-buffer)
(ignore-errors (insert-file-contents
(expand-file-name "uevent" dir)))
"AC"
"BAT")
"N/A")))))
-
-(defun battery-yeeloong-sysfs ()
- "Get ACPI status information from Linux (the kernel).
-This function works only on the Lemote Yeeloong.
-
-The following %-sequences are provided:
-%c Current capacity (mAh)
-%r Current rate
-%B Battery status (verbose)
-%b Battery status, empty means high, `-' means low,
- `!' means critical, and `+' means charging
-%L AC line status (verbose)
-%p Battery load percentage
-%m Remaining time (to charge or discharge) in minutes
-%h Remaining time (to charge or discharge) in hours
-%t Remaining time (to charge or discharge) in the form `h:min'"
-
- (let (capacity
- capacity-level
- status
- ac-online
- hours
- current-now
- charge-full
- charge-now)
-
- (with-temp-buffer
- (ignore-errors
- (insert-file-contents "/sys/class/power_supply/yeeloong-bat/uevent")
- (goto-char 1)
- (search-forward "POWER_SUPPLY_CHARGE_NOW=")
- (setq charge-now (read (current-buffer)))
- (goto-char 1)
- (search-forward "POWER_SUPPLY_CHARGE_FULL=")
- (setq charge-full (read (current-buffer)))
- (goto-char 1)
- (search-forward "POWER_SUPPLY_CURRENT_NOW=")
- (setq current-now (read (current-buffer)))
- (goto-char 1)
- (search-forward "POWER_SUPPLY_CAPACITY_LEVEL=")
- (setq capacity-level (buffer-substring (point) (line-end-position)))
- (goto-char 1)
- (search-forward "POWER_SUPPLY_STATUS=")
- (setq status (buffer-substring (point) (line-end-position))))
-
- (erase-buffer)
- (ignore-errors
- (insert-file-contents
- "/sys/class/power_supply/yeeloong-ac/online")
- (goto-char 1)
- (setq ac-online (read (current-buffer)))
- (erase-buffer)))
-
-
- (setq capacity (round (/ (* charge-now 100.0) charge-full)))
- (when (and current-now (not (= current-now 0)))
- (if (< current-now 0)
- ;; Charging
- (setq hours (/ (- charge-now charge-full) (+ 0.0 current-now)))
- ;; Discharging
- (setq hours (/ charge-now (+ 0.0 current-now)))))
-
- (list (cons ?c (if charge-now
- (number-to-string charge-now)
- "N/A"))
- (cons ?r current-now)
- (cons ?B (cond ((equal capacity-level "Full") "full")
- ((equal status "Charging") "charging")
- ((equal capacity-level "Low") "low")
- ((equal capacity-level "Critical") "critical")
- (t "high")))
- (cons ?b (cond ((equal capacity-level "Full") " ")
- ((equal status "Charging") "+")
- ((equal capacity-level "Low") "-")
- ((equal capacity-level "Critical") "!")
- (t " ")))
- (cons ?h (if hours (number-to-string hours) "N/A"))
- (cons ?m (if hours (number-to-string (* 60 hours)) "N/A"))
- (cons ?t (if hours
- (format "%d:%d"
- (/ (round (* 60 hours)) 60)
- (% (round (* 60 hours)) 60))
- "N/A"))
- (cons ?p (if capacity (number-to-string capacity) "N/A"))
- (cons ?L (if (eq ac-online 1) "AC" "BAT")))))
\f
;;; `pmset' interface for Darwin (OS X).
(interactive "e")
(save-selected-window
(select-window (posn-window (event-start event)))
- (toggle-read-only)
- (force-mode-line-update)))
-
+ (read-only-mode 'toggle)))
(defun mode-line-toggle-modified (event)
"Toggle the buffer-modified flag from the mode-line."
(set-buffer-modified-p (not (buffer-modified-p)))
(force-mode-line-update)))
-
(defun mode-line-widen (event)
"Widen a buffer from the mode-line."
(interactive "e")
(widen)
(force-mode-line-update)))
-
(defvar mode-line-input-method-map
(let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-2]
(describe-current-input-method))))
(purecopy map)))
-
(defvar mode-line-coding-system-map
(let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-1]
(when (and enable-multibyte-characters
buffer-file-coding-system)
(describe-coding-system buffer-file-coding-system)))))
+ (define-key map [mode-line mouse-3]
+ (lambda (e)
+ (interactive "e")
+ (save-selected-window
+ (select-window (posn-window (event-start e)))
+ (call-interactively 'set-buffer-file-coding-system))))
(purecopy map))
"Local keymap for the coding-system part of the mode line.")
-
(defun mode-line-change-eol (event)
"Cycle through the various possible kinds of end-of-line styles."
(interactive "e")
(setq desc
(propertize
mnemonic
- 'help-echo (format "End-of-line style: %s\nmouse-1 to cycle"
+ 'help-echo (format "End-of-line style: %s\nmouse-1: Cycle"
(if (eq eol 0) "Unix-style LF"
(if (eq eol 1) "DOS-style CRLF"
(if (eq eol 2) "Mac-style CR"
(push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache)
desc)))
-(defvar mode-line-client
- `(""
- (:propertize ("" (:eval (if (frame-parameter nil 'client) "@" "")))
- help-echo ,(purecopy "emacsclient frame")))
- "Mode-line control for identifying emacsclient frames.")
-;;;###autoload
-(put 'mode-line-client 'risky-local-variable t)
+\f
+;;; Mode line contents
+
+(defcustom mode-line-default-help-echo
+ "mouse-1: Select (drag to resize)\n\
+mouse-2: Make current window occupy the whole frame\n\
+mouse-3: Remove current window from display"
+ "Default help text for the mode line.
+If the value is a string, it specifies the tooltip or echo area
+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.3"
+ :group 'mode-line)
+
+(defvar mode-line-front-space '(:eval (if (display-graphic-p) " " "-"))
+ "Mode line construct to put at the front of the mode line.
+By default, this construct is displayed right at the beginning of
+the mode line, except that if there is a memory-full message, it
+is displayed first.")
+(put 'mode-line-front-space 'risky-local-variable t)
+
+(defun mode-line-mule-info-help-echo (window _object _point)
+ "Return help text specifying WINDOW's buffer coding system."
+ (with-current-buffer (window-buffer window)
+ (if buffer-file-coding-system
+ (format "Buffer coding system (%s): %s
+mouse-1: Describe coding system
+mouse-3: Set coding system"
+ (if enable-multibyte-characters "multi-byte" "unibyte")
+ (symbol-name buffer-file-coding-system))
+ "Buffer coding system: none specified")))
(defvar mode-line-mule-info
`(""
mouse-face mode-line-highlight))
,(propertize
"%z"
- 'help-echo
- (lambda (window _object _point)
- (with-current-buffer (window-buffer window)
- ;; Don't show this tip if the coding system is nil,
- ;; it reads like a bug, and is not useful anyway.
- (when buffer-file-coding-system
- (format "Buffer coding system %s\nmouse-1: describe coding system"
- (if enable-multibyte-characters
- (concat "(multi-byte): "
- (symbol-name buffer-file-coding-system))
- (concat "(unibyte): "
- (symbol-name buffer-file-coding-system)))))))
+ 'help-echo 'mode-line-mule-info-help-echo
'mouse-face 'mode-line-highlight
'local-map mode-line-coding-system-map)
(:eval (mode-line-eol-desc)))
- "Mode-line control for displaying information of multilingual environment.
+ "Mode line construct to report the multilingual environment.
Normally it displays current input method (if any activated) and
mnemonics of the following coding systems:
coding system for saving or writing the current buffer
- coding system for keyboard input (if Emacs is running on terminal)
- coding system for terminal output (if Emacs is running on terminal)"
- ;; Currently not:
- ;; coding system for decoding output of buffer process (if any)
- ;; coding system for encoding text to send to buffer process (if any)."
-)
-
+ coding system for keyboard input (on a text terminal)
+ coding system for terminal output (on a text terminal)")
;;;###autoload
(put 'mode-line-mule-info 'risky-local-variable t)
(make-variable-buffer-local 'mode-line-mule-info)
-;; MSDOS frames have window-system, but want the Fn identification.
-(defun mode-line-frame-control ()
- "Compute mode-line control for frame identification.
-Value is used for `mode-line-frame-identification', which see."
- (if (or (null window-system)
- (eq window-system 'pc))
- "-%F "
- " "))
-
-;; We need to defer the call to mode-line-frame-control to the time
-;; the mode line is actually displayed.
-(defvar mode-line-frame-identification '(:eval (mode-line-frame-control))
- "Mode-line control to describe the current frame.")
+(defvar mode-line-client
+ `(""
+ (:propertize ("" (:eval (if (frame-parameter nil 'client) "@" "")))
+ help-echo ,(purecopy "emacsclient frame")))
+ "Mode line construct for identifying emacsclient frames.")
;;;###autoload
-(put 'mode-line-frame-identification 'risky-local-variable t)
+(put 'mode-line-client 'risky-local-variable t)
-(defvar mode-line-process nil "\
-Mode-line control for displaying info on process status.
-Normally nil in most modes, since there is no process to display.")
+(defun mode-line-read-only-help-echo (window _object _point)
+ "Return help text specifying WINDOW's buffer read-only status."
+ (format "Buffer is %s\nmouse-1: Toggle"
+ (if (buffer-local-value 'buffer-read-only (window-buffer window))
+ "read-only"
+ "writable")))
-;;;###autoload
-(put 'mode-line-process 'risky-local-variable t)
-(make-variable-buffer-local 'mode-line-process)
+(defun mode-line-modified-help-echo (window _object _point)
+ "Return help text specifying WINDOW's buffer modification status."
+ (format "Buffer is %smodified\nmouse-1: Toggle modification state"
+ (if (buffer-modified-p (window-buffer window)) "" "not ")))
(defvar mode-line-modified
(list (propertize
"%1*"
- 'help-echo (purecopy (lambda (window _object _point)
- (format "Buffer is %s\nmouse-1 toggles"
- (save-selected-window
- (select-window window)
- (if buffer-read-only
- "read-only"
- "writable")))))
+ 'help-echo 'mode-line-read-only-help-echo
'local-map (purecopy (make-mode-line-mouse-map
'mouse-1
#'mode-line-toggle-read-only))
'mouse-face 'mode-line-highlight)
(propertize
"%1+"
- 'help-echo (purecopy (lambda (window _object _point)
- (format "Buffer is %sodified\nmouse-1 toggles modified state"
- (save-selected-window
- (select-window window)
- (if (buffer-modified-p)
- "m"
- "not m")))))
+ 'help-echo 'mode-line-modified-help-echo
'local-map (purecopy (make-mode-line-mouse-map
'mouse-1 #'mode-line-toggle-modified))
'mouse-face 'mode-line-highlight))
- "Mode-line control for displaying whether current buffer is modified.")
-
+ "Mode line construct for displaying whether current buffer is modified.")
;;;###autoload
(put 'mode-line-modified 'risky-local-variable t)
(make-variable-buffer-local 'mode-line-modified)
"Current directory is remote: "
"Current directory is local: ")
default-directory)))))))
- "Mode-line flag to show if default-directory for current buffer is remote.")
+ "Mode line construct to indicate a remote buffer.")
;;;###autoload
(put 'mode-line-remote 'risky-local-variable t)
-
(make-variable-buffer-local 'mode-line-remote)
-;; Actual initialization is below.
-(defvar mode-line-position nil
- "Mode-line control for displaying the position in the buffer.
-Normally displays the buffer percentage and, optionally, the
-buffer size, the line number and the column number.")
+;; MSDOS frames have window-system, but want the Fn identification.
+(defun mode-line-frame-control ()
+ "Compute mode line construct for frame identification.
+Value is used for `mode-line-frame-identification', which see."
+ (if (or (null window-system)
+ (eq window-system 'pc))
+ "-%F "
+ " "))
+
+;; We need to defer the call to mode-line-frame-control to the time
+;; the mode line is actually displayed.
+(defvar mode-line-frame-identification '(:eval (mode-line-frame-control))
+ "Mode line construct to describe the current frame.")
;;;###autoload
-(put 'mode-line-position 'risky-local-variable t)
+(put 'mode-line-frame-identification 'risky-local-variable t)
-(defvar mode-line-modes nil
- "Mode-line control for displaying major and minor modes.")
+(defvar mode-line-process nil
+ "Mode line construct for displaying info on process status.
+Normally nil in most modes, since there is no process to display.")
;;;###autoload
-(put 'mode-line-modes 'risky-local-variable t)
+(put 'mode-line-process 'risky-local-variable t)
+(make-variable-buffer-local 'mode-line-process)
+
+(defun bindings--define-key (map key item)
+ "Make as much as possible of the menus pure."
+ (declare (indent 2))
+ (define-key map key
+ (cond
+ ((not (consp item)) item) ;Not sure that could be other than a symbol.
+ ;; Keymaps can't be made pure otherwise users can't remove/add elements
+ ;; from/to them any more.
+ ((keymapp item) item)
+ ((stringp (car item))
+ (if (keymapp (cdr item))
+ (cons (purecopy (car item)) (cdr item))
+ (purecopy item)))
+ ((eq 'menu-item (car item))
+ (if (keymapp (nth 2 item))
+ `(menu-item ,(purecopy (nth 1 item)) ,(nth 2 item)
+ ,@(purecopy (nthcdr 3 item)))
+ (purecopy item)))
+ (t (message "non-menu-item: %S" item) item))))
(defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\
Menu of mode operations in the mode line.")
(defvar mode-line-major-mode-keymap
(let ((map (make-sparse-keymap)))
- (define-key map [mode-line down-mouse-1]
- `(menu-item ,(purecopy "Menu Bar") ignore
- :filter (lambda (_) (mouse-menu-major-mode-map))))
+ (bindings--define-key map [mode-line down-mouse-1]
+ `(menu-item "Menu Bar" ignore
+ :filter ,(lambda (_) (mouse-menu-major-mode-map))))
(define-key map [mode-line mouse-2] 'describe-mode)
(define-key map [mode-line down-mouse-3] mode-line-mode-menu)
map) "\
map) "\
Keymap to display on minor modes.")
+(defvar mode-line-modes
+ (let ((recursive-edit-help-echo "Recursive edit, type C-M-c to get out"))
+ (list (propertize "%[" 'help-echo recursive-edit-help-echo)
+ "("
+ `(:propertize ("" mode-name)
+ help-echo "Major mode\n\
+mouse-1: Display major mode menu\n\
+mouse-2: Show help for major mode\n\
+mouse-3: Toggle minor modes"
+ mouse-face mode-line-highlight
+ local-map ,mode-line-major-mode-keymap)
+ '("" mode-line-process)
+ `(:propertize ("" minor-mode-alist)
+ mouse-face mode-line-highlight
+ help-echo "Minor mode\n\
+mouse-1: Display minor mode menu\n\
+mouse-2: Show help for minor mode\n\
+mouse-3: Toggle minor modes"
+ local-map ,mode-line-minor-mode-keymap)
+ (propertize "%n" 'help-echo "mouse-2: Remove narrowing from buffer"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (make-mode-line-mouse-map
+ 'mouse-2 #'mode-line-widen))
+ ")"
+ (propertize "%]" 'help-echo recursive-edit-help-echo)
+ " "))
+ "Mode line construct for displaying major and minor modes.")
+(put 'mode-line-modes 'risky-local-variable t)
+
(defvar mode-line-column-line-number-mode-map
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap "Toggle Line and Column Number Display")))
- (define-key menu-map [line-number-mode]
- `(menu-item ,(purecopy "Display Line Numbers") line-number-mode
- :help ,(purecopy "Toggle displaying line numbers in the mode-line")
+ (bindings--define-key menu-map [line-number-mode]
+ '(menu-item "Display Line Numbers" line-number-mode
+ :help "Toggle displaying line numbers in the mode-line"
:button (:toggle . line-number-mode)))
- (define-key menu-map [column-number-mode]
- `(menu-item ,(purecopy "Display Column Numbers") column-number-mode
- :help ,(purecopy "Toggle displaying column numbers in the mode-line")
+ (bindings--define-key menu-map [column-number-mode]
+ '(menu-item "Display Column Numbers" column-number-mode
+ :help "Toggle displaying column numbers in the mode-line"
:button (:toggle . column-number-mode)))
(define-key map [mode-line down-mouse-1] menu-map)
map) "\
Keymap to display on column and line numbers.")
-(let* ((help-echo
- ;; The multi-line message doesn't work terribly well on the
- ;; bottom mode line... Better ideas?
- ;; "\
- ;; mouse-1: select window, mouse-2: delete others, mouse-3: delete,
- ;; drag-mouse-1: resize, C-mouse-2: split horizontally"
- "mouse-1: Select (drag to resize)\n\
-mouse-2: Make current window occupy the whole frame\n\
-mouse-3: Remove current window from display")
- (recursive-edit-help-echo "Recursive edit, type C-M-c to get out")
- (spaces (propertize " " 'help-echo help-echo))
- (standard-mode-line-format
- (list
- "%e"
- `(:eval (if (display-graphic-p)
- ,(propertize " " 'help-echo help-echo)
- ,(propertize "-" 'help-echo help-echo)))
- 'mode-line-mule-info
- 'mode-line-client
- 'mode-line-modified
- 'mode-line-remote
- 'mode-line-frame-identification
- 'mode-line-buffer-identification
- (propertize " " 'help-echo help-echo)
- 'mode-line-position
- '(vc-mode vc-mode)
- (propertize " " 'help-echo help-echo)
- 'mode-line-modes
- `(which-func-mode ("" which-func-format ,spaces))
- `(global-mode-string ("" global-mode-string ,spaces))
- `(:eval (unless (display-graphic-p)
- ,(propertize "-%-" 'help-echo help-echo)))))
- (standard-mode-line-modes
- (list
- (propertize "%[" 'help-echo recursive-edit-help-echo)
- (propertize "(" 'help-echo help-echo)
- `(:propertize ("" mode-name)
- help-echo "Major mode\n\
-mouse-1: Display major mode menu\n\
-mouse-2: Show help for major mode\n\
-mouse-3: Toggle minor modes"
- mouse-face mode-line-highlight
- local-map ,mode-line-major-mode-keymap)
- '("" mode-line-process)
- `(:propertize ("" minor-mode-alist)
- mouse-face mode-line-highlight
- help-echo "Minor mode\n\
-mouse-1: Display minor mode menu\n\
-mouse-2: Show help for minor mode\n\
-mouse-3: Toggle minor modes"
- local-map ,mode-line-minor-mode-keymap)
- (propertize "%n" 'help-echo "mouse-2: Remove narrowing from the current buffer"
- 'mouse-face 'mode-line-highlight
- 'local-map (make-mode-line-mouse-map
- 'mouse-2 #'mode-line-widen))
- (propertize ")" 'help-echo help-echo)
- (propertize "%]" 'help-echo recursive-edit-help-echo)
- spaces))
-
- (standard-mode-line-position
- `((-3 ,(propertize
- "%p"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- ;; XXX needs better description
- 'help-echo "Size indication mode\n\
+(defvar mode-line-position
+ `((-3 ,(propertize
+ "%p"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ ;; XXX needs better description
+ 'help-echo "Size indication mode\n\
mouse-1: Display Line and Column Mode Menu"))
- (size-indication-mode
- (8 ,(propertize
- " of %I"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- ;; XXX needs better description
- 'help-echo "Size indication mode\n\
+ (size-indication-mode
+ (8 ,(propertize
+ " of %I"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ ;; XXX needs better description
+ 'help-echo "Size indication mode\n\
mouse-1: Display Line and Column Mode Menu")))
- (line-number-mode
- ((column-number-mode
- (10 ,(propertize
- " (%l,%c)"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line number and Column number\n\
+ (line-number-mode
+ ((column-number-mode
+ (10 ,(propertize
+ " (%l,%c)"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Line number and Column number\n\
mouse-1: Display Line and Column Mode Menu"))
- (6 ,(propertize
- " L%l"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line Number\n\
+ (6 ,(propertize
+ " L%l"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Line Number\n\
mouse-1: Display Line and Column Mode Menu"))))
- ((column-number-mode
- (5 ,(propertize
- " C%c"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Column number\n\
-mouse-1: Display Line and Column Mode Menu"))))))))
-
- (setq-default mode-line-format standard-mode-line-format)
- (put 'mode-line-format 'standard-value
- (list `(quote ,standard-mode-line-format)))
-
- (setq-default mode-line-modes standard-mode-line-modes)
- (put 'mode-line-modes 'standard-value
- (list `(quote ,standard-mode-line-modes)))
-
- (setq-default mode-line-position standard-mode-line-position)
- (put 'mode-line-position 'standard-value
- (list `(quote ,standard-mode-line-position))))
+ ((column-number-mode
+ (5 ,(propertize
+ " C%c"
+ 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Column number\n\
+mouse-1: Display Line and Column Mode Menu"))))))
+ "Mode line construct for displaying the position in the buffer.
+Normally displays the buffer percentage and, optionally, the
+buffer size, the line number and the column number.")
+(put 'mode-line-position 'risky-local-variable t)
(defvar mode-line-buffer-identification-keymap
;; Add menu of buffer operations to the buffer identification part
(list (propertize fmt
'face 'mode-line-buffer-id
'help-echo
- (purecopy "Buffer name\n\
-mouse-1: previous buffer\n\
-mouse-3: next buffer")
+ (purecopy "Buffer name
+mouse-1: Previous buffer\nmouse-3: Next buffer")
'mouse-face 'mode-line-highlight
'local-map mode-line-buffer-identification-keymap)))
-(defvar mode-line-buffer-identification (propertized-buffer-identification "%12b") "\
-Mode-line control for identifying the buffer being displayed.
+(defvar mode-line-buffer-identification
+ (propertized-buffer-identification "%12b")
+ "Mode line construct for identifying the buffer being displayed.
Its default value is (\"%12b\") with some text properties added.
Major modes that edit things other than ordinary files may change this
\(e.g. Info, Dired,...)")
-
;;;###autoload
(put 'mode-line-buffer-identification 'risky-local-variable t)
(make-variable-buffer-local 'mode-line-buffer-identification)
+(defvar mode-line-misc-info
+ '((which-func-mode ("" which-func-format " "))
+ (global-mode-string ("" global-mode-string " ")))
+ "Mode line construct for miscellaneous information.
+By default, this shows the information specified by
+`which-func-mode' and `global-mode-string'.")
+(put 'mode-line-misc-info 'risky-local-variable t)
+
+(defvar mode-line-end-spaces '(:eval (unless (display-graphic-p) "-%-"))
+ "Mode line construct to put at the end of the mode line.")
+(put 'mode-line-end-spaces 'risky-local-variable t)
+
+;; Default value of the top-level `mode-line-format' variable:
+(let ((standard-mode-line-format
+ (list "%e"
+ 'mode-line-front-space
+ 'mode-line-mule-info
+ 'mode-line-client
+ 'mode-line-modified
+ 'mode-line-remote
+ 'mode-line-frame-identification
+ 'mode-line-buffer-identification
+ " "
+ 'mode-line-position
+ '(vc-mode vc-mode)
+ " "
+ 'mode-line-modes
+ 'mode-line-misc-info
+ 'mode-line-end-spaces)))
+ (setq-default mode-line-format standard-mode-line-format)
+ (put 'mode-line-format 'standard-value
+ (list `(quote ,standard-mode-line-format))))
+
+\f
(defun mode-line-unbury-buffer (event) "\
Call `unbury-buffer' in this window."
(interactive "e")
;; Use mode-line-mode-menu for local minor-modes only.
;; Global ones can go on the menubar (Options --> Show/Hide).
-(define-key mode-line-mode-menu [overwrite-mode]
- `(menu-item ,(purecopy "Overwrite (Ovwrt)") overwrite-mode
- :help ,(purecopy "Overwrite mode: typed characters replace existing text")
+(bindings--define-key mode-line-mode-menu [overwrite-mode]
+ '(menu-item "Overwrite (Ovwrt)" overwrite-mode
+ :help "Overwrite mode: typed characters replace existing text"
:button (:toggle . overwrite-mode)))
-(define-key mode-line-mode-menu [outline-minor-mode]
- `(menu-item ,(purecopy "Outline (Outl)") outline-minor-mode
+(bindings--define-key mode-line-mode-menu [outline-minor-mode]
+ '(menu-item "Outline (Outl)" outline-minor-mode
;; XXX: This needs a good, brief description.
- :help ,(purecopy "")
+ :help ""
:button (:toggle . (bound-and-true-p outline-minor-mode))))
-(define-key mode-line-mode-menu [highlight-changes-mode]
- `(menu-item ,(purecopy "Highlight changes (Chg)") highlight-changes-mode
- :help ,(purecopy "Show changes in the buffer in a distinctive color")
+(bindings--define-key mode-line-mode-menu [highlight-changes-mode]
+ '(menu-item "Highlight changes (Chg)" highlight-changes-mode
+ :help "Show changes in the buffer in a distinctive color"
:button (:toggle . (bound-and-true-p highlight-changes-mode))))
-(define-key mode-line-mode-menu [hide-ifdef-mode]
- `(menu-item ,(purecopy "Hide ifdef (Ifdef)") hide-ifdef-mode
- :help ,(purecopy "Show/Hide code within #ifdef constructs")
+(bindings--define-key mode-line-mode-menu [hide-ifdef-mode]
+ '(menu-item "Hide ifdef (Ifdef)" hide-ifdef-mode
+ :help "Show/Hide code within #ifdef constructs"
:button (:toggle . (bound-and-true-p hide-ifdef-mode))))
-(define-key mode-line-mode-menu [glasses-mode]
- `(menu-item ,(purecopy "Glasses (o^o)") glasses-mode
- :help ,(purecopy "Insert virtual separators to make long identifiers easy to read")
+(bindings--define-key mode-line-mode-menu [glasses-mode]
+ '(menu-item "Glasses (o^o)" glasses-mode
+ :help "Insert virtual separators to make long identifiers easy to read"
:button (:toggle . (bound-and-true-p glasses-mode))))
-(define-key mode-line-mode-menu [font-lock-mode]
- `(menu-item ,(purecopy "Font Lock") font-lock-mode
- :help ,(purecopy "Syntax coloring")
+(bindings--define-key mode-line-mode-menu [font-lock-mode]
+ '(menu-item "Font Lock" font-lock-mode
+ :help "Syntax coloring"
:button (:toggle . font-lock-mode)))
-(define-key mode-line-mode-menu [flyspell-mode]
- `(menu-item ,(purecopy "Flyspell (Fly)") flyspell-mode
- :help ,(purecopy "Spell checking on the fly")
+(bindings--define-key mode-line-mode-menu [flyspell-mode]
+ '(menu-item "Flyspell (Fly)" flyspell-mode
+ :help "Spell checking on the fly"
:button (:toggle . (bound-and-true-p flyspell-mode))))
-(define-key mode-line-mode-menu [auto-revert-tail-mode]
- `(menu-item ,(purecopy "Auto revert tail (Tail)") auto-revert-tail-mode
- :help ,(purecopy "Revert the tail of the buffer when buffer grows")
+(bindings--define-key mode-line-mode-menu [auto-revert-tail-mode]
+ '(menu-item "Auto revert tail (Tail)" auto-revert-tail-mode
+ :help "Revert the tail of the buffer when buffer grows"
:enable (buffer-file-name)
:button (:toggle . (bound-and-true-p auto-revert-tail-mode))))
-(define-key mode-line-mode-menu [auto-revert-mode]
- `(menu-item ,(purecopy "Auto revert (ARev)") auto-revert-mode
- :help ,(purecopy "Revert the buffer when the file on disk changes")
+(bindings--define-key mode-line-mode-menu [auto-revert-mode]
+ '(menu-item "Auto revert (ARev)" auto-revert-mode
+ :help "Revert the buffer when the file on disk changes"
:button (:toggle . (bound-and-true-p auto-revert-mode))))
-(define-key mode-line-mode-menu [auto-fill-mode]
- `(menu-item ,(purecopy "Auto fill (Fill)") auto-fill-mode
- :help ,(purecopy "Automatically insert new lines")
+(bindings--define-key mode-line-mode-menu [auto-fill-mode]
+ '(menu-item "Auto fill (Fill)" auto-fill-mode
+ :help "Automatically insert new lines"
:button (:toggle . auto-fill-function)))
-(define-key mode-line-mode-menu [abbrev-mode]
- `(menu-item ,(purecopy "Abbrev (Abbrev)") abbrev-mode
- :help ,(purecopy "Automatically expand abbreviations")
+(bindings--define-key mode-line-mode-menu [abbrev-mode]
+ '(menu-item "Abbrev (Abbrev)" abbrev-mode
+ :help "Automatically expand abbreviations"
:button (:toggle . abbrev-mode)))
(defun mode-line-minor-mode-help (event)
Each element looks like (VARIABLE STRING);
STRING is included in the mode line if VARIABLE's value is non-nil.
-Actually, STRING need not be a string; any possible mode-line element
-is okay. See `mode-line-format'.")
+Actually, STRING need not be a string; any mode-line construct is
+okay. See `mode-line-format'.")
;;;###autoload
(put 'minor-mode-alist 'risky-local-variable t)
;; Don't use purecopy here--some people want to change these strings.
;; Packages should add to this list appropriately when they are
;; loaded, rather than listing everything here.
(setq debug-ignored-errors
+ ;; FIXME: Maybe beginning-of-line, beginning-of-buffer, end-of-line,
+ ;; end-of-buffer, end-of-file, buffer-read-only, and
+ ;; file-supersession should all be user-errors!
`(beginning-of-line beginning-of-buffer end-of-line
end-of-buffer end-of-file buffer-read-only
file-supersession
- ,(purecopy "^Previous command was not a yank$")
- ,(purecopy "^Minibuffer window is not active$")
- ,(purecopy "^No previous history search regexp$")
- ,(purecopy "^No later matching history item$")
- ,(purecopy "^No earlier matching history item$")
- ,(purecopy "^End of history; no default available$")
- ,(purecopy "^End of defaults; no next item$")
- ,(purecopy "^Beginning of history; no preceding item$")
- ,(purecopy "^No recursive edit is in progress$")
- ,(purecopy "^Changes to be undone are outside visible portion of buffer$")
- ,(purecopy "^No undo information in this buffer$")
- ,(purecopy "^No further undo information")
- ,(purecopy "^Save not confirmed$")
- ,(purecopy "^Recover-file cancelled\\.$")
- ,(purecopy "^Cannot switch buffers in a dedicated window$")
+ user-error ;; That's the main one!
))
-
(make-variable-buffer-local 'indent-tabs-mode)
+;; These per-buffer variables are never reset by
+;; `kill-all-local-variables', because they have no default value.
+;; For consistency, we give them the `permanent-local' property, even
+;; though `kill-all-local-variables' does not actually consult it.
+
+(mapc (lambda (sym) (put sym 'permanent-local t))
+ '(buffer-file-name default-directory buffer-backed-up
+ buffer-saved-size buffer-auto-save-file-name
+ buffer-read-only buffer-undo-list mark-active
+ point-before-scroll buffer-file-truename
+ buffer-file-format buffer-auto-save-file-format
+ buffer-display-count buffer-display-time
+ enable-multibyte-characters))
+
;; We have base64, md5 and sha1 functions built in now.
(provide 'base64)
(provide 'md5)
(define-key ctl-x-map [right] 'next-buffer)
(define-key ctl-x-map [C-right] 'next-buffer)
+(define-key global-map [XF86Forward] 'next-buffer)
(define-key ctl-x-map [left] 'previous-buffer)
(define-key ctl-x-map [C-left] 'previous-buffer)
+(define-key global-map [XF86Back] 'previous-buffer)
(let ((map minibuffer-local-map))
(define-key map "\en" 'next-history-element)
(define-key map [next] 'next-history-element)
(define-key map [down] 'next-history-element)
+ (define-key map [XF86Forward] 'next-history-element)
(define-key map "\ep" 'previous-history-element)
(define-key map [prior] 'previous-history-element)
(define-key map [up] 'previous-history-element)
+ (define-key map [XF86Back] 'previous-history-element)
(define-key map "\es" 'next-matching-history-element)
(define-key map "\er" 'previous-matching-history-element)
;; Override the global binding (which calls indent-relative via
"Keymap for navigation commands.")
(define-key esc-map "g" goto-map)
+(define-key goto-map "c" 'goto-char)
(define-key goto-map "g" 'goto-line)
(define-key goto-map "\M-g" 'goto-line)
(define-key goto-map "n" 'next-error)
(define-key ctl-x-5-map "m" 'compose-mail-other-frame)
\f
-(defvar ctl-x-r-map (make-sparse-keymap)
+(defvar ctl-x-r-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "c" 'clear-rectangle)
+ (define-key map "k" 'kill-rectangle)
+ (define-key map "d" 'delete-rectangle)
+ (define-key map "y" 'yank-rectangle)
+ (define-key map "o" 'open-rectangle)
+ (define-key map "t" 'string-rectangle)
+ (define-key map "N" 'rectangle-number-lines)
+ (define-key map "\M-w" 'copy-rectangle-as-kill)
+ (define-key map "\C-@" 'point-to-register)
+ (define-key map [?\C-\ ] 'point-to-register)
+ (define-key map " " 'point-to-register)
+ (define-key map "j" 'jump-to-register)
+ (define-key map "s" 'copy-to-register)
+ (define-key map "x" 'copy-to-register)
+ (define-key map "i" 'insert-register)
+ (define-key map "g" 'insert-register)
+ (define-key map "r" 'copy-rectangle-to-register)
+ (define-key map "n" 'number-to-register)
+ (define-key map "+" 'increment-register)
+ (define-key map "w" 'window-configuration-to-register)
+ (define-key map "f" 'frame-configuration-to-register)
+ map)
"Keymap for subcommands of C-x r.")
(define-key ctl-x-map "r" ctl-x-r-map)
;; (define-key ctl-x-map "\-" 'inverse-add-global-abbrev)
(define-key esc-map "'" 'abbrev-prefix-mark)
(define-key ctl-x-map "'" 'expand-abbrev)
+(define-key ctl-x-map "\C-b" 'list-buffers)
(define-key ctl-x-map "z" 'repeat)
;;; Code:
(require 'pp)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Misc comments:
;;
(defcustom bookmark-bmenu-toggle-filenames t
"Non-nil means show filenames when listing bookmarks.
-This may result in truncated bookmark names. To disable this, put the
-following in your `.emacs' file:
-
-\(setq bookmark-bmenu-toggle-filenames nil)"
+A non-nil value may result in truncated bookmark names."
:type 'boolean
:group 'bookmark)
(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
(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.
(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
(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'
(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)
"# Date: " (current-time-string) "\n"))
+(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
+ 'bookmark-edit-annotation-text-func "23.1")
(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
"Function to return default text to use for a bookmark annotation.
It takes one argument, the name of the bookmark, as a string.")
-(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
- 'bookmark-edit-annotation-text-func "23.1")
(defvar bookmark-edit-annotation-mode-map
(let ((map (make-sparse-keymap)))
(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."
Note: this function is deprecated and is present for Emacs 22
compatibility only."
+ (declare (obsolete bookmark-handle-bookmark "23.1"))
(save-excursion
(bookmark-handle-bookmark bookmark)
(cons (current-buffer) (point))))
-(make-obsolete 'bookmark-jump-noselect 'bookmark-handle-bookmark "23.1")
-
(defun bookmark-handle-bookmark (bookmark-name-or-record)
"Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler'
if it has none. This changes current buffer and point and returns nil,
(tmp-list ()))
(while
(let ((char (read-key (concat prompt bookmark-search-pattern))))
- (case char
- ((?\e ?\r) nil) ; RET or ESC break the search loop.
+ (pcase char
+ ((or ?\e ?\r) nil) ; RET or ESC break the search loop.
(?\C-g (setq bookmark-quit-flag t) nil)
(?\d (pop tmp-list) t) ; Delete last char of pattern with DEL
- (t
+ (_
(if (characterp char)
(push char tmp-list)
(setq unread-command-events
(defun bookmark-bmenu-filter-alist-by-regexp (regexp)
"Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list."
(let ((bookmark-alist
- (loop for i in bookmark-alist
- when (string-match regexp (car i)) collect i into new
- finally return new)))
+ (cl-loop for i in bookmark-alist
+ when (string-match regexp (car i)) collect i into new
+ finally return new)))
(bookmark-bmenu-list)))
;;;###autoload
(defvar menu-bar-bookmark-map
(let ((map (make-sparse-keymap "Bookmark functions")))
- (define-key map [load]
- `(menu-item ,(purecopy "Load a Bookmark File...") bookmark-load
- :help ,(purecopy "Load bookmarks from a bookmark file)")))
- (define-key map [write]
- `(menu-item ,(purecopy "Save Bookmarks As...") bookmark-write
- :help ,(purecopy "Write bookmarks to a file (reading the file name with the minibuffer)")))
- (define-key map [save]
- `(menu-item ,(purecopy "Save Bookmarks") bookmark-save
- :help ,(purecopy "Save currently defined bookmarks")))
- (define-key map [edit]
- `(menu-item ,(purecopy "Edit Bookmark List") bookmark-bmenu-list
- :help ,(purecopy "Display a list of existing bookmarks")))
- (define-key map [delete]
- `(menu-item ,(purecopy "Delete Bookmark...") bookmark-delete
- :help ,(purecopy "Delete a bookmark from the bookmark list")))
- (define-key map [rename]
- `(menu-item ,(purecopy "Rename Bookmark...") bookmark-rename
- :help ,(purecopy "Change the name of a bookmark")))
- (define-key map [locate]
- `(menu-item ,(purecopy "Insert Location...") bookmark-locate
- :help ,(purecopy "Insert the name of the file associated with a bookmark")))
- (define-key map [insert]
- `(menu-item ,(purecopy "Insert Contents...") bookmark-insert
- :help ,(purecopy "Insert the text of the file pointed to by a bookmark")))
- (define-key map [set]
- `(menu-item ,(purecopy "Set Bookmark...") bookmark-set
- :help ,(purecopy "Set a bookmark named inside a file.")))
- (define-key map [jump]
- `(menu-item ,(purecopy "Jump to Bookmark...") bookmark-jump
- :help ,(purecopy "Jump to a bookmark (a point in some file)")))
+ (bindings--define-key map [load]
+ '(menu-item "Load a Bookmark File..." bookmark-load
+ :help "Load bookmarks from a bookmark file)"))
+ (bindings--define-key map [write]
+ '(menu-item "Save Bookmarks As..." bookmark-write
+ :help "Write bookmarks to a file (reading the file name with the minibuffer)"))
+ (bindings--define-key map [save]
+ '(menu-item "Save Bookmarks" bookmark-save
+ :help "Save currently defined bookmarks"))
+ (bindings--define-key map [edit]
+ '(menu-item "Edit Bookmark List" bookmark-bmenu-list
+ :help "Display a list of existing bookmarks"))
+ (bindings--define-key map [delete]
+ '(menu-item "Delete Bookmark..." bookmark-delete
+ :help "Delete a bookmark from the bookmark list"))
+ (bindings--define-key map [rename]
+ '(menu-item "Rename Bookmark..." bookmark-rename
+ :help "Change the name of a bookmark"))
+ (bindings--define-key map [locate]
+ '(menu-item "Insert Location..." bookmark-locate
+ :help "Insert the name of the file associated with a bookmark"))
+ (bindings--define-key map [insert]
+ '(menu-item "Insert Contents..." bookmark-insert
+ :help "Insert the text of the file pointed to by a bookmark"))
+ (bindings--define-key map [set]
+ '(menu-item "Set Bookmark..." bookmark-set
+ :help "Set a bookmark named inside a file."))
+ (bindings--define-key map [jump]
+ '(menu-item "Jump to Bookmark..." bookmark-jump
+ :help "Jump to a bookmark (a point in some file)"))
map))
;;;###autoload
"Hook run at the end of loading library `bookmark.el'.")
;; Exit Hook, called from kill-emacs-hook
+(define-obsolete-variable-alias 'bookmark-exit-hooks
+ 'bookmark-exit-hook "22.1")
(defvar bookmark-exit-hook nil
"Hook run when Emacs exits.")
-(define-obsolete-variable-alias 'bookmark-exit-hooks 'bookmark-exit-hook "22.1")
-
(defun bookmark-exit-hook-internal ()
"Save bookmark state, if necessary, at Emacs exit time.
This also runs `bookmark-exit-hook'."
;;; Code:
-(eval-when-compile (require 'cl))
-
;; ----------------------------------------------------------------------
;; Globals for customization
;; ----------------------------------------------------------------------
(interactive)
(let ((res
(with-current-buffer (bs--current-buffer)
- (setq bs-buffer-show-mark (case bs-buffer-show-mark
- ((nil) 'never)
- ((never) 'always)
- (t nil))))))
+ (setq bs-buffer-show-mark (pcase bs-buffer-show-mark
+ (`nil 'never)
+ (`never 'always)
+ (_ nil))))))
(bs--update-current-line)
(bs--set-window-height)
(bs--show-config-message res)))
Uses function `toggle-read-only'."
(interactive)
(with-current-buffer (bs--current-buffer)
- (toggle-read-only))
+ (read-only-mode 'toggle))
(bs--update-current-line))
(defun bs-clear-modified ()
-;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*-
+;;; buff-menu.el --- Interface for viewing and manipulating buffers
;; Copyright (C) 1985-1987, 1993-1995, 2000-2012
;; Free Software Foundation, Inc.
;;; Commentary:
-;; Edit, delete, or change attributes of all currently active Emacs
-;; buffers from a list summarizing their state. A good way to browse
-;; any special or scratch buffers you have loaded, since you can't find
-;; them by filename. The single entry point is `list-buffers',
-;; normally bound to C-x C-b.
-
-;;; Change Log:
-
-;; Buffer-menu-view: New function
-;; Buffer-menu-view-other-window: New function
-
-;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993
-;;
-;; Modified by Bob Weiner, Motorola, Inc., 4/14/89
-;;
-;; Added optional backup argument to 'Buffer-menu-unmark' to make it undelete
-;; current entry and then move to previous one.
-;;
-;; Based on FSF code dating back to 1985.
+;; The Buffer Menu is used to view, edit, delete, or change attributes
+;; of buffers. The entry points are C-x C-b (`list-buffers') and
+;; M-x buffer-menu.
;;; Code:
-;;Trying to preserve the old window configuration works well in
-;;simple scenarios, when you enter the buffer menu, use it, and exit it.
-;;But it does strange things when you switch back to the buffer list buffer
-;;with C-x b, later on, when the window configuration is different.
-;;The choice seems to be, either restore the window configuration
-;;in all cases, or in no cases.
-;;I decided it was better not to restore the window config at all. -- rms.
-
-;;But since then, I changed buffer-menu to use the selected window,
-;;so q now once again goes back to the previous window configuration.
-
-;;(defvar Buffer-menu-window-config nil
-;; "Window configuration saved from entry to `buffer-menu'.")
-
-;; Put buffer *Buffer List* into proper mode right away
-;; so that from now on even list-buffers is enough to get a buffer menu.
+(require 'tabulated-list)
(defgroup Buffer-menu nil
"Show a menu of all buffers in a buffer."
:group 'convenience)
(defcustom Buffer-menu-use-header-line t
- "Non-nil means to use an immovable header-line."
+ "If non-nil, use the header line to display Buffer Menu column titles."
:type 'boolean
:group 'Buffer-menu)
(defface buffer-menu-buffer
'((t (:weight bold)))
- "Face used to highlight buffer names in the buffer menu."
+ "Face for buffer names in the Buffer Menu."
:group 'Buffer-menu)
(put 'Buffer-menu-buffer 'face-alias 'buffer-menu-buffer)
-(defcustom Buffer-menu-buffer+size-width 26
- "How wide to jointly make the buffer name and size columns."
+(defcustom Buffer-menu-buffer+size-width nil
+ "Combined width of buffer name and size columns in Buffer Menu.
+If nil, use `Buffer-menu-name-width' and `Buffer-menu-size-width'.
+
+If non-nil, the value of `Buffer-menu-name-width' is overridden;
+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)
+ :group 'Buffer-menu
+ :version "24.3")
+
+(make-obsolete-variable 'Buffer-menu-buffer+size-width
+ "`Buffer-menu-name-width' and `Buffer-menu-size-width'"
+ "24.3")
+
+(defcustom Buffer-menu-name-width 19
+ "Width of buffer name column in the Buffer Menu."
+ :type 'number
+ :group 'Buffer-menu
+ :version "24.3")
+
+(defcustom Buffer-menu-size-width 7
+ "Width of buffer size column in the Buffer Menu."
+ :type 'number
+ :group 'Buffer-menu
+ :version "24.3")
(defcustom Buffer-menu-mode-width 16
- "How wide to make the mode name column."
+ "Width of mode name column in the Buffer Menu."
:type 'number
:group 'Buffer-menu)
:group 'Buffer-menu
:version "22.1")
-;; This should get updated & resorted when you click on a column heading
-(defvar Buffer-menu-sort-column nil
- "Which column to sort the menu on.
-Use 2 to sort by buffer names, or 5 to sort by file names.
-A nil value means sort by visited order (the default).")
-
-(defconst Buffer-menu-buffer-column 4)
-
(defvar Buffer-menu-files-only nil
- "Non-nil if the current buffer-menu lists only file buffers.
-This variable determines whether reverting the buffer lists only
-file buffers. It affects both manual reverting and reverting by
-Auto Revert Mode.")
+ "Non-nil if the current Buffer Menu lists only file buffers.
+This is set by the prefix argument to `buffer-menu' and related
+commands.")
(make-variable-buffer-local 'Buffer-menu-files-only)
-(defvar Buffer-menu--buffers nil
- "If non-nil, list of buffers shown in the current buffer-menu.
-This variable determines whether reverting the buffer lists only
-these buffers. It affects both manual reverting and reverting by
-Auto Revert Mode.")
-(make-variable-buffer-local 'Buffer-menu--buffers)
-
-(defvar Info-current-file) ;; from info.el
-(defvar Info-current-node) ;; from info.el
+(defvar Info-current-file) ; from info.el
+(defvar Info-current-node) ; from info.el
(defvar Buffer-menu-mode-map
- (let ((map (make-keymap))
+ (let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap)))
- (suppress-keymap map t)
+ (set-keymap-parent map tabulated-list-mode-map)
(define-key map "v" 'Buffer-menu-select)
(define-key map "2" 'Buffer-menu-2-window)
(define-key map "1" 'Buffer-menu-1-window)
(define-key map "s" 'Buffer-menu-save)
(define-key map "d" 'Buffer-menu-delete)
(define-key map "k" 'Buffer-menu-delete)
- (define-key map "\C-d" 'Buffer-menu-delete-backwards)
(define-key map "\C-k" 'Buffer-menu-delete)
+ (define-key map "\C-d" 'Buffer-menu-delete-backwards)
(define-key map "x" 'Buffer-menu-execute)
(define-key map " " 'next-line)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
(define-key map "\177" 'Buffer-menu-backup-unmark)
(define-key map "~" 'Buffer-menu-not-modified)
(define-key map "u" 'Buffer-menu-unmark)
(define-key map "b" 'Buffer-menu-bury)
(define-key map "V" 'Buffer-menu-view)
(define-key map "T" 'Buffer-menu-toggle-files-only)
- (define-key map [mouse-2] 'Buffer-menu-mouse-select)
- (define-key map [follow-link] 'mouse-face)
(define-key map (kbd "M-s a C-s") 'Buffer-menu-isearch-buffers)
(define-key map (kbd "M-s a M-C-s") 'Buffer-menu-isearch-buffers-regexp)
+
+ (define-key map [mouse-2] 'Buffer-menu-mouse-select)
+ (define-key map [follow-link] 'mouse-face)
+
(define-key map [menu-bar Buffer-menu-mode] (cons (purecopy "Buffer-Menu") menu-map))
- (define-key menu-map [quit]
- `(menu-item ,(purecopy "Quit") quit-window
- :help ,(purecopy "Remove the buffer menu from the display")))
- (define-key menu-map [rev]
- `(menu-item ,(purecopy "Refresh") revert-buffer
- :help ,(purecopy "Refresh the *Buffer List* buffer contents")))
- (define-key menu-map [s0] menu-bar-separator)
- (define-key menu-map [tf]
- `(menu-item ,(purecopy "Show Only File Buffers") Buffer-menu-toggle-files-only
+ (bindings--define-key menu-map [quit]
+ '(menu-item "Quit" quit-window
+ :help "Remove the buffer menu from the display"))
+ (bindings--define-key menu-map [rev]
+ '(menu-item "Refresh" revert-buffer
+ :help "Refresh the *Buffer List* buffer contents"))
+ (bindings--define-key menu-map [s0] menu-bar-separator)
+ (bindings--define-key menu-map [tf]
+ '(menu-item "Show Only File Buffers" Buffer-menu-toggle-files-only
:button (:toggle . Buffer-menu-files-only)
- :help ,(purecopy "Toggle whether the current buffer-menu displays only file buffers")))
- (define-key menu-map [s1] menu-bar-separator)
+ :help "Toggle whether the current buffer-menu displays only file buffers"))
+ (bindings--define-key menu-map [s1] menu-bar-separator)
;; FIXME: The "Select" entries could use better names...
- (define-key menu-map [sel]
- `(menu-item ,(purecopy "Select Marked") Buffer-menu-select
- :help ,(purecopy "Select this line's buffer; also display buffers marked with `>'")))
- (define-key menu-map [bm2]
- `(menu-item ,(purecopy "Select Two") Buffer-menu-2-window
- :help ,(purecopy "Select this line's buffer, with previous buffer in second window")))
- (define-key menu-map [bm1]
- `(menu-item ,(purecopy "Select Current") Buffer-menu-1-window
- :help ,(purecopy "Select this line's buffer, alone, in full frame")))
- (define-key menu-map [ow]
- `(menu-item ,(purecopy "Select in Other Window") Buffer-menu-other-window
- :help ,(purecopy "Select this line's buffer in other window, leaving buffer menu visible")))
- (define-key menu-map [tw]
- `(menu-item ,(purecopy "Select in Current Window") Buffer-menu-this-window
- :help ,(purecopy "Select this line's buffer in this window")))
- (define-key menu-map [s2] menu-bar-separator)
- (define-key menu-map [is]
- `(menu-item ,(purecopy "Regexp Isearch Marked Buffers...") Buffer-menu-isearch-buffers-regexp
- :help ,(purecopy "Search for a regexp through all marked buffers using Isearch")))
- (define-key menu-map [ir]
- `(menu-item ,(purecopy "Isearch Marked Buffers...") Buffer-menu-isearch-buffers
- :help ,(purecopy "Search for a string through all marked buffers using Isearch")))
- (define-key menu-map [s3] menu-bar-separator)
- (define-key menu-map [by]
- `(menu-item ,(purecopy "Bury") Buffer-menu-bury
- :help ,(purecopy "Bury the buffer listed on this line")))
- (define-key menu-map [vt]
- `(menu-item ,(purecopy "Set Unmodified") Buffer-menu-not-modified
- :help ,(purecopy "Mark buffer on this line as unmodified (no changes to save)")))
- (define-key menu-map [ex]
- `(menu-item ,(purecopy "Execute") Buffer-menu-execute
- :help ,(purecopy "Save and/or delete buffers marked with s or k commands")))
- (define-key menu-map [s4] menu-bar-separator)
- (define-key menu-map [delb]
- `(menu-item ,(purecopy "Mark for Delete and Move Backwards") Buffer-menu-delete-backwards
- :help ,(purecopy "Mark buffer on this line to be deleted by x command and move up one line")))
- (define-key menu-map [del]
- `(menu-item ,(purecopy "Mark for Delete") Buffer-menu-delete
- :help ,(purecopy "Mark buffer on this line to be deleted by x command")))
-
- (define-key menu-map [sv]
- `(menu-item ,(purecopy "Mark for Save") Buffer-menu-save
- :help ,(purecopy "Mark buffer on this line to be saved by x command")))
- (define-key menu-map [umk]
- `(menu-item ,(purecopy "Unmark") Buffer-menu-unmark
- :help ,(purecopy "Cancel all requested operations on buffer on this line and move down")))
- (define-key menu-map [mk]
- `(menu-item ,(purecopy "Mark") Buffer-menu-mark
- :help ,(purecopy "Mark buffer on this line for being displayed by v command")))
+ (bindings--define-key menu-map [sel]
+ '(menu-item "Select Marked" Buffer-menu-select
+ :help "Select this line's buffer; also display buffers marked with `>'"))
+ (bindings--define-key menu-map [bm2]
+ '(menu-item "Select Two" Buffer-menu-2-window
+ :help "Select this line's buffer, with previous buffer in second window"))
+ (bindings--define-key menu-map [bm1]
+ '(menu-item "Select Current" Buffer-menu-1-window
+ :help "Select this line's buffer, alone, in full frame"))
+ (bindings--define-key menu-map [ow]
+ '(menu-item "Select in Other Window" Buffer-menu-other-window
+ :help "Select this line's buffer in other window, leaving buffer menu visible"))
+ (bindings--define-key menu-map [tw]
+ '(menu-item "Select in Current Window" Buffer-menu-this-window
+ :help "Select this line's buffer in this window"))
+ (bindings--define-key menu-map [s2] menu-bar-separator)
+ (bindings--define-key menu-map [is]
+ '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp
+ :help "Search for a regexp through all marked buffers using Isearch"))
+ (bindings--define-key menu-map [ir]
+ '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers
+ :help "Search for a string through all marked buffers using Isearch"))
+ (bindings--define-key menu-map [s3] menu-bar-separator)
+ (bindings--define-key menu-map [by]
+ '(menu-item "Bury" Buffer-menu-bury
+ :help "Bury the buffer listed on this line"))
+ (bindings--define-key menu-map [vt]
+ '(menu-item "Set Unmodified" Buffer-menu-not-modified
+ :help "Mark buffer on this line as unmodified (no changes to save)"))
+ (bindings--define-key menu-map [ex]
+ '(menu-item "Execute" Buffer-menu-execute
+ :help "Save and/or delete buffers marked with s or k commands"))
+ (bindings--define-key menu-map [s4] menu-bar-separator)
+ (bindings--define-key menu-map [delb]
+ '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards
+ :help "Mark buffer on this line to be deleted by x command and move up one line"))
+ (bindings--define-key menu-map [del]
+ '(menu-item "Mark for Delete" Buffer-menu-delete
+ :help "Mark buffer on this line to be deleted by x command"))
+
+ (bindings--define-key menu-map [sv]
+ '(menu-item "Mark for Save" Buffer-menu-save
+ :help "Mark buffer on this line to be saved by x command"))
+ (bindings--define-key menu-map [umk]
+ '(menu-item "Unmark" Buffer-menu-unmark
+ :help "Cancel all requested operations on buffer on this line and move down"))
+ (bindings--define-key menu-map [mk]
+ '(menu-item "Mark" Buffer-menu-mark
+ :help "Mark buffer on this line for being displayed by v command"))
map)
"Local keymap for `Buffer-menu-mode' buffers.")
-;; Buffer Menu mode is suitable only for specially formatted data.
-(put 'Buffer-menu-mode 'mode-class 'special)
+(define-obsolete-variable-alias 'buffer-menu-mode-hook
+ 'Buffer-menu-mode-hook "23.1")
-(define-derived-mode Buffer-menu-mode special-mode "Buffer Menu"
- "Major mode for editing a list of buffers.
-Each line describes one of the buffers in Emacs.
-Letters do not insert themselves; instead, they are commands.
-\\<Buffer-menu-mode-map>
-\\[Buffer-menu-mouse-select] -- select buffer you click on, in place of the buffer menu.
-\\[Buffer-menu-this-window] -- select current line's buffer in place of the buffer menu.
-\\[Buffer-menu-other-window] -- select that buffer in another window,
- so the buffer menu buffer remains visible in its window.
-\\[Buffer-menu-view] -- select current line's buffer, but in view-mode.
-\\[Buffer-menu-view-other-window] -- select that buffer in
- another window, in view-mode.
-\\[Buffer-menu-switch-other-window] -- make another window display that buffer.
-\\[Buffer-menu-mark] -- mark current line's buffer to be displayed.
-\\[Buffer-menu-select] -- select current line's buffer.
- Also show buffers marked with m, in other windows.
-\\[Buffer-menu-1-window] -- select that buffer in full-frame window.
-\\[Buffer-menu-2-window] -- select that buffer in one window,
- together with buffer selected before this one in another window.
-\\[Buffer-menu-isearch-buffers] -- Do incremental search in the marked buffers.
-\\[Buffer-menu-isearch-buffers-regexp] -- Isearch for regexp in the marked buffers.
-\\[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer.
-\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
-\\[Buffer-menu-save] -- mark that buffer to be saved, and move down.
-\\[Buffer-menu-delete] -- mark that buffer to be deleted, and move down.
-\\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted, and move up.
-\\[Buffer-menu-execute] -- delete or save marked buffers.
-\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
- With prefix argument, also move up one line.
-\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
-\\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line.
-\\[revert-buffer] -- update the list of buffers.
-\\[Buffer-menu-toggle-files-only] -- toggle whether the menu displays only file buffers.
-\\[Buffer-menu-bury] -- bury the buffer listed on this line."
- (set (make-local-variable 'revert-buffer-function)
- 'Buffer-menu-revert-function)
+(define-derived-mode Buffer-menu-mode tabulated-list-mode "Buffer Menu"
+ "Major mode for Buffer Menu buffers.
+The Buffer Menu is invoked by the commands \\[list-buffers], \\[buffer-menu], and
+\\[buffer-menu-other-window]. See `buffer-menu' for details."
(set (make-local-variable 'buffer-stale-function)
(lambda (&optional _noconfirm) 'fast))
- (setq truncate-lines t)
- (setq buffer-read-only t)
- ;; Force L2R direction, to avoid messing the display if the first
- ;; buffer in the list happens to begin with a strong R2L character.
- (setq bidi-paragraph-direction 'left-to-right))
+ (add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
-(define-obsolete-variable-alias 'buffer-menu-mode-hook
- 'Buffer-menu-mode-hook "23.1")
+(defun buffer-menu (&optional arg)
+ "Switch to the Buffer Menu.
+By default, all buffers are listed except those whose names start
+with a space (which are for internal use). With prefix argument
+ARG, show only buffers that are visiting files.
-(defun Buffer-menu-revert-function (_ignore1 _ignore2)
- (or (eq buffer-undo-list t)
- (setq buffer-undo-list nil))
- ;; We can not use save-excursion here. The buffer gets erased.
- (let ((opoint (point))
- (eobp (eobp))
- (ocol (current-column))
- (oline (progn (move-to-column Buffer-menu-buffer-column)
- (get-text-property (point) 'buffer)))
- (prop (point-min))
- ;; do not make undo records for the reversion.
- (buffer-undo-list t))
- ;; We can be called by Auto Revert Mode with the "*Buffer Menu*"
- ;; temporarily the current buffer. Make sure that the
- ;; interactively current buffer is correctly identified with a `.'
- ;; by `list-buffers-noselect'.
- (with-current-buffer (window-buffer)
- (list-buffers-noselect Buffer-menu-files-only Buffer-menu--buffers))
- (if oline
- (while (setq prop (next-single-property-change prop 'buffer))
- (when (eq (get-text-property prop 'buffer) oline)
- (goto-char prop)
- (move-to-column ocol)))
- (goto-char (if eobp (point-max) opoint)))))
+The first column (denoted \"C\") shows \".\" for the buffer from
+which you came. It shows \">\" for buffers you mark to be
+displayed, and \"D\" for those you mark for deletion.
-(defun Buffer-menu-toggle-files-only (arg)
- "Toggle whether the current buffer-menu displays only file buffers.
-With a positive ARG display only file buffers. With zero or
-negative ARG, display other buffers as well."
- (interactive "P")
- (setq Buffer-menu-files-only
- (cond ((not arg) (not Buffer-menu-files-only))
- ((> (prefix-numeric-value arg) 0) t)))
- (revert-buffer))
+The \"R\" column has a \"%\" if the buffer is read-only.
+The \"M\" column has a \"*\" if it is modified, or \"S\" if you
+have marked it for saving.
-\f
-(defun Buffer-menu-buffer (error-if-non-existent-p)
- "Return buffer described by this line of buffer menu."
- (let* ((where (+ (line-beginning-position) Buffer-menu-buffer-column))
- (name (and (not (eobp)) (get-text-property where 'buffer-name)))
- (buf (and (not (eobp)) (get-text-property where 'buffer))))
- (if name
- (or (get-buffer name)
- (and buf (buffer-name buf) buf)
- (if error-if-non-existent-p
- (error "No buffer named `%s'" name)
- nil))
- (or (and buf (buffer-name buf) buf)
- (if error-if-non-existent-p
- (error "No buffer on this line")
- nil)))))
-\f
-(defun buffer-menu (&optional arg)
- "Make a menu of buffers so you can save, delete or select them.
-With argument, show only buffers that are visiting files.
-Type ? after invocation to get help on commands available.
-Type q to remove the buffer menu from the display.
-
-The first column shows `>' for a buffer you have
-marked to be displayed, `D' for one you have marked for
-deletion, and `.' for the current buffer.
-
-The C column has a `.' for the buffer from which you came.
-The R column has a `%' if the buffer is read-only.
-The M column has a `*' if it is modified,
-or `S' if you have marked it for saving.
-After this come the buffer name, its size in characters,
-its major mode, and the visited file name (if any)."
+After this come the buffer name, its size in characters, its
+major mode, and the visited file name (if any).
+
+
+In the Buffer Menu, the following commands are defined:
+\\<Buffer-menu-mode-map>
+\\[quit-window] Remove the Buffer Menu from the display.
+\\[Buffer-menu-this-window] Select current line's buffer in place of the buffer menu.
+\\[Buffer-menu-other-window] Select that buffer in another window,
+ so the Buffer Menu remains visible in its window.
+\\[Buffer-menu-view] Select current line's buffer, in View mode.
+\\[Buffer-menu-view-other-window] Select that buffer in
+ another window, in view-mode.
+\\[Buffer-menu-switch-other-window] Make another window display that buffer.
+\\[Buffer-menu-mark] Mark current line's buffer to be displayed.
+\\[Buffer-menu-select] Select current line's buffer.
+ Also show buffers marked with m, in other windows.
+\\[Buffer-menu-1-window] Select that buffer in full-frame window.
+\\[Buffer-menu-2-window] Select that buffer in one window, together with the
+ buffer selected before this one in another window.
+\\[Buffer-menu-isearch-buffers] Incremental search in the marked buffers.
+\\[Buffer-menu-isearch-buffers-regexp] Isearch for regexp in the marked buffers.
+\\[Buffer-menu-visit-tags-table] visit-tags-table this buffer.
+\\[Buffer-menu-not-modified] Clear modified-flag on that buffer.
+\\[Buffer-menu-save] Mark that buffer to be saved, and move down.
+\\[Buffer-menu-delete] Mark that buffer to be deleted, and move down.
+\\[Buffer-menu-delete-backwards] Mark that buffer to be deleted, and move up.
+\\[Buffer-menu-execute] Delete or save marked buffers.
+\\[Buffer-menu-unmark] Remove all marks from current line.
+ With prefix argument, also move up one line.
+\\[Buffer-menu-backup-unmark] Back up a line and remove marks.
+\\[Buffer-menu-toggle-read-only] Toggle read-only status of buffer on this line.
+\\[revert-buffer] Update the list of buffers.
+\\[Buffer-menu-toggle-files-only] Toggle whether the menu displays only file buffers.
+\\[Buffer-menu-bury] Bury the buffer listed on this line."
(interactive "P")
-;;; (setq Buffer-menu-window-config (current-window-configuration))
(switch-to-buffer (list-buffers-noselect arg))
(message
"Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
(defun buffer-menu-other-window (&optional arg)
- "Display a list of buffers in another window.
-With the buffer list buffer, you can save, delete or select the buffers.
-With argument, show only buffers that are visiting files.
-Type ? after invocation to get help on commands available.
-Type q to remove the buffer menu from the display.
-For more information, see the function `buffer-menu'."
+ "Display the Buffer Menu in another window.
+See `buffer-menu' for a description of the Buffer Menu.
+
+By default, all buffers are listed except those whose names start
+with a space (which are for internal use). With prefix argument
+ARG, show only buffers that are visiting files."
(interactive "P")
-;;; (setq Buffer-menu-window-config (current-window-configuration))
(switch-to-buffer-other-window (list-buffers-noselect arg))
(message
"Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+;;;###autoload
+(defun list-buffers (&optional arg)
+ "Display a list of existing buffers.
+The list is displayed in a buffer named \"*Buffer List*\".
+See `buffer-menu' for details about the Buffer Menu buffer.
+
+By default, all buffers are listed except those whose names start
+with a space (which are for internal use). With prefix argument
+ARG, show only buffers that are visiting files."
+ (interactive "P")
+ (display-buffer (list-buffers-noselect arg)))
+
+(defun Buffer-menu-toggle-files-only (arg)
+ "Toggle whether the current buffer-menu displays only file buffers.
+With a positive ARG, display only file buffers. With zero or
+negative ARG, display other buffers as well."
+ (interactive "P")
+ (setq Buffer-menu-files-only
+ (cond ((not arg) (not Buffer-menu-files-only))
+ ((> (prefix-numeric-value arg) 0) t)))
+ (message (if Buffer-menu-files-only
+ "Showing only file-visiting buffers."
+ "Showing all non-internal buffers."))
+ (revert-buffer))
+
+(defalias 'Buffer-menu-sort 'tabulated-list-sort)
+\f
+
+(defun Buffer-menu-buffer (&optional error-if-non-existent-p)
+ "Return the buffer described by the current Buffer Menu line.
+If there is no buffer here, return nil if ERROR-IF-NON-EXISTENT-P
+is nil or omitted, and signal an error otherwise."
+ (let ((buffer (tabulated-list-get-id)))
+ (cond ((null buffer)
+ (if error-if-non-existent-p
+ (error "No buffer on this line")))
+ ((not (buffer-live-p buffer))
+ (if error-if-non-existent-p
+ (error "This buffer has been killed")))
+ (t buffer))))
+
(defun Buffer-menu-no-header ()
(beginning-of-line)
(if (or Buffer-menu-use-header-line
(forward-line 1)
nil))
+(defun Buffer-menu-beginning ()
+ (goto-char (point-min))
+ (unless Buffer-menu-use-header-line
+ (forward-line)))
+
+\f
+;;; Commands for modifying Buffer Menu entries.
+
(defun Buffer-menu-mark ()
- "Mark buffer on this line for being displayed by \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
+ "Mark the Buffer menu entry at point for later display.
+It will be displayed by the \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
(interactive)
- (when (Buffer-menu-no-header)
- (let ((inhibit-read-only t))
- (delete-char 1)
- (insert ?>)
- (forward-line 1))))
+ (tabulated-list-set-col 0 ">" t)
+ (forward-line))
(defun Buffer-menu-unmark (&optional backup)
"Cancel all requested operations on buffer on this line and move down.
Optional prefix arg means move up."
(interactive "P")
- (when (Buffer-menu-no-header)
- (let* ((buf (Buffer-menu-buffer t))
- (mod (buffer-modified-p buf))
- (readonly (with-current-buffer buf buffer-read-only))
- (inhibit-read-only t))
- (delete-char 3)
- (insert (if readonly (if mod " %*" " % ") (if mod " *" " ")))))
+ (tabulated-list-set-col 0 " " t)
(forward-line (if backup -1 1)))
(defun Buffer-menu-backup-unmark ()
"Move up and cancel all requested operations on buffer on line above."
(interactive)
(forward-line -1)
- (Buffer-menu-unmark)
- (forward-line -1))
+ (tabulated-list-set-col 0 " " t))
(defun Buffer-menu-delete (&optional arg)
- "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command.
-Prefix arg is how many buffers to delete.
-Negative arg means delete backwards."
+ "Mark the buffer on this Buffer Menu buffer line for deletion.
+A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
+will delete it.
+
+If prefix argument ARG is non-nil, it specifies the number of
+buffers to delete; a negative ARG means to delete backwards."
(interactive "p")
- (when (Buffer-menu-no-header)
- (let ((inhibit-read-only t))
- (if (or (null arg) (= arg 0))
- (setq arg 1))
- (while (> arg 0)
- (delete-char 1)
- (insert ?D)
- (forward-line 1)
- (setq arg (1- arg)))
- (while (and (< arg 0)
- (Buffer-menu-no-header))
- (delete-char 1)
- (insert ?D)
- (forward-line -1)
- (setq arg (1+ arg))))))
+ (if (or (null arg) (= arg 0))
+ (setq arg 1))
+ (while (> arg 0)
+ (when (Buffer-menu-buffer)
+ (tabulated-list-set-col 0 "D" t))
+ (forward-line 1)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (when (Buffer-menu-buffer)
+ (tabulated-list-set-col 0 "D" t))
+ (forward-line -1)
+ (setq arg (1+ arg))))
(defun Buffer-menu-delete-backwards (&optional arg)
- "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command
-and then move up one line. Prefix arg means move that many lines."
+ "Mark the buffer on this Buffer Menu line for deletion, and move up.
+Prefix ARG means move that many lines."
(interactive "p")
(Buffer-menu-delete (- (or arg 1))))
(defun Buffer-menu-save ()
- "Mark buffer on this line to be saved by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command."
+ "Mark the buffer on this Buffer Menu line for saving.
+A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
+will save it."
(interactive)
- (when (Buffer-menu-no-header)
- (let ((inhibit-read-only t))
- (forward-char 2)
- (delete-char 1)
- (insert ?S)
- (forward-line 1))))
+ (when (Buffer-menu-buffer)
+ (tabulated-list-set-col 2 "S" t)
+ (forward-line 1)))
(defun Buffer-menu-not-modified (&optional arg)
- "Mark buffer on this line as unmodified (no changes to save)."
+ "Mark the buffer on this line as unmodified (no changes to save).
+If ARG is non-nil (interactively, with a prefix argument), mark
+it as modified."
(interactive "P")
(with-current-buffer (Buffer-menu-buffer t)
(set-buffer-modified-p arg))
- (save-excursion
- (beginning-of-line)
- (forward-char 2)
- (if (= (char-after) (if arg ?\s ?*))
- (let ((inhibit-read-only t))
- (delete-char 1)
- (insert (if arg ?* ?\s))))))
-
-(defun Buffer-menu-beginning ()
- (goto-char (point-min))
- (unless Buffer-menu-use-header-line
- (forward-line)))
+ (tabulated-list-set-col 2 (if arg "*" " ") t))
(defun Buffer-menu-execute ()
- "Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
+ "Save and/or delete marked buffers in the Buffer Menu.
+Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-save]' are saved.
+Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted."
(interactive)
(save-excursion
(Buffer-menu-beginning)
- (while (re-search-forward "^..S" nil t)
- (let ((modp nil))
- (with-current-buffer (Buffer-menu-buffer t)
- (save-buffer)
- (setq modp (buffer-modified-p)))
- (let ((inhibit-read-only t))
- (delete-char -1)
- (insert (if modp ?* ?\s))))))
- (save-excursion
- (Buffer-menu-beginning)
- (let ((buff-menu-buffer (current-buffer))
- (inhibit-read-only t))
- (while (re-search-forward "^D" nil t)
- (forward-char -1)
- (let ((buf (Buffer-menu-buffer nil)))
- (or (eq buf nil)
- (eq buf buff-menu-buffer)
- (save-excursion (kill-buffer buf)))
- (if (and buf (buffer-name buf))
- (progn (delete-char 1)
- (insert ?\s))
- (delete-region (point) (progn (forward-line 1) (point)))
- (unless (bobp)
- (forward-char -1))))))))
+ (while (not (eobp))
+ (let ((buffer (tabulated-list-get-id))
+ (entry (tabulated-list-get-entry)))
+ (cond ((null entry)
+ (forward-line 1))
+ ((not (buffer-live-p buffer))
+ (tabulated-list-delete-entry))
+ (t
+ (let ((delete (eq (char-after) ?D)))
+ (when (equal (aref entry 2) "S")
+ (condition-case nil
+ (progn
+ (with-current-buffer buffer
+ (save-buffer))
+ (tabulated-list-set-col 2 " " t))
+ (error (warn "Error saving %s" buffer))))
+ (if delete
+ (unless (eq buffer (current-buffer))
+ (kill-buffer buffer)
+ (tabulated-list-delete-entry))
+ (forward-line 1)))))))))
(defun Buffer-menu-select ()
- "Select this line's buffer; also display buffers marked with `>'.
-You can mark buffers with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command.
+ "Select this line's buffer; also, display buffers marked with `>'.
+You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command.
This command deletes and replaces all the previously existing windows
in the selected frame."
(interactive)
- (let ((buff (Buffer-menu-buffer t))
- (menu (current-buffer))
- (others ())
- tem)
- (Buffer-menu-beginning)
- (while (re-search-forward "^>" nil t)
- (setq tem (Buffer-menu-buffer t))
- (let ((inhibit-read-only t))
- (delete-char -1)
- (insert ?\s))
- (or (eq tem buff) (memq tem others) (setq others (cons tem others))))
- (setq others (nreverse others)
- tem (/ (1- (frame-height)) (1+ (length others))))
+ (let* ((this-buffer (Buffer-menu-buffer t))
+ (menu-buffer (current-buffer))
+ (others (delq this-buffer (Buffer-menu-marked-buffers t)))
+ (height (/ (1- (frame-height)) (1+ (length others)))))
(delete-other-windows)
- (switch-to-buffer buff)
- (or (eq menu buff)
- (bury-buffer menu))
- (if (equal (length others) 0)
- (progn
-;;; ;; Restore previous window configuration before displaying
-;;; ;; selected buffers.
-;;; (if Buffer-menu-window-config
-;;; (progn
-;;; (set-window-configuration Buffer-menu-window-config)
-;;; (setq Buffer-menu-window-config nil)))
- (switch-to-buffer buff))
- (while others
- (split-window nil tem)
- (other-window 1)
- (switch-to-buffer (car others))
- (setq others (cdr others)))
- (other-window 1) ;back to the beginning!
-)))
-
-(defun Buffer-menu-marked-buffers ()
- "Return a list of buffers marked with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command."
+ (switch-to-buffer this-buffer)
+ (unless (eq menu-buffer this-buffer)
+ (bury-buffer menu-buffer))
+ (dolist (buffer others)
+ (split-window nil height)
+ (other-window 1)
+ (switch-to-buffer buffer))
+ ;; Back to the beginning!
+ (other-window 1)))
+
+(defun Buffer-menu-marked-buffers (&optional unmark)
+ "Return the list of buffers marked with `Buffer-menu-mark'.
+If UNMARK is non-nil, unmark them."
(let (buffers)
(Buffer-menu-beginning)
(while (re-search-forward "^>" nil t)
- (setq buffers (cons (Buffer-menu-buffer t) buffers)))
+ (let ((buffer (Buffer-menu-buffer)))
+ (if (and buffer unmark)
+ (tabulated-list-set-col 0 " " t))
+ (if (buffer-live-p buffer)
+ (push buffer buffers))))
(nreverse buffers)))
(defun Buffer-menu-isearch-buffers ()
(bury-buffer (other-buffer))
(delete-other-windows))
-(defun Buffer-menu-mouse-select (event)
- "Select the buffer whose line you click on."
- (interactive "e")
- (let (buffer)
- (with-current-buffer (window-buffer (posn-window (event-end event)))
- (save-excursion
- (goto-char (posn-point (event-end event)))
- (setq buffer (Buffer-menu-buffer t))))
- (select-window (posn-window (event-end event)))
- (if (and (window-dedicated-p (selected-window))
- (eq (selected-window) (frame-root-window)))
- (switch-to-buffer-other-frame buffer)
- (switch-to-buffer buffer))))
-
(defun Buffer-menu-this-window ()
"Select this line's buffer in this window."
(interactive)
(bury-buffer menu)))
(defun Buffer-menu-toggle-read-only ()
- "Toggle read-only status of buffer on this line, perhaps via version control."
+ "Toggle read-only status of buffer on this line.
+This behaves like invoking \\[toggle-read-only] in that buffer."
(interactive)
- (let (char)
- (with-current-buffer (Buffer-menu-buffer t)
- (toggle-read-only)
- (setq char (if buffer-read-only ?% ?\s)))
- (save-excursion
- (beginning-of-line)
- (forward-char 1)
- (if (/= (following-char) char)
- (let ((inhibit-read-only t))
- (delete-char 1)
- (insert char))))))
+ (let ((read-only
+ (with-current-buffer (Buffer-menu-buffer t)
+ (read-only-mode 'toggle)
+ buffer-read-only)))
+ (tabulated-list-set-col 1 (if read-only "%" " ") t)))
(defun Buffer-menu-bury ()
"Bury the buffer listed on this line."
(interactive)
- (when (Buffer-menu-no-header)
- (save-excursion
- (beginning-of-line)
- (bury-buffer (Buffer-menu-buffer t))
- (let ((line (buffer-substring (point) (progn (forward-line 1) (point))))
- (inhibit-read-only t))
- (delete-region (point) (progn (forward-line -1) (point)))
- (goto-char (point-max))
- (insert line))
- (message "Buried buffer moved to the end"))))
-
+ (let ((buffer (tabulated-list-get-id)))
+ (cond ((null buffer))
+ ((buffer-live-p buffer)
+ (bury-buffer buffer)
+ (save-excursion
+ (let ((elt (tabulated-list-delete-entry)))
+ (goto-char (point-max))
+ (apply 'tabulated-list-print-entry elt)))
+ (message "Buffer buried."))
+ (t
+ (tabulated-list-delete-entry)
+ (message "Buffer is dead; removing from list.")))))
(defun Buffer-menu-view ()
"View this line's buffer in View mode."
(interactive)
(view-buffer (Buffer-menu-buffer t)))
-
(defun Buffer-menu-view-other-window ()
"View this line's buffer in View mode in another window."
(interactive)
(view-buffer-other-window (Buffer-menu-buffer t)))
\f
+;;; Functions for populating the Buffer Menu.
;;;###autoload
-(define-key ctl-x-map "\C-b" 'list-buffers)
-
-;;;###autoload
-(defun list-buffers (&optional files-only)
- "Display a list of names of existing buffers.
-The list is displayed in a buffer named `*Buffer List*'.
-Note that buffers with names starting with spaces are omitted.
-Non-null optional arg FILES-ONLY means mention only file buffers.
-
-For more information, see the function `buffer-menu'."
- (interactive "P")
- (display-buffer (list-buffers-noselect files-only)))
-
-(defconst Buffer-menu-short-ellipsis
- ;; This file is preloaded, so we can't use char-displayable-p here
- ;; because we don't know yet what display we're going to connect to.
- ":" ;; (if (char-displayable-p ?…) "…" ":")
- )
-
-(defun Buffer-menu-buffer+size (name size &optional name-props size-props)
- (if (> (+ (string-width name) (string-width size) 2)
- Buffer-menu-buffer+size-width)
- (setq name
- (let ((tail
- (if (string-match "<[0-9]+>$" name)
- (match-string 0 name)
- "")))
- (concat (truncate-string-to-width
- name
- (- Buffer-menu-buffer+size-width
- (max (string-width size) 3)
- (string-width tail)
- 2))
- Buffer-menu-short-ellipsis
- tail)))
- ;; Don't put properties on (buffer-name).
- (setq name (copy-sequence name)))
- (add-text-properties 0 (length name) name-props name)
- (add-text-properties 0 (length size) size-props size)
- (let ((name+space-width (- Buffer-menu-buffer+size-width
- (string-width size))))
- (concat name
- (propertize (make-string (- name+space-width (string-width name))
- ?\s)
- 'display `(space :align-to
- ,(+ Buffer-menu-buffer-column
- name+space-width)))
- size)))
-
-(defun Buffer-menu-sort (column)
- "Sort the buffer menu by COLUMN."
- (interactive "P")
- (when column
- (setq column (prefix-numeric-value column))
- (if (< column 2) (setq column 2))
- (if (> column 5) (setq column 5)))
- (setq Buffer-menu-sort-column column)
- (let ((inhibit-read-only t) l buf m1 m2)
- (save-excursion
- (Buffer-menu-beginning)
- (while (not (eobp))
- (when (buffer-live-p
- (setq buf (get-text-property
- (+ (point)
- Buffer-menu-buffer-column)
- 'buffer)))
- (setq m1 (char-after)
- m1 (if (memq m1 '(?> ?D)) m1)
- m2 (char-after (+ (point) 2))
- m2 (if (eq m2 ?S) m2))
- (if (or m1 m2)
- (push (list buf m1 m2) l)))
- (forward-line)))
- (revert-buffer)
- (save-excursion
- (Buffer-menu-beginning)
- (while (not (eobp))
- (when (setq buf (assq (get-text-property (+ (point)
- Buffer-menu-buffer-column)
- 'buffer) l))
- (setq m1 (cadr buf)
- m2 (cadr (cdr buf)))
- (when m1
- (delete-char 1)
- (insert m1)
- (backward-char 1))
- (when m2
- (forward-char 2)
- (delete-char 1)
- (insert m2)))
- (forward-line)))))
-
-(defun Buffer-menu-sort-by-column (&optional e)
- "Sort the buffer menu by the column clicked on."
- (interactive (list last-input-event))
- (if e (mouse-select-window e))
- (let* ((pos (event-start e))
- (obj (posn-object pos))
- (col (if obj
- (get-text-property (cdr obj) 'column (car obj))
- (get-text-property (posn-point pos) 'column))))
- (Buffer-menu-sort col)))
-
-(defvar Buffer-menu-sort-button-map
- (let ((map (make-sparse-keymap)))
- ;; This keymap handles both nil and non-nil values for
- ;; Buffer-menu-use-header-line.
- (define-key map [header-line mouse-1] 'Buffer-menu-sort-by-column)
- (define-key map [header-line mouse-2] 'Buffer-menu-sort-by-column)
- (define-key map [mouse-2] 'Buffer-menu-sort-by-column)
- (define-key map [follow-link] 'mouse-face)
- (define-key map "\C-m" 'Buffer-menu-sort-by-column)
- map)
- "Local keymap for Buffer menu sort buttons.")
-
-(defun Buffer-menu-make-sort-button (name column)
- (if (equal column Buffer-menu-sort-column) (setq column nil))
- (propertize name
- 'column column
- 'help-echo (concat
- (if Buffer-menu-use-header-line
- "mouse-1, mouse-2: sort by "
- "mouse-2, RET: sort by ")
- (if column (downcase name) "visited order"))
- 'mouse-face 'highlight
- 'keymap Buffer-menu-sort-button-map))
-
(defun list-buffers-noselect (&optional files-only buffer-list)
- "Create and return a buffer with a list of names of existing buffers.
-The buffer is named `*Buffer List*'.
-Note that buffers with names starting with spaces are omitted.
-Non-null optional arg FILES-ONLY means mention only file buffers.
-
-If BUFFER-LIST is non-nil, it should be a list of buffers;
-it means list those buffers and no others.
-
-For more information, see the function `buffer-menu'."
- (let* ((old-buffer (current-buffer))
- (standard-output standard-output)
- (mode-end (make-string (- Buffer-menu-mode-width 2) ?\s))
- (header (concat "CRM "
- (Buffer-menu-buffer+size
- (Buffer-menu-make-sort-button "Buffer" 2)
- (Buffer-menu-make-sort-button "Size" 3))
- " "
- (Buffer-menu-make-sort-button "Mode" 4) mode-end
- (Buffer-menu-make-sort-button "File" 5) "\n"))
- list desired-point)
- (when Buffer-menu-use-header-line
- (let ((pos 0))
- ;; Turn whitespace chars in the header into stretch specs so
- ;; they work regardless of the header-line face.
- (while (string-match "[ \t\n]+" header pos)
- (setq pos (match-end 0))
- (put-text-property (match-beginning 0) pos 'display
- ;; Assume fixed-size chars in the buffer.
- (list 'space :align-to pos)
- header)))
- ;; Try to better align the one-char headers.
- (put-text-property 0 3 'face 'fixed-pitch header)
- ;; Add a "dummy" leading space to align the beginning of the header
- ;; line with the beginning of the text (rather than with the left
- ;; scrollbar or the left fringe). --Stef
- (setq header (concat (propertize " " 'display '(space :align-to 0))
- header)))
- (with-current-buffer (get-buffer-create "*Buffer List*")
- (setq buffer-read-only nil)
- (erase-buffer)
- (setq standard-output (current-buffer))
- ;; Force L2R direction, to avoid messing the display if the
- ;; first buffer in the list happens to begin with a strong R2L
- ;; character.
- (setq bidi-paragraph-direction 'left-to-right)
- (unless Buffer-menu-use-header-line
- ;; Use U+2014 (EM DASH) to underline if possible, else use ASCII
- ;; (i.e. U+002D, HYPHEN-MINUS).
- (let ((underline (if (char-displayable-p ?\u2014) ?\u2014 ?-)))
- (insert header
- (apply 'string
- (mapcar (lambda (c)
- (if (memq c '(?\n ?\s)) c underline))
- header)))))
- ;; Collect info for every buffer we're interested in.
- (dolist (buffer (or buffer-list
- (buffer-list
- (when Buffer-menu-use-frame-buffer-list
- (selected-frame)))))
- (with-current-buffer buffer
- (let ((name (buffer-name))
- (file buffer-file-name))
- (unless (and (not buffer-list)
- (or
- ;; Don't mention internal buffers.
- (and (string= (substring name 0 1) " ") (null file))
- ;; Maybe don't mention buffers without files.
- (and files-only (not file))
- (string= name "*Buffer List*")))
- ;; Otherwise output info.
- (let ((mode (concat (format-mode-line mode-name nil nil buffer)
- (if mode-line-process
- (format-mode-line mode-line-process
- nil nil buffer))))
- (bits (string
- (if (eq buffer old-buffer) ?. ?\s)
- ;; Handle readonly status. The output buffer
- ;; is special cased to appear readonly; it is
- ;; actually made so at a later date.
- (if (or (eq buffer standard-output)
- buffer-read-only)
- ?% ?\s)
- ;; Identify modified buffers.
- (if (buffer-modified-p) ?* ?\s)
- ;; Space separator.
- ?\s)))
- (unless file
- ;; No visited file. Check local value of
- ;; list-buffers-directory and, for Info buffers,
- ;; Info-current-file.
- (cond ((and (boundp 'list-buffers-directory)
- list-buffers-directory)
- (setq file list-buffers-directory))
- ((eq major-mode 'Info-mode)
- (setq file Info-current-file)
- (cond
- ((equal file "dir")
- (setq file "*Info Directory*"))
- ((eq file 'apropos)
- (setq file "*Info Apropos*"))
- ((eq file 'history)
- (setq file "*Info History*"))
- ((eq file 'toc)
- (setq file "*Info TOC*"))
- ((not (stringp file)) ;; avoid errors
- (setq file nil))
- (t
- (setq file (concat "("
- (file-name-nondirectory file)
- ") "
- Info-current-node)))))))
- (push (list buffer bits name (buffer-size) mode file)
- list))))))
- ;; Preserve the original buffer-list ordering, just in case.
- (setq list (nreverse list))
- ;; Place the buffers's info in the output buffer, sorted if necessary.
- (dolist (buffer
- (if Buffer-menu-sort-column
- (sort list
- (if (eq Buffer-menu-sort-column 3)
- (lambda (a b)
- (< (nth Buffer-menu-sort-column a)
- (nth Buffer-menu-sort-column b)))
- (lambda (a b)
- (string< (nth Buffer-menu-sort-column a)
- (nth Buffer-menu-sort-column b)))))
- list))
- (if (eq (car buffer) old-buffer)
- (setq desired-point (point)))
- (insert (cadr buffer)
- ;; Put the buffer name into a text property
- ;; so we don't have to extract it from the text.
- ;; This way we avoid problems with unusual buffer names.
- (let ((name (nth 2 buffer))
- (size (int-to-string (nth 3 buffer))))
- (Buffer-menu-buffer+size name size
- `(buffer-name ,name
- buffer ,(car buffer)
- font-lock-face buffer-menu-buffer
- mouse-face highlight
- help-echo
- ,(if (>= (length name)
- (- Buffer-menu-buffer+size-width
- (max (length size) 3)
- 2))
- name
- "mouse-2: select this buffer"))))
- " "
- (if (> (string-width (nth 4 buffer)) Buffer-menu-mode-width)
- (truncate-string-to-width (nth 4 buffer)
- Buffer-menu-mode-width)
- (nth 4 buffer)))
- (when (nth 5 buffer)
- (indent-to (+ Buffer-menu-buffer-column Buffer-menu-buffer+size-width
- Buffer-menu-mode-width 4) 1)
- (princ (abbreviate-file-name (nth 5 buffer))))
- (princ "\n"))
+ "Create and return a Buffer Menu buffer.
+This is called by `buffer-menu' and others as a subroutine.
+
+If FILES-ONLY is non-nil, show only file-visiting buffers.
+If BUFFER-LIST is non-nil, it should be a list of buffers; it
+means list those buffers and no others."
+ (let ((old-buffer (current-buffer))
+ (buffer (get-buffer-create "*Buffer List*")))
+ (with-current-buffer buffer
(Buffer-menu-mode)
- (when Buffer-menu-use-header-line
- (setq header-line-format header))
- ;; DESIRED-POINT doesn't have to be set; it is not when the
- ;; current buffer is not displayed for some reason.
- (and desired-point
- (goto-char desired-point))
- (setq Buffer-menu-files-only files-only)
- (setq Buffer-menu--buffers buffer-list)
- (set-buffer-modified-p nil)
- (current-buffer))))
+ (setq Buffer-menu-files-only
+ (and files-only (>= (prefix-numeric-value files-only) 0)))
+ (list-buffers--refresh buffer-list old-buffer)
+ (tabulated-list-print))
+ buffer))
+
+(defun Buffer-menu-mouse-select (event)
+ "Select the buffer whose line you click on."
+ (interactive "e")
+ (select-window (posn-window (event-end event)))
+ (let ((buffer (tabulated-list-get-id (posn-point (event-end event)))))
+ (when (buffer-live-p buffer)
+ (if (and (window-dedicated-p (selected-window))
+ (eq (selected-window) (frame-root-window)))
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer)))))
+
+(defun list-buffers--refresh (&optional buffer-list old-buffer)
+ ;; Set up `tabulated-list-format'.
+ (let ((name-width Buffer-menu-name-width)
+ (size-width Buffer-menu-size-width))
+ ;; Handle obsolete variable:
+ (if Buffer-menu-buffer+size-width
+ (setq name-width (- Buffer-menu-buffer+size-width size-width)))
+ (setq tabulated-list-format
+ (vector '("C" 1 t :pad-right 0)
+ '("R" 1 t :pad-right 0)
+ '("M" 1 t)
+ `("Buffer" ,name-width t)
+ `("Size" ,size-width tabulated-list-entry-size->
+ :right-align t)
+ `("Mode" ,Buffer-menu-mode-width t)
+ '("File" 1 t))))
+ (setq tabulated-list-use-header-line Buffer-menu-use-header-line)
+ ;; Collect info for each buffer we're interested in.
+ (let ((buffer-menu-buffer (current-buffer))
+ (show-non-file (not Buffer-menu-files-only))
+ entries)
+ (dolist (buffer (or buffer-list
+ (buffer-list (if Buffer-menu-use-frame-buffer-list
+ (selected-frame)))))
+ (with-current-buffer buffer
+ (let* ((name (buffer-name))
+ (file buffer-file-name))
+ (when (and (buffer-live-p buffer)
+ (or buffer-list
+ (and (not (string= (substring name 0 1) " "))
+ (not (eq buffer buffer-menu-buffer))
+ (or file show-non-file))))
+ (push (list buffer
+ (vector (if (eq buffer old-buffer) "." " ")
+ (if buffer-read-only "%" " ")
+ (if (buffer-modified-p) "*" " ")
+ (Buffer-menu--pretty-name name)
+ (number-to-string (buffer-size))
+ (concat (format-mode-line mode-name nil nil buffer)
+ (if mode-line-process
+ (format-mode-line mode-line-process
+ nil nil buffer)))
+ (Buffer-menu--pretty-file-name file)))
+ entries)))))
+ (setq tabulated-list-entries (nreverse entries)))
+ (tabulated-list-init-header))
+
+(defun tabulated-list-entry-size-> (entry1 entry2)
+ (> (string-to-number (aref (cadr entry1) 4))
+ (string-to-number (aref (cadr entry2) 4))))
+
+(defun Buffer-menu--pretty-name (name)
+ (propertize name
+ 'font-lock-face 'buffer-menu-buffer
+ 'mouse-face 'highlight))
+
+(defun Buffer-menu--pretty-file-name (file)
+ (cond (file
+ (abbreviate-file-name file))
+ ((and (boundp 'list-buffers-directory)
+ list-buffers-directory)
+ list-buffers-directory)
+ ((eq major-mode 'Info-mode)
+ (Buffer-menu-info-node-description Info-current-file))
+ (t "")))
+
+(defun Buffer-menu-info-node-description (file)
+ (cond
+ ((equal file "dir") "*Info Directory*")
+ ((eq file 'apropos) "*Info Apropos*")
+ ((eq file 'history) "*Info History*")
+ ((eq file 'toc) "*Info TOC*")
+ ((not (stringp file)) "") ; Avoid errors
+ (t
+ (concat "(" (file-name-nondirectory file) ") " Info-current-node))))
;;; buff-menu.el ends here
Summary of changes to "Calc"
------- -- ------- -- ----
+Emacs 24.3
+
+Algebraic simplification mode is now the default.
+To restrict to the limited simplifications given by the former
+default simplification mode, use `m I'.
+
Emacs 24.1
* Support for musical notes added.
;;;###autoload
(defun calc-alg-entry (&optional initial prompt)
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(calc-plain-entry t)
;; math-simplify-step, which is called by math-simplify.
(defvar math-top-only)
+;; math-normalize-error is declared in calc.el.
+(defvar math-normalize-error)
(defun math-simplify (top-expr)
(let ((math-simplifying t)
(math-top-only (consp calc-simplify-mode))
(calc-with-default-simplification
(while (let ((r simp-rules))
(setq res (math-normalize top-expr))
- (while r
- (setq res (math-rewrite res (car r))
- r (cdr r)))
- (not (equal top-expr (setq res (math-simplify-step res)))))
+ (if (not math-normalize-error)
+ (progn
+ (while r
+ (setq res (math-rewrite res (car r))
+ r (cdr r)))
+ (not (equal top-expr (setq res (math-simplify-step res)))))))
(setq top-expr res)))))
top-expr)
(not (Math-realp (nth 1 math-simplify-expr))))
(math-common-constant-factor (nth 1 math-simplify-expr))))
(if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
- (progn
+ (unless (and (eq (car-safe math-simplify-expr) 'calcFunc-eq)
+ (eq (car-safe (nth 1 math-simplify-expr)) 'var)
+ (not (math-expr-contains (nth 2 math-simplify-expr)
+ (nth 1 math-simplify-expr))))
(setcar (cdr math-simplify-expr)
(math-mul (nth 2 nn) (nth 1 math-simplify-expr)))
(setcar (cdr (cdr math-simplify-expr))
4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973
4987 4993 4999 5003])
-;; The variable math-prime-factors-finished is set by calcFunc-prfac to
+;; The variable math-prime-factors-finished is set by calcFunc-prfac to
;; indicate whether factoring is complete, and used by calcFunc-factors,
;; calcFunc-totient and calcFunc-moebius.
(defvar math-prime-factors-finished)
(while (<= (length math-stirling-local-cache) n)
(let ((i (1- (length math-stirling-local-cache)))
row)
- (setq math-stirling-local-cache
- (vconcat math-stirling-local-cache
+ (setq math-stirling-local-cache
+ (vconcat math-stirling-local-cache
(make-vector (length math-stirling-local-cache) nil)))
(aset math-stirling-cache k math-stirling-local-cache)
(while (< (setq i (1+ i)) (length math-stirling-local-cache))
(let ((i 200))
(while (> (setq i (1- i)) 0)
(math-random-base))))
- (random t)
(setq var-RandSeed nil
math-random-cache nil
math-random-shift -4) ; assume RAND_MAX >= 16383
(i (/ (+ n slop) 3))
(rnum 0))
(while (> i 0)
- (setq rnum
+ (setq rnum
(math-add
(math-random-three-digit-number)
(math-mul rnum 1000)))
(setq sum (%
(+
sum
- (calcFunc-mod
+ (calcFunc-mod
q 1000000))
111111))
- (setq q
- (math-quotient
+ (setq q
+ (math-quotient
q 1000000)))
(cond ((= (% sum 3) 0) '(nil 3))
((= (% sum 7) 0) '(nil 7))
(declare-function math-vector-is-string "calccomp" (a))
(declare-function math-vector-to-string "calccomp" (a &optional quoted))
(declare-function math-format-radix-float "calc-bin" (a prec))
-(declare-function math-compose-expr "calccomp" (a prec))
+(declare-function math-compose-expr "calccomp" (a prec &optional div))
(declare-function math-abs "calc-arith" (a))
(declare-function math-format-bignum-binary "calc-bin" (a))
(declare-function math-format-bignum-octal "calc-bin" (a))
(define-key calc-mode-map "mD" 'calc-default-simplify-mode)
(define-key calc-mode-map "mE" 'calc-ext-simplify-mode)
(define-key calc-mode-map "mF" 'calc-settings-file-name)
+ (define-key calc-mode-map "mI" 'calc-basic-simplify-mode)
(define-key calc-mode-map "mM" 'calc-more-recursion-depth)
(define-key calc-mode-map "mN" 'calc-num-simplify-mode)
(define-key calc-mode-map "mO" 'calc-no-simplify-mode)
("calc-mode" calc-alg-simplify-mode calc-algebraic-mode
calc-always-load-extensions calc-auto-recompute calc-auto-why
-calc-bin-simplify-mode calc-break-vectors calc-center-justify
-calc-default-simplify-mode calc-display-raw calc-eng-notation
-calc-ext-simplify-mode calc-fix-notation calc-full-trail-vectors
-calc-full-vectors calc-get-modes calc-group-char calc-group-digits
-calc-infinite-mode calc-left-justify calc-left-label
+calc-basic-simplify-mode calc-bin-simplify-mode calc-break-vectors
+calc-center-justify calc-default-simplify-mode calc-display-raw
+calc-eng-notation calc-ext-simplify-mode calc-fix-notation
+calc-full-trail-vectors calc-full-vectors calc-get-modes calc-group-char
+calc-group-digits calc-infinite-mode calc-left-justify calc-left-label
calc-line-breaking calc-line-numbering calc-matrix-brackets
calc-matrix-center-justify calc-matrix-left-justify calc-matrix-mode
calc-matrix-right-justify calc-mode-record-mode calc-no-simplify-mode
(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]
(substring str i))))
str))
-;;; Users can redefine this in their .emacs files.
+;;; Users can redefine this in their init files.
(defvar calc-keypad-user-menu nil
"If non-nil, this describes an additional menu for calc-keypad.
It should contain a list of three rows.
(defun math-this-year ()
- (string-to-number (substring (current-time-string) -4)))
+ (nth 5 (decode-time)))
(defun math-leap-year-p (year)
(if (Math-lessp year 1752)
(car res))))))))
-;;; It is safe to redefine these in your .emacs file to use a different
+;;; It is safe to redefine these in your init file to use a different
;;; language.
(defvar math-long-weekday-names '( "Sunday" "Monday" "Tuesday" "Wednesday"
'("Deg, Rad, HMS; Frac; Polar; Inf; Alg, Total; Symb; Vec/mat"
"Working; Xtensions; Mode-save; preserve Embedded modes"
"SHIFT + Shifted-prefixes, mode-Filename; Record; reCompute"
- "SHIFT + simplify: Off, Num, Default, Bin, Alg, Ext, Units")
+ "SHIFT + simplify: Off, Num, basIc, Algebraic, Bin, Ext, Units")
"mode" ?m))
( asin . calcFunc-arcsin )
( asinh . calcFunc-arcsinh )
( atan . calcFunc-arctan )
- ( atan2 . calcFunc-arctan2 )
- ( atanh . calcFunc-arctanh )))
+ ( atan2 . calcFunc-arctan2 )
+ ( atanh . calcFunc-arctanh )
+ ( fma . (math-C-parse-fma))
+ ( fmax . calcFunc-max )
+ ( j0 . (math-C-parse-bess))
+ ( jn . calcFunc-besJ )
+ ( j1 . (math-C-parse-bess))
+ ( yn . calcFunc-besY )
+ ( y0 . (math-C-parse-bess))
+ ( y1 . (math-C-parse-bess))
+ ( tgamma . calcFunc-gamma )))
+
+(defun math-C-parse-bess (f val)
+ "Parse C's j0, j1, y0, y1 functions."
+ (let ((args (math-read-expr-list)))
+ (math-read-token)
+ (append
+ (cond ((eq val 'j0) '(calcFunc-besJ 0))
+ ((eq val 'j1) '(calcFunc-besJ 1))
+ ((eq val 'y0) '(calcFunc-besY 0))
+ ((eq val 'y1) '(calcFunc-besY 1)))
+ args)))
+
+(defun math-C-parse-fma (f val)
+ "Parse C's fma function fma(x,y,z) => (x * y + z)."
+ (let ((args (math-read-expr-list)))
+ (math-read-token)
+ (list 'calcFunc-add
+ (list 'calcFunc-mul
+ (nth 0 args)
+ (nth 1 args))
+ (nth 2 args))))
+
(put 'c 'math-variable-table
'( ( M_PI . var-pi )
(defun calc-apply (&optional oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(oper (or oper (calc-get-operator "Apply"
(defun calc-reduce (&optional oper accum)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (nest (calc-is-hyperbolic))
+ (let* ((nest (calc-is-hyperbolic))
(rev (calc-is-inverse))
(nargs (if (and nest (not rev)) 2 1))
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(calc-mapping-dir (and (not accum) (not nest) ""))
(defun calc-map (&optional oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(calc-mapping-dir "")
(defun calc-map-equation (&optional oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(oper (or oper (calc-get-operator "Map-equation")))
(defun calc-outer-product (&optional oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(oper (or oper (calc-get-operator "Outer" 2))))
(defun calc-inner-product (&optional mul-oper add-oper)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(mul-oper (or mul-oper (calc-get-operator "Inner (Mult)" 2)))
: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
: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
(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]
(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
- "Default simplifications enabled")))
+ "Algebraic simplification occurs by default")))
(defun calc-no-simplify-mode (arg)
(interactive "P")
(calc-wrapper
(calc-set-simplify-mode 'none arg
- "All default simplifications are disabled")))
+ "Simplification is disabled")))
(defun calc-num-simplify-mode (arg)
(interactive "P")
(calc-wrapper
(calc-set-simplify-mode 'num arg
- "Default simplifications apply only if arguments are numeric")))
+ "Basic simplifications apply only if arguments are numeric")))
(defun calc-default-simplify-mode (arg)
- (interactive "p")
- (cond ((= arg 1)
+ (interactive "P")
+ (cond ((or (not arg) (= arg 3))
+ (calc-wrapper
+ (calc-set-simplify-mode
+ 'alg nil "Algebraic simplification occurs by default")))
+ ((= arg 1)
(calc-wrapper
(calc-set-simplify-mode
- nil nil "Usual default simplifications are enabled")))
+ nil nil "Only basic simplifications occur by default")))
((= arg 0) (calc-num-simplify-mode 1))
((< arg 0) (calc-no-simplify-mode 1))
((= arg 2) (calc-bin-simplify-mode 1))
- ((= arg 3) (calc-alg-simplify-mode 1))
((= arg 4) (calc-ext-simplify-mode 1))
((= arg 5) (calc-units-simplify-mode 1))
(t (error "Prefix argument out of range"))))
(format "Binary simplification occurs by default (word size=%d)"
calc-word-size))))
+(defun calc-basic-simplify-mode (arg)
+ (interactive "P")
+ (calc-wrapper
+ (calc-set-simplify-mode nil arg
+ "Only basic simplifications occur by default")))
+
(defun calc-alg-simplify-mode (arg)
(interactive "P")
(calc-wrapper
(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)
(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)
(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
(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)
(defun calc-store-map (&optional oper var)
(interactive)
(calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
+ (let* ((calc-dollar-values (mapcar #'calc-get-stack-element
(nthcdr calc-stack-top calc-stack)))
(calc-dollar-used 0)
(oper (or oper (calc-get-operator "Store Mapping")))
(defvar math-additional-units nil
- "*Additional units table for user-defined units.
+ "Additional units table for user-defined units.
Must be formatted like `math-standard-units'.
If you change this, be sure to set `math-units-table' to nil to ensure
that the combined units table will be rebuilt.")
(math-to-standard-units (calc-top-n 1)
nil))))))
+(defvar calc-ensure-consistent-units)
+
(defun calc-quick-units ()
(interactive)
(calc-slow-wrapper
(unless (< pos (length units))
(error "Unit number %d not defined" pos))
(if (math-units-in-expr-p expr nil)
- (calc-enter-result 1 (format "cun%d" num)
- (math-convert-units expr (nth pos units)))
+ (progn
+ (if calc-ensure-consistent-units
+ (math-check-unit-consistency expr (nth pos units)))
+ (calc-enter-result 1 (format "cun%d" num)
+ (math-convert-units expr (nth pos units))))
(calc-enter-result 1 (format "*un%d" num)
(math-simplify-units
(math-mul expr (nth pos units))))))))
(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)
(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)
(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)))
- (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")
(defun calc-extract-units ()
(interactive)
(calc-slow-wrapper
- (calc-enter-result 1 "rmun" (math-simplify-units
+ (calc-enter-result 1 "exun" (math-simplify-units
(math-extract-units (calc-top-n 1))))))
;; The variables calc-num-units and calc-den-units are local to
(math-single-units-in-expr-p (nth 1 expr))))
(t 'wrong)))
+(defun math-consistent-units-p (expr newunits)
+ "Non-nil if EXPR and NEWUNITS have consistent units."
+ (or
+ (and (eq (car-safe newunits) 'var)
+ (assq (nth 1 newunits) math-standard-units-systems))
+ (math-numberp (math-get-units (list '/ expr newunits)))))
+
+(defun math-check-unit-consistency (expr units)
+ "Give an error if EXPR and UNITS do not have consistent units."
+ (unless (math-consistent-units-p expr units)
+ (error "New units (%s) are inconsistent with current units (%s)"
+ (math-format-value units)
+ (math-format-value (math-get-units expr)))))
+
(defun math-check-unit-name (v)
(and (eq (car-safe v) 'var)
(or (assq (nth 1 v) (or math-units-table (math-build-units-table)))
(declare-function calc-div-fractions "calc-frac" (a b))
(declare-function math-div-objects-fancy "calc-arith" (a b))
(declare-function math-div-symb-fancy "calc-arith" (a b))
-(declare-function math-compose-expr "calccomp" (a prec))
+(declare-function math-compose-expr "calccomp" (a prec &optional div))
(declare-function math-comp-width "calccomp" (c))
(declare-function math-composition-to-string "calccomp" (c &optional width))
(declare-function math-stack-value-offset-fancy "calccomp" ())
(defgroup calc nil
- "GNU Calc."
+ "Advanced desk calculator and mathematical tool."
:prefix "calc-"
:tag "Calc"
:group 'applications)
:group 'calc
:type 'boolean)
+(defcustom calc-ensure-consistent-units
+ nil
+ "If non-nil, make sure new units are consistent with current units
+when converting units."
+ :group 'calc
+ :type 'boolean)
+
(defcustom calc-undo-length
100
"The number of undo steps that will be preserved when Calc is quit."
(defcalcmodevar calc-previous-modulo nil
"Most recently used value of M in a modulo form.")
-(defcalcmodevar calc-simplify-mode nil
+(defcalcmodevar calc-simplify-mode 'alg
"Type of simplification applied to results.
If `none', results are not simplified when pushed on the stack.
If `num', functions are simplified only when args are constant.
-If nil, only fast simplifications are applied.
+If nil, only limited simplifications are applied.
If `binary', `math-clip' is applied if appropriate.
If `alg', `math-simplify' is applied.
If `ext', `math-simplify-extended' is applied.
Used by `calc-user-invocation'.")
(defcalcmodevar calc-show-banner t
- "*If non-nil, show a friendly greeting above the stack.")
+ "If non-nil, show a friendly greeting above the stack.")
(defconst calc-local-var-list '(calc-stack
calc-stack-top
(defvar calc-embedded-mode-hook nil
"Hook run when starting embedded mode.")
-;; Set up the autoloading linkage.
-(let ((name (and (fboundp 'calc-dispatch)
- (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload)
- (nth 1 (symbol-function 'calc-dispatch))))
- (p load-path))
-
- ;; If Calc files exist on the load-path, we're all set.
- (while (and p (not (file-exists-p
- (expand-file-name "calc-misc.elc" (car p)))))
- (setq p (cdr p)))
- (or p
-
- ;; If Calc is autoloaded using a path name, look there for Calc files.
- ;; This works for both relative ("calc/calc.elc") and absolute paths.
- (and name (file-name-directory name)
- (let ((p2 load-path)
- (name2 (concat (file-name-directory name)
- "calc-misc.elc")))
- (while (and p2 (not (file-exists-p
- (expand-file-name name2 (car p2)))))
- (setq p2 (cdr p2)))
- (when p2
- (setq load-path (nconc load-path
- (list
- (directory-file-name
- (file-name-directory
- (expand-file-name
- name (car p2))))))))))))
-
;; The following modes use specially-formatted data.
(put 'calc-mode 'mode-class 'special)
(put 'calc-trail-mode 'mode-class 'special)
\\{calc-mode-map}
"
(interactive)
- (mapc (function
+ (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!?
(lambda (v) (set-default v (symbol-value v)))) calc-local-var-list)
(kill-all-local-variables)
(use-local-map (if (eq calc-algebraic-mode 'total)
(progn (require 'calc-ext) calc-alg-map) calc-mode-map))
- (mapc (function (lambda (v) (make-local-variable v))) calc-local-var-list)
+ (mapc #'make-local-variable calc-local-var-list)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(if calc-buffer-list (setq calc-stack (copy-sequence calc-stack)))
(add-to-list 'calc-buffer-list (current-buffer) t))
-(defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks
+(defvar calc-check-defines 'calc-check-defines) ; Suitable for run-hooks.
(defun calc-check-defines ()
(if (symbol-plist 'calc-define)
(let ((plist (copy-sequence (symbol-plist 'calc-define))))
((eq calc-simplify-mode 'num) "NumSimp ")
((eq calc-simplify-mode 'binary)
(format "BinSimp%d " calc-word-size))
- ((eq calc-simplify-mode 'alg) "AlgSimp ")
+ ((eq calc-simplify-mode 'alg) "")
((eq calc-simplify-mode 'ext) "ExtSimp ")
((eq calc-simplify-mode 'units) "UnitSimp ")
- (t ""))
+ (t "BasicSimp "))
;; Display modes
(cond ((= calc-number-radix 10) "")
(delete-region (point) (point-max))))
(calc-set-command-flag 'renum-stack))))))
-(defvar sel-mode)
-(defun calc-get-stack-element (x)
+(defun calc-get-stack-element (x &optional sel-mode)
(cond ((eq sel-mode 'entry)
x)
((eq sel-mode 'sel)
(defun calc-top (&optional n sel-mode)
(or n (setq n 1))
(calc-check-stack n)
- (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack)))
+ (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack) sel-mode))
-(defun calc-top-n (&optional n sel-mode) ; in case precision has changed
+(defun calc-top-n (&optional n sel-mode) ; In case precision has changed.
(math-check-complete (calc-normalize (calc-top n sel-mode))))
(defun calc-top-list (&optional n m sel-mode)
(let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1)
calc-stack))))
(setcdr (nthcdr (1- n) top) nil)
- (nreverse (mapcar 'calc-get-stack-element top)))))
+ (nreverse
+ (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top)))))
(defun calc-top-list-n (&optional n m sel-mode)
(mapcar 'math-check-complete
;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public]
(defvar math-normalize-a)
+(defvar math-normalize-error nil
+ "Non-nil if the last call the `math-normalize' returned an error.")
+
(defun math-normalize (math-normalize-a)
+ (setq math-normalize-error nil)
(cond
((not (consp math-normalize-a))
(if (integerp math-normalize-a)
(fboundp (car math-normalize-a))))
(apply (car math-normalize-a) args)))))
(wrong-number-of-arguments
+ (setq math-normalize-error t)
(calc-record-why "*Wrong number of arguments"
(cons (car math-normalize-a) args))
nil)
(wrong-type-argument
+ (setq math-normalize-error t)
(or calc-next-why
(calc-record-why "Wrong type of argument"
(cons (car math-normalize-a) args)))
nil)
(args-out-of-range
+ (setq math-normalize-error t)
(calc-record-why "*Argument out of range"
(cons (car math-normalize-a) args))
nil)
(inexact-result
+ (setq math-normalize-error t)
(calc-record-why "No exact representation for result"
(cons (car math-normalize-a) args))
nil)
(math-overflow
+ (setq math-normalize-error t)
(calc-record-why "*Floating-point overflow occurred"
(cons (car math-normalize-a) args))
nil)
(math-underflow
+ (setq math-normalize-error t)
(calc-record-why "*Floating-point underflow occurred"
(cons (car math-normalize-a) args))
nil)
(void-variable
+ (setq math-normalize-error t)
(if (eq (nth 1 err) 'var-EvalRules)
(progn
(setq var-EvalRules nil)
(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;
(setq sn (math-to-underscores sn)))
sn)))
-(defun math-compose-expr (a prec)
- (let ((math-compose-level (1+ math-compose-level))
+;;; Give multiplication precedence 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
(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) '/)
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 ")")))
;;; History:
;; I hate history.
-(eval-when-compile (require 'cl))
-
;;;=====================================================================
;;; Customization:
(cond
((not (get-buffer-window calculator-buffer))
(let ((window-min-height 2))
- ;; maybe leave two lines for our window because of the normal
- ;; `raised' modeline in Emacs 21
+ ;; maybe leave two lines for our window because of the
+ ;; normal `raised' mode line
(select-window
(split-window-below
- ;; If the modeline might interfere with the calculator buffer,
- ;; use 3 lines instead.
+ ;; If the mode line might interfere with the calculator
+ ;; buffer, use 3 lines instead.
(if (and (fboundp 'face-attr-construct)
(let* ((dh (plist-get (face-attr-construct 'default) :height))
- (mf (face-attr-construct 'modeline))
+ (mf (face-attr-construct 'mode-line))
(mh (plist-get mf :height)))
- ;; If the modeline is shorter than the default,
+ ;; If the mode line is shorter than the default,
;; stick with 2 lines. (It may be necessary to
;; check how much shorter.)
(and
(not (integerp mh))
(< mh 1))))
(or
- ;; If the modeline is taller than the default,
+ ;; If the mode line is taller than the default,
;; use 3 lines.
(and (integerp dh)
(integerp mh)
(and (numberp mh)
(not (integerp mh))
(> mh 1))
- ;; If the modeline has a box with non-negative line-width,
+ ;; If the mode line has a box with non-negative line-width,
;; use 3 lines.
(let* ((bx (plist-get mf :box))
(lh (plist-get bx :line-width)))
(or
(not lh)
(> lh 0))))
- ;; If the modeline has an overline, use 3 lines.
- (plist-get (face-attr-construct 'modeline) :overline)))))
+ ;; If the mode line has an overline, use 3 lines.
+ (plist-get (face-attr-construct 'mode-line) :overline)))))
-3 -2)))
(switch-to-buffer calculator-buffer)))
((not (eq (current-buffer) calculator-buffer))
(string :tag "Sat"))
:group 'calendar-html)
+(defcustom cal-html-holidays t
+ "If non-nil, include holidays as well as diary entries."
+ :version "24.3"
+ :type 'boolean
+ :group 'calendar-html)
+
(defcustom cal-html-css-default
(concat
"<STYLE TYPE=\"text/css\">\n"
" SPAN.NO-YEAR { color: #0b3; font-weight: bold; }\n"
" SPAN.ANN { color: #0bb; font-weight: bold; }\n"
" SPAN.BLOCK { color: #048; font-style: italic; }\n"
+ " SPAN.HOLIDAY { color: #f00; font-weight: bold; }\n"
"</STYLE>\n\n")
"Default cal-html css style. You can override this with a \"cal.css\" file."
:type 'string
+ :version "24.3" ; added SPAN.HOLIDAY
:group 'calendar-html)
;;; End customizable variables.
;;------------------------------------------------------------
;; minical: a small month calendar with links
;;------------------------------------------------------------
+(autoload 'holiday-in-range "holidays")
+
(defun cal-html-insert-minical (month year)
"Insert a minical for numeric MONTH of YEAR."
(let* ((blank-days ; at start of month
""))
-(defun cal-html-htmlify-entry (entry)
- "Convert a diary entry ENTRY to html with the appropriate class specifier."
+(defun cal-html-htmlify-entry (entry &optional class)
+ "Convert a diary entry ENTRY to html with the appropriate class specifier.
+Optional argument CLASS is the class specifier to use."
(let ((start
(cond
+ (class)
((string-match "block" (nth 2 entry)) "BLOCK")
((string-match "anniversary" (nth 2 entry)) "ANN")
((not (string-match
(cal-html-htmlify-string (cadr entry)))))
-(defun cal-html-htmlify-list (date-list date)
+(defun cal-html-htmlify-list (date-list date &optional holidays)
"Return a string of concatenated, HTML-ified diary entries.
-DATE-LIST is a list of diary entries. Return only those matching DATE."
- (mapconcat (lambda (x) (cal-html-htmlify-entry x))
+DATE-LIST is a list of diary entries. Return only those matching DATE.
+Optional argument HOLIDAYS non-nil means the input is actually a list
+of holidays, rather than diary entries."
+ (mapconcat (lambda (x) (cal-html-htmlify-entry x (if holidays "HOLIDAY")))
(let (result)
(dolist (p date-list (reverse result))
(and (car p)
(diary-list-entries (calendar-gregorian-from-absolute d1)
(1+ (- d2 d1)) t))
-
-(defun cal-html-insert-agenda-days (month year diary-list)
+(defun cal-html-insert-agenda-days (month year diary-list holiday-list)
"Insert HTML commands for a range of days in monthly calendars.
HTML commands are inserted for the days of the numeric MONTH in
-four-digit YEAR. Diary entries in DIARY-LIST are included."
+four-digit YEAR. Includes diary entries in DIARY-LIST, and
+holidays in HOLIDAY-LIST."
(let ((blank-days ; at start of month
(mod (- (calendar-day-of-week (list month 1 year))
calendar-week-start-day)
cal-html-e-tableheader-string
;; Diary entries.
cal-html-b-tabledata-string
+ (cal-html-htmlify-list holiday-list date t)
+ (if (and holiday-list diary-list) "<BR>\n" "")
(cal-html-htmlify-list diary-list date)
cal-html-e-tabledata-string
cal-html-e-tablerow-string)
(defun cal-html-one-month (month year dir)
"Write an HTML calendar file for numeric MONTH of YEAR in directory DIR."
- (let ((diary-list (cal-html-list-diary-entries
- (calendar-absolute-from-gregorian (list month 1 year))
- (calendar-absolute-from-gregorian
+ (let* ((d1 (calendar-absolute-from-gregorian (list month 1 year)))
+ (d2 (calendar-absolute-from-gregorian
(list month
(calendar-last-day-of-month month year)
- year)))))
+ year)))
+ (diary-list (cal-html-list-diary-entries d1 d2))
+ (holiday-list (if cal-html-holidays (holiday-in-range d1 d2))))
(with-temp-buffer
(insert cal-html-b-document-string)
(cal-html-insert-month-header month year)
- (cal-html-insert-agenda-days month year diary-list)
+ (cal-html-insert-agenda-days month year diary-list holiday-list)
(insert cal-html-e-document-string)
(write-file (expand-file-name
(cal-html-monthpage-name month year) dir)))))
;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
-;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
;; Author: Steve Fisk <fisk@bowdoin.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
"LaTeX code to insert one box with date info in calendar.
This definition is the heart of the calendar!")
-(autoload 'calendar-holiday-list "holidays")
-
-(defun cal-tex-list-holidays (d1 d2)
- "Generate a list of all holidays from absolute date D1 to D2."
- (let* ((start (calendar-gregorian-from-absolute d1))
- (displayed-month (calendar-extract-month start))
- (displayed-year (calendar-extract-year start))
- (end (calendar-gregorian-from-absolute d2))
- (end-month (calendar-extract-month end))
- (end-year (calendar-extract-year end))
- (number-of-intervals
- (1+ (/ (calendar-interval displayed-month displayed-year
- end-month end-year)
- 3)))
- holidays in-range a)
- (calendar-increment-month displayed-month displayed-year 1)
- (dotimes (_idummy number-of-intervals)
- (setq holidays (append holidays (calendar-holiday-list)))
- (calendar-increment-month displayed-month displayed-year 3))
- (dolist (hol holidays)
- (and (car hol)
- (setq a (calendar-absolute-from-gregorian (car hol)))
- (and (<= d1 a) (<= a d2))
- (setq in-range (append (list hol) in-range))))
- in-range))
+(defconst cal-tex-lefthead
+ "\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}\n"
+ "LaTeX code for left header.")
+
+(defconst cal-tex-righthead
+ "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}\n"
+ "LaTeX code for right header.")
+
+(autoload 'holiday-in-range "holidays")
+
+(define-obsolete-function-alias 'cal-tex-list-holidays 'holiday-in-range "24.3")
(autoload 'diary-list-entries "diary-lib")
"Insert the LaTeX calendar preamble into `cal-tex-buffer'.
Preamble includes initial definitions for various LaTeX commands.
Optional string ARGS are included as options for the article document class."
- ;; FIXME use generate-new-buffer, and adjust cal-tex-end-document.
- (set-buffer (get-buffer-create cal-tex-buffer))
+ (set-buffer (generate-new-buffer cal-tex-buffer))
(insert (format "\\documentclass%s{article}\n"
(if (stringp args)
(format "[%s]" args)
"")))
(if (stringp cal-tex-preamble-extra)
(insert cal-tex-preamble-extra "\n"))
+ ;; FIXME boxwidth and boxheight unused?
(insert "\\hbadness 20000
\\hfuzz=1000pt
\\vbadness 20000
(run-hooks 'cal-tex-year-hook))
(run-hooks 'cal-tex-hook))
+
+(defun cal-tex-filofax-paper (&optional year)
+ "Insert some page size settings for filofax layouts."
+ (insert "\\textwidth 3.25in
+\\textheight 6.5in
+\\headheight -0.875in
+\\topmargin 0pt
+")
+ (insert
+ ;; Why is this one subtly different? Who knows...
+ (if year "\\oddsidemargin 1.675in
+\\evensidemargin 1.675in
+"
+ "\\oddsidemargin 1.75in
+\\evensidemargin 1.5in
+\\headsep 0.125in
+\\footskip 0.125in
+")))
+
+(defun cal-tex-longday (funcname height)
+ "Insert LaTeX code for a long day function."
+ (insert "\\long\\def\\" funcname "#1#2#3#4#5{%
+ \\rule{\\textwidth}{0.3pt}\\\\%
+ \\hbox to \\textwidth{%
+ \\vbox to " height "{%
+ \\vspace*{2pt}%
+ \\hbox to \\textwidth{"
+ (if (string-equal funcname "leftday")
+ "\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%\n"
+ "\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%\n")
+ " \\hbox to \\textwidth{\\vbox {\\"
+ (if (string-equal funcname "leftday") "noindent" "raggedleft")
+ " \\footnotesize \\em #4}}%
+ \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}\n"))
+
+(defun cal-tex-shortday (funcname)
+ "Insert LaTeX code for a short day function."
+ (insert "\\long\\def\\" funcname "#1#2#3{%
+ \\rule{\\textwidth}{0.3pt}\\\\%
+ \\hbox to \\textwidth{%
+ \\vbox {%
+ \\vspace*{2pt}%
+ \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
+ \\hbox to \\textwidth{\\vbox {\\"
+ (if (string-equal funcname "rightday") "raggedleft" "noindent")
+ " \\em #2}}%
+ \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}\n"))
+
;;;###cal-autoload
(defun cal-tex-cursor-filofax-year (&optional n event)
"Make a Filofax one page yearly calendar of year indicated by cursor.
(or n (setq n 1))
(let ((year (calendar-extract-year (calendar-cursor-to-date t event))))
(cal-tex-preamble "twoside")
- (cal-tex-cmd "\\textwidth 3.25in")
- (cal-tex-cmd "\\textheight 6.5in")
- (cal-tex-cmd "\\oddsidemargin 1.675in")
- (cal-tex-cmd "\\evensidemargin 1.675in")
- (cal-tex-cmd "\\topmargin 0pt")
- (cal-tex-cmd "\\headheight -0.875in")
+ (cal-tex-filofax-paper 'year)
(cal-tex-cmd "\\fboxsep 0.5mm")
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(cal-tex-b-document)
- (cal-tex-cmd "\\vspace*{0.25in}")
+ (cal-tex-vspace "0.25in")
(dotimes (j n)
(insert (format "\\hfil \\textbf{\\Large %s} \\hfil\\\\\n" year))
(cal-tex-b-center)
(if (= j (1- n))
(cal-tex-end-document)
(cal-tex-newpage)
- (cal-tex-cmd "\\vspace*{0.25in}"))
+ (cal-tex-vspace "0.25in"))
(run-hooks 'cal-tex-year-hook))
(run-hooks 'cal-tex-hook)))
(calendar-last-day-of-month end-month end-year)
end-year))))
(diary-list (if cal-tex-diary (cal-tex-list-diary-entries d1 d2)))
- (holidays (if cal-tex-holidays (cal-tex-list-holidays d1 d2)))
+ (holidays (if cal-tex-holidays (holiday-in-range d1 d2)))
other-month other-year small-months-at-start)
(cal-tex-insert-preamble (cal-tex-number-weeks month year 1) t "12pt")
(cal-tex-cmd cal-tex-cal-one-month)
(calendar-last-day-of-month end-month end-year)
end-year))))
(diary-list (if cal-tex-diary (cal-tex-list-diary-entries d1 d2)))
- (holidays (if cal-tex-holidays (cal-tex-list-holidays d1 d2))))
+ (holidays (if cal-tex-holidays (holiday-in-range d1 d2))))
(cal-tex-insert-preamble (cal-tex-number-weeks month year n) nil "12pt")
(if (> n 1)
(cal-tex-cmd cal-tex-cal-multi-month)
{\\makebox[2em]{\\rule{0cm}{#2ex}#1}\\rule{3in}{.15mm}}\n"
"One hour and a line on the right.")
+(defun cal-tex-weekly-paper (&optional nomargins)
+ "Insert some page size settings for weekly layouts."
+ (insert "\\textwidth 6.5in
+\\textheight 10.5in
+")
+ (or nomargins (insert "\\oddsidemargin 0in
+\\evensidemargin 0in
+")))
+
;; TODO cal-tex-diary-support.
;; TODO respect cal-tex-daily-start,end (see cal-tex-week-hours).
;;;###cal-autoload
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2))))
+ (holiday-in-range d1 d2))))
(cal-tex-preamble "11pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
- (cal-tex-cmd "\\oddsidemargin 0in")
- (cal-tex-cmd "\\evensidemargin 0in")
+ (cal-tex-weekly-paper)
(insert cal-tex-LaTeX-hourbox)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.5in")
(cal-tex-b-center)
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2))))
+ (holiday-in-range d1 d2))))
(cal-tex-preamble "12pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
- (cal-tex-cmd "\\oddsidemargin 0in")
- (cal-tex-cmd "\\evensidemargin 0in")
+ (cal-tex-weekly-paper)
(insert cal-tex-LaTeX-hourbox)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.5in")
(cal-tex-b-center)
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2)))
+ (holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
- (cal-tex-list-diary-entries
- ;; FIXME d1?
- (calendar-absolute-from-gregorian (list month 1 year))
- d2)))
+ (cal-tex-list-diary-entries d1 d2)))
s)
(cal-tex-preamble "11pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
- (cal-tex-cmd "\\oddsidemargin 0in")
- (cal-tex-cmd "\\evensidemargin 0in")
+ (cal-tex-weekly-paper)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.5in")
(cal-tex-b-center)
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event))))))
(cal-tex-preamble "11pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
- (cal-tex-cmd "\\oddsidemargin 0in")
- (cal-tex-cmd "\\evensidemargin 0in")
+ (cal-tex-weekly-paper)
(cal-tex-b-document)
(dotimes (i n)
(cal-tex-vspace "-1cm")
(cal-tex-e-framebox)
(cal-tex-hspace "1cm")))
-;;;###cal-autoload
-(defun cal-tex-cursor-filofax-2week (&optional n event)
- "Two-weeks-at-a-glance Filofax style calendar for week cursor is in.
-Optional prefix argument N specifies number of weeks (default 1).
-The calendar shows holiday and diary entries if
-`cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil.
-Optional EVENT indicates a buffer position to use instead of point."
- (interactive (list (prefix-numeric-value current-prefix-arg)
- last-nonmenu-event))
- (or n (setq n 1))
- (let* ((date (calendar-gregorian-from-absolute
- (calendar-dayname-on-or-before
- calendar-week-start-day
- (calendar-absolute-from-gregorian
- (calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
- (d1 (calendar-absolute-from-gregorian date))
- (d2 (+ (* 7 n) d1))
- (holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2)))
- (diary-list (if cal-tex-diary
- (cal-tex-list-diary-entries
- ;; FIXME d1?
- (calendar-absolute-from-gregorian (list month 1 year))
- d2))))
- (cal-tex-preamble "twoside")
- (cal-tex-cmd "\\textwidth 3.25in")
- (cal-tex-cmd "\\textheight 6.5in")
- (cal-tex-cmd "\\oddsidemargin 1.75in")
- (cal-tex-cmd "\\evensidemargin 1.5in")
- (cal-tex-cmd "\\topmargin 0pt")
- (cal-tex-cmd "\\headheight -0.875in")
- (cal-tex-cmd "\\headsep 0.125in")
- (cal-tex-cmd "\\footskip .125in")
- (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
-\\long\\def\\rightday#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to 0.7in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
- \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
-\\long\\def\\leftday#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to 0.7in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-")
- (cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
- (dotimes (i n)
- (if (zerop (mod i 2))
- (insert "\\righthead")
- (insert "\\lefthead"))
- (cal-tex-arg
- (let ((d (cal-tex-incr-date date 6)))
- (if (= (calendar-extract-month date)
- (calendar-extract-month d))
- (format "%s %s"
- (cal-tex-month-name (calendar-extract-month date))
- (calendar-extract-year date))
- (if (= (calendar-extract-year date)
- (calendar-extract-year d))
- (format "%s---%s %s"
- (cal-tex-month-name (calendar-extract-month date))
- (cal-tex-month-name (calendar-extract-month d))
- (calendar-extract-year date))
- (format "%s %s---%s %s"
- (cal-tex-month-name (calendar-extract-month date))
- (calendar-extract-year date)
- (cal-tex-month-name (calendar-extract-month d))
- (calendar-extract-year d))))))
- (insert "%\n")
- (dotimes (_jdummy 7)
- (if (zerop (mod i 2))
- (insert "\\rightday")
- (insert "\\leftday"))
- (cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
- (cal-tex-arg (number-to-string (calendar-extract-day date)))
- (cal-tex-arg (cal-tex-latexify-list diary-list date))
- (cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
- (insert "%\n")
- (setq date (cal-tex-incr-date date)))
- (unless (= i (1- n))
- (run-hooks 'cal-tex-week-hook)
- (cal-tex-newpage)))
- (cal-tex-end-document)
- (run-hooks 'cal-tex-hook)))
-
-;;;###cal-autoload
-(defun cal-tex-cursor-filofax-week (&optional n event)
- "One-week-at-a-glance Filofax style calendar for week indicated by cursor.
-Optional prefix argument N specifies number of weeks (default 1),
-starting on Mondays. The calendar shows holiday and diary entries
-if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil.
-Optional EVENT indicates a buffer position to use instead of point."
- (interactive (list (prefix-numeric-value current-prefix-arg)
- last-nonmenu-event))
+(defun cal-tex-weekly-common (n event &optional filofax)
+ "Common code for weekly calendars."
(or n (setq n 1))
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2)))
+ (holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
- (cal-tex-list-diary-entries
- ;; FIXME d1?
- (calendar-absolute-from-gregorian (list month 1 year))
- d2))))
- (cal-tex-preamble "twoside")
- (cal-tex-cmd "\\textwidth 3.25in")
- (cal-tex-cmd "\\textheight 6.5in")
- (cal-tex-cmd "\\oddsidemargin 1.75in")
- (cal-tex-cmd "\\evensidemargin 1.5in")
- (cal-tex-cmd "\\topmargin 0pt")
- (cal-tex-cmd "\\headheight -0.875in")
- (cal-tex-cmd "\\headsep 0.125in")
- (cal-tex-cmd "\\footskip .125in")
- (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
-\\long\\def\\rightday#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to 1.85in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
- \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-\\long\\def\\weekend#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to .8in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
- \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
-\\long\\def\\leftday#1#2#3#4#5{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox to 1.85in{%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%
- \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
+ (cal-tex-list-diary-entries d1 d2))))
+ (if filofax
+ (progn
+ (cal-tex-preamble "twoside")
+ (cal-tex-filofax-paper)
+ (insert cal-tex-righthead)
+ (cal-tex-longday "rightday" "1.85in")
+ (cal-tex-longday "weekend" "0.8in")
+ (insert cal-tex-lefthead)
+ (cal-tex-longday "leftday" "1.85in"))
+ (cal-tex-preamble "twoside,12pt")
+ (insert "\\textwidth 7in
+\\textheight 10.5in
+\\oddsidemargin 0in
+\\evensidemargin 0in
+\\topmargin 0pt
+\\headheight -0.875in
+\\headsep 0.125in
+\\footskip .125in
")
+ (insert cal-tex-righthead)
+ (cal-tex-longday "rightday" "2.75in")
+ (cal-tex-longday "weekend" "1.8in")
+ (insert cal-tex-lefthead)
+ (cal-tex-longday "leftday" "2.75in"))
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}\\ ")
+ (cal-tex-cmd "\\pagestyle" "empty")
+ ;; Let's assume this is something to do with twopage documents.
+ ;; It has the downside that we start with a blank page.
+ ;; It doesn't make obvious sense when oddside and evenside margins
+ ;; are the same (non-filofax), but consider the left and right
+ ;; versions of various functions as applicable to even and odd pages.
(cal-tex-newpage)
(dotimes (i n)
(insert "\\lefthead")
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
+ (unless filofax
+ (cal-tex-nl)
+ (insert (cal-tex-mini-calendar
+ (calendar-extract-month (cal-tex-previous-month date))
+ (calendar-extract-year (cal-tex-previous-month date))
+ "lastmonth" "1.1in" "1in"))
+ (insert (cal-tex-mini-calendar
+ (calendar-extract-month date)
+ (calendar-extract-year date)
+ "thismonth" "1.1in" "1in"))
+ (insert (cal-tex-mini-calendar
+ (calendar-extract-month (cal-tex-next-month date))
+ (calendar-extract-year (cal-tex-next-month date))
+ "nextmonth" "1.1in" "1in"))
+ (insert "\\hbox to \\textwidth{")
+ (cal-tex-hfill)
+ (insert "\\lastmonth")
+ (cal-tex-hfill)
+ (insert "\\thismonth")
+ (cal-tex-hfill)
+ (insert "\\nextmonth")
+ (cal-tex-hfill)
+ (insert "}"))
(cal-tex-newpage)
(insert "\\righthead")
(cal-tex-arg
(let ((d (cal-tex-incr-date date 3)))
(if (= (calendar-extract-month date)
- (calendar-extract-month d))
+ (calendar-extract-month d))
(format "%s %s"
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date))
(cal-tex-end-document)
(run-hooks 'cal-tex-hook)))
+;;;###cal-autoload
+(defun cal-tex-cursor-week-at-a-glance (&optional n event)
+ "One-week-at-a-glance full page calendar for week indicated by cursor.
+Optional prefix argument N specifies number of weeks (default 1),
+starting on Mondays. The calendar shows holiday and diary entries
+if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil.
+It does not show hours of the day. Optional EVENT indicates a buffer
+position to use instead of point."
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ last-nonmenu-event))
+ (cal-tex-weekly-common n event))
+
+;;;###cal-autoload
+(defun cal-tex-cursor-filofax-2week (&optional n event)
+ "Two-weeks-at-a-glance Filofax style calendar for week cursor is in.
+Optional prefix argument N specifies number of weeks (default 1).
+The calendar shows holiday and diary entries if
+`cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil.
+Optional EVENT indicates a buffer position to use instead of point."
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ last-nonmenu-event))
+ (or n (setq n 1))
+ (let* ((date (calendar-gregorian-from-absolute
+ (calendar-dayname-on-or-before
+ calendar-week-start-day
+ (calendar-absolute-from-gregorian
+ (calendar-cursor-to-date t event)))))
+ (month (calendar-extract-month date))
+ (year (calendar-extract-year date))
+ (day (calendar-extract-day date))
+ (d1 (calendar-absolute-from-gregorian date))
+ (d2 (+ (* 7 n) d1))
+ (holidays (if cal-tex-holidays
+ (holiday-in-range d1 d2)))
+ (diary-list (if cal-tex-diary
+ (cal-tex-list-diary-entries d1 d2))))
+ (cal-tex-preamble "twoside")
+ (cal-tex-filofax-paper)
+ (insert cal-tex-righthead)
+ (cal-tex-longday "rightday" "0.7in")
+ (insert cal-tex-lefthead)
+ (cal-tex-longday "leftday" "0.7in")
+ (cal-tex-b-document)
+ (cal-tex-cmd "\\pagestyle" "empty")
+ (dotimes (i n)
+ (if (zerop (mod i 2))
+ (insert "\\righthead")
+ (insert "\\lefthead"))
+ (cal-tex-arg
+ (let ((d (cal-tex-incr-date date 6)))
+ (if (= (calendar-extract-month date)
+ (calendar-extract-month d))
+ (format "%s %s"
+ (cal-tex-month-name (calendar-extract-month date))
+ (calendar-extract-year date))
+ (if (= (calendar-extract-year date)
+ (calendar-extract-year d))
+ (format "%s---%s %s"
+ (cal-tex-month-name (calendar-extract-month date))
+ (cal-tex-month-name (calendar-extract-month d))
+ (calendar-extract-year date))
+ (format "%s %s---%s %s"
+ (cal-tex-month-name (calendar-extract-month date))
+ (calendar-extract-year date)
+ (cal-tex-month-name (calendar-extract-month d))
+ (calendar-extract-year d))))))
+ (insert "%\n")
+ (dotimes (_jdummy 7)
+ (if (zerop (mod i 2))
+ (insert "\\rightday")
+ (insert "\\leftday"))
+ (cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
+ (cal-tex-arg (number-to-string (calendar-extract-day date)))
+ (cal-tex-arg (cal-tex-latexify-list diary-list date))
+ (cal-tex-arg (cal-tex-latexify-list holidays date))
+ (cal-tex-arg (eval cal-tex-daily-string))
+ (insert "%\n")
+ (setq date (cal-tex-incr-date date)))
+ (unless (= i (1- n))
+ (run-hooks 'cal-tex-week-hook)
+ (cal-tex-newpage)))
+ (cal-tex-end-document)
+ (run-hooks 'cal-tex-hook)))
+
+;;;###cal-autoload
+(defun cal-tex-cursor-filofax-week (&optional n event)
+ "One-week-at-a-glance Filofax style calendar for week indicated by cursor.
+Optional prefix argument N specifies number of weeks (default 1),
+starting on Mondays. The calendar shows holiday and diary entries
+if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil.
+Optional EVENT indicates a buffer position to use instead of point."
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ last-nonmenu-event))
+ (cal-tex-weekly-common n event t))
+
;;;###cal-autoload
(defun cal-tex-cursor-filofax-daily (&optional n event)
"Day-per-page Filofax style calendar for week indicated by cursor.
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
- (cal-tex-list-holidays d1 d2)))
+ (holiday-in-range d1 d2)))
(diary-list (if cal-tex-diary
- (cal-tex-list-diary-entries
- ;; FIXME d1?
- (calendar-absolute-from-gregorian (list month 1 year))
- d2))))
+ (cal-tex-list-diary-entries d1 d2))))
(cal-tex-preamble "twoside")
- (cal-tex-cmd "\\textwidth 3.25in")
- (cal-tex-cmd "\\textheight 6.5in")
- (cal-tex-cmd "\\oddsidemargin 1.75in")
- (cal-tex-cmd "\\evensidemargin 1.5in")
- (cal-tex-cmd "\\topmargin 0pt")
- (cal-tex-cmd "\\headheight -0.875in")
- (cal-tex-cmd "\\headsep 0.125in")
- (cal-tex-cmd "\\footskip .125in")
- (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
-\\long\\def\\rightday#1#2#3{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox {%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
- \\hbox to \\textwidth{\\vbox {\\raggedleft \\em #2}}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
-\\long\\def\\weekend#1#2#3{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox {%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
-\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
-\\long\\def\\leftday#1#2#3{%
- \\rule{\\textwidth}{0.3pt}\\\\%
- \\hbox to \\textwidth{%
- \\vbox {%
- \\vspace*{2pt}%
- \\hbox to \\textwidth{\\hfill \\small #3 \\hfill}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\em #2}}%
- \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize #1}}}}}
-\\newbox\\LineBox
+ (cal-tex-filofax-paper)
+ (insert cal-tex-righthead)
+ (cal-tex-shortday "rightday")
+ (cal-tex-shortday "weekend")
+ (insert cal-tex-lefthead)
+ (cal-tex-shortday "leftday")
+ (insert "\\newbox\\LineBox
\\setbox\\LineBox=\\hbox to\\textwidth{%
\\vrule height.2in width0pt\\leaders\\hrule\\hfill}
\\def\\linesfill{\\par\\leaders\\copy\\LineBox\\vfill}
")
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(dotimes (j 4)
(let ((even (zerop (% j 2))))
(let ((date (calendar-absolute-from-gregorian
(calendar-cursor-to-date t event))))
(cal-tex-preamble "12pt")
- (cal-tex-cmd "\\textwidth 6.5in")
- (cal-tex-cmd "\\textheight 10.5in")
+ (cal-tex-weekly-paper 'nomargins)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}")
+ (cal-tex-cmd "\\pagestyle" "empty")
(dotimes (i n)
(cal-tex-vspace "-1.7in")
(cal-tex-daily-page (calendar-gregorian-from-absolute date))
(cal-tex-e-document)
(or (and cal-tex-preamble-extra
(string-match "inputenc" cal-tex-preamble-extra))
- (not (re-search-backward "[^[:ascii:]]" nil 'move))
- (progn
+ (when (re-search-backward "[^[:ascii:]]" nil 'move)
(goto-char (point-min))
(when (search-forward "documentclass" nil t)
(forward-line 1)
;; FIXME latin1 might not always be right.
(insert "\\usepackage[latin1]{inputenc}\n"))))
(latex-mode)
- (pop-to-buffer cal-tex-buffer)
+ (pop-to-buffer (current-buffer))
(goto-char (point-min))
;; FIXME auctex equivalents?
(cal-tex-comment
(if (not landscape)
(progn
(cal-tex-cmd "\\oddsidemargin -1.75cm")
- (cal-tex-cmd "\\def\\holidaymult{.06}"))
- (cal-tex-cmd "\\special{landscape}")
+ (cal-tex-cmd "\\def\\holidaymult" ".06"))
+ (cal-tex-cmd "\\special" "landscape")
(cal-tex-cmd "\\textwidth 9.5in")
(cal-tex-cmd "\\textheight 7in")
(cal-tex-comment)
- (cal-tex-cmd "\\def\\holidaymult{.08}"))
+ (cal-tex-cmd "\\def\\holidaymult" ".08"))
(cal-tex-cmd cal-tex-caldate)
(cal-tex-cmd cal-tex-myday)
(cal-tex-b-document)
- (cal-tex-cmd "\\pagestyle{empty}"))
+ (cal-tex-cmd "\\pagestyle" "empty"))
(cal-tex-cmd "\\setlength{\\cellwidth}" width)
(insert (format "\\setlength{\\cellwidth}{%f\\cellwidth}\n"
(/ 1.1 (length cal-tex-which-days))))
(defun cal-tex-vspace (space)
"Insert vspace command to move SPACE vertically."
- (insert "\\vspace*{" space "}")
- (cal-tex-comment))
+ (cal-tex-cmd "\\vspace*" space))
(defun cal-tex-hspace (space)
"Insert hspace command to move SPACE horizontally."
- (insert "\\hspace*{" space "}")
- (cal-tex-comment))
+ (cal-tex-cmd "\\hspace*" space))
(defun cal-tex-comment (&optional comment)
"Insert `% ', followed by optional string COMMENT, followed by newline.
(defun cal-tex-b-document ()
"Insert beginning of document."
- (cal-tex-cmd "\\begin{document}"))
+ (cal-tex-cmd "\\begin" "document"))
(defun cal-tex-e-document ()
"Insert end of document."
- (cal-tex-cmd "\\end{document}"))
+ (cal-tex-cmd "\\end" "document"))
(defun cal-tex-b-center ()
"Insert beginning of centered block."
- (cal-tex-cmd "\\begin{center}"))
+ (cal-tex-cmd "\\begin" "center"))
(defun cal-tex-e-center ()
"Insert end of centered block."
(cal-tex-comment)
- (cal-tex-cmd "\\end{center}"))
+ (cal-tex-cmd "\\end" "center"))
;;;
(defun cal-tex-em (string)
"Insert STRING in italic font."
- (insert "\\textit{" string "}"))
+ (cal-tex-cmd "\\textit" string))
(defun cal-tex-bf (string)
"Insert STRING in bf font."
- (insert "\\textbf{ " string "}"))
+ (cal-tex-cmd "\\textbf" string))
(defun cal-tex-scriptsize (string)
"Insert STRING in scriptsize font."
- (insert "{\\scriptsize " string "}"))
+ (cal-tex-arg (concat "\\scriptsize " string)))
(defun cal-tex-huge (string)
"Insert STRING in huge font."
- (insert "{\\huge " string "}"))
+ (cal-tex-arg (concat "\\huge " string)))
(defun cal-tex-Huge (string)
"Insert STRING in Huge font."
- (insert "{\\Huge " string "}"))
+ (cal-tex-arg (concat "\\Huge " string)))
(defun cal-tex-Huge-bf (string)
"Insert STRING in Huge bf font."
- (insert "\\textbf{\\Huge " string "}"))
+ (cal-tex-cmd "\\textbf" (concat "\\Huge " string)))
(defun cal-tex-large (string)
"Insert STRING in large font."
- (insert "{\\large " string "}"))
+ (cal-tex-arg (concat "\\large " string)))
(defun cal-tex-large-bf (string)
"Insert STRING in large bf font."
- (insert "\\textbf{\\large " string "}"))
+ (cal-tex-cmd "\\textbf" (concat "\\large " string)))
(provide 'cal-tex)
(defun calendar-one-frame-setup (&optional prompt)
"Display calendar and diary in a single dedicated frame.
See `calendar-frame-setup' for more information."
+ (declare (obsolete calendar-frame-setup "23.1"))
(calendar-frame-setup 'one-frame prompt))
-(make-obsolete 'calendar-one-frame-setup 'calendar-frame-setup "23.1")
-
-
;;;###cal-autoload
(defun calendar-only-one-frame-setup (&optional prompt)
"Display calendar in a dedicated frame.
See `calendar-frame-setup' for more information."
+ (declare (obsolete calendar-frame-setup "23.1"))
(calendar-frame-setup 'calendar-only prompt))
-(make-obsolete 'calendar-only-one-frame-setup 'calendar-frame-setup "23.1")
-
-
;;;###cal-autoload
(defun calendar-two-frame-setup (&optional prompt)
"Display calendar and diary in separate, dedicated frames.
See `calendar-frame-setup' for more information."
+ (declare (obsolete calendar-frame-setup "23.1"))
(calendar-frame-setup 'two-frames prompt))
-(make-obsolete 'calendar-two-frame-setup 'calendar-frame-setup "23.1")
-
-
;; Undocumented and probably useless.
(defvar cal-x-load-hook nil
"Hook run on loading of the `cal-x' package.")
Three default styles are provided: `diary-american-date-forms',
`diary-european-date-forms', and `diary-iso-date-forms'.
You can choose between these by setting `calendar-date-style' in your
-.emacs file, or by using `calendar-set-date-style' when in the calendar.
+init file, or by using `calendar-set-date-style' when in the calendar.
A diary entry can be preceded by the character `diary-nonmarking-symbol'
\(ordinarily `&') to make that entry nonmarking--that is, it will not be
calendar-american-date-display-form)
:group 'calendar)
+(defcustom calendar-american-month-header
+ '(propertize (format "%s %d" (calendar-month-name month) year)
+ 'font-lock-face 'font-lock-function-name-face)
+ "Default format for calendar month headings with the American date style.
+Normally you should not customize this, but `calender-month-header'."
+ :group 'calendar
+ :risky t
+ :type 'sexp
+ :version "24.3")
+
+(defcustom calendar-european-month-header
+ '(propertize (format "%s %d" (calendar-month-name month) year)
+ 'font-lock-face 'font-lock-function-name-face)
+ "Default format for calendar month headings with the European date style.
+Normally you should not customize this, but `calender-month-header'."
+ :group 'calendar
+ :risky t
+ :type 'sexp
+ :version "24.3")
+
+(defcustom calendar-iso-month-header
+ '(propertize (format "%d %s" year (calendar-month-name month))
+ 'font-lock-face 'font-lock-function-name-face)
+ "Default format for calendar month headings with the ISO date style.
+Normally you should not customize this, but `calender-month-header'."
+ :group 'calendar
+ :risky t
+ :type 'sexp
+ :version "24.3")
+
+(defcustom calendar-month-header
+ (cond ((eq calendar-date-style 'iso)
+ calendar-iso-month-header)
+ ((eq calendar-date-style 'european)
+ calendar-european-month-header)
+ (t calendar-american-month-header))
+ "Expression to evaluate to return the calendar month headings.
+When this expression is evaluated, the variables MONTH and YEAR are
+integers appropriate to the relevant month. The result is padded
+to the width of `calendar-month-digit-width'.
+
+For examples of three common styles, see `calendar-american-month-header',
+`calendar-european-month-header', and `calendar-iso-month-header'.
+
+Changing this variable without using customize has no effect on
+pre-existing calendar windows."
+ :group 'calendar
+ :initialize 'custom-initialize-default
+ :risky t
+ :set (lambda (sym val)
+ (set sym val)
+ (calendar-redraw))
+ :set-after '(calendar-date-style calendar-american-month-header
+ calendar-european-month-header
+ calendar-iso-month-header)
+ :type 'sexp
+ :version "24.3")
+
(defun calendar-set-date-style (style)
"Set the style of calendar and diary dates to STYLE (a symbol).
The valid styles are described in the documentation of `calendar-date-style'."
calendar-date-display-form
(symbol-value (intern-soft
(format "calendar-%s-date-display-form" style)))
+ calendar-month-header
+ (symbol-value (intern-soft (format "calendar-%s-month-header" style)))
diary-date-forms
(symbol-value (intern-soft (format "diary-%s-date-forms" style))))
+ (calendar-redraw)
(calendar-update-mode-line))
(defun european-calendar ()
"Set the interpretation and display of dates to the European style."
+ (declare (obsolete calendar-set-date-style "23.1"))
(interactive)
(calendar-set-date-style 'european))
-(make-obsolete 'european-calendar 'calendar-set-date-style "23.1")
-
(defun american-calendar ()
"Set the interpretation and display of dates to the American style."
+ (declare (obsolete calendar-set-date-style "23.1"))
(interactive)
(calendar-set-date-style 'american))
-(make-obsolete 'american-calendar 'calendar-set-date-style "23.1")
-
(define-obsolete-variable-alias 'holidays-in-diary-buffer
'diary-show-holidays-flag "23.1")
"Execute a for loop.
Evaluate BODY with VAR bound to successive integers from INIT to FINAL,
inclusive. The standard macro `dotimes' is preferable in most cases."
- (declare (debug (symbolp "from" form "to" form "do" body))
+ (declare (obsolete "use `dotimes' or `while' instead." "23.1")
+ (debug (symbolp "from" form "to" form "do" body))
(indent defun))
`(let ((,var (1- ,init)))
(while (>= ,final (setq ,var (1+ ,var)))
,@body)))
-(make-obsolete 'calendar-for-loop "use `dotimes' or `while' instead." "23.1")
-
(defmacro calendar-sum (index initial condition expression)
"For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION."
(declare (debug (symbolp form form form)))
,index (1+ ,index)))
sum))
-;; FIXME bind q to bury-buffer?
(defmacro calendar-in-read-only-buffer (buffer &rest body)
- "Switch to BUFFER and executes the forms in BODY.
+ "Switch to BUFFER and execute the forms in BODY.
First creates or erases BUFFER as needed. Leaves BUFFER read-only,
with disabled undo. Leaves point at point-min, displays BUFFER."
(declare (indent 1) (debug t))
`(progn
(set-buffer (get-buffer-create ,buffer))
+ (or (derived-mode-p 'special-mode) (special-mode))
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
generating a calendar, if today's date is visible or not, respectively
`calendar-initial-window-hook' - after first creating a calendar
-This function is suitable for execution in a .emacs file."
+This function is suitable for execution in an init file."
(interactive "P")
;; Avoid loading cal-x unless it will be used.
(if (and (memq calendar-setup '(one-frame two-frames calendar-only))
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
- (calendar-string-spread
- (list (format "%s %d" (calendar-month-name month) year))
- ?\s calendar-month-digit-width))
+ (calendar-string-spread (list calendar-month-header)
+ ?\s calendar-month-digit-width))
(calendar-ensure-newline)
(calendar-insert-at-column indent calendar-intermonth-header trunc)
;; Use the first two characters of each day to head the columns.
?\s (- calendar-right-margin (1- start))))))
(force-mode-line-update))))
-(defun calendar-window-list ()
- "List of all calendar-related windows."
- (let ((calendar-buffers (calendar-buffer-list))
- list)
- ;; Using 0 rather than t for last argument - see bug#2199.
- ;; This is only used with calendar-hide-window, which ignores
- ;; iconified frames anyway, so could use 'visible rather than 0.
- (walk-windows (lambda (w)
- (if (memq (window-buffer w) calendar-buffers)
- (push w list)))
- nil 0)
- list))
-
(defun calendar-buffer-list ()
"List of all calendar-related buffers (as buffers, not strings)."
(let (buffs)
(push b buffs)))
buffs))
-(defun calendar-exit ()
+(defun calendar-exit (&optional kill)
"Get out of the calendar window and hide it and related buffers."
- (interactive)
- (let ((diary-buffer (get-file-buffer diary-file)))
- (if (or (not diary-buffer)
- (not (buffer-modified-p diary-buffer))
- (yes-or-no-p
- "Diary modified; do you really want to exit the calendar? "))
- ;; Need to do this multiple times because one time can replace some
- ;; calendar-related buffers with other calendar-related buffers.
- (mapc (lambda (x)
- (mapc 'calendar-hide-window (calendar-window-list)))
- (calendar-window-list)))))
+ (interactive "P")
+ (let ((diary-buffer (get-file-buffer diary-file))
+ (calendar-buffers (calendar-buffer-list)))
+ (when (or (not diary-buffer)
+ (not (buffer-modified-p diary-buffer))
+ (yes-or-no-p
+ "Diary modified; do you really want to exit the calendar? "))
+ (if (and calendar-setup (display-multi-frame-p))
+ ;; FIXME: replace this cruft with the `quit-restore' window property
+ (dolist (w (window-list-1 nil nil t))
+ (if (and (memq (window-buffer w) calendar-buffers)
+ (window-dedicated-p w))
+ (if (eq (window-deletable-p w) 'frame)
+ (if calendar-remove-frame-by-deleting
+ (delete-frame (window-frame w))
+ (iconify-frame (window-frame w)))
+ (quit-window kill w))))
+ (dolist (b calendar-buffers)
+ (quit-windows-on b kill))))))
(define-obsolete-function-alias 'exit-calendar 'calendar-exit "23.1")
-(defun calendar-hide-window (window)
- "Hide WINDOW if it is calendar-related."
- (let ((buffer (if (window-live-p window) (window-buffer window))))
- (if (memq buffer (calendar-buffer-list))
- (cond
- ((and (display-multi-frame-p)
- (eq 'icon (cdr (assoc 'visibility
- (frame-parameters
- (window-frame window))))))
- nil)
- ((and (display-multi-frame-p) (window-dedicated-p window))
- (if calendar-remove-frame-by-deleting
- (delete-frame (window-frame window))
- (iconify-frame (window-frame window))))
- ((not (and (select-window window) (one-window-p window)))
- (delete-window window))
- (t (set-buffer buffer)
- (bury-buffer))))))
-
(defun calendar-current-date (&optional offset)
"Return the current date in a list (month day year).
Optional integer OFFSET is a number of days from the current date."
;; or on or before the digit of a 1-digit date.
(if (not (and (looking-at "[ 0-9]?[0-9][^0-9]")
(get-text-property (point) 'date)))
- (if error (error "Not on a date!"))
+ (if error (user-error "Not on a date!"))
;; Convert segment to real month and year.
(if (zerop month) (setq month 12))
;; Go back to before the first date digit.
((and (= 1 month) (= segment 2)) (1+ displayed-year))
(t displayed-year))))))))
-(add-to-list 'debug-ignored-errors "Not on a date!")
-
;; The following version of calendar-gregorian-from-absolute is preferred for
;; reasons of clarity, BUT it's much slower than the version that follows it.
(- mon2 mon1)))
(defvar calendar-font-lock-keywords
+ ;; Month and year. Not really needed now that calendar-month-header
+ ;; contains propertize, and not correct for non-american forms
+ ;; of that variable.
`((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
" -?[0-9]+")
- . font-lock-function-name-face) ; month and year
+ . font-lock-function-name-face)
(,(regexp-opt
(list (substring (aref calendar-day-name-array 6)
0 calendar-day-header-width)
;; First two chars of each day are used in the calendar.
(,(regexp-opt (mapcar (lambda (x) (substring x 0 calendar-day-header-width))
calendar-day-name-array))
- . font-lock-reference-face))
+ . font-lock-constant-face))
"Default keywords to highlight in Calendar mode.")
(defun calendar-day-name (date &optional abbrev absolute)
"---")
(calendar-string-spread (list str) ?- width)))))
-(defun calendar-version ()
- "Display the Calendar version."
- (interactive)
- (message "GNU Emacs %s" emacs-version))
-
-(make-obsolete 'calendar-version 'emacs-version "23.1")
-
+(define-obsolete-function-alias 'calendar-version 'emacs-version "23.1")
(run-hooks 'calendar-load-hook)
'diary-list-entries-hook "23.1")
(defcustom diary-list-entries-hook nil
- "List of functions called after diary file is culled for relevant entries.
-You might wish to add `diary-include-other-diary-files', in which case
-you will probably also want to add `diary-mark-included-diary-files' to
-`diary-mark-entries-hook'. For example, you could use
+ "Hook run after diary file is culled for relevant entries.
+
+If you add `diary-include-other-diary-files' to this hook, you
+will probably also want to add `diary-mark-included-diary-files'
+to `diary-mark-entries-hook'. For example, to cause the fancy
+diary buffer to be displayed with diary entries from various
+included files, each day's entries sorted into lexicographic
+order, add the following to your init file:
(setq diary-display-function 'diary-fancy-display)
(add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
(add-hook 'diary-list-entries-hook 'diary-sort-entries t)
-in your `.emacs' file to cause the fancy diary buffer to be displayed with
-diary entries from various included files, each day's entries sorted into
-lexicographic order. Note how the sort function is placed last,
-so that it can sort the entries included from other files.
+Note how the sort function is placed last, so that it can sort
+the entries included from other files.
This hook runs after `diary-nongregorian-listing-hook'. These two hooks
differ only if you are using included diary files. In that case,
"Generate the diary window for ARG days starting with the current date.
If no argument is provided, the number of days of diary entries is governed
by the variable `diary-number-of-entries'. A value of ARG less than 1
-does nothing. This function is suitable for execution in a `.emacs' file."
+does nothing. This function is suitable for execution in an init file."
(interactive "P")
(diary-check-diary-file)
(diary-list-entries (calendar-current-date)
(setq diary-entries-list
(append diary-entries-list
(diary-list-entries original-date number t)))))
- (beep)
- (message "Can't read included diary file %s" diary-file)
- (sleep-for 2))
- (beep)
- (message "Can't find included diary file %s" diary-file)
- (sleep-for 2))))
+ (display-warning
+ :error
+ (format "Can't read included diary file %s\n" diary-file)))
+ (display-warning
+ :error
+ (format "Can't find included diary file %s\n" diary-file)))))
(goto-char (point-min)))
(defun diary-include-other-diary-files ()
Here is an example of a script to call `diary-mail-entries',
suitable for regular scheduling using cron (or at). Note that
-since `emacs -script' does not load your `.emacs' file, you
-should ensure that all relevant variables are set.
+since `emacs -script' does not load your init file, you should
+ensure that all relevant variables are set.
#!/usr/bin/emacs -script
;; diary-rem.el - run the Emacs diary-reminder
(let ((result (if calendar-debug-sexp
(let ((debug-on-error t))
(eval (car (read-from-string sexp))))
- (condition-case nil
- (eval (car (read-from-string sexp)))
- (error
- (beep)
- (message "Bad sexp at line %d in %s: %s"
- (count-lines (point-min) (point))
- diary-file sexp)
- (sleep-for 2))))))
+ (let (err)
+ (condition-case err
+ (eval (car (read-from-string sexp)))
+ (error
+ (display-warning
+ :error
+ (format "Bad diary sexp at line %d in %s:\n%s\n\
+Error: %s\n"
+ (count-lines (point-min) (point))
+ diary-file sexp err))
+ nil))))))
(cond ((stringp result) result)
((and (consp result)
(stringp (cdr result))) result)
(cons
(format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol)
(regexp-quote diary-sexp-entry-symbol))
- '(1 font-lock-reference-face))
+ '(1 font-lock-constant-face))
(cons
(format "^%s" (regexp-quote diary-nonmarking-symbol))
- 'font-lock-reference-face)
+ 'font-lock-constant-face)
(cons
(format "^%s?%s" (regexp-quote diary-nonmarking-symbol)
(regexp-opt (mapcar 'regexp-quote
diary-islamic-entry-symbol
diary-bahai-entry-symbol))
t))
- '(1 font-lock-reference-face))
+ '(1 font-lock-constant-face))
'(diary-font-lock-sexps . font-lock-keyword-face)
;; Don't need to worry about space around "-" because the first
;; match takes care of that. It does mean the "-" itself may or
(defvar diary-fancy-font-lock-keywords
`((diary-fancy-date-matcher . diary-face)
("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
- ("^.*Yahrzeit.*$" . font-lock-reference-face)
+ ("^.*Yahrzeit.*$" . font-lock-constant-face)
("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
("^Day.*omer.*$" . font-lock-builtin-face)
("^Parashat.*$" . font-lock-comment-face)
"List of notable days for the command \\[holidays].
Additional holidays are easy to add to the list, just put them in the
-list `holiday-other-holidays' in your .emacs file. Similarly, by setting
+list `holiday-other-holidays' in your init file. Similarly, by setting
any of `holiday-general-holidays', `holiday-local-holidays',
`holiday-christian-holidays', `holiday-hebrew-holidays',
`holiday-islamic-holidays', `holiday-bahai-holidays',
`holiday-oriental-holidays', or `holiday-solar-holidays' to nil in your
-.emacs file, you can eliminate unwanted categories of holidays.
+init file, you can eliminate unwanted categories of holidays.
The aforementioned variables control the holiday choices offered
by the function `holiday-list' when it is called interactively.
(defun calendar-holiday-list ()
"Form the list of holidays that occur on dates in the calendar window.
The holidays are those in the list `calendar-holidays'."
- (let (res h)
+ (let (res h err)
(sort
(dolist (p calendar-holidays res)
(if (setq h (if calendar-debug-sexp
(let ((debug-on-error t))
(eval p))
- (condition-case nil
+ (condition-case err
(eval p)
- (error (beep)
- (message "Bad holiday list item: %s" p)
- (sleep-for 2)))))
+ (error
+ (display-warning
+ :error
+ (format "Bad holiday list item: %s\nError: %s\n"
+ p err))
+ nil))))
(setq res (append h res))))
'calendar-date-compare)))
(defun holidays (&optional arg)
"Display the holidays for last month, this month, and next month.
If called with an optional prefix argument ARG, prompts for month and year.
-This function is suitable for execution in a .emacs file."
+This function is suitable for execution in a init file."
(interactive "P")
(save-excursion
(let* ((completion-ignore-case t)
(define-obsolete-function-alias
'check-calendar-holidays 'calendar-check-holidays "23.1")
+
+;; Formerly cal-tex-list-holidays.
+(defun holiday-in-range (d1 d2)
+ "Generate a list of all holidays in range from absolute date D1 to D2."
+ (let* ((start (calendar-gregorian-from-absolute d1))
+ (displayed-month (calendar-extract-month start))
+ (displayed-year (calendar-extract-year start))
+ (end (calendar-gregorian-from-absolute d2))
+ (end-month (calendar-extract-month end))
+ (end-year (calendar-extract-year end))
+ (number-of-intervals
+ (1+ (/ (calendar-interval displayed-month displayed-year
+ end-month end-year)
+ 3)))
+ holidays in-range a)
+ (calendar-increment-month displayed-month displayed-year 1)
+ (dotimes (_idummy number-of-intervals)
+ (setq holidays (append holidays (calendar-holiday-list)))
+ (calendar-increment-month displayed-month displayed-year 3))
+ (dolist (hol holidays)
+ (and (car hol)
+ (setq a (calendar-absolute-from-gregorian (car hol)))
+ (and (<= d1 a) (<= a d2))
+ (setq in-range (append (list hol) in-range))))
+ in-range))
+
+
(declare-function x-popup-menu "menu.c" (position menu))
;;;###cal-autoload
%s Summary, see `icalendar-import-format-summary'
%t Status, see `icalendar-import-format-status'
%u URL, see `icalendar-import-format-url'
+%U UID, see `icalendar-import-format-uid'
A formatting FUNCTION will be called with a VEVENT as its only
argument. It must return a string. See
:type 'string
:group 'icalendar)
+(defcustom icalendar-import-format-uid
+ "\n UID: %s"
+ "Format string defining how the UID element is formatted.
+This applies only if the UID is not empty! `%s' is replaced by
+the UID."
+ :type 'string
+ :group 'icalendar)
+
(defcustom icalendar-import-format-status
"\n Status: %s"
"Format string defining how the status element is formatted.
(defun icalendar--parse-vtimezone (alist)
"Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
Return nil if timezone cannot be parsed."
- (let* ((tz-id (icalendar--get-event-property alist 'TZID))
+ (let* ((tz-id (icalendar--convert-string-for-import
+ (icalendar--get-event-property alist 'TZID)))
(daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
(day (and daylight (icalendar--convert-tz-offset daylight t)))
(standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
(set-buffer (find-file diary-filename))
(icalendar-export-region (point-min) (point-max) ical-filename)))
-(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file)
-(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file "22.1")
+(define-obsolete-function-alias 'icalendar-convert-diary-to-ical
+ 'icalendar-export-file "22.1")
(defvar icalendar--uid-count 0
"Auxiliary counter for creating unique ids.")
(org (cdr (assoc 'org other-elements)))
(sta (cdr (assoc 'sta other-elements)))
(sum (cdr (assoc 'sum other-elements)))
- (url (cdr (assoc 'url other-elements))))
+ (url (cdr (assoc 'url other-elements)))
+ (uid (cdr (assoc 'uid other-elements))))
(if cla
(setq contents (concat contents "\nCLASS:" cla)))
(if des
;;(if sum
;; (setq contents (concat contents "\nSUMMARY:" sum)))
(if url
- (setq contents (concat contents "\nURL:" url))))
+ (setq contents (concat contents "\nURL:" url)))
- (setq header (concat "\nBEGIN:VEVENT\nUID:"
- (icalendar--create-uid entry-full contents)))
+ (setq header (concat "\nBEGIN:VEVENT\nUID:"
+ (or uid
+ (icalendar--create-uid entry-full
+ contents)))))
(setq result (concat result header contents "\nEND:VEVENT")))
;; handle errors
(error
;; can't do anything
nil
;; split summary-and-rest
- (let* ((s icalendar-import-format)
+ (let* ((case-fold-search nil)
+ (s icalendar-import-format)
(p-cla (or (string-match "%c" icalendar-import-format) -1))
(p-des (or (string-match "%d" icalendar-import-format) -1))
(p-loc (or (string-match "%l" icalendar-import-format) -1))
(p-sum (or (string-match "%s" icalendar-import-format) -1))
(p-sta (or (string-match "%t" icalendar-import-format) -1))
(p-url (or (string-match "%u" icalendar-import-format) -1))
- (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<))
+ (p-uid (or (string-match "%U" icalendar-import-format) -1))
+ (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid) '<))
(ct 0)
- pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url)
+ pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url pos-uid)
(dotimes (i (length p-list))
;; Use 'ct' to keep track of current position in list
(cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
(setq pos-sum (* 2 ct)))
((and (>= p-url 0) (= (nth i p-list) p-url))
(setq ct (+ ct 1))
- (setq pos-url (* 2 ct)))) )
+ (setq pos-url (* 2 ct)))
+ ((and (>= p-uid 0) (= (nth i p-list) p-uid))
+ (setq ct (+ ct 1))
+ (setq pos-uid (* 2 ct)))) )
(mapc (lambda (ij)
(setq s (icalendar--rris (car ij) (cadr ij) s t t)))
(list
(list "%t"
(concat "\\(" icalendar-import-format-status "\\)??"))
(list "%u"
- (concat "\\(" icalendar-import-format-url "\\)??"))))
+ (concat "\\(" icalendar-import-format-url "\\)??"))
+ (list "%U"
+ (concat "\\(" icalendar-import-format-uid "\\)??"))))
;; Need the \' regexp in order to detect multi-line items
(setq s (concat "\\`"
(icalendar--rris "%s" "\\(.*?\\)" s nil t)
"\\'"))
(if (string-match s summary-and-rest)
- (let (cla des loc org sta sum url)
+ (let (cla des loc org sta sum url uid)
(if (and pos-sum (match-beginning pos-sum))
(setq sum (substring summary-and-rest
(match-beginning pos-sum)
(setq url (substring summary-and-rest
(match-beginning pos-url)
(match-end pos-url))))
+ (if (and pos-uid (match-beginning pos-uid))
+ (setq uid (substring summary-and-rest
+ (match-beginning pos-uid)
+ (match-end pos-uid))))
(list (if cla (cons 'cla cla) nil)
(if des (cons 'des des) nil)
(if loc (cons 'loc loc) nil)
(if org (cons 'org org) nil)
(if sta (cons 'sta sta) nil)
;;(if sum (cons 'sum sum) nil)
- (if url (cons 'url url) nil))))))))
+ (if url (cons 'url url) nil)
+ (if uid (cons 'uid uid) nil))))))))
;; subroutines for icalendar-export-region
(defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
;; return nil, i.e. import did not work
nil)))
-(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer)
-(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer "22.1")
+(define-obsolete-function-alias 'icalendar-extract-ical-from-buffer
+ 'icalendar-import-buffer "22.1")
(defun icalendar--format-ical-event (event)
"Create a string representation of an iCalendar EVENT."
(if (functionp icalendar-import-format)
(funcall icalendar-import-format event)
(let ((string icalendar-import-format)
+ (case-fold-search nil)
(conversion-list
'(("%c" CLASS icalendar-import-format-class)
("%d" DESCRIPTION icalendar-import-format-description)
("%o" ORGANIZER icalendar-import-format-organizer)
("%s" SUMMARY icalendar-import-format-summary)
("%t" STATUS icalendar-import-format-status)
- ("%u" URL icalendar-import-format-url))))
+ ("%u" URL icalendar-import-format-url)
+ ("%U" UID icalendar-import-format-uid))))
;; convert the specifiers in the format string
(mapc (lambda (i)
(let* ((spec (car i))
(defun lunar-phases (&optional arg)
"Display the quarters of the moon for last month, this month, and next month.
If called with an optional prefix argument ARG, prompts for month and year.
-This function is suitable for execution in a .emacs file."
+This function is suitable for execution in an init file."
(interactive "P")
(save-excursion
(let* ((date (if arg (calendar-read-date t)
;;; Code:
-(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it
+(eval-when-compile (require 'cl-lib))
(defvar parse-time-digits (make-vector 256 nil))
(defvar parse-time-val)
(unless (aref parse-time-digits ?0)
- (loop for i from ?0 to ?9
- do (aset parse-time-digits i (- i ?0))))
+ (cl-loop for i from ?0 to ?9
+ do (aset parse-time-digits i (- i ?0))))
(defsubst digit-char-p (char)
(aref parse-time-digits char))
(index 0)
(c nil))
(while (< index end)
- (while (and (< index end) ;skip invalid characters
+ (while (and (< index end) ;Skip invalid characters.
(not (setq c (parse-time-string-chars (aref string index)))))
- (incf index))
+ (cl-incf index))
(setq start index all-digits (eq c ?0))
- (while (and (< (incf index) end) ;scan valid characters
+ (while (and (< (cl-incf index) end) ;Scan valid characters.
(setq c (parse-time-string-chars (aref string index))))
(setq all-digits (and all-digits (eq c ?0))))
(if (<= index end)
If called with an optional double prefix argument, prompt for
longitude, latitude, time zone, and date, and always use standard time.
-This function is suitable for execution in a .emacs file."
+This function is suitable for execution in an init file."
(interactive "p")
(or arg (setq arg 1))
(if (and (< arg 16)
;;; Commentary:
-;; Time values come in three formats. The oldest format is a cons
+;; Time values come in several formats. The oldest format is a cons
;; cell of the form (HIGH . LOW). This format is obsolete, but still
-;; supported. The two other formats are the lists (HIGH LOW) and
-;; (HIGH LOW MICRO). The first two formats specify HIGH * 2^16 + LOW
-;; seconds; the third format specifies HIGH * 2^16 + LOW + MICRO /
-;; 1000000 seconds. We should have 0 <= MICRO < 1000000 and 0 <= LOW
-;; < 2^16. If the time value represents a point in time, then HIGH is
-;; nonnegative. If the time value is a time difference, then HIGH can
-;; be negative as well. The macro `with-decoded-time-value' and the
+;; supported. The other formats are the lists (HIGH LOW), (HIGH LOW
+;; USEC), and (HIGH LOW USEC PSEC). These formats specify the time
+;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12
+;; seconds, where missing components are treated as zero. HIGH can be
+;; negative, either because the value is a time difference, or because
+;; the machine supports negative time stamps that fall before the
+;; epoch. The macro `with-decoded-time-value' and the
;; function `encode-time-value' make it easier to deal with these
;; three formats. See `time-subtract' for an example of how to use
;; them.
The value of the last form in BODY is returned.
Each element of the list VARLIST is a list of the form
-\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [TYPE-SYMBOL] TIME-VALUE).
+\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [PICO-SYMBOL [TYPE-SYMBOL]] TIME-VALUE).
The time value TIME-VALUE is decoded and the result it bound to
the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL.
+The optional PICO-SYMBOL is bound to the picoseconds part.
The optional TYPE-SYMBOL is bound to the type of the time value.
Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH
-LOW), and type 2 is the list (HIGH LOW MICRO)."
+LOW), type 2 is the list (HIGH LOW MICRO), and type 3 is the
+list (HIGH LOW MICRO PICO)."
(declare (indent 1)
(debug ((&rest (symbolp symbolp symbolp &or [symbolp form] form))
body)))
(high (pop elt))
(low (pop elt))
(micro (pop elt))
+ (pico (unless (<= (length elt) 2)
+ (pop elt)))
(type (unless (eq (length elt) 1)
(pop elt)))
(time-value (car elt))
`(let* ,(append `((,gensym ,time-value)
(,high (pop ,gensym))
,low ,micro)
+ (when pico `(,pico))
(when type `(,type)))
(if (consp ,gensym)
(progn
(setq ,low (pop ,gensym))
(if ,gensym
- ,(append `(setq ,micro (car ,gensym))
- (when type `(,type 2)))
+ (progn
+ (setq ,micro (car ,gensym))
+ ,(cond (pico
+ `(if (cdr ,gensym)
+ ,(append `(setq ,pico (cadr ,gensym))
+ (when type `(,type 3)))
+ ,(append `(setq ,pico 0)
+ (when type `(,type 2)))))
+ (type
+ `(setq type 2))))
,(append `(setq ,micro 0)
+ (when pico `(,pico 0))
(when type `(,type 1)))))
,(append `(setq ,low ,gensym ,micro 0)
+ (when pico `(,pico 0))
(when type `(,type 0))))
(with-decoded-time-value ,varlist ,@body)))
`(progn ,@body)))
-(defun encode-time-value (high low micro type)
- "Encode HIGH, LOW, and MICRO into a time value of type TYPE.
+(defun encode-time-value (high low micro pico &optional type)
+ "Encode HIGH, LOW, MICRO, and PICO into a time value of type TYPE.
Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH LOW),
-and type 2 is the list (HIGH LOW MICRO)."
+type 2 is (HIGH LOW MICRO), and type 3 is (HIGH LOW MICRO PICO).
+
+For backward compatibility, if only four arguments are given,
+it is assumed that PICO was omitted and should be treated as zero."
(cond
((eq type 0) (cons high low))
((eq type 1) (list high low))
- ((eq type 2) (list high low micro))))
+ ((eq type 2) (list high low micro))
+ ((eq type 3) (list high low micro pico))
+ ((null type) (encode-time-value high low micro 0 pico))))
(autoload 'parse-time-string "parse-time")
(autoload 'timezone-make-date-arpa-standard "timezone")
(subrp (symbol-function 'float-time)))
(defun time-to-seconds (time)
"Convert time value TIME to a floating point number."
- (with-decoded-time-value ((high low micro time))
+ (with-decoded-time-value ((high low micro pico type time))
(+ (* 1.0 high 65536)
low
- (/ micro 1000000.0))))))
+ (/ (+ (* micro 1e6) pico) 1e12))))))
;;;###autoload
(defun seconds-to-time (seconds)
"Convert SECONDS (a floating point number) to a time value."
- (list (floor seconds 65536)
- (floor (mod seconds 65536))
- (floor (* (- seconds (ffloor seconds)) 1000000))))
+ (let* ((usec (* 1000000 (mod seconds 1)))
+ (ps (round (* 1000000 (mod usec 1))))
+ (us (floor usec))
+ (lo (floor (mod seconds 65536)))
+ (hi (floor seconds 65536)))
+ (if (eq ps 1000000)
+ (progn
+ (setq ps 0)
+ (setq us (1+ us))
+ (if (eq us 1000000)
+ (progn
+ (setq us 0)
+ (setq lo (1+ lo))
+ (if (eq lo 65536)
+ (progn
+ (setq lo 0)
+ (setq hi (1+ hi))))))))
+ (list hi lo us ps)))
;;;###autoload
(defun time-less-p (t1 t2)
"Return non-nil if time value T1 is earlier than time value T2."
- (with-decoded-time-value ((high1 low1 micro1 t1)
- (high2 low2 micro2 t2))
+ (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1)
+ (high2 low2 micro2 pico2 type2 t2))
(or (< high1 high2)
(and (= high1 high2)
(or (< low1 low2)
(and (= low1 low2)
- (< micro1 micro2)))))))
+ (or (< micro1 micro2)
+ (and (= micro1 micro2)
+ (< pico1 pico2)))))))))
;;;###autoload
(defun days-to-time (days)
(defun time-subtract (t1 t2)
"Subtract two time values, T1 minus T2.
Return the difference in the format of a time value."
- (with-decoded-time-value ((high low micro type t1)
- (high2 low2 micro2 type2 t2))
+ (with-decoded-time-value ((high low micro pico type t1)
+ (high2 low2 micro2 pico2 type2 t2))
(setq high (- high high2)
low (- low low2)
micro (- micro micro2)
+ pico (- pico pico2)
type (max type type2))
+ (when (< pico 0)
+ (setq micro (1- micro)
+ pico (+ pico 1000000)))
(when (< micro 0)
(setq low (1- low)
micro (+ micro 1000000)))
(when (< low 0)
(setq high (1- high)
low (+ low 65536)))
- (encode-time-value high low micro type)))
+ (encode-time-value high low micro pico type)))
;;;###autoload
(defun time-add (t1 t2)
"Add two time values T1 and T2. One should represent a time difference."
- (with-decoded-time-value ((high low micro type t1)
- (high2 low2 micro2 type2 t2))
+ (with-decoded-time-value ((high low micro pico type t1)
+ (high2 low2 micro2 pico2 type2 t2))
(setq high (+ high high2)
low (+ low low2)
micro (+ micro micro2)
+ pico (+ pico pico2)
type (max type type2))
+ (when (>= pico 1000000)
+ (setq micro (1+ micro)
+ pico (- pico 1000000)))
(when (>= micro 1000000)
(setq low (1+ low)
micro (- micro 1000000)))
(when (>= low 65536)
(setq high (1+ high)
low (- low 65536)))
- (encode-time-value high low micro type)))
+ (encode-time-value high low micro pico type)))
;;;###autoload
(defun date-to-day (date)
;; (define-key ctl-x-map "to" 'timeclock-out)
;; (define-key ctl-x-map "tc" 'timeclock-change)
;; (define-key ctl-x-map "tr" 'timeclock-reread-log)
-;; (define-key ctl-x-map "tu" 'timeclock-update-modeline)
+;; (define-key ctl-x-map "tu" 'timeclock-update-mode-line)
;; (define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)
;; If you want Emacs to display the amount of time "left" to your
-;; workday in the modeline, you can either set the value of
-;; `timeclock-modeline-display' to t using M-x customize, or you
-;; can add this code to your .emacs file:
+;; workday in the mode-line, you can either set the value of
+;; `timeclock-mode-line-display' to t using M-x customize, or you can
+;; add this code to your init file:
;;
;; (require 'timeclock)
-;; (timeclock-modeline-display)
+;; (timeclock-mode-line-display)
;;
-;; To cancel this modeline display at any time, just call
-;; `timeclock-modeline-display' again.
+;; To cancel this mode line display at any time, just call
+;; `timeclock-mode-line-display' again.
;; You may also want Emacs to ask you before exiting, if you are
;; currently working on a project. This can be done either by setting
;; `timeclock-ask-before-exiting' to t using M-x customize (this is
-;; the default), or by adding the following to your .emacs file:
+;; the default), or by adding the following to your init file:
;;
;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
Tuesday is twelve hours -- relative to an averaged work period of
eight hours -- or eight hours, non-relative. So relative time takes
into account any discrepancy of time under-worked or over-worked on
-previous days. This only affects the timeclock modeline display."
+previous days. This only affects the timeclock mode line display."
:type 'boolean
:group 'timeclock)
;; For byte-compiler.
(defvar display-time-hook)
-(defvar timeclock-modeline-display)
+(defvar timeclock-mode-line-display)
(defcustom timeclock-use-display-time t
- "If non-nil, use `display-time-hook' for doing modeline updates.
+ "If non-nil, use `display-time-hook' for doing mode line updates.
The advantage of this is that one less timer has to be set running
amok in Emacs's process space. The disadvantage is that it requires
you to have `display-time' running. If you don't want to use
-`display-time', but still want the modeline to show how much time is
+`display-time', but still want the mode line to show how much time is
left, set this variable to nil. Changing the value of this variable
-while timeclock information is being displayed in the modeline has no
-effect. You should call the function `timeclock-modeline-display' with
+while timeclock information is being displayed in the mode line has no
+effect. You should call the function `timeclock-mode-line-display' with
a positive argument to force an update."
:set (lambda (symbol value)
(let ((currently-displaying
- (and (boundp 'timeclock-modeline-display)
- timeclock-modeline-display)))
+ (and (boundp 'timeclock-mode-line-display)
+ timeclock-mode-line-display)))
;; if we're changing to the state that
- ;; `timeclock-modeline-display' is already using, don't
+ ;; `timeclock-mode-line-display' is already using, don't
;; bother toggling it. This happens on the initial loading
;; of timeclock.el.
(if (and currently-displaying
(or (and value
(boundp 'display-time-hook)
- (memq 'timeclock-update-modeline
+ (memq 'timeclock-update-mode-line
display-time-hook))
(and (not value)
timeclock-update-timer)))
(setq currently-displaying nil))
(and currently-displaying
- (set-variable 'timeclock-modeline-display nil))
+ (set-variable 'timeclock-mode-line-display nil))
(setq timeclock-use-display-time value)
(and currently-displaying
- (set-variable 'timeclock-modeline-display t))
+ (set-variable 'timeclock-mode-line-display t))
timeclock-use-display-time))
:type 'boolean
:group 'timeclock
(defcustom timeclock-day-over-hook nil
"A hook that is run when the workday has been completed.
This hook is only run if the current time remaining is being displayed
-in the modeline. See the variable `timeclock-modeline-display'."
+in the mode line. See the variable `timeclock-mode-line-display'."
:type 'hook
:group 'timeclock)
will be the same as `timeclock-discrepancy'.")
(defvar timeclock-use-elapsed nil
- "Non-nil if the modeline should display time elapsed, not remaining.")
+ "Non-nil if the mode line should display time elapsed, not remaining.")
(defvar timeclock-last-period nil
"Integer representing the number of seconds in the last period.
function `timeclock-last-period'.")
(defvar timeclock-mode-string nil
- "The timeclock string (optionally) displayed in the modeline.
+ "The timeclock string (optionally) displayed in the mode line.
The time is bracketed by <> if you are clocked in, otherwise by [].")
(defvar timeclock-day-over nil
;;; User Functions:
+(define-obsolete-function-alias 'timeclock-modeline-display
+ 'timeclock-mode-line-display "24.3")
+
;;;###autoload
-(defun timeclock-modeline-display (&optional arg)
- "Toggle display of the amount of time left today in the modeline.
+(defun timeclock-mode-line-display (&optional arg)
+ "Toggle display of the amount of time left today in the mode line.
If `timeclock-use-display-time' is non-nil (the default), then
-the function `display-time-mode' must be active, and the modeline
+the function `display-time-mode' must be active, and the mode line
will be updated whenever the time display is updated. Otherwise,
the timeclock will use its own sixty second timer to do its
-updating. With prefix ARG, turn modeline display on if and only
-if ARG is positive. Returns the new status of timeclock modeline
+updating. With prefix ARG, turn mode line display on if and only
+if ARG is positive. Returns the new status of timeclock mode line
display (non-nil means on)."
(interactive "P")
;; cf display-time-mode.
(or global-mode-string (setq global-mode-string '("")))
(let ((on-p (if arg
(> (prefix-numeric-value arg) 0)
- (not timeclock-modeline-display))))
+ (not timeclock-mode-line-display))))
(if on-p
(progn
(or (memq 'timeclock-mode-string global-mode-string)
(setq global-mode-string
(append global-mode-string '(timeclock-mode-string))))
- (unless (memq 'timeclock-update-modeline timeclock-event-hook)
- (add-hook 'timeclock-event-hook 'timeclock-update-modeline))
+ (add-hook 'timeclock-event-hook 'timeclock-update-mode-line)
(when timeclock-update-timer
(cancel-timer timeclock-update-timer)
(setq timeclock-update-timer nil))
(if (boundp 'display-time-hook)
- (remove-hook 'display-time-hook 'timeclock-update-modeline))
+ (remove-hook 'display-time-hook 'timeclock-update-mode-line))
(if timeclock-use-display-time
(progn
;; Update immediately so there is a visible change
;; on calling this function.
- (if display-time-mode (timeclock-update-modeline)
+ (if display-time-mode
+ (timeclock-update-mode-line)
(message "Activate `display-time-mode' or turn off \
`timeclock-use-display-time' to see timeclock information"))
- (add-hook 'display-time-hook 'timeclock-update-modeline))
+ (add-hook 'display-time-hook 'timeclock-update-mode-line))
(setq timeclock-update-timer
- (run-at-time nil 60 'timeclock-update-modeline))))
+ (run-at-time nil 60 'timeclock-update-mode-line))))
(setq global-mode-string
(delq 'timeclock-mode-string global-mode-string))
- (remove-hook 'timeclock-event-hook 'timeclock-update-modeline)
+ (remove-hook 'timeclock-event-hook 'timeclock-update-mode-line)
(if (boundp 'display-time-hook)
(remove-hook 'display-time-hook
- 'timeclock-update-modeline))
+ 'timeclock-update-mode-line))
(when timeclock-update-timer
(cancel-timer timeclock-update-timer)
(setq timeclock-update-timer nil)))
(force-mode-line-update)
- (setq timeclock-modeline-display on-p)))
+ (setq timeclock-mode-line-display on-p)))
;; This has to be here so that the function definition of
-;; `timeclock-modeline-display' is known to the "set" function.
-(defcustom timeclock-modeline-display nil
- "Toggle modeline display of time remaining.
+;; `timeclock-mode-line-display' is known to the "set" function.
+(defcustom timeclock-mode-line-display nil
+ "Toggle mode line display of time remaining.
You must modify via \\[customize] for this variable to have an effect."
:set (lambda (symbol value)
- (setq timeclock-modeline-display
- (timeclock-modeline-display (or value 0))))
+ (setq timeclock-mode-line-display
+ (timeclock-mode-line-display (or value 0))))
:type 'boolean
:group 'timeclock
:require 'timeclock)
(interactive)
(setq timeclock-discrepancy nil)
(timeclock-find-discrep)
- (if (and timeclock-discrepancy timeclock-modeline-display)
- (timeclock-update-modeline))
+ (if (and timeclock-discrepancy timeclock-mode-line-display)
+ (timeclock-update-mode-line))
timeclock-discrepancy)
(defun timeclock-seconds-to-string (seconds &optional show-seconds
(timeclock-completing-read "Reason for clocking out: "
(mapcar 'list timeclock-reason-list)))
-(defun timeclock-update-modeline ()
- "Update the `timeclock-mode-string' displayed in the modeline.
+(define-obsolete-function-alias 'timeclock-update-modeline
+ 'timeclock-update-mode-line "24.3")
+
+(defun timeclock-update-mode-line ()
+ "Update the `timeclock-mode-string' displayed in the mode line.
The value of `timeclock-relative' affects the display as described in
that variable's documentation."
(interactive)
-2012-08-15 Chong Yidong <cyd@gnu.org>
+2012-08-07 Andreas Schwab <schwab@linux-m68k.org>
- * Version 24.2 released.
+ * ede/base.el (ede-with-projectfile): Use backquote forms.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.1 released.
+ inaccessable -> inaccessible spelling fix (Bug#10052)
+ * semantic/wisent/comp.el (wisent-inaccessible-symbols):
+ Rename from wisent-inaccessable-symbols, fixing a misspelling.
+ Caller changed.
+
+2012-07-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * ede/project-am.el: Fix typo.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename configure.in to configure.ac (Bug#11603).
+ * ede/autoconf-edit.el (autoconf-find-query-for-program)
+ (autoconf-new-program):
+ * ede/emacs.el (ede-emacs-version):
+ * ede/proj.el (ede-proj-setup-buildenvironment):
+ * ede/project-am.el (project-am-autoconf-file-options):
+ Prefer configure.ac to configure.in.
2012-03-12 David Engster <deng@randomsample.de>
(srecode-template-inserter-ask, srecode-template-inserter-width)
(srecode-template-inserter-section-start)
(srecode-template-inserter-section-end, srecode-insert-method):
+ Fix typos in docstrings.
2010-01-12 Juanma Barranquero <lekktu@gmail.com>
"Keymap used in data-debug.")
(defcustom data-debug-mode-hook nil
- "*Hook run when data-debug starts."
+ "Hook run when data-debug starts."
:group 'data-debug
:type 'hook)
(declare-function ede-srecode-insert "ede/srecode")
(defun autoconf-new-program (rootdir program testfile)
- "Initialize a new configure.in in ROOTDIR for PROGRAM using TESTFILE.
+ "Initialize a new configure.ac in ROOTDIR for PROGRAM using TESTFILE.
ROOTDIR is the root directory of a given autoconf controlled project.
PROGRAM is the program to be configured.
TESTFILE is the file used with AC_INIT.
"Position the cursor where PROG is queried.
PROG is the VARIABLE to use in autoconf to identify the program.
PROG excludes the _PROG suffix. Thus if PROG were EMACS, then the
-variable in configure.in would be EMACS_PROG."
+variable in configure.ac would be EMACS_PROG."
(let ((op (point))
(found t)
(builtin (assoc prog autoconf-program-builtin)))
;;
(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.
"Find the Emacs version for the Emacs src in DIR.
Return a tuple of ( EMACSNAME . VERSION )."
(let ((buff (get-buffer-create " *emacs-query*"))
+ (configure_ac "configure.ac")
(emacs "Emacs")
(ver ""))
(with-current-buffer buff
(erase-buffer)
(setq default-directory (file-name-as-directory dir))
+ (or (file-exists-p configure_ac)
+ (setq configure_ac "configure.in"))
;(call-process "egrep" nil buff nil "-n" "-e" "^version=" "Makefile")
- (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" "configure.in")
+ (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" configure_ac)
(goto-char (point-min))
;(re-search-forward "version=\\([0-9.]+\\)")
(cond
;; Vaguely recent version of GNU Emacs?
(t
- (insert-file-contents "configure.in")
+ (insert-file-contents configure_ac)
(goto-char (point-min))
(re-search-forward "AC_INIT(emacs,\\s-*\\([0-9.]+\\)\\s-*)")
(setq ver (match-string 1))
(defmethod ede-proj-setup-buildenvironment ((this ede-proj-project)
&optional force)
"Setup the build environment for project THIS.
-Handles the Makefile, or a Makefile.am configure.in combination.
+Handles the Makefile, or a Makefile.am configure.ac combination.
Optional argument FORCE will force items to be regenerated."
(if (not force)
(ede-proj-makefile-create-maybe this (ede-proj-dist-makefile this))
out))
-;;; Configure.in queries.
+;;; Configure.ac queries.
;;
(defvar project-am-autoconf-file-options
- '("configure.in" "configure.ac")
+ '("configure.ac" "configure.in")
"List of possible configure files to look in for project info.")
(defun project-am-autoconf-file (dir)
(configfiles nil)
)
(cond
- ;; Try configure.in or configure.ac
+ ;; Try configure.ac or configure.in
(conf-in
(project-am-with-config-current conf-in
(let ((aci (autoconf-parameters-for-macro "AC_INIT"))
(list (mode-local--override name args body))
result)))
+;;;###autoload
+(put 'define-overloadable-function 'doc-string-elt 3)
+
(defmacro define-overloadable-function (name args docstring &rest body)
"Define a new function, as with `defun', which can be overloaded.
NAME is the name of the function to create.
appropriate arguments deduced from ARGS.
OVERARGS is a list of arguments passed to the override and
`NAME-default' function, in place of those deduced from ARGS."
+ (declare (doc-string 3))
`(eval-and-compile
(defun ,name ,args
,docstring
(:background "#AAAA33"))
(((class color) (background light))
(:background "#FFFFAA")))
- "*Face used at beginning of a highlight."
+ "Face used at beginning of a highlight."
:group 'pulse)
(defface pulse-highlight-face
(:background "#AAAA33"))
(((class color) (background light))
(:background "#FFFFAA")))
- "*Face used during a pulse for display. *DO NOT CUSTOMIZE*
+ "Face used during a pulse for display. *DO NOT CUSTOMIZE*
Face used for temporary highlighting of tags for effect."
:group 'pulse)
)
(defvar semantic-working-type 'percent
- "*The type of working message to use when parsing.
+ "The type of working message to use when parsing.
'percent means we are doing a linear parse through the buffer.
'dynamic means we are reparsing specific tags.")
(semantic-varalias-obsolete 'semantic-bovination-working-type
'semantic-working-type "23.2")
(defvar semantic-minimum-working-buffer-size (* 1024 5)
- "*The minimum size of a buffer before working messages are displayed.
+ "The minimum size of a buffer before working messages are displayed.
Buffers smaller than this will parse silently.
Buffers larger than this will display the working progress bar.")
N Ns)))
(setq N Np)))
-(defun wisent-inaccessable-symbols ()
+(defun wisent-inaccessible-symbols ()
"Find out which productions are reachable and which symbols are used."
;; Starting with an empty set of productions and a set of symbols
;; which only has the start symbol in it, iterate over all
nuseless-productions 0)
(wisent-useless-nonterminals)
- (wisent-inaccessable-symbols)
+ (wisent-inaccessible-symbols)
(when (> (+ nuseless-nonterminals nuseless-productions) 0)
(wisent-total-useless)
-;;; 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.
(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)))
"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*."
"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."
;;; Code:
-(eval-when-compile (require 'cl))
(require 'ring)
(require 'ansi-color)
+(require 'regexp-opt) ;For regexp-opt-charset.
\f
;; Buffer Local Variables:
;;============================================================================
`comint-kill-whole-line' or `comint-kill-region' with no
narrowing in effect. This way you will be certain that none of
the remaining prompts will be accidentally messed up. You may
-wish to put something like the following in your `.emacs' file:
+wish to put something like the following in your init file:
\(add-hook 'comint-mode-hook
(lambda ()
(defun comint-search-arg (arg)
;; First make sure there is a ring and that we are after the process mark
(cond ((not (comint-after-pmark-p))
- (error "Not at command line"))
+ (user-error "Not at command line"))
((or (null comint-input-ring)
(ring-empty-p comint-input-ring))
- (error "Empty input ring"))
+ (user-error "Empty input ring"))
((zerop arg)
;; arg of zero resets search from beginning, and uses arg of 1
(setq comint-input-ring-index nil)
Moves relative to START, or `comint-input-ring-index'."
(if (or (not (ring-p comint-input-ring))
(ring-empty-p comint-input-ring))
- (error "No history"))
+ (user-error "No history"))
(let* ((len (ring-length comint-input-ring))
(motion (if (> arg 0) 1 -1))
(n (mod (- (or start (comint-search-start arg)) motion) len))
(let ((pos (comint-previous-matching-input-string-position regexp n)))
;; Has a match been found?
(if (null pos)
- (error "Not found")
+ (user-error "Not found")
;; If leaving the edit line, save partial input
(if (null comint-input-ring-index) ;not yet on ring
(setq comint-stored-incomplete-input
(goto-char (match-beginning 0))
(if (not (search-forward old pos t))
(or silent
- (error "Not found"))
+ (user-error "Not found"))
(replace-match new t t)
(message "History item: substituted"))))
(t
(if comint-history-isearch-message-overlay
(delete-overlay comint-history-isearch-message-overlay))
(setq isearch-message-prefix-add nil)
- (setq isearch-search-fun-function nil)
+ (setq isearch-search-fun-function 'isearch-search-fun-default)
(setq isearch-message-function nil)
(setq isearch-wrap-function nil)
(setq isearch-push-state-function nil)
(defun comint-history-isearch-search ()
"Return the proper search function, for Isearch in input history."
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (t
- (lambda (string bound noerror)
- (let ((search-fun
- ;; Use standard functions to search within comint text
- (cond
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
- found)
- ;; Avoid lazy-highlighting matches in the comint prompt and in the
- ;; output when searching forward. Lazy-highlight calls this lambda
- ;; with the bound arg, so skip the prompt and the output.
- (if (and bound isearch-forward (not (comint-after-pmark-p)))
- (goto-char (process-mark (get-buffer-process (current-buffer)))))
- (or
- ;; 1. First try searching in the initial comint text
- (funcall search-fun string
- (if isearch-forward bound (comint-line-beginning-position))
- noerror)
- ;; 2. If the above search fails, start putting next/prev history
- ;; elements in the comint successively, and search the string
- ;; in them. Do this only when bound is nil (i.e. not while
- ;; lazy-highlighting search strings in the current comint text).
- (unless bound
- (condition-case nil
- (progn
- (while (not found)
- (cond (isearch-forward
- ;; Signal an error here explicitly, because
- ;; `comint-next-input' doesn't signal an error.
- (when (null comint-input-ring-index)
- (error "End of history; no next item"))
- (comint-next-input 1)
- (goto-char (comint-line-beginning-position)))
- (t
- ;; Signal an error here explicitly, because
- ;; `comint-previous-input' doesn't signal an error.
- (when (eq comint-input-ring-index
- (1- (ring-length comint-input-ring)))
- (error "Beginning of history; no preceding item"))
- (comint-previous-input 1)
- (goto-char (point-max))))
- (setq isearch-barrier (point) isearch-opoint (point))
- ;; After putting the next/prev history element, search
- ;; the string in them again, until comint-next-input
- ;; or comint-previous-input raises an error at the
- ;; beginning/end of history.
- (setq found (funcall search-fun string
- (unless isearch-forward
- ;; For backward search, don't search
- ;; in the comint prompt
- (comint-line-beginning-position))
- noerror)))
- ;; Return point of the new search result
- (point))
- ;; Return nil on the error "no next/preceding item"
- (error nil)))))))))
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within comint text
+ (isearch-search-fun-default))
+ found)
+ ;; Avoid lazy-highlighting matches in the comint prompt and in the
+ ;; output when searching forward. Lazy-highlight calls this lambda
+ ;; with the bound arg, so skip the prompt and the output.
+ (if (and bound isearch-forward (not (comint-after-pmark-p)))
+ (goto-char (process-mark (get-buffer-process (current-buffer)))))
+ (or
+ ;; 1. First try searching in the initial comint text
+ (funcall search-fun string
+ (if isearch-forward bound (comint-line-beginning-position))
+ noerror)
+ ;; 2. If the above search fails, start putting next/prev history
+ ;; elements in the comint successively, and search the string
+ ;; in them. Do this only when bound is nil (i.e. not while
+ ;; lazy-highlighting search strings in the current comint text).
+ (unless bound
+ (condition-case nil
+ (progn
+ (while (not found)
+ (cond (isearch-forward
+ ;; Signal an error here explicitly, because
+ ;; `comint-next-input' doesn't signal an error.
+ (when (null comint-input-ring-index)
+ (error "End of history; no next item"))
+ (comint-next-input 1)
+ (goto-char (comint-line-beginning-position)))
+ (t
+ ;; Signal an error here explicitly, because
+ ;; `comint-previous-input' doesn't signal an error.
+ (when (eq comint-input-ring-index
+ (1- (ring-length comint-input-ring)))
+ (error "Beginning of history; no preceding item"))
+ (comint-previous-input 1)
+ (goto-char (point-max))))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After putting the next/prev history element, search
+ ;; the string in them again, until comint-next-input
+ ;; or comint-previous-input raises an error at the
+ ;; beginning/end of history.
+ (setq found (funcall search-fun string
+ (unless isearch-forward
+ ;; For backward search, don't search
+ ;; in the comint prompt
+ (comint-line-beginning-position))
+ noerror)))
+ ;; Return point of the new search result
+ (point))
+ ;; Return nil on the error "no next/preceding item"
+ (error nil)))))))
(defun comint-history-isearch-message (&optional c-q-hack ellipsis)
"Display the input history search prompt.
"Wrap the input history search when search fails.
Move point to the first history element for a forward search,
or to the last history element for a backward search."
- (unless isearch-word
- ;; When `comint-history-isearch-search' fails on reaching the
- ;; beginning/end of the history, wrap the search to the first/last
- ;; input history element.
- (if isearch-forward
- (comint-goto-input (1- (ring-length comint-input-ring)))
- (comint-goto-input nil))
- (setq isearch-success t))
+ ;; When `comint-history-isearch-search' fails on reaching the
+ ;; beginning/end of the history, wrap the search to the first/last
+ ;; input history element.
+ (if isearch-forward
+ (comint-goto-input (1- (ring-length comint-input-ring)))
+ (comint-goto-input nil))
+ (setq isearch-success t)
(goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
(defun comint-history-isearch-push-state ()
(interactive)
;; Note that the input string does not include its terminal newline.
(let ((proc (get-buffer-process (current-buffer))))
- (if (not proc) (error "Current buffer has no process")
+ (if (not proc) (user-error "Current buffer has no process")
(widen)
(let* ((pmark (process-mark proc))
(intxt (if (>= (point) (marker-position pmark))
(goto-char (process-mark process))
(set-marker comint-last-output-start (point))
+ ;; Try to skip repeated prompts, which can occur as a result of
+ ;; commands sent without inserting them in the buffer.
+ (let ((bol (save-excursion (forward-line 0) (point)))) ;No fields.
+ (when (and (not (bolp))
+ (looking-back comint-prompt-regexp bol))
+ (let* ((prompt (buffer-substring bol (point)))
+ (prompt-re (concat "\\`" (regexp-quote prompt))))
+ (while (string-match prompt-re string)
+ (setq string (substring string (match-end 0)))))))
+ (while (string-match (concat "\\(^" comint-prompt-regexp
+ "\\)\\1+")
+ string)
+ (setq string (replace-match "\\1" nil nil string)))
+
;; insert-before-markers is a bad thing. XXX
;; Luckily we don't have to use it any more, we use
;; window-point-insertion-type instead.
(select-window selected))))
nil t))))))
+(defvar follow-mode)
+(declare-function follow-comint-scroll-to-bottom "follow" (&optional window))
+
(defun comint-postoutput-scroll-to-bottom (_string)
"Go to the end of buffer in some or all windows showing it.
-Does not scroll if the current line is the last line in the buffer.
+Do not scroll if the current line is the last line in the buffer.
Depends on the value of `comint-move-point-for-output' and
`comint-scroll-show-maximum-output'.
This function should be in the list `comint-output-filter-functions'."
- (let* ((selected (selected-window))
- (current (current-buffer))
- (process (get-buffer-process current))
- (scroll comint-move-point-for-output))
+ (let* ((current (current-buffer))
+ (process (get-buffer-process current)))
(unwind-protect
- (if process
- (walk-windows
- (lambda (window)
- (when (eq (window-buffer window) current)
- (select-window window)
- (if (and (< (point) (process-mark process))
- (or (eq scroll t) (eq scroll 'all)
- ;; Maybe user wants point to jump to end.
- (and (eq scroll 'this) (eq selected window))
- (and (eq scroll 'others) (not (eq selected window)))
- ;; If point was at the end, keep it at end.
- (and (marker-position comint-last-output-start)
- (>= (point) comint-last-output-start))))
- (goto-char (process-mark process)))
- ;; Optionally scroll so that the text
- ;; ends at the bottom of the window.
- (if (and comint-scroll-show-maximum-output
- (= (point) (point-max)))
- (save-excursion
- (goto-char (point-max))
- (recenter (- -1 scroll-margin))))
- (select-window selected)))
- nil t))
+ (cond
+ ((null process))
+ ((bound-and-true-p follow-mode)
+ (follow-comint-scroll-to-bottom))
+ (t
+ (let ((selected (selected-window)))
+ (dolist (w (get-buffer-window-list current nil t))
+ (select-window w)
+ (unwind-protect
+ (progn
+ (comint-adjust-point selected)
+ ;; Optionally scroll to the bottom of the window.
+ (and comint-scroll-show-maximum-output
+ (eobp)
+ (recenter (- -1 scroll-margin))))
+ (select-window selected))))))
(set-buffer current))))
+(defun comint-adjust-point (selected)
+ "Move point in the selected window based on Comint settings.
+SELECTED is the window that was originally selected."
+ (let ((process (get-buffer-process (current-buffer))))
+ (and (< (point) (process-mark process))
+ (or (memq comint-move-point-for-output '(t all))
+ ;; Maybe user wants point to jump to end.
+ (eq comint-move-point-for-output
+ (if (eq (selected-window) selected) 'this 'others))
+ ;; If point was at the end, keep it at end.
+ (and (marker-position comint-last-output-start)
+ (>= (point) comint-last-output-start)))
+ (goto-char (process-mark process)))))
+
(defun comint-truncate-buffer (&optional _string)
"Truncate the buffer to `comint-buffer-maximum-size'.
This function could be on `comint-output-filter-functions' or bound to a key."
(let ((input (funcall comint-get-old-input))
(process (get-buffer-process (current-buffer))))
(if (not process)
- (error "Current buffer has no process")
+ (user-error "Current buffer has no process")
(goto-char (process-mark process))
(insert input))))
(save-excursion
(while (/= n 0)
(unless (re-search-backward regexp nil t dir)
- (error "Not found"))
+ (user-error "Not found"))
(unless (get-char-property (point) 'field)
(setq n (- n dir))))
(field-beginning))))
the case, this command just calls `kill-region' with all
read-only properties intact. The read-only status of newlines is
updated using `comint-update-fence', if necessary."
+ (declare (advertised-calling-convention (beg end) "23.3"))
(interactive "r")
(save-excursion
(let* ((true-beg (min beg end))
(let ((inhibit-read-only t))
(kill-region beg end yank-handler)
(comint-update-fence))))))
-(set-advertised-calling-convention 'comint-kill-region '(beg end) "23.3")
-
\f
;; Support for source-file processing commands.
;;============================================================================
"Return the word of WORD-CHARS at point, or nil if none is found.
Word constituents are considered to be those in WORD-CHARS, which is like the
inside of a \"[...]\" (see `skip-chars-forward'), plus all non-ASCII characters."
+ ;; FIXME: Need to handle "..." and '...' quoting in shell.el!
+ ;; This should be combined with completion parsing somehow.
(save-excursion
(let ((here (point))
giveup)
(while (not giveup)
(let ((startpoint (point)))
(skip-chars-backward (concat "\\\\" word-chars))
- ;; Fixme: This isn't consistent with Bash, at least -- not
- ;; all non-ASCII chars should be word constituents.
- (if (and (> (- (point) 2) (point-min))
- (= (char-after (- (point) 2)) ?\\))
+ (if (and comint-file-name-quote-list
+ (eq (char-before (1- (point))) ?\\))
(forward-char -2))
- (if (and (> (- (point) 1) (point-min))
- (>= (char-after (- (point) 1)) 128))
+ ;; FIXME: This isn't consistent with Bash, at least -- not
+ ;; all non-ASCII chars should be word constituents.
+ (if (and (not (bobp)) (>= (char-before) 128))
(forward-char -1))
(if (= (point) startpoint)
(setq giveup t))))
See `comint-word'."
(comint-word comint-file-name-chars))
-(defun comint--unquote&expand-filename (filename)
- ;; FIXME: The code below does unquote-then-expand which means that "\\$HOME"
- ;; gets expanded to the same as "$HOME"
- (comint-substitute-in-file-name
- (comint-unquote-filename filename)))
+(defun comint--unquote&requote-argument (qstr &optional upos)
+ (unless upos (setq upos 0))
+ (let* ((qpos 0)
+ (ustrs '())
+ (re (concat
+ "\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
+ "\\|{\\(?1:[^{}]+\\)}\\)"
+ (when (memq system-type '(ms-dos windows-nt))
+ "\\|%\\(?1:[^\\\\/]*\\)%")
+ (when comint-file-name-quote-list
+ "\\|\\\\\\(.\\)")))
+ (qupos nil)
+ (push (lambda (str end)
+ (push str ustrs)
+ (setq upos (- upos (length str)))
+ (unless (or qupos (> upos 0))
+ (setq qupos (if (< end 0) (- end) (+ upos end))))))
+ match)
+ (while (setq match (string-match re qstr qpos))
+ (funcall push (substring qstr qpos match) match)
+ (cond
+ ((match-beginning 2) (funcall push (match-string 2 qstr) (match-end 0)))
+ ((match-beginning 1) (funcall push (getenv (match-string 1 qstr))
+ (- (match-end 0))))
+ (t (error "Unexpected case in comint--unquote&requote-argument!")))
+ (setq qpos (match-end 0)))
+ (funcall push (substring qstr qpos) (length qstr))
+ (list (mapconcat #'identity (nreverse ustrs) "")
+ qupos #'comint-quote-filename)))
+
+(defun comint--unquote-argument (str)
+ (car (comint--unquote&requote-argument str)))
+(define-obsolete-function-alias 'comint--unquote&expand-filename
+ #'comint--unquote-argument "24.3")
(defun comint-match-partial-filename ()
"Return the unquoted&expanded filename at point, or nil if none is found.
Environment variables are substituted. See `comint-word'."
(let ((filename (comint--match-partial-filename)))
- (and filename (comint--unquote&expand-filename filename))))
+ (and filename (comint--unquote-argument filename))))
(defun comint-quote-filename (filename)
"Return FILENAME with magic characters quoted.
Magic characters are those in `comint-file-name-quote-list'."
(if (null comint-file-name-quote-list)
filename
- (let ((regexp
- (format "[%s]"
- (mapconcat 'char-to-string comint-file-name-quote-list ""))))
+ (let ((regexp (regexp-opt-charset comint-file-name-quote-list)))
(save-match-data
(let ((i 0))
(while (string-match regexp filename i)
(defun comint-unquote-filename (filename)
"Return FILENAME with quoted characters unquoted."
+ (declare (obsolete nil "24.3"))
(if (null comint-file-name-quote-list)
filename
(save-match-data
(replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
+(defun comint--requote-argument (upos qstr)
+ ;; See `completion-table-with-quoting'.
+ (let ((res (comint--unquote&requote-argument qstr upos)))
+ (cons (nth 1 res) (nth 2 res))))
+
(defun comint-completion-at-point ()
(run-hook-with-args-until-success 'comint-dynamic-complete-functions))
(when (comint--match-partial-filename)
(comint--complete-file-name-data)))
-;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and
-;; comint--table-subvert don't fully solve the problem, since
-;; selecting a file from *Completions* won't quote it, among several
-;; other problems.
-
-(defun comint--common-suffix (s1 s2)
- (assert (not (or (string-match "\n" s1) (string-match "\n" s2))))
- ;; Since S2 is expected to be the "unquoted/expanded" version of S1,
- ;; there shouldn't be any case difference, even if the completion is
- ;; case-insensitive.
- (let ((case-fold-search nil))
- (string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2))
- (- (match-end 1) (match-beginning 1))))
-
-(defun comint--common-quoted-suffix (s1 s2)
- ;; FIXME: Copied in pcomplete.el.
- "Find the common suffix between S1 and S2 where S1 is the expanded S2.
-S1 is expected to be the unquoted and expanded version of S2.
-Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
-S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
-SS1 = (unquote SS2)."
- (let* ((cs (comint--common-suffix s1 s2))
- (ss1 (substring s1 (- (length s1) cs)))
- (qss1 (comint-quote-filename ss1))
- qc s2b)
- (if (and (not (equal ss1 qss1))
- (setq qc (comint-quote-filename (substring ss1 0 1)))
- (setq s2b (- (length s2) cs (length qc) -1))
- (>= s2b 0) ;bug#11158.
- (eq t (compare-strings s2 s2b (- (length s2) cs -1)
- qc nil nil)))
- ;; The difference found is just that one char is quoted in S2
- ;; but not in S1, keep looking before this difference.
- (comint--common-quoted-suffix
- (substring s1 0 (- (length s1) cs))
- (substring s2 0 s2b))
- (cons (substring s1 0 (- (length s1) cs))
- (substring s2 0 (- (length s2) cs))))))
-
-(defun comint--table-subvert (table s1 s2 &optional quote-fun unquote-fun)
- "Completion table that replaces the prefix S1 with S2 in STRING.
-The result is a completion table which completes strings of the
-form (concat S1 S) in the same way as TABLE completes strings of
-the form (concat S2 S)."
- (lambda (string pred action)
- (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
- completion-ignore-case))
- (let ((rest (substring string (length s1))))
- (concat s2 (if unquote-fun
- (funcall unquote-fun rest) rest)))))
- (res (if str (complete-with-action action table str pred))))
- (when res
- (cond
- ((and (eq (car-safe action) 'boundaries))
- (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
- (list* 'boundaries
- (max (length s1)
- ;; FIXME: Adjust because of quoting/unquoting.
- (+ beg (- (length s1) (length s2))))
- (and (eq (car-safe res) 'boundaries) (cddr res)))))
- ((stringp res)
- (if (eq t (compare-strings res 0 (length s2) s2 nil nil
- completion-ignore-case))
- (let ((rest (substring res (length s2))))
- (concat s1 (if quote-fun (funcall quote-fun rest) rest)))))
- ((eq action t)
- (let ((bounds (completion-boundaries str table pred "")))
- (if (>= (car bounds) (length s2))
- (if quote-fun (mapcar quote-fun res) res)
- (let ((re (concat "\\`"
- (regexp-quote (substring s2 (car bounds))))))
- (delq nil
- (mapcar (lambda (c)
- (if (string-match re c)
- (let ((str (substring c (match-end 0))))
- (if quote-fun
- (funcall quote-fun str) str))))
- res))))))
- ;; E.g. action=nil and it's the only completion.
- (res))))))
-
(defun comint-completion-file-name-table (string pred action)
(if (not (file-name-absolute-p string))
(completion-file-name-table string pred action)
res)))
(t (completion-file-name-table string pred action)))))
+(defvar comint-unquote-function #'comint--unquote-argument
+ "Function to use for completion of quoted data.
+See `completion-table-with-quoting' and `comint-requote-function'.")
+(defvar comint-requote-function #'comint--requote-argument
+ "Function to use for completion of quoted data.
+See `completion-table-with-quoting' and `comint-unquote-function'.")
+
(defun comint--complete-file-name-data ()
"Return the completion data for file name at point."
(let* ((filesuffix (cond ((not comint-completion-addsuffix) "")
(filename (comint--match-partial-filename))
(filename-beg (if filename (match-beginning 0) (point)))
(filename-end (if filename (match-end 0) (point)))
- (unquoted (if filename (comint--unquote&expand-filename filename) ""))
(table
- (let ((prefixes (comint--common-quoted-suffix
- unquoted filename)))
- (comint--table-subvert
- #'comint-completion-file-name-table
- (cdr prefixes) (car prefixes)
- #'comint-quote-filename #'comint-unquote-filename))))
+ (completion-table-with-quoting
+ #'comint-completion-file-name-table
+ comint-unquote-function
+ comint-requote-function)))
(nconc
(list
filename-beg filename-end
(complete-with-action action table string pred))))
(unless (zerop (length filesuffix))
(list :exit-function
- (lambda (_s finished)
- (when (memq finished '(sole finished))
+ (lambda (_s status)
+ (when (eq status 'finished)
(if (looking-at (regexp-quote filesuffix))
(goto-char (match-end 0))
(insert filesuffix)))))))))
(defun comint-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
See `comint-dynamic-complete-filename'. Returns t if successful."
+ (declare (obsolete comint-filename-completion "24.1"))
(let ((data (comint--complete-file-name-data)))
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))
-(make-obsolete 'comint-dynamic-complete-as-filename
- 'comint-filename-completion "24.1")
(defun comint-replace-by-expanded-filename ()
"Dynamically expand and complete the filename at point.
Return `listed' if a completion listing was shown.
See also `comint-dynamic-complete-filename'."
+ (declare (obsolete completion-in-region "24.1"))
(let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
(minibuffer-p (window-minibuffer-p (selected-window)))
(suffix (cond ((not comint-completion-addsuffix) "")
(unless minibuffer-p
(message "Partially completed"))
'partial)))))))
-(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1")
-
(defun comint-dynamic-list-filename-completions ()
"Display a list of possible completions for the filename at point."
from input that has not yet been sent."
(interactive)
(let ((proc (or (get-buffer-process (current-buffer))
- (error "Current buffer has no process"))))
+ (user-error "Current buffer has no process"))))
(goto-char (process-mark proc))
(when (called-interactively-p 'interactive)
(message "Point is now at the process mark"))))
"Set the process mark at point."
(interactive)
(let ((proc (or (get-buffer-process (current-buffer))
- (error "Current buffer has no process"))))
+ (user-error "Current buffer has no process"))))
(set-marker (process-mark proc) (point))
(message "Process mark set")))
(match-end regexp-group))
results))
results)))
-
-(dolist (x '("^Not at command line$"
- "^Empty input ring$"
- "^No history$"
- "^Not found$" ; Too common?
- "^Current buffer has no process$"))
- (add-to-list 'debug-ignored-errors x))
-
\f
;; Converting process modes to use comint mode
;; ===========================================================================
;; superior to that of the LISPM version.
;;
;;-----------------------------------------------
-;; Acknowledgements
+;; Acknowledgments
;;-----------------------------------------------
;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com),
;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu,
:group 'completion)
;;(defvar *record-cmpl-statistics-p* nil
-;; "*If non-nil, record completion statistics.")
+;; "If non-nil, record completion statistics.")
;;(defvar *completion-auto-save-period* 1800
-;; "*The period in seconds to wait for emacs to be idle before autosaving
+;; "The period in seconds to wait for emacs to be idle before autosaving
;;the completions. Default is a 1/2 hour.")
(defvar completion-min-length 6
- "*The minimum length of a stored completion.
+ "The minimum length of a stored completion.
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
(defvar completion-max-length 200
- "*The maximum length of a stored completion.
+ "The maximum length of a stored completion.
DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.")
(defvar completion-prefix-min-length 3
(defun check-completion-length (string)
(if (< (length string) completion-min-length)
- (error "The string `%s' is too short to be saved as a completion"
- string)
+ (user-error "The string `%s' is too short to be saved as a completion"
+ string)
(list string)))
(defun add-completion (string &optional num-uses last-use-time)
(defvaralias 'cmpl-syntax-table 'completion-syntax-table)
(defalias 'initialize-completions 'completion-initialize)
-(dolist (x '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$"
- "^The string \".*\" is too short to be saved as a completion\\.$"))
- (add-to-list 'debug-ignored-errors x))
-
(provide 'completion)
;;; completion.el ends here
;;; Code:
-(eval-when-compile (require 'cl))
-
(defconst reference-point-alist
'((tl . 0) (tc . 1) (tr . 2)
(Bl . 3) (Bc . 4) (Br . 5)
;;; Code:
-(eval-when-compile (require 'cl))
(require 'widget)
(require 'cus-face)
(default-directory (expand-file-name subdir))
(preloaded (concat "\\`"
(regexp-opt (mapcar
- (lambda (f)
- (file-name-sans-extension
- (file-name-nondirectory f)))
+ 'file-name-base
preloaded-file-list) t)
"\\.el\\'")))
(dolist (file files)
;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
-;; Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
:group 'emacs)
(defgroup languages nil
- "Specialized modes for editing programming languages."
+ "Modes for editing programming languages."
:group 'programming)
(defgroup lisp nil
:group 'applications)
(defgroup news nil
- "Support for netnews reading and posting."
+ "Reading and posting to newsgroups."
:link '(custom-manual "(gnus)")
:group 'applications)
:group 'environment)
(defgroup unix nil
- "Front-ends/assistants for, or emulators of, UNIX features."
+ "Interfaces, assistants, and emulators for UNIX features."
:group 'environment)
(defgroup i18n nil
:group 'editing)
(defgroup mode-line nil
- "Content of the modeline."
+ "Contents of the mode line."
:group 'environment)
(defgroup editing-basics nil
:type 'boolean)
(defcustom custom-unlispify-remove-prefixes nil
- "Non-nil means remove group prefixes from option names in buffer."
+ "Non-nil means remove group prefixes from option names in buffer.
+Discarding prefixes often leads to confusing names for options
+and faces in Customize buffers, so do not set this to a non-nil
+value unless you are sure you know what it does."
:group 'custom-menu
:group 'custom-buffer
:type 'boolean)
(erase-buffer)
(princ symbol (current-buffer))
(goto-char (point-min))
- ;; FIXME: Boolean variables are not predicates, so they shouldn't
- ;; end with `-p'. -stef
- ;; (when (and (eq (get symbol 'custom-type) 'boolean)
- ;; (re-search-forward "-p\\'" nil t))
- ;; (replace-match "" t t)
- ;; (goto-char (point-min)))
(if custom-unlispify-remove-prefixes
(let ((prefixes custom-prefix-list)
prefix)
;; `custom-buffer-create-internal' if `custom-buffer-verbose-help' is non-nil.
(defvar custom-commands
- '((" Set for current session " Custom-set t
- "Apply all settings in this buffer to the current session"
+ '((" Apply " Custom-set t
+ "Apply settings (for the current session only)"
"index"
"Apply")
- (" Save for future sessions " Custom-save
+ (" Apply and Save " Custom-save
(or custom-file user-init-file)
- "Apply all settings in this buffer and save them for future Emacs sessions."
+ "Apply settings and save for future sessions."
"save"
"Save")
- (" Undo edits " Custom-reset-current t
- "Restore all settings in this buffer to reflect their current values."
+ (" Undo Edits " Custom-reset-current t
+ "Restore customization buffer to reflect existing settings."
"refresh"
"Undo")
- (" Reset to saved " Custom-reset-saved t
- "Restore all settings in this buffer to their saved values (if any)."
+ (" Reset Customizations " Custom-reset-saved t
+ "Undo any settings applied only for the current session."
"undo"
"Reset")
- (" Erase customizations " Custom-reset-standard
+ (" Erase Customizations " Custom-reset-standard
(or custom-file user-init-file)
- "Un-customize all settings in this buffer and save them with standard values."
+ "Un-customize settings in this and future sessions."
"delete"
"Uncustomize")
(" Help for Customize " Custom-help t
(info "(emacs)Easy Customization"))
(defvar custom-reset-menu
- '(("Undo Edits" . Custom-reset-current)
- ("Reset to Saved" . Custom-reset-saved)
- ("Erase Customizations (use standard values)" . Custom-reset-standard))
+ '(("Undo Edits in Customization Buffer" . Custom-reset-current)
+ ("Revert This Session's Customizations" . Custom-reset-saved)
+ ("Erase Customizations" . Custom-reset-standard))
"Alist of actions for the `Reset' button.
The key is a string containing the name of the action, the value is a
Lisp function taking the widget as an element which will be called
(memq (widget-get widget :custom-state)
'(modified set changed saved rogue))
(widget-apply widget :custom-mark-to-reset-standard)))
- "Erase all customizations for settings in this buffer? " t)
+ "The settings will revert to their default values, in this
+and future sessions. Really erase customizations? " t)
(custom-reset-standard-save-and-update)))
;;; The Customize Commands
;;;###autoload
(defun customize-option (symbol)
- "Customize SYMBOL, which must be a user option variable."
+ "Customize SYMBOL, which must be a user option."
(interactive (custom-variable-prompt))
(unless symbol
(error "No variable specified"))
;;;###autoload
(defun customize-option-other-window (symbol)
- "Customize SYMBOL, which must be a user option variable.
+ "Customize SYMBOL, which must be a user option.
Show the buffer in another window, but don't select it."
(interactive (custom-variable-prompt))
(unless symbol
(unless (eq symbol basevar)
(message "`%s' is an alias for `%s'" symbol basevar))))
-(defvar customize-changed-options-previous-release "23.4"
+(defvar customize-changed-options-previous-release "24.1"
"Version for `customize-changed-options' to refer back to by default.")
;; Packages will update this variable, so make it available.
;;;###autoload
(defun customize-changed-options (&optional since-version)
"Customize all settings whose meanings have changed in Emacs itself.
-This includes new user option variables and faces, and new
-customization groups, as well as older options and faces whose meanings
-or default values have changed since the previous major Emacs release.
+This includes new user options and faces, and new customization
+groups, as well as older options and faces whose meanings or
+default values have changed since the previous major Emacs
+release.
With argument SINCE-VERSION (a string), customize all settings
that were added or redefined since that version."
(if found
(custom-buffer-create (custom-sort-items found t 'first)
"*Customize Changed Options*")
- (error "No user option defaults have been changed since Emacs %s"
- since-version))))
+ (user-error "No user option defaults have been changed since Emacs %s"
+ since-version))))
(defun customize-package-emacs-version (symbol package-version)
"Return the Emacs version in which SYMBOL's meaning last changed.
(default-value symbol))))
(push (list symbol 'custom-variable) found)))))
(if (not found)
- (error "No rogue user options")
+ (user-error "No rogue user options")
(custom-buffer-create (custom-sort-items found t nil)
"*Customize Rogue*"))))
;;;###autoload
(get symbol 'saved-variable-comment))
(boundp symbol)
(push (list symbol 'custom-variable) found))))
- (if (not found )
- (error "No saved user options")
+ (if (not found)
+ (user-error "No saved user options")
(custom-buffer-create (custom-sort-items found t nil)
"*Customize Saved*"))))
;;;###autoload
(defun customize-apropos (pattern &optional type)
- "Customize all loaded options, faces and groups matching PATTERN.
+ "Customize loaded options, faces and groups matching PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
or a regexp (using some regexp special characters). If it is a word,
search for matches for that word as a substring. If it is a list of words,
If TYPE is `options', include only options.
If TYPE is `faces', include only faces.
-If TYPE is `groups', include only groups.
-If TYPE is t (interactively, with prefix arg), include variables
-that are not customizable options, as well as faces and groups
-\(but we recommend using `apropos-variable' instead)."
- (interactive (list (apropos-read-pattern "symbol") current-prefix-arg))
+If TYPE is `groups', include only groups."
+ (interactive (list (apropos-read-pattern "symbol") nil))
(require 'apropos)
+ (unless (memq type '(nil options faces groups))
+ (error "Invalid setting type %s" (symbol-name type)))
(apropos-parse-pattern pattern)
(let (found)
(mapatoms
`(lambda (symbol)
(when (string-match apropos-regexp (symbol-name symbol))
- ,(if (not (memq type '(faces options)))
+ ,(if (memq type '(nil groups))
'(if (get symbol 'custom-group)
(push (list symbol 'custom-group) found)))
- ,(if (not (memq type '(options groups)))
+ ,(if (memq type '(nil faces))
'(if (custom-facep symbol)
(push (list symbol 'custom-face) found)))
- ,(if (not (memq type '(groups faces)))
+ ,(if (memq type '(nil options))
`(if (and (boundp symbol)
(eq (indirect-variable symbol) symbol)
(or (get symbol 'saved-value)
- (custom-variable-p symbol)
- ,(if (not (memq type '(nil options)))
- '(get symbol 'variable-documentation))))
+ (custom-variable-p symbol)))
(push (list symbol 'custom-variable) found))))))
- (if (not found)
- (error "No %s matching %s"
- (if (eq type t)
- "items"
- (format "customizable %s"
- (if (memq type '(options faces groups))
- (symbol-name type)
- "items")))
- pattern)
- (custom-buffer-create
- (custom-sort-items found t custom-buffer-order-groups)
- "*Customize Apropos*"))))
+ (unless found
+ (error "No customizable %s matching %s" (symbol-name type) pattern))
+ (custom-buffer-create
+ (custom-sort-items found t custom-buffer-order-groups)
+ "*Customize Apropos*")))
;;;###autoload
-(defun customize-apropos-options (regexp &optional arg)
- "Customize all loaded customizable options matching REGEXP.
-With prefix ARG, include variables that are not customizable options
-\(but it is better to use `apropos-variable' if you want to find those)."
- (interactive "sCustomize options (regexp): \nP")
- (customize-apropos regexp (or arg 'options)))
+(defun customize-apropos-options (regexp &optional ignored)
+ "Customize all loaded customizable options matching REGEXP."
+ (interactive (list (apropos-read-pattern "options")))
+ (customize-apropos regexp 'options))
;;;###autoload
(defun customize-apropos-faces (regexp)
"Customize all loaded faces matching REGEXP."
- (interactive "sCustomize faces (regexp): \n")
+ (interactive (list (apropos-read-pattern "faces")))
(customize-apropos regexp 'faces))
;;;###autoload
(defun customize-apropos-groups (regexp)
"Customize all loaded groups matching REGEXP."
- (interactive "sCustomize groups (regexp): \n")
+ (interactive (list (apropos-read-pattern "groups")))
(customize-apropos regexp 'groups))
;;; Buffer.
(switch-to-buffer-other-window (custom-get-fresh-buffer name))
(custom-buffer-create-internal options description))
-(defcustom custom-reset-button-menu nil
+(defcustom custom-reset-button-menu t
"If non-nil, only show a single reset button in customize buffers.
This button will have a menu with all three reset operations."
:type 'boolean
- :group 'custom-buffer)
+ :group 'custom-buffer
+ :version "24.3")
(defcustom custom-buffer-verbose-help t
"If non-nil, include explanatory text in the customization buffer."
(let ((init-file (or custom-file user-init-file)))
;; Insert verbose help at the top of the custom buffer.
(when custom-buffer-verbose-help
- (widget-insert (if init-file
- "To apply changes, use the Save or Set buttons."
- "Custom settings cannot be saved; maybe you started Emacs with `-q'.")
- "\nFor details, see ")
+ (unless init-file
+ (widget-insert "Custom settings cannot be saved; maybe you started Emacs with `-q'.\n"))
+ (widget-insert "For help using this buffer, see ")
(widget-create 'custom-manual
- :tag "Saving Customizations"
- "(emacs)Saving Customizations")
+ :tag "Easy Customization"
+ "(emacs)Easy Customization")
(widget-insert " in the ")
(widget-create 'custom-manual
:tag "Emacs manual"
;; So now the buttons are always inserted in the buffer. (Bug#1326)
(if custom-buffer-verbose-help
(widget-insert "
- Operate on all settings in this buffer:\n"))
+Operate on all settings in this buffer:\n"))
(let ((button (lambda (tag action active help _icon _label)
(widget-insert " ")
(if (eval active)
(widget-create 'push-button :tag tag
:help-echo help :action action))))
(commands custom-commands))
- (apply button (pop commands)) ; Set for current session
- (apply button (pop commands)) ; Save for future sessions
(if custom-reset-button-menu
(progn
- (widget-insert " ")
(widget-create 'push-button
- :tag "Reset buffer"
+ :tag " Revert... "
:help-echo "Show a menu with reset operations."
:mouse-down-action 'ignore
- :action 'custom-reset))
+ :action 'custom-reset)
+ (apply button (pop commands)) ; Apply
+ (apply button (pop commands))) ; Apply and Save
+ (apply button (pop commands)) ; Apply
+ (apply button (pop commands)) ; Apply and Save
(widget-insert "\n")
- (apply button (pop commands)) ; Undo edits
- (apply button (pop commands)) ; Reset to saved
- (apply button (pop commands)) ; Erase customization
+ (apply button (pop commands)) ; Undo
+ (apply button (pop commands)) ; Reset
+ (apply button (pop commands)) ; Erase
(widget-insert " ")
- (pop commands) ; Help (omitted)
+ (pop commands) ; Help (omitted)
(apply button (pop commands)))) ; Exit
(widget-insert "\n\n"))
:group 'custom-buffer)
(defface custom-invalid '((((class color))
- (:foreground "yellow1" :background "red1"))
- (t
- (:weight bold :slant italic :underline t)))
+ :foreground "yellow1" :background "red1")
+ (t :weight bold :slant italic :underline t))
"Face used when the customize item is invalid."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-invalid-face 'custom-invalid "22.1")
(defface custom-rogue '((((class color))
- (:foreground "pink" :background "black"))
- (t
- (:underline t)))
+ :foreground "pink" :background "black")
+ (t :underline t))
"Face used when the customize item is not defined for customization."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-rogue-face 'custom-rogue "22.1")
(defface custom-modified '((((min-colors 88) (class color))
- (:foreground "white" :background "blue1"))
+ :foreground "white" :background "blue1")
(((class color))
- (:foreground "white" :background "blue"))
- (t
- (:slant italic :bold)))
+ :foreground "white" :background "blue")
+ (t :slant italic))
"Face used when the customize item has been modified."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-modified-face 'custom-modified "22.1")
(defface custom-set '((((min-colors 88) (class color))
- (:foreground "blue1" :background "white"))
+ :foreground "blue1" :background "white")
(((class color))
- (:foreground "blue" :background "white"))
- (t
- (:slant italic)))
+ :foreground "blue" :background "white")
+ (t :slant italic))
"Face used when the customize item has been set."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-set-face 'custom-set "22.1")
(defface custom-changed '((((min-colors 88) (class color))
- (:foreground "white" :background "blue1"))
+ :foreground "white" :background "blue1")
(((class color))
- (:foreground "white" :background "blue"))
- (t
- (:slant italic)))
+ :foreground "white" :background "blue")
+ (t :slant italic))
"Face used when the customize item has been changed."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-changed-face 'custom-changed "22.1")
(defface custom-themed '((((min-colors 88) (class color))
- (:foreground "white" :background "blue1"))
- (((class color))
- (:foreground "white" :background "blue"))
- (t
- (:slant italic)))
+ :foreground "white" :background "blue1")
+ (((class color))
+ :foreground "white" :background "blue")
+ (t :slant italic))
"Face used when the customize item has been set by a theme."
:group 'custom-magic-faces)
-(defface custom-saved '((t (:underline t)))
+(defface custom-saved '((t :underline t))
"Face used when the customize item has been saved."
:group 'custom-magic-faces)
-(define-obsolete-face-alias 'custom-saved-face 'custom-saved "22.1")
(defconst custom-magic-alist
'((nil "#" underline "\
;;; The `custom' Widget.
(defface custom-button
- '((((type x w32 ns) (class color)) ; Like default modeline
- (:box (:line-width 2 :style released-button)
- :background "lightgrey" :foreground "black"))
- (t
- nil))
+ '((((type x w32 ns) (class color)) ; Like default mode line
+ :box (:line-width 2 :style released-button)
+ :background "lightgrey" :foreground "black"))
"Face for custom buffer buttons if `custom-raised-buttons' is non-nil."
:version "21.1"
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-button-face 'custom-button "22.1")
(defface custom-button-mouse
'((((type x w32 ns) (class color))
- (:box (:line-width 2 :style released-button)
- :background "grey90" :foreground "black"))
+ :box (:line-width 2 :style released-button)
+ :background "grey90" :foreground "black")
(t
;; This is for text terminals that support mouse, like GPM mouse
;; or the MS-DOS terminal: inverse-video makes the button stand
;; out on mouse-over.
- (:inverse-video t)))
+ :inverse-video t))
"Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil."
:version "22.1"
:group 'custom-faces)
(defface custom-button-pressed
'((((type x w32 ns) (class color))
- (:box (:line-width 2 :style pressed-button)
- :background "lightgrey" :foreground "black"))
- (t
- (:inverse-video t)))
+ :box (:line-width 2 :style pressed-button)
+ :background "lightgrey" :foreground "black")
+ (t :inverse-video t))
"Face for pressed custom buttons if `custom-raised-buttons' is non-nil."
:version "21.1"
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-button-pressed-face
- 'custom-button-pressed "22.1")
(defface custom-button-pressed-unraised
'((default :inherit custom-button-unraised)
(defface custom-documentation '((t nil))
"Face used for documentation strings in customization buffers."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-documentation-face
- 'custom-documentation "22.1")
-
-(defface custom-state '((((class color)
- (background dark))
- (:foreground "lime green"))
- (((class color)
- (background light))
- (:foreground "dark green"))
- (t nil))
+
+(defface custom-state '((((class color) (background dark))
+ :foreground "lime green")
+ (((class color) (background light))
+ :foreground "dark green"))
"Face used for State descriptions in the customize buffer."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-state-face 'custom-state "22.1")
-(defface custom-link
- '((t :inherit link))
+(defface custom-link '((t :inherit link))
"Face for links in customization buffers."
:version "22.1"
:group 'custom-faces)
(setq widget nil)))))
(widget-setup))
-(make-obsolete 'custom-show "this widget type is no longer supported." "24.1")
(defun custom-show (widget value)
"Non-nil if WIDGET should be shown with VALUE by default."
+ (declare (obsolete "this widget type is no longer supported." "24.1"))
(let ((show (widget-get widget :custom-show)))
(if (functionp show)
(funcall show widget value)
"Face used for comments on variables or faces."
:version "21.1"
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-comment-face 'custom-comment "22.1")
;; like font-lock-comment-face
(defface custom-comment-tag
- '((((class color) (background dark)) (:foreground "gray80"))
- (((class color) (background light)) (:foreground "blue4"))
+ '((((class color) (background dark)) :foreground "gray80")
+ (((class color) (background light)) :foreground "blue4")
(((class grayscale) (background light))
- (:foreground "DimGray" :weight bold :slant italic))
+ :foreground "DimGray" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "LightGray" :weight bold :slant italic))
- (t (:weight bold)))
+ :foreground "LightGray" :weight bold :slant italic)
+ (t :weight bold))
"Face used for the comment tag on variables or faces."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-comment-tag-face 'custom-comment-tag "22.1")
(define-widget 'custom-comment 'string
"User comment."
;;; The `custom-variable' Widget.
(defface custom-variable-tag
- `((((class color)
- (background dark))
- (:foreground "light blue" :weight bold))
- (((min-colors 88) (class color)
- (background light))
- (:foreground "blue1" :weight bold))
- (((class color)
- (background light))
- (:foreground "blue" :weight bold))
- (t (:weight bold)))
+ `((((class color) (background dark))
+ :foreground "light blue" :weight bold)
+ (((min-colors 88) (class color) (background light))
+ :foreground "blue1" :weight bold)
+ (((class color) (background light))
+ :foreground "blue" :weight bold)
+ (t :weight bold))
"Face used for unpushable variable tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-variable-tag-face
- 'custom-variable-tag "22.1")
-(defface custom-variable-button '((t (:underline t :weight bold)))
+(defface custom-variable-button '((t :underline t :weight bold))
"Face used for pushable variable tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-variable-button-face
- 'custom-variable-button "22.1")
(defcustom custom-variable-default-form 'edit
"Default form of displaying variable values."
"Return documentation of VARIABLE for use in Custom buffer.
Normally just return the docstring. But if VARIABLE automatically
becomes buffer local when set, append a message to that effect."
- (if (and (local-variable-if-set-p variable)
- (or (not (local-variable-p variable))
- (with-temp-buffer
- (local-variable-if-set-p variable))))
- (concat (documentation-property variable 'variable-documentation)
+ (format "%s%s" (documentation-property variable 'variable-documentation)
+ (if (and (local-variable-if-set-p variable)
+ (or (not (local-variable-p variable))
+ (with-temp-buffer
+ (local-variable-if-set-p variable))))
"\n
This variable automatically becomes buffer-local when set outside Custom.
-However, setting it through Custom sets the default value.")
- (documentation-property variable 'variable-documentation)))
+However, setting it through Custom sets the default value."
+ "")))
(define-widget 'custom-variable 'custom
"A widget for displaying a Custom variable.
(lambda (widget)
(and (default-boundp (widget-value widget))
(memq (widget-get widget :custom-state) '(modified changed)))))
- ("Reset to Saved" custom-variable-reset-saved
+ ("Revert This Session's Customization" custom-variable-reset-saved
(lambda (widget)
- (and (or (get (widget-value widget) 'saved-value)
- (get (widget-value widget) 'saved-variable-comment))
- (memq (widget-get widget :custom-state)
- '(modified set changed rogue)))))
+ (memq (widget-get widget :custom-state)
+ '(modified set changed rogue))))
,@(when (or custom-file init-file-user)
'(("Erase Customization" custom-variable-reset-standard
(lambda (widget)
(comment (widget-value comment-widget))
val)
(cond ((eq state 'hidden)
- (error "Cannot set hidden variable"))
+ (user-error "Cannot set hidden variable"))
((setq val (widget-apply child :validate))
(goto-char (widget-get val :from))
(error "%s" (widget-get val :error)))
(comment (widget-value comment-widget))
val)
(cond ((eq state 'hidden)
- (error "Cannot set hidden variable"))
+ (user-error "Cannot set hidden variable"))
((setq val (widget-apply child :validate))
(goto-char (widget-get val :from))
(error "Saving %s: %s" symbol (widget-get val :error)))
(custom-variable-state-set-and-redraw widget))
(defun custom-variable-reset-saved (widget)
- "Restore the saved value for the variable being edited by WIDGET.
-This also updates the buffer to show that value.
-The value that was current before this operation
-becomes the backup value, so you can get it again."
+ "Restore the value of the variable being edited by WIDGET.
+If there is a saved value, restore it; otherwise reset to the
+uncustomized (themed or standard) value.
+
+Update the widget to show that value. The value that was current
+before this operation becomes the backup value."
(let* ((symbol (widget-value widget))
- (set (or (get symbol 'custom-set) 'set-default))
- (value (get symbol 'saved-value))
+ (saved-value (get symbol 'saved-value))
(comment (get symbol 'saved-variable-comment)))
- (cond ((or value comment)
- (put symbol 'variable-comment comment)
- (custom-variable-backup-value widget)
- (custom-push-theme 'theme-value symbol 'user 'set (car-safe value))
- (condition-case nil
- (funcall set symbol (eval (car value)))
- (error nil)))
- (t
- (error "No saved value for %s" symbol)))
+ (custom-variable-backup-value widget)
+ (if (not (or saved-value comment))
+ ;; If there is no saved value, remove the setting.
+ (custom-push-theme 'theme-value symbol 'user 'reset)
+ ;; Otherwise, apply the saved value.
+ (put symbol 'variable-comment comment)
+ (custom-push-theme 'theme-value symbol 'user 'set (car-safe saved-value))
+ (ignore-errors
+ (funcall (or (get symbol 'custom-set) 'set-default)
+ symbol (eval (car saved-value)))))
(put symbol 'customized-value nil)
(put symbol 'customized-variable-comment nil)
(widget-put widget :custom-state 'unknown)
(let* ((symbol (widget-value widget)))
(if (get symbol 'standard-value)
(custom-variable-backup-value widget)
- (error "No standard setting known for %S" symbol))
+ (user-error "No standard setting known for %S" symbol))
(put symbol 'variable-comment nil)
(put symbol 'customized-value nil)
(put symbol 'customized-variable-comment nil)
(condition-case nil
(funcall set symbol (car value))
(error nil)))
- (error "No backup value for %s" symbol))
+ (user-error "No backup value for %s" symbol))
(put symbol 'customized-value (list (custom-quote (car value))))
(put symbol 'variable-comment comment)
(put symbol 'customized-variable-comment comment)
;;; The `custom-face' Widget.
(defface custom-face-tag
- `((t :inherit custom-variable-tag))
+ '((t :inherit custom-variable-tag))
"Face used for face tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-face-tag-face 'custom-face-tag "22.1")
(defcustom custom-face-default-form 'selected
"Default form of displaying face definition."
("Undo Edits" custom-redraw
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified changed))))
- ("Reset to Saved" custom-face-reset-saved
+ ("Revert This Session's Customization" custom-face-reset-saved
(lambda (widget)
- (or (get (widget-value widget) 'saved-face)
- (get (widget-value widget) 'saved-face-comment))))
+ (memq (widget-get widget :custom-state) '(modified set changed))))
,@(when (or custom-file init-file-user)
'(("Erase Customization" custom-face-reset-standard
(lambda (widget)
'changed))
((or (get face 'saved-face)
(get face 'saved-face-comment))
- (if (equal (get face 'saved-face-comment) comment)
- (cond
- ((eq 'user (caar (get face 'theme-face)))
- 'saved)
- ((eq 'changed (caar (get face 'theme-face)))
- 'changed)
- (t 'themed))
- 'changed))
+ (cond ((not (equal (get face 'saved-face-comment) comment))
+ 'changed)
+ ((eq 'user (caar (get face 'theme-face)))
+ 'saved)
+ ((eq 'changed (caar (get face 'theme-face)))
+ 'changed)
+ (t 'themed)))
((get face 'face-defface-spec)
- (if (equal comment nil)
- 'standard
- 'changed))
+ (cond (comment 'changed)
+ ((get face 'theme-face) 'themed)
+ (t 'standard)))
(t 'rogue))))
;; If the user called set-face-attribute to change the default for
;; new frames, this face is "set outside of Customize".
"22.1")
(defun custom-face-reset-saved (widget)
- "Restore WIDGET to the face's default attributes."
- (let* ((symbol (widget-value widget))
+ "Restore WIDGET to the face's default attributes.
+If there is a saved face, restore it; otherwise reset to the
+uncustomized (themed or standard) face."
+ (let* ((face (widget-value widget))
(child (car (widget-get widget :children)))
- (value (get symbol 'saved-face))
- (comment (get symbol 'saved-face-comment))
+ (saved-face (get face 'saved-face))
+ (comment (get face 'saved-face-comment))
(comment-widget (widget-get widget :comment-widget)))
- (unless (or value comment)
- (error "No saved value for this face"))
- (put symbol 'customized-face nil)
- (put symbol 'customized-face-comment nil)
- (custom-push-theme 'theme-face symbol 'user 'set value)
- (face-spec-set symbol value t)
- (put symbol 'face-comment comment)
- (widget-value-set child value)
+ (put face 'customized-face nil)
+ (put face 'customized-face-comment nil)
+ (custom-push-theme 'theme-face face 'user
+ (if saved-face 'set 'reset)
+ saved-face)
+ (face-spec-set face saved-face t)
+ (put face 'face-comment comment)
+ (widget-value-set child saved-face)
;; This call manages the comment visibility
(widget-value-set comment-widget (or comment ""))
(custom-face-state-set widget)
- (custom-redraw-magic widget)))
+ (custom-redraw widget)))
(defun custom-face-standard-value (widget)
(get (widget-value widget) 'face-defface-spec))
(value (get symbol 'face-defface-spec))
(comment-widget (widget-get widget :comment-widget)))
(unless value
- (error "No standard setting for this face"))
+ (user-error "No standard setting for this face"))
(put symbol 'customized-face nil)
(put symbol 'customized-face-comment nil)
(custom-push-theme 'theme-face symbol 'user 'reset)
;;; The `custom-group' Widget.
(defcustom custom-group-tag-faces nil
- ;; In XEmacs, this ought to play games with font size.
- ;; Fixme: make it do so in Emacs.
"Face used for group tags.
The first member is used for level 1 groups, the second for level 2,
and so forth. The remaining group tags are shown with `custom-group-tag'."
:group 'custom-faces)
(defface custom-group-tag-1
- `((((class color)
- (background dark))
- (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch))
- (((min-colors 88) (class color)
- (background light))
- (:foreground "red1" :weight bold :height 1.2 :inherit variable-pitch))
- (((class color)
- (background light))
- (:foreground "red" :weight bold :height 1.2 :inherit variable-pitch))
- (t (:weight bold)))
- "Face used for group tags."
+ '((default :weight bold :height 1.2 :inherit variable-pitch)
+ (((class color) (background dark)) :foreground "pink")
+ (((min-colors 88) (class color) (background light)) :foreground "red1")
+ (((class color) (background light)) :foreground "red"))
+ "Face for group tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-group-tag-face-1 'custom-group-tag-1 "22.1")
(defface custom-group-tag
- `((((class color)
- (background dark))
- (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch))
- (((min-colors 88) (class color)
- (background light))
- (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch))
- (((class color)
- (background light))
- (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch))
- (t (:weight bold)))
- "Face used for low level group tags."
+ '((default :weight bold :height 1.2 :inherit variable-pitch)
+ (((class color) (background dark)) :foreground "light blue")
+ (((min-colors 88) (class color) (background light)) :foreground "blue1")
+ (((class color) (background light)) :foreground "blue")
+ (t :weight bold))
+ "Face for low level group tags."
:group 'custom-faces)
-(define-obsolete-face-alias 'custom-group-tag-face 'custom-group-tag "22.1")
+
+(defface custom-group-subtitle
+ '((t :weight bold))
+ "Face for the \"Subgroups:\" subtitle in Custom buffers."
+ :group 'custom-faces)
+
+(defvar custom-group-doc-align-col 20)
(define-widget 'custom-group 'custom
"Customize group."
(custom-browse-insert-prefix prefix)
(push (widget-create-child-and-convert
widget 'custom-browse-visibility
- ;; :tag-glyph "plus"
:tag "+")
buttons)
(insert "-- ")
- ;; (widget-glyph-insert nil "-- " "horizontal")
(push (widget-create-child-and-convert
widget 'custom-browse-group-tag)
buttons)
(zerop (length members)))
(custom-browse-insert-prefix prefix)
(insert "[ ]-- ")
- ;; (widget-glyph-insert nil "[ ]" "empty")
- ;; (widget-glyph-insert nil "-- " "horizontal")
(push (widget-create-child-and-convert
widget 'custom-browse-group-tag)
buttons)
:action 'custom-toggle-parent
(not (eq state 'hidden)))
buttons))
- (insert " : ")
+ (if (>= (current-column) custom-group-doc-align-col)
+ (insert " "))
;; Create magic button.
(let ((magic (widget-create-child-and-convert
widget 'custom-magic nil)))
(widget-put widget :buttons buttons)
;; Insert documentation.
(if (and (eq custom-buffer-style 'links) (> level 1))
- (widget-put widget :documentation-indent 0))
+ (widget-put widget :documentation-indent
+ custom-group-doc-align-col))
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility))
(count 0)
(reporter (make-progress-reporter
"Creating group entries..." 0 len))
+ (have-subtitle (and (not (eq symbol 'emacs))
+ (eq custom-buffer-order-groups 'last)))
+ prev-type
children)
- (setq children
- (mapcar
- (lambda (entry)
- (widget-insert "\n")
- (progress-reporter-update reporter (setq count (1+ count)))
- (let ((sym (nth 0 entry))
- (type (nth 1 entry)))
- (prog1
- (widget-create-child-and-convert
- widget type
- :group widget
- :tag (custom-unlispify-tag-name sym)
- :custom-prefixes custom-prefix-list
- :custom-level (1+ level)
- :value sym)
- (unless (eq (preceding-char) ?\n)
- (widget-insert "\n")))))
- members))
+
+ (dolist (entry members)
+ (unless (eq prev-type 'custom-group)
+ (widget-insert "\n"))
+ (progress-reporter-update reporter (setq count (1+ count)))
+ (let ((sym (nth 0 entry))
+ (type (nth 1 entry)))
+ (when (and have-subtitle (eq type 'custom-group))
+ (setq have-subtitle nil)
+ (widget-insert
+ (propertize "Subgroups:\n" 'face 'custom-group-subtitle)))
+ (setq prev-type type)
+ (push (widget-create-child-and-convert
+ widget type
+ :group widget
+ :tag (custom-unlispify-tag-name sym)
+ :custom-prefixes custom-prefix-list
+ :custom-level (1+ level)
+ :value sym)
+ children)
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))))
+
+ (setq children (nreverse children))
(mapc 'custom-magic-reset children)
(widget-put widget :children children)
(custom-group-state-update widget)
("Undo Edits" custom-group-reset-current
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified))))
- ("Reset to Saved" custom-group-reset-saved
+ ("Revert This Session's Customizations" custom-group-reset-saved
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified set))))
,@(when (or custom-file init-file-user)
;; sense.
(if no-error
nil
- (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
+ (user-error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
(file-chase-links (or custom-file user-init-file))))
;; If recentf-mode is non-nil, this is defined.
(set (make-local-variable 'widget-link-suffix) ""))
(setq show-trailing-whitespace nil))
+(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1")
(define-derived-mode Custom-mode nil "Custom"
"Major mode for editing customization buffers.
(put 'Custom-mode 'mode-class 'special)
-;; backward-compatibility
-(defun custom-mode ()
- "Non-interactive variant of `Custom-mode'."
- (Custom-mode))
-(make-obsolete 'custom-mode 'Custom-mode "23.1")
-(put 'custom-mode 'mode-class 'special)
-(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1")
+(define-obsolete-function-alias 'custom-mode 'Custom-mode "23.1")
-(dolist (regexp
- '("^No user option defaults have been changed since Emacs "
- "^Invalid face:? "
- "^No \\(?:customized\\|rogue\\|saved\\) user options"
- "^No customizable items matching "
- "^There are unset changes"
- "^Cannot set hidden variable"
- "^No \\(?:saved\\|backup\\) value for "
- "^No standard setting known for "
- "^No standard setting for this face"
- "^Saving settings from \"emacs -q\" would overwrite existing customizations"))
- (add-to-list 'debug-ignored-errors regexp))
+(add-to-list 'debug-ignored-errors "^Invalid face:? ")
;;; The End.
(choice :tag "Underline"
:help-echo "Control text underlining."
(const :tag "Off" nil)
- (const :tag "On" t)
- (color :tag "Colored")))
+ (list :tag "On"
+ :value (:color foreground-color :style line)
+ (const :format "" :value :color)
+ (choice :tag "Color"
+ (const :tag "Foreground Color" foreground-color)
+ color)
+ (const :format "" :value :style)
+ (choice :tag "Style"
+ (const :tag "Line" line)
+ (const :tag "Wave" wave))))
+ ;; filter to make value suitable for customize
+ (lambda (real-value)
+ (and real-value
+ (let ((color
+ (or (and (consp real-value) (plist-get real-value :color))
+ (and (stringp real-value) real-value)
+ 'foreground-color))
+ (style
+ (or (and (consp real-value) (plist-get real-value :style))
+ 'line)))
+ (list :color color :style style))))
+ ;; filter to make customized-value suitable for storing
+ (lambda (cus-value)
+ (and cus-value
+ (let ((color (plist-get cus-value :color))
+ (style (plist-get cus-value :style)))
+ (cond ((eq style 'line)
+ ;; Use simple value for default style
+ (if (eq color 'foreground-color) t color))
+ (t
+ `(:color ,color :style ,style)))))))
(:overline
(choice :tag "Overline"
;;; cus-start.el --- define customization properties of builtins
-;;
-;; Copyright (C) 1997, 1999-2012 Free Software Foundation, Inc.
-;;
+
+;; Copyright (C) 1997, 1999-2012 Free Software Foundation, Inc.
+
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: internal
;; Package: emacs
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; This file adds customize support for built-in variables.
;; While dumping Emacs, this file is loaded, but it only records
;; :tag - custom-tag property
(let ((all '(;; alloc.c
(gc-cons-threshold alloc integer)
+ (gc-cons-percentage alloc float)
(garbage-collection-messages alloc boolean)
;; buffer.c
(mode-line-format mode-line sexp) ;Hard to do right.
(exec-path execute
(repeat (choice (const :tag "default directory" nil)
(directory :format "%v"))))
+ (exec-suffixes execute (repeat string))
;; charset.c
(charset-map-path installation
(repeat (directory :format "%v")))
;; coding.c
(inhibit-eol-conversion mule boolean)
(eol-mnemonic-undecided mule string)
- (eol-mnemonic-unix mule string)
- (eol-mnemonic-dos mule string)
- (eol-mnemonic-mac mule string)
+ ;; startup.el fiddles with the values. IMO, would be
+ ;; simpler to just use #ifdefs in coding.c.
+ (eol-mnemonic-unix mule string nil
+ :standard
+ (if (memq system-type '(ms-dos windows-nt))
+ "(Unix)" ":"))
+ (eol-mnemonic-dos mule string nil
+ :standard
+ (if (memq system-type '(ms-dos windows-nt))
+ "\\" "(DOS)"))
+ (eol-mnemonic-mac mule string nil
+ :standard "(Mac)")
(file-coding-system-alist
mule
(alist
(inverse-video display boolean)
(visible-bell display boolean)
(no-redraw-on-reenter display boolean)
+
+ ;; dosfns.c
+ (dos-display-scancodes display boolean)
+ (dos-hyper-key keyboard integer)
+ (dos-super-key keyboard integer)
+ (dos-keypad-mode keyboard integer)
+
;; editfns.c
(user-full-name mail string)
;; eval.c
(const :tag "always" t)))
(debug-ignored-errors debug (repeat (choice symbol regexp)))
(debug-on-quit debug boolean)
- ;; fileio.c
- (delete-by-moving-to-trash auto-save boolean "23.1")
+ (debug-on-signal debug boolean)
+ ;; fileio.c
+ (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.3")
(temporary-file-directory
;; Darwin section added 24.1, does not seem worth :version bump.
files directory nil
(use-dialog-box menu boolean "21.1")
(use-file-dialog menu boolean "22.1")
(focus-follows-mouse frames boolean "20.3")
+ ;; fontset.c
+ (vertical-centering-font-regexp display regexp)
;; frame.c
(default-frame-alist frames
(repeat (cons :format "%v"
(const :tag "only shift-selection or mouse-drag" only)
(const :tag "off" nil))
"24.1")
- (suggest-key-bindings keyboard (choice (const :tag "off" nil)
- (integer :tag "time" 2)
- (other :tag "on")))
(debug-on-event debug
(choice (const :tag "None" nil)
(const :tag "When sent SIGUSR1" sigusr1)
(const :tag "Only on ttys" :value tty)
(other :tag "Always" t)) "23.1")
(window-combination-resize windows boolean "24.1")
- (window-combination-limit windows boolean "24.1")
+ (window-combination-limit
+ windows (choice
+ (const :tag "Never (nil)" :value nil)
+ (const :tag "For Temp Buffer Resize mode (temp-buffer-resize)"
+ :value temp-buffer-resize)
+ (const :tag "For temporary buffers (temp-buffer)"
+ :value temp-buffer)
+ (const :tag "For buffer display (display-buffer)"
+ :value display-buffer)
+ (other :tag "Always (t)" :value t))
+ "24.3")
;; xdisp.c
(show-trailing-whitespace whitespace-faces boolean nil
:safe booleanp)
(hscroll-margin windows integer "22.1")
(hscroll-step windows number "22.1")
(truncate-partial-width-windows display boolean "23.1")
- (mode-line-inverse-video mode-line boolean)
+ (make-cursor-line-fully-visible windows boolean)
(mode-line-in-non-selected-windows mode-line boolean "22.1")
(line-number-display-limit display
(choice integer
(const :tag "Both" :value both)
(const :tag "Both-horiz" :value both-horiz)
(const :tag "Text-image-horiz" :value text-image-horiz)
- (const :tag "System default" :value nil)) "23.3")
- (tool-bar-max-label-size frames integer "23.3")
+ (const :tag "System default" :value nil)) "24.1")
+ (tool-bar-max-label-size frames integer "24.1")
(auto-hscroll-mode scrolling boolean "21.1")
+ (void-text-area-pointer cursor
+ (choice
+ (const :tag "Standard (text pointer)" :value nil)
+ (const :tag "Arrow" :value arrow)
+ (const :tag "Text pointer" :value text)
+ (const :tag "Hand" :value hand)
+ (const :tag "Vertical dragger" :value vdrag)
+ (const :tag "Horizontal dragger" :value hdrag)
+ (const :tag "Same as mode line" :value modeline)
+ (const :tag "Hourglass" :value hourglass)))
(display-hourglass cursor boolean)
(hourglass-delay cursor number)
;; xfaces.c
+ (font-list-limit display integer)
(scalable-fonts-allowed display boolean "22.1")
;; xfns.c
(x-bitmap-file-path installation
;; the condition for loadup.el to preload tool-bar.el.
((string-match "tool-bar-" (symbol-name symbol))
(fboundp 'x-create-frame))
+ ((equal "vertical-centering-font-regexp"
+ (symbol-name symbol))
+ ;; Any function from fontset.c will do.
+ (fboundp 'new-fontset))
(t t))))
(if (not (boundp symbol))
;; If variables are removed from C code, give an error here!
For variables in preloaded files, you can simply use this
function for the :initialize property. For autoloaded variables,
you will also need to add an autoload stanza calling this
-function, and another one setting the standard-value property."
+function, and another one setting the standard-value property.
+Or you can wrap the defcustom in a progn, to force the autoloader
+to include all of it." ; see eg vc-sccs-search-project-dir
;; No longer true:
;; "See `send-mail-function' in sendmail.el for an example."
is `default-value'.
:require
VALUE should be a feature symbol. If you save a value
- for this option, then when your `.emacs' file loads the value,
+ for this option, then when your init file loads the value,
it does (require VALUE) first.
:set-after VARIABLES
Specifies that SYMBOL should be set after the list of variables
;; expression is checked by the byte-compiler, and that
;; lexical-binding is obeyed, so quote the expression with
;; `lambda' rather than with `quote'.
- `(list (lambda () ,standard))
+ ``(funcall #',(lambda () ,standard))
`',standard)
,doc
,@args))
Third argument DOC is the face documentation.
-If FACE has been set with `custom-set-faces', set the face attributes
-as specified by that function, otherwise set the face attributes
-according to SPEC.
-
-The remaining arguments should have the form
-
- [KEYWORD VALUE]...
+If FACE has been set with `custom-set-faces', set the face
+attributes as specified by that function, otherwise set the face
+attributes according to SPEC.
+The remaining arguments should have the form [KEYWORD VALUE]...
For a list of valid keywords, see the common keywords listed in
`defcustom'.
-SPEC should be an alist of the form ((DISPLAY ATTS)...).
-
-In the first element, DISPLAY can be `default'. The ATTS in that
-element then act as defaults for all the following elements.
-
-Aside from that, DISPLAY specifies conditions to match some or
-all frames. For each frame, the first element of SPEC where the
-DISPLAY conditions are satisfied is the one that applies to that
-frame. The ATTRs in this element take effect, and the following
-elements are ignored, on that frame.
-
-In the last element, DISPLAY can be t. That element applies to a
-frame if none of the previous elements (except the `default' if
-any) did.
-
-ATTS is a list of face attributes followed by their values:
- (ATTR VALUE ATTR VALUE...)
-
-The possible attributes are `:family', `:width', `:height', `:weight',
-`:slant', `:underline', `:overline', `:strike-through', `:box',
-`:foreground', `:background', `:stipple', `:inverse-video', and `:inherit'.
-
-DISPLAY can be `default' (only in the first element), the symbol
-t (only in the last element) to match all frames, or an alist of
-conditions of the form \(REQ ITEM...). For such an alist to
-match a frame, each of the conditions must be satisfied, meaning
-that the REQ property of the frame must match one of the
-corresponding ITEMs. These are the defined REQ values:
-
-`type' (the value of `window-system')
- Under X, in addition to the values `window-system' can take,
- `motif', `lucid', `gtk' and `x-toolkit' are allowed, and match when
- the Motif toolkit, Lucid toolkit, GTK toolkit or any X toolkit is in use.
-
-`class' (the frame's color support)
- Should be one of `color', `grayscale', or `mono'.
-
-`background' (what color is used for the background text)
- Should be one of `light' or `dark'.
-
-`min-colors' (the minimum number of colors the frame should support)
- Should be an integer, it is compared with the result of
- `display-color-cells'.
-
-`supports' (only match frames that support the specified face attributes)
- Should be a list of face attributes. See the documentation for
- the function `display-supports-face-attributes-p' for more
- information on exactly how testing is done.
-
-See Info node `(elisp) Customization' in the Emacs Lisp manual
-for more information."
+SPEC should be an alist of the form
+
+ ((DISPLAY . ATTS)...)
+
+where DISPLAY is a form specifying conditions to match certain
+terminals and ATTS is a property list (ATTR VALUE ATTR VALUE...)
+specifying face attributes and values for frames on those
+terminals. On each terminal, the first element with a matching
+DISPLAY specification takes effect, and the remaining elements in
+SPEC are disregarded.
+
+As a special exception, in the first element of SPEC, DISPLAY can
+be the special value `default'. Then the ATTS in that element
+act as defaults for all the following elements.
+
+For backward compatibility, elements of SPEC can be written
+as (DISPLAY ATTS) instead of (DISPLAY . ATTS).
+
+Each DISPLAY can have the following values:
+ - `default' (only in the first element).
+ - The symbol t, which matches all terminals.
+ - An alist of conditions. Each alist element must have the form
+ (REQ ITEM...). A matching terminal must satisfy each
+ specified condition by matching one of its ITEMs. Each REQ
+ must be one of the following:
+ - `type' (the terminal type).
+ Each ITEM must be one of the values returned by
+ `window-system'. Under X, additional allowed values are
+ `motif', `lucid', `gtk' and `x-toolkit'.
+ - `class' (the terminal's color support).
+ Each ITEM should be one of `color', `grayscale', or `mono'.
+ - `background' (what color is used for the background text)
+ Each ITEM should be one of `light' or `dark'.
+ - `min-colors' (the minimum number of supported colors)
+ Each ITEM should be an integer, which is compared with the
+ result of `display-color-cells'.
+ - `supports' (match terminals supporting certain attributes).
+ Each ITEM should be a list of face attributes. See
+ `display-supports-face-attributes-p' for more information on
+ exactly how testing is done.
+
+In the ATTS property list, possible attributes are `:family',
+`:width', `:height', `:weight', `:slant', `:underline',
+`:overline', `:strike-through', `:box', `:foreground',
+`:background', `:stipple', `:inverse-video', and `:inherit'.
+
+See Info node `(elisp) Faces' in the Emacs Lisp manual for more
+information."
(declare (doc-string 3))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
(put symbol 'custom-autoload (if noset 'noset t))
(custom-add-load symbol load))
-;; This test is also in the C code of `user-variable-p'.
(defun custom-variable-p (variable)
"Return non-nil if VARIABLE is a customizable variable.
A customizable variable is either (i) a variable whose property
list contains a non-nil `standard-value' or `custom-autoload'
property, or (ii) an alias for another customizable variable."
- (setq variable (indirect-variable variable))
- (or (get variable 'standard-value)
- (get variable 'custom-autoload)))
+ (when (symbolp variable)
+ (setq variable (indirect-variable variable))
+ (or (get variable 'standard-value)
+ (get variable 'custom-autoload))))
+
+(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).
Any theme `foo' should be defined in a file called `foo-theme.el';
see `custom-make-theme-feature' for more information."
+ (declare (doc-string 2))
(let ((feature (custom-make-theme-feature theme)))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
(expand-file-name "themes/" data-directory)))
(member hash custom-safe-themes)
(custom-theme-load-confirm hash))
- (let ((custom--inhibit-theme-enable t))
+ (let ((custom--inhibit-theme-enable t)
+ (buffer-file-name fn)) ;For load-history.
(eval-buffer))
;; Optimization: if the theme changes the `default' face, put that
;; entry first. This avoids some `frame-set-background-mode' rigmarole
"Query the user about loading a Custom theme that may not be safe.
The theme should be in the current buffer. If the user agrees,
query also about adding HASH to `custom-safe-themes'."
- (if noninteractive
- nil
- (let ((exit-chars '(?y ?n ?\s))
- window prompt char)
- (save-window-excursion
- (rename-buffer "*Custom Theme*" t)
- (emacs-lisp-mode)
- (setq window (display-buffer (current-buffer)))
- (setq prompt
- (format "Loading a theme can run Lisp code. Really load?%s"
- (if (and window
- (< (line-number-at-pos (point-max))
- (window-body-height)))
- " (y or n) "
- (push ?\C-v exit-chars)
- "\nType y or n, or C-v to scroll: ")))
- (goto-char (point-min))
- (while (null char)
- (setq char (read-char-choice prompt exit-chars))
- (when (eq char ?\C-v)
- (if window
- (with-selected-window window
- (condition-case nil
- (scroll-up)
- (error (goto-char (point-min))))))
- (setq char nil)))
- (when (memq char '(?\s ?y))
- ;; Offer to save to `custom-safe-themes'.
- (and (or custom-file user-init-file)
- (y-or-n-p "Treat this theme as safe in future sessions? ")
- (customize-push-and-save 'custom-safe-themes (list hash)))
- t)))))
+ (unless noninteractive
+ (save-window-excursion
+ (rename-buffer "*Custom Theme*" t)
+ (emacs-lisp-mode)
+ (pop-to-buffer (current-buffer))
+ (goto-char (point-min))
+ (prog1 (when (y-or-n-p "Loading a theme can run Lisp code. Really load? ")
+ ;; Offer to save to `custom-safe-themes'.
+ (and (or custom-file user-init-file)
+ (y-or-n-p "Treat this theme as safe in future sessions? ")
+ (customize-push-and-save 'custom-safe-themes (list hash)))
+ t)
+ (quit-window)))))
(defun custom-theme-name-valid-p (name)
"Return t if NAME is a valid name for a Custom theme, nil otherwise.
;;??? Do we want this?
;;;###autoload (define-key esc-map [?\C-/] 'dabbrev-completion)
+(defun dabbrev--ignore-case-p (abbrev)
+ (and (if (eq dabbrev-case-fold-search 'case-fold-search)
+ case-fold-search
+ dabbrev-case-fold-search)
+ (or (not dabbrev-upcase-means-case-search)
+ (string= abbrev (downcase abbrev)))))
+
;;;###autoload
(defun dabbrev-completion (&optional arg)
"Completion on current word.
(abbrev (dabbrev--abbrev-at-point))
(beg (progn (search-backward abbrev) (point)))
(end (progn (search-forward abbrev) (point)))
- (ignore-case-p
- (and (if (eq dabbrev-case-fold-search 'case-fold-search)
- case-fold-search
- dabbrev-case-fold-search)
- (or (not dabbrev-upcase-means-case-search)
- (string= abbrev (downcase abbrev)))))
+ (ignore-case-p (dabbrev--ignore-case-p abbrev))
(list 'uninitialized)
(table
(lambda (s p a)
(dabbrev--find-all-expansions abbrev ignore-case-p))
(completion-ignore-case ignore-case-p))
(or (consp completion-list)
- (error "No dynamic expansion for \"%s\" found%s"
- abbrev
- (if dabbrev--check-other-buffers
- "" " in this-buffer")))
+ (user-error "No dynamic expansion for \"%s\" found%s"
+ abbrev
+ (if dabbrev--check-other-buffers
+ "" " in this-buffer")))
(setq list
(cond
((not (and ignore-case-p dabbrev-case-replace))
(setq expansion
(dabbrev--find-expansion
abbrev direction
- (and (if (eq dabbrev-case-fold-search 'case-fold-search)
- case-fold-search
- dabbrev-case-fold-search)
- (or (not dabbrev-upcase-means-case-search)
- (string= abbrev (downcase abbrev))))))))
+ (dabbrev--ignore-case-p abbrev)))))
(cond
((not expansion)
(dabbrev--reset-global-variables)
(search-backward old)
(insert abbrev)
(delete-region (point) (+ (point) (length old)))))
- (error "No%s dynamic expansion for `%s' found"
- (if old " further" "") abbrev))
+ (user-error "No%s dynamic expansion for `%s' found"
+ (if old " further" "") abbrev))
(t
(if (not (or (eq dabbrev--last-buffer dabbrev--last-buffer-found)
(minibuffer-window-active-p (selected-window))))
"Extract the symbol at point to serve as abbreviation."
;; Check for error
(if (bobp)
- (error "No possible abbreviation preceding point"))
+ (user-error "No possible abbreviation preceding point"))
;; Return abbrev at point
(save-excursion
;; Record the end of the abbreviation.
"\\sw\\|\\s_")
nil t)
(forward-char 1)
- (error "No possible abbreviation preceding point"))))
+ (user-error "No possible abbreviation preceding point"))))
;; Now find the beginning of that one.
(dabbrev--goto-start-of-abbrev)
(buffer-substring-no-properties
to record whether we upcased the expansion, downcased it, or did neither."
;;(undo-boundary)
(let ((use-case-replace
- (and (if (eq dabbrev-case-fold-search 'case-fold-search)
- case-fold-search
- dabbrev-case-fold-search)
- (or (not dabbrev-upcase-means-case-search)
- (string= abbrev (downcase abbrev)))
+ (and (dabbrev--ignore-case-p abbrev)
(if (eq dabbrev-case-replace 'case-replace)
case-replace
dabbrev-case-replace))))
(cons found-string dabbrev--last-table))
result)))))
-(dolist (mess '("^No dynamic expansion for .* found"
- "^No further dynamic expansion for .* found$"
- "^No possible abbreviation preceding point$"))
- (add-to-list 'debug-ignored-errors mess))
-
(provide 'dabbrev)
;;; dabbrev.el ends here
;; 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))
(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).
(defun describe-text-properties-1 (pos output-buffer)
(let* ((properties (text-properties-at pos))
- (overlays (overlays-at pos))
+ (overlays (overlays-in pos (1+ pos)))
(wid-field (get-char-property pos 'field))
(wid-button (get-char-property pos 'button))
(wid-doc (get-char-property pos 'widget-doc))
(col (current-column)))
(if (or (/= beg 1) (/= end (1+ total)))
(format "%d of %d (%d%%), restriction: <%d-%d>, column: %d%s"
- pos total percent col beg end hscroll)
+ pos total percent beg end col hscroll)
(if (= pos end)
(format "%d of %d (EOB), column: %d%s" pos total col hscroll)
(format "%d of %d (%d%%), column: %d%s"
`(insert-text-button
,current-input-method
'type 'help-input-method
- 'help-args '(,current-input-method)))))))
+ 'help-args '(,current-input-method))
+ "input method")
+ (list
+ "type \"C-x 8 RET HEX-CODEPOINT\" or \"C-x 8 RET NAME\"")))))
("buffer code"
,(if multibyte-p
(encoded-string-description
(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)))
(format " %s: %s\n" elt val)))))))
(if text-props-desc (insert text-props-desc))
- (toggle-read-only 1))))))
+ (setq buffer-read-only t))))))
(define-obsolete-function-alias 'describe-char-after 'describe-char "22.1")
;; - some local variables
;; To use this, use customize to turn on desktop-save-mode or add the
-;; following line somewhere in your .emacs file:
+;; following line somewhere in your init file:
;;
;; (desktop-save-mode 1)
;;
"Save status of Emacs when you exit."
:group 'frames)
+;; Maintained for backward compatibility
+(define-obsolete-variable-alias 'desktop-enable 'desktop-save-mode "22.1")
;;;###autoload
(define-minor-mode desktop-save-mode
"Toggle desktop saving (Desktop Save mode).
:global t
:group 'desktop)
-;; Maintained for backward compatibility
-(define-obsolete-variable-alias 'desktop-enable
- 'desktop-save-mode "22.1")
-
(defun desktop-save-mode-off ()
"Disable `desktop-save-mode'. Provided for use in hooks."
(desktop-save-mode 0))
:group 'desktop
:version "22.2")
-(defcustom desktop-path (list "." user-emacs-directory "~")
+(defcustom desktop-path (list user-emacs-directory "~")
"List of directories to search for the desktop file.
The base name of the file is specified in `desktop-base-file-name'."
:type '(repeat directory)
'desktop-save-buffer "22.1")
;;;###autoload
-(defvar desktop-buffer-mode-handlers
- nil
+(defvar desktop-buffer-mode-handlers nil
"Alist of major mode specific functions to restore a desktop buffer.
Functions listed are called by `desktop-create-buffer' when `desktop-read'
evaluates the desktop file. List elements must have the form
:group 'desktop)
;;;###autoload
-(defvar desktop-minor-mode-handlers
- nil
+(defvar desktop-minor-mode-handlers nil
"Alist of functions to restore non-standard minor modes.
Functions are called by `desktop-create-buffer' to restore minor modes.
List elements must have the form
(and dirs (car dirs)))
;; If not found and `desktop-path' is non-nil, use its first element.
(and desktop-path (car desktop-path))
- ;; Default: Home directory.
- "~"))))
+ ;; Default: .emacs.d.
+ user-emacs-directory))))
(if (file-exists-p (desktop-full-file-name))
;; Desktop file found, but is it already in use?
(let ((desktop-first-buffer nil)
(if (and owner
(memq desktop-load-locked-desktop '(nil ask))
(or (null desktop-load-locked-desktop)
+ (daemonp)
(not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\
Using it may cause conflicts. Use it anyway? " owner)))))
(let ((default-directory desktop-dirname))
(defun desktop-load-default ()
"Load the `default' start-up library manually.
Also inhibit further loading of it."
+ (declare (obsolete desktop-save-mode "22.1"))
(unless inhibit-default-init ; safety check
(load "default" t t)
(setq inhibit-default-init t)))
-(make-obsolete 'desktop-load-default
- 'desktop-save-mode "22.1")
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-load-file (function)
"Load the file where auto loaded FUNCTION is defined."
- (when function
- (let ((fcell (and (fboundp function) (symbol-function function))))
- (when (and (listp fcell)
- (eq 'autoload (car fcell)))
- (load (cadr fcell))))))
+ (when (fboundp function)
+ (autoload-do-load (symbol-function function) function)))
;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set its mode, ...;
:type 'hook)
(defvar dframe-track-mouse-function nil
- "*A function to call when the mouse is moved in the given frame.
+ "A function to call when the mouse is moved in the given frame.
Typically used to display info about the line under the mouse.")
(make-variable-buffer-local 'dframe-track-mouse-function)
(defvar dframe-help-echo-function nil
- "*A function to call when help-echo is used in newer versions of Emacs.
+ "A function to call when help-echo is used in newer versions of Emacs.
Typically used to display info about the line under the mouse.")
(make-variable-buffer-local 'dframe-help-echo-function)
(defvar dframe-mouse-click-function nil
- "*A function to call when the mouse is clicked.
+ "A function to call when the mouse is clicked.
Valid clicks are mouse 2, our double mouse 1.")
(make-variable-buffer-local 'dframe-mouse-click-function)
(defvar dframe-mouse-position-function nil
- "*A function to call to position the cursor for a mouse click.")
+ "A function to call to position the cursor for a mouse click.")
(make-variable-buffer-local 'dframe-mouse-position-function)
(defvar dframe-power-click nil
(defun dframe-needed-height (&optional frame)
"The needed height for the tool bar FRAME (in characters)."
(or frame (setq frame (selected-frame)))
- ;; The 1 is the missing modeline/minibuffer
+ ;; The 1 is the missing mode line or minibuffer
(+ 1 (/ (frame-pixel-height frame)
;; This obscure code avoids a byte compiler warning in Emacs.
(let ((f 'face-height))
(switch-to-buffer buffer)
(call-interactively 'switch-to-buffer nil nil)))
-;; XEmacs: this can be implemented using modeline keymaps, but there
+;; XEmacs: this can be implemented using mode line keymaps, but there
;; is no use, as we have horizontal scrollbar (as the docstring
;; hints.)
(defun dframe-mouse-hscroll (e)
((> click-col (- (window-width) 5))
(scroll-right 2))
(t (dframe-message
- "Click on the edge of the modeline to scroll left/right")))
- ))
+ "Click on the edge of the mode line to scroll left/right")))))
(provide 'dframe)
;;;###autoload
(defun dired-diff (file &optional switches)
"Compare file at point with file FILE using `diff'.
-FILE defaults to the file at the mark. (That's the mark set by
-\\[set-mark-command], not by Dired's \\[dired-mark] command.)
-The prompted-for FILE is the first file given to `diff'.
-With prefix arg, prompt for second argument SWITCHES,
-which is the string of command switches for `diff'."
+If called interactively, prompt for FILE. If the file at point
+has a backup file, use that as the default. If the mark is active
+in Transient Mark mode, use the file at the mark as the default.
+\(That's the mark set by \\[set-mark-command], not by Dired's
+\\[dired-mark] command.)
+
+FILE is the first file given to `diff'. The file at point
+is the second file given to `diff'.
+
+With prefix arg, prompt for second argument SWITCHES, which is
+the string of command switches for the third argument of `diff'."
(interactive
(let* ((current (dired-get-filename t))
+ ;; Get the latest existing backup file.
+ (oldf (diff-latest-backup-file current))
;; Get the file at the mark.
- (file-at-mark (if (mark t)
+ (file-at-mark (if (and transient-mark-mode mark-active)
(save-excursion (goto-char (mark t))
(dired-get-filename t t))))
+ (default-file (or file-at-mark
+ (and oldf (file-name-nondirectory oldf))))
;; Use it as default if it's not the same as the current file,
- ;; and the target dir is the current dir or the mark is active.
- (default (if (and (not (equal file-at-mark current))
+ ;; and the target dir is current or there is a default file.
+ (default (if (and (not (equal default-file current))
(or (equal (dired-dwim-target-directory)
(dired-current-directory))
- mark-active))
- file-at-mark))
+ default-file))
+ default-file))
(target-dir (if default
(dired-current-directory)
(dired-dwim-target-directory)))
(defaults (dired-dwim-target-defaults (list current) target-dir)))
- (require 'diff)
(list
(minibuffer-with-setup-hook
(lambda ()
;; OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up').
;; ARG describes which files to use, as in `dired-get-marked-files'.
(let* ((files (dired-get-marked-files t arg))
- (default (and (eq op-symbol 'touch)
- (stringp (car files))
- (format-time-string "%Y%m%d%H%M.%S"
- (nth 5 (file-attributes (car files))))))
+ ;; The source of default file attributes is the file at point.
+ (default-file (dired-get-filename t t))
+ (default (when default-file
+ (cond ((eq op-symbol 'touch)
+ (format-time-string
+ "%Y%m%d%H%M.%S"
+ (nth 5 (file-attributes default-file))))
+ ((eq op-symbol 'chown)
+ (nth 2 (file-attributes default-file 'string)))
+ ((eq op-symbol 'chgrp)
+ (nth 3 (file-attributes default-file 'string))))))
(prompt (concat "Change " attribute-name " of %s to"
(if (eq op-symbol 'touch)
" (default now): "
": ")))
(new-attribute (dired-mark-read-string prompt nil op-symbol
- arg files default))
+ arg files default
+ (cond ((eq op-symbol 'chown)
+ (system-users))
+ ((eq op-symbol 'chgrp)
+ (system-groups)))))
(operation (concat program " " new-attribute))
failures)
(setq failures
(function dired-check-process)
(append
(list operation program)
- (unless (string-equal new-attribute "")
+ (unless (or (string-equal new-attribute "")
+ ;; Use `eq' instead of `equal'
+ ;; to detect empty input (bug#12399).
+ (eq new-attribute default))
(if (eq op-symbol 'touch)
(list "-t" new-attribute)
(list new-attribute)))
;;;###autoload
(defun dired-do-chmod (&optional arg)
"Change the mode of the marked (or next ARG) files.
-Symbolic modes like `g+w' are allowed."
+Symbolic modes like `g+w' are allowed.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(let* ((files (dired-get-marked-files t arg))
- (modestr (and (stringp (car files))
- (nth 8 (file-attributes (car files)))))
+ ;; The source of default file attributes is the file at point.
+ (default-file (dired-get-filename t t))
+ (modestr (when default-file
+ (nth 8 (file-attributes default-file))))
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
"Change mode of %s to: "
nil 'chmod arg files default))
num-modes)
- (cond ((equal modes "")
+ (cond ((or (equal modes "")
+ ;; Use `eq' instead of `equal'
+ ;; to detect empty input (bug#12399).
+ (eq modes default))
;; We used to treat empty input as DEFAULT, but that is not
;; such a good idea (Bug#9361).
(error "No file mode specified"))
;;;###autoload
(defun dired-do-chgrp (&optional arg)
- "Change the group of the marked (or next ARG) files."
+ "Change the group of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
(error "chgrp not supported on this system"))
;;;###autoload
(defun dired-do-chown (&optional arg)
- "Change the owner of the marked (or next ARG) files."
+ "Change the owner of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
(error "chown not supported on this system"))
;;;###autoload
(defun dired-do-touch (&optional arg)
"Change the timestamp of the marked (or next ARG) files.
-This calls touch."
+This calls touch.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
(defun dired-mark-read-string (prompt initial op-symbol arg files
- &optional default-value)
+ &optional default-value collection)
"Read args for a Dired marked-files command, prompting with PROMPT.
Return the user input (a string).
INITIAL, if non-nil, is the initial minibuffer input.
OP-SYMBOL is an operation symbol (see `dired-no-confirm').
-ARG is normally the prefix argument for the calling command.
-FILES should be a list of file names.
+ARG is normally the prefix argument for the calling command;
+it is passed as the first argument to `dired-mark-prompt'.
+FILES should be a list of marked files' names.
-DEFAULT-VALUE, if non-nil, should be a \"standard\" value or list
-of such values, available via history commands. Note that if the
-user enters empty input, this function returns the empty string,
-not DEFAULT-VALUE."
+Optional arg DEFAULT-VALUE is a default value or list of default
+values, passed as the seventh arg to `completing-read'.
+
+Optional arg COLLECTION is a collection of possible completions,
+passed as the second arg to `completing-read'."
(dired-mark-pop-up nil op-symbol files
- 'read-from-minibuffer
+ 'completing-read
(format prompt (dired-mark-prompt arg files))
- initial nil nil nil default-value))
+ collection nil nil initial nil default-value nil))
\f
;;; Cleaning a directory: flagging some backups for deletion.
(defun dired-do-async-shell-command (command &optional arg file-list)
"Run a shell command COMMAND on the marked files asynchronously.
-Like `dired-do-shell-command' but if COMMAND doesn't end in ampersand,
-adds `* &' surrounded by whitespace and executes the command asynchronously.
+Like `dired-do-shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
+When operating on multiple files, asynchronous commands
+are executed in the background on each file in parallel.
+In shell syntax this means separating the individual commands
+with `&'. However, when COMMAND ends in `;' or `;&' then commands
+are executed in the background on each file sequentially waiting
+for each command to terminate before running the next command.
+In shell syntax this means separating the individual commands with `;'.
+
The output appears in the buffer `*Async Shell Command*'."
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg)))
(dired-read-shell-command "& on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (unless (string-match "[*?][ \t]*\\'" command)
- (setq command (concat command " *")))
(unless (string-match "&[ \t]*\\'" command)
(setq command (concat command " &")))
(dired-do-shell-command command arg file-list))
-;; The in-background argument is only needed in Emacs 18 where
-;; shell-command doesn't understand an appended ampersand `&'.
;;;###autoload
(defun dired-do-shell-command (command &optional arg file-list)
"Run a shell command COMMAND on the marked files.
-If no files are marked or a specific numeric prefix arg is given,
+If no files are marked or a numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
it, write `*\"\"' in place of just `*'. This is equivalent to just
`*' in the shell, but avoids Dired's special handling.
-If COMMAND produces output, it goes to a separate buffer.
+If COMMAND ends in `&', `;', or `;&', it is executed in the
+background asynchronously, and the output appears in the buffer
+`*Async Shell Command*'. When operating on multiple files and COMMAND
+ends in `&', the shell command is executed on each file in parallel.
+However, when COMMAND ends in `;' or `;&' then commands are executed
+in the background on each file sequentially waiting for each command
+to terminate before running the next command. You can also use
+`dired-do-async-shell-command' that automatically adds `&'.
+
+Otherwise, COMMAND is executed synchronously, and the output
+appears in the buffer `*Shell Command Output*'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
(let ((files (dired-get-marked-files t current-prefix-arg)))
(list
;; Want to give feedback whether this file or marked files are used:
- (dired-read-shell-command (concat "! on "
- "%s: ")
- current-prefix-arg
- files)
+ (dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
(let* ((on-each (not (string-match dired-star-subst-regexp command)))
;; Might be redefined for smarter things and could then use RAW-ARG
;; (coming from interactive P and currently ignored) to decide what to do.
;; Smart would be a way to access basename or extension of file names.
- (let ((stuff-it
- (if (or (string-match dired-star-subst-regexp command)
- (string-match dired-quark-subst-regexp command))
- (lambda (x)
- (let ((retval command))
- (while (string-match
- "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
- (setq retval (replace-match x t t retval 2)))
- retval))
- (lambda (x) (concat command dired-mark-separator x)))))
- (if on-each
- (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";")
- (let ((files (mapconcat 'shell-quote-argument
- file-list dired-mark-separator)))
- (if (> (length file-list) 1)
- (setq files (concat dired-mark-prefix files dired-mark-postfix)))
- (funcall stuff-it files)))))
+ (let* ((in-background (string-match "[ \t]*&[ \t]*\\'" command))
+ (command (if in-background
+ (substring command 0 (match-beginning 0))
+ command))
+ (sequentially (string-match "[ \t]*;[ \t]*\\'" command))
+ (command (if sequentially
+ (substring command 0 (match-beginning 0))
+ command))
+ (stuff-it
+ (if (or (string-match dired-star-subst-regexp command)
+ (string-match dired-quark-subst-regexp command))
+ (lambda (x)
+ (let ((retval command))
+ (while (string-match
+ "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
+ (setq retval (replace-match x t t retval 2)))
+ retval))
+ (lambda (x) (concat command dired-mark-separator x)))))
+ (concat
+ (if on-each
+ (mapconcat stuff-it (mapcar 'shell-quote-argument file-list)
+ (if (and in-background (not sequentially)) "&" ";"))
+ (let ((files (mapconcat 'shell-quote-argument
+ file-list dired-mark-separator)))
+ (if (> (length file-list) 1)
+ (setq files (concat dired-mark-prefix files dired-mark-postfix)))
+ (funcall stuff-it files)))
+ (if in-background "&" ""))))
;; This is an extra function so that it can be redefined by ange-ftp.
;;;###autoload
argument, the name of an old file, and returning either the
corresponding new file name or nil to skip.
-Optional MARKER-CHAR is a character with which to mark every
-newfile's entry, or t to use the current marker character if the
-old file was marked."
+If optional argument MARKER-CHAR is non-nil, mark each
+newly-created file's Dired entry with the character MARKER-CHAR,
+or with the current marker character if MARKER-CHAR is t."
(let (dired-create-files-failures failures
skipped (success-count 0) (total (length fn-list)))
(let (to overwrite-query
&optional marker-char op1
how-to)
"Create a new file for each marked file.
-Prompts user for target, which is a directory in which to create
- the new files. Target may also be a plain file if only one marked
- file exists. The way the default for the target directory is
- computed depends on the value of `dired-dwim-target-directory'.
+Prompt user for a target directory in which to create the new
+ files. The target may also be a non-directory file, if only
+ one file is marked. The initial suggestion for target is the
+ Dired buffer's current directory (or, if `dired-dwim-target' is
+ non-nil, the current directory of a neighboring Dired window).
OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
will determine whether pop-ups are appropriate for this OP-SYMBOL.
FILE-CREATOR and OPERATION as in `dired-create-files'.
;;;###autoload
(defun dired-do-copy (&optional arg)
"Copy all marked (or next ARG) files, or copy the current file.
-This normally preserves the last-modified date when copying.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory,
-and new copies of these files are made in that directory
-with the same names that the files currently have. The default
-suggested for the target directory depends on the value of
-`dired-dwim-target', which see.
+When operating on just the current file, prompt for the new name.
+
+When operating on multiple or marked files, prompt for a target
+directory, and make the new copies in that directory, with the
+same names as the original files. The initial suggestion for the
+target directory is the Dired buffer's current directory (or, if
+`dired-dwim-target' is non-nil, the current directory of a
+neighboring Dired window).
-This command copies symbolic links by creating new ones,
-like `cp -d'."
+If `dired-copy-preserve-time' is non-nil, this command preserves
+the modification time of each old file in the copy, similar to
+the \"-p\" option for the \"cp\" shell command.
+
+This command copies symbolic links by creating new ones, similar
+to the \"-d\" option for the \"cp\" shell command."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
(dired-do-create-files 'copy (function dired-copy-file)
;;;###autoload
(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
- "Insert this subdirectory into the same dired buffer.
-If it is already present, overwrites previous entry,
- else inserts it at its natural place (as `ls -lR' would have done).
+ "Insert this subdirectory into the same Dired buffer.
+If it is already present, overwrite the previous entry;
+ otherwise, insert it at its natural place (as `ls -lR' would
+ have done).
With a prefix arg, you may edit the `ls' switches used for this listing.
You can add `R' to the switches to expand the whole tree starting at
this subdirectory.
:type '(choice (const :tag "no maximum" nil) integer)
:group 'dired-x)
+;; For backward compatibility
+(define-obsolete-variable-alias 'dired-omit-files-p 'dired-omit-mode "22.1")
(define-minor-mode dired-omit-mode
"Toggle omission of uninteresting files in Dired (Dired-Omit mode).
With a prefix argument ARG, enable Dired-Omit mode if ARG is
(put 'dired-omit-mode 'safe-local-variable 'booleanp)
-;; For backward compatibility
-(define-obsolete-variable-alias 'dired-omit-files-p 'dired-omit-mode "22.1")
-
(defcustom dired-omit-files "^\\.?#\\|^\\.$\\|^\\.\\.$"
"Filenames matching this regexp will not be displayed.
This only has effect when `dired-omit-mode' is t. See interactive function
(defun dired-default-directory ()
"Return the `dired-default-directory-alist' entry for the current major-mode.
If none, return `default-directory'."
+ ;; It looks like this was intended to be something of a "general"
+ ;; feature, but it only ever seems to have been used in
+ ;; dired-smart-shell-command, and doesn't seem worth keeping around.
+ (declare (obsolete nil "24.1"))
(or (eval (cdr (assq major-mode dired-default-directory-alist)))
default-directory))
-;; It looks like this was intended to be something of a "general" feature,
-;; but it only ever seems to have been used in dired-smart-shell-command,
-;; and does not seem worth keeping around (?).
-(make-obsolete 'dired-default-directory
- "this feature is due to be removed." "24.1")
-
(defun dired-smart-shell-command (command &optional output-buffer error-buffer)
"Like function `shell-command', but in the current Virtual Dired directory."
(interactive
(defun dired-hack-local-variables ()
"Evaluate local variables in `dired-local-variables-file' for dired buffer."
+ (declare (obsolete hack-dir-local-variables-non-file-buffer "24.1"))
(and (stringp dired-local-variables-file)
(file-exists-p dired-local-variables-file)
(let ((opoint (point-max))
(hack-local-variables))
;; Delete this stuff: `eobp' is used to find last subdir by dired.el.
(delete-region opoint (point-max)))
- ;; Make sure that the modeline shows the proper information.
- (dired-sort-set-modeline))))
-
-(make-obsolete 'dired-hack-local-variables
- 'hack-dir-local-variables-non-file-buffer "24.1")
+ ;; Make sure that the mode line shows the proper information.
+ (dired-sort-set-mode-line))))
;; Does not seem worth a dedicated command.
;; See the more general features in files-x.el.
(defun dired-omit-here-always ()
"Create `dir-locals-file' setting `dired-omit-mode' to t in `dired-mode'.
If in a Dired buffer, reverts it."
+ (declare (obsolete add-dir-local-variable "24.1"))
(interactive)
(if (file-exists-p dired-local-variables-file)
(error "Old-style dired-local-variables-file `./%s' found;
(dired-extra-startup)
(dired-revert))))
-(make-obsolete 'dired-omit-here-always 'add-dir-local-variable "24.1")
-
\f
;;; GUESS SHELL COMMAND.
;;; Code:
-(eval-when-compile (require 'cl))
-
;;; Customizable variables
(defgroup dired nil
(defcustom dired-dwim-target nil
"If non-nil, Dired tries to guess a default target directory.
-This means: if there is a dired buffer displayed in the next window,
-use its current subdir, instead of the current subdir of this dired buffer.
+This means: if there is a Dired buffer displayed in the next
+window, use its current directory, instead of this Dired buffer's
+current directory.
The target is used in the prompt for file copy, rename etc."
:type 'boolean
;; (dolist (ext completion-ignored-extensions)
;; (if (eq ?/ (aref ext (1- (length ext)))) (push ext cie)))
;; (setq cie (concat (regexp-opt cie "\\(?:") "\\'"))
-;; (lexical-let* ((default (and buffer-file-name
-;; (abbreviate-file-name buffer-file-name)))
-;; (cie cie)
-;; (completion-table
-;; ;; We need a mix of read-file-name and
-;; ;; read-directory-name so that completion to directories
-;; ;; is preferred, but if the user wants to enter a global
-;; ;; pattern, he can still use completion on filenames to
-;; ;; help him write the pattern.
-;; ;; Essentially, we want to use
-;; ;; (completion-table-with-predicate
-;; ;; 'read-file-name-internal 'file-directory-p nil)
-;; ;; but that doesn't work because read-file-name-internal
-;; ;; does not obey its `predicate' argument.
-;; (completion-table-in-turn
-;; (lambda (str pred action)
-;; (let ((read-file-name-predicate
-;; (lambda (f)
-;; (and (not (member f '("./" "../")))
-;; ;; Hack! Faster than file-directory-p!
-;; (eq (aref f (1- (length f))) ?/)
-;; (not (string-match cie f))))))
-;; (complete-with-action
-;; action 'read-file-name-internal str nil)))
-;; 'read-file-name-internal)))
+;; (let* ((default (and buffer-file-name
+;; (abbreviate-file-name buffer-file-name)))
+;; (cie cie)
+;; (completion-table
+;; ;; We need a mix of read-file-name and
+;; ;; read-directory-name so that completion to directories
+;; ;; is preferred, but if the user wants to enter a global
+;; ;; pattern, he can still use completion on filenames to
+;; ;; help him write the pattern.
+;; ;; Essentially, we want to use
+;; ;; (completion-table-with-predicate
+;; ;; 'read-file-name-internal 'file-directory-p nil)
+;; ;; but that doesn't work because read-file-name-internal
+;; ;; does not obey its `predicate' argument.
+;; (completion-table-in-turn
+;; (lambda (str pred action)
+;; (let ((read-file-name-predicate
+;; (lambda (f)
+;; (and (not (member f '("./" "../")))
+;; ;; Hack! Faster than file-directory-p!
+;; (eq (aref f (1- (length f))) ?/)
+;; (not (string-match cie f))))))
+;; (complete-with-action
+;; action 'read-file-name-internal str nil)))
+;; 'read-file-name-internal)))
;; (minibuffer-with-setup-hook
;; (lambda ()
;; (setq minibuffer-default default)
"Mark all files remembered in ALIST.
Each element of ALIST looks like (FILE . MARKERCHAR)."
(let (elt fil chr)
- (while alist
- (setq elt (car alist)
- alist (cdr alist)
- fil (car elt)
- chr (cdr elt))
- (if (dired-goto-file fil)
- (save-excursion
- (beginning-of-line)
- (delete-char 1)
- (insert chr))))))
+ (save-excursion
+ (while alist
+ (setq elt (car alist)
+ alist (cdr alist)
+ fil (car elt)
+ chr (cdr elt))
+ (when (dired-goto-file fil)
+ (beginning-of-line)
+ (delete-char 1)
+ (insert chr))))))
(defun dired-remember-hidden ()
"Return a list of names of subdirs currently hidden."
(define-key map "&" 'dired-do-async-shell-command)
;; Comparison commands
(define-key map "=" 'dired-diff)
- (define-key map "\M-=" 'dired-backup-diff)
;; Tree Dired commands
(define-key map "\M-\C-?" 'dired-unmark-all-files)
(define-key map "\M-\C-d" 'dired-tree-down)
(define-key map (kbd "M-s f C-s") 'dired-isearch-filenames)
(define-key map (kbd "M-s f M-C-s") 'dired-isearch-filenames-regexp)
;; misc
+ (define-key map [remap read-only-mode] 'dired-toggle-read-only)
+ ;; `toggle-read-only' is an obsolete alias for `read-only-mode'
(define-key map [remap toggle-read-only] 'dired-toggle-read-only)
(define-key map "?" 'dired-summary)
(define-key map "\177" 'dired-unmark-backward)
(define-key map
[menu-bar operate epa-dired-do-decrypt]
- '(menu-item "Decrypt" epa-dired-do-decrypt
+ '(menu-item "Decrypt..." epa-dired-do-decrypt
:help "Decrypt file at cursor"))
(define-key map
(define-key map
[menu-bar operate epa-dired-do-sign]
- '(menu-item "Sign" epa-dired-do-sign
+ '(menu-item "Sign..." epa-dired-do-sign
:help "Create digital signature of file at cursor"))
(define-key map
[menu-bar operate epa-dired-do-encrypt]
- '(menu-item "Encrypt" epa-dired-do-encrypt
+ '(menu-item "Encrypt..." epa-dired-do-encrypt
:help "Encrypt file at cursor"))
(define-key map [menu-bar operate dashes-3]
Actual changes in files cannot be undone by Emacs."))
(defun dired-toggle-read-only ()
- "Edit dired buffer with Wdired, or set it read-only.
-Call `wdired-change-to-wdired-mode' in dired buffers whose editing is
-supported by Wdired (the major mode of the dired buffer is `dired-mode').
-Otherwise, for buffers inheriting from dired-mode, call `toggle-read-only'."
+ "Edit Dired buffer with Wdired, or make it read-only.
+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)
- (with-no-warnings
- (toggle-read-only))))
+ (read-only-mode 'toggle)))
(defun dired-next-line (arg)
"Move down lines then position at filename.
;; dired-get-filename.
(concat (or dir default-directory) file))
-(defun dired-make-relative (file &optional dir _ignore)
+(defun dired-make-relative (file &optional dir)
"Convert FILE (an absolute file name) to a name relative to DIR.
-If this is impossible, return FILE unchanged.
-DIR must be a directory name, not a file name."
+If DIR is omitted or nil, it defaults to `default-directory'.
+If FILE is not in the directory tree of DIR, return FILE
+unchanged."
(or dir (setq dir default-directory))
;; This case comes into play if default-directory is set to
;; use ~.
(setq dir (expand-file-name dir)))
(if (string-match (concat "^" (regexp-quote dir)) file)
(substring file (match-end 0))
-;;; (or no-error
-;;; (error "%s: not in directory tree growing at %s" file dir))
file))
\f
;;; Functions for finding the file name in a dired buffer line.
dired-subdir-alist))))
cur-dir))))
-;(defun dired-get-subdir-min (elt)
-; (cdr elt))
;; can't use macro, must be redefinable for other alist format in dired-nstd.
(defalias 'dired-get-subdir-min 'cdr)
;; Deleting files
(defcustom dired-recursive-deletes 'top
- "Decide whether recursive deletes are allowed.
-A value of nil means no recursive deletes.
-`always' means delete recursively without asking. This is DANGEROUS!
-`top' means ask for each directory at top level, but delete its subdirectories
-without asking.
-Anything else means ask for each directory."
+ "Whether Dired deletes directories recursively.
+If nil, Dired will not delete non-empty directories.
+`always' means to delete non-empty directories recursively,
+without asking. This is dangerous!
+`top' means to ask for each top-level directory specified by the
+Dired deletion command, and delete its subdirectories without
+asking.
+Any other value means to ask for each directory."
:type '(choice :tag "Delete non-empty directories"
(const :tag "Yes" always)
(const :tag "No--only delete empty directories" nil)
(split-window-sensibly window))))
pop-up-frames)
(pop-to-buffer (get-buffer-create buf)))
+ ;; See Bug#12281.
+ (set-window-start nil (point-min))
;; If dired-shrink-to-fit is t, make its window fit its contents.
(when dired-shrink-to-fit
;; Try to not delete window when we want to display less than
(const shell) (const symlink) (const touch)
(const uncompress))))
-(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
+(defun dired-mark-pop-up (buffer-or-name op-symbol files function &rest args)
"Return FUNCTION's result on ARGS after showing which files are marked.
-Displays the file names in a buffer named BUFNAME;
- nil gives \" *Marked Files*\".
-This uses function `dired-pop-to-buffer' to do that.
-
-FUNCTION should not manipulate files, just read input
- (an argument or confirmation).
-The window is not shown if there is just one file or
- OP-SYMBOL is a member of the list in `dired-no-confirm'.
+Displays the file names in a window showing a buffer named
+BUFFER-OR-NAME; the default name being \" *Marked Files*\". The
+window is not shown if there is just one file, `dired-no-confirm'
+is t, or OP-SYMBOL is a member of the list in `dired-no-confirm'.
+
FILES is the list of marked files. It can also be (t FILENAME)
in the case of one marked file, to distinguish that from using
-just the current file."
- (or bufname (setq bufname " *Marked Files*"))
+just the current file.
+
+FUNCTION should not manipulate files, just read input \(an
+argument or confirmation)."
(if (or (eq dired-no-confirm t)
(memq op-symbol dired-no-confirm)
;; If FILES defaulted to the current line's file.
(= (length files) 1))
(apply function args)
- (with-current-buffer (get-buffer-create bufname)
- (erase-buffer)
- ;; Handle (t FILE) just like (FILE), here.
- ;; That value is used (only in some cases), to mean
- ;; just one file that was marked, rather than the current line file.
- (dired-format-columns-of-files (if (eq (car files) t) (cdr files) files))
- (remove-text-properties (point-min) (point-max)
- '(mouse-face nil help-echo nil)))
- (save-window-excursion
- (dired-pop-to-buffer bufname)
- (apply function args))))
+ (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*"))))
+ (with-current-buffer buffer
+ (let ((split-height-threshold 0))
+ (with-temp-buffer-window
+ buffer
+ (cons 'display-buffer-below-selected nil)
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (apply function args)
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ ;; Handle (t FILE) just like (FILE), here. That value is
+ ;; used (only in some cases), to mean just one file that was
+ ;; marked, rather than the current line file.
+ (dired-format-columns-of-files
+ (if (eq (car files) t) (cdr files) files))
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face nil help-echo nil))))))))
(defun dired-format-columns-of-files (files)
(let ((beg (point)))
(defun dired-mark (arg)
"Mark the current (or next ARG) files.
If on a subdir headerline, mark all its files except `.' and `..'.
+If the region is active in Transient Mark mode, mark all files
+in the active region.
Use \\[dired-unmark-all-files] to remove all marks
and \\[dired-unmark] on a subdir to remove the marks in
this subdir."
(interactive "P")
- (if (dired-get-subdir)
- (save-excursion (dired-mark-subdir-files))
+ (cond
+ ;; Mark files in the active region.
+ ((and transient-mark-mode mark-active)
+ (save-excursion
+ (let ((beg (region-beginning))
+ (end (region-end)))
+ (dired-mark-files-in-region
+ (progn (goto-char beg) (line-beginning-position))
+ (progn (goto-char end) (line-beginning-position))))))
+ ;; Mark subdir files from the subdir headerline.
+ ((dired-get-subdir)
+ (save-excursion (dired-mark-subdir-files)))
+ ;; Mark the current (or next ARG) files.
+ (t
(let ((inhibit-read-only t))
(dired-repeat-over-lines
(prefix-numeric-value arg)
- (function (lambda () (delete-char 1) (insert dired-marker-char)))))))
+ (function (lambda () (delete-char 1) (insert dired-marker-char))))))))
(defun dired-unmark (arg)
"Unmark the current (or next ARG) files.
-If looking at a subdir, unmark all its files except `.' and `..'."
+If looking at a subdir, unmark all its files except `.' and `..'.
+If the region is active in Transient Mark mode, unmark all files
+in the active region."
(interactive "P")
(let ((dired-marker-char ?\040))
(dired-mark arg)))
(defun dired-flag-file-deletion (arg)
"In Dired, flag the current line's file for deletion.
With prefix arg, repeat over several lines.
-
-If on a subdir headerline, mark all its files except `.' and `..'."
+If on a subdir headerline, flag all its files except `.' and `..'.
+If the region is active in Transient Mark mode, flag all files
+in the active region."
(interactive "P")
(let ((dired-marker-char dired-del-marker))
(dired-mark arg)))
(defun dired-unmark-backward (arg)
"In Dired, move up lines and remove marks or deletion flags there.
Optional prefix ARG says how many lines to unmark/unflag; default
-is one line."
+is one line.
+If the region is active in Transient Mark mode, unmark all files
+in the active region."
(interactive "p")
(dired-unmark (- arg)))
(defvar dired-regexp-history nil
"History list of regular expressions used in Dired commands.")
-(defun dired-read-regexp (prompt)
- (read-from-minibuffer prompt nil nil nil 'dired-regexp-history))
+(defun dired-read-regexp (prompt &optional default history)
+ (read-regexp prompt default (or history 'dired-regexp-history)))
(defun dired-mark-files-regexp (regexp &optional marker-char)
"Mark all files matching REGEXP for use in later commands.
"Non-nil means the Dired sort command is disabled.
The idea is to set this buffer-locally in special dired buffers.")
-(defun dired-sort-set-modeline ()
- ;; Set modeline display according to dired-actual-switches.
- ;; Modeline display of "by name" or "by date" guarantees the user a
+(defun dired-sort-set-mode-line ()
+ ;; Set mode line display according to dired-actual-switches.
+ ;; Mode line display of "by name" or "by date" guarantees the user a
;; match with the corresponding regexps. Non-matching switches are
;; shown literally.
(when (eq major-mode 'dired-mode)
(concat "Dired " dired-actual-switches)))))
(force-mode-line-update)))
+(define-obsolete-function-alias 'dired-sort-set-modeline
+ 'dired-sort-set-mode-line "24.3")
+
(defun dired-sort-toggle-or-edit (&optional arg)
"Toggle sorting by date, and refresh the Dired buffer.
With a prefix argument, edit the current listing switches instead."
;; Now, if we weren't sorting by date before, add the -t switch.
(unless sorting-by-date
(setq dired-actual-switches (concat dired-actual-switches " -t"))))
- (dired-sort-set-modeline)
+ (dired-sort-set-mode-line)
(revert-buffer))
;; Some user code loads dired especially for this.
With optional second arg NO-REVERT, don't refresh the listing afterwards."
(dired-sort-R-check switches)
(setq dired-actual-switches switches)
- (dired-sort-set-modeline)
+ (dired-sort-set-mode-line)
(or no-revert (revert-buffer)))
(defvar dired-subdir-alist-pre-R nil
;;;; Drag and drop support
(defcustom dired-recursive-copies 'top
- "Decide whether recursive copies are allowed.
-A value of nil means no recursive copies.
-`always' means copy recursively without asking.
-`top' means ask for each directory at top level.
-Anything else means ask for each directory."
+ "Whether Dired copies directories recursively.
+If nil, never copy recursively.
+`always' means to copy recursively without asking.
+`top' means to ask for each directory at top level.
+Any other value means to ask for each directory."
:type '(choice :tag "Copy directories"
(const :tag "No recursive copies" nil)
(const :tag "Ask for each directory" t)
;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command
;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown
;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff
-;;;;;; dired-diff) "dired-aux" "dired-aux.el" "58d623eb8e68e472e6164a1bcae83360")
+;;;;;; dired-diff) "dired-aux" "dired-aux.el" "244227ae609852d3dc10ab3fc40ba9ab")
;;; Generated autoloads from dired-aux.el
(autoload 'dired-diff "dired-aux" "\
Compare file at point with file FILE using `diff'.
-FILE defaults to the file at the mark. (That's the mark set by
-\\[set-mark-command], not by Dired's \\[dired-mark] command.)
-The prompted-for FILE is the first file given to `diff'.
-With prefix arg, prompt for second argument SWITCHES,
-which is the string of command switches for `diff'.
+If called interactively, prompt for FILE. If the file at point
+has a backup file, use that as the default. If the mark is active
+in Transient Mark mode, use the file at the mark as the default.
+\(That's the mark set by \\[set-mark-command], not by Dired's
+\\[dired-mark] command.)
+
+FILE is the first file given to `diff'. The file at point
+is the second file given to `diff'.
+
+With prefix arg, prompt for second argument SWITCHES, which is
+the string of command switches for the third argument of `diff'.
\(fn FILE &optional SWITCHES)" t nil)
(autoload 'dired-do-chmod "dired-aux" "\
Change the mode of the marked (or next ARG) files.
Symbolic modes like `g+w' are allowed.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer.
\(fn &optional ARG)" t nil)
(autoload 'dired-do-chgrp "dired-aux" "\
Change the group of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer.
\(fn &optional ARG)" t nil)
(autoload 'dired-do-chown "dired-aux" "\
Change the owner of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer.
\(fn &optional ARG)" t nil)
(autoload 'dired-do-touch "dired-aux" "\
Change the timestamp of the marked (or next ARG) files.
This calls touch.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer.
\(fn &optional ARG)" t nil)
(autoload 'dired-do-async-shell-command "dired-aux" "\
Run a shell command COMMAND on the marked files asynchronously.
-Like `dired-do-shell-command' but if COMMAND doesn't end in ampersand,
-adds `* &' surrounded by whitespace and executes the command asynchronously.
+Like `dired-do-shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
+When operating on multiple files, asynchronous commands
+are executed in the background on each file in parallel.
+In shell syntax this means separating the individual commands
+with `&'. However, when COMMAND ends in `;' or `;&' then commands
+are executed in the background on each file sequentially waiting
+for each command to terminate before running the next command.
+In shell syntax this means separating the individual commands with `;'.
+
The output appears in the buffer `*Async Shell Command*'.
\(fn COMMAND &optional ARG FILE-LIST)" t nil)
(autoload 'dired-do-shell-command "dired-aux" "\
Run a shell command COMMAND on the marked files.
-If no files are marked or a specific numeric prefix arg is given,
+If no files are marked or a numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
it, write `*\"\"' in place of just `*'. This is equivalent to just
`*' in the shell, but avoids Dired's special handling.
-If COMMAND produces output, it goes to a separate buffer.
+If COMMAND ends in `&', `;', or `;&', it is executed in the
+background asynchronously, and the output appears in the buffer
+`*Async Shell Command*'. When operating on multiple files and COMMAND
+ends in `&', the shell command is executed on each file in parallel.
+However, when COMMAND ends in `;' or `;&' then commands are executed
+in the background on each file sequentially waiting for each command
+to terminate before running the next command. You can also use
+`dired-do-async-shell-command' that automatically adds `&'.
+
+Otherwise, COMMAND is executed synchronously, and the output
+appears in the buffer `*Shell Command Output*'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
(autoload 'dired-do-copy "dired-aux" "\
Copy all marked (or next ARG) files, or copy the current file.
-This normally preserves the last-modified date when copying.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory,
-and new copies of these files are made in that directory
-with the same names that the files currently have. The default
-suggested for the target directory depends on the value of
-`dired-dwim-target', which see.
+When operating on just the current file, prompt for the new name.
+
+When operating on multiple or marked files, prompt for a target
+directory, and make the new copies in that directory, with the
+same names as the original files. The initial suggestion for the
+target directory is the Dired buffer's current directory (or, if
+`dired-dwim-target' is non-nil, the current directory of a
+neighboring Dired window).
-This command copies symbolic links by creating new ones,
-like `cp -d'.
+If `dired-copy-preserve-time' is non-nil, this command preserves
+the modification time of each old file in the copy, similar to
+the \"-p\" option for the \"cp\" shell command.
+
+This command copies symbolic links by creating new ones, similar
+to the \"-d\" option for the \"cp\" shell command.
\(fn &optional ARG)" t nil)
\(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil)
(autoload 'dired-insert-subdir "dired-aux" "\
-Insert this subdirectory into the same dired buffer.
-If it is already present, overwrites previous entry,
- else inserts it at its natural place (as `ls -lR' would have done).
+Insert this subdirectory into the same Dired buffer.
+If it is already present, overwrite the previous entry;
+ otherwise, insert it at its natural place (as `ls -lR' would
+ have done).
With a prefix arg, you may edit the `ls' switches used for this listing.
You can add `R' to the switches to expand the whole tree starting at
this subdirectory.
;;;***
\f
;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump)
-;;;;;; "dired-x" "dired-x.el" "2a39a8306a5541c304bc4ab602876f92")
+;;;;;; "dired-x" "dired-x.el" "a4e6844421c2c5e6fde90e959fbcc26f")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\
dir))
+(define-obsolete-function-alias 'dirtrack-toggle 'dirtrack-mode "23.1")
+(define-obsolete-variable-alias 'dirtrackp 'dirtrack-mode "23.1")
;;;###autoload
(define-minor-mode dirtrack-mode
"Toggle directory tracking in shell buffers (Dirtrack mode).
(add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
(remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
-(define-obsolete-function-alias 'dirtrack-toggle 'dirtrack-mode "23.1")
-(define-obsolete-variable-alias 'dirtrackp 'dirtrack-mode "23.1")
-
+(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
+ "23.1")
+(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
(define-minor-mode dirtrack-debug-mode
"Toggle Dirtrack debugging.
With a prefix argument ARG, enable Dirtrack debugging if ARG is
(if dirtrack-debug-mode
(display-buffer (get-buffer-create dirtrack-debug-buffer))))
-(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
- "23.1")
-(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
-
-
(defun dirtrack-debug-message (msg1 msg2)
"Insert strings at the end of `dirtrack-debug-buffer'."
(when dirtrack-debug-mode
;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;;
-;; Author: Tassilo Horn <tassilo@member.fsf.org>
-;; Maintainer: Tassilo Horn <tassilo@member.fsf.org>
+;; Author: Tassilo Horn <tsdh@gnu.org>
+;; Maintainer: Tassilo Horn <tsdh@gnu.org>
;; Keywords: files, pdf, ps, dvi
;; This file is part of GNU Emacs.
;; pages won't be displayed before conversion of the document finished
;; completely.
;;
-;; DocView lets you select a slice of the displayed pages. This slice will be
-;; remembered and applied to all pages of the current document. This enables
-;; you to cut away the margins of a document to save some space. To select a
-;; slice you can use `doc-view-set-slice' (bound to `s s') which will query you
-;; for the coordinates of the slice's top-left corner and its width and height.
-;; A much more convenient way to do the same is offered by the command
-;; `doc-view-set-slice-using-mouse' (bound to `s m'). After invocation you
-;; only have to press mouse-1 at the top-left corner and drag it to the
-;; bottom-right corner of the desired slice. To reset the slice use
-;; `doc-view-reset-slice' (bound to `s r').
+;; DocView lets you select a slice of the displayed pages. This slice
+;; will be remembered and applied to all pages of the current
+;; document. This enables you to cut away the margins of a document
+;; to save some space. To select a slice you can use
+;; `doc-view-set-slice' (bound to `s s') which will query you for the
+;; coordinates of the slice's top-left corner and its width and
+;; height. A much more convenient way to do the same is offered by
+;; the command `doc-view-set-slice-using-mouse' (bound to `s m').
+;; After invocation you only have to press mouse-1 at the top-left
+;; corner and drag it to the bottom-right corner of the desired slice.
+;; Even more accurate and convenient is to use
+;; `doc-view-set-slice-from-bounding-box' (bound to `s b') which uses
+;; the BoundingBox information of the current page to set an optimal
+;; slice. To reset the slice use `doc-view-reset-slice' (bound to `s
+;; r').
;;
;; You can also search within the document. The command `doc-view-search'
;; (bound to `C-s') queries for a search regexp and initializes a list of all
;; - share more code with image-mode.
;; - better menu.
;; - Bind slicing to a drag event.
-;; - doc-view-fit-doc-to-window and doc-view-fit-window-to-doc?
;; - zoom the region around the cursor (like xdvi).
;; - get rid of the silly arrow in the fringe.
;; - improve anti-aliasing (pdf-utils gets it better).
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'dired)
(require 'image-mode)
(require 'jka-compr)
;;;; Internal Variables
(defun doc-view-new-window-function (winprops)
+ ;; (message "New window %s for buf %s" (car winprops) (current-buffer))
+ (cl-assert (or (eq t (car winprops))
+ (eq (window-buffer (car winprops)) (current-buffer))))
(let ((ol (image-mode-window-get 'overlay winprops)))
- (when (and ol (not (overlay-buffer ol)))
- ;; I've seen `ol' be a dead overlay. I do not yet know how this
- ;; happened, so maybe the bug is elsewhere, but in the mean time,
- ;; this seems like a safe approach.
- (setq ol nil))
(if ol
(progn
- (assert (eq (overlay-buffer ol) (current-buffer)))
- (setq ol (copy-overlay ol)))
- (assert (not (get-char-property (point-min) 'display)))
+ (setq ol (copy-overlay ol))
+ ;; `ol' might actually be dead.
+ (move-overlay ol (point-min) (point-max)))
(setq ol (make-overlay (point-min) (point-max) nil t))
(overlay-put ol 'doc-view t))
(overlay-put ol 'window (car winprops))
+ (unless (windowp (car winprops))
+ ;; It's a pseudo entry. Let's make sure it's not displayed (the
+ ;; `window' property is only effective if its value is a window).
+ (cl-assert (eq t (car winprops)))
+ (delete-overlay ol))
(image-mode-window-put 'overlay ol winprops)))
(defvar doc-view-current-files nil
;; Slicing the image
(define-key map (kbd "s s") 'doc-view-set-slice)
(define-key map (kbd "s m") 'doc-view-set-slice-using-mouse)
+ (define-key map (kbd "s b") 'doc-view-set-slice-from-bounding-box)
(define-key map (kbd "s r") 'doc-view-reset-slice)
;; Searching
(define-key map (kbd "C-s") 'doc-view-search)
)
"---"
["Set Slice" doc-view-set-slice-using-mouse]
+ ["Set Slice (BoundingBox)" doc-view-set-slice-from-bounding-box]
["Set Slice (manual)" doc-view-set-slice]
["Reset Slice" doc-view-reset-slice]
"---"
"Kill the current converter process(es)."
(interactive)
(while (consp doc-view-current-converter-processes)
- (ignore-errors ;; Maybe it's dead already?
+ (ignore-errors ;; Some entries might not be processes, and maybe
+ ;; some are dead already?
(kill-process (pop doc-view-current-converter-processes))))
(when doc-view-current-timer
(cancel-timer doc-view-current-timer)
(defvar doc-view-shrink-factor 1.125)
(defun doc-view-enlarge (factor)
- "Enlarge the document."
+ "Enlarge the document by FACTOR."
(interactive (list doc-view-shrink-factor))
(if (eq (plist-get (cdr (doc-view-current-image)) :type)
'imagemagick)
- ;; ImageMagick supports on-the-fly-rescaling
- (progn
- (set (make-local-variable 'doc-view-image-width)
- (ceiling (* factor doc-view-image-width)))
- (doc-view-insert-image (plist-get (cdr (doc-view-current-image)) :file)
- :width doc-view-image-width))
- (set (make-local-variable 'doc-view-resolution)
- (ceiling (* factor doc-view-resolution)))
- (doc-view-reconvert-doc)))
+ ;; ImageMagick supports on-the-fly-rescaling.
+ (let ((new (ceiling (* factor doc-view-image-width))))
+ (unless (equal new doc-view-image-width)
+ (set (make-local-variable 'doc-view-image-width) new)
+ (doc-view-insert-image
+ (plist-get (cdr (doc-view-current-image)) :file)
+ :width doc-view-image-width)))
+ (let ((new (ceiling (* factor doc-view-resolution))))
+ (unless (equal new doc-view-resolution)
+ (set (make-local-variable 'doc-view-resolution) new)
+ (doc-view-reconvert-doc)))))
(defun doc-view-shrink (factor)
"Shrink the document."
(img-height (cdr (image-display-size
(image-get-display-property) t))))
(doc-view-enlarge (min (/ (float win-width) (float img-width))
- (/ (float (- win-height 1)) (float img-height)))))
+ (/ (float (- win-height 1))
+ (float img-height)))))
;; If slice is set
(let* ((slice-width (nth 2 slice))
(slice-height (nth 3 slice))
(scale-factor (min (/ (float win-width) (float slice-width))
- (/ (float (- win-height 1)) (float slice-height))))
+ (/ (float (- win-height 1))
+ (float slice-height))))
(new-slice (mapcar (lambda (x) (ceiling (* scale-factor x))) slice)))
(doc-view-enlarge scale-factor)
(setf (doc-view-current-slice) new-slice)
;; Clear the old cached files
(when (file-exists-p (doc-view-current-cache-dir))
(delete-directory (doc-view-current-cache-dir) 'recursive))
+ (kill-local-variable 'doc-view-last-page-number)
(doc-view-initiate-display))
(defun doc-view-sentinel (proc event)
(list "-raw" pdf txt)
callback))
+(defun doc-view-current-cache-doc-pdf ()
+ "Return the name of the doc.pdf in the current cache dir.
+ This file exists only if the current document isn't a PDF or PS file already."
+ (expand-file-name "doc.pdf" (doc-view-current-cache-dir)))
+
(defun doc-view-doc->txt (txt callback)
"Convert the current document to text and call CALLBACK when done."
(make-directory (doc-view-current-cache-dir) t)
- (case doc-view-doc-type
- (pdf
+ (pcase doc-view-doc-type
+ (`pdf
;; Doc is a PDF, so convert it to TXT
(doc-view-pdf->txt doc-view-buffer-file-name txt callback))
- (ps
+ (`ps
;; Doc is a PS, so convert it to PDF (which will be converted to
;; TXT thereafter).
- (let ((pdf (expand-file-name "doc.pdf"
- (doc-view-current-cache-dir))))
+ (let ((pdf (doc-view-current-cache-doc-pdf)))
(doc-view-ps->pdf doc-view-buffer-file-name pdf
(lambda () (doc-view-pdf->txt pdf txt callback)))))
- (dvi
+ (`dvi
;; Doc is a DVI. This means that a doc.pdf already exists in its
;; cache subdirectory.
- (doc-view-pdf->txt (expand-file-name "doc.pdf"
- (doc-view-current-cache-dir))
- txt callback))
- (odf
+ (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback))
+ (`odf
;; Doc is some ODF (or MS Office) doc. This means that a doc.pdf
;; already exists in its cache subdirectory.
- (doc-view-pdf->txt (expand-file-name "doc.pdf"
- (doc-view-current-cache-dir))
- txt callback))
- (t (error "DocView doesn't know what to do"))))
+ (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback))
+ (_ (error "DocView doesn't know what to do"))))
(defun doc-view-ps->pdf (ps pdf callback)
"Convert PS to PDF asynchronously and call CALLBACK when finished."
(let ((png-file (expand-file-name "page-%d.png"
(doc-view-current-cache-dir))))
(make-directory (doc-view-current-cache-dir) t)
- (case doc-view-doc-type
- (dvi
+ (pcase doc-view-doc-type
+ (`dvi
;; DVI files have to be converted to PDF before Ghostscript can process
;; it.
- (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)))
+ (let ((pdf (doc-view-current-cache-doc-pdf)))
(doc-view-dvi->pdf doc-view-buffer-file-name pdf
(lambda () (doc-view-pdf/ps->png pdf png-file)))))
- (odf
+ (`odf
;; ODF files have to be converted to PDF before Ghostscript can
;; process it.
- (lexical-let
- ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))
- (opdf (expand-file-name (concat (file-name-sans-extension
- (file-name-nondirectory doc-view-buffer-file-name))
- ".pdf")
- doc-view-current-cache-dir))
- (png-file png-file))
+ (let ((pdf (doc-view-current-cache-doc-pdf))
+ (opdf (expand-file-name (concat (file-name-base doc-view-buffer-file-name)
+ ".pdf")
+ doc-view-current-cache-dir))
+ (png-file png-file))
;; The unoconv tool only supports a output directory, but no
;; file name. It's named like the input file with the
;; extension replaced by pdf.
;; Rename to doc.pdf
(rename-file opdf pdf)
(doc-view-pdf/ps->png pdf png-file)))))
- (pdf
+ (`pdf
(let ((pages (doc-view-active-pages)))
;; Convert PDF to PNG images starting with the active pages.
(doc-view-pdf->png doc-view-buffer-file-name png-file pages)))
- (t
+ (_
;; Convert to PNG images.
(doc-view-pdf/ps->png doc-view-buffer-file-name png-file)))))
margins of the document. It prompts for the top-left corner (X
and Y) of the slice to display and its WIDTH and HEIGHT.
-See `doc-view-set-slice-using-mouse' for a more convenient way to
-do that. To reset the slice use `doc-view-reset-slice'."
+See `doc-view-set-slice-using-mouse' and
+`doc-view-set-slice-from-bounding-box' for more convenient ways
+to do that. To reset the slice use `doc-view-reset-slice'."
(interactive
(let* ((size (image-size (doc-view-current-image) t))
(a (read-number (format "Top-left X (0..%d): " (car size))))
(setq done t))))
(doc-view-set-slice x y w h)))
+(defun doc-view-get-bounding-box ()
+ "Get the BoundingBox information of the current page."
+ (let* ((page (doc-view-current-page))
+ (doc (let ((cache-doc (doc-view-current-cache-doc-pdf)))
+ (if (file-exists-p cache-doc)
+ cache-doc
+ doc-view-buffer-file-name)))
+ (o (shell-command-to-string
+ (concat doc-view-ghostscript-program
+ " -dSAFER -dBATCH -dNOPAUSE -q -sDEVICE=bbox "
+ (format "-dFirstPage=%s -dLastPage=%s %s"
+ page page doc)))))
+ (save-match-data
+ (when (string-match (concat "%%BoundingBox: "
+ "\\([[:digit:]]+\\) \\([[:digit:]]+\\) "
+ "\\([[:digit:]]+\\) \\([[:digit:]]+\\)") o)
+ (mapcar #'string-to-number
+ (list (match-string 1 o)
+ (match-string 2 o)
+ (match-string 3 o)
+ (match-string 4 o)))))))
+
+(defvar doc-view-paper-sizes
+ '((a4 595 842)
+ (a4-landscape 842 595)
+ (letter 612 792)
+ (letter-landscape 792 612)
+ (legal 612 1008)
+ (legal-landscape 1008 612)
+ (a3 842 1191)
+ (a3-landscape 1191 842)
+ (tabloid 792 1224)
+ (ledger 1224 792))
+ "An alist from paper size names to dimensions.")
+
+(defun doc-view-guess-paper-size (iw ih)
+ "Guess the paper size according to the aspect ratio."
+ (cl-labels ((div (x y)
+ (round (/ (* 100.0 x) y))))
+ (let ((ar (div iw ih))
+ (al (mapcar (lambda (l)
+ (list (div (nth 1 l) (nth 2 l)) (car l)))
+ doc-view-paper-sizes)))
+ (cadr (assoc ar al)))))
+
+(defun doc-view-scale-bounding-box (ps iw ih bb)
+ (list (/ (* (nth 0 bb) iw) (nth 1 (assoc ps doc-view-paper-sizes)))
+ (/ (* (nth 1 bb) ih) (nth 2 (assoc ps doc-view-paper-sizes)))
+ (/ (* (nth 2 bb) iw) (nth 1 (assoc ps doc-view-paper-sizes)))
+ (/ (* (nth 3 bb) ih) (nth 2 (assoc ps doc-view-paper-sizes)))))
+
+(defun doc-view-set-slice-from-bounding-box (&optional force-paper-size)
+ "Set the slice from the document's BoundingBox information.
+The result is that the margins are almost completely cropped,
+much more accurate than could be done manually using
+`doc-view-set-slice-using-mouse'."
+ (interactive "P")
+ (let ((bb (doc-view-get-bounding-box)))
+ (if (not bb)
+ (message "BoundingBox couldn't be determined")
+ (let* ((is (image-size (doc-view-current-image) t))
+ (iw (car is))
+ (ih (cdr is))
+ (ps (or (and (null force-paper-size) (doc-view-guess-paper-size iw ih))
+ (intern (completing-read "Paper size: "
+ (mapcar #'car doc-view-paper-sizes)
+ nil t))))
+ (bb (doc-view-scale-bounding-box ps iw ih bb))
+ (x1 (nth 0 bb))
+ (y1 (nth 1 bb))
+ (x2 (nth 2 bb))
+ (y2 (nth 3 bb)))
+ ;; We keep a 2 pixel margin.
+ (doc-view-set-slice (- x1 2) (- ih y2 2)
+ (+ (- x2 x1) 4) (+ (- y2 y1) 4))))))
+
(defun doc-view-reset-slice ()
"Reset the current slice.
After calling this function whole pages will be visible again."
"page-[0-9]+\\.png" t)
'doc-view-sort))
(dolist (win (or (get-buffer-window-list buffer nil t)
- (list (selected-window))))
+ (list t)))
(let* ((page (doc-view-current-page win))
(pagefile (expand-file-name (format "page-%d.png" page)
(doc-view-current-cache-dir))))
(when (or force
(and (not (member pagefile prev-pages))
(member pagefile doc-view-current-files)))
- (with-selected-window win
- (assert (eq (current-buffer) buffer))
- (doc-view-goto-page page))))))))
+ (if (windowp win)
+ (with-selected-window win
+ (cl-assert (eq (current-buffer) buffer) t)
+ (doc-view-goto-page page))
+ (doc-view-goto-page page))))))))
(defun doc-view-buffer-message ()
;; Only show this message initially, not when refreshing the buffer (in which
;;;;; Toggle between editing and viewing
+(defvar-local doc-view-saved-settings nil
+ "Doc-view settings saved while in some other mode.")
+(put 'doc-view-saved-settings 'permanent-local t)
+
(defun doc-view-toggle-display ()
"Toggle between editing a document as text or viewing it."
(interactive)
;; returns nil for tar members.
(doc-view-fallback-mode)
- (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode)
+ (let* ((prev-major-mode (if (derived-mode-p 'doc-view-mode)
doc-view-previous-major-mode
- (when (not (memq major-mode
- '(doc-view-mode fundamental-mode)))
+ (unless (eq major-mode 'fundamental-mode)
major-mode))))
(kill-all-local-variables)
- (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode))
+ (set (make-local-variable 'doc-view-previous-major-mode)
+ prev-major-mode))
+
+ (dolist (var doc-view-saved-settings)
+ (set (make-local-variable (car var)) (cdr var)))
;; Figure out the document type.
(unless doc-view-doc-type
(defun doc-view-fallback-mode ()
"Fallback to the previous or next best major mode."
- (if doc-view-previous-major-mode
- (funcall doc-view-previous-major-mode)
- (let ((auto-mode-alist (rassq-delete-all
- 'doc-view-mode-maybe
- (rassq-delete-all 'doc-view-mode
- (copy-alist auto-mode-alist)))))
- (normal-mode))))
+ (let ((vars (if (derived-mode-p 'doc-view-mode)
+ (mapcar (lambda (var) (cons var (symbol-value var)))
+ '(doc-view-resolution
+ image-mode-winprops-alist)))))
+ (if doc-view-previous-major-mode
+ (funcall doc-view-previous-major-mode)
+ (let ((auto-mode-alist
+ (rassq-delete-all
+ 'doc-view-mode-maybe
+ (rassq-delete-all 'doc-view-mode
+ (copy-alist auto-mode-alist)))))
+ (normal-mode)))
+ (when vars
+ (setq-local doc-view-saved-settings vars))))
;;;###autoload
(defun doc-view-mode-maybe ()
(add-hook 'before-init-hook 'dos-reevaluate-defcustoms)
+(define-obsolete-variable-alias
+ 'register-name-alist 'dos-register-name-alist "24.1")
+
(defvar dos-register-name-alist
'((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5)
(cflag . 6) (flags . 7)
(al . (0 . 0)) (bl . (1 . 0)) (cl . (2 . 0)) (dl . (3 . 0))
(ah . (0 . 1)) (bh . (1 . 1)) (ch . (2 . 1)) (dh . (3 . 1))))
-(define-obsolete-variable-alias
- 'register-name-alist 'dos-register-name-alist "24.1")
-
(defun dos-make-register ()
(make-vector 8 0))
(setq null-device "NUL")
;; For distinguishing file types based upon suffixes.
-(defvar file-name-buffer-file-type-alist
- '(
- ("[:/].*config.sys$" . nil) ; config.sys text
+(defcustom file-name-buffer-file-type-alist
+ '(("[:/].*config.sys$" . nil) ; config.sys text
("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|bin\\|ico\\|pif\\|class\\)$" . t)
; MS-Dos stuff
("\\.\\(dll\\|drv\\|386\\|vxd\\|fon\\|fnt\\|fot\\|ttf\\|grp\\)$" . t)
("\\.tp[ulpw]$" . t) ; borland Pascal stuff
("[:/]tags$" . nil) ; emacs TAGS file
)
- "*Alist for distinguishing text files from binary files.
+ "Alist for distinguishing text files from binary files.
Each element has the form (REGEXP . TYPE), where REGEXP is matched
-against the file name, and TYPE is nil for text, t for binary.")
+against the file name, and TYPE is nil for text, t for binary."
+ :type '(repeat (cons regexp boolean))
+ :group 'dos-fns
+ :group 'w32)
;; Return the pair matching filename on file-name-buffer-file-type-alist,
;; or nil otherwise.
;;; Support for printing under DOS/Windows, see lpr.el and ps-print.el.
-(defvar direct-print-region-use-command-dot-com t
- "*Control whether command.com is used to print on Windows 9x.")
+(defcustom direct-print-region-use-command-dot-com t
+ "If non-nil, use command.com to print on Windows 9x."
+ :type 'boolean
+ :group 'dos-fns
+ :group 'w32)
;; Function to actually send data to the printer port.
;; Supports writing directly, and using various programs.
(apply 'call-process lpr-prog nil errbuf nil rest))
;; Run command.com to access printer port on Windows 9x, unless
;; we are supposed to append to an existing (non-empty) file,
- ;; to work around a bug in Windows 9x that prevents Win32
+ ;; to work around a bug in Windows 9x that prevents Windows
;; programs from accessing LPT ports reliably.
((and (eq system-type 'windows-nt)
(getenv "winbootdir")
(require 'electric)
-;; this depends on the format of list-buffers (from src/buffer.c) and
-;; on stuff in lisp/buff-menu.el
-
(defvar electric-buffer-menu-mode-map
(let ((map (make-keymap)))
(fillarray (car (cdr map)) 'Electric-buffer-menu-undefined)
(define-key map [mouse-2] 'Electric-buffer-menu-mouse-select)
map))
+(put 'Electric-buffer-menu-quit :advertised-binding "\C-c\C-c")
+(put 'Electric-buffer-menu-select :advertised-binding " ")
+(put 'Helper-help :advertised-binding (char-to-string help-char))
+(put 'Helper-describe-bindings :advertised-binding "?")
+
(defvar electric-buffer-menu-mode-hook nil
- "Normal hook run by `electric-buffer-list'.")
+ "Normal hook run by `electric-buffer-menu-mode'.")
;;;###autoload
(defun electric-buffer-list (arg)
- "Pop up a buffer describing the set of Emacs buffers.
-Vaguely like ITS lunar select buffer; combining typeoutoid buffer
-listing with menuoid buffer selection.
-
-If the very next character typed is a space then the buffer list
-window disappears. Otherwise, one may move around in the buffer list
-window, marking buffers to be selected, saved or deleted.
-
-To exit and select a new buffer, type a space when the cursor is on
-the appropriate line of the buffer-list window. Other commands are
-much like those of `Buffer-menu-mode'.
+ "Pop up the Buffer Menu in an \"electric\" window.
+If you type SPC or RET (`Electric-buffer-menu-select'), that
+selects the buffer at point and quits the \"electric\" window.
+Otherwise, you can move around in the Buffer Menu, marking
+buffers to be selected, saved or deleted; these other commands
+are much like those of `Buffer-menu-mode'.
Run hooks in `electric-buffer-menu-mode-hook' on entry.
-\\{electric-buffer-menu-mode-map}"
+\\<electric-buffer-menu-mode-map>
+\\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
+ configuration. If the very first character typed is a space, it
+ also has this effect.
+\\[Electric-buffer-menu-select] -- select buffer of line point is on.
+ Also show buffers marked with m in other windows,
+ deletes buffers marked with \"D\", and saves those marked with \"S\".
+\\[Buffer-menu-mark] -- mark buffer to be displayed.
+\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
+\\[Buffer-menu-save] -- mark that buffer to be saved.
+\\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
+\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
+\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
+\\[Buffer-menu-backup-unmark] -- back up a line and remove marks."
(interactive "P")
(let (select buffer)
(save-window-excursion
(setq buffer (list-buffers-noselect arg))
(Electric-pop-up-window buffer)
(unwind-protect
- (progn
+ (let ((header header-line-format))
(set-buffer buffer)
- (Electric-buffer-menu-mode)
+ (electric-buffer-menu-mode)
+ (setq header-line-format header)
+ (goto-char (point-min))
+ (if (search-forward "\n." nil t)
+ (forward-char -1))
(electric-buffer-update-highlight)
(setq select
(catch 'electric-buffer-menu-select
- (message "<<< Press Return to bury the buffer list >>>")
- (if (eq (setq unread-command-events (list (read-event)))
- ?\s)
- (progn (setq unread-command-events nil)
- (throw 'electric-buffer-menu-select nil)))
+ (message "<<< Type SPC or RET to bury the buffer list >>>")
+ (setq unread-command-events (list (read-event)))
(let ((start-point (point))
(first (progn (goto-char (point-min))
(unless Buffer-menu-use-header-line
(Buffer-menu-mode)
(bury-buffer) ;Get rid of window, if dedicated.
(message "")))
- (if select
- (progn (set-buffer buffer)
- (let ((opoint (point-marker)))
- (Buffer-menu-execute)
- (goto-char (point-min))
- (if (prog1 (search-forward "\n>" nil t)
- (goto-char opoint) (set-marker opoint nil))
- (Buffer-menu-select)
- (switch-to-buffer (Buffer-menu-buffer t))))))))
+ (when select
+ (set-buffer buffer)
+ (let ((opoint (point-marker)))
+ (Buffer-menu-execute)
+ (goto-char (point-min))
+ (if (prog1 (search-forward "\n>" nil t)
+ (goto-char opoint)
+ (set-marker opoint nil))
+ (Buffer-menu-select)
+ (switch-to-buffer (Buffer-menu-buffer t)))))))
(defun electric-buffer-menu-looper (state condition)
(cond ((and condition
(defvar Helper-return-blurb)
-(put 'Electric-buffer-menu-mode 'mode-class 'special)
-(defun Electric-buffer-menu-mode ()
- "Major mode for editing a list of buffers.
-Each line describes one of the buffers in Emacs.
-Letters do not insert themselves; instead, they are commands.
-\\<electric-buffer-menu-mode-map>
-\\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
- configuration. If the very first character typed is a space, it
- also has this effect.
-\\[Electric-buffer-menu-select] -- select buffer of line point is on.
- Also show buffers marked with m in other windows,
- deletes buffers marked with \"D\", and saves those marked with \"S\".
-\\[Buffer-menu-mark] -- mark buffer to be displayed.
-\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
-\\[Buffer-menu-save] -- mark that buffer to be saved.
-\\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
-\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
-\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
-\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
+(define-derived-mode electric-buffer-menu-mode Buffer-menu-mode
+ "Electric Buffer Menu"
+ "Toggle Electric Buffer Menu mode in this buffer.
+With a prefix argument ARG, enable Long Lines mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
-\\{electric-buffer-menu-mode-map}
-
-Entry to this mode via command `electric-buffer-list' calls the value of
-`electric-buffer-menu-mode-hook'."
- (let ((saved header-line-format))
- (kill-all-local-variables)
- (setq header-line-format saved))
- (use-local-map electric-buffer-menu-mode-map)
- (setq mode-name "Electric Buffer Menu")
+Electric Buffer Menu mode is a minor mode which is automatically
+enabled and disabled by the \\[electric-buffer-list] command.
+See the documentation of `electric-buffer-list' for details."
(setq mode-line-buffer-identification "Electric Buffer List")
- (make-local-variable 'Helper-return-blurb)
- (setq Helper-return-blurb "return to buffer editing")
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (setq major-mode 'Electric-buffer-menu-mode)
- (goto-char (point-min))
- (if (search-forward "\n." nil t) (forward-char -1))
- (run-mode-hooks 'electric-buffer-menu-mode-hook))
+ (set (make-local-variable 'Helper-return-blurb)
+ "return to buffer editing"))
+
+(define-obsolete-function-alias 'Electric-buffer-menu-mode
+ 'electric-buffer-menu-mode "24.3")
;; generally the same as Buffer-menu-mode-map
;; (except we don't indirect to global-map)
(put 'Electric-buffer-menu-undefined 'suppress-keymap t)
-
(defun Electric-buffer-menu-exit ()
(interactive)
(setq unread-command-events (listify-key-sequence (this-command-keys)))
(interactive)
(ding)
(message "%s"
- (if (and (eq (key-binding "\C-c\C-c") 'Electric-buffer-menu-quit)
- (eq (key-binding " ") 'Electric-buffer-menu-select)
- (eq (key-binding (char-to-string help-char)) 'Helper-help)
- (eq (key-binding "?") 'Helper-describe-bindings))
- (substitute-command-keys "Type C-c C-c to exit, Space to select, \\[Helper-help] for help, ? for commands")
- (substitute-command-keys "\
+ (substitute-command-keys "\
Type \\[Electric-buffer-menu-quit] to exit, \
\\[Electric-buffer-menu-select] to select, \
-\\[Helper-help] for help, \\[Helper-describe-bindings] for commands.")))
+\\[Helper-help] for help, \\[Helper-describe-bindings] for commands."))
(sit-for 4))
(defun Electric-buffer-menu-mode-view-buffer ()
(sit-for 4))))
(defvar electric-buffer-overlay nil)
+
(defun electric-buffer-update-highlight ()
- (when (eq major-mode 'Electric-buffer-menu-mode)
+ (when (derived-mode-p 'electric-buffer-menu-mode)
;; Make sure we have an overlay to use.
(or electric-buffer-overlay
- (progn
- (make-local-variable 'electric-buffer-overlay)
- (setq electric-buffer-overlay (make-overlay (point) (point)))))
+ (set (make-local-variable 'electric-buffer-overlay)
+ (make-overlay (point) (point))))
(move-overlay electric-buffer-overlay
(line-beginning-position)
(line-end-position))
;;; Code:
\f
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'kmacro)
mac))))
(if no-keys
(when cmd
- (loop for key in (where-is-internal cmd '(keymap)) do
- (global-unset-key key)))
+ (cl-loop for key in (where-is-internal cmd '(keymap)) do
+ (global-unset-key key)))
(when keys
(if (= (length mac) 0)
- (loop for key in keys do (global-unset-key key))
- (loop for key in keys do
- (global-set-key key
- (or cmd
- (if (and mac-counter mac-format)
- (kmacro-lambda-form mac mac-counter mac-format)
- mac))))))))))
+ (cl-loop for key in keys do (global-unset-key key))
+ (cl-loop for key in keys do
+ (global-set-key key
+ (or cmd
+ (if (and mac-counter mac-format)
+ (kmacro-lambda-form
+ mac mac-counter mac-format)
+ mac))))))))))
(kill-buffer buf)
(when (buffer-name obuf)
(switch-to-buffer obuf))
(one-line (eq verbose 1)))
(if one-line (setq verbose nil))
(when (stringp macro)
- (loop for i below (length macro) do
- (when (>= (aref rest-mac i) 128)
- (incf (aref rest-mac i) (- ?\M-\^@ 128)))))
+ (cl-loop for i below (length macro) do
+ (when (>= (aref rest-mac i) 128)
+ (cl-incf (aref rest-mac i) (- ?\M-\^@ 128)))))
(while (not (eq (aref rest-mac 0) 'end-macro))
(let* ((prefix
(or (and (integerp (aref rest-mac 0))
'(digit-argument negative-argument))
(let ((i 1))
(while (memq (aref rest-mac i) (cdr mdigs))
- (incf i))
+ (cl-incf i))
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ")
- (callf edmacro-subseq rest-mac i)))))
+ (cl-callf edmacro-subseq rest-mac i)))))
(and (eq (aref rest-mac 0) ?\C-u)
(eq (key-binding [?\C-u]) 'universal-argument)
(let ((i 1))
(while (eq (aref rest-mac i) ?\C-u)
- (incf i))
+ (cl-incf i))
(and (not (memq (aref rest-mac i) pkeys))
- (prog1 (loop repeat i concat "C-u ")
- (callf edmacro-subseq rest-mac i)))))
+ (prog1 (cl-loop repeat i concat "C-u ")
+ (cl-callf edmacro-subseq rest-mac i)))))
(and (eq (aref rest-mac 0) ?\C-u)
(eq (key-binding [?\C-u]) 'universal-argument)
(let ((i 1))
(when (eq (aref rest-mac i) ?-)
- (incf i))
+ (cl-incf i))
(while (memq (aref rest-mac i)
'(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- (incf i))
+ (cl-incf i))
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ")
- (callf edmacro-subseq rest-mac i)))))))
+ (cl-callf edmacro-subseq rest-mac i)))))))
(bind-len (apply 'max 1
- (loop for map in maps
- for b = (lookup-key map rest-mac)
- when b collect b)))
+ (cl-loop for map in maps
+ for b = (lookup-key map rest-mac)
+ when b collect b)))
(key (edmacro-subseq rest-mac 0 bind-len))
(fkey nil) tlen tkey
- (bind (or (loop for map in maps for b = (lookup-key map key)
- thereis (and (not (integerp b)) b))
+ (bind (or (cl-loop for map in maps for b = (lookup-key map key)
+ thereis (and (not (integerp b)) b))
(and (setq fkey (lookup-key local-function-key-map rest-mac))
(setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen)
fkey (lookup-key local-function-key-map tkey))
- (loop for map in maps
- for b = (lookup-key map fkey)
- when (and (not (integerp b)) b)
- do (setq bind-len tlen key tkey)
- and return b
- finally do (setq fkey nil)))))
+ (cl-loop for map in maps
+ for b = (lookup-key map fkey)
+ when (and (not (integerp b)) b)
+ do (setq bind-len tlen key tkey)
+ and return b
+ finally do (setq fkey nil)))))
(first (aref key 0))
- (text (loop for i from bind-len below (length rest-mac)
- for ch = (aref rest-mac i)
- while (and (integerp ch)
- (> ch 32) (< ch maxkey) (/= ch 92)
- (eq (key-binding (char-to-string ch))
- 'self-insert-command)
- (or (> i (- (length rest-mac) 2))
- (not (eq ch (aref rest-mac (+ i 1))))
- (not (eq ch (aref rest-mac (+ i 2))))))
- finally return i))
+ (text
+ (cl-loop for i from bind-len below (length rest-mac)
+ for ch = (aref rest-mac i)
+ while (and (integerp ch)
+ (> ch 32) (< ch maxkey) (/= ch 92)
+ (eq (key-binding (char-to-string ch))
+ 'self-insert-command)
+ (or (> i (- (length rest-mac) 2))
+ (not (eq ch (aref rest-mac (+ i 1))))
+ (not (eq ch (aref rest-mac (+ i 2))))))
+ finally return i))
desc)
(if (stringp bind) (setq bind nil))
(cond ((and (eq bind 'self-insert-command) (not prefix)
(setq desc (concat (edmacro-subseq rest-mac 0 text)))
(when (string-match "^[ACHMsS]-." desc)
(setq text 2)
- (callf substring desc 0 2))
+ (cl-callf substring desc 0 2))
(not (string-match
"^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*."
desc))))
(cond
((integerp ch)
(concat
- (loop for pf across "ACHMsS"
- for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
- ?\M-\^@ ?\s-\^@ ?\S-\^@)
- when (/= (logand ch bit) 0)
- concat (format "%c-" pf))
+ (cl-loop for pf across "ACHMsS"
+ for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
+ ?\M-\^@ ?\s-\^@ ?\S-\^@)
+ when (/= (logand ch bit) 0)
+ concat (format "%c-" pf))
(let ((ch2 (logand ch (1- (lsh 1 18)))))
(cond ((<= ch2 32)
- (case ch2
+ (pcase ch2
(0 "NUL") (9 "TAB") (10 "LFD")
(13 "RET") (27 "ESC") (32 "SPC")
- (t
+ (_
(format "C-%c"
(+ (if (<= ch2 26) 96 64)
ch2)))))
(let ((times 1) (pos bind-len))
(while (not (edmacro-mismatch rest-mac rest-mac
0 bind-len pos (+ bind-len pos)))
- (incf times)
- (incf pos bind-len))
+ (cl-incf times)
+ (cl-incf pos bind-len))
(when (> times 1)
(setq desc (format "%d*%s" times desc))
(setq bind-len (* bind-len times)))))
(setq rest-mac (edmacro-subseq rest-mac bind-len))
(if verbose
(progn
- (unless (equal res "") (callf concat res "\n"))
- (callf concat res desc)
+ (unless (equal res "") (cl-callf concat res "\n"))
+ (cl-callf concat res desc)
(when (and bind (or (stringp bind) (symbolp bind)))
- (callf concat res
+ (cl-callf concat res
(make-string (max (- 3 (/ (length desc) 8)) 1) 9)
";; " (if (stringp bind) bind (symbol-name bind))))
(setq len 0))
(if (and (> (+ len (length desc) 2) 72) (not one-line))
(progn
- (callf concat res "\n ")
+ (cl-callf concat res "\n ")
(setq len 1))
(unless (equal res "")
- (callf concat res " ")
- (incf len)))
- (callf concat res desc)
- (incf len (length desc)))))
+ (cl-callf concat res " ")
+ (cl-incf len)))
+ (cl-callf concat res desc)
+ (cl-incf len (length desc)))))
res))
(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2)
Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorted sequence.
\n(fn SEQ1 SEQ2 START1 END1 START2 END2)"
- (let (cl-test cl-test-not cl-key cl-from-end)
- (or cl-end1 (setq cl-end1 (length cl-seq1)))
- (or cl-end2 (setq cl-end2 (length cl-seq2)))
- (if cl-from-end
- (progn
- (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl-check-match (elt cl-seq1 (1- cl-end1))
- (elt cl-seq2 (1- cl-end2))))
- (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
- (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
- (1- cl-end1)))
- (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
- (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
- (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl-check-match (if cl-p1 (car cl-p1)
- (aref cl-seq1 cl-start1))
- (if cl-p2 (car cl-p2)
- (aref cl-seq2 cl-start2))))
- (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
- cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
- (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
- cl-start1)))))
+ (or cl-end1 (setq cl-end1 (length cl-seq1)))
+ (or cl-end2 (setq cl-end2 (length cl-seq2)))
+ (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
+ (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
+ (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+ (eql (if cl-p1 (car cl-p1)
+ (aref cl-seq1 cl-start1))
+ (if cl-p2 (car cl-p2)
+ (aref cl-seq2 cl-start2))))
+ (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
+ cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
+ (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+ cl-start1)))
(defun edmacro-subseq (seq start &optional end)
"Return the subsequence of SEQ from START to END.
The string represents the same events; Meta is indicated by bit 7.
This function assumes that the events can be stored in a string."
(setq seq (copy-sequence seq))
- (loop for i below (length seq) do
- (when (logand (aref seq i) 128)
- (setf (aref seq i) (logand (aref seq i) 127))))
+ (cl-loop for i below (length seq) do
+ (when (logand (aref seq i) 128)
+ (setf (aref seq i) (logand (aref seq i) 127))))
seq)
(defun edmacro-fix-menu-commands (macro &optional noerror)
((eq (car ev) 'switch-frame))
((equal ev '(menu-bar))
(push 'menu-bar result))
- ((equal (cadadr ev) '(menu-bar))
+ ((equal (cl-cadadr ev) '(menu-bar))
(push (vector 'menu-bar (car ev)) result))
;; It would be nice to do pop-up menus, too, but not enough
;; info is recorded in macros to make this possible.
(t
(let ((orig-word word) (prefix 0) (bits 0))
(while (string-match "^[ACHMsS]-." word)
- (incf bits (cdr (assq (aref word 0)
+ (cl-incf bits (cdr (assq (aref word 0)
'((?A . ?\A-\^@) (?C . ?\C-\^@)
(?H . ?\H-\^@) (?M . ?\M-\^@)
(?s . ?\s-\^@) (?S . ?\S-\^@)))))
- (incf prefix 2)
- (callf substring word 2))
+ (cl-incf prefix 2)
+ (cl-callf substring word 2))
(when (string-match "^\\^.$" word)
- (incf bits ?\C-\^@)
- (incf prefix)
- (callf substring word 1))
+ (cl-incf bits ?\C-\^@)
+ (cl-incf prefix)
+ (cl-callf substring word 1))
(let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
("LFD" . "\n") ("TAB" . "\t")
("ESC" . "\e") ("SPC" . " ")
("DEL" . "\177")))))
(when found (setq word (cdr found))))
(when (string-match "^\\\\[0-7]+$" word)
- (loop for ch across word
- for n = 0 then (+ (* n 8) ch -48)
- finally do (setq word (vector n))))
+ (cl-loop for ch across word
+ for n = 0 then (+ (* n 8) ch -48)
+ finally do (setq word (vector n))))
(cond ((= bits 0)
(setq key word))
((and (= bits ?\M-\^@) (stringp word)
(string-match "^-?[0-9]+$" word))
- (setq key (loop for x across word collect (+ x bits))))
+ (setq key (cl-loop for x across word
+ collect (+ x bits))))
((/= (length word) 1)
(error "%s must prefix a single character, not %s"
(substring orig-word 0 prefix) word))
(t
(setq key (list (+ bits (aref word 0)))))))))
(when key
- (loop repeat times do (callf vconcat res key)))))
+ (cl-loop repeat times do (cl-callf vconcat res key)))))
(when (and (>= (length res) 4)
(eq (aref res 0) ?\C-x)
(eq (aref res 1) ?\()
(eq (aref res (- (length res) 1)) ?\)))
(setq res (edmacro-subseq res 2 -2)))
(if (and (not need-vector)
- (loop for ch across res
- always (and (characterp ch)
- (let ((ch2 (logand ch (lognot ?\M-\^@))))
- (and (>= ch2 0) (<= ch2 127))))))
- (concat (loop for ch across res
- collect (if (= (logand ch ?\M-\^@) 0)
- ch (+ ch 128))))
+ (cl-loop for ch across res
+ always (and (characterp ch)
+ (let ((ch2 (logand ch (lognot ?\M-\^@))))
+ (and (>= ch2 0) (<= ch2 127))))))
+ (concat (cl-loop for ch across res
+ collect (if (= (logand ch ?\M-\^@) 0)
+ ch (+ ch 128))))
res)))
(provide 'edmacro)
(replace-buffer-in-windows buffer)
;; must do this outside of save-window-excursion
(bury-buffer buffer))
- (eval electric-help-form-to-execute))))
+ (if (functionp electric-help-form-to-execute)
+ (funcall electric-help-form-to-execute)
+ (eval electric-help-form-to-execute)))))
(defun electric-help-command-loop ()
(catch 'exit
;; continues with execute-extended-command.
(defun electric-help-execute-extended (_prefixarg)
(interactive "p")
- (setq electric-help-form-to-execute '(execute-extended-command nil))
+ (setq electric-help-form-to-execute
+ (lambda () (execute-extended-command nil)))
(electric-help-retain))
;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
;; continues with ctrl-x prefix.
(defun electric-help-ctrl-x-prefix (_prefixarg)
(interactive "p")
- (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
+ (setq electric-help-form-to-execute
+ (lambda ()
+ (message nil)
+ (setq unread-command-events
+ (append unread-command-events '(?\C-x)))))
(electric-help-retain))
\f
;;; Code:
-(eval-when-compile (require 'cl))
-
;; This loop is the guts for non-standard modes which retain control
;; until some event occurs. It is a `do-forever', the only way out is
;; to throw. It assumes that you have set up the keymap, window, and
;; it looks challenging.
(let (pos)
(when (and
+ electric-indent-mode
;; Don't reindent while inserting spaces at beginning of line.
(or (not (memq last-command-event '(?\s ?\t)))
(save-excursion (skip-chars-backward " \t") (not (bolp))))
((and (memq syntax '(?\( ?\" ?\$)) (use-region-p))
(if (> (mark) (point))
(goto-char (mark))
- ;; We already inserted the open-paren but at the end of the region,
- ;; so we have to remove it and start over.
- (delete-char -1)
- (save-excursion
+ ;; We already inserted the open-paren but at the end of the
+ ;; region, so we have to remove it and start over.
+ (delete-char -1)
+ (save-excursion
(goto-char (mark))
- (insert last-command-event)))
+ ;; Do not insert after `save-excursion' marker (Bug#11520).
+ (insert-before-markers last-command-event)))
(insert closer))
;; Backslash-escaped: no pairing, no skipping.
((save-excursion
(not (nth 8 (save-excursion (syntax-ppss pos)))))
(let ((end (copy-marker (point) t)))
(goto-char pos)
- (case (if (functionp rule) (funcall rule) rule)
+ (pcase (if (functionp rule) (funcall rule) rule)
;; FIXME: we used `newline' down here which called
;; self-insert-command and ran post-self-insert-hook recursively.
;; It happened to make electric-indent-mode work automatically with
;; electric-layout-mode (at the cost of re-indenting lines
;; multiple times), but I'm not sure it's what we want.
- (before (goto-char (1- pos)) (skip-chars-backward " \t")
+ (`before (goto-char (1- pos)) (skip-chars-backward " \t")
(unless (bolp) (insert "\n")))
- (after (insert "\n")) ; FIXME: check eolp before inserting \n?
- (around (save-excursion
+ (`after (insert "\n")) ; FIXME: check eolp before inserting \n?
+ (`around (save-excursion
(goto-char (1- pos)) (skip-chars-backward " \t")
(unless (bolp) (insert "\n")))
(insert "\n"))) ; FIXME: check eolp before inserting \n?
-;;; advice.el --- an overloading mechanism for Emacs Lisp functions
+;;; advice.el --- An overloading mechanism for Emacs Lisp functions
;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
(provide 'advice-preload)
;; During a normal load this is a noop:
(require 'advice-preload "advice.el")
-
+(require 'macroexp)
+(eval-when-compile (require 'cl-lib))
;; @@ Variable definitions:
;; ========================
(funcall fUnCtIoN tReE))
(t tReE)))
-;; this is just faster than `ad-substitute-tree':
-(defun ad-copy-tree (tree)
- "Return a copy of the list structure of TREE."
- (cond ((consp tree)
- (cons (ad-copy-tree (car tree))
- (ad-copy-tree (cdr tree))))
- (t tree)))
-
-(defmacro ad-dolist (varform &rest body)
- "A Common-Lisp-style dolist iterator with the following syntax:
-
- (ad-dolist (VAR INIT-FORM [RESULT-FORM])
- BODY-FORM...)
-
-which will iterate over the list yielded by INIT-FORM binding VAR to the
-current head at every iteration. If RESULT-FORM is supplied its value will
-be returned at the end of the iteration, nil otherwise. The iteration can be
-exited prematurely with `(ad-do-return [VALUE])'."
- (let ((expansion
- `(let ((ad-dO-vAr ,(car (cdr varform)))
- ,(car varform))
- (while ad-dO-vAr
- (setq ,(car varform) (car ad-dO-vAr))
- ,@body
- ;;work around a backquote bug:
- ;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
- ;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
- ,'(setq ad-dO-vAr (cdr ad-dO-vAr)))
- ,(car (cdr (cdr varform))))))
- ;;ok, this wastes some cons cells but only during compilation:
- (if (catch 'contains-return
- (ad-substitute-tree
- (function (lambda (subtree)
- (cond ((eq (car-safe subtree) 'ad-dolist))
- ((eq (car-safe subtree) 'ad-do-return)
- (throw 'contains-return t)))))
- 'identity body)
- nil)
- `(catch 'ad-dO-eXiT ,expansion)
- expansion)))
-
-(defmacro ad-do-return (value)
- `(throw 'ad-dO-eXiT ,value))
-
-(if (not (get 'ad-dolist 'lisp-indent-hook))
- (put 'ad-dolist 'lisp-indent-hook 1))
-
-
;; @@ Save real definitions of subrs used by Advice:
;; =================================================
;; Advice depends on the real, unmodified functionality of various subrs,
ad-advised-functions)))
(defmacro ad-do-advised-functions (varform &rest body)
- "`ad-dolist'-style iterator that maps over `ad-advised-functions'.
+ "`dolist'-style iterator that maps over `ad-advised-functions'.
\(ad-do-advised-functions (VAR [RESULT-FORM])
BODY-FORM...)
On each iteration VAR will be bound to the name of an advised function
\(a symbol)."
- `(ad-dolist (,(car varform)
+ `(cl-dolist (,(car varform)
ad-advised-functions
,(car (cdr varform)))
- (setq ,(car varform) (intern (car ,(car varform))))
- ,@body))
+ (setq ,(car varform) (intern (car ,(car varform))))
+ ,@body))
(if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
(put 'ad-do-advised-functions 'lisp-indent-hook 1))
`(put ,function 'ad-advice-info ,advice-info))
(defmacro ad-copy-advice-info (function)
- `(ad-copy-tree (get ,function 'ad-advice-info)))
+ `(copy-tree (get ,function 'ad-advice-info)))
(defmacro ad-is-advised (function)
"Return non-nil if FUNCTION has any advice info associated with it.
(defun ad-has-enabled-advice (function class)
"True if at least one of FUNCTION's advices in CLASS is enabled."
- (ad-dolist (advice (ad-get-advice-info-field function class))
- (if (ad-advice-enabled advice) (ad-do-return t))))
+ (cl-dolist (advice (ad-get-advice-info-field function class))
+ (if (ad-advice-enabled advice) (cl-return t))))
(defun ad-has-redefining-advice (function)
"True if FUNCTION's advice info defines at least 1 redefining advice.
(defun ad-has-any-advice (function)
"True if the advice info of FUNCTION defines at least one advice."
(and (ad-is-advised function)
- (ad-dolist (class ad-advice-classes nil)
+ (cl-dolist (class ad-advice-classes nil)
(if (ad-get-advice-info-field function class)
- (ad-do-return t)))))
+ (cl-return t)))))
(defun ad-get-enabled-advices (function class)
"Return the list of enabled advices of FUNCTION in CLASS."
(let (enabled-advices)
- (ad-dolist (advice (ad-get-advice-info-field function class))
+ (dolist (advice (ad-get-advice-info-field function class))
(if (ad-advice-enabled advice)
(push advice enabled-advices)))
(reverse enabled-advices)))
(ad-do-advised-functions (function)
(if (or (null predicate)
(funcall predicate function))
- (ad-do-return function)))
+ (cl-return function)))
(error "ad-read-advised-function: %s"
"There are no qualifying advised functions")))
(let* ((ad-pReDiCaTe predicate)
class of FUNCTION)."
(setq default
(or default
- (ad-dolist (class ad-advice-classes)
+ (cl-dolist (class ad-advice-classes)
(if (ad-get-advice-info-field function class)
- (ad-do-return class)))
+ (cl-return class)))
(error "ad-read-advice-class: `%s' has no advices" function)))
(let ((class (completing-read
(format "%s (default %s): " (or prompt "Class") default)
If CLASS is `any' all valid advice classes will be checked."
(if (ad-is-advised function)
(let (found-advice)
- (ad-dolist (advice-class ad-advice-classes)
+ (cl-dolist (advice-class ad-advice-classes)
(if (or (eq class 'any) (eq advice-class class))
(setq found-advice
- (ad-dolist (advice (ad-get-advice-info-field
+ (cl-dolist (advice (ad-get-advice-info-field
function advice-class))
(if (or (and (stringp name)
(string-match
name (symbol-name
(ad-advice-name advice))))
(eq name (ad-advice-name advice)))
- (ad-do-return advice)))))
- (if found-advice (ad-do-return found-advice))))))
+ (cl-return advice)))))
+ (if found-advice (cl-return found-advice))))))
(defun ad-enable-advice-internal (function class name flag)
"Set enable FLAG of FUNCTION's advices in CLASS matching NAME.
FUNCTION was not advised)."
(if (ad-is-advised function)
(let ((matched-advices 0))
- (ad-dolist (advice-class ad-advice-classes)
+ (dolist (advice-class ad-advice-classes)
(if (or (eq class 'any) (eq advice-class class))
- (ad-dolist (advice (ad-get-advice-info-field
- function advice-class))
+ (dolist (advice (ad-get-advice-info-field
+ function advice-class))
(cond ((or (and (stringp name)
(string-match
name (symbol-name (ad-advice-name advice))))
For that it has to be fbound with a non-autoload definition."
(and (symbolp function)
(fboundp function)
- (not (eq (car-safe (symbol-function function)) 'autoload))))
+ (not (autoloadp (symbol-function function)))))
;; The following two are necessary for the sake of packages such as
;; ange-ftp which redefine functions via fcell indirection:
(byte-compile symbol)
(fset function (symbol-function symbol))))))
-(defun ad-prognify (forms)
- (cond ((<= (length forms) 1)
- (car forms))
- (t (cons 'progn forms))))
-
;; @@@ Accessing argument lists:
;; =============================
(if origdoc (setq paragraphs (list origdoc)))
(unless (eq style 'plain)
(push (concat "This " origtype " is advised.") paragraphs))
- (ad-dolist (class ad-advice-classes)
- (ad-dolist (advice (ad-get-enabled-advices function class))
+ (dolist (class ad-advice-classes)
+ (dolist (advice (ad-get-enabled-advices function class))
(setq advice-docstring
(ad-make-single-advice-docstring advice class style))
(if advice-docstring
(defun ad-advised-arglist (function)
"Find first defined arglist in FUNCTION's redefining advices."
- (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+ (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
(ad-get-enabled-advices function 'around)
(ad-get-enabled-advices function 'after)))
(let ((arglist (ad-arglist (ad-advice-definition advice))))
(if arglist
;; We found the first one, use it:
- (ad-do-return arglist)))))
+ (cl-return arglist)))))
(defun ad-advised-interactive-form (function)
"Find first interactive form in FUNCTION's redefining advices."
- (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+ (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
(ad-get-enabled-advices function 'around)
(ad-get-enabled-advices function 'after)))
(let ((interactive-form
(ad-interactive-form (ad-advice-definition advice))))
(if interactive-form
;; We found the first one, use it:
- (ad-do-return interactive-form)))))
+ (cl-return interactive-form)))))
;; @@@ Putting it all together:
;; ============================
should be modified. The assembled function will be returned."
(let (before-forms around-form around-form-protected after-forms definition)
- (ad-dolist (advice befores)
- (cond ((and (ad-advice-protected advice)
- before-forms)
- (setq before-forms
- `((unwind-protect
- ,(ad-prognify before-forms)
- ,@(ad-body-forms
- (ad-advice-definition advice))))))
- (t (setq before-forms
- (append before-forms
- (ad-body-forms (ad-advice-definition advice)))))))
+ (dolist (advice befores)
+ (cond ((and (ad-advice-protected advice)
+ before-forms)
+ (setq before-forms
+ `((unwind-protect
+ ,(macroexp-progn before-forms)
+ ,@(ad-body-forms
+ (ad-advice-definition advice))))))
+ (t (setq before-forms
+ (append before-forms
+ (ad-body-forms (ad-advice-definition advice)))))))
(setq around-form `(setq ad-return-value ,orig))
- (ad-dolist (advice (reverse arounds))
- ;; If any of the around advices is protected then we
- ;; protect the complete around advice onion:
- (if (ad-advice-protected advice)
- (setq around-form-protected t))
- (setq around-form
- (ad-substitute-tree
- (function (lambda (form) (eq form 'ad-do-it)))
- (function (lambda (form) around-form))
- (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
+ (dolist (advice (reverse arounds))
+ ;; If any of the around advices is protected then we
+ ;; protect the complete around advice onion:
+ (if (ad-advice-protected advice)
+ (setq around-form-protected t))
+ (setq around-form
+ (ad-substitute-tree
+ (function (lambda (form) (eq form 'ad-do-it)))
+ (function (lambda (form) around-form))
+ (macroexp-progn (ad-body-forms (ad-advice-definition advice))))))
(setq after-forms
(if (and around-form-protected before-forms)
`((unwind-protect
- ,(ad-prognify before-forms)
+ ,(macroexp-progn before-forms)
,around-form))
(append before-forms (list around-form))))
- (ad-dolist (advice afters)
- (cond ((and (ad-advice-protected advice)
- after-forms)
- (setq after-forms
- `((unwind-protect
- ,(ad-prognify after-forms)
- ,@(ad-body-forms
- (ad-advice-definition advice))))))
- (t (setq after-forms
- (append after-forms
- (ad-body-forms (ad-advice-definition advice)))))))
+ (dolist (advice afters)
+ (cond ((and (ad-advice-protected advice)
+ after-forms)
+ (setq after-forms
+ `((unwind-protect
+ ,(macroexp-progn after-forms)
+ ,@(ad-body-forms
+ (ad-advice-definition advice))))))
+ (t (setq after-forms
+ (append after-forms
+ (ad-body-forms (ad-advice-definition advice)))))))
(setq definition
`(,@(if (memq type '(macro special-form)) '(macro))
(ad-body-forms (ad-advice-definition advice))))
(ad-get-enabled-advices function hook-name))))
(if hook-forms
- (ad-prognify (apply 'append hook-forms)))))
+ (macroexp-progn (apply 'append hook-forms)))))
;; @@ Caching:
(nth 2 cache-id)))))
(defun ad-verify-cache-class-id (cache-class-id advices)
- (ad-dolist (advice advices (null cache-class-id))
+ (cl-dolist (advice advices (null cache-class-id))
(if (ad-advice-enabled advice)
(if (eq (car cache-class-id) (ad-advice-name advice))
(setq cache-class-id (cdr cache-class-id))
- (ad-do-return nil)))))
+ (cl-return nil)))))
;; There should be a way to monitor if and why a cache verification failed
;; in order to determine whether a certain preactivation could be used or
usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)"
- (declare (doc-string 3))
+ (declare (doc-string 3)
+ (debug (&define name ;; thing being advised.
+ (name ;; class is [&or "before" "around" "after"
+ ;; "activation" "deactivation"]
+ name ;; name of advice
+ &rest sexp ;; optional position and flags
+ )
+ [&optional stringp]
+ [&optional ("interactive" interactive)]
+ def-body)))
(if (not (ad-name-p function))
(error "defadvice: Invalid function name: %s" function))
(let* ((class (car args))
-;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-coding: utf-8;-*-
+;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-coding: utf-8 -*-
;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
("Torbjörn Einarsson" "Torbj.*rn Einarsson")
("Toru Tomabechi" "Toru Tomabechi,")
("Tsugutomo Enami" "enami tsugutomo")
+ ("Ulrich Müller" "Ulrich Mueller")
("Vincent Del Vecchio" "Vince Del Vecchio")
("William M. Perry" "Bill Perry")
("Wlodzimierz Bzyl" "W.*dek Bzyl")
("Lawrence R. Dodd" :cowrote "dired-x.el")
;; No longer distributed.
;;; ("Viktor Dukhovni" :wrote "unexsunos4.c")
- ("Paul Eggert" :wrote "rcs2log" "vcdiff")
+ ("Paul Eggert" :wrote "rcs2log") ; "vcdiff"
("Fred Fish" :changed "unexcoff.c")
;; No longer distributed.
;;; ("Tim Fleehart" :wrote "makefile.nt")
;; No longer distributed.
;;; ("Ishikawa Chiaki" :changed "aviion.h" "dgux.h")
;; ymakefile no longer distributed.
- ("Michael K. Johnson" :changed "configure.in" "emacs.c" "intel386.h"
+ ("Michael K. Johnson" :changed "configure.ac" "emacs.c" "intel386.h"
"mem-limits.h" "process.c" "template.h" "sysdep.c" "syssignal.h"
"systty.h" "unexcoff.c" "linux.h")
;; No longer distributed.
("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")
("config.h.dist" . "config.in")
("config.h-dist" . "config.in")
("config.h.in" . "config.in")
the file name. Only uses the LOG-FILE position POS and associated AUTHOR
to print a message if FILE is not found."
;; FILE should be re-checked in every different directory associated
- ;; with a LOG-FILE. Eg configure.in from src/ChangeLog is not the
+ ;; with a LOG-FILE. Eg configure.ac from src/ChangeLog is not the
;; same as that from top-level/ChangeLog.
(let* ((fullname (expand-file-name file (file-name-directory log-file)))
(entry (assoc fullname authors-checked-files-alist))
(enable-local-eval nil)
(existing-buffer (get-file-buffer log-file))
(buffer (find-file-noselect log-file))
- authors file pos)
+ authors pos)
(with-current-buffer buffer
(save-restriction
(widen)
(file (car change))
(filestat (if (authors-public-domain-p file)
(concat file " (public domain)")
- file))
- slot)
+ file)))
(cond ((assq :wrote actions)
(setq wrote-list (cons filestat wrote-list)))
((assq :cowrote actions)
-;; autoload.el --- maintain autoloads in loaddefs.el
+;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
;; Copyright (C) 1991-1997, 2001-2012 Free Software Foundation, Inc.
(require 'lisp-mode) ;for `doc-string-elt' properties.
(require 'help-fns) ;for help-add-fundoc-usage.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar generated-autoload-file nil
"File into which to write autoload definitions.
(defvar autoload-modified-buffers) ;Dynamically scoped var.
-(defun make-autoload (form file)
+(defun make-autoload (form file &optional expansion)
"Turn FORM into an autoload or defvar for source file FILE.
Returns nil if FORM is not a special autoload form (i.e. a function definition
-or macro definition or a defcustom)."
+or macro definition or a defcustom).
+If EXPANSION is non-nil, we're processing the macro expansion of an
+expression, in which case we want to handle forms differently."
(let ((car (car-safe form)) expand)
(cond
+ ((and expansion (eq car 'defalias))
+ (pcase-let*
+ ((`(,_ ,_ ,arg . ,rest) form)
+ ;; `type' is non-nil if it defines a macro.
+ ;; `fun' is the function part of `arg' (defaults to `arg').
+ ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
+ (and (let fun arg) (let type nil)))
+ arg)
+ ;; `lam' is the lambda expression in `fun' (or nil if not
+ ;; recognized).
+ (lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
+ ;; `args' is the list of arguments (or t if not recognized).
+ ;; `body' is the body of `lam' (or t if not recognized).
+ ((or `(lambda ,args . ,body)
+ (and (let args t) (let body t)))
+ lam)
+ ;; Get the `doc' from `body' or `rest'.
+ (doc (cond ((stringp (car-safe body)) (car body))
+ ((stringp (car-safe rest)) (car rest))))
+ ;; Look for an interactive spec.
+ (interactive (pcase body
+ ((or `((interactive . ,_) . ,_)
+ `(,_ (interactive . ,_) . ,_)) t))))
+ ;; Add the usage form at the end where describe-function-1
+ ;; can recover it.
+ (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
+ ;; (message "autoload of %S" (nth 1 form))
+ `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
+
+ ((and expansion (memq car '(progn prog1)))
+ (let ((end (memq :autoload-end form)))
+ (when end ;Cut-off anything after the :autoload-end marker.
+ (setq form (copy-sequence form))
+ (setcdr (memq :autoload-end form) nil))
+ (let ((exps (delq nil (mapcar (lambda (form)
+ (make-autoload form file expansion))
+ (cdr form)))))
+ (when exps (cons 'progn exps)))))
+
;; For complex cases, try again on the macro-expansion.
((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
- define-globalized-minor-mode
+ define-globalized-minor-mode defun defmacro
+ ;; FIXME: we'd want `defmacro*' here as well, so as
+ ;; to handle its `declare', but when autoload is run
+ ;; CL is not loaded so macroexpand doesn't know how
+ ;; to expand it!
easy-mmode-define-minor-mode define-minor-mode))
(setq expand (let ((load-file-name file)) (macroexpand form)))
- (eq (car expand) 'progn)
- (memq :autoload-end expand))
- (let ((end (memq :autoload-end expand)))
- ;; Cut-off anything after the :autoload-end marker.
- (setcdr end nil)
- (cons 'progn
- (mapcar (lambda (form) (make-autoload form file))
- (cdr expand)))))
+ (memq (car expand) '(progn prog1 defalias)))
+ (make-autoload expand file 'expansion)) ;Recurse on the expansion.
;; For special function-like operators, use the `autoload' function.
- ((memq car '(defun define-skeleton defmacro define-derived-mode
+ ((memq car '(define-skeleton define-derived-mode
define-compilation-mode define-generic-mode
easy-mmode-define-global-mode define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode define-minor-mode
- defun* defmacro* define-overloadable-function))
+ cl-defun defun* cl-defmacro defmacro*
+ define-overloadable-function))
(let* ((macrop (memq car '(defmacro defmacro*)))
(name (nth 1 form))
- (args (case car
- ((defun defmacro defun* defmacro*
- define-overloadable-function) (nth 2 form))
- ((define-skeleton) '(&optional str arg))
- ((define-generic-mode define-derived-mode
- define-compilation-mode) nil)
- (t)))
- (body (nthcdr (get car 'doc-string-elt) form))
+ (args (pcase car
+ ((or `defun `defmacro
+ `defun* `defmacro* `cl-defun `cl-defmacro
+ `define-overloadable-function) (nth 2 form))
+ (`define-skeleton '(&optional str arg))
+ ((or `define-generic-mode `define-derived-mode
+ `define-compilation-mode) nil)
+ (_ t)))
+ (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
(doc (if (stringp (car body)) (pop body))))
- (when (listp args)
- ;; Add the usage form at the end where describe-function-1
- ;; can recover it.
- (setq doc (help-add-fundoc-usage doc args)))
- (let ((exp
- ;; `define-generic-mode' quotes the name, so take care of that
- (list 'autoload (if (listp name) name (list 'quote name))
- file doc
- (or (and (memq car '(define-skeleton define-derived-mode
- define-generic-mode
- easy-mmode-define-global-mode
- define-global-minor-mode
- define-globalized-minor-mode
- easy-mmode-define-minor-mode
- define-minor-mode)) t)
- (eq (car-safe (car body)) 'interactive))
- (if macrop (list 'quote 'macro) nil))))
- (when macrop
- ;; Special case to autoload some of the macro's declarations.
- (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form))
- (exps '()))
- (when (eq (car-safe decls) 'declare)
- ;; FIXME: We'd like to reuse macro-declaration-function,
- ;; but we can't since it doesn't return anything.
- (dolist (decl decls)
- (case (car-safe decl)
- (indent
- (push `(put ',name 'lisp-indent-function ',(cadr decl))
- exps))
- (doc-string
- (push `(put ',name 'doc-string-elt ',(cadr decl)) exps))))
- (when exps
- (setq exp `(progn ,exp ,@exps))))))
- exp)))
+ ;; Add the usage form at the end where describe-function-1
+ ;; can recover it.
+ (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
+ ;; `define-generic-mode' quotes the name, so take care of that
+ `(autoload ,(if (listp name) name (list 'quote name))
+ ,file ,doc
+ ,(or (and (memq car '(define-skeleton define-derived-mode
+ define-generic-mode
+ easy-mmode-define-global-mode
+ define-global-minor-mode
+ define-globalized-minor-mode
+ easy-mmode-define-minor-mode
+ define-minor-mode)) t)
+ (eq (car-safe (car body)) 'interactive))
+ ,(if macrop ''macro nil))))
;; For defclass forms, use `eieio-defclass-autoload'.
((eq car 'defclass)
(if (member ',file loads) nil
(put ',groupname 'custom-loads (cons ',file loads))))))
+ ;; When processing a macro expansion, any expression
+ ;; before a :autoload-end should be included. These are typically (put
+ ;; 'fun 'prop val) and things like that.
+ ((and expansion (consp form)) form)
+
;; nil here indicates that this is not a special autoload form.
(t nil))))
;; Symbols at the toplevel are meaningless.
((symbolp form) nil)
(t
- (let ((doc-string-elt (get (car-safe form) 'doc-string-elt))
+ (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
(outbuf autoload-print-form-outbuf))
(if (and doc-string-elt (stringp (nth doc-string-elt form)))
;; We need to hack the printing because the
"Insert the section-header line,
which lists the file name and which functions are in it, etc."
(insert generate-autoload-section-header)
- (prin1 (list 'autoloads autoloads load-name file time)
+ (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
outbuf)
(terpri outbuf)
;; Break that line at spaces, to avoid very long lines.
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(if (eolp)
- (condition-case err
+ (condition-case-unless-debug err
;; Read the next form and make an autoload.
(let* ((form (prog1 (read (current-buffer))
(or (bolp) (forward-line 1))))
(save-excursion
;; Insert the section-header line which lists the file name
;; and which functions are in it, etc.
- (assert (= ostart output-start))
+ (cl-assert (= ostart output-start))
(goto-char output-start)
(let ((relfile (file-relative-name absfile)))
(autoload-insert-section-header
write its autoloads into the specified file instead."
(interactive "DUpdate autoloads from directory: ")
(let* ((files-re (let ((tmp nil))
- (dolist (suf (get-load-suffixes)
- (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
- (unless (string-match "\\.elc" suf) (push suf tmp)))))
+ (dolist (suf (get-load-suffixes))
+ (unless (string-match "\\.elc" suf) (push suf tmp)))
+ (concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
(files (apply 'nconc
(mapcar (lambda (dir)
(directory-files (expand-file-name dir)
(define-obsolete-function-alias 'update-autoloads-from-directories
'update-directory-autoloads "22.1")
-(defvar autoload-make-program (or (getenv "MAKE") "make")
- "Name of the make program in use during the Emacs build process.")
-
;;;###autoload
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
(opp (avl-tree--switch-dir dir))
;; direction 0,1 -> sign factor -1,+1
(sgn (avl-tree--dir-to-sign dir))
- p1 p2 b2 result)
+ p1 p2 b2)
(cond
((< (* sgn (avl-tree--node-balance br)) 0)
(setf (avl-tree--node-balance br) 0)
Return a list of the total elapsed time for execution, the number of
garbage collections that ran, and the time taken by garbage collection.
See also `benchmark-run-compiled'."
+ (declare (indent 1) (debug t))
(unless (natnump repetitions)
(setq forms (cons repetitions forms)
repetitions 1))
`(benchmark-elapse ,@forms))
(- gcs-done ,gcs)
(- gc-elapsed ,gc)))))
-(put 'benchmark-run 'edebug-form-spec t)
-(put 'benchmark-run 'lisp-indent-function 2)
;;;###autoload
(defmacro benchmark-run-compiled (&optional repetitions &rest forms)
This is like `benchmark-run', but what is timed is a funcall of the
byte code obtained by wrapping FORMS in a `lambda' and compiling the
result. The overhead of the `lambda's is accounted for."
+ (declare (indent 1) (debug t))
(unless (natnump repetitions)
(setq forms (cons repetitions forms)
repetitions 1))
(funcall ,lambda-code))))
`(benchmark-elapse (funcall ,code)))
(- gcs-done ,gcs) (- gc-elapsed ,gc)))))
-(put 'benchmark-run-compiled 'edebug-form-spec t)
-(put 'benchmark-run-compiled 'lisp-indent-function 2)
;;;###autoload
(defun benchmark (repetitions form)
;;; Code:
(require 'bytecomp)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+(require 'macroexp)
(defun byte-compile-log-lap-1 (format &rest args)
;; Newer byte codes for stack-ref make the slot 0 non-nil again.
(let* ((name (car form))
(localfn (cdr (assq name byte-compile-function-environment)))
(fn (or localfn (and (fboundp name) (symbol-function name)))))
- (when (and (consp fn) (eq (car fn) 'autoload))
- (load (nth 1 fn))
+ (when (autoloadp fn)
+ (autoload-do-load fn)
(setq fn (or (and (fboundp name) (symbol-function name))
(cdr (assq name byte-compile-function-environment)))))
(pcase fn
;; (message "Inlining byte-code for %S!" name)
;; The byte-code will be really inlined in byte-compile-unfold-bcf.
`(,fn ,@(cdr form)))
- ((or (and `(lambda ,args . ,body) (let env nil))
- `(closure ,env ,args . ,body))
+ ((or `(lambda . ,_) `(closure . ,_))
(if (not (or (eq fn localfn) ;From the same file => same mode.
- (eq (not lexical-binding) (not env)))) ;Same mode.
+ (eq (car fn) ;Same mode.
+ (if lexical-binding 'closure 'lambda))))
;; While byte-compile-unfold-bcf can inline dynbind byte-code into
;; letbind byte-code (or any other combination for that matter), we
;; can only inline dynbind source into dynbind source or letbind
;; source into letbind source.
- ;; FIXME: we could of course byte-compile the inlined function
- ;; first, and then inline its byte-code.
- form
- (let ((renv ()))
- ;; Turn the function's closed vars (if any) into local let bindings.
- (dolist (binding env)
- (cond
- ((consp binding)
- ;; We check shadowing by the args, so that the `let' can be
- ;; moved within the lambda, which can then be unfolded.
- ;; FIXME: Some of those bindings might be unused in `body'.
- (unless (memq (car binding) args) ;Shadowed.
- (push `(,(car binding) ',(cdr binding)) renv)))
- ((eq binding t))
- (t (push `(defvar ,binding) body))))
- (let ((newfn (byte-compile-preprocess
- (if (null renv)
- `(lambda ,args ,@body)
- `(lambda ,args (let ,(nreverse renv) ,@body))))))
- (if (eq (car-safe newfn) 'function)
- (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
- (byte-compile-log-warning
- (format "Inlining closure %S failed" name))
- form)))))
+ (progn
+ ;; We can of course byte-compile the inlined function
+ ;; first, and then inline its byte-code.
+ (byte-compile name)
+ `(,(symbol-function name) ,@(cdr form)))
+ (let ((newfn (if (eq fn localfn)
+ ;; If `fn' is from the same file, it has already
+ ;; been preprocessed!
+ `(function ,fn)
+ (byte-compile-preprocess
+ (byte-compile--reify-function fn)))))
+ (if (eq (car-safe newfn) 'function)
+ (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
+ (byte-compile-log-warning
+ (format "Inlining closure %S failed" name))
+ form))))
(t ;; Give up on inlining.
form))))
clause))
(cdr form))))
((eq fn 'progn)
- ;; as an extra added bonus, this simplifies (progn <x>) --> <x>
+ ;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
(if (cdr (cdr form))
- (progn
- (setq tmp (byte-optimize-body (cdr form) for-effect))
- (if (cdr tmp) (cons 'progn tmp) (car tmp)))
+ (macroexp-progn (byte-optimize-body (cdr form) for-effect))
(byte-optimize-form (nth 1 form) for-effect)))
((eq fn 'prog1)
(if (cdr (cdr form))
(prin1-to-string form))
nil)
- ((memq fn '(defun defmacro function condition-case))
+ ((memq fn '(function condition-case))
;; These forms are compiled as constants or by breaking out
;; all the subexpressions and compiling them separately.
form)
(cons fn args)))))))
(defun byte-optimize-all-constp (list)
- "Non-nil if all elements of LIST satisfy `byte-compile-constp'."
+ "Non-nil if all elements of LIST satisfy `macroexp-const-p"
(let ((constant t))
(while (and list constant)
- (unless (byte-compile-constp (car list))
+ (unless (macroexp-const-p (car list))
(setq constant nil))
(setq list (cdr list)))
constant))
(let (opt new)
(if (and (consp form)
(symbolp (car form))
- (or (and for-effect
- ;; we don't have any of these yet, but we might.
- (setq opt (get (car form) 'byte-for-effect-optimizer)))
- (setq opt (get (car form) 'byte-optimizer)))
+ (or ;; (and for-effect
+ ;; ;; We don't have any of these yet, but we might.
+ ;; (setq opt (get (car form)
+ ;; 'byte-for-effect-optimizer)))
+ (setq opt (function-get (car form) 'byte-optimizer)))
(not (eq form (setq new (funcall opt form)))))
(progn
;; (if (equal form new) (error "bogus optimizer -- %s" opt))
(while (eq (car-safe form) 'progn)
(setq form (car (last (cdr form)))))
(cond ((consp form)
- (case (car form)
- (quote (cadr form))
+ (pcase (car form)
+ (`quote (cadr form))
;; Can't use recursion in a defsubst.
- ;; (progn (byte-compile-trueconstp (car (last (cdr form)))))
+ ;; (`progn (byte-compile-trueconstp (car (last (cdr form)))))
))
((not (symbolp form)))
((eq form t))
(while (eq (car-safe form) 'progn)
(setq form (car (last (cdr form)))))
(cond ((consp form)
- (case (car form)
- (quote (null (cadr form)))
+ (pcase (car form)
+ (`quote (null (cadr form)))
;; Can't use recursion in a defsubst.
- ;; (progn (byte-compile-nilconstp (car (last (cdr form)))))
+ ;; (`progn (byte-compile-nilconstp (car (last (cdr form)))))
))
((not (symbolp form)) nil)
((null form))))
(defun byte-optimize-binary-predicate (form)
- (if (byte-compile-constp (nth 1 form))
- (if (byte-compile-constp (nth 2 form))
+ (if (macroexp-const-p (nth 1 form))
+ (if (macroexp-const-p (nth 2 form))
(condition-case ()
(list 'quote (eval form))
(error form))
(let ((ok t)
(rest (cdr form)))
(while (and rest ok)
- (setq ok (byte-compile-constp (car rest))
+ (setq ok (macroexp-const-p (car rest))
rest (cdr rest)))
(if ok
(condition-case ()
(defun byte-optimize-quote (form)
(if (or (consp (nth 1 form))
(and (symbolp (nth 1 form))
- (not (byte-compile-const-symbol-p form))))
+ (not (macroexp--const-symbol-p form))))
form
(nth 1 form)))
;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
;; string-make-multibyte for constant args.
-(put 'featurep 'byte-optimizer 'byte-optimize-featurep)
-(defun byte-optimize-featurep (form)
- ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we
- ;; can safely optimize away this test.
- (if (member (cdr-safe form) '(((quote xemacs)) ((quote sxemacs))))
- nil
- (if (member (cdr-safe form) '(((quote emacs))))
- t
- form)))
-
(put 'set 'byte-optimizer 'byte-optimize-set)
(defun byte-optimize-set (form)
(let ((var (car-safe (cdr-safe form))))
string-to-multibyte
tan truncate
unibyte-char-to-multibyte upcase user-full-name
- user-login-name user-original-login-name user-variable-p
+ user-login-name user-original-login-name custom-variable-p
vconcat
window-buffer window-dedicated-p window-edges window-height
window-hscroll window-minibuffer-p window-width
;; This uses dynamic-scope magic.
offset (disassemble-offset bytes))
(let ((opcode (aref byte-code-vector bytedecomp-op)))
- (assert opcode)
+ (cl-assert opcode)
(setq bytedecomp-op opcode))
(cond ((memq bytedecomp-op byte-goto-ops)
;; It's a pc.
(not (eq (car lap0) 'byte-constant)))
nil
(setq keep-going t)
- (if (memq (car lap0) '(byte-constant byte-dup))
- (progn
- (setq tmp (if (or (not tmp)
- (byte-compile-const-symbol-p
- (car (cdr lap0))))
- (cdr lap0)
- (byte-compile-get-constant t)))
+ (if (memq (car lap0) '(byte-constant byte-dup))
+ (progn
+ (setq tmp (if (or (not tmp)
+ (macroexp--const-symbol-p
+ (car (cdr lap0))))
+ (cdr lap0)
+ (byte-compile-get-constant t)))
(byte-compile-log-lap " %s %s %s\t-->\t%s %s %s"
lap0 lap1 lap2 lap0 lap1
(cons (car lap0) tmp))
(byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1)
(setq keep-going t
rest (cdr rest))
- (if (eq 'byte-stack-set (car lap1)) (decf (cdr lap1)))
+ (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1)))
(setq lap (delq lap0 (delq lap2 lap))))
;;
;; not goto-X-if-nil --> goto-X-if-non-nil
-;;; byte-run.el --- byte-compiler support for inlining
+;;; byte-run.el --- byte-compiler support for inlining -*- lexical-binding: t -*-
;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;;; Code:
-;; We define macro-declaration-function here because it is needed to
-;; handle declarations in macro definitions and this is the first file
-;; loaded by loadup.el that uses declarations in macros.
+;; `macro-declaration-function' are both obsolete (as marked at the end of this
+;; file) but used in many .elc files.
+
+(defvar macro-declaration-function #'macro-declaration-function
+ "Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used.")
-(defun macro-declaration-function (macro decl)
- "Process a declaration found in a macro definition.
+(defalias 'macro-declaration-function
+ #'(lambda (macro decl)
+ "Process a declaration found in a macro definition.
This is set as the value of the variable `macro-declaration-function'.
MACRO is the name of the macro being defined.
DECL is a list `(declare ...)' containing the declarations.
The return value of this function is not used."
- ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
- (let (d)
- ;; Ignore the first element of `decl' (it's always `declare').
- (while (setq decl (cdr decl))
- (setq d (car decl))
- (if (and (consp d)
- (listp (cdr d))
- (null (cdr (cdr d))))
- (cond ((eq (car d) 'indent)
- (put macro 'lisp-indent-function (car (cdr d))))
- ((eq (car d) 'debug)
- (put macro 'edebug-form-spec (car (cdr d))))
- ((eq (car d) 'doc-string)
- (put macro 'doc-string-elt (car (cdr d))))
- (t
- (message "Unknown declaration %s" d)))
- (message "Invalid declaration %s" d)))))
-
-
-(setq macro-declaration-function 'macro-declaration-function)
+ ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
+ (let (d)
+ ;; Ignore the first element of `decl' (it's always `declare').
+ (while (setq decl (cdr decl))
+ (setq d (car decl))
+ (if (and (consp d)
+ (listp (cdr d))
+ (null (cdr (cdr d))))
+ (cond ((eq (car d) 'indent)
+ (put macro 'lisp-indent-function (car (cdr d))))
+ ((eq (car d) 'debug)
+ (put macro 'edebug-form-spec (car (cdr d))))
+ ((eq (car d) 'doc-string)
+ (put macro 'doc-string-elt (car (cdr d))))
+ (t
+ (message "Unknown declaration %s" d)))
+ (message "Invalid declaration %s" d))))))
+
+;; We define macro-declaration-alist here because it is needed to
+;; handle declarations in macro definitions and this is the first file
+;; loaded by loadup.el that uses declarations in macros.
+(defvar defun-declarations-alist
+ (list
+ ;; We can only use backquotes inside the lambdas and not for those
+ ;; properties that are used by functions loaded before backquote.el.
+ (list 'advertised-calling-convention
+ #'(lambda (f _args arglist when)
+ (list 'set-advertised-calling-convention
+ (list 'quote f) (list 'quote arglist) (list 'quote when))))
+ (list 'obsolete
+ #'(lambda (f _args new-name when)
+ `(make-obsolete ',f ',new-name ,when)))
+ (list 'compiler-macro
+ #'(lambda (f _args compiler-function)
+ `(put ',f 'compiler-macro #',compiler-function)))
+ (list 'doc-string
+ #'(lambda (f _args pos)
+ (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos))))
+ (list 'indent
+ #'(lambda (f _args val)
+ (list 'put (list 'quote f)
+ ''lisp-indent-function (list 'quote val)))))
+ "List associating function properties to their macro expansion.
+Each element of the list takes the form (PROP FUN) where FUN is
+a function. For each (PROP . VALUES) in a function's declaration,
+the FUN corresponding to PROP is called with the function name,
+the function's arglist, and the VALUES and should return the code to use
+to set this property.")
+
+(defvar macro-declarations-alist
+ (cons
+ (list 'debug
+ #'(lambda (name _args spec)
+ (list 'progn :autoload-end
+ (list 'put (list 'quote name)
+ ''edebug-form-spec (list 'quote spec)))))
+ defun-declarations-alist)
+ "List associating properties of macros to their macro expansion.
+Each element of the list takes the form (PROP FUN) where FUN is
+a function. For each (PROP . VALUES) in a macro's declaration,
+the FUN corresponding to PROP is called with the function name
+and the VALUES and should return the code to use to set this property.")
+
+(put 'defmacro 'doc-string-elt 3)
+(defalias 'defmacro
+ (cons
+ 'macro
+ #'(lambda (name arglist &optional docstring decl &rest body)
+ "Define NAME as a macro.
+When the macro is called, as in (NAME ARGS...),
+the function (lambda ARGLIST BODY...) is applied to
+the list ARGS... as it appears in the expression,
+and the result should be a form to be evaluated instead of the original.
+DECL is a declaration, optional, of the form (declare DECLS...) where
+DECLS is a list of elements of the form (PROP . VALUES). These are
+interpreted according to `macro-declarations-alist'.
+The return value is undefined."
+ (if (stringp docstring) nil
+ (if decl (setq body (cons decl body)))
+ (setq decl docstring)
+ (setq docstring nil))
+ (if (or (null decl) (eq 'declare (car-safe decl))) nil
+ (setq body (cons decl body))
+ (setq decl nil))
+ (if (null body) (setq body '(nil)))
+ (if docstring (setq body (cons docstring body)))
+ ;; Can't use backquote because it's not defined yet!
+ (let* ((fun (list 'function (cons 'lambda (cons arglist body))))
+ (def (list 'defalias
+ (list 'quote name)
+ (list 'cons ''macro fun)))
+ (declarations
+ (mapcar
+ #'(lambda (x)
+ (let ((f (cdr (assq (car x) macro-declarations-alist))))
+ (if f (apply (car f) name arglist (cdr x))
+ (message "Warning: Unknown macro property %S in %S"
+ (car x) name))))
+ (cdr decl))))
+ (if declarations
+ (cons 'prog1 (cons def declarations))
+ def)))))
+
+;; Now that we defined defmacro we can use it!
+(defmacro defun (name arglist &optional docstring &rest body)
+ "Define NAME as a function.
+The definition is (lambda ARGLIST [DOCSTRING] BODY...).
+See also the function `interactive'.
+DECL is a declaration, optional, of the form (declare DECLS...) where
+DECLS is a list of elements of the form (PROP . VALUES). These are
+interpreted according to `defun-declarations-alist'.
+The return value is undefined.
+
+\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
+ ;; We can't just have `decl' as an &optional argument, because we need
+ ;; to distinguish
+ ;; (defun foo (arg) (toto) nil)
+ ;; from
+ ;; (defun foo (arg) (toto)).
+ (declare (doc-string 3))
+ (let ((decls (cond
+ ((eq (car-safe docstring) 'declare)
+ (prog1 (cdr docstring) (setq docstring nil)))
+ ((eq (car-safe (car body)) 'declare)
+ (prog1 (cdr (car body)) (setq body (cdr body)))))))
+ (if docstring (setq body (cons docstring body))
+ (if (null body) (setq body '(nil))))
+ (let ((declarations
+ (mapcar
+ #'(lambda (x)
+ (let ((f (cdr (assq (car x) defun-declarations-alist))))
+ (cond
+ (f (apply (car f) name arglist (cdr x)))
+ ;; Yuck!!
+ ((and (featurep 'cl)
+ (memq (car x) ;C.f. cl-do-proclaim.
+ '(special inline notinline optimize warn)))
+ (push (list 'declare x)
+ (if (stringp docstring) (cdr body) body))
+ nil)
+ (t (message "Warning: Unknown defun property `%S' in %S"
+ (car x) name)))))
+ decls))
+ (def (list 'defalias
+ (list 'quote name)
+ (list 'function
+ (cons 'lambda
+ (cons arglist body))))))
+ (if declarations
+ (cons 'prog1 (cons def declarations))
+ def))))
\f
;; Redefined in byte-optimize.el.
;; This is not documented--it's not clear that we should promote it.
;; (list 'put x ''byte-optimizer nil)))
;; fns)))
-;; This has a special byte-hunk-handler in bytecomp.el.
(defmacro defsubst (name arglist &rest body)
"Define an inline function. The syntax is just like that of `defun'."
- (declare (debug defun))
+ (declare (debug defun) (doc-string 3))
(or (memq (get name 'byte-optimizer)
'(nil byte-compile-inline-expand))
(error "`%s' is a primitive" name))
(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
-(defun set-advertised-calling-convention (function signature when)
+(defun set-advertised-calling-convention (function signature _when)
"Set the advertised SIGNATURE of FUNCTION.
This will allow the byte-compiler to warn the programmer when she uses
an obsolete calling convention. WHEN specifies since when the calling
advertised-signature-table))
(defun make-obsolete (obsolete-name current-name &optional when)
- "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
+ "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
+OBSOLETE-NAME should be a function name or macro name (a symbol).
+
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message
\(it should end with a period, and not start with a capital).
WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
+ (declare (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when) "23.1"))
(interactive "aMake function obsolete: \nxObsoletion replacement: ")
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
(purecopy (list current-name nil when)))
obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete '(obsolete-name current-name when) "23.1")
(defmacro define-obsolete-function-alias (obsolete-name current-name
&optional when docstring)
\(make-obsolete 'old-fun 'new-fun \"22.1\")
See the docstrings of `defalias' and `make-obsolete' for more details."
- (declare (doc-string 4))
+ (declare (doc-string 4)
+ (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional docstring) "23.1"))
`(progn
(defalias ,obsolete-name ,current-name ,docstring)
(make-obsolete ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-function-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
was first made obsolete, for example a date or a release number.
ACCESS-TYPE if non-nil should specify the kind of access that will trigger
obsolescence warnings; it can be either `get' or `set'."
+ (declare (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional access-type) "23.1"))
(put obsolete-name 'byte-obsolete-variable
(purecopy (list current-name access-type when)))
obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete-variable
- '(obsolete-name current-name when &optional access-type) "23.1")
+
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)
See the Info node `(elisp)Variable Aliases' for more details.
If CURRENT-NAME is a defcustom (more generally, any variable
-where OBSOLETE-NAME may be set, e.g. in a .emacs file, before the
+where OBSOLETE-NAME may be set, e.g. in an init file, before the
alias is defined), then the define-obsolete-variable-alias
statement should be evaluated before the defcustom, if user
customizations are to be respected. The simplest way to achieve
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
'saved-value, 'saved-variable-comment."
- (declare (doc-string 4))
+ (declare (doc-string 4)
+ (advertised-calling-convention
+ ;; New code should always provide the `when' argument.
+ (obsolete-name current-name when &optional docstring) "23.1"))
`(progn
(defvaralias ,obsolete-name ,current-name ,docstring)
;; See Bug#4706.
(null (get ,current-name prop))
(put ,current-name prop (get ,obsolete-name prop))))
(make-obsolete-variable ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-variable-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
;; FIXME This is only defined in this file because the variable- and
;; function- versions are too. Unlike those two, this one is not used
;; (file-format emacs19))"
;; nil)
+(make-obsolete-variable 'macro-declaration-function
+ 'macro-declarations-alist "24.3")
+(make-obsolete 'macro-declaration-function
+ 'macro-declarations-alist "24.3")
+
;;; byte-run.el ends here
(require 'backquote)
(require 'macroexp)
(require 'cconv)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(or (fboundp 'defsubst)
;; This really ought to be loaded already!
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
insert-file insert-buffer insert-file-literally previous-line next-line
- goto-line comint-run delete-backward-char toggle-read-only)
+ goto-line comint-run delete-backward-char)
"List of commands that are not meant to be called from Lisp.")
(defvar byte-compile-not-obsolete-vars nil
(bytes-var (car (last args 2)))
(pc-var (car (last args))))
`(setq ,bytes-var ,(if (null (cdr byte-exprs))
- `(progn (assert (<= 0 ,(car byte-exprs)))
+ `(progn (cl-assert (<= 0 ,(car byte-exprs)))
(cons ,@byte-exprs ,bytes-var))
`(nconc (list ,@(reverse byte-exprs)) ,bytes-var))
,pc-var (+ ,(length byte-exprs) ,pc-var))))
(defvar byte-compile-last-warned-form nil)
(defvar byte-compile-last-logged-file nil)
+(defvar byte-compile-root-dir nil
+ "Directory relative to which file names in error messages are written.")
;; This is used as warning-prefix for the compiler.
;; It is always called with the warnings buffer current.
(defun byte-compile-warning-prefix (level entry)
(let* ((inhibit-read-only t)
- (dir default-directory)
+ (dir (or byte-compile-root-dir default-directory))
(file (cond ((stringp byte-compile-current-file)
(format "%s:" (file-relative-name
byte-compile-current-file dir)))
((bufferp byte-compile-current-file)
(format "Buffer %s:"
(buffer-name byte-compile-current-file)))
+ ;; We might be simply loading a file that
+ ;; contains explicit calls to byte-compile functions.
+ ((stringp load-file-name)
+ (format "%s:" (file-relative-name load-file-name dir)))
(t "")))
(pos (if (and byte-compile-current-file
(integerp byte-compile-read-position))
"Warn that SYMBOL (a variable or function) is obsolete."
(when (byte-compile-warning-enabled-p 'obsolete)
(let* ((funcp (get symbol 'byte-obsolete-info))
- (obsolete (or funcp (get symbol 'byte-obsolete-variable)))
- (instead (car obsolete))
- (asof (nth 2 obsolete)))
+ (msg (macroexp--obsolete-warning
+ symbol
+ (or funcp (get symbol 'byte-obsolete-variable))
+ (if funcp "function" "variable"))))
(unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
- (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
- (if funcp "function" "variable")
- (if asof (concat " (as of " asof ")") "")
- (cond ((stringp instead)
- (concat "; " instead))
- (instead
- (format "; use `%s' instead." instead))
- (t ".")))))))
+ (byte-compile-warn "%s" msg)))))
(defun byte-compile-report-error (error-info)
"Report Lisp error in compilation. ERROR-INFO is the error data."
(t fn)))))))
(defun byte-compile-arglist-signature (arglist)
- (if (integerp arglist)
- ;; New style byte-code arglist.
- (cons (logand arglist 127) ;Mandatory.
- (if (zerop (logand arglist 128)) ;No &rest.
- (lsh arglist -8))) ;Nonrest.
- ;; Old style byte-code, or interpreted function.
+ (cond
+ ;; New style byte-code arglist.
+ ((integerp arglist)
+ (cons (logand arglist 127) ;Mandatory.
+ (if (zerop (logand arglist 128)) ;No &rest.
+ (lsh arglist -8)))) ;Nonrest.
+ ;; Old style byte-code, or interpreted function.
+ ((listp arglist)
(let ((args 0)
opts
restp)
(setq opts (1+ opts))
(setq args (1+ args)))))
(setq arglist (cdr arglist)))
- (cons args (if restp nil (if opts (+ args opts) args))))))
+ (cons args (if restp nil (if opts (+ args opts) args)))))
+ ;; Unknown arglist.
+ (t '(0))))
(defun byte-compile-arglist-signatures-congruent-p (old new)
;; and/or remember its arity if it's unknown.
(or (and (or def (fboundp (car form))) ; might be a subr or autoload.
(not (memq (car form) byte-compile-noruntime-functions)))
- (eq (car form) byte-compile-current-form) ; ## this doesn't work
- ; with recursion.
+ (eq (car form) byte-compile-current-form) ; ## This doesn't work
+ ; with recursion.
;; It's a currently-undefined function.
;; Remember number of args in call.
(let ((cons (assq (car form) byte-compile-unresolved-functions))
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
-(defun byte-compile-arglist-warn (form macrop)
- (let* ((name (nth 1 form))
- (old (byte-compile-fdefinition name macrop))
+(defun byte-compile-arglist-warn (name arglist macrop)
+ (let* ((old (byte-compile-fdefinition name macrop))
(initial (and macrop
(cdr (assq name
byte-compile-initial-macro-environment)))))
(`(closure ,_ ,args . ,_) args)
((pred byte-code-function-p) (aref old 0))
(t '(&rest def)))))
- (sig2 (byte-compile-arglist-signature (nth 2 form))))
+ (sig2 (byte-compile-arglist-signature arglist)))
(unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
(byte-compile-set-symbol-position name)
(byte-compile-warn
"%s %s used to take %s %s, now takes %s"
- (if (eq (car form) 'defun) "function" "macro")
+ (if macrop "macro" "function")
name
(byte-compile-arglist-signature-string sig1)
(if (equal sig1 '(1 . 1)) "argument" "arguments")
nums sig min max)
(when calls
(when (and (symbolp name)
- (eq (get name 'byte-optimizer)
+ (eq (function-get name 'byte-optimizer)
'byte-compile-inline-expand))
(byte-compile-warn "defsubst `%s' was used before it was defined"
name))
- (setq sig (byte-compile-arglist-signature (nth 2 form))
+ (setq sig (byte-compile-arglist-signature arglist)
nums (sort (copy-sequence (cdr calls)) (function <))
min (car nums)
max (car (nreverse nums)))
;; These aren't all aliases of subrs, so not trivial to
;; avoid hardwiring the list.
(not (memq func
- '(cl-block-wrapper cl-block-throw
+ '(cl--block-wrapper cl--block-throw
multiple-value-call nth-value
copy-seq first second rest endp cl-member
;; These are included in generated code
;; that can't be called except at compile time
;; or unless cl is loaded anyway.
- cl-defsubst-expand cl-struct-setf-expander
+ cl--defsubst-expand cl-struct-setf-expander
;; These would sometimes be warned about
;; but such warnings are never useful,
;; so don't warn about them.
macroexpand cl-macroexpand-all
- cl-compiling-file))))
+ cl--compiling-file))))
(byte-compile-warn "function `%s' from cl package called at runtime"
func)))
form)
nil)
\f
-(defsubst byte-compile-const-symbol-p (symbol &optional any-value)
- "Non-nil if SYMBOL is constant.
-If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
-symbol itself."
- (or (memq symbol '(nil t))
- (keywordp symbol)
- (if any-value
- (or (memq symbol byte-compile-const-variables)
- ;; FIXME: We should provide a less intrusive way to find out
- ;; if a variable is "constant".
- (and (boundp symbol)
- (condition-case nil
- (progn (set symbol (symbol-value symbol)) nil)
- (setting-constant t)))))))
-
-(defmacro byte-compile-constp (form)
- "Return non-nil if FORM is a constant."
- `(cond ((consp ,form) (eq (car ,form) 'quote))
- ((not (symbolp ,form)))
- ((byte-compile-const-symbol-p ,form))))
+;; Dynamically bound in byte-compile-from-buffer.
+;; NB also used in cl.el and cl-macs.el.
+(defvar byte-compile--outbuffer)
(defmacro byte-compile-close-variables (&rest body)
(declare (debug t))
- (cons 'let
- (cons '(;;
- ;; Close over these variables to encapsulate the
- ;; compilation state
- ;;
- (byte-compile-macro-environment
- ;; Copy it because the compiler may patch into the
- ;; macroenvironment.
- (copy-alist byte-compile-initial-macro-environment))
- (byte-compile-function-environment nil)
- (byte-compile-bound-variables nil)
- (byte-compile-const-variables nil)
- (byte-compile-free-references nil)
- (byte-compile-free-assignments nil)
- ;;
- ;; Close over these variables so that `byte-compiler-options'
- ;; can change them on a per-file basis.
- ;;
- (byte-compile-verbose byte-compile-verbose)
- (byte-optimize byte-optimize)
- (byte-compile-dynamic byte-compile-dynamic)
- (byte-compile-dynamic-docstrings
- byte-compile-dynamic-docstrings)
-;; (byte-compile-generate-emacs19-bytecodes
-;; byte-compile-generate-emacs19-bytecodes)
- (byte-compile-warnings byte-compile-warnings)
- )
- body)))
+ `(let (;;
+ ;; Close over these variables to encapsulate the
+ ;; compilation state
+ ;;
+ (byte-compile-macro-environment
+ ;; Copy it because the compiler may patch into the
+ ;; macroenvironment.
+ (copy-alist byte-compile-initial-macro-environment))
+ (byte-compile--outbuffer nil)
+ (byte-compile-function-environment nil)
+ (byte-compile-bound-variables nil)
+ (byte-compile-const-variables nil)
+ (byte-compile-free-references nil)
+ (byte-compile-free-assignments nil)
+ ;;
+ ;; Close over these variables so that `byte-compiler-options'
+ ;; can change them on a per-file basis.
+ ;;
+ (byte-compile-verbose byte-compile-verbose)
+ (byte-optimize byte-optimize)
+ (byte-compile-dynamic byte-compile-dynamic)
+ (byte-compile-dynamic-docstrings
+ byte-compile-dynamic-docstrings)
+ ;; (byte-compile-generate-emacs19-bytecodes
+ ;; byte-compile-generate-emacs19-bytecodes)
+ (byte-compile-warnings byte-compile-warnings)
+ )
+ ,@body))
(defmacro displaying-byte-compile-warnings (&rest body)
(declare (debug t))
(not (auto-save-file-name-p source))
(not (string-equal dir-locals-file
(file-name-nondirectory source))))
- (progn (case (byte-recompile-file source force arg)
- (no-byte-compile (setq skip-count (1+ skip-count)))
- ((t) (setq file-count (1+ file-count)))
- ((nil) (setq fail-count (1+ fail-count))))
+ (progn (cl-incf
+ (pcase (byte-recompile-file source force arg)
+ (`no-byte-compile skip-count)
+ (`t file-count)
+ (_ fail-count)))
(or noninteractive
(message "Checking %s..." directory))
(if (not (eq last-dir directory))
"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)
(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
(set-buffer-multibyte nil))
;; Run hooks including the uncompression hook.
;; If they change the file name, then change it for the output also.
- (letf ((buffer-file-name filename)
- ((default-value 'major-mode) 'emacs-lisp-mode)
- ;; Ignore unsafe local variables.
- ;; We only care about a few of them for our purposes.
- (enable-local-variables :safe)
- (enable-local-eval nil))
- ;; Arg of t means don't alter enable-local-variables.
- (normal-mode t)
+ (let ((buffer-file-name filename)
+ (dmm (default-value 'major-mode))
+ ;; Ignore unsafe local variables.
+ ;; We only care about a few of them for our purposes.
+ (enable-local-variables :safe)
+ (enable-local-eval nil))
+ (unwind-protect
+ (progn
+ (setq-default major-mode 'emacs-lisp-mode)
+ ;; Arg of t means don't alter enable-local-variables.
+ (normal-mode t))
+ (setq-default major-mode dmm))
;; There may be a file local variable setting (bug#10419).
(setq buffer-read-only nil
filename buffer-file-name))
(insert "\n"))
((message "%s" (prin1-to-string value)))))))
-;; Dynamically bound in byte-compile-from-buffer.
-;; NB also used in cl.el and cl-macs.el.
-(defvar byte-compile--outbuffer)
-
(defun byte-compile-from-buffer (inbuffer)
- (let (byte-compile--outbuffer
- (byte-compile-current-buffer inbuffer)
+ (let ((byte-compile-current-buffer inbuffer)
(byte-compile-read-position nil)
(byte-compile-last-position nil)
;; Prevent truncation of flonums and lists as we read and print them
;; if the buffer contains multibyte characters.
(and byte-compile-current-file
(with-current-buffer byte-compile--outbuffer
- (byte-compile-fix-header byte-compile-current-file)))))
- byte-compile--outbuffer))
+ (byte-compile-fix-header byte-compile-current-file))))
+ byte-compile--outbuffer)))
(defun byte-compile-fix-header (_filename)
"If the current buffer has any multibyte characters, insert a version test."
;; Because the header must fit in a fixed width, we cannot
;; insert arbitrary-length file names (Bug#11585).
" (error \"`%s' was compiled for "
- (format "Emacs %s or later\" load-file-name))\n\n" minimum-version))
+ (format "Emacs %s or later\" #$))\n\n" minimum-version))
;; Now compensate for any change in size, to make sure all
;; positions in the file remain valid.
(setq delta (- (point-max) old-header-end))
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
(defun byte-compile-output-file-form (form)
- ;; writes the given form to the output buffer, being careful of docstrings
- ;; in defun, defmacro, defvar, defvaralias, defconst, autoload and
+ ;; Write the given form to the output buffer, being careful of docstrings
+ ;; in defvar, defvaralias, defconst, autoload and
;; custom-declare-variable because make-docfile is so amazingly stupid.
;; defalias calls are output directly by byte-compile-file-form-defmumble;
;; it does not pay to first build the defalias in defmumble and then parse
;; it here.
- (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst
- autoload custom-declare-variable))
- (stringp (nth 3 form)))
- (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
- (memq (car form)
- '(defvaralias autoload
- custom-declare-variable)))
- (let ((print-escape-newlines t)
- (print-length nil)
- (print-level nil)
- (print-quoted t)
- (print-gensym t)
- (print-circle ; handle circular data structures
- (not byte-compile-disable-print-circle)))
+ (let ((print-escape-newlines t)
+ (print-length nil)
+ (print-level nil)
+ (print-quoted t)
+ (print-gensym t)
+ (print-circle ; Handle circular data structures.
+ (not byte-compile-disable-print-circle)))
+ (if (and (memq (car-safe form) '(defvar defvaralias defconst
+ autoload custom-declare-variable))
+ (stringp (nth 3 form)))
+ (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
+ (memq (car form)
+ '(defvaralias autoload
+ custom-declare-variable)))
(princ "\n" byte-compile--outbuffer)
(prin1 form byte-compile--outbuffer)
nil)))
-(defvar print-gensym-alist) ;Used before print-circle existed.
(defvar byte-compile--for-effect)
(defun byte-compile-output-docform (preface name info form specindex quoted)
(setq position
(byte-compile-output-as-comment
(nth (nth 1 info) form) nil))
- (setq position (- (position-bytes position) (point-min) -1))
;; If the doc string starts with * (a user variable),
;; negate POSITION.
(if (and (stringp (nth (nth 1 info) form))
(insert preface)
(prin1 name byte-compile--outbuffer)))
(insert (car info))
- (let ((print-escape-newlines t)
- (print-quoted t)
- ;; For compatibility with code before print-circle,
- ;; use a cons cell to say that we want
- ;; print-gensym-alist not to be cleared
- ;; between calls to print functions.
- (print-gensym '(t))
- (print-circle ; handle circular data structures
- (not byte-compile-disable-print-circle))
- print-gensym-alist ; was used before print-circle existed.
- (print-continuous-numbering t)
+ (let ((print-continuous-numbering t)
print-number-table
- (index 0))
+ (index 0)
+ ;; FIXME: The bindings below are only needed for when we're
+ ;; called from ...-defmumble.
+ (print-escape-newlines t)
+ (print-length nil)
+ (print-level nil)
+ (print-quoted t)
+ (print-gensym t)
+ (print-circle ; Handle circular data structures.
+ (not byte-compile-disable-print-circle)))
(prin1 (car form) byte-compile--outbuffer)
(while (setq form (cdr form))
(setq index (1+ index))
(byte-compile-output-as-comment
(cons (car form) (nth 1 form))
t)))
- (setq position (- (position-bytes position)
- (point-min) -1))
(princ (format "(#$ . %d) nil" position)
byte-compile--outbuffer)
(setq form (cdr form))
(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
(defun byte-compile-file-form-autoload (form)
(and (let ((form form))
- (while (if (setq form (cdr form)) (byte-compile-constp (car form))))
+ (while (if (setq form (cdr form)) (macroexp-const-p (car form))))
(null form)) ;Constants only
(eval (nth 5 form)) ;Macro
(eval form)) ;Define the autoload.
(when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
(push (nth 1 (nth 1 form)) byte-compile-bound-variables)
- ;; Don't compile the expression because it may be displayed to the user.
- ;; (when (eq (car-safe (nth 2 form)) 'quote)
- ;; ;; (nth 2 form) is meant to evaluate to an expression, so if we have the
- ;; ;; final value already, we can byte-compile it.
- ;; (setcar (cdr (nth 2 form))
- ;; (byte-compile-top-level (cadr (nth 2 form)) nil 'file)))
- (let ((tail (nthcdr 4 form)))
- (while tail
- (unless (keywordp (car tail)) ;No point optimizing keywords.
- ;; Compile the keyword arguments.
- (setcar tail (byte-compile-top-level (car tail) nil 'file)))
- (setq tail (cdr tail))))
- form)
+ (byte-compile-keep-pending form))
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
(nth 1 (nth 1 form))
(byte-compile-keep-pending form)))
-(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun)
-(defun byte-compile-file-form-defun (form)
- (byte-compile-file-form-defmumble form nil))
-
-(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
-(defun byte-compile-file-form-defmacro (form)
- (byte-compile-file-form-defmumble form t))
-
-(defun byte-compile-defmacro-declaration (form)
- "Generate code for declarations in macro definitions.
-Remove declarations from the body of the macro definition
-by side-effects."
- (let ((tail (nthcdr 2 form))
- (res '()))
- (when (stringp (car (cdr tail)))
- (setq tail (cdr tail)))
- (while (and (consp (car (cdr tail)))
- (eq (car (car (cdr tail))) 'declare))
- (let ((declaration (car (cdr tail))))
- (setcdr tail (cdr (cdr tail)))
- (push `(if macro-declaration-function
- (funcall macro-declaration-function
- ',(car (cdr form)) ',declaration))
- res)))
- res))
-
-(defun byte-compile-file-form-defmumble (form macrop)
- (let* ((name (car (cdr form)))
- (this-kind (if macrop 'byte-compile-macro-environment
- 'byte-compile-function-environment))
- (that-kind (if macrop 'byte-compile-function-environment
- 'byte-compile-macro-environment))
- (this-one (assq name (symbol-value this-kind)))
- (that-one (assq name (symbol-value that-kind)))
- (byte-compile-free-references nil)
- (byte-compile-free-assignments nil))
+(defun byte-compile-file-form-defmumble (name macro arglist body rest)
+ "Process a `defalias' for NAME.
+If MACRO is non-nil, the definition is known to be a macro.
+ARGLIST is the list of arguments, if it was recognized or t otherwise.
+BODY of the definition, or t if not recognized.
+Return non-nil if everything went as planned, or nil to imply that it decided
+not to take responsibility for the actual compilation of the code."
+ (let* ((this-kind (if macro 'byte-compile-macro-environment
+ 'byte-compile-function-environment))
+ (that-kind (if macro 'byte-compile-function-environment
+ 'byte-compile-macro-environment))
+ (this-one (assq name (symbol-value this-kind)))
+ (that-one (assq name (symbol-value that-kind)))
+ (byte-compile-current-form name)) ; For warnings.
+
(byte-compile-set-symbol-position name)
;; When a function or macro is defined, add it to the call tree so that
;; we can tell when functions are not used.
(if byte-compile-generate-call-tree
- (or (assq name byte-compile-call-tree)
- (setq byte-compile-call-tree
- (cons (list name nil nil) byte-compile-call-tree))))
+ (or (assq name byte-compile-call-tree)
+ (setq byte-compile-call-tree
+ (cons (list name nil nil) byte-compile-call-tree))))
- (setq byte-compile-current-form name) ; for warnings
(if (byte-compile-warning-enabled-p 'redefine)
- (byte-compile-arglist-warn form macrop))
+ (byte-compile-arglist-warn name arglist macro))
+
(if byte-compile-verbose
- (message "Compiling %s... (%s)"
- (or byte-compile-current-file "") (nth 1 form)))
- (cond (that-one
- (if (and (byte-compile-warning-enabled-p 'redefine)
- ;; don't warn when compiling the stubs in byte-run...
- (not (assq (nth 1 form)
- byte-compile-initial-macro-environment)))
- (byte-compile-warn
+ (message "Compiling %s... (%s)"
+ (or byte-compile-current-file "") name))
+ (cond ((not (or macro (listp body)))
+ ;; We do not know positively if the definition is a macro
+ ;; or a function, so we shouldn't emit warnings.
+ ;; This also silences "multiple definition" warnings for defmethods.
+ nil)
+ (that-one
+ (if (and (byte-compile-warning-enabled-p 'redefine)
+ ;; Don't warn when compiling the stubs in byte-run...
+ (not (assq name byte-compile-initial-macro-environment)))
+ (byte-compile-warn
"`%s' defined multiple times, as both function and macro"
- (nth 1 form)))
- (setcdr that-one nil))
- (this-one
- (when (and (byte-compile-warning-enabled-p 'redefine)
- ;; hack: don't warn when compiling the magic internal
+ name))
+ (setcdr that-one nil))
+ (this-one
+ (when (and (byte-compile-warning-enabled-p 'redefine)
+ ;; Hack: Don't warn when compiling the magic internal
;; byte-compiler macros in byte-run.el...
- (not (assq (nth 1 form)
- byte-compile-initial-macro-environment)))
- (byte-compile-warn "%s `%s' defined multiple times in this file"
- (if macrop "macro" "function")
- (nth 1 form))))
- ((and (fboundp name)
- (eq (car-safe (symbol-function name))
- (if macrop 'lambda 'macro)))
- (when (byte-compile-warning-enabled-p 'redefine)
- (byte-compile-warn "%s `%s' being redefined as a %s"
- (if macrop "function" "macro")
- (nth 1 form)
- (if macrop "macro" "function")))
- ;; shadow existing definition
- (set this-kind
- (cons (cons name nil)
- (symbol-value this-kind))))
- )
- (let ((body (nthcdr 3 form)))
- (when (and (stringp (car body))
- (symbolp (car-safe (cdr-safe body)))
- (car-safe (cdr-safe body))
- (stringp (car-safe (cdr-safe (cdr-safe body)))))
- (byte-compile-set-symbol-position (nth 1 form))
- (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
- (nth 1 form))))
-
- ;; Generate code for declarations in macro definitions.
- ;; Remove declarations from the body of the macro definition.
- (when macrop
- (dolist (decl (byte-compile-defmacro-declaration form))
- (prin1 decl byte-compile--outbuffer)))
-
- (let* ((code (byte-compile-lambda (nthcdr 2 form) t)))
- (if this-one
- ;; A definition in b-c-initial-m-e should always take precedence
- ;; during compilation, so don't let it be redefined. (Bug#8647)
- (or (and macrop
- (assq name byte-compile-initial-macro-environment))
- (setcdr this-one code))
- (set this-kind
- (cons (cons name code)
- (symbol-value this-kind))))
- (byte-compile-flush-pending)
- (if (not (stringp (nth 3 form)))
- ;; No doc string. Provide -1 as the "doc string index"
- ;; so that no element will be treated as a doc string.
- (byte-compile-output-docform
- "\n(defalias '"
- name
- (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))
- (append code nil) ; Turn byte-code-function-p into list.
- (and (atom code) byte-compile-dynamic
- 1)
- nil)
- ;; Output the form by hand, that's much simpler than having
- ;; b-c-output-file-form analyze the defalias.
- (byte-compile-output-docform
- "\n(defalias '"
- name
- (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))
- (append code nil) ; Turn byte-code-function-p into list.
- (and (atom code) byte-compile-dynamic
- 1)
- nil))
- (princ ")" byte-compile--outbuffer)
- nil)))
+ (not (assq name byte-compile-initial-macro-environment)))
+ (byte-compile-warn "%s `%s' defined multiple times in this file"
+ (if macro "macro" "function")
+ name)))
+ ((and (fboundp name)
+ (eq (car-safe (symbol-function name))
+ (if macro 'lambda 'macro)))
+ (when (byte-compile-warning-enabled-p 'redefine)
+ (byte-compile-warn "%s `%s' being redefined as a %s"
+ (if macro "function" "macro")
+ name
+ (if macro "macro" "function")))
+ ;; Shadow existing definition.
+ (set this-kind
+ (cons (cons name nil)
+ (symbol-value this-kind))))
+ )
+
+ (when (and (listp body)
+ (stringp (car body))
+ (symbolp (car-safe (cdr-safe body)))
+ (car-safe (cdr-safe body))
+ (stringp (car-safe (cdr-safe (cdr-safe body)))))
+ ;; FIXME: We've done that already just above, so this looks wrong!
+ ;;(byte-compile-set-symbol-position name)
+ (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
+ name))
+
+ (if (not (listp body))
+ ;; The precise definition requires evaluation to find out, so it
+ ;; will only be known at runtime.
+ ;; For a macro, that means we can't use that macro in the same file.
+ (progn
+ (unless macro
+ (push (cons name (if (listp arglist) `(declared ,arglist) t))
+ byte-compile-function-environment))
+ ;; Tell the caller that we didn't compile it yet.
+ nil)
+
+ (let* ((code (byte-compile-lambda (cons arglist body) t)))
+ (if this-one
+ ;; A definition in b-c-initial-m-e should always take precedence
+ ;; during compilation, so don't let it be redefined. (Bug#8647)
+ (or (and macro
+ (assq name byte-compile-initial-macro-environment))
+ (setcdr this-one code))
+ (set this-kind
+ (cons (cons name code)
+ (symbol-value this-kind))))
+
+ (if rest
+ ;; There are additional args to `defalias' (like maybe a docstring)
+ ;; that the code below can't handle: punt!
+ nil
+ ;; Otherwise, we have a bona-fide defun/defmacro definition, and use
+ ;; special code to allow dynamic docstrings and byte-code.
+ (byte-compile-flush-pending)
+ (let ((index
+ ;; If there's no doc string, provide -1 as the "doc string
+ ;; index" so that no element will be treated as a doc string.
+ (if (not (stringp (car body))) -1 4)))
+ ;; Output the form by hand, that's much simpler than having
+ ;; b-c-output-file-form analyze the defalias.
+ (byte-compile-output-docform
+ "\n(defalias '"
+ name
+ (if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]"))
+ (append code nil) ; Turn byte-code-function-p into list.
+ (and (atom code) byte-compile-dynamic
+ 1)
+ nil))
+ (princ ")" byte-compile--outbuffer)
+ t)))))
-;; Print Lisp object EXP in the output file, inside a comment,
-;; and return the file position it will have.
-;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
(defun byte-compile-output-as-comment (exp quoted)
- (let ((position (point)))
- (with-current-buffer byte-compile--outbuffer
+ "Print Lisp object EXP in the output file, inside a comment,
+and return the file (byte) position it will have.
+If QUOTED is non-nil, print with quoting; otherwise, print without quoting."
+ (with-current-buffer byte-compile--outbuffer
+ (let ((position (point)))
;; Insert EXP, and make it a comment with #@LENGTH.
(insert " ")
(position-bytes position))))
;; Save the file position of the object.
- ;; Note we should add 1 to skip the space
- ;; that we inserted before the actual doc string,
- ;; and subtract 1 to convert from an 1-origin Emacs position
- ;; to a file position; they cancel.
- (setq position (point))
- (goto-char (point-max)))
- position))
-
-
+ ;; Note we add 1 to skip the space that we inserted before the actual doc
+ ;; string, and subtract point-min to convert from an 1-origin Emacs
+ ;; position to a file position.
+ (prog1
+ (- (position-bytes (point)) (point-min) -1)
+ (goto-char (point-max))))))
+
+(defun byte-compile--reify-function (fun)
+ "Return an expression which will evaluate to a function value FUN.
+FUN should be either a `lambda' value or a `closure' value."
+ (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil))
+ `(closure ,env ,args . ,body)) fun)
+ (renv ()))
+ ;; Turn the function's closed vars (if any) into local let bindings.
+ (dolist (binding env)
+ (cond
+ ((consp binding)
+ ;; We check shadowing by the args, so that the `let' can be moved
+ ;; within the lambda, which can then be unfolded. FIXME: Some of those
+ ;; bindings might be unused in `body'.
+ (unless (memq (car binding) args) ;Shadowed.
+ (push `(,(car binding) ',(cdr binding)) renv)))
+ ((eq binding t))
+ (t (push `(defvar ,binding) body))))
+ (if (null renv)
+ `(lambda ,args ,@body)
+ `(lambda ,args (let ,(nreverse renv) ,@body)))))
\f
;;;###autoload
(defun byte-compile (form)
If FORM is a lambda or a macro, byte-compile it as a function."
(displaying-byte-compile-warnings
(byte-compile-close-variables
- (let* ((fun (if (symbolp form)
+ (let* ((lexical-binding lexical-binding)
+ (fun (if (symbolp form)
(and (fboundp form) (symbol-function form))
form))
(macro (eq (car-safe fun) 'macro)))
(if macro
(setq fun (cdr fun)))
- (cond ((eq (car-safe fun) 'lambda)
- ;; Expand macros.
- (setq fun (byte-compile-preprocess fun))
- ;; Get rid of the `function' quote added by the `lambda' macro.
- (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
- (setq fun (if macro
- (cons 'macro (byte-compile-lambda fun))
- (byte-compile-lambda fun)))
- (if (symbolp form)
- (defalias form fun)
- fun)))))))
+ (cond
+ ;; Up until Emacs-24.1, byte-compile silently did nothing when asked to
+ ;; compile something invalid. So let's tune down the complaint from an
+ ;; error to a simple message for the known case where signaling an error
+ ;; causes problems.
+ ((byte-code-function-p fun)
+ (message "Function %s is already compiled"
+ (if (symbolp form) form "provided"))
+ fun)
+ (t
+ (when (symbolp form)
+ (unless (memq (car-safe fun) '(closure lambda))
+ (error "Don't know how to compile %S" fun))
+ (setq fun (byte-compile--reify-function fun))
+ (setq lexical-binding (eq (car fun) 'closure)))
+ (unless (eq (car-safe fun) 'lambda)
+ (error "Don't know how to compile %S" fun))
+ ;; Expand macros.
+ (setq fun (byte-compile-preprocess fun))
+ ;; Get rid of the `function' quote added by the `lambda' macro.
+ (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
+ (setq fun (byte-compile-lambda fun))
+ (if macro (push 'macro fun))
+ (if (symbolp form)
+ (fset form fun)
+ fun)))))))
(defun byte-compile-sexp (sexp)
"Compile and return SEXP."
(when (symbolp arg)
(byte-compile-set-symbol-position arg))
(cond ((or (not (symbolp arg))
- (byte-compile-const-symbol-p arg t))
+ (macroexp--const-symbol-p arg t))
(error "Invalid lambda variable %s" arg))
((eq arg '&rest)
(unless (cdr list)
(lsh nonrest 8)
(lsh rest 7)))))
-;; Byte-compile a lambda-expression and return a valid function.
-;; The value is usually a compiled function but may be the original
-;; lambda-expression.
-;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
-;; of the list FUN and `byte-compile-set-symbol-position' is not called.
-;; Use this feature to avoid calling `byte-compile-set-symbol-position'
-;; for symbols generated by the byte compiler itself.
+
(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
+ "Byte-compile a lambda-expression and return a valid function.
+The value is usually a compiled function but may be the original
+lambda-expression.
+When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
+of the list FUN and `byte-compile-set-symbol-position' is not called.
+Use this feature to avoid calling `byte-compile-set-symbol-position'
+for symbols generated by the byte compiler itself."
(if add-lambda
(setq fun (cons 'lambda fun))
(unless (eq 'lambda (car-safe fun))
(byte-compile-make-lambda-lexenv fun))
reserved-csts)))
;; Build the actual byte-coded function.
- (if (eq 'byte-code (car-safe compiled))
- (apply 'make-byte-code
- (if lexical-binding
- (byte-compile-make-args-desc arglist)
- arglist)
- (append
- ;; byte-string, constants-vector, stack depth
- (cdr compiled)
- ;; optionally, the doc string.
- (cond (lexical-binding
- (require 'help-fns)
- (list (help-add-fundoc-usage doc arglist)))
- ((or doc int)
- (list doc)))
- ;; optionally, the interactive spec.
- (if int
- (list (nth 1 int)))))
- (error "byte-compile-top-level did not return byte-code")))))
+ (cl-assert (eq 'byte-code (car-safe compiled)))
+ (apply #'make-byte-code
+ (if lexical-binding
+ (byte-compile-make-args-desc arglist)
+ arglist)
+ (append
+ ;; byte-string, constants-vector, stack depth
+ (cdr compiled)
+ ;; optionally, the doc string.
+ (cond (lexical-binding
+ (require 'help-fns)
+ (list (help-add-fundoc-usage doc arglist)))
+ ((or doc int)
+ (list doc)))
+ ;; optionally, the interactive spec.
+ (if int
+ (list (nth 1 int))))))))
(defvar byte-compile-reserved-constants 0)
(while (and rest (< i limit))
(cond
((numberp (car rest))
- (assert (< (car rest) byte-compile-reserved-constants)))
+ (cl-assert (< (car rest) byte-compile-reserved-constants)))
((setq tmp (assq (car (car rest)) ret))
(setcdr (car rest) (cdr tmp)))
(t
(if (if (eq (car (car rest)) 'byte-constant)
(or (consp tmp)
(and (symbolp tmp)
- (not (byte-compile-const-symbol-p tmp)))))
+ (not (macroexp--const-symbol-p tmp)))))
(if maycall
(setq body (cons (list 'quote tmp) body)))
(setq body (cons tmp body))))
(push (cons fn
(if (and (consp args) (listp (car args)))
(list 'declared (car args))
- t)) ; arglist not specified
+ t)) ; Arglist not specified.
byte-compile-function-environment)
;; We are stating that it _will_ be defined at runtime.
(setq byte-compile-noruntime-functions
(let ((byte-compile--for-effect for-effect))
(cond
((not (consp form))
- (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
+ (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
(when (symbolp form)
(byte-compile-set-symbol-position form))
(byte-compile-constant form))
((symbolp (car form))
(let* ((fn (car form))
(handler (get fn 'byte-compile)))
- (when (byte-compile-const-symbol-p fn)
+ (when (macroexp--const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
(and (byte-compile-warning-enabled-p 'interactive-only)
(memq fn byte-compile-interactive-only-functions)
(byte-compile-log-warning
(format "Forgot to expand macro %s" (car form)) nil :error))
(if (and handler
- ;; Make sure that function exists. This is important
- ;; for CL compiler macros since the symbol may be
- ;; `cl-byte-compile-compiler-macro' but if CL isn't
- ;; loaded, this function doesn't exist.
- (and (not (eq handler
- ;; Already handled by macroexpand-all.
- 'cl-byte-compile-compiler-macro))
- (functionp handler)))
+ ;; Make sure that function exists.
+ (and (functionp handler)
+ ;; Ignore obsolete byte-compile function used by former
+ ;; CL code to handle compiler macros (we do it
+ ;; differently now).
+ (not (eq handler 'cl-byte-compile-compiler-macro))))
(funcall handler form)
(byte-compile-normal-call form))
(if (byte-compile-warning-enabled-p 'cl-functions)
(mapc 'byte-compile-form (cdr form))
(unless fmax2
;; Old-style byte-code.
- (assert (listp fargs))
+ (cl-assert (listp fargs))
(while fargs
- (case (car fargs)
- (&optional (setq fargs (cdr fargs)))
- (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
+ (pcase (car fargs)
+ (`&optional (setq fargs (cdr fargs)))
+ (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
(push (cadr fargs) dynbinds)
(setq fargs nil))
- (t (push (pop fargs) dynbinds))))
+ (_ (push (pop fargs) dynbinds))))
(unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
(cond
((<= (+ alen alen) fmax2)
(t
;; Turn &rest args into a list.
(let ((n (- alen (/ (1- fmax2) 2))))
- (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
+ (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
(if (< n 5)
(byte-compile-out
(aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n))
;; Unbind dynamic variables.
(when dynbinds
(byte-compile-out 'byte-unbind (length dynbinds)))
- (assert (eq byte-compile-depth (1+ start-depth))
+ (cl-assert (eq byte-compile-depth (1+ start-depth))
nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
(defun byte-compile-check-variable (var access-type)
"Do various error checks before a use of the variable VAR."
(when (symbolp var)
(byte-compile-set-symbol-position var))
- (cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var))
+ (cond ((or (not (symbolp var)) (macroexp--const-symbol-p var))
(when (byte-compile-warning-enabled-p 'constants)
(byte-compile-warn (if (eq access-type 'let-bind)
"attempt to let-bind %s `%s`"
(and od
(not (memq var byte-compile-not-obsolete-vars))
(not (memq var byte-compile-global-not-obsolete-vars))
- (or (case (nth 1 od)
- (set (not (eq access-type 'reference)))
- (get (eq access-type 'reference))
- (t t)))))
+ (or (pcase (nth 1 od)
+ (`set (not (eq access-type 'reference)))
+ (`get (eq access-type 'reference))
+ (_ t)))))
(byte-compile-warn-obsolete var))))
(defsubst byte-compile-dynamic-variable-op (base-op var)
(byte-compile-check-variable var 'assign)
(let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
- ;; VAR is lexically bound
+ ;; VAR is lexically bound.
(byte-compile-stack-set (cdr lex-binding))
- ;; VAR is dynamically bound
+ ;; VAR is dynamically bound.
(unless (or (not (byte-compile-warning-enabled-p 'free-vars))
(boundp var)
(memq var byte-compile-bound-variables)
(body (nthcdr 3 form))
(fun
(byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
- (assert (byte-code-function-p fun))
+ (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure.
+ (cl-assert (byte-code-function-p fun))
(byte-compile-form `(make-byte-code
',(aref fun 0) ',(aref fun 1)
(vconcat (vector . ,env) ',(aref fun 2))
(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))
- (byte-compile-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)
(if lexical-binding
;; Unbind both lexical and dynamic variables.
(progn
- (assert (or (eq byte-compile-depth init-stack-depth)
- (eq byte-compile-depth (1+ init-stack-depth))))
+ (cl-assert (or (eq byte-compile-depth init-stack-depth)
+ (eq byte-compile-depth (1+ init-stack-depth))))
(byte-compile-unbind clauses init-lexenv (> byte-compile-depth
init-stack-depth)))
;; Unbind dynamic variables.
\f
;;; top-level forms elsewhere
-(byte-defop-compiler-1 defun)
-(byte-defop-compiler-1 defmacro)
(byte-defop-compiler-1 defvar)
(byte-defop-compiler-1 defconst byte-compile-defvar)
(byte-defop-compiler-1 autoload)
(byte-defop-compiler-1 lambda byte-compile-lambda-form)
-(defun byte-compile-defun (form)
- ;; This is not used for file-level defuns with doc strings.
- (if (symbolp (car form))
- (byte-compile-set-symbol-position (car form))
- (byte-compile-set-symbol-position 'defun)
- (error "defun name must be a symbol, not %s" (car form)))
- (byte-compile-push-constant 'defalias)
- (byte-compile-push-constant (nth 1 form))
- (byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t))
- (byte-compile-out 'byte-call 2))
-
-(defun byte-compile-defmacro (form)
- ;; This is not used for file-level defmacros with doc strings.
- (byte-compile-body-do-effect
- (let ((decls (byte-compile-defmacro-declaration form))
- (code (byte-compile-lambda (cdr (cdr form)) t)))
- `((defalias ',(nth 1 form)
- ,(if (eq (car-safe code) 'make-byte-code)
- `(cons 'macro ,code)
- `'(macro . ,(eval code))))
- ,@decls
- ',(nth 1 form)))))
-
;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
;; actually use `toto' in order for this obsolete variable to still work
;; correctly, so paradoxically, while byte-compiling foo.el, the presence
(defun byte-compile-autoload (form)
(byte-compile-set-symbol-position 'autoload)
- (and (byte-compile-constp (nth 1 form))
- (byte-compile-constp (nth 5 form))
+ (and (macroexp-const-p (nth 1 form))
+ (macroexp-const-p (nth 5 form))
(eval (nth 5 form)) ; macro-p
(not (fboundp (eval (nth 1 form))))
(byte-compile-warn
(put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
;; Used for eieio--defalias as well.
(defun byte-compile-file-form-defalias (form)
- (if (and (consp (cdr form)) (consp (nth 1 form))
- (eq (car (nth 1 form)) 'quote)
- (consp (cdr (nth 1 form)))
- (symbolp (nth 1 (nth 1 form))))
- (let ((constant
- (and (consp (nthcdr 2 form))
- (consp (nth 2 form))
- (eq (car (nth 2 form)) 'quote)
- (consp (cdr (nth 2 form)))
- (symbolp (nth 1 (nth 2 form))))))
- (byte-compile-defalias-warn (nth 1 (nth 1 form)))
- (push (cons (nth 1 (nth 1 form))
- (if constant (nth 1 (nth 2 form)) t))
- byte-compile-function-environment)))
- ;; We used to just do: (byte-compile-normal-call form)
- ;; But it turns out that this fails to optimize the code.
- ;; So instead we now do the same as what other byte-hunk-handlers do,
- ;; which is to call back byte-compile-file-form and then return nil.
- ;; Except that we can't just call byte-compile-file-form since it would
- ;; call us right back.
- (byte-compile-keep-pending form)
- ;; Return nil so the form is not output twice.
- nil)
-
-;; Turn off warnings about prior calls to the function being defalias'd.
-;; This could be smarter and compare those calls with
-;; the function it is being aliased to.
-(defun byte-compile-defalias-warn (new)
- (let ((calls (assq new byte-compile-unresolved-functions)))
- (if calls
- (setq byte-compile-unresolved-functions
- (delq calls byte-compile-unresolved-functions)))))
+ ;; For the compilation itself, we could largely get rid of this hunk-handler,
+ ;; if it weren't for the fact that we need to figure out when a defalias
+ ;; defines a macro, so as to add it to byte-compile-macro-environment.
+ ;;
+ ;; FIXME: we also use this hunk-handler to implement the function's dynamic
+ ;; docstring feature. We could actually implement it more elegantly in
+ ;; byte-compile-lambda so it applies to all lambdas, but the problem is that
+ ;; the resulting .elc format will not be recognized by make-docfile, so
+ ;; either we stop using DOC for the docstrings of preloaded elc files (at the
+ ;; cost of around 24KB on 32bit hosts, double on 64bit hosts) or we need to
+ ;; build DOC in a more clever way (e.g. handle anonymous elements).
+ (let ((byte-compile-free-references nil)
+ (byte-compile-free-assignments nil))
+ (pcase form
+ ;; Decompose `form' into:
+ ;; - `name' is the name of the defined function.
+ ;; - `arg' is the expression to which it is defined.
+ ;; - `rest' is the rest of the arguments.
+ (`(,_ ',name ,arg . ,rest)
+ (pcase-let*
+ ;; `macro' is non-nil if it defines a macro.
+ ;; `fun' is the function part of `arg' (defaults to `arg').
+ (((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let macro t))
+ (and (let fun arg) (let macro nil)))
+ arg)
+ ;; `lam' is the lambda expression in `fun' (or nil if not
+ ;; recognized).
+ ((or `(,(or `quote `function) ,lam) (let lam nil))
+ fun)
+ ;; `arglist' is the list of arguments (or t if not recognized).
+ ;; `body' is the body of `lam' (or t if not recognized).
+ ((or `(lambda ,arglist . ,body)
+ ;; `(closure ,_ ,arglist . ,body)
+ (and `(internal-make-closure ,arglist . ,_) (let body t))
+ (and (let arglist t) (let body t)))
+ lam))
+ (unless (byte-compile-file-form-defmumble
+ name macro arglist body rest)
+ (byte-compile-keep-pending form))))
+
+ ;; We used to just do: (byte-compile-normal-call form)
+ ;; But it turns out that this fails to optimize the code.
+ ;; So instead we now do the same as what other byte-hunk-handlers do,
+ ;; which is to call back byte-compile-file-form and then return nil.
+ ;; Except that we can't just call byte-compile-file-form since it would
+ ;; call us right back.
+ (t (byte-compile-keep-pending form)))))
(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
(defun byte-compile-no-warnings (form)
(if byte-compile-call-tree-sort
(setq byte-compile-call-tree
(sort byte-compile-call-tree
- (case byte-compile-call-tree-sort
- (callers
+ (pcase byte-compile-call-tree-sort
+ (`callers
(lambda (x y) (< (length (nth 1 x))
(length (nth 1 y)))))
- (calls
+ (`calls
(lambda (x y) (< (length (nth 2 x))
(length (nth 2 y)))))
- (calls+callers
+ (`calls+callers
(lambda (x y) (< (+ (length (nth 1 x))
(length (nth 2 x)))
(+ (length (nth 1 y))
(length (nth 2 y))))))
- (name
+ (`name
(lambda (x y) (string< (car x) (car y))))
- (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
+ (_ (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
byte-compile-call-tree-sort))))))
(message "Generating call tree...")
(let ((rest byte-compile-call-tree)
(kill-emacs (if error 1 0))))
(defun batch-byte-compile-file (file)
- (if debug-on-error
- (byte-compile-file file)
- (condition-case err
- (byte-compile-file file)
- (file-error
- (message (if (cdr err)
- ">>Error occurred processing %s: %s (%s)"
- ">>Error occurred processing %s: %s")
- file
- (get (car err) 'error-message)
- (prin1-to-string (cdr err)))
- (let ((destfile (byte-compile-dest-file file)))
- (if (file-exists-p destfile)
- (delete-file destfile)))
- nil)
- (error
- (message (if (cdr err)
- ">>Error occurred processing %s: %s (%s)"
- ">>Error occurred processing %s: %s")
- file
- (get (car err) 'error-message)
- (prin1-to-string (cdr err)))
- nil))))
+ (let ((byte-compile-root-dir (or byte-compile-root-dir default-directory)))
+ (if debug-on-error
+ (byte-compile-file file)
+ (condition-case err
+ (byte-compile-file file)
+ (file-error
+ (message (if (cdr err)
+ ">>Error occurred processing %s: %s (%s)"
+ ">>Error occurred processing %s: %s")
+ file
+ (get (car err) 'error-message)
+ (prin1-to-string (cdr err)))
+ (let ((destfile (byte-compile-dest-file file)))
+ (if (file-exists-p destfile)
+ (delete-file destfile)))
+ nil)
+ (error
+ (message (if (cdr err)
+ ">>Error occurred processing %s: %s (%s)"
+ ">>Error occurred processing %s: %s")
+ file
+ (get (car err) 'error-message)
+ (prin1-to-string (cdr err)))
+ nil)))))
(defun byte-compile-refresh-preloaded ()
"Reload any Lisp file that was changed since Emacs was dumped.
(setq command-line-args-left (cdr command-line-args-left)))
(kill-emacs 0))
+;;; Core compiler macros.
+
+(put 'featurep 'compiler-macro
+ (lambda (form feature &rest _ignore)
+ ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so
+ ;; we can safely optimize away this test.
+ (if (member feature '('xemacs 'sxemacs 'emacs))
+ (eval form)
+ form)))
+
(provide 'byte-compile)
(provide 'bytecomp)
;; since afterwards they can because obnoxious (warnings about an "unused
;; variable" should not be emitted when the variable use has simply been
;; optimized away).
-;; - turn defun and defmacro into macros (and remove special handling of
-;; `declare' afterwards).
;; - let macros specify that some let-bindings come from the same source,
;; so the unused warning takes all uses into account.
;; - let interactive specs return a function to build the args (to stash into
;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
;; binders)))
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defconst cconv-liftwhen 6
"Try to do lambda lifting if the number of arguments + free variables
;; Here we assume that X appears at most once in M.
(let* ((b (assq x m))
(res (if b (remq b m) m)))
- (assert (null (assq x res))) ;; Check the assumption was warranted.
+ (cl-assert (null (assq x res))) ;; Check the assumption was warranted.
res))
(defun cconv--map-diff-set (m s)
(nreverse res)))
(defun cconv--convert-function (args body env parentform)
- (assert (equal body (caar cconv-freevars-alist)))
+ (cl-assert (equal body (caar cconv-freevars-alist)))
(let* ((fvs (cdr (pop cconv-freevars-alist)))
(body-new '())
(letbind '())
EXTEND is a list of variables which might need to be accessed even from places
where they are shadowed, because some part of ENV causes them to be used at
places where they originally did not directly appear."
- (assert (not (delq nil (mapcar (lambda (mapping)
- (if (eq (cadr mapping) 'apply-partially)
- (cconv--set-diff (cdr (cddr mapping))
- extend)))
- env))))
+ (cl-assert (not (delq nil (mapcar (lambda (mapping)
+ (if (eq (cadr mapping) 'apply-partially)
+ (cconv--set-diff (cdr (cddr mapping))
+ extend)))
+ env))))
;; What's the difference between fvrs and envs?
;; Suppose that we have the code
;; Check if var is a candidate for lambda lifting.
((and (member (cons binder form) cconv-lambda-candidates)
(progn
- (assert (and (eq (car value) 'function)
- (eq (car (cadr value)) 'lambda)))
- (assert (equal (cddr (cadr value))
- (caar cconv-freevars-alist)))
+ (cl-assert (and (eq (car value) 'function)
+ (eq (car (cadr value)) 'lambda)))
+ (cl-assert (equal (cddr (cadr value))
+ (caar cconv-freevars-alist)))
;; Peek at the freevars to decide whether to λ-lift.
(let* ((fvs (cdr (car cconv-freevars-alist)))
(fun (cadr value))
(funcbody-env ()))
(push `(,var . (apply-partially ,var . ,fvs)) new-env)
(dolist (fv fvs)
- (pushnew fv new-extend)
+ (cl-pushnew fv new-extend)
(if (and (eq 'car (car-safe (cdr (assq fv env))))
(not (memq fv funargs)))
(push `(,fv . (car ,fv)) funcbody-env)))
(mapcar (lambda (mapping)
(if (not (eq (cadr mapping) 'apply-partially))
mapping
- (assert (eq (car mapping) (nth 2 mapping)))
- (list* (car mapping)
- 'apply-partially
- (car mapping)
- (mapcar (lambda (arg)
- (if (eq var arg)
- closedsym arg))
- (nthcdr 3 mapping)))))
+ (cl-assert (eq (car mapping) (nth 2 mapping)))
+ `(,(car mapping)
+ apply-partially
+ ,(car mapping)
+ ,@(mapcar (lambda (arg)
+ (if (eq var arg)
+ closedsym arg))
+ (nthcdr 3 mapping)))))
new-env))
(setq new-extend (remq var new-extend))
(push closedsym new-extend)
. ,(mapcar (lambda (form) (cconv-convert form env extend))
forms)))
- ;defun, defmacro
- (`(,(and sym (or `defun `defmacro))
- ,func ,args . ,body)
- (assert (equal body (caar cconv-freevars-alist)))
- (assert (null (cdar cconv-freevars-alist)))
-
- (let ((new (cconv--convert-function args body env form)))
- (pcase new
- (`(function (lambda ,newargs . ,new-body))
- (assert (equal args newargs))
- `(,sym ,func ,args . ,new-body))
- (t (byte-compile-report-error
- (format "Internal error in cconv of (%s %s ...)" sym func))))))
-
;condition-case
(`(condition-case ,var ,protected-form . ,handlers)
(let ((newform (cconv--convert-function
(let ((mapping (cdr (assq fun env))))
(pcase mapping
(`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
- (assert (eq (cadr mapping) fun))
+ (cl-assert (eq (cadr mapping) fun))
`(,callsym ,fun
,@(mapcar (lambda (fv)
(let ((exp (or (cdr (assq fv env)) fv)))
;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
;; and compute free variables.
(while env
- (assert (and envcopy (eq (caar env) (caar envcopy))))
+ (cl-assert (and envcopy (eq (caar env) (caar envcopy))))
(let ((free nil)
(x (cdr (car env)))
(y (cdr (car envcopy))))
(dolist (vardata newvars)
(cconv--analyse-use vardata form "variable"))))
- ; defun special form
- (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms)
- (when env
- (byte-compile-log-warning
- (format "Function %S will ignore its context %S"
- func (mapcar #'car env))
- t :warning))
- (cconv--analyse-function vrs body-forms nil form))
-
(`(function (lambda ,vrs . ,body-forms))
(cconv--analyse-function vrs body-forms env form))
(cconv-analyse-form (cadr forms) env)
(setq forms (cddr forms))))
- (`((lambda . ,_) . ,_) ; first element is lambda expression
+ (`((lambda . ,_) . ,_) ; First element is lambda expression.
+ (byte-compile-log-warning
+ "Use of deprecated ((lambda ...) ...) form" t :warning)
(dolist (exp `((function ,(car form)) . ,(cdr form)))
(cconv-analyse-form exp env)))
-;;; chart.el --- Draw charts (bar charts, etc)
+;;; chart.el --- Draw charts (bar charts, etc) -*- lexical-binding: t -*-
;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2012
;; Free Software Foundation, Inc.
(require 'eieio)
;;; Code:
-(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.")
(define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1")
+(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.")
(defvar chart-local-object nil
"Local variable containing the locally displayed chart object.")
Useful if new Emacs is used on B&W display.")
(defcustom chart-face-use-pixmaps nil
- "*Non-nil to use fancy pixmaps in the background of chart face colors."
+ "Non-nil to use fancy pixmaps in the background of chart face colors."
:group 'eieio
:type 'boolean)
)
"Superclass for all charts to be displayed in an Emacs buffer.")
-(defmethod initialize-instance :AFTER ((obj chart) &rest fields)
+(defmethod initialize-instance :AFTER ((obj chart) &rest _fields)
"Initialize the chart OBJ being created with FIELDS.
Make sure the width/height is correct."
(oset obj x-width (- (window-width) 10))
(float (- (cdr range) (car range)))))))))
)
-(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone start end)
+(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone _start _end)
"Draw axis information based upon a range to be spread along the edge.
A is the chart to draw. DIR is the direction.
MARGIN, ZONE, START, and END specify restrictions in chart space."
(+ m -1 (round (* lpn (+ 1.0 (float n))))))
))
-(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone start end)
+(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone _start _end)
"Draw axis information based upon A range to be spread along the edge.
Optional argument DIR is the direction of the chart.
Optional arguments MARGIN, ZONE, START and END specify boundaries of the drawing."
(defun chart-emacs-storage ()
"Chart the current storage requirements of Emacs."
(interactive)
- (let* ((data (garbage-collect))
- (names '("strings/2" "vectors"
- "conses" "free cons"
- "syms" "free syms"
- "markers" "free mark"
- ;; "floats" "free flt"
- ))
- (nums (list (/ (nth 3 data) 2)
- (nth 4 data)
- (car (car data)) ; conses
- (cdr (car data))
- (car (nth 1 data)) ; syms
- (cdr (nth 1 data))
- (car (nth 2 data)) ; markers
- (cdr (nth 2 data))
- ;(car (nth 5 data)) ; floats are Emacs only
- ;(cdr (nth 5 data))
- )))
+ (let* ((data (garbage-collect)))
;; Let's create the chart!
(chart-bar-quickie 'vertical "Emacs Runtime Storage Usage"
- names "Storage Items"
- nums "Objects")))
+ (mapcar (lambda (x) (symbol-name (car x))) data)
+ "Storage Items"
+ (mapcar (lambda (x) (* (nth 1 x) (nth 2 x)))
+ data)
+ "Bytes")))
(defun chart-emacs-lists ()
"Chart out the size of various important lists."
(progn
(goto-char wrong)
(if (not take-notes)
- (error "%s" (checkdoc-error-text msg)))))
+ (user-error "%s" (checkdoc-error-text msg)))))
(checkdoc-show-diagnostics)
(if (called-interactively-p 'interactive)
(message "No style warnings."))))
(e (checkdoc-file-comments-engine))
(checkdoc-generate-compile-warnings-flag
(or take-notes checkdoc-generate-compile-warnings-flag)))
- (if e (error "%s" (checkdoc-error-text e)))
+ (if e (user-error "%s" (checkdoc-error-text e)))
(checkdoc-show-diagnostics)
e))
(if (not (called-interactively-p 'interactive))
e
(if e
- (error "%s" (checkdoc-error-text e))
+ (user-error "%s" (checkdoc-error-text e))
(checkdoc-show-diagnostics)))
(goto-char p))
(if (called-interactively-p 'interactive)
(car (memq checkdoc-spellcheck-documentation-flag
'(defun t))))
(beg (save-excursion (beginning-of-defun) (point)))
- (end (save-excursion (end-of-defun) (point)))
- (msg (checkdoc-this-string-valid)))
- (if msg (if no-error
- (message "%s" (checkdoc-error-text msg))
- (error "%s" (checkdoc-error-text msg)))
- (setq msg (checkdoc-message-text-search beg end))
- (if msg (if no-error
- (message "%s" (checkdoc-error-text msg))
- (error "%s" (checkdoc-error-text msg)))
- (setq msg (checkdoc-rogue-space-check-engine beg end))
- (if msg (if no-error
- (message "%s" (checkdoc-error-text msg))
- (error "%s" (checkdoc-error-text msg))))))
+ (end (save-excursion (end-of-defun) (point))))
+ (dolist (fun (list #'checkdoc-this-string-valid
+ (lambda () (checkdoc-message-text-search beg end))
+ (lambda () (checkdoc-rogue-space-check-engine beg end))))
+ (let ((msg (funcall fun)))
+ (if msg (if no-error
+ (message "%s" (checkdoc-error-text msg))
+ (user-error "%s" (checkdoc-error-text msg))))))
(if (called-interactively-p 'interactive)
(message "Checkdoc: done."))))))
(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
-(add-to-list 'debug-ignored-errors
- "Argument `.*' should appear (as .*) in the doc string")
-(add-to-list 'debug-ignored-errors
- "Lisp symbol `.*' should appear in quotes")
-(add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*")
-
(provide 'checkdoc)
;;; checkdoc.el ends here
-;;; cl-extra.el --- Common Lisp features, part 2
+;;; cl-extra.el --- Common Lisp features, part 2 -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2000-2012 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: extensions
;;; Code:
-(require 'cl)
+(require 'cl-lib)
;;; Type coercion.
;;;###autoload
-(defun coerce (x type)
+(defun cl-coerce (x type)
"Coerce OBJECT to type TYPE.
TYPE is a Common Lisp type specifier.
\n(fn OBJECT TYPE)"
((eq type 'string) (if (stringp x) x (concat x)))
((eq type 'array) (if (arrayp x) x (vconcat x)))
((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0))
- ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type))
+ ((and (eq type 'character) (symbolp x)) (cl-coerce (symbol-name x) type))
((eq type 'float) (float x))
- ((typep x type) x)
+ ((cl-typep x type) x)
(t (error "Can't coerce %s to type %s" x type))))
;;; Predicates.
;;;###autoload
-(defun equalp (x y)
+(defun cl-equalp (x y)
"Return t if two Lisp objects have similar structures and contents.
This is like `equal', except that it accepts numerically equal
numbers of different types (float vs. integer), and also compares
((numberp x)
(and (numberp y) (= x y)))
((consp x)
- (while (and (consp x) (consp y) (equalp (car x) (car y)))
+ (while (and (consp x) (consp y) (cl-equalp (car x) (car y)))
(setq x (cdr x) y (cdr y)))
- (and (not (consp x)) (equalp x y)))
+ (and (not (consp x)) (cl-equalp x y)))
((vectorp x)
(and (vectorp y) (= (length x) (length y))
(let ((i (length x)))
(while (and (>= (setq i (1- i)) 0)
- (equalp (aref x i) (aref y i))))
+ (cl-equalp (aref x i) (aref y i))))
(< i 0))))
(t (equal x y))))
;;; Control structures.
;;;###autoload
-(defun cl-mapcar-many (cl-func cl-seqs)
+(defun cl--mapcar-many (cl-func cl-seqs)
(if (cdr (cdr cl-seqs))
(let* ((cl-res nil)
(cl-n (apply 'min (mapcar 'length cl-seqs)))
(cl-i -1))
(while (< (setq cl-i (1+ cl-i)) cl-n)
(push (funcall cl-func
- (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
- (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
- cl-res)))
+ (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
+ (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
+ cl-res)))
(nreverse cl-res))))
;;;###autoload
-(defun map (cl-type cl-func cl-seq &rest cl-rest)
+(defun cl-map (cl-type cl-func cl-seq &rest cl-rest)
"Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
TYPE is the sequence type to return.
\n(fn TYPE FUNCTION SEQUENCE...)"
- (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
- (and cl-type (coerce cl-res cl-type))))
+ (let ((cl-res (apply 'cl-mapcar cl-func cl-seq cl-rest)))
+ (and cl-type (cl-coerce cl-res cl-type))))
;;;###autoload
-(defun maplist (cl-func cl-list &rest cl-rest)
+(defun cl-maplist (cl-func cl-list &rest cl-rest)
"Map FUNCTION to each sublist of LIST or LISTs.
Like `mapcar', except applies to lists and their cdr's rather than to
the elements themselves.
"Like `mapcar', but does not accumulate values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
(if cl-rest
- (progn (apply 'map nil cl-func cl-seq cl-rest)
+ (progn (apply 'cl-map nil cl-func cl-seq cl-rest)
cl-seq)
(mapc cl-func cl-seq)))
;;;###autoload
-(defun mapl (cl-func cl-list &rest cl-rest)
- "Like `maplist', but does not accumulate values returned by the function.
+(defun cl-mapl (cl-func cl-list &rest cl-rest)
+ "Like `cl-maplist', but does not accumulate values returned by the function.
\n(fn FUNCTION LIST...)"
(if cl-rest
- (apply 'maplist cl-func cl-list cl-rest)
+ (apply 'cl-maplist cl-func cl-list cl-rest)
(let ((cl-p cl-list))
(while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p)))))
cl-list)
;;;###autoload
-(defun mapcan (cl-func cl-seq &rest cl-rest)
+(defun cl-mapcan (cl-func cl-seq &rest cl-rest)
"Like `mapcar', but nconc's together the values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
- (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
+ (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest)))
;;;###autoload
-(defun mapcon (cl-func cl-list &rest cl-rest)
- "Like `maplist', but nconc's together the values returned by the function.
+(defun cl-mapcon (cl-func cl-list &rest cl-rest)
+ "Like `cl-maplist', but nconc's together the values returned by the function.
\n(fn FUNCTION LIST...)"
- (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
+ (apply 'nconc (apply 'cl-maplist cl-func cl-list cl-rest)))
;;;###autoload
-(defun some (cl-pred cl-seq &rest cl-rest)
+(defun cl-some (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is true of any element of SEQ or SEQs.
If so, return the true (non-nil) value returned by PREDICATE.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-some
- (apply 'map nil
+ (apply 'cl-map nil
(function (lambda (&rest cl-x)
(let ((cl-res (apply cl-pred cl-x)))
(if cl-res (throw 'cl-some cl-res)))))
cl-x)))
;;;###autoload
-(defun every (cl-pred cl-seq &rest cl-rest)
+(defun cl-every (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is true of every element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-every
- (apply 'map nil
+ (apply 'cl-map nil
(function (lambda (&rest cl-x)
(or (apply cl-pred cl-x) (throw 'cl-every nil))))
cl-seq cl-rest) t)
(null cl-seq)))
;;;###autoload
-(defun notany (cl-pred cl-seq &rest cl-rest)
+(defun cl-notany (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is false of every element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
- (not (apply 'some cl-pred cl-seq cl-rest)))
+ (not (apply 'cl-some cl-pred cl-seq cl-rest)))
;;;###autoload
-(defun notevery (cl-pred cl-seq &rest cl-rest)
+(defun cl-notevery (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is false of some element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
- (not (apply 'every cl-pred cl-seq cl-rest)))
+ (not (apply 'cl-every cl-pred cl-seq cl-rest)))
-;;; Support for `loop'.
;;;###autoload
-(defalias 'cl-map-keymap 'map-keymap)
-
-;;;###autoload
-(defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
+(defun cl--map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
(or cl-base
(setq cl-base (copy-sequence [0])))
(map-keymap
(lambda (cl-key cl-bind)
(aset cl-base (1- (length cl-base)) cl-key)
(if (keymapp cl-bind)
- (cl-map-keymap-recursively
+ (cl--map-keymap-recursively
cl-func-rec cl-bind
(vconcat cl-base (list 0)))
(funcall cl-func-rec cl-base cl-bind))))
cl-map))
;;;###autoload
-(defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
+(defun cl--map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
(or cl-what (setq cl-what (current-buffer)))
(if (bufferp cl-what)
(let (cl-mark cl-mark2 (cl-next t) cl-next2)
(setq cl-start cl-next)))))
;;;###autoload
-(defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
+(defun cl--map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
(or cl-buffer (setq cl-buffer (current-buffer)))
(if (fboundp 'overlay-lists)
;;; Support for `setf'.
;;;###autoload
-(defun cl-set-frame-visible-p (frame val)
+(defun cl--set-frame-visible-p (frame val)
(cond ((null val) (make-frame-invisible frame))
((eq val 'icon) (iconify-frame frame))
(t (make-frame-visible frame)))
val)
-;;; Support for `progv'.
-(defvar cl-progv-save)
-;;;###autoload
-(defun cl-progv-before (syms values)
- (while syms
- (push (if (boundp (car syms))
- (cons (car syms) (symbol-value (car syms)))
- (car syms)) cl-progv-save)
- (if values
- (set (pop syms) (pop values))
- (makunbound (pop syms)))))
-
-(defun cl-progv-after ()
- (while cl-progv-save
- (if (consp (car cl-progv-save))
- (set (car (car cl-progv-save)) (cdr (car cl-progv-save)))
- (makunbound (car cl-progv-save)))
- (pop cl-progv-save)))
-
;;; Numbers.
;;;###autoload
-(defun gcd (&rest args)
+(defun cl-gcd (&rest args)
"Return the greatest common divisor of the arguments."
(let ((a (abs (or (pop args) 0))))
(while args
a))
;;;###autoload
-(defun lcm (&rest args)
+(defun cl-lcm (&rest args)
"Return the least common multiple of the arguments."
(if (memq 0 args)
0
(let ((a (abs (or (pop args) 1))))
(while args
(let ((b (abs (pop args))))
- (setq a (* (/ a (gcd a b)) b))))
+ (setq a (* (/ a (cl-gcd a b)) b))))
a)))
;;;###autoload
-(defun isqrt (x)
+(defun cl-isqrt (x)
"Return the integer square root of the argument."
(if (and (integerp x) (> x 0))
(let ((g (cond ((<= x 100) 10) ((<= x 10000) 100)
(if (eq x 0) 0 (signal 'arith-error nil))))
;;;###autoload
-(defun floor* (x &optional y)
+(defun cl-floor (x &optional y)
"Return a list of the floor of X and the fractional part of X.
With two arguments, return floor and remainder of their quotient."
(let ((q (floor x y)))
(list q (- x (if y (* y q) q)))))
;;;###autoload
-(defun ceiling* (x &optional y)
+(defun cl-ceiling (x &optional y)
"Return a list of the ceiling of X and the fractional part of X.
With two arguments, return ceiling and remainder of their quotient."
- (let ((res (floor* x y)))
+ (let ((res (cl-floor x y)))
(if (= (car (cdr res)) 0) res
(list (1+ (car res)) (- (car (cdr res)) (or y 1))))))
;;;###autoload
-(defun truncate* (x &optional y)
+(defun cl-truncate (x &optional y)
"Return a list of the integer part of X and the fractional part of X.
With two arguments, return truncation and remainder of their quotient."
(if (eq (>= x 0) (or (null y) (>= y 0)))
- (floor* x y) (ceiling* x y)))
+ (cl-floor x y) (cl-ceiling x y)))
;;;###autoload
-(defun round* (x &optional y)
+(defun cl-round (x &optional y)
"Return a list of X rounded to the nearest integer and the remainder.
With two arguments, return rounding and remainder of their quotient."
(if y
(if (and (integerp x) (integerp y))
(let* ((hy (/ y 2))
- (res (floor* (+ x hy) y)))
+ (res (cl-floor (+ x hy) y)))
(if (and (= (car (cdr res)) 0)
(= (+ hy hy) y)
(/= (% (car res) 2) 0))
(list q (- x q))))))
;;;###autoload
-(defun mod* (x y)
+(defun cl-mod (x y)
"The remainder of X divided by Y, with the same sign as Y."
- (nth 1 (floor* x y)))
+ (nth 1 (cl-floor x y)))
;;;###autoload
-(defun rem* (x y)
+(defun cl-rem (x y)
"The remainder of X divided by Y, with the same sign as X."
- (nth 1 (truncate* x y)))
+ (nth 1 (cl-truncate x y)))
;;;###autoload
-(defun signum (x)
+(defun cl-signum (x)
"Return 1 if X is positive, -1 if negative, 0 if zero."
(cond ((> x 0) 1) ((< x 0) -1) (t 0)))
;; Random numbers.
-(defvar *random-state*)
;;;###autoload
-(defun random* (lim &optional state)
+(defun cl-random (lim &optional state)
"Return a random nonnegative number less than LIM, an integer or float.
Optional second arg STATE is a random-state object."
- (or state (setq state *random-state*))
+ (or state (setq state cl--random-state))
;; Inspired by "ran3" from Numerical Recipes. Additive congruential method.
(let ((vec (aref state 3)))
(if (integerp vec)
(aset vec 0 j)
(while (> (setq i (% (+ i 21) 55)) 0)
(aset vec i (setq j (prog1 k (setq k (- j k))))))
- (while (< (setq i (1+ i)) 200) (random* 2 state))))
+ (while (< (setq i (1+ i)) 200) (cl-random 2 state))))
(let* ((i (aset state 1 (% (1+ (aref state 1)) 55)))
(j (aset state 2 (% (1+ (aref state 2)) 55)))
(n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j))))))
(if (integerp lim)
(if (<= lim 512) (% n lim)
- (if (> lim 8388607) (setq n (+ (lsh n 9) (random* 512 state))))
+ (if (> lim 8388607) (setq n (+ (lsh n 9) (cl-random 512 state))))
(let ((mask 1023))
(while (< mask (1- lim)) (setq mask (1+ (+ mask mask))))
- (if (< (setq n (logand n mask)) lim) n (random* lim state))))
+ (if (< (setq n (logand n mask)) lim) n (cl-random lim state))))
(* (/ n '8388608e0) lim)))))
;;;###autoload
-(defun make-random-state (&optional state)
- "Return a copy of random-state STATE, or of `*random-state*' if omitted.
+(defun cl-make-random-state (&optional state)
+ "Return a copy of random-state STATE, or of the internal state if omitted.
If STATE is t, return a new state object seeded from the time of day."
- (cond ((null state) (make-random-state *random-state*))
- ((vectorp state) (cl-copy-tree state t))
+ (cond ((null state) (cl-make-random-state cl--random-state))
+ ((vectorp state) (copy-tree state t))
((integerp state) (vector 'cl-random-state-tag -1 30 state))
- (t (make-random-state (cl-random-time)))))
+ (t (cl-make-random-state (cl-random-time)))))
;;;###autoload
-(defun random-state-p (object)
+(defun cl-random-state-p (object)
"Return t if OBJECT is a random-state object."
(and (vectorp object) (= (length object) 4)
(eq (aref object 0) 'cl-random-state-tag)))
;; Implementation limits.
-(defun cl-finite-do (func a b)
- (condition-case err
+(defun cl--finite-do (func a b)
+ (condition-case _
(let ((res (funcall func a b))) ; check for IEEE infinity
(and (numberp res) (/= res (/ res 2)) res))
(arith-error nil)))
;;;###autoload
(defun cl-float-limits ()
"Initialize the Common Lisp floating-point parameters.
-This sets the values of: `most-positive-float', `most-negative-float',
-`least-positive-float', `least-negative-float', `float-epsilon',
-`float-negative-epsilon', `least-positive-normalized-float', and
-`least-negative-normalized-float'."
- (or most-positive-float (not (numberp '2e1))
+This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
+`cl-least-positive-float', `cl-least-negative-float', `cl-float-epsilon',
+`cl-float-negative-epsilon', `cl-least-positive-normalized-float', and
+`cl-least-negative-normalized-float'."
+ (or cl-most-positive-float (not (numberp '2e1))
(let ((x '2e0) y z)
;; Find maximum exponent (first two loops are optimizations)
- (while (cl-finite-do '* x x) (setq x (* x x)))
- (while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2))))
- (while (cl-finite-do '+ x x) (setq x (+ x x)))
+ (while (cl--finite-do '* x x) (setq x (* x x)))
+ (while (cl--finite-do '* x (/ x 2)) (setq x (* x (/ x 2))))
+ (while (cl--finite-do '+ x x) (setq x (+ x x)))
(setq z x y (/ x 2))
- ;; Now fill in 1's in the mantissa.
- (while (and (cl-finite-do '+ x y) (/= (+ x y) x))
+ ;; Now cl-fill in 1's in the mantissa.
+ (while (and (cl--finite-do '+ x y) (/= (+ x y) x))
(setq x (+ x y) y (/ y 2)))
- (setq most-positive-float x
- most-negative-float (- x))
+ (setq cl-most-positive-float x
+ cl-most-negative-float (- x))
;; Divide down until mantissa starts rounding.
(setq x (/ x z) y (/ 16 z) x (* x y))
- (while (condition-case err (and (= x (* (/ x 2) 2)) (> (/ y 2) 0))
+ (while (condition-case _ (and (= x (* (/ x 2) 2)) (> (/ y 2) 0))
(arith-error nil))
(setq x (/ x 2) y (/ y 2)))
- (setq least-positive-normalized-float y
- least-negative-normalized-float (- y))
+ (setq cl-least-positive-normalized-float y
+ cl-least-negative-normalized-float (- y))
;; Divide down until value underflows to zero.
(setq x (/ 1 z) y x)
- (while (condition-case err (> (/ x 2) 0) (arith-error nil))
+ (while (condition-case _ (> (/ x 2) 0) (arith-error nil))
(setq x (/ x 2)))
- (setq least-positive-float x
- least-negative-float (- x))
+ (setq cl-least-positive-float x
+ cl-least-negative-float (- x))
(setq x '1e0)
(while (/= (+ '1e0 x) '1e0) (setq x (/ x 2)))
- (setq float-epsilon (* x 2))
+ (setq cl-float-epsilon (* x 2))
(setq x '1e0)
(while (/= (- '1e0 x) '1e0) (setq x (/ x 2)))
- (setq float-negative-epsilon (* x 2))))
+ (setq cl-float-negative-epsilon (* x 2))))
nil)
;;; Sequence functions.
;;;###autoload
-(defun subseq (seq start &optional end)
+(defun cl-subseq (seq start &optional end)
"Return the subsequence of SEQ from START to END.
If END is omitted, it defaults to the length of the sequence.
If START or END is negative, it counts from the end."
+ (declare (gv-setter
+ (lambda (new)
+ `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end)
+ ,new))))
(if (stringp seq) (substring seq start end)
(let (len)
(and end (< end 0) (setq end (+ end (setq len (length seq)))))
res))))))
;;;###autoload
-(defun concatenate (type &rest seqs)
+(defun cl-concatenate (type &rest seqs)
"Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
\n(fn TYPE SEQUENCE...)"
(cond ((eq type 'vector) (apply 'vconcat seqs))
;;; List functions.
;;;###autoload
-(defun revappend (x y)
+(defun cl-revappend (x y)
"Equivalent to (append (reverse X) Y)."
(nconc (reverse x) y))
;;;###autoload
-(defun nreconc (x y)
+(defun cl-nreconc (x y)
"Equivalent to (nconc (nreverse X) Y)."
(nconc (nreverse x) y))
;;;###autoload
-(defun list-length (x)
+(defun cl-list-length (x)
"Return the length of list X. Return nil if list is circular."
(let ((n 0) (fast x) (slow x))
(while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
(if fast (if (cdr fast) nil (1+ n)) n)))
;;;###autoload
-(defun tailp (sublist list)
+(defun cl-tailp (sublist list)
"Return true if SUBLIST is a tail of LIST."
(while (and (consp list) (not (eq sublist list)))
(setq list (cdr list)))
(if (numberp sublist) (equal sublist list) (eq sublist list)))
-(defalias 'cl-copy-tree 'copy-tree)
-
-
;;; Property lists.
;;;###autoload
-(defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el
+(defun cl-get (sym tag &optional def)
"Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
\n(fn SYMBOL PROPNAME &optional DEFAULT)"
+ (declare (compiler-macro cl--compiler-macro-get)
+ (gv-setter (lambda (store) `(put ,sym ,tag ,store))))
(or (get sym tag)
(and def
+ ;; Make sure `def' is really absent as opposed to set to nil.
(let ((plist (symbol-plist sym)))
(while (and plist (not (eq (car plist) tag)))
(setq plist (cdr (cdr plist))))
(if plist (car (cdr plist)) def)))))
+(autoload 'cl--compiler-macro-get "cl-macs")
;;;###autoload
-(defun getf (plist tag &optional def)
+(defun cl-getf (plist tag &optional def)
"Search PROPLIST for property PROPNAME; return its value or DEFAULT.
PROPLIST is a list of the sort returned by `symbol-plist'.
\n(fn PROPLIST PROPNAME &optional DEFAULT)"
+ (declare (gv-expander
+ (lambda (do)
+ (gv-letplace (getter setter) plist
+ (macroexp-let2 nil k tag
+ (macroexp-let2 nil d def
+ (funcall do `(cl-getf ,getter ,k ,d)
+ (lambda (v)
+ (funcall setter
+ `(cl--set-getf ,getter ,k ,v))))))))))
(setplist '--cl-getf-symbol-- plist)
(or (get '--cl-getf-symbol-- tag)
- ;; Originally we called get* here,
- ;; but that fails, because get* has a compiler macro
+ ;; Originally we called cl-get here,
+ ;; but that fails, because cl-get has a compiler macro
;; definition that uses getf!
(when def
+ ;; Make sure `def' is really absent as opposed to set to nil.
(while (and plist (not (eq (car plist) tag)))
(setq plist (cdr (cdr plist))))
(if plist (car (cdr plist)) def))))
;;;###autoload
-(defun cl-set-getf (plist tag val)
+(defun cl--set-getf (plist tag val)
(let ((p plist))
(while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
- (if p (progn (setcar (cdr p) val) plist) (list* tag val plist))))
+ (if p (progn (setcar (cdr p) val) plist) (cl-list* tag val plist))))
;;;###autoload
-(defun cl-do-remf (plist tag)
+(defun cl--do-remf (plist tag)
(let ((p (cdr plist)))
(while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
(and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
(let ((plist (symbol-plist sym)))
(if (and plist (eq tag (car plist)))
(progn (setplist sym (cdr (cdr plist))) t)
- (cl-do-remf plist tag))))
-;;;###autoload
-(defalias 'remprop 'cl-remprop)
-
-
-
-;;; 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)
- (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x))))
-
-(defvar cl-builtin-gethash (symbol-function 'gethash))
-(defvar cl-builtin-remhash (symbol-function 'remhash))
-(defvar cl-builtin-clrhash (symbol-function 'clrhash))
-(defvar cl-builtin-maphash (symbol-function 'maphash))
-
-;;;###autoload
-(defalias 'cl-gethash 'gethash)
-;;;###autoload
-(defalias 'cl-puthash 'puthash)
-;;;###autoload
-(defalias 'cl-remhash 'remhash)
-;;;###autoload
-(defalias 'cl-clrhash 'clrhash)
-;;;###autoload
-(defalias 'cl-maphash 'maphash)
-;; These three actually didn't exist in Emacs-20.
-;;;###autoload
-(defalias 'cl-make-hash-table 'make-hash-table)
-;;;###autoload
-(defalias 'cl-hash-table-p 'hash-table-p)
-;;;###autoload
-(defalias 'cl-hash-table-count 'hash-table-count)
+ (cl--do-remf plist tag))))
;;; Some debugging aids.
(forward-sexp)
(delete-char 1))
(goto-char (1+ pt))
- (cl-do-prettyprint)))
+ (cl--do-prettyprint)))
-(defun cl-do-prettyprint ()
+(defun cl--do-prettyprint ()
(skip-chars-forward " ")
(if (looking-at "(")
(let ((skip (or (looking-at "((") (looking-at "(prog")
(looking-at "(unwind-protect ")
(looking-at "(function (")
- (looking-at "(cl-block-wrapper ")))
+ (looking-at "(cl--block-wrapper ")))
(two (or (looking-at "(defun ") (looking-at "(defmacro ")))
(let (or (looking-at "(let\\*? ") (looking-at "(while ")))
(set (looking-at "(p?set[qf] ")))
(and (>= (current-column) 78) (progn (backward-sexp) t))))
(let ((nl t))
(forward-char 1)
- (cl-do-prettyprint)
- (or skip (looking-at ")") (cl-do-prettyprint))
- (or (not two) (looking-at ")") (cl-do-prettyprint))
+ (cl--do-prettyprint)
+ (or skip (looking-at ")") (cl--do-prettyprint))
+ (or (not two) (looking-at ")") (cl--do-prettyprint))
(while (not (looking-at ")"))
(if set (setq nl (not nl)))
(if nl (insert "\n"))
(lisp-indent-line)
- (cl-do-prettyprint))
+ (cl--do-prettyprint))
(forward-char 1))))
(forward-sexp)))
-(defvar cl-macroexpand-cmacs nil)
-(defvar cl-closure-vars nil)
-
-;;;###autoload
-(defun cl-macroexpand-all (form &optional env)
- "Expand all macro calls through a Lisp FORM.
-This also does some trivial optimizations to make the form prettier."
- (while (or (not (eq form (setq form (macroexpand form env))))
- (and cl-macroexpand-cmacs
- (not (eq form (setq form (compiler-macroexpand form)))))))
- (cond ((not (consp form)) form)
- ((memq (car form) '(let let*))
- (if (null (nth 1 form))
- (cl-macroexpand-all (cons 'progn (cddr form)) env)
- (let ((letf nil) (res nil) (lets (cadr form)))
- (while lets
- (push (if (consp (car lets))
- (let ((exp (cl-macroexpand-all (caar lets) env)))
- (or (symbolp exp) (setq letf t))
- (cons exp (cl-macroexpand-body (cdar lets) env)))
- (let ((exp (cl-macroexpand-all (car lets) env)))
- (if (symbolp exp) exp
- (setq letf t) (list exp nil)))) res)
- (setq lets (cdr lets)))
- (list* (if letf (if (eq (car form) 'let) 'letf 'letf*) (car form))
- (nreverse res) (cl-macroexpand-body (cddr form) env)))))
- ((eq (car form) 'cond)
- (cons (car form)
- (mapcar (function (lambda (x) (cl-macroexpand-body x env)))
- (cdr form))))
- ((eq (car form) 'condition-case)
- (list* (car form) (nth 1 form) (cl-macroexpand-all (nth 2 form) env)
- (mapcar (function
- (lambda (x)
- (cons (car x) (cl-macroexpand-body (cdr x) env))))
- (cdddr form))))
- ((memq (car form) '(quote function))
- (if (eq (car-safe (nth 1 form)) 'lambda)
- (let ((body (cl-macroexpand-body (cddadr form) env)))
- (if (and cl-closure-vars (eq (car form) 'function)
- (cl-expr-contains-any body cl-closure-vars))
- (let* ((new (mapcar 'gensym cl-closure-vars))
- (sub (pairlis cl-closure-vars new)) (decls nil))
- (while (or (stringp (car body))
- (eq (car-safe (car body)) 'interactive))
- (push (list 'quote (pop body)) decls))
- (put (car (last cl-closure-vars)) 'used t)
- `(list 'lambda '(&rest --cl-rest--)
- ,@(sublis sub (nreverse decls))
- (list 'apply
- (list 'quote
- #'(lambda ,(append new (cadadr form))
- ,@(sublis sub body)))
- ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
- cl-closure-vars)
- '((quote --cl-rest--))))))
- (list (car form) (list* 'lambda (cadadr form) body))))
- (let ((found (assq (cadr form) env)))
- (if (and found (ignore-errors
- (eq (cadr (caddr found)) 'cl-labels-args)))
- (cl-macroexpand-all (cadr (caddr (cadddr found))) env)
- form))))
- ((memq (car form) '(defun defmacro))
- (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env)))
- ((and (eq (car form) 'progn) (not (cddr form)))
- (cl-macroexpand-all (nth 1 form) env))
- ((eq (car form) 'setq)
- (let* ((args (cl-macroexpand-body (cdr form) env)) (p args))
- (while (and p (symbolp (car p))) (setq p (cddr p)))
- (if p (cl-macroexpand-all (cons 'setf args)) (cons 'setq args))))
- ((consp (car form))
- (cl-macroexpand-all (list* 'funcall
- (list 'function (car form))
- (cdr form))
- env))
- (t (cons (car form) (cl-macroexpand-body (cdr form) env)))))
-
-(defun cl-macroexpand-body (body &optional env)
- (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body))
-
;;;###autoload
(defun cl-prettyexpand (form &optional full)
(message "Expanding...")
- (let ((cl-macroexpand-cmacs full) (cl-compiling-file full)
+ (let ((cl--compiling-file full)
(byte-compile-macro-environment nil))
- (setq form (cl-macroexpand-all form
- (and (not full) '((block) (eval-when)))))
+ (setq form (macroexpand-all form
+ (and (not full) '((cl-block) (cl-eval-when)))))
(message "Formatting...")
(prog1 (cl-prettyprint form)
(message ""))))
--- /dev/null
+;;; cl-lib.el --- Common Lisp extensions for Emacs -*- lexical-binding: t -*-
+
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
+
+;; Author: Dave Gillespie <daveg@synaptics.com>
+;; Version: 2.02
+;; Keywords: extensions
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; These are extensions to Emacs Lisp that provide a degree of
+;; Common Lisp compatibility, beyond what is already built-in
+;; in Emacs Lisp.
+;;
+;; This package was written by Dave Gillespie; it is a complete
+;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
+;;
+;; Bug reports, comments, and suggestions are welcome!
+
+;; This file contains the portions of the Common Lisp extensions
+;; package which should always be present.
+
+
+;;; Future notes:
+
+;; Once Emacs 19 becomes standard, many things in this package which are
+;; messy for reasons of compatibility can be greatly simplified. For now,
+;; I prefer to maintain one unified version.
+
+
+;;; Change Log:
+
+;; Version 2.02 (30 Jul 93):
+;; * Added "cl-compat.el" file, extra compatibility with old package.
+;; * Added `lexical-let' and `lexical-let*'.
+;; * Added `define-modify-macro', `callf', and `callf2'.
+;; * Added `ignore-errors'.
+;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.
+;; * Merged `*gentemp-counter*' into `*gensym-counter*'.
+;; * Extended `subseq' to allow negative START and END like `substring'.
+;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses.
+;; * Added `concat', `vconcat' loop clauses.
+;; * Cleaned up a number of compiler warnings.
+
+;; Version 2.01 (7 Jul 93):
+;; * Added support for FSF version of Emacs 19.
+;; * Added `add-hook' for Emacs 18 users.
+;; * Added `defsubst*' and `symbol-macrolet'.
+;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.
+;; * Added `map', `concatenate', `reduce', `merge'.
+;; * Added `revappend', `nreconc', `tailp', `tree-equal'.
+;; * Added `assert', `check-type', `typecase', `typep', and `deftype'.
+;; * Added destructuring and `&environment' support to `defmacro*'.
+;; * Added destructuring to `loop', and added the following clauses:
+;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.
+;; * Renamed `delete' to `delete*' and `remove' to `remove*'.
+;; * Completed support for all keywords in `remove*', `substitute', etc.
+;; * Added `most-positive-float' and company.
+;; * Fixed hash tables to work with latest Lucid Emacs.
+;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.
+;; * Syntax for `warn' declarations has changed.
+;; * Improved implementation of `random*'.
+;; * Moved most sequence functions to a new file, cl-seq.el.
+;; * Moved `eval-when' into cl-macs.el.
+;; * Moved `pushnew' and `adjoin' to cl.el for most common cases.
+;; * Moved `provide' forms down to ends of files.
+;; * Changed expansion of `pop' to something that compiles to better code.
+;; * Changed so that no patch is required for Emacs 19 byte compiler.
+;; * Made more things dependent on `optimize' declarations.
+;; * Added a partial implementation of struct print functions.
+;; * Miscellaneous minor changes.
+
+;; Version 2.00:
+;; * First public release of this package.
+
+
+;;; Code:
+
+(require 'macroexp)
+
+(defvar cl-optimize-speed 1)
+(defvar cl-optimize-safety 1)
+
+;;;###autoload
+(define-obsolete-variable-alias
+ ;; This alias is needed for compatibility with .elc files that use defstruct
+ ;; and were compiled with Emacs<24.3.
+ 'custom-print-functions 'cl-custom-print-functions "24.3")
+
+;;;###autoload
+(defvar cl-custom-print-functions nil
+ "This is a list of functions that format user objects for printing.
+Each function is called in turn with three arguments: the object, the
+stream, and the print level (currently ignored). If it is able to
+print the object it returns true; otherwise it returns nil and the
+printer proceeds to the next function on the list.
+
+This variable is not used at present, but it is defined in hopes that
+a future Emacs interpreter will be able to use it.")
+
+(defun cl-unload-function ()
+ "Stop unloading of the Common Lisp extensions."
+ (message "Cannot unload the feature `cl'")
+ ;; Stop standard unloading!
+ t)
+
+;;; Generalized variables.
+;; These macros are defined here so that they
+;; can safely be used in init files.
+
+(defmacro cl-incf (place &optional x)
+ "Increment PLACE by X (1 by default).
+PLACE may be a symbol, or any generalized variable allowed by `setf'.
+The return value is the incremented value of PLACE."
+ (declare (debug (place &optional form)))
+ (if (symbolp place)
+ (list 'setq place (if x (list '+ place x) (list '1+ place)))
+ (list 'cl-callf '+ place (or x 1))))
+
+(defmacro cl-decf (place &optional x)
+ "Decrement PLACE by X (1 by default).
+PLACE may be a symbol, or any generalized variable allowed by `setf'.
+The return value is the decremented value of PLACE."
+ (declare (debug cl-incf))
+ (if (symbolp place)
+ (list 'setq place (if x (list '- place x) (list '1- place)))
+ (list 'cl-callf '- place (or x 1))))
+
+(defmacro cl-pushnew (x place &rest keys)
+ "(cl-pushnew X PLACE): insert X at the head of the list if not already there.
+Like (push X PLACE), except that the list is unmodified if X is `eql' to
+an element already on the list.
+\nKeywords supported: :test :test-not :key
+\n(fn X PLACE [KEYWORD VALUE]...)"
+ (declare (debug
+ (form place &rest
+ &or [[&or ":test" ":test-not" ":key"] function-form]
+ [keywordp form])))
+ (if (symbolp place)
+ (if (null keys)
+ (macroexp-let2 nil var x
+ `(if (memql ,var ,place)
+ ;; This symbol may later on expand to actual code which then
+ ;; trigger warnings like "value unused" since cl-pushnew's
+ ;; return value is rarely used. It should not matter that
+ ;; other warnings may be silenced, since `place' is used
+ ;; earlier and should have triggered them already.
+ (with-no-warnings ,place)
+ (setq ,place (cons ,var ,place))))
+ (list 'setq place (cl-list* 'cl-adjoin x place keys)))
+ (cl-list* 'cl-callf2 'cl-adjoin x place keys)))
+
+(defun cl--set-elt (seq n val)
+ (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
+
+(defun cl--set-buffer-substring (start end val)
+ (save-excursion (delete-region start end)
+ (goto-char start)
+ (insert val)
+ val))
+
+(defun cl--set-substring (str start end val)
+ (if end (if (< end 0) (cl-incf end (length str)))
+ (setq end (length str)))
+ (if (< start 0) (cl-incf start (length str)))
+ (concat (and (> start 0) (substring str 0 start))
+ val
+ (and (< end (length str)) (substring str end))))
+
+
+;;; Blocks and exits.
+
+(defalias 'cl--block-wrapper 'identity)
+(defalias 'cl--block-throw 'throw)
+
+
+;;; Multiple values.
+;; True multiple values are not supported, or even
+;; simulated. Instead, cl-multiple-value-bind and friends simply expect
+;; the target form to return the values as a list.
+
+(defun cl--defalias (cl-f el-f &optional doc)
+ (defalias cl-f el-f doc)
+ (put cl-f 'byte-optimizer 'byte-compile-inline-expand))
+
+(cl--defalias 'cl-values #'list
+ "Return multiple values, Common Lisp style.
+The arguments of `cl-values' are the values
+that the containing function should return.
+
+\(fn &rest VALUES)")
+
+(cl--defalias 'cl-values-list #'identity
+ "Return multiple values, Common Lisp style, taken from a list.
+LIST specifies the list of values
+that the containing function should return.
+
+\(fn LIST)")
+
+(defsubst cl-multiple-value-list (expression)
+ "Return a list of the multiple values produced by EXPRESSION.
+This handles multiple values in Common Lisp style, but it does not
+work right when EXPRESSION calls an ordinary Emacs Lisp function
+that returns just one value."
+ expression)
+
+(defsubst cl-multiple-value-apply (function expression)
+ "Evaluate EXPRESSION to get multiple values and apply FUNCTION to them.
+This handles multiple values in Common Lisp style, but it does not work
+right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
+one value."
+ (apply function expression))
+
+(defalias 'cl-multiple-value-call 'apply
+ "Apply FUNCTION to ARGUMENTS, taking multiple values into account.
+This implementation only handles the case where there is only one argument.")
+
+(cl--defalias 'cl-nth-value #'nth
+ "Evaluate EXPRESSION to get multiple values and return the Nth one.
+This handles multiple values in Common Lisp style, but it does not work
+right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
+one value.
+
+\(fn N EXPRESSION)")
+
+;;; Declarations.
+
+(defvar cl--compiling-file nil)
+(defun cl--compiling-file ()
+ (or cl--compiling-file
+ (and (boundp 'byte-compile--outbuffer)
+ (bufferp (symbol-value 'byte-compile--outbuffer))
+ (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
+ " *Compiler Output*"))))
+
+(defvar cl-proclaims-deferred nil)
+
+(defun cl-proclaim (spec)
+ (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
+ (push spec cl-proclaims-deferred))
+ nil)
+
+(defmacro cl-declaim (&rest specs)
+ (let ((body (mapcar (function (lambda (x) (list 'cl-proclaim (list 'quote x))))
+ specs)))
+ (if (cl--compiling-file) (cl-list* 'cl-eval-when '(compile load eval) body)
+ (cons 'progn body)))) ; avoid loading cl-macs.el for cl-eval-when
+
+
+;;; Symbols.
+
+(defun cl-random-time ()
+ (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
+ (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
+ v))
+
+(defvar cl--gensym-counter (* (logand (cl-random-time) 1023) 100))
+
+
+;;; Numbers.
+
+(defun cl-floatp-safe (object)
+ "Return t if OBJECT is a floating point number.
+On Emacs versions that lack floating-point support, this function
+always returns nil."
+ (and (numberp object) (not (integerp object))))
+
+(defsubst cl-plusp (number)
+ "Return t if NUMBER is positive."
+ (> number 0))
+
+(defsubst cl-minusp (number)
+ "Return t if NUMBER is negative."
+ (< number 0))
+
+(defun cl-oddp (integer)
+ "Return t if INTEGER is odd."
+ (eq (logand integer 1) 1))
+
+(defun cl-evenp (integer)
+ "Return t if INTEGER is even."
+ (eq (logand integer 1) 0))
+
+(defvar cl--random-state (vector 'cl-random-state-tag -1 30 (cl-random-time)))
+
+(defconst cl-most-positive-float nil
+ "The largest value that a Lisp float can hold.
+If your system supports infinities, this is the largest finite value.
+For IEEE machines, this is approximately 1.79e+308.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-most-negative-float nil
+ "The largest negative value that a Lisp float can hold.
+This is simply -`cl-most-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-positive-float nil
+ "The smallest value greater than zero that a Lisp float can hold.
+For IEEE machines, it is about 4.94e-324 if denormals are supported,
+or 2.22e-308 if they are not.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-negative-float nil
+ "The smallest value less than zero that a Lisp float can hold.
+This is simply -`cl-least-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-positive-normalized-float nil
+ "The smallest normalized Lisp float greater than zero.
+This is the smallest value for which IEEE denormalization does not lose
+precision. For IEEE machines, this value is about 2.22e-308.
+For machines that do not support the concept of denormalization
+and gradual underflow, this constant equals `cl-least-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-negative-normalized-float nil
+ "The smallest normalized Lisp float less than zero.
+This is simply -`cl-least-positive-normalized-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-float-epsilon nil
+ "The smallest positive float that adds to 1.0 to give a distinct value.
+Adding a number less than this to 1.0 returns 1.0 due to roundoff.
+For IEEE machines, epsilon is about 2.22e-16.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-float-negative-epsilon nil
+ "The smallest positive float that subtracts from 1.0 to give a distinct value.
+For IEEE machines, it is about 1.11e-16.
+Call `cl-float-limits' to set this.")
+
+
+;;; Sequence functions.
+
+(cl--defalias 'cl-copy-seq 'copy-sequence)
+
+(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs))
+
+(defun cl-mapcar (cl-func cl-x &rest cl-rest)
+ "Apply FUNCTION to each element of SEQ, and make a list of the results.
+If there are several SEQs, FUNCTION is called with that many arguments,
+and mapping stops as soon as the shortest list runs out. With just one
+SEQ, this is like `mapcar'. With several, it is like the Common Lisp
+`mapcar' function extended to arbitrary sequence types.
+\n(fn FUNCTION SEQ...)"
+ (if cl-rest
+ (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
+ (cl--mapcar-many cl-func (cons cl-x cl-rest))
+ (let ((cl-res nil) (cl-y (car cl-rest)))
+ (while (and cl-x cl-y)
+ (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
+ (nreverse cl-res)))
+ (mapcar cl-func cl-x)))
+
+(cl--defalias 'cl-svref 'aref)
+
+;;; List functions.
+
+(cl--defalias 'cl-first 'car)
+(cl--defalias 'cl-second 'cadr)
+(cl--defalias 'cl-rest 'cdr)
+(cl--defalias 'cl-endp 'null)
+
+(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.")
+(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.")
+
+(defsubst cl-fifth (x)
+ "Return the fifth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 4 ,x) ,store))))
+ (nth 4 x))
+
+(defsubst cl-sixth (x)
+ "Return the sixth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 5 ,x) ,store))))
+ (nth 5 x))
+
+(defsubst cl-seventh (x)
+ "Return the seventh element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 6 ,x) ,store))))
+ (nth 6 x))
+
+(defsubst cl-eighth (x)
+ "Return the eighth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 7 ,x) ,store))))
+ (nth 7 x))
+
+(defsubst cl-ninth (x)
+ "Return the ninth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 8 ,x) ,store))))
+ (nth 8 x))
+
+(defsubst cl-tenth (x)
+ "Return the tenth element of the list X."
+ (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
+ (nth 9 x))
+
+(defun cl-caaar (x)
+ "Return the `car' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (car x))))
+
+(defun cl-caadr (x)
+ "Return the `car' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (cdr x))))
+
+(defun cl-cadar (x)
+ "Return the `car' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (car x))))
+
+(defun cl-caddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (cdr x))))
+
+(defun cl-cdaar (x)
+ "Return the `cdr' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (car x))))
+
+(defun cl-cdadr (x)
+ "Return the `cdr' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (cdr x))))
+
+(defun cl-cddar (x)
+ "Return the `cdr' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (car x))))
+
+(defun cl-cdddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (cdr x))))
+
+(defun cl-caaaar (x)
+ "Return the `car' of the `car' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (car (car x)))))
+
+(defun cl-caaadr (x)
+ "Return the `car' of the `car' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (car (cdr x)))))
+
+(defun cl-caadar (x)
+ "Return the `car' of the `car' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (cdr (car x)))))
+
+(defun cl-caaddr (x)
+ "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (car (cdr (cdr x)))))
+
+(defun cl-cadaar (x)
+ "Return the `car' of the `cdr' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (car (car x)))))
+
+(defun cl-cadadr (x)
+ "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (car (cdr x)))))
+
+(defun cl-caddar (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (cdr (car x)))))
+
+(defun cl-cadddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (car (cdr (cdr (cdr x)))))
+
+(defun cl-cdaaar (x)
+ "Return the `cdr' of the `car' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (car (car x)))))
+
+(defun cl-cdaadr (x)
+ "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (car (cdr x)))))
+
+(defun cl-cdadar (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (cdr (car x)))))
+
+(defun cl-cdaddr (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (car (cdr (cdr x)))))
+
+(defun cl-cddaar (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (car (car x)))))
+
+(defun cl-cddadr (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (car (cdr x)))))
+
+(defun cl-cdddar (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (cdr (car x)))))
+
+(defun cl-cddddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro cl--compiler-macro-cXXr))
+ (cdr (cdr (cdr (cdr x)))))
+
+;;(defun last* (x &optional n)
+;; "Returns the last link in the list LIST.
+;;With optional argument N, returns Nth-to-last link (default 1)."
+;; (if n
+;; (let ((m 0) (p x))
+;; (while (consp p) (cl-incf m) (pop p))
+;; (if (<= n 0) p
+;; (if (< n m) (nthcdr (- m n) x) x)))
+;; (while (consp (cdr x)) (pop x))
+;; x))
+
+(defun cl-list* (arg &rest rest)
+ "Return a new list with specified ARGs as elements, consed to last ARG.
+Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
+`(cons A (cons B (cons C D)))'.
+\n(fn ARG...)"
+ (declare (compiler-macro cl--compiler-macro-list*))
+ (cond ((not rest) arg)
+ ((not (cdr rest)) (cons arg (car rest)))
+ (t (let* ((n (length rest))
+ (copy (copy-sequence rest))
+ (last (nthcdr (- n 2) copy)))
+ (setcdr last (car (cdr last)))
+ (cons arg copy)))))
+
+(defun cl-ldiff (list sublist)
+ "Return a copy of LIST with the tail SUBLIST removed."
+ (let ((res nil))
+ (while (and (consp list) (not (eq list sublist)))
+ (push (pop list) res))
+ (nreverse res)))
+
+(defun cl-copy-list (list)
+ "Return a copy of LIST, which may be a dotted list.
+The elements of LIST are not copied, just the list structure itself."
+ (if (consp list)
+ (let ((res nil))
+ (while (consp list) (push (pop list) res))
+ (prog1 (nreverse res) (setcdr res list)))
+ (car list)))
+
+;; Autoloaded, but we have not loaded cl-loaddefs yet.
+(declare-function cl-floor "cl-extra" (x &optional y))
+(declare-function cl-ceiling "cl-extra" (x &optional y))
+(declare-function cl-truncate "cl-extra" (x &optional y))
+(declare-function cl-round "cl-extra" (x &optional y))
+(declare-function cl-mod "cl-extra" (x y))
+
+(defun cl-adjoin (cl-item cl-list &rest cl-keys)
+ "Return ITEM consed onto the front of LIST only if it's not already there.
+Otherwise, return LIST unmodified.
+\nKeywords supported: :test :test-not :key
+\n(fn ITEM LIST [KEYWORD VALUE]...)"
+ (declare (compiler-macro cl--compiler-macro-adjoin))
+ (cond ((or (equal cl-keys '(:test eq))
+ (and (null cl-keys) (not (numberp cl-item))))
+ (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
+ ((or (equal cl-keys '(:test equal)) (null cl-keys))
+ (if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
+ (t (apply 'cl--adjoin cl-item cl-list cl-keys))))
+
+(defun cl-subst (cl-new cl-old cl-tree &rest cl-keys)
+ "Substitute NEW for OLD everywhere in TREE (non-destructively).
+Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
+\nKeywords supported: :test :test-not :key
+\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
+ (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
+ (apply 'cl-sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
+ (cl--do-subst cl-new cl-old cl-tree)))
+
+(defun cl--do-subst (cl-new cl-old cl-tree)
+ (cond ((eq cl-tree cl-old) cl-new)
+ ((consp cl-tree)
+ (let ((a (cl--do-subst cl-new cl-old (car cl-tree)))
+ (d (cl--do-subst cl-new cl-old (cdr cl-tree))))
+ (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
+ cl-tree (cons a d))))
+ (t cl-tree)))
+
+(defun cl-acons (key value alist)
+ "Add KEY and VALUE to ALIST.
+Return a new list with (cons KEY VALUE) as car and ALIST as cdr."
+ (cons (cons key value) alist))
+
+(defun cl-pairlis (keys values &optional alist)
+ "Make an alist from KEYS and VALUES.
+Return a new alist composed by associating KEYS to corresponding VALUES;
+the process stops as soon as KEYS or VALUES run out.
+If ALIST is non-nil, the new pairs are prepended to it."
+ (nconc (cl-mapcar 'cons keys values) alist))
+
+
+;;; Generalized variables.
+
+;; These used to be in cl-macs.el since all macros that use them (like setf)
+;; were autoloaded from cl-macs.el. But now that setf, push, and pop are in
+;; core Elisp, they need to either be right here or be autoloaded via
+;; cl-loaddefs.el, which is more trouble than it is worth.
+
+;; Some more Emacs-related place types.
+(gv-define-simple-setter buffer-file-name set-visited-file-name t)
+(gv-define-setter buffer-modified-p (flag &optional buf)
+ `(with-current-buffer ,buf
+ (set-buffer-modified-p ,flag)))
+(gv-define-simple-setter buffer-name rename-buffer t)
+(gv-define-setter buffer-string (store)
+ `(insert (prog1 ,store (erase-buffer))))
+(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
+(gv-define-simple-setter current-buffer set-buffer)
+(gv-define-simple-setter current-case-table set-case-table)
+(gv-define-simple-setter current-column move-to-column t)
+(gv-define-simple-setter current-global-map use-global-map t)
+(gv-define-setter current-input-mode (store)
+ `(progn (apply #'set-input-mode ,store) ,store))
+(gv-define-simple-setter current-local-map use-local-map t)
+(gv-define-simple-setter current-window-configuration
+ set-window-configuration t)
+(gv-define-simple-setter default-file-modes set-default-file-modes t)
+(gv-define-simple-setter documentation-property put)
+(gv-define-setter face-background (x f &optional s)
+ `(set-face-background ,f ,x ,s))
+(gv-define-setter face-background-pixmap (x f &optional s)
+ `(set-face-background-pixmap ,f ,x ,s))
+(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
+(gv-define-setter face-foreground (x f &optional s)
+ `(set-face-foreground ,f ,x ,s))
+(gv-define-setter face-underline-p (x f &optional s)
+ `(set-face-underline-p ,f ,x ,s))
+(gv-define-simple-setter file-modes set-file-modes t)
+(gv-define-simple-setter frame-height set-screen-height t)
+(gv-define-simple-setter frame-parameters modify-frame-parameters t)
+(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
+(gv-define-simple-setter frame-width set-screen-width t)
+(gv-define-simple-setter getenv setenv t)
+(gv-define-simple-setter get-register set-register)
+(gv-define-simple-setter global-key-binding global-set-key)
+(gv-define-simple-setter local-key-binding local-set-key)
+(gv-define-simple-setter mark set-mark t)
+(gv-define-simple-setter mark-marker set-mark t)
+(gv-define-simple-setter marker-position set-marker t)
+(gv-define-setter mouse-position (store scr)
+ `(set-mouse-position ,scr (car ,store) (cadr ,store)
+ (cddr ,store)))
+(gv-define-simple-setter point goto-char)
+(gv-define-simple-setter point-marker goto-char t)
+(gv-define-setter point-max (store)
+ `(progn (narrow-to-region (point-min) ,store) ,store))
+(gv-define-setter point-min (store)
+ `(progn (narrow-to-region ,store (point-max)) ,store))
+(gv-define-setter read-mouse-position (store scr)
+ `(set-mouse-position ,scr (car ,store) (cdr ,store)))
+(gv-define-simple-setter screen-height set-screen-height t)
+(gv-define-simple-setter screen-width set-screen-width t)
+(gv-define-simple-setter selected-window select-window)
+(gv-define-simple-setter selected-screen select-screen)
+(gv-define-simple-setter selected-frame select-frame)
+(gv-define-simple-setter standard-case-table set-standard-case-table)
+(gv-define-simple-setter syntax-table set-syntax-table)
+(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
+(gv-define-setter window-height (store)
+ `(progn (enlarge-window (- ,store (window-height))) ,store))
+(gv-define-setter window-width (store)
+ `(progn (enlarge-window (- ,store (window-width)) t) ,store))
+(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
+(gv-define-simple-setter x-get-selection x-own-selection t)
+
+;; More complex setf-methods.
+
+;; This is a hack that allows (setf (eq a 7) B) to mean either
+;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
+;; This is useful when you have control over the PLACE but not over
+;; the VALUE, as is the case in define-minor-mode's :variable.
+;; It turned out that :variable needed more flexibility anyway, so
+;; this doesn't seem too useful now.
+(gv-define-expander eq
+ (lambda (do place val)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil val val
+ (funcall do `(eq ,getter ,val)
+ (lambda (v)
+ `(cond
+ (,v ,(funcall setter val))
+ ((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
+
+(gv-define-expander substring
+ (lambda (do place from &optional to)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil start from
+ (macroexp-let2 nil end to
+ (funcall do `(substring ,getter ,start ,end)
+ (lambda (v)
+ (funcall setter `(cl--set-substring
+ ,getter ,start ,end ,v)))))))))
+
+;;; Miscellaneous.
+
+;;;###autoload
+(progn
+ ;; Make sure functions defined with cl-defsubst can be inlined even in
+ ;; packages which do not require CL.
+ (autoload 'cl--defsubst-expand "cl-macs")
+ ;; Autoload, so autoload.el and font-lock can use it even when CL
+ ;; is not loaded.
+ (put 'cl-defun 'doc-string-elt 3)
+ (put 'cl-defmacro 'doc-string-elt 3)
+ (put 'cl-defsubst 'doc-string-elt 3)
+ (put 'cl-defstruct 'doc-string-elt 2))
+
+(load "cl-loaddefs" nil 'quiet)
+
+(provide 'cl-lib)
+
+(run-hooks 'cl-load-hook)
+
+;; Local variables:
+;; byte-compile-dynamic: t
+;; byte-compile-warnings: (not cl-functions)
+;; End:
+
+;;; cl-lib.el ends here
;;; Code:
\f
-;;;### (autoloads (cl-prettyexpand cl-macroexpand-all cl-remprop
-;;;;;; cl-do-remf cl-set-getf getf get* tailp list-length nreconc
-;;;;;; revappend concatenate subseq cl-float-limits random-state-p
-;;;;;; make-random-state random* signum rem* mod* round* truncate*
-;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p
-;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively
-;;;;;; notevery notany every some mapcon mapcan mapl maplist map
-;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "c172dda6770ce18b556561481bfefbb2")
+;;;### (autoloads (cl-prettyexpand cl-remprop cl--do-remf cl--set-getf
+;;;;;; cl-getf cl-get cl-tailp cl-list-length cl-nreconc cl-revappend
+;;;;;; cl-concatenate cl-subseq cl-float-limits cl-random-state-p
+;;;;;; cl-make-random-state cl-random cl-signum cl-rem cl-mod cl-round
+;;;;;; cl-truncate cl-ceiling cl-floor cl-isqrt cl-lcm cl-gcd cl--set-frame-visible-p
+;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively
+;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan
+;;;;;; cl-mapl cl-maplist cl-map cl--mapcar-many cl-equalp cl-coerce)
+;;;;;; "cl-extra" "cl-extra.el" "535a24c1cff55a16e3d51219498a7858")
;;; Generated autoloads from cl-extra.el
-(autoload 'coerce "cl-extra" "\
+(autoload 'cl-coerce "cl-extra" "\
Coerce OBJECT to type TYPE.
TYPE is a Common Lisp type specifier.
\(fn OBJECT TYPE)" nil nil)
-(autoload 'equalp "cl-extra" "\
+(autoload 'cl-equalp "cl-extra" "\
Return t if two Lisp objects have similar structures and contents.
This is like `equal', except that it accepts numerically equal
numbers of different types (float vs. integer), and also compares
\(fn X Y)" nil nil)
-(autoload 'cl-mapcar-many "cl-extra" "\
+(autoload 'cl--mapcar-many "cl-extra" "\
\(fn CL-FUNC CL-SEQS)" nil nil)
-(autoload 'map "cl-extra" "\
+(autoload 'cl-map "cl-extra" "\
Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
TYPE is the sequence type to return.
\(fn TYPE FUNCTION SEQUENCE...)" nil nil)
-(autoload 'maplist "cl-extra" "\
+(autoload 'cl-maplist "cl-extra" "\
Map FUNCTION to each sublist of LIST or LISTs.
Like `mapcar', except applies to lists and their cdr's rather than to
the elements themselves.
\(fn FUNCTION LIST...)" nil nil)
-(autoload 'mapl "cl-extra" "\
-Like `maplist', but does not accumulate values returned by the function.
+(autoload 'cl-mapl "cl-extra" "\
+Like `cl-maplist', but does not accumulate values returned by the function.
\(fn FUNCTION LIST...)" nil nil)
-(autoload 'mapcan "cl-extra" "\
+(autoload 'cl-mapcan "cl-extra" "\
Like `mapcar', but nconc's together the values returned by the function.
\(fn FUNCTION SEQUENCE...)" nil nil)
-(autoload 'mapcon "cl-extra" "\
-Like `maplist', but nconc's together the values returned by the function.
+(autoload 'cl-mapcon "cl-extra" "\
+Like `cl-maplist', but nconc's together the values returned by the function.
\(fn FUNCTION LIST...)" nil nil)
-(autoload 'some "cl-extra" "\
+(autoload 'cl-some "cl-extra" "\
Return true if PREDICATE is true of any element of SEQ or SEQs.
If so, return the true (non-nil) value returned by PREDICATE.
\(fn PREDICATE SEQ...)" nil nil)
-(autoload 'every "cl-extra" "\
+(autoload 'cl-every "cl-extra" "\
Return true if PREDICATE is true of every element of SEQ or SEQs.
\(fn PREDICATE SEQ...)" nil nil)
-(autoload 'notany "cl-extra" "\
+(autoload 'cl-notany "cl-extra" "\
Return true if PREDICATE is false of every element of SEQ or SEQs.
\(fn PREDICATE SEQ...)" nil nil)
-(autoload 'notevery "cl-extra" "\
+(autoload 'cl-notevery "cl-extra" "\
Return true if PREDICATE is false of some element of SEQ or SEQs.
\(fn PREDICATE SEQ...)" nil nil)
-(defalias 'cl-map-keymap 'map-keymap)
-
-(autoload 'cl-map-keymap-recursively "cl-extra" "\
+(autoload 'cl--map-keymap-recursively "cl-extra" "\
\(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil)
-(autoload 'cl-map-intervals "cl-extra" "\
+(autoload 'cl--map-intervals "cl-extra" "\
\(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil)
-(autoload 'cl-map-overlays "cl-extra" "\
+(autoload 'cl--map-overlays "cl-extra" "\
\(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil)
-(autoload 'cl-set-frame-visible-p "cl-extra" "\
+(autoload 'cl--set-frame-visible-p "cl-extra" "\
\(fn FRAME VAL)" nil nil)
-(autoload 'cl-progv-before "cl-extra" "\
-
-
-\(fn SYMS VALUES)" nil nil)
-
-(autoload 'gcd "cl-extra" "\
+(autoload 'cl-gcd "cl-extra" "\
Return the greatest common divisor of the arguments.
\(fn &rest ARGS)" nil nil)
-(autoload 'lcm "cl-extra" "\
+(autoload 'cl-lcm "cl-extra" "\
Return the least common multiple of the arguments.
\(fn &rest ARGS)" nil nil)
-(autoload 'isqrt "cl-extra" "\
+(autoload 'cl-isqrt "cl-extra" "\
Return the integer square root of the argument.
\(fn X)" nil nil)
-(autoload 'floor* "cl-extra" "\
+(autoload 'cl-floor "cl-extra" "\
Return a list of the floor of X and the fractional part of X.
With two arguments, return floor and remainder of their quotient.
\(fn X &optional Y)" nil nil)
-(autoload 'ceiling* "cl-extra" "\
+(autoload 'cl-ceiling "cl-extra" "\
Return a list of the ceiling of X and the fractional part of X.
With two arguments, return ceiling and remainder of their quotient.
\(fn X &optional Y)" nil nil)
-(autoload 'truncate* "cl-extra" "\
+(autoload 'cl-truncate "cl-extra" "\
Return a list of the integer part of X and the fractional part of X.
With two arguments, return truncation and remainder of their quotient.
\(fn X &optional Y)" nil nil)
-(autoload 'round* "cl-extra" "\
+(autoload 'cl-round "cl-extra" "\
Return a list of X rounded to the nearest integer and the remainder.
With two arguments, return rounding and remainder of their quotient.
\(fn X &optional Y)" nil nil)
-(autoload 'mod* "cl-extra" "\
+(autoload 'cl-mod "cl-extra" "\
The remainder of X divided by Y, with the same sign as Y.
\(fn X Y)" nil nil)
-(autoload 'rem* "cl-extra" "\
+(autoload 'cl-rem "cl-extra" "\
The remainder of X divided by Y, with the same sign as X.
\(fn X Y)" nil nil)
-(autoload 'signum "cl-extra" "\
+(autoload 'cl-signum "cl-extra" "\
Return 1 if X is positive, -1 if negative, 0 if zero.
\(fn X)" nil nil)
-(autoload 'random* "cl-extra" "\
+(autoload 'cl-random "cl-extra" "\
Return a random nonnegative number less than LIM, an integer or float.
Optional second arg STATE is a random-state object.
\(fn LIM &optional STATE)" nil nil)
-(autoload 'make-random-state "cl-extra" "\
-Return a copy of random-state STATE, or of `*random-state*' if omitted.
+(autoload 'cl-make-random-state "cl-extra" "\
+Return a copy of random-state STATE, or of the internal state if omitted.
If STATE is t, return a new state object seeded from the time of day.
\(fn &optional STATE)" nil nil)
-(autoload 'random-state-p "cl-extra" "\
+(autoload 'cl-random-state-p "cl-extra" "\
Return t if OBJECT is a random-state object.
\(fn OBJECT)" nil nil)
(autoload 'cl-float-limits "cl-extra" "\
Initialize the Common Lisp floating-point parameters.
-This sets the values of: `most-positive-float', `most-negative-float',
-`least-positive-float', `least-negative-float', `float-epsilon',
-`float-negative-epsilon', `least-positive-normalized-float', and
-`least-negative-normalized-float'.
+This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
+`cl-least-positive-float', `cl-least-negative-float', `cl-float-epsilon',
+`cl-float-negative-epsilon', `cl-least-positive-normalized-float', and
+`cl-least-negative-normalized-float'.
\(fn)" nil nil)
-(autoload 'subseq "cl-extra" "\
+(autoload 'cl-subseq "cl-extra" "\
Return the subsequence of SEQ from START to END.
If END is omitted, it defaults to the length of the sequence.
If START or END is negative, it counts from the end.
\(fn SEQ START &optional END)" nil nil)
-(autoload 'concatenate "cl-extra" "\
+(autoload 'cl-concatenate "cl-extra" "\
Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
\(fn TYPE SEQUENCE...)" nil nil)
-(autoload 'revappend "cl-extra" "\
+(autoload 'cl-revappend "cl-extra" "\
Equivalent to (append (reverse X) Y).
\(fn X Y)" nil nil)
-(autoload 'nreconc "cl-extra" "\
+(autoload 'cl-nreconc "cl-extra" "\
Equivalent to (nconc (nreverse X) Y).
\(fn X Y)" nil nil)
-(autoload 'list-length "cl-extra" "\
+(autoload 'cl-list-length "cl-extra" "\
Return the length of list X. Return nil if list is circular.
\(fn X)" nil nil)
-(autoload 'tailp "cl-extra" "\
+(autoload 'cl-tailp "cl-extra" "\
Return true if SUBLIST is a tail of LIST.
\(fn SUBLIST LIST)" nil nil)
-(autoload 'get* "cl-extra" "\
+(autoload 'cl-get "cl-extra" "\
Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
\(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil)
-(autoload 'getf "cl-extra" "\
+(put 'cl-get 'compiler-macro #'cl--compiler-macro-get)
+
+(autoload 'cl-getf "cl-extra" "\
Search PROPLIST for property PROPNAME; return its value or DEFAULT.
PROPLIST is a list of the sort returned by `symbol-plist'.
\(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil)
-(autoload 'cl-set-getf "cl-extra" "\
+(autoload 'cl--set-getf "cl-extra" "\
\(fn PLIST TAG VAL)" nil nil)
-(autoload 'cl-do-remf "cl-extra" "\
+(autoload 'cl--do-remf "cl-extra" "\
\(fn PLIST TAG)" nil nil)
\(fn SYMBOL PROPNAME)" nil nil)
-(defalias 'remprop 'cl-remprop)
-
-(defalias 'cl-gethash 'gethash)
-
-(defalias 'cl-puthash 'puthash)
-
-(defalias 'cl-remhash 'remhash)
-
-(defalias 'cl-clrhash 'clrhash)
-
-(defalias 'cl-maphash 'maphash)
+(autoload 'cl-prettyexpand "cl-extra" "\
-(defalias 'cl-make-hash-table 'make-hash-table)
-(defalias 'cl-hash-table-p 'hash-table-p)
+\(fn FORM &optional FULL)" nil nil)
-(defalias 'cl-hash-table-count 'hash-table-count)
+;;;***
+\f
+;;;### (autoloads (cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
+;;;;;; cl-define-compiler-macro cl-assert cl-check-type cl-typep
+;;;;;; cl-deftype cl-defstruct cl-callf2 cl-callf cl-letf* cl-letf
+;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally
+;;;;;; cl-multiple-value-setq cl-multiple-value-bind cl-symbol-macrolet
+;;;;;; cl-macrolet cl-labels cl-flet* cl-flet cl-progv cl-psetq
+;;;;;; cl-do-all-symbols cl-do-symbols cl-dotimes cl-dolist cl-do*
+;;;;;; 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--compiler-macro-cXXr cl--compiler-macro-list*)
+;;;;;; "cl-macs" "cl-macs.el" "6d0676869af66e5b5a671f95ee069461")
+;;; Generated autoloads from cl-macs.el
-(autoload 'cl-macroexpand-all "cl-extra" "\
-Expand all macro calls through a Lisp FORM.
-This also does some trivial optimizations to make the form prettier.
+(autoload 'cl--compiler-macro-list* "cl-macs" "\
-\(fn FORM &optional ENV)" nil nil)
-(autoload 'cl-prettyexpand "cl-extra" "\
+\(fn FORM ARG &rest OTHERS)" nil nil)
+(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
-\(fn FORM &optional FULL)" nil nil)
-;;;***
-\f
-;;;### (autoloads (defsubst* compiler-macroexpand define-compiler-macro
-;;;;;; assert check-type typep deftype cl-struct-setf-expander defstruct
-;;;;;; define-modify-macro callf2 callf letf* letf rotatef shiftf
-;;;;;; remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method
-;;;;;; declare the locally multiple-value-setq multiple-value-bind
-;;;;;; lexical-let* lexical-let symbol-macrolet macrolet labels
-;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
-;;;;;; do* do loop return-from return block etypecase typecase ecase
-;;;;;; case load-time-value eval-when destructuring-bind function*
-;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "0be85e9c7ef309d2ccbac18b9b0f1d42")
-;;; Generated autoloads from cl-macs.el
+\(fn FORM X)" nil nil)
-(autoload 'gensym "cl-macs" "\
+(autoload 'cl-gensym "cl-macs" "\
Generate a new uninterned symbol.
The name is made by appending a number to PREFIX, default \"G\".
\(fn &optional PREFIX)" nil nil)
-(autoload 'gentemp "cl-macs" "\
+(autoload 'cl-gentemp "cl-macs" "\
Generate a new interned symbol with a unique name.
The name is made by appending a number to PREFIX, default \"G\".
\(fn &optional PREFIX)" nil nil)
-(autoload 'defun* "cl-macs" "\
+(autoload 'cl-defun "cl-macs" "\
Define NAME as a function.
Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
-\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro))
+(put 'cl-defun 'doc-string-elt '3)
-(autoload 'defmacro* "cl-macs" "\
+(put 'cl-defun 'lisp-indent-function '2)
+
+(autoload 'cl-defmacro "cl-macs" "\
Define NAME as a macro.
Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
+
+(put 'cl-defmacro 'doc-string-elt '3)
-\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro))
+(put 'cl-defmacro 'lisp-indent-function '2)
-(autoload 'function* "cl-macs" "\
+(autoload 'cl-function "cl-macs" "\
Introduce a function.
Like normal `function', except that if argument is a lambda form,
its argument list allows full Common Lisp conventions.
-\(fn FUNC)" nil (quote macro))
+\(fn FUNC)" nil t)
-(autoload 'destructuring-bind "cl-macs" "\
+(autoload 'cl-destructuring-bind "cl-macs" "\
-\(fn ARGS EXPR &rest BODY)" nil (quote macro))
+\(fn ARGS EXPR &rest BODY)" nil t)
-(autoload 'eval-when "cl-macs" "\
+(put 'cl-destructuring-bind 'lisp-indent-function '2)
+
+(autoload 'cl-eval-when "cl-macs" "\
Control when BODY is evaluated.
If `compile' is in WHEN, BODY is evaluated when compiled at top-level.
If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
-\(fn (WHEN...) BODY...)" nil (quote macro))
+\(fn (WHEN...) BODY...)" nil t)
+
+(put 'cl-eval-when 'lisp-indent-function '1)
-(autoload 'load-time-value "cl-macs" "\
+(autoload 'cl-load-time-value "cl-macs" "\
Like `progn', but evaluates the body at load time.
The result of the body appears to the compiler as a quoted constant.
-\(fn FORM &optional READ-ONLY)" nil (quote macro))
+\(fn FORM &optional READ-ONLY)" nil t)
-(autoload 'case "cl-macs" "\
+(autoload 'cl-case "cl-macs" "\
Eval EXPR and choose among clauses on that value.
Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared
against each key in each KEYLIST; the corresponding BODY is evaluated.
-If no clause succeeds, case returns nil. A single atom may be used in
+If no clause succeeds, cl-case returns nil. A single atom may be used in
place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is
allowed only in the final clause, and matches if no other keys match.
Key values are compared by `eql'.
-\(fn EXPR (KEYLIST BODY...)...)" nil (quote macro))
+\(fn EXPR (KEYLIST BODY...)...)" nil t)
+
+(put 'cl-case 'lisp-indent-function '1)
-(autoload 'ecase "cl-macs" "\
-Like `case', but error if no case fits.
+(autoload 'cl-ecase "cl-macs" "\
+Like `cl-case', but error if no case fits.
`otherwise'-clauses are not allowed.
-\(fn EXPR (KEYLIST BODY...)...)" nil (quote macro))
+\(fn EXPR (KEYLIST BODY...)...)" nil t)
-(autoload 'typecase "cl-macs" "\
+(put 'cl-ecase 'lisp-indent-function '1)
+
+(autoload 'cl-typecase "cl-macs" "\
Evals EXPR, chooses among clauses on that value.
Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it
satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
+cl-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
final clause, and matches if no other keys match.
-\(fn EXPR (TYPE BODY...)...)" nil (quote macro))
+\(fn EXPR (TYPE BODY...)...)" nil t)
+
+(put 'cl-typecase 'lisp-indent-function '1)
-(autoload 'etypecase "cl-macs" "\
-Like `typecase', but error if no case fits.
+(autoload 'cl-etypecase "cl-macs" "\
+Like `cl-typecase', but error if no case fits.
`otherwise'-clauses are not allowed.
-\(fn EXPR (TYPE BODY...)...)" nil (quote macro))
+\(fn EXPR (TYPE BODY...)...)" nil t)
+
+(put 'cl-etypecase 'lisp-indent-function '1)
-(autoload 'block "cl-macs" "\
+(autoload 'cl-block "cl-macs" "\
Define a lexically-scoped block named NAME.
-NAME may be any symbol. Code inside the BODY forms can call `return-from'
+NAME may be any symbol. Code inside the BODY forms can call `cl-return-from'
to jump prematurely out of the block. This differs from `catch' and `throw'
in two respects: First, the NAME is an unevaluated symbol rather than a
quoted symbol or other form; and second, NAME is lexically rather than
references may appear inside macro expansions, but not inside functions
called from BODY.
-\(fn NAME &rest BODY)" nil (quote macro))
+\(fn NAME &rest BODY)" nil t)
-(autoload 'return "cl-macs" "\
+(put 'cl-block 'lisp-indent-function '1)
+
+(autoload 'cl-return "cl-macs" "\
Return from the block named nil.
-This is equivalent to `(return-from nil RESULT)'.
+This is equivalent to `(cl-return-from nil RESULT)'.
-\(fn &optional RESULT)" nil (quote macro))
+\(fn &optional RESULT)" nil t)
-(autoload 'return-from "cl-macs" "\
+(autoload 'cl-return-from "cl-macs" "\
Return from the block named NAME.
-This jumps out to the innermost enclosing `(block NAME ...)' form,
+This jumps out to the innermost enclosing `(cl-block NAME ...)' form,
returning RESULT from that form (or nil if RESULT is omitted).
This is compatible with Common Lisp, but note that `defun' and
`defmacro' do not create implicit blocks as they do in Common Lisp.
-\(fn NAME &optional RESULT)" nil (quote macro))
+\(fn NAME &optional RESULT)" nil t)
+
+(put 'cl-return-from 'lisp-indent-function '1)
-(autoload 'loop "cl-macs" "\
-The Common Lisp `loop' macro.
+(autoload 'cl-loop "cl-macs" "\
+The Common Lisp `cl-loop' macro.
Valid clauses are:
for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR,
finally return EXPR, named NAME.
-\(fn CLAUSE...)" nil (quote macro))
+\(fn CLAUSE...)" nil t)
-(autoload 'do "cl-macs" "\
-The Common Lisp `do' loop.
+(autoload 'cl-do "cl-macs" "\
+The Common Lisp `cl-do' loop.
-\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro))
+\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t)
-(autoload 'do* "cl-macs" "\
-The Common Lisp `do*' loop.
+(put 'cl-do 'lisp-indent-function '2)
-\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro))
+(autoload 'cl-do* "cl-macs" "\
+The Common Lisp `cl-do*' loop.
-(autoload 'dolist "cl-macs" "\
+\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t)
+
+(put 'cl-do* 'lisp-indent-function '2)
+
+(autoload 'cl-dolist "cl-macs" "\
Loop over a list.
Evaluate BODY with VAR bound to each `car' from LIST, in turn.
Then evaluate RESULT to get return value, default nil.
An implicit nil block is established around the loop.
-\(fn (VAR LIST [RESULT]) BODY...)" nil (quote macro))
+\(fn (VAR LIST [RESULT]) BODY...)" nil t)
+
+(put 'cl-dolist 'lisp-indent-function '1)
-(autoload 'dotimes "cl-macs" "\
+(autoload 'cl-dotimes "cl-macs" "\
Loop a certain number of times.
Evaluate BODY with VAR bound to successive integers from 0, inclusive,
to COUNT, exclusive. Then evaluate RESULT to get return value, default
nil.
-\(fn (VAR COUNT [RESULT]) BODY...)" nil (quote macro))
+\(fn (VAR COUNT [RESULT]) BODY...)" nil t)
-(autoload 'do-symbols "cl-macs" "\
+(put 'cl-dotimes 'lisp-indent-function '1)
+
+(autoload 'cl-do-symbols "cl-macs" "\
Loop over all symbols.
Evaluate BODY with VAR bound to each interned symbol, or to each symbol
from OBARRAY.
-\(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil (quote macro))
+\(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil t)
+
+(put 'cl-do-symbols 'lisp-indent-function '1)
-(autoload 'do-all-symbols "cl-macs" "\
+(autoload 'cl-do-all-symbols "cl-macs" "\
-\(fn SPEC &rest BODY)" nil (quote macro))
+\(fn SPEC &rest BODY)" nil t)
-(autoload 'psetq "cl-macs" "\
+(put 'cl-do-all-symbols 'lisp-indent-function '1)
+
+(autoload 'cl-psetq "cl-macs" "\
Set SYMs to the values VALs in parallel.
This is like `setq', except that all VAL forms are evaluated (in order)
before assigning any symbols SYM to the corresponding values.
-\(fn SYM VAL SYM VAL ...)" nil (quote macro))
+\(fn SYM VAL SYM VAL ...)" nil t)
-(autoload 'progv "cl-macs" "\
+(autoload 'cl-progv "cl-macs" "\
Bind SYMBOLS to VALUES dynamically in BODY.
The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
Each symbol in the first list is bound to the corresponding value in the
BODY forms are executed and their result is returned. This is much like
a `let' form, except that the list of symbols can be computed at run-time.
-\(fn SYMBOLS VALUES &rest BODY)" nil (quote macro))
+\(fn SYMBOLS VALUES &rest BODY)" nil t)
+
+(put 'cl-progv 'lisp-indent-function '2)
+
+(autoload 'cl-flet "cl-macs" "\
+Make temporary function definitions.
+Like `cl-labels' but the definitions are not recursive.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
-(autoload 'flet "cl-macs" "\
+(put 'cl-flet 'lisp-indent-function '1)
+
+(autoload 'cl-flet* "cl-macs" "\
Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell. The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+Like `cl-flet' but the definitions can refer to previous ones.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
-\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro))
+(put 'cl-flet* 'lisp-indent-function '1)
-(autoload 'labels "cl-macs" "\
+(autoload 'cl-labels "cl-macs" "\
Make temporary function bindings.
-This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive and the scoping is lexical, but capturing them
+in closures will only work if `lexical-binding' is in use.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
-\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro))
+(put 'cl-labels 'lisp-indent-function '1)
-(autoload 'macrolet "cl-macs" "\
+(autoload 'cl-macrolet "cl-macs" "\
Make temporary macro definitions.
-This is like `flet', but for macros instead of functions.
+This is like `cl-flet', but for macros instead of functions.
-\(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil (quote macro))
+\(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil t)
-(autoload 'symbol-macrolet "cl-macs" "\
+(put 'cl-macrolet 'lisp-indent-function '1)
+
+(autoload 'cl-symbol-macrolet "cl-macs" "\
Make symbol macro definitions.
Within the body FORMs, references to the variable NAME will be replaced
by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
-\(fn ((NAME EXPANSION) ...) FORM...)" nil (quote macro))
-
-(autoload 'lexical-let "cl-macs" "\
-Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-
-\(fn BINDINGS BODY)" nil (quote macro))
+\(fn ((NAME EXPANSION) ...) FORM...)" nil t)
-(autoload 'lexical-let* "cl-macs" "\
-Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp. This is similar to the behavior of `let*' in
-Common Lisp.
+(put 'cl-symbol-macrolet 'lisp-indent-function '1)
-\(fn BINDINGS BODY)" nil (quote macro))
-
-(autoload 'multiple-value-bind "cl-macs" "\
+(autoload 'cl-multiple-value-bind "cl-macs" "\
Collect multiple return values.
FORM must return a list; the BODY is then executed with the first N elements
of this list bound (`let'-style) to each of the symbols SYM in turn. This
-is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
-simulate true multiple return values. For compatibility, (values A B C) is
+is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to
+simulate true multiple return values. For compatibility, (cl-values A B C) is
a synonym for (list A B C).
-\(fn (SYM...) FORM BODY)" nil (quote macro))
+\(fn (SYM...) FORM BODY)" nil t)
+
+(put 'cl-multiple-value-bind 'lisp-indent-function '2)
-(autoload 'multiple-value-setq "cl-macs" "\
+(autoload 'cl-multiple-value-setq "cl-macs" "\
Collect multiple return values.
FORM must return a list; the first N elements of this list are stored in
each of the symbols SYM in turn. This is analogous to the Common Lisp
-`multiple-value-setq' macro, using lists to simulate true multiple return
-values. For compatibility, (values A B C) is a synonym for (list A B C).
+`cl-multiple-value-setq' macro, using lists to simulate true multiple return
+values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
+
+\(fn (SYM...) FORM)" nil t)
-\(fn (SYM...) FORM)" nil (quote macro))
+(put 'cl-multiple-value-setq 'lisp-indent-function '1)
-(autoload 'locally "cl-macs" "\
+(autoload 'cl-locally "cl-macs" "\
-\(fn &rest BODY)" nil (quote macro))
+\(fn &rest BODY)" nil t)
-(autoload 'the "cl-macs" "\
+(autoload 'cl-the "cl-macs" "\
-\(fn TYPE FORM)" nil (quote macro))
+\(fn TYPE FORM)" nil t)
-(autoload 'declare "cl-macs" "\
+(put 'cl-the 'lisp-indent-function '1)
+
+(autoload 'cl-declare "cl-macs" "\
Declare SPECS about the current function while compiling.
For instance
- (declare (warn 0))
+ (cl-declare (warn 0))
will turn off byte-compile warnings in the function.
See Info node `(cl)Declarations' for details.
-\(fn &rest SPECS)" nil (quote macro))
-
-(autoload 'define-setf-method "cl-macs" "\
-Define a `setf' method.
-This method shows how to handle `setf's to places of the form (NAME ARGS...).
-The argument forms ARGS are bound according to ARGLIST, as if NAME were
-going to be expanded as a macro, then the BODY forms are executed and must
-return a list of five elements: a temporary-variables list, a value-forms
-list, a store-variables list (of length one), a store-form, and an access-
-form. See `defsetf' for a simpler way to define most setf-methods.
-
-\(fn NAME ARGLIST BODY...)" nil (quote macro))
-
-(autoload 'defsetf "cl-macs" "\
-Define a `setf' method.
-This macro is an easy-to-use substitute for `define-setf-method' that works
-well for simple place forms. In the simple `defsetf' form, `setf's of
-the form (setf (NAME ARGS...) VAL) are transformed to function or macro
-calls of the form (FUNC ARGS... VAL). Example:
-
- (defsetf aref aset)
-
-Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
-Here, the above `setf' call is expanded by binding the argument forms ARGS
-according to ARGLIST, binding the value form VAL to STORE, then executing
-BODY, which must return a Lisp form that does the necessary `setf' operation.
-Actually, ARGLIST and STORE may be bound to temporary variables which are
-introduced automatically to preserve proper execution order of the arguments.
-Example:
-
- (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))
-
-\(fn NAME [FUNC | ARGLIST (STORE) BODY...])" nil (quote macro))
-
-(autoload 'get-setf-method "cl-macs" "\
-Return a list of five values describing the setf-method for PLACE.
-PLACE may be any Lisp form which can appear as the PLACE argument to
-a macro like `setf' or `incf'.
-
-\(fn PLACE &optional ENV)" nil nil)
-
-(autoload 'setf "cl-macs" "\
-Set each PLACE to the value of its VAL.
-This is a generalized version of `setq'; the PLACEs may be symbolic
-references such as (car x) or (aref x i), as well as plain symbols.
-For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
-The return value is the last VAL in the list.
-
-\(fn PLACE VAL PLACE VAL ...)" nil (quote macro))
+\(fn &rest SPECS)" nil t)
-(autoload 'psetf "cl-macs" "\
+(autoload 'cl-psetf "cl-macs" "\
Set PLACEs to the values VALs in parallel.
This is like `setf', except that all VAL forms are evaluated (in order)
before assigning any PLACEs to the corresponding values.
-\(fn PLACE VAL PLACE VAL ...)" nil (quote macro))
+\(fn PLACE VAL PLACE VAL ...)" nil t)
-(autoload 'cl-do-pop "cl-macs" "\
-
-
-\(fn PLACE)" nil nil)
-
-(autoload 'remf "cl-macs" "\
+(autoload 'cl-remf "cl-macs" "\
Remove TAG from property list PLACE.
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The form returns true if TAG was found and removed, nil otherwise.
-\(fn PLACE TAG)" nil (quote macro))
+\(fn PLACE TAG)" nil t)
-(autoload 'shiftf "cl-macs" "\
+(autoload 'cl-shiftf "cl-macs" "\
Shift left among PLACEs.
-Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
+Example: (cl-shiftf A B C) sets A to B, B to C, and returns the old A.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
-\(fn PLACE... VAL)" nil (quote macro))
+\(fn PLACE... VAL)" nil t)
-(autoload 'rotatef "cl-macs" "\
+(autoload 'cl-rotatef "cl-macs" "\
Rotate left among PLACEs.
-Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
+Example: (cl-rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
-\(fn PLACE...)" nil (quote macro))
+\(fn PLACE...)" nil t)
-(autoload 'letf "cl-macs" "\
+(autoload 'cl-letf "cl-macs" "\
Temporarily bind to PLACEs.
This is the analogue of `let', but with generalized variables (in the
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY.
-\(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro))
+\(fn ((PLACE VALUE) ...) BODY...)" nil t)
-(autoload 'letf* "cl-macs" "\
+(put 'cl-letf 'lisp-indent-function '1)
+
+(autoload 'cl-letf* "cl-macs" "\
Temporarily bind to PLACEs.
-This is the analogue of `let*', but with generalized variables (in the
-sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
-VALUE, then the BODY forms are executed. On exit, either normally or
-because of a `throw' or error, the PLACEs are set back to their original
-values. Note that this macro is *not* available in Common Lisp.
-As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY.
+Like `cl-letf' but where the bindings are performed one at a time,
+rather than all at the end (i.e. like `let*' rather than like `let').
+
+\(fn BINDINGS &rest BODY)" nil t)
-\(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro))
+(put 'cl-letf* 'lisp-indent-function '1)
-(autoload 'callf "cl-macs" "\
+(autoload 'cl-callf "cl-macs" "\
Set PLACE to (FUNC PLACE ARGS...).
FUNC should be an unquoted function name. PLACE may be a symbol,
or any generalized variable allowed by `setf'.
-\(fn FUNC PLACE ARGS...)" nil (quote macro))
+\(fn FUNC PLACE &rest ARGS)" nil t)
-(autoload 'callf2 "cl-macs" "\
-Set PLACE to (FUNC ARG1 PLACE ARGS...).
-Like `callf', but PLACE is the second argument of FUNC, not the first.
+(put 'cl-callf 'lisp-indent-function '2)
-\(fn FUNC ARG1 PLACE ARGS...)" nil (quote macro))
+(autoload 'cl-callf2 "cl-macs" "\
+Set PLACE to (FUNC ARG1 PLACE ARGS...).
+Like `cl-callf', but PLACE is the second argument of FUNC, not the first.
-(autoload 'define-modify-macro "cl-macs" "\
-Define a `setf'-like modify macro.
-If NAME is called, it combines its PLACE argument with the other arguments
-from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)
+\(fn FUNC ARG1 PLACE ARGS...)" nil t)
-\(fn NAME ARGLIST FUNC &optional DOC)" nil (quote macro))
+(put 'cl-callf2 'lisp-indent-function '3)
-(autoload 'defstruct "cl-macs" "\
+(autoload 'cl-defstruct "cl-macs" "\
Define a struct type.
This macro defines a new data type called NAME that stores data
in SLOTs. It defines a `make-NAME' constructor, a `copy-NAME'
one keyword is supported, `:read-only'. If this has a non-nil
value, that slot cannot be set via `setf'.
-\(fn NAME SLOTS...)" nil (quote macro))
-
-(autoload 'cl-struct-setf-expander "cl-macs" "\
+\(fn NAME SLOTS...)" nil t)
+(put 'cl-defstruct 'doc-string-elt '2)
-\(fn X NAME ACCESSOR PRED-FORM POS)" nil nil)
+(put 'cl-defstruct 'lisp-indent-function '1)
-(autoload 'deftype "cl-macs" "\
+(autoload 'cl-deftype "cl-macs" "\
Define NAME as a new data type.
-The type name can then be used in `typecase', `check-type', etc.
+The type name can then be used in `cl-typecase', `cl-check-type', etc.
-\(fn NAME ARGLIST &rest BODY)" nil (quote macro))
+\(fn NAME ARGLIST &rest BODY)" nil t)
-(autoload 'typep "cl-macs" "\
+(put 'cl-deftype 'doc-string-elt '3)
+
+(autoload 'cl-typep "cl-macs" "\
Check that OBJECT is of type TYPE.
TYPE is a Common Lisp-style type specifier.
\(fn OBJECT TYPE)" nil nil)
-(autoload 'check-type "cl-macs" "\
+(autoload 'cl-check-type "cl-macs" "\
Verify that FORM is of type TYPE; signal an error if not.
STRING is an optional description of the desired type.
-\(fn FORM TYPE &optional STRING)" nil (quote macro))
+\(fn FORM TYPE &optional STRING)" nil t)
-(autoload 'assert "cl-macs" "\
+(autoload 'cl-assert "cl-macs" "\
Verify that FORM returns non-nil; signal an error if not.
Second arg SHOW-ARGS means to include arguments of FORM in message.
Other args STRING and ARGS... are arguments to be passed to `error'.
They are not evaluated unless the assertion fails. If STRING is
omitted, a default message listing FORM itself is used.
-\(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil (quote macro))
+\(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil t)
-(autoload 'define-compiler-macro "cl-macs" "\
+(autoload 'cl-define-compiler-macro "cl-macs" "\
Define a compiler-only macro.
This is like `defmacro', but macro expansion occurs only if the call to
FUNC is compiled (i.e., not interpreted). Compiler macros should be used
original function call alone by declaring an initial `&whole foo' parameter
and then returning foo.
-\(fn FUNC ARGS &rest BODY)" nil (quote macro))
+\(fn FUNC ARGS &rest BODY)" nil t)
-(autoload 'compiler-macroexpand "cl-macs" "\
+(autoload 'cl-compiler-macroexpand "cl-macs" "\
\(fn FORM)" nil nil)
-(autoload 'defsubst* "cl-macs" "\
+(autoload 'cl-defsubst "cl-macs" "\
Define NAME as a function.
Like `defun', except the function is automatically declared `inline',
ARGLIST allows full Common Lisp conventions, and BODY is implicitly
-surrounded by (block NAME ...).
+surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
-\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro))
+(put 'cl-defsubst 'lisp-indent-function '2)
+
+(autoload 'cl--compiler-macro-adjoin "cl-macs" "\
+
+
+\(fn FORM A LIST &rest KEYS)" nil nil)
;;;***
\f
-;;;### (autoloads (tree-equal nsublis sublis nsubst-if-not nsubst-if
-;;;;;; nsubst subst-if-not subst-if subsetp nset-exclusive-or set-exclusive-or
-;;;;;; nset-difference set-difference nintersection intersection
-;;;;;; nunion union rassoc-if-not rassoc-if rassoc* assoc-if-not
-;;;;;; assoc-if assoc* cl-adjoin member-if-not member-if member*
-;;;;;; merge stable-sort sort* search mismatch count-if-not count-if
-;;;;;; count position-if-not position-if position find-if-not find-if
-;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
-;;;;;; substitute-if substitute delete-duplicates remove-duplicates
-;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove*
-;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "99095e49c83af1c8bec0fdcf517b3f95")
+;;;### (autoloads (cl-tree-equal cl-nsublis cl-sublis cl-nsubst-if-not
+;;;;;; cl-nsubst-if cl-nsubst cl-subst-if-not cl-subst-if cl-subsetp
+;;;;;; cl-nset-exclusive-or cl-set-exclusive-or cl-nset-difference
+;;;;;; cl-set-difference cl-nintersection cl-intersection cl-nunion
+;;;;;; cl-union cl-rassoc-if-not cl-rassoc-if cl-rassoc cl-assoc-if-not
+;;;;;; cl-assoc-if cl-assoc cl--adjoin cl-member-if-not cl-member-if
+;;;;;; cl-member cl-merge cl-stable-sort cl-sort cl-search cl-mismatch
+;;;;;; cl-count-if-not cl-count-if cl-count cl-position-if-not cl-position-if
+;;;;;; cl-position cl-find-if-not cl-find-if cl-find cl-nsubstitute-if-not
+;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if
+;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not
+;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove
+;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "b444601641dcbd14a23ca5182bc80ffa")
;;; Generated autoloads from cl-seq.el
-(autoload 'reduce "cl-seq" "\
+(autoload 'cl-reduce "cl-seq" "\
Reduce two-argument FUNCTION across SEQ.
Keywords supported: :start :end :from-end :initial-value :key
\(fn FUNCTION SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'fill "cl-seq" "\
+(autoload 'cl-fill "cl-seq" "\
Fill the elements of SEQ with ITEM.
Keywords supported: :start :end
\(fn SEQ ITEM [KEYWORD VALUE]...)" nil nil)
-(autoload 'replace "cl-seq" "\
+(autoload 'cl-replace "cl-seq" "\
Replace the elements of SEQ1 with the elements of SEQ2.
SEQ1 is destructively modified, then returned.
\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'remove* "cl-seq" "\
+(autoload 'cl-remove "cl-seq" "\
Remove all occurrences of ITEM in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'remove-if "cl-seq" "\
+(autoload 'cl-remove-if "cl-seq" "\
Remove all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'remove-if-not "cl-seq" "\
+(autoload 'cl-remove-if-not "cl-seq" "\
Remove all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'delete* "cl-seq" "\
+(autoload 'cl-delete "cl-seq" "\
Remove all occurrences of ITEM in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'delete-if "cl-seq" "\
+(autoload 'cl-delete-if "cl-seq" "\
Remove all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'delete-if-not "cl-seq" "\
+(autoload 'cl-delete-if-not "cl-seq" "\
Remove all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'remove-duplicates "cl-seq" "\
+(autoload 'cl-remove-duplicates "cl-seq" "\
Return a copy of SEQ with all duplicate elements removed.
Keywords supported: :test :test-not :key :start :end :from-end
\(fn SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'delete-duplicates "cl-seq" "\
+(autoload 'cl-delete-duplicates "cl-seq" "\
Remove all duplicate elements from SEQ (destructively).
Keywords supported: :test :test-not :key :start :end :from-end
\(fn SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'substitute "cl-seq" "\
+(autoload 'cl-substitute "cl-seq" "\
Substitute NEW for OLD in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'substitute-if "cl-seq" "\
+(autoload 'cl-substitute-if "cl-seq" "\
Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'substitute-if-not "cl-seq" "\
+(autoload 'cl-substitute-if-not "cl-seq" "\
Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubstitute "cl-seq" "\
+(autoload 'cl-nsubstitute "cl-seq" "\
Substitute NEW for OLD in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubstitute-if "cl-seq" "\
+(autoload 'cl-nsubstitute-if "cl-seq" "\
Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubstitute-if-not "cl-seq" "\
+(autoload 'cl-nsubstitute-if-not "cl-seq" "\
Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'find "cl-seq" "\
+(autoload 'cl-find "cl-seq" "\
Find the first occurrence of ITEM in SEQ.
Return the matching ITEM, or nil if not found.
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'find-if "cl-seq" "\
+(autoload 'cl-find-if "cl-seq" "\
Find the first item satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'find-if-not "cl-seq" "\
+(autoload 'cl-find-if-not "cl-seq" "\
Find the first item not satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'position "cl-seq" "\
+(autoload 'cl-position "cl-seq" "\
Find the first occurrence of ITEM in SEQ.
Return the index of the matching item, or nil if not found.
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'position-if "cl-seq" "\
+(autoload 'cl-position-if "cl-seq" "\
Find the first item satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'position-if-not "cl-seq" "\
+(autoload 'cl-position-if-not "cl-seq" "\
Find the first item not satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'count "cl-seq" "\
+(autoload 'cl-count "cl-seq" "\
Count the number of occurrences of ITEM in SEQ.
Keywords supported: :test :test-not :key :start :end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'count-if "cl-seq" "\
+(autoload 'cl-count-if "cl-seq" "\
Count the number of items satisfying PREDICATE in SEQ.
Keywords supported: :key :start :end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'count-if-not "cl-seq" "\
+(autoload 'cl-count-if-not "cl-seq" "\
Count the number of items not satisfying PREDICATE in SEQ.
Keywords supported: :key :start :end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload 'mismatch "cl-seq" "\
+(autoload 'cl-mismatch "cl-seq" "\
Compare SEQ1 with SEQ2, return index of first mismatching element.
Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorter sequence.
\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'search "cl-seq" "\
+(autoload 'cl-search "cl-seq" "\
Search for SEQ1 as a subsequence of SEQ2.
Return the index of the leftmost element of the first match found;
return nil if there are no matches.
\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'sort* "cl-seq" "\
+(autoload 'cl-sort "cl-seq" "\
Sort the argument SEQ according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil)
-(autoload 'stable-sort "cl-seq" "\
+(autoload 'cl-stable-sort "cl-seq" "\
Sort the argument SEQ stably according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil)
-(autoload 'merge "cl-seq" "\
+(autoload 'cl-merge "cl-seq" "\
Destructively merge the two sequences to produce a new sequence.
TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
sequences, and PREDICATE is a `less-than' predicate on the elements.
\(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)" nil nil)
-(autoload 'member* "cl-seq" "\
+(autoload 'cl-member "cl-seq" "\
Find the first occurrence of ITEM in LIST.
Return the sublist of LIST whose car is ITEM.
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'member-if "cl-seq" "\
+(put 'cl-member 'compiler-macro #'cl--compiler-macro-member)
+
+(autoload 'cl-member-if "cl-seq" "\
Find the first item satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'member-if-not "cl-seq" "\
+(autoload 'cl-member-if-not "cl-seq" "\
Find the first item not satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'cl-adjoin "cl-seq" "\
+(autoload 'cl--adjoin "cl-seq" "\
\(fn CL-ITEM CL-LIST &rest CL-KEYS)" nil nil)
-(autoload 'assoc* "cl-seq" "\
+(autoload 'cl-assoc "cl-seq" "\
Find the first item whose car matches ITEM in LIST.
Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'assoc-if "cl-seq" "\
+(put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc)
+
+(autoload 'cl-assoc-if "cl-seq" "\
Find the first item whose car satisfies PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'assoc-if-not "cl-seq" "\
+(autoload 'cl-assoc-if-not "cl-seq" "\
Find the first item whose car does not satisfy PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'rassoc* "cl-seq" "\
+(autoload 'cl-rassoc "cl-seq" "\
Find the first item whose cdr matches ITEM in LIST.
Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'rassoc-if "cl-seq" "\
+(autoload 'cl-rassoc-if "cl-seq" "\
Find the first item whose cdr satisfies PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'rassoc-if-not "cl-seq" "\
+(autoload 'cl-rassoc-if-not "cl-seq" "\
Find the first item whose cdr does not satisfy PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload 'union "cl-seq" "\
+(autoload 'cl-union "cl-seq" "\
Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'nunion "cl-seq" "\
+(autoload 'cl-nunion "cl-seq" "\
Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'intersection "cl-seq" "\
+(autoload 'cl-intersection "cl-seq" "\
Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'nintersection "cl-seq" "\
+(autoload 'cl-nintersection "cl-seq" "\
Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'set-difference "cl-seq" "\
+(autoload 'cl-set-difference "cl-seq" "\
Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'nset-difference "cl-seq" "\
+(autoload 'cl-nset-difference "cl-seq" "\
Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'set-exclusive-or "cl-seq" "\
+(autoload 'cl-set-exclusive-or "cl-seq" "\
Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'nset-exclusive-or "cl-seq" "\
+(autoload 'cl-nset-exclusive-or "cl-seq" "\
Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'subsetp "cl-seq" "\
+(autoload 'cl-subsetp "cl-seq" "\
Return true if LIST1 is a subset of LIST2.
I.e., if every element of LIST1 also appears in LIST2.
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload 'subst-if "cl-seq" "\
+(autoload 'cl-subst-if "cl-seq" "\
Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced by NEW.
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'subst-if-not "cl-seq" "\
+(autoload 'cl-subst-if-not "cl-seq" "\
Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all non-matching elements replaced by NEW.
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubst "cl-seq" "\
+(autoload 'cl-nsubst "cl-seq" "\
Substitute NEW for OLD everywhere in TREE (destructively).
Any element of TREE which is `eql' to OLD is changed to NEW (via a call
to `setcar').
\(fn NEW OLD TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubst-if "cl-seq" "\
+(autoload 'cl-nsubst-if "cl-seq" "\
Substitute NEW for elements matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsubst-if-not "cl-seq" "\
+(autoload 'cl-nsubst-if-not "cl-seq" "\
Substitute NEW for elements not matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'sublis "cl-seq" "\
+(autoload 'cl-sublis "cl-seq" "\
Perform substitutions indicated by ALIST in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced.
\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'nsublis "cl-seq" "\
+(autoload 'cl-nsublis "cl-seq" "\
Perform substitutions indicated by ALIST in TREE (destructively).
Any matching element of TREE is changed via a call to `setcar'.
\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil)
-(autoload 'tree-equal "cl-seq" "\
+(autoload 'cl-tree-equal "cl-seq" "\
Return t if trees TREE1 and TREE2 have `eql' leaves.
Atoms are compared by `eql'; cons cells are compared recursively.
-;;; cl-macs.el --- Common Lisp macros
+;;; cl-macs.el --- Common Lisp macros -*- lexical-binding: t; coding: utf-8 -*-
;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;;; Code:
-(require 'cl)
+(require 'cl-lib)
+(require 'macroexp)
+;; `gv' is required here because cl-macs can be loaded before loaddefs.el.
+(require 'gv)
(defmacro cl-pop2 (place)
- (list 'prog1 (list 'car (list 'cdr place))
- (list 'setq place (list 'cdr (list 'cdr place)))))
-(put 'cl-pop2 'edebug-form-spec 'edebug-sexps)
+ (declare (debug edebug-sexps))
+ `(prog1 (car (cdr ,place))
+ (setq ,place (cdr (cdr ,place)))))
(defvar cl-optimize-safety)
(defvar cl-optimize-speed)
-
-;; This kludge allows macros which use cl-transform-function-property
-;; to be called at compile-time.
-
-(require
- (progn
- (or (fboundp 'cl-transform-function-property)
- (defalias 'cl-transform-function-property
- (function (lambda (n p f)
- (list 'put (list 'quote n) (list 'quote p)
- (list 'function (cons 'lambda f)))))))
- (car (or features (setq features (list 'cl-kludge))))))
-
-
;;; Initialization.
-(defvar cl-old-bc-file-form nil)
+;; Place compiler macros at the beginning, otherwise uses of the corresponding
+;; functions can lead to recursive-loads that prevent the calls from
+;; being optimized.
-;;; Some predicates for analyzing Lisp forms. These are used by various
-;;; macro expanders to optimize the results in certain common cases.
+;;;###autoload
+(defun cl--compiler-macro-list* (_form arg &rest others)
+ (let* ((args (reverse (cons arg others)))
+ (form (car args)))
+ (while (setq args (cdr args))
+ (setq form `(cons ,(car args) ,form)))
+ form))
-(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
+;;;###autoload
+(defun cl--compiler-macro-cXXr (form x)
+ (let* ((head (car form))
+ (n (symbol-name (car form)))
+ (i (- (length n) 2)))
+ (if (not (string-match "c[ad]+r\\'" n))
+ (if (and (fboundp head) (symbolp (symbol-function head)))
+ (cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
+ x)
+ (error "Compiler macro for cXXr applied to non-cXXr form"))
+ (while (> i (match-beginning 0))
+ (setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
+ (setq i (1- i)))
+ x)))
+
+;;; Some predicates for analyzing Lisp forms.
+;; These are used by various
+;; macro expanders to optimize the results in certain common cases.
+
+(defconst cl--simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
car-safe cdr-safe progn prog1 prog2))
-(defconst cl-safe-funcs '(* / % length memq list vector vectorp
+(defconst cl--safe-funcs '(* / % length memq list vector vectorp
< > <= >= = error))
-;;; Check if no side effects, and executes quickly.
-(defun cl-simple-expr-p (x &optional size)
+(defun cl--simple-expr-p (x &optional size)
+ "Check if no side effects, and executes quickly."
(or size (setq size 10))
- (if (and (consp x) (not (memq (car x) '(quote function function*))))
+ (if (and (consp x) (not (memq (car x) '(quote function cl-function))))
(and (symbolp (car x))
- (or (memq (car x) cl-simple-funcs)
+ (or (memq (car x) cl--simple-funcs)
(get (car x) 'side-effect-free))
(progn
(setq size (1- size))
(while (and (setq x (cdr x))
- (setq size (cl-simple-expr-p (car x) size))))
+ (setq size (cl--simple-expr-p (car x) size))))
(and (null x) (>= size 0) size)))
(and (> size 0) (1- size))))
-(defun cl-simple-exprs-p (xs)
- (while (and xs (cl-simple-expr-p (car xs)))
+(defun cl--simple-exprs-p (xs)
+ (while (and xs (cl--simple-expr-p (car xs)))
(setq xs (cdr xs)))
(not xs))
-;;; Check if no side effects.
-(defun cl-safe-expr-p (x)
- (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
+(defun cl--safe-expr-p (x)
+ "Check if no side effects."
+ (or (not (and (consp x) (not (memq (car x) '(quote function cl-function)))))
(and (symbolp (car x))
- (or (memq (car x) cl-simple-funcs)
- (memq (car x) cl-safe-funcs)
+ (or (memq (car x) cl--simple-funcs)
+ (memq (car x) cl--safe-funcs)
(get (car x) 'side-effect-free))
(progn
- (while (and (setq x (cdr x)) (cl-safe-expr-p (car x))))
+ (while (and (setq x (cdr x)) (cl--safe-expr-p (car x))))
(null x)))))
;;; Check if constant (i.e., no side effects or dependencies).
-(defun cl-const-expr-p (x)
+(defun cl--const-expr-p (x)
(cond ((consp x)
(or (eq (car x) 'quote)
- (and (memq (car x) '(function function*))
+ (and (memq (car x) '(function cl-function))
(or (symbolp (nth 1 x))
(and (eq (car-safe (nth 1 x)) 'lambda) 'func)))))
((symbolp x) (and (memq x '(nil t)) t))
(t t)))
-(defun cl-const-exprs-p (xs)
- (while (and xs (cl-const-expr-p (car xs)))
- (setq xs (cdr xs)))
- (not xs))
-
-(defun cl-const-expr-val (x)
- (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x)))
-
-(defun cl-expr-access-order (x v)
- ;; This apparently tries to return nil iff the expression X evaluates
- ;; the variables V in the same order as they appear in V (so as to
- ;; be able to replace those vars with the expressions they're bound
- ;; to).
- ;; FIXME: This is very naive, it doesn't even check to see if those
- ;; variables appear more than once.
- (if (cl-const-expr-p x) v
- (if (consp x)
- (progn
- (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v)))
- v)
- (if (eq x (car v)) (cdr v) '(t)))))
+(defun cl--const-expr-val (x)
+ (and (macroexp-const-p x) (if (consp x) (nth 1 x) x)))
-;;; Count number of times X refers to Y. Return nil for 0 times.
-(defun cl-expr-contains (x y)
+(defun cl--expr-contains (x y)
+ "Count number of times X refers to Y. Return nil for 0 times."
+ ;; FIXME: This is naive, and it will cl-count Y as referred twice in
+ ;; (let ((Y 1)) Y) even though it should be 0. Also it is often called on
+ ;; non-macroexpanded code, so it may also miss some occurrences that would
+ ;; only appear in the expanded code.
(cond ((equal y x) 1)
- ((and (consp x) (not (memq (car-safe x) '(quote function function*))))
+ ((and (consp x) (not (memq (car x) '(quote function cl-function))))
(let ((sum 0))
- (while x
- (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))))
+ (while (consp x)
+ (setq sum (+ sum (or (cl--expr-contains (pop x) y) 0))))
+ (setq sum (+ sum (or (cl--expr-contains x y) 0)))
(and (> sum 0) sum)))
(t nil)))
-(defun cl-expr-contains-any (x y)
- (while (and y (not (cl-expr-contains x (car y)))) (pop y))
+(defun cl--expr-contains-any (x y)
+ (while (and y (not (cl--expr-contains x (car y)))) (pop y))
y)
-;;; Check whether X may depend on any of the symbols in Y.
-(defun cl-expr-depends-p (x y)
- (and (not (cl-const-expr-p x))
- (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y))))
+(defun cl--expr-depends-p (x y)
+ "Check whether X may depend on any of the symbols in Y."
+ (and (not (macroexp-const-p x))
+ (or (not (cl--safe-expr-p x)) (cl--expr-contains-any x y))))
;;; Symbols.
-(defvar *gensym-counter*)
+(defvar cl--gensym-counter)
;;;###autoload
-(defun gensym (&optional prefix)
+(defun cl-gensym (&optional prefix)
"Generate a new uninterned symbol.
The name is made by appending a number to PREFIX, default \"G\"."
(let ((pfix (if (stringp prefix) prefix "G"))
(num (if (integerp prefix) prefix
- (prog1 *gensym-counter*
- (setq *gensym-counter* (1+ *gensym-counter*))))))
+ (prog1 cl--gensym-counter
+ (setq cl--gensym-counter (1+ cl--gensym-counter))))))
(make-symbol (format "%s%d" pfix num))))
;;;###autoload
-(defun gentemp (&optional prefix)
+(defun cl-gentemp (&optional prefix)
"Generate a new interned symbol with a unique name.
The name is made by appending a number to PREFIX, default \"G\"."
(let ((pfix (if (stringp prefix) prefix "G"))
name)
- (while (intern-soft (setq name (format "%s%d" pfix *gensym-counter*)))
- (setq *gensym-counter* (1+ *gensym-counter*)))
+ (while (intern-soft (setq name (format "%s%d" pfix cl--gensym-counter)))
+ (setq cl--gensym-counter (1+ cl--gensym-counter)))
(intern name)))
;;; Program structure.
-;;;###autoload
-(defmacro defun* (name args &rest body)
- "Define NAME as a function.
-Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+(def-edebug-spec cl-declarations
+ (&rest ("cl-declare" &rest sexp)))
-\(fn NAME ARGLIST [DOCSTRING] BODY...)"
- (let* ((res (cl-transform-lambda (cons args body) name))
- (form (list* 'defun name (cdr res))))
- (if (car res) (list 'progn (car res) form) form)))
+(def-edebug-spec cl-declarations-or-string
+ (&or stringp cl-declarations))
-;;;###autoload
-(defmacro defmacro* (name args &rest body)
- "Define NAME as a macro.
-Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+(def-edebug-spec cl-lambda-list
+ (([&rest arg]
+ [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
+ [&optional ["&rest" arg]]
+ [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ )))
-\(fn NAME ARGLIST [DOCSTRING] BODY...)"
- (let* ((res (cl-transform-lambda (cons args body) name))
- (form (list* 'defmacro name (cdr res))))
- (if (car res) (list 'progn (car res) form) form)))
+(def-edebug-spec cl-&optional-arg
+ (&or (arg &optional def-form arg) arg))
-;;;###autoload
-(defmacro function* (func)
- "Introduce a function.
-Like normal `function', except that if argument is a lambda form,
-its argument list allows full Common Lisp conventions."
- (if (eq (car-safe func) 'lambda)
- (let* ((res (cl-transform-lambda (cdr func) 'cl-none))
- (form (list 'function (cons 'lambda (cdr res)))))
- (if (car res) (list 'progn (car res) form) form))
- (list 'function func)))
-
-(defun cl-transform-function-property (func prop form)
- (let ((res (cl-transform-lambda form func)))
- (append '(progn) (cdr (cdr (car res)))
- (list (list 'put (list 'quote func) (list 'quote prop)
- (list 'function (cons 'lambda (cdr res))))))))
-
-(defconst lambda-list-keywords
- '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
+(def-edebug-spec cl-&key-arg
+ (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
-(defvar cl-macro-environment nil
- "Keep the list of currently active macros.
-It is a list of elements of the form either:
-- (SYMBOL . FUNCTION) where FUNCTION is the macro expansion function.
-- (SYMBOL-NAME . EXPANSION) where SYMBOL-NAME is the name of a symbol macro.")
-(defvar bind-block) (defvar bind-defs) (defvar bind-enquote)
-(defvar bind-inits) (defvar bind-lets) (defvar bind-forms)
+(defconst cl--lambda-list-keywords
+ '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
-(declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
+(defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote)
+(defvar cl--bind-inits) (defvar cl--bind-lets) (defvar cl--bind-forms)
-(defun cl--make-usage-var (x)
- "X can be a var or a (destructuring) lambda-list."
- (cond
- ((symbolp x) (make-symbol (upcase (symbol-name x))))
- ((consp x) (cl--make-usage-args x))
- (t x)))
-
-(defun cl--make-usage-args (arglist)
- ;; `orig-args' can contain &cl-defs (an internal
- ;; CL thingy I don't understand), so remove it.
- (let ((x (memq '&cl-defs arglist)))
- (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
- (let ((state nil))
- (mapcar (lambda (x)
- (cond
- ((symbolp x)
- (if (eq ?\& (aref (symbol-name x) 0))
- (setq state x)
- (make-symbol (upcase (symbol-name x)))))
- ((not (consp x)) x)
- ((memq state '(nil &rest)) (cl--make-usage-args x))
- (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
- (list*
- (if (and (consp (car x)) (eq state '&key))
- (list (caar x) (cl--make-usage-var (nth 1 (car x))))
- (cl--make-usage-var (car x)))
- (nth 1 x) ;INITFORM.
- (cl--make-usage-args (nthcdr 2 x)) ;SVAR.
- ))))
- arglist)))
-
-(defun cl-transform-lambda (form bind-block)
+(defun cl--transform-lambda (form bind-block)
(let* ((args (car form)) (body (cdr form)) (orig-args args)
- (bind-defs nil) (bind-enquote nil)
- (bind-inits nil) (bind-lets nil) (bind-forms nil)
+ (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil)
+ (cl--bind-inits nil) (cl--bind-lets nil) (cl--bind-forms nil)
(header nil) (simple-args nil))
(while (or (stringp (car body))
- (memq (car-safe (car body)) '(interactive declare)))
+ (memq (car-safe (car body)) '(interactive cl-declare)))
(push (pop body) header))
- (setq args (if (listp args) (copy-list args) (list '&rest args)))
+ (setq args (if (listp args) (cl-copy-list args) (list '&rest args)))
(let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
- (if (setq bind-defs (cadr (memq '&cl-defs args)))
- (setq args (delq '&cl-defs (delq bind-defs args))
- bind-defs (cadr bind-defs)))
- (if (setq bind-enquote (memq '&cl-quote args))
+ (if (setq cl--bind-defs (cadr (memq '&cl-defs args)))
+ (setq args (delq '&cl-defs (delq cl--bind-defs args))
+ cl--bind-defs (cadr cl--bind-defs)))
+ (if (setq cl--bind-enquote (memq '&cl-quote args))
(setq args (delq '&cl-quote args)))
(if (memq '&whole args) (error "&whole not currently implemented"))
- (let* ((p (memq '&environment args)) (v (cadr p)))
+ (let* ((p (memq '&environment args)) (v (cadr p))
+ (env-exp 'macroexpand-all-environment))
(if p (setq args (nconc (delq (car p) (delq v args))
- (list '&aux (list v 'cl-macro-environment))))))
+ (list '&aux (list v env-exp))))))
(while (and args (symbolp (car args))
(not (memq (car args) '(nil &rest &body &key &aux)))
(not (and (eq (car args) '&optional)
- (or bind-defs (consp (cadr args))))))
+ (or cl--bind-defs (consp (cadr args))))))
(push (pop args) simple-args))
- (or (eq bind-block 'cl-none)
- (setq body (list (list* 'block bind-block body))))
+ (or (eq cl--bind-block 'cl-none)
+ (setq body (list `(cl-block ,cl--bind-block ,@body))))
(if (null args)
- (list* nil (nreverse simple-args) (nconc (nreverse header) body))
+ (cl-list* nil (nreverse simple-args) (nconc (nreverse header) body))
(if (memq '&optional simple-args) (push '&optional args))
- (cl-do-arglist args nil (- (length simple-args)
- (if (memq '&optional simple-args) 1 0)))
- (setq bind-lets (nreverse bind-lets))
- (list* (and bind-inits (list* 'eval-when '(compile load eval)
- (nreverse bind-inits)))
+ (cl--do-arglist args nil (- (length simple-args)
+ (if (memq '&optional simple-args) 1 0)))
+ (setq cl--bind-lets (nreverse cl--bind-lets))
+ (cl-list* (and cl--bind-inits `(cl-eval-when (compile load eval)
+ ,@(nreverse cl--bind-inits)))
(nconc (nreverse simple-args)
- (list '&rest (car (pop bind-lets))))
+ (list '&rest (car (pop cl--bind-lets))))
(nconc (let ((hdr (nreverse header)))
;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not
(cons 'fn
(cl--make-usage-args orig-args))))
hdr)))
- (list (nconc (list 'let* bind-lets)
- (nreverse bind-forms) body)))))))
+ (list `(let* ,cl--bind-lets
+ ,@(nreverse cl--bind-forms)
+ ,@body)))))))
+
+;;;###autoload
+(defmacro cl-defun (name args &rest body)
+ "Define NAME as a function.
+Like normal `defun', except ARGLIST allows full Common Lisp conventions,
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug
+ ;; Same as defun but use cl-lambda-list.
+ (&define [&or name ("setf" :name setf name)]
+ cl-lambda-list
+ cl-declarations-or-string
+ [&optional ("interactive" interactive)]
+ def-body))
+ (doc-string 3)
+ (indent 2))
+ (let* ((res (cl--transform-lambda (cons args body) name))
+ (form `(defun ,name ,@(cdr res))))
+ (if (car res) `(progn ,(car res) ,form) form)))
+
+;; The lambda list for macros is different from that of normal lambdas.
+;; Note that &environment is only allowed as first or last items in the
+;; top level list.
+
+(def-edebug-spec cl-macro-list
+ (([&optional "&environment" arg]
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ [&optional "&environment" arg]
+ )))
+
+(def-edebug-spec cl-macro-arg
+ (&or arg cl-macro-list1))
+
+(def-edebug-spec cl-macro-list1
+ (([&optional "&whole" arg] ;; only allowed at lower levels
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ . [&or arg nil])))
+
+;;;###autoload
+(defmacro cl-defmacro (name args &rest body)
+ "Define NAME as a macro.
+Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug
+ (&define name cl-macro-list cl-declarations-or-string def-body))
+ (doc-string 3)
+ (indent 2))
+ (let* ((res (cl--transform-lambda (cons args body) name))
+ (form `(defmacro ,name ,@(cdr res))))
+ (if (car res) `(progn ,(car res) ,form) form)))
+
+(def-edebug-spec cl-lambda-expr
+ (&define ("lambda" cl-lambda-list
+ ;;cl-declarations-or-string
+ ;;[&optional ("interactive" interactive)]
+ def-body)))
+
+;; Redefine function-form to also match cl-function
+(def-edebug-spec function-form
+ ;; form at the end could also handle "function",
+ ;; but recognize it specially to avoid wrapping function forms.
+ (&or ([&or "quote" "function"] &or symbolp lambda-expr)
+ ("cl-function" cl-function)
+ form))
+
+;;;###autoload
+(defmacro cl-function (func)
+ "Introduce a function.
+Like normal `function', except that if argument is a lambda form,
+its argument list allows full Common Lisp conventions."
+ (declare (debug (&or symbolp cl-lambda-expr)))
+ (if (eq (car-safe func) 'lambda)
+ (let* ((res (cl--transform-lambda (cdr func) 'cl-none))
+ (form `(function (lambda . ,(cdr res)))))
+ (if (car res) `(progn ,(car res) ,form) form))
+ `(function ,func)))
+
+(declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
+
+(defun cl--make-usage-var (x)
+ "X can be a var or a (destructuring) lambda-list."
+ (cond
+ ((symbolp x) (make-symbol (upcase (symbol-name x))))
+ ((consp x) (cl--make-usage-args x))
+ (t x)))
-(defun cl-do-arglist (args expr &optional num) ; uses bind-*
+(defun cl--make-usage-args (arglist)
+ (if (cdr-safe (last arglist)) ;Not a proper list.
+ (let* ((last (last arglist))
+ (tail (cdr last)))
+ (unwind-protect
+ (progn
+ (setcdr last nil)
+ (nconc (cl--make-usage-args arglist) (cl--make-usage-var tail)))
+ (setcdr last tail)))
+ ;; `orig-args' can contain &cl-defs (an internal
+ ;; CL thingy I don't understand), so remove it.
+ (let ((x (memq '&cl-defs arglist)))
+ (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
+ (let ((state nil))
+ (mapcar (lambda (x)
+ (cond
+ ((symbolp x)
+ (let ((first (aref (symbol-name x) 0)))
+ (if (eq ?\& first)
+ (setq state x)
+ ;; Strip a leading underscore, since it only
+ ;; means that this argument is unused.
+ (make-symbol (upcase (if (eq ?_ first)
+ (substring (symbol-name x) 1)
+ (symbol-name x)))))))
+ ((not (consp x)) x)
+ ((memq state '(nil &rest)) (cl--make-usage-args x))
+ (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
+ (cl-list*
+ (if (and (consp (car x)) (eq state '&key))
+ (list (caar x) (cl--make-usage-var (nth 1 (car x))))
+ (cl--make-usage-var (car x)))
+ (nth 1 x) ;INITFORM.
+ (cl--make-usage-args (nthcdr 2 x)) ;SVAR.
+ ))))
+ arglist))))
+
+(defun cl--do-arglist (args expr &optional num) ; uses bind-*
(if (nlistp args)
- (if (or (memq args lambda-list-keywords) (not (symbolp args)))
+ (if (or (memq args cl--lambda-list-keywords) (not (symbolp args)))
(error "Invalid argument name: %s" args)
- (push (list args expr) bind-lets))
- (setq args (copy-list args))
+ (push (list args expr) cl--bind-lets))
+ (setq args (cl-copy-list args))
(let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
(let ((p (memq '&body args))) (if p (setcar p '&rest)))
(if (memq '&environment args) (error "&environment used incorrectly"))
(let ((save-args args)
(restarg (memq '&rest args))
- (safety (if (cl-compiling-file) cl-optimize-safety 3))
+ (safety (if (cl--compiling-file) cl-optimize-safety 3))
(keys nil)
(laterarg nil) (exactarg nil) minarg)
(or num (setq num 0))
(if (listp (cadr restarg))
(setq restarg (make-symbol "--cl-rest--"))
(setq restarg (cadr restarg)))
- (push (list restarg expr) bind-lets)
+ (push (list restarg expr) cl--bind-lets)
(if (eq (car args) '&whole)
- (push (list (cl-pop2 args) restarg) bind-lets))
+ (push (list (cl-pop2 args) restarg) cl--bind-lets))
(let ((p args))
(setq minarg restarg)
- (while (and p (not (memq (car p) lambda-list-keywords)))
+ (while (and p (not (memq (car p) cl--lambda-list-keywords)))
(or (eq p args) (setq minarg (list 'cdr minarg)))
(setq p (cdr p)))
(if (memq (car p) '(nil &aux))
- (setq minarg (list '= (list 'length restarg)
- (length (ldiff args p)))
+ (setq minarg `(= (length ,restarg)
+ ,(length (cl-ldiff args p)))
exactarg (not (eq args p)))))
- (while (and args (not (memq (car args) lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
restarg)))
- (cl-do-arglist
+ (cl--do-arglist
(pop args)
(if (or laterarg (= safety 0)) poparg
- (list 'if minarg poparg
- (list 'signal '(quote wrong-number-of-arguments)
- (list 'list (and (not (eq bind-block 'cl-none))
- (list 'quote bind-block))
- (list 'length restarg)))))))
+ `(if ,minarg ,poparg
+ (signal 'wrong-number-of-arguments
+ (list ,(and (not (eq cl--bind-block 'cl-none))
+ `',cl--bind-block)
+ (length ,restarg)))))))
(setq num (1+ num) laterarg t))
(while (and (eq (car args) '&optional) (pop args))
- (while (and args (not (memq (car args) lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
- (if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t)))
+ (if (cddr arg) (cl--do-arglist (nth 2 arg) `(and ,restarg t)))
(let ((def (if (cdr arg) (nth 1 arg)
- (or (car bind-defs)
- (nth 1 (assq (car arg) bind-defs)))))
- (poparg (list 'pop restarg)))
- (and def bind-enquote (setq def (list 'quote def)))
- (cl-do-arglist (car arg)
- (if def (list 'if restarg poparg def) poparg))
+ (or (car cl--bind-defs)
+ (nth 1 (assq (car arg) cl--bind-defs)))))
+ (poparg `(pop ,restarg)))
+ (and def cl--bind-enquote (setq def `',def))
+ (cl--do-arglist (car arg)
+ (if def `(if ,restarg ,poparg ,def) poparg))
(setq num (1+ num))))))
(if (eq (car args) '&rest)
(let ((arg (cl-pop2 args)))
- (if (consp arg) (cl-do-arglist arg restarg)))
+ (if (consp arg) (cl--do-arglist arg restarg)))
(or (eq (car args) '&key) (= safety 0) exactarg
- (push (list 'if restarg
- (list 'signal '(quote wrong-number-of-arguments)
- (list 'list
- (and (not (eq bind-block 'cl-none))
- (list 'quote bind-block))
- (list '+ num (list 'length restarg)))))
- bind-forms)))
+ (push `(if ,restarg
+ (signal 'wrong-number-of-arguments
+ (list
+ ,(and (not (eq cl--bind-block 'cl-none))
+ `',cl--bind-block)
+ (+ ,num (length ,restarg)))))
+ cl--bind-forms)))
(while (and (eq (car args) '&key) (pop args))
- (while (and args (not (memq (car args) lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
(let* ((karg (if (consp (car arg)) (caar arg)
- (intern (format ":%s" (car arg)))))
- (varg (if (consp (car arg)) (cadar arg) (car arg)))
+ (let ((name (symbol-name (car arg))))
+ ;; Strip a leading underscore, since it only
+ ;; means that this argument is unused, but
+ ;; shouldn't affect the key's name (bug#12367).
+ (if (eq ?_ (aref name 0))
+ (setq name (substring name 1)))
+ (intern (format ":%s" name)))))
+ (varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
(def (if (cdr arg) (cadr arg)
- (or (car bind-defs) (cadr (assq varg bind-defs)))))
- (look (list 'memq (list 'quote karg) restarg)))
- (and def bind-enquote (setq def (list 'quote def)))
+ (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs)))))
+ (look `(memq ',karg ,restarg)))
+ (and def cl--bind-enquote (setq def `',def))
(if (cddr arg)
(let* ((temp (or (nth 2 arg) (make-symbol "--cl-var--")))
- (val (list 'car (list 'cdr temp))))
- (cl-do-arglist temp look)
- (cl-do-arglist varg
- (list 'if temp
- (list 'prog1 val (list 'setq temp t))
- def)))
- (cl-do-arglist
+ (val `(car (cdr ,temp))))
+ (cl--do-arglist temp look)
+ (cl--do-arglist varg
+ `(if ,temp
+ (prog1 ,val (setq ,temp t))
+ ,def)))
+ (cl--do-arglist
varg
- (list 'car
- (list 'cdr
- (if (null def)
+ `(car (cdr ,(if (null def)
look
- (list 'or look
- (if (eq (cl-const-expr-p def) t)
- (list
- 'quote
- (list nil (cl-const-expr-val def)))
- (list 'list nil def))))))))
+ `(or ,look
+ ,(if (eq (cl--const-expr-p def) t)
+ `'(nil ,(cl--const-expr-val def))
+ `(list nil ,def))))))))
(push karg keys)))))
(setq keys (nreverse keys))
(or (and (eq (car args) '&allow-other-keys) (pop args))
(null keys) (= safety 0)
(let* ((var (make-symbol "--cl-keys--"))
(allow '(:allow-other-keys))
- (check (list
- 'while var
- (list
- 'cond
- (list (list 'memq (list 'car var)
- (list 'quote (append keys allow)))
- (list 'setq var (list 'cdr (list 'cdr var))))
- (list (list 'car
- (list 'cdr
- (list 'memq (cons 'quote allow)
- restarg)))
- (list 'setq var nil))
- (list t
- (list
- 'error
- (format "Keyword argument %%s not one of %s"
- keys)
- (list 'car var)))))))
- (push (list 'let (list (list var restarg)) check) bind-forms)))
+ (check `(while ,var
+ (cond
+ ((memq (car ,var) ',(append keys allow))
+ (setq ,var (cdr (cdr ,var))))
+ ((car (cdr (memq (quote ,@allow) ,restarg)))
+ (setq ,var nil))
+ (t
+ (error
+ ,(format "Keyword argument %%s not one of %s"
+ keys)
+ (car ,var)))))))
+ (push `(let ((,var ,restarg)) ,check) cl--bind-forms)))
(while (and (eq (car args) '&aux) (pop args))
- (while (and args (not (memq (car args) lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(if (consp (car args))
- (if (and bind-enquote (cadar args))
- (cl-do-arglist (caar args)
- (list 'quote (cadr (pop args))))
- (cl-do-arglist (caar args) (cadr (pop args))))
- (cl-do-arglist (pop args) nil))))
+ (if (and cl--bind-enquote (cl-cadar args))
+ (cl--do-arglist (caar args)
+ `',(cadr (pop args)))
+ (cl--do-arglist (caar args) (cadr (pop args))))
+ (cl--do-arglist (pop args) nil))))
(if args (error "Malformed argument list %s" save-args)))))
-(defun cl-arglist-args (args)
+(defun cl--arglist-args (args)
(if (nlistp args) (list args)
(let ((res nil) (kind nil) arg)
(while (consp args)
(setq arg (pop args))
- (if (memq arg lambda-list-keywords) (setq kind arg)
+ (if (memq arg cl--lambda-list-keywords) (setq kind arg)
(if (eq arg '&cl-defs) (pop args)
(and (consp arg) kind (setq arg (car arg)))
(and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg)))
- (setq res (nconc res (cl-arglist-args arg))))))
+ (setq res (nconc res (cl--arglist-args arg))))))
(nconc res (and args (list args))))))
;;;###autoload
-(defmacro destructuring-bind (args expr &rest body)
- (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
- (bind-defs nil) (bind-block 'cl-none) (bind-enquote nil))
- (cl-do-arglist (or args '(&aux)) expr)
- (append '(progn) bind-inits
- (list (nconc (list 'let* (nreverse bind-lets))
- (nreverse bind-forms) body)))))
+(defmacro cl-destructuring-bind (args expr &rest body)
+ (declare (indent 2)
+ (debug (&define cl-macro-list def-form cl-declarations def-body)))
+ (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-inits nil)
+ (cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil))
+ (cl--do-arglist (or args '(&aux)) expr)
+ (append '(progn) cl--bind-inits
+ (list `(let* ,(nreverse cl--bind-lets)
+ ,@(nreverse cl--bind-forms) ,@body)))))
-;;; The `eval-when' form.
+;;; The `cl-eval-when' form.
(defvar cl-not-toplevel nil)
;;;###autoload
-(defmacro eval-when (when &rest body)
+(defmacro cl-eval-when (when &rest body)
"Control when BODY is evaluated.
If `compile' is in WHEN, BODY is evaluated when compiled at top-level.
If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
\(fn (WHEN...) BODY...)"
- (if (and (fboundp 'cl-compiling-file) (cl-compiling-file)
+ (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body)))
+ (if (and (fboundp 'cl--compiling-file) (cl--compiling-file)
(not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge
(let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
(cl-not-toplevel t))
(if (or (memq 'load when) (memq :load-toplevel when))
- (if comp (cons 'progn (mapcar 'cl-compile-time-too body))
- (list* 'if nil nil body))
+ (if comp (cons 'progn (mapcar 'cl--compile-time-too body))
+ `(if nil nil ,@body))
(progn (if comp (eval (cons 'progn body))) nil)))
(and (or (memq 'eval when) (memq :execute when))
(cons 'progn body))))
-(defun cl-compile-time-too (form)
+(defun cl--compile-time-too (form)
(or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler))
(setq form (macroexpand
- form (cons '(eval-when) byte-compile-macro-environment))))
+ form (cons '(cl-eval-when) byte-compile-macro-environment))))
(cond ((eq (car-safe form) 'progn)
- (cons 'progn (mapcar 'cl-compile-time-too (cdr form))))
- ((eq (car-safe form) 'eval-when)
+ (cons 'progn (mapcar 'cl--compile-time-too (cdr form))))
+ ((eq (car-safe form) 'cl-eval-when)
(let ((when (nth 1 form)))
(if (or (memq 'eval when) (memq :execute when))
- (list* 'eval-when (cons 'compile when) (cddr form))
+ `(cl-eval-when (compile ,@when) ,@(cddr form))
form)))
(t (eval form) form)))
;;;###autoload
-(defmacro load-time-value (form &optional read-only)
+(defmacro cl-load-time-value (form &optional _read-only)
"Like `progn', but evaluates the body at load time.
The result of the body appears to the compiler as a quoted constant."
- (if (cl-compiling-file)
- (let* ((temp (gentemp "--cl-load-time--"))
- (set (list 'set (list 'quote temp) form)))
+ (declare (debug (form &optional sexp)))
+ (if (cl--compiling-file)
+ (let* ((temp (cl-gentemp "--cl-load-time--"))
+ (set `(set ',temp ,form)))
(if (and (fboundp 'byte-compile-file-form-defmumble)
(boundp 'this-kind) (boundp 'that-one))
(fset 'byte-compile-file-form
- (list 'lambda '(form)
- (list 'fset '(quote byte-compile-file-form)
- (list 'quote
- (symbol-function 'byte-compile-file-form)))
- (list 'byte-compile-file-form (list 'quote set))
- '(byte-compile-file-form form)))
+ `(lambda (form)
+ (fset 'byte-compile-file-form
+ ',(symbol-function 'byte-compile-file-form))
+ (byte-compile-file-form ',set)
+ (byte-compile-file-form form)))
(print set (symbol-value 'byte-compile--outbuffer)))
- (list 'symbol-value (list 'quote temp)))
- (list 'quote (eval form))))
+ `(symbol-value ',temp))
+ `',(eval form)))
;;; Conditional control structures.
;;;###autoload
-(defmacro case (expr &rest clauses)
+(defmacro cl-case (expr &rest clauses)
"Eval EXPR and choose among clauses on that value.
Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared
against each key in each KEYLIST; the corresponding BODY is evaluated.
-If no clause succeeds, case returns nil. A single atom may be used in
+If no clause succeeds, cl-case returns nil. A single atom may be used in
place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is
allowed only in the final clause, and matches if no other keys match.
Key values are compared by `eql'.
\n(fn EXPR (KEYLIST BODY...)...)"
- (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
+ (declare (indent 1) (debug (form &rest (sexp body))))
+ (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
(head-list nil)
(body (cons
'cond
(function
(lambda (c)
(cons (cond ((memq (car c) '(t otherwise)) t)
- ((eq (car c) 'ecase-error-flag)
- (list 'error "ecase failed: %s, %s"
- temp (list 'quote (reverse head-list))))
+ ((eq (car c) 'cl--ecase-error-flag)
+ `(error "cl-ecase failed: %s, %s"
+ ,temp ',(reverse head-list)))
((listp (car c))
(setq head-list (append (car c) head-list))
- (list 'member* temp (list 'quote (car c))))
+ `(cl-member ,temp ',(car c)))
(t
(if (memq (car c) head-list)
(error "Duplicate key in case: %s"
(car c)))
(push (car c) head-list)
- (list 'eql temp (list 'quote (car c)))))
+ `(eql ,temp ',(car c))))
(or (cdr c) '(nil)))))
clauses))))
(if (eq temp expr) body
- (list 'let (list (list temp expr)) body))))
+ `(let ((,temp ,expr)) ,body))))
;;;###autoload
-(defmacro ecase (expr &rest clauses)
- "Like `case', but error if no case fits.
+(defmacro cl-ecase (expr &rest clauses)
+ "Like `cl-case', but error if no case fits.
`otherwise'-clauses are not allowed.
\n(fn EXPR (KEYLIST BODY...)...)"
- (list* 'case expr (append clauses '((ecase-error-flag)))))
+ (declare (indent 1) (debug cl-case))
+ `(cl-case ,expr ,@clauses (cl--ecase-error-flag)))
;;;###autoload
-(defmacro typecase (expr &rest clauses)
+(defmacro cl-typecase (expr &rest clauses)
"Evals EXPR, chooses among clauses on that value.
Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it
satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
+cl-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
final clause, and matches if no other keys match.
\n(fn EXPR (TYPE BODY...)...)"
- (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
+ (declare (indent 1)
+ (debug (form &rest ([&or cl-type-spec "otherwise"] body))))
+ (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
(type-list nil)
(body (cons
'cond
(function
(lambda (c)
(cons (cond ((eq (car c) 'otherwise) t)
- ((eq (car c) 'ecase-error-flag)
- (list 'error "etypecase failed: %s, %s"
- temp (list 'quote (reverse type-list))))
+ ((eq (car c) 'cl--ecase-error-flag)
+ `(error "cl-etypecase failed: %s, %s"
+ ,temp ',(reverse type-list)))
(t
(push (car c) type-list)
- (cl-make-type-test temp (car c))))
+ (cl--make-type-test temp (car c))))
(or (cdr c) '(nil)))))
clauses))))
(if (eq temp expr) body
- (list 'let (list (list temp expr)) body))))
+ `(let ((,temp ,expr)) ,body))))
;;;###autoload
-(defmacro etypecase (expr &rest clauses)
- "Like `typecase', but error if no case fits.
+(defmacro cl-etypecase (expr &rest clauses)
+ "Like `cl-typecase', but error if no case fits.
`otherwise'-clauses are not allowed.
\n(fn EXPR (TYPE BODY...)...)"
- (list* 'typecase expr (append clauses '((ecase-error-flag)))))
+ (declare (indent 1) (debug cl-typecase))
+ `(cl-typecase ,expr ,@clauses (cl--ecase-error-flag)))
;;; Blocks and exits.
;;;###autoload
-(defmacro block (name &rest body)
+(defmacro cl-block (name &rest body)
"Define a lexically-scoped block named NAME.
-NAME may be any symbol. Code inside the BODY forms can call `return-from'
+NAME may be any symbol. Code inside the BODY forms can call `cl-return-from'
to jump prematurely out of the block. This differs from `catch' and `throw'
in two respects: First, the NAME is an unevaluated symbol rather than a
quoted symbol or other form; and second, NAME is lexically rather than
dynamically scoped: Only references to it within BODY will work. These
references may appear inside macro expansions, but not inside functions
called from BODY."
- (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body)
- (list 'cl-block-wrapper
- (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name)))
- body))))
+ (declare (indent 1) (debug (symbolp body)))
+ (if (cl--safe-expr-p `(progn ,@body)) `(progn ,@body)
+ `(cl--block-wrapper
+ (catch ',(intern (format "--cl-block-%s--" name))
+ ,@body))))
;;;###autoload
-(defmacro return (&optional result)
+(defmacro cl-return (&optional result)
"Return from the block named nil.
-This is equivalent to `(return-from nil RESULT)'."
- (list 'return-from nil result))
+This is equivalent to `(cl-return-from nil RESULT)'."
+ (declare (debug (&optional form)))
+ `(cl-return-from nil ,result))
;;;###autoload
-(defmacro return-from (name &optional result)
+(defmacro cl-return-from (name &optional result)
"Return from the block named NAME.
-This jumps out to the innermost enclosing `(block NAME ...)' form,
+This jumps out to the innermost enclosing `(cl-block NAME ...)' form,
returning RESULT from that form (or nil if RESULT is omitted).
This is compatible with Common Lisp, but note that `defun' and
`defmacro' do not create implicit blocks as they do in Common Lisp."
+ (declare (indent 1) (debug (symbolp &optional form)))
(let ((name2 (intern (format "--cl-block-%s--" name))))
- (list 'cl-block-throw (list 'quote name2) result)))
+ `(cl--block-throw ',name2 ,result)))
-;;; The "loop" macro.
+;;; The "cl-loop" macro.
-(defvar loop-args) (defvar loop-accum-var) (defvar loop-accum-vars)
-(defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps)
-(defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag)
-(defvar loop-initially) (defvar loop-map-form) (defvar loop-name)
-(defvar loop-result) (defvar loop-result-explicit)
-(defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs)
+(defvar cl--loop-args) (defvar cl--loop-accum-var) (defvar cl--loop-accum-vars)
+(defvar cl--loop-bindings) (defvar cl--loop-body) (defvar cl--loop-destr-temps)
+(defvar cl--loop-finally) (defvar cl--loop-finish-flag)
+(defvar cl--loop-first-flag)
+(defvar cl--loop-initially) (defvar cl--loop-map-form) (defvar cl--loop-name)
+(defvar cl--loop-result) (defvar cl--loop-result-explicit)
+(defvar cl--loop-result-var) (defvar cl--loop-steps) (defvar cl--loop-symbol-macs)
;;;###autoload
-(defmacro loop (&rest loop-args)
- "The Common Lisp `loop' macro.
+(defmacro cl-loop (&rest loop-args)
+ "The Common Lisp `cl-loop' macro.
Valid clauses are:
for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
finally return EXPR, named NAME.
\(fn CLAUSE...)"
- (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list loop-args))))))
- (list 'block nil (list* 'while t loop-args))
- (let ((loop-name nil) (loop-bindings nil)
- (loop-body nil) (loop-steps nil)
- (loop-result nil) (loop-result-explicit nil)
- (loop-result-var nil) (loop-finish-flag nil)
- (loop-accum-var nil) (loop-accum-vars nil)
- (loop-initially nil) (loop-finally nil)
- (loop-map-form nil) (loop-first-flag nil)
- (loop-destr-temps nil) (loop-symbol-macs nil))
- (setq loop-args (append loop-args '(cl-end-loop)))
- (while (not (eq (car loop-args) 'cl-end-loop)) (cl-parse-loop-clause))
- (if loop-finish-flag
- (push `((,loop-finish-flag t)) loop-bindings))
- (if loop-first-flag
- (progn (push `((,loop-first-flag t)) loop-bindings)
- (push `(setq ,loop-first-flag nil) loop-steps)))
- (let* ((epilogue (nconc (nreverse loop-finally)
- (list (or loop-result-explicit loop-result))))
- (ands (cl-loop-build-ands (nreverse loop-body)))
- (while-body (nconc (cadr ands) (nreverse loop-steps)))
+ (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)
+ (cl--loop-body nil) (cl--loop-steps nil)
+ (cl--loop-result nil) (cl--loop-result-explicit nil)
+ (cl--loop-result-var nil) (cl--loop-finish-flag nil)
+ (cl--loop-accum-var nil) (cl--loop-accum-vars nil)
+ (cl--loop-initially nil) (cl--loop-finally nil)
+ (cl--loop-map-form nil) (cl--loop-first-flag nil)
+ (cl--loop-destr-temps nil) (cl--loop-symbol-macs nil))
+ (setq cl--loop-args (append cl--loop-args '(cl-end-loop)))
+ (while (not (eq (car cl--loop-args) 'cl-end-loop)) (cl-parse-loop-clause))
+ (if cl--loop-finish-flag
+ (push `((,cl--loop-finish-flag t)) cl--loop-bindings))
+ (if cl--loop-first-flag
+ (progn (push `((,cl--loop-first-flag t)) cl--loop-bindings)
+ (push `(setq ,cl--loop-first-flag nil) cl--loop-steps)))
+ (let* ((epilogue (nconc (nreverse cl--loop-finally)
+ (list (or cl--loop-result-explicit cl--loop-result))))
+ (ands (cl--loop-build-ands (nreverse cl--loop-body)))
+ (while-body (nconc (cadr ands) (nreverse cl--loop-steps)))
(body (append
- (nreverse loop-initially)
- (list (if loop-map-form
- (list 'block '--cl-finish--
- (subst
- (if (eq (car ands) t) while-body
- (cons `(or ,(car ands)
- (return-from --cl-finish--
- nil))
- while-body))
- '--cl-map loop-map-form))
- (list* 'while (car ands) while-body)))
- (if loop-finish-flag
- (if (equal epilogue '(nil)) (list loop-result-var)
- `((if ,loop-finish-flag
- (progn ,@epilogue) ,loop-result-var)))
+ (nreverse cl--loop-initially)
+ (list (if cl--loop-map-form
+ `(cl-block --cl-finish--
+ ,(cl-subst
+ (if (eq (car ands) t) while-body
+ (cons `(or ,(car ands)
+ (cl-return-from --cl-finish--
+ nil))
+ while-body))
+ '--cl-map cl--loop-map-form))
+ `(while ,(car ands) ,@while-body)))
+ (if cl--loop-finish-flag
+ (if (equal epilogue '(nil)) (list cl--loop-result-var)
+ `((if ,cl--loop-finish-flag
+ (progn ,@epilogue) ,cl--loop-result-var)))
epilogue))))
- (if loop-result-var (push (list loop-result-var) loop-bindings))
- (while loop-bindings
- (if (cdar loop-bindings)
- (setq body (list (cl-loop-let (pop loop-bindings) body t)))
+ (if cl--loop-result-var (push (list cl--loop-result-var) cl--loop-bindings))
+ (while cl--loop-bindings
+ (if (cdar cl--loop-bindings)
+ (setq body (list (cl--loop-let (pop cl--loop-bindings) body t)))
(let ((lets nil))
- (while (and loop-bindings
- (not (cdar loop-bindings)))
- (push (car (pop loop-bindings)) lets))
- (setq body (list (cl-loop-let lets body nil))))))
- (if loop-symbol-macs
- (setq body (list (list* 'symbol-macrolet loop-symbol-macs body))))
- (list* 'block loop-name body)))))
+ (while (and cl--loop-bindings
+ (not (cdar cl--loop-bindings)))
+ (push (car (pop cl--loop-bindings)) lets))
+ (setq body (list (cl--loop-let lets body nil))))))
+ (if cl--loop-symbol-macs
+ (setq body (list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body))))
+ `(cl-block ,cl--loop-name ,@body)))))
+
+;; Below is a complete spec for cl-loop, in several parts that correspond
+;; to the syntax given in CLtL2. The specs do more than specify where
+;; the forms are; it also specifies, as much as Edebug allows, all the
+;; syntactically valid cl-loop clauses. The disadvantage of this
+;; completeness is rigidity, but the "for ... being" clause allows
+;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
+
+;; (def-edebug-spec cl-loop
+;; ([&optional ["named" symbolp]]
+;; [&rest
+;; &or
+;; ["repeat" form]
+;; loop-for-as
+;; loop-with
+;; loop-initial-final]
+;; [&rest loop-clause]
+;; ))
+
+;; (def-edebug-spec loop-with
+;; ("with" loop-var
+;; loop-type-spec
+;; [&optional ["=" form]]
+;; &rest ["and" loop-var
+;; loop-type-spec
+;; [&optional ["=" form]]]))
+
+;; (def-edebug-spec loop-for-as
+;; ([&or "for" "as"] loop-for-as-subclause
+;; &rest ["and" loop-for-as-subclause]))
+
+;; (def-edebug-spec loop-for-as-subclause
+;; (loop-var
+;; loop-type-spec
+;; &or
+;; [[&or "in" "on" "in-ref" "across-ref"]
+;; form &optional ["by" function-form]]
+
+;; ["=" form &optional ["then" form]]
+;; ["across" form]
+;; ["being"
+;; [&or "the" "each"]
+;; &or
+;; [[&or "element" "elements"]
+;; [&or "of" "in" "of-ref"] form
+;; &optional "using" ["index" symbolp]];; is this right?
+;; [[&or "hash-key" "hash-keys"
+;; "hash-value" "hash-values"]
+;; [&or "of" "in"]
+;; hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
+;; "hash-key" "hash-keys"] sexp)]]
+
+;; [[&or "symbol" "present-symbol" "external-symbol"
+;; "symbols" "present-symbols" "external-symbols"]
+;; [&or "in" "of"] package-p]
+
+;; ;; Extensions for Emacs Lisp, including Lucid Emacs.
+;; [[&or "frame" "frames"
+;; "screen" "screens"
+;; "buffer" "buffers"]]
+
+;; [[&or "window" "windows"]
+;; [&or "of" "in"] form]
+
+;; [[&or "overlay" "overlays"
+;; "extent" "extents"]
+;; [&or "of" "in"] form
+;; &optional [[&or "from" "to"] form]]
+
+;; [[&or "interval" "intervals"]
+;; [&or "in" "of"] form
+;; &optional [[&or "from" "to"] form]
+;; ["property" form]]
+
+;; [[&or "key-code" "key-codes"
+;; "key-seq" "key-seqs"
+;; "key-binding" "key-bindings"]
+;; [&or "in" "of"] form
+;; &optional ["using" ([&or "key-code" "key-codes"
+;; "key-seq" "key-seqs"
+;; "key-binding" "key-bindings"]
+;; sexp)]]
+;; ;; For arbitrary extensions, recognize anything else.
+;; [symbolp &rest &or symbolp form]
+;; ]
+
+;; ;; arithmetic - must be last since all parts are optional.
+;; [[&optional [[&or "from" "downfrom" "upfrom"] form]]
+;; [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
+;; [&optional ["by" form]]
+;; ]))
+
+;; (def-edebug-spec loop-initial-final
+;; (&or ["initially"
+;; ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
+;; &rest loop-non-atomic-expr]
+;; ["finally" &or
+;; [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
+;; ["return" form]]))
+
+;; (def-edebug-spec loop-and-clause
+;; (loop-clause &rest ["and" loop-clause]))
+
+;; (def-edebug-spec loop-clause
+;; (&or
+;; [[&or "while" "until" "always" "never" "thereis"] form]
+
+;; [[&or "collect" "collecting"
+;; "append" "appending"
+;; "nconc" "nconcing"
+;; "concat" "vconcat"] form
+;; [&optional ["into" loop-var]]]
+
+;; [[&or "count" "counting"
+;; "sum" "summing"
+;; "maximize" "maximizing"
+;; "minimize" "minimizing"] form
+;; [&optional ["into" loop-var]]
+;; loop-type-spec]
+
+;; [[&or "if" "when" "unless"]
+;; form loop-and-clause
+;; [&optional ["else" loop-and-clause]]
+;; [&optional "end"]]
+
+;; [[&or "do" "doing"] &rest loop-non-atomic-expr]
+
+;; ["return" form]
+;; loop-initial-final
+;; ))
+
+;; (def-edebug-spec loop-non-atomic-expr
+;; ([¬ atom] form))
+
+;; (def-edebug-spec loop-var
+;; ;; The symbolp must be last alternative to recognize e.g. (a b . c)
+;; ;; loop-var =>
+;; ;; (loop-var . [&or nil loop-var])
+;; ;; (symbolp . [&or nil loop-var])
+;; ;; (symbolp . loop-var)
+;; ;; (symbolp . (symbolp . [&or nil loop-var]))
+;; ;; (symbolp . (symbolp . loop-var))
+;; ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
+;; (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
+
+;; (def-edebug-spec loop-type-spec
+;; (&optional ["of-type" loop-d-type-spec]))
+
+;; (def-edebug-spec loop-d-type-spec
+;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
+
+
(defun cl-parse-loop-clause () ; uses loop-*
- (let ((word (pop loop-args))
+ (let ((word (pop cl--loop-args))
(hash-types '(hash-key hash-keys hash-value hash-values))
(key-types '(key-code key-codes key-seq key-seqs
key-binding key-bindings)))
(cond
- ((null loop-args)
- (error "Malformed `loop' macro"))
+ ((null cl--loop-args)
+ (error "Malformed `cl-loop' macro"))
((eq word 'named)
- (setq loop-name (pop loop-args)))
+ (setq cl--loop-name (pop cl--loop-args)))
((eq word 'initially)
- (if (memq (car loop-args) '(do doing)) (pop loop-args))
- (or (consp (car loop-args)) (error "Syntax error on `initially' clause"))
- (while (consp (car loop-args))
- (push (pop loop-args) loop-initially)))
+ (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args))
+ (or (consp (car cl--loop-args)) (error "Syntax error on `initially' clause"))
+ (while (consp (car cl--loop-args))
+ (push (pop cl--loop-args) cl--loop-initially)))
((eq word 'finally)
- (if (eq (car loop-args) 'return)
- (setq loop-result-explicit (or (cl-pop2 loop-args) '(quote nil)))
- (if (memq (car loop-args) '(do doing)) (pop loop-args))
- (or (consp (car loop-args)) (error "Syntax error on `finally' clause"))
- (if (and (eq (caar loop-args) 'return) (null loop-name))
- (setq loop-result-explicit (or (nth 1 (pop loop-args)) '(quote nil)))
- (while (consp (car loop-args))
- (push (pop loop-args) loop-finally)))))
+ (if (eq (car cl--loop-args) 'return)
+ (setq cl--loop-result-explicit (or (cl-pop2 cl--loop-args) '(quote nil)))
+ (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args))
+ (or (consp (car cl--loop-args)) (error "Syntax error on `finally' clause"))
+ (if (and (eq (caar cl--loop-args) 'return) (null cl--loop-name))
+ (setq cl--loop-result-explicit (or (nth 1 (pop cl--loop-args)) '(quote nil)))
+ (while (consp (car cl--loop-args))
+ (push (pop cl--loop-args) cl--loop-finally)))))
((memq word '(for as))
(let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
(ands nil))
(while
- ;; Use `gensym' rather than `make-symbol'. It's important that
+ ;; Use `cl-gensym' rather than `make-symbol'. It's important that
;; (not (eq (symbol-name var1) (symbol-name var2))) because
- ;; these vars get added to the cl-macro-environment.
- (let ((var (or (pop loop-args) (gensym "--cl-var--"))))
- (setq word (pop loop-args))
- (if (eq word 'being) (setq word (pop loop-args)))
- (if (memq word '(the each)) (setq word (pop loop-args)))
+ ;; these vars get added to the macro-environment.
+ (let ((var (or (pop cl--loop-args) (cl-gensym "--cl-var--"))))
+ (setq word (pop cl--loop-args))
+ (if (eq word 'being) (setq word (pop cl--loop-args)))
+ (if (memq word '(the each)) (setq word (pop cl--loop-args)))
(if (memq word '(buffer buffers))
- (setq word 'in loop-args (cons '(buffer-list) loop-args)))
+ (setq word 'in cl--loop-args (cons '(buffer-list) cl--loop-args)))
(cond
((memq word '(from downfrom upfrom to downto upto
above below by))
- (push word loop-args)
- (if (memq (car loop-args) '(downto above))
- (error "Must specify `from' value for downward loop"))
- (let* ((down (or (eq (car loop-args) 'downfrom)
- (memq (caddr loop-args) '(downto above))))
- (excl (or (memq (car loop-args) '(above below))
- (memq (caddr loop-args) '(above below))))
- (start (and (memq (car loop-args) '(from upfrom downfrom))
- (cl-pop2 loop-args)))
- (end (and (memq (car loop-args)
+ (push word cl--loop-args)
+ (if (memq (car cl--loop-args) '(downto above))
+ (error "Must specify `from' value for downward cl-loop"))
+ (let* ((down (or (eq (car cl--loop-args) 'downfrom)
+ (memq (cl-caddr cl--loop-args) '(downto above))))
+ (excl (or (memq (car cl--loop-args) '(above below))
+ (memq (cl-caddr cl--loop-args) '(above below))))
+ (start (and (memq (car cl--loop-args) '(from upfrom downfrom))
+ (cl-pop2 cl--loop-args)))
+ (end (and (memq (car cl--loop-args)
'(to upto downto above below))
- (cl-pop2 loop-args)))
- (step (and (eq (car loop-args) 'by) (cl-pop2 loop-args)))
- (end-var (and (not (cl-const-expr-p end))
+ (cl-pop2 cl--loop-args)))
+ (step (and (eq (car cl--loop-args) 'by) (cl-pop2 cl--loop-args)))
+ (end-var (and (not (macroexp-const-p end))
(make-symbol "--cl-var--")))
- (step-var (and (not (cl-const-expr-p step))
+ (step-var (and (not (macroexp-const-p step))
(make-symbol "--cl-var--"))))
(and step (numberp step) (<= step 0)
(error "Loop `by' value is not positive: %s" step))
(if end
(push (list
(if down (if excl '> '>=) (if excl '< '<=))
- var (or end-var end)) loop-body))
+ var (or end-var end)) cl--loop-body))
(push (list var (list (if down '- '+) var
(or step-var step 1)))
loop-for-steps)))
(let* ((on (eq word 'on))
(temp (if (and on (symbolp var))
var (make-symbol "--cl-var--"))))
- (push (list temp (pop loop-args)) loop-for-bindings)
- (push (list 'consp temp) loop-body)
+ (push (list temp (pop cl--loop-args)) loop-for-bindings)
+ (push `(consp ,temp) cl--loop-body)
(if (eq word 'in-ref)
- (push (list var (list 'car temp)) loop-symbol-macs)
+ (push (list var `(car ,temp)) cl--loop-symbol-macs)
(or (eq temp var)
(progn
(push (list var nil) loop-for-bindings)
- (push (list var (if on temp (list 'car temp)))
+ (push (list var (if on temp `(car ,temp)))
loop-for-sets))))
(push (list temp
- (if (eq (car loop-args) 'by)
- (let ((step (cl-pop2 loop-args)))
+ (if (eq (car cl--loop-args) 'by)
+ (let ((step (cl-pop2 cl--loop-args)))
(if (and (memq (car-safe step)
'(quote function
- function*))
+ cl-function))
(symbolp (nth 1 step)))
(list (nth 1 step) temp)
- (list 'funcall step temp)))
- (list 'cdr temp)))
+ `(funcall ,step ,temp)))
+ `(cdr ,temp)))
loop-for-steps)))
((eq word '=)
- (let* ((start (pop loop-args))
- (then (if (eq (car loop-args) 'then) (cl-pop2 loop-args) start)))
+ (let* ((start (pop cl--loop-args))
+ (then (if (eq (car cl--loop-args) 'then) (cl-pop2 cl--loop-args) start)))
(push (list var nil) loop-for-bindings)
- (if (or ands (eq (car loop-args) 'and))
+ (if (or ands (eq (car cl--loop-args) 'and))
(progn
(push `(,var
- (if ,(or loop-first-flag
- (setq loop-first-flag
+ (if ,(or cl--loop-first-flag
+ (setq cl--loop-first-flag
(make-symbol "--cl-var--")))
,start ,var))
loop-for-sets)
(push (list var then) loop-for-steps))
(push (list var
(if (eq start then) start
- `(if ,(or loop-first-flag
- (setq loop-first-flag
+ `(if ,(or cl--loop-first-flag
+ (setq cl--loop-first-flag
(make-symbol "--cl-var--")))
,start ,then)))
loop-for-sets))))
((memq word '(across across-ref))
(let ((temp-vec (make-symbol "--cl-vec--"))
(temp-idx (make-symbol "--cl-idx--")))
- (push (list temp-vec (pop loop-args)) loop-for-bindings)
+ (push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
(push (list temp-idx -1) loop-for-bindings)
- (push (list '< (list 'setq temp-idx (list '1+ temp-idx))
- (list 'length temp-vec)) loop-body)
+ (push `(< (setq ,temp-idx (1+ ,temp-idx))
+ (length ,temp-vec)) cl--loop-body)
(if (eq word 'across-ref)
- (push (list var (list 'aref temp-vec temp-idx))
- loop-symbol-macs)
+ (push (list var `(aref ,temp-vec ,temp-idx))
+ cl--loop-symbol-macs)
(push (list var nil) loop-for-bindings)
- (push (list var (list 'aref temp-vec temp-idx))
+ (push (list var `(aref ,temp-vec ,temp-idx))
loop-for-sets))))
((memq word '(element elements))
- (let ((ref (or (memq (car loop-args) '(in-ref of-ref))
- (and (not (memq (car loop-args) '(in of)))
+ (let ((ref (or (memq (car cl--loop-args) '(in-ref of-ref))
+ (and (not (memq (car cl--loop-args) '(in of)))
(error "Expected `of'"))))
- (seq (cl-pop2 loop-args))
+ (seq (cl-pop2 cl--loop-args))
(temp-seq (make-symbol "--cl-seq--"))
- (temp-idx (if (eq (car loop-args) 'using)
- (if (and (= (length (cadr loop-args)) 2)
- (eq (caadr loop-args) 'index))
- (cadr (cl-pop2 loop-args))
+ (temp-idx (if (eq (car cl--loop-args) 'using)
+ (if (and (= (length (cadr cl--loop-args)) 2)
+ (eq (cl-caadr cl--loop-args) 'index))
+ (cadr (cl-pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-idx--"))))
(push (list temp-seq seq) loop-for-bindings)
(push (list temp-idx 0) loop-for-bindings)
(if ref
(let ((temp-len (make-symbol "--cl-len--")))
- (push (list temp-len (list 'length temp-seq))
+ (push (list temp-len `(length ,temp-seq))
loop-for-bindings)
- (push (list var (list 'elt temp-seq temp-idx))
- loop-symbol-macs)
- (push (list '< temp-idx temp-len) loop-body))
+ (push (list var `(elt ,temp-seq ,temp-idx))
+ cl--loop-symbol-macs)
+ (push `(< ,temp-idx ,temp-len) cl--loop-body))
(push (list var nil) loop-for-bindings)
- (push (list 'and temp-seq
- (list 'or (list 'consp temp-seq)
- (list '< temp-idx
- (list 'length temp-seq))))
- loop-body)
- (push (list var (list 'if (list 'consp temp-seq)
- (list 'pop temp-seq)
- (list 'aref temp-seq temp-idx)))
+ (push `(and ,temp-seq
+ (or (consp ,temp-seq)
+ (< ,temp-idx (length ,temp-seq))))
+ cl--loop-body)
+ (push (list var `(if (consp ,temp-seq)
+ (pop ,temp-seq)
+ (aref ,temp-seq ,temp-idx)))
loop-for-sets))
- (push (list temp-idx (list '1+ temp-idx))
+ (push (list temp-idx `(1+ ,temp-idx))
loop-for-steps)))
((memq word hash-types)
- (or (memq (car loop-args) '(in of)) (error "Expected `of'"))
- (let* ((table (cl-pop2 loop-args))
- (other (if (eq (car loop-args) 'using)
- (if (and (= (length (cadr loop-args)) 2)
- (memq (caadr loop-args) hash-types)
- (not (eq (caadr loop-args) word)))
- (cadr (cl-pop2 loop-args))
+ (or (memq (car cl--loop-args) '(in of)) (error "Expected `of'"))
+ (let* ((table (cl-pop2 cl--loop-args))
+ (other (if (eq (car cl--loop-args) 'using)
+ (if (and (= (length (cadr cl--loop-args)) 2)
+ (memq (cl-caadr cl--loop-args) hash-types)
+ (not (eq (cl-caadr cl--loop-args) word)))
+ (cadr (cl-pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-var--"))))
(if (memq word '(hash-value hash-values))
(setq var (prog1 other (setq other var))))
- (setq loop-map-form
+ (setq cl--loop-map-form
`(maphash (lambda (,var ,other) . --cl-map) ,table))))
((memq word '(symbol present-symbol external-symbol
symbols present-symbols external-symbols))
- (let ((ob (and (memq (car loop-args) '(in of)) (cl-pop2 loop-args))))
- (setq loop-map-form
+ (let ((ob (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args))))
+ (setq cl--loop-map-form
`(mapatoms (lambda (,var) . --cl-map) ,ob))))
((memq word '(overlay overlays extent extents))
(let ((buf nil) (from nil) (to nil))
- (while (memq (car loop-args) '(in of from to))
- (cond ((eq (car loop-args) 'from) (setq from (cl-pop2 loop-args)))
- ((eq (car loop-args) 'to) (setq to (cl-pop2 loop-args)))
- (t (setq buf (cl-pop2 loop-args)))))
- (setq loop-map-form
- `(cl-map-extents
+ (while (memq (car cl--loop-args) '(in of from to))
+ (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args)))
+ ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args)))
+ (t (setq buf (cl-pop2 cl--loop-args)))))
+ (setq cl--loop-map-form
+ `(cl--map-overlays
(lambda (,var ,(make-symbol "--cl-var--"))
(progn . --cl-map) nil)
,buf ,from ,to))))
(let ((buf nil) (prop nil) (from nil) (to nil)
(var1 (make-symbol "--cl-var1--"))
(var2 (make-symbol "--cl-var2--")))
- (while (memq (car loop-args) '(in of property from to))
- (cond ((eq (car loop-args) 'from) (setq from (cl-pop2 loop-args)))
- ((eq (car loop-args) 'to) (setq to (cl-pop2 loop-args)))
- ((eq (car loop-args) 'property)
- (setq prop (cl-pop2 loop-args)))
- (t (setq buf (cl-pop2 loop-args)))))
+ (while (memq (car cl--loop-args) '(in of property from to))
+ (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args)))
+ ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args)))
+ ((eq (car cl--loop-args) 'property)
+ (setq prop (cl-pop2 cl--loop-args)))
+ (t (setq buf (cl-pop2 cl--loop-args)))))
(if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
(setq var1 (car var) var2 (cdr var))
- (push (list var (list 'cons var1 var2)) loop-for-sets))
- (setq loop-map-form
- `(cl-map-intervals
+ (push (list var `(cons ,var1 ,var2)) loop-for-sets))
+ (setq cl--loop-map-form
+ `(cl--map-intervals
(lambda (,var1 ,var2) . --cl-map)
,buf ,prop ,from ,to))))
((memq word key-types)
- (or (memq (car loop-args) '(in of)) (error "Expected `of'"))
- (let ((map (cl-pop2 loop-args))
- (other (if (eq (car loop-args) 'using)
- (if (and (= (length (cadr loop-args)) 2)
- (memq (caadr loop-args) key-types)
- (not (eq (caadr loop-args) word)))
- (cadr (cl-pop2 loop-args))
+ (or (memq (car cl--loop-args) '(in of)) (error "Expected `of'"))
+ (let ((cl-map (cl-pop2 cl--loop-args))
+ (other (if (eq (car cl--loop-args) 'using)
+ (if (and (= (length (cadr cl--loop-args)) 2)
+ (memq (cl-caadr cl--loop-args) key-types)
+ (not (eq (cl-caadr cl--loop-args) word)))
+ (cadr (cl-pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-var--"))))
(if (memq word '(key-binding key-bindings))
(setq var (prog1 other (setq other var))))
- (setq loop-map-form
+ (setq cl--loop-map-form
`(,(if (memq word '(key-seq key-seqs))
- 'cl-map-keymap-recursively 'map-keymap)
- (lambda (,var ,other) . --cl-map) ,map))))
+ 'cl--map-keymap-recursively 'map-keymap)
+ (lambda (,var ,other) . --cl-map) ,cl-map))))
((memq word '(frame frames screen screens))
(let ((temp (make-symbol "--cl-var--")))
(push (list var '(selected-frame))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (push (list 'prog1 (list 'not (list 'eq var temp))
- (list 'or temp (list 'setq temp var)))
- loop-body)
- (push (list var (list 'next-frame var))
+ (push `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var)))
+ cl--loop-body)
+ (push (list var `(next-frame ,var))
loop-for-steps)))
((memq word '(window windows))
- (let ((scr (and (memq (car loop-args) '(in of)) (cl-pop2 loop-args)))
+ (let ((scr (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args)))
(temp (make-symbol "--cl-var--"))
(minip (make-symbol "--cl-minip--")))
(push (list var (if scr
- (list 'frame-selected-window scr)
+ `(frame-selected-window ,scr)
'(selected-window)))
loop-for-bindings)
;; If we started in the minibuffer, we need to
;; ensure that next-window will bring us back there
;; at some point. (Bug#7492).
- ;; (Consider using walk-windows instead of loop if
+ ;; (Consider using walk-windows instead of cl-loop if
;; you care about such things.)
(push (list minip `(minibufferp (window-buffer ,var)))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (push (list 'prog1 (list 'not (list 'eq var temp))
- (list 'or temp (list 'setq temp var)))
- loop-body)
- (push (list var (list 'next-window var minip))
+ (push `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var)))
+ cl--loop-body)
+ (push (list var `(next-window ,var ,minip))
loop-for-steps)))
(t
(let ((handler (and (symbolp word)
- (get word 'cl-loop-for-handler))))
+ (get word 'cl--loop-for-handler))))
(if handler
(funcall handler var)
(error "Expected a `for' preposition, found %s" word)))))
- (eq (car loop-args) 'and))
+ (eq (car cl--loop-args) 'and))
(setq ands t)
- (pop loop-args))
+ (pop cl--loop-args))
(if (and ands loop-for-bindings)
- (push (nreverse loop-for-bindings) loop-bindings)
- (setq loop-bindings (nconc (mapcar 'list loop-for-bindings)
- loop-bindings)))
+ (push (nreverse loop-for-bindings) cl--loop-bindings)
+ (setq cl--loop-bindings (nconc (mapcar 'list loop-for-bindings)
+ cl--loop-bindings)))
(if loop-for-sets
- (push (list 'progn
- (cl-loop-let (nreverse loop-for-sets) 'setq ands)
- t) loop-body))
+ (push `(progn
+ ,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
+ t) cl--loop-body))
(if loop-for-steps
- (push (cons (if ands 'psetq 'setq)
+ (push (cons (if ands 'cl-psetq 'setq)
(apply 'append (nreverse loop-for-steps)))
- loop-steps))))
+ cl--loop-steps))))
((eq word 'repeat)
(let ((temp (make-symbol "--cl-var--")))
- (push (list (list temp (pop loop-args))) loop-bindings)
- (push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body)))
+ (push (list (list temp (pop cl--loop-args))) cl--loop-bindings)
+ (push `(>= (setq ,temp (1- ,temp)) 0) cl--loop-body)))
((memq word '(collect collecting))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum nil 'nreverse)))
- (if (eq var loop-accum-var)
- (push (list 'progn (list 'push what var) t) loop-body)
- (push (list 'progn
- (list 'setq var (list 'nconc var (list 'list what)))
- t) loop-body))))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum nil 'nreverse)))
+ (if (eq var cl--loop-accum-var)
+ (push `(progn (push ,what ,var) t) cl--loop-body)
+ (push `(progn
+ (setq ,var (nconc ,var (list ,what)))
+ t) cl--loop-body))))
((memq word '(nconc nconcing append appending))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum nil 'nreverse)))
- (push (list 'progn
- (list 'setq var
- (if (eq var loop-accum-var)
- (list 'nconc
- (list (if (memq word '(nconc nconcing))
- 'nreverse 'reverse)
- what)
- var)
- (list (if (memq word '(nconc nconcing))
- 'nconc 'append)
- var what))) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum nil 'nreverse)))
+ (push `(progn
+ (setq ,var
+ ,(if (eq var cl--loop-accum-var)
+ `(nconc
+ (,(if (memq word '(nconc nconcing))
+ #'nreverse #'reverse)
+ ,what)
+ ,var)
+ `(,(if (memq word '(nconc nconcing))
+ #'nconc #'append)
+ ,var ,what))) t) cl--loop-body)))
((memq word '(concat concating))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum "")))
- (push (list 'progn (list 'callf 'concat var what) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum "")))
+ (push `(progn (cl-callf concat ,var ,what) t) cl--loop-body)))
((memq word '(vconcat vconcating))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum [])))
- (push (list 'progn (list 'callf 'vconcat var what) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum [])))
+ (push `(progn (cl-callf vconcat ,var ,what) t) cl--loop-body)))
((memq word '(sum summing))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum 0)))
- (push (list 'progn (list 'incf var what) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum 0)))
+ (push `(progn (cl-incf ,var ,what) t) cl--loop-body)))
((memq word '(count counting))
- (let ((what (pop loop-args))
- (var (cl-loop-handle-accum 0)))
- (push (list 'progn (list 'if what (list 'incf var)) t) loop-body)))
+ (let ((what (pop cl--loop-args))
+ (var (cl--loop-handle-accum 0)))
+ (push `(progn (if ,what (cl-incf ,var)) t) cl--loop-body)))
((memq word '(minimize minimizing maximize maximizing))
- (let* ((what (pop loop-args))
- (temp (if (cl-simple-expr-p what) what (make-symbol "--cl-var--")))
- (var (cl-loop-handle-accum nil))
+ (let* ((what (pop cl--loop-args))
+ (temp (if (cl--simple-expr-p what) what (make-symbol "--cl-var--")))
+ (var (cl--loop-handle-accum nil))
(func (intern (substring (symbol-name word) 0 3)))
- (set (list 'setq var (list 'if var (list func var temp) temp))))
- (push (list 'progn (if (eq temp what) set
- (list 'let (list (list temp what)) set))
- t) loop-body)))
+ (set `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
+ (push `(progn ,(if (eq temp what) set
+ `(let ((,temp ,what)) ,set))
+ t) cl--loop-body)))
((eq word 'with)
(let ((bindings nil))
- (while (progn (push (list (pop loop-args)
- (and (eq (car loop-args) '=) (cl-pop2 loop-args)))
+ (while (progn (push (list (pop cl--loop-args)
+ (and (eq (car cl--loop-args) '=) (cl-pop2 cl--loop-args)))
bindings)
- (eq (car loop-args) 'and))
- (pop loop-args))
- (push (nreverse bindings) loop-bindings)))
+ (eq (car cl--loop-args) 'and))
+ (pop cl--loop-args))
+ (push (nreverse bindings) cl--loop-bindings)))
((eq word 'while)
- (push (pop loop-args) loop-body))
+ (push (pop cl--loop-args) cl--loop-body))
((eq word 'until)
- (push (list 'not (pop loop-args)) loop-body))
+ (push `(not ,(pop cl--loop-args)) cl--loop-body))
((eq word 'always)
- (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
- (push (list 'setq loop-finish-flag (pop loop-args)) loop-body)
- (setq loop-result t))
+ (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+ (push `(setq ,cl--loop-finish-flag ,(pop cl--loop-args)) cl--loop-body)
+ (setq cl--loop-result t))
((eq word 'never)
- (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
- (push (list 'setq loop-finish-flag (list 'not (pop loop-args)))
- loop-body)
- (setq loop-result t))
+ (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+ (push `(setq ,cl--loop-finish-flag (not ,(pop cl--loop-args)))
+ cl--loop-body)
+ (setq cl--loop-result t))
((eq word 'thereis)
- (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
- (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--")))
- (push (list 'setq loop-finish-flag
- (list 'not (list 'setq loop-result-var (pop loop-args))))
- loop-body))
+ (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+ (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--")))
+ (push `(setq ,cl--loop-finish-flag
+ (not (setq ,cl--loop-result-var ,(pop cl--loop-args))))
+ cl--loop-body))
((memq word '(if when unless))
- (let* ((cond (pop loop-args))
- (then (let ((loop-body nil))
+ (let* ((cond (pop cl--loop-args))
+ (then (let ((cl--loop-body nil))
(cl-parse-loop-clause)
- (cl-loop-build-ands (nreverse loop-body))))
- (else (let ((loop-body nil))
- (if (eq (car loop-args) 'else)
- (progn (pop loop-args) (cl-parse-loop-clause)))
- (cl-loop-build-ands (nreverse loop-body))))
+ (cl--loop-build-ands (nreverse cl--loop-body))))
+ (else (let ((cl--loop-body nil))
+ (if (eq (car cl--loop-args) 'else)
+ (progn (pop cl--loop-args) (cl-parse-loop-clause)))
+ (cl--loop-build-ands (nreverse cl--loop-body))))
(simple (and (eq (car then) t) (eq (car else) t))))
- (if (eq (car loop-args) 'end) (pop loop-args))
+ (if (eq (car cl--loop-args) 'end) (pop cl--loop-args))
(if (eq word 'unless) (setq then (prog1 else (setq else then))))
(let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
(if simple (nth 1 else) (list (nth 2 else))))))
- (if (cl-expr-contains form 'it)
+ (if (cl--expr-contains form 'it)
(let ((temp (make-symbol "--cl-var--")))
- (push (list temp) loop-bindings)
- (setq form (list* 'if (list 'setq temp cond)
- (subst temp 'it form))))
- (setq form (list* 'if cond form)))
- (push (if simple (list 'progn form t) form) loop-body))))
+ (push (list temp) cl--loop-bindings)
+ (setq form `(if (setq ,temp ,cond)
+ ,@(cl-subst temp 'it form))))
+ (setq form `(if ,cond ,@form)))
+ (push (if simple `(progn ,form t) form) cl--loop-body))))
((memq word '(do doing))
(let ((body nil))
- (or (consp (car loop-args)) (error "Syntax error on `do' clause"))
- (while (consp (car loop-args)) (push (pop loop-args) body))
- (push (cons 'progn (nreverse (cons t body))) loop-body)))
+ (or (consp (car cl--loop-args)) (error "Syntax error on `do' clause"))
+ (while (consp (car cl--loop-args)) (push (pop cl--loop-args) body))
+ (push (cons 'progn (nreverse (cons t body))) cl--loop-body)))
((eq word 'return)
- (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-var--")))
- (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--")))
- (push (list 'setq loop-result-var (pop loop-args)
- loop-finish-flag nil) loop-body))
+ (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-var--")))
+ (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--")))
+ (push `(setq ,cl--loop-result-var ,(pop cl--loop-args)
+ ,cl--loop-finish-flag nil) cl--loop-body))
(t
- (let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
- (or handler (error "Expected a loop keyword, found %s" word))
+ (let ((handler (and (symbolp word) (get word 'cl--loop-handler))))
+ (or handler (error "Expected a cl-loop keyword, found %s" word))
(funcall handler))))
- (if (eq (car loop-args) 'and)
- (progn (pop loop-args) (cl-parse-loop-clause)))))
+ (if (eq (car cl--loop-args) 'and)
+ (progn (pop cl--loop-args) (cl-parse-loop-clause)))))
-(defun cl-loop-let (specs body par) ; uses loop-*
+(defun cl--loop-let (specs body par) ; uses loop-*
(let ((p specs) (temps nil) (new nil))
- (while (and p (or (symbolp (car-safe (car p))) (null (cadar p))))
+ (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p))))
(setq p (cdr p)))
(and par p
(progn
(setq par nil p specs)
(while p
- (or (cl-const-expr-p (cadar p))
+ (or (macroexp-const-p (cl-cadar p))
(let ((temp (make-symbol "--cl-var--")))
- (push (list temp (cadar p)) temps)
+ (push (list temp (cl-cadar p)) temps)
(setcar (cdar p) temp)))
(setq p (cdr p)))))
(while specs
(if (and (consp (car specs)) (listp (caar specs)))
(let* ((spec (caar specs)) (nspecs nil)
(expr (cadr (pop specs)))
- (temp (cdr (or (assq spec loop-destr-temps)
+ (temp (cdr (or (assq spec cl--loop-destr-temps)
(car (push (cons spec (or (last spec 0)
(make-symbol "--cl-var--")))
- loop-destr-temps))))))
+ cl--loop-destr-temps))))))
(push (list temp expr) new)
(while (consp spec)
(push (list (pop spec)
(setq specs (nconc (nreverse nspecs) specs)))
(push (pop specs) new)))
(if (eq body 'setq)
- (let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new)))))
- (if temps (list 'let* (nreverse temps) set) set))
- (list* (if par 'let 'let*)
- (nconc (nreverse temps) (nreverse new)) body))))
-
-(defun cl-loop-handle-accum (def &optional func) ; uses loop-*
- (if (eq (car loop-args) 'into)
- (let ((var (cl-pop2 loop-args)))
- (or (memq var loop-accum-vars)
- (progn (push (list (list var def)) loop-bindings)
- (push var loop-accum-vars)))
+ (let ((set (cons (if par 'cl-psetq 'setq) (apply 'nconc (nreverse new)))))
+ (if temps `(let* ,(nreverse temps) ,set) set))
+ `(,(if par 'let 'let*)
+ ,(nconc (nreverse temps) (nreverse new)) ,@body))))
+
+(defun cl--loop-handle-accum (def &optional func) ; uses loop-*
+ (if (eq (car cl--loop-args) 'into)
+ (let ((var (cl-pop2 cl--loop-args)))
+ (or (memq var cl--loop-accum-vars)
+ (progn (push (list (list var def)) cl--loop-bindings)
+ (push var cl--loop-accum-vars)))
var)
- (or loop-accum-var
+ (or cl--loop-accum-var
(progn
- (push (list (list (setq loop-accum-var (make-symbol "--cl-var--")) def))
- loop-bindings)
- (setq loop-result (if func (list func loop-accum-var)
- loop-accum-var))
- loop-accum-var))))
-
-(defun cl-loop-build-ands (clauses)
+ (push (list (list (setq cl--loop-accum-var (make-symbol "--cl-var--")) def))
+ cl--loop-bindings)
+ (setq cl--loop-result (if func (list func cl--loop-accum-var)
+ cl--loop-accum-var))
+ cl--loop-accum-var))))
+
+(defun cl--loop-build-ands (clauses)
+ "Return various representations of (and . CLAUSES).
+CLAUSES is a list of Elisp expressions, where clauses of the form
+\(progn E1 E2 E3 .. t) are the focus of particular optimizations.
+The return value has shape (COND BODY COMBO)
+such that COMBO is equivalent to (and . CLAUSES)."
(let ((ands nil)
(body nil))
+ ;; Look through `clauses', trying to optimize (progn ,@A t) (progn ,@B) ,@C
+ ;; into (progn ,@A ,@B) ,@C.
(while clauses
(if (and (eq (car-safe (car clauses)) 'progn)
(eq (car (last (car clauses))) t))
(setq clauses (cons (nconc (butlast (car clauses))
(if (eq (car-safe (cadr clauses))
'progn)
- (cdadr clauses)
+ (cl-cdadr clauses)
(list (cadr clauses))))
(cddr clauses)))
+ ;; A final (progn ,@A t) is moved outside of the `and'.
(setq body (cdr (butlast (pop clauses)))))
(push (pop clauses) ands)))
(setq ands (or (nreverse ands) (list t)))
;;; Other iteration control structures.
;;;###autoload
-(defmacro do (steps endtest &rest body)
- "The Common Lisp `do' loop.
+(defmacro cl-do (steps endtest &rest body)
+ "The Common Lisp `cl-do' loop.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
+ (declare (indent 2)
+ (debug
+ ((&rest &or symbolp (symbolp &optional form form))
+ (form body)
+ cl-declarations body)))
(cl-expand-do-loop steps endtest body nil))
;;;###autoload
-(defmacro do* (steps endtest &rest body)
- "The Common Lisp `do*' loop.
+(defmacro cl-do* (steps endtest &rest body)
+ "The Common Lisp `cl-do*' loop.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
+ (declare (indent 2) (debug cl-do))
(cl-expand-do-loop steps endtest body t))
(defun cl-expand-do-loop (steps endtest body star)
- (list 'block nil
- (list* (if star 'let* 'let)
- (mapcar (function (lambda (c)
- (if (consp c) (list (car c) (nth 1 c)) c)))
- steps)
- (list* 'while (list 'not (car endtest))
- (append body
- (let ((sets (mapcar
- (function
- (lambda (c)
- (and (consp c) (cdr (cdr c))
- (list (car c) (nth 2 c)))))
- steps)))
- (setq sets (delq nil sets))
- (and sets
- (list (cons (if (or star (not (cdr sets)))
- 'setq 'psetq)
- (apply 'append sets)))))))
- (or (cdr endtest) '(nil)))))
+ `(cl-block nil
+ (,(if star 'let* 'let)
+ ,(mapcar (lambda (c) (if (consp c) (list (car c) (nth 1 c)) c))
+ steps)
+ (while (not ,(car endtest))
+ ,@body
+ ,@(let ((sets (mapcar (lambda (c)
+ (and (consp c) (cdr (cdr c))
+ (list (car c) (nth 2 c))))
+ steps)))
+ (setq sets (delq nil sets))
+ (and sets
+ (list (cons (if (or star (not (cdr sets)))
+ 'setq 'cl-psetq)
+ (apply 'append sets))))))
+ ,@(or (cdr endtest) '(nil)))))
;;;###autoload
-(defmacro dolist (spec &rest body)
+(defmacro cl-dolist (spec &rest body)
"Loop over a list.
Evaluate BODY with VAR bound to each `car' from LIST, in turn.
Then evaluate RESULT to get return value, default nil.
An implicit nil block is established around the loop.
\(fn (VAR LIST [RESULT]) BODY...)"
- (let ((temp (make-symbol "--cl-dolist-temp--")))
- ;; FIXME: Copy&pasted from subr.el.
- `(block nil
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other is slightly faster (and has cleaner semantics)
- ;; with lexical scoping.
- ,(if lexical-binding
- `(let ((,temp ,(nth 1 spec)))
- (while ,temp
- (let ((,(car spec) (car ,temp)))
- ,@body
- (setq ,temp (cdr ,temp))))
- ,@(if (cdr (cdr spec))
- ;; FIXME: This let often leads to "unused var" warnings.
- `((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
- `(let ((,temp ,(nth 1 spec))
- ,(car spec))
- (while ,temp
- (setq ,(car spec) (car ,temp))
- ,@body
- (setq ,temp (cdr ,temp)))
- ,@(if (cdr (cdr spec))
- `((setq ,(car spec) nil) ,@(cddr spec))))))))
+ (declare (debug ((symbolp form &optional form) cl-declarations body))
+ (indent 1))
+ `(cl-block nil
+ (,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist)
+ ,spec ,@body)))
;;;###autoload
-(defmacro dotimes (spec &rest body)
+(defmacro cl-dotimes (spec &rest body)
"Loop a certain number of times.
Evaluate BODY with VAR bound to successive integers from 0, inclusive,
to COUNT, exclusive. Then evaluate RESULT to get return value, default
nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
- (let ((temp (make-symbol "--cl-dotimes-temp--"))
- (end (nth 1 spec)))
- ;; FIXME: Copy&pasted from subr.el.
- `(block nil
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other has cleaner semantics.
- ,(if lexical-binding
- (let ((counter '--dotimes-counter--))
- `(let ((,temp ,end)
- (,counter 0))
- (while (< ,counter ,temp)
- (let ((,(car spec) ,counter))
- ,@body)
- (setq ,counter (1+ ,counter)))
- ,@(if (cddr spec)
- ;; FIXME: This let often leads to "unused var" warnings.
- `((let ((,(car spec) ,counter)) ,@(cddr spec))))))
- `(let ((,temp ,end)
- (,(car spec) 0))
- (while (< ,(car spec) ,temp)
- ,@body
- (incf ,(car spec)))
- ,@(cdr (cdr spec)))))))
+ (declare (debug cl-dolist) (indent 1))
+ `(cl-block nil
+ (,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes)
+ ,spec ,@body)))
;;;###autoload
-(defmacro do-symbols (spec &rest body)
+(defmacro cl-do-symbols (spec &rest body)
"Loop over all symbols.
Evaluate BODY with VAR bound to each interned symbol, or to each symbol
from OBARRAY.
\(fn (VAR [OBARRAY [RESULT]]) BODY...)"
+ (declare (indent 1)
+ (debug ((symbolp &optional form form) cl-declarations body)))
;; Apparently this doesn't have an implicit block.
- (list 'block nil
- (list 'let (list (car spec))
- (list* 'mapatoms
- (list 'function (list* 'lambda (list (car spec)) body))
- (and (cadr spec) (list (cadr spec))))
- (caddr spec))))
+ `(cl-block nil
+ (let (,(car spec))
+ (mapatoms #'(lambda (,(car spec)) ,@body)
+ ,@(and (cadr spec) (list (cadr spec))))
+ ,(cl-caddr spec))))
;;;###autoload
-(defmacro do-all-symbols (spec &rest body)
- (list* 'do-symbols (list (car spec) nil (cadr spec)) body))
+(defmacro cl-do-all-symbols (spec &rest body)
+ (declare (indent 1) (debug ((symbolp &optional form) cl-declarations body)))
+ `(cl-do-symbols (,(car spec) nil ,(cadr spec)) ,@body))
;;; Assignments.
;;;###autoload
-(defmacro psetq (&rest args)
+(defmacro cl-psetq (&rest args)
"Set SYMs to the values VALs in parallel.
This is like `setq', except that all VAL forms are evaluated (in order)
before assigning any symbols SYM to the corresponding values.
\(fn SYM VAL SYM VAL ...)"
- (cons 'psetf args))
+ (declare (debug setq))
+ (cons 'cl-psetf args))
;;; Binding control structures.
;;;###autoload
-(defmacro progv (symbols values &rest body)
+(defmacro cl-progv (symbols values &rest body)
"Bind SYMBOLS to VALUES dynamically in BODY.
The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
Each symbol in the first list is bound to the corresponding value in the
second list (or made unbound if VALUES is shorter than SYMBOLS); then the
BODY forms are executed and their result is returned. This is much like
a `let' form, except that the list of symbols can be computed at run-time."
- (list 'let '((cl-progv-save nil))
- (list 'unwind-protect
- (list* 'progn (list 'cl-progv-before symbols values) body)
- '(cl-progv-after))))
+ (declare (indent 2) (debug (form form body)))
+ (let ((bodyfun (make-symbol "cl--progv-body"))
+ (binds (make-symbol "binds"))
+ (syms (make-symbol "syms"))
+ (vals (make-symbol "vals")))
+ `(progn
+ (defvar ,bodyfun)
+ (let* ((,syms ,symbols)
+ (,vals ,values)
+ (,bodyfun (lambda () ,@body))
+ (,binds ()))
+ (while ,syms
+ (push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds))
+ (eval (list 'let ,binds '(funcall ,bodyfun)))))))
+
+(defvar cl--labels-convert-cache nil)
+
+(defun cl--labels-convert (f)
+ "Special macro-expander to rename (function F) references in `cl-labels'."
+ (cond
+ ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+ ;; *after* handling `function', but we want to stop macroexpansion from
+ ;; being applied infinitely, so we use a cache to return the exact `form'
+ ;; being expanded even though we don't receive it.
+ ((eq f (car cl--labels-convert-cache)) (cdr cl--labels-convert-cache))
+ (t
+ (let ((found (assq f macroexpand-all-environment)))
+ (if (and found (ignore-errors
+ (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+ (cadr (cl-caddr (cl-cadddr found)))
+ (let ((res `(function ,f)))
+ (setq cl--labels-convert-cache (cons f res))
+ res))))))
+
+;;;###autoload
+(defmacro cl-flet (bindings &rest body)
+ "Make temporary function definitions.
+Like `cl-labels' but the definitions are not recursive.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+ (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
+ (let ((binds ()) (newenv macroexpand-all-environment))
+ (dolist (binding bindings)
+ (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+ (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+ (push (cons (car binding)
+ `(lambda (&rest cl-labels-args)
+ (cl-list* 'funcall ',var
+ cl-labels-args)))
+ newenv)))
+ `(let ,(nreverse binds)
+ ,@(macroexp-unprogn
+ (macroexpand-all
+ `(progn ,@body)
+ ;; Don't override lexical-let's macro-expander.
+ (if (assq 'function newenv) newenv
+ (cons (cons 'function #'cl--labels-convert) newenv)))))))
-;;; This should really have some way to shadow 'byte-compile properties, etc.
;;;###autoload
-(defmacro flet (bindings &rest body)
+(defmacro cl-flet* (bindings &rest body)
"Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell. The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+Like `cl-flet' but the definitions can refer to previous ones.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
- (list* 'letf*
- (mapcar
- (function
- (lambda (x)
- (if (or (and (fboundp (car x))
- (eq (car-safe (symbol-function (car x))) 'macro))
- (cdr (assq (car x) cl-macro-environment)))
- (error "Use `labels', not `flet', to rebind macro names"))
- (let ((func (list 'function*
- (list 'lambda (cadr x)
- (list* 'block (car x) (cddr x))))))
- (when (cl-compiling-file)
- ;; Bug#411. It would be nice to fix this.
- (and (get (car x) 'byte-compile)
- (error "Byte-compiling a redefinition of `%s' \
-will not work - use `labels' instead" (symbol-name (car x))))
- ;; FIXME This affects the rest of the file, when it
- ;; should be restricted to the flet body.
- (and (boundp 'byte-compile-function-environment)
- (push (cons (car x) (eval func))
- byte-compile-function-environment)))
- (list (list 'symbol-function (list 'quote (car x))) func))))
- bindings)
- body))
+ (declare (indent 1) (debug cl-flet))
+ (cond
+ ((null bindings) (macroexp-progn body))
+ ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
+ (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
;;;###autoload
-(defmacro labels (bindings &rest body)
+(defmacro cl-labels (bindings &rest body)
"Make temporary function bindings.
-This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive and the scoping is lexical, but capturing them
+in closures will only work if `lexical-binding' is in use.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
- (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment))
- (while bindings
- ;; Use `gensym' rather than `make-symbol'. It's important that
- ;; (not (eq (symbol-name var1) (symbol-name var2))) because these
- ;; vars get added to the cl-macro-environment.
- (let ((var (gensym "--cl-var--")))
- (push var vars)
- (push (list 'function* (cons 'lambda (cdar bindings))) sets)
- (push var sets)
- (push (list (car (pop bindings)) 'lambda '(&rest cl-labels-args)
- (list 'list* '(quote funcall) (list 'quote var)
- 'cl-labels-args))
- cl-macro-environment)))
- (cl-macroexpand-all (list* 'lexical-let vars (cons (cons 'setq sets) body))
- cl-macro-environment)))
+ (declare (indent 1) (debug cl-flet))
+ (let ((binds ()) (newenv macroexpand-all-environment))
+ (dolist (binding bindings)
+ (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+ (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+ (push (cons (car binding)
+ `(lambda (&rest cl-labels-args)
+ (cl-list* 'funcall ',var
+ cl-labels-args)))
+ newenv)))
+ (macroexpand-all `(letrec ,(nreverse binds) ,@body)
+ ;; Don't override lexical-let's macro-expander.
+ (if (assq 'function newenv) newenv
+ (cons (cons 'function #'cl--labels-convert) newenv)))))
;; The following ought to have a better definition for use with newer
;; byte compilers.
;;;###autoload
-(defmacro macrolet (bindings &rest body)
+(defmacro cl-macrolet (bindings &rest body)
"Make temporary macro definitions.
-This is like `flet', but for macros instead of functions.
+This is like `cl-flet', but for macros instead of functions.
\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
+ (declare (indent 1)
+ (debug
+ ((&rest (&define name (&rest arg) cl-declarations-or-string
+ def-body))
+ cl-declarations body)))
(if (cdr bindings)
- (list 'macrolet
- (list (car bindings)) (list* 'macrolet (cdr bindings) body))
+ `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
(if (null bindings) (cons 'progn body)
(let* ((name (caar bindings))
- (res (cl-transform-lambda (cdar bindings) name)))
+ (res (cl--transform-lambda (cdar bindings) name)))
(eval (car res))
- (cl-macroexpand-all (cons 'progn body)
- (cons (list* name 'lambda (cdr res))
- cl-macro-environment))))))
+ (macroexpand-all (cons 'progn body)
+ (cons (cons name `(lambda ,@(cdr res)))
+ macroexpand-all-environment))))))
+
+(defconst cl--old-macroexpand
+ (if (and (boundp 'cl--old-macroexpand)
+ (eq (symbol-function 'macroexpand)
+ #'cl--sm-macroexpand))
+ cl--old-macroexpand
+ (symbol-function 'macroexpand)))
+
+(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 env))
+ (while
+ (progn
+ (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 symbol-macrolet (bindings &rest body)
+(defmacro cl-symbol-macrolet (bindings &rest body)
"Make symbol macro definitions.
Within the body FORMs, references to the variable NAME will be replaced
by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
\(fn ((NAME EXPANSION) ...) FORM...)"
- (if (cdr bindings)
- (list 'symbol-macrolet
- (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body))
- (if (null bindings) (cons 'progn body)
- (cl-macroexpand-all (cons 'progn body)
- (cons (list (symbol-name (caar bindings))
- (cadar bindings))
- cl-macro-environment)))))
-
-(defvar cl-closure-vars nil)
-;;;###autoload
-(defmacro lexical-let (bindings &rest body)
- "Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-\n(fn BINDINGS BODY)"
- (let* ((cl-closure-vars cl-closure-vars)
- (vars (mapcar (function
- (lambda (x)
- (or (consp x) (setq x (list x)))
- (push (make-symbol (format "--cl-%s--" (car x)))
- cl-closure-vars)
- (set (car cl-closure-vars) [bad-lexical-ref])
- (list (car x) (cadr x) (car cl-closure-vars))))
- bindings))
- (ebody
- (cl-macroexpand-all
- (cons 'progn body)
- (nconc (mapcar (function (lambda (x)
- (list (symbol-name (car x))
- (list 'symbol-value (caddr x))
- t))) vars)
- (list '(defun . cl-defun-expander))
- cl-macro-environment))))
- (if (not (get (car (last cl-closure-vars)) 'used))
- (list 'let (mapcar (function (lambda (x)
- (list (caddr x) (cadr x)))) vars)
- (sublis (mapcar (function (lambda (x)
- (cons (caddr x)
- (list 'quote (caddr x)))))
- vars)
- ebody))
- (list 'let (mapcar (function (lambda (x)
- (list (caddr x)
- (list 'make-symbol
- (format "--%s--" (car x))))))
- vars)
- (apply 'append '(setf)
- (mapcar (function
- (lambda (x)
- (list (list 'symbol-value (caddr x)) (cadr x))))
- vars))
- ebody))))
-
-;;;###autoload
-(defmacro lexical-let* (bindings &rest body)
- "Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp. This is similar to the behavior of `let*' in
-Common Lisp.
-\n(fn BINDINGS BODY)"
- (if (null bindings) (cons 'progn body)
- (setq bindings (reverse bindings))
- (while bindings
- (setq body (list (list* 'lexical-let (list (pop bindings)) body))))
- (car body)))
-
-(defun cl-defun-expander (func &rest rest)
- (list 'progn
- (list 'defalias (list 'quote func)
- (list 'function (cons 'lambda rest)))
- (list 'quote func)))
-
+ (declare (indent 1) (debug ((&rest (symbol sexp)) cl-declarations body)))
+ (cond
+ ((cdr bindings)
+ `(cl-symbol-macrolet (,(car bindings))
+ (cl-symbol-macrolet ,(cdr bindings) ,@body)))
+ ((null bindings) (macroexp-progn body))
+ (t
+ (let ((previous-macroexpand (symbol-function 'macroexpand)))
+ (unwind-protect
+ (progn
+ (fset 'macroexpand #'cl--sm-macroexpand)
+ ;; FIXME: For N bindings, this will traverse `body' N times!
+ (macroexpand-all (cons 'progn body)
+ (cons (list (symbol-name (caar bindings))
+ (cl-cadar bindings))
+ macroexpand-all-environment)))
+ (fset 'macroexpand previous-macroexpand))))))
;;; Multiple values.
;;;###autoload
-(defmacro multiple-value-bind (vars form &rest body)
+(defmacro cl-multiple-value-bind (vars form &rest body)
"Collect multiple return values.
FORM must return a list; the BODY is then executed with the first N elements
of this list bound (`let'-style) to each of the symbols SYM in turn. This
-is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
-simulate true multiple return values. For compatibility, (values A B C) is
+is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to
+simulate true multiple return values. For compatibility, (cl-values A B C) is
a synonym for (list A B C).
\(fn (SYM...) FORM BODY)"
+ (declare (indent 2) (debug ((&rest symbolp) form body)))
(let ((temp (make-symbol "--cl-var--")) (n -1))
- (list* 'let* (cons (list temp form)
- (mapcar (function
- (lambda (v)
- (list v (list 'nth (setq n (1+ n)) temp))))
- vars))
- body)))
+ `(let* ((,temp ,form)
+ ,@(mapcar (lambda (v)
+ (list v `(nth ,(setq n (1+ n)) ,temp)))
+ vars))
+ ,@body)))
;;;###autoload
-(defmacro multiple-value-setq (vars form)
+(defmacro cl-multiple-value-setq (vars form)
"Collect multiple return values.
FORM must return a list; the first N elements of this list are stored in
each of the symbols SYM in turn. This is analogous to the Common Lisp
-`multiple-value-setq' macro, using lists to simulate true multiple return
-values. For compatibility, (values A B C) is a synonym for (list A B C).
+`cl-multiple-value-setq' macro, using lists to simulate true multiple return
+values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
\(fn (SYM...) FORM)"
- (cond ((null vars) (list 'progn form nil))
- ((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
+ (declare (indent 1) (debug ((&rest symbolp) form)))
+ (cond ((null vars) `(progn ,form nil))
+ ((null (cdr vars)) `(setq ,(car vars) (car ,form)))
(t
(let* ((temp (make-symbol "--cl-var--")) (n 0))
- (list 'let (list (list temp form))
- (list 'prog1 (list 'setq (pop vars) (list 'car temp))
- (cons 'setq (apply 'nconc
- (mapcar (function
- (lambda (v)
- (list v (list
- 'nth
- (setq n (1+ n))
- temp))))
- vars)))))))))
+ `(let ((,temp ,form))
+ (prog1 (setq ,(pop vars) (car ,temp))
+ (setq ,@(apply #'nconc
+ (mapcar (lambda (v)
+ (list v `(nth ,(setq n (1+ n))
+ ,temp)))
+ vars)))))))))
;;; Declarations.
;;;###autoload
-(defmacro locally (&rest body) (cons 'progn body))
+(defmacro cl-locally (&rest body)
+ (declare (debug t))
+ (cons 'progn body))
;;;###autoload
-(defmacro the (type form) form)
+(defmacro cl-the (_type form)
+ (declare (indent 1) (debug (cl-type-spec form)))
+ form)
(defvar cl-proclaim-history t) ; for future compilers
(defvar cl-declare-stack t) ; for future compilers
((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
(while (setq spec (cdr spec))
(if (consp (car spec))
- (if (eq (cadar spec) 0)
+ (if (eq (cl-cadar spec) 0)
(byte-compile-disable-warning (caar spec))
(byte-compile-enable-warning (caar spec)))))))
nil)
(setq cl-proclaims-deferred nil))
;;;###autoload
-(defmacro declare (&rest specs)
+(defmacro cl-declare (&rest specs)
"Declare SPECS about the current function while compiling.
For instance
- \(declare (warn 0))
+ \(cl-declare (warn 0))
will turn off byte-compile warnings in the function.
See Info node `(cl)Declarations' for details."
- (if (cl-compiling-file)
+ (if (cl--compiling-file)
(while specs
(if (listp cl-declare-stack) (push (car specs) cl-declare-stack))
(cl-do-proclaim (pop specs) nil)))
nil)
-
-
-;;; Generalized variables.
-
-;;;###autoload
-(defmacro define-setf-method (func args &rest body)
- "Define a `setf' method.
-This method shows how to handle `setf's to places of the form (NAME ARGS...).
-The argument forms ARGS are bound according to ARGLIST, as if NAME were
-going to be expanded as a macro, then the BODY forms are executed and must
-return a list of five elements: a temporary-variables list, a value-forms
-list, a store-variables list (of length one), a store-form, and an access-
-form. See `defsetf' for a simpler way to define most setf-methods.
-
-\(fn NAME ARGLIST BODY...)"
- (append '(eval-when (compile load eval))
- (if (stringp (car body))
- (list (list 'put (list 'quote func) '(quote setf-documentation)
- (pop body))))
- (list (cl-transform-function-property
- func 'setf-method (cons args body)))))
-(defalias 'define-setf-expander 'define-setf-method)
-
-;;;###autoload
-(defmacro defsetf (func arg1 &rest args)
- "Define a `setf' method.
-This macro is an easy-to-use substitute for `define-setf-method' that works
-well for simple place forms. In the simple `defsetf' form, `setf's of
-the form (setf (NAME ARGS...) VAL) are transformed to function or macro
-calls of the form (FUNC ARGS... VAL). Example:
-
- (defsetf aref aset)
-
-Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
-Here, the above `setf' call is expanded by binding the argument forms ARGS
-according to ARGLIST, binding the value form VAL to STORE, then executing
-BODY, which must return a Lisp form that does the necessary `setf' operation.
-Actually, ARGLIST and STORE may be bound to temporary variables which are
-introduced automatically to preserve proper execution order of the arguments.
-Example:
-
- (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))
-
-\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
- (if (and (listp arg1) (consp args))
- (let* ((largs nil) (largsr nil)
- (temps nil) (tempsr nil)
- (restarg nil) (rest-temps nil)
- (store-var (car (prog1 (car args) (setq args (cdr args)))))
- (store-temp (intern (format "--%s--temp--" store-var)))
- (lets1 nil) (lets2 nil)
- (docstr nil) (p arg1))
- (if (stringp (car args))
- (setq docstr (prog1 (car args) (setq args (cdr args)))))
- (while (and p (not (eq (car p) '&aux)))
- (if (eq (car p) '&rest)
- (setq p (cdr p) restarg (car p))
- (or (memq (car p) '(&optional &key &allow-other-keys))
- (setq largs (cons (if (consp (car p)) (car (car p)) (car p))
- largs)
- temps (cons (intern (format "--%s--temp--" (car largs)))
- temps))))
- (setq p (cdr p)))
- (setq largs (nreverse largs) temps (nreverse temps))
- (if restarg
- (setq largsr (append largs (list restarg))
- rest-temps (intern (format "--%s--temp--" restarg))
- tempsr (append temps (list rest-temps)))
- (setq largsr largs tempsr temps))
- (let ((p1 largs) (p2 temps))
- (while p1
- (setq lets1 (cons `(,(car p2)
- (make-symbol ,(format "--cl-%s--" (car p1))))
- lets1)
- lets2 (cons (list (car p1) (car p2)) lets2)
- p1 (cdr p1) p2 (cdr p2))))
- (if restarg (setq lets2 (cons (list restarg rest-temps) lets2)))
- `(define-setf-method ,func ,arg1
- ,@(and docstr (list docstr))
- (let*
- ,(nreverse
- (cons `(,store-temp
- (make-symbol ,(format "--cl-%s--" store-var)))
- (if restarg
- `((,rest-temps
- (mapcar (lambda (_) (make-symbol "--cl-var--"))
- ,restarg))
- ,@lets1)
- lets1)))
- (list ; 'values
- (,(if restarg 'list* 'list) ,@tempsr)
- (,(if restarg 'list* 'list) ,@largsr)
- (list ,store-temp)
- (let*
- ,(nreverse
- (cons (list store-var store-temp)
- lets2))
- ,@args)
- (,(if restarg 'list* 'list)
- ,@(cons (list 'quote func) tempsr))))))
- `(defsetf ,func (&rest args) (store)
- ,(let ((call `(cons ',arg1
- (append args (list store)))))
- (if (car args)
- `(list 'progn ,call store)
- call)))))
-
-;;; Some standard place types from Common Lisp.
-(defsetf aref aset)
-(defsetf car setcar)
-(defsetf cdr setcdr)
-(defsetf caar (x) (val) (list 'setcar (list 'car x) val))
-(defsetf cadr (x) (val) (list 'setcar (list 'cdr x) val))
-(defsetf cdar (x) (val) (list 'setcdr (list 'car x) val))
-(defsetf cddr (x) (val) (list 'setcdr (list 'cdr x) val))
-(defsetf elt (seq n) (store)
- (list 'if (list 'listp seq) (list 'setcar (list 'nthcdr n seq) store)
- (list 'aset seq n store)))
-(defsetf get put)
-(defsetf get* (x y &optional d) (store) (list 'put x y store))
-(defsetf gethash (x h &optional d) (store) (list 'puthash x store h))
-(defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store))
-(defsetf subseq (seq start &optional end) (new)
- (list 'progn (list 'replace seq new :start1 start :end1 end) new))
-(defsetf symbol-function fset)
-(defsetf symbol-plist setplist)
-(defsetf symbol-value set)
-
-;;; Various car/cdr aliases. Note that `cadr' is handled specially.
-(defsetf first setcar)
-(defsetf second (x) (store) (list 'setcar (list 'cdr x) store))
-(defsetf third (x) (store) (list 'setcar (list 'cddr x) store))
-(defsetf fourth (x) (store) (list 'setcar (list 'cdddr x) store))
-(defsetf fifth (x) (store) (list 'setcar (list 'nthcdr 4 x) store))
-(defsetf sixth (x) (store) (list 'setcar (list 'nthcdr 5 x) store))
-(defsetf seventh (x) (store) (list 'setcar (list 'nthcdr 6 x) store))
-(defsetf eighth (x) (store) (list 'setcar (list 'nthcdr 7 x) store))
-(defsetf ninth (x) (store) (list 'setcar (list 'nthcdr 8 x) store))
-(defsetf tenth (x) (store) (list 'setcar (list 'nthcdr 9 x) store))
-(defsetf rest setcdr)
-
-;;; Some more Emacs-related place types.
-(defsetf buffer-file-name set-visited-file-name t)
-(defsetf buffer-modified-p (&optional buf) (flag)
- (list 'with-current-buffer buf
- (list 'set-buffer-modified-p flag)))
-(defsetf buffer-name rename-buffer t)
-(defsetf buffer-string () (store)
- (list 'progn '(erase-buffer) (list 'insert store)))
-(defsetf buffer-substring cl-set-buffer-substring)
-(defsetf current-buffer set-buffer)
-(defsetf current-case-table set-case-table)
-(defsetf current-column move-to-column t)
-(defsetf current-global-map use-global-map t)
-(defsetf current-input-mode () (store)
- (list 'progn (list 'apply 'set-input-mode store) store))
-(defsetf current-local-map use-local-map t)
-(defsetf current-window-configuration set-window-configuration t)
-(defsetf default-file-modes set-default-file-modes t)
-(defsetf default-value set-default)
-(defsetf documentation-property put)
-(defsetf face-background (f &optional s) (x) (list 'set-face-background f x s))
-(defsetf face-background-pixmap (f &optional s) (x)
- (list 'set-face-background-pixmap f x s))
-(defsetf face-font (f &optional s) (x) (list 'set-face-font f x s))
-(defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s))
-(defsetf face-underline-p (f &optional s) (x)
- (list 'set-face-underline-p f x s))
-(defsetf file-modes set-file-modes t)
-(defsetf frame-height set-screen-height t)
-(defsetf frame-parameters modify-frame-parameters t)
-(defsetf frame-visible-p cl-set-frame-visible-p)
-(defsetf frame-width set-screen-width t)
-(defsetf frame-parameter set-frame-parameter t)
-(defsetf terminal-parameter set-terminal-parameter)
-(defsetf getenv setenv t)
-(defsetf get-register set-register)
-(defsetf global-key-binding global-set-key)
-(defsetf keymap-parent set-keymap-parent)
-(defsetf local-key-binding local-set-key)
-(defsetf mark set-mark t)
-(defsetf mark-marker set-mark t)
-(defsetf marker-position set-marker t)
-(defsetf match-data set-match-data t)
-(defsetf mouse-position (scr) (store)
- (list 'set-mouse-position scr (list 'car store) (list 'cadr store)
- (list 'cddr store)))
-(defsetf overlay-get overlay-put)
-(defsetf overlay-start (ov) (store)
- (list 'progn (list 'move-overlay ov store (list 'overlay-end ov)) store))
-(defsetf overlay-end (ov) (store)
- (list 'progn (list 'move-overlay ov (list 'overlay-start ov) store) store))
-(defsetf point goto-char)
-(defsetf point-marker goto-char t)
-(defsetf point-max () (store)
- (list 'progn (list 'narrow-to-region '(point-min) store) store))
-(defsetf point-min () (store)
- (list 'progn (list 'narrow-to-region store '(point-max)) store))
-(defsetf process-buffer set-process-buffer)
-(defsetf process-filter set-process-filter)
-(defsetf process-sentinel set-process-sentinel)
-(defsetf process-get process-put)
-(defsetf read-mouse-position (scr) (store)
- (list 'set-mouse-position scr (list 'car store) (list 'cdr store)))
-(defsetf screen-height set-screen-height t)
-(defsetf screen-width set-screen-width t)
-(defsetf selected-window select-window)
-(defsetf selected-screen select-screen)
-(defsetf selected-frame select-frame)
-(defsetf standard-case-table set-standard-case-table)
-(defsetf syntax-table set-syntax-table)
-(defsetf visited-file-modtime set-visited-file-modtime t)
-(defsetf window-buffer set-window-buffer t)
-(defsetf window-display-table set-window-display-table t)
-(defsetf window-dedicated-p set-window-dedicated-p t)
-(defsetf window-height () (store)
- (list 'progn (list 'enlarge-window (list '- store '(window-height))) store))
-(defsetf window-hscroll set-window-hscroll)
-(defsetf window-parameter set-window-parameter)
-(defsetf window-point set-window-point)
-(defsetf window-start set-window-start)
-(defsetf window-width () (store)
- (list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store))
-(defsetf x-get-secondary-selection x-own-secondary-selection t)
-(defsetf x-get-selection x-own-selection t)
-
-;; This is a hack that allows (setf (eq a 7) B) to mean either
-;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
-;; This is useful when you have control over the PLACE but not over
-;; the VALUE, as is the case in define-minor-mode's :variable.
-(define-setf-method eq (place val)
- (let ((method (get-setf-method place cl-macro-environment))
- (val-temp (make-symbol "--eq-val--"))
- (store-temp (make-symbol "--eq-store--")))
- (list (append (nth 0 method) (list val-temp))
- (append (nth 1 method) (list val))
- (list store-temp)
- `(let ((,(car (nth 2 method))
- (if ,store-temp ,val-temp (not ,val-temp))))
- ,(nth 3 method) ,store-temp)
- `(eq ,(nth 4 method) ,val-temp))))
-
-;;; More complex setf-methods.
-;; These should take &environment arguments, but since full arglists aren't
-;; available while compiling cl-macs, we fake it by referring to the global
-;; variable cl-macro-environment directly.
-
-(define-setf-method apply (func arg1 &rest rest)
- (or (and (memq (car-safe func) '(quote function function*))
- (symbolp (car-safe (cdr-safe func))))
- (error "First arg to apply in setf is not (function SYM): %s" func))
- (let* ((form (cons (nth 1 func) (cons arg1 rest)))
- (method (get-setf-method form cl-macro-environment)))
- (list (car method) (nth 1 method) (nth 2 method)
- (cl-setf-make-apply (nth 3 method) (cadr func) (car method))
- (cl-setf-make-apply (nth 4 method) (cadr func) (car method)))))
-
-(defun cl-setf-make-apply (form func temps)
- (if (eq (car form) 'progn)
- (list* 'progn (cl-setf-make-apply (cadr form) func temps) (cddr form))
- (or (equal (last form) (last temps))
- (error "%s is not suitable for use with setf-of-apply" func))
- (list* 'apply (list 'quote (car form)) (cdr form))))
-
-(define-setf-method nthcdr (n place)
- (let ((method (get-setf-method place cl-macro-environment))
- (n-temp (make-symbol "--cl-nthcdr-n--"))
- (store-temp (make-symbol "--cl-nthcdr-store--")))
- (list (cons n-temp (car method))
- (cons n (nth 1 method))
- (list store-temp)
- (list 'let (list (list (car (nth 2 method))
- (list 'cl-set-nthcdr n-temp (nth 4 method)
- store-temp)))
- (nth 3 method) store-temp)
- (list 'nthcdr n-temp (nth 4 method)))))
-
-(define-setf-method getf (place tag &optional def)
- (let ((method (get-setf-method place cl-macro-environment))
- (tag-temp (make-symbol "--cl-getf-tag--"))
- (def-temp (make-symbol "--cl-getf-def--"))
- (store-temp (make-symbol "--cl-getf-store--")))
- (list (append (car method) (list tag-temp def-temp))
- (append (nth 1 method) (list tag def))
- (list store-temp)
- (list 'let (list (list (car (nth 2 method))
- (list 'cl-set-getf (nth 4 method)
- tag-temp store-temp)))
- (nth 3 method) store-temp)
- (list 'getf (nth 4 method) tag-temp def-temp))))
-
-(define-setf-method substring (place from &optional to)
- (let ((method (get-setf-method place cl-macro-environment))
- (from-temp (make-symbol "--cl-substring-from--"))
- (to-temp (make-symbol "--cl-substring-to--"))
- (store-temp (make-symbol "--cl-substring-store--")))
- (list (append (car method) (list from-temp to-temp))
- (append (nth 1 method) (list from to))
- (list store-temp)
- (list 'let (list (list (car (nth 2 method))
- (list 'cl-set-substring (nth 4 method)
- from-temp to-temp store-temp)))
- (nth 3 method) store-temp)
- (list 'substring (nth 4 method) from-temp to-temp))))
-
-;;; Getting and optimizing setf-methods.
-;;;###autoload
-(defun get-setf-method (place &optional env)
- "Return a list of five values describing the setf-method for PLACE.
-PLACE may be any Lisp form which can appear as the PLACE argument to
-a macro like `setf' or `incf'."
- (if (symbolp place)
- (let ((temp (make-symbol "--cl-setf--")))
- (list nil nil (list temp) (list 'setq place temp) place))
- (or (and (symbolp (car place))
- (let* ((func (car place))
- (name (symbol-name func))
- (method (get func 'setf-method))
- (case-fold-search nil))
- (or (and method
- (let ((cl-macro-environment env))
- (setq method (apply method (cdr place))))
- (if (and (consp method) (= (length method) 5))
- method
- (error "Setf-method for %s returns malformed method"
- func)))
- (and (string-match-p "\\`c[ad][ad][ad]?[ad]?r\\'" name)
- (get-setf-method (compiler-macroexpand place)))
- (and (eq func 'edebug-after)
- (get-setf-method (nth (1- (length place)) place)
- env)))))
- (if (eq place (setq place (macroexpand place env)))
- (if (and (symbolp (car place)) (fboundp (car place))
- (symbolp (symbol-function (car place))))
- (get-setf-method (cons (symbol-function (car place))
- (cdr place)) env)
- (error "No setf-method known for %s" (car place)))
- (get-setf-method place env)))))
-
-(defun cl-setf-do-modify (place opt-expr)
- (let* ((method (get-setf-method place cl-macro-environment))
- (temps (car method)) (values (nth 1 method))
- (lets nil) (subs nil)
- (optimize (and (not (eq opt-expr 'no-opt))
- (or (and (not (eq opt-expr 'unsafe))
- (cl-safe-expr-p opt-expr))
- (cl-setf-simple-store-p (car (nth 2 method))
- (nth 3 method)))))
- (simple (and optimize (consp place) (cl-simple-exprs-p (cdr place)))))
- (while values
- (if (or simple (cl-const-expr-p (car values)))
- (push (cons (pop temps) (pop values)) subs)
- (push (list (pop temps) (pop values)) lets)))
- (list (nreverse lets)
- (cons (car (nth 2 method)) (sublis subs (nth 3 method)))
- (sublis subs (nth 4 method)))))
-
-(defun cl-setf-do-store (spec val)
- (let ((sym (car spec))
- (form (cdr spec)))
- (if (or (cl-const-expr-p val)
- (and (cl-simple-expr-p val) (eq (cl-expr-contains form sym) 1))
- (cl-setf-simple-store-p sym form))
- (subst val sym form)
- (list 'let (list (list sym val)) form))))
-
-(defun cl-setf-simple-store-p (sym form)
- (and (consp form) (eq (cl-expr-contains form sym) 1)
- (eq (nth (1- (length form)) form) sym)
- (symbolp (car form)) (fboundp (car form))
- (not (eq (car-safe (symbol-function (car form))) 'macro))))
-
;;; The standard modify macros.
-;;;###autoload
-(defmacro setf (&rest args)
- "Set each PLACE to the value of its VAL.
-This is a generalized version of `setq'; the PLACEs may be symbolic
-references such as (car x) or (aref x i), as well as plain symbols.
-For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
-The return value is the last VAL in the list.
-\(fn PLACE VAL PLACE VAL ...)"
- (if (cdr (cdr args))
- (let ((sets nil))
- (while args (push (list 'setf (pop args) (pop args)) sets))
- (cons 'progn (nreverse sets)))
- (if (symbolp (car args))
- (and args (cons 'setq args))
- (let* ((method (cl-setf-do-modify (car args) (nth 1 args)))
- (store (cl-setf-do-store (nth 1 method) (nth 1 args))))
- (if (car method) (list 'let* (car method) store) store)))))
+;; `setf' is now part of core Elisp, defined in gv.el.
;;;###autoload
-(defmacro psetf (&rest args)
+(defmacro cl-psetf (&rest args)
"Set PLACEs to the values VALs in parallel.
This is like `setf', except that all VAL forms are evaluated (in order)
before assigning any PLACEs to the corresponding values.
\(fn PLACE VAL PLACE VAL ...)"
+ (declare (debug setf))
(let ((p args) (simple t) (vars nil))
(while p
- (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars))
+ (if (or (not (symbolp (car p))) (cl--expr-depends-p (nth 1 p) vars))
(setq simple nil))
(if (memq (car p) vars)
(error "Destination duplicated in psetf: %s" (car p)))
(push (pop p) vars)
- (or p (error "Odd number of arguments to psetf"))
+ (or p (error "Odd number of arguments to cl-psetf"))
(pop p))
(if simple
- (list 'progn (cons 'setf args) nil)
+ `(progn (setq ,@args) nil)
(setq args (reverse args))
- (let ((expr (list 'setf (cadr args) (car args))))
+ (let ((expr `(setf ,(cadr args) ,(car args))))
(while (setq args (cddr args))
- (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr))))
- (list 'progn expr nil)))))
-
-;;;###autoload
-(defun cl-do-pop (place)
- (if (cl-simple-expr-p place)
- (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place)))
- (let* ((method (cl-setf-do-modify place t))
- (temp (make-symbol "--cl-pop--")))
- (list 'let*
- (append (car method)
- (list (list temp (nth 2 method))))
- (list 'prog1
- (list 'car temp)
- (cl-setf-do-store (nth 1 method) (list 'cdr temp)))))))
+ (setq expr `(setf ,(cadr args) (prog1 ,(car args) ,expr))))
+ `(progn ,expr nil)))))
;;;###autoload
-(defmacro remf (place tag)
+(defmacro cl-remf (place tag)
"Remove TAG from property list PLACE.
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The form returns true if TAG was found and removed, nil otherwise."
- (let* ((method (cl-setf-do-modify place t))
- (tag-temp (and (not (cl-const-expr-p tag)) (make-symbol "--cl-remf-tag--")))
- (val-temp (and (not (cl-simple-expr-p place))
- (make-symbol "--cl-remf-place--")))
- (ttag (or tag-temp tag))
- (tval (or val-temp (nth 2 method))))
- (list 'let*
- (append (car method)
- (and val-temp (list (list val-temp (nth 2 method))))
- (and tag-temp (list (list tag-temp tag))))
- (list 'if (list 'eq ttag (list 'car tval))
- (list 'progn
- (cl-setf-do-store (nth 1 method) (list 'cddr tval))
- t)
- (list 'cl-do-remf tval ttag)))))
+ (declare (debug (place form)))
+ (gv-letplace (tval setter) place
+ (macroexp-let2 macroexp-copyable-p ttag tag
+ `(if (eq ,ttag (car ,tval))
+ (progn ,(funcall setter `(cddr ,tval))
+ t)
+ (cl--do-remf ,tval ,ttag)))))
;;;###autoload
-(defmacro shiftf (place &rest args)
+(defmacro cl-shiftf (place &rest args)
"Shift left among PLACEs.
-Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
+Example: (cl-shiftf A B C) sets A to B, B to C, and returns the old A.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
\(fn PLACE... VAL)"
+ (declare (debug (&rest place)))
(cond
((null args) place)
- ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
+ ((symbolp place) `(prog1 ,place (setq ,place (cl-shiftf ,@args))))
(t
- (let ((method (cl-setf-do-modify place 'unsafe)))
- `(let* ,(car method)
- (prog1 ,(nth 2 method)
- ,(cl-setf-do-store (nth 1 method) `(shiftf ,@args))))))))
+ (gv-letplace (getter setter) place
+ `(prog1 ,getter
+ ,(funcall setter `(cl-shiftf ,@args)))))))
;;;###autoload
-(defmacro rotatef (&rest args)
+(defmacro cl-rotatef (&rest args)
"Rotate left among PLACEs.
-Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
+Example: (cl-rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
\(fn PLACE...)"
+ (declare (debug (&rest place)))
(if (not (memq nil (mapcar 'symbolp args)))
(and (cdr args)
(let ((sets nil)
(first (car args)))
(while (cdr args)
(setq sets (nconc sets (list (pop args) (car args)))))
- (nconc (list 'psetf) sets (list (car args) first))))
+ `(cl-psetf ,@sets ,(car args) ,first)))
(let* ((places (reverse args))
(temp (make-symbol "--cl-rotatef--"))
(form temp))
(while (cdr places)
- (let ((method (cl-setf-do-modify (pop places) 'unsafe)))
- (setq form (list 'let* (car method)
- (list 'prog1 (nth 2 method)
- (cl-setf-do-store (nth 1 method) form))))))
- (let ((method (cl-setf-do-modify (car places) 'unsafe)))
- (list 'let* (append (car method) (list (list temp (nth 2 method))))
- (cl-setf-do-store (nth 1 method) form) nil)))))
+ (setq form
+ (gv-letplace (getter setter) (pop places)
+ `(prog1 ,getter ,(funcall setter form)))))
+ (gv-letplace (getter setter) (car places)
+ (macroexp-let* `((,temp ,getter))
+ `(progn ,(funcall setter form) nil))))))
+
+;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
+;; previous state. If the getter/setter loses information, that info is
+;; not recovered.
+
+(defun cl--letf (bindings simplebinds binds body)
+ ;; It's not quite clear what the semantics of cl-letf should be.
+ ;; E.g. in (cl-letf ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
+ ;; that the actual assignments ("bindings") should only happen after
+ ;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
+ ;; PLACE1 and PLACE2 should be evaluated. Should we have
+ ;; PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
+ ;; or
+ ;; VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
+ ;; or
+ ;; VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
+ ;; Common-Lisp's `psetf' does the first, so we'll do the same.
+ (if (null bindings)
+ (if (and (null binds) (null simplebinds)) (macroexp-progn body)
+ `(let* (,@(mapcar (lambda (x)
+ (pcase-let ((`(,vold ,getter ,_setter ,_vnew) x))
+ (list vold getter)))
+ binds)
+ ,@simplebinds)
+ (unwind-protect
+ ,(macroexp-progn
+ (append
+ (delq nil
+ (mapcar (lambda (x)
+ (pcase x
+ ;; If there's no vnew, do nothing.
+ (`(,_vold ,_getter ,setter ,vnew)
+ (funcall setter vnew))))
+ binds))
+ body))
+ ,@(mapcar (lambda (x)
+ (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
+ (funcall setter vold)))
+ binds))))
+ (let ((binding (car bindings)))
+ (gv-letplace (getter setter) (car binding)
+ (macroexp-let2 nil vnew (cadr binding)
+ (if (symbolp (car binding))
+ ;; Special-case for simple variables.
+ (cl--letf (cdr bindings)
+ (cons `(,getter ,(if (cdr binding) vnew getter))
+ simplebinds)
+ binds body)
+ (cl--letf (cdr bindings) simplebinds
+ (cons `(,(make-symbol "old") ,getter ,setter
+ ,@(if (cdr binding) (list vnew)))
+ binds)
+ body)))))))
;;;###autoload
-(defmacro letf (bindings &rest body)
+(defmacro cl-letf (bindings &rest body)
"Temporarily bind to PLACEs.
This is the analogue of `let', but with generalized variables (in the
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
the PLACE is not modified before executing BODY.
\(fn ((PLACE VALUE) ...) BODY...)"
+ (declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body)))
(if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
- (list* 'let bindings body)
- (let ((lets nil) (sets nil)
- (unsets nil) (rev (reverse bindings)))
- (while rev
- (let* ((place (if (symbolp (caar rev))
- (list 'symbol-value (list 'quote (caar rev)))
- (caar rev)))
- (value (cadar rev))
- (method (cl-setf-do-modify place 'no-opt))
- (save (make-symbol "--cl-letf-save--"))
- (bound (and (memq (car place) '(symbol-value symbol-function))
- (make-symbol "--cl-letf-bound--")))
- (temp (and (not (cl-const-expr-p value)) (cdr bindings)
- (make-symbol "--cl-letf-val--"))))
- (setq lets (nconc (car method)
- (if bound
- (list (list bound
- (list (if (eq (car place)
- 'symbol-value)
- 'boundp 'fboundp)
- (nth 1 (nth 2 method))))
- (list save (list 'and bound
- (nth 2 method))))
- (list (list save (nth 2 method))))
- (and temp (list (list temp value)))
- lets)
- body (list
- (list 'unwind-protect
- (cons 'progn
- (if (cdr (car rev))
- (cons (cl-setf-do-store (nth 1 method)
- (or temp value))
- body)
- body))
- (if bound
- (list 'if bound
- (cl-setf-do-store (nth 1 method) save)
- (list (if (eq (car place) 'symbol-value)
- 'makunbound 'fmakunbound)
- (nth 1 (nth 2 method))))
- (cl-setf-do-store (nth 1 method) save))))
- rev (cdr rev))))
- (list* 'let* lets body))))
+ `(let ,bindings ,@body)
+ (cl--letf bindings () () body)))
;;;###autoload
-(defmacro letf* (bindings &rest body)
+(defmacro cl-letf* (bindings &rest body)
"Temporarily bind to PLACEs.
-This is the analogue of `let*', but with generalized variables (in the
-sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
-VALUE, then the BODY forms are executed. On exit, either normally or
-because of a `throw' or error, the PLACEs are set back to their original
-values. Note that this macro is *not* available in Common Lisp.
-As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY.
-
-\(fn ((PLACE VALUE) ...) BODY...)"
- (if (null bindings)
- (cons 'progn body)
- (setq bindings (reverse bindings))
- (while bindings
- (setq body (list (list* 'letf (list (pop bindings)) body))))
- (car body)))
+Like `cl-letf' but where the bindings are performed one at a time,
+rather than all at the end (i.e. like `let*' rather than like `let')."
+ (declare (indent 1) (debug cl-letf))
+ (dolist (binding (reverse bindings))
+ (setq body (list `(cl-letf (,binding) ,@body))))
+ (macroexp-progn body))
;;;###autoload
-(defmacro callf (func place &rest args)
+(defmacro cl-callf (func place &rest args)
"Set PLACE to (FUNC PLACE ARGS...).
FUNC should be an unquoted function name. PLACE may be a symbol,
-or any generalized variable allowed by `setf'.
-
-\(fn FUNC PLACE ARGS...)"
- (let* ((method (cl-setf-do-modify place (cons 'list args)))
- (rargs (cons (nth 2 method) args)))
- (list 'let* (car method)
- (cl-setf-do-store (nth 1 method)
- (if (symbolp func) (cons func rargs)
- (list* 'funcall (list 'function func)
- rargs))))))
+or any generalized variable allowed by `setf'."
+ (declare (indent 2) (debug (cl-function place &rest form)))
+ (gv-letplace (getter setter) place
+ (let* ((rargs (cons getter args)))
+ (funcall setter
+ (if (symbolp func) (cons func rargs)
+ `(funcall #',func ,@rargs))))))
;;;###autoload
-(defmacro callf2 (func arg1 place &rest args)
+(defmacro cl-callf2 (func arg1 place &rest args)
"Set PLACE to (FUNC ARG1 PLACE ARGS...).
-Like `callf', but PLACE is the second argument of FUNC, not the first.
+Like `cl-callf', but PLACE is the second argument of FUNC, not the first.
\(fn FUNC ARG1 PLACE ARGS...)"
- (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func))
- (list 'setf place (list* func arg1 place args))
- (let* ((method (cl-setf-do-modify place (cons 'list args)))
- (temp (and (not (cl-const-expr-p arg1)) (make-symbol "--cl-arg1--")))
- (rargs (list* (or temp arg1) (nth 2 method) args)))
- (list 'let* (append (and temp (list (list temp arg1))) (car method))
- (cl-setf-do-store (nth 1 method)
- (if (symbolp func) (cons func rargs)
- (list* 'funcall (list 'function func)
- rargs)))))))
-
-;;;###autoload
-(defmacro define-modify-macro (name arglist func &optional doc)
- "Define a `setf'-like modify macro.
-If NAME is called, it combines its PLACE argument with the other arguments
-from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
- (if (memq '&key arglist) (error "&key not allowed in define-modify-macro"))
- (let ((place (make-symbol "--cl-place--")))
- (list 'defmacro* name (cons place arglist) doc
- (list* (if (memq '&rest arglist) 'list* 'list)
- '(quote callf) (list 'quote func) place
- (cl-arglist-args arglist)))))
-
+ (declare (indent 3) (debug (cl-function form place &rest form)))
+ (if (and (cl--safe-expr-p arg1) (cl--simple-expr-p place) (symbolp func))
+ `(setf ,place (,func ,arg1 ,place ,@args))
+ (macroexp-let2 nil a1 arg1
+ (gv-letplace (getter setter) place
+ (let* ((rargs (cl-list* a1 getter args)))
+ (funcall setter
+ (if (symbolp func) (cons func rargs)
+ `(funcall #',func ,@rargs))))))))
;;; Structures.
;;;###autoload
-(defmacro defstruct (struct &rest descs)
+(defmacro cl-defstruct (struct &rest descs)
"Define a struct type.
This macro defines a new data type called NAME that stores data
in SLOTs. It defines a `make-NAME' constructor, a `copy-NAME'
value, that slot cannot be set via `setf'.
\(fn NAME SLOTS...)"
+ (declare (doc-string 2) (indent 1)
+ (debug
+ (&define ;Makes top-level form not be wrapped.
+ [&or symbolp
+ (gate
+ symbolp &rest
+ (&or [":conc-name" symbolp]
+ [":constructor" symbolp &optional cl-lambda-list]
+ [":copier" symbolp]
+ [":predicate" symbolp]
+ [":include" symbolp &rest sexp] ;; Not finished.
+ ;; The following are not supported.
+ ;; [":print-function" ...]
+ ;; [":type" ...]
+ ;; [":initial-offset" ...]
+ ))]
+ [&optional stringp]
+ ;; All the above is for the following def-form.
+ &rest &or symbolp (symbolp def-form
+ &optional ":read-only" sexp))))
(let* ((name (if (consp struct) (car struct) struct))
(opts (cdr-safe struct))
(slots nil)
(copier (intern (format "copy-%s" name)))
(predicate (intern (format "%s-p" name)))
(print-func nil) (print-auto nil)
- (safety (if (cl-compiling-file) cl-optimize-safety 3))
+ (safety (if (cl--compiling-file) cl-optimize-safety 3))
(include nil)
(tag (intern (format "cl-struct-%s" name)))
(tag-symbol (intern (format "cl-struct-%s-tags" name)))
(forms nil)
pred-form pred-check)
(if (stringp (car descs))
- (push (list 'put (list 'quote name) '(quote structure-documentation)
- (pop descs)) forms))
+ (push `(put ',name 'structure-documentation
+ ,(pop descs)) forms))
(setq descs (cons '(cl-tag-slot)
(mapcar (function (lambda (x) (if (consp x) x (list x))))
descs)))
(t
(error "Slot option %s unrecognized" opt)))))
(if print-func
- (setq print-func (list 'progn
- (list 'funcall (list 'function print-func)
- 'cl-x 'cl-s 'cl-n) t))
+ (setq print-func
+ `(progn (funcall #',print-func cl-x cl-s cl-n) t))
(or type (and include (not (get include 'cl-struct-print)))
(setq print-auto t
print-func (and (or (not (or include type)) (null print-func))
- (list 'progn
- (list 'princ (format "#S(%s" name)
- 'cl-s))))))
+ `(progn
+ (princ ,(format "#S(%s" name) cl-s))))))
(if include
(let ((inc-type (get include 'cl-struct-type))
(old-descs (get include 'cl-struct-slots)))
(if (cadr inc-type) (setq tag name named t))
(let ((incl include))
(while incl
- (push (list 'pushnew (list 'quote tag)
- (intern (format "cl-struct-%s-tags" incl)))
- forms)
+ (push `(cl-pushnew ',tag
+ ,(intern (format "cl-struct-%s-tags" incl)))
+ forms)
(setq incl (get incl 'cl-struct-include)))))
(if type
(progn
(if named (setq tag name)))
(setq type 'vector named 'true)))
(or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
- (push (list 'defvar tag-symbol) forms)
+ (push `(defvar ,tag-symbol) forms)
(setq pred-form (and named
(let ((pos (- (length descs)
(length (memq (assq 'cl-tag-slot descs)
descs)))))
(if (eq type 'vector)
- (list 'and '(vectorp cl-x)
- (list '>= '(length cl-x) (length descs))
- (list 'memq (list 'aref 'cl-x pos)
- tag-symbol))
+ `(and (vectorp cl-x)
+ (>= (length cl-x) ,(length descs))
+ (memq (aref cl-x ,pos) ,tag-symbol))
(if (= pos 0)
- (list 'memq '(car-safe cl-x) tag-symbol)
- (list 'and '(consp cl-x)
- (list 'memq (list 'nth pos 'cl-x)
- tag-symbol))))))
+ `(memq (car-safe cl-x) ,tag-symbol)
+ `(and (consp cl-x)
+ (memq (nth ,pos cl-x) ,tag-symbol))))))
pred-check (and pred-form (> safety 0)
- (if (and (eq (caadr pred-form) 'vectorp)
+ (if (and (eq (cl-caadr pred-form) 'vectorp)
(= safety 1))
- (cons 'and (cdddr pred-form)) pred-form)))
+ (cons 'and (cl-cdddr pred-form)) pred-form)))
(let ((pos 0) (descp descs))
(while descp
(let* ((desc (pop descp))
(if (memq slot '(cl-tag-slot cl-skip-slot))
(progn
(push nil slots)
- (push (and (eq slot 'cl-tag-slot) (list 'quote tag))
+ (push (and (eq slot 'cl-tag-slot) `',tag)
defaults))
(if (assq slot descp)
(error "Duplicate slots named %s in %s" slot name))
(let ((accessor (intern (format "%s%s" conc-name slot))))
(push slot slots)
(push (nth 1 desc) defaults)
- (push (list*
- 'defsubst* accessor '(cl-x)
- (append
- (and pred-check
- (list (list 'or pred-check
- `(error "%s accessing a non-%s"
- ',accessor ',name))))
- (list (if (eq type 'vector) (list 'aref 'cl-x pos)
- (if (= pos 0) '(car cl-x)
- (list 'nth pos 'cl-x)))))) forms)
+ (push `(cl-defsubst ,accessor (cl-x)
+ ,@(and pred-check
+ (list `(or ,pred-check
+ (error "%s accessing a non-%s"
+ ',accessor ',name))))
+ ,(if (eq type 'vector) `(aref cl-x ,pos)
+ (if (= pos 0) '(car cl-x)
+ `(nth ,pos cl-x)))) forms)
(push (cons accessor t) side-eff)
- (push (list 'define-setf-method accessor '(cl-x)
- (if (cadr (memq :read-only (cddr desc)))
- (list 'progn '(ignore cl-x)
- `(error "%s is a read-only slot"
- ',accessor))
- ;; If cl is loaded only for compilation,
- ;; the call to cl-struct-setf-expander would
- ;; cause a warning because it may not be
- ;; defined at run time. Suppress that warning.
- (list 'with-no-warnings
- (list 'cl-struct-setf-expander 'cl-x
- (list 'quote name) (list 'quote accessor)
- (and pred-check (list 'quote pred-check))
- pos))))
- forms)
+ ;; Don't bother defining a setf-expander, since gv-get can use
+ ;; the compiler macro to get the same result.
+ ;;(push `(gv-define-setter ,accessor (cl-val cl-x)
+ ;; ,(if (cadr (memq :read-only (cddr desc)))
+ ;; `(progn (ignore cl-x cl-val)
+ ;; (error "%s is a read-only slot"
+ ;; ',accessor))
+ ;; ;; If cl is loaded only for compilation,
+ ;; ;; the call to cl--struct-setf-expander would
+ ;; ;; cause a warning because it may not be
+ ;; ;; defined at run time. Suppress that warning.
+ ;; `(progn
+ ;; (declare-function
+ ;; cl--struct-setf-expander "cl-macs"
+ ;; (x name accessor pred-form pos))
+ ;; (cl--struct-setf-expander
+ ;; cl-val cl-x ',name ',accessor
+ ;; ,(and pred-check `',pred-check)
+ ;; ,pos))))
+ ;; forms)
(if print-auto
(nconc print-func
- (list (list 'princ (format " %s" slot) 'cl-s)
- (list 'prin1 (list accessor 'cl-x) 'cl-s)))))))
+ (list `(princ ,(format " %s" slot) cl-s)
+ `(prin1 (,accessor cl-x) cl-s)))))))
(setq pos (1+ pos))))
(setq slots (nreverse slots)
defaults (nreverse defaults))
(and predicate pred-form
- (progn (push (list 'defsubst* predicate '(cl-x)
- (if (eq (car pred-form) 'and)
- (append pred-form '(t))
- (list 'and pred-form t))) forms)
+ (progn (push `(cl-defsubst ,predicate (cl-x)
+ ,(if (eq (car pred-form) 'and)
+ (append pred-form '(t))
+ `(and ,pred-form t))) forms)
(push (cons predicate 'error-free) side-eff)))
(and copier
- (progn (push (list 'defun copier '(x) '(copy-sequence x)) forms)
+ (progn (push `(defun ,copier (x) (copy-sequence x)) forms)
(push (cons copier t) side-eff)))
(if constructor
(push (list constructor
(while constrs
(let* ((name (caar constrs))
(args (cadr (pop constrs)))
- (anames (cl-arglist-args args))
- (make (mapcar* (function (lambda (s d) (if (memq s anames) s d)))
+ (anames (cl--arglist-args args))
+ (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
slots defaults)))
- (push (list 'defsubst* name
- (list* '&cl-defs (list 'quote (cons nil descs)) args)
- (cons type make)) forms)
- (if (cl-safe-expr-p (cons 'progn (mapcar 'second descs)))
+ (push `(cl-defsubst ,name
+ (&cl-defs '(nil ,@descs) ,@args)
+ (,type ,@make)) forms)
+ (if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
(push (cons name t) side-eff))))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
- (if print-func
- (push `(push
- ;; The auto-generated function does not pay attention to
- ;; the depth argument cl-n.
- (lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n))
- (and ,pred-form ,print-func))
- custom-print-functions)
- forms))
- (push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
- (push (list* 'eval-when '(compile load eval)
- (list 'put (list 'quote name) '(quote cl-struct-slots)
- (list 'quote descs))
- (list 'put (list 'quote name) '(quote cl-struct-type)
- (list 'quote (list type (eq named t))))
- (list 'put (list 'quote name) '(quote cl-struct-include)
- (list 'quote include))
- (list 'put (list 'quote name) '(quote cl-struct-print)
- print-auto)
- (mapcar (function (lambda (x)
- (list 'put (list 'quote (car x))
- '(quote side-effect-free)
- (list 'quote (cdr x)))))
- side-eff))
- forms)
- (cons 'progn (nreverse (cons (list 'quote name) forms)))))
-
-;;;###autoload
-(defun cl-struct-setf-expander (x name accessor pred-form pos)
- (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--")))
- (list (list temp) (list x) (list store)
- (append '(progn)
- (and pred-form
- (list (list 'or (subst temp 'cl-x pred-form)
- (list 'error
- (format
- "%s storing a non-%s" accessor name)))))
- (list (if (eq (car (get name 'cl-struct-type)) 'vector)
- (list 'aset temp pos store)
- (list 'setcar
- (if (<= pos 5)
- (let ((xx temp))
- (while (>= (setq pos (1- pos)) 0)
- (setq xx (list 'cdr xx)))
- xx)
- (list 'nthcdr pos temp))
- store))))
- (list accessor temp))))
-
+ ;; Don't bother adding to cl-custom-print-functions since it's not used
+ ;; by anything anyway!
+ ;;(if print-func
+ ;; (push `(if (boundp 'cl-custom-print-functions)
+ ;; (push
+ ;; ;; The auto-generated function does not pay attention to
+ ;; ;; the depth argument cl-n.
+ ;; (lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n))
+ ;; (and ,pred-form ,print-func))
+ ;; cl-custom-print-functions))
+ ;; forms))
+ (push `(setq ,tag-symbol (list ',tag)) forms)
+ (push `(cl-eval-when (compile load eval)
+ (put ',name 'cl-struct-slots ',descs)
+ (put ',name 'cl-struct-type ',(list type (eq named t)))
+ (put ',name 'cl-struct-include ',include)
+ (put ',name 'cl-struct-print ,print-auto)
+ ,@(mapcar (lambda (x)
+ `(put ',(car x) 'side-effect-free ',(cdr x)))
+ side-eff))
+ forms)
+ `(progn ,@(nreverse (cons `',name forms)))))
;;; Types and assertions.
;;;###autoload
-(defmacro deftype (name arglist &rest body)
+(defmacro cl-deftype (name arglist &rest body)
"Define NAME as a new data type.
-The type name can then be used in `typecase', `check-type', etc."
- (list 'eval-when '(compile load eval)
- (cl-transform-function-property
- name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) arglist) body))))
+The type name can then be used in `cl-typecase', `cl-check-type', etc."
+ (declare (debug cl-defmacro) (doc-string 3))
+ `(cl-eval-when (compile load eval)
+ (put ',name 'cl-deftype-handler
+ (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
-(defun cl-make-type-test (val type)
+(defun cl--make-type-test (val type)
(if (symbolp type)
(cond ((get type 'cl-deftype-handler)
- (cl-make-type-test val (funcall (get type 'cl-deftype-handler))))
+ (cl--make-type-test val (funcall (get type 'cl-deftype-handler))))
((memq type '(nil t)) type)
((eq type 'null) `(null ,val))
((eq type 'atom) `(atom ,val))
- ((eq type 'float) `(floatp-safe ,val))
+ ((eq type 'float) `(cl-floatp-safe ,val))
((eq type 'real) `(numberp ,val))
((eq type 'fixnum) `(integerp ,val))
- ;; FIXME: Should `character' accept things like ?\C-\M-a ? -stef
+ ;; FIXME: Should `character' accept things like ?\C-\M-a ? --Stef
((memq type '(character string-char)) `(characterp ,val))
(t
(let* ((name (symbol-name type))
(if (fboundp namep) (list namep val)
(list (intern (concat name "-p")) val)))))
(cond ((get (car type) 'cl-deftype-handler)
- (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler)
+ (cl--make-type-test val (apply (get (car type) 'cl-deftype-handler)
(cdr type))))
((memq (car type) '(integer float real number))
- (delq t (list 'and (cl-make-type-test val (car type))
- (if (memq (cadr type) '(* nil)) t
- (if (consp (cadr type)) (list '> val (caadr type))
- (list '>= val (cadr type))))
- (if (memq (caddr type) '(* nil)) t
- (if (consp (caddr type)) (list '< val (caaddr type))
- (list '<= val (caddr type)))))))
+ (delq t `(and ,(cl--make-type-test val (car type))
+ ,(if (memq (cadr type) '(* nil)) t
+ (if (consp (cadr type)) `(> ,val ,(cl-caadr type))
+ `(>= ,val ,(cadr type))))
+ ,(if (memq (cl-caddr type) '(* nil)) t
+ (if (consp (cl-caddr type)) `(< ,val ,(cl-caaddr type))
+ `(<= ,val ,(cl-caddr type)))))))
((memq (car type) '(and or not))
(cons (car type)
- (mapcar (function (lambda (x) (cl-make-type-test val x)))
+ (mapcar (function (lambda (x) (cl--make-type-test val x)))
(cdr type))))
- ((memq (car type) '(member member*))
- (list 'and (list 'member* val (list 'quote (cdr type))) t))
+ ((memq (car type) '(member cl-member))
+ `(and (cl-member ,val ',(cdr type)) t))
((eq (car type) 'satisfies) (list (cadr type) val))
(t (error "Bad type spec: %s" type)))))
+(defvar cl--object)
;;;###autoload
-(defun typep (object type) ; See compiler macro below.
+(defun cl-typep (object type) ; See compiler macro below.
"Check that OBJECT is of type TYPE.
TYPE is a Common Lisp-style type specifier."
- (eval (cl-make-type-test 'object type)))
+ (let ((cl--object object)) ;; Yuck!!
+ (eval (cl--make-type-test 'cl--object type))))
;;;###autoload
-(defmacro check-type (form type &optional string)
+(defmacro cl-check-type (form type &optional string)
"Verify that FORM is of type TYPE; signal an error if not.
STRING is an optional description of the desired type."
- (and (or (not (cl-compiling-file))
+ (declare (debug (place cl-type-spec &optional stringp)))
+ (and (or (not (cl--compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
- (let* ((temp (if (cl-simple-expr-p form 3)
+ (let* ((temp (if (cl--simple-expr-p form 3)
form (make-symbol "--cl-var--")))
- (body (list 'or (cl-make-type-test temp type)
- (list 'signal '(quote wrong-type-argument)
- (list 'list (or string (list 'quote type))
- temp (list 'quote form))))))
- (if (eq temp form) (list 'progn body nil)
- (list 'let (list (list temp form)) body nil)))))
+ (body `(or ,(cl--make-type-test temp type)
+ (signal 'wrong-type-argument
+ (list ,(or string `',type)
+ ,temp ',form)))))
+ (if (eq temp form) `(progn ,body nil)
+ `(let ((,temp ,form)) ,body nil)))))
;;;###autoload
-(defmacro assert (form &optional show-args string &rest args)
+(defmacro cl-assert (form &optional show-args string &rest args)
+ ;; FIXME: This is actually not compatible with Common-Lisp's `assert'.
"Verify that FORM returns non-nil; signal an error if not.
Second arg SHOW-ARGS means to include arguments of FORM in message.
Other args STRING and ARGS... are arguments to be passed to `error'.
They are not evaluated unless the assertion fails. If STRING is
omitted, a default message listing FORM itself is used."
- (and (or (not (cl-compiling-file))
+ (declare (debug (form &rest form)))
+ (and (or (not (cl--compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
(let ((sargs (and show-args
- (delq nil (mapcar
- (lambda (x)
- (unless (cl-const-expr-p x)
- x))
- (cdr form))))))
- (list 'progn
- (list 'or form
- (if string
- (list* 'error string (append sargs args))
- (list 'signal '(quote cl-assertion-failed)
- (list* 'list (list 'quote form) sargs))))
- nil))))
+ (delq nil (mapcar (lambda (x)
+ (unless (macroexp-const-p x)
+ x))
+ (cdr form))))))
+ `(progn
+ (or ,form
+ ,(if string
+ `(error ,string ,@sargs ,@args)
+ `(signal 'cl-assertion-failed
+ (list ',form ,@sargs))))
+ nil))))
;;; Compiler macros.
;;;###autoload
-(defmacro define-compiler-macro (func args &rest body)
+(defmacro cl-define-compiler-macro (func args &rest body)
"Define a compiler-only macro.
This is like `defmacro', but macro expansion occurs only if the call to
FUNC is compiled (i.e., not interpreted). Compiler macros should be used
possible. Unlike regular macros, BODY can decide to \"punt\" and leave the
original function call alone by declaring an initial `&whole foo' parameter
and then returning foo."
+ (declare (debug cl-defmacro))
(let ((p args) (res nil))
(while (consp p) (push (pop p) res))
(setq args (nconc (nreverse res) (and p (list '&rest p)))))
- (list 'eval-when '(compile load eval)
- (cl-transform-function-property
- func 'cl-compiler-macro
- (cons (if (memq '&whole args) (delq '&whole args)
- (cons '_cl-whole-arg args)) body))
- (list 'or (list 'get (list 'quote func) '(quote byte-compile))
- (list 'progn
- (list 'put (list 'quote func) '(quote byte-compile)
- '(quote cl-byte-compile-compiler-macro))
- ;; This is so that describe-function can locate
- ;; the macro definition.
- (list 'let
- (list (list
- 'file
- (or buffer-file-name
- (and (boundp 'byte-compile-current-file)
- (stringp byte-compile-current-file)
- byte-compile-current-file))))
- (list 'if 'file
- (list 'put (list 'quote func)
- '(quote compiler-macro-file)
- '(purecopy (file-name-nondirectory file)))))))))
+ `(cl-eval-when (compile load eval)
+ (put ',func 'compiler-macro
+ (cl-function (lambda ,(if (memq '&whole args) (delq '&whole args)
+ (cons '_cl-whole-arg args))
+ ,@body)))
+ ;; This is so that describe-function can locate
+ ;; the macro definition.
+ (let ((file ,(or buffer-file-name
+ (and (boundp 'byte-compile-current-file)
+ (stringp byte-compile-current-file)
+ byte-compile-current-file))))
+ (if file (put ',func 'compiler-macro-file
+ (purecopy (file-name-nondirectory file)))))))
;;;###autoload
-(defun compiler-macroexpand (form)
+(defun cl-compiler-macroexpand (form)
(while
(let ((func (car-safe form)) (handler nil))
(while (and (symbolp func)
- (not (setq handler (get func 'cl-compiler-macro)))
+ (not (setq handler (get func 'compiler-macro)))
(fboundp func)
- (or (not (eq (car-safe (symbol-function func)) 'autoload))
- (load (nth 1 (symbol-function func)))))
+ (or (not (autoloadp (symbol-function func)))
+ (autoload-do-load (symbol-function func) func)))
(setq func (symbol-function func)))
(and handler
(not (eq form (setq form (apply handler form (cdr form))))))))
form)
-(defun cl-byte-compile-compiler-macro (form)
- (if (eq form (setq form (compiler-macroexpand form)))
- (byte-compile-normal-call form)
- (byte-compile-form form)))
-
;; Optimize away unused block-wrappers.
-(defvar cl-active-block-names nil)
+(defvar cl--active-block-names nil)
-(define-compiler-macro cl-block-wrapper (cl-form)
+(cl-define-compiler-macro cl--block-wrapper (cl-form)
(let* ((cl-entry (cons (nth 1 (nth 1 cl-form)) nil))
- (cl-active-block-names (cons cl-entry cl-active-block-names))
+ (cl--active-block-names (cons cl-entry cl--active-block-names))
(cl-body (macroexpand-all ;Performs compiler-macro expansions.
(cons 'progn (cddr cl-form))
macroexpand-all-environment)))
`(catch ,(nth 1 cl-form) ,@(cdr cl-body))
cl-body)))
-(define-compiler-macro cl-block-throw (cl-tag cl-value)
- (let ((cl-found (assq (nth 1 cl-tag) cl-active-block-names)))
+(cl-define-compiler-macro cl--block-throw (cl-tag cl-value)
+ (let ((cl-found (assq (nth 1 cl-tag) cl--active-block-names)))
(if cl-found (setcdr cl-found t)))
`(throw ,cl-tag ,cl-value))
;;;###autoload
-(defmacro defsubst* (name args &rest body)
+(defmacro cl-defsubst (name args &rest body)
"Define NAME as a function.
Like `defun', except the function is automatically declared `inline',
ARGLIST allows full Common Lisp conventions, and BODY is implicitly
-surrounded by (block NAME ...).
+surrounded by (cl-block NAME ...).
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
- (let* ((argns (cl-arglist-args args)) (p argns)
+ (declare (debug cl-defun) (indent 2))
+ (let* ((argns (cl--arglist-args args)) (p argns)
(pbody (cons 'progn body))
- (unsafe (not (cl-safe-expr-p pbody))))
- (while (and p (eq (cl-expr-contains args (car p)) 1)) (pop p))
- (list 'progn
- (if p nil ; give up if defaults refer to earlier args
- (list 'define-compiler-macro name
- (if (memq '&key args)
- (list* '&whole 'cl-whole '&cl-quote args)
- (cons '&cl-quote args))
- (list* 'cl-defsubst-expand (list 'quote argns)
- (list 'quote (list* 'block name body))
- ;; We used to pass `simple' as
- ;; (not (or unsafe (cl-expr-access-order pbody argns)))
- ;; But this is much too simplistic since it
- ;; does not pay attention to the argvs (and
- ;; cl-expr-access-order itself is also too naive).
- nil
- (and (memq '&key args) 'cl-whole) unsafe argns)))
- (list* 'defun* name args body))))
-
-(defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs)
- (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole
- (if (cl-simple-exprs-p argvs) (setq simple t))
+ (unsafe (not (cl--safe-expr-p pbody))))
+ (while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p))
+ `(progn
+ ,(if p nil ; give up if defaults refer to earlier args
+ `(cl-define-compiler-macro ,name
+ ,(if (memq '&key args)
+ `(&whole cl-whole &cl-quote ,@args)
+ (cons '&cl-quote args))
+ (cl--defsubst-expand
+ ',argns '(cl-block ,name ,@body)
+ ;; We used to pass `simple' as
+ ;; (not (or unsafe (cl-expr-access-order pbody argns)))
+ ;; But this is much too simplistic since it
+ ;; does not pay attention to the argvs (and
+ ;; cl-expr-access-order itself is also too naive).
+ nil
+ ,(and (memq '&key args) 'cl-whole) ,unsafe ,@argns)))
+ (cl-defun ,name ,args ,@body))))
+
+(defun cl--defsubst-expand (argns body simple whole unsafe &rest argvs)
+ (if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole
+ (if (cl--simple-exprs-p argvs) (setq simple t))
(let* ((substs ())
(lets (delq nil
- (mapcar* (function
- (lambda (argn argv)
- (if (or simple (cl-const-expr-p argv))
- (progn (push (cons argn argv) substs)
- (and unsafe (list argn argv)))
- (list argn argv))))
- argns argvs))))
+ (cl-mapcar (lambda (argn argv)
+ (if (or simple (macroexp-const-p argv))
+ (progn (push (cons argn argv) substs)
+ (and unsafe (list argn argv)))
+ (list argn argv)))
+ argns argvs))))
;; FIXME: `sublis/subst' will happily substitute the symbol
;; `argn' in places where it's not used as a reference
;; to a variable.
;; scope, leading to name capture.
(setq body (cond ((null substs) body)
((null (cdr substs))
- (subst (cdar substs) (caar substs) body))
- (t (sublis substs body))))
- (if lets (list 'let lets body) body))))
+ (cl-subst (cdar substs) (caar substs) body))
+ (t (cl-sublis substs body))))
+ (if lets `(let ,lets ,body) body))))
;; Compile-time optimizations for some functions defined in this package.
-;; Note that cl.el arranges to force cl-macs to be loaded at compile-time,
-;; mainly to make sure these macros will be present.
-
-(put 'eql 'byte-compile nil)
-(define-compiler-macro eql (&whole form a b)
- (cond ((eq (cl-const-expr-p a) t)
- (let ((val (cl-const-expr-val a)))
- (if (and (numberp val) (not (integerp val)))
- (list 'equal a b)
- (list 'eq a b))))
- ((eq (cl-const-expr-p b) t)
- (let ((val (cl-const-expr-val b)))
- (if (and (numberp val) (not (integerp val)))
- (list 'equal a b)
- (list 'eq a b))))
- ((cl-simple-expr-p a 5)
- (list 'if (list 'numberp a)
- (list 'equal a b)
- (list 'eq a b)))
- ((and (cl-safe-expr-p a)
- (cl-simple-expr-p b 5))
- (list 'if (list 'numberp b)
- (list 'equal a b)
- (list 'eq a b)))
- (t form)))
-
-(define-compiler-macro member* (&whole form a list &rest keys)
+
+(defun cl--compiler-macro-member (form a list &rest keys)
(let ((test (and (= (length keys) 2) (eq (car keys) :test)
- (cl-const-expr-val (nth 1 keys)))))
- (cond ((eq test 'eq) (list 'memq a list))
- ((eq test 'equal) (list 'member a list))
- ((or (null keys) (eq test 'eql)) (list 'memql a list))
+ (cl--const-expr-val (nth 1 keys)))))
+ (cond ((eq test 'eq) `(memq ,a ,list))
+ ((eq test 'equal) `(member ,a ,list))
+ ((or (null keys) (eq test 'eql)) `(memql ,a ,list))
(t form))))
-(define-compiler-macro assoc* (&whole form a list &rest keys)
+(defun cl--compiler-macro-assoc (form a list &rest keys)
(let ((test (and (= (length keys) 2) (eq (car keys) :test)
- (cl-const-expr-val (nth 1 keys)))))
- (cond ((eq test 'eq) (list 'assq a list))
- ((eq test 'equal) (list 'assoc a list))
- ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql)))
- (if (floatp-safe (cl-const-expr-val a))
- (list 'assoc a list) (list 'assq a list)))
+ (cl--const-expr-val (nth 1 keys)))))
+ (cond ((eq test 'eq) `(assq ,a ,list))
+ ((eq test 'equal) `(assoc ,a ,list))
+ ((and (macroexp-const-p a) (or (null keys) (eq test 'eql)))
+ (if (cl-floatp-safe (cl--const-expr-val a))
+ `(assoc ,a ,list) `(assq ,a ,list)))
(t form))))
-(define-compiler-macro adjoin (&whole form a list &rest keys)
- (if (and (cl-simple-expr-p a) (cl-simple-expr-p list)
+;;;###autoload
+(defun cl--compiler-macro-adjoin (form a list &rest keys)
+ (if (and (cl--simple-expr-p a) (cl--simple-expr-p list)
(not (memq :key keys)))
- (list 'if (list* 'member* a list keys) list (list 'cons a list))
+ `(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list))
form))
-(define-compiler-macro list* (arg &rest others)
- (let* ((args (reverse (cons arg others)))
- (form (car args)))
- (while (setq args (cdr args))
- (setq form (list 'cons (car args) form)))
- form))
-
-(define-compiler-macro get* (sym prop &optional def)
+(defun cl--compiler-macro-get (_form sym prop &optional def)
(if def
- (list 'getf (list 'symbol-plist sym) prop def)
- (list 'get sym prop)))
-
-(define-compiler-macro typep (&whole form val type)
- (if (cl-const-expr-p type)
- (let ((res (cl-make-type-test val (cl-const-expr-val type))))
- (if (or (memq (cl-expr-contains res val) '(nil 1))
- (cl-simple-expr-p val)) res
- (let ((temp (make-symbol "--cl-var--")))
- (list 'let (list (list temp val)) (subst temp val res)))))
- form))
+ `(cl-getf (symbol-plist ,sym) ,prop ,def)
+ `(get ,sym ,prop)))
+(cl-define-compiler-macro cl-typep (&whole form val type)
+ (if (macroexp-const-p type)
+ (macroexp-let2 macroexp-copyable-p temp val
+ (cl--make-type-test temp (cl--const-expr-val type)))
+ form))
-(mapc (lambda (y)
- (put (car y) 'side-effect-free t)
- (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
- (put (car y) 'cl-compiler-macro
- `(lambda (w x)
- ,(if (symbolp (cadr y))
- `(list ',(cadr y)
- (list ',(caddr y) x))
- (cons 'list (cdr y))))))
- '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
- (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
- (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
- (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0)
- (caaar car caar) (caadr car cadr) (cadar car cdar)
- (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)
- (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar)
- (caaadr car caadr) (caadar car cadar) (caaddr car caddr)
- (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar)
- (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr)
- (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
- (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr) ))
+(dolist (y '(cl-first cl-second cl-third cl-fourth
+ cl-fifth cl-sixth cl-seventh
+ cl-eighth cl-ninth cl-tenth
+ cl-rest cl-endp cl-plusp cl-minusp
+ cl-caaar cl-caadr cl-cadar
+ cl-caddr cl-cdaar cl-cdadr
+ cl-cddar cl-cdddr cl-caaaar
+ cl-caaadr cl-caadar cl-caaddr
+ cl-cadaar cl-cadadr cl-caddar
+ cl-cadddr cl-cdaaar cl-cdaadr
+ cl-cdadar cl-cdaddr cl-cddaar
+ cl-cddadr cl-cdddar cl-cddddr))
+ (put y 'side-effect-free t))
;;; Things that are inline.
-(proclaim '(inline floatp-safe acons map concatenate notany notevery
- cl-set-elt revappend nreconc gethash))
+(cl-proclaim '(inline cl-floatp-safe cl-acons cl-map cl-concatenate cl-notany
+ cl-notevery cl--set-elt cl-revappend cl-nreconc gethash))
;;; Things that are side-effect-free.
(mapc (lambda (x) (put x 'side-effect-free t))
- '(oddp evenp signum last butlast ldiff pairlis gcd lcm
- isqrt floor* ceiling* truncate* round* mod* rem* subseq
- list-length get* getf))
+ '(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd cl-lcm
+ cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem cl-subseq
+ cl-list-length cl-get cl-getf))
;;; Things that are side-effect-and-error-free.
(mapc (lambda (x) (put x 'side-effect-free 'error-free))
- '(eql floatp-safe list* subst acons equalp random-state-p
- copy-tree sublis))
+ '(eql cl-floatp-safe cl-list* cl-subst cl-acons cl-equalp cl-random-state-p
+ copy-tree cl-sublis))
(run-hooks 'cl-macs-load-hook)
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
+(provide 'cl-macs)
+
;;; cl-macs.el ends here
-;;; cl-seq.el --- Common Lisp features, part 3
+;;; cl-seq.el --- Common Lisp features, part 3 -*- lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
;;; Code:
-(require 'cl)
+(require 'cl-lib)
-;;; Keyword parsing. This is special-cased here so that we can compile
-;;; this file independent from cl-macs.
+;; Keyword parsing.
+;; This is special-cased here so that we can compile
+;; this file independent from cl-macs.
-(defmacro cl-parsing-keywords (kwords other-keys &rest body)
+(defmacro cl--parsing-keywords (kwords other-keys &rest body)
(declare (indent 2) (debug (sexp sexp &rest form)))
- (cons
- 'let*
- (cons (mapcar
- (function
- (lambda (x)
- (let* ((var (if (consp x) (car x) x))
- (mem (list 'car (list 'cdr (list 'memq (list 'quote var)
- 'cl-keys)))))
- (if (eq var :test-not)
- (setq mem (list 'and mem (list 'setq 'cl-test mem) t)))
- (if (eq var :if-not)
- (setq mem (list 'and mem (list 'setq 'cl-if mem) t)))
- (list (intern
- (format "cl-%s" (substring (symbol-name var) 1)))
- (if (consp x) (list 'or mem (car (cdr x))) mem)))))
- kwords)
- (append
- (and (not (eq other-keys t))
- (list
- (list 'let '((cl-keys-temp cl-keys))
- (list 'while 'cl-keys-temp
- (list 'or (list 'memq '(car cl-keys-temp)
- (list 'quote
- (mapcar
- (function
- (lambda (x)
- (if (consp x)
- (car x) x)))
- (append kwords
- other-keys))))
- '(car (cdr (memq (quote :allow-other-keys)
- cl-keys)))
- '(error "Bad keyword argument %s"
- (car cl-keys-temp)))
- '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
- body))))
-
-(defmacro cl-check-key (x)
+ `(let* ,(mapcar
+ (lambda (x)
+ (let* ((var (if (consp x) (car x) x))
+ (mem `(car (cdr (memq ',var cl-keys)))))
+ (if (eq var :test-not)
+ (setq mem `(and ,mem (setq cl-test ,mem) t)))
+ (if (eq var :if-not)
+ (setq mem `(and ,mem (setq cl-if ,mem) t)))
+ (list (intern
+ (format "cl-%s" (substring (symbol-name var) 1)))
+ (if (consp x) `(or ,mem ,(car (cdr x))) mem))))
+ kwords)
+ ,@(append
+ (and (not (eq other-keys t))
+ (list
+ (list 'let '((cl-keys-temp cl-keys))
+ (list 'while 'cl-keys-temp
+ (list 'or (list 'memq '(car cl-keys-temp)
+ (list 'quote
+ (mapcar
+ (function
+ (lambda (x)
+ (if (consp x)
+ (car x) x)))
+ (append kwords
+ other-keys))))
+ '(car (cdr (memq (quote :allow-other-keys)
+ cl-keys)))
+ '(error "Bad keyword argument %s"
+ (car cl-keys-temp)))
+ '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
+ body)))
+
+(defmacro cl--check-key (x) ;Expects `cl-key' in context of generated code.
(declare (debug edebug-forms))
- (list 'if 'cl-key (list 'funcall 'cl-key x) x))
+ `(if cl-key (funcall cl-key ,x) ,x))
-(defmacro cl-check-test-nokey (item x)
+(defmacro cl--check-test-nokey (item x) ;cl-test cl-if cl-test-not cl-if-not.
(declare (debug edebug-forms))
- (list 'cond
- (list 'cl-test
- (list 'eq (list 'not (list 'funcall 'cl-test item x))
- 'cl-test-not))
- (list 'cl-if
- (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not))
- (list 't (list 'if (list 'numberp item)
- (list 'equal item x) (list 'eq item x)))))
-
-(defmacro cl-check-test (item x)
+ `(cond
+ (cl-test (eq (not (funcall cl-test ,item ,x))
+ cl-test-not))
+ (cl-if (eq (not (funcall cl-if ,x)) cl-if-not))
+ (t (eql ,item ,x))))
+
+(defmacro cl--check-test (item x) ;all of the above.
(declare (debug edebug-forms))
- (list 'cl-check-test-nokey item (list 'cl-check-key x)))
+ `(cl--check-test-nokey ,item (cl--check-key ,x)))
-(defmacro cl-check-match (x y)
+(defmacro cl--check-match (x y) ;cl-key cl-test cl-test-not
(declare (debug edebug-forms))
- (setq x (list 'cl-check-key x) y (list 'cl-check-key y))
- (list 'if 'cl-test
- (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not)
- (list 'if (list 'numberp x)
- (list 'equal x y) (list 'eq x y))))
+ (setq x `(cl--check-key ,x) y `(cl--check-key ,y))
+ `(if cl-test
+ (eq (not (funcall cl-test ,x ,y)) cl-test-not)
+ (eql ,x ,y)))
(defvar cl-test) (defvar cl-test-not)
(defvar cl-if) (defvar cl-if-not)
(defvar cl-key)
-
;;;###autoload
-(defun reduce (cl-func cl-seq &rest cl-keys)
+(defun cl-reduce (cl-func cl-seq &rest cl-keys)
"Reduce two-argument FUNCTION across SEQ.
\nKeywords supported: :start :end :from-end :initial-value :key
\n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
+ (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
(or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
- (setq cl-seq (subseq cl-seq cl-start cl-end))
+ (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
(if cl-from-end (setq cl-seq (nreverse cl-seq)))
(let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
- (cl-seq (cl-check-key (pop cl-seq)))
+ (cl-seq (cl--check-key (pop cl-seq)))
(t (funcall cl-func)))))
(if cl-from-end
(while cl-seq
- (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
+ (setq cl-accum (funcall cl-func (cl--check-key (pop cl-seq))
cl-accum)))
(while cl-seq
(setq cl-accum (funcall cl-func cl-accum
- (cl-check-key (pop cl-seq))))))
+ (cl--check-key (pop cl-seq))))))
cl-accum)))
;;;###autoload
-(defun fill (seq item &rest cl-keys)
+(defun cl-fill (seq item &rest cl-keys)
"Fill the elements of SEQ with ITEM.
\nKeywords supported: :start :end
\n(fn SEQ ITEM [KEYWORD VALUE]...)"
- (cl-parsing-keywords ((:start 0) :end) ()
+ (cl--parsing-keywords ((:start 0) :end) ()
(if (listp seq)
(let ((p (nthcdr cl-start seq))
(n (if cl-end (- cl-end cl-start) 8000000)))
seq))
;;;###autoload
-(defun replace (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-replace (cl-seq1 cl-seq2 &rest cl-keys)
"Replace the elements of SEQ1 with the elements of SEQ2.
SEQ1 is destructively modified, then returned.
\nKeywords supported: :start1 :end1 :start2 :end2
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
+ (cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
(if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
(or (= cl-start1 cl-start2)
(let* ((cl-len (length cl-seq1))
(cl-n (min (- (or cl-end1 cl-len) cl-start1)
(- (or cl-end2 cl-len) cl-start2))))
(while (>= (setq cl-n (1- cl-n)) 0)
- (cl-set-elt cl-seq1 (+ cl-start1 cl-n)
+ (cl--set-elt cl-seq1 (+ cl-start1 cl-n)
(elt cl-seq2 (+ cl-start2 cl-n))))))
(if (listp cl-seq1)
(let ((cl-p1 (nthcdr cl-start1 cl-seq1))
cl-seq1))
;;;###autoload
-(defun remove* (cl-item cl-seq &rest cl-keys)
+(defun cl-remove (cl-item cl-seq &rest cl-keys)
"Remove all occurrences of ITEM in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
(:start 0) :end) ()
(if (<= (or cl-count (setq cl-count 8000000)) 0)
cl-seq
(if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
- (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end
- cl-from-end)))
+ (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end
+ cl-from-end)))
(if cl-i
- (let ((cl-res (apply 'delete* cl-item (append cl-seq nil)
+ (let ((cl-res (apply 'cl-delete cl-item (append cl-seq nil)
(append (if cl-from-end
(list :end (1+ cl-i))
(list :start cl-i))
(setq cl-end (- (or cl-end 8000000) cl-start))
(if (= cl-start 0)
(while (and cl-seq (> cl-end 0)
- (cl-check-test cl-item (car cl-seq))
+ (cl--check-test cl-item (car cl-seq))
(setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
(> (setq cl-count (1- cl-count)) 0))))
(if (and (> cl-count 0) (> cl-end 0))
(let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq)
(setq cl-end (1- cl-end)) (cdr cl-seq))))
(while (and cl-p (> cl-end 0)
- (not (cl-check-test cl-item (car cl-p))))
+ (not (cl--check-test cl-item (car cl-p))))
(setq cl-p (cdr cl-p) cl-end (1- cl-end)))
(if (and cl-p (> cl-end 0))
- (nconc (ldiff cl-seq cl-p)
+ (nconc (cl-ldiff cl-seq cl-p)
(if (= cl-count 1) (cdr cl-p)
(and (cdr cl-p)
- (apply 'delete* cl-item
+ (apply 'cl-delete cl-item
(copy-sequence (cdr cl-p))
:start 0 :end (1- cl-end)
:count (1- cl-count) cl-keys))))
cl-seq)))))
;;;###autoload
-(defun remove-if (cl-pred cl-list &rest cl-keys)
+(defun cl-remove-if (cl-pred cl-list &rest cl-keys)
"Remove all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'remove* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-remove nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun remove-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-remove-if-not (cl-pred cl-list &rest cl-keys)
"Remove all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'remove* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-remove nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun delete* (cl-item cl-seq &rest cl-keys)
+(defun cl-delete (cl-item cl-seq &rest cl-keys)
"Remove all occurrences of ITEM in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
(:start 0) :end) ()
(if (<= (or cl-count (setq cl-count 8000000)) 0)
cl-seq
(if (and cl-from-end (< cl-count 4000000))
(let (cl-i)
(while (and (>= (setq cl-count (1- cl-count)) 0)
- (setq cl-i (cl-position cl-item cl-seq cl-start
- cl-end cl-from-end)))
+ (setq cl-i (cl--position cl-item cl-seq cl-start
+ cl-end cl-from-end)))
(if (= cl-i 0) (setq cl-seq (cdr cl-seq))
(let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
(setcdr cl-tail (cdr (cdr cl-tail)))))
(progn
(while (and cl-seq
(> cl-end 0)
- (cl-check-test cl-item (car cl-seq))
+ (cl--check-test cl-item (car cl-seq))
(setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
(> (setq cl-count (1- cl-count)) 0)))
(setq cl-end (1- cl-end)))
(if (and (> cl-count 0) (> cl-end 0))
(let ((cl-p (nthcdr cl-start cl-seq)))
(while (and (cdr cl-p) (> cl-end 0))
- (if (cl-check-test cl-item (car (cdr cl-p)))
+ (if (cl--check-test cl-item (car (cdr cl-p)))
(progn
(setcdr cl-p (cdr (cdr cl-p)))
(if (= (setq cl-count (1- cl-count)) 0)
(setq cl-p (cdr cl-p)))
(setq cl-end (1- cl-end)))))
cl-seq)
- (apply 'remove* cl-item cl-seq cl-keys)))))
+ (apply 'cl-remove cl-item cl-seq cl-keys)))))
;;;###autoload
-(defun delete-if (cl-pred cl-list &rest cl-keys)
+(defun cl-delete-if (cl-pred cl-list &rest cl-keys)
"Remove all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'delete* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-delete nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun delete-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-delete-if-not (cl-pred cl-list &rest cl-keys)
"Remove all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'delete* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-delete nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun remove-duplicates (cl-seq &rest cl-keys)
+(defun cl-remove-duplicates (cl-seq &rest cl-keys)
"Return a copy of SEQ with all duplicate elements removed.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn SEQ [KEYWORD VALUE]...)"
- (cl-delete-duplicates cl-seq cl-keys t))
+ (cl--delete-duplicates cl-seq cl-keys t))
;;;###autoload
-(defun delete-duplicates (cl-seq &rest cl-keys)
+(defun cl-delete-duplicates (cl-seq &rest cl-keys)
"Remove all duplicate elements from SEQ (destructively).
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn SEQ [KEYWORD VALUE]...)"
- (cl-delete-duplicates cl-seq cl-keys nil))
+ (cl--delete-duplicates cl-seq cl-keys nil))
-(defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
+(defun cl--delete-duplicates (cl-seq cl-keys cl-copy)
(if (listp cl-seq)
- (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
+ (cl--parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
()
(if cl-from-end
(let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
(setq cl-end (- (or cl-end (length cl-seq)) cl-start))
(while (> cl-end 1)
(setq cl-i 0)
- (while (setq cl-i (cl-position (cl-check-key (car cl-p))
- (cdr cl-p) cl-i (1- cl-end)))
+ (while (setq cl-i (cl--position (cl--check-key (car cl-p))
+ (cdr cl-p) cl-i (1- cl-end)))
(if cl-copy (setq cl-seq (copy-sequence cl-seq)
cl-p (nthcdr cl-start cl-seq) cl-copy nil))
(let ((cl-tail (nthcdr cl-i cl-p)))
cl-seq)
(setq cl-end (- (or cl-end (length cl-seq)) cl-start))
(while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
- (cl-position (cl-check-key (car cl-seq))
- (cdr cl-seq) 0 (1- cl-end)))
+ (cl--position (cl--check-key (car cl-seq))
+ (cdr cl-seq) 0 (1- cl-end)))
(setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
(let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
(setq cl-end (1- cl-end) cl-start 1) cl-seq)))
(while (and (cdr (cdr cl-p)) (> cl-end 1))
- (if (cl-position (cl-check-key (car (cdr cl-p)))
- (cdr (cdr cl-p)) 0 (1- cl-end))
+ (if (cl--position (cl--check-key (car (cdr cl-p)))
+ (cdr (cdr cl-p)) 0 (1- cl-end))
(progn
(if cl-copy (setq cl-seq (copy-sequence cl-seq)
cl-p (nthcdr (1- cl-start) cl-seq)
(setq cl-p (cdr cl-p)))
(setq cl-end (1- cl-end) cl-start (1+ cl-start)))
cl-seq)))
- (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil)))
+ (let ((cl-res (cl--delete-duplicates (append cl-seq nil) cl-keys nil)))
(if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
;;;###autoload
-(defun substitute (cl-new cl-old cl-seq &rest cl-keys)
+(defun cl-substitute (cl-new cl-old cl-seq &rest cl-keys)
"Substitute NEW for OLD in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count
(:start 0) :end :from-end) ()
(if (or (eq cl-old cl-new)
(<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
cl-seq
- (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end)))
+ (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end)))
(if (not cl-i)
cl-seq
(setq cl-seq (copy-sequence cl-seq))
(or cl-from-end
- (progn (cl-set-elt cl-seq cl-i cl-new)
+ (progn (cl--set-elt cl-seq cl-i cl-new)
(setq cl-i (1+ cl-i) cl-count (1- cl-count))))
- (apply 'nsubstitute cl-new cl-old cl-seq :count cl-count
+ (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
:start cl-i cl-keys))))))
;;;###autoload
-(defun substitute-if (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-substitute-if (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-substitute cl-new nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-substitute cl-new nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
+(defun cl-nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
"Substitute NEW for OLD in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count
(:start 0) :end :from-end) ()
(or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
(if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
(let ((cl-p (nthcdr cl-start cl-seq)))
(setq cl-end (- (or cl-end 8000000) cl-start))
(while (and cl-p (> cl-end 0) (> cl-count 0))
- (if (cl-check-test cl-old (car cl-p))
+ (if (cl--check-test cl-old (car cl-p))
(progn
(setcar cl-p cl-new)
(setq cl-count (1- cl-count))))
(if cl-from-end
(while (and (< cl-start cl-end) (> cl-count 0))
(setq cl-end (1- cl-end))
- (if (cl-check-test cl-old (elt cl-seq cl-end))
+ (if (cl--check-test cl-old (elt cl-seq cl-end))
(progn
- (cl-set-elt cl-seq cl-end cl-new)
+ (cl--set-elt cl-seq cl-end cl-new)
(setq cl-count (1- cl-count)))))
(while (and (< cl-start cl-end) (> cl-count 0))
- (if (cl-check-test cl-old (aref cl-seq cl-start))
+ (if (cl--check-test cl-old (aref cl-seq cl-start))
(progn
(aset cl-seq cl-start cl-new)
(setq cl-count (1- cl-count))))
cl-seq))
;;;###autoload
-(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun find (cl-item cl-seq &rest cl-keys)
+(defun cl-find (cl-item cl-seq &rest cl-keys)
"Find the first occurrence of ITEM in SEQ.
Return the matching ITEM, or nil if not found.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
+ (let ((cl-pos (apply 'cl-position cl-item cl-seq cl-keys)))
(and cl-pos (elt cl-seq cl-pos))))
;;;###autoload
-(defun find-if (cl-pred cl-list &rest cl-keys)
+(defun cl-find-if (cl-pred cl-list &rest cl-keys)
"Find the first item satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'find nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-find nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun find-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-find-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item not satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'find nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-find nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun position (cl-item cl-seq &rest cl-keys)
+(defun cl-position (cl-item cl-seq &rest cl-keys)
"Find the first occurrence of ITEM in SEQ.
Return the index of the matching item, or nil if not found.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not
+ (cl--parsing-keywords (:test :test-not :key :if :if-not
(:start 0) :end :from-end) ()
- (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
+ (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
-(defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
+(defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
(if (listp cl-seq)
(let ((cl-p (nthcdr cl-start cl-seq)))
(or cl-end (setq cl-end 8000000))
(let ((cl-res nil))
(while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
- (if (cl-check-test cl-item (car cl-p))
+ (if (cl--check-test cl-item (car cl-p))
(setq cl-res cl-start))
(setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
cl-res))
(if cl-from-end
(progn
(while (and (>= (setq cl-end (1- cl-end)) cl-start)
- (not (cl-check-test cl-item (aref cl-seq cl-end)))))
+ (not (cl--check-test cl-item (aref cl-seq cl-end)))))
(and (>= cl-end cl-start) cl-end))
(while (and (< cl-start cl-end)
- (not (cl-check-test cl-item (aref cl-seq cl-start))))
+ (not (cl--check-test cl-item (aref cl-seq cl-start))))
(setq cl-start (1+ cl-start)))
(and (< cl-start cl-end) cl-start))))
;;;###autoload
-(defun position-if (cl-pred cl-list &rest cl-keys)
+(defun cl-position-if (cl-pred cl-list &rest cl-keys)
"Find the first item satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'position nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-position nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun position-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-position-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item not satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
\nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'position nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-position nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun count (cl-item cl-seq &rest cl-keys)
+(defun cl-count (cl-item cl-seq &rest cl-keys)
"Count the number of occurrences of ITEM in SEQ.
\nKeywords supported: :test :test-not :key :start :end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
+ (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
(let ((cl-count 0) cl-x)
(or cl-end (setq cl-end (length cl-seq)))
(if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
(while (< cl-start cl-end)
(setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
- (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
+ (if (cl--check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
(setq cl-start (1+ cl-start)))
cl-count)))
;;;###autoload
-(defun count-if (cl-pred cl-list &rest cl-keys)
+(defun cl-count-if (cl-pred cl-list &rest cl-keys)
"Count the number of items satisfying PREDICATE in SEQ.
\nKeywords supported: :key :start :end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'count nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-count nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun count-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-count-if-not (cl-pred cl-list &rest cl-keys)
"Count the number of items not satisfying PREDICATE in SEQ.
\nKeywords supported: :key :start :end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
- (apply 'count nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-count nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-mismatch (cl-seq1 cl-seq2 &rest cl-keys)
"Compare SEQ1 with SEQ2, return index of first mismatching element.
Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorter sequence.
\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :from-end
+ (cl--parsing-keywords (:test :test-not :key :from-end
(:start1 0) :end1 (:start2 0) :end2) ()
(or cl-end1 (setq cl-end1 (length cl-seq1)))
(or cl-end2 (setq cl-end2 (length cl-seq2)))
(if cl-from-end
(progn
(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl-check-match (elt cl-seq1 (1- cl-end1))
+ (cl--check-match (elt cl-seq1 (1- cl-end1))
(elt cl-seq2 (1- cl-end2))))
(setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
(let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
(cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
- (cl-check-match (if cl-p1 (car cl-p1)
+ (cl--check-match (if cl-p1 (car cl-p1)
(aref cl-seq1 cl-start1))
(if cl-p2 (car cl-p2)
(aref cl-seq2 cl-start2))))
cl-start1)))))
;;;###autoload
-(defun search (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-search (cl-seq1 cl-seq2 &rest cl-keys)
"Search for SEQ1 as a subsequence of SEQ2.
Return the index of the leftmost element of the first match found;
return nil if there are no matches.
\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :from-end
+ (cl--parsing-keywords (:test :test-not :key :from-end
(:start1 0) :end1 (:start2 0) :end2) ()
(or cl-end1 (setq cl-end1 (length cl-seq1)))
(or cl-end2 (setq cl-end2 (length cl-seq2)))
(if (>= cl-start1 cl-end1)
(if cl-from-end cl-end2 cl-start2)
(let* ((cl-len (- cl-end1 cl-start1))
- (cl-first (cl-check-key (elt cl-seq1 cl-start1)))
+ (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
(cl-if nil) cl-pos)
(setq cl-end2 (- cl-end2 (1- cl-len)))
(while (and (< cl-start2 cl-end2)
- (setq cl-pos (cl-position cl-first cl-seq2
- cl-start2 cl-end2 cl-from-end))
- (apply 'mismatch cl-seq1 cl-seq2
+ (setq cl-pos (cl--position cl-first cl-seq2
+ cl-start2 cl-end2 cl-from-end))
+ (apply 'cl-mismatch cl-seq1 cl-seq2
:start1 (1+ cl-start1) :end1 cl-end1
:start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
:from-end nil cl-keys))
(and (< cl-start2 cl-end2) cl-pos)))))
;;;###autoload
-(defun sort* (cl-seq cl-pred &rest cl-keys)
+(defun cl-sort (cl-seq cl-pred &rest cl-keys)
"Sort the argument SEQ according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
\nKeywords supported: :key
\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
(if (nlistp cl-seq)
- (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
- (cl-parsing-keywords (:key) ()
+ (cl-replace cl-seq (apply 'cl-sort (append cl-seq nil) cl-pred cl-keys))
+ (cl--parsing-keywords (:key) ()
(if (memq cl-key '(nil identity))
(sort cl-seq cl-pred)
(sort cl-seq (function (lambda (cl-x cl-y)
(funcall cl-key cl-y)))))))))
;;;###autoload
-(defun stable-sort (cl-seq cl-pred &rest cl-keys)
+(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
"Sort the argument SEQ stably according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
\nKeywords supported: :key
\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
- (apply 'sort* cl-seq cl-pred cl-keys))
+ (apply 'cl-sort cl-seq cl-pred cl-keys))
;;;###autoload
-(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
+(defun cl-merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
"Destructively merge the two sequences to produce a new sequence.
TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
sequences, and PREDICATE is a `less-than' predicate on the elements.
\n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
(or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
(or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
- (cl-parsing-keywords (:key) ()
+ (cl--parsing-keywords (:key) ()
(let ((cl-res nil))
(while (and cl-seq1 cl-seq2)
- (if (funcall cl-pred (cl-check-key (car cl-seq2))
- (cl-check-key (car cl-seq1)))
+ (if (funcall cl-pred (cl--check-key (car cl-seq2))
+ (cl--check-key (car cl-seq1)))
(push (pop cl-seq2) cl-res)
(push (pop cl-seq1) cl-res)))
- (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
+ (cl-coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
-;;; See compiler macro in cl-macs.el
;;;###autoload
-(defun member* (cl-item cl-list &rest cl-keys)
+(defun cl-member (cl-item cl-list &rest cl-keys)
"Find the first occurrence of ITEM in LIST.
Return the sublist of LIST whose car is ITEM.
\nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
+ (declare (compiler-macro cl--compiler-macro-member))
(if cl-keys
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
- (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+ (while (and cl-list (not (cl--check-test cl-item (car cl-list))))
(setq cl-list (cdr cl-list)))
cl-list)
(if (and (numberp cl-item) (not (integerp cl-item)))
(member cl-item cl-list)
(memq cl-item cl-list))))
+(autoload 'cl--compiler-macro-member "cl-macs")
;;;###autoload
-(defun member-if (cl-pred cl-list &rest cl-keys)
+(defun cl-member-if (cl-pred cl-list &rest cl-keys)
"Find the first item satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'member* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-member nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun member-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-member-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item not satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'member* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-member nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun cl-adjoin (cl-item cl-list &rest cl-keys)
- (if (cl-parsing-keywords (:key) t
- (apply 'member* (cl-check-key cl-item) cl-list cl-keys))
+(defun cl--adjoin (cl-item cl-list &rest cl-keys)
+ (if (cl--parsing-keywords (:key) t
+ (apply 'cl-member (cl--check-key cl-item) cl-list cl-keys))
cl-list
(cons cl-item cl-list)))
-;;; See compiler macro in cl-macs.el
;;;###autoload
-(defun assoc* (cl-item cl-alist &rest cl-keys)
+(defun cl-assoc (cl-item cl-alist &rest cl-keys)
"Find the first item whose car matches ITEM in LIST.
\nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
+ (declare (compiler-macro cl--compiler-macro-assoc))
(if cl-keys
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
(while (and cl-alist
(or (not (consp (car cl-alist)))
- (not (cl-check-test cl-item (car (car cl-alist))))))
+ (not (cl--check-test cl-item (car (car cl-alist))))))
(setq cl-alist (cdr cl-alist)))
(and cl-alist (car cl-alist)))
(if (and (numberp cl-item) (not (integerp cl-item)))
(assoc cl-item cl-alist)
(assq cl-item cl-alist))))
+(autoload 'cl--compiler-macro-assoc "cl-macs")
;;;###autoload
-(defun assoc-if (cl-pred cl-list &rest cl-keys)
+(defun cl-assoc-if (cl-pred cl-list &rest cl-keys)
"Find the first item whose car satisfies PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'assoc* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-assoc nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun assoc-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-assoc-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item whose car does not satisfy PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-assoc nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun rassoc* (cl-item cl-alist &rest cl-keys)
+(defun cl-rassoc (cl-item cl-alist &rest cl-keys)
"Find the first item whose cdr matches ITEM in LIST.
\nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(if (or cl-keys (numberp cl-item))
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
(while (and cl-alist
(or (not (consp (car cl-alist)))
- (not (cl-check-test cl-item (cdr (car cl-alist))))))
+ (not (cl--check-test cl-item (cdr (car cl-alist))))))
(setq cl-alist (cdr cl-alist)))
(and cl-alist (car cl-alist)))
(rassq cl-item cl-alist)))
;;;###autoload
-(defun rassoc-if (cl-pred cl-list &rest cl-keys)
+(defun cl-rassoc-if (cl-pred cl-list &rest cl-keys)
"Find the first item whose cdr satisfies PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'rassoc* nil cl-list :if cl-pred cl-keys))
+ (apply 'cl-rassoc nil cl-list :if cl-pred cl-keys))
;;;###autoload
-(defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-rassoc-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item whose cdr does not satisfy PREDICATE in LIST.
\nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
- (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys))
+ (apply 'cl-rassoc nil cl-list :if-not cl-pred cl-keys))
;;;###autoload
-(defun union (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-union (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
(setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
(while cl-list2
(if (or cl-keys (numberp (car cl-list2)))
- (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys))
+ (setq cl-list1 (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys))
(or (memq (car cl-list2) cl-list1)
(push (car cl-list2) cl-list1)))
(pop cl-list2))
cl-list1)))
;;;###autoload
-(defun nunion (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nunion (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-union operation.
The resulting list contains all items that appear in either LIST1 or LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
- (t (apply 'union cl-list1 cl-list2 cl-keys))))
+ (t (apply 'cl-union cl-list1 cl-list2 cl-keys))))
;;;###autoload
-(defun intersection (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-intersection (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(and cl-list1 cl-list2
(if (equal cl-list1 cl-list2) cl-list1
- (cl-parsing-keywords (:key) (:test :test-not)
+ (cl--parsing-keywords (:key) (:test :test-not)
(let ((cl-res nil))
(or (>= (length cl-list1) (length cl-list2))
(setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
(while cl-list2
(if (if (or cl-keys (numberp (car cl-list2)))
- (apply 'member* (cl-check-key (car cl-list2))
+ (apply 'cl-member (cl--check-key (car cl-list2))
cl-list1 cl-keys)
(memq (car cl-list2) cl-list1))
(push (car cl-list2) cl-res))
cl-res)))))
;;;###autoload
-(defun nintersection (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nintersection (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-intersection operation.
The resulting list contains all items that appear in both LIST1 and LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible.
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
- (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
+ (and cl-list1 cl-list2 (apply 'cl-intersection cl-list1 cl-list2 cl-keys)))
;;;###autoload
-(defun set-difference (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-set-difference (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(if (or (null cl-list1) (null cl-list2)) cl-list1
- (cl-parsing-keywords (:key) (:test :test-not)
+ (cl--parsing-keywords (:key) (:test :test-not)
(let ((cl-res nil))
(while cl-list1
(or (if (or cl-keys (numberp (car cl-list1)))
- (apply 'member* (cl-check-key (car cl-list1))
+ (apply 'cl-member (cl--check-key (car cl-list1))
cl-list2 cl-keys)
(memq (car cl-list1) cl-list2))
(push (car cl-list1) cl-res))
cl-res))))
;;;###autoload
-(defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-difference operation.
The resulting list contains all items that appear in LIST1 but not LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(if (or (null cl-list1) (null cl-list2)) cl-list1
- (apply 'set-difference cl-list1 cl-list2 cl-keys)))
+ (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)))
;;;###autoload
-(defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
((equal cl-list1 cl-list2) nil)
- (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
- (apply 'set-difference cl-list2 cl-list1 cl-keys)))))
+ (t (append (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)
+ (apply 'cl-set-difference cl-list2 cl-list1 cl-keys)))))
;;;###autoload
-(defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
"Combine LIST1 and LIST2 using a set-exclusive-or operation.
The resulting list contains all items appearing in exactly one of LIST1, LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
((equal cl-list1 cl-list2) nil)
- (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
- (apply 'nset-difference cl-list2 cl-list1 cl-keys)))))
+ (t (nconc (apply 'cl-nset-difference cl-list1 cl-list2 cl-keys)
+ (apply 'cl-nset-difference cl-list2 cl-list1 cl-keys)))))
;;;###autoload
-(defun subsetp (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-subsetp (cl-list1 cl-list2 &rest cl-keys)
"Return true if LIST1 is a subset of LIST2.
I.e., if every element of LIST1 also appears in LIST2.
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) t) ((null cl-list2) nil)
((equal cl-list1 cl-list2) t)
- (t (cl-parsing-keywords (:key) (:test :test-not)
+ (t (cl--parsing-keywords (:key) (:test :test-not)
(while (and cl-list1
- (apply 'member* (cl-check-key (car cl-list1))
+ (apply 'cl-member (cl--check-key (car cl-list1))
cl-list2 cl-keys))
(pop cl-list1))
(null cl-list1)))))
;;;###autoload
-(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-subst-if (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced by NEW.
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
- (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
+ (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
;;;###autoload
-(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all non-matching elements replaced by NEW.
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
- (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+ (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
;;;###autoload
-(defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
+(defun cl-nsubst (cl-new cl-old cl-tree &rest cl-keys)
"Substitute NEW for OLD everywhere in TREE (destructively).
Any element of TREE which is `eql' to OLD is changed to NEW (via a call
to `setcar').
\nKeywords supported: :test :test-not :key
\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
- (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
+ (apply 'cl-nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
;;;###autoload
-(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elements matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
- (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
+ (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
;;;###autoload
-(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elements not matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
\nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
- (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+ (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+
+(defvar cl--alist)
;;;###autoload
-(defun sublis (cl-alist cl-tree &rest cl-keys)
+(defun cl-sublis (cl-alist cl-tree &rest cl-keys)
"Perform substitutions indicated by ALIST in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced.
\nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
- (cl-sublis-rec cl-tree)))
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+ (let ((cl--alist cl-alist))
+ (cl--sublis-rec cl-tree))))
-(defvar cl-alist)
-(defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if*
- (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist))
- (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
+(defun cl--sublis-rec (cl-tree) ;Uses cl--alist cl-key/test*/if*.
+ (let ((cl-temp (cl--check-key cl-tree)) (cl-p cl--alist))
+ (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
(setq cl-p (cdr cl-p)))
(if cl-p (cdr (car cl-p))
(if (consp cl-tree)
- (let ((cl-a (cl-sublis-rec (car cl-tree)))
- (cl-d (cl-sublis-rec (cdr cl-tree))))
+ (let ((cl-a (cl--sublis-rec (car cl-tree)))
+ (cl-d (cl--sublis-rec (cdr cl-tree))))
(if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
cl-tree
(cons cl-a cl-d)))
cl-tree))))
;;;###autoload
-(defun nsublis (cl-alist cl-tree &rest cl-keys)
+(defun cl-nsublis (cl-alist cl-tree &rest cl-keys)
"Perform substitutions indicated by ALIST in TREE (destructively).
Any matching element of TREE is changed via a call to `setcar'.
\nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
- (let ((cl-hold (list cl-tree)))
- (cl-nsublis-rec cl-hold)
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+ (let ((cl-hold (list cl-tree))
+ (cl--alist cl-alist))
+ (cl--nsublis-rec cl-hold)
(car cl-hold))))
-(defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if*
+(defun cl--nsublis-rec (cl-tree) ;Uses cl--alist cl-key/test*/if*.
(while (consp cl-tree)
- (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist))
- (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
+ (let ((cl-temp (cl--check-key (car cl-tree))) (cl-p cl--alist))
+ (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
(setq cl-p (cdr cl-p)))
(if cl-p (setcar cl-tree (cdr (car cl-p)))
- (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree))))
- (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist)
- (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
+ (if (consp (car cl-tree)) (cl--nsublis-rec (car cl-tree))))
+ (setq cl-temp (cl--check-key (cdr cl-tree)) cl-p cl--alist)
+ (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
(setq cl-p (cdr cl-p)))
(if cl-p
(progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
(setq cl-tree (cdr cl-tree))))))
;;;###autoload
-(defun tree-equal (cl-x cl-y &rest cl-keys)
+(defun cl-tree-equal (cl-x cl-y &rest cl-keys)
"Return t if trees TREE1 and TREE2 have `eql' leaves.
Atoms are compared by `eql'; cons cells are compared recursively.
\nKeywords supported: :test :test-not :key
\n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key) ()
- (cl-tree-equal-rec cl-x cl-y)))
+ (cl--parsing-keywords (:test :test-not :key) ()
+ (cl--tree-equal-rec cl-x cl-y)))
-(defun cl-tree-equal-rec (cl-x cl-y)
+(defun cl--tree-equal-rec (cl-x cl-y) ;Uses cl-key/test*.
(while (and (consp cl-x) (consp cl-y)
- (cl-tree-equal-rec (car cl-x) (car cl-y)))
+ (cl--tree-equal-rec (car cl-x) (car cl-y)))
(setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
- (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y)))
+ (and (not (consp cl-x)) (not (consp cl-y)) (cl--check-match cl-x cl-y)))
(run-hooks 'cl-seq-load-hook)
+++ /dev/null
-;;; cl-specs.el --- Edebug specs for cl.el -*- no-byte-compile: t -*-
-
-;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
-;; Author: Daniel LaLiberte <liberte@holonexus.org>
-;; Keywords: lisp, tools, maint
-;; Package: emacs
-
-;; LCD Archive Entry:
-;; cl-specs.el|Daniel LaLiberte|liberte@holonexus.org
-;; |Edebug specs for cl.el
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; These specs are to be used with edebug.el version 3.3 or later and
-;; cl.el version 2.03 or later, by Dave Gillespie <daveg@synaptics.com>.
-
-;; This file need not be byte-compiled, but it shouldn't hurt.
-
-;;; Code:
-
-(provide 'cl-specs)
-;; Do the above provide before the following require.
-;; Otherwise if you load this before edebug if cl is already loaded
-;; an infinite loading loop would occur.
-(require 'edebug)
-
-;; Blocks
-
-(def-edebug-spec block (symbolp body))
-(def-edebug-spec return (&optional form))
-(def-edebug-spec return-from (symbolp &optional form))
-
-;; Loops
-
-(def-edebug-spec case (form &rest (sexp body)))
-(def-edebug-spec ecase case)
-(def-edebug-spec do
- ((&rest &or symbolp (symbolp &optional form form))
- (form body)
- cl-declarations body))
-(def-edebug-spec do* do)
-(def-edebug-spec dolist
- ((symbolp form &optional form) cl-declarations body))
-(def-edebug-spec dotimes dolist)
-(def-edebug-spec do-symbols
- ((symbolp &optional form form) cl-declarations body))
-(def-edebug-spec do-all-symbols
- ((symbolp &optional form) cl-declarations body))
-
-;; Multiple values
-
-(def-edebug-spec multiple-value-list (form))
-(def-edebug-spec multiple-value-call (function-form body))
-(def-edebug-spec multiple-value-bind
- ((&rest symbolp) form body))
-(def-edebug-spec multiple-value-setq ((&rest symbolp) form))
-(def-edebug-spec multiple-value-prog1 (form body))
-
-;; Bindings
-
-(def-edebug-spec lexical-let let)
-(def-edebug-spec lexical-let* let)
-
-(def-edebug-spec psetq setq)
-(def-edebug-spec progv (form form body))
-
-(def-edebug-spec flet ((&rest (defun*)) cl-declarations body))
-(def-edebug-spec labels flet)
-
-(def-edebug-spec macrolet
- ((&rest (&define name (&rest arg) cl-declarations-or-string def-body))
- cl-declarations body))
-
-(def-edebug-spec symbol-macrolet
- ((&rest (symbol sexp)) cl-declarations body))
-
-(def-edebug-spec destructuring-bind
- (&define cl-macro-list def-form cl-declarations def-body))
-
-;; Setf
-
-(def-edebug-spec setf (&rest [place form])) ;; sexp is not specific enough
-(def-edebug-spec psetf setf)
-
-(def-edebug-spec letf ;; *not* available in Common Lisp
- ((&rest (gate place &optional form))
- body))
-(def-edebug-spec letf* letf)
-
-
-(def-edebug-spec defsetf
- (&define name
- [&or [symbolp &optional stringp]
- [cl-lambda-list (symbolp)]]
- cl-declarations-or-string def-body))
-
-(def-edebug-spec define-setf-method
- (&define name cl-lambda-list cl-declarations-or-string def-body))
-
-(def-edebug-spec define-modify-macro
- (&define name cl-lambda-list ;; should exclude &key
- symbolp &optional stringp))
-
-(def-edebug-spec callf (function* place &rest form))
-(def-edebug-spec callf2 (function* form place &rest form))
-
-;; Other operations on places
-
-(def-edebug-spec remf (place form))
-
-(def-edebug-spec incf (place &optional form))
-(def-edebug-spec decf incf)
-(def-edebug-spec push (form place)) ; different for CL
-(def-edebug-spec pushnew
- (form place &rest
- &or [[&or ":test" ":test-not" ":key"] function-form]
- [keywordp form]))
-(def-edebug-spec pop (place)) ; different for CL
-
-(def-edebug-spec shiftf (&rest place)) ;; really [&rest place] form
-(def-edebug-spec rotatef (&rest place))
-
-
-;; Functions with function args. These are only useful if the
-;; function arg is quoted with ' instead of function.
-
-(def-edebug-spec some (function-form form &rest form))
-(def-edebug-spec every some)
-(def-edebug-spec notany some)
-(def-edebug-spec notevery some)
-
-;; Mapping
-
-(def-edebug-spec map (form function-form form &rest form))
-(def-edebug-spec maplist (function-form form &rest form))
-(def-edebug-spec mapc maplist)
-(def-edebug-spec mapl maplist)
-(def-edebug-spec mapcan maplist)
-(def-edebug-spec mapcon maplist)
-
-;; Sequences
-
-(def-edebug-spec reduce (function-form form &rest form))
-
-;; Types and assertions
-
-(def-edebug-spec cl-type-spec (sexp)) ;; not worth the trouble to specify, yet.
-
-(def-edebug-spec deftype defmacro*)
-(def-edebug-spec check-type (place cl-type-spec &optional stringp))
-;; (def-edebug-spec assert (form &optional form stringp &rest form))
-(def-edebug-spec assert (form &rest form))
-(def-edebug-spec typecase (form &rest ([&or cl-type-spec "otherwise"] body)))
-(def-edebug-spec etypecase typecase)
-
-(def-edebug-spec ignore-errors t)
-
-;; Time of Evaluation
-
-(def-edebug-spec eval-when
- ((&rest &or "compile" "load" "eval") body))
-(def-edebug-spec load-time-value (form &optional &or "t" "nil"))
-
-;; Declarations
-
-(def-edebug-spec cl-decl-spec
- ((symbolp &rest sexp)))
-
-(def-edebug-spec cl-declarations
- (&rest ("declare" &rest cl-decl-spec)))
-
-(def-edebug-spec cl-declarations-or-string
- (&or stringp cl-declarations))
-
-(def-edebug-spec declaim (&rest cl-decl-spec))
-(def-edebug-spec declare (&rest cl-decl-spec)) ;; probably not needed.
-(def-edebug-spec locally (cl-declarations &rest form))
-(def-edebug-spec the (cl-type-spec form))
-
-;;======================================================
-;; Lambda things
-
-(def-edebug-spec cl-lambda-list
- (([&rest arg]
- [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
- [&optional ["&rest" arg]]
- [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- )))
-
-(def-edebug-spec cl-&optional-arg
- (&or (arg &optional def-form arg) arg))
-
-(def-edebug-spec cl-&key-arg
- (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
-
-;; The lambda list for macros is different from that of normal lambdas.
-;; Note that &environment is only allowed as first or last items in the
-;; top level list.
-
-(def-edebug-spec cl-macro-list
- (([&optional "&environment" arg]
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- [&optional "&environment" arg]
- )))
-
-(def-edebug-spec cl-macro-arg
- (&or arg cl-macro-list1))
-
-(def-edebug-spec cl-macro-list1
- (([&optional "&whole" arg] ;; only allowed at lower levels
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- . [&or arg nil])))
-
-
-(def-edebug-spec defun*
- ;; Same as defun but use cl-lambda-list.
- (&define [&or name
- ("setf" :name setf name)]
- cl-lambda-list
- cl-declarations-or-string
- [&optional ("interactive" interactive)]
- def-body))
-(def-edebug-spec defsubst* defun*)
-
-(def-edebug-spec defmacro*
- (&define name cl-macro-list cl-declarations-or-string def-body))
-(def-edebug-spec define-compiler-macro defmacro*)
-
-
-(def-edebug-spec function*
- (&or symbolp cl-lambda-expr))
-
-(def-edebug-spec cl-lambda-expr
- (&define ("lambda" cl-lambda-list
- ;;cl-declarations-or-string
- ;;[&optional ("interactive" interactive)]
- def-body)))
-
-;; Redefine function-form to also match function*
-(def-edebug-spec function-form
- ;; form at the end could also handle "function",
- ;; but recognize it specially to avoid wrapping function forms.
- (&or ([&or "quote" "function"] &or symbolp lambda-expr)
- ("function*" function*)
- form))
-
-;;======================================================
-;; Structures
-;; (def-edebug-spec defstruct (&rest sexp)) would be sufficient, but...
-
-;; defstruct may contain forms that are evaluated when a structure is created.
-(def-edebug-spec defstruct
- (&define ; makes top-level form not be wrapped
- [&or symbolp
- (gate
- symbolp &rest
- (&or [":conc-name" symbolp]
- [":constructor" symbolp &optional cl-lambda-list]
- [":copier" symbolp]
- [":predicate" symbolp]
- [":include" symbolp &rest sexp];; not finished
- ;; The following are not supported.
- ;; [":print-function" ...]
- ;; [":type" ...]
- ;; [":initial-offset" ...]
- ))]
- [&optional stringp]
- ;; All the above is for the following def-form.
- &rest &or symbolp (symbolp def-form &optional ":read-only" sexp)))
-
-;;======================================================
-;; Loop
-
-;; The loop macro is very complex, and a full spec is found below.
-;; The following spec only minimally specifies that
-;; parenthesized forms are executable, but single variables used as
-;; expressions will be missed. You may want to use this if the full
-;; spec causes problems for you.
-
-(def-edebug-spec loop
- (&rest &or symbolp form))
-
-;; Below is a complete spec for loop, in several parts that correspond
-;; to the syntax given in CLtL2. The specs do more than specify where
-;; the forms are; it also specifies, as much as Edebug allows, all the
-;; syntactically valid loop clauses. The disadvantage of this
-;; completeness is rigidity, but the "for ... being" clause allows
-;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
-
-(def-edebug-spec loop
- ([&optional ["named" symbolp]]
- [&rest
- &or
- ["repeat" form]
- loop-for-as
- loop-with
- loop-initial-final]
- [&rest loop-clause]
- ))
-
-(def-edebug-spec loop-with
- ("with" loop-var
- loop-type-spec
- [&optional ["=" form]]
- &rest ["and" loop-var
- loop-type-spec
- [&optional ["=" form]]]))
-
-(def-edebug-spec loop-for-as
- ([&or "for" "as"] loop-for-as-subclause
- &rest ["and" loop-for-as-subclause]))
-
-(def-edebug-spec loop-for-as-subclause
- (loop-var
- loop-type-spec
- &or
- [[&or "in" "on" "in-ref" "across-ref"]
- form &optional ["by" function-form]]
-
- ["=" form &optional ["then" form]]
- ["across" form]
- ["being"
- [&or "the" "each"]
- &or
- [[&or "element" "elements"]
- [&or "of" "in" "of-ref"] form
- &optional "using" ["index" symbolp]];; is this right?
- [[&or "hash-key" "hash-keys"
- "hash-value" "hash-values"]
- [&or "of" "in"]
- hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
- "hash-key" "hash-keys"] sexp)]]
-
- [[&or "symbol" "present-symbol" "external-symbol"
- "symbols" "present-symbols" "external-symbols"]
- [&or "in" "of"] package-p]
-
- ;; Extensions for Emacs Lisp, including Lucid Emacs.
- [[&or "frame" "frames"
- "screen" "screens"
- "buffer" "buffers"]]
-
- [[&or "window" "windows"]
- [&or "of" "in"] form]
-
- [[&or "overlay" "overlays"
- "extent" "extents"]
- [&or "of" "in"] form
- &optional [[&or "from" "to"] form]]
-
- [[&or "interval" "intervals"]
- [&or "in" "of"] form
- &optional [[&or "from" "to"] form]
- ["property" form]]
-
- [[&or "key-code" "key-codes"
- "key-seq" "key-seqs"
- "key-binding" "key-bindings"]
- [&or "in" "of"] form
- &optional ["using" ([&or "key-code" "key-codes"
- "key-seq" "key-seqs"
- "key-binding" "key-bindings"]
- sexp)]]
- ;; For arbitrary extensions, recognize anything else.
- [symbolp &rest &or symbolp form]
- ]
-
- ;; arithmetic - must be last since all parts are optional.
- [[&optional [[&or "from" "downfrom" "upfrom"] form]]
- [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
- [&optional ["by" form]]
- ]))
-
-(def-edebug-spec loop-initial-final
- (&or ["initially"
- ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
- &rest loop-non-atomic-expr]
- ["finally" &or
- [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
- ["return" form]]))
-
-(def-edebug-spec loop-and-clause
- (loop-clause &rest ["and" loop-clause]))
-
-(def-edebug-spec loop-clause
- (&or
- [[&or "while" "until" "always" "never" "thereis"] form]
-
- [[&or "collect" "collecting"
- "append" "appending"
- "nconc" "nconcing"
- "concat" "vconcat"] form
- [&optional ["into" loop-var]]]
-
- [[&or "count" "counting"
- "sum" "summing"
- "maximize" "maximizing"
- "minimize" "minimizing"] form
- [&optional ["into" loop-var]]
- loop-type-spec]
-
- [[&or "if" "when" "unless"]
- form loop-and-clause
- [&optional ["else" loop-and-clause]]
- [&optional "end"]]
-
- [[&or "do" "doing"] &rest loop-non-atomic-expr]
-
- ["return" form]
- loop-initial-final
- ))
-
-(def-edebug-spec loop-non-atomic-expr
- ([¬ atom] form))
-
-(def-edebug-spec loop-var
- ;; The symbolp must be last alternative to recognize e.g. (a b . c)
- ;; loop-var =>
- ;; (loop-var . [&or nil loop-var])
- ;; (symbolp . [&or nil loop-var])
- ;; (symbolp . loop-var)
- ;; (symbolp . (symbolp . [&or nil loop-var]))
- ;; (symbolp . (symbolp . loop-var))
- ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
- (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
-
-(def-edebug-spec loop-type-spec
- (&optional ["of-type" loop-d-type-spec]))
-
-(def-edebug-spec loop-d-type-spec
- (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
-
-;;; cl-specs.el ends here
-;;; cl.el --- Common Lisp extensions for Emacs
+;;; cl.el --- Compatibility aliases for the old CL library. -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2012 Free Software Foundation, Inc.
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions
;; This file is part of GNU Emacs.
;;; Commentary:
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains the portions of the Common Lisp extensions
-;; package which should always be present.
-
-
-;;; Future notes:
-
-;; Once Emacs 19 becomes standard, many things in this package which are
-;; messy for reasons of compatibility can be greatly simplified. For now,
-;; I prefer to maintain one unified version.
-
-
-;;; Change Log:
-
-;; Version 2.02 (30 Jul 93):
-;; * Added "cl-compat.el" file, extra compatibility with old package.
-;; * Added `lexical-let' and `lexical-let*'.
-;; * Added `define-modify-macro', `callf', and `callf2'.
-;; * Added `ignore-errors'.
-;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.
-;; * Merged `*gentemp-counter*' into `*gensym-counter*'.
-;; * Extended `subseq' to allow negative START and END like `substring'.
-;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses.
-;; * Added `concat', `vconcat' loop clauses.
-;; * Cleaned up a number of compiler warnings.
-
-;; Version 2.01 (7 Jul 93):
-;; * Added support for FSF version of Emacs 19.
-;; * Added `add-hook' for Emacs 18 users.
-;; * Added `defsubst*' and `symbol-macrolet'.
-;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.
-;; * Added `map', `concatenate', `reduce', `merge'.
-;; * Added `revappend', `nreconc', `tailp', `tree-equal'.
-;; * Added `assert', `check-type', `typecase', `typep', and `deftype'.
-;; * Added destructuring and `&environment' support to `defmacro*'.
-;; * Added destructuring to `loop', and added the following clauses:
-;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.
-;; * Renamed `delete' to `delete*' and `remove' to `remove*'.
-;; * Completed support for all keywords in `remove*', `substitute', etc.
-;; * Added `most-positive-float' and company.
-;; * Fixed hash tables to work with latest Lucid Emacs.
-;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.
-;; * Syntax for `warn' declarations has changed.
-;; * Improved implementation of `random*'.
-;; * Moved most sequence functions to a new file, cl-seq.el.
-;; * Moved `eval-when' into cl-macs.el.
-;; * Moved `pushnew' and `adjoin' to cl.el for most common cases.
-;; * Moved `provide' forms down to ends of files.
-;; * Changed expansion of `pop' to something that compiles to better code.
-;; * Changed so that no patch is required for Emacs 19 byte compiler.
-;; * Made more things dependent on `optimize' declarations.
-;; * Added a partial implementation of struct print functions.
-;; * Miscellaneous minor changes.
-
-;; Version 2.00:
-;; * First public release of this package.
-
+;; This is a compatibility file which provides the old names provided by CL
+;; before we cleaned up its namespace usage.
;;; Code:
-(defvar cl-optimize-speed 1)
-(defvar cl-optimize-safety 1)
-
-
-;;;###autoload
-(defvar custom-print-functions nil
- "This is a list of functions that format user objects for printing.
-Each function is called in turn with three arguments: the object, the
-stream, and the print level (currently ignored). If it is able to
-print the object it returns true; otherwise it returns nil and the
-printer proceeds to the next function on the list.
-
-This variable is not used at present, but it is defined in hopes that
-a future Emacs interpreter will be able to use it.")
-
-(defun cl-unload-function ()
- "Stop unloading of the Common Lisp extensions."
- (message "Cannot unload the feature `cl'")
- ;; stop standard unloading!
- t)
-
-;;; Generalized variables.
-;; These macros are defined here so that they
-;; can safely be used in .emacs files.
-
-(defmacro incf (place &optional x)
- "Increment PLACE by X (1 by default).
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the incremented value of PLACE."
- (if (symbolp place)
- (list 'setq place (if x (list '+ place x) (list '1+ place)))
- (list 'callf '+ place (or x 1))))
-
-(defmacro decf (place &optional x)
- "Decrement PLACE by X (1 by default).
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the decremented value of PLACE."
- (if (symbolp place)
- (list 'setq place (if x (list '- place x) (list '1- place)))
- (list 'callf '- place (or x 1))))
-
-;; Autoloaded, but we haven't loaded cl-loaddefs yet.
-(declare-function cl-do-pop "cl-macs" (place))
-
-(defmacro pop (place)
- "Remove and return the head of the list stored in PLACE.
-Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
-careful about evaluating each argument only once and in the right order.
-PLACE may be a symbol, or any generalized variable allowed by `setf'."
- (if (symbolp place)
- (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))
- (cl-do-pop place)))
-
-(defmacro push (x place)
- "Insert X at the head of the list stored in PLACE.
-Analogous to (setf PLACE (cons X PLACE)), though more careful about
-evaluating each argument only once and in the right order. PLACE may
-be a symbol, or any generalized variable allowed by `setf'."
- (if (symbolp place) (list 'setq place (list 'cons x place))
- (list 'callf2 'cons x place)))
-
-(defmacro pushnew (x place &rest keys)
- "(pushnew X PLACE): insert X at the head of the list if not already there.
-Like (push X PLACE), except that the list is unmodified if X is `eql' to
-an element already on the list.
-\nKeywords supported: :test :test-not :key
-\n(fn X PLACE [KEYWORD VALUE]...)"
- (if (symbolp place)
- (if (null keys)
- `(let ((x ,x))
- (if (memql x ,place)
- ;; This symbol may later on expand to actual code which then
- ;; trigger warnings like "value unused" since pushnew's return
- ;; value is rarely used. It should not matter that other
- ;; warnings may be silenced, since `place' is used earlier and
- ;; should have triggered them already.
- (with-no-warnings ,place)
- (setq ,place (cons x ,place))))
- (list 'setq place (list* 'adjoin x place keys)))
- (list* 'callf2 'adjoin x place keys)))
-
-(defun cl-set-elt (seq n val)
- (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
-
-(defsubst cl-set-nthcdr (n list x)
- (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list))
-
-(defun cl-set-buffer-substring (start end val)
- (save-excursion (delete-region start end)
- (goto-char start)
- (insert val)
- val))
-
-(defun cl-set-substring (str start end val)
- (if end (if (< end 0) (incf end (length str)))
- (setq end (length str)))
- (if (< start 0) (incf start (length str)))
- (concat (and (> start 0) (substring str 0 start))
- val
- (and (< end (length str)) (substring str end))))
-
-
-;;; Control structures.
-
-;; These macros are so simple and so often-used that it's better to have
-;; them all the time than to load them from cl-macs.el.
-
-(defun cl-map-extents (&rest cl-args)
- (apply 'cl-map-overlays cl-args))
-
-
-;;; Blocks and exits.
-
-(defalias 'cl-block-wrapper 'identity)
-(defalias 'cl-block-throw 'throw)
-
-
-;;; Multiple values.
-;; True multiple values are not supported, or even
-;; simulated. Instead, multiple-value-bind and friends simply expect
-;; the target form to return the values as a list.
-
-(defsubst values (&rest values)
- "Return multiple values, Common Lisp style.
-The arguments of `values' are the values
-that the containing function should return."
- values)
-
-(defsubst values-list (list)
- "Return multiple values, Common Lisp style, taken from a list.
-LIST specifies the list of values
-that the containing function should return."
- list)
-
-(defsubst multiple-value-list (expression)
- "Return a list of the multiple values produced by EXPRESSION.
-This handles multiple values in Common Lisp style, but it does not
-work right when EXPRESSION calls an ordinary Emacs Lisp function
-that returns just one value."
- expression)
-
-(defsubst multiple-value-apply (function expression)
- "Evaluate EXPRESSION to get multiple values and apply FUNCTION to them.
-This handles multiple values in Common Lisp style, but it does not work
-right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
-one value."
- (apply function expression))
-
-(defalias 'multiple-value-call 'apply
- "Apply FUNCTION to ARGUMENTS, taking multiple values into account.
-This implementation only handles the case where there is only one argument.")
-
-(defsubst nth-value (n expression)
- "Evaluate EXPRESSION to get multiple values and return the Nth one.
-This handles multiple values in Common Lisp style, but it does not work
-right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
-one value."
- (nth n expression))
-
-;;; Macros.
-
-(defvar cl-macro-environment)
-(defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand)
- (defalias 'macroexpand 'cl-macroexpand)))
-
-(defun cl-macroexpand (cl-macro &optional cl-env)
- "Return result of expanding macros at top level of FORM.
-If FORM is not a macro call, it is returned unchanged.
-Otherwise, the macro is expanded and the expansion is considered
-in place of FORM. When a non-macro-call results, it is returned.
-
-The second optional arg ENVIRONMENT specifies an environment of macro
-definitions to shadow the loaded ones for use in file byte-compilation.
-\n(fn FORM &optional ENVIRONMENT)"
- (let ((cl-macro-environment cl-env))
- (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
- (and (symbolp cl-macro)
- (cdr (assq (symbol-name cl-macro) cl-env))))
- (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))
- cl-macro))
-
-
-;;; Declarations.
-
-(defvar cl-compiling-file nil)
-(defun cl-compiling-file ()
- (or cl-compiling-file
- (and (boundp 'byte-compile--outbuffer)
- (bufferp (symbol-value 'byte-compile--outbuffer))
- (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
- " *Compiler Output*"))))
-
-(defvar cl-proclaims-deferred nil)
-
-(defun proclaim (spec)
- (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
- (push spec cl-proclaims-deferred))
- nil)
-
-(defmacro declaim (&rest specs)
- (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x))))
- specs)))
- (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body)
- (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when
-
-
-;;; Symbols.
-
-(defun cl-random-time ()
- (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
- (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
- v))
-
-(defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
-
-
-;;; Numbers.
-
-(defun floatp-safe (object)
- "Return t if OBJECT is a floating point number.
-On Emacs versions that lack floating-point support, this function
-always returns nil."
- (and (numberp object) (not (integerp object))))
-
-(defun plusp (number)
- "Return t if NUMBER is positive."
- (> number 0))
-
-(defun minusp (number)
- "Return t if NUMBER is negative."
- (< number 0))
-
-(defun oddp (integer)
- "Return t if INTEGER is odd."
- (eq (logand integer 1) 1))
-
-(defun evenp (integer)
- "Return t if INTEGER is even."
- (eq (logand integer 1) 0))
-
-(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
-
-(defconst most-positive-float nil
- "The largest value that a Lisp float can hold.
-If your system supports infinities, this is the largest finite value.
-For IEEE machines, this is approximately 1.79e+308.
-Call `cl-float-limits' to set this.")
-
-(defconst most-negative-float nil
- "The largest negative value that a Lisp float can hold.
-This is simply -`most-positive-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst least-positive-float nil
- "The smallest value greater than zero that a Lisp float can hold.
-For IEEE machines, it is about 4.94e-324 if denormals are supported,
-or 2.22e-308 if they are not.
-Call `cl-float-limits' to set this.")
-
-(defconst least-negative-float nil
- "The smallest value less than zero that a Lisp float can hold.
-This is simply -`least-positive-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst least-positive-normalized-float nil
- "The smallest normalized Lisp float greater than zero.
-This is the smallest value for which IEEE denormalization does not lose
-precision. For IEEE machines, this value is about 2.22e-308.
-For machines that do not support the concept of denormalization
-and gradual underflow, this constant equals `least-positive-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst least-negative-normalized-float nil
- "The smallest normalized Lisp float less than zero.
-This is simply -`least-positive-normalized-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst float-epsilon nil
- "The smallest positive float that adds to 1.0 to give a distinct value.
-Adding a number less than this to 1.0 returns 1.0 due to roundoff.
-For IEEE machines, epsilon is about 2.22e-16.
-Call `cl-float-limits' to set this.")
-
-(defconst float-negative-epsilon nil
- "The smallest positive float that subtracts from 1.0 to give a distinct value.
-For IEEE machines, it is about 1.11e-16.
-Call `cl-float-limits' to set this.")
-
-
-;;; Sequence functions.
-
-(defalias 'copy-seq 'copy-sequence)
-
-(declare-function cl-mapcar-many "cl-extra" (cl-func cl-seqs))
-
-(defun mapcar* (cl-func cl-x &rest cl-rest)
- "Apply FUNCTION to each element of SEQ, and make a list of the results.
-If there are several SEQs, FUNCTION is called with that many arguments,
-and mapping stops as soon as the shortest list runs out. With just one
-SEQ, this is like `mapcar'. With several, it is like the Common Lisp
-`mapcar' function extended to arbitrary sequence types.
-\n(fn FUNCTION SEQ...)"
- (if cl-rest
- (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
- (cl-mapcar-many cl-func (cons cl-x cl-rest))
- (let ((cl-res nil) (cl-y (car cl-rest)))
- (while (and cl-x cl-y)
- (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
- (nreverse cl-res)))
- (mapcar cl-func cl-x)))
-
-(defalias 'svref 'aref)
-
-;;; List functions.
-
-(defalias 'first 'car)
-(defalias 'second 'cadr)
-(defalias 'rest 'cdr)
-(defalias 'endp 'null)
-
-(defun third (x)
- "Return the third element of the list X."
- (car (cdr (cdr x))))
-
-(defun fourth (x)
- "Return the fourth element of the list X."
- (nth 3 x))
-
-(defun fifth (x)
- "Return the fifth element of the list X."
- (nth 4 x))
-
-(defun sixth (x)
- "Return the sixth element of the list X."
- (nth 5 x))
-
-(defun seventh (x)
- "Return the seventh element of the list X."
- (nth 6 x))
-
-(defun eighth (x)
- "Return the eighth element of the list X."
- (nth 7 x))
-
-(defun ninth (x)
- "Return the ninth element of the list X."
- (nth 8 x))
-
-(defun tenth (x)
- "Return the tenth element of the list X."
- (nth 9 x))
-
-(defun caaar (x)
- "Return the `car' of the `car' of the `car' of X."
- (car (car (car x))))
-
-(defun caadr (x)
- "Return the `car' of the `car' of the `cdr' of X."
- (car (car (cdr x))))
-
-(defun cadar (x)
- "Return the `car' of the `cdr' of the `car' of X."
- (car (cdr (car x))))
-
-(defun caddr (x)
- "Return the `car' of the `cdr' of the `cdr' of X."
- (car (cdr (cdr x))))
-
-(defun cdaar (x)
- "Return the `cdr' of the `car' of the `car' of X."
- (cdr (car (car x))))
-
-(defun cdadr (x)
- "Return the `cdr' of the `car' of the `cdr' of X."
- (cdr (car (cdr x))))
-
-(defun cddar (x)
- "Return the `cdr' of the `cdr' of the `car' of X."
- (cdr (cdr (car x))))
-
-(defun cdddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of X."
- (cdr (cdr (cdr x))))
-
-(defun caaaar (x)
- "Return the `car' of the `car' of the `car' of the `car' of X."
- (car (car (car (car x)))))
-
-(defun caaadr (x)
- "Return the `car' of the `car' of the `car' of the `cdr' of X."
- (car (car (car (cdr x)))))
-
-(defun caadar (x)
- "Return the `car' of the `car' of the `cdr' of the `car' of X."
- (car (car (cdr (car x)))))
-
-(defun caaddr (x)
- "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
- (car (car (cdr (cdr x)))))
-
-(defun cadaar (x)
- "Return the `car' of the `cdr' of the `car' of the `car' of X."
- (car (cdr (car (car x)))))
-
-(defun cadadr (x)
- "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
- (car (cdr (car (cdr x)))))
-
-(defun caddar (x)
- "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
- (car (cdr (cdr (car x)))))
-
-(defun cadddr (x)
- "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
- (car (cdr (cdr (cdr x)))))
-
-(defun cdaaar (x)
- "Return the `cdr' of the `car' of the `car' of the `car' of X."
- (cdr (car (car (car x)))))
-
-(defun cdaadr (x)
- "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
- (cdr (car (car (cdr x)))))
-
-(defun cdadar (x)
- "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
- (cdr (car (cdr (car x)))))
-
-(defun cdaddr (x)
- "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
- (cdr (car (cdr (cdr x)))))
-
-(defun cddaar (x)
- "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
- (cdr (cdr (car (car x)))))
-
-(defun cddadr (x)
- "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
- (cdr (cdr (car (cdr x)))))
-
-(defun cdddar (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
- (cdr (cdr (cdr (car x)))))
-
-(defun cddddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
- (cdr (cdr (cdr (cdr x)))))
-
-;;(defun last* (x &optional n)
-;; "Returns the last link in the list LIST.
-;;With optional argument N, returns Nth-to-last link (default 1)."
-;; (if n
-;; (let ((m 0) (p x))
-;; (while (consp p) (incf m) (pop p))
-;; (if (<= n 0) p
-;; (if (< n m) (nthcdr (- m n) x) x)))
-;; (while (consp (cdr x)) (pop x))
-;; x))
-
-(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el
- "Return a new list with specified ARGs as elements, consed to last ARG.
-Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
-`(cons A (cons B (cons C D)))'.
-\n(fn ARG...)"
- (cond ((not rest) arg)
- ((not (cdr rest)) (cons arg (car rest)))
- (t (let* ((n (length rest))
- (copy (copy-sequence rest))
- (last (nthcdr (- n 2) copy)))
- (setcdr last (car (cdr last)))
- (cons arg copy)))))
-
-(defun ldiff (list sublist)
- "Return a copy of LIST with the tail SUBLIST removed."
- (let ((res nil))
- (while (and (consp list) (not (eq list sublist)))
- (push (pop list) res))
- (nreverse res)))
-
-(defun copy-list (list)
- "Return a copy of LIST, which may be a dotted list.
-The elements of LIST are not copied, just the list structure itself."
- (if (consp list)
- (let ((res nil))
- (while (consp list) (push (pop list) res))
- (prog1 (nreverse res) (setcdr res list)))
- (car list)))
+(require 'cl-lib)
+(require 'macroexp)
+
+;; (defun cl--rename ()
+;; (let ((vdefs ())
+;; (fdefs ())
+;; (case-fold-search nil)
+;; (files '("cl.el" "cl-macs.el" "cl-seq.el" "cl-extra.el")))
+;; (dolist (file files)
+;; (with-current-buffer (find-file-noselect file)
+;; (goto-char (point-min))
+;; (while (re-search-forward
+;; "^(\\(def[^ \t\n]*\\) +'?\\(\\(\\sw\\|\\s_\\)+\\)" nil t)
+;; (let ((name (match-string-no-properties 2))
+;; (type (match-string-no-properties 1)))
+;; (unless (string-match-p "\\`cl-" name)
+;; (cond
+;; ((member type '("defvar" "defconst"))
+;; (unless (member name vdefs) (push name vdefs)))
+;; ((member type '("defun" "defsubst" "defalias" "defmacro"))
+;; (unless (member name fdefs) (push name fdefs)))
+;; ((member type '("def-edebug-spec" "defsetf" "define-setf-method"
+;; "define-compiler-macro"))
+;; nil)
+;; (t (error "Unknown type %S" type))))))))
+;; (let ((re (concat "\\_<" (regexp-opt (append vdefs fdefs)) "\\_>"))
+;; (conflicts ()))
+;; (dolist (file files)
+;; (with-current-buffer (find-file-noselect file)
+;; (goto-char (point-min))
+;; (while (re-search-forward re nil t)
+;; (replace-match "cl-\\&"))
+;; (save-buffer))))
+;; (with-current-buffer (find-file-noselect "cl-rename.el")
+;; (dolist (def vdefs)
+;; (insert (format "(defvaralias '%s 'cl-%s)\n" def def)))
+;; (dolist (def fdefs)
+;; (insert (format "(defalias '%s 'cl-%s)\n" def def)))
+;; (save-buffer))))
+
+;; (defun cl--unrename ()
+;; ;; Taken from "Naming Conventions" node of the doc.
+;; (let* ((names '(defun* defsubst* defmacro* function* member*
+;; assoc* rassoc* get* remove* delete*
+;; mapcar* sort* floor* ceiling* truncate*
+;; round* mod* rem* random*))
+;; (files '("cl.el" "cl-lib.el" "cl-macs.el" "cl-seq.el" "cl-extra.el"))
+;; (re (concat "\\_<cl-" (regexp-opt (mapcar #'symbol-name names))
+;; "\\_>")))
+;; (dolist (file files)
+;; (with-current-buffer (find-file-noselect file)
+;; (goto-char (point-min))
+;; (while (re-search-forward re nil t)
+;; (delete-region (1- (point)) (point)))
+;; (save-buffer)))))
+
+;;; Aliases to cl-lib's features.
+
+(dolist (var '(
+ ;; loop-result-var
+ ;; loop-result
+ ;; loop-initially
+ ;; loop-finally
+ ;; loop-bindings
+ ;; loop-args
+ ;; bind-inits
+ ;; bind-block
+ ;; lambda-list-keywords
+ float-negative-epsilon
+ float-epsilon
+ least-negative-normalized-float
+ least-positive-normalized-float
+ least-negative-float
+ least-positive-float
+ most-negative-float
+ most-positive-float
+ ;; custom-print-functions
+ ))
+ (defvaralias var (intern (format "cl-%s" var))))
+
+;; Before overwriting subr.el's `dotimes' and `dolist', let's remember
+;; them under a different name, so we can use them in our implementation
+;; of `dotimes' and `dolist'.
+(unless (fboundp 'cl--dotimes)
+ (defalias 'cl--dotimes (symbol-function 'dotimes) "The non-CL `dotimes'."))
+(unless (fboundp 'cl--dolist)
+ (defalias 'cl--dolist (symbol-function 'dolist) "The non-CL `dolist'."))
+
+(dolist (fun '(
+ (get* . cl-get)
+ (random* . cl-random)
+ (rem* . cl-rem)
+ (mod* . cl-mod)
+ (round* . cl-round)
+ (truncate* . cl-truncate)
+ (ceiling* . cl-ceiling)
+ (floor* . cl-floor)
+ (rassoc* . cl-rassoc)
+ (assoc* . cl-assoc)
+ (member* . cl-member)
+ (delete* . cl-delete)
+ (remove* . cl-remove)
+ (defsubst* . cl-defsubst)
+ (sort* . cl-sort)
+ (function* . cl-function)
+ (defmacro* . cl-defmacro)
+ (defun* . cl-defun)
+ (mapcar* . cl-mapcar)
+
+ remprop
+ getf
+ tailp
+ list-length
+ nreconc
+ revappend
+ concatenate
+ subseq
+ random-state-p
+ make-random-state
+ signum
+ isqrt
+ lcm
+ gcd
+ notevery
+ notany
+ every
+ some
+ mapcon
+ mapcan
+ mapl
+ maplist
+ map
+ equalp
+ coerce
+ tree-equal
+ nsublis
+ sublis
+ nsubst-if-not
+ nsubst-if
+ nsubst
+ subst-if-not
+ subst-if
+ subsetp
+ nset-exclusive-or
+ set-exclusive-or
+ nset-difference
+ set-difference
+ nintersection
+ intersection
+ nunion
+ union
+ rassoc-if-not
+ rassoc-if
+ assoc-if-not
+ assoc-if
+ member-if-not
+ member-if
+ merge
+ stable-sort
+ search
+ mismatch
+ count-if-not
+ count-if
+ count
+ position-if-not
+ position-if
+ position
+ find-if-not
+ find-if
+ find
+ nsubstitute-if-not
+ nsubstitute-if
+ nsubstitute
+ substitute-if-not
+ substitute-if
+ substitute
+ delete-duplicates
+ remove-duplicates
+ delete-if-not
+ delete-if
+ remove-if-not
+ remove-if
+ replace
+ fill
+ reduce
+ compiler-macroexpand
+ define-compiler-macro
+ assert
+ check-type
+ typep
+ deftype
+ defstruct
+ callf2
+ callf
+ letf*
+ ;; letf
+ rotatef
+ shiftf
+ remf
+ psetf
+ (define-setf-method . define-setf-expander)
+ declare
+ the
+ locally
+ multiple-value-setq
+ multiple-value-bind
+ symbol-macrolet
+ macrolet
+ progv
+ psetq
+ do-all-symbols
+ do-symbols
+ dotimes
+ dolist
+ do*
+ do
+ loop
+ return-from
+ return
+ block
+ etypecase
+ typecase
+ ecase
+ case
+ load-time-value
+ eval-when
+ destructuring-bind
+ gentemp
+ gensym
+ pairlis
+ acons
+ subst
+ adjoin
+ copy-list
+ ldiff
+ list*
+ cddddr
+ cdddar
+ cddadr
+ cddaar
+ cdaddr
+ cdadar
+ cdaadr
+ cdaaar
+ cadddr
+ caddar
+ cadadr
+ cadaar
+ caaddr
+ caadar
+ caaadr
+ caaaar
+ cdddr
+ cddar
+ cdadr
+ cdaar
+ caddr
+ cadar
+ caadr
+ caaar
+ tenth
+ ninth
+ eighth
+ seventh
+ sixth
+ fifth
+ fourth
+ third
+ endp
+ rest
+ second
+ first
+ svref
+ copy-seq
+ evenp
+ oddp
+ minusp
+ plusp
+ floatp-safe
+ declaim
+ proclaim
+ nth-value
+ multiple-value-call
+ multiple-value-apply
+ multiple-value-list
+ values-list
+ values
+ pushnew
+ decf
+ incf
+ ))
+ (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
+ (intern (format "cl-%s" fun)))))
+ (defalias fun new)))
+
+;;; Features provided a bit differently in Elisp.
+
+;; First, the old lexical-let is now better served by `lexical-binding', tho
+;; it's not 100% compatible.
+
+(defvar cl-closure-vars nil)
+(defvar cl--function-convert-cache nil)
+
+(defun cl--function-convert (f)
+ "Special macro-expander for special cases of (function F).
+The two cases that are handled are:
+- closure-conversion of lambda expressions for `lexical-let'.
+- renaming of F when it's a function defined via `cl-labels' or `labels'."
+ (require 'cl-macs)
+ (declare-function cl--expr-contains-any "cl-macs" (x y))
+ (cond
+ ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+ ;; *after* handling `function', but we want to stop macroexpansion from
+ ;; being applied infinitely, so we use a cache to return the exact `form'
+ ;; being expanded even though we don't receive it.
+ ((eq f (car cl--function-convert-cache)) (cdr cl--function-convert-cache))
+ ((eq (car-safe f) 'lambda)
+ (let ((body (mapcar (lambda (f)
+ (macroexpand-all f macroexpand-all-environment))
+ (cddr f))))
+ (if (and cl-closure-vars
+ (cl--expr-contains-any body cl-closure-vars))
+ (let* ((new (mapcar 'cl-gensym cl-closure-vars))
+ (sub (cl-pairlis cl-closure-vars new)) (decls nil))
+ (while (or (stringp (car body))
+ (eq (car-safe (car body)) 'interactive))
+ (push (list 'quote (pop body)) decls))
+ (put (car (last cl-closure-vars)) 'used t)
+ `(list 'lambda '(&rest --cl-rest--)
+ ,@(cl-sublis sub (nreverse decls))
+ (list 'apply
+ (list 'quote
+ #'(lambda ,(append new (cadr f))
+ ,@(cl-sublis sub body)))
+ ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
+ cl-closure-vars)
+ '((quote --cl-rest--))))))
+ (let* ((newf `(lambda ,(cadr f) ,@body))
+ (res `(function ,newf)))
+ (setq cl--function-convert-cache (cons newf res))
+ res))))
+ (t
+ (let ((found (assq f macroexpand-all-environment)))
+ (if (and found (ignore-errors
+ (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+ (cadr (cl-caddr (cl-cadddr found)))
+ (let ((res `(function ,f)))
+ (setq cl--function-convert-cache (cons f res))
+ res))))))
+
+(defmacro lexical-let (bindings &rest body)
+ "Like `let', but lexically scoped.
+The main visible difference is that lambdas inside BODY will create
+lexical closures as in Common Lisp.
+\n(fn BINDINGS BODY)"
+ (declare (indent 1) (debug let))
+ (let* ((cl-closure-vars cl-closure-vars)
+ (vars (mapcar (function
+ (lambda (x)
+ (or (consp x) (setq x (list x)))
+ (push (make-symbol (format "--cl-%s--" (car x)))
+ cl-closure-vars)
+ (set (car cl-closure-vars) [bad-lexical-ref])
+ (list (car x) (cadr x) (car cl-closure-vars))))
+ bindings))
+ (ebody
+ (macroexpand-all
+ `(cl-symbol-macrolet
+ ,(mapcar (lambda (x)
+ `(,(car x) (symbol-value ,(cl-caddr x))))
+ vars)
+ ,@body)
+ (cons (cons 'function #'cl--function-convert)
+ macroexpand-all-environment))))
+ (if (not (get (car (last cl-closure-vars)) 'used))
+ ;; Turn (let ((foo (cl-gensym)))
+ ;; (set foo <val>) ...(symbol-value foo)...)
+ ;; into (let ((foo <val>)) ...(symbol-value 'foo)...).
+ ;; This is good because it's more efficient but it only works with
+ ;; dynamic scoping, since with lexical scoping we'd need
+ ;; (let ((foo <val>)) ...foo...).
+ `(progn
+ ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars)
+ (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars)
+ ,(cl-sublis (mapcar (lambda (x)
+ (cons (cl-caddr x)
+ `',(cl-caddr x)))
+ vars)
+ ebody)))
+ `(let ,(mapcar (lambda (x)
+ (list (cl-caddr x)
+ `(make-symbol ,(format "--%s--" (car x)))))
+ vars)
+ (setf ,@(apply #'append
+ (mapcar (lambda (x)
+ (list `(symbol-value ,(cl-caddr x)) (cadr x)))
+ vars)))
+ ,ebody))))
+
+(defmacro lexical-let* (bindings &rest body)
+ "Like `let*', but lexically scoped.
+The main visible difference is that lambdas inside BODY, and in
+successive bindings within BINDINGS, will create lexical closures
+as in Common Lisp. This is similar to the behavior of `let*' in
+Common Lisp.
+\n(fn BINDINGS BODY)"
+ (declare (indent 1) (debug let))
+ (if (null bindings) (cons 'progn body)
+ (setq bindings (reverse bindings))
+ (while bindings
+ (setq body (list `(lexical-let (,(pop bindings)) ,@body))))
+ (car body)))
+
+;; This should really have some way to shadow 'byte-compile properties, etc.
+(defmacro flet (bindings &rest body)
+ "Make temporary overriding function definitions.
+This is an analogue of a dynamically scoped `let' that operates on the function
+cell of FUNCs rather than their value cell.
+If you want the Common-Lisp style of `flet', you should use `cl-flet'.
+The FORMs are evaluated with the specified function definitions in place,
+then the definitions are undone (the FUNCs go back to their previous
+definitions, or lack thereof).
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+ (declare (indent 1) (debug cl-flet)
+ (obsolete "Use either `cl-flet' or `cl-letf'." "24.3"))
+ `(letf ,(mapcar
+ (lambda (x)
+ (if (or (and (fboundp (car x))
+ (eq (car-safe (symbol-function (car x))) 'macro))
+ (cdr (assq (car x) macroexpand-all-environment)))
+ (error "Use `labels', not `flet', to rebind macro names"))
+ (let ((func `(cl-function
+ (lambda ,(cadr x)
+ (cl-block ,(car x) ,@(cddr x))))))
+ (when (cl--compiling-file)
+ ;; Bug#411. It would be nice to fix this.
+ (and (get (car x) 'byte-compile)
+ (error "Byte-compiling a redefinition of `%s' \
+will not work - use `labels' instead" (symbol-name (car x))))
+ ;; FIXME This affects the rest of the file, when it
+ ;; should be restricted to the flet body.
+ (and (boundp 'byte-compile-function-environment)
+ (push (cons (car x) (eval func))
+ byte-compile-function-environment)))
+ (list `(symbol-function ',(car x)) func)))
+ bindings)
+ ,@body))
+
+(defmacro labels (bindings &rest body)
+ "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.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)))
+ ;; because these var's *names* get added to the macro-environment.
+ (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+ (push var vars)
+ (push `(cl-function (lambda . ,(cdr binding))) sets)
+ (push var sets)
+ (push (cons (car binding)
+ `(lambda (&rest cl-labels-args)
+ (cl-list* 'funcall ',var
+ cl-labels-args)))
+ newenv)))
+ (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv)))
+
+;; Generalized variables are provided by gv.el, but some details are
+;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we
+;; still need to support old users of cl.el.
+
+(defmacro cl--symbol-function (symbol)
+ "Like `symbol-function' but return `cl--unbound' if not bound."
+ ;; (declare (gv-setter (lambda (store)
+ ;; `(if (eq ,store 'cl--unbound)
+ ;; (fmakunbound ,symbol) (fset ,symbol ,store)))))
+ `(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound))
+(gv-define-setter cl--symbol-function (store symbol)
+ `(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store)))
+
+(defmacro letf (bindings &rest body)
+ "Dynamically scoped let-style bindings for places.
+Like `cl-letf', but with some extra backward compatibility."
+ ;; Like cl-letf, but with special handling of symbol-function.
+ `(cl-letf ,(mapcar (lambda (x) (if (eq (car-safe (car x)) 'symbol-function)
+ `((cl--symbol-function ,@(cdar x)) ,@(cdr x))
+ x))
+ bindings)
+ ,@body))
+
+(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.3.
+ (let ((vars (nth 0 cl-gv))
+ (vals (nth 1 cl-gv))
+ (binds ())
+ (substs ()))
+ ;; Use cl-sublis as was done in cl-setf-do-modify.
+ (while vars
+ (if (macroexp-copyable-p (car vals))
+ (push (cons (pop vars) (pop vals)) substs)
+ (push (list (pop vars) (pop vals)) binds)))
+ (macroexp-let*
+ binds
+ (funcall do (cl-sublis substs (nth 4 cl-gv))
+ ;; We'd like to do something like
+ ;; (lambda ,(nth 2 cl-gv) ,(nth 3 cl-gv)).
+ (lambda (exp)
+ (macroexp-let2 macroexp-copyable-p v exp
+ (cl-sublis (cons (cons (car (nth 2 cl-gv)) v)
+ substs)
+ (nth 3 cl-gv))))))))
+
+(defmacro define-setf-expander (name arglist &rest body)
+ "Define a `setf' method.
+This method shows how to handle `setf's to places of the form (NAME ARGS...).
+The argument forms ARGS are bound according to ARGLIST, as if NAME were
+going to be expanded as a macro, then the BODY forms are executed and must
+return a list of five elements: a temporary-variables list, a value-forms
+list, a store-variables list (of length one), a store-form, and an access-
+form. See `gv-define-expander', `gv-define-setter', and `gv-define-expander'
+for a better and simpler ways to define setf-methods."
+ (declare (debug
+ (&define name cl-lambda-list cl-declarations-or-string def-body)))
+ `(progn
+ ,@(if (stringp (car body))
+ (list `(put ',name 'setf-documentation ,(pop body))))
+ (gv-define-expander ,name
+ (cl-function
+ (lambda (do ,@arglist)
+ (cl--gv-adapt (progn ,@body) do))))))
+
+(defmacro defsetf (name arg1 &rest args)
+ "Define a `setf' method.
+This macro is an easy-to-use substitute for `define-setf-expander' that works
+well for simple place forms. In the simple `defsetf' form, `setf's of
+the form (setf (NAME ARGS...) VAL) are transformed to function or macro
+calls of the form (FUNC ARGS... VAL). Example:
+
+ (cl-defsetf aref aset)
+
+Alternate form: (cl-defsetf NAME ARGLIST (STORE) BODY...).
+Here, the above `setf' call is expanded by binding the argument forms ARGS
+according to ARGLIST, binding the value form VAL to STORE, then executing
+BODY, which must return a Lisp form that does the necessary `setf' operation.
+Actually, ARGLIST and STORE may be bound to temporary variables which are
+introduced automatically to preserve proper execution order of the arguments.
+Example:
+
+ (cl-defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v))
+
+\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
+ (declare (debug
+ (&define name
+ [&or [symbolp &optional stringp]
+ [cl-lambda-list (symbolp)]]
+ cl-declarations-or-string def-body)))
+ (if (and (listp arg1) (consp args))
+ ;; Like `gv-define-setter' but with `cl-function'.
+ `(gv-define-expander ,name
+ (lambda (do &rest args)
+ (gv--defsetter ',name
+ (cl-function
+ (lambda (,@(car args) ,@arg1) ,@(cdr args)))
+ do args)))
+ `(gv-define-simple-setter ,name ,arg1)))
+
+;; FIXME: CL used to provide a setf method for `apply', but I haven't been able
+;; to find a case where it worked. The code below tries to handle it as well.
+;; (defun cl--setf-apply (form last-witness last)
+;; (cond
+;; ((not (consp form)) form)
+;; ((eq (ignore-errors (car (last form))) last-witness)
+;; `(apply #',(car form) ,@(butlast (cdr form)) ,last))
+;; ((and (memq (car form) '(let let*))
+;; (rassoc (list last-witness) (cadr form)))
+;; (let ((rebind (rassoc (list last-witness) (cadr form))))
+;; `(,(car form) ,(remq rebind (cadr form))
+;; ,@(mapcar (lambda (form) (cl--setf-apply form (car rebind) last))
+;; (cddr form)))))
+;; (t (mapcar (lambda (form) (cl--setf-apply form last-witness last)) form))))
+;; (gv-define-setter apply (val fun &rest args)
+;; (pcase fun (`#',(and (pred symbolp) f) (setq fun f))
+;; (_ (error "First arg to apply in setf is not #'SYM: %S" fun)))
+;; (let* ((butlast (butlast args))
+;; (last (car (last args)))
+;; (last-witness (make-symbol "--cl-tailarg--"))
+;; (setter (macroexpand `(setf (,fun ,@butlast ,last-witness) ,val)
+;; macroexpand-all-environment)))
+;; (cl--setf-apply setter last-witness last)))
+
+
+;; FIXME: CL used to provide get-setf-method, which was used by some
+;; setf-expanders, but now that we use gv.el, it is a lot more difficult
+;; and in general impossible to provide get-setf-method. Hopefully, it
+;; won't be needed. If needed, we'll have to do something nasty along the
+;; lines of
+;; (defun get-setf-method (place &optional env)
+;; (let* ((witness (list 'cl-gsm))
+;; (expansion (gv-letplace (getter setter) place
+;; `(,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.3")
+
+(defmacro define-modify-macro (name arglist func &optional doc)
+ "Define a `setf'-like modify macro.
+If NAME is called, it combines its PLACE argument with the other arguments
+from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
+ (declare (debug
+ (&define name cl-lambda-list ;; should exclude &key
+ symbolp &optional stringp)))
+ (if (memq '&key arglist)
+ (error "&key not allowed in define-modify-macro"))
+ (let ((place (make-symbol "--cl-place--")))
+ `(cl-defmacro ,name (,place ,@arglist)
+ ,doc
+ (,(if (memq '&rest arglist) #'cl-list* #'list)
+ #'cl-callf ',func ,place
+ ,@(cl--arglist-args arglist)))))
+
+;;; Additional compatibility code.
+;; For names that were clean but really aren't needed any more.
+
+(define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.3")
+(define-obsolete-variable-alias 'cl-macro-environment
+ '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.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.3")
+(defvar cl-builtin-remhash (symbol-function 'remhash))
+(make-obsolete-variable 'cl-builtin-remhash nil "24.3")
+(defvar cl-builtin-clrhash (symbol-function 'clrhash))
+(make-obsolete-variable 'cl-builtin-clrhash nil "24.3")
+(defvar cl-builtin-maphash (symbol-function 'maphash))
+
+(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.3"))
(while (and list (not (equal item (car list)))) (setq list (cdr list)))
list)
-(defalias 'cl-member 'memq) ; for compatibility with old CL package
-
-;; Autoloaded, but we have not loaded cl-loaddefs yet.
-(declare-function floor* "cl-extra" (x &optional y))
-(declare-function ceiling* "cl-extra" (x &optional y))
-(declare-function truncate* "cl-extra" (x &optional y))
-(declare-function round* "cl-extra" (x &optional y))
-(declare-function mod* "cl-extra" (x y))
-
-(defalias 'cl-floor 'floor*)
-(defalias 'cl-ceiling 'ceiling*)
-(defalias 'cl-truncate 'truncate*)
-(defalias 'cl-round 'round*)
-(defalias 'cl-mod 'mod*)
-
-(defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs
- "Return ITEM consed onto the front of LIST only if it's not already there.
-Otherwise, return LIST unmodified.
-\nKeywords supported: :test :test-not :key
-\n(fn ITEM LIST [KEYWORD VALUE]...)"
- (cond ((or (equal cl-keys '(:test eq))
- (and (null cl-keys) (not (numberp cl-item))))
- (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
- ((or (equal cl-keys '(:test equal)) (null cl-keys))
- (if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
- (t (apply 'cl-adjoin cl-item cl-list cl-keys))))
-
-(defun subst (cl-new cl-old cl-tree &rest cl-keys)
- "Substitute NEW for OLD everywhere in TREE (non-destructively).
-Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
-\nKeywords supported: :test :test-not :key
-\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
- (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
- (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
- (cl-do-subst cl-new cl-old cl-tree)))
-
-(defun cl-do-subst (cl-new cl-old cl-tree)
- (cond ((eq cl-tree cl-old) cl-new)
- ((consp cl-tree)
- (let ((a (cl-do-subst cl-new cl-old (car cl-tree)))
- (d (cl-do-subst cl-new cl-old (cdr cl-tree))))
- (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
- cl-tree (cons a d))))
- (t cl-tree)))
-
-(defun acons (key value alist)
- "Add KEY and VALUE to ALIST.
-Return a new list with (cons KEY VALUE) as car and ALIST as cdr."
- (cons (cons key value) alist))
-
-(defun pairlis (keys values &optional alist)
- "Make an alist from KEYS and VALUES.
-Return a new alist composed by associating KEYS to corresponding VALUES;
-the process stops as soon as KEYS or VALUES run out.
-If ALIST is non-nil, the new pairs are prepended to it."
- (nconc (mapcar* 'cons keys values) alist))
-
-
-;;; Miscellaneous.
-
-;; Define data for indentation and edebug.
-(dolist (entry
- '(((defun* defmacro*) 2)
- ((function*) nil
- (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form)))
- ((eval-when) 1 (sexp &rest form))
- ((declare) nil (&rest sexp))
- ((the) 1 (sexp &rest form))
- ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form)))
- ((block return-from) 1 (sexp &rest form))
- ((return) nil (&optional form))
- ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form))
- (form &rest form)
- &rest form))
- ((do-symbols) 1 ((symbolp form &optional form form) &rest form))
- ((do-all-symbols) 1 ((symbolp form &optional form) &rest form))
- ((psetq setf psetf) nil edebug-setq-form)
- ((progv) 2 (&rest form))
- ((flet labels macrolet) 1
- ((&rest (sexp sexp &rest form)) &rest form))
- ((symbol-macrolet lexical-let lexical-let*) 1
- ((&rest &or symbolp (symbolp form)) &rest form))
- ((multiple-value-bind) 2 ((&rest symbolp) &rest form))
- ((multiple-value-setq) 1 ((&rest symbolp) &rest form))
- ((incf decf remf pushnew shiftf rotatef) nil (&rest form))
- ((letf letf*) 1 ((&rest (&rest form)) &rest form))
- ((callf destructuring-bind) 2 (sexp form &rest form))
- ((callf2) 3 (sexp form form &rest form))
- ((loop) nil (&rest &or symbolp form))
- ((ignore-errors) 0 (&rest form))))
- (dolist (func (car entry))
- (put func 'lisp-indent-function (nth 1 entry))
- (put func 'lisp-indent-hook (nth 1 entry))
- (or (get func 'edebug-form-spec)
- (put func 'edebug-form-spec (nth 2 entry)))))
-
-;; Autoload the other portions of the package.
-;; We want to replace the basic versions of dolist, dotimes, declare below.
-(fmakunbound 'dolist)
-(fmakunbound 'dotimes)
-(fmakunbound 'declare)
-(load "cl-loaddefs" nil 'quiet)
-
-;; This goes here so that cl-macs can find it if it loads right now.
-(provide 'cl)
-
-;; Things to do after byte-compiler is loaded.
-
-(defvar cl-hacked-flag nil)
-(defun cl-hack-byte-compiler ()
- (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)
- (progn
- (setq cl-hacked-flag t) ; Do it first, to prevent recursion.
- (load "cl-macs" nil t)
- (run-hooks 'cl-hack-bytecomp-hook))))
-
-;; Try it now in case the compiler has already been loaded.
-(cl-hack-byte-compiler)
-
-;; Also make a hook in case compiler is loaded after this file.
-(add-hook 'bytecomp-load-hook 'cl-hack-byte-compiler)
-
-
-;; The following ensures that packages which expect the old-style cl.el
-;; will be happy with this one.
+;; Used in the expansion of the old `defstruct'.
+(defun cl-struct-setf-expander (x name accessor pred-form pos)
+ (declare (obsolete nil "24.3"))
+ (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--")))
+ (list (list temp) (list x) (list store)
+ `(progn
+ ,@(and pred-form
+ (list `(or ,(cl-subst temp 'cl-x pred-form)
+ (error ,(format
+ "%s storing a non-%s"
+ accessor name)))))
+ ,(if (eq (car (get name 'cl-struct-type)) 'vector)
+ `(aset ,temp ,pos ,store)
+ `(setcar
+ ,(if (<= pos 5)
+ (let ((xx temp))
+ (while (>= (setq pos (1- pos)) 0)
+ (setq xx `(cdr ,xx)))
+ xx)
+ `(nthcdr ,pos ,temp))
+ ,store)))
+ (list accessor temp))))
(provide 'cl)
-
-(run-hooks 'cl-load-hook)
-
-;; Local variables:
-;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
;;; cl.el ends here
;; This is a defvar rather than a defconst, because the year can
;; change during the Emacs session.
-(defvar copyright-current-year (substring (current-time-string) -4)
+(defvar copyright-current-year (format-time-string "%Y")
"String representing the current year.")
(defsubst copyright-limit () ; re-search-forward BOUND
;; This uses the match-data from copyright-find-copyright/end.
(goto-char (match-end 1))
(copyright-find-end)
- ;; Note that `current-time-string' isn't locale-sensitive.
- (setq copyright-current-year (substring (current-time-string) -4))
+ (setq copyright-current-year (format-time-string "%Y"))
(unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3))
(substring copyright-current-year -2))
(if (or noquery
"Insert a copyright by $ORGANIZATION notice at cursor."
"Company: "
comment-start
- "Copyright (C) " `(substring (current-time-string) -4) " by "
+ "Copyright (C) " `(format-time-string "%Y") " by "
(or (getenv "ORGANIZATION")
str)
'(if (copyright-offset-too-large-p)
:group 'debugger
:version "21.1")
+(defcustom debugger-bury-or-kill 'bury
+ "How to proceed with the debugger buffer when exiting `debug'.
+The value used here affects the behavior of operations on any
+window previously showing the debugger buffer.
+
+`nil' means that if its window is not deleted when exiting the
+ debugger, invoking `switch-to-prev-buffer' will usually show
+ the debugger buffer again.
+
+`append' means that if the window is not deleted, the debugger
+ buffer moves to the end of the window's previous buffers so
+ it's less likely that a future invocation of
+ `switch-to-prev-buffer' will switch to it. Also, it moves the
+ buffer to the end of the frame's buffer list.
+
+`bury' means that if the window is not deleted, its buffer is
+ removed from the window's list of previous buffers. Also, it
+ moves the buffer to the end of the frame's buffer list. This
+ value provides the most reliable remedy to not have
+ `switch-to-prev-buffer' switch to the debugger buffer again
+ without killing the buffer.
+
+`kill' means to kill the debugger buffer.
+
+The value used here is passed to `quit-restore-window'."
+ :type '(choice
+ (const :tag "Keep alive" nil)
+ (const :tag "Append" append)
+ (const :tag "Bury" bury)
+ (const :tag "Kill" kill))
+ :group 'debugger
+ :version "24.2")
+
(defvar debug-function-list nil
"List of functions currently set for debug on entry.")
(defvar debugger-old-buffer nil
"This is the buffer that was current when the debugger was entered.")
+(defvar debugger-previous-window nil
+ "This is the window last showing the debugger buffer.")
+
+(defvar debugger-previous-window-height nil
+ "The last recorded height of `debugger-previous-window'.")
+
(defvar debugger-previous-backtrace nil
"The contents of the previous backtrace (including text properties).
This is to optimize `debugger-make-xrefs'.")
(defvar debugger-outer-track-mouse)
(defvar debugger-outer-last-command)
(defvar debugger-outer-this-command)
-;; unread-command-char is obsolete,
-;; but we still save and restore it
-;; in case some user program still tries to set it.
-(defvar debugger-outer-unread-command-char)
(defvar debugger-outer-unread-command-events)
(defvar debugger-outer-unread-post-input-method-events)
(defvar debugger-outer-last-input-event)
(unless noninteractive
(message "Entering debugger..."))
(let (debugger-value
- (debug-on-error nil)
- (debug-on-quit nil)
(debugger-previous-state
(if (get-buffer "*Backtrace*")
(with-current-buffer (get-buffer "*Backtrace*")
(list major-mode (buffer-string)))))
(debugger-buffer (get-buffer-create "*Backtrace*"))
(debugger-old-buffer (current-buffer))
+ (debugger-window nil)
(debugger-step-after-exit nil)
(debugger-will-be-back nil)
;; Don't keep reading from an executing kbd macro!
(debugger-outer-track-mouse track-mouse)
(debugger-outer-last-command last-command)
(debugger-outer-this-command this-command)
- (debugger-outer-unread-command-char
- (with-no-warnings unread-command-char))
(debugger-outer-unread-command-events unread-command-events)
(debugger-outer-unread-post-input-method-events
unread-post-input-method-events)
(cursor-in-echo-area nil))
(unwind-protect
(save-excursion
- (save-window-excursion
- (with-no-warnings
- (setq unread-command-char -1))
- (when (eq (car debugger-args) 'debug)
- ;; Skip the frames for backtrace-debug, byte-code,
- ;; and implement-debug-on-entry.
- (backtrace-debug 4 t)
- ;; Place an extra debug-on-exit for macro's.
- (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
- (backtrace-debug 5 t)))
- (pop-to-buffer debugger-buffer)
- (debugger-mode)
- (debugger-setup-buffer debugger-args)
- (when noninteractive
- ;; If the backtrace is long, save the beginning
- ;; and the end, but discard the middle.
- (when (> (count-lines (point-min) (point-max))
- debugger-batch-max-lines)
- (goto-char (point-min))
- (forward-line (/ 2 debugger-batch-max-lines))
- (let ((middlestart (point)))
- (goto-char (point-max))
- (forward-line (- (/ 2 debugger-batch-max-lines)
- debugger-batch-max-lines))
- (delete-region middlestart (point)))
- (insert "...\n"))
+ (when (eq (car debugger-args) 'debug)
+ ;; Skip the frames for backtrace-debug, byte-code,
+ ;; and implement-debug-on-entry.
+ (backtrace-debug 4 t)
+ ;; Place an extra debug-on-exit for macro's.
+ (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
+ (backtrace-debug 5 t)))
+ (pop-to-buffer
+ debugger-buffer
+ `((display-buffer-reuse-window
+ display-buffer-in-previous-window)
+ . (,(when debugger-previous-window
+ `(previous-window . ,debugger-previous-window)))))
+ (setq debugger-window (selected-window))
+ (if (eq debugger-previous-window debugger-window)
+ (when debugger-jumping-flag
+ ;; Try to restore previous height of debugger
+ ;; window.
+ (condition-case nil
+ (window-resize
+ debugger-window
+ (- debugger-previous-window-height
+ (window-total-size debugger-window)))
+ (error nil)))
+ (setq debugger-previous-window debugger-window))
+ (debugger-mode)
+ (debugger-setup-buffer debugger-args)
+ (when noninteractive
+ ;; If the backtrace is long, save the beginning
+ ;; and the end, but discard the middle.
+ (when (> (count-lines (point-min) (point-max))
+ debugger-batch-max-lines)
(goto-char (point-min))
- (message "%s" (buffer-string))
- (kill-emacs -1))
+ (forward-line (/ 2 debugger-batch-max-lines))
+ (let ((middlestart (point)))
+ (goto-char (point-max))
+ (forward-line (- (/ 2 debugger-batch-max-lines)
+ debugger-batch-max-lines))
+ (delete-region middlestart (point)))
+ (insert "...\n"))
+ (goto-char (point-min))
+ (message "%s" (buffer-string))
+ (kill-emacs -1))
+ (message "")
+ (let ((standard-output nil)
+ (buffer-read-only t))
(message "")
- (let ((standard-output nil)
- (buffer-read-only t))
- (message "")
- ;; Make sure we unbind buffer-read-only in the right buffer.
- (save-excursion
- (recursive-edit)))))
- ;; Kill or at least neuter the backtrace buffer, so that users
- ;; don't try to execute debugger commands in an invalid context.
- (if (get-buffer-window debugger-buffer 0)
- ;; Still visible despite the save-window-excursion? Maybe it
- ;; it's in a pop-up frame. It would be annoying to delete and
- ;; recreate it every time the debugger stops, so instead we'll
- ;; erase it (and maybe hide it) but keep it alive.
- (with-current-buffer debugger-buffer
- (with-selected-window (get-buffer-window debugger-buffer 0)
- (when (and (window-dedicated-p (selected-window))
- (not debugger-will-be-back))
- ;; If the window is not dedicated, burying the buffer
- ;; will mean that the frame created for it is left
- ;; around showing some random buffer, and next time we
- ;; pop to the debugger buffer we'll create yet
- ;; another frame.
- ;; If debugger-will-be-back is non-nil, the frame
- ;; would need to be de-iconified anyway immediately
- ;; after when we re-enter the debugger, so iconifying it
- ;; here would cause flashing.
- ;; Drew Adams is not happy with this: he wants to frame
- ;; to be left at the top-level, still working on how
- ;; best to do that.
- (bury-buffer))))
- (unless debugger-previous-state
- (kill-buffer debugger-buffer)))
- ;; Restore the previous state of the debugger-buffer, in case we were
- ;; in a recursive invocation of the debugger.
- (when (buffer-live-p debugger-buffer)
- (with-current-buffer debugger-buffer
- (let ((inhibit-read-only t))
- (erase-buffer)
- (if (null debugger-previous-state)
- (fundamental-mode)
- (insert (nth 1 debugger-previous-state))
- (funcall (nth 0 debugger-previous-state))))))
+ ;; Make sure we unbind buffer-read-only in the right buffer.
+ (save-excursion
+ (recursive-edit))))
+ (when (and (not debugger-will-be-back)
+ (window-live-p debugger-window)
+ (eq (window-buffer debugger-window) debugger-buffer))
+ ;; Record height of debugger window.
+ (setq debugger-previous-window-height
+ (window-total-size debugger-window))
+ ;; Unshow debugger-buffer.
+ (quit-restore-window debugger-window debugger-bury-or-kill))
+ ;; Restore previous state of debugger-buffer in case we were
+ ;; in a recursive invocation of the debugger, otherwise just
+ ;; erase the buffer and put it into fundamental mode.
+ (when (buffer-live-p debugger-buffer)
+ (with-current-buffer debugger-buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (if (null debugger-previous-state)
+ (fundamental-mode)
+ (insert (nth 1 debugger-previous-state))
+ (funcall (nth 0 debugger-previous-state))))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
;; Put into effect the modified values of these variables
(setq track-mouse debugger-outer-track-mouse)
(setq last-command debugger-outer-last-command)
(setq this-command debugger-outer-this-command)
- (with-no-warnings
- (setq unread-command-char debugger-outer-unread-command-char))
(setq unread-command-events debugger-outer-unread-command-events)
(setq unread-post-input-method-events
debugger-outer-unread-post-input-method-events)
(cursor-in-echo-area debugger-outer-cursor-in-echo-area))
(set-match-data debugger-outer-match-data)
(prog1
- (let ((save-ucc (with-no-warnings unread-command-char)))
- (unwind-protect
- (progn
- (with-no-warnings
- (setq unread-command-char debugger-outer-unread-command-char))
- (prog1 (progn ,@body)
- (with-no-warnings
- (setq debugger-outer-unread-command-char unread-command-char))))
- (with-no-warnings
- (setq unread-command-char save-ucc))))
+ (progn ,@body)
(setq debugger-outer-match-data (match-data))
(setq debugger-outer-load-read-function load-read-function)
(setq debugger-outer-overriding-terminal-local-map
,(interactive-form (symbol-function function))
(apply ',(symbol-function function)
debug-on-entry-args)))
- (when (eq (car-safe (symbol-function function)) 'autoload)
+ (when (autoloadp (symbol-function function))
;; The function is autoloaded. Load its real definition.
- (load (cadr (symbol-function function)) nil noninteractive nil t))
+ (autoload-do-load (symbol-function function) function))
(when (or (not (consp (symbol-function function)))
(and (eq (car (symbol-function function)) 'macro)
(not (consp (cdr (symbol-function function))))))
\f
;;; Code:
-(eval-when-compile (require 'cl))
-
;;; PRIVATE: defsubst must be defined before they are first used
(defsubst derived-mode-hook-name (mode)
;; Process the keyword args.
(while (keywordp (car body))
- (case (pop body)
- (:group (setq group (pop body)))
- (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
- (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
- (t (pop body))))
+ (pcase (pop body)
+ (`:group (setq group (pop body)))
+ (`:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
+ (`:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
+ (_ (pop body))))
(setq docstring (derived-mode-make-docstring
parent child docstring syntax abbrev))
Use the `derived-mode-parent' property of the symbol to trace backwards.
Since major-modes might all derive from `fundamental-mode', this function
is not very useful."
+ (declare (obsolete derived-mode-p "22.1"))
(while (get mode 'derived-mode-parent)
(setq mode (get mode 'derived-mode-parent)))
mode)
-(make-obsolete 'derived-mode-class 'derived-mode-p "22.1")
\f
;;; PRIVATE
;;; Code:
+(require 'macroexp)
+
;;; The variable byte-code-vector is defined by the new bytecomp.el.
;;; The function byte-decompile-lapcode is defined in byte-opt.el.
;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
obj (symbol-function obj)))
(if (subrp obj)
(error "Can't disassemble #<subr %s>" name))
- (when (and (listp obj) (eq (car obj) 'autoload))
- (load (nth 1 obj))
- (setq obj (symbol-function name)))
- (if (eq (car-safe obj) 'macro) ;handle macros
+ (setq obj (autoload-do-load obj name))
+ (if (eq (car-safe obj) 'macro) ;Handle macros.
(setq macro t
obj (cdr obj)))
- (when (and (listp obj) (eq (car obj) 'closure))
- (error "Don't know how to compile an interpreted closure"))
(if (and (listp obj) (eq (car obj) 'byte-code))
(setq obj (list 'lambda nil obj)))
(if (and (listp obj) (not (eq (car obj) 'lambda)))
(t
(insert "Uncompiled body: ")
(let ((print-escape-newlines t))
- (prin1 (if (cdr obj) (cons 'progn obj) (car obj))
+ (prin1 (macroexp-progn obj)
(current-buffer))))))
(if interactive-p
(message "")))
;;; Code:
-(eval-when-compile (require 'cl))
-
(defun easy-mmode-pretty-mode-name (mode &optional lighter)
"Turn the symbol MODE into a string intended for the user.
If provided, LIGHTER will be used to help choose capitalization by,
;; "foo-bar-minor" -> "Foo-Bar-Minor"
(capitalize (replace-regexp-in-string
;; "foo-bar-minor-mode" -> "foo-bar-minor"
- "-mode\\'" "" (symbol-name mode))))
+ "toggle-\\|-mode\\'" ""
+ (symbol-name mode))))
" mode")))
(if (not (stringp lighter)) name
;; Strip leading and trailing whitespace from LIGHTER.
DOC is the documentation for the mode toggle command.
The defined mode command takes one optional (prefix) argument.
-Interactively with no prefix argument it toggles the mode.
-With a prefix argument, it enables the mode if the argument is
-positive and otherwise disables it. When called from Lisp, it
-enables the mode if the argument is omitted or nil, and toggles
-the mode if the argument is `toggle'. If DOC is nil this
-function adds a basic doc-string stating these facts.
+Interactively with no prefix argument, it toggles the mode.
+A prefix argument enables the mode if the argument is positive,
+and disables it otherwise.
+
+When called from Lisp, the mode command toggles the mode if the
+argument is `toggle', disables the mode if the argument is a
+non-positive integer, and enables the mode otherwise (including
+if the argument is omitted or nil or a positive integer).
+
+If DOC is nil, give the mode command a basic doc-string
+documenting what its argument does.
Optional INIT-VALUE is the initial value of the mode's variable.
-Optional LIGHTER is displayed in the modeline when the mode is on.
+Optional LIGHTER is displayed in the mode line when the mode is on.
Optional KEYMAP is the default keymap bound to the mode keymap.
If non-nil, it should be a variable name (whose value is a keymap),
or an expression that returns either a keymap or a list of
(define-minor-mode foo-mode \"If enabled, foo on you!\"
:lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
...BODY CODE...)"
- (declare (debug (&define name stringp
+ (declare (doc-string 2)
+ (debug (&define name stringp
[&optional [¬ keywordp] sexp
&optional [¬ keywordp] sexp
&optional [¬ keywordp] sexp]
;; Allow skipping the first three args.
(cond
((keywordp init-value)
- (setq body (list* init-value lighter keymap body)
+ (setq body `(,init-value ,lighter ,keymap ,@body)
init-value nil lighter nil keymap nil))
((keywordp lighter)
- (setq body (list* lighter keymap body) lighter nil keymap nil))
+ (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
((keywordp keymap) (push keymap body) (setq keymap nil)))
(let* ((last-message (make-symbol "last-message"))
;; Check keys.
(while (keywordp (setq keyw (car body)))
(setq body (cdr body))
- (case keyw
- (:init-value (setq init-value (pop body)))
- (:lighter (setq lighter (purecopy (pop body))))
- (:global (setq globalp (pop body)))
- (:extra-args (setq extra-args (pop body)))
- (:set (setq set (list :set (pop body))))
- (:initialize (setq initialize (list :initialize (pop body))))
- (:group (setq group (nconc group (list :group (pop body)))))
- (:type (setq type (list :type (pop body))))
- (:require (setq require (pop body)))
- (:keymap (setq keymap (pop body)))
- (:variable (setq variable (pop body))
+ (pcase keyw
+ (`:init-value (setq init-value (pop body)))
+ (`:lighter (setq lighter (purecopy (pop body))))
+ (`:global (setq globalp (pop body)))
+ (`:extra-args (setq extra-args (pop body)))
+ (`:set (setq set (list :set (pop body))))
+ (`:initialize (setq initialize (list :initialize (pop body))))
+ (`:group (setq group (nconc group (list :group (pop body)))))
+ (`:type (setq type (list :type (pop body))))
+ (`:require (setq require (pop body)))
+ (`:keymap (setq keymap (pop body)))
+ (`:variable (setq variable (pop body))
(if (not (and (setq tmp (cdr-safe variable))
(or (symbolp tmp)
(functionp tmp))))
(setq mode variable)
(setq mode (car variable))
(setq setter (cdr variable))))
- (:after-hook (setq after-hook (pop body)))
- (t (push keyw extra-keywords) (push (pop body) extra-keywords))))
+ (`:after-hook (setq after-hook (pop body)))
+ (_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
(setq keymap-sym (if (and keymap (symbolp keymap)) keymap
(intern (concat mode-name "-map"))))
(variable nil)
((not globalp)
`(progn
+ :autoload-end
(defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
Use the command `%s' to change this variable." pretty-name mode))
(make-variable-buffer-local ',mode)))
correctly with the current major mode. This is important to
prevent problems with derived modes, that is, major modes that
call another major mode in their body."
-
+ (declare (doc-string 2))
(let* ((global-mode-name (symbol-name global-mode))
(pretty-name (easy-mmode-pretty-mode-name mode))
(pretty-global-name (easy-mmode-pretty-mode-name global-mode))
;; Check keys.
(while (keywordp (setq keyw (car keys)))
(setq keys (cdr keys))
- (case keyw
- (:group (setq group (nconc group (list :group (pop keys)))))
- (:global (setq keys (cdr keys)))
- (t (push keyw extra-keywords) (push (pop keys) extra-keywords))))
+ (pcase keyw
+ (`:group (setq group (nconc group (list :group (pop keys)))))
+ (`:global (setq keys (cdr keys)))
+ (_ (push keyw extra-keywords) (push (pop keys) extra-keywords))))
(unless group
;; We might as well provide a best-guess default group.
"-mode\\'" "" (symbol-name mode))))))
`(progn
- (defvar ,MODE-major-mode nil)
- (make-variable-buffer-local ',MODE-major-mode)
+ (progn
+ :autoload-end
+ (defvar ,MODE-major-mode nil)
+ (make-variable-buffer-local ',MODE-major-mode))
;; The actual global minor-mode
(define-minor-mode ,global-mode
;; Very short lines to avoid too long lines in the generated
(while args
(let ((key (pop args))
(val (pop args)))
- (case key
- (:name (setq name val))
- (:dense (setq dense val))
- (:inherit (setq inherit val))
- (:suppress (setq suppress val))
- (:group)
- (t (message "Unknown argument %s in defmap" key)))))
+ (pcase key
+ (`:name (setq name val))
+ (`:dense (setq dense val))
+ (`:inherit (setq inherit val))
+ (`:suppress (setq suppress val))
+ (`:group)
+ (_ (message "Unknown argument %s in defmap" key)))))
(unless (keymapp m)
(setq bs (append m bs))
(setq m (if dense (make-keymap name) (make-sparse-keymap name))))
(when was-narrowed (,narrowfun)))))))
(unless name (setq name base-name))
`(progn
- (add-to-list 'debug-ignored-errors
- ,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
(defun ,next-sym (&optional count)
,(format "Go to the next COUNT'th %s." name)
(interactive "p")
`(if (not (re-search-forward ,re nil t count))
(if (looking-at ,re)
(goto-char (or ,(if endfun `(,endfun)) (point-max)))
- (error "No next %s" ,name))
+ (user-error "No next %s" ,name))
(goto-char (match-beginning 0))
(when (and (eq (current-buffer) (window-buffer (selected-window)))
(called-interactively-p 'interactive))
(if (< count 0) (,next-sym (- count))
,(funcall when-narrowed
`(unless (re-search-backward ,re nil t count)
- (error "No previous %s" ,name)))
+ (user-error "No previous %s" ,name)))
,@body))
(put ',prev-sym 'definition-name ',base))))
;;; Code:
-(eval-when-compile (require 'cl))
-
(defvar easy-menu-precalculate-equivalent-keybindings nil
"Determine when equivalent key bindings are computed for easy-menu menus.
It can take some time to calculate the equivalent key bindings that are shown
as a solid horizontal line.
A menu item can be a list with the same format as MENU. This is a submenu."
- (declare (indent defun))
+ (declare (indent defun) (debug (symbolp body)))
`(progn
,(if symbol `(defvar ,symbol nil ,doc))
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
(keywordp (setq keyword (car menu-items))))
(setq arg (cadr menu-items))
(setq menu-items (cddr menu-items))
- (case keyword
- (:filter
+ (pcase keyword
+ (`:filter
(setq filter `(lambda (menu)
(easy-menu-filter-return (,arg menu) ,menu-name))))
- ((:enable :active) (setq enable (or arg ''nil)))
- (:label (setq label arg))
- (:help (setq help arg))
- ((:included :visible) (setq visible (or arg ''nil)))))
+ ((or `:enable `:active) (setq enable (or arg ''nil)))
+ (`:label (setq label arg))
+ (`:help (setq help arg))
+ ((or `:included `:visible) (setq visible (or arg ''nil)))))
(if (equal visible ''nil)
nil ; Invisible menu entry, return nil.
(if (and visible (not (easy-menu-always-true-p visible)))
(setq keyword (aref item count))
(setq arg (aref item (1+ count)))
(setq count (+ 2 count))
- (case keyword
- ((:included :visible) (setq visible (or arg ''nil)))
- (:key-sequence (setq cache arg cache-specified t))
- (:keys (setq keys arg no-name nil))
- (:label (setq label arg))
- ((:active :enable) (setq active (or arg ''nil)))
- (:help (setq prop (cons :help (cons arg prop))))
- (:suffix (setq suffix arg))
- (:style (setq style arg))
- (:selected (setq selected (or arg ''nil)))))
+ (pcase keyword
+ ((or `:included `:visible) (setq visible (or arg ''nil)))
+ (`:key-sequence (setq cache arg cache-specified t))
+ (`:keys (setq keys arg no-name nil))
+ (`:label (setq label arg))
+ ((or `:active `:enable) (setq active (or arg ''nil)))
+ (`:help (setq prop (cons :help (cons arg prop))))
+ (`:suffix (setq suffix arg))
+ (`:style (setq style arg))
+ (`:selected (setq selected (or arg ''nil)))))
(if suffix
(setq label
(if (stringp suffix)
-;;; edebug.el --- a source-level debugger for Emacs Lisp
+;;; edebug.el --- a source-level debugger for Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 1988-1995, 1997, 1999-2012 Free Software Foundation, Inc.
;;; Code:
-;;; Bug reporting
-
-(defalias 'edebug-submit-bug-report 'report-emacs-bug)
+(require 'macroexp)
+(eval-when-compile (require 'cl-lib))
;;; Options
;;; Form spec utilities.
-(defmacro def-edebug-form-spec (symbol spec-form)
- "For compatibility with old version."
- (def-edebug-spec symbol (eval spec-form)))
-(make-obsolete 'def-edebug-form-spec 'def-edebug-spec "22.1")
-
(defun get-edebug-spec (symbol)
;; Get the spec of symbol resolving all indirection.
- (let ((edebug-form-spec (get symbol 'edebug-form-spec))
- indirect)
- (while (and (symbolp edebug-form-spec)
- (setq indirect (get edebug-form-spec 'edebug-form-spec)))
+ (let ((spec nil)
+ (indirect symbol))
+ (while
+ (progn
+ (and (symbolp indirect)
+ (setq indirect
+ (function-get indirect 'edebug-form-spec 'macro))))
;; (edebug-trace "indirection: %s" edebug-form-spec)
- (setq edebug-form-spec indirect))
- edebug-form-spec
- ))
+ (setq spec indirect))
+ spec))
;;;###autoload
(defun edebug-basic-spec (spec)
(setq spec (cdr spec)))
t))
((symbolp spec)
- (unless (functionp spec) (get spec 'edebug-form-spec)))))
+ (unless (functionp spec) (function-get spec 'edebug-form-spec)))))
;;; Utilities
(lambda (e1 e2)
(funcall function (car e1) (car e2))))))
-;;(def-edebug-spec edebug-save-restriction t)
-
-;; Not used. If it is used, def-edebug-spec must be defined before use.
+;; Not used.
'(defmacro edebug-save-restriction (&rest body)
"Evaluate BODY while saving the current buffers restriction.
BODY may change buffer outside of current restriction, unlike
and the restriction will be restored to the original buffer,
and the current buffer remains current.
Return the result of the last expression in BODY."
+ (declare (debug t))
`(let ((edebug:s-r-beg (point-min-marker))
(edebug:s-r-end (point-max-marker)))
(unwind-protect
;; Select WINDOW if it is provided and still exists. Otherwise,
;; if buffer is currently shown in several windows, choose one.
;; Otherwise, find a new window, possibly splitting one.
+ ;; FIXME: We should probably just be using `pop-to-buffer'.
(setq window
(cond
((and (edebug-window-live-p window)
((eq (window-buffer (selected-window)) buffer)
;; Selected window already displays BUFFER.
(selected-window))
- ((edebug-get-buffer-window buffer))
+ ((get-buffer-window buffer 0))
((one-window-p 'nomini)
;; When there's one window only, split it.
(split-window))
window-info)
(set-window-configuration window-info)))
-(defalias 'edebug-get-buffer-window 'get-buffer-window)
-(defalias 'edebug-sit-for 'sit-for)
-(defalias 'edebug-input-pending-p 'input-pending-p)
-
-
;;; Redefine read and eval functions
;; read is redefined to maybe instrument forms.
;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
;; Save the original read function
-(or (fboundp 'edebug-original-read)
- (defalias 'edebug-original-read (symbol-function 'read)))
+(defalias 'edebug-original-read
+ (symbol-function (if (fboundp 'edebug-original-read)
+ 'edebug-original-read 'read)))
(defun edebug-read (&optional stream)
"Read one Lisp expression as text from STREAM, return as Lisp object.
(setq face-new-frame-defaults
(assq-delete-all (nth 1 form) face-new-frame-defaults))
(put (nth 1 form) 'face-defface-spec nil)
+ (put (nth 1 form) 'face-documentation (nth 3 form))
;; See comments in `eval-defun-1' for purpose of code below
(setq form (prog1 `(prog1 ,form
(put ',(nth 1 form) 'saved-face
;; The internal data that is needed for edebugging is kept in the
;; buffer-local variable `edebug-form-data'.
-(make-variable-buffer-local 'edebug-form-data)
-
-(defvar edebug-form-data nil)
-;; A list of entries associating symbols with buffer regions.
-;; This is an automatic buffer local variable. Each entry looks like:
-;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}). The markers
-;; are at the beginning and end of an entry level form and @var{symbol} is
-;; a symbol that holds all edebug related information for the form on its
-;; property list.
-
-;; In the future, the symbol will be irrelevant and edebug data will
-;; be stored in the definitions themselves rather than in the property
-;; list of a symbol.
-
-(defun edebug-make-form-data-entry (symbol begin end)
- (list symbol begin end))
-
-(defsubst edebug-form-data-name (entry)
- (car entry))
-
-(defsubst edebug-form-data-begin (entry)
- (nth 1 entry))
-
-(defsubst edebug-form-data-end (entry)
- (nth 2 entry))
+(defvar-local edebug-form-data nil
+ "A list of entries associating symbols with buffer regions.
+Each entry is an `edebug--form-data' struct with fields:
+SYMBOL, BEGIN-MARKER, and END-MARKER. The markers
+are at the beginning and end of an entry level form and SYMBOL is
+a symbol that holds all edebug related information for the form on its
+property list.
+
+In the future (haha!), the symbol will be irrelevant and edebug data will
+be stored in the definitions themselves rather than in the property
+list of a symbol.")
+
+(cl-defstruct (edebug--form-data
+ ;; Some callers expect accessors to return nil when passed nil.
+ (:type list)
+ (:constructor edebug--make-form-data-entry (name begin end))
+ (:predicate nil) (:constructor nil) (:copier nil))
+ name begin end)
(defsubst edebug-set-form-data-entry (entry name begin end)
- (setcar entry name);; in case name is changed
- (set-marker (nth 1 entry) begin)
- (set-marker (nth 2 entry) end))
+ (setf (edebug--form-data-name entry) name) ;; In case name is changed.
+ (set-marker (edebug--form-data-begin entry) begin)
+ (set-marker (edebug--form-data-end entry) end))
(defun edebug-get-form-data-entry (pnt &optional end-point)
;; Find the edebug form data entry which is closest to PNT.
;; Return `nil' if none found.
(let ((rest edebug-form-data)
closest-entry
- (closest-dist 999999)) ;; need maxint here
+ (closest-dist 999999)) ;; Need maxint here.
(while (and rest (< 0 closest-dist))
(let* ((entry (car rest))
- (begin (edebug-form-data-begin entry))
+ (begin (edebug--form-data-begin entry))
(dist (- pnt begin)))
(setq rest (cdr rest))
(if (and (<= 0 dist)
(< dist closest-dist)
(or (not end-point)
- (= end-point (edebug-form-data-end entry)))
- (<= pnt (edebug-form-data-end entry)))
+ (= end-point (edebug--form-data-end entry)))
+ (<= pnt (edebug--form-data-end entry)))
(setq closest-dist dist
closest-entry entry))))
closest-entry))
;; and find an entry given a symbol, which should be just assq.
(defun edebug-form-data-symbol ()
-;; Return the edebug data symbol of the form where point is in.
-;; If point is not inside a edebuggable form, cause error.
- (or (edebug-form-data-name (edebug-get-form-data-entry (point)))
+ "Return the edebug data symbol of the form where point is in.
+If point is not inside a edebuggable form, cause error."
+ (or (edebug--form-data-name (edebug-get-form-data-entry (point)))
(error "Not inside instrumented form")))
(defun edebug-make-top-form-data-entry (new-entry)
;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
(edebug-clear-form-data-entry new-entry)
- (setq edebug-form-data (cons new-entry edebug-form-data)))
+ (push new-entry edebug-form-data))
(defun edebug-clear-form-data-entry (entry)
-;; If non-nil, clear ENTRY out of the form data.
-;; Maybe clear the markers and delete the symbol's edebug property?
+ "If non-nil, clear ENTRY out of the form data.
+Maybe clear the markers and delete the symbol's edebug property?"
(if entry
(progn
;; Instead of this, we could just find all contained forms.
(cond ((eq ?\' (following-char))
(forward-char 1)
(list
- (edebug-storing-offsets (- (point) 2)
- (if (featurep 'cl) 'function* 'function))
+ (edebug-storing-offsets (- (point) 2) 'function)
(edebug-read-storing-offsets stream)))
((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
?7 ?8 ?9 ?0))
;; If it gets an error, make it nil.
(let ((temp-hook edebug-setup-hook))
(setq edebug-setup-hook nil)
- (run-hooks 'temp-hook))
+ (if (functionp temp-hook) (funcall temp-hook)
+ (mapc #'funcall temp-hook)))
(let (result
edebug-top-window-data
(defvar edebug-offset-list) ; the list of offset positions.
(defun edebug-inc-offset (offset)
- ;; modifies edebug-offset-index and edebug-offset-list
- ;; accesses edebug-func-marc and buffer point
+ ;; Modifies edebug-offset-index and edebug-offset-list
+ ;; accesses edebug-func-marc and buffer point.
(prog1
edebug-offset-index
(setq edebug-offset-list (cons (- offset edebug-form-begin-marker)
;; given FORM. Looks like:
;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
;; Also increment the offset index for subsequent use.
- (list 'edebug-after
- (list 'edebug-before before-index)
- after-index form))
+ `(edebug-after (edebug-before ,before-index) ,after-index ,form))
(defun edebug-make-after-form (form after-index)
;; Like edebug-make-before-and-after-form, but only after.
- (list 'edebug-after 0 after-index form))
+ `(edebug-after 0 ,after-index ,form))
(defun edebug-unwrap (sexp)
((eq 'edebug-after (car sexp))
(nth 3 sexp))
((eq 'edebug-enter (car sexp))
- (let ((forms (nthcdr 2 (nth 1 (nth 3 sexp)))))
- (if (> (length forms) 1)
- (cons 'progn forms) ;; could return (values forms) instead.
- (car forms))))
+ (macroexp-progn (nthcdr 2 (nth 1 (nth 3 sexp)))))
(t sexp);; otherwise it is not wrapped, so just return it.
)
sexp))
;; Set this marker before parsing.
(edebug-form-begin-marker
(if form-data-entry
- (edebug-form-data-begin form-data-entry)
+ (edebug--form-data-begin form-data-entry)
;; Buffer must be current-buffer for this to work:
(set-marker (make-marker) form-begin))))
;; For definitions.
;; (edebug-containing-def-name edebug-def-name)
;; Get name from form-data, if any.
- (edebug-old-def-name (edebug-form-data-name form-data-entry))
+ (edebug-old-def-name (edebug--form-data-name form-data-entry))
edebug-def-name
edebug-def-args
edebug-def-interactive
;; In the latter case, pointers to the entry remain eq.
(if (not form-data-entry)
(setq form-data-entry
- (edebug-make-form-data-entry
+ (edebug--make-form-data-entry
edebug-def-name
edebug-form-begin-marker
;; Buffer must be current-buffer.
;; Otherwise it signals an error. The place of the error is found
;; with the two before- and after-offset functions.
-(defun edebug-no-match (cursor &rest edebug-args)
+(defun edebug-no-match (cursor &rest args)
;; Throw a no-match, or signal an error immediately if gate is active.
;; Remember this point in case we need to report this error.
(setq edebug-error-point (or edebug-error-point
(edebug-before-offset cursor))
- edebug-best-error (or edebug-best-error edebug-args))
+ edebug-best-error (or edebug-best-error args))
(if (and edebug-gate (not edebug-&optional))
(progn
(if edebug-error-point
(goto-char edebug-error-point))
- (apply 'edebug-syntax-error edebug-args))
- (funcall 'throw 'no-match edebug-args)))
+ (apply 'edebug-syntax-error args))
+ (throw 'no-match args)))
(defun edebug-match (cursor specs)
specs))))
-(defun edebug-match-gate (cursor)
+(defun edebug-match-gate (_cursor)
;; Simply set the gate to prevent backtracking at this level.
(setq edebug-gate t)
nil)
nil))
-(defun edebug-match-function (cursor)
+(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
(defun edebug-match-&define (cursor specs)
(edebug-move-cursor cursor)
(list name)))
-(defun edebug-match-colon-name (cursor spec)
+(defun edebug-match-colon-name (_cursor spec)
;; Set the edebug-def-name to the spec.
(setq edebug-def-name
(if edebug-def-name
;;;; Edebug Form Specs
;;; ==========================================================
-;;; See cl-specs.el for common lisp specs.
;;;;* Spec for def-edebug-spec
;;; Out of date.
def-body))
;; FIXME? Isn't this missing the doc-string? Cf defun.
(def-edebug-spec defmacro
+ ;; FIXME: Improve `declare' so we can Edebug gv-expander and
+ ;; gv-setter declarations.
(&define name lambda-list [&optional ("declare" &rest sexp)] def-body))
(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
;; A macro is allowed by Emacs.
(def-edebug-spec function (&or symbolp lambda-expr))
-;; lambda is a macro in emacs 19.
-(def-edebug-spec lambda (&define lambda-list
- [&optional stringp]
- [&optional ("interactive" interactive)]
- def-body))
-
;; A macro expression is a lambda expression with "macro" prepended.
(def-edebug-spec macro (&define "lambda" lambda-list def-body))
;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
;; Standard functions that take function-forms arguments.
-(def-edebug-spec mapcar (function-form form))
-(def-edebug-spec mapconcat (function-form form form))
-(def-edebug-spec mapatoms (function-form &optional form))
-(def-edebug-spec apply (function-form &rest form))
-(def-edebug-spec funcall (function-form &rest form))
;; FIXME? The manual uses this form (maybe that's just for illustration?):
;; (def-edebug-spec let
&or ("quote" edebug-\`) def-form))
;; New byte compiler.
-(def-edebug-spec defsubst defun)
-(def-edebug-spec dont-compile t)
-(def-edebug-spec eval-when-compile t)
-(def-edebug-spec eval-and-compile t)
(def-edebug-spec save-selected-window t)
(def-edebug-spec save-current-buffer t)
-(def-edebug-spec delay-mode-hooks t)
-(def-edebug-spec with-temp-file t)
-(def-edebug-spec with-temp-message t)
-(def-edebug-spec with-syntax-table t)
-(def-edebug-spec push (form sexp))
-(def-edebug-spec pop (sexp))
-
-(def-edebug-spec 1value (form))
-(def-edebug-spec noreturn (form))
-
;; Anything else?
-
-;; Some miscellaneous specs for macros in public packages.
-;; Send me yours.
-
-;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
-
-(def-edebug-spec ad-dolist ((symbolp form &optional form) body))
-(def-edebug-spec defadvice
- (&define name ;; thing being advised.
- (name ;; class is [&or "before" "around" "after"
- ;; "activation" "deactivation"]
- name ;; name of advice
- &rest sexp ;; optional position and flags
- )
- [&optional stringp]
- [&optional ("interactive" interactive)]
- def-body))
-
-(def-edebug-spec easy-menu-define (symbolp body))
-
-(def-edebug-spec with-custom-print body)
-
-
;;; The debugger itself
(defvar edebug-active nil) ;; Non-nil when edebug is active
;; Dynamically bound variables, declared globally but left unbound.
(defvar edebug-function) ; the function being executed. change name!!
-(defvar edebug-args) ; the arguments of the function
(defvar edebug-data) ; the edebug data for the function
-(defvar edebug-value) ; the result of the expression
-(defvar edebug-after-index)
(defvar edebug-def-mark) ; the mark for the definition
(defvar edebug-freq-count) ; the count of expression visits.
(defvar edebug-coverage) ; the coverage results of each expression of function.
(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
-(defvar edebug-outside-overriding-local-map)
-(defvar edebug-outside-overriding-terminal-local-map)
(defvar edebug-outside-pre-command-hook)
(defvar edebug-outside-post-command-hook)
;;; Handling signals
-(defun edebug-signal (edebug-signal-name edebug-signal-data)
+(defun edebug-signal (signal-name signal-data)
"Signal an error. Args are SIGNAL-NAME, and associated DATA.
A signal name is a symbol with an `error-conditions' property
that is a list of condition names.
This is the Edebug replacement for the standard `signal'. It should
only be active while Edebug is. It checks `debug-on-error' to see
whether it should call the debugger. When execution is resumed, the
-error is signaled again.
-\n(fn SIGNAL-NAME DATA)"
- (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error))
- (edebug 'error (cons edebug-signal-name edebug-signal-data)))
+error is signaled again."
+ (if (and (listp debug-on-error) (memq signal-name debug-on-error))
+ (edebug 'error (cons signal-name signal-data)))
;; If we reach here without another non-local exit, then send signal again.
;; i.e. the signal is not continuable, yet.
;; Avoid infinite recursion.
(let ((signal-hook-function nil))
- (signal edebug-signal-name edebug-signal-data)))
+ (signal signal-name signal-data)))
;;; Entering Edebug
-(defun edebug-enter (edebug-function edebug-args edebug-body)
+(defun edebug-enter (function args body)
;; Entering FUNC. The arguments are ARGS, and the body is BODY.
;; Setup edebug variables and evaluate BODY. This function is called
;; when a function evaluated with edebug-eval-top-level-form is entered.
;; Is this the first time we are entering edebug since
;; lower-level recursive-edit command?
;; More precisely, this tests whether Edebug is currently active.
- (if (not edebug-entered)
- (let ((edebug-entered t)
- ;; Binding max-lisp-eval-depth here is OK,
- ;; but not inside an unwind-protect.
- ;; Doing it here also keeps it from growing too large.
- (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
- (max-specpdl-size (+ 200 max-specpdl-size))
-
- (debugger edebug-debugger) ; only while edebug is active.
- (edebug-outside-debug-on-error debug-on-error)
- (edebug-outside-debug-on-quit debug-on-quit)
- ;; Binding these may not be the right thing to do.
- ;; We want to allow the global values to be changed.
- (debug-on-error (or debug-on-error edebug-on-error))
- (debug-on-quit edebug-on-quit)
-
- ;; Lexical bindings must be uncompiled for this to work.
- (cl-lexical-debug t)
-
- (edebug-outside-overriding-local-map overriding-local-map)
- (edebug-outside-overriding-terminal-local-map
- overriding-terminal-local-map)
-
- ;; Save the outside value of executing macro. (here??)
- (edebug-outside-executing-macro executing-kbd-macro)
- (edebug-outside-pre-command-hook
- (edebug-var-status 'pre-command-hook))
- (edebug-outside-post-command-hook
- (edebug-var-status 'post-command-hook)))
- (unwind-protect
- (let (;; Don't keep reading from an executing kbd macro
- ;; within edebug unless edebug-continue-kbd-macro is
- ;; non-nil. Again, local binding may not be best.
- (executing-kbd-macro
- (if edebug-continue-kbd-macro executing-kbd-macro))
-
- ;; Don't get confused by the user's keymap changes.
- (overriding-local-map nil)
- (overriding-terminal-local-map nil)
-
- (signal-hook-function 'edebug-signal)
-
- ;; Disable command hooks. This is essential when
- ;; a hook function is instrumented - to avoid infinite loop.
- ;; This may be more than we need, however.
- (pre-command-hook nil)
- (post-command-hook nil))
- (setq edebug-execution-mode (or edebug-next-execution-mode
- edebug-initial-mode
- edebug-execution-mode)
- edebug-next-execution-mode nil)
- (edebug-enter edebug-function edebug-args edebug-body))
- ;; Reset global variables in case outside value was changed.
- (setq executing-kbd-macro edebug-outside-executing-macro)
- (edebug-restore-status
- 'post-command-hook edebug-outside-post-command-hook)
- (edebug-restore-status
- 'pre-command-hook edebug-outside-pre-command-hook)))
-
- (let* ((edebug-data (get edebug-function 'edebug))
- (edebug-def-mark (car edebug-data)) ; mark at def start
- (edebug-freq-count (get edebug-function 'edebug-freq-count))
- (edebug-coverage (get edebug-function 'edebug-coverage))
- (edebug-buffer (marker-buffer edebug-def-mark))
-
- (edebug-stack (cons edebug-function edebug-stack))
- (edebug-offset-indices (cons 0 edebug-offset-indices))
- )
- (if (get edebug-function 'edebug-on-entry)
- (progn
- (setq edebug-execution-mode 'step)
- (if (eq (get edebug-function 'edebug-on-entry) 'temp)
- (put edebug-function 'edebug-on-entry nil))))
- (if edebug-trace
- (edebug-enter-trace edebug-body)
- (funcall edebug-body))
- )))
+ (let ((edebug-function function))
+ (if (not edebug-entered)
+ (let ((edebug-entered t)
+ ;; Binding max-lisp-eval-depth here is OK,
+ ;; but not inside an unwind-protect.
+ ;; Doing it here also keeps it from growing too large.
+ (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
+ (max-specpdl-size (+ 200 max-specpdl-size))
+
+ (debugger edebug-debugger) ; only while edebug is active.
+ (edebug-outside-debug-on-error debug-on-error)
+ (edebug-outside-debug-on-quit debug-on-quit)
+ ;; Binding these may not be the right thing to do.
+ ;; We want to allow the global values to be changed.
+ (debug-on-error (or debug-on-error edebug-on-error))
+ (debug-on-quit edebug-on-quit)
+
+ ;; Lexical bindings must be uncompiled for this to work.
+ (cl-lexical-debug t))
+ (unwind-protect
+ (let ((signal-hook-function 'edebug-signal))
+ (setq edebug-execution-mode (or edebug-next-execution-mode
+ edebug-initial-mode
+ edebug-execution-mode)
+ edebug-next-execution-mode nil)
+ (edebug-enter function args body))))
+
+ (let* ((edebug-data (get function 'edebug))
+ (edebug-def-mark (car edebug-data)) ; mark at def start
+ (edebug-freq-count (get function 'edebug-freq-count))
+ (edebug-coverage (get function 'edebug-coverage))
+ (edebug-buffer (marker-buffer edebug-def-mark))
+
+ (edebug-stack (cons function edebug-stack))
+ (edebug-offset-indices (cons 0 edebug-offset-indices))
+ )
+ (if (get function 'edebug-on-entry)
+ (progn
+ (setq edebug-execution-mode 'step)
+ (if (eq (get function 'edebug-on-entry) 'temp)
+ (put function 'edebug-on-entry nil))))
+ (if edebug-trace
+ (edebug--enter-trace function args body)
+ (funcall body))
+ ))))
(defun edebug-var-status (var)
"Return a cons cell describing the status of VAR's current binding.
(t
(set var value)))))
-(defun edebug-enter-trace (edebug-body)
+(defun edebug--enter-trace (function args body)
(let ((edebug-stack-depth (1+ edebug-stack-depth))
edebug-result)
(edebug-print-trace-before
- (format "%s args: %s" edebug-function edebug-args))
- (prog1 (setq edebug-result (funcall edebug-body))
+ (format "%s args: %s" function args))
+ (prog1 (setq edebug-result (funcall body))
(edebug-print-trace-after
- (format "%s result: %s" edebug-function edebug-result)))))
+ (format "%s result: %s" function edebug-result)))))
(def-edebug-spec edebug-tracing (form body))
-(defun edebug-slow-before (edebug-before-index)
+(defun edebug-slow-before (before-index)
(unless edebug-active
;; Debug current function given BEFORE position.
;; Called from functions compiled with edebug-eval-top-level-form.
;; Return the before index.
- (setcar edebug-offset-indices edebug-before-index)
+ (setcar edebug-offset-indices before-index)
;; Increment frequency count
- (aset edebug-freq-count edebug-before-index
- (1+ (aref edebug-freq-count edebug-before-index)))
+ (aset edebug-freq-count before-index
+ (1+ (aref edebug-freq-count before-index)))
(if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
- (edebug-input-pending-p))
- (edebug-debugger edebug-before-index 'before nil)))
- edebug-before-index)
+ (input-pending-p))
+ (edebug-debugger before-index 'before nil)))
+ before-index)
-(defun edebug-fast-before (edebug-before-index)
+(defun edebug-fast-before (_before-index)
;; Do nothing.
)
-(defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value)
+(defun edebug-slow-after (_before-index after-index value)
(if edebug-active
- edebug-value
+ value
;; Debug current function given AFTER position and VALUE.
;; Called from functions compiled with edebug-eval-top-level-form.
;; Return VALUE.
- (setcar edebug-offset-indices edebug-after-index)
+ (setcar edebug-offset-indices after-index)
;; Increment frequency count
- (aset edebug-freq-count edebug-after-index
- (1+ (aref edebug-freq-count edebug-after-index)))
- (if edebug-test-coverage (edebug-update-coverage))
+ (aset edebug-freq-count after-index
+ (1+ (aref edebug-freq-count after-index)))
+ (if edebug-test-coverage (edebug--update-coverage after-index value))
(if (and (eq edebug-execution-mode 'Go-nonstop)
- (not (edebug-input-pending-p)))
+ (not (input-pending-p)))
;; Just return result.
- edebug-value
- (edebug-debugger edebug-after-index 'after edebug-value)
+ value
+ (edebug-debugger after-index 'after value)
)))
-(defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value)
+(defun edebug-fast-after (_before-index _after-index value)
;; Do nothing but return the value.
- edebug-value)
+ value)
(defun edebug-run-slow ()
(defalias 'edebug-before 'edebug-slow-before)
(edebug-run-slow)
-(defun edebug-update-coverage ()
- (let ((old-result (aref edebug-coverage edebug-after-index)))
+(defun edebug--update-coverage (after-index value)
+ (let ((old-result (aref edebug-coverage after-index)))
(cond
((eq 'ok-coverage old-result))
((eq 'unknown old-result)
- (aset edebug-coverage edebug-after-index edebug-value))
+ (aset edebug-coverage after-index value))
;; Test if a different result.
- ((not (eq edebug-value old-result))
- (aset edebug-coverage edebug-after-index 'ok-coverage)))))
+ ((not (eq value old-result))
+ (aset edebug-coverage after-index 'ok-coverage)))))
;; Dynamically declared unbound variables.
-(defvar edebug-arg-mode) ; the mode, either before, after, or error
(defvar edebug-breakpoints)
(defvar edebug-break-data) ; break data for current function.
(defvar edebug-break) ; whether a break occurred.
(defvar edebug-global-break-result nil)
-(defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value)
+(defun edebug-debugger (offset-index arg-mode value)
(if inhibit-redisplay
;; Don't really try to enter edebug within an eval from redisplay.
- edebug-value
+ value
;; Check breakpoints and pending input.
- ;; If edebug display should be updated, call edebug-display.
- ;; Return edebug-value.
+ ;; If edebug display should be updated, call edebug--display.
+ ;; Return value.
(let* ( ;; This needs to be here since breakpoints may be changed.
(edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
- (edebug-break-data (assq edebug-offset-index edebug-breakpoints))
+ (edebug-break-data (assq offset-index edebug-breakpoints))
(edebug-break-condition (car (cdr edebug-break-data)))
(edebug-global-break
(if edebug-global-break-condition
(error nil))))
(edebug-break))
-;;; (edebug-trace "exp: %s" edebug-value)
+ ;;(edebug-trace "exp: %s" value)
;; Test whether we should break.
(setq edebug-break
(or edebug-global-break
;; or break, or input is pending,
(if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
edebug-break
- (edebug-input-pending-p))
- (edebug-display)) ; <--------------- display
+ (input-pending-p))
+ (edebug--display value offset-index arg-mode)) ; <---------- display
- edebug-value
- )))
+ value)))
;; window-start now stored with each function.
;; Emacs 19 adds an arg to mark and mark-marker.
(defalias 'edebug-mark-marker 'mark-marker)
+(defvar edebug-outside-unread-command-events)
-(defun edebug-display ()
+(defun edebug--display (value offset-index arg-mode)
(unless (marker-position edebug-def-mark)
;; The buffer holding the source has been killed.
;; Let's at least show a backtrace so the user can figure out
;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
;; Uses local variables of edebug-enter, edebug-before, edebug-after
;; and edebug-debugger.
- (let ((edebug-active t) ; for minor mode alist
+ (let ((edebug-active t) ; For minor mode alist.
(edebug-with-timeout-suspend (with-timeout-suspend))
- edebug-stop ; should we enter recursive-edit
+ edebug-stop ; Should we enter recursive-edit?
(edebug-point (+ edebug-def-mark
- (aref (nth 2 edebug-data) edebug-offset-index)))
+ (aref (nth 2 edebug-data) offset-index)))
edebug-buffer-outside-point ; current point in edebug-buffer
;; window displaying edebug-buffer
(edebug-window-data (nth 3 edebug-data))
(edebug-outside-point (point))
(edebug-outside-mark (edebug-mark))
(edebug-outside-unread-command-events unread-command-events)
- edebug-outside-windows ; window or screen configuration
+ edebug-outside-windows ; Window or screen configuration.
edebug-buffer-points
- edebug-eval-buffer ; declared here so we can kill it below
- (edebug-eval-result-list (and edebug-eval-list
- (edebug-eval-result-list)))
+ edebug-eval-buffer ; Declared here so we can kill it below.
+ (eval-result-list (and edebug-eval-list
+ (edebug-eval-result-list)))
edebug-trace-window
edebug-trace-window-start
(let ((overlay-arrow-position overlay-arrow-position)
(overlay-arrow-string overlay-arrow-string)
(cursor-in-echo-area nil)
- (unread-command-events unread-command-events)
+ (unread-command-events nil)
;; any others??
)
(setq-default cursor-in-non-selected-windows t)
(let ((debug-on-error nil))
(error "Buffer defining %s not found" edebug-function)))
- (if (eq 'after edebug-arg-mode)
+ (if (eq 'after arg-mode)
;; Compute result string now before windows are modified.
- (edebug-compute-previous-result edebug-value))
+ (edebug-compute-previous-result value))
(if edebug-save-windows
;; Save windows now before we modify them.
;; Now display eval list, if any.
;; This is done after the pop to edebug-buffer
;; so that buffer-window correspondence is correct after quitting.
- (edebug-eval-display edebug-eval-result-list)
+ (edebug-eval-display eval-result-list)
;; The evaluation list better not have deleted edebug-window-data.
(select-window (car edebug-window-data))
(set-buffer edebug-buffer)
(setq edebug-buffer-outside-point (point))
(goto-char edebug-point)
- (if (eq 'before edebug-arg-mode)
+ (if (eq 'before arg-mode)
;; Check whether positions are up-to-date.
;; This assumes point is never before symbol.
(if (not (memq (following-char) '(?\( ?\# ?\` )))
(edebug-adjust-window (cdr edebug-window-data)))
;; Test if there is input, not including keyboard macros.
- (if (edebug-input-pending-p)
+ (if (input-pending-p)
(progn
(setq edebug-execution-mode 'step
edebug-stop t)
(edebug-overlay-arrow)
(cond
- ((eq 'error edebug-arg-mode)
+ ((eq 'error arg-mode)
;; Display error message
(setq edebug-execution-mode 'step)
(edebug-overlay-arrow)
(beep)
- (if (eq 'quit (car edebug-value))
+ (if (eq 'quit (car value))
(message "Quit")
- (edebug-report-error edebug-value)))
+ (edebug-report-error value)))
(edebug-break
(cond
(edebug-global-break
(t (message "")))
- (setq unread-command-events nil)
- (if (eq 'after edebug-arg-mode)
+ (if (eq 'after arg-mode)
(progn
;; Display result of previous evaluation.
(if (and edebug-break
(not (eq edebug-execution-mode 'Continue-fast)))
- (edebug-sit-for edebug-sit-for-seconds)) ; Show message.
+ (sit-for edebug-sit-for-seconds)) ; Show message.
(edebug-previous-result)))
(cond
(edebug-break
(cond
((eq edebug-execution-mode 'continue)
- (edebug-sit-for edebug-sit-for-seconds))
- ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
+ (sit-for edebug-sit-for-seconds))
+ ((eq edebug-execution-mode 'Continue-fast) (sit-for 0))
(t (setq edebug-stop t))))
;; not edebug-break
((eq edebug-execution-mode 'trace)
- (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause.
+ (sit-for edebug-sit-for-seconds)) ; Force update and pause.
((eq edebug-execution-mode 'Trace-fast)
- (edebug-sit-for 0))) ; Force update and continue.
+ (sit-for 0))) ; Force update and continue.
(unwind-protect
(if (or edebug-stop
(memq edebug-execution-mode '(step next))
- (eq edebug-arg-mode 'error))
+ (eq arg-mode 'error))
(progn
;; (setq edebug-execution-mode 'step)
;; (edebug-overlay-arrow) ; This doesn't always show up.
- (edebug-recursive-edit))) ; <---------- Recursive edit
+ (edebug--recursive-edit arg-mode))) ; <----- Recursive edit
;; Reset the edebug-window-data to whatever it is now.
(let ((window (if (eq (window-buffer) edebug-buffer)
(selected-window)
- (edebug-get-buffer-window edebug-buffer))))
+ (get-buffer-window edebug-buffer))))
;; Remember window-start for edebug-buffer, if still displayed.
(if window
(progn
(goto-char edebug-buffer-outside-point))
;; ... nothing more.
)
+ ;; Could be an option to keep eval display up.
+ (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
(with-timeout-unsuspend edebug-with-timeout-suspend)
;; Reset global variables to outside values in case they were changed.
(setq
;; in versions where the variable is *not* built-in.
;; Emacs 18 FIXME
-(defvar edebug-outside-unread-command-char)
;; Emacs 19.
(defvar edebug-outside-last-command-event)
-(defvar edebug-outside-unread-command-events)
(defvar edebug-outside-last-input-event)
(defvar edebug-outside-last-event-frame)
(defvar edebug-outside-last-nonmenu-event)
(defvar edebug-outside-track-mouse)
-;; Disable byte compiler warnings about unread-command-char and -event
-;; (maybe works with byte-compile-version 2.22 at least)
-(defvar edebug-unread-command-char-warning)
-(defvar edebug-unread-command-event-warning)
-(eval-when-compile ; FIXME
- (setq edebug-unread-command-char-warning
- (get 'unread-command-char 'byte-obsolete-variable))
- (put 'unread-command-char 'byte-obsolete-variable nil))
-
-(defun edebug-recursive-edit ()
+(defun edebug--recursive-edit (arg-mode)
;; Start up a recursive edit inside of edebug.
;; The current buffer is the edebug-buffer, which is put into edebug-mode.
;; Assume that none of the variables below are buffer-local.
(edebug-outside-map (current-local-map))
- (edebug-outside-standard-output standard-output)
+ ;; Save the outside value of executing macro. (here??)
+ (edebug-outside-executing-macro executing-kbd-macro)
+ (edebug-outside-pre-command-hook
+ (edebug-var-status 'pre-command-hook))
+ (edebug-outside-post-command-hook
+ (edebug-var-status 'post-command-hook))
+
+ (edebug-outside-standard-output standard-output)
(edebug-outside-standard-input standard-input)
(edebug-outside-defining-kbd-macro defining-kbd-macro)
(edebug-outside-last-command last-command)
(edebug-outside-this-command this-command)
- (edebug-outside-unread-command-char unread-command-char) ; FIXME
(edebug-outside-current-prefix-arg current-prefix-arg)
(edebug-outside-last-input-event last-input-event)
;; We could set these to the values for previous edebug call.
(last-command last-command)
(this-command this-command)
-
- ;; Assume no edebug command sets unread-command-char.
- (unread-command-char -1)
(current-prefix-arg nil)
;; More for Emacs 19
(last-nonmenu-event nil)
(track-mouse nil)
- ;; Bind again to outside values.
+ (standard-output t)
+ (standard-input t)
+
+ ;; Don't keep reading from an executing kbd macro
+ ;; within edebug unless edebug-continue-kbd-macro is
+ ;; non-nil. Again, local binding may not be best.
+ (executing-kbd-macro
+ (if edebug-continue-kbd-macro executing-kbd-macro))
+
+ ;; Don't get confused by the user's keymap changes.
+ (overriding-local-map nil)
+ (overriding-terminal-local-map nil)
+
+ ;; Bind again to outside values.
(debug-on-error edebug-outside-debug-on-error)
(debug-on-quit edebug-outside-debug-on-quit)
(defining-kbd-macro
(if edebug-continue-kbd-macro defining-kbd-macro))
+ ;; Disable command hooks. This is essential when
+ ;; a hook function is instrumented - to avoid infinite loop.
+ ;; This may be more than we need, however.
+ (pre-command-hook nil)
+ (post-command-hook nil)
+
;; others??
)
(if (and (eq edebug-execution-mode 'go)
- (not (memq edebug-arg-mode '(after error))))
+ (not (memq arg-mode '(after error))))
(message "Break"))
(setq buffer-read-only t)
(setq signal-hook-function 'edebug-signal)
(if edebug-backtrace-buffer
(kill-buffer edebug-backtrace-buffer))
- ;; Could be an option to keep eval display up.
- (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
;; Remember selected-window after recursive-edit.
;; (setq edebug-inside-window (selected-window))
last-command-event edebug-outside-last-command-event
last-command edebug-outside-last-command
this-command edebug-outside-this-command
- unread-command-char edebug-outside-unread-command-char
current-prefix-arg edebug-outside-current-prefix-arg
last-input-event edebug-outside-last-input-event
last-event-frame edebug-outside-last-event-frame
standard-output edebug-outside-standard-output
standard-input edebug-outside-standard-input
- defining-kbd-macro edebug-outside-defining-kbd-macro
- ))
- ))
+ defining-kbd-macro edebug-outside-defining-kbd-macro)
+
+ (setq executing-kbd-macro edebug-outside-executing-macro)
+ (edebug-restore-status
+ 'post-command-hook edebug-outside-post-command-hook)
+ (edebug-restore-status
+ 'pre-command-hook edebug-outside-pre-command-hook))))
;;; Display related functions
(defun edebug-adjust-window (old-start)
;; If pos is not visible, adjust current window to fit following context.
-;;; (message "window: %s old-start: %s window-start: %s pos: %s"
-;;; (selected-window) old-start (window-start) (point)) (sit-for 5)
+ ;; (message "window: %s old-start: %s window-start: %s pos: %s"
+ ;; (selected-window) old-start (window-start) (point)) (sit-for 5)
(if (not (pos-visible-in-window-p))
(progn
;; First try old-start
(set-window-start (selected-window) old-start))
(if (not (pos-visible-in-window-p))
(progn
-;; (message "resetting window start") (sit-for 2)
+ ;; (message "resetting window start") (sit-for 2)
(set-window-start
(selected-window)
(save-excursion
(edebug-toggle-save-selected-window)
(edebug-toggle-save-all-windows)))
-
(defun edebug-where ()
"Show the debug windows and where we stopped in the program."
(interactive)
(current-buffer) (point)
(if (marker-buffer (edebug-mark-marker))
(marker-position (edebug-mark-marker)) "<not set>"))
- (edebug-sit-for arg)
+ (sit-for arg)
(edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
;; Joe Wells, here is a start at your idea of adding a buffer to the internal
-;; display list. Still need to use this list in edebug-display.
+;; display list. Still need to use this list in edebug--display.
'(defvar edebug-display-buffer-list nil
"List of buffers that edebug will display when it is active.")
(save-excursion
(down-list 1)
(if (looking-at "\(")
- (edebug-form-data-name
+ (edebug--form-data-name
(edebug-get-form-data-entry (point)))
(edebug-original-read (current-buffer))))))
(edebug-instrument-function func))))
;;; Evaluation of expressions
-(def-edebug-spec edebug-outside-excursion t)
-
(defmacro edebug-outside-excursion (&rest body)
"Evaluate an expression list in the outside context.
Return the result of the last expression."
+ (declare (debug t))
`(save-excursion ; of current-buffer
(if edebug-save-windows
(progn
(last-command-event edebug-outside-last-command-event)
(last-command edebug-outside-last-command)
(this-command edebug-outside-this-command)
- (unread-command-char edebug-outside-unread-command-char)
(unread-command-events edebug-outside-unread-command-events)
(current-prefix-arg edebug-outside-current-prefix-arg)
(last-input-event edebug-outside-last-input-event)
(pre-command-hook (cdr edebug-outside-pre-command-hook))
(post-command-hook (cdr edebug-outside-post-command-hook))
- ;; See edebug-display
+ ;; See edebug-display.
(overlay-arrow-position edebug-outside-o-a-p)
(overlay-arrow-string edebug-outside-o-a-s)
(cursor-in-echo-area edebug-outside-c-i-e-a)
edebug-outside-last-command-event last-command-event
edebug-outside-last-command last-command
edebug-outside-this-command this-command
- edebug-outside-unread-command-char unread-command-char
edebug-outside-unread-command-events unread-command-events
edebug-outside-current-prefix-arg current-prefix-arg
edebug-outside-last-input-event last-input-event
(defvar cl-debug-env) ; defined in cl; non-nil when lexical env used.
-(defun edebug-eval (edebug-expr)
+(defun edebug-eval (expr)
;; Are there cl lexical variables active?
- (eval (if (bound-and-true-p cl-debug-env)
- (cl-macroexpand-all edebug-expr cl-debug-env)
- edebug-expr)
+ (eval (if (and (bound-and-true-p cl-debug-env)
+ (fboundp 'cl-macroexpand-all))
+ (cl-macroexpand-all expr cl-debug-env)
+ expr)
lexical-binding))
-(defun edebug-safe-eval (edebug-expr)
+(defun edebug-safe-eval (expr)
;; Evaluate EXPR safely.
;; If there is an error, a string is returned describing the error.
(condition-case edebug-err
- (edebug-eval edebug-expr)
+ (edebug-eval expr)
(error (edebug-format "%s: %s" ;; could
(get (car edebug-err) 'error-message)
(car (cdr edebug-err))))))
;;; Printing
-(defun edebug-report-error (edebug-value)
+(defun edebug-report-error (value)
;; Print an error message like command level does.
;; This also prints the error name if it has no error-message.
(message "%s: %s"
- (or (get (car edebug-value) 'error-message)
- (format "peculiar error (%s)" (car edebug-value)))
+ (or (get (car value) 'error-message)
+ (format "peculiar error (%s)" (car value)))
(mapconcat (function (lambda (edebug-arg)
;; continuing after an error may
;; complain about edebug-arg. why??
(prin1-to-string edebug-arg)))
- (cdr edebug-value) ", ")))
+ (cdr value) ", ")))
(defvar print-readably) ; defined by lemacs
;; Alternatively, we could change the definition of
(edebug-prin1-to-string value)
(error "#Apparently circular structure#"))))
-(defun edebug-compute-previous-result (edebug-previous-value)
+(defun edebug-compute-previous-result (previous-value)
(if edebug-unwrap-results
- (setq edebug-previous-value
- (edebug-unwrap* edebug-previous-value)))
+ (setq previous-value
+ (edebug-unwrap* previous-value)))
(setq edebug-previous-result
(concat "Result: "
- (edebug-safe-prin1-to-string edebug-previous-value)
- (eval-expression-print-format edebug-previous-value))))
+ (edebug-safe-prin1-to-string previous-value)
+ (eval-expression-print-format previous-value))))
(defun edebug-previous-result ()
"Print the previous result."
(defalias 'edebug-format 'format)
(defalias 'edebug-message 'message)
-(defun edebug-eval-expression (edebug-expr)
+(defun edebug-eval-expression (expr)
"Evaluate an expression in the outside environment.
If interactive, prompt for the expression.
Print result in minibuffer."
'read-expression-history)))
(princ
(edebug-outside-excursion
- (setq values (cons (edebug-eval edebug-expr) values))
+ (setq values (cons (edebug-eval expr) values))
(concat (edebug-safe-prin1-to-string (car values))
(eval-expression-print-format (car values))))))
"Evaluate sexp before point in outside environment; insert value.
This prints the value into current buffer."
(interactive)
- (let* ((edebug-form (edebug-last-sexp))
- (edebug-result-string
+ (let* ((form (edebug-last-sexp))
+ (result-string
(edebug-outside-excursion
- (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
+ (edebug-safe-prin1-to-string (edebug-safe-eval form))))
(standard-output (current-buffer)))
(princ "\n")
;; princ the string to get rid of quotes.
- (princ edebug-result-string)
+ (princ result-string)
(princ "\n")
))
;;; Edebug Minor Mode
-;; FIXME eh?
-(defvar gud-inhibit-global-bindings
- "*Non-nil means don't do global rebindings of C-x C-a subcommands.")
+(defvar edebug-inhibit-emacs-lisp-mode-bindings nil
+ "If non-nil, inhibit Edebug bindings on the C-x C-a key.
+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.3")
;; Global GUD bindings for all emacs-lisp-mode buffers.
-(unless gud-inhibit-global-bindings
+(unless edebug-inhibit-emacs-lisp-mode-bindings
(define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
(define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
(define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
(edebug-trace nil))
(mapcar 'edebug-safe-eval edebug-eval-list)))
-(defun edebug-eval-display-list (edebug-eval-result-list)
+(defun edebug-eval-display-list (eval-result-list)
;; Assumes edebug-eval-buffer exists.
- (let ((edebug-eval-list-temp edebug-eval-list)
- (standard-output edebug-eval-buffer)
+ (let ((standard-output edebug-eval-buffer)
(edebug-comment-line
(format ";%s\n" (make-string (- (window-width) 2) ?-))))
(set-buffer edebug-eval-buffer)
(erase-buffer)
- (while edebug-eval-list-temp
- (prin1 (car edebug-eval-list-temp)) (terpri)
- (prin1 (car edebug-eval-result-list)) (terpri)
- (princ edebug-comment-line)
- (setq edebug-eval-list-temp (cdr edebug-eval-list-temp))
- (setq edebug-eval-result-list (cdr edebug-eval-result-list)))
+ (dolist (exp edebug-eval-list)
+ (prin1 exp) (terpri)
+ (prin1 (pop eval-result-list)) (terpri)
+ (princ edebug-comment-line))
(edebug-pop-to-buffer edebug-eval-buffer)
))
(defun edebug-create-eval-buffer ()
- (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer)))
- (progn
- (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
- (edebug-eval-mode))))
+ (unless (and edebug-eval-buffer (buffer-name edebug-eval-buffer))
+ (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
+ (edebug-eval-mode)))
;; Should generalize this to be callable outside of edebug
;; with calls in user functions, e.g. (edebug-eval-display)
-(defun edebug-eval-display (edebug-eval-result-list)
- "Display expressions and evaluations in EDEBUG-EVAL-RESULT-LIST.
+(defun edebug-eval-display (eval-result-list)
+ "Display expressions and evaluations in EVAL-RESULT-LIST.
It modifies the context by popping up the eval display."
- (if edebug-eval-result-list
- (progn
- (edebug-create-eval-buffer)
- (edebug-eval-display-list edebug-eval-result-list)
- )))
+ (when eval-result-list
+ (edebug-create-eval-buffer)
+ (edebug-eval-display-list eval-result-list)))
(defun edebug-eval-redisplay ()
"Redisplay eval list in outside environment.
-May only be called from within `edebug-recursive-edit'."
+May only be called from within `edebug--recursive-edit'."
(edebug-create-eval-buffer)
(edebug-outside-excursion
(edebug-eval-display-list (edebug-eval-result-list))
(if (not (eobp))
(progn
(forward-sexp 1)
- (setq new-list (cons (edebug-last-sexp) new-list))))
+ (push (edebug-last-sexp) new-list)))
(while (re-search-forward "^;" nil t)
(forward-line 1)
(not (eobp)))
(progn
(forward-sexp 1)
- (setq new-list (cons (edebug-last-sexp) new-list)))))
+ (push (edebug-last-sexp) new-list))))
(setq edebug-eval-list (nreverse new-list))
(edebug-eval-redisplay)
(define-key map "\C-c\C-u" 'edebug-update-eval-list)
(define-key map "\C-x\C-e" 'edebug-eval-last-sexp)
(define-key map "\C-j" 'edebug-eval-print-last-sexp)
- map)
-"Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
+ map)
+ "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
(put 'edebug-eval-mode 'mode-class 'special)
;; since they depend on the backtrace looking a certain way. But
;; edebug is not dependent on this, yet.
-(defun edebug (&optional edebug-arg-mode &rest debugger-args)
+(defun edebug (&optional arg-mode &rest args)
"Replacement for `debug'.
If we are running an edebugged function, show where we last were.
Otherwise call `debug' normally."
-;; (message "entered: %s depth: %s edebug-recursion-depth: %s"
-;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
+ ;;(message "entered: %s depth: %s edebug-recursion-depth: %s"
+ ;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
(if (and edebug-entered ; anything active?
(eq (recursion-depth) edebug-recursion-depth))
(let (;; Where were we before the error occurred?
- (edebug-offset-index (car edebug-offset-indices))
- ;; Bind variables required by edebug-display
- (edebug-value (car debugger-args))
+ (offset-index (car edebug-offset-indices))
+ (value (car args))
+ ;; Bind variables required by edebug--display.
edebug-breakpoints
edebug-break-data
edebug-break-condition
edebug-global-break
- (edebug-break (null edebug-arg-mode)) ;; if called explicitly
+ (edebug-break (null arg-mode)) ;; If called explicitly.
)
- (edebug-display)
- (if (eq edebug-arg-mode 'error)
+ (edebug--display value offset-index arg-mode)
+ (if (eq arg-mode 'error)
nil
- edebug-value))
+ value))
;; Otherwise call debug normally.
;; Still need to remove extraneous edebug calls from stack.
- (apply 'debug edebug-arg-mode debugger-args)
+ (apply 'debug arg-mode args)
))
(null (buffer-name edebug-backtrace-buffer)))
(setq edebug-backtrace-buffer
(generate-new-buffer "*Backtrace*"))
- ;; else, could just display edebug-backtrace-buffer
+ ;; Else, could just display edebug-backtrace-buffer.
)
(with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
(setq edebug-backtrace-buffer standard-output)
(beginning-of-line)
(cond
((looking-at "^ \(edebug-after")
- ;; Previous lines may contain code, so just delete this line
+ ;; Previous lines may contain code, so just delete this line.
(setq last-ok-point (point))
(forward-line 1)
(delete-region last-ok-point (point)))
"In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
The buffer is created if it does not exist.
You must include newlines in FMT to break lines, but one newline is appended."
-;; e.g.
-;; (edebug-trace-display "*trace-point*"
-;; "saving: point = %s window-start = %s"
-;; (point) (window-start))
+ ;; e.g.
+ ;; (edebug-trace-display "*trace-point*"
+ ;; "saving: point = %s window-start = %s"
+ ;; (point) (window-start))
(let* ((oldbuf (current-buffer))
(selected-window (selected-window))
(buffer (get-buffer-create buf-name))
buf-window)
-;; (message "before pop-to-buffer") (sit-for 1)
+ ;; (message "before pop-to-buffer") (sit-for 1)
(edebug-pop-to-buffer buffer)
(setq truncate-lines t)
(setq buf-window (selected-window))
(vertical-motion (- 1 (window-height)))
(set-window-start buf-window (point))
(goto-char (point-max))
-;; (set-window-point buf-window (point))
-;; (edebug-sit-for 0)
+ ;; (set-window-point buf-window (point))
+ ;; (sit-for 0)
(bury-buffer buffer)
(select-window selected-window)
(set-buffer oldbuf))
;; Insert all the indices for this line.
(forward-line 1)
(setq start-of-count-line (point)
- first-index i ; really last index for line above this one.
- last-count -1) ; cause first count to always appear.
+ first-index i ; Really, last index for line above this one.
+ last-count -1) ; Cause first count to always appear.
(insert ";#")
;; i == first-index still
(while (<= (setq i (1+ i)) last-index)
(let ((buffer-read-only nil))
(undo-boundary)
(edebug-display-freq-count)
- (setq unread-command-char (read-char))
+ (setq unread-command-events
+ (append unread-command-events (list (read-event))))
;; Yuck! This doesn't seem to work at all for me.
(undo)))
(edebug-modify-breakpoint t condition arg))
(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
-\f
-;;; Byte-compiler
-
-;; Extension for bytecomp to resolve undefined function references.
-;; Requires new byte compiler.
-
-;; Reenable byte compiler warnings about unread-command-char and -event.
-;; Disabled before edebug-recursive-edit.
-(eval-when-compile
- (if edebug-unread-command-char-warning
- (put 'unread-command-char 'byte-obsolete-variable
- edebug-unread-command-char-warning)))
-
-(eval-when-compile
- ;; The body of eval-when-compile seems to get evaluated with eval-defun.
- ;; We only want to evaluate when actually byte compiling.
- ;; But it is OK to evaluate as long as byte-compiler has been loaded.
- (if (featurep 'byte-compile) (progn
-
- (defun byte-compile-resolve-functions (funcs)
- "Say it is OK for the named functions to be unresolved."
- (mapc
- (function
- (lambda (func)
- (setq byte-compile-unresolved-functions
- (delq (assq func byte-compile-unresolved-functions)
- byte-compile-unresolved-functions))))
- funcs)
- nil)
-
- '(defun byte-compile-resolve-free-references (vars)
- "Say it is OK for the named variables to be referenced."
- (mapcar
- (function
- (lambda (var)
- (setq byte-compile-free-references
- (delq var byte-compile-free-references))))
- vars)
- nil)
-
- '(defun byte-compile-resolve-free-assignments (vars)
- "Say it is OK for the named variables to be assigned."
- (mapcar
- (function
- (lambda (var)
- (setq byte-compile-free-assignments
- (delq var byte-compile-free-assignments))))
- vars)
- nil)
-
- (byte-compile-resolve-functions
- '(reporter-submit-bug-report
- edebug-gensym ;; also in cl.el
- ;; Interfaces to standard functions.
- edebug-original-eval-defun
- edebug-original-read
- edebug-get-buffer-window
- edebug-mark
- edebug-mark-marker
- edebug-input-pending-p
- edebug-sit-for
- edebug-prin1-to-string
- edebug-format
- ;; lemacs
- zmacs-deactivate-region
- popup-menu
- ;; CL
- cl-macroexpand-all
- ;; And believe it or not, the byte compiler doesn't know about:
- byte-compile-resolve-functions
- ))
-
- '(byte-compile-resolve-free-references
- '(read-expression-history
- read-expression-map))
-
- '(byte-compile-resolve-free-assignments
- '(read-expression-history))
-
- )))
-
\f
;;; Autoloading of Edebug accessories
-(if (featurep 'cl)
- (add-hook 'edebug-setup-hook
- (function (lambda () (require 'cl-specs))))
- ;; The following causes cl-specs to be loaded if you load cl.el.
- (add-hook 'cl-load-hook
- (function (lambda () (require 'cl-specs)))))
-
;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
(if (featurep 'cl-read)
(add-hook 'edebug-setup-hook
(concat "*CUSTOMIZE "
(object-name obj) " "
(symbol-name g) "*")))
- (toggle-read-only -1)
+ (setq buffer-read-only nil)
(kill-all-local-variables)
(erase-buffer)
(let ((all (overlay-lists)))
;;; CLASS COMPLETION / DOCUMENTATION
-;;;###autoload
-(defalias 'describe-class 'eieio-describe-class)
+;;;###autoload(defalias 'describe-class 'eieio-describe-class)
;;;###autoload
(defun eieio-describe-class (class &optional headerfcn)
;;; METHOD COMPLETION / DOC
(defalias 'describe-method 'eieio-describe-generic)
-;;;###autoload
-(defalias 'describe-generic 'eieio-describe-generic)
+;;;###autoload(defalias 'describe-generic 'eieio-describe-generic)
(defalias 'eieio-describe-method 'eieio-describe-generic)
;;;###autoload
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
(defvar eieio-version "1.3"
"Current version of EIEIO.")
;;
(defvar eieio-hook nil
- "*This hook is executed, then cleared each time `defclass' is called.")
+ "This hook is executed, then cleared each time `defclass' is called.")
(defvar eieio-error-unsupported-class-tags nil
"Non-nil to throw an error if an encountered tag is unsupported.
since EIEIO does not support all CLOS tags.")
(defvar eieio-skip-typecheck nil
- "*If non-nil, skip all slot typechecking.
+ "If non-nil, skip all slot typechecking.
Set this to t permanently if a program is functioning well to get a
small speed increase. This variable is also used internally to handle
default setting for optimization purposes.")
(run-hooks 'eieio-hook)
(setq eieio-hook nil)
- (if (not (symbolp cname)) (signal 'wrong-type-argument '(symbolp cname)))
- (if (not (listp superclasses)) (signal 'wrong-type-argument '(listp superclasses)))
+ (if (not (listp superclasses))
+ (signal 'wrong-type-argument '(listp superclasses)))
- (let* ((pname (if superclasses superclasses nil))
+ (let* ((pname superclasses)
(newc (make-vector class-num-slots nil))
(oldc (when (class-p cname) (class-v cname)))
(groups nil) ;; list of groups id'd from slots
(put cname 'cl-deftype-handler
(list 'lambda () `(list 'satisfies (quote ,csym)))))
- ;; before adding new slots, let's add all the methods and classes
- ;; in from the parent class
+ ;; Before adding new slots, let's add all the methods and classes
+ ;; in from the parent class.
(eieio-copy-parents-into-subclass newc superclasses)
;; Store the new class vector definition into the symbol. We need to
;; We need to id the group, and store them in a group list attribute.
(mapc (lambda (cg) (add-to-list 'groups cg)) customg)
- ;; anyone can have an accessor function. This creates a function
+ ;; Anyone can have an accessor function. This creates a function
;; of the specified name, and also performs a `defsetf' if applicable
- ;; so that users can `setf' the space returned by this function
+ ;; so that users can `setf' the space returned by this function.
(if acces
(progn
(eieio--defmethod
;; Else - Some error? nil?
nil)))
- ;; Provide a setf method. It would be cleaner to use
- ;; defsetf, but that would require CL at runtime.
- (put acces 'setf-method
- `(lambda (widget)
- (let* ((--widget-sym-- (make-symbol "--widget--"))
- (--store-sym-- (make-symbol "--store--")))
- (list
- (list --widget-sym--)
- (list widget)
- (list --store-sym--)
- (list 'eieio-oset --widget-sym-- '',name --store-sym--)
- (list 'getfoo --widget-sym--)))))))
+ (if (fboundp 'gv-define-setter)
+ ;; FIXME: We should move more of eieio-defclass into the
+ ;; defclass macro so we don't have to use `eval' and require
+ ;; `gv' at run-time.
+ (eval `(gv-define-setter ,acces (eieio--store eieio--object)
+ (list 'eieio-oset eieio--object '',name
+ eieio--store)))
+ ;; Provide a setf method. It would be cleaner to use
+ ;; defsetf, but that would require CL at runtime.
+ (put acces 'setf-method
+ `(lambda (widget)
+ (let* ((--widget-sym-- (make-symbol "--widget--"))
+ (--store-sym-- (make-symbol "--store--")))
+ (list
+ (list --widget-sym--)
+ (list widget)
+ (list --store-sym--)
+ (list 'eieio-oset --widget-sym-- '',name
+ --store-sym--)
+ (list 'getfoo --widget-sym--))))))))
;; If a writer is defined, then create a generic method of that
;; name whose purpose is to set the value of the slot.
)
(setq slots (cdr slots)))
- ;; Now that everything has been loaded up, all our lists are backwards! Fix that up now.
+ ;; Now that everything has been loaded up, all our lists are backwards!
+ ;; Fix that up now.
(aset newc class-public-a (nreverse (aref newc class-public-a)))
(aset newc class-public-d (nreverse (aref newc class-public-d)))
(aset newc class-public-doc (nreverse (aref newc class-public-doc)))
is called, the next method is popped off the stack.")
(defvar eieio-pre-method-execution-hooks nil
- "*Hooks run just before a method is executed.
+ "Abnormal hook run just before an EIEIO method is executed.
The hook function must accept one argument, the list of forms
about to be executed.")
;;; Here are some CLOS items that need the CL package
;;
-(defsetf slot-value (obj slot) (store) (list 'eieio-oset obj slot store))
-(defsetf eieio-oref (obj slot) (store) (list 'eieio-oset obj slot store))
+(defsetf eieio-oref eieio-oset)
+
+(if (eval-when-compile (fboundp 'gv-define-expander))
+ ;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and
+ ;; follows aliases.
+ nil
+(defsetf slot-value eieio-oset)
;; The below setf method was written by Arnd Kohrs <kohrs@acm.org>
(define-setf-method oref (obj slot)
(list store-temp)
(list 'set-slot-value obj-temp slot-temp
store-temp)
- (list 'slot-value obj-temp slot-temp)))))
+ (list 'slot-value obj-temp slot-temp))))))
\f
;;;
;;; Start of automatically extracted autoloads.
\f
;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el"
-;;;;;; "9cf80224540c52045d515a4c2c833543")
+;;;;;; "928623502e8bf40454822355388542b5")
;;; Generated autoloads from eieio-custom.el
(autoload 'customize-object "eieio-custom" "\
\f
;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic
;;;;;; eieio-describe-constructor eieio-describe-class eieio-browse)
-;;;;;; "eieio-opt" "eieio-opt.el" "e2814881441ad23759409687502f0ee1")
+;;;;;; "eieio-opt" "eieio-opt.el" "d808328f9c0156ecbd412d77ba8c569e")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
variable `eieio-default-superclass'.
\(fn &optional ROOT-CLASS)" t nil)
-
(defalias 'describe-class 'eieio-describe-class)
(autoload 'eieio-describe-class "eieio-opt" "\
Uses `eieio-describe-class' to describe the class being constructed.
\(fn FCN)" t nil)
-
(defalias 'describe-generic 'eieio-describe-generic)
(autoload 'eieio-describe-generic "eieio-opt" "\
;;; Code:
+(require 'help-fns)
+
(defgroup elint nil
"Linting for Emacs Lisp."
:prefix "elint-"
(set (make-local-variable 'elint-buffer-env)
(elint-init-env elint-buffer-forms))
(if elint-preloaded-env
+ ;; FIXME: This doesn't do anything! Should we setq the result to
+ ;; elint-buffer-env?
(elint-env-add-env elint-preloaded-env elint-buffer-env))
(set (make-local-variable 'elint-last-env-time) (buffer-modified-tick))
elint-buffer-forms))
(add-to-list 'elint-features name)
;; cl loads cl-macs in an opaque manner.
;; Since cl-macs requires cl, we can just process cl-macs.
+ ;; FIXME: AFAIK, `cl' now behaves properly and does not need any
+ ;; special treatment any more. Can someone who understands this
+ ;; code confirm? --Stef
(and (eq name 'cl) (not elint-doing-cl)
;; We need cl if elint-form is to be able to expand cl macros.
(require 'cl)
(defun elint-find-args-in-code (code)
"Extract the arguments from CODE.
CODE can be a lambda expression, a macro, or byte-compiled code."
- (cond
- ((byte-code-function-p code)
- (aref code 0))
- ((and (listp code) (eq (car code) 'lambda))
- (car (cdr code)))
- ((and (listp code) (eq (car code) 'macro))
- (elint-find-args-in-code (cdr code)))
- (t 'unknown)))
+ (let ((args (help-function-arglist code)))
+ (if (listp args) args 'unknown)))
;;;
;;; Functions to check some special forms
;; the autoload here, since that could have side effects, and
;; elp-instrument-function is similar (in my mind) to defun-ish
;; type functionality (i.e. it shouldn't execute the function).
- (and (eq (car-safe funguts) 'autoload)
+ (and (autoloadp funguts)
(error "ELP cannot profile autoloaded function: %s" funsym))
;; We cannot profile functions used internally during profiling.
(unless (elp-profilable-p funsym)
;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc.
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
-;; Author: Christian Ohler <ohler@gnu.org>
+;; Christian Ohler <ohler@gnu.org>
;; This file is part of GNU Emacs.
-;; 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 (at your option) 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.
-;;
+;; 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 this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file is part of GNU Emacs.
-;; 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 (at your option) 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.
-;;
+;; 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 this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Running tests in batch mode.
(defvar ert-batch-backtrace-right-margin 70
- "*The maximum line length for printing backtraces in `ert-run-tests-batch'.")
+ "The maximum line length for printing backtraces in `ert-run-tests-batch'.")
;;;###autoload
(defun ert-run-tests-batch (&optional selector)
-;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer
+;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer -*- lexical-binding: t -*-
;; Copyright (C) 1991-2012 Free Software Foundation, Inc.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; The doubly linked list is implemented as a circular list with a dummy
;; node first and last. The dummy node is used as "the dll".
-(defstruct (ewoc--node
+(cl-defstruct (ewoc--node
(:type vector) ;ewoc--node-nth needs this
(:constructor nil)
(:constructor ewoc--node-create (start-marker data)))
\f
;;; The ewoc data type
-(defstruct (ewoc
+(cl-defstruct (ewoc
(:constructor nil)
(:constructor ewoc--create (buffer pretty-printer dll))
(:conc-name ewoc--))
(ewoc--adjust m (point) R dll)))
(defun ewoc--wrap (func)
- (lexical-let ((ewoc--user-pp func))
- (lambda (data)
- (funcall ewoc--user-pp data)
- (insert "\n"))))
+ (lambda (data)
+ (funcall func data)
+ (insert "\n")))
\f
;;; ===========================================================================
(if aliases
(message "%s" aliases))
(let ((library
- (cond ((eq (car-safe def) 'autoload)
- (nth 1 def))
+ (cond ((autoloadp def) (nth 1 def))
((subrp def)
(if lisp-only
(error "%s is a built-in function" function))
;; Provide an easy hook to tell if we are running with floats or not.
;; Define pi and e via math-lib calls (much less prone to killer typos).
(defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).")
-(progn
- ;; Simulate a defconst that doesn't declare the variable dynamically bound.
- (setq-default pi float-pi)
- (put 'pi 'variable-documentation
- "Obsolete since Emacs-23.3. Use `float-pi' instead.")
- (put 'pi 'risky-local-variable t)
- (push 'pi current-load-list))
+(defconst pi float-pi
+ "Obsolete since Emacs-23.3. Use `float-pi' instead.")
+(internal-make-var-non-special 'pi)
(defconst float-e (exp 1) "The value of e (2.7182818...).")
;; Internal Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-obsolete-variable-alias 'generic-font-lock-defaults
+ 'generic-font-lock-keywords "22.1")
(defvar generic-font-lock-keywords nil
"Keywords for `font-lock-defaults' in a generic mode.")
(make-variable-buffer-local 'generic-font-lock-keywords)
-(define-obsolete-variable-alias 'generic-font-lock-defaults 'generic-font-lock-keywords "22.1")
;;;###autoload
(defvar generic-mode-list nil
See the file generic-x.el for some examples of `define-generic-mode'."
(declare (debug (sexp def-form def-form def-form form def-form
[&optional stringp] &rest [keywordp form]))
- (indent 1))
+ (indent 1)
+ (doc-string 7))
;; Backward compatibility.
(when (eq (car-safe mode) 'quote)
--- /dev/null
+;;; gv.el --- generalized variables -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords: extensions
+;; Package: emacs
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a re-implementation of the setf machinery using a different
+;; underlying approach than the one used earlier in CL, which was based on
+;; define-setf-expander.
+;; `define-setf-expander' makes every "place-expander" return a 5-tuple
+;; (VARS VALUES STORES GETTER SETTER)
+;; where STORES is a list with a single variable (Common-Lisp allows multiple
+;; variables for use with multiple-return-values, but this is rarely used and
+;; not applicable to Elisp).
+;; It basically says that GETTER is an expression that returns the place's
+;; value, and (lambda STORES SETTER) is an expression that assigns the value(s)
+;; passed to that function to the place, and that you need to wrap the whole
+;; thing within a `(let* ,(zip VARS VALUES) ...).
+;;
+;; Instead, we use here a higher-order approach: instead
+;; of a 5-tuple, a place-expander returns a function.
+;; If you think about types, the old approach return things of type
+;; {vars: List Var, values: List Exp,
+;; stores: List Var, getter: Exp, setter: Exp}
+;; whereas the new approach returns a function of type
+;; (do: ((getter: Exp, setter: ((store: Exp) -> Exp)) -> Exp)) -> Exp.
+;; You can get the new function from the old 5-tuple with something like:
+;; (lambda (do)
+;; `(let* ,(zip VARS VALUES)
+;; (funcall do GETTER (lambda ,STORES ,SETTER))))
+;; You can't easily do the reverse, because this new approach is more
+;; expressive than the old one, so we can't provide a backward-compatible
+;; get-setf-method.
+;;
+;; While it may seem intimidating for people not used to higher-order
+;; functions, you will quickly see that its use (especially with the
+;; `gv-letplace' macro) is actually much easier and more elegant than the old
+;; approach which is clunky and often leads to unreadable code.
+
+;; Food for thought: the syntax of places does not actually conflict with the
+;; pcase patterns. The `cons' gv works just like a `(,a . ,b) pcase
+;; pattern, and actually the `logand' gv is even closer since it should
+;; arguably fail when trying to set a value outside of the mask.
+;; Generally, places are used for destructors (gethash, aref, car, ...)
+;; whereas pcase patterns are used for constructors (backquote, constants,
+;; vectors, ...).
+
+;;; Code:
+
+(require 'macroexp)
+
+;; What we call a "gvar" is basically a function of type "(getter * setter ->
+;; code) -> code", where "getter" is code and setter is "code -> code".
+
+;; (defvar gv--macro-environment nil
+;; "Macro expanders for generalized variables.")
+
+;;;###autoload
+(defun gv-get (place do)
+ "Build the code that applies DO to PLACE.
+PLACE must be a valid generalized variable.
+DO must be a function; it will be called with 2 arguments: GETTER and SETTER,
+where GETTER is a (copyable) Elisp expression that returns the value of PLACE,
+and SETTER is a function which returns the code to set PLACE when called
+with a (not necessarily copyable) Elisp expression that returns the value to
+set it to.
+DO must return an Elisp expression."
+ (if (symbolp place)
+ (funcall do place (lambda (v) `(setq ,place ,v)))
+ (let* ((head (car place))
+ (gf (function-get head 'gv-expander 'autoload)))
+ (if gf (apply gf do (cdr place))
+ (let ((me (macroexpand place ;FIXME: expand one step at a time!
+ ;; (append macroexpand-all-environment
+ ;; gv--macro-environment)
+ macroexpand-all-environment)))
+ (if (and (eq me place) (get head 'compiler-macro))
+ ;; Expand compiler macros: this takes care of all the accessors
+ ;; defined via cl-defsubst, such as cXXXr and defstruct slots.
+ (setq me (apply (get head 'compiler-macro) place (cdr place))))
+ (if (and (eq me place) (fboundp head)
+ (symbolp (symbol-function head)))
+ ;; Follow aliases.
+ (setq me (cons (symbol-function head) (cdr place))))
+ (if (eq me place)
+ (error "%S is not a valid place expression" place)
+ (gv-get me do)))))))
+
+;;;###autoload
+(defmacro gv-letplace (vars place &rest body)
+ "Build the code manipulating the generalized variable PLACE.
+GETTER will be bound to a copyable expression that returns the value
+of PLACE.
+SETTER will be bound to a function that takes an expression V and returns
+and new expression that sets PLACE to V.
+BODY should return some Elisp expression E manipulating PLACE via GETTER
+and SETTER.
+The returned value will then be an Elisp expression that first evaluates
+all the parts of PLACE that can be evaluated and then runs E.
+
+\(fn (GETTER SETTER) PLACE &rest BODY)"
+ (declare (indent 2) (debug (sexp form body)))
+ `(gv-get ,place (lambda ,vars ,@body)))
+
+;; Different ways to declare a generalized variable.
+;;;###autoload
+(defmacro gv-define-expander (name handler)
+ "Use HANDLER to handle NAME as a generalized var.
+NAME is a symbol: the name of a function, macro, or special form.
+HANDLER is a function which takes an argument DO followed by the same
+arguments as NAME. DO is a function as defined in `gv-get'."
+ (declare (indent 1) (debug (sexp form)))
+ ;; Use eval-and-compile so the method can be used in the same file as it
+ ;; is defined.
+ ;; FIXME: Just like byte-compile-macro-environment, we should have something
+ ;; like byte-compile-symbolprop-environment so as to handle these things
+ ;; cleanly without affecting the running Emacs.
+ `(eval-and-compile (put ',name 'gv-expander ,handler)))
+
+;;;###autoload
+(defun gv--defun-declaration (symbol name args handler &optional fix)
+ `(progn
+ ;; No need to autoload this part, since gv-get will auto-load the
+ ;; function's definition before checking the `gv-expander' property.
+ :autoload-end
+ ,(pcase (cons symbol handler)
+ (`(gv-expander . (lambda (,do) . ,body))
+ `(gv-define-expander ,name (lambda (,do ,@args) ,@body)))
+ (`(gv-expander . ,(pred symbolp))
+ `(gv-define-expander ,name #',handler))
+ (`(gv-setter . (lambda (,store) . ,body))
+ `(gv-define-setter ,name (,store ,@args) ,@body))
+ (`(gv-setter . ,(pred symbolp))
+ `(gv-define-simple-setter ,name ,handler ,fix))
+ ;; (`(expand ,expander) `(gv-define-expand ,name ,expander))
+ (_ (message "Unknown %s declaration %S" symbol handler) nil))))
+
+;;;###autoload
+(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander))
+ defun-declarations-alist)
+;;;###autoload
+(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
+ defun-declarations-alist)
+
+;; (defmacro gv-define-expand (name expander)
+;; "Use EXPANDER to handle NAME as a generalized var.
+;; NAME is a symbol: the name of a function, macro, or special form.
+;; EXPANDER is a function that will be called as a macro-expander to reduce
+;; uses of NAME to some other generalized variable."
+;; (declare (debug (sexp form)))
+;; `(eval-and-compile
+;; (if (not (boundp 'gv--macro-environment))
+;; (setq gv--macro-environment nil))
+;; (push (cons ',name ,expander) gv--macro-environment)))
+
+(defun gv--defsetter (name setter do args &optional vars)
+ "Helper function used by code generated by `gv-define-setter'.
+NAME is the name of the getter function.
+SETTER is a function that generates the code for the setter.
+NAME accept ARGS as arguments and SETTER accepts (NEWVAL . ARGS).
+VARS is used internally for recursive calls."
+ (if (null args)
+ (let ((vars (nreverse vars)))
+ (funcall do `(,name ,@vars) (lambda (v) (apply setter v vars))))
+ ;; FIXME: Often it would be OK to skip this `let', but in general,
+ ;; `do' may have all kinds of side-effects.
+ (macroexp-let2 nil v (car args)
+ (gv--defsetter name setter do (cdr args) (cons v vars)))))
+
+;;;###autoload
+(defmacro gv-define-setter (name arglist &rest body)
+ "Define a setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms.
+Assignments of VAL to (NAME ARGS...) are expanded by binding the argument
+forms (VAL ARGS...) according to ARGLIST, then executing BODY, which must
+return a Lisp form that does the assignment.
+The first arg in ARLIST (the one that receives VAL) receives an expression
+which can do arbitrary things, whereas the other arguments are all guaranteed
+to be pure and copyable. Example use:
+ (gv-define-setter aref (v a i) `(aset ,a ,i ,v))"
+ (declare (indent 2) (debug (&define name sexp body)))
+ `(gv-define-expander ,name
+ (lambda (do &rest args)
+ (gv--defsetter ',name (lambda ,arglist ,@body) do args))))
+
+;;;###autoload
+(defmacro gv-define-simple-setter (name setter &optional fix-return)
+ "Define a simple setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms. Assignments of VAL to (NAME ARGS...) are
+turned into calls of the form (SETTER ARGS... VAL).
+If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and
+instead the assignment is turned into (prog1 VAL (SETTER ARGS... VAL))
+so as to preserve the semantics of `setf'."
+ (declare (debug (sexp (&or symbolp lambda-expr) &optional sexp)))
+ (let ((set-call `(cons ',setter (append args (list val)))))
+ `(gv-define-setter ,name (val &rest args)
+ ,(if fix-return `(list 'prog1 val ,set-call) set-call))))
+
+;;; Typical operations on generalized variables.
+
+;;;###autoload
+(defmacro setf (&rest args)
+ "Set each PLACE to the value of its VAL.
+This is a generalized version of `setq'; the PLACEs may be symbolic
+references such as (car x) or (aref x i), as well as plain symbols.
+For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y).
+The return value is the last VAL in the list.
+
+\(fn PLACE VAL PLACE VAL ...)"
+ (declare (debug (gv-place form)))
+ (if (and args (null (cddr args)))
+ (let ((place (pop args))
+ (val (car args)))
+ (gv-letplace (_getter setter) place
+ (funcall setter val)))
+ (let ((sets nil))
+ (while args (push `(setf ,(pop args) ,(pop args)) sets))
+ (cons 'progn (nreverse sets)))))
+
+;; (defmacro gv-pushnew! (val place)
+;; "Like `gv-push!' but only adds VAL if it's not yet in PLACE.
+;; Presence is checked with `member'.
+;; The return value is unspecified."
+;; (declare (debug (form gv-place)))
+;; (macroexp-let2 macroexp-copyable-p v val
+;; (gv-letplace (getter setter) place
+;; `(if (member ,v ,getter) nil
+;; ,(funcall setter `(cons ,v ,getter))))))
+
+;; (defmacro gv-inc! (place &optional val)
+;; "Increment PLACE by VAL (default to 1)."
+;; (declare (debug (gv-place &optional form)))
+;; (gv-letplace (getter setter) place
+;; (funcall setter `(+ ,getter ,(or val 1)))))
+
+;; (defmacro gv-dec! (place &optional val)
+;; "Decrement PLACE by VAL (default to 1)."
+;; (declare (debug (gv-place &optional form)))
+;; (gv-letplace (getter setter) place
+;; (funcall setter `(- ,getter ,(or val 1)))))
+
+;; For Edebug, the idea is to let Edebug instrument gv-places just like it does
+;; for normal expressions, and then give it a gv-expander to DTRT.
+;; Maybe this should really be in edebug.el rather than here.
+
+;; Autoload this `put' since a user might use C-u C-M-x on an expression
+;; containing a non-trivial `push' even before gv.el was loaded.
+;;;###autoload
+(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+;; CL did the equivalent of:
+;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
+
+(put 'edebug-after 'gv-expander
+ (lambda (do before index place)
+ (gv-letplace (getter setter) place
+ (funcall do `(edebug-after ,before ,index ,getter)
+ setter))))
+
+;;; The common generalized variables.
+
+(gv-define-simple-setter aref aset)
+(gv-define-simple-setter car setcar)
+(gv-define-simple-setter cdr setcdr)
+;; FIXME: add compiler-macros for `cXXr' instead!
+(gv-define-setter caar (val x) `(setcar (car ,x) ,val))
+(gv-define-setter cadr (val x) `(setcar (cdr ,x) ,val))
+(gv-define-setter cdar (val x) `(setcdr (car ,x) ,val))
+(gv-define-setter cddr (val x) `(setcdr (cdr ,x) ,val))
+(gv-define-setter elt (store seq n)
+ `(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store)
+ (aset ,seq ,n ,store)))
+(gv-define-simple-setter get put)
+(gv-define-setter gethash (val k h &optional _d) `(puthash ,k ,val ,h))
+
+;; (gv-define-expand nth (lambda (idx list) `(car (nthcdr ,idx ,list))))
+(put 'nth 'gv-expander
+ (lambda (do idx list)
+ (macroexp-let2 nil c `(nthcdr ,idx ,list)
+ (funcall do `(car ,c) (lambda (v) `(setcar ,c ,v))))))
+(gv-define-simple-setter symbol-function fset)
+(gv-define-simple-setter symbol-plist setplist)
+(gv-define-simple-setter symbol-value set)
+
+(put 'nthcdr 'gv-expander
+ (lambda (do n place)
+ (macroexp-let2 nil idx n
+ (gv-letplace (getter setter) place
+ (funcall do `(nthcdr ,idx ,getter)
+ (lambda (v) `(if (<= ,idx 0) ,(funcall setter v)
+ (setcdr (nthcdr (1- ,idx) ,getter) ,v))))))))
+
+;;; Elisp-specific generalized variables.
+
+(gv-define-simple-setter default-value set-default)
+(gv-define-simple-setter frame-parameter set-frame-parameter 'fix)
+(gv-define-simple-setter terminal-parameter set-terminal-parameter)
+(gv-define-simple-setter keymap-parent set-keymap-parent)
+(gv-define-simple-setter match-data set-match-data 'fix)
+(gv-define-simple-setter overlay-get overlay-put)
+(gv-define-setter overlay-start (store ov)
+ `(progn (move-overlay ,ov ,store (overlay-end ,ov)) ,store))
+(gv-define-setter overlay-end (store ov)
+ `(progn (move-overlay ,ov (overlay-start ,ov) ,store) ,store))
+(gv-define-simple-setter process-buffer set-process-buffer)
+(gv-define-simple-setter process-filter set-process-filter)
+(gv-define-simple-setter process-sentinel set-process-sentinel)
+(gv-define-simple-setter process-get process-put)
+(gv-define-simple-setter window-buffer set-window-buffer)
+(gv-define-simple-setter window-display-table set-window-display-table 'fix)
+(gv-define-simple-setter window-dedicated-p set-window-dedicated-p)
+(gv-define-simple-setter window-hscroll set-window-hscroll)
+(gv-define-simple-setter window-parameter set-window-parameter)
+(gv-define-simple-setter window-point set-window-point)
+(gv-define-simple-setter window-start set-window-start)
+
+;;; Some occasionally handy extensions.
+
+;; While several of the "places" below are not terribly useful for direct use,
+;; they can show up as the output of the macro expansion of reasonable places,
+;; such as struct-accessors.
+
+(put 'progn 'gv-expander
+ (lambda (do &rest exps)
+ (let ((start (butlast exps))
+ (end (car (last exps))))
+ (if (null start) (gv-get end do)
+ `(progn ,@start ,(gv-get end do))))))
+
+(let ((let-expander
+ (lambda (letsym)
+ (lambda (do bindings &rest body)
+ `(,letsym ,bindings
+ ,@(macroexp-unprogn
+ (gv-get (macroexp-progn body) do)))))))
+ (put 'let 'gv-expander (funcall let-expander 'let))
+ (put 'let* 'gv-expander (funcall let-expander 'let*)))
+
+(put 'if 'gv-expander
+ (lambda (do test then &rest else)
+ (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy)))
+ ;; This duplicates the `do' code, which is a problem if that
+ ;; code is large, but otherwise results in more efficient code.
+ `(if ,test ,(gv-get then do)
+ ,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
+ (let ((v (make-symbol "v")))
+ (macroexp-let2 nil
+ gv `(if ,test ,(gv-letplace (getter setter) then
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v))))
+ ,(gv-letplace (getter setter) (macroexp-progn else)
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v)))))
+ (funcall do `(funcall (car ,gv))
+ (lambda (v) `(funcall (cdr ,gv) ,v))))))))
+
+(put 'cond 'gv-expander
+ (lambda (do &rest branches)
+ (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy)))
+ ;; This duplicates the `do' code, which is a problem if that
+ ;; code is large, but otherwise results in more efficient code.
+ `(cond
+ ,@(mapcar (lambda (branch)
+ (if (cdr branch)
+ (cons (car branch)
+ (macroexp-unprogn
+ (gv-get (macroexp-progn (cdr branch)) do)))
+ (gv-get (car branch) do)))
+ branches))
+ (let ((v (make-symbol "v")))
+ (macroexp-let2 nil
+ gv `(cond
+ ,@(mapcar
+ (lambda (branch)
+ (if (cdr branch)
+ `(,(car branch)
+ ,@(macroexp-unprogn
+ (gv-letplace (getter setter)
+ (macroexp-progn (cdr branch))
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v))))))
+ (gv-letplace (getter setter)
+ (car branch)
+ `(cons (lambda () ,getter)
+ (lambda (,v) ,(funcall setter v))))))
+ branches))
+ (funcall do `(funcall (car ,gv))
+ (lambda (v) `(funcall (cdr ,gv) ,v))))))))
+
+;;; Even more debatable extensions.
+
+(put 'cons 'gv-expander
+ (lambda (do a d)
+ (gv-letplace (agetter asetter) a
+ (gv-letplace (dgetter dsetter) d
+ (funcall do
+ `(cons ,agetter ,dgetter)
+ (lambda (v) `(progn
+ ,(funcall asetter `(car ,v))
+ ,(funcall dsetter `(cdr ,v)))))))))
+
+(put 'logand 'gv-expander
+ (lambda (do place &rest masks)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 macroexp-copyable-p
+ mask (if (cdr masks) `(logand ,@masks) (car masks))
+ (funcall
+ do `(logand ,getter ,mask)
+ (lambda (v)
+ (funcall setter
+ `(logior (logand ,v ,mask)
+ (logand ,getter (lognot ,mask))))))))))
+
+;;; Vaguely related definitions that should be moved elsewhere.
+
+;; (defun alist-get (key alist)
+;; "Get the value associated to KEY in ALIST."
+;; (declare
+;; (gv-expander
+;; (lambda (do)
+;; (macroexp-let2 macroexp-copyable-p k key
+;; (gv-letplace (getter setter) alist
+;; (macroexp-let2 nil p `(assoc ,k ,getter)
+;; (funcall do `(cdr ,p)
+;; (lambda (v)
+;; `(if ,p (setcdr ,p ,v)
+;; ,(funcall setter
+;; `(cons (cons ,k ,v) ,getter)))))))))))
+;; (cdr (assoc key alist)))
+
+(provide 'gv)
+;;; gv.el ends here
(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
;; This was originally in autoload.el and is still used there.
(put 'autoload 'doc-string-elt 3)
-(put 'defun 'doc-string-elt 3)
-(put 'defun* 'doc-string-elt 3)
(put 'defmethod 'doc-string-elt 3)
(put 'defvar 'doc-string-elt 3)
-(put 'defcustom 'doc-string-elt 3)
-(put 'deftheme 'doc-string-elt 2)
-(put 'deftype 'doc-string-elt 3)
(put 'defconst 'doc-string-elt 3)
-(put 'defmacro 'doc-string-elt 3)
-(put 'defmacro* 'doc-string-elt 3)
-(put 'defsubst 'doc-string-elt 3)
-(put 'defstruct 'doc-string-elt 2)
-(put 'define-skeleton 'doc-string-elt 2)
-(put 'define-derived-mode 'doc-string-elt 4)
-(put 'define-compilation-mode 'doc-string-elt 3)
-(put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
-(put 'define-minor-mode 'doc-string-elt 2)
-(put 'easy-mmode-define-global-mode 'doc-string-elt 2)
-(put 'define-global-minor-mode 'doc-string-elt 2)
-(put 'define-globalized-minor-mode 'doc-string-elt 2)
-(put 'define-generic-mode 'doc-string-elt 7)
-(put 'define-ibuffer-filter 'doc-string-elt 2)
-(put 'define-ibuffer-op 'doc-string-elt 3)
-(put 'define-ibuffer-sorter 'doc-string-elt 2)
-(put 'lambda 'doc-string-elt 2)
(put 'defalias 'doc-string-elt 3)
(put 'defvaralias 'doc-string-elt 3)
(put 'define-category 'doc-string-elt 2)
-(put 'define-overloadable-function 'doc-string-elt 3)
(defvar lisp-doc-string-elt-property 'doc-string-elt
"The symbol property that holds the docstring position info.")
(goto-char listbeg)
(and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
(match-string 1)))))
- (docelt (and firstsym (get (intern-soft firstsym)
+ (docelt (and firstsym
+ (function-get (intern-soft firstsym)
lisp-doc-string-elt-property))))
(if (and docelt
;; It's a string in a form that can have a docstring.
(define-key map "\e\t" 'completion-at-point)
(define-key map "\e\C-x" 'eval-defun)
(define-key map "\e\C-q" 'indent-pp-sexp)
- (define-key map [menu-bar emacs-lisp] (cons (purecopy "Emacs-Lisp") menu-map))
- (define-key menu-map [eldoc]
- `(menu-item ,(purecopy "Auto-Display Documentation Strings") eldoc-mode
+ (bindings--define-key map [menu-bar emacs-lisp]
+ (cons "Emacs-Lisp" menu-map))
+ (bindings--define-key menu-map [eldoc]
+ '(menu-item "Auto-Display Documentation Strings" eldoc-mode
:button (:toggle . (bound-and-true-p eldoc-mode))
- :help ,(purecopy "Display the documentation string for the item under cursor")))
- (define-key menu-map [checkdoc]
- `(menu-item ,(purecopy "Check Documentation Strings") checkdoc
- :help ,(purecopy "Check documentation strings for style requirements")))
- (define-key menu-map [re-builder]
- `(menu-item ,(purecopy "Construct Regexp") re-builder
- :help ,(purecopy "Construct a regexp interactively")))
- (define-key menu-map [tracing] (cons (purecopy "Tracing") tracing-map))
- (define-key tracing-map [tr-a]
- `(menu-item ,(purecopy "Untrace All") untrace-all
- :help ,(purecopy "Untrace all currently traced functions")))
- (define-key tracing-map [tr-uf]
- `(menu-item ,(purecopy "Untrace Function...") untrace-function
- :help ,(purecopy "Untrace function, and possibly activate all remaining advice")))
- (define-key tracing-map [tr-sep] menu-bar-separator)
- (define-key tracing-map [tr-q]
- `(menu-item ,(purecopy "Trace Function Quietly...") trace-function-background
- :help ,(purecopy "Trace the function with trace output going quietly to a buffer")))
- (define-key tracing-map [tr-f]
- `(menu-item ,(purecopy "Trace Function...") trace-function
- :help ,(purecopy "Trace the function given as an argument")))
- (define-key menu-map [profiling] (cons (purecopy "Profiling") prof-map))
- (define-key prof-map [prof-restall]
- `(menu-item ,(purecopy "Remove Instrumentation for All Functions") elp-restore-all
- :help ,(purecopy "Restore the original definitions of all functions being profiled")))
- (define-key prof-map [prof-restfunc]
- `(menu-item ,(purecopy "Remove Instrumentation for Function...") elp-restore-function
- :help ,(purecopy "Restore an instrumented function to its original definition")))
-
- (define-key prof-map [sep-rem] menu-bar-separator)
- (define-key prof-map [prof-resall]
- `(menu-item ,(purecopy "Reset Counters for All Functions") elp-reset-all
- :help ,(purecopy "Reset the profiling information for all functions being profiled")))
- (define-key prof-map [prof-resfunc]
- `(menu-item ,(purecopy "Reset Counters for Function...") elp-reset-function
- :help ,(purecopy "Reset the profiling information for a function")))
- (define-key prof-map [prof-res]
- `(menu-item ,(purecopy "Show Profiling Results") elp-results
- :help ,(purecopy "Display current profiling results")))
- (define-key prof-map [prof-pack]
- `(menu-item ,(purecopy "Instrument Package...") elp-instrument-package
- :help ,(purecopy "Instrument for profiling all function that start with a prefix")))
- (define-key prof-map [prof-func]
- `(menu-item ,(purecopy "Instrument Function...") elp-instrument-function
- :help ,(purecopy "Instrument a function for profiling")))
- (define-key menu-map [lint] (cons (purecopy "Linting") lint-map))
- (define-key lint-map [lint-di]
- `(menu-item ,(purecopy "Lint Directory...") elint-directory
- :help ,(purecopy "Lint a directory")))
- (define-key lint-map [lint-f]
- `(menu-item ,(purecopy "Lint File...") elint-file
- :help ,(purecopy "Lint a file")))
- (define-key lint-map [lint-b]
- `(menu-item ,(purecopy "Lint Buffer") elint-current-buffer
- :help ,(purecopy "Lint the current buffer")))
- (define-key lint-map [lint-d]
- `(menu-item ,(purecopy "Lint Defun") elint-defun
- :help ,(purecopy "Lint the function at point")))
- (define-key menu-map [edebug-defun]
- `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun
- :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug")
- :keys ,(purecopy "C-u C-M-x")))
- (define-key menu-map [separator-byte] menu-bar-separator)
- (define-key menu-map [disas]
- `(menu-item ,(purecopy "Disassemble Byte Compiled Object...") disassemble
- :help ,(purecopy "Print disassembled code for OBJECT in a buffer")))
- (define-key menu-map [byte-recompile]
- `(menu-item ,(purecopy "Byte-recompile Directory...") byte-recompile-directory
- :help ,(purecopy "Recompile every `.el' file in DIRECTORY that needs recompilation")))
- (define-key menu-map [emacs-byte-compile-and-load]
- `(menu-item ,(purecopy "Byte-compile and Load") emacs-lisp-byte-compile-and-load
- :help ,(purecopy "Byte-compile the current file (if it has changed), then load compiled code")))
- (define-key menu-map [byte-compile]
- `(menu-item ,(purecopy "Byte-compile This File") emacs-lisp-byte-compile
- :help ,(purecopy "Byte compile the file containing the current buffer")))
- (define-key menu-map [separator-eval] menu-bar-separator)
- (define-key menu-map [ielm]
- `(menu-item ,(purecopy "Interactive Expression Evaluation") ielm
- :help ,(purecopy "Interactively evaluate Emacs Lisp expressions")))
- (define-key menu-map [eval-buffer]
- `(menu-item ,(purecopy "Evaluate Buffer") eval-buffer
- :help ,(purecopy "Execute the current buffer as Lisp code")))
- (define-key menu-map [eval-region]
- `(menu-item ,(purecopy "Evaluate Region") eval-region
- :help ,(purecopy "Execute the region as Lisp code")
+ :help "Display the documentation string for the item under cursor"))
+ (bindings--define-key menu-map [checkdoc]
+ '(menu-item "Check Documentation Strings" checkdoc
+ :help "Check documentation strings for style requirements"))
+ (bindings--define-key menu-map [re-builder]
+ '(menu-item "Construct Regexp" re-builder
+ :help "Construct a regexp interactively"))
+ (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
+ (bindings--define-key tracing-map [tr-a]
+ '(menu-item "Untrace All" untrace-all
+ :help "Untrace all currently traced functions"))
+ (bindings--define-key tracing-map [tr-uf]
+ '(menu-item "Untrace Function..." untrace-function
+ :help "Untrace function, and possibly activate all remaining advice"))
+ (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
+ (bindings--define-key tracing-map [tr-q]
+ '(menu-item "Trace Function Quietly..." trace-function-background
+ :help "Trace the function with trace output going quietly to a buffer"))
+ (bindings--define-key tracing-map [tr-f]
+ '(menu-item "Trace Function..." trace-function
+ :help "Trace the function given as an argument"))
+ (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
+ (bindings--define-key prof-map [prof-restall]
+ '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
+ :help "Restore the original definitions of all functions being profiled"))
+ (bindings--define-key prof-map [prof-restfunc]
+ '(menu-item "Remove Instrumentation for Function..." elp-restore-function
+ :help "Restore an instrumented function to its original definition"))
+
+ (bindings--define-key prof-map [sep-rem] menu-bar-separator)
+ (bindings--define-key prof-map [prof-resall]
+ '(menu-item "Reset Counters for All Functions" elp-reset-all
+ :help "Reset the profiling information for all functions being profiled"))
+ (bindings--define-key prof-map [prof-resfunc]
+ '(menu-item "Reset Counters for Function..." elp-reset-function
+ :help "Reset the profiling information for a function"))
+ (bindings--define-key prof-map [prof-res]
+ '(menu-item "Show Profiling Results" elp-results
+ :help "Display current profiling results"))
+ (bindings--define-key prof-map [prof-pack]
+ '(menu-item "Instrument Package..." elp-instrument-package
+ :help "Instrument for profiling all function that start with a prefix"))
+ (bindings--define-key prof-map [prof-func]
+ '(menu-item "Instrument Function..." elp-instrument-function
+ :help "Instrument a function for profiling"))
+ (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
+ (bindings--define-key lint-map [lint-di]
+ '(menu-item "Lint Directory..." elint-directory
+ :help "Lint a directory"))
+ (bindings--define-key lint-map [lint-f]
+ '(menu-item "Lint File..." elint-file
+ :help "Lint a file"))
+ (bindings--define-key lint-map [lint-b]
+ '(menu-item "Lint Buffer" elint-current-buffer
+ :help "Lint the current buffer"))
+ (bindings--define-key lint-map [lint-d]
+ '(menu-item "Lint Defun" elint-defun
+ :help "Lint the function at point"))
+ (bindings--define-key menu-map [edebug-defun]
+ '(menu-item "Instrument Function for Debugging" edebug-defun
+ :help "Evaluate the top level form point is in, stepping through with Edebug"
+ :keys "C-u C-M-x"))
+ (bindings--define-key menu-map [separator-byte] menu-bar-separator)
+ (bindings--define-key menu-map [disas]
+ '(menu-item "Disassemble Byte Compiled Object..." disassemble
+ :help "Print disassembled code for OBJECT in a buffer"))
+ (bindings--define-key menu-map [byte-recompile]
+ '(menu-item "Byte-recompile Directory..." byte-recompile-directory
+ :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
+ (bindings--define-key menu-map [emacs-byte-compile-and-load]
+ '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
+ :help "Byte-compile the current file (if it has changed), then load compiled code"))
+ (bindings--define-key menu-map [byte-compile]
+ '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
+ :help "Byte compile the file containing the current buffer"))
+ (bindings--define-key menu-map [separator-eval] menu-bar-separator)
+ (bindings--define-key menu-map [ielm]
+ '(menu-item "Interactive Expression Evaluation" ielm
+ :help "Interactively evaluate Emacs Lisp expressions"))
+ (bindings--define-key menu-map [eval-buffer]
+ '(menu-item "Evaluate Buffer" eval-buffer
+ :help "Execute the current buffer as Lisp code"))
+ (bindings--define-key menu-map [eval-region]
+ '(menu-item "Evaluate Region" eval-region
+ :help "Execute the region as Lisp code"
:enable mark-active))
- (define-key menu-map [eval-sexp]
- `(menu-item ,(purecopy "Evaluate Last S-expression") eval-last-sexp
- :help ,(purecopy "Evaluate sexp before point; print value in minibuffer")))
- (define-key menu-map [separator-format] menu-bar-separator)
- (define-key menu-map [comment-region]
- `(menu-item ,(purecopy "Comment Out Region") comment-region
- :help ,(purecopy "Comment or uncomment each line in the region")
+ (bindings--define-key menu-map [eval-sexp]
+ '(menu-item "Evaluate Last S-expression" eval-last-sexp
+ :help "Evaluate sexp before point; print value in minibuffer"))
+ (bindings--define-key menu-map [separator-format] menu-bar-separator)
+ (bindings--define-key menu-map [comment-region]
+ '(menu-item "Comment Out Region" comment-region
+ :help "Comment or uncomment each line in the region"
:enable mark-active))
- (define-key menu-map [indent-region]
- `(menu-item ,(purecopy "Indent Region") indent-region
- :help ,(purecopy "Indent each nonblank line in the region")
+ (bindings--define-key menu-map [indent-region]
+ '(menu-item "Indent Region" indent-region
+ :help "Indent each nonblank line in the region"
:enable mark-active))
- (define-key menu-map [indent-line]
- `(menu-item ,(purecopy "Indent Line") lisp-indent-line))
+ (bindings--define-key menu-map [indent-line]
+ '(menu-item "Indent Line" lisp-indent-line))
map)
"Keymap for Emacs Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
(add-hook 'completion-at-point-functions
'lisp-completion-at-point nil 'local))
+;;; Emacs Lisp Byte-Code mode
+
+(eval-and-compile
+ (defconst emacs-list-byte-code-comment-re
+ (concat "\\(#\\)@\\([0-9]+\\) "
+ ;; Make sure it's a docstring and not a lazy-loaded byte-code.
+ "\\(?:[^(]\\|([^\"]\\)")))
+
+(defun emacs-lisp-byte-code-comment (end &optional _point)
+ "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
+ (let ((ppss (syntax-ppss)))
+ (when (and (nth 4 ppss)
+ (eq (char-after (nth 8 ppss)) ?#))
+ (let* ((n (save-excursion
+ (goto-char (nth 8 ppss))
+ (when (looking-at emacs-list-byte-code-comment-re)
+ (string-to-number (match-string 2)))))
+ ;; `maxdiff' tries to make sure the loop below terminates.
+ (maxdiff n))
+ (when n
+ (let* ((bchar (match-end 2))
+ (b (position-bytes bchar)))
+ (goto-char (+ b n))
+ (while (let ((diff (- (position-bytes (point)) b n)))
+ (unless (zerop diff)
+ (when (> diff maxdiff) (setq diff maxdiff))
+ (forward-char (- diff))
+ (setq maxdiff (if (> diff 0) diff
+ (max (1- maxdiff) 1)))
+ t))))
+ (if (<= (point) end)
+ (put-text-property (1- (point)) (point)
+ 'syntax-table
+ (string-to-syntax "> b"))
+ (goto-char end)))))))
+
+(defun emacs-lisp-byte-code-syntax-propertize (start end)
+ (emacs-lisp-byte-code-comment end (point))
+ (funcall
+ (syntax-propertize-rules
+ (emacs-list-byte-code-comment-re
+ (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point))))))
+ start end))
+
+(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode))
+(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode
+ "Elisp-Byte-Code"
+ "Major mode for *.elc files."
+ ;; TODO: Add way to disassemble byte-code under point.
+ (setq-local open-paren-in-column-0-is-defun-start nil)
+ (setq-local syntax-propertize-function
+ #'emacs-lisp-byte-code-syntax-propertize))
+
+;;; Generic Lisp mode.
+
(defvar lisp-mode-map
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap "Lisp")))
(set-keymap-parent map lisp-mode-shared-map)
(define-key map "\e\C-x" 'lisp-eval-defun)
(define-key map "\C-c\C-z" 'run-lisp)
- (define-key map [menu-bar lisp] (cons (purecopy "Lisp") menu-map))
- (define-key menu-map [run-lisp]
- `(menu-item ,(purecopy "Run inferior Lisp") run-lisp
- :help ,(purecopy "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'")))
- (define-key menu-map [ev-def]
- `(menu-item ,(purecopy "Eval defun") lisp-eval-defun
- :help ,(purecopy "Send the current defun to the Lisp process made by M-x run-lisp")))
- (define-key menu-map [ind-sexp]
- `(menu-item ,(purecopy "Indent sexp") indent-sexp
- :help ,(purecopy "Indent each line of the list starting just after point")))
+ (bindings--define-key map [menu-bar lisp] (cons "Lisp" menu-map))
+ (bindings--define-key menu-map [run-lisp]
+ '(menu-item "Run inferior Lisp" run-lisp
+ :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"))
+ (bindings--define-key menu-map [ev-def]
+ '(menu-item "Eval defun" lisp-eval-defun
+ :help "Send the current defun to the Lisp process made by M-x run-lisp"))
+ (bindings--define-key menu-map [ind-sexp]
+ '(menu-item "Indent sexp" indent-sexp
+ :help "Indent each line of the list starting just after point"))
map)
"Keymap for ordinary Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
(define-key map "\e\C-q" 'indent-pp-sexp)
(define-key map "\e\t" 'completion-at-point)
(define-key map "\n" 'eval-print-last-sexp)
- (define-key map [menu-bar lisp-interaction] (cons (purecopy "Lisp-Interaction") menu-map))
- (define-key menu-map [eval-defun]
- `(menu-item ,(purecopy "Evaluate Defun") eval-defun
- :help ,(purecopy "Evaluate the top-level form containing point, or after point")))
- (define-key menu-map [eval-print-last-sexp]
- `(menu-item ,(purecopy "Evaluate and Print") eval-print-last-sexp
- :help ,(purecopy "Evaluate sexp before point; print value into current buffer")))
- (define-key menu-map [edebug-defun-lisp-interaction]
- `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun
- :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug")
- :keys ,(purecopy "C-u C-M-x")))
- (define-key menu-map [indent-pp-sexp]
- `(menu-item ,(purecopy "Indent or Pretty-Print") indent-pp-sexp
- :help ,(purecopy "Indent each line of the list starting just after point, or prettyprint it")))
- (define-key menu-map [complete-symbol]
- `(menu-item ,(purecopy "Complete Lisp Symbol") completion-at-point
- :help ,(purecopy "Perform completion on Lisp symbol preceding point")))
+ (bindings--define-key map [menu-bar lisp-interaction]
+ (cons "Lisp-Interaction" menu-map))
+ (bindings--define-key menu-map [eval-defun]
+ '(menu-item "Evaluate Defun" eval-defun
+ :help "Evaluate the top-level form containing point, or after point"))
+ (bindings--define-key menu-map [eval-print-last-sexp]
+ '(menu-item "Evaluate and Print" eval-print-last-sexp
+ :help "Evaluate sexp before point; print value into current buffer"))
+ (bindings--define-key menu-map [edebug-defun-lisp-interaction]
+ '(menu-item "Instrument Function for Debugging" edebug-defun
+ :help "Evaluate the top level form point is in, stepping through with Edebug"
+ :keys "C-u C-M-x"))
+ (bindings--define-key menu-map [indent-pp-sexp]
+ '(menu-item "Indent or Pretty-Print" indent-pp-sexp
+ :help "Indent each line of the list starting just after point, or prettyprint it"))
+ (bindings--define-key menu-map [complete-symbol]
+ '(menu-item "Complete Lisp Symbol" completion-at-point
+ :help "Perform completion on Lisp symbol preceding point"))
map)
"Keymap for Lisp Interaction mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
(let ((vars ()))
(goto-char (point-min))
(while (re-search-forward
- "^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
+ "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
pos t)
(let ((var (intern (match-string 1))))
- (unless (special-variable-p var)
+ (and (not (special-variable-p var))
+ (save-excursion
+ (zerop (car (syntax-ppss (match-beginning 0)))))
(push var vars))))
`(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
(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)
With argument, insert value in current buffer after the defun.
Return the result of evaluation."
- (interactive "P")
;; FIXME: the print-length/level bindings should only be applied while
;; printing, not while evaluating.
(let ((debug-on-error eval-expression-debug-on-error)
(end-of-defun)
(beginning-of-defun)
(setq beg (point))
- (setq form (eval-sexp-add-defvars (read (current-buffer))))
+ (setq form (read (current-buffer)))
(setq end (point)))
;; Alter the form if necessary.
- (setq form (eval-defun-1 (macroexpand form)))
+ (setq form (eval-sexp-add-defvars (eval-defun-1 (macroexpand form))))
(list beg end standard-output
`(lambda (ignore)
;; Skipping to the end of the specified region
(if (or (null indent) (looking-at "\\s<\\s<\\s<"))
;; Don't alter indentation of a ;;; comment line
;; or a line that starts in a string.
+ ;; FIXME: inconsistency: comment-indent moves ;;; to column 0.
(goto-char (- (point-max) pos))
(if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
;; Single-semicolon comment lines should be indented
;; If initial point was within line's indentation,
;; position after the indentation. Else stay at same point in text.
(if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos)))
- ;; If desired, shift remaining lines of expression the same amount.
- (and whole-exp (not (zerop shift-amt))
- (save-excursion
- (goto-char beg)
- (forward-sexp 1)
- (setq end (point))
- (goto-char beg)
- (forward-line 1)
- (setq beg (point))
- (> end beg))
- (indent-code-rigidly beg end shift-amt)))))
+ (goto-char (- (point-max) pos))))))
(defvar calculate-lisp-indent-last-sexp)
(let ((function (buffer-substring (point)
(progn (forward-sexp 1) (point))))
method)
- (setq method (or (get (intern-soft function) 'lisp-indent-function)
+ (setq method (or (function-get (intern-soft function)
+ 'lisp-indent-function)
(get (intern-soft function) 'lisp-indent-hook)))
(cond ((or (eq method 'defun)
(and (null method)
;; like defun if the first form is placed on the next line, otherwise
;; it is indented like any other form (i.e. forms line up under first).
-(put 'lambda 'lisp-indent-function 'defun)
(put 'autoload 'lisp-indent-function 'defun)
(put 'progn 'lisp-indent-function 0)
(put 'prog1 'lisp-indent-function 1)
(put 'prog2 'lisp-indent-function 2)
(put 'save-excursion 'lisp-indent-function 0)
(put 'save-restriction 'lisp-indent-function 0)
-(put 'save-match-data 'lisp-indent-function 0)
(put 'save-current-buffer 'lisp-indent-function 0)
(put 'let 'lisp-indent-function 1)
(put 'let* 'lisp-indent-function 1)
;; Try first in this order for the sake of languages with nested
;; functions where several can end at the same place as with
;; the offside rule, e.g. Python.
- (beginning-of-defun)
+
+ ;; Finding the start of the function is a bit problematic since
+ ;; `beginning-of-defun' when we are on the first character of
+ ;; the function might go to the previous function.
+ ;;
+ ;; Therefore we first move one character forward and then call
+ ;; `beginning-of-defun'. However now we must check that we did
+ ;; not move into the next function.
+ (let ((here (point)))
+ (unless (eolp)
+ (forward-char))
+ (beginning-of-defun)
+ (when (< (point) here)
+ (goto-char here)
+ (beginning-of-defun)))
(setq beg (point))
(end-of-defun)
(setq end (point))
-;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*-
+;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t; coding: utf-8 -*-
;;
;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;
;;; Code:
-(eval-when-compile (require 'cl))
-
;; Bound by the top-level `macroexpand-all', and modified to include any
;; macros defined by `defmacro'.
(defvar macroexpand-all-environment nil)
-(defun maybe-cons (car cdr original-cons)
+(defun macroexp--cons (car cdr original-cons)
"Return (CAR . CDR), using ORIGINAL-CONS if possible."
(if (and (eq car (car original-cons)) (eq cdr (cdr original-cons)))
original-cons
;; We use this special macro to iteratively process forms and share list
;; structure of the result with the input. Doing so recursively using
-;; `maybe-cons' results in excessively deep recursion for very long
+;; `macroexp--cons' results in excessively deep recursion for very long
;; input forms.
-(defmacro macroexp-accumulate (var+list &rest body)
+(defmacro macroexp--accumulate (var+list &rest body)
"Return a list of the results of evaluating BODY for each element of LIST.
Evaluate BODY with VAR bound to each `car' from LIST, in turn.
Return a list of the values of the final form in BODY.
(,unshared nil)
(,tail ,shared)
,var ,new-el)
- (while ,tail
+ (while (consp ,tail)
(setq ,var (car ,tail)
,new-el (progn ,@body))
(unless (eq ,var ,new-el)
(setq ,tail (cdr ,tail)))
(nconc (nreverse ,unshared) ,shared))))
-(defun macroexpand-all-forms (forms &optional skip)
+(defun macroexp--all-forms (forms &optional skip)
"Return FORMS with macros expanded. FORMS is a list of forms.
If SKIP is non-nil, then don't expand that many elements at the start of
FORMS."
- (macroexp-accumulate (form forms)
+ (macroexp--accumulate (form forms)
(if (or (null skip) (zerop skip))
- (macroexpand-all-1 form)
+ (macroexp--expand-all form)
(setq skip (1- skip))
form)))
-(defun macroexpand-all-clauses (clauses &optional skip)
+(defun macroexp--all-clauses (clauses &optional skip)
"Return CLAUSES with macros expanded.
CLAUSES is a list of lists of forms; any clause that's not a list is ignored.
If SKIP is non-nil, then don't expand that many elements at the start of
each clause."
- (macroexp-accumulate (clause clauses)
+ (macroexp--accumulate (clause clauses)
(if (listp clause)
- (macroexpand-all-forms clause skip)
+ (macroexp--all-forms clause skip)
clause)))
-(defun macroexpand-all-1 (form)
+(defun macroexp--compiler-macro (handler form)
+ (condition-case err
+ (apply handler form (cdr form))
+ (error (message "Compiler-macro error for %S: %S" (car form) err)
+ form)))
+
+(defun macroexp--funcall-if-compiled (_form)
+ "Pseudo function used internally by macroexp to delay warnings.
+The purpose is to delay warnings to bytecomp.el, so they can use things
+like `byte-compile-log-warning' to get better file-and-line-number data
+and also to avoid outputting the warning during normal execution."
+ nil)
+(put 'macroexp--funcall-if-compiled 'byte-compile
+ (lambda (form)
+ (funcall (eval (cadr form)))
+ (byte-compile-constant nil)))
+
+(defun macroexp--warn-and-return (msg form)
+ (let ((when-compiled (lambda () (byte-compile-log-warning msg t))))
+ (cond
+ ((null msg) form)
+ ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
+ ;; macro-expansion will be processed by the byte-compiler, we check
+ ;; circumstantial evidence.
+ ((member '(declare-function . byte-compile-macroexpand-declare-function)
+ macroexpand-all-environment)
+ `(progn
+ (macroexp--funcall-if-compiled ',when-compiled)
+ ,form))
+ (t
+ (message "%s" msg)
+ form))))
+
+(defun macroexp--obsolete-warning (fun obsolescence-data type)
+ (let ((instead (car obsolescence-data))
+ (asof (nth 2 obsolescence-data)))
+ (format "`%s' is an obsolete %s%s%s" fun type
+ (if asof (concat " (as of " asof ")") "")
+ (cond ((stringp instead) (concat "; " instead))
+ (instead (format "; use `%s' instead." instead))
+ (t ".")))))
+
+(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
Assumes the caller has bound `macroexpand-all-environment'."
;; generates exceedingly deep expansions from relatively shallow input
;; forms. We just process it `in reverse' -- first we expand all the
;; arguments, _then_ we expand the top-level definition.
- (macroexpand (macroexpand-all-forms form 1)
+ (macroexpand (macroexp--all-forms form 1)
macroexpand-all-environment)
;; Normal form; get its expansion, and then expand arguments.
- (let ((new-form (macroexpand form macroexpand-all-environment)))
- (when (and (not (eq form new-form)) ;It was a macro call.
- (car-safe form)
- (symbolp (car form))
- (get (car form) 'byte-obsolete-info)
- (fboundp 'byte-compile-warn-obsolete))
- (byte-compile-warn-obsolete (car form)))
- (setq form new-form))
+ (let ((new-form
+ (macroexpand form macroexpand-all-environment)))
+ (setq form
+ (if (and (not (eq form new-form)) ;It was a macro call.
+ (car-safe form)
+ (symbolp (car form))
+ (get (car form) 'byte-obsolete-info))
+ (let* ((fun (car form))
+ (obsolete (get fun 'byte-obsolete-info)))
+ (macroexp--warn-and-return
+ (macroexp--obsolete-warning fun obsolete "macro")
+ new-form))
+ new-form)))
(pcase form
(`(cond . ,clauses)
- (maybe-cons 'cond (macroexpand-all-clauses clauses) form))
+ (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
(`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
- (maybe-cons
+ (macroexp--cons
'condition-case
- (maybe-cons err
- (maybe-cons (macroexpand-all-1 body)
- (macroexpand-all-clauses handlers 1)
+ (macroexp--cons err
+ (macroexp--cons (macroexp--expand-all body)
+ (macroexp--all-clauses handlers 1)
(cddr form))
(cdr form))
form))
- (`(defmacro ,name . ,args-and-body)
- (push (cons name (cons 'lambda args-and-body))
- macroexpand-all-environment)
- (let ((n 3))
- ;; Don't macroexpand `declare' since it should really be "expanded"
- ;; away when `defmacro' is expanded, but currently defmacro is not
- ;; itself a macro. So both `defmacro' and `declare' need to be
- ;; handled directly in bytecomp.el.
- ;; FIXME: Maybe a simpler solution is to (defalias 'declare 'quote).
- (while (or (stringp (nth n form))
- (eq (car-safe (nth n form)) 'declare))
- (setq n (1+ n)))
- (macroexpand-all-forms form n)))
- (`(defun . ,_) (macroexpand-all-forms form 3))
- (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2))
+ (`(,(or `defvar `defconst) . ,_) (macroexp--all-forms form 2))
(`(function ,(and f `(lambda . ,_)))
- (maybe-cons 'function
- (maybe-cons (macroexpand-all-forms f 2)
+ (macroexp--cons 'function
+ (macroexp--cons (macroexp--all-forms f 2)
nil
(cdr form))
form))
(`(,(or `function `quote) . ,_) form)
(`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
- (maybe-cons fun
- (maybe-cons (macroexpand-all-clauses bindings 1)
- (macroexpand-all-forms body)
+ (macroexp--cons fun
+ (macroexp--cons (macroexp--all-clauses bindings 1)
+ (macroexp--all-forms body)
(cdr form))
form))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
- (maybe-cons (macroexpand-all-forms fun 2)
- (macroexpand-all-forms args)
+ (macroexp--cons (macroexp--all-forms fun 2)
+ (macroexp--all-forms args)
form))
;; The following few cases are for normal function calls that
;; are known to funcall one of their arguments. The byte
;; First arg is a function:
(`(,(and fun (or `funcall `apply `mapcar `mapatoms `mapconcat `mapc))
',(and f `(lambda . ,_)) . ,args)
- (byte-compile-log-warning
+ (macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
- t)
- ;; We don't use `maybe-cons' since there's clearly a change.
- (cons fun
- (cons (macroexpand-all-1 (list 'function f))
- (macroexpand-all-forms args))))
+ (macroexp--expand-all `(,fun ,f . ,args))))
;; Second arg is a function:
(`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
- (byte-compile-log-warning
+ (macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
- t)
- ;; We don't use `maybe-cons' since there's clearly a change.
- (cons fun
- (cons (macroexpand-all-1 arg1)
- (cons (macroexpand-all-1
- (list 'function f))
- (macroexpand-all-forms args)))))
- ;; Macro expand compiler macros. This cannot be delayed to
- ;; byte-optimize-form because the output of the compiler-macro can
- ;; use macros.
- ;; FIXME: Don't depend on CL.
- (`(,(pred (lambda (fun)
- (and (symbolp fun)
- (eq (get fun 'byte-compile)
- 'cl-byte-compile-compiler-macro)
- (functionp 'compiler-macroexpand))))
- . ,_)
- (let ((newform (with-no-warnings (compiler-macroexpand form))))
- (if (eq form newform)
- (macroexpand-all-forms form 1)
- (macroexpand-all-1 newform))))
- (`(,_ . ,_)
- ;; For every other list, we just expand each argument (for
- ;; setq/setq-default this works alright because the variable names
- ;; are symbols).
- (macroexpand-all-forms form 1))
+ (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
+ (`(,func . ,_)
+ ;; Macro expand compiler macros. This cannot be delayed to
+ ;; byte-optimize-form because the output of the compiler-macro can
+ ;; use macros.
+ (let ((handler (function-get func 'compiler-macro)))
+ (if (null handler)
+ ;; No compiler macro. We just expand each argument (for
+ ;; setq/setq-default this works alright because the variable names
+ ;; are symbols).
+ (macroexp--all-forms form 1)
+ ;; If the handler is not loaded yet, try (auto)loading the
+ ;; function itself, which may in turn load the handler.
+ (unless (functionp handler)
+ (ignore-errors
+ (autoload-do-load (indirect-function func) func)))
+ (let ((newform (macroexp--compiler-macro handler form)))
+ (if (eq form newform)
+ ;; The compiler macro did not find anything to do.
+ (if (equal form (setq newform (macroexp--all-forms form 1)))
+ form
+ ;; Maybe after processing the args, some new opportunities
+ ;; appeared, so let's try the compiler macro again.
+ (setq form (macroexp--compiler-macro handler newform))
+ (if (eq newform form)
+ newform
+ (macroexp--expand-all newform)))
+ (macroexp--expand-all newform))))))
+
(t form))))
;;;###autoload
The second optional arg ENVIRONMENT specifies an environment of macro
definitions to shadow the loaded ones for use in file byte-compilation."
(let ((macroexpand-all-environment environment))
- (macroexpand-all-1 form)))
+ (macroexp--expand-all form)))
+
+;;; Handy functions to use in macros.
+
+(defun macroexp-progn (exps)
+ "Return an expression equivalent to `(progn ,@EXPS)."
+ (if (cdr exps) `(progn ,@exps) (car exps)))
+
+(defun macroexp-unprogn (exp)
+ "Turn EXP into a list of expressions to execute in sequence."
+ (if (eq (car-safe exp) 'progn) (cdr exp) (list exp)))
+
+(defun macroexp-let* (bindings exp)
+ "Return an expression equivalent to `(let* ,bindings ,exp)."
+ (cond
+ ((null bindings) exp)
+ ((eq 'let* (car-safe exp)) `(let* (,@bindings ,@(cadr exp)) ,@(cddr exp)))
+ (t `(let* ,bindings ,exp))))
+
+(defun macroexp-if (test then else)
+ "Return an expression equivalent to `(if ,test ,then ,else)."
+ (cond
+ ((eq (car-safe else) 'if)
+ (if (equal test (nth 1 else))
+ ;; Doing a test a second time: get rid of the redundancy.
+ `(if ,test ,then ,@(nthcdr 3 else))
+ `(cond (,test ,then)
+ (,(nth 1 else) ,(nth 2 else))
+ (t ,@(nthcdr 3 else)))))
+ ((eq (car-safe else) 'cond)
+ `(cond (,test ,then)
+ ;; Doing a test a second time: get rid of the redundancy, as above.
+ ,@(remove (assoc test else) (cdr else))))
+ ;; Invert the test if that lets us reduce the depth of the tree.
+ ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
+ (t `(if ,test ,then ,else))))
+
+(defmacro macroexp-let2 (test var exp &rest exps)
+ "Bind VAR to a copyable expression that returns the value of EXP.
+This is like `(let ((v ,EXP)) ,EXPS) except that `v' is a new generated
+symbol which EXPS can find in VAR.
+TEST should be the name of a predicate on EXP checking whether the `let' can
+be skipped; if nil, as is usual, `macroexp-const-p' is used."
+ (declare (indent 3) (debug (sexp sexp form body)))
+ (let ((bodysym (make-symbol "body"))
+ (expsym (make-symbol "exp")))
+ `(let* ((,expsym ,exp)
+ (,var (if (funcall #',(or test #'macroexp-const-p) ,expsym)
+ ,expsym (make-symbol ,(symbol-name var))))
+ (,bodysym ,(macroexp-progn exps)))
+ (if (eq ,var ,expsym) ,bodysym
+ (macroexp-let* (list (list ,var ,expsym))
+ ,bodysym)))))
+
+(defun macroexp--maxsize (exp size)
+ (cond ((< size 0) size)
+ ((symbolp exp) (1- size))
+ ((stringp exp) (- size (/ (length exp) 16)))
+ ((vectorp exp)
+ (dotimes (i (length exp))
+ (setq size (macroexp--maxsize (aref exp i) size)))
+ (1- size))
+ ((consp exp)
+ ;; We could try to be more clever with quote&function,
+ ;; but it is difficult to do so correctly, and it's not obvious that
+ ;; it would be worth the effort.
+ (dolist (e exp)
+ (setq size (macroexp--maxsize e size)))
+ (1- size))
+ (t -1)))
+
+(defun macroexp-small-p (exp)
+ "Return non-nil if EXP can be considered small."
+ (> (macroexp--maxsize exp 10) 0))
+
+(defsubst macroexp--const-symbol-p (symbol &optional any-value)
+ "Non-nil if SYMBOL is constant.
+If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
+symbol itself."
+ (or (memq symbol '(nil t))
+ (keywordp symbol)
+ (if any-value
+ (or (memq symbol byte-compile-const-variables)
+ ;; FIXME: We should provide a less intrusive way to find out
+ ;; if a variable is "constant".
+ (and (boundp symbol)
+ (condition-case nil
+ (progn (set symbol (symbol-value symbol)) nil)
+ (setting-constant t)))))))
+
+(defun macroexp-const-p (exp)
+ "Return non-nil if EXP will always evaluate to the same value."
+ (cond ((consp exp) (or (eq (car exp) 'quote)
+ (and (eq (car exp) 'function)
+ (symbolp (cadr exp)))))
+ ;; It would sometimes make sense to pass `any-value', but it's not
+ ;; always safe since a "constant" variable may not actually always have
+ ;; the same value.
+ ((symbolp exp) (macroexp--const-symbol-p exp))
+ (t t)))
+
+(defun macroexp-copyable-p (exp)
+ "Return non-nil if EXP can be copied without extra cost."
+ (or (symbolp exp) (macroexp-const-p exp)))
+
+;;; Load-time macro-expansion.
+
+;; Because macro-expansion used to be more lazy, eager macro-expansion
+;; tends to bump into previously harmless/unnoticeable cyclic-dependencies.
+;; So, we have to delay macro-expansion like we used to when we detect
+;; such a cycle, and we also want to help coders resolve those cycles (since
+;; they can be non-obvious) by providing a usefully trimmed backtrace
+;; (hopefully) highlighting the problem.
+
+(defun macroexp--backtrace ()
+ "Return the Elisp backtrace, more recent frames first."
+ (let ((bt ())
+ (i 0))
+ (while
+ (let ((frame (backtrace-frame i)))
+ (when frame
+ (push frame bt)
+ (setq i (1+ i)))))
+ (nreverse bt)))
+
+(defun macroexp--trim-backtrace-frame (frame)
+ (pcase frame
+ (`(,_ macroexpand (,head . ,_) . ,_) `(macroexpand (,head …)))
+ (`(,_ internal-macroexpand-for-load (,head ,second . ,_) . ,_)
+ (if (or (symbolp second)
+ (and (eq 'quote (car-safe second))
+ (symbolp (cadr second))))
+ `(macroexpand-all (,head ,second …))
+ '(macroexpand-all …)))
+ (`(,_ load-with-code-conversion ,name . ,_)
+ `(load ,(file-name-nondirectory name)))))
+
+(defvar macroexp--pending-eager-loads nil
+ "Stack of files currently undergoing eager macro-expansion.")
+
+(defun internal-macroexpand-for-load (form)
+ ;; Called from the eager-macroexpansion in readevalloop.
+ (cond
+ ;; Don't repeat the same warning for every top-level element.
+ ((eq 'skip (car macroexp--pending-eager-loads)) form)
+ ;; If we detect a cycle, skip macro-expansion for now, and output a warning
+ ;; with a trimmed backtrace.
+ ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
+ (let* ((bt (delq nil
+ (mapcar #'macroexp--trim-backtrace-frame
+ (macroexp--backtrace))))
+ (elem `(load ,(file-name-nondirectory load-file-name)))
+ (tail (member elem (cdr (member elem bt)))))
+ (if tail (setcdr tail (list '…)))
+ (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
+ (message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
+ (mapconcat #'prin1-to-string (nreverse bt) " => "))
+ (push 'skip macroexp--pending-eager-loads)
+ form))
+ (t
+ (condition-case err
+ (let ((macroexp--pending-eager-loads
+ (cons load-file-name macroexp--pending-eager-loads)))
+ (macroexpand-all form))
+ (error
+ ;; Hopefully this shouldn't happen thanks to the cycle detection,
+ ;; but in case it does happen, let's catch the error and give the
+ ;; code a chance to macro-expand later.
+ (message "Eager macro-expansion failure: %S" err)
+ form)))))
+
+;; ¡¡¡ Big Ugly Hack !!!
+;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
+;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
+;; by compiling those files first, but this only makes a difference if those
+;; files are not preloaded. But macroexp.el is preloaded so we reload it if
+;; the current version is interpreted and there's a compiled version available.
+(eval-when-compile
+ (add-hook 'emacs-startup-hook
+ (lambda ()
+ (and (not (byte-code-function-p
+ (symbol-function 'macroexpand-all)))
+ (locate-library "macroexp.elc")
+ (load "macroexp.elc")))))
(provide 'macroexp)
map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map query-replace-map)
- (define-key map [?\C-\M-v] 'scroll-other-window)
- (define-key map [M-next] 'scroll-other-window)
- (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
- (define-key map [M-prior] 'scroll-other-window-down)
- ;; The above are rather inconvenient, so maybe we should
- ;; provide the non-other keys for the other-scroll as well.
- ;; (define-key map [?\C-v] 'scroll-other-window)
- ;; (define-key map [next] 'scroll-other-window)
- ;; (define-key map [?\M-v] 'scroll-other-window-down)
- ;; (define-key map [prior] 'scroll-other-window-down)
(dolist (elt action-alist)
(define-key map (vector (car elt)) (vector (nth 1 elt))))
map)))
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
+;; 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
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
+;; 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
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Change Log:
(defun define-package (name-string version-string
&optional docstring requirements
- &rest extra-properties)
+ &rest _extra-properties)
"Define a new package.
NAME-STRING is the name of the package, as a string.
VERSION-STRING is the version of the package, as a string.
(defun package-generate-autoloads (name pkg-dir)
(require 'autoload) ;Load before we let-bind generated-autoload-file!
(let* ((auto-name (concat name "-autoloads.el"))
- (ignore-name (concat name "-pkg.el"))
+ ;;(ignore-name (concat name "-pkg.el"))
(generated-autoload-file (expand-file-name auto-name pkg-dir))
(version-control 'never))
(unless (fboundp 'autoload-ensure-default-file)
map)
"Local keymap for `package-menu-mode' buffers.")
+(defvar package-menu--new-package-list nil
+ "List of newly-available packages since `list-packages' was last called.")
+
(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
"Major mode for browsing a list of packages.
Letters do not insert themselves; instead, they are commands.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display."
;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION).
- (let (info-list name builtin)
+ (let (info-list name)
;; Installed packages:
(dolist (elt package-alist)
(setq name (car elt))
(when (or (eq packages t) (memq name packages))
(let ((hold (assq name package-load-list)))
(package--push name (cdr elt)
- (if (and hold (null (cadr hold)))
- "disabled"
- "available")
+ (cond
+ ((and hold (null (cadr hold))) "disabled")
+ ((memq name package-menu--new-package-list) "new")
+ (t "available"))
info-list))))
;; Obsolete packages:
(face (cond
((string= status "built-in") 'font-lock-builtin-face)
((string= status "available") 'default)
+ ((string= status "new") 'bold)
((string= status "held") 'font-lock-constant-face)
((string= status "disabled") 'font-lock-warning-face)
((string= status "installed") 'font-lock-comment-face)
(describe-package package))))
;; fixme numeric argument
-(defun package-menu-mark-delete (&optional num)
+(defun package-menu-mark-delete (&optional _num)
"Mark a package for deletion and move to the next line."
(interactive "p")
(if (member (package-menu-get-status) '("installed" "obsolete"))
(tabulated-list-put-tag "D" t)
(forward-line)))
-(defun package-menu-mark-install (&optional num)
+(defun package-menu-mark-install (&optional _num)
"Mark a package for installation and move to the next line."
(interactive "p")
- (if (string-equal (package-menu-get-status) "available")
+ (if (member (package-menu-get-status) '("available" "new"))
(tabulated-list-put-tag "I" t)
(forward-line)))
-(defun package-menu-mark-unmark (&optional num)
+(defun package-menu-mark-unmark (&optional _num)
"Clear any marks on a package and move to the next line."
(interactive "p")
(tabulated-list-put-tag " " t))
(dolist (entry tabulated-list-entries)
;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC])
(let ((pkg (car entry))
- (status (aref (cadr entry) 2))
- old)
+ (status (aref (cadr entry) 2)))
(cond ((equal status "installed")
(push pkg installed))
- ((equal status "available")
+ ((member status '("available" "new"))
(push pkg available)))))
;; Loop through list of installed packages, finding upgrades
(dolist (pkg installed)
(sB (aref (cadr B) 2)))
(cond ((string= sA sB)
(package-menu--name-predicate A B))
- ((string= sA "available") t)
+ ((string= sA "new") t)
+ ((string= sB "new") nil)
+ ((string= sA "available") t)
((string= sB "available") nil)
- ((string= sA "installed") t)
+ ((string= sA "installed") t)
((string= sB "installed") nil)
- ((string= sA "held") t)
+ ((string= sA "held") t)
((string= sB "held") nil)
- ((string= sA "built-in") t)
+ ((string= sA "built-in") t)
((string= sB "built-in") nil)
- ((string= sA "obsolete") t)
- ((string= sB "obsolete") nil)
+ ((string= sA "obsolete") t)
+ ((string= sB "obsolete") nil)
(t (string< sA sB)))))
(defun package-menu--description-predicate (A B)
;; Initialize the package system if necessary.
(unless package--initialized
(package-initialize t))
- (unless no-fetch
- (package-refresh-contents))
- (let ((buf (get-buffer-create "*Packages*")))
- (with-current-buffer buf
- (package-menu-mode)
- (package-menu--generate nil t))
- ;; The package menu buffer has keybindings. If the user types
- ;; `M-x list-packages', that suggests it should become current.
- (switch-to-buffer buf))
- (let ((upgrades (package-menu--find-upgrades)))
- (if upgrades
- (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
- (length upgrades)
- (if (= (length upgrades) 1) "" "s")
- (substitute-command-keys "\\[package-menu-mark-upgrades]")
- (if (= (length upgrades) 1) "it" "them")))))
+ (let (old-archives new-packages)
+ (unless no-fetch
+ ;; Read the locally-cached archive-contents.
+ (package-read-all-archive-contents)
+ (setq old-archives package-archive-contents)
+ ;; Fetch the remote list of packages.
+ (package-refresh-contents)
+ ;; Find which packages are new.
+ (dolist (elt package-archive-contents)
+ (unless (assq (car elt) old-archives)
+ (push (car elt) new-packages))))
+
+ ;; Generate the Package Menu.
+ (let ((buf (get-buffer-create "*Packages*")))
+ (with-current-buffer buf
+ (package-menu-mode)
+ (set (make-local-variable 'package-menu--new-package-list)
+ new-packages)
+ (package-menu--generate nil t))
+ ;; The package menu buffer has keybindings. If the user types
+ ;; `M-x list-packages', that suggests it should become current.
+ (switch-to-buffer buf))
+
+ (let ((upgrades (package-menu--find-upgrades)))
+ (if upgrades
+ (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")
+ (substitute-command-keys "\\[package-menu-mark-upgrades]")
+ (if (= (length upgrades) 1) "it" "them"))))))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
-;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*-
+;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t; coding: utf-8 -*-
;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; - along these lines, provide patterns to match CL structs.
;; - provide something like (setq VAR) so a var can be set rather than
;; let-bound.
-;; - provide a way to fallthrough to subsequent cases.
+;; - provide a way to fallthrough to subsequent cases (not sure what I meant by
+;; this :-()
;; - try and be more clever to reduce the size of the decision tree, and
;; to reduce the number of leaves that need to be turned into function:
;; - first, do the tests shared by all remaining branches (it will have
-;; to be performed anyway, so better so it first so it's shared).
+;; to be performed anyway, so better do it first so it's shared).
;; - then choose the test that discriminates more (?).
+;; - provide Agda's `with' (along with its `...' companion).
+;; - implement (not UPAT). This might require a significant redesign.
;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to
;; generate a lex-style DFA to decide whether to run E1 or E2.
;;; Code:
+(require 'macroexp)
+
;; Macro-expansion of pcase is reasonably fast, so it's not a problem
;; when byte-compiling a file, but when interpreting the code, if the pcase
;; is in a loop, the repeated macro-expansion becomes terribly costly, so we
;; memoize previous macro expansions to try and avoid recomputing them
;; over and over again.
+;; FIXME: Now that macroexpansion is also performed when loading an interpreted
+;; file, this is not a real problem any more.
(defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq))
-
-(defconst pcase--dontcare-upats '(t _ dontcare))
+;; (defconst pcase--memoize-1 (make-hash-table :test 'eq))
+;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal))
+
+(defconst pcase--dontcare-upats '(t _ pcase--dontcare))
+
+(def-edebug-spec
+ pcase-UPAT
+ (&or symbolp
+ ("or" &rest pcase-UPAT)
+ ("and" &rest pcase-UPAT)
+ ("`" pcase-QPAT)
+ ("guard" form)
+ ("let" pcase-UPAT form)
+ ("pred"
+ &or lambda-expr
+ ;; Punt on macros/special forms.
+ (functionp &rest form)
+ sexp)
+ sexp))
+
+(def-edebug-spec
+ pcase-QPAT
+ (&or ("," pcase-UPAT)
+ (pcase-QPAT . pcase-QPAT)
+ sexp))
;;;###autoload
(defmacro pcase (exp &rest cases)
UPatterns can take the following forms:
_ matches anything.
+ SELFQUOTING matches itself. This includes keywords, numbers, and strings.
SYMBOL matches anything and binds it to SYMBOL.
(or UPAT...) matches if any of the patterns matches.
(and UPAT...) matches if all the patterns match.
PRED can take the form
FUNCTION in which case it gets called with one argument.
- (FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments.
+ (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
+ which is the value being matched.
A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
PRED patterns can refer to variables bound earlier in the pattern.
E.g. you can match pairs where the cdr is larger than the car with a pattern
like `(,a . ,(pred (< a))) or, with more checks:
`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))"
- (declare (indent 1) (debug case)) ;FIXME: edebug `guard' and vars.
+ (declare (indent 1) (debug (form &rest (pcase-UPAT body))))
;; We want to use a weak hash table as a cache, but the key will unavoidably
;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
;; we're called so it'll be immediately GC'd. So we use (car cases) as key
(if (and (equal exp (car data)) (equal cases (cadr data)))
;; We have the right expansion.
(cddr data)
+ ;; (when (gethash (car cases) pcase--memoize-1)
+ ;; (message "pcase-memoize failed because of weak key!!"))
+ ;; (when (gethash (car cases) pcase--memoize-2)
+ ;; (message "pcase-memoize failed because of eq test on %S"
+ ;; (car cases)))
(when data
(message "pcase-memoize: equal first branch, yet different"))
(let ((expansion (pcase--expand exp cases)))
- (puthash (car cases) (cons exp (cons cases expansion)) pcase--memoize)
+ (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize)
+ ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-1)
+ ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
+(defun pcase--let* (bindings body)
+ (cond
+ ((null bindings) (macroexp-progn body))
+ ((pcase--trivial-upat-p (caar bindings))
+ (macroexp-let* `(,(car bindings)) (pcase--let* (cdr bindings) body)))
+ (t
+ (let ((binding (pop bindings)))
+ (pcase--expand
+ (cadr binding)
+ `((,(car binding) ,(pcase--let* bindings body))
+ ;; We can either signal an error here, or just use `pcase--dontcare'
+ ;; which generates more efficient code. In practice, if we use
+ ;; `pcase--dontcare' we will still often get an error and the few
+ ;; cases where we don't do not matter that much, so
+ ;; it's a better choice.
+ (pcase--dontcare nil)))))))
+
;;;###autoload
(defmacro pcase-let* (bindings &rest body)
"Like `let*' but where you can use `pcase' patterns for bindings.
BODY should be an expression, and BINDINGS should be a list of bindings
of the form (UPAT EXP)."
- (declare (indent 1) (debug let))
- (cond
- ((null bindings) (if (> (length body) 1) `(progn ,@body) (car body)))
- ((pcase--trivial-upat-p (caar bindings))
- `(let (,(car bindings)) (pcase-let* ,(cdr bindings) ,@body)))
- (t
- `(pcase ,(cadr (car bindings))
- (,(caar bindings) (pcase-let* ,(cdr bindings) ,@body))
- ;; We can either signal an error here, or just use `dontcare' which
- ;; generates more efficient code. In practice, if we use `dontcare' we
- ;; will still often get an error and the few cases where we don't do not
- ;; matter that much, so it's a better choice.
- (dontcare nil)))))
+ (declare (indent 1)
+ (debug ((&rest (pcase-UPAT &optional form)) body)))
+ (let ((cached (gethash bindings pcase--memoize)))
+ ;; cached = (BODY . EXPANSION)
+ (if (equal (car cached) body)
+ (cdr cached)
+ (let ((expansion (pcase--let* bindings body)))
+ (puthash bindings (cons body expansion) pcase--memoize)
+ expansion))))
;;;###autoload
(defmacro pcase-let (bindings &rest body)
"Like `let' but where you can use `pcase' patterns for bindings.
BODY should be a list of expressions, and BINDINGS should be a list of bindings
of the form (UPAT EXP)."
- (declare (indent 1) (debug let))
+ (declare (indent 1) (debug pcase-let*))
(if (null (cdr bindings))
`(pcase-let* ,bindings ,@body)
(let ((matches '()))
`(let ,(nreverse bindings) (pcase-let* ,matches ,@body)))))
(defmacro pcase-dolist (spec &rest body)
+ (declare (indent 1) (debug ((pcase-UPAT form) body)))
(if (pcase--trivial-upat-p (car spec))
`(dolist ,spec ,@body)
(let ((tmpvar (make-symbol "x")))
(defun pcase--expand (exp cases)
;; (message "pid=%S (pcase--expand %S ...hash=%S)"
;; (emacs-pid) exp (sxhash cases))
- (let* ((defs (if (symbolp exp) '()
- (let ((sym (make-symbol "x")))
- (prog1 `((,sym ,exp)) (setq exp sym)))))
- (seen '())
- (codegen
- (lambda (code vars)
- (let ((prev (assq code seen)))
- (if (not prev)
- (let ((res (pcase-codegen code vars)))
- (push (list code vars res) seen)
- res)
- ;; Since we use a tree-based pattern matching
- ;; technique, the leaves (the places that contain the
- ;; code to run once a pattern is matched) can get
- ;; copied a very large number of times, so to avoid
- ;; code explosion, we need to keep track of how many
- ;; times we've used each leaf and move it
- ;; to a separate function if that number is too high.
- ;;
- ;; We've already used this branch. So it is shared.
- (let* ((code (car prev)) (cdrprev (cdr prev))
- (prevvars (car cdrprev)) (cddrprev (cdr cdrprev))
- (res (car cddrprev)))
- (unless (symbolp res)
- ;; This is the first repeat, so we have to move
- ;; the branch to a separate function.
- (let ((bsym
- (make-symbol (format "pcase-%d" (length defs)))))
- (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs)
- (setcar res 'funcall)
- (setcdr res (cons bsym (mapcar #'cdr prevvars)))
- (setcar (cddr prev) bsym)
- (setq res bsym)))
- (setq vars (copy-sequence vars))
- (let ((args (mapcar (lambda (pa)
- (let ((v (assq (car pa) vars)))
- (setq vars (delq v vars))
- (cdr v)))
- prevvars)))
- (when vars ;New additional vars.
- (error "The vars %s are only bound in some paths"
- (mapcar #'car vars)))
- `(funcall ,res ,@args)))))))
- (main
- (pcase--u
- (mapcar (lambda (case)
- `((match ,exp . ,(car case))
- ,(apply-partially
- (if (pcase--small-branch-p (cdr case))
- ;; Don't bother sharing multiple
- ;; occurrences of this leaf since it's small.
- #'pcase-codegen codegen)
- (cdr case))))
- cases))))
- (if (null defs) main
- `(let ,defs ,main))))
+ (macroexp-let2 macroexp-copyable-p val exp
+ (let* ((defs ())
+ (seen '())
+ (codegen
+ (lambda (code vars)
+ (let ((prev (assq code seen)))
+ (if (not prev)
+ (let ((res (pcase-codegen code vars)))
+ (push (list code vars res) seen)
+ res)
+ ;; Since we use a tree-based pattern matching
+ ;; technique, the leaves (the places that contain the
+ ;; code to run once a pattern is matched) can get
+ ;; copied a very large number of times, so to avoid
+ ;; code explosion, we need to keep track of how many
+ ;; times we've used each leaf and move it
+ ;; to a separate function if that number is too high.
+ ;;
+ ;; We've already used this branch. So it is shared.
+ (let* ((code (car prev)) (cdrprev (cdr prev))
+ (prevvars (car cdrprev)) (cddrprev (cdr cdrprev))
+ (res (car cddrprev)))
+ (unless (symbolp res)
+ ;; This is the first repeat, so we have to move
+ ;; the branch to a separate function.
+ (let ((bsym
+ (make-symbol (format "pcase-%d" (length defs)))))
+ (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code))
+ defs)
+ (setcar res 'funcall)
+ (setcdr res (cons bsym (mapcar #'cdr prevvars)))
+ (setcar (cddr prev) bsym)
+ (setq res bsym)))
+ (setq vars (copy-sequence vars))
+ (let ((args (mapcar (lambda (pa)
+ (let ((v (assq (car pa) vars)))
+ (setq vars (delq v vars))
+ (cdr v)))
+ prevvars)))
+ ;; If some of `vars' were not found in `prevvars', that's
+ ;; OK it just means those vars aren't present in all
+ ;; branches, so they can be used within the pattern
+ ;; (e.g. by a `guard/let/pred') but not in the branch.
+ ;; FIXME: But if some of `prevvars' are not in `vars' we
+ ;; should remove them from `prevvars'!
+ `(funcall ,res ,@args)))))))
+ (used-cases ())
+ (main
+ (pcase--u
+ (mapcar (lambda (case)
+ `((match ,val . ,(car case))
+ ,(lambda (vars)
+ (unless (memq case used-cases)
+ ;; Keep track of the cases that are used.
+ (push case used-cases))
+ (funcall
+ (if (pcase--small-branch-p (cdr case))
+ ;; Don't bother sharing multiple
+ ;; occurrences of this leaf since it's small.
+ #'pcase-codegen codegen)
+ (cdr case)
+ vars))))
+ cases))))
+ (dolist (case cases)
+ (unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare))
+ (message "Redundant pcase pattern: %S" (car case))))
+ (macroexp-let* defs main))))
(defun pcase-codegen (code vars)
+ ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
+ ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
+ ;; codegen from later metamorphosing this let into a funcall.
`(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars)
,@code))
(cond
((eq else :pcase--dontcare) then)
((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen?
- ((eq (car-safe else) 'if)
- (if (equal test (nth 1 else))
- ;; Doing a test a second time: get rid of the redundancy.
- ;; FIXME: ideally, this should never happen because the pcase--split-*
- ;; funs should have eliminated such things, but pcase--split-member
- ;; is imprecise, so in practice it can happen occasionally.
- `(if ,test ,then ,@(nthcdr 3 else))
- `(cond (,test ,then)
- (,(nth 1 else) ,(nth 2 else))
- (t ,@(nthcdr 3 else)))))
- ((eq (car-safe else) 'cond)
- `(cond (,test ,then)
- ;; Doing a test a second time: get rid of the redundancy, as above.
- ,@(remove (assoc test else) (cdr else))))
- ;; Invert the test if that lets us reduce the depth of the tree.
- ((memq (car-safe then) '(if cond)) (pcase--if `(not ,test) else then))
- (t `(if ,test ,then ,else))))
+ (t (macroexp-if test then else))))
(defun pcase--upat (qpattern)
(cond
(defun pcase--split-pred (upat pat)
;; FIXME: For predicates like (pred (> a)), two such predicates may
;; actually refer to different variables `a'.
- (cond
- ((equal upat pat) (cons :pcase--succeed :pcase--fail))
- ((and (eq 'pred (car upat))
- (eq 'pred (car-safe pat))
- (or (member (cons (cadr upat) (cadr pat))
- pcase-mutually-exclusive-predicates)
- (member (cons (cadr pat) (cadr upat))
- pcase-mutually-exclusive-predicates)))
- (cons :pcase--fail nil))
- ;; ((and (eq 'pred (car upat))
- ;; (eq '\` (car-safe pat))
- ;; (symbolp (cadr upat))
- ;; (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
- ;; (get (cadr upat) 'side-effect-free)
- ;; (progn (message "Trying predicate %S" (cadr upat))
- ;; (ignore-errors
- ;; (funcall (cadr upat) (cadr pat)))))
- ;; (message "Simplify pred %S against %S" upat pat)
- ;; (cons nil :pcase--fail))
- ))
+ (let (test)
+ (cond
+ ((equal upat pat) (cons :pcase--succeed :pcase--fail))
+ ((and (eq 'pred (car upat))
+ (eq 'pred (car-safe pat))
+ (or (member (cons (cadr upat) (cadr pat))
+ pcase-mutually-exclusive-predicates)
+ (member (cons (cadr pat) (cadr upat))
+ pcase-mutually-exclusive-predicates)))
+ (cons :pcase--fail nil))
+ ((and (eq 'pred (car upat))
+ (eq '\` (car-safe pat))
+ (symbolp (cadr upat))
+ (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
+ (get (cadr upat) 'side-effect-free)
+ (ignore-errors
+ (setq test (list (funcall (cadr upat) (cadr pat))))))
+ (if (car test)
+ (cons nil :pcase--fail)
+ (cons :pcase--fail nil))))))
(defun pcase--fgrep (vars sexp)
"Check which of the symbols VARS appear in SEXP."
(and (memq sexp vars) (not (memq sexp res)) (push sexp res))
res))
+(defun pcase--self-quoting-p (upat)
+ (or (keywordp upat) (numberp upat) (stringp upat)))
+
+(defsubst pcase--mark-used (sym)
+ ;; Exceptionally, `sym' may be a constant expression rather than a symbol.
+ (if (symbolp sym) (put sym 'pcase-used t)))
+
;; It's very tempting to use `pcase' below, tho obviously, it'd create
;; bootstrapping problems.
(defun pcase--u1 (matches code vars rest)
(upat (cdr cdrpopmatches)))
(cond
((memq upat '(t _)) (pcase--u1 matches code vars rest))
- ((eq upat 'dontcare) :pcase--dontcare)
+ ((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred))
- (if (eq (car upat) 'pred) (put sym 'pcase-used t))
+ (if (eq (car upat) 'pred) (pcase--mark-used sym))
(let* ((splitrest
(pcase--split-rest
- sym (apply-partially #'pcase--split-pred upat) rest))
+ sym (lambda (pat) (pcase--split-pred upat pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
(pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))
(let ((newsym (make-symbol "x")))
(push (list newsym sym) env)
(setq sym newsym)))
- (if (functionp exp) `(,exp ,sym)
+ (if (functionp exp)
+ `(funcall #',exp ,sym)
`(,@exp ,sym)))))
(if (null vs)
call
`(let* ,env ,call))))
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest))))
+ ((pcase--self-quoting-p upat)
+ (pcase--mark-used sym)
+ (pcase--q1 sym upat matches code vars rest))
((symbolp upat)
- (put sym 'pcase-used t)
+ (pcase--mark-used sym)
(if (not (assq upat vars))
(pcase--u1 matches code (cons (cons upat sym) vars) rest)
;; Non-linear pattern. Turn it into an `eq' test.
;; A upat of the form (let VAR EXP).
;; (pcase--u1 matches code
;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest)
- (let* ((exp
- (let* ((exp (nth 2 upat))
- (found (assq exp vars)))
- (if found (cdr found)
- (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
- (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
- vs)))
- (if env `(let* ,env ,exp) exp)))))
- (sym (if (symbolp exp) exp (make-symbol "x")))
- (body
- (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
- code vars rest)))
- (if (eq sym exp)
- body
- `(let* ((,sym ,exp)) ,body))))
+ (macroexp-let2
+ macroexp-copyable-p sym
+ (let* ((exp (nth 2 upat))
+ (found (assq exp vars)))
+ (if found (cdr found)
+ (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
+ (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
+ vs)))
+ (if env (macroexp-let* env exp) exp))))
+ (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
+ code vars rest)))
((eq (car-safe upat) '\`)
- (put sym 'pcase-used t)
+ (pcase--mark-used sym)
(pcase--q1 sym (cadr upat) matches code vars rest))
((eq (car-safe upat) 'or)
(let ((all (> (length (cdr upat)) 1))
(memq-fine t))
(when all
(dolist (alt (cdr upat))
- (unless (and (eq (car-safe alt) '\`)
- (or (symbolp (cadr alt)) (integerp (cadr alt))
- (setq memq-fine nil)
- (stringp (cadr alt))))
+ (unless (or (pcase--self-quoting-p alt)
+ (and (eq (car-safe alt) '\`)
+ (or (symbolp (cadr alt)) (integerp (cadr alt))
+ (setq memq-fine nil)
+ (stringp (cadr alt)))))
(setq all nil))))
(if all
;; Use memq for (or `a `b `c `d) rather than a big tree.
- (let* ((elems (mapcar 'cadr (cdr upat)))
+ (let* ((elems (mapcar (lambda (x) (if (consp x) (cadr x) x))
+ (cdr upat)))
(splitrest
(pcase--split-rest
- sym (apply-partially #'pcase--split-member elems) rest))
+ sym (lambda (pat) (pcase--split-member elems pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
+ (pcase--mark-used sym)
(pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest)))
(symd (make-symbol "xcdr"))
(splitrest (pcase--split-rest
sym
- (apply-partially #'pcase--split-consp syma symd)
+ (lambda (pat) (pcase--split-consp syma symd pat))
rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest))
;; The byte-compiler could do that for us, but it would have to pay
;; attention to the `consp' test in order to figure out that car/cdr
;; can't signal errors and our byte-compiler is not that clever.
- `(let (,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
+ ;; FIXME: Some of those let bindings occur too early (they are used in
+ ;; `then-body', but only within some sub-branch).
+ (macroexp-let*
+ `(,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
- ,then-body)
+ then-body)
(pcase--u else-rest))))
((or (integerp qpat) (symbolp qpat) (stringp qpat))
(let* ((splitrest (pcase--split-rest
- sym (apply-partially 'pcase--split-equal qpat) rest))
+ sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
- (pcase--if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat)
+ (pcase--if (cond
+ ((stringp qpat) `(equal ,sym ,qpat))
+ ((null qpat) `(null ,sym))
+ (t `(eq ,sym ',qpat)))
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest))))
(t (error "Unknown QPattern %s" qpat))))
(progn
(select-window window)
(run-hooks 'temp-buffer-show-hook))
- (select-window old-selected)
+ (when (window-live-p old-selected)
+ (select-window old-selected))
(message "See buffer %s." out-buffer-name)))
(message "%s" (buffer-substring (point-min) (point)))
))))))
;; the target buffer are marked automatically with colored overlays
;; (for non-color displays see below) giving you feedback over the
;; extents of the matched (sub) expressions. The (non-)validity is
-;; shown only in the modeline without throwing the errors at you. If
+;; shown only in the mode line without throwing the errors at you. If
;; you want to know the reason why RE Builder considers it as invalid
;; call `reb-force-update' ("\C-c\C-u") which should reveal the error.
\f
;;; Workhorse functions.
-(eval-when-compile
- (require 'cl))
-
(defun regexp-opt-group (strings &optional paren lax)
"Return a regexp to match a string in the sorted list STRINGS.
If PAREN non-nil, output regexp parentheses around returned regexp.
(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.
;;
;;
;; Make a character map but extract character set meta characters.
(dolist (char chars)
- (case char
- (?\]
- (setq bracket "]"))
- (?^
- (setq caret "^"))
- (?-
- (setq dash "-"))
- (otherwise
- (aset charmap char t))))
+ (cond
+ ((eq char ?\])
+ (setq bracket "]"))
+ ((eq char ?^)
+ (setq caret "^"))
+ ((eq char ?-)
+ (setq dash "-"))
+ (t
+ (aset charmap char t))))
;;
;; Make a character set from the map using ranges where applicable.
(map-char-table
(setq charset (format "%s%c-%c" charset start end))
(while (>= end start)
(setq charset (format "%s%c" charset start))
- (incf start)))
+ (setq start (1+ start))))
(setq start (car c) end (cdr c)))
(if (= (1- c) end) (setq end c)
(if (> end (+ start 2))
(setq charset (format "%s%c-%c" charset start end))
(while (>= end start)
(setq charset (format "%s%c" charset start))
- (incf start)))
+ (setq start (1+ start))))
(setq start c end c)))))
charmap)
(when (>= end start)
(setq charset (format "%s%c-%c" charset start end))
(while (>= end start)
(setq charset (format "%s%c" charset start))
- (incf start))))
+ (setq start (1+ start)))))
;;
;; Make sure a caret is not first and a dash is first or last.
(if (and (string-equal charset "") (string-equal bracket ""))
;; 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
-;; <URL:http://www.ai.mit.edu/~/shivers/sre.txt>. SRE forms not
-;; catered for include: dsm, uncase, w/case, w/nocase, ,@<exp>,
+;; with Olin Shivers' attempted definitive SRE notation. SRE forms
+;; not catered for include: dsm, uncase, w/case, w/nocase, ,@<exp>,
;; ,<exp>, (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
;;; 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
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
;; - smie-indent-comment doesn't interact well with mis-indented lines (where
;; the indent rules don't do what the user wants). Not sure what to do.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup smie nil
"Simple Minded Indentation Engine."
(defvar smie-warning-count 0)
(defun smie-set-prec2tab (table x y val &optional override)
- (assert (and x y))
+ (cl-assert (and x y))
(let* ((key (cons x y))
(old (gethash key table)))
(if (and old (not (eq old val)))
;; don't hide real conflicts.
(puthash key (gethash key override) table)
(display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))
- (incf smie-warning-count))
+ (cl-incf smie-warning-count))
(puthash key val table))))
(put 'smie-precs->prec2 'pure t)
(unless (consp rhs)
(signal 'wrong-type-argument `(consp ,rhs)))
(if (not (member (car rhs) nts))
- (pushnew (car rhs) first-ops)
- (pushnew (car rhs) first-nts)
+ (cl-pushnew (car rhs) first-ops)
+ (cl-pushnew (car rhs) first-nts)
(when (consp (cdr rhs))
;; If the first is not an OP we add the second (which
;; should be an OP if BNF is an "operator grammar").
(when (member (cadr rhs) nts)
(error "Adjacent non-terminals: %s %s"
(car rhs) (cadr rhs)))
- (pushnew (cadr rhs) first-ops)))
+ (cl-pushnew (cadr rhs) first-ops)))
(let ((shr (reverse rhs)))
(if (not (member (car shr) nts))
- (pushnew (car shr) last-ops)
- (pushnew (car shr) last-nts)
+ (cl-pushnew (car shr) last-ops)
+ (cl-pushnew (car shr) last-nts)
(when (consp (cdr shr))
(when (member (cadr shr) nts)
(error "Adjacent non-terminals: %s %s"
(cadr shr) (car shr)))
- (pushnew (cadr shr) last-ops)))))
+ (cl-pushnew (cadr shr) last-ops)))))
(push (cons nt first-ops) first-ops-table)
(push (cons nt last-ops) last-ops-table)
(push (cons nt first-nts) first-nts-table)
(if no-inners
(let ((last (car (last rhs))))
(unless (member last nts)
- (pushnew (cons (car rhs) last) alist :test #'equal)))
+ (cl-pushnew (cons (car rhs) last) alist :test #'equal)))
;; Reverse so that the "real" closer gets there first,
;; which is important for smie-close-block.
(dolist (term (reverse (cdr rhs)))
(unless (member term nts)
- (pushnew (cons (car rhs) term) alist :test #'equal)))))))
+ (cl-pushnew (cons (car rhs) term) alist :test #'equal)))))))
(nreverse alist)))
(defun smie-bnf--set-class (table token class)
(push (concat "." (car elem)) res))
(if (eq (cddr elem) val)
(push (concat (car elem) ".") res)))
- (assert res)
+ (cl-assert res)
res))
cycle)))
(mapconcat
;; (right (nth 1 (assoc (cdr k) grammar))))
;; (when (and left right)
;; (cond
-;; ((< left right) (assert (eq v '<)))
-;; ((> left right) (assert (eq v '>)))
-;; (t (assert (eq v '=))))))))
+;; ((< left right) (cl-assert (eq v '<)))
+;; ((> left right) (cl-assert (eq v '>)))
+;; (t (cl-assert (eq v '=))))))))
;; prec2))
(put 'smie-prec2->grammar 'pure t)
;; final `table'. The value of each "variable" is kept in the `car'.
(let ((table ())
(csts ())
- (eqs ())
- tmp x y)
+ (eqs ()))
;; From `prec2' we construct a list of constraints between
;; variables (aka "precedence levels"). These can be either
;; equality constraints (in `eqs') or `<' constraints (in `csts').
(maphash (lambda (k v)
(when (consp k)
- (if (setq tmp (assoc (car k) table))
- (setq x (cddr tmp))
- (setq x (cons nil nil))
- (push (cons (car k) (cons nil x)) table))
- (if (setq tmp (assoc (cdr k) table))
- (setq y (cdr tmp))
- (setq y (cons nil (cons nil nil)))
- (push (cons (cdr k) y) table))
- (ecase v
- (= (push (cons x y) eqs))
- (< (push (cons x y) csts))
- (> (push (cons y x) csts)))))
+ (let ((tmp (assoc (car k) table))
+ x y)
+ (if tmp
+ (setq x (cddr tmp))
+ (setq x (cons nil nil))
+ (push (cons (car k) (cons nil x)) table))
+ (if (setq tmp (assoc (cdr k) table))
+ (setq y (cdr tmp))
+ (setq y (cons nil (cons nil nil)))
+ (push (cons (cdr k) y) table))
+ (pcase v
+ (`= (push (cons x y) eqs))
+ (`< (push (cons x y) csts))
+ (`> (push (cons y x) csts))
+ (_ (error "SMIE error: prec2 has %S↦%S which ∉ {<,+,>}"
+ k v))))))
prec2)
;; First process the equality constraints.
(let ((eqs eqs))
(unless (caar cst)
(setcar (car cst) i)
;; (smie-check-grammar table prec2 'step1)
- (incf i))
+ (cl-incf i))
(setq csts (delq cst csts))))
(unless progress
(error "Can't resolve the precedence cycle: %s"
(smie-debug--describe-cycle
table (smie-debug--prec2-cycle csts)))))
- (incf i 10))
+ (cl-incf i 10))
;; Propagate equality constraints back to their sources.
(dolist (eq (nreverse eqs))
(when (null (cadr eq))
;; So set it here rather than below since doing it below
;; makes it more difficult to obey the equality constraints.
(setcar (cdr eq) i)
- (incf i))
- (assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
+ (cl-incf i))
+ (cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
(setcar (car eq) (cadr eq))
;; (smie-check-grammar table prec2 'step2)
)
(dolist (x table)
(unless (nth 1 x)
(setf (nth 1 x) i)
- (incf i)) ;See other (incf i) above.
+ (cl-incf i)) ;See other (cl-incf i) above.
(unless (nth 2 x)
(setf (nth 2 x) i)
- (incf i)))) ;See other (incf i) above.
+ (cl-incf i)))) ;See other (cl-incf i) above.
;; Mark closers and openers.
(dolist (x (gethash :smie-open/close-alist prec2))
(let* ((token (car x))
- (cons (case (cdr x)
- (closer (cddr (assoc token table)))
- (opener (cdr (assoc token table))))))
- (assert (numberp (car cons)))
+ (cons (pcase (cdr x)
+ (`closer (cddr (assoc token table)))
+ (`opener (cdr (assoc token table))))))
+ (cl-assert (numberp (car cons)))
(setf (car cons) (list (car cons)))))
(let ((ca (gethash :smie-closer-alist prec2)))
(when ca (push (cons :smie-closer-alist ca) table)))
is too high. FORW-LEVEL is the forw-level of TOKEN,
POS is its start position in the buffer.
(t POS TOKEN): same thing when we bump on the wrong side of a paren.
+ Instead of t, the `car' can also be some other non-nil non-number value.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(catch 'return
(when (zerop (length token))
(condition-case err
(progn (goto-char pos) (funcall next-sexp 1) nil)
- (scan-error (throw 'return
- (list t (caddr err)
- (buffer-substring-no-properties
- (caddr err)
- (+ (caddr err)
- (if (< (point) (caddr err))
- -1 1)))))))
+ (scan-error
+ (let ((pos (nth 2 err)))
+ (throw 'return
+ (list t pos
+ (buffer-substring-no-properties
+ pos (+ pos (if (< (point) pos) -1 1))))))))
(if (eq pos (point))
;; We did not move, so let's abort the loop.
(throw 'return (list t (point))))))
((not (numberp (funcall op-back toklevels)))
;; A token like a paren-close.
- (assert (numberp ; Otherwise, why mention it in smie-grammar.
- (funcall op-forw toklevels)))
+ (cl-assert (numberp ; Otherwise, why mention it in smie-grammar.
+ (funcall op-forw toklevels)))
(push toklevels levels))
(t
(while (and levels (< (funcall op-back toklevels)
(if (and halfsexp (numberp (funcall op-forw toklevels)))
(push toklevels levels)
(throw 'return
- (prog1 (list (or (car toklevels) t) (point) token)
+ (prog1 (list (or (funcall op-forw toklevels) t)
+ (point) token)
(goto-char pos)))))
(t
(let ((lastlevels levels))
((and lastlevels
(smie--associative-p (car lastlevels)))
(throw 'return
- (prog1 (list (or (car toklevels) t) (point) token)
+ (prog1 (list (or (funcall op-forw toklevels) t)
+ (point) token)
(goto-char pos))))
;; - it's an associative operator within a larger construct
;; (e.g. an "elsif"), so we should just ignore it and keep
is too high. LEFT-LEVEL is the left-level of TOKEN,
POS is its start position in the buffer.
(t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
+ Instead of t, the `car' can also be some other non-nil non-number value.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(smie-next-sexp
(RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level
is too high. RIGHT-LEVEL is the right-level of TOKEN,
POS is its end position in the buffer.
- (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
+ (t POS TOKEN): same thing but for a close-paren or the end of buffer.
+ Instead of t, the `car' can also be some other non-nil non-number value.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
(smie-next-sexp
"Return non-nil if the current token is the first on the line."
(save-excursion (skip-chars-backward " \t") (bolp)))
+(defun smie-indent--bolp-1 ()
+ ;; Like smie-indent--bolp but also returns non-nil if it's the first
+ ;; non-comment token. Maybe we should simply always use this?
+ "Return non-nil if the current token is the first on the line.
+Comments are treated as spaces."
+ (let ((bol (line-beginning-position)))
+ (save-excursion
+ (forward-comment (- (point)))
+ (<= (point) bol))))
+
;; Dynamically scoped.
(defvar smie--parent) (defvar smie--after) (defvar smie--token)
;; - middle-of-line: "trust current position".
(cond
((smie-indent--rule :before token))
- ((smie-indent--bolp) ;I.e. non-virtual indent.
+ ((smie-indent--bolp-1) ;I.e. non-virtual indent.
;; For an open-paren-like thingy at BOL, always indent only
;; based on other rules (typically smie-indent-after-keyword).
+ ;; FIXME: we do the same if after a comment, since we may be trying
+ ;; to compute the indentation of this comment and we shouldn't indent
+ ;; based on the indentation of subsequent code.
nil)
(t
;; By default use point unless we're hanging.
(save-excursion
(forward-comment (point-max))
(skip-chars-forward " \t\r\n")
+ ;; FIXME: We assume here that smie-indent-calculate will compute the
+ ;; indentation of the next token based on text before the comment, but
+ ;; this is not guaranteed, so maybe we should let
+ ;; smie-indent-calculate return some info about which buffer position
+ ;; was used as the "indentation base" and check that this base is
+ ;; before `pos'.
(smie-indent-calculate))))
(defun smie-indent-comment-continue ()
(save-excursion (indent-line-to indent))
(indent-line-to indent)))))
+(defun smie-auto-fill ()
+ (let ((fc (current-fill-column)))
+ (while (and fc (> (current-column) fc))
+ (cond
+ ((not (or (nth 8 (save-excursion
+ (syntax-ppss (line-beginning-position))))
+ (nth 8 (syntax-ppss))))
+ (save-excursion
+ (beginning-of-line)
+ (smie-indent-forward-token)
+ (let ((bsf (point))
+ (gain 0)
+ curcol)
+ (while (<= (setq curcol (current-column)) fc)
+ ;; FIXME? `smie-indent-calculate' can (and often will)
+ ;; return a result that actually depends on the presence/absence
+ ;; of a newline, so the gain computed here may not be accurate,
+ ;; but in practice it seems to works well enough.
+ (let* ((newcol (smie-indent-calculate))
+ (newgain (- curcol newcol)))
+ (when (> newgain gain)
+ (setq gain newgain)
+ (setq bsf (point))))
+ (smie-indent-forward-token))
+ (when (> gain 0)
+ (goto-char bsf)
+ (newline-and-indent)))))
+ (t (do-auto-fill))))))
+
+
(defun smie-setup (grammar rules-function &rest keywords)
"Setup SMIE navigation and indentation.
GRAMMAR is a grammar table generated by `smie-prec2->grammar'.
(set (make-local-variable 'smie-rules-function) rules-function)
(set (make-local-variable 'smie-grammar) grammar)
(set (make-local-variable 'indent-line-function) 'smie-indent-line)
+ (set (make-local-variable 'normal-auto-fill-function) 'smie-auto-fill)
(set (make-local-variable 'forward-sexp-function)
'smie-forward-sexp-command)
(while keywords
(let ((k (pop keywords))
(v (pop keywords)))
- (case k
- (:forward-token
+ (pcase k
+ (`:forward-token
(set (make-local-variable 'smie-forward-token-function) v))
- (:backward-token
+ (`:backward-token
(set (make-local-variable 'smie-backward-token-function) v))
- (t (message "smie-setup: ignoring unknown keyword %s" k)))))
+ (_ (message "smie-setup: ignoring unknown keyword %s" k)))))
(let ((ca (cdr (assq :smie-closer-alist grammar))))
(when ca
(set (make-local-variable 'smie-closer-alist) ca)
-;;; syntax.el --- helper functions to find syntactic context
+;;; syntax.el --- helper functions to find syntactic context -*- lexical-binding: t -*-
;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Note: PPSS stands for `parse-partial-sexp state'
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar font-lock-beginning-of-syntax-function)
;; If there's more than 1 rule, and the rule want to apply
;; highlight to match 0, create an extra group to be able to
;; tell when *this* match 0 has succeeded.
- (incf offset)
+ (cl-incf offset)
(setq re (concat "\\(" re "\\)")))
(setq re (syntax-propertize--shift-groups re offset))
(let ((code '())
(setq offset 0)))
;; Now construct the code for each subgroup rules.
(dolist (case (cdr rule))
- (assert (null (cddr case)))
+ (cl-assert (null (cddr case)))
(let* ((gn (+ offset (car case)))
(action (nth 1 case))
(thiscode
code))))
(push (cons condition (nreverse code))
branches))
- (incf offset (regexp-opt-depth orig-re))
+ (cl-incf offset (regexp-opt-depth orig-re))
re))
rules
"\\|")))
"Propertize for syntax in START..END using font-lock syntax.
KEYWORDS obeys the format used in `font-lock-syntactic-keywords'.
The return value is a function suitable for `syntax-propertize-function'."
- (lexical-let ((keywords keywords))
- (lambda (start end)
- (with-no-warnings
- (let ((font-lock-syntactic-keywords keywords))
- (font-lock-fontify-syntactic-keywords-region start end)
- ;; In case it was eval'd/compiled.
- (setq keywords font-lock-syntactic-keywords))))))
+ (lambda (start end)
+ (with-no-warnings
+ (let ((font-lock-syntactic-keywords keywords))
+ (font-lock-fontify-syntactic-keywords-region start end)
+ ;; In case it was eval'd/compiled.
+ (setq keywords font-lock-syntactic-keywords)))))
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS."
(* 2 (/ (cdr (aref syntax-ppss-stats 5))
(1+ (car (aref syntax-ppss-stats 5)))))))
(progn
- (incf (car (aref syntax-ppss-stats 0)))
- (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
+ (cl-incf (car (aref syntax-ppss-stats 0)))
+ (cl-incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
(parse-partial-sexp old-pos pos nil nil old-ppss))
(cond
(setq pt-min (or (syntax-ppss-toplevel-pos old-ppss)
(nth 2 old-ppss)))
(<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span))
- (incf (car (aref syntax-ppss-stats 1)))
- (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
+ (cl-incf (car (aref syntax-ppss-stats 1)))
+ (cl-incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
(setq ppss (parse-partial-sexp pt-min pos)))
;; The OLD-* data can't be used. Consult the cache.
(t
;; Use the best of OLD-POS and CACHE.
(if (or (not old-pos) (< old-pos pt-min))
(setq pt-best pt-min ppss-best ppss)
- (incf (car (aref syntax-ppss-stats 4)))
- (incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
+ (cl-incf (car (aref syntax-ppss-stats 4)))
+ (cl-incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
(setq pt-best old-pos ppss-best old-ppss))
;; Use the `syntax-begin-function' if available.
(not (memq (get-text-property (point) 'face)
'(font-lock-string-face font-lock-doc-face
font-lock-comment-face))))
- (incf (car (aref syntax-ppss-stats 5)))
- (incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
+ (cl-incf (car (aref syntax-ppss-stats 5)))
+ (cl-incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
(setq pt-best (point) ppss-best nil))
(cond
;; Quick case when we found a nearby pos.
((< (- pos pt-best) syntax-ppss-max-span)
- (incf (car (aref syntax-ppss-stats 2)))
- (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
+ (cl-incf (car (aref syntax-ppss-stats 2)))
+ (cl-incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
(setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best)))
;; Slow case: compute the state from some known position and
;; populate the cache so we won't need to do it again soon.
(t
- (incf (car (aref syntax-ppss-stats 3)))
- (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
+ (cl-incf (car (aref syntax-ppss-stats 3)))
+ (cl-incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
;; If `pt-min' is too far, add a few intermediate entries.
(while (> (- pos pt-min) (* 2 syntax-ppss-max-span))
(setq ppss (parse-partial-sexp
pt-min (setq pt-min (/ (+ pt-min pos) 2))
nil nil ppss))
- (let ((pair (cons pt-min ppss)))
- (if cache-pred
- (push pair (cdr cache-pred))
- (push pair syntax-ppss-cache))))
+ (push (cons pt-min ppss)
+ (if cache-pred (cdr cache-pred) syntax-ppss-cache)))
;; Compute the actual return value.
(setq ppss (parse-partial-sexp pt-min pos nil nil ppss))
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
+;; 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
;;; Commentary:
-;; This file defines `tabulated-list-mode', a generic major mode for displaying
-;; lists of tabulated data, intended for other major modes to inherit from. It
-;; provides several utility routines, e.g. for pretty-printing lines of
-;; tabulated data to fit into the appropriate columns.
+;; This file defines Tabulated List mode, a generic major mode for
+;; displaying lists of tabulated data, intended for other major modes
+;; to inherit from. It provides several utility routines, e.g. for
+;; pretty-printing lines of tabulated data to fit into the appropriate
+;; columns.
;; For usage information, see the documentation of `tabulated-list-mode'.
-;; This package originated from Tom Tromey's Package Menu mode, extended and
-;; generalized to be used by other modes.
+;; This package originated from Tom Tromey's Package Menu mode,
+;; extended and generalized to be used by other modes.
;;; Code:
+;; The reason `tabulated-list-format' and other variables are
+;; permanent-local is to make it convenient to switch to a different
+;; major mode, switch back, and have the original Tabulated List data
+;; still valid. See, for example, ebuff-menu.el.
+
(defvar tabulated-list-format nil
"The format of the current Tabulated List mode buffer.
-This should be a vector of elements (NAME WIDTH SORT), where:
+This should be a vector of elements (NAME WIDTH SORT . PROPS),
+where:
- NAME is a string describing the column.
+ This is the label for the column in the header line.
+ Different columns must have non-`equal' names.
- WIDTH is the width to reserve for the column.
For the final element, its numerical value is ignored.
- SORT specifies how to sort entries by this column.
If t, sort by comparing the string value printed in the column.
Otherwise, it should be a predicate function suitable for
`sort', accepting arguments with the same form as the elements
- of `tabulated-list-entries'.")
+ of `tabulated-list-entries'.
+ - PROPS is a plist of additional column properties.
+ Currently supported properties are:
+ - `:right-align': if non-nil, the column should be right-aligned.
+ - `:pad-right': Number of additional padding spaces to the
+ right of the column (defaults to 1 if omitted).")
(make-variable-buffer-local 'tabulated-list-format)
+(put 'tabulated-list-format 'permanent-local t)
+
+(defvar tabulated-list-use-header-line t
+ "Whether the Tabulated List buffer should use a header line.")
+(make-variable-buffer-local 'tabulated-list-use-header-line)
(defvar tabulated-list-entries nil
"Entries displayed in the current Tabulated List buffer.
If `tabulated-list-entries' is a function, it is called with no
arguments and must return a list of the above form.")
(make-variable-buffer-local 'tabulated-list-entries)
+(put 'tabulated-list-entries 'permanent-local t)
(defvar tabulated-list-padding 0
"Number of characters preceding each Tabulated List mode entry.
By default, lines are padded with spaces, but you can use the
function `tabulated-list-put-tag' to change this.")
(make-variable-buffer-local 'tabulated-list-padding)
+(put 'tabulated-list-padding 'permanent-local t)
(defvar tabulated-list-revert-hook nil
"Hook run before reverting a Tabulated List buffer.
`tabulated-list-format' then specifies how to sort). FLIP, if
non-nil, means to invert the resulting sort.")
(make-variable-buffer-local 'tabulated-list-sort-key)
+(put 'tabulated-list-sort-key 'permanent-local t)
-(defun tabulated-list-get-id (&optional pos)
- "Obtain the entry ID of the Tabulated List mode entry at POS.
-This is an ID object from `tabulated-list-entries', or nil.
+(defsubst tabulated-list-get-id (&optional pos)
+ "Return the entry ID of the Tabulated List entry at POS.
+The value is an ID object from `tabulated-list-entries', or nil.
POS, if omitted or nil, defaults to point."
(get-text-property (or pos (point)) 'tabulated-list-id))
+(defsubst tabulated-list-get-entry (&optional pos)
+ "Return the Tabulated List entry at POS.
+The value is a vector of column descriptors, or nil if there is
+no entry at POS. POS, if omitted or nil, defaults to point."
+ (get-text-property (or pos (point)) 'tabulated-list-entry))
+
(defun tabulated-list-put-tag (tag &optional advance)
"Put TAG in the padding area of the current line.
TAG should be a string, with length <= `tabulated-list-padding'.
(error "Unable to tag the current line"))
(save-excursion
(beginning-of-line)
- (when (get-text-property (point) 'tabulated-list-id)
+ (when (tabulated-list-get-entry)
(let ((beg (point))
(inhibit-read-only t))
(forward-char tabulated-list-padding)
(insert-and-inherit
- (if (<= (length tag) tabulated-list-padding)
- (concat tag
- (make-string (- tabulated-list-padding (length tag))
- ?\s))
- (substring tag 0 tabulated-list-padding)))
+ (let ((width (string-width tag)))
+ (if (<= width tabulated-list-padding)
+ (concat tag
+ (make-string (- tabulated-list-padding width) ?\s))
+ (truncate-string-to-width tag tabulated-list-padding))))
(delete-region beg (+ beg tabulated-list-padding)))))
(if advance
(forward-line)))
(set-keymap-parent map button-buffer-map)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
+ (define-key map "S" 'tabulated-list-sort)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'mouse-select-window)
map)
(let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-1] 'tabulated-list-col-sort)
(define-key map [header-line mouse-2] 'tabulated-list-col-sort)
+ (define-key map [mouse-1] 'tabulated-list-col-sort)
+ (define-key map [mouse-2] 'tabulated-list-col-sort)
+ (define-key map "\C-m" 'tabulated-list-sort)
(define-key map [follow-link] 'mouse-face)
map)
"Local keymap for `tabulated-list-mode' sort buttons.")
table)
"The `glyphless-char-display' table in Tabulated List buffers.")
+(defvar tabulated-list--header-string nil)
+(defvar tabulated-list--header-overlay nil)
+
(defun tabulated-list-init-header ()
"Set up header line for the Tabulated List buffer."
- (let ((x tabulated-list-padding)
+ ;; FIXME: Should share code with tabulated-list-print-col!
+ (let ((x (max tabulated-list-padding 0))
(button-props `(help-echo "Click to sort by column"
mouse-face highlight
keymap ,tabulated-list-sort-button-map))
(cols nil))
- (if (> tabulated-list-padding 0)
- (push (propertize " " 'display `(space :align-to ,x)) cols))
+ (push (propertize " " 'display `(space :align-to ,x)) cols)
(dotimes (n (length tabulated-list-format))
(let* ((col (aref tabulated-list-format n))
+ (label (nth 0 col))
(width (nth 1 col))
- (label (car col)))
- (setq x (+ x 1 width))
- (and (<= tabulated-list-padding 0)
- (= n 0)
- (setq label (concat " " label)))
+ (props (nthcdr 3 col))
+ (pad-right (or (plist-get props :pad-right) 1))
+ (right-align (plist-get props :right-align))
+ (next-x (+ x pad-right width)))
(push
(cond
;; An unsortable column
- ((not (nth 2 col)) label)
+ ((not (nth 2 col))
+ (propertize label 'tabulated-list-column-name label))
;; The selected sort column
((equal (car col) (car tabulated-list-sort-key))
(apply 'propertize
(concat label
(cond
- ((> (+ 2 (length label)) width)
- "")
- ((cdr tabulated-list-sort-key)
- " ▲")
+ ((> (+ 2 (length label)) width) "")
+ ((cdr tabulated-list-sort-key) " ▲")
(t " ▼")))
'face 'bold
- 'tabulated-list-column-name (car col)
+ 'tabulated-list-column-name label
button-props))
;; Unselected sortable column.
(t (apply 'propertize label
- 'tabulated-list-column-name (car col)
+ 'tabulated-list-column-name label
button-props)))
- cols))
- (push (propertize " "
- 'display (list 'space :align-to x)
- 'face 'fixed-pitch)
- cols))
- (setq header-line-format (mapconcat 'identity (nreverse cols) ""))))
+ cols)
+ (when right-align
+ (let ((shift (- width (string-width (car cols)))))
+ (when (> shift 0)
+ (setq cols
+ (cons (car cols)
+ (cons (propertize (make-string shift ?\s)
+ 'display
+ `(space :align-to ,(+ x shift)))
+ (cdr cols))))
+ (setq x (+ x shift)))))
+ (if (> pad-right 0)
+ (push (propertize " "
+ 'display `(space :align-to ,next-x)
+ 'face 'fixed-pitch)
+ cols))
+ (setq x next-x)))
+ (setq cols (apply 'concat (nreverse cols)))
+ (if tabulated-list-use-header-line
+ (setq header-line-format cols)
+ (setq header-line-format nil)
+ (set (make-local-variable 'tabulated-list--header-string) cols))))
+
+(defun tabulated-list-print-fake-header ()
+ "Insert a fake Tabulated List \"header line\" at the start of the buffer."
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (insert tabulated-list--header-string "\n")
+ (if tabulated-list--header-overlay
+ (move-overlay tabulated-list--header-overlay (point-min) (point))
+ (set (make-local-variable 'tabulated-list--header-overlay)
+ (make-overlay (point-min) (point))))
+ (overlay-put tabulated-list--header-overlay 'face 'underline)))
(defun tabulated-list-revert (&rest ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
(run-hooks 'tabulated-list-revert-hook)
(tabulated-list-print t))
+(defun tabulated-list--column-number (name)
+ (let ((len (length tabulated-list-format))
+ (n 0)
+ found)
+ (while (and (< n len) (null found))
+ (if (equal (car (aref tabulated-list-format n)) name)
+ (setq found n))
+ (setq n (1+ n)))
+ (or found
+ (error "No column named %s" name))))
+
(defun tabulated-list-print (&optional remember-pos)
"Populate the current Tabulated List mode buffer.
This sorts the `tabulated-list-entries' list if sorting is
(setq entry-id (tabulated-list-get-id))
(setq saved-col (current-column)))
(erase-buffer)
- ;; Sort the buffers, if necessary.
- (when tabulated-list-sort-key
- (let ((sort-column (car tabulated-list-sort-key))
- (len (length tabulated-list-format))
- (n 0)
- sorter)
- ;; Which column is to be sorted?
- (while (and (< n len)
- (not (equal (car (aref tabulated-list-format n))
- sort-column)))
- (setq n (1+ n)))
- (when (< n len)
- (setq sorter (nth 2 (aref tabulated-list-format n)))
+ (unless tabulated-list-use-header-line
+ (tabulated-list-print-fake-header))
+ ;; Sort the entries, if necessary.
+ (when (and tabulated-list-sort-key
+ (car tabulated-list-sort-key))
+ (let* ((sort-column (car tabulated-list-sort-key))
+ (n (tabulated-list--column-number sort-column))
+ (sorter (nth 2 (aref tabulated-list-format n))))
+ ;; Is the specified column sortable?
+ (when sorter
(when (eq sorter t)
(setq sorter ; Default sorter checks column N:
(lambda (A B)
This is the default `tabulated-list-printer' function. ID is a
Lisp object identifying the entry to print, and COLS is a vector
of column descriptors."
- (let ((beg (point))
- (x (max tabulated-list-padding 0))
- (len (length tabulated-list-format)))
+ (let ((beg (point))
+ (x (max tabulated-list-padding 0))
+ (ncols (length tabulated-list-format))
+ (inhibit-read-only t))
(if (> tabulated-list-padding 0)
(insert (make-string x ?\s)))
- (dotimes (n len)
- (let* ((format (aref tabulated-list-format n))
- (desc (aref cols n))
- (width (nth 1 format))
- (label (if (stringp desc) desc (car desc)))
- (help-echo (concat (car format) ": " label)))
- ;; Truncate labels if necessary (except last column).
- (and (< (1+ n) len)
- (> (string-width label) width)
- (setq label (truncate-string-to-width label width nil nil t)))
- (setq label (bidi-string-mark-left-to-right label))
- (if (stringp desc)
- (insert (propertize label 'help-echo help-echo))
- (apply 'insert-text-button label (cdr desc)))
- (setq x (+ x 1 width)))
- ;; No need to append any spaces if this is the last column.
- (if (< (1+ n) len)
- (indent-to x 1)))
+ (dotimes (n ncols)
+ (setq x (tabulated-list-print-col n (aref cols n) x)))
(insert ?\n)
- (put-text-property beg (point) 'tabulated-list-id id)))
+ (put-text-property beg (point) 'tabulated-list-id id)
+ (put-text-property beg (point) 'tabulated-list-entry cols)))
+
+(defun tabulated-list-print-col (n col-desc x)
+ "Insert a specified Tabulated List entry at point.
+N is the column number, COL-DESC is a column descriptor \(see
+`tabulated-list-entries'), and X is the column number at point.
+Return the column number after insertion."
+ ;; TODO: don't truncate to `width' if the next column is align-right
+ ;; and has some space left.
+ (let* ((format (aref tabulated-list-format n))
+ (name (nth 0 format))
+ (width (nth 1 format))
+ (props (nthcdr 3 format))
+ (pad-right (or (plist-get props :pad-right) 1))
+ (right-align (plist-get props :right-align))
+ (label (if (stringp col-desc) col-desc (car col-desc)))
+ (label-width (string-width label))
+ (help-echo (concat (car format) ": " label))
+ (opoint (point))
+ (not-last-col (< (1+ n) (length tabulated-list-format))))
+ ;; Truncate labels if necessary (except last column).
+ (and not-last-col
+ (> label-width width)
+ (setq label (truncate-string-to-width label width nil nil t)
+ label-width width))
+ (setq label (bidi-string-mark-left-to-right label))
+ (when (and right-align (> width label-width))
+ (let ((shift (- width label-width)))
+ (insert (propertize (make-string shift ?\s)
+ 'display `(space :align-to ,(+ x shift))))
+ (setq width (- width shift))
+ (setq x (+ x shift))))
+ (if (stringp col-desc)
+ (insert (propertize label 'help-echo help-echo))
+ (apply 'insert-text-button label (cdr col-desc)))
+ (let ((next-x (+ x pad-right width)))
+ ;; No need to append any spaces if this is the last column.
+ (when not-last-col
+ (when (> pad-right 0) (insert (make-string pad-right ?\s)))
+ (insert (propertize
+ (make-string (- next-x x label-width pad-right) ?\s)
+ 'display `(space :align-to ,next-x))))
+ (put-text-property opoint (point) 'tabulated-list-column-name name)
+ next-x)))
+
+(defun tabulated-list-delete-entry ()
+ "Delete the Tabulated List entry at point.
+Return a list (ID COLS), where ID is the ID of the deleted entry
+and COLS is a vector of its column descriptors. Move point to
+the beginning of the deleted entry. Return nil if there is no
+entry at point.
+
+This function only changes the buffer contents; it does not alter
+`tabulated-list-entries'."
+ ;; Assume that each entry occupies one line.
+ (let* ((id (tabulated-list-get-id))
+ (cols (tabulated-list-get-entry))
+ (inhibit-read-only t))
+ (when cols
+ (delete-region (line-beginning-position) (1+ (line-end-position)))
+ (list id cols))))
+
+(defun tabulated-list-set-col (col desc &optional change-entry-data)
+ "Change the Tabulated List entry at point, setting COL to DESC.
+COL is the column number to change, or the name of the column to change.
+DESC is the new column descriptor, which is inserted via
+`tabulated-list-print-col'.
+
+If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data
+by setting the appropriate slot of the vector originally used to
+print this entry. If `tabulated-list-entries' has a list value,
+this is the vector stored within it."
+ (let* ((opoint (point))
+ (eol (line-end-position))
+ (pos (line-beginning-position))
+ (id (tabulated-list-get-id pos))
+ (entry (tabulated-list-get-entry pos))
+ (prop 'tabulated-list-column-name)
+ (inhibit-read-only t)
+ name)
+ (cond ((numberp col)
+ (setq name (car (aref tabulated-list-format col))))
+ ((stringp col)
+ (setq name col
+ col (tabulated-list--column-number col)))
+ (t
+ (error "Invalid column %s" col)))
+ (unless entry
+ (error "No Tabulated List entry at position %s" opoint))
+ (unless (equal (get-text-property pos prop) name)
+ (while (and (setq pos
+ (next-single-property-change pos prop nil eol))
+ (< pos eol)
+ (not (equal (get-text-property pos prop) name)))))
+ (when (< pos eol)
+ (delete-region pos (next-single-property-change pos prop nil eol))
+ (goto-char pos)
+ (tabulated-list-print-col col desc (current-column))
+ (if change-entry-data
+ (aset entry col desc))
+ (put-text-property pos (point) 'tabulated-list-id id)
+ (put-text-property pos (point) 'tabulated-list-entry entry)
+ (goto-char opoint))))
(defun tabulated-list-col-sort (&optional e)
"Sort Tabulated List entries by the column of the mouse click E."
(interactive "e")
(let* ((pos (event-start e))
- (obj (posn-object pos))
- (name (get-text-property (if obj (cdr obj) (posn-point pos))
- 'tabulated-list-column-name
- (car obj))))
+ (obj (posn-object pos)))
(with-current-buffer (window-buffer (posn-window pos))
- (when (derived-mode-p 'tabulated-list-mode)
- ;; Flip the sort order on a second click.
- (if (equal name (car tabulated-list-sort-key))
- (setcdr tabulated-list-sort-key
- (not (cdr tabulated-list-sort-key)))
- (setq tabulated-list-sort-key (cons name nil)))
- (tabulated-list-init-header)
- (tabulated-list-print t)))))
+ (tabulated-list--sort-by-column-name
+ (get-text-property (if obj (cdr obj) (posn-point pos))
+ 'tabulated-list-column-name
+ (car obj))))))
+
+(defun tabulated-list-sort (&optional n)
+ "Sort Tabulated List entries by the column at point.
+With a numeric prefix argument N, sort the Nth column."
+ (interactive "P")
+ (let ((name (if n
+ (car (aref tabulated-list-format n))
+ (get-text-property (point)
+ 'tabulated-list-column-name))))
+ (tabulated-list--sort-by-column-name name)))
+
+(defun tabulated-list--sort-by-column-name (name)
+ (when (and name (derived-mode-p 'tabulated-list-mode))
+ ;; Flip the sort order on a second click.
+ (if (equal name (car tabulated-list-sort-key))
+ (setcdr tabulated-list-sort-key
+ (not (cdr tabulated-list-sort-key)))
+ (setq tabulated-list-sort-key (cons name nil)))
+ (tabulated-list-init-header)
+ (tabulated-list-print t)))
;;; The mode definition:
-;;;###autoload
(define-derived-mode tabulated-list-mode special-mode "Tabulated"
"Generic major mode for browsing a list of items.
This mode is usually not used directly; instead, other major
(setq id (nth 2 form))
(setcdr form (nthcdr 2 form))
(setq val (testcover-reinstrument (nth 2 form)))
- (if (eq val t)
- (setcar form 'testcover-1value)
- (setcar form 'testcover-after))
+ (setcar form (if (eq val t)
+ 'testcover-1value
+ 'testcover-after))
(when val
;;1-valued or potentially 1-valued
(aset testcover-vector id '1value))
,(nth 3 (cadr form))))
t)
(t
- (if (eq (car (cadr form)) 'edebug-after)
- (setq id (car (nth 3 (cadr form))))
- (setq id (car (cadr form))))
+ (setq id (car (if (eq (car (cadr form)) 'edebug-after)
+ (nth 3 (cadr form))
+ (cadr form))))
(let ((testcover-1value-functions
(cons id testcover-1value-functions)))
(testcover-reinstrument (cadr form))))))
,(nth 3 (cadr form))))
'maybe)
(t
- (if (eq (car (cadr form)) 'edebug-after)
- (setq id (car (nth 3 (cadr form))))
- (setq id (car (cadr form))))
+ (setq id (car (if (eq (car (cadr form)) 'edebug-after)
+ (nth 3 (cadr form))
+ (cadr form))))
(let ((testcover-noreturn-functions
(cons id testcover-noreturn-functions)))
(testcover-reinstrument (cadr form))))))
(defun testcover-after (idx val)
"Internal function for coverage testing. Returns VAL after installing it in
`testcover-vector' at offset IDX."
+ (declare (gv-expander (lambda (do)
+ (gv-letplace (getter setter) val
+ (funcall do getter
+ (lambda (store)
+ `(progn (testcover-after ,idx ,getter)
+ ,(funcall setter store))))))))
(cond
((eq (aref testcover-vector idx) 'unknown)
(aset testcover-vector idx val))
;; Layout of a timer vector:
;; [triggered-p high-seconds low-seconds usecs repeat-delay
-;; function args idle-delay]
+;; function args idle-delay psecs]
;; triggered-p is nil if the timer is active (waiting to be triggered),
;; t if it is inactive ("already triggered", in theory)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
-(defstruct (timer
+(cl-defstruct (timer
(:constructor nil)
(:copier nil)
(:constructor timer-create ())
(:type vector)
(:conc-name timer--))
(triggered t)
- high-seconds low-seconds usecs repeat-delay function args idle-delay)
+ high-seconds low-seconds usecs repeat-delay function args idle-delay psecs)
(defun timerp (object)
"Return t if OBJECT is a timer."
- (and (vectorp object) (= (length object) 8)))
+ (and (vectorp object) (= (length object) 9)))
;; Pseudo field `time'.
(defun timer--time (timer)
(list (timer--high-seconds timer)
(timer--low-seconds timer)
- (timer--usecs timer)))
+ (timer--usecs timer)
+ (timer--psecs timer)))
-(defsetf timer--time
+(gv-define-simple-setter timer--time
(lambda (timer time)
(or (timerp timer) (error "Invalid timer"))
(setf (timer--high-seconds timer) (pop time))
- (setf (timer--low-seconds timer)
- (if (consp time) (car time) time))
- (setf (timer--usecs timer) (or (and (consp time) (consp (cdr time))
- (cadr time))
- 0))))
+ (let ((low time) (usecs 0) (psecs 0))
+ (if (consp time)
+ (progn
+ (setq low (pop time))
+ (if time
+ (progn
+ (setq usecs (pop time))
+ (if time
+ (setq psecs (car time)))))))
+ (setf (timer--low-seconds timer) low)
+ (setf (timer--usecs timer) usecs)
+ (setf (timer--psecs timer) psecs))))
(defun timer-set-time (timer time &optional delta)
(defun timer-set-idle-time (timer secs &optional repeat)
"Set the trigger idle time of TIMER to SECS.
SECS may be an integer, floating point number, or the internal
-time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
+time format returned by, e.g., `current-idle-time'.
If optional third argument REPEAT is non-nil, make the timer
fire each time Emacs is idle for that many seconds."
(if (consp secs)
"Yield the next value after TIME that is an integral multiple of SECS.
More precisely, the next value, after TIME, that is an integral multiple
of SECS seconds since the epoch. SECS may be a fraction."
- (let ((time-base (ash 1 16)))
- ;; Use floating point, taking care to not lose precision.
- (let* ((float-time-base (float time-base))
- (million 1000000.0)
- (time-usec (+ (* million
- (+ (* float-time-base (nth 0 time))
- (nth 1 time)))
- (nth 2 time)))
- (secs-usec (* million secs))
- (mod-usec (mod time-usec secs-usec))
- (next-usec (+ (- time-usec mod-usec) secs-usec))
- (time-base-million (* float-time-base million)))
- (list (floor next-usec time-base-million)
- (floor (mod next-usec time-base-million) million)
- (floor (mod next-usec million))))))
-
-(defun timer-relative-time (time secs &optional usecs)
- "Advance TIME by SECS seconds and optionally USECS microseconds.
-SECS may be either an integer or a floating point number."
+ (let* ((trillion 1e12)
+ (time-sec (+ (nth 1 time)
+ (* 65536.0 (nth 0 time))))
+ (delta-sec (mod (- time-sec) secs))
+ (next-sec (+ time-sec (ffloor delta-sec)))
+ (next-sec-psec (ffloor (* trillion (mod delta-sec 1))))
+ (sub-time-psec (+ (or (nth 3 time) 0)
+ (* 1e6 (nth 2 time))))
+ (psec-diff (- sub-time-psec next-sec-psec)))
+ (if (and (<= next-sec time-sec) (< 0 psec-diff))
+ (setq next-sec-psec (+ sub-time-psec
+ (mod (- psec-diff) (* trillion secs)))))
+ (setq next-sec (+ next-sec (floor next-sec-psec trillion)))
+ (setq next-sec-psec (mod next-sec-psec trillion))
+ (list (floor next-sec 65536)
+ (floor (mod next-sec 65536))
+ (floor next-sec-psec 1000000)
+ (floor (mod next-sec-psec 1000000)))))
+
+(defun timer-relative-time (time secs &optional usecs psecs)
+ "Advance TIME by SECS seconds and optionally USECS nanoseconds
+and PSECS picoseconds. SECS may be either an integer or a
+floating point number."
(let ((delta (if (floatp secs)
(seconds-to-time secs)
(list (floor secs 65536) (mod secs 65536)))))
- (if usecs
- (setq delta (time-add delta (list 0 0 usecs))))
+ (if (or usecs psecs)
+ (setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0)))))
(time-add time delta)))
(defun timer--time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2."
(time-less-p (timer--time t1) (timer--time t2)))
-(defun timer-inc-time (timer secs &optional usecs)
- "Increment the time set in TIMER by SECS seconds and USECS microseconds.
-SECS may be a fraction. If USECS is omitted, that means it is zero."
+(defun timer-inc-time (timer secs &optional usecs psecs)
+ "Increment the time set in TIMER by SECS seconds, USECS nanoseconds,
+and PSECS picoseconds. SECS may be a fraction. If USECS or PSECS are
+omitted, they are treated as zero."
(setf (timer--time timer)
- (timer-relative-time (timer--time timer) secs usecs)))
+ (timer-relative-time (timer--time timer) secs usecs psecs)))
(defun timer-set-time-with-usecs (timer time usecs &optional delta)
"Set the trigger time of TIMER to TIME plus USECS.
The microsecond count from TIME is ignored, and USECS is used instead.
If optional fourth argument DELTA is a positive number, make the timer
fire repeatedly that many seconds apart."
+ (declare (obsolete "use `timer-set-time' and `timer-inc-time' instead."
+ "22.1"))
(setf (timer--time timer) time)
(setf (timer--usecs timer) usecs)
+ (setf (timer--psecs timer) 0)
(setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta))
timer)
-(make-obsolete 'timer-set-time-with-usecs
- "use `timer-set-time' and `timer-inc-time' instead."
- "22.1")
(defun timer-set-function (timer function &optional args)
"Make TIMER call FUNCTION with optional ARGS when triggering."
(integerp (timer--high-seconds timer))
(integerp (timer--low-seconds timer))
(integerp (timer--usecs timer))
+ (integerp (timer--psecs timer))
(timer--function timer))
(let ((timers (if idle timer-idle-list timer-list))
last)
"Insert TIMER into `timer-idle-list'.
This arranges to activate TIMER whenever Emacs is next idle.
If optional argument DONT-WAIT is non-nil, set TIMER to activate
-immediately, or at the right time, if Emacs is already idle.
+immediately \(see beloe\), or at the right time, if Emacs is
+already idle.
REUSE-CELL, if non-nil, is a cons cell to reuse when inserting
TIMER into `timer-idle-list' (usually a cell removed from that
list by `cancel-timer-internal'; using this reduces consing for
-repeat timers). If nil, allocate a new cell."
+repeat timers). If nil, allocate a new cell.
+
+Using non-nil DONT-WAIT is not recommended when activating an
+idle timer from an idle timer handler, if the timer being
+activated has an idleness time that is smaller or equal to
+the time of the current timer. That's because the activated
+timer will fire right away."
(timer--activate timer (not dont-wait) reuse-cell 'idle))
(defalias 'disable-timeout 'cancel-timer)
(defvar timer-event-last-2 nil
"Third-to-last timer that was run.")
-(defvar timer-max-repeats 10
- "*Maximum number of times to repeat a timer, if many repeats are delayed.
+(defcustom timer-max-repeats 10
+ "Maximum number of times to repeat a timer, if many repeats are delayed.
Timer invocations can be delayed because Emacs is suspended or busy,
or because the system's time changes. If such an occurrence makes it
appear that many invocations are overdue, this variable controls
-how many will really happen.")
+how many will really happen."
+ :type 'integer
+ :group 'internal)
(defun timer-until (timer time)
"Calculate number of seconds from when TIMER will run, until TIME.
TIMER is a timer, and stands for the time when its next repeat is scheduled.
TIME is a time-list."
- (float-time (time-subtract time (timer--time timer))))
+ (- (float-time time) (float-time (timer--time timer))))
(defun timer-event-handler (timer)
"Call the handler for the timer TIMER.
"Perform an action the next time Emacs is idle for SECS seconds.
The action is to call FUNCTION with arguments ARGS.
SECS may be an integer, a floating point number, or the internal
-time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
+time format returned by, e.g., `current-idle-time'.
If Emacs is currently idle, and has been idle for N seconds (N < SECS),
-then it will call FUNCTION in SECS - N seconds from now.
+then it will call FUNCTION in SECS - N seconds from now. Using
+SECS <= N is not recommended if this function is invoked from an idle
+timer, because FUNCTION will then be called immediately.
If REPEAT is non-nil, do the action each time Emacs has been idle for
exactly SECS seconds (that is, only once for each time Emacs becomes idle).
activated only if the advice of FUNCTION is currently active. If FUNCTION
was not traced this is a noop."
(interactive
- (list (ad-read-advised-function "Untrace function: " 'trace-is-traced)))
+ (list (ad-read-advised-function "Untrace function" 'trace-is-traced)))
(when (trace-is-traced function)
(ad-remove-advice function 'around trace-advice-name)
(ad-update function)))
:group 'emacs-lock
:version "24.1")
+(defcustom emacs-lock-locked-buffer-functions nil
+ "Abnormal hook run when Emacs Lock prevents exiting Emacs, or killing a buffer.
+The functions get one argument, the first locked buffer found."
+ :type 'hook
+ :group 'emacs-lock
+ :version "24.3")
+
(defvar emacs-lock-mode nil
"If non-nil, the current buffer is locked.
It can be one of the following values:
(or (eq unlock 'all) (eq unlock action))))))
(defun emacs-lock--exit-locked-buffer ()
- "Return the name of the first exit-locked buffer found."
+ "Return the first exit-locked buffer found."
(save-current-buffer
(catch :found
(dolist (buffer (buffer-list))
(set-buffer buffer)
(unless (or (emacs-lock--can-auto-unlock 'exit)
(memq emacs-lock-mode '(nil kill)))
- (throw :found (buffer-name))))
+ (throw :found buffer)))
nil)))
(defun emacs-lock--kill-emacs-hook ()
"Signal an error if any buffer is exit-locked.
Used from `kill-emacs-hook' (which see)."
- (let ((buffer-name (emacs-lock--exit-locked-buffer)))
- (when buffer-name
- (error "Emacs cannot exit because buffer %S is locked" buffer-name))))
+ (let ((locked (emacs-lock--exit-locked-buffer)))
+ (when locked
+ (run-hook-with-args 'emacs-lock-locked-buffer-functions locked)
+ (error "Emacs cannot exit because buffer %S is locked"
+ (buffer-name locked)))))
(defun emacs-lock--kill-emacs-query-functions ()
"Display a message if any buffer is exit-locked.
Return a value appropriate for `kill-emacs-query-functions' (which see)."
(let ((locked (emacs-lock--exit-locked-buffer)))
- (or (not locked)
- (progn
- (message "Emacs cannot exit because buffer %S is locked" locked)
- nil))))
+ (if (not locked)
+ t
+ (run-hook-with-args 'emacs-lock-locked-buffer-functions locked)
+ (message "Emacs cannot exit because buffer %S is locked"
+ (buffer-name locked))
+ nil)))
(defun emacs-lock--kill-buffer-query-functions ()
"Display a message if the current buffer is kill-locked.
Return a value appropriate for `kill-buffer-query-functions' (which see)."
- (or (emacs-lock--can-auto-unlock 'kill)
- (memq emacs-lock-mode '(nil exit))
- (progn
- (message "Buffer %S is locked and cannot be killed" (buffer-name))
- nil)))
+ (if (or (emacs-lock--can-auto-unlock 'kill)
+ (memq emacs-lock-mode '(nil exit)))
+ t
+ (run-hook-with-args 'emacs-lock-locked-buffer-functions (current-buffer))
+ (message "Buffer %S is locked and cannot be killed" (buffer-name))
+ nil))
(defun emacs-lock--set-mode (mode arg)
"Setter function for `emacs-lock-mode'."
;; anything else (turn off)
mode))))
+(define-obsolete-variable-alias 'emacs-lock-from-exiting
+ 'emacs-lock-mode "24.1")
;;;###autoload
(define-minor-mode emacs-lock-mode
"Toggle Emacs Lock mode in the current buffer.
;;; Compatibility
-(define-obsolete-variable-alias 'emacs-lock-from-exiting 'emacs-lock-mode "24.1")
-
(defun toggle-emacs-lock ()
"Toggle `emacs-lock-from-exiting' for the current buffer."
+ (declare (obsolete emacs-lock-mode "24.1"))
(interactive)
(call-interactively 'emacs-lock-mode))
-(make-obsolete 'toggle-emacs-lock 'emacs-lock-mode "24.1")
(provide 'emacs-lock)
;; by default run `save-buffers-kill-emacs' instead of the command
;; `execute-extended-command'.
-;; Finally, if you want to change the string displayed in the modeline
-;; when this mode is in effect, override the definition of
-;; `crisp-mode-modeline-string' in your .emacs. The default value is
+;; Finally, if you want to change the string displayed in the mode
+;; line when this mode is in effect, override the definition of
+;; `crisp-mode-mode-line-string' in your .emacs. The default value is
;; " *Crisp*" which may be a bit lengthy if you have a lot of things
;; being displayed there.
;;; Code:
-(eval-when-compile (require 'cl))
-
;; local variables
(defgroup crisp nil
All the bindings are done here instead of globally to try and be
nice to the world.")
-(defcustom crisp-mode-modeline-string " *CRiSP*"
- "String to display in the modeline when CRiSP emulation mode is enabled."
+(defcustom crisp-mode-mode-line-string " *CRiSP*"
+ "String to display in the mode line when CRiSP emulation mode is enabled."
:type 'string
:group 'crisp)
+(define-obsolete-variable-alias 'crisp-mode-modeline-string
+ 'crisp-mode-mode-line-string "24.3")
+
;;;###autoload
(defcustom crisp-mode nil
"Track status of CRiSP emulation mode.
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil."
:keymap crisp-mode-map
- :lighter crisp-mode-modeline-string
+ :lighter crisp-mode-mode-line-string
(when crisp-mode
;; Make menu entries show M-u or f14 in preference to C-x u.
(put 'undo :advertised-binding
- (list* [?\M-u] [f14] (get 'undo :advertised-binding)))
+ `([?\M-u] [f14] ,@(get 'undo :advertised-binding)))
;; Force transient-mark-mode, so that the marking routines work as
;; expected. If the user turns off transient mark mode, most
;; things will still work fine except the crisp-(copy|kill)
(defface cua-global-mark
'((((min-colors 88)(class color)) :foreground "black" :background "yellow1")
(((class color)) :foreground "black" :background "yellow")
- (t :bold t))
+ (t :weight bold))
"Font used by CUA for highlighting the global mark."
:group 'cua)
;; (and region not started with C-SPC).
;; If rectangle is active, expand rectangle in specified direction and
;; ignore the movement.
- ((if window-system
- ;; Shortcut for window-system, assuming that input-decode-map is empty.
- (memq 'shift (event-modifiers
- (aref (this-single-command-raw-keys) 0)))
- (or
- ;; Check if the final key-sequence was shifted.
- (memq 'shift (event-modifiers
- (aref (this-single-command-keys) 0)))
- ;; If not, maybe the raw key-sequence was mapped by input-decode-map
- ;; to a shifted key (and then mapped down to its unshifted form).
- (let* ((keys (this-single-command-raw-keys))
- (ev (lookup-key input-decode-map keys)))
- (or (and (vector ev) (memq 'shift (event-modifiers (aref ev 0))))
- ;; Or maybe, the raw key-sequence was not an escape sequence
- ;; and was shifted (and then mapped down to its unshifted form).
- (memq 'shift (event-modifiers (aref keys 0)))))))
+ (this-command-keys-shift-translated
(unless mark-active
(push-mark-command nil t))
(setq cua--last-region-shifted t)
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;; Acknowledgements
+;;; Acknowledgments
;; The rectangle handling and display code borrows from the standard
;; GNU emacs rect.el package and the rect-mark.el package by Rick
(cua-copy-rectangle arg)
(setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
-(defun cua--mouse-ignore (event)
+(defun cua--mouse-ignore (_event)
(interactive "e")
(setq this-command last-command))
(let ((lines 0))
(if (not (cua--rectangle-virtual-edges))
(cua--rectangle-operation nil nil t 2 t
- (lambda (s e l r v)
+ (lambda (s e _l _r _v)
(setq lines (1+ lines))
(if (and (> e s) (<= e (point-max)))
(delete-region s e))))
(cua--rectangle-operation nil 1 t nil t
- (lambda (s e l r v)
+ (lambda (s e _l _r _v)
(setq lines (1+ lines))
(when (and (> e s) (<= e (point-max)))
(delete-region s e)))))
(let (rect)
(if (not (cua--rectangle-virtual-edges))
(cua--rectangle-operation nil nil nil nil nil ; do not tabify
- (lambda (s e l r)
+ (lambda (s e _l _r)
(setq rect (cons (cua--filter-buffer-noprops s e) rect))))
(cua--rectangle-operation nil 1 nil nil nil ; do not tabify
- (lambda (s e l r v)
+ (lambda (s e l r _v)
(let ((copy t) (bs 0) (as 0) row)
(if (= s e) (setq e (1+ e)))
(goto-char s)
(pad (cua--rectangle-virtual-edges))
indent)
(cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil
- (lambda (s e l r)
+ (lambda (_s _e l _r)
(move-to-column col pad)
(if (and (eolp)
(< (current-column) col))
(cua-help-for-region t))))
(defun cua-restrict-regexp-rectangle (arg)
- "Restrict rectangle to lines (not) matching REGEXP.
-With prefix argument, the toggle restriction."
+ "Restrict rectangle to lines (not) matching regexp.
+With prefix argument, toggle restriction."
(interactive "P")
- (let ((r (cua--rectangle-restriction)) regexp)
+ (let ((r (cua--rectangle-restriction)))
(if (and r (null (car (cdr r))))
(if arg
(cua--rectangle-restriction (car r) nil (not (car (cdr (cdr r)))))
(defun cua-restrict-prefix-rectangle (arg)
"Restrict rectangle to lines (not) starting with CHAR.
-With prefix argument, the toggle restriction."
+With prefix argument, toggle restriction."
(interactive "P")
- (let ((r (cua--rectangle-restriction)) regexp)
+ (let ((r (cua--rectangle-restriction)))
(if (and r (car (cdr r)))
(if arg
(cua--rectangle-restriction (car r) t (not (car (cdr (cdr r)))))
but instead winds up to the right of the rectangle."
(interactive)
(cua--rectangle-operation 'corners nil t 1 nil
- (lambda (s e l r)
+ (lambda (_s _e l r)
(skip-chars-forward " \t")
(let ((ws (- (current-column) l))
(p (point)))
With prefix arg, also delete whitespace to the left of that column."
(interactive "P")
(cua--rectangle-operation 'clear nil t 1 nil
- (lambda (s e l r)
+ (lambda (s _e _l _r)
(when arg
(skip-syntax-backward " " (line-beginning-position))
(setq s (point)))
The text previously in the rectangle is overwritten by the blanks."
(interactive)
(cua--rectangle-operation 'keep nil nil 1 nil
- (lambda (s e l r)
+ (lambda (s e _l _r)
(goto-char e)
(skip-syntax-forward " " (line-end-position))
(setq e (point))
(defun cua-align-rectangle ()
"Align rectangle lines to left column."
(interactive)
- (let (x)
- (cua--rectangle-operation 'clear nil t t nil
- (lambda (s e l r)
- (let ((b (line-beginning-position)))
- (skip-syntax-backward "^ " b)
- (skip-syntax-backward " " b)
- (setq s (point)))
- (skip-syntax-forward " " (line-end-position))
- (delete-region s (point))
- (indent-to l))
- (lambda (l r)
- (move-to-column l)
- ;; (setq cua-save-point (point))
- ))))
+ (cua--rectangle-operation 'clear nil t t nil
+ (lambda (s _e l _r)
+ (let ((b (line-beginning-position)))
+ (skip-syntax-backward "^ " b)
+ (skip-syntax-backward " " b)
+ (setq s (point)))
+ (skip-syntax-forward " " (line-end-position))
+ (delete-region s (point))
+ (indent-to l))
+ (lambda (l _r)
+ (move-to-column l)
+ ;; (setq cua-save-point (point))
+ )))
(declare-function cua--cut-rectangle-to-global-mark "cua-gmrk" (as-text))
(declare-function cua--copy-rectangle-to-global-mark "cua-gmrk" (as-text))
The length of STRING need not be the same as the rectangle width."
(interactive "sString rectangle: ")
(cua--rectangle-operation 'keep nil t t nil
- (lambda (s e l r)
+ (lambda (s e l _r)
(delete-region s e)
(skip-chars-forward " \t")
(let ((ws (- (current-column) l)))
(insert string)
(indent-to (+ (current-column) ws))))
(unless (cua--rectangle-restriction)
- (lambda (l r)
+ (lambda (l _r)
(cua--rectangle-right (max l (+ l (length string) -1)))))))
(defun cua-fill-char-rectangle (character)
(if buffer-read-only
(message "Cannot replace in read-only buffer")
(cua--rectangle-operation 'keep nil t 1 nil
- (lambda (s e l r)
+ (lambda (_s e _l _r)
(if (re-search-forward regexp e t)
(replace-match newtext nil nil))))))
"Increment each line of CUA rectangle by prefix amount."
(interactive "p")
(cua--rectangle-operation 'keep nil t 1 nil
- (lambda (s e l r)
+ (lambda (_s e _l _r)
(cond
((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
(let* ((txt (cua--filter-buffer-noprops (match-beginning 1) (match-end 1)))
(setq format cua--rectangle-seq-format)
(setq cua--rectangle-seq-format format))
(cua--rectangle-operation 'clear nil t 1 nil
- (lambda (s e l r)
+ (lambda (s e _l _r)
(delete-region s e)
(insert (format format first))
(setq first (+ first incr)))))
(defmacro cua--convert-rectangle-as (command tabify)
`(cua--rectangle-operation 'clear nil nil nil ,tabify
- (lambda (s e l r)
+ (lambda (s e _l _r)
(,command s e))))
(defun cua-upcase-rectangle ()
(if cua--debug
(print z auxbuf))
(cua--rectangle-operation nil nil t pad nil
- (lambda (s e l r)
+ (lambda (s e l _r)
(let (cc)
(goto-char e)
(skip-chars-forward " \t")
(put 'cua--rectangle-aux-replace 'lisp-indent-function 4)
-(defun cua--left-fill-rectangle (start end)
+(defun cua--left-fill-rectangle (_start _end)
(beginning-of-line)
(while (< (point) (point-max))
(delete-horizontal-space nil)
"Remove the first line of the rectangle and scroll remaining lines up."
(interactive)
(cua--rectangle-aux-replace 0 t t t t
- (lambda (s e)
+ (lambda (s _e)
(if (= (forward-line 1) 0)
(delete-region s (point))))))
The remaining lines are scrolled down, losing the last line."
(interactive)
(cua--rectangle-aux-replace 0 t t t t
- (lambda (s e)
+ (lambda (s _e)
(goto-char s)
(insert "\n"))))
(pad (cua--rectangle-virtual-edges))
indent)
(cua--rectangle-operation 'corners nil t pad nil
- (lambda (s e l r)
+ (lambda (_s _e l r)
(move-to-column
(if (cua--rectangle-right-side t)
(max (1+ r) col) l)
;; emacs -q -l edt-mapper.el
-;; The "-q" option prevents loading of your .emacs file (commands
+;; The "-q" option prevents loading of your init file (commands
;; therein might confuse this program).
;; An instruction screen showing the typical LK-201 terminal
;; and loaded automatically when the EDT emulation is started. If
;; you specify a different file name, you will need to set the
;; variable "edt-keys-file" before starting the EDT emulation.
-;; Here's how you might go about doing that in your .emacs file.
+;; Here's how you might go about doing that in your init file:
;; (setq edt-keys-file (expand-file-name "~/.my-emacs-keys"))
;; You can have the EDT Emulation start up automatically, each time
;; you initiate a GNU Emacs session, by adding the following line to
-;; your .emacs file:
+;; your init file:
;;
;; (add-hook term-setup-hook 'edt-emulation-on)
;; default, this feature is enabled, with the top margin set to
;; 10% of the window and the bottom margin set to 15% of the
;; window. To change these settings, you can invoke the function
-;; edt-set-scroll-margins in your .emacs file. For example, the
+;; edt-set-scroll-margins in your init file. For example, the
;; following line
;;
;; (edt-set-scroll-margins "20%" "25%")
;;;
;;; (setq edt-keep-current-page-delimiter t)
;;;
-;;; in your .emacs file.
+;;; in your init file.
(defun edt-page-forward (num)
"Move forward to just after next page delimiter.
Ack!! You're running the Enhanced EDT Emulation without loading an
EDT key mapping file. To create an EDT key mapping file, run the
edt-mapper program. It is safest to run it from an Emacs loaded
- without any of your own customizations found in your .emacs file, etc.
+ without any of your own customizations found in your init file, etc.
The reason for this is that some user customizations confuse edt-mapper.
You can do this by quitting Emacs and then invoking Emacs again as
follows:
emacs -q -l edt-mapper
- [NOTE: If you do nothing out of the ordinary in your .emacs file, and
+ [NOTE: If you do nothing out of the ordinary in your init file, and
the search for edt-mapper is successful, you can try running it now.]
The library edt-mapper includes these same directions on how to
(setq transient-mark-mode edt-orig-transient-mark-mode))
(message "Original key bindings restored; EDT Emulation disabled"))
+(defun edt-default-menu-bar-update-buffers ()
+ ;; Update edt-default-global-map with latest copy of
+ ;; `global-buffers-menu-map' each time `menu-bar-update-buffers'
+ ;; updates global-map.
+ (define-key edt-default-global-map [menu-bar buffer]
+ (cons "Buffers" global-buffers-menu-map)))
+
+(defun edt-user-menu-bar-update-buffers ()
+ ;; We need to update edt-user-global-map with latest copy of
+ ;; `global-buffers-menu-map' each time `menu-bar-update-buffers'
+ ;; updates global-map.
+ (define-key edt-user-global-map [menu-bar buffer]
+ (cons "Buffers" global-buffers-menu-map)))
+
(defun edt-default-emulation-setup (&optional user-setup)
"Setup emulation of DEC's EDT editor.
Optional argument USER-SETUP non-nil means called from function
(progn
(fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map))
(edt-select-default-global-map)))
- ;; We need to share `global-buffers-menu-map' with the saved global
- ;; keymap, because `menu-bar-update-buffers' directly changes it.
- (define-key (current-global-map) [menu-bar buffer]
- (cons "Buffers" global-buffers-menu-map)))
+ ;; Keep the menu bar Buffers menu up-to-date in edt-default-global-map.
+ (add-hook 'menu-bar-update-hook 'edt-default-menu-bar-update-buffers))
(defun edt-user-emulation-setup ()
"Setup user custom emulation of DEC's EDT editor."
;; See Info node `edt' for more details, and sample edt-user.el file.
(if (fboundp 'edt-setup-user-bindings)
(edt-setup-user-bindings))
- (edt-select-user-global-map))
+ (edt-select-user-global-map)
+ ;; Keep the menu bar Buffers menu up-to-date in edt-user-global-map.
+ (add-hook 'menu-bar-update-hook 'edt-user-menu-bar-update-buffers))
(defun edt-select-default-global-map()
"Select default EDT emulation key bindings."
;; and type `tpu-edt' followed by a carriage return.
;; If you like TPU-edt and want to use it all the time, you can start
-;; TPU-edt using the Emacs initialization file, .emacs. Simply create
-;; a .emacs file in your home directory containing the line:
+;; TPU-edt using the Emacs initialization file, .emacs. Simply add
+;; the following line to your init file:
;; (tpu-edt)
;;; Global Keymaps
;;;
+(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1")
(defvar tpu-gold-map
(let ((map (make-keymap)))
;; Previously we used escape sequences here. We now instead presume
map)
"Maps the function keys on the VT100 keyboard preceded by PF1.
GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
-(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1")
(defvar tpu-global-map
(let ((map (make-sparse-keymap)))
\f
;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins
-;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "76f06905db4c5bfb3b86491a51512a0e")
+;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "bf5e7322f9a2c324a3bb306415813374")
;;; Generated autoloads from tpu-extras.el
(autoload 'tpu-cursor-free-mode "tpu-extras" "\
;; Use the functions defined here to customize TPU-edt to your tastes by
;; setting scroll margins and/or turning on free cursor mode. Here's an
-;; example for your .emacs file.
+;; example for your init file.
;; (tpu-set-cursor-free) ; Set cursor free.
;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins.
definitions. If you chose the default, TPU-edt will find it and load it
automatically. If you specify a different file name, you will need to
set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how
-you might go about doing that in your .emacs file.
+you might go about doing that in your init file.
(setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\"))
(tpu-edt)
;; (if (not (or (eq major-mode 'Info-mode)
;; (eq major-mode 'vi-mode)))
;; (vi-mode))))))
-;; 3) In your .emacs file you can define the command "vi-mode" to be "autoload"
+;; 3) In your init file you can define the command "vi-mode" to be "autoload"
;; or you can execute the "load" command to load "vi" directly.
;; 4) Read the comments for command "vi-mode" before you start using it.
(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.
(defcustom viper-smart-suffix-list
'("" "tex" "c" "cc" "C" "java" "el" "html" "htm" "xml"
"pl" "flr" "P" "p" "h" "H")
- "*List of suffixes that Viper tries to append to filenames ending with a `.'.
+ "List of suffixes that Viper tries to append to filenames ending with a `.'.
This is useful when the current directory contains files with the same
prefix and many different suffixes. Usually, only one of the suffixes
represents an editable file. However, file completion will stop at the `.'
(defun viper-adjust-window ()
(let ((win-height (if (featurep 'xemacs)
(window-displayed-height)
- (1- (window-height)))) ; adjust for modeline
+ (1- (window-height)))) ; adjust for mode line
(pt (point))
at-top-p at-bottom-p
min-scroll direction)
(defvar viper-keep-reading-filename nil)
(defcustom ex-cycle-other-window t
- "*If t, :n and :b cycles through files and buffers in other window.
+ "If t, :n and :b cycles through files and buffers in other window.
Then :N and :B cycles in the current window. If nil, this behavior is
reversed."
:type 'boolean
:group 'viper-ex)
(defcustom ex-cycle-through-non-files nil
- "*Cycle through *scratch* and other buffers that don't visit any file."
+ "Cycle through *scratch* and other buffers that don't visit any file."
:type 'boolean
:group 'viper-ex)
;;; 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))
;; (viper-loop COUNT BODY) Execute BODY COUNT times.
(defmacro viper-loop (count &rest body)
+ (declare (indent defun))
`(let ((count ,count))
(while (> count 0)
,@body
))
;; viper hook to run on input-method deactivation
-(defun viper-inactivate-input-method-action ()
+(defun viper-deactivate-input-method-action ()
(if (null viper-mule-hook-flag)
()
(setq viper-special-input-method nil)
(or current-input-method default-input-method))
"")))))
-(defun viper-inactivate-input-method ()
- (cond ((and (featurep 'emacs) (fboundp 'inactivate-input-method))
- (inactivate-input-method))
+(defun viper-deactivate-input-method ()
+ (cond ((and (featurep 'emacs) (fboundp 'deactivate-input-method))
+ (deactivate-input-method))
((and (featurep 'xemacs) (boundp 'current-input-method))
;; XEmacs had broken quail-mode for some time, so we are working around
;; it here
(quail-delete-overlays))
(setq describe-current-input-method-function nil)
(setq current-input-method nil)
- (run-hooks 'input-method-inactivate-hook)
+ (run-hooks
+ 'input-method-inactivate-hook ; for backward compatibility
+ 'input-method-deactivate-hook)
(force-mode-line-update))
))
(defun viper-activate-input-method ()
;; activate input method
(viper-activate-input-method))
(t ; deactivate input method
- (viper-inactivate-input-method)))
+ (viper-deactivate-input-method)))
))
(defconst viper-buffer-undo-list-mark 'viper)
(defcustom viper-keep-point-on-undo nil
- "*Non-nil means not to move point while undoing commands.
+ "Non-nil means not to move point while undoing commands.
This style is different from Emacs and Vi. Try it to see if
it better fits your working style."
:type 'boolean
:group 'viper)
(defcustom viper-replace-overlay-cursor-color "Red"
- "*Cursor color when Viper is in Replace state."
+ "Cursor color when Viper is in Replace state."
:type 'string
:group 'viper)
(defcustom viper-use-replace-region-delimiters
(or (not (viper-has-face-support-p))
(and (featurep 'xemacs) (eq (viper-device-type) 'tty)))
- "*If non-nil, Viper will always use `viper-replace-region-end-delimiter' and
+ "If non-nil, Viper will always use `viper-replace-region-end-delimiter' and
`viper-replace-region-start-delimiter' to delimit replacement regions, even on
color displays. By default, the delimiters are used only on TTYs."
:type 'boolean
;; Fast keyseq and ESC keyseq timeouts
(defcustom viper-fast-keyseq-timeout 200
- "*Key sequence separated by no more than this many milliseconds is viewed as a Vi-style macro, if such a macro is defined.
+ "Key sequence separated by no more than this many milliseconds is viewed as a Vi-style macro, if such a macro is defined.
Setting this too high may slow down your typing. Setting this value too low
will make it hard to use Vi-style timeout macros."
:type 'integer
(viper-deflocalvar viper-auto-indent nil "")
(defcustom viper-auto-indent nil
- "*Enable autoindent, if t.
+ "Enable autoindent, if t.
This is a buffer-local variable."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-electric-mode t "")
(defcustom viper-electric-mode t
- "*If t, electrify Viper.
+ "If t, electrify Viper.
Currently, this only electrifies auto-indentation, making it appropriate to the
mode of the buffer.
This means that auto-indentation will depart from standard Vi and will indent
:group 'viper)
(defcustom viper-shift-width 8
- "*The value of the shiftwidth.
+ "The value of the shiftwidth.
This determines the number of columns by which the Ctl-t moves the cursor in
the Insert state."
:type 'integer
;; Variables for repeating destructive commands
(defcustom viper-keep-point-on-repeat t
- "*If t, don't move point when repeating previous command.
+ "If t, don't move point when repeating previous command.
This is useful for doing repeated changes with the '.' key.
The user can change this to nil, if she likes when the cursor moves
to a new place after repeating previous Vi command."
(defvar viper-s-forward nil)
(defcustom viper-case-fold-search nil
- "*If not nil, search ignores cases."
+ "If not nil, search ignores cases."
:type 'boolean
:group 'viper-search)
(defcustom viper-re-search t
- "*If not nil, search is regexp search, otherwise vanilla search."
+ "If not nil, search is regexp search, otherwise vanilla search."
:type 'boolean
:tag "Regexp Search"
:group 'viper-search)
(defcustom viper-search-scroll-threshold 2
- "*If search lands within this threshold from the window top/bottom,
+ "If search lands within this threshold from the window top/bottom,
the window will be scrolled up or down appropriately, to reveal context.
If you want Viper search to behave as usual in Vi, set this variable to a
negative number."
:group 'viper-search)
(defcustom viper-re-query-replace t
- "*If t then do regexp replace, if nil then do string replace."
+ "If t then do regexp replace, if nil then do string replace."
:type 'boolean
:tag "Regexp Query Replace"
:group 'viper-search)
(defcustom viper-re-replace t
- "*If t, do regexp replace. nil means do string replace."
+ "If t, do regexp replace. nil means do string replace."
:type 'boolean
:tag "Regexp Replace"
:group 'viper-search)
(defcustom viper-parse-sexp-ignore-comments t
- "*If t, `%' ignores the parentheses that occur inside comments."
+ "If t, `%' ignores the parentheses that occur inside comments."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-ex-style-motion t "")
(defcustom viper-ex-style-motion t
- "*If t, the commands l,h do not cross lines, etc (Ex-style).
+ "If t, the commands l,h do not cross lines, etc (Ex-style).
If nil, these commands cross line boundaries."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-ex-style-editing t "")
(defcustom viper-ex-style-editing t
- "*If t, Ex-style behavior while editing in Vi command and insert states.
+ "If t, Ex-style behavior while editing in Vi command and insert states.
`Backspace' and `Delete' don't cross line boundaries in insert.
`X' and `x' can't delete characters across line boundary in Vi, etc.
Note: this doesn't preclude `Backspace' and `Delete' from deleting characters
(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing "")
(defcustom viper-ESC-moves-cursor-back nil
- "*If t, ESC moves cursor back when changing from insert to vi state.
+ "If t, ESC moves cursor back when changing from insert to vi state.
If nil, the cursor stays where it was when ESC was hit."
:type 'boolean
:group 'viper)
(viper-deflocalvar viper-delete-backwards-in-replace nil "")
(defcustom viper-delete-backwards-in-replace nil
- "*If t, DEL key will delete characters while moving the cursor backwards.
+ "If t, DEL key will delete characters while moving the cursor backwards.
If nil, the cursor will move backwards without deleting anything."
:type 'boolean
:group 'viper)
(defcustom viper-buffer-search-char nil
- "*Key used for buffer-searching. Must be a character type, e.g., ?g."
+ "Key used for buffer-searching. Must be a character type, e.g., ?g."
:type '(choice (const nil) character)
:group 'viper-search)
(defcustom viper-search-wrap-around t
- "*If t, search wraps around."
+ "If t, search wraps around."
:type 'boolean
:tag "Search Wraps Around"
:group 'viper-search)
(viper-deflocalvar viper-related-files-and-buffers-ring nil "")
(defcustom viper-related-files-and-buffers-ring nil
- "*List of file and buffer names that are considered to be related to the current buffer.
+ "List of file and buffer names that are considered to be related to the current buffer.
Related buffers can be cycled through via :R and :P commands."
:type 'boolean
:group 'viper-misc)
"^\\\\[sb][a-z]*{.*}\\s-*$\\|" ; latex
"^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ; texinfo
"^.+:-") ; prolog
- "*Regexps for Headings. Used by \[\[ and \]\].")
+ "Regexps for Headings. Used by \[\[ and \]\].")
(defvar viper-heading-end
(concat "^}\\|" ; C/C++
(defface viper-search
'((((class color)) (:foreground "Black" :background "khaki"))
(t (:underline t :stipple "gray3")))
- "*Face used to flash out the search pattern."
+ "Face used to flash out the search pattern."
:group 'viper-highlighting)
;; An internal variable. Viper takes the face from here.
(defvar viper-search-face 'viper-search
(defface viper-replace-overlay
'((((class color)) (:foreground "Black" :background "darkseagreen2"))
(t (:underline t :stipple "gray3")))
- "*Face for highlighting replace regions on a window display."
+ "Face for highlighting replace regions on a window display."
:group 'viper-highlighting)
;; An internal variable. Viper takes the face from here.
(defvar viper-replace-overlay-face 'viper-replace-overlay
:group 'viper)
(defcustom viper-vi-state-hook 'viper-restore-cursor-type
- "*Hooks run just before the switch to Vi mode is completed."
+ "Hooks run just before the switch to Vi mode is completed."
:type 'hook
:group 'viper-hooks)
(defcustom viper-insert-state-hook 'viper-set-insert-cursor-type
- "*Hooks run just before the switch to Insert mode is completed."
+ "Hooks run just before the switch to Insert mode is completed."
:type 'hook
:group 'viper-hooks)
(defcustom viper-replace-state-hook 'viper-restore-cursor-type
- "*Hooks run just before the switch to Replace mode is completed."
+ "Hooks run just before the switch to Replace mode is completed."
:type 'hook
:group 'viper-hooks)
(defcustom viper-emacs-state-hook 'viper-restore-cursor-type
- "*Hooks run just before the switch to Emacs mode is completed."
+ "Hooks run just before the switch to Emacs mode is completed."
:type 'hook
:group 'viper-hooks)
(setq cursor-type '(bar . 2))))
(defun viper-ESC-keyseq-timeout ()
- "*Key sequence beginning with ESC and separated by no more than this many milliseconds is considered to be generated by a keyboard function key.
+ "Key sequence beginning with ESC and separated by no more than this many milliseconds is considered to be generated by a keyboard function key.
Setting this too high may slow down switching from insert to vi state. Setting
this value too low will make it impossible to use function keys in insert mode
on a dumb terminal."
;;; Emacs keys in other states.
(defcustom viper-want-emacs-keys-in-insert t
- "*Set to nil if you want complete Vi compatibility in insert mode.
+ "Set to nil if you want complete Vi compatibility in insert mode.
Complete compatibility with Vi is not recommended for power use of Viper."
:type 'boolean
:group 'viper)
(defcustom viper-want-emacs-keys-in-vi t
- "*Set to nil if you want complete Vi compatibility in Vi mode.
+ "Set to nil if you want complete Vi compatibility in Vi mode.
Full Vi compatibility is not recommended for power use of Viper."
:type 'boolean
:group 'viper)
(defcustom viper-no-multiple-ESC t
- "*If true, multiple ESC in Vi mode will cause bell to ring.
+ "If true, multiple ESC in Vi mode will cause bell to ring.
This is set to t on a windowing terminal and to 'twice on a dumb
terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this
enables cursor keys and is generally more convenient, as terminals usually
:group 'viper)
(defcustom viper-want-ctl-h-help nil
- "*If non-nil, C-h gets bound to help-command; otherwise, C-h gets the usual Vi bindings."
+ "If non-nil, C-h gets bound to help-command; otherwise, C-h gets the usual Vi bindings."
:type 'boolean
:group 'viper)
(defvar viper-current-frame-saved (selected-frame))
(defcustom viper-surrounding-word-function 'viper-surrounding-word
- "*Function that determines what constitutes a word for clicking events.
+ "Function that determines what constitutes a word for clicking events.
Takes two parameters: a COUNT, indicating how many words to return,
and CLICK-COUNT, telling whether this is the first click, a double-click,
or a triple-click."
mouse-track-multi-click-time
double-click-time)
500)
- "*Time interval in millisecond within which successive mouse clicks are
+ "Time interval in millisecond within which successive mouse clicks are
considered related."
:type 'integer
:group 'viper-mouse)
(defcustom viper-mouse-search-key '(meta shift 1)
- "*Key used to click-search in Viper.
+ "Key used to click-search in Viper.
This must be a list that specifies the mouse button and modifiers.
The supported modifiers are `meta', `shift', and `control'.
For instance, `(meta shift 1)' means that holding the meta and shift
:group 'viper-mouse)
(defcustom viper-mouse-insert-key '(meta shift 2)
- "*Key used to click-insert in Viper.
+ "Key used to click-insert in Viper.
Must be a list that specifies the mouse button and modifiers.
The supported modifiers are `meta', `shift', and `control'.
For instance, `(meta shift 2)' means that holding the meta and shift keys
(viper-update-syntax-classes))
(defcustom viper-syntax-preference 'reformed-vi
- "*Syntax type characterizing Viper's alphanumeric symbols.
+ "Syntax type characterizing Viper's alphanumeric symbols.
Affects movement and change commands that deal with Vi-style words.
Works best when set in the hooks to various major modes.
;; (require 'viper)
;;
-;;; Acknowledgements:
-;; -----------------
+;;; Acknowledgments:
+;; ----------------
;; Bug reports and ideas contributed by many users have helped
;; improve Viper and the various versions of VIP.
;; See the on-line manual for a complete list of contributors.
If t, viperize Emacs. If nil -- don't. If `ask', ask the user.
This variable is used primarily when Viper is being loaded.
-Must be set in `~/.emacs' before Viper is loaded.
+Must be set in your init file before Viper is loaded.
DO NOT set this variable interactively, unless you are using the customization
widget."
:type '(choice (const nil) (const t) (const ask))
view-mode
vm-mode
vm-summary-mode)
- "*A list of major modes that should come up in Emacs state.
+ "A list of major modes that should come up in Emacs state.
Normally, Viper would bring buffers up in Emacs state, unless the corresponding
major mode has been placed on `viper-vi-state-mode-list' or
`viper-insert-state-mode-list'. So, don't place a new mode on this list,
erc-mode
eshell-mode
shell-mode)
- "*A list of major modes that should come up in Vi Insert state."
+ "A list of major modes that should come up in Vi Insert state."
:type '(repeat symbol)
:group 'viper-misc)
(if (featurep 'emacs)
(eval-after-load "mule-cmds"
'(progn
- (defadvice inactivate-input-method (after viper-mule-advice activate)
+ (defadvice deactivate-input-method (after viper-mule-advice activate)
"Set viper-special-input-method to disable intl. input methods."
- (viper-inactivate-input-method-action))
+ (viper-deactivate-input-method-action))
(defadvice activate-input-method (after viper-mule-advice activate)
"Set viper-special-input-method to enable intl. input methods."
(viper-activate-input-method-action))
'(progn
(add-hook 'input-method-activate-hook
'viper-activate-input-method-action t)
- (add-hook 'input-method-inactivate-hook
- 'viper-inactivate-input-method-action t)))
+ (add-hook 'input-method-deactivate-hook
+ 'viper-deactivate-input-method-action t)))
)
(eval-after-load "mule-cmds"
'(defadvice toggle-input-method (around viper-mule-advice activate)
"Adjust input-method toggling in vi-state."
(if (and viper-special-input-method (eq viper-current-state 'vi-state))
- (viper-inactivate-input-method)
+ (viper-deactivate-input-method)
ad-do-it)))
) ; viper-set-hooks
(setq viper-mode t)
(require 'viper)
-in your .emacs file (preferably, close to the top).
+in your init file (preferably, close to the top).
These two lines must come in the order given.
** Viper users:
;;; Code:
-(eval-when-compile (require 'cl))
-
;; History list for environment variable names.
(defvar read-envvar-name-history nil)
If no one is selected, symmetric encryption will be performed. "
recipients)
(if recipients
- (mapcar
- (lambda (recipient)
- (setq recipient-key
- (epa-mail--find-usable-key
- (epg-list-keys
- (epg-make-context epa-protocol)
- (if (string-match "@" recipient)
- (concat "<" recipient ">")
- recipient))
- 'encrypt))
- (unless (or recipient-key
- (y-or-n-p
- (format
- "No public key for %s; skip it? "
- recipient)))
- (error "No public key for %s" recipient))
- recipient-key)
- recipients)))
+ (apply
+ 'nconc
+ (mapcar
+ (lambda (recipient)
+ (setq recipient-key
+ (epa-mail--find-usable-key
+ (epg-list-keys
+ (epg-make-context epa-protocol)
+ (if (string-match "@" recipient)
+ (concat "<" recipient ">")
+ recipient))
+ 'encrypt))
+ (unless (or recipient-key
+ (y-or-n-p
+ (format
+ "No public key for %s; skip it? "
+ recipient)))
+ (error "No public key for %s" recipient))
+ (if recipient-key (list recipient-key)))
+ recipients))))
(setq sign (if verbose (y-or-n-p "Sign? ")))
(if sign
(epa-select-keys context
:group 'epa)
(defface epa-validity-high
- `((((class color) (background dark))
- (:foreground "PaleTurquoise"
- ,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t))))
- (t
- (,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t)))))
- "Face used for displaying the high validity."
+ '((default :weight bold)
+ (((class color) (background dark)) :foreground "PaleTurquoise"))
+ "Face for high validity EPA information."
:group 'epa-faces)
(defface epa-validity-medium
- `((((class color) (background dark))
- (:foreground "PaleTurquoise"
- ,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t))))
- (t
- (,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t)))))
- "Face used for displaying the medium validity."
+ '((default :slant italic)
+ (((class color) (background dark)) :foreground "PaleTurquoise"))
+ "Face for medium validity EPA information."
:group 'epa-faces)
(defface epa-validity-low
- `((t
- (,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t)))))
+ '((t :slant italic))
"Face used for displaying the low validity."
:group 'epa-faces)
(defface epa-validity-disabled
- `((t
- (,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t))
- :inverse-video t)))
+ '((t :slant italic :inverse-video t))
"Face used for displaying the disabled validity."
:group 'epa-faces)
(defface epa-string
'((((class color) (background dark))
- (:foreground "lightyellow"))
+ :foreground "lightyellow")
(((class color) (background light))
- (:foreground "blue4")))
+ :foreground "blue4"))
"Face used for displaying the string."
:group 'epa-faces)
(defface epa-mark
- `((((class color) (background dark))
- (:foreground "orange"
- ,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t))))
- (((class color) (background light))
- (:foreground "red"
- ,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t))))
- (t
- (,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t)))))
+ '((default :weight bold)
+ (((class color) (background dark)) :foreground "orange")
+ (((class color) (background light)) :foreground "red"))
"Face used for displaying the high validity."
:group 'epa-faces)
(defface epa-field-name
- `((((class color) (background dark))
- (:foreground "PaleTurquoise"
- ,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t))))
- (t
- (,@(if (assq ':weight custom-face-attributes)
- '(:weight bold)
- '(:bold t)))))
+ '((default :weight bold)
+ (((class color) (background dark)) :foreground "PaleTurquoise"))
"Face for the name of the attribute field."
:group 'epa)
(defface epa-field-body
- `((((class color) (background dark))
- (:foreground "turquoise"
- ,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t))))
- (t
- (,@(if (assq ':slant custom-face-attributes)
- '(:slant italic)
- '(:italic t)))))
+ '((default :slant italic)
+ (((class color) (background dark)) :foreground "turquoise"))
"Face for the body of the attribute field."
:group 'epa)
(20 . ?G)))
(defvar epa-protocol 'OpenPGP
- "*The default protocol.
+ "The default protocol.
The value can be either OpenPGP or CMS.
You should bind this variable with `let', but do not set it globally.")
(defvar epa-armor nil
- "*If non-nil, epa commands create ASCII armored output.
+ "If non-nil, epa commands create ASCII armored output.
You should bind this variable with `let', but do not set it globally.")
(defvar epa-textmode nil
- "*If non-nil, epa commands treat input files as text.
+ "If non-nil, epa commands treat input files as text.
You should bind this variable with `let', but do not set it globally.")
(message "%s" info)))
(defun epa-display-verify-result (verify-result)
+ (declare (obsolete epa-display-info "23.1"))
(epa-display-info (epg-verify-result-to-string verify-result)))
-(make-obsolete 'epa-display-verify-result 'epa-display-info "23.1")
(defun epa-passphrase-callback-function (context key-id handback)
(if (eq key-id 'SYM)
"Report bugs to this address.")
(defgroup epg ()
- "The EasyPG library."
+ "Interface to the GNU Privacy Guard (GnuPG)."
+ :tag "EasyPG"
:version "23.1"
- :group 'data)
+ :group 'data
+ :group 'external)
(defcustom epg-gpg-program (or (executable-find "gpg")
(executable-find "gpg2")
(epg-context-set-result-for context 'import-status nil)))
(defun epg-passphrase-callback-function (context key-id _handback)
+ (declare (obsolete epa-passphrase-callback-function "23.1"))
(if (eq key-id 'SYM)
(read-passwd "Passphrase for symmetric encryption: "
(eq (epg-context-operation context) 'encrypt))
(format "Passphrase for %s %s: " key-id (cdr entry))
(format "Passphrase for %s: " key-id)))))))
-(make-obsolete 'epg-passphrase-callback-function
- 'epa-passphrase-callback-function "23.1")
-
(defun epg--list-keys-1 (context name mode)
(let ((args (append (if epg-gpg-home-directory
(list "--homedir" epg-gpg-home-directory))
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-sign-keys' instead."
+ (declare (obsolete nil "23.1"))
(epg-context-set-operation context 'sign-keys)
(epg-context-set-result context nil)
(epg--start context (cons (if local
(epg-sub-key-id
(car (epg-key-sub-key-list key))))
keys))))
-(make-obsolete 'epg-start-sign-keys "do not use." "23.1")
(defun epg-sign-keys (context keys &optional local)
"Sign KEYS from the key ring."
+ (declare (obsolete nil "23.1"))
(unwind-protect
(progn
(epg-start-sign-keys context keys local)
(list "Sign keys failed"
(epg-errors-to-string errors))))))
(epg-reset context)))
-(make-obsolete 'epg-sign-keys "do not use." "23.1")
(defun epg-start-generate-key (context parameters)
"Initiate a key generation.
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-25 Chong Yidong <cyd@gnu.org>
- * Version 24.2 released.
+ * erc.el (erc-send-command): Use define-obsolete-function-alias.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-09-17 Chong Yidong <cyd@gnu.org>
- * Version 24.1 released.
+ * erc-page.el (erc-page-function):
+
+ * erc-stamp.el (erc-stamp): Doc fix.
+
+2012-08-21 Josh Feinstein <jlf@foxtail.org>
+
+ * erc-join.el (erc-autojoin-timing): Fix defcustom type.
+
+2012-08-21 Julien Danjou <julien@danjou.info>
+
+ * erc-match.el (erc-match-message): Use
+ `erc-match-exclude-server-buffer' not
+ `erc-track-exclude-server-buffer'.
+
+2012-08-20 Josh Feinstein <jlf@foxtail.org>
+
+ * erc.el (erc-display-message): Abstract message hiding decision
+ to new function erc-hide-current-message-p.
+ (erc-lurker): New customization group.
+ (erc-lurker-state, erc-lurker-trim-nicks, erc-lurker-ignore-chars)
+ (erc-lurker-hide-list, erc-lurker-cleanup-interval)
+ (erc-lurker-threshold-time): New variables.
+ (erc-lurker-maybe-trim, erc-lurker-initialize, erc-lurker-cleanup)
+ (erc-hide-current-message-p, erc-canonicalize-server-name)
+ (erc-lurker-update-status, erc-lurker-p): New functions. Together
+ they maintain state about which users have spoken in the last
+ erc-lurker-threshold-time, with all other users being considered
+ lurkers whose messages of types in erc-lurker-hide-list will not
+ be displayed by erc-display-message.
+
+2012-08-06 Julien Danjou <julien@danjou.info>
+
+ * 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 <julien@danjou.info>
+
+ * erc-notifications.el: New file.
+
+2012-06-15 Julien Danjou <julien@danjou.info>
+
+ * erc.el (erc-open): Use `auth-source' for password retrieval when
+ possible.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * erc-dcc.el (erc-dcc-chat-filter-functions): Rename from
+ erc-dcc-chat-filter-hook, since this is an abnormal hook.
+
+2012-06-08 Chong Yidong <cyd@gnu.org>
+
+ * erc.el (erc-direct-msg-face, erc-header-line, erc-input-face)
+ (erc-command-indicator-face, erc-notice-face, erc-action-face)
+ (erc-error-face, erc-my-nick-face, erc-nick-default-face)
+ (erc-nick-msg-face): Use new-style face specs, and avoid :bold.
+
+ * erc-button.el (erc-button):
+ * erc-goodies.el (erc-bold-face, erc-inverse-face)
+ (erc-underline-face, fg:erc-color-*):
+ * erc-match.el (erc-current-nick-face, erc-dangerous-host-face)
+ (erc-pal-face, erc-fool-face, erc-keyword-face):
+ * erc-stamp.el (erc-timestamp-face): Likewise.
+
+2012-06-02 Chong Yidong <cyd@gnu.org>
+
+ * erc-track.el (erc-track, erc-track-faces-priority-list)
+ (erc-track-faces-normal-list, erc-track-find-face)
+ (erc-track-modified-channels): Fix modeline -> mode line in docs.
+
+2012-05-14 Mike Kazantsev <mk.fraggod@gmail.com> (tiny change)
+
+ * erc-dcc.el (erc-dcc-handle-ctcp-send): Fix a regression
+ introduced on 2011-11-28 when fixing quoted filenames matching,
+ the regex group was not corrected.
+
+2012-05-13 Teemu Likonen <tlikonen@iki.fi>
+
+ * erc-backend.el (erc-server-timestamp-format): New variable to
+ allow specifying the timestamp format (bug#10779).
+
+2012-04-11 Vivek Dasmohapatra <vivek@etla.org>
+
+ * erc-services.el (erc-nickserv-passwords): Don't display the
+ password (bug#4459).
+
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * erc-join.el (erc-server-join-channel): New function to look up
+ the channel password via auth-source.
+ (erc-autojoin-channels): Use it.
+ (erc-autojoin-after-ident): Ditto.
+ (erc-autojoin-channels-alist): Mention auth-source.
+
+2012-04-10 Deniz Dogan <deniz@dogan.se> (tiny change)
+
+ * erc.el (erc-display-prompt): Adds the field text property to the
+ ERC prompt. This allows users to use `kill-whole-line' to kill
+ all text back to the prompt given that it's on a single line
+ (bug#10841).
+
+2012-04-09 Chong Yidong <cyd@gnu.org>
+
+ * erc.el (erc-cmd-SET): Call custom-variable-p instead of
+ user-variable-p.
2012-02-08 Glenn Morris <rgm@gnu.org>
(remove-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators))))
(defcustom erc-autoaway-idle-method 'user
- "*The method used to determine how long you have been idle.
+ "The method used to determine how long you have been idle.
If 'user, the time of the last command sent to Emacs is used.
If 'emacs, the idle time in Emacs is used.
If 'irc, the time of the last IRC command is used.
(set sym val))))
(defcustom erc-auto-set-away t
- "*If non-nil, set away after `erc-autoaway-idle-seconds' seconds of idling.
+ "If non-nil, set away after `erc-autoaway-idle-seconds' seconds of idling.
ERC autoaway mode can set you away when you idle, and set you no
longer away when you type something. This variable controls whether
you will be set away when you idle. See `erc-auto-discard-away' for
:type 'boolean)
(defcustom erc-auto-discard-away t
- "*If non-nil, sending anything when away automatically discards away state.
+ "If non-nil, sending anything when away automatically discards away state.
ERC autoaway mode can set you away when you idle, and set you no
longer away when you type something. This variable controls whether
you will be set no longer away when you type something. See
:type 'boolean)
(defcustom erc-autoaway-no-auto-discard-regexp "^/g?away.*$"
- "*Input that matches this will not automatically discard away status.
+ "Input that matches this will not automatically discard away status.
See `erc-auto-discard-away'."
:group 'erc-autoaway
:type 'regexp)
(defcustom erc-autoaway-idle-seconds 1800
- "*Number of seconds after which ERC will set you automatically away.
+ "Number of seconds after which ERC will set you automatically away.
If you are changing this variable using lisp instead of customizing it,
you have to run `erc-autoaway-reestablish-idletimer' afterwards."
:group 'erc-autoaway
(defcustom erc-autoaway-message
"I'm gone (autoaway after %i seconds of idletime)"
- "*Message ERC will use when setting you automatically away.
+ "Message ERC will use when setting you automatically away.
It is used as a `format' string with the argument of the idletime
in seconds."
:group 'erc-autoaway
:type 'number)
(defcustom erc-split-line-length 440
- "*The maximum length of a single message.
+ "The maximum length of a single message.
If a message exceeds this size, it is broken into multiple ones.
IRC allows for lines up to 512 bytes. Two of them are CR LF.
:type 'function)
(defcustom erc-server-prevent-duplicates '("301")
- "*Either nil or a list of strings.
+ "Either nil or a list of strings.
Each string is a IRC message type, like PRIVMSG or NOTICE.
All Message types in that list of subjected to duplicate prevention."
:type '(choice (const nil) (list string))
:group 'erc-server)
(defcustom erc-server-duplicate-timeout 60
- "*The time allowed in seconds between duplicate messages.
+ "The time allowed in seconds between duplicate messages.
If two identical messages arrive within this value of one another, the second
isn't displayed."
:type 'integer
:group 'erc-server)
+(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.3"
+ :type 'string
+ :group 'erc-server)
+
;;; Flood-related
;; Most of this is courtesy of Jorgen Schaefer and Circe
;; (http://www.nongnu.org/circe)
(defcustom erc-server-flood-margin 10
- "*A margin on how much excess data we send.
+ "A margin on how much excess data we send.
The flood protection algorithm of ERC works like the one
detailed in RFC 2813, section 5.8 \"Flood control of clients\".
;; Ping handling
(defcustom erc-server-send-ping-interval 30
- "*Interval of sending pings to the server, in seconds.
+ "Interval of sending pings to the server, in seconds.
If this is set to nil, pinging the server is disabled."
:group 'erc-server
:type '(choice (const :tag "Disabled" nil)
(integer :tag "Seconds")))
(defcustom erc-server-send-ping-timeout 120
- "*If the time between ping and response is greater than this, reconnect.
+ "If the time between ping and response is greater than this, reconnect.
The time is in seconds.
This must be greater than or equal to the value for
"The channel topic has changed." nil
(let* ((ch (first (erc-response.command-args parsed)))
(topic (erc-trim-string (erc-response.contents parsed)))
- (time (format-time-string "%T %m/%d/%y" (current-time))))
+ (time (format-time-string erc-server-timestamp-format
+ (current-time))))
(multiple-value-bind (nick login host)
(values-list (erc-parse-user (erc-response.sender parsed)))
(erc-update-channel-member ch nick nick nil nil nil host login)
(multiple-value-bind (nick seconds-idle on-since time)
(values-list (cdr (erc-response.command-args parsed)))
(setq time (when on-since
- (format-time-string "%T %Y/%m/%d"
+ (format-time-string erc-server-timestamp-format
(erc-string-to-emacs-time on-since))))
(erc-update-user-nick nick nick nil nil nil
(and time (format "on since %s" time)))
(third (erc-response.command-args parsed)))))
(erc-display-message
parsed 'notice (erc-get-buffer channel proc)
- 's329 ?c channel ?t (format-time-string "%A %Y/%m/%d %X" time))))
+ 's329 ?c channel ?t (format-time-string erc-server-timestamp-format
+ time))))
(define-erc-response-handler (330)
"Nick is authed as (on Quakenet network)." nil
"Who set the topic, and when." nil
(multiple-value-bind (channel nick time)
(values-list (cdr (erc-response.command-args parsed)))
- (setq time (format-time-string "%T %Y/%m/%d"
+ (setq time (format-time-string erc-server-timestamp-format
(erc-string-to-emacs-time time)))
(erc-update-channel-topic channel
(format "\C-o (%s, %s)" nick time)
;; Heavily borrowed from gnus-art.el. Thanks to the original authors.
;; This buttonizes nicks and other stuff to make it all clickable.
-;; To enable, add to your ~/.emacs:
+;; To enable, add to your init file:
;; (require 'erc-button)
;; (erc-button-mode 1)
;;
;;; Variables
-(defface erc-button '((t (:bold t)))
+(defface erc-button '((t :weight bold))
"ERC button face."
:group 'erc-faces)
:type 'boolean)
(defcustom erc-button-rfc-url "http://www.faqs.org/rfcs/rfc%s.html"
- "*URL used to browse rfc references.
+ "URL used to browse rfc references.
%s is replaced by the number."
:group 'erc-button
:type 'string)
(defcustom erc-button-google-url "http://www.google.com/search?q=%s"
- "*URL used to browse Google search references.
+ "URL used to browse Google search references.
%s is replaced by the search string."
:group 'erc-button
:type 'string)
1)
;; other
("\\s-\\(@\\([0-9][0-9][0-9]\\)\\)" 1 t erc-button-beats-to-time 2))
- "*Alist of regexps matching buttons in ERC buffers.
+ "Alist of regexps matching buttons in ERC buffers.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
REGEXP is the string matching text around the button or a symbol
(integer :tag "Regexp section number")))))
(defcustom erc-emacswiki-url "http://www.emacswiki.org/cgi-bin/wiki.pl?"
- "*URL of the EmacsWiki Homepage."
+ "URL of the EmacsWiki Homepage."
:group 'erc-button
:type 'string)
(defcustom erc-emacswiki-lisp-url "http://www.emacswiki.org/elisp/"
- "*URL of the EmacsWiki ELisp area."
+ "URL of the EmacsWiki ELisp area."
:group 'erc-button
:type 'string)
("Query" . (erc-cmd-QUERY nick))
("Whois" . (erc-cmd-WHOIS nick))
("Lastlog" . (erc-cmd-LASTLOG nick)))
- "*An alist of possible actions to take on a nickname.
+ "An alist of possible actions to take on a nickname.
An entry looks like (\"Action\" . SEXP) where SEXP is evaluated with
the variable `nick' bound to the nick in question.
;;; Usage:
-;; Put the following in your ~/.emacs file.
+;; Put the following in your init file.
;; (require 'erc-capab)
;; (erc-capab-identify-mode 1)
:group 'erc)
(defcustom erc-dcc-verbose nil
- "*If non-nil, be verbose about DCC activity reporting."
+ "If non-nil, be verbose about DCC activity reporting."
:group 'erc-dcc
:type 'boolean)
:valid-regexp erc-dcc-ipv4-regexp)))
(defcustom erc-dcc-send-request 'ask
- "*How to treat incoming DCC Send requests.
+ "How to treat incoming DCC Send requests.
'ask - Report the Send request, and wait for the user to manually accept it
You might want to set `erc-dcc-auto-masks' for this.
'auto - Automatically accept the request and begin downloading the file
;;; Interactive command handling
(defcustom erc-dcc-get-default-directory nil
- "*Default directory for incoming DCC file transfers.
+ "Default directory for incoming DCC file transfers.
If this is nil, then the current value of `default-directory' is used."
:group 'erc-dcc
:type '(choice (const nil :tag "Default directory") directory))
;;;###autoload
(defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC)
- "Hook variable for CTCP DCC queries")
+ "Hook variable for CTCP DCC queries.")
(defvar erc-dcc-query-handler-alist
'(("SEND" . erc-dcc-handle-ctcp-send)
?r "SEND" ?n nick ?u login ?h host))
((string-match erc-dcc-ctcp-query-send-regexp query)
(let ((filename
- (or (match-string 3 query)
+ (or (match-string 5 query)
(erc-dcc-unquote-filename (match-string 2 query))))
(ip (erc-decimal-to-ip (match-string 6 query)))
(port (match-string 7 query))
"^DCC CHAT +chat +\\([0-9]+\\) +\\([0-9]+\\)")
(defcustom erc-dcc-chat-request 'ask
- "*How to treat incoming DCC Chat requests.
+ "How to treat incoming DCC Chat requests.
'ask - Report the Chat request, and wait for the user to manually accept it
'auto - Automatically accept the request and open a new chat window
'ignore - Ignore incoming DCC chat requests completely."
;;; SEND handling
(defcustom erc-dcc-block-size 1024
- "*Block size to use for DCC SEND sessions."
+ "Block size to use for DCC SEND sessions."
:group 'erc-dcc
:type 'integer)
(defcustom erc-dcc-pump-bytes nil
- "*If set to an integer, keep sending until that number of bytes are
+ "If set to an integer, keep sending until that number of bytes are
unconfirmed."
:group 'erc-dcc
:type '(choice (const nil) integer))
(defcustom erc-dcc-send-connect-hook
'(erc-dcc-display-send erc-dcc-send-block)
- "*Hook run whenever the remote end of a DCC SEND offer connected to your
+ "Hook run whenever the remote end of a DCC SEND offer connected to your
listening port."
:group 'erc-dcc
:type 'hook)
;;; CHAT handling
(defcustom erc-dcc-chat-buffer-name-format "DCC-CHAT-%s"
- "*Format to use for DCC Chat buffer names."
+ "Format to use for DCC Chat buffer names."
:group 'erc-dcc
:type 'string)
(defcustom erc-dcc-chat-mode-hook nil
- "*Hook calls when `erc-dcc-chat-mode' finished setting up the buffer."
+ "Hook calls when `erc-dcc-chat-mode' finished setting up the buffer."
:group 'erc-dcc
:type 'hook)
(pcomplete-here '("auto" "ask" "ignore")))
(defalias 'pcomplete/erc-mode/SREQ 'pcomplete/erc-mode/CREQ)
-(defvar erc-dcc-chat-filter-hook '(erc-dcc-chat-parse-output)
- "*Hook to run after doing parsing (and possible insertion) of DCC messages.")
+(defvar erc-dcc-chat-filter-functions '(erc-dcc-chat-parse-output)
+ "Abnormal hook run after parsing (and maybe inserting) a DCC message.
+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.3")
(defvar erc-dcc-chat-mode-map
(let ((map (make-sparse-keymap)))
(set-buffer (process-buffer proc))
(setq erc-dcc-unprocessed-output
(concat erc-dcc-unprocessed-output str))
- (run-hook-with-args 'erc-dcc-chat-filter-hook proc
- erc-dcc-unprocessed-output))
+ (run-hook-with-args 'erc-dcc-chat-filter-functions
+ proc erc-dcc-unprocessed-output))
(set-buffer orig-buffer))))
(defun erc-dcc-chat-parse-output (proc str)
:group 'erc)
(defcustom erc-interpret-controls-p t
- "*If non-nil, display IRC colors and other highlighting effects.
+ "If non-nil, display IRC colors and other highlighting effects.
If this is set to the symbol `remove', ERC removes all IRC colors and
highlighting effects. When this variable is non-nil, it can cause Emacs to run
(const :tag "Display raw control characters" nil)))
(defcustom erc-interpret-mirc-color nil
- "*If non-nil, ERC will interpret mIRC color codes."
+ "If non-nil, ERC will interpret mIRC color codes."
:group 'erc-control-characters
:type 'boolean)
:group 'erc-control-characters
:type 'boolean)
-(defface erc-bold-face '((t (:bold t)))
+(defface erc-bold-face '((t :weight bold))
"ERC bold face."
:group 'erc-faces)
+
(defface erc-inverse-face
- '((t (:foreground "White" :background "Black")))
+ '((t :foreground "White" :background "Black"))
"ERC inverse face."
:group 'erc-faces)
-(defface erc-underline-face '((t (:underline t)))
+
+(defface erc-underline-face '((t :underline t))
"ERC underline face."
:group 'erc-faces)
-(defface fg:erc-color-face0 '((t (:foreground "White")))
+(defface fg:erc-color-face0 '((t :foreground "White"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face1 '((t (:foreground "black")))
+(defface fg:erc-color-face1 '((t :foreground "black"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face2 '((t (:foreground "blue4")))
+(defface fg:erc-color-face2 '((t :foreground "blue4"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face3 '((t (:foreground "green4")))
+(defface fg:erc-color-face3 '((t :foreground "green4"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face4 '((t (:foreground "red")))
+(defface fg:erc-color-face4 '((t :foreground "red"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face5 '((t (:foreground "brown")))
+(defface fg:erc-color-face5 '((t :foreground "brown"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face6 '((t (:foreground "purple")))
+(defface fg:erc-color-face6 '((t :foreground "purple"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face7 '((t (:foreground "orange")))
+(defface fg:erc-color-face7 '((t :foreground "orange"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face8 '((t (:foreground "yellow")))
+(defface fg:erc-color-face8 '((t :foreground "yellow"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face9 '((t (:foreground "green")))
+(defface fg:erc-color-face9 '((t :foreground "green"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face10 '((t (:foreground "lightblue1")))
+(defface fg:erc-color-face10 '((t :foreground "lightblue1"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face11 '((t (:foreground "cyan")))
+(defface fg:erc-color-face11 '((t :foreground "cyan"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face12 '((t (:foreground "blue")))
+(defface fg:erc-color-face12 '((t :foreground "blue"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face13 '((t (:foreground "deeppink")))
+(defface fg:erc-color-face13 '((t :foreground "deeppink"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face14 '((t (:foreground "gray50")))
+(defface fg:erc-color-face14 '((t :foreground "gray50"))
"ERC face."
:group 'erc-faces)
-(defface fg:erc-color-face15 '((t (:foreground "gray90")))
+(defface fg:erc-color-face15 '((t :foreground "gray90"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face0 '((t (:background "White")))
+(defface bg:erc-color-face0 '((t :background "White"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face1 '((t (:background "black")))
+(defface bg:erc-color-face1 '((t :background "black"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face2 '((t (:background "blue4")))
+(defface bg:erc-color-face2 '((t :background "blue4"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face3 '((t (:background "green4")))
+(defface bg:erc-color-face3 '((t :background "green4"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face4 '((t (:background "red")))
+(defface bg:erc-color-face4 '((t :background "red"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face5 '((t (:background "brown")))
+(defface bg:erc-color-face5 '((t :background "brown"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face6 '((t (:background "purple")))
+(defface bg:erc-color-face6 '((t :background "purple"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face7 '((t (:background "orange")))
+(defface bg:erc-color-face7 '((t :background "orange"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face8 '((t (:background "yellow")))
+(defface bg:erc-color-face8 '((t :background "yellow"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face9 '((t (:background "green")))
+(defface bg:erc-color-face9 '((t :background "green"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face10 '((t (:background "lightblue1")))
+(defface bg:erc-color-face10 '((t :background "lightblue1"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face11 '((t (:background "cyan")))
+(defface bg:erc-color-face11 '((t :background "cyan"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face12 '((t (:background "blue")))
+(defface bg:erc-color-face12 '((t :background "blue"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face13 '((t (:background "deeppink")))
+(defface bg:erc-color-face13 '((t :background "deeppink"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face14 '((t (:background "gray50")))
+(defface bg:erc-color-face14 '((t :background "gray50"))
"ERC face."
:group 'erc-faces)
-(defface bg:erc-color-face15 '((t (:background "gray90")))
+(defface bg:erc-color-face15 '((t :background "gray90"))
"ERC face."
:group 'erc-faces)
;;; Code:
(require 'erc)
+(require 'auth-source)
(eval-when-compile (require 'cl))
(defgroup erc-autojoin nil
SERVER is a regexp matching the server, and channels is the
list of channels to join.
+If the channel(s) require channel keys for joining, the passwords
+are found via auth-source. For instance, if you use ~/.authinfo
+as your auth-source backend, then put something like the
+following in that file:
+
+machine irc.example.net login \"#fsf\" password sEcReT
+
Customize this variable to set the value for your first connect.
Once you are connected and join and part channels, this alist
keeps track of what channels you are on, and will join them
Any other value means the same as `connect'."
:group 'erc-autojoin
:version "24.1"
- :type '(choice (const :tag "On Connection" 'connect)
- (const :tag "When Identified" 'ident)))
+ :type '(choice (const :tag "On Connection" connect)
+ (const :tag "When Identified" ident)))
(defcustom erc-autojoin-delay 30
"Number of seconds to wait before attempting to autojoin channels.
(when (string-match (car l) server)
(dolist (chan (cdr l))
(unless (erc-member-ignore-case chan joined)
- (erc-server-send (concat "join " chan))))))))
+ (erc-server-join-channel server chan)))))))
nil)
(defun erc-autojoin-channels (server nick)
(dolist (l erc-autojoin-channels-alist)
(when (string-match (car l) server)
(dolist (chan (cdr l))
- (erc-server-send (concat "join " chan))))))
+ (erc-server-join-channel server chan)))))
;; Return nil to avoid stomping on any other hook funcs.
nil)
+(defun erc-server-join-channel (server channel)
+ (let* ((secret (plist-get (nth 0 (auth-source-search
+ :max 1
+ :host server
+ :port "irc"
+ :user channel))
+ :secret))
+ (password (if (functionp secret)
+ (funcall secret)
+ secret)))
+ (erc-server-send (concat "join " channel
+ (if password
+ (concat " " password)
+ "")))))
+
(defun erc-autojoin-add (proc parsed)
"Add the channel being joined to `erc-autojoin-channels-alist'."
(let* ((chnl (erc-response.contents parsed))
:group 'erc)
(defcustom erc-generate-log-file-name-function 'erc-generate-log-file-name-long
- "*A function to generate a log filename.
+ "A function to generate a log filename.
The function must take five arguments: BUFFER, TARGET, NICK, SERVER and PORT.
BUFFER is the buffer to be saved,
TARGET is the name of the channel, or the target of the query,
(const :tag "Disable logging" nil)))
(defcustom erc-log-insert-log-on-open nil
- "*Insert log file contents into the buffer if a log file exists."
+ "Insert log file contents into the buffer if a log file exists."
:group 'erc-log
:type 'boolean)
(defcustom erc-save-buffer-on-part t
- "*Save the channel buffer content using `erc-save-buffer-in-logs' on PART.
+ "Save the channel buffer content using `erc-save-buffer-in-logs' on PART.
If you set this to nil, you may want to enable both
`erc-log-write-after-send' and `erc-log-write-after-insert'."
:type 'boolean)
(defcustom erc-save-queries-on-quit t
- "*Save all query (also channel) buffers of the server on QUIT.
+ "Save all query (also channel) buffers of the server on QUIT.
If you set this to nil, you may want to enable both
`erc-log-write-after-send' and `erc-log-write-after-insert'."
:type 'boolean)
(defcustom erc-log-write-after-send nil
- "*If non-nil, write to log file after every message you send.
+ "If non-nil, write to log file after every message you send.
If you set this to nil, you may want to enable both
`erc-save-buffer-on-part' and `erc-save-queries-on-quit'."
:type 'boolean)
(defcustom erc-log-write-after-insert nil
- "*If non-nil, write to log file when new text is added to a
+ "If non-nil, write to log file when new text is added to a
logged ERC buffer.
If you set this to nil, you may want to enable both
(defcustom erc-log-file-coding-system (if (featurep 'xemacs)
'binary
'emacs-mule)
- "*The coding system ERC should use for writing log files.
+ "The coding system ERC should use for writing log files.
This should ideally, be a \"catch-all\" coding system, like
`emacs-mule', or `iso-2022-7bit'."
:group 'erc-log)
(defcustom erc-log-filter-function nil
- "*If non-nil, pass text through the given function before writing it to
+ "If non-nil, pass text through the given function before writing it to
a log file.
The function should take one argument, which is the text to filter."
;; customizable variables.
;; Usage:
-;; Put (erc-match-mode 1) into your ~/.emacs file.
+;; Put (erc-match-mode 1) into your init file.
;;; Code:
:type '(repeat regexp))
(defcustom erc-current-nick-highlight-type 'keyword
- "*Determines how to highlight text in which your current nickname appears
+ "Determines how to highlight text in which your current nickname appears
\(does not apply to text sent by you\).
The following values are allowed:
(const all)))
(defcustom erc-pal-highlight-type 'nick
- "*Determines how to highlight messages by pals.
+ "Determines how to highlight messages by pals.
See `erc-pals'.
The following values are allowed:
(const all)))
(defcustom erc-fool-highlight-type 'nick
- "*Determines how to highlight messages by fools.
+ "Determines how to highlight messages by fools.
See `erc-fools'.
The following values are allowed:
(const all)))
(defcustom erc-keyword-highlight-type 'keyword
- "*Determines how to highlight messages containing keywords.
+ "Determines how to highlight messages containing keywords.
See variable `erc-keywords'.
The following values are allowed:
(const all)))
(defcustom erc-dangerous-host-highlight-type 'nick
- "*Determines how to highlight messages by nicks from dangerous-hosts.
+ "Determines how to highlight messages by nicks from dangerous-hosts.
See `erc-dangerous-hosts'.
The following values are allowed:
: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
;; Faces:
-(defface erc-current-nick-face '((t (:bold t :foreground "DarkTurquoise")))
+(defface erc-current-nick-face '((t :weight bold :foreground "DarkTurquoise"))
"ERC face for occurrences of your current nickname."
:group 'erc-faces)
-(defface erc-dangerous-host-face '((t (:foreground "red")))
+(defface erc-dangerous-host-face '((t :foreground "red"))
"ERC face for people on dangerous hosts.
See `erc-dangerous-hosts'."
:group 'erc-faces)
-(defface erc-pal-face '((t (:bold t :foreground "Magenta")))
+(defface erc-pal-face '((t :weight bold :foreground "Magenta"))
"ERC face for your pals.
See `erc-pals'."
:group 'erc-faces)
-(defface erc-fool-face '((t (:foreground "dim gray")))
+(defface erc-fool-face '((t :foreground "dim gray"))
"ERC face for fools on the channel.
See `erc-fools'."
:group 'erc-faces)
-(defface erc-keyword-face '((t (:bold t :foreground "pale green")))
+(defface erc-keyword-face '((t :weight bold :foreground "pale green"))
"ERC face for your keywords.
Note that this is the default face to use if
`erc-keywords' does not specify another."
(+ 2 nick-end)
(point-min))
(point-max))))
- (when vector
+ (when (and vector
+ (not (and erc-match-exclude-server-buffer
+ (erc-server-buffer-p))))
(mapc
(lambda (match-type)
(goto-char (point-min))
;;; Commentary:
;; This module hides quit/join messages if a netsplit occurs.
-;; To enable, add the following to your ~/.emacs:
+;; To enable, add the following to your init file:
;; (require 'erc-netsplit)
;; (erc-netsplit-mode 1)
--- /dev/null
+;; erc-notifications.el -- Send notification on PRIVMSG or mentions
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: comm
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This implements notifications using `notifications-notify' on
+;; PRIVMSG received and on public nickname mentions.
+
+;;; Code:
+
+(require 'erc)
+(require 'xml)
+(require 'notifications)
+(require 'erc-match)
+(require 'dbus)
+
+(defgroup erc-notifications nil
+ "Send notifications on PRIVMSG or mentions."
+ :group 'erc)
+
+(defvar erc-notifications-last-notification nil
+ "Last notification id.")
+
+(defcustom erc-notifications-icon nil
+ "Icon to use for notification."
+ :group 'erc-notifications
+ :type 'file)
+
+(defun erc-notifications-notify (nick msg)
+ "Notify that NICK send some MSG.
+This will replace the last notification sent with this function."
+ (dbus-ignore-errors
+ (setq erc-notifications-last-notification
+ (notifications-notify :title (xml-escape-string nick)
+ :body (xml-escape-string msg)
+ :replaces-id erc-notifications-last-notification
+ :app-icon erc-notifications-icon))))
+
+(defun erc-notifications-PRIVMSG (proc parsed)
+ (let ((nick (car (erc-parse-user (erc-response.sender parsed))))
+ (target (car (erc-response.command-args parsed)))
+ (msg (erc-response.contents parsed)))
+ (when (and (erc-current-nick-p target)
+ (not (and (boundp 'erc-track-exclude)
+ (member nick erc-track-exclude)))
+ (not (erc-is-message-ctcp-and-not-action-p msg)))
+ (erc-notifications-notify nick msg)))
+ ;; Return nil to continue processing by ERC
+ nil)
+
+(defun erc-notifications-notify-on-match (match-type nickuserhost msg)
+ (when (eq match-type 'current-nick)
+ (let ((nick (nth 0 (erc-parse-user nickuserhost))))
+ (unless (or (string-match-p "^Server:" nick)
+ (when (boundp 'erc-track-exclude)
+ (member nick erc-track-exclude)))
+ (erc-notifications-notify nick msg)))))
+
+;;;###autoload(autoload 'erc-notifications-mode "erc-notifications" "" t)
+(define-erc-module notifications nil
+ "Send notifications on private message reception and mentions."
+ ;; Enable
+ ((add-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG)
+ (add-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match))
+ ;; Disable
+ ((remove-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG)
+ (remove-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match)))
+
+(provide 'erc-notifications)
+
+;;; erc-notifications.el ends here
:group 'erc)
(defcustom erc-notify-list nil
- "*List of nicknames you want to be notified about online/offline
+ "List of nicknames you want to be notified about online/offline
status change."
:group 'erc-notify
:type '(repeat string))
(defcustom erc-notify-interval 60
- "*Time interval (in seconds) for checking online status of notified
+ "Time interval (in seconds) for checking online status of notified
people."
:group 'erc-notify
:type 'integer)
(defcustom erc-notify-signon-hook nil
- "*Hook run after someone on `erc-notify-list' has signed on.
+ "Hook run after someone on `erc-notify-list' has signed on.
Two arguments are passed to the function, SERVER and NICK, both
strings."
:group 'erc-notify
:options '(erc-notify-signon))
(defcustom erc-notify-signoff-hook nil
- "*Hook run after someone on `erc-notify-list' has signed off.
+ "Hook run after someone on `erc-notify-list' has signed off.
Two arguments are passed to the function, SERVER and NICK, both
strings."
:group 'erc-notify
`beep'. If non-nil, it must be a function that takes two arguments:
SENDER and MSG, both strings.
-Example for your ~/.emacs file:
+Example for your init file:
\(setq erc-page-function
(lambda (sender msg)
:group 'erc)
(defcustom erc-pcomplete-nick-postfix ":"
- "*When `pcomplete' is used in the first word after the prompt,
+ "When `pcomplete' is used in the first word after the prompt,
add this string to nicks completed."
:group 'erc-pcomplete
:type 'string)
;; This module allows you to systematically replace text in incoming
;; messages. Load erc-replace, and customize `erc-replace-alist'.
-;; Then add to your ~/.emacs:
+;; Then add to your init file:
;; (require 'erc-replace)
;; (erc-replace-mode 1)
(repeat :tag "Nickname and password"
(cons :tag "Identity"
(string :tag "Nick")
- (string :tag "Password"))))))
+ (string :tag "Password"
+ :secret ?*))))))
;; Variables:
:group 'erc)
(defcustom erc-play-sound t
- "*Play sounds when you receive CTCP SOUND requests."
+ "Play sounds when you receive CTCP SOUND requests."
:group 'erc-sound
:type 'boolean)
of timestamp information in `erc-mode' buffer.
For timestamping to be activated, you just need to load `erc-stamp'
-in your .emacs file or interactively using `load-library'."
+in your init file or interactively using `load-library'."
:group 'erc)
(defcustom erc-timestamp-format "[%H:%M]"
- "*If set to a string, messages will be timestamped.
+ "If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
(string)))
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
- "*If set to a string, messages will be timestamped.
+ "If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
(string)))
(defcustom erc-timestamp-format-right " [%H:%M]"
- "*If set to a string, messages will be timestamped.
+ "If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
(string)))
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
- "*Function to use to insert timestamps.
+ "Function to use to insert timestamps.
It takes a single argument STRING which is the final string
which all text-properties already appended. This function only cares about
function))
(defcustom erc-away-timestamp-format "<%H:%M>"
- "*Timestamp format used when marked as being away.
+ "Timestamp format used when marked as being away.
If nil, timestamping is turned off when away unless `erc-timestamp-format'
is set.
(defcustom erc-insert-away-timestamp-function
'erc-insert-timestamp-left-and-right
- "*Function to use to insert the away timestamp.
+ "Function to use to insert the away timestamp.
See `erc-insert-timestamp-function' for details."
:group 'erc-stamp
function))
(defcustom erc-hide-timestamps nil
- "*If non-nil, timestamps will be invisible.
+ "If non-nil, timestamps will be invisible.
This is useful for logging, because, although timestamps will be
hidden, they will still be present in the logs."
:type 'boolean)
(defcustom erc-echo-timestamps nil
- "*If non-nil, print timestamp in the minibuffer when point is moved.
+ "If non-nil, print timestamp in the minibuffer when point is moved.
Using this variable, you can turn off normal timestamping,
and simply move point to an irc message to see its timestamp
printed in the minibuffer."
:type 'boolean)
(defcustom erc-echo-timestamp-format "Timestamped %A, %H:%M:%S"
- "*Format string to be used when `erc-echo-timestamps' is non-nil.
+ "Format string to be used when `erc-echo-timestamps' is non-nil.
This string specifies the format of the timestamp being echoed in
the minibuffer."
:group 'erc-stamp
:type 'string)
(defcustom erc-timestamp-intangible t
- "*Whether the timestamps should be intangible, i.e. prevent the point
+ "Whether the timestamps should be intangible, i.e. prevent the point
from entering them and instead jump over them."
:group 'erc-stamp
:type 'boolean)
-(defface erc-timestamp-face '((t (:bold t :foreground "green")))
+(defface erc-timestamp-face '((t :weight bold :foreground "green"))
"ERC timestamp face."
:group 'erc-faces)
(make-variable-buffer-local 'erc-timestamp-last-inserted-right)
(defcustom erc-timestamp-only-if-changed-flag t
- "*Insert timestamp only if its value changed since last insertion.
+ "Insert timestamp only if its value changed since last insertion.
If `erc-insert-timestamp-function' is `erc-insert-timestamp-left', a
string of spaces which is the same size as the timestamp is added to
the beginning of the line in its place. If you use
:type 'boolean)
(defcustom erc-timestamp-right-column nil
- "*If non-nil, the column at which the timestamp is inserted,
+ "If non-nil, the column at which the timestamp is inserted,
if the timestamp is to be printed to the right. If nil,
`erc-insert-timestamp-right' will use other means to determine
the correct column."
(defcustom erc-timestamp-use-align-to (and (not (featurep 'xemacs))
(>= emacs-major-version 22)
(eq window-system 'x))
- "*If non-nil, use the :align-to display property to align the stamp.
+ "If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
Unfortunately, it only works in Emacs 22 and when using the X
;;; Commentary:
;; Highlights keywords and pals (friends), and hides or highlights fools
-;; (using a dark color). Add to your ~/.emacs:
+;; (using a dark color). Add to your init file:
;; (require 'erc-track)
;; (erc-track-mode 1)
;;; Code:
(defgroup erc-track nil
- "Track active buffers and show activity in the modeline."
+ "Track active buffers and show activity in the mode line."
:group 'erc)
(defcustom erc-track-enable-keybindings 'ask
:type '(repeat string))
(defcustom erc-track-remove-disconnected-buffers nil
- "*If true, remove buffers associated with a server that is
+ "If true, remove buffers associated with a server that is
disconnected from `erc-modified-channels-alist'."
:group 'erc-track
:type 'boolean)
(defcustom erc-track-exclude-types '("NICK" "333" "353")
- "*List of message types to be ignored.
+ "List of message types to be ignored.
This list could look like '(\"JOIN\" \"PART\").
By default, exclude changes of nicknames (NICK), display of who
:type 'erc-message-type)
(defcustom erc-track-exclude-server-buffer nil
- "*If true, don't perform tracking on the server buffer; this is
+ "If true, don't perform tracking on the server buffer; this is
useful for excluding all the things like MOTDs from the server and
other miscellaneous functions."
:group 'erc-track
:type 'number)
(defcustom erc-track-shorten-aggressively nil
- "*If non-nil, channel names will be shortened more aggressively.
+ "If non-nil, channel names will be shortened more aggressively.
Usually, names are not shortened if this will save only one character.
Example: If there are two channels, #linux-de and #linux-fr, then
normally these will not be shortened. When shortening aggressively,
(const :tag "Max" max)))
(defcustom erc-track-shorten-function 'erc-track-shorten-names
- "*This function will be used to reduce the channel names before display.
+ "This function will be used to reduce the channel names before display.
It takes one argument, CHANNEL-NAMES which is a list of strings.
It should return a list of strings of the same number of elements.
If nil instead of a function, shortening is disabled."
:type 'hook)
(defcustom erc-track-use-faces t
- "*Use faces in the mode-line.
+ "Use faces in the mode-line.
The faces used are the same as used for text in the buffers.
\(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
:group 'erc-track
erc-notice-face
erc-input-face
erc-prompt-face)
- "A list of faces used to highlight active buffer names in the modeline.
+ "A list of faces used to highlight active buffer names in the mode line.
If a message contains one of the faces in this list, the buffer name will
be highlighted using that face. The first matching face is used."
:group 'erc-track
erc-default-face
erc-action-face)
"A list of faces considered to be part of normal conversations.
-This list is used to highlight active buffer names in the modeline.
+This list is used to highlight active buffer names in the mode line.
If a message contains one of the faces in this list, and the
-previous modeline face for this buffer is also in this list, then
+previous mode line face for this buffer is also in this list, then
the buffer name will be highlighted using the face from the
message. This gives a rough indication that active conversations
are occurring in these channels.
(erc-modified-channels-display)))
(defun erc-track-find-face (faces)
- "Return the face to use in the modeline from the faces in FACES.
+ "Return the face to use in the mode line from the faces in FACES.
If `erc-track-faces-priority-list' is set, the one from FACES who
is first in that list will be used. If nothing matches or if
`erc-track-faces-priority-list' is not set, the default mode-line
(defun erc-track-modified-channels ()
"Hook function for `erc-insert-post-hook' to check if the current
-buffer should be added to the modeline as a hidden, modified
+buffer should be added to the mode line as a hidden, modified
channel. Assumes it will only be called when current-buffer
is in `erc-mode'."
(let ((this-channel (or (erc-default-target)
:group 'erc)
(defcustom erc-max-buffer-size 30000
- "*Maximum size in chars of each ERC buffer.
+ "Maximum size in chars of each ERC buffer.
Used only when auto-truncation is enabled.
\(see `erc-truncate-buffer' and `erc-insert-post-hook')."
:group 'erc-truncate
(require 'erc-dcc)
(defcustom erc-xdcc-files nil
- "*List of files to offer via XDCC.
+ "List of files to offer via XDCC.
Your friends should issue \"/ctcp yournick XDCC list\" to see this."
:group 'erc-dcc
:type '(repeat file))
(defcustom erc-xdcc-verbose-flag t
- "*Report XDCC CTCP requests in the server buffer."
+ "Report XDCC CTCP requests in the server buffer."
:group 'erc-dcc
:type 'boolean)
'(("help" . erc-xdcc-help)
("list" . erc-xdcc-list)
("send" . erc-xdcc-send))
- "*Sub-command handler alist for XDCC CTCP queries."
+ "Sub-command handler alist for XDCC CTCP queries."
:group 'erc-dcc
:type '(alist :key-type (string :tag "Sub-command") :value-type function))
("Type \"/ctcp " (erc-current-nick)
" XDCC list\" to see the list of offered files, then type \"/ctcp "
(erc-current-nick) " XDCC send #\" to get a particular file number."))
- "*Help text sent in response to XDCC help command.
+ "Help text sent in response to XDCC help command.
A list of messages, each consisting of strings and expressions, expressions
being evaluated and should return strings."
:group 'erc-dcc
(require 'font-lock)
(require 'pp)
(require 'thingatpt)
+(require 'auth-source)
(require 'erc-compat)
(defvar erc-official-location
"Ignoring certain messages"
:group 'erc)
+(defgroup erc-lurker nil
+ "Hide specified message types sent by lurkers"
+ :group 'erc-ignore)
+
(defgroup erc-query nil
"Using separate buffers for private discussions"
:group 'erc)
(message (concat "ERC: The function `defvaralias' is not bound. See the "
"NEWS file for variable name changes since ERC 5.0.4.")))
-(defalias 'erc-send-command 'erc-server-send)
-(erc-make-obsolete 'erc-send-command 'erc-server-send "ERC 5.1")
+(define-obsolete-function-alias 'erc-send-command
+ 'erc-server-send "ERC 5.1")
;; tunable connection and authentication parameters
(repeat :inline t :tag "Others" (string :tag "IRC Message Type"))))
(defcustom erc-hide-list nil
- "*List of IRC type messages to hide.
+ "List of IRC type messages to hide.
A typical value would be '(\"JOIN\" \"PART\" \"QUIT\")."
:group 'erc-ignore
:type 'erc-message-type)
prompt))))
(defcustom erc-notice-prefix "*** "
- "*Prefix for all notices."
+ "Prefix for all notices."
:group 'erc-display
:type 'string)
(defcustom erc-notice-highlight-type 'all
- "*Determines how to highlight notices.
+ "Determines how to highlight notices.
See `erc-notice-prefix'.
The following values are allowed:
(const :tag "don't highlight notices at all" nil)))
(defcustom erc-echo-notice-hook nil
- "*Specifies a list of functions to call to echo a private
+ "Specifies a list of functions to call to echo a private
notice. Each function is called with four arguments, the string
to display, the parsed server message, the target buffer (or
nil), and the sender. The functions are called in order, until a
(defcustom erc-echo-notice-always-hook
'(erc-echo-notice-in-default-buffer)
- "*Specifies a list of functions to call to echo a private
+ "Specifies a list of functions to call to echo a private
notice. Each function is called with four arguments, the string
to display, the parsed server message, the target buffer (or
nil), and the sender. The functions are called in order, and all
;; other tunable parameters
(defcustom erc-whowas-on-nosuchnick nil
- "*If non-nil, do a whowas on a nick if no such nick."
+ "If non-nil, do a whowas on a nick if no such nick."
:group 'erc
:type 'boolean)
(defcustom erc-verbose-server-ping nil
- "*If non-nil, show every time you get a PING or PONG from the server."
+ "If non-nil, show every time you get a PING or PONG from the server."
:group 'erc-paranoia
:type 'boolean)
(defcustom erc-public-away-p nil
- "*Let others know you are back when you are no longer marked away.
+ "Let others know you are back when you are no longer marked away.
This happens in this form:
* <nick> is back (gone for <time>)
:type 'boolean)
(defcustom erc-away-nickname nil
- "*The nickname to take when you are marked as being away."
+ "The nickname to take when you are marked as being away."
:group 'erc
:type '(choice (const nil)
string))
string))
(defcustom erc-ignore-list nil
- "*List of regexps matching user identifiers to ignore.
+ "List of regexps matching user identifiers to ignore.
A user identifier has the form \"nick!login@host\". If an
identifier matches, the message from the person will not be
(make-variable-buffer-local 'erc-ignore-list)
(defcustom erc-ignore-reply-list nil
- "*List of regexps matching user identifiers to ignore completely.
+ "List of regexps matching user identifiers to ignore completely.
This differs from `erc-ignore-list' in that it also ignores any
messages directed at the user.
:type '(repeat regexp))
(defvar erc-flood-protect t
- "*If non-nil, flood protection is enabled.
+ "If non-nil, flood protection is enabled.
Flooding is sending too much information to the server in too
short of an interval, which may cause the server to terminate the
connection.
:type '(repeat directory))
(defcustom erc-script-echo t
- "*If non-nil, echo the IRC script commands locally."
+ "If non-nil, echo the IRC script commands locally."
:group 'erc-scripts
:type 'boolean)
:type '(repeat (list regexp (choice (string) (function)))))
(defcustom erc-quit-reason 'erc-quit-reason-normal
- "*A function which returns the reason for quitting.
+ "A function which returns the reason for quitting.
The function is passed a single argument, the string typed by the
user after \"/quit\"."
"ERC default face."
:group 'erc-faces)
-(defface erc-direct-msg-face '((t (:foreground "IndianRed")))
+(defface erc-direct-msg-face '((t :foreground "IndianRed"))
"ERC face used for messages you receive in the main erc buffer."
:group 'erc-faces)
(defface erc-header-line
- '((t (:foreground "grey20" :background "grey90")))
+ '((t :foreground "grey20" :background "grey90"))
"ERC face used for the header line.
This will only be used if `erc-header-line-face-method' is non-nil."
:group 'erc-faces)
-(defface erc-input-face '((t (:foreground "brown")))
+(defface erc-input-face '((t :foreground "brown"))
"ERC face used for your input."
:group 'erc-faces)
(defface erc-prompt-face
- '((t (:bold t :foreground "Black" :background "lightBlue2")))
+ '((t :weight bold :foreground "Black" :background "lightBlue2"))
"ERC face for the prompt."
:group 'erc-faces)
(defface erc-command-indicator-face
- '((t (:bold t)))
+ '((t :weight bold))
"ERC face for the command indicator.
See the variable `erc-command-indicator'."
:group 'erc-faces)
(defface erc-notice-face
- (if (or (featurep 'xemacs)
- (< emacs-major-version 22))
- '((t (:bold t :foreground "blue")))
- '((((class color) (min-colors 88))
- (:bold t :foreground "SlateBlue"))
- (t (:bold t :foreground "blue"))))
+ '((default :weight bold)
+ (((class color) (min-colors 88)) :foreground "SlateBlue")
+ (t :foreground "blue"))
"ERC face for notices."
:group 'erc-faces)
-(defface erc-action-face '((t (:bold t)))
+(defface erc-action-face '((t :weight bold))
"ERC face for actions generated by /ME."
:group 'erc-faces)
-(defface erc-error-face '((t (:foreground "red")))
+(defface erc-error-face '((t :foreground "red"))
"ERC face for errors."
:group 'erc-faces)
;; same default color as `erc-input-face'
-(defface erc-my-nick-face '((t (:bold t :foreground "brown")))
+(defface erc-my-nick-face '((t :weight bold :foreground "brown"))
"ERC face for your current nickname in messages sent by you.
See also `erc-show-my-nick'."
:group 'erc-faces)
-(defface erc-nick-default-face '((t (:bold t)))
+(defface erc-nick-default-face '((t :weight bold))
"ERC nickname default face."
:group 'erc-faces)
-(defface erc-nick-msg-face '((t (:bold t :foreground "IndianRed")))
+(defface erc-nick-msg-face '((t :weight bold :foreground "IndianRed"))
"ERC nickname face for private messages."
:group 'erc-faces)
(const :tag "Use current buffer" t)))
(defcustom erc-frame-alist nil
- "*Alist of frame parameters for creating erc frames.
+ "Alist of frame parameters for creating erc frames.
A value of nil means to use `default-frame-alist'."
:group 'erc-buffers
:type '(repeat (cons :format "%v"
(sexp :tag "Value"))))
(defcustom erc-frame-dedicated-flag nil
- "*Non-nil means the erc frames are dedicated to that buffer.
+ "Non-nil means the erc frames are dedicated to that buffer.
This only has effect when `erc-join-buffer' is set to `frame'."
:group 'erc-buffers
:type 'boolean)
(defcustom erc-reuse-frames t
- "*Determines whether new frames are always created.
+ "Determines whether new frames are always created.
Non-nil means that a new frame is not created to display an ERC
buffer if there is already a window displaying it. This only has
effect when `erc-join-buffer' is set to `frame'."
(t nil)))
(defcustom erc-reuse-buffers t
- "*If nil, create new buffers on joining a channel/query.
+ "If nil, create new buffers on joining a channel/query.
If non-nil, a new buffer will only be created when you join
channels with same names on different servers, or have query buffers
open with nicks of the same name on different servers. Otherwise,
;; The local copy of `erc-nick' - the list of nicks to choose
(setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
;; password stuff
- (setq erc-session-password passwd)
+ (setq erc-session-password (or passwd
+ (let ((secret
+ (plist-get
+ (nth 0
+ (auth-source-search :host server
+ :max 1
+ :user nick
+ :port port
+ :require '(:secret)))
+ :secret)))
+ (if (functionp secret)
+ (funcall secret)
+ secret))))
;; debug output buffer
(setq erc-dbuf
(when erc-log-p
string)
string)))
+(defvar erc-lurker-state nil
+ "Track the time of the last PRIVMSG for each (server,nick) pair.
+
+This is implemented as a hash of hashes, where the outer key is
+the canonicalized server name (as returned by
+`erc-canonicalize-server-name') and the outer value is a hash
+table mapping nicks (as returned by `erc-lurker-maybe-trim') to
+the times of their most recently received PRIVMSG on any channel
+on the given server.")
+
+(defcustom erc-lurker-trim-nicks t
+ "If t, trim trailing `erc-lurker-ignore-chars' from nicks.
+
+This causes e.g. nick and nick` to be considered as the same
+individual for activity tracking and lurkiness detection
+purposes."
+ :group 'erc-lurker
+ :type 'boolean)
+
+(defun erc-lurker-maybe-trim (nick)
+ "Maybe trim trailing `erc-lurker-ignore-chars' from NICK.
+
+Returns NICK unmodified unless `erc-lurker-trim-nicks' is
+non-nil."
+ (if erc-lurker-trim-nicks
+ (replace-regexp-in-string
+ (format "[%s]"
+ (mapconcat (lambda (char)
+ (regexp-quote (char-to-string char)))
+ erc-lurker-ignore-chars ""))
+ "" nick)
+ nick))
+
+(defcustom erc-lurker-ignore-chars "`_"
+ "Characters at the end of a nick to strip for activity tracking purposes.
+
+See also `erc-lurker-trim-nicks'."
+ :group 'erc-lurker
+ :type 'string)
+
+(defcustom erc-lurker-hide-list nil
+ "List of IRC type messages to hide when sent by lurkers.
+
+A typical value would be '(\"JOIN\" \"PART\" \"QUIT\").
+See also `erc-lurker-p' and `erc-hide-list'."
+ :group 'erc-lurker
+ :type 'erc-message-type)
+
+(defcustom erc-lurker-threshold-time (* 60 60 24) ; 24h by default
+ "Nicks from which no PRIVMSGs have been received within this
+interval (in units of seconds) are considered lurkers by
+`erc-lurker-p' and as a result their messages of types in
+`erc-lurker-hide-list' will be hidden."
+ :group 'erc-lurker
+ :type 'integer)
+
+(defun erc-lurker-initialize ()
+ "Initialize ERC lurker tracking functionality.
+
+This function adds `erc-lurker-update-status' to
+`erc-insert-pre-hook' in order to record the time of each nick's
+most recent PRIVMSG as well as initializing the state variable
+storing this information."
+ (setq erc-lurker-state (make-hash-table :test 'equal))
+ (add-hook 'erc-insert-pre-hook 'erc-lurker-update-status))
+
+(defun erc-lurker-cleanup ()
+ "Remove all last PRIVMSG state older than `erc-lurker-threshold-time'.
+
+This should be called regularly to avoid excessive resource
+consumption for long-lived IRC or Emacs sessions."
+ (maphash
+ (lambda (server hash)
+ (maphash
+ (lambda (nick last-PRIVMSG-time)
+ (when
+ (> (time-to-seconds (time-subtract
+ (current-time)
+ last-PRIVMSG-time))
+ erc-lurker-threshold-time)
+ (remhash nick hash)))
+ hash)
+ (if (zerop (hash-table-count hash))
+ (remhash server erc-lurker-state)))
+ erc-lurker-state))
+
+(defvar erc-lurker-cleanup-count 0
+ "Internal counter variable for use with `erc-lurker-cleanup-interval'.")
+
+(defvar erc-lurker-cleanup-interval 100
+ "Specifies frequency of cleaning up stale erc-lurker state.
+
+`erc-lurker-update-status' calls `erc-lurker-cleanup' once for
+every `erc-lurker-cleanup-interval' updates to
+`erc-lurker-state'. This is designed to limit the memory
+consumption of lurker state during long Emacs sessions and/or ERC
+sessions with large numbers of incoming PRIVMSGs.")
+
+(defun erc-lurker-update-status (message)
+ "Update `erc-lurker-state' if necessary.
+
+This function is called from `erc-insert-pre-hook'. If the
+current message is a PRIVMSG, update `erc-lurker-state' to
+reflect the fact that its sender has issued a PRIVMSG at the
+current time. Otherwise, take no action.
+
+This function depends on the fact that `erc-display-message'
+dynamically binds `parsed', which is used to check if the current
+message is a PRIVMSG and to determine its sender. See also
+`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
+
+In order to limit memory consumption, this function also calls
+`erc-lurker-cleanup' once every `erc-lurker-cleanup-interval'
+updates of `erc-lurker-state'."
+ (when (and (boundp 'parsed) (erc-response-p parsed))
+ (let* ((command (erc-response.command parsed))
+ (sender
+ (erc-lurker-maybe-trim
+ (car (erc-parse-user (erc-response.sender parsed)))))
+ (server
+ (erc-canonicalize-server-name erc-server-announced-name)))
+ (when (equal command "PRIVMSG")
+ (when (>= (incf erc-lurker-cleanup-count) erc-lurker-cleanup-interval)
+ (setq erc-lurker-cleanup-count 0)
+ (erc-lurker-cleanup))
+ (unless (gethash server erc-lurker-state)
+ (puthash server (make-hash-table :test 'equal) erc-lurker-state))
+ (puthash sender (current-time)
+ (gethash server erc-lurker-state))))))
+
+(defun erc-lurker-p (nick)
+ "Predicate indicating NICK's lurking status on the current server.
+
+Lurking is the condition where NICK has issued no PRIVMSG on this
+server within `erc-lurker-threshold-time'. See also
+`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'."
+ (unless erc-lurker-state (erc-lurker-initialize))
+ (let* ((server
+ (erc-canonicalize-server-name erc-server-announced-name))
+ (last-PRIVMSG-time
+ (gethash (erc-lurker-maybe-trim nick)
+ (gethash server erc-lurker-state (make-hash-table)))))
+ (or (null last-PRIVMSG-time)
+ (> (time-to-seconds
+ (time-subtract (current-time) last-PRIVMSG-time))
+ erc-lurker-threshold-time))))
+
+(defun erc-canonicalize-server-name (server)
+ "Returns the canonical network name for SERVER if any,
+otherwise `erc-server-announced-name'. SERVER is matched against
+`erc-common-server-suffixes'."
+ (when server
+ (or (cdar (erc-remove-if-not
+ (lambda (net) (string-match (car net) server))
+ erc-common-server-suffixes))
+ erc-server-announced-name)))
+
+(defun erc-hide-current-message-p (parsed)
+ "Predicate indicating whether the parsed ERC response PARSED should be hidden.
+
+Messages are always hidden if the message type of PARSED appears in
+`erc-hide-list'. In addition, messages whose type is a member of
+`erc-lurker-hide-list' are hidden if `erc-lurker-p' returns true."
+ (let* ((command (erc-response.command parsed))
+ (sender (car (erc-parse-user (erc-response.sender parsed)))))
+ (or (member command erc-hide-list)
+ (and (member command erc-lurker-hide-list) (erc-lurker-p sender)))))
+
(defun erc-display-message (parsed type buffer msg &rest args)
"Display MSG in BUFFER.
(if (not (erc-response-p parsed))
(erc-display-line string buffer)
- (unless (member (erc-response.command parsed) erc-hide-list)
+ (unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
(erc-put-text-property 0 (length string) 'rear-sticky t string)
(erc-display-line string buffer)))))
(if (consp val)
(concat "\n" (pp-to-string val))
(format " %S\n" val)))))
- (apropos-internal "^erc-" 'user-variable-p))))
+ (apropos-internal "^erc-" 'custom-variable-p))))
(current-buffer)) t)
(t nil)))
(defalias 'erc-cmd-VAR 'erc-cmd-SET)
'start-open t ; XEmacs
'rear-nonsticky t ; Emacs
'erc-prompt t
+ 'field t
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
(defcustom erc-default-server-hook '(erc-debug-missing-hooks
erc-default-server-handler)
- "*Default for server messages which aren't covered by `erc-server-hooks'."
+ "Default for server messages which aren't covered by `erc-server-hooks'."
:group 'erc-server-hooks
:type 'hook)
str))
(defcustom erc-format-nick-function 'erc-format-nick
- "*Function to format a nickname for message display."
+ "Function to format a nickname for message display."
:group 'erc-display
:type 'function)
(run-hooks 'erc-channel-members-changed-hook)))
(defcustom erc-channel-members-changed-hook nil
- "*This hook is called every time the variable `channel-members' changes.
+ "This hook is called every time the variable `channel-members' changes.
The buffer where the change happened is current while this hook is called."
:group 'erc-hooks
:type 'hook)
(add-hook 'kill-buffer-hook 'erc-kill-buffer-function)
(defcustom erc-kill-server-hook '(erc-kill-server)
- "*Invoked whenever a server-buffer is killed via `kill-buffer'."
+ "Invoked whenever a server-buffer is killed via `kill-buffer'."
:group 'erc-hooks
:type 'hook)
(defcustom erc-kill-channel-hook '(erc-kill-channel)
- "*Invoked whenever a channel-buffer is killed via `kill-buffer'."
+ "Invoked whenever a channel-buffer is killed via `kill-buffer'."
:group 'erc-hooks
:type 'hook)
(defcustom erc-kill-buffer-hook nil
- "*Hook run whenever a non-server or channel buffer is killed.
+ "Hook run whenever a non-server or channel buffer is killed.
See also `kill-buffer'."
:group 'erc-hooks
(require 'eshell)
;;;###autoload
-(eshell-defgroup eshell-alias nil
+(progn
+(defgroup eshell-alias nil
"Command aliases allow for easy definition of alternate commands."
:tag "Command aliases"
;; :link '(info-link "(eshell)Command aliases")
- :group 'eshell-module)
+ :group 'eshell-module))
(defcustom eshell-aliases-file (expand-file-name "alias" eshell-directory-name)
"The file in which aliases are kept.
Where NAME is the textual name of the alias, and DEFINITION is the
command string to replace that command with.
-Note: this list should not be modified in your '.emacs' file. Rather,
-any desired alias definitions should be declared using the `alias'
-command, which will automatically write them to the file named by
-`eshell-aliases-file'.")
+Note: this list should not be modified in your init file.
+Rather, any desired alias definitions should be declared using
+the `alias' command, which will automatically write them to the
+file named by `eshell-aliases-file'.")
(put 'eshell-command-aliases-list 'risky-local-variable t)
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'esh-mode)
(require 'eshell))
(require 'esh-util)
;;;###autoload
-(eshell-defgroup eshell-banner nil
+(progn
+(defgroup eshell-banner nil
"This sample module displays a welcome banner at login.
It exists so that others wishing to create their own Eshell extension
modules may have a simple template to begin with."
:tag "Login banner"
;; :link '(info-link "(eshell)Login banner")
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
;; `insert', because `insert' doesn't know how to interact with the
;; I/O code used by Eshell
(unless eshell-non-interactive-p
- (assert eshell-mode)
- (assert eshell-banner-message)
+ (cl-assert eshell-mode)
+ (cl-assert eshell-banner-message)
(let ((msg (eval eshell-banner-message)))
- (assert msg)
+ (cl-assert msg)
(eshell-interactive-print msg))))
(provide 'em-banner)
(require 'esh-opt)
;;;###autoload
-(eshell-defgroup eshell-basic nil
+(progn
+(defgroup eshell-basic nil
"The \"basic\" code provides a set of convenience functions which
are traditionally considered shell builtins. Since all of the
functionality provided by them is accessible through Lisp, they are
not really builtins at all, but offer a command-oriented way to do the
same thing."
:tag "Basic shell commands"
- :group 'eshell-module)
+ :group 'eshell-module))
(defcustom eshell-plain-echo-behavior nil
"If non-nil, `echo' tries to behave like an ordinary shell echo.
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'eshell))
(require 'esh-util)
;;;###autoload
-(eshell-defgroup eshell-cmpl nil
+(progn
+(defgroup eshell-cmpl nil
"This module provides a programmable completion function bound to
the TAB key, which allows for completing command names, file names,
variable names, arguments, etc."
:tag "Argument completion"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
(nconc posns (list pos)))
(setq pos (1+ pos))))
(setq posns (cdr posns))
- (assert (= (length args) (length posns)))
+ (cl-assert (= (length args) (length posns)))
(let ((a args)
(i 0)
l final)
(and l
(setq args (nthcdr (1+ l) args)
posns (nthcdr (1+ l) posns))))
- (assert (= (length args) (length posns)))
+ (cl-assert (= (length args) (length posns)))
(when (and args (eq (char-syntax (char-before end)) ? )
(not (eq (char-before (1- end)) ?\\)))
(nconc args (list ""))
(let ((result
(eshell-do-eval
(list 'eshell-commands arg) t)))
- (assert (eq (car result) 'quote))
+ (cl-assert (eq (car result) 'quote))
(cadr result))
arg)))
(if (numberp val)
(require 'esh-opt)
;;;###autoload
-(eshell-defgroup eshell-dirs nil
+(progn
+(defgroup eshell-dirs nil
"Directory navigation involves changing directories, examining the
current directory, maintaining a directory stack, and also keeping
track of a history of the last directory locations the user was in.
Emacs does provide standard Lisp definitions of `pwd' and `cd', but
they lack somewhat in feel from the typical shell equivalents."
:tag "Directory navigation"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
(require 'esh-util)
;;;###autoload
-(eshell-defgroup eshell-glob nil
+(progn
+(defgroup eshell-glob nil
"This module provides extended globbing syntax, similar what is used
by zsh for filename generation."
:tag "Extended filename globbing"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'ring)
(require 'esh-opt)
(require 'eshell)
;;;###autoload
-(eshell-defgroup eshell-hist nil
+(progn
+(defgroup eshell-hist nil
"This module provides command history management."
:tag "History list management"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
(forward-char))
(setq posb (cdr posb)
pose (cdr pose))
- (assert (= (length posb) (length args)))
- (assert (<= (length posb) (length pose))))
+ (cl-assert (= (length posb) (length args)))
+ (cl-assert (<= (length posb) (length pose))))
(setq hist (buffer-substring-no-properties begin end))
(let ((b posb) (e pose))
(while b
(setq b (cdr b)
e (cdr e))))
(setq textargs (cdr textargs))
- (assert (= (length textargs) (length args)))
+ (cl-assert (= (length textargs) (length args)))
(list textargs posb pose))))
(defun eshell-expand-history-references (beg end)
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'eshell))
(require 'esh-util)
(require 'esh-opt)
;;;###autoload
-(eshell-defgroup eshell-ls nil
+(progn
+(defgroup eshell-ls nil
"This module implements the \"ls\" utility fully in Lisp. If it is
passed any unrecognized command switches, it will revert to the
operating system's version. This version of \"ls\" uses text
properties to colorize its output based on the setting of
`eshell-ls-use-colors'."
:tag "Implementation of `ls' in Lisp"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
(let ((insert-func 'eshell-buffered-print)
(error-func 'eshell-error)
(flush-func 'eshell-flush))
- (eshell-do-ls args)))
+ (apply 'eshell-do-ls args)))
(put 'eshell/ls 'eshell-no-numeric-conversions t)
(progn
(setcdr fileinfo attr)
(setcar fileinfo (eshell-ls-decorated-name fileinfo)))
- (assert (eq listing-style 'long-listing))
+ (cl-assert (eq listing-style 'long-listing))
(setcar fileinfo
(concat (eshell-ls-decorated-name fileinfo) " -> "
(eshell-ls-decorated-name
(let* ((col-vals
(if (eq listing-style 'by-columns)
(eshell-ls-find-column-lengths display-files)
- (assert (eq listing-style 'by-lines))
+ (cl-assert (eq listing-style 'by-lines))
(eshell-ls-find-column-widths display-files)))
(col-widths (car col-vals))
(display-files (cdr col-vals))
(eval-when-compile (require 'eshell))
;;;###autoload
-(eshell-defgroup eshell-pred nil
+(progn
+(defgroup eshell-pred nil
"This module allows for predicates to be applied to globbing
patterns (similar to zsh), in addition to string modifiers which can
be applied either to globbing results, variable references, or just
ordinary strings."
:tag "Value modifiers and predicates"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
(eval-when-compile (require 'eshell))
;;;###autoload
-(eshell-defgroup eshell-prompt nil
+(progn
+(defgroup eshell-prompt nil
"This module provides command prompts, and navigation between them,
as is common with most shells."
:tag "Command prompts"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
:group 'eshell-prompt)
(defface eshell-prompt
- '((((class color) (background light)) (:foreground "Red" :bold t))
- (((class color) (background dark)) (:foreground "Pink" :bold t))
- (t (:bold t)))
+ '((default :weight bold)
+ (((class color) (background light)) :foreground "Red")
+ (((class color) (background dark)) :foreground "Pink"))
"The face used to highlight prompt strings.
For highlighting other kinds of strings -- similar to shell mode's
behavior -- simply use an output filer which changes text properties."
(eval-when-compile (require 'eshell))
;;;###autoload
-(eshell-defgroup eshell-rebind nil
+(progn
+(defgroup eshell-rebind nil
"This module allows for special keybindings that only take effect
while the point is in a region of input text. By default, it binds
C-a to move to the beginning of the input text (rather than just the
`backward-word', `previous-line', etc. This module intends to mimic
the behavior of normal shells while the user editing new input text."
:tag "Rebind keys at input"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
;;; Code:
(require 'eshell)
+(require 'esh-opt)
;;;###autoload
-(eshell-defgroup eshell-script nil
+(progn
+(defgroup eshell-script nil
"This module allows for the execution of files containing Eshell
commands, as a script file."
:tag "Running script files."
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
(eval-when-compile (require 'eshell))
;;;###autoload
-(eshell-defgroup eshell-smart nil
+(progn
+(defgroup eshell-smart nil
"This module combines the facility of normal, modern shells with
some of the edit/review concepts inherent in the design of Plan 9's
9term. See the docs for more details.
it to get a real sense of how it works."
:tag "Smart display of output"
;; :link '(info-link "(eshell)Smart display of output")
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
(require 'term)
;;;###autoload
-(eshell-defgroup eshell-term nil
+(progn
+(defgroup eshell-term nil
"This module causes visual commands (e.g., 'vi') to be executed by
the `term' package, which comes with Emacs. This package handles most
of the ANSI control codes, allowing curses-based applications to run
within an Emacs window. The variable `eshell-visual-commands' defines
which commands are considered visual in nature."
:tag "Running visual commands"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; User Variables:
:type '(repeat string)
:group 'eshell-term)
-(defcustom eshell-term-name "eterm"
+;; If you change this from term-term-name, you need to ensure that the
+;; value you choose exists in the system's terminfo database. (Bug#12485)
+(defcustom eshell-term-name term-term-name
"Name to use for the TERM variable when running visual commands.
See `term-term-name' in term.el for more information on how this is
used."
+ :version "24.3" ; eterm -> term-term-name = eterm-color
:type 'string
:group 'eshell-term)
(require 'pcomplete)
;;;###autoload
-(eshell-defgroup eshell-unix nil
+(progn
+(defgroup eshell-unix nil
"This module defines many of the more common UNIX utilities as
aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If
the user passes arguments which are too complex, or are unrecognized
\(such as being able to use `kill' to kill Eshell background processes
by name)."
:tag "UNIX commands in Lisp"
- :group 'eshell-module)
+ :group 'eshell-module))
(defcustom eshell-unix-load-hook nil
"A list of functions to run when `eshell-unix' is loaded."
(put 'eshell/occur 'eshell-no-numeric-conversions t)
-;; Pacify the byte-compiler.
-(defvar tramp-default-proxies-alist)
-
(defun eshell/su (&rest args)
"Alias \"su\" to call Tramp."
- (require 'tramp)
(setq args (eshell-stringify-list (eshell-flatten-list args)))
(let ((orig-args (copy-tree args)))
(eshell-eval-using-options
(host (or (file-remote-p default-directory 'host)
"localhost"))
(dir (or (file-remote-p default-directory 'localname)
- (expand-file-name default-directory))))
+ (expand-file-name default-directory)))
+ (prefix (file-remote-p default-directory)))
(dolist (arg args)
(if (string-equal arg "-") (setq login t) (setq user arg)))
;; `eshell-eval-using-options' does not handle "-".
(if (member "-" orig-args) (setq login t))
(if login (setq dir "~/"))
- (if (and (file-remote-p default-directory)
+ (if (and prefix
(or
(not (string-equal
"su" (file-remote-p default-directory 'method)))
(not (string-equal
user (file-remote-p default-directory 'user)))))
- (add-to-list
- 'tramp-default-proxies-alist
- (list host user (file-remote-p default-directory))))
- (eshell-parse-command
- "cd" (list (format "/su:%s@%s:%s" user host dir))))))))
+ (eshell-parse-command
+ "cd" (list (format "%s|su:%s@%s:%s"
+ (substring prefix 0 -1) user host dir)))
+ (eshell-parse-command
+ "cd" (list (format "/su:%s@%s:%s" user host dir)))))))))
(put 'eshell/su 'eshell-no-numeric-conversions t)
(defun eshell/sudo (&rest args)
"Alias \"sudo\" to call Tramp."
- (require 'tramp)
(setq args (eshell-stringify-list (eshell-flatten-list args)))
(let ((orig-args (copy-tree args)))
(eshell-eval-using-options
(host (or (file-remote-p default-directory 'host)
"localhost"))
(dir (or (file-remote-p default-directory 'localname)
- (expand-file-name default-directory))))
+ (expand-file-name default-directory)))
+ (prefix (file-remote-p default-directory)))
;; `eshell-eval-using-options' reads options of COMMAND.
(while (and (stringp (car orig-args))
(member (car orig-args) '("-u" "--user")))
(setq orig-args (cddr orig-args)))
- (if (and (file-remote-p default-directory)
- (or
- (not (string-equal
- "sudo" (file-remote-p default-directory 'method)))
- (not (string-equal
- user (file-remote-p default-directory 'user)))))
- (add-to-list
- 'tramp-default-proxies-alist
- (list host user (file-remote-p default-directory))))
- (let ((default-directory (format "/sudo:%s@%s:%s" user host dir)))
+ (let ((default-directory
+ (if (and prefix
+ (or
+ (not
+ (string-equal
+ "sudo"
+ (file-remote-p default-directory 'method)))
+ (not
+ (string-equal
+ user
+ (file-remote-p default-directory 'user)))))
+ (format "%s|sudo:%s@%s:%s"
+ (substring prefix 0 -1) user host dir)
+ (format "/sudo:%s@%s:%s" user host dir))))
+ ;; Ensure, that Tramp has connected to that construct already.
+ (ignore (file-exists-p default-directory))
(eshell-named-command (car orig-args) (cdr orig-args))))))))
(put 'eshell/sudo 'eshell-no-numeric-conversions t)
(require 'compile)
;;;###autoload
-(eshell-defgroup eshell-xtra nil
+(progn
+(defgroup eshell-xtra nil
"This module defines some extra alias functions which are entirely
optional. They can be viewed as samples for how to write Eshell alias
functions, or as aliases which make some of Emacs's behavior more
naturally accessible within Emacs."
:tag "Extra alias functions"
- :group 'eshell-module)
+ :group 'eshell-module))
;;; Functions:
;;; esh-cmd.el --- command invocation
-;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
(require 'esh-ext)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'pcomplete))
:group 'eshell-cmd)
(defcustom eshell-debug-command nil
- "If non-nil, enable debugging code. SSLLOOWW.
-This option is only useful for reporting bugs. If you enable it, you
-will have to visit the file 'eshell-cmd.el' and run the command
-\\[eval-buffer]."
+ "If non-nil, enable Eshell debugging code.
+This is slow, and only useful for debugging problems with Eshell.
+If you change this without using customize after Eshell has loaded,
+you must re-load 'esh-cmd.el'."
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set symbol value)
+ (load-library "esh-cmd"))
:type 'boolean
:group 'eshell-cmd)
(list
(if (<= (length pieces) 1)
(car pieces)
- (assert (not eshell-in-pipeline-p))
+ (cl-assert (not eshell-in-pipeline-p))
`(eshell-execute-pipeline (quote ,pieces))))))
(setq bp (cdr bp))))
;; `results' might be empty; this happens in the case of
results (cdr results)
sep-terms (nreverse sep-terms))
(while results
- (assert (car sep-terms))
+ (cl-assert (car sep-terms))
(setq final (eshell-structure-basic-command
'if (string= (car sep-terms) "&&") "if"
`(eshell-protect ,(car results))
;; `eshell-copy-tree' is needed here so that the test argument
;; doesn't get modified and thus always yield the same result.
(when (car eshell-command-body)
- (assert (not synchronous-p))
+ (cl-assert (not synchronous-p))
(eshell-do-eval (car eshell-command-body))
(setcar eshell-command-body nil)
(setcar eshell-test-body nil))
;; doesn't get modified and thus always yield the same result.
(if (car eshell-command-body)
(progn
- (assert (not synchronous-p))
+ (cl-assert (not synchronous-p))
(eshell-do-eval (car eshell-command-body)))
(unless (car eshell-test-body)
(setcar eshell-test-body (eshell-copy-tree (car args))))
(setq eshell-last-arguments args
eshell-last-command-name (eshell-stringify command))
(run-hook-with-args 'eshell-prepare-command-hook)
- (assert (stringp eshell-last-command-name))
+ (cl-assert (stringp eshell-last-command-name))
(if eshell-last-command-name
(or (run-hook-with-args-until-success
'eshell-named-command-hook eshell-last-command-name
(let* ((sym (intern-soft (concat "eshell/" name)))
(file (symbol-file sym 'defun)))
;; If the function exists, but is defined in an eshell module
- ;; that's not currently enabled, don't report it as found
+ ;; that's not currently enabled, don't report it as found.
(if (and file
- (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file))
+ (setq file (file-name-base file))
+ (string-match "\\`\\(em\\|esh\\)-\\([[:alnum:]]+\\)\\'" file))
(let ((module-sym
- (intern (file-name-sans-extension
- (file-name-nondirectory
- (concat "eshell-" (match-string 2 file)))))))
+ (intern (concat "eshell-" (match-string 2 file)))))
(if (and (functionp sym)
(or (null module-sym)
(eshell-using-module module-sym)
(provide 'esh-ext)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'esh-cmd))
(require 'esh-util)
+(require 'esh-opt)
(defgroup eshell-ext nil
"External commands are invoked when operating system executables are
causing the user to wonder if anything's really going on..."
(let ((outbuf (generate-new-buffer " *eshell remote output*"))
(errbuf (generate-new-buffer " *eshell remote error*"))
+ (command (or (file-remote-p command 'localname) command))
(exitcode 1))
(unwind-protect
(progn
(defun eshell-external-command (command args)
"Insert output from an external COMMAND, using ARGS."
(setq args (eshell-stringify-list (eshell-flatten-list args)))
- (if (file-remote-p default-directory)
- (eshell-remote-command command args))
- (let ((interp (eshell-find-interpreter command)))
- (assert interp)
+ (let ((interp (eshell-find-interpreter
+ command
+ ;; `eshell-find-interpreter' does not work correctly
+ ;; for Tramp file name syntax. But we don't need to
+ ;; know the interpreter in that case, therefore the
+ ;; check is suppressed.
+ (or (and (stringp command) (file-remote-p command))
+ (file-remote-p default-directory)))))
+ (cl-assert interp)
(if (functionp (car interp))
(apply (car interp) (append (cdr interp) args))
(eshell-gather-process-output
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)
(provide 'esh-io)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'eshell))
(defgroup eshell-io nil
command. If nil, then the meta variables for keeping track of the
last execution result should not be changed."
(let ((idx 0))
- (assert (or (not result) (eq (car result) 'quote)))
+ (cl-assert (or (not result) (eq (car result) 'quote)))
(setq eshell-last-command-status exit-code
eshell-last-command-result (cadr result))
(while (< idx eshell-number-of-handles)
:type '(choice (const nil) function)
:group 'eshell-mode)
-(defcustom eshell-status-in-modeline t
- "If non-nil, let the user know a command is running in the modeline."
+(defcustom eshell-status-in-mode-line t
+ "If non-nil, let the user know a command is running in the mode line."
:type 'boolean
:group 'eshell-mode)
+(define-obsolete-variable-alias 'eshell-status-in-modeline
+ '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.")
(setq eshell-mode-map (make-sparse-keymap))
(use-local-map eshell-mode-map)
- (when eshell-status-in-modeline
+ (when eshell-status-in-mode-line
(make-local-variable 'eshell-command-running-string)
(let ((fmt (copy-sequence mode-line-format)))
(make-local-variable 'mode-line-format)
(setq mode-line-format fmt))
- (let ((modeline (memq 'mode-line-modified mode-line-format)))
- (if modeline
- (setcar modeline 'eshell-command-running-string))))
+ (let ((mode-line-elt (memq 'mode-line-modified mode-line-format)))
+ (if mode-line-elt
+ (setcar mode-line-elt 'eshell-command-running-string))))
(define-key eshell-mode-map [return] 'eshell-send-input)
(define-key eshell-mode-map [(control ?m)] 'eshell-send-input)
(when eshell-scroll-show-maximum-output
(set (make-local-variable 'scroll-conservatively) 1000))
- (when eshell-status-in-modeline
+ (when eshell-status-in-mode-line
(add-hook 'eshell-pre-command-hook 'eshell-command-started nil t)
(add-hook 'eshell-post-command-hook 'eshell-command-finished nil t))
(put 'eshell-mode 'mode-class 'special)
(defun eshell-command-started ()
- "Indicate in the modeline that a command has started."
+ "Indicate in the mode line that a command has started."
(setq eshell-command-running-string "**")
(force-mode-line-update))
(defun eshell-command-finished ()
- "Indicate in the modeline that a command has finished."
+ "Indicate in the mode line that a command has finished."
(setq eshell-command-running-string "--")
(force-mode-line-update))
;; load the defgroup's for the standard extension modules, so that
;; documentation can be provided when the user customize's
-;; `eshell-modules-list'.
+;; `eshell-modules-list'. We use "(progn (defgroup ..." in each file
+;; to force the autoloader into including the entire defgroup, rather
+;; than an abbreviated version.
(load "esh-groups" nil 'nomessage)
;;; User Variables:
(and (listp opt) (nth 3 opt)))
(cadr options)))
'(usage-msg last-value ext-command args))
- (eshell-do-opt ,name ,options (quote ,body-forms)))))
+ ;; FIXME: `options' ends up hiding some variable names under `quote',
+ ;; which is incompatible with lexical scoping!!
+ (eshell-do-opt ,name ,options (lambda () ,@body-forms)))))
;;; Internal Functions:
;; Documented part of the interface; see eshell-eval-using-options.
(defvar args)
-(defun eshell-do-opt (name options body-forms)
+(defun eshell-do-opt (name options body-fun)
"Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
(setq args temp-args)
(throw 'eshell-usage
(eshell-show-usage name options)))
(setq args (eshell-process-args name args options)
- last-value (eval (append (list 'progn)
- body-forms)))
+ last-value (funcall body-fun))
nil))
(error "%s" usage-msg))))
(throw 'eshell-external
found)
(while opts
(if (and (listp (car opts))
- (nth kind (car opts))
- (if (= kind 0)
- (eq switch (nth kind (car opts)))
- (string= switch (nth kind (car opts)))))
+ (nth kind (car opts))
+ (equal switch (nth kind (car opts))))
(progn
(eshell-set-option name ai (car opts) options)
(setq found t opts nil))
NOTE: If you find that numeric conversions are interfering with the
specification of filenames (for example, in calling `find-file', or
some other Lisp function that deals with files, not numbers), add the
-following in your .emacs file:
+following in your init file:
(put 'find-file 'eshell-no-numeric-conversions t)
(defmacro eshell-for (for-var for-list &rest forms)
"Iterate through a list."
+ (declare (obsolete dolist "24.1"))
(declare (indent 2))
`(let ((list-iter ,for-list))
(while list-iter
,@forms)
(setq list-iter (cdr list-iter)))))
-
-(make-obsolete 'eshell-for 'dolist "24.1")
-
(defun eshell-flatten-list (args)
"Flatten any lists within ARGS, so that there are no sublists."
(let ((new-list (list t)))
(eval-when-compile
(require 'pcomplete)
(require 'esh-util)
- (require 'esh-opt)
(require 'esh-mode))
+(require 'esh-opt)
(require 'env)
(require 'ring)
;; things up.
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'esh-util))
(require 'esh-util)
(require 'esh-mode)
(defgroup eshell nil
- "A command shell implemented entirely in Emacs Lisp.
+ "Command shell implemented entirely in Emacs Lisp.
It invokes no external processes beyond those requested by the
user, and is intended to be a functional replacement for command
shells such as bash, zsh, rc, 4dos."
- :tag "The Emacs shell"
:link '(info-link "(eshell)Top")
:version "21.1"
:group 'applications)
-;; This is hack to force make-autoload to put the whole definition
-;; into the autoload file (see esh-module.el).
-(defalias 'eshell-defgroup 'defgroup)
-
;;;_* User Options
;;
;; 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'."
+ (declare (obsolete nil "24.3"))
(add-to-list 'same-window-buffer-names eshell-buffer-name))
-(defsubst eshell-remove-from-window-buffer-names ()
+(defun eshell-remove-from-window-buffer-names ()
"Remove `eshell-buffer-name' from `same-window-buffer-names'."
+ (declare (obsolete nil "24.3"))
(setq same-window-buffer-names
(delete eshell-buffer-name same-window-buffer-names)))
: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)
nonnumeric prefix arg means to create a new session. Returns the
buffer selected (or created)."
(interactive "P")
- (assert eshell-buffer-name)
+ (cl-assert eshell-buffer-name)
(let ((buf (cond ((numberp arg)
(get-buffer-create (format "%s<%d>"
eshell-buffer-name
(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
- (assert (and buf (buffer-live-p buf)))
- (pop-to-buffer buf)
+ (cl-assert (and buf (buffer-live-p buf)))
+ (pop-to-buffer-same-window buf)
(unless (eq major-mode 'eshell-mode)
(eshell-mode))
buf))
(when intr
(if (eshell-interactive-process)
(eshell-wait-for-process (eshell-interactive-process)))
- (assert (not (eshell-interactive-process)))
+ (cl-assert (not (eshell-interactive-process)))
(goto-char (point-max))
(while (and (bolp) (not (bobp)))
(delete-char -1)))
- (assert (and buf (buffer-live-p buf)))
+ (cl-assert (and buf (buffer-live-p buf)))
(unless arg
(let ((len (if (not intr) 2
(count-lines (point-min) (point-max)))))
(list 'eshell-commands
(list 'eshell-command-to-value
(eshell-parse-command command))) t)))
- (assert (eq (car result) 'quote))
+ (cl-assert (eq (car result) 'quote))
(if (and status-var (symbolp status-var))
(set status-var eshell-last-command-status))
(cadr result))))))
Return a cookie which can be used to delete this remapping with
`face-remap-remove-relative'.
-The remaining arguments, SPECS, should be either a list of face
-names, or a property list of face attribute/value pairs. The
-remapping specified by SPECS takes effect alongside the
-remappings from other calls to `face-remap-add-relative', as well
-as the normal definition of FACE (at lowest priority). This
-function tries to sort multiple remappings for the same face, so
-that remappings specifying relative face attributes are applied
-after remappings specifying absolute face attributes.
+The remaining arguments, SPECS, should form a list of faces.
+Each list element should be either a face name or a property list
+of face attribute/value pairs. If more than one face is listed,
+that specifies an aggregate face, in the same way as in a `face'
+text property, except for possible priority changes noted below.
+
+The face remapping specified by SPECS takes effect alongside the
+remappings from other calls to `face-remap-add-relative' for the
+same FACE, as well as the normal definition of FACE (at lowest
+priority). This function tries to sort multiple remappings for
+the same face, so that remappings specifying relative face
+attributes are applied after remappings specifying absolute face
+attributes.
The base (lowest priority) remapping may be set to something
other than the normal definition of FACE via `face-remap-set-base'."
(defun face-remap-set-base (face &rest specs)
"Set the base remapping of FACE in the current buffer to SPECS.
This causes the remappings specified by `face-remap-add-relative'
-to apply on top of the face specification given by SPECS. SPECS
-should be either a list of face names, or a property list of face
-attribute/value pairs.
+to apply on top of the face specification given by SPECS.
+
+The remaining arguments, SPECS, should form a list of faces.
+Each list element should be either a face name or a property list
+of face attribute/value pairs, like in a `face' text property.
If SPECS is empty, call `face-remap-reset-base' to use the normal
definition of FACE as the base remapping; note that this is
`text-scale-decrease' may be more appropriate."
(interactive "p")
(let ((first t)
- (step t)
(ev last-command-event)
(echo-keystrokes nil))
- (while step
- (let ((base (event-basic-type ev)))
- (cond ((or (eq base ?+) (eq base ?=))
- (setq step inc))
- ((eq base ?-)
- (setq step (- inc)))
- ((eq base ?0)
- (setq step 0))
- (first
- (setq step inc))
- (t
- (setq step nil))))
- (when step
- (text-scale-increase step)
- (setq inc 1 first nil)
- (setq ev (read-event "+,-,0 for further adjustment: "))))
- (push ev unread-command-events)))
+ (let* ((base (event-basic-type ev))
+ (step
+ (pcase base
+ ((or ?+ ?=) inc)
+ (?- (- inc))
+ (?0 0)
+ (t inc))))
+ (text-scale-increase step)
+ ;; FIXME: do it after every "iteration of the loop".
+ (message "+,-,0 for further adjustment: ")
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (mods '(() (control)))
+ (define-key map (vector (append mods '(?-))) 'text-scale-decrease)
+ (define-key map (vector (append mods '(?+))) 'text-scale-increase)
+ ;; = is unshifted + on most keyboards.
+ (define-key map (vector (append mods '(?=))) 'text-scale-increase)
+ (define-key map (vector (append mods '(?0)))
+ (lambda () (interactive) (text-scale-increase 0))))
+ map)
+ t))))
\f
;; ----------------------------------------------------------------
;;;###autoload
(defun buffer-face-set (&rest specs)
"Enable `buffer-face-mode', using face specs SPECS.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
-If SPECS is nil, then `buffer-face-mode' is disabled.
-
-This function will make the variable `buffer-face-mode-face'
-buffer local, and set it to FACE."
+Each argument in SPECS should be a face, i.e. either a face name
+or a property list of face attributes and values. If more than
+one face is listed, that specifies an aggregate face, like in a
+`face' text property. If SPECS is nil or omitted, disable
+`buffer-face-mode'.
+
+This function makes the variable `buffer-face-mode-face' buffer
+local, and sets it to FACE."
(interactive (list (read-face-name "Set buffer face")))
(while (and (consp specs) (null (cdr specs)))
(setq specs (car specs)))
;;;###autoload
(defun buffer-face-toggle (&rest specs)
"Toggle `buffer-face-mode', using face specs SPECS.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
+Each argument in SPECS should be a face, i.e. either a face name
+or a property list of face attributes and values. If more than
+one face is listed, that specifies an aggregate face, like in a
+`face' text property.
If `buffer-face-mode' is already enabled, and is currently using
the face specs SPECS, then it is disabled; if buffer-face-mode is
ARG controls whether the mode is enabled or disabled, and is
interpreted in the usual manner for minor-mode commands.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
+SPECS can be any value suitable for a `face' text property,
+including a face name, a plist of face attributes and values, or
+a list of faces.
-If INTERACTIVE is non-nil, a message will be displayed describing the result.
+If INTERACTIVE is non-nil, display a message describing the
+result.
This is a wrapper function which calls `buffer-face-set' or
`buffer-face-toggle' (depending on ARG), and prints a status
:type 'boolean
:group 'facemenu)
-(defvar facemenu-unlisted-faces
- `(modeline region secondary-selection highlight scratch-face
- ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-")
- ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-")
- ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-"))
- "*List of faces that are of no interest to the user.")
-(make-obsolete-variable 'facemenu-unlisted-faces 'facemenu-listed-faces
- "22.1,\n and has no effect on the Face menu")
-
(defcustom facemenu-listed-faces nil
"List of faces to include in the Face menu.
Each element should be a symbol, the name of a face.
;;; Code:
-(eval-when-compile
- (require 'cl))
+(defcustom term-file-prefix (purecopy "term/")
+ "If non-nil, Emacs startup performs terminal-specific initialization.
+It does this by: (load (concat term-file-prefix (getenv \"TERM\")))
+
+You may set this variable to nil in your init file if you do not wish
+the terminal-initialization file to be loaded."
+ :type '(choice (const :tag "No terminal-specific initialization" nil)
+ (string :tag "Name of directory with term files"))
+ :group 'terminals)
(declare-function xw-defined-colors "term/common-win" (&optional frame))
(defun set-face-attribute (face frame &rest args)
"Set attributes of FACE on FRAME from ARGS.
+This function overrides the face attributes specified by FACE's
+face spec. It is mostly intended for internal use only.
-If FRAME is nil this function sets the attributes for all
-existing frames, and the default for new frames. If FRAME is t,
-change the default for new frames (this is done automatically
-each time an attribute is changed on all frames).
+If FRAME is nil, set the attributes for all existing frames, as
+well as the default for new frames. If FRAME is t, change the
+default for new frames only.
-ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a valid
-face attribute name. All attributes can be set to `unspecified';
-this fact is not further mentioned below.
+ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a
+valid face attribute name. All attributes can be set to
+`unspecified'; this fact is not further mentioned below.
The following attributes are recognized:
`:family'
-VALUE must be a string specifying the font family, e.g. ``monospace'',
-or a fontset alias name. If a font family is specified, wild-cards `*'
-and `?' are allowed.
+VALUE must be a string specifying the font family
+\(e.g. \"Monospace\") or a fontset.
`:foundry'
`:height'
-VALUE specifies the height of the font, in either absolute or relative
-terms. An absolute height is an integer, and specifies font height in
-units of 1/10 pt. A relative height is either a floating point number,
+VALUE specifies the relative or absolute height of the font. An
+absolute height is an integer, and specifies font height in units
+of 1/10 pt. A relative height is either a floating point number,
which specifies a scaling factor for the underlying face height;
-or a function that takes a single argument (the underlying face height)
-and returns the new height. Note that for the `default' face,
-you can only specify an absolute height (since there is nothing
+or a function that takes a single argument (the underlying face
+height) and returns the new height. Note that for the `default'
+face, you must specify an absolute height (since there is nothing
for it to be relative to).
`:weight'
`:underline'
-VALUE specifies whether characters in FACE should be underlined. If
-VALUE is t, underline with foreground color of the face. If VALUE is
-a string, underline with that color. If VALUE is nil, explicitly
-don't underline.
+VALUE specifies whether characters in FACE should be underlined.
+If VALUE is t, underline with foreground color of the face.
+If VALUE is a string, underline with that color.
+If VALUE is nil, explicitly don't underline.
+
+Otherwise, VALUE must be a property list of the form:
+
+`(:color COLOR :style STYLE)'.
+
+COLOR can be a either a color name string or `foreground-color'.
+STYLE can be either `line' or `wave'.
+If a keyword/value pair is missing from the property list, a
+default value will be used for the value.
+The default value of COLOR is the foreground color of the face.
+The default value of STYLE is `line'.
`:overline'
`:font'
-Set font-related face attributes from VALUE. VALUE must be a valid
-XLFD font name. If it is a font name pattern, the first matching font
-will be used.
-
-For compatibility with Emacs 20, keywords `:bold' and `:italic' can
-be used to specify that a bold or italic font should be used. VALUE
-must be t or nil in that case. A value of `unspecified' is not allowed.
+Set font-related face attributes from VALUE. VALUE must be a
+valid font name or font object. Setting this attribute will also
+set the `:family', `:foundry', `:width', `:height', `:weight',
+and `:slant' attributes.
`:inherit'
-VALUE is the name of a face from which to inherit attributes, or a list
-of face names. Attributes from inherited faces are merged into the face
-like an underlying face would be, with higher priority than underlying faces."
+VALUE is the name of a face from which to inherit attributes, or
+a list of face names. Attributes from inherited faces are merged
+into the face like an underlying face would be, with higher
+priority than underlying faces.
+
+For backward compatibility, the keywords `:bold' and `:italic'
+can be used to specify weight and slant respectively. This usage
+is considered obsolete. For these two keywords, the VALUE must
+be either t or nil. A value of t for `:bold' is equivalent to
+setting `:weight' to `bold', and a value of t for `:italic' is
+equivalent to setting `:slant' to `italic'. But if `:weight' is
+specified in the face spec, `:bold' is ignored, and if `:slant'
+is specified, `:italic' is ignored."
(setq args (purecopy args))
(let ((where (if (null frame) 0 frame))
(spec args)
of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
an integer value."
(let ((valid
- (case attribute
- (:family
+ (pcase attribute
+ (`:family
(if (window-system frame)
(mapcar (lambda (x) (cons x x))
(font-family-list))
;; Only one font on TTYs.
(list (cons "default" "default"))))
- (:foundry
+ (`:foundry
(list nil))
- (:width
+ (`:width
(mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-width-table))
- (:weight
+ (`:weight
(mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-weight-table))
- (:slant
+ (`:slant
(mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-slant-table))
- (:inverse-video
+ (`:inverse-video
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute)))
- ((:underline :overline :strike-through :box)
+ ((or `:underline `:overline `:strike-through `:box)
(if (window-system frame)
(nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))
(defined-colors frame)))
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))))
- ((:foreground :background)
+ ((or `:foreground `:background)
(mapcar #'(lambda (c) (cons c c))
(defined-colors frame)))
- ((:height)
+ (`:height
'integerp)
- (:stipple
+ (`:stipple
(and (memq (window-system frame) '(x ns)) ; No stipple on w32
(mapcar #'list
(apply #'nconc
(file-directory-p dir)
(directory-files dir)))
x-bitmap-file-path)))))
- (:inherit
+ (`:inherit
(cons '("none" . nil)
(mapcar #'(lambda (c) (cons (symbol-name c) c))
(face-list))))
- (t
+ (_
(error "Internal error")))))
(if (and (listp valid) (not (memq attribute '(:inherit))))
(nconc (list (cons "unspecified" 'unspecified)) valid)
:foreground (or foreground 'unspecified)
:background (or background 'unspecified)
:stipple stipple
- :bold bold-p
- :italic italic-p
+ :weight (if bold-p 'bold 'normal)
+ :slant (if italic-p 'italic 'normal)
:underline underline
:inverse-video inverse-p)
(setq face (read-face-name "Modify face"))
(defconst list-faces-sample-text
"abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "*Text string to display as the sample text for `list-faces-display'.")
+ "Text string to display as the sample text for `list-faces-display'.")
;; The name list-faces would be more consistent, but let's avoid a
;; temacs, prior to loading frame.el.
(unless (and (fboundp 'display-graphic-p)
(display-graphic-p frame))
- '(:family "default" :foundry "default" :width normal
+ `(:family "default" :foundry "default" :width normal
:height 1 :weight normal :slant normal
- :foreground "unspecified-fg"
- :background "unspecified-bg")))
+ :foreground ,(if (frame-parameter nil 'reverse)
+ "unspecified-bg"
+ "unspecified-fg")
+ :background ,(if (frame-parameter nil 'reverse)
+ "unspecified-fg"
+ "unspecified-bg"))))
;; For all other faces, unspecify all attributes.
(apply 'append
(mapcar (lambda (x) (list (car x) 'unspecified))
face-attribute-name-alist)))))
(defun face-spec-set (face spec &optional for-defface)
- "Set FACE's face spec, which controls its appearance, to SPEC.
-If FOR-DEFFACE is t, set the base spec, the one that `defface'
- and Custom set. (In that case, the caller must put it in the
- appropriate property, because that depends on the caller.)
-If FOR-DEFFACE is nil, set the overriding spec (and store it
- in the `face-override-spec' property of FACE).
-
-The appearance of FACE is controlled by the base spec,
-by any custom theme specs on top of that, and by the
-overriding spec on top of all the rest.
-
-FOR-DEFFACE can also be a frame, in which case we set the
-frame-specific attributes of FACE for that frame based on SPEC.
-That usage is deprecated.
-
-See `defface' for information about the format and meaning of SPEC."
- (if (framep for-defface)
- ;; Handle the deprecated case where third arg is a frame.
- (face-spec-set-2 face for-defface spec)
- (if for-defface
- ;; When we reset the face based on its custom spec, then it is
- ;; unmodified as far as Custom is concerned.
- (put (or (get face 'face-alias) face) 'face-modified nil)
- ;; When we change a face based on a spec from outside custom,
- ;; record it for future frames.
- (put (or (get face 'face-alias) face) 'face-override-spec spec))
- ;; Reset each frame according to the rules implied by all its specs.
- (dolist (frame (frame-list))
- (face-spec-recalc face frame))))
+ "Set and apply the face spec for FACE.
+If the optional argument FOR-DEFFACE is omitted or nil, set the
+overriding spec to SPEC, recording it in the `face-override-spec'
+property of FACE. See `defface' for the format of SPEC.
+
+If FOR-DEFFACE is non-nil, set the base spec (the one set by
+`defface' and Custom). In this case, SPEC is ignored; the caller
+is responsible for putting the face spec in the `saved-face',
+`customized-face', or `face-defface-spec', as appropriate.
+
+The appearance of FACE is controlled by the base spec, by any
+custom theme specs on top of that, and by the overriding spec on
+top of all the rest."
+ (if for-defface
+ ;; When we reset the face based on its custom spec, then it is
+ ;; unmodified as far as Custom is concerned.
+ (put (or (get face 'face-alias) face) 'face-modified nil)
+ ;; When we change a face based on a spec from outside custom,
+ ;; record it for future frames.
+ (put (or (get face 'face-alias) face) 'face-override-spec spec))
+ ;; Reset each frame according to the rules implied by all its specs.
+ (dolist (frame (frame-list))
+ (face-spec-recalc face frame)))
(defun face-spec-recalc (face frame)
"Reset the face attributes of FACE on FRAME according to its specs.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare-function x-parse-geometry "frame.c" (string))
+(defvar x-display-name)
(defun x-handle-named-frame-geometry (parameters)
"Add geometry parameters for a named frame to parameter list PARAMETERS.
:group 'menu
:group 'basic-faces)
-(defface help-argument-name '((((supports :slant italic)) :inherit italic))
+(defface help-argument-name '((t :inherit italic))
"Face to highlight argument names in *Help* buffers."
:group 'help)
:group 'basic-faces)
(defface error
- '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold))
- (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold))
- (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold))
- (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold))
- (((class color) (min-colors 8)) (:foreground "red"))
- (t (:inverse-video t :weight bold)))
+ '((default :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "Red1")
+ (((class color) (min-colors 88) (background dark)) :foreground "Pink")
+ (((class color) (min-colors 16) (background light)) :foreground "Red1")
+ (((class color) (min-colors 16) (background dark)) :foreground "Pink")
+ (((class color) (min-colors 8)) :foreground "red")
+ (t :inverse-video t))
"Basic face used to highlight errors and to denote failure."
:version "24.1"
:group 'basic-faces)
(defface warning
- '((((class color) (min-colors 16)) (:foreground "DarkOrange" :weight bold))
- (((class color)) (:foreground "yellow" :weight bold))
- (t (:weight bold)))
+ '((default :weight bold)
+ (((class color) (min-colors 16)) :foreground "DarkOrange")
+ (((class color)) :foreground "yellow"))
"Basic face used to highlight warnings."
:version "24.1"
:group 'basic-faces)
(defface success
- '((((class color) (min-colors 16) (background light))
- (:foreground "ForestGreen" :weight bold))
- (((class color) (min-colors 88) (background dark))
- (:foreground "Green1" :weight bold))
- (((class color) (min-colors 16) (background dark))
- (:foreground "Green" :weight bold))
- (((class color)) (:foreground "green" :weight bold))
- (t (:weight bold)))
+ '((default :weight bold)
+ (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 88) (background dark)) :foreground "Green1")
+ (((class color) (min-colors 16) (background dark)) :foreground "Green")
+ (((class color)) :foreground "green"))
"Basic face used to indicate successful operation."
:version "24.1"
:group 'basic-faces)
;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
;; M-x ffap-bug.
;;
-;; For the default installation, add this line to your .emacs file:
+;; For the default installation, add this line to your init file:
;;
;; (ffap-bindings) ; do default key bindings
;;
\f
;;; Code:
+(require 'url-parse)
+
(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2")
(defgroup ffap nil
regexp)
:group 'ffap)
-(defcustom ffap-ftp-regexp
- ;; This used to test for ange-ftp or efs being present, but it should be
- ;; harmless (and simpler) to give it this value unconditionally.
- "\\`/[^/:]+:"
+(defcustom ffap-ftp-regexp "\\`/[^/:]+:"
"File names matching this regexp are treated as remote ffap.
If nil, ffap neither recognizes nor generates such names."
:type '(choice (const :tag "Disable" nil)
:group 'ffap)
(defcustom ffap-url-unwrap-local t
- "If non-nil, convert `file:' URL to local file name before prompting."
+ "If non-nil, convert some URLs to local file names before prompting.
+Only \"file:\" and \"ftp:\" URLs are converted, and only if they
+do not specify a host, or the host is either \"localhost\" or
+equal to `system-name'."
:type 'boolean
:group 'ffap)
-(defcustom ffap-url-unwrap-remote t
- "If non-nil, convert `ftp:' URL to remote file name before prompting.
-This is ignored if `ffap-ftp-regexp' is nil."
- :type 'boolean
- :group 'ffap)
+(defcustom ffap-url-unwrap-remote '("ftp")
+ "If non-nil, convert URLs to remote file names before prompting.
+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.3")
(defcustom ffap-ftp-default-user "anonymous"
"User name in ftp file names generated by `ffap-host-to-path'.
;; those features interesting but not clear winners (a matter of
;; personal taste) I try to leave options to enable them. Read
;; through this section for features that you like, put an appropriate
-;; enabler in your .emacs file.
+;; enabler in your init file.
(defcustom ffap-dired-wildcards "[*?][^/]*\\'"
"A regexp matching filename wildcard characters, or nil.
(defcustom ffap-file-finder 'find-file
"The command called by `find-file-at-point' to find a file."
:type 'function
- :group 'ffap)
-(put 'ffap-file-finder 'risky-local-variable t)
+ :group 'ffap
+ :risky t)
(defcustom ffap-directory-finder 'dired
"The command called by `dired-at-point' to find a directory."
:type 'function
- :group 'ffap)
-(put 'ffap-directory-finder 'risky-local-variable t)
+ :group 'ffap
+ :risky t)
(defcustom ffap-url-fetcher
(if (fboundp 'browse-url)
(const browse-url-netscape)
(const browse-url-mosaic)
function)
+ :group 'ffap
+ :risky t)
+
+(defcustom ffap-next-regexp
+ ;; If you want ffap-next to find URL's only, try this:
+ ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
+ ;; (concat "\\<" (substring ffap-url-regexp 2))))
+ ;;
+ ;; It pays to put a big fancy regexp here, since ffap-guesser is
+ ;; much more time-consuming than regexp searching:
+ "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
+ "Regular expression governing movements of `ffap-next'."
+ :type 'regexp
:group 'ffap)
-(put 'ffap-url-fetcher 'risky-local-variable t)
+
+(defcustom dired-at-point-require-prefix nil
+ "If non-nil, reverse the prefix argument to `dired-at-point'.
+This is nil so neophytes notice FFAP. Experts may prefer to
+disable FFAP most of the time."
+ :type 'boolean
+ :group 'ffap
+ :version "20.3")
\f
;;; Compatibility:
;; then, broke it up into ffap-next-guess (noninteractive) and
;; ffap-next (a command). It now work on files as well as url's.
-(defcustom ffap-next-regexp
- ;; If you want ffap-next to find URL's only, try this:
- ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
- ;; (concat "\\<" (substring ffap-url-regexp 2))))
- ;;
- ;; It pays to put a big fancy regexp here, since ffap-guesser is
- ;; much more time-consuming than regexp searching:
- "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
- "Regular expression governing movements of `ffap-next'."
- :type 'regexp
- :group 'ffap)
-
(defvar ffap-next-guess nil
"Last value returned by `ffap-next-guess'.")
string)))
;; Broke these out of ffap-fixup-url, for use of ffap-url package.
-(defsubst ffap-url-unwrap-local (url)
- "Return URL as a local file, or nil. Ignores `ffap-url-regexp'."
- (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
- (substring url (1+ (match-end 1)))))
-(defsubst ffap-url-unwrap-remote (url)
- "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'."
- (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
- (concat
- (ffap-host-to-filename (substring url (match-beginning 2) (match-end 2)))
- (substring url (match-beginning 3) (match-end 3)))))
-;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
+(defun ffap-url-unwrap-local (url)
+ "Return URL as a local file name, or nil."
+ (let* ((obj (url-generic-parse-url url))
+ (host (url-host obj))
+ (filename (car (url-path-and-query obj))))
+ (when (and (member (url-type obj) '("ftp" "file"))
+ (member host `("" "localhost" ,(system-name))))
+ ;; On Windows, "file:///C:/foo" should unwrap to "C:/foo"
+ (if (and (memq system-type '(ms-dos windows-nt cygwin))
+ (string-match "\\`/[a-zA-Z]:" filename))
+ (substring filename 1)
+ filename))))
+
+(defun ffap-url-unwrap-remote (url)
+ "Return URL as a remote file name, or nil."
+ (let* ((obj (url-generic-parse-url url))
+ (scheme (url-type obj))
+ (valid-schemes (if (listp ffap-url-unwrap-remote)
+ ffap-url-unwrap-remote
+ '("ftp")))
+ (host (url-host obj))
+ (port (url-port-if-non-default obj))
+ (user (url-user obj))
+ (filename (car (url-path-and-query obj))))
+ (when (and (member scheme valid-schemes)
+ (string-match "\\`[a-zA-Z][-a-zA-Z0-9+.]*\\'" scheme)
+ (not (equal host "")))
+ (concat "/" scheme ":"
+ (if user (concat user "@"))
+ host
+ (if port (concat "#" (number-to-string port)))
+ ":" filename))))
(defun ffap-fixup-url (url)
"Clean up URL and return it, maybe as a file name."
(cond
((not (stringp url)) nil)
- ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
- ((and ffap-url-unwrap-remote ffap-ftp-regexp
- (ffap-url-unwrap-remote url)))
- ;; All this seems to do is remove any trailing "#anchor" part (Bug#898).
-;;; ((fboundp 'url-normalize-url) ; may autoload url (part of w3)
-;;; (url-normalize-url url))
+ ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
+ ((and ffap-url-unwrap-remote (ffap-url-unwrap-remote url)))
(url)))
\f
;; ignore non-relative links, trim punctuation. The other will
;; actually look back if point is in whitespace, but I would rather
;; ffap be less aggressive in such situations.
- (and
- ffap-url-regexp
- (or
- ;; In a w3 buffer button?
- (and (eq major-mode 'w3-mode)
- ;; interface recommended by wmperry:
- (w3-view-this-url t))
- ;; Is there a reason not to strip trailing colon?
- (let ((name (ffap-string-at-point 'url)))
- (cond
- ((string-match "^url:" name) (setq name (substring name 4)))
- ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
- ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
- ;; Without "<>" it must be "mailto". Otherwise could be
- ;; either, so consult `ffap-foo-at-bar-prefix'.
- (let ((prefix (if (and (equal (ffap-string-around) "<>")
- ;; Expect some odd characters:
- (string-match "[$.0-9].*[$.0-9].*@" name))
- ;; Could be news:
- ffap-foo-at-bar-prefix
- "mailto")))
- (and prefix (setq name (concat prefix ":" name))))))
- ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
- ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
- (equal (ffap-string-around) "<>")
- ;; (ffap-user-p name):
- (not (string-match "~" (expand-file-name (concat "~" name))))
- )
- (setq name (concat "mailto:" name)))
- )
- (and (ffap-url-p name) name)
- ))))
+ (when ffap-url-regexp
+ (or (and (eq major-mode 'w3-mode) ; In a w3 buffer button?
+ (w3-view-this-url t))
+ ;; Is there a reason not to strip trailing colon?
+ (let ((name (ffap-string-at-point 'url)))
+ (cond
+ ((string-match "^url:" name) (setq name (substring name 4)))
+ ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
+ ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
+ ;; Without "<>" it must be "mailto". Otherwise could be
+ ;; either, so consult `ffap-foo-at-bar-prefix'.
+ (let ((prefix (if (and (equal (ffap-string-around) "<>")
+ ;; Expect some odd characters:
+ (string-match "[$.0-9].*[$.0-9].*@" name))
+ ;; Could be news:
+ ffap-foo-at-bar-prefix
+ "mailto")))
+ (and prefix (setq name (concat prefix ":" name))))))
+ ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
+ ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
+ (equal (ffap-string-around) "<>")
+ ;; (ffap-user-p name):
+ (not (string-match "~" (expand-file-name (concat "~" name)))))
+ (setq name (concat "mailto:" name))))
+
+ (if (ffap-url-p name)
+ name)))))
(defvar ffap-gopher-regexp
"^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
;; We must inform complete about whether our completion function
;; will do filename style completion.
-(defun ffap-complete-as-file-p ()
- ;; Will `minibuffer-completion-table' complete the minibuffer
- ;; contents as a filename? Assumes the minibuffer is current.
- ;; Note: t and non-nil mean somewhat different reasons.
- (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
- (not (ffap-url-p (buffer-string))) ; t
- (and minibuffer-completing-file-name '(t)))) ;list
-
-(and
- (featurep 'complete)
- (if (boundp 'PC-completion-as-file-name-predicate)
- ;; modern version of complete.el, just set the variable:
- (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)))
-
\f
;;; Highlighting (`ffap-highlight'):
-;;
-;; Based on overlay highlighting in Emacs 19.28 isearch.el.
(defvar ffap-highlight t
"If non-nil, ffap highlights the current buffer substring.")
\f
;;; Menu support (`ffap-menu'):
-(defvar ffap-menu-regexp nil
- "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
+(defcustom ffap-menu-regexp nil
+ "If non-nil, regexp overriding `ffap-next-regexp' in `ffap-menu'.
Make this more restrictive for faster menu building.
-For example, try \":/\" for URL (and some ftp) references.")
+For example, try \":/\" for URL (and some ftp) references."
+ :type '(choice (const nil) regexp)
+ :group 'ffap)
(defvar ffap-menu-alist nil
"Buffer local cache of menu presented by `ffap-menu'.")
(set-window-dedicated-p win wdp))
value))
+(defun ffap--toggle-read-only (buffer-or-list)
+ (dolist (buffer (if (listp buffer-or-list)
+ buffer-or-list
+ (list buffer-or-list)))
+ (with-current-buffer buffer
+ (read-only-mode 1))))
+
(defun ffap-read-only ()
"Like `ffap', but mark buffer as read-only.
Only intended for interactive use."
(let ((value (call-interactively 'ffap)))
(unless (or (bufferp value) (bufferp (car-safe value)))
(setq value (current-buffer)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
+ (ffap--toggle-read-only value)
value))
(defun ffap-read-only-other-window ()
Only intended for interactive use."
(interactive)
(let ((value (ffap-other-window)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
+ (ffap--toggle-read-only value)
value))
(defun ffap-read-only-other-frame ()
Only intended for interactive use."
(interactive)
(let ((value (ffap-other-frame)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
+ (ffap--toggle-read-only value)
value))
(defun ffap-alternate-file ()
(defun ffap-ro-mode-hook ()
"Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
(local-set-key "\M-l" 'ffap-next)
- (local-set-key "\M-m" 'ffap-menu)
- )
+ (local-set-key "\M-m" 'ffap-menu))
(defun ffap-gnus-hook ()
"Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
(interactive) (ffap-gnus-wrapper '(ffap-menu)))
\f
-(defcustom dired-at-point-require-prefix nil
- "If set, reverses the prefix argument to `dired-at-point'.
-This is nil so neophytes notice ffap. Experts may prefer to disable
-ffap most of the time."
- :type 'boolean
- :group 'ffap
- :version "20.3")
;;;###autoload
(defun dired-at-point (&optional filename)
;;; Hooks to put in `file-name-at-point-functions':
;;;###autoload
-(progn (defun ffap-guess-file-name-at-point ()
+(defun ffap-guess-file-name-at-point ()
"Try to get a file name at point.
This hook is intended to be put in `file-name-at-point-functions'."
(when (fboundp 'ffap-guesser)
(when guess
(if (file-directory-p guess)
(file-name-as-directory guess)
- guess))))))
+ guess)))))
\f
;;; Offer default global bindings (`ffap-bindings'):
(defvar ffap-bindings
- '(
- (global-set-key [S-mouse-3] 'ffap-at-mouse)
+ '((global-set-key [S-mouse-3] 'ffap-at-mouse)
(global-set-key [C-S-mouse-3] 'ffap-menu)
(global-set-key "\C-x\C-f" 'find-file-at-point)
(add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
(add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
(add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
- (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
- ;; (setq dired-x-hands-off-my-keys t) ; the default
- )
+ (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook))
"List of binding forms evaluated by function `ffap-bindings'.
A reasonable ffap installation needs just this one line:
(ffap-bindings)
(format "%s: " prompt))
obarray
(lambda (sym)
- (or (user-variable-p sym)
+ (or (custom-variable-p sym)
(get sym 'safe-local-variable)
(memq sym '(mode eval coding unibyte))))
nil nil nil default nil))
;;; Code:
-(eval-when-compile (require 'cl))
-
(defvar font-lock-keywords)
(defgroup backup nil
;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-hooks 'permanent-local t)
+(define-obsolete-variable-alias 'find-file-not-found-hooks
+ 'find-file-not-found-functions "22.1")
(defvar find-file-not-found-functions nil
"List of functions to be called for `find-file' on nonexistent file.
These functions are called as soon as the error is detected.
Variable `buffer-file-name' is already set up.
The functions are called in the order given until one of them returns non-nil.")
-(define-obsolete-variable-alias 'find-file-not-found-hooks
- 'find-file-not-found-functions "22.1")
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
:options '(auto-insert)
:version "22.1")
+(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
(defvar write-file-functions nil
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
node `(elisp)Saving Buffers'.) To perform various checks or
updates before the buffer is saved, use `before-save-hook'.")
(put 'write-file-functions 'permanent-local t)
-(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
(defvar local-write-file-hooks nil)
(make-variable-buffer-local 'local-write-file-hooks)
(put 'local-write-file-hooks 'permanent-local t)
(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1")
+(define-obsolete-variable-alias 'write-contents-hooks
+ 'write-contents-functions "22.1")
(defvar write-contents-functions nil
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
To perform various checks or updates before the buffer is saved,
use `before-save-hook'.")
(make-variable-buffer-local 'write-contents-functions)
-(define-obsolete-variable-alias 'write-contents-hooks
- 'write-contents-functions "22.1")
(defcustom enable-local-variables t
"Control use of local variables in files you visit.
(defun parse-colon-path (search-path)
"Explode a search path into a list of directory names.
-Directories are separated by occurrences of `path-separator'
-\(which is colon in GNU and GNU-like systems)."
- ;; We could use split-string here.
- (and search-path
- (let (cd-list (cd-start 0) cd-colon)
- (setq search-path (concat search-path path-separator))
- (while (setq cd-colon (string-match path-separator search-path cd-start))
- (setq cd-list
- (nconc cd-list
- (list (if (= cd-start cd-colon)
- nil
- (substitute-in-file-name
- (file-name-as-directory
- (substring search-path cd-start cd-colon)))))))
- (setq cd-start (+ cd-colon 1)))
- cd-list)))
+Directories are separated by `path-separator' (which is colon in
+GNU and Unix systems). Substitute environment variables into the
+resulting list of directory names."
+ (when (stringp search-path)
+ (mapcar (lambda (f)
+ (substitute-in-file-name (file-name-as-directory f)))
+ (split-string search-path path-separator t))))
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
(read-file-name-internal string pred action))
((eq (car-safe action) 'boundaries)
(let ((suffix (cdr action)))
- (list* 'boundaries
- (length (file-name-directory string))
- (let ((x (file-name-directory suffix)))
- (if x (1- (length x)) (length suffix))))))
+ `(boundaries
+ ,(length (file-name-directory string))
+ ,@(let ((x (file-name-directory suffix)))
+ (if x (1- (length x)) (length suffix))))))
(t
(let ((names '())
;; If we have files like "foo.el" and "foo.elc", we could load one of
(defun locate-file-completion (string path-and-suffixes action)
"Do completion for file names passed to `locate-file'.
PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
+ (declare (obsolete locate-file-completion-table "23.1"))
(locate-file-completion-table (car path-and-suffixes)
(cdr path-and-suffixes)
string nil action))
-(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1")
(defvar locate-dominating-stop-dir-regexp
(purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'")
;; nil)))
(defun locate-dominating-file (file name)
- "Look up the directory hierarchy from FILE for a file named NAME.
+ "Look up the directory hierarchy from FILE for a directory containing NAME.
Stop at the first parent directory containing a file NAME,
and return the directory. Return nil if not found.
-
-This function only tests if FILE exists. If you care about whether
-it is readable, regular, etc., you should test the result."
+Instead of a string, NAME can also be a predicate taking one argument
+\(a directory) and returning a non-nil value if that directory is the one for
+which we're looking."
;; We used to use the above locate-dominating-files code, but the
;; directory-files call is very costly, so we're much better off doing
;; multiple calls using the code in here.
;; (setq user (nth 2 (file-attributes file)))
;; (and prev-user (not (equal user prev-user))))
(string-match locate-dominating-stop-dir-regexp file)))
- ;; FIXME? maybe this function should (optionally?)
- ;; use file-readable-p instead. In many cases, an unreadable
- ;; FILE is no better than a non-existent one.
- ;; See eg dir-locals-find-file.
- (setq try (file-exists-p (expand-file-name name file)))
+ (setq try (if (stringp name)
+ (file-exists-p (expand-file-name name file))
+ (funcall name file)))
(cond (try (setq root file))
((equal file (setq file (file-name-directory
(directory-file-name file))))
(setq file nil))))
- root))
+ (if root (file-name-as-directory root))))
(defun executable-find (command)
(funcall handler 'file-remote-p file identification connected)
nil)))
+;; Probably this entire variable should be obsolete now, in favor of
+;; something Tramp-related (?). It is not used in many places.
+;; It's not clear what the best file for this to be in is, but given
+;; it uses custom-initialize-delay, it is easier if it is preloaded
+;; rather than autoloaded.
+(defcustom remote-shell-program
+ ;; This used to try various hard-coded places for remsh, rsh, and
+ ;; rcmd, trying to guess based on location whether "rsh" was
+ ;; "restricted shell" or "remote shell", but I don't see the point
+ ;; in this day and age. Almost everyone will use ssh, and have
+ ;; whatever command they want to use in PATH.
+ (purecopy
+ (let ((list '("ssh" "remsh" "rcmd" "rsh")))
+ (while (and list
+ (not (executable-find (car list)))
+ (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.3" ; ssh rather than rsh, etc
+ :initialize 'custom-initialize-delay
+ :group 'environment
+ :type 'file)
+
(defcustom remote-file-name-inhibit-cache 10
"Whether to use the remote file-name cache for read access.
When `nil', never expire cached values (caution)
(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.)
;; 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.
(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))
(find-file filename)
(current-buffer)))
-(defun find-file-read-only (filename &optional wildcards)
- "Edit file FILENAME but don't allow changes.
-Like \\[find-file], but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
- (interactive
- (find-file-read-args "Find file read-only: "
- (confirm-nonexistent-file-or-buffer)))
+(defun find-file--read-only (fun filename wildcards)
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
(file-exists-p filename))
(error "%s does not exist" filename))
- (let ((value (find-file filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
+ (let ((value (funcall fun filename wildcards)))
+ (mapc (lambda (b) (with-current-buffer b (read-only-mode 1)))
(if (listp value) value (list value)))
value))
+(defun find-file-read-only (filename &optional wildcards)
+ "Edit file FILENAME but don't allow changes.
+Like \\[find-file], but marks buffer as read-only.
+Use \\[toggle-read-only] to permit editing."
+ (interactive
+ (find-file-read-args "Find file read-only: "
+ (confirm-nonexistent-file-or-buffer)))
+ (find-file--read-only #'find-file filename wildcards))
+
(defun find-file-read-only-other-window (filename &optional wildcards)
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window], but marks buffer as read-only.
(interactive
(find-file-read-args "Find file read-only other window: "
(confirm-nonexistent-file-or-buffer)))
- (unless (or (and wildcards find-file-wildcards
- (not (string-match "\\`/:" filename))
- (string-match "[[*?]" filename))
- (file-exists-p filename))
- (error "%s does not exist" filename))
- (let ((value (find-file-other-window filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
- value))
+ (find-file--read-only #'find-file-other-window filename wildcards))
(defun find-file-read-only-other-frame (filename &optional wildcards)
"Edit file FILENAME in another frame but don't allow changes.
(interactive
(find-file-read-args "Find file read-only other frame: "
(confirm-nonexistent-file-or-buffer)))
- (unless (or (and wildcards find-file-wildcards
- (not (string-match "\\`/:" filename))
- (string-match "[[*?]" filename))
- (file-exists-p filename))
- (error "%s does not exist" filename))
- (let ((value (find-file-other-frame filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
- value))
+ (find-file--read-only #'find-file-other-frame filename wildcards))
(defun find-alternate-file-other-window (filename &optional wildcards)
"Find file FILENAME as a replacement for the file in the next window.
(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.
"Regexp to match the automounter prefix in a directory name."
:group 'files
:type 'regexp)
+(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'.")
OP-TYPE specifies the file operation being performed (for message to user)."
(when (and large-file-warning-threshold size
(> size large-file-warning-threshold)
- (not (y-or-n-p (format "File %s is large (%dMB), really %s? "
+ (not (y-or-n-p (format "File %s is large (%s), really %s? "
(file-name-nondirectory filename)
- (/ size 1048576) op-type))))
+ (file-size-human-readable size) op-type))))
(error "Aborted")))
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
(after-find-file error (not nowarn)))
(current-buffer))))
\f
+(defvar file-name-buffer-file-type-alist) ;From dos-w32.el.
+
(defun insert-file-contents-literally (filename &optional visit beg end replace)
"Like `insert-file-contents', but only reads in the file literally.
A buffer may be modified in several ways after reading into the buffer,
(after-insert-file-functions nil)
(coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
- (find-buffer-file-type-function
- (if (fboundp 'find-buffer-file-type)
- (symbol-function 'find-buffer-file-type)
- nil))
+ (file-name-buffer-file-type-alist '(("" . t)))
(inhibit-file-name-handlers
+ ;; FIXME: Yuck!! We should turn insert-file-contents-literally
+ ;; into a file operation instead!
(append '(jka-compr-handler image-file-handler epa-file-handler)
inhibit-file-name-handlers))
(inhibit-file-name-operation 'insert-file-contents))
- (unwind-protect
- (progn
- (fset 'find-buffer-file-type (lambda (_filename) t))
- (insert-file-contents filename visit beg end replace))
- (if find-buffer-file-type-function
- (fset 'find-buffer-file-type find-buffer-file-type-function)
- (fmakunbound 'find-buffer-file-type)))))
+ (insert-file-contents filename visit beg end replace)))
(defun insert-file-1 (filename insert-func)
(if (file-directory-p filename)
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(= (char-after (1- (point-max))) ?\r)))
+ (not buffer-read-only)
(save-excursion
(goto-char (point-max))
- (insert "\n")))
+ (ignore-errors (insert "\n"))))
(when (and buffer-read-only
view-read-only
(not (eq (get major-mode 'mode-class) 'special)))
(boundp 'font-lock-keywords)
(eq (car font-lock-keywords) t))
(setq font-lock-keywords (cadr font-lock-keywords))
- (font-lock-mode 1))
-
- (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
- (ucs-set-table-for-input)))
+ (font-lock-mode 1)))
(defcustom auto-mode-case-fold t
"Non-nil means to try second pass through `auto-mode-alist'.
("\\.makepp\\'" . makefile-makepp-mode)
,@(if (memq system-type '(berkeley-unix darwin))
'(("\\.mk\\'" . makefile-bsdmake-mode)
+ ("\\.make\\'" . makefile-bsdmake-mode)
("GNUmakefile\\'" . makefile-gmake-mode)
("[Mm]akefile\\'" . makefile-bsdmake-mode))
'(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
+ ("\\.make\\'" . makefile-gmake-mode)
("[Mm]akefile\\'" . makefile-gmake-mode)))
("\\.am\\'" . makefile-automake-mode)
;; Less common extensions come here
("\\.dbk\\'" . xml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
- ("\\.js\\'" . js-mode) ; javascript-mode would be better
- ("\\.json\\'" . js-mode)
+ ("\\.js\\'" . javascript-mode)
+ ("\\.json\\'" . javascript-mode)
("\\.[ds]?vh?\\'" . verilog-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
(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))))))
(funcall mode)
mode)))
+(defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
+ "Regexp of lines to skip when looking for file-local settings.
+If the first line matches this regular expression, then the -*-...-*- file-
+local settings will be consulted on the second line instead of the first.")
+
(defun set-auto-mode-1 ()
"Find the -*- spec in the buffer.
Call with point at the place to start searching from.
;; interpreter invocation. The same holds
;; for '\" in man pages (preprocessor
;; magic for the `man' program).
- (and (looking-at "^\\(#!\\|'\\\\\"\\)") 2)) t)
+ (and (looking-at file-auto-mode-skip) 2)) t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
RISKY-VARS is the list of those that are marked as risky.
If these settings come from directory-local variables, then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
- (if noninteractive
- nil
- (save-window-excursion
- (let* ((name (or dir-name
- (if buffer-file-name
- (file-name-nondirectory buffer-file-name)
- (concat "buffer " (buffer-name)))))
- (offer-save (and (eq enable-local-variables t)
- unsafe-vars))
- (exit-chars
- (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g)))
- (buf (pop-to-buffer "*Local Variables*"))
- prompt char)
- (set (make-local-variable 'cursor-type) nil)
+ (unless noninteractive
+ (let ((name (cond (dir-name)
+ (buffer-file-name
+ (file-name-nondirectory buffer-file-name))
+ ((concat "buffer " (buffer-name)))))
+ (offer-save (and (eq enable-local-variables t)
+ unsafe-vars))
+ (buf (get-buffer-create "*Local Variables*")))
+ ;; Set up the contents of the *Local Variables* buffer.
+ (with-current-buffer buf
(erase-buffer)
(cond
(unsafe-vars
(let ((print-escape-newlines t))
(prin1 (cdr elt) buf))
(insert "\n"))
- (setq prompt
- (format "Please type %s%s: "
- (if offer-save "y, n, or !" "y or n")
- (if (< (line-number-at-pos) (window-body-height))
- ""
- (push ?\C-v exit-chars)
- ", or C-v to scroll")))
- (goto-char (point-min))
- (while (null char)
- (setq char (read-char-choice prompt exit-chars t))
- (when (eq char ?\C-v)
- (condition-case nil
- (scroll-up)
- (error (goto-char (point-min))))
- (setq char nil)))
- (kill-buffer buf)
- (when (and offer-save (= char ?!) unsafe-vars)
- (customize-push-and-save 'safe-local-variable-values unsafe-vars))
- (memq char '(?! ?\s ?y))))))
+ (set (make-local-variable 'cursor-type) nil)
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))
+
+ ;; Display the buffer and read a choice.
+ (save-window-excursion
+ (pop-to-buffer buf)
+ (let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
+ (prompt (format "Please type %s%s: "
+ (if offer-save "y, n, or !" "y or n")
+ (if (< (line-number-at-pos (point-max))
+ (window-body-height))
+ ""
+ (push ?\C-v exit-chars)
+ ", or C-v to scroll")))
+ char)
+ (if offer-save (push ?! exit-chars))
+ (while (null char)
+ (setq char (read-char-choice prompt exit-chars t))
+ (when (eq char ?\C-v)
+ (condition-case nil
+ (scroll-up)
+ (error (goto-char (point-min))
+ (recenter 1)))
+ (setq char nil)))
+ (when (and offer-save (= char ?!) unsafe-vars)
+ (customize-push-and-save 'safe-local-variable-values unsafe-vars))
+ (prog1 (memq char '(?! ?\s ?y))
+ (quit-window t)))))))
(defun hack-local-variables-prop-line (&optional mode-only)
"Return local variables specified in the -*- line.
;; Obey `enable-local-eval'.
((eq var 'eval)
(when enable-local-eval
- (let ((safe (or (hack-one-local-variable-eval-safep
- (eval (quote val)))
+ (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.
class-name))
(error (message "Error reading dir-locals: %S" err) nil)))))
+(defcustom enable-remote-dir-locals nil
+ "Non-nil means dir-local variables will be applied to remote files."
+ :version "24.3"
+ :type 'boolean
+ :group 'find-file)
+
(defun hack-dir-local-variables ()
"Read per-directory local variables for the current buffer.
Store the directory-local variables in `dir-local-variables-alist'
and `file-local-variables-alist', without applying them."
(when (and enable-local-variables
- (not (file-remote-p (or (buffer-file-name) default-directory))))
+ (or enable-remote-dir-locals
+ (not (file-remote-p (or (buffer-file-name)
+ default-directory)))))
;; Find the variables file.
- (let ((variables-file (dir-locals-find-file (or (buffer-file-name) default-directory)))
+ (let ((variables-file (dir-locals-find-file
+ (or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
(if period
"")))))
+(defun file-name-base (&optional filename)
+ "Return the base name of the FILENAME: no directory, no extension.
+FILENAME defaults to `buffer-file-name'."
+ (file-name-sans-extension
+ (file-name-nondirectory (or filename (buffer-file-name)))))
+
(defcustom make-backup-file-name-function nil
"A function to use instead of the default `make-backup-file-name'.
A value of nil gives the default `make-backup-file-name' behavior.
(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
(format
"%s has changed since visited or saved. Save anyway? "
(file-name-nondirectory buffer-file-name)))
- (error "Save not confirmed"))
+ (user-error "Save not confirmed"))
(save-restriction
(widen)
(save-excursion
"Modification-flag cleared"))
(set-buffer-modified-p arg))
-(defun toggle-read-only (&optional arg)
- "Change whether this buffer is read-only.
-With prefix argument ARG, make the buffer read-only if ARG is
-positive, otherwise make it writable. If buffer is read-only
-and `view-read-only' is non-nil, enter view mode.
-
-This function is usually the wrong thing to use in a Lisp program.
-It can have side-effects beyond changing the read-only status of a buffer
-\(e.g., enabling view mode), and does not affect read-only regions that
-are caused by text properties. To make a buffer read-only in Lisp code,
-set `buffer-read-only'. To ignore read-only status (whether due to text
-properties or buffer state) and make changes, temporarily bind
-`inhibit-read-only'."
- (interactive "P")
- (if (and arg
- (if (> (prefix-numeric-value arg) 0) buffer-read-only
- (not buffer-read-only))) ; If buffer-read-only is set correctly,
- nil ; do nothing.
- ;; Toggle.
- (cond
- ((and buffer-read-only view-mode)
- (View-exit-and-edit)
- (make-local-variable 'view-read-only)
- (setq view-read-only t)) ; Must leave view mode.
- ((and (not buffer-read-only) view-read-only
- ;; If view-mode is already active, `view-mode-enter' is a nop.
- (not view-mode)
- (not (eq (get major-mode 'mode-class) 'special)))
- (view-mode-enter))
- (t (setq buffer-read-only (not buffer-read-only))
- (force-mode-line-update)))))
+(defun toggle-read-only (&optional arg interactive)
+ (declare (obsolete read-only-mode "24.3"))
+ (interactive (list current-prefix-arg t))
+ (if interactive
+ (call-interactively 'read-only-mode)
+ (read-only-mode (or arg 'toggle))))
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
(times (and keep-time (nth 5 (file-attributes directory)))))
(if modes (set-file-modes newname modes))
(if times (set-file-times newname times))))))
+
+\f
+;; At time of writing, only info uses this.
+(defun prune-directory-list (dirs &optional keep reject)
+ "Return a copy of DIRS with all non-existent directories removed.
+The optional argument KEEP is a list of directories to retain even if
+they don't exist, and REJECT is a list of directories to remove from
+DIRS, even if they exist; REJECT takes precedence over KEEP.
+
+Note that membership in REJECT and KEEP is checked using simple string
+comparison."
+ (apply #'nconc
+ (mapcar (lambda (dir)
+ (and (not (member dir reject))
+ (or (member dir keep) (file-directory-p dir))
+ (list dir)))
+ dirs)))
+
\f
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function nil
(not (file-exists-p file-name)))
(error "Auto-save file %s not current"
(abbreviate-file-name file-name)))
- ((save-window-excursion
- (with-output-to-temp-buffer "*Directory*"
- (buffer-disable-undo standard-output)
- (save-excursion
- (let ((switches dired-listing-switches))
- (if (file-symlink-p file)
- (setq switches (concat switches " -L")))
- (set-buffer standard-output)
- ;; Use insert-directory-safely, not insert-directory,
- ;; because these files might not exist. In particular,
- ;; FILE might not exist if the auto-save file was for
- ;; a buffer that didn't visit a file, such as "*mail*".
- ;; The code in v20.x called `ls' directly, so we need
- ;; to emulate what `ls' did in that case.
- (insert-directory-safely file switches)
- (insert-directory-safely file-name switches))))
- (yes-or-no-p (format "Recover auto save file %s? " file-name)))
+ ((with-temp-buffer-window
+ "*Directory*" nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (yes-or-no-p (format "Recover auto save file %s? " file-name))
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (with-current-buffer standard-output
+ (let ((switches dired-listing-switches))
+ (if (file-symlink-p file)
+ (setq switches (concat switches " -L")))
+ ;; Use insert-directory-safely, not insert-directory,
+ ;; because these files might not exist. In particular,
+ ;; FILE might not exist if the auto-save file was for
+ ;; a buffer that didn't visit a file, such as "*mail*".
+ ;; The code in v20.x called `ls' directly, so we need
+ ;; to emulate what `ls' did in that case.
+ (insert-directory-safely file switches)
+ (insert-directory-safely file-name switches))))
(switch-to-buffer (find-file-noselect file t))
(let ((inhibit-read-only t)
;; Keep the current buffer-file-coding-system.
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system))
(after-find-file nil nil t))
- (t (error "Recover-file cancelled")))))
+ (t (user-error "Recover-file cancelled")))))
(defun recover-session ()
"Recover auto save files from a previous Emacs session.
(when (and directory-free-space-program
;; Avoid failure if the default directory does
;; not exist (Bug#2631, Bug#3911).
- (let ((default-directory "/"))
- (eq (call-process directory-free-space-program
+ (let ((default-directory
+ (locate-dominating-file dir 'file-directory-p)))
+ (eq (process-file directory-free-space-program
nil t nil
directory-free-space-args
- dir)
+ (file-relative-name dir))
0)))
;; Assume that the "available" column is before the
;; "capacity" column. Find the "%" and scan backward.
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (progn (list-processes t)
- (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))))
+ (with-temp-buffer-window
+ (get-buffer-create "*Process List*") nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (yes-or-no-p "Active processes exist; kill them and exit anyway? ")
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (list-processes t)))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm-kill-emacs)
"/"
(substring (car pair) 2)))))
(setq file-arg-indices (cdr file-arg-indices))))
- (case method
- (identity (car arguments))
- (add (concat "/:" (apply operation arguments)))
- (insert-file-contents
+ (pcase method
+ (`identity (car arguments))
+ (`add (concat "/:" (apply operation arguments)))
+ (`insert-file-contents
(let ((visit (nth 1 arguments)))
(prog1
- (apply operation arguments)
+ (apply operation arguments)
(when (and visit buffer-file-name)
(setq buffer-file-name (concat "/:" buffer-file-name))))))
- (unquote-then-quote
+ (`unquote-then-quote
(let ((buffer-file-name (substring buffer-file-name 2)))
(apply operation arguments)))
- (t
- (apply operation arguments)))))
+ (_
+ (apply operation arguments)))))
\f
;; Symbolic modes and read-file-modes.
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
(define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal)
-(define-key ctl-x-map "\C-q" 'toggle-read-only)
+(define-key ctl-x-map "\C-q" 'read-only-mode)
(define-key ctl-x-4-map "f" 'find-file-other-window)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
;; inclusion group (i.e. a base file including other files).
;; Usage:
-;; 1. Put (require 'filesets) and (filesets-init) in your .emacs file.
+;; 1. Put (require 'filesets) and (filesets-init) in your init file.
;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
;; 3. Save your customizations.
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(eval-when-compile (require 'cl-lib))
;;; Some variables
(or entry
(filesets-get-external-viewer filename)))))
(filesets-alist-get def
- (case event
- ((on-open-all) ':ignore-on-open-all)
- ((on-grep) ':ignore-on-read-text)
- ((on-cmd) nil)
- ((on-close-all) nil))
+ (pcase event
+ (`on-open-all ':ignore-on-open-all)
+ (`on-grep ':ignore-on-read-text)
+ (`on-cmd nil)
+ (`on-close-all nil))
nil t)))
(defun filesets-filetype-get-prop (property filename &optional entry)
(defun filesets-get-fileset-from-name (name &optional mode)
"Get fileset definition for NAME."
- (case mode
- ((:ingroup :tree)
- name)
- (t
- (assoc name filesets-data))))
+ (pcase mode
+ ((or `:ingroup `:tree) name)
+ (_ (assoc name filesets-data))))
;;; commands
Assume MODE (see `filesets-entry-mode'), if provided."
(let* ((mode (or mode
(filesets-entry-mode entry)))
- (fl (case mode
- ((:files)
+ (fl (pcase mode
+ (:files
(filesets-entry-get-files entry))
- ((:file)
+ (:file
(list (filesets-entry-get-file entry)))
- ((:ingroup)
+ (:ingroup
(let ((entry (expand-file-name
(if (stringp entry)
entry
(filesets-entry-get-master entry)))))
(cons entry (filesets-ingroup-cache-get entry))))
- ((:tree)
+ (:tree
(let ((dir (nth 0 entry))
(patt (nth 1 entry)))
(filesets-directory-files dir patt ':files t)))
- ((:pattern)
+ (:pattern
(let ((dirpatt (filesets-entry-get-pattern entry)))
(if dirpatt
(let ((dir (filesets-entry-get-pattern--dir dirpatt))
(let* ((result nil)
(factor (ceiling (/ (float bl)
filesets-max-submenu-length))))
- (do ((data submenu-body (cdr data))
- (n 1 (+ n 1))
- (count 0 (+ count factor)))
+ (cl-do ((data submenu-body (cdr data))
+ (n 1 (+ n 1))
+ (count 0 (+ count factor)))
((or (> count bl)
(null data)))
-; (let ((sl (subseq submenu-body count
+ ;; (let ((sl (subseq submenu-body count
(let ((sl (filesets-sublist submenu-body count
(let ((x (+ count factor)))
(if (>= bl x)
`((,(concat
(filesets-get-shortcut n)
(let ((rv ""))
- (do ((x sl (cdr x)))
+ (cl-do ((x sl (cdr x)))
((null x))
(let ((y (concat (elt (car x) 0)
(if (null (cdr x))
"Get submenu epilog for SOMETHING (usually a fileset).
If mode is :tree or :ingroup, SOMETHING is some weird construct and
LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
- (case mode
- ((:tree)
+ (pcase mode
+ (:tree
`("---"
["Close all files" (filesets-close ',mode ',something ',lookup-name)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:ingroup)
+ (:ingroup
`("---"
["Close all files" (filesets-close ',mode ',something ',lookup-name)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:pattern)
+ (:pattern
`("---"
["Close all files" (filesets-close ',mode ',something)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:files)
+ (:files
`("---"
[,(concat "Close all files") (filesets-close ',mode ',something)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- (t
+ (_
(filesets-error 'error "Filesets: malformed definition of " something))))
(defun filesets-ingroup-get-data (master pos &optional fun)
(filesets-verbosity (filesets-entry-get-verbosity entry))
(this-lookup-name (concat (filesets-get-shortcut count)
lookup-name)))
- (case mode
- ((:file)
+ (pcase mode
+ (:file
(let* ((file (filesets-entry-get-file entry)))
`[,this-lookup-name
(filesets-file-open nil ',file ',lookup-name)]))
- (t
+ (_
`(,this-lookup-name
- ,@(case mode
- ((:pattern)
+ ,@(pcase mode
+ (:pattern
(let* ((files (filesets-get-filelist entry mode 'on-ls))
(dirpatt (filesets-entry-get-pattern entry))
(pattname (apply 'concat (cons "Pattern: " dirpatt)))
files))
,@(filesets-get-menu-epilog lookup-name mode
lookup-name t))))
- ((:ingroup)
+ (:ingroup
(let* ((master (filesets-entry-get-master entry)))
;;(filesets-message 3 "Filesets: parsing %S" master)
`([,(concat "Inclusion Group: "
,@(filesets-wrap-submenu
(filesets-build-ingroup-submenu lookup-name master))
,@(filesets-get-menu-epilog master mode lookup-name t))))
- ((:tree)
+ (:tree
(let* ((dirpatt (filesets-entry-get-tree entry))
(dir (car dirpatt))
(patt (cadr dirpatt)))
(filesets-build-dir-submenu entry lookup-name dir patt)))
- ((:files)
+ (:files
(let ((files (filesets-get-filelist entry mode 'on-open-all))
(count 0))
`([,(concat "Files: " lookup-name)
(setq filesets-has-changed-flag nil)
(setq filesets-updated-buffers nil)
(setq filesets-update-cache-file-flag t)
- (do ((data (filesets-conditional-sort filesets-data (function car))
- (cdr data))
- (count 1 (+ count 1)))
+ (cl-do ((data (filesets-conditional-sort filesets-data (function car))
+ (cdr data))
+ (count 1 (+ count 1)))
((null data))
(let* ((this (car data))
(name (filesets-data-get-name this))
:group 'ff)
;;;###autoload
-(defvar ff-special-constructs
- `(
- ;; C/C++ include, for NeXTstep too
- (,(purecopy "^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
+(defcustom ff-special-constructs
+ ;; C/C++ include, for NeXTstep too
+ `((,(purecopy "^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
(lambda ()
- (buffer-substring (match-beginning 2) (match-end 2))))
- )
+ (buffer-substring (match-beginning 2) (match-end 2)))))
;; We include `ff-treat-as-special' documentation here so that autoload
;; can make it available to be read prior to loading this file.
- "*List of special constructs for `ff-treat-as-special' to recognize.
+ "List of special constructs recognized by `ff-treat-as-special'.
Each element, tried in order, has the form (REGEXP . EXTRACT).
If REGEXP matches the current line (from the beginning of the line),
`ff-treat-as-special' calls function EXTRACT with no args.
If EXTRACT returns nil, keep trying. Otherwise, return the
-filename that EXTRACT returned.")
+filename that EXTRACT returned."
+ :type '(repeat (cons regexp function))
+ :group 'ff)
(defvaralias 'ff-related-file-alist 'ff-other-file-alist)
(defcustom ff-other-file-alist 'cc-other-file-alist
;;
;; To invoke these adjustments, a user need only invoke the function
;; enable-flow-control-on with a list of terminal types in his/her own
-;; .emacs file. As arguments, give it the names of one or more terminal
+;; init file. As arguments, give it the names of one or more terminal
;; types in use by that user which require flow control adjustments.
;; Here's an example:
;;
;; look under one of the level-2 headings, position the cursor on it and do C-c
;; C-z again. This exposes the level-2 body and its level-3 child subheadings
;; and narrows the buffer again. You can keep on zooming in on successive
-;; subheadings as much as you like. A string in the modeline tells you how
+;; subheadings as much as you like. A string in the mode line tells you how
;; deep you've gone.
;;
;; When zooming in on a heading you might only want to see the child
;; shows only the subheadings.
;; 1.2 28-Jan-94
-;; Fixed a dumb bug - didn't make `foldout-modeline-string' buffer-local :-(
+;; Fixed a dumb bug - didn't make `foldout-mode-line-string' buffer-local :-(
;;
;; Changed `foldout-exit-fold' to use prefix arg to say how many folds to exit.
;; Negative arg means exit but don't hide text. Zero arg means exit all folds.
An end marker of nil means the fold ends after (point-max).")
(make-variable-buffer-local 'foldout-fold-list)
-(defvar foldout-modeline-string nil
- "Modeline string announcing that we are in an outline fold.")
-(make-variable-buffer-local 'foldout-modeline-string)
+(defvar foldout-mode-line-string nil
+ "Mode line string announcing that we are in an outline fold.")
+(make-variable-buffer-local 'foldout-mode-line-string)
;; put our minor mode string immediately following outline-minor-mode's
-(or (assq 'foldout-modeline-string minor-mode-alist)
+(or (assq 'foldout-mode-line-string minor-mode-alist)
(let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist)
minor-mode-alist))
- (foldout-entry '((foldout-modeline-string foldout-modeline-string))))
+ (foldout-entry '((foldout-mode-line-string foldout-mode-line-string))))
;; something's wrong with outline if we can't find it
(if (null outl-entry)
(setq foldout-fold-list (cons (cons start-marker end-marker)
foldout-fold-list))
- ;; update the modeline
- (foldout-update-modeline)
+ ;; update the mode line
+ (foldout-update-mode-line)
)))
\f
;; zap the markers so they don't slow down editing
(set-marker start-marker nil)
- (if end-marker (set-marker end-marker nil))
- )
+ (if end-marker (set-marker end-marker nil)))
;; narrow to the enclosing fold if there is one
(if foldout-fold-list
(narrow-to-region start-marker
(if end-marker
(1- (marker-position end-marker))
- (point-max)))
- ))
+ (point-max)))))
(recenter)
- ;; update the modeline
- (foldout-update-modeline)
- ))
+ ;; update the mode line
+ (foldout-update-mode-line)))
\f
-(defun foldout-update-modeline ()
- "Set the modeline string to indicate our fold depth."
+(defun foldout-update-mode-line ()
+ "Set the mode line to indicate our fold depth."
(let ((depth (length foldout-fold-list)))
- (setq foldout-modeline-string
+ (setq foldout-mode-line-string
(cond
;; if we're not in a fold, keep quiet
((zerop depth)
nil)
- ;; in outline-minor-mode we're after "Outl:xx" in the modeline
+ ;; in outline-minor-mode we're after "Outl:xx" in the mode line
(outline-minor-mode
(format ":%d" depth))
;; otherwise just announce the depth (I guess we're in outline-mode)
((= depth 1)
" Inside 1 fold")
(t
- (format " Inside %d folds" depth))
- ))))
+ (format " Inside %d folds" depth))))))
\f
(defun foldout-mouse-zoom (event)
;;; follow.el --- synchronize windows showing the same buffer
-
;; Copyright (C) 1995-1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Anders Lindgren <andersl@andersl.com>
;;; Commentary:
-;;{{{ Documentation
-
;; `Follow mode' is a minor mode for Emacs and XEmacs that
;; combines windows into one tall virtual window.
;;
;; (setq truncate-partial-width-windows nil)
-;; Since the display of XEmacs is pixel-oriented, a line could be
-;; clipped in half at the bottom of the window.
-;;
-;; To make XEmacs avoid clipping (normal) lines, please place the
-;; following line in your init-file:
-;;
-;; (setq pixel-vertical-clip-threshold 30)
-
-
;; The correct way to configure Follow mode, or any other mode for
;; that matter, is to create one or more functions that do
;; whatever you would like to do. These functions are then added to
;; a hook.
;;
-;; When `Follow' mode is activated, functions stored in the hook
-;; `follow-mode-hook' are called. When it is deactivated
-;; `follow-mode-off-hook' is run.
-;;
;; The keymap `follow-key-map' contains key bindings activated by
;; `follow-mode'.
;;
;; Example from my ~/.emacs:
;; (global-set-key [f8] 'follow-mode)
-
;; Implementation:
;;
-;; In an ideal world, follow mode would have been implemented in the
-;; kernel of the display routines, making sure that the windows (using
-;; follow mode) ALWAYS are aligned. On planet Earth, however, we must
-;; accept a solution where we ALMOST ALWAYS can make sure that the
-;; windows are aligned.
-;;
-;; Follow mode does this in three places:
-;; 1) After each user command.
-;; 2) After a process output has been performed.
-;; 3) When a scrollbar has been moved.
+;; The main method by which Follow mode aligns windows is via the
+;; function `follow-post-command-hook', which is run after each
+;; command. This "fixes up" the alignment of other windows which are
+;; showing the same Follow mode buffer, on the same frame as the
+;; selected window. It does not try to deal with buffers other than
+;; the buffer of the selected frame, or windows on other frames.
;;
-;; This will cover most situations. (Let me know if there are other
-;; situations that should be covered.)
-;;
-;; Note that only the selected window is checked, for the reason of
-;; efficiency and code complexity. (I.e. it is possible to make a
-;; non-selected window unaligned. It will, however, pop right back
-;; when it is selected.)
-
-;;}}}
+;; Comint mode specially calls `follow-comint-scroll-to-bottom' on
+;; Follow mode buffers. This function scrolls the bottom-most window
+;; in a window chain and aligns the other windows accordingly. Follow
+;; mode adds a function to `compilation-filter-hook' to align
+;; compilation buffers.
;;; Code:
-;;{{{ Preliminaries
-
-;; Make the compiler shut up!
-;; There are two strategies:
-;; 1) Shut warnings off completely.
-;; 2) Handle each warning separately.
-;;
-;; Since I would like to see real errors, I've selected the latter
-;; method.
-;;
-;; The problem with undefined variables and functions has been solved
-;; by using `set', `symbol-value' and `symbol-function' rather than
-;; `setq' and direct references to variables and functions.
-;;
-;; For example:
-;; (if (boundp 'foo) ... (symbol-value 'foo) )
-;; (set 'foo ...) <-- XEmacs doesn't fall for this one.
-;; (funcall (symbol-function 'set) 'bar ...)
-;;
-;; Note: When this file is interpreted, `eval-when-compile' is
-;; evaluated. Since it doesn't hurt to evaluate it, but it is a bit
-;; annoying, we test if the byte-compiler has been loaded. This can,
-;; of course, lead to some occasional unintended evaluation...
-;;
-;; Should someone come up with a better solution, please let me
-;; know.
-
(require 'easymenu)
-(eval-when-compile
- (if (or (featurep 'bytecomp)
- (featurep 'byte-compile))
- (cond ((featurep 'xemacs)
- ;; Make XEmacs shut up! I'm using standard Emacs
- ;; functions, they are NOT obsolete!
- (if (eq (get 'force-mode-line-update 'byte-compile)
- 'byte-compile-obsolete)
- (put 'force-mode-line-update 'byte-compile 'nil))
- (if (eq (get 'frame-first-window 'byte-compile)
- 'byte-compile-obsolete)
- (put 'frame-first-window 'byte-compile 'nil))))))
-
-;;}}}
-;;{{{ Variables
+;;; Variables
(defgroup follow nil
"Synchronize windows showing the same buffer."
- :prefix "follow-"
:group 'windows
:group 'convenience)
:type 'hook
:group 'follow)
-(defcustom follow-mode-off-hook nil
- "Hooks to run when Follow mode is turned off."
- :type 'hook
- :group 'follow)
-(make-obsolete-variable 'follow-mode-off-hook 'follow-mode-hook "22.2")
-
-;;{{{ Keymap/Menu
+;;; Keymap/Menu
;; Define keys for the follow-mode minor mode map and replace some
-;; functions in the global map. All `follow' mode special functions
-;; can be found on (the somewhat cumbersome) "C-c . <key>"
-;; (Control-C dot <key>). (As of Emacs 19.29 the keys
-;; C-c <punctuation character> are reserved for minor modes.)
+;; functions in the global map. All Follow mode special functions can
+;; be found on the `C-c .' prefix key.
;;
-;; To change the prefix, redefine `follow-mode-prefix' before
-;; `follow' is loaded, or see the section on `follow-mode-hook'
-;; above for an example of how to bind the keys the way you like.
-;;
-;; Please note that the keymap is defined the first time this file is
-;; loaded. Also note that the only valid way to manipulate the
-;; keymap is to use `define-key'. Don't change it using `setq' or
-;; similar!
+;; To change the prefix, redefine `follow-mode-prefix' before `follow'
+;; is loaded, or see the section on `follow-mode-hook' above for an
+;; example of how to bind the keys the way you like.
(defcustom follow-mode-prefix "\C-c."
"Prefix key to use for follow commands in Follow mode.
;; the look and feel of Follow mode.)
(define-key mainmap [remap end-of-buffer] 'follow-end-of-buffer)
+ (define-key mainmap [remap scroll-bar-toolkit-scroll] 'follow-scroll-bar-toolkit-scroll)
+ (define-key mainmap [remap scroll-bar-drag] 'follow-scroll-bar-drag)
+ (define-key mainmap [remap scroll-bar-scroll-up] 'follow-scroll-bar-scroll-up)
+ (define-key mainmap [remap scroll-bar-scroll-down] 'follow-scroll-bar-scroll-down)
+ (define-key mainmap [remap mwheel-scroll] 'follow-mwheel-scroll)
+
mainmap)
"Minor mode keymap for Follow mode.")
'(["Follow mode" follow-mode
:style toggle :selected follow-mode])))
-;; If there is a `tools' menu, we use it. However, we can't add a
-;; minor-mode specific item to it (it's broken), so we make the
-;; contents ghosted when not in use, and add ourselves to the
-;; global map.
(easy-menu-add-item nil '("Tools")
'("Follow"
- ;; The Emacs code used to just gray out operations when follow-mode was
- ;; not enabled, whereas the XEmacs code used to remove it altogether.
- ;; Not sure which is preferable, but clearly the preference should not
- ;; depend on the flavor.
:filter follow-menu-filter
["Scroll Up" follow-scroll-up follow-mode]
["Scroll Down" follow-scroll-down follow-mode]
"--"
["Follow mode" follow-mode :style toggle :selected follow-mode]))
-;;}}}
-
(defcustom follow-mode-line-text " Follow"
"Text shown in the mode line when Follow mode is active.
Defaults to \" Follow\". Examples of other values
(defcustom follow-auto nil
"Non-nil activates Follow mode whenever a file is loaded."
:type 'boolean
- :group 'follow)
-
-(defcustom follow-intercept-processes (fboundp 'start-process)
- "When non-nil, Follow mode will monitor process output."
- :type 'boolean
- :group 'follow)
-
-(defvar follow-avoid-tail-recenter-p (not (featurep 'xemacs))
- "*When non-nil, patch Emacs so that tail windows won't be recentered.
-
-A \"tail window\" is a window that displays only the end of
-the buffer. Normally it is practical for the user that empty
-windows are recentered automatically. However, when using
-Follow mode it breaks the display when the end is displayed
-in a window \"above\" the last window. This is for
-example the case when displaying a short page in info.
-
-Must be set before Follow mode is loaded.
-
-Please note that it is not possible to fully prevent Emacs from
-recentering empty windows. Please report if you find a repeatable
-situation in which Emacs recenters empty windows.
-
-XEmacs, as of 19.12, does not recenter windows, good!")
+ :group 'follow
+ :set (lambda (symbol value)
+ (if value
+ (add-hook 'find-file-hook 'follow-find-file-hook t)
+ (remove-hook 'find-file-hook 'follow-find-file-hook))
+ (set-default symbol value)))
(defvar follow-cache-command-list
'(next-line previous-line forward-char backward-char)
To mark other commands as suitable for caching, set the symbol
property `follow-mode-use-cache' to non-nil.")
-(defvar follow-debug nil
- "*Non-nil when debugging Follow mode.")
-
+(defcustom follow-debug nil
+ "If non-nil, emit Follow mode debugging messages."
+ :type 'boolean
+ :group 'follow)
;; Internal variables:
(defvar follow-internal-force-redisplay nil
"True when Follow mode should redisplay the windows.")
-(defvar follow-process-filter-alist '()
- "The original filters for processes intercepted by Follow mode.")
-
(defvar follow-active-menu nil
"The menu visible when Follow mode is active.")
-(defvar follow-deactive-menu nil
- "The menu visible when Follow mode is deactivated.")
+(defvar follow-inactive-menu nil
+ "The menu visible when Follow mode is inactive.")
(defvar follow-inside-post-command-hook nil
"Non-nil when inside Follow modes `post-command-hook'.
(defvar follow-windows-start-end-cache nil
"Cache used by `follow-window-start-end'.")
-;;}}}
-;;{{{ Debug messages
+;;; Debug messages
;; This inline function must be as small as possible!
;; Maybe we should define a macro that expands to nil if
(if (and (boundp 'follow-debug) follow-debug)
(apply 'message args)))
-;;}}}
-;;{{{ Cache
+;;; Cache
(dolist (cmd follow-cache-command-list)
(put cmd 'follow-mode-use-cache t))
-;;}}}
-
-;;{{{ The mode
+;;; The mode
;;;###autoload
(defun turn-on-follow-mode ()
Only windows displayed in the same frame follow each other.
-If the variable `follow-intercept-processes' is non-nil, Follow mode
-will listen to the output of processes and redisplay accordingly.
-\(This is the default.)
-
This command runs the normal hook `follow-mode-hook'.
Keys specific to Follow mode:
\\{follow-mode-map}"
:keymap follow-mode-map
- (when (and follow-mode follow-intercept-processes)
- (follow-intercept-process-output))
- (cond (follow-mode ; On
- ;; XEmacs: If this is non-nil, the window will scroll before
- ;; the point will have a chance to get into the next window.
- (when (boundp 'scroll-on-clipped-lines)
- (setq scroll-on-clipped-lines nil))
- (force-mode-line-update)
- (add-hook 'post-command-hook 'follow-post-command-hook t))
-
- ((not follow-mode) ; Off
- (force-mode-line-update))))
-
-;;}}}
-;;{{{ Find file hook
-
-;; This will start follow-mode whenever a new file is loaded, if
-;; the variable `follow-auto' is non-nil.
-
-(add-hook 'find-file-hook 'follow-find-file-hook t)
+ (if follow-mode
+ (progn
+ (add-hook 'compilation-filter-hook 'follow-align-compilation-windows t t)
+ (add-hook 'post-command-hook 'follow-post-command-hook t)
+ (add-hook 'window-size-change-functions 'follow-window-size-change t))
+ ;; Remove globally-installed hook functions only if there is no
+ ;; other Follow mode buffer.
+ (let ((buffers (buffer-list))
+ following)
+ (while (and (not following) buffers)
+ (setq following (buffer-local-value 'follow-mode (car buffers))
+ buffers (cdr buffers)))
+ (unless following
+ (remove-hook 'post-command-hook 'follow-post-command-hook)
+ (remove-hook 'window-size-change-functions 'follow-window-size-change)))
+ (remove-hook 'compilation-filter-hook 'follow-align-compilation-windows t)))
(defun follow-find-file-hook ()
"Find-file hook for Follow mode. See the variable `follow-auto'."
- (if follow-auto (follow-mode t)))
-
-;;}}}
+ (if follow-auto (follow-mode 1)))
-;;{{{ User functions
+;;; User functions
-;;;
-;;; User functions usable when in Follow mode.
-;;;
-
-;;{{{ Scroll
+;;; Scroll
;; `scroll-up' and `-down', but for windows in Follow mode.
;;
Works like `scroll-up' when not in Follow mode."
(interactive "P")
- (cond ((not (and (boundp 'follow-mode) follow-mode))
+ (cond ((not follow-mode)
(scroll-up arg))
(arg
(save-excursion (scroll-up arg))
Works like `scroll-up' when not in Follow mode."
(interactive "P")
- (cond ((not (and (boundp 'follow-mode) follow-mode))
+ (cond ((not follow-mode)
(scroll-up arg))
(arg
(save-excursion (scroll-down arg)))
(vertical-motion (- next-screen-context-lines 1))
(setq follow-internal-force-redisplay t))))))
-;;}}}
-;;{{{ Buffer
+(declare-function comint-adjust-point "comint" (window))
+(defvar comint-scroll-show-maximum-output)
+
+(defun follow-comint-scroll-to-bottom (&optional window)
+ "Scroll the bottom-most window in the current Follow chain.
+This is to be called by `comint-postoutput-scroll-to-bottom'."
+ (let* ((buffer (current-buffer))
+ (selected (selected-window))
+ (is-selected (eq (window-buffer) buffer))
+ some-window)
+ (when (or is-selected
+ (setq some-window (get-buffer-window)))
+ (let* ((pos (progn (comint-adjust-point nil) (point)))
+ (win (if is-selected
+ selected
+ (car (last (follow-all-followers some-window))))))
+ (select-window win)
+ (goto-char pos)
+ (setq follow-windows-start-end-cache nil)
+ (follow-adjust-window win pos)
+ (unless is-selected
+ (select-window selected)
+ (set-buffer buffer))))))
+
+(defun follow-align-compilation-windows ()
+ "Align the windows of the current Follow mode buffer.
+This is to be called from `compilation-filter-hook'."
+ (let ((buffer (current-buffer))
+ (win (get-buffer-window))
+ (selected (selected-window)))
+ (when (and follow-mode (waiting-for-user-input-p) win)
+ (let ((windows (follow-all-followers win)))
+ (unless (eq (window-buffer selected) buffer)
+ (setq win (car windows))
+ (select-window win))
+ (follow-redisplay windows win t)
+ (setq follow-windows-start-end-cache nil)
+ (unless (eq selected win)
+ (select-window selected)
+ (set-buffer buffer))))))
+
+;;; Buffer
;;;###autoload
(defun follow-delete-other-windows-and-split (&optional arg)
If ARG is positive, the leftmost window is selected. If negative,
the rightmost is selected. If ARG is nil, the leftmost window is
-selected if the original window is the first one in the frame.
-
-To bind this command to a hotkey, place the following line
-in your `~/.emacs' file, replacing [f7] by your favorite key:
- (global-set-key [f7] 'follow-delete-other-windows-and-split)"
+selected if the original window is the first one in the frame."
(interactive "P")
(let ((other (or (and (null arg)
(not (eq (selected-window)
(current-buffer))))
(or buffer (setq buffer (current-buffer)))
(let ((orig-window (selected-window)))
- (walk-windows
- (function
- (lambda (win)
- (select-window win)
- (switch-to-buffer buffer))))
+ (walk-windows (lambda (win)
+ (select-window win)
+ (switch-to-buffer buffer))
+ 'no-minibuf)
(select-window orig-window)
(follow-redisplay)))
(defun follow-switch-to-current-buffer-all ()
- "Show current buffer in all windows on this frame, and enter Follow mode.
-
-To bind this command to a hotkey place the following line
-in your `~/.emacs' file:
- (global-set-key [f7] 'follow-switch-to-current-buffer-all)"
+ "Show current buffer in all windows on this frame, and enter Follow mode."
(interactive)
- (or (and (boundp 'follow-mode) follow-mode)
- (follow-mode 1))
+ (unless follow-mode
+ (follow-mode 1))
(follow-switch-to-buffer-all))
-;;}}}
-;;{{{ Movement
+;;; Movement
;; Note, these functions are not very useful, at least not unless you
;; rebind the rather cumbersome key sequence `C-c . p'.
(interactive)
(select-window (car (reverse (follow-all-followers)))))
-;;}}}
-;;{{{ Redraw
+;;; Redraw
(defun follow-recenter (&optional arg)
"Recenter the middle window around point.
(win (nth (/ (- (length windows) 1) 2) windows)))
(select-window win)
(goto-char dest)
- (recenter)
- ;;(setq follow-internal-force-redisplay t)
- )))
+ (recenter))))
(defun follow-redraw ()
(sit-for 0)
(follow-redisplay))
-;;}}}
-;;{{{ End of buffer
+;;; End of buffer
(defun follow-end-of-buffer (&optional arg)
"Move point to the end of the buffer, Follow mode style.
(with-no-warnings
(end-of-buffer arg))))
-;;}}}
-
-;;}}}
-
-;;{{{ Display
-
-;;;; The display routines
-
-;;{{{ Information gathering functions
-
-(defun follow-all-followers (&optional testwin)
- "Return all windows displaying the same buffer as the TESTWIN.
-The list contains only windows displayed in the same frame as TESTWIN.
-If TESTWIN is nil the selected window is used."
- (or (window-live-p testwin)
- (setq testwin (selected-window)))
- (let* ((top (frame-first-window (window-frame testwin)))
- (win top)
- (done nil)
- (windows '())
- (buffer (window-buffer testwin)))
- (while (and (not done) win)
- (if (eq (window-buffer win) buffer)
- (setq windows (cons win windows)))
- (setq win (next-window win 'not))
- (if (eq win top)
- (setq done t)))
- (nreverse windows)))
-
+;;; Display
+
+(defun follow--window-sorter (w1 w2)
+ "Sorting function for W1 and W2 based on their positions.
+Return non-nil if W1 is above W2; if their top-lines
+are at the same position, return non-nil if W1 is to the
+left of W2."
+ (let* ((edge-1 (window-pixel-edges w1))
+ (edge-2 (window-pixel-edges w2))
+ (y1 (nth 1 edge-1))
+ (y2 (nth 1 edge-2)))
+ (if (= y1 y2)
+ (< (car edge-1) (car edge-2))
+ (< y1 y2))))
+
+(defun follow-all-followers (&optional win)
+ "Return all windows displaying the same buffer as the WIN.
+The list is sorted with topmost and leftmost windows first, and
+contains only windows in the same frame as WIN. If WIN is nil,
+it defaults to the selected window."
+ (unless (window-live-p win)
+ (setq win (selected-window)))
+ (let ((buffer (window-buffer win))
+ windows)
+ (dolist (w (window-list (window-frame win) 'no-minibuf win))
+ (if (eq (window-buffer w) buffer)
+ (push w windows)))
+ (sort windows 'follow--window-sorter)))
(defun follow-split-followers (windows &optional win)
- "Split the WINDOWS into the sets: predecessors and successors.
+ "Split WINDOWS into two sets: predecessors and successors.
Return `(PRED . SUCC)' where `PRED' and `SUCC' are ordered starting
from the selected window."
(or win
(setq windows (cdr windows)))
(cons pred (cdr windows))))
-
-;; This function is optimized function for speed!
-
(defun follow-calc-win-end (&optional win)
- "Calculate the presumed window end for WIN.
-
-Actually, the position returned is the start of the next
-window, normally is the end plus one.
-
-If WIN is nil, the selected window is used.
-
-Returns (end-pos end-of-buffer-p)"
- (if (featurep 'xemacs)
- ;; XEmacs can calculate the end of the window by using
- ;; the 'guarantee options. GOOD!
- (let ((end (window-end win t)))
- (if (= end (point-max (window-buffer win)))
- (list end t)
- (list (+ end 1) nil)))
- ;; Emacs: We have to calculate the end by ourselves.
- ;; This code works on both XEmacs and Emacs, but now
- ;; that XEmacs has got custom-written code, this could
- ;; be optimized for Emacs.
- (let (height buffer-end-p)
- (with-selected-window (or win (selected-window))
- (save-excursion
- (goto-char (window-start))
- (setq height
- (- (window-height)
- (if header-line-format 2 1)))
- (setq buffer-end-p
- (if (bolp)
- (not (= height (vertical-motion height)))
- (save-restriction
- ;; Fix a mis-feature in `vertical-motion':
- ;; The start of the window is assumed to
- ;; coincide with the start of a line.
- (narrow-to-region (point) (point-max))
- (not (= height (vertical-motion height))))))
- (list (point) buffer-end-p))))))
-
-
-;; Can't use `save-window-excursion' since it triggers a redraw.
-(defun follow-calc-win-start (windows pos win)
- "Calculate where WIN will start if the first in WINDOWS start at POS.
+ "Calculate the end position for window WIN.
+Return (END-POS END-OF-BUFFER).
+
+Actually, the position returned is the start of the line after
+the last fully-visible line in WIN. If WIN is nil, the selected
+window is used."
+ (let* ((win (or win (selected-window)))
+ (edges (window-inside-pixel-edges win))
+ (ht (- (nth 3 edges) (nth 1 edges)))
+ (last-line-pos (posn-point (posn-at-x-y 0 (1- ht) win))))
+ (if (pos-visible-in-window-p last-line-pos win)
+ (let ((end (window-end win t)))
+ (list end (= end (point-max))))
+ (list last-line-pos nil))))
-If WIN is nil the point below all windows is returned."
- (let (start)
- (while (and windows (not (eq (car windows) win)))
- (setq start (window-start (car windows)))
+(defun follow-calc-win-start (windows pos win)
+ "Determine the start of window WIN in a Follow mode window chain.
+WINDOWS is a list of chained windows, and POS is the starting
+position for the first window in the list. If WIN is nil, return
+the point below all windows."
+ (while (and windows (not (eq (car windows) win)))
+ (let ((old-start (window-start (car windows))))
+ ;; Can't use `save-window-excursion' since it triggers a redraw.
(set-window-start (car windows) pos 'noforce)
(setq pos (car (follow-calc-win-end (car windows))))
- (set-window-start (car windows) start 'noforce)
- (setq windows (cdr windows)))
- pos))
-
+ (set-window-start (car windows) old-start 'noforce)
+ (setq windows (cdr windows))))
+ pos)
;; The result from `follow-windows-start-end' is cached when using
;; a handful simple commands, like cursor movement commands.
(setq cache (cdr cache)))
(and res (null windows) (null cache))))
-
-(defsubst follow-invalidate-cache ()
- "Force `follow-windows-start-end' to recalculate the end of the window."
- (setq follow-windows-start-end-cache nil))
-
-
-;; Build a list of windows and their start and end positions.
-;; Useful to avoid calculating start/end position whenever they are needed.
-;; The list has the format:
-;; ((Win Start End End-of-buffer-visible-p) ...)
-
-;; Used to have a `save-window-excursion', but it obviously triggered
-;; redraws of the display. Check if I used it for anything.
-
-
(defun follow-windows-start-end (windows)
- "Builds a list of (WIN START END BUFFER-END-P) for every window in WINDOWS."
+ "Return a list of (WIN START END BUFFER-END-P) for window list WINDOWS."
(if (follow-cache-valid-p windows)
follow-windows-start-end-cache
(let ((orig-win (selected-window))
(select-window orig-win)
(setq follow-windows-start-end-cache (nreverse win-start-end)))))
-
(defsubst follow-pos-visible (pos win win-start-end)
"Non-nil when POS is visible in WIN."
(let ((wstart-wend-bend (cdr (assq win win-start-end))))
;; should start at a full screen line.
(defsubst follow-windows-aligned-p (win-start-end)
- "Non-nil if the follower windows are aligned."
- (let ((res t))
- (save-excursion
- (goto-char (window-start (caar win-start-end)))
- (unless (bolp)
- (vertical-motion 0 (caar win-start-end))
- (setq res (eq (point) (window-start (caar win-start-end))))))
- (while (and res (cdr win-start-end))
- ;; At least two followers left
- (setq res (eq (car (cdr (cdr (car win-start-end))))
- (car (cdr (car (cdr win-start-end))))))
+ "Non-nil if the follower windows are aligned.
+The argument, WIN-START-END, should be a list of the form
+returned by `follow-windows-start-end'."
+ (let ((result t))
+ (while (and win-start-end result)
+ (if (cdr win-start-end)
+ (setq result (eq (nth 2 (car win-start-end))
+ (nth 1 (cadr win-start-end)))))
(setq win-start-end (cdr win-start-end)))
- res))
-
+ result))
;; Check if the point is visible in all windows. (So that
;; no one will be recentered.)
(vertical-motion 1 win)
(set-window-start win (point) 'noforce)))))
-;;}}}
-;;{{{ Selection functions
-
-;; Make a window in WINDOWS selected if it currently
-;; is displaying the position DEST.
-;;
-;; We don't select a window if it just has been moved.
-
(defun follow-select-if-visible (dest win-start-end)
"Select and return a window, if DEST is visible in it.
Return the selected window."
- (let (win win-end)
+ (let (win win-end wse)
(while (and (not win) win-start-end)
;; Don't select a window that was just moved. This makes it
- ;; possible to later select the last window after a `end-of-buffer'
- ;; command.
- (when (follow-pos-visible dest (caar win-start-end) win-start-end)
- (setq win (caar win-start-end)
- win-end (car (cddr (car win-start-end))))
+ ;; possible to later select the last window after a
+ ;; `end-of-buffer' command.
+ (setq wse (car win-start-end))
+ (when (follow-pos-visible dest (car wse) win-start-end)
+ (setq win (car wse)
+ win-end (nth 2 wse))
(select-window win))
(setq win-start-end (cdr win-start-end)))
- ;; The last line of the window may be partially visible; if so,
- ;; and if point is visible in the next window, select the next
- ;; window instead.
- (and win
- (/= dest (point-max))
- win-start-end
- (follow-pos-visible dest (caar win-start-end) win-start-end)
- (save-excursion
- (goto-char dest)
- (vertical-motion 1 win)
- (>= (point) win-end))
- (setq win (caar win-start-end))
- (select-window win))
win))
-
;; Lets select a window showing the end. Make sure we only select it if
;; it wasn't just moved here. (I.e. M-> shall not unconditionally place
;; the point in the selected window.)
(set-window-start (car windows) (point) 'noforce)
(setq end-pos-end-p (follow-calc-win-end (car windows)))
(goto-char (car end-pos-end-p))
- ;; Visible, if dest above end, or if eob is visible inside
- ;; the window.
+ ;; Visible, if dest above end, or if eob is visible
+ ;; inside the window.
(if (or (car (cdr end-pos-end-p))
(< dest (point)))
(setq win (car windows))
(goto-char dest))
win))
-
-;;}}}
-;;{{{ Redisplay
+;;; Redisplay
;; Redraw all the windows on the screen, starting with the top window.
;; The window used as as marker is WIN, or the selected window if WIN
(set-window-start w start))
(setq start (car (follow-calc-win-end w))))))
-
(defun follow-estimate-first-window-start (windows win start)
"Estimate the position of the first window.
The estimate is computed by assuming that the window WIN, which
;; Find the starting point, start at GUESS and search upward. Return
;; a point on the same line as GUESS, or above.
-;;
-;; (Is this ever used? I must make sure it works just in case it is
-;; ever called.)
(defun follow-calculate-first-window-start-from-below
(windows guess &optional win start)
(setq res (point))))))
res)))
-;;}}}
-;;{{{ Avoid tail recenter
+;;; Avoid tail recenter
-;; This sets the window internal flag `force_start'. The effect is that
-;; windows only displaying the tail aren't recentered.
-;; Has to be called before every redisplay... (Great isn't it?)
-;;
-;; XEmacs doesn't recenter the tail, GOOD!
-;;
-;; A window displaying only the tail, is a window whose
-;; window-start position is equal to (point-max) of the buffer it
-;; displays.
-;;
-;; This function is also added to `post-command-idle-hook', introduced
-;; in Emacs 19.30. This is needed since the vaccine injected by the
-;; call from `post-command-hook' only works until the next redisplay.
-;; It is possible that the functions in the `post-command-idle-hook'
-;; can cause a redisplay, and hence a new vaccine is needed.
+;; This sets the window internal flag `force_start'. The effect is
+;; that windows only displaying the tail aren't recentered.
;;
-;; Sometimes, calling this function could actually cause a redisplay,
-;; especially if it is placed in the debug filter section. I must
-;; investigate this further...
+;; A window displaying only the tail, is a window whose window-start
+;; position is equal to (point-max) of the buffer it displays.
(defun follow-avoid-tail-recenter (&rest _rest)
"Make sure windows displaying the end of a buffer aren't recentered.
-
This is done by reading and rewriting the start position of
non-first windows in Follow mode."
- (if follow-avoid-tail-recenter-p
- (let* ((orig-buffer (current-buffer))
- (top (frame-first-window (selected-frame)))
- (win top)
- (who '()) ; list of (buffer . frame)
- start
- pair) ; (buffer . frame)
- ;; If the only window in the frame is a minibuffer
- ;; window, `next-window' will never find it again...
- (if (window-minibuffer-p top)
- nil
- (while ;; look, no body!
- (progn
- (setq start (window-start win))
- (set-buffer (window-buffer win))
- (setq pair (cons (window-buffer win) (window-frame win)))
- (if (member pair who)
- (if (and (boundp 'follow-mode) follow-mode
- (eq (point-max) start))
- ;; Write the same window start back, but don't
- ;; set the NOFORCE flag.
- (set-window-start win start))
- (setq who (cons pair who)))
- (setq win (next-window win 'not t))
- (not (eq win top)))) ;; Loop while this is true.
- (set-buffer orig-buffer)))))
-
-;;}}}
-
-;;}}}
-;;{{{ Post Command Hook
+ (let* ((orig-buffer (current-buffer))
+ (top (frame-first-window (selected-frame)))
+ (win top)
+ who) ; list of (buffer . frame)
+ ;; If the only window in the frame is a minibuffer
+ ;; window, `next-window' will never find it again...
+ (unless (window-minibuffer-p top)
+ (while ;; look, no body!
+ (let ((start (window-start win))
+ (pair (cons (window-buffer win) (window-frame win))))
+ (set-buffer (window-buffer win))
+ (cond ((null (member pair who))
+ (setq who (cons pair who)))
+ ((and follow-mode (eq (point-max) start))
+ ;; Write the same window start back, but don't
+ ;; set the NOFORCE flag.
+ (set-window-start win start)))
+ (setq win (next-window win 'not t))
+ (not (eq win top)))) ;; Loop while this is true.
+ (set-buffer orig-buffer))))
+
+;;; Post Command Hook
;; The magic little box. This function is called after every command.
(with-current-buffer (window-buffer win)
(unless (and (symbolp this-command)
(get this-command 'follow-mode-use-cache))
- (follow-invalidate-cache))
- (when (and follow-mode
- (not (window-minibuffer-p win)))
- ;; The buffer shown in the selected window is in follow
- ;; mode. Find the current state of the display.
- (let* ((windows (follow-all-followers win))
- (dest (point))
- (win-start-end (progn
- (follow-update-window-start (car windows))
- (follow-windows-start-end windows)))
- (aligned (follow-windows-aligned-p win-start-end))
- (visible (follow-pos-visible dest win win-start-end))
- selected-window-up-to-date)
- (unless (and aligned visible)
- (follow-invalidate-cache))
- (follow-avoid-tail-recenter)
- ;; Select a window to display point.
- (unless follow-internal-force-redisplay
- (if (eq dest (point-max))
- ;; At point-max, we have to be careful since the
- ;; display can be aligned while `dest' can be
- ;; visible in several windows.
- (cond
- ;; Select the current window, but only when the
- ;; display is correct. (When inserting characters
- ;; in a tail window, the display is not correct, as
- ;; they are shown twice.)
- ;;
- ;; Never stick to the current window after a
- ;; deletion. The reason is cosmetic: when typing
- ;; `DEL' in a window showing only the end of the
- ;; file, a character would be removed from the
- ;; window above, which is very unintuitive.
- ((and visible
- aligned
- (not (memq this-command
- '(backward-delete-char
- delete-backward-char
- backward-delete-char-untabify
- kill-region))))
- (follow-debug-message "Max: same"))
- ;; If the end is visible, and the window doesn't
- ;; seems like it just has been moved, select it.
- ((follow-select-if-end-visible win-start-end)
- (follow-debug-message "Max: end visible")
- (setq visible t aligned nil)
- (goto-char dest))
- ;; Just show the end...
- (t
- (follow-debug-message "Max: default")
- (select-window (car (reverse windows)))
- (goto-char dest)
- (setq visible nil aligned nil)))
-
- ;; We're not at the end, here life is much simpler.
- (cond
- ;; This is the normal case!
- ;; It should be optimized for speed.
- ((and visible aligned)
- (follow-debug-message "same"))
- ;; Pick a position in any window. If the display is
- ;; ok, this will pick the `correct' window.
- ((follow-select-if-visible dest win-start-end)
- (follow-debug-message "visible")
- (goto-char dest)
- ;; We have to perform redisplay, since scrolling is
- ;; needed in case the line is partially visible.
- (setq visible nil))
- ;; Not visible anywhere else, lets pick this one.
- ;; (Is this case used?)
- (visible
- (follow-debug-message "visible in selected."))
- ;; Far out!
- ((eq dest (point-min))
- (follow-debug-message "min")
- (select-window (car windows))
- (goto-char dest)
- (set-window-start (selected-window) (point-min))
- (setq win-start-end (follow-windows-start-end windows))
- (follow-invalidate-cache)
- (setq visible t aligned nil))
- ;; If we can position the cursor without moving the first
- ;; window, do it. This is the case that catches `RET'
- ;; at the bottom of a window.
- ((follow-select-if-visible-from-first dest windows)
- (follow-debug-message "Below first")
- (setq visible t aligned t))
- ;; None of the above. For simplicity, we stick to the
- ;; selected window.
- (t
- (follow-debug-message "None")
- (setq visible nil aligned nil))))
- ;; If a new window has been selected, make sure that the
- ;; old is not scrolled when the point is outside the
- ;; window.
- (unless (eq win (selected-window))
- (let ((p (window-point win)))
- (set-window-start win (window-start win) nil)
- (set-window-point win p))))
- (unless visible
- ;; If point may not be visible in the selected window,
- ;; perform a redisplay; this ensures scrolling.
- (redisplay)
- (setq selected-window-up-to-date t)
- (follow-avoid-tail-recenter)
- (setq win-start-end (follow-windows-start-end windows))
- (follow-invalidate-cache)
- (setq aligned nil))
- ;; Now redraw the windows around the selected window.
- (unless (and (not follow-internal-force-redisplay)
- (or aligned
- (follow-windows-aligned-p win-start-end))
- (follow-point-visible-all-windows-p
- win-start-end))
- (setq follow-internal-force-redisplay nil)
- (follow-redisplay windows (selected-window)
- selected-window-up-to-date)
- (setq win-start-end (follow-windows-start-end windows))
- (follow-invalidate-cache)
- ;; When the point ends up in another window. This
- ;; happens when dest is in the beginning of the file and
- ;; the selected window is not the first. It can also,
- ;; in rare situations happen when long lines are used
- ;; and there is a big difference between the width of
- ;; the windows. (When scrolling one line in a wide
- ;; window which will cause a move larger that an entire
- ;; small window.)
- (unless (follow-pos-visible dest win win-start-end)
- (follow-select-if-visible dest win-start-end)
- (goto-char dest)))
-
- ;; If the region is visible, make it look good when spanning
- ;; multiple windows.
- (when (region-active-p)
- (follow-maximize-region
- (selected-window) windows win-start-end))))
- ;; Whether or not the buffer was in follow mode, we must
- ;; update the windows displaying the tail so that Emacs won't
- ;; recenter them.
- (follow-avoid-tail-recenter)))))
-
-;;}}}
-;;{{{ The region
+ (setq follow-windows-start-end-cache nil)))
+ (follow-adjust-window win (point)))))
+
+(defun follow-adjust-window (win dest)
+ ;; Adjust the window WIN and its followers.
+ (with-current-buffer (window-buffer win)
+ (when (and follow-mode
+ (not (window-minibuffer-p win)))
+ (let* ((windows (follow-all-followers win))
+ (win-start-end (progn
+ (follow-update-window-start (car windows))
+ (follow-windows-start-end windows)))
+ (aligned (follow-windows-aligned-p win-start-end))
+ (visible (follow-pos-visible dest win win-start-end))
+ selected-window-up-to-date)
+ (unless (and aligned visible)
+ (setq follow-windows-start-end-cache nil))
+
+ ;; Select a window to display point.
+ (unless follow-internal-force-redisplay
+ (if (eq dest (point-max))
+ ;; Be careful at point-max: the display can be aligned
+ ;; while DEST can be visible in several windows.
+ (cond
+ ;; Select the current window, but only when the display
+ ;; is correct. (When inserting characters in a tail
+ ;; window, the display is not correct, as they are
+ ;; shown twice.)
+ ;;
+ ;; Never stick to the current window after a deletion.
+ ;; Otherwise, when typing `DEL' in a window showing
+ ;; only the end of the file, a character would be
+ ;; removed from the window above, which is very
+ ;; unintuitive.
+ ((and visible
+ aligned
+ (not (memq this-command
+ '(backward-delete-char
+ delete-backward-char
+ backward-delete-char-untabify
+ kill-region))))
+ (follow-debug-message "Max: same"))
+ ;; If the end is visible, and the window doesn't
+ ;; seems like it just has been moved, select it.
+ ((follow-select-if-end-visible win-start-end)
+ (follow-debug-message "Max: end visible")
+ (setq visible t aligned nil)
+ (goto-char dest))
+ ;; Just show the end...
+ (t
+ (follow-debug-message "Max: default")
+ (select-window (car (last windows)))
+ (goto-char dest)
+ (setq visible nil aligned nil)))
+
+ ;; We're not at the end, here life is much simpler.
+ (cond
+ ;; This is the normal case!
+ ;; It should be optimized for speed.
+ ((and visible aligned)
+ (follow-debug-message "same"))
+ ;; Pick a position in any window. If the display is ok,
+ ;; this picks the `correct' window.
+ ((follow-select-if-visible dest win-start-end)
+ (follow-debug-message "visible")
+ (goto-char dest)
+ ;; Perform redisplay, in case line is partially visible.
+ (setq visible nil))
+ ;; Not visible anywhere else, lets pick this one.
+ (visible
+ (follow-debug-message "visible in selected."))
+ ;; If DEST is before the first window start, select the
+ ;; first window.
+ ((< dest (nth 1 (car win-start-end)))
+ (follow-debug-message "before first")
+ (select-window (car windows))
+ (goto-char dest)
+ (setq visible nil aligned nil))
+ ;; If we can position the cursor without moving the first
+ ;; window, do it. This is the case that catches `RET' at
+ ;; the bottom of a window.
+ ((follow-select-if-visible-from-first dest windows)
+ (follow-debug-message "Below first")
+ (setq visible t aligned t))
+ ;; None of the above. Stick to the selected window.
+ (t
+ (follow-debug-message "None")
+ (setq visible nil aligned nil))))
+
+ ;; If a new window was selected, make sure that the old is
+ ;; not scrolled when the point is outside the window.
+ (unless (eq win (selected-window))
+ (let ((p (window-point win)))
+ (set-window-start win (window-start win) nil)
+ (set-window-point win p))))
+
+ (unless visible
+ ;; If point may not be visible in the selected window,
+ ;; perform a redisplay; this ensures scrolling.
+ (let ((opoint (point)))
+ (redisplay)
+ ;; If this `redisplay' moved point, we got clobbered by a
+ ;; previous call to `set-window-start'. Try again.
+ (when (/= (point) opoint)
+ (goto-char opoint)
+ (redisplay)))
+
+ (setq selected-window-up-to-date t)
+ (follow-avoid-tail-recenter)
+ (setq win-start-end (follow-windows-start-end windows)
+ follow-windows-start-end-cache nil
+ aligned nil))
+
+ ;; Now redraw the windows around the selected window.
+ (unless (and (not follow-internal-force-redisplay)
+ (or aligned
+ (follow-windows-aligned-p win-start-end))
+ (follow-point-visible-all-windows-p win-start-end))
+ (setq follow-internal-force-redisplay nil)
+ (follow-redisplay windows (selected-window)
+ selected-window-up-to-date)
+ (setq win-start-end (follow-windows-start-end windows)
+ follow-windows-start-end-cache nil)
+ ;; The point can ends up in another window when DEST is at
+ ;; the beginning of the buffer and the selected window is
+ ;; not the first. It can also happen when long lines are
+ ;; used and there is a big difference between the width of
+ ;; the windows. (When scrolling one line in a wide window
+ ;; which will cause a move larger that an entire small
+ ;; window.)
+ (unless (follow-pos-visible dest win win-start-end)
+ (follow-select-if-visible dest win-start-end)
+ (goto-char dest)))
+
+ ;; If the region is visible, make it look good when spanning
+ ;; multiple windows.
+ (when (region-active-p)
+ (follow-maximize-region
+ (selected-window) windows win-start-end)))
+
+ ;; Whether or not the buffer was in follow mode, update windows
+ ;; displaying the tail so that Emacs won't recenter them.
+ (follow-avoid-tail-recenter))))
+
+;;; The region
;; Tries to make the highlighted area representing the region look
;; good when spanning several windows.
(set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
(setq succ (cdr succ)))))
-;;}}}
-;;{{{ Scroll bar
+;;; Scroll bar
;;;; Scroll-bar support code.
-;; Why is it needed? Well, if the selected window is in follow mode,
-;; all its followers stick to it blindly. If one of them is scrolled,
-;; it immediately returns to the original position when the mouse is
-;; released. If the selected window is not a follower of the dragged
-;; window the windows will be unaligned.
-
-;; The advices don't get compiled. Aesthetically, this might be a
-;; problem but in practical life it isn't.
-
-;; Discussion: Now when the other windows in the chain follow the
-;; dragged, should we really select it?
-
-(cond ((fboundp 'scroll-bar-drag)
- ;;;
- ;;; Emacs style scrollbars.
- ;;;
-
- ;; Select the dragged window if it is a follower of the
- ;; selected window.
- ;;
- ;; Generate advices of the form:
- ;; (defadvice scroll-bar-drag (after follow-scroll-bar-drag activate)
- ;; "Adviced by `follow-mode'."
- ;; (follow-redraw-after-event (ad-get-arg 0)))
- (let ((cmds '(scroll-bar-drag
- scroll-bar-drag-1 ; Executed at every move.
- scroll-bar-scroll-down
- scroll-bar-scroll-up
- scroll-bar-set-window-start)))
- (while cmds
- (eval
- `(defadvice ,(intern (symbol-name (car cmds)))
- (after
- ,(intern (concat "follow-" (symbol-name (car cmds))))
- activate)
- "Adviced by Follow mode."
- (follow-redraw-after-event (ad-get-arg 0))))
- (setq cmds (cdr cmds))))
-
-
- (defun follow-redraw-after-event (event)
- "Adviced by Follow mode."
- (condition-case nil
- (let* ((orig-win (selected-window))
- (win (nth 0 (funcall
- (symbol-function 'event-start) event)))
- (fmode (assq 'follow-mode
- (buffer-local-variables
- (window-buffer win)))))
- (if (and fmode (cdr fmode))
- ;; The selected window is in follow-mode
- (progn
- ;; Recenter around the dragged window.
- (select-window win)
- (follow-redisplay)
- (select-window orig-win))))
- (error nil))))
-
-
- ((fboundp 'scrollbar-vertical-drag)
- ;;;
- ;;; XEmacs style scrollbars.
- ;;;
-
- ;; Advice all scrollbar functions on the form:
- ;;
- ;; (defadvice scrollbar-line-down
- ;; (after follow-scrollbar-line-down activate)
- ;; (follow-xemacs-scrollbar-support (ad-get-arg 0)))
-
- (let ((cmds '(scrollbar-line-down ; Window
- scrollbar-line-up
- scrollbar-page-down ; Object
- scrollbar-page-up
- scrollbar-to-bottom ; Window
- scrollbar-to-top
- scrollbar-vertical-drag ; Object
- )))
-
- (while cmds
- (eval
- `(defadvice ,(intern (symbol-name (car cmds)))
- (after
- ,(intern (concat "follow-" (symbol-name (car cmds))))
- activate)
- "Adviced by `follow-mode'."
- (follow-xemacs-scrollbar-support (ad-get-arg 0))))
- (setq cmds (cdr cmds))))
-
-
- (defun follow-xemacs-scrollbar-support (window)
- "Redraw windows showing the same buffer as shown in WINDOW.
-WINDOW is either the dragged window, or a cons containing the
-window as its first element. This is called while the user drags
-the scrollbar.
-
-WINDOW can be an object or a window."
- (condition-case nil
- (progn
- (if (consp window)
- (setq window (car window)))
- (let ((fmode (assq 'follow-mode
- (buffer-local-variables
- (window-buffer window))))
- (orig-win (selected-window)))
- (if (and fmode (cdr fmode))
- (progn
- ;; Recenter around the dragged window.
- (select-window window)
- (follow-redisplay)
- (select-window orig-win)))))
- (error nil)))))
-
-;;}}}
-;;{{{ Process output
-
-;; The following sections installs a spy that listens to process
-;; output and tries to reposition the windows whose buffers are in
-;; Follow mode. We play safe as much as possible...
-;;
-;; When follow-mode is activated all active processes are
-;; intercepted. All new processes that change their filter function
-;; using `set-process-filter' are also intercepted. The reason is
-;; that a process can cause a redisplay recentering "tail" windows.
-;; Note that it doesn't hurt to spy on more processes than needed.
-;;
-;; Technically, we set the process filter to `follow-generic-filter'.
-;; The original filter is stored in `follow-process-filter-alist'.
-;; Our generic filter calls the original filter, or inserts the
-;; output into the buffer, if the buffer originally didn't have an
-;; output filter. It also makes sure that the windows connected to
-;; the buffer are aligned.
-;;
-;; Discussion: How do we find processes that don't call
-;; `set-process-filter'? (How often are processes created in a
-;; buffer after Follow mode are activated?)
-;;
-;; Discussion: Should we also advice `process-filter' to make our
-;; filter invisible to others?
-
-;;{{{ Advice for `set-process-filter'
-
-;; Do not call this with 'follow-generic-filter as the name of the
-;; filter...
-
-(defadvice set-process-filter (before follow-set-process-filter activate)
- "Ensure process output will be displayed correctly in Follow mode buffers.
-
-Follow mode inserts its own process filter to do its
-magic stuff before the real process filter is called."
- (if follow-intercept-processes
- (progn
- (setq follow-process-filter-alist
- (delq (assq (ad-get-arg 0) follow-process-filter-alist)
- follow-process-filter-alist))
- (follow-tidy-process-filter-alist)
- (cond ((eq (ad-get-arg 1) t))
- ((eq (ad-get-arg 1) nil)
- (ad-set-arg 1 'follow-generic-filter))
- (t
- (setq follow-process-filter-alist
- (cons (cons (ad-get-arg 0) (ad-get-arg 1))
- follow-process-filter-alist))
- (ad-set-arg 1 'follow-generic-filter))))))
-
-
-(defun follow-call-set-process-filter (proc filter)
- "Call original `set-process-filter' without the Follow mode advice."
- (ad-disable-advice 'set-process-filter 'before
- 'follow-set-process-filter)
- (ad-activate 'set-process-filter)
- (prog1
- (set-process-filter proc filter)
- (ad-enable-advice 'set-process-filter 'before
- 'follow-set-process-filter)
- (ad-activate 'set-process-filter)))
-
-
-(defadvice process-filter (after follow-process-filter activate)
- "Return the original process filter, not `follow-generic-filter'."
- (cond ((eq ad-return-value 'follow-generic-filter)
- (setq ad-return-value
- (cdr-safe (assq (ad-get-arg 0)
- follow-process-filter-alist))))))
-
-
-(defun follow-call-process-filter (proc)
- "Call original `process-filter' without the Follow mode advice."
- (ad-disable-advice 'process-filter 'after
- 'follow-process-filter)
- (ad-activate 'process-filter)
- (prog1
- (process-filter proc)
- (ad-enable-advice 'process-filter 'after
- 'follow-process-filter)
- (ad-activate 'process-filter)))
-
-
-(defun follow-tidy-process-filter-alist ()
- "Remove old processes from `follow-process-filter-alist'."
- (let ((alist follow-process-filter-alist)
- (ps (process-list))
- (new ()))
- (while alist
- (if (and (not (memq (process-status (car (car alist)))
- '(exit signal closed nil)))
- (memq (car (car alist)) ps))
- (setq new (cons (car alist) new)))
- (setq alist (cdr alist)))
- (setq follow-process-filter-alist new)))
-
-;;}}}
-;;{{{ Start/stop interception of processes.
-
-;; Normally, all new processes are intercepted by our `set-process-filter'.
-;; This is needed to intercept old processes that were started before we were
-;; loaded, and processes we have forgotten by calling
-;; `follow-stop-intercept-process-output'.
-
-(defun follow-intercept-process-output ()
- "Intercept all active processes.
-
-This is needed so that Follow mode can track all display events in the
-system. (See `follow-mode'.)"
- (interactive)
- (let ((list (process-list)))
- (while list
- (if (eq (process-filter (car list)) 'follow-generic-filter)
- nil
- ;; The custom `set-process-filter' defined above.
- (set-process-filter (car list) (process-filter (car list))))
- (setq list (cdr list))))
- (setq follow-intercept-processes t))
-
-
-(defun follow-stop-intercept-process-output ()
- "Stop Follow mode from spying on processes.
-
-All current spypoints are removed and no new will be added.
-
-The effect is that Follow mode won't be able to handle buffers
-connected to processes.
-
-The only reason to call this function is if the Follow mode spy filter
-would interfere with some other package. If this happens, please
-report this using the `report-emacs-bug' function."
- (interactive)
- (follow-tidy-process-filter-alist)
- (dolist (process (process-list))
- (when (eq (follow-call-process-filter process) 'follow-generic-filter)
- (follow-call-set-process-filter
- process
- (cdr-safe (assq process follow-process-filter-alist)))
- (setq follow-process-filter-alist
- (delq (assq process follow-process-filter-alist)
- follow-process-filter-alist))))
- (setq follow-intercept-processes nil))
-
-;;}}}
-;;{{{ The filter
-
-;; The following section is a naive method to make buffers with
-;; process output to work with Follow mode. Whenever the start of the
-;; window displaying the buffer is moved, we move it back to its
-;; original position and try to select a new window. (If we fail,
-;; the normal redisplay functions of Emacs will scroll it right
-;; back!)
-
-(defun follow-generic-filter (proc output)
- "Process output filter for process connected to buffers in Follow mode."
- (let* ((old-buffer (current-buffer))
- (orig-win (selected-window))
- (buf (process-buffer proc))
- (win (and buf (if (eq buf (window-buffer orig-win))
- orig-win
- (get-buffer-window buf t))))
- (return-to-orig-win (and win (not (eq win orig-win))))
- (orig-window-start (and win (window-start win))))
-
- ;; If input is pending, the `sit-for' below won't redraw the
- ;; display. In that case, calling `follow-avoid-tail-recenter' may
- ;; provoke the process handling code to schedule a redisplay.
- ;(or (input-pending-p)
- ; (follow-avoid-tail-recenter))
-
- ;; Output the `output'.
- (let ((filter (cdr-safe (assq proc follow-process-filter-alist))))
- (cond
- ;; Call the original filter function
- (filter
- (funcall filter proc output))
-
- ;; No filter, but we've got a buffer. Just output into it.
- (buf
- (set-buffer buf)
- (if (not (marker-buffer (process-mark proc)))
- (set-marker (process-mark proc) (point-max)))
- (let ((moving (= (point) (process-mark proc)))
- deactivate-mark
- (inhibit-read-only t))
- (save-excursion
- (goto-char (process-mark proc))
- ;; `insert-before-markers' just in case the user's next
- ;; command is M-y.
- (insert-before-markers output)
- (set-marker (process-mark proc) (point)))
- (if moving (goto-char (process-mark proc)))))))
-
- ;; If we're in follow mode, do our stuff. Select a new window and
- ;; redisplay. (Actually, it is redundant to check `buf', but I
- ;; feel it's more correct.)
- (if (and buf (window-live-p win))
- (progn
- (set-buffer buf)
- (if (and (boundp 'follow-mode) follow-mode)
- (progn
- (select-window win)
- (let* ((windows (follow-all-followers win))
- (win-start-end (follow-windows-start-end windows))
- (new-window-start (window-start win))
- (new-window-point (window-point win)))
- (cond
- ;; The start of the selected window was repositioned.
- ;; Try to use the original start position and continue
- ;; working with a window to the "right" in the window
- ;; chain. This will create the effect that the output
- ;; starts in one window and continues into the next.
-
- ;; If the display has changed so much that it is not
- ;; possible to keep the original window fixed and still
- ;; display the point then we give up and use the new
- ;; window start.
-
- ;; This case is typically used when the process filter
- ;; tries to reposition the start of the window in order
- ;; to view the tail of the output.
- ((not (eq orig-window-start new-window-start))
- (follow-debug-message "filter: Moved")
- (set-window-start win orig-window-start)
- (follow-redisplay windows win)
- (setq win-start-end (follow-windows-start-end windows))
- (follow-select-if-visible new-window-point
- win-start-end)
- (goto-char new-window-point)
- (if (eq win (selected-window))
- (set-window-start win new-window-start))
- (setq win-start-end (follow-windows-start-end windows)))
- ;; Stick to this window, if point is visible in it.
- ((pos-visible-in-window-p new-window-point)
- (follow-debug-message "filter: Visible in window"))
- ;; Avoid redisplaying the first window. If the
- ;; point is visible at a window below,
- ;; redisplay and select it.
- ((follow-select-if-visible-from-first
- new-window-point windows)
- (follow-debug-message "filter: Seen from first")
- (setq win-start-end
- (follow-windows-start-end windows)))
- ;; None of the above. We stick to the current window.
- (t
- (follow-debug-message "filter: nothing")))
-
- ;; Here we have selected a window. Make sure the
- ;; windows are aligned and the point is visible
- ;; in the selected window.
- (if (and (not (follow-pos-visible
- (point) (selected-window) win-start-end))
- (not return-to-orig-win))
- (progn
- (sit-for 0)
- (setq win-start-end
- (follow-windows-start-end windows))))
-
- (if (or follow-internal-force-redisplay
- (not (follow-windows-aligned-p win-start-end)))
- (follow-redisplay windows)))))))
-
- ;; return to the original window.
- (if return-to-orig-win
- (select-window orig-win))
- ;; Restore the original buffer, unless the filter explicitly
- ;; changed buffer or killed the old buffer.
- (if (and (eq buf (current-buffer))
- (buffer-name old-buffer))
- (set-buffer old-buffer)))
-
- (follow-invalidate-cache)
-
- ;; Normally, if the display has been changed, it is redrawn. All
- ;; windows showing only the end of a buffer are unconditionally
- ;; recentered; we can't prevent that by calling
- ;; `follow-avoid-tail-recenter'.
- ;;
- ;; We force a redisplay here on our own, so Emacs does need to.
- ;; (However, redisplaying when there's input available just seems
- ;; to make things worse, so we exclude that case.)
- (if (and follow-avoid-tail-recenter-p
- (not (input-pending-p)))
- (sit-for 0)))
-
-;;}}}
-
-;;}}}
-;;{{{ Window size change
-
-;; In Emacs 19.29, the functions in `window-size-change-functions' are
-;; called every time a window in a frame changes size. Most notably, it
-;; is called after the frame has been resized.
-;;
-;; We basically call our post-command-hook for every buffer that is
-;; visible in any window in the resized frame, which is in follow-mode.
-;;
-;; Since this function can be called indirectly from
-;; `follow-post-command-hook' we have a potential infinite loop. We
-;; handle this problem by simply not doing anything at all in this
-;; situation. The variable `follow-inside-post-command-hook' contains
-;; information about whether the execution actually is inside the
+;; This handles the case where the user drags the scroll bar of a
+;; non-selected window whose buffer is in Follow mode.
+
+(defun follow-scroll-bar-toolkit-scroll (event)
+ (interactive "e")
+ (scroll-bar-toolkit-scroll event)
+ (follow-redraw-after-event event))
+
+(defun follow-scroll-bar-drag (event)
+ (interactive "e")
+ (scroll-bar-drag event)
+ (follow-redraw-after-event event))
+
+(defun follow-scroll-bar-scroll-up (event)
+ (interactive "e")
+ (scroll-bar-scroll-up event)
+ (follow-redraw-after-event event))
+
+(defun follow-scroll-bar-scroll-down (event)
+ (interactive "e")
+ (scroll-bar-scroll-down event)
+ (follow-redraw-after-event event))
+
+(defun follow-mwheel-scroll (event)
+ (interactive "e")
+ (mwheel-scroll event)
+ (follow-redraw-after-event event))
+
+(defun follow-redraw-after-event (event)
+ "Re-align the Follow mode windows affected by EVENT."
+ (let* ((window (nth 0 (event-end event)))
+ (buffer (window-buffer window))
+ (orig-win (selected-window)))
+ (when (and (buffer-local-value 'follow-mode buffer)
+ ;; Ignore the case where we scroll the selected window;
+ ;; that is handled by the post-command hook function.
+ (not (eq window (selected-window))))
+ (select-window window)
+ (follow-redisplay)
+ (unless (eq (window-buffer orig-win) buffer)
+ (select-window orig-win)))))
+
+;;; Window size change
+
+;; The functions in `window-size-change-functions' are called every
+;; time a window in a frame changes size, most notably after the frame
+;; has been resized. We call `follow-post-command-hook' for every
+;; Follow mode buffer visible in any window in the resized frame.
+;;
+;; Since `follow-window-size-change' can be called indirectly from
+;; `follow-post-command-hook' we have a potential infinite loop. To
+;; avoid this, we simply do not do anything in this situation. The
+;; variable `follow-inside-post-command-hook' contains information
+;; about whether the execution actually is inside the
;; post-command-hook or not.
-(if (boundp 'window-size-change-functions)
- (add-hook 'window-size-change-functions 'follow-window-size-change))
-
-
(defun follow-window-size-change (frame)
"Redraw all windows in FRAME, when in Follow mode."
- ;; Below, we call `post-command-hook'. This makes sure that we
- ;; don't start a mutually recursive endless loop.
- (if follow-inside-post-command-hook
- nil
+ ;; Below, we call `post-command-hook'. Avoid an infloop.
+ (unless follow-inside-post-command-hook
(let ((buffers '())
(orig-window (selected-window))
(orig-buffer (current-buffer))
(select-frame frame)
(unwind-protect
(walk-windows
- (function
- (lambda (win)
- (setq buf (window-buffer win))
- (if (memq buf buffers)
- nil
- (set-buffer buf)
- (if (and (boundp 'follow-mode)
- follow-mode)
- (progn
- (setq windows (follow-all-followers win))
- (if (memq orig-window windows)
- (progn
- ;; Make sure we're redrawing around the
- ;; selected window.
- ;;
- ;; We must be really careful not to do this
- ;; when we are (indirectly) called by
- ;; `post-command-hook'.
- (select-window orig-window)
- (follow-post-command-hook)
- (setq orig-window (selected-window)))
- (follow-redisplay windows win))
- (setq buffers (cons buf buffers))))))))
+ (lambda (win)
+ (setq buf (window-buffer win))
+ (unless (memq buf buffers)
+ (set-buffer buf)
+ (when follow-mode
+ (setq windows (follow-all-followers win))
+ (if (not (memq orig-window windows))
+ (follow-redisplay windows win)
+ ;; Make sure we're redrawing around the selected
+ ;; window.
+ (select-window orig-window)
+ (follow-post-command-hook)
+ (setq orig-window (selected-window)))
+ (setq buffers (cons buf buffers)))))
+ 'no-minibuf)
(select-frame orig-frame)
(set-buffer orig-buffer)
(select-window orig-window)))))
-;;}}}
-
-;;{{{ XEmacs isearch
-
-;; In XEmacs, isearch often finds matches in other windows than the
-;; currently selected. However, when exiting the old window
-;; configuration is restored, with the exception of the beginning of
-;; the start of the window for the selected window. This is not much
-;; help for us.
-;;
-;; We overwrite the stored window configuration with the current,
-;; unless we are in `slow-search-mode', i.e. only a few lines
-;; of text is visible.
-
-(if (featurep 'xemacs)
- (defadvice isearch-done (before follow-isearch-done activate)
- (if (and (boundp 'follow-mode)
- follow-mode
- (boundp 'isearch-window-configuration)
- isearch-window-configuration
- (boundp 'isearch-slow-terminal-mode)
- (not isearch-slow-terminal-mode))
- (let ((buf (current-buffer)))
- (setq isearch-window-configuration
- (current-window-configuration))
- (set-buffer buf)))))
-
-;;}}}
-;;{{{ Tail window handling
-
-;; In Emacs (not XEmacs) windows showing nothing are sometimes
-;; recentered. When in Follow mode, this is not desirable for
-;; non-first windows in the window chain. This section tries to
-;; make the windows stay where they should be.
-;;
-;; If the display is updated, all windows starting at (point-max) are
-;; going to be recentered at the next redisplay, unless we do a
-;; read-and-write cycle to update the `force' flag inside the windows.
-;;
-;; In 19.30, a new variable `window-scroll-functions' is called every
-;; time a window is recentered. It is not perfect for our situation,
-;; since when it is called for a tail window, it is to late. However,
-;; if it is called for another window, we can try to update our
-;; windows.
-;;
-;; By patching `sit-for' we can make sure that to catch all explicit
-;; updates initiated by lisp programs. Internal calls, on the other
-;; hand, are not handled.
-;;
-;; Please note that the function `follow-avoid-tail-recenter' is also
-;; called from other places, e.g. `post-command-hook' and
-;; `post-command-idle-hook'.
-
-;; If this function is called it is too late for this window, but
-;; we might save other windows from being recentered.
-
-(if (and follow-avoid-tail-recenter-p (boundp 'window-scroll-functions))
- (add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t))
-
-
-;; This prevents all packages that calls `sit-for' directly
-;; to recenter tail windows.
-
-(if follow-avoid-tail-recenter-p
- (defadvice sit-for (before follow-sit-for activate)
- "Adviced by Follow mode.
+(add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t)
-Avoid to recenter windows displaying only the end of a file as when
-displaying a short file in two windows, using Follow mode."
- (follow-avoid-tail-recenter)))
-
-
-;; Without this advice, `mouse-drag-region' would start to recenter
-;; tail windows.
-
-(if (and follow-avoid-tail-recenter-p
- (fboundp 'move-overlay))
- (defadvice move-overlay (before follow-move-overlay activate)
- "Adviced by Follow mode.
-Don't recenter windows showing only the end of a buffer.
-This prevents `mouse-drag-region' from messing things up."
- (follow-avoid-tail-recenter)))
-
-;;}}}
-;;{{{ profile support
+;;; Profile support
;; The following (non-evaluated) section can be used to
;; profile this package using `elp'.
;;
;; Invalid indentation on purpose!
-(cond (nil
-(setq elp-function-list
- '(window-end
- vertical-motion
- ; sit-for ;; elp can't handle advices...
- follow-mode
- follow-all-followers
- follow-split-followers
- follow-redisplay
- follow-estimate-first-window-start
- follow-calculate-first-window-start-from-above
- follow-calculate-first-window-start-from-below
- follow-calc-win-end
- follow-calc-win-start
- follow-pos-visible
- follow-windows-start-end
- follow-cache-valid-p
- follow-select-if-visible
- follow-select-if-visible-from-first
- follow-windows-aligned-p
- follow-point-visible-all-windows-p
- follow-avoid-tail-recenter
- follow-update-window-start
- follow-post-command-hook
- ))))
-
-;;}}}
-
-;;{{{ The end
-
-(defun follow-unload-function ()
- "Unload Follow mode library."
- (easy-menu-remove-item nil '("Tools") "Follow")
- (follow-stop-intercept-process-output)
- (dolist (group '((before
- ;; XEmacs
- isearch-done
- ;; both
- set-process-filter sit-for move-overlay)
- (after
- ;; Emacs
- scroll-bar-drag scroll-bar-drag-1 scroll-bar-scroll-down
- scroll-bar-scroll-up scroll-bar-set-window-start
- ;; XEmacs
- scrollbar-line-down scrollbar-line-up scrollbar-page-down
- scrollbar-page-up scrollbar-to-bottom scrollbar-to-top
- scrollbar-vertical-drag
- ;; both
- process-filter)))
- (let ((class (car group)))
- (dolist (fun (cdr group))
- (when (functionp fun)
- (condition-case nil
- (progn
- (ad-remove-advice fun class
- (intern (concat "follow-" (symbol-name fun))))
- (ad-update fun))
- (error nil))))))
- ;; continue standard processing
- nil)
-
-;;
-;; We're done!
-;;
+;; (setq elp-function-list
+;; '(window-end
+;; vertical-motion
+;; follow-mode
+;; follow-all-followers
+;; follow-split-followers
+;; follow-redisplay
+;; follow-estimate-first-window-start
+;; follow-calculate-first-window-start-from-above
+;; follow-calculate-first-window-start-from-below
+;; follow-calc-win-end
+;; follow-calc-win-start
+;; follow-pos-visible
+;; follow-windows-start-end
+;; follow-cache-valid-p
+;; follow-select-if-visible
+;; follow-select-if-visible-from-first
+;; follow-windows-aligned-p
+;; follow-point-visible-all-windows-p
+;; follow-avoid-tail-recenter
+;; follow-update-window-start
+;; follow-post-command-hook))
(provide 'follow)
-;;}}}
-
;; /------------------------------------------------------------------------\
;; | "I [..] am rarely happier then when spending an entire day programming |
;; | my computer to perform automatically a task that it would otherwise |
;; When this minor mode is on, the faces of the current line are updated with
;; every insertion or deletion.
;;
-;; To turn Font Lock mode on automatically, add this to your ~/.emacs file:
+;; To turn Font Lock mode on automatically, add this to your init file:
;;
;; (add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock)
;;
;; fontified automagically. In your ~/.emacs there could be:
;;
;; (defvar foo-font-lock-keywords
-;; '(("\\<\\(one\\|two\\|three\\)\\>" . font-lock-keyword-face)
-;; ("\\<\\(four\\|five\\|six\\)\\>" . font-lock-type-face))
+;; '(("\\<\\(one\\|two\\|three\\)\\>" . 'font-lock-keyword-face)
+;; ("\\<\\(four\\|five\\|six\\)\\>" . 'font-lock-type-face))
;; "Default expressions to highlight in Foo mode.")
;;
;; (add-hook 'foo-mode-hook
;; could be:
;;
;; (defvar bar-font-lock-keywords
-;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . font-lock-keyword-face)
-;; ("\\<\\(quattro\\|cinque\\|sei\\)\\>" . font-lock-type-face))
+;; '(("\\<\\(uno\\|due\\|tre\\)\\>" . 'font-lock-keyword-face)
+;; ("\\<\\(quattro\\|cinque\\|sei\\)\\>" . 'font-lock-type-face))
;; "Default expressions to highlight in Bar mode.")
;;
;; and within `bar-mode' there could be:
;;; Code:
(require 'syntax)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; Define core `font-lock' group.
(defgroup font-lock '((jit-lock custom-group))
(defvar font-lock-preprocessor-face 'font-lock-preprocessor-face
"Face name to use for preprocessor directives.")
-(defvar font-lock-reference-face 'font-lock-constant-face)
-(make-obsolete-variable 'font-lock-reference-face 'font-lock-constant-face "20.3")
+(define-obsolete-variable-alias
+ 'font-lock-reference-face 'font-lock-constant-face "20.3")
;; Fontification variables:
`font-lock-remove-keywords'.")
(defvar font-lock-keywords-only nil
- "*Non-nil means Font Lock should not fontify comments or strings.
+ "Non-nil means Font Lock should not fontify comments or strings.
This is normally set via `font-lock-defaults'.")
(defvar font-lock-keywords-case-fold-search nil
- "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.
+ "Non-nil means the patterns in `font-lock-keywords' are case-insensitive.
This is set via the function `font-lock-set-defaults', based on
the CASE-FOLD argument of `font-lock-defaults'.")
(make-variable-buffer-local 'font-lock-keywords-case-fold-search)
This is normally set via `font-lock-defaults'.")
(defvar font-lock-beginning-of-syntax-function nil
- "*Non-nil means use this function to move back outside all constructs.
+ "Non-nil means use this function to move back outside all constructs.
When called with no args it should move point backward to a place which
is not in a string or comment and not within any bracket-pairs (or else,
a place such that any bracket-pairs outside it can be ignored for Emacs
'syntax-begin-function "23.3" 'set)
(defvar font-lock-mark-block-function nil
- "*Non-nil means use this function to mark a block of text.
+ "Non-nil means use this function to mark a block of text.
When called with no args it should leave point at the beginning of any
enclosing textual block and mark at the end.
This is normally set via `font-lock-defaults'.")
;; Font Lock mode.
(eval-when-compile
- ;;
- ;; We don't do this at the top-level as we only use non-autoloaded macros.
- (require 'cl)
;;
;; Borrowed from lazy-lock.el.
;; We use this to preserve or protect things when modifying text properties.
For example:
(font-lock-add-keywords 'c-mode
- '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
- (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face)))
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend)
+ (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . 'font-lock-keyword-face)))
adds two fontification patterns for C mode, to fontify `FIXME:' words, even in
comments, and to fontify `and', `or' and `not' words as keywords.
(add-hook 'c-mode-hook
(lambda ()
(font-lock-add-keywords nil
- '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend)
(\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" .
- font-lock-keyword-face)))))
+ 'font-lock-keyword-face)))))
The above procedure may fail to add keywords to derived modes if
some involved major mode does not follow the standard conventions.
(declare-function lazy-lock-mode "lazy-lock")
(defun font-lock-turn-on-thing-lock ()
- (case (font-lock-value-in-major-mode font-lock-support-mode)
- (fast-lock-mode (fast-lock-mode t))
- (lazy-lock-mode (lazy-lock-mode t))
- (jit-lock-mode
+ (pcase (font-lock-value-in-major-mode font-lock-support-mode)
+ (`fast-lock-mode (fast-lock-mode t))
+ (`lazy-lock-mode (lazy-lock-mode t))
+ (`jit-lock-mode
;; Prepare for jit-lock
(remove-hook 'after-change-functions
'font-lock-after-change-function t)
;; Fontify each item in `font-lock-keywords' from `start' to `end'.
(while keywords
(if loudly (message "Fontifying %s... (regexps..%s)" bufname
- (make-string (incf count) ?.)))
+ (make-string (cl-incf count) ?.)))
;;
;; Find an occurrence of `matcher' from `start' to `end'.
(setq keyword (car keywords) matcher (car keyword))
;; `custom-declare-face'.
(defface font-lock-comment-face
'((((class grayscale) (background light))
- (:foreground "DimGray" :weight bold :slant italic))
+ :foreground "DimGray" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "LightGray" :weight bold :slant italic))
+ :foreground "LightGray" :weight bold :slant italic)
(((class color) (min-colors 88) (background light))
- (:foreground "Firebrick"))
+ :foreground "Firebrick")
(((class color) (min-colors 88) (background dark))
- (:foreground "chocolate1"))
+ :foreground "chocolate1")
(((class color) (min-colors 16) (background light))
- (:foreground "red"))
+ :foreground "red")
(((class color) (min-colors 16) (background dark))
- (:foreground "red1"))
+ :foreground "red1")
(((class color) (min-colors 8) (background light))
- (:foreground "red"))
+ :foreground "red")
(((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))
- (t (:weight bold :slant italic)))
+ :foreground "yellow")
+ (t :weight bold :slant italic))
"Font Lock mode face used to highlight comments."
:group 'font-lock-faces)
:group 'font-lock-faces)
(defface font-lock-string-face
- '((((class grayscale) (background light)) (:foreground "DimGray" :slant italic))
- (((class grayscale) (background dark)) (:foreground "LightGray" :slant italic))
- (((class color) (min-colors 88) (background light)) (:foreground "VioletRed4"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSalmon"))
- (((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:slant italic)))
+ '((((class grayscale) (background light)) :foreground "DimGray" :slant italic)
+ (((class grayscale) (background dark)) :foreground "LightGray" :slant italic)
+ (((class color) (min-colors 88) (background light)) :foreground "VioletRed4")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSalmon")
+ (((class color) (min-colors 16) (background light)) :foreground "RosyBrown")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSalmon")
+ (((class color) (min-colors 8)) :foreground "green")
+ (t :slant italic))
"Font Lock mode face used to highlight strings."
:group 'font-lock-faces)
:group 'font-lock-faces)
(defface font-lock-keyword-face
- '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
- (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
- (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
- (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
- (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
- (t (:weight bold)))
+ '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "Purple")
+ (((class color) (min-colors 88) (background dark)) :foreground "Cyan1")
+ (((class color) (min-colors 16) (background light)) :foreground "Purple")
+ (((class color) (min-colors 16) (background dark)) :foreground "Cyan")
+ (((class color) (min-colors 8)) :foreground "cyan" :weight bold)
+ (t :weight bold))
"Font Lock mode face used to highlight keywords."
:group 'font-lock-faces)
(defface font-lock-builtin-face
- '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
- (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
- (((class color) (min-colors 88) (background light)) (:foreground "dark slate blue"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSteelBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
- (t (:weight bold)))
+ '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "dark slate blue")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSteelBlue")
+ (((class color) (min-colors 16) (background light)) :foreground "Orchid")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSteelBlue")
+ (((class color) (min-colors 8)) :foreground "blue" :weight bold)
+ (t :weight bold))
"Font Lock mode face used to highlight builtins."
:group 'font-lock-faces)
(defface font-lock-function-name-face
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
- (t (:inverse-video t :weight bold)))
+ '((((class color) (min-colors 88) (background light)) :foreground "Blue1")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 16) (background light)) :foreground "Blue")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 8)) :foreground "blue" :weight bold)
+ (t :inverse-video t :weight bold))
"Font Lock mode face used to highlight function names."
:group 'font-lock-faces)
(defface font-lock-variable-name-face
'((((class grayscale) (background light))
- (:foreground "Gray90" :weight bold :slant italic))
+ :foreground "Gray90" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "DimGray" :weight bold :slant italic))
- (((class color) (min-colors 88) (background light)) (:foreground "sienna"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
- (t (:weight bold :slant italic)))
+ :foreground "DimGray" :weight bold :slant italic)
+ (((class color) (min-colors 88) (background light)) :foreground "sienna")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightGoldenrod")
+ (((class color) (min-colors 16) (background light)) :foreground "DarkGoldenrod")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightGoldenrod")
+ (((class color) (min-colors 8)) :foreground "yellow" :weight light)
+ (t :weight bold :slant italic))
"Font Lock mode face used to highlight variable names."
:group 'font-lock-faces)
(defface font-lock-type-face
- '((((class grayscale) (background light)) (:foreground "Gray90" :weight bold))
- (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
- (((class color) (min-colors 88) (background light)) (:foreground "ForestGreen"))
- (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
- (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:weight bold :underline t)))
+ '((((class grayscale) (background light)) :foreground "Gray90" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen")
+ (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen")
+ (((class color) (min-colors 8)) :foreground "green")
+ (t :weight bold :underline t))
"Font Lock mode face used to highlight type and classes."
:group 'font-lock-faces)
(defface font-lock-constant-face
'((((class grayscale) (background light))
- (:foreground "LightGray" :weight bold :underline t))
+ :foreground "LightGray" :weight bold :underline t)
(((class grayscale) (background dark))
- (:foreground "Gray50" :weight bold :underline t))
- (((class color) (min-colors 88) (background light)) (:foreground "dark cyan"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 8)) (:foreground "magenta"))
- (t (:weight bold :underline t)))
+ :foreground "Gray50" :weight bold :underline t)
+ (((class color) (min-colors 88) (background light)) :foreground "dark cyan")
+ (((class color) (min-colors 88) (background dark)) :foreground "Aquamarine")
+ (((class color) (min-colors 16) (background light)) :foreground "CadetBlue")
+ (((class color) (min-colors 16) (background dark)) :foreground "Aquamarine")
+ (((class color) (min-colors 8)) :foreground "magenta")
+ (t :weight bold :underline t))
"Font Lock mode face used to highlight constants and labels."
:group 'font-lock-faces)
(,(concat
"(" (regexp-opt
'("cond" "if" "while" "while-no-input" "let" "let*" "letrec"
- "prog" "progn" "progv" "prog1" "prog2" "prog*"
- "inline" "lambda" "save-restriction" "save-excursion"
- "save-selected-window" "save-window-excursion"
- "save-match-data" "save-current-buffer"
+ "pcase" "pcase-let" "pcase-let*" "prog" "progn" "progv"
+ "prog1" "prog2" "prog*" "inline" "lambda"
+ "save-restriction" "save-excursion" "save-selected-window"
+ "save-window-excursion" "save-match-data" "save-current-buffer"
"combine-after-change-calls" "unwind-protect"
"condition-case" "condition-case-unless-debug"
"track-mouse" "eval-after-load" "eval-and-compile"
;;; Commentary:
-;; Visit a file using a form. See forms-d2.el for examples.
+;; Visit a file using a form. See etc/forms for examples.
;;
;; === Naming conventions
;;
;;(message "forms: proceeding setup...")
- ;; Since we aren't really implementing a minor mode, we hack the modeline
+ ;; Since we aren't really implementing a minor mode, we hack the mode line
;; directly to get the text " View " into forms-read-only form buffers. For
;; that reason, this variable must be buffer only.
(make-local-variable 'minor-mode-alist)
\f
;;; Debugging
-(defvar forms--debug nil
- "*Enables forms-mode debugging if not nil.")
+(defcustom forms--debug nil
+ "If non-nil, enable Forms mode debugging."
+ :type 'boolean
+ :group 'forms)
(defun forms--debug (&rest args)
"Internal debugging routine."
;;; Commentary:
;;; Code:
-(eval-when-compile (require 'cl))
-
(defvar frame-creation-function-alist
(list (cons nil
(if (fboundp 'tty-create-frame-with-faces)
;; existing frame. We need to explicitly include
;; default-frame-alist in the parameters of the screen we
;; create here, so that its new value, gleaned from the user's
- ;; .emacs file, will be applied to the existing screen.
+ ;; init file, will be applied to the existing screen.
(if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
(assq 'minibuffer window-system-frame-alist)
(assq 'minibuffer default-frame-alist)
(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
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)
;; (: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
(defun set-frame-name (name)
"Set the name of the selected frame to NAME.
When called interactively, prompt for the name of the frame.
-The frame name is displayed on the modeline if the terminal displays only
-one frame, otherwise the name is displayed on the frame's caption bar."
+On text terminals, the frame name is displayed on the mode line.
+On graphical displays, it is displayed on the frame's title bar."
(interactive "sFrame name: ")
(modify-frame-parameters (selected-frame)
(list (cons 'name name))))
(define-obsolete-variable-alias 'delete-frame-hook
'delete-frame-functions "22.1")
-\f
-;; Highlighting trailing whitespace.
-
-(make-variable-buffer-local 'show-trailing-whitespace)
-
-\f
-;; Scrolling
-
-(defgroup scrolling nil
- "Scrolling windows."
- :version "21.1"
- :group 'frames)
-
-(defvaralias 'automatic-hscrolling 'auto-hscroll-mode)
-
\f
;; Blinking cursor
(cancel-timer blink-cursor-timer)
(setq blink-cursor-timer nil)))
+(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
+
(define-minor-mode blink-cursor-mode
"Toggle cursor blinking (Blink Cursor mode).
With a prefix argument ARG, enable Blink Cursor mode if ARG is
blink-cursor-delay
'blink-cursor-start))))
-(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
-
\f
;;;; Key bindings
(define-key ctl-x-5-map "0" 'delete-frame)
(define-key ctl-x-5-map "o" 'other-frame)
+\f
+;; Misc.
+
+;; Only marked as obsolete in 24.3.
+(define-obsolete-variable-alias 'automatic-hscrolling
+ 'auto-hscroll-mode "22.1")
+
+(make-variable-buffer-local 'show-trailing-whitespace)
+
+;; Defined in dispnew.c.
+(make-obsolete-variable
+ 'window-system-version "it does not give useful information." "24.3")
+
(provide 'frame)
;;; frame.el ends here
;; Define the built-in fringe bitmaps and setup default mappings
(when (boundp 'fringe-bitmaps)
- (let ((bitmaps '(question-mark
+ (let ((bitmaps '(question-mark exclamation-mark
left-arrow right-arrow up-arrow down-arrow
left-curly-arrow right-curly-arrow
left-triangle right-triangle
(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)
(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)
("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
": ")
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
-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 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 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
(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
-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 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 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))
;;
;; INSTALLATION:
;;
-;; Add this line to your .emacs file:
+;; Add this line to your init file:
;;
;; (require 'generic-x)
;;
'("#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)"
1 font-lock-string-face)
'("#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
- (1 font-lock-reference-face)
+ (1 font-lock-constant-face)
(2 font-lock-variable-name-face nil t))
;; indirect string constants
'("\\(@[A-Za-z][A-Za-z0-9_]+\\)" 1 font-lock-builtin-face)
;; gotos
- '("[ \t]*\\(\\sw+:\\)" 1 font-lock-reference-face)
+ '("[ \t]*\\(\\sw+:\\)" 1 font-lock-constant-face)
'("\\<\\(goto\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-keyword-face)
- (2 font-lock-reference-face nil t))
+ (2 font-lock-constant-face nil t))
;; system variables
(generic-make-keywords-list
installshield-system-variables-list
-2012-07-10 Andreas Schwab <schwab@linux-m68k.org>
+2012-09-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-delete-temp-files): Never ask again
+ a user about whether to delete temp files if once a user answered as n.
+
+2012-09-17 Richard Stallman <rms@gnu.org>
+
+ * message.el (message-in-body-p): Don't set mark or modify buffer.
+
+ * mml.el (mml-attach-file): Doc fix.
+ (mml-attach-external, mml-attach-buffer, mml-attach-file):
+ Set mail-encode-mml when in Mail mode.
+ Simplify code to set HEAD and move back to HEAD.
+ (mml-insert-multipart, mml-insert-part):
+ Set mail-encode-mml when in Mail mode.
+
+2012-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-util.el (gnus-timer--function): New function.
+
+ * gnus-art.el (gnus-article-stop-animations): Use it.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix glitches caused by addition of psec to timers.
+ * gnus-art.el (gnus-article-stop-animations): Use timer--function
+ rather than raw access to timer vector.
+
+2012-09-11 Julien Danjou <julien@danjou.info>
+
+ * gnus-notifications.el (gnus-notifications): Check for nil values in
+ ignored addresses check.
+
+2012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * qp.el (quoted-printable-decode-region): Inline+CSE+strength-reduction.
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * gnus-util.el
+ (gnus-put-text-property-excluding-characters-with-faces): Restore.
+
+ * gnus-salt.el (gnus-tree-highlight-node):
+ * gnus-sum.el (gnus-summary-highlight-line):
+ * gnus-group.el (gnus-group-highlight-line): Revert use of add-face.
+
+2012-09-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el: Fix compilation error on XEmacs 21.4.
+
+2012-09-06 Juri Linkov <juri@jurta.org>
+
+ * gnus-group.el (gnus-read-ephemeral-gmane-group): Change the naming
+ scheme for buffer names to be more consistent with other group and
+ article buffer names in Gnus.
+
+2012-09-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el
+ (gnus-put-text-property-excluding-characters-with-faces): Remove.
+
+ * gnus-compat.el: Define compat function `add-face' from Wolfgang
+ Jenkner.
+
+ * gnus-group.el (gnus-group-highlight-line): Use combining faces.
+
+ * gnus-sum.el (gnus-summary-highlight-line): Ditto.
+
+ * gnus-salt.el (gnus-tree-highlight-node): Ditto.
+
+2012-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-score.el (gnus-score-decode-text-parts): Use #' for
+ mm-text-parts used in labels macro to make it work with XEmacs 21.5.
+
+ * gnus-util.el (gnus-string-prefix-p): New function, an alias to
+ string-prefix-p in Emacs >=23.2.
+
+ * nnmaildir.el (nnmaildir--ensure-suffix, nnmaildir--add-flag)
+ (nnmaildir--remove-flag, nnmaildir--scan): Use gnus-string-match-p
+ instead of string-match-p.
+ (nnmaildir--scan): Use gnus-string-prefix-p instead of string-prefix-p.
+
+2012-09-06 Kenichi Handa <handa@gnu.org>
+
+ * qp.el (quoted-printable-decode-region): Fix previous change; handle
+ lowercase a..f.
+
+2012-09-05 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * nnmaildir.el (nnmaildir--article-set-flags): Fix compilation error.
+
+2012-09-05 Martin Stjernholm <mast@lysator.liu.se>
+
+ * gnus-demon.el (gnus-demon-init): Fixed regression when IDLE is t and
+ TIME is set.
+
+2012-09-05 Juri Linkov <juri@jurta.org>
+
+ * gnus-group.el (gnus-read-ephemeral-bug-group): Allow opening more
+ than one group at a time (bug#11961).
+
+2012-09-05 Julien Danjou <julien@danjou.info>
+
+ * gnus-srvr.el (gnus-server-open-server): Don't message on failure:
+ this hide the real reason with a message giving absolutely no hint.
+
+2012-09-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-mark-article-read): Propagate the read mark
+ to the backend (bug#11804).
+
+ * message.el (message-insert-newsgroups): Don't insert newsgroup
+ duplicates (bug#12275).
+
+2012-09-05 John Wiegley <johnw@newartisans.com>
+
+ * gnus.el (gnus-expand-group-parameters): Allow regexp substitutions in
+ sieve rules.
+
+2012-09-05 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-score.el (gnus-score-decode-text-parts): Use #' for the local
+ function.
+
+ * gnus-logic.el (gnus-advanced-body): Allow scoring on decoded bodies.
+
+ * gnus-score.el (gnus-score-decode-text-parts): Ditto.
+
+2012-09-05 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * nnmaildir.el: Make nnmaildir understand and write maildir flags.
+ That is, rename files from "unique:2," to "unique:2,S" for "seen", etc.
+ This should make nnmaildir more usable with offlineimap.
+
+2012-09-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-notifications.el (gnus-notifications-notify): Use it.
+
+ * gnus-fun.el (gnus-funcall-no-warning): New function to silence
+ warnings on XEmacs.
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seeds for (random).
+ * gnus-sync.el (gnus-sync-lesync-setup):
+ * message.el (message-canlock-generate, message-unique-id):
+ Change (random t) to (random), now that the latter is more random.
+
+2012-08-31 Dave Abrahams <dave@boostpro.com>
+
+ * auth-source.el (auth-sources): Fix macos keychain access.
+
+ * gnus-int.el (gnus-request-head): When gnus-override-method is set,
+ allow the backend `request-head' function to determine the group
+ name on its own.
+ (gnus-request-expire-articles): Filter out negative article numbers
+ during expiry (Bug#11980).
+
+ * gnus-range.el (gnus-set-difference): Change gnus-set-difference from
+ O(N^2) to O(N). This makes warping into huge groups tolerable.
+
+ * gnus-registry.el (gnus-try-warping-via-registry): Don't act as though
+ you've found the article when you haven't.
+
+2012-08-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-notifications.el (gnus-notifications-action): Avoid CL-ism.
+
+2012-08-30 Julien Danjou <julien@danjou.info>
+
+ * gnus-notifications.el (gnus-notifications-notify): Use timeout from
+ `gnus-notifications-timeout'.
+ (gnus-notifications-timeout): Add.
+ (gnus-notifications-action): New function.
+ (gnus-notifications-notify): Add :action using
+ `gnus-notifications-action'.
+ (gnus-notifications-id-to-msg): New variable.
+ (gnus-notifications): Use `gnus-notifications-id-to-msg' to map
+ notifications id to messages.
+
+2012-08-30 Kenichi Handa <handa@gnu.org>
+
+ * qp.el (quoted-printable-decode-region): Decode multiple bytes at
+ once.
+
+2012-08-29 Julien Danjou <julien@danjou.info>
+
+ * gnus-notifications.el: New file.
+ (gnus-notifications-notify): New function.
+ (gnus-notifications): Use `gnus-notifications-notify'.
+
+2012-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-enter-digest-group): Decode content
+ transfer encoding first; bind gnus-newsgroup-charset to the charset
+ that the article specifies (Bug#12209).
+
+2012-08-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-cus.el (gnus-group-customize): Decode values posting-style holds.
+ (gnus-group-customize-done): Encode values posting-style holds.
+
+ * gnus-msg.el (gnus-summary-resend-message)
+ (gnus-configure-posting-styles): Decode values posting-style group
+ parameter holds.
+
+2012-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-resend-message): Honor posting-style for
+ `name' and `address' in Resent-From header.
+
+2012-08-14 Chong Yidong <cyd@gnu.org>
+
+ * gnus-art.el (article-display-face): Handle failure in
+ gnus-create-image (Bug#11802).
+
+2012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-groups):
+ Use defsetf.
+
+2012-08-10 Daiki Ueno <ueno@unixuser.org>
+
+ * auth-source.el: (auth-source-plstore-search)
+ (auth-source-secrets-search): Ignore :require and :type in search spec.
+
+2012-08-06 Julien Danjou <julien@danjou.info>
+
+ * gnus-demon.el (gnus-demon-add-handler, gnus-demon-remove-handler):
+ Remove autoload, already handled by gnus.el.
+
+2012-08-05 Julien Danjou <julien@danjou.info>
+
+ * gnus-demon.el (gnus-demon-add-handler, gnus-demon-remove-handler):
+ Add autoload.
+
+2012-07-31 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-valid-select-methods): Fix custom type.
+
+2012-07-29 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth-source.el (auth-sources, auth-source-backend-parse)
+ (auth-source-macos-keychain-search)
+ (auth-source-macos-keychain-search-items)
+ (auth-source-macos-keychain-result-append)
+ (auth-source-macos-keychain-create): Support Mac OS X Keychains in
+ auth-source.el through the /usr/bin/security utility.
+ (auth-sources): Fix syntax error.
+ (auth-source-macos-keychain-result-append): Fix variable name.
+ (auth-sources, auth-source-macos-keychain-result-append): More fixes.
+
+2012-07-27 Julien Danjou <julien@danjou.info>
+
+ * message.el (fboundp): Add a defalias on `mail-dont-reply-to' for
+ Emacs < 24.1
+
+2012-07-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-kill-address): Don't kill last newline.
+ (message-skip-to-next-address): Don't move to the next header.
+ (message-fill-field-address): Work properly.
+
+2012-07-25 Julien Danjou <julien@danjou.info>
+
+ * gnus-art.el (gnus-kill-sticky-article-buffers): Reintroduce.
+
+2012-07-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnimap.el (nnimap-get-responses): Don't remove, still used.
+
+2012-07-24 Julien Danjou <julien@danjou.info>
+
+ * mail-source.el (mail-source-movemail-and-remove): Remove, unused.
+
+ * nntp.el (nntp-send-nosy-authinfo, nntp-send-authinfo-from-file)
+ (nntp-async-timer-handler): Remove, unused.
+
+ * nnimap.el (nnimap-get-responses): Remove, unused.
+
+ * nnheader.el (mail-header-set-extra): Remove, unused.
+
+ * mm-view.el (mm-view-sound-file): Remove, unused.
+
+ * mm-url.el (mm-url-fetch-simple, mm-url-fetch-form)
+ (mm-url-encode-multipart-form-data): Remove, unused.
+
+ * message.el (message-remove-signature, message-make-host-name)
+ (message-fill-address): Remove, unused.
+
+ * gnus.el (gnus-writable-groups, gnus-group-guess-prefixed-name)
+ (gnus-group-guess-full-name, gnus-group-guess-prefixed-name): Remove,
+ unused.
+
+ * gnus-uu.el (gnus-uu-find-name-in-shar): Remove, unused.
+
+ * gnus-util.el (gnus-extract-address-component-name)
+ (gnus-extract-address-component-email, gnus-sortable-date)
+ (gnus-alist-to-hashtable, gnus-hashtable-to-alist)
+ (gnus-process-live-p): Remove, unused.
+
+ * gnus-topic.el (gnus-group-parent-topic): Remove, unused.
+
+ * gnus-sum.el (gnus-score-set-default, gnus-article-parent-p)
+ (gnus-article-read-p, gnus-uncompress-marks): Remove, unused.
+ (gnus-summary-set-current-mark): Remove obsolete, empty and unused
+ function.
+
+ * gnus-start.el (gnus-kill-newsgroup): Remove unused obsolete function.
+
+ * gnus-score.el (gnus-summary-score-crossposting)
+ (gnus-score-regexp-bad-p): Remove, unused.
+
+ * gnus-salt.el (gnus-tree-goto-article): Remove, unused.
+
+ * gnus-range.el (gnus-sublist-p): Remove, unused.
+
+ * gnus-msg.el (gnus-mail-parse-comma-list, gnus-put-message): Remove,
+ unused.
+
+ * gnus-kill.el (gnus-Newsgroup-kill-file): Remove, unused.
+
+ * gnus-int.el (gnus-list-active-group, gnus-request-group-articles)
+ (gnus-request-associate-buffer): Remove, unused.
+
+ * gnus-group.el (gnus-group-set-method-info)
+ (gnus-group-set-params-info): Remove, unused.
+
+ * gnus-fun.el (gnus-shell-command-to-string)
+ (gnus-shell-command-on-region): Remove, unused.
+
+ * gnus-cite.el (gnus-cited-line-p): Remove, unused.
+
+ * gnus-art.el (gnus-article-text-type-exists-p)
+ (article-translate-characters, gnus-article-hide-text-of-type)
+ (gnus-kill-sticky-article-buffers, gnus-article-maybe-highlight):
+ Remove, unused.
+
+2012-07-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnir.el ("nnir"): Revert last change, that's premature to merge from
+ Gnus master.
+
+2012-07-22 Andrew Cohen <cohen@bu.edu>
+
+ * nnir.el ("nnir"): Add 'virtual ability to nnir backend.
+
+2012-07-21 Julien Danjou <julien@danjou.info>
+
+ * message.el (message-dont-reply-to-names): Replace deprecated
+ `rmail-dont-reply-to-names' with `mail-dont-reply-to-names'.
+ (message-get-reply-headers): Ditto.
+
+2012-07-18 Julien Danjou <julien@danjou.info>
+
+ * sieve-mode.el (sieve-mode-map): Bind C-c C-c to
+ `sieve-upload-and-kill'.
+
+ * sieve.el (sieve-bury-buffer): Remove function.
+ (sieve-manage-mode-map): Map "q" to `kill-buffer'.
+ (sieve-upload-and-kill): New function, mapped to C-c C-c.
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
* shr.el (shr-expand-url): Handle URL starting with `//'.
-2012-06-10 Toke Høiland-Jørgensen <toke@toke.dk> (tiny change)
+2012-07-17 Toke Høiland-Jørgensen <toke@toke.dk> (tiny change)
+2012-07-13 Chong Yidong <cyd@gnu.org>
+
+ * smime.el (smime-certificate-info): Set buffer-read-only directly,
+ instead of calling toggle-read-only with a (bogus) argument.
+
+2012-07-09 Tassilo Horn <tassilo@member.fsf.org>
+
+ * gnus-sum.el (gnus-summary-limit-to-author): Use default value instead
+ of initial input when reading the author to restrict the summary to.
+
+2012-07-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-select-newsgroup): Don't assume that the group
+ buffer exists, which it doesn't if we haven't started Gnus.
+
+2012-07-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-shr):
+ Allow overriding charset by mm-charset-override-alist.
+
+2012-07-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-view-part):
+ Toggle subparts of multipart/alternative part.
+
+2012-07-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sync.el: Simply require json.
+
+ * registry.el: Simply require eieio and eieio-base.
+
+2012-06-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * tests/gnustest-nntp.el, tests/gnustest-registry.el, tests/: Remove.
+
+2012-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * shr.el (shr-render-buffer): New command.
+ (shr-visit-file): Use it.
+
+2012-06-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * tests/gnustest-nntp.el, tests/gnustest-registry.el:
+ Set no-byte-compile and no-update-autoloads.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el: Add coding cookie for a soft hyphen that mm-shr uses.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-read-summary-keys): Protect against the key
+ being bound to a lambda form.
+
+2012-06-26 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus-picon.el (gnus-picon-properties): New defcustom.
+ (gnus-picon-create-glyph): Use it.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el: Add a iso-8859-1 cookie to make stuff work under other
+ locales.
+
+ * mm-decode.el (mm-display-part): Dissect archives when hitting `RET'
+ on a handle.
+
+ * gnus-sum.el (gnus-summary-limit-to-author): Use the current From
+ address as the default.
+
+ * nnfolder.el (nnfolder-save-buffer): Delete old versions silently.
+ It makes no sense to query the user about internal files.
+
+ * gnus-spec.el: Remove all the byte-compilation stuff, since
+ benchmarking shows that it doesn't help when entering large summary
+ buffers.
+
+ * gnus-util.el (gnus-byte-code): Remove.
+
+ * gnus-spec.el (gnus-update-format-specifications): Remove outdated
+ grouplens stuff.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-msg-mail): Warn the user about Gnus not running
+ (bug#11514).
+
+2012-06-26 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk>
+
+ * message.el (message-buffers): Return all buffers derived from Message
+ to make `gnus-dired-attach' work with mu4e.
+
+2012-06-26 Daiki Ueno <ueno@unixuser.org>
+
+ * mm-decode.el (mm-inhibit-auto-detect-attachment): New variable.
+ (mm-dissect-singlepart): Don't guess the MIME type of
+ application/octet-stream parts if mm-inhibit-auto-detect-attachment is
+ set.
+ (mm-dissect-multipart): Bind mm-inhibit-auto-detect-attachment if the
+ toplevel MIME type is multipart/encrypted.
+
+2012-06-26 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus-agent.el (gnus-agent-save-active): Deal with the "groups" format.
+ In particular, add an optional argument and a docstring.
+
+ * gnus-start.el (gnus-groups-to-gnus-format): Use it.
+
+ * nntp.el (nntp-finish-retrieve-group-infos): Make `nntp-server-buffer'
+ current before calling `gnus-groups-to-gnus-format'.
+ Note that this was already the case for `gnus-active-to-gnus-format'.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * pop3.el (pop3-wait-for-messages): Fix retrieved data size calculation.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-dissect-buffer): Doc fix.
+
+ * gnus-sum.el (gnus-handle-ephemeral-exit):
+ Avoid creating the group buffer if it doesn't exist.
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): If no quit-config
+ is given, mark the group as ephemeral with the current window conf.
+
+ * gnus-sum.el (gnus-set-global-variables): Don't assume that the group
+ buffer exists, which it doesn't if we haven't started Gnus.
+ (gnus-summary-exit): Allow quitting when we don't have a group buffer.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-generate-mime):
+ Allow specifying what the top-level part type is.
+
+ * gnus-sum.el (gnus-auto-center-summary):
+ `scroll-margin' isn't defined on XEmacs.
+
+2012-06-26 Philipp Haselwarter <philipp.haselwarter@gmx.de> (tiny change)
+
+ * gnus-sum.el (gnus-auto-center-summary):
+ Set default to respect `scroll-margin'.
+
+2012-06-26 Elias Oltmanns <eo@nebensachen.de> (tiny change)
+
+ * gnus-cite.el (gnus-dissect-cited-text): A single line without
+ citation prefix within a block of cited text should be considered
+ part of that block *only* if it is a blank line.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * shr.el (shr-find-fill-point): Remove unused code; don't break a line
+ before kinsoku-bol characters nor within kinsoku-eol characters.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sync.el (gnus-topic-alist, gnus-group-topic)
+ (gnus-topic-create-topic, gnus-topic-enter-dribble):
+ Silence compiler.
+ (gnus-sync-read): Use mapc instead of mapcar.
+
+ * mm-archive.el: Require mm-decode for some macros.
+ (gnus-recursive-directory-files, mailcap-extension-to-mime):
+ Silence the byte compiler.
+ (mm-archive-decoders): New function that returns the value of
+ the mm-archive-decoders variable.
+
+ * mm-decode.el:
+ Don't require mm-archive; autoload mm-archive functions instead.
+ (mm-dissect-singlepart): Use the function mm-archive-decoders.
+
+ * nnmail.el (mail-send-and-exit): Silence the byte compiler.
+
+2012-06-26 Peter Munster <pmrb@free.fr>
+
+ * gnus-demon.el (gnus-demon-timers): Now a plist (function -> timer).
+ (gnus-demon-cancel): Ditto.
+ (gnus-demon-run-callback): When function cannot be called due to low
+ idleness, call it when idleness reaches the expected value, instead
+ of waiting another timer period.
+ (gnus-demon-init): Add `time' to arguments of call-back.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el: Register gnus-registry functions.
+
+ * gnus-registry.el (gnus-try-warping-via-registry):
+ Moved here and indent.
+
+ * gnus-int.el (gnus-warp-to-article):
+ Check whether the registry is enabled before warping.
+
+2012-06-26 Dave Abrahams <dave@boostpro.com>
+
+ * gnus-sum.el (gnus-summary-insert-subject): Record information
+ in the registry about each article retrieved.
+
+ * gnus-int.el (gnus-select-group-with-message-id): New function.
+ (gnus-try-warping-via-registry): Ditto.
+ (gnus-warp-to-article): Fall back on the registry.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-fetch-partial-articles): Minor doc string fixup.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-resend-message-insert-gcc): Assume that
+ gnus-gcc-self-resent-messages may be a group parameter.
+ (gnus-summary-resend-message):
+ Don't encode encoded words in header when Gcc'ing resent message.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-insert): Treat non-breaking space just like normal
+ space. This seems to produce more pleasing results.
+ (shr-insert):
+ Only insert a blank line if we're starting from an image.
+ (shr-tag-br):
+ Allow <br> to end lines or to make a single blank line.
+ (shr-ensure-paragraph): Consider lines with white space to be blank.
+
+2012-06-26 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * gnus-msg.el (gnus-inews-do-gcc): Add gnus-gcc-pre-body-encode-hook
+ and gnus-gcc-post-body-encode-hook.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-dissect-singlepart):
+ Guess what the type of application/octet-stream parts really is.
+
+ * gnus-sum.el (gnus-propagate-marks): Remove.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nntp.el (nntp-coding-system-for-read): Remove.
+ (nntp-coding-system-for-write): Ditto.
+ (nntp-open-connection): Just use `binary' directly.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * registry.el (registry-usage-test, registry-persistence-test):
+ Move to tests/gnustest-registry.el.
+ (registry-make-testable-db, registry-match-test)
+ (registry-instantiation-test): Move to tests/gnustest-registry.el.
+
+ * gnus-registry.el (gnus-registry-misc-test)
+ (gnus-registry-usage-test): Move to tests/gnustest-registry.el.
+
+ * tests/gnustest-registry.el:
+ New file with the registry and gnus-registry ERT tests.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-resend-message):
+ Make gnus-summary-resend-message-insert-gcc be last item in
+ message-header-setup-hook.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnfolder.el (nnfolder-marks-directory, nnfolder-marks-is-evil)
+ (nnfolder-marks, nnfolder-marks-file-suffix)
+ (nnfolder-marks-modtime): Remove.
+ (nnfolder-open-server): Don't use marks.
+ (nnfolder-request-delete-group): Ditto.
+ (nnfolder-request-rename-group): Ditto.
+ (nnfolder-request-set-mark, nnfolder-request-marks)
+ (nnfolder-group-marks-pathname, nnfolder-marks-changed-p)
+ (nnfolder-save-marks, nnfolder-open-marks): Remove.
+
+ * nnml.el (nnml-marks-is-evil, nnml-marks-file-name, nnml-marks)
+ (nnml-marks-modtime): Remove.
+ (nnml-request-delete-group): Don't use marks.
+ (nnml-request-rename-group): Ditto.
+ (nnml-request-set-mark, nnml-request-marks, nnml-marks-changed-p)
+ (nnml-save-marks, nnml-open-marks): Remove.
+
+ * nntp.el (nntp-marks-is-evil, nntp-marks-file-name, nntp-marks)
+ (nntp-marks-modtime, nntp-marks-directory, nntp-request-set-mark)
+ (nntp-request-marks, nntp-marks-directory, nntp-marks-changed-p)
+ (nntp-save-marks, nntp-open-marks, nntp-possibly-create-directory)
+ (nntp-server-to-method-cache): Remove.
+
+ * shr.el (shr-rescale-image): Fix wrong merge.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-remove-trailing-whitespace):
+ Really delete the padding on too-wide lines.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-archive.el (mm-archive-dissect-and-inline): New function.
+ (mm-archive-dissect-and-inline): Fix up the undisplayer.
+
+ * mm-decode.el (mm-display-external): Output the text from
+ the command in the buffer after the command finished.
+ This makes text-based commands behave better.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (smtpmail-smtp-user): Silence compiler warning.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-multi-smtp-send-mail): Also allow specifying
+ the SMTP user name.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-article-map): Fix typo.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-multi-smtp-send-mail): New function.
+ (message-multi-smtp-send-mail): Respect the X-Message-SMTP-Method
+ header to implement multi-SMTP functionality.
+
+ * gnus-agent.el (gnus-agent-send-mail-function): Removed.
+ (gnus-agentize): Don't set it.
+ (gnus-agent-send-mail): Don't use it.
+
+ * gnus-sum.el (gnus-summary-widget-backward):
+ New function and keystroke.
+
+ * shr.el (shr-put-image): Remove underlines from sliced images.
+ (shr-zoom-image): Compute the region to be replaced more correctly.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-gcc-self-resent-messages): New user option.
+ (gnus-summary-resend-message-insert-gcc): New function.
+ (gnus-summary-resend-message): Modify message-header-setup-hook and
+ message-sent-hook to make it work for Gcc.
+ (gnus-inews-do-gcc): Update the number of unread articles of groups
+ that messages are Gcc'd to.
+
+ * message.el (message-resend): Run message-sent-hook to do Gcc.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-registry.el (gnus-registry-fixup-registry):
+ Move the message to a higher level to silence compilation.
+
+ * gnus-art.el (gnus-shr-put-image): Take and pass on a `flags'
+ parameter to allow controlling the scaling.
+
+ * shr.el (shr-zoom-image): New command and keystroke.
+ (shr-put-image): Take a `size' flag to say how to scale the image.
+
+ * mm-archive.el (mm-dissect-archive): Use it to get all file names.
+ Use recursive deletion.
+ (mm-dissect-archive): Add support for zip files.
+
+ * gnus-util.el (gnus-recursive-directory-files): New function.
+
+ * mm-archive.el (mm-archive-list-files): Inline text and image parts.
+ (mm-archive-decoders): Add tgz support.
+
+ * mm-decode.el (mm-shr): Make sure that the HTML ends with a newline.
+ Otherwise inserting text into the Gnus buffer can look odd.
+
+ * gnus-art.el (gnus-mime-inline-part): Slight clean-up.
+
+ * mm-archive.el (mm-archive-decoders): Add support for tar.
+
+ * gnus.el (gnus-logo-color-alist): Change the colours for Ma Gnus.
+
+ * nnmail.el (nnmail-extra-headers): Add Cc to the default.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-dissect-singlepart): Check that the decoder exists.
+
+ * mm-archive.el: New file.
+
+ * mm-decode.el (mm-dissect-singlepart):
+ Use it to decode ms-tnef files.
+
+ * mm-util.el (mm-find-buffer-file-coding-system): Comment fix.
+
+ * message.el (message-goto-*): Make all the `message-goto-*' commands
+ push the mark before moving point. This makes it easier to go back
+ to where you came from after editing whatever you jumped to.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el (gnus-sync-newsrc-groups): Quote normally.
+ (gnus-sync-lesync-pre-save-group-entry): Remove invalid invlists.
+ (gnus-sync-lesync-normalize-group-entry): Ignore a few more keys.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: Move BBDB autoloads.
+ (spam-exists-in-BBDB-p):
+ New function to do the BBDB search directly in BBDB 2 and 3.
+ (spam-check-BBDB): Use it.
+ (spam-enter-ham-BBDB): Use it.
+
+2012-06-26 Peter Munster <pmrb@free.fr> (tiny change)
+
+ * gnus-group.el (gnus-group-get-new-news):
+ New parameter `one-level' for scanning exactly one level.
+
+ * gnus-start.el (gnus-get-unread-articles): Ditto.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: More commentary about setup.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: More commentary about `gnus-sync-read' issues.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: Improve docs about CouchDB admins.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el (gnus-sync-lesync-setup): Fix salt when user setup is
+ not needed. Provide xmlplistread list function to produce XML plist
+ output for non-Gnus LeSync clients.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: Add LeSync synchronization backend and logic to read
+ and save against it. Group subscriptions, read marks, other marks,
+ subscription levels, topic names, and topic offsets (the group's
+ position within the topic) are saved. This is an experimental
+ backend and may change significantly. Load json.el from
+ the gnus-fallback-lib if it's not available otherwise.
+ (gnus-sync-save): Don't use `apply-partially' because of XEmacs.
+
+2012-06-26 David Engster <dengste@eml.cc>
+
+ * tests/gnustest-nntp.el: New file for simple NNTP testing.
+
+2012-06-18 Nelson Ferreira <nelson.ferreira@ieee.org> (tiny change)
+
+ * gnus-win.el (gnus-configure-frame): Pass an arg to window-dedicated-p.
+
+2012-06-17 Toke Høiland-Jørgensen <toke@toke.dk> (tiny change)
* nnmaildir.el (nnmaildir-request-expire-articles): Ensure that `time'
is an integer to avoid later problems.
-2012-06-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+2012-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el: Add a iso-8859-1 cookie to make stuff work under other
locales.
-2012-05-21 Katsumi Yamaoka <yamaoka@jpl.org>
+2012-04-14 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus-agent.el (gnus-agent-retrieve-headers): Recalculate the range of
+ articles when fetch-old is non-nil (bug#11370).
+
+2012-06-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-get-new-news): Respect
+ `gnus-group-use-permanent-levels', as documented (bug#11638).
+
+2012-06-10 Dave Abrahams <dave@boostpro.com>
+
+ * gnus-int.el (gnus-warp-to-article): Limit registry warping to real
+ groups (bug#11641).
+
+2012-06-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-msg-mail): Warn the user about Gnus not running
+ (bug#11514).
+
+2012-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * nntp.el: Stop the `letf' madness.
+ (nntp--report-1): New var.
+ (nntp-report): Merge nntp-report-1 into it.
+ (nntp-with-open-group-function): Set nntp--report-1 instead of modifying
+ the nntp-report function.
+
+ * auth-source.el: Fix comment-style to follow the convention.
+
+2012-05-27 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-msg.el (gnus-msg-mail): Ensure that gnus-newsgroup-name is
a string so that Gcc works (bug#11514).
-2012-04-21 Andreas Schwab <schwab@linux-m68k.org>
+2012-05-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * legacy-gnus-agent.el (gnus-agent-unhook-expire-days):
+ * gnus-demon.el (gnus-demon-init): Don't bother with type-of.
+
+2012-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-win.el (gnus-configure-frame): Don't signal an error when
+ jumping to *Server* from a dedicated *Group* window.
+ (gnus-configure-frame): CSE.
+
+ * gnus-registry.el: Minor style cleanup.
+ (gnus-registry--set/remove-mark): New function, extracted from
+ gnus-registry-install-shortcuts.
+ (gnus-registry-install-shortcuts): Use it.
+
+2012-05-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnspool.el (news-path): Use eval-and-compile.
+
+2012-05-24 Glenn Morris <rgm@gnu.org>
+
+ * nnspool.el (news-directory, news-path, news-inews-program):
+ Move here from paths.el. Don't see a need for these to be autoloaded.
+
+ * gnus.el (gnus-default-nntp-server): Make it a defcustom.
+ Merge in doc from paths.el version. Don't see any need for this to be
+ autoloaded, or for the warning about users not setting it.
+
+2012-05-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor Y10k bug.
+ * nnweb.el (nnweb-google-parse-1): Don't assume years have 4 digits.
+
+2012-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * nnimap.el (nnimap-open-connection-1): Don't leave an "opening..."
+ message once it's actually open.
+
+2012-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * auth-source.el (auth-source--aput-1, auth-source--aput)
+ (auth-source--aget): New functions and macros.
+ Use them instead of aput/aget.
+
+2012-04-27 Andreas Schwab <schwab@linux-m68k.org>
* gnus.el (debbugs-gnu): Don't override existing autoload definition.
-2012-04-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+2012-04-26 Daiki Ueno <ueno@unixuser.org>
+
+ * plstore.el (plstore-called-interactively-p): New compat macro copied
+ from message.el.
+ (plstore-mode): Use it.
+
+2012-04-26 Daiki Ueno <ueno@unixuser.org>
+
+ * plstore.el: Revive the editing feature.
+ (plstore-mode): New mode to edit plstore file.
+ (plstore-mode-toggle-display, plstore-mode-original)
+ (plstore-mode-decoded): New command.
+ (plstore--encode, plstore--decode, plstore--write-contents-functions)
+ (plstore--insert-buffer, plstore--make): New function.
+ (plstore-open, plstore-save): Simplify by using them.
+
+2012-04-16 Glenn Morris <rgm@gnu.org>
+
+ * nndraft.el (nndraft-request-list): Fix declaration.
+
+2012-04-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-msg.el (gnus-inews-insert-gcc): Don't do the alist stuff when we
don't have a current group.
-2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
* gnus-msg.el (gnus-inews-insert-gcc): Protect against when we don't
have a group name.
* gnus-start.el (gnus-read-newsrc-el-file): Protect against broken
.newsrc.el files.
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-summary-cancel-article): See what From header we
+ would have gotten if we posted to the group, and use that to compare
+ against the message we want to cancel (bug#10808).
+
2012-03-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
* auth-source.el (auth-source-netrc-create): Quote tokens that contain
2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * dgnushack.el: Autoload sha1 on XEmacs.
-
* gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Take an optional
quit window configuration.
2010-11-29 Binjo <binjo.cn@gmail.com> (tiny change)
* nnimap.el (nnimap-open-connection-1): w32 open-network-stream doesn't
- seem to accept strings-with-numbers as port numbers,
+ seem to accept strings-with-numbers as port numbers.
2010-11-29 Andrew Cohen <cohen@andy.bu.edu>
2010-11-25 Julien Danjou <julien@danjou.info>
- * shr-color.el (shr-color->hexadecimal): Use color-rgb->hex
+ * shr-color.el (shr-color->hexadecimal): Use color-rgb->hex.
* color.el: Rename from color-lab.el
(color-rgb->hex): Add.
2004-05-20 Danny Siu <dsiu@adobe.com>
- * gnus-sum.el (gnus-summary-recenter): Summery buffer was not auto
- centered even when gnus-auto-center-summary is t
+ * gnus-sum.el (gnus-summary-recenter): Summary buffer was not auto
+ centered even when gnus-auto-center-summary is t.
2004-05-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.el (gnus-method-to-server): Move defsubst before first use.
- * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr
+ * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr.
* gnus-art.el (gnus-article-edit-mode): Define before first
reference.
* gnus-sum.el (gnus-select-newgroup): Replace inline code with
gnus-agent-possibly-alter-active.
- (gnus-adjust-marked-articles): Faster handling of simple lists
+ (gnus-adjust-marked-articles): Faster handling of simple lists.
2004-01-21 Jesper Harder <harder@ifa.au.dk>
See ChangeLog.2 for earlier changes.
- Copyright (C) 2004-2012 Free Software Foundation, Inc.
+ Copyright (C) 2004-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
1997-11-25 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * gnus-move.el (gnus-move-group-to-server): Protect agains
+ * gnus-move.el (gnus-move-group-to-server): Protect against
nil-ness.
1997-11-25 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el:
+ * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el:
* gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el:
* mml1991.el, nnultimate.el: Add `coding'.
(require 'password-cache)
(require 'mm-util)
(require 'gnus-util)
-(require 'assoc)
(eval-when-compile (require 'cl))
(require 'eieio)
(const :tag "30 Minutes" 1800)
(integer :tag "Seconds")))
-;;; The slots below correspond with the `auth-source-search' spec,
-;;; so a backend with :host set, for instance, would match only
-;;; searches for that host. Normally they are nil.
+;; The slots below correspond with the `auth-source-search' spec,
+;; so a backend with :host set, for instance, would match only
+;; searches for that host. Normally they are nil.
(defclass auth-source-backend ()
((type :initarg :type
:initform 'netrc
(repeat :tag "Names"
(string :tag "Name")))))
-;;; generate all the protocols in a format Customize can use
-;;; TODO: generate on the fly from auth-source-protocols
+;; Generate all the protocols in a format Customize can use.
+;; TODO: generate on the fly from auth-source-protocols
(defconst auth-source-protocols-customize
(mapcar (lambda (a)
(let ((p (car-safe a)))
(const :tag "Default Secrets API Collection" 'default)
(const :tag "Login Secrets API Collection" "secrets:Login")
(const :tag "Temp Secrets API Collection" "secrets:session")
+
+ (const :tag "Default internet Mac OS Keychain"
+ macos-keychain-internet)
+
+ (const :tag "Default generic Mac OS Keychain"
+ macos-keychain-generic)
+
(list :tag "Source definition"
(const :format "" :value :source)
(choice :tag "Authentication backend choice"
(const :tag "Default" 'default)
(const :tag "Login" "Login")
(const
- :tag "Temporary" "session"))))
+ :tag "Temporary" "session")))
+ (list
+ :tag "Mac OS internet Keychain"
+ (const :format ""
+ :value :macos-keychain-internet)
+ (choice :tag "Collection to use"
+ (string :tag "internet Keychain path")
+ (const :tag "default" 'default)))
+ (list
+ :tag "Mac OS generic Keychain"
+ (const :format ""
+ :value :macos-keychain-generic)
+ (choice :tag "Collection to use"
+ (string :tag "generic Keychain path")
+ (const :tag "default" 'default))))
(repeat :tag "Extra Parameters" :inline t
(choice :tag "Extra parameter"
(list
msg))
-;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
+;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
(defun auth-source-read-char-choice (prompt choices)
"Read one of CHOICES by `read-char-choice', or `read-char'.
`dropdown-list' support is disabled because it doesn't work reliably.
;; (auth-source-backend-parse "myfile.gpg")
;; (auth-source-backend-parse 'default)
;; (auth-source-backend-parse "secrets:Login")
+;; (auth-source-backend-parse 'macos-keychain-internet)
+;; (auth-source-backend-parse 'macos-keychain-generic)
+;; (auth-source-backend-parse "macos-keychain-internet:/path/here.keychain")
+;; (auth-source-backend-parse "macos-keychain-generic:/path/here.keychain")
(defun auth-source-backend-parse (entry)
"Creates an auth-source-backend from an ENTRY in `auth-sources'."
;; matching any user, host, and protocol
((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
(auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
+
+ ;; take 'macos-keychain-internet and recurse to get it as a Mac OS
+ ;; Keychain collection matching any user, host, and protocol
+ ((eq entry 'macos-keychain-internet)
+ (auth-source-backend-parse '(:source (:macos-keychain-internet default))))
+ ;; take 'macos-keychain-generic and recurse to get it as a Mac OS
+ ;; Keychain collection matching any user, host, and protocol
+ ((eq entry 'macos-keychain-generic)
+ (auth-source-backend-parse '(:source (:macos-keychain-generic default))))
+ ;; take macos-keychain-internet:XYZ and recurse to get it as MacOS
+ ;; Keychain "XYZ" matching any user, host, and protocol
+ ((and (stringp entry) (string-match "^macos-keychain-internet:\\(.+\\)"
+ entry))
+ (auth-source-backend-parse `(:source (:macos-keychain-internet
+ ,(match-string 1 entry)))))
+ ;; take macos-keychain-generic:XYZ and recurse to get it as MacOS
+ ;; Keychain "XYZ" matching any user, host, and protocol
+ ((and (stringp entry) (string-match "^macos-keychain-generic:\\(.+\\)"
+ entry))
+ (auth-source-backend-parse `(:source (:macos-keychain-generic
+ ,(match-string 1 entry)))))
+
;; take just a file name and recurse to get it as a netrc file
;; matching any user, host, and protocol
((stringp entry)
:search-function 'auth-source-netrc-search
:create-function 'auth-source-netrc-create)))
+ ;; the MacOS Keychain
+ ((and
+ (not (null (plist-get entry :source))) ; the source must not be nil
+ (listp (plist-get entry :source)) ; and it must be a list
+ (or
+ (plist-get (plist-get entry :source) :macos-keychain-generic)
+ (plist-get (plist-get entry :source) :macos-keychain-internet)))
+
+ (let* ((source-spec (plist-get entry :source))
+ (keychain-generic (plist-get source-spec :macos-keychain-generic))
+ (keychain-type (if keychain-generic
+ 'macos-keychain-generic
+ 'macos-keychain-internet))
+ (source (plist-get source-spec (if keychain-generic
+ :macos-keychain-generic
+ :macos-keychain-internet))))
+
+ (when (symbolp source)
+ (setq source (symbol-name source)))
+
+ (auth-source-backend
+ (format "Mac OS Keychain (%s)" source)
+ :source source
+ :type keychain-type
+ :search-function 'auth-source-macos-keychain-search
+ :create-function 'auth-source-macos-keychain-create)))
+
;; the Secrets API. We require the package, in order to have a
;; defined value for `secrets-enabled'.
((and
(let* ((bmatches (apply
(slot-value backend 'search-function)
:backend backend
+ :type (slot-value backend :type)
;; note we're overriding whatever the spec
;; has for :require, :create, and :delete
:require require
(setq matches (append matches bmatches))))))
matches))
-;;; (auth-source-search :max 1)
-;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
-;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
-;;; (auth-source-search :host "nonesuch" :type 'secrets)
+;; (auth-source-search :max 1)
+;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
+;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
+;; (auth-source-search :host "nonesuch" :type 'secrets)
(defun* auth-source-delete (&rest spec
&key delete
Returns t or nil for forgotten or not found."
(password-cache-remove (auth-source-format-cache-entry spec)))
-;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
+;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
-;;; (auth-source-remember '(:host "wedd") '(4 5 6))
-;;; (auth-source-remembered-p '(:host "wedd"))
-;;; (auth-source-remember '(:host "xedd") '(1 2 3))
-;;; (auth-source-remembered-p '(:host "xedd"))
-;;; (auth-source-remembered-p '(:host "zedd"))
-;;; (auth-source-recall '(:host "xedd"))
-;;; (auth-source-recall '(:host t))
-;;; (auth-source-forget+ :host t)
+;; (auth-source-remember '(:host "wedd") '(4 5 6))
+;; (auth-source-remembered-p '(:host "wedd"))
+;; (auth-source-remember '(:host "xedd") '(1 2 3))
+;; (auth-source-remembered-p '(:host "xedd"))
+;; (auth-source-remembered-p '(:host "zedd"))
+;; (auth-source-recall '(:host "xedd"))
+;; (auth-source-recall '(:host t))
+;; (auth-source-forget+ :host t)
(defun* auth-source-forget+ (&rest spec &allow-other-keys)
"Forget any cached data matching SPEC. Returns forgotten count.
(return 'no)))
'no))))
-;;; (auth-source-pick-first-password :host "z.lifelogs.com")
-;;; (auth-source-pick-first-password :port "imap")
+;; (auth-source-pick-first-password :host "z.lifelogs.com")
+;; (auth-source-pick-first-password :port "imap")
(defun auth-source-pick-first-password (&rest spec)
"Pick the first secret found from applying SPEC to `auth-source-search'."
(let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1))))
;;; Backend specific parsing: netrc/authinfo backend
-;;; (auth-source-netrc-parse "~/.authinfo.gpg")
+(defun auth-source--aput-1 (alist key val)
+ (let ((seen ())
+ (rest alist))
+ (while (and (consp rest) (not (equal key (caar rest))))
+ (push (pop rest) seen))
+ (cons (cons key val)
+ (if (null rest) alist
+ (nconc (nreverse seen)
+ (if (equal key (caar rest)) (cdr rest) rest))))))
+(defmacro auth-source--aput (var key val)
+ `(setq ,var (auth-source--aput-1 ,var ,key ,val)))
+
+(defun auth-source--aget (alist key)
+ (cdr (assoc key alist)))
+
+;; (auth-source-netrc-parse "~/.authinfo.gpg")
(defun* auth-source-netrc-parse (&rest
spec
&key file max host user port delete require
;; cache all netrc files (used to be just .gpg files)
;; Store the contents of the file heavily encrypted in memory.
;; (note for the irony-impaired: they are just obfuscated)
- (aput 'auth-source-netrc-cache file
- (list :mtime (nth 5 (file-attributes file))
- :secret (lexical-let ((v (mapcar '1+ (buffer-string))))
- (lambda () (apply 'string (mapcar '1- v)))))))
+ (auth-source--aput
+ auth-source-netrc-cache file
+ (list :mtime (nth 5 (file-attributes file))
+ :secret (lexical-let ((v (mapcar '1+ (buffer-string))))
+ (lambda () (apply 'string (mapcar '1- v)))))))
(goto-char (point-min))
;; Go through the file, line by line.
(while (and (not (eobp))
(auth-source-search-collection
host
(or
- (aget alist "machine")
- (aget alist "host")
+ (auth-source--aget alist "machine")
+ (auth-source--aget alist "host")
t))
(auth-source-search-collection
user
(or
- (aget alist "login")
- (aget alist "account")
- (aget alist "user")
+ (auth-source--aget alist "login")
+ (auth-source--aget alist "account")
+ (auth-source--aget alist "user")
t))
(auth-source-search-collection
port
(or
- (aget alist "port")
- (aget alist "protocol")
+ (auth-source--aget alist "port")
+ (auth-source--aget alist "protocol")
t))
(or
;; the required list of keys is nil, or
ret))
alist))
-;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
-;;; (funcall secret)
+;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
+;; (funcall secret)
(defun* auth-source-netrc-search (&rest
spec
(nth 0 v)
v))
-;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
-;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
+;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
+;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
(defun* auth-source-netrc-create (&rest spec
&key backend
;; just the value otherwise
(t (symbol-value br)))))
(when br-choice
- (aput 'valist br br-choice)))))
+ (auth-source--aput valist br br-choice)))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
collect (nth i spec))))
(dolist (k keys)
(when (equal (symbol-name k) name)
- (aput 'valist er (plist-get spec k))))))
+ (auth-source--aput valist er (plist-get spec k))))))
;; for each required element
(dolist (r required)
- (let* ((data (aget valist r))
+ (let* ((data (auth-source--aget valist r))
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
(intern (format ":%s" r) obarray))))
;; this is the default to be offered
- (given-default (aget auth-source-creation-defaults r))
+ (given-default (auth-source--aget
+ auth-source-creation-defaults r))
;; the default supplementals are simple:
;; for the user, try `given-default' and then (user-login-name);
;; otherwise take `given-default'
(cons 'user
(or
(auth-source-netrc-element-or-first
- (aget valist 'user))
+ (auth-source--aget valist 'user))
(plist-get artificial :user)
"[any user]"))
(cons 'host
(or
(auth-source-netrc-element-or-first
- (aget valist 'host))
+ (auth-source--aget valist 'host))
(plist-get artificial :host)
"[any host]"))
(cons 'port
(or
(auth-source-netrc-element-or-first
- (aget valist 'port))
+ (auth-source--aget valist 'port))
(plist-get artificial :port)
"[any port]"))))
- (prompt (or (aget auth-source-creation-prompts r)
+ (prompt (or (auth-source--aget auth-source-creation-prompts r)
(case r
(secret "%p password for %u@%h: ")
(user "%p user name for %h: ")
(format "Enter %s (%%u@%%h:%%p): " r)))
(prompt (auth-source-format-prompt
prompt
- `((?u ,(aget printable-defaults 'user))
- (?h ,(aget printable-defaults 'host))
- (?p ,(aget printable-defaults 'port))))))
+ `((?u ,(auth-source--aget printable-defaults 'user))
+ (?h ,(auth-source--aget printable-defaults 'host))
+ (?p ,(auth-source--aget printable-defaults 'port))))))
;; Store the data, prompting for the password if needed.
(setq data (or data
file)
(message "Saved new authentication information to %s" file)
nil))))
- (aput 'auth-source-netrc-cache key "ran"))))
+ (auth-source--aput auth-source-netrc-cache key "ran"))))
;;; Backend specific parsing: Secrets API backend
-;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
-;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
-;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
-;;; (let ((auth-sources '(default))) (auth-source-search))
-;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
-;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
+;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
+;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
+;; (let ((auth-sources '(default))) (auth-source-search :max 1))
+;; (let ((auth-sources '(default))) (auth-source-search))
+;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
+;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
(defun* auth-source-secrets-search (&rest
spec
(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)))
;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
(debug spec))
+;;; Backend specific parsing: Mac OS Keychain (using /usr/bin/security) backend
+
+;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search :max 1 :create t))
+;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search :max 1 :delete t))
+;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search :max 1))
+;; (let ((auth-sources '(macos-keychain-internet))) (auth-source-search))
+
+;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search :max 1 :create t))
+;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search :max 1 :delete t))
+;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search :max 1))
+;; (let ((auth-sources '(macos-keychain-generic))) (auth-source-search))
+
+;; (let ((auth-sources '("macos-keychain-internet:/Users/tzz/Library/Keychains/login.keychain"))) (auth-source-search :max 1))
+;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org"))
+
+(defun* auth-source-macos-keychain-search (&rest
+ spec
+ &key backend create delete label
+ type max host user port
+ &allow-other-keys)
+ "Search the MacOS Keychain; spec is like `auth-source'.
+
+All search keys must match exactly. If you need substring
+matching, do a wider search and narrow it down yourself.
+
+You'll get back all the properties of the token as a plist.
+
+The :type key is either 'macos-keychain-internet or
+'macos-keychain-generic.
+
+For the internet keychain type, the :label key searches the
+item's labels (\"-l LABEL\" passed to \"/usr/bin/security\").
+Similarly, :host maps to \"-s HOST\", :user maps to \"-a USER\",
+and :port maps to \"-P PORT\" or \"-r PROT\"
+(note PROT has to be a 4-character string).
+
+For the generic keychain type, the :label key searches the item's
+labels (\"-l LABEL\" passed to \"/usr/bin/security\").
+Similarly, :host maps to \"-c HOST\" (the \"creator\" keychain
+field), :user maps to \"-a USER\", and :port maps to \"-s PORT\".
+
+Here's an example that looks for the first item in the default
+generic MacOS Keychain:
+
+ \(let ((auth-sources '(macos-keychain-generic)))
+ (auth-source-search :max 1)
+
+Here's another that looks for the first item in the internet
+MacOS Keychain collection whose label is 'gnus':
+
+ \(let ((auth-sources '(macos-keychain-internet)))
+ (auth-source-search :max 1 :label \"gnus\")
+
+And this one looks for the first item in the internet keychain
+entries for git.gnus.org:
+
+ \(let ((auth-sources '(macos-keychain-internet\")))
+ (auth-source-search :max 1 :host \"git.gnus.org\"))
+"
+ ;; TODO
+ (assert (not create) nil
+ "The MacOS Keychain auth-source backend doesn't support creation yet")
+ ;; TODO
+ ;; (macos-keychain-delete-item coll elt)
+ (assert (not delete) nil
+ "The MacOS Keychain auth-source backend doesn't support deletion yet")
+
+ (let* ((coll (oref backend source))
+ (max (or max 5000)) ; sanity check: default to stop at 5K
+ (ignored-keys '(:create :delete :max :backend :label))
+ (search-keys (loop for i below (length spec) by 2
+ unless (memq (nth i spec) ignored-keys)
+ collect (nth i spec)))
+ ;; build a search spec without the ignored keys
+ ;; if a search key is nil or t (match anything), we skip it
+ (search-spec (apply 'append (mapcar
+ (lambda (k)
+ (if (or (null (plist-get spec k))
+ (eq t (plist-get spec k)))
+ nil
+ (list k (plist-get spec k))))
+ search-keys)))
+ ;; needed keys (always including host, login, port, and secret)
+ (returned-keys (mm-delete-duplicates (append
+ '(:host :login :port :secret)
+ search-keys)))
+ (items (apply 'auth-source-macos-keychain-search-items
+ coll
+ type
+ max
+ search-spec))
+
+ ;; ensure each item has each key in `returned-keys'
+ (items (mapcar (lambda (plist)
+ (append
+ (apply 'append
+ (mapcar (lambda (req)
+ (if (plist-get plist req)
+ nil
+ (list req nil)))
+ returned-keys))
+ plist))
+ items)))
+ items))
+
+(defun* auth-source-macos-keychain-search-items (coll type max
+ &rest spec
+ &key label type
+ host user port
+ &allow-other-keys)
+
+ (let* ((keychain-generic (eq type 'macos-keychain-generic))
+ (args `(,(if keychain-generic
+ "find-generic-password"
+ "find-internet-password")
+ "-g"))
+ (ret (list :type type)))
+ (when label
+ (setq args (append args (list "-l" label))))
+ (when host
+ (setq args (append args (list (if keychain-generic "-c" "-s") host))))
+ (when user
+ (setq args (append args (list "-a" user))))
+
+ (when port
+ (if keychain-generic
+ (setq args (append args (list "-s" port)))
+ (setq args (append args (list
+ (if (string-match "[0-9]+" port) "-P" "-r")
+ port)))))
+
+ (unless (equal coll "default")
+ (setq args (append args (list coll))))
+
+ (with-temp-buffer
+ (apply 'call-process "/usr/bin/security" nil t nil args)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (cond
+ ((looking-at "^password: \"\\(.+\\)\"$")
+ (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "secret"
+ (lexical-let ((v (match-string 1)))
+ (lambda () v))))
+ ;; TODO: check if this is really the label
+ ;; match 0x00000007 <blob>="AppleID"
+ ((looking-at "^[ ]+0x00000007 <blob>=\"\\(.+\\)\"")
+ (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "label"
+ (match-string 1)))
+ ;; match "crtr"<uint32>="aapl"
+ ;; match "svce"<blob>="AppleID"
+ ((looking-at "^[ ]+\"\\([a-z]+\\)\"[^=]+=\"\\(.+\\)\"")
+ (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ (match-string 1)
+ (match-string 2))))
+ (forward-line)))
+ ;; return `ret' iff it has the :secret key
+ (and (plist-get ret :secret) (list ret))))
+
+(defun auth-source-macos-keychain-result-append (result generic k v)
+ (push v result)
+ (setq k (cond
+ ((equal k "acct") "user")
+ ;; for generic keychains, creator is host, service is port
+ ((and generic (equal k "crtr")) "host")
+ ((and generic (equal k "svce")) "port")
+ ;; for internet keychains, protocol is port, server is host
+ ((and (not generic) (equal k "ptcl")) "port")
+ ((and (not generic) (equal k "srvr")) "host")
+ (t k)))
+
+ (push (intern (format ":%s" k)) result))
+
+(defun* auth-source-macos-keychain-create (&rest
+ spec
+ &key backend type max host user port
+ &allow-other-keys)
+ ;; TODO
+ (debug spec))
+
;;; Backend specific parsing: PLSTORE backend
(defun* auth-source-plstore-search (&rest
"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)))
;; just the value otherwise
(t (symbol-value br)))))
(when br-choice
- (aput 'valist br br-choice)))))
+ (auth-source--aput valist br br-choice)))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
collect (nth i spec))))
(dolist (k keys)
(when (equal (symbol-name k) name)
- (aput 'valist er (plist-get spec k))))))
+ (auth-source--aput valist er (plist-get spec k))))))
;; for each required element
(dolist (r required)
- (let* ((data (aget valist r))
+ (let* ((data (auth-source--aget valist r))
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
(intern (format ":%s" r) obarray))))
;; this is the default to be offered
- (given-default (aget auth-source-creation-defaults r))
+ (given-default (auth-source--aget
+ auth-source-creation-defaults r))
;; the default supplementals are simple:
;; for the user, try `given-default' and then (user-login-name);
;; otherwise take `given-default'
(cons 'user
(or
(auth-source-netrc-element-or-first
- (aget valist 'user))
+ (auth-source--aget valist 'user))
(plist-get artificial :user)
"[any user]"))
(cons 'host
(or
(auth-source-netrc-element-or-first
- (aget valist 'host))
+ (auth-source--aget valist 'host))
(plist-get artificial :host)
"[any host]"))
(cons 'port
(or
(auth-source-netrc-element-or-first
- (aget valist 'port))
+ (auth-source--aget valist 'port))
(plist-get artificial :port)
"[any port]"))))
- (prompt (or (aget auth-source-creation-prompts r)
+ (prompt (or (auth-source--aget auth-source-creation-prompts r)
(case r
(secret "%p password for %u@%h: ")
(user "%p user name for %h: ")
(format "Enter %s (%%u@%%h:%%p): " r)))
(prompt (auth-source-format-prompt
prompt
- `((?u ,(aget printable-defaults 'user))
- (?h ,(aget printable-defaults 'host))
- (?p ,(aget printable-defaults 'port))))))
+ `((?u ,(auth-source--aget printable-defaults 'user))
+ (?h ,(auth-source--aget printable-defaults 'host))
+ (?p ,(auth-source--aget printable-defaults 'port))))))
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
(or (eval default) (read-passwd prompt))
(if (stringp default)
- (read-string (if (string-match ": *\\'" prompt)
- (concat (substring prompt 0 (match-beginning 0))
- " (default " default "): ")
- (concat prompt "(default " default ") "))
- nil nil default)
+ (read-string
+ (if (string-match ": *\\'" prompt)
+ (concat (substring prompt 0 (match-beginning 0))
+ " (default " default "): ")
+ (concat prompt "(default " default ") "))
+ nil nil default)
(eval default)))))
(when data
;;; older API
-;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
+;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
;; deprecate the old interface
(make-obsolete 'auth-source-user-or-password
(defvar gnus-category-group-cache nil)
(defvar gnus-agent-spam-hashtb nil)
(defvar gnus-agent-file-name nil)
-(defvar gnus-agent-send-mail-function nil)
(defvar gnus-agent-file-coding-system 'raw-text)
(defvar gnus-agent-file-loading-cache nil)
(defvar gnus-agent-total-fetched-hashtb nil)
(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)))
-
- (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
- )))))
+ (list 'cdr (list 'assq '',prop-name category)))
+
+ (defsetf ,name (category) (value)
+ (list 'gnus-agent-cat-set-property
+ category '',prop-name value))))
)
(defmacro gnus-agent-cat-name (category)
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)
minor mode in all Gnus buffers."
(interactive)
(gnus-open-agent)
- (unless gnus-agent-send-mail-function
- (setq gnus-agent-send-mail-function
- (or message-send-mail-real-function
- (function (lambda () (funcall message-send-mail-function))))
- message-send-mail-real-function 'gnus-agent-send-mail))
+ (setq message-send-mail-real-function 'gnus-agent-send-mail)
;; If the servers file doesn't exist, auto-agentize some servers and
;; save the servers file so this auto-agentizing isn't invoked
(defun gnus-agent-send-mail ()
(if (or (not gnus-agent-queue-mail)
(and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
- (funcall gnus-agent-send-mail-function)
+ (message-multi-smtp-send-mail)
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "\n"))
(gnus-group-update-group group t)))
nil))
-(defun gnus-agent-save-active (method)
+(defun gnus-agent-save-active (method &optional groups-p)
+ "Sync the agent's active file with the current buffer.
+Pass non-nil for GROUPS-P if the buffer starts out in groups format.
+Regardless, both the file and the buffer end up in active format
+if METHOD is agentized; otherwise the function is a no-op."
(when (gnus-agent-method-p method)
(let* ((gnus-command-method method)
(new (gnus-make-hashtable (count-lines (point-min) (point-max))))
(file (gnus-agent-lib-file "active")))
- (gnus-active-to-gnus-format nil new)
+ (if groups-p
+ (gnus-groups-to-gnus-format nil new)
+ (gnus-active-to-gnus-format nil new))
(gnus-agent-write-active file new)
(erase-buffer)
(let ((nnheader-file-coding-system gnus-agent-file-coding-system))
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
+ (when fetch-old
+ (setq articles (gnus-uncompress-range
+ (cons (if (numberp fetch-old)
+ (max 1 (- (car articles) fetch-old))
+ 1)
+ (car (last articles))))))
+
;; Populate temp buffer with known headers
(when (file-exists-p file)
(with-current-buffer gnus-agent-overview-buffer
(set-buffer nntp-server-buffer)
(let* ((fetched-articles (list nil))
(tail-fetched-articles fetched-articles)
- (min (cond ((numberp fetch-old)
- (max 1 (- (car articles) fetch-old)))
- (fetch-old
- 1)
- (t
- (car articles))))
+ (min (car articles))
(max (car (last articles))))
;; Get the list of articles that were fetched
(not (numberp fetch-old)))
t ; Don't remove anything.
(nnheader-nov-delete-outside-range
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles))
+ (car articles)
(car (last articles)))
t)
(put-text-property (max (1- b) (point-min))
b 'intangible nil)))
-(defun gnus-article-hide-text-of-type (type)
- "Hide text of TYPE in the current buffer."
- (save-excursion
- (let ((b (point-min))
- (e (point-max)))
- (while (setq b (text-property-any b e 'article-type type))
- (add-text-properties b (incf b) gnus-hidden-properties)))))
-
(defun gnus-article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
(save-excursion
b (or (text-property-not-all b (point-max) 'invisible t)
(point-max)))))))
-(defun gnus-article-text-type-exists-p (type)
- "Say whether any text of type TYPE exists in the buffer."
- (text-property-any (point-min) (point-max) 'article-type type))
-
(defsubst gnus-article-header-rank ()
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
(let ((list gnus-sorted-header-list)
props)
(insert replace)))))))))
-(defun article-translate-characters (from to)
- "Translate all characters in the body of the article according to FROM and TO.
-FROM is a string of characters to translate from; to is a string of
-characters to translate to."
- (save-excursion
- (when (article-goto-body)
- (let ((inhibit-read-only t)
- (x (make-string 225 ?x))
- (i -1))
- (while (< (incf i) (length x))
- (aset x i i))
- (setq i 0)
- (while (< i (length from))
- (aset x (aref from i) (aref to i))
- (incf i))
- (translate-region (point) (point-max) x)))))
-
(defun article-translate-strings (map)
"Translate all string in the body of the article according to MAP.
MAP is an alist where the elements are on the form (\"from\" \"to\")."
(unfoldable
(or (equal gnus-article-unfold-long-headers t)
(and (stringp gnus-article-unfold-long-headers)
- (string-match gnus-article-unfold-long-headers header)))))
+ (string-match gnus-article-unfold-long-headers
+ header)))))
(with-temp-buffer
(insert header)
(goto-char (point-min))
(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."
(or how (setq how gnus-article-browse-delete-temp))
(if (eq how 'ask)
(let ((files (length gnus-article-browse-html-temp-list)))
- (gnus-y-or-n-p
- (if (= files 1)
- "Delete the temporary HTML file? "
- (format "Delete all %s temporary HTML files? "
- files))))
+ (or (gnus-y-or-n-p
+ (if (= files 1)
+ "Delete the temporary HTML file? "
+ (format "Delete all %s temporary HTML files? "
+ files)))
+ (setq gnus-article-browse-html-temp-list nil)))
how)))
(dolist (file gnus-article-browse-html-temp-list)
(cond ((file-directory-p file)
(defun gnus-article-stop-animations ()
(dolist (timer (and (boundp 'timer-list)
timer-list))
- (when (eq (elt timer 5) 'image-animate-timeout)
+ (when (eq (gnus-timer--function timer) 'image-animate-timeout)
(cancel-timer timer))))
(defun gnus-stop-downloads ()
(dolist (buf (gnus-buffers))
(with-current-buffer buf
(when (eq major-mode 'gnus-sticky-article-mode)
- (if (not arg)
- (gnus-kill-buffer buf)
- (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
- (gnus-kill-buffer buf)))))))
+ (if (not arg)
+ (gnus-kill-buffer buf)
+ (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
+ (gnus-kill-buffer buf)))))))
;;;
;;; Gnus MIME viewing functions
(or (cdr (assq arg
gnus-summary-show-article-charset-alist))
(mm-read-coding-system "Charset: "))))
- (t
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))))
+ ((mm-handle-undisplayer handle)
+ (mm-remove-part handle)))
(forward-line 2)
(mm-display-inline handle)
(goto-char b)))))
(let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
(when (gnus-article-goto-part n)
(if (equal (car handle) "multipart/alternative")
- (gnus-article-press-button)
+ (progn
+ (beginning-of-line) ;; Make it toggle subparts
+ (gnus-article-press-button))
(when (eq (gnus-mm-display-part handle) 'internal)
(gnus-set-window-start)))))))
(not gnus-inhibit-hiding))
(gnus-article-hide-headers)))
-(declare-function shr-put-image "shr" (data alt))
+(declare-function shr-put-image "shr" (data alt &optional flags))
-(defun gnus-shr-put-image (data alt)
+(defun gnus-shr-put-image (data alt &optional flags)
"Put image DATA with a string ALT. Enable image to be deleted."
(let ((image (shr-put-image data (propertize (or alt "*")
- 'gnus-image-category 'shr))))
+ 'gnus-image-category 'shr)
+ flags)))
(when image
(gnus-add-image 'shr image))))
(ding)
(unless (member keys nosave-in-article)
(set-buffer gnus-article-current-summary))
- (when (get func 'disabled)
+ (when (and (symbolp func)
+ (get func 'disabled))
(error "Function %s disabled" func))
(call-interactively func)
(setq new-sum-point (point)))
(gnus-article-hide-citation-maybe arg force)
(gnus-article-hide-signature arg))
-(defun gnus-article-maybe-highlight ()
- "Do some article highlighting if article highlighting is requested."
- (when (gnus-visual-p 'article-highlight 'highlight)
- (gnus-article-highlight-some)))
-
(defun gnus-check-group-server ()
;; Make sure the connection to the server is alive.
(unless (gnus-server-opened
(if (and (equal (cdadr m) "")
(equal (cdar m) (cdaddr m))
(goto-char (caadr m))
+ (looking-at "[ \t]*$")
(forward-line 1)
(= (point) (caaddr m)))
(setcdr m (cdddr m))
(while vars
(make-local-variable (pop vars)))))
-(defun gnus-cited-line-p ()
- "Say whether the current line is a cited line."
- (save-excursion
- (beginning-of-line)
- (let ((found nil))
- (dolist (prefix (mapcar 'car gnus-cite-prefix-alist))
- (when (string= (buffer-substring (point) (+ (length prefix) (point)))
- prefix)
- (setq found t)))
- found)))
-
-
;; Highlighting of different citation levels in message-mode.
;; - message-cite-prefix will be overridden if this is enabled.
(delq elem tmp))
(setq tmp (cdr tmp))))
+ ;; Decode values posting-style holds.
+ (dolist (style (cdr (assq 'posting-style values)))
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8)))))
+
(setq gnus-custom-params
(apply 'widget-create 'group
:value values
(defun gnus-group-customize-done (&rest ignore)
"Apply changes and bury the buffer."
(interactive)
- (if gnus-custom-topic
- (gnus-topic-set-parameters gnus-custom-topic
- (widget-value gnus-custom-params))
- (gnus-group-edit-group-done 'params gnus-custom-group
- (widget-value gnus-custom-params))
- (gnus-group-edit-group-done 'method gnus-custom-group
- (widget-value gnus-custom-method)))
- (bury-buffer))
+ (let ((params (widget-value gnus-custom-params)))
+ ;; Encode values posting-style holds.
+ (dolist (style (cdr (assq 'posting-style params)))
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-encode-coding-string (cadr style) 'utf-8)))))
+ (if gnus-custom-topic
+ (gnus-topic-set-parameters gnus-custom-topic params)
+ (gnus-group-edit-group-done 'params gnus-custom-group params)
+ (gnus-group-edit-group-done 'method gnus-custom-group
+ (widget-value gnus-custom-method)))
+ (bury-buffer)))
;;; Score Customization:
;;; Internal variables.
(defvar gnus-demon-timers nil
- "List of idle timers which are running.")
+ "Plist of idle timers which are running.")
(defvar gnus-inhibit-demon nil
"If non-nil, no daemonic function will be run.")
(float-time (or (current-idle-time)
'(0 0 0)))))
-(defun gnus-demon-run-callback (func &optional idle)
- "Run FUNC if Emacs has been idle for longer than IDLE seconds."
+(defun gnus-demon-run-callback (func &optional idle time special)
+ "Run FUNC if Emacs has been idle for longer than IDLE seconds.
+If not, and a TIME is given, restart a new idle timer, so FUNC
+can be called at the next opportunity. Such a special idle run is
+marked with SPECIAL."
(unless gnus-inhibit-demon
- (when (or (not idle)
- (and (eq idle t) (> (gnus-demon-idle-since) 0))
- (<= idle (gnus-demon-idle-since)))
+ (block run-callback
+ (when (eq idle t)
+ (setq idle 0.001))
+ (cond (special
+ (setq gnus-demon-timers
+ (plist-put gnus-demon-timers func
+ (run-with-timer time time 'gnus-demon-run-callback
+ func idle time))))
+ ((and idle (> idle (gnus-demon-idle-since)))
+ (when time
+ (nnheader-cancel-timer (plist-get gnus-demon-timers func))
+ (setq gnus-demon-timers
+ (plist-put gnus-demon-timers func
+ (run-with-idle-timer idle nil
+ 'gnus-demon-run-callback
+ func idle time t))))
+ (return-from run-callback)))
(with-local-quit
- (ignore-errors
- (funcall func))))))
+ (ignore-errors
+ (funcall func))))))
(defun gnus-demon-init ()
"Initialize the Gnus daemon."
;; Set up the timer.
(let* ((func (nth 0 handler))
(time (nth 1 handler))
- (time-type (type-of time))
(idle (nth 2 handler))
;; Compute time according with timestep.
;; If t, replace by 1
(* (gnus-demon-time-to-step time) gnus-demon-timestep))
(t
(* time gnus-demon-timestep))))
- (idle (if (numberp idle)
- (* idle gnus-demon-timestep)
- idle))
+ (idle (cond ((numberp idle)
+ (* idle gnus-demon-timestep))
+ ((and (eq idle t) (numberp time))
+ time)
+ (t
+ idle)))
(timer
(cond
(run-with-idle-timer idle t 'gnus-demon-run-callback func))
;; (func number any)
;; Call every `time'
- ((eq time-type 'integer)
- (run-with-timer time time 'gnus-demon-run-callback func idle))
+ ((integerp time)
+ (run-with-timer time time 'gnus-demon-run-callback
+ func idle time))
;; (func string any)
- ((eq time-type 'string)
- (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback func idle)))))
+ ((stringp time)
+ (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback
+ func idle)))))
(when timer
- (add-to-list 'gnus-demon-timers timer)))))
+ (setq gnus-demon-timers (plist-put gnus-demon-timers func timer))))))
(defun gnus-demon-time-to-step (time)
"Find out how many steps to TIME, which is on the form \"17:43\"."
(defun gnus-demon-cancel ()
"Cancel any Gnus daemons."
(interactive)
- (dolist (timer gnus-demon-timers)
- (nnheader-cancel-timer timer))
+ (dotimes (i (/ (length gnus-demon-timers) 2))
+ (nnheader-cancel-timer (nth (1+ (* i 2)) gnus-demon-timers)))
(setq gnus-demon-timers nil))
(defun gnus-demon-add-disconnection ()
(call-process shell-file-name nil (list standard-output nil)
nil shell-command-switch command)))
-(defun gnus-shell-command-on-region (start end command)
- "A simplified `shell-command-on-region'.
-Output to the current buffer, replace text, and don't mingle error."
- (call-process-region start end shell-file-name t
- (list (current-buffer) nil)
- nil shell-command-switch command))
-
;;;###autoload
(defun gnus-random-x-face ()
"Return X-Face header data chosen randomly from `gnus-x-face-directory'."
values))
(mapconcat 'identity values " ")))
+(defun gnus-funcall-no-warning (function &rest args)
+ (when (fboundp function)
+ (apply function args)))
+
(provide 'gnus-fun)
;;; gnus-fun.el ends here
(autoload 'gnus-group-make-nnir-group "nnir")
-(defcustom gnus-no-groups-message "No Gnus is good news"
+(defcustom gnus-no-groups-message "No news is good news"
"*Message displayed by Gnus when no groups are available."
:group 'gnus-start
:type 'string)
;; (gnus-read-group "Group name: ")
(gnus-group-completing-read)
(gnus-read-method "From method")))
- ;; Transform the select method into a unique server.
(unless (gnus-alive-p)
- (gnus-no-server))
+ (nnheader-init-server-buffer)
+ ;; Necessary because of funky inlining.
+ (require 'gnus-cache)
+ (setq gnus-newsrc-hashtb (gnus-make-hashtable)))
+ ;; Transform the select method into a unique server.
(when (stringp method)
(setq method (gnus-server-to-method method)))
(let ((address-slot
`(-1 nil (,group
,gnus-level-default-subscribed nil nil ,method
,(cons
- (cond
- (quit-config
- (cons 'quit-config quit-config))
- ((assq gnus-current-window-configuration
- gnus-buffer-configuration)
- (cons 'quit-config
+ (cons 'quit-config
+ (cond
+ (quit-config
+ quit-config)
+ ((assq gnus-current-window-configuration
+ gnus-buffer-configuration)
(cons gnus-summary-buffer
- gnus-current-window-configuration))))
+ gnus-current-window-configuration))
+ (t
+ (cons (current-buffer)
+ (current-window-configuration)))))
parameters)))
gnus-newsrc-hashtb)
(push method gnus-ephemeral-servers)
- (set-buffer gnus-group-buffer)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
(unless (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
(when activate
group start (+ start range)))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
- (format "%s.start-%s.range-%s" group start range)
+ (format "nndoc+ephemeral:%s.start-%s.range-%s" group start range)
`(nndoc ,tmpfile
(nndoc-article-type mbox))))
(delete-file tmpfile)))
"/.*$" ""))))
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
- "gnus-read-ephemeral-bug"
+ (format "nndoc+ephemeral:bug#%s"
+ (mapconcat 'number-to-string ids ","))
`(nndoc ,tmpfile
(nndoc-article-type mbox))
nil window-conf))
(gnus-activate-foreign-newsgroups level))
(gnus-group-get-new-news)))
-(defun gnus-group-get-new-news (&optional arg)
+(defun gnus-group-get-new-news (&optional arg one-level)
"Get newly arrived articles.
If ARG is a number, it specifies which levels you are interested in
re-scanning. If ARG is non-nil and not a number, this will force
-\"hard\" re-reading of the active files from all servers."
+\"hard\" re-reading of the active files from all servers.
+If ONE-LEVEL is not nil, then re-scan only the specified level,
+otherwise all levels below ARG will be scanned too."
(interactive "P")
(require 'nnmail)
(let ((gnus-inhibit-demon t)
(unless gnus-slave
(gnus-master-read-slave-newsrc))
- (gnus-get-unread-articles arg)
+ (gnus-get-unread-articles (gnus-group-default-level arg t)
+ nil one-level)
;; If the user wants it, we scan for new groups.
(when (eq gnus-check-new-newsgroups 'always)
(gnus-list-of-unread-articles (car info))))))
(error "No such group: %s" (gnus-info-group info))))))
-(defun gnus-group-set-method-info (group select-method)
- (gnus-group-set-info select-method group 'method))
-
-(defun gnus-group-set-params-info (group params)
- (gnus-group-set-info params group 'params))
-
;; Ad-hoc function for inserting data from a different newsrc.eld
;; file. Use with caution, if at all.
(defun gnus-import-other-newsrc-file (file)
(setq mark gnus-expirable-mark))
(setq mark (gnus-request-update-mark
group article mark))
+ (gnus-request-set-mark
+ group (list (list (list article) 'add '(read))))
(gnus-mark-article-as-read article mark)
(setq gnus-newsgroup-active (gnus-active group))
(when active
dont-check
info)))
-(defun gnus-list-active-group (group)
- "Request active information on GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'list-active-group))
- (when (gnus-check-backend-function func group)
- (funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
-
(defun gnus-request-group-description (group)
"Request a description of GROUP."
(let ((gnus-command-method (gnus-find-method-for-group group))
(funcall (gnus-get-function gnus-command-method func)
(gnus-group-real-name group) (nth 1 gnus-command-method)))))
-(defun gnus-request-group-articles (group)
- "Request a list of existing articles in GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'request-group-articles))
- (when (gnus-check-backend-function func group)
- (funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
-
(defun gnus-close-group (group)
"Request the GROUP be closed."
(let ((gnus-command-method (inline (gnus-find-method-for-group group))))
header
(gnus-group-real-name group))))
+(defun gnus-select-group-with-message-id (group message-id)
+ "Activate and select GROUP with the given MESSAGE-ID selected.
+Returns the article number of the message.
+
+If GROUP is not already selected, the message will be the only one in
+the group's summary.
+"
+ ;; TODO: is there a way to know at this point whether the group will
+ ;; be newly-selected? If so we could clean up the logic at the end
+ ;;
+ ;; save the new group's display parameter, if any, so we
+ ;; can replace it temporarily with zero.
+ (let ((saved-display
+ (gnus-group-get-parameter group 'display :allow-list)))
+
+ ;; Tell gnus we really don't want any articles
+ (gnus-group-set-parameter group 'display 0)
+
+ (unwind-protect
+ (gnus-summary-read-group-1
+ group (not :show-all) :no-article (not :kill-buffer)
+ ;; The combination of no-display and this dummy list of
+ ;; articles to select somehow makes it possible to open a
+ ;; group with no articles in it. Black magic.
+ :no-display '(-1); select-articles
+ )
+ ;; Restore the new group's display parameter
+ (gnus-group-set-parameter group 'display saved-display)))
+
+ ;; The summary buffer was suppressed by :no-display above.
+ ;; Create it now and insert the message
+ (let ((group-is-new (gnus-summary-setup-buffer group)))
+ (condition-case err
+ (let ((article-number
+ (gnus-summary-insert-subject message-id)))
+ (unless article-number
+ (signal 'error "message-id not in group"))
+ (gnus-summary-select-article nil nil nil article-number)
+ article-number)
+ ;; Clean up the new summary and propagate the error
+ (error (when group-is-new (gnus-summary-exit))
+ (apply 'signal err)))))
+
+(defun gnus-simplify-group-name (group)
+ "Return the simplest representation of the name of GROUP.
+This is the string that Gnus uses to identify the group."
+ (gnus-group-prefixed-name
+ (gnus-group-real-name group)
+ (gnus-group-method group)))
+
(defun gnus-warp-to-article ()
"Warps from an article in a virtual group to the article in its
real group. Does nothing on a real group."
(interactive)
- (let ((gnus-command-method
- (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (gnus-check-backend-function
- 'warp-to-article (car gnus-command-method))
- (funcall (gnus-get-function gnus-command-method 'warp-to-article)))))
+ (when (gnus-virtual-group-p gnus-newsgroup-name)
+ (let ((gnus-command-method
+ (gnus-find-method-for-group gnus-newsgroup-name)))
+ (or
+ (when (gnus-check-backend-function
+ 'warp-to-article (car gnus-command-method))
+ (funcall (gnus-get-function gnus-command-method 'warp-to-article)))
+ (and (bound-and-true-p gnus-registry-enabled)
+ (gnus-try-warping-via-registry))))))
(defun gnus-request-head (article group)
"Request the head of ARTICLE in GROUP."
clean-up t))
;; Use `head' function.
((fboundp head)
- (setq res (funcall head article (gnus-group-real-name group)
+ (setq res (funcall head article
+ (and (not gnus-override-method) (gnus-group-real-name group))
(nth 1 gnus-command-method))))
;; Use `article' function.
(t
(defun gnus-request-expire-articles (articles group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group))
+ ;; Filter out any negative article numbers; they can't be
+ ;; expired here.
+ (articles
+ (delq nil (mapcar (lambda (n) (and (>= n 0) n)) articles)))
(gnus-inhibit-demon t)
(not-deleted
(funcall
(gnus-agent-regenerate-group group (list article)))
result))
-(defun gnus-request-associate-buffer (group)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-associate-buffer)
- (gnus-group-real-name group))))
-
(defun gnus-request-restore-buffer (article group)
"Request a new buffer restored to the state of ARTICLE."
(let ((gnus-command-method (gnus-find-method-for-group group)))
;; For kill files
-(defun gnus-Newsgroup-kill-file (newsgroup)
- "Return the name of a kill file for NEWSGROUP.
-If NEWSGROUP is nil, return the global kill file instead."
- (cond ((or (null newsgroup)
- (string-equal newsgroup ""))
- ;; The global kill file is placed at top of the directory.
- (expand-file-name gnus-kill-file-name gnus-kill-files-directory))
- (gnus-use-long-file-name
- ;; Append ".KILL" to capitalized newsgroup name.
- (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
- "." gnus-kill-file-name)
- gnus-kill-files-directory))
- (t
- ;; Place "KILL" under the hierarchical directory.
- (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
- "/" gnus-kill-file-name)
- gnus-kill-files-directory))))
-
(defun gnus-expunge (marks)
"Remove lines marked with MARKS."
(with-current-buffer gnus-summary-buffer
(setq header "article"))
(with-current-buffer nntp-server-buffer
(let* ((request-func (cond ((string= "head" header)
- 'gnus-request-head)
- ((string= "body" header)
- 'gnus-request-body)
- (t 'gnus-request-article)))
- ofunc article)
+ 'gnus-request-head)
+ ;; We need to peek at the headers to detect the
+ ;; content encoding
+ ((string= "body" header)
+ 'gnus-request-article)
+ (t 'gnus-request-article)))
+ ofunc article handles)
;; Not all backends support partial fetching. In that case, we
;; just fetch the entire article.
(unless (gnus-check-backend-function
- (intern (concat "request-" header))
- gnus-newsgroup-name)
- (setq ofunc request-func)
- (setq request-func 'gnus-request-article))
+ (intern (concat "request-" header))
+ gnus-newsgroup-name)
+ (setq ofunc request-func)
+ (setq request-func 'gnus-request-article))
(setq article (mail-header-number gnus-advanced-headers))
(gnus-message 7 "Scoring article %s..." article)
(when (funcall request-func article gnus-newsgroup-name)
- (goto-char (point-min))
- ;; If just parts of the article is to be searched and the
- ;; backend didn't support partial fetching, we just narrow to
- ;; the relevant parts.
- (when ofunc
- (if (eq ofunc 'gnus-request-head)
- (narrow-to-region
- (point)
- (or (search-forward "\n\n" nil t) (point-max)))
- (narrow-to-region
- (or (search-forward "\n\n" nil t) (point))
- (point-max))))
- (let* ((case-fold-search (not (eq (downcase (symbol-name type))
- (symbol-name type))))
- (search-func
- (cond ((memq type '(r R regexp Regexp))
- 're-search-forward)
- ((memq type '(s S string String))
- 'search-forward)
- (t
- (error "Invalid match type: %s" type)))))
- (goto-char (point-min))
- (prog1
- (funcall search-func match nil t)
- (widen)))))))
+ (when (string= "body" header)
+ (setq handles (gnus-score-decode-text-parts)))
+ (goto-char (point-min))
+ ;; If just parts of the article is to be searched and the
+ ;; backend didn't support partial fetching, we just narrow to
+ ;; the relevant parts.
+ (when ofunc
+ (if (eq ofunc 'gnus-request-head)
+ (narrow-to-region
+ (point)
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (narrow-to-region
+ (or (search-forward "\n\n" nil t) (point))
+ (point-max))))
+ (let* ((case-fold-search (not (eq (downcase (symbol-name type))
+ (symbol-name type))))
+ (search-func
+ (cond ((memq type '(r R regexp Regexp))
+ 're-search-forward)
+ ((memq type '(s S string String))
+ 'search-forward)
+ (t
+ (error "Invalid match type: %s" type)))))
+ (goto-char (point-min))
+ (prog1
+ (funcall search-func match nil t)
+ (widen)))
+ (when handles (mm-destroy-parts handles))))))
(provide 'gnus-logic)
(const all :tag "Any")
(string :tag "Regexp")))
+(defcustom gnus-gcc-self-resent-messages 'no-gcc-self
+ "Like `gcc-self' group parameter, only for unmodified resent messages.
+Applied to messages sent by `gnus-summary-resend-message'. Non-nil
+value of this variable takes precedence over any existing Gcc header.
+
+If this is `none', no Gcc copy will be made. If this is t, messages
+resent will be Gcc'd to the current group. If this is a string, it
+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.3"
+ :group 'gnus-message
+ :type '(choice (const none) (const t) string (const nil)
+ (const no-gcc-self)))
+
(gnus-define-group-parameter
posting-charset-alist
:type list
:group 'gnus-message
:type 'boolean)
+(defcustom gnus-gcc-pre-body-encode-hook nil
+ "A hook called before encoding the body of the Gcc copy of a message.
+The current buffer (when the hook is run) contains the message
+including the message header. Changes made to the message will
+only affect the Gcc copy, but not the original message."
+ :group 'gnus-message
+ :type 'hook)
+
+(defcustom gnus-gcc-post-body-encode-hook nil
+ "A hook called after encoding the body of the Gcc copy of a message.
+The current buffer (when the hook is run) contains the message
+including the message header. Changes made to the message will
+only affect the Gcc copy, but not the original message."
+ :group 'gnus-message
+ :type 'hook)
+
(autoload 'gnus-message-citation-mode "gnus-cite" nil t)
;;; Internal variables.
instead."
(interactive)
(if (not (gnus-alive-p))
- (message-mail to subject other-headers continue
- nil yank-action send-actions return-action)
+ (progn
+ (message "Gnus not running; using plain Message mode")
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions return-action))
(let ((buf (current-buffer))
(gnus-newsgroup-name (or gnus-newsgroup-name ""))
mail-buf)
(interactive (gnus-interactive "P\ny"))
(let ((message-post-method
`(lambda (arg)
- (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))))
+ (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
+ (user-mail-address user-mail-address))
(dolist (article (gnus-summary-work-articles n))
(when (gnus-summary-select-article t nil nil article)
+ ;; Pretend that we're doing a followup so that we can see what
+ ;; the From header would have ended up being.
+ (save-window-excursion
+ (save-excursion
+ (gnus-summary-followup nil)
+ (let ((from (message-fetch-field "from")))
+ (when from
+ (setq user-mail-address
+ (car (mail-header-parse-address from)))))
+ (kill-buffer (current-buffer))))
+ ;; Now cancel the article using the From header we got.
(when (gnus-eval-in-buffer-window gnus-original-article-buffer
(message-cancel-news))
(gnus-summary-mark-as-read article gnus-canceled-mark)
(set-buffer gnus-original-article-buffer)
(message-forward post)))))))
+(defun gnus-summary-resend-message-insert-gcc ()
+ "Insert Gcc header according to `gnus-gcc-self-resent-messages'."
+ (gnus-inews-insert-gcc)
+ (let ((gcc (mapcar
+ (lambda (group)
+ (mm-encode-coding-string
+ group
+ (gnus-group-name-charset (gnus-inews-group-method group)
+ group)))
+ (message-unquote-tokens
+ (message-tokenize-header (mail-fetch-field "gcc" nil t)
+ " ,"))))
+ (self (with-current-buffer gnus-summary-buffer
+ gnus-gcc-self-resent-messages)))
+ (message-remove-header "gcc")
+ (when gcc
+ (goto-char (point-max))
+ (cond ((eq self 'none))
+ ((eq self t)
+ (insert "Gcc: \"" gnus-newsgroup-name "\"\n"))
+ ((stringp self)
+ (insert "Gcc: "
+ (mm-encode-coding-string
+ (if (string-match " " self)
+ (concat "\"" self "\"")
+ self)
+ (gnus-group-name-charset (gnus-inews-group-method self)
+ self))
+ "\n"))
+ ((null self)
+ (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
+ ((eq self 'no-gcc-self)
+ (when (setq gcc (delete
+ gnus-newsgroup-name
+ (delete (concat "\"" gnus-newsgroup-name "\"")
+ gcc)))
+ (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
+
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(interactive
(with-current-buffer gnus-original-article-buffer
(nnmail-fetch-field "to"))))
current-prefix-arg))
- (dolist (article (gnus-summary-work-articles n))
- (gnus-summary-select-article nil nil nil article)
- (with-current-buffer gnus-original-article-buffer
- (let ((gnus-gcc-externalize-attachments nil))
- (message-resend address)))
- (gnus-summary-mark-article-as-forwarded article)))
+ (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
+ (message-sent-hook (copy-sequence message-sent-hook))
+ ;; Honor posting-style for `name' and `address' in Resent-From header.
+ (styles (gnus-group-find-parameter gnus-newsgroup-name
+ 'posting-style t))
+ (user-full-name user-full-name)
+ (user-mail-address user-mail-address)
+ tem)
+ (dolist (style styles)
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8)))))
+ (dolist (style (if styles
+ (append gnus-posting-styles (list (cons ".*" styles)))
+ gnus-posting-styles))
+ (when (string-match (pop style) gnus-newsgroup-name)
+ (when (setq tem (cadr (assq 'name style)))
+ (setq user-full-name tem))
+ (when (setq tem (cadr (assq 'address style)))
+ (setq user-mail-address tem))))
+ ;; `gnus-summary-resend-message-insert-gcc' must run last.
+ (add-hook 'message-header-setup-hook
+ 'gnus-summary-resend-message-insert-gcc t)
+ (add-hook 'message-sent-hook
+ `(lambda ()
+ (let ((rfc2047-encode-encoded-words nil))
+ ,(if gnus-agent
+ '(gnus-agent-possibly-do-gcc)
+ '(gnus-inews-do-gcc)))))
+ (dolist (article (gnus-summary-work-articles n))
+ (gnus-summary-select-article nil nil nil article)
+ (with-current-buffer gnus-original-article-buffer
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address)))
+ (gnus-summary-mark-article-as-forwarded article))))
;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
(defun gnus-summary-resend-message-edit ()
(when (gnus-y-or-n-p "Send this complaint? ")
(message-send-and-exit))))))
-(defun gnus-mail-parse-comma-list ()
- (let (accumulated
- beg)
- (skip-chars-forward " ")
- (while (not (eobp))
- (setq beg (point))
- (skip-chars-forward "^,")
- (while (zerop
- (save-excursion
- (save-restriction
- (let ((i 0))
- (narrow-to-region beg (point))
- (goto-char beg)
- (logand (progn
- (while (search-forward "\"" nil t)
- (incf i))
- (if (zerop i) 2 i))
- 2)))))
- (skip-chars-forward ",")
- (skip-chars-forward "^,"))
- (skip-chars-backward " ")
- (push (buffer-substring beg (point))
- accumulated)
- (skip-chars-forward "^,")
- (skip-chars-forward ", "))
- accumulated))
-
(defun gnus-inews-add-to-address (group)
(let ((to-address (mail-fetch-field "to")))
(when (and to-address
(format "Do you want to add this as `to-list': %s? " to-address))
(gnus-group-add-parameter group (cons 'to-list to-address))))))
-(defun gnus-put-message ()
- "Put the current message in some group and return to Gnus."
- (interactive)
- (let ((reply gnus-article-reply)
- (winconf gnus-prev-winconf)
- (group gnus-newsgroup-name))
- (unless (and group
- (not (gnus-group-read-only-p group)))
- (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
-
- (when (gnus-group-entry group)
- (error "No such group: %s" group))
- (save-excursion
- (save-restriction
- (widen)
- (message-narrow-to-headers)
- (let ((gnus-deletable-headers nil))
- (message-generate-headers
- (if (message-news-p)
- message-required-news-headers
- message-required-mail-headers)))
- (goto-char (point-max))
- (if (string-match " " group)
- (insert "Gcc: \"" group "\"\n")
- (insert "Gcc: " group "\n"))
- (widen)))
- (gnus-inews-do-gcc)
- (when (and (get-buffer gnus-group-buffer)
- (gnus-buffer-exists-p (car-safe reply))
- (cdr reply))
- (set-buffer (car reply))
- (gnus-summary-mark-article-as-replied (cdr reply)))
- (when winconf
- (set-window-configuration winconf))))
-
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
If YANK is non-nil, include the original article."
(nnheader-set-temp-buffer " *acc*")
(setq message-options (with-current-buffer cur message-options))
(insert-buffer-substring cur)
+ (run-hooks 'gnus-gcc-pre-body-encode-hook)
(message-encode-message-body)
+ (run-hooks 'gnus-gcc-post-body-encode-hook)
(save-restriction
(message-narrow-to-headers)
(let* ((mail-parse-charset message-default-charset)
(when (and group-art
;; FIXME: Should gcc-mark-as-read work when
;; Gnus is not running?
- (gnus-alive-p)
- (or gnus-gcc-mark-as-read
- (and
- (boundp 'gnus-inews-mark-gcc-as-read)
- (symbol-value 'gnus-inews-mark-gcc-as-read))))
- (gnus-group-mark-article-read group (cdr group-art)))
+ (gnus-alive-p))
+ (if (or gnus-gcc-mark-as-read
+ (and (boundp 'gnus-inews-mark-gcc-as-read)
+ (symbol-value 'gnus-inews-mark-gcc-as-read)))
+ (gnus-group-mark-article-read group (cdr group-art))
+ (with-current-buffer gnus-group-buffer
+ (let ((gnus-group-marked (list group))
+ (gnus-get-new-news-hook nil)
+ (inhibit-read-only t))
+ (gnus-group-get-new-news-this-group nil t)))))
(setq options message-options)
(with-current-buffer cur (setq message-options options))
(kill-buffer (current-buffer)))))))))
(when gnus-newsgroup-name
(let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
(when tmp-style
+ (dolist (style tmp-style)
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-decode-coding-string (cadr style)
+ 'utf-8)))))
(setq styles (append styles (list (cons ".*" tmp-style)))))))
;; Go through all styles and look for matches.
(dolist (style styles)
--- /dev/null
+;; gnus-notifications.el -- Send notification on new message in Gnus
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: news
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This implements notifications using `notifications-notify' on new
+;; messages received.
+;; Use (add-hook 'gnus-after-getting-new-news-hook 'gnus-notifications)
+;; to get notifications just after getting the new news.
+
+;;; Code:
+
+(ignore-errors
+ (require 'notifications))
+(require 'gnus-sum)
+(require 'gnus-group)
+(require 'gnus-int)
+(require 'gnus-art)
+(require 'gnus-util)
+(ignore-errors
+ (require 'google-contacts)) ; Optional
+(require 'gnus-fun)
+
+(defgroup gnus-notifications nil
+ "Send notifications on new message in Gnus."
+ :group 'gnus)
+
+(defcustom gnus-notifications-use-google-contacts t
+ "Use Google Contacts to retrieve photo."
+ :type 'boolean
+ :group 'gnus-notifications)
+
+(defcustom gnus-notifications-use-gravatar t
+ "Use Gravatar to retrieve photo."
+ :type 'boolean
+ :group 'gnus-notifications)
+
+(defcustom gnus-notifications-minimum-level 1
+ "Minimum group level the message should have to be notified.
+Any message in a group that has a greater value than this will
+not get notifications."
+ :type 'integer
+ :group 'gnus-notifications)
+
+(defcustom gnus-notifications-timeout nil
+ "Timeout used for notifications sent via `notifications-notify'."
+ :type 'integer
+ :group 'gnus-notifications)
+
+(defvar gnus-notifications-sent nil
+ "Notifications already sent.")
+
+(defvar gnus-notifications-id-to-msg nil
+ "Map notifications ids to messages.")
+
+(defun gnus-notifications-action (id key)
+ (when (string= key "read")
+ (let ((group-article (assoc id gnus-notifications-id-to-msg)))
+ (when group-article
+ (let ((group (cadr group-article))
+ (article (nth 2 group-article)))
+ (gnus-fetch-group group (list article)))))))
+
+(defun gnus-notifications-notify (from subject photo-file)
+ "Send a notification about a new mail.
+Return a notification id if any, or t on success."
+ (if (fboundp 'notifications-notify)
+ (gnus-funcall-no-warning
+ 'notifications-notify
+ :title from
+ :body subject
+ :actions '("read" "Read")
+ :on-action 'gnus-notifications-action
+ :app-icon (gnus-funcall-no-warning
+ 'image-search-load-path "gnus/gnus.png")
+ :app-name "Gnus"
+ :category "email.arrived"
+ :timeout gnus-notifications-timeout
+ :image-path photo-file)
+ (message "New message from %s: %s" from subject)
+ ;; Don't return an id
+ t))
+
+(defun gnus-notifications-get-photo (mail-address)
+ "Get photo for mail address."
+ (let ((google-photo (when (and gnus-notifications-use-google-contacts
+ (fboundp 'google-contacts-get-photo))
+ (ignore-errors
+ (gnus-funcall-no-warning
+ 'google-contacts-get-photo mail-address)))))
+ (if google-photo
+ google-photo
+ (when gnus-notifications-use-gravatar
+ (let ((gravatar (ignore-errors
+ (gravatar-retrieve-synchronously mail-address))))
+ (if (eq gravatar 'error)
+ nil
+ (plist-get (cdr gravatar) :data)))))))
+
+(defun gnus-notifications-get-photo-file (mail-address)
+ "Get a temporary file with an image for MAIL-ADDRESS.
+You have to delete the temporary image yourself using
+`delete-image'.
+
+Returns nil if no image found."
+ (let ((photo (gnus-notifications-get-photo mail-address)))
+ (when photo
+ (let ((photo-file (make-temp-file "gnus-notifications-photo-"))
+ (coding-system-for-write 'binary))
+ (with-temp-file photo-file
+ (insert photo))
+ photo-file))))
+
+;;;###autoload
+(defun gnus-notifications ()
+ "Send a notification on new message.
+This check for new messages that are in group with a level lower
+or equal to `gnus-notifications-minimum-level' and send a
+notification using `notifications-notify' for it.
+
+This is typically a function to add in
+`gnus-after-getting-new-news-hook'"
+ (dolist (entry gnus-newsrc-alist)
+ (let ((group (car entry)))
+ ;; Check that the group level is less than
+ ;; `gnus-notifications-minimum-level' and the the group has unread
+ ;; messages.
+ (when (and (<= (gnus-group-level group) gnus-notifications-minimum-level)
+ (let ((unread (gnus-group-unread group)))
+ (and (numberp unread)
+ (> unread 0))))
+ ;; Each group should have an entry in the `gnus-notifications-sent'
+ ;; alist. If not, we add one at this time.
+ (let ((group-notifications (or (assoc group gnus-notifications-sent)
+ ;; Nothing, add one and return it.
+ (assoc group
+ (add-to-list
+ 'gnus-notifications-sent
+ (cons group nil))))))
+ (dolist (article (gnus-list-of-unread-articles group))
+ ;; Check if the article already has been notified
+ (unless (memq article (cdr group-notifications))
+ (with-current-buffer nntp-server-buffer
+ (gnus-request-head article group)
+ (article-decode-encoded-words) ; to decode mail addresses, subjects, etc
+ (let* ((address-components (mail-extract-address-components
+ (or (mail-fetch-field "From") "")))
+ (address (cadr address-components)))
+ ;; Ignore mails from ourselves
+ (unless (and gnus-ignored-from-addresses
+ address
+ (gnus-string-match-p gnus-ignored-from-addresses
+ address))
+ (let* ((photo-file (gnus-notifications-get-photo-file address))
+ (notification-id (gnus-notifications-notify
+ (or (car address-components) address)
+ (mail-fetch-field "Subject")
+ photo-file)))
+ (when notification-id
+ ;; Register that we did notify this message
+ (setcdr group-notifications (cons article (cdr group-notifications)))
+ (unless (eq notification-id t)
+ ;; Register the notification id for later actions
+ (add-to-list 'gnus-notifications-id-to-msg (list notification-id group article))))
+ (when photo-file
+ (delete-file photo-file)))))))))))))
+
+(provide 'gnus-notifications)
+
+;;; gnus-notifications.el ends here
:type '(repeat string)
:group 'gnus-picon)
+(defcustom gnus-picon-properties '(:color-symbols (("None" . "white")))
+ "List of image properties applied to picons."
+ :type 'list
+ :version "24.3"
+ :group 'gnus-picon)
+
(defcustom gnus-picon-style 'inline
"How should picons be displayed.
If `inline', the textual representation is replaced. If `right', picons are
(defun gnus-picon-create-glyph (file)
(or (cdr (assoc file gnus-picon-glyph-alist))
- (cdar (push (cons file (gnus-create-image
- file nil nil
- :color-symbols '(("None" . "white"))))
+ (cdar (push (cons file (apply 'gnus-create-image
+ file nil nil
+ gnus-picon-properties))
gnus-picon-glyph-alist))))
;;; Functions that does picon transformations:
(defun gnus-set-difference (list1 list2)
"Return a list of elements of LIST1 that do not appear in LIST2."
- (let ((list1 (copy-sequence list1)))
- (while list2
- (setq list1 (delq (car list2) list1))
- (setq list2 (cdr list2)))
- list1))
+ (let ((hash2 (make-hash-table :test 'eq))
+ (result nil))
+ (dolist (elt list2) (puthash elt t hash2))
+ (dolist (elt list1)
+ (unless (gethash elt hash2)
+ (setq result (cons elt result))))
+ (nreverse result)))
(defun gnus-range-nconcat (&rest ranges)
"Return a range comprising all the RANGES, which are pre-sorted.
(setq sum
(+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
-(defun gnus-sublist-p (list sublist)
- "Test whether all elements in SUBLIST are members of LIST."
- (let ((sublistp t))
- (while sublist
- (unless (memq (pop sublist) list)
- (setq sublistp nil
- sublist nil)))
- sublistp))
-
(defun gnus-range-add (range1 range2)
"Add RANGE2 to RANGE1 (nondestructively)."
(unless (listp (cdr range1))
(eval-when-compile (require 'cl))
-(eval-when-compile
- (when (null (ignore-errors (require 'ert)))
- (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
-
-(ignore-errors
- (require 'ert))
(require 'gnus)
(require 'gnus-int)
(require 'gnus-sum)
(defvar gnus-adaptive-word-syntax-table)
(defvar gnus-registry-dirty t
- "Boolean set to t when the registry is modified")
+ "Boolean set to t when the registry is modified.")
(defgroup gnus-registry nil
"The Gnus registry."
(append gnus-registry-track-extra
'(mark group keyword)))
(when (not (equal old (oref db :tracked)))
- (gnus-message 4 "Reindexing the Gnus registry (tracked change)")
+ (gnus-message 9 "Reindexing the Gnus registry (tracked change)")
(registry-reindex db))))
db)
:tracked nil)))
(defvar gnus-registry-db (gnus-registry-make-db)
- "*The article registry by Message ID. See `registry-db'")
+ "The article registry by Message ID. See `registry-db'.")
;; top-level registry data management
(defun gnus-registry-remake-db (&optional forsure)
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
(defun gnus-registry-split-fancy-with-parent ()
- "Split this message into the same group as its parent. The parent
-is obtained from the registry. This function can be used as an entry
-in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
+ "Split this message into the same group as its parent.
+The parent is obtained from the registry. This function can be used as an
+entry in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
this: (: gnus-registry-split-fancy-with-parent)
This function tracks ALL backends, unlike
(registry-lookup-secondary-value gnus-registry-db 'keyword keyword))
(defun gnus-registry-register-message-ids ()
- "Register the Message-ID of every article in the group"
+ "Register the Message-ID of every article in the group."
(unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
(dolist (article gnus-newsgroup-articles)
(let* ((id (gnus-registry-fetch-message-id-fast article))
;; message field fetchers
(defun gnus-registry-fetch-message-id-fast (article)
- "Fetch the Message-ID quickly, using the internal gnus-data-list function"
+ "Fetch the Message-ID quickly, using the internal gnus-data-list function."
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
(defun gnus-registry-fetch-simplified-message-subject-fast (article)
- "Fetch the Subject quickly, using the internal gnus-data-list function"
+ "Fetch the Subject quickly, using the internal gnus-data-list function."
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(gnus-string-remove-all-properties
(or (ignore-errors (gnus-registry-fetch-header-fast "To" article)) "")))
(defun gnus-registry-fetch-header-fast (article header)
- "Fetch the HEADER quickly, using the internal gnus-data-list function"
+ "Fetch the HEADER quickly, using the internal gnus-data-list function."
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(gnus-string-remove-all-properties
(when cell-data
(funcall function mark cell-data)))))
-;;; this is ugly code, but I don't know how to do it better
+;; FIXME: Why not merge gnus-registry--set/remove-mark and
+;; gnus-registry-set-article-mark-internal?
+(defun gnus-registry--set/remove-mark (remove mark articles)
+ "Set/remove the MARK over process-marked ARTICLES."
+ ;; If this is called and the user doesn't want the
+ ;; registry enabled, we'll ask anyhow.
+ (unless gnus-registry-install
+ (let ((gnus-registry-install 'ask))
+ (gnus-registry-install-p)))
+
+ ;; Now the user is asked if gnus-registry-install is `ask'.
+ (when (gnus-registry-install-p)
+ (gnus-registry-set-article-mark-internal
+ ;; All this just to get the mark, I must be doing it wrong.
+ mark articles remove t)
+ ;; FIXME: Why do we do the above only here and not directly inside
+ ;; gnus-registry-set-article-mark-internal? I.e. we wouldn't we want to do
+ ;; the things below when gnus-registry-set-article-mark-internal is called
+ ;; from gnus-registry-set-article-mark or
+ ;; gnus-registry-remove-article-mark?
+ (gnus-message 9 "Applying mark %s to %d articles"
+ mark (length articles))
+ (dolist (article articles)
+ (gnus-summary-update-article
+ article
+ (assoc article (gnus-data-list nil))))))
+
+;; This is ugly code, but I don't know how to do it better.
(defun gnus-registry-install-shortcuts ()
"Install the keyboard shortcuts and menus for the registry.
Uses `gnus-registry-marks' to find what shortcuts to install."
(let ((function-format
(format "gnus-registry-%%s-article-%s-mark" mark)))
-;;; The following generates these functions:
-;;; (defun gnus-registry-set-article-Important-mark (&rest articles)
-;;; "Apply the Important mark to process-marked ARTICLES."
-;;; (interactive (gnus-summary-work-articles current-prefix-arg))
-;;; (gnus-registry-set-article-mark-internal 'Important articles nil t))
-;;; (defun gnus-registry-remove-article-Important-mark (&rest articles)
-;;; "Apply the Important mark to process-marked ARTICLES."
-;;; (interactive (gnus-summary-work-articles current-prefix-arg))
-;;; (gnus-registry-set-article-mark-internal 'Important articles t t))
+;;; The following generates these functions:
+;;; (defun gnus-registry-set-article-Important-mark (&rest articles)
+;;; "Apply the Important mark to process-marked ARTICLES."
+;;; (interactive (gnus-summary-work-articles current-prefix-arg))
+;;; (gnus-registry-set-article-mark-internal 'Important articles nil t))
+;;; (defun gnus-registry-remove-article-Important-mark (&rest articles)
+;;; "Apply the Important mark to process-marked ARTICLES."
+;;; (interactive (gnus-summary-work-articles current-prefix-arg))
+;;; (gnus-registry-set-article-mark-internal 'Important articles t t))
(dolist (remove '(t nil))
(let* ((variant-name (if remove "remove" "set"))
- (function-name (format function-format variant-name))
- (shortcut (format "%c" data))
- (shortcut (if remove (upcase shortcut) shortcut)))
- (unintern function-name obarray)
- (eval
- `(defun
- ;; function name
- ,(intern function-name)
- ;; parameter definition
- (&rest articles)
- ;; documentation
- ,(format
- "%s the %s mark over process-marked ARTICLES."
- (upcase-initials variant-name)
- mark)
- ;; interactive definition
- (interactive
- (gnus-summary-work-articles current-prefix-arg))
- ;; actual code
-
- ;; if this is called and the user doesn't want the
- ;; registry enabled, we'll ask anyhow
- (unless gnus-registry-install
- (let ((gnus-registry-install 'ask))
- (gnus-registry-install-p)))
-
- ;; now the user is asked if gnus-registry-install is 'ask
- (when (gnus-registry-install-p)
- (gnus-registry-set-article-mark-internal
- ;; all this just to get the mark, I must be doing it wrong
- (intern ,(symbol-name mark))
- articles ,remove t)
- (gnus-message
- 9
- "Applying mark %s to %d articles"
- ,(symbol-name mark) (length articles))
- (dolist (article articles)
- (gnus-summary-update-article
- article
- (assoc article (gnus-data-list nil)))))))
- (push (intern function-name) keys-plist)
+ (function-name
+ (intern (format function-format variant-name)))
+ (shortcut (format "%c" (if remove (upcase data) data))))
+ (defalias function-name
+ ;; If it weren't for the function's docstring, we could
+ ;; use a closure, with lexical-let :-(
+ `(lambda (&rest articles)
+ ,(format
+ "%s the %s mark over process-marked ARTICLES."
+ (upcase-initials variant-name)
+ mark)
+ (interactive
+ (gnus-summary-work-articles current-prefix-arg))
+ (gnus-registry--set/remove-mark ',mark ',remove articles)))
+ (push function-name keys-plist)
(push shortcut keys-plist)
(push (vector (format "%s %s"
(upcase-initials variant-name)
(symbol-name mark))
- (intern function-name) t)
+ function-name t)
gnus-registry-misc-menus)
- (gnus-message
- 9
- "Defined mark handling function %s"
- function-name))))))
+ (gnus-message 9 "Defined mark handling function %s"
+ function-name))))))
(gnus-define-keys-1
'(gnus-registry-mark-map "M" gnus-summary-mark-map)
keys-plist)
;; use like this:
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
(defun gnus-registry-article-marks-to-chars (headers)
- "Show the marks for an article by the :char property"
+ "Show the marks for an article by the :char property."
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
(mapconcat (lambda (mark)
;; use like this:
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
(defun gnus-registry-article-marks-to-names (headers)
- "Show the marks for an article by name"
+ "Show the marks for an article by name."
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
(mapconcat (lambda (mark) (symbol-name mark)) marks ",")))
(gnus-registry-set-id-key id key val))))
(message "Import done, collected %d entries" count))))
-(ert-deftest gnus-registry-misc-test ()
- (should-error (gnus-registry-extract-addresses '("" "")))
-
- (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
- "noname <ed@you.me>"
- "noname <cyd@stupidchicken.com>"
- "noname <tzz@lifelogs.com>")
- (gnus-registry-extract-addresses
- (concat "Ted Zlatanov <tzz@lifelogs.com>, "
- "ed <ed@you.me>, " ; "ed" is not a valid name here
- "cyd@stupidchicken.com, "
- "tzz@lifelogs.com")))))
-
-(ert-deftest gnus-registry-usage-test ()
- (let* ((n 100)
- (tempfile (make-temp-file "gnus-registry-persist"))
- (db (gnus-registry-make-db tempfile))
- (gnus-registry-db db)
- back size)
- (message "Adding %d keys to the test Gnus registry" n)
- (dotimes (i n)
- (let ((id (number-to-string i)))
- (gnus-registry-handle-action id
- (if (>= 50 i) "fromgroup" nil)
- "togroup"
- (when (>= 70 i)
- (format "subject %d" (mod i 10)))
- (when (>= 80 i)
- (format "sender %d" (mod i 10))))))
- (message "Testing Gnus registry size is %d" n)
- (should (= n (registry-size db)))
- (message "Looking up individual keys (registry-lookup)")
- (should (equal (loop for e
- in (mapcar 'cadr
- (registry-lookup db '("20" "83" "72")))
- collect (assq 'subject e)
- collect (assq 'sender e)
- collect (assq 'group e))
- '((subject "subject 0") (sender "sender 0") (group "togroup")
- (subject) (sender) (group "togroup")
- (subject) (sender "sender 2") (group "togroup"))))
-
- (message "Looking up individual keys (gnus-registry-id-key)")
- (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
- (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
- (message "Trying to insert a duplicate key")
- (should-error (gnus-registry-insert db "55" '()))
- (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
- (should (gnus-registry-get-or-make-entry "22"))
- (message "Saving the Gnus registry to %s" tempfile)
- (should (gnus-registry-save tempfile db))
- (setq size (nth 7 (file-attributes tempfile)))
- (message "Saving the Gnus registry to %s: size %d" tempfile size)
- (should (< 0 size))
- (with-temp-buffer
- (insert-file-contents-literally tempfile)
- (should (looking-at (concat ";; Object "
- "Gnus Registry"
- "\n;; EIEIO PERSISTENT OBJECT"))))
- (message "Reading Gnus registry back")
- (setq back (eieio-persistent-read tempfile))
- (should back)
- (message "Read Gnus registry back: %d keys, expected %d==%d"
- (registry-size back) n (registry-size db))
- (should (= (registry-size back) n))
- (should (= (registry-size back) (registry-size db)))
- (delete-file tempfile)
- (message "Pruning Gnus registry to 0 by setting :max-soft")
- (oset db :max-soft 0)
- (registry-prune db)
- (should (= (registry-size db) 0)))
- (message "Done with Gnus registry usage testing."))
-
;;;###autoload
(defun gnus-registry-initialize ()
-"Initialize the Gnus registry."
+ "Initialize the Gnus registry."
(interactive)
(gnus-message 5 "Initializing the registry")
(gnus-registry-install-hooks)
(gnus-registry-install-shortcuts)
(gnus-registry-read))
+;; FIXME: Why autoload this function?
;;;###autoload
(defun gnus-registry-install-hooks ()
"Install the registry hooks."
(gnus-registry-initialize)))
gnus-registry-enabled)
+;; largely based on nnir-warp-to-article
+(defun gnus-try-warping-via-registry ()
+ "Try to warp via the registry.
+This will be done via the current article's source group based on
+data stored in the registry."
+ (interactive)
+ (when (gnus-summary-article-header)
+ (let* ((message-id (mail-header-id (gnus-summary-article-header)))
+ ;; Retrieve the message's group(s) from the registry
+ (groups (gnus-registry-get-id-key message-id 'group))
+ ;; If starting from an ephemeral group, this describes
+ ;; how to restore the window configuration
+ (quit-config
+ (gnus-ephemeral-group-p gnus-newsgroup-name))
+ (seen-groups (list (gnus-group-group-name))))
+
+ (catch 'found
+ (dolist (group (mapcar 'gnus-simplify-group-name groups))
+
+ ;; skip over any groups we really don't want to warp to.
+ (unless (or (member group seen-groups)
+ (gnus-ephemeral-group-p group) ;; any ephemeral group
+ (memq (car (gnus-find-method-for-group group))
+ ;; Specific methods; this list may need to expand.
+ '(nnir)))
+
+ ;; remember that we've seen this group already
+ (push group seen-groups)
+
+ ;; first exit from any ephemeral summary buffer.
+ (when quit-config
+ (gnus-summary-exit)
+ ;; and if the ephemeral summary buffer in turn came from
+ ;; another summary buffer we have to clean that summary
+ ;; up too.
+ (when (eq (cdr quit-config) 'summary)
+ (gnus-summary-exit))
+ ;; remember that we've already done this part
+ (setq quit-config nil))
+
+ ;; Try to activate the group. If that fails, just move
+ ;; along. We may have more groups to work with
+ (when
+ (ignore-errors
+ (gnus-select-group-with-message-id group message-id) t)
+ (throw 'found t))))))))
+
;; TODO: a few things
(provide 'gnus-registry)
(when pos
(cons pos (next-single-property-change pos 'gnus-number)))))
-(defun gnus-tree-goto-article (article)
- (let ((pos (text-property-any
- (point-min) (point-max) 'gnus-number article)))
- (when pos
- (goto-char pos))))
-
(defun gnus-tree-recenter ()
"Center point in the tree window."
(let ((selected (selected-window))
(gnus-summary-raise-score score))))
(beginning-of-line 2))))
(gnus-set-mode-line 'summary))
-
-(defun gnus-summary-score-crossposting (score date)
- ;; Enter score file entry for current crossposting.
- ;; SCORE is the score to add.
- ;; DATE is the expire date.
- (let ((xref (gnus-summary-header "xref"))
- (start 0)
- group)
- (unless xref
- (error "This article is not crossposted"))
- (while (string-match " \\([^ \t]+\\):" xref start)
- (setq start (match-end 0))
- (when (not (string=
- (setq group
- (substring xref (match-beginning 1) (match-end 1)))
- gnus-newsgroup-name))
- (gnus-summary-score-entry
- "xref" (concat " " group ":") nil score date t)))))
-
\f
;;;
;;; Gnus Score Files
(setq entries rest)))))
nil)
+(defun gnus-score-decode-text-parts ()
+ (labels ((mm-text-parts (handle)
+ (cond ((stringp (car handle))
+ (let ((parts (mapcan #'mm-text-parts (cdr handle))))
+ (if (equal "multipart/alternative" (car handle))
+ ;; pick the first supported alternative
+ (list (car parts))
+ parts)))
+
+ ((bufferp (car handle))
+ (when (string-match "^text/" (mm-handle-media-type handle))
+ (list handle)))
+
+ (t (mapcan #'mm-text-parts handle))))
+ (my-mm-display-part (handle)
+ (when handle
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mm-display-inline handle)
+ (goto-char (point-max))))))
+
+ (let (;(mm-text-html-renderer 'w3m-standalone)
+ (handles (mm-dissect-buffer t)))
+ (save-excursion
+ (article-goto-body)
+ (delete-region (point) (point-max))
+ (mapc #'my-mm-display-part (mm-text-parts handles))
+ handles))))
+
(defun gnus-score-body (scores header now expire &optional trace)
- (if gnus-agent-fetching
- nil
- (save-excursion
- (setq gnus-scores-articles
- (sort gnus-scores-articles
- (lambda (a1 a2)
- (< (mail-header-number (car a1))
- (mail-header-number (car a2))))))
- (set-buffer nntp-server-buffer)
- (save-restriction
- (let* ((buffer-read-only nil)
- (articles gnus-scores-articles)
- (all-scores scores)
- (request-func (cond ((string= "head" header)
- 'gnus-request-head)
- ((string= "body" header)
- 'gnus-request-body)
- (t 'gnus-request-article)))
- entries alist ofunc article last)
- (when articles
- (setq last (mail-header-number (caar (last articles))))
- ;; Not all backends support partial fetching. In that case,
- ;; we just fetch the entire article.
- (unless (gnus-check-backend-function
- (and (string-match "^gnus-" (symbol-name request-func))
- (intern (substring (symbol-name request-func)
- (match-end 0))))
- gnus-newsgroup-name)
- (setq ofunc request-func)
- (setq request-func 'gnus-request-article))
- (while articles
- (setq article (mail-header-number (caar articles)))
- (gnus-message 7 "Scoring article %s of %s..." article last)
- (widen)
- (when (funcall request-func article gnus-newsgroup-name)
- (goto-char (point-min))
- ;; If just parts of the article is to be searched, but the
- ;; backend didn't support partial fetching, we just narrow
- ;; to the relevant parts.
- (when ofunc
- (if (eq ofunc 'gnus-request-head)
- (narrow-to-region
- (point)
- (or (search-forward "\n\n" nil t) (point-max)))
- (narrow-to-region
- (or (search-forward "\n\n" nil t) (point))
- (point-max))))
- (setq scores all-scores)
- ;; Find matches.
- (while scores
- (setq alist (pop scores)
- entries (assoc header alist))
- (while (cdr entries) ;First entry is the header index.
- (let* ((rest (cdr entries))
- (kill (car rest))
- (match (nth 0 kill))
- (type (or (nth 3 kill) 's))
- (score (or (nth 1 kill)
- gnus-score-interactive-default-score))
- (date (nth 2 kill))
- (found nil)
- (case-fold-search
- (not (or (eq type 'R) (eq type 'S)
- (eq type 'Regexp) (eq type 'String))))
- (search-func
- (cond ((or (eq type 'r) (eq type 'R)
- (eq type 'regexp) (eq type 'Regexp))
- 're-search-forward)
- ((or (eq type 's) (eq type 'S)
- (eq type 'string) (eq type 'String))
- 'search-forward)
- (t
- (error "Invalid match type: %s" type)))))
- (goto-char (point-min))
- (when (funcall search-func match nil t)
- ;; Found a match, update scores.
- (setcdr (car articles) (+ score (cdar articles)))
- (setq found t)
- (when trace
- (push
- (cons (car-safe (rassq alist gnus-score-cache))
- kill)
- gnus-score-trace)))
- ;; Update expire date
- (unless trace
- (cond
- ((null date)) ;Permanent entry.
- ((and found gnus-update-score-entry-dates)
- ;; Match, update date.
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now))
- ((and expire (< date expire)) ;Old entry, remove.
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cdr rest))
- (setq rest entries))))
- (setq entries rest)))))
- (setq articles (cdr articles)))))))
- nil))
+ (if gnus-agent-fetching
+ nil
+ (save-excursion
+ (setq gnus-scores-articles
+ (sort gnus-scores-articles
+ (lambda (a1 a2)
+ (< (mail-header-number (car a1))
+ (mail-header-number (car a2))))))
+ (set-buffer nntp-server-buffer)
+ (save-restriction
+ (let* ((buffer-read-only nil)
+ (articles gnus-scores-articles)
+ (all-scores scores)
+ (request-func (cond ((string= "head" header)
+ 'gnus-request-head)
+ ;; We need to peek at the headers to detect
+ ;; the content encoding
+ ((string= "body" header)
+ 'gnus-request-article)
+ (t 'gnus-request-article)))
+ entries alist ofunc article last)
+ (when articles
+ (setq last (mail-header-number (caar (last articles))))
+ ;; Not all backends support partial fetching. In that case,
+ ;; we just fetch the entire article.
+ (unless (gnus-check-backend-function
+ (and (string-match "^gnus-" (symbol-name request-func))
+ (intern (substring (symbol-name request-func)
+ (match-end 0))))
+ gnus-newsgroup-name)
+ (setq ofunc request-func)
+ (setq request-func 'gnus-request-article))
+ (while articles
+ (setq article (mail-header-number (caar articles)))
+ (gnus-message 7 "Scoring article %s of %s..." article last)
+ (widen)
+ (let (handles)
+ (when (funcall request-func article gnus-newsgroup-name)
+ (when (string= "body" header)
+ (setq handles (gnus-score-decode-text-parts)))
+ (goto-char (point-min))
+ ;; If just parts of the article is to be searched, but the
+ ;; backend didn't support partial fetching, we just narrow
+ ;; to the relevant parts.
+ (when ofunc
+ (if (eq ofunc 'gnus-request-head)
+ (narrow-to-region
+ (point)
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (narrow-to-region
+ (or (search-forward "\n\n" nil t) (point))
+ (point-max))))
+ (setq scores all-scores)
+ ;; Find matches.
+ (while scores
+ (setq alist (pop scores)
+ entries (assoc header alist))
+ (while (cdr entries) ;First entry is the header index.
+ (let* ((rest (cdr entries))
+ (kill (car rest))
+ (match (nth 0 kill))
+ (type (or (nth 3 kill) 's))
+ (score (or (nth 1 kill)
+ gnus-score-interactive-default-score))
+ (date (nth 2 kill))
+ (found nil)
+ (case-fold-search
+ (not (or (eq type 'R) (eq type 'S)
+ (eq type 'Regexp) (eq type 'String))))
+ (search-func
+ (cond ((or (eq type 'r) (eq type 'R)
+ (eq type 'regexp) (eq type 'Regexp))
+ 're-search-forward)
+ ((or (eq type 's) (eq type 'S)
+ (eq type 'string) (eq type 'String))
+ 'search-forward)
+ (t
+ (error "Invalid match type: %s" type)))))
+ (goto-char (point-min))
+ (when (funcall search-func match nil t)
+ ;; Found a match, update scores.
+ (setcdr (car articles) (+ score (cdar articles)))
+ (setq found t)
+ (when trace
+ (push
+ (cons (car-safe (rassq alist gnus-score-cache))
+ kill)
+ gnus-score-trace)))
+ ;; Update expire date
+ (unless trace
+ (cond
+ ((null date)) ;Permanent entry.
+ ((and found gnus-update-score-entry-dates)
+ ;; Match, update date.
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now))
+ ((and expire (< date expire)) ;Old entry, remove.
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cdr rest))
+ (setq rest entries))))
+ (setq entries rest))))
+ (when handles (mm-destroy-parts handles))))
+ (setq articles (cdr articles)))))))
+ nil))
(defun gnus-score-thread (scores header now expire &optional trace)
(gnus-score-followup scores header now expire trace t))
;; Return whether this score file needs to be saved. By Je-haysuss!
updated))
-(defun gnus-score-regexp-bad-p (regexp)
- "Test whether REGEXP is safe for Gnus scoring.
-A regexp is unsafe if it matches newline or a buffer boundary.
-
-If the regexp is good, return nil. If the regexp is bad, return a
-cons cell (SYM . STRING), where the symbol SYM is `new' or `bad'.
-In the `new' case, the string is a safe replacement for REGEXP.
-In the `bad' case, the string is a unsafe subexpression of REGEXP,
-and we do not have a simple replacement to suggest.
-
-See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
- (let (case-fold-search)
- (and
- ;; First, try a relatively fast necessary condition.
- ;; Notice ranges (like [^:] or [\t-\r]), \s>, \Sw, \W, \', \`:
- (string-match "\n\\|\\\\[SsW`']\\|\\[\\^\\|[\0-\n]-" regexp)
- ;; Now break the regexp into tokens, and check each:
- (let ((tail regexp) ; remaining regexp to check
- tok ; current token
- bad ; nil, or bad subexpression
- new ; nil, or replacement regexp so far
- end) ; length of current token
- (while (and (not bad)
- (string-match
- "\\`\\(\\\\[sS]?.\\|\\[\\^?]?[^]]*]\\|[^\\]\\)"
- tail))
- (setq end (match-end 0)
- tok (substring tail 0 end)
- tail (substring tail end))
- (if;; Is token `bad' (matching newline or buffer ends)?
- (or (member tok '("\n" "\\W" "\\`" "\\'"))
- ;; This next handles "[...]", "\\s.", and "\\S.":
- (and (> end 2) (string-match tok "\n")))
- (let ((newtok
- ;; Try to suggest a replacement for tok ...
- (cond ((string-equal tok "\\`") "^") ; or "\\(^\\)"
- ((string-equal tok "\\'") "$") ; or "\\($\\)"
- ((string-match "\\[\\^" tok) ; very common
- (concat (substring tok 0 -1) "\n]")))))
- (if newtok
- (setq new
- (concat
- (or new
- ;; good prefix so far:
- (substring regexp 0 (- (+ (length tail) end))))
- newtok))
- ;; No replacement idea, so give up:
- (setq bad tok)))
- ;; tok is good, may need to extend new
- (and new (setq new (concat new tok)))))
- ;; Now return a value:
- (cond
- (bad (cons 'bad bad))
- (new (cons 'new new))
- (t nil))))))
-
(provide 'gnus-score)
;;; gnus-score.el ends here
(propertize (string 8206) 'invisible t)
""))
-(defun gnus-summary-line-format-spec ()
- (insert gnus-tmp-unread gnus-tmp-replied
- gnus-tmp-score-char gnus-tmp-indentation)
- (gnus-put-text-property
- (point)
- (progn
- (insert
- (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines
- (let ((val
- (inline
- (gnus-summary-from-or-to-or-newsgroups
- gnus-tmp-header gnus-tmp-from))))
- (if (> (length val) 23)
- (if (gnus-lrm-string-p val)
- (concat (substring val 0 23) gnus-lrm-string)
- (substring val 0 23))
- val))
- gnus-tmp-closing-bracket))
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject-or-nil "\n"))
-
-(defvar gnus-summary-line-format-spec
- (gnus-byte-code 'gnus-summary-line-format-spec))
-
-(defun gnus-summary-dummy-line-format-spec ()
- (insert "* ")
- (gnus-put-text-property
- (point)
- (progn
- (insert ": :")
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject "\n"))
-
-(defvar gnus-summary-dummy-line-format-spec
- (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
-
-(defun gnus-group-line-format-spec ()
- (insert gnus-tmp-marked-mark gnus-tmp-subscribed
- gnus-tmp-process-marked
- gnus-group-indentation
- (format "%5s: " gnus-tmp-number-of-unread))
- (gnus-put-text-property
- (point)
- (progn
- (insert gnus-tmp-group "\n")
- (1- (point)))
- gnus-mouse-face-prop gnus-mouse-face))
-(defvar gnus-group-line-format-spec
- (gnus-byte-code 'gnus-group-line-format-spec))
+(defvar gnus-summary-line-format-spec nil)
+(defvar gnus-summary-dummy-line-format-spec nil)
+(defvar gnus-group-line-format-spec nil)
(defvar gnus-format-specs
`((version . ,emacs-version)
- (gnus-version . ,(gnus-continuum-version))
- (group "%M\%S\%p\%P\%5y: %(%g%)\n" ,gnus-group-line-format-spec)
- (summary-dummy "* %(: :%) %S\n"
- ,gnus-summary-dummy-line-format-spec)
- (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
- ,gnus-summary-line-format-spec))
+ (gnus-version . ,(gnus-continuum-version)))
"Alist of format specs.")
(defvar gnus-default-format-specs gnus-format-specs)
(not (equal emacs-version
(cdr (assq 'version gnus-format-specs)))))
(setq gnus-format-specs nil))
- ;; Flush the group format spec cache if there's the grouplens stuff
- ;; or it doesn't support decoded group names.
- (when (memq 'group types)
- (let* ((spec (assq 'group gnus-format-specs))
- (sspec (gnus-prin1-to-string (nth 2 spec))))
- (when (or (string-match " gnus-tmp-grouplens[ )]" sspec)
- (not (string-match " gnus-tmp-decoded-group[ )]" sspec)))
- (setq gnus-format-specs (delq spec gnus-format-specs)))))
-
;; Go through all the formats and see whether they need updating.
(let (new-format entry type val updated)
(while (setq type (pop types))
(gnus-add-text-properties (point) (progn (eval form) (point)) props)
(eval form))))
-(defun gnus-compile ()
- "Byte-compile the user-defined format specs."
- (interactive)
- (require 'bytecomp)
- (let ((entries gnus-format-specs)
- (byte-compile-warnings '(unresolved callargs redefine))
- entry gnus-tmp-func)
- (save-excursion
- (gnus-message 7 "Compiling format specs...")
-
- (while entries
- (setq entry (pop entries))
- (if (memq (car entry) '(gnus-version version))
- (setq gnus-format-specs (delq entry gnus-format-specs))
- (let ((form (caddr entry)))
- (when (and (listp form)
- ;; Under GNU Emacs, it's (byte-code ...)
- (not (eq 'byte-code (car form)))
- ;; Under XEmacs, it's (funcall #<compiled-function ...>)
- (not (and (eq 'funcall (car form))
- (byte-code-function-p (cadr form)))))
- (defalias 'gnus-tmp-func `(lambda () ,form))
- (byte-compile 'gnus-tmp-func)
- (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))
-
- (push (cons 'version emacs-version) gnus-format-specs)
- ;; Mark the .newsrc.eld file as "dirty".
- (gnus-dribble-touch)
- (gnus-message 7 "Compiling user specs...done"))))
-
(defun gnus-set-format (type &optional insertable)
(set (intern (format "gnus-%s-line-format-spec" type))
(gnus-parse-format
(error "No such server: %s" server))
(gnus-server-set-status method 'ok)
(prog1
- (or (gnus-open-server method)
- (progn (message "Couldn't open %s" server) nil))
+ (gnus-open-server method)
(gnus-server-update-server server)
(gnus-server-position-point))))
(funcall gnus-group-change-level-function
group level oldlevel previous)))))
-(defun gnus-kill-newsgroup (newsgroup)
- "Obsolete function. Kills a newsgroup."
- (gnus-group-change-level
- (gnus-group-entry newsgroup) gnus-level-killed))
-
(defun gnus-check-bogus-newsgroups (&optional confirm)
"Remove bogus newsgroups.
If CONFIRM is non-nil, the user has to confirm the deletion of every
;; Return the new active info.
active)))))
-(defvar gnus-propagate-marks) ; gnus-sum
-
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when (and info active)
;; Allow the backend to update the info in the group.
(gnus-info-group info)))))
(gnus-activate-group (gnus-info-group info) nil t))
- ;; Allow backends to update marks,
- (when gnus-propagate-marks
- (let ((method (inline (gnus-find-method-for-group
- (gnus-info-group info)))))
- (when (gnus-check-backend-function 'request-marks (car method))
- (gnus-request-marks info method))))
-
(let* ((range (gnus-info-read info))
(num 0))
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
;; and compute how many unread articles there are in each group.
-(defun gnus-get-unread-articles (&optional level dont-connect)
+(defun gnus-get-unread-articles (&optional level dont-connect one-level)
(setq gnus-server-method-cache nil)
(require 'gnus-agent)
(let* ((newsrc (cdr gnus-newsrc-alist))
(push (setq method-group-list (list method method-type nil nil))
type-cache))
;; Only add groups that need updating.
- (if (<= (gnus-info-level info)
+ (if (funcall (if one-level #'= #'<=) (gnus-info-level info)
(if (eq (cadr method-group-list) 'foreign)
foreign-level
alevel))
(gnus-online method)
(gnus-agent-method-p method))
(progn
- (gnus-agent-save-active method)
+ (gnus-agent-save-active method t)
(gnus-active-to-gnus-format method hashtb nil real-active))
(goto-char (point-min))
:group 'gnus-summary-maneuvering
:type 'boolean)
-(defcustom gnus-auto-center-summary 2
+(defcustom gnus-auto-center-summary
+ (max (or (bound-and-true-p scroll-margin) 0) 2)
"*If non-nil, always center the current summary buffer.
In particular, if `vertical' do only vertical recentering. If non-nil
and non-`vertical', do both horizontal and vertical recentering."
:type 'boolean
:group 'gnus-summary-marks)
-(defcustom gnus-propagate-marks nil
- "If non-nil, Gnus will store and retrieve marks from the backends.
-This means that marks will be stored both in .newsrc.eld and in
-the backend, and will slow operation down somewhat."
- :type 'boolean
- :group 'gnus-summary-marks)
-
(defcustom gnus-alter-articles-to-read-function nil
"Function to be called to alter the list of articles to be selected."
:type '(choice (const nil) function)
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
[tab] gnus-summary-widget-forward
+ [backtab] gnus-summary-widget-backward
"t" gnus-summary-toggle-header
"g" gnus-summary-show-article
"l" gnus-summary-goto-last-article
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
[tab] gnus-summary-widget-forward
+ [backtab] gnus-summary-widget-backward
"P" gnus-summary-print-article
"S" gnus-sticky-article
"M" gnus-mailing-list-insinuate
(setq gnus-summary-tool-bar-map map))))
(set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
-(defun gnus-score-set-default (var value)
- "A version of set that updates the GNU Emacs menu-bar."
- (set var value)
- ;; It is the message that forces the active status to be updated.
- (message ""))
-
(defun gnus-make-score-map (type)
"Make a summary score map of type TYPE."
(if t
"Say whether this article is a sparse article or not."
`(memq ,article gnus-newsgroup-ancient))
-(defun gnus-article-parent-p (number)
- "Say whether this article is a parent or not."
- (let ((data (gnus-data-find-list number)))
- (and (cdr data) ; There has to be an article after...
- (< (gnus-data-level (car data)) ; And it has to have a higher level.
- (gnus-data-level (nth 1 data))))))
-
(defun gnus-article-children (number)
"Return a list of all children to NUMBER."
(let* ((data (gnus-data-find-list number))
"Say whether this article is intangible or not."
'(get-text-property (point) 'gnus-intangible))
-(defun gnus-article-read-p (article)
- "Say whether ARTICLE is read or not."
- (not (or (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-spam-marked)
- (memq article gnus-newsgroup-unreads)
- (memq article gnus-newsgroup-unselected)
- (memq article gnus-newsgroup-dormant))))
-
;; Some summary mode macros.
(defmacro gnus-summary-article-number ()
(push (eval (car locals)) vlist))
(setq locals (cdr locals)))
(setq vlist (nreverse vlist)))
- (with-current-buffer gnus-group-buffer
+ (with-temp-buffer
(setq gnus-newsgroup-name name
gnus-newsgroup-marked marked
gnus-newsgroup-spam-marked spam
;; Init the dependencies hash table.
(setq gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles)))
- (gnus-set-global-variables)
+ (if (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-set-global-variables)
+ (set-default 'gnus-newsgroup-name gnus-newsgroup-name))
;; Retrieve the headers and read them in.
(setq gnus-newsgroup-headers (gnus-fetch-headers articles))
(setq articles (cdr articles)))
out))
-(defun gnus-uncompress-marks (marks)
- "Uncompress the mark ranges in MARKS."
- (let ((uncompressed '(score bookmark))
- out)
- (while marks
- (if (memq (caar marks) uncompressed)
- (push (car marks) out)
- (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
- (setq marks (cdr marks)))
- out))
-
(defun gnus-article-mark-to-type (mark)
"Return the type of MARK."
(or (cadr (assq mark gnus-article-special-mark-lists))
(setq mark (car marks)
mark-type (gnus-article-mark-to-type mark)
var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
-
;; We set the variable according to the type of the marks list,
;; and then adjust the marks to a subset of the active articles.
(cond
(when (and (gnus-check-backend-function
'request-set-mark gnus-newsgroup-name)
- (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group gnus-newsgroup-name)
- 'server-marks))
(not (gnus-article-unpropagatable-p (cdr type))))
(let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
;; Don't do anything about marks for articles we
(info (nth 2 entry))
(active (gnus-active group))
(set-marks
- (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group group)
- 'server-marks)))
+ (gnus-method-option-p
+ (gnus-find-method-for-group group)
+ 'server-marks))
range)
(if (not entry)
;; Group that Gnus doesn't know exists, but still allow the
;; article if ID is a number -- so that the next `P' or `N'
;; command will fetch the previous (or next) article even
;; if the one we tried to fetch this time has been canceled.
- (when (> number gnus-newsgroup-end)
+ (unless (and gnus-newsgroup-end (< number gnus-newsgroup-end))
(setq gnus-newsgroup-end number))
- (when (< number gnus-newsgroup-begin)
+ (unless (and gnus-newsgroup-begin (> number gnus-newsgroup-begin))
(setq gnus-newsgroup-begin number))
(setq gnus-newsgroup-unselected
(delq number gnus-newsgroup-unselected)))
(gnus-summary-update-info))
(gnus-close-group group)
;; Make sure where we were, and go to next newsgroup.
- (set-buffer gnus-group-buffer)
+ (when (buffer-live-p (get-buffer gnus-group-buffer))
+ (set-buffer gnus-group-buffer))
(unless quit-config
(gnus-group-jump-to-group group))
(gnus-run-hooks 'gnus-summary-exit-hook)
(gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
- (set-buffer gnus-group-buffer)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
(if quit-config
(gnus-handle-ephemeral-exit quit-config)
(goto-char group-point)
"Handle movement when leaving an ephemeral group.
The state which existed when entering the ephemeral is reset."
(if (not (buffer-live-p (car quit-config)))
- (gnus-configure-windows 'group 'force)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-configure-windows 'group 'force))
(set-buffer (car quit-config))
(unless (eq (cdr quit-config) 'group)
(setq gnus-current-select-method
gnus-buttonized-mime-types)))
(gnus-summary-select-article nil 'force)))
-(defun gnus-summary-set-current-mark (&optional current-mark)
- "Obsolete function."
- nil)
-
(defun gnus-summary-next-article (&optional unread subject backward push)
"Select the next article.
If UNREAD, only unread articles are selected.
"Limit the summary buffer to articles that have authors that match a regexp.
If NOT-MATCHING, excluding articles that have authors that match a regexp."
(interactive
- (list (read-string (if current-prefix-arg
- "Exclude author (regexp): "
- "Limit to author (regexp): "))
+ (list (let* ((header (gnus-summary-article-header))
+ (default (and header (car (mail-header-parse-address
+ (mail-header-from header))))))
+ (read-string (concat (if current-prefix-arg
+ "Exclude author (regexp"
+ "Limit to author (regexp")
+ (if default
+ (concat ", default \"" default "\"): ")
+ "): "))
+ nil nil
+ default))
current-prefix-arg))
(gnus-summary-limit-to-subject from "from" not-matching))
(list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
- dig to-address)
+ dig to-address charset)
(with-current-buffer gnus-original-article-buffer
;; Have the digest group inherit the main mail address of
;; the parent article.
to-address))))))
(setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
(insert-buffer-substring gnus-original-article-buffer)
- ;; Remove lines that may lead nndoc to misinterpret the
- ;; document type.
(narrow-to-region
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (point)))
+ ;; Remove lines that may lead nndoc to misinterpret the
+ ;; document type.
(goto-char (point-min))
(delete-matching-lines "^Path:\\|^From ")
+ ;; Parse charset, and decode content transfer encoding.
+ (setq charset (mail-content-type-get
+ (mail-header-parse-content-type
+ (or (gnus-fetch-field "content-type") ""))
+ 'charset))
+ (let ((encoding (gnus-fetch-field "content-transfer-encoding")))
+ (when encoding
+ (message-remove-header "content-transfer-encoding")
+ (goto-char (point-max))
+ (widen)
+ (narrow-to-region (point) (point-max))
+ (mm-decode-content-transfer-encoding
+ (intern (downcase (mail-header-strip encoding))))))
(widen))
(unwind-protect
- (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
+ (if (let ((gnus-newsgroup-ephemeral-charset
+ (if charset
+ (intern (downcase (gnus-strip-whitespace charset)))
+ gnus-newsgroup-charset))
(gnus-newsgroup-ephemeral-ignored-charsets
gnus-newsgroup-ignored-charsets))
(gnus-group-read-ephemeral-group
(select-window (gnus-get-buffer-window gnus-article-buffer))
(widget-forward arg))
+(defun gnus-summary-widget-backward (arg)
+ "Move point to the previous field or button in the article.
+With optional ARG, move across that many fields."
+ (interactive "p")
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (select-window (gnus-get-buffer-window gnus-article-buffer))
+ (unless (widget-at (point))
+ (goto-char (point-max)))
+ (widget-backward arg))
+
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
to-group 'expire (list to-article) info))
(when (and to-marks
- (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group to-group)
- 'server-marks)))
+ (gnus-method-option-p
+ (gnus-find-method-for-group to-group)
+ 'server-marks))
(gnus-request-set-mark
to-group (list (list (list to-article) 'add to-marks)))))
(not (setq header (car (gnus-get-newsgroup-headers nil t)))))
() ; Malformed head.
(unless (gnus-summary-article-sparse-p (mail-header-number header))
+ (when (and (bound-and-true-p gnus-registry-enabled)
+ (not (gnus-ephemeral-group-p (car where))))
+ (gnus-registry-handle-action
+ (mail-header-id header) nil
+ (gnus-group-prefixed-name (car where) gnus-override-method)
+ (mail-header-subject header)
+ (mail-header-from header)))
(when (and (stringp id)
(or
(not (string= (gnus-group-real-name group)
(save-excursion
(let (setmarkundo)
;; Propagate the read marks to the backend.
- (when (and (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group group)
- 'server-marks))
+ (when (and (gnus-method-option-p
+ (gnus-find-method-for-group group)
+ 'server-marks)
(gnus-check-backend-function 'request-set-mark group))
(let ((del (gnus-remove-from-range (gnus-info-read info) read))
(add (gnus-remove-from-range read (gnus-info-read info))))
;; This is the gnus-sync.el package.
-;; It's due for a rewrite using gnus-after-set-mark-hook and
-;; gnus-before-update-mark-hook, and my plan is to do this once No
-;; Gnus development is done. Until then please consider it
-;; experimental.
-
;; Put this in your startup file (~/.gnus.el for instance)
;; possibilities for gnus-sync-backend:
;; Tramp over SSH: /ssh:user@host:/path/to/filename
-;; Tramp over IMAP: /imaps:user@yourhosthere.com:/INBOX.test/filename
;; ...or any other file Tramp and Emacs can handle...
;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded
-;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date)
-;; gnus-sync-newsrc-groups `("nntp" "nnrss")
-;; gnus-sync-newsrc-offsets `(2 3))
+;; gnus-sync-global-vars '(gnus-newsrc-last-checked-date)
+;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
+;; gnus-sync-newsrc-offsets '(2 3))
+;; against a LeSync server (beware the vampire LeSync, who knows your newsrc)
+
+;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz")
+;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
+
+;; What's a LeSync server?
+
+;; 1. install CouchDB, set up a real server admin user, and create a
+;; database, e.g. "tzz" and save the URL,
+;; e.g. http://lesync.info:5984/tzz
+
+;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)'
+
+;; (If you run it more than once, you have to remove the entry from
+;; _users yourself. This is intentional. This sets up a database
+;; admin for the "tzz" database, distinct from the server admin
+;; user in (1) above.)
+
+;; That's it, you can start using http://lesync.info:5984/tzz in your
+;; gnus-sync-backend as a LeSync backend. Fan fiction about the
+;; vampire LeSync is welcome.
+
+;; You may not want to expose a CouchDB install to the Big Bad
+;; Internet, especially if your love of all things furry would be thus
+;; revealed. Make sure it's not accessible by unauthorized users and
+;; guests, at least.
+
+;; If you want to try it out, I will create a test DB for you under
+;; http://lesync.info:5984/yourfavoritedbname
;; TODO:
-;; - after gnus-sync-read, the message counts are wrong. So it's not
-;; run automatically, you have to call it with M-x gnus-sync-read
+;; - after gnus-sync-read, the message counts look wrong until you do
+;; `g'. So it's not run automatically, you have to call it with M-x
+;; gnus-sync-read
;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to
;; catch the mark updates
+;; - repositioning of groups within topic after a LeSync sync is a
+;; weird sort of bubble sort ("buttle" sort: the old entry ends up
+;; at the rear of the list); you will eventually end up with the
+;; right order after calling `gnus-sync-read' a bunch of times.
+
+;; - installing topics and groups is inefficient and annoying, lots of
+;; prompts could be avoided
+
;;; Code:
(eval-when-compile (require 'cl))
+(require 'json)
(require 'gnus)
(require 'gnus-start)
(require 'gnus-util)
+(defvar gnus-topic-alist) ;; gnus-group.el
+(eval-when-compile
+ (autoload 'gnus-group-topic "gnus-topic")
+ (autoload 'gnus-topic-create-topic "gnus-topic" nil t)
+ (autoload 'gnus-topic-enter-dribble "gnus-topic"))
+
(defgroup gnus-sync nil
"The Gnus synchronization facility."
:version "24.1"
:group 'gnus)
-(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss")
+(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss")
"List of groups to be synchronized in the gnus-newsrc-alist.
The group names are matched, they don't have to be fully
qualified. Typically you would choose all of these. That's the
:group 'gnus-sync
:type '(repeat regexp))
-(defcustom gnus-sync-newsrc-offsets '(2 3)
- "List of per-group data to be synchronized."
- :group 'gnus-sync
- :type '(set (const :tag "Read ranges" 2)
- (const :tag "Marks" 3)))
-
(defcustom gnus-sync-global-vars nil
"List of global variables to be synchronized.
You may want to sync `gnus-newsrc-last-checked-date' but pretty
much any symbol is fair game. You could additionally sync
`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology',
-and `gnus-topic-alist' to cover all the variables in
-newsrc.eld (except for `gnus-format-specs' which should not be
-synchronized, I believe). Also see `gnus-variable-list'."
+and `gnus-topic-alist'. Also see `gnus-variable-list'."
:group 'gnus-sync
:type '(repeat (choice (variable :tag "A known variable")
(symbol :tag "Any symbol"))))
"The synchronization backend."
:group 'gnus-sync
:type '(radio (const :format "None" nil)
+ (list :tag "Sync server"
+ (const :format "LeSync Server API" lesync)
+ (string :tag "URL of a CouchDB database for API access"))
(string :tag "Sync to a file")))
(defvar gnus-sync-newsrc-loader nil
"Carrier for newsrc data")
-(defun gnus-sync-save ()
-"Save the Gnus sync data to the backend."
- (interactive)
+(defcustom gnus-sync-lesync-name (system-name)
+ "The LeSync name for this machine."
+ :group 'gnus-sync
+ :type 'string)
+
+(defcustom gnus-sync-lesync-install-topics 'ask
+ "Should LeSync install the recorded topics?"
+ :group 'gnus-sync
+ :type '(choice (const :tag "Never Install" nil)
+ (const :tag "Always Install" t)
+ (const :tag "Ask Me Once" ask)))
+
+(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal)
+ "LeSync props, keyed by group name")
+
+(defvar gnus-sync-lesync-design-prefix "/_design/lesync"
+ "The LeSync design prefix for CouchDB")
+
+(defvar gnus-sync-lesync-security-object "/_security"
+ "The LeSync security object for CouchDB")
+
+(defun gnus-sync-lesync-parse ()
+ "Parse the result of a LeSync request."
+ (goto-char (point-min))
+ (condition-case nil
+ (when (search-forward-regexp "^$" nil t)
+ (json-read))
+ (error
+ (gnus-message
+ 1
+ "gnus-sync-lesync-parse: Could not read the LeSync response!")
+ nil)))
+
+(defun gnus-sync-lesync-call (url method headers &optional kvdata)
+ "Make an access request to URL using KVDATA and METHOD.
+KVDATA must be an alist."
+ (flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch
+ (let ((url-request-method method)
+ (url-request-extra-headers headers)
+ (url-request-data (if kvdata (json-encode kvdata) nil)))
+ (with-current-buffer (url-retrieve-synchronously url)
+ (let ((data (gnus-sync-lesync-parse)))
+ (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S"
+ method url `((headers . ,headers) (data ,kvdata)) data)
+ (kill-buffer (current-buffer))
+ data)))))
+
+(defun gnus-sync-lesync-PUT (url headers &optional data)
+ (gnus-sync-lesync-call url "PUT" headers data))
+
+(defun gnus-sync-lesync-POST (url headers &optional data)
+ (gnus-sync-lesync-call url "POST" headers data))
+
+(defun gnus-sync-lesync-GET (url headers &optional data)
+ (gnus-sync-lesync-call url "GET" headers data))
+
+(defun gnus-sync-lesync-DELETE (url headers &optional data)
+ (gnus-sync-lesync-call url "DELETE" headers data))
+
+;; this is not necessary with newer versions of json.el but 1.2 or older
+;; (which are in Emacs 24.1 and earlier) need it
+(defun gnus-sync-json-alist-p (list)
+ "Non-null if and only if LIST is an alist."
+ (while (consp list)
+ (setq list (if (consp (car list))
+ (cdr list)
+ 'not-alist)))
+ (null list))
+
+;; this is not necessary with newer versions of json.el but 1.2 or older
+;; (which are in Emacs 24.1 and earlier) need it
+(defun gnus-sync-json-plist-p (list)
+ "Non-null if and only if LIST is a plist."
+ (while (consp list)
+ (setq list (if (and (keywordp (car list))
+ (consp (cdr list)))
+ (cddr list)
+ 'not-plist)))
+ (null list))
+
+; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)
+; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz")
+
+(defun gnus-sync-lesync-setup (url &optional user password salt reader admin)
+ (interactive "sEnter URL to set up: ")
+ "Set up the LeSync database at URL.
+Install USER as a READER and/or an ADMIN in the security object
+under \"_security\", and in the CouchDB \"_users\" table using
+PASSWORD and SALT. Only one USER is thus supported for now.
+When SALT is nil, a random one will be generated using `random'."
+ (let* ((design-url (concat url gnus-sync-lesync-design-prefix))
+ (security-object (concat url "/_security"))
+ (user-record `((names . [,user]) (roles . [])))
+ (couch-user-name (format "org.couchdb.user:%s" user))
+ (salt (or salt (sha1 (format "%s" (random)))))
+ (couch-user-record
+ `((_id . ,couch-user-name)
+ (type . user)
+ (name . ,(format "%s" user))
+ (roles . [])
+ (salt . ,salt)
+ (password_sha . ,(when password
+ (sha1
+ (format "%s%s" password salt))))))
+ (rev (progn
+ (gnus-sync-lesync-find-prop 'rev design-url design-url)
+ (gnus-sync-lesync-get-prop 'rev design-url)))
+ (latest-func "function(head,req)
+{
+ var tosend = [];
+ var row;
+ var ftime = (req.query['ftime'] || 0);
+ while (row = getRow())
+ {
+ if (row.value['float-time'] > ftime)
+ {
+ var s = row.value['_id'];
+ if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"');
+ }
+ }
+ send('['+tosend.join(',') + ']');
+}")
+;; <key>read</key>
+;; <dict>
+;; <key>de.alt.fan.ipod</key>
+;; <array>
+;; <integer>1</integer>
+;; <integer>2</integer>
+;; <dict>
+;; <key>start</key>
+;; <integer>100</integer>
+;; <key>length</key>
+;; <integer>100</integer>
+;; </dict>
+;; </array>
+;; </dict>
+ (xmlplistread-func "function(head, req) {
+ var row;
+ start({ 'headers': { 'Content-Type': 'text/xml' } });
+
+ send('<dict>');
+ send('<key>read</key>');
+ send('<dict>');
+ while(row = getRow())
+ {
+ var read = row.value.read;
+ if (read && read[0] && read[0] == 'invlist')
+ {
+ send('<key>'+row.key+'</key>');
+ //send('<invlist>'+read+'</invlist>');
+ send('<array>');
+
+ var from = 0;
+ var flip = false;
+
+ for (var i = 1; i < read.length && read[i]; i++)
+ {
+ var cur = read[i];
+ if (flip)
+ {
+ if (from == cur-1)
+ {
+ send('<integer>'+read[i]+'</integer>');
+ }
+ else
+ {
+ send('<dict>');
+ send('<key>start</key>');
+ send('<integer>'+from+'</integer>');
+ send('<key>end</key>');
+ send('<integer>'+(cur-1)+'</integer>');
+ send('</dict>');
+ }
+
+ }
+ flip = ! flip;
+ from = cur;
+ }
+ send('</array>');
+ }
+ }
+
+ send('</dict>');
+ send('</dict>');
+}
+")
+ (subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}")
+ (revs-func "function(doc){emit(doc._id, doc._rev);}")
+ (bytimesubs-func "function(doc)
+{emit([(doc['float-time']||0), doc._id], doc._rev);}")
+ (bytime-func "function(doc)
+{emit([(doc['float-time']||0), doc._id], doc);}")
+ (groups-func "function(doc){emit(doc._id, doc);}"))
+ (and (if user
+ (and (assq 'ok (gnus-sync-lesync-PUT
+ security-object
+ nil
+ (append (and reader
+ (list `(readers . ,user-record)))
+ (and admin
+ (list `(admins . ,user-record))))))
+ (assq 'ok (gnus-sync-lesync-PUT
+ (concat (file-name-directory url)
+ "_users/"
+ couch-user-name)
+ nil
+ couch-user-record)))
+ t)
+ (assq 'ok (gnus-sync-lesync-PUT
+ design-url
+ nil
+ `(,@(when rev (list (cons '_rev rev)))
+ (lists . ((latest . ,latest-func)
+ (xmlplistread . ,xmlplistread-func)))
+ (views . ((subs . ((map . ,subs-func)))
+ (revs . ((map . ,revs-func)))
+ (bytimesubs . ((map . ,bytimesubs-func)))
+ (bytime . ((map . ,bytime-func)))
+ (groups . ((map . ,groups-func)))))))))))
+
+(defun gnus-sync-lesync-find-prop (prop url key)
+ "Retrieve a PROPerty of a document KEY at URL.
+Calls `gnus-sync-lesync-set-prop'.
+For the 'rev PROP, uses '_rev against the document."
+ (gnus-sync-lesync-set-prop
+ prop key (cdr (assq (if (eq prop 'rev) '_rev prop)
+ (gnus-sync-lesync-GET url nil)))))
+
+(defun gnus-sync-lesync-set-prop (prop key val)
+ "Update the PROPerty of document KEY at URL to VAL.
+Updates `gnus-sync-lesync-props-hash'."
+ (puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash))
+
+(defun gnus-sync-lesync-get-prop (prop key)
+ "Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'."
+ (gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash))
+
+(defun gnus-sync-deep-print (data)
+ (let* ((print-quoted t)
+ (print-readably t)
+ (print-escape-multibyte nil)
+ (print-escape-nonascii t)
+ (print-length nil)
+ (print-level nil)
+ (print-circle nil)
+ (print-escape-newlines t))
+ (format "%S" data)))
+
+(defun gnus-sync-newsrc-loader-builder (&optional only-modified)
+ (let* ((entries (cdr gnus-newsrc-alist))
+ entry name ret)
+ (while entries
+ (setq entry (pop entries)
+ name (car entry))
+ (when (gnus-grep-in-list name gnus-sync-newsrc-groups)
+ (if only-modified
+ (when (not (equal (gnus-sync-deep-print entry)
+ (gnus-sync-lesync-get-prop 'checksum name)))
+ (gnus-message 9 "%s: add %s, it's modified"
+ "gnus-sync-newsrc-loader-builder" name)
+ (push entry ret))
+ (push entry ret))))
+ ret))
+
+; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)))
+(defun gnus-sync-range2invlist (ranges)
+ (append '(invlist)
+ (let ((ranges (delq nil ranges))
+ ret range from to)
+ (while ranges
+ (setq range (pop ranges))
+ (if (atom range)
+ (setq from range
+ to range)
+ (setq from (car range)
+ to (cdr range)))
+ (push from ret)
+ (push (1+ to) ret))
+ (reverse ret))))
+
+; (let* ((d '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)) (j (format "%S" (gnus-sync-invlist2range (gnus-sync-range2invlist d))))) (or (equal (format "%S" d) j) j))
+(defun gnus-sync-invlist2range (inv)
+ (setq inv (append inv nil))
+ (if (equal (format "%s" (car inv)) "invlist")
+ (let ((i (cdr inv))
+ (start 0)
+ ret cur top flip)
+ (while i
+ (setq cur (pop i))
+ (when flip
+ (setq top (1- cur))
+ (if (= start top)
+ (push start ret)
+ (push (cons start top) ret)))
+ (setq flip (not flip))
+ (setq start cur))
+ (reverse ret))
+ inv))
+
+(defun gnus-sync-position (search list &optional test)
+ "Find the position of SEARCH in LIST using TEST, defaulting to `eq'."
+ (let ((pos 0)
+ (test (or test 'eq)))
+ (while (and list (not (funcall test (car list) search)))
+ (pop list)
+ (incf pos))
+ (if (funcall test (car list) search) pos nil)))
+
+(defun gnus-sync-topic-group-position (group topic-name)
+ (gnus-sync-position
+ group (cdr (assoc topic-name gnus-topic-alist)) 'equal))
+
+(defun gnus-sync-fix-topic-group-position (group topic-name position)
+ (unless (equal position (gnus-sync-topic-group-position group topic-name))
+ (let* ((loc "gnus-sync-fix-topic-group-position")
+ (groups (delete group (cdr (assoc topic-name gnus-topic-alist))))
+ (position (min position (1- (length groups))))
+ (old (nth position groups)))
+ (when (and old (not (equal old group)))
+ (setf (nth position groups) group)
+ (setcdr (assoc topic-name gnus-topic-alist)
+ (append groups (list old)))
+ (gnus-message 9 "%s: %s moved to %d, swap with %s"
+ loc group position old)))))
+
+(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props)
+ (let* ((loc "gnus-sync-lesync-save-group-entry")
+ (k (car nentry))
+ (revision (gnus-sync-lesync-get-prop 'rev k))
+ (sname gnus-sync-lesync-name)
+ (topic (gnus-group-topic k))
+ (topic-offset (gnus-sync-topic-group-position k topic))
+ (sources (gnus-sync-lesync-get-prop 'source k)))
+ ;; set the revision so we don't have a conflict
+ `(,@(when revision
+ (list (cons '_rev revision)))
+ (_id . ,k)
+ ;; the time we saved
+ ,@passed-props
+ ;; add our name to the sources list for this key
+ (source ,@(if (member gnus-sync-lesync-name sources)
+ sources
+ (cons gnus-sync-lesync-name sources)))
+ ,(cons 'level (nth 1 nentry))
+ ,@(if topic (list (cons 'topic topic)) nil)
+ ,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil)
+ ;; the read marks
+ ,(cons 'read (gnus-sync-range2invlist (nth 2 nentry)))
+ ;; the other marks
+ ,@(delq nil (mapcar (lambda (mark-entry)
+ (gnus-message 12 "%s: prep param %s in %s"
+ loc
+ (car mark-entry)
+ (nth 3 nentry))
+ (if (listp (cdr mark-entry))
+ (cons (car mark-entry)
+ (gnus-sync-range2invlist
+ (cdr mark-entry)))
+ (progn ; else this is not a list
+ (gnus-message 9 "%s: non-list param %s in %s"
+ loc
+ (car mark-entry)
+ (nth 3 nentry))
+ nil)))
+ (nth 3 nentry))))))
+
+(defun gnus-sync-lesync-post-save-group-entry (url entry)
+ (let* ((loc "gnus-sync-lesync-post-save-group-entry")
+ (k (cdr (assq 'id entry))))
+ (cond
+ ;; success!
+ ((and (assq 'rev entry) (assq 'id entry))
+ (progn
+ (gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry)))
+ (gnus-sync-lesync-set-prop 'checksum
+ k
+ (gnus-sync-deep-print
+ (assoc k gnus-newsrc-alist)))
+ (gnus-message 9 "%s: successfully synced %s to %s"
+ loc k url)))
+ ;; specifically check for document conflicts
+ ((equal "conflict" (format "%s" (cdr-safe (assq 'error entry))))
+ (gnus-error
+ 1
+ "%s: use `%s' to resolve the conflict synchronizing %s to %s: %s"
+ loc "gnus-sync-read" k url (cdr (assq 'reason entry))))
+ ;; generic errors
+ ((assq 'error entry)
+ (gnus-error 1 "%s: got error while synchronizing %s to %s: %s"
+ loc k url (cdr (assq 'reason entry))))
+
+ (t
+ (gnus-message 2 "%s: unknown sync status after %s to %s: %S"
+ loc k url entry)))
+ (assoc 'error entry)))
+
+(defun gnus-sync-lesync-groups-builder (url)
+ (let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups")))
+ (cdr (assq 'rows (gnus-sync-lesync-GET u nil)))))
+
+(defun gnus-sync-subscribe-group (name)
+ "Subscribe to group NAME. Returns NAME on success, nil otherwise."
+ (gnus-subscribe-newsgroup name))
+
+(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props)
+ "Read ENTRY information for NAME. Returns NAME if successful.
+Skips entries whose sources don't contain
+`gnus-sync-lesync-name'. When the alist PASSED-PROPS has a
+`subscribe-all' element that evaluates to true, we attempt to
+subscribe to unknown groups. The user is also allowed to delete
+unwanted groups via the LeSync URL."
+ (let* ((loc "gnus-sync-lesync-read-group-entry")
+ (entry (gnus-sync-lesync-normalize-group-entry entry passed-props))
+ (subscribe-all (cdr (assq 'subscribe-all passed-props)))
+ (sources (cdr (assq 'source entry)))
+ (rev (cdr (assq 'rev entry)))
+ (in-sources (member gnus-sync-lesync-name sources))
+ (known (assoc name gnus-newsrc-alist))
+ cell)
+ (unless known
+ (if (and subscribe-all
+ (y-or-n-p (format "Subscribe to group %s?" name)))
+ (setq known (gnus-sync-subscribe-group name)
+ in-sources t)
+ ;; else...
+ (when (y-or-n-p (format "Delete group %s from server?" name))
+ (if (equal name (gnus-sync-lesync-delete-group url name))
+ (gnus-message 1 "%s: removed group %s from server %s"
+ loc name url)
+ (gnus-error 1 "%s: could not remove group %s from server %s"
+ loc name url)))))
+ (when known
+ (unless in-sources
+ (setq in-sources
+ (y-or-n-p
+ (format "Read group %s even though %s is not in sources %S?"
+ name gnus-sync-lesync-name (or sources ""))))))
+ (when rev
+ (gnus-sync-lesync-set-prop 'rev name rev))
+
+ ;; if the source matches AND we have this group
+ (if (and known in-sources)
+ (progn
+ (gnus-message 10 "%s: reading LeSync entry %s, sources %S"
+ loc name sources)
+ (while entry
+ (setq cell (pop entry))
+ (let ((k (car cell))
+ (val (cdr cell)))
+ (gnus-sync-lesync-set-prop k name val)))
+ name)
+ ;; else...
+ (unless known
+ (gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed. %s"
+ loc name "Call `gnus-sync-read' with C-u to force it."))
+ (unless in-sources
+ (gnus-message 5 "%s: ignoring entry %s, %s not in sources %S"
+ loc name gnus-sync-lesync-name (or sources "")))
+ nil)))
+
+(defun gnus-sync-lesync-install-group-entry (name)
+ (let* ((master (assoc name gnus-newsrc-alist))
+ (old-topic-name (gnus-group-topic name))
+ (old-topic (assoc old-topic-name gnus-topic-alist))
+ (target-topic-name (gnus-sync-lesync-get-prop 'topic name))
+ (target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name))
+ (target-topic (assoc target-topic-name gnus-topic-alist))
+ (loc "gnus-sync-lesync-install-group-entry"))
+ (if master
+ (progn
+ (when (eq 'ask gnus-sync-lesync-install-topics)
+ (setq gnus-sync-lesync-install-topics
+ (y-or-n-p "Install topics from LeSync?")))
+ (when (and (eq t gnus-sync-lesync-install-topics)
+ target-topic-name)
+ (if (equal old-topic-name target-topic-name)
+ (gnus-message 12 "%s: %s is already in topic %s"
+ loc name target-topic-name)
+ ;; see `gnus-topic-move-group'
+ (when (and old-topic target-topic)
+ (setcdr old-topic (gnus-delete-first name (cdr old-topic)))
+ (gnus-message 5 "%s: removing %s from topic %s"
+ loc name old-topic-name))
+ (unless target-topic
+ (when (y-or-n-p (format "Create missing topic %s?"
+ target-topic-name))
+ (gnus-topic-create-topic target-topic-name nil)
+ (setq target-topic (assoc target-topic-name
+ gnus-topic-alist))))
+ (if target-topic
+ (prog1
+ (nconc target-topic (list name))
+ (gnus-message 5 "%s: adding %s to topic %s"
+ loc name (car target-topic))
+ (gnus-topic-enter-dribble))
+ (gnus-error 2 "%s: LeSync group %s can't go in missing topic %s"
+ loc name target-topic-name)))
+ (when (and target-topic-offset target-topic)
+ (gnus-sync-fix-topic-group-position
+ name target-topic-name target-topic-offset)))
+ ;; install the subscription level
+ (when (gnus-sync-lesync-get-prop 'level name)
+ (setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name)))
+ ;; install the read and other marks
+ (setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name))
+ (setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name))
+ (gnus-sync-lesync-set-prop 'checksum
+ name
+ (gnus-sync-deep-print master))
+ nil)
+ (gnus-error 1 "%s: invalid LeSync group %s" loc name)
+ 'invalid-name)))
+
+; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot")
+
+(defun gnus-sync-lesync-delete-group (url name)
+ "Returns NAME if successful deleting it from URL, an error otherwise."
+ (interactive "sEnter URL to set up: \rsEnter group name: ")
+ (let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name)))
+ (del (gnus-sync-lesync-DELETE
+ u
+ `(,@(when (gnus-sync-lesync-get-prop 'rev name)
+ (list (cons "If-Match"
+ (gnus-sync-lesync-get-prop 'rev name))))))))
+ (or (cdr (assq 'id del)) del)))
+
+;;; (gnus-sync-lesync-normalize-group-entry '((subscribe . ["invlist"]) (read . ["invlist"]) (topic-offset . 20) (topic . "news") (level . 6) (source . ["a" "b"]) (float-time . 1319671237.099285) (_rev . "10-edf5107f41e5e6f7f6629d1c0ee172f7") (_id . "nntp+news.net:alt.movies")) '((read-time 1319672156.486414) (subscribe-all nil)))
+
+(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props)
+ (let (ret
+ marks
+ cell)
+ (setq entry (append passed-props entry))
+ (while (setq cell (pop entry))
+ (let ((k (car cell))
+ (val (cdr cell)))
+ (cond
+ ((eq k 'read)
+ (push (cons k (gnus-sync-invlist2range val)) ret))
+ ;; we ignore these parameters
+ ((member k '(_id subscribe-all _deleted_conflicts))
+ nil)
+ ((eq k '_rev)
+ (push (cons 'rev val) ret))
+ ((eq k 'source)
+ (push (cons 'source (append val nil)) ret))
+ ((or (eq k 'float-time)
+ (eq k 'level)
+ (eq k 'topic)
+ (eq k 'topic-offset)
+ (eq k 'read-time))
+ (push (cons k val) ret))
+;;; "How often have I said to you that when you have eliminated the
+;;; impossible, whatever remains, however improbable, must be the
+;;; truth?" --Sherlock Holmes
+ ;; everything remaining must be a mark
+ (t (push (cons k (gnus-sync-invlist2range val)) marks)))))
+ (cons (cons 'marks marks) ret)))
+
+(defun gnus-sync-save (&optional force)
+"Save the Gnus sync data to the backend.
+With a prefix, FORCE is set and all groups will be saved."
+ (interactive "P")
(cond
+ ((and (listp gnus-sync-backend)
+ (eq (nth 0 gnus-sync-backend) 'lesync)
+ (stringp (nth 1 gnus-sync-backend)))
+
+ ;; refresh the revisions if we're forcing the save
+ (when force
+ (mapc (lambda (entry)
+ (when (and (assq 'key entry)
+ (assq 'value entry))
+ (gnus-sync-lesync-set-prop
+ 'rev
+ (cdr (assq 'key entry))
+ (cdr (assq 'value entry)))))
+ ;; the revs view is key = name, value = rev
+ (cdr (assq 'rows (gnus-sync-lesync-GET
+ (concat (nth 1 gnus-sync-backend)
+ gnus-sync-lesync-design-prefix
+ "/_view/revs")
+ nil)))))
+
+ (let* ((ftime (float-time))
+ (url (nth 1 gnus-sync-backend))
+ (entries
+ (mapcar (lambda (entry)
+ (gnus-sync-lesync-pre-save-group-entry
+ (cadr gnus-sync-backend)
+ entry
+ (cons 'float-time ftime)))
+ (gnus-sync-newsrc-loader-builder (not force))))
+ ;; when there are no entries, there's nothing to save
+ (sync (if entries
+ (gnus-sync-lesync-POST
+ (concat url "/_bulk_docs")
+ '(("Content-Type" . "application/json"))
+ `((docs . ,(vconcat entries nil))))
+ (gnus-message
+ 2 "gnus-sync-save: nothing to save to the LeSync backend")
+ nil)))
+ (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e))
+ sync)))
((stringp gnus-sync-backend)
- (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend)
+ (gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend)
;; populate gnus-sync-newsrc-loader from all but the first dummy
;; entry in gnus-newsrc-alist whose group matches any of the
;; gnus-sync-newsrc-groups
;; TODO: keep the old contents for groups we don't have!
- (let ((gnus-sync-newsrc-loader
- (loop for entry in (cdr gnus-newsrc-alist)
- when (gnus-grep-in-list
- (car entry) ;the group name
- gnus-sync-newsrc-groups)
- collect (cons (car entry)
- (mapcar (lambda (offset)
- (cons offset (nth offset entry)))
- gnus-sync-newsrc-offsets)))))
+ (let ((gnus-sync-newsrc-loader (gnus-sync-newsrc-loader-builder)))
(with-temp-file gnus-sync-backend
(progn
(let ((coding-system-for-write gnus-ding-file-coding-system)
(princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
gnus-ding-file-coding-system))
(princ ";; Gnus sync data v. 0.0.1\n")
+ ;; TODO: replace with `gnus-sync-deep-print'
(let* ((print-quoted t)
(print-readably t)
(print-escape-multibyte nil)
(princ (symbol-name variable)))))
(gnus-message
7
- "gnus-sync: stored variables %s and %d groups in %s"
+ "gnus-sync-save: stored variables %s and %d groups in %s"
gnus-sync-global-vars
(length gnus-sync-newsrc-loader)
gnus-sync-backend)
;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
;; Save the .eld file with extra line breaks.
- (gnus-message 8 "gnus-sync: adding whitespace to %s"
+ (gnus-message 8 "gnus-sync-save: adding whitespace to %s"
gnus-sync-backend)
(save-excursion
(goto-char (point-min))
;; the pass-through case: gnus-sync-backend is not a known choice
(nil)))
-(defun gnus-sync-read ()
-"Load the Gnus sync data from the backend."
- (interactive)
+(defun gnus-sync-read (&optional subscribe-all)
+ "Load the Gnus sync data from the backend.
+With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed."
+ (interactive "P")
(when gnus-sync-backend
- (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend)
- (cond ((stringp gnus-sync-backend)
- ;; read data here...
- (if (or debug-on-error debug-on-quit)
- (load gnus-sync-backend nil t)
- (condition-case var
- (load gnus-sync-backend nil t)
- (error
- (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
- (let ((valid-count 0)
- invalid-groups)
- (dolist (node gnus-sync-newsrc-loader)
- (if (gnus-gethash (car node) gnus-newsrc-hashtb)
- (progn
- (incf valid-count)
- (loop for store in (cdr node)
- do (setf (nth (car store)
- (assoc (car node) gnus-newsrc-alist))
- (cdr store))))
- (push (car node) invalid-groups)))
- (gnus-message
- 7
- "gnus-sync: loaded %d groups (out of %d) from %s"
- valid-count (length gnus-sync-newsrc-loader)
- gnus-sync-backend)
- (when invalid-groups
- (gnus-message
- 7
- "gnus-sync: skipped %d groups (out of %d) from %s"
- (length invalid-groups)
- (length gnus-sync-newsrc-loader)
- gnus-sync-backend)
- (gnus-message 9 "gnus-sync: skipped groups: %s"
- (mapconcat 'identity invalid-groups ", ")))))
- (nil))
- ;; make the hashtable again because the newsrc-alist may have been modified
- (when gnus-sync-newsrc-offsets
- (gnus-message 9 "gnus-sync: remaking the newsrc hashtable")
- (gnus-make-hashtable-from-newsrc-alist))))
+ (gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend)
+ (cond
+ ((and (listp gnus-sync-backend)
+ (eq (nth 0 gnus-sync-backend) 'lesync)
+ (stringp (nth 1 gnus-sync-backend)))
+ (let ((errored nil)
+ name ftime)
+ (mapc (lambda (entry)
+ (setq name (cdr (assq 'id entry)))
+ ;; set ftime the FIRST time through this loop, that
+ ;; way it reflects the time we FINISHED reading
+ (unless ftime (setq ftime (float-time)))
+
+ (unless errored
+ (setq errored
+ (when (equal name
+ (gnus-sync-lesync-read-group-entry
+ (nth 1 gnus-sync-backend)
+ name
+ (cdr (assq 'value entry))
+ `(read-time ,ftime)
+ `(subscribe-all ,subscribe-all)))
+ (gnus-sync-lesync-install-group-entry
+ (cdr (assq 'id entry)))))))
+ (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend)))))
+
+ ((stringp gnus-sync-backend)
+ ;; read data here...
+ (if (or debug-on-error debug-on-quit)
+ (load gnus-sync-backend nil t)
+ (condition-case var
+ (load gnus-sync-backend nil t)
+ (error
+ (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
+ (let ((valid-count 0)
+ invalid-groups)
+ (dolist (node gnus-sync-newsrc-loader)
+ (if (gnus-gethash (car node) gnus-newsrc-hashtb)
+ (progn
+ (incf valid-count)
+ (loop for store in (cdr node)
+ do (setf (nth (car store)
+ (assoc (car node) gnus-newsrc-alist))
+ (cdr store))))
+ (push (car node) invalid-groups)))
+ (gnus-message
+ 7
+ "gnus-sync-read: loaded %d groups (out of %d) from %s"
+ valid-count (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (when invalid-groups
+ (gnus-message
+ 7
+ "gnus-sync-read: skipped %d groups (out of %d) from %s"
+ (length invalid-groups)
+ (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (gnus-message 9 "gnus-sync-read: skipped groups: %s"
+ (mapconcat 'identity invalid-groups ", ")))))
+ (nil))
+
+ (gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable")
+ (gnus-make-hashtable-from-newsrc-alist)))
;;;###autoload
(defun gnus-sync-initialize ()
(defun gnus-sync-unload-hook ()
"Uninstall the sync hooks."
(interactive)
- (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
- (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
- (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
+ (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook)
-;; this is harmless by default, until the gnus-sync-backend is set
-(gnus-sync-initialize)
+(when gnus-sync-backend (gnus-sync-initialize))
(provide 'gnus-sync)
(setq alist (cdr alist)))
out))
-(defun gnus-group-parent-topic (group)
- "Return the topic GROUP is member of by looking at the group buffer."
- (with-current-buffer gnus-group-buffer
- (if (gnus-group-goto-group group)
- (gnus-current-topic)
- (gnus-group-topic group))))
-
(defun gnus-topic-goto-topic (topic)
(when topic
(gnus-goto-char (text-property-any (point-min) (point-max)
`(delete-region (point-at-bol)
(progn (forward-line ,(or n 1)) (point))))
-(defun gnus-byte-code (func)
- "Return a form that can be `eval'ed based on FUNC."
- (let ((fval (indirect-function func)))
- (if (byte-code-function-p fval)
- (let ((flist (append fval nil)))
- (setcar flist 'byte-code)
- flist)
- (cons 'progn (cddr fval)))))
-
(defun gnus-extract-address-components (from)
"Extract address components from a From header.
Given an RFC-822 address FROM, extract full name and canonical address.
(match-end 0)))))
(list (if (string= name "") nil name) (or address from))))
-(defun gnus-extract-address-component-name (from)
- "Extract name from a From header.
-Uses `gnus-extract-address-components'."
- (nth 0 (gnus-extract-address-components from)))
-
-(defun gnus-extract-address-component-email (from)
- "Extract e-mail address from a From header.
-Uses `gnus-extract-address-components'."
- (nth 1 (gnus-extract-address-components from)))
-
(declare-function message-fetch-field "message" (header &optional not-all))
(defun gnus-fetch-field (field)
;; should be gnus-characterp, but this can't be called in XEmacs anyway
(cons (and (numberp event) event) event)))
-(defun gnus-sortable-date (date)
- "Make string suitable for sorting from DATE."
- (gnus-time-iso8601 (date-to-time date)))
-
(defun gnus-copy-file (file &optional to)
"Copy FILE to TO."
(interactive
(unless dir
(delete-directory directory)))))
-;; The following two functions are used in gnus-registry.
-;; They were contributed by Andreas Fuchs <asf@void.at>.
-(defun gnus-alist-to-hashtable (alist)
- "Build a hashtable from the values in ALIST."
- (let ((ht (make-hash-table
- :size 4096
- :test 'equal)))
- (mapc
- (lambda (kv-pair)
- (puthash (car kv-pair) (cdr kv-pair) ht))
- alist)
- ht))
-
-(defun gnus-hashtable-to-alist (hash)
- "Build an alist from the values in HASH."
- (let ((list nil))
- (maphash
- (lambda (key value)
- (setq list (cons (cons key value) list)))
- hash)
- list))
-
(defun gnus-strip-whitespace (string)
"Return STRING stripped of all whitespace."
(while (string-match "[\r\n\t ]+" string)
(with-current-buffer gnus-group-buffer
(eq major-mode 'gnus-group-mode))))
-(defun gnus-process-live-p (process)
- "Returns non-nil if PROCESS is alive.
-A process is considered alive if its status is `run', `open',
-`listen', `connect' or `stop'."
- (memq (process-status process)
- '(run open listen connect stop)))
-
(defun gnus-remove-if (predicate sequence &optional hash-table-p)
"Return a copy of SEQUENCE with all items satisfying PREDICATE removed.
SEQUENCE should be a list, a vector, or a string. Returns always a list.
image)))
image)))
+(defun gnus-recursive-directory-files (dir)
+ "Return all regular files below DIR."
+ (let (files)
+ (dolist (file (directory-files dir t))
+ (when (and (not (member (file-name-nondirectory file) '("." "..")))
+ (file-readable-p file))
+ (cond
+ ((file-regular-p file)
+ (push file files))
+ ((file-directory-p file)
+ (setq files (append (gnus-recursive-directory-files file) files))))))
+ files))
+
(defun gnus-list-memq-of-list (elements list)
"Return non-nil if any of the members of ELEMENTS are in LIST."
(let ((found nil))
(save-match-data
(string-match regexp string start))))
+(if (fboundp 'string-prefix-p)
+ (defalias 'gnus-string-prefix-p 'string-prefix-p)
+ (defun gnus-string-prefix-p (str1 str2 &optional ignore-case)
+ "Return non-nil if STR1 is a prefix of STR2.
+If IGNORE-CASE is non-nil, the comparison is done without paying attention
+to case differences."
+ (and (<= (length str1) (length str2))
+ (let ((prefix (substring str2 0 (length str1))))
+ (if ignore-case
+ (string-equal (downcase str1) (downcase prefix))
+ (string-equal str1 prefix))))))
+
(eval-and-compile
(if (fboundp 'macroexpand-all)
(defalias 'gnus-macroexpand-all 'macroexpand-all)
(defun gnus-bound-and-true-p (sym)
(and (boundp sym) (symbol-value sym)))
+(if (fboundp 'timer--function)
+ (defalias 'gnus-timer--function 'timer--function)
+ (defun gnus-timer--function (timer)
+ (elt timer 5)))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
gnus-shell-command-separator " sh")))))
state))
-;; Returns the name of what the shar file is going to unpack.
-(defun gnus-uu-find-name-in-shar ()
- (let ((oldpoint (point))
- res)
- (goto-char (point-min))
- (when (re-search-forward gnus-uu-shar-name-marker nil t)
- (setq res (buffer-substring (match-beginning 1) (match-end 1))))
- (goto-char oldpoint)
- res))
-
;; `gnus-uu-choose-action' chooses what action to perform given the name
;; and `gnus-uu-file-action-list'. Returns either nil if no action is
;; found, or the name of the command to run if such a rule is found.
(defun gnus-configure-frame (split &optional window)
"Split WINDOW according to SPLIT."
- (let* ((current-window (or (get-buffer-window (current-buffer)) (selected-window)))
+ (let* ((current-window (or (get-buffer-window (current-buffer))
+ (selected-window)))
(window (or window current-window)))
(select-window window)
;; The SPLIT might be something that is to be evalled to
(let ((buf (gnus-get-buffer-create
(gnus-window-to-buffer-helper buffer))))
(when (buffer-name buf)
- (if (eq buf (window-buffer (selected-window)))
- (set-buffer buf)
- (switch-to-buffer buf))))
+ (cond
+ ((eq buf (window-buffer (selected-window)))
+ (set-buffer buf))
+ ((eq t (window-dedicated-p
+ ;; XEmacs version of `window-dedicated-p' requires it.
+ (selected-window)))
+ ;; If the window is hard-dedicated, we have a problem because
+ ;; we just can't do what we're asked. But signaling an error,
+ ;; like `switch-to-buffer' would do, is not an option because
+ ;; it would prevent things like "^" (to jump to the *Servers*)
+ ;; in a dedicated *Group*.
+ ;; FIXME: Maybe a better/additional fix would be to change
+ ;; gnus-configure-windows so that when called
+ ;; from a hard-dedicated frame, it creates (and
+ ;; configures) a new frame, leaving the dedicated frame alone.
+ (pop-to-buffer buf))
+ (t (switch-to-buffer buf)))))
(when (memq 'frame-focus split)
(setq gnus-window-frame-focus window))
;; We return the window if it has the `point' spec.
;; fashion.
(setq comp-subs (nreverse comp-subs))
(while comp-subs
- (if (null (cdr comp-subs))
- (setq new-win window)
- (setq new-win
+ (setq new-win
+ (if (null (cdr comp-subs))
+ window
(split-window window (cadar comp-subs)
(eq type 'horizontal))))
(setq result (or (gnus-configure-frame
(purp "#9999cc" "#666699")
(no "#ff0000" "#ffff00")
(neutral "#b4b4b4" "#878787")
+ (ma "#2020e0" "#8080ff")
(september "#bf9900" "#ffcc00"))
"Color alist used for the Gnus logo.")
-(defcustom gnus-logo-color-style 'no
+(defcustom gnus-logo-color-style 'ma
"*Color styles used for the Gnus logo."
:type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
gnus-logo-color-alist))
:type '(choice (const :tag "current" nil)
directory))
-;; Site dependent variables. These variables should be defined in
-;; paths.el.
+;; Site dependent variables.
-(defvar gnus-default-nntp-server nil
- "Specify a default NNTP server.
-This variable should be defined in paths.el, and should never be set
-by the user.
-If you want to change servers, you should use `gnus-select-method'.
-See the documentation to that variable.")
+;; Should this be obsolete?
+(defcustom gnus-default-nntp-server nil
+ "The hostname of the default NNTP server.
+The empty string, or nil, means to use the local host.
+You may wish to set this on a site-wide basis.
+
+If you want to change servers, you should use `gnus-select-method'."
+ :group 'gnus-server
+ :type '(choice (const :tag "local host" nil)
+ (string :tag "host name")))
(defcustom gnus-nntpserver-file "/etc/nntpserver"
"A file with only the name of the nntp server in it."
There is a lot more to know about select methods and virtual servers -
see the manual for details."
+ ;; Emacs has set-after since 22.1.
+ ;set-after '(gnus-default-nntp-server)
:group 'gnus-server
:group 'gnus-start
:initialize 'custom-initialize-default
(const :format "%v " mail)
(const :format "%v " none)
(const post-mail))
- (checklist :inline t
+ (checklist :inline t :greedy t
(const :format "%v " address)
(const :format "%v " prompt-address)
(const :format "%v " physical-address)
- (const :format "%v " virtual)
- (const respool))))
+ (const virtual)
+ (const :format "%v " respool)
+ (const server-marks))))
:version "24.1")
(defun gnus-redefine-select-method-widget ()
("gnus-kill" gnus-kill gnus-apply-kill-file-internal
gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
+ ("gnus-registry" gnus-try-warping-via-registry
+ gnus-registry-handle-action)
("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
gnus-cache-possibly-remove-articles gnus-cache-request-article
gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
(t ;Has positive number
(eq (gnus-request-type group article) 'news)))) ;use it.
-;; Returns a list of writable groups.
-(defun gnus-writable-groups ()
- (let ((alist gnus-newsrc-alist)
- groups group)
- (while (setq group (car (pop alist)))
- (unless (gnus-group-read-only-p group)
- (push group groups)))
- (nreverse groups)))
-
;; Check whether to use long file names.
(defun gnus-use-long-file-name (symbol)
;; The variable has to be set...
group
(concat (gnus-method-to-server-name method) ":" group)))
-(defun gnus-group-guess-prefixed-name (group)
- "Guess the whole name from GROUP and METHOD."
- (gnus-group-prefixed-name group (gnus-find-method-for-group
- group)))
-
(defun gnus-group-full-name (group method)
"Return the full name from GROUP and METHOD, even if the method is native."
(gnus-group-prefixed-name group method t))
-(defun gnus-group-guess-full-name (group)
- "Guess the full name from GROUP, even if the method is native."
- (if (gnus-group-prefixed-p group)
- group
- (gnus-group-full-name group (gnus-find-method-for-group group))))
-
(defun gnus-group-guess-full-name-from-command-method (group)
"Guess the full name from GROUP, even if the method is native."
(if (gnus-group-prefixed-p group)
"Go through PARAMETERS and expand them according to the match data."
(let (new)
(dolist (elem parameters)
- (if (and (stringp (cdr elem))
- (string-match "\\\\[0-9&]" (cdr elem)))
- (push (cons (car elem)
- (gnus-expand-group-parameter match (cdr elem) group))
- new)
- (push elem new)))
+ (cond
+ ((and (stringp (cdr elem))
+ (string-match "\\\\[0-9&]" (cdr elem)))
+ (push (cons (car elem)
+ (gnus-expand-group-parameter match (cdr elem) group))
+ new))
+ ;; For `sieve' group parameters, perform substitutions for every
+ ;; string within the match rule. This allows for parameters such
+ ;; as:
+ ;; ("list\\.\\(.*\\)"
+ ;; (sieve header :is "list-id" "<\\1.domain.org>"))
+ ((eq 'sieve (car elem))
+ (push (mapcar (lambda (sieve-elem)
+ (if (and (stringp sieve-elem)
+ (string-match "\\\\[0-9&]" sieve-elem))
+ (gnus-expand-group-parameter match sieve-elem
+ group)
+ sieve-elem))
+ (cdr elem))
+ new))
+ (t
+ (push elem new))))
new))
(defun gnus-group-fast-parameter (group symbol &optional allow-list)
(when this-result
(setq result (car this-result))
;; Expand if necessary.
- (if (and (stringp result) (string-match "\\\\[0-9&]" result))
- (setq result (gnus-expand-group-parameter
- (car head) result group)))))))
+ (cond
+ ((and (stringp result) (string-match "\\\\[0-9&]" result))
+ (setq result (gnus-expand-group-parameter
+ (car head) result group)))
+ ;; For `sieve' group parameters, perform substitutions
+ ;; for every string within the match rule (see above).
+ ((eq symbol 'sieve)
+ (setq result
+ (mapcar (lambda (elem)
+ (if (stringp elem)
+ (gnus-expand-group-parameter (car head)
+ elem group)
+ elem))
+ result))))))))
;; Done.
result))))
(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
(defun gnus-agent-unhook-expire-days (converting-to)
- "Remove every lambda from gnus-group-prepare-hook that mention the
-symbol gnus-agent-do-once in their definition. This should NOT be
+ "Remove every lambda from `gnus-group-prepare-hook' that mention the
+symbol `gnus-agent-do-once' in their definition. This should NOT be
necessary as gnus-agent.el no longer adds them. However, it is
possible that the hook was persistently saved."
- (let ((h t)) ; iterate from bgn of hook
+ (let ((h t)) ; Iterate from bgn of hook.
(while h
(let ((func (progn (when (eq h t)
- ;; init h to list of functions
+ ;; Init h to list of functions.
(setq h (cond ((listp gnus-group-prepare-hook)
gnus-group-prepare-hook)
((boundp 'gnus-group-prepare-hook)
(list gnus-group-prepare-hook)))))
(pop h))))
- (when (cond ((eq (type-of func) 'compiled-function)
- ;; Search def. of compiled function for gnus-agent-do-once string
+ (when (cond ((byte-code-function-p func)
+ ;; Search def. of compiled function for
+ ;; gnus-agent-do-once string.
(let* (definition
print-level
print-length
(standard-output
(lambda (char)
(setq definition (cons char definition)))))
- (princ func) ; populates definition with reversed list of characters
+ (princ func) ; Populates definition with reversed list
+ ; of characters.
(let* ((i (length definition))
(s (make-string i 0)))
(while definition
(string-match "\\bgnus-agent-do-once\\b" s))))
((listp func)
- (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda
+ (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles eval'd lambda.
))
(remove-hook 'gnus-group-prepare-hook func)
;; Return whether we moved successfully or not.
to)))
-(defun mail-source-movemail-and-remove (from to)
- "Move FROM to TO using movemail, then remove FROM if empty."
- (or (not (mail-source-movemail from to))
- (not (zerop (nth 7 (file-attributes from))))
- (delete-file from)))
-
(defun mail-source-fetch-with-program (program)
(eq 0 (call-process shell-file-name nil nil nil
shell-command-switch program)))
:type 'symbol)
(defcustom message-dont-reply-to-names
- (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
+ (and (boundp 'mail-dont-reply-to-names) mail-dont-reply-to-names)
"*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 "21.1"
+ :version "24.3"
:group 'message
:link '(custom-manual "(message)Wide Reply")
:type '(choice (const :tag "Yourself" nil)
(autoload 'nndraft-request-associate-buffer "nndraft")
(autoload 'nndraft-request-expire-articles "nndraft")
(autoload 'nnvirtual-find-group-art "nnvirtual")
-(autoload 'rmail-dont-reply-to "mail-utils")
(autoload 'rmail-msg-is-pruned "rmail")
(autoload 'rmail-output "rmailout")
+;; Emacs < 24.1 do not have mail-dont-reply-to
+(unless (fboundp 'mail-dont-reply-to)
+ (defalias 'mail-dont-reply-to 'rmail-dont-reply-to))
+
\f
;;;
(interactive)
(let ((start (point)))
(message-skip-to-next-address)
- (kill-region start (point))))
+ (kill-region start (if (bolp) (1- (point)) (point)))))
(autoload 'Info-goto-node "info")
(defun message-goto-to ()
"Move point to the To header."
(interactive)
+ (push-mark)
(message-position-on-field "To"))
(defun message-goto-from ()
"Move point to the From header."
(interactive)
+ (push-mark)
(message-position-on-field "From"))
(defun message-goto-subject ()
"Move point to the Subject header."
(interactive)
+ (push-mark)
(message-position-on-field "Subject"))
(defun message-goto-cc ()
"Move point to the Cc header."
(interactive)
+ (push-mark)
(message-position-on-field "Cc" "To"))
(defun message-goto-bcc ()
"Move point to the Bcc header."
(interactive)
+ (push-mark)
(message-position-on-field "Bcc" "Cc" "To"))
(defun message-goto-fcc ()
"Move point to the Fcc header."
(interactive)
+ (push-mark)
(message-position-on-field "Fcc" "To" "Newsgroups"))
(defun message-goto-reply-to ()
"Move point to the Reply-To header."
(interactive)
+ (push-mark)
(message-position-on-field "Reply-To" "Subject"))
(defun message-goto-newsgroups ()
"Move point to the Newsgroups header."
(interactive)
+ (push-mark)
(message-position-on-field "Newsgroups"))
(defun message-goto-distribution ()
"Move point to the Distribution header."
(interactive)
+ (push-mark)
(message-position-on-field "Distribution"))
(defun message-goto-followup-to ()
"Move point to the Followup-To header."
(interactive)
+ (push-mark)
(message-position-on-field "Followup-To" "Newsgroups"))
(defun message-goto-mail-followup-to ()
"Move point to the Mail-Followup-To header."
(interactive)
+ (push-mark)
(message-position-on-field "Mail-Followup-To" "To"))
(defun message-goto-keywords ()
"Move point to the Keywords header."
(interactive)
+ (push-mark)
(message-position-on-field "Keywords" "Subject"))
(defun message-goto-summary ()
"Move point to the Summary header."
(interactive)
+ (push-mark)
(message-position-on-field "Summary" "Subject"))
(eval-when-compile
(when (and (message-called-interactively-p 'any)
(looking-at "[ \t]*\n"))
(expand-abbrev))
+ (push-mark)
(goto-char (point-min))
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
(search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
(defun message-in-body-p ()
"Return t if point is in the message body."
- (let ((body (save-excursion (message-goto-body))))
- (>= (point) body)))
+ (>= (point)
+ (save-excursion
+ (goto-char (point-min))
+ (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
+ (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))
+ (point))))
(defun message-goto-eoh ()
"Move point to the end of the headers."
If there is no signature in the article, go to the end and
return nil."
(interactive)
+ (push-mark)
(goto-char (point-min))
(if (re-search-forward message-signature-separator nil t)
(forward-line 1)
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
(interactive)
- (when (and (message-position-on-field "Newsgroups")
- (mail-fetch-field "newsgroups")
- (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
- (insert ","))
- (insert (or (message-fetch-reply-field "newsgroups") "")))
+ (let ((old-newsgroups (mail-fetch-field "newsgroups"))
+ (new-newsgroups (message-fetch-reply-field "newsgroups"))
+ (first t)
+ insert-newsgroups)
+ (message-position-on-field "Newsgroups")
+ (cond
+ ((not new-newsgroups)
+ (error "No Newsgroups to insert"))
+ ((not old-newsgroups)
+ (insert new-newsgroups))
+ (t
+ (setq new-newsgroups (split-string new-newsgroups "[, ]+")
+ old-newsgroups (split-string old-newsgroups "[, ]+"))
+ (dolist (group new-newsgroups)
+ (unless (member group old-newsgroups)
+ (push group insert-newsgroups)))
+ (if (null insert-newsgroups)
+ (error "Newgroup%s already in the header"
+ (if (> (length new-newsgroups) 1)
+ "s" ""))
+ (when old-newsgroups
+ (setq first nil))
+ (dolist (group insert-newsgroups)
+ (unless first
+ (insert ","))
+ (setq first nil)
+ (insert group)))))))
\f
(save-current-buffer
(dolist (buffer (buffer-list t))
(set-buffer buffer)
- (when (and (eq major-mode 'message-mode)
+ (when (and (derived-mode-p 'message-mode)
(null message-sent-message-via))
(push (buffer-name buffer) buffers))))
(nreverse buffers)))
(forward-char -1)
nil))))
-(defun message-remove-signature ()
- "Remove the signature from the text between point and mark.
-The text will also be indented the normal way."
- (save-excursion
- (let ((start (point))
- mark)
- (if (not (re-search-forward message-signature-separator (mark t) t))
- ;; No signature here, so we just indent the cited text.
- (message-indent-citation)
- ;; Find the last non-empty line.
- (forward-line -1)
- (while (looking-at "[ \t]*$")
- (forward-line -1))
- (forward-line 1)
- (setq mark (set-marker (make-marker) (point)))
- (goto-char start)
- (message-indent-citation)
- ;; Enable undoing the deletion.
- (undo-boundary)
- (delete-region mark (mark t))
- (set-marker mark nil)))))
-
\f
;;;
(end-of-line)
(insert (format " (%d/%d)" n total))
(widen)
- (funcall (or message-send-mail-real-function
- message-send-mail-function)))
+ (if message-send-mail-real-function
+ (funcall message-send-mail-real-function)
+ (message-multi-smtp-send-mail)))
(setq n (+ n 1))
(setq p (pop plist))
(erase-buffer)))
")))
(progn
(message "Sending via mail...")
- (funcall (or message-send-mail-real-function
- message-send-mail-function)))
+ (if message-send-mail-real-function
+ (funcall message-send-mail-real-function)
+ (message-multi-smtp-send-mail)))
(message-send-mail-partially))
(setq options message-options))
(kill-buffer tembuf))
(push 'mail message-sent-message-via)))
(defvar sendmail-program)
+(defvar smtpmail-smtp-user)
+
+(defun message-multi-smtp-send-mail ()
+ "Send the current buffer to `message-send-mail-function'.
+Or, if there's a header that specifies a different method, use
+that instead."
+ (let ((method (message-field-value "X-Message-SMTP-Method")))
+ (if (not method)
+ (funcall message-send-mail-function)
+ (message-remove-header "X-Message-SMTP-Method")
+ (setq method (split-string method))
+ (cond
+ ((equal (car method) "sendmail")
+ (message-send-mail-with-sendmail))
+ ((equal (car method) "smtp")
+ (require 'smtpmail)
+ (let ((smtpmail-smtp-server (nth 1 method))
+ (smtpmail-smtp-service (nth 2 method))
+ (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user)))
+ (message-smtpmail-send-it)))
+ (t
+ (error "Unknown method %s" method))))))
(defun message-send-mail-with-sendmail ()
"Send off the prepared buffer with sendmail."
(require 'sha1)
(let (sha1-maximum-internal-length)
(sha1 (concat (message-unique-id)
- (format "%x%x%x" (random)
- (progn (random t) (random))
- (random))
+ (format "%x%x%x" (random) (random) (random))
(prin1-to-string (recent-keys))
(prin1-to-string (garbage-collect))))))
;; You might for example insert a "." somewhere (not next to another dot
;; or string boundary), or modify the "fsf" string.
(defun message-unique-id ()
- (random t)
;; Don't use microseconds from (current-time), they may be unsupported.
;; Instead we use this randomly inited counter.
(setq message-unique-id-char
(concat system-name
".i-did-not-set--mail-host-address--so-tickle-me")))))
-(defun message-make-host-name ()
- "Return the name of the host."
- (let ((fqdn (message-make-fqdn)))
- (string-match "^[^.]+\\." fqdn)
- (substring fqdn 0 (1- (match-end 0)))))
-
(defun message-make-domain ()
"Return the domain name."
(or mail-host-address
(while (and (not (= (point) end))
(or (not (eq char ?,))
quoted))
- (skip-chars-forward "^,\"" (point-max))
+ (skip-chars-forward "^,\"" end)
(when (eq (setq char (following-char)) ?\")
(setq quoted (not quoted)))
(unless (= (point) end)
(forward-char 1)))
(skip-chars-forward " \t\n")))
-(defun message-fill-address (header value)
- (insert (capitalize (symbol-name header))
- ": "
- (if (consp value) (car value) value)
- "\n")
- (message-fill-field-address))
-
(defun message-split-line ()
"Split current line, moving portion beyond point vertically down.
If the current line has `message-yank-prefix', insert it on the new line."
(point-max))))
(defun message-fill-field-address ()
- (while (not (eobp))
- (message-skip-to-next-address)
- (let (last)
- (if (and (> (current-column) 78)
- last)
- (progn
- (save-excursion
- (goto-char last)
- (insert "\n\t"))
- (setq last (1+ (point))))
- (setq last (1+ (point)))))))
+ (let (end last)
+ (while (not end)
+ (message-skip-to-next-address)
+ (cond ((bolp)
+ (end-of-line 0)
+ (setq end 1))
+ ((eobp)
+ (setq end 0)))
+ (when (and (> (current-column) 78)
+ last)
+ (save-excursion
+ (goto-char last)
+ (delete-char (- (skip-chars-backward " \t")))
+ (insert "\n\t")))
+ (setq last (point)))
+ (forward-line end)))
(defun message-fill-field-general ()
(let ((begin (point))
;; Squeeze whitespace.
(while (string-match "[ \t][ \t]+" recipients)
(setq recipients (replace-match " " t t recipients)))
- ;; Remove addresses that match `rmail-dont-reply-to-names'.
- (let ((rmail-dont-reply-to-names (message-dont-reply-to-names)))
- (setq recipients (rmail-dont-reply-to recipients)))
+ ;; Remove addresses that match `mail-dont-reply-to-names'.
+ (let ((mail-dont-reply-to-names (message-dont-reply-to-names)))
+ (setq recipients (mail-dont-reply-to recipients)))
;; Perhaps "Mail-Copies-To: never" removed the only address?
(if (string-equal recipients "")
(setq recipients author))
(message "Resending message to %s..." address)
(save-excursion
(let ((cur (current-buffer))
- beg)
+ gcc beg)
;; We first set up a normal mail buffer.
(unless (message-mail-user-agent)
(set-buffer (get-buffer-create " *message resend*"))
;; Insert our usual headers.
(message-generate-headers '(From Date To Message-ID))
(message-narrow-to-headers)
+ (when (setq gcc (mail-fetch-field "gcc" nil t))
+ (message-remove-header "gcc"))
;; Remove X-Draft-From header etc.
(message-remove-header message-ignored-mail-headers t)
;; Rename them all to "Resent-*".
message-generate-hashcash
rfc2047-encode-encoded-words)
(message-send-mail))
+ (when gcc
+ (message-goto-eoh)
+ (insert "Gcc: " gcc "\n"))
+ (run-hooks 'message-sent-hook)
(kill-buffer (current-buffer)))
(message "Resending message to %s...done" address)))
--- /dev/null
+;;; mm-archive.el --- Functions for parsing archive files as MIME
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'mm-decode)
+(eval-when-compile
+ (autoload 'gnus-recursive-directory-files "gnus-util")
+ (autoload 'mailcap-extension-to-mime "mailcap"))
+
+(defvar mm-archive-decoders
+ '(("application/ms-tnef" t "tnef" "-f" "-" "-C")
+ ("application/zip" nil "unzip" "-j" "-x" "%f" "-d")
+ ("application/x-gtar-compressed" nil "tar" "xzf" "-" "-C")
+ ("application/x-tar" nil "tar" "xf" "-" "-C")))
+
+(defun mm-archive-decoders () mm-archive-decoders)
+
+(defun mm-dissect-archive (handle)
+ (let ((decoder (cddr (assoc (car (mm-handle-type handle))
+ mm-archive-decoders)))
+ (dir (mm-make-temp-file
+ (expand-file-name "emm." mm-tmp-directory) 'dir)))
+ (set-file-modes dir #o700)
+ (unwind-protect
+ (progn
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (if (member "%f" decoder)
+ (let ((file (expand-file-name "mail.zip" dir)))
+ (write-region (point-min) (point-max) file nil 'silent)
+ (setq decoder (copy-sequence decoder))
+ (setcar (member "%f" decoder) file)
+ (apply 'call-process (car decoder) nil nil nil
+ (append (cdr decoder) (list dir)))
+ (delete-file file))
+ (apply 'call-process-region (point-min) (point-max) (car decoder)
+ nil (get-buffer-create "*tnef*")
+ nil (append (cdr decoder) (list dir)))))
+ `("multipart/mixed"
+ ,handle
+ ,@(mm-archive-list-files (gnus-recursive-directory-files dir))))
+ (delete-directory dir t))))
+
+(defun mm-archive-list-files (files)
+ (let ((handles nil)
+ type disposition)
+ (dolist (file files)
+ (with-temp-buffer
+ (when (string-match "\\.\\([^.]+\\)$" file)
+ (setq type (mailcap-extension-to-mime (match-string 1 file))))
+ (unless type
+ (setq type "application/octet-stream"))
+ (setq disposition
+ (if (string-match "^image/\\|^text/" type)
+ "inline"
+ "attachment"))
+ (insert (format "Content-type: %s\n" type))
+ (insert "Content-Transfer-Encoding: 8bit\n\n")
+ (insert-file-contents file)
+ (push
+ (mm-make-handle (mm-copy-to-buffer)
+ (list type)
+ '8bit nil
+ `(,disposition (filename . ,file))
+ nil nil nil)
+ handles)))
+ handles))
+
+(defun mm-archive-dissect-and-inline (handle)
+ (let ((start (point-marker)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (dolist (handle (cddr (mm-dissect-archive handle)))
+ (goto-char (point-max))
+ (mm-display-inline handle))
+ (goto-char (point-max))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let ((inhibit-read-only t)
+ (end ,(point-marker)))
+ (remove-images ,start end)
+ (delete-region ,start end)))))))
+
+(provide 'mm-archive)
+
+;; mm-archive.el ends here
(autoload 'mm-extern-cache-contents "mm-extern")
(autoload 'mm-insert-inline "mm-view")
+(autoload 'mm-archive-decoders "mm-archive")
+(autoload 'mm-archive-dissect-and-inline "mm-archive")
+(autoload 'mm-dissect-archive "mm-archive")
+
(defvar gnus-current-window-configuration)
(add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
("message/partial" mm-inline-partial identity)
("message/external-body" mm-inline-external-body identity)
("text/.*" mm-inline-text identity)
+ ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity)
+ ("application/zip" mm-archive-dissect-and-inline identity)
("audio/wav" mm-inline-audio
(lambda (handle)
(and (or (featurep 'nas-sound) (featurep 'native-sound))
(ignore-errors
(if (fboundp 'create-image)
(create-image (buffer-string) 'imagemagick 'data-p)
- (mm-create-image-xemacs (mm-handle-media-subtype handle))))))
+ (mm-create-image-xemacs
+ (mm-handle-media-subtype handle))))))
(when image
(setcar (cdr handle) (list "image/imagemagick"))
(mm-image-fit-p handle)))))))
"application/pgp-signature" "application/x-pkcs7-signature"
"application/pkcs7-signature" "application/x-pkcs7-mime"
"application/pkcs7-mime"
+ "application/x-gtar-compressed"
+ "application/x-tar"
+ "application/zip"
;; Mutt still uses this even though it has already been withdrawn.
"application/pgp")
"List of media types that are to be displayed inline.
(defvar mm-last-shell-command "")
(defvar mm-content-id-alist nil)
(defvar mm-postponed-undisplay-list nil)
+(defvar mm-inhibit-auto-detect-attachment nil)
;; According to RFC2046, in particular, in a digest, the default
;; Content-Type value for a body part is changed from "text/plain" to
(autoload 'message-fetch-field "message")
(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
- "Dissect the current buffer and return a list of MIME handles."
+ "Dissect the current buffer and return a list of MIME handles.
+If NO-STRICT-MIME, don't require the message to have a
+MIME-Version header before proceeding."
(save-excursion
(let (ct ctl type subtype cte cd description id result)
(save-restriction
(if (equal "text/plain" (car ctl))
(assoc 'format ctl)
t))
- (mm-make-handle
- (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+ ;; Guess what the type of application/octet-stream parts should
+ ;; really be.
+ (let ((filename (cdr (assq 'filename (cdr cdl)))))
+ (when (and (not mm-inhibit-auto-detect-attachment)
+ (equal (car ctl) "application/octet-stream")
+ filename
+ (string-match "\\.\\([^.]+\\)$" filename))
+ (let ((new-type (mailcap-extension-to-mime (match-string 1 filename))))
+ (when new-type
+ (setcar ctl new-type)))))
+ (let ((handle
+ (mm-make-handle
+ (mm-copy-to-buffer) ctl cte nil cdl description nil id))
+ (decoder (assoc (car ctl) (mm-archive-decoders))))
+ (if (and decoder
+ ;; Do automatic decoding
+ (cadr decoder)
+ (executable-find (caddr decoder)))
+ (mm-dissect-archive handle)
+ handle))))
(defun mm-dissect-multipart (ctl from)
(goto-char (point-min))
(goto-char (point-max))
(if (re-search-backward close-delimiter nil t)
(match-beginning 0)
- (point-max)))))
+ (point-max))))
+ (mm-inhibit-auto-detect-attachment
+ (equal (car ctl) "multipart/encrypted")))
(setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
(while (and (< (point) end) (re-search-forward boundary end t))
(goto-char (match-beginning 0))
(mail-content-type-get
(mm-handle-type handle) 'name)
"<file>"))
- (external mm-enable-external))
- (if (and (mm-inlinable-p ehandle)
- (mm-inlined-p ehandle))
- (progn
- (forward-line 1)
- (mm-display-inline handle)
- 'inline)
- (when (or method
- (not no-default))
- (if (and (not method)
- (equal "text" (car (split-string type "/"))))
- (progn
- (forward-line 1)
- (mm-insert-inline handle (mm-get-part handle))
- 'inline)
- (setq external
- (and method ;; If nil, we always use "save".
+ (external mm-enable-external)
+ (decoder (assoc (car (mm-handle-type handle))
+ (mm-archive-decoders))))
+ (cond
+ ((and decoder
+ (executable-find (caddr decoder)))
+ (mm-archive-dissect-and-inline handle)
+ 'inline)
+ ((and (mm-inlinable-p ehandle)
+ (mm-inlined-p ehandle))
+ (forward-line 1)
+ (mm-display-inline handle)
+ 'inline)
+ ((or method
+ (not no-default))
+ (if (and (not method)
+ (equal "text" (car (split-string type "/"))))
+ (progn
+ (forward-line 1)
+ (mm-insert-inline handle (mm-get-part handle))
+ 'inline)
+ (setq external
+ (and method ;; If nil, we always use "save".
(stringp method) ;; 'mailcap-save-binary-file
(or (eq mm-enable-external t)
(and (eq mm-enable-external 'ask)
(concat
" \"" (format method filename) "\"")
"")
- "? "))))))
- (if external
- (mm-display-external
- handle (or method 'mailcap-save-binary-file))
+ "? "))))))
+ (if external
(mm-display-external
- handle 'mailcap-save-binary-file)))))))))
+ handle (or method 'mailcap-save-binary-file))
+ (mm-display-external
+ handle 'mailcap-save-binary-file)))))))))
(declare-function gnus-configure-windows "gnus-win" (setting &optional force))
(defvar mailcap-mime-extensions) ; mailcap-mime-info autoloads
shell-command-switch command)
(set-process-sentinel
(get-buffer-process buffer)
- (lexical-let ;; Don't use `let'.
- ;; Function used to remove temp file and directory.
- ((fn `(lambda nil
- ;; Don't use `ignore-errors'.
- (condition-case nil
- (delete-file ,file)
- (error))
- (condition-case nil
- (delete-directory
- ,(file-name-directory file))
- (error))))
- ;; Form uses to kill the process buffer and
- ;; remove the undisplayer.
- (fm `(progn
- (kill-buffer ,buffer)
- ,(macroexpand
- (list 'mm-handle-set-undisplayer
- (list 'quote handle)
- nil))))
- ;; Message to be issued when the process exits.
- (done (format "Displaying %s...done" command))
- ;; In particular, the timer object (which is
- ;; a vector in Emacs but is a list in XEmacs)
- ;; requires that it is lexically scoped.
- (timer (run-at-time 30.0 nil 'ignore)))
- (if (featurep 'xemacs)
- (lambda (process state)
- (when (eq 'exit (process-status process))
- (if (memq timer itimer-list)
- (set-itimer-function timer fn)
- (funcall fn))
- (ignore-errors (eval fm))
- (message "%s" done)))
- (lambda (process state)
- (when (eq 'exit (process-status process))
- (if (memq timer timer-list)
- (timer-set-function timer fn)
- (funcall fn))
- (ignore-errors (eval fm))
- (message "%s" done)))))))
+ (lexical-let ((outbuf outbuf)
+ (file file)
+ (buffer buffer)
+ (command command)
+ (handle handle))
+ (run-at-time
+ 30.0 nil
+ (lambda ()
+ (ignore-errors
+ (delete-file file))
+ (ignore-errors
+ (delete-directory (file-name-directory file)))))
+ (lambda (process state)
+ (when (eq (process-status process) 'exit)
+ (condition-case nil
+ (delete-file file)
+ (error))
+ (condition-case nil
+ (delete-directory (file-name-directory file))
+ (error))
+ (when (buffer-live-p outbuf)
+ (with-current-buffer outbuf
+ (let ((buffer-read-only nil)
+ (point (point)))
+ (forward-line 2)
+ (mm-insert-inline
+ handle (with-current-buffer buffer
+ (buffer-string)))
+ (goto-char point))))
+ (when (buffer-live-p buffer)
+ (kill-buffer buffer)))
+ (message "Displaying %s...done" command)))))
(mm-handle-set-external-undisplayer
handle (cons file buffer)))
(message "Displaying %s..." command))
(insert (prog1
(if (and charset
(setq charset
- (mm-charset-to-coding-system charset))
+ (mm-charset-to-coding-system charset
+ nil t))
(not (eq charset 'ascii)))
(mm-decode-coding-string (buffer-string) charset)
(mm-string-as-multibyte (buffer-string)))
(while (search-forward "" nil t)
(replace-match "" t t))
(libxml-parse-html-region (point-min) (point-max))))
+ (unless (bobp)
+ (insert "\n"))
(mm-handle-set-undisplayer
handle
`(lambda ()
(provide 'mm-decode)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; mm-decode.el ends here
(autoload 'mml-compute-boundary "mml")
-(defun mm-url-encode-multipart-form-data (pairs &optional boundary)
- "Return PAIRS encoded in multipart/form-data."
- ;; RFC1867
-
- ;; Get a good boundary
- (unless boundary
- (setq boundary (mml-compute-boundary '())))
-
- (concat
-
- ;; Start with the boundary
- "--" boundary "\r\n"
-
- ;; Create name value pairs
- (mapconcat
- 'identity
- ;; Delete any returned items that are empty
- (delq nil
- (mapcar (lambda (data)
- (when (car data)
- ;; For each pair
- (concat
-
- ;; Encode the name
- "Content-Disposition: form-data; name=\""
- (car data) "\"\r\n"
- "Content-Type: text/plain; charset=utf-8\r\n"
- "Content-Transfer-Encoding: binary\r\n\r\n"
-
- (cond ((stringp (cdr data))
- (cdr data))
- ((integerp (cdr data))
- (int-to-string (cdr data))))
-
- "\r\n")))
- pairs))
- ;; use the boundary as a separator
- (concat "--" boundary "\r\n"))
-
- ;; put a boundary at the end.
- "--" boundary "--\r\n"))
-
-(defun mm-url-fetch-form (url pairs)
- "Fetch a form from URL with PAIRS as the data using the POST method."
- (mm-url-load-url)
- (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun mm-url-fetch-simple (url content)
- (mm-url-load-url)
- (let ((url-request-data content)
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
(defun mm-url-remove-markup ()
"Remove all HTML markup, leaving just plain text."
(goto-char (point-min))
(unless filename
(setq filename buffer-file-name))
(save-excursion
- (let ((decomp (unless ;; No worth to examine charset of tar files.
+ (let ((decomp (unless ;; Not worth it to examine charset of tar files.
(and filename
(string-match
"\\.\\(?:tar\\.[^.]+\\|tbz\\|tgz\\)\\'"
(defun mm-inline-audio (handle)
(message "Not implemented"))
-(defun mm-view-sound-file ()
- (message "Not implemented"))
-
(defun mm-w3-prepare-buffer ()
(require 'w3)
(let ((url-standalone-mode t)
(defvar mml-multipart-number 0)
(defvar mml-inhibit-compute-boundary nil)
-(defun mml-generate-mime ()
- "Generate a MIME message based on the current MML document."
+(defun mml-generate-mime (&optional multipart-type)
+ "Generate a MIME message based on the current MML document.
+MULTIPART-TYPE defaults to \"mixed\", but can also
+be \"related\" or \"alternate\"."
(let ((cont (mml-parse))
(mml-multipart-number mml-multipart-number)
(options message-options))
(if (and (consp (car cont))
(= (length cont) 1))
(mml-generate-mime-1 (car cont))
- (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed"))
- cont)))
+ (mml-generate-mime-1
+ (nconc (list 'multipart (cons 'type (or multipart-type "mixed")))
+ cont)))
(setq options message-options)
(buffer-string))
(setq message-options options)))))
(defun mml-attach-file (file &optional type description disposition)
"Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
-`\\[message-send-and-exit]' or `\\[message-send]'.
+`\\[message-send-and-exit]' or `\\[message-send]' in Message mode,
+or `\\[mail-send-and-exit]' or `\\[mail-send]' in Mail mode.
FILE is the name of the file to attach. TYPE is its
content-type, a string of the form \"type/subtype\". DESCRIPTION
(description (mml-minibuffer-read-description))
(disposition (mml-minibuffer-read-disposition type nil file)))
(list file type description disposition)))
- ;; Don't move point if this command is invoked inside the message header.
- (let ((head (unless (message-in-body-p)
- (prog1
- (point)
- (goto-char (point-max))))))
+ ;; If in the message header, attach at the end and leave point unchanged.
+ (let ((head (unless (message-in-body-p) (point))))
+ (if head (goto-char (point-max)))
(mml-insert-empty-tag 'part
'type type
;; icicles redefines read-file-name and returns a
'filename (mm-substring-no-properties file)
'disposition (or disposition "attachment")
'description description)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(when head
- (unless (prog1
- (pos-visible-in-window-p)
- (goto-char head))
+ (unless (pos-visible-in-window-p)
(message "The file \"%s\" has been attached at the end of the message"
- (file-name-nondirectory file))))))
+ (file-name-nondirectory file)))
+ (goto-char head))))
(defun mml-dnd-attach-file (uri action)
"Attach a drag and drop file.
(description (mml-minibuffer-read-description))
(disposition (mml-minibuffer-read-disposition type nil)))
(list buffer type description disposition)))
- ;; Don't move point if this command is invoked inside the message header.
- (let ((head (unless (message-in-body-p)
- (prog1
- (point)
- (goto-char (point-max))))))
+ ;; If in the message header, attach at the end and leave point unchanged.
+ (let ((head (unless (message-in-body-p) (point))))
+ (if head (goto-char (point-max)))
(mml-insert-empty-tag 'part 'type type 'buffer buffer
'disposition disposition
'description description)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(when head
- (unless (prog1
- (pos-visible-in-window-p)
- (goto-char head))
+ (unless (pos-visible-in-window-p)
(message
"The buffer \"%s\" has been attached at the end of the message"
- buffer)))))
+ buffer))
+ (goto-char head))))
(defun mml-attach-external (file &optional type description)
"Attach an external file into the buffer.
(type (mml-minibuffer-read-type file))
(description (mml-minibuffer-read-description)))
(list file type description)))
- ;; Don't move point if this command is invoked inside the message header.
- (let ((head (unless (message-in-body-p)
- (prog1
- (point)
- (goto-char (point-max))))))
+ ;; If in the message header, attach at the end and leave point unchanged.
+ (let ((head (unless (message-in-body-p) (point))))
+ (if head (goto-char (point-max)))
(mml-insert-empty-tag 'external 'type type 'name file
'disposition "attachment" 'description description)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(when head
- (unless (prog1
- (pos-visible-in-window-p)
- (goto-char head))
+ (unless (pos-visible-in-window-p)
(message "The file \"%s\" has been attached at the end of the message"
- (file-name-nondirectory file))))))
+ (file-name-nondirectory file)))
+ (goto-char head))))
(defun mml-insert-multipart (&optional type)
(interactive (if (message-in-body-p)
(or type
(setq type "mixed"))
(mml-insert-empty-tag "multipart" 'type type)
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(forward-line -1))
(defun mml-insert-part (&optional type)
(interactive (if (message-in-body-p)
(list (mml-minibuffer-read-type ""))
(error "Use this command in the message body")))
+ ;; When using Mail mode, make sure it does the mime encoding
+ ;; when you send the message.
+ (or (eq mail-user-agent 'message-user-agent)
+ (setq mail-encode-mml t))
(mml-insert-tag 'part 'type type 'disposition "inline"))
(declare-function message-subscribed-p "message" ())
(require 'mm-util)
(eval-when-compile (require 'cl))
-(declare-function nndraft-request-list "nnmh" (&rest args))
+;; The nnoo-import at the end, I think.
+(declare-function nndraft-request-list "nndraft" (&rest args) t)
(nnoo-declare nndraft
nnmh)
;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
-;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; Author: Simon Josefsson <simon@josefsson.org>
;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
;; Scott Byer <byer@mv.us.adobe.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
"The name of the nnfolder NOV directory.
If nil, `nnfolder-directory' is used.")
-(defvoo nnfolder-marks-directory nil
- "The name of the nnfolder MARKS directory.
-If nil, `nnfolder-directory' is used.")
-
(defvoo nnfolder-active-file
(nnheader-concat nnfolder-directory "active")
"The name of the active file.")
(defvar nnfolder-nov-buffer-file-name nil)
-(defvoo nnfolder-marks-is-evil nil
- "If non-nil, Gnus will never generate and use marks file for mail groups.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'. If you have, for some reason, set
-this to t, and want to set it to nil again, you should always remove
-the corresponding marks file (usually base nnfolder file name
-concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for
-the group. Then the marks file will be regenerated properly by Gnus.")
-
-(defvoo nnfolder-marks nil)
-
-(defvoo nnfolder-marks-file-suffix ".mrk")
-
-(defvar nnfolder-marks-modtime (gnus-make-hashtable))
-
\f
;;; Interface functions
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
(and nnfolder-nov-directory
(gnus-make-directory nnfolder-nov-directory)))
- (unless nnfolder-marks-is-evil
- (and nnfolder-marks-directory
- (gnus-make-directory nnfolder-marks-directory)))
(cond
((not (file-exists-p nnfolder-directory))
(nnfolder-close-server)
() ; Don't delete the articles.
;; Delete the file that holds the group.
(let ((data (nnfolder-group-pathname group))
- (nov (nnfolder-group-nov-pathname group))
- (mrk (nnfolder-group-marks-pathname group)))
+ (nov (nnfolder-group-nov-pathname group)))
(ignore-errors (delete-file data))
- (ignore-errors (delete-file nov))
- (ignore-errors (delete-file mrk))))
+ (ignore-errors (delete-file nov))))
;; Remove the group from all structures.
(setq nnfolder-group-alist
(delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
(when (file-exists-p (nnfolder-group-nov-pathname group))
(setq new-file (nnfolder-group-nov-pathname new-name))
(gnus-make-directory (file-name-directory new-file))
- (rename-file (nnfolder-group-nov-pathname group) new-file))
- (when (file-exists-p (nnfolder-group-marks-pathname group))
- (setq new-file (nnfolder-group-marks-pathname new-name))
- (gnus-make-directory (file-name-directory new-file))
- (rename-file (nnfolder-group-marks-pathname group) new-file)))
+ (rename-file (nnfolder-group-nov-pathname group) new-file)))
t)
;; That went ok, so we change the internal structures.
(let ((entry (assoc group nnfolder-group-alist)))
(defun nnfolder-save-buffer ()
"Save the buffer."
- (when (buffer-modified-p)
- (run-hooks 'nnfolder-save-buffer-hook)
- (gnus-make-directory (file-name-directory (buffer-file-name)))
- (let ((coding-system-for-write
- (or nnfolder-file-coding-system-for-write
- nnfolder-file-coding-system)))
- (set (make-local-variable 'copyright-update) nil)
- (save-buffer)))
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (nnfolder-save-nov)))
+ (let ((delete-old-versions t))
+ (when (buffer-modified-p)
+ (run-hooks 'nnfolder-save-buffer-hook)
+ (gnus-make-directory (file-name-directory (buffer-file-name)))
+ (let ((coding-system-for-write
+ (or nnfolder-file-coding-system-for-write
+ nnfolder-file-coding-system)))
+ (set (make-local-variable 'copyright-update) nil)
+ (save-buffer)))
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (nnfolder-save-nov))))
(defun nnfolder-save-active (group-alist active-file)
(let ((nnmail-active-file-coding-system
(mail-header-set-number headers article)
(nnheader-insert-nov headers)))
-(deffoo nnfolder-request-set-mark (group actions &optional server)
- (when (and server
- (not (nnfolder-server-opened server)))
- (nnfolder-open-server server))
- (unless nnfolder-marks-is-evil
- (nnfolder-open-marks group server)
- (setq nnfolder-marks (nnheader-update-marks-actions nnfolder-marks actions))
- (nnfolder-save-marks group server))
- nil)
-
-(deffoo nnfolder-request-marks (group info &optional server)
- ;; Change servers.
- (when (and server
- (not (nnfolder-server-opened server)))
- (nnfolder-open-server server))
- (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group))
- (nnheader-message 8 "Updating marks for %s..." group)
- (nnfolder-open-marks group server)
- ;; Update info using `nnfolder-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnfolder-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nnfolder-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group))
- info)
-
-(defun nnfolder-group-marks-pathname (group)
- "Make pathname for GROUP NOV."
- (let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory)))
- (concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix)))
-
-(defun nnfolder-marks-changed-p (group)
- (let ((file (nnfolder-group-marks-pathname group)))
- (if (null (gnus-gethash file nnfolder-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (not (equal (gnus-gethash file nnfolder-marks-modtime)
- (nth 5 (file-attributes file)))))))
-
-(defun nnfolder-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nnfolder-group-marks-pathname group)))
- (condition-case err
- (progn
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nnfolder-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nnfolder-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnfolder-open-marks (group server)
- (let ((file (nnfolder-group-marks-pathname group)))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nnfolder-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nnfolder-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nnfolder marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method (format "nnfolder:%s" server))))))
- (nnheader-message 7 "Bootstrapping marks for %s..." group)
- (setq nnfolder-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnfolder-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))
- (nnfolder-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
-
(provide 'nnfolder)
;;; nnfolder.el ends here
(defvoo nnimap-fetch-partial-articles nil
"If non-nil, Gnus will fetch partial articles.
-If t, nnimap will fetch only the first part. If a string, it
+If t, Gnus will fetch only the first part. If a string, it
will fetch all parts that have types that match that string. A
likely value would be \"text/\" to automatically fetch all
textual parts.")
(when nnimap-object
(when (nnimap-capability "QRESYNC")
(nnimap-command "ENABLE QRESYNC"))
+ (nnheader-message 7 "Opening connection to %s...done"
+ nnimap-address)
(nnimap-process nnimap-object))))))))
(autoload 'rfc2104-hash "rfc2104")
(autoload 'gnus-add-buffer "gnus")
(autoload 'gnus-kill-buffer "gnus")
+(eval-when-compile
+ (autoload 'mail-send-and-exit "sendmail" nil t))
(defgroup nnmail nil
"Reading mail with Gnus."
(const warn)
(const delete)))
-(defcustom nnmail-extra-headers '(To Newsgroups)
+(defcustom nnmail-extra-headers '(To Newsgroups Cc)
"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 "21.1"
+ :version "24.3"
:group 'nnmail
:type '(repeat symbol))
(defconst nnmaildir-version "Gnus")
+(defconst nnmaildir-flag-mark-mapping
+ '((?F . tick)
+ (?R . reply)
+ (?S . read))
+ "Alist mapping Maildir filename flags to Gnus marks.
+Maildir filenames are of the form \"unique-id:2,FLAGS\",
+where FLAGS are a string of characters in ASCII order.
+Some of the FLAGS correspond to Gnus marks.")
+
+(defsubst nnmaildir--mark-to-flag (mark)
+ "Find the Maildir flag that corresponds to MARK (an atom).
+Return a character, or `nil' if not found.
+See `nnmaildir-flag-mark-mapping'."
+ (car (rassq mark nnmaildir-flag-mark-mapping)))
+
+(defsubst nnmaildir--flag-to-mark (flag)
+ "Find the Gnus mark that corresponds to FLAG (a character).
+Return an atom, or `nil' if not found.
+See `nnmaildir-flag-mark-mapping'."
+ (cdr (assq flag nnmaildir-flag-mark-mapping)))
+
+(defun nnmaildir--ensure-suffix (filename)
+ "Ensure that FILENAME contains the suffix \":2,\"."
+ (if (gnus-string-match-p ":2," filename)
+ filename
+ (concat filename ":2,")))
+
+(defun nnmaildir--add-flag (flag suffix)
+ "Return a copy of SUFFIX where FLAG is set.
+SUFFIX should start with \":2,\"."
+ (unless (gnus-string-match-p "^:2," suffix)
+ (error "Invalid suffix `%s'" suffix))
+ (let* ((flags (substring suffix 3))
+ (flags-as-list (append flags nil))
+ (new-flags
+ (concat (gnus-delete-duplicates
+ ;; maildir flags must be sorted
+ (sort (cons flag flags-as-list) '<)))))
+ (concat ":2," new-flags)))
+
+(defun nnmaildir--remove-flag (flag suffix)
+ "Return a copy of SUFFIX where FLAG is cleared.
+SUFFIX should start with \":2,\"."
+ (unless (gnus-string-match-p "^:2," suffix)
+ (error "Invalid suffix `%s'" suffix))
+ (let* ((flags (substring suffix 3))
+ (flags-as-list (append flags nil))
+ (new-flags (concat (delq flag flags-as-list))))
+ (concat ":2," new-flags)))
+
(defvar nnmaildir-article-file-name nil
"*The filename of the most recently requested article. This variable is set
by nnmaildir-request-article.")
(gnm nil) ;; flag: split from mail-sources?
(target-prefix nil :type string)) ;; symlink target prefix
+(defun nnmaildir--article-set-flags (article new-suffix curdir)
+ (let* ((prefix (nnmaildir--art-prefix article))
+ (suffix (nnmaildir--art-suffix article))
+ (article-file (concat curdir prefix suffix))
+ (new-name (concat curdir prefix new-suffix)))
+ (unless (file-exists-p article-file)
+ (error "Couldn't find article file %s" article-file))
+ (rename-file article-file new-name 'replace)
+ (setf (nnmaildir--art-suffix article) new-suffix)))
+
(defun nnmaildir--expired-article (group article)
(setf (nnmaildir--art-nov article) nil)
(let ((flist (nnmaildir--grp-flist group))
(eval param))
(defmacro nnmaildir--with-nntp-buffer (&rest body)
+ (declare (debug (body)))
`(with-current-buffer nntp-server-buffer
,@body))
(defmacro nnmaildir--with-work-buffer (&rest body)
+ (declare (debug (body)))
`(with-current-buffer (get-buffer-create " *nnmaildir work*")
,@body))
(defmacro nnmaildir--with-nov-buffer (&rest body)
+ (declare (debug (body)))
`(with-current-buffer (get-buffer-create " *nnmaildir nov*")
,@body))
(defmacro nnmaildir--with-move-buffer (&rest body)
+ (declare (debug (body)))
`(with-current-buffer (get-buffer-create " *nnmaildir move*")
,@body))
-(defmacro nnmaildir--subdir (dir subdir)
- `(file-name-as-directory (concat ,dir ,subdir)))
-(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
- `(nnmaildir--subdir ,srv-dir ,gname))
-(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp"))
-(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new"))
-(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur"))
-(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
-(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
-(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
-(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num"))
+(defsubst nnmaildir--subdir (dir subdir)
+ (file-name-as-directory (concat dir subdir)))
+(defsubst nnmaildir--srvgrp-dir (srv-dir gname)
+ (nnmaildir--subdir srv-dir gname))
+(defsubst nnmaildir--tmp (dir) (nnmaildir--subdir dir "tmp"))
+(defsubst nnmaildir--new (dir) (nnmaildir--subdir dir "new"))
+(defsubst nnmaildir--cur (dir) (nnmaildir--subdir dir "cur"))
+(defsubst nnmaildir--nndir (dir) (nnmaildir--subdir dir ".nnmaildir"))
+(defsubst nnmaildir--nov-dir (dir) (nnmaildir--subdir dir "nov"))
+(defsubst nnmaildir--marks-dir (dir) (nnmaildir--subdir dir "marks"))
+(defsubst nnmaildir--num-dir (dir) (nnmaildir--subdir dir "num"))
(defmacro nnmaildir--unlink (file-arg)
`(let ((file ,file-arg))
string)
(defmacro nnmaildir--condcase (errsym body &rest handler)
+ (declare (debug (sexp form body)))
`(condition-case ,errsym
(let ((system-messages-locale "C")) ,body)
(error . ,handler)))
(dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort))
(setq x (concat ndir file))
(and (time-less-p (nth 5 (file-attributes x)) (current-time))
- (rename-file x (concat cdir file ":2,"))))
+ (rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
(setf (nnmaildir--grp-new group) nattr))
(setq cattr (nth 5 (file-attributes cdir)))
(if (equal cattr (nnmaildir--grp-cur group))
cdir (nnmaildir--marks-dir nndir)
ndir (nnmaildir--subdir cdir "tick")
cdir (nnmaildir--subdir cdir "read"))
- (dolist (file files)
- (setq file (car file))
- (if (or (not (file-exists-p (concat cdir file)))
- (file-exists-p (concat ndir file)))
- (setq num (1+ num)))))
+ (dolist (prefix-suffix files)
+ (let ((prefix (car prefix-suffix))
+ (suffix (cdr prefix-suffix)))
+ ;; increase num for each unread or ticked article
+ (when (or
+ ;; first look for marks in suffix, if it's valid...
+ (when (and (stringp suffix)
+ (gnus-string-prefix-p ":2," suffix))
+ (or
+ (not (gnus-string-match-p
+ (string (nnmaildir--mark-to-flag 'read)) suffix))
+ (gnus-string-match-p
+ (string (nnmaildir--mark-to-flag 'tick)) suffix)))
+ ;; then look in marks directories
+ (not (file-exists-p (concat cdir prefix)))
+ (file-exists-p (concat ndir prefix)))
+ (incf num)))))
(setf (nnmaildir--grp-cache group) (make-vector num nil))
(let ((inhibit-quit t))
(set (intern gname groups) group))
"\n")))))
'group)
-(defun nnmaildir-request-marks (gname info &optional server)
- (let ((group (nnmaildir--prepare server gname))
- pgname flist always-marks never-marks old-marks dotfile num dir
- markdirs marks mark ranges markdir article read end new-marks ls
- old-mmth new-mmth mtime mark-sym existing missing deactivate-mark
- article-list)
+(defun nnmaildir-request-update-info (gname info &optional server)
+ (let* ((group (nnmaildir--prepare server gname))
+ (curdir (nnmaildir--cur
+ (nnmaildir--srvgrp-dir
+ (nnmaildir--srv-dir nnmaildir--cur-server) gname)))
+ (curdir-mtime (nth 5 (file-attributes curdir)))
+ pgname flist always-marks never-marks old-marks dotfile num dir
+ all-marks marks mark ranges markdir read end new-marks ls
+ old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
(catch 'return
(unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
dir (nnmaildir--nndir dir)
dir (nnmaildir--marks-dir dir)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
- markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
- new-mmth (nnmaildir--up2-1 (length markdirs))
+ all-marks (gnus-delete-duplicates
+ ;; get mark names from mark dirs and from flag
+ ;; mappings
+ (append
+ (mapcar 'cdr nnmaildir-flag-mark-mapping)
+ (mapcar 'intern (funcall ls dir nil "\\`[^.]" 'nosort))))
+ new-mmth (nnmaildir--up2-1 (length all-marks))
new-mmth (make-vector new-mmth 0)
old-mmth (nnmaildir--grp-mmth group))
- (dolist (mark markdirs)
- (setq markdir (nnmaildir--subdir dir mark)
- mark-sym (intern mark)
+ (dolist (mark all-marks)
+ (setq markdir (nnmaildir--subdir dir (symbol-name mark))
ranges nil)
(catch 'got-ranges
- (if (memq mark-sym never-marks) (throw 'got-ranges nil))
- (when (memq mark-sym always-marks)
+ (if (memq mark never-marks) (throw 'got-ranges nil))
+ (when (memq mark always-marks)
(setq ranges existing)
(throw 'got-ranges nil))
- (setq mtime (nth 5 (file-attributes markdir)))
- (set (intern mark new-mmth) mtime)
- (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
- (setq ranges (assq mark-sym old-marks))
+ ;; Find the mtime for this mark. If this mark can be expressed as
+ ;; a filename flag, get the later of the mtimes for markdir and
+ ;; curdir, otherwise only the markdir counts.
+ (setq mtime
+ (let ((markdir-mtime (nth 5 (file-attributes markdir))))
+ (cond
+ ((null (nnmaildir--mark-to-flag mark))
+ markdir-mtime)
+ ((null markdir-mtime)
+ curdir-mtime)
+ ((null curdir-mtime)
+ ;; this should never happen...
+ markdir-mtime)
+ ((time-less-p markdir-mtime curdir-mtime)
+ curdir-mtime)
+ (t
+ markdir-mtime))))
+ (set (intern (symbol-name mark) new-mmth) mtime)
+ (when (equal mtime (symbol-value (intern-soft (symbol-name mark) old-mmth)))
+ (setq ranges (assq mark old-marks))
(if ranges (setq ranges (cdr ranges)))
(throw 'got-ranges nil))
- (setq article-list nil)
- (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
- (setq article (nnmaildir--flist-art flist prefix))
- (if article
- (setq article-list
- (cons (nnmaildir--art-num article) article-list))))
- (setq ranges (gnus-add-to-range ranges (sort article-list '<))))
- (if (eq mark-sym 'read) (setq read ranges)
- (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
+ (let ((article-list nil))
+ ;; Consider the article marked if it either has the flag in the
+ ;; filename, or is in the markdir. As you'd rarely remove a
+ ;; flag/mark, this should avoid losing information in the most
+ ;; common usage pattern.
+ (or
+ (let ((flag (nnmaildir--mark-to-flag mark)))
+ ;; If this mark has a corresponding maildir flag...
+ (when flag
+ (let ((regexp
+ (concat "\\`[^.].*:2,[A-Z]*" (string flag))))
+ ;; ...then find all files with that flag.
+ (dolist (filename (funcall ls curdir nil regexp 'nosort))
+ (let* ((prefix (car (split-string filename ":2,")))
+ (article (nnmaildir--flist-art flist prefix)))
+ (when article
+ (push (nnmaildir--art-num article) article-list)))))))
+ ;; Also check Gnus-specific mark directory, if it exists.
+ (when (file-directory-p markdir)
+ (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
+ (let ((article (nnmaildir--flist-art flist prefix)))
+ (when article
+ (push (nnmaildir--art-num article) article-list))))))
+ (setq ranges (gnus-add-to-range ranges (sort article-list '<)))))
+ (if (eq mark 'read) (setq read ranges)
+ (if ranges (setq marks (cons (cons mark ranges) marks)))))
(gnus-info-set-read info (gnus-range-add read missing))
(gnus-info-set-marks info marks 'extend)
(setf (nnmaildir--grp-mmth group) new-mmth)
didnt)))
(defun nnmaildir-request-set-mark (gname actions &optional server)
- (let ((group (nnmaildir--prepare server gname))
- (coding-system-for-write nnheader-file-coding-system)
- (buffer-file-coding-system nil)
- (file-coding-system-alist nil)
- del-mark del-action add-action set-action marksdir nlist
- ranges begin end article all-marks todo-marks mdir mfile
- pgname ls permarkfile deactivate-mark)
+ (let* ((group (nnmaildir--prepare server gname))
+ (curdir (nnmaildir--cur
+ (nnmaildir--srvgrp-dir
+ (nnmaildir--srv-dir nnmaildir--cur-server)
+ gname)))
+ (coding-system-for-write nnheader-file-coding-system)
+ (buffer-file-coding-system nil)
+ (file-coding-system-alist nil)
+ del-mark del-action add-action set-action marksdir nlist
+ ranges begin end article all-marks todo-marks mdir mfile
+ pgname ls permarkfile deactivate-mark)
(setq del-mark
(lambda (mark)
- (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
- mfile (concat mfile (nnmaildir--art-prefix article)))
- (nnmaildir--unlink mfile))
+ (let ((prefix (nnmaildir--art-prefix article))
+ (suffix (nnmaildir--art-suffix article))
+ (flag (nnmaildir--mark-to-flag mark)))
+ (when flag
+ ;; If this mark corresponds to a flag, remove the flag from
+ ;; the file name.
+ (nnmaildir--article-set-flags
+ article (nnmaildir--remove-flag flag suffix) curdir))
+ ;; We still want to delete the hardlink in the marks dir if
+ ;; present, regardless of whether this mark has a maildir flag or
+ ;; not, to avoid getting out of sync.
+ (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
+ mfile (concat mfile prefix))
+ (nnmaildir--unlink mfile)))
del-action (lambda (article) (mapcar del-mark todo-marks))
add-action
(lambda (article)
(mapcar
(lambda (mark)
- (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
- permarkfile (concat mdir ":")
- mfile (concat mdir (nnmaildir--art-prefix article)))
- (nnmaildir--condcase err (add-name-to-file permarkfile mfile)
- (cond
- ((nnmaildir--eexist-p err))
- ((nnmaildir--enoent-p err)
- (nnmaildir--mkdir mdir)
- (nnmaildir--mkfile permarkfile)
- (add-name-to-file permarkfile mfile))
- ((nnmaildir--emlink-p err)
- (let ((permarkfilenew (concat permarkfile "{new}")))
- (nnmaildir--mkfile permarkfilenew)
- (rename-file permarkfilenew permarkfile 'replace)
- (add-name-to-file permarkfile mfile)))
- (t (signal (car err) (cdr err))))))
+ (let ((prefix (nnmaildir--art-prefix article))
+ (suffix (nnmaildir--art-suffix article))
+ (flag (nnmaildir--mark-to-flag mark)))
+ (if flag
+ ;; If there is a corresponding maildir flag, just rename
+ ;; the file.
+ (nnmaildir--article-set-flags
+ article (nnmaildir--add-flag flag suffix) curdir)
+ ;; Otherwise, use nnmaildir-specific marks dir.
+ (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
+ permarkfile (concat mdir ":")
+ mfile (concat mdir prefix))
+ (nnmaildir--condcase err (add-name-to-file permarkfile mfile)
+ (cond
+ ((nnmaildir--eexist-p err))
+ ((nnmaildir--enoent-p err)
+ (nnmaildir--mkdir mdir)
+ (nnmaildir--mkfile permarkfile)
+ (add-name-to-file permarkfile mfile))
+ ((nnmaildir--emlink-p err)
+ (let ((permarkfilenew (concat permarkfile "{new}")))
+ (nnmaildir--mkfile permarkfilenew)
+ (rename-file permarkfilenew permarkfile 'replace)
+ (add-name-to-file permarkfile mfile)))
+ (t (signal (car err) (cdr err))))))))
todo-marks))
set-action (lambda (article)
(funcall add-action article)
pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
- all-marks (mapcar 'intern all-marks))
+ all-marks (gnus-delete-duplicates
+ ;; get mark names from mark dirs and from flag
+ ;; mappings
+ (append
+ (mapcar 'cdr nnmaildir-flag-mark-mapping)
+ (mapcar 'intern all-marks))))
(dolist (action actions)
(setq ranges (car action)
todo-marks (caddr action))
;; Foundation, Inc.
;; Authors: Didier Verna <didier@xemacs.org> (adding compaction)
-;; Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; Simon Josefsson <simon@josefsson.org>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
through all nnml directories and generate nov databases for them
all. This may very well take some time.")
-(defvoo nnml-marks-is-evil nil
- "If non-nil, Gnus will never generate and use marks file for mail spools.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'. If you have, for some reason, set this
-to t, and want to set it to nil again, you should always remove the
-corresponding marks file (usually named `.marks' in the nnml group
-directory, but see `nnml-marks-file-name') for the group. Then the
-marks file will be regenerated properly by Gnus.")
-
(defvoo nnml-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
"nnml version.")
(defvoo nnml-nov-file-name ".overview")
-(defvoo nnml-marks-file-name ".marks")
(defvoo nnml-current-directory nil)
(defvoo nnml-current-group nil)
(defvoo nnml-file-coding-system nnmail-file-coding-system)
-(defvoo nnml-marks nil)
-
-(defvar nnml-marks-modtime (gnus-make-hashtable))
-
\f
;;; Interface functions.
nnml-current-directory t
(concat
nnheader-numerical-short-files
- "\\|" (regexp-quote nnml-nov-file-name) "$"
- "\\|" (regexp-quote nnml-marks-file-name) "$")))
+ "\\|" (regexp-quote nnml-nov-file-name) "$")))
(decoded (nnml-decoded-group-name group server)))
(dolist (article articles)
(when (file-writable-p article)
(let ((overview (concat old-dir nnml-nov-file-name)))
(when (file-exists-p overview)
(rename-file overview (concat new-dir nnml-nov-file-name))))
- ;; Move .marks file.
- (let ((marks (concat old-dir nnml-marks-file-name)))
- (when (file-exists-p marks)
- (rename-file marks (concat new-dir nnml-marks-file-name))))
(when (<= (length (directory-files old-dir)) 2)
(ignore-errors (delete-directory old-dir)))
;; That went ok, so we change the internal structures.
(forward-line 1))
alist))))
-(deffoo nnml-request-set-mark (group actions &optional server)
- (nnml-possibly-change-directory group server)
- (unless nnml-marks-is-evil
- (nnml-open-marks group server)
- (setq nnml-marks (nnheader-update-marks-actions nnml-marks actions))
- (nnml-save-marks group server))
- nil)
-
-(deffoo nnml-request-marks (group info &optional server)
- (nnml-possibly-change-directory group server)
- (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server))
- (nnheader-message 8 "Updating marks for %s..." group)
- (nnml-open-marks group server)
- ;; Update info using `nnml-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnml-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nnml-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group))
- info)
-
-(defun nnml-marks-changed-p (group server)
- (let ((file (nnml-group-pathname group nnml-marks-file-name server)))
- (if (null (gnus-gethash file nnml-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (not (equal (gnus-gethash file nnml-marks-modtime)
- (nth 5 (file-attributes file)))))))
-
-(defun nnml-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nnml-group-pathname group nnml-marks-file-name server)))
- (condition-case err
- (progn
- (nnml-possibly-create-directory group server)
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nnml-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nnml-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnml-open-marks (group server)
- (let* ((decoded (nnml-decoded-group-name group server))
- (file (nnmail-group-pathname decoded nnml-directory
- nnml-marks-file-name))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nnml-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nnml-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nnml marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method
- (format "nnml:%s" (or server "")))))))
- (setq decoded (if (member server '(nil ""))
- (concat "nnml:" decoded)
- (format "nnml+%s:%s" server decoded)))
- (nnheader-message 7 "Bootstrapping marks for %s..." decoded)
- (setq nnml-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnml-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks)))
- (nnml-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" decoded)))))
-
-
;;;
;;; Group and server compaction. -- dvl
;;;
(gnus-set-active group-full-name active))
;; 1 bis/
;; #### NOTE: normally, we should save the overview (NOV) file
- ;; #### here, just like we save the marks file. However, there is no
- ;; #### such function as nnml-save-nov for a single group. Only for
- ;; #### all groups. Gnus inconsistency is getting worse every day...
- ;; 2/ Rebuild marks file:
- (unless nnml-marks-is-evil
- ;; #### NOTE: this constant use of global variables everywhere is
- ;; #### truly disgusting. Gnus really needs a *major* cleanup.
- (setq nnml-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnml-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks)))
- (nnml-save-marks group server))
- ;; 3/ Save everything if this was not part of a bigger operation:
+ ;; #### here. However, there is no such function as
+ ;; #### nnml-save-nov for a single group. Only for all
+ ;; #### groups. Gnus inconsistency is getting worse every
+ ;; #### day... ;; 3/ Save everything if this was not part of
+ ;; #### a bigger operation:
(if (not save)
;; Nothing to save (yet):
t
(nnml-save-nov)
;; b/ Save the active file:
(nnmail-save-active nnml-group-alist nnml-active-file)
- (let ((marks (nnml-group-pathname group nnml-marks-file-name server)))
- (when (file-exists-p marks)
- (delete-file marks)))
t)))))
(defun nnml-request-compact (&optional server)
(require 'nnoo)
(eval-when-compile (require 'cl))
+;; Probably this entire thing should be obsolete.
+;; It's only used to init nnspool-spool-directory, so why not just
+;; set that variable's default directly?
+(eval-and-compile
+ (defvar news-directory (if (file-exists-p "/usr/spool/news/")
+ "/usr/spool/news/"
+ "/var/spool/news/")
+ "The root directory below which all news files are stored.")
+ (defvaralias 'news-path 'news-directory))
+
+;; Ditto re obsolescence.
+(defvar news-inews-program
+ (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews")
+ ((file-exists-p "/usr/local/inews") "/usr/local/inews")
+ ((file-exists-p "/usr/local/bin/inews") "/usr/local/bin/inews")
+ ((file-exists-p "/usr/contrib/lib/news/inews") "/usr/contrib/lib/news/inews")
+ ((file-exists-p "/usr/lib/news/inews") "/usr/lib/news/inews")
+ (t "inews"))
+ "Program to post news.")
+
(nnoo-declare nnspool)
(defvoo nnspool-inews-program news-inews-program
server there that you can connect to. See also
`nntp-open-connection-function'")
-(defvoo nntp-coding-system-for-read 'binary
- "*Coding system to read from NNTP.")
-
-(defvoo nntp-coding-system-for-write 'binary
- "*Coding system to write to NNTP.")
-
-;; Marks
-(defvoo nntp-marks-is-evil nil
- "*If non-nil, Gnus will never generate and use marks file for nntp groups.
-See `nnml-marks-is-evil' for more information.")
-
-(defvoo nntp-marks-file-name ".marks")
-(defvoo nntp-marks nil)
-(defvar nntp-marks-modtime (gnus-make-hashtable))
-
-(defcustom nntp-marks-directory
- (nnheader-concat gnus-directory "marks/")
- "*The directory where marks for nntp groups will be stored."
- :group 'nntp
- :type 'directory)
-
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
:group 'nntp
(insert (format-time-string "%Y%m%dT%H%M%S.%3N")
" " nntp-address " " string "\n")))
+(defvar nntp--report-1 nil)
+
(defun nntp-report (&rest args)
"Report an error from the nntp backend. The first string in ARGS
can be a format string. For some commands, the failed command may be
retried once before actually displaying the error report."
+ (if nntp--report-1
+ (progn
+ ;; Throw out to nntp-with-open-group-error so that the connection may
+ ;; be restored and the command retried."
+ (when nntp-record-commands
+ (nntp-record-command "*** CONNECTION LOST ***"))
+ (throw 'nntp-with-open-group-error t))
- (when nntp-record-commands
- (nntp-record-command "*** CALLED nntp-report ***"))
-
- (nnheader-report 'nntp args)
+ (when nntp-record-commands
+ (nntp-record-command "*** CALLED nntp-report ***"))
- (apply 'error args))
-
-(defun nntp-report-1 (&rest args)
- "Throws out to nntp-with-open-group-error so that the connection may
-be restored and the command retried."
-
- (when nntp-record-commands
- (nntp-record-command "*** CONNECTION LOST ***"))
+ (nnheader-report 'nntp args)
- (throw 'nntp-with-open-group-error t))
+ (apply 'error args)))
(defmacro nntp-copy-to-buffer (buffer start end)
"Copy string from unibyte current buffer to multibyte buffer."
(t
nil)))
-(eval-when-compile
- (defvar nntp-with-open-group-internal nil)
- (defvar nntp-report-n nil))
-
(defun nntp-with-open-group-function (-group -server -connectionless -bodyfun)
"Protect against servers that don't like clients that keep idle connections opens.
The problem being that these servers may either close a connection or
`nntp-connection-timeout' has expired. When these occur
`nntp-with-open-group', opens a new connection then re-issues the NNTP
command whose response triggered the error."
- (letf ((nntp-report-n (symbol-function 'nntp-report))
- ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
- (nntp-with-open-group-internal nil))
+ (let ((nntp-report-n nntp--report-1)
+ (nntp--report-1 t)
+ (nntp-with-open-group-internal nil))
(while (catch 'nntp-with-open-group-error
;; Open the connection to the server
;; NOTE: Existing connections are NOT tested.
(when -timer
(nnheader-cancel-timer -timer)))
nil))
- (setf (symbol-function 'nntp-report) nntp-report-n))
+ (setq nntp--report-1 nntp-report-n))
nntp-with-open-group-internal))
(defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
(progn
(nntp-copy-to-buffer nntp-server-buffer
(point-min) (point-max))
- (gnus-groups-to-gnus-format method gnus-active-hashtb t))
+ (with-current-buffer nntp-server-buffer
+ (gnus-groups-to-gnus-format method gnus-active-hashtb t)))
;; We have read active entries, so we just delete the
;; superfluous gunk.
(goto-char (point-min))
(deffoo nntp-asynchronous-p ()
t)
-(deffoo nntp-request-set-mark (group actions &optional server)
- (when (and (not nntp-marks-is-evil)
- nntp-marks-file-name)
- (nntp-possibly-create-directory group server)
- (nntp-open-marks group server)
- (setq nntp-marks (nnheader-update-marks-actions nntp-marks actions))
- (nntp-save-marks group server))
- nil)
-
-(deffoo nntp-request-marks (group info &optional server)
- (when (and (not nntp-marks-is-evil)
- nntp-marks-file-name)
- (nntp-possibly-create-directory group server)
- (when (nntp-marks-changed-p group server)
- (nnheader-message 8 "Updating marks for %s..." group)
- (nntp-open-marks group server)
- ;; Update info using `nntp-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nntp-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nntp-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group)))
- nil)
-
-
;;; Hooky functions.
(read-passwd (format "NNTP (%s@%s) password: "
user nntp-address))))))))))
-(defun nntp-send-nosy-authinfo ()
- "Send the AUTHINFO to the nntp server."
- (let ((user (read-string (format "NNTP (%s) user name: " nntp-address))))
- (unless (member user '(nil ""))
- (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
- (when t ;???Should check if AUTHINFO succeeded
- (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
- (read-passwd (format "NNTP (%s@%s) password: "
- user nntp-address)))))))
-
-(defun nntp-send-authinfo-from-file ()
- "Send the AUTHINFO to the nntp server.
-
-The authinfo login name is taken from the user's login name and the
-password contained in '~/.nntp-authinfo'."
- (when (file-exists-p "~/.nntp-authinfo")
- (with-temp-buffer
- (insert-file-contents "~/.nntp-authinfo")
- (goto-char (point-min))
- (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point) (point-at-eol))))))
-
;;; Internal functions.
(defun nntp-handle-authinfo (process)
(nntp-kill-buffer ,pbuffer)))))
(process
(condition-case err
- (let ((coding-system-for-read nntp-coding-system-for-read)
- (coding-system-for-write nntp-coding-system-for-write)
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
(map '((nntp-open-network-stream network)
(network-only plain) ; compat
(nntp-open-plain-stream plain)
nntp-process-start-point (point-max))
(setq after-change-functions '(nntp-after-change-function))))
-(defun nntp-async-timer-handler ()
- (mapcar
- (lambda (proc)
- (if (memq (process-status proc) '(open run))
- (nntp-async-trigger proc)
- (nntp-async-stop proc)))
- nntp-async-process-list))
-
(defun nntp-async-stop (proc)
(setq nntp-async-process-list (delq proc nntp-async-process-list))
(when (and nntp-async-timer (not nntp-async-process-list))
(delete-region (point) (point-max)))
proc)))
-;; Marks handling
-
-(defun nntp-marks-directory (server)
- (expand-file-name server nntp-marks-directory))
-
-(defvar nntp-server-to-method-cache nil
- "Alist of servers and select methods.")
-
-(defun nntp-group-pathname (server group &optional file)
- "Return an absolute file name of FILE for GROUP on SERVER."
- (let ((method (cdr (assoc server nntp-server-to-method-cache))))
- (unless method
- (push (cons server (setq method (or (gnus-server-to-method server)
- (gnus-find-method-for-group group))))
- nntp-server-to-method-cache))
- (nnmail-group-pathname
- (mm-decode-coding-string group
- (inline (gnus-group-name-charset method group)))
- (nntp-marks-directory server)
- file)))
-
-(defun nntp-possibly-create-directory (group server)
- (let ((dir (nntp-group-pathname server group))
- (file-name-coding-system nnmail-pathname-coding-system))
- (unless (file-exists-p dir)
- (make-directory (directory-file-name dir) t)
- (nnheader-message 5 "Creating nntp marks directory %s" dir))))
-
-(autoload 'time-less-p "time-date")
-
-(defun nntp-marks-changed-p (group server)
- (let ((file (nntp-group-pathname server group nntp-marks-file-name))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (null (gnus-gethash file nntp-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (time-less-p (gnus-gethash file nntp-marks-modtime)
- (nth 5 (file-attributes file))))))
-
-(defun nntp-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nntp-group-pathname server group nntp-marks-file-name)))
- (condition-case err
- (progn
- (nntp-possibly-create-directory group server)
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nntp-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nntp-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nntp-open-marks (group server)
- (let ((file (nntp-group-pathname server group nntp-marks-file-name))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nntp-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nntp-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nntp-marks (gnus-remassoc el nntp-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nntp marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nntp marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method (format "nntp:%s" server)))))
- (decoded-name (mm-decode-coding-string
- group
- (gnus-group-name-charset
- (gnus-server-to-method server) group))))
- (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name)
- (setq nntp-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nntp-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nntp-marks (gnus-remassoc el nntp-marks)))
- (nntp-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done"
- decoded-name)))))
-
(provide 'nntp)
;;; nntp.el ends here
(match-string 1)
(match-string 2)
(or (match-string 3)
- (substring (current-time-string) -4)))
+ (format-time-string "%Y")))
(current-time-string)))
(setq From (match-string 4)))
(widen)
;;
;; Editing:
;;
-;; Currently not supported but in the future plstore will provide a
-;; major mode to edit PLSTORE files.
+;; This file also provides `plstore-mode', a major mode for editing
+;; the PLSTORE format file. Visit a non-existing file and put the
+;; following line:
+;;
+;; (("foo" :host "foo.example.org" :secret-user "user"))
+;;
+;; where the prefixing `:secret-' means the property (without
+;; `:secret-' prefix) is marked as secret. Thus, when you save the
+;; buffer, the `:secret-user' property is encrypted as `:user'.
+;;
+;; You can toggle the view between encrypted form and the decrypted
+;; form with C-c C-c.
;;; Code:
(put 'plstore-encrypt-to 'permanent-local t)
+(defvar plstore-encoded nil)
+
+(put 'plstore-encoded 'permanent-local t)
+
(defvar plstore-cache-passphrase-for-symmetric-encryption nil)
(defvar plstore-passphrase-alist nil)
(generate-new-buffer (format " plstore %s" filename))))
(store (plstore--make buffer)))
(with-current-buffer buffer
- ;; In the future plstore will provide a major mode called
- ;; `plstore-mode' to edit PLSTORE files.
- (if (eq major-mode 'plstore-mode)
- (error "%s is opened for editing; kill the buffer first" file))
(erase-buffer)
(condition-case nil
(insert-file-contents-literally file)
(plstore--insert-buffer plstore)
(save-buffer)))
+(defun plstore--encode (plstore)
+ (plstore--decrypt plstore)
+ (let ((merged-alist (plstore--get-merged-alist plstore)))
+ (concat "("
+ (mapconcat
+ (lambda (entry)
+ (setq entry (copy-sequence entry))
+ (let ((merged-plist (cdr (assoc (car entry) merged-alist)))
+ (plist (cdr entry)))
+ (while plist
+ (if (string-match "\\`:secret-" (symbol-name (car plist)))
+ (setcar (cdr plist)
+ (plist-get
+ merged-plist
+ (intern (concat ":"
+ (substring (symbol-name
+ (car plist))
+ (match-end 0)))))))
+ (setq plist (nthcdr 2 plist)))
+ (prin1-to-string entry)))
+ (plstore--get-alist plstore)
+ "\n")
+ ")")))
+
+(defun plstore--decode (string)
+ (let* ((alist (car (read-from-string string)))
+ (pointer alist)
+ secret-alist
+ plist
+ entry)
+ (while pointer
+ (unless (stringp (car (car pointer)))
+ (error "Invalid PLSTORE format %s" string))
+ (setq plist (cdr (car pointer)))
+ (while plist
+ (when (string-match "\\`:secret-" (symbol-name (car plist)))
+ (setq entry (assoc (car (car pointer)) secret-alist))
+ (unless entry
+ (setq entry (list (car (car pointer)))
+ secret-alist (cons entry secret-alist)))
+ (setcdr entry (plist-put (cdr entry)
+ (intern (concat ":"
+ (substring (symbol-name
+ (car plist))
+ (match-end 0))))
+ (car (cdr plist))))
+ (setcar (cdr plist) t))
+ (setq plist (nthcdr 2 plist)))
+ (setq pointer (cdr pointer)))
+ (plstore--make nil alist nil secret-alist)))
+
+(defun plstore--write-contents-functions ()
+ (when plstore-encoded
+ (let ((store (plstore--decode (buffer-string)))
+ (file (buffer-file-name)))
+ (unwind-protect
+ (progn
+ (set-visited-file-name nil)
+ (with-temp-buffer
+ (plstore--insert-buffer store)
+ (write-region (buffer-string) nil file)))
+ (set-visited-file-name file)
+ (set-buffer-modified-p nil))
+ t)))
+
+(defun plstore-mode-original ()
+ "Show the original form of the this buffer."
+ (interactive)
+ (when plstore-encoded
+ (if (and (buffer-modified-p)
+ (y-or-n-p "Save buffer before reading the original form? "))
+ (save-buffer))
+ (erase-buffer)
+ (insert-file-contents-literally (buffer-file-name))
+ (set-buffer-modified-p nil)
+ (setq plstore-encoded nil)))
+
+(defun plstore-mode-decoded ()
+ "Show the decoded form of the this buffer."
+ (interactive)
+ (unless plstore-encoded
+ (if (and (buffer-modified-p)
+ (y-or-n-p "Save buffer before decoding? "))
+ (save-buffer))
+ (let ((store (plstore--make (current-buffer))))
+ (plstore--init-from-buffer store)
+ (erase-buffer)
+ (insert
+ (substitute-command-keys "\
+;;; You are looking at the decoded form of the PLSTORE file.\n\
+;;; To see the original form content, do \\[plstore-mode-toggle-display]\n\n"))
+ (insert (plstore--encode store))
+ (set-buffer-modified-p nil)
+ (setq plstore-encoded t))))
+
+(defun plstore-mode-toggle-display ()
+ "Toggle the display mode of PLSTORE between the original and decoded forms."
+ (interactive)
+ (if plstore-encoded
+ (plstore-mode-original)
+ (plstore-mode-decoded)))
+
+(eval-when-compile
+ (defmacro plstore-called-interactively-p (kind)
+ (condition-case nil
+ (progn
+ (eval '(called-interactively-p 'any))
+ ;; Emacs >=23.2
+ `(called-interactively-p ,kind))
+ ;; Emacs <23.2
+ (wrong-number-of-arguments '(called-interactively-p))
+ ;; XEmacs
+ (void-function '(interactive-p)))))
+
+;;;###autoload
+(define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE"
+ "Major mode for editing PLSTORE files."
+ (make-local-variable 'plstore-encoded)
+ (add-hook 'write-contents-functions #'plstore--write-contents-functions)
+ (define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display)
+ ;; to create a new file with plstore-mode, mark it as already decoded
+ (if (plstore-called-interactively-p 'any)
+ (setq plstore-encoded t)
+ (plstore-mode-decoded)))
+
(provide 'plstore)
;;; plstore.el ends here
(unless (memq (process-status process) '(open run))
(error "pop3 process died"))
(when total-size
- (message "pop3 retrieved %dKB (%d%%)"
- (truncate (/ (buffer-size) 1000))
- (truncate (* (/ (* (buffer-size) 1.0)
- total-size) 100))))
+ (let ((size 0))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\+OK.*\n" nil t)
+ (setq size (+ size (- (point))
+ (if (re-search-forward "^\\.\r?\n" nil 'move)
+ (match-beginning 0)
+ (point)))))
+ (message "pop3 retrieved %dKB (%d%%)"
+ (truncate (/ size 1000))
+ (truncate (* (/ (* size 1.0) total-size) 100)))))
(pop3-accept-process-output process))
start-point)
(not (eobp)))
(cond ((eq (char-after (1+ (point))) ?\n)
(delete-char 2))
- ((looking-at "=[0-9A-F][0-9A-F]")
- (let ((byte (string-to-number (buffer-substring (1+ (point))
- (+ 3 (point)))
- 16)))
- (mm-insert-byte byte 1)
- (delete-char 3)))
+ ((looking-at "\\(=[0-9A-F][0-9A-F]\\)+")
+ ;; Decode this sequence at once; i.e. by a single
+ ;; deletion and insertion.
+ (let* ((n (/ (- (match-end 0) (point)) 3))
+ (str (make-string n 0)))
+ (dotimes (i n)
+ (let ((n1 (char-after (1+ (point))))
+ (n2 (char-after (+ 2 (point)))))
+ (aset str i
+ (+ (* 16 (- n1 (if (<= n1 ?9) ?0
+ (if (<= n1 ?F) (- ?A 10)
+ (- ?a 10)))))
+ (- n2 (if (<= n2 ?9) ?0
+ (if (<= n2 ?F) (- ?A 10)
+ (- ?a 10)))))))
+ (forward-char 3))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert str)))
(t
(message "Malformed quoted-printable text")
(forward-char)))))
(eval-when-compile (require 'cl))
-(eval-when-compile
- (when (null (ignore-errors (require 'ert)))
- (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
-
-(ignore-errors
- (require 'ert))
-(eval-and-compile
- (or (ignore-errors (progn
- (require 'eieio)
- (require 'eieio-base)))
- ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
- (ignore-errors
- (let ((load-path (cons (expand-file-name
- "gnus-fallback-lib/eieio"
- (file-name-directory (locate-library "gnus")))
- load-path)))
- (require 'eieio)
- (require 'eieio-base)))
- (error
- "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
+(require 'eieio)
+(require 'eieio-base)
(defclass registry-db (eieio-persistent)
((version :initarg :version
collect k)))
(list limit candidates))))
-(ert-deftest registry-instantiation-test ()
- (should (registry-db "Testing")))
-
-(ert-deftest registry-match-test ()
- (let ((entry '((hello "goodbye" "bye") (blank))))
-
- (message "Testing :regex matching")
- (should (registry--match :regex entry '((hello "nye" "bye"))))
- (should (registry--match :regex entry '((hello "good"))))
- (should-not (registry--match :regex entry '((hello "nye"))))
- (should-not (registry--match :regex entry '((hello))))
-
- (message "Testing :member matching")
- (should (registry--match :member entry '((hello "bye"))))
- (should (registry--match :member entry '((hello "goodbye"))))
- (should-not (registry--match :member entry '((hello "good"))))
- (should-not (registry--match :member entry '((hello "nye"))))
- (should-not (registry--match :member entry '((hello)))))
- (message "Done with matching testing."))
-
-(defun registry-make-testable-db (n &optional name file)
- (let* ((db (registry-db
- (or name "Testing")
- :file (or file "unused")
- :max-hard n
- :max-soft 0 ; keep nothing not precious
- :precious '(extra more-extra)
- :tracked '(sender subject groups))))
- (dotimes (i n)
- (registry-insert db i `((sender "me")
- (subject "about you")
- (more-extra) ; empty data key should be pruned
- ;; first 5 entries will NOT have this extra data
- ,@(when (< 5 i) (list (list 'extra "more data")))
- (groups ,(number-to-string i)))))
- db))
-
-(ert-deftest registry-usage-test ()
- (let* ((n 100)
- (db (registry-make-testable-db n)))
- (message "size %d" n)
- (should (= n (registry-size db)))
- (message "max-hard test")
- (should-error (registry-insert db "new" '()))
- (message "Individual lookup")
- (should (= 58 (caadr (registry-lookup db '(1 58 99)))))
- (message "Grouped individual lookup")
- (should (= 3 (length (registry-lookup db '(1 58 99)))))
- (when (boundp 'lexical-binding)
- (message "Individual lookup (breaks before lexbind)")
- (should (= 58
- (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
- (message "Grouped individual lookup (breaks before lexbind)")
- (should (= 3
- (length (registry-lookup-breaks-before-lexbind db
- '(1 58 99))))))
- (message "Search")
- (should (= n (length (registry-search db :all t))))
- (should (= n (length (registry-search db :member '((sender "me"))))))
- (message "Secondary index search")
- (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
- (should (equal '(74) (registry-lookup-secondary-value db 'groups "74")))
- (message "Delete")
- (should (registry-delete db '(1) t))
- (decf n)
- (message "Search after delete")
- (should (= n (length (registry-search db :all t))))
- (message "Secondary search after delete")
- (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
- ;; (message "Pruning")
- ;; (let* ((tokeep (registry-search db :member '((extra "more data"))))
- ;; (count (- n (length tokeep)))
- ;; (pruned (registry-prune db))
- ;; (prune-count (length pruned)))
- ;; (message "Expecting to prune %d entries and pruned %d"
- ;; count prune-count)
- ;; (should (and (= count 5)
- ;; (= count prune-count))))
- (message "Done with usage testing.")))
-
-(ert-deftest registry-persistence-test ()
- (let* ((n 100)
- (tempfile (make-temp-file "registry-persistence-"))
- (name "persistence tester")
- (db (registry-make-testable-db n name tempfile))
- size back)
- (message "Saving to %s" tempfile)
- (eieio-persistent-save db)
- (setq size (nth 7 (file-attributes tempfile)))
- (message "Saved to %s: size %d" tempfile size)
- (should (< 0 size))
- (with-temp-buffer
- (insert-file-contents-literally tempfile)
- (should (looking-at (concat ";; Object "
- name
- "\n;; EIEIO PERSISTENT OBJECT"))))
- (message "Reading object back")
- (setq back (eieio-persistent-read tempfile))
- (should back)
- (message "Read object back: %d keys, expected %d==%d"
- (registry-size back) n (registry-size db))
- (should (= (registry-size back) n))
- (should (= (registry-size back) (registry-size db)))
- (delete-file tempfile))
- (message "Done with persistence testing."))
-
(provide 'registry)
;;; registry.el ends here
(let ((map (make-sparse-keymap)))
(define-key map "a" 'shr-show-alt-text)
(define-key map "i" 'shr-browse-image)
+ (define-key map "z" 'shr-zoom-image)
(define-key map "I" 'shr-insert-image)
(define-key map "u" 'shr-copy-url)
(define-key map "v" 'shr-browse-url)
;; Public functions and commands.
-(defun shr-visit-file (file)
- "Parse FILE as an HTML document, and render it in a new buffer."
- (interactive "fHTML file name: ")
+(defun shr-render-buffer (buffer)
+ "Display the HTML rendering of the current buffer."
+ (interactive (list (current-buffer)))
(pop-to-buffer "*html*")
(erase-buffer)
(shr-insert-document
- (with-temp-buffer
- (insert-file-contents file)
+ (with-current-buffer buffer
(libxml-parse-html-region (point-min) (point-max))))
(goto-char (point-min)))
+(defun shr-visit-file (file)
+ "Parse FILE as an HTML document, and render it in a new buffer."
+ (interactive "fHTML file name: ")
+ (with-temp-buffer
+ (insert-file-contents file)
+ (shr-render-buffer (current-buffer))))
+
;;;###autoload
(defun shr-insert-document (dom)
"Render the parsed document DOM into the current buffer.
(list (current-buffer) (1- (point)) (point-marker))
t t))))
+(defun shr-zoom-image ()
+ "Toggle the image size.
+The size will be rotated between the default size, the original
+size, and full-buffer size."
+ (interactive)
+ (let ((url (get-text-property (point) 'image-url))
+ (size (get-text-property (point) 'image-size))
+ (buffer-read-only nil))
+ (if (not url)
+ (message "No image under point")
+ ;; Delete the old picture.
+ (while (get-text-property (point) 'image-url)
+ (forward-char -1))
+ (forward-char 1)
+ (let ((start (point)))
+ (while (get-text-property (point) 'image-url)
+ (forward-char 1))
+ (forward-char -1)
+ (put-text-property start (point) 'display nil)
+ (when (> (- (point) start) 2)
+ (delete-region start (1- (point)))))
+ (message "Inserting %s..." url)
+ (url-retrieve url 'shr-image-fetched
+ (list (current-buffer) (1- (point)) (point-marker)
+ (list (cons 'size
+ (cond ((or (eq size 'default)
+ (null size))
+ 'original)
+ ((eq size 'original)
+ 'full)
+ ((eq size 'full)
+ 'default)))))
+ t))))
+
;;; Utility functions.
(defun shr-transform-dom (dom)
(defun shr-insert (text)
(when (and (eq shr-state 'image)
+ (not (bolp))
(not (string-match "\\`[ \t\n]+\\'" text)))
(insert "\n")
(setq shr-state nil))
((eq shr-folding-mode 'none)
(insert text))
(t
- (when (and (string-match "\\`[ \t\n]" text)
+ (when (and (string-match "\\`[ \t\n ]" text)
(not (bolp))
(not (eq (char-after (1- (point))) ? )))
(insert " "))
- (dolist (elem (split-string text))
+ (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t))
(when (and (bolp)
(> shr-indentation 0))
(shr-indent))
(shr-indent))
(end-of-line))
(insert " ")))
- (unless (string-match "[ \t\n]\\'" text)
+ (unless (string-match "[ \t\n ]\\'" text)
(delete-char -1)))))
(defun shr-find-fill-point ()
(shr-char-kinsoku-eol-p (following-char)))))
(goto-char bp)))
((shr-char-kinsoku-eol-p (preceding-char))
- (if (shr-char-kinsoku-eol-p (following-char))
- ;; There are consecutive kinsoku-eol characters.
- (setq failed t)
- (let ((count 4))
- (while
- (progn
- (backward-char 1)
- (and (> (setq count (1- count)) 0)
- (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
- (or (shr-char-kinsoku-eol-p (preceding-char))
- (shr-char-kinsoku-bol-p (following-char)))))))
- (if (setq failed (= (current-column) shr-indentation))
- ;; There's no breakable point that doesn't violate kinsoku,
- ;; so we go to the second best position.
- (if (looking-at "\\(\\c<+\\)\\c<")
- (goto-char (match-end 1))
- (forward-char 1)))))
- (t
- (if (shr-char-kinsoku-bol-p (preceding-char))
- ;; There are consecutive kinsoku-bol characters.
- (setq failed t)
- (let ((count 4))
- (while (and (>= (setq count (1- count)) 0)
+ ;; Find backward the point where kinsoku-eol characters begin.
+ (let ((count 4))
+ (while
+ (progn
+ (backward-char 1)
+ (and (> (setq count (1- count)) 0)
+ (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
+ (or (shr-char-kinsoku-eol-p (preceding-char))
+ (shr-char-kinsoku-bol-p (following-char)))))))
+ (if (setq failed (= (current-column) shr-indentation))
+ ;; There's no breakable point that doesn't violate kinsoku,
+ ;; so we go to the second best position.
+ (if (looking-at "\\(\\c<+\\)\\c<")
+ (goto-char (match-end 1))
+ (forward-char 1))))
+ ((shr-char-kinsoku-bol-p (following-char))
+ ;; Find forward the point where kinsoku-bol characters end.
+ (let ((count 4))
+ (while (progn
+ (forward-char 1)
+ (and (>= (setq count (1- count)) 0)
(shr-char-kinsoku-bol-p (following-char))
- (shr-char-breakable-p (following-char)))
- (forward-char 1))))))
+ (shr-char-breakable-p (following-char))))))))
(when (eq (following-char) ? )
(forward-char 1))))
(not failed)))
(if (save-excursion
(beginning-of-line)
(looking-at " *$"))
- (insert "\n")
+ (delete-region (match-beginning 0) (match-end 0))
(insert "\n\n")))))
(defun shr-indent ()
(expand-file-name (file-name-nondirectory url)
directory)))))
-(defun shr-image-fetched (status buffer start end)
+(defun shr-image-fetched (status buffer start end &optional flags)
(let ((image-buffer (current-buffer)))
(when (and (buffer-name buffer)
(not (plist-get status :error)))
(with-current-buffer buffer
(save-excursion
(let ((alt (buffer-substring start end))
+ (properties (text-properties-at start))
(inhibit-read-only t))
(delete-region start end)
(goto-char start)
- (funcall shr-put-image-function data alt)))))))
+ (funcall shr-put-image-function data alt flags)
+ (while properties
+ (let ((type (pop properties))
+ (value (pop properties)))
+ (unless (memq type '(display image-size))
+ (put-text-property start (point) type value))))))))))
(kill-buffer image-buffer)))
-(defun shr-put-image (data alt)
+(defun shr-put-image (data alt &optional flags)
"Put image DATA with a string ALT. Return image."
(if (display-graphic-p)
- (let ((image (ignore-errors
- (shr-rescale-image data))))
+ (let* ((size (cdr (assq 'size flags)))
+ (start (point))
+ (image (cond
+ ((eq size 'original)
+ (create-image data nil t :ascent 100))
+ ((eq size 'full)
+ (ignore-errors
+ (shr-rescale-image data t)))
+ (t
+ (ignore-errors
+ (shr-rescale-image data))))))
(when image
;; When inserting big-ish pictures, put them at the
;; beginning of the line.
(when (and (> (current-column) 0)
(> (car (image-size image t)) 400))
(insert "\n"))
- (insert-image image (or alt "*"))
+ (if (eq size 'original)
+ (let ((overlays (overlays-at (point))))
+ (insert-sliced-image image (or alt "*") nil 20 1)
+ (dolist (overlay overlays)
+ (overlay-put overlay 'face 'default)))
+ (insert-image image (or alt "*")))
+ (put-text-property start (point) 'image-size size)
(when (image-animated-p image)
(image-animate image nil 60)))
image)
(insert alt)))
-(defun shr-rescale-image (data)
+(defun shr-rescale-image (data &optional force)
+ "Rescale DATA, if too big, to fit the current buffer.
+If FORCE, rescale the image anyway."
(let ((image (create-image data nil t :ascent 100)))
(if (or (not (fboundp 'imagemagick-types))
(not (get-buffer-window (current-buffer))))
(window-height (truncate (* shr-max-image-proportion
(- (nth 3 edges) (nth 1 edges)))))
scaled-image)
- (when (> height window-height)
+ (when (or force
+ (> height window-height))
(setq image (or (create-image data 'imagemagick t
:height window-height
:ascent 100)
(shr-generic cont)))
(defun shr-tag-br (cont)
- (unless (bobp)
+ (when (and (not (bobp))
+ ;; Only add a newline if we break the current line, or
+ ;; the previous line isn't a blank line.
+ (or (not (bolp))
+ (and (> (- (point) 2) (point-min))
+ (not (= (char-after (- (point) 2)) ?\n)))))
(insert "\n")
(shr-indent))
(shr-generic cont))
(defvar sieve-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-l" 'sieve-upload)
- (define-key map "\C-c\C-c" 'sieve-upload-and-bury)
+ (define-key map "\C-c\C-c" 'sieve-upload-and-kill)
(define-key map "\C-c\C-m" 'sieve-manage)
map)
"Key map used in sieve mode.")
;; various
(define-key map "?" 'sieve-help)
(define-key map "h" 'sieve-help)
- (define-key map "q" 'sieve-bury-buffer)
+ (define-key map "q" 'kill-buffer)
;; activating
(define-key map "m" 'sieve-activate)
(define-key map "u" 'sieve-deactivate)
(message "%s" (substitute-command-keys
"`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove"))))
-(defun sieve-bury-buffer (buf &optional mainbuf)
- "Hide the buffer BUF that was temporarily popped up.
-BUF is assumed to be a temporary buffer used from the buffer MAINBUF."
- (interactive (list (current-buffer)))
- (save-current-buffer
- (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window)
- (get-buffer-window buf t))))
- (when win
- (if (window-dedicated-p win)
- (condition-case ()
- (delete-window win)
- (error (iconify-frame (window-frame win))))
- (if (and mainbuf (get-buffer-window mainbuf))
- (delete-window win)))))
- (with-current-buffer buf
- (bury-buffer (unless (and (eq buf (window-buffer (selected-window)))
- (not (window-dedicated-p (selected-window))))
- buf)))
- (when mainbuf
- (let ((mainwin (or (get-buffer-window mainbuf)
- (get-buffer-window mainbuf 'visible))))
- (when mainwin (select-window mainwin))))))
-
;; Create buffer:
(defun sieve-setup-buffer (server port)
(sieve-upload name)
(bury-buffer))
+;;;###autoload
+(defun sieve-upload-and-kill (&optional name)
+ (interactive)
+ (sieve-upload name)
+ (kill-buffer))
+
(provide 'sieve)
;; sieve.el ends here
"x509" "-in" (expand-file-name certfile) "-text")
(fundamental-mode)
(set-buffer-modified-p nil)
- (toggle-read-only t)
+ (setq buffer-read-only t)
(goto-char (point-min))))
(defun smime-draw-buffer ()
;; all this is done inside a condition-case to trap errors
-(eval-when-compile
- (autoload 'bbdb-buffer "bbdb")
- (autoload 'bbdb-create-internal "bbdb")
- (autoload 'bbdb-search-simple "bbdb"))
-
;; Autoloaded in message, which we require.
(declare-function gnus-extract-address-components "gnus-util" (from))
(file-error
;; `bbdb-records' should not be bound as an autoload function
;; before loading bbdb because of `bbdb-hashtable-size'.
+ (defalias 'bbdb-buffer 'ignore)
+ (defalias 'bbdb-create-internal 'ignore)
(defalias 'bbdb-records 'ignore)
(defalias 'spam-BBDB-register-routine 'ignore)
(defalias 'spam-enter-ham-BBDB 'ignore)
+ (defalias 'spam-exists-in-BBDB-p 'ignore)
+ (defalias 'bbdb-gethash 'ignore)
nil))
;; when the BBDB changes, we want to clear out our cache
'ignore))
(net-address (nth 1 parsed-address))
(record (and net-address
- (bbdb-search-simple nil net-address))))
+ (spam-exists-in-BBDB-p net-address))))
(when net-address
(gnus-message 6 "%s address %s %s BBDB"
(if remove "Deleting" "Adding")
(defun spam-BBDB-unregister-routine (articles)
(spam-BBDB-register-routine articles t))
+ (defsubst spam-exists-in-BBDB-p (net)
+ (when (and (stringp net) (not (zerop (length net))))
+ (bbdb-records)
+ (bbdb-gethash (downcase net))))
+
(defun spam-check-BBDB ()
"Mail from people in the BBDB is classified as ham or non-spam"
- (let ((who (message-fetch-field "from")))
- (when who
- (setq who (nth 1 (gnus-extract-address-components who)))
- (if
- (if (fboundp 'bbdb-search)
- (bbdb-search (bbdb-records) who) ;; v3
- (bbdb-search-simple nil who)) ;; v2
+ (let ((net (message-fetch-field "from")))
+ (when net
+ (setq net (nth 1 (gnus-extract-address-components net)))
+ (if (spam-exists-in-BBDB-p net)
t
(if spam-use-BBDB-exclusive
spam-split-group
arglist)))
(unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
(nreverse arglist))))
- ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap)))
+ ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
"[Arg list not available until function definition is loaded.]")
(t t)))
found via `load-path'. The return value can also be `C-source', which
means that OBJECT is a function or variable defined in C. If no
suitable file is found, return nil."
- (let* ((autoloaded (eq (car-safe type) 'autoload))
+ (let* ((autoloaded (autoloadp type))
(file-name (or (and autoloaded (nth 1 type))
(symbol-file
object (if (memq type (list 'defvar 'defface))
(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 (if (symbolp remapped)
+ (concat "`" (symbol-name remapped) "'")
+ "an anonymous command"))
+ (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 (function-get function 'compiler-macro)))
+ (when handler
+ (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)
+ (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)
+ ;; Ignore lambda constructs, keyboard macros, etc.
+ (let* ((obsolete (and (symbolp function)
+ (get function 'byte-obsolete-info)))
+ (use (car obsolete)))
+ (when obsolete
+ (insert "\nThis "
+ (if (eq (car-safe (symbol-function 'with-current-buffer))
+ 'macro)
+ "macro"
+ "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)
+ "Return non-nil if FUNCTION has previously been autoloaded.
+FILE is the file where FUNCTION was probably defined."
+ (let* ((file (file-name-sans-extension (file-truename file)))
+ (load-hist load-history)
+ (target (cons t function))
+ found)
+ (while (and load-hist (not found))
+ (and (caar load-hist)
+ (equal (file-name-sans-extension (caar load-hist)) file)
+ (setq found (member target (cdar load-hist))))
+ (setq load-hist (cdr load-hist)))
+ found))
+
;;;###autoload
(defun describe-function-1 (function)
(let* ((advised (and (symbolp function) (featurep 'advice)
(def (if (symbolp real-function)
(symbol-function real-function)
function))
- file-name string
- (beg (if (commandp def) "an interactive " "a "))
+ (aliased (symbolp def))
+ (real-def (if aliased
+ (let ((f def))
+ (while (and (fboundp f)
+ (symbolp (symbol-function f)))
+ (setq f (symbol-function f)))
+ f)
+ def))
+ (file-name (find-lisp-object-file-name function def))
(pt1 (with-current-buffer (help-buffer) (point)))
- errtype)
- (setq string
- (cond ((or (stringp def) (vectorp def))
- "a keyboard macro")
- ((subrp def)
- (if (eq 'unevalled (cdr (subr-arity def)))
- (concat beg "special form")
- (concat beg "built-in function")))
- ((byte-code-function-p def)
- (concat beg "compiled Lisp function"))
- ((symbolp def)
- (while (and (fboundp def)
- (symbolp (symbol-function def)))
- (setq def (symbol-function def)))
- ;; Handle (defalias 'foo 'bar), where bar is undefined.
- (or (fboundp def) (setq errtype 'alias))
- (format "an alias for `%s'" def))
- ((eq (car-safe def) 'lambda)
- (concat beg "Lisp function"))
- ((eq (car-safe def) 'macro)
- "a Lisp macro")
- ((eq (car-safe def) 'closure)
- (concat beg "Lisp closure"))
- ((eq (car-safe def) 'autoload)
- (format "%s autoloaded %s"
- (if (commandp def) "an interactive" "an")
- (if (eq (nth 4 def) 'keymap) "keymap"
- (if (nth 4 def) "Lisp macro" "Lisp function"))))
- ((keymapp def)
- (let ((is-full nil)
- (elts (cdr-safe def)))
- (while elts
- (if (char-table-p (car-safe elts))
- (setq is-full t
- elts nil))
- (setq elts (cdr-safe elts)))
- (if is-full
- "a full keymap"
- "a sparse keymap")))
- (t "")))
- (princ string)
- (if (eq errtype 'alias)
+ (beg (if (and (or (byte-code-function-p def)
+ (keymapp def)
+ (memq (car-safe def) '(macro lambda closure)))
+ file-name
+ (help-fns--autoloaded-p function file-name))
+ (if (commandp def)
+ "an interactive autoloaded "
+ "an autoloaded ")
+ (if (commandp def) "an interactive " "a "))))
+
+ ;; Print what kind of function-like object FUNCTION is.
+ (princ (cond ((or (stringp def) (vectorp def))
+ "a keyboard macro")
+ ((subrp def)
+ (if (eq 'unevalled (cdr (subr-arity def)))
+ (concat beg "special form")
+ (concat beg "built-in function")))
+ ((byte-code-function-p def)
+ (concat beg "compiled Lisp function"))
+ (aliased
+ (format "an alias for `%s'" real-def))
+ ((eq (car-safe def) 'lambda)
+ (concat beg "Lisp function"))
+ ((eq (car-safe def) 'macro)
+ (concat beg "Lisp macro"))
+ ((eq (car-safe def) 'closure)
+ (concat beg "Lisp closure"))
+ ((autoloadp def)
+ (format "%s autoloaded %s"
+ (if (commandp def) "an interactive" "an")
+ (if (eq (nth 4 def) 'keymap) "keymap"
+ (if (nth 4 def) "Lisp macro" "Lisp function"))))
+ ((keymapp def)
+ (let ((is-full nil)
+ (elts (cdr-safe def)))
+ (while elts
+ (if (char-table-p (car-safe elts))
+ (setq is-full t
+ elts nil))
+ (setq elts (cdr-safe elts)))
+ (concat beg (if is-full "keymap" "sparse keymap"))))
+ (t "")))
+
+ (if (and aliased (not (fboundp real-def)))
(princ ",\nwhich is not defined. Please make a bug report.")
(with-current-buffer standard-output
(save-excursion
(save-match-data
(when (re-search-backward "alias for `\\([^`']+\\)'" nil t)
- (help-xref-button 1 'help-function def)))))
+ (help-xref-button 1 'help-function real-def)))))
- (setq file-name (find-lisp-object-file-name function def))
(when file-name
(princ " in `")
;; We used to add .el to the file name,
(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)))))
- ;; Note that list* etc do not get this property until
- ;; cl-hack-byte-compiler runs, after bytecomp is loaded.
- (when (and (symbolp function)
- (eq (get function 'byte-compile)
- 'cl-byte-compile-compiler-macro))
- (princ "This function has a compiler macro")
- (let ((lib (get function 'compiler-macro-file)))
- (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"))
- (let* ((advertised (gethash def advertised-signature-table t))
- (arglist (if (listp advertised)
- advertised (help-function-arglist def)))
- (doc (condition-case err (documentation function)
- (error (format "No Doc! %S" err))))
- (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 def)
- (vectorp def))
- (format "\nMacro: %s" (format-kbd-macro 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))))
-
- ;; 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")))
-
- (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."))))))))
+
+ (let* ((doc-raw (condition-case err
+ (documentation function t)
+ (error (format "No Doc! %S" err))))
+ ;; If the function is autoloaded, and its docstring has
+ ;; key substitution constructs, load the library.
+ (doc (progn
+ (and (autoloadp real-def)
+ help-enable-auto-load
+ (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]"
+ doc-raw)
+ (load (cadr real-def) t))
+ (substitute-command-keys doc-raw))))
+
+ (help-fns--key-bindings function)
+ (with-current-buffer standard-output
+ (setq doc (help-fns--signature function doc real-def real-function))
+
+ (help-fns--compiler-macro function)
+ (help-fns--parent-mode function)
+ (help-fns--obsolete function)
+
+ (insert "\n"
+ (or doc "Not documented.")))))))
\f
;; Variables
(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.
(princ "value is ")
(let ((from (point))
(line-beg (line-beginning-position))
- ;;
(print-rep
(let ((print-quoted t))
(prin1-to-string val))))
(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; ")))
(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.
(obsolete (get variable 'byte-obsolete-variable))
(use (car obsolete))
(safe-var (get variable 'safe-local-variable))
- (doc (or (documentation-property variable 'variable-documentation)
- (documentation-property alias 'variable-documentation)))
+ (doc (condition-case err
+ (or (documentation-property
+ variable 'variable-documentation)
+ (documentation-property
+ 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 buffer-local when set in any fashion.\n"))
+ (princ " Automatically becomes ")
+ (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)))
(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.
(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")))
(princ " This variable is safe as a file local variable ")
(princ "if its value\n satisfies the predicate ")
(princ (if (byte-code-function-p safe-var)
- "which is byte-compiled expression.\n"
+ "which is a byte-compiled expression.\n"
(format "`%s'.\n" safe-var))))
(if extra-line (terpri))
;;; Code:
(require 'button)
-(require 'view)
(eval-when-compile (require 'easymenu))
(defvar help-mode-map
(define-key map [mouse-2] 'help-follow-mouse)
(define-key map "\C-c\C-b" 'help-go-back)
(define-key map "\C-c\C-f" 'help-go-forward)
+ (define-key map [XF86Back] 'help-go-back)
+ (define-key map [XF86Forward] 'help-go-forward)
(define-key map "\C-c\C-c" 'help-follow-symbol)
(define-key map "\r" 'help-follow)
map)
: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"))
+
\f
+(defvar bookmark-make-record-function)
+
;;;###autoload
(define-derived-mode help-mode special-mode "Help"
"Major mode for viewing help text and navigating references in it.
Commands:
\\{help-mode-map}"
(set (make-local-variable 'revert-buffer-function)
- 'help-mode-revert-buffer))
+ 'help-mode-revert-buffer)
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'help-bookmark-make-record))
;;;###autoload
(defun help-mode-setup ()
;;;###autoload
(defun help-mode-finish ()
(when (eq major-mode 'help-mode)
- ;; View mode's read-only status of existing *Help* buffer is lost
- ;; by with-output-to-temp-buffer.
- (toggle-read-only 1)
-
+ (setq buffer-read-only t)
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t))
((and
(or (boundp sym)
(get sym 'variable-documentation))
- (or
- (documentation-property
- sym 'variable-documentation)
- (condition-case nil
+ (condition-case err
+ (or
+ (documentation-property
+ sym 'variable-documentation)
(documentation-property
(indirect-variable sym)
- 'variable-documentation)
- (cyclic-variable-indirection nil))))
+ 'variable-documentation))
+ (error (message "No doc found: %S" err) nil)))
(help-xref-button 8 'help-variable sym))
((fboundp sym)
(help-xref-button 8 'help-function sym)))))))
(with-output-to-temp-buffer (help-buffer)
(insert string)))
+\f
+;; Bookmark support
+
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-make-record-default "bookmark"
+ (&optional no-file no-context posn))
+
+(defun help-bookmark-make-record ()
+ "Create and return a help-mode bookmark record.
+Implements `bookmark-make-record-function' for help-mode buffers."
+ (unless (car help-xref-stack-item)
+ (error "Cannot create bookmark - help command not known"))
+ `(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT)
+ (help-fn . ,(car help-xref-stack-item))
+ (help-args . ,(cdr help-xref-stack-item))
+ (position . ,(point))
+ (handler . help-bookmark-jump)))
+
+;;;###autoload
+(defun help-bookmark-jump (bookmark)
+ "Jump to help-mode bookmark BOOKMARK.
+Handler function for record returned by `help-bookmark-make-record'.
+BOOKMARK is a bookmark name or a bookmark record."
+ (let ((help-fn (bookmark-prop-get bookmark 'help-fn))
+ (help-args (bookmark-prop-get bookmark 'help-args))
+ (position (bookmark-prop-get bookmark 'position)))
+ (apply help-fn help-args)
+ (pop-to-buffer "*Help*")
+ (goto-char position)))
+
+
(provide 'help-mode)
;;; help-mode.el ends here
;; `help-window-point-marker' is a marker you can move to a valid
;; position of the buffer shown in the help window in order to override
;; the standard positioning mechanism (`point-min') chosen by
-;; `with-output-to-temp-buffer'. `with-help-window' has this point
-;; nowhere before exiting. Currently used by `view-lossage' to assert
-;; that the last keystrokes are always visible.
+;; `with-output-to-temp-buffer' and `with-temp-buffer-window'.
+;; `with-help-window' has this point nowhere before exiting. Currently
+;; used by `view-lossage' to assert that the last keystrokes are always
+;; visible.
(defvar help-window-point-marker (make-marker)
"Marker to override default `window-point' in help windows.")
;; Secondly, the buffer has not been displayed yet,
;; so we don't know whether its frame will be selected.
nil)
- (display-buffer-reuse-frames
- (setq help-return-method (cons (selected-window)
- 'quit-window))
- nil)
((not (one-window-p t))
(setq help-return-method
(cons (selected-window) 'quit-window))
(setq saved-yank-menu (copy-sequence yank-menu))
(menu-bar-update-yank-menu "(any string)" nil))
(setq key (read-key-sequence "Describe key (or click or menu item): "))
+ ;; Clear the echo area message (Bug#7014).
+ (message nil)
;; If KEY is a down-event, read and discard the
;; corresponding up-event. Note that there are also
;; down-events on scroll bars and mode lines: the actual
(error "Cannot find minor mode for `%s'" indicator))))
(defun lookup-minor-mode-from-indicator (indicator)
- "Return a minor mode symbol from its indicator on the modeline."
+ "Return a minor mode symbol from its indicator on the mode line."
;; remove first space if existed
(if (and (< 0 (length indicator))
(eq (aref indicator 0) ?\s))
result))
\f
;;; Automatic resizing of temporary buffers.
-(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
+(defcustom temp-buffer-max-height
+ (lambda (buffer)
+ (if (eq (selected-window) (frame-root-window))
+ (/ (x-display-pixel-height) (frame-char-height) 2)
+ (/ (- (frame-height) 2) 2)))
"Maximum height of a window displaying a temporary buffer.
This is effective only when Temp Buffer Resize mode is enabled.
The value is the maximum height (in lines) which
function is called, the window to be resized is selected."
:type '(choice integer function)
:group 'help
- :version "20.4")
+ :version "24.2")
+
+(defcustom temp-buffer-resize-frames nil
+ "Non-nil means `temp-buffer-resize-mode' can resize frames.
+A frame can be resized if and only if its root window is a live
+window. The height of the root window is subject to the values of
+`temp-buffer-max-height' and `window-min-height'."
+ :type 'boolean
+ :version "24.2"
+ :group 'help)
+
+(defcustom temp-buffer-resize-regexps nil
+ "List of regexps that inhibit Temp Buffer Resize mode.
+Any window of a buffer whose name matches one of these regular
+expressions is left alone by Temp Buffer Resize mode."
+ :type '(repeat
+ :tag "Buffer"
+ :value ""
+ (regexp :format "%v"))
+ :version "24.3"
+ :group 'help)
(define-minor-mode temp-buffer-resize-mode
- "Toggle auto-shrinking temp buffer windows (Temp Buffer Resize mode).
+ "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode).
With a prefix argument ARG, enable Temp Buffer Resize mode if ARG
is positive, and disable it otherwise. If called from Lisp,
enable the mode if ARG is omitted or nil.
When Temp Buffer Resize mode is enabled, the windows in which we
-show a temporary buffer are automatically reduced in height to
+show a temporary buffer are automatically resized in height to
fit the buffer's contents, but never more than
`temp-buffer-max-height' nor less than `window-min-height'.
+A window is resized only if it has been specially created for the
+buffer. Windows that have shown another buffer before are not
+resized. A window showing a buffer whose name matches any of the
+expressions in `temp-buffer-resize-regexps' is not resized. A
+frame is resized only if `temp-buffer-resize-frames' is non-nil.
+
This mode is used by `help', `apropos' and `completion' buffers,
and some others."
:global t :group 'help
(add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
(remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
-(defun resize-temp-buffer-window ()
- "Resize the selected window to fit its contents.
-Will not make it higher than `temp-buffer-max-height' nor smaller
-than `window-min-height'. Do nothing if the selected window is
-not vertically combined or some of its contents are scrolled out
-of view."
- (when (and (pos-visible-in-window-p (point-min))
- (window-combined-p))
- (fit-window-to-buffer
- nil
- (if (functionp temp-buffer-max-height)
- (funcall temp-buffer-max-height (window-buffer))
- temp-buffer-max-height))))
+(defun resize-temp-buffer-window (&optional window)
+ "Resize WINDOW to fit its contents.
+WINDOW can be any live window and defaults to the selected one.
+
+Do not make WINDOW higher than `temp-buffer-max-height' nor
+smaller than `window-min-height'. Do nothing if WINDOW is not
+vertically combined or some of its contents are scrolled out of
+view. Do nothing if the name of WINDOW's buffer matches an
+expression in `temp-buffer-resize-regexps'."
+ (setq window (window-normalize-window window t))
+ (let ((buffer-name (buffer-name (window-buffer window))))
+ (unless (catch 'found
+ (dolist (regexp temp-buffer-resize-regexps)
+ (when (string-match regexp buffer-name)
+ (throw 'found t))))
+ (let ((height (if (functionp temp-buffer-max-height)
+ (with-selected-window window
+ (funcall temp-buffer-max-height (window-buffer)))
+ temp-buffer-max-height))
+ (quit-cadr (cadr (window-parameter window 'quit-restore))))
+ (cond
+ ;; Don't resize WINDOW if it showed another buffer before.
+ ((and (eq quit-cadr 'window)
+ (pos-visible-in-window-p (point-min) window)
+ (window-combined-p window))
+ (fit-window-to-buffer window height))
+ ((and temp-buffer-resize-frames
+ (eq quit-cadr 'frame)
+ (eq window (frame-root-window window)))
+ (let ((frame (window-frame window)))
+ (fit-frame-to-buffer
+ frame (+ (frame-height frame)
+ (- (window-total-size window))
+ height)))))))))
;;; Help windows.
(defcustom help-window-select 'other
:group 'help
:version "23.1")
+(defcustom help-enable-auto-load t
+ "Whether Help commands can perform autoloading.
+If non-nil, whenever \\[describe-function] is called for an
+autoloaded function whose docstring contains any key substitution
+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.3")
+
(defun help-window-display-message (quit-part window &optional scroll)
"Display message telling how to quit and scroll help window.
QUIT-PART is a string telling how to quit the help window WINDOW.
;;; Code:
(require 'eldoc)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;
;; vars here
"Edit a file in a hex dump format using the hexl filter."
:group 'data)
+(defcustom hexl-bits 16
+ "The bit grouping that hexl will use."
+ :type '(choice (const 8 )
+ (const 16)
+ (const 32)
+ (const 64))
+ :group 'hexl
+ :version "24.3")
(defcustom hexl-program "hexl"
"The program that will hexlify and dehexlify its stdin.
(defcustom hexl-options (format "-hex %s" hexl-iso)
"Space separated options to `hexl-program' that suit your needs.
-Quoting cannot be used, so the arguments cannot themselves contain spaces."
+Quoting cannot be used, so the arguments cannot themselves contain spaces.
+If you wish to set the `-group-by-X-bits' options, set `hexl-bits' instead,
+as that will override any bit grouping options set here."
:type 'string
:group 'hexl)
(2 'hexl-ascii-region t t)))
"Font lock keywords used in `hexl-mode'.")
+(defun hexl-rulerize (string bits)
+ (let ((size (/ bits 4)) (strlen (length string)) (pos 0) (ruler ""))
+ (while (< pos strlen)
+ (setq ruler (concat ruler " " (substring string pos (+ pos size))))
+ (setq pos (+ pos size)))
+ (substring ruler 1) ))
+
+(defvar hexl-rulers
+ (mapcar
+ (lambda (bits)
+ (cons bits
+ (concat " 87654321 "
+ (hexl-rulerize "00112233445566778899aabbccddeeff" bits)
+ " 0123456789abcdef")))
+ '(8 16 32 64)))
;; routines
(put 'hexl-mode 'mode-class 'special)
+;; 10 chars for the "address: "
+;; 32 chars for the hexlified bytes
+;; 1 char for the space
+;; 16 chars for the character display
+;; X chars for the spaces (128 bits divided by the hexl-bits)
+;; 1 char for the newline.
+(defun hexl-line-displen ()
+ "The length of a hexl display line (varies with `hexl-bits')."
+ (+ 60 (/ 128 (or hexl-bits 16))))
(defun hexl-mode--minor-mode-p (var)
(memq var '(ruler-mode hl-line-mode)))
Each line in the buffer has an \"address\" (displayed in hexadecimal)
representing the offset into the file that the characters on this line
are at and 16 characters from the file (displayed as hexadecimal
-values grouped every 16 bits) and as their ASCII values.
+values grouped every `hexl-bits' bits) and as their ASCII values.
If any of the characters (displayed as ASCII characters) are
unprintable (control or meta characters) they will be replaced as
(hexlify-buffer)
(restore-buffer-modified-p modified))
(set (make-local-variable 'hexl-max-address)
- (let* ((full-lines (/ (buffer-size) 68))
- (last-line (% (buffer-size) 68))
- (last-line-bytes (% last-line 52)))
- (+ last-line-bytes (* full-lines 16) -1)))
+ (+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15))
(condition-case nil
(hexl-goto-address original-point)
(error nil)))
" \\(?: .+\n[a-f0-9]+: \\)?"))
textre))
bound noerror count))
- (let ((isearch-search-fun-function nil))
- (isearch-search-fun))))
+ (isearch-search-fun-default)))
(defvar hexl-in-save-buffer nil)
(let ((completion-ignored-extensions nil))
(read-file-name "Filename: " nil nil 'ret-must-match))))
;; Ignore the user's setting of default major-mode.
- (letf (((default-value 'major-mode) 'fundamental-mode))
+ (cl-letf (((default-value 'major-mode) 'fundamental-mode))
(find-file-literally filename))
(if (not (eq major-mode 'hexl-mode))
(hexl-mode)))
(defun hexl-current-address (&optional validate)
"Return current hexl-address."
(interactive)
- (let ((current-column (- (% (- (point) (point-min) -1) 68) 11))
+ (let ((current-column
+ (- (% (- (point) (point-min) -1) (hexl-line-displen)) 11))
(hexl-address 0))
(if (< current-column 0)
(if validate
(error "Point is not on a character in the file")
(setq current-column 0)))
(setq hexl-address
- (+ (* (/ (- (point) (point-min) -1) 68) 16)
- (if (>= current-column 41)
- (- current-column 41)
- (/ (- current-column (/ current-column 5)) 2))))
+ (+ (* (/ (- (point) (point-min) -1)
+ (hexl-line-displen)) 16)
+ (if (>= current-column (- (hexl-ascii-start-column) 10))
+ (- current-column (- (hexl-ascii-start-column) 10))
+ (/ (- current-column
+ (/ current-column (1+ (/ hexl-bits 4)))) 2))))
(when (called-interactively-p 'interactive)
(message "Current address is %d/0x%08x" hexl-address hexl-address))
hexl-address))
(let ((addr (hexl-current-address)))
(format "Current address is %d/0x%08x" addr addr)))
+(defun hexl-ascii-start-column ()
+ "Column at which the ascii portion of the hexl display starts."
+ (+ 43 (/ 128 hexl-bits)))
+
(defun hexl-address-to-marker (address)
"Return buffer position for ADDRESS."
(interactive "nAddress: ")
- (+ (* (/ address 16) 68) 10 (point-min) (/ (* (% address 16) 5) 2)))
+ (let ((N (* (% address 16) 2)))
+ (+ (* (/ address 16) (hexl-line-displen)) ; hexl line no * display length
+ 10 ; 10 chars for the "address: " prefix
+ (point-min) ; base offset (point usually starts at 1, not 0)
+ (+ N (/ N (/ hexl-bits 4))) )) ) ; char offset into hexl display line
(defun hexl-goto-address (address)
"Go to hexl-mode (decimal) address ADDRESS.
(defun hexl-beginning-of-line ()
"Goto beginning of line in hexl mode."
(interactive)
- (goto-char (+ (* (/ (point) 68) 68) 11)))
+ (goto-char (+ (* (/ (point) (hexl-line-displen)) (hexl-line-displen)) 11)))
(defun hexl-end-of-line ()
"Goto end of line in hexl mode."
;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789ABCDEF
+(defun hexl-options (&optional test)
+ "Combine `hexl-bits' with `hexl-options', altering `hexl-options' as needed
+to produce the command line options to pass to the hexl command."
+ (let ((opts (or test hexl-options)))
+ (when (memq hexl-bits '(8 16 32 64))
+ (when (string-match "\\(.*\\)-group-by-[0-9]+-bits\\(.*\\)" opts)
+ (setq opts (concat (match-string 1 opts)
+ (match-string 2 opts))))
+ (setq opts (format "%s -group-by-%d-bits " opts hexl-bits)) )
+ opts))
+
;;;###autoload
(defun hexlify-buffer ()
"Convert a binary buffer to hexl format.
(mapcar (lambda (s)
(if (not (multibyte-string-p s)) s
(encode-coding-string s locale-coding-system)))
- (split-string hexl-options)))
+ (split-string (hexl-options))))
(if (> (point) (hexl-address-to-marker hexl-max-address))
(hexl-goto-address hexl-max-address))))
(buffer-undo-list t))
(apply 'call-process-region (point-min) (point-max)
(expand-file-name hexl-program exec-directory)
- t t nil "-de" (split-string hexl-options))))
+ t t nil "-de" (split-string (hexl-options)))))
(defun hexl-char-after-point ()
"Return char for ASCII hex digits at point."
(error "Invalid character 0x%x -- must be in the range [0..255]" ch))
(let ((address (hexl-current-address t)))
(while (> num 0)
- (let ((hex-position
- (+ (* (/ address 16) 68)
- 10 (point-min)
- (* 2 (% address 16))
- (/ (% address 16) 2)))
+ (let ((hex-position (hexl-address-to-marker address))
(ascii-position
- (+ (* (/ address 16) 68) 51 (point-min) (% address 16)))
+ (+ (* (/ address 16) (hexl-line-displen))
+ (hexl-ascii-start-column)
+ (point-min)
+ (% address 16)))
at-ascii-position)
(if (= (point) ascii-position)
(setq at-ascii-position t))
(if at-ascii-position
(progn
(beginning-of-line)
- (forward-char 51)
+ (forward-char (hexl-ascii-start-column))
(forward-char (% address 16)))))
(setq num (1- num)))))
(defun hexl-follow-ascii-find ()
"Find and highlight the ASCII element corresponding to current point."
- (let ((pos (+ 51
+ (let ((pos (+ (hexl-ascii-start-column)
(- (point) (current-column))
(mod (hexl-current-address) 16))))
(move-overlay hexl-ascii-overlay pos (1+ pos))
(defun hexl-mode-ruler ()
"Return a string ruler for hexl mode."
(let* ((highlight (mod (hexl-current-address) 16))
- (s " 87654321 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789abcdef")
+ (s (cdr (assq hexl-bits hexl-rulers)))
(pos 0))
(set-text-properties 0 (length s) nil s)
;; Turn spaces in the header into stretch specs so they work
`(space :align-to ,(1- pos))
s))
;; Highlight the current column.
- (put-text-property (+ 11 (/ (* 5 highlight) 2))
- (+ 13 (/ (* 5 highlight) 2))
- 'face 'highlight s)
+ (let ( (offset (+ (* 2 highlight) (/ (* 8 highlight) hexl-bits))) )
+ (put-text-property (+ 11 offset) (+ 13 offset) 'face 'highlight s))
;; Highlight the current ascii column
- (put-text-property (+ 13 39 highlight) (+ 13 40 highlight)
- 'face 'highlight s)
+ (put-text-property (+ (hexl-ascii-start-column) highlight 1)
+ (+ (hexl-ascii-start-column) highlight 2)
+ 'face 'highlight s)
s))
;; startup stuff.
;;
;; Setup:
;;
-;; Put the following code in your .emacs file. This turns on
+;; Put the following code in your init file. This turns on
;; hi-lock mode and adds a "Regexp Highlighting" entry
;; to the edit menu.
;;
;; (global-hi-lock-mode 1)
;;
;; To enable the use of patterns found in files (presumably placed
-;; there by hi-lock) include the following in your .emacs file:
+;; there by hi-lock) include the following in your init file:
;;
;; (setq hi-lock-file-patterns-policy 'ask)
;;
(defvar hi-lock-interactive-patterns nil
"Patterns provided to hi-lock by user. Should not be changed.")
+(define-obsolete-variable-alias 'hi-lock-face-history
+ 'hi-lock-face-defaults "23.1")
(defvar hi-lock-face-defaults
'("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-black-b"
"hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
"Default faces for hi-lock interactive functions.")
-;(dolist (f hi-lock-face-defaults) (unless (facep f) (error "%s not a face" f)))
-
-(define-obsolete-variable-alias 'hi-lock-face-history
- 'hi-lock-face-defaults
- "23.1")
+;;(dolist (f hi-lock-face-defaults)
+;; (unless (facep f) (error "%s not a face" f)))
(define-obsolete-variable-alias 'hi-lock-regexp-history
'regexp-history
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.
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)
"Possible archaic use of (hi-lock-mode).
Use (global-hi-lock-mode 1) in .emacs to enable hi-lock for all buffers,
use (hi-lock-mode 1) for individual buffers. For compatibility with Emacs
-versions before 22 use the following in your .emacs file:
+versions before 22 use the following in your init file:
(if (functionp 'global-hi-lock-mode)
(global-hi-lock-mode 1)
(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)
;;;###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.
-\\<minibuffer-local-map>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
;;;###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.
-\\<minibuffer-local-map>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
;;;###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
;;;###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'.\)
-\\<minibuffer-local-must-match-map>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)
(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))
;; opposite situation to occur, that `hippie-expand' misses some
;; suggestion because it thinks it has already tried it.
;;
-;; Acknowledgement
+;; Acknowledgment
;;
;; I want to thank Mikael Djurfeldt in discussions with whom the idea
;; of this function took form.
(hfy-face-attr-for-class fn hfy-display-class))
((and (symbolp fn)
(facep (symbol-value fn)))
- ;; Obsolete faces like `font-lock-reference-face' are defined as
- ;; aliases for another face.
(hfy-face-attr-for-class (symbol-value fn) hfy-display-class))
(t nil)))
(eval-when-compile
(require 'ibuf-macs)
- (require 'cl))
+ (require 'cl-lib))
;;; Utility functions
(defun ibuffer-delete-alist (key alist)
(defun ibuffer-included-in-filter-p-1 (buf filter)
(not
(not
- (case (car filter)
- (or
+ (pcase (car filter)
+ (`or
(memq t (mapcar #'(lambda (x)
(ibuffer-included-in-filter-p buf x))
(cdr filter))))
- (saved
+ (`saved
(let ((data
(assoc (cdr filter)
ibuffer-saved-filters)))
(ibuffer-filter-disable t)
(error "Unknown saved filter %s" (cdr filter)))
(ibuffer-included-in-filters-p buf (cadr data))))
- (t
- (let ((filterdat (assq (car filter)
- ibuffer-filtering-alist)))
- ;; filterdat should be like (TYPE DESCRIPTION FUNC)
- ;; just a sanity check
- (unless filterdat
- (ibuffer-filter-disable t)
- (error "Undefined filter %s" (car filter)))
- (not
- (not
- (funcall (caddr filterdat)
- buf
- (cdr filter))))))))))
+ (_
+ (pcase-let ((`(,_type ,_desc ,func)
+ (assq (car filter) ibuffer-filtering-alist)))
+ (unless func
+ (ibuffer-filter-disable t)
+ (error "Undefined filter %s" (car filter)))
+ (funcall func buf (cdr filter))))))))
(defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault)
(let ((filter-group-alist (if nodefault
(i 0))
(dolist (filtergroup filter-group-alist)
(let ((filterset (cdr filtergroup)))
- (multiple-value-bind (hip-crowd lamers)
- (values-list
+ (cl-multiple-value-bind (hip-crowd lamers)
+ (cl-values-list
(ibuffer-split-list (lambda (bufmark)
(ibuffer-included-in-filters-p (car bufmark)
filterset))
bmarklist))
(aset vec i hip-crowd)
- (incf i)
+ (cl-incf i)
(setq bmarklist lamers))))
(let (ret)
(dotimes (j i ret)
(if (equal (car groups) group)
(setq found t
groups nil)
- (incf res)
+ (cl-incf res)
(setq groups (cdr groups))))
res)))
(cond ((not found)
The value from `ibuffer-saved-filter-groups' is used."
(interactive
(list
- (if (null ibuffer-saved-filter-groups)
- (error "No saved filters")
- (completing-read "Switch to saved filter group: "
- ibuffer-saved-filter-groups nil t))))
+ (cond ((null ibuffer-saved-filter-groups)
+ (error "No saved filters"))
+ ;; `ibuffer-saved-filter-groups' is a user variable that defaults
+ ;; to nil. We assume that with one element in this list the user
+ ;; knows what she wants. See bug#12331.
+ ((null (cdr ibuffer-saved-filter-groups))
+ (caar ibuffer-saved-filter-groups))
+ (t
+ (completing-read "Switch to saved filter group: "
+ ibuffer-saved-filter-groups nil t)))))
(setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups))
ibuffer-hidden-filter-groups nil)
(ibuffer-update nil t))
(when (null ibuffer-filtering-qualifiers)
(error "No filters in effect"))
(let ((lim (pop ibuffer-filtering-qualifiers)))
- (case (car lim)
- (or
+ (pcase (car lim)
+ (`or
(setq ibuffer-filtering-qualifiers (append
(cdr lim)
ibuffer-filtering-qualifiers)))
- (saved
+ (`saved
(let ((data
(assoc (cdr lim)
ibuffer-saved-filters)))
(setq ibuffer-filtering-qualifiers (append
(cadr data)
ibuffer-filtering-qualifiers))))
- (not
+ (`not
(push (cdr lim)
ibuffer-filtering-qualifiers))
- (t
+ (_
(error "Filter type %s is not compound" (car lim)))))
(ibuffer-update nil t))
(ibuffer-format-qualifier-1 qualifier)))
(defun ibuffer-format-qualifier-1 (qualifier)
- (case (car qualifier)
- (saved
+ (pcase (car qualifier)
+ (`saved
(concat " [filter: " (cdr qualifier) "]"))
- (or
+ (`or
(concat " [OR" (mapconcat #'ibuffer-format-qualifier
(cdr qualifier) "") "]"))
- (t
+ (_
(let ((type (assq (car qualifier) ibuffer-filtering-alist)))
(unless qualifier
(error "Ibuffer: bad qualifier %s" qualifier))
(concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
-(defun ibuffer-list-buffer-modes ()
- "Create an alist of buffer modes currently in use.
-The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)."
- (let ((bufs (buffer-list))
- (modes)
- (this-mode))
- (while bufs
- (setq this-mode (buffer-local-value 'major-mode (car bufs))
- bufs (cdr bufs))
- (add-to-list
- 'modes
- `(,(symbol-name this-mode) .
- ,this-mode)))
- modes))
+(defun ibuffer-list-buffer-modes (&optional include-parents)
+ "Create a completion table of buffer modes currently in use.
+If INCLUDE-PARENTS is non-nil then include parent modes."
+ (let ((modes))
+ (dolist (buf (buffer-list))
+ (let ((this-mode (buffer-local-value 'major-mode buf)))
+ (while (and this-mode (not (memq this-mode modes)))
+ (push this-mode modes)
+ (setq this-mode (and include-parents
+ (get this-mode 'derived-mode-parent))))))
+ (mapcar #'symbol-name modes)))
;;; Extra operation definitions
"Toggle current view to buffers with major mode QUALIFIER."
(:description "major mode"
:reader
- (intern
- (completing-read "Filter by major mode: " obarray
- #'(lambda (e)
- (string-match "-mode$"
- (symbol-name e)))
- t
- (let ((buf (ibuffer-current-buffer)))
- (if (and buf (buffer-live-p buf))
- (symbol-name (buffer-local-value 'major-mode buf))
- "")))))
+ (let* ((buf (ibuffer-current-buffer))
+ (default (if (and buf (buffer-live-p buf))
+ (symbol-name (buffer-local-value
+ 'major-mode buf)))))
+ (intern
+ (completing-read
+ (if default
+ (format "Filter by major mode (default %s): " default)
+ "Filter by major mode: ")
+ obarray
+ #'(lambda (e)
+ (string-match "-mode\\'" (symbol-name e)))
+ t nil nil default))))
(eq qualifier (buffer-local-value 'major-mode buf)))
;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
Called interactively, this function allows selection of modes
currently used by buffers."
(:description "major mode in use"
+ :reader
+ (let* ((buf (ibuffer-current-buffer))
+ (default (if (and buf (buffer-live-p buf))
+ (symbol-name (buffer-local-value
+ 'major-mode buf)))))
+ (intern
+ (completing-read
+ (if default
+ (format "Filter by major mode (default %s): " default)
+ "Filter by major mode: ")
+ (ibuffer-list-buffer-modes) nil t nil nil default))))
+ (eq qualifier (buffer-local-value 'major-mode buf)))
+
+;;;###autoload (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext")
+(define-ibuffer-filter derived-mode
+ "Toggle current view to buffers whose major mode inherits from QUALIFIER."
+ (:description "derived mode"
:reader
(intern
- (completing-read "Filter by major mode: "
- (ibuffer-list-buffer-modes)
- nil
- t
- (let ((buf (ibuffer-current-buffer)))
- (if (and buf (buffer-live-p buf))
- (symbol-name (buffer-local-value
- 'major-mode buf))
- "")))))
- (eq qualifier (buffer-local-value 'major-mode buf)))
+ (completing-read "Filter by derived mode: "
+ (ibuffer-list-buffer-modes t)
+ nil t)))
+ (with-current-buffer buf (derived-mode-p qualifier)))
;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext")
(define-ibuffer-filter name
(concat ibuffer-copy-filename-as-kill-result
(let ((name (buffer-file-name buf)))
(if name
- (case type
- (full
+ (pcase type
+ (`full
name)
- (relative
+ (`relative
(file-relative-name
name (or ibuffer-default-directory
default-directory)))
- (t
+ (_
(file-name-nondirectory name)))
""))
" "))))
(defun ibuffer-mark-by-mode (mode)
"Mark all buffers whose major mode equals MODE."
(interactive
- (list (intern (completing-read "Mark by major mode: " obarray
- #'(lambda (e)
- ;; kind of a hack...
- (and (fboundp e)
- (string-match "-mode$"
- (symbol-name e))))
- t
- (let ((buf (ibuffer-current-buffer)))
- (if (and buf (buffer-live-p buf))
- (with-current-buffer buf
- (cons (symbol-name major-mode)
- 0))
- ""))))))
+ (let* ((buf (ibuffer-current-buffer))
+ (default (if (and buf (buffer-live-p buf))
+ (symbol-name (buffer-local-value
+ 'major-mode buf)))))
+ (list (intern
+ (completing-read
+ (if default
+ (format "Mark by major mode (default %s): " default)
+ "Mark by major mode: ")
+ (ibuffer-list-buffer-modes) nil t nil nil default)))))
(ibuffer-mark-on-buffer
#'(lambda (buf)
(eq (buffer-local-value 'major-mode buf) mode))))
(with-current-buffer buf
;; hacked from midnight.el
(when buffer-display-time
- (let* ((tm (current-time))
- (now (+ (* (float (ash 1 16)) (car tm))
- (float (cadr tm)) (* 0.0000001 (caddr tm))))
- (then (+ (* (float (ash 1 16))
- (car buffer-display-time))
- (float (cadr buffer-display-time))
- (* 0.0000001 (caddr buffer-display-time)))))
+ (let* ((now (float-time))
+ (then (float-time buffer-display-time)))
(> (- now then) (* 60 60 ibuffer-old-time))))))))
;;;###autoload
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here.
(defmacro ibuffer-aif (test true-body &rest false-body)
(ibuffer-redisplay t))))))
;;;###autoload
-(defmacro* define-ibuffer-column (symbol (&key name inline props summarizer
+(cl-defmacro define-ibuffer-column (symbol (&key name inline props summarizer
header-mouse-map) &rest body)
"Define a column SYMBOL for use with `ibuffer-formats'.
:autoload-end)))
;;;###autoload
-(defmacro* define-ibuffer-sorter (name documentation
+(cl-defmacro define-ibuffer-sorter (name documentation
(&key
description)
&rest body)
value if and only if `a' is \"less than\" `b'.
\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)"
- (declare (indent 1))
+ (declare (indent 1) (doc-string 2))
`(progn
(defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) ()
,(or documentation "No :documentation specified for this sorting method.")
:autoload-end))
;;;###autoload
-(defmacro* define-ibuffer-op (op args
+(cl-defmacro define-ibuffer-op (op args
documentation
(&key
interactive
macro for exactly what it does.
\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)"
- (declare (indent 2))
+ (declare (indent 2) (doc-string 3))
`(progn
(defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
"" "ibuffer-do-") (symbol-name op)))
,(if (not (null interactive))
`(interactive ,interactive)
'(interactive))
- (assert (derived-mode-p 'ibuffer-mode))
+ (cl-assert (derived-mode-p 'ibuffer-mode))
(setq ibuffer-did-modification nil)
- (let ((marked-names (,(case mark
+ (let ((marked-names (,(pcase mark
(:deletion
'ibuffer-deletion-marked-buffer-names)
- (t
+ (_
'ibuffer-marked-buffer-names)))))
(when (null marked-names)
(setq marked-names (list (buffer-name (ibuffer-current-buffer))))
- (ibuffer-set-mark ,(case mark
+ (ibuffer-set-mark ,(pcase mark
(:deletion
'ibuffer-deletion-char)
- (t
+ (_
'ibuffer-marked-char))))
,(let* ((finish (append
'(progn)
,@body))
t)))
(body `(let ((count
- (,(case mark
+ (,(pcase mark
(:deletion
'ibuffer-map-deletion-lines)
- (t
+ (_
'ibuffer-map-marked-lines))
#'(lambda (buf mark)
,(if (eq modifier-p :maybe)
:autoload-end))
;;;###autoload
-(defmacro* define-ibuffer-filter (name documentation
+(cl-defmacro define-ibuffer-filter (name documentation
(&key
reader
description)
bound to the current value of the filter.
\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)"
- (declare (indent 2))
+ (declare (indent 2) (doc-string 2))
(let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name)))))
`(progn
(defun ,fn-name (qualifier)
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'ibuf-macs)
(require 'dired))
(declare-function ibuffer-format-filter-group-data "ibuf-ext" (filter))
(defgroup ibuffer nil
- "An advanced replacement for `buffer-menu'.
-
-Ibuffer allows you to operate on buffers in a manner much like Dired.
-Operations include sorting, marking by regular expression, and
-the ability to filter the displayed buffers by various criteria."
+ "Advanced replacement for `buffer-menu'.
+Ibuffer lets you operate on buffers in a Dired-like way,
+with the ability to sort, mark by regular expression,
+and filter displayed buffers by various criteria."
:version "22.1"
:group 'convenience)
no upper limit on its size. The size will also be aligned to the
right.
-Thus, if you wanted to use these two formats, add
-
- (setq ibuffer-formats '((mark \" \" name)
- (mark modified read-only
- (name 16 16 :left) (size 6 -1 :right))))
+Thus, if you wanted to use these two formats, the appropriate
+value for this variable would be
-to your ~/.emacs file.
+ '((mark \" \" name)
+ (mark modified read-only
+ (name 16 16 :left)
+ (size 6 -1 :right)))
Using \\[ibuffer-switch-format], you can rotate the display between
the specified formats in the list."
(define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process)
(define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode)
- (define-key map (kbd "/ m") 'ibuffer-filter-by-mode)
- (define-key map (kbd "/ M") 'ibuffer-filter-by-used-mode)
+ (define-key map (kbd "/ m") 'ibuffer-filter-by-used-mode)
+ (define-key map (kbd "/ M") 'ibuffer-filter-by-derived-mode)
(define-key map (kbd "/ n") 'ibuffer-filter-by-name)
(define-key map (kbd "/ c") 'ibuffer-filter-by-content)
(define-key map (kbd "/ e") 'ibuffer-filter-by-predicate)
(when (get-text-property (point) 'ibuffer-title)
(forward-line 1)
(setq arg 1))
- (decf arg)))
+ (cl-decf arg)))
(defun ibuffer-forward-line (&optional arg skip-group-names)
"Move forward ARG lines, wrapping around the list if necessary."
(and skip-group-names
(get-text-property (point) 'ibuffer-filter-group-name)))
(when (> arg 0)
- (decf arg))
+ (cl-decf arg))
(ibuffer-skip-properties (append '(ibuffer-title)
(when skip-group-names
'(ibuffer-filter-group-name)))
(or (eobp)
(get-text-property (point) 'ibuffer-summary)))
(goto-char (point-min)))
- (decf arg)
+ (cl-decf arg)
(ibuffer-skip-properties (append '(ibuffer-title)
(when skip-group-names
'(ibuffer-filter-group-name)))
(setq trying nil))
(error
;; Handle a failure
- (if (or (> (incf attempts) 4)
+ (if (or (> (cl-incf attempts) 4)
(and (stringp (cadr err))
;; This definitely falls in the
;; ghetto hack category...
(ibuffer-map-on-mark ibuffer-deletion-char func))
(defsubst ibuffer-assert-ibuffer-mode ()
- (assert (derived-mode-p 'ibuffer-mode)))
+ (cl-assert (derived-mode-p 'ibuffer-mode)))
(defun ibuffer-buffer-file-name ()
(or buffer-file-name
(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))
+ (read-only-mode 'toggle))
(define-ibuffer-op ibuffer-do-delete ()
"Kill marked buffers as with `kill-this-buffer'."
`(progn
(setq tmp1 ,widthform
tmp2 (/ tmp1 2))
- ,(case alignment
+ ,(pcase alignment
(:right `(concat ,left ,right ,strvar))
(:center `(concat ,left ,strvar ,right))
(:left `(concat ,strvar ,left ,right))
- (t (error "Invalid alignment %s" alignment))))))
+ (_ (error "Invalid alignment %s" alignment))))))
(defun ibuffer-compile-format (format)
(let ((result nil)
(max (nth 2 form))
(align (nth 3 form))
(elide (nth 4 form)))
- (let* ((from-end-p (when (minusp min)
+ (let* ((from-end-p (when (cl-minusp min)
(setq min (- min))
t))
(letbindings nil)
(defun ibuffer-format-column (str width alignment)
(let ((left (make-string (/ width 2) ?\s))
(right (make-string (- width (/ width 2)) ?\s)))
- (case alignment
+ (pcase alignment
(:right (concat left right str))
(:center (concat left str right))
- (t (concat str left right)))))
+ (_ (concat str left right)))))
(defun ibuffer-buffer-name-face (buf mark)
(cond ((char-equal mark ibuffer-marked-char)
;; `nil' if it chose not to affect the buffer
;; `kill' means the remove line from the buffer list
;; `t' otherwise
- (incf ibuffer-map-lines-total)
+ (cl-incf ibuffer-map-lines-total)
(cond ((null result)
(forward-line 1))
((eq result 'kill)
(delete-region (line-beginning-position)
(1+ (line-end-position)))
- (incf ibuffer-map-lines-count)
+ (cl-incf ibuffer-map-lines-count)
(when (< ibuffer-map-lines-total
orig-target-line)
- (decf target-line-offset)))
+ (cl-decf target-line-offset)))
(t
- (incf ibuffer-map-lines-count)
+ (cl-incf ibuffer-map-lines-count)
(forward-line 1)))))
ibuffer-map-lines-count)
(progn
(insert
(if (stringp element)
element
- (let ((sym (car element))
- (min (cadr element))
- ;; (max (caddr element))
- (align (cadddr element)))
+ (pcase-let ((`(,sym ,min ,_max ,align) element))
;; Ignore a negative min when we're inserting the title
- (when (minusp min)
+ (when (cl-minusp min)
(setq min (- min)))
(let* ((name (or (get sym 'ibuffer-column-name)
(error "Unknown column %s in ibuffer-formats" sym)))
(insert
(if (stringp element)
(make-string (length element) ?\s)
- (let ((sym (car element)))
- (let ((min (cadr element))
- ;; (max (caddr element))
- (align (cadddr element)))
- ;; Ignore a negative min when we're inserting the title
- (when (minusp min)
- (setq min (- min)))
- (let* ((summary (if (get sym 'ibuffer-column-summarizer)
- (funcall (get sym 'ibuffer-column-summarizer)
- (get sym 'ibuffer-column-summary))
- (make-string (length (get sym 'ibuffer-column-name))
- ?\s)))
- (len (length summary)))
- (if (< len min)
- (ibuffer-format-column summary
- (- min len)
- align)
- summary)))))))
+ (pcase-let ((`(,sym ,min ,_max ,align) element))
+ ;; Ignore a negative min when we're inserting the title.
+ (when (cl-minusp min)
+ (setq min (- min)))
+ (let* ((summary
+ (if (get sym 'ibuffer-column-summarizer)
+ (funcall (get sym 'ibuffer-column-summarizer)
+ (get sym 'ibuffer-column-summary))
+ (make-string
+ (length (get sym 'ibuffer-column-name))
+ ?\s)))
+ (len (length summary)))
+ (if (< len min)
+ (ibuffer-format-column summary
+ (- min len)
+ align)
+ summary))))))
(point))
`(ibuffer-summary t)))))
(eq ibuffer-always-show-last-buffer
:nomini)
(minibufferp (cadr bufs)))
- (caddr bufs)
+ (cl-caddr bufs)
(cadr bufs))
(ibuffer-current-buffers-with-marks bufs)
ibuffer-display-maybe-show-predicates)))
(require 'ibuf-ext))
(let* ((sortdat (assq ibuffer-sorting-mode
ibuffer-sorting-functions-alist))
- (func (caddr sortdat)))
+ (func (cl-caddr sortdat)))
(let ((result
;; actually sort the buffers
(if (and sortdat func)
buffer's file as an argument.
'\\[ibuffer-do-eval]' - Evaluate a form in each of the marked buffers. This
is a very flexible command. For example, if you want to make all
- of the marked buffers read only, try using (toggle-read-only 1) as
+ of the marked buffers read only, try using (read-only-mode 1) as
the input form.
'\\[ibuffer-do-view-and-eval]' - As above, but view each buffer while the form
is evaluated.
;; `ibuffer-update' puts this on header-line-format when needed.
(setq ibuffer-header-line-format
;; Display the part that won't be in the mode-line.
- (list* "" mode-name
- (mapcar (lambda (elem)
- (if (eq (car-safe elem) 'header-line-format)
- (nth 2 elem) elem))
- mode-line-process)))
+ `("" ,mode-name
+ ,@(mapcar (lambda (elem)
+ (if (eq (car-safe elem) 'header-line-format)
+ (nth 2 elem) elem))
+ mode-line-process)))
(setq buffer-read-only t)
(buffer-disable-undo)
;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group
;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group
;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode
-;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "d075c17b63e67b28652ececf548385fc")
+;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "f03bae226325c7320d41ddb78896665a")
;;; Generated autoloads from ibuf-ext.el
(autoload 'ibuffer-auto-mode "ibuf-ext" "\
\(fn NAME)" t nil)
(autoload 'ibuffer-filter-by-mode "ibuf-ext")
(autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
+ (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext")
(autoload 'ibuffer-filter-by-name "ibuf-ext")
(autoload 'ibuffer-filter-by-filename "ibuf-ext")
(autoload 'ibuffer-filter-by-size-gt "ibuf-ext")
(when (and icomplete-mode (icomplete-simple-completing-p))
(set (make-local-variable 'completion-show-inline-help) nil)
(add-hook 'pre-command-hook
- (lambda () (run-hooks 'icomplete-pre-command-hook))
+ (lambda () (let ((non-essential t))
+ (run-hooks 'icomplete-pre-command-hook)))
nil t)
(add-hook 'post-command-hook
- (lambda () (run-hooks 'icomplete-post-command-hook))
+ (lambda () (let ((non-essential t)) ;E.g. don't prompt for password!
+ (run-hooks 'icomplete-post-command-hook)))
nil t)
(run-hooks 'icomplete-minibuffer-setup-hook)))
;\f
matches exist. \(Keybindings for uniquely matched commands
are exhibited within the square braces.)"
- (let* ((non-essential t)
- (md (completion--field-metadata (field-beginning)))
+ (let* ((md (completion--field-metadata (field-beginning)))
(comps (completion-all-sorted-completions))
(last (if (consp comps) (last comps)))
(base-size (cdr last))
;; can be used by other packages to read a buffer name, a file name,
;; or a directory name in the `ido' way.
-;;; Acknowledgements
+;;; Acknowledgments
;; Infinite amounts of gratitude goes to Stephen Eglen <stephen@cns.ed.ac.uk>
;; who wrote iswitch-buffer mode - from which I ripped off 99% of the code
:type 'boolean
:group 'ido)
-(defface ido-first-match '((t (:bold t)))
+(defface ido-first-match '((t :weight bold))
"Face used by ido for highlighting first match."
:group 'ido)
(defface ido-only-match '((((class color))
- (:foreground "ForestGreen"))
- (t (:italic t)))
+ :foreground "ForestGreen")
+ (t :slant italic))
"Face used by ido for highlighting only match."
:group 'ido)
(defface ido-subdir '((((min-colors 88) (class color))
- (:foreground "red1"))
- (((class color))
- (:foreground "red"))
- (t (:underline t)))
+ :foreground "red1")
+ (((class color))
+ :foreground "red")
+ (t :underline t))
"Face used by ido for highlighting subdirs in the alternatives."
:group 'ido)
-(defface ido-virtual '((t (:inherit font-lock-builtin-face)))
+(defface ido-virtual '((t :inherit font-lock-builtin-face))
"Face used by ido for matching virtual buffer names."
:version "24.1"
:group 'ido)
-(defface ido-indicator '((((min-colors 88) (class color))
- (:foreground "yellow1"
- :background "red1"
- :width condensed))
- (((class color))
- (:foreground "yellow"
- :background "red"
- :width condensed))
- (t (:inverse-video t)))
+(defface ido-indicator '((((min-colors 88) (class color))
+ :foreground "yellow1" :background "red1" :width condensed)
+ (((class color))
+ :foreground "yellow" :background "red" :width condensed)
+ (t :inverse-video t))
"Face used by ido for highlighting its indicators."
:group 'ido)
(defface ido-incomplete-regexp
- '((t
- (:inherit font-lock-warning-face)))
+ '((t :inherit font-lock-warning-face))
"Ido face for indicating incomplete regexps."
:group 'ido)
:group 'ido)
(defvar ido-rewrite-file-prompt-rules nil
- "*Alist of rewriting rules for directory names in ido prompts.
+ "Alist of rewriting rules for directory names in ido prompts.
A list of elements of the form (FROM . TO) or (FROM . FUNC), each
meaning to rewrite the directory name if matched by FROM by either
substituting the matched string by TO or calling the function FUNC
:type 'boolean
:group 'ido)
-(defvar ido-all-frames 'visible
- "*Argument to pass to `walk-windows' when finding visible files.
-See documentation of `walk-windows' for useful values.")
+(defcustom ido-all-frames 'visible
+ "Argument to pass to `walk-windows' when Ido is finding buffers.
+See documentation of `walk-windows' for useful values."
+ :type '(choice (const :tag "Selected frame only" nil)
+ (const :tag "All existing frames" t)
+ (const :tag "All visible frames" visible)
+ (const :tag "All frames on this terminal" 0))
+ :group 'ido)
(defcustom ido-minibuffer-setup-hook nil
"Ido-specific customization of minibuffer setup.
RET Select the buffer at the front of the list of matches. If the
list is empty, possibly prompt to create new buffer.
-\\[ido-select-text] Select the current prompt as the buffer.
-If no buffer is found, prompt for a new one.
+\\[ido-select-text] Use the current input string verbatim.
\\[ido-next-match] Put the first element at the end of the list.
\\[ido-prev-match] Put the last element at the start of the list.
RET Select the file at the front of the list of matches. If the
list is empty, possibly prompt to create new file.
-\\[ido-select-text] Select the current prompt as the buffer or file.
-If no buffer or file is found, prompt for a new one.
+\\[ido-select-text] Use the current input string verbatim.
\\[ido-next-match] Put the first element at the end of the list.
\\[ido-prev-match] Put the last element at the start of the list.
matches all files. If there is only one match, select that file.
If there is no common suffix, show a list of all matching files
in a separate window.
+\\[ido-magic-delete-char] Open the specified directory in Dired mode.
\\[ido-edit-input] Edit input string (including directory).
\\[ido-prev-work-directory] or \\[ido-next-work-directory] go to previous/next directory in work directory history.
\\[ido-merge-work-directories] search for file in the work directory history.
`comint-kill-whole-line' or `comint-kill-region' with no
narrowing in effect. This way you will be certain that none of
the remaining prompts will be accidentally messed up. You may
-wish to put something like the following in your `.emacs' file:
+wish to put something like the following in your init file:
\(add-hook 'ielm-mode-hook
(lambda ()
(require 'widget)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'wid-edit))
(defgroup image-dired nil
(md5 (file-name-as-directory (file-name-directory f)))))
(format "%s%s%s.thumb.%s"
(file-name-as-directory (expand-file-name (image-dired-dir)))
- (file-name-sans-extension (file-name-nondirectory f))
+ (file-name-base f)
(if md5-hash (concat "_" md5-hash) "")
(file-name-extension f))))
((eq 'per-directory image-dired-thumbnail-storage)
(let ((f (expand-file-name file)))
(format "%s.image-dired/%s.thumb.%s"
(file-name-directory f)
- (file-name-sans-extension (file-name-nondirectory f))
+ (file-name-base f)
(file-name-extension f))))))
(defun image-dired-create-thumb (original-file thumbnail-file)
(image-file (dired-get-filename nil t))
thumb-file
overlay)
- (when (and image-file (string-match-p (image-file-name-regexp) image-file))
+ (when (and image-file
+ (string-match-p (image-file-name-regexp) image-file))
(setq thumb-file (image-dired-get-thumbnail-image image-file))
;; If image is not already added, then add it.
(let ((cur-ov (overlays-in (point) (1+ (point)))))
(if cur-ov
(delete-overlay (car cur-ov))
(put-image thumb-file image-pos)
- (setq overlay (loop for o in (overlays-in (point) (1+ (point)))
- when (overlay-get o 'put-image) collect o into ov
- finally return (car ov)))
+ (setq overlay
+ (cl-loop for o in (overlays-in (point) (1+ (point)))
+ when (overlay-get o 'put-image) collect o into ov
+ finally return (car ov)))
(overlay-put overlay 'image-file image-file)
(overlay-put overlay 'thumb-file thumb-file)))))
arg ; Show or hide image on ARG next files.
'show-progress) ; Update dired display after each image is updated.
- (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t))
+ (add-hook 'dired-after-readin-hook
+ 'image-dired-dired-after-readin-hook nil t))
(defun image-dired-dired-after-readin-hook ()
"Relocate existing thumbnail overlays in dired buffer after reverting.
-;;; image-mode.el --- support for visiting image files
+;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*-
;;
;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;;
;; resulting buffer file is saved to another name it will correctly save
;; the image data to the new file.
+;; Todo:
+
+;; Consolidate with doc-view to make them work on directories of images or on
+;; image files containing various "pages".
+
;;; Code:
(require 'image)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Image mode window-info management.
-(defvar image-mode-winprops-alist t)
-(make-variable-buffer-local 'image-mode-winprops-alist)
+(defvar-local image-mode-winprops-alist t)
(defvar image-mode-new-window-functions nil
"Special hook run when image data is requested in a new window.
(defun image-mode-winprops (&optional window cleanup)
"Return winprops of WINDOW.
-A winprops object has the shape (WINDOW . ALIST)."
+A winprops object has the shape (WINDOW . ALIST).
+WINDOW defaults to `selected-window' if it displays the current buffer, and
+otherwise it defaults to t, used for times when the buffer is not displayed."
(cond ((null window)
- (setq window (selected-window)))
+ (setq window
+ (if (eq (current-buffer) (window-buffer)) (selected-window) t)))
+ ((eq window t))
((not (windowp window))
(error "Not a window: %s" window)))
(when cleanup
winprops))
(defun image-mode-window-get (prop &optional winprops)
+ (declare (gv-setter (lambda (val)
+ `(image-mode-window-put ,prop ,val ,winprops))))
(unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
(cdr (assq prop (cdr winprops))))
-(defsetf image-mode-window-get (prop &optional winprops) (val)
- `(image-mode-window-put ,prop ,val ,winprops))
-
(defun image-mode-window-put (prop val &optional winprops)
(unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
(setcdr winprops (cons (cons prop val)
(setq image-type type)
(if (eq major-mode 'image-mode)
(setq mode-name (format "Image[%s]" type)))
+ (image-transform-check-size)
(if (called-interactively-p 'any)
(message "Repeat this command to go back to displaying the file as text"))))
\f
;; Not yet implemented.
-;;; (defvar image-transform-minor-mode-map
-;;; (let ((map (make-sparse-keymap)))
-;;; ;; (define-key map [(control ?+)] 'image-scale-in)
-;;; ;; (define-key map [(control ?-)] 'image-scale-out)
-;;; ;; (define-key map [(control ?=)] 'image-scale-none)
-;;; ;; (define-key map "c f h" 'image-scale-fit-height)
-;;; ;; (define-key map "c ]" 'image-rotate-right)
-;;; map)
-;;; "Minor mode keymap `image-transform-mode'.")
-;;;
-;;; (define-minor-mode image-transform-mode
-;;; "Minor mode for scaling and rotating images.
-;;; With a prefix argument ARG, enable the mode if ARG is positive,
-;;; and disable it otherwise. If called from Lisp, enable the mode
-;;; if ARG is omitted or nil. This minor mode requires Emacs to have
-;;; been compiled with ImageMagick support."
-;;; nil "image-transform" image-transform-minor-mode-map)
+;; (defvar image-transform-minor-mode-map
+;; (let ((map (make-sparse-keymap)))
+;; ;; (define-key map [(control ?+)] 'image-scale-in)
+;; ;; (define-key map [(control ?-)] 'image-scale-out)
+;; ;; (define-key map [(control ?=)] 'image-scale-none)
+;; ;; (define-key map "c f h" 'image-scale-fit-height)
+;; ;; (define-key map "c ]" 'image-rotate-right)
+;; map)
+;; "Minor mode keymap `image-transform-mode'.")
+;;
+;; (define-minor-mode image-transform-mode
+;; "Minor mode for scaling and rotating images.
+;; With a prefix argument ARG, enable the mode if ARG is positive,
+;; and disable it otherwise. If called from Lisp, enable the mode
+;; if ARG is omitted or nil. This minor mode requires Emacs to have
+;; been compiled with ImageMagick support."
+;; nil "image-transform" image-transform-minor-mode-map)
;; FIXME this doesn't seem mature yet. Document in manual when it is.
- nil, meaning no resizing.
- `fit-height', meaning to fit the image to the window height.
- `fit-width', meaning to fit the image to the window width.
- - A number, which is a scale factor (the default size is 100).")
+ - A number, which is a scale factor (the default size is 1).")
+
+(defvar image-transform-scale 1.0
+ "The scale factor of the image being displayed.")
(defvar image-transform-rotation 0.0
"Rotation angle for the image in the current Image mode buffer.")
+(defvar image-transform-right-angle-fudge 0.0001
+ "Snap distance to a multiple of a right angle.
+There's no deep theory behind the default value, it should just
+be somewhat larger than ImageMagick's MagickEpsilon.")
+
+(defsubst image-transform-width (width height)
+ "Return the bounding box width of a rotated WIDTH x HEIGHT rectangle.
+The rotation angle is the value of `image-transform-rotation' in degrees."
+ (let ((angle (degrees-to-radians image-transform-rotation)))
+ ;; Assume, w.l.o.g., that the vertices of the rectangle have the
+ ;; coordinates (+-w/2, +-h/2) and that (0, 0) is the center of the
+ ;; rotation by the angle A. The projections onto the first axis
+ ;; of the vertices of the rotated rectangle are +- (w/2) cos A +-
+ ;; (h/2) sin A, and the difference between the largest and the
+ ;; smallest of the four values is the expression below.
+ (+ (* width (abs (cos angle))) (* height (abs (sin angle))))))
+
+;; The following comment and code snippet are from
+;; ImageMagick-6.7.4-4/magick/distort.c
+
+;; /* Set the output image geometry to calculated 'best fit'.
+;; Yes this tends to 'over do' the file image size, ON PURPOSE!
+;; Do not do this for DePolar which needs to be exact for virtual tiling.
+;; */
+;; if ( fix_bounds ) {
+;; geometry.x = (ssize_t) floor(min.x-0.5);
+;; geometry.y = (ssize_t) floor(min.y-0.5);
+;; geometry.width=(size_t) ceil(max.x-geometry.x+0.5);
+;; geometry.height=(size_t) ceil(max.y-geometry.y+0.5);
+;; }
+
+;; Other parts of the same file show that here the origin is in the
+;; left lower corner of the image rectangle, the center of the
+;; rotation is the center of the rectangle and min.x and max.x
+;; (resp. min.y and max.y) are the smallest and the largest of the
+;; projections of the vertices onto the first (resp. second) axis.
+
+(defun image-transform-fit-width (width height length)
+ "Return (w . h) so that a rotated w x h image has exactly width LENGTH.
+The rotation angle is the value of `image-transform-rotation'.
+Write W for WIDTH and H for HEIGHT. Then the w x h rectangle is
+an \"approximately uniformly\" scaled W x H rectangle, which
+currently means that w is one of floor(s W) + {0, 1, -1} and h is
+floor(s H), where s can be recovered as the value of `image-transform-scale'.
+The value of `image-transform-rotation' may be replaced by
+a slightly different angle. Currently this is done for values
+close to a multiple of 90, see `image-transform-right-angle-fudge'."
+ (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90))
+ image-transform-right-angle-fudge)
+ (cl-assert (not (zerop width)) t)
+ (setq image-transform-rotation
+ (float (round image-transform-rotation))
+ image-transform-scale (/ (float length) width))
+ (cons length nil))
+ ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45))
+ image-transform-right-angle-fudge)
+ (cl-assert (not (zerop height)) t)
+ (setq image-transform-rotation
+ (float (round image-transform-rotation))
+ image-transform-scale (/ (float length) height))
+ (cons nil length))
+ (t
+ (cl-assert (not (and (zerop width) (zerop height))) t)
+ (setq image-transform-scale
+ (/ (float (1- length)) (image-transform-width width height)))
+ ;; Assume we have a w x h image and an angle A, and let l =
+ ;; l(w, h) = w |cos A| + h |sin A|, which is the actual width
+ ;; of the bounding box of the rotated image, as calculated by
+ ;; `image-transform-width'. The code snippet quoted above
+ ;; means that ImageMagick puts the rotated image in
+ ;; a bounding box of width L = 2 ceil((w+l+1)/2) - w.
+ ;; Elementary considerations show that this is equivalent to
+ ;; L - w being even and L-3 < l(w, h) <= L-1. In our case, L is
+ ;; the given `length' parameter and our job is to determine
+ ;; reasonable values for w and h which satisfy these
+ ;; conditions.
+ (let ((w (floor (* image-transform-scale width)))
+ (h (floor (* image-transform-scale height))))
+ ;; Let w and h as bound above. Then l(w, h) <= l(s W, s H)
+ ;; = L-1 < l(w+1, h+1) = l(w, h) + l(1, 1) <= l(w, h) + 2,
+ ;; hence l(w, h) > (L-1) - 2 = L-3.
+ (cons
+ (cond ((= (mod w 2) (mod length 2))
+ w)
+ ;; l(w+1, h) >= l(w, h) > L-3, but does l(w+1, h) <=
+ ;; L-1 hold?
+ ((<= (image-transform-width (1+ w) h) (1- length))
+ (1+ w))
+ ;; No, it doesn't, but this implies that l(w-1, h) =
+ ;; l(w+1, h) - l(2, 0) >= l(w+1, h) - 2 > (L-1) -
+ ;; 2 = L-3. Clearly, l(w-1, h) <= l(w, h) <= L-1.
+ (t
+ (1- w)))
+ h)))))
+
+(defun image-transform-check-size ()
+ "Check that the image exactly fits the width/height of the window."
+ (unless (numberp image-transform-resize)
+ (let ((size (image-display-size (image-get-display-property) t)))
+ (cond ((eq image-transform-resize 'fit-width)
+ (cl-assert (= (car size)
+ (- (nth 2 (window-inside-pixel-edges))
+ (nth 0 (window-inside-pixel-edges))))
+ t))
+ ((eq image-transform-resize 'fit-height)
+ (cl-assert (= (cdr size)
+ (- (nth 3 (window-inside-pixel-edges))
+ (nth 1 (window-inside-pixel-edges))))
+ t))))))
+
(defun image-transform-properties (spec)
"Return rescaling/rotation properties for image SPEC.
These properties are determined by the Image mode variables
Rescaling and rotation properties only take effect if Emacs is
compiled with ImageMagick support."
+ (setq image-transform-scale 1.0)
(when (or image-transform-resize
- (not (equal image-transform-rotation 0.0)))
+ (/= image-transform-rotation 0.0))
;; Note: `image-size' looks up and thus caches the untransformed
;; image. There's no easy way to prevent that.
(let* ((size (image-size spec t))
- (height
+ (resized
(cond
((numberp image-transform-resize)
- (unless (= image-transform-resize 100)
- (* image-transform-resize (cdr size))))
+ (unless (= image-transform-resize 1)
+ (setq image-transform-scale image-transform-resize)
+ (cons nil (floor (* image-transform-resize (cdr size))))))
+ ((eq image-transform-resize 'fit-width)
+ (image-transform-fit-width
+ (car size) (cdr size)
+ (- (nth 2 (window-inside-pixel-edges))
+ (nth 0 (window-inside-pixel-edges)))))
((eq image-transform-resize 'fit-height)
- (- (nth 3 (window-inside-pixel-edges))
- (nth 1 (window-inside-pixel-edges))))))
- (width (if (eq image-transform-resize 'fit-width)
- (- (nth 2 (window-inside-pixel-edges))
- (nth 0 (window-inside-pixel-edges))))))
- ;;TODO fit-to-* should consider the rotation angle
- `(,@(if height (list :height height))
- ,@(if width (list :width width))
- ,@(if (not (equal 0.0 image-transform-rotation))
- (list :rotation image-transform-rotation))))))
-
-;; FIXME 2 works, but eg 1.9 or 0.5 don't?
+ (let ((res (image-transform-fit-width
+ (cdr size) (car size)
+ (- (nth 3 (window-inside-pixel-edges))
+ (nth 1 (window-inside-pixel-edges))))))
+ (cons (cdr res) (car res)))))))
+ `(,@(when (car resized)
+ (list :width (car resized)))
+ ,@(when (cdr resized)
+ (list :height (cdr resized)))
+ ,@(unless (= 0.0 image-transform-rotation)
+ (list :rotation image-transform-rotation))))))
+
(defun image-transform-set-scale (scale)
"Prompt for a number, and resize the current image by that amount.
This command has no effect unless Emacs is compiled with
ROTATION should be in degrees. This command has no effect unless
Emacs is compiled with ImageMagick support."
(interactive "nRotation angle (in degrees): ")
- ;;TODO 0 90 180 270 degrees are the only reasonable angles here
- ;;otherwise combining with rescaling will get very awkward
- (setq image-transform-rotation (float rotation))
+ (setq image-transform-rotation (float (mod rotation 360)))
(image-toggle-display-image))
(provide 'image-mode)
types nil)
(setq types (cdr types)))))
(goto-char opoint)
- type))
+ (and type
+ (memq type image-types)
+ type)))
;;;###autoload
"Return non-nil if image type TYPE is available.
Image types are symbols like `xbm' or `jpeg'."
(and (fboundp 'init-image-library)
- (init-image-library type dynamic-library-alist)))
+ (init-image-library type)))
;;;###autoload
(prop (if (null area) image (list (list 'margin area) image))))
(put-text-property 0 (length string) 'display prop string)
(overlay-put overlay 'put-image t)
- (overlay-put overlay 'before-string string))))
+ (overlay-put overlay 'before-string string)
+ overlay)))
;;;###autoload
(while tail
(setq timer (car tail)
tail (cdr tail))
- (if (and (eq (aref timer 5) 'image-animate-timeout)
- (eq (car-safe (aref timer 6)) image))
+ (if (and (eq (timer--function timer) 'image-animate-timeout)
+ (eq (car-safe (timer--args timer)) image))
(setq tail nil)
(setq timer nil)))
timer))
image n count time-elapsed limit))))
\f
-(defcustom imagemagick-types-inhibit
- '(C HTML HTM TXT PDF)
- "ImageMagick types that should not be visited in Image mode.
-This should be a list of symbols, each of which should be one of
-the ImageMagick types listed in `imagemagick-types'. These image
-types are not registered by `imagemagick-register-types'.
-
-If Emacs is compiled without ImageMagick support, this variable
-has no effect."
- :type '(choice (const :tag "Let ImageMagick handle all types it can" nil)
- (repeat symbol))
- ;; Ideally, would have a :set function that checks if we already did
- ;; imagemagick-register-types, and if so undoes it, then redoes it.
- :version "24.1"
- :group 'image)
+(defvar imagemagick-types-inhibit)
+(defvar imagemagick-enabled-types)
+
+(defun imagemagick-filter-types ()
+ "Return a list of the ImageMagick types to be treated as images, or nil.
+This is the result of `imagemagick-types', including only elements
+that match `imagemagick-enabled-types' and do not match
+`imagemagick-types-inhibit'."
+ (when (fboundp 'imagemagick-types)
+ (cond ((null imagemagick-enabled-types) nil)
+ ((eq imagemagick-types-inhibit t) nil)
+ (t
+ (delq nil
+ (mapcar
+ (lambda (type)
+ (unless (memq type imagemagick-types-inhibit)
+ (if (eq imagemagick-enabled-types t) type
+ (catch 'found
+ (dolist (enable imagemagick-enabled-types nil)
+ (if (cond ((symbolp enable) (eq enable type))
+ ((stringp enable)
+ (string-match enable
+ (symbol-name type))))
+ (throw 'found type)))))))
+ (imagemagick-types)))))))
+
+(defvar imagemagick--file-regexp nil
+ "File extension regexp for ImageMagick files, if any.
+This is the extension installed into `auto-mode-alist' and
+`image-type-file-name-regexps' by `imagemagick-register-types'.")
;;;###autoload
(defun imagemagick-register-types ()
"Register file types that can be handled by ImageMagick.
-This registers the ImageMagick types listed in `imagemagick-types',
-excluding those listed in `imagemagick-types-inhibit'.
+This function is called at startup, after loading the init file.
+It registers the ImageMagick types returned by `imagemagick-filter-types'.
Registered image types are added to `auto-mode-alist', so that
Emacs visits them in Image mode. They are also added to
`image-type-file-name-regexps', so that the `image-type' function
recognizes these files as having image type `imagemagick'.
-If Emacs is compiled without ImageMagick support, do nothing."
+If Emacs is compiled without ImageMagick support, this does nothing."
(when (fboundp 'imagemagick-types)
- (let ((im-types '()))
- (dolist (im-type (imagemagick-types))
- (unless (memq im-type imagemagick-types-inhibit)
- (push (downcase (symbol-name im-type)) im-types)))
- (let ((extension (concat "\\." (regexp-opt im-types) "\\'")))
- (push (cons extension 'image-mode) auto-mode-alist)
- (push (cons extension 'imagemagick)
- image-type-file-name-regexps)))))
+ (let* ((types (mapcar (lambda (type) (downcase (symbol-name type)))
+ (imagemagick-filter-types)))
+ (re (if types (concat "\\." (regexp-opt types) "\\'")))
+ (ama-elt (car (member (cons imagemagick--file-regexp 'image-mode)
+ auto-mode-alist)))
+ (itfnr-elt (car (member (cons imagemagick--file-regexp 'imagemagick)
+ image-type-file-name-regexps))))
+ (if (not re)
+ (setq auto-mode-alist (delete ama-elt auto-mode-alist)
+ image-type-file-name-regexps
+ (delete itfnr-elt image-type-file-name-regexps))
+ (if ama-elt
+ (setcar ama-elt re)
+ (push (cons re 'image-mode) auto-mode-alist))
+ (if itfnr-elt
+ (setcar itfnr-elt re)
+ ;; Append to `image-type-file-name-regexps', so that we
+ ;; preferentially use specialized image libraries.
+ (add-to-list 'image-type-file-name-regexps
+ (cons re 'imagemagick) t)))
+ (setq imagemagick--file-regexp re))))
+
+(defcustom imagemagick-types-inhibit
+ '(C HTML HTM INFO M TXT PDF)
+ "List of ImageMagick types that should never be treated as images.
+This should be a list of symbols, each of which should be one of
+the ImageMagick types listed by `imagemagick-types'. The listed
+image types are not registered by `imagemagick-register-types'.
+
+If the value is t, inhibit the use of ImageMagick for images.
+
+If you change this without using customize, you must call
+`imagemagick-register-types' afterwards.
+
+If Emacs is compiled without ImageMagick support, this variable
+has no effect."
+ :type '(choice (const :tag "Support all ImageMagick types" nil)
+ (const :tag "Disable all ImageMagick types" t)
+ (repeat symbol))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (imagemagick-register-types))
+ :version "24.3"
+ :group 'image)
+
+(defcustom imagemagick-enabled-types
+ '(3FR ART ARW AVS BMP BMP2 BMP3 CAL CALS CMYK CMYKA CR2 CRW
+ CUR CUT DCM DCR DCX DDS DJVU DNG DPX EXR FAX FITS GBR GIF
+ GIF87 GRB HRZ ICB ICO ICON J2C JNG JP2 JPC JPEG JPG JPX K25
+ KDC MIFF MNG MRW MSL MSVG MTV NEF ORF OTB PBM PCD PCDS PCL
+ PCT PCX PDB PEF PGM PICT PIX PJPEG PNG PNG24 PNG32 PNG8 PNM
+ PPM PSD PTIF PWP RAF RAS RBG RGB RGBA RGBO RLA RLE SCR SCT
+ SFW SGI SR2 SRF SUN SVG SVGZ TGA TIFF TIFF64 TILE TIM TTF
+ UYVY VDA VICAR VID VIFF VST WBMP WPG X3F XBM XC XCF XPM XV
+ XWD YCbCr YCbCrA YUV)
+ "List of ImageMagick types to treat as images.
+Each list element should be a string or symbol, representing one
+of the image types returned by `imagemagick-types'. If the
+element is a string, it is handled as a regexp that enables all
+matching types.
+
+The value of `imagemagick-enabled-types' may also be t, meaning
+to enable all types that ImageMagick supports.
+
+The variable `imagemagick-types-inhibit' overrides this variable.
+
+If you change this without outside of Customize, you must call
+`imagemagick-register-types' afterwards.
+
+If Emacs is compiled without ImageMagick support, this variable
+has no effect."
+ :type '(choice (const :tag "Support all ImageMagick types" t)
+ (const :tag "Disable all ImageMagick types" nil)
+ (repeat :tag "List of types"
+ (choice (symbol :tag "type")
+ (regexp :tag "regexp"))))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (imagemagick-register-types))
+ :version "24.3"
+ :group 'image)
+
+(imagemagick-register-types)
(provide 'image)
-;;; imenu.el --- framework for mode-specific buffer indexes
+;;; imenu.el --- framework for mode-specific buffer indexes -*- lexical-binding: t -*-
;; Copyright (C) 1994-1998, 2001-2012 Free Software Foundation, Inc.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;###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
(and (consp (cdr item)) (listp (cadr item))
(not (eq (car (cadr item)) 'lambda))))
-;; Macro to display a progress message.
-;; RELPOS is the relative position to display.
-;; If RELPOS is nil, then the relative position in the buffer
-;; is calculated.
-;; PREVPOS is the variable in which we store the last position displayed.
-(defmacro imenu-progress-message (prevpos &optional relpos reverse)
+(defmacro imenu-progress-message (_prevpos &optional _relpos _reverse)
+ "Macro to display a progress message.
+RELPOS is the relative position to display.
+If RELPOS is nil, then the relative position in the buffer
+is calculated.
+PREVPOS is the variable in which we store the last position displayed."
;; Made obsolete/empty, as computers are now faster than the eye, and
;; it had problems updating the messages correctly, and could shadow
;; `(and
;; imenu-scanning-message
;; (let ((pos ,(if relpos
-;; relpos
-;; `(imenu--relative-position ,reverse))))
-;; (if ,(if relpos t
-;; `(> pos (+ 5 ,prevpos)))
-;; (progn
-;; (message imenu-scanning-message pos)
-;; (setq ,prevpos pos)))))
+;; relpos
+;; `(imenu--relative-position ,reverse))))
+;; (if ,(if relpos t
+;; `(> pos (+ 5 ,prevpos)))
+;; (progn
+;; (message imenu-scanning-message pos)
+;; (setq ,prevpos pos)))))
)
(defun imenu-example--name-and-position ()
"Return the current/previous sexp and its (beginning) location.
Don't move point."
+ (declare (obsolete "use your own function instead." "23.2"))
(save-excursion
(forward-sexp -1)
;; [ydi] modified for imenu-use-markers
(end (progn (forward-sexp) (point))))
(cons (buffer-substring beg end)
beg))))
-(make-obsolete 'imenu-example--name-and-position
- "use your own function instead." "23.2")
;;;
;;; Lisp
(defun imenu-example--lisp-extract-index-name ()
;; Example of a candidate for `imenu-extract-index-name-function'.
;; This will generate a flat index of definitions in a lisp file.
+ (declare (obsolete nil "23.2"))
(save-match-data
(and (looking-at "(def")
(condition-case nil
(end (progn (forward-sexp -1) (point))))
(buffer-substring beg end)))
(error nil)))))
-(make-obsolete 'imenu-example--lisp-extract-index-name "your own" "23.2")
(defun imenu-example--create-lisp-index ()
;; Example of a candidate for `imenu-create-index-function'.
;; It will generate a nested index of definitions.
+ (declare (obsolete nil "23.2"))
(let ((index-alist '())
(index-var-alist '())
(index-type-alist '())
- (index-unknown-alist '())
- prev-pos)
+ (index-unknown-alist '()))
(goto-char (point-max))
- (imenu-progress-message prev-pos 0)
;; Search for the function
(while (beginning-of-defun)
- (imenu-progress-message prev-pos nil t)
(save-match-data
(and (looking-at "(def")
(save-excursion
(forward-sexp 2)
(push (imenu-example--name-and-position)
index-unknown-alist)))))))
- (imenu-progress-message prev-pos 100)
(and index-var-alist
(push (cons "Variables" index-var-alist)
index-alist))
(push (cons "Syntax-unknown" index-unknown-alist)
index-alist))
index-alist))
-(make-obsolete 'imenu-example--create-lisp-index "your own" "23.2")
;; Regular expression to find C functions
(defvar imenu-example--function-name-regexp-c
))
(defun imenu-example--create-c-index (&optional regexp)
+ (declare (obsolete nil "23.2"))
(let ((index-alist '())
- prev-pos char)
+ char)
(goto-char (point-min))
- (imenu-progress-message prev-pos 0)
;; Search for the function
(save-match-data
(while (re-search-forward
(or regexp imenu-example--function-name-regexp-c)
nil t)
- (imenu-progress-message prev-pos)
(backward-up-list 1)
(save-excursion
(goto-char (scan-sexps (point) 1))
;; Skip this function name if it is a prototype declaration.
(if (not (eq char ?\;))
(push (imenu-example--name-and-position) index-alist))))
- (imenu-progress-message prev-pos 100)
(nreverse index-alist)))
-(make-obsolete 'imenu-example--create-c-index "your own" "23.2")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
(defconst imenu--rescan-item '("*Rescan*" . -99))
;; The latest buffer index.
-;; Buffer local.
-(defvar imenu--index-alist nil
+(defvar-local imenu--index-alist nil
"The buffer index alist computed for this buffer in Imenu.
Simple elements in the alist look like (INDEX-NAME . POSITION).
element recalculates the buffer's index alist.")
;;;###autoload(put 'imenu--index-alist 'risky-local-variable t)
-(make-variable-buffer-local 'imenu--index-alist)
-
-(defvar imenu--last-menubar-index-alist nil
+(defvar-local imenu--last-menubar-index-alist nil
"The latest buffer index alist used to update the menu bar menu.")
-(make-variable-buffer-local 'imenu--last-menubar-index-alist)
-
-;; History list for 'jump-to-function-in-buffer'.
-;; Making this buffer local caused it not to work!
-(defvar imenu--history-list nil)
+(defvar imenu--history-list nil
+ ;; Making this buffer local caused it not to work!
+ "History list for 'jump-to-function-in-buffer'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Sort function
-;;; Sorts the items depending on their index name.
-;;; An item looks like (NAME . POSITION).
-;;;
(defun imenu--sort-by-name (item1 item2)
+ "Comparison function to sort items depending on their index name.
+An item looks like (NAME . POSITION)."
(string-lessp (car item1) (car item2)))
(defun imenu--sort-by-position (item1 item2)
(< (cdr item1) (cdr item2)))
(defun imenu--relative-position (&optional reverse)
- ;; Support function to calculate relative position in buffer
- ;; Beginning of buffer is 0 and end of buffer is 100
- ;; If REVERSE is non-nil then the beginning is 100 and the end is 0.
+ "Support function to calculate relative position in buffer.
+Beginning of buffer is 0 and end of buffer is 100
+If REVERSE is non-nil then the beginning is 100 and the end is 0."
(let ((pos (point))
(total (buffer-size)))
(and reverse (setq pos (- total pos)))
(/ (1- pos) (max (/ total 100) 1))
(/ (* 100 (1- pos)) (max total 1)))))
-;; Split LIST into sublists of max length N.
-;; Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
-;;
-;; The returned list DOES NOT share structure with LIST.
(defun imenu--split (list n)
+ "Split LIST into sublists of max length N.
+Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
+The returned list DOES NOT share structure with LIST."
(let ((remain list)
(result '())
(sublist '())
(i 0))
(while remain
(push (pop remain) sublist)
- (incf i)
+ (cl-incf i)
(and (= i n)
;; We have finished a sublist
(progn (push (nreverse sublist) result)
(push (nreverse sublist) result))
(nreverse result)))
-;;; Split the alist MENULIST into a nested alist, if it is long enough.
-;;; In any case, add TITLE to the front of the alist.
-;;; If IMENU--RESCAN-ITEM is present in MENULIST, it is moved to the
-;;; beginning of the returned alist.
-;;;
-;;; The returned alist DOES NOT share structure with MENULIST.
(defun imenu--split-menu (menulist title)
+ "Split the alist MENULIST into a nested alist, if it is long enough.
+In any case, add TITLE to the front of the alist.
+If IMENU--RESCAN-ITEM is present in MENULIST, it is moved to the
+beginning of the returned alist.
+The returned alist DOES NOT share structure with MENULIST."
(let ((menulist (copy-sequence menulist))
- keep-at-top tail)
+ keep-at-top)
(if (memq imenu--rescan-item menulist)
(setq keep-at-top (list imenu--rescan-item)
menulist (delq imenu--rescan-item menulist)))
- (setq tail menulist)
- (dolist (item tail)
+ (dolist (item menulist)
(when (imenu--subalist-p item)
(push item keep-at-top)
(setq menulist (delq item menulist))))
(cons title
(nconc (nreverse keep-at-top) menulist))))
-;;; Split up each long alist that are nested within ALIST
-;;; into nested alists.
-;;;
-;;; Return a split and sorted copy of ALIST. The returned alist DOES
-;;; NOT share structure with ALIST.
(defun imenu--split-submenus (alist)
- (mapcar (function
- (lambda (elt)
- (if (and (consp elt)
- (stringp (car elt))
- (listp (cdr elt)))
- (imenu--split-menu (cdr elt) (car elt))
- elt)))
+ "Split up each long alist that are nested within ALIST into nested alists.
+Return a split and sorted copy of ALIST. The returned alist DOES
+NOT share structure with ALIST."
+ (mapcar (lambda (elt)
+ (if (and (consp elt)
+ (stringp (car elt))
+ (listp (cdr elt)))
+ (imenu--split-menu (cdr elt) (car elt))
+ elt))
alist))
-;;; Truncate all strings in MENULIST to imenu-max-item-length
(defun imenu--truncate-items (menulist)
- (mapcar (function
- (lambda (item)
- (cond
- ((consp (cdr item))
- (imenu--truncate-items (cdr item)))
- ;; truncate if necessary
- ((and (numberp imenu-max-item-length)
- (> (length (car item)) imenu-max-item-length))
- (setcar item (substring (car item) 0 imenu-max-item-length))))))
+ "Truncate all strings in MENULIST to `imenu-max-item-length'."
+ (mapcar (lambda (item)
+ (cond
+ ((consp (cdr item))
+ (imenu--truncate-items (cdr item)))
+ ;; truncate if necessary
+ ((and (numberp imenu-max-item-length)
+ (> (length (car item)) imenu-max-item-length))
+ (setcar item (substring (car item) 0 imenu-max-item-length)))))
menulist))
(funcall imenu-create-index-function))))
(imenu--truncate-items imenu--index-alist)))
(or imenu--index-alist noerror
- (error "No items suitable for an index found in this buffer"))
+ (user-error "No items suitable for an index found in this buffer"))
(or imenu--index-alist
(setq imenu--index-alist (list nil)))
;; Add a rescan option to the index.
(cons imenu--rescan-item imenu--index-alist))
-;;; Find all markers in alist and makes
-;;; them point nowhere.
-;;; The top-level call uses nil as the argument;
-;;; non-nil arguments are in recursive calls.
-(defvar imenu--cleanup-seen)
+(defvar imenu--cleanup-seen nil)
(defun imenu--cleanup (&optional alist)
+ "Find all markers in ALIST and make them point nowhere.
+If ALIST is nil (the normal case), use `imenu--index-alist'.
+Non-nil arguments are in recursive calls."
;; If alist is provided use that list.
;; If not, empty the table of lists already seen
;; and use imenu--index-alist.
(setq imenu--cleanup-seen (cons alist imenu--cleanup-seen))
(setq alist imenu--index-alist imenu--cleanup-seen (list alist)))
- (and alist
- (mapc
- (lambda (item)
- (cond
- ((markerp (cdr item))
- (set-marker (cdr item) nil))
- ;; Don't process one alist twice.
- ((memq (cdr item) imenu--cleanup-seen))
- ((imenu--subalist-p item)
- (imenu--cleanup (cdr item)))))
- alist)
- t))
+ (when alist
+ (dolist (item alist)
+ (cond
+ ((markerp (cdr item)) (set-marker (cdr item) nil))
+ ;; Don't process one alist twice.
+ ((memq (cdr item) imenu--cleanup-seen))
+ ((imenu--subalist-p item) (imenu--cleanup (cdr item)))))
+ t))
(defun imenu--create-keymap (title alist &optional cmd)
- (list* 'keymap title
- (mapcar
- (lambda (item)
- (list* (car item) (car item)
- (cond
- ((imenu--subalist-p item)
- (imenu--create-keymap (car item) (cdr item) cmd))
- (t
- `(lambda () (interactive)
- ,(if cmd `(,cmd ',item) (list 'quote item)))))))
- alist)))
+ `(keymap ,title
+ ,@(mapcar
+ (lambda (item)
+ `(,(car item) ,(car item)
+ ,@(cond
+ ((imenu--subalist-p item)
+ (imenu--create-keymap (car item) (cdr item) cmd))
+ (t
+ `(lambda () (interactive)
+ ,(if cmd `(,cmd ',item) (list 'quote item)))))))
+ alist)))
(defun imenu--in-alist (str alist)
"Check whether the string STR is contained in multi-level ALIST."
(cond ((and imenu-prev-index-position-function
imenu-extract-index-name-function)
(let ((index-alist '()) (pos (point))
- prev-pos name)
+ name)
(goto-char (point-max))
- (imenu-progress-message prev-pos 0 t)
;; Search for the function
(while (funcall imenu-prev-index-position-function)
(when (= pos (point))
(error "Infinite loop at %s:%d: imenu-prev-index-position-function does not move point" (buffer-name) pos))
(setq pos (point))
- (imenu-progress-message prev-pos nil t)
(save-excursion
(setq name (funcall imenu-extract-index-name-function)))
(and (stringp name)
;; [ydi] updated for imenu-use-markers
(push (cons name (if imenu-use-markers (point-marker) (point)))
index-alist)))
- (imenu-progress-message prev-pos 100 t)
index-alist))
;; Use generic expression if possible.
((and imenu-generic-expression)
(imenu--generic-function imenu-generic-expression))
(t
- (error "This buffer cannot use `imenu-default-create-index-function'"))))
+ (user-error "This buffer cannot use `imenu-default-create-index-function'"))))
;;;
;;; Generic index gathering function.
;; 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))
- prev-pos
(case-fold-search (if (or (local-variable-p 'imenu-case-fold-search)
(not (local-variable-p 'font-lock-defaults)))
imenu-case-fold-search
(modify-syntax-entry c (cdr syn) table))
(car syn))))
(goto-char (point-max))
- (imenu-progress-message prev-pos 0 t)
(unwind-protect ; for syntax table
(save-match-data
(set-syntax-table table)
(goto-char (point-max))
(while (and (if (functionp regexp)
(funcall regexp)
- (re-search-backward regexp nil t))
+ (and
+ (re-search-backward regexp nil t)
+ ;; Do not count invisible definitions.
+ (let ((invis (invisible-p (point))))
+ (or (not invis)
+ (progn
+ (while (and invis
+ (not (bobp)))
+ (setq invis (not (re-search-backward
+ regexp nil 'move))))
+ (not invis))))))
;; Exit the loop if we get an empty match,
;; because it means a bad regexp was specified.
(not (= (match-beginning 0) (match-end 0))))
(goto-char (match-beginning index))
(beginning-of-line)
(setq beg (point))
- (imenu-progress-message prev-pos nil t)
;; Add this sort of submenu only when we've found an
;; item for it, avoiding empty, duff menus.
(unless (assoc menu-title index-alist)
;; keep making progress backwards.
(goto-char start))))
(set-syntax-table old-table)))
- (imenu-progress-message prev-pos 100 t)
;; Sort each submenu by position.
;; This is in case one submenu gets items from two different regexps.
(dolist (item index-alist)
`(menu-item ,name ,(make-sparse-keymap "Imenu")))
(use-local-map newmap)
(add-hook 'menu-bar-update-hook 'imenu-update-menubar)))
- (error "The mode `%s' does not support Imenu"
- (format-mode-line mode-name))))
+ (user-error "The mode `%s' does not support Imenu"
+ (format-mode-line mode-name))))
;;;###autoload
(defun imenu-add-menubar-index ()
(defvar imenu-buffer-menubar nil)
-(defvar imenu-menubar-modified-tick 0
+(defvar-local imenu-menubar-modified-tick 0
"The value of (buffer-chars-modified-tick) as of the last call
to `imenu-update-menubar'.")
-(make-variable-buffer-local 'imenu-menubar-modified-tick)
(defun imenu-update-menubar ()
(when (and (current-local-map)
(imenu item)
nil))
-(defun imenu-default-goto-function (name position &optional rest)
+(defun imenu-default-goto-function (_name position &optional _rest)
"Move to the given position.
NAME is ignored. POSITION is where to move. REST is also ignored.
(apply function (car index-item) position rest))
(run-hooks 'imenu-after-jump-hook)))
-(dolist (mess
- '("^No items suitable for an index found in this buffer$"
- "^This buffer cannot use `imenu-default-create-index-function'$"
- "^The mode `.*' does not support Imenu$"))
- (add-to-list 'debug-ignored-errors mess))
-
(provide 'imenu)
;;; imenu.el ends here
:parse-rule "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z0-9-]+\\|##\\|\\+="
:doc-spec '(
;; "(automake)Macro Index" is autoconf macros used in
- ;; configure.in, not Makefile.am, so don't have that here.
+ ;; configure.ac, not Makefile.am, so don't have that here.
("(automake)Variable Index" nil "^[ \t]*`" "'")
;; In automake 1.4 macros and variables were a combined node.
("(automake)Macro and Variable Index" nil "^[ \t]*`" "'")
;;; Code:
(require 'info)
-(eval-when-compile
- (require 'cl)) ;; for `incf'
+(eval-when-compile (require 'cl-lib)) ;; for `incf'
;;-----------------------------------------------------------------------------
;; vaguely generic
;; if the file exists, try the node
(cond ((not (cdr (assoc file info-xref-xfile-alist)))
- (incf info-xref-unavail))
+ (cl-incf info-xref-unavail))
((info-xref-goto-node-p node)
- (incf info-xref-good))
+ (cl-incf info-xref-good))
(t
- (incf info-xref-bad)
+ (cl-incf info-xref-bad)
(info-xref-output-error "no such node: %s" node)))))))
(if (eq :tag (cadr link))
(setq link (cddr link)))
(if (info-xref-goto-node-p (cadr link))
- (incf info-xref-good)
- (incf info-xref-bad)
+ (cl-incf info-xref-good)
+ (cl-incf info-xref-bad)
;; symbol-file gives nil for preloaded variables, would need
;; to copy what describe-variable does to show the right place
(info-xref-output "Symbol `%s' (file %s): cannot goto node: %s"
;; info.el --- info package for Emacs
-;; Copyright (C) 1985-1986, 1992-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help
;;; Code:
-(eval-when-compile (require 'cl))
-
(defgroup info nil
"Info subsystem."
:group 'help
"Face for Info nodes in a node header."
:group 'info)
+;; This is a defcustom largely so that we can get the benefit
+;; of custom-initialize-delay. Perhaps it would work to make it a
+;; defvar and explicitly give it a standard-value property, and
+;; call custom-initialize-delay on it.
+;; The progn forces the autoloader to include the whole thing, not
+;; just an abbreviated version.
+;;;###autoload
+(progn
+(defcustom Info-default-directory-list
+ (let* ((config-dir
+ (file-name-as-directory
+ ;; Self-contained NS build with info/ in the app-bundle.
+ (or (and (featurep 'ns)
+ (let ((dir (expand-file-name "../info" data-directory)))
+ (if (file-directory-p dir) dir)))
+ configure-info-directory)))
+ (prefixes
+ ;; Directory trees in which to look for info subdirectories
+ (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/")))
+ (suffixes
+ ;; Subdirectories in each directory tree that may contain info
+ ;; directories. Most of these are rather outdated.
+ ;; It ought to be fine to stop checking the "emacs" ones now,
+ ;; since this is Emacs and we have not installed info files
+ ;; into such directories for a looong time...
+ '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/"
+ "emacs/" "lib/" "lib/emacs/"))
+ (standard-info-dirs
+ (apply #'nconc
+ (mapcar (lambda (pfx)
+ (let ((dirs
+ (mapcar (lambda (sfx)
+ (concat pfx sfx "info/"))
+ suffixes)))
+ (prune-directory-list dirs)))
+ prefixes)))
+ ;; If $(prefix)/share/info is not one of the standard info
+ ;; directories, they are probably installing an experimental
+ ;; version of Emacs, so make sure that experimental version's Info
+ ;; files override the ones in standard directories.
+ (dirs
+ (if (member config-dir standard-info-dirs)
+ ;; FIXME? What is the point of adding it again at the end
+ ;; when it is already present earlier in the list?
+ (nconc standard-info-dirs (list config-dir))
+ (cons config-dir standard-info-dirs))))
+ (if (not (eq system-type 'windows-nt))
+ dirs
+ ;; Include the info directory near where Emacs executable was installed.
+ (let* ((instdir (file-name-directory invocation-directory))
+ (dir1 (expand-file-name "../info/" instdir))
+ (dir2 (expand-file-name "../../../info/" instdir)))
+ (cond ((file-exists-p dir1) (append dirs (list dir1)))
+ ((file-exists-p dir2) (append dirs (list dir2)))
+ (t dirs)))))
+
+ "Default list of directories to search for Info documentation files.
+They are searched in the order they are given in the list.
+Therefore, the directory of Info files that come with Emacs
+normally should come last (so that local files override standard ones),
+unless Emacs is installed into a non-standard directory. In the latter
+case, the directory of Info files that come with Emacs should be
+first in this list.
+
+Once Info is started, the list of directories to search
+comes from the variable `Info-directory-list'.
+This variable `Info-default-directory-list' is used as the default
+for initializing `Info-directory-list' when Info is started, unless
+the environment variable INFOPATH is set.
+
+Although this is a customizable variable, that is mainly for technical
+reasons. Normally, you should either set INFOPATH or customize
+`Info-additional-directory-list', rather than changing this variable."
+ :initialize 'custom-initialize-delay
+ :type '(repeat directory)
+ :group 'info))
+
(defvar Info-directory-list nil
"List of directories to search for Info documentation files.
If nil, meaning not yet initialized, Info uses the environment
(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."
(defvar Info-standalone nil
"Non-nil if Emacs was started solely as an Info browser.")
+(defvar Info-file-attributes nil
+ "Alist of file attributes of visited Info files.
+Each element is a list (FILE-NAME FILE-ATTRIBUTES...).")
+
+(defvar Info-toc-nodes nil
+ "Alist of cached parent-children node information in visited Info files.
+Each element is (FILE (NODE-NAME PARENT SECTION CHILDREN) ...)
+where PARENT is the parent node extracted from the Up pointer,
+SECTION is the section name in the Top node where this node is placed,
+CHILDREN is a list of child nodes extracted from the node menu.")
+
+(defvar Info-index-nodes nil
+ "Alist of cached index node names of visited Info files.
+Each element has the form (INFO-FILE INDEX-NODE-NAMES-LIST).")
+
(defvar Info-virtual-files nil
"List of definitions of virtual Info files.
Each element of the list has the format (FILENAME (OPERATION . HANDLER) ...)
(apply 'call-process-region (point-min) (point-max)
(car decoder) t t nil (cdr decoder))))
(let ((inhibit-null-byte-detection t)) ; Index nodes include null bytes
- (insert-file-contents fullname visit)))))
+ (insert-file-contents fullname visit)))
+
+ ;; Clear the caches of modified Info files.
+ (let* ((attribs-old (cdr (assoc fullname Info-file-attributes)))
+ (modtime-old (and attribs-old (nth 5 attribs-old)))
+ (attribs-new (and (stringp fullname) (file-attributes fullname)))
+ (modtime-new (and attribs-new (nth 5 attribs-new))))
+ (when (and modtime-old modtime-new
+ (> (float-time modtime-new) (float-time modtime-old)))
+ (setq Info-index-nodes (remove (assoc (or Info-current-file filename)
+ Info-index-nodes)
+ Info-index-nodes))
+ (setq Info-toc-nodes (remove (assoc (or Info-current-file filename)
+ Info-toc-nodes)
+ Info-toc-nodes)))
+ ;; Add new modtime to `Info-file-attributes'.
+ (setq Info-file-attributes
+ (cons (cons fullname attribs-new)
+ (remove (assoc fullname Info-file-attributes)
+ Info-file-attributes))))))
(defun Info-file-supports-index-cookies (&optional file)
"Return non-nil value if FILE supports Info index cookies.
(append (split-string (substring path 0 -1) sep)
(Info-default-dirs))
(split-string path sep))
- (Info-default-dirs)))))))
+ (Info-default-dirs))))
+ ;; For a self-contained (ie relocatable) NS build, AFAICS we
+ ;; always want the included info directory to be at the head of
+ ;; the search path, unless it's already in INFOPATH somewhere.
+ ;; It's at the head of Info-default-directory-list,
+ ;; but there's no way to get it at the head of Info-directory-list
+ ;; except by doing it here.
+ (and path
+ (featurep 'ns)
+ (let ((dir (expand-file-name "../info" data-directory)))
+ (and (file-directory-p dir)
+ (not (member dir (split-string path ":" t)))
+ (push dir Info-directory-list)))))))
;;;###autoload
(defun info-other-window (&optional file-or-node)
(interactive)
(info "emacs"))
+;;;###autoload
+(defun info-emacs-bug ()
+ "Display the \"Reporting Bugs\" section of the Emacs manual in Info mode."
+ (interactive)
+ (info "(emacs)Bugs"))
+
;;;###autoload
(defun info-standalone ()
"Run Emacs as a standalone Info reader.
(throw 'foo t))
;; No such anchor in tag table or node in tag table or file
- (error "No such node or anchor: %s" nodename))
+ (user-error "No such node or anchor: %s" nodename))
(Info-select-node)
(goto-char (point-min))
(while (and (not give-up)
(or (null found)
(not (funcall isearch-filter-predicate beg-found found))))
- (let ((search-spaces-regexp
- (if (or (not isearch-mode) isearch-regexp)
- Info-search-whitespace-regexp)))
+ (let ((search-spaces-regexp Info-search-whitespace-regexp))
(if (if backward
(re-search-backward regexp bound t)
(re-search-forward regexp bound t))
(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
(if (null Info-current-subfile)
(if isearch-mode
(signal 'search-failed (list regexp "end of manual"))
- (let ((search-spaces-regexp
- (if (or (not isearch-mode) isearch-regexp)
- Info-search-whitespace-regexp)))
+ (let ((search-spaces-regexp Info-search-whitespace-regexp))
(if backward
(re-search-backward regexp)
(re-search-forward regexp))))
(while (and (not give-up)
(or (null found)
(not (funcall isearch-filter-predicate beg-found found))))
- (let ((search-spaces-regexp
- (if (or (not isearch-mode) isearch-regexp)
- Info-search-whitespace-regexp)))
+ (let ((search-spaces-regexp Info-search-whitespace-regexp))
(if (if backward
(re-search-backward regexp nil t)
(re-search-forward regexp nil t))
(defun Info-isearch-search ()
(if Info-isearch-search
(lambda (string &optional bound noerror count)
- (if isearch-word
- (Info-search (concat "\\b" (replace-regexp-in-string
- "\\W+" "\\W+"
- (replace-regexp-in-string
- "^\\W+\\|\\W+$" "" string)
- nil t)
- ;; Lax version of word search
- (if (or isearch-nonincremental
- (eq (length string)
- (length (isearch-string-state
- (car isearch-cmds)))))
- "\\b"))
- bound noerror count
- (unless isearch-forward 'backward))
- (Info-search (if isearch-regexp string (regexp-quote string))
- bound noerror count
- (unless isearch-forward 'backward)))
+ (let ((Info-search-whitespace-regexp
+ (if (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ search-whitespace-regexp)))
+ (Info-search
+ (cond
+ (isearch-word
+ ;; Lax version of word search
+ (let ((lax (not (or isearch-nonincremental
+ (eq (length string)
+ (length (isearch--state-string
+ (car isearch-cmds))))))))
+ (if (functionp isearch-word)
+ (funcall isearch-word string lax)
+ (word-search-regexp string lax))))
+ (isearch-regexp string)
+ (t (regexp-quote string)))
+ bound noerror count
+ (unless isearch-forward 'backward)))
(point))
- (let ((isearch-search-fun-function nil))
- (isearch-search-fun))))
+ (isearch-search-fun-default)))
(defun Info-isearch-wrap ()
(if Info-isearch-search
(concat name ":" (Info-following-node-name-re)) bound t)
(match-string-no-properties 1))
((not (eq errorname t))
- (error "Node has no %s"
- (capitalize (or errorname name)))))))))
+ (user-error "Node has no %s"
+ (capitalize (or errorname name)))))))))
(defun Info-following-node-name-re (&optional allowedchars)
"Return a regexp matching a node name.
"Go back in the history to the last node visited."
(interactive)
(or Info-history
- (error "This is the first Info node you looked at"))
+ (user-error "This is the first Info node you looked at"))
(let ((history-forward
(cons (list Info-current-file Info-current-node (point))
Info-history-forward))
"Go forward in the history of visited nodes."
(interactive)
(or Info-history-forward
- (error "This is the last Info node you looked at"))
+ (user-error "This is the last Info node you looked at"))
(let ((history-forward (cdr Info-history-forward))
filename nodename opoint)
(setq filename (car (car Info-history-forward)))
(message "")
(nreverse nodes))))
-(defvar Info-toc-nodes nil
- "Alist of cached parent-children node information in visited Info files.
-Each element is (FILE (NODE-NAME PARENT SECTION CHILDREN) ...)
-where PARENT is the parent node extracted from the Up pointer,
-SECTION is the section name in the Top node where this node is placed,
-CHILDREN is a list of child nodes extracted from the node menu.")
-
(defun Info-toc-nodes (filename)
"Return a node list of Info FILENAME with parent-children information.
This information is cached in the variable `Info-toc-nodes' with the help
completions nil t)))
(list (if (equal input "")
default input) current-prefix-arg))
- (error "No cross-references in this node"))))
+ (user-error "No cross-references in this node"))))
(unless footnotename
(error "No reference was specified"))
(abs (- prev-ref (point))))
next-ref prev-ref))
((or next-ref prev-ref))
- ((error "No cross-reference named %s" footnotename))))
+ ((user-error "No cross-reference named %s"
+ footnotename))))
(setq target (Info-extract-menu-node-name t))))
(while (setq i (string-match "[ \t\n]+" target i))
(setq target (concat (substring target 0 i) " "
(save-excursion
(goto-char (point-min))
(if (not (search-forward "\n* menu:" nil t))
- (error "No menu in this node"))
+ (user-error "No menu in this node"))
(setq beg (point))
(and (< (point) p)
(save-excursion
(let ((case-fold-search t))
(goto-char (point-min))
(or (search-forward "\n* menu:" nil t)
- (error "No menu in this node"))
+ (user-error "No menu in this node"))
(or (re-search-forward (concat "\n\\* +" menu-item ":") nil t)
(re-search-forward (concat "\n\\* +" menu-item) nil t)
- (error "No such item in menu"))
+ (user-error "No such item in menu"))
(beginning-of-line)
(forward-char 2)
(Info-extract-menu-node-name nil (Info-index-node))))))
(match-beginning 0))))
(goto-char (point-min))
(or (search-forward "\n* menu:" bound t)
- (error "No menu in this node"))
+ (user-error "No menu in this node"))
(if count
(or (search-forward "\n* " bound t count)
(error "Too few items in menu"))
(if Info-history-skip-intermediate-nodes
(setq Info-history old-history)))))
(no-error nil)
- (t (error "No pointer forward from this node")))))
+ (t (user-error "No pointer forward from this node")))))
(defun Info-backward-node ()
"Go backward one node, considering all nodes as forming one sequence."
(upnode (Info-extract-pointer "up" t))
(case-fold-search t))
(cond ((and upnode (string-match "(" upnode))
- (error "First node in file"))
+ (user-error "First node in file"))
((and upnode (or (null prevnode)
;; Use string-equal, not equal,
;; to ignore text properties.
(if Info-history-skip-intermediate-nodes
(setq Info-history old-history))))
(t
- (error "No pointer backward from this node")))))
+ (user-error "No pointer backward from this node")))))
(defun Info-exit ()
"Exit Info by selecting some other buffer."
(and (search-forward "\n* " nil t)
(Info-extract-menu-node-name)))))
(if node (Info-goto-node node)
- (error "No more items in menu"))))
+ (user-error "No more items in menu"))))
(defun Info-last-menu-item ()
"Go to the node of the previous menu item."
(and (search-backward "\n* menu:" nil t)
(point)))))
(or (and beg (search-backward "\n* " beg t))
- (error "No previous items in menu")))
+ (user-error "No previous items in menu")))
(Info-goto-node (save-excursion
(goto-char (match-end 0))
(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."
(if Info-history-skip-intermediate-nodes
(setq Info-history old-history))))
(t
- (error "No more nodes"))))
+ (user-error "No more nodes"))))
(defun Info-last-preorder ()
"Go to the last node, popping up a level if there is none."
(let ((case-fold-search t))
(or (search-forward "\n* Menu:" nil t)
(goto-char (point-max)))))
- (t (error "No previous nodes"))))
+ (t (user-error "No previous nodes"))))
(defun Info-scroll-up ()
"Scroll one screenful forward in Info, considering all nodes as one sequence.
(or (re-search-forward pat nil t)
(progn
(goto-char old-pt)
- (error "No cross references in this node")))))
+ (user-error "No cross references in this node")))))
(goto-char (or (match-beginning 1) (match-beginning 0)))
(if (looking-at "\\* Menu:")
(if recur
- (error "No cross references in this node")
+ (user-error "No cross references in this node")
(Info-next-reference t))
(if (looking-at "^\\* ")
(forward-char 2)))))
(or (re-search-backward pat nil t)
(progn
(goto-char old-pt)
- (error "No cross references in this node")))))
+ (user-error "No cross references in this node")))))
(goto-char (or (match-beginning 1) (match-beginning 0)))
(if (looking-at "\\* Menu:")
(if recur
- (error "No cross references in this node")
+ (user-error "No cross references in this node")
(Info-prev-reference t))
(if (looking-at "^\\* ")
(forward-char 2)))))
\f
-(defvar Info-index-nodes nil
- "Alist of cached index node names of visited Info files.
-Each element has the form (INFO-FILE INDEX-NODE-NAMES-LIST).")
-
(defun Info-index-nodes (&optional file)
"Return a list of names of all index nodes in Info FILE.
If FILE is omitted, it defaults to the current Info file.
(or matches
(progn
(Info-goto-node orignode)
- (error "No `%s' in index" topic)))
+ (user-error "No `%s' in index" topic)))
;; Here it is a feature that assoc is case-sensitive.
(while (setq found (assoc topic matches))
(setq exact (cons found exact)
"Go to the next matching index item from the last \\<Info-mode-map>\\[Info-index] command."
(interactive "p")
(or Info-index-alternatives
- (error "No previous `i' command"))
+ (user-error "No previous `i' command"))
(while (< num 0)
(setq num (+ num (length Info-index-alternatives))))
(while (> num 0)
;; Don't raise an error when mouse-1 is bound to this - it's
;; often used to simply select the window or frame.
(eq 'mouse-1 (event-basic-type last-input-event)))
- (error "Point neither on reference nor in menu item description")))
+ (user-error "Point neither on reference nor in menu item description")))
;; Common subroutine.
(defun Info-try-follow-nearest-node (&optional fork)
(defun Info-mouse-follow-link (click)
"Follow a link where you click."
- (interactive "e")
+ (interactive "@e")
(let* ((position (event-start click))
(posn-string (and position (posn-string position)))
- (string (car-safe posn-string))
- (string-pos (cdr-safe posn-string))
- (link-args (and string string-pos
- (get-text-property string-pos 'link-args string))))
- (when link-args
- (Info-goto-node link-args))))
+ (link-args (if posn-string
+ (get-text-property (cdr posn-string)
+ 'link-args
+ (car posn-string))
+ (get-char-property (posn-point position)
+ 'link-args))))
+ (cond ((stringp link-args)
+ (Info-goto-node link-args))
+ ;; These special values of the `link-args' property are used
+ ;; for navigation; see `Info-fontify-node'.
+ ((eq link-args 'prev) (Info-prev))
+ ((eq link-args 'next) (Info-next))
+ ((eq link-args 'up) (Info-up)))))
\f
(defvar Info-mode-map
(define-key map "\177" 'Info-scroll-down)
(define-key map [mouse-2] 'Info-mouse-follow-nearest-node)
(define-key map [follow-link] 'mouse-face)
+ (define-key map [XF86Back] 'Info-history-back)
+ (define-key map [XF86Forward] 'Info-history-forward)
map)
"Keymap containing Info commands.")
With a zero prefix arg, put the name inside a function call to `info'."
(interactive "P")
(unless Info-current-node
- (error "No current Info node"))
+ (user-error "No current Info node"))
(let ((node (if (stringp Info-current-file)
(concat "(" (file-name-nondirectory Info-current-file) ") "
Info-current-node))))
'Info-isearch-push-state)
(set (make-local-variable 'isearch-filter-predicate)
'Info-isearch-filter)
- (set (make-local-variable 'search-whitespace-regexp)
- Info-search-whitespace-regexp)
(set (make-local-variable 'revert-buffer-function)
'Info-revert-buffer-function)
(Info-set-mode-line)
(t
(Info-goto-emacs-command-node command)))))
\f
-(defvar Info-next-link-keymap
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap [header-line mouse-1] 'Info-next)
- (define-key keymap [header-line mouse-2] 'Info-next)
- (define-key keymap [header-line down-mouse-1] 'ignore)
- (define-key keymap [mouse-2] 'Info-next)
- (define-key keymap [follow-link] 'mouse-face)
- keymap)
- "Keymap to put on the Next link in the text or the header line.")
-
-(defvar Info-prev-link-keymap
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap [header-line mouse-1] 'Info-prev)
- (define-key keymap [header-line mouse-2] 'Info-prev)
- (define-key keymap [header-line down-mouse-1] 'ignore)
- (define-key keymap [mouse-2] 'Info-prev)
- (define-key keymap [follow-link] 'mouse-face)
- keymap)
- "Keymap to put on the Prev link in the text or the header line.")
-
-(defvar Info-up-link-keymap
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap [header-line mouse-1] 'Info-up)
- (define-key keymap [header-line mouse-2] 'Info-up)
- (define-key keymap [header-line down-mouse-1] 'ignore)
- (define-key keymap [mouse-2] 'Info-up)
- (define-key keymap [follow-link] 'mouse-face)
- keymap)
- "Keymap to put on the Up link in the text or the header line.")
-
(defvar Info-link-keymap
(let ((keymap (make-sparse-keymap)))
- (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link)
+ (define-key keymap [header-line down-mouse-1] 'mouse-drag-header-line)
+ (define-key keymap [header-line mouse-1] 'mouse-select-window)
(define-key keymap [header-line mouse-2] 'Info-mouse-follow-link)
- (define-key keymap [header-line down-mouse-1] 'ignore)
(define-key keymap [mouse-2] 'Info-mouse-follow-link)
(define-key keymap [follow-link] 'mouse-face)
keymap)
- "Keymap to put on the link in the text or the header line.")
+ "Keymap to put on Info links.
+This is used for the \"Next\", \"Prev\", and \"Up\" links in the
+first line or header line, and for breadcrumb links.")
(defun Info-breadcrumbs ()
(let ((nodes (Info-toc-nodes Info-current-file))
'help-echo
(concat "mouse-2: Go to node "
(buffer-substring nbeg nend)))
- ;; Always set up the text property keymap.
- ;; It will either be used in the buffer
- ;; or copied in the header line.
- (put-text-property
- tbeg nend 'keymap
- (cond
- ((string-equal (downcase tag) "prev") Info-prev-link-keymap)
- ((string-equal (downcase tag) "next") Info-next-link-keymap)
- ((string-equal (downcase tag) "up" ) Info-up-link-keymap))))))
+ ;; Set up the text property keymap. Depending on
+ ;; `Info-use-header-line', it is either used in the
+ ;; buffer, or copied to the header line. A symbol value
+ ;; of the `link-args' property is handled specially by
+ ;; `Info-mouse-follow-link'.
+ (put-text-property tbeg nend 'keymap Info-link-keymap)
+ (put-text-property tbeg nend 'link-args
+ (intern (downcase tag))))))
;; (when (> Info-breadcrumbs-depth 0)
;; (insert (Info-breadcrumbs)))
((not (bobp))
;; Hide the punctuation at the end, too.
(skip-chars-backward " \t,")
- (put-text-property (point) header-end 'invisible t))))))
+ (put-text-property (point) header-end 'invisible t)
+ ;; Hide the suffix of the Info file name.
+ (beginning-of-line)
+ (if (re-search-forward
+ (format "File: %s\\([^,\n\t]+\\),"
+ (if (stringp Info-current-file)
+ (file-name-nondirectory Info-current-file)
+ Info-current-file))
+ header-end t)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'invisible t)))))))
;; Fontify titles
(goto-char (point-min))
mouse-face highlight
help-echo "mouse-2: go to this URL"))))
+ ;; Hide empty lines at the end of the node.
+ (goto-char (point-max))
+ (skip-chars-backward "\n")
+ (when (< (1+ (point)) (point-max))
+ (put-text-property (1+ (point)) (point-max) 'invisible t))
+
(set-buffer-modified-p nil))))
\f
;;; Speedbar support:
(erase-buffer))
(Info-speedbar-hierarchy-buttons nil 0))
-(dolist (mess '("^First node in file$"
- "^No `.*' in index$"
- "^No cross-reference named"
- "^No cross.references in this node$"
- "^No current Info node$"
- "^No menu in this node$"
- "^No more items in menu$"
- "^No more nodes$"
- "^No pointer \\(?:forward\\|backward\\) from this node$"
- "^No previous `i' command$"
- "^No previous items in menu$"
- "^No previous nodes$"
- "^No such item in menu$"
- "^No such node or anchor"
- "^Node has no"
- "^Point neither on reference nor in menu item description$"
- "^This is the \\(?:first\\|last\\) Info node you looked at$"
- search-failed))
- (add-to-list 'debug-ignored-errors mess))
+;; FIXME: Really? Why here?
+(add-to-list 'debug-ignored-errors 'search-failed)
;;;; Desktop support
(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)
;;; Code:
(require 'disp-table)
-(eval-when-compile (require 'cl))
(defgroup iso-ascii nil
"Set up char tables for ISO 8859/1 on ASCII terminals."
With a prefix argument ARG, enable the mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil."
- :variable (eq standard-display-table iso-ascii-display-table)
- (unless standard-display-table
- (setq standard-display-table iso-ascii-standard-display-table)))
+ :variable ((eq standard-display-table iso-ascii-display-table)
+ . (lambda (v)
+ (setq standard-display-table
+ (cond
+ (v iso-ascii-display-table)
+ ((eq standard-display-table iso-ascii-display-table)
+ iso-ascii-standard-display-table)
+ (t standard-display-table))))))
(provide 'iso-ascii)
;;; Code:
;;; Provide some binding for startup:
-;;;###autoload (or key-translation-map (setq key-translation-map (make-sparse-keymap)))
;;;###autoload (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map)
;;;###autoload (autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap)
;; with a language-specific mapping by using `M-x iso-transl-set-language'.
(iso-transl-define-keys iso-transl-char-map)
-(define-key isearch-mode-map "\C-x" nil)
-(define-key isearch-mode-map [?\C-x t] 'isearch-other-control-char)
-(define-key isearch-mode-map "\C-x8" nil)
-
-
(provide 'iso-transl)
;;; iso-transl.el ends here
(and char (char-displayable-p char))))
;; Backwards compatibility.
-(defalias 'latin1-char-displayable-p 'char-displayable-p)
-(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "22.1")
+(define-obsolete-function-alias 'latin1-char-displayable-p
+ 'char-displayable-p "22.1")
(defun latin1-display-setup (set &optional force)
"Set up Latin-1 display for characters in the given SET.
;;; Code:
-(eval-when-compile (require 'cl)) ; letf
-
(defvar dos-codepage)
(autoload 'widget-value "wid-edit")
(defvar describe-language-environment-map
(let ((map (make-sparse-keymap "Describe Language Environment")))
- (define-key map
- [Default] `(menu-item ,(purecopy "Default") describe-specified-language-support))
+ (bindings--define-key map
+ [Default] '(menu-item "Default" describe-specified-language-support))
map))
(defvar setup-language-environment-map
(let ((map (make-sparse-keymap "Set Language Environment")))
- (define-key map
- [Default] `(menu-item ,(purecopy "Default") setup-specified-language-environment))
+ (bindings--define-key map
+ [Default] '(menu-item "Default" setup-specified-language-environment))
map))
(defvar set-coding-system-map
(let ((map (make-sparse-keymap "Set Coding System")))
- (define-key-after map [universal-coding-system-argument]
- `(menu-item ,(purecopy "For Next Command") universal-coding-system-argument
- :help ,(purecopy "Coding system to be used by next command")))
- (define-key-after map [separator-1] menu-bar-separator)
- (define-key-after map [set-buffer-file-coding-system]
- `(menu-item ,(purecopy "For Saving This Buffer") set-buffer-file-coding-system
- :help ,(purecopy "How to encode this buffer when saved")))
- (define-key-after map [revert-buffer-with-coding-system]
- `(menu-item ,(purecopy "For Reverting This File Now")
- revert-buffer-with-coding-system
- :enable buffer-file-name
- :help ,(purecopy "Revisit this file immediately using specified coding system")))
- (define-key-after map [set-file-name-coding-system]
- `(menu-item ,(purecopy "For File Name") set-file-name-coding-system
- :help ,(purecopy "How to decode/encode file names")))
- (define-key-after map [separator-2] menu-bar-separator)
-
- (define-key-after map [set-keyboard-coding-system]
- `(menu-item ,(purecopy "For Keyboard") set-keyboard-coding-system
- :help ,(purecopy "How to decode keyboard input")))
- (define-key-after map [set-terminal-coding-system]
- `(menu-item ,(purecopy "For Terminal") set-terminal-coding-system
- :enable (null (memq initial-window-system '(x w32 ns)))
- :help ,(purecopy "How to encode terminal output")))
- (define-key-after map [separator-3] menu-bar-separator)
-
- (define-key-after map [set-selection-coding-system]
- `(menu-item ,(purecopy "For X Selections/Clipboard") set-selection-coding-system
- :visible (display-selections-p)
- :help ,(purecopy "How to en/decode data to/from selection/clipboard")))
- (define-key-after map [set-next-selection-coding-system]
- `(menu-item ,(purecopy "For Next X Selection") set-next-selection-coding-system
- :visible (display-selections-p)
- :help ,(purecopy "How to en/decode next selection/clipboard operation")))
- (define-key-after map [set-buffer-process-coding-system]
- `(menu-item ,(purecopy "For I/O with Subprocess") set-buffer-process-coding-system
+ (bindings--define-key map [set-buffer-process-coding-system]
+ '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
:visible (fboundp 'start-process)
:enable (get-buffer-process (current-buffer))
- :help ,(purecopy "How to en/decode I/O from/to subprocess connected to this buffer")))
+ :help "How to en/decode I/O from/to subprocess connected to this buffer"))
+ (bindings--define-key map [set-next-selection-coding-system]
+ '(menu-item "For Next X Selection" set-next-selection-coding-system
+ :visible (display-selections-p)
+ :help "How to en/decode next selection/clipboard operation"))
+ (bindings--define-key map [set-selection-coding-system]
+ '(menu-item "For X Selections/Clipboard" set-selection-coding-system
+ :visible (display-selections-p)
+ :help "How to en/decode data to/from selection/clipboard"))
+
+ (bindings--define-key map [separator-3] menu-bar-separator)
+ (bindings--define-key map [set-terminal-coding-system]
+ '(menu-item "For Terminal" set-terminal-coding-system
+ :enable (null (memq initial-window-system '(x w32 ns)))
+ :help "How to encode terminal output"))
+ (bindings--define-key map [set-keyboard-coding-system]
+ '(menu-item "For Keyboard" set-keyboard-coding-system
+ :help "How to decode keyboard input"))
+
+ (bindings--define-key map [separator-2] menu-bar-separator)
+ (bindings--define-key map [set-file-name-coding-system]
+ '(menu-item "For File Name" set-file-name-coding-system
+ :help "How to decode/encode file names"))
+ (bindings--define-key map [revert-buffer-with-coding-system]
+ '(menu-item "For Reverting This File Now"
+ revert-buffer-with-coding-system
+ :enable buffer-file-name
+ :help "Revisit this file immediately using specified coding system"))
+ (bindings--define-key map [set-buffer-file-coding-system]
+ '(menu-item "For Saving This Buffer" set-buffer-file-coding-system
+ :help "How to encode this buffer when saved"))
+ (bindings--define-key map [separator-1] menu-bar-separator)
+ (bindings--define-key map [universal-coding-system-argument]
+ '(menu-item "For Next Command" universal-coding-system-argument
+ :help "Coding system to be used by next command"))
map))
(defvar mule-menu-keymap
(let ((map (make-sparse-keymap "Mule (Multilingual Environment)")))
- (define-key-after map [set-language-environment]
- `(menu-item ,(purecopy "Set Language Environment") ,setup-language-environment-map))
- (define-key-after map [separator-mule] menu-bar-separator)
-
- (define-key-after map [toggle-input-method]
- `(menu-item ,(purecopy "Toggle Input Method") toggle-input-method))
- (define-key-after map [set-input-method]
- `(menu-item ,(purecopy "Select Input Method...") set-input-method))
- (define-key-after map [describe-input-method]
- `(menu-item ,(purecopy "Describe Input Method") describe-input-method))
- (define-key-after map [separator-input-method] menu-bar-separator)
-
- (define-key-after map [set-various-coding-system]
- `(menu-item ,(purecopy "Set Coding Systems") ,set-coding-system-map
- :enable (default-value 'enable-multibyte-characters)))
- (define-key-after map [view-hello-file]
- `(menu-item ,(purecopy "Show Multilingual Sample Text") view-hello-file
+ (bindings--define-key map [mule-diag]
+ '(menu-item "Show All Multilingual Settings" mule-diag
+ :help "Display multilingual environment settings"))
+ (bindings--define-key map [list-character-sets]
+ '(menu-item "List Character Sets" list-character-sets
+ :help "Show table of available character sets"))
+ (bindings--define-key map [describe-coding-system]
+ '(menu-item "Describe Coding System..." describe-coding-system))
+ (bindings--define-key map [describe-input-method]
+ '(menu-item "Describe Input Method..." describe-input-method
+ :help "Keyboard layout for a specific input method"))
+ (bindings--define-key map [describe-language-environment]
+ `(menu-item "Describe Language Environment"
+ ,describe-language-environment-map
+ :help "Show multilingual settings for a specific language"))
+
+ (bindings--define-key map [separator-coding-system] menu-bar-separator)
+ (bindings--define-key map [view-hello-file]
+ '(menu-item "Show Multilingual Sample Text" view-hello-file
:enable (file-readable-p
(expand-file-name "HELLO" data-directory))
- :help ,(purecopy "Demonstrate various character sets")))
- (define-key-after map [separator-coding-system] menu-bar-separator)
+ :help "Demonstrate various character sets"))
+ (bindings--define-key map [set-various-coding-system]
+ `(menu-item "Set Coding Systems" ,set-coding-system-map
+ :enable (default-value 'enable-multibyte-characters)))
- (define-key-after map [describe-language-environment]
- `(menu-item ,(purecopy "Describe Language Environment")
- ,describe-language-environment-map
- :help ,(purecopy "Show multilingual settings for a specific language")))
- (define-key-after map [describe-input-method]
- `(menu-item ,(purecopy "Describe Input Method...") describe-input-method
- :help ,(purecopy "Keyboard layout for a specific input method")))
- (define-key-after map [describe-coding-system]
- `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system))
- (define-key-after map [list-character-sets]
- `(menu-item ,(purecopy "List Character Sets") list-character-sets
- :help ,(purecopy "Show table of available character sets")))
- (define-key-after map [mule-diag]
- `(menu-item ,(purecopy "Show All Multilingual Settings") mule-diag
- :help ,(purecopy "Display multilingual environment settings")))
+ (bindings--define-key map [separator-input-method] menu-bar-separator)
+ (bindings--define-key map [describe-input-method]
+ '(menu-item "Describe Input Method" describe-input-method))
+ (bindings--define-key map [set-input-method]
+ '(menu-item "Select Input Method..." set-input-method))
+ (bindings--define-key map [toggle-input-method]
+ '(menu-item "Toggle Input Method" toggle-input-method))
+
+ (bindings--define-key map [separator-mule] menu-bar-separator)
+ (bindings--define-key map [set-language-environment]
+ `(menu-item "Set Language Environment" ,setup-language-environment-map))
map)
"Keymap for Mule (Multilingual environment) menu specific commands.")
"Display the HELLO file, which lists many languages and characters."
(interactive)
;; We have to decode the file in any environment.
- (letf ((coding-system-for-read 'iso-2022-7bit))
+ (let ((coding-system-for-read 'iso-2022-7bit))
(view-file (expand-file-name "HELLO" data-directory))))
(defun universal-coding-system-argument (coding-system)
if CODING-SYSTEM is ASCII-compatible"
(check-coding-system coding-system)
(setq-default buffer-file-coding-system coding-system)
- (if (fboundp 'ucs-set-table-for-input)
- (dolist (buffer (buffer-list))
- (or (local-variable-p 'buffer-file-coding-system buffer)
- (ucs-set-table-for-input buffer))))
(if (eq system-type 'darwin)
;; The file-name coding system on Darwin systems is always utf-8.
(make-variable-buffer-local 'input-method-history)
(put 'input-method-history 'permanent-local t)
-(defvar inactivate-current-input-method-function nil
- "Function to call for inactivating the current input method.
+(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.
This function is called with no argument.
This function should never change the value of `current-input-method'.
-It is set to nil by the function `inactivate-input-method'.")
-(make-variable-buffer-local 'inactivate-current-input-method-function)
-(put 'inactivate-current-input-method-function 'permanent-local t)
+It is set to nil by the function `deactivate-input-method'.")
+(make-variable-buffer-local 'deactivate-current-input-method-function)
+(put 'deactivate-current-input-method-function 'permanent-local t)
(defvar describe-current-input-method-function nil
"Function to call for describing the current input method.
(setq input-method (symbol-name input-method)))
(if (and current-input-method
(not (string= current-input-method input-method)))
- (inactivate-input-method))
+ (deactivate-input-method))
(unless (or current-input-method (null input-method))
(let ((slot (assoc input-method input-method-alist)))
(if (null slot)
(run-hooks 'input-method-activate-hook)
(force-mode-line-update)))))
-(defun inactivate-input-method ()
+(defun deactivate-input-method ()
"Turn off the current input method."
(when current-input-method
(if input-method-history
(progn
(setq input-method-function nil
current-input-method-title nil)
- (funcall inactivate-current-input-method-function))
+ (funcall deactivate-current-input-method-function))
(unwind-protect
- (run-hooks 'input-method-inactivate-hook)
+ (run-hooks
+ 'input-method-inactivate-hook ; for backward compatibility
+ 'input-method-deactivate-hook)
(setq current-input-method nil)
(force-mode-line-update)))))
+(define-obsolete-function-alias
+ 'inactivate-input-method
+ 'deactivate-input-method "24.3")
+
(defun set-input-method (input-method &optional interactive)
"Select and activate input method INPUT-METHOD for the current buffer.
This also sets the default input method to the one you specify.
which marks the variable `default-input-method' as set for Custom buffers.
To deactivate the input method interactively, use \\[toggle-input-method].
-To deactivate it programmatically, use `inactivate-input-method'."
+To deactivate it programmatically, use `deactivate-input-method'."
(interactive
(let* ((default (or (car input-method-history) default-input-method)))
(list (read-input-method-name
(if toggle-input-method-active
(error "Recursive use of `toggle-input-method'"))
(if (and current-input-method (not arg))
- (inactivate-input-method)
+ (deactivate-input-method)
(let ((toggle-input-method-active t)
(default (or (car input-method-history) default-input-method)))
(if (and arg default (equal current-input-method default)
:type 'hook
:group 'mule)
-(defcustom input-method-inactivate-hook nil
- "Normal hook run just after an input method is inactivated.
+(define-obsolete-variable-alias
+ 'input-method-inactivate-hook
+ 'input-method-deactivate-hook "24.3")
+
+(defcustom input-method-deactivate-hook nil
+ "Normal hook run just after an input method is deactivated.
The variable `current-input-method' still keeps the input method name
-just inactivated."
+just deactivated."
:type 'hook
- :group 'mule)
+ :group 'mule
+ :version "24.3")
(defcustom input-method-after-insert-chunk-hook nil
"Normal hook run just after an input method insert some chunk of text."
(defun princ-list (&rest args)
"Print all arguments with `princ', then print \"\\n\"."
+ (declare (obsolete "use mapc and princ instead." "23.3"))
(mapc #'princ args)
(princ "\n"))
-(make-obsolete 'princ-list "use mapc and princ instead" "23.3")
(put 'describe-specified-language-support 'apropos-inhibit t)
(unless frame (setq locale-coding-system code-page-coding))
(set-keyboard-coding-system code-page-coding frame)
(set-terminal-coding-system code-page-coding frame)
- ;; Set default-file-name-coding-system last, so that Emacs
- ;; doesn't try to use cpNNNN when it defines keyboard and
- ;; terminal encoding. That's because the above two lines
- ;; will want to load code-pages.el, where cpNNNN are
- ;; defined; if default-file-name-coding-system were set to
- ;; cpNNNN while these two lines run, Emacs will want to use
- ;; it for encoding the file name it wants to load. And that
- ;; will fail, since cpNNNN is not yet usable until
- ;; code-pages.el finishes loading.
(setq default-file-name-coding-system code-page-coding))))
(when (eq system-type 'darwin)
(t
(cdr (assoc-string input (ucs-names) t))))))
-(defun ucs-insert (character &optional count inherit)
- "Insert COUNT copies of CHARACTER of the given Unicode code point.
-Interactively, prompts for a Unicode character name or a hex number
-using `read-char-by-name'.
-
-You can type a few of the first letters of the Unicode name and
-use completion. If you type a substring of the Unicode name
-preceded by an asterisk `*' and use completion, it will show all
-the characters whose names include that substring, not necessarily
-at the beginning of the name.
-
-This function also accepts a hexadecimal number of Unicode code
-point or a number in hash notation, e.g. #o21430 for octal,
-#x2318 for hex, or #10r8984 for decimal.
-
-The optional third arg INHERIT (non-nil when called interactively),
-says to inherit text properties from adjoining text, if those
-properties are sticky."
- (interactive
- (list (read-char-by-name "Unicode (name or hex): ")
- (prefix-numeric-value current-prefix-arg)
- t))
- (unless count (setq count 1))
- (if (and (stringp character)
- (string-match-p "\\`[0-9a-fA-F]+\\'" character))
- (setq character (string-to-number character 16)))
- (cond
- ((null character)
- (error "Not a Unicode character"))
- ((not (integerp character))
- (error "Not a Unicode character code: %S" character))
- ((or (< character 0) (> character #x10FFFF))
- (error "Not a Unicode character code: 0x%X" character)))
- (if inherit
- (dotimes (i count) (insert-and-inherit character))
- (dotimes (i count) (insert character))))
-
-(define-key ctl-x-map "8\r" 'ucs-insert)
+(define-obsolete-function-alias 'ucs-insert 'insert-char "24.3")
+(define-key ctl-x-map "8\r" 'insert-char)
;;; mule-cmds.el ends here
"Decode a character that has code CODE in CODEPAGE.
Return a decoded character string. Each CODEPAGE corresponds to a
coding system cpCODEPAGE."
+ (declare (obsolete decode-char "23.1"))
(decode-char (intern (format "cp%d" codepage)) code))
-(make-obsolete 'decode-codepage-char 'decode-char "23.1")
;; A variable to hold charset input history.
(defvar charset-history nil)
;;; String manipulations while paying attention to multibyte
;;; characters.
-;;;###autoload
-(defun string-to-sequence (string type)
- "Convert STRING to a sequence of TYPE which contains characters in STRING.
-TYPE should be `list' or `vector'."
-;;; (let ((len (length string))
-;;; (i 0)
-;;; val)
- (cond ((eq type 'list)
- ;; Applicable post-Emacs 20.2 and asymptotically ~10 times
- ;; faster than the code below:
- (append string nil))
-;;; (setq val (make-list len 0))
-;;; (let ((l val))
-;;; (while (< i len)
-;;; (setcar l (aref string i))
-;;; (setq l (cdr l) i (1+ i))))))
- ((eq type 'vector)
- ;; As above.
- (vconcat string))
-;;; (setq val (make-vector len 0))
-;;; (while (< i len)
-;;; (aset val i (aref string i))
-;;; (setq i (1+ i))))
- (t
- (error "Invalid type: %s" type)))
-;;; val)
-)
-
-;;;###autoload
-(make-obsolete 'string-to-sequence
- "use `string-to-list' or `string-to-vector'."
- "22.1")
-
;;;###autoload
(defsubst string-to-list (string)
"Return a list of characters in STRING."
"Detect a coding system of the text between FROM and TO with PRIORITY-LIST.
PRIORITY-LIST is an alist of coding categories vs the corresponding
coding systems ordered by priority."
+ (declare (obsolete with-coding-priority "23.1"))
`(with-coding-priority (mapcar #'cdr ,priority-list)
(detect-coding-region ,from ,to)))
-(make-obsolete 'detect-coding-with-priority
- "use `with-coding-priority' and `detect-coding-region'." "23.1")
;;;###autoload
(defun detect-coding-with-language-environment (from to lang-env)
;;; Code:
+;; FIXME? Are these still relevant? Nothing uses them AFAICS.
(defconst mule-version "6.0 (HANACHIRUSATO)" "\
Version number and name of this version of MULE (multilingual environment).")
(defun charset-id (charset)
"Always return 0. This is provided for backward compatibility."
+ (declare (obsolete nil "23.1"))
0)
-(make-obsolete 'charset-id "do not use it." "23.1")
(defmacro charset-bytes (charset)
"Always return 0. This is provided for backward compatibility."
+ (declare (obsolete nil "23.1"))
0)
-(make-obsolete 'charset-bytes "do not use it." "23.1")
(defun get-charset-property (charset propname)
"Return the value of CHARSET's PROPNAME property.
(defun charset-list ()
"Return list of all charsets ever defined."
+ (declare (obsolete charset-list "23.1"))
charset-list)
-(make-obsolete 'charset-list "use variable `charset-list'." "23.1")
\f
;;; CHARACTER
(defun generic-char-p (char)
"Always return nil. This is provided for backward compatibility."
+ (declare (obsolete nil "23.1"))
nil)
-(make-obsolete 'generic-char-p "generic characters no longer exist." "23.1")
(defun make-char-internal (charset-id &optional code1 code2)
(let ((charset (aref emacs-mule-charset-table charset-id)))
eol-type)
"Define a new coding system CODING-SYSTEM (symbol).
This function is provided for backward compatibility."
+ (declare (obsolete define-coding-system "23.1"))
;; For compatibility with XEmacs, we check the type of TYPE. If it
;; is a symbol, perhaps, this function is called with XEmacs-style
;; arguments. Here, try to transform that kind of arguments to
(apply 'define-coding-system coding-system doc-string properties))
-(make-obsolete 'make-coding-system 'define-coding-system "23.1")
-
(defun merge-coding-systems (first second)
"Fill in any unspecified aspects of coding system FIRST from SECOND.
Return the resulting coding system."
ARG is a list of coding categories ordered by priority.
This function is provided for backward compatibility."
+ (declare (obsolete set-coding-system-priority "23.1"))
(apply 'set-coding-system-priority
(mapcar #'(lambda (x) (symbol-value x)) arg)))
-(make-obsolete 'set-coding-priority 'set-coding-system-priority "23.1")
;;; X selections
(re-search-forward
"\\(.*;\\)?[ \t]*unibyte:[ \t]*\\([^ ;]+\\)"
head-end t))
+ (display-warning 'mule "`unibyte: t' is obsolete; \
+use \"coding: 'raw-text\" instead." :warning)
(setq coding-system 'raw-text))
(when (and (not coding-system)
(re-search-forward
(goto-char pos)
(when (and set-auto-coding-for-load
(re-search-forward re-unibyte tail-end t))
+ (display-warning 'mule "`unibyte: t' is obsolete; \
+use \"coding: 'raw-text\" instead." :warning)
(setq coding-system 'raw-text))
(when (and (not coding-system)
(re-search-forward re-coding tail-end t))
(setq ignore-relative-composition
(make-char-table 'ignore-relative-composition))
-(make-obsolete 'set-char-table-default
- "generic characters no longer exist." "23.1")
-
;;; Built-in auto-coding-functions:
(defun sgml-xml-auto-coding-function (size)
ogonek-prefix-to-encoding iso8859-2
The above default values can be changed by placing appropriate settings
- in the '~/.emacs' file:
+ in your init file:
(setq ogonek-prefix-char ?/)
(setq ogonek-prefix-to-encoding \"iso8859-2\")
- Instead of loading the whole library `ogonek' it may be better to
- autoload the needed functions, for example by placing in `~/.emacs':
+ Instead of loading the whole library `ogonek' it may be better
+ to autoload the needed functions, for example by adding the
+ following lines to your init file:
(autoload 'ogonek-how \"ogonek\")
(autoload 'ogonek-recode-region \"ogonek\")
;;; Code:
(require 'help-mode)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup quail nil
"Quail: multilingual input method."
(setq translation-keymap (copy-keymap
(if simple quail-simple-translation-keymap
quail-translation-keymap)))
- (while translation-keys
- (define-key translation-keymap
- (car (car translation-keys)) (cdr (car translation-keys)))
- (setq translation-keys (cdr translation-keys))))
+ (dolist (trans translation-keys)
+ (define-key translation-keymap (car trans) (cdr trans))))
(setq translation-keymap
(if simple quail-simple-translation-keymap
quail-translation-keymap)))
(when conversion-keys
(setq conversion-keymap (copy-keymap quail-conversion-keymap))
- (while conversion-keys
- (define-key conversion-keymap
- (car (car conversion-keys)) (cdr (car conversion-keys)))
- (setq conversion-keys (cdr conversion-keys))))
+ (dolist (conv conversion-keys)
+ (define-key conversion-keymap (car conv) (cdr conv))))
(quail-add-package
(list name title (list nil) guidance (or docstring "")
translation-keymap
(if (and (overlayp quail-conv-overlay) (overlay-start quail-conv-overlay))
(delete-overlay quail-conv-overlay)))
-(defun quail-inactivate ()
- "Inactivate Quail input method.
+(defun quail-deactivate ()
+ "Deactivate Quail input method.
-This function runs the normal hook `quail-inactivate-hook'."
+This function runs the normal hook `quail-deactivate-hook'."
(interactive)
(quail-activate -1))
+(define-obsolete-function-alias 'quail-inactivate 'quail-deactivate "24.3")
+
(defun quail-activate (&optional arg)
"Activate Quail input method.
With ARG, activate Quail input method if and only if arg is positive.
This function runs `quail-activate-hook' if it activates the input
-method, `quail-inactivate-hook' if it deactivates it.
+method, `quail-deactivate-hook' if it deactivates it.
While this input method is active, the variable
`input-method-function' is bound to the function `quail-input-method'."
(if (and arg
(< (prefix-numeric-value arg) 0))
- ;; Let's inactivate Quail input method.
+ ;; Let's deactivate Quail input method.
(unwind-protect
(progn
(quail-delete-overlays)
(setq describe-current-input-method-function nil)
(quail-hide-guidance)
(remove-hook 'post-command-hook 'quail-show-guidance t)
- (run-hooks 'quail-inactivate-hook))
+ (run-hooks
+ 'quail-inactivate-hook ; for backward compatibility
+ 'quail-deactivate-hook))
(kill-local-variable 'input-method-function))
;; Let's activate Quail input method.
(if (null quail-current-package)
(setq name (car (car quail-package-alist)))
(error "No Quail package loaded"))
(quail-select-package name)))
- (setq inactivate-current-input-method-function 'quail-inactivate)
+ (setq deactivate-current-input-method-function 'quail-deactivate)
(setq describe-current-input-method-function 'quail-help)
(quail-delete-overlays)
(setq quail-guidance-str "")
(make-local-variable 'input-method-function)
(setq input-method-function 'quail-input-method)))
+(define-obsolete-variable-alias
+ 'quail-inactivate-hook
+ 'quail-deactivate-hook "24.3")
+
(defun quail-exit-from-minibuffer ()
- (inactivate-input-method)
+ (deactivate-input-method)
(if (<= (minibuffer-depth) 1)
(remove-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)))
(setq quail-keyboard-layout-substitution subst-list)
;; If there are additional key locations, map them to missing
;; key locations.
- (while missing-list
+ (dolist (missing missing-list)
(while (and subst-list (cdr (car subst-list)))
(setq subst-list (cdr subst-list)))
(if subst-list
- (setcdr (car subst-list) (car missing-list)))
- (setq missing-list (cdr missing-list))))))
+ (setcdr (car subst-list) missing))))))
(defcustom quail-keyboard-layout-type "standard"
"Type of keyboard layout used in Quail base input method.
(if translation
(progn
(if (consp translation)
- (if (> (length (cdr translation)) 0)
- (setq translation (aref (cdr translation) 0))
- (setq translation " ")))
+ (setq translation
+ (if (> (length (cdr translation)) 0)
+ (aref (cdr translation) 0)
+ " ")))
(setq done-list (cons translation done-list)))
(setq translation (aref kbd-layout i)))
(aset layout i translation))
(if (< (if (stringp lower) (string-width lower) (char-width lower)) 2)
(insert " "))
(if (characterp lower)
- (if (eq (get-char-code-property lower 'general-category) 'Mn)
- ;; Pad the left and right of non-spacing characters.
- (setq lower (compose-string (string lower) 0 1
- (format "\t%c\t" lower)))
- (setq lower (string lower))))
+ (setq lower
+ (if (eq (get-char-code-property lower 'general-category) 'Mn)
+ ;; Pad the left and right of non-spacing characters.
+ (compose-string (string lower) 0 1
+ (format "\t%c\t" lower))
+ (string lower))))
(if (characterp upper)
- (if (eq (get-char-code-property upper 'general-category) 'Mn)
- ;; Pad the left and right of non-spacing characters.
- (setq upper (compose-string (string upper) 0 1
- (format "\t%c\t" upper)))
- (setq upper (string upper))))
+ (setq upper
+ (if (eq (get-char-code-property upper 'general-category) 'Mn)
+ ;; Pad the left and right of non-spacing characters.
+ (compose-string (string upper) 0 1
+ (format "\t%c\t" upper))
+ (string upper))))
(insert (bidi-string-mark-left-to-right lower)
(propertize " " 'invisible t)
(bidi-string-mark-left-to-right upper))
(let ((map (list nil))
(decode-map (if (not no-decode-map) (list 'decode-map)))
key trans)
- (while l
- (setq key (car (car l)) trans (car (cdr (car l))) l (cdr l))
+ (dolist (el l)
+ (setq key (car el) trans (car (cdr el)))
(quail-defrule-internal key trans map t decode-map props))
`(if (prog1 (quail-decode-map)
(quail-install-map ',map))
(if (stringp trans)
(setq trans (string-to-vector trans))))
(let ((new (quail-vunion prevchars trans)))
- (setq trans
+ (setq trans
(if (equal new prevchars)
;; Nothing to change, get back to orig value.
prev
the translation, and INDEX points into VECTOR to specify the currently
selected translation."
(if (and def (symbolp def))
- (if (functionp def)
- ;; DEF is a symbol of a function which returns valid translation.
- (setq def (funcall def key len))
- (setq def nil)))
+ ;; DEF is a symbol of a function which returns valid translation.
+ (setq def (if (functionp def) (funcall def key len))))
(if (and (consp def) (not (vectorp (cdr def))))
(setq def (car def)))
(let ((last-col-elt (or (nth (1- (* (1+ col) newrows))
single-list)
(car (last single-list)))))
- (incf width (+ (max 3 (length (car last-col-elt)))
- 1 single-trans-width 1))))
+ (cl-incf width (+ (max 3 (length (car last-col-elt)))
+ 1 single-trans-width 1))))
(< width window-width))
- (incf cols))
+ (cl-incf cols))
(setq rows (/ (+ len cols -1) cols)) ;Round up.
(let ((key-width (max 3 (length (car (nth (1- rows) single-list))))))
(insert "key")
;; Use the symbol `robin-use-package' as the third argument.
-;; The fourth argument is the prompt that appears in modeline when this
+;; The fourth argument is the prompt that appears in mode line when this
;; input method is active.
;; The fifth argument is a documentation string; it may or may not be
(setq robin-current-package-name name)
(robin-activate)))
-(defun robin-inactivate ()
- "Inactivate robin input method."
+(defun robin-deactivate ()
+ "Deactivate robin input method."
(interactive)
(robin-activate -1))
+(define-obsolete-function-alias 'robin-inactivate 'robin-deactivate "24.3")
+
(defun robin-activate (&optional arg)
"Activate robin input method.
(if (and arg
(< (prefix-numeric-value arg) 0))
- ;; inactivate robin input method.
+ ;; deactivate robin input method.
(unwind-protect
(progn
(setq robin-mode nil)
(setq describe-current-input-method-function nil)
- (run-hooks 'robin-inactivate-hook))
+ (run-hooks
+ 'robin-inactivate-hook ; for backward compatibility
+ 'robin-deactivate-hook))
(kill-local-variable 'input-method-function))
;; activate robin input method.
(setq robin-mode t
describe-current-input-method-function 'robin-help
- inactivate-current-input-method-function 'robin-inactivate)
+ deactivate-current-input-method-function 'robin-deactivate)
(if (eq (selected-window) (minibuffer-window))
(add-hook 'minibuffer-exit-hook 'robin-exit-from-minibuffer))
(run-hooks 'input-method-activate-hook
(set (make-local-variable 'input-method-function)
'robin-input-method)))
+(define-obsolete-variable-alias
+ 'robin-inactivate-hook
+ 'robin-deactivate-hook "24.3")
+
(defun robin-exit-from-minibuffer ()
- (inactivate-input-method)
+ (deactivate-input-method)
(if (<= (minibuffer-depth) 1)
(remove-hook 'minibuffer-exit-hook 'robin-exit-from-minibuffer)))
(defconst ucs-normalize-version "1.2")
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(declare-function nfd "ucs-normalize" (char))
(let ((char 0) ccc decomposition)
(mapc
(lambda (start-end)
- (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
+ (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
(setq ccc (ucs-normalize-ccc char))
(setq decomposition (get-char-code-property
char 'decomposition))
(let (decomposition alist)
(mapc
(lambda (start-end)
- (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
+ (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
(setq decomposition (funcall decomposition-function char))
(if decomposition
(setq alist (cons (cons char
(let (entries decomposition composition)
(mapc
(lambda (start-end)
- (do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))
+ (cl-do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))
(setq decomposition
(string-to-list
(with-temp-buffer
;; See lisp/international/README for the copyright and permission notice.
(define-char-code-property 'bidi-class #^[1 nil char-code-property-table
#^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] #^^[1 0 #^^[2 0
-#^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] "\ 2\ 5Â\85\ 6\ 5Â\9a\ f\13\ eÂ\84\13Â\84\ 1\13\13\ 5\13\13\ e\ e\ 3\ 3\13\ 1\13Â\83\ 3\ 1\13Â\85\ 1Â\97\13\ 1Â\9f\13\ 1Â\88" 1 1 1 "\ 2\ 1¹\13\13\ 1Â\87\13Â\8e\ 1\ 1\13Â\8e\ 1Â\85\13Â\89\ 1\13Â\91" "\ 2\10ð\ 1Â\84\13\13\ 1Â\88\13\ 1" "\ 2\ 1Â\84\13\13\ 1\13\ 1î\13\ 1Â\89" 1 "\ 2\ 1Â\83\10Â\87\ 1ö" 1 "\ 2\ 1Â\8a\13\ 1Â\85\ 2\10Â\ 2\10\ 2\10\10\ 2\10\10\ 2\10\ 2¸" "\ 2\ 4Â\84\a\a\13\13\a\ e\ e\a\ f\a\13\13\10Â\8b\a°\10Â\95\ 4Â\8a\ e\ 4\ 4\aÂ\83\10\aÂ\8f" "\ 2\aÃ\96\10Â\87\ 4\13\10Â\86\a\a\10\10\13\10Â\84\a\a\ 3Â\8a\aÂ\86" "\ 2\aÂ\8e\ 1\ 4\a\10\aÂ\9e\10Â\9b\ 1\ 1\a³" "\ 2\a¦\10Â\8b\a\ 1Â\8e\ 2«\10Â\89\ 2\ 2\13Â\84\ 2Â\86" "\ 2\ 2Â\96\10Â\84\ 2\10Â\89\ 2\10Â\83\ 2\10Â\85\ 2«\10Â\83\ 2¤" 2 "\ 2\10Â\83\ 1·\10\ 1\10\ 1Â\84\10Â\88\ 1Â\84\10\ 1Â\83\10Â\87\ 1Â\8a\10\10\ 1Â\9c" "\ 2\ 1\10\ 1º\10\ 1Â\84\10Â\84\ 1Â\88\10\ 1Â\94\10\10\ 1Â\8e\ e\ e\ 1Â\87\ e\ 1Â\84" "\ 2\ 1\10\10\ 1¹\10\ 1Â\84\10\10\ 1Â\84\10\10\ 1\ 1\10Â\83\ 1Â\83\10\ 1Â\9e\10\10\ 1Â\83\10\ 1Â\8a" "\ 2\ 1\10\10\ 1¹\10\ 1Â\84\10Â\85\ 1\10\10\ 1Â\84\10\ 1Â\94\10\10\ 1Â\8d\ e\ 1Â\8e" "\ 2\ 1\10\ 1º\10\ 1\ 1\10\ 1\10Â\84\ 1Â\88\10\ 1Â\88\10\ 1Â\8b\10\10\ 1Â\9c" "\ 2\ 1\ 1\10\ 1½\10\ 1Â\8c\10\ 1Â¥\13Â\86\ e\13\ 1Â\85" "\ 2\ 1¾\10Â\83\ 1Â\85\10Â\83\ 1\10Â\84\ 1Â\87\10\10\ 1Â\8b\10\10\ 1Â\94\13Â\87\ 1" "\ 2\ 1¼\10\ 1Â\8f\10\10\ 1Â\94\10\10\ 1Â\9c" "\ 2\ 1Ã\81\10Â\84\ 1Â\88\10\ 1Â\94\10\10\ 1Â\9c" "\ 2\ 1Ã\8a\10\ 1Â\87\10Â\83\ 1\10\ 1©" "\ 2\ 1±\10\ 1\ 1\10Â\87\ 1Â\84\ e\ 1Â\87\10Â\88\ 1±" "\ 2\ 1±\10\ 1\ 1\10Â\86\ 1\10\10\ 1Â\8b\10Â\86\ 1²" "\ 2\ 1Â\98\10\10\ 1Â\9b\10\ 1\10\ 1\10\13Â\84\ 1³\10Â\8e\ 1" "\ 2\10Â\85\ 1\10\10\ 1Â\85\10Â\8b\ 1\10¤\ 1Â\89\10\ 1¹"] #^^[2 4096 "\ 2\ 1Â\10Â\84\ 1\10Â\86\ 1\10\10\ 1\ 1\10\10\ 1Â\99\10\10\ 1Â\84\10Â\83\ 1Â\90\10Â\84\ 1Â\8b" "\ 2\ 1\ 1\10\ 1\ 1\10\10\ 1Â\86\10\ 1Â\8f\10\ 1â" 1 1 1 1 "\ 2\ 1Ã\9d\10Â\83\ 1 " "\ 2\ 1Â\90\13Â\8a\ 1æ" "\ 2\13\ 1ÿ" 1 1 1 1 "\ 2\12\ 1Â\9a\13\13\ 1ã" "\ 2\ 1Â\92\10Â\83\ 1Â\9d\10Â\83\ 1Â\9d\10\10\ 1Â\9e\10\10\ 1Â\8c" "\ 2\ 1·\10Â\87\ 1Â\88\10\ 1\ 1\10Â\8b\ 1Â\87\ e\ 1\10\ 1Â\92\13Â\8a\ 1Â\86" "\ 2\13Â\8b\10Â\83\12\ 1ñ" "\ 2\ 1©\10\ 1Ã\96" "\ 2\ 1 \10Â\83\ 1Â\84\10\10\ 1Â\89\10\ 1Â\86\10Â\83\ 1Â\84\13\ 1Â\83\13\13\ 1º" "\ 2\ 1Ã\9e\13¢" "\ 2\ 1Â\97\10\10\ 1½\10\ 1\10Â\87\ 1\10\ 1\10\ 1\ 1\10Â\88\ 1Â\86\10Â\8a\ 1\ 1\10" 1 "\ 2\10Â\84\ 1°\10\ 1\10Â\85\ 1\10\ 1Â\85\10\ 1¨\10Â\89\ 1Â\8c" "\ 2\10\10\ 1 \10Â\84\ 1\ 1\10\10\ 1¼\10\ 1\10\10\ 1Â\83\10\ 1\10Â\83\ 1Â\8e" "\ 2\ 1¬\10Â\88\ 1\ 1\10\10\ 1Ã\88" "\ 2\ 1Ã\90\10Â\83\ 1\10Â\8d\ 1\10Â\87\ 1Â\84\10\ 1Â\92" 1 "\ 2\ 1À\10§\ 1\95\10\84" 1 1 1 "\ 2\ 1½\13\ 1\13\83\ 1\8b\13\83\ 1\8d\13\83\ 1\8d\13\83\ 1\8d\13\13\ 1"] #^^[2 8192 "\ 2\12\8b\ 5\83\ 1\ 2\13\98\12\ 6\b
-\f \v\ f\ eÂ\85\13Â\8f\ f\13Â\9a\12\ 5Â\85\ 1Â\85\ 5Â\86\ 3\ 1Â\83\ 3Â\86\r\r\13Â\83\ 1" "\ 2\ 3Â\8a\r\r\13Â\83\ 1Â\91\ eÂ\9a\ 1Â\96\10¡\ 1Â\8f" "\ 2\13\13\ 1\13Â\84\ 1\13\13\ 1Â\8a\13\ 1\13Â\83\ 1Â\85\13Â\86\ 1\13\ 1\13\ 1\13\ 1Â\84\ e\ 1Â\8b\13\13\ 1Â\84\13Â\85\ 1Â\85\13Â\84\ 1\ 1\13Â\90\ 1 " "\ 2\ 1Â\89\13\ 1Â\86\13ð" "\ 2\13Â\92\r\ e\13ì" 19 "\ 2\13¶\ 1Ã\85\13Â\85" "\ 2\13Â\95\ 1\13Ã\9e\ 1Â\8c" "\ 2\13§\ 1Â\99\13Â\8b\ 1Â\95\13 " "\ 2\13Â\88\ 3Â\94\ 1Ã\8e\13Â\96" 19 19 19 "\ 2\13¬\ 1\13Ã\93" "\ 2\ 1\13ÿ" "\ 2\13Ã\8b\ 1\13\ 1\13²" 1 1 19 19 19 19 "\ 2\13Ã\8d\ 1Â\83\13Â\8a\ 1¦" 1 1 "\ 2\ 1Ã¥\13Â\86\ 1Â\84\10Â\83\ 1Â\87\13Â\87" "\ 2\ 1ÿ\10" "\ 2\ 1à \10 " "\ 2\13²\ 1Ã\8e" "\ 2\13Â\9a\ 1\13Ã\99\ 1Â\8c" 19 "\ 2\13Ã\96\ 1Â\9a\13Â\8c\ 1Â\84"] #^^[2 12288 "\ 2\12\13Â\84\ 1Â\83\13Â\99\ 1Â\89\10Â\86\13\ 1\85\13\13\ 1\85\13\83\ 1À" "\ 2\ 1\99\10\10\13\13\ 1\83\13\ 1Ú\13\ 1\84" 1 "\ 2\ 1À\13¤\ 1\9c" "\ 2\ 1\9d\13\13\ 1±\13\90\ 1\9c\13\83\ 1" "\ 2\ 1±\13\8f\ 1\8c\13\84\ 1°" "\ 2\ 1÷\13\84\ 1\85" "\ 2\ 1Þ\13\13\ 1\9f\13" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1À\13À" 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 40832 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[2 40960 1 1 1 1 1 1 1 1 1 "\ 2\ 1\90\13·\ 1¹" 1 1 "\ 2\ 1\8d\13\83\ 1ß\10\84\13\ 1\88\10\10\13\13" "\ 2\ 1ð\10\10\ 1\8e" "\ 2\13¢\ 1Þ" "\ 2\ 1\88\13\ 1÷" "\ 2\ 1\ 1\10\ 1\83\10\ 1\84\10\ 1\99\10\10\ 1\13\84\ 1\8c\ e\ e\ 1º\13\84\ 1\88" "\ 2\ 1Ä\10\ 1\9b\10\92\ 1\8e" "\ 2\ 1¦\10\88\ 1\99\10\8b\ 1®" "\ 2\10\83\ 1°\10\ 1\ 1\10\84\ 1\ 1\10\ 1Ã" "\ 2\ 1©\10\86\ 1\ 1\10\10\ 1\ 1\10\10\ 1\8c\10\ 1\88\10\ 1³" "\ 2\ 1°\10\ 1\10\83\ 1\ 1\10\10\ 1\85\10\10\ 1\10\ 1¾" 1 "\ 2\ 1å\10\ 1\ 1\10\ 1\84\10\ 1\92" 1 1 1 1 1 1 1 1] 1 1 #^^[2 53248 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 61440 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1\9d\ 2\10\ 2\8a\r\ 2¦\a°" 7 7 7 "\ 2\a¾\13\13\aÀ" "\ 2\aý\13\a\a" "\ 2\10\90\13\8a\ 1\86\10\87\ 1\89\13 \ f\13\ f\ 1\13\ f\13\89\ e\13\13\r\r\13\83\ 1\13\ e\ e\13\ 1\84\a\90" "\ 2\aÿ\ 5" "\ 2\ 1\13\13\ e\83\13\85\r\ f\r\ f\ f\ 3\8a\ f\13\86\ 1\9a\13\86\ 1\9a\13\8b\ 1\9a" "\ 2\ 1à\ e\ e\13\83\ e\ e\ 1\13\87\ 1\8a\13\85\ 1\ 1"]] #^^[1 65536 #^^[2 65536 1 1 "\ 2\ 1\13\ 1¾\13À" "\ 2\13\8b\ 1\85\13\8c\ 1á\10\ 1\ 1" 1 1 1 1 1 1 1 1 1 1 1 1 2 2 "\ 2\ 2\9f\13\ 2à" 2 "\ 2\ 2\10\83\ 2\10\10\ 2\85\10\84\ 2¨\10\83\ 2\84\10\ 2À" 2 "\ 2\ 2¹\13\87\ 2À" 2 2 2 2 2 "\ 2\ 2à\ 4\9f\ 2" 2 2 2] #^^[2 69632 "\ 2\ 1\10\ 1¶\10\8f\ 1\8b\13\94\ 1\9a" "\ 2\10\10\ 1±\10\84\ 1\ 1\10\10\ 1Å" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 73728 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 77824 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 #^^[2 90112 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 #^^[2 110592 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 118784 1 1 "\ 2\ 1ç\10\83\ 1\89\ 5\88\10\85" "\ 2\10\83\ 1\ 1\10\87\ 1\9e\10\84\ 1Ò" "\ 2\13Â\10\83\13\ 1º" 1 "\ 2\13×\ 1©" 1 1 1 1 1 1 "\ 2\ 1Û\13\ 1¤" "\ 2\ 1\95\13\ 1¹\13\ 1°" "\ 2\ 1\89\13\ 1¹\13\ 1\8a\ 3²" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 122880 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2] #^^[2 126976 "\ 2\13¬\ 1\84\13Ð" "\ 2\13\94\ 1\8c\13\8f\ 1\ 1\13\8e\ 1\ 1\13\8f\ 1\13\8f\ 1 " "\ 2\ 3\8b\ 1õ" 1 1 1 "\ 2\13¡\ 1\8f\13\86\ 1\13Æ\ 1\83" "\ 2\13\94\ 1\8c\13¥\ 1\13\85\ 1\95\13\91\ 1\8f" "\ 2\13¿\ 1\13\ 1\13¾" "\ 2\13\8c\ 1\13ë\ 1\13\84\ 1\83" "\ 2\13¤\ 1\13\99\ 1\92\13\98\ 1\98" "\ 2\ 1û\13\85" "\ 2\ 1\13\90\ 1\13\83\ 1\13\ 1\13\ 1\13\ 1\13\83\ 1\13\86\ 1\ 1\13\84\ 1\13\ 1\ 1\13\84\ 1\13\8c\ 1\84\13\8b\ 1°" "\ 2\13Æ\ 1º" "\ 2\13ô\ 1\8c" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[1 131072 1 1 1 1 1 1 1 1 1 1 #^^[2 172032 1 1 1 1 1 1 1 1 1 1 1 1 1
+#^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] "\ 2\ 5Â\85\ 6\ 5Â\9a\ f\13\ eÂ\84\13Â\84\ 1\13\13\ 5\13\13\ e\ e\ 3\ 3\13\ 1\13Â\83\ 3\ 1\13Â\85\ 1Â\97\13\ 1Â\9f\13\ 1Â\88" 1 1 1 "\ 2\ 1¹\13\13\ 1Â\87\13Â\8e\ 1\ 1\13Â\8e\ 1Â\85\13Â\89\ 1\13Â\91" "\ 2\10ð\ 1Â\84\13\13\ 1Â\88\13\ 1" "\ 2\ 1Â\84\13\13\ 1\13\ 1î\13\ 1Â\89" 1 "\ 2\ 1Â\83\10Â\87\ 1ö" 1 "\ 2\ 1Â\8a\13\ 1Â\84\ e\ 2\10Â\ 2\10\ 2\10\10\ 2\10\10\ 2\10\ 2¸" "\ 2\ 4Â\85\a\13\13\a\ e\ e\a\ f\a\13\13\10Â\8b\a°\10Â\95\ 4Â\8a\ e\ 4\ 4\aÂ\83\10\aÂ\8f" "\ 2\aÃ\96\10Â\87\ 4\13\10Â\86\a\a\10\10\13\10Â\84\a\a\ 3Â\8a\aÂ\86" "\ 2\aÂ\8e\ 1\a\a\10\aÂ\9e\10Â\9b\ 1\ 1\a³" "\ 2\a¦\10Â\8b\a\ 1Â\8e\ 2«\10Â\89\ 2\ 2\13Â\84\ 2Â\86" "\ 2\ 2Â\96\10Â\84\ 2\10Â\89\ 2\10Â\83\ 2\10Â\85\ 2«\10Â\83\ 2¤" "\ 2\ 2 \a\ 2\aÂ\8b\ 2·\10Â\9b\ 2" "\ 2\10Â\83\ 1·\10\ 1\10\ 1Â\84\10Â\88\ 1Â\84\10\ 1Â\83\10Â\87\ 1Â\8a\10\10\ 1Â\9c" "\ 2\ 1\10\ 1º\10\ 1Â\84\10Â\84\ 1Â\88\10\ 1Â\94\10\10\ 1Â\8e\ e\ e\ 1Â\87\ e\ 1Â\84" "\ 2\ 1\10\10\ 1¹\10\ 1Â\84\10\10\ 1Â\84\10\10\ 1\ 1\10Â\83\ 1Â\83\10\ 1Â\9e\10\10\ 1Â\83\10\ 1Â\8a" "\ 2\ 1\10\10\ 1¹\10\ 1Â\84\10Â\85\ 1\10\10\ 1Â\84\10\ 1Â\94\10\10\ 1Â\8d\ e\ 1Â\8e" "\ 2\ 1\10\ 1º\10\ 1\ 1\10\ 1\10Â\84\ 1Â\88\10\ 1Â\88\10\ 1Â\8b\10\10\ 1Â\9c" "\ 2\ 1\ 1\10\ 1½\10\ 1Â\8c\10\ 1Â¥\13Â\86\ e\13\ 1Â\85" "\ 2\ 1¾\10Â\83\ 1Â\85\10Â\83\ 1\10Â\84\ 1Â\87\10\10\ 1Â\8b\10\10\ 1Â\94\13Â\87\ 1" "\ 2\ 1¼\10\ 1Â\8f\10\10\ 1Â\94\10\10\ 1Â\9c" "\ 2\ 1Ã\81\10Â\84\ 1Â\88\10\ 1Â\94\10\10\ 1Â\9c" "\ 2\ 1Ã\8a\10\ 1Â\87\10Â\83\ 1\10\ 1©" "\ 2\ 1±\10\ 1\ 1\10Â\87\ 1Â\84\ e\ 1Â\87\10Â\88\ 1±" "\ 2\ 1±\10\ 1\ 1\10Â\86\ 1\10\10\ 1Â\8b\10Â\86\ 1²" "\ 2\ 1Â\98\10\10\ 1Â\9b\10\ 1\10\ 1\10\13Â\84\ 1³\10Â\8e\ 1" "\ 2\10Â\85\ 1\10\10\ 1Â\85\10Â\8b\ 1\10¤\ 1Â\89\10\ 1¹"] #^^[2 4096 "\ 2\ 1Â\10Â\84\ 1\10Â\86\ 1\10\10\ 1\ 1\10\10\ 1Â\99\10\10\ 1Â\84\10Â\83\ 1Â\90\10Â\84\ 1Â\8b" "\ 2\ 1\ 1\10\ 1\ 1\10\10\ 1Â\86\10\ 1Â\8f\10\ 1â" 1 1 1 1 "\ 2\ 1Ã\9d\10Â\83\ 1 " "\ 2\ 1Â\90\13Â\8a\ 1æ" "\ 2\13\ 1ÿ" 1 1 1 1 "\ 2\12\ 1Â\9a\13\13\ 1ã" "\ 2\ 1Â\92\10Â\83\ 1Â\9d\10Â\83\ 1Â\9d\10\10\ 1Â\9e\10\10\ 1Â\8c" "\ 2\ 1´\10\10\ 1\10Â\87\ 1Â\88\10\ 1\ 1\10Â\8b\ 1Â\87\ e\ 1\10\ 1Â\92\13Â\8a\ 1Â\86" "\ 2\13Â\8b\10Â\83\12\ 1ñ" "\ 2\ 1©\10\ 1Ã\96" "\ 2\ 1 \10Â\83\ 1Â\84\10\10\ 1Â\89\10\ 1Â\86\10Â\83\ 1Â\84\13\ 1Â\83\13\13\ 1º" "\ 2\ 1Ã\9e\13¢" "\ 2\ 1Â\97\10\10\ 1½\10\ 1\10Â\87\ 1\10\ 1\10\ 1\ 1\10Â\88\ 1Â\86\10Â\8a\ 1\ 1\10" 1 "\ 2\10Â\84\ 1°\10\ 1\10Â\85\ 1\10\ 1Â\85\10\ 1¨\10Â\89\ 1Â\8c" "\ 2\10\10\ 1 \10Â\84\ 1\ 1\10\10\ 1\10\ 1º\10\ 1\10\10\ 1Â\83\10\ 1\10Â\83\ 1Â\8e" "\ 2\ 1¬\10Â\88\ 1\ 1\10\10\ 1Ã\88" "\ 2\ 1Ã\90\10Â\83\ 1\10Â\8d\ 1\10Â\87\ 1Â\84\10\ 1Â\86\10\ 1Â\8b" 1 "\ 2\ 1À\10§\ 1\95\10\84" 1 1 1 "\ 2\ 1½\13\ 1\13\83\ 1\8b\13\83\ 1\8d\13\83\ 1\8d\13\83\ 1\8d\13\13\ 1"] #^^[2 8192 "\ 2\12\8b\ 5\83\ 1\ 2\13\98\12\ 6\b
+\f \v\ f\ eÂ\85\13Â\8f\ f\13Â\9a\12\ 5Â\85\ 1Â\85\ 5Â\86\ 3\ 1Â\83\ 3Â\86\r\r\13Â\83\ 1" "\ 2\ 3Â\8a\r\r\13Â\83\ 1Â\91\ eÂ\9b\ 1Â\95\10¡\ 1Â\8f" "\ 2\13\13\ 1\13Â\84\ 1\13\13\ 1Â\8a\13\ 1\13Â\83\ 1Â\85\13Â\86\ 1\13\ 1\13\ 1\13\ 1Â\84\ e\ 1Â\8b\13\13\ 1Â\84\13Â\85\ 1Â\85\13Â\84\ 1\ 1\13Â\90\ 1 " "\ 2\ 1Â\89\13\ 1Â\86\13ð" "\ 2\13Â\92\r\ e\13ì" 19 "\ 2\13¶\ 1Ã\85\13Â\85" "\ 2\13Â\95\ 1\13Ã\9e\ 1Â\8c" "\ 2\13§\ 1Â\99\13Â\8b\ 1Â\95\13 " "\ 2\13Â\88\ 3Â\94\ 1Ã\8e\13Â\96" 19 19 19 "\ 2\13¬\ 1\13Ã\93" "\ 2\ 1\13ÿ" 19 1 1 19 19 19 19 "\ 2\13Ã\8d\ 1Â\83\13Â\8a\ 1¦" 1 1 "\ 2\ 1Ã¥\13Â\86\ 1Â\84\10Â\83\ 1Â\87\13Â\87" "\ 2\ 1ÿ\10" "\ 2\ 1à \10 " "\ 2\13¼\ 1Ã\84" "\ 2\13Â\9a\ 1\13Ã\99\ 1Â\8c" 19 "\ 2\13Ã\96\ 1Â\9a\13Â\8c\ 1Â\84"] #^^[2 12288 "\ 2\12\13Â\84\ 1Â\83\13Â\99\ 1Â\89\10Â\84\ 1\ 1\13\ 1\85\13\13\ 1\85\13\83\ 1À" "\ 2\ 1\99\10\10\13\13\ 1\83\13\ 1Ú\13\ 1\84" 1 "\ 2\ 1À\13¤\ 1\9c" "\ 2\ 1\9d\13\13\ 1±\13\90\ 1\9c\13\83\ 1" "\ 2\ 1±\13\8f\ 1\8c\13\84\ 1°" "\ 2\ 1÷\13\84\ 1\85" "\ 2\ 1Þ\13\13\ 1\9f\13" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1À\13À" 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+#^^[3 40832 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[2 40960 1 1 1 1 1 1 1 1 1 "\ 2\ 1\90\13·\ 1¹" 1 1 "\ 2\ 1\8d\13\83\ 1ß\10\84\13\10\8a\13\13" "\ 2\ 1\9f\10\ 1Ð\10\10\ 1\8e" "\ 2\13¢\ 1Þ" "\ 2\ 1\88\13\ 1÷" "\ 2\ 1\ 1\10\ 1\83\10\ 1\84\10\ 1\99\10\10\ 1\13\84\ 1\8c\ e\ e\ 1º\13\84\ 1\88" "\ 2\ 1Ä\10\ 1\9b\10\92\ 1\8e" "\ 2\ 1¦\10\88\ 1\99\10\8b\ 1®" "\ 2\10\83\ 1°\10\ 1\ 1\10\84\ 1\ 1\10\ 1Ã" "\ 2\ 1©\10\86\ 1\ 1\10\10\ 1\ 1\10\10\ 1\8c\10\ 1\88\10\ 1³" "\ 2\ 1°\10\ 1\10\83\ 1\ 1\10\10\ 1\85\10\10\ 1\10\ 1ª\10\10\ 1\88\10\ 1\89" 1 "\ 2\ 1å\10\ 1\ 1\10\ 1\84\10\ 1\92" 1 1 1 1 1 1 1 1] 1 1 #^^[2 53248 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 61440 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1\9d\ 2\10\ 2\8a\r\ 2¦\a°" 7 7 7 "\ 2\a¾\13\13\aÀ" "\ 2\aý\13\a\a" "\ 2\10\90\13\8a\ 1\86\10\87\ 1\89\13 \ f\13\ f\ 1\13\ f\13\89\ e\13\13\r\r\13\83\ 1\13\ e\ e\13\ 1\84\a\90" "\ 2\aÿ\ 5" "\ 2\ 1\13\13\ e\83\13\85\r\ f\r\ f\ f\ 3\8a\ f\13\86\ 1\9a\13\86\ 1\9a\13\8b\ 1\9a" "\ 2\ 1à\ e\ e\13\83\ e\ e\ 1\13\87\ 1\8a\13\85\ 1\ 1"]] #^^[1 65536 #^^[2 65536 1 1 "\ 2\ 1\13\ 1¾\13À" "\ 2\13\8b\ 1\85\13\8c\ 1á\10\ 1\ 1" 1 1 1 1 1 1 1 1 1 1 1 1 2 2 "\ 2\ 2\9f\13\ 2à" 2 "\ 2\ 2\10\83\ 2\10\10\ 2\85\10\84\ 2¨\10\83\ 2\84\10\ 2À" 2 "\ 2\ 2¹\13\87\ 2À" 2 2 2 2 2 "\ 2\ 2à\ 4\9f\ 2" 2 2 2] #^^[2 69632 "\ 2\ 1\10\ 1¶\10\8f\ 1\8b\13\94\ 1\9a" "\ 2\10\10\ 1±\10\84\ 1\ 1\10\10\ 1Å" "\ 2\10\83\ 1¤\10\85\ 1\10\88\ 1Ë" "\ 2\10\10\ 1´\10\89\ 1Á" 1 1 1 1 1 1 1 1 1 "\ 2\ 1«\10\ 1\10\ 1\ 1\10\86\ 1\10\ 1È" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 73728 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 77824 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 #^^[2 90112 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1\8f\10\84\ 1í"] 1 1 1 1 #^^[2 110592 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 118784 1 1 "\ 2\ 1ç\10\83\ 1\89\ 5\88\10\85" "\ 2\10\83\ 1\ 1\10\87\ 1\9e\10\84\ 1Ò" "\ 2\13Â\10\83\13\ 1º" 1 "\ 2\13×\ 1©" 1 1 1 1 1 1 "\ 2\ 1Û\13\ 1¤" "\ 2\ 1\95\13\ 1¹\13\ 1°" "\ 2\ 1\89\13\ 1¹\13\ 1\8a\ 3²" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 122880 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 "\ 2\a\84\ 2\a\9b\ 2\a\a\ 2\a\ 2\ 2\a\ 2\a\8a\ 2\a\84\ 2\a\ 2\a\ 2\86\a\ 2\84\a\ 2\a\ 2\a\ 2\a\83\ 2\a\a\ 2\a\ 2\ 2\a\ 2\a\ 2\a\ 2\a\ 2\a\ 2\a\a\ 2\a\ 2\ 2\a\84\ 2\a\87\ 2\a\84\ 2\a\84\ 2\a\ 2" "\ 2\a\8a\ 2\a\91\ 2\85\a\83\ 2\a\85\ 2\a\91\ 2´\13\13\ 2\8e" 2 2] #^^[2 126976 "\ 2\13¬\ 1\84\13Ð" "\ 2\13\94\ 1\8c\13\8f\ 1\ 1\13\8e\ 1\ 1\13\8f\ 1\13\8f\ 1 " "\ 2\ 3\8b\ 1ß\13\13\ 1\94" 1 1 1 "\ 2\13¡\ 1\8f\13\86\ 1\13Æ\ 1\83" "\ 2\13\94\ 1\8c\13¥\ 1\13\85\ 1\95\13\91\ 1\8f" "\ 2\13¿\ 1\13\ 1\13¾" "\ 2\13ø\ 1\13\84\ 1\83" "\ 2\13¾\ 1\ 1\13\84\ 1\8c\13\98\ 1\98" "\ 2\ 1û\13\85" "\ 2\13Á\ 1\84\13\8b\ 1°" "\ 2\13Æ\ 1º" "\ 2\13ô\ 1\8c" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[1 131072 1 1 1 1 1 1 1 1 1 1 #^^[2 172032 1 1 1 1 1 1 1 1 1 1 1 1 1
#^^[3 173696 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 176128 1 1 1 1 1 1 1 1 1 1 1 1 1 1
#^^[3 177920 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1
#^^[3 178176 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 #^^[2 192512 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] 1 1 1 1 1 1 1 1 1 1 1 #^^[1 917504 #^^[2 917504 "\ 2\ 1\ 5\ 1\9e\ 5à" 1 16 "\ 2\10ð\ 1\90" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[1 983040 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[2 1044480 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
;; See lisp/international/README for the copyright and permission notice.
(define-char-code-property 'general-category #^[30 nil char-code-property-table
#^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] #^^[1 0 #^^[2 0
-#^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] "\ 2\1a \17\12\14\84\16\16\15\16\ 2\10\13\e\16\15\16\13\v\v\15\ 2\16\12\15\v\ 2\11\v\83\12\ 1\97\13\ 1\87\ 2\98\13\ 2\88" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 1\ 2\ 1\ 2\ 1\ 2\ 2" "\ 2\ 2\ 1\ 1\ 2\ 1\ 2\ 1\ 1\ 2\ 1\83\ 2\ 2\ 1\84\ 2\ 1\ 1\ 2\ 1\83\ 2\83\ 1\ 1\ 2\ 1\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 1\ 2\ 1\83\ 2\ 1\ 2\ 1\ 1\ 2\ 2\ 5\ 1\ 2\83\ 5\84\ 1\ 3\ 2\ 1\ 3\ 2\ 1\ 3\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 3\ 2\ 1\ 2\ 1\83\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\87\ 1\ 1\ 2\ 1\ 1\ 2\ 2\ 1\ 2\ 1\84\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2±" "\ 2\ 2\94\ 5\ 2\9b\ 4\92\15\84\ 4\8c\15\8e\ 4\85\15\87\ 4\15\ 4\15\91" "\ 2\ 6ð\ 1\ 2\ 1\ 2\ 4\15\ 1\ 2\1e\1e\ 4\ 2\83\12\1e" "\ 2\1e\84\15\15\ 1\12\ 1\83\1e\ 1\1e\ 1\ 1\ 2\ 1\91\1e\ 1\89\ 2£\ 1\ 2\ 2\ 1\83\ 2\83\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\85\ 1\ 2\13\ 1\ 2\ 1\ 1\ 2\ 2\ 1\83" "\ 2\ 1°\ 2°\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 1\ 2\16\ 6\85\b\b\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\1e\89\ 1¦\1e\1e\ 4\12\86\1e\ 2\9f" "\ 2\ 2\88\1e\12\r\1e\86\ 6\r\ 6\12\ 6\ 6\12\ 6\ 6\12\ 6\1e\88\ 5\9b\1e\85\ 5\83\12\12\1e\8b" "\ 2\e\84\1e\1e\13\83\12\12\14\12\12\16\16\ 6\8b\12\1e\1e\12\12\ 5 \ 4\ 5\8a\ 6\95 \8a\12\84\ 5\ 5\ 6\ 5\8f" "\ 2\ 5Ô\12\ 5\ 6\87\e\16\ 6\86\ 4\ 4\ 6\ 6\16\ 6\84\ 5\ 5 \8a\ 5\83\16\16\ 5" "\ 2\12\8e\1e\e\ 5\ 6\ 5\9e\ 6\9b\1e\1e\ 5³" "\ 2\ 5¦\ 6\8b\ 5\1e\8e \8a\ 5¡\ 6\89\ 4\ 4\16\12\83\ 4\1e\85" "\ 2\ 5\96\ 6\84\ 4\ 6\89\ 4\ 6\83\ 4\ 6\85\1e\1e\12\8f\1e\ 5\99\ 6\83\1e\1e\12\1e¡" 30 "\ 2\ 6\83\a\ 5¶\ 6\a\ 6\ 5\a\83\ 6\88\a\84\ 6\a\a\ 5\ 6\87\ 5\8a\ 6\ 6\12\12 \8a\12\ 4\ 5\86\1e\ 5\87" "\ 2\1e\ 6\a\a\1e\ 5\88\1e\1e\ 5\ 5\1e\1e\ 5\96\1e\ 5\87\1e\ 5\1e\83\ 5\84\1e\1e\ 6\ 5\a\83\ 6\84\1e\1e\a\a\1e\1e\a\a\ 6\ 5\1e\88\a\1e\84\ 5\ 5\1e\ 5\83\ 6\ 6\1e\1e \8a\ 5\ 5\14\14\v\86\16\14\1e\84" "\ 2\1e\ 6\ 6\a\1e\ 5\86\1e\84\ 5\ 5\1e\1e\ 5\96\1e\ 5\87\1e\ 5\ 5\1e\ 5\ 5\1e\ 5\ 5\1e\1e\ 6\1e\a\83\ 6\ 6\1e\84\ 6\ 6\1e\1e\ 6\83\1e\83\ 6\1e\87\ 5\84\1e\ 5\1e\87 \8a\ 6\ 6\ 5\83\ 6\1e\8a" "\ 2\1e\ 6\ 6\a\1e\ 5\89\1e\ 5\83\1e\ 5\96\1e\ 5\87\1e\ 5\ 5\1e\ 5\85\1e\1e\ 6\ 5\a\83\ 6\85\1e\ 6\ 6\a\1e\a\a\ 6\1e\1e\ 5\1e\8f\ 5\ 5\ 6\ 6\1e\1e \8a\1e\14\1e\8e" "\ 2\1e\ 6\a\a\1e\ 5\88\1e\1e\ 5\ 5\1e\1e\ 5\96\1e\ 5\87\1e\ 5\ 5\1e\ 5\85\1e\1e\ 6\ 5\a\ 6\a\ 6\84\1e\1e\a\a\1e\1e\a\a\ 6\1e\88\ 6\a\1e\84\ 5\ 5\1e\ 5\83\ 6\ 6\1e\1e \8a\16\ 5\v\86\1e\88" "\ 2\1e\1e\ 6\ 5\1e\ 5\86\1e\83\ 5\83\1e\ 5\84\1e\83\ 5\ 5\1e\ 5\1e\ 5\ 5\1e\83\ 5\ 5\1e\83\ 5\83\1e\83\ 5\8c\1e\84\a\a\ 6\a\a\1e\83\a\83\1e\a\83\ 6\1e\1e\ 5\1e\86\a\1e\8e \8a\v\83\16\86\14\16\1e\85" "\ 2\1e\a\83\1e\ 5\88\1e\ 5\83\1e\ 5\97\1e\ 5\8a\1e\ 5\85\1e\83\ 5\ 6\83\a\84\1e\ 6\83\1e\ 6\84\1e\87\ 6\ 6\1e\ 5\ 5\1e\86\ 5\ 5\ 6\ 6\1e\1e \8a\1e\88\v\87\16" "\ 2\1e\1e\a\a\1e\ 5\88\1e\ 5\83\1e\ 5\97\1e\ 5\8a\1e\ 5\85\1e\1e\ 6\ 5\a\ 6\a\85\1e\ 6\a\a\1e\a\a\ 6\ 6\1e\87\a\a\1e\87\ 5\1e\ 5\ 5\ 6\ 6\1e\1e \8a\1e\ 5\ 5\1e\8d" "\ 2\1e\1e\a\a\1e\ 5\88\1e\ 5\83\1e\ 5©\1e\1e\ 5\a\83\ 6\84\1e\a\83\1e\a\83\ 6\ 5\1e\88\a\1e\88\ 5\ 5\ 6\ 6\1e\1e \8a\v\86\1e\83\16\ 5\86" "\ 2\1e\1e\a\a\1e\ 5\92\1e\83\ 5\98\1e\ 5\89\1e\ 5\1e\1e\ 5\87\1e\83\ 6\1e\84\a\83\ 6\83\1e\ 6\1e\a\88\1e\92\a\a\12\1e\8b" "\ 2\1e\ 5°\ 6\ 5\ 5\ 6\87\1e\84\14\ 5\86\ 4\ 6\88\12 \8a\12\12\1e¤" "\ 2\1e\ 5\ 5\1e\ 5\1e\1e\ 5\ 5\1e\ 5\1e\1e\ 5\1e\86\ 5\84\1e\ 5\87\1e\ 5\83\1e\ 5\1e\ 5\1e\1e\ 5\ 5\1e\ 5\84\ 6\ 5\ 5\ 6\86\1e\ 6\ 6\ 5\1e\1e\ 5\85\1e\ 4\1e\ 6\86\1e\1e \8a\1e\1e\ 5\ 5\1e¢" "\ 2\ 5\16\83\12\8f\16\85\ 6\ 6\16\86 \8a\v\8a\16\ 6\16\ 6\16\ 6\ e\ f\ e\ f\a\a\ 5\88\1e\ 5¤\1e\84\ 6\8e\a" "\ 2\ 6\85\12\ 6\ 6\ 5\85\ 6\8b\1e\ 6¤\1e\16\88\ 6\16\86\1e\16\16\12\85\16\84\12\12\1e¥"] #^^[2 4096 "\ 2\ 5«\a\a\ 6\84\a\ 6\86\a\ 6\ 6\a\a\ 6\ 6\ 5 \8a\12\86\ 5\86\a\a\ 6\ 6\ 5\84\ 6\83\ 5\a\83\ 5\ 5\a\87\ 5\83\ 6\84\ 5\8b" "\ 2\ 5\ 5\ 6\a\a\ 6\ 6\a\86\ 6\ 5\a \8a\a\83\ 6\16\16\ 1¦\1e\8a\ 5«\12\ 4\1e\83" 5 5 "\ 2\ 5É\1e\ 5\84\1e\1e\ 5\87\1e\ 5\1e\ 5\84\1e\1e\ 5 " "\ 2\ 5\89\1e\ 5\84\1e\1e\ 5¡\1e\ 5\84\1e\1e\ 5\87\1e\ 5\1e\ 5\84\1e\1e\ 5\8f\1e\ 5¨" "\ 2\ 5\91\1e\ 5\84\1e\1e\ 5Ã\1e\1e\ 6\83\16\12\88\v\94\1e\83" "\ 2\ 5\90\16\8a\1e\86\ 5Õ\1e\8b" "\ 2\r\ 5ÿ" 5 5 5 "\ 2\ 5í\12\12\ 5\91" "\ 2\17\ 5\9a\ e\ f\1e\83\ 5Ë\12\83
-\83\1e\8f" "\ 2\ 5\8d\1e\ 5\84\ 6\83\1e\8b\ 5\92\ 6\83\12\12\1e\89\ 5\92\ 6\ 6\1e\8c\ 5\8d\1e\ 5\83\1e\ 6\ 6\1e\8c" "\ 2\ 5´\e\e\a\ 6\87\a\88\ 6\a\a\ 6\8b\12\83\ 4\12\83\14\ 5\ 6\1e\1e \8a\1e\86\v\8a\1e\86" "\ 2\12\86\r\12\84\ 6\83\17\1e \8a\1e\86\ 5£\ 4\ 5´\1e\88" "\ 2\ 5©\ 6\ 5\1e\85\ 5Æ\1e\8a" "\ 2\ 5\9d\1e\83\ 6\83\a\84\ 6\ 6\a\83\1e\84\a\a\ 6\a\86\ 6\83\1e\84\16\1e\83\12\12 \8a\ 5\9e\1e\1e\ 5\85\1e\8b" "\ 2\ 5¬\1e\84\a\91\ 5\87\a\a\1e\86 \8a\v\1e\83\16¢" "\ 2\ 5\97\ 6\ 6\a\83\1e\1e\12\12\ 5µ\a\ 6\a\ 6\87\1e\ 6\a\ 6\a\a\ 6\88\a\86\ 6\8a\1e\1e\ 6" "\ 2 \8a\1e\86 \8a\1e\86\12\87\ 4\12\86\1eÒ" "\ 2\ 6\84\a\ 5¯\ 6\a\ 6\85\a\ 6\a\85\ 6\a\a\ 5\87\1e\84 \8a\12\87\16\8a\ 6\89\16\89\1e\83" "\ 2\ 6\ 6\a\ 5\9e\a\ 6\84\a\a\ 6\ 6\a\1e\83\ 5\ 5 \8a\1e\86\ 5¦\ 6\a\ 6\ 6\a\83\ 6\a\ 6\83\a\a\1e\88\12\84" "\ 2\ 5¤\a\88\ 6\88\a\a\ 6\ 6\1e\83\12\85 \8a\1e\83\ 5\83 \8a\ 5\9e\ 4\86\12\12" "\ 2\1eÐ\ 6\83\12\ 6\8d\a\ 6\87\ 5\84\ 6\ 5\84\a\1e\8d" "\ 2\ 2¬\ 4¶\ 2\96\ 4\ 2\87" "\ 2\ 2\9b\ 4¥\ 6§\1e\95\ 6\84" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\89\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 2\88\ 1\88\ 2\86\1e\1e\ 1\86\1e\1e\ 2\88\ 1\88\ 2\88\ 1\88\ 2\86\1e\1e\ 1\86\1e\1e\ 2\88\1e\ 1\1e\ 1\1e\ 1\1e\ 1\ 2\88\ 1\88\ 2\8e\1e\1e" "\ 2\ 2\88\ 3\88\ 2\88\ 3\88\ 2\88\ 3\88\ 2\85\1e\ 2\ 2\ 1\84\ 3\15\ 2\15\83\ 2\83\1e\ 2\ 2\ 1\84\ 3\15\83\ 2\84\1e\1e\ 2\ 2\ 1\84\1e\15\83\ 2\88\ 1\85\15\83\1e\1e\ 2\83\1e\ 2\ 2\ 1\84\ 3\15\15\1e"] #^^[2 8192 "\ 2\17\8b\e\85\r\86\12\12\10\11\ e\10\10\11\ e\10\12\88\18\19\e\85\17\12\89\10\11\12\84\f\f\12\83\13\ e\ f\12\8b\13\12\f\12\8a\17\e\85\1e\85\e\86\v\ 4\1e\1e\v\86\13\83\ e\ f\ 4" "\ 2\v\8a\13\83\ e\ f\1e\ 4\8d\1e\83\14\9a\1e\96\ 6\8d\b\84\ 6\b\83\ 6\8c\1e\8f" "\ 2\16\16\ 1\16\84\ 1\16\16\ 2\ 1\83\ 2\ 2\ 1\83\ 2\16\ 1\16\16\13\ 1\85\16\86\ 1\16\ 1\16\ 1\16\ 1\84\16\ 2\ 1\84\ 2\ 5\84\ 2\16\16\ 2\ 2\ 1\ 1\13\85\ 1\ 2\84\16\13\16\16\ 2\16\v\90
+#^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] "\ 2\1a \17\12\14\84\16\12\15\16\ 5\10\13\e\16\15\16\13\v\v\15\ 2\12\12\15\v\ 5\11\v\83\12\ 1\97\13\ 1\87\ 2\98\13\ 2\88" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 1\ 2\ 1\ 2\ 1\ 2\ 2" "\ 2\ 2\ 1\ 1\ 2\ 1\ 2\ 1\ 1\ 2\ 1\83\ 2\ 2\ 1\84\ 2\ 1\ 1\ 2\ 1\83\ 2\83\ 1\ 1\ 2\ 1\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 1\ 2\ 1\83\ 2\ 1\ 2\ 1\ 1\ 2\ 2\ 5\ 1\ 2\83\ 5\84\ 1\ 3\ 2\ 1\ 3\ 2\ 1\ 3\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 3\ 2\ 1\ 2\ 1\83\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\87\ 1\ 1\ 2\ 1\ 1\ 2\ 2\ 1\ 2\ 1\84\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2±" "\ 2\ 2\94\ 5\ 2\9b\ 4\92\15\84\ 4\8c\15\8e\ 4\85\15\87\ 4\15\ 4\15\91" "\ 2\ 6ð\ 1\ 2\ 1\ 2\ 4\15\ 1\ 2\1e\1e\ 4\ 2\83\12\1e" "\ 2\1e\84\15\15\ 1\12\ 1\83\1e\ 1\1e\ 1\ 1\ 2\ 1\91\1e\ 1\89\ 2£\ 1\ 2\ 2\ 1\83\ 2\83\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\85\ 1\ 2\13\ 1\ 2\ 1\ 1\ 2\ 2\ 1\83" "\ 2\ 1°\ 2°\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 1\ 2\16\ 6\85\b\b\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\1e\89\ 1¦\1e\1e\ 4\12\86\1e\ 2\9f" "\ 2\ 2\88\1e\12\r\1e\84\14\1e\ 6\r\ 6\12\ 6\ 6\12\ 6\ 6\12\ 6\1e\88\ 5\9b\1e\85\ 5\83\12\12\1e\8b" "\ 2\e\85\1e\13\83\12\12\14\12\12\16\16\ 6\8b\12\1e\1e\12\12\ 5 \ 4\ 5\8a\ 6\95 \8a\12\84\ 5\ 5\ 6\ 5\8f" "\ 2\ 5Ô\12\ 5\ 6\87\e\16\ 6\86\ 4\ 4\ 6\ 6\16\ 6\84\ 5\ 5 \8a\ 5\83\16\16\ 5" "\ 2\12\8e\1e\e\ 5\ 6\ 5\9e\ 6\9b\1e\1e\ 5³" "\ 2\ 5¦\ 6\8b\ 5\1e\8e \8a\ 5¡\ 6\89\ 4\ 4\16\12\83\ 4\1e\85" "\ 2\ 5\96\ 6\84\ 4\ 6\89\ 4\ 6\83\ 4\ 6\85\1e\1e\12\8f\1e\ 5\99\ 6\83\1e\1e\12\1e¡" "\ 2\1e \ 5\1e\ 5\8b\1e·\ 6\9b\1e" "\ 2\ 6\83\a\ 5¶\ 6\a\ 6\ 5\a\83\ 6\88\a\84\ 6\a\a\ 5\ 6\87\ 5\8a\ 6\ 6\12\12 \8a\12\ 4\ 5\86\1e\ 5\87" "\ 2\1e\ 6\a\a\1e\ 5\88\1e\1e\ 5\ 5\1e\1e\ 5\96\1e\ 5\87\1e\ 5\1e\83\ 5\84\1e\1e\ 6\ 5\a\83\ 6\84\1e\1e\a\a\1e\1e\a\a\ 6\ 5\1e\88\a\1e\84\ 5\ 5\1e\ 5\83\ 6\ 6\1e\1e \8a\ 5\ 5\14\14\v\86\16\14\1e\84" "\ 2\1e\ 6\ 6\a\1e\ 5\86\1e\84\ 5\ 5\1e\1e\ 5\96\1e\ 5\87\1e\ 5\ 5\1e\ 5\ 5\1e\ 5\ 5\1e\1e\ 6\1e\a\83\ 6\ 6\1e\84\ 6\ 6\1e\1e\ 6\83\1e\83\ 6\1e\87\ 5\84\1e\ 5\1e\87 \8a\ 6\ 6\ 5\83\ 6\1e\8a" "\ 2\1e\ 6\ 6\a\1e\ 5\89\1e\ 5\83\1e\ 5\96\1e\ 5\87\1e\ 5\ 5\1e\ 5\85\1e\1e\ 6\ 5\a\83\ 6\85\1e\ 6\ 6\a\1e\a\a\ 6\1e\1e\ 5\1e\8f\ 5\ 5\ 6\ 6\1e\1e \8a\12\14\1e\8e" "\ 2\1e\ 6\a\a\1e\ 5\88\1e\1e\ 5\ 5\1e\1e\ 5\96\1e\ 5\87\1e\ 5\ 5\1e\ 5\85\1e\1e\ 6\ 5\a\ 6\a\ 6\84\1e\1e\a\a\1e\1e\a\a\ 6\1e\88\ 6\a\1e\84\ 5\ 5\1e\ 5\83\ 6\ 6\1e\1e \8a\16\ 5\v\86\1e\88" "\ 2\1e\1e\ 6\ 5\1e\ 5\86\1e\83\ 5\83\1e\ 5\84\1e\83\ 5\ 5\1e\ 5\1e\ 5\ 5\1e\83\ 5\ 5\1e\83\ 5\83\1e\83\ 5\8c\1e\84\a\a\ 6\a\a\1e\83\a\83\1e\a\83\ 6\1e\1e\ 5\1e\86\a\1e\8e \8a\v\83\16\86\14\16\1e\85" "\ 2\1e\a\83\1e\ 5\88\1e\ 5\83\1e\ 5\97\1e\ 5\8a\1e\ 5\85\1e\83\ 5\ 6\83\a\84\1e\ 6\83\1e\ 6\84\1e\87\ 6\ 6\1e\ 5\ 5\1e\86\ 5\ 5\ 6\ 6\1e\1e \8a\1e\88\v\87\16" "\ 2\1e\1e\a\a\1e\ 5\88\1e\ 5\83\1e\ 5\97\1e\ 5\8a\1e\ 5\85\1e\1e\ 6\ 5\a\ 6\a\85\1e\ 6\a\a\1e\a\a\ 6\ 6\1e\87\a\a\1e\87\ 5\1e\ 5\ 5\ 6\ 6\1e\1e \8a\1e\ 5\ 5\1e\8d" "\ 2\1e\1e\a\a\1e\ 5\88\1e\ 5\83\1e\ 5©\1e\1e\ 5\a\83\ 6\84\1e\a\83\1e\a\83\ 6\ 5\1e\88\a\1e\88\ 5\ 5\ 6\ 6\1e\1e \8a\v\86\1e\83\16\ 5\86" "\ 2\1e\1e\a\a\1e\ 5\92\1e\83\ 5\98\1e\ 5\89\1e\ 5\1e\1e\ 5\87\1e\83\ 6\1e\84\a\83\ 6\83\1e\ 6\1e\a\88\1e\92\a\a\12\1e\8b" "\ 2\1e\ 5°\ 6\ 5\ 5\ 6\87\1e\84\14\ 5\86\ 4\ 6\88\12 \8a\12\12\1e¤" "\ 2\1e\ 5\ 5\1e\ 5\1e\1e\ 5\ 5\1e\ 5\1e\1e\ 5\1e\86\ 5\84\1e\ 5\87\1e\ 5\83\1e\ 5\1e\ 5\1e\1e\ 5\ 5\1e\ 5\84\ 6\ 5\ 5\ 6\86\1e\ 6\ 6\ 5\1e\1e\ 5\85\1e\ 4\1e\ 6\86\1e\1e \8a\1e\1e\ 5\84\1e " "\ 2\ 5\16\83\12\8f\16\12\16\83\ 6\ 6\16\86 \8a\v\8a\16\ 6\16\ 6\16\ 6\ e\ f\ e\ f\a\a\ 5\88\1e\ 5¤\1e\84\ 6\8e\a" "\ 2\ 6\85\12\ 6\ 6\ 5\85\ 6\8b\1e\ 6¤\1e\16\88\ 6\16\86\1e\16\16\12\85\16\84\12\12\1e¥"] #^^[2 4096 "\ 2\ 5«\a\a\ 6\84\a\ 6\86\a\ 6\ 6\a\a\ 6\ 6\ 5 \8a\12\86\ 5\86\a\a\ 6\ 6\ 5\84\ 6\83\ 5\a\83\ 5\ 5\a\87\ 5\83\ 6\84\ 5\8b" "\ 2\ 5\ 5\ 6\a\a\ 6\ 6\a\86\ 6\ 5\a \8a\a\83\ 6\16\16\ 1¦\1e\ 1\1e\85\ 1\1e\1e\ 5«\12\ 4\ 5\83" 5 5 "\ 2\ 5É\1e\ 5\84\1e\1e\ 5\87\1e\ 5\1e\ 5\84\1e\1e\ 5 " "\ 2\ 5\89\1e\ 5\84\1e\1e\ 5¡\1e\ 5\84\1e\1e\ 5\87\1e\ 5\1e\ 5\84\1e\1e\ 5\8f\1e\ 5¨" "\ 2\ 5\91\1e\ 5\84\1e\1e\ 5Ã\1e\1e\ 6\83\12\89\v\94\1e\83" "\ 2\ 5\90\16\8a\1e\86\ 5Õ\1e\8b" "\ 2\r\ 5ÿ" 5 5 5 "\ 2\ 5í\12\12\ 5\91" "\ 2\17\ 5\9a\ e\ f\1e\83\ 5Ë\12\83
+\83\1e\8f" "\ 2\ 5\8d\1e\ 5\84\ 6\83\1e\8b\ 5\92\ 6\83\12\12\1e\89\ 5\92\ 6\ 6\1e\8c\ 5\8d\1e\ 5\83\1e\ 6\ 6\1e\8c" "\ 2\ 5´\ 6\ 6\a\ 6\87\a\88\ 6\a\a\ 6\8b\12\83\ 4\12\83\14\ 5\ 6\1e\1e \8a\1e\86\v\8a\1e\86" "\ 2\12\86\r\12\84\ 6\83\17\1e \8a\1e\86\ 5£\ 4\ 5´\1e\88" "\ 2\ 5©\ 6\ 5\1e\85\ 5Æ\1e\8a" "\ 2\ 5\9d\1e\83\ 6\83\a\84\ 6\ 6\a\83\1e\84\a\a\ 6\a\86\ 6\83\1e\84\16\1e\83\12\12 \8a\ 5\9e\1e\1e\ 5\85\1e\8b" "\ 2\ 5¬\1e\84\a\91\ 5\87\a\a\1e\86 \8a\v\1e\83\16¢" "\ 2\ 5\97\ 6\ 6\a\83\1e\1e\12\12\ 5µ\a\ 6\a\ 6\87\1e\ 6\a\ 6\a\a\ 6\88\a\86\ 6\8a\1e\1e\ 6" "\ 2 \8a\1e\86 \8a\1e\86\12\87\ 4\12\86\1eÒ" "\ 2\ 6\84\a\ 5¯\ 6\a\ 6\85\a\ 6\a\85\ 6\a\a\ 5\87\1e\84 \8a\12\87\16\8a\ 6\89\16\89\1e\83" "\ 2\ 6\ 6\a\ 5\9e\a\ 6\84\a\a\ 6\ 6\a\ 6\a\a\ 5\ 5 \8a\ 5¬\ 6\a\ 6\ 6\a\83\ 6\a\ 6\83\a\a\1e\88\12\84" "\ 2\ 5¤\a\88\ 6\88\a\a\ 6\ 6\1e\83\12\85 \8a\1e\83\ 5\83 \8a\ 5\9e\ 4\86\12\12" "\ 2\1eÀ\12\88\1e\88\ 6\83\12\ 6\8d\a\ 6\87\ 5\84\ 6\ 5\84\a\a\ 6\ 5\ 5\1e\89" "\ 2\ 2¬\ 4¿\ 2\8d\ 4\ 2\87" "\ 2\ 2\9b\ 4¥\ 6§\1e\95\ 6\84" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\89\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2" "\ 2\ 2\88\ 1\88\ 2\86\1e\1e\ 1\86\1e\1e\ 2\88\ 1\88\ 2\88\ 1\88\ 2\86\1e\1e\ 1\86\1e\1e\ 2\88\1e\ 1\1e\ 1\1e\ 1\1e\ 1\ 2\88\ 1\88\ 2\8e\1e\1e" "\ 2\ 2\88\ 3\88\ 2\88\ 3\88\ 2\88\ 3\88\ 2\85\1e\ 2\ 2\ 1\84\ 3\15\ 2\15\83\ 2\83\1e\ 2\ 2\ 1\84\ 3\15\83\ 2\84\1e\1e\ 2\ 2\ 1\84\1e\15\83\ 2\88\ 1\85\15\83\1e\1e\ 2\83\1e\ 2\ 2\ 1\84\ 3\15\15\1e"] #^^[2 8192 "\ 2\17\8b\e\85\r\86\12\12\10\11\ e\10\10\11\ e\10\12\88\18\19\e\85\17\12\89\10\11\12\84\f\f\12\83\13\ e\ f\12\8b\13\12\f\12\8a\17\e\85\1e\85\e\86\v\ 4\1e\1e\v\86\13\83\ e\ f\ 4" "\ 2\v\8a\13\83\ e\ f\1e\ 4\8d\1e\83\14\9b\1e\95\ 6\8d\b\84\ 6\b\83\ 6\8c\1e\8f" "\ 2\16\16\ 1\16\84\ 1\16\16\ 2\ 1\83\ 2\ 2\ 1\83\ 2\16\ 1\16\16\13\ 1\85\16\86\ 1\16\ 1\16\ 1\16\ 1\84\16\ 2\ 1\84\ 2\ 5\84\ 2\16\16\ 2\ 2\ 1\ 1\13\85\ 1\ 2\84\16\13\16\16\ 2\16\v\90
" "\ 2
\83\ 1\ 2
-Â\84\v\1eÂ\86\13Â\85\16Â\85\13\13\16Â\84\13\16\16\13\16\16\13\16Â\87\13\16Â\9f\13\13\16\16\13\16\13\16Â\9f\13Â\8c" 19 19 "\ 2\16Â\88\13Â\84\16Â\94\13\13\16Â\87\ e\ f\16Ã\91\13\16Â\83" "\ 2\16Â\9b\13Â\99\16¨\13Â\86\16Â\92\1eÂ\8c" "\ 2\16§\1eÂ\99\16Â\8b\1eÂ\95\v " "\ 2\vÂ\9c\16Ã\8e\vÂ\96" 22 "\ 2\16·\13\16Â\89\13\16¶\13Â\88" "\ 2\16ï\13\16Â\90" 22 "\ 2\1e\16ç\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\vÂ\8a" "\ 2\vÂ\94\16¬\13Â\85\ e\ f\13Â\84\1e\13\1e\13Â\98\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\13Â\90" 22 22 19 "\ 2\13Â\83\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\13¿\ e\ f\ e\ f\13 \ e\ f\13\13" 19 19 "\ 2\16°\13Â\95\16\16\13Â\86\1eÂ\83\16Â\8a\1e¦" 30 "\ 2\ 1¯\1e\ 2¯\1e\ 1\ 2\ 1Â\83\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1Â\84\ 2\ 1\ 2\ 2\ 1\ 2Â\87\ 4\ 1\ 1" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\16Â\86\ 1\ 2\ 1\ 2\ 6Â\83\1eÂ\87\12Â\84\v\12\12" "\ 2\ 2¦\1eÂ\8a\ 5¶\1eÂ\89\ 4\12\1eÂ\8e\ 6" "\ 2\ 5Â\97\1eÂ\89\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 6 " "\ 2\12\12\10\11\10\11\12Â\83\10\11\12\10\11\12Â\89\r\12\12\r\12\10\11\12\12\10\11\ e\ f\ e\ f\ e\ f\ e\ f\12Â\85\ 4\12\12\1eÃ\8e" "\ 2\16\9a\1e\16Ù\1e\8c" 22 "\ 2\16Ö\1e\9a\16\8c\1e\84"] #^^[2 12288 "\ 2\17\12\83\16\ 4\ 5
+Â\84\v\1eÂ\86\13Â\85\16Â\85\13\13\16Â\84\13\16\16\13\16\16\13\16Â\87\13\16Â\9f\13\13\16\16\13\16\13\16Â\9f\13Â\8c" 19 19 "\ 2\16Â\88\13Â\84\16Â\94\13\13\16Â\87\ e\ f\16Ã\91\13\16Â\83" "\ 2\16Â\9b\13Â\99\16¨\13Â\86\16Â\92\1eÂ\8c" "\ 2\16§\1eÂ\99\16Â\8b\1eÂ\95\v " "\ 2\vÂ\9c\16Ã\8e\vÂ\96" 22 "\ 2\16·\13\16Â\89\13\16¶\13Â\88" "\ 2\16ï\13\16Â\90" 22 "\ 2\1e\16ç\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\vÂ\8a" "\ 2\vÂ\94\16¬\13Â\85\ e\ f\13Â\9f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\13Â\90" 22 22 19 "\ 2\13Â\83\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\13¿\ e\ f\ e\ f\13 \ e\ f\13\13" 19 19 "\ 2\16°\13Â\95\16\16\13Â\86\1eÂ\83\16Â\8a\1e¦" 30 "\ 2\ 1¯\1e\ 2¯\1e\ 1\ 2\ 1Â\83\ 2\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1Â\84\ 2\ 1\ 2\ 2\ 1\ 2Â\86\ 4\ 4\ 1\ 1" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 2\16Â\86\ 1\ 2\ 1\ 2\ 6Â\83\ 1\ 2\1eÂ\85\12Â\84\v\12\12" "\ 2\ 2¦\1e\ 2\1eÂ\85\ 2\1e\1e\ 5¸\1eÂ\87\ 4\12\1eÂ\8e\ 6" "\ 2\ 5Â\97\1eÂ\89\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 5Â\87\1e\ 6 " "\ 2\12\12\10\11\10\11\12Â\83\10\11\12\10\11\12Â\89\r\12\12\r\12\10\11\12\12\10\11\ e\ f\ e\ f\ e\ f\ e\ f\12Â\85\ 4\12Â\8a\r\r\1eÃ\84" "\ 2\16\9a\1e\16Ù\1e\8c" 22 "\ 2\16Ö\1e\9a\16\8c\1e\84"] #^^[2 12288 "\ 2\17\12\83\16\ 4\ 5
\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\16\16\ e\ f\ e\ f\ e\ f\ e\ f\r\ e\ f\ f\16
-Â\89\ 6Â\86\r\ 4\85\16\16
-Â\83\ 4\ 5\12\16\16\1e\ 5¿" "\ 2\ 5Â\97\1e\1e\ 6\ 6\15\15\ 4\ 4\ 5\r\ 5Ã\9a\12\ 4Â\83\ 5" "\ 2\1eÂ\85\ 5©\1eÂ\83\ 5Ã\8f" "\ 2\ 5Â\8f\1e\16\16\vÂ\84\16Â\8a\ 5Â\9b\1eÂ\85\16¤\1eÂ\8c\ 5Â\90" "\ 2\16Â\9f\1e\vÂ\8a\16§\v\8f\16 " "\ 2\v\8a\16§\v\8f\16¿\1e" 22 22 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] #^^[2 16384 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "\ 2\ 5¶\1e\8a\16À" 5 5 5 5] 5 5 5 5 #^^[2 36864 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
-#^^[3 40832 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[2 40960 "\ 2\ 5\95\ 4\ 5ê" 5 5 5 5 5 5 5 5 "\ 2\ 5\8d\1e\83\16·\1e\89\ 5¨\ 4\86\12\12" 5 5 "\ 2\ 5\8c\ 4\12\83\ 5\90 \8a\ 5\ 5\1e\94\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 5\ 6\b\83\12\1e\88\ 6\ 6\12\ 4" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\1e\88\ 5Æ
-\8a\ 6\ 6\12\86\1e\88" "\ 2\15\97\ 4\89\15\15\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\83\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 4\ 2\88\ 1\ 2\ 1\ 2\ 1\ 1\ 2" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 4\15\15\ 1\ 2\ 1\ 2\1e\ 1\ 2\1e\8e\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\1eÐ\ 2\ 5\85" "\ 2\ 5\ 5\ 6\ 5\83\ 6\ 5\84\ 6\ 5\97\a\a\ 6\ 6\a\16\84\1e\84\v\86\16\16\14\16\1e\86\ 5´\12\84\1e\88" "\ 2\a\a\ 5²\a\90\ 6\1e\89\12\12 \8a\1e\86\ 6\92\ 5\86\12\83\ 5\1e\84" "\ 2 \8a\ 5\9c\ 6\88\12\12\ 5\97\ 6\8b\a\a\1e\8b\12\ 5\9d\1e\83" "\ 2\ 6\83\a\ 5¯\ 6\a\a\ 6\84\a\a\ 6\a\84\12\8d\1e\ 4 \8a\1e\84\12\12\1e " "\ 2\ 5©\ 6\86\a\a\ 6\ 6\a\a\ 6\ 6\1e\89\ 5\83\ 6\ 5\88\ 6\a\1e\1e \8a\1e\1e\12\84\ 5\90\ 4\ 5\86\16\83\ 5\a\1e\84" "\ 2\ 5°\ 6\ 5\ 6\83\ 5\ 5\ 6\ 6\ 5\85\ 6\ 6\ 5\ 6\ 5\1e\98\ 5\ 5\ 4\12\12\1e " "\ 2\1e\ 5\86\1e\1e\ 5\86\1e\1e\ 5\86\1e\89\ 5\87\1e\ 5\87\1eÑ" "\ 2\1eÀ\ 5£\a\a\ 6\a\a\ 6\a\a\12\a\ 6\1e\1e \8a\1e\86" 5 5 5 5 5 5 5 5] 5 5 #^^[2 53248 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "\ 2\ 5¤\1e\8c\ 5\97\1e\84\ 5±\1e\84" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 29 #^^[2 61440 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 5 5 "\ 2\ 5®\1e\1e\ 5¾\1e\1e\ 5\90" "\ 2\ 5Ú\1e¦" "\ 2\ 2\87\1e\8c\ 2\85\1e\85\ 5\ 6\ 5\8a\13\ 5\8d\1e\ 5\85\1e\ 5\1e\ 5\ 5\1e\ 5\ 5\1e\ 5º" "\ 2\ 5²\15\90\1e\91\ 5" 5 5 "\ 2\ 5¾\ e\ f\1e\90\ 5°" "\ 2\ 5\90\1e\1e\ 5¶\1e¨\ 5\8c\14\16\1e\1e" "\ 2\ 6\90\12\87\ e\ f\12\1e\86\ 6\87\1e\89\12\r\r\f\f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\12\12\ e\ f\12\84\f\83\12\83\1e\12\84\r\ e\ f\ e\ f\ e\ f\12\83\13\r\13\83\1e\12\14\12\12\1e\84\ 5\85\1e\ 5\8a" "\ 2\ 5ý\1e\1e\e" "\ 2\1e\12\83\14\12\83\ e\ f\12\13\12\r\12\12 \8a\12\12\13\83\12\12\ 1\9a\ e\12\ f\15\f\15\ 2\9a\ e\13\ f\13\ e\ f\12\ e\ f\12\12\ 5\8a\ 4\ 5\8f" "\ 2\ 5\9e\ 4\ 4\ 5\9f\1e\83\ 5\86\1e\1e\ 5\86\1e\1e\ 5\86\1e\1e\ 5\83\1e\83\14\14\13\15\16\14\14\1e\16\13\84\16\16\1e\8a\e\83\16\16\1e\1e"]] #^^[1 65536 #^^[2 65536 "\ 2\ 5\8c\1e\ 5\9a\1e\ 5\93\1e\ 5\ 5\1e\ 5\8f\1e\1e\ 5\8e\1e¢" "\ 2\ 5û\1e\85" "\ 2\12\12\16\1e\84\v\1e\83\16\89
+Â\89\ 6Â\84\a\a\r\ 4\85\16\16
+Â\83\ 4\ 5\12\16\16\1e\ 5¿" "\ 2\ 5Â\97\1e\1e\ 6\ 6\15\15\ 4\ 4\ 5\r\ 5Ã\9a\12\ 4Â\83\ 5" "\ 2\1eÂ\85\ 5©\1eÂ\83\ 5Ã\8f" "\ 2\ 5Â\8f\1e\16\16\vÂ\84\16Â\8a\ 5Â\9b\1eÂ\85\16¤\1eÂ\8c\ 5Â\90" "\ 2\16Â\9f\1e\vÂ\8a\16Â\9e\vÂ\88\16\v\8f\16 " "\ 2\v\8a\16§\v\8f\16¿\1e" 22 22 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] #^^[2 16384 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "\ 2\ 5¶\1e\8a\16À" 5 5 5 5] 5 5 5 5 #^^[2 36864 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
+#^^[3 40832 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[2 40960 "\ 2\ 5\95\ 4\ 5ê" 5 5 5 5 5 5 5 5 "\ 2\ 5\8d\1e\83\16·\1e\89\ 5¨\ 4\86\12\12" 5 5 "\ 2\ 5\8c\ 4\12\83\ 5\90 \8a\ 5\ 5\1e\94\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 5\ 6\b\83\12\ 6\8a\12\ 4" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\1e\87\ 6\ 5Æ
+\8a\ 6\ 6\12\86\1e\88" "\ 2\15\97\ 4\89\15\15\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\83\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 4\ 2\88\ 1\ 2\ 1\ 2\ 1\ 1\ 2" "\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 4\15\15\ 1\ 2\ 1\ 2\1e\ 1\ 2\ 1\ 2\1e\8c\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\ 2\ 1\1eÍ\ 4\ 4\ 2\ 5\85" "\ 2\ 5\ 5\ 6\ 5\83\ 6\ 5\84\ 6\ 5\97\a\a\ 6\ 6\a\16\84\1e\84\v\86\16\16\14\16\1e\86\ 5´\12\84\1e\88" "\ 2\a\a\ 5²\a\90\ 6\1e\89\12\12 \8a\1e\86\ 6\92\ 5\86\12\83\ 5\1e\84" "\ 2 \8a\ 5\9c\ 6\88\12\12\ 5\97\ 6\8b\a\a\1e\8b\12\ 5\9d\1e\83" "\ 2\ 6\83\a\ 5¯\ 6\a\a\ 6\84\a\a\ 6\a\84\12\8d\1e\ 4 \8a\1e\84\12\12\1e " "\ 2\ 5©\ 6\86\a\a\ 6\ 6\a\a\ 6\ 6\1e\89\ 5\83\ 6\ 5\88\ 6\a\1e\1e \8a\1e\1e\12\84\ 5\90\ 4\ 5\86\16\83\ 5\a\1e\84" "\ 2\ 5°\ 6\ 5\ 6\83\ 5\ 5\ 6\ 6\ 5\85\ 6\ 6\ 5\ 6\ 5\1e\98\ 5\ 5\ 4\12\12\ 5\8b\a\ 6\ 6\a\a\12\12\ 5\ 4\ 4\a\ 6\1e\89" "\ 2\1e\ 5\86\1e\1e\ 5\86\1e\1e\ 5\86\1e\89\ 5\87\1e\ 5\87\1eÑ" "\ 2\1eÀ\ 5£\a\a\ 6\a\a\ 6\a\a\12\a\ 6\1e\1e \8a\1e\86" 5 5 5 5 5 5 5 5] 5 5 #^^[2 53248 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "\ 2\ 5¤\1e\8c\ 5\97\1e\84\ 5±\1e\84" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 29 #^^[2 61440 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 5 5 "\ 2\ 5î\1e\1e\ 5\90" "\ 2\ 5Ú\1e¦" "\ 2\ 2\87\1e\8c\ 2\85\1e\85\ 5\ 6\ 5\8a\13\ 5\8d\1e\ 5\85\1e\ 5\1e\ 5\ 5\1e\ 5\ 5\1e\ 5º" "\ 2\ 5²\15\90\1e\91\ 5" 5 5 "\ 2\ 5¾\ e\ f\1e\90\ 5°" "\ 2\ 5\90\1e\1e\ 5¶\1e¨\ 5\8c\14\16\1e\1e" "\ 2\ 6\90\12\87\ e\ f\12\1e\86\ 6\87\1e\89\12\r\r\f\f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\ e\ f\12\12\ e\ f\12\84\f\83\12\83\1e\12\84\r\ e\ f\ e\ f\ e\ f\12\83\13\r\13\83\1e\12\14\12\12\1e\84\ 5\85\1e\ 5\8a" "\ 2\ 5ý\1e\1e\e" "\ 2\1e\12\83\14\12\83\ e\ f\12\13\12\r\12\12 \8a\12\12\13\83\12\12\ 1\9a\ e\12\ f\15\f\15\ 2\9a\ e\13\ f\13\ e\ f\12\ e\ f\12\12\ 5\8a\ 4\ 5\8f" "\ 2\ 5\9e\ 4\ 4\ 5\9f\1e\83\ 5\86\1e\1e\ 5\86\1e\1e\ 5\86\1e\1e\ 5\83\1e\83\14\14\13\15\16\14\14\1e\16\13\84\16\16\1e\8a\e\83\16\16\1e\1e"]] #^^[1 65536 #^^[2 65536 "\ 2\ 5\8c\1e\ 5\9a\1e\ 5\93\1e\ 5\ 5\1e\ 5\8f\1e\1e\ 5\8e\1e¢" "\ 2\ 5û\1e\85" "\ 2\12\83\1e\84\v\1e\83\16\89
µ\v\84\16\87" "\ 2\16\8a\v\1e\85\16\8c\1e´\16\ 6\1e\1e" 30 "\ 2\ 5\9d\1e\83\ 5±\1e¯" "\ 2\ 5\9f\1e\v\84\1e\8c\ 5\91
\ 5\88
\1eµ" "\ 2\ 5\9e\1e\12\ 5¤\1e\84\ 5\88\12
-\85\1eª" "\ 2\ 1¨\ 2¨\ 5°" "\ 2\ 5\9e\1e\1e \8a\1eÖ" 30 30 30 30 30 30 "\ 2\ 5\86\1e\1e\ 5\1e\ 5¬\1e\ 5\ 5\1e\83\ 5\1e\1e\ 5\97\1e\12\v\88\1e " 30 "\ 2\ 5\96\v\86\1e\83\12\ 5\9a\1e\85\12\1eÀ" 30 "\ 2\ 5\ 6\83\1e\ 6\ 6\1e\85\ 6\84\ 5\84\1e\ 5\83\1e\ 5\9b\1e\84\ 6\83\1e\84\ 6\v\88\1e\88\12\89\1e\87\ 5\9d\v\v\12" 30 "\ 2\ 5¶\1e\83\12\87\ 5\96\1e\1e\v\88\ 5\93\1e\85\v\88" 30 "\ 2\ 5É\1e·" 30 30 30 "\ 2\1eà\v\9f\1e" 30 30 30] #^^[2 69632 "\ 2\a\ 6\a\ 5µ\ 6\8f\12\87\1e\84\v\94 \8a\1e\90" "\ 2\ 6\ 6\a\ 5\a\83\ 6\84\a\a\ 6\ 6\12\12\e\12\84\1e¾" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 73728 5 5 5 5 5 5 "\ 2\ 5ï\1e\91" 30 "\ 2
-ã\1e\8d\12\84\1e\8c" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 77824 5 5 5 5 5 5 5 5 "\ 2\ 5¯\1eÑ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 #^^[2 90112 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 "\ 2\ 5¹\1eÇ" 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 30 #^^[2 110592 "\ 2\ 5\ 5\1eþ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 #^^[2 118784 22 "\ 2\16ö\1e\8a" "\ 2\16§\1e\1e\16¼\a\a\ 6\83\16\83\a\86\e\88\ 6\85" "\ 2\ 6\83\16\16\ 6\87\16\9e\ 6\84\16°\1e¢" "\ 2\16Â\ 6\83\16\1eº" 30 "\ 2\16×\1e\89\v\92\1e\8e" 30 "\ 2\ 1\9a\ 2\9a\ 1\9a\ 2\87\1e\ 2\92\ 1\98" "\ 2\ 1\ 1\ 2\9a\ 1\1e\ 1\ 1\1e\1e\ 1\1e\1e\ 1\ 1\1e\1e\ 1\84\1e\ 1\88\ 2\84\1e\ 2\1e\ 2\87\1e\ 2\8b\ 1\9a\ 2\96" "\ 2\ 2\84\ 1\ 1\1e\ 1\84\1e\1e\ 1\88\1e\ 1\87\1e\ 2\9a\ 1\ 1\1e\ 1\84\1e\ 1\85\1e\ 1\1e\83\ 1\87\1e\ 2\9a\ 1\94" "\ 2\ 1\86\ 2\9a\ 1\9a\ 2\9a\ 1\9a\ 2\92" "\ 2\ 2\88\ 1\9a\ 2\9a\ 1\9a\ 2\9a\ 1\90" "\ 2\ 1\8a\ 2\9c\1e\1e\ 1\99\13\ 2\99\13\ 2\86\ 1\99\13\ 2\84" "\ 2\ 2\95\13\ 2\86\ 1\99\13\ 2\99\13\ 2\86\ 1\99\13\ 2\90" "\ 2\ 2\89\13\ 2\86\ 1\99\13\ 2\99\13\ 2\86\ 1\ 2\1e\1e ²" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 #^^[2 126976 "\ 2\16¬\1e\84\16Ð" "\ 2\16\94\1e\8c\16\8f\1e\1e\16\8e\1e\1e\16\8f\1e\16\8f\1e " "\ 2\v\8b\1e\85\16\9f\1e\16º\1e\86\16\90" "\ 2\16\9b\1eË\16\9a" "\ 2\16\83\1e\8d\16«\1e\85\16\89\1e\87\16\16\1e®" 30 "\ 2\16¡\1e\8f\16\86\1e\16Æ\1e\83" "\ 2\16\94\1e\8c\16¥\1e\16\85\1e\95\16\91\1e\8f" "\ 2\16¿\1e\16\1e\16¾" "\ 2\16ø\1e\16\84\1e\83" "\ 2\16¾\1e\92\16\98\1e\98" "\ 2\1eû\16\85" "\ 2\1e\16\90\1e\16\83\1e\16\1e\16\1e\16\1e\16\83\1e\16\86\1e\1e\16\84\1e\16\1e\1e\16\84\1e\16\8c\1e\84\16\8b\1e°" "\ 2\16Æ\1eº" "\ 2\16ô\1e\8c" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[1 131072 5 5 5 5 5 5 5 5 5 5 #^^[2 172032 5 5 5 5 5 5 5 5 5 5 5 5 5
+\85\1eª" "\ 2\ 1¨\ 2¨\ 5°" "\ 2\ 5\9e\1e\1e \8a\1eÖ" 30 30 30 30 30 30 "\ 2\ 5\86\1e\1e\ 5\1e\ 5¬\1e\ 5\ 5\1e\83\ 5\1e\1e\ 5\97\1e\12\v\88\1e " 30 "\ 2\ 5\96\v\86\1e\83\12\ 5\9a\1e\85\12\1eÀ" "\ 2\ 5¸\1e\86\ 5\ 5\1eÀ" "\ 2\ 5\ 6\83\1e\ 6\ 6\1e\85\ 6\84\ 5\84\1e\ 5\83\1e\ 5\9b\1e\84\ 6\83\1e\84\ 6\v\88\1e\88\12\89\1e\87\ 5\9d\v\v\12" 30 "\ 2\ 5¶\1e\83\12\87\ 5\96\1e\1e\v\88\ 5\93\1e\85\v\88" 30 "\ 2\ 5É\1e·" 30 30 30 "\ 2\1eà\v\9f\1e" 30 30 30] #^^[2 69632 "\ 2\a\ 6\a\ 5µ\ 6\8f\12\87\1e\84\v\94 \8a\1e\90" "\ 2\ 6\ 6\a\ 5\a\83\ 6\84\a\a\ 6\ 6\12\12\e\12\84\1e\8e\ 5\99\1e\87 \8a\1e\86" "\ 2\ 6\83\ 5¤\ 6\85\a\ 6\88\1e \8a\12\84\1e¼" "\ 2\ 6\ 6\a\ 5°\a\83\ 6\89\a\a\ 5\84\12\84\1e\87 \8a\1e¦" 30 30 30 30 30 30 30 30 30 "\ 2\ 5«\ 6\a\ 6\a\a\ 6\86\a\ 6\1e\88 \8a\1e¶" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 73728 5 5 5 5 5 5 "\ 2\ 5ï\1e\91" 30 "\ 2
+ã\1e\8d\12\84\1e\8c" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 77824 5 5 5 5 5 5 5 5 "\ 2\ 5¯\1eÑ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 #^^[2 90112 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 "\ 2\ 5¹\1eÇ" 30 30 30 30 30 30 30 30 30 "\ 2\ 5Å\1e\8b\ 5\a®\1e" "\ 2\1e\8f\ 6\84\ 4\8d\1eà"] 30 30 30 30 #^^[2 110592 "\ 2\ 5\ 5\1eþ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 #^^[2 118784 22 "\ 2\16ö\1e\8a" "\ 2\16§\1e\1e\16¼\a\a\ 6\83\16\83\a\86\e\88\ 6\85" "\ 2\ 6\83\16\16\ 6\87\16\9e\ 6\84\16°\1e¢" "\ 2\16Â\ 6\83\16\1eº" 30 "\ 2\16×\1e\89\v\92\1e\8e" 30 "\ 2\ 1\9a\ 2\9a\ 1\9a\ 2\87\1e\ 2\92\ 1\98" "\ 2\ 1\ 1\ 2\9a\ 1\1e\ 1\ 1\1e\1e\ 1\1e\1e\ 1\ 1\1e\1e\ 1\84\1e\ 1\88\ 2\84\1e\ 2\1e\ 2\87\1e\ 2\8b\ 1\9a\ 2\96" "\ 2\ 2\84\ 1\ 1\1e\ 1\84\1e\1e\ 1\88\1e\ 1\87\1e\ 2\9a\ 1\ 1\1e\ 1\84\1e\ 1\85\1e\ 1\1e\83\ 1\87\1e\ 2\9a\ 1\94" "\ 2\ 1\86\ 2\9a\ 1\9a\ 2\9a\ 1\9a\ 2\92" "\ 2\ 2\88\ 1\9a\ 2\9a\ 1\9a\ 2\9a\ 1\90" "\ 2\ 1\8a\ 2\9c\1e\1e\ 1\99\13\ 2\99\13\ 2\86\ 1\99\13\ 2\84" "\ 2\ 2\95\13\ 2\86\ 1\99\13\ 2\99\13\ 2\86\ 1\99\13\ 2\90" "\ 2\ 2\89\13\ 2\86\ 1\99\13\ 2\99\13\ 2\86\ 1\ 2\1e\1e ²" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 122880 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 "\ 2\ 5\84\1e\ 5\9b\1e\ 5\ 5\1e\ 5\1e\1e\ 5\1e\ 5\8a\1e\ 5\84\1e\ 5\1e\ 5\1e\86\ 5\1e\84\ 5\1e\ 5\1e\ 5\1e\ 5\83\1e\ 5\ 5\1e\ 5\1e\1e\ 5\1e\ 5\1e\ 5\1e\ 5\1e\ 5\1e\ 5\ 5\1e\ 5\1e\1e\ 5\84\1e\ 5\87\1e\ 5\84\1e\ 5\84\1e\ 5\1e" "\ 2\ 5\8a\1e\ 5\91\1e\85\ 5\83\1e\ 5\85\1e\ 5\91\1e´\13\13\1e\8e" 30 30] #^^[2 126976 "\ 2\16¬\1e\84\16Ð" "\ 2\16\94\1e\8c\16\8f\1e\1e\16\8e\1e\1e\16\8f\1e\16\8f\1e " "\ 2\v\8b\1e\85\16\9f\1e\16¼\1e\84\16\90" "\ 2\16\9b\1eË\16\9a" "\ 2\16\83\1e\8d\16«\1e\85\16\89\1e\87\16\16\1e®" 30 "\ 2\16¡\1e\8f\16\86\1e\16Æ\1e\83" "\ 2\16\94\1e\8c\16¥\1e\16\85\1e\95\16\91\1e\8f" "\ 2\16¿\1e\16\1e\16¾" "\ 2\16ø\1e\16\84\1e\83" "\ 2\16¾\1e\1e\16\84\1e\8c\16\98\1e\98" "\ 2\1eû\16\85" "\ 2\16Á\1e\84\16\8b\1e°" "\ 2\16Æ\1eº" "\ 2\16ô\1e\8c" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[1 131072 5 5 5 5 5 5 5 5 5 5 #^^[2 172032 5 5 5 5 5 5 5 5 5 5 5 5 5
#^^[3 173696 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] #^^[2 176128 5 5 5 5 5 5 5 5 5 5 5 5 5 5
#^^[3 177920 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] 5
#^^[3 178176 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 #^^[2 192512 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 "\ 2\ 5\9e\1eâ" 30 30 30 30 30 30 30 30 30 30 30]] 30 30 30 30 30 30 30 30 30 30 30 #^^[1 917504 #^^[2 917504 "\ 2\1e\e\1e\9e\eà" 30 6 "\ 2\ 6ð\1e\90" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[1 983040 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 #^^[2 1044480 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29
- \ 2\8d\ 1\90" 1 1 "\ 2\ 1\83\ 2\85\ 1ø" 1 "\ 2\ 1\91\ 4\ 2\84\ 4\ 2\83\v\ 4\ 2\86\ 4\86\ 2\ 2\ 4\ 2\ 2\v\f\ 2\r\ e\ f\10\11\12\13\14\15\16\16\17\18\19\ 1\1a\ 1\e\1c\ 1\ 2\ 4\ 1\15\ 1¸" "\ 2\ 1\90\ 2\88\1d\1e\1f\ 1° !\"\1d\1e\1f#$\ 2\ 2\ 4\ 4\ 2\85\ 4\ 2\ 2\ 4\ 1\90%\ 1\8f" "\ 2\ 1Ö\ 2\87\ 1\ 1\ 2\84\ 4\ 2\ 1\ 1\ 2\ 2\ 1\ 4\ 2\ 2\ 4\ 1\92" "\ 2\ 1\91&\ 1\9e\ 2\ 4\ 2\ 2\ 4\ 2\ 2\ 4\83\ 2\ 4\ 4\ 2\ 4\ 2\83\ 4\ 2\ 4\ 2\ 4\ 2\ 4\ 2\ 2\ 1µ" "\ 2\ 1ë\ 2\87\ 4\ 2\ 1\8c" "\ 2\ 1\96\ 2\84\ 1\ 2\89\ 1\ 2\83\ 1\ 2\85\ 1«\ 4\83\ 1¤" 1 "\ 2\ 1¼'\ 1\90(\ 1\83\ 2\ 4\ 2\ 2\ 1«" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1Í(\ 1²" "\ 2\ 1Í(\ 1\87)*\ 1©" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1Í(\ 1²" "\ 2\ 1Ê(\ 1µ" "\ 2\ 1¸++(\ 1\8d,\84\ 1´" "\ 2\ 1¸--\ 1\8e.\84\ 1´" "\ 2\ 1\98\ 4\ 4\ 1\9b\ 4\ 1\ 4\ 1\ 5\ 1·/0\ 11\ 1\850\84\ 1\ 1" "\ 20\ 1\ 2\ 2(\ 1\ 2\ 2\ 1¾\ 4\ 1¹"] #^^[2 4096 "\ 2\ 1·'\ 1((\ 1Å" "\ 2\ 1\8d\ 4\ 1ò" 1 1 1 1 "\ 2\ 1Ý\ 2\83\ 1 " 1 1 1 1 1 1 1 "\ 2\ 1\94(\ 1\9f(\ 1Ë" "\ 2\ 1Ò(\ 1\8a\ 2\ 1¢" 1 "\ 2\ 1©\f\ 1Ö" "\ 2\ 1¹\v\ 2\ 4\ 1Ä" 1 "\ 2\ 1\97\ 2\ 4\ 1Ç(\ 1\94\ 2\88\ 1\ 1\ 4" 1 "\ 2\ 1´'\ 1\8f(\ 1¦\ 2\ 4\ 2\87\ 1\8c" "\ 2\ 1ª(\ 1»'\ 1\8b((\ 1\8c" "\ 2\ 1·'\ 1È" "\ 2\ 1Ð\ 2\83\ 1\a\ 4\85\ 2\ 2\ 4\84\ 2\ 1\a\87\ 1\84\ 4\ 1\92" 1 "\ 2\ 1À\ 2\ 2\ 4\ 2\87\ 4\ 2\ 2
+ \ 2\8d\ 1\90" 1 1 "\ 2\ 1\83\ 2\85\ 1ø" 1 "\ 2\ 1\91\ 4\ 2\84\ 4\ 2\83\v\ 4\ 2\86\ 4\86\ 2\ 2\ 4\ 2\ 2\v\f\ 2\r\ e\ f\10\11\12\13\14\15\16\16\17\18\19\ 1\1a\ 1\e\1c\ 1\ 2\ 4\ 1\15\ 1¸" "\ 2\ 1\90\ 2\88\1d\1e\1f\ 1° !\"\1d\1e\1f#$\ 2\ 2\ 4\ 4\ 2\85\ 4\ 2\ 2\ 4\ 1\90%\ 1\8f" "\ 2\ 1Ö\ 2\87\ 1\ 1\ 2\84\ 4\ 2\ 1\ 1\ 2\ 2\ 1\ 4\ 2\ 2\ 4\ 1\92" "\ 2\ 1\91&\ 1\9e\ 2\ 4\ 2\ 2\ 4\ 2\ 2\ 4\83\ 2\ 4\ 4\ 2\ 4\ 2\83\ 4\ 2\ 4\ 2\ 4\ 2\ 4\ 2\ 2\ 1µ" "\ 2\ 1ë\ 2\87\ 4\ 2\ 1\8c" "\ 2\ 1\96\ 2\84\ 1\ 2\89\ 1\ 2\83\ 1\ 2\85\ 1«\ 4\83\ 1¤" "\ 2\ 1ä\ 2\ 2\ 4\ 2\ 2\ 4\ 2\83\ 4\83 !\"\ 2\83\ 4\ 2\ 2\ 4\ 4\ 2\84\ 1" "\ 2\ 1¼'\ 1\90(\ 1\83\ 2\ 4\ 2\ 2\ 1«" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1Í(\ 1²" "\ 2\ 1Í(\ 1\87)*\ 1©" "\ 2\ 1¼'\ 1\90(\ 1²" "\ 2\ 1Í(\ 1²" "\ 2\ 1Ê(\ 1µ" "\ 2\ 1¸++(\ 1\8d,\84\ 1´" "\ 2\ 1¸--\ 1\8e.\84\ 1´" "\ 2\ 1\98\ 4\ 4\ 1\9b\ 4\ 1\ 4\ 1\ 5\ 1·/0\ 11\ 1\850\84\ 1\ 1" "\ 20\ 1\ 2\ 2(\ 1\ 2\ 2\ 1¾\ 4\ 1¹"] #^^[2 4096 "\ 2\ 1·'\ 1((\ 1Å" "\ 2\ 1\8d\ 4\ 1ò" 1 1 1 1 "\ 2\ 1Ý\ 2\83\ 1 " 1 1 1 1 1 1 1 "\ 2\ 1\94(\ 1\9f(\ 1Ë" "\ 2\ 1Ò(\ 1\8a\ 2\ 1¢" 1 "\ 2\ 1©\f\ 1Ö" "\ 2\ 1¹\v\ 2\ 4\ 1Ä" 1 "\ 2\ 1\97\ 2\ 4\ 1Ç(\ 1\94\ 2\88\ 1\ 1\ 4" 1 "\ 2\ 1´'\ 1\8f(\ 1¦\ 2\ 4\ 2\87\ 1\8c" "\ 2\ 1ª((\ 1º'\ 1\8b((\ 1\8c" "\ 2\ 1·'\ 1È" "\ 2\ 1Ð\ 2\83\ 1\a\ 4\85\ 2\ 2\ 4\84\ 2\ 1\a\87\ 1\84\ 4\ 1\86\ 2\ 1\8b" 1 "\ 2\ 1À\ 2\ 2\ 4\ 2\87\ 4\ 2\ 2
2\ 4\ 6\ 2\96\ 1\95 \ 4\ 2\ 4" 1 1 1 1] #^^[2 8192 1 "\ 2\ 1Ð\ 2\ 2\a\a\ 2\84\a\83\ 2\ 2\ 1\84\ 2\ 1\83\a\a\ 2\ 4\ 2\a\a\ 4\84\ 2\ 1\8f" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1ï\ 2\83\ 1\8e" "\ 2\ 1ÿ(" "\ 2\ 1à\ 2 " 1 1 1 1] #^^[2 12288 "\ 2\ 1ª3\f\ 3\v44\ 1Ð" "\ 2\ 1\9955\ 1å" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 40832 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[2 40960 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1ï\ 2\ 1Â\8c\ 2\ 2\ 1\ 1" "\ 2\ 1ð\ 2\ 2\ 1Â\8e" 1 1 "\ 2\ 1Â\86(\ 1ù" "\ 2\ 1Ã\84(\ 1Â\9b\ 2Â\92\ 1Â\8e" "\ 2\ 1«\ 4Â\83\ 1Â¥(\ 1¬" "\ 2\ 1³'\ 1Â\8c(\ 1¿" 1 "\ 2\ 1°\ 2\ 1\ 2\ 2\ 4\ 1\ 1\ 2\ 2\ 1Â\85\ 2\ 2\ 1\ 2\ 1¾" 1 "\ 2\ 1Ã(\ 1Â\92" 1 1 1 1 1 1 1 1] 1 1 #^^[2 53248 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 61440 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1Â\9e6\ 1á" 1 1 1 1 1 "\ 2\ 1 \ 2Â\87\ 1Ã\99" 1 1 1]] #^^[1 65536 #^^[2 65536 1 1 1 "\ 2\ 1ý\ 4\ 1\ 1" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1Â\8d\ 4\ 1\ 2\ 1¨\ 2\a\ 4\ 1Â\84(\ 1Ã\80" 1 1 1 1 1 1 1 1 1 1 1] #^^[2 69632 "\ 2\ 1Ã\86(\ 1¹" "\ 2\ 1¹('\ 1Ã\85" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 73728 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 77824 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 #^^[2 90112 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 #^^[2 110592 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 118784 1 1 "\ 2\ 1Ã¥\ 5\ 5\aÂ\83\ 1Â\837\ 5Â\85\ 1Â\88\ 4Â\85" "\ 2\ 4Â\83\ 1\ 1\ 2Â\85\ 4\ 4\ 1Â\9e\ 2Â\84\ 1Ã\92" "\ 2\ 1Ã\82\ 2Â\83\ 1»" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 126976 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[1 131072 1 1 1 1 1 1 1 1 1 1 #^^[2 172032 1 1 1 1 1 1 1 1 1 1 1 1 1
+#^^[3 40832 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[2 40960 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1ï\ 2\ 1Â\84\ 2Â\8a\ 1\ 1" "\ 2\ 1Â\9f\ 2\ 1Ã\90\ 2\ 2\ 1Â\8e" 1 1 "\ 2\ 1Â\86(\ 1ù" "\ 2\ 1Ã\84(\ 1Â\9b\ 2Â\92\ 1Â\8e" "\ 2\ 1«\ 4Â\83\ 1Â¥(\ 1¬" "\ 2\ 1³'\ 1Â\8c(\ 1¿" 1 "\ 2\ 1°\ 2\ 1\ 2\ 2\ 4\ 1\ 1\ 2\ 2\ 1Â\85\ 2\ 2\ 1\ 2\ 1´(\ 1Â\89" 1 "\ 2\ 1Ã(\ 1Â\92" 1 1 1 1 1 1 1 1] 1 1 #^^[2 53248 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 61440 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1Â\9e6\ 1á" 1 1 1 1 1 "\ 2\ 1 \ 2Â\87\ 1Ã\99" 1 1 1]] #^^[1 65536 #^^[2 65536 1 1 1 "\ 2\ 1ý\ 4\ 1\ 1" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "\ 2\ 1Â\8d\ 4\ 1\ 2\ 1¨\ 2\a\ 4\ 1Â\84(\ 1Ã\80" 1 1 1 1 1 1 1 1 1 1 1] #^^[2 69632 "\ 2\ 1Ã\86(\ 1¹" "\ 2\ 1¹('\ 1Ã\85" "\ 2\ 2Â\83\ 1°((\ 1Ã\8b" "\ 2\ 1Ã\80(\ 1¿" 1 1 1 1 1 1 1 1 1 "\ 2\ 1¶('\ 1Ã\88" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 73728 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 77824 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 #^^[2 90112 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 #^^[2 110592 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 118784 1 1 "\ 2\ 1Ã¥\ 5\ 5\aÂ\83\ 1Â\837\ 5Â\85\ 1Â\88\ 4Â\85" "\ 2\ 4Â\83\ 1\ 1\ 2Â\85\ 4\ 4\ 1Â\9e\ 2Â\84\ 1Ã\92" "\ 2\ 1Ã\82\ 2Â\83\ 1»" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 122880 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 126976 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[1 131072 1 1 1 1 1 1 1 1 1 1 #^^[2 172032 1 1 1 1 1 1 1 1 1 1 1 1 1
#^^[3 173696 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 176128 1 1 1 1 1 1 1 1 1 1 1 1 1 1
#^^[3 177920 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1
#^^[3 178176 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 #^^[2 192512 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] 1 1 1 1 1 1 1 1 1 1 1 #^^[1 917504 #^^[2 917504 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[1 983040 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[2 1044480 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
;;; Code:
+(eval-when-compile (require 'cl-lib))
\f
;; Some additional options and constants.
(defcustom search-whitespace-regexp (purecopy "\\s-+")
"If non-nil, regular expression to match a sequence of whitespace chars.
-This applies to regular expression incremental search.
-When you put a space or spaces in the incremental regexp, it stands for
-this, unless it is inside of a regexp construct such as [...] or *, + or ?.
+When you enter a space or spaces in the incremental search, it
+will match any sequence matched by this regexp. As an exception,
+spaces are treated normally in regexp incremental search if they
+occur in a regexp construct like [...] or *, + or ?.
+
+If the value is a string, it applies to both ordinary and
+regexp incremental search. If the value is nil, or
+`isearch-lax-whitespace' is nil for ordinary incremental search, or
+`isearch-regexp-lax-whitespace' is nil for regexp incremental search,
+then each space you type matches literally, against one space.
+
You might want to use something like \"[ \\t\\r\\n]+\" instead.
In the Customization buffer, that is `[' followed by a space,
-a tab, a carriage return (control-M), a newline, and `]+'.
-
-When this is nil, each space you type matches literally, against one space."
- :type '(choice (const :tag "Find Spaces Literally" nil)
+a tab, a carriage return (control-M), a newline, and `]+'."
+ :type '(choice (const :tag "Match Spaces Literally" nil)
regexp)
- :group 'isearch)
+ :group 'isearch
+ :version "24.3")
(defcustom search-invisible 'open
"If t incremental search can match hidden text.
;; 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)
;; 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)
(define-key map "\M-r" 'isearch-toggle-regexp)
(define-key map "\M-e" 'isearch-edit-string)
+ (define-key map "\M-sc" 'isearch-toggle-case-fold)
(define-key map "\M-sr" 'isearch-toggle-regexp)
(define-key map "\M-sw" 'isearch-toggle-word)
+ (define-key map "\M-s_" 'isearch-toggle-symbol)
+ (define-key map "\M-s " 'isearch-toggle-lax-whitespace)
(define-key map [?\M-%] 'isearch-query-replace)
(define-key map [?\C-\M-%] 'isearch-query-replace-regexp)
(define-key map "\M-so" 'isearch-occur)
(define-key map "\M-shr" 'isearch-highlight-regexp)
+ ;; The key translations defined in the C-x 8 prefix should insert
+ ;; characters into the search string. See iso-transl.el.
+ (define-key map "\C-x" nil)
+ (define-key map [?\C-x t] 'isearch-other-control-char)
+ (define-key map "\C-x8" nil)
+ (define-key map "\C-x8\r" 'isearch-other-control-char)
+
map)
"Keymap for `isearch-mode'.")
(defvar isearch-forward nil) ; Searching in the forward direction.
(defvar isearch-regexp nil) ; Searching for a regexp.
-(defvar isearch-word nil) ; Searching for words.
-(defvar isearch-hidden nil) ; Non-nil if the string exists but is invisible.
+(defvar isearch-word nil
+ "Regexp-based search mode for words/symbols.
+If t, do incremental search for a sequence of words, ignoring punctuation.
+If the value is a function (e.g. `isearch-symbol-regexp'), it is called to
+convert the search string to a regexp used by regexp search functions.
+The property `isearch-message-prefix' put on this function specifies the
+prefix string displayed in the search message.")
+
+(defvar isearch-lax-whitespace t
+ "If non-nil, a space will match a sequence of whitespace chars.
+When you enter a space or spaces in ordinary incremental search, it
+will match any sequence matched by the regexp defined by the variable
+`search-whitespace-regexp'. If the value is nil, each space you type
+matches literally, against one space. You can toggle the value of this
+variable by the command `isearch-toggle-lax-whitespace'.")
+
+(defvar isearch-regexp-lax-whitespace nil
+ "If non-nil, a space will match a sequence of whitespace chars.
+When you enter a space or spaces in regexp incremental search, it
+will match any sequence matched by the regexp defined by the variable
+`search-whitespace-regexp'. If the value is nil, each space you type
+matches literally, against one space. You can toggle the value of this
+variable by the command `isearch-toggle-lax-whitespace'.")
(defvar isearch-cmds nil
"Stack of search status sets.
;; Accumulate here the overlays opened during searching.
(defvar isearch-opened-overlays nil)
+;; Non-nil if the string exists but is invisible.
+(defvar isearch-hidden nil)
+
;; The value of input-method-function when isearch is invoked.
(defvar isearch-input-method-function nil)
(define-key global-map "\C-r" 'isearch-backward)
(define-key esc-map "\C-r" 'isearch-backward-regexp)
(define-key search-map "w" 'isearch-forward-word)
+(define-key search-map "_" 'isearch-forward-symbol)
;; Entry points to isearch-mode.
Type \\[isearch-toggle-case-fold] to toggle search case-sensitivity.
Type \\[isearch-toggle-regexp] to toggle regular-expression mode.
Type \\[isearch-toggle-word] to toggle word mode.
+Type \\[isearch-toggle-symbol] to toggle symbol mode.
+
+Type \\[isearch-toggle-lax-whitespace] to toggle whitespace matching.
+In incremental searches, a space or spaces normally matches any whitespace
+defined by the variable `search-whitespace-regexp'; see also the variables
+`isearch-lax-whitespace' and `isearch-regexp-lax-whitespace'.
+
Type \\[isearch-edit-string] to edit the search string in the minibuffer.
Also supported is a search ring of the previous 16 search strings.
(isearch-mode t (not (null regexp-p)) nil (not no-recursive-edit)))
(defun isearch-forward-regexp (&optional not-regexp no-recursive-edit)
- "\
-Do incremental search forward for regular expression.
+ "Do incremental search forward for regular expression.
With a prefix argument, do a regular string search instead.
Like ordinary incremental search except that your input is treated
as a regexp. See the command `isearch-forward' for more information.
-In regexp incremental searches, a space or spaces normally matches
-any whitespace (the variable `search-whitespace-regexp' controls
-precisely what that means). If you want to search for a literal space
-and nothing else, enter C-q SPC."
+In incremental searches, a space or spaces normally matches any
+whitespace defined by the variable `search-whitespace-regexp'.
+To search for a literal space and nothing else, enter C-q SPC.
+To toggle whitespace matching, use `isearch-toggle-lax-whitespace'."
(interactive "P\np")
(isearch-mode t (null not-regexp) nil (not no-recursive-edit)))
(defun isearch-forward-word (&optional not-word no-recursive-edit)
- "\
-Do incremental search forward for a sequence of words.
+ "Do incremental search forward for a sequence of words.
With a prefix argument, do a regular string search instead.
Like ordinary incremental search except that your input is treated
as a sequence of words without regard to how the words are separated.
(interactive "P\np")
(isearch-mode t nil nil (not no-recursive-edit) (null not-word)))
+(defun isearch-forward-symbol (&optional not-symbol no-recursive-edit)
+ "Do incremental search forward for a symbol.
+The prefix argument is currently unused.
+Like ordinary incremental search except that your input is treated
+as a symbol surrounded by symbol boundary constructs \\_< and \\_>.
+See the command `isearch-forward' for more information."
+ (interactive "P\np")
+ (isearch-mode t nil nil (not no-recursive-edit) 'isearch-symbol-regexp))
+
(defun isearch-backward (&optional regexp-p no-recursive-edit)
- "\
-Do incremental search backward.
+ "Do incremental search backward.
With a prefix argument, do a regular expression search instead.
See the command `isearch-forward' for more information."
(interactive "P\np")
(isearch-mode nil (not (null regexp-p)) nil (not no-recursive-edit)))
(defun isearch-backward-regexp (&optional not-regexp no-recursive-edit)
- "\
-Do incremental search backward for regular expression.
+ "Do incremental search backward for regular expression.
With a prefix argument, do a regular string search instead.
Like ordinary incremental search except that your input is treated
as a regexp. See the command `isearch-forward' for more information."
;; "List of commands for which isearch-mode does not recursive-edit.")
-(defun isearch-mode (forward &optional regexp op-fun recursive-edit word-p)
+(defun isearch-mode (forward &optional regexp op-fun recursive-edit word)
"Start Isearch minor mode.
It is called by the function `isearch-forward' and other related functions."
;; Initialize global vars.
(setq isearch-forward forward
isearch-regexp regexp
- isearch-word word-p
+ isearch-word word
isearch-op-fun op-fun
isearch-last-case-fold-search isearch-case-fold-search
isearch-case-fold-search case-fold-search
(if (< isearch-other-end (point)) ; isearch-forward?
(isearch-highlight isearch-other-end (point))
(isearch-highlight (point) isearch-other-end))
- (isearch-dehighlight))
- ))
+ (isearch-dehighlight))))
(setq ;; quit-flag nil not for isearch-mode
isearch-adjusted nil
isearch-yank-flag nil)
(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.
\f
;; 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))
-
-(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))))
+(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--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))
\f
;; Commands active while inside of the isearch minor mode.
(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
(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
;; 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,
(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 "")
(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))
+(defun isearch-toggle-symbol ()
+ "Toggle symbol searching on or off."
+ (interactive)
+ (setq isearch-word (unless (eq isearch-word 'isearch-symbol-regexp)
+ 'isearch-symbol-regexp))
+ (if isearch-word (setq isearch-regexp nil))
+ (setq isearch-success t isearch-adjusted t)
+ (isearch-update))
+
+(defun isearch-toggle-lax-whitespace ()
+ "Toggle whitespace matching in searching on or off.
+In ordinary search, toggles the value of the variable
+`isearch-lax-whitespace'. In regexp search, toggles the
+value of the variable `isearch-regexp-lax-whitespace'."
+ (interactive)
+ (if isearch-regexp
+ (setq isearch-regexp-lax-whitespace (not isearch-regexp-lax-whitespace))
+ (setq isearch-lax-whitespace (not isearch-lax-whitespace)))
+ (let ((message-log-max nil))
+ (message "%s%s [%s]"
+ (isearch-message-prefix nil isearch-nonincremental)
+ isearch-message
+ (if (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ "match spaces loosely"
+ "match spaces literally")))
+ (setq isearch-success t isearch-adjusted t)
+ (sit-for 1)
+ (isearch-update))
+
(defun isearch-toggle-case-fold ()
"Toggle case folding in searching on or off."
(interactive)
(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)
(sit-for 1)
(isearch-update))
+\f
+;; Word search
+
+(defun word-search-regexp (string &optional lax)
+ "Return a regexp which matches words, ignoring punctuation.
+Given STRING, a string of words separated by word delimiters,
+compute a regexp that matches those exact words separated by
+arbitrary punctuation. If LAX is non-nil, the end of the string
+need not match a word boundary unless it ends in whitespace.
+
+Used in `word-search-forward', `word-search-backward',
+`word-search-forward-lax', `word-search-backward-lax'."
+ (if (string-match-p "^\\W*$" string)
+ ""
+ (concat
+ "\\b"
+ (mapconcat 'identity (split-string string "\\W+" t) "\\W+")
+ (if (or (not lax) (string-match-p "\\W$" string)) "\\b"))))
+
+(defun word-search-backward (string &optional bound noerror count)
+ "Search backward from point for STRING, ignoring differences in punctuation.
+Set point to the beginning of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend before that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+
+Relies on the function `word-search-regexp' to convert a sequence
+of words in STRING to a regexp used to search words without regard
+to punctuation."
+ (interactive "sWord search backward: ")
+ (re-search-backward (word-search-regexp string nil) bound noerror count))
+
+(defun word-search-forward (string &optional bound noerror count)
+ "Search forward from point for STRING, ignoring differences in punctuation.
+Set point to the end of the occurrence found, and return point.
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+
+Relies on the function `word-search-regexp' to convert a sequence
+of words in STRING to a regexp used to search words without regard
+to punctuation."
+ (interactive "sWord search: ")
+ (re-search-forward (word-search-regexp string nil) bound noerror count))
+
+(defun word-search-backward-lax (string &optional bound noerror count)
+ "Search backward from point for STRING, ignoring differences in punctuation.
+Set point to the beginning of the occurrence found, and return point.
+
+Unlike `word-search-backward', the end of STRING need not match a word
+boundary, unless STRING ends in whitespace.
+
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend before that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+
+Relies on the function `word-search-regexp' to convert a sequence
+of words in STRING to a regexp used to search words without regard
+to punctuation."
+ (interactive "sWord search backward: ")
+ (re-search-backward (word-search-regexp string t) bound noerror count))
+
+(defun word-search-forward-lax (string &optional bound noerror count)
+ "Search forward from point for STRING, ignoring differences in punctuation.
+Set point to the end of the occurrence found, and return point.
+
+Unlike `word-search-forward', the end of STRING need not match a word
+boundary, unless STRING ends in whitespace.
+
+An optional second argument bounds the search; it is a buffer position.
+The match found must not extend after that position.
+Optional third argument, if t, means if fail just return nil (no error).
+ If not nil and not t, move to limit of search and return nil.
+Optional fourth argument is repeat count--search for successive occurrences.
+
+Relies on the function `word-search-regexp' to convert a sequence
+of words in STRING to a regexp used to search words without regard
+to punctuation."
+ (interactive "sWord search: ")
+ (re-search-forward (word-search-regexp string t) bound noerror count))
+
+;; Symbol search
+
+(defun isearch-symbol-regexp (string &optional lax)
+ "Return a regexp which matches STRING as a symbol.
+Creates a regexp where STRING is surrounded by symbol delimiters \\_< and \\_>.
+If LAX is non-nil, the end of the string need not match a symbol boundary."
+ (concat "\\_<" (regexp-quote string) (unless lax "\\_>")))
+
+(put 'isearch-symbol-regexp 'isearch-message-prefix "symbol ")
+
+;; Search with lax whitespace
+
+(defun search-forward-lax-whitespace (string &optional bound noerror count)
+ "Search forward for STRING, matching a sequence of whitespace chars."
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (re-search-forward (regexp-quote string) bound noerror count)))
+
+(defun search-backward-lax-whitespace (string &optional bound noerror count)
+ "Search backward for STRING, matching a sequence of whitespace chars."
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (re-search-backward (regexp-quote string) bound noerror count)))
+
+(defun re-search-forward-lax-whitespace (regexp &optional bound noerror count)
+ "Search forward for REGEXP, matching a sequence of whitespace chars."
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (re-search-forward regexp bound noerror count)))
+
+(defun re-search-backward-lax-whitespace (regexp &optional bound noerror count)
+ "Search backward for REGEXP, matching a sequence of whitespace chars."
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (re-search-backward regexp bound noerror count)))
+
+\f
(defun isearch-query-replace (&optional delimited regexp-flag)
"Start `query-replace' with string to replace from last search string.
The arg DELIMITED (prefix arg if interactive), if non-nil, means replace
;; set `search-upper-case' to nil to not call
;; `isearch-no-upper-case-p' in `perform-replace'
(search-upper-case nil)
+ (replace-lax-whitespace
+ isearch-lax-whitespace)
+ (replace-regexp-lax-whitespace
+ isearch-regexp-lax-whitespace)
;; Set `isearch-recursive-edit' to nil to prevent calling
;; `exit-recursive-edit' in `isearch-done' that terminates
;; the execution of this command when it is non-nil.
(interactive
(let* ((perform-collect (consp current-prefix-arg))
(regexp (cond
+ ((functionp isearch-word)
+ (funcall isearch-word isearch-string))
(isearch-word (word-search-regexp isearch-string))
(isearch-regexp isearch-string)
(t (regexp-quote isearch-string)))))
(isearch-done nil t)
(isearch-clean-overlays)
(let ((default (car occur-collect-regexp-history)))
- (read-string
+ (read-regexp
(format "Regexp to collect (default %s): " default)
- nil 'occur-collect-regexp-history default)))
+ default 'occur-collect-regexp-history)))
;; Otherwise normal occur takes numerical prefix argument.
(when current-prefix-arg
(prefix-numeric-value current-prefix-arg))))))
;; Set `search-upper-case' to nil to not call
;; `isearch-no-upper-case-p' in `occur-1'.
(search-upper-case nil)
- (search-spaces-regexp (if isearch-regexp search-whitespace-regexp)))
+ (search-spaces-regexp
+ (if (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ search-whitespace-regexp)))
(occur regexp nlines)))
(declare-function hi-lock-read-face-name "hi-lock" ())
(setq case-fold-search
(isearch-no-upper-case-p isearch-string isearch-regexp)))
(looking-at (cond
+ ((functionp isearch-word)
+ (funcall isearch-word isearch-string t))
(isearch-word (word-search-regexp isearch-string t))
(isearch-regexp isearch-string)
(t (regexp-quote isearch-string)))))
;; 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)
;; 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
;; 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)))
;; 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)
;; Assume character codes 0200 - 0377 stand for characters in some
;; single-byte character set, and convert them to Emacs
;; characters.
- (if (and isearch-regexp (= char ?\s))
+ (if (and isearch-regexp isearch-regexp-lax-whitespace (= char ?\s))
(if (subregexp-context-p isearch-string (length isearch-string))
(isearch-process-search-string "[ ]" " ")
(isearch-process-search-char char))
(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.
(< (point) isearch-opoint)))
"over")
(if isearch-wrapped "wrapped ")
- (if isearch-word "word " "")
+ (if isearch-word
+ (or (and (symbolp isearch-word)
+ (get isearch-word 'isearch-message-prefix))
+ "word ")
+ "")
(if isearch-regexp "regexp " "")
(if multi-isearch-next-buffer-current-function "multi " "")
(or isearch-message-prefix-add "")
(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 "]")
\f
;; Searching
-(defvar isearch-search-fun-function nil
- "Overrides the default `isearch-search-fun' behavior.
+(defvar isearch-search-fun-function 'isearch-search-fun-default
+ "Non-default value overrides the behavior of `isearch-search-fun-default'.
This variable's value should be a function, which will be called
with no arguments, and should return a function that takes three
arguments: STRING, BOUND, and NOERROR.
(defun isearch-search-fun ()
"Return the function to use for the search.
Can be changed via `isearch-search-fun-function' for special needs."
- (if isearch-search-fun-function
- (funcall isearch-search-fun-function)
- (cond
- (isearch-word
+ (funcall (or isearch-search-fun-function 'isearch-search-fun-default)))
+
+(defun isearch-search-fun-default ()
+ "Return default functions to use for the search."
+ (cond
+ (isearch-word
+ (lambda (string &optional bound noerror count)
;; Use lax versions to not fail at the end of the word while
;; the user adds and removes characters in the search string
;; (or when using nonincremental word isearch)
- (if (or isearch-nonincremental
- (eq (length isearch-string)
- (length (isearch-string-state (car isearch-cmds)))))
- (if isearch-forward 'word-search-forward 'word-search-backward)
- (if isearch-forward 'word-search-forward-lax 'word-search-backward-lax)))
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward)))))
+ (let ((lax (not (or isearch-nonincremental
+ (eq (length isearch-string)
+ (length (isearch--state-string
+ (car isearch-cmds))))))))
+ (funcall
+ (if isearch-forward #'re-search-forward #'re-search-backward)
+ (if (functionp isearch-word)
+ (funcall isearch-word string lax)
+ (word-search-regexp string lax))
+ bound noerror count))))
+ ((and isearch-regexp isearch-regexp-lax-whitespace
+ search-whitespace-regexp)
+ (if isearch-forward
+ 're-search-forward-lax-whitespace
+ 're-search-backward-lax-whitespace))
+ (isearch-regexp
+ (if isearch-forward 're-search-forward 're-search-backward))
+ ((and isearch-lax-whitespace search-whitespace-regexp)
+ (if isearch-forward
+ 'search-forward-lax-whitespace
+ 'search-backward-lax-whitespace))
+ (t
+ (if isearch-forward 'search-forward 'search-backward))))
(defun isearch-search-string (string bound noerror)
"Search for the first occurrence of STRING or its translation.
(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)
(case-fold-search isearch-case-fold-search)
- (search-spaces-regexp search-whitespace-regexp)
(retry t))
(setq isearch-error nil)
(while retry
(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.
(defvar isearch-lazy-highlight-window-end nil)
(defvar isearch-lazy-highlight-case-fold-search nil)
(defvar isearch-lazy-highlight-regexp nil)
-(defvar isearch-lazy-highlight-space-regexp nil)
+(defvar isearch-lazy-highlight-lax-whitespace nil)
+(defvar isearch-lazy-highlight-regexp-lax-whitespace nil)
(defvar isearch-lazy-highlight-word nil)
(defvar isearch-lazy-highlight-forward nil)
(defvar isearch-lazy-highlight-error nil)
isearch-regexp))
(not (eq isearch-lazy-highlight-word
isearch-word))
+ (not (eq isearch-lazy-highlight-lax-whitespace
+ isearch-lax-whitespace))
+ (not (eq isearch-lazy-highlight-regexp-lax-whitespace
+ isearch-regexp-lax-whitespace))
(not (= (window-start)
isearch-lazy-highlight-window-start))
(not (= (window-end) ; Window may have been split/joined.
isearch-lazy-highlight-last-string isearch-string
isearch-lazy-highlight-case-fold-search isearch-case-fold-search
isearch-lazy-highlight-regexp isearch-regexp
- isearch-lazy-highlight-space-regexp search-whitespace-regexp
+ isearch-lazy-highlight-lax-whitespace isearch-lax-whitespace
+ isearch-lazy-highlight-regexp-lax-whitespace isearch-regexp-lax-whitespace
isearch-lazy-highlight-word isearch-word
isearch-lazy-highlight-forward isearch-forward)
(unless (equal isearch-string "")
(condition-case nil
(let ((case-fold-search isearch-lazy-highlight-case-fold-search)
(isearch-regexp isearch-lazy-highlight-regexp)
- (search-spaces-regexp isearch-lazy-highlight-space-regexp)
(isearch-word isearch-lazy-highlight-word)
+ (isearch-lax-whitespace
+ isearch-lazy-highlight-lax-whitespace)
+ (isearch-regexp-lax-whitespace
+ isearch-lazy-highlight-regexp-lax-whitespace)
+ (isearch-forward isearch-lazy-highlight-forward)
(search-invisible nil) ; don't match invisible text
(retry t)
(success nil)
- (isearch-forward isearch-lazy-highlight-forward)
(bound (if isearch-lazy-highlight-forward
(min (or isearch-lazy-highlight-end-limit (point-max))
(if isearch-lazy-highlight-wrapped
;;; TODO
-;;; Acknowledgements
+;;; Acknowledgments
;; Thanks to Jari Aalto <jari.aalto@poboxes.com> for help with the
;; first version of this package, iswitch-buffer. Thanks also to many
:type 'string
:group 'iswitchb)
-(defvar iswitchb-all-frames 'visible
- "*Argument to pass to `walk-windows' when finding visible buffers.
-See documentation of `walk-windows' for useful values.")
+(defcustom iswitchb-all-frames 'visible
+ "Argument to pass to `walk-windows' when iswitchb is finding buffers.
+See documentation of `walk-windows' for useful values."
+ :type '(choice (const :tag "Selected frame only" nil)
+ (const :tag "All existing frames" t)
+ (const :tag "All visible frames" visible)
+ (const :tag "All frames on this terminal" 0))
+ :group 'iswitchb)
(defcustom iswitchb-minibuffer-setup-hook nil
"Iswitchb-specific customization of minibuffer setup.
;;; FUNCTIONS
-;;; ISWITCHB KEYMAP
-(defun iswitchb-define-mode-map ()
- "Set up the keymap for `iswitchb-buffer'."
- (interactive)
- (let (map)
- ;; generated every time so that it can inherit new functions.
- ;;(or iswitchb-mode-map
-
- (setq map (copy-keymap minibuffer-local-map))
- (define-key map "?" 'iswitchb-completion-help)
- (define-key map "\C-s" 'iswitchb-next-match)
- (define-key map "\C-r" 'iswitchb-prev-match)
- (define-key map "\t" 'iswitchb-complete)
- (define-key map "\C-j" 'iswitchb-select-buffer-text)
- (define-key map "\C-t" 'iswitchb-toggle-regexp)
- (define-key map "\C-x\C-f" 'iswitchb-find-file)
- (define-key map "\C-n" 'iswitchb-toggle-ignore)
- (define-key map "\C-c" 'iswitchb-toggle-case)
- (define-key map "\C-k" 'iswitchb-kill-buffer)
- (define-key map "\C-m" 'iswitchb-exit-minibuffer)
- (setq iswitchb-mode-map map)
- (run-hooks 'iswitchb-define-mode-map-hook)))
-
-(make-obsolete 'iswitchb-define-mode-map
- "use M-x iswitchb-mode or customize the variable `iswitchb-mode'."
- "21.1")
-
;;; MAIN FUNCTION
(defun iswitchb ()
"Switch to buffer matching a substring.
string.
If MATCHES-SET is non-nil, the buflist is not updated before
the selection process begins. Used by isearchb.el."
- (let
- (
- buf-sel
- iswitchb-final-text
- (icomplete-mode nil) ;; prevent icomplete starting up
- )
-
- (iswitchb-define-mode-map)
+ ;; The map is generated every time so that it can inherit new
+ ;; functions.
+ (let ((map (copy-keymap minibuffer-local-map))
+ buf-sel iswitchb-final-text map
+ icomplete-mode) ; prevent icomplete starting up
+ (define-key map "?" 'iswitchb-completion-help)
+ (define-key map "\C-s" 'iswitchb-next-match)
+ (define-key map "\C-r" 'iswitchb-prev-match)
+ (define-key map "\t" 'iswitchb-complete)
+ (define-key map "\C-j" 'iswitchb-select-buffer-text)
+ (define-key map "\C-t" 'iswitchb-toggle-regexp)
+ (define-key map "\C-x\C-f" 'iswitchb-find-file)
+ (define-key map "\C-n" 'iswitchb-toggle-ignore)
+ (define-key map "\C-c" 'iswitchb-toggle-case)
+ (define-key map "\C-k" 'iswitchb-kill-buffer)
+ (define-key map "\C-m" 'iswitchb-exit-minibuffer)
+ (setq iswitchb-mode-map map)
+ (run-hooks 'iswitchb-define-mode-map-hook)
+
(setq iswitchb-exit nil)
(setq iswitchb-default
(if (bufferp default)
(eval-when-compile
- (require 'cl)
-
(defmacro with-buffer-prepared-for-jit-lock (&rest body)
"Execute BODY in current buffer, overriding several variables.
Preserves the `buffer-modified-p' state of the current buffer."
(put 'json-string-format 'error-conditions
'(json-string-format json-error error))
+(put 'json-key-format 'error-message "Bad JSON object key")
+(put 'json-key-format 'error-conditions
+ '(json-key-format json-error error))
+
(put 'json-object-format 'error-message "Bad JSON object")
(put 'json-object-format 'error-conditions
'(json-object-format json-error error))
(setq char (json-encode-char0 char 'ucs))
(let ((control-char (car (rassoc char json-special-chars))))
(cond
- ;; Special JSON character (\n, \r, etc.)
+ ;; Special JSON character (\n, \r, etc.).
(control-char
(format "\\%c" control-char))
- ;; ASCIIish printable character
- ((and (> char 31) (< char 161))
+ ;; ASCIIish printable character.
+ ((and (> char 31) (< char 127))
(format "%c" char))
- ;; Fallback: UCS code point in \uNNNN form
+ ;; Fallback: UCS code point in \uNNNN form.
(t
(format "\\u%04x" char)))))
"Return a JSON representation of STRING."
(format "\"%s\"" (mapconcat 'json-encode-char string "")))
+(defun json-encode-key (object)
+ "Return a JSON representation of OBJECT.
+If the resulting JSON object isn't a valid JSON object key,
+this signals `json-key-format'."
+ (let ((encoded (json-encode object)))
+ (unless (stringp (json-read-from-string encoded))
+ (signal 'json-key-format (list object)))
+ encoded))
+
;;; JSON Objects
(defun json-new-object ()
(maphash
(lambda (k v)
(push (format "%s:%s"
- (json-encode k)
+ (json-encode-key k)
(json-encode v))
r))
hash-table)
(format "{%s}"
(json-join (mapcar (lambda (cons)
(format "%s:%s"
- (json-encode (car cons))
+ (json-encode-key (car cons))
(json-encode (cdr cons))))
alist)
", ")))
"Return a JSON representation of PLIST."
(let (result)
(while plist
- (push (concat (json-encode (car plist))
+ (push (concat (json-encode-key (car plist))
":"
(json-encode (cadr plist)))
result)
;;; Keyboard macro counter
(defvar kmacro-counter 0
- "*Current keyboard macro counter.")
+ "Current keyboard macro counter.")
(defvar kmacro-default-counter-format "%d")
(defvar kmacro-counter-format "%d"
- "*Current keyboard macro counter format.")
+ "Current keyboard macro counter format.")
(defvar kmacro-counter-format-start kmacro-counter-format
"Macro format at start of macro execution.")
To make a macro permanent so you can call it even after defining
others, use \\[kmacro-name-last-macro]."
(interactive "p")
- (let ((repeat-key (and (null no-repeat)
- (> (length (this-single-command-keys)) 1)
- last-input-event))
- repeat-key-str)
+ (let ((repeat-key (and (or (and (null no-repeat)
+ (> (length (this-single-command-keys)) 1))
+ ;; Used when we're in the process of repeating.
+ (eq no-repeat 'repeating))
+ last-input-event)))
(if end-macro
(kmacro-end-macro arg)
(call-last-kbd-macro arg #'kmacro-loop-setup-function))
(if (eq kmacro-call-repeat-key t)
repeat-key
kmacro-call-repeat-key)))
- (setq repeat-key-str (format-kbd-macro (vector repeat-key) nil))
- (while repeat-key
- ;; Issue a hint to the user, if the echo area isn't in use.
- (unless (current-message)
- (message "(Type %s to repeat macro%s)"
- repeat-key-str
- (if (and kmacro-call-repeat-with-arg
- arg (> arg 1))
- (format " %d times" arg) "")))
- (if (equal repeat-key (read-event))
- (progn
- (clear-this-command-keys t)
- (call-last-kbd-macro (and kmacro-call-repeat-with-arg arg)
- #'kmacro-loop-setup-function)
- (setq last-input-event nil))
- (setq repeat-key nil)))
- (when last-input-event
- (clear-this-command-keys t)
- (setq unread-command-events (list last-input-event))))))
+ ;; Issue a hint to the user, if the echo area isn't in use.
+ (unless (current-message)
+ (message "(Type %s to repeat macro%s)"
+ (format-kbd-macro (vector repeat-key) nil)
+ (if (and kmacro-call-repeat-with-arg
+ arg (> arg 1))
+ (format " %d times" arg) "")))
+ ;; Can't use the `keep-pred' arg because this overlay keymap needs to be
+ ;; removed during the next run of the kmacro (i.e. we need to add&remove
+ ;; this overlay-map at each repetition).
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (vector repeat-key)
+ `(lambda () (interactive)
+ (kmacro-call-macro ,(and kmacro-call-repeat-with-arg arg)
+ 'repeating)))
+ map)))))
;;; Combined function key bindings:
-;;; burmese.el --- support for Burmese -*- coding: utf-8; no-byte-compile: t -*-
+;;; burmese.el --- support for Burmese -*- coding: utf-8 -*-
;; Copyright (C) 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
-;;; cham.el --- support for Cham -*- coding: utf-8; no-byte-compile: t -*-
+;;; cham.el --- support for Cham -*- coding: utf-8 -*-
;; Copyright (C) 2008, 2009, 2010, 2011, 2012
;; National Institute of Advanced Industrial Science and Technology (AIST)
(use-cjk-char-width-table 'zh_CN)))
(exit-function . use-default-char-width-table)
(coding-system chinese-iso-8bit iso-2022-cn chinese-hz)
- (coding-priority chinese-iso-8bit chinese-big5 iso-2022-cn)
+ (coding-priority chinese-iso-8bit chinese-gbk chinese-big5
+ iso-2022-cn)
(input-method . "chinese-py-punct")
(features china-util)
(sample-text . "Chinese (\e$AVPND\e(B,\e$AFUM(;0\e(B,\e$A::So\e(B) \e$ADc:C\e(B")
(use-cjk-char-width-table 'zh_HK)))
(exit-function . use-default-char-width-table)
(coding-system chinese-big5 chinese-iso-7bit)
- (coding-priority chinese-big5 iso-2022-cn chinese-iso-8bit)
+ (coding-priority chinese-big5 iso-2022-cn chinese-iso-8bit
+ chinese-gbk)
(input-method . "chinese-py-punct-b5")
(ctext-non-standard-encodings "big5-0")
(features china-util)
(exit-function . use-default-char-width-table)
(coding-system iso-2022-cn euc-tw)
(coding-priority iso-2022-cn euc-tw chinese-big5
- chinese-iso-8bit)
+ chinese-iso-8bit chinese-gbk)
(features china-util)
(input-method . "chinese-cns-quick")
;; Fixme: presumably it won't accept big5 now.
(exit-function . use-default-char-width-table)
(coding-system euc-tw iso-2022-cn)
(coding-priority euc-tw chinese-big5 iso-2022-cn
- chinese-iso-8bit)
+ chinese-iso-8bit chinese-gbk)
(features china-util)
(input-method . "chinese-cns-quick")
(documentation . "\
-;;; czech.el --- support for Czech -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; czech.el --- support for Czech -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Maintainer: Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-;;; english.el --- support for English -*- no-byte-compile: t -*-
+;;; english.el --- support for English
-;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;;
(defvar ethio-primary-language 'tigrigna
- "*Symbol that defines the primary language in SERA --> FIDEL conversion.
+ "Symbol that defines the primary language in SERA --> FIDEL conversion.
The value should be one of: `tigrigna', `amharic' or `english'.")
(defvar ethio-secondary-language 'english
- "*Symbol that defines the secondary language in SERA --> FIDEL conversion.
+ "Symbol that defines the secondary language in SERA --> FIDEL conversion.
The value should be one of: `tigrigna', `amharic' or `english'.")
(defvar ethio-use-colon-for-colon nil
- "*Non-nil means associate ASCII colon with Ethiopic colon.
+ "Non-nil means associate ASCII colon with Ethiopic colon.
If nil, associate ASCII colon with Ethiopic word separator, i.e., two
vertically stacked dots. All SERA <--> FIDEL converters refer this
variable.")
(defvar ethio-use-three-dot-question nil
- "*Non-nil means associate ASCII question mark with Ethiopic old style question mark (three vertically stacked dots).
+ "Non-nil means associate ASCII question mark with Ethiopic old style question mark (three vertically stacked dots).
If nil, associate ASCII question mark with Ethiopic stylized question
mark. All SERA <--> FIDEL converters refer this variable.")
(defvar ethio-quote-vowel-always nil
- "*Non-nil means always put an apostrophe before an isolated vowel (except at word initial) in FIDEL --> SERA conversion.
+ "Non-nil means always put an apostrophe before an isolated vowel (except at word initial) in FIDEL --> SERA conversion.
If nil, put an apostrophe only between a 6th-form consonant and an
isolated vowel.")
(defvar ethio-W-sixth-always nil
- "*Non-nil means convert the Wu-form of a 12-form consonant to \"W'\" instead of \"Wu\" in FIDEL --> SERA conversion.")
+ "Non-nil means convert the Wu-form of a 12-form consonant to \"W'\" instead of \"Wu\" in FIDEL --> SERA conversion.")
(defvar ethio-numeric-reduction 0
- "*Degree of reduction in converting Ethiopic digits into Arabic digits.
+ "Degree of reduction in converting Ethiopic digits into Arabic digits.
Should be 0, 1 or 2.
For example, ({10}{9}{100}{80}{7}) is converted into:
`10`9`100`80`7 if `ethio-numeric-reduction' is 0,
`10900807 if `ethio-numeric-reduction' is 2.")
(defvar ethio-java-save-lowercase nil
- "*Non-nil means save Ethiopic characters in lowercase hex numbers to Java files.
+ "Non-nil means save Ethiopic characters in lowercase hex numbers to Java files.
If nil, use uppercases.")
(defun ethio-prefer-amharic-p ()
:mime-charset 'windows-1257)
(define-coding-system-alias 'cp1257 'windows-1257)
+(define-coding-system 'cp775
+ "DOS codepage 775 (PC Baltic, MS-DOS Baltic Rim)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp775)
+ :mime-charset 'cp775)
+(define-coding-system-alias 'ibm775 'cp775)
+
(define-coding-system 'cp850
"DOS codepage 850 (Western European)"
:coding-type 'charset
-;;; georgian.el --- language support for Georgian -*- no-byte-compile: t -*-
+;;; georgian.el --- language support for Georgian
-;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
-;;; greek.el --- support for Greek -*- no-byte-compile: t -*-
+;;; greek.el --- support for Greek
;; Copyright (C) 2002 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;; japanese.el --- support for Japanese -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; japanese.el --- support for Japanese -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
-;;; khmer.el --- support for Khmer -*- coding: utf-8; no-byte-compile: t -*-
+;;; khmer.el --- support for Khmer -*- coding: utf-8 -*-
;; Copyright (C) 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
(purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
"3"
""))
- "*The kind of Korean keyboard for Korean input method.
+ "The kind of Korean keyboard for Korean input method.
\"\" for 2, \"3\" for 3.")
;; functions useful for Korean text input
"Turn on or off a Korean text input method for the current buffer."
(interactive)
(if current-input-method
- (inactivate-input-method)
+ (deactivate-input-method)
(activate-input-method
(concat "korean-hangul" default-korean-keyboard))))
-;;; korean.el --- support for Korean -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; korean.el --- support for Korean -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
-;;; lao.el --- support for Lao -*- coding: utf-8; no-byte-compile: t -*-
+;;; lao.el --- support for Lao -*- coding: utf-8 -*-
-;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
-;;; misc-lang.el --- support for miscellaneous languages (characters) -*- no-byte-compile: t -*-
+;;; misc-lang.el --- support for miscellaneous languages (characters)
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
(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)
-;;; romanian.el --- support for Romanian -*- coding: iso-latin-2; no-byte-compile: t -*-
+;;; romanian.el --- support for Romanian -*- coding: iso-latin-2 -*-
-;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <done@ece.arizona.edu>
;; Keywords: multilingual, Romanian, i18n
-;;; sinhala.el --- support for Sinhala -*- coding: utf-8; no-byte-compile: t -*-
+;;; sinhala.el --- support for Sinhala -*- coding: utf-8 -*-
;; Copyright (C) 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
-;;; slovak.el --- support for Slovak -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; slovak.el --- support for Slovak -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; Authors: Tibor \e,B)\e(Bimko <tibor.simko@fmph.uniba.sk>,
;; Milan Zamazal <pdm@zamazal.org>
-;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8; no-byte-compile: t -*-
+;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8 -*-
-;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
-;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+;;; thai.el --- support for Thai -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
))))
(defvar tibetan-strict-unicode t
- "*Flag to control Tibetan canonicalizing for Unicode.
+ "Flag to control Tibetan canonicalizing for Unicode.
If non-nil, the vowel a is removed and composite vowels are decomposed
before writing buffer in Unicode. See also
-;;; utf-8-lang.el --- generic UTF-8 language environment -*- no-byte-compile: t -*-
+;;; utf-8-lang.el --- generic UTF-8 language environment
-;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
\f
;;;### (autoloads (5x5-crack 5x5-crack-xor-mutate 5x5-crack-mutating-best
;;;;;; 5x5-crack-mutating-current 5x5-crack-randomly 5x5) "5x5"
-;;;;;; "play/5x5.el" (20355 10320))
+;;;;;; "play/5x5.el" (20545 57511 257469 0))
;;; Generated autoloads from play/5x5.el
(autoload '5x5 "5x5" "\
;;;***
\f
;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20427 14766 970343 0))
;;; Generated autoloads from progmodes/ada-mode.el
(autoload 'ada-add-extensions "ada-mode" "\
;;;***
\f
;;;### (autoloads (ada-header) "ada-stmt" "progmodes/ada-stmt.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/ada-stmt.el
(autoload 'ada-header "ada-stmt" "\
;;;***
\f
;;;### (autoloads (ada-find-file) "ada-xref" "progmodes/ada-xref.el"
-;;;;;; (20355 10320))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from progmodes/ada-xref.el
(autoload 'ada-find-file "ada-xref" "\
;;;;;; add-change-log-entry-other-window add-change-log-entry find-change-log
;;;;;; prompt-for-change-log-name add-log-mailing-address add-log-full-name
;;;;;; add-log-current-defun-function) "add-log" "vc/add-log.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from vc/add-log.el
(put 'change-log-default-name 'safe-local-variable 'string-or-null-p)
\(fn)" t nil)
(defvar add-log-lisp-like-modes '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode) "\
-*Modes that look like Lisp to `add-log-current-defun'.")
+Modes that look like Lisp to `add-log-current-defun'.")
(defvar add-log-c-like-modes '(c-mode c++-mode c++-c-mode objc-mode) "\
-*Modes that look like C to `add-log-current-defun'.")
+Modes that look like C to `add-log-current-defun'.")
(defvar add-log-tex-like-modes '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode) "\
-*Modes that look like TeX to `add-log-current-defun'.")
+Modes that look like TeX to `add-log-current-defun'.")
(autoload 'add-log-current-defun "add-log" "\
Return name of function definition point is in, or nil.
\f
;;;### (autoloads (defadvice ad-activate ad-add-advice ad-disable-advice
;;;;;; ad-enable-advice ad-default-compilation-action ad-redefinition-action)
-;;;;;; "advice" "emacs-lisp/advice.el" (20355 10320))
+;;;;;; "advice" "emacs-lisp/advice.el" (20497 6436 957082 0))
;;; Generated autoloads from emacs-lisp/advice.el
(defvar ad-redefinition-action 'warn "\
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)
-\(fn FUNCTION ARGS &rest BODY)" nil (quote macro))
+\(fn FUNCTION ARGS &rest BODY)" nil t)
(put 'defadvice 'doc-string-elt '3)
\f
;;;### (autoloads (align-newline-and-indent align-unhighlight-rule
;;;;;; align-highlight-rule align-current align-entire align-regexp
-;;;;;; align) "align" "align.el" (20355 10320))
+;;;;;; align) "align" "align.el" (20515 36389 544939 0))
;;; Generated autoloads from align.el
(autoload 'align "align" "\
\f
;;;### (autoloads (outlineify-sticky allout-mode allout-mode-p allout-auto-activation
;;;;;; allout-setup allout-auto-activation-helper) "allout" "allout.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from allout.el
(autoload 'allout-auto-activation-helper "allout" "\
(autoload 'allout-mode-p "allout" "\
Return t if `allout-mode' is active in current buffer.
-\(fn)" nil (quote macro))
+\(fn)" nil t)
(autoload 'allout-mode "allout" "\
Toggle Allout outline mode.
`allout-mode-hook'
`allout-mode-deactivate-hook' (deprecated)
`allout-mode-off-hook'
-`allout-exposure-change-hook'
-`allout-structure-added-hook'
-`allout-structure-deleted-hook'
-`allout-structure-shifted-hook'
+`allout-exposure-change-functions'
+`allout-structure-added-functions'
+`allout-structure-deleted-functions'
+`allout-structure-shifted-functions'
`allout-after-copy-or-kill-hook'
`allout-post-undo-hook'
\f
;;;### (autoloads (allout-widgets-mode allout-widgets-auto-activation
;;;;;; allout-widgets-setup allout-widgets) "allout-widgets" "allout-widgets.el"
-;;;;;; (20433 57140))
+;;;;;; (20545 57511 257469 0))
;;; Generated autoloads from allout-widgets.el
(let ((loads (get 'allout-widgets 'custom-loads))) (if (member '"allout-widgets" loads) nil (put 'allout-widgets 'custom-loads (cons '"allout-widgets" loads))))
;;;***
\f
;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp"
-;;;;;; "net/ange-ftp.el" (20355 10320))
+;;;;;; "net/ange-ftp.el" (20501 3499 284800 0))
;;; Generated autoloads from net/ange-ftp.el
(defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
;;;***
\f
;;;### (autoloads (animate-birthday-present animate-sequence animate-string)
-;;;;;; "animate" "play/animate.el" (20355 10320))
+;;;;;; "animate" "play/animate.el" (20545 57511 257469 0))
;;; Generated autoloads from play/animate.el
(autoload 'animate-string "animate" "\
;;;***
\f
;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on)
-;;;;;; "ansi-color" "ansi-color.el" (20391 44851))
+;;;;;; "ansi-color" "ansi-color.el" (20523 30501 603360 0))
;;; Generated autoloads from ansi-color.el
(autoload 'ansi-color-for-comint-mode-on "ansi-color" "\
;;;***
\f
;;;### (autoloads (antlr-set-tabs antlr-mode antlr-show-makefile-rules)
-;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20355 10320))
+;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20427 14766 970343
+;;;;;; 0))
;;; Generated autoloads from progmodes/antlr-mode.el
(autoload 'antlr-show-makefile-rules "antlr-mode" "\
;;;***
\f
;;;### (autoloads (appt-activate appt-add) "appt" "calendar/appt.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from calendar/appt.el
(autoload 'appt-add "appt" "\
\f
;;;### (autoloads (apropos-documentation apropos-value apropos-library
;;;;;; apropos apropos-documentation-property apropos-command apropos-variable
-;;;;;; apropos-read-pattern) "apropos" "apropos.el" (20355 10320))
+;;;;;; apropos-read-pattern) "apropos" "apropos.el" (20523 62082
+;;;;;; 997685 0))
;;; Generated autoloads from apropos.el
(autoload 'apropos-read-pattern "apropos" "\
;;;***
\f
-;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20387
+;;;;;; 44199 24128 0))
;;; Generated autoloads from arc-mode.el
(autoload 'archive-mode "arc-mode" "\
;;;***
\f
-;;;### (autoloads (array-mode) "array" "array.el" (20355 10320))
+;;;### (autoloads (array-mode) "array" "array.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from array.el
(autoload 'array-mode "array" "\
;;;***
\f
-;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (20513
+;;;;;; 18948 537867 0))
;;; Generated autoloads from textmodes/artist.el
(autoload 'artist-mode "artist" "\
Toggle Artist mode.
-With argument STATE, turn Artist mode on if STATE is positive.
+With argument ARG, turn Artist mode on if ARG is positive.
Artist lets you draw lines, squares, rectangles and poly-lines,
ellipses and circles with your mouse and/or keyboard.
Hooks
- When entering artist-mode, the hook `artist-mode-init-hook' is called.
- When quitting artist-mode, the hook `artist-mode-exit-hook' is called.
+ Turning the mode on or off runs `artist-mode-hook'.
Keymap summary
\\{artist-mode-map}
-\(fn &optional STATE)" t nil)
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/asm-mode.el
(autoload 'asm-mode "asm-mode" "\
;;;***
\f
;;;### (autoloads (auth-source-cache-expiry) "auth-source" "gnus/auth-source.el"
-;;;;;; (20355 10320))
+;;;;;; (20544 36659 880486 0))
;;; Generated autoloads from gnus/auth-source.el
(defvar auth-source-cache-expiry 7200 "\
;;;***
\f
;;;### (autoloads (autoarg-kp-mode autoarg-mode) "autoarg" "autoarg.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from autoarg.el
(defvar autoarg-mode nil "\
;;;***
\f
;;;### (autoloads (autoconf-mode) "autoconf" "progmodes/autoconf.el"
-;;;;;; (20355 10320))
+;;;;;; (20513 18948 537867 0))
;;; Generated autoloads from progmodes/autoconf.el
(autoload 'autoconf-mode "autoconf" "\
-Major mode for editing Autoconf configure.in files.
+Major mode for editing Autoconf configure.ac files.
\(fn)" t nil)
;;;***
\f
;;;### (autoloads (auto-insert-mode define-auto-insert auto-insert)
-;;;;;; "autoinsert" "autoinsert.el" (20355 10320))
+;;;;;; "autoinsert" "autoinsert.el" (20458 56750 651721 0))
;;; Generated autoloads from autoinsert.el
(autoload 'auto-insert "autoinsert" "\
\f
;;;### (autoloads (batch-update-autoloads update-directory-autoloads
;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el"
-;;;;;; (20516 60858))
+;;;;;; (20518 12580 46478 0))
;;; Generated autoloads from emacs-lisp/autoload.el
(put 'generated-autoload-file 'safe-local-variable 'stringp)
\f
;;;### (autoloads (global-auto-revert-mode turn-on-auto-revert-tail-mode
;;;;;; auto-revert-tail-mode turn-on-auto-revert-mode auto-revert-mode)
-;;;;;; "autorevert" "autorevert.el" (20355 10320))
+;;;;;; "autorevert" "autorevert.el" (20476 31768 298871 0))
;;; Generated autoloads from autorevert.el
(autoload 'auto-revert-mode "autorevert" "\
;;;***
\f
;;;### (autoloads (mouse-avoidance-mode mouse-avoidance-mode) "avoid"
-;;;;;; "avoid.el" (20355 10320))
+;;;;;; "avoid.el" (20476 31768 298871 0))
;;; Generated autoloads from avoid.el
(defvar mouse-avoidance-mode nil "\
;;;***
\f
;;;### (autoloads (display-battery-mode battery) "battery" "battery.el"
-;;;;;; (20369 17844))
+;;;;;; (20476 31768 298871 0))
;;; Generated autoloads from battery.el
(put 'battery-mode-line-string 'risky-local-variable t)
;;;***
\f
;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run)
-;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20355 10320))
+;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from emacs-lisp/benchmark.el
(autoload 'benchmark-run "benchmark" "\
garbage collections that ran, and the time taken by garbage collection.
See also `benchmark-run-compiled'.
-\(fn &optional REPETITIONS &rest FORMS)" nil (quote macro))
+\(fn &optional REPETITIONS &rest FORMS)" nil t)
(autoload 'benchmark-run-compiled "benchmark" "\
Time execution of compiled version of FORMS.
byte code obtained by wrapping FORMS in a `lambda' and compiling the
result. The overhead of the `lambda's is accounted for.
-\(fn &optional REPETITIONS &rest FORMS)" nil (quote macro))
+\(fn &optional REPETITIONS &rest FORMS)" nil t)
(autoload 'benchmark "benchmark" "\
Print the time taken for REPETITIONS executions of FORM.
;;;***
\f
;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize)
-;;;;;; "bibtex" "textmodes/bibtex.el" (20355 10320))
+;;;;;; "bibtex" "textmodes/bibtex.el" (20439 5925 915283 0))
;;; Generated autoloads from textmodes/bibtex.el
(autoload 'bibtex-initialize "bibtex" "\
;;;***
\f
;;;### (autoloads (bibtex-style-mode) "bibtex-style" "textmodes/bibtex-style.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/bibtex-style.el
(autoload 'bibtex-style-mode "bibtex-style" "\
\f
;;;### (autoloads (binhex-decode-region binhex-decode-region-external
;;;;;; binhex-decode-region-internal) "binhex" "mail/binhex.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/binhex.el
(defconst binhex-begin-line "^:...............................................................$" "\
;;;***
\f
-;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20544
-;;;;;; 62870))
+;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20545
+;;;;;; 57511 257469 0))
;;; Generated autoloads from play/blackbox.el
(autoload 'blackbox "blackbox" "\
;;;;;; bookmark-save bookmark-write bookmark-delete bookmark-insert
;;;;;; bookmark-rename bookmark-insert-location bookmark-relocate
;;;;;; bookmark-jump-other-window bookmark-jump bookmark-set) "bookmark"
-;;;;;; "bookmark.el" (20355 10320))
+;;;;;; "bookmark.el" (20514 15527 107017 0))
;;; Generated autoloads from bookmark.el
(define-key ctl-x-r-map "b" 'bookmark-jump)
(define-key ctl-x-r-map "m" 'bookmark-set)
\(fn)" t nil)
-(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (define-key map [load] `(menu-item ,(purecopy "Load a Bookmark File...") bookmark-load :help ,(purecopy "Load bookmarks from a bookmark file)"))) (define-key map [write] `(menu-item ,(purecopy "Save Bookmarks As...") bookmark-write :help ,(purecopy "Write bookmarks to a file (reading the file name with the minibuffer)"))) (define-key map [save] `(menu-item ,(purecopy "Save Bookmarks") bookmark-save :help ,(purecopy "Save currently defined bookmarks"))) (define-key map [edit] `(menu-item ,(purecopy "Edit Bookmark List") bookmark-bmenu-list :help ,(purecopy "Display a list of existing bookmarks"))) (define-key map [delete] `(menu-item ,(purecopy "Delete Bookmark...") bookmark-delete :help ,(purecopy "Delete a bookmark from the bookmark list"))) (define-key map [rename] `(menu-item ,(purecopy "Rename Bookmark...") bookmark-rename :help ,(purecopy "Change the name of a bookmark"))) (define-key map [locate] `(menu-item ,(purecopy "Insert Location...") bookmark-locate :help ,(purecopy "Insert the name of the file associated with a bookmark"))) (define-key map [insert] `(menu-item ,(purecopy "Insert Contents...") bookmark-insert :help ,(purecopy "Insert the text of the file pointed to by a bookmark"))) (define-key map [set] `(menu-item ,(purecopy "Set Bookmark...") bookmark-set :help ,(purecopy "Set a bookmark named inside a file."))) (define-key map [jump] `(menu-item ,(purecopy "Jump to Bookmark...") bookmark-jump :help ,(purecopy "Jump to a bookmark (a point in some file)"))) map))
+(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (bindings--define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (bindings--define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (bindings--define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (bindings--define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (bindings--define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (bindings--define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (bindings--define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (bindings--define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map))
(defalias 'menu-bar-bookmark-map menu-bar-bookmark-map)
;;;;;; browse-url-xdg-open browse-url-at-mouse browse-url-at-point
;;;;;; browse-url browse-url-of-region browse-url-of-dired-file
;;;;;; browse-url-of-buffer browse-url-of-file browse-url-browser-function)
-;;;;;; "browse-url" "net/browse-url.el" (20355 10320))
+;;;;;; "browse-url" "net/browse-url.el" (20478 3673 653810 0))
;;; Generated autoloads from net/browse-url.el
(defvar browse-url-browser-function 'browse-url-default-browser "\
\(fn URL &optional NEW-WINDOW)" t nil)
-;;;***
-\f
-;;;### (autoloads (snarf-bruces bruce) "bruce" "play/bruce.el" (20355
-;;;;;; 10320))
-;;; Generated autoloads from play/bruce.el
-
-(autoload 'bruce "bruce" "\
-Adds that special touch of class to your outgoing mail.
-
-\(fn)" t nil)
-
-(autoload 'snarf-bruces "bruce" "\
-Return a vector containing the lines from `bruce-phrases-file'.
-
-\(fn)" nil nil)
-
;;;***
\f
;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next)
-;;;;;; "bs" "bs.el" (20355 10320))
+;;;;;; "bs" "bs.el" (20520 54308 826101 0))
;;; Generated autoloads from bs.el
(autoload 'bs-cycle-next "bs" "\
;;;***
\f
-;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20355 10320))
+;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20478 3673
+;;;;;; 653810 0))
;;; Generated autoloads from play/bubbles.el
(autoload 'bubbles "bubbles" "\
;;;***
\f
;;;### (autoloads (bug-reference-prog-mode bug-reference-mode) "bug-reference"
-;;;;;; "progmodes/bug-reference.el" (20487 60609))
+;;;;;; "progmodes/bug-reference.el" (20532 45476 981297 0))
;;; Generated autoloads from progmodes/bug-reference.el
(put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format)))))
;;;;;; batch-byte-compile-if-not-done display-call-tree byte-compile
;;;;;; compile-defun byte-compile-file byte-recompile-directory
;;;;;; byte-force-recompile byte-compile-enable-warning byte-compile-disable-warning)
-;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20423 21318))
+;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20522 38631 876994 556000))
;;; Generated autoloads from emacs-lisp/bytecomp.el
(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)
(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
;;;***
\f
;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from calendar/cal-china.el
(put 'calendar-chinese-time-zone 'risky-local-variable t)
;;;***
\f
-;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (20461 36529))
+;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (20461 32935
+;;;;;; 300400 0))
;;; Generated autoloads from calendar/cal-dst.el
(put 'calendar-daylight-savings-starts 'risky-local-variable t)
;;;***
\f
;;;### (autoloads (calendar-hebrew-list-yahrzeits) "cal-hebrew" "calendar/cal-hebrew.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from calendar/cal-hebrew.el
(autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\
\f
;;;### (autoloads (defmath calc-embedded-activate calc-embedded calc-grab-rectangle
;;;;;; calc-grab-region full-calc-keypad calc-keypad calc-eval quick-calc
-;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20355
-;;;;;; 10320))
+;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20504
+;;;;;; 23200 130482 0))
;;; Generated autoloads from calc/calc.el
(define-key ctl-x-map "*" 'calc-dispatch)
See Info node `(calc)Defining Functions'.
-\(fn FUNC ARGS &rest BODY)" nil (quote macro))
+\(fn FUNC ARGS &rest BODY)" nil t)
(put 'defmath 'doc-string-elt '3)
;;;***
\f
;;;### (autoloads (calc-undo) "calc-undo" "calc/calc-undo.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from calc/calc-undo.el
(autoload 'calc-undo "calc-undo" "\
;;;***
\f
-;;;### (autoloads (calculator) "calculator" "calculator.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (calculator) "calculator" "calculator.el" (20476
+;;;;;; 31768 298871 0))
;;; Generated autoloads from calculator.el
(autoload 'calculator "calculator" "\
;;;***
\f
-;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20457
+;;;;;; 35879 688143 0))
;;; Generated autoloads from calendar/calendar.el
(autoload 'calendar "calendar" "\
;;;***
\f
;;;### (autoloads (canlock-verify canlock-insert-header) "canlock"
-;;;;;; "gnus/canlock.el" (20355 10320))
+;;;;;; "gnus/canlock.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/canlock.el
(autoload 'canlock-insert-header "canlock" "\
;;;***
\f
;;;### (autoloads (capitalized-words-mode) "cap-words" "progmodes/cap-words.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/cap-words.el
(autoload 'capitalized-words-mode "cap-words" "\
;;;***
\f
;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/cc-compat.el
(put 'c-indent-level 'safe-local-variable 'integerp)
;;;***
\f
;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el"
-;;;;;; (20358 10456))
+;;;;;; (20486 36135 22104 0))
;;; Generated autoloads from progmodes/cc-engine.el
(autoload 'c-guess-basic-syntax "cc-engine" "\
\f
;;;### (autoloads (c-guess-install c-guess-region-no-install c-guess-region
;;;;;; c-guess-buffer-no-install c-guess-buffer c-guess-no-install
-;;;;;; c-guess) "cc-guess" "progmodes/cc-guess.el" (20355 10320))
+;;;;;; c-guess) "cc-guess" "progmodes/cc-guess.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from progmodes/cc-guess.el
(defvar c-guess-guessed-offsets-alist nil "\
\f
;;;### (autoloads (awk-mode pike-mode idl-mode java-mode objc-mode
;;;;;; c++-mode c-mode c-initialize-cc-mode) "cc-mode" "progmodes/cc-mode.el"
-;;;;;; (20365 20790))
+;;;;;; (20416 44451 205563 0))
;;; Generated autoloads from progmodes/cc-mode.el
(autoload 'c-initialize-cc-mode "cc-mode" "\
(defvar pike-mode-syntax-table nil "\
Syntax table used in pike-mode buffers.")
- (add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(.in\\)?\\)\\'" . pike-mode))
+ (add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(\\.in\\)?\\)\\'" . pike-mode))
(add-to-list 'interpreter-mode-alist '("pike" . pike-mode))
(autoload 'pike-mode "cc-mode" "\
;;;***
\f
;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles"
-;;;;;; "progmodes/cc-styles.el" (20355 10320))
+;;;;;; "progmodes/cc-styles.el" (20355 10021 546955 0))
;;; Generated autoloads from progmodes/cc-styles.el
(autoload 'c-set-style "cc-styles" "\
;;;***
\f
-;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20355 10320))
+;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from progmodes/cc-vars.el
(put 'c-basic-offset 'safe-local-variable 'integerp)
(put 'c-backslash-column 'safe-local-variable 'integerp)
\f
;;;### (autoloads (ccl-execute-with-args check-ccl-program define-ccl-program
;;;;;; declare-ccl-program ccl-dump ccl-compile) "ccl" "international/ccl.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from international/ccl.el
(autoload 'ccl-compile "ccl" "\
Optional arg VECTOR is a compiled CCL code of the CCL program.
-\(fn NAME &optional VECTOR)" nil (quote macro))
+\(fn NAME &optional VECTOR)" nil t)
(autoload 'define-ccl-program "ccl" "\
Set NAME the compiled code of CCL-PROGRAM.
MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
MAP-ID := integer
-\(fn NAME CCL-PROGRAM &optional DOC)" nil (quote macro))
+\(fn NAME CCL-PROGRAM &optional DOC)" nil t)
(put 'define-ccl-program 'doc-string-elt '3)
If CCL-PROGRAM is a vector and optional arg NAME (symbol) is supplied,
register CCL-PROGRAM by name NAME, and return NAME.
-\(fn CCL-PROGRAM &optional NAME)" nil (quote macro))
+\(fn CCL-PROGRAM &optional NAME)" nil t)
(autoload 'ccl-execute-with-args "ccl" "\
Execute CCL-PROGRAM with registers initialized by the remaining args.
;;;***
\f
;;;### (autoloads (cconv-closure-convert) "cconv" "emacs-lisp/cconv.el"
-;;;;;; (20355 10320))
+;;;;;; (20453 5437 764254 0))
;;; Generated autoloads from emacs-lisp/cconv.el
(autoload 'cconv-closure-convert "cconv" "\
;;;***
\f
;;;### (autoloads (cfengine-auto-mode cfengine2-mode cfengine3-mode)
-;;;;;; "cfengine" "progmodes/cfengine.el" (20355 10320))
+;;;;;; "cfengine" "progmodes/cfengine.el" (20355 10021 546955 0))
;;; Generated autoloads from progmodes/cfengine.el
(autoload 'cfengine3-mode "cfengine" "\
;;;***
\f
;;;### (autoloads (check-declare-directory check-declare-file) "check-declare"
-;;;;;; "emacs-lisp/check-declare.el" (20370 2))
+;;;;;; "emacs-lisp/check-declare.el" (20378 29222 722320 0))
;;; Generated autoloads from emacs-lisp/check-declare.el
(autoload 'check-declare-file "check-declare" "\
;;;;;; checkdoc-comments checkdoc-continue checkdoc-start checkdoc-current-buffer
;;;;;; checkdoc-eval-current-buffer checkdoc-message-interactive
;;;;;; checkdoc-interactive checkdoc checkdoc-list-of-strings-p)
-;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20355 10320))
+;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20388 65061 302484 0))
;;; Generated autoloads from emacs-lisp/checkdoc.el
(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp)
(put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp)
\f
;;;### (autoloads (pre-write-encode-hz post-read-decode-hz encode-hz-buffer
;;;;;; encode-hz-region decode-hz-buffer decode-hz-region) "china-util"
-;;;;;; "language/china-util.el" (20355 10320))
+;;;;;; "language/china-util.el" (20355 10021 546955 0))
;;; Generated autoloads from language/china-util.el
(autoload 'decode-hz-region "china-util" "\
;;;***
\f
;;;### (autoloads (command-history list-command-history repeat-matching-complex-command)
-;;;;;; "chistory" "chistory.el" (20355 10320))
+;;;;;; "chistory" "chistory.el" (20355 10021 546955 0))
;;; Generated autoloads from chistory.el
(autoload 'repeat-matching-complex-command "chistory" "\
\(fn)" t nil)
-;;;***
-\f
-;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (20355 10320))
-;;; Generated autoloads from emacs-lisp/cl.el
-
-(defvar custom-print-functions nil "\
-This is a list of functions that format user objects for printing.
-Each function is called in turn with three arguments: the object, the
-stream, and the print level (currently ignored). If it is able to
-print the object it returns true; otherwise it returns nil and the
-printer proceeds to the next function on the list.
-
-This variable is not used at present, but it is defined in hopes that
-a future Emacs interpreter will be able to use it.")
-
;;;***
\f
;;;### (autoloads (common-lisp-indent-function) "cl-indent" "emacs-lisp/cl-indent.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/cl-indent.el
(autoload 'common-lisp-indent-function "cl-indent" "\
\(fn INDENT-POINT STATE)" nil nil)
+;;;***
+\f
+;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20541 60450
+;;;;;; 834170 0))
+;;; Generated autoloads from emacs-lisp/cl-lib.el
+
+(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.
+Each function is called in turn with three arguments: the object, the
+stream, and the print level (currently ignored). If it is able to
+print the object it returns true; otherwise it returns nil and the
+printer proceeds to the next function on the list.
+
+This variable is not used at present, but it is defined in hopes that
+a future Emacs interpreter will be able to use it.")
+
+(autoload 'cl--defsubst-expand "cl-macs")
+
+(put 'cl-defun 'doc-string-elt 3)
+
+(put 'cl-defmacro 'doc-string-elt 3)
+
+(put 'cl-defsubst 'doc-string-elt 3)
+
+(put 'cl-defstruct 'doc-string-elt 2)
+
;;;***
\f
;;;### (autoloads (c-macro-expand) "cmacexp" "progmodes/cmacexp.el"
-;;;;;; (20355 10320))
+;;;;;; (20495 51111 757560 0))
;;; Generated autoloads from progmodes/cmacexp.el
(autoload 'c-macro-expand "cmacexp" "\
;;;***
\f
;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from cmuscheme.el
(autoload 'run-scheme "cmuscheme" "\
;;;***
\f
-;;;### (autoloads (color-name-to-rgb) "color" "color.el" (20355 10320))
+;;;### (autoloads (color-name-to-rgb) "color" "color.el" (20522 9637
+;;;;;; 465791 0))
;;; Generated autoloads from color.el
(autoload 'color-name-to-rgb "color" "\
;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list
;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command
;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el"
-;;;;;; (20367 62515))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from comint.el
(defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\
;;;***
\f
;;;### (autoloads (compare-windows) "compare-w" "vc/compare-w.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from vc/compare-w.el
(autoload 'compare-windows "compare-w" "\
;;;;;; compilation-shell-minor-mode compilation-mode compilation-start
;;;;;; compile compilation-disable-input compile-command compilation-search-path
;;;;;; compilation-ask-about-save compilation-window-height compilation-start-hook
-;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20399
-;;;;;; 38963))
+;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20543
+;;;;;; 15782 195452 0))
;;; Generated autoloads from progmodes/compile.el
(defvar compilation-mode-hook nil "\
(custom-autoload 'compilation-window-height "compile" t)
(defvar compilation-process-setup-function nil "\
-*Function to call to customize the compilation process.
+Function to call to customize the compilation process.
This function is called immediately before the compilation process is
started. It can be used to set any variables or functions that are used
while processing the output of the compilation process.")
\(fn &optional NAME-OF-MODE)" t nil)
+(put 'define-compilation-mode 'doc-string-elt 3)
+
(autoload 'compilation-shell-minor-mode "compile" "\
Toggle Compilation Shell minor mode.
With a prefix argument ARG, enable Compilation Shell minor mode
;;;***
\f
;;;### (autoloads (dynamic-completion-mode) "completion" "completion.el"
-;;;;;; (20355 10320))
+;;;;;; (20495 51111 757560 0))
;;; Generated autoloads from completion.el
(defvar dynamic-completion-mode nil "\
;;;### (autoloads (conf-xdefaults-mode conf-ppd-mode conf-colon-mode
;;;;;; conf-space-keywords conf-space-mode conf-javaprop-mode conf-windows-mode
;;;;;; conf-unix-mode conf-mode) "conf-mode" "textmodes/conf-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/conf-mode.el
(autoload 'conf-mode "conf-mode" "\
;;;***
\f
;;;### (autoloads (shuffle-vector cookie-snarf cookie-insert cookie)
-;;;;;; "cookie1" "play/cookie1.el" (20355 10320))
+;;;;;; "cookie1" "play/cookie1.el" (20545 57511 257469 0))
;;; Generated autoloads from play/cookie1.el
(autoload 'cookie "cookie1" "\
;;;***
\f
;;;### (autoloads (copyright-update-directory copyright copyright-fix-years
-;;;;;; copyright-update) "copyright" "emacs-lisp/copyright.el" (20516
-;;;;;; 60858))
+;;;;;; copyright-update) "copyright" "emacs-lisp/copyright.el" (20518
+;;;;;; 12580 46478 0))
;;; Generated autoloads from emacs-lisp/copyright.el
(put 'copyright-at-end-flag 'safe-local-variable 'booleanp)
(put 'copyright-names-regexp 'safe-local-variable 'stringp)
;;;***
\f
;;;### (autoloads (cperl-perldoc-at-point cperl-perldoc cperl-mode)
-;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (20512 11949))
+;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (20512 60198 306109
+;;;;;; 0))
;;; Generated autoloads from progmodes/cperl-mode.el
(put 'cperl-indent-level 'safe-local-variable 'integerp)
(put 'cperl-brace-offset 'safe-local-variable 'integerp)
;;;***
\f
;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/cpp.el
(autoload 'cpp-highlight-buffer "cpp" "\
;;;***
\f
;;;### (autoloads (crisp-mode crisp-mode) "crisp" "emulation/crisp.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from emulation/crisp.el
(defvar crisp-mode nil "\
;;;***
\f
;;;### (autoloads (completing-read-multiple) "crm" "emacs-lisp/crm.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/crm.el
(autoload 'completing-read-multiple "crm" "\
;;;***
\f
-;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from textmodes/css-mode.el
(autoload 'css-mode "css-mode" "\
;;;***
\f
;;;### (autoloads (cua-selection-mode cua-mode) "cua-base" "emulation/cua-base.el"
-;;;;;; (20360 2867))
+;;;;;; (20434 17809 692608 0))
;;; Generated autoloads from emulation/cua-base.el
(defvar cua-mode nil "\
;;;;;; customize-mode customize customize-push-and-save customize-save-variable
;;;;;; customize-set-variable customize-set-value custom-menu-sort-alphabetically
;;;;;; custom-buffer-sort-alphabetically custom-browse-sort-alphabetically)
-;;;;;; "cus-edit" "cus-edit.el" (20424 42174))
+;;;;;; "cus-edit" "cus-edit.el" (20523 62082 997685 0))
;;; Generated autoloads from cus-edit.el
(defvar custom-browse-sort-alphabetically nil "\
(defalias 'customize-variable 'customize-option)
(autoload 'customize-option "cus-edit" "\
-Customize SYMBOL, which must be a user option variable.
+Customize SYMBOL, which must be a user option.
\(fn SYMBOL)" t nil)
(defalias 'customize-variable-other-window 'customize-option-other-window)
(autoload 'customize-option-other-window "cus-edit" "\
-Customize SYMBOL, which must be a user option variable.
+Customize SYMBOL, which must be a user option.
Show the buffer in another window, but don't select it.
\(fn SYMBOL)" t nil)
(autoload 'customize-changed-options "cus-edit" "\
Customize all settings whose meanings have changed in Emacs itself.
-This includes new user option variables and faces, and new
-customization groups, as well as older options and faces whose meanings
-or default values have changed since the previous major Emacs release.
+This includes new user options and faces, and new customization
+groups, as well as older options and faces whose meanings or
+default values have changed since the previous major Emacs
+release.
With argument SINCE-VERSION (a string), customize all settings
that were added or redefined since that version.
\(fn)" t nil)
(autoload 'customize-apropos "cus-edit" "\
-Customize all loaded options, faces and groups matching PATTERN.
+Customize loaded options, faces and groups matching PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
or a regexp (using some regexp special characters). If it is a word,
search for matches for that word as a substring. If it is a list of words,
If TYPE is `options', include only options.
If TYPE is `faces', include only faces.
If TYPE is `groups', include only groups.
-If TYPE is t (interactively, with prefix arg), include variables
-that are not customizable options, as well as faces and groups
-\(but we recommend using `apropos-variable' instead).
\(fn PATTERN &optional TYPE)" t nil)
(autoload 'customize-apropos-options "cus-edit" "\
Customize all loaded customizable options matching REGEXP.
-With prefix ARG, include variables that are not customizable options
-\(but it is better to use `apropos-variable' if you want to find those).
-\(fn REGEXP &optional ARG)" t nil)
+\(fn REGEXP &optional IGNORED)" t nil)
(autoload 'customize-apropos-faces "cus-edit" "\
Customize all loaded faces matching REGEXP.
\f
;;;### (autoloads (customize-themes describe-theme custom-theme-visit-theme
;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from cus-theme.el
(autoload 'customize-create-theme "cus-theme" "\
;;;***
\f
;;;### (autoloads (cvs-status-mode) "cvs-status" "vc/cvs-status.el"
-;;;;;; (20355 10320))
+;;;;;; (20476 31768 298871 0))
;;; Generated autoloads from vc/cvs-status.el
(autoload 'cvs-status-mode "cvs-status" "\
;;;***
\f
;;;### (autoloads (global-cwarn-mode turn-on-cwarn-mode cwarn-mode)
-;;;;;; "cwarn" "progmodes/cwarn.el" (20355 10320))
+;;;;;; "cwarn" "progmodes/cwarn.el" (20478 3673 653810 0))
;;; Generated autoloads from progmodes/cwarn.el
(autoload 'cwarn-mode "cwarn" "\
\f
;;;### (autoloads (standard-display-cyrillic-translit cyrillic-encode-alternativnyj-char
;;;;;; cyrillic-encode-koi8-r-char) "cyril-util" "language/cyril-util.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from language/cyril-util.el
(autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\
;;;***
\f
;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el"
-;;;;;; (20355 10320))
+;;;;;; (20397 45851 446679 0))
;;; Generated autoloads from dabbrev.el
(put 'dabbrev-case-fold-search 'risky-local-variable t)
(put 'dabbrev-case-replace 'risky-local-variable t)
;;;***
\f
;;;### (autoloads (data-debug-new-buffer) "data-debug" "cedet/data-debug.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from cedet/data-debug.el
(autoload 'data-debug-new-buffer "data-debug" "\
;;;***
\f
-;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20523
+;;;;;; 62082 997685 0))
;;; Generated autoloads from net/dbus.el
(autoload 'dbus-handle-event "dbus" "\
;;;***
\f
;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/dcl-mode.el
(autoload 'dcl-mode "dcl-mode" "\
;;;***
\f
;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug"
-;;;;;; "emacs-lisp/debug.el" (20355 10320))
+;;;;;; "emacs-lisp/debug.el" (20497 6436 957082 0))
;;; Generated autoloads from emacs-lisp/debug.el
(setq debugger 'debug)
;;;***
\f
;;;### (autoloads (decipher-mode decipher) "decipher" "play/decipher.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from play/decipher.el
(autoload 'decipher "decipher" "\
\f
;;;### (autoloads (delimit-columns-rectangle delimit-columns-region
;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from delim-col.el
(autoload 'delimit-columns-customize "delim-col" "\
;;;***
\f
;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/delphi.el
(autoload 'delphi-mode "delphi" "\
;;;***
\f
-;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (20515
+;;;;;; 36389 544939 0))
;;; Generated autoloads from delsel.el
(defalias 'pending-delete-mode 'delete-selection-mode)
;;;***
\f
;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode)
-;;;;;; "derived" "emacs-lisp/derived.el" (20355 10320))
+;;;;;; "derived" "emacs-lisp/derived.el" (20437 50597 545250 0))
;;; Generated autoloads from emacs-lisp/derived.el
(autoload 'define-derived-mode "derived" "\
See Info node `(elisp)Derived Modes' for more details.
-\(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil (quote macro))
+\(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil t)
(put 'define-derived-mode 'doc-string-elt '4)
;;;***
\f
;;;### (autoloads (describe-char describe-text-properties) "descr-text"
-;;;;;; "descr-text.el" (20355 10320))
+;;;;;; "descr-text.el" (20530 32114 546307 0))
;;; Generated autoloads from descr-text.el
(autoload 'describe-text-properties "descr-text" "\
;;;### (autoloads (desktop-revert desktop-save-in-desktop-dir desktop-change-dir
;;;;;; desktop-load-default desktop-read desktop-remove desktop-save
;;;;;; desktop-clear desktop-locals-to-save desktop-save-mode) "desktop"
-;;;;;; "desktop.el" (20419 24243))
+;;;;;; "desktop.el" (20497 6436 957082 0))
;;; Generated autoloads from desktop.el
(defvar desktop-save-mode nil "\
\f
;;;### (autoloads (gnus-article-outlook-deuglify-article gnus-outlook-deuglify-article
;;;;;; gnus-article-outlook-repair-attribution gnus-article-outlook-unwrap-lines)
-;;;;;; "deuglify" "gnus/deuglify.el" (20355 10320))
+;;;;;; "deuglify" "gnus/deuglify.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/deuglify.el
(autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\
;;;***
\f
;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib"
-;;;;;; "calendar/diary-lib.el" (20355 10320))
+;;;;;; "calendar/diary-lib.el" (20530 32124 97707 678000))
;;; Generated autoloads from calendar/diary-lib.el
(autoload 'diary "diary-lib" "\
;;;***
\f
;;;### (autoloads (diff-buffer-with-file diff-backup diff diff-command
-;;;;;; diff-switches) "diff" "vc/diff.el" (20355 10320))
+;;;;;; diff-switches) "diff" "vc/diff.el" (20476 31768 298871 0))
;;; Generated autoloads from vc/diff.el
(defvar diff-switches (purecopy "-c") "\
;;;***
\f
;;;### (autoloads (diff-minor-mode diff-mode) "diff-mode" "vc/diff-mode.el"
-;;;;;; (20454 63285))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from vc/diff-mode.el
(autoload 'diff-mode "diff-mode" "\
;;;***
\f
-;;;### (autoloads (dig) "dig" "net/dig.el" (20355 10320))
+;;;### (autoloads (dig) "dig" "net/dig.el" (20355 10021 546955 0))
;;; Generated autoloads from net/dig.el
(autoload 'dig "dig" "\
;;;***
\f
;;;### (autoloads (dired-mode dired-noselect dired-other-frame dired-other-window
-;;;;;; dired dired-listing-switches) "dired" "dired.el" (20355 10320))
+;;;;;; dired dired-listing-switches) "dired" "dired.el" (20539 18737
+;;;;;; 159373 0))
;;; Generated autoloads from dired.el
(defvar dired-listing-switches (purecopy "-al") "\
;;;***
\f
;;;### (autoloads (dirtrack dirtrack-mode) "dirtrack" "dirtrack.el"
-;;;;;; (20355 10320))
+;;;;;; (20399 35365 4050 0))
;;; Generated autoloads from dirtrack.el
(autoload 'dirtrack-mode "dirtrack" "\
;;;***
\f
-;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (20497
+;;;;;; 6436 957082 0))
;;; Generated autoloads from emacs-lisp/disass.el
(autoload 'disassemble "disass" "\
;;;;;; standard-display-g1 standard-display-ascii standard-display-default
;;;;;; standard-display-8bit describe-current-display-table describe-display-table
;;;;;; set-display-table-slot display-table-slot make-display-table)
-;;;;;; "disp-table" "disp-table.el" (20355 10320))
+;;;;;; "disp-table" "disp-table.el" (20355 10021 546955 0))
;;; Generated autoloads from disp-table.el
(autoload 'make-display-table "disp-table" "\
;;;***
\f
;;;### (autoloads (dissociated-press) "dissociate" "play/dissociate.el"
-;;;;;; (20355 10320))
+;;;;;; (20545 57511 257469 0))
;;; Generated autoloads from play/dissociate.el
(autoload 'dissociated-press "dissociate" "\
;;;***
\f
-;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (20355 10320))
+;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from dnd.el
(defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://") . dnd-open-file) (,(purecopy "^file:") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) "\
;;;***
\f
;;;### (autoloads (dns-mode-soa-increment-serial dns-mode) "dns-mode"
-;;;;;; "textmodes/dns-mode.el" (20355 10320))
+;;;;;; "textmodes/dns-mode.el" (20355 10021 546955 0))
;;; Generated autoloads from textmodes/dns-mode.el
(autoload 'dns-mode "dns-mode" "\
;;;***
\f
;;;### (autoloads (doc-view-bookmark-jump doc-view-minor-mode doc-view-mode-maybe
-;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20355
-;;;;;; 10320))
+;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20476
+;;;;;; 31768 298871 0))
;;; Generated autoloads from doc-view.el
(autoload 'doc-view-mode-p "doc-view" "\
;;;***
\f
-;;;### (autoloads (doctor) "doctor" "play/doctor.el" (20355 10320))
+;;;### (autoloads (doctor) "doctor" "play/doctor.el" (20545 57511
+;;;;;; 257469 0))
;;; Generated autoloads from play/doctor.el
(autoload 'doctor "doctor" "\
;;;***
\f
-;;;### (autoloads (double-mode) "double" "double.el" (20355 10320))
+;;;### (autoloads (double-mode) "double" "double.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from double.el
(autoload 'double-mode "double" "\
;;;***
\f
-;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (20355 10320))
+;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (20545 57511
+;;;;;; 257469 0))
;;; Generated autoloads from play/dunnet.el
(autoload 'dunnet "dunnet" "\
\f
;;;### (autoloads (easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap
;;;;;; define-globalized-minor-mode define-minor-mode) "easy-mmode"
-;;;;;; "emacs-lisp/easy-mmode.el" (20362 44597))
+;;;;;; "emacs-lisp/easy-mmode.el" (20459 40320 865360 0))
;;; Generated autoloads from emacs-lisp/easy-mmode.el
(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
function adds a basic doc-string stating these facts.
Optional INIT-VALUE is the initial value of the mode's variable.
-Optional LIGHTER is displayed in the modeline when the mode is on.
+Optional LIGHTER is displayed in the mode line when the mode is on.
Optional KEYMAP is the default keymap bound to the mode keymap.
If non-nil, it should be a variable name (whose value is a keymap),
or an expression that returns either a keymap or a list of
:lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
...BODY CODE...)
-\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" nil (quote macro))
+\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" nil t)
+
+(put 'define-minor-mode 'doc-string-elt '2)
(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
prevent problems with derived modes, that is, major modes that
call another major mode in their body.
-\(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil (quote macro))
+\(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil t)
+
+(put 'define-globalized-minor-mode 'doc-string-elt '2)
(autoload 'easy-mmode-define-keymap "easy-mmode" "\
Return a keymap built from bindings BS.
The M, BS, and ARGS arguments are as per that function. DOC is
the constant's documentation.
-\(fn M BS DOC &rest ARGS)" nil (quote macro))
+\(fn M BS DOC &rest ARGS)" nil t)
(autoload 'easy-mmode-defsyntax "easy-mmode" "\
Define variable ST as a syntax-table.
CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
-\(fn ST CSS DOC &rest ARGS)" nil (quote macro))
+\(fn ST CSS DOC &rest ARGS)" nil t)
;;;***
\f
;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define
-;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20355
-;;;;;; 10320))
+;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20437
+;;;;;; 50597 545250 0))
;;; Generated autoloads from emacs-lisp/easymenu.el
(autoload 'easy-menu-define "easymenu" "\
A menu item can be a list with the same format as MENU. This is a submenu.
-\(fn SYMBOL MAPS DOC MENU)" nil (quote macro))
+\(fn SYMBOL MAPS DOC MENU)" nil t)
(put 'easy-menu-define 'lisp-indent-function 'defun)
;;;;;; ebnf-eps-file ebnf-eps-directory ebnf-spool-region ebnf-spool-buffer
;;;;;; ebnf-spool-file ebnf-spool-directory ebnf-print-region ebnf-print-buffer
;;;;;; ebnf-print-file ebnf-print-directory ebnf-customize) "ebnf2ps"
-;;;;;; "progmodes/ebnf2ps.el" (20355 10320))
+;;;;;; "progmodes/ebnf2ps.el" (20495 51111 757560 0))
;;; Generated autoloads from progmodes/ebnf2ps.el
(autoload 'ebnf-customize "ebnf2ps" "\
;;;;;; ebrowse-tags-find-declaration-other-window ebrowse-tags-find-definition
;;;;;; ebrowse-tags-view-definition ebrowse-tags-find-declaration
;;;;;; ebrowse-tags-view-declaration ebrowse-member-mode ebrowse-electric-choose-tree
-;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20355
-;;;;;; 10320))
+;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from progmodes/ebrowse.el
(autoload 'ebrowse-tree-mode "ebrowse" "\
;;;***
\f
;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from ebuff-menu.el
(autoload 'electric-buffer-list "ebuff-menu" "\
-Pop up a buffer describing the set of Emacs buffers.
-Vaguely like ITS lunar select buffer; combining typeoutoid buffer
-listing with menuoid buffer selection.
-
-If the very next character typed is a space then the buffer list
-window disappears. Otherwise, one may move around in the buffer list
-window, marking buffers to be selected, saved or deleted.
-
-To exit and select a new buffer, type a space when the cursor is on
-the appropriate line of the buffer-list window. Other commands are
-much like those of `Buffer-menu-mode'.
+Pop up the Buffer Menu in an \"electric\" window.
+If you type SPC or RET (`Electric-buffer-menu-select'), that
+selects the buffer at point and quits the \"electric\" window.
+Otherwise, you can move around in the Buffer Menu, marking
+buffers to be selected, saved or deleted; these other commands
+are much like those of `Buffer-menu-mode'.
Run hooks in `electric-buffer-menu-mode-hook' on entry.
-\\{electric-buffer-menu-mode-map}
+\\<electric-buffer-menu-mode-map>
+\\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
+ configuration. If the very first character typed is a space, it
+ also has this effect.
+\\[Electric-buffer-menu-select] -- select buffer of line point is on.
+ Also show buffers marked with m in other windows,
+ deletes buffers marked with \"D\", and saves those marked with \"S\".
+\\[Buffer-menu-mark] -- mark buffer to be displayed.
+\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
+\\[Buffer-menu-save] -- mark that buffer to be saved.
+\\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
+\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
+\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
+\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
\(fn ARG)" t nil)
;;;***
\f
;;;### (autoloads (Electric-command-history-redo-expression) "echistory"
-;;;;;; "echistory.el" (20355 10320))
+;;;;;; "echistory.el" (20355 10021 546955 0))
;;; Generated autoloads from echistory.el
(autoload 'Electric-command-history-redo-expression "echistory" "\
;;;***
\f
;;;### (autoloads (ecomplete-setup) "ecomplete" "gnus/ecomplete.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/ecomplete.el
(autoload 'ecomplete-setup "ecomplete" "\
;;;***
\f
-;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20355 10320))
+;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from cedet/ede.el
(defvar global-ede-mode nil "\
\f
;;;### (autoloads (edebug-all-forms edebug-all-defs edebug-eval-top-level-form
;;;;;; edebug-basic-spec edebug-all-forms edebug-all-defs) "edebug"
-;;;;;; "emacs-lisp/edebug.el" (20355 10320))
+;;;;;; "emacs-lisp/edebug.el" (20523 62082 997685 0))
;;; Generated autoloads from emacs-lisp/edebug.el
(defvar edebug-all-defs nil "\
;;;;;; ediff-merge-directories-with-ancestor ediff-merge-directories
;;;;;; ediff-directories3 ediff-directory-revisions ediff-directories
;;;;;; ediff-buffers3 ediff-buffers ediff-backup ediff-current-file
-;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (20355 10320))
+;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (20495 51111
+;;;;;; 757560 0))
;;; Generated autoloads from vc/ediff.el
(autoload 'ediff-files "ediff" "\
;;;***
\f
;;;### (autoloads (ediff-customize) "ediff-help" "vc/ediff-help.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from vc/ediff-help.el
(autoload 'ediff-customize "ediff-help" "\
;;;***
\f
;;;### (autoloads (ediff-show-registry) "ediff-mult" "vc/ediff-mult.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from vc/ediff-mult.el
(autoload 'ediff-show-registry "ediff-mult" "\
;;;***
\f
;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe)
-;;;;;; "ediff-util" "vc/ediff-util.el" (20355 10320))
+;;;;;; "ediff-util" "vc/ediff-util.el" (20355 10021 546955 0))
;;; Generated autoloads from vc/ediff-util.el
(autoload 'ediff-toggle-multiframe "ediff-util" "\
\f
;;;### (autoloads (format-kbd-macro read-kbd-macro edit-named-kbd-macro
;;;;;; edit-last-kbd-macro edit-kbd-macro) "edmacro" "edmacro.el"
-;;;;;; (20355 10320))
+;;;;;; (20476 31768 298871 0))
;;; Generated autoloads from edmacro.el
(autoload 'edit-kbd-macro "edmacro" "\
;;;***
\f
;;;### (autoloads (edt-emulation-on edt-set-scroll-margins) "edt"
-;;;;;; "emulation/edt.el" (20355 10320))
+;;;;;; "emulation/edt.el" (20448 20900 17488 0))
;;; Generated autoloads from emulation/edt.el
(autoload 'edt-set-scroll-margins "edt" "\
;;;***
\f
;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from ehelp.el
(autoload 'with-electric-help "ehelp" "\
;;;***
\f
;;;### (autoloads (turn-on-eldoc-mode eldoc-mode eldoc-minor-mode-string)
-;;;;;; "eldoc" "emacs-lisp/eldoc.el" (20355 10320))
+;;;;;; "eldoc" "emacs-lisp/eldoc.el" (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/eldoc.el
(defvar eldoc-minor-mode-string (purecopy " ElDoc") "\
;;;***
\f
;;;### (autoloads (electric-layout-mode electric-pair-mode electric-indent-mode)
-;;;;;; "electric" "electric.el" (20355 10320))
+;;;;;; "electric" "electric.el" (20481 18215 64245 0))
;;; Generated autoloads from electric.el
(defvar electric-indent-chars '(10) "\
;;;***
\f
;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from elide-head.el
(autoload 'elide-head "elide-head" "\
\f
;;;### (autoloads (elint-initialize elint-defun elint-current-buffer
;;;;;; elint-directory elint-file) "elint" "emacs-lisp/elint.el"
-;;;;;; (20355 10320))
+;;;;;; (20486 36135 22104 0))
;;; Generated autoloads from emacs-lisp/elint.el
(autoload 'elint-file "elint" "\
;;;***
\f
;;;### (autoloads (elp-results elp-instrument-package elp-instrument-list
-;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (20355
-;;;;;; 10320))
+;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (20497
+;;;;;; 6436 957082 0))
;;; Generated autoloads from emacs-lisp/elp.el
(autoload 'elp-instrument-function "elp" "\
;;;***
\f
;;;### (autoloads (emacs-lock-mode) "emacs-lock" "emacs-lock.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from emacs-lock.el
(autoload 'emacs-lock-mode "emacs-lock" "\
;;;***
\f
;;;### (autoloads (report-emacs-bug-query-existing-bugs report-emacs-bug)
-;;;;;; "emacsbug" "mail/emacsbug.el" (20355 10320))
+;;;;;; "emacsbug" "mail/emacsbug.el" (20523 62082 997685 0))
;;; Generated autoloads from mail/emacsbug.el
(autoload 'report-emacs-bug "emacsbug" "\
;;;;;; emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote
;;;;;; emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor
;;;;;; emerge-buffers emerge-files-with-ancestor emerge-files) "emerge"
-;;;;;; "vc/emerge.el" (20355 10320))
+;;;;;; "vc/emerge.el" (20355 10021 546955 0))
;;; Generated autoloads from vc/emerge.el
(autoload 'emerge-files "emerge" "\
;;;***
\f
;;;### (autoloads (enriched-decode enriched-encode enriched-mode)
-;;;;;; "enriched" "textmodes/enriched.el" (20454 63285))
+;;;;;; "enriched" "textmodes/enriched.el" (20461 32935 300400 0))
;;; Generated autoloads from textmodes/enriched.el
(autoload 'enriched-mode "enriched" "\
;;;;;; epa-sign-region epa-verify-cleartext-in-region epa-verify-region
;;;;;; epa-decrypt-armor-in-region epa-decrypt-region epa-encrypt-file
;;;;;; epa-sign-file epa-verify-file epa-decrypt-file epa-select-keys
-;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20355
-;;;;;; 10320))
+;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20434
+;;;;;; 17809 692608 0))
;;; Generated autoloads from epa.el
(autoload 'epa-list-keys "epa" "\
;;;***
\f
;;;### (autoloads (epa-dired-do-encrypt epa-dired-do-sign epa-dired-do-verify
-;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (20355 10320))
+;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from epa-dired.el
(autoload 'epa-dired-do-decrypt "epa-dired" "\
;;;***
\f
;;;### (autoloads (epa-file-disable epa-file-enable epa-file-handler)
-;;;;;; "epa-file" "epa-file.el" (20355 10320))
+;;;;;; "epa-file" "epa-file.el" (20355 10021 546955 0))
;;; Generated autoloads from epa-file.el
(autoload 'epa-file-handler "epa-file" "\
\f
;;;### (autoloads (epa-global-mail-mode epa-mail-import-keys epa-mail-encrypt
;;;;;; epa-mail-sign epa-mail-verify epa-mail-decrypt epa-mail-mode)
-;;;;;; "epa-mail" "epa-mail.el" (20355 10320))
+;;;;;; "epa-mail" "epa-mail.el" (20355 10021 546955 0))
;;; Generated autoloads from epa-mail.el
(autoload 'epa-mail-mode "epa-mail" "\
;;;***
\f
-;;;### (autoloads (epg-make-context) "epg" "epg.el" (20355 10320))
+;;;### (autoloads (epg-make-context) "epg" "epg.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from epg.el
(autoload 'epg-make-context "epg" "\
;;;***
\f
;;;### (autoloads (epg-expand-group epg-check-configuration epg-configuration)
-;;;;;; "epg-config" "epg-config.el" (20355 10320))
+;;;;;; "epg-config" "epg-config.el" (20373 11301 906925 0))
;;; Generated autoloads from epg-config.el
(autoload 'epg-configuration "epg-config" "\
;;;***
\f
;;;### (autoloads (erc-handle-irc-url erc-tls erc erc-select-read-args)
-;;;;;; "erc" "erc/erc.el" (20355 10320))
+;;;;;; "erc" "erc/erc.el" (20530 32114 546307 0))
;;; Generated autoloads from erc/erc.el
(autoload 'erc-select-read-args "erc" "\
;;;***
\f
;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from erc/erc-autoaway.el
(autoload 'erc-autoaway-mode "erc-autoaway")
;;;***
\f
-;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20355 10320))
+;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20434 17809
+;;;;;; 692608 0))
;;; Generated autoloads from erc/erc-button.el
(autoload 'erc-button-mode "erc-button" nil t)
;;;***
\f
-;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20355 10320))
+;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from erc/erc-capab.el
(autoload 'erc-capab-identify-mode "erc-capab" nil t)
;;;***
\f
-;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (20355 10320))
+;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from erc/erc-compat.el
(autoload 'erc-define-minor-mode "erc-compat")
;;;***
\f
;;;### (autoloads (erc-ctcp-query-DCC pcomplete/erc-mode/DCC erc-cmd-DCC)
-;;;;;; "erc-dcc" "erc/erc-dcc.el" (20355 10320))
+;;;;;; "erc-dcc" "erc/erc-dcc.el" (20523 62082 997685 0))
;;; Generated autoloads from erc/erc-dcc.el
(autoload 'erc-dcc-mode "erc-dcc")
\(fn)" nil nil)
(defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC) "\
-Hook variable for CTCP DCC queries")
+Hook variable for CTCP DCC queries.")
(autoload 'erc-ctcp-query-DCC "erc-dcc" "\
The function called when a CTCP DCC request is detected by the client.
;;;;;; erc-ezb-add-session erc-ezb-end-of-session-list erc-ezb-init-session-list
;;;;;; erc-ezb-identify erc-ezb-notice-autodetect erc-ezb-lookup-action
;;;;;; erc-ezb-get-login erc-cmd-ezb) "erc-ezbounce" "erc/erc-ezbounce.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from erc/erc-ezbounce.el
(autoload 'erc-cmd-ezb "erc-ezbounce" "\
;;;***
\f
;;;### (autoloads (erc-fill) "erc-fill" "erc/erc-fill.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from erc/erc-fill.el
(autoload 'erc-fill-mode "erc-fill" nil t)
;;;***
\f
;;;### (autoloads (erc-identd-stop erc-identd-start) "erc-identd"
-;;;;;; "erc/erc-identd.el" (20355 10320))
+;;;;;; "erc/erc-identd.el" (20355 10021 546955 0))
;;; Generated autoloads from erc/erc-identd.el
(autoload 'erc-identd-mode "erc-identd")
;;;***
\f
;;;### (autoloads (erc-create-imenu-index) "erc-imenu" "erc/erc-imenu.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from erc/erc-imenu.el
(autoload 'erc-create-imenu-index "erc-imenu" "\
;;;***
\f
-;;;### (autoloads nil "erc-join" "erc/erc-join.el" (20355 10320))
+;;;### (autoloads nil "erc-join" "erc/erc-join.el" (20532 45476 981297
+;;;;;; 0))
;;; Generated autoloads from erc/erc-join.el
(autoload 'erc-autojoin-mode "erc-join" nil t)
;;;***
\f
-;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20355 10320))
+;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from erc/erc-list.el
(autoload 'erc-list-mode "erc-list")
;;;***
\f
;;;### (autoloads (erc-save-buffer-in-logs erc-logging-enabled) "erc-log"
-;;;;;; "erc/erc-log.el" (20355 10320))
+;;;;;; "erc/erc-log.el" (20355 10021 546955 0))
;;; Generated autoloads from erc/erc-log.el
(autoload 'erc-log-mode "erc-log" nil t)
;;;### (autoloads (erc-delete-dangerous-host erc-add-dangerous-host
;;;;;; erc-delete-keyword erc-add-keyword erc-delete-fool erc-add-fool
;;;;;; erc-delete-pal erc-add-pal) "erc-match" "erc/erc-match.el"
-;;;;;; (20355 10320))
+;;;;;; (20531 24613 995935 0))
;;; Generated autoloads from erc/erc-match.el
(autoload 'erc-match-mode "erc-match")
;;;***
\f
-;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20355 10320))
+;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from erc/erc-menu.el
(autoload 'erc-menu-mode "erc-menu" nil t)
;;;***
\f
;;;### (autoloads (erc-cmd-WHOLEFT) "erc-netsplit" "erc/erc-netsplit.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from erc/erc-netsplit.el
(autoload 'erc-netsplit-mode "erc-netsplit")
;;;***
\f
;;;### (autoloads (erc-server-select erc-determine-network) "erc-networks"
-;;;;;; "erc/erc-networks.el" (20355 10320))
+;;;;;; "erc/erc-networks.el" (20355 10021 546955 0))
;;; Generated autoloads from erc/erc-networks.el
(autoload 'erc-determine-network "erc-networks" "\
\(fn)" t nil)
+;;;***
+\f
+;;;### (autoloads nil "erc-notifications" "erc/erc-notifications.el"
+;;;;;; (20491 54052 900109 0))
+;;; Generated autoloads from erc/erc-notifications.el
+(autoload 'erc-notifications-mode "erc-notifications" "" t)
+
;;;***
\f
;;;### (autoloads (pcomplete/erc-mode/NOTIFY erc-cmd-NOTIFY) "erc-notify"
-;;;;;; "erc/erc-notify.el" (20355 10320))
+;;;;;; "erc/erc-notify.el" (20355 10021 546955 0))
;;; Generated autoloads from erc/erc-notify.el
(autoload 'erc-notify-mode "erc-notify" nil t)
;;;***
\f
-;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20355 10320))
+;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from erc/erc-page.el
(autoload 'erc-page-mode "erc-page")
;;;***
\f
;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from erc/erc-pcomplete.el
(autoload 'erc-completion-mode "erc-pcomplete" nil t)
;;;***
\f
-;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20355 10320))
+;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from erc/erc-replace.el
(autoload 'erc-replace-mode "erc-replace")
;;;***
\f
-;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20355 10320))
+;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from erc/erc-ring.el
(autoload 'erc-ring-mode "erc-ring" nil t)
;;;***
\f
;;;### (autoloads (erc-nickserv-identify erc-nickserv-identify-mode)
-;;;;;; "erc-services" "erc/erc-services.el" (20355 10320))
+;;;;;; "erc-services" "erc/erc-services.el" (20357 58785 834364
+;;;;;; 0))
;;; Generated autoloads from erc/erc-services.el
(autoload 'erc-services-mode "erc-services" nil t)
;;;***
\f
-;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (20355 10320))
+;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from erc/erc-sound.el
(autoload 'erc-sound-mode "erc-sound")
;;;***
\f
;;;### (autoloads (erc-speedbar-browser) "erc-speedbar" "erc/erc-speedbar.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from erc/erc-speedbar.el
(autoload 'erc-speedbar-browser "erc-speedbar" "\
;;;***
\f
;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from erc/erc-spelling.el
(autoload 'erc-spelling-mode "erc-spelling" nil t)
;;;***
\f
-;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20355 10320))
+;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20434 17809
+;;;;;; 692608 0))
;;; Generated autoloads from erc/erc-stamp.el
(autoload 'erc-timestamp-mode "erc-stamp" nil t)
;;;***
\f
;;;### (autoloads (erc-track-minor-mode) "erc-track" "erc/erc-track.el"
-;;;;;; (20355 10320))
+;;;;;; (20427 14766 970343 0))
;;; Generated autoloads from erc/erc-track.el
(defvar erc-track-minor-mode nil "\
;;;***
\f
;;;### (autoloads (erc-truncate-buffer erc-truncate-buffer-to-size)
-;;;;;; "erc-truncate" "erc/erc-truncate.el" (20355 10320))
+;;;;;; "erc-truncate" "erc/erc-truncate.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from erc/erc-truncate.el
(autoload 'erc-truncate-mode "erc-truncate" nil t)
;;;***
\f
;;;### (autoloads (erc-xdcc-add-file) "erc-xdcc" "erc/erc-xdcc.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from erc/erc-xdcc.el
(autoload 'erc-xdcc-mode "erc-xdcc")
\f
;;;### (autoloads (ert-describe-test ert-run-tests-interactively
;;;;;; ert-run-tests-batch-and-exit ert-run-tests-batch ert-deftest)
-;;;;;; "ert" "emacs-lisp/ert.el" (20355 10320))
+;;;;;; "ert" "emacs-lisp/ert.el" (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/ert.el
(autoload 'ert-deftest "ert" "\
\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags '(TAG...)] BODY...)" nil (quote macro))
-(put 'ert-deftest 'lisp-indent-function '2)
-
-(put 'ert-deftest 'doc-string-elt '3)
-
(put 'ert-deftest 'lisp-indent-function 2)
(put 'ert-info 'lisp-indent-function 1)
;;;***
\f
;;;### (autoloads (ert-kill-all-test-buffers) "ert-x" "emacs-lisp/ert-x.el"
-;;;;;; (20355 10320))
+;;;;;; (20364 28960 773408 688000))
;;; Generated autoloads from emacs-lisp/ert-x.el
(put 'ert-with-test-buffer 'lisp-indent-function 1)
;;;***
\f
-;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20523
+;;;;;; 62082 997685 0))
;;; Generated autoloads from eshell/esh-mode.el
(autoload 'eshell-mode "esh-mode" "\
;;;***
\f
;;;### (autoloads (eshell-command-result eshell-command eshell) "eshell"
-;;;;;; "eshell/eshell.el" (20355 10320))
+;;;;;; "eshell/eshell.el" (20523 62082 997685 0))
;;; Generated autoloads from eshell/eshell.el
(autoload 'eshell "eshell" "\
;;;;;; visit-tags-table tags-table-mode find-tag-default-function
;;;;;; find-tag-hook tags-add-tables tags-compression-info-list
;;;;;; tags-table-list tags-case-fold-search) "etags" "progmodes/etags.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from progmodes/etags.el
(defvar tags-file-name nil "\
-*File name of tags table.
+File name of tags table.
To switch to a new tags table, setting this variable is sufficient.
If you set this variable, do not also set `tags-table-list'.
Use the `etags' program to make a tags table file.")
(put 'tags-file-name 'safe-local-variable 'stringp)
(defvar tags-case-fold-search 'default "\
-*Whether tags operations should be case-sensitive.
+Whether tags operations should be case-sensitive.
A value of t means case-insensitive, a value of nil means case-sensitive.
Any other value means use the setting of `case-fold-search'.")
(custom-autoload 'tags-case-fold-search "etags" t)
(defvar tags-table-list nil "\
-*List of file names of tags tables to search.
+List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
To switch to a new list of tags tables, setting this variable is sufficient.
If you set this variable, do not also set `tags-file-name'.
(custom-autoload 'tags-table-list "etags" t)
(defvar tags-compression-info-list (purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz")) "\
-*List of extensions tried by etags when jka-compr is used.
+List of extensions tried by etags when jka-compr is used.
An empty string means search the non-compressed file.
These extensions will be tried only if jka-compr was activated
\(i.e. via customize of `auto-compression-mode' or by calling the function
(custom-autoload 'tags-compression-info-list "etags" t)
(defvar tags-add-tables 'ask-user "\
-*Control whether to add a new tags table to the current list.
+Control whether to add a new tags table to the current list.
t means do; nil means don't (always start a new list).
Any other value means ask the user whether to add a new tags table
to the current list (as opposed to starting a new list).")
(custom-autoload 'tags-add-tables "etags" t)
(defvar find-tag-hook nil "\
-*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
+Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
The value in the buffer in which \\[find-tag] is done is used,
not the value in the buffer \\[find-tag] goes to.")
(custom-autoload 'find-tag-hook "etags" t)
(defvar find-tag-default-function nil "\
-*A function of no arguments used by \\[find-tag] to pick a default tag.
+A function of no arguments used by \\[find-tag] to pick a default tag.
If nil, and the symbol that is the value of `major-mode'
has a `find-tag-default-function' property (see `put'), that is used.
Otherwise, `find-tag-default' is used.")
;;;;;; ethio-fidel-to-sera-marker ethio-fidel-to-sera-region ethio-fidel-to-sera-buffer
;;;;;; ethio-sera-to-fidel-marker ethio-sera-to-fidel-region ethio-sera-to-fidel-buffer
;;;;;; setup-ethiopic-environment-internal) "ethio-util" "language/ethio-util.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from language/ethio-util.el
(autoload 'setup-ethiopic-environment-internal "ethio-util" "\
\f
;;;### (autoloads (eudc-load-eudc eudc-query-form eudc-expand-inline
;;;;;; eudc-get-phone eudc-get-email eudc-set-server) "eudc" "net/eudc.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from net/eudc.el
(autoload 'eudc-set-server "eudc" "\
\f
;;;### (autoloads (eudc-display-jpeg-as-button eudc-display-jpeg-inline
;;;;;; eudc-display-sound eudc-display-mail eudc-display-url eudc-display-generic-binary)
-;;;;;; "eudc-bob" "net/eudc-bob.el" (20355 10320))
+;;;;;; "eudc-bob" "net/eudc-bob.el" (20355 10021 546955 0))
;;; Generated autoloads from net/eudc-bob.el
(autoload 'eudc-display-generic-binary "eudc-bob" "\
;;;***
\f
;;;### (autoloads (eudc-try-bbdb-insert eudc-insert-record-at-point-into-bbdb)
-;;;;;; "eudc-export" "net/eudc-export.el" (20355 10320))
+;;;;;; "eudc-export" "net/eudc-export.el" (20355 10021 546955 0))
;;; Generated autoloads from net/eudc-export.el
(autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\
;;;***
\f
;;;### (autoloads (eudc-edit-hotlist) "eudc-hotlist" "net/eudc-hotlist.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from net/eudc-hotlist.el
(autoload 'eudc-edit-hotlist "eudc-hotlist" "\
;;;***
\f
-;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (20453
+;;;;;; 5437 764254 0))
;;; Generated autoloads from emacs-lisp/ewoc.el
(autoload 'ewoc-create "ewoc" "\
;;;### (autoloads (executable-make-buffer-file-executable-if-script-p
;;;;;; executable-self-display executable-set-magic executable-interpret
;;;;;; executable-command-find-posix-p) "executable" "progmodes/executable.el"
-;;;;;; (20355 10320))
+;;;;;; (20533 6181 437016 717000))
;;; Generated autoloads from progmodes/executable.el
(autoload 'executable-command-find-posix-p "executable" "\
\f
;;;### (autoloads (expand-jump-to-next-slot expand-jump-to-previous-slot
;;;;;; expand-abbrev-hook expand-add-abbrevs) "expand" "expand.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from expand.el
(autoload 'expand-add-abbrevs "expand" "\
;;;***
\f
-;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20451 30311))
+;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20461 32935
+;;;;;; 300400 0))
;;; Generated autoloads from progmodes/f90.el
(autoload 'f90-mode "f90" "\
;;;### (autoloads (variable-pitch-mode buffer-face-toggle buffer-face-set
;;;;;; buffer-face-mode text-scale-adjust text-scale-decrease text-scale-increase
;;;;;; text-scale-set face-remap-set-base face-remap-reset-base
-;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20355
-;;;;;; 10320))
+;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20476
+;;;;;; 31768 298871 0))
;;; Generated autoloads from face-remap.el
(autoload 'face-remap-add-relative "face-remap" "\
Return a cookie which can be used to delete this remapping with
`face-remap-remove-relative'.
-The remaining arguments, SPECS, should be either a list of face
-names, or a property list of face attribute/value pairs. The
-remapping specified by SPECS takes effect alongside the
-remappings from other calls to `face-remap-add-relative', as well
-as the normal definition of FACE (at lowest priority). This
-function tries to sort multiple remappings for the same face, so
-that remappings specifying relative face attributes are applied
-after remappings specifying absolute face attributes.
+The remaining arguments, SPECS, should form a list of faces.
+Each list element should be either a face name or a property list
+of face attribute/value pairs. If more than one face is listed,
+that specifies an aggregate face, in the same way as in a `face'
+text property, except for possible priority changes noted below.
+
+The face remapping specified by SPECS takes effect alongside the
+remappings from other calls to `face-remap-add-relative' for the
+same FACE, as well as the normal definition of FACE (at lowest
+priority). This function tries to sort multiple remappings for
+the same face, so that remappings specifying relative face
+attributes are applied after remappings specifying absolute face
+attributes.
The base (lowest priority) remapping may be set to something
other than the normal definition of FACE via `face-remap-set-base'.
(autoload 'face-remap-set-base "face-remap" "\
Set the base remapping of FACE in the current buffer to SPECS.
This causes the remappings specified by `face-remap-add-relative'
-to apply on top of the face specification given by SPECS. SPECS
-should be either a list of face names, or a property list of face
-attribute/value pairs.
+to apply on top of the face specification given by SPECS.
+
+The remaining arguments, SPECS, should form a list of faces.
+Each list element should be either a face name or a property list
+of face attribute/value pairs, like in a `face' text property.
If SPECS is empty, call `face-remap-reset-base' to use the normal
definition of FACE as the base remapping; note that this is
(autoload 'buffer-face-set "face-remap" "\
Enable `buffer-face-mode', using face specs SPECS.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
-If SPECS is nil, then `buffer-face-mode' is disabled.
+Each argument in SPECS should be a face, i.e. either a face name
+or a property list of face attributes and values. If more than
+one face is listed, that specifies an aggregate face, like in a
+`face' text property. If SPECS is nil or omitted, disable
+`buffer-face-mode'.
-This function will make the variable `buffer-face-mode-face'
-buffer local, and set it to FACE.
+This function makes the variable `buffer-face-mode-face' buffer
+local, and sets it to FACE.
\(fn &rest SPECS)" t nil)
(autoload 'buffer-face-toggle "face-remap" "\
Toggle `buffer-face-mode', using face specs SPECS.
-SPECS can be any value suitable for the `face' text property,
-including a face name, a list of face names, or a face-attribute
+Each argument in SPECS should be a face, i.e. either a face name
+or a property list of face attributes and values. If more than
+one face is listed, that specifies an aggregate face, like in a
+`face' text property.
If `buffer-face-mode' is already enabled, and is currently using
the face specs SPECS, then it is disabled; if buffer-face-mode is
\f
;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue
;;;;;; feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts
-;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20355 10320))
+;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20501 3499
+;;;;;; 284800 0))
;;; Generated autoloads from mail/feedmail.el
(autoload 'feedmail-send-it "feedmail" "\
;;;***
\f
-;;;### (autoloads (ffap-bindings dired-at-point ffap-at-mouse ffap-menu
-;;;;;; find-file-at-point ffap-next) "ffap" "ffap.el" (20355 10320))
+;;;### (autoloads (ffap-bindings ffap-guess-file-name-at-point dired-at-point
+;;;;;; ffap-at-mouse ffap-menu find-file-at-point ffap-next) "ffap"
+;;;;;; "ffap.el" (20542 46798 773957 0))
;;; Generated autoloads from ffap.el
(autoload 'ffap-next "ffap" "\
\(fn &optional FILENAME)" t nil)
-(defun ffap-guess-file-name-at-point nil "\
+(autoload 'ffap-guess-file-name-at-point "ffap" "\
Try to get a file name at point.
-This hook is intended to be put in `file-name-at-point-functions'." (when (fboundp (quote ffap-guesser)) (let ((guess (ffap-guesser))) (setq guess (if (or (not guess) (and (fboundp (quote ffap-url-p)) (ffap-url-p guess)) (and (fboundp (quote ffap-file-remote-p)) (ffap-file-remote-p guess))) guess (abbreviate-file-name (expand-file-name guess)))) (when guess (if (file-directory-p guess) (file-name-as-directory guess) guess)))))
+This hook is intended to be put in `file-name-at-point-functions'.
+
+\(fn)" nil nil)
(autoload 'ffap-bindings "ffap" "\
Evaluate the forms in variable `ffap-bindings'.
;;;### (autoloads (file-cache-minibuffer-complete file-cache-add-directory-recursively
;;;;;; file-cache-add-directory-using-locate file-cache-add-directory-using-find
;;;;;; file-cache-add-file file-cache-add-directory-list file-cache-add-directory)
-;;;;;; "filecache" "filecache.el" (20355 10320))
+;;;;;; "filecache" "filecache.el" (20355 10021 546955 0))
;;; Generated autoloads from filecache.el
(autoload 'file-cache-add-directory "filecache" "\
;;;;;; copy-file-locals-to-dir-locals delete-dir-local-variable
;;;;;; add-dir-local-variable delete-file-local-variable-prop-line
;;;;;; add-file-local-variable-prop-line delete-file-local-variable
-;;;;;; add-file-local-variable) "files-x" "files-x.el" (20355 10320))
+;;;;;; add-file-local-variable) "files-x" "files-x.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from files-x.el
(autoload 'add-file-local-variable "files-x" "\
;;;***
\f
-;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20476
+;;;;;; 31768 298871 0))
;;; Generated autoloads from filesets.el
(autoload 'filesets-init "filesets" "\
;;;***
\f
-;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (20355 10320))
+;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from find-cmd.el
(autoload 'find-cmd "find-cmd" "\
;;;***
\f
;;;### (autoloads (find-grep-dired find-name-dired find-dired) "find-dired"
-;;;;;; "find-dired.el" (20355 10320))
+;;;;;; "find-dired.el" (20355 10021 546955 0))
;;; Generated autoloads from find-dired.el
(autoload 'find-dired "find-dired" "\
;;;***
\f
;;;### (autoloads (ff-mouse-find-other-file-other-window ff-mouse-find-other-file
-;;;;;; ff-find-other-file ff-get-other-file) "find-file" "find-file.el"
-;;;;;; (20355 10320))
+;;;;;; ff-find-other-file ff-get-other-file ff-special-constructs)
+;;;;;; "find-file" "find-file.el" (20387 44199 24128 0))
;;; Generated autoloads from find-file.el
(defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") lambda nil (buffer-substring (match-beginning 2) (match-end 2)))) "\
-*List of special constructs for `ff-treat-as-special' to recognize.
+List of special constructs recognized by `ff-treat-as-special'.
Each element, tried in order, has the form (REGEXP . EXTRACT).
If REGEXP matches the current line (from the beginning of the line),
`ff-treat-as-special' calls function EXTRACT with no args.
If EXTRACT returns nil, keep trying. Otherwise, return the
filename that EXTRACT returned.")
+(custom-autoload 'ff-special-constructs "find-file" t)
+
(autoload 'ff-get-other-file "find-file" "\
Find the header or source file corresponding to this file.
See also the documentation for `ff-find-other-file'.
;;;;;; find-variable find-variable-noselect find-function-other-frame
;;;;;; find-function-other-window find-function find-function-noselect
;;;;;; find-function-search-for-symbol find-library) "find-func"
-;;;;;; "emacs-lisp/find-func.el" (20355 10320))
+;;;;;; "emacs-lisp/find-func.el" (20497 6436 957082 0))
;;; Generated autoloads from emacs-lisp/find-func.el
(autoload 'find-library "find-func" "\
;;;***
\f
;;;### (autoloads (find-lisp-find-dired-filter find-lisp-find-dired-subdirectories
-;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (20355 10320))
+;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from find-lisp.el
(autoload 'find-lisp-find-dired "find-lisp" "\
;;;***
\f
;;;### (autoloads (finder-by-keyword finder-commentary finder-list-keywords)
-;;;;;; "finder" "finder.el" (20355 10320))
+;;;;;; "finder" "finder.el" (20355 10021 546955 0))
;;; Generated autoloads from finder.el
(autoload 'finder-list-keywords "finder" "\
;;;***
\f
;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl"
-;;;;;; "flow-ctrl.el" (20355 10320))
+;;;;;; "flow-ctrl.el" (20355 10021 546955 0))
;;; Generated autoloads from flow-ctrl.el
(autoload 'enable-flow-control "flow-ctrl" "\
;;;***
\f
;;;### (autoloads (fill-flowed fill-flowed-encode) "flow-fill" "gnus/flow-fill.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/flow-fill.el
(autoload 'fill-flowed-encode "flow-fill" "\
;;;***
\f
;;;### (autoloads (flymake-find-file-hook flymake-mode-off flymake-mode-on
-;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20544 40251))
+;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20482 39076
+;;;;;; 289170 0))
;;; Generated autoloads from progmodes/flymake.el
(autoload 'flymake-mode "flymake" "\
\f
;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off
;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode)
-;;;;;; "flyspell" "textmodes/flyspell.el" (20355 10320))
+;;;;;; "flyspell" "textmodes/flyspell.el" (20434 17809 692608 0))
;;; Generated autoloads from textmodes/flyspell.el
(autoload 'flyspell-prog-mode "flyspell" "\
\f
;;;### (autoloads (follow-delete-other-windows-and-split follow-mode
;;;;;; turn-off-follow-mode turn-on-follow-mode) "follow" "follow.el"
-;;;;;; (20355 10320))
+;;;;;; (20501 3499 284800 0))
;;; Generated autoloads from follow.el
(autoload 'turn-on-follow-mode "follow" "\
Only windows displayed in the same frame follow each other.
-If the variable `follow-intercept-processes' is non-nil, Follow mode
-will listen to the output of processes and redisplay accordingly.
-\(This is the default.)
-
This command runs the normal hook `follow-mode-hook'.
Keys specific to Follow mode:
the rightmost is selected. If ARG is nil, the leftmost window is
selected if the original window is the first one in the frame.
-To bind this command to a hotkey, place the following line
-in your `~/.emacs' file, replacing [f7] by your favorite key:
- (global-set-key [f7] 'follow-delete-other-windows-and-split)
-
\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from mail/footnote.el
(autoload 'footnote-mode "footnote" "\
;;;***
\f
;;;### (autoloads (forms-find-file-other-window forms-find-file forms-mode)
-;;;;;; "forms" "forms.el" (20355 10320))
+;;;;;; "forms" "forms.el" (20427 14766 970343 0))
;;; Generated autoloads from forms.el
(autoload 'forms-mode "forms" "\
;;;***
\f
;;;### (autoloads (fortran-mode) "fortran" "progmodes/fortran.el"
-;;;;;; (20355 10320))
+;;;;;; (20438 24024 724594 589000))
;;; Generated autoloads from progmodes/fortran.el
(autoload 'fortran-mode "fortran" "\
;;;***
\f
;;;### (autoloads (fortune fortune-to-signature fortune-compile fortune-from-region
-;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (20355 10320))
+;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from play/fortune.el
(autoload 'fortune-add-fortune "fortune" "\
;;;***
\f
;;;### (autoloads (gdb gdb-enable-debug) "gdb-mi" "progmodes/gdb-mi.el"
-;;;;;; (20501 7101))
+;;;;;; (20537 63402 936234 0))
;;; Generated autoloads from progmodes/gdb-mi.el
(defvar gdb-enable-debug nil "\
-Non-nil means record the process input and output in `gdb-debug-log'.")
+Non-nil if Gdb-Enable-Debug mode is enabled.
+See the command `gdb-enable-debug' for a description of this minor mode.")
+
+(custom-autoload 'gdb-enable-debug "gdb-mi" nil)
+
+(autoload 'gdb-enable-debug "gdb-mi" "\
+Toggle logging of transaction between Emacs and Gdb.
+The log is stored in `gdb-debug-log' as an alist with elements
+whose cons is send, send-item or recv and whose cdr is the string
+being transferred. This list may grow up to a size of
+`gdb-debug-log-max' after which the oldest element (at the end of
+the list) is deleted every time a new one is added (at the front).
-(custom-autoload 'gdb-enable-debug "gdb-mi" t)
+\(fn &optional ARG)" t nil)
(autoload 'gdb "gdb-mi" "\
Run gdb on program FILE in buffer *gud-FILE*.
;;;***
\f
;;;### (autoloads (generic-make-keywords-list generic-mode generic-mode-internal
-;;;;;; define-generic-mode) "generic" "emacs-lisp/generic.el" (20355
-;;;;;; 10320))
+;;;;;; define-generic-mode) "generic" "emacs-lisp/generic.el" (20406
+;;;;;; 8611 875037 0))
;;; Generated autoloads from emacs-lisp/generic.el
(defvar generic-mode-list nil "\
See the file generic-x.el for some examples of `define-generic-mode'.
-\(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil (quote macro))
+\(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil t)
(put 'define-generic-mode 'lisp-indent-function '1)
+(put 'define-generic-mode 'doc-string-elt '7)
+
(autoload 'generic-mode-internal "generic" "\
Go into the generic mode MODE.
;;;***
\f
;;;### (autoloads (glasses-mode) "glasses" "progmodes/glasses.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from progmodes/glasses.el
(autoload 'glasses-mode "glasses" "\
\f
;;;### (autoloads (gmm-tool-bar-from-list gmm-widget-p gmm-error
;;;;;; gmm-message gmm-regexp-concat) "gmm-utils" "gnus/gmm-utils.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gmm-utils.el
(autoload 'gmm-regexp-concat "gmm-utils" "\
;;;***
\f
;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server
-;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20370 38715))
+;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20503 45225
+;;;;;; 529939 0))
;;; Generated autoloads from gnus/gnus.el
(when (fboundp 'custom-autoload)
(custom-autoload 'gnus-select-method "gnus"))
;;;;;; gnus-agent-get-undownloaded-list gnus-agent-delete-group
;;;;;; gnus-agent-rename-group gnus-agent-possibly-save-gcc gnus-agentize
;;;;;; gnus-slave-unplugged gnus-plugged gnus-unplugged) "gnus-agent"
-;;;;;; "gnus/gnus-agent.el" (20355 10320))
+;;;;;; "gnus/gnus-agent.el" (20518 12580 46478 0))
;;; Generated autoloads from gnus/gnus-agent.el
(autoload 'gnus-unplugged "gnus-agent" "\
;;;***
\f
;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el"
-;;;;;; (20358 10456))
+;;;;;; (20522 9637 465791 0))
;;; Generated autoloads from gnus/gnus-art.el
(autoload 'gnus-article-prepare-display "gnus-art" "\
;;;***
\f
;;;### (autoloads (gnus-bookmark-bmenu-list gnus-bookmark-jump gnus-bookmark-set)
-;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (20355 10320))
+;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from gnus/gnus-bookmark.el
(autoload 'gnus-bookmark-set "gnus-bookmark" "\
;;;### (autoloads (gnus-cache-delete-group gnus-cache-rename-group
;;;;;; gnus-cache-generate-nov-databases gnus-cache-generate-active
;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from gnus/gnus-cache.el
(autoload 'gnus-jog-cache "gnus-cache" "\
;;;***
\f
;;;### (autoloads (gnus-delay-initialize gnus-delay-send-queue gnus-delay-article)
-;;;;;; "gnus-delay" "gnus/gnus-delay.el" (20355 10320))
+;;;;;; "gnus-delay" "gnus/gnus-delay.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-delay.el
(autoload 'gnus-delay-article "gnus-delay" "\
;;;***
\f
;;;### (autoloads (gnus-user-format-function-D gnus-user-format-function-d)
-;;;;;; "gnus-diary" "gnus/gnus-diary.el" (20355 10320))
+;;;;;; "gnus-diary" "gnus/gnus-diary.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-diary.el
(autoload 'gnus-user-format-function-d "gnus-diary" "\
;;;***
\f
;;;### (autoloads (turn-on-gnus-dired-mode) "gnus-dired" "gnus/gnus-dired.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-dired.el
(autoload 'turn-on-gnus-dired-mode "gnus-dired" "\
;;;***
\f
;;;### (autoloads (gnus-draft-reminder) "gnus-draft" "gnus/gnus-draft.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-draft.el
(autoload 'gnus-draft-reminder "gnus-draft" "\
\f
;;;### (autoloads (gnus-convert-png-to-face gnus-convert-face-to-png
;;;;;; gnus-face-from-file gnus-x-face-from-file gnus-insert-random-x-face-header
-;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (20355
-;;;;;; 10320))
+;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (20495
+;;;;;; 51111 757560 0))
;;; Generated autoloads from gnus/gnus-fun.el
(autoload 'gnus-random-x-face "gnus-fun" "\
;;;***
\f
;;;### (autoloads (gnus-treat-mail-gravatar gnus-treat-from-gravatar)
-;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (20355 10320))
+;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from gnus/gnus-gravatar.el
(autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\
;;;***
\f
;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group)
-;;;;;; "gnus-group" "gnus/gnus-group.el" (20355 10320))
+;;;;;; "gnus-group" "gnus/gnus-group.el" (20495 51111 757560 0))
;;; Generated autoloads from gnus/gnus-group.el
(autoload 'gnus-fetch-group "gnus-group" "\
;;;***
\f
;;;### (autoloads (gnus-html-prefetch-images gnus-article-html) "gnus-html"
-;;;;;; "gnus/gnus-html.el" (20355 10320))
+;;;;;; "gnus/gnus-html.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-html.el
(autoload 'gnus-article-html "gnus-html" "\
;;;***
\f
;;;### (autoloads (gnus-batch-score) "gnus-kill" "gnus/gnus-kill.el"
-;;;;;; (20355 10320))
+;;;;;; (20495 51111 757560 0))
;;; Generated autoloads from gnus/gnus-kill.el
(defalias 'gnus-batch-kill 'gnus-batch-score)
\f
;;;### (autoloads (gnus-mailing-list-mode gnus-mailing-list-insinuate
;;;;;; turn-on-gnus-mailing-list-mode) "gnus-ml" "gnus/gnus-ml.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-ml.el
(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" "\
\f
;;;### (autoloads (gnus-group-split-fancy gnus-group-split gnus-group-split-update
;;;;;; gnus-group-split-setup) "gnus-mlspl" "gnus/gnus-mlspl.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/gnus-mlspl.el
(autoload 'gnus-group-split-setup "gnus-mlspl" "\
;;;***
\f
;;;### (autoloads (gnus-button-reply gnus-button-mailto gnus-msg-mail)
-;;;;;; "gnus-msg" "gnus/gnus-msg.el" (20411 30131))
+;;;;;; "gnus-msg" "gnus/gnus-msg.el" (20533 5993 500881 0))
;;; Generated autoloads from gnus/gnus-msg.el
(autoload 'gnus-msg-mail "gnus-msg" "\
(define-mail-user-agent 'gnus-user-agent 'gnus-msg-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)
+;;;***
+\f
+;;;### (autoloads (gnus-notifications) "gnus-notifications" "gnus/gnus-notifications.el"
+;;;;;; (20544 36659 880486 0))
+;;; Generated autoloads from gnus/gnus-notifications.el
+
+(autoload 'gnus-notifications "gnus-notifications" "\
+Send a notification on new message.
+This check for new messages that are in group with a level lower
+or equal to `gnus-notifications-minimum-level' and send a
+notification using `notifications-notify' for it.
+
+This is typically a function to add in
+`gnus-after-getting-new-news-hook'
+
+\(fn)" nil nil)
+
;;;***
\f
;;;### (autoloads (gnus-treat-newsgroups-picon gnus-treat-mail-picon
;;;;;; gnus-treat-from-picon) "gnus-picon" "gnus/gnus-picon.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from gnus/gnus-picon.el
(autoload 'gnus-treat-from-picon "gnus-picon" "\
;;;;;; gnus-sorted-nintersection gnus-sorted-range-intersection
;;;;;; gnus-sorted-intersection gnus-intersection gnus-sorted-complement
;;;;;; gnus-sorted-ndifference gnus-sorted-difference) "gnus-range"
-;;;;;; "gnus/gnus-range.el" (20355 10320))
+;;;;;; "gnus/gnus-range.el" (20544 36659 880486 0))
;;; Generated autoloads from gnus/gnus-range.el
(autoload 'gnus-sorted-difference "gnus-range" "\
;;;***
\f
;;;### (autoloads (gnus-registry-install-hooks gnus-registry-initialize)
-;;;;;; "gnus-registry" "gnus/gnus-registry.el" (20355 10320))
+;;;;;; "gnus-registry" "gnus/gnus-registry.el" (20544 36659 880486
+;;;;;; 0))
;;; Generated autoloads from gnus/gnus-registry.el
(autoload 'gnus-registry-initialize "gnus-registry" "\
\f
;;;### (autoloads (gnus-sieve-article-add-rule gnus-sieve-generate
;;;;;; gnus-sieve-update) "gnus-sieve" "gnus/gnus-sieve.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from gnus/gnus-sieve.el
(autoload 'gnus-sieve-update "gnus-sieve" "\
;;;***
\f
;;;### (autoloads (gnus-update-format) "gnus-spec" "gnus/gnus-spec.el"
-;;;;;; (20355 10320))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from gnus/gnus-spec.el
(autoload 'gnus-update-format "gnus-spec" "\
;;;***
\f
;;;### (autoloads (gnus-declare-backend) "gnus-start" "gnus/gnus-start.el"
-;;;;;; (20358 10456))
+;;;;;; (20495 51111 757560 0))
;;; Generated autoloads from gnus/gnus-start.el
(autoload 'gnus-declare-backend "gnus-start" "\
;;;***
\f
;;;### (autoloads (gnus-summary-bookmark-jump) "gnus-sum" "gnus/gnus-sum.el"
-;;;;;; (20355 10320))
+;;;;;; (20540 39589 424586 0))
;;; Generated autoloads from gnus/gnus-sum.el
(autoload 'gnus-summary-bookmark-jump "gnus-sum" "\
;;;***
\f
;;;### (autoloads (gnus-sync-install-hooks gnus-sync-initialize)
-;;;;;; "gnus-sync" "gnus/gnus-sync.el" (20355 10320))
+;;;;;; "gnus-sync" "gnus/gnus-sync.el" (20545 57511 257469 0))
;;; Generated autoloads from gnus/gnus-sync.el
(autoload 'gnus-sync-initialize "gnus-sync" "\
;;;***
\f
;;;### (autoloads (gnus-add-configuration) "gnus-win" "gnus/gnus-win.el"
-;;;;;; (20355 10320))
+;;;;;; (20447 49522 409090 0))
;;; Generated autoloads from gnus/gnus-win.el
(autoload 'gnus-add-configuration "gnus-win" "\
;;;***
\f
;;;### (autoloads (gnutls-min-prime-bits) "gnutls" "net/gnutls.el"
-;;;;;; (20403 36019))
+;;;;;; (20476 31768 298871 0))
;;; Generated autoloads from net/gnutls.el
(defvar gnutls-min-prime-bits 256 "\
;;;***
\f
-;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (20355 10320))
+;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (20545 57511
+;;;;;; 257469 0))
;;; Generated autoloads from play/gomoku.el
(autoload 'gomoku "gomoku" "\
\f
;;;### (autoloads (goto-address-prog-mode goto-address-mode goto-address
;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from net/goto-addr.el
(define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1")
;;;***
\f
;;;### (autoloads (gravatar-retrieve-synchronously gravatar-retrieve)
-;;;;;; "gravatar" "gnus/gravatar.el" (20355 10320))
+;;;;;; "gravatar" "gnus/gravatar.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/gravatar.el
(autoload 'gravatar-retrieve "gravatar" "\
\f
;;;### (autoloads (zrgrep rgrep lgrep grep-find grep grep-mode grep-compute-defaults
;;;;;; grep-process-setup grep-setup-hook grep-find-command grep-command
-;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20366 41661))
+;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20369 14251
+;;;;;; 85829 0))
;;; Generated autoloads from progmodes/grep.el
(defvar grep-window-height nil "\
-*Number of lines in a grep window. If nil, use `compilation-window-height'.")
+Number of lines in a grep window. If nil, use `compilation-window-height'.")
(custom-autoload 'grep-window-height "grep" t)
;;;***
\f
-;;;### (autoloads (gs-load-image) "gs" "gs.el" (20355 10320))
+;;;### (autoloads (gs-load-image) "gs" "gs.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from gs.el
(autoload 'gs-load-image "gs" "\
;;;***
\f
;;;### (autoloads (gud-tooltip-mode gdb-script-mode jdb pdb perldb
-;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20355 10320))
+;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20537 63402
+;;;;;; 936234 0))
;;; Generated autoloads from progmodes/gud.el
(autoload 'gud-gdb "gud" "\
\(fn &optional ARG)" t nil)
+;;;***
+\f
+;;;### (autoloads (setf gv-define-simple-setter gv-define-setter
+;;;;;; gv--defun-declaration gv-define-expander gv-letplace gv-get)
+;;;;;; "gv" "emacs-lisp/gv.el" (20542 46798 773957 0))
+;;; Generated autoloads from emacs-lisp/gv.el
+
+(autoload 'gv-get "gv" "\
+Build the code that applies DO to PLACE.
+PLACE must be a valid generalized variable.
+DO must be a function; it will be called with 2 arguments: GETTER and SETTER,
+where GETTER is a (copyable) Elisp expression that returns the value of PLACE,
+and SETTER is a function which returns the code to set PLACE when called
+with a (not necessarily copyable) Elisp expression that returns the value to
+set it to.
+DO must return an Elisp expression.
+
+\(fn PLACE DO)" nil nil)
+
+(autoload 'gv-letplace "gv" "\
+Build the code manipulating the generalized variable PLACE.
+GETTER will be bound to a copyable expression that returns the value
+of PLACE.
+SETTER will be bound to a function that takes an expression V and returns
+and new expression that sets PLACE to V.
+BODY should return some Elisp expression E manipulating PLACE via GETTER
+and SETTER.
+The returned value will then be an Elisp expression that first evaluates
+all the parts of PLACE that can be evaluated and then runs E.
+
+\(fn (GETTER SETTER) PLACE &rest BODY)" nil t)
+
+(put 'gv-letplace 'lisp-indent-function '2)
+
+(autoload 'gv-define-expander "gv" "\
+Use HANDLER to handle NAME as a generalized var.
+NAME is a symbol: the name of a function, macro, or special form.
+HANDLER is a function which takes an argument DO followed by the same
+arguments as NAME. DO is a function as defined in `gv-get'.
+
+\(fn NAME HANDLER)" nil t)
+
+(put 'gv-define-expander 'lisp-indent-function '1)
+
+(autoload 'gv--defun-declaration "gv" "\
+
+
+\(fn SYMBOL NAME ARGS HANDLER &optional FIX)" nil nil)
+
+(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander)) defun-declarations-alist)
+
+(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter)) defun-declarations-alist)
+
+(autoload 'gv-define-setter "gv" "\
+Define a setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms.
+Assignments of VAL to (NAME ARGS...) are expanded by binding the argument
+forms (VAL ARGS...) according to ARGLIST, then executing BODY, which must
+return a Lisp form that does the assignment.
+The first arg in ARLIST (the one that receives VAL) receives an expression
+which can do arbitrary things, whereas the other arguments are all guaranteed
+to be pure and copyable. Example use:
+ (gv-define-setter aref (v a i) `(aset ,a ,i ,v))
+
+\(fn NAME ARGLIST &rest BODY)" nil t)
+
+(put 'gv-define-setter 'lisp-indent-function '2)
+
+(autoload 'gv-define-simple-setter "gv" "\
+Define a simple setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms. Assignments of VAL to (NAME ARGS...) are
+turned into calls of the form (SETTER ARGS... VAL).
+If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and
+instead the assignment is turned into (prog1 VAL (SETTER ARGS... VAL))
+so as to preserve the semantics of `setf'.
+
+\(fn NAME SETTER &optional FIX-RETURN)" nil t)
+
+(autoload 'setf "gv" "\
+Set each PLACE to the value of its VAL.
+This is a generalized version of `setq'; the PLACEs may be symbolic
+references such as (car x) or (aref x i), as well as plain symbols.
+For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y).
+The return value is the last VAL in the list.
+
+\(fn PLACE VAL PLACE VAL ...)" nil t)
+
+(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+
;;;***
\f
;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from play/handwrite.el
(autoload 'handwrite "handwrite" "\
;;;***
\f
;;;### (autoloads (hanoi-unix-64 hanoi-unix hanoi) "hanoi" "play/hanoi.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from play/hanoi.el
(autoload 'hanoi "hanoi" "\
\f
;;;### (autoloads (mail-check-payment mail-add-payment-async mail-add-payment
;;;;;; hashcash-verify-payment hashcash-insert-payment-async hashcash-insert-payment)
-;;;;;; "hashcash" "mail/hashcash.el" (20355 10320))
+;;;;;; "hashcash" "mail/hashcash.el" (20355 10021 546955 0))
;;; Generated autoloads from mail/hashcash.el
(autoload 'hashcash-insert-payment "hashcash" "\
;;;### (autoloads (scan-buf-previous-region scan-buf-next-region
;;;;;; scan-buf-move-to-region help-at-pt-display-when-idle help-at-pt-set-timer
;;;;;; help-at-pt-cancel-timer display-local-help help-at-pt-kbd-string
-;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (20355 10320))
+;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from help-at-pt.el
(autoload 'help-at-pt-string "help-at-pt" "\
;;;### (autoloads (doc-file-to-info doc-file-to-man describe-categories
;;;;;; describe-syntax describe-variable variable-at-point describe-function-1
;;;;;; find-lisp-object-file-name help-C-file-name describe-function)
-;;;;;; "help-fns" "help-fns.el" (20355 10320))
+;;;;;; "help-fns" "help-fns.el" (20532 45476 981297 0))
;;; Generated autoloads from help-fns.el
(autoload 'describe-function "help-fns" "\
;;;***
\f
;;;### (autoloads (three-step-help) "help-macro" "help-macro.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from help-macro.el
(defvar three-step-help nil "\
;;;***
\f
-;;;### (autoloads (help-xref-on-pp help-insert-xref-button help-xref-button
-;;;;;; help-make-xrefs help-buffer help-setup-xref help-mode-finish
-;;;;;; help-mode-setup help-mode) "help-mode" "help-mode.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (help-bookmark-jump help-xref-on-pp help-insert-xref-button
+;;;;;; help-xref-button help-make-xrefs help-buffer help-setup-xref
+;;;;;; help-mode-finish help-mode-setup help-mode) "help-mode" "help-mode.el"
+;;;;;; (20510 18478 782378 0))
;;; Generated autoloads from help-mode.el
(autoload 'help-mode "help-mode" "\
\(fn FROM TO)" nil nil)
+(autoload 'help-bookmark-jump "help-mode" "\
+Jump to help-mode bookmark BOOKMARK.
+Handler function for record returned by `help-bookmark-make-record'.
+BOOKMARK is a bookmark name or a bookmark record.
+
+\(fn BOOKMARK)" nil nil)
+
;;;***
\f
;;;### (autoloads (Helper-help Helper-describe-bindings) "helper"
-;;;;;; "emacs-lisp/helper.el" (20355 10320))
+;;;;;; "emacs-lisp/helper.el" (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/helper.el
(autoload 'Helper-describe-bindings "helper" "\
;;;***
\f
;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl"
-;;;;;; "hexl.el" (20355 10320))
+;;;;;; "hexl.el" (20523 62082 997685 0))
;;; Generated autoloads from hexl.el
(autoload 'hexl-mode "hexl" "\
Each line in the buffer has an \"address\" (displayed in hexadecimal)
representing the offset into the file that the characters on this line
are at and 16 characters from the file (displayed as hexadecimal
-values grouped every 16 bits) and as their ASCII values.
+values grouped every `hexl-bits' bits) and as their ASCII values.
If any of the characters (displayed as ASCII characters) are
unprintable (control or meta characters) they will be replaced as
;;;### (autoloads (hi-lock-write-interactive-patterns hi-lock-unface-buffer
;;;;;; hi-lock-face-phrase-buffer hi-lock-face-buffer hi-lock-line-face-buffer
;;;;;; global-hi-lock-mode hi-lock-mode) "hi-lock" "hi-lock.el"
-;;;;;; (20355 10320))
+;;;;;; (20522 9637 465791 0))
;;; Generated autoloads from hi-lock.el
(autoload 'hi-lock-mode "hi-lock" "\
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.
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'.
\(fn &optional ARG)" t nil)
(autoload 'hi-lock-line-face-buffer "hi-lock" "\
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.
-\\<minibuffer-local-map>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.
\(fn REGEXP &optional FACE)" t nil)
(autoload 'hi-lock-face-buffer "hi-lock" "\
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.
-\\<minibuffer-local-map>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.
\(fn REGEXP &optional FACE)" t nil)
(autoload 'hi-lock-face-phrase-buffer "hi-lock" "\
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.
+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.
+
\(fn REGEXP &optional FACE)" t nil)
(defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
(autoload 'hi-lock-unface-buffer "hi-lock" "\
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'.)
-\\<minibuffer-local-must-match-map>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.
\(fn REGEXP)" t nil)
;;;***
\f
;;;### (autoloads (hide-ifdef-mode) "hideif" "progmodes/hideif.el"
-;;;;;; (20532 49081))
+;;;;;; (20541 6907 775259 0))
;;; Generated autoloads from progmodes/hideif.el
(autoload 'hide-ifdef-mode "hideif" "\
;;;***
\f
;;;### (autoloads (turn-off-hideshow hs-minor-mode) "hideshow" "progmodes/hideshow.el"
-;;;;;; (20531 28218))
+;;;;;; (20541 6907 775259 0))
;;; Generated autoloads from progmodes/hideshow.el
(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\
-*Alist for initializing the hideshow variables for different modes.
+Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
;;;;;; highlight-changes-previous-change highlight-changes-next-change
;;;;;; highlight-changes-remove-highlight highlight-changes-visible-mode
;;;;;; highlight-changes-mode) "hilit-chg" "hilit-chg.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from hilit-chg.el
(autoload 'highlight-changes-mode "hilit-chg" "\
;;;;;; hippie-expand-ignore-buffers hippie-expand-max-buffers hippie-expand-no-restriction
;;;;;; hippie-expand-dabbrev-as-symbol hippie-expand-dabbrev-skip-space
;;;;;; hippie-expand-verbose hippie-expand-try-functions-list) "hippie-exp"
-;;;;;; "hippie-exp.el" (20355 10320))
+;;;;;; "hippie-exp.el" (20495 51111 757560 0))
;;; Generated autoloads from hippie-exp.el
(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose.
-\(fn TRY-LIST &optional VERBOSE)" nil (quote macro))
+\(fn TRY-LIST &optional VERBOSE)" nil t)
;;;***
\f
;;;### (autoloads (global-hl-line-mode hl-line-mode) "hl-line" "hl-line.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from hl-line.el
(autoload 'hl-line-mode "hl-line" "\
;;;;;; holiday-bahai-holidays holiday-islamic-holidays holiday-christian-holidays
;;;;;; holiday-hebrew-holidays holiday-other-holidays holiday-local-holidays
;;;;;; holiday-oriental-holidays holiday-general-holidays) "holidays"
-;;;;;; "calendar/holidays.el" (20542 48904))
+;;;;;; "calendar/holidays.el" (20530 32124 107724 973000))
;;; Generated autoloads from calendar/holidays.el
(define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1")
(define-obsolete-variable-alias 'christian-holidays 'holiday-christian-holidays "23.1")
-(defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Christmas (Julian calendar)") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\
+(defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Eastern Orthodox Christmas") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\
Christian holidays.
See the documentation for `calendar-holidays' for details.")
;;;***
\f
;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from gnus/html2text.el
(autoload 'html2text "html2text" "\
;;;***
\f
;;;### (autoloads (htmlfontify-copy-and-link-dir htmlfontify-buffer)
-;;;;;; "htmlfontify" "htmlfontify.el" (20355 10320))
+;;;;;; "htmlfontify" "htmlfontify.el" (20355 10021 546955 0))
;;; Generated autoloads from htmlfontify.el
(autoload 'htmlfontify-buffer "htmlfontify" "\
;;;***
\f
;;;### (autoloads (define-ibuffer-filter define-ibuffer-op define-ibuffer-sorter
-;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (20355
-;;;;;; 10320))
+;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from ibuf-macs.el
(autoload 'define-ibuffer-column "ibuf-macs" "\
change its definition, you should explicitly call
`ibuffer-recompile-formats'.
-\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil (quote macro))
-
-(put 'define-ibuffer-column 'lisp-indent-function 'defun)
+\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil nil)
(autoload 'define-ibuffer-sorter "ibuf-macs" "\
Define a method of sorting named NAME.
buffer object, and `b' bound to another. BODY should return a non-nil
value if and only if `a' is \"less than\" `b'.
-\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil (quote macro))
-
-(put 'define-ibuffer-sorter 'lisp-indent-function '1)
+\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil nil)
(autoload 'define-ibuffer-op "ibuf-macs" "\
Generate a function which operates on a buffer.
COMPLEX means this function is special; see the source code of this
macro for exactly what it does.
-\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" nil (quote macro))
-
-(put 'define-ibuffer-op 'lisp-indent-function '2)
+\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" nil nil)
(autoload 'define-ibuffer-filter "ibuf-macs" "\
Define a filter named NAME.
will be evaluated with BUF bound to the buffer object, and QUALIFIER
bound to the current value of the filter.
-\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil (quote macro))
-
-(put 'define-ibuffer-filter 'lisp-indent-function '2)
+\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil nil)
;;;***
\f
;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers)
-;;;;;; "ibuffer" "ibuffer.el" (20454 63593))
+;;;;;; "ibuffer" "ibuffer.el" (20542 46798 773957 0))
;;; Generated autoloads from ibuffer.el
(autoload 'ibuffer-list-buffers "ibuffer" "\
\f
;;;### (autoloads (icalendar-import-buffer icalendar-import-file
;;;;;; icalendar-export-region icalendar-export-file) "icalendar"
-;;;;;; "calendar/icalendar.el" (20355 10320))
+;;;;;; "calendar/icalendar.el" (20434 17809 692608 0))
;;; Generated autoloads from calendar/icalendar.el
(autoload 'icalendar-export-file "icalendar" "\
;;;***
\f
-;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (20453
+;;;;;; 5437 764254 0))
;;; Generated autoloads from icomplete.el
(defvar icomplete-mode nil "\
;;;***
\f
-;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (20355 10320))
+;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from progmodes/icon.el
(autoload 'icon-mode "icon" "\
;;;***
\f
;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el"
-;;;;;; (20355 10320))
+;;;;;; (20427 14766 970343 0))
;;; Generated autoloads from progmodes/idlw-shell.el
(autoload 'idlwave-shell "idlw-shell" "\
;;;***
\f
;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el"
-;;;;;; (20355 10320))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from progmodes/idlwave.el
(autoload 'idlwave-mode "idlwave" "\
;;;;;; ido-find-alternate-file ido-find-file-other-window ido-find-file
;;;;;; ido-find-file-in-dir ido-switch-buffer-other-frame ido-insert-buffer
;;;;;; ido-kill-buffer ido-display-buffer ido-switch-buffer-other-window
-;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20355
-;;;;;; 10320))
+;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20495
+;;;;;; 51111 757560 0))
;;; Generated autoloads from ido.el
(defvar ido-mode nil "\
RET Select the buffer at the front of the list of matches. If the
list is empty, possibly prompt to create new buffer.
-\\[ido-select-text] Select the current prompt as the buffer.
-If no buffer is found, prompt for a new one.
+\\[ido-select-text] Use the current input string verbatim.
\\[ido-next-match] Put the first element at the end of the list.
\\[ido-prev-match] Put the last element at the start of the list.
RET Select the file at the front of the list of matches. If the
list is empty, possibly prompt to create new file.
-\\[ido-select-text] Select the current prompt as the buffer or file.
-If no buffer or file is found, prompt for a new one.
+\\[ido-select-text] Use the current input string verbatim.
\\[ido-next-match] Put the first element at the end of the list.
\\[ido-prev-match] Put the last element at the start of the list.
matches all files. If there is only one match, select that file.
If there is no common suffix, show a list of all matching files
in a separate window.
+\\[ido-magic-delete-char] Open the specified directory in Dired mode.
\\[ido-edit-input] Edit input string (including directory).
\\[ido-prev-work-directory] or \\[ido-next-work-directory] go to previous/next directory in work directory history.
\\[ido-merge-work-directories] search for file in the work directory history.
;;;***
\f
-;;;### (autoloads (ielm) "ielm" "ielm.el" (20355 10320))
+;;;### (autoloads (ielm) "ielm" "ielm.el" (20355 10021 546955 0))
;;; Generated autoloads from ielm.el
(autoload 'ielm "ielm" "\
;;;***
\f
-;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (20355 10320))
+;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from iimage.el
(define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1")
;;;;;; create-image image-type-auto-detected-p image-type-available-p
;;;;;; image-type image-type-from-file-name image-type-from-file-header
;;;;;; image-type-from-buffer image-type-from-data) "image" "image.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from image.el
(autoload 'image-type-from-data "image" "\
(defimage test-image ((:type xpm :file \"~/test1.xpm\")
(:type xbm :file \"~/test1.xbm\")))
-\(fn SYMBOL SPECS &optional DOC)" nil (quote macro))
+\(fn SYMBOL SPECS &optional DOC)" nil t)
(put 'defimage 'doc-string-elt '3)
(autoload 'imagemagick-register-types "image" "\
Register file types that can be handled by ImageMagick.
-This registers the ImageMagick types listed in `imagemagick-types',
-excluding those listed in `imagemagick-types-inhibit'.
+This function is called at startup, after loading the init file.
+It registers the ImageMagick types returned by `imagemagick-filter-types'.
Registered image types are added to `auto-mode-alist', so that
Emacs visits them in Image mode. They are also added to
`image-type-file-name-regexps', so that the `image-type' function
recognizes these files as having image type `imagemagick'.
-If Emacs is compiled without ImageMagick support, do nothing.
+If Emacs is compiled without ImageMagick support, this does nothing.
\(fn)" nil nil)
;;;;;; image-dired-jump-thumbnail-buffer image-dired-delete-tag
;;;;;; image-dired-tag-files image-dired-show-all-from-dir image-dired-display-thumbs
;;;;;; image-dired-dired-with-window-configuration image-dired-dired-toggle-marked-thumbs)
-;;;;;; "image-dired" "image-dired.el" (20355 10320))
+;;;;;; "image-dired" "image-dired.el" (20478 3673 653810 0))
;;; Generated autoloads from image-dired.el
(autoload 'image-dired-dired-toggle-marked-thumbs "image-dired" "\
\f
;;;### (autoloads (auto-image-file-mode insert-image-file image-file-name-regexp
;;;;;; image-file-name-regexps image-file-name-extensions) "image-file"
-;;;;;; "image-file.el" (20355 10320))
+;;;;;; "image-file.el" (20355 10021 546955 0))
;;; Generated autoloads from image-file.el
(defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\
;;;***
\f
;;;### (autoloads (image-bookmark-jump image-mode-as-text image-minor-mode
-;;;;;; image-mode) "image-mode" "image-mode.el" (20355 10320))
+;;;;;; image-mode) "image-mode" "image-mode.el" (20476 31768 298871
+;;;;;; 0))
;;; Generated autoloads from image-mode.el
(autoload 'image-mode "image-mode" "\
;;;***
\f
;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar
-;;;;;; imenu-sort-function) "imenu" "imenu.el" (20358 10456))
+;;;;;; imenu-sort-function) "imenu" "imenu.el" (20511 39332 974340
+;;;;;; 0))
;;; Generated autoloads from imenu.el
(defvar imenu-sort-function nil "\
(custom-autoload 'imenu-sort-function "imenu" t)
(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.")
(put 'imenu-generic-expression 'risky-local-variable t)
(make-variable-buffer-local 'imenu-generic-expression)
\f
;;;### (autoloads (indian-2-column-to-ucs-region in-is13194-pre-write-conversion
;;;;;; in-is13194-post-read-conversion indian-compose-string indian-compose-region)
-;;;;;; "ind-util" "language/ind-util.el" (20355 10320))
+;;;;;; "ind-util" "language/ind-util.el" (20355 10021 546955 0))
;;; Generated autoloads from language/ind-util.el
(autoload 'indian-compose-region "ind-util" "\
\f
;;;### (autoloads (inferior-lisp inferior-lisp-prompt inferior-lisp-load-command
;;;;;; inferior-lisp-program inferior-lisp-filter-regexp) "inf-lisp"
-;;;;;; "progmodes/inf-lisp.el" (20355 10320))
+;;;;;; "progmodes/inf-lisp.el" (20355 10021 546955 0))
;;; Generated autoloads from progmodes/inf-lisp.el
(defvar inferior-lisp-filter-regexp (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'") "\
-*What not to save on inferior Lisp's input history.
+What not to save on inferior Lisp's input history.
Input matching this regexp is not saved on the input history in Inferior Lisp
mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
\(as in :a, :c, etc.)")
(custom-autoload 'inferior-lisp-filter-regexp "inf-lisp" t)
(defvar inferior-lisp-program (purecopy "lisp") "\
-*Program name for invoking an inferior Lisp in Inferior Lisp mode.")
+Program name for invoking an inferior Lisp in Inferior Lisp mode.")
(custom-autoload 'inferior-lisp-program "inf-lisp" t)
(defvar inferior-lisp-load-command (purecopy "(load \"%s\")\n") "\
-*Format-string for building a Lisp expression to load a file.
+Format-string for building a Lisp expression to load a file.
This format string should use `%s' to substitute a file name
and should result in a Lisp expression that will command the inferior Lisp
to load that file. The default works acceptably on most Lisps.
(custom-autoload 'inferior-lisp-prompt "inf-lisp" t)
(defvar inferior-lisp-mode-hook 'nil "\
-*Hook for customizing Inferior Lisp mode.")
+Hook for customizing Inferior Lisp mode.")
(autoload 'inferior-lisp "inf-lisp" "\
Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
;;;### (autoloads (info-display-manual Info-bookmark-jump Info-speedbar-browser
;;;;;; Info-goto-emacs-key-command-node Info-goto-emacs-command-node
;;;;;; Info-mode info-finder info-apropos Info-index Info-directory
-;;;;;; Info-on-current-buffer info-standalone info-emacs-manual
-;;;;;; info info-other-window) "info" "info.el" (20355 10320))
+;;;;;; Info-on-current-buffer info-standalone info-emacs-bug info-emacs-manual
+;;;;;; info info-other-window) "info" "info.el" (20540 39589 424586
+;;;;;; 0))
;;; Generated autoloads from info.el
+(defcustom Info-default-directory-list (let* ((config-dir (file-name-as-directory (or (and (featurep 'ns) (let ((dir (expand-file-name "../info" data-directory))) (if (file-directory-p dir) dir))) configure-info-directory))) (prefixes (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) (suffixes '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" "emacs/" "lib/" "lib/emacs/")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) (let ((dirs (mapcar (lambda (sfx) (concat pfx sfx "info/")) suffixes))) (prune-directory-list dirs))) prefixes))) (dirs (if (member config-dir standard-info-dirs) (nconc standard-info-dirs (list config-dir)) (cons config-dir standard-info-dirs)))) (if (not (eq system-type 'windows-nt)) dirs (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (cond ((file-exists-p dir1) (append dirs (list dir1))) ((file-exists-p dir2) (append dirs (list dir2))) (t dirs))))) "\
+Default list of directories to search for Info documentation files.
+They are searched in the order they are given in the list.
+Therefore, the directory of Info files that come with Emacs
+normally should come last (so that local files override standard ones),
+unless Emacs is installed into a non-standard directory. In the latter
+case, the directory of Info files that come with Emacs should be
+first in this list.
+
+Once Info is started, the list of directories to search
+comes from the variable `Info-directory-list'.
+This variable `Info-default-directory-list' is used as the default
+for initializing `Info-directory-list' when Info is started, unless
+the environment variable INFOPATH is set.
+
+Although this is a customizable variable, that is mainly for technical
+reasons. Normally, you should either set INFOPATH or customize
+`Info-additional-directory-list', rather than changing this variable." :initialize (quote custom-initialize-delay) :type (quote (repeat directory)) :group (quote info))
+
(autoload 'info-other-window "info" "\
Like `info' but show the Info buffer in another window.
\(fn)" t nil)
+(autoload 'info-emacs-bug "info" "\
+Display the \"Reporting Bugs\" section of the Emacs manual in Info mode.
+
+\(fn)" t nil)
+
(autoload 'info-standalone "info" "\
Run Emacs as a standalone Info reader.
Usage: emacs -f info-standalone [filename]
\f
;;;### (autoloads (info-complete-file info-complete-symbol info-lookup-file
;;;;;; info-lookup-symbol info-lookup-reset) "info-look" "info-look.el"
-;;;;;; (20355 10320))
+;;;;;; (20474 44971 970015 0))
;;; Generated autoloads from info-look.el
(autoload 'info-lookup-reset "info-look" "\
\f
;;;### (autoloads (info-xref-docstrings info-xref-check-all-custom
;;;;;; info-xref-check-all info-xref-check) "info-xref" "info-xref.el"
-;;;;;; (20355 10320))
+;;;;;; (20476 31768 298871 0))
;;; Generated autoloads from info-xref.el
(autoload 'info-xref-check "info-xref" "\
;;;***
\f
;;;### (autoloads (batch-info-validate Info-validate Info-split Info-split-threshold
-;;;;;; Info-tagify) "informat" "informat.el" (20355 10320))
+;;;;;; Info-tagify) "informat" "informat.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from informat.el
(autoload 'Info-tagify "informat" "\
\f
;;;### (autoloads (isearch-process-search-multibyte-characters isearch-toggle-input-method
;;;;;; isearch-toggle-specified-input-method) "isearch-x" "international/isearch-x.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from international/isearch-x.el
(autoload 'isearch-toggle-specified-input-method "isearch-x" "\
;;;***
\f
;;;### (autoloads (isearchb-activate) "isearchb" "isearchb.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from isearchb.el
(autoload 'isearchb-activate "isearchb" "\
;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only
;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso
;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt"
-;;;;;; "international/iso-cvt.el" (20355 10320))
+;;;;;; "international/iso-cvt.el" (20355 10021 546955 0))
;;; Generated autoloads from international/iso-cvt.el
(autoload 'iso-spanish "iso-cvt" "\
;;;***
\f
;;;### (autoloads nil "iso-transl" "international/iso-transl.el"
-;;;;;; (20355 10320))
+;;;;;; (20486 36135 22104 0))
;;; Generated autoloads from international/iso-transl.el
- (or key-translation-map (setq key-translation-map (make-sparse-keymap)))
(define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map)
(autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap)
;;;;;; ispell-complete-word ispell-continue ispell-buffer ispell-comments-and-strings
;;;;;; ispell-region ispell-change-dictionary ispell-kill-ispell
;;;;;; ispell-help ispell-pdict-save ispell-word ispell-personal-dictionary)
-;;;;;; "ispell" "textmodes/ispell.el" (20355 10320))
+;;;;;; "ispell" "textmodes/ispell.el" (20458 56750 651721 0))
;;; Generated autoloads from textmodes/ispell.el
(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive))))
(defvar ispell-personal-dictionary nil "\
-*File name of your personal spelling dictionary, or nil.
+File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary, (\"~/.ispell_DICTNAME\" for ispell or
\"~/.aspell.LANG.pws\" for aspell) is used, where DICTNAME is the name of your
default dictionary and LANG the two letter language code.")
(defvar ispell-menu-map-needed (and (not ispell-menu-map) (not (featurep 'xemacs)) 'reload))
-(if ispell-menu-map-needed (progn (setq ispell-menu-map (make-sparse-keymap "Spell")) (define-key ispell-menu-map [ispell-change-dictionary] `(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary :help ,(purecopy "Supply explicit dictionary file name"))) (define-key ispell-menu-map [ispell-kill-ispell] `(menu-item ,(purecopy "Kill Process") ispell-kill-ispell :enable (and (boundp 'ispell-process) ispell-process (eq (ispell-process-status) 'run)) :help ,(purecopy "Terminate Ispell subprocess"))) (define-key ispell-menu-map [ispell-pdict-save] `(menu-item ,(purecopy "Save Dictionary") (lambda nil (interactive) (ispell-pdict-save t t)) :help ,(purecopy "Save personal dictionary"))) (define-key ispell-menu-map [ispell-customize] `(menu-item ,(purecopy "Customize...") (lambda nil (interactive) (customize-group 'ispell)) :help ,(purecopy "Customize spell checking options"))) (define-key ispell-menu-map [ispell-help] `(menu-item ,(purecopy "Help") (lambda nil (interactive) (describe-function 'ispell-help)) :help ,(purecopy "Show standard Ispell keybindings and commands"))) (define-key ispell-menu-map [flyspell-mode] `(menu-item ,(purecopy "Automatic spell checking (Flyspell)") flyspell-mode :help ,(purecopy "Check spelling while you edit the text") :button (:toggle bound-and-true-p flyspell-mode))) (define-key ispell-menu-map [ispell-complete-word] `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor")))))
+(if ispell-menu-map-needed (progn (setq ispell-menu-map (make-sparse-keymap "Spell")) (define-key ispell-menu-map [ispell-change-dictionary] `(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary :help ,(purecopy "Supply explicit dictionary file name"))) (define-key ispell-menu-map [ispell-kill-ispell] `(menu-item ,(purecopy "Kill Process") (lambda nil (interactive) (ispell-kill-ispell nil 'clear)) :enable (and (boundp 'ispell-process) ispell-process (eq (ispell-process-status) 'run)) :help ,(purecopy "Terminate Ispell subprocess"))) (define-key ispell-menu-map [ispell-pdict-save] `(menu-item ,(purecopy "Save Dictionary") (lambda nil (interactive) (ispell-pdict-save t t)) :help ,(purecopy "Save personal dictionary"))) (define-key ispell-menu-map [ispell-customize] `(menu-item ,(purecopy "Customize...") (lambda nil (interactive) (customize-group 'ispell)) :help ,(purecopy "Customize spell checking options"))) (define-key ispell-menu-map [ispell-help] `(menu-item ,(purecopy "Help") (lambda nil (interactive) (describe-function 'ispell-help)) :help ,(purecopy "Show standard Ispell keybindings and commands"))) (define-key ispell-menu-map [flyspell-mode] `(menu-item ,(purecopy "Automatic spell checking (Flyspell)") flyspell-mode :help ,(purecopy "Check spelling while you edit the text") :button (:toggle bound-and-true-p flyspell-mode))) (define-key ispell-menu-map [ispell-complete-word] `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor")))))
(if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-continue] `(menu-item ,(purecopy "Continue Spell-Checking") ispell-continue :enable (and (boundp 'ispell-region-end) (marker-position ispell-region-end) (equal (marker-buffer ispell-region-end) (current-buffer))) :help ,(purecopy "Continue spell checking last region"))) (define-key ispell-menu-map [ispell-word] `(menu-item ,(purecopy "Spell-Check Word") ispell-word :help ,(purecopy "Spell-check word at cursor"))) (define-key ispell-menu-map [ispell-comments-and-strings] `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings :help ,(purecopy "Spell-check only comments and strings")))))
(KEY FUNCTION ARGS) - FUNCTION called with ARGS returns end of region.")
(defvar ispell-tex-skip-alists (purecopy '((("\\\\addcontentsline" ispell-tex-arg-end 2) ("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end) ("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end) ("\\\\bibliographystyle" ispell-tex-arg-end) ("\\\\makebox" ispell-tex-arg-end 0) ("\\\\e?psfig" ispell-tex-arg-end) ("\\\\document\\(class\\|style\\)" . "\\\\begin[ \n]*{[ \n]*document[ \n]*}")) (("\\(figure\\|table\\)\\*?" ispell-tex-arg-end 0) ("list" ispell-tex-arg-end 2) ("program" . "\\\\end[ \n]*{[ \n]*program[ \n]*}") ("verbatim\\*?" . "\\\\end[ \n]*{[ \n]*verbatim\\*?[ \n]*}")))) "\
-*Lists of regions to be skipped in TeX mode.
+Lists of regions to be skipped in TeX mode.
First list is used raw.
Second list has key placed inside \\begin{}.
for skipping in latex mode.")
(defconst ispell-html-skip-alists '(("<[cC][oO][dD][eE]\\>[^>]*>" "</[cC][oO][dD][eE]*>") ("<[sS][cC][rR][iI][pP][tT]\\>[^>]*>" "</[sS][cC][rR][iI][pP][tT]>") ("<[aA][pP][pP][lL][eE][tT]\\>[^>]*>" "</[aA][pP][pP][lL][eE][tT]>") ("<[vV][eE][rR][bB]\\>[^>]*>" "<[vV][eE][rR][bB]\\>[^>]*>") ("<[tT][tT]/" "/") ("<[^ \n>]" ">") ("&[^ \n;]" "[; \n]")) "\
-*Lists of start and end keys to skip in HTML buffers.
+Lists of start and end keys to skip in HTML buffers.
Same format as `ispell-skip-region-alist'.
Note - substrings of other matches must come last
(e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").")
(autoload 'ispell-kill-ispell "ispell" "\
Kill current Ispell process (so that you may start a fresh one).
With NO-ERROR, just return non-nil if there was no Ispell running.
+With CLEAR, buffer session localwords are cleaned.
-\(fn &optional NO-ERROR)" t nil)
+\(fn &optional NO-ERROR CLEAR)" t nil)
(autoload 'ispell-change-dictionary "ispell" "\
Change to dictionary DICT for Ispell.
;;;***
\f
-;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20495
+;;;;;; 51111 757560 0))
;;; Generated autoloads from iswitchb.el
(defvar iswitchb-mode nil "\
;;;### (autoloads (read-hiragana-string japanese-zenkaku-region japanese-hankaku-region
;;;;;; japanese-hiragana-region japanese-katakana-region japanese-zenkaku
;;;;;; japanese-hankaku japanese-hiragana japanese-katakana setup-japanese-environment-internal)
-;;;;;; "japan-util" "language/japan-util.el" (20355 10320))
+;;;;;; "japan-util" "language/japan-util.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from language/japan-util.el
(autoload 'setup-japanese-environment-internal "japan-util" "\
;;;***
\f
;;;### (autoloads (jka-compr-uninstall jka-compr-handler) "jka-compr"
-;;;;;; "jka-compr.el" (20355 10320))
+;;;;;; "jka-compr.el" (20355 10021 546955 0))
;;; Generated autoloads from jka-compr.el
(defvar jka-compr-inhibit nil "\
;;;***
\f
-;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20355 10320))
+;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20532 45476 981297
+;;;;;; 0))
;;; Generated autoloads from progmodes/js.el
(autoload 'js-mode "js" "\
\f
;;;### (autoloads (keypad-setup keypad-numlock-shifted-setup keypad-shifted-setup
;;;;;; keypad-numlock-setup keypad-setup) "keypad" "emulation/keypad.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emulation/keypad.el
(defvar keypad-setup nil "\
;;;***
\f
;;;### (autoloads (kinsoku) "kinsoku" "international/kinsoku.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from international/kinsoku.el
(autoload 'kinsoku "kinsoku" "\
;;;***
\f
;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from international/kkc.el
(defvar kkc-after-update-conversion-functions nil "\
;;;### (autoloads (kmacro-end-call-mouse kmacro-end-and-call-macro
;;;;;; kmacro-end-or-call-macro kmacro-start-macro-or-insert-counter
;;;;;; kmacro-call-macro kmacro-end-macro kmacro-start-macro kmacro-exec-ring-item)
-;;;;;; "kmacro" "kmacro.el" (20355 10320))
+;;;;;; "kmacro" "kmacro.el" (20471 22929 875294 592000))
;;; Generated autoloads from kmacro.el
(global-set-key "\C-x(" 'kmacro-start-macro)
(global-set-key "\C-x)" 'kmacro-end-macro)
;;;***
\f
;;;### (autoloads (setup-korean-environment-internal) "korea-util"
-;;;;;; "language/korea-util.el" (20355 10320))
+;;;;;; "language/korea-util.el" (20501 3499 284800 0))
;;; Generated autoloads from language/korea-util.el
(defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\
-*The kind of Korean keyboard for Korean input method.
+The kind of Korean keyboard for Korean input method.
\"\" for 2, \"3\" for 3.")
(autoload 'setup-korean-environment-internal "korea-util" "\
;;;***
\f
;;;### (autoloads (landmark landmark-test-run) "landmark" "play/landmark.el"
-;;;;;; (20355 10320))
+;;;;;; (20545 57511 257469 0))
;;; Generated autoloads from play/landmark.el
(defalias 'landmark-repeat 'landmark-test-run)
\f
;;;### (autoloads (lao-compose-region lao-composition-function lao-transcribe-roman-to-lao-string
;;;;;; lao-transcribe-single-roman-syllable-to-lao lao-compose-string)
-;;;;;; "lao-util" "language/lao-util.el" (20355 10320))
+;;;;;; "lao-util" "language/lao-util.el" (20355 10021 546955 0))
;;; Generated autoloads from language/lao-util.el
(autoload 'lao-compose-string "lao-util" "\
\f
;;;### (autoloads (latexenc-find-file-coding-system latexenc-coding-system-to-inputenc
;;;;;; latexenc-inputenc-to-coding-system latex-inputenc-coding-alist)
-;;;;;; "latexenc" "international/latexenc.el" (20355 10320))
+;;;;;; "latexenc" "international/latexenc.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from international/latexenc.el
(defvar latex-inputenc-coding-alist (purecopy '(("ansinew" . windows-1252) ("applemac" . mac-roman) ("ascii" . us-ascii) ("cp1250" . windows-1250) ("cp1252" . windows-1252) ("cp1257" . cp1257) ("cp437de" . cp437) ("cp437" . cp437) ("cp850" . cp850) ("cp852" . cp852) ("cp858" . cp858) ("cp865" . cp865) ("latin1" . iso-8859-1) ("latin2" . iso-8859-2) ("latin3" . iso-8859-3) ("latin4" . iso-8859-4) ("latin5" . iso-8859-5) ("latin9" . iso-8859-15) ("next" . next) ("utf8" . utf-8) ("utf8x" . utf-8))) "\
;;;***
\f
;;;### (autoloads (latin1-display-ucs-per-lynx latin1-display latin1-display)
-;;;;;; "latin1-disp" "international/latin1-disp.el" (20355 10320))
+;;;;;; "latin1-disp" "international/latin1-disp.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from international/latin1-disp.el
(defvar latin1-display nil "\
;;;***
\f
;;;### (autoloads (ld-script-mode) "ld-script" "progmodes/ld-script.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/ld-script.el
(autoload 'ld-script-mode "ld-script" "\
;;;***
\f
-;;;### (autoloads (ledit-from-lisp-mode ledit-mode) "ledit" "ledit.el"
-;;;;;; (20355 10320))
-;;; Generated autoloads from ledit.el
-
-(defconst ledit-save-files t "\
-*Non-nil means Ledit should save files before transferring to Lisp.")
-
-(defconst ledit-go-to-lisp-string "%?lisp" "\
-*Shell commands to execute to resume Lisp job.")
-
-(defconst ledit-go-to-liszt-string "%?liszt" "\
-*Shell commands to execute to resume Lisp compiler job.")
-
-(autoload 'ledit-mode "ledit" "\
-\\<ledit-mode-map>Major mode for editing text and stuffing it to a Lisp job.
-Like Lisp mode, plus these special commands:
- \\[ledit-save-defun] -- record defun at or after point
- for later transmission to Lisp job.
- \\[ledit-save-region] -- record region for later transmission to Lisp job.
- \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
- \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
- and transmit saved text.
-
-\\{ledit-mode-map}
-To make Lisp mode automatically change to Ledit mode,
-do (setq lisp-mode-hook 'ledit-from-lisp-mode)
-
-\(fn)" t nil)
-
-(autoload 'ledit-from-lisp-mode "ledit" "\
-
-
-\(fn)" nil nil)
-
-;;;***
-\f
-;;;### (autoloads (life) "life" "play/life.el" (20355 10320))
+;;;### (autoloads (life) "life" "play/life.el" (20545 57511 257469
+;;;;;; 0))
;;; Generated autoloads from play/life.el
(autoload 'life "life" "\
;;;***
\f
;;;### (autoloads (global-linum-mode linum-mode linum-format) "linum"
-;;;;;; "linum.el" (20355 10320))
+;;;;;; "linum.el" (20355 10021 546955 0))
;;; Generated autoloads from linum.el
(defvar linum-format 'dynamic "\
;;;***
\f
-;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (20476
+;;;;;; 31768 298871 0))
;;; Generated autoloads from loadhist.el
(autoload 'unload-feature "loadhist" "\
;;;***
\f
;;;### (autoloads (locate-with-filter locate locate-ls-subdir-switches)
-;;;;;; "locate" "locate.el" (20355 10320))
+;;;;;; "locate" "locate.el" (20355 10021 546955 0))
;;; Generated autoloads from locate.el
(defvar locate-ls-subdir-switches (purecopy "-al") "\
;;;***
\f
-;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20531 28218))
+;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20477 21160
+;;;;;; 227853 0))
;;; Generated autoloads from vc/log-edit.el
(autoload 'log-edit "log-edit" "\
Setup a buffer to enter a log message.
-\\<log-edit-mode-map>The buffer will be put in mode MODE or `log-edit-mode'
-if MODE is nil.
-If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run.
-Mark and point will be set around the entire contents of the buffer so
-that it is easy to kill the contents of the buffer with \\[kill-region].
-Once you're done editing the message, pressing \\[log-edit-done] will call
-`log-edit-done' which will end up calling CALLBACK to do the actual commit.
-
-PARAMS if non-nil is an alist. Possible keys and associated values:
+The buffer is put in mode MODE or `log-edit-mode' if MODE is nil.
+\\<log-edit-mode-map>
+If SETUP is non-nil, erase the buffer and run `log-edit-hook'.
+Set mark and point around the entire contents of the buffer, so
+that it is easy to kill the contents of the buffer with
+\\[kill-region]. Once the user is done editing the message,
+invoking the command \\[log-edit-done] (`log-edit-done') will
+call CALLBACK to do the actual commit.
+
+PARAMS if non-nil is an alist of variables and buffer-local
+values to give them in the Log Edit buffer. Possible keys and
+associated values:
`log-edit-listfun' -- function taking no arguments that returns the list of
files that are concerned by the current operation (using relative names);
`log-edit-diff-function' -- function taking no arguments that
displays a diff of the files concerned by the current operation.
+ `vc-log-fileset' -- the VC fileset to be committed (if any).
-If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the
-log message and go back to the current buffer when done. Otherwise, it
-uses the current buffer.
+If BUFFER is non-nil `log-edit' will jump to that buffer, use it
+to edit the log message and go back to the current buffer when
+done. Otherwise, it uses the current buffer.
\(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil)
;;;***
\f
-;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (20515
+;;;;;; 36389 544939 0))
;;; Generated autoloads from vc/log-view.el
(autoload 'log-view-mode "log-view" "\
;;;***
\f
;;;### (autoloads (longlines-mode) "longlines" "longlines.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from longlines.el
(autoload 'longlines-mode "longlines" "\
;;;***
\f
;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer
-;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (20355
-;;;;;; 10320))
+;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (20476
+;;;;;; 31768 298871 0))
;;; Generated autoloads from lpr.el
(defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\
;;;***
\f
;;;### (autoloads (ls-lisp-support-shell-wildcards) "ls-lisp" "ls-lisp.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from ls-lisp.el
(defvar ls-lisp-support-shell-wildcards t "\
;;;***
\f
;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from calendar/lunar.el
(autoload 'lunar-phases "lunar" "\
;;;***
\f
;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/m4-mode.el
(autoload 'm4-mode "m4-mode" "\
;;;***
\f
;;;### (autoloads (macroexpand-all) "macroexp" "emacs-lisp/macroexp.el"
-;;;;;; (20355 10320))
+;;;;;; (20497 6436 957082 0))
;;; Generated autoloads from emacs-lisp/macroexp.el
(autoload 'macroexpand-all "macroexp" "\
;;;***
\f
;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro
-;;;;;; name-last-kbd-macro) "macros" "macros.el" (20355 10320))
+;;;;;; name-last-kbd-macro) "macros" "macros.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from macros.el
(autoload 'name-last-kbd-macro "macros" "\
;;;***
\f
;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr"
-;;;;;; "mail/mail-extr.el" (20355 10320))
+;;;;;; "mail/mail-extr.el" (20355 10021 546955 0))
;;; Generated autoloads from mail/mail-extr.el
(autoload 'mail-extract-address-components "mail-extr" "\
\f
;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-keep-history
;;;;;; mail-hist-enable mail-hist-define-keys) "mail-hist" "mail/mail-hist.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/mail-hist.el
(autoload 'mail-hist-define-keys "mail-hist" "\
\(fn)" nil nil)
(defvar mail-hist-keep-history t "\
-*Non-nil means keep a history for headers and text of outgoing mail.")
+Non-nil means keep a history for headers and text of outgoing mail.")
(custom-autoload 'mail-hist-keep-history "mail-hist" t)
;;;### (autoloads (mail-fetch-field mail-unquote-printable-region
;;;;;; mail-unquote-printable mail-quote-printable-region mail-quote-printable
;;;;;; mail-file-babyl-p mail-dont-reply-to-names mail-use-rfc822)
-;;;;;; "mail-utils" "mail/mail-utils.el" (20355 10320))
+;;;;;; "mail-utils" "mail/mail-utils.el" (20355 10021 546955 0))
;;; Generated autoloads from mail/mail-utils.el
(defvar mail-use-rfc822 nil "\
;;;***
\f
;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup
-;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20355
-;;;;;; 10320))
+;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20387
+;;;;;; 44199 24128 0))
;;; Generated autoloads from mail/mailabbrev.el
(defvar mail-abbrevs-mode nil "\
\f
;;;### (autoloads (mail-complete mail-completion-at-point-function
;;;;;; define-mail-alias expand-mail-aliases mail-complete-style)
-;;;;;; "mailalias" "mail/mailalias.el" (20355 10320))
+;;;;;; "mailalias" "mail/mailalias.el" (20355 10021 546955 0))
;;; Generated autoloads from mail/mailalias.el
(defvar mail-complete-style 'angles "\
;;;***
\f
;;;### (autoloads (mailclient-send-it) "mailclient" "mail/mailclient.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/mailclient.el
(autoload 'mailclient-send-it "mailclient" "\
\f
;;;### (autoloads (makefile-imake-mode makefile-bsdmake-mode makefile-makepp-mode
;;;;;; makefile-gmake-mode makefile-automake-mode makefile-mode)
-;;;;;; "make-mode" "progmodes/make-mode.el" (20355 10320))
+;;;;;; "make-mode" "progmodes/make-mode.el" (20392 30149 675975
+;;;;;; 59000))
;;; Generated autoloads from progmodes/make-mode.el
(autoload 'makefile-mode "make-mode" "\
;;;***
\f
;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from makesum.el
(autoload 'make-command-summary "makesum" "\
;;;***
\f
;;;### (autoloads (Man-bookmark-jump man-follow man) "man" "man.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from man.el
(defalias 'manual-entry 'man)
;;;***
\f
-;;;### (autoloads (master-mode) "master" "master.el" (20355 10320))
+;;;### (autoloads (master-mode) "master" "master.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from master.el
(autoload 'master-mode "master" "\
;;;***
\f
;;;### (autoloads (minibuffer-depth-indicate-mode) "mb-depth" "mb-depth.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mb-depth.el
(defvar minibuffer-depth-indicate-mode nil "\
;;;;;; message-forward-make-body message-forward message-recover
;;;;;; message-supersede message-cancel-news message-followup message-wide-reply
;;;;;; message-reply message-news message-mail message-mode) "message"
-;;;;;; "gnus/message.el" (20355 10320))
+;;;;;; "gnus/message.el" (20545 57511 257469 0))
;;; Generated autoloads from gnus/message.el
(define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)
;;;***
\f
;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20399 35365 4050 0))
;;; Generated autoloads from progmodes/meta-mode.el
(autoload 'metafont-mode "meta-mode" "\
\f
;;;### (autoloads (metamail-region metamail-buffer metamail-interpret-body
;;;;;; metamail-interpret-header) "metamail" "mail/metamail.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/metamail.el
(autoload 'metamail-interpret-header "metamail" "\
\f
;;;### (autoloads (mh-fully-kill-draft mh-send-letter mh-user-agent-compose
;;;;;; mh-smail-batch mh-smail-other-window mh-smail) "mh-comp"
-;;;;;; "mh-e/mh-comp.el" (20355 10320))
+;;;;;; "mh-e/mh-comp.el" (20355 10021 546955 0))
;;; Generated autoloads from mh-e/mh-comp.el
(autoload 'mh-smail "mh-comp" "\
;;;***
\f
-;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20355 10320))
+;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from mh-e/mh-e.el
(put 'mh-progs 'risky-local-variable t)
;;;***
\f
;;;### (autoloads (mh-folder-mode mh-nmail mh-rmail) "mh-folder"
-;;;;;; "mh-e/mh-folder.el" (20355 10320))
+;;;;;; "mh-e/mh-folder.el" (20371 55972 331861 0))
;;; Generated autoloads from mh-e/mh-folder.el
(autoload 'mh-rmail "mh-folder" "\
;;;***
\f
;;;### (autoloads (midnight-delay-set clean-buffer-list) "midnight"
-;;;;;; "midnight.el" (20355 10320))
+;;;;;; "midnight.el" (20478 3673 653810 0))
;;; Generated autoloads from midnight.el
(autoload 'clean-buffer-list "midnight" "\
;;;***
\f
;;;### (autoloads (minibuffer-electric-default-mode) "minibuf-eldef"
-;;;;;; "minibuf-eldef.el" (20355 10320))
+;;;;;; "minibuf-eldef.el" (20355 10021 546955 0))
;;; Generated autoloads from minibuf-eldef.el
(defvar minibuffer-electric-default-mode nil "\
;;;***
\f
;;;### (autoloads (list-dynamic-libraries butterfly) "misc" "misc.el"
-;;;;;; (20355 10320))
+;;;;;; (20533 5993 500881 0))
;;; Generated autoloads from misc.el
(autoload 'butterfly "misc" "\
\f
;;;### (autoloads (multi-isearch-files-regexp multi-isearch-files
;;;;;; multi-isearch-buffers-regexp multi-isearch-buffers multi-isearch-setup)
-;;;;;; "misearch" "misearch.el" (20487 60609))
+;;;;;; "misearch" "misearch.el" (20490 33188 850375 0))
;;; Generated autoloads from misearch.el
(add-hook 'isearch-mode-hook 'multi-isearch-setup)
;;;***
\f
;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/mixal-mode.el
(autoload 'mixal-mode "mixal-mode" "\
;;;***
\f
;;;### (autoloads (mm-default-file-encoding) "mm-encode" "gnus/mm-encode.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/mm-encode.el
(autoload 'mm-default-file-encoding "mm-encode" "\
;;;***
\f
;;;### (autoloads (mm-inline-external-body mm-extern-cache-contents)
-;;;;;; "mm-extern" "gnus/mm-extern.el" (20355 10320))
+;;;;;; "mm-extern" "gnus/mm-extern.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/mm-extern.el
(autoload 'mm-extern-cache-contents "mm-extern" "\
;;;***
\f
;;;### (autoloads (mm-inline-partial) "mm-partial" "gnus/mm-partial.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/mm-partial.el
(autoload 'mm-inline-partial "mm-partial" "\
;;;***
\f
;;;### (autoloads (mm-url-insert-file-contents-external mm-url-insert-file-contents)
-;;;;;; "mm-url" "gnus/mm-url.el" (20355 10320))
+;;;;;; "mm-url" "gnus/mm-url.el" (20495 51111 757560 0))
;;; Generated autoloads from gnus/mm-url.el
(autoload 'mm-url-insert-file-contents "mm-url" "\
;;;***
\f
;;;### (autoloads (mm-uu-dissect-text-parts mm-uu-dissect) "mm-uu"
-;;;;;; "gnus/mm-uu.el" (20355 10320))
+;;;;;; "gnus/mm-uu.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/mm-uu.el
(autoload 'mm-uu-dissect "mm-uu" "\
;;;***
\f
;;;### (autoloads (mml-attach-file mml-to-mime) "mml" "gnus/mml.el"
-;;;;;; (20355 10320))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from gnus/mml.el
(autoload 'mml-to-mime "mml" "\
;;;***
\f
;;;### (autoloads (mml1991-sign mml1991-encrypt) "mml1991" "gnus/mml1991.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/mml1991.el
(autoload 'mml1991-encrypt "mml1991" "\
\f
;;;### (autoloads (mml2015-self-encrypt mml2015-sign mml2015-encrypt
;;;;;; mml2015-verify-test mml2015-verify mml2015-decrypt-test mml2015-decrypt)
-;;;;;; "mml2015" "gnus/mml2015.el" (20355 10320))
+;;;;;; "mml2015" "gnus/mml2015.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/mml2015.el
(autoload 'mml2015-decrypt "mml2015" "\
\(fn)" nil nil)
+;;;***
+\f
+;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (20406 8611
+;;;;;; 875037 0))
+;;; Generated autoloads from cedet/mode-local.el
+
+(put 'define-overloadable-function 'doc-string-elt 3)
+
;;;***
\f
;;;### (autoloads (m2-mode) "modula2" "progmodes/modula2.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/modula2.el
(defalias 'modula-2-mode 'm2-mode)
;;;***
\f
;;;### (autoloads (denato-region nato-region unmorse-region morse-region)
-;;;;;; "morse" "play/morse.el" (20355 10320))
+;;;;;; "morse" "play/morse.el" (20355 10021 546955 0))
;;; Generated autoloads from play/morse.el
(autoload 'morse-region "morse" "\
;;;***
\f
;;;### (autoloads (mouse-drag-drag mouse-drag-throw) "mouse-drag"
-;;;;;; "mouse-drag.el" (20355 10320))
+;;;;;; "mouse-drag.el" (20355 10021 546955 0))
;;; Generated autoloads from mouse-drag.el
(autoload 'mouse-drag-throw "mouse-drag" "\
;;;***
\f
-;;;### (autoloads (mouse-sel-mode) "mouse-sel" "mouse-sel.el" (20355
-;;;;;; 10320))
-;;; Generated autoloads from mouse-sel.el
-
-(defvar mouse-sel-mode nil "\
-Non-nil if Mouse-Sel mode is enabled.
-See the command `mouse-sel-mode' for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `mouse-sel-mode'.")
-
-(custom-autoload 'mouse-sel-mode "mouse-sel" nil)
-
-(autoload 'mouse-sel-mode "mouse-sel" "\
-Toggle Mouse Sel mode.
-With a prefix argument ARG, enable Mouse Sel mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-Mouse Sel mode is a global minor mode. When enabled, mouse
-selection is enhanced in various ways:
-
-- Double-clicking on symbol constituents selects symbols.
-Double-clicking on quotes or parentheses selects sexps.
-Double-clicking on whitespace selects whitespace.
-Triple-clicking selects lines.
-Quad-clicking selects paragraphs.
-
-- Selecting sets the region & X primary selection, but does NOT affect
-the `kill-ring', nor do the kill-ring functions change the X selection.
-Because the mouse handlers set the primary selection directly,
-mouse-sel sets the variables `interprogram-cut-function' and
-`interprogram-paste-function' to nil.
-
-- Clicking mouse-2 inserts the contents of the primary selection at
-the mouse position (or point, if `mouse-yank-at-point' is non-nil).
-
-- mouse-2 while selecting or extending copies selection to the
-kill ring; mouse-1 or mouse-3 kills it.
-
-\(fn &optional ARG)" t nil)
-
-;;;***
-\f
-;;;### (autoloads (mpc) "mpc" "mpc.el" (20355 10320))
+;;;### (autoloads (mpc) "mpc" "mpc.el" (20523 62082 997685 0))
;;; Generated autoloads from mpc.el
(autoload 'mpc "mpc" "\
;;;***
\f
-;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (20355 10320))
+;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (20545 57511 257469
+;;;;;; 0))
;;; Generated autoloads from play/mpuz.el
(autoload 'mpuz "mpuz" "\
;;;***
\f
-;;;### (autoloads (msb-mode) "msb" "msb.el" (20355 10320))
+;;;### (autoloads (msb-mode) "msb" "msb.el" (20476 31768 298871 0))
;;; Generated autoloads from msb.el
(defvar msb-mode nil "\
;;;;;; describe-current-coding-system describe-current-coding-system-briefly
;;;;;; describe-coding-system describe-character-set list-charset-chars
;;;;;; read-charset list-character-sets) "mule-diag" "international/mule-diag.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from international/mule-diag.el
(autoload 'list-character-sets "mule-diag" "\
;;;;;; coding-system-translation-table-for-decode coding-system-pre-write-conversion
;;;;;; coding-system-post-read-conversion lookup-nested-alist set-nested-alist
;;;;;; truncate-string-to-width store-substring string-to-sequence)
-;;;;;; "mule-util" "international/mule-util.el" (20355 10320))
+;;;;;; "mule-util" "international/mule-util.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from international/mule-util.el
(autoload 'string-to-sequence "mule-util" "\
This affects the implicit sorting of lists of coding systems returned by
operations such as `find-coding-systems-region'.
-\(fn CODING-SYSTEMS &rest BODY)" nil (quote macro))
+\(fn CODING-SYSTEMS &rest BODY)" nil t)
(put 'with-coding-priority 'lisp-indent-function 1)
(autoload 'detect-coding-with-priority "mule-util" "\
PRIORITY-LIST is an alist of coding categories vs the corresponding
coding systems ordered by priority.
-\(fn FROM TO PRIORITY-LIST)" nil (quote macro))
+\(fn FROM TO PRIORITY-LIST)" nil t)
(autoload 'detect-coding-with-language-environment "mule-util" "\
Detect a coding system for the text between FROM and TO with LANG-ENV.
;;;;;; whois-reverse-lookup whois finger ftp run-dig dns-lookup-host
;;;;;; nslookup nslookup-host ping traceroute route arp netstat
;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from net/net-utils.el
(autoload 'ifconfig "net-utils" "\
;;;***
\f
-;;;### (autoloads (netrc-credentials) "netrc" "net/netrc.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (netrc-credentials) "netrc" "net/netrc.el" (20495
+;;;;;; 51111 757560 0))
;;; Generated autoloads from net/netrc.el
(autoload 'netrc-credentials "netrc" "\
;;;***
\f
;;;### (autoloads (open-network-stream) "network-stream" "net/network-stream.el"
-;;;;;; (20366 41661))
+;;;;;; (20369 14251 85829 0))
;;; Generated autoloads from net/network-stream.el
(autoload 'open-network-stream "network-stream" "\
(defalias 'open-protocol-stream 'open-network-stream)
-;;;***
-\f
-;;;### (autoloads (comment-indent-new-line comment-auto-fill-only-comments
-;;;;;; comment-dwim comment-or-uncomment-region comment-box comment-region
-;;;;;; uncomment-region comment-kill comment-set-column comment-indent
-;;;;;; comment-indent-default comment-normalize-vars comment-multi-line
-;;;;;; comment-padding comment-style comment-column) "newcomment"
-;;;;;; "newcomment.el" (20355 10320))
-;;; Generated autoloads from newcomment.el
-
-(defalias 'indent-for-comment 'comment-indent)
-
-(defalias 'set-comment-column 'comment-set-column)
-
-(defalias 'kill-comment 'comment-kill)
-
-(defalias 'indent-new-comment-line 'comment-indent-new-line)
-
-(defvar comment-use-syntax 'undecided "\
-Non-nil if syntax-tables can be used instead of regexps.
-Can also be `undecided' which means that a somewhat expensive test will
-be used to try to determine whether syntax-tables should be trusted
-to understand comments or not in the given buffer.
-Major modes should set this variable.")
-
-(defvar comment-column 32 "\
-Column to indent right-margin comments to.
-Each mode may establish a different default value for this variable; you
-can set the value for a particular mode using that mode's hook.
-Comments might be indented to a different value in order not to go beyond
-`comment-fill-column' or in order to align them with surrounding comments.")
-
-(custom-autoload 'comment-column "newcomment" t)
-(put 'comment-column 'safe-local-variable 'integerp)
-
-(defvar comment-start nil "\
-*String to insert to start a new comment, or nil if no comment syntax.")
-(put 'comment-start 'safe-local-variable 'string-or-null-p)
-
-(defvar comment-start-skip nil "\
-*Regexp to match the start of a comment plus everything up to its body.
-If there are any \\(...\\) pairs, the comment delimiter text is held to begin
-at the place matched by the close of the first pair.")
-(put 'comment-start-skip 'safe-local-variable 'string-or-null-p)
-
-(defvar comment-end-skip nil "\
-Regexp to match the end of a comment plus everything back to its body.")
-(put 'comment-end-skip 'safe-local-variable 'string-or-null-p)
-
-(defvar comment-end (purecopy "") "\
-*String to insert to end a new comment.
-Should be an empty string if comments are terminated by end-of-line.")
-(put 'comment-end 'safe-local-variable 'string-or-null-p)
-
-(defvar comment-indent-function 'comment-indent-default "\
-Function to compute desired indentation for a comment.
-This function is called with no args with point at the beginning of
-the comment's starting delimiter and should return either the desired
-column indentation or nil.
-If nil is returned, indentation is delegated to `indent-according-to-mode'.")
-
-(defvar comment-insert-comment-function nil "\
-Function to insert a comment when a line doesn't contain one.
-The function has no args.
-
-Applicable at least in modes for languages like fixed-format Fortran where
-comments always start in column zero.")
-
-(defconst comment-styles '((plain nil nil nil nil "Start in column 0 (do not indent), as in Emacs-20") (indent-or-triple nil nil nil multi-char "Start in column 0, but only for single-char starters") (indent nil nil nil t "Full comment per line, ends not aligned") (aligned nil t nil t "Full comment per line, ends aligned") (box nil t t t "Full comment per line, ends aligned, + top and bottom") (extra-line t nil t t "One comment for all lines, end on a line by itself") (multi-line t nil nil t "One comment for all lines, end on last commented line") (box-multi t t t t "One comment for all lines, + top and bottom")) "\
-Comment region style definitions.
-Each style is defined with a form (STYLE . (MULTI ALIGN EXTRA INDENT DOC)).
-DOC should succinctly describe the style.
-STYLE should be a mnemonic symbol.
-MULTI specifies that comments are allowed to span multiple lines.
- e.g. in C it comments regions as
- /* blabla
- * bli */
- rather than
- /* blabla */
- /* bli */
- if `comment-end' is empty, this has no effect.
-
-ALIGN specifies that the `comment-end' markers should be aligned.
- e.g. in C it comments regions as
- /* blabla */
- /* bli */
- rather than
- /* blabla */
- /* bli */
- if `comment-end' is empty, this has no effect, unless EXTRA is also set,
- in which case the comment gets wrapped in a box.
-
-EXTRA specifies that an extra line should be used before and after the
- region to comment (to put the `comment-end' and `comment-start').
- e.g. in C it comments regions as
- /*
- * blabla
- * bli
- */
- rather than
- /* blabla
- * bli */
- if the comment style is not multi line, this has no effect, unless ALIGN
- is also set, in which case the comment gets wrapped in a box.
-
-INDENT specifies that the `comment-start' markers should not be put at the
- left margin but at the current indentation of the region to comment.
-If INDENT is `multi-char', that means indent multi-character
- comment starters, but not one-character comment starters.")
-
-(defvar comment-style 'indent "\
-Style to be used for `comment-region'.
-See `comment-styles' for a list of available styles.")
-
-(custom-autoload 'comment-style "newcomment" t)
-
-(defvar comment-padding (purecopy " ") "\
-Padding string that `comment-region' puts between comment chars and text.
-Can also be an integer which will be automatically turned into a string
-of the corresponding number of spaces.
-
-Extra spacing between the comment characters and the comment text
-makes the comment easier to read. Default is 1. nil means 0.")
-
-(custom-autoload 'comment-padding "newcomment" t)
-
-(defvar comment-multi-line nil "\
-Non-nil means `comment-indent-new-line' continues comments.
-That is, it inserts no new terminator or starter.
-This affects `auto-fill-mode', which is the main reason to
-customize this variable.
-
-It also affects \\[indent-new-comment-line]. However, if you want this
-behavior for explicit filling, you might as well use \\[newline-and-indent].")
-
-(custom-autoload 'comment-multi-line "newcomment" t)
-
-(autoload 'comment-normalize-vars "newcomment" "\
-Check and setup the variables needed by other commenting functions.
-Functions autoloaded from newcomment.el, being entry points, should call
-this function before any other, so the rest of the code can assume that
-the variables are properly set.
-
-\(fn &optional NOERROR)" nil nil)
-
-(autoload 'comment-indent-default "newcomment" "\
-Default for `comment-indent-function'.
-
-\(fn)" nil nil)
-
-(autoload 'comment-indent "newcomment" "\
-Indent this line's comment to `comment-column', or insert an empty comment.
-If CONTINUE is non-nil, use the `comment-continue' markers if any.
-
-\(fn &optional CONTINUE)" t nil)
-
-(autoload 'comment-set-column "newcomment" "\
-Set the comment column based on point.
-With no ARG, set the comment column to the current column.
-With just minus as arg, kill any comment on this line.
-With any other arg, set comment column to indentation of the previous comment
- and then align or create a comment on this line at that column.
-
-\(fn ARG)" t nil)
-
-(autoload 'comment-kill "newcomment" "\
-Kill the first comment on this line, if any.
-With prefix ARG, kill comments on that many lines starting with this one.
-
-\(fn ARG)" t nil)
-
-(autoload 'uncomment-region "newcomment" "\
-Uncomment each line in the BEG .. END region.
-The numeric prefix ARG can specify a number of chars to remove from the
-comment markers.
-
-\(fn BEG END &optional ARG)" t nil)
-
-(autoload 'comment-region "newcomment" "\
-Comment or uncomment each line in the region.
-With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END.
-Numeric prefix ARG means use ARG comment characters.
-If ARG is negative, delete that many comment characters instead.
-
-The strings used as comment starts are built from `comment-start'
-and `comment-padding'; the strings used as comment ends are built
-from `comment-end' and `comment-padding'.
-
-By default, the `comment-start' markers are inserted at the
-current indentation of the region, and comments are terminated on
-each line (even for syntaxes in which newline does not end the
-comment and blank lines do not get comments). This can be
-changed with `comment-style'.
-
-\(fn BEG END &optional ARG)" t nil)
-
-(autoload 'comment-box "newcomment" "\
-Comment out the BEG .. END region, putting it inside a box.
-The numeric prefix ARG specifies how many characters to add to begin- and
-end- comment markers additionally to what `comment-add' already specifies.
-
-\(fn BEG END &optional ARG)" t nil)
-
-(autoload 'comment-or-uncomment-region "newcomment" "\
-Call `comment-region', unless the region only consists of comments,
-in which case call `uncomment-region'. If a prefix arg is given, it
-is passed on to the respective function.
-
-\(fn BEG END &optional ARG)" t nil)
-
-(autoload 'comment-dwim "newcomment" "\
-Call the comment command you want (Do What I Mean).
-If the region is active and `transient-mark-mode' is on, call
-`comment-region' (unless it only consists of comments, in which
-case it calls `uncomment-region').
-Else, if the current line is empty, call `comment-insert-comment-function'
-if it is defined, otherwise insert a comment and indent it.
-Else if a prefix ARG is specified, call `comment-kill'.
-Else, call `comment-indent'.
-You can configure `comment-style' to change the way regions are commented.
-
-\(fn ARG)" t nil)
-
-(defvar comment-auto-fill-only-comments nil "\
-Non-nil means to only auto-fill inside comments.
-This has no effect in modes that do not define a comment syntax.")
-
-(custom-autoload 'comment-auto-fill-only-comments "newcomment" t)
-
-(autoload 'comment-indent-new-line "newcomment" "\
-Break line at point and indent, continuing comment if within one.
-This indents the body of the continued comment
-under the previous comment line.
-
-This command is intended for styles where you write a comment per line,
-starting a new comment (and terminating it if necessary) on each line.
-If you want to continue one comment across several lines, use \\[newline-and-indent].
-
-If a fill column is specified, it overrides the use of the comment column
-or comment indentation.
-
-The inserted newline is marked hard if variable `use-hard-newlines' is true,
-unless optional argument SOFT is non-nil.
-
-\(fn &optional SOFT)" t nil)
-
;;;***
\f
;;;### (autoloads (newsticker-start newsticker-running-p) "newst-backend"
-;;;;;; "net/newst-backend.el" (20355 10320))
+;;;;;; "net/newst-backend.el" (20355 10021 546955 0))
;;; Generated autoloads from net/newst-backend.el
(autoload 'newsticker-running-p "newst-backend" "\
;;;***
\f
;;;### (autoloads (newsticker-plainview) "newst-plainview" "net/newst-plainview.el"
-;;;;;; (20355 10320))
+;;;;;; (20434 17809 692608 0))
;;; Generated autoloads from net/newst-plainview.el
(autoload 'newsticker-plainview "newst-plainview" "\
;;;***
\f
;;;### (autoloads (newsticker-show-news) "newst-reader" "net/newst-reader.el"
-;;;;;; (20355 10320))
+;;;;;; (20434 17809 692608 0))
;;; Generated autoloads from net/newst-reader.el
(autoload 'newsticker-show-news "newst-reader" "\
;;;***
\f
;;;### (autoloads (newsticker-start-ticker newsticker-ticker-running-p)
-;;;;;; "newst-ticker" "net/newst-ticker.el" (20355 10320))
+;;;;;; "newst-ticker" "net/newst-ticker.el" (20427 14766 970343
+;;;;;; 0))
;;; Generated autoloads from net/newst-ticker.el
(autoload 'newsticker-ticker-running-p "newst-ticker" "\
;;;***
\f
;;;### (autoloads (newsticker-treeview) "newst-treeview" "net/newst-treeview.el"
-;;;;;; (20355 10320))
+;;;;;; (20434 17809 692608 0))
;;; Generated autoloads from net/newst-treeview.el
(autoload 'newsticker-treeview "newst-treeview" "\
;;;***
\f
;;;### (autoloads (nndiary-generate-nov-databases) "nndiary" "gnus/nndiary.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/nndiary.el
(autoload 'nndiary-generate-nov-databases "nndiary" "\
;;;***
\f
;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from gnus/nndoc.el
(autoload 'nndoc-add-type "nndoc" "\
;;;***
\f
;;;### (autoloads (nnfolder-generate-active-file) "nnfolder" "gnus/nnfolder.el"
-;;;;;; (20355 10320))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from gnus/nnfolder.el
(autoload 'nnfolder-generate-active-file "nnfolder" "\
;;;***
\f
;;;### (autoloads (nnml-generate-nov-databases) "nnml" "gnus/nnml.el"
-;;;;;; (20355 10320))
+;;;;;; (20458 56750 651721 0))
;;; Generated autoloads from gnus/nnml.el
(autoload 'nnml-generate-nov-databases "nnml" "\
;;;***
\f
;;;### (autoloads (disable-command enable-command disabled-command-function)
-;;;;;; "novice" "novice.el" (20355 10320))
+;;;;;; "novice" "novice.el" (20478 3673 653810 0))
;;; Generated autoloads from novice.el
+(define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1")
+
(defvar disabled-command-function 'disabled-command-function "\
Function to call to handle disabled commands.
If nil, the feature is disabled, i.e., all commands work normally.")
-(define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1")
-
(autoload 'disabled-command-function "novice" "\
;;;***
\f
;;;### (autoloads (nroff-mode) "nroff-mode" "textmodes/nroff-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/nroff-mode.el
(autoload 'nroff-mode "nroff-mode" "\
;;;***
\f
;;;### (autoloads (nxml-glyph-display-string) "nxml-glyph" "nxml/nxml-glyph.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from nxml/nxml-glyph.el
(autoload 'nxml-glyph-display-string "nxml-glyph" "\
;;;***
\f
-;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from nxml/nxml-mode.el
(autoload 'nxml-mode "nxml-mode" "\
;;;***
\f
;;;### (autoloads (nxml-enable-unicode-char-name-sets) "nxml-uchnm"
-;;;;;; "nxml/nxml-uchnm.el" (20355 10320))
+;;;;;; "nxml/nxml-uchnm.el" (20355 10021 546955 0))
;;; Generated autoloads from nxml/nxml-uchnm.el
(autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\
;;;;;; org-babel-pop-to-session-maybe org-babel-load-in-session-maybe
;;;;;; org-babel-expand-src-block-maybe org-babel-view-src-block-info
;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob"
-;;;;;; "org/ob.el" (20415 27188))
+;;;;;; "org/ob.el" (20417 65331 139825 0))
;;; Generated autoloads from org/ob.el
(autoload 'org-babel-execute-safely-maybe "ob" "\
beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body
-\(fn FILE &rest BODY)" nil (quote macro))
+\(fn FILE &rest BODY)" nil t)
(put 'org-babel-map-src-blocks 'lisp-indent-function '1)
If FILE is nil evaluate BODY forms on source blocks in current
buffer.
-\(fn FILE &rest BODY)" nil (quote macro))
+\(fn FILE &rest BODY)" nil t)
(put 'org-babel-map-inline-src-blocks 'lisp-indent-function '1)
If FILE is nil evaluate BODY forms on source blocks in current
buffer.
-\(fn FILE &rest BODY)" nil (quote macro))
+\(fn FILE &rest BODY)" nil t)
(put 'org-babel-map-call-lines 'lisp-indent-function '1)
(autoload 'org-babel-map-executables "ob" "\
-\(fn FILE &rest BODY)" nil (quote macro))
+\(fn FILE &rest BODY)" nil t)
(put 'org-babel-map-executables 'lisp-indent-function '1)
;;;***
\f
;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "org/ob-keys.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/ob-keys.el
(autoload 'org-babel-describe-bindings "ob-keys" "\
;;;***
\f
;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe
-;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (20355 10320))
+;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from org/ob-lob.el
(autoload 'org-babel-lob-ingest "ob-lob" "\
\f
;;;### (autoloads (org-babel-tangle org-babel-tangle-file org-babel-load-file
;;;;;; org-babel-tangle-lang-exts) "ob-tangle" "org/ob-tangle.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/ob-tangle.el
(defvar org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "\
;;;***
\f
;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from progmodes/octave-inf.el
(autoload 'inferior-octave "octave-inf" "\
;;;***
\f
;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el"
-;;;;;; (20355 10320))
+;;;;;; (20388 65061 302484 0))
;;; Generated autoloads from progmodes/octave-mod.el
(autoload 'octave-mode "octave-mod" "\
;;;;;; org-insert-link-global org-store-link org-run-like-in-org-mode
;;;;;; turn-on-orgstruct++ turn-on-orgstruct orgstruct-mode org-global-cycle
;;;;;; org-mode org-version org-babel-do-load-languages) "org" "org/org.el"
-;;;;;; (20415 63769))
+;;;;;; (20420 41510 996439 0))
;;; Generated autoloads from org/org.el
(autoload 'org-babel-do-load-languages "org" "\
;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list
;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views
;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda
-;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (20404 56885))
+;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (20420 41510
+;;;;;; 996439 0))
;;; Generated autoloads from org/org-agenda.el
(autoload 'org-agenda "org-agenda" "\
Parameters are alternating variable names and values that will be bound
before running the agenda command.
-\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro))
+\(fn CMD-KEY &rest PARAMETERS)" nil t)
(autoload 'org-batch-agenda-csv "org-agenda" "\
Run an agenda command in batch mode and send the result to STDOUT.
priority-n The computed numerical priority
agenda-day The day in the agenda where this is listed
-\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro))
+\(fn CMD-KEY &rest PARAMETERS)" nil t)
(autoload 'org-store-agenda-views "org-agenda" "\
(autoload 'org-batch-store-agenda-views "org-agenda" "\
Run all custom agenda commands that have a file argument.
-\(fn &rest PARAMETERS)" nil (quote macro))
+\(fn &rest PARAMETERS)" nil t)
(autoload 'org-agenda-list "org-agenda" "\
Produce a daily/weekly view from all files in variable `org-agenda-files'.
\f
;;;### (autoloads (org-archive-subtree-default-with-confirmation
;;;;;; org-archive-subtree-default) "org-archive" "org/org-archive.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-archive.el
(autoload 'org-archive-subtree-default "org-archive" "\
;;;;;; org-replace-region-by-ascii org-export-as-ascii-to-buffer
;;;;;; org-export-as-utf8-to-buffer org-export-as-utf8 org-export-as-latin1-to-buffer
;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from org/org-ascii.el
(autoload 'org-export-as-latin1 "org-ascii" "\
;;;***
\f
;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from org/org-attach.el
(autoload 'org-attach "org-attach" "\
;;;***
\f
;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org/org-bbdb.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-bbdb.el
(autoload 'org-bbdb-anniversaries "org-bbdb" "\
;;;***
\f
;;;### (autoloads (org-capture-import-remember-templates org-capture-insert-template-here
-;;;;;; org-capture) "org-capture" "org/org-capture.el" (20355 10320))
+;;;;;; org-capture) "org-capture" "org/org-capture.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from org/org-capture.el
(autoload 'org-capture "org-capture" "\
;;;***
\f
;;;### (autoloads (org-clock-persistence-insinuate org-get-clocktable)
-;;;;;; "org-clock" "org/org-clock.el" (20377 35643))
+;;;;;; "org-clock" "org/org-clock.el" (20427 14766 970343 0))
;;; Generated autoloads from org/org-clock.el
(autoload 'org-get-clocktable "org-clock" "\
;;;***
\f
;;;### (autoloads (org-datetree-find-date-create) "org-datetree"
-;;;;;; "org/org-datetree.el" (20355 10320))
+;;;;;; "org/org-datetree.el" (20355 10021 546955 0))
;;; Generated autoloads from org/org-datetree.el
(autoload 'org-datetree-find-date-create "org-datetree" "\
;;;### (autoloads (org-export-as-docbook org-export-as-docbook-pdf-and-open
;;;;;; org-export-as-docbook-pdf org-export-region-as-docbook org-replace-region-by-docbook
;;;;;; org-export-as-docbook-to-buffer org-export-as-docbook-batch)
-;;;;;; "org-docbook" "org/org-docbook.el" (20355 10320))
+;;;;;; "org-docbook" "org/org-docbook.el" (20355 10021 546955 0))
;;; Generated autoloads from org/org-docbook.el
(autoload 'org-export-as-docbook-batch "org-docbook" "\
\f
;;;### (autoloads (org-insert-export-options-template org-export-as-org
;;;;;; org-export-visible org-export) "org-exp" "org/org-exp.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-exp.el
(autoload 'org-export "org-exp" "\
\f
;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update
;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from org/org-feed.el
(autoload 'org-feed-update-all "org-feed" "\
;;;***
\f
;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote"
-;;;;;; "org/org-footnote.el" (20377 35643))
+;;;;;; "org/org-footnote.el" (20378 29222 722320 0))
;;; Generated autoloads from org/org-footnote.el
(autoload 'org-footnote-action "org-footnote" "\
;;;### (autoloads (org-freemind-to-org-mode org-freemind-from-org-sparse-tree
;;;;;; org-freemind-from-org-mode org-freemind-from-org-mode-node
;;;;;; org-freemind-show org-export-as-freemind) "org-freemind"
-;;;;;; "org/org-freemind.el" (20355 10320))
+;;;;;; "org/org-freemind.el" (20355 10021 546955 0))
;;; Generated autoloads from org/org-freemind.el
(autoload 'org-export-as-freemind "org-freemind" "\
;;;### (autoloads (org-export-htmlize-generate-css org-export-as-html
;;;;;; org-export-region-as-html org-replace-region-by-html org-export-as-html-to-buffer
;;;;;; org-export-as-html-batch org-export-as-html-and-open) "org-html"
-;;;;;; "org/org-html.el" (20355 10320))
+;;;;;; "org/org-html.el" (20355 10021 546955 0))
;;; Generated autoloads from org/org-html.el
(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
\f
;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files
;;;;;; org-export-icalendar-this-file) "org-icalendar" "org/org-icalendar.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-icalendar.el
(autoload 'org-export-icalendar-this-file "org-icalendar" "\
;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-find
;;;;;; org-id-goto org-id-get-with-outline-drilling org-id-get-with-outline-path-completion
;;;;;; org-id-get org-id-copy org-id-get-create) "org-id" "org/org-id.el"
-;;;;;; (20355 10320))
+;;;;;; (20545 57511 257469 0))
;;; Generated autoloads from org/org-id.el
(autoload 'org-id-get-create "org-id" "\
;;;***
\f
;;;### (autoloads (org-indent-mode) "org-indent" "org/org-indent.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-indent.el
(autoload 'org-indent-mode "org-indent" "\
;;;***
\f
;;;### (autoloads (org-irc-store-link) "org-irc" "org/org-irc.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-irc.el
(autoload 'org-irc-store-link "org-irc" "\
;;;### (autoloads (org-export-as-pdf-and-open org-export-as-pdf org-export-as-latex
;;;;;; org-export-region-as-latex org-replace-region-by-latex org-export-as-latex-to-buffer
;;;;;; org-export-as-latex-batch) "org-latex" "org/org-latex.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-latex.el
(autoload 'org-export-as-latex-batch "org-latex" "\
\f
;;;### (autoloads (org-lparse-region org-replace-region-by org-lparse-to-buffer
;;;;;; org-lparse-batch org-lparse-and-open) "org-lparse" "org/org-lparse.el"
-;;;;;; (20415 27188))
+;;;;;; (20417 65331 139825 0))
;;; Generated autoloads from org/org-lparse.el
(autoload 'org-lparse-and-open "org-lparse" "\
\f
;;;### (autoloads (org-mobile-create-sumo-agenda org-mobile-pull
;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from org/org-mobile.el
(autoload 'org-mobile-push "org-mobile" "\
\f
;;;### (autoloads (org-export-as-odf-and-open org-export-as-odf org-export-odt-convert
;;;;;; org-export-as-odt org-export-as-odt-batch org-export-as-odt-and-open)
-;;;;;; "org-odt" "org/org-odt.el" (20415 63769))
+;;;;;; "org-odt" "org/org-odt.el" (20417 65331 139825 0))
;;; Generated autoloads from org/org-odt.el
(autoload 'org-export-as-odt-and-open "org-odt" "\
;;;***
\f
;;;### (autoloads (org-plot/gnuplot) "org-plot" "org/org-plot.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-plot.el
(autoload 'org-plot/gnuplot "org-plot" "\
\f
;;;### (autoloads (org-publish-current-project org-publish-current-file
;;;;;; org-publish-all org-publish) "org-publish" "org/org-publish.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-publish.el
(defalias 'org-publish-project 'org-publish)
\f
;;;### (autoloads (org-remember-handler org-remember org-remember-apply-template
;;;;;; org-remember-annotation org-remember-insinuate) "org-remember"
-;;;;;; "org/org-remember.el" (20355 10320))
+;;;;;; "org/org-remember.el" (20420 41510 996439 0))
;;; Generated autoloads from org/org-remember.el
(autoload 'org-remember-insinuate "org-remember" "\
;;;***
\f
;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl)
-;;;;;; "org-table" "org/org-table.el" (20404 56885))
+;;;;;; "org-table" "org/org-table.el" (20417 65331 139825 0))
;;; Generated autoloads from org/org-table.el
(autoload 'turn-on-orgtbl "org-table" "\
;;;***
\f
;;;### (autoloads (org-export-as-taskjuggler-and-open org-export-as-taskjuggler)
-;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (20355 10320))
+;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from org/org-taskjuggler.el
(autoload 'org-export-as-taskjuggler "org-taskjuggler" "\
\f
;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region
;;;;;; org-timer org-timer-start) "org-timer" "org/org-timer.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-timer.el
(autoload 'org-timer-start "org-timer" "\
;;;***
\f
;;;### (autoloads (org-export-as-xoxo) "org-xoxo" "org/org-xoxo.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from org/org-xoxo.el
(autoload 'org-export-as-xoxo "org-xoxo" "\
;;;***
\f
;;;### (autoloads (outline-minor-mode outline-mode) "outline" "outline.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from outline.el
(put 'outline-regexp 'safe-local-variable 'stringp)
(put 'outline-heading-end-regexp 'safe-local-variable 'stringp)
;;;### (autoloads (list-packages describe-package package-initialize
;;;;;; package-refresh-contents package-install-file package-install-from-buffer
;;;;;; package-install package-enable-at-startup) "package" "emacs-lisp/package.el"
-;;;;;; (20390 23986))
+;;;;;; (20440 26788 208175 0))
;;; Generated autoloads from emacs-lisp/package.el
(defvar package-enable-at-startup t "\
;;;***
\f
-;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20355 10320))
+;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20542 50478
+;;;;;; 439878 507000))
;;; Generated autoloads from paren.el
(defvar show-paren-mode nil "\
;;;***
\f
;;;### (autoloads (parse-time-string) "parse-time" "calendar/parse-time.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from calendar/parse-time.el
(put 'parse-time-rules 'risky-local-variable t)
;;;***
\f
-;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from progmodes/pascal.el
(autoload 'pascal-mode "pascal" "\
;;;***
\f
;;;### (autoloads (password-in-cache-p password-cache-expiry password-cache)
-;;;;;; "password-cache" "password-cache.el" (20355 10320))
+;;;;;; "password-cache" "password-cache.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from password-cache.el
(defvar password-cache t "\
;;;***
\f
;;;### (autoloads (pcase-let pcase-let* pcase) "pcase" "emacs-lisp/pcase.el"
-;;;;;; (20355 10320))
+;;;;;; (20497 6436 957082 0))
;;; Generated autoloads from emacs-lisp/pcase.el
(autoload 'pcase "pcase" "\
UPatterns can take the following forms:
_ matches anything.
+ SELFQUOTING matches itself. This includes keywords, numbers, and strings.
SYMBOL matches anything and binds it to SYMBOL.
(or UPAT...) matches if any of the patterns matches.
(and UPAT...) matches if all the patterns match.
PRED can take the form
FUNCTION in which case it gets called with one argument.
- (FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments.
+ (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
+ which is the value being matched.
A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
PRED patterns can refer to variables bound earlier in the pattern.
E.g. you can match pairs where the cdr is larger than the car with a pattern
like `(,a . ,(pred (< a))) or, with more checks:
`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
-\(fn EXP &rest CASES)" nil (quote macro))
+\(fn EXP &rest CASES)" nil t)
(put 'pcase 'lisp-indent-function '1)
BODY should be an expression, and BINDINGS should be a list of bindings
of the form (UPAT EXP).
-\(fn BINDINGS &rest BODY)" nil (quote macro))
+\(fn BINDINGS &rest BODY)" nil t)
(put 'pcase-let* 'lisp-indent-function '1)
BODY should be a list of expressions, and BINDINGS should be a list of bindings
of the form (UPAT EXP).
-\(fn BINDINGS &rest BODY)" nil (quote macro))
+\(fn BINDINGS &rest BODY)" nil t)
(put 'pcase-let 'lisp-indent-function '1)
;;;***
\f
;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from pcmpl-cvs.el
(autoload 'pcomplete/cvs "pcmpl-cvs" "\
;;;***
\f
;;;### (autoloads (pcomplete/tar pcomplete/make pcomplete/bzip2 pcomplete/gzip)
-;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20355 10320))
+;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20355 10021 546955 0))
;;; Generated autoloads from pcmpl-gnu.el
(autoload 'pcomplete/gzip "pcmpl-gnu" "\
;;;***
\f
;;;### (autoloads (pcomplete/mount pcomplete/umount pcomplete/kill)
-;;;;;; "pcmpl-linux" "pcmpl-linux.el" (20355 10320))
+;;;;;; "pcmpl-linux" "pcmpl-linux.el" (20355 10021 546955 0))
;;; Generated autoloads from pcmpl-linux.el
(autoload 'pcomplete/kill "pcmpl-linux" "\
;;;***
\f
-;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (20523
+;;;;;; 62082 997685 0))
;;; Generated autoloads from pcmpl-rpm.el
(autoload 'pcomplete/rpm "pcmpl-rpm" "\
\f
;;;### (autoloads (pcomplete/scp pcomplete/ssh pcomplete/chgrp pcomplete/chown
;;;;;; pcomplete/which pcomplete/xargs pcomplete/rm pcomplete/rmdir
-;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (20355 10320))
+;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (20376 40834 914217
+;;;;;; 0))
;;; Generated autoloads from pcmpl-unix.el
(autoload 'pcomplete/cd "pcmpl-unix" "\
\f
;;;### (autoloads (pcomplete-shell-setup pcomplete-comint-setup pcomplete-list
;;;;;; pcomplete-help pcomplete-expand pcomplete-continue pcomplete-expand-and-complete
-;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20355
-;;;;;; 10320))
+;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20523
+;;;;;; 62082 997685 0))
;;; Generated autoloads from pcomplete.el
(autoload 'pcomplete "pcomplete" "\
\f
;;;### (autoloads (cvs-dired-use-hook cvs-dired-action cvs-status
;;;;;; cvs-update cvs-examine cvs-quickdir cvs-checkout) "pcvs"
-;;;;;; "vc/pcvs.el" (20355 10320))
+;;;;;; "vc/pcvs.el" (20476 31768 298871 0))
;;; Generated autoloads from vc/pcvs.el
(autoload 'cvs-checkout "pcvs" "\
;;;***
\f
-;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20355 10320))
+;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20476 31768
+;;;;;; 298871 0))
;;; Generated autoloads from vc/pcvs-defs.el
(defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\
;;;***
\f
;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from progmodes/perl-mode.el
(put 'perl-indent-level 'safe-local-variable 'integerp)
(put 'perl-continued-statement-offset 'safe-local-variable 'integerp)
;;;***
\f
;;;### (autoloads (picture-mode) "picture" "textmodes/picture.el"
-;;;;;; (20544 62870))
+;;;;;; (20373 11301 906925 0))
;;; Generated autoloads from textmodes/picture.el
(autoload 'picture-mode "picture" "\
;;;***
\f
-;;;### (autoloads (plstore-open) "plstore" "gnus/plstore.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (plstore-mode plstore-open) "plstore" "gnus/plstore.el"
+;;;;;; (20378 29222 722320 0))
;;; Generated autoloads from gnus/plstore.el
(autoload 'plstore-open "plstore" "\
\(fn FILE)" nil nil)
+(autoload 'plstore-mode "plstore" "\
+Major mode for editing PLSTORE files.
+
+\(fn)" t nil)
+
;;;***
\f
;;;### (autoloads (po-find-file-coding-system) "po" "textmodes/po.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/po.el
(autoload 'po-find-file-coding-system "po" "\
;;;***
\f
-;;;### (autoloads (pong) "pong" "play/pong.el" (20355 10320))
+;;;### (autoloads (pong) "pong" "play/pong.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from play/pong.el
(autoload 'pong "pong" "\
;;;***
\f
-;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (20355 10320))
+;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (20458 56750
+;;;;;; 651721 0))
;;; Generated autoloads from gnus/pop3.el
(autoload 'pop3-movemail "pop3" "\
\f
;;;### (autoloads (pp-macroexpand-last-sexp pp-eval-last-sexp pp-macroexpand-expression
;;;;;; pp-eval-expression pp pp-buffer pp-to-string) "pp" "emacs-lisp/pp.el"
-;;;;;; (20355 10320))
+;;;;;; (20495 51111 757560 0))
;;; Generated autoloads from emacs-lisp/pp.el
(autoload 'pp-to-string "pp" "\
;;;;;; pr-ps-buffer-print pr-ps-buffer-using-ghostscript pr-ps-buffer-preview
;;;;;; pr-ps-directory-ps-print pr-ps-directory-print pr-ps-directory-using-ghostscript
;;;;;; pr-ps-directory-preview pr-interface) "printing" "printing.el"
-;;;;;; (20355 10320))
+;;;;;; (20501 3499 284800 0))
;;; Generated autoloads from printing.el
(autoload 'pr-interface "printing" "\
;;;***
\f
-;;;### (autoloads (proced) "proced" "proced.el" (20355 10320))
+;;;### (autoloads (proced) "proced" "proced.el" (20511 39332 974340
+;;;;;; 0))
;;; Generated autoloads from proced.el
(autoload 'proced "proced" "\
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'.
+\\<proced-mode-map>
+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.
\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (run-prolog mercury-mode prolog-mode) "prolog"
-;;;;;; "progmodes/prolog.el" (20355 10320))
+;;;;;; "progmodes/prolog.el" (20397 45851 446679 0))
;;; Generated autoloads from progmodes/prolog.el
(autoload 'prolog-mode "prolog" "\
;;;***
\f
;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from ps-bdf.el
(defvar bdf-directory-list (if (memq system-type '(ms-dos windows-nt)) (list (expand-file-name "fonts/bdf" installation-directory)) '("/usr/local/share/emacs/fonts/bdf")) "\
;;;***
\f
;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/ps-mode.el
(autoload 'ps-mode "ps-mode" "\
;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces
;;;;;; ps-print-buffer ps-print-customize ps-print-color-p ps-paper-type
;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from ps-print.el
(defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\
;;;***
\f
-;;;### (autoloads (jython-mode python-mode python-after-info-look
-;;;;;; run-python) "python" "progmodes/python.el" (20355 10320))
+;;;### (autoloads (python-mode run-python) "python" "progmodes/python.el"
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from progmodes/python.el
-(add-to-list 'interpreter-mode-alist (cons (purecopy "jython") 'jython-mode))
+(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode))
-(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
-
(autoload 'run-python "python" "\
-Run an inferior Python process, input and output via buffer *Python*.
-CMD is the Python command to run. NOSHOW non-nil means don't
-show the buffer automatically.
-
-Interactively, a prefix arg means to prompt for the initial
-Python command line (default is `python-command').
-
-A new process is started if one isn't running attached to
-`python-buffer', or if called from Lisp with non-nil arg NEW.
-Otherwise, if a process is already running in `python-buffer',
-switch to that buffer.
+Run an inferior Python process.
+Input and output via buffer named after
+`python-shell-buffer-name'. If there is a process already
+running in that buffer, just switch to it.
-This command runs the hook `inferior-python-mode-hook' after
-running `comint-mode-hook'. Type \\[describe-mode] in the
-process buffer for a list of commands.
+With argument, allows you to define CMD so you can edit the
+command used to call the interpreter and define DEDICATED, so a
+dedicated process for the current buffer is open. When numeric
+prefix arg is other than 0 or 4 do not SHOW.
-By default, Emacs inhibits the loading of Python modules from the
-current working directory, for security reasons. To disable this
-behavior, change `python-remove-cwd-from-path' to nil.
+Runs the hook `inferior-python-mode-hook' (after the
+`comint-mode-hook' is run). (Type \\[describe-mode] in the
+process buffer for a list of commands.)
-\(fn &optional CMD NOSHOW NEW)" t nil)
-
-(autoload 'python-after-info-look "python" "\
-Set up info-look for Python.
-Used with `eval-after-load'.
-
-\(fn)" nil nil)
+\(fn CMD &optional DEDICATED SHOW)" t nil)
(autoload 'python-mode "python" "\
Major mode for editing Python files.
-Turns on Font Lock mode unconditionally since it is currently required
-for correct parsing of the source.
-See also `jython-mode', which is actually invoked if the buffer appears to
-contain Jython code. See also `run-python' and associated Python mode
-commands for running Python under Emacs.
-
-The Emacs commands which work with `defun's, e.g. \\[beginning-of-defun], deal
-with nested `def' and `class' blocks. They take the innermost one as
-current without distinguishing method and class definitions. Used multiple
-times, they move over others at the same indentation level until they reach
-the end of definitions at that level, when they move up a level.
-\\<python-mode-map>
-Colon is electric: it outdents the line if appropriate, e.g. for
-an else statement. \\[python-backspace] at the beginning of an indented statement
-deletes a level of indentation to close the current block; otherwise it
-deletes a character backward. TAB indents the current line relative to
-the preceding code. Successive TABs, with no intervening command, cycle
-through the possibilities for indentation on the basis of enclosing blocks.
-
-\\[fill-paragraph] fills comments and multi-line strings appropriately, but has no
-effect outside them.
-
-Supports Eldoc mode (only for functions, using a Python process),
-Info-Look and Imenu. In Outline minor mode, `class' and `def'
-lines count as headers. Symbol completion is available in the
-same way as in the Python shell using the `rlcompleter' module
-and this is added to the Hippie Expand functions locally if
-Hippie Expand mode is turned on. Completion of symbols of the
-form x.y only works if the components are literal
-module/attribute names, not variables. An abbrev table is set up
-with skeleton expansions for compound statement templates.
\\{python-mode-map}
-
-\(fn)" t nil)
-
-(autoload 'jython-mode "python" "\
-Major mode for editing Jython files.
-Like `python-mode', but sets up parameters for Jython subprocesses.
-Runs `jython-mode-hook' after `python-mode-hook'.
+Entry to this mode calls the value of `python-mode-hook'
+if that value is non-nil.
\(fn)" t nil)
;;;***
\f
;;;### (autoloads (quoted-printable-decode-region) "qp" "gnus/qp.el"
-;;;;;; (20355 10320))
+;;;;;; (20544 36659 880486 0))
;;; Generated autoloads from gnus/qp.el
(autoload 'quoted-printable-decode-region "qp" "\
;;;;;; quail-defrule quail-install-decode-map quail-install-map
;;;;;; quail-define-rules quail-show-keyboard-layout quail-set-keyboard-layout
;;;;;; quail-define-package quail-use-package quail-title) "quail"
-;;;;;; "international/quail.el" (20355 10320))
+;;;;;; "international/quail.el" (20523 62082 997685 0))
;;; Generated autoloads from international/quail.el
(autoload 'quail-title "quail" "\
no-decode-map --- the value non-nil means that decoding map is not
generated for the following translations.
-\(fn &rest RULES)" nil (quote macro))
+\(fn &rest RULES)" nil t)
(autoload 'quail-install-map "quail" "\
Install the Quail map MAP in the current Quail package.
\f
;;;### (autoloads (quickurl-list quickurl-list-mode quickurl-edit-urls
;;;;;; quickurl-browse-url-ask quickurl-browse-url quickurl-add-url
-;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20355
-;;;;;; 10320))
+;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from net/quickurl.el
(defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\
;;;***
\f
;;;### (autoloads (rcirc-track-minor-mode rcirc-connect rcirc) "rcirc"
-;;;;;; "net/rcirc.el" (20523 61801))
+;;;;;; "net/rcirc.el" (20541 6907 775259 0))
;;; Generated autoloads from net/rcirc.el
(autoload 'rcirc "rcirc" "\
;;;***
\f
;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from net/rcompile.el
(autoload 'remote-compile "rcompile" "\
;;;***
\f
;;;### (autoloads (re-builder) "re-builder" "emacs-lisp/re-builder.el"
-;;;;;; (20355 10320))
+;;;;;; (20427 14766 970343 0))
;;; Generated autoloads from emacs-lisp/re-builder.el
(defalias 'regexp-builder 're-builder)
;;;***
\f
-;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20355 10320))
+;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20356 2211
+;;;;;; 532900 0))
;;; Generated autoloads from recentf.el
(defvar recentf-mode nil "\
\f
;;;### (autoloads (rectangle-number-lines clear-rectangle string-insert-rectangle
;;;;;; string-rectangle delete-whitespace-rectangle open-rectangle
-;;;;;; insert-rectangle yank-rectangle kill-rectangle extract-rectangle
-;;;;;; delete-extract-rectangle delete-rectangle) "rect" "rect.el"
-;;;;;; (20355 10320))
+;;;;;; insert-rectangle yank-rectangle copy-rectangle-as-kill kill-rectangle
+;;;;;; extract-rectangle delete-extract-rectangle delete-rectangle)
+;;;;;; "rect" "rect.el" (20501 3499 284800 0))
;;; Generated autoloads from rect.el
- (define-key ctl-x-r-map "c" 'clear-rectangle)
- (define-key ctl-x-r-map "k" 'kill-rectangle)
- (define-key ctl-x-r-map "d" 'delete-rectangle)
- (define-key ctl-x-r-map "y" 'yank-rectangle)
- (define-key ctl-x-r-map "o" 'open-rectangle)
- (define-key ctl-x-r-map "t" 'string-rectangle)
- (define-key ctl-x-r-map "N" 'rectangle-number-lines)
(autoload 'delete-rectangle "rect" "\
Delete (don't save) text in the region-rectangle.
\(fn START END &optional FILL)" t nil)
+(autoload 'copy-rectangle-as-kill "rect" "\
+Copy the region-rectangle and save it as the last killed one.
+
+\(fn START END)" t nil)
+
(autoload 'yank-rectangle "rect" "\
Yank the last killed rectangle with upper left corner at point.
;;;***
\f
-;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from textmodes/refill.el
(autoload 'refill-mode "refill" "\
;;;***
\f
;;;### (autoloads (reftex-reset-scanning-information reftex-mode
-;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20355 10320))
+;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20507 42276
+;;;;;; 222255 0))
;;; Generated autoloads from textmodes/reftex.el
(autoload 'turn-on-reftex "reftex" "\
;;;***
\f
;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/reftex-cite.el
(autoload 'reftex-citation "reftex-cite" "\
;;;***
\f
;;;### (autoloads (reftex-isearch-minor-mode) "reftex-global" "textmodes/reftex-global.el"
-;;;;;; (20355 10320))
+;;;;;; (20427 14766 970343 0))
;;; Generated autoloads from textmodes/reftex-global.el
(autoload 'reftex-isearch-minor-mode "reftex-global" "\
;;;***
\f
;;;### (autoloads (reftex-index-phrases-mode) "reftex-index" "textmodes/reftex-index.el"
-;;;;;; (20355 10320))
+;;;;;; (20399 35365 4050 0))
;;; Generated autoloads from textmodes/reftex-index.el
(autoload 'reftex-index-phrases-mode "reftex-index" "\
;;;***
\f
;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/reftex-parse.el
(autoload 'reftex-all-document-files "reftex-parse" "\
;;;***
\f
-;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20355
-;;;;;; 10320))
+;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20507
+;;;;;; 42276 222255 0))
;;; Generated autoloads from textmodes/reftex-vars.el
(put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
(put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
;;;***
\f
;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "emacs-lisp/regexp-opt.el"
-;;;;;; (20355 10320))
+;;;;;; (20522 38650 757441 0))
;;; Generated autoloads from emacs-lisp/regexp-opt.el
(autoload 'regexp-opt "regexp-opt" "\
\f
;;;### (autoloads (remember-diary-extract-entries remember-clipboard
;;;;;; remember-other-frame remember) "remember" "textmodes/remember.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from textmodes/remember.el
(autoload 'remember "remember" "\
;;;***
\f
-;;;### (autoloads (repeat) "repeat" "repeat.el" (20355 10320))
+;;;### (autoloads (repeat) "repeat" "repeat.el" (20388 65061 302484
+;;;;;; 0))
;;; Generated autoloads from repeat.el
(autoload 'repeat "repeat" "\
;;;***
\f
;;;### (autoloads (reporter-submit-bug-report) "reporter" "mail/reporter.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/reporter.el
(autoload 'reporter-submit-bug-report "reporter" "\
;;;***
\f
;;;### (autoloads (reposition-window) "reposition" "reposition.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from reposition.el
(autoload 'reposition-window "reposition" "\
;;;***
\f
;;;### (autoloads (global-reveal-mode reveal-mode) "reveal" "reveal.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from reveal.el
(autoload 'reveal-mode "reveal" "\
;;;***
\f
;;;### (autoloads (make-ring ring-p) "ring" "emacs-lisp/ring.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/ring.el
(autoload 'ring-p "ring" "\
;;;***
\f
-;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20398 18099))
+;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20402 11562
+;;;;;; 85788 0))
;;; Generated autoloads from net/rlogin.el
(autoload 'rlogin "rlogin" "\
;;;;;; rmail rmail-show-message-hook rmail-secondary-file-regexp
;;;;;; rmail-secondary-file-directory rmail-primary-inbox-list rmail-highlighted-headers
;;;;;; rmail-retry-ignored-headers rmail-displayed-headers rmail-ignored-headers
-;;;;;; rmail-user-mail-address-regexp rmail-movemail-variant-p)
-;;;;;; "rmail" "mail/rmail.el" (20436 33338))
+;;;;;; rmail-user-mail-address-regexp rmail-movemail-variant-p rmail-spool-directory
+;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20526 43809 637014
+;;;;;; 858000))
;;; Generated autoloads from mail/rmail.el
+(defvar rmail-file-name (purecopy "~/RMAIL") "\
+Name of user's primary mail file.")
+
+(custom-autoload 'rmail-file-name "rmail" t)
+
+(put 'rmail-spool-directory 'standard-value '((cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/") (t "/usr/spool/mail/"))))
+
+(defvar rmail-spool-directory (purecopy (cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/") (t "/usr/spool/mail/"))) "\
+Name of directory used by system mailer for delivering new mail.
+Its name should end with a slash.")
+
+(custom-autoload 'rmail-spool-directory "rmail" t)
+(custom-initialize-delay 'rmail-spool-directory nil)
+
(autoload 'rmail-movemail-variant-p "rmail" "\
Return t if the current movemail variant is any of VARIANTS.
Currently known variants are 'emacs and 'mailutils.
;;;***
\f
;;;### (autoloads (rmail-output-body-to-file rmail-output-as-seen
-;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (20355 10320))
+;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (20530 3765 184907
+;;;;;; 0))
;;; Generated autoloads from mail/rmailout.el
(put 'rmail-output-file-alist 'risky-local-variable t)
;;;***
\f
;;;### (autoloads (rng-c-load-schema) "rng-cmpct" "nxml/rng-cmpct.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from nxml/rng-cmpct.el
(autoload 'rng-c-load-schema "rng-cmpct" "\
;;;***
\f
;;;### (autoloads (rng-nxml-mode-init) "rng-nxml" "nxml/rng-nxml.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from nxml/rng-nxml.el
(autoload 'rng-nxml-mode-init "rng-nxml" "\
;;;***
\f
;;;### (autoloads (rng-validate-mode) "rng-valid" "nxml/rng-valid.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from nxml/rng-valid.el
(autoload 'rng-validate-mode "rng-valid" "\
;;;***
\f
;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from nxml/rng-xsd.el
(put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile 'rng-xsd-compile)
;;;***
\f
;;;### (autoloads (robin-use-package robin-modify-package robin-define-package)
-;;;;;; "robin" "international/robin.el" (20355 10320))
+;;;;;; "robin" "international/robin.el" (20523 62082 997685 0))
;;; Generated autoloads from international/robin.el
(autoload 'robin-define-package "robin" "\
If there already exists a robin package whose name is NAME, the new
one replaces the old one.
-\(fn NAME DOCSTRING &rest RULES)" nil (quote macro))
+\(fn NAME DOCSTRING &rest RULES)" nil t)
(autoload 'robin-modify-package "robin" "\
Change a rule in an already defined robin package.
;;;***
\f
;;;### (autoloads (toggle-rot13-mode rot13-other-window rot13-region
-;;;;;; rot13-string rot13) "rot13" "rot13.el" (20355 10320))
+;;;;;; rot13-string rot13) "rot13" "rot13.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from rot13.el
(autoload 'rot13 "rot13" "\
;;;***
\f
;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from textmodes/rst.el
(add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
(autoload 'rst-mode "rst" "\
Major mode for editing reStructuredText documents.
\\<rst-mode-map>
-There are a number of convenient keybindings provided by
-Rst mode. The main one is \\[rst-adjust], it updates or rotates
-the section title around point or promotes/demotes the
-decorations within the region (see full details below).
-Use negative prefix arg to rotate in the other direction.
Turning on `rst-mode' calls the normal hooks `text-mode-hook'
and `rst-mode-hook'. This mode also supports font-lock
-highlighting. You may customize `rst-mode-lazy' to toggle
-font-locking of blocks.
+highlighting.
\\{rst-mode-map}
;;;***
\f
;;;### (autoloads (ruby-mode) "ruby-mode" "progmodes/ruby-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20522 38650 757441 0))
;;; Generated autoloads from progmodes/ruby-mode.el
(autoload 'ruby-mode "ruby-mode" "\
;;;***
\f
;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from ruler-mode.el
(defvar ruler-mode nil "\
;;;***
\f
-;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (20518
+;;;;;; 12580 46478 0))
;;; Generated autoloads from emacs-lisp/rx.el
(autoload 'rx-to-string "rx" "\
`(regexp REGEXP)'
include REGEXP in string notation in the result.
-\(fn &rest REGEXPS)" nil (quote macro))
+\(fn &rest REGEXPS)" nil t)
;;;***
\f
-;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20523
+;;;;;; 62082 997685 0))
;;; Generated autoloads from savehist.el
(defvar savehist-mode nil "\
;;;***
\f
;;;### (autoloads (dsssl-mode scheme-mode) "scheme" "progmodes/scheme.el"
-;;;;;; (20355 10320))
+;;;;;; (20427 14766 970343 0))
;;; Generated autoloads from progmodes/scheme.el
(autoload 'scheme-mode "scheme" "\
In addition, if an inferior Scheme process is running, some additional
commands will be defined, for evaluating expressions and controlling
the interpreter, and the state of the process will be displayed in the
-modeline of all Scheme buffers. The names of commands that interact
+mode line of all Scheme buffers. The names of commands that interact
with the Scheme process start with \"xscheme-\" if you use the MIT
Scheme-specific `xscheme' package; for more information see the
documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to
;;;***
\f
;;;### (autoloads (gnus-score-mode) "score-mode" "gnus/score-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/score-mode.el
(autoload 'gnus-score-mode "score-mode" "\
;;;***
\f
;;;### (autoloads (scroll-all-mode) "scroll-all" "scroll-all.el"
-;;;;;; (20355 10320))
+;;;;;; (20363 61861 222722 0))
;;; Generated autoloads from scroll-all.el
(defvar scroll-all-mode nil "\
;;;***
\f
;;;### (autoloads (scroll-lock-mode) "scroll-lock" "scroll-lock.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from scroll-lock.el
(autoload 'scroll-lock-mode "scroll-lock" "\
;;;***
\f
-;;;### (autoloads nil "secrets" "net/secrets.el" (20355 10320))
+;;;### (autoloads nil "secrets" "net/secrets.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from net/secrets.el
(when (featurep 'dbusbind)
(autoload 'secrets-show-secrets "secrets" nil t))
;;;***
\f
;;;### (autoloads (semantic-mode semantic-default-submodes) "semantic"
-;;;;;; "cedet/semantic.el" (20355 10320))
+;;;;;; "cedet/semantic.el" (20355 10021 546955 0))
;;; Generated autoloads from cedet/semantic.el
(defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\
;;;;;; mail-personal-alias-file mail-default-reply-to mail-archive-file-name
;;;;;; mail-header-separator send-mail-function mail-interactive
;;;;;; mail-self-blind mail-specify-envelope-from mail-from-style)
-;;;;;; "sendmail" "mail/sendmail.el" (20406 12211))
+;;;;;; "sendmail" "mail/sendmail.el" (20501 3499 284800 0))
;;; Generated autoloads from mail/sendmail.el
(defvar mail-from-style 'default "\
(custom-autoload 'mail-mailing-lists "sendmail" t)
(defvar sendmail-coding-system nil "\
-*Coding system for encoding the outgoing mail.
+Coding system for encoding the outgoing mail.
This has higher priority than the default `buffer-file-coding-system'
and `default-sendmail-coding-system',
but lower priority than the local value of `buffer-file-coding-system'.
;;;***
\f
;;;### (autoloads (server-save-buffers-kill-terminal server-mode
-;;;;;; server-force-delete server-start) "server" "server.el" (20362
-;;;;;; 44597))
+;;;;;; server-force-delete server-start) "server" "server.el" (20545
+;;;;;; 57511 257469 0))
;;; Generated autoloads from server.el
(put 'server-host 'risky-local-variable t)
(autoload 'server-start "server" "\
Allow this Emacs process to be a server for client processes.
-This starts a server communications subprocess through which
-client \"editors\" can send your editing commands to this Emacs
-job. To use the server, set up the program `emacsclient' in the
-Emacs distribution as your standard \"editor\".
+This starts a server communications subprocess through which client
+\"editors\" can send your editing commands to this Emacs job.
+To use the server, set up the program `emacsclient' in the Emacs
+distribution as your standard \"editor\".
Optional argument LEAVE-DEAD (interactively, a prefix arg) means just
kill any existing server communications subprocess.
;;;***
\f
-;;;### (autoloads (ses-mode) "ses" "ses.el" (20355 10320))
+;;;### (autoloads (ses-mode) "ses" "ses.el" (20493 9382 687578 0))
;;; Generated autoloads from ses.el
(autoload 'ses-mode "ses" "\
;;;***
\f
;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "textmodes/sgml-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from textmodes/sgml-mode.el
(autoload 'sgml-mode "sgml-mode" "\
;;;***
\f
;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el"
-;;;;;; (20542 48866))
+;;;;;; (20541 6907 775259 0))
;;; Generated autoloads from progmodes/sh-script.el
(put 'sh-shell 'safe-local-variable 'symbolp)
\\[sh-set-shell] Set this buffer's shell, and maybe its magic number.
\\[sh-execute-region] Have optional header and region be executed in a subshell.
-\\[sh-maybe-here-document] Without prefix, following an unquoted < inserts here document.
-{, (, [, ', \", `
- Unless quoted with \\, insert the pairs {}, (), [], or '', \"\", ``.
+`sh-electric-here-document-mode' controls whether insertion of two
+unquoted < insert a here document.
If you generally program a shell different from your login shell you can
set `sh-shell-file' accordingly. If your shell's file name doesn't correctly
;;;***
\f
;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/shadow.el
(autoload 'list-load-path-shadows "shadow" "\
\f
;;;### (autoloads (shadow-initialize shadow-define-regexp-group shadow-define-literal-group
;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from shadowfile.el
(autoload 'shadow-define-cluster "shadowfile" "\
;;;***
\f
;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el"
-;;;;;; (20395 41908))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from shell.el
(defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\
;;;***
\f
-;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20476
-;;;;;; 3891))
+;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20486
+;;;;;; 36135 22104 0))
;;; Generated autoloads from gnus/shr.el
(autoload 'shr-insert-document "shr" "\
;;;***
\f
-;;;### (autoloads (sieve-upload-and-bury sieve-upload sieve-manage)
-;;;;;; "sieve" "gnus/sieve.el" (20355 10320))
+;;;### (autoloads (sieve-upload-and-kill sieve-upload-and-bury sieve-upload
+;;;;;; sieve-manage) "sieve" "gnus/sieve.el" (20487 57003 603251
+;;;;;; 0))
;;; Generated autoloads from gnus/sieve.el
(autoload 'sieve-manage "sieve" "\
(autoload 'sieve-upload-and-bury "sieve" "\
+\(fn &optional NAME)" t nil)
+
+(autoload 'sieve-upload-and-kill "sieve" "\
+
+
\(fn &optional NAME)" t nil)
;;;***
\f
;;;### (autoloads (sieve-mode) "sieve-mode" "gnus/sieve-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20487 57003 603251 0))
;;; Generated autoloads from gnus/sieve-mode.el
(autoload 'sieve-mode "sieve-mode" "\
;;;***
\f
;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from progmodes/simula.el
(autoload 'simula-mode "simula" "\
;;;***
\f
;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy-new
-;;;;;; define-skeleton) "skeleton" "skeleton.el" (20539 22323))
+;;;;;; define-skeleton) "skeleton" "skeleton.el" (20541 6907 775259
+;;;;;; 0))
;;; Generated autoloads from skeleton.el
(defvar skeleton-filter-function 'identity "\
DOCUMENTATION is that of the command.
SKELETON is as defined under `skeleton-insert'.
-\(fn COMMAND DOCUMENTATION &rest SKELETON)" nil (quote macro))
+\(fn COMMAND DOCUMENTATION &rest SKELETON)" nil t)
+
+(put 'define-skeleton 'doc-string-elt '2)
(autoload 'skeleton-proxy-new "skeleton" "\
Insert SKELETON.
;;;***
\f
;;;### (autoloads (smerge-start-session smerge-mode smerge-ediff)
-;;;;;; "smerge-mode" "vc/smerge-mode.el" (20355 10320))
+;;;;;; "smerge-mode" "vc/smerge-mode.el" (20523 62082 997685 0))
;;; Generated autoloads from vc/smerge-mode.el
(autoload 'smerge-ediff "smerge-mode" "\
;;;***
\f
;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/smiley.el
(autoload 'smiley-region "smiley" "\
;;;***
\f
;;;### (autoloads (smtpmail-send-queued-mail smtpmail-send-it) "smtpmail"
-;;;;;; "mail/smtpmail.el" (20395 41908))
+;;;;;; "mail/smtpmail.el" (20402 11562 85788 0))
;;; Generated autoloads from mail/smtpmail.el
(autoload 'smtpmail-send-it "smtpmail" "\
;;;***
\f
-;;;### (autoloads (snake) "snake" "play/snake.el" (20355 10320))
+;;;### (autoloads (snake) "snake" "play/snake.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from play/snake.el
(autoload 'snake "snake" "\
;;;***
\f
;;;### (autoloads (snmpv2-mode snmp-mode) "snmp-mode" "net/snmp-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from net/snmp-mode.el
(autoload 'snmp-mode "snmp-mode" "\
;;;***
\f
;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from calendar/solar.el
(autoload 'sunrise-sunset "solar" "\
;;;***
\f
-;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (20427
+;;;;;; 14766 970343 0))
;;; Generated autoloads from play/solitaire.el
(autoload 'solitaire "solitaire" "\
\f
;;;### (autoloads (reverse-region sort-columns sort-regexp-fields
;;;;;; sort-fields sort-numeric-fields sort-pages sort-paragraphs
-;;;;;; sort-lines sort-subr) "sort" "sort.el" (20355 10320))
+;;;;;; sort-lines sort-subr) "sort" "sort.el" (20507 42276 222255
+;;;;;; 0))
;;; Generated autoloads from sort.el
(put 'sort-fold-case 'safe-local-variable 'booleanp)
\(fn FIELD BEG END)" t nil)
(autoload 'sort-regexp-fields "sort" "\
-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.
-
-With a negative prefix arg sorts in reverse order.
+Sort the text in the region region lexicographically.
+If called interactively, prompt for two regular expressions,
+RECORD-REGEXP and KEY-REGEXP.
+
+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.
;;;***
\f
-;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20458
+;;;;;; 56750 651721 0))
;;; Generated autoloads from gnus/spam.el
(autoload 'spam-initialize "spam" "\
\f
;;;### (autoloads (spam-report-deagentize spam-report-agentize spam-report-url-to-file
;;;;;; spam-report-url-ping-mm-url spam-report-process-queue) "spam-report"
-;;;;;; "gnus/spam-report.el" (20355 10320))
+;;;;;; "gnus/spam-report.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/spam-report.el
(autoload 'spam-report-process-queue "spam-report" "\
;;;***
\f
;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar"
-;;;;;; "speedbar.el" (20355 10320))
+;;;;;; "speedbar.el" (20497 6436 957082 0))
;;; Generated autoloads from speedbar.el
(defalias 'speedbar 'speedbar-frame-mode)
;;;***
\f
;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from play/spook.el
(autoload 'spook "spook" "\
;;;;;; sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix
;;;;;; sql-sybase sql-oracle sql-product-interactive sql-connect
;;;;;; sql-mode sql-help sql-add-product-keywords) "sql" "progmodes/sql.el"
-;;;;;; (20355 10320))
+;;;;;; (20480 38535 248706 0))
;;; Generated autoloads from progmodes/sql.el
(autoload 'sql-add-product-keywords "sql" "\
;;;***
\f
;;;### (autoloads (srecode-template-mode) "srecode/srt-mode" "cedet/srecode/srt-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from cedet/srecode/srt-mode.el
(autoload 'srecode-template-mode "srecode/srt-mode" "\
;;;***
\f
;;;### (autoloads (starttls-open-stream) "starttls" "gnus/starttls.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from gnus/starttls.el
(autoload 'starttls-open-stream "starttls" "\
;;;;;; strokes-mode strokes-list-strokes strokes-load-user-strokes
;;;;;; strokes-help strokes-describe-stroke strokes-do-complex-stroke
;;;;;; strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke
-;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20355
-;;;;;; 10320))
+;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20523
+;;;;;; 62082 997685 0))
;;; Generated autoloads from strokes.el
(autoload 'strokes-global-set-stroke "strokes" "\
;;;***
\f
;;;### (autoloads (studlify-buffer studlify-word studlify-region)
-;;;;;; "studly" "play/studly.el" (20355 10320))
+;;;;;; "studly" "play/studly.el" (20355 10021 546955 0))
;;; Generated autoloads from play/studly.el
(autoload 'studlify-region "studly" "\
;;;***
\f
;;;### (autoloads (global-subword-mode subword-mode) "subword" "progmodes/subword.el"
-;;;;;; (20355 10320))
+;;;;;; (20524 51365 2559 0))
;;; Generated autoloads from progmodes/subword.el
(autoload 'subword-mode "subword" "\
;;;***
\f
;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/supercite.el
(autoload 'sc-cite-original "supercite" "\
;;;***
\f
;;;### (autoloads (gpm-mouse-mode) "t-mouse" "t-mouse.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from t-mouse.el
(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1")
;;;***
\f
-;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (20355 10320))
+;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from tabify.el
(autoload 'untabify "tabify" "\
;;;;;; table-recognize table-insert-row-column table-insert-column
;;;;;; table-insert-row table-insert table-point-left-cell-hook
;;;;;; table-point-entered-cell-hook table-load-hook table-cell-map-hook)
-;;;;;; "table" "textmodes/table.el" (20355 10320))
+;;;;;; "table" "textmodes/table.el" (20434 17809 692608 0))
;;; Generated autoloads from textmodes/table.el
(defvar table-cell-map-hook nil "\
;;;***
\f
-;;;### (autoloads (tabulated-list-mode) "tabulated-list" "emacs-lisp/tabulated-list.el"
-;;;;;; (20366 41661))
-;;; Generated autoloads from emacs-lisp/tabulated-list.el
-
-(autoload 'tabulated-list-mode "tabulated-list" "\
-Generic major mode for browsing a list of items.
-This mode is usually not used directly; instead, other major
-modes are derived from it, using `define-derived-mode'.
-
-In this major mode, the buffer is divided into multiple columns,
-which are labeled using the header line. Each non-empty line
-belongs to one \"entry\", and the entries can be sorted according
-to their column values.
-
-An inheriting mode should usually do the following in their body:
-
- - Set `tabulated-list-format', specifying the column format.
- - Set `tabulated-list-revert-hook', if the buffer contents need
- to be specially recomputed prior to `revert-buffer'.
- - Maybe set a `tabulated-list-entries' function (see below).
- - Maybe set `tabulated-list-printer' (see below).
- - Maybe set `tabulated-list-padding'.
- - Call `tabulated-list-init-header' to initialize `header-line-format'
- according to `tabulated-list-format'.
-
-An inheriting mode is usually accompanied by a \"list-FOO\"
-command (e.g. `list-packages', `list-processes'). This command
-creates or switches to a buffer and enables the major mode in
-that buffer. If `tabulated-list-entries' is not a function, the
-command should initialize it to a list of entries for displaying.
-Finally, it should call `tabulated-list-print'.
-
-`tabulated-list-print' calls the printer function specified by
-`tabulated-list-printer', once for each entry. The default
-printer is `tabulated-list-print-entry', but a mode that keeps
-data in an ewoc may instead specify a printer function (e.g., one
-that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
-as the ewoc pretty-printer.
-
-\(fn)" t nil)
-
-;;;***
-\f
-;;;### (autoloads (talk talk-connect) "talk" "talk.el" (20355 10320))
+;;;### (autoloads (talk talk-connect) "talk" "talk.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from talk.el
(autoload 'talk-connect "talk" "\
;;;***
\f
-;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20355 10320))
+;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20522 9637
+;;;;;; 465791 0))
;;; Generated autoloads from tar-mode.el
(autoload 'tar-mode "tar-mode" "\
;;;***
\f
;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl"
-;;;;;; "progmodes/tcl.el" (20355 10320))
+;;;;;; "progmodes/tcl.el" (20355 10021 546955 0))
;;; Generated autoloads from progmodes/tcl.el
(autoload 'tcl-mode "tcl" "\
;;;***
\f
-;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (20355 10320))
+;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from net/telnet.el
(autoload 'telnet "telnet" "\
;;;***
\f
;;;### (autoloads (serial-term ansi-term term make-term) "term" "term.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from term.el
(autoload 'make-term "term" "\
;;;***
\f
;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from terminal.el
(autoload 'terminal-emulator "terminal" "\
;;;***
\f
;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/testcover.el
(autoload 'testcover-this-defun "testcover" "\
;;;***
\f
-;;;### (autoloads (tetris) "tetris" "play/tetris.el" (20355 10320))
+;;;### (autoloads (tetris) "tetris" "play/tetris.el" (20545 57511
+;;;;;; 257469 0))
;;; Generated autoloads from play/tetris.el
(autoload 'tetris "tetris" "\
;;;;;; tex-start-commands tex-start-options slitex-run-command latex-run-command
;;;;;; tex-run-command tex-offer-save tex-main-file tex-first-line-header-regexp
;;;;;; tex-directory tex-shell-file-name) "tex-mode" "textmodes/tex-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from textmodes/tex-mode.el
(defvar tex-shell-file-name nil "\
;;;***
\f
;;;### (autoloads (texi2info texinfo-format-region texinfo-format-buffer)
-;;;;;; "texinfmt" "textmodes/texinfmt.el" (20355 10320))
+;;;;;; "texinfmt" "textmodes/texinfmt.el" (20434 17809 692608 0))
;;; Generated autoloads from textmodes/texinfmt.el
(autoload 'texinfo-format-buffer "texinfmt" "\
;;;***
\f
;;;### (autoloads (texinfo-mode texinfo-close-quote texinfo-open-quote)
-;;;;;; "texinfo" "textmodes/texinfo.el" (20355 10320))
+;;;;;; "texinfo" "textmodes/texinfo.el" (20478 3673 653810 0))
;;; Generated autoloads from textmodes/texinfo.el
(defvar texinfo-open-quote (purecopy "``") "\
\f
;;;### (autoloads (thai-composition-function thai-compose-buffer
;;;;;; thai-compose-string thai-compose-region) "thai-util" "language/thai-util.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from language/thai-util.el
(autoload 'thai-compose-region "thai-util" "\
\f
;;;### (autoloads (list-at-point number-at-point symbol-at-point
;;;;;; sexp-at-point thing-at-point bounds-of-thing-at-point forward-thing)
-;;;;;; "thingatpt" "thingatpt.el" (20355 10320))
+;;;;;; "thingatpt" "thingatpt.el" (20416 44451 205563 0))
;;; Generated autoloads from thingatpt.el
(autoload 'forward-thing "thingatpt" "\
\f
;;;### (autoloads (thumbs-dired-setroot thumbs-dired-show thumbs-dired-show-marked
;;;;;; thumbs-show-from-dir thumbs-find-thumb) "thumbs" "thumbs.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from thumbs.el
(autoload 'thumbs-find-thumb "thumbs" "\
;;;;;; tibetan-decompose-string tibetan-decompose-region tibetan-compose-region
;;;;;; tibetan-compose-string tibetan-transcription-to-tibetan tibetan-tibetan-to-transcription
;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from language/tibet-util.el
(autoload 'tibetan-char-p "tibet-util" "\
;;;***
\f
;;;### (autoloads (tildify-buffer tildify-region) "tildify" "textmodes/tildify.el"
-;;;;;; (20355 10320))
+;;;;;; (20373 11301 906925 0))
;;; Generated autoloads from textmodes/tildify.el
(autoload 'tildify-region "tildify" "\
\f
;;;### (autoloads (emacs-init-time emacs-uptime display-time-world
;;;;;; display-time-mode display-time display-time-day-and-date)
-;;;;;; "time" "time.el" (20355 10320))
+;;;;;; "time" "time.el" (20387 44199 24128 0))
;;; Generated autoloads from time.el
(defvar display-time-day-and-date nil "\
;;;;;; time-to-day-in-year date-leap-year-p days-between date-to-day
;;;;;; time-add time-subtract time-since days-to-time time-less-p
;;;;;; seconds-to-time date-to-time) "time-date" "calendar/time-date.el"
-;;;;;; (20355 10320))
+;;;;;; (20453 5437 764254 0))
;;; Generated autoloads from calendar/time-date.el
(autoload 'date-to-time "time-date" "\
;;;***
\f
;;;### (autoloads (time-stamp-toggle-active time-stamp) "time-stamp"
-;;;;;; "time-stamp.el" (20355 10320))
+;;;;;; "time-stamp.el" (20355 10021 546955 0))
;;; Generated autoloads from time-stamp.el
(put 'time-stamp-format 'safe-local-variable 'stringp)
(put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p)
;;;### (autoloads (timeclock-when-to-leave-string timeclock-workday-elapsed-string
;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out
;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in
-;;;;;; timeclock-modeline-display) "timeclock" "calendar/timeclock.el"
-;;;;;; (20355 10320))
+;;;;;; timeclock-mode-line-display) "timeclock" "calendar/timeclock.el"
+;;;;;; (20523 62082 997685 0))
;;; Generated autoloads from calendar/timeclock.el
-(autoload 'timeclock-modeline-display "timeclock" "\
-Toggle display of the amount of time left today in the modeline.
+(autoload 'timeclock-mode-line-display "timeclock" "\
+Toggle display of the amount of time left today in the mode line.
If `timeclock-use-display-time' is non-nil (the default), then
-the function `display-time-mode' must be active, and the modeline
+the function `display-time-mode' must be active, and the mode line
will be updated whenever the time display is updated. Otherwise,
the timeclock will use its own sixty second timer to do its
-updating. With prefix ARG, turn modeline display on if and only
-if ARG is positive. Returns the new status of timeclock modeline
+updating. With prefix ARG, turn mode line display on if and only
+if ARG is positive. Returns the new status of timeclock mode line
display (non-nil means on).
\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (batch-titdic-convert titdic-convert) "titdic-cnv"
-;;;;;; "international/titdic-cnv.el" (20355 10320))
+;;;;;; "international/titdic-cnv.el" (20355 10021 546955 0))
;;; Generated autoloads from international/titdic-cnv.el
(autoload 'titdic-convert "titdic-cnv" "\
;;;***
\f
;;;### (autoloads (tmm-prompt tmm-menubar-mouse tmm-menubar) "tmm"
-;;;;;; "tmm.el" (20355 10320))
+;;;;;; "tmm.el" (20433 53542 563193 0))
;;; Generated autoloads from tmm.el
(define-key global-map "\M-`" 'tmm-menubar)
(define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse)
\f
;;;### (autoloads (todo-show todo-cp todo-mode todo-print todo-top-priorities
;;;;;; todo-insert-item todo-add-item-non-interactively todo-add-category)
-;;;;;; "todo-mode" "calendar/todo-mode.el" (20355 10320))
+;;;;;; "todo-mode" "calendar/todo-mode.el" (20355 10021 546955 0))
;;; Generated autoloads from calendar/todo-mode.el
(autoload 'todo-add-category "todo-mode" "\
\f
;;;### (autoloads (tool-bar-local-item-from-menu tool-bar-add-item-from-menu
;;;;;; tool-bar-local-item tool-bar-add-item toggle-tool-bar-mode-from-frame)
-;;;;;; "tool-bar" "tool-bar.el" (20355 10320))
+;;;;;; "tool-bar" "tool-bar.el" (20355 10021 546955 0))
;;; Generated autoloads from tool-bar.el
(autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\
;;;***
\f
;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el"
-;;;;;; (20355 10320))
+;;;;;; (20399 35365 4050 0))
;;; Generated autoloads from emulation/tpu-edt.el
(defvar tpu-edt-mode nil "\
;;;***
\f
;;;### (autoloads (tpu-mapper) "tpu-mapper" "emulation/tpu-mapper.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emulation/tpu-mapper.el
(autoload 'tpu-mapper "tpu-mapper" "\
;;;***
\f
-;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (20355 10320))
+;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from emacs-lisp/tq.el
(autoload 'tq-create "tq" "\
;;;***
\f
;;;### (autoloads (trace-function-background trace-function trace-buffer)
-;;;;;; "trace" "emacs-lisp/trace.el" (20355 10320))
+;;;;;; "trace" "emacs-lisp/trace.el" (20485 15269 390836 0))
;;; Generated autoloads from emacs-lisp/trace.el
(defvar trace-buffer (purecopy "*trace-output*") "\
;;;### (autoloads (tramp-unload-tramp tramp-completion-handle-file-name-completion
;;;;;; tramp-completion-handle-file-name-all-completions tramp-unload-file-name-handlers
;;;;;; tramp-file-name-handler tramp-syntax tramp-mode) "tramp"
-;;;;;; "net/tramp.el" (20355 10320))
+;;;;;; "net/tramp.el" (20530 32114 546307 0))
;;; Generated autoloads from net/tramp.el
(defvar tramp-mode t "\
-*Whether Tramp is enabled.
+Whether Tramp is enabled.
If it is set to nil, all remote file names are used literally.")
(custom-autoload 'tramp-mode "tramp" t)
(custom-autoload 'tramp-syntax "tramp" t)
-(defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):" "\\`/\\([^[/:]+\\|[^/]+]\\):") "\
+(defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):" "\\`/\\([^[/|:]+\\|[^/|]+]\\):") "\
Value for `tramp-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
Tramp. See `tramp-file-name-structure' for more explanations.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
-(defconst tramp-file-name-regexp-url "\\`/[^/:]+://" "\
+(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://" "\
Value for `tramp-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
(defconst tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) ((equal tramp-syntax 'url) tramp-file-name-regexp-url) (t (error "Wrong `tramp-syntax' defined"))) "\
-*Regular expression matching file names handled by Tramp.
+Regular expression matching file names handled by Tramp.
This regexp should match Tramp file names but no other file names.
When tramp.el is loaded, this regular expression is prepended to
`file-name-handler-alist', and that is searched sequentially. Thus,
See `tramp-file-name-structure' for more explanations.")
(defconst tramp-completion-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate) ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url) (t (error "Wrong `tramp-syntax' defined"))) "\
-*Regular expression matching file names handled by Tramp completion.
+Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
Please note that the entry in `file-name-handler-alist' is made when
;;;***
\f
;;;### (autoloads (tramp-ftp-enable-ange-ftp) "tramp-ftp" "net/tramp-ftp.el"
-;;;;;; (20355 10320))
+;;;;;; (20438 24016 194668 0))
;;; Generated autoloads from net/tramp-ftp.el
(autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\
;;;***
\f
-;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20516
-;;;;;; 60858))
+;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20518
+;;;;;; 12580 46478 0))
;;; Generated autoloads from tutorial.el
(autoload 'help-with-tutorial "tutorial" "\
;;;***
\f
;;;### (autoloads (tai-viet-composition-function) "tv-util" "language/tv-util.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from language/tv-util.el
(autoload 'tai-viet-composition-function "tv-util" "\
;;;***
\f
;;;### (autoloads (2C-split 2C-associate-buffer 2C-two-columns) "two-column"
-;;;;;; "textmodes/two-column.el" (20355 10320))
+;;;;;; "textmodes/two-column.el" (20364 31990 752722 691000))
;;; Generated autoloads from textmodes/two-column.el
(autoload '2C-command "two-column" () t 'keymap)
(global-set-key "\C-x6" '2C-command)
;;;;;; type-break type-break-mode type-break-keystroke-threshold
;;;;;; type-break-good-break-interval type-break-good-rest-interval
;;;;;; type-break-interval type-break-mode) "type-break" "type-break.el"
-;;;;;; (20355 10320))
+;;;;;; (20545 57511 257469 0))
;;; Generated autoloads from type-break.el
(defvar type-break-mode nil "\
;;;***
\f
-;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20355 10320))
+;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from mail/uce.el
(autoload 'uce-reply-to-uce "uce" "\
;;;;;; ucs-normalize-NFKC-string ucs-normalize-NFKC-region ucs-normalize-NFKD-string
;;;;;; ucs-normalize-NFKD-region ucs-normalize-NFC-string ucs-normalize-NFC-region
;;;;;; ucs-normalize-NFD-string ucs-normalize-NFD-region) "ucs-normalize"
-;;;;;; "international/ucs-normalize.el" (20355 10320))
+;;;;;; "international/ucs-normalize.el" (20476 31768 298871 0))
;;; Generated autoloads from international/ucs-normalize.el
(autoload 'ucs-normalize-NFD-region "ucs-normalize" "\
;;;***
\f
;;;### (autoloads (ununderline-region underline-region) "underline"
-;;;;;; "textmodes/underline.el" (20355 10320))
+;;;;;; "textmodes/underline.el" (20355 10021 546955 0))
;;; Generated autoloads from textmodes/underline.el
(autoload 'underline-region "underline" "\
;;;***
\f
;;;### (autoloads (unrmail batch-unrmail) "unrmail" "mail/unrmail.el"
-;;;;;; (20355 10320))
+;;;;;; (20369 14251 85829 0))
;;; Generated autoloads from mail/unrmail.el
(autoload 'batch-unrmail "unrmail" "\
;;;***
\f
;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from emacs-lisp/unsafep.el
(autoload 'unsafep "unsafep" "\
;;;***
\f
;;;### (autoloads (url-retrieve-synchronously url-retrieve) "url"
-;;;;;; "url/url.el" (20355 10320))
+;;;;;; "url/url.el" (20478 3673 653810 0))
;;; Generated autoloads from url/url.el
(autoload 'url-retrieve "url" "\
Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
-URL is either a string or a parsed URL.
+URL is either a string or a parsed URL. If it is a string
+containing characters that are not valid in a URI, those
+characters are percent-encoded; see `url-encode-url'.
CALLBACK is called when the object has been completely retrieved, with
the current buffer containing the object, and any MIME headers associated
If SILENT, then don't message progress reports and the like.
If INHIBIT-COOKIES, cookies will neither be stored nor sent to
the server.
+If URL is a multibyte string, it will be encoded as utf-8 and
+URL-encoded before it's used.
\(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil)
;;;***
\f
;;;### (autoloads (url-register-auth-scheme url-get-authentication)
-;;;;;; "url-auth" "url/url-auth.el" (20355 10320))
+;;;;;; "url-auth" "url/url-auth.el" (20355 10021 546955 0))
;;; Generated autoloads from url/url-auth.el
(autoload 'url-get-authentication "url-auth" "\
;;;***
\f
;;;### (autoloads (url-cache-extract url-is-cached url-store-in-cache)
-;;;;;; "url-cache" "url/url-cache.el" (20355 10320))
+;;;;;; "url-cache" "url/url-cache.el" (20355 10021 546955 0))
;;; Generated autoloads from url/url-cache.el
(autoload 'url-store-in-cache "url-cache" "\
;;;***
\f
-;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (20355 10320))
+;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from url/url-cid.el
(autoload 'url-cid "url-cid" "\
;;;***
\f
-;;;### (autoloads (url-dav-vc-registered url-dav-supported-p) "url-dav"
-;;;;;; "url/url-dav.el" (20355 10320))
+;;;### (autoloads (url-dav-vc-registered url-dav-request url-dav-supported-p)
+;;;;;; "url-dav" "url/url-dav.el" (20501 3499 284800 0))
;;; Generated autoloads from url/url-dav.el
(autoload 'url-dav-supported-p "url-dav" "\
-
+Return WebDAV protocol version supported by URL.
+Returns nil if WebDAV is not supported.
\(fn URL)" nil nil)
+(autoload 'url-dav-request "url-dav" "\
+Perform WebDAV operation METHOD on URL. Return the parsed responses.
+Automatically creates an XML request body if TAG is non-nil.
+BODY is the XML document fragment to be enclosed by <TAG></TAG>.
+
+DEPTH is how deep the request should propagate. Default is 0, meaning
+it should apply only to URL. A negative number means to use
+`Infinity' for the depth. Not all WebDAV servers support this depth
+though.
+
+HEADERS is an assoc list of extra headers to send in the request.
+
+NAMESPACES is an assoc list of (NAMESPACE . EXPANSION), and these are
+added to the <TAG> element. The DAV=DAV: namespace is automatically
+added to this list, so most requests can just pass in nil.
+
+\(fn URL METHOD TAG BODY &optional DEPTH HEADERS NAMESPACES)" nil nil)
+
(autoload 'url-dav-vc-registered "url-dav" "\
;;;***
\f
-;;;### (autoloads (url-file) "url-file" "url/url-file.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (url-file) "url-file" "url/url-file.el" (20478
+;;;;;; 3673 653810 0))
;;; Generated autoloads from url/url-file.el
(autoload 'url-file "url-file" "\
;;;***
\f
;;;### (autoloads (url-open-stream url-gateway-nslookup-host) "url-gw"
-;;;;;; "url/url-gw.el" (20355 10320))
+;;;;;; "url/url-gw.el" (20478 3673 653810 0))
;;; Generated autoloads from url/url-gw.el
(autoload 'url-gateway-nslookup-host "url-gw" "\
\f
;;;### (autoloads (url-insert-file-contents url-file-local-copy url-copy-file
;;;;;; url-file-handler url-handler-mode) "url-handlers" "url/url-handlers.el"
-;;;;;; (20355 10320))
+;;;;;; (20440 54677 388705 0))
;;; Generated autoloads from url/url-handlers.el
(defvar url-handler-mode nil "\
;;;***
\f
;;;### (autoloads (url-http-options url-http-file-attributes url-http-file-exists-p
-;;;;;; url-http) "url-http" "url/url-http.el" (20454 63285))
+;;;;;; url-http) "url-http" "url/url-http.el" (20522 38650 757441
+;;;;;; 0))
;;; Generated autoloads from url/url-http.el
(autoload 'url-http "url-http" "\
;;;***
\f
-;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (20355 10320))
+;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from url/url-irc.el
(autoload 'url-irc "url-irc" "\
;;;***
\f
;;;### (autoloads (url-ldap) "url-ldap" "url/url-ldap.el" (20355
-;;;;;; 10320))
+;;;;;; 10021 546955 0))
;;; Generated autoloads from url/url-ldap.el
(autoload 'url-ldap "url-ldap" "\
;;;***
\f
;;;### (autoloads (url-mailto url-mail) "url-mailto" "url/url-mailto.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from url/url-mailto.el
(autoload 'url-mail "url-mailto" "\
;;;***
\f
;;;### (autoloads (url-data url-generic-emulator-loader url-info
-;;;;;; url-man) "url-misc" "url/url-misc.el" (20355 10320))
+;;;;;; url-man) "url-misc" "url/url-misc.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from url/url-misc.el
(autoload 'url-man "url-misc" "\
;;;***
\f
;;;### (autoloads (url-snews url-news) "url-news" "url/url-news.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from url/url-news.el
(autoload 'url-news "url-news" "\
\f
;;;### (autoloads (url-ns-user-pref url-ns-prefs isInNet isResolvable
;;;;;; dnsResolve dnsDomainIs isPlainHostName) "url-ns" "url/url-ns.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from url/url-ns.el
(autoload 'isPlainHostName "url-ns" "\
;;;***
\f
;;;### (autoloads (url-generic-parse-url url-recreate-url) "url-parse"
-;;;;;; "url/url-parse.el" (20355 10320))
+;;;;;; "url/url-parse.el" (20523 62082 997685 0))
;;; Generated autoloads from url/url-parse.el
(autoload 'url-recreate-url "url-parse" "\
(autoload 'url-generic-parse-url "url-parse" "\
Return an URL-struct of the parts of URL.
The CL-style struct contains the following fields:
-TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS.
+
+TYPE is the URI scheme (string or nil).
+USER is the user name (string or nil).
+PASSWORD is the password (string [deprecated] or nil).
+HOST is the host (a registered name, IP literal in square
+ brackets, or IPv4 address in dotted-decimal form).
+PORTSPEC is the specified port (a number), or nil.
+FILENAME is the path AND the query component of the URI.
+TARGET is the fragment identifier component (used to refer to a
+ subordinate resource, e.g. a part of a webpage).
+ATTRIBUTES is nil; this slot originally stored the attribute and
+ value alists for IMAP URIs, but this feature was removed
+ since it conflicts with RFC 3986.
+FULLNESS is non-nil iff the hierarchical sequence component of
+ the URL starts with two slashes, \"//\".
+
+The parser follows RFC 3986, except that it also tries to handle
+URIs that are not fully specified (e.g. lacking TYPE), and it
+does not check for or perform %-encoding.
+
+Here is an example. The URL
+
+ foo://bob:pass@example.com:42/a/b/c.dtb?type=animal&name=narwhal#nose
+
+parses to
+
+ TYPE = \"foo\"
+ USER = \"bob\"
+ PASSWORD = \"pass\"
+ HOST = \"example.com\"
+ PORTSPEC = 42
+ FILENAME = \"/a/b/c.dtb?type=animal&name=narwhal\"
+ TARGET = \"nose\"
+ ATTRIBUTES = nil
+ FULLNESS = t
\(fn URL)" nil nil)
;;;***
\f
;;;### (autoloads (url-setup-privacy-info) "url-privacy" "url/url-privacy.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from url/url-privacy.el
(autoload 'url-setup-privacy-info "url-privacy" "\
;;;***
\f
;;;### (autoloads (url-queue-retrieve) "url-queue" "url/url-queue.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from url/url-queue.el
(autoload 'url-queue-retrieve "url-queue" "\
;;;***
\f
;;;### (autoloads (url-view-url url-truncate-url-for-viewing url-file-extension
-;;;;;; url-hexify-string url-unhex-string url-parse-query-string
-;;;;;; url-file-nondirectory url-file-directory url-percentage url-display-percentage
-;;;;;; url-pretty-length url-strip-leading-spaces url-eat-trailing-space
-;;;;;; url-get-normalized-date url-lazy-message url-normalize-url
-;;;;;; url-insert-entities-in-string url-parse-args url-debug url-debug)
-;;;;;; "url-util" "url/url-util.el" (20355 10320))
+;;;;;; url-encode-url url-hexify-string url-unhex-string url-build-query-string
+;;;;;; url-parse-query-string url-file-nondirectory url-file-directory
+;;;;;; url-percentage url-display-percentage url-pretty-length url-strip-leading-spaces
+;;;;;; url-eat-trailing-space url-get-normalized-date url-lazy-message
+;;;;;; url-normalize-url url-insert-entities-in-string url-parse-args
+;;;;;; url-debug url-debug) "url-util" "url/url-util.el" (20520
+;;;;;; 54308 826101 0))
;;; Generated autoloads from url/url-util.el
(defvar url-debug nil "\
\(fn QUERY &optional DOWNCASE ALLOW-NEWLINES)" nil nil)
+(autoload 'url-build-query-string "url-util" "\
+Build a query-string.
+
+Given a QUERY in the form:
+'((key1 val1)
+ (key2 val2)
+ (key3 val1 val2)
+ (key4)
+ (key5
+
+\(fn QUERY &optional SEMICOLONS KEEP-EMPTY)" nil nil)
+
(autoload 'url-unhex-string "url-util" "\
Remove %XX embedded spaces, etc in a URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
\(fn STR &optional ALLOW-NEWLINES)" nil nil)
(autoload 'url-hexify-string "url-util" "\
-Return a new string that is STRING URI-encoded.
-First, STRING is converted to utf-8, if necessary. Then, for each
-character in the utf-8 string, those found in `url-unreserved-chars'
-are left as-is, all others are represented as a three-character
-string: \"%\" followed by two lowercase hex digits.
+URI-encode STRING and return the result.
+If STRING is multibyte, it is first converted to a utf-8 byte
+string. Each byte corresponding to an allowed character is left
+as-is, while all other bytes are converted to a three-character
+string: \"%\" followed by two upper-case hex digits.
+
+The allowed characters are specified by ALLOWED-CHARS. If this
+argument is nil, the list `url-unreserved-chars' determines the
+allowed characters. Otherwise, ALLOWED-CHARS should be a vector
+whose Nth element is non-nil if character N is allowed.
+
+\(fn STRING &optional ALLOWED-CHARS)" nil nil)
+
+(autoload 'url-encode-url "url-util" "\
+Return a properly URI-encoded version of URL.
+This function also performs URI normalization, e.g. converting
+the scheme to lowercase if it is uppercase. Apart from
+normalization, if URL is already URI-encoded, this function
+should return it unchanged.
-\(fn STRING)" nil nil)
+\(fn URL)" nil nil)
(autoload 'url-file-extension "url-util" "\
Return the filename extension of FNAME.
;;;***
\f
;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock)
-;;;;;; "userlock" "userlock.el" (20487 60609))
+;;;;;; "userlock" "userlock.el" (20490 33188 850375 0))
;;; Generated autoloads from userlock.el
(autoload 'ask-user-about-lock "userlock" "\
\f
;;;### (autoloads (utf-7-imap-pre-write-conversion utf-7-pre-write-conversion
;;;;;; utf-7-imap-post-read-conversion utf-7-post-read-conversion)
-;;;;;; "utf-7" "international/utf-7.el" (20355 10320))
+;;;;;; "utf-7" "international/utf-7.el" (20355 10021 546955 0))
;;; Generated autoloads from international/utf-7.el
(autoload 'utf-7-post-read-conversion "utf-7" "\
;;;***
\f
-;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (20355 10320))
+;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from gnus/utf7.el
(autoload 'utf7-encode "utf7" "\
\f
;;;### (autoloads (uudecode-decode-region uudecode-decode-region-internal
;;;;;; uudecode-decode-region-external) "uudecode" "mail/uudecode.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from mail/uudecode.el
(autoload 'uudecode-decode-region-external "uudecode" "\
;;;;;; vc-print-log vc-retrieve-tag vc-create-tag vc-merge vc-insert-headers
;;;;;; vc-revision-other-window vc-root-diff vc-ediff vc-version-ediff
;;;;;; vc-diff vc-version-diff vc-register vc-next-action vc-before-checkin-hook
-;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20355
-;;;;;; 10320))
+;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20542
+;;;;;; 46798 773957 0))
;;; Generated autoloads from vc/vc.el
(defvar vc-checkout-hook nil "\
The optional argument NOT-URGENT non-nil means it is ok to say no to
saving the buffer.
-\(fn HISTORIC &optional NOT-URGENT)" t nil)
+\(fn &optional HISTORIC NOT-URGENT)" t nil)
(autoload 'vc-version-ediff "vc" "\
Show differences between revisions of the fileset in the
;;;***
\f
;;;### (autoloads (vc-annotate) "vc-annotate" "vc/vc-annotate.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from vc/vc-annotate.el
(autoload 'vc-annotate "vc-annotate" "\
;;;***
\f
-;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20355 10320))
+;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20478 3673 653810
+;;;;;; 0))
;;; Generated autoloads from vc/vc-arch.el
(defun vc-arch-registered (file)
(if (vc-find-root file "{arch}/=tagging-method")
;;;***
\f
-;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20355 10320))
+;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20489 12324 656827
+;;;;;; 0))
;;; Generated autoloads from vc/vc-bzr.el
(defconst vc-bzr-admin-dirname ".bzr" "\
;;;***
\f
-;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20355 10320))
+;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20542 46798 773957
+;;;;;; 0))
;;; Generated autoloads from vc/vc-cvs.el
(defun vc-cvs-registered (f)
"Return non-nil if file F is registered with CVS."
;;;***
\f
-;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (20355 10320))
+;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (20522 9637 465791
+;;;;;; 0))
;;; Generated autoloads from vc/vc-dir.el
(autoload 'vc-dir "vc-dir" "\
;;;***
\f
;;;### (autoloads (vc-do-command) "vc-dispatcher" "vc/vc-dispatcher.el"
-;;;;;; (20355 10320))
+;;;;;; (20489 12324 656827 0))
;;; Generated autoloads from vc/vc-dispatcher.el
(autoload 'vc-do-command "vc-dispatcher" "\
;;;***
\f
-;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20377 11956))
+;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20495 51111 757560
+;;;;;; 0))
;;; Generated autoloads from vc/vc-git.el
(defun vc-git-registered (file)
"Return non-nil if FILE is registered with git."
;;;***
\f
-;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20355 10320))
+;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20489 12324 656827 0))
;;; Generated autoloads from vc/vc-hg.el
(defun vc-hg-registered (file)
"Return non-nil if FILE is registered with hg."
;;;***
\f
-;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20355 10320))
+;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20524 51365 2559 0))
;;; Generated autoloads from vc/vc-mtn.el
(defconst vc-mtn-admin-dir "_MTN" "\
;;;***
\f
;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc/vc-rcs.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from vc/vc-rcs.el
(defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\
;;;***
\f
;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc/vc-sccs.el"
-;;;;;; (20355 10320))
+;;;;;; (20430 41939 815258 390000))
;;; Generated autoloads from vc/vc-sccs.el
(defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\
;;;***
\f
-;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20355 10320))
+;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from vc/vc-svn.el
(defun vc-svn-registered (f)
(let ((admin-dir (cond ((and (eq system-type 'windows-nt)
;;;***
\f
;;;### (autoloads (vera-mode) "vera-mode" "progmodes/vera-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20434 17809 692608 0))
;;; Generated autoloads from progmodes/vera-mode.el
(add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode))
;;;***
\f
;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20420 41510 996439 0))
;;; Generated autoloads from progmodes/verilog-mode.el
(autoload 'verilog-mode "verilog-mode" "\
;;;***
\f
;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20495 51111 757560 0))
;;; Generated autoloads from progmodes/vhdl-mode.el
(autoload 'vhdl-mode "vhdl-mode" "\
brackets and removed if the queried string is left empty. Prompts for
mandatory arguments remain in the code if the queried string is left
empty. They can be queried again by `C-c C-t C-q'. Enabled
- electrification is indicated by `/e' in the modeline.
+ electrification is indicated by `/e' in the mode line.
Typing `M-SPC' after a keyword inserts a space without calling the
template generator. Automatic template generation (i.e.
Double striking of some keys inserts cumbersome VHDL syntax elements.
Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in
- the modeline. The stuttering keys and their effects are:
+ the mode line. The stuttering keys and their effects are:
;; --> \" : \" [ --> ( -- --> comment
;;; --> \" := \" [[ --> [ --CR --> comment-out code
with a comment in between.
`--CR' comments out code on that line. Re-hitting CR comments
out following lines.
- `C-c c' comments out a region if not commented out,
- uncomments a region if already commented out.
+ `C-c C-c' comments out a region if not commented out,
+ uncomments a region if already commented out. Option
+ `comment-style' defines where the comment characters
+ should be placed (beginning of line, indent, etc.).
You are prompted for comments after object definitions (i.e. signals,
variables, constants, ports) and after subprogram and process
`TAB' indents a line if at the beginning of the line. The amount of
indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l'
always indents the current line (is bound to `TAB' if option
- `vhdl-intelligent-tab' is nil).
+ `vhdl-intelligent-tab' is nil). If a region is active, `TAB' indents
+ the entire region.
Indentation can be done for a group of lines (`C-c C-i C-g'), a region
(`M-C-\\') or the entire buffer (menu). Argument and port lists are
Syntax-based indentation can be very slow in large files. Option
`vhdl-indent-syntax-based' allows to use faster but simpler indentation.
+ Option `vhdl-indent-comment-like-next-code-line' controls whether
+ comment lines are indented like the preceding or like the following code
+ line.
+
ALIGNMENT:
The alignment functions align operators, keywords, and inline comments
STRUCTURAL COMPOSITION:
- Enables simple structural composition. `C-c C-c C-n' creates a skeleton
+ Enables simple structural composition. `C-c C-m C-n' creates a skeleton
for a new component. Subcomponents (i.e. component declaration and
instantiation) can be automatically placed from a previously read port
- (`C-c C-c C-p') or directly from the hierarchy browser (`P'). Finally,
+ (`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally,
all subcomponents can be automatically connected using internal signals
- and ports (`C-c C-c C-w') following these rules:
+ and ports (`C-c C-m C-w') following these rules:
- subcomponent actual ports with same name are considered to be
connected by a signal (internal signal or port)
- signals that are only inputs to subcomponents are considered as
Component declarations can be placed in a components package (option
`vhdl-use-components-package') which can be automatically generated for
- an entire directory or project (`C-c C-c M-p'). The VHDL'93 direct
+ an entire directory or project (`C-c C-m M-p'). The VHDL'93 direct
component instantiation is also supported (option
`vhdl-use-direct-instantiation').
-| Configuration declarations can automatically be generated either from
-| the menu (`C-c C-c C-f') (for the architecture the cursor is in) or from
-| the speedbar menu (for the architecture under the cursor). The
-| configurations can optionally be hierarchical (i.e. include all
-| component levels of a hierarchical design, option
-| `vhdl-compose-configuration-hierarchical') or include subconfigurations
-| (option `vhdl-compose-configuration-use-subconfiguration'). For
-| subcomponents in hierarchical configurations, the most-recently-analyzed
-| (mra) architecture is selected. If another architecture is desired, it
-| can be marked as most-recently-analyzed (speedbar menu) before
-| generating the configuration.
-|
-| Note: Configurations of subcomponents (i.e. hierarchical configuration
-| declarations) are currently not considered when displaying
-| configurations in speedbar.
+ Configuration declarations can automatically be generated either from
+ the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from
+ the speedbar menu (for the architecture under the cursor). The
+ configurations can optionally be hierarchical (i.e. include all
+ component levels of a hierarchical design, option
+ `vhdl-compose-configuration-hierarchical') or include subconfigurations
+ (option `vhdl-compose-configuration-use-subconfiguration'). For
+ subcomponents in hierarchical configurations, the most-recently-analyzed
+ (mra) architecture is selected. If another architecture is desired, it
+ can be marked as most-recently-analyzed (speedbar menu) before
+ generating the configuration.
+
+ Note: Configurations of subcomponents (i.e. hierarchical configuration
+ declarations) are currently not considered when displaying
+ configurations in speedbar.
See the options group `vhdl-compose' for all relevant user options.
The Makefile's default target \"all\" compiles the entire design, the
target \"clean\" removes it and the target \"library\" creates the
- library directory if not existent. The Makefile also includes a target
- for each primary library unit which allows selective compilation of this
- unit, its secondary units and its subhierarchy (example: compilation of
- a design specified by a configuration). User specific parts can be
- inserted into a Makefile with option `vhdl-makefile-generation-hook'.
+ library directory if not existent. These target names can be customized
+ by option `vhdl-makefile-default-targets'. The Makefile also includes a
+ target for each primary library unit which allows selective compilation
+ of this unit, its secondary units and its subhierarchy (example:
+ compilation of a design specified by a configuration). User specific
+ parts can be inserted into a Makefile with option
+ `vhdl-makefile-generation-hook'.
Limitations:
- Only library units and dependencies within the current library are
VHDL STANDARDS:
The VHDL standards to be used are specified in option `vhdl-standard'.
- Available standards are: VHDL'87/'93, VHDL-AMS, and Math Packages.
+ Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
KEYWORD CASE:
- Out parameters of procedures are considered to be read.
Use option `vhdl-entity-file-name' to specify the entity file name
(used to obtain the port names).
+ Use option `vhdl-array-index-record-field-in-sensitivity-list' to
+ specify whether to include array indices and record fields in
+ sensitivity lists.
CODE FIXING:
to above mailing lists by sending an email to <reto@gnu.org>.
VHDL Mode is officially distributed at
-URL `http://opensource.ethz.ch/emacs/vhdl-mode.html'
+http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
where the latest version can be found.
Known problems:
---------------
-- Indentation bug in simultaneous if- and case-statements (VHDL-AMS).
- XEmacs: Incorrect start-up when automatically opening speedbar.
- XEmacs: Indentation in XEmacs 21.4 (and higher).
+- Indentation incorrect for new 'postponed' VHDL keyword.
+- Indentation incorrect for 'protected body' construct.
The VHDL Mode Authors
;;;***
\f
-;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20355 10320))
+;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20355 10021 546955
+;;;;;; 0))
;;; Generated autoloads from emulation/vi.el
(autoload 'vi-mode "vi" "\
;;;### (autoloads (viqr-pre-write-conversion viqr-post-read-conversion
;;;;;; viet-encode-viqr-buffer viet-encode-viqr-region viet-decode-viqr-buffer
;;;;;; viet-decode-viqr-region viet-encode-viscii-char) "viet-util"
-;;;;;; "language/viet-util.el" (20355 10320))
+;;;;;; "language/viet-util.el" (20355 10021 546955 0))
;;; Generated autoloads from language/viet-util.el
(autoload 'viet-encode-viscii-char "viet-util" "\
;;;;;; view-mode view-buffer-other-frame view-buffer-other-window
;;;;;; view-buffer view-file-other-frame view-file-other-window
;;;;;; view-file kill-buffer-if-not-modified view-remove-frame-by-deleting)
-;;;;;; "view" "view.el" (20355 10320))
+;;;;;; "view" "view.el" (20355 10021 546955 0))
;;; Generated autoloads from view.el
(defvar view-remove-frame-by-deleting t "\
;;;***
\f
-;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (20513
+;;;;;; 18948 537867 0))
;;; Generated autoloads from emulation/vip.el
(autoload 'vip-setup "vip" "\
;;;***
\f
;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el"
-;;;;;; (20355 10320))
+;;;;;; (20501 3499 284800 0))
;;; Generated autoloads from emulation/viper.el
(autoload 'toggle-viper-mode "viper" "\
;;;***
\f
;;;### (autoloads (warn lwarn display-warning) "warnings" "emacs-lisp/warnings.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emacs-lisp/warnings.el
(defvar warning-prefix-function nil "\
;;;***
\f
;;;### (autoloads (wdired-change-to-wdired-mode) "wdired" "wdired.el"
-;;;;;; (20355 10320))
+;;;;;; (20510 18478 782378 0))
;;; Generated autoloads from wdired.el
(autoload 'wdired-change-to-wdired-mode "wdired" "\
-Put a dired buffer in a mode in which filenames are editable.
+Put a Dired buffer in Writable Dired (WDired) mode.
\\<wdired-mode-map>
-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'.
;;;***
\f
-;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20355 10320))
+;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20355 10021
+;;;;;; 546955 0))
;;; Generated autoloads from net/webjump.el
(autoload 'webjump "webjump" "\
;;;***
\f
;;;### (autoloads (which-function-mode which-func-mode) "which-func"
-;;;;;; "progmodes/which-func.el" (20456 18614))
+;;;;;; "progmodes/which-func.el" (20523 62082 997685 0))
;;; Generated autoloads from progmodes/which-func.el
(put 'which-func-format 'risky-local-variable t)
(put 'which-func-current 'risky-local-variable t)
;;;### (autoloads (whitespace-report-region whitespace-report whitespace-cleanup-region
;;;;;; whitespace-cleanup global-whitespace-toggle-options whitespace-toggle-options
;;;;;; global-whitespace-newline-mode global-whitespace-mode whitespace-newline-mode
-;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20355 10320))
+;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20508 13724
+;;;;;; 260761 0))
;;; Generated autoloads from whitespace.el
(autoload 'whitespace-mode "whitespace" "\
;;;***
\f
;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse
-;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (20355 10320))
+;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (20478 3673
+;;;;;; 653810 0))
;;; Generated autoloads from wid-browse.el
(autoload 'widget-browse-at "wid-browse" "\
;;;***
\f
;;;### (autoloads (widget-setup widget-insert widget-delete widget-create
-;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (20355
-;;;;;; 10320))
+;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (20373
+;;;;;; 11301 906925 0))
;;; Generated autoloads from wid-edit.el
(autoload 'widgetp "wid-edit" "\
;;;***
\f
;;;### (autoloads (windmove-default-keybindings windmove-down windmove-right
-;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20355
-;;;;;; 10320))
+;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20495
+;;;;;; 51111 757560 0))
;;; Generated autoloads from windmove.el
(autoload 'windmove-left "windmove" "\
;;;***
\f
;;;### (autoloads (winner-mode winner-mode) "winner" "winner.el"
-;;;;;; (20355 10320))
+;;;;;; (20478 3673 653810 0))
;;; Generated autoloads from winner.el
(defvar winner-mode nil "\
;;;***
\f
;;;### (autoloads (woman-bookmark-jump woman-find-file woman-dired-find-file
-;;;;;; woman woman-locale) "woman" "woman.el" (20355 10320))
+;;;;;; woman woman-locale) "woman" "woman.el" (20539 18737 159373
+;;;;;; 0))
;;; Generated autoloads from woman.el
(defvar woman-locale nil "\
;;;***
\f
;;;### (autoloads (wordstar-mode) "ws-mode" "emulation/ws-mode.el"
-;;;;;; (20355 10320))
+;;;;;; (20355 10021 546955 0))
;;; Generated autoloads from emulation/ws-mode.el
(autoload 'wordstar-mode "ws-mode" "\
;;;***
\f
-;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (20355 10320))
+;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (20478 3673
+;;;;;; 653810 0))
;;; Generated autoloads from net/xesam.el
(autoload 'xesam-search "xesam" "\
;;;***
\f
;;;### (autoloads (xml-parse-region xml-parse-file) "xml" "xml.el"
-;;;;;; (20370 38715))
+;;;;;; (20528 48420 241677 0))
;;; Generated autoloads from xml.el
(autoload 'xml-parse-file "xml" "\
Parse the well-formed XML file FILE.
-If FILE is already visited, use its buffer and don't kill it.
-Returns the top node with all its children.
+Return the top node with all its children.
If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
-If PARSE-NS is non-nil, then QNAMES are expanded.
+
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST).
\(fn FILE &optional PARSE-DTD PARSE-NS)" nil nil)
(autoload 'xml-parse-region "xml" "\
Parse the region from BEG to END in BUFFER.
+Return the XML parse tree, or raise an error if the region does
+not contain well-formed XML.
+
+If BEG is nil, it defaults to `point-min'.
+If END is nil, it defaults to `point-max'.
If BUFFER is nil, it defaults to the current buffer.
-Returns the XML list for the region, or raises an error if the region
-is not well-formed XML.
-If PARSE-DTD is non-nil, the DTD is parsed rather than skipped,
-and returned as the first element of the list.
-If PARSE-NS is non-nil, then QNAMES are expanded.
+If PARSE-DTD is non-nil, parse the DTD and return it as the first
+element of the list.
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST).
-\(fn BEG END &optional BUFFER PARSE-DTD PARSE-NS)" nil nil)
+\(fn &optional BEG END BUFFER PARSE-DTD PARSE-NS)" nil nil)
;;;***
\f
;;;### (autoloads (xmltok-get-declared-encoding-position) "xmltok"
-;;;;;; "nxml/xmltok.el" (20355 10320))
+;;;;;; "nxml/xmltok.el" (20355 10021 546955 0))
;;; Generated autoloads from nxml/xmltok.el
(autoload 'xmltok-get-declared-encoding-position "xmltok" "\
;;;***
\f
-;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (20355
-;;;;;; 10320))
+;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (20485
+;;;;;; 15269 390836 0))
;;; Generated autoloads from xt-mouse.el
(defvar xterm-mouse-mode nil "\
;;;***
\f
;;;### (autoloads (yenc-extract-filename yenc-decode-region) "yenc"
-;;;;;; "gnus/yenc.el" (20355 10320))
+;;;;;; "gnus/yenc.el" (20355 10021 546955 0))
;;; Generated autoloads from gnus/yenc.el
(autoload 'yenc-decode-region "yenc" "\
;;;***
\f
;;;### (autoloads (psychoanalyze-pinhead apropos-zippy insert-zippyism
-;;;;;; yow) "yow" "play/yow.el" (20355 10320))
+;;;;;; yow) "yow" "play/yow.el" (20364 42504 244840 586000))
;;; Generated autoloads from play/yow.el
(autoload 'yow "yow" "\
;;;***
\f
-;;;### (autoloads (zone) "zone" "play/zone.el" (20355 10320))
+;;;### (autoloads (zone) "zone" "play/zone.el" (20545 57511 257469
+;;;;;; 0))
;;; Generated autoloads from play/zone.el
(autoload 'zone "zone" "\
;;;;;; "cedet/ede/proj-shared.el" "cedet/ede/proj.el" "cedet/ede/project-am.el"
;;;;;; "cedet/ede/shell.el" "cedet/ede/simple.el" "cedet/ede/source.el"
;;;;;; "cedet/ede/speedbar.el" "cedet/ede/srecode.el" "cedet/ede/system.el"
-;;;;;; "cedet/ede/util.el" "cedet/inversion.el" "cedet/mode-local.el"
-;;;;;; "cedet/pulse.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el"
+;;;;;; "cedet/ede/util.el" "cedet/inversion.el" "cedet/pulse.el"
+;;;;;; "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el"
;;;;;; "cedet/semantic/analyze/debug.el" "cedet/semantic/analyze/fcn.el"
;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el"
;;;;;; "cedet/semantic/bovine/c-by.el" "cedet/semantic/bovine/c.el"
;;;;;; "cedet/srecode/semantic.el" "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el"
;;;;;; "cedet/srecode/table.el" "cedet/srecode/template.el" "cedet/srecode/texi.el"
;;;;;; "cus-dep.el" "dframe.el" "dired-aux.el" "dired-x.el" "dos-fns.el"
-;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/assoc.el"
-;;;;;; "emacs-lisp/authors.el" "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el"
-;;;;;; "emacs-lisp/byte-opt.el" "emacs-lisp/chart.el" "emacs-lisp/cl-extra.el"
-;;;;;; "emacs-lisp/cl-loaddefs.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el"
-;;;;;; "emacs-lisp/cl-specs.el" "emacs-lisp/cust-print.el" "emacs-lisp/eieio-base.el"
-;;;;;; "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-datadebug.el"
+;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/authors.el"
+;;;;;; "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el"
+;;;;;; "emacs-lisp/chart.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el"
+;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el"
+;;;;;; "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-datadebug.el"
;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eieio-speedbar.el"
;;;;;; "emacs-lisp/eieio.el" "emacs-lisp/find-gc.el" "emacs-lisp/gulp.el"
;;;;;; "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" "emacs-lisp/regi.el"
;;;;;; "eshell/esh-ext.el" "eshell/esh-groups.el" "eshell/esh-io.el"
;;;;;; "eshell/esh-module.el" "eshell/esh-opt.el" "eshell/esh-proc.el"
;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "foldout.el"
-;;;;;; "format-spec.el" "forms-d2.el" "forms-pass.el" "fringe.el"
-;;;;;; "generic-x.el" "gnus/compface.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.el"
-;;;;;; "gnus/gnus-cite.el" "gnus/gnus-cus.el" "gnus/gnus-demon.el"
-;;;;;; "gnus/gnus-dup.el" "gnus/gnus-eform.el" "gnus/gnus-ems.el"
-;;;;;; "gnus/gnus-int.el" "gnus/gnus-logic.el" "gnus/gnus-mh.el"
-;;;;;; "gnus/gnus-salt.el" "gnus/gnus-score.el" "gnus/gnus-setup.el"
-;;;;;; "gnus/gnus-srvr.el" "gnus/gnus-topic.el" "gnus/gnus-undo.el"
-;;;;;; "gnus/gnus-util.el" "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/gssapi.el"
-;;;;;; "gnus/ietf-drums.el" "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el"
-;;;;;; "gnus/mail-prsvr.el" "gnus/mail-source.el" "gnus/mailcap.el"
-;;;;;; "gnus/messcompat.el" "gnus/mm-bodies.el" "gnus/mm-decode.el"
+;;;;;; "format-spec.el" "fringe.el" "generic-x.el" "gnus/compface.el"
+;;;;;; "gnus/gnus-async.el" "gnus/gnus-bcklg.el" "gnus/gnus-cite.el"
+;;;;;; "gnus/gnus-cus.el" "gnus/gnus-demon.el" "gnus/gnus-dup.el"
+;;;;;; "gnus/gnus-eform.el" "gnus/gnus-ems.el" "gnus/gnus-int.el"
+;;;;;; "gnus/gnus-logic.el" "gnus/gnus-mh.el" "gnus/gnus-salt.el"
+;;;;;; "gnus/gnus-score.el" "gnus/gnus-setup.el" "gnus/gnus-srvr.el"
+;;;;;; "gnus/gnus-topic.el" "gnus/gnus-undo.el" "gnus/gnus-util.el"
+;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/gssapi.el" "gnus/ietf-drums.el"
+;;;;;; "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el" "gnus/mail-prsvr.el"
+;;;;;; "gnus/mail-source.el" "gnus/mailcap.el" "gnus/messcompat.el"
+;;;;;; "gnus/mm-archive.el" "gnus/mm-bodies.el" "gnus/mm-decode.el"
;;;;;; "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el"
;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el"
;;;;;; "gnus/nneething.el" "gnus/nngateway.el" "gnus/nnheader.el"
;;;;;; "international/uni-old-name.el" "international/uni-titlecase.el"
;;;;;; "international/uni-uppercase.el" "json.el" "kermit.el" "language/hanja-util.el"
;;;;;; "language/thai-word.el" "ldefs-boot.el" "loadup.el" "mail/blessmail.el"
-;;;;;; "mail/mailheader.el" "mail/mailpost.el" "mail/mspools.el"
-;;;;;; "mail/rfc2368.el" "mail/rfc822.el" "mail/rmail-spam-filter.el"
-;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el"
-;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el"
-;;;;;; "mail/undigest.el" "md4.el" "mh-e/mh-acros.el" "mh-e/mh-alias.el"
-;;;;;; "mh-e/mh-buffers.el" "mh-e/mh-compat.el" "mh-e/mh-funcs.el"
-;;;;;; "mh-e/mh-gnus.el" "mh-e/mh-identity.el" "mh-e/mh-inc.el"
-;;;;;; "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el"
+;;;;;; "mail/mailheader.el" "mail/mspools.el" "mail/rfc2368.el"
+;;;;;; "mail/rfc822.el" "mail/rmail-spam-filter.el" "mail/rmailedit.el"
+;;;;;; "mail/rmailkwd.el" "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el"
+;;;;;; "mail/rmailsum.el" "mail/undigest.el" "md4.el" "mh-e/mh-acros.el"
+;;;;;; "mh-e/mh-alias.el" "mh-e/mh-buffers.el" "mh-e/mh-compat.el"
+;;;;;; "mh-e/mh-funcs.el" "mh-e/mh-gnus.el" "mh-e/mh-identity.el"
+;;;;;; "mh-e/mh-inc.el" "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el"
;;;;;; "mh-e/mh-loaddefs.el" "mh-e/mh-mime.el" "mh-e/mh-print.el"
;;;;;; "mh-e/mh-scan.el" "mh-e/mh-search.el" "mh-e/mh-seq.el" "mh-e/mh-show.el"
;;;;;; "mh-e/mh-speed.el" "mh-e/mh-thread.el" "mh-e/mh-tool-bar.el"
;;;;;; "org/org-mew.el" "org/org-mhe.el" "org/org-mks.el" "org/org-mouse.el"
;;;;;; "org/org-pcomplete.el" "org/org-protocol.el" "org/org-rmail.el"
;;;;;; "org/org-special-blocks.el" "org/org-src.el" "org/org-vm.el"
-;;;;;; "org/org-w3m.el" "org/org-wl.el" "patcomp.el" "play/gamegrid.el"
-;;;;;; "play/gametree.el" "play/meese.el" "progmodes/ada-prj.el"
-;;;;;; "progmodes/cc-align.el" "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el"
-;;;;;; "progmodes/cc-cmds.el" "progmodes/cc-defs.el" "progmodes/cc-fonts.el"
-;;;;;; "progmodes/cc-langs.el" "progmodes/cc-menus.el" "progmodes/ebnf-abn.el"
-;;;;;; "progmodes/ebnf-bnf.el" "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el"
-;;;;;; "progmodes/ebnf-iso.el" "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el"
-;;;;;; "progmodes/idlw-complete-structtag.el" "progmodes/idlw-help.el"
-;;;;;; "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" "progmodes/xscheme.el"
-;;;;;; "ps-def.el" "ps-mule.el" "ps-samp.el" "saveplace.el" "sb-image.el"
-;;;;;; "scroll-bar.el" "select.el" "soundex.el" "subdirs.el" "tempo.el"
-;;;;;; "textmodes/bib-mode.el" "textmodes/makeinfo.el" "textmodes/page-ext.el"
-;;;;;; "textmodes/refbib.el" "textmodes/refer.el" "textmodes/reftex-auc.el"
-;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el"
-;;;;;; "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el" "timezone.el"
-;;;;;; "tooltip.el" "tree-widget.el" "uniquify.el" "url/url-about.el"
-;;;;;; "url/url-cookie.el" "url/url-dired.el" "url/url-expand.el"
-;;;;;; "url/url-ftp.el" "url/url-future.el" "url/url-history.el"
-;;;;;; "url/url-imap.el" "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el"
+;;;;;; "org/org-w3m.el" "org/org-wl.el" "play/gamegrid.el" "play/gametree.el"
+;;;;;; "play/meese.el" "progmodes/ada-prj.el" "progmodes/cc-align.el"
+;;;;;; "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el" "progmodes/cc-cmds.el"
+;;;;;; "progmodes/cc-defs.el" "progmodes/cc-fonts.el" "progmodes/cc-langs.el"
+;;;;;; "progmodes/cc-menus.el" "progmodes/ebnf-abn.el" "progmodes/ebnf-bnf.el"
+;;;;;; "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el" "progmodes/ebnf-iso.el"
+;;;;;; "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" "progmodes/idlw-complete-structtag.el"
+;;;;;; "progmodes/idlw-help.el" "progmodes/idlw-toolbar.el" "progmodes/mantemp.el"
+;;;;;; "progmodes/xscheme.el" "ps-def.el" "ps-mule.el" "ps-samp.el"
+;;;;;; "saveplace.el" "sb-image.el" "scroll-bar.el" "select.el"
+;;;;;; "soundex.el" "subdirs.el" "tempo.el" "textmodes/bib-mode.el"
+;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/refbib.el"
+;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el"
+;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el"
+;;;;;; "textmodes/texnfo-upd.el" "timezone.el" "tooltip.el" "tree-widget.el"
+;;;;;; "uniquify.el" "url/url-about.el" "url/url-cookie.el" "url/url-dired.el"
+;;;;;; "url/url-domsuf.el" "url/url-expand.el" "url/url-ftp.el"
+;;;;;; "url/url-future.el" "url/url-history.el" "url/url-imap.el"
+;;;;;; "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el"
;;;;;; "url/url-vars.el" "vc/ediff-diff.el" "vc/ediff-init.el" "vc/ediff-merg.el"
;;;;;; "vc/ediff-ptch.el" "vc/ediff-vers.el" "vc/ediff-wind.el"
;;;;;; "vc/pcvs-info.el" "vc/pcvs-parse.el" "vc/pcvs-util.el" "vc/vc-dav.el"
;;;;;; "vcursor.el" "vt-control.el" "vt100-led.el" "w32-fns.el"
-;;;;;; "w32-vars.el" "x-dnd.el") (20545 61134 411881))
+;;;;;; "w32-vars.el" "x-dnd.el") (20545 57718 475744 538000))
;;;***
\f
"Show line numbers in the left margin."
:group 'convenience)
-;;;###autoload
(defcustom linum-format 'dynamic
"Format used to display line numbers.
Either a format string like \"%7d\", `dynamic' to adapt the width
argument and should evaluate to a string to be shown on that line.
See also `linum-before-numbering-hook'."
:group 'linum
- :type 'sexp)
+ :type '(choice (string :tag "Format string")
+ (const :tag "Dynamic width" dynamic)
+ (function :tag "Function")))
(defface linum
'((t :inherit (shadow default)))
;;; Code:
-(eval-when-compile (require 'cl))
-
(defun feature-symbols (feature)
"Return the file and list of definitions associated with FEATURE.
The value is actually the element of `load-history'
`-hook' or `-hooks', from which `unload-feature' should try to remove
pertinent symbols.")
+(define-obsolete-variable-alias 'unload-hook-features-list
+ 'unload-function-defs-list "22.2")
(defvar unload-function-defs-list nil
"List of definitions in the Lisp library being unloaded.
This is meant to be used by `FEATURE-unload-function'; see the
documentation of `unload-feature' for details.")
-(define-obsolete-variable-alias 'unload-hook-features-list
- 'unload-function-defs-list "22.2")
(defun unload--set-major-mode ()
(save-current-buffer
(dolist (x unload-function-defs-list)
(if (consp x)
- (case (car x)
+ (pcase (car x)
;; Remove any feature names that this file provided.
- (provide
+ (`provide
(setq features (delq (cdr x) features)))
- ((defun autoload)
+ ((or `defun `autoload)
(let ((fun (cdr x)))
(when (fboundp fun)
(when (fboundp 'ad-unadvise)
;; (t . SYMBOL) comes before (defun . SYMBOL)
;; and says we should restore SYMBOL's autoload
;; when we undefine it.
- ((t) (setq restore-autoload (cdr x)))
- ((require defface) nil)
- (t (message "Unexpected element %s in load-history" x)))
+ (`t (setq restore-autoload (cdr x)))
+ ((or `require `defface) nil)
+ (_ (message "Unexpected element %s in load-history" x)))
;; Kill local values as much as possible.
(dolist (buf (buffer-list))
(with-current-buffer buf
;; Add subdirectories to the load-path for files that might get
;; autoloaded when bootstrapping.
+;; This is because PATH_DUMPLOADSEARCH is just "../lisp".
+;; Note that we reset load-path below just before dumping,
+;; since lread.c:init_lread checks for changes to load-path
+;; in deciding whether to modify it.
(if (or (equal (nth 3 command-line-args) "bootstrap")
(equal (nth 4 command-line-args) "bootstrap")
(equal (nth 3 command-line-args) "unidata-gen.el")
(if (eq t purify-flag)
;; Hash consing saved around 11% of pure space in my tests.
- (setq purify-flag (make-hash-table :test 'equal)))
+ (setq purify-flag (make-hash-table :test 'equal :size 70000)))
(message "Using load-path %s" load-path)
;; implemented in subr.el.
(add-hook 'after-load-functions (lambda (f) (garbage-collect)))
-;; We specify .el in case someone compiled version.el by mistake.
-(load "version.el")
+(load "version")
(load "widget")
(load "custom")
(load "emacs-lisp/map-ynp")
-(load "cus-start")
(load "international/mule")
(load "international/mule-conf")
(load "env")
(load "format")
(load "bindings")
+(load "cus-start")
(load "window") ; Needed here for `replace-buffer-in-windows'.
(setq load-source-file-function 'load-with-code-conversion)
(load "files")
+;; Load-time macro-expansion can only take effect after setting
+;; load-source-file-function because of where it is called in lread.c.
+(load "emacs-lisp/macroexp")
+(if (byte-code-function-p (symbol-function 'macroexpand-all))
+ nil
+ ;; Since loaddefs is not yet loaded, macroexp's uses of pcase will simply
+ ;; fail until pcase is explicitly loaded. This also means that we have to
+ ;; disable eager macro-expansion while loading pcase.
+ (let ((macroexp--pending-eager-loads '(skip)))
+ (load "emacs-lisp/pcase"))
+ ;; Re-load macroexp so as to eagerly macro-expand its uses of pcase.
+ (load "emacs-lisp/macroexp"))
+
(load "cus-face")
(load "faces") ; after here, `defface' may be used.
(load "button")
(load "startup")
+;; We don't want to store loaddefs.el in the repository because it is
+;; a generated file; but it is required in order to compile the lisp files.
+;; When bootstrapping, we cannot generate loaddefs.el until an
+;; emacs binary has been built. We therefore compromise and keep
+;; ldefs-boot.el in the repository. This does not need to be updated
+;; as often as the real loaddefs.el would. Bootstrap should always
+;; work with ldefs-boot.el. Therefore, Whenever a new autoload cookie
+;; gets added that is necessary during bootstrapping, ldefs-boot.el
+;; should be updated by overwriting it with an up-to-date copy of
+;; loaddefs.el that is uncorrupted by local changes.
+;; autogen/update_autogen can be used to periodically update ldefs-boot.
(condition-case nil
;; Don't get confused if someone compiled this by mistake.
(load "loaddefs.el")
(load "rfn-eshadow")
(load "menu-bar")
-(load "paths.el") ;Don't get confused if someone compiled paths by mistake.
(load "emacs-lisp/lisp")
(load "textmodes/page")
(load "register")
(load "emacs-lisp/lisp-mode")
(load "textmodes/text-mode")
(load "textmodes/fill")
+(load "newcomment")
(load "replace")
+(load "emacs-lisp/tabulated-list")
(load "buff-menu")
(if (fboundp 'x-create-frame)
(progn
(load "fringe")
+ ;; Needed by `imagemagick-register-types'
+ (load "emacs-lisp/regexp-opt")
(load "image")
(load "international/fontset")
(load "dnd")
(versions (mapcar (function (lambda (name)
(string-to-number (substring name (length base)))))
files)))
+ (setq emacs-bzr-version (condition-case nil (emacs-bzr-get-version)
+ (error nil)))
;; `emacs-version' is a constant, so we shouldn't change it with `setq'.
(defconst emacs-version
(format "%s.%d"
;; At this point, we're ready to resume undo recording for scratch.
(buffer-enable-undo "*scratch*")
+(when (hash-table-p purify-flag)
+ (let ((strings 0)
+ (vectors 0)
+ (bytecodes 0)
+ (conses 0)
+ (others 0))
+ (maphash (lambda (k v)
+ (cond
+ ((stringp k) (setq strings (1+ strings)))
+ ((vectorp k) (setq vectors (1+ vectors)))
+ ((consp k) (setq conses (1+ conses)))
+ ((byte-code-function-p v) (setq bytecodes (1+ bytecodes)))
+ (t (setq others (1+ others)))))
+ purify-flag)
+ (message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others"
+ strings vectors conses bytecodes others)))
+
;; Avoid error if user loads some more libraries now and make sure the
;; hash-consing hash table is GC'd.
(setq purify-flag nil)
(if (or (member (nth 3 command-line-args) '("dump" "bootstrap"))
(member (nth 4 command-line-args) '("dump" "bootstrap")))
(progn
- (if (memq system-type '(ms-dos windows-nt cygwin))
- (message "Dumping under the name emacs")
- (message "Dumping under the name emacs"))
+ (message "Dumping under the name emacs")
(condition-case ()
(delete-file "emacs")
(file-error nil))
;;
;; SHELLPROGRAM Name-to-find
;;
-;; set the variable `locate-command' in your .emacs file.
+;; set the variable `locate-command' in your init file.
;;
;; To use a more complicated expression, create a function which
;; takes a string (the name to find) as input and returns a list.
;;; Code:
-(eval-when-compile (require 'cl))
-
;;;###autoload
(defvar lpr-windows-system
(memq system-type '(ms-dos windows-nt))
(if (markerp end)
(set-marker end nil))
(message "Spooling%s...done%s%s" switch-string
- (case (count-lines (point-min) (point-max))
+ (pcase (count-lines (point-min) (point-max))
(0 "")
(1 ": ")
- (t ":\n"))
+ (_ ":\n"))
(buffer-string)))))))
;; This function copies the text between start and end
:group 'news)
(defcustom binhex-decoder-program "hexbin"
- "*Non-nil value should be a string that names a binhex decoder.
+ "Non-nil value should be a string that names a binhex decoder.
The program should expect to read binhex data on its standard
input and write the converted data to its standard output."
:type 'string
:group 'binhex)
(defcustom binhex-decoder-switches '("-d")
- "*List of command line flags passed to the command `binhex-decoder-program'."
+ "List of command line flags passed to the command `binhex-decoder-program'."
:group 'binhex
:type '(repeat string))
(defcustom binhex-use-external
(executable-find binhex-decoder-program)
- "*Use external binhex program."
+ "Use external binhex program."
:version "22.1"
:group 'binhex
:type 'boolean)
(insert ". Please check that
the From: line contains a valid email address. After a delay of up
-to one day, you should receive an acknowledgement at that address.
+to one day, you should receive an acknowledgment at that address.
Please write in English if possible, as the Emacs maintainers
usually do not have translators for other languages.\n\n")))
(add-text-properties (1+ user-point) (point) prompt-properties)
(insert "\n\nIn " (emacs-version) "\n")
+ (if (stringp emacs-bzr-version)
+ (insert "Bzr revision: " emacs-bzr-version "\n"))
(if (fboundp 'x-server-vendor)
(condition-case nil
;; This is used not only for X11 but also W32 and others.
"', version "
(mapconcat 'number-to-string (x-server-version) ".") "\n")
(error t)))
+ (let ((lsb (with-temp-buffer
+ (if (eq 0 (ignore-errors
+ (call-process "lsb_release" nil '(t nil)
+ nil "-d")))
+ (buffer-string)))))
+ (if (stringp lsb)
+ (insert "System " lsb "\n")))
(when (and system-configuration-options
(not (equal system-configuration-options "")))
(insert "Configured using:\n `configure "
(insert "Important settings:\n")
(mapc
(lambda (var)
- (insert (format " value of $%s: %s\n" var (getenv var))))
- '("LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
+ (let ((val (getenv var)))
+ (if val (insert (format " value of $%s: %s\n" var val)))))
+ '("EMACSDATA" "EMACSDOC" "EMACSLOADPATH" "EMACSPATH"
+ "LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
"LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG" "XMODIFIERS"))
(insert (format " locale-coding-system: %s\n" locale-coding-system))
(insert (format " default enable-multibyte-characters: %s\n"
(fill-region (line-beginning-position 0) (point))
;; This is so the user has to type something in order to send easily.
(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
- (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
+ (define-key (current-local-map) "\C-c\C-i" 'info-emacs-bug)
(if can-insert-mail
(define-key (current-local-map) "\C-cm"
'report-emacs-bug-insert-to-mailer))
" Type \\[report-emacs-bug-insert-to-mailer] to copy text to your preferred mail program.\n")))
(terpri)
(princ (substitute-command-keys
- " Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
+ " Type \\[info-emacs-bug] to visit in Info the Emacs Manual section
about when and how to write a bug report, and what
information you should include to help fix the bug.")))
(shrink-window-if-larger-than-buffer (get-buffer-window "*Bug Help*")))
(buffer-substring-no-properties (point-min) (point)))
(goto-char user-point)))
-(defun report-emacs-bug-info ()
- "Go to the Info node on reporting Emacs bugs."
- (interactive)
- (info "(emacs)Bugs"))
+(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")
;; feedmail-send-it. Hers's the best way to use the stuff in this
;; file:
;;
-;; Save this file as feedmail.el somewhere on your elisp
-;; loadpath; byte-compile it. Put the following lines somewhere in
-;; your ~/.emacs stuff:
+;; Save this file as feedmail.el somewhere on your elisp loadpath;
+;; byte-compile it. Put the following lines in your init file:
;;
;; (setq send-mail-function 'feedmail-send-it)
;; (autoload 'feedmail-send-it "feedmail")
(require 'mail-utils) ; pick up mail-strip-quoted-names
(eval-when-compile
- (require 'smtpmail)
- (require 'cl))
+ (require 'smtpmail))
(autoload 'mail-do-fcc "sendmail")
(defvar feedmail-queue-runner-is-active nil
- "*Non-nil means we're inside the logic of the queue-running loop.
+ "Non-nil means we're inside the logic of the queue-running loop.
That is, iterating over all messages in the queue to send them. In
that case, the value is the name of the queued message file currently
being processed. This can be used for differentiating customized code
(feedmail-say-debug ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active)
(if feedmail-queue-runner-is-active
(run-hooks 'feedmail-mail-send-hook-queued)
- (run-hooks 'feedmail-mail-send-hook))
- )
-
-
-(defvar feedmail-mail-send-hook nil
- "*See documentation for `feedmail-mail-send-hook-splitter'.")
+ (run-hooks 'feedmail-mail-send-hook)))
+(defcustom feedmail-mail-send-hook nil
+ "Hook run by `feedmail-mail-send-hook-splitter' for immediate mail.
+See documentation of `feedmail-mail-send-hook-splitter' for details."
+ :type 'hook
+ :group 'feedmail)
-(defvar feedmail-mail-send-hook-queued nil
- "*See documentation for `feedmail-mail-send-hook-splitter'.")
-
+(defcustom feedmail-mail-send-hook-queued nil
+ "Hook run by `feedmail-mail-send-hook-splitter' for queued mail.
+See documentation of `feedmail-mail-send-hook-splitter' for details."
+ :type 'hook
+ :group 'feedmail)
(defun feedmail-confirm-addresses-hook-example ()
"An example of a `feedmail-last-chance-hook'.
(erase-buffer)
(insert (mapconcat 'identity feedmail-address-list " "))
(if (not (y-or-n-p "How do you like them apples? "))
- (error "FQM: Sending...gave up in last chance hook")
- )))
-
+ (error "FQM: Sending...gave up in last chance hook"))))
(defcustom feedmail-last-chance-hook nil
"User's last opportunity to modify the message on its way out.
(defvar feedmail-is-a-resend nil
- "*Non-nil means the message is a Resend (in the RFC-822 sense).
+ "Non-nil means the message is a Resend (in the RFC-822 sense).
This affects the composition of certain headers. feedmail sets this
variable as soon as it starts prepping the message text buffer, so any
user-supplied functions can rely on it. Users shouldn't set or change this
;; feedmail-buffer-to-binmail, feedmail-buffer-to-sendmail, and
-;; feedmail-buffer-to-smptmail are the only things provided for values
+;; feedmail-buffer-to-smtpmail are the only things provided for values
;; for the variable feedmail-buffer-eating-function. It's pretty easy
;; to write your own, though.
(defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid)
(feedmail-say-debug ">in-> feedmail-run-the-queue-global-prompts")
(let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
-;; letf fools the byte-compiler.
-(defvar file-name-buffer-file-type-alist)
-
;;;###autoload
(defun feedmail-run-the-queue (&optional arg)
"Visit each message in the feedmail queue directory and send it out.
(if (looking-at ".*\r\n.*\r\n")
(while (search-forward "\r\n" nil t)
(replace-match "\n" nil t)))
-;; ;; work around text-vs-binary weirdness
-;; ;; if we don't find the normal M-H-S, try reading the file a different way
-;; (if (not (feedmail-find-eoh t))
-;; (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil))
-;; (erase-buffer)
-;; (insert-file-contents maybe-file)))
(funcall feedmail-queue-runner-mode-setter arg)
(condition-case signal-stuff ; don't give up the loop if user skips some
(let ((feedmail-enable-queue nil)
(if (and is-fqm is-in-this-dir)
(setq filename buffer-file-name)
(setq filename (feedmail-create-queue-filename queue-directory)))
- ;; make binary file on DOS/Win95/WinNT, etc
+ ;; make binary file on DOS/Windows 95/Windows NT, etc
(let ((buffer-file-type feedmail-force-binary-write))
(write-file filename))
;; convenient for moving from draft to q, for example
(defun feedmail-send-it-immediately ()
"Handle immediate sending, including during a queue run."
(feedmail-say-debug ">in-> feedmail-send-it-immediately")
- (let ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*"))
- (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*"))
+ (let ((feedmail-error-buffer
+ (get-buffer-create " *FQM Outgoing Email Errors*"))
+ (feedmail-prepped-text-buffer
+ (get-buffer-create " *FQM Outgoing Email Text*"))
(feedmail-raw-text-buffer (current-buffer))
(feedmail-address-list)
(eoh-marker)
(a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):")
(a-re-dtc "^\\(To\\|Cc\\):")
(a-re-db "^Bcc:")
- ;; to get a temporary changeable copy
+ ;; To get a temporary changeable copy.
(mail-header-separator mail-header-separator)
)
(unwind-protect
(set-buffer feedmail-error-buffer) (erase-buffer)
(set-buffer feedmail-prepped-text-buffer) (erase-buffer)
- ;; jam contents of user-supplied mail buffer into our scratch buffer
+ ;; Jam contents of user-supplied mail buffer into our scratch buffer.
(insert-buffer-substring feedmail-raw-text-buffer)
- ;; require one newline at the end.
+ ;; Require one newline at the end.
(goto-char (point-max))
(or (= (preceding-char) ?\n) (insert ?\n))
(and (fboundp 'expand-mail-aliases) mail-aliases))
(expand-mail-aliases (point-min) eoh-marker))
- ;; make it pretty
+ ;; Make it pretty.
(if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker))
- ;; ignore any blank lines in the header
+ ;; Ignore any blank lines in the header.
(goto-char (point-min))
- (while (and (re-search-forward "\n\n\n*" eoh-marker t) (< (point) eoh-marker))
+ (while (and (re-search-forward "\n\n\n*" eoh-marker t)
+ (< (point) eoh-marker))
(replace-match "\n"))
(let ((case-fold-search t) (addr-regexp))
(goto-char (point-min))
- ;; there are some RFC-822 combinations/cases missed here,
- ;; but probably good enough and what users expect
+ ;; There are some RFC-822 combinations/cases missed here,
+ ;; but probably good enough and what users expect.
;;
- ;; use resent-* stuff only if there is at least one non-empty one
+ ;; Use resent-* stuff only if there is at least one non-empty one.
(setq feedmail-is-a-resend
(re-search-forward
- ;; header name, followed by optional whitespace, followed by
- ;; non-whitespace, followed by anything, followed by newline;
- ;; the idea is empty Resent-* headers are ignored
+ ;; Header name, followed by optional whitespace, followed by
+ ;; non-whitespace, followed by anything, followed by
+ ;; newline; the idea is empty Resent-* headers are ignored.
"^\\(Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)\\s-*\\S-+.*$"
eoh-marker t))
- ;; if we say so, gather the Bcc stuff before the main course
- (if (eq feedmail-deduce-bcc-where 'first)
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
- ;; the main course
- (if (or (eq feedmail-deduce-bcc-where 'first) (eq feedmail-deduce-bcc-where 'last))
- ;; handled by first or last cases, so don't get Bcc stuff
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtc) (setq addr-regexp a-re-dtc))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))
- ;; not handled by first or last cases, so also get Bcc stuff
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtcb) (setq addr-regexp a-re-dtcb))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
- ;; if we say so, gather the Bcc stuff after the main course
- (if (eq feedmail-deduce-bcc-where 'last)
- (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
- (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
- (if (not feedmail-address-list) (error "FQM: Sending...abandoned, no addressees"))
- ;; not needed, but meets user expectations
+ ;; If we say so, gather the Bcc stuff before the main course.
+ (when (eq feedmail-deduce-bcc-where 'first)
+ (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
+ (setq feedmail-address-list
+ (feedmail-deduce-address-list
+ feedmail-prepped-text-buffer (point-min) eoh-marker
+ addr-regexp feedmail-address-list)))
+ ;; The main course.
+ (setq addr-regexp
+ (if (memq feedmail-deduce-bcc-where '(first last))
+ ;; Handled by first or last cases, so don't get
+ ;; Bcc stuff.
+ (if feedmail-is-a-resend a-re-rtc a-re-dtc)
+ ;; Not handled by first or last cases, so also get
+ ;; Bcc stuff.
+ (if feedmail-is-a-resend a-re-rtcb a-re-dtcb)))
+ (setq feedmail-address-list
+ (feedmail-deduce-address-list
+ feedmail-prepped-text-buffer (point-min) eoh-marker
+ addr-regexp feedmail-address-list))
+ ;; If we say so, gather the Bcc stuff after the main course.
+ (when (eq feedmail-deduce-bcc-where 'last)
+ (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
+ (setq feedmail-address-list
+ (feedmail-deduce-address-list
+ feedmail-prepped-text-buffer (point-min) eoh-marker
+ addr-regexp feedmail-address-list)))
+ (if (not feedmail-address-list)
+ (error "FQM: Sending...abandoned, no addressees"))
+ ;; Not needed, but meets user expectations.
(setq feedmail-address-list (nreverse feedmail-address-list))
;; Find and handle any Bcc fields.
- (setq bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
- (setq resent-bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
- (if (and bcc-holder (not feedmail-nuke-bcc))
- (progn (goto-char (point-min))
- (insert bcc-holder)))
- (if (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
- (progn (goto-char (point-min))
- (insert resent-bcc-holder)))
+ (setq bcc-holder
+ (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
+ (setq resent-bcc-holder
+ (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
+ (when (and bcc-holder (not feedmail-nuke-bcc))
+ (goto-char (point-min))
+ (insert bcc-holder))
+ (when (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
+ (goto-char (point-min))
+ (insert resent-bcc-holder))
(goto-char (point-min))
;; fiddle about, fiddle about, fiddle about....
(feedmail-fiddle-sender)
(feedmail-fiddle-x-mailer)
(feedmail-fiddle-message-id
- (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
+ (or feedmail-queue-runner-is-active
+ (buffer-file-name feedmail-raw-text-buffer)))
(feedmail-fiddle-date
- (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
- (feedmail-fiddle-list-of-fiddle-plexes feedmail-fiddle-plex-user-list)
+ (or feedmail-queue-runner-is-active
+ (buffer-file-name feedmail-raw-text-buffer)))
+ (feedmail-fiddle-list-of-fiddle-plexes
+ feedmail-fiddle-plex-user-list)
;; don't send out a blank headers of various sorts
;; (this loses on continued line with a blank first line)
(goto-char (point-min))
(and feedmail-nuke-empty-headers ; hey, who's an empty-header?
- (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t)
+ (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n"
+ eoh-marker t)
(replace-match ""))))
(feedmail-say-debug "last chance hook: %s" feedmail-last-chance-hook)
(confirm (cond
((eq feedmail-confirm-outgoing 'immediate)
(not feedmail-queue-runner-is-active))
- ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active)
+ ((eq feedmail-confirm-outgoing 'queued)
+ feedmail-queue-runner-is-active)
(t feedmail-confirm-outgoing)))
(fullframe (cond
((eq feedmail-display-full-frame 'immediate)
(not feedmail-queue-runner-is-active))
- ((eq feedmail-display-full-frame 'queued) feedmail-queue-runner-is-active)
+ ((eq feedmail-display-full-frame 'queued)
+ feedmail-queue-runner-is-active)
(t feedmail-display-full-frame))))
(if fullframe
(progn
(switch-to-buffer feedmail-prepped-text-buffer t)
(delete-other-windows)))
- (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer))
- (let ((user-mail-address (feedmail-envelope-deducer eoh-marker)))
+ (if (or (not confirm)
+ (feedmail-one-last-look feedmail-prepped-text-buffer))
+ (let ((user-mail-address
+ (feedmail-envelope-deducer eoh-marker)))
(feedmail-say-debug "give it to buffer-eater")
(feedmail-give-it-to-buffer-eater)
(feedmail-say-debug "gave it to buffer-eater")
- (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer)))
- (progn ; if a file but not running the queue, offer to delete it
+ (if (and (not feedmail-queue-runner-is-active)
+ (setq also-file
+ (buffer-file-name feedmail-raw-text-buffer)))
+ (progn
+ ;; If a file but not running the queue,
+ ;; offer to delete it
(setq also-file (expand-file-name also-file))
(when (or feedmail-queue-auto-file-nuke
(y-or-n-p
(format "FQM: Delete message file %s? "
also-file)))
- ;; if we delete the affiliated file, get rid
+ ;; If we delete the affiliated file, get rid
;; of the file name association and make sure we
- ;; don't annoy people with a prompt on exit
+ ;; don't annoy people with a prompt on exit.
(delete-file also-file)
(with-current-buffer feedmail-raw-text-buffer
(setq buffer-offer-save nil)
(setq buffer-file-name nil)))))
(goto-char (point-min))
- ;; re-insert and handle any Fcc fields (and, optionally, any Bcc).
- (if fcc (letf (((default-value 'buffer-file-type)
- feedmail-force-binary-write))
- (insert fcc)
- (if (not feedmail-nuke-bcc-in-fcc)
- (progn (if bcc-holder (insert bcc-holder))
- (if resent-bcc-holder (insert resent-bcc-holder))))
-
- (run-hooks 'feedmail-before-fcc-hook)
-
- (if feedmail-nuke-body-in-fcc
- (progn (goto-char eoh-marker)
- (if (natnump feedmail-nuke-body-in-fcc)
- (forward-line feedmail-nuke-body-in-fcc))
- (delete-region (point) (point-max))
- ))
- (mail-do-fcc eoh-marker)
- )))
- ;; user bailed out of one-last-look
+ ;; Re-insert and handle any Fcc fields (and, optionally,
+ ;; any Bcc).
+ (when fcc
+ (let ((old (default-value 'buffer-file-type)))
+ (unwind-protect
+ (progn
+ (setq-default buffer-file-type
+ feedmail-force-binary-write)
+ (insert fcc)
+ (unless feedmail-nuke-bcc-in-fcc
+ (if bcc-holder (insert bcc-holder))
+ (if resent-bcc-holder
+ (insert resent-bcc-holder)))
+
+ (run-hooks 'feedmail-before-fcc-hook)
+
+ (when feedmail-nuke-body-in-fcc
+ (goto-char eoh-marker)
+ (if (natnump feedmail-nuke-body-in-fcc)
+ (forward-line feedmail-nuke-body-in-fcc))
+ (delete-region (point) (point-max)))
+ (mail-do-fcc eoh-marker))
+ (setq-default buffer-file-type old)))))
+ ;; User bailed out of one-last-look.
(if feedmail-queue-runner-is-active
(throw 'skip-me-q 'skip-me-q)
(throw 'skip-me-i 'skip-me-i))
)))) ; unwind-protect body (save-excursion)
- ;; unwind-protect cleanup forms
+ ;; unwind-protect cleanup forms.
(kill-buffer feedmail-prepped-text-buffer)
(set-buffer feedmail-error-buffer)
(if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer)
- (progn (display-buffer feedmail-error-buffer)
- ;; read fast ... the meter is running
- (if feedmail-queue-runner-is-active
- (progn
- (ding t)
- (feedmail-say-chatter "Sending...failed")))
- (error "FQM: Sending...failed")))
+ (display-buffer feedmail-error-buffer)
+ ;; Read fast ... the meter is running.
+ (if feedmail-queue-runner-is-active
+ (progn
+ (ding t)
+ (feedmail-say-chatter "Sending...failed")))
+ (error "FQM: Sending...failed"))
(set-buffer feedmail-raw-text-buffer))
) ; let
- (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
- (progn
- (feedmail-queue-reminder 'after-immediate)
- (sit-for feedmail-queue-chatty-sit-for)))
- )
+ (when (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
+ (feedmail-queue-reminder 'after-immediate)
+ (sit-for feedmail-queue-chatty-sit-for)))
(defun feedmail-fiddle-header (name value &optional action folding)
;;; Code:
-(eval-when-compile
- (require 'cl)
- (defvar filladapt-token-table))
+(eval-when-compile (require 'cl-lib))
+(defvar filladapt-token-table)
(defgroup footnote nil
"Support for footnotes in mail and news messages."
:type 'string
:group 'footnote)
-(defvar footnote-signature-separator (if (boundp 'message-signature-separator)
- message-signature-separator
- "^-- $")
- "*String used to recognize .signatures.")
+(defcustom footnote-signature-separator (if (boundp 'message-signature-separator)
+ message-signature-separator
+ "^-- $")
+ "Regexp used by Footnote mode to recognize signatures."
+ :type 'regexp
+ :group 'footnote)
;;; Private variables
the buffer is narrowed to the footnote body. The restriction is removed
by using `Footnote-back-to-message'."
(interactive "*P")
- (let (num)
- (if footnote-text-marker-alist
- (if (< (point) (cadar (last footnote-pointer-marker-alist)))
- (setq num (Footnote-make-hole))
- (setq num (1+ (caar (last footnote-text-marker-alist)))))
- (setq num 1))
+ (let ((num
+ (if footnote-text-marker-alist
+ (if (< (point) (cl-cadar (last footnote-pointer-marker-alist)))
+ (Footnote-make-hole)
+ (1+ (caar (last footnote-text-marker-alist))))
+ 1)))
(message "Adding footnote %d" num)
(Footnote-insert-footnote num)
(insert-before-markers (make-string footnote-body-tag-spacing ? ))
:group 'mail)
(defcustom hashcash-default-payment 20
- "*The default number of bits to pay to unknown users.
+ "The default number of bits to pay to unknown users.
If this is zero, no payment header will be generated.
See `hashcash-payment-alist'."
:type 'integer
:group 'hashcash)
(defcustom hashcash-payment-alist '()
- "*An association list mapping email addresses to payment amounts.
+ "An association list mapping email addresses to payment amounts.
Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where
ADDR is the email address of the intended recipient and AMOUNT is
the value of hashcash payment to be made to that user. STRING, if
:group 'hashcash)
(defcustom hashcash-default-accept-payment 20
- "*The default minimum number of bits to accept on incoming payments."
+ "The default minimum number of bits to accept on incoming payments."
:type 'integer
:group 'hashcash)
(defcustom hashcash-accept-resources `((,user-mail-address nil))
- "*An association list mapping hashcash resources to payment amounts.
+ "An association list mapping hashcash resources to payment amounts.
Resources named here are to be accepted in incoming payments. If the
corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
is used instead."
:group 'hashcash)
(defcustom hashcash-path (executable-find "hashcash")
- "*The path to the hashcash binary."
+ "The path to the hashcash binary."
:group 'hashcash)
(defcustom hashcash-extra-generate-parameters nil
- "*A list of parameter strings passed to `hashcash-path' when minting.
+ "A list of parameter strings passed to `hashcash-path' when minting.
For example, you may want to set this to '(\"-Z2\") to reduce header length."
:type '(repeat string)
:group 'hashcash)
(defcustom hashcash-double-spend-database "hashcash.db"
- "*The path to the double-spending database."
+ "The path to the double-spending database."
:group 'hashcash)
(defcustom hashcash-in-news nil
- "*Specifies whether or not hashcash payments should be made to newsgroups."
+ "Specifies whether or not hashcash payments should be made to newsgroups."
:type 'boolean
:group 'hashcash)
;;
(defcustom mail-extr-guess-middle-initial nil
- "*Whether to try to guess middle initial from mail address.
+ "Whether to try to guess middle initial from mail address.
If true, then when we see an address like \"John Smith <jqs@host.com>\"
we will assume that \"John Q. Smith\" is the fellow's name."
:type 'boolean
:group 'mail-extr)
(defcustom mail-extr-ignore-single-names nil
- "*Whether to ignore a name that is just a single word.
+ "Whether to ignore a name that is just a single word.
If true, then when we see an address like \"Idiot <dumb@stupid.com>\"
we will act as though we couldn't find a full name in the address."
:type 'boolean
(defcustom mail-extr-full-name-prefixes
(purecopy
"\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]")
- "*Matches prefixes to the full name that identify a person's position.
+ "Matches prefixes to the full name that identify a person's position.
These are stripped from the full name because they do not contribute to
uniquely identifying the person."
:type 'regexp
:group 'mail-extr)
(defcustom mail-extr-@-binds-tighter-than-! nil
- "*Whether the local mail transport agent looks at ! before @."
+ "Whether the local mail transport agent looks at ! before @."
:type 'boolean
:group 'mail-extr)
(defcustom mail-extr-mangle-uucp nil
- "*Whether to throw away information in UUCP addresses
+ "Whether to throw away information in UUCP addresses
by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
:type 'boolean
:group 'mail-extr)
))
(defcustom mail-extr-disable-voodoo "\\cj"
- "*If it is a regexp, names matching it will never be modified.
+ "If it is a regexp, names matching it will never be modified.
If it is neither nil nor a string, modifying of names will never take
place. It affects how `mail-extract-address-components' works."
:type '(choice (regexp :size 0)
;; time.
;;
;; To use this package, put it in a directory in your load-path, and
-;; put this in your .emacs file:
+;; put this in your init file:
;;
;; (load "mail-hist" nil t)
;;
previous/next input.")
(defcustom mail-hist-history-size (or kill-ring-max 1729)
- "*The maximum number of elements in a mail field's history.
+ "The maximum number of elements in a mail field's history.
Oldest elements are dumped first."
:type 'integer
:group 'mail-hist)
;;;###autoload
(defcustom mail-hist-keep-history t
- "*Non-nil means keep a history for headers and text of outgoing mail."
+ "Non-nil means keep a history for headers and text of outgoing mail."
:type 'boolean
:group 'mail-hist)
(cdr (assoc header mail-hist-header-ring-alist)))
(defcustom mail-hist-text-size-limit nil
- "*Don't store any header or body with more than this many characters.
+ "Don't store any header or body with more than this many characters.
If the value is nil, that means no limit on text size."
:type '(choice (const nil) integer)
:group 'mail-hist)
mail-abbrevs)
(message "Parsing %s... done" file))
-(defvar mail-alias-separator-string ", "
- "*A string inserted between addresses in multi-address mail aliases.
+(defcustom mail-alias-separator-string ", "
+ "String inserted between addresses in multi-address mail aliases.
This has to contain a comma, so \", \" is a reasonable value. You might
-also want something like \",\\n \" to get each address on its own line.")
+also want something like \",\\n \" to get each address on its own line."
+ :type 'string
+ :group 'mail-abbrev)
;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases
;; to be called before expanding abbrevs if it's necessary.
(defun mail-abbrev-expand-hook ()
"For use as the fourth arg to `define-abbrev'.
After expanding a mail-abbrev, if Auto Fill mode is on and we're past the
-fill-column, break the line at the previous comma, and indent the next line."
- ;; Disable abbrev mode to avoid recursion in indent-relative expanding
- ;; part of the abbrev expansion as an abbrev itself.
- (let ((abbrev-mode nil))
- (save-excursion
- (let ((p (point))
- bol comma fp)
- (beginning-of-line)
- (setq bol (point))
- (goto-char p)
- (while (and auto-fill-function
- (>= (current-column) fill-column)
- (search-backward "," bol t))
- (setq comma (point))
- (forward-char 1) ; Now we are just past the comma.
- (insert "\n")
- (delete-horizontal-space)
- (setq p (point))
- (indent-relative)
- (setq fp (buffer-substring p (point)))
- ;; Go to the end of the new line.
- (end-of-line)
- (if (> (current-column) fill-column)
- ;; It's still too long; do normal auto-fill.
- (let ((fill-prefix (or fp "\t")))
- (do-auto-fill)))
- ;; Resume the search.
- (goto-char comma)
- )))))
+fill-column, break the line at the previous comma, and indent the next line
+with a space."
+ (when auto-fill-function
+ (let (p)
+ (save-excursion
+ (while (>= (current-column) fill-column)
+ (while (and (search-backward "," (point-at-bol) 'move)
+ (>= (current-column) (1- fill-column))
+ (setq p (point))))
+ (when (or (not (bolp))
+ (and p (goto-char p)))
+ (setq p nil)
+ (forward-char 1)
+ (insert "\n")
+ (when (looking-at "[\t ]+")
+ (delete-region (point) (match-end 0)))
+ (insert " ")
+ (end-of-line)))))))
\f
;;; Syntax tables and abbrev-expansion
-(defvar mail-abbrev-mode-regexp
+(defcustom mail-abbrev-mode-regexp
"^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):"
- "*Regexp to select mail-headers in which mail abbrevs should be expanded.
+ "Regexp matching mail headers in which mail abbrevs should be expanded.
This string will be handed to `looking-at' with point at the beginning
of the current line; if it matches, abbrev mode will be turned on, otherwise
it will be turned off. (You don't need to worry about continuation lines.)
This should be set to match those mail fields in which you want abbreviations
-turned on.")
+turned on."
+ :type 'regexp
+ :group 'mail-abbrev)
(defvar mail-abbrev-syntax-table nil
"The syntax-table used for abbrev-expansion purposes.
"Perform completion on header field or word preceding point.
Completable headers are according to `mail-complete-alist'. If none matches
current header, calls `mail-complete-function' and passes prefix ARG if any."
+ (declare (obsolete mail-completion-at-point-function "24.1"))
(interactive "P")
;; Read the defaults first, if we have not done so.
(sendmail-sync-aliases)
(if data
(apply #'completion-in-region data)
(funcall mail-complete-function arg))))
-(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1")
(defun mail-completion-expand (table)
"Build new completion table that expands aliases.
;;; Code:
-(eval-when-compile
- (require 'cl))
-
(defun mail-header-extract ()
"Extract headers from current buffer after point.
Returns a header alist, where each element is a cons cell (name . value),
value is a list, its first element is the original value of the header,
with any subsequent elements being the result of parsing the value.
If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
+ (declare (gv-setter (lambda (value)
+ `(mail-header-set ,header ,value ,header-alist))))
(cdr (assq header (or header-alist headers))))
(defun mail-header-set (header value &optional header-alist)
(nconc alist (list (cons header value)))))
value)
-(defsetf mail-header (header &optional header-alist) (value)
- `(mail-header-set ,header ,value ,header-alist))
-
(defun mail-header-merge (merge-rules headers)
"Return a new header alist with MERGE-RULES applied to HEADERS.
MERGE-RULES is an alist whose keys are header names (symbols) and whose
:group 'processes)
(defcustom metamail-program-name "metamail"
- "*Metamail program name."
+ "Metamail program name."
:type 'string
:group 'metamail)
(defcustom metamail-mailer-name "emacs"
- "*Mailer name set to MM_MAILER environment variable."
+ "Mailer name set to MM_MAILER environment variable."
:type 'string
:group 'metamail)
(defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
- "*Environment variables passed to `metamail'.
+ "Environment variables passed to `metamail'.
It must be a list of strings that have the format ENVVARNAME=VALUE.
It is not expected to be altered globally by `set' or `setq'.
Instead, change its value temporary using `let' or `let*' form.")
(defcustom metamail-switches '("-x" "-d" "-z")
- "*Switches for `metamail' program.
+ "Switches for `metamail' program.
`-z' is required to remove zap file.
It is not expected to be altered globally by `set' or `setq'.
Instead, change its value temporary using `let' or `let*' form.
;; Useful settings for VM
;; vm-auto-get-new-mail should be t (the default).
-;; Acknowledgements
+;; Acknowledgments
;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for
;; setting up vm-spool-files.
)
(defcustom mspools-update nil
- "*Non-nil means update *spools* buffer after visiting any folder."
+ "Non-nil means update *spools* buffer after visiting any folder."
:type 'boolean
:group 'mspools)
(defcustom mspools-suffix "spool"
- "*Extension used for spool files (not including full stop)."
+ "Extension used for spool files (not including full stop)."
:type 'string
:group 'mspools)
(defcustom mspools-using-vm (fboundp 'vm)
- "*Non-nil if VM is used as mail reader, otherwise RMAIL is used."
+ "Non-nil if VM is used as mail reader, otherwise RMAIL is used."
:type 'boolean
:group 'mspools)
(if (boundp 'vm-folder-directory)
vm-folder-directory
"~/MAIL/")
- "*Directory where mail folders are kept. Ensure it has a trailing /.
+ "Directory where mail folders are kept. Ensure it has a trailing /.
Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
:type 'directory
:group 'mspools)
(defcustom mspools-vm-system-mail (or (getenv "MAIL")
(concat rmail-spool-directory
(user-login-name)))
- "*Spool file for main mailbox. Only used by VM.
+ "Spool file for main mailbox. Only used by VM.
This needs to be set to your primary mail spool - mspools will not run
without it. By default this will be set to the environment variable
$MAIL. Otherwise it will use `rmail-spool-directory' to guess where
;;
;; this is intended as a replacement for mailto.el
;;
-;; acknowledgements:
+;; acknowledgments:
;;
;; the functions that deal w/ unhexifying in this file were basically
;; taken from w3 -- i hope to replace them w/ something else soon OR
(require 'mail-utils)
(require 'rfc2047)
+(declare-function compilation--message->loc "compile" (cl-x) t)
+(declare-function epa--find-coding-system-for-mime-charset "epa" (mime-charset))
+
(defconst rmail-attribute-header "X-RMAIL-ATTRIBUTES"
"The header that stores the Rmail attribute data.")
"The current header display style choice, one of
'normal (selected headers) or 'full (all headers).")
-;; rmail-spool-directory and rmail-file-name are defined in paths.el.
-
(defgroup rmail nil
"Mail reader for Emacs."
:group 'mail)
:prefix "rmail-edit-"
:group 'rmail)
+;;;###autoload
+(defcustom rmail-file-name (purecopy "~/RMAIL")
+ "Name of user's primary mail file."
+ :type 'string
+ :group 'rmail
+ :version "21.1")
+
+;;;###autoload
+(put 'rmail-spool-directory 'standard-value
+ '((cond ((file-exists-p "/var/mail") "/var/mail/")
+ ((file-exists-p "/var/spool/mail") "/var/spool/mail/")
+ ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/")
+ (t "/usr/spool/mail/"))))
+
+;;;###autoload
+(defcustom rmail-spool-directory
+ (purecopy
+ (cond ((file-exists-p "/var/mail")
+ ;; SVR4 and recent BSD are said to use this.
+ ;; Rather than trying to know precisely which systems use it,
+ ;; let's assume this dir is never used for anything else.
+ "/var/mail/")
+ ;; Many GNU/Linux systems use this name.
+ ((file-exists-p "/var/spool/mail") "/var/spool/mail/")
+ ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/")
+ (t "/usr/spool/mail/")))
+ "Name of directory used by system mailer for delivering new mail.
+Its name should end with a slash."
+ :initialize 'custom-initialize-delay
+ :type 'directory
+ :group 'rmail)
+
+;;;###autoload(custom-initialize-delay 'rmail-spool-directory nil)
+
(defcustom rmail-movemail-program nil
"If non-nil, the file name of the `movemail' program."
:group 'rmail-retrieve
(defvar rmail-last-regexp nil)
(put 'rmail-last-regexp 'permanent-local t)
+;; Note that rmail-output-read-file-name modifies this.
(defcustom rmail-default-file "~/xmail"
"Default file name for \\[rmail-output]."
:type 'file
`rmail-insert-mime-forwarded-message-function', and
`rmail-insert-mime-resent-message-function'.")
-;; FIXME this is unused since 23.1.
-(defvar rmail-decode-mime-charset t
- "*Non-nil means a message is decoded by MIME's charset specification.
-If this variable is nil, or the message has not MIME specification,
-the message is decoded as normal way.
-
-If the variable `rmail-enable-mime' is non-nil, this variable is
-ignored, and all the decoding work is done by a feature specified by
-the variable `rmail-mime-feature'.")
-
-(make-obsolete-variable 'rmail-decode-mime-charset
- "it does nothing." "23.1")
-
(defvar rmail-mime-charset-pattern
(concat "^content-type:[ \t]*text/plain;"
"\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
specifying headers which should not be copied into the new message."
(interactive)
(require 'mail-utils)
+ (if rmail-enable-mime
+ (with-current-buffer rmail-buffer
+ (if (rmail-mime-message-p)
+ (let ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer rmail-buffer))
+ (rmail-mime-toggle-raw 'raw)))))
+
(let ((rmail-this-buffer (current-buffer))
(msgnum rmail-current-message)
bounce-start bounce-end bounce-indent resending
;;; Speedbar support for RMAIL files.
(eval-when-compile (require 'speedbar))
-(defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
- "*This regex is used to match folder names to be displayed in speedbar.
-Enabling this will permit speedbar to display your folders for easy
-browsing, and moving of messages.")
+(defcustom rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
+ "Regexp matching Rmail folder names to be displayed in Speedbar.
+Enabling this permits Speedbar to display your folders for easy
+browsing, and moving of messages."
+ :type 'regexp
+ :group 'rmail
+ :group 'speedbar)
(defvar rmail-speedbar-last-user nil
"The last user to be displayed in the speedbar.")
;;; Start of automatically extracted autoloads.
\f
;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el"
-;;;;;; "7d558f958574f6003fa474ce2f3c80a8")
+;;;;;; "78b8b7d5c679935c118d595d473d7c5e")
;;; Generated autoloads from rmailedit.el
(autoload 'rmail-edit-current-message "rmailedit" "\
;;;***
\f
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "cd7656f82944d0b92b0d093a5f3a4c36")
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "0c18b83f914803d1216e1a9df7ea5275")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\
;;;***
\f
;;;### (autoloads (unforward-rmail-message undigestify-rmail-message)
-;;;;;; "undigest" "undigest.el" "a31a35802a2adbc51be42959c3043dbd")
+;;;;;; "undigest" "undigest.el" "9f270a2571bbbbfabc27498a8d4089c7")
;;; Generated autoloads from undigest.el
(autoload 'undigestify-rmail-message "undigest" "\
;; Even if the message is in `raw' state, boundaries etc
;; are still missing. All we can do is insert the real
;; raw message. (Bug#9840)
+ ;; FIXME? Since the 2012-09-17 changes to rmail-mime,
+ ;; can we just use that function now?
(when (and entity
(not (equal "text/plain"
(car (rmail-mime-entity-type entity)))))
;; Enter the raw mode.
(rmail-mime-raw-mode entity)
;; Enter the shown mode.
- (rmail-mime-shown-mode entity))
- (let ((inhibit-read-only t)
- (modified (buffer-modified-p)))
- (save-excursion
- (goto-char (aref segment 1))
- (rmail-mime-insert entity)
- (restore-buffer-modified-p modified)))))
+ (rmail-mime-shown-mode entity)
+ (let ((inhibit-read-only t)
+ (modified (buffer-modified-p)))
+ (save-excursion
+ (goto-char (aref segment 1))
+ (rmail-mime-insert entity)
+ (restore-buffer-modified-p modified))))))
(defun rmail-mime-toggle-hidden ()
"Hide or show the body of the MIME-entity at point."
(if (rmail-mime-display-header current)
(delete-char (- (aref segment 2) (aref segment 1))))
(insert-buffer-substring rmail-mime-mbox-buffer
- (aref header 0) (aref header 1)))
+ (aref header 0) (aref header 1)))
;; tagline
(if (rmail-mime-display-tagline current)
(delete-char (- (aref segment 3) (aref segment 2))))
(interactive (list current-prefix-arg nil))
(if rmail-enable-mime
(with-current-buffer rmail-buffer
- (if (rmail-mime-message-p)
- (let ((rmail-mime-mbox-buffer rmail-view-buffer)
- (rmail-mime-view-buffer rmail-buffer)
- (entity (get-text-property
- (progn
- (or arg (goto-char (point-min)))
- (point)) 'rmail-mime-entity)))
- (if (or (not arg) entity) (rmail-mime-toggle-raw state)))
+ (if (or (rmail-mime-message-p)
+ (get-text-property (point-min) 'rmail-mime-hidden))
+ (let* ((hidden (get-text-property (point-min) 'rmail-mime-hidden))
+ (desired-hidden (if state (eq state 'raw) (not hidden))))
+ (unless (eq hidden desired-hidden)
+ (if (not desired-hidden)
+ (rmail-show-message rmail-current-message)
+ (let ((rmail-enable-mime nil)
+ (inhibit-read-only t))
+ (rmail-show-message rmail-current-message)
+ (add-text-properties (point-min) (point-max) '(rmail-mime-hidden t))))))
(message "Not a MIME message, just toggling headers")
(rmail-toggle-header)))
(let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
:type 'boolean
:group 'rmail-output)
-;; FIXME risky?
(defcustom rmail-output-file-alist nil
"Alist matching regexps to suggested output Rmail files.
This is a list of elements of the form (REGEXP . NAME-EXP).
(string :tag "File Name")
sexp)))
:group 'rmail-output)
+;; This is risky because NAME-EXP gets evalled.
;;;###autoload(put 'rmail-output-file-alist 'risky-local-variable t)
(defcustom rmail-fields-not-to-output nil
(defun rmail-output-read-file-name ()
"Read the file name to use for `rmail-output'.
-Set `rmail-default-file' to this name as well as returning it."
- (let ((default-file
- (let (answer tail)
- (setq tail rmail-output-file-alist)
- ;; Suggest a file based on a pattern match.
- (while (and tail (not answer))
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward (car (car tail)) nil t)
- (setq answer (eval (cdr (car tail)))))
- (setq tail (cdr tail))))
+Set `rmail-default-file' to this name as well as returning it.
+This uses `rmail-output-file-alist'."
+ (let* ((default-file
+ (or
+ (when rmail-output-file-alist
+ (or rmail-buffer (error "There is no Rmail buffer"))
+ (save-current-buffer
+ (set-buffer rmail-buffer)
+ (let ((beg (rmail-msgbeg rmail-current-message))
+ (end (rmail-msgend rmail-current-message)))
+ (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region beg end)
+ (let ((tail rmail-output-file-alist)
+ answer err)
+ ;; Suggest a file based on a pattern match.
+ (while (and tail (not answer))
+ (goto-char (point-min))
+ (if (re-search-forward (caar tail) nil t)
+ (setq answer
+ (condition-case err
+ (eval (cdar tail))
+ (error
+ (display-warning
+ :error
+ (format "Error evaluating \
+`rmail-output-file-alist' element:\nregexp: %s\naction: %s\nerror: %S\n"
+ (caar tail) (cdar tail) err))
+ nil))))
+ (setq tail (cdr tail)))
+ answer))))))
;; If no suggestion, use same file as last time.
- (or answer rmail-default-file))))
- (let ((read-file
- (expand-file-name
- (read-file-name
- (concat "Output message to mail file (default "
- (file-name-nondirectory default-file)
- "): ")
- (file-name-directory default-file)
- (abbreviate-file-name default-file))
- (file-name-directory default-file))))
- (setq rmail-default-file
- (if (file-directory-p read-file)
- (expand-file-name (file-name-nondirectory default-file)
- read-file)
- (expand-file-name
- (or read-file (file-name-nondirectory default-file))
- (file-name-directory default-file)))))))
+ rmail-default-file))
+ (read-file
+ (expand-file-name
+ (read-file-name
+ (concat "Output message to mail file (default "
+ (file-name-nondirectory default-file)
+ "): ")
+ (file-name-directory default-file)
+ (abbreviate-file-name default-file))
+ (file-name-directory default-file))))
+ (setq rmail-default-file
+ (if (file-directory-p read-file)
+ (expand-file-name (file-name-nondirectory default-file)
+ read-file)
+ (expand-file-name
+ (or read-file (file-name-nondirectory default-file))
+ (file-name-directory default-file))))))
(defun rmail-delete-unwanted-fields (preserve)
"Delete all headers matching `rmail-fields-not-to-output'.
;; (kill-local-variable 'enable-multibyte-characters)
(set-buffer-multibyte (default-value 'enable-multibyte-characters))
(if current-input-method
- (inactivate-input-method))
+ (deactivate-input-method))
;; Local variables for Mail mode.
(setq mail-send-actions actions)
(defun mail-bury (&optional arg)
"Bury this mail buffer."
(let ((newbuf (other-buffer (current-buffer)))
- (return-action mail-return-action)
- some-rmail)
+ (return-action mail-return-action))
(bury-buffer (current-buffer))
;; If there is an Rmail buffer, return to it nicely
;; even if this message was not started by an Rmail command.
;;;###autoload
(defvar sendmail-coding-system nil
- "*Coding system for encoding the outgoing mail.
+ "Coding system for encoding the outgoing mail.
This has higher priority than the default `buffer-file-coding-system'
and `default-sendmail-coding-system',
but lower priority than the local value of `buffer-file-coding-system'.
(defun mail-sent-via ()
"Make a Sent-via header line from each To or CC header line."
+ (declare (obsolete "nobody can remember what it is for." "24.1"))
(interactive)
(save-excursion
;; put a marker at the end of the header
(point)))))
;; Insert a copy, with altered header field name.
(insert-before-markers "Sent-via:" to-line))))))
-
-(make-obsolete 'mail-sent-via "nobody can remember what it is for." "24.1")
-
\f
(defun mail-to ()
"Move point to end of To field, creating it if necessary."
;; local binding in the mail buffer will take effect.
(smtpmail-mail-address
(or (and mail-specify-envelope-from (mail-envelope-from))
- (smtpmail-user-mail-address)
- (let ((from (mail-fetch-field "from")))
+ (let ((from (mail-fetch-field "from")))
(and from
- (cadr (mail-extract-address-components from))))))
+ (cadr (mail-extract-address-components from))))
+ (smtpmail-user-mail-address)))
(smtpmail-code-conv-from
(if enable-multibyte-characters
(let ((sendmail-coding-system smtpmail-code-conv-from))
(or smtpmail-mail-address
(and mail-specify-envelope-from
(mail-envelope-from))
- (smtpmail-user-mail-address)
- ;; Fall back on the From: header as the envelope From
- ;; address.
(let ((from (mail-fetch-field "from")))
(and from
- (cadr (mail-extract-address-components from))))))
+ (cadr (mail-extract-address-components from))))
+ (smtpmail-user-mail-address)))
response-code
process-buffer
result
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; end user configuration variables
\f
-(define-obsolete-variable-alias 'sc-version 'emacs-version "23.1")
-
(defvar sc-mail-info nil
"Alist of mail header information gleaned from reply buffer.")
(defvar sc-attributions nil
(define-key map "r" 'sc-recite-region)
(define-key map "\C-p" 'sc-raw-mode-toggle)
(define-key map "u" 'sc-uncite-region)
- (define-key map "v" 'sc-version)
(define-key map "w" 'sc-insert-reference)
(define-key map "\C-t" sc-T-keymap)
- (define-key map "\C-b" 'sc-submit-bug-report)
(define-key map "?" 'sc-describe)
map)
"Keymap for Supercite quasi-mode.")
(insert (sc-mail-field "sc-citation"))
(error "Line is already cited"))))
-;; The argument logic here is crazy.
-(defun sc-version (message)
- "Return the current Supercite version.
-If MESSAGE is non-nil (interactively, with no prefix argument),
-echoes the version in the minibuffer. Otherwise, inserts the
-version at point."
- (interactive (list (not current-prefix-arg)))
- (let ((verstr (format "Using Supercite.el %s" emacs-version)))
- (if message
- (message verstr)
- (insert "`sc-version' says: " verstr))))
-
-(make-obsolete 'sc-version 'emacs-version "23.1")
-
(defun sc-describe ()
"Read the Supercite info node."
(interactive)
(info "(SC)top"))
-(make-obsolete 'sc-describe "read the SC manual using `info'." "23.1")
-
-(define-obsolete-function-alias 'sc-submit-bug-report 'report-emacs-bug "23.1")
-
\f
;; useful stuff
(provide 'supercite)
;; Usage:
;; Place uce.el in your load-path (and optionally byte-compile it).
-;; Add the following line to your ~/.emacs:
+;; Add the following line to your init file:
;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
;; If you want to use it with Gnus rather than Rmail:
;; (setq uce-mail-reader 'gnus)
(defcustom rmail-forward-separator-regex
"^----.*\\([Ff]orwarded\\|[Oo]riginal\\).*[Mm]essage"
- "*Regexp to match the string that introduces forwarded messages.
+ "Regexp to match the string that introduces forwarded messages.
This is not a header, but a string contained in the body of the message.
You may need to customize it for local needs."
:type 'regexp
(error "This file is not in Babyl format"))
;; Decode the file contents just as Rmail did.
- (let ((modifiedp (buffer-modified-p))
- (coding-system rmail-file-coding-system)
+ (let ((coding-system rmail-file-coding-system)
from to)
(goto-char (point-min))
(search-forward "\n\^_" nil t) ; Skip BABYL header.
:group 'news)
(defcustom uudecode-decoder-program "uudecode"
- "*Non-nil value should be a string that names a uu decoder.
+ "Non-nil value should be a string that names a uu decoder.
The program should expect to read uu data on its standard
input and write the converted data to its standard output."
:type 'string
:group 'uudecode)
(defcustom uudecode-decoder-switches nil
- "*List of command line flags passed to `uudecode-decoder-program'."
+ "List of command line flags passed to `uudecode-decoder-program'."
:group 'uudecode
:type '(repeat string))
(defcustom uudecode-use-external
(executable-find uudecode-decoder-program)
- "*Use external uudecode program."
+ "Use external uudecode program."
:version "22.1"
:group 'uudecode
:type 'boolean)
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
-# Copyright (C) 2000-2012 Free Software Foundation, Inc.
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
# During bootstrapping the byte-compiler is run interpreted when compiling
# itself, and uses more stack than usual.
#
-BIG_STACK_DEPTH = 1200
+BIG_STACK_DEPTH = 2200
BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
-# speed up the bootstrap process. The CC files are compiled first
-# because CC mode tweaks the compilation process, and requiring
-# cc-mode when it is not compiled doesn't work during the
-# bootstrapping.
+# speed up the bootstrap process.
COMPILE_FIRST = \
- $(lisp)/emacs-lisp/byte-opt.el \
- $(lisp)/emacs-lisp/bytecomp.el \
$(lisp)/emacs-lisp/macroexp.el \
$(lisp)/emacs-lisp/cconv.el \
- $(lisp)/subr.el \
- $(lisp)/progmodes/cc-mode.el \
- $(lisp)/progmodes/cc-vars.el
+ $(lisp)/emacs-lisp/byte-opt.el \
+ $(lisp)/emacs-lisp/bytecomp.el \
+ $(lisp)/emacs-lisp/autoload.el
# The actual Emacs command run in the targets below.
# The quotes around $(EMACS) are here because the user could type
# WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as
# this can break with GNU Make 3.81 and later if sh.exe is used.
-custom-deps: $(lisp)/cus-load.el $(lisp)/loaddefs.el doit
+custom-deps: $(lisp)/cus-load.el $(lisp)/loaddefs.el $(lisp)/subdirs.el doit
@echo Directories: $(WINS_UPDATES)
-$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hook nil)$(ARGQUOTE) \
-f custom-make-dependencies $(lisp) $(WINS_UPDATES)
-finder-data: $(lisp)/loaddefs.el doit
+finder-data: $(lisp)/loaddefs.el $(lisp)/subdirs.el doit
@echo Directories: $(WINS_UPDATES)
$(emacs) -l finder -f finder-compile-keywords-make-dist $(lisp) $(WINS_UPDATES)
echo ;; End:>> $(lisp)/subdirs.el
update-subdirs-SH: doit
- $(srcdir)/update-subdirs $(lisp); \
+ $(srcdir)/build-aux/update-subdirs $(lisp); \
for file in $(WINS_SUBDIR); do \
- $(srcdir)/update-subdirs $$file; \
+ $(srcdir)/build-aux/update-subdirs $$file; \
done;
-updates: update-subdirs autoloads mh-autoloads finder-data custom-deps
+updates: $(lisp)/subdirs.el autoloads mh-autoloads finder-data custom-deps
# This is useful after "bzr up".
bzr-update: recompile autoloads finder-data custom-deps
# compiled find the right files.
# Need separate version for sh and native cmd.exe
-compile: $(lisp)/subdirs.el mh-autoloads compile-$(SHELLTYPE) doit
+compile: $(lisp)/subdirs.el compile-$(SHELLTYPE) doit
-compile-CMD:
+compile-CMD: autoloads
# -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g
for %%f in ($(COMPILE_FIRST)) do \
$(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f
for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do \
$(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g
-compile-SH:
+compile-SH: autoloads
# for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done
for el in $(COMPILE_FIRST); do \
echo Compiling $$el; \
compile-after-backup: backup-compiled-files compile-always
compile-first: $(lisp)/emacs-lisp/bytecomp.elc $(lisp)/emacs-lisp/byte-opt.elc \
- $(lisp)/emacs-lisp/autoload.elc
+ $(lisp)/emacs-lisp/autoload.elc $(lisp)/subdirs.el
# Recompile all Lisp files which are newer than their .elc files.
# Note that this doesn't create .elc files. It only recompiles if an
recompile: compile-first autoloads doit $(lisp)/progmodes/cc-mode.elc
$(emacs) --eval $(ARGQUOTE)(batch-byte-recompile-directory 0)$(ARGQUOTE) $(lisp)
-$(lisp)/calendar/cal-loaddefs.el:
+$(lisp)/calendar/cal-loaddefs.el: $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \
--eval "(setq find-file-suppress-same-file-warnings t)" \
-f w32-batch-update-autoloads "$(lisp)/calendar/cal-loaddefs.el" \
$(MAKE) ./calendar
-$(lisp)/calendar/diary-loaddefs.el:
+$(lisp)/calendar/diary-loaddefs.el: $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \
--eval "(setq find-file-suppress-same-file-warnings t)" \
-f w32-batch-update-autoloads $(lisp)/calendar/diary-loaddefs.el \
$(MAKE) ./calendar
-$(lisp)/calendar/hol-loaddefs.el:
+$(lisp)/calendar/hol-loaddefs.el: $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \
--eval "(setq find-file-suppress-same-file-warnings t)" \
# See the commentary for autoloads above for why we use ./mh-e below
# instead of $(lisp)/mh-e.
mh-autoloads: $(lisp)/mh-e/mh-loaddefs.el
-$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
+$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) \
-l autoload \
--eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###mh-autoload$(DQUOTE))$(ARGQUOTE) \
$(lisp)/net/tramp-smb.el $(lisp)/net/tramp-uu.el \
$(lisp)/net/trampver.el
-$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC)
+$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC) $(lisp)/subdirs.el
"$(EMACS)" $(EMACSOPT) \
-l autoload \
--eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###tramp-autoload$(DQUOTE))$(ARGQUOTE) \
# Need separate version for sh and native cmd.exe
bootstrap-clean:
- $(DEL) $(lisp)/loaddefs.el
+ - $(DEL) $(lisp)/subdirs.el
$(MAKE) $(MFLAGS) bootstrap-clean-$(SHELLTYPE)
bootstrap-clean-CMD:
# When done, remove bootstrap-emacs from ../bin, so that
# it will not be mistaken for an installed binary.
-bootstrap: update-subdirs autoloads mh-autoloads compile finder-data custom-deps
+bootstrap: $(lisp)/subdirs.el compile finder-data custom-deps
- $(DEL) "$(EMACS)"
#
$(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \
$(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \
$(lisp)/progmodes/cc-styles.elc $(lisp)/progmodes/cc-cmds.elc \
- $(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-menus.elc
+ $(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-menus.elc \
+ $(lisp)/subdirs.el
$(lisp)/progmodes/cc-styles.elc: $(lisp)/progmodes/cc-vars.elc \
$(lisp)/progmodes/cc-align.elc
\f
;;; Code:
-(eval-when-compile (require 'cl))
-(require 'assoc)
+(require 'ansi-color)
(require 'button)
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; empty defvars (keep the compiler quiet)
-
(defgroup man nil
"Browse UNIX manual pages."
:prefix "Man-"
:group 'help)
(defvar Man-notify)
+
(defcustom Man-filter-list nil
"Manpage cleaning filter command phrases.
This variable contains a list of the following form:
(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)
: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).")
(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)
Otherwise, the value is whatever the function
`Man-support-local-filenames' should return.")
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end user variables
\f
;; other variables and keymap initializations
(defvar Man-original-frame)
(make-variable-buffer-local 'Man-arguments)
(put 'Man-arguments 'permanent-local t)
-(defvar Man-sections-alist nil)
-(make-variable-buffer-local 'Man-sections-alist)
-(defvar Man-refpages-alist nil)
-(make-variable-buffer-local 'Man-refpages-alist)
+(defvar Man--sections nil)
+(make-variable-buffer-local 'Man--sections)
+(defvar Man--refpages nil)
+(make-variable-buffer-local 'Man--refpages)
(defvar Man-page-list nil)
(make-variable-buffer-local 'Man-page-list)
(defvar Man-current-page 0)
(list (let* ((default-entry (Man-default-man-entry))
;; ignore case because that's friendly for bizarre
;; caps things like the X11 function names and because
- ;; "man" itself is case-sensitive on the command line
+ ;; "man" itself is case-insensitive on the command line
;; so you're accustomed not to bother about the case
;; ("man -k" is case-insensitive similarly, so the
;; table has everything available to complete)
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).
See the variable `Man-notify-method' for the different notification behaviors."
(let ((saved-frame (with-current-buffer man-buffer
Man-original-frame)))
- (case Man-notify-method
- (newframe
- ;; Since we run asynchronously, perhaps while Emacs is waiting
- ;; for input, we must not leave a different buffer current. We
- ;; can't rely on the editor command loop to reselect the
- ;; selected window's buffer.
- (save-excursion
- (let ((frame (make-frame Man-frame-parameters)))
- (set-window-buffer (frame-selected-window frame) man-buffer)
- (set-window-dedicated-p (frame-selected-window frame) t)
- (or (display-multi-frame-p frame)
- (select-frame frame)))))
- (pushy
- (switch-to-buffer man-buffer))
- (bully
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (pop-to-buffer man-buffer)
- (delete-other-windows))
- (aggressive
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (pop-to-buffer man-buffer))
- (friendly
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (display-buffer man-buffer 'not-this-window))
- (polite
- (beep)
- (message "Manual buffer %s is ready" (buffer-name man-buffer)))
- (quiet
- (message "Manual buffer %s is ready" (buffer-name man-buffer)))
- (t ;; meek
- (message ""))
- )))
+ (pcase Man-notify-method
+ (`newframe
+ ;; Since we run asynchronously, perhaps while Emacs is waiting
+ ;; for input, we must not leave a different buffer current. We
+ ;; can't rely on the editor command loop to reselect the
+ ;; selected window's buffer.
+ (save-excursion
+ (let ((frame (make-frame Man-frame-parameters)))
+ (set-window-buffer (frame-selected-window frame) man-buffer)
+ (set-window-dedicated-p (frame-selected-window frame) t)
+ (or (display-multi-frame-p frame)
+ (select-frame frame)))))
+ (`pushy
+ (switch-to-buffer man-buffer))
+ (`bully
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (pop-to-buffer man-buffer)
+ (delete-other-windows))
+ (`aggressive
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (pop-to-buffer man-buffer))
+ (`friendly
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (display-buffer man-buffer 'not-this-window))
+ (`polite
+ (beep)
+ (message "Manual buffer %s is ready" (buffer-name man-buffer)))
+ (`quiet
+ (message "Manual buffer %s is ready" (buffer-name man-buffer)))
+ (_ ;; meek
+ (message ""))
+ )))
(defun Man-softhyphen-to-minus ()
;; \255 is SOFT HYPHEN in Latin-N. Versions of Debian man, at
(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 (case (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 (case (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)))
(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")
(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))
(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)
(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)
(if (not Man-page-list)
(let ((args Man-arguments))
(kill-buffer (current-buffer))
- (error "Can't find the %s manpage"
- (Man-page-from-arguments args)))
+ (user-error "Can't find the %s manpage"
+ (Man-page-from-arguments args)))
(set-buffer-modified-p nil))))
;; Restore case-fold-search before calling
;; Man-notify-when-ready because it may switch buffers.
(run-mode-hooks 'Man-mode-hook))
(defsubst Man-build-section-alist ()
- "Build the association list of manpage sections."
- (setq Man-sections-alist nil)
+ "Build the list of manpage sections."
+ (setq Man--sections nil)
(goto-char (point-min))
(let ((case-fold-search nil))
(while (re-search-forward Man-heading-regexp (point-max) t)
- (aput 'Man-sections-alist (match-string 1))
+ (let ((section (match-string 1)))
+ (unless (member section Man--sections)
+ (push section Man--sections)))
(forward-line 1))))
(defsubst Man-build-references-alist ()
- "Build the association list of references (in the SEE ALSO section)."
- (setq Man-refpages-alist nil)
+ "Build the list of references (in the SEE ALSO section)."
+ (setq Man--refpages nil)
(save-excursion
(if (Man-find-section Man-see-also-regexp)
(let ((start (progn (forward-line 1) (point)))
len (1- (length word))))
(if (memq (aref word len) '(?- ?))
(setq hyphenated (substring word 0 len)))
- (if (string-match Man-reference-regexp word)
- (aput 'Man-refpages-alist word))))
+ (and (string-match Man-reference-regexp word)
+ (not (member word Man--refpages))
+ (push word Man--refpages))))
(skip-chars-forward " \t\n,"))))))
- (setq Man-refpages-alist (nreverse Man-refpages-alist)))
+ (setq Man--refpages (nreverse Man--refpages)))
(defun Man-build-page-list ()
"Build the list of separate manpages in the buffer."
(nindent 0))
(narrow-to-region (car page) (car (cdr page)))
(if Man-uses-untabify-flag
- (untabify (point-min) (point-max)))
+ ;; The space characters inserted by `untabify' inherit
+ ;; sticky text properties, which is unnecessary and looks
+ ;; ugly with underlining (Bug#11408).
+ (let ((text-property-default-nonsticky
+ (cons '(face . t) text-property-default-nonsticky)))
+ (untabify (point-min) (point-max))))
(if (catch 'unindent
(goto-char (point-min))
(if (not (re-search-forward Man-first-heading-regexp nil t))
nil)
))
-(defun Man-goto-section ()
- "Query for section to move point to."
- (interactive)
- (aput 'Man-sections-alist
- (let* ((default (aheadsym Man-sections-alist))
- (completion-ignore-case t)
- chosen
- (prompt (concat "Go to section (default " default "): ")))
- (setq chosen (completing-read prompt Man-sections-alist))
- (if (or (not chosen)
- (string= chosen ""))
- default
- chosen)))
- (unless (Man-find-section (aheadsym Man-sections-alist))
- (error "Section not found")))
+(defvar Man--last-section nil)
+
+(defun Man-goto-section (section)
+ "Move point to SECTION."
+ (interactive
+ (let* ((default (if (member Man--last-section Man--sections)
+ Man--last-section
+ (car Man--sections)))
+ (completion-ignore-case t)
+ (prompt (concat "Go to section (default " default "): "))
+ (chosen (completing-read prompt Man--sections
+ nil nil nil nil default)))
+ (list chosen)))
+ (setq Man--last-section section)
+ (unless (Man-find-section section)
+ (error "Section %s not found" section)))
(defun Man-goto-see-also-section ()
(setq word (current-word))))
word)))
+(defvar Man--last-refpage nil)
+
(defun Man-follow-manual-reference (reference)
"Get one of the manpages referred to in the \"SEE ALSO\" section.
Specify which REFERENCE to use; default is based on word at point."
(interactive
- (if (not Man-refpages-alist)
+ (if (not Man--refpages)
(error "There are no references in the current man page")
(list
(let* ((default (or
(substring word 0
(match-beginning 0))
word))
- Man-refpages-alist))
- (aheadsym Man-refpages-alist)))
+ Man--refpages))
+ (if (member Man--last-refpage Man--refpages)
+ Man--last-refpage
+ (car Man--refpages))))
(defaults
(mapcar 'substring-no-properties
- (delete-dups
- (delq nil (cons default
- (mapcar 'car Man-refpages-alist))))))
- chosen
- (prompt (concat "Refer to (default " default "): ")))
- (setq chosen (completing-read prompt Man-refpages-alist
- nil nil nil nil defaults))
- (if (or (not chosen)
- (string= chosen ""))
- default
- chosen)))))
- (if (not Man-refpages-alist)
+ (cons default Man--refpages)))
+ (prompt (concat "Refer to (default " default "): "))
+ (chosen (completing-read prompt Man--refpages
+ nil nil nil nil defaults)))
+ chosen))))
+ (if (not Man--refpages)
(error "Can't find any references in the current manpage")
- (aput 'Man-refpages-alist reference)
+ (setq Man--last-refpage reference)
(Man-getpage-in-background
- (Man-translate-references (aheadsym Man-refpages-alist)))))
+ (Man-translate-references reference))))
(defun Man-kill ()
"Kill the buffer containing the manpage."
(when Man-page-list
(if (or (< page 1)
(> page (length Man-page-list)))
- (error "No manpage %d found" page))
+ (user-error "No manpage %d found" page))
(let* ((page-range (nth (1- page) Man-page-list))
(page-start (car page-range))
(page-end (car (cdr page-range))))
;; Init the man package variables, if not already done.
(Man-init-defvars)
-(add-to-list 'debug-ignored-errors "^No manpage [0-9]* found$")
-(add-to-list 'debug-ignored-errors "^Can't find the .* manpage$")
-
(provide 'man)
;;; man.el ends here
;;; menu-bar.el --- define a default menu bar
-;; Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc.
;; Author: RMS
;; Maintainer: FSF
(setq menu-bar-final-items '(buffer services help-menu))
(setq menu-bar-final-items '(buffer services hide-app quit))
;; Add standard top-level items to GNUstep menu.
- (define-key global-map [menu-bar quit]
- `(menu-item ,(purecopy "Quit") save-buffers-kill-emacs
- :help ,(purecopy "Save unsaved buffers, then exit")))
- (define-key global-map [menu-bar hide-app]
- `(menu-item ,(purecopy "Hide") ns-do-hide-emacs
- :help ,(purecopy "Hide Emacs"))))
- (define-key global-map [menu-bar services] ; set-up in ns-win
- (cons (purecopy "Services") (make-sparse-keymap "Services"))))
+ (bindings--define-key global-map [menu-bar quit]
+ '(menu-item "Quit" save-buffers-kill-emacs
+ :help "Save unsaved buffers, then exit"))
+ (bindings--define-key global-map [menu-bar hide-app]
+ '(menu-item "Hide" ns-do-hide-emacs
+ :help "Hide Emacs")))
+ (bindings--define-key global-map [menu-bar services] ; Set-up in ns-win.
+ (cons "Services" (make-sparse-keymap "Services"))))
;; This definition is just to show what this looks like.
;; It gets modified in place when menu-bar-update-buffers is called.
(let ((menu (make-sparse-keymap "File")))
;; The "File" menu items
- (define-key menu [exit-emacs]
- `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal
- :help ,(purecopy "Save unsaved buffers, then exit")))
+ (bindings--define-key menu [exit-emacs]
+ '(menu-item "Quit" save-buffers-kill-terminal
+ :help "Save unsaved buffers, then exit"))
- (define-key menu [separator-exit]
+ (bindings--define-key menu [separator-exit]
menu-bar-separator)
;; Don't use delete-frame as event name because that is a special
;; event.
- (define-key menu [delete-this-frame]
- `(menu-item ,(purecopy "Delete Frame") delete-frame
+ (bindings--define-key menu [delete-this-frame]
+ '(menu-item "Delete Frame" delete-frame
:visible (fboundp 'delete-frame)
:enable (delete-frame-enabled-p)
- :help ,(purecopy "Delete currently selected frame")))
- (define-key menu [make-frame-on-display]
- `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display
+ :help "Delete currently selected frame"))
+ (bindings--define-key menu [make-frame-on-display]
+ '(menu-item "New Frame on Display..." make-frame-on-display
:visible (fboundp 'make-frame-on-display)
- :help ,(purecopy "Open a new frame on another display")))
- (define-key menu [make-frame]
- `(menu-item ,(purecopy "New Frame") make-frame-command
+ :help "Open a new frame on another display"))
+ (bindings--define-key menu [make-frame]
+ '(menu-item "New Frame" make-frame-command
:visible (fboundp 'make-frame-command)
- :help ,(purecopy "Open a new frame")))
+ :help "Open a new frame"))
- (define-key menu [separator-frame]
+ (bindings--define-key menu [separator-frame]
menu-bar-separator)
- (define-key menu [one-window]
- `(menu-item ,(purecopy "Remove Other Windows") delete-other-windows
+ (bindings--define-key menu [one-window]
+ '(menu-item "Remove Other Windows" delete-other-windows
:enable (not (one-window-p t nil))
- :help ,(purecopy "Make selected window fill whole frame")))
+ :help "Make selected window fill whole frame"))
- (define-key menu [new-window-on-right]
- `(menu-item ,(purecopy "New Window on Right") split-window-right
+ (bindings--define-key menu [new-window-on-right]
+ '(menu-item "New Window on Right" split-window-right
:enable (and (menu-bar-menu-frame-live-and-visible-p)
(menu-bar-non-minibuffer-window-p))
- :help ,(purecopy "Make new window on right of selected one")))
+ :help "Make new window on right of selected one"))
- (define-key menu [new-window-below]
- `(menu-item ,(purecopy "New Window Below") split-window-below
+ (bindings--define-key menu [new-window-below]
+ '(menu-item "New Window Below" split-window-below
:enable (and (menu-bar-menu-frame-live-and-visible-p)
(menu-bar-non-minibuffer-window-p))
- :help ,(purecopy "Make new window below selected one")))
+ :help "Make new window below selected one"))
- (define-key menu [separator-window]
+ (bindings--define-key menu [separator-window]
menu-bar-separator)
- (define-key menu [ps-print-region]
- `(menu-item ,(purecopy "PostScript Print Region (B+W)") ps-print-region
+ (bindings--define-key menu [ps-print-region]
+ '(menu-item "PostScript Print Region (B+W)" ps-print-region
:enable mark-active
- :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer")))
- (define-key menu [ps-print-buffer]
- `(menu-item ,(purecopy "PostScript Print Buffer (B+W)") ps-print-buffer
+ :help "Pretty-print marked region in black and white to PostScript printer"))
+ (bindings--define-key menu [ps-print-buffer]
+ '(menu-item "PostScript Print Buffer (B+W)" ps-print-buffer
:enable (menu-bar-menu-frame-live-and-visible-p)
- :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer")))
- (define-key menu [ps-print-region-faces]
- `(menu-item ,(purecopy "PostScript Print Region")
+ :help "Pretty-print current buffer in black and white to PostScript printer"))
+ (bindings--define-key menu [ps-print-region-faces]
+ '(menu-item "PostScript Print Region"
ps-print-region-with-faces
:enable mark-active
- :help ,(purecopy
- "Pretty-print marked region to PostScript printer")))
- (define-key menu [ps-print-buffer-faces]
- `(menu-item ,(purecopy "PostScript Print Buffer")
+ :help "Pretty-print marked region to PostScript printer"))
+ (bindings--define-key menu [ps-print-buffer-faces]
+ '(menu-item "PostScript Print Buffer"
ps-print-buffer-with-faces
:enable (menu-bar-menu-frame-live-and-visible-p)
- :help ,(purecopy "Pretty-print current buffer to PostScript printer")))
- (define-key menu [print-region]
- `(menu-item ,(purecopy "Print Region") print-region
+ :help "Pretty-print current buffer to PostScript printer"))
+ (bindings--define-key menu [print-region]
+ '(menu-item "Print Region" print-region
:enable mark-active
- :help ,(purecopy "Print region between mark and current position")))
- (define-key menu [print-buffer]
- `(menu-item ,(purecopy "Print Buffer") print-buffer
+ :help "Print region between mark and current position"))
+ (bindings--define-key menu [print-buffer]
+ '(menu-item "Print Buffer" print-buffer
:enable (menu-bar-menu-frame-live-and-visible-p)
- :help ,(purecopy "Print current buffer with page headings")))
+ :help "Print current buffer with page headings"))
- (define-key menu [separator-print]
+ (bindings--define-key menu [separator-print]
menu-bar-separator)
- (define-key menu [recover-session]
- `(menu-item ,(purecopy "Recover Crashed Session") recover-session
+ (bindings--define-key menu [recover-session]
+ '(menu-item "Recover Crashed Session" recover-session
:enable
(and auto-save-list-file-prefix
(file-directory-p
(file-name-nondirectory
auto-save-list-file-prefix)))
t))
- :help ,(purecopy "Recover edits from a crashed session")))
- (define-key menu [revert-buffer]
- `(menu-item ,(purecopy "Revert Buffer") revert-buffer
+ :help "Recover edits from a crashed session"))
+ (bindings--define-key menu [revert-buffer]
+ '(menu-item "Revert Buffer" revert-buffer
:enable (or revert-buffer-function
revert-buffer-insert-file-contents-function
(and buffer-file-number
(or (buffer-modified-p)
(not (verify-visited-file-modtime
(current-buffer))))))
- :help ,(purecopy "Re-read current buffer from its file")))
- (define-key menu [write-file]
- `(menu-item ,(purecopy "Save As...") write-file
+ :help "Re-read current buffer from its file"))
+ (bindings--define-key menu [write-file]
+ '(menu-item "Save As..." write-file
:enable (and (menu-bar-menu-frame-live-and-visible-p)
(menu-bar-non-minibuffer-window-p))
- :help ,(purecopy "Write current buffer to another file")))
- (define-key menu [save-buffer]
- `(menu-item ,(purecopy "Save") save-buffer
+ :help "Write current buffer to another file"))
+ (bindings--define-key menu [save-buffer]
+ '(menu-item "Save" save-buffer
:enable (and (buffer-modified-p)
(buffer-file-name)
(menu-bar-non-minibuffer-window-p))
- :help ,(purecopy "Save current buffer to its file")))
+ :help "Save current buffer to its file"))
- (define-key menu [separator-save]
+ (bindings--define-key menu [separator-save]
menu-bar-separator)
- (define-key menu [kill-buffer]
- `(menu-item ,(purecopy "Close") kill-this-buffer
+ (bindings--define-key menu [kill-buffer]
+ '(menu-item "Close" kill-this-buffer
:enable (kill-this-buffer-enabled-p)
- :help ,(purecopy "Discard (kill) current buffer")))
- (define-key menu [insert-file]
- `(menu-item ,(purecopy "Insert File...") insert-file
+ :help "Discard (kill) current buffer"))
+ (bindings--define-key menu [insert-file]
+ '(menu-item "Insert File..." insert-file
:enable (menu-bar-non-minibuffer-window-p)
- :help ,(purecopy "Insert another file into current buffer")))
- (define-key menu [dired]
- `(menu-item ,(purecopy "Open Directory...") dired
+ :help "Insert another file into current buffer"))
+ (bindings--define-key menu [dired]
+ '(menu-item "Open Directory..." dired
:enable (menu-bar-non-minibuffer-window-p)
- :help ,(purecopy
- "Read a directory, to operate on its files")))
- (define-key menu [open-file]
- `(menu-item ,(purecopy "Open File...") menu-find-file-existing
+ :help "Read a directory, to operate on its files"))
+ (bindings--define-key menu [open-file]
+ '(menu-item "Open File..." menu-find-file-existing
:enable (menu-bar-non-minibuffer-window-p)
- :help ,(purecopy
- "Read an existing file into an Emacs buffer")))
- (define-key menu [new-file]
- `(menu-item ,(purecopy "Visit New File...") find-file
+ :help "Read an existing file into an Emacs buffer"))
+ (bindings--define-key menu [new-file]
+ '(menu-item "Visit New File..." find-file
:enable (menu-bar-non-minibuffer-window-p)
- :help ,(purecopy
- "Specify a new file's name, to edit the file")))
+ :help "Specify a new file's name, to edit the file"))
menu))
;; The Edit->Search->Incremental Search menu
(defvar menu-bar-i-search-menu
(let ((menu (make-sparse-keymap "Incremental Search")))
- (define-key menu [isearch-backward-regexp]
- `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp
- :help ,(purecopy
- "Search backwards for a regular expression as you type it")))
- (define-key menu [isearch-forward-regexp]
- `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp
- :help ,(purecopy
- "Search forward for a regular expression as you type it")))
- (define-key menu [isearch-backward]
- `(menu-item ,(purecopy "Backward String...") isearch-backward
- :help ,(purecopy "Search backwards for a string as you type it")))
- (define-key menu [isearch-forward]
- `(menu-item ,(purecopy "Forward String...") isearch-forward
- :help ,(purecopy "Search forward for a string as you type it")))
+ (bindings--define-key menu [isearch-backward-regexp]
+ '(menu-item "Backward Regexp..." isearch-backward-regexp
+ :help "Search backwards for a regular expression as you type it"))
+ (bindings--define-key menu [isearch-forward-regexp]
+ '(menu-item "Forward Regexp..." isearch-forward-regexp
+ :help "Search forward for a regular expression as you type it"))
+ (bindings--define-key menu [isearch-backward]
+ '(menu-item "Backward String..." isearch-backward
+ :help "Search backwards for a string as you type it"))
+ (bindings--define-key menu [isearch-forward]
+ '(menu-item "Forward String..." isearch-forward
+ :help "Search forward for a string as you type it"))
menu))
(defvar menu-bar-search-menu
(let ((menu (make-sparse-keymap "Search")))
- (define-key menu [i-search]
- `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu))
- (define-key menu [separator-tag-isearch]
+ (bindings--define-key menu [i-search]
+ `(menu-item "Incremental Search" ,menu-bar-i-search-menu))
+ (bindings--define-key menu [separator-tag-isearch]
menu-bar-separator)
- (define-key menu [tags-continue]
- `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue
- :help ,(purecopy "Continue last tags search operation")))
- (define-key menu [tags-srch]
- `(menu-item ,(purecopy "Search Tagged Files...") tags-search
- :help ,(purecopy "Search for a regexp in all tagged files")))
- (define-key menu [separator-tag-search] menu-bar-separator)
+ (bindings--define-key menu [tags-continue]
+ '(menu-item "Continue Tags Search" tags-loop-continue
+ :help "Continue last tags search operation"))
+ (bindings--define-key menu [tags-srch]
+ '(menu-item "Search Tagged Files..." tags-search
+ :help "Search for a regexp in all tagged files"))
+ (bindings--define-key menu [separator-tag-search] menu-bar-separator)
- (define-key menu [repeat-search-back]
- `(menu-item ,(purecopy "Repeat Backwards")
+ (bindings--define-key menu [repeat-search-back]
+ '(menu-item "Repeat Backwards"
nonincremental-repeat-search-backward
:enable (or (and (eq menu-bar-last-search-type 'string)
search-ring)
(and (eq menu-bar-last-search-type 'regexp)
regexp-search-ring))
- :help ,(purecopy "Repeat last search backwards")))
- (define-key menu [repeat-search-fwd]
- `(menu-item ,(purecopy "Repeat Forward")
+ :help "Repeat last search backwards"))
+ (bindings--define-key menu [repeat-search-fwd]
+ '(menu-item "Repeat Forward"
nonincremental-repeat-search-forward
:enable (or (and (eq menu-bar-last-search-type 'string)
search-ring)
(and (eq menu-bar-last-search-type 'regexp)
regexp-search-ring))
- :help ,(purecopy "Repeat last search forward")))
- (define-key menu [separator-repeat-search]
+ :help "Repeat last search forward"))
+ (bindings--define-key menu [separator-repeat-search]
menu-bar-separator)
- (define-key menu [re-search-backward]
- `(menu-item ,(purecopy "Regexp Backwards...")
+ (bindings--define-key menu [re-search-backward]
+ '(menu-item "Regexp Backwards..."
nonincremental-re-search-backward
- :help ,(purecopy
- "Search backwards for a regular expression")))
- (define-key menu [re-search-forward]
- `(menu-item ,(purecopy "Regexp Forward...")
+ :help "Search backwards for a regular expression"))
+ (bindings--define-key menu [re-search-forward]
+ '(menu-item "Regexp Forward..."
nonincremental-re-search-forward
- :help ,(purecopy "Search forward for a regular expression")))
+ :help "Search forward for a regular expression"))
- (define-key menu [search-backward]
- `(menu-item ,(purecopy "String Backwards...")
+ (bindings--define-key menu [search-backward]
+ '(menu-item "String Backwards..."
nonincremental-search-backward
- :help ,(purecopy "Search backwards for a string")))
- (define-key menu [search-forward]
- `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward
- :help ,(purecopy "Search forward for a string")))
+ :help "Search backwards for a string"))
+ (bindings--define-key menu [search-forward]
+ '(menu-item "String Forward..." nonincremental-search-forward
+ :help "Search forward for a string"))
menu))
;; The Edit->Replace submenu
(defvar menu-bar-replace-menu
(let ((menu (make-sparse-keymap "Replace")))
- (define-key menu [tags-repl-continue]
- `(menu-item ,(purecopy "Continue Replace") tags-loop-continue
- :help ,(purecopy "Continue last tags replace operation")))
- (define-key menu [tags-repl]
- `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace
- :help ,(purecopy
- "Interactively replace a regexp in all tagged files")))
- (define-key menu [separator-replace-tags]
+ (bindings--define-key menu [tags-repl-continue]
+ '(menu-item "Continue Replace" tags-loop-continue
+ :help "Continue last tags replace operation"))
+ (bindings--define-key menu [tags-repl]
+ '(menu-item "Replace in Tagged Files..." tags-query-replace
+ :help "Interactively replace a regexp in all tagged files"))
+ (bindings--define-key menu [separator-replace-tags]
menu-bar-separator)
- (define-key menu [query-replace-regexp]
- `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp
+ (bindings--define-key menu [query-replace-regexp]
+ '(menu-item "Replace Regexp..." query-replace-regexp
:enable (not buffer-read-only)
- :help ,(purecopy "Replace regular expression interactively, ask about each occurrence")))
- (define-key menu [query-replace]
- `(menu-item ,(purecopy "Replace String...") query-replace
+ :help "Replace regular expression interactively, ask about each occurrence"))
+ (bindings--define-key menu [query-replace]
+ '(menu-item "Replace String..." query-replace
:enable (not buffer-read-only)
- :help ,(purecopy
- "Replace string interactively, ask about each occurrence")))
+ :help "Replace string interactively, ask about each occurrence"))
menu))
;;; Assemble the top-level Edit menu items.
(defvar menu-bar-goto-menu
(let ((menu (make-sparse-keymap "Go To")))
- (define-key menu [set-tags-name]
- `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table
- :help ,(purecopy "Tell Tags commands which tag table file to use")))
+ (bindings--define-key menu [set-tags-name]
+ '(menu-item "Set Tags File Name..." visit-tags-table
+ :help "Tell Tags commands which tag table file to use"))
- (define-key menu [separator-tag-file]
+ (bindings--define-key menu [separator-tag-file]
menu-bar-separator)
- (define-key menu [apropos-tags]
- `(menu-item ,(purecopy "Tags Apropos...") tags-apropos
- :help ,(purecopy "Find function/variables whose names match regexp")))
- (define-key menu [next-tag-otherw]
- `(menu-item ,(purecopy "Next Tag in Other Window")
+ (bindings--define-key menu [apropos-tags]
+ '(menu-item "Tags Apropos..." tags-apropos
+ :help "Find function/variables whose names match regexp"))
+ (bindings--define-key menu [next-tag-otherw]
+ '(menu-item "Next Tag in Other Window"
menu-bar-next-tag-other-window
:enable (and (boundp 'tags-location-ring)
(not (ring-empty-p tags-location-ring)))
- :help ,(purecopy "Find next function/variable matching last tag name in another window")))
+ :help "Find next function/variable matching last tag name in another window"))
- (define-key menu [next-tag]
- `(menu-item ,(purecopy "Find Next Tag")
+ (bindings--define-key menu [next-tag]
+ '(menu-item "Find Next Tag"
menu-bar-next-tag
:enable (and (boundp 'tags-location-ring)
(not (ring-empty-p tags-location-ring)))
- :help ,(purecopy "Find next function/variable matching last tag name")))
- (define-key menu [find-tag-otherw]
- `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window
- :help ,(purecopy "Find function/variable definition in another window")))
- (define-key menu [find-tag]
- `(menu-item ,(purecopy "Find Tag...") find-tag
- :help ,(purecopy "Find definition of function or variable")))
-
- (define-key menu [separator-tags]
+ :help "Find next function/variable matching last tag name"))
+ (bindings--define-key menu [find-tag-otherw]
+ '(menu-item "Find Tag in Other Window..." find-tag-other-window
+ :help "Find function/variable definition in another window"))
+ (bindings--define-key menu [find-tag]
+ '(menu-item "Find Tag..." find-tag
+ :help "Find definition of function or variable"))
+
+ (bindings--define-key menu [separator-tags]
menu-bar-separator)
- (define-key menu [end-of-buf]
- `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer))
- (define-key menu [beg-of-buf]
- `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer))
- (define-key menu [go-to-pos]
- `(menu-item ,(purecopy "Goto Buffer Position...") goto-char
- :help ,(purecopy "Read a number N and go to buffer position N")))
- (define-key menu [go-to-line]
- `(menu-item ,(purecopy "Goto Line...") goto-line
- :help ,(purecopy "Read a line number and go to that line")))
+ (bindings--define-key menu [end-of-buf]
+ '(menu-item "Goto End of Buffer" end-of-buffer))
+ (bindings--define-key menu [beg-of-buf]
+ '(menu-item "Goto Beginning of Buffer" beginning-of-buffer))
+ (bindings--define-key menu [go-to-pos]
+ '(menu-item "Goto Buffer Position..." goto-char
+ :help "Read a number N and go to buffer position N"))
+ (bindings--define-key menu [go-to-line]
+ '(menu-item "Goto Line..." goto-line
+ :help "Read a line number and go to that line"))
menu))
(defvar menu-bar-edit-menu
(let ((menu (make-sparse-keymap "Edit")))
- (define-key menu [props]
- `(menu-item ,(purecopy "Text Properties") facemenu-menu))
+ (bindings--define-key menu [props]
+ `(menu-item "Text Properties" facemenu-menu))
;; ns-win.el said: Add spell for platform consistency.
(if (featurep 'ns)
- (define-key menu [spell]
- `(menu-item ,(purecopy "Spell") ispell-menu-map)))
+ (bindings--define-key menu [spell]
+ `(menu-item "Spell" ispell-menu-map)))
- (define-key menu [fill]
- `(menu-item ,(purecopy "Fill") fill-region
+ (bindings--define-key menu [fill]
+ `(menu-item "Fill" fill-region
:enable (and mark-active (not buffer-read-only))
:help
- ,(purecopy "Fill text in region to fit between left and right margin")))
+ "Fill text in region to fit between left and right margin"))
- (define-key menu [separator-bookmark]
+ (bindings--define-key menu [separator-bookmark]
menu-bar-separator)
- (define-key menu [bookmark]
- `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map))
+ (bindings--define-key menu [bookmark]
+ `(menu-item "Bookmarks" menu-bar-bookmark-map))
- (define-key menu [goto]
- `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu))
+ (bindings--define-key menu [goto]
+ `(menu-item "Go To" ,menu-bar-goto-menu))
- (define-key menu [replace]
- `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu))
+ (bindings--define-key menu [replace]
+ `(menu-item "Replace" ,menu-bar-replace-menu))
- (define-key menu [search]
- `(menu-item ,(purecopy "Search") ,menu-bar-search-menu))
+ (bindings--define-key menu [search]
+ `(menu-item "Search" ,menu-bar-search-menu))
- (define-key menu [separator-search]
+ (bindings--define-key menu [separator-search]
menu-bar-separator)
- (define-key menu [mark-whole-buffer]
- `(menu-item ,(purecopy "Select All") mark-whole-buffer
- :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy")))
- (define-key menu [clear]
- `(menu-item ,(purecopy "Clear") delete-region
+ (bindings--define-key menu [mark-whole-buffer]
+ '(menu-item "Select All" mark-whole-buffer
+ :help "Mark the whole buffer for a subsequent cut/copy"))
+ (bindings--define-key menu [clear]
+ '(menu-item "Clear" delete-region
:enable (and mark-active
(not buffer-read-only))
:help
- ,(purecopy "Delete the text in region between mark and current position")))
+ "Delete the text in region between mark and current position"))
- (define-key menu (if (featurep 'ns) [select-paste]
+ (bindings--define-key menu (if (featurep 'ns) [select-paste]
[paste-from-menu])
;; ns-win.el said: Change text to be more consistent with
;; surrounding menu items `paste', etc."
- `(menu-item ,(purecopy (if (featurep 'ns) "Select and Paste"
- "Paste from Kill Menu")) yank-menu
- :enable (and (cdr yank-menu) (not buffer-read-only))
- :help ,(purecopy "Choose a string from the kill ring and paste it")))
- (define-key menu [paste]
- `(menu-item ,(purecopy "Paste") yank
+ `(menu-item ,(if (featurep 'ns) "Select and Paste"
+ "Paste from Kill Menu") yank-menu
+ :enable (and (cdr yank-menu) (not buffer-read-only))
+ :help "Choose a string from the kill ring and paste it"))
+ (bindings--define-key menu [paste]
+ '(menu-item "Paste" yank
:enable (and (or
;; Emacs compiled --without-x (or --with-ns)
;; doesn't have x-selection-exists-p.
(cdr yank-menu)
kill-ring))
(not buffer-read-only))
- :help ,(purecopy "Paste (yank) text most recently cut/copied")))
- (define-key menu [copy]
+ :help "Paste (yank) text most recently cut/copied"))
+ (bindings--define-key menu [copy]
;; ns-win.el said: Substitute a Copy function that works better
;; under X (for GNUstep).
- `(menu-item ,(purecopy "Copy") ,(if (featurep 'ns)
- 'ns-copy-including-secondary
- 'kill-ring-save)
+ `(menu-item "Copy" ,(if (featurep 'ns)
+ 'ns-copy-including-secondary
+ 'kill-ring-save)
:enable mark-active
- :help ,(purecopy "Copy text in region between mark and current position")
- :keys ,(purecopy (if (featurep 'ns)
- "\\[ns-copy-including-secondary]"
- "\\[kill-ring-save]"))))
- (define-key menu [cut]
- `(menu-item ,(purecopy "Cut") kill-region
+ :help "Copy text in region between mark and current position"
+ :keys ,(if (featurep 'ns)
+ "\\[ns-copy-including-secondary]"
+ "\\[kill-ring-save]")))
+ (bindings--define-key menu [cut]
+ '(menu-item "Cut" kill-region
:enable (and mark-active (not buffer-read-only))
:help
- ,(purecopy "Cut (kill) text in region between mark and current position")))
+ "Cut (kill) text in region between mark and current position"))
;; ns-win.el said: Separate undo from cut/paste section.
(if (featurep 'ns)
- (define-key menu [separator-undo] menu-bar-separator))
+ (bindings--define-key menu [separator-undo] menu-bar-separator))
- (define-key menu [undo]
- `(menu-item ,(purecopy "Undo") undo
+ (bindings--define-key menu [undo]
+ '(menu-item "Undo" undo
:enable (and (not buffer-read-only)
(not (eq t buffer-undo-list))
(if (eq last-command 'undo)
(listp pending-undo-list)
(consp buffer-undo-list)))
- :help ,(purecopy "Undo last operation")))
+ :help "Undo last operation"))
menu))
(defvar menu-bar-custom-menu
(let ((menu (make-sparse-keymap "Customize")))
- (define-key menu [customize-apropos-faces]
- `(menu-item ,(purecopy "Faces Matching...") customize-apropos-faces
- :help ,(purecopy "Browse faces matching a regexp or word list")))
- (define-key menu [customize-apropos-options]
- `(menu-item ,(purecopy "Options Matching...") customize-apropos-options
- :help ,(purecopy "Browse options matching a regexp or word list")))
- (define-key menu [customize-apropos]
- `(menu-item ,(purecopy "All Settings Matching...") customize-apropos
- :help ,(purecopy "Browse customizable settings matching a regexp or word list")))
- (define-key menu [separator-1]
+ (bindings--define-key menu [customize-apropos-faces]
+ '(menu-item "Faces Matching..." customize-apropos-faces
+ :help "Browse faces matching a regexp or word list"))
+ (bindings--define-key menu [customize-apropos-options]
+ '(menu-item "Options Matching..." customize-apropos-options
+ :help "Browse options matching a regexp or word list"))
+ (bindings--define-key menu [customize-apropos]
+ '(menu-item "All Settings Matching..." customize-apropos
+ :help "Browse customizable settings matching a regexp or word list"))
+ (bindings--define-key menu [separator-1]
menu-bar-separator)
- (define-key menu [customize-group]
- `(menu-item ,(purecopy "Specific Group...") customize-group
- :help ,(purecopy "Customize settings of specific group")))
- (define-key menu [customize-face]
- `(menu-item ,(purecopy "Specific Face...") customize-face
- :help ,(purecopy "Customize attributes of specific face")))
- (define-key menu [customize-option]
- `(menu-item ,(purecopy "Specific Option...") customize-option
- :help ,(purecopy "Customize value of specific option")))
- (define-key menu [separator-2]
+ (bindings--define-key menu [customize-group]
+ '(menu-item "Specific Group..." customize-group
+ :help "Customize settings of specific group"))
+ (bindings--define-key menu [customize-face]
+ '(menu-item "Specific Face..." customize-face
+ :help "Customize attributes of specific face"))
+ (bindings--define-key menu [customize-option]
+ '(menu-item "Specific Option..." customize-option
+ :help "Customize value of specific option"))
+ (bindings--define-key menu [separator-2]
menu-bar-separator)
- (define-key menu [customize-changed-options]
- `(menu-item ,(purecopy "New Options...") customize-changed-options
- :help ,(purecopy "Options added or changed in recent Emacs versions")))
- (define-key menu [customize-saved]
- `(menu-item ,(purecopy "Saved Options") customize-saved
- :help ,(purecopy "Customize previously saved options")))
- (define-key menu [separator-3]
+ (bindings--define-key menu [customize-changed-options]
+ '(menu-item "New Options..." customize-changed-options
+ :help "Options added or changed in recent Emacs versions"))
+ (bindings--define-key menu [customize-saved]
+ '(menu-item "Saved Options" customize-saved
+ :help "Customize previously saved options"))
+ (bindings--define-key menu [separator-3]
menu-bar-separator)
- (define-key menu [customize-browse]
- `(menu-item ,(purecopy "Browse Customization Groups") customize-browse
- :help ,(purecopy "Browse all customization groups")))
- (define-key menu [customize]
- `(menu-item ,(purecopy "Top-level Customization Group") customize
- :help ,(purecopy "The master group called `Emacs'")))
- (define-key menu [customize-themes]
- `(menu-item ,(purecopy "Custom Themes") customize-themes
- :help ,(purecopy "Choose a pre-defined customization theme")))
+ (bindings--define-key menu [customize-browse]
+ '(menu-item "Browse Customization Groups" customize-browse
+ :help "Browse all customization groups"))
+ (bindings--define-key menu [customize]
+ '(menu-item "Top-level Customization Group" customize
+ :help "The master group called `Emacs'"))
+ (bindings--define-key menu [customize-themes]
+ '(menu-item "Custom Themes" customize-themes
+ :help "Choose a pre-defined customization theme"))
menu))
;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
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 (purecopy ,doc) ',fname
- ,@(mapcar (lambda (p) (list 'quote p)) props)
- :help (purecopy ,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
;; 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 (purecopy ,doc) ',name
- :help (purecopy ,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.
(defvar menu-bar-showhide-fringe-ind-menu
(let ((menu (make-sparse-keymap "Buffer boundaries")))
- (define-key menu [customize]
- `(menu-item ,(purecopy "Other (Customize)")
+ (bindings--define-key menu [customize]
+ '(menu-item "Other (Customize)"
menu-bar-showhide-fringe-ind-customize
- :help ,(purecopy "Additional choices available through Custom buffer")
+ :help "Additional choices available through Custom buffer"
:visible (display-graphic-p)
:button (:radio . (not (member indicate-buffer-boundaries
'(nil left right
((top . left) (bottom . right))
((t . right) (top . left))))))))
- (define-key menu [mixed]
- `(menu-item ,(purecopy "Opposite, Arrows Right") menu-bar-showhide-fringe-ind-mixed
+ (bindings--define-key menu [mixed]
+ '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed
:help
- ,(purecopy "Show top/bottom indicators in opposite fringes, arrows in right")
+ "Show top/bottom indicators in opposite fringes, arrows in right"
:visible (display-graphic-p)
:button (:radio . (equal indicate-buffer-boundaries
'((t . right) (top . left))))))
- (define-key menu [box]
- `(menu-item ,(purecopy "Opposite, No Arrows") menu-bar-showhide-fringe-ind-box
- :help ,(purecopy "Show top/bottom indicators in opposite fringes, no arrows")
+ (bindings--define-key menu [box]
+ '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box
+ :help "Show top/bottom indicators in opposite fringes, no arrows"
:visible (display-graphic-p)
:button (:radio . (equal indicate-buffer-boundaries
'((top . left) (bottom . right))))))
- (define-key menu [right]
- `(menu-item ,(purecopy "In Right Fringe") menu-bar-showhide-fringe-ind-right
- :help ,(purecopy "Show buffer boundaries and arrows in right fringe")
+ (bindings--define-key menu [right]
+ '(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right
+ :help "Show buffer boundaries and arrows in right fringe"
:visible (display-graphic-p)
:button (:radio . (eq indicate-buffer-boundaries 'right))))
- (define-key menu [left]
- `(menu-item ,(purecopy "In Left Fringe") menu-bar-showhide-fringe-ind-left
- :help ,(purecopy "Show buffer boundaries and arrows in left fringe")
+ (bindings--define-key menu [left]
+ '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left
+ :help "Show buffer boundaries and arrows in left fringe"
:visible (display-graphic-p)
:button (:radio . (eq indicate-buffer-boundaries 'left))))
- (define-key menu [none]
- `(menu-item ,(purecopy "No Indicators") menu-bar-showhide-fringe-ind-none
- :help ,(purecopy "Hide all buffer boundary indicators and arrows")
+ (bindings--define-key menu [none]
+ '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none
+ :help "Hide all buffer boundary indicators and arrows"
:visible (display-graphic-p)
:button (:radio . (eq indicate-buffer-boundaries nil))))
menu))
(defvar menu-bar-showhide-fringe-menu
(let ((menu (make-sparse-keymap "Fringe")))
- (define-key menu [showhide-fringe-ind]
- `(menu-item ,(purecopy "Buffer Boundaries") ,menu-bar-showhide-fringe-ind-menu
+ (bindings--define-key menu [showhide-fringe-ind]
+ `(menu-item "Buffer Boundaries" ,menu-bar-showhide-fringe-ind-menu
:visible (display-graphic-p)
- :help ,(purecopy "Indicate buffer boundaries in fringe")))
+ :help "Indicate buffer boundaries in fringe"))
- (define-key menu [indicate-empty-lines]
+ (bindings--define-key menu [indicate-empty-lines]
(menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
"Empty Line Indicators"
"Indicating of empty lines %s"
"Indicate trailing empty lines in fringe, globally"))
- (define-key menu [customize]
- `(menu-item ,(purecopy "Customize Fringe") menu-bar-showhide-fringe-menu-customize
- :help ,(purecopy "Detailed customization of fringe")
+ (bindings--define-key menu [customize]
+ '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize
+ :help "Detailed customization of fringe"
:visible (display-graphic-p)))
- (define-key menu [default]
- `(menu-item ,(purecopy "Default") menu-bar-showhide-fringe-menu-customize-reset
- :help ,(purecopy "Default width fringe on both left and right side")
+ (bindings--define-key menu [default]
+ '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset
+ :help "Default width fringe on both left and right side"
:visible (display-graphic-p)
:button (:radio . (eq fringe-mode nil))))
- (define-key menu [right]
- `(menu-item ,(purecopy "On the Right") menu-bar-showhide-fringe-menu-customize-right
- :help ,(purecopy "Fringe only on the right side")
+ (bindings--define-key menu [right]
+ '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right
+ :help "Fringe only on the right side"
:visible (display-graphic-p)
:button (:radio . (equal fringe-mode '(0 . nil)))))
- (define-key menu [left]
- `(menu-item ,(purecopy "On the Left") menu-bar-showhide-fringe-menu-customize-left
- :help ,(purecopy "Fringe only on the left side")
+ (bindings--define-key menu [left]
+ '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left
+ :help "Fringe only on the left side"
:visible (display-graphic-p)
:button (:radio . (equal fringe-mode '(nil . 0)))))
- (define-key menu [none]
- `(menu-item ,(purecopy "None") menu-bar-showhide-fringe-menu-customize-disable
- :help ,(purecopy "Turn off fringe")
+ (bindings--define-key menu [none]
+ '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable
+ :help "Turn off fringe"
:visible (display-graphic-p)
:button (:radio . (eq fringe-mode 0))))
menu))
(defvar menu-bar-showhide-scroll-bar-menu
(let ((menu (make-sparse-keymap "Scroll-bar")))
- (define-key menu [right]
- `(menu-item ,(purecopy "On the Right")
+ (bindings--define-key menu [right]
+ '(menu-item "On the Right"
menu-bar-right-scroll-bar
- :help ,(purecopy "Scroll-bar on the right side")
+ :help "Scroll-bar on the right side"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
(frame-parameters))) 'right))))
- (define-key menu [left]
- `(menu-item ,(purecopy "On the Left")
+ (bindings--define-key menu [left]
+ '(menu-item "On the Left"
menu-bar-left-scroll-bar
- :help ,(purecopy "Scroll-bar on the left side")
+ :help "Scroll-bar on the left side"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
(frame-parameters))) 'left))))
- (define-key menu [none]
- `(menu-item ,(purecopy "None")
+ (bindings--define-key menu [none]
+ '(menu-item "None"
menu-bar-no-scroll-bar
- :help ,(purecopy "Turn off scroll-bar")
+ :help "Turn off scroll-bar"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
(frame-parameters))) nil))))
(defvar menu-bar-showhide-tool-bar-menu
(let ((menu (make-sparse-keymap "Tool-bar")))
- (define-key menu [showhide-tool-bar-left]
- `(menu-item ,(purecopy "On the Left")
+ (bindings--define-key menu [showhide-tool-bar-left]
+ '(menu-item "On the Left"
menu-bar-showhide-tool-bar-menu-customize-enable-left
- :help ,(purecopy "Tool-bar at the left side")
+ :help "Tool-bar at the left side"
:visible (display-graphic-p)
:button
(:radio . (and tool-bar-mode
'tool-bar-position)
'left)))))
- (define-key menu [showhide-tool-bar-right]
- `(menu-item ,(purecopy "On the Right")
+ (bindings--define-key menu [showhide-tool-bar-right]
+ '(menu-item "On the Right"
menu-bar-showhide-tool-bar-menu-customize-enable-right
- :help ,(purecopy "Tool-bar at the right side")
+ :help "Tool-bar at the right side"
:visible (display-graphic-p)
:button
(:radio . (and tool-bar-mode
'tool-bar-position)
'right)))))
- (define-key menu [showhide-tool-bar-bottom]
- `(menu-item ,(purecopy "On the Bottom")
+ (bindings--define-key menu [showhide-tool-bar-bottom]
+ '(menu-item "On the Bottom"
menu-bar-showhide-tool-bar-menu-customize-enable-bottom
- :help ,(purecopy "Tool-bar at the bottom")
+ :help "Tool-bar at the bottom"
:visible (display-graphic-p)
:button
(:radio . (and tool-bar-mode
'tool-bar-position)
'bottom)))))
- (define-key menu [showhide-tool-bar-top]
- `(menu-item ,(purecopy "On the Top")
+ (bindings--define-key menu [showhide-tool-bar-top]
+ '(menu-item "On the Top"
menu-bar-showhide-tool-bar-menu-customize-enable-top
- :help ,(purecopy "Tool-bar at the top")
+ :help "Tool-bar at the top"
:visible (display-graphic-p)
:button
(:radio . (and tool-bar-mode
'tool-bar-position)
'top)))))
- (define-key menu [showhide-tool-bar-none]
- `(menu-item ,(purecopy "None")
+ (bindings--define-key menu [showhide-tool-bar-none]
+ '(menu-item "None"
menu-bar-showhide-tool-bar-menu-customize-disable
- :help ,(purecopy "Turn tool-bar off")
+ :help "Turn tool-bar off"
:visible (display-graphic-p)
:button (:radio . (eq tool-bar-mode nil))))
menu)))
(defvar menu-bar-showhide-menu
(let ((menu (make-sparse-keymap "Show/Hide")))
- (define-key menu [column-number-mode]
+ (bindings--define-key menu [column-number-mode]
(menu-bar-make-mm-toggle column-number-mode
"Column Numbers"
"Show the current column number in the mode line"))
- (define-key menu [line-number-mode]
+ (bindings--define-key menu [line-number-mode]
(menu-bar-make-mm-toggle line-number-mode
"Line Numbers"
"Show the current line number in the mode line"))
- (define-key menu [size-indication-mode]
+ (bindings--define-key menu [size-indication-mode]
(menu-bar-make-mm-toggle size-indication-mode
"Size Indication"
"Show the size of the buffer in the mode line"))
- (define-key menu [linecolumn-separator]
+ (bindings--define-key menu [linecolumn-separator]
menu-bar-separator)
- (define-key menu [showhide-battery]
+ (bindings--define-key menu [showhide-battery]
(menu-bar-make-mm-toggle display-battery-mode
"Battery Status"
"Display battery status information in mode line"))
- (define-key menu [showhide-date-time]
+ (bindings--define-key menu [showhide-date-time]
(menu-bar-make-mm-toggle display-time-mode
"Time, Load and Mail"
"Display time, system load averages and \
mail status in mode line"))
- (define-key menu [datetime-separator]
+ (bindings--define-key menu [datetime-separator]
menu-bar-separator)
- (define-key menu [showhide-speedbar]
- `(menu-item ,(purecopy "Speedbar") speedbar-frame-mode
- :help ,(purecopy "Display a Speedbar quick-navigation frame")
+ (bindings--define-key menu [showhide-speedbar]
+ '(menu-item "Speedbar" speedbar-frame-mode
+ :help "Display a Speedbar quick-navigation frame"
:button (:toggle
. (and (boundp 'speedbar-frame)
(frame-live-p (symbol-value 'speedbar-frame))
(frame-visible-p
(symbol-value 'speedbar-frame))))))
- (define-key menu [showhide-fringe]
- `(menu-item ,(purecopy "Fringe") ,menu-bar-showhide-fringe-menu
+ (bindings--define-key menu [showhide-fringe]
+ `(menu-item "Fringe" ,menu-bar-showhide-fringe-menu
:visible (display-graphic-p)))
- (define-key menu [showhide-scroll-bar]
- `(menu-item ,(purecopy "Scroll-bar") ,menu-bar-showhide-scroll-bar-menu
+ (bindings--define-key menu [showhide-scroll-bar]
+ `(menu-item "Scroll-bar" ,menu-bar-showhide-scroll-bar-menu
:visible (display-graphic-p)))
- (define-key menu [showhide-tooltip-mode]
- `(menu-item ,(purecopy "Tooltips") tooltip-mode
- :help ,(purecopy "Turn tooltips on/off")
+ (bindings--define-key menu [showhide-tooltip-mode]
+ '(menu-item "Tooltips" tooltip-mode
+ :help "Turn tooltips on/off"
:visible (and (display-graphic-p) (fboundp 'x-show-tip))
:button (:toggle . tooltip-mode)))
- (define-key menu [menu-bar-mode]
- `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame
- :help ,(purecopy "Turn menu-bar on/off")
+ (bindings--define-key menu [menu-bar-mode]
+ '(menu-item "Menu-bar" toggle-menu-bar-mode-from-frame
+ :help "Turn menu-bar on/off"
:button
(:toggle . (menu-bar-positive-p
(frame-parameter (menu-bar-frame-for-menubar)
(if (and (boundp 'menu-bar-showhide-tool-bar-menu)
(keymapp menu-bar-showhide-tool-bar-menu))
- (define-key menu [showhide-tool-bar]
- `(menu-item ,(purecopy "Tool-bar") ,menu-bar-showhide-tool-bar-menu
+ (bindings--define-key menu [showhide-tool-bar]
+ `(menu-item "Tool-bar" ,menu-bar-showhide-tool-bar-menu
:visible (display-graphic-p)))
;; else not tool bar that can move.
- (define-key menu [showhide-tool-bar]
- `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame
- :help ,(purecopy "Turn tool-bar on/off")
+ (bindings--define-key menu [showhide-tool-bar]
+ '(menu-item "Tool-bar" toggle-tool-bar-mode-from-frame
+ :help "Turn tool-bar on/off"
:visible (display-graphic-p)
:button
(:toggle . (menu-bar-positive-p
(defvar menu-bar-line-wrapping-menu
(let ((menu (make-sparse-keymap "Line Wrapping")))
- (define-key menu [word-wrap]
- `(menu-item
- ,(purecopy "Word Wrap (Visual Line mode)")
- (lambda ()
- (interactive)
- (unless visual-line-mode
- (visual-line-mode 1))
- (message ,(purecopy "Visual-Line mode enabled")))
- :help ,(purecopy "Wrap long lines at word boundaries")
- :button (:radio . (and (null truncate-lines)
- (not (truncated-partial-width-window-p))
- word-wrap))
- :visible (menu-bar-menu-frame-live-and-visible-p)))
-
- (define-key menu [truncate]
- `(menu-item ,(purecopy "Truncate Long Lines")
- (lambda ()
- (interactive)
- (if visual-line-mode (visual-line-mode 0))
- (setq word-wrap nil)
- (toggle-truncate-lines 1))
- :help ,(purecopy "Truncate long lines at window edge")
+ (bindings--define-key menu [word-wrap]
+ `(menu-item "Word Wrap (Visual Line mode)"
+ ,(lambda ()
+ (interactive)
+ (unless visual-line-mode
+ (visual-line-mode 1))
+ (message "Visual-Line mode enabled"))
+ :help "Wrap long lines at word boundaries"
+ :button (:radio
+ . (and (null truncate-lines)
+ (not (truncated-partial-width-window-p))
+ word-wrap))
+ :visible (menu-bar-menu-frame-live-and-visible-p)))
+
+ (bindings--define-key menu [truncate]
+ `(menu-item "Truncate Long Lines"
+ ,(lambda ()
+ (interactive)
+ (if visual-line-mode (visual-line-mode 0))
+ (setq word-wrap nil)
+ (toggle-truncate-lines 1))
+ :help "Truncate long lines at window edge"
:button (:radio . (or truncate-lines
(truncated-partial-width-window-p)))
:visible (menu-bar-menu-frame-live-and-visible-p)
:enable (not (truncated-partial-width-window-p))))
- (define-key menu [window-wrap]
- `(menu-item ,(purecopy "Wrap at Window Edge")
- (lambda () (interactive)
- (if visual-line-mode (visual-line-mode 0))
- (setq word-wrap nil)
- (if truncate-lines (toggle-truncate-lines -1)))
- :help ,(purecopy "Wrap long lines at window edge")
- :button (:radio . (and (null truncate-lines)
- (not (truncated-partial-width-window-p))
- (not word-wrap)))
+ (bindings--define-key menu [window-wrap]
+ `(menu-item "Wrap at Window Edge"
+ ,(lambda () (interactive)
+ (if visual-line-mode (visual-line-mode 0))
+ (setq word-wrap nil)
+ (if truncate-lines (toggle-truncate-lines -1)))
+ :help "Wrap long lines at window edge"
+ :button (:radio
+ . (and (null truncate-lines)
+ (not (truncated-partial-width-window-p))
+ (not word-wrap)))
:visible (menu-bar-menu-frame-live-and-visible-p)
:enable (not (truncated-partial-width-window-p))))
menu))
(defvar menu-bar-options-menu
(let ((menu (make-sparse-keymap "Options")))
- (define-key menu [customize]
- `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu))
+ (bindings--define-key menu [customize]
+ `(menu-item "Customize Emacs" ,menu-bar-custom-menu))
- (define-key menu [package]
+ (bindings--define-key menu [package]
'(menu-item "Manage Emacs Packages" package-list-packages
:help "Install or uninstall additional Emacs packages"))
- (define-key menu [save]
- `(menu-item ,(purecopy "Save Options") menu-bar-options-save
- :help ,(purecopy "Save options set from the menu above")))
+ (bindings--define-key menu [save]
+ '(menu-item "Save Options" menu-bar-options-save
+ :help "Save options set from the menu above"))
- (define-key menu [custom-separator]
+ (bindings--define-key menu [custom-separator]
menu-bar-separator)
- (define-key menu [menu-set-font]
- `(menu-item ,(purecopy "Set Default Font...") menu-set-font
+ (bindings--define-key menu [menu-set-font]
+ '(menu-item "Set Default Font..." menu-set-font
:visible (display-multi-font-p)
- :help ,(purecopy "Select a default font")))
+ :help "Select a default font"))
(if (featurep 'system-font-setting)
- (define-key menu [menu-system-font]
+ (bindings--define-key menu [menu-system-font]
(menu-bar-make-toggle
toggle-use-system-font font-use-system-font
"Use System Font"
"Use system font: %s"
"Use the monospaced font defined by the system")))
- (define-key menu [showhide]
- `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu))
+ (bindings--define-key menu [showhide]
+ `(menu-item "Show/Hide" ,menu-bar-showhide-menu))
- (define-key menu [showhide-separator]
+ (bindings--define-key menu [showhide-separator]
menu-bar-separator)
- (define-key menu [mule]
+ (bindings--define-key menu [mule]
;; It is better not to use backquote here,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
- `(menu-item ,(purecopy "Multilingual Environment") ,mule-menu-keymap
+ `(menu-item "Multilingual Environment" ,mule-menu-keymap
;; Most of the MULE menu actually does make sense in
;; unibyte mode, e.g. language selection.
;; :visible '(default-value 'enable-multibyte-characters)
))
;;(setq menu-bar-final-items (cons 'mule menu-bar-final-items))
- ;;(define-key menu [preferences]
- ;; `(menu-item ,(purecopy "Preferences") ,menu-bar-preferences-menu
- ;; :help ,(purecopy "Toggle important global options")))
+ ;;(bindings--define-key menu [preferences]
+ ;; `(menu-item "Preferences" ,menu-bar-preferences-menu
+ ;; :help "Toggle important global options"))
- (define-key menu [mule-separator]
+ (bindings--define-key menu [mule-separator]
menu-bar-separator)
- (define-key menu [debug-on-quit]
+ (bindings--define-key menu [debug-on-quit]
(menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
"Enter Debugger on Quit/C-g" "Debug on Quit %s"
"Enter Lisp debugger when C-g is pressed"))
- (define-key menu [debug-on-error]
+ (bindings--define-key menu [debug-on-error]
(menu-bar-make-toggle toggle-debug-on-error debug-on-error
"Enter Debugger on Error" "Debug on Error %s"
"Enter Lisp debugger when an error is signaled"))
- (define-key menu [debugger-separator]
+ (bindings--define-key menu [debugger-separator]
menu-bar-separator)
- (define-key menu [blink-cursor-mode]
+ (bindings--define-key menu [blink-cursor-mode]
(menu-bar-make-mm-toggle
blink-cursor-mode
"Blink Cursor"
"Whether the cursor blinks (Blink Cursor mode)"))
- (define-key menu [cursor-separator]
+ (bindings--define-key menu [cursor-separator]
menu-bar-separator)
- (define-key menu [save-place]
+ (bindings--define-key menu [save-place]
(menu-bar-make-toggle
toggle-save-place-globally save-place
"Save Place in Files between Sessions"
(set-default
'save-place (not (symbol-value 'save-place)))))
- (define-key menu [uniquify]
+ (bindings--define-key menu [uniquify]
(menu-bar-make-toggle
toggle-uniquify-buffer-names uniquify-buffer-name-style
"Use Directory Names in Buffer Names"
(if (not uniquify-buffer-name-style)
'forward))))
- (define-key menu [edit-options-separator]
+ (bindings--define-key menu [edit-options-separator]
menu-bar-separator)
- (define-key menu [cua-mode]
+ (bindings--define-key menu [cua-mode]
(menu-bar-make-mm-toggle
cua-mode
"Use CUA Keys (Cut/Paste with C-x/C-c/C-v)"
(:visible (or (not (boundp 'cua-enable-cua-keys))
cua-enable-cua-keys))))
- (define-key menu [cua-emulation-mode]
+ (bindings--define-key menu [cua-emulation-mode]
(menu-bar-make-mm-toggle
cua-mode
"Shift movement mark region (CUA)"
(:visible (and (boundp 'cua-enable-cua-keys)
(not cua-enable-cua-keys)))))
- (define-key menu [case-fold-search]
+ (bindings--define-key menu [case-fold-search]
(menu-bar-make-toggle
toggle-case-fold-search case-fold-search
"Ignore Case for Search"
"Case-Insensitive Search %s"
"Ignore letter-case in search commands"))
- (define-key menu [auto-fill-mode]
- `(menu-item
- ,(purecopy "Auto Fill in Text Modes")
+ (bindings--define-key menu [auto-fill-mode]
+ '(menu-item
+ "Auto Fill in Text Modes"
menu-bar-text-mode-auto-fill
- :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)")
+ :help "Automatically fill text while typing (Auto Fill mode)"
:button (:toggle . (if (listp text-mode-hook)
(member 'turn-on-auto-fill text-mode-hook)
(eq 'turn-on-auto-fill text-mode-hook)))))
- (define-key menu [line-wrapping]
- `(menu-item ,(purecopy "Line Wrapping in This Buffer")
+ (bindings--define-key menu [line-wrapping]
+ `(menu-item "Line Wrapping in This Buffer"
,menu-bar-line-wrapping-menu))
- (define-key menu [highlight-separator]
+ (bindings--define-key menu [highlight-separator]
menu-bar-separator)
- (define-key menu [highlight-paren-mode]
+ (bindings--define-key menu [highlight-paren-mode]
(menu-bar-make-mm-toggle
show-paren-mode
"Highlight Matching Parentheses"
"Highlight matching/mismatched parentheses at cursor (Show Paren mode)"))
- (define-key menu [transient-mark-mode]
+ (bindings--define-key menu [transient-mark-mode]
(menu-bar-make-mm-toggle
transient-mark-mode
"Highlight Active Region"
(defvar menu-bar-games-menu
(let ((menu (make-sparse-keymap "Games")))
- (define-key menu [zone]
- `(menu-item ,(purecopy "Zone Out") zone
- :help ,(purecopy "Play tricks with Emacs display when Emacs is idle")))
- (define-key menu [tetris]
- `(menu-item ,(purecopy "Tetris") tetris
- :help ,(purecopy "Falling blocks game")))
- (define-key menu [solitaire]
- `(menu-item ,(purecopy "Solitaire") solitaire
- :help ,(purecopy "Get rid of all the stones")))
- (define-key menu [snake]
- `(menu-item ,(purecopy "Snake") snake
- :help ,(purecopy "Move snake around avoiding collisions")))
- (define-key menu [pong]
- `(menu-item ,(purecopy "Pong") pong
- :help ,(purecopy "Bounce the ball to your opponent")))
- (define-key menu [mult]
- `(menu-item ,(purecopy "Multiplication Puzzle") mpuz
- :help ,(purecopy "Exercise brain with multiplication")))
- (define-key menu [life]
- `(menu-item ,(purecopy "Life") life
- :help ,(purecopy "Watch how John Conway's cellular automaton evolves")))
- (define-key menu [land]
- `(menu-item ,(purecopy "Landmark") landmark
- :help ,(purecopy "Watch a neural-network robot learn landmarks")))
- (define-key menu [hanoi]
- `(menu-item ,(purecopy "Towers of Hanoi") hanoi
- :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs")))
- (define-key menu [gomoku]
- `(menu-item ,(purecopy "Gomoku") gomoku
- :help ,(purecopy "Mark 5 contiguous squares (like tic-tac-toe)")))
- (define-key menu [bubbles]
- `(menu-item ,(purecopy "Bubbles") bubbles
- :help ,(purecopy "Remove all bubbles using the fewest moves")))
- (define-key menu [black-box]
- `(menu-item ,(purecopy "Blackbox") blackbox
- :help ,(purecopy "Find balls in a black box by shooting rays")))
- (define-key menu [adventure]
- `(menu-item ,(purecopy "Adventure") dunnet
- :help ,(purecopy "Dunnet, a text Adventure game for Emacs")))
- (define-key menu [5x5]
- `(menu-item ,(purecopy "5x5") 5x5
- :help ,(purecopy "Fill in all the squares on a 5x5 board")))
+ (bindings--define-key menu [zone]
+ '(menu-item "Zone Out" zone
+ :help "Play tricks with Emacs display when Emacs is idle"))
+ (bindings--define-key menu [tetris]
+ '(menu-item "Tetris" tetris
+ :help "Falling blocks game"))
+ (bindings--define-key menu [solitaire]
+ '(menu-item "Solitaire" solitaire
+ :help "Get rid of all the stones"))
+ (bindings--define-key menu [snake]
+ '(menu-item "Snake" snake
+ :help "Move snake around avoiding collisions"))
+ (bindings--define-key menu [pong]
+ '(menu-item "Pong" pong
+ :help "Bounce the ball to your opponent"))
+ (bindings--define-key menu [mult]
+ '(menu-item "Multiplication Puzzle" mpuz
+ :help "Exercise brain with multiplication"))
+ (bindings--define-key menu [life]
+ '(menu-item "Life" life
+ :help "Watch how John Conway's cellular automaton evolves"))
+ (bindings--define-key menu [land]
+ '(menu-item "Landmark" landmark
+ :help "Watch a neural-network robot learn landmarks"))
+ (bindings--define-key menu [hanoi]
+ '(menu-item "Towers of Hanoi" hanoi
+ :help "Watch Towers-of-Hanoi puzzle solved by Emacs"))
+ (bindings--define-key menu [gomoku]
+ '(menu-item "Gomoku" gomoku
+ :help "Mark 5 contiguous squares (like tic-tac-toe)"))
+ (bindings--define-key menu [bubbles]
+ '(menu-item "Bubbles" bubbles
+ :help "Remove all bubbles using the fewest moves"))
+ (bindings--define-key menu [black-box]
+ '(menu-item "Blackbox" blackbox
+ :help "Find balls in a black box by shooting rays"))
+ (bindings--define-key menu [adventure]
+ '(menu-item "Adventure" dunnet
+ :help "Dunnet, a text Adventure game for Emacs"))
+ (bindings--define-key menu [5x5]
+ '(menu-item "5x5" 5x5
+ :help "Fill in all the squares on a 5x5 board"))
menu))
(defvar menu-bar-encryption-decryption-menu
(let ((menu (make-sparse-keymap "Encryption/Decryption")))
- (define-key menu [insert-keys]
- `(menu-item ,(purecopy "Insert Keys") epa-insert-keys
- :help ,(purecopy "Insert public keys after the current point")))
+ (bindings--define-key menu [insert-keys]
+ '(menu-item "Insert Keys" epa-insert-keys
+ :help "Insert public keys after the current point"))
- (define-key menu [export-keys]
- `(menu-item ,(purecopy "Export Keys") epa-export-keys
- :help ,(purecopy "Export public keys to a file")))
+ (bindings--define-key menu [export-keys]
+ '(menu-item "Export Keys" epa-export-keys
+ :help "Export public keys to a file"))
- (define-key menu [import-keys-region]
- `(menu-item ,(purecopy "Import Keys from Region") epa-import-keys-region
- :help ,(purecopy "Import public keys from the current region")))
+ (bindings--define-key menu [import-keys-region]
+ '(menu-item "Import Keys from Region" epa-import-keys-region
+ :help "Import public keys from the current region"))
- (define-key menu [import-keys]
- `(menu-item ,(purecopy "Import Keys from File...") epa-import-keys
- :help ,(purecopy "Import public keys from a file")))
+ (bindings--define-key menu [import-keys]
+ '(menu-item "Import Keys from File..." epa-import-keys
+ :help "Import public keys from a file"))
- (define-key menu [list-keys]
- `(menu-item ,(purecopy "List Keys") epa-list-keys
- :help ,(purecopy "Browse your public keyring")))
+ (bindings--define-key menu [list-keys]
+ '(menu-item "List Keys" epa-list-keys
+ :help "Browse your public keyring"))
- (define-key menu [separator-keys]
+ (bindings--define-key menu [separator-keys]
menu-bar-separator)
- (define-key menu [sign-region]
- `(menu-item ,(purecopy "Sign Region") epa-sign-region
- :help ,(purecopy "Create digital signature of the current region")))
+ (bindings--define-key menu [sign-region]
+ '(menu-item "Sign Region" epa-sign-region
+ :help "Create digital signature of the current region"))
- (define-key menu [verify-region]
- `(menu-item ,(purecopy "Verify Region") epa-verify-region
- :help ,(purecopy "Verify digital signature of the current region")))
+ (bindings--define-key menu [verify-region]
+ '(menu-item "Verify Region" epa-verify-region
+ :help "Verify digital signature of the current region"))
- (define-key menu [encrypt-region]
- `(menu-item ,(purecopy "Encrypt Region") epa-encrypt-region
- :help ,(purecopy "Encrypt the current region")))
+ (bindings--define-key menu [encrypt-region]
+ '(menu-item "Encrypt Region" epa-encrypt-region
+ :help "Encrypt the current region"))
- (define-key menu [decrypt-region]
- `(menu-item ,(purecopy "Decrypt Region") epa-decrypt-region
- :help ,(purecopy "Decrypt the current region")))
+ (bindings--define-key menu [decrypt-region]
+ '(menu-item "Decrypt Region" epa-decrypt-region
+ :help "Decrypt the current region"))
- (define-key menu [separator-file]
+ (bindings--define-key menu [separator-file]
menu-bar-separator)
- (define-key menu [sign-file]
- `(menu-item ,(purecopy "Sign File...") epa-sign-file
- :help ,(purecopy "Create digital signature of a file")))
+ (bindings--define-key menu [sign-file]
+ '(menu-item "Sign File..." epa-sign-file
+ :help "Create digital signature of a file"))
- (define-key menu [verify-file]
- `(menu-item ,(purecopy "Verify File...") epa-verify-file
- :help ,(purecopy "Verify digital signature of a file")))
+ (bindings--define-key menu [verify-file]
+ '(menu-item "Verify File..." epa-verify-file
+ :help "Verify digital signature of a file"))
- (define-key menu [encrypt-file]
- `(menu-item ,(purecopy "Encrypt File...") epa-encrypt-file
- :help ,(purecopy "Encrypt a file")))
+ (bindings--define-key menu [encrypt-file]
+ '(menu-item "Encrypt File..." epa-encrypt-file
+ :help "Encrypt a file"))
- (define-key menu [decrypt-file]
- `(menu-item ,(purecopy "Decrypt File...") epa-decrypt-file
- :help ,(purecopy "Decrypt a file")))
+ (bindings--define-key menu [decrypt-file]
+ '(menu-item "Decrypt File..." epa-decrypt-file
+ :help "Decrypt a file"))
menu))
(defvar menu-bar-tools-menu
(let ((menu (make-sparse-keymap "Tools")))
- (define-key menu [games]
- `(menu-item ,(purecopy "Games") ,menu-bar-games-menu))
+ (bindings--define-key menu [games]
+ `(menu-item "Games" ,menu-bar-games-menu))
- (define-key menu [separator-games]
+ (bindings--define-key menu [separator-games]
menu-bar-separator)
- (define-key menu [encryption-decryption]
- `(menu-item ,(purecopy "Encryption/Decryption") ,menu-bar-encryption-decryption-menu))
+ (bindings--define-key menu [encryption-decryption]
+ `(menu-item "Encryption/Decryption"
+ ,menu-bar-encryption-decryption-menu))
- (define-key menu [separator-encryption-decryption]
+ (bindings--define-key menu [separator-encryption-decryption]
menu-bar-separator)
- (define-key menu [simple-calculator]
- `(menu-item ,(purecopy "Simple Calculator") calculator
- :help ,(purecopy "Invoke the Emacs built-in quick calculator")))
- (define-key menu [calc]
- `(menu-item ,(purecopy "Programmable Calculator") calc
- :help ,(purecopy "Invoke the Emacs built-in full scientific calculator")))
- (define-key menu [calendar]
- `(menu-item ,(purecopy "Calendar") calendar
- :help ,(purecopy "Invoke the Emacs built-in calendar")))
-
- (define-key menu [separator-net]
+ (bindings--define-key menu [simple-calculator]
+ '(menu-item "Simple Calculator" calculator
+ :help "Invoke the Emacs built-in quick calculator"))
+ (bindings--define-key menu [calc]
+ '(menu-item "Programmable Calculator" calc
+ :help "Invoke the Emacs built-in full scientific calculator"))
+ (bindings--define-key menu [calendar]
+ '(menu-item "Calendar" calendar
+ :help "Invoke the Emacs built-in calendar"))
+
+ (bindings--define-key menu [separator-net]
menu-bar-separator)
- (define-key menu [directory-search]
- `(menu-item ,(purecopy "Directory Search") eudc-tools-menu))
- (define-key menu [compose-mail]
- `(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail
+ (bindings--define-key menu [directory-search]
+ '(menu-item "Directory Search" eudc-tools-menu))
+ (bindings--define-key menu [compose-mail]
+ '(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail
:visible (and mail-user-agent (not (eq mail-user-agent 'ignore)))
- :help ,(purecopy "Send a mail message")))
- (define-key menu [rmail]
- `(menu-item (format "Read Mail (with %s)" (read-mail-item-name))
+ :help "Send a mail message"))
+ (bindings--define-key menu [rmail]
+ '(menu-item (format "Read Mail (with %s)" (read-mail-item-name))
menu-bar-read-mail
:visible (and read-mail-command
(not (eq read-mail-command 'ignore)))
- :help ,(purecopy "Read your mail and reply to it")))
+ :help "Read your mail and reply to it"))
- (define-key menu [gnus]
- `(menu-item ,(purecopy "Read Net News (Gnus)") gnus
- :help ,(purecopy "Read network news groups")))
+ (bindings--define-key menu [gnus]
+ '(menu-item "Read Net News (Gnus)" gnus
+ :help "Read network news groups"))
- (define-key menu [separator-vc]
+ (bindings--define-key menu [separator-vc]
menu-bar-separator)
- (define-key menu [pcl-cvs]
- `(menu-item ,(purecopy "PCL-CVS") cvs-global-menu))
- (define-key menu [vc] nil) ;Create the place for the VC menu.
+ (bindings--define-key menu [vc] nil) ;Create the place for the VC menu.
- (define-key menu [separator-compare]
+ (bindings--define-key menu [separator-compare]
menu-bar-separator)
- (define-key menu [epatch]
- `(menu-item ,(purecopy "Apply Patch") menu-bar-epatch-menu))
- (define-key menu [ediff-merge]
- `(menu-item ,(purecopy "Merge") menu-bar-ediff-merge-menu))
- (define-key menu [compare]
- `(menu-item ,(purecopy "Compare (Ediff)") menu-bar-ediff-menu))
+ (bindings--define-key menu [epatch]
+ '(menu-item "Apply Patch" menu-bar-epatch-menu))
+ (bindings--define-key menu [ediff-merge]
+ '(menu-item "Merge" menu-bar-ediff-merge-menu))
+ (bindings--define-key menu [compare]
+ '(menu-item "Compare (Ediff)" menu-bar-ediff-menu))
- (define-key menu [separator-spell]
+ (bindings--define-key menu [separator-spell]
menu-bar-separator)
- (define-key menu [spell]
- `(menu-item ,(purecopy "Spell Checking") ispell-menu-map))
+ (bindings--define-key menu [spell]
+ '(menu-item "Spell Checking" ispell-menu-map))
- (define-key menu [separator-prog]
+ (bindings--define-key menu [separator-prog]
menu-bar-separator)
- (define-key menu [semantic]
- `(menu-item ,(purecopy "Source Code Parsers (Semantic)")
+ (bindings--define-key menu [semantic]
+ '(menu-item "Source Code Parsers (Semantic)"
semantic-mode
- :help ,(purecopy "Toggle automatic parsing in source code buffers (Semantic mode)")
+ :help "Toggle automatic parsing in source code buffers (Semantic mode)"
:button (:toggle . (bound-and-true-p semantic-mode))))
- (define-key menu [ede]
- `(menu-item ,(purecopy "Project support (EDE)")
+ (bindings--define-key menu [ede]
+ '(menu-item "Project support (EDE)"
global-ede-mode
- :help ,(purecopy "Toggle the Emacs Development Environment (Global EDE mode)")
+ :help "Toggle the Emacs Development Environment (Global EDE mode)"
:button (:toggle . (bound-and-true-p global-ede-mode))))
- (define-key menu [gdb]
- `(menu-item ,(purecopy "Debugger (GDB)...") gdb
- :help ,(purecopy "Debug a program from within Emacs with GDB")))
- (define-key menu [shell-on-region]
- `(menu-item ,(purecopy "Shell Command on Region...") shell-command-on-region
+ (bindings--define-key menu [gdb]
+ '(menu-item "Debugger (GDB)..." gdb
+ :help "Debug a program from within Emacs with GDB"))
+ (bindings--define-key menu [shell-on-region]
+ '(menu-item "Shell Command on Region..." shell-command-on-region
:enable mark-active
- :help ,(purecopy "Pass marked region to a shell command")))
- (define-key menu [shell]
- `(menu-item ,(purecopy "Shell Command...") shell-command
- :help ,(purecopy "Invoke a shell command and catch its output")))
- (define-key menu [compile]
- `(menu-item ,(purecopy "Compile...") compile
- :help ,(purecopy "Invoke compiler or Make, view compilation errors")))
- (define-key menu [grep]
- `(menu-item ,(purecopy "Search Files (Grep)...") grep
- :help ,(purecopy "Search files for strings or regexps (with Grep)")))
+ :help "Pass marked region to a shell command"))
+ (bindings--define-key menu [shell]
+ '(menu-item "Shell Command..." shell-command
+ :help "Invoke a shell command and catch its output"))
+ (bindings--define-key menu [compile]
+ '(menu-item "Compile..." compile
+ :help "Invoke compiler or Make, view compilation errors"))
+ (bindings--define-key menu [grep]
+ '(menu-item "Search Files (Grep)..." grep
+ :help "Search files for strings or regexps (with Grep)"))
menu))
\f
;; The "Help" menu items
(defvar menu-bar-describe-menu
(let ((menu (make-sparse-keymap "Describe")))
- (define-key menu [mule-diag]
- `(menu-item ,(purecopy "Show All of Mule Status") mule-diag
+ (bindings--define-key menu [mule-diag]
+ '(menu-item "Show All of Mule Status" mule-diag
:visible (default-value 'enable-multibyte-characters)
- :help ,(purecopy "Display multilingual environment settings")))
- (define-key menu [describe-coding-system-briefly]
- `(menu-item ,(purecopy "Describe Coding System (Briefly)")
+ :help "Display multilingual environment settings"))
+ (bindings--define-key menu [describe-coding-system-briefly]
+ '(menu-item "Describe Coding System (Briefly)"
describe-current-coding-system-briefly
:visible (default-value 'enable-multibyte-characters)))
- (define-key menu [describe-coding-system]
- `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system
+ (bindings--define-key menu [describe-coding-system]
+ '(menu-item "Describe Coding System..." describe-coding-system
:visible (default-value 'enable-multibyte-characters)))
- (define-key menu [describe-input-method]
- `(menu-item ,(purecopy "Describe Input Method...") describe-input-method
+ (bindings--define-key menu [describe-input-method]
+ '(menu-item "Describe Input Method..." describe-input-method
:visible (default-value 'enable-multibyte-characters)
- :help ,(purecopy "Keyboard layout for specific input method")))
- (define-key menu [describe-language-environment]
- `(menu-item ,(purecopy "Describe Language Environment")
+ :help "Keyboard layout for specific input method"))
+ (bindings--define-key menu [describe-language-environment]
+ `(menu-item "Describe Language Environment"
,describe-language-environment-map))
- (define-key menu [separator-desc-mule]
+ (bindings--define-key menu [separator-desc-mule]
menu-bar-separator)
- (define-key menu [list-keybindings]
- `(menu-item ,(purecopy "List Key Bindings") describe-bindings
- :help ,(purecopy "Display all current key bindings (keyboard shortcuts)")))
- (define-key menu [describe-current-display-table]
- `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table
- :help ,(purecopy "Describe the current display table")))
- (define-key menu [describe-package]
- `(menu-item ,(purecopy "Describe Package...") describe-package
- :help ,(purecopy "Display documentation of a Lisp package")))
- (define-key menu [describe-face]
- `(menu-item ,(purecopy "Describe Face...") describe-face
- :help ,(purecopy "Display the properties of a face")))
- (define-key menu [describe-variable]
- `(menu-item ,(purecopy "Describe Variable...") describe-variable
- :help ,(purecopy "Display documentation of variable/option")))
- (define-key menu [describe-function]
- `(menu-item ,(purecopy "Describe Function...") describe-function
- :help ,(purecopy "Display documentation of function/command")))
- (define-key menu [describe-key-1]
- `(menu-item ,(purecopy "Describe Key or Mouse Operation...") describe-key
+ (bindings--define-key menu [list-keybindings]
+ '(menu-item "List Key Bindings" describe-bindings
+ :help "Display all current key bindings (keyboard shortcuts)"))
+ (bindings--define-key menu [describe-current-display-table]
+ '(menu-item "Describe Display Table" describe-current-display-table
+ :help "Describe the current display table"))
+ (bindings--define-key menu [describe-package]
+ '(menu-item "Describe Package..." describe-package
+ :help "Display documentation of a Lisp package"))
+ (bindings--define-key menu [describe-face]
+ '(menu-item "Describe Face..." describe-face
+ :help "Display the properties of a face"))
+ (bindings--define-key menu [describe-variable]
+ '(menu-item "Describe Variable..." describe-variable
+ :help "Display documentation of variable/option"))
+ (bindings--define-key menu [describe-function]
+ '(menu-item "Describe Function..." describe-function
+ :help "Display documentation of function/command"))
+ (bindings--define-key menu [describe-key-1]
+ '(menu-item "Describe Key or Mouse Operation..." describe-key
;; Users typically don't identify keys and menu items...
- :help ,(purecopy "Display documentation of command bound to a \
-key, a click, or a menu-item")))
- (define-key menu [describe-mode]
- `(menu-item ,(purecopy "Describe Buffer Modes") describe-mode
- :help ,(purecopy "Describe this buffer's major and minor mode")))
+ :help "Display documentation of command bound to a \
+key, a click, or a menu-item"))
+ (bindings--define-key menu [describe-mode]
+ '(menu-item "Describe Buffer Modes" describe-mode
+ :help "Describe this buffer's major and minor mode"))
menu))
(defun menu-bar-read-lispref ()
(defvar menu-bar-search-documentation-menu
(let ((menu (make-sparse-keymap "Search Documentation")))
- (define-key menu [search-documentation-strings]
- `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation
+ (bindings--define-key menu [search-documentation-strings]
+ '(menu-item "Search Documentation Strings..." apropos-documentation
:help
- ,(purecopy "Find functions and variables whose doc strings match a regexp")))
- (define-key menu [find-any-object-by-name]
- `(menu-item ,(purecopy "Find Any Object by Name...") apropos
- :help ,(purecopy "Find symbols of any kind whose names match a regexp")))
- (define-key menu [find-option-by-value]
- `(menu-item ,(purecopy "Find Options by Value...") apropos-value
- :help ,(purecopy "Find variables whose values match a regexp")))
- (define-key menu [find-options-by-name]
- `(menu-item ,(purecopy "Find Options by Name...") apropos-variable
- :help ,(purecopy "Find variables whose names match a regexp")))
- (define-key menu [find-commands-by-name]
- `(menu-item ,(purecopy "Find Commands by Name...") apropos-command
- :help ,(purecopy "Find commands whose names match a regexp")))
- (define-key menu [sep1]
+ "Find functions and variables whose doc strings match a regexp"))
+ (bindings--define-key menu [find-any-object-by-name]
+ '(menu-item "Find Any Object by Name..." apropos
+ :help "Find symbols of any kind whose names match a regexp"))
+ (bindings--define-key menu [find-option-by-value]
+ '(menu-item "Find Options by Value..." apropos-value
+ :help "Find variables whose values match a regexp"))
+ (bindings--define-key menu [find-options-by-name]
+ '(menu-item "Find Options by Name..." apropos-variable
+ :help "Find variables whose names match a regexp"))
+ (bindings--define-key menu [find-commands-by-name]
+ '(menu-item "Find Commands by Name..." apropos-command
+ :help "Find commands whose names match a regexp"))
+ (bindings--define-key menu [sep1]
menu-bar-separator)
- (define-key menu [lookup-command-in-manual]
- `(menu-item ,(purecopy "Look Up Command in User Manual...") Info-goto-emacs-command-node
- :help ,(purecopy "Display manual section that describes a command")))
- (define-key menu [lookup-key-in-manual]
- `(menu-item ,(purecopy "Look Up Key in User Manual...") Info-goto-emacs-key-command-node
- :help ,(purecopy "Display manual section that describes a key")))
- (define-key menu [lookup-subject-in-elisp-manual]
- `(menu-item ,(purecopy "Look Up Subject in ELisp Manual...") elisp-index-search
- :help ,(purecopy "Find description of a subject in Emacs Lisp manual")))
- (define-key menu [lookup-subject-in-emacs-manual]
- `(menu-item ,(purecopy "Look Up Subject in User Manual...") emacs-index-search
- :help ,(purecopy "Find description of a subject in Emacs User manual")))
- (define-key menu [emacs-terminology]
- `(menu-item ,(purecopy "Emacs Terminology") search-emacs-glossary
- :help ,(purecopy "Display the Glossary section of the Emacs manual")))
+ (bindings--define-key menu [lookup-command-in-manual]
+ '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node
+ :help "Display manual section that describes a command"))
+ (bindings--define-key menu [lookup-key-in-manual]
+ '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node
+ :help "Display manual section that describes a key"))
+ (bindings--define-key menu [lookup-subject-in-elisp-manual]
+ '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search
+ :help "Find description of a subject in Emacs Lisp manual"))
+ (bindings--define-key menu [lookup-subject-in-emacs-manual]
+ '(menu-item "Look Up Subject in User Manual..." emacs-index-search
+ :help "Find description of a subject in Emacs User manual"))
+ (bindings--define-key menu [emacs-terminology]
+ '(menu-item "Emacs Terminology" search-emacs-glossary
+ :help "Display the Glossary section of the Emacs manual"))
menu))
(defvar menu-bar-manuals-menu
(let ((menu (make-sparse-keymap "More Manuals")))
- (define-key menu [man]
- `(menu-item ,(purecopy "Read Man Page...") manual-entry
- :help ,(purecopy "Man-page docs for external commands and libraries")))
- (define-key menu [sep2]
+ (bindings--define-key menu [man]
+ '(menu-item "Read Man Page..." manual-entry
+ :help "Man-page docs for external commands and libraries"))
+ (bindings--define-key menu [sep2]
menu-bar-separator)
- (define-key menu [order-emacs-manuals]
- `(menu-item ,(purecopy "Ordering Manuals") view-order-manuals
- :help ,(purecopy "How to order manuals from the Free Software Foundation")))
- (define-key menu [lookup-subject-in-all-manuals]
- `(menu-item ,(purecopy "Lookup Subject in all Manuals...") info-apropos
- :help ,(purecopy "Find description of a subject in all installed manuals")))
- (define-key menu [other-manuals]
- `(menu-item ,(purecopy "All Other Manuals (Info)") Info-directory
- :help ,(purecopy "Read any of the installed manuals")))
- (define-key menu [emacs-lisp-reference]
- `(menu-item ,(purecopy "Emacs Lisp Reference") menu-bar-read-lispref
- :help ,(purecopy "Read the Emacs Lisp Reference manual")))
- (define-key menu [emacs-lisp-intro]
- `(menu-item ,(purecopy "Introduction to Emacs Lisp") menu-bar-read-lispintro
- :help ,(purecopy "Read the Introduction to Emacs Lisp Programming")))
+ (bindings--define-key menu [order-emacs-manuals]
+ '(menu-item "Ordering Manuals" view-order-manuals
+ :help "How to order manuals from the Free Software Foundation"))
+ (bindings--define-key menu [lookup-subject-in-all-manuals]
+ '(menu-item "Lookup Subject in all Manuals..." info-apropos
+ :help "Find description of a subject in all installed manuals"))
+ (bindings--define-key menu [other-manuals]
+ '(menu-item "All Other Manuals (Info)" Info-directory
+ :help "Read any of the installed manuals"))
+ (bindings--define-key menu [emacs-lisp-reference]
+ '(menu-item "Emacs Lisp Reference" menu-bar-read-lispref
+ :help "Read the Emacs Lisp Reference manual"))
+ (bindings--define-key menu [emacs-lisp-intro]
+ '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro
+ :help "Read the Introduction to Emacs Lisp Programming"))
menu))
(defun menu-bar-help-extra-packages ()
(defvar menu-bar-help-menu
(let ((menu (make-sparse-keymap "Help")))
- (define-key menu [about-gnu-project]
- `(menu-item ,(purecopy "About GNU") describe-gnu-project
- :help ,(purecopy "About the GNU System, GNU Project, and GNU/Linux")))
- (define-key menu [about-emacs]
- `(menu-item ,(purecopy "About Emacs") about-emacs
- :help ,(purecopy "Display version number, copyright info, and basic help")))
- (define-key menu [sep4]
+ (bindings--define-key menu [about-gnu-project]
+ '(menu-item "About GNU" describe-gnu-project
+ :help "About the GNU System, GNU Project, and GNU/Linux"))
+ (bindings--define-key menu [about-emacs]
+ '(menu-item "About Emacs" about-emacs
+ :help "Display version number, copyright info, and basic help"))
+ (bindings--define-key menu [sep4]
menu-bar-separator)
- (define-key menu [describe-no-warranty]
- `(menu-item ,(purecopy "(Non)Warranty") describe-no-warranty
- :help ,(purecopy "Explain that Emacs has NO WARRANTY")))
- (define-key menu [describe-copying]
- `(menu-item ,(purecopy "Copying Conditions") describe-copying
- :help ,(purecopy "Show the Emacs license (GPL)")))
- (define-key menu [getting-new-versions]
- `(menu-item ,(purecopy "Getting New Versions") describe-distribution
- :help ,(purecopy "How to get the latest version of Emacs")))
- (define-key menu [sep2]
+ (bindings--define-key menu [describe-no-warranty]
+ '(menu-item "(Non)Warranty" describe-no-warranty
+ :help "Explain that Emacs has NO WARRANTY"))
+ (bindings--define-key menu [describe-copying]
+ '(menu-item "Copying Conditions" describe-copying
+ :help "Show the Emacs license (GPL)"))
+ (bindings--define-key menu [getting-new-versions]
+ '(menu-item "Getting New Versions" describe-distribution
+ :help "How to get the latest version of Emacs"))
+ (bindings--define-key menu [sep2]
menu-bar-separator)
- (define-key menu [external-packages]
- `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages
- :help ,(purecopy "Lisp packages distributed separately for use in Emacs")))
- (define-key menu [find-emacs-packages]
- `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword
- :help ,(purecopy "Find built-in packages and features by keyword")))
- (define-key menu [more-manuals]
- `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu))
- (define-key menu [emacs-manual]
- `(menu-item ,(purecopy "Read the Emacs Manual") info-emacs-manual
- :help ,(purecopy "Full documentation of Emacs features")))
- (define-key menu [describe]
- `(menu-item ,(purecopy "Describe") ,menu-bar-describe-menu))
- (define-key menu [search-documentation]
- `(menu-item ,(purecopy "Search Documentation") ,menu-bar-search-documentation-menu))
- (define-key menu [sep1]
+ (bindings--define-key menu [external-packages]
+ '(menu-item "Finding Extra Packages" menu-bar-help-extra-packages
+ :help "Lisp packages distributed separately for use in Emacs"))
+ (bindings--define-key menu [find-emacs-packages]
+ '(menu-item "Search Built-in Packages" finder-by-keyword
+ :help "Find built-in packages and features by keyword"))
+ (bindings--define-key menu [more-manuals]
+ `(menu-item "More Manuals" ,menu-bar-manuals-menu))
+ (bindings--define-key menu [emacs-manual]
+ '(menu-item "Read the Emacs Manual" info-emacs-manual
+ :help "Full documentation of Emacs features"))
+ (bindings--define-key menu [describe]
+ `(menu-item "Describe" ,menu-bar-describe-menu))
+ (bindings--define-key menu [search-documentation]
+ `(menu-item "Search Documentation" ,menu-bar-search-documentation-menu))
+ (bindings--define-key menu [sep1]
menu-bar-separator)
- (define-key menu [emacs-psychotherapist]
- `(menu-item ,(purecopy "Emacs Psychotherapist") doctor
- :help ,(purecopy "Our doctor will help you feel better")))
- (define-key menu [send-emacs-bug-report]
- `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug
- :help ,(purecopy "Send e-mail to Emacs maintainers")))
- (define-key menu [emacs-known-problems]
- `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems
- :help ,(purecopy "Read about known problems with Emacs")))
- (define-key menu [emacs-news]
- `(menu-item ,(purecopy "Emacs News") view-emacs-news
- :help ,(purecopy "New features of this version")))
- (define-key menu [emacs-faq]
- `(menu-item ,(purecopy "Emacs FAQ") view-emacs-FAQ
- :help ,(purecopy "Frequently asked (and answered) questions about Emacs")))
-
- (define-key menu [emacs-tutorial-language-specific]
- `(menu-item ,(purecopy "Emacs Tutorial (choose language)...")
+ (bindings--define-key menu [emacs-psychotherapist]
+ '(menu-item "Emacs Psychotherapist" doctor
+ :help "Our doctor will help you feel better"))
+ (bindings--define-key menu [send-emacs-bug-report]
+ '(menu-item "Send Bug Report..." report-emacs-bug
+ :help "Send e-mail to Emacs maintainers"))
+ (bindings--define-key menu [emacs-manual-bug]
+ '(menu-item "How to Report a Bug" info-emacs-bug
+ :help "Read about how to report an Emacs bug"))
+ (bindings--define-key menu [emacs-known-problems]
+ '(menu-item "Emacs Known Problems" view-emacs-problems
+ :help "Read about known problems with Emacs"))
+ (bindings--define-key menu [emacs-news]
+ '(menu-item "Emacs News" view-emacs-news
+ :help "New features of this version"))
+ (bindings--define-key menu [emacs-faq]
+ '(menu-item "Emacs FAQ" view-emacs-FAQ
+ :help "Frequently asked (and answered) questions about Emacs"))
+
+ (bindings--define-key menu [emacs-tutorial-language-specific]
+ '(menu-item "Emacs Tutorial (choose language)..."
help-with-tutorial-spec-language
- :help ,(purecopy "Learn how to use Emacs (choose a language)")))
- (define-key menu [emacs-tutorial]
- `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial
- :help ,(purecopy "Learn how to use Emacs")))
+ :help "Learn how to use Emacs (choose a language)"))
+ (bindings--define-key menu [emacs-tutorial]
+ '(menu-item "Emacs Tutorial" help-with-tutorial
+ :help "Learn how to use Emacs"))
;; In OS X it's in the app menu already.
;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu.
(and (featurep 'ns)
(not (eq system-type 'darwin))
- (define-key menu [info-panel]
- `(menu-item ,(purecopy "About Emacs...") ns-do-emacs-info-panel)))
+ (bindings--define-key menu [info-panel]
+ '(menu-item "About Emacs..." ns-do-emacs-info-panel)))
menu))
-(define-key global-map [menu-bar tools]
- (cons (purecopy "Tools") menu-bar-tools-menu))
-(define-key global-map [menu-bar buffer]
- (cons (purecopy "Buffers") global-buffers-menu-map))
-(define-key global-map [menu-bar options]
- (cons (purecopy "Options") menu-bar-options-menu))
-(define-key global-map [menu-bar edit]
- (cons (purecopy "Edit") menu-bar-edit-menu))
-(define-key global-map [menu-bar file]
- (cons (purecopy "File") menu-bar-file-menu))
+(bindings--define-key global-map [menu-bar tools]
+ (cons "Tools" menu-bar-tools-menu))
+(bindings--define-key global-map [menu-bar buffer]
+ (cons "Buffers" global-buffers-menu-map))
+(bindings--define-key global-map [menu-bar options]
+ (cons "Options" menu-bar-options-menu))
+(bindings--define-key global-map [menu-bar edit]
+ (cons "Edit" menu-bar-edit-menu))
+(bindings--define-key global-map [menu-bar file]
+ (cons "File" menu-bar-file-menu))
;; Put "Help" menu at the end, or Info at the front.
;; If running under GNUstep, "Help" is moved and renamed "Info" (see below).
(if (and (featurep 'ns)
(not (eq system-type 'darwin)))
- (define-key global-map [menu-bar help-menu]
- (cons (purecopy "Info") menu-bar-help-menu))
+ (bindings--define-key global-map [menu-bar help-menu]
+ (cons "Info" menu-bar-help-menu))
(define-key-after global-map [menu-bar help-menu]
(cons (purecopy "Help") menu-bar-help-menu)))
;; This shouldn't be necessary, but there's a funny
;; bug in keymap.c that I don't understand yet. -stef
minibuffer-local-completion-map))
- (define-key map [menu-bar minibuf]
- (cons (purecopy "Minibuf") (make-sparse-keymap "Minibuf"))))
+ (bindings--define-key map [menu-bar minibuf]
+ (cons "Minibuf" (make-sparse-keymap "Minibuf"))))
(let ((map minibuffer-local-completion-map))
- (define-key map [menu-bar minibuf ?\?]
- `(menu-item ,(purecopy "List Completions") minibuffer-completion-help
- :help ,(purecopy "Display all possible completions")))
- (define-key map [menu-bar minibuf space]
- `(menu-item ,(purecopy "Complete Word") minibuffer-complete-word
- :help ,(purecopy "Complete at most one word")))
- (define-key map [menu-bar minibuf tab]
- `(menu-item ,(purecopy "Complete") minibuffer-complete
- :help ,(purecopy "Complete as far as possible"))))
+ (bindings--define-key map [menu-bar minibuf ?\?]
+ '(menu-item "List Completions" minibuffer-completion-help
+ :help "Display all possible completions"))
+ (bindings--define-key map [menu-bar minibuf space]
+ '(menu-item "Complete Word" minibuffer-complete-word
+ :help "Complete at most one word"))
+ (bindings--define-key map [menu-bar minibuf tab]
+ '(menu-item "Complete" minibuffer-complete
+ :help "Complete as far as possible")))
(let ((map minibuffer-local-map))
- (define-key map [menu-bar minibuf quit]
- `(menu-item ,(purecopy "Quit") abort-recursive-edit
- :help ,(purecopy "Abort input and exit minibuffer")))
- (define-key map [menu-bar minibuf return]
- `(menu-item ,(purecopy "Enter") exit-minibuffer
- :key-sequence ,(purecopy "\r")
- :help ,(purecopy "Terminate input and exit minibuffer")))
- (define-key map [menu-bar minibuf isearch-forward]
- `(menu-item ,(purecopy "Isearch History Forward") isearch-forward
- :help ,(purecopy "Incrementally search minibuffer history forward")))
- (define-key map [menu-bar minibuf isearch-backward]
- `(menu-item ,(purecopy "Isearch History Backward") isearch-backward
- :help ,(purecopy "Incrementally search minibuffer history backward")))
- (define-key map [menu-bar minibuf next]
- `(menu-item ,(purecopy "Next History Item") next-history-element
- :help ,(purecopy "Put next minibuffer history element in the minibuffer")))
- (define-key map [menu-bar minibuf previous]
- `(menu-item ,(purecopy "Previous History Item") previous-history-element
- :help ,(purecopy "Put previous minibuffer history element in the minibuffer"))))
+ (bindings--define-key map [menu-bar minibuf quit]
+ '(menu-item "Quit" abort-recursive-edit
+ :help "Abort input and exit minibuffer"))
+ (bindings--define-key map [menu-bar minibuf return]
+ '(menu-item "Enter" exit-minibuffer
+ :key-sequence "\r"
+ :help "Terminate input and exit minibuffer"))
+ (bindings--define-key map [menu-bar minibuf isearch-forward]
+ '(menu-item "Isearch History Forward" isearch-forward
+ :help "Incrementally search minibuffer history forward"))
+ (bindings--define-key map [menu-bar minibuf isearch-backward]
+ '(menu-item "Isearch History Backward" isearch-backward
+ :help "Incrementally search minibuffer history backward"))
+ (bindings--define-key map [menu-bar minibuf next]
+ '(menu-item "Next History Item" next-history-element
+ :help "Put next minibuffer history element in the minibuffer"))
+ (bindings--define-key map [menu-bar minibuf previous]
+ '(menu-item "Previous History Item" previous-history-element
+ :help "Put previous minibuffer history element in the minibuffer")))
\f
(define-minor-mode menu-bar-mode
"Toggle display of a menu bar on each frame (Menu Bar mode).
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
- * Version 24.2 released.
+ * mh-utils.el (minibuffer-completing-file-name): Don't declare, unused.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-04-21 Juanma Barranquero <lekktu@gmail.com>
- * Version 24.1 released.
+ * mh-folder.el (top): Check whether which-func-modes is t before
+ adding mh-folder-mode.
2011-11-20 Bill Wohler <wohler@newt.com>
* mh-mime.el (mh-decode-message-subject): New function to decode
RFC2047 encoded Subject lines. Used for reply drafts.
- * mh-comp.el (mh-compose-and-send-mail): Call
- `mh-decode-message-subject' on (reply or forward) message drafts.
+ * mh-comp.el (mh-compose-and-send-mail):
+ Call `mh-decode-message-subject' on (reply or forward) message drafts.
2010-05-07 Chong Yidong <cyd@stupidchicken.com>
* mh-show.el (mh-show-preferred-alternative)
* mh-e.el (mh-annotate-msg-hook): Sync docstring with manual.
- * mh-comp.el (mh-send-letter, mh-redistribute): Mention
- mh-annotate-msg-hook in docstring.
+ * mh-comp.el (mh-send-letter, mh-redistribute):
+ Mention mh-annotate-msg-hook in docstring.
2008-06-29 Jeffrey C Honig <jch@honig.net>
2008-05-23 Bill Wohler <wohler@newt.com>
- * mh-e.el (mh-invisible-header-fields-internal): Remove
- DKIM-Signature as it is covered by DKIM-. Fully qualify X-EID.
+ * mh-e.el (mh-invisible-header-fields-internal):
+ Remove DKIM-Signature as it is covered by DKIM-. Fully qualify X-EID.
2008-05-19 Sergey Poznyakoff <gray@gnu.org.ua>
2007-08-21 Jeffrey C Honig <jch@honig.net>
- * mh-folder.el (mh-folder-message-menu, mh-folder-mode-map): Add
- folder mode support for mh-show-preferred-alternative (closes SF
+ * mh-folder.el (mh-folder-message-menu, mh-folder-mode-map):
+ Add folder mode support for mh-show-preferred-alternative (closes SF
#1777321).
* mh-show.el (mh-show-preferred-alternative)
HTML when text content is lacking (closes SF #1777321).
* mh-e.el:
- (mh-invisible-header-fields-internal): Exclude Fax and Phone. Put
- known exclusions as comments before the list and move parens to
+ (mh-invisible-header-fields-internal): Exclude Fax and Phone.
+ Put known exclusions as comments before the list and move parens to
separate lines to aid in sorting (closes SF #1701231).
* mh-mime.el (mm-decode-body): Remove explicit autoload of
(mh-tool-bar-folder-buttons-set, mh-tool-bar-letter-buttons-set):
Call it (closes SF #1452718).
- * mh-folder.el (mh-folder-buttons-init-flag): Delete. Use
- mh-folder-tool-bar-map instead.
+ * mh-folder.el (mh-folder-buttons-init-flag): Delete.
+ Use mh-folder-tool-bar-map instead.
(image-load-path): Delete. No longer used.
- (mh-folder-mode): Moved setting of image-load-path into
+ (mh-folder-mode): Move setting of image-load-path into
mh-tool-bar-folder-buttons-init.
- * mh-letter.el (mh-letter-buttons-init-flag): Delete. Use
- mh-letter-tool-bar-map instead.
+ * mh-letter.el (mh-letter-buttons-init-flag): Delete.
+ Use mh-letter-tool-bar-map instead.
(image-load-path): Delete. No longer used.
- (mh-letter-mode): Moved setting of image-load-path into
+ (mh-letter-mode): Move setting of image-load-path into
mh-tool-bar-letter-buttons-init.
* mh-seq.el (mh-narrow-to-seq, mh-widen): Use with-current-buffer
(mh-print-background-flag, mh-show-maximum-size)
(mh-show-use-xface-flag, mh-store-default-directory)
(mh-summary-height, mh-speed-update-interval)
- (mh-show-threads-flag, mh-tool-bar-search-function): Add
- :package-version keyword to these options (closes SF #1452724).
+ (mh-show-threads-flag, mh-tool-bar-search-function):
+ Add :package-version keyword to these options (closes SF #1452724).
(mh-after-commands-processed-hook)
(mh-alias-reloaded-hook, mh-before-commands-processed-hook)
(mh-before-quit-hook, mh-before-send-letter-hook)
(mh-speedbar-selected-folder-with-unseen-messages): : Add
:package-version keyword to these faces (closes SF #1452724).
- * mh-tool-bar.el (mh-tool-bar-define): Added commented-out
+ * mh-tool-bar.el (mh-tool-bar-define): Add commented-out
:package-version keywords (closes SF #1452724).
2006-03-28 Bill Wohler <wohler@newt.com>
* mh-tool-bar.el: Use clipboard-kill-region,
clipboard-kill-ring-save, and clipboard-yank instead of undo,
- kill-region, and menu-bar-kill-ring-save respectively. In
- MH-Letter mode, move save-buffer and mh-fully-kill-draft icons in
+ kill-region, and menu-bar-kill-ring-save respectively.
+ In MH-Letter mode, move save-buffer and mh-fully-kill-draft icons in
front of mh-compose-insertion to be consistent with other mailers,
such as Evolution. In MH-Folder mode, move vanilla reply icon to
the left of the other reply icons. Use mail/inbox icon instead of
2006-03-14 Bill Wohler <wohler@newt.com>
- * mh-compat.el (mh-image-load-path-for-library): Incorporate
- changes from image-load-path-for-library, which are:
+ * mh-compat.el (mh-image-load-path-for-library):
+ Incorporate changes from image-load-path-for-library, which are:
(image-load-path-for-library): Pass value of path rather than
symbol. Always return list of directories. Guarantee that image
directory comes first.
flag to replace-in-string. This was badly needed by
mh-quote-pick-expr in order to properly quote subjects when using
/ s on XEmacs (closes SF #1447598).
- (mh-image-load-path-for-library): Merged changes from Reiner. Add
- no-error argument. If path t, just return directory.
+ (mh-image-load-path-for-library): Merged changes from Reiner.
+ Add no-error argument. If path t, just return directory.
* mh-e.el (mh-profile-component): Drop `s' from mhparam
-components for Mailutils compatibility (closes SF #1446985).
local variable mh-image-directory to image-directory. Move error
checks to default case in cond and simplify.
- * mh-comp.el (mh-send-letter, mh-insert-auto-fields): Sync
- docstrings with manual.
+ * mh-comp.el (mh-send-letter, mh-insert-auto-fields):
+ Sync docstrings with manual.
2006-03-02 Bill Wohler <wohler@newt.com>
* mh-utils.el (mh-image-directory)
(mh-image-load-path-called-flag): Delete.
- (mh-image-load-path): Incorporate changes from Gnus team. Biggest
- changes are that it no longer uses/sets mh-image-directory or
+ (mh-image-load-path): Incorporate changes from Gnus team.
+ Biggest changes are that it no longer uses/sets mh-image-directory or
mh-image-load-path-called-flag, and returns the updated path
rather than change it.
(mh-logo-display): Change usage of mh-image-load-path.
goto-addr.el.
(mh-alias-suggest-alias): Use goto-address-mail-regexp instead of
mh-address-mail-regexp.
- (mh-alias-add-address-under-point): Use
- goto-address-find-address-at-point instead of
+ (mh-alias-add-address-under-point):
+ Use goto-address-find-address-at-point instead of
mh-goto-address-find-address-at-point.
* mh-e.el (mh-show-use-goto-addr-flag): Delete.
2006-02-08 Peter S Galbraith <psg@debian.org>
- * mh-e.el (mh-invisible-header-fields-internal): Added entries
+ * mh-e.el (mh-invisible-header-fields-internal): Add entries
"X-BrightmailFiltered:", "X-Brightmail-Tracker:" and "X-Hashcash".
2006-02-04 Bill Wohler <wohler@newt.com>
* mh-search.el (which-func-mode): Shush compiler on Emacs 21 too.
- * mh-alias.el (mh-alias-gecos-name): Use
- mh-replace-regexp-in-string instead of replace-regexp-in-string.
+ * mh-alias.el (mh-alias-gecos-name):
+ Use mh-replace-regexp-in-string instead of replace-regexp-in-string.
(crm, multi-prompt): Use mh-require instead of require.
- (mh-goto-address-find-address-at-point): Use
- mh-line-beginning-position and mh-line-end-position instead of
- line-beginning-position and line-end-position. Use
- mh-match-string-no-properties instead of
+ (mh-goto-address-find-address-at-point):
+ Use mh-line-beginning-position and mh-line-end-position instead of
+ line-beginning-position and line-end-position.
+ Use mh-match-string-no-properties instead of
match-string-no-properties.
- * mh-comp.el (mh-modify-header-field): Use
- mh-line-beginning-position and mh-line-end-position instead of
+ * mh-comp.el (mh-modify-header-field):
+ Use mh-line-beginning-position and mh-line-end-position instead of
line-beginning-position and line-end-position.
* mh-compat.el (mailabbrev): Use mh-require instead of require.
mh-line-end-position instead of line-beginning-position and
line-end-position.
- * mh-limit.el (mh-subject-to-sequence-unthreaded): Use
- mh-match-string-no-properties instead of
+ * mh-limit.el (mh-subject-to-sequence-unthreaded):
+ Use mh-match-string-no-properties instead of
match-string-no-properties.
(mh-narrow-to-header-field): Use mh-line-beginning-position and
mh-line-end-position instead of line-beginning-position and
line-end-position.
* mh-mime.el (mh-mime-inline-part, mh-mm-display-part)
- (mh-mh-quote-unescaped-sharp, mh-mh-directive-present-p): Use
- mh-line-beginning-position and mh-line-end-position instead of
+ (mh-mh-quote-unescaped-sharp, mh-mh-directive-present-p):
+ Use mh-line-beginning-position and mh-line-end-position instead of
line-beginning-position and line-end-position.
* mh-search.el (which-func): Use mh-require instead of require.
(mh-mairix-next-result, mh-namazu-next-result)
(mh-pick-next-result, mh-grep-next-result)
(mh-index-create-imenu-index, mh-index-match-checksum)
- (mh-md5sum-parser, mh-openssl-parser, mh-index-update-maps): Use
- mh-line-beginning-position and mh-line-end-position instead of
+ (mh-md5sum-parser, mh-openssl-parser, mh-index-update-maps):
+ Use mh-line-beginning-position and mh-line-end-position instead of
line-beginning-position and line-end-position.
* mh-seq.el (mh-list-sequences): Use mh-view-mode-enter instead of
(mh-speed-flists): Use mh-cancel-timer instead of cancel-timer.
* mh-thread.el (mh-thread-find-children)
- (mh-thread-parse-scan-line, mh-thread-generate): Use
- mh-line-beginning-position and mh-line-end-position instead of
+ (mh-thread-parse-scan-line, mh-thread-generate):
+ Use mh-line-beginning-position and mh-line-end-position instead of
line-beginning-position and line-end-position.
* mh-utils.el (mh-colors-available-p): Use mh-display-color-cells
(mh-letter-header-field-regexp, mh-pgp-support-flag)
(mh-x-mailer-string): Move here from mh-comp.el.
(mh-folder-line-matches-show-buffer-p): Move to mh-alias.el.
- (mh-thread-scan-line-map, mh-thread-scan-line-map-stack): Move
- here from mh-seq.el.
+ (mh-thread-scan-line-map, mh-thread-scan-line-map-stack):
+ Move here from mh-seq.el.
(mh-draft-folder, mh-inbox, mh-user-path, mh-current-folder)
(mh-previous-window-config, mh-seen-list, mh-seq-list)
(mh-show-buffer, mh-showing-mode, mh-globals-hash)
(mh-show-mouse, mh-modify, mh-goto-msg, mh-set-folder-modified-p):
Move to new file mh-folder.el.
(with-mh-folder-updating, mh-in-show-buffer)
- (mh-do-at-event-location, mh-seq-msgs): Moved to mh-acros.el.
+ (mh-do-at-event-location, mh-seq-msgs): Move to mh-acros.el.
(mh-make-seq, mh-seq-name, mh-notate, mh-find-seq)
(mh-seq-to-msgs, mh-add-msgs-to-seq, mh-canonicalize-sequence):
- Moved to mh-seq.el.
+ Move to mh-seq.el.
(mh-show-xface-function, mh-uncompface-executable, mh-face-to-png)
(mh-uncompface, mh-icontopbm, mh-face-foreground-compat)
(mh-face-background-compat, mh-face-display-function)
mh-init.el.
(mh-help-messages): Now an alist of modes to an alist of messages.
(mh-set-help): New function used to set mh-help-messages.
- (mh-help): Adjust for new format of mh-help-messages. Add
- help-messages argument.
+ (mh-help): Adjust for new format of mh-help-messages.
+ Add help-messages argument.
(mh-prefix-help): Refactor to use mh-help.
(mh-coalesce-msg-list, mh-greaterp, mh-lessp): Move here from
mh-e.el.
(mh-search-mode-map): Autoload so that keys are shown in help even
before mh-search is loaded.
(mh-search-mode): Sync docstring with manual.
- (mh-index-do-search): Rename argument indexer to searcher. Sync
- docstring with manual.
+ (mh-index-do-search): Rename argument indexer to searcher.
+ Sync docstring with manual.
(mh-pick-do-search): Sync docstring with manual.
(mh-index-p): Rename to mh-search-p.
(mh-indexer-choices): Rename to mh-search-choices.
2006-01-13 Bill Wohler <wohler@newt.com>
- * mh-acros.el (require): Added Satyaki's comment regarding what
+ * mh-acros.el (require): Add Satyaki's comment regarding what
needs to happen to remove this defadvice which caused a little
discussion on emacs-devel today (see Subject: mh-e/mh-acros.el
advices `require' incorrectly).
* mh-gnus.el: Require mh-acros.
(mh-defmacro-compat, mh-defun-compat): Move to mh-acros.el.
- * mh-utils.el (mh-x-image-url-cache-canonicalize): Use
- url-hexify-string to remove special characters from filenames
+ * mh-utils.el (mh-x-image-url-cache-canonicalize):
+ Use url-hexify-string to remove special characters from filenames
(closes SF #1396499). Note that this invalidates the existing
names in your cache so you might as well remove
~/Mail/.mhe-x-image-cache/* now.
than file-executable-p which returns t for directories.
(mh-file-command-p): Move here from mh-utils, since
mh-variant-*-info are the only functions to use it.
- (mh-variant-set, mh-variant-set-variant, mh-variant-p): Use
- function mh-variants instead of variable. More robust.
+ (mh-variant-set, mh-variant-set-variant, mh-variant-p):
+ Use function mh-variants instead of variable. More robust.
(mh-find-path-run): Move here from mh-utils.el. Mention that
checking this variable is unnecessary.
(mh-find-path): Move here from mh-utils.el. With the advent of MH
variants and an mhparam command that doesn't work if there isn't
- an MH profile, we can't get libdir for running install-mh. So
- don't bother. If there's an issue with the environment, direct the
- user to install MH and run install-mh (closes SF #835192). Don't
- read ~/.mh_profile directly. Use mh-profile-component which uses
+ an MH profile, we can't get libdir for running install-mh.
+ So don't bother. If there's an issue with the environment, direct the
+ user to install MH and run install-mh (closes SF #835192).
+ Don't read ~/.mh_profile directly. Use mh-profile-component which uses
mhparam (closes SF #1016027).
* mh-utils.el (mh-get-profile-field): Rename to
(mh-no-install, mh-install): Delete.
* mh-customize.el (mh-folder-msg-number):
- * mh-mime.el (mh-file-mime-type): Removed trailing whitespace.
+ * mh-mime.el (mh-file-mime-type): Remove trailing whitespace.
2006-01-09 Bill Wohler <wohler@newt.com>
- * mh-init.el (mh-variant-mu-mh-info, mh-variant-nmh-info): Applied
- patch from Satyaki from SF #1016027.
+ * mh-init.el (mh-variant-mu-mh-info, mh-variant-nmh-info):
+ Applied patch from Satyaki from SF #1016027.
* mh-e.el (mh-rescan-folder): Try to keep cursor at current
message, even if cur sequence is no longer present (closes SF
* mh-comp.el: Require cleanup, wrap compiler-shushing defvars with
eval-when-compile.
- (mh-file-is-vcard-p): Removed redundant test.
+ (mh-file-is-vcard-p): Remove redundant test.
* mh-customize.el: Require cleanup, wrap compiler-shushing defvars
with eval-when-compile.
* mh-mime.el: Wrap compiler-shushing defvars with
eval-when-compile.
- (mh-have-file-command): Initialize variable to 'undefined. Add
- docstring. Update function of same name accordingly. Also don't
+ (mh-have-file-command): Initialize variable to 'undefined.
+ Add docstring. Update function of same name accordingly. Also don't
need to load executable any more.
(mh-mime-content-types): Delete.
(mh-minibuffer-read-type): Prompt user for type if
with manual.
(mh-yank-cur-msg): Mention that mh-ins-buf-prefix isn't used if
you have added a mail-citation-hook and neither are used if you
- use one of the supercite flavors of mh-yank-behavior. Sync
- docstrings with manual.
+ use one of the supercite flavors of mh-yank-behavior.
+ Sync docstrings with manual.
- * mh-customize.el (mh-kill-folder-suppress-prompt-hooks): Rename
- from mh-kill-folder-suppress-prompt-hook since it is an abnormal
+ * mh-customize.el (mh-kill-folder-suppress-prompt-hooks):
+ Rename from mh-kill-folder-suppress-prompt-hook since it is an abnormal
hook. Use "Hook run by `function'..." instead of "Invoked...".
Sync docstrings with manual.
(mh-ins-buf-prefix, mh-yank-behavior): Mention that
* mh-customize.el (mh-speed-flists-interval): Rename to
mh-speed-update-interval.
- (mh-speed-run-flists-flag): Delete. Setting
- mh-speed-flists-interval to 0 accomplishes the same thing.
+ (mh-speed-run-flists-flag): Delete.
+ Setting mh-speed-flists-interval to 0 accomplishes the same thing.
- * mh-speed.el (mh-folder-speedbar-buttons, mh-speed-flists): Use
- mh-speed-update-interval instead of mh-speed-run-flists-flag.
- (mh-speed-toggle, mh-speed-view, mh-speed-refresh): Sync
- docstrings with manual.
+ * mh-speed.el (mh-folder-speedbar-buttons, mh-speed-flists):
+ Use mh-speed-update-interval instead of mh-speed-run-flists-flag.
+ (mh-speed-toggle, mh-speed-view, mh-speed-refresh):
+ Sync docstrings with manual.
2005-12-09 Bill Wohler <wohler@newt.com>
(mh-invisible-header-fields-internal): Add X-Bugzilla-* and
X-Virus-Scanned.
- * mh-customize.el (mh-insert-signature-hook): Rename
- mh-letter-insert-signature-hook to mh-insert-signature-hook.
+ * mh-customize.el (mh-insert-signature-hook):
+ Rename mh-letter-insert-signature-hook to mh-insert-signature-hook.
* mh-comp.el (mh-insert-signature): Ditto.
(mh-next-undeleted-msg, mh-previous-undeleted-msg): Rename arg to
count. Sync docstrings with manual.
(mh-refile-or-write-again): Use output from mh-write-msg-to-file
- so that message doesn't change when using this command. Sync
- docstrings with manual.
- (mh-page-msg, mh-previous-page): Rename arg to lines. Sync
- docstrings with manual.
+ so that message doesn't change when using this command.
+ Sync docstrings with manual.
+ (mh-page-msg, mh-previous-page): Rename arg to lines.
+ Sync docstrings with manual.
(mh-write-msg-to-file): Rename msg to message. Rename no-headers
to no-header. Sync docstrings with manual.
(mh-ps-print-map): Delete keybindings for deleted commands
Sync docstrings with manual.
(mh-toggle-mh-decode-mime-flag): Use English in message, not Lisp.
Sync docstrings with manual.
- (mh-mm-display-part, mh-mm-inline-message): Use
- mh-highlight-citation-style instead of mh-highlight-citation-p.
+ (mh-mm-display-part, mh-mm-inline-message):
+ Use mh-highlight-citation-style instead of mh-highlight-citation-p.
(mh-press-button): Sync docstrings with manual.
(mh-display-with-external-viewer): Fix default output in
minibuffer. Sync docstrings with manual.
(mh-smail, mh-extract-rejected-mail, mh-forward, mh-redistribute)
(mh-reply, mh-send, mh-send-other-window)
(mh-fill-paragraph-function): Sync docstrings with manual.
- (mh-edit-again, mh-extract-rejected-mail, mh-redistribute): Rename
- msg argument to message (to make for a better docstring).
+ (mh-edit-again, mh-extract-rejected-mail, mh-redistribute):
+ Rename msg argument to message (to make for a better docstring).
* mh-customize.el (mh-redist-full-contents-flag): Convert defvar
to defcustom. Rename by adding -flag.
* mh-customize.el (mh-compose-space-does-completion-flag)
(mh-signature-separator-flag, mh-interpret-number-as-range-flag)
(mh-adaptive-cmd-note-flag): Use "Non-nil means" instead of "On
- means" to remain checkdoc clean and consistent with Emacs. I
- raised this issue with the Emacs developers and Stallman agrees
+ means" to remain checkdoc clean and consistent with Emacs.
+ I raised this issue with the Emacs developers and Stallman agrees
that "On means" should be allowed in custom docstrings but that
this change requires thought and should wait until after the Emacs
22 release.
* mh-customize.el (mh-interpret-number-as-range-flag): Add * to
docstring.
- (mh-adaptive-cmd-note-flag-check, mh-scan-format-file-check): New
- functions to check input for mh-adaptive-cmd-note-flag and
+ (mh-adaptive-cmd-note-flag-check, mh-scan-format-file-check):
+ New functions to check input for mh-adaptive-cmd-note-flag and
mh-scan-format-file respectively.
(mh-adaptive-cmd-note-flag, mh-scan-format-file): Docstring fixes,
add :set.
- * mh-e.el (mh-scan-field-destination-offset): New variable. The
- destination is the -, t, b, c, or n character for Replied, To, cc,
+ * mh-e.el (mh-scan-field-destination-offset): New variable.
+ The destination is the -, t, b, c, or n character for Replied, To, cc,
Bcc, or Newsgroups respectively.
(mh-make-folder, mh-regenerate-headers, mh-generate-new-cmd-note):
Call new function mh-msg-num-width-to-column to make leap between
2005-10-23 Bill Wohler <wohler@newt.com>
- * mh-comp.el (mh-letter-menu): Rename
- mh-mhn-compose-external-compressed-tar to
- mh-mh-compose-external-compressed-tar. Rename
- mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. Rename
+ * mh-comp.el (mh-letter-menu):
+ Rename mh-mhn-compose-external-compressed-tar to
+ mh-mh-compose-external-compressed-tar.
+ Rename mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. Rename
mh-edit-mhn to mh-mh-to-mime. Rename mh-mhn-directive-present-p to
mh-mh-directive-present-p. Rename mh-revert-mhn-edit to
mh-mh-to-mime-undo. Rename mh-gnus-pgp-support-flag to
mh-mh-directive-present-p.
(mh-send-letter): Rename mh-mhn-directive-present-p to
mh-mh-directive-present-p. Rename mh-edit-mhn to mh-mh-to-mime.
- (mh-letter-mode-map): Rename mh-edit-mhn to mh-mh-to-mime. Rename
- mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp. Rename
- mh-mhn-compose-external-compressed-tar to
+ (mh-letter-mode-map): Rename mh-edit-mhn to mh-mh-to-mime.
+ Rename mh-mhn-compose-anon-ftp to mh-mh-compose-anon-ftp.
+ Rename mh-mhn-compose-external-compressed-tar to
mh-mh-compose-external-compressed-tar. Rename mh-revert-mhn-edit
to mh-mh-to-mime-undo. Rename mh-mhn-compose-external-type to
mh-mh-compose-external-type. Rename mh-mhn-compose-anon-ftp to
- mh-mh-compose-anon-ftp. Rename
- mh-mhn-compose-external-compressed-tar to
+ mh-mh-compose-anon-ftp.
+ Rename mh-mhn-compose-external-compressed-tar to
mh-mh-compose-external-compressed-tar. Rename mh-revert-mhn-edit
to mh-mh-to-mime-undo. Rename mh-mhn-compose-external-type to
mh-mh-compose-external-type.
(mh-send-letter, mh-letter-mode-map): Rename mh-edit-mhn to
mh-mh-to-mime, mh-revert-mhn-edit to mh-mh-to-mime-undo.
- (mh-reply, mh-yank-cur-msg, mh-insert-prefix-string): Rename
- mh-yank-from-start-of-msg to mh-yank-behavior.
+ (mh-reply, mh-yank-cur-msg, mh-insert-prefix-string):
+ Rename mh-yank-from-start-of-msg to mh-yank-behavior.
(mh-letter-mode, mh-to-field, mh-to-fcc, mh-insert-signature)
(mh-check-whom, mh-insert-auto-fields, mh-send-letter)
(mh-insert-letter, mh-yank-cur-msg, mh-insert-prefix-string)
(mh-mhn-compose-anon-ftp): Rename to mh-mh-compose-anon-ftp.
Rename mh-mhn-compose-external-type to mh-mh-compose-external-type.
(mh-mhn-compose-external-compressed-tar): Rename to
- mh-mh-compose-external-compressed-tar. Rename
- mh-mhn-compose-external-type to mh-mh-compose-external-type.
+ mh-mh-compose-external-compressed-tar.
+ Rename mh-mhn-compose-external-type to mh-mh-compose-external-type.
(mh-mhn-compose-external-type): Rename to mh-mh-compose-external-type.
(mh-edit-mhn): Rename to mh-mh-to-mime. Rename mh-mhn-args to
mh-mh-to-mime-args. Rename mh-edit-mhn-hook to mh-mh-to-mime-hook.
(mh-mh-compose-external-type): Rename extra-param argument to
parameters.
(mh-mml-to-mime, mh-secure-message, mh-mml-unsecure-message)
- (mh-mime-display-part, mh-mime-display-single): Rename
- mh-gnus-pgp-support-flag to mh-pgp-support-flag.
+ (mh-mime-display-part, mh-mime-display-single):
+ Rename mh-gnus-pgp-support-flag to mh-pgp-support-flag.
(mh-compose-insertion): Rename mh-mhn-compose-insertion to
mh-mh-attach-file.
(mh-compose-forward): Rename mh-mhn-compose-forw to
* mh-init.el (mh-image-load-path-called-flag): New variable which
is used by mh-image-load-path so that it runs only once.
- (mh-image-load-path): Modify so that it gets run only once. Also
- flatten out heavily nested if statements to make it clearer.
+ (mh-image-load-path): Modify so that it gets run only once.
+ Also flatten out heavily nested if statements to make it clearer.
* mh-e.el (mh-folder-mode): Call mh-image-load-path to allow Emacs
to find images used in the toolbar.
need to be indented.
* mh-e.el: mh-folder-tick-face had been renamed to mh-folder-tick
- but the code that invoked the face had not been updated. Tick
- highlighting working again.
+ but the code that invoked the face had not been updated.
+ Tick highlighting working again.
- * mh-seq.el (mh-non-seq-mode-line-annotation): Move
- make-variable-buffer-local call to top level to avoid warnings in
+ * mh-seq.el (mh-non-seq-mode-line-annotation):
+ Move make-variable-buffer-local call to top level to avoid warnings in
CVS Emacs.
* mh-comp.el (mh-insert-letter): Replace deprecated read-input
* mh-utils.el (mh-find-progs): Run PATH search only when mh-progs,
mh-lib and mh-lib-progs are not all already set. This allows the
user to set them using a simple setq prior to loading mh-e. This
- is useful for implementation of mh-e on win32. Note that many
+ is useful for implementation of mh-e on w32. Note that many
commands still call mh-find-path which also parses the mh_profile
- file (that may still fail on win32), so this is still done often.
+ file (that may still fail on w32), so this is still done often.
But it lets us change the mh_profile file and have mh-e see the
changed file without exiting emacs and starting over so I left
that in.
* mh-utils.el (mh-prompt-for-folder): Exit with error if no folder
specified, otherwise mh-refile-msg may try to create a folder with
- empty name, and this creates problems; even mh-undo can't handle
+ empty name, and this creates problems; even mh-undo can't handle
it (Closes SF #476824).
* mh-comp.el (mh-letter-tool-bar-map): Info button needed to
;; Register mh-folder-mode as supporting which-function-mode...
(mh-require 'which-func nil t)
-(when (boundp 'which-func-modes)
+(when (and (boundp 'which-func-modes) (listp which-func-modes))
(add-to-list 'which-func-modes 'mh-folder-mode))
;; Shush compiler.
;; Shush compiler.
(mh-do-in-xemacs
- (defvar completion-root-regexp)
- (defvar minibuffer-completing-file-name))
+ (defvar completion-root-regexp))
(defun mh-folder-completing-read (prompt default allow-root-folder-flag)
"Read folder name with PROMPT and default result DEFAULT.
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup midnight nil
"Run something every day at midnight."
(defun midnight-find (el ls test &optional key)
"A stopgap solution to the absence of `find' in ELisp."
- (dolist (rr ls)
+ (cl-dolist (rr ls)
(when (funcall test (if key (funcall key rr) rr) el)
- (return rr))))
+ (cl-return rr))))
(defun clean-buffer-list-delay (name)
"Return the delay, in seconds, before killing a buffer named NAME.
(defun midnight-next ()
"Return the number of seconds till the next midnight."
- (multiple-value-bind (sec min hrs)
- (values-list (decode-time))
+ (pcase-let ((`(,sec ,min ,hrs) (decode-time)))
(- (* 24 60 60) (* 60 60 hrs) (* 60 min) sec)))
;;;###autoload
"Modify `midnight-timer' according to `midnight-delay'.
Sets the first argument SYMB (which must be symbol `midnight-delay')
to its second argument TM."
- (assert (eq symb 'midnight-delay) t
- "Invalid argument to `midnight-delay-set': `%s'")
+ (cl-assert (eq symb 'midnight-delay) t
+ "Invalid argument to `midnight-delay-set': `%s'")
(set symb tm)
(when (timerp midnight-timer) (cancel-timer midnight-timer))
(setq midnight-timer
-;;; minibuf-eldef.el --- Only show defaults in prompts when applicable
+;;; minibuf-eldef.el --- Only show defaults in prompts when applicable -*- lexical-binding: t -*-
;;
;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;;
;;; Code:
+(defvar minibuffer-eldef-shorten-default nil
+ "If non-nil, shorten \"(default ...)\" to \"[...]\" in minibuffer prompts.")
+
(defvar minibuffer-default-in-prompt-regexps
- '(("\\( (default\\>.*)\\):? \\'" . 1) ("\\( \\[.*\\]\\):? *\\'" . 1))
- "*A list of regexps matching the parts of minibuffer prompts showing defaults.
+ `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
+ 1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
+ ("\\( \\[.*\\]\\):? *\\'" 1))
+ "A list of regexps matching the parts of minibuffer prompts showing defaults.
When `minibuffer-electric-default-mode' is active, these regexps are
used to identify the portions of prompts to elide.
-Each entry is either a string, which should be a regexp matching the
-default portion of the prompt, or a cons cell, who's car is a regexp
-matching the default part of the prompt, and who's cdr indicates the
-regexp subexpression that matched.")
+Each entry is of the form (REGEXP MATCH-NUM &optional REWRITE),
+where REGEXP should match the default part of the prompt,
+MATCH-NUM is the subgroup that matched the actual default indicator,
+and REWRITE, if present, is a string to pass to `replace-match' that
+should be displayed in its place.")
\f
;;; Internal variables
(inhibit-point-motion-hooks t))
(save-excursion
(save-restriction
- ;; Narrow to only the prompt
+ ;; Narrow to only the prompt.
(goto-char (point-min))
(narrow-to-region (point) (minibuffer-prompt-end))
- ;; See the prompt contains a default input indicator
+ ;; See if the prompt contains a default input indicator.
(while regexps
(setq match (pop regexps))
- (if (re-search-forward (if (stringp match) match (car match)) nil t)
- (setq regexps nil)
- (setq match nil)))))
+ (cond
+ ((not (re-search-forward (if (stringp match) match (car match))
+ nil t))
+ ;; No match yet, try the next rule.
+ (setq match nil))
+ ((and (consp (cdr-safe match)) (nth 2 match))
+ ;; Matched a replacement rule.
+ (let* ((inhibit-read-only t)
+ (buffer-undo-list t)
+ (submatch (nth 1 match))
+ (replacement (nth 2 match))
+ (props (text-properties-at (match-beginning submatch))))
+ (replace-match replacement nil nil nil submatch)
+ (set-text-properties (match-beginning submatch)
+ (match-end submatch)
+ props)
+ ;; Replacement done, now keep trying with subsequent rules.
+ (setq match nil)
+ (goto-char (point-min))))
+ ;; Matched a non-replacement (i.e. electric hide) rule, no need to
+ ;; keep trying.
+ (t (setq regexps nil))))))
(if (not match)
- ;; Nope, so just make sure our post-command-hook isn't left around.
+ ;; No match for electric hiding, so just make sure our
+ ;; post-command-hook isn't left around.
(remove-hook 'post-command-hook #'minibuf-eldef-update-minibuffer t)
;; Yup; set things up so we can frob the prompt as the state of
;; the input string changes.
(setq match (if (consp match) (cdr match) 0))
+ (setq match (if (consp match) (car match) match))
(setq minibuf-eldef-overlay
(make-overlay (match-beginning match) (match-end match)))
(setq minibuf-eldef-showing-default-in-prompt t)
(overlay-put minibuf-eldef-overlay 'intangible t)))))
\f
-;;; Note this definition must be at the end of the file, because
-;;; `define-minor-mode' actually calls the mode-function if the
-;;; associated variable is non-nil, which requires that all needed
-;;; functions be already defined. [This is arguably a bug in d-m-m]
;;;###autoload
(define-minor-mode minibuffer-electric-default-mode
"Toggle Minibuffer Electric Default mode.
;; corresponding to the displayed completions because we only
;; provide the start info but not the end info in
;; completion-base-position.
-;; - quoting is problematic. E.g. the double-dollar quoting used in
-;; substitute-in-file-name (and hence read-file-name-internal) bumps
-;; into various bugs:
-;; - choose-completion doesn't know how to quote the text it inserts.
-;; E.g. it fails to double the dollars in file-name completion, or
-;; to backslash-escape spaces and other chars in comint completion.
-;; - when completing ~/tmp/fo$$o, the highlighting in *Completions*
-;; is off by one position.
-;; - all code like PCM which relies on all-completions to match
-;; its argument gets confused because all-completions returns unquoted
-;; texts (as desired for *Completions* output).
;; - C-x C-f ~/*/sr ? should not list "~/./src".
;; - minibuffer-force-complete completes ~/src/emacs/t<!>/lisp/minibuffer.el
;; to ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
;; - Make things like icomplete-mode or lightning-completion work with
;; completion-in-region-mode.
;; - extend `metadata':
-;; - quoting/unquoting (so we can complete files names with envvars
-;; and backslashes, and all-completion can list names without
-;; quoting backslashes and dollars).
;; - indicate how to turn all-completion's output into
;; try-completion's output: e.g. completion-ignored-extensions.
-;; maybe that could be merged with the "quote" operation above.
+;; maybe that could be merged with the "quote" operation.
;; - indicate that `all-completions' doesn't do prefix-completion
;; but just returns some list that relates in some other way to
;; the provided string (as is the case in filecache.el), in which
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Completion table manipulation
`(completion-table-dynamic
(lambda (,str)
(when (functionp ,var)
- (setq ,var (,fun)))
+ (setq ,var (funcall #',fun)))
,var))))
(defun completion-table-case-fold (table &optional dont-fold)
(let ((completion-ignore-case (not dont-fold)))
(complete-with-action action table string pred))))
+(defun completion-table-subvert (table s1 s2)
+ "Return a completion table from TABLE with S1 replaced by S2.
+The result is a completion table which completes strings of the
+form (concat S1 S) in the same way as TABLE completes strings of
+the form (concat S2 S)."
+ (lambda (string pred action)
+ (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
+ completion-ignore-case))
+ (concat s2 (substring string (length s1)))))
+ (res (if str (complete-with-action action table str pred))))
+ (when res
+ (cond
+ ((eq (car-safe action) 'boundaries)
+ (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
+ `(boundaries
+ ,(max (length s1)
+ (+ beg (- (length s1) (length s2))))
+ . ,(and (eq (car-safe res) 'boundaries) (cddr res)))))
+ ((stringp res)
+ (if (eq t (compare-strings res 0 (length s2) s2 nil nil
+ completion-ignore-case))
+ (concat s1 (substring res (length s2)))))
+ ((eq action t)
+ (let ((bounds (completion-boundaries str table pred "")))
+ (if (>= (car bounds) (length s2))
+ res
+ (let ((re (concat "\\`"
+ (regexp-quote (substring s2 (car bounds))))))
+ (delq nil
+ (mapcar (lambda (c)
+ (if (string-match re c)
+ (substring c (match-end 0))))
+ res))))))
+ ;; E.g. action=nil and it's the only completion.
+ (res))))))
+
(defun completion-table-with-context (prefix table string pred action)
;; TODO: add `suffix' maybe?
(let ((pred
(if (eq (car-safe action) 'boundaries)
(let* ((len (length prefix))
(bound (completion-boundaries string table pred (cdr action))))
- (list* 'boundaries (+ (car bound) len) (cdr bound)))
+ `(boundaries ,(+ (car bound) len) . ,(cdr bound)))
(let ((comp (complete-with-action action table string pred)))
(cond
;; In case of try-completion, add the prefix.
(cdr terminator) (regexp-quote terminator)))
(max (and terminator-regexp
(string-match terminator-regexp suffix))))
- (list* 'boundaries (car bounds)
- (min (cdr bounds) (or max (length suffix))))))
+ `(boundaries ,(car bounds)
+ . ,(min (cdr bounds) (or max (length suffix))))))
((eq action nil)
(let ((comp (try-completion string table pred)))
(if (consp terminator) (setq terminator (car terminator)))
(complete-with-action action table string pred))
tables)))
+(defun completion-table-with-quoting (table unquote requote)
+ ;; A difficult part of completion-with-quoting is to map positions in the
+ ;; quoted string to equivalent positions in the unquoted string and
+ ;; vice-versa. There is no efficient and reliable algorithm that works for
+ ;; arbitrary quote and unquote functions.
+ ;; So to map from quoted positions to unquoted positions, we simply assume
+ ;; that `concat' and `unquote' commute (which tends to be the case).
+ ;; And we ask `requote' to do the work of mapping from unquoted positions
+ ;; back to quoted positions.
+ "Return a new completion table operating on quoted text.
+TABLE operates on the unquoted text.
+UNQUOTE is a function that takes a string and returns a new unquoted string.
+REQUOTE is a function of 2 args (UPOS QSTR) where
+ QSTR is a string entered by the user (and hence indicating
+ the user's preferred form of quoting); and
+ UPOS is a position within the unquoted form of QSTR.
+REQUOTE should return a pair (QPOS . QFUN) such that QPOS is the
+position corresponding to UPOS but in QSTR, and QFUN is a function
+of one argument (a string) which returns that argument appropriately quoted
+for use at QPOS."
+ ;; FIXME: One problem with the current setup is that `qfun' doesn't know if
+ ;; its argument is "the end of the completion", so if the quoting used double
+ ;; quotes (for example), we end up completing "fo" to "foobar and throwing
+ ;; away the closing double quote.
+ (lambda (string pred action)
+ (cond
+ ((eq action 'metadata)
+ (append (completion-metadata string table pred)
+ '((completion--unquote-requote . t))))
+
+ ((eq action 'lambda) ;;test-completion
+ (let ((ustring (funcall unquote string)))
+ (test-completion ustring table pred)))
+
+ ((eq (car-safe action) 'boundaries)
+ (let* ((ustring (funcall unquote string))
+ (qsuffix (cdr action))
+ (ufull (if (zerop (length qsuffix)) ustring
+ (funcall unquote (concat string qsuffix))))
+ (_ (cl-assert (string-prefix-p ustring ufull)))
+ (usuffix (substring ufull (length ustring)))
+ (boundaries (completion-boundaries ustring table pred usuffix))
+ (qlboundary (car (funcall requote (car boundaries) string)))
+ (qrboundary (if (zerop (cdr boundaries)) 0 ;Common case.
+ (let* ((urfullboundary
+ (+ (cdr boundaries) (length ustring))))
+ (- (car (funcall requote urfullboundary
+ (concat string qsuffix)))
+ (length string))))))
+ `(boundaries ,qlboundary . ,qrboundary)))
+
+ ;; In "normal" use a c-t-with-quoting completion table should never be
+ ;; called with action in (t nil) because `completion--unquote' should have
+ ;; been called before and would have returned a different completion table
+ ;; to apply to the unquoted text. But there's still a lot of code around
+ ;; that likes to use all/try-completions directly, so we do our best to
+ ;; handle those calls as well as we can.
+
+ ((eq action nil) ;;try-completion
+ (let* ((ustring (funcall unquote string))
+ (completion (try-completion ustring table pred)))
+ ;; Most forms of quoting allow several ways to quote the same string.
+ ;; So here we could simply requote `completion' in a kind of
+ ;; "canonical" quoted form without paying attention to the way
+ ;; `string' was quoted. But since we have to solve the more complex
+ ;; problems of "pay attention to the original quoting" for
+ ;; all-completions, we may as well use it here, since it provides
+ ;; a nicer behavior.
+ (if (not (stringp completion)) completion
+ (car (completion--twq-try
+ string ustring completion 0 unquote requote)))))
+
+ ((eq action t) ;;all-completions
+ ;; When all-completions is used for completion-try/all-completions
+ ;; (e.g. for `pcm' style), we can't do the job properly here because
+ ;; the caller will match our output against some pattern derived from
+ ;; the user's (quoted) input, and we don't have access to that
+ ;; pattern, so we can't know how to requote our output so that it
+ ;; matches the quoting used in the pattern. It is to fix this
+ ;; fundamental problem that we have to introduce the new
+ ;; unquote-requote method so that completion-try/all-completions can
+ ;; pass the unquoted string to the style functions.
+ (pcase-let*
+ ((ustring (funcall unquote string))
+ (completions (all-completions ustring table pred))
+ (boundary (car (completion-boundaries ustring table pred "")))
+ (completions
+ (completion--twq-all
+ string ustring completions boundary unquote requote))
+ (last (last completions)))
+ (when (consp last) (setcdr last nil))
+ completions))
+
+ ((eq action 'completion--unquote)
+ (let ((ustring (funcall unquote string))
+ (uprefix (funcall unquote (substring string 0 pred))))
+ ;; We presume (more or less) that `concat' and `unquote' commute.
+ (cl-assert (string-prefix-p uprefix ustring))
+ (list ustring table (length uprefix)
+ (lambda (unquoted-result op)
+ (pcase op
+ (1 ;;try
+ (if (not (stringp (car-safe unquoted-result)))
+ unquoted-result
+ (completion--twq-try
+ string ustring
+ (car unquoted-result) (cdr unquoted-result)
+ unquote requote)))
+ (2 ;;all
+ (let* ((last (last unquoted-result))
+ (base (or (cdr last) 0)))
+ (when last
+ (setcdr last nil)
+ (completion--twq-all string ustring
+ unquoted-result base
+ unquote requote))))))))))))
+
+(defun completion--twq-try (string ustring completion point
+ unquote requote)
+ ;; Basically two cases: either the new result is
+ ;; - commonprefix1 <point> morecommonprefix <qpos> suffix
+ ;; - commonprefix <qpos> newprefix <point> suffix
+ (pcase-let*
+ ((prefix (fill-common-string-prefix ustring completion))
+ (suffix (substring completion (max point (length prefix))))
+ (`(,qpos . ,qfun) (funcall requote (length prefix) string))
+ (qstr1 (if (> point (length prefix))
+ (funcall qfun (substring completion (length prefix) point))))
+ (qsuffix (funcall qfun suffix))
+ (qstring (concat (substring string 0 qpos) qstr1 qsuffix))
+ (qpoint
+ (cond
+ ((zerop point) 0)
+ ((> point (length prefix)) (+ qpos (length qstr1)))
+ (t (car (funcall requote point string))))))
+ ;; Make sure `requote' worked.
+ (if (equal (funcall unquote qstring) completion)
+ (cons qstring qpoint)
+ ;; If requote failed (e.g. because sifn-requote did not handle
+ ;; Tramp's "/foo:/bar//baz -> /foo:/baz" truncation), then at least
+ ;; try requote properly.
+ (let ((qstr (funcall qfun completion)))
+ (cons qstr (length qstr))))))
+
+(defun completion--string-equal-p (s1 s2)
+ (eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case)))
+
+(defun completion--twq-all (string ustring completions boundary
+ unquote requote)
+ (when completions
+ (pcase-let*
+ ((prefix
+ (let ((completion-regexp-list nil))
+ (try-completion "" (cons (substring ustring boundary)
+ completions))))
+ (`(,qfullpos . ,qfun)
+ (funcall requote (+ boundary (length prefix)) string))
+ (qfullprefix (substring string 0 qfullpos))
+ (_ (cl-assert (completion--string-equal-p
+ (funcall unquote qfullprefix)
+ (concat (substring ustring 0 boundary) prefix))
+ t))
+ (qboundary (car (funcall requote boundary string)))
+ (_ (cl-assert (<= qboundary qfullpos)))
+ ;; FIXME: this split/quote/concat business messes up the carefully
+ ;; placed completions-common-part and completions-first-difference
+ ;; faces. We could try within the mapcar loop to search for the
+ ;; boundaries of those faces, pass them to `requote' to find their
+ ;; equivalent positions in the quoted output and re-add the faces:
+ ;; this might actually lead to correct results but would be
+ ;; pretty expensive.
+ ;; The better solution is to not quote the *Completions* display,
+ ;; which nicely circumvents the problem. The solution I used here
+ ;; instead is to hope that `qfun' preserves the text-properties and
+ ;; presume that the `first-difference' is not within the `prefix';
+ ;; this presumption is not always true, but at least in practice it is
+ ;; true in most cases.
+ (qprefix (propertize (substring qfullprefix qboundary)
+ 'face 'completions-common-part)))
+
+ ;; Here we choose to quote all elements returned, but a better option
+ ;; would be to return unquoted elements together with a function to
+ ;; requote them, so that *Completions* can show nicer unquoted values
+ ;; which only get quoted when needed by choose-completion.
+ (nconc
+ (mapcar (lambda (completion)
+ (cl-assert (string-prefix-p prefix completion 'ignore-case) t)
+ (let* ((new (substring completion (length prefix)))
+ (qnew (funcall qfun new))
+ (qcompletion (concat qprefix qnew)))
+ (cl-assert
+ (completion--string-equal-p
+ (funcall unquote
+ (concat (substring string 0 qboundary)
+ qcompletion))
+ (concat (substring ustring 0 boundary)
+ completion))
+ t)
+ qcompletion))
+ completions)
+ qboundary))))
+
;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b))
;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun))
(define-obsolete-function-alias
(delete-dups (append (cdr over) (copy-sequence completion-styles)))
completion-styles)))
+(defun completion--nth-completion (n string table pred point metadata)
+ "Call the Nth method of completion styles."
+ (unless metadata
+ (setq metadata
+ (completion-metadata (substring string 0 point) table pred)))
+ ;; We provide special support for quoting/unquoting here because it cannot
+ ;; reliably be done within the normal completion-table routines: Completion
+ ;; styles such as `substring' or `partial-completion' need to match the
+ ;; output of all-completions with the user's input, and since most/all
+ ;; quoting mechanisms allow several equivalent quoted forms, the
+ ;; completion-style can't do this matching (e.g. `substring' doesn't know
+ ;; that "\a\b\e" is a valid (quoted) substring of "label").
+ ;; The quote/unquote function needs to come from the completion table (rather
+ ;; than from completion-extra-properties) because it may apply only to some
+ ;; part of the string (e.g. substitute-in-file-name).
+ (let ((requote
+ (when (completion-metadata-get metadata 'completion--unquote-requote)
+ (let ((new (funcall table string point 'completion--unquote)))
+ (setq string (pop new))
+ (setq table (pop new))
+ (setq point (pop new))
+ (pop new))))
+ (result
+ (completion--some (lambda (style)
+ (funcall (nth n (assq style
+ completion-styles-alist))
+ string table pred point))
+ (completion--styles metadata))))
+ (if requote
+ (funcall requote result n)
+ result)))
+
(defun completion-try-completion (string table pred point &optional metadata)
"Try to complete STRING using completion table TABLE.
Only the elements of table that satisfy predicate PRED are considered.
POINT is the position of point within STRING.
The return value can be either nil to indicate that there is no completion,
t to indicate that STRING is the only possible completion,
-or a pair (STRING . NEWPOINT) of the completed result string together with
+or a pair (NEWSTRING . NEWPOINT) of the completed result string together with
a new position for point."
- (completion--some (lambda (style)
- (funcall (nth 1 (assq style completion-styles-alist))
- string table pred point))
- (completion--styles (or metadata
- (completion-metadata
- (substring string 0 point)
- table pred)))))
+ (completion--nth-completion 1 string table pred point metadata))
(defun completion-all-completions (string table pred point &optional metadata)
"List the possible completions of STRING in completion table TABLE.
in the last `cdr'."
;; FIXME: We need to additionally return the info needed for the
;; second part of completion-base-position.
- (completion--some (lambda (style)
- (funcall (nth 2 (assq style completion-styles-alist))
- string table pred point))
- (completion--styles (or metadata
- (completion-metadata
- (substring string 0 point)
- table pred)))))
+ (completion--nth-completion 2 string table pred point metadata))
(defun minibuffer--bitset (modified completions exact)
(logior (if modified 4 0)
'exact 'unknown))))
;; Show the completion table, if requested.
((not exact)
- (if (case completion-auto-help
- (lazy (eq this-command last-command))
- (t completion-auto-help))
+ (if (pcase completion-auto-help
+ (`lazy (eq this-command last-command))
+ (_ completion-auto-help))
(minibuffer-completion-help)
(completion--message "Next char not unique")))
;; If the last exact completion and this one were the same, it
((and completion-cycling completion-all-sorted-completions)
(minibuffer-force-complete)
t)
- (t (case (completion--do-completion)
+ (t (pcase (completion--do-completion)
(#b000 nil)
- (t t)))))
+ (_ t)))))
(defun completion--cache-all-sorted-completions (comps)
(add-hook 'after-change-functions
(t
;; Call do-completion, but ignore errors.
- (case (condition-case nil
+ (pcase (condition-case nil
(completion--do-completion nil 'expect-exact)
(error 1))
- ((#b001 #b011) (exit-minibuffer))
+ ((or #b001 #b011) (exit-minibuffer))
(#b111 (if (not minibuffer-completion-confirm)
(exit-minibuffer)
(minibuffer-message "Confirm")
nil))
- (t nil))))))
+ (_ nil))))))
(defun completion--try-word-completion (string table predicate point md)
(let ((comp (completion-try-completion string table predicate point md)))
is added, provided that matches some possible completion.
Return nil if there is no valid completion, else t."
(interactive)
- (case (completion--do-completion 'completion--try-word-completion)
+ (pcase (completion--do-completion 'completion--try-word-completion)
(#b000 nil)
- (t t)))
+ (_ t)))
(defface completions-annotations '((t :inherit italic))
"Face to use for annotations in the *Completions* buffer.")
(defun completion--done (string &optional finished message)
(let* ((exit-fun (plist-get completion-extra-properties :exit-function))
(pre-msg (and exit-fun (current-message))))
- (assert (memq finished '(exact sole finished unknown)))
+ (cl-assert (memq finished '(exact sole finished unknown)))
;; FIXME: exit-fun should receive `finished' as a parameter.
(when exit-fun
(when (eq finished 'unknown)
Point needs to be somewhere between START and END.
PREDICATE (a function called with no arguments) says when to
exit."
- (assert (<= start (point)) (<= (point) end))
+ (cl-assert (<= start (point)) (<= (point) end))
(with-wrapper-hook
;; FIXME: Maybe we should use this hook to provide a "display
;; completions" operation as well.
(unless (equal "*Completions*" (buffer-name (window-buffer)))
(minibuffer-hide-completions))
;; (add-hook 'pre-command-hook #'completion-in-region--prech)
- (assert completion-in-region-mode-predicate)
+ (cl-assert completion-in-region-mode-predicate)
(setq completion-in-region-mode--predicate
completion-in-region-mode-predicate)
(add-hook 'post-command-hook #'completion-in-region--postch)
`:predicate' a predicate that completion candidates need to satisfy.
`:exclusive' If `no', means that if the completion table fails to
match the text at point, then instead of reporting a completion
- failure, the completion should try the next completion function.")
+ failure, the completion should try the next completion function.
+As is the case with most hooks, the functions are responsible to preserve
+things like point and current buffer.")
(defvar completion--capf-misbehave-funs nil
"List of functions found on `completion-at-point-functions' that misbehave.
;; always return the same kind of data, but this breaks down with functions
;; like comint-completion-at-point or mh-letter-completion-at-point, which
;; could be sometimes safe and sometimes misbehaving (and sometimes neither).
- (if (case which
- (all t)
- (safe (member fun completion--capf-safe-funs))
- (optimist (not (member fun completion--capf-misbehave-funs))))
+ (if (pcase which
+ (`all t)
+ (`safe (member fun completion--capf-safe-funs))
+ (`optimist (not (member fun completion--capf-misbehave-funs))))
(let ((res (funcall fun)))
(cond
((and (consp res) (not (functionp res)))
Gets combined either with `minibuffer-local-completion-map' or
with `minibuffer-local-must-match-map'.")
-(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
-(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
'minibuffer-local-filename-must-match-map "23.1")
+(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
+(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
(let ((map minibuffer-local-ns-map))
(define-key map " " 'exit-minibuffer)
;;; Completion tables.
(defun minibuffer--double-dollars (str)
- (replace-regexp-in-string "\\$" "$$" str))
+ ;; Reuse the actual "$" from the string to preserve any text-property it
+ ;; might have, such as `face'.
+ (replace-regexp-in-string "\\$" (lambda (dollar) (concat dollar dollar))
+ str))
(defun completion--make-envvar-table ()
(mapcar (lambda (enventry)
(if (eq action 'metadata)
'(metadata (category . environment-variable))
(let ((suffix (cdr action)))
- (list* 'boundaries
- (or (match-beginning 2) (match-beginning 1))
- (when (string-match "[^[:alnum:]_]" suffix)
- (match-beginning 0)))))))
+ `(boundaries
+ ,(or (match-beginning 2) (match-beginning 1))
+ . ,(when (string-match "[^[:alnum:]_]" suffix)
+ (match-beginning 0)))))))
(t
(if (eq (aref string (1- beg)) ?{)
(setq table (apply-partially 'completion-table-with-terminator
(condition-case nil
(cond
((eq action 'metadata) '(metadata (category . file)))
+ ((string-match-p "\\`~[^/\\]*\\'" string)
+ (completion-table-with-context "~"
+ (mapcar (lambda (u) (concat u "/"))
+ (system-users))
+ (substring string 1)
+ pred action))
((eq (car-safe action) 'boundaries)
(let ((start (length (file-name-directory string)))
(end (string-match-p "/" (cdr action))))
- (list* 'boundaries
- ;; if `string' is "C:" in w32, (file-name-directory string)
- ;; returns "C:/", so `start' is 3 rather than 2.
- ;; Not quite sure what is The Right Fix, but clipping it
- ;; back to 2 will work for this particular case. We'll
- ;; see if we can come up with a better fix when we bump
- ;; into more such problematic cases.
- (min start (length string)) end)))
+ `(boundaries
+ ;; if `string' is "C:" in w32, (file-name-directory string)
+ ;; returns "C:/", so `start' is 3 rather than 2.
+ ;; Not quite sure what is The Right Fix, but clipping it
+ ;; back to 2 will work for this particular case. We'll
+ ;; see if we can come up with a better fix when we bump
+ ;; into more such problematic cases.
+ ,(min start (length string)) . ,end)))
((eq action 'lambda)
(if (zerop (length string))
(make-obsolete-variable 'read-file-name-predicate
"use the regular PRED argument" "23.2")
-(defun completion--file-name-table (string pred action)
+(defun completion--sifn-requote (upos qstr)
+ ;; We're looking for `qupos' such that:
+ ;; (equal (substring (substitute-in-file-name qstr) 0 upos)
+ ;; (substitute-in-file-name (substring qstr 0 qupos)))
+ ;; Big problem here: we have to reverse engineer substitute-in-file-name to
+ ;; find the position corresponding to UPOS in QSTR, but
+ ;; substitute-in-file-name can do anything, depending on file-name-handlers.
+ ;; Kind of like in rfn-eshadow-update-overlay, only worse.
+ ;; FIXME: example of thing we do not handle: Tramp's makes
+ ;; (substitute-in-file-name "/foo:~/bar//baz") -> "/scpc:foo:/baz".
+ ;; FIXME: One way to try and handle "all" cases is to require
+ ;; substitute-in-file-name to preserve text-properties, so we could
+ ;; apply text-properties to the input string and then look for them in
+ ;; the output to understand what comes from where.
+ (let ((qpos 0))
+ ;; Handle substitute-in-file-name's truncation behavior.
+ (let (tpos)
+ (while (and (string-match "[\\/][~/\\]" qstr qpos)
+ ;; Hopefully our regexp covers all truncation cases.
+ ;; Also let's make sure sifn indeed truncates here.
+ (progn
+ (setq tpos (1+ (match-beginning 0)))
+ (equal (substitute-in-file-name qstr)
+ (substitute-in-file-name (substring qstr tpos)))))
+ (setq qpos tpos)))
+ ;; `upos' is relative to the position corresponding to `qpos' in
+ ;; (substitute-in-file-name qstr), so as qpos moves forward, upos
+ ;; gets smaller.
+ (while (and (> upos 0)
+ (string-match "\\$\\(\\$\\|\\([[:alnum:]_]+\\|{[^}]*}\\)\\)?"
+ qstr qpos))
+ (cond
+ ((>= (- (match-beginning 0) qpos) upos) ; UPOS is before current match.
+ (setq qpos (+ qpos upos))
+ (setq upos 0))
+ ((not (match-end 1)) ;A sole $: probably an error.
+ (setq upos (- upos (- (match-end 0) qpos)))
+ (setq qpos (match-end 0)))
+ (t
+ (setq upos (- upos (- (match-beginning 0) qpos)))
+ (setq qpos (match-end 0))
+ (setq upos (- upos (length (substitute-in-file-name
+ (match-string 0 qstr))))))))
+ ;; If `upos' is negative, it's because it's within the expansion of an
+ ;; envvar, i.e. there is no exactly matching qpos, so we just use the next
+ ;; available qpos right after the envvar.
+ (cons (if (>= upos 0) (+ qpos upos) qpos)
+ #'minibuffer--double-dollars)))
+
+(defalias 'completion--file-name-table
+ (completion-table-with-quoting #'completion-file-name-table
+ #'substitute-in-file-name
+ #'completion--sifn-requote)
"Internal subroutine for `read-file-name'. Do not call this.
This is a completion table for file names, like `completion-file-name-table'
-except that it passes the file name through `substitute-in-file-name'."
- (cond
- ((eq (car-safe action) 'boundaries)
- ;; For the boundaries, we can't really delegate to
- ;; substitute-in-file-name+completion-file-name-table and then fix
- ;; them up (as we do for the other actions), because it would
- ;; require us to track the relationship between `str' and
- ;; `string', which is difficult. And in any case, if
- ;; substitute-in-file-name turns "fo-$TO-ba" into "fo-o/b-ba",
- ;; there's no way for us to return proper boundaries info, because
- ;; the boundary is not (yet) in `string'.
- ;;
- ;; FIXME: Actually there is a way to return correct boundaries
- ;; info, at the condition of modifying the all-completions
- ;; return accordingly. But for now, let's not bother.
- (completion-file-name-table string pred action))
-
- (t
- (let* ((default-directory
- (if (stringp pred)
- ;; It used to be that `pred' was abused to pass `dir'
- ;; as an argument.
- (prog1 (file-name-as-directory (expand-file-name pred))
- (setq pred nil))
- default-directory))
- (str (condition-case nil
- (substitute-in-file-name string)
- (error string)))
- (comp (completion-file-name-table
- str
- (with-no-warnings (or pred read-file-name-predicate))
- action)))
-
- (cond
- ((stringp comp)
- ;; Requote the $s before returning the completion.
- (minibuffer--double-dollars comp))
- ((and (null action) comp
- ;; Requote the $s before checking for changes.
- (setq str (minibuffer--double-dollars str))
- (not (string-equal string str)))
- ;; If there's no real completion, but substitute-in-file-name
- ;; changed the string, then return the new string.
- str)
- (t comp))))))
+except that it passes the file name through `substitute-in-file-name'.")
(defalias 'read-file-name-internal
- (completion-table-in-turn 'completion--embedded-envvar-table
- 'completion--file-name-table)
+ (completion-table-in-turn #'completion--embedded-envvar-table
+ #'completion--file-name-table)
"Internal subroutine for `read-file-name'. Do not call this.")
(defvar read-file-name-function 'read-file-name-default
(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.
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
(funcall (or read-file-name-function #'read-file-name-default)
prompt dir default-filename mustmatch initial predicate))
+(defvar minibuffer-local-filename-syntax
+ (let ((table (make-syntax-table))
+ (punctuation (car (string-to-syntax "."))))
+ ;; Convert all punctuation entries to symbol.
+ (map-char-table (lambda (c syntax)
+ (when (eq (car syntax) punctuation)
+ (modify-syntax-entry c "_" table)))
+ table)
+ (mapc
+ (lambda (c)
+ (modify-syntax-entry c "." table))
+ '(?/ ?: ?\\))
+ table)
+ "Syntax table to be used in minibuffer for reading file name.")
+
;; minibuffer-completing-file-name is a variable used internally in minibuf.c
;; to determine whether to use minibuffer-local-filename-completion-map or
;; minibuffer-local-completion-map. It shouldn't be exported to Elisp.
;; use (eq minibuffer-completion-table #'read-file-name-internal), which is
;; probably even worse. Maybe We should add some read-file-name-setup-hook
;; instead, but for now, let's keep this non-obsolete.
-;;(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1" 'get)
+;;(make-obsolete-variable 'minibuffer-completing-file-name nil "future" 'get)
(defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate)
"Default method for reading file names.
(lambda ()
(with-current-buffer
(window-buffer (minibuffer-selected-window))
- (read-file-name--defaults dir initial)))))
+ (read-file-name--defaults dir initial))))
+ (set-syntax-table minibuffer-local-filename-syntax))
(completing-read prompt 'read-file-name-internal
pred mustmatch insdef
'file-name-history default-filename)))
(setq p0 (1+ p)))
(push 'any pattern)
(setq p0 p))
- (incf p))
+ (cl-incf p))
;; An empty string might be erroneously added at the beginning.
;; It should be avoided properly, but it's so easy to remove it here.
(defun completion-pcm--all-completions (prefix pattern table pred)
"Find all completions for PATTERN in TABLE obeying PRED.
PATTERN is as returned by `completion-pcm--string->pattern'."
- ;; (assert (= (car (completion-boundaries prefix table pred ""))
+ ;; (cl-assert (= (car (completion-boundaries prefix table pred ""))
;; (length prefix)))
;; Find an initial list of possible completions.
(if (completion-pcm--pattern-trivial-p pattern)
;; The prefix has no completions at all, so we should try and fix
;; that first.
(let ((substring (substring prefix 0 -1)))
- (destructuring-bind (subpat suball subprefix _subsuffix)
- (completion-pcm--find-all-completions
- substring table pred (length substring) filter)
+ (pcase-let ((`(,subpat ,suball ,subprefix ,_subsuffix)
+ (completion-pcm--find-all-completions
+ substring table pred (length substring) filter)))
(let ((sep (aref prefix (1- (length prefix))))
;; Text that goes between the new submatches and the
;; completion substring.
(list pattern all prefix suffix)))))
(defun completion-pcm-all-completions (string table pred point)
- (destructuring-bind (pattern all &optional prefix _suffix)
- (completion-pcm--find-all-completions string table pred point)
+ (pcase-let ((`(,pattern ,all ,prefix ,_suffix)
+ (completion-pcm--find-all-completions string table pred point)))
(when all
(nconc (completion-pcm--hilit-commonality pattern all)
(length prefix)))))
(defun completion--sreverse (str)
"Like `reverse' but for a string STR rather than a list."
- (apply 'string (nreverse (mapcar 'identity str))))
+ (apply #'string (nreverse (mapcar 'identity str))))
(defun completion--common-suffix (strs)
"Return the common suffix of the strings STRS."
(completion--sreverse
(try-completion
""
- (mapcar 'completion--sreverse strs))))
+ (mapcar #'completion--sreverse strs))))
(defun completion-pcm--merge-completions (strs pattern)
"Extract the commonality in STRS, with the help of PATTERN.
;; `any' it could lead to a merged completion that
;; doesn't itself match the candidates.
(let ((suffix (completion--common-suffix comps)))
- (assert (stringp suffix))
+ (cl-assert (stringp suffix))
(unless (equal suffix "")
(push suffix res)))))
(setq fixed "")))))
(cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
(defun completion-pcm-try-completion (string table pred point)
- (destructuring-bind (pattern all prefix suffix)
- (completion-pcm--find-all-completions
- string table pred point
- (if minibuffer-completing-file-name
- 'completion-pcm--filename-try-filter))
+ (pcase-let ((`(,pattern ,all ,prefix ,suffix)
+ (completion-pcm--find-all-completions
+ string table pred point
+ (if minibuffer-completing-file-name
+ 'completion-pcm--filename-try-filter))))
(completion-pcm--merge-try pattern all prefix suffix)))
;;; Substring completion
(list all pattern prefix suffix (car bounds))))
(defun completion-substring-try-completion (string table pred point)
- (destructuring-bind (all pattern prefix suffix _carbounds)
- (completion-substring--all-completions string table pred point)
+ (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
+ (completion-substring--all-completions
+ string table pred point)))
(if minibuffer-completing-file-name
(setq all (completion-pcm--filename-try-filter all)))
(completion-pcm--merge-try pattern all prefix suffix)))
(defun completion-substring-all-completions (string table pred point)
- (destructuring-bind (all pattern prefix _suffix _carbounds)
- (completion-substring--all-completions string table pred point)
+ (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
+ (completion-substring--all-completions
+ string table pred point)))
(when all
(nconc (completion-pcm--hilit-commonality pattern all)
(length prefix)))))
(defun forward-to-word (arg)
"Move forward until encountering the beginning of a word.
With argument, do this that many times."
- (interactive "p")
+ (interactive "^p")
(or (re-search-forward (if (> arg 0) "\\W\\b" "\\b\\W") nil t arg)
(goto-char (if (> arg 0) (point-max) (point-min)))))
(defun backward-to-word (arg)
"Move backward until encountering the end of a word.
With argument, do this that many times."
- (interactive "p")
+ (interactive "^p")
(forward-to-word (- arg)))
;;;###autoload
(defvar list-dynamic-libraries--loaded-only-p)
(make-variable-buffer-local 'list-dynamic-libraries--loaded-only-p)
+(defun list-dynamic-libraries--loaded (from)
+ "Compute the \"Loaded from\" column.
+Internal use only."
+ (if from
+ (let ((name (car from))
+ (path (or (cdr from) "<unknown>")))
+ ;; This is a roundabout way to change the tooltip without
+ ;; having to replace the default printer function
+ (propertize name
+ 'display (propertize name
+ 'help-echo (concat "Loaded from: " path))))
+ ""))
+
(defun list-dynamic-libraries--refresh ()
"Recompute the list of dynamic libraries.
Internal use only."
(when (or from
(not list-dynamic-libraries--loaded-only-p))
(push (list id (vector (symbol-name id)
- (or from "")
+ (list-dynamic-libraries--loaded from)
(mapconcat 'identity (cdr lib) ", ")))
tabulated-list-entries)))))
(lambda (string bound noerror)
(let ((search-fun
;; Use standard functions to search within one buffer
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
+ (isearch-search-fun-default))
found buffer)
(or
;; 1. First try searching in the initial buffer
;; If you like mouse-copy, you should also check out mouse-drag
;; for ``one-click scrolling''.
;;
-;; To use mouse-copy, place the following in your .emacs file:
+;; To use mouse-copy, place the following in your init file:
;; (require 'mouse-copy)
;; (global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting)
;; (global-set-key [M-S-down-mouse-1] 'mouse-drag-secondary-moving)
;; If you like mouse-drag, you should also check out mouse-copy
;; for ``one-click text copy and move''.
;;
-;; To use mouse-drag, place the following in your .emacs file:
+;; To use mouse-drag, place the following in your init file:
;; -either-
;; (global-set-key [down-mouse-2] 'mouse-drag-throw)
;; -or-
nil))))))
(defvar mouse-throw-with-scroll-bar nil
- "*Set direction of mouse-throwing.
+ "Set direction of mouse-throwing.
If nil, the text moves in the direction the mouse moves.
If t, the scroll bar moves in the direction the mouse moves.")
(defconst mouse-throw-magnifier-min -6)
-;;; 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.
+;; Copyright (C) 1993-1995, 1999-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware, mouse
"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.
+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)
(filter (when (symbolp map)
(plist-get (get map 'menu-prop) :filter))))
(if filter (funcall filter (symbol-function map)) map)))))
- event cmd)
- (unless position
- (let ((mp (mouse-pixel-position)))
- (setq position (list (list (cadr mp) (cddr mp)) (car mp)))))
+ 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
binding)
(while (and map (null binding))
(setq binding (lookup-key (car map) mouse-click))
- (if (numberp binding) ; `too long'
+ (if (numberp binding) ; `too long'
(setq binding nil))
(setq map (cdr map)))
binding)
;; 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.
(newmap (if ancestor
(make-sparse-keymap (concat (format-mode-line mode-name)
" Mode"))
- menu-bar-edit-menu))
- uniq)
+ menu-bar-edit-menu)))
(if ancestor
(set-keymap-parent newmap ancestor))
newmap))
(defun mouse-major-mode-menu (event &optional prefix)
"Pop up a mode-specific menu of mouse commands.
Default to the Edit menu if the major mode doesn't define a menu."
+ (declare (obsolete mouse-menu-major-mode-map "23.1"))
(interactive "@e\nP")
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(popup-menu (mouse-menu-major-mode-map) event prefix))
-(make-obsolete 'mouse-major-mode-menu 'mouse-menu-major-mode-map "23.1")
(defun mouse-popup-menubar (event prefix)
"Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
The contents are the items that would be in the menu bar whether or
not it is actually displayed."
+ (declare (obsolete mouse-menu-bar-map "23.1"))
(interactive "@e \nP")
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
-(make-obsolete 'mouse-popup-menubar 'mouse-menu-bar-map "23.1")
(defun mouse-popup-menubar-stuff (event prefix)
"Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
Use the former if the menu bar is showing, otherwise the latter."
+ (declare (obsolete nil "23.1"))
(interactive "@e\nP")
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(popup-menu
(mouse-menu-bar-map)
(mouse-menu-major-mode-map))
event prefix))
-(make-obsolete 'mouse-popup-menubar-stuff nil "23.1")
\f
;; Commands that operate on windows.
(let ((w (posn-window (event-start event))))
(and (window-minibuffer-p w)
(not (minibuffer-window-active-p w))
- (error "Minibuffer window is not active")))
+ (user-error "Minibuffer window is not active")))
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook))
;; Note that `window-in-direction' replaces `mouse-drag-window-above'
;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1.
+
(defun mouse-drag-line (start-event line)
- "Drag some line with the mouse.
+ "Drag a mode line, header line, or vertical line with the mouse.
START-EVENT is the starting mouse-event of the drag action. LINE
-must be one of the symbols header, mode, or vertical."
+must be one of the symbols `header', `mode', or `vertical'."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(let* ((echo-keystrokes 0)
(frame (window-frame window))
(minibuffer-window (minibuffer-window frame))
(on-link (and mouse-1-click-follows-link
- (or mouse-1-click-in-non-selected-windows
- (eq window (selected-window)))
(mouse-on-link-p start)))
- (resize-minibuffer
- ;; Resize the minibuffer window if it's on the same frame as
- ;; and immediately below the position window and it's either
- ;; active or `resize-mini-windows' is nil.
- (and (eq line 'mode)
- (eq (window-frame minibuffer-window) frame)
- (= (nth 1 (window-edges minibuffer-window))
- (nth 3 (window-edges window)))
- (or (not resize-mini-windows)
- (eq minibuffer-window (active-minibuffer-window)))))
- (which-side
- (and (eq line 'vertical)
- (or (cdr (assq 'vertical-scroll-bars (frame-parameters frame)))
- 'right)))
- done event mouse growth dragged)
+ (side (and (eq line 'vertical)
+ (or (cdr (assq 'vertical-scroll-bars
+ (frame-parameters frame)))
+ 'right)))
+ (draggable t)
+ event position growth dragged)
(cond
((eq line 'header)
;; Check whether header-line can be dragged at all.
(if (window-at-side-p window 'top)
- (setq done t)
+ (setq draggable nil)
(setq window (window-in-direction 'above window t))))
((eq line 'mode)
;; Check whether mode-line can be dragged at all.
- (when (and (window-at-side-p window 'bottom)
- (not resize-minibuffer))
- (setq done t)))
+ (and (window-at-side-p window 'bottom)
+ ;; Allow resizing the minibuffer window if it's on the same
+ ;; frame as and immediately below the clicked window, and
+ ;; it's active or `resize-mini-windows' is nil.
+ (not (and (eq (window-frame minibuffer-window) frame)
+ (= (nth 1 (window-edges minibuffer-window))
+ (nth 3 (window-edges window)))
+ (or (not resize-mini-windows)
+ (eq minibuffer-window
+ (active-minibuffer-window)))))
+ (setq draggable nil)))
((eq line 'vertical)
- ;; Get the window to adjust for the vertical case.
- (setq window
- (if (eq which-side 'right)
- ;; If the scroll bar is on the window's right or there's
- ;; no scroll bar at all, adjust the window where the
- ;; start-event occurred.
- window
- ;; If the scroll bar is on the start-event window's left,
- ;; adjust the window on the left of it.
- (window-in-direction 'left window t)))))
+ ;; Get the window to adjust for the vertical case. If the
+ ;; scroll bar is on the window's right or there's no scroll bar
+ ;; at all, adjust the window where the start-event occurred. If
+ ;; the scroll bar is on the start-event window's left, adjust
+ ;; the window on the left of it.
+ (unless (eq side 'right)
+ (setq window (window-in-direction 'left window t)))))
;; Start tracking.
(track-mouse
;; Loop reading events and sampling the position of the mouse.
- (while (not done)
+ (while draggable
(setq event (read-event))
- (setq mouse (mouse-position))
+ (setq position (mouse-position))
;; Do nothing if
;; - there is a switch-frame event.
;; - the mouse isn't in the frame that we started in
;; - the mouse isn't in any Emacs frame
;; Drag if
;; - there is a mouse-movement event
- ;; - there is a scroll-bar-movement event (??)
+ ;; - there is a scroll-bar-movement event (Why? -- cyd)
;; (same as mouse movement for our purposes)
;; Quit if
;; - there is a keyboard event or some other unknown event.
(cond
((not (consp event))
- (setq done t))
+ (setq draggable nil))
((memq (car event) '(switch-frame select-window))
nil)
((not (memq (car event) '(mouse-movement scroll-bar-movement)))
(memq (car event) '(drag-mouse-1 mouse-1))
(eq (car event) 'drag-mouse-1)))
(push event unread-command-events)))
- (setq done t))
- ((or (not (eq (car mouse) frame)) (null (car (cdr mouse))))
+ (setq draggable nil))
+ ((or (not (eq (car position) frame))
+ (null (car (cdr position))))
nil)
((eq line 'vertical)
- ;; Drag vertical divider (the calculations below are those
- ;; from Emacs 23).
- (setq growth
- (- (- (cadr mouse)
- (if (eq which-side 'right) 0 2))
- (nth 2 (window-edges window))
- -1))
+ ;; Drag vertical divider.
+ (setq growth (- (cadr position)
+ (if (eq side 'right) 0 2)
+ (nth 2 (window-edges window))
+ -1))
(unless (zerop growth)
- ;; Remember that we dragged.
(setq dragged t))
(adjust-window-trailing-edge window growth t))
- (t
- ;; Drag horizontal divider (the calculations below are those
- ;; from Emacs 23).
+ (draggable
+ ;; Drag horizontal divider.
(setq growth
(if (eq line 'mode)
- (- (cddr mouse) (nth 3 (window-edges window)) -1)
+ (- (cddr position) (nth 3 (window-edges window)) -1)
;; The window's top includes the header line!
- (- (nth 3 (window-edges window)) (cddr mouse))))
-
+ (- (nth 3 (window-edges window)) (cddr position))))
(unless (zerop growth)
- ;; Remember that we dragged.
(setq dragged t))
-
- (if (eq line 'mode)
- (adjust-window-trailing-edge window growth)
- (adjust-window-trailing-edge window (- growth))))))
-
- ;; Presumably, if this was just a click, the last event should be
- ;; `mouse-1', whereas if this did move the mouse, it should be a
- ;; `drag-mouse-1'. `dragged' nil tells us that we never dragged
- ;; and `on-link' tells us that there is a link to follow.
- (when (and on-link (not dragged)
- (eq 'mouse-1 (car-safe (car unread-command-events))))
- ;; If mouse-2 has never been done by the user, it doesn't
- ;; have the necessary property to be interpreted correctly.
- (put 'mouse-2 'event-kind 'mouse-click)
- (setcar unread-command-events
- (cons 'mouse-2 (cdar unread-command-events)))))))
+ (adjust-window-trailing-edge window (if (eq line 'mode)
+ growth
+ (- growth)))))))
+ ;; Process the terminating event.
+ (when (and (mouse-event-p event) on-link (not dragged)
+ (mouse--remap-link-click-p start-event event))
+ ;; If mouse-2 has never been done by the user, it doesn't have
+ ;; the necessary property to be interpreted correctly.
+ (put 'mouse-2 'event-kind 'mouse-click)
+ (setcar event 'mouse-2))
+ (push event unread-command-events)))
(defun mouse-drag-mode-line (start-event)
"Change the height of a window by dragging on the mode line."
;; Don't count the mode line.
(1- (nth 3 bounds))))
(on-link (and mouse-1-click-follows-link
- (or mouse-1-click-in-non-selected-windows
- (eq start-window original-window))
;; Use start-point before the intangibility
- ;; treatment, in case we click on a link inside an
+ ;; treatment, in case we click on a link inside
;; intangible text.
(mouse-on-link-p start-posn)))
(click-count (1- (event-click-count start-event)))
(= click-count 1)))
;; Suppress automatic hscrolling, because that is a nuisance
;; when setting point near the right fringe (but see below).
- (automatic-hscrolling-saved automatic-hscrolling)
- (automatic-hscrolling nil)
+ (auto-hscroll-mode-saved auto-hscroll-mode)
+ (auto-hscroll-mode nil)
moved-off-start event end end-point)
(setq mouse-selection-click-count click-count)
;; Automatic hscrolling did not occur during the call to
;; `read-event'; but if the user subsequently drags the
;; mouse, go ahead and hscroll.
- (let ((automatic-hscrolling automatic-hscrolling-saved))
+ (let ((auto-hscroll-mode auto-hscroll-mode-saved))
(redisplay))
(setq end (event-end event)
end-point (posn-point end))
(choice
;; Either choice == 'x-select-font, or choice is a
;; symbol whose name is a font.
- (buffer-face-mode-invoke (font-face-attributes
- (if (eq choice 'x-select-font)
- (x-select-font)
- (symbol-name choice)))
- t
- (called-interactively-p 'interactive))))))))
+ (let ((font (if (eq choice 'x-select-font)
+ (x-select-font)
+ (symbol-name choice))))
+ (buffer-face-mode-invoke
+ (if (fontp font 'font-spec)
+ (list :font font)
+ (font-face-attributes font))
+ t (called-interactively-p 'interactive)))))))))
\f
;;; Bindings for mouse commands.
;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: multimedia
;; UI-commands : mpc-
;; internal : mpc--
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup mpc ()
- "A Client for the Music Player Daemon."
+ "Client for the Music Player Daemon (mpd)."
:prefix "mpc-"
:group 'multimedia
:group 'applications)
(abs res))
res))))))))
-(defun mpc-string-prefix-p (str1 str2)
- ;; FIXME: copied from pcvs-util.el.
- "Tell whether STR1 is a prefix of STR2."
- (eq t (compare-strings str2 nil (length str1) str1 nil nil)))
+(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
(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)
(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)))
(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)
(defconst mpc--proc-alist-to-alists-starters '(file directory))
(defun mpc--proc-alist-to-alists (alist)
- (assert (or (null alist)
+ (cl-assert (or (null alist)
(memq (caar alist) mpc--proc-alist-to-alists-starters)))
(let ((starter (caar alist))
(alists ())
(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)))
(funcall callback (prog1 (mpc-proc-buf-to-alist
(current-buffer))
(set-buffer buf))))))
- ;; (lexical-let ((res nil))
+ ;; (let ((res nil))
;; (mpc-proc-cmd-to-alist cmd (lambda (alist) (setq res alist)))
;; (mpc-proc-sync)
;; res)
(let ((old-status mpc-status))
;; Update the alist.
(setq mpc-status (mpc-proc-buf-to-alist))
- (assert mpc-status)
+ (cl-assert mpc-status)
(unless (equal old-status mpc-status)
;; Run the relevant refresher functions.
(dolist (pair mpc-status-callbacks)
;; (defun mpc--queue-pop ()
;; (when mpc-queue ;Can be nil if out of sync.
;; (let ((song (car mpc-queue)))
-;; (assert song)
+;; (cl-assert song)
;; (push (if (and (consp song) (cddr song))
;; ;; The queue's first element is itself a list of
;; ;; songs, where the first element isn't itself a song
;; (prog1 (if (consp song) (cadr song) song)
;; (setq mpc-queue (cdr mpc-queue))))
;; mpc-queue-back)
-;; (assert (stringp (car mpc-queue-back))))))
+;; (cl-assert (stringp (car mpc-queue-back))))))
;; (defun mpc--queue-refresh ()
;; ;; Maintain the queue.
(i 0))
(mapcar (lambda (s)
(prog1 (cons (cons 'Pos (number-to-string i)) s)
- (incf i)))
+ (cl-incf i)))
l)))
((eq tag 'Search)
(mpc-proc-buf-to-alists
(list "move" song-pos dest-pos))
(if (< song-pos dest-pos)
;; This move has shifted dest-pos by 1.
- (decf dest-pos))
- (incf i)))
+ (cl-decf dest-pos))
+ (cl-incf i)))
;; Sort them from last to first, so the renumbering
;; caused by the earlier deletions affect
;; later ones a bit less.
(right-align (match-end 1))
(text
(if (eq info 'self) (symbol-name tag)
- (case tag
- ((Time Duration)
+ (pcase tag
+ ((or `Time `Duration)
(let ((time (cdr (or (assq 'time info) (assq 'Time info)))))
(setq pred (list nil)) ;Just assume it's never eq.
(when time
(string-match ":" time))
(substring time (match-end 0))
time)))))
- (Cover
+ (`Cover
(let* ((dir (file-name-directory (cdr (assq 'file info))))
(cover (concat dir "cover.jpg"))
(file (condition-case err
(mpc-tempfiles-add image tempfile)))
(setq size nil)
(propertize dir 'display image))))
- (t (let ((val (cdr (assq tag info))))
+ (_ (let ((val (cdr (assq tag info))))
;; For Streaming URLs, there's no other info
;; than the URL in `file'. Pretend it's in `Title'.
(when (and (null val) (eq tag 'Title))
(beginning-of-line))
(defun mpc-select-make-overlay ()
- (assert (not (get-char-property (point) 'mpc-select)))
+ (cl-assert (not (get-char-property (point) 'mpc-select)))
(let ((ol (make-overlay
(line-beginning-position) (line-beginning-position 2))))
(overlay-put ol 'mpc-select t)
(> (overlay-end ol) (point)))
(delete-overlay ol)
(push ol ols)))
- (assert (= (1+ (length ols)) (length mpc-select)))
+ (cl-assert (= (1+ (length ols)) (length mpc-select)))
(setq mpc-select ols)))
;; We're trying to select *ALL* additionally to others.
((mpc-tagbrowser-all-p) nil)
(while (and (zerop (forward-line 1))
(get-char-property (point) 'mpc-select))
(setq end (1+ (point)))
- (incf after))
+ (cl-incf after))
(goto-char mid)
(while (and (zerop (forward-line -1))
(get-char-property (point) 'mpc-select))
(setq start (point))
- (incf before))
+ (cl-incf before))
(if (and (= after 0) (= before 0))
;; Shortening an already minimum-size region: do nothing.
nil
(start (line-beginning-position)))
(while (and (zerop (forward-line 1))
(not (get-char-property (point) 'mpc-select)))
- (incf count))
+ (cl-incf count))
(unless (get-char-property (point) 'mpc-select)
(setq count nil))
(goto-char start)
(while (and (zerop (forward-line -1))
(not (get-char-property (point) 'mpc-select)))
- (incf before))
+ (cl-incf before))
(unless (get-char-property (point) 'mpc-select)
(setq before nil))
(when (and before (or (null count) (< before count)))
(mpc-select-save
(widen)
(goto-char (point-min))
- (assert (looking-at (regexp-quote mpc-tagbrowser-all-name)))
+ (cl-assert (looking-at (regexp-quote mpc-tagbrowser-all-name)))
(forward-line 1)
(let ((inhibit-read-only t))
(delete-region (point) (point-max))
(process-put (mpc-proc) prop
(delq nil
(mapcar (lambda (x)
- (if (mpc-string-prefix-p name x)
+ (if (string-prefix-p name x)
nil x))
new)))))
(mpc-tagbrowser-refresh)))
(cdr (assq 'file song1))
(cdr (assq 'file song2)))))
(and (integerp cmp) (< cmp 0)))))))
- (incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0")))
+ (cl-incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0")))
(mpc-format mpc-songs-format song)
(delete-char (- (skip-chars-backward " "))) ;Remove trailing space.
(insert "\n")
(- (point) (car prev)))
next prev)
(or next prev)))))
- (assert sn)
+ (cl-assert sn)
(mpc-proc-cmd (concat "play " sn))))))))))
(define-derived-mode mpc-songs-mode mpc-mode "MPC-song"
(dolist (song (car context))
(and (zerop (forward-line -1))
(eq (get-text-property (point) 'mpc-file) song)
- (incf count)))
+ (cl-incf count)))
(goto-char pos)
(dolist (song (cdr context))
(and (zerop (forward-line 1))
(eq (get-text-property (point) 'mpc-file) song)
- (incf count)))
+ (cl-incf count)))
count))
(defun mpc-songpointer-refresh-hairy ()
((< score context-size) nil)
(t
;; Score is equal and increasing context might help: try it.
- (incf context-size)
+ (cl-incf context-size)
(let ((new-context
(mpc-songpointer-context context-size plbuf)))
(if (null new-context)
;; There isn't more context: choose one arbitrarily
;; and keep looking for a better match elsewhere.
- (decf context-size)
+ (cl-decf context-size)
(setq context new-context)
(setq score (mpc-songpointer-score context pos))
(save-excursion
;; hacked on by Dave Love.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
-;;;
-;;; Some example constants to be used for `msb-menu-cond'. See that
-;;; variable for more information. Please note that if the condition
-;;; returns `multi', then the buffer can appear in several menus.
-;;;
+;;
+;; Some example constants to be used for `msb-menu-cond'. See that
+;; variable for more information. Please note that if the condition
+;; returns `multi', then the buffer can appear in several menus.
+;;
(defconst msb--few-menus
'(((and (boundp 'server-buffer-clients)
server-buffer-clients
:group 'msb)
(defvar msb-files-by-directory-sort-key 0
- "*The sort key for files sorted by directory.")
+ "The sort key for files sorted by directory.")
(defcustom msb-max-menu-items 15
"The maximum number of items in a menu.
:group 'msb)
(defvar msb-horizontal-shift-function (lambda () 0)
- "*Function that specifies how many pixels to shift the top menu leftwards.")
+ "Function that specifies how many pixels to shift the top menu leftwards.")
(defcustom msb-display-invisible-buffers-p nil
"Show invisible buffers or not.
:group 'msb)
(defvar msb-item-handling-function 'msb-item-handler
- "*The appearance of a buffer menu.
+ "The appearance of a buffer menu.
The default function to call for handling the appearance of a menu
item. It should take two arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
(multi-flag nil)
function-info-list)
(setq function-info-list
- (loop for fi
- across function-info-vector
- if (and (setq result
- (eval (aref fi 1))) ;Test CONDITION
- (not (and (eq result 'no-multi)
- multi-flag))
- (progn (when (eq result 'multi)
- (setq multi-flag t))
- t))
- collect fi
- until (and result
- (not (eq result 'multi)))))
+ (cl-loop for fi
+ across function-info-vector
+ if (and (setq result
+ (eval (aref fi 1))) ;Test CONDITION
+ (not (and (eq result 'no-multi)
+ multi-flag))
+ (progn (when (eq result 'multi)
+ (setq multi-flag t))
+ t))
+ collect fi
+ until (and result
+ (not (eq result 'multi)))))
(when (and (not function-info-list)
(not result))
(error "No catch-all in msb-menu-cond!"))
(defun msb--mode-menu-cond ()
(let ((key msb-modes-key))
(mapcar (lambda (item)
- (incf key)
+ (cl-incf key)
(list `( eq major-mode (quote ,(car item)))
key
(concat (cdr item) " (%d)")))
(> msb-display-most-recently-used 0))
(let* ((buffers (cdr (buffer-list)))
(most-recently-used
- (loop with n = 0
- for buffer in buffers
- if (with-current-buffer buffer
- (and (not (msb-invisible-buffer-p))
- (not (eq major-mode 'dired-mode))))
- collect (with-current-buffer buffer
- (cons (funcall msb-item-handling-function
- buffer
- max-buffer-name-length)
- buffer))
- and do (incf n)
- until (>= n msb-display-most-recently-used))))
+ (cl-loop with n = 0
+ for buffer in buffers
+ if (with-current-buffer buffer
+ (and (not (msb-invisible-buffer-p))
+ (not (eq major-mode 'dired-mode))))
+ collect (with-current-buffer buffer
+ (cons (funcall msb-item-handling-function
+ buffer
+ max-buffer-name-length)
+ buffer))
+ and do (cl-incf n)
+ until (>= n msb-display-most-recently-used))))
(cons (if (stringp msb-most-recently-used-title)
(format msb-most-recently-used-title
(length most-recently-used))
(when file-buffers
(setq file-buffers
(mapcar (lambda (buffer-list)
- (list* msb-files-by-directory-sort-key
- (car buffer-list)
- (sort
- (mapcar (lambda (buffer)
- (cons (with-current-buffer buffer
- (funcall
- msb-item-handling-function
- buffer
- max-buffer-name-length))
- buffer))
- (cdr buffer-list))
- (lambda (item1 item2)
- (string< (car item1) (car item2))))))
+ `(,msb-files-by-directory-sort-key
+ ,(car buffer-list)
+ ,@(sort
+ (mapcar (lambda (buffer)
+ (cons (with-current-buffer buffer
+ (funcall
+ msb-item-handling-function
+ buffer
+ max-buffer-name-length))
+ buffer))
+ (cdr buffer-list))
+ (lambda (item1 item2)
+ (string< (car item1) (car item2))))))
(msb--choose-file-menu file-buffers))))
;; Now make the menu - a list of (TITLE . BUFFER-LIST)
(let* (menu
(most-recently-used
(msb--most-recently-used-menu max-buffer-name-length))
(others (nconc file-buffers
- (loop for elt
- across function-info-vector
- for value = (msb--create-sort-item elt)
- if value collect value))))
+ (cl-loop for elt
+ across function-info-vector
+ for value = (msb--create-sort-item elt)
+ if value collect value))))
(setq menu
(mapcar 'cdr ;Remove the SORT-KEY
;; Sort the menus - not the items.
(tmp-list nil))
(while (< count msb-max-menu-items)
(push (pop list) tmp-list)
- (incf count))
+ (cl-incf count))
(setq tmp-list (nreverse tmp-list))
(setq sub-name (concat (car (car tmp-list)) "..."))
(push (nconc (list mcount sub-name
(cons (buffer-name (cdr item))
(cons (car item) end)))
(cdr sub-menu))))
- (nconc (list (incf mcount) (car sub-menu)
+ (nconc (list (cl-incf mcount) (car sub-menu)
'keymap (car sub-menu))
(msb--split-menus buffers))))))
raw-menu)))
;; that this change will take effect for the current GNU Emacs session only.
;; See below for a discussion of non-UNIX hosts. If a large number of
;; machines with similar hostnames have this problem then it is easier to set
-;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp
+;; the value of ange-ftp-dumb-unix-host-regexp in your init file. ange-ftp
;; is unable to automatically recognize dumb unix hosts.
;; File name completion:
;; VMS support:
;;
-;; Ange-ftp has full support for VMS hosts. It
-;; should be able to automatically recognize any VMS machine. However, if it
-;; fails to do this, you can use the command ange-ftp-add-vms-host. As well,
-;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We
+;; Ange-ftp has full support for VMS hosts. It should be able to
+;; automatically recognize any VMS machine. However, if it fails to do
+;; this, you can use the command ange-ftp-add-vms-host. Also, you can
+;; set the variable ange-ftp-vms-host-regexp in your init file. We
;; would be grateful if you would report any failures to automatically
;; recognize a VMS host as a bug.
;;
;; the Michigan terminal system. It should be able to automatically
;; recognize any MTS machine. However, if it fails to do this, you can use
;; the command ange-ftp-add-mts-host. As well, you can set the variable
-;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you
+;; ange-ftp-mts-host-regexp in your init file. We would be grateful if you
;; would report any failures to automatically recognize a MTS host as a bug.
;;
;; Filename syntax:
;; CMS. It should be able to automatically recognize any CMS machine.
;; However, if it fails to do this, you can use the command
;; ange-ftp-add-cms-host. As well, you can set the variable
-;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you
+;; ange-ftp-cms-host-regexp in your init file. We would be grateful if you
;; would report any failures to automatically recognize a CMS host as a bug.
;;
;; Filename syntax:
;;;; ------------------------------------------------------------
(defgroup ange-ftp nil
- "Accessing remote files and directories using FTP
- made as simple and transparent as possible."
+ "Accessing remote files and directories using FTP."
:group 'files
:group 'comm
:prefix "ange-ftp-")
(defvar ange-ftp-multi-msgs
"^150-\\|^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-"
- "*Regular expression matching the start of a multiline FTP reply.")
+ "Regular expression matching the start of a multiline FTP reply.")
(defvar ange-ftp-good-msgs
"^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark"
- "*Regular expression matching FTP \"success\" messages.")
+ "Regular expression matching FTP \"success\" messages.")
;; CMS and the odd VMS machine say 200 Port rather than 200 PORT.
;; Also CMS machines use a multiline 550- reply to say that you
(if (eq system-type 'hpux)
"stty -onlcr -echo\n"
"stty -echo nl\n")
- "*Set up terminal after logging in to the gateway machine.
+ "Set up terminal after logging in to the gateway machine.
This command should stop the terminal from echoing each command, and
arrange to strip out trailing ^M characters.")
(defun ange-ftp-get-passwd (host user)
"Return the password for specified HOST and USER, asking user if necessary."
+ ;; If `non-essential' is non-nil, don't ask for a password. It will
+ ;; be caught in Tramp.
+ (when non-essential
+ (throw 'non-essential 'non-essential))
+
(ange-ftp-parse-netrc)
;; look up password in the hash table first; user might have overridden the
;; see if same user has logged in to other hosts; if so then prompt
;; with the password that was used there.
(t
- (let* ((other (ange-ftp-get-host-with-passwd user))
+ (let* ((enable-recursive-minibuffers t)
+ (other (ange-ftp-get-host-with-passwd user))
(passwd (if other
;; found another machine with the same user.
(defun ange-ftp-gwp-start (host user name args)
"Login to the gateway machine and fire up an FTP process."
+ ;; If `non-essential' is non-nil, don't reopen a new connection. It
+ ;; will be caught in Tramp.
+ (when non-essential
+ (throw 'non-essential 'non-essential))
(let (;; It would be nice to make process-connection-type nil,
;; but that doesn't work: ftp never responds.
;; Can anyone find a fix for that?
"Spawn a new FTP process ready to connect to machine HOST and give it NAME.
If HOST is only FTP-able through a gateway machine then spawn a shell
on the gateway machine to do the FTP instead."
+ ;; If `non-essential' is non-nil, don't reopen a new connection. It
+ ;; will be caught in Tramp.
+ (when non-essential
+ (throw 'non-essential 'non-essential))
(let* ((use-gateway (ange-ftp-use-gateway-p host))
(use-smart-ftp (and (not ange-ftp-gateway-host)
(ange-ftp-use-smart-gateway-p host)))
;; ange@hplb.hpl.hp.com says this should not be changed.
(defvar ange-ftp-hash-mark-msgs
"[hH]ash mark [^0-9]*\\([0-9]+\\)"
- "*Regexp matching the FTP client's output upon doing a HASH command.")
+ "Regexp matching the FTP client's output upon doing a HASH command.")
(defun ange-ftp-guess-hash-mark-size (proc)
(if ange-ftp-send-hash
(proc (get-process name)))
(if (and proc (memq (process-status proc) '(run open)))
proc
+ ;; If `non-essential' is non-nil, don't reopen a new connection. It
+ ;; will be caught in Tramp.
+ (when non-essential
+ (throw 'non-essential 'non-essential))
+
;; Must delete dead process so that new process can reuse the name.
(if proc (delete-process proc))
(let ((pass (ange-ftp-quote-string
(format
"list data file %s not readable"
temp))))
- ;; remove ^M inserted by the win32 ftp client
+ ;; remove ^M inserted by the w32 ftp client
(while (re-search-forward "\r$" nil t)
(replace-match ""))
(goto-char 1)
"Documented as `expand-file-name'."
(save-match-data
(setq default (or default default-directory))
- (cond ((eq (string-to-char name) ?~)
- (ange-ftp-real-expand-file-name name))
- ((eq (string-to-char name) ?/)
- (ange-ftp-canonize-filename name))
- ((and (eq system-type 'windows-nt)
- (eq (string-to-char name) ?\\))
- (ange-ftp-canonize-filename name))
- ((and (eq system-type 'windows-nt)
- (or (string-match "\\`[a-zA-Z]:" name)
- (string-match "\\`[a-zA-Z]:" default)))
- (ange-ftp-real-expand-file-name name default))
- ((zerop (length name))
- (ange-ftp-canonize-filename default))
- ((ange-ftp-canonize-filename
- (concat (file-name-as-directory default) name))))))
+ (cond
+ ((ange-ftp-ftp-name name)
+ ;; `default' is irrelevant.
+ (ange-ftp-canonize-filename name))
+ ((file-name-absolute-p name)
+ ;; `name' is absolute but is not an ange-ftp name => not ange-ftp.
+ (ange-ftp-real-expand-file-name name "/"))
+ ((ange-ftp-canonize-filename
+ (concat (file-name-as-directory default) name))))))
\f
;;; These are problems--they are currently not enabled.
(if (ange-ftp-file-entry-p name)
(let ((file-ent (ange-ftp-get-file-entry name)))
(if (stringp file-ent)
- (file-exists-p
+ (ange-ftp-file-exists-p
(ange-ftp-expand-symlink file-ent
(file-name-directory
(directory-file-name name))))
(format "Copying %s to %s" f-abbr t-abbr)))
(list 'ange-ftp-cf2
newname t-host t-user binary temp1 temp2 cont)
- nowait))
+ nowait)
+ (ange-ftp-add-file-entry newname))
;; newname wasn't remote.
(ange-ftp-cf2 t nil newname t-host t-user binary temp1 temp2 cont))
(string-match "\\`[a-zA-Z]:[/\\]\\'" dir))
(string-equal "/" dir)))
+(defmacro ange-ftp-ignore-errors-if-non-essential (&rest body)
+ `(if non-essential
+ (ignore-errors ,@body)
+ (progn ,@body)))
+
(defun ange-ftp-file-name-all-completions (file dir)
(let ((ange-ftp-this-dir (expand-file-name dir)))
(if (ange-ftp-ftp-name ange-ftp-this-dir)
- (progn
+ (ange-ftp-ignore-errors-if-non-essential
(ange-ftp-barf-if-not-directory ange-ftp-this-dir)
(setq ange-ftp-this-dir
(ange-ftp-real-file-name-as-directory ange-ftp-this-dir))
(defcustom ange-ftp-bs2000-additional-pubsets
nil
- "*List of additional pubsets available to all users."
+ "List of additional pubsets available to all users."
:group 'ange-ftp
:type '(repeat string))
;; the buffer, use:
;; M-x browse-url
-;; To display a URL by shift-clicking on it, put this in your ~/.emacs
-;; file:
+;; To display a URL by shift-clicking on it, put this in your init file:
;; (global-set-key [S-mouse-2] 'browse-url-at-mouse)
;; (Note that using Shift-mouse-1 is not desirable because
;; that event has a standard meaning in Emacs.)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables
-(eval-when-compile (require 'cl))
-
(defgroup browse-url nil
"Use a web browser to look at a URL."
:prefix "browse-url-"
;; it in anonymous cases. If it's not anonymous the next regexp
;; applies.
("^/\\([^:@]+@\\)?\\([^:]+\\):/*" . "ftp://\\1\\2/")
- ,@(if (memq system-type '(windows-nt ms-dos cygwin))
+ ,@(if (memq system-type '(windows-nt ms-dos))
'(("^\\([a-zA-Z]:\\)[\\/]" . "file:///\\1/")
("^[\\/][\\/]+" . "file://")))
("^/+" . "file:///"))
(s 0))
(while (setq s (string-match chars encoded-text s))
(setq encoded-text
- (replace-match (format "%%%x"
+ (replace-match (format "%%%X"
(string-to-char (match-string 0 encoded-text)))
t t encoded-text)
s (1+ s)))
;; FIXME: Is there an actual example of a web browser getting
;; confused? (This used to encode commas, but at least Firefox
;; handles commas correctly and doesn't accept encoded commas.)
- (browse-url-url-encode-chars url "[)$]"))
+ (browse-url-url-encode-chars url "[\")$] "))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL input
(defun browse-url-file-url (file)
"Return the URL corresponding to FILE.
Use variable `browse-url-filename-alist' to map filenames to URLs."
- ;; De-munge Cygwin filenames before passing them to Windows browser.
- (if (eq system-type 'cygwin)
- (let ((winfile (with-output-to-string
- (call-process "cygpath" nil standard-output
- nil "-m" file))))
- (setq file (substring winfile 0 -1))))
(let ((coding (and (default-value 'enable-multibyte-characters)
(or file-name-coding-system
default-file-name-coding-system))))
(and buffer (set-buffer buffer))
(let ((file-name
;; Ignore real name if restricted
- (and (= (- (point-max) (point-min)) (buffer-size))
+ (and (not (buffer-narrowed-p))
(or buffer-file-name
(and (boundp 'dired-directory) dired-directory)))))
(or file-name
(defun browse-url-elinks-sentinel (process url)
"Determines if Elinks is running or a new one has to be started."
- (let ((exit-status (process-exit-status process)))
- ;; Try to determine if an instance is running or if we have to
- ;; create a new one.
- (case exit-status
- (5
- ;; No instance, start a new one.
- (browse-url-elinks-new-window url))
- (0
- ;; Found an instance, open URL in new tab.
- (let ((process-environment (browse-url-process-environment)))
- (start-process (concat "elinks:" url) nil
- "elinks" "-remote"
- (concat "openURL(\"" url "\",new-tab)"))))
- (otherwise
- (error "Unrecognized exit-code %d of process `elinks'"
- exit-status)))))
+ ;; Try to determine if an instance is running or if we have to
+ ;; create a new one.
+ (pcase (process-exit-status process)
+ (5
+ ;; No instance, start a new one.
+ (browse-url-elinks-new-window url))
+ (0
+ ;; Found an instance, open URL in new tab.
+ (let ((process-environment (browse-url-process-environment)))
+ (start-process (concat "elinks:" url) nil
+ "elinks" "-remote"
+ (concat "openURL(\"" url "\",new-tab)"))))
+ (exit-status
+ (error "Unrecognized exit-code %d of process `elinks'"
+ exit-status))))
(provide 'browse-url)
;; Low-level language bindings are implemented in src/dbusbind.c.
+;; D-Bus support in the Emacs core can be disabled with configuration
+;; option "--without-dbus".
+
;;; Code:
-;; D-Bus support in the Emacs core can be disabled with configuration
-;; option "--without-dbus". Declare used subroutines and variables.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-call-method-asynchronously "dbusbind.c")
+;; Declare used subroutines and variables.
+(declare-function dbus-message-internal "dbusbind.c")
(declare-function dbus-init-bus "dbusbind.c")
-(declare-function dbus-method-return-internal "dbusbind.c")
-(declare-function dbus-method-error-internal "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
-(declare-function dbus-register-method "dbusbind.c")
-(declare-function dbus-send-signal "dbusbind.c")
+(defvar dbus-message-type-invalid)
+(defvar dbus-message-type-method-call)
+(defvar dbus-message-type-method-return)
+(defvar dbus-message-type-error)
+(defvar dbus-message-type-signal)
(defvar dbus-debug)
(defvar dbus-registered-objects-table)
;; Pacify byte compiler.
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'xml)
(defconst dbus-path-dbus "/org/freedesktop/DBus"
"The object path used to talk to the bus itself.")
+;; Default D-Bus interfaces.
+
(defconst dbus-interface-dbus "org.freedesktop.DBus"
- "The interface exported by the object with `dbus-service-dbus' and `dbus-path-dbus'.")
+ "The interface exported by the service `dbus-service-dbus'.")
(defconst dbus-interface-peer (concat dbus-interface-dbus ".Peer")
- "The interface for peer objects.")
+ "The interface for peer objects.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-peer'.")
+
+;; <interface name="org.freedesktop.DBus.Peer">
+;; <method name="Ping">
+;; </method>
+;; <method name="GetMachineId">
+;; <arg name="machine_uuid" type="s" direction="out"/>
+;; </method>
+;; </interface>
(defconst dbus-interface-introspectable
(concat dbus-interface-dbus ".Introspectable")
- "The interface supported by introspectable objects.")
+ "The interface supported by introspectable objects.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-introspectable'.")
-(defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
- "The interface for property objects.")
+;; <interface name="org.freedesktop.DBus.Introspectable">
+;; <method name="Introspect">
+;; <arg name="data" type="s" direction="out"/>
+;; </method>
+;; </interface>
+(defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
+ "The interface for property objects.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-properties'.")
+
+;; <interface name="org.freedesktop.DBus.Properties">
+;; <method name="Get">
+;; <arg name="interface" type="s" direction="in"/>
+;; <arg name="propname" type="s" direction="in"/>
+;; <arg name="value" type="v" direction="out"/>
+;; </method>
+;; <method name="Set">
+;; <arg name="interface" type="s" direction="in"/>
+;; <arg name="propname" type="s" direction="in"/>
+;; <arg name="value" type="v" direction="in"/>
+;; </method>
+;; <method name="GetAll">
+;; <arg name="interface" type="s" direction="in"/>
+;; <arg name="props" type="a{sv}" direction="out"/>
+;; </method>
+;; <signal name="PropertiesChanged">
+;; <arg name="interface" type="s"/>
+;; <arg name="changed_properties" type="a{sv}"/>
+;; <arg name="invalidated_properties" type="as"/>
+;; </signal>
+;; </interface>
+
+(defconst dbus-interface-objectmanager
+ (concat dbus-interface-dbus ".ObjectManager")
+ "The object manager interface.
+See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager'.")
+
+;; <interface name="org.freedesktop.DBus.ObjectManager">
+;; <method name="GetManagedObjects">
+;; <arg name="object_paths_interfaces_and_properties"
+;; type="a{oa{sa{sv}}}" direction="out"/>
+;; </method>
+;; <signal name="InterfacesAdded">
+;; <arg name="object_path" type="o"/>
+;; <arg name="interfaces_and_properties" type="a{sa{sv}}"/>
+;; </signal>
+;; <signal name="InterfacesRemoved">
+;; <arg name="object_path" type="o"/>
+;; <arg name="interfaces" type="as"/>
+;; </signal>
+;; </interface>
+
+;; Emacs defaults.
(defconst dbus-service-emacs "org.gnu.Emacs"
"The well known service name of Emacs.")
(defconst dbus-path-emacs "/org/gnu/Emacs"
- "The object path head used by Emacs.")
+ "The object path namespace used by Emacs.
+All object paths provided by the service `dbus-service-emacs'
+shall be subdirectories of this path.")
-(defconst dbus-message-type-invalid 0
- "This value is never a valid message type.")
+(defconst dbus-interface-emacs "org.gnu.Emacs"
+ "The interface namespace used by Emacs.")
-(defconst dbus-message-type-method-call 1
- "Message type of a method call message.")
-
-(defconst dbus-message-type-method-return 2
- "Message type of a method return message.")
-
-(defconst dbus-message-type-error 3
- "Message type of an error reply message.")
-
-(defconst dbus-message-type-signal 4
- "Message type of a signal message.")
+;; D-Bus constants.
(defmacro dbus-ignore-errors (&rest body)
"Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
caught in `condition-case' by `dbus-error'.")
\f
-;;; Hash table of registered functions.
+;;; Basic D-Bus message functions.
(defvar dbus-return-values-table (make-hash-table :test 'equal)
"Hash table for temporary storing arguments of reply messages.
-A key in this hash table is a list (BUS SERIAL). BUS is either a
-Lisp symbol, `:system' or `:session', or a string denoting the
-bus address. SERIAL is the serial number of the reply message.
-See `dbus-call-method-non-blocking-handler' and
-`dbus-call-method-non-blocking'.")
+A key in this hash table is a list (:serial BUS SERIAL), like in
+`dbus-registered-objects-table'. BUS is either a Lisp symbol,
+`:system' or `:session', or a string denoting the bus address.
+SERIAL is the serial number of the reply message.")
+
+(defun dbus-call-method-handler (&rest args)
+ "Handler for reply messages of asynchronous D-Bus message calls.
+It calls the function stored in `dbus-registered-objects-table'.
+The result will be made available in `dbus-return-values-table'."
+ (puthash (list :serial
+ (dbus-event-bus-name last-input-event)
+ (dbus-event-serial-number last-input-event))
+ (if (= (length args) 1) (car args) args)
+ dbus-return-values-table))
+
+(defun dbus-call-method (bus service path interface method &rest args)
+ "Call METHOD on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name to be used. PATH is the D-Bus
+object path SERVICE is registered at. INTERFACE is an interface
+offered by SERVICE. It must provide METHOD.
+
+If the parameter `:timeout' is given, the following integer TIMEOUT
+specifies the maximum number of milliseconds the method call must
+return. The default value is 25,000. If the method call doesn't
+return in time, a D-Bus error is raised.
+
+All other arguments ARGS are passed to METHOD as arguments. They are
+converted into D-Bus types via the following rules:
+
+ t and nil => DBUS_TYPE_BOOLEAN
+ number => DBUS_TYPE_UINT32
+ integer => DBUS_TYPE_INT32
+ float => DBUS_TYPE_DOUBLE
+ string => DBUS_TYPE_STRING
+ list => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol. For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+`dbus-call-method' returns the resulting values of METHOD as a list of
+Lisp objects. The type conversion happens the other direction as for
+input arguments. It follows the mapping rules:
+
+ DBUS_TYPE_BOOLEAN => t or nil
+ DBUS_TYPE_BYTE => number
+ DBUS_TYPE_UINT16 => number
+ DBUS_TYPE_INT16 => integer
+ DBUS_TYPE_UINT32 => number or float
+ DBUS_TYPE_UNIX_FD => number or float
+ DBUS_TYPE_INT32 => integer or float
+ DBUS_TYPE_UINT64 => number or float
+ DBUS_TYPE_INT64 => integer or float
+ DBUS_TYPE_DOUBLE => float
+ DBUS_TYPE_STRING => string
+ DBUS_TYPE_OBJECT_PATH => string
+ DBUS_TYPE_SIGNATURE => string
+ DBUS_TYPE_ARRAY => list
+ DBUS_TYPE_VARIANT => list
+ DBUS_TYPE_STRUCT => list
+ DBUS_TYPE_DICT_ENTRY => list
+
+Example:
+
+\(dbus-call-method
+ :session \"org.gnome.seahorse\" \"/org/gnome/seahorse/keys/openpgp\"
+ \"org.gnome.seahorse.Keys\" \"GetKeyField\"
+ \"openpgp:657984B8C7A966DD\" \"simple-name\")
+
+ => (t (\"Philip R. Zimmermann\"))
+
+If the result of the METHOD call is just one value, the converted Lisp
+object is returned instead of a list containing this single Lisp object.
+
+\(dbus-call-method
+ :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
+ \"org.freedesktop.Hal.Device\" \"GetPropertyString\"
+ \"system.kernel.machine\")
+
+ => \"i686\""
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (stringp path)
+ (signal 'wrong-type-argument (list 'stringp path)))
+ (or (stringp interface)
+ (signal 'wrong-type-argument (list 'stringp interface)))
+ (or (stringp method)
+ (signal 'wrong-type-argument (list 'stringp method)))
+
+ (let ((timeout (plist-get args :timeout))
+ (key
+ (apply
+ 'dbus-message-internal dbus-message-type-method-call
+ bus service path interface method 'dbus-call-method-handler args)))
+
+ ;; Wait until `dbus-call-method-handler' has put the result into
+ ;; `dbus-return-values-table'. If no timeout is given, use the
+ ;; default 25". Events which are not from D-Bus must be restored.
+ (with-timeout ((if timeout (/ timeout 1000.0) 25))
+ (while (eq (gethash key dbus-return-values-table :ignore) :ignore)
+ (let ((event (let (unread-command-events) (read-event nil nil 0.1))))
+ (when (and event (not (ignore-errors (dbus-check-event event))))
+ (setq unread-command-events
+ (append unread-command-events (list event)))))))
+
+ ;; Cleanup `dbus-return-values-table'. Return the result.
+ (prog1
+ (gethash key dbus-return-values-table)
+ (remhash key dbus-return-values-table))))
+
+;; `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.3")
+
+(defun dbus-call-method-asynchronously
+ (bus service path interface method handler &rest args)
+ "Call METHOD on the D-Bus BUS asynchronously.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name to be used. PATH is the D-Bus
+object path SERVICE is registered at. INTERFACE is an interface
+offered by SERVICE. It must provide METHOD.
+
+HANDLER is a Lisp function, which is called when the corresponding
+return message has arrived. If HANDLER is nil, no return message
+will be expected.
+
+If the parameter `:timeout' is given, the following integer TIMEOUT
+specifies the maximum number of milliseconds the method call must
+return. The default value is 25,000. If the method call doesn't
+return in time, a D-Bus error is raised.
+
+All other arguments ARGS are passed to METHOD as arguments. They are
+converted into D-Bus types via the following rules:
+
+ t and nil => DBUS_TYPE_BOOLEAN
+ number => DBUS_TYPE_UINT32
+ integer => DBUS_TYPE_INT32
+ float => DBUS_TYPE_DOUBLE
+ string => DBUS_TYPE_STRING
+ list => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol. For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+If HANDLER is a Lisp function, the function returns a key into the
+hash table `dbus-registered-objects-table'. The corresponding entry
+in the hash table is removed, when the return message has been arrived,
+and HANDLER is called.
+
+Example:
+
+\(dbus-call-method-asynchronously
+ :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
+ \"org.freedesktop.Hal.Device\" \"GetPropertyString\" 'message
+ \"system.kernel.machine\")
+
+ => \(:serial :system 2)
+
+ -| i686"
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (stringp path)
+ (signal 'wrong-type-argument (list 'stringp path)))
+ (or (stringp interface)
+ (signal 'wrong-type-argument (list 'stringp interface)))
+ (or (stringp method)
+ (signal 'wrong-type-argument (list 'stringp method)))
+ (or (null handler) (functionp handler)
+ (signal 'wrong-type-argument (list 'functionp handler)))
+
+ (apply 'dbus-message-internal dbus-message-type-method-call
+ bus service path interface method handler args))
+
+(defun dbus-send-signal (bus service path interface signal &rest args)
+ "Send signal SIGNAL on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address. The signal is sent from the D-Bus object
+Emacs is registered at BUS.
+
+SERVICE is the D-Bus name SIGNAL is sent to. It can be either a known
+name or a unique name. If SERVICE is nil, the signal is sent as
+broadcast message. PATH is the D-Bus object path SIGNAL is sent from.
+INTERFACE is an interface available at PATH. It must provide signal
+SIGNAL.
+
+All other arguments ARGS are passed to SIGNAL as arguments. They are
+converted into D-Bus types via the following rules:
+
+ t and nil => DBUS_TYPE_BOOLEAN
+ number => DBUS_TYPE_UINT32
+ integer => DBUS_TYPE_INT32
+ float => DBUS_TYPE_DOUBLE
+ string => DBUS_TYPE_STRING
+ list => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol. For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+Example:
+
+\(dbus-send-signal
+ :session nil \"/org/gnu/Emacs\" \"org.gnu.Emacs.FileManager\"
+ \"FileModified\" \"/home/albinus/.emacs\")"
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (null service) (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (stringp path)
+ (signal 'wrong-type-argument (list 'stringp path)))
+ (or (stringp interface)
+ (signal 'wrong-type-argument (list 'stringp interface)))
+ (or (stringp signal)
+ (signal 'wrong-type-argument (list 'stringp signal)))
+
+ (apply 'dbus-message-internal dbus-message-type-signal
+ bus service path interface signal args))
+
+(defun dbus-method-return-internal (bus service serial &rest args)
+ "Return for message SERIAL on the D-Bus BUS.
+This is an internal function, it shall not be used outside dbus.el."
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (natnump serial)
+ (signal 'wrong-type-argument (list 'natnump serial)))
+
+ (apply 'dbus-message-internal dbus-message-type-method-return
+ bus service serial args))
+
+(defun dbus-method-error-internal (bus service serial &rest args)
+ "Return error message for message SERIAL on the D-Bus BUS.
+This is an internal function, it shall not be used outside dbus.el."
+
+ (or (memq bus '(:system :session)) (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+ (or (natnump serial)
+ (signal 'wrong-type-argument (list 'natnump serial)))
+
+ (apply 'dbus-message-internal dbus-message-type-error
+ bus service serial args))
+
+\f
+;;; Hash table of registered functions.
(defun dbus-list-hash-table ()
"Returns all registered member registrations to D-Bus.
dbus-registered-objects-table)
result))
+(defun dbus-setenv (bus variable value)
+ "Set the value of the BUS environment variable named VARIABLE to VALUE.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address. Both VARIABLE and VALUE should be strings.
+
+Normally, services inherit the environment of the BUS daemon. This
+function adds to or modifies that environment when activating services.
+
+Some bus instances, such as `:system', may disable setting the environment."
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "UpdateActivationEnvironment"
+ `(:array (:dict-entry ,variable ,value))))
+
+(defun dbus-register-service (bus service &rest flags)
+ "Register known name SERVICE on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name that should be registered. It must
+be a known name.
+
+FLAGS are keywords, which control how the service name is registered.
+The following keywords are recognized:
+
+`:allow-replacement': Allow another service to become the primary
+owner if requested.
+
+`:replace-existing': Request to replace the current primary owner.
+
+`:do-not-queue': If we can not become the primary owner do not place
+us in the queue.
+
+The function returns a keyword, indicating the result of the
+operation. One of the following keywords is returned:
+
+`:primary-owner': Service has become the primary owner of the
+requested name.
+
+`:in-queue': Service could not become the primary owner and has been
+placed in the queue.
+
+`:exists': Service is already in the queue.
+
+`:already-owner': Service is already the primary owner."
+
+ ;; Add ObjectManager handler.
+ (dbus-register-method
+ bus service nil dbus-interface-objectmanager "GetManagedObjects"
+ 'dbus-managed-objects-handler 'dont-register)
+
+ (let ((arg 0)
+ reply)
+ (dolist (flag flags)
+ (setq arg
+ (+ arg
+ (pcase flag
+ (:allow-replacement 1)
+ (:replace-existing 2)
+ (:do-not-queue 4)
+ (_ (signal 'wrong-type-argument (list flag)))))))
+ (setq reply (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "RequestName" service arg))
+ (pcase reply
+ (1 :primary-owner)
+ (2 :in-queue)
+ (3 :exists)
+ (4 :already-owner)
+ (_ (signal 'dbus-error (list "Could not register service" service))))))
+
+(defun dbus-unregister-service (bus service)
+ "Unregister all objects related to SERVICE from D-Bus BUS.
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address. SERVICE must be a known service name.
+
+The function returns a keyword, indicating the result of the
+operation. One of the following keywords is returned:
+
+`:released': Service has become the primary owner of the name.
+
+`:non-existent': Service name does not exist on this bus.
+
+`:not-owner': We are neither the primary owner nor waiting in the
+queue of this service."
+
+ (maphash
+ (lambda (key value)
+ (dolist (elt value)
+ (ignore-errors
+ (when (and (equal bus (cadr key)) (string-equal service (cadr elt)))
+ (unless
+ (puthash key (delete elt value) dbus-registered-objects-table)
+ (remhash key dbus-registered-objects-table))))))
+ dbus-registered-objects-table)
+ (let ((reply (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "ReleaseName" service)))
+ (pcase reply
+ (1 :released)
+ (2 :non-existent)
+ (3 :not-owner)
+ (_ (signal 'dbus-error (list "Could not unregister service" service))))))
+
+(defun dbus-register-signal
+ (bus service path interface signal handler &rest args)
+ "Register for a signal on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name used by the sending D-Bus object.
+It can be either a known name or the unique name of the D-Bus object
+sending the signal.
+
+PATH is the D-Bus object path SERVICE is registered. INTERFACE
+is an interface offered by SERVICE. It must provide SIGNAL.
+HANDLER is a Lisp function to be called when the signal is
+received. It must accept as arguments the values SIGNAL is
+sending.
+
+SERVICE, PATH, INTERFACE and SIGNAL can be nil. This is
+interpreted as a wildcard for the respective argument.
+
+The remaining arguments ARGS can be keywords or keyword string pairs.
+The meaning is as follows:
+
+`:argN' STRING:
+`:pathN' STRING: This stands for the Nth argument of the
+signal. `:pathN' arguments can be used for object path wildcard
+matches as specified by D-Bus, while an `:argN' argument
+requires an exact match.
+
+`:arg-namespace' STRING: Register for the signals, which first
+argument defines the service or interface namespace STRING.
+
+`:path-namespace' STRING: Register for the object path namespace
+STRING. All signals sent from an object path, which has STRING as
+the preceding string, are matched. This requires PATH to be nil.
+
+`:eavesdrop': Register for unicast signals which are not directed
+to the D-Bus object Emacs is registered at D-Bus BUS, if the
+security policy of BUS allows this.
+
+Example:
+
+\(defun my-signal-handler (device)
+ (message \"Device %s added\" device))
+
+\(dbus-register-signal
+ :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
+ \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" 'my-signal-handler)
+
+ => \(\(:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
+ \(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
+
+`dbus-register-signal' returns an object, which can be used in
+`dbus-unregister-object' for removing the registration."
+
+ (let ((counter 0)
+ (rule "type='signal'")
+ uname key key1 value)
+
+ ;; Retrieve unique name of service. If service is a known name,
+ ;; we will register for the corresponding unique name, if any.
+ ;; Signals are sent always with the unique name as sender. Note:
+ ;; the unique name of `dbus-service-dbus' is that string itself.
+ (if (and (stringp service)
+ (not (zerop (length service)))
+ (not (string-equal service dbus-service-dbus))
+ (not (string-match "^:" service)))
+ (setq uname (dbus-get-name-owner bus service))
+ (setq uname service))
+
+ (setq rule (concat rule
+ (when uname (format ",sender='%s'" uname))
+ (when interface (format ",interface='%s'" interface))
+ (when signal (format ",member='%s'" signal))
+ (when path (format ",path='%s'" path))))
+
+ ;; Add arguments to the rule.
+ (if (or (stringp (car args)) (null (car args)))
+ ;; As backward compatibility option, we allow just strings.
+ (dolist (arg args)
+ (if (stringp arg)
+ (setq rule (concat rule (format ",arg%d='%s'" counter arg)))
+ (if arg (signal 'wrong-type-argument (list "Wrong argument" arg))))
+ (setq counter (1+ counter)))
+
+ ;; Parse keywords.
+ (while args
+ (setq
+ key (car args)
+ rule (concat
+ rule
+ (cond
+ ;; `:arg0' .. `:arg63', `:path0' .. `:path63'.
+ ((and (keywordp key)
+ (string-match
+ "^:\\(arg\\|path\\)\\([[:digit:]]+\\)$"
+ (symbol-name key)))
+ (setq counter (match-string 2 (symbol-name key))
+ args (cdr args)
+ value (car args))
+ (unless (and (<= counter 63) (stringp value))
+ (signal 'wrong-type-argument
+ (list "Wrong argument" key value)))
+ (format
+ ",arg%s%s='%s'"
+ counter
+ (if (string-equal (match-string 1 (symbol-name key)) "path")
+ "path" "")
+ value))
+ ;; `:arg-namespace', `:path-namespace'.
+ ((and (keywordp key)
+ (string-match
+ "^:\\(arg\\|path\\)-namespace$" (symbol-name key)))
+ (setq args (cdr args)
+ value (car args))
+ (unless (stringp value)
+ (signal 'wrong-type-argument
+ (list "Wrong argument" key value)))
+ (format
+ ",%s='%s'"
+ (if (string-equal (match-string 1 (symbol-name key)) "path")
+ "path_namespace" "arg0namespace")
+ value))
+ ;; `:eavesdrop'.
+ ((eq key :eavesdrop)
+ ",eavesdrop='true'")
+ (t (signal 'wrong-type-argument (list "Wrong argument" key)))))
+ args (cdr args))))
+
+ ;; Add the rule to the bus.
+ (condition-case err
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "AddMatch" rule)
+ (dbus-error
+ (if (not (string-match "eavesdrop" rule))
+ (signal (car err) (cdr err))
+ ;; The D-Bus spec says we shall fall back to a rule without eavesdrop.
+ (when dbus-debug (message "Removing eavesdrop from rule %s" rule))
+ (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule))
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "AddMatch" rule))))
+
+ (when dbus-debug (message "Matching rule \"%s\" created" rule))
+
+ ;; Create a hash table entry.
+ (setq key (list :signal bus interface signal)
+ key1 (list uname service path handler rule)
+ value (gethash key dbus-registered-objects-table))
+ (unless (member key1 value)
+ (puthash key (cons key1 value) dbus-registered-objects-table))
+
+ ;; Return the object.
+ (list key (list service path handler))))
+
+(defun dbus-register-method
+ (bus service path interface method handler &optional dont-register-service)
+ "Register for method METHOD on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name of the D-Bus object METHOD is
+registered for. It must be a known name (See discussion of
+DONT-REGISTER-SERVICE below).
+
+PATH is the D-Bus object path SERVICE is registered (See discussion of
+DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
+SERVICE. It must provide METHOD.
+
+HANDLER is a Lisp function to be called when a method call is
+received. It must accept the input arguments of METHOD. The return
+value of HANDLER is used for composing the returning D-Bus message.
+In case HANDLER shall return a reply message with an empty argument
+list, HANDLER must return the symbol `:ignore'.
+
+When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
+registered. This means that other D-Bus clients have no way of
+noticing the newly registered method. When interfaces are constructed
+incrementally by adding single methods or properties at a time,
+DONT-REGISTER-SERVICE can be used to prevent other clients from
+discovering the still incomplete interface."
+
+ ;; Register SERVICE.
+ (unless (or dont-register-service
+ (member service (dbus-list-names bus)))
+ (dbus-register-service bus service))
+
+ ;; Create a hash table entry. We use nil for the unique name,
+ ;; because the method might be called from anybody.
+ (let* ((key (list :method bus interface method))
+ (key1 (list nil service path handler))
+ (value (gethash key dbus-registered-objects-table)))
+
+ (unless (member key1 value)
+ (puthash key (cons key1 value) dbus-registered-objects-table))
+
+ ;; Return the object.
+ (list key (list service path handler))))
+
(defun dbus-unregister-object (object)
"Unregister OBJECT from D-Bus.
OBJECT must be the result of a preceding `dbus-register-method',
;; Find the corresponding entry in the hash table.
(let* ((key (car object))
+ (type (car key))
+ (bus (cadr key))
(value (cadr object))
- (bus (car key))
(service (car value))
(entry (gethash key dbus-registered-objects-table))
ret)
- ;; key has the structure (BUS INTERFACE MEMBER).
+ ;; key has the structure (TYPE BUS INTERFACE MEMBER).
;; value has the structure (SERVICE PATH [HANDLER]).
;; entry has the structure ((UNAME SERVICE PATH MEMBER [RULE]) ...).
;; MEMBER is either a string (the handler), or a cons cell (a
(unless (puthash key (delete elt entry) dbus-registered-objects-table)
(remhash key dbus-registered-objects-table))
;; Remove match rule of signals.
- (let ((rule (nth 4 elt)))
- (when (stringp rule)
- (setq service nil) ; We do not need to unregister the service.
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "RemoveMatch" rule)))))
+ (when (eq type :signal)
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "RemoveMatch" (nth 4 elt)))))
+
;; Check, whether there is still a registered function or property
;; for the given service. If not, unregister the service from the
;; bus.
- (when service
- (dolist (elt entry)
- (let (found)
- (maphash
- (lambda (k v)
- (dolist (e v)
- (ignore-errors
- (when (and (equal bus (car k)) (string-equal service (cadr e)))
- (setq found t)))))
- dbus-registered-objects-table)
- (unless found
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "ReleaseName" service)))))
+ (when (and service (memq type '(:method :property))
+ (not (catch :found
+ (progn
+ (maphash
+ (lambda (k v)
+ (dolist (e v)
+ (ignore-errors
+ (and
+ ;; Bus.
+ (equal bus (cadr k))
+ ;; Service.
+ (string-equal service (cadr e))
+ ;; Non-empty object path.
+ (cl-caddr e)
+ (throw :found t)))))
+ dbus-registered-objects-table)
+ nil))))
+ (dbus-unregister-service bus service))
;; Return.
ret))
-(defun dbus-unregister-service (bus service)
- "Unregister all objects related to SERVICE from D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. SERVICE must be a known service name.
-
-The function returns a keyword, indicating the result of the
-operation. One of the following keywords is returned:
-
-`:released': Service has become the primary owner of the name.
-
-`:non-existent': Service name does not exist on this bus.
-
-`:not-owner': We are neither the primary owner nor waiting in the
-queue of this service."
-
- (maphash
- (lambda (key value)
- (dolist (elt value)
- (ignore-errors
- (when (and (equal bus (car key)) (string-equal service (cadr elt)))
- (unless
- (puthash key (delete elt value) dbus-registered-objects-table)
- (remhash key dbus-registered-objects-table))))))
- dbus-registered-objects-table)
- (let ((reply (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "ReleaseName" service)))
- (case reply
- (1 :released)
- (2 :non-existent)
- (3 :not-owner)
- (t (signal 'dbus-error (list "Could not unregister service" service))))))
-
-(defun dbus-call-method-non-blocking-handler (&rest args)
- "Handler for reply messages of asynchronous D-Bus message calls.
-It calls the function stored in `dbus-registered-objects-table'.
-The result will be made available in `dbus-return-values-table'."
- (puthash (list (dbus-event-bus-name last-input-event)
- (dbus-event-serial-number last-input-event))
- (if (= (length args) 1) (car args) args)
- dbus-return-values-table))
-
-(defun dbus-call-method-non-blocking
- (bus service path interface method &rest args)
- "Call METHOD on the D-Bus BUS, but don't block the event queue.
-This is necessary for communicating to registered D-Bus methods,
-which are running in the same Emacs process.
-
-The arguments are the same as in `dbus-call-method'.
-
-usage: (dbus-call-method-non-blocking
- BUS SERVICE PATH INTERFACE METHOD
- &optional :timeout TIMEOUT &rest ARGS)"
-
- (let ((key
- (apply
- 'dbus-call-method-asynchronously
- bus service path interface method
- 'dbus-call-method-non-blocking-handler args)))
- ;; Wait until `dbus-call-method-non-blocking-handler' has put the
- ;; result into `dbus-return-values-table'.
- (while (eq (gethash key dbus-return-values-table :ignore) :ignore)
- (read-event nil nil 0.1))
-
- ;; Cleanup `dbus-return-values-table'. Return the result.
- (prog1
- (gethash key dbus-return-values-table nil)
- (remhash key dbus-return-values-table))))
-
-(defun dbus-name-owner-changed-handler (&rest args)
- "Reapplies all member registrations to D-Bus.
-This handler is applied when a \"NameOwnerChanged\" signal has
-arrived. SERVICE is the object name for which the name owner has
-been changed. OLD-OWNER is the previous owner of SERVICE, or the
-empty string if SERVICE was not owned yet. NEW-OWNER is the new
-owner of SERVICE, or the empty string if SERVICE loses any name owner.
-
-usage: (dbus-name-owner-changed-handler service old-owner new-owner)"
- (save-match-data
- ;; Check the arguments. We should silently ignore it when they
- ;; are wrong.
- (if (and (= (length args) 3)
- (stringp (car args))
- (stringp (cadr args))
- (stringp (caddr args)))
- (let ((service (car args))
- (old-owner (cadr args))
- (new-owner (caddr args)))
- ;; Check whether SERVICE is a known name.
- (when (not (string-match "^:" service))
- (maphash
- (lambda (key value)
- (dolist (elt value)
- ;; key has the structure (BUS INTERFACE MEMBER).
- ;; elt has the structure (UNAME SERVICE PATH HANDLER).
- (when (string-equal old-owner (car elt))
- ;; Remove old key, and add new entry with changed name.
- (dbus-unregister-object (list key (cdr elt)))
- ;; Maybe we could arrange the lists a little bit better
- ;; that we don't need to extract every single element?
- (dbus-register-signal
- ;; BUS SERVICE PATH
- (nth 0 key) (nth 1 elt) (nth 2 elt)
- ;; INTERFACE MEMBER HANDLER
- (nth 1 key) (nth 2 key) (nth 3 elt)))))
- (copy-hash-table dbus-registered-objects-table))))
- ;; The error is reported only in debug mode.
- (when dbus-debug
- (signal
- 'dbus-error
- (cons
- (format "Wrong arguments of %s.NameOwnerChanged" dbus-interface-dbus)
- args))))))
-
-;; Register the handler.
-(when nil ;ignore-errors
- (dbus-register-signal
- :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "NameOwnerChanged" 'dbus-name-owner-changed-handler)
- (dbus-register-signal
- :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "NameOwnerChanged" 'dbus-name-owner-changed-handler))
-
\f
;;; D-Bus type conversion.
(dbus-ignore-errors
(if (eq result :ignore)
(dbus-method-return-internal
- (nth 1 event) (nth 3 event) (nth 4 event))
+ (nth 1 event) (nth 4 event) (nth 3 event))
(apply 'dbus-method-return-internal
- (nth 1 event) (nth 3 event) (nth 4 event)
+ (nth 1 event) (nth 4 event) (nth 3 event)
(if (consp result) result (list result)))))))
;; Error handling.
(dbus-error
(when (= dbus-message-type-method-call (nth 2 event))
(dbus-ignore-errors
(dbus-method-error-internal
- (nth 1 event) (nth 3 event) (nth 4 event) (cadr err))))
+ (nth 1 event) (nth 4 event) (nth 3 event) (cadr err))))
;; Propagate D-Bus error messages.
(run-hook-with-args 'dbus-event-error-hooks event err)
(when (or dbus-debug (= dbus-message-type-error (nth 2 event)))
and PATH must be a valid object path. The last two parameters
are strings. The result, the introspection data, is a string in
XML format."
- ;; We don't want to raise errors. `dbus-call-method-non-blocking'
- ;; is used, because the handler can be registered in our Emacs
- ;; instance; caller an callee would block each other.
+ ;; We don't want to raise errors.
(dbus-ignore-errors
- (funcall
- (if noninteractive 'dbus-call-method 'dbus-call-method-non-blocking)
- bus service path dbus-interface-introspectable "Introspect")))
+ (dbus-call-method
+ bus service path dbus-interface-introspectable "Introspect"
+ :timeout 1000)))
(defun dbus-introspect-xml (bus service path)
"Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
It will be checked at BUS, SERVICE, PATH. The result can be any
valid D-Bus value, or `nil' if there is no PROPERTY."
(dbus-ignore-errors
- ;; "Get" returns a variant, so we must use the `car'.
- (car
- (funcall
- (if noninteractive 'dbus-call-method 'dbus-call-method-non-blocking)
- bus service path dbus-interface-properties
- "Get" :timeout 500 interface property))))
+ ;; "Get" returns a variant, so we must use the `car'.
+ (car
+ (dbus-call-method
+ bus service path dbus-interface-properties
+ "Get" :timeout 500 interface property))))
(defun dbus-set-property (bus service path interface property value)
"Set value of PROPERTY of INTERFACE to VALUE.
been set successful, the result is VALUE. Otherwise, `nil' is
returned."
(dbus-ignore-errors
- ;; "Set" requires a variant.
- (funcall
- (if noninteractive 'dbus-call-method 'dbus-call-method-non-blocking)
- bus service path dbus-interface-properties
- "Set" :timeout 500 interface property (list :variant value))
- ;; Return VALUE.
- (dbus-get-property bus service path interface property)))
+ ;; "Set" requires a variant.
+ (dbus-call-method
+ bus service path dbus-interface-properties
+ "Set" :timeout 500 interface property (list :variant value))
+ ;; Return VALUE.
+ (dbus-get-property bus service path interface property)))
(defun dbus-get-all-properties (bus service path interface)
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
;; "GetAll" returns "a{sv}".
(let (result)
(dolist (dict
- (funcall
- (if noninteractive
- 'dbus-call-method
- 'dbus-call-method-non-blocking)
+ (dbus-call-method
bus service path dbus-interface-properties
"GetAll" :timeout 500 interface)
result)
- (add-to-list 'result (cons (car dict) (caadr dict)) 'append)))))
+ (add-to-list 'result (cons (car dict) (cl-caadr dict)) 'append)))))
(defun dbus-register-property
(bus service path interface property access value
at a time, DONT-REGISTER-SERVICE can be used to prevent other
clients from discovering the still incomplete interface."
(unless (member access '(:read :readwrite))
- (signal 'dbus-error (list "Access type invalid" access)))
-
- ;; Register SERVICE.
- (unless (or dont-register-service
- (member service (dbus-list-names bus)))
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "RequestName" service 0))
+ (signal 'wrong-type-argument (list "Access type invalid" access)))
;; Add handlers for the three property-related methods.
(dbus-register-method
bus service path dbus-interface-properties "Set"
'dbus-property-handler 'dont-register)
- ;; Register the name SERVICE with BUS.
- (unless dont-register-service
+ ;; Register SERVICE.
+ (unless (or dont-register-service (member service (dbus-list-names bus)))
(dbus-register-service bus service))
;; Send the PropertiesChanged signal.
(when emits-signal
(dbus-send-signal
bus service path dbus-interface-properties "PropertiesChanged"
- (list (list :dict-entry property (list :variant value)))
+ `((:dict-entry ,property (:variant ,value)))
'(:array)))
;; Create a hash table entry. We use nil for the unique name,
;; because the property might be accessed from anybody.
- (let ((key (list bus interface property))
+ (let ((key (list :property bus interface property))
(val
(list
(list
(defun dbus-property-handler (&rest args)
"Default handler for the \"org.freedesktop.DBus.Properties\" interface.
-It will be registered for all objects created by `dbus-register-object'."
+It will be registered for all objects created by `dbus-register-property'."
(let ((bus (dbus-event-bus-name last-input-event))
(service (dbus-event-service-name last-input-event))
(path (dbus-event-path-name last-input-event))
(cond
;; "Get" returns a variant.
((string-equal method "Get")
- (let ((entry (gethash (list bus interface property)
+ (let ((entry (gethash (list :property bus interface property)
dbus-registered-objects-table)))
(when (string-equal path (nth 2 (car entry)))
- (list (list :variant (cdar (last (car entry))))))))
+ `((:variant ,(cdar (last (car entry))))))))
;; "Set" expects a variant.
((string-equal method "Set")
(let* ((value (caar (cddr args)))
- (entry (gethash (list bus interface property)
+ (entry (gethash (list :property bus interface property)
dbus-registered-objects-table))
;; The value of the hash table is a list; in case of
;; properties it contains just one element (UNAME SERVICE
(unless (member :readwrite (car object))
(signal 'dbus-error
(list "Property not writable at path" property path)))
- (puthash (list bus interface property)
+ (puthash (list :property bus interface property)
(list (append (butlast (car entry))
(list (cons (car object) value))))
dbus-registered-objects-table)
(when (member :emits-signal (car object))
(dbus-send-signal
bus service path dbus-interface-properties "PropertiesChanged"
- (list (list :dict-entry property (list :variant value)))
+ `((:dict-entry ,property (:variant ,value)))
'(:array)))
;; Return empty reply.
:ignore))
(let (result)
(maphash
(lambda (key val)
- (when (and (equal (butlast key) (list bus interface))
+ (when (and (equal (butlast key) (list :property bus interface))
(string-equal path (nth 2 (car val)))
(not (functionp (car (last (car val))))))
(add-to-list
;; Return the result, or an empty array.
(list :array (or result '(:signature "{sv}"))))))))
+\f
+;;; D-Bus object manager.
+
+(defun dbus-get-all-managed-objects (bus service path)
+ "Return all objects at BUS, SERVICE, PATH, and the children of PATH.
+The result is a list of objects. Every object is a cons of an
+existing path name, and the list of available interface objects.
+An interface object is another cons, which car is the interface
+name, and the cdr is the list of properties as returned by
+`dbus-get-all-properties' for that path and interface. Example:
+
+\(dbus-get-all-managed-objects :session \"org.gnome.SettingsDaemon\" \"/\")
+
+ => \(\(\"/org/gnome/SettingsDaemon/MediaKeys\"
+ \(\"org.gnome.SettingsDaemon.MediaKeys\")
+ \(\"org.freedesktop.DBus.Peer\")
+ \(\"org.freedesktop.DBus.Introspectable\")
+ \(\"org.freedesktop.DBus.Properties\")
+ \(\"org.freedesktop.DBus.ObjectManager\"))
+ \(\"/org/gnome/SettingsDaemon/Power\"
+ \(\"org.gnome.SettingsDaemon.Power.Keyboard\")
+ \(\"org.gnome.SettingsDaemon.Power.Screen\")
+ \(\"org.gnome.SettingsDaemon.Power\"
+ \(\"Icon\" . \". GThemedIcon battery-full-charged-symbolic \")
+ \(\"Tooltip\" . \"Laptop battery is charged\"))
+ \(\"org.freedesktop.DBus.Peer\")
+ \(\"org.freedesktop.DBus.Introspectable\")
+ \(\"org.freedesktop.DBus.Properties\")
+ \(\"org.freedesktop.DBus.ObjectManager\"))
+ ...)
+
+If possible, \"org.freedesktop.DBus.ObjectManager.GetManagedObjects\"
+is used for retrieving the information. Otherwise, the information
+is collected via \"org.freedesktop.DBus.Introspectable.Introspect\"
+and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
+ (let ((result
+ ;; Direct call. Fails, if the target does not support the
+ ;; object manager interface.
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus service path dbus-interface-objectmanager
+ "GetManagedObjects" :timeout 1000))))
+
+ (if result
+ ;; Massage the returned structure.
+ (dolist (entry result result)
+ ;; "a{oa{sa{sv}}}".
+ (dolist (entry1 (cdr entry))
+ ;; "a{sa{sv}}".
+ (dolist (entry2 entry1)
+ ;; "a{sv}".
+ (if (cadr entry2)
+ ;; "sv".
+ (dolist (entry3 (cadr entry2))
+ (setcdr entry3 (cl-caadr entry3)))
+ (setcdr entry2 nil)))))
+
+ ;; Fallback: collect the information. Slooow!
+ (dolist (object
+ (dbus-introspect-get-all-nodes bus service path)
+ result)
+ (let (result1)
+ (dolist
+ (interface
+ (dbus-introspect-get-interface-names bus service object)
+ result1)
+ (add-to-list
+ 'result1
+ (cons interface
+ (dbus-get-all-properties bus service object interface))))
+ (when result1
+ (add-to-list 'result (cons object result1))))))))
+
+(defun dbus-managed-objects-handler ()
+ "Default handler for the \"org.freedesktop.DBus.ObjectManager\" interface.
+It will be registered for all objects created by `dbus-register-method'."
+ (let* ((last-input-event last-input-event)
+ (bus (dbus-event-bus-name last-input-event))
+ (service (dbus-event-service-name last-input-event))
+ (path (dbus-event-path-name last-input-event)))
+ ;; "GetManagedObjects" returns "a{oa{sa{sv}}}".
+ (let (interfaces result)
+
+ ;; Check for object path wildcard interfaces.
+ (maphash
+ (lambda (key val)
+ (when (and (equal (butlast key 2) (list :method bus))
+ (null (nth 2 (car-safe val))))
+ (add-to-list 'interfaces (nth 2 key))))
+ dbus-registered-objects-table)
+
+ ;; Check all registered object paths.
+ (maphash
+ (lambda (key val)
+ (let ((object (or (nth 2 (car-safe val)) ""))
+ (interface (nth 2 key)))
+ (when (and (equal (butlast key 2) (list :method bus))
+ (string-prefix-p path object))
+ (dolist (interface (cons (nth 2 key) interfaces))
+ (unless (assoc object result)
+ (add-to-list 'result (list object)))
+ (unless (assoc interface (cdr (assoc object result)))
+ (setcdr
+ (assoc object result)
+ (append
+ (list (cons
+ interface
+ ;; We simulate "org.freedesktop.DBus.Properties.GetAll"
+ ;; by using an appropriate D-Bus event.
+ (let ((last-input-event
+ (append
+ (butlast last-input-event 4)
+ (list object dbus-interface-properties
+ "GetAll" 'dbus-property-handler))))
+ (dbus-property-handler interface))))
+ (cdr (assoc object result)))))))))
+ dbus-registered-objects-table)
+
+ ;; Return the result, or an empty array.
+ (list
+ :array
+ (or
+ (mapcar
+ (lambda (x)
+ (list
+ :dict-entry :object-path (car x)
+ (cons :array (mapcar (lambda (y) (cons :dict-entry y)) (cdr x)))))
+ result)
+ '(:signature "{oa{sa{sv}}}"))))))
+
\f
-;; Initialize :system and :session buses. This adds their file
+;; Initialize `:system' and `:session' buses. This adds their file
;; descriptors to input_wait_mask, in order to detect incoming
;; messages immediately.
(when (featurep 'dbusbind)
(dbus-ignore-errors
- (dbus-init-bus :system)
+ (dbus-init-bus :system))
+ (dbus-ignore-errors
(dbus-init-bus :session)))
(provide 'dbus)
+;;; TODO:
+
+;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
+;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
+
;;; dbus.el ends here
(eval-and-compile
(if (not (fboundp 'make-overlay))
- (require 'overlay))
- (if (not (fboundp 'unless))
- (require 'cl)))
+ (require 'overlay)))
(unless (fboundp 'custom-menu-create)
(autoload 'custom-menu-create "cus-edit"))
;;; Load the options file
(if (and (not noninteractive)
(and (locate-library eudc-options-file)
- (progn (message "") t)) ; Remove modeline message
+ (progn (message "") t)) ; Remove mode line message
(not (featurep 'eudc-options-file)))
(load eudc-options-file))
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup gnutls nil
"Emacs interface to the GnuTLS library."
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
(declare-function gnutls-errorp "gnutls.c" (error))
-(defun* gnutls-negotiate
+(cl-defun gnutls-negotiate
(&rest spec
&key process type hostname priority-string
trustfiles crlfiles keylist min-prime-bits
;; INSTALLATION
;;
;; To use goto-address in a particular mode (for example, while
-;; reading mail in mh-e), add something like this in your .emacs file:
+;; reading mail in mh-e), add this to your init file:
;;
;; (add-hook 'mh-show-mode-hook 'goto-address)
;;
;; I don't expect users to want fontify'ing without highlighting.
(defcustom goto-address-fontify-p t
- "*Non-nil means URLs and e-mail addresses in buffer are fontified.
+ "Non-nil means URLs and e-mail addresses in buffer are fontified.
But only if `goto-address-highlight-p' is also non-nil."
:type 'boolean
:group 'goto-address)
(defcustom goto-address-highlight-p t
- "*Non-nil means URLs and e-mail addresses in buffer are highlighted."
+ "Non-nil means URLs and e-mail addresses in buffer are highlighted."
:type 'boolean
:group 'goto-address)
(defcustom goto-address-fontify-maximum-size 30000
- "*Maximum size of file in which to fontify and/or highlight URLs.
+ "Maximum size of file in which to fontify and/or highlight URLs.
A value of t means there is no limit--fontify regardless of the size."
:type '(choice (integer :tag "Maximum size") (const :tag "No limit" t))
:group 'goto-address)
;; 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
:type '(repeat string))
(defcustom imap-process-connection-type nil
- "*Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell, and SSL.
+ "Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell, and SSL.
The `process-connection-type' variable controls the type of device
used to communicate with subprocesses. Values are nil to use a
pipe, or t or `pty' to use a pty. The value has no effect if the
(symbol-name system-type))
1.0
0.1)
- "*How long to wait between checking for the end of output.
+ "How long to wait between checking for the end of output.
Shorter values mean quicker response, but is more CPU intensive."
:type 'number
:group 'imap)
(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)
(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)
(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
(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
(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."
rights))))))
(defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
- "Remove any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER."
+ "Remove <id,rights> 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
(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 ")
(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)))))
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) " <")
;; ; 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
;;; Code:
(require 'custom)
-(eval-when-compile (require 'cl))
(autoload 'auth-source-search "auth-source")
(error "No LDAP host specified"))
(let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
result)
- (setq result (ldap-search-internal (list* 'host host
- 'filter filter
- 'attributes attributes
- 'attrsonly attrsonly
- 'withdn withdn
- host-plist)))
+ (setq result (ldap-search-internal `(host ,host
+ filter ,filter
+ attributes ,attributes
+ attrsonly ,attrsonly
+ withdn ,withdn
+ ,@host-plist)))
(if ldap-ignore-attribute-codings
result
(mapcar (lambda (record)
(require 'widget)
(require 'cus-edit)
-(eval-when-compile
- (require 'cl))
;;; Keymappings
(eq type (car (cddr service)))))))
(car service)))
-(defun netrc-find-service-number (name &optional type)
- (let ((services (netrc-parse-services))
- service)
- (setq type (or type 'tcp))
- (while (and (setq service (pop services))
- (not (and (string= name (car service))
- (eq type (car (cddr service)))))))
- (cadr service)))
-
-(defun netrc-store-data (file host port user password)
- (with-temp-buffer
- (when (file-exists-p file)
- (insert-file-contents file))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (insert (format "machine %s login %s password %s port %s\n"
- host user password port))
- (write-region (point-min) (point-max) file nil 'silent)))
-
;;;###autoload
(defun netrc-credentials (machine &rest ports)
"Return a user name/password pair.
"Name of the newsticker cache file."
:type 'string
:group 'newsticker-miscellaneous)
-(make-obsolete 'newsticker-cache-filename 'newsticker-dir "23.1")
+(make-obsolete-variable 'newsticker-cache-filename 'newsticker-dir "23.1")
(defcustom newsticker-dir
(locate-user-emacs-file "newsticker/" ".newsticker/")
;; ======================================================================
;; faces
-(defface newsticker-new-item-face
- '((((class color) (background dark))
- (:family "sans" :bold t))
- (((class color) (background light))
- (:family "sans" :bold t)))
+(defface newsticker-new-item-face '((t :weight bold))
"Face for new news items."
:group 'newsticker-faces)
(defface newsticker-old-item-face
- '((((class color) (background dark))
- (:family "sans" :bold t :foreground "orange3"))
- (((class color) (background light))
- (:family "sans" :bold t :foreground "red4")))
+ '((default :weight bold)
+ (((class color) (background dark)) :foreground "orange3")
+ (((class color) (background light)) :foreground "red4"))
"Face for old news items."
:group 'newsticker-faces)
(defface newsticker-immortal-item-face
- '((((class color) (background dark))
- (:family "sans" :bold t :italic t :foreground "orange"))
- (((class color) (background light))
- (:family "sans" :bold t :italic t :foreground "blue")))
+ '((default :weight bold :slant italic)
+ (((class color) (background dark)) :foreground "orange")
+ (((class color) (background light)) :foreground "blue"))
"Face for immortal news items."
:group 'newsticker-faces)
(defface newsticker-obsolete-item-face
- '((((class color) (background dark))
- (:family "sans" :bold t :strike-through t))
- (((class color) (background light))
- (:family "sans" :bold t :strike-through t)))
+ '((t :weight bold :strike-through t))
"Face for old news items."
:group 'newsticker-faces)
-(defface newsticker-date-face
- '((((class color) (background dark))
- (:family "sans" :italic t :height 0.8))
- (((class color) (background light))
- (:family "sans" :italic t :height 0.8)))
+(defface newsticker-date-face '((t :slant italic :height 0.8))
"Face for newsticker dates."
:group 'newsticker-faces)
-(defface newsticker-statistics-face
- '((((class color) (background dark))
- (:family "sans" :italic t :height 0.8))
- (((class color) (background light))
- (:family "sans" :italic t :height 0.8)))
+(defface newsticker-statistics-face '((t :slant italic :height 0.8))
"Face for newsticker dates."
:group 'newsticker-faces)
-(defface newsticker-default-face
- '((((class color) (background dark))
- (:inherit default))
- (((class color) (background light))
- (:inherit default)))
+(defface newsticker-default-face '((t))
"Face for the description of news items."
- ;;:set 'newsticker--set-customvar
:group 'newsticker-faces)
(defcustom newsticker-hide-old-items-in-newsticker-buffer
:group 'newsticker-reader)
(defface newsticker-feed-face
- '((((class color) (background dark))
- (:family "sans" :bold t :height 1.2 :foreground "white"))
- (((class color) (background light))
- (:family "sans" :bold t :height 1.2 :foreground "black")))
+ '((default :weight bold :height 1.2)
+ (((class color) (background dark)) :foreground "white")
+ (((class color) (background light)) :foreground "black"))
"Face for news feeds."
:group 'newsticker-faces)
(defface newsticker-extra-face
- '((((class color) (background dark))
- (:italic t :foreground "gray50" :height 0.8))
- (((class color) (background light))
- (:italic t :foreground "gray50" :height 0.8)))
+ '((default :slant italic :height 0.8)
+ (((class color) (background dark)) :foreground "gray50")
+ (((class color) (background light)) :foreground "gray50"))
"Face for newsticker dates."
:group 'newsticker-faces)
(defface newsticker-enclosure-face
- '((((class color) (background dark))
- (:bold t :background "orange"))
- (((class color) (background light))
- (:bold t :background "orange")))
+ '((default :weight bold)
+ (((class color) (background dark)) :background "orange")
+ (((class color) (background light)) :background "orange"))
"Face for enclosed elements."
:group 'newsticker-faces)
-;; newst-ticker.el --- modeline ticker for newsticker.
+;; newst-ticker.el --- mode line ticker for newsticker.
;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
:group 'newsticker-reader)
(defface newsticker-treeview-face
- '((((class color) (background dark))
- (:family "sans" :foreground "white" :bold nil))
- (((class color) (background light))
- (:family "sans" :foreground "black" :bold nil)))
+ '((((class color) (background dark)) :foreground "white")
+ (((class color) (background light)) :foreground "black"))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-new-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face :bold t))
- (((class color) (background light))
- (:inherit newsticker-treeview-face :bold t)))
+ '((t :inherit newsticker-treeview-face :weight bold))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-old-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face))
- (((class color) (background light))
- (:inherit newsticker-treeview-face)))
+ '((t :inherit newsticker-treeview-face))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-immortal-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face :foreground "orange" :italic t))
- (((class color) (background light))
- (:inherit newsticker-treeview-face :foreground "blue" :italic t)))
+ '((default :inherit newsticker-treeview-face :slant italic)
+ (((class color) (background dark)) :foreground "orange")
+ (((class color) (background light)) :foreground "blue"))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-obsolete-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face :strike-through t))
- (((class color) (background light))
- (:inherit newsticker-treeview-face :strike-through t)))
+ '((t :inherit newsticker-treeview-face :strike-through t))
"Face for newsticker tree."
:group 'newsticker-treeview)
(defface newsticker-treeview-selection-face
- '((((class color) (background dark))
- (:background "#bbbbff"))
- (((class color) (background light))
- (:background "#bbbbff")))
+ '((((class color) (background dark)) :background "#bbbbff")
+ (((class color) (background light)) :background "#bbbbff"))
"Face for newsticker selection."
:group 'newsticker-treeview)
"Name of the newsticker groups settings file."
:type 'string
:group 'newsticker-treeview)
-(make-obsolete 'newsticker-groups-filename 'newsticker-dir "23.1")
+(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
;; ======================================================================
;;; internal variables
;; If you are using Newsticker as part of GNU Emacs there is no need to
;; perform any installation steps in order to use Newsticker. Otherwise
;; place Newsticker in a directory where Emacs can find it. Add the
-;; following line to your Emacs startup file (`~/.emacs').
+;; following line to your init file:
;; (add-to-list 'load-path "/path/to/newsticker/")
;; (autoload 'newsticker-start "newsticker" "Emacs Newsticker" t)
;; (autoload 'newsticker-show-news "newsticker" "Emacs Newsticker" t)
;; -----
;; The command newsticker-show-news will display all available headlines in
;; a special buffer, called `*newsticker*'. It will also start the
-;; asynchronous download of headlines. The modeline in the `*newsticker*'
+;; asynchronous download of headlines. The mode line in the `*newsticker*'
;; buffer informs whenever new headlines have arrived. Clicking
;; mouse-button 2 or pressing RET in this buffer on a headline will call
;; browse-url to load the corresponding news story in your favorite web
;; Things we need:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'thingatpt)
(require 'pp)
(require 'browse-url)
:prefix "quickurl-")
(defcustom quickurl-url-file (convert-standard-filename "~/.quickurls")
- "*File that contains the URL list."
+ "File that contains the URL list."
:type 'file
:group 'quickurl)
(defcustom quickurl-format-function (lambda (url) (format "<URL:%s>" (quickurl-url-url url)))
- "*Function to format the URL before insertion into the current buffer."
+ "Function to format the URL before insertion into the current buffer."
:type 'function
:group 'quickurl)
(string<
(downcase (quickurl-url-description x))
(downcase (quickurl-url-description y))))))
- "*Function to sort the URL list."
+ "Function to sort the URL list."
:type 'function
:group 'quickurl)
(defcustom quickurl-grab-lookup-function #'current-word
- "*Function to grab the thing to lookup."
+ "Function to grab the thing to lookup."
:type 'function
:group 'quickurl)
(defcustom quickurl-assoc-function #'assoc-ignore-case
- "*Function to use for alist lookup into `quickurl-urls'."
+ "Function to use for alist lookup into `quickurl-urls'."
:type 'function
:group 'quickurl)
(defcustom quickurl-completion-ignore-case t
- "*Should `quickurl-ask' ignore case when doing the input lookup?"
+ "Should `quickurl-ask' ignore case when doing the input lookup?"
:type 'boolean
:group 'quickurl)
(defcustom quickurl-prefix ";; -*- lisp -*-\n\n"
- "*Text to write to `quickurl-url-file' before writing the URL list."
+ "Text to write to `quickurl-url-file' before writing the URL list."
:type 'string
:group 'quickurl)
(defcustom quickurl-postfix ""
- "*Text to write to `quickurl-url-file' after writing the URL list.
+ "Text to write to `quickurl-url-file' after writing the URL list.
See the constant `quickurl-reread-hook-postfix' for some example text that
could be used here."
:group 'quickurl)
(defcustom quickurl-list-mode-hook nil
- "*Hooks for `quickurl-list-mode'."
+ "Hooks for `quickurl-list-mode'."
:type 'hook
:group 'quickurl)
(setq quickurl-postfix quickurl-reread-hook-postfix)
-in your ~/.emacs (after loading/requiring quickurl).")
+in your init file (after loading/requiring quickurl).")
;; Non-customize variables.
(list keyword url comment)
(cons keyword url)))
-(defun quickurl-url-keyword (url)
+(defalias 'quickurl-url-keyword #'car
"Return the keyword for the URL.
-
-Note that this function is a setfable place."
- (car url))
-
-(defsetf quickurl-url-keyword (url) (store)
- `(setf (car ,url) ,store))
+\n\(fn URL)")
(defun quickurl-url-url (url)
"Return the actual URL of the URL.
Note that this function is a setfable place."
+ (declare (gv-setter (lambda (store)
+ `(setf (if (quickurl-url-commented-p ,url)
+ (cadr ,url)
+ (cdr ,url))
+ ,store))))
(if (quickurl-url-commented-p url)
(cadr url)
(cdr url)))
-(defsetf quickurl-url-url (url) (store)
- `
- (if (quickurl-url-commented-p ,url)
- (setf (cadr ,url) ,store)
- (setf (cdr ,url) ,store)))
-
(defun quickurl-url-comment (url)
"Get the comment from a URL.
If the URL has no comment an empty string is returned. Also note that this
function is a setfable place."
+ (declare
+ (gv-setter (lambda (store)
+ `(if (quickurl-url-commented-p ,url)
+ (if (zerop (length ,store))
+ (setf (cdr ,url) (cadr ,url))
+ (setf (nth 2 ,url) ,store))
+ (unless (zerop (length ,store))
+ (setf (cdr ,url) (list (cdr ,url) ,store)))))))
(if (quickurl-url-commented-p url)
(nth 2 url)
""))
-(defsetf quickurl-url-comment (url) (store)
- `
- (if (quickurl-url-commented-p ,url)
- (if (zerop (length ,store))
- (setf (cdr ,url) (cadr ,url))
- (setf (nth 2 ,url) ,store))
- (unless (zerop (length ,store))
- (setf (cdr ,url) (list (cdr ,url) ,store)))))
-
(defun quickurl-url-description (url)
"Return a description for the URL.
;; Main code:
-(defun* quickurl-read (&optional buffer)
+(cl-defun quickurl-read (&optional buffer)
"`read' the URL list from BUFFER into `quickurl-urls'.
BUFFER, if nil, defaults to current buffer.
Note that this function moves point to `point-min' before doing the `read'
It also restores point after the `read'."
(save-excursion
- (setf (point) (point-min))
+ (goto-char (point-min))
(setq quickurl-urls (funcall quickurl-sort-function
(read (or buffer (current-buffer)))))))
(message "Found %s" (quickurl-url-url url))))
;;;###autoload
-(defun* quickurl (&optional lookup)
+(cl-defun quickurl (&optional lookup)
"Insert a URL based on LOOKUP.
If not supplied LOOKUP is taken to be the word at point in the current
(defun quickurl-list-populate-buffer ()
"Populate the `quickurl-list' buffer."
(with-current-buffer (get-buffer quickurl-list-buffer-name)
- (let ((buffer-read-only nil)
- (fmt (format "%%-%ds %%s\n"
- (apply #'max (or (loop for url in quickurl-urls
- collect (length (quickurl-url-description url)))
- (list 20))))))
- (setf (buffer-string) "")
- (loop for url in quickurl-urls
- do (let ((start (point)))
- (insert (format fmt (quickurl-url-description url)
- (quickurl-url-url url)))
- (add-text-properties start (1- (point))
- '(mouse-face highlight
- help-echo "mouse-2: insert this URL"))))
- (setf (point) (point-min)))))
+ (let* ((sizes (or (cl-loop for url in quickurl-urls
+ collect (length (quickurl-url-description url)))
+ (list 20)))
+ (fmt (format "%%-%ds %%s\n" (apply #'max sizes)))
+ (inhibit-read-only t))
+ (erase-buffer)
+ (cl-loop for url in quickurl-urls
+ do (let ((start (point)))
+ (insert (format fmt (quickurl-url-description url)
+ (quickurl-url-url url)))
+ (add-text-properties
+ start (1- (point))
+ '(mouse-face highlight
+ help-echo "mouse-2: insert this URL"))))
+ (goto-char (point-min)))))
(defun quickurl-list-add-url (word url comment)
"Wrapper for `quickurl-add-url' that doesn't guess the parameters."
(defun quickurl-list-mouse-select (event)
"Select the URL under the mouse click."
(interactive "e")
- (setf (point) (posn-point (event-end event)))
+ (goto-char (posn-point (event-end event)))
(quickurl-list-insert-url))
(defun quickurl-list-insert (type)
(if url
(with-current-buffer quickurl-list-last-buffer
(insert
- (case type
- (url (funcall quickurl-format-function url))
- (naked-url (quickurl-url-url url))
- (with-lookup (format "%s <URL:%s>"
+ (pcase type
+ (`url (funcall quickurl-format-function url))
+ (`naked-url (quickurl-url-url url))
+ (`with-lookup (format "%s <URL:%s>"
(quickurl-url-keyword url)
(quickurl-url-url url)))
- (with-desc (format "%S <URL:%s>"
+ (`with-desc (format "%S <URL:%s>"
(quickurl-url-description url)
(quickurl-url-url url)))
- (lookup (quickurl-url-keyword url)))))
+ (`lookup (quickurl-url-keyword url)))))
(error "No URL details on that line"))
url))
;; one-to-one communication.
;; Rcirc has simple defaults and clear and consistent behavior.
-;; Message arrival timestamps, activity notification on the modeline,
+;; Message arrival timestamps, activity notification on the mode line,
;; message filling, nick completion, and keepalive pings are all
;; enabled by default, but can easily be adjusted or turned off. Each
;; discussion takes place in its own buffer and there is a single
:group 'rcirc)
(defcustom rcirc-fill-flag t
- "*Non-nil means line-wrap messages printed in channel buffers."
+ "Non-nil means line-wrap messages printed in channel buffers."
:type 'boolean
:group 'rcirc)
(defcustom rcirc-fill-column nil
- "*Column beyond which automatic line-wrapping should happen.
+ "Column beyond which automatic line-wrapping should happen.
If nil, use value of `fill-column'. If 'frame-width, use the
maximum frame width."
:type '(choice (const :tag "Value of `fill-column'")
:group 'rcirc)
(defcustom rcirc-fill-prefix nil
- "*Text to insert before filled lines.
+ "Text to insert before filled lines.
If nil, calculate the prefix dynamically to line up text
underneath each nick."
:type '(choice (const :tag "Dynamic" nil)
(make-variable-buffer-local 'rcirc-omit-mode)
(defcustom rcirc-time-format "%H:%M "
- "*Describes how timestamps are printed.
+ "Describes how timestamps are printed.
Used as the first arg to `format-time-string'."
:type 'string
:group 'rcirc)
(defcustom rcirc-input-ring-size 1024
- "*Size of input history ring."
+ "Size of input history ring."
:type 'integer
:group 'rcirc)
(defcustom rcirc-read-only-flag t
- "*Non-nil means make text in IRC buffers read-only."
+ "Non-nil means make text in IRC buffers read-only."
:type 'boolean
:group 'rcirc)
(defcustom rcirc-buffer-maximum-lines nil
- "*The maximum size in lines for rcirc buffers.
+ "The maximum size in lines for rcirc buffers.
Channel buffers are truncated from the top to be no greater than this
number. If zero or nil, no truncating is done."
:type '(choice (const :tag "No truncation" nil)
:group 'rcirc)
(defcustom rcirc-scroll-show-maximum-output t
- "*If non-nil, scroll buffer to keep the point at the bottom of
+ "If non-nil, scroll buffer to keep the point at the bottom of
the window."
:type 'boolean
:group 'rcirc)
:group 'rcirc)
(defcustom rcirc-auto-authenticate-flag t
- "*Non-nil means automatically send authentication string to server.
+ "Non-nil means automatically send authentication string to server.
See also `rcirc-authinfo'."
:type 'boolean
:group 'rcirc)
(defcustom rcirc-authenticate-before-join t
- "*Non-nil means authenticate to services before joining channels.
+ "Non-nil means authenticate to services before joining channels.
Currently only works with NickServ on some networks."
:version "24.1"
:type 'boolean
:type 'string
:group 'rcirc)
+(defcustom rcirc-kill-channel-buffers nil
+ "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.3"
+ :type 'boolean
+ :group 'rcirc)
+
(defvar rcirc-nick nil)
(defvar rcirc-prompt-start-marker nil)
"List of buffers with unviewed activity.")
(defvar rcirc-activity-string ""
- "String displayed in modeline representing `rcirc-activity'.")
+ "String displayed in mode line representing `rcirc-activity'.")
(put 'rcirc-activity-string 'risky-local-variable t)
(defvar rcirc-server-buffer nil
:group 'rcirc)
(defun rcirc-kill-buffer-hook ()
- "Part the channel when killing an rcirc buffer."
+ "Part the channel when killing an rcirc buffer.
+
+If `rcirc-kill-channel-buffers' is non-nil and the killed buffer
+is a server buffer, kills all of the channel buffers associated
+with it."
(when (eq major-mode 'rcirc-mode)
(when (and rcirc-log-flag
rcirc-log-directory)
(rcirc-log-write))
- (rcirc-clean-up-buffer "Killed buffer")))
+ (rcirc-clean-up-buffer "Killed buffer")
+ (when (and rcirc-buffer-alist ;; it's a server buffer
+ rcirc-kill-channel-buffers)
+ (dolist (channel rcirc-buffer-alist)
+ (kill-buffer (cdr channel))))))
(defun rcirc-change-major-mode-hook ()
"Part the channel when changing the major-mode."
(buffer-disable-undo)
(buffer-enable-undo))
- ;; record modeline activity
+ ;; record mode line activity
(when (and activity
(not rcirc-ignore-buffer-activity-flag)
(not (and rcirc-dim-nicks sender
buffers ","))
(defun rcirc-short-buffer-name (buffer)
- "Return a short name for BUFFER to use in the modeline indicator."
+ "Return a short name for BUFFER to use in the mode line indicator."
(with-current-buffer buffer
(or rcirc-short-buffer-name (buffer-name))))
:group 'faces)
(defface rcirc-my-nick ; font-lock-function-name-face
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
- (t (:inverse-video t :weight bold)))
- "The face used to highlight my messages."
+ '((((class color) (min-colors 88) (background light)) :foreground "Blue1")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 16) (background light)) :foreground "Blue")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 8)) :foreground "blue" :weight bold)
+ (t :inverse-video t :weight bold))
+ "Rcirc face for my messages."
:group 'rcirc-faces)
(defface rcirc-other-nick ; font-lock-variable-name-face
'((((class grayscale) (background light))
- (:foreground "Gray90" :weight bold :slant italic))
+ :foreground "Gray90" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "DimGray" :weight bold :slant italic))
- (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
- (t (:weight bold :slant italic)))
- "The face used to highlight other messages."
+ :foreground "DimGray" :weight bold :slant italic)
+ (((class color) (min-colors 88) (background light)) :foreground "DarkGoldenrod")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightGoldenrod")
+ (((class color) (min-colors 16) (background light)) :foreground "DarkGoldenrod")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightGoldenrod")
+ (((class color) (min-colors 8)) :foreground "yellow" :weight light)
+ (t :weight bold :slant italic))
+ "Rcirc face for other users' messages."
:group 'rcirc-faces)
(defface rcirc-bright-nick
'((((class grayscale) (background light))
- (:foreground "LightGray" :weight bold :underline t))
+ :foreground "LightGray" :weight bold :underline t)
(((class grayscale) (background dark))
- (:foreground "Gray50" :weight bold :underline t))
- (((class color) (min-colors 88) (background light)) (:foreground "CadetBlue"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 8)) (:foreground "magenta"))
- (t (:weight bold :underline t)))
- "Face used for nicks matched by `rcirc-bright-nicks'."
+ :foreground "Gray50" :weight bold :underline t)
+ (((class color) (min-colors 88) (background light)) :foreground "CadetBlue")
+ (((class color) (min-colors 88) (background dark)) :foreground "Aquamarine")
+ (((class color) (min-colors 16) (background light)) :foreground "CadetBlue")
+ (((class color) (min-colors 16) (background dark)) :foreground "Aquamarine")
+ (((class color) (min-colors 8)) :foreground "magenta")
+ (t :weight bold :underline t))
+ "Rcirc face for nicks matched by `rcirc-bright-nicks'."
:group 'rcirc-faces)
(defface rcirc-dim-nick
'((t :inherit default))
- "Face used for nicks in `rcirc-dim-nicks'."
+ "Rcirc face for nicks in `rcirc-dim-nicks'."
:group 'rcirc-faces)
(defface rcirc-server ; font-lock-comment-face
'((((class grayscale) (background light))
- (:foreground "DimGray" :weight bold :slant italic))
+ :foreground "DimGray" :weight bold :slant italic)
(((class grayscale) (background dark))
- (:foreground "LightGray" :weight bold :slant italic))
+ :foreground "LightGray" :weight bold :slant italic)
(((class color) (min-colors 88) (background light))
- (:foreground "Firebrick"))
+ :foreground "Firebrick")
(((class color) (min-colors 88) (background dark))
- (:foreground "chocolate1"))
+ :foreground "chocolate1")
(((class color) (min-colors 16) (background light))
- (:foreground "red"))
+ :foreground "red")
(((class color) (min-colors 16) (background dark))
- (:foreground "red1"))
- (((class color) (min-colors 8) (background light))
- )
- (((class color) (min-colors 8) (background dark))
- )
- (t (:weight bold :slant italic)))
- "The face used to highlight server messages."
+ :foreground "red1")
+ (((class color) (min-colors 8) (background light)))
+ (((class color) (min-colors 8) (background dark)))
+ (t :weight bold :slant italic))
+ "Rcirc face for server messages."
:group 'rcirc-faces)
(defface rcirc-server-prefix ; font-lock-comment-delimiter-face
:foreground "red")
(((class color) (min-colors 8) (background dark))
:foreground "red1"))
- "The face used to highlight server prefixes."
+ "Rcirc face for server prefixes."
:group 'rcirc-faces)
(defface rcirc-timestamp
- '((t (:inherit default)))
- "The face used to highlight timestamps."
+ '((t :inherit default))
+ "Rcirc face for timestamps."
:group 'rcirc-faces)
(defface rcirc-nick-in-message ; font-lock-keyword-face
- '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
- (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
- (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
- (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
- (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
- (t (:weight bold)))
- "The face used to highlight instances of your nick within messages."
+ '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "Purple")
+ (((class color) (min-colors 88) (background dark)) :foreground "Cyan1")
+ (((class color) (min-colors 16) (background light)) :foreground "Purple")
+ (((class color) (min-colors 16) (background dark)) :foreground "Cyan")
+ (((class color) (min-colors 8)) :foreground "cyan" :weight bold)
+ (t :weight bold))
+ "Rcirc face for instances of your nick within messages."
:group 'rcirc-faces)
-(defface rcirc-nick-in-message-full-line
- '((t (:bold t)))
- "The face used emphasize the entire message when your nick is mentioned."
+(defface rcirc-nick-in-message-full-line '((t :weight bold))
+ "Rcirc face for emphasizing the entire message when your nick is mentioned."
:group 'rcirc-faces)
(defface rcirc-prompt ; comint-highlight-prompt
- '((((min-colors 88) (background dark)) (:foreground "cyan1"))
- (((background dark)) (:foreground "cyan"))
- (t (:foreground "dark blue")))
- "The face used to highlight prompts."
+ '((((min-colors 88) (background dark)) :foreground "cyan1")
+ (((background dark)) :foreground "cyan")
+ (t :foreground "dark blue"))
+ "Rcirc face for prompts."
:group 'rcirc-faces)
(defface rcirc-track-nick
- '((((type tty)) (:inherit default))
- (t (:inverse-video t)))
- "The face used in the mode-line when your nick is mentioned."
+ '((((type tty)) :inherit default)
+ (t :inverse-video t))
+ "Rcirc face used in the mode-line when your nick is mentioned."
:group 'rcirc-faces)
-(defface rcirc-track-keyword
- '((t (:bold t )))
- "The face used in the mode-line when keywords are mentioned."
+(defface rcirc-track-keyword '((t :weight bold))
+ "Rcirc face used in the mode-line when keywords are mentioned."
:group 'rcirc-faces)
-(defface rcirc-url
- '((t (:bold t)))
- "The face used to highlight urls."
+(defface rcirc-url '((t :weight bold))
+ "Rcirc face used to highlight urls."
:group 'rcirc-faces)
-(defface rcirc-keyword
- '((t (:inherit highlight)))
- "The face used to highlight keywords."
+(defface rcirc-keyword '((t :inherit highlight))
+ "Rcirc face used to highlight keywords."
:group 'rcirc-faces)
\f
;; Don't use microseconds from (current-time), they may be unsupported.
;; Instead we use this randomly inited counter.
(setq sasl-unique-id-char
- (% (1+ (or sasl-unique-id-char (logand (random t) (1- (lsh 1 20)))))
+ (% (1+ (or sasl-unique-id-char (logand (random) (1- (lsh 1 20)))))
;; (current-time) returns 16-bit ints,
;; and 2^16*25 just fits into 4 digits i base 36.
(* 25 25)))
;; Pacify byte-compiler. D-Bus support in the Emacs core can be
;; disabled with configuration option "--without-dbus". Declare used
;; subroutines and variables of `dbus' therefore.
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
(defvar dbus-debug)
(require 'dbus)
(let ((item-path (secrets-item-path collection item)))
(unless (secrets-empty-path item-path)
(dbus-byte-array-to-string
- (caddr
+ (cl-caddr
(dbus-call-method
:session secrets-service item-path secrets-interface-item
"GetSecret" :object-path secrets-session-path))))))
;;; Code:
(eval-when-compile
- (require 'cl)
(require 'imenu) ; Need this stuff when compiling for imenu macros, etc.
(require 'tempo))
:group 'snmp)
(defvar snmp-tempo-tags nil
- "*Tempo tags for SNMP mode.")
+ "Tempo tags for SNMP mode.")
(defvar snmpv2-tempo-tags nil
- "*Tempo tags for SNMPv2 mode.")
+ "Tempo tags for SNMPv2 mode.")
;; Enable fontification for SNMP MIBs
(defvar snmp-font-lock-keywords-3
(append
'(("\\([^\n]+\\)[ \t]+::=[ \t]+\\(SEQUENCE\\)[ \t]+{"
- (1 font-lock-reference-face) (2 font-lock-keyword-face))
+ (1 font-lock-constant-face) (2 font-lock-keyword-face))
("::=[ \t]*{[ \t]*\\([a-z0-9].*[ \t]+\\)?\\([0-9]+\\)[ \t]*}"
- (1 font-lock-reference-face nil t) (2 font-lock-variable-name-face)))
+ (1 font-lock-constant-face nil t) (2 font-lock-variable-name-face)))
snmp-font-lock-keywords-2)
"Gaudy SNMP MIB mode expression highlighting.")
kind ; a symbol of: string, dateTime, long, int
)
+(defstruct (soap-simple-type (:include soap-basic-type))
+ enumeration)
+
(defstruct soap-sequence-element
name type nillable? multiple?)
(defun soap-default-xsd-types ()
"Return a namespace containing some of the XMLSchema types."
(let ((ns (make-soap-namespace :name "http://www.w3.org/2001/XMLSchema")))
- (dolist (type '("string" "dateTime" "boolean" "long" "int" "float"
- "base64Binary" "anyType" "Array" "byte[]"))
+ (dolist (type '("string" "dateTime" "boolean"
+ "long" "int" "integer" "unsignedInt" "byte" "float" "double"
+ "base64Binary" "anyType" "anyURI" "Array" "byte[]"))
(soap-namespace-put
(make-soap-basic-type :name type :kind (intern type))
ns))
(defun soap-default-soapenc-types ()
"Return a namespace containing some of the SOAPEnc types."
(let ((ns (make-soap-namespace
- :name "http://schemas.xmlsoap.org/soap/encoding/")))
- (dolist (type '("string" "dateTime" "boolean" "long" "int" "float"
- "base64Binary" "anyType" "Array" "byte[]"))
+ :name "http://schemas.xmlsoap.org/soap/encoding/")))
+ (dolist (type '("string" "dateTime" "boolean"
+ "long" "int" "integer" "unsignedInt" "byte" "float" "double"
+ "base64Binary" "anyType" "anyURI" "Array" "byte[]"))
(soap-namespace-put
(make-soap-basic-type :name type :kind (intern type))
ns))
(when resolver
(funcall resolver element wsdl))))
+(defun soap-resolve-references-for-simple-type (type wsdl)
+ "Resolve the base type for the simple TYPE using the WSDL
+ document."
+ (let ((kind (soap-basic-type-kind type)))
+ (unless (symbolp kind)
+ (let ((basic-type (soap-wsdl-get kind wsdl 'soap-basic-type-p)))
+ (setf (soap-basic-type-kind type)
+ (soap-basic-type-kind basic-type))))))
+
(defun soap-resolve-references-for-sequence-type (type wsdl)
"Resolve references for a sequence TYPE using WSDL document.
See also `soap-resolve-references-for-element' and
(let ((parent (soap-sequence-type-parent type)))
(when (or (consp parent) (stringp parent))
(setf (soap-sequence-type-parent type)
- (soap-wsdl-get parent wsdl 'soap-type-p))))
+ (soap-wsdl-get
+ parent wsdl
+ ;; Prevent self references, see Bug#9
+ (lambda (e) (and (not (eq e type)) (soap-type-p e)))))))
(dolist (element (soap-sequence-type-elements type))
(let ((element-type (soap-sequence-element-type element)))
(cond ((or (consp element-type) (stringp element-type))
(setf (soap-sequence-element-type element)
- (soap-wsdl-get element-type wsdl 'soap-type-p)))
+ (soap-wsdl-get
+ element-type wsdl
+ ;; Prevent self references, see Bug#9
+ (lambda (e) (and (not (eq e type)) (soap-type-p e))))))
((soap-element-p element-type)
;; since the element already has a child element, it
;; could be an inline structure. we must resolve
(let ((element-type (soap-array-type-element-type type)))
(when (or (consp element-type) (stringp element-type))
(setf (soap-array-type-element-type type)
- (soap-wsdl-get element-type wsdl 'soap-type-p)))))
+ (soap-wsdl-get
+ element-type wsdl
+ ;; Prevent self references, see Bug#9
+ (lambda (e) (and (not (eq e type)) (soap-type-p e))))))))
(defun soap-resolve-references-for-message (message wsdl)
"Resolve references for a MESSAGE type using the WSDL document.
;; Install resolvers for our types
(progn
+ (put (aref (make-soap-simple-type) 0) 'soap-resolve-references
+ 'soap-resolve-references-for-simple-type)
(put (aref (make-soap-sequence-type) 0) 'soap-resolve-references
'soap-resolve-references-for-sequence-type)
(put (aref (make-soap-array-type) 0) 'soap-resolve-references
(let ((ns (make-soap-namespace :name (soap-get-target-namespace node))))
;; NOTE: we only extract the complexTypes from the schema, we wouldn't
;; know how to handle basic types beyond the built in ones anyway.
+ (dolist (node (soap-xml-get-children1 node 'xsd:simpleType))
+ (soap-namespace-put (soap-parse-simple-type node) ns))
+
(dolist (node (soap-xml-get-children1 node 'xsd:complexType))
(soap-namespace-put (soap-parse-complex-type node) ns))
ns)))
+(defun soap-parse-simple-type (node)
+ "Parse NODE and construct a simple type from it."
+ (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:simpleType)
+ nil
+ "soap-parse-complex-type: expecting xsd:simpleType node, got %s"
+ (soap-l2wk (xml-node-name node)))
+ (let ((name (xml-get-attribute-or-nil node 'name))
+ type
+ enumeration
+ (restriction (car-safe
+ (soap-xml-get-children1 node 'xsd:restriction))))
+ (unless restriction
+ (error "simpleType %s has no base type" name))
+
+ (setq type (xml-get-attribute-or-nil restriction 'base))
+ (dolist (e (soap-xml-get-children1 restriction 'xsd:enumeration))
+ (push (xml-get-attribute e 'value) enumeration))
+
+ (make-soap-simple-type :name name :kind type :enumeration enumeration)))
+
(defun soap-parse-schema-element (node)
"Parse NODE and construct a schema element from it."
(assert (eq (soap-l2wk (xml-node-name node)) 'xsd:element)
extension 'xsd:sequence)))))
(restriction
(let ((base (xml-get-attribute-or-nil restriction 'base)))
- (assert (equal base "soapenc:Array")
+ (assert (equal base (soap-wk2l "soapenc:Array"))
nil
"restrictions supported only for soapenc:Array types, this is a %s"
base))
(if (null contents)
nil
(ecase type-kind
- (string (car contents))
+ ((string anyURI) (car contents))
(dateTime (car contents)) ; TODO: convert to a date time
- ((long int float) (string-to-number (car contents)))
+ ((long int integer unsignedInt byte float double) (string-to-number (car contents)))
(boolean (string= (downcase (car contents)) "true"))
(base64Binary (base64-decode-string (car contents)))
(anyType (soap-decode-any-type node))
(progn
(put (aref (make-soap-basic-type) 0)
'soap-decoder 'soap-decode-basic-type)
+ ;; just use the basic type decoder for the simple type -- we accept any
+ ;; value and don't do any validation on it.
+ (put (aref (make-soap-simple-type) 0)
+ 'soap-decoder 'soap-decode-basic-type)
(put (aref (make-soap-sequence-type) 0)
'soap-decoder 'soap-decode-sequence-type)
(put (aref (make-soap-array-type) 0)
fault 'faultcode))))
(car-safe (xml-node-children n))))
(fault-string (let ((n (car (xml-get-children
- fault 'faultstring))))
- (car-safe (xml-node-children n)))))
+ fault 'faultstring))))
+ (car-safe (xml-node-children n))))
+ (detail (xml-get-children fault 'detail)))
(while t
- (signal 'soap-error (list fault-code fault-string))))))
+ (signal 'soap-error (list fault-code fault-string detail))))))
;; First (non string) element of the body is the root node of he
;; response
(progn
(insert ">")
(case basic-type
- (string
+ ((string anyURI)
(unless (stringp value)
(error "Soap-encode-basic-type(%s, %s, %s): not a string value"
xml-tag value xsi-type))
xml-tag value xsi-type))
(insert (if value "true" "false")))
- ((long int)
+ ((long int integer byte unsignedInt)
(unless (integerp value)
(error "Soap-encode-basic-type(%s, %s, %s): not an integer value"
xml-tag value xsi-type))
+ (when (and (eq basic-type 'unsignedInt) (< value 0))
+ (error "Soap-encode-basic-type(%s, %s, %s): not a positive integer"
+ xml-tag value xsi-type))
+ (insert (number-to-string value)))
+
+ ((float double)
+ (unless (numberp value)
+ (error "Soap-encode-basic-type(%s, %s, %s): not a number"
+ xml-tag value xsi-type))
(insert (number-to-string value)))
(base64Binary
(insert " xsi:nil=\"true\">"))
(insert "</" xml-tag ">\n")))
+(defun soap-encode-simple-type (xml-tag value type)
+ "Encode inside XML-TAG the LISP VALUE according to TYPE."
+
+ ;; Validate VALUE against the simple type's enumeration, than just encode it
+ ;; using `soap-encode-basic-type'
+
+ (let ((enumeration (soap-simple-type-enumeration type)))
+ (unless (and (> (length enumeration) 1)
+ (member value enumeration))
+ (error "soap-encode-simple-type(%s, %s, %s): bad value, should be one of %s"
+ xml-tag value (soap-element-fq-name type) enumeration)))
+
+ (soap-encode-basic-type xml-tag value type))
+
(defun soap-encode-sequence-type (xml-tag value type)
"Encode inside XML-TAG the LISP VALUE according to TYPE.
Do not call this function directly, use `soap-encode-value'
(progn
(put (aref (make-soap-basic-type) 0)
'soap-encoder 'soap-encode-basic-type)
+ (put (aref (make-soap-simple-type) 0)
+ 'soap-encoder 'soap-encode-simple-type)
(put (aref (make-soap-sequence-type) 0)
'soap-encoder 'soap-encode-sequence-type)
(put (aref (make-soap-array-type) 0)
;; TODO: we need better sample values for more types.
(t (format "%s" (soap-basic-type-kind type)))))
+(defun soap-sample-value-for-simple-type (type)
+ "Provide a sample value for TYPE which is a simple type.
+This is a specific function which should not be called directly,
+use `soap-sample-value' instead."
+ (let ((enumeration (soap-simple-type-enumeration type)))
+ (if (> (length enumeration) 1)
+ (elt enumeration (random (length enumeration)))
+ (soap-sample-value-for-basic-type type))))
+
(defun soap-sample-value-for-seqence-type (type)
"Provide a sample value for TYPE which is a sequence type.
Values for sequence types are ALISTS of (slot-name . VALUE) for
(put (aref (make-soap-basic-type) 0) 'soap-sample-value
'soap-sample-value-for-basic-type)
+ (put (aref (make-soap-simple-type) 0) 'soap-sample-value
+ 'soap-sample-value-for-simple-type)
+
(put (aref (make-soap-sequence-type) 0) 'soap-sample-value
'soap-sample-value-for-seqence-type)
(insert "\nSample value\n")
(pp (soap-sample-value basic-type) (current-buffer)))
+(defun soap-inspect-simple-type (simple-type)
+ "Insert information about SIMPLE-TYPE into the current buffer"
+ (insert "Simple type: " (soap-element-fq-name simple-type) "\n")
+ (insert "Base: " (symbol-name (soap-basic-type-kind simple-type)) "\n")
+ (let ((enumeration (soap-simple-type-enumeration simple-type)))
+ (when (> (length enumeration) 1)
+ (insert "Valid values: ")
+ (dolist (e enumeration)
+ (insert "\"" e "\" ")))))
+
(defun soap-inspect-sequence-type (sequence)
"Insert information about SEQUENCE into the current buffer."
(insert "Sequence type: " (soap-element-fq-name sequence) "\n")
(put (aref (make-soap-basic-type) 0) 'soap-inspect
'soap-inspect-basic-type)
+ (put (aref (make-soap-simple-type) 0) 'soap-inspect
+ 'soap-inspect-simple-type)
+
(put (aref (make-soap-sequence-type) 0) 'soap-inspect
'soap-inspect-sequence-type)
;; could get a wrapper hook, or defer to open-network-stream-function.
(defvar socks-override-functions nil
- "*Whether to overwrite the open-network-stream function with the SOCKSified
+ "Whether to overwrite the open-network-stream function with the SOCKSified
version.")
(require 'network-stream)
\f
;; Replacement functions for open-network-stream, etc.
(defvar socks-noproxy nil
- "*List of regexps matching hosts that we should not socksify connections to")
+ "List of regexps matching hosts that we should not socksify connections to")
(defun socks-find-route (host service)
(let ((route socks-server)
\f
(defcustom socks-nslookup-program "nslookup"
- "*If non-NIL then a string naming the nslookup program."
+ "If non-NIL then a string naming the nslookup program."
:type '(choice (const :tag "None" :value nil) string)
:group 'socks)
?h host
?p (if (integerp port)
(int-to-string port)
- port))))
- response)
+ port)))))
(message "Opening TLS connection with `%s'..." formatted-cmd)
(setq process (start-process
name buffer shell-file-name shell-command-switch
(not (zerop (hash-table-count tramp-cache-data)))
tramp-cache-data-changed
(stringp tramp-persistency-file-name))
- (let ((cache (copy-hash-table tramp-cache-data)))
+ (let ((cache (copy-hash-table tramp-cache-data))
+ print-length print-level)
;; Remove temporary data. If there is the key "login-as", we
;; don't save either, because all other properties might
;; depend on the login name, and we want to give the
(tramp-flush-directory-property vec "")
;; Flush connection cache.
- (tramp-flush-connection-property (tramp-get-connection-process vec))
+ (when (processp (tramp-get-connection-process vec))
+ (delete-process (tramp-get-connection-process vec))
+ (tramp-flush-connection-property (tramp-get-connection-process vec)))
(tramp-flush-connection-property vec)
;; Remove buffers.
(setq tramp-verbose 9)
-in the ~/.emacs file and to repeat the bug. Then, include the
+in your init file and to repeat the bug. Then, include the
contents of the *tramp/foo* buffer and the *debug tramp/foo*
buffer in your bug report.
;; Dump load-path shadows.
(insert "\nload-path shadows:\n==================\n")
(ignore-errors
- (mapc (lambda (x) (when (string-match "tramp" x) (insert x "\n")))
- (split-string (list-load-path-shadows t) "\n")))
+ (mapc
+ (lambda (x) (when (string-match "tramp" x) (insert x "\n")))
+ (split-string (tramp-compat-funcall 'list-load-path-shadows t) "\n")))
;; Append buffers only when we are in message mode.
(when (and
;;; Code:
-(require 'tramp-loaddefs)
-
(eval-when-compile
;; Pacify byte-compiler.
(eval-and-compile
+ ;; Some packages must be required for XEmacs, because we compile
+ ;; with -no-autoloads.
+ (when (featurep 'xemacs)
+ (require 'cus-edit)
+ (require 'env)
+ (require 'executable)
+ (require 'outline)
+ (require 'passwd)
+ (require 'pp)
+ (require 'regexp-opt))
+
(require 'advice)
(require 'custom)
(require 'format-spec)
(require 'shell)
+ (require 'tramp-loaddefs)
+
;; As long as password.el is not part of (X)Emacs, it shouldn't be
;; mandatory.
(if (featurep 'xemacs)
(require 'timer))
;; We check whether `start-file-process' is bound.
- (unless (fboundp 'start-file-process)
+ ;; Note: we deactivate this. There are problems, at least in SXEmacs.
+ (unless t;(fboundp 'start-file-process)
;; tramp-util offers integration into other (X)Emacs packages like
;; compile.el, gud.el etc. Not necessary in Emacs 23.
(defalias 'file-remote-p
(lambda (file &optional identification connected)
(when (tramp-tramp-file-p file)
- (tramp-file-name-handler
+ (tramp-compat-funcall
+ 'tramp-file-name-handler
'file-remote-p file identification connected)))))
;; `process-file' does not exist in XEmacs.
(defalias 'set-file-times
(lambda (filename &optional time)
(when (tramp-tramp-file-p filename)
- (tramp-file-name-handler
- 'set-file-times filename time)))))
+ (tramp-compat-funcall
+ 'tramp-file-name-handler 'set-file-times filename time)))))
;; We currently use "[" and "]" in the filename format for IPv6
;; hosts of GNU Emacs. This means that Emacs wants to expand
"Display MESSAGE temporarily if non-nil while BODY is evaluated."
`(progn ,@body)))
+;; `condition-case-unless-debug' is introduced with Emacs 24.
+(if (fboundp 'condition-case-unless-debug)
+ (defalias 'tramp-compat-condition-case-unless-debug
+ 'condition-case-unless-debug)
+ (defmacro tramp-compat-condition-case-unless-debug
+ (var bodyform &rest handlers)
+ "Like `condition-case' except that it does not catch anything when debugging."
+ (declare (debug condition-case) (indent 2))
+ (let ((bodysym (make-symbol "body")))
+ `(let ((,bodysym (lambda () ,bodyform)))
+ (if debug-on-error
+ (funcall ,bodysym)
+ (condition-case ,var
+ (funcall ,bodysym)
+ ,@handlers))))))
+
;; `font-lock-add-keywords' does not exist in XEmacs.
(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how)
"Add highlighting KEYWORDS for MODE."
"Return name of directory for temporary files (compat function).
For Emacs, this is the variable `temporary-file-directory', for XEmacs
this is the function `temp-directory'."
- (cond
- ((boundp 'temporary-file-directory) (symbol-value 'temporary-file-directory))
- ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory))
- ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
- (file-name-as-directory (getenv "TEMP")))
- ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
- (file-name-as-directory (getenv "TMP")))
- ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
- (file-name-as-directory (getenv "TMPDIR")))
- ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
- (t (message (concat "Neither `temporary-file-directory' nor "
- "`temp-directory' is defined -- using /tmp."))
- (file-name-as-directory "/tmp"))))
+ (let (file-name-handler-alist)
+ ;; We must return a local directory. If it is remote, we could
+ ;; run into an infloop.
+ (cond
+ ((and (boundp 'temporary-file-directory)
+ (eval (car (get 'temporary-file-directory 'standard-value)))))
+ ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory))
+ ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
+ (file-name-as-directory (getenv "TEMP")))
+ ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
+ (file-name-as-directory (getenv "TMP")))
+ ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
+ (file-name-as-directory (getenv "TMPDIR")))
+ ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
+ (t (message (concat "Neither `temporary-file-directory' nor "
+ "`temp-directory' is defined -- using /tmp."))
+ (file-name-as-directory "/tmp")))))
;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
;; implementation with `make-temp-name', creating the temporary file
((or (null id-format) (eq id-format 'integer))
(file-attributes filename))
((tramp-tramp-file-p filename)
- (tramp-file-name-handler 'file-attributes filename id-format))
+ (tramp-compat-funcall
+ 'tramp-file-name-handler 'file-attributes filename id-format))
(t (condition-case nil
(tramp-compat-funcall 'file-attributes filename id-format)
(wrong-number-of-arguments (file-attributes filename))))))
;; `copy-directory' is a new function in Emacs 23.2. Implementation
;; is taken from there.
(defun tramp-compat-copy-directory
- (directory newname &optional keep-time parents)
+ (directory newname &optional keep-time parents copy-contents)
"Make a copy of DIRECTORY (compat function)."
- (if (fboundp 'copy-directory)
- (tramp-compat-funcall 'copy-directory directory newname keep-time parents)
-
- ;; If `default-directory' is a remote directory, make sure we find
- ;; its `copy-directory' handler.
- (let ((handler (or (find-file-name-handler directory 'copy-directory)
- (find-file-name-handler newname 'copy-directory))))
- (if handler
- (funcall handler 'copy-directory directory newname keep-time parents)
-
- ;; Compute target name.
- (setq directory (directory-file-name (expand-file-name directory))
- newname (directory-file-name (expand-file-name newname)))
- (if (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory directory)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory directory) newname)))
- (if (not (file-directory-p newname)) (make-directory newname parents))
-
- ;; Copy recursively.
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (tramp-compat-copy-directory file newname keep-time parents)
- (copy-file file newname t keep-time)))
- ;; We do not want to delete "." and "..".
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
-
- ;; Set directory attributes.
- (set-file-modes newname (file-modes directory))
- (if keep-time
- (set-file-times newname (nth 5 (file-attributes directory))))))))
+ (condition-case nil
+ (tramp-compat-funcall
+ 'copy-directory directory newname keep-time parents copy-contents)
+
+ ;; `copy-directory' is either not implemented, or it does not
+ ;; support the the COPY-CONTENTS flag. For the time being, we
+ ;; ignore COPY-CONTENTS as well.
+
+ (error
+ ;; If `default-directory' is a remote directory, make sure we
+ ;; find its `copy-directory' handler.
+ (let ((handler (or (find-file-name-handler directory 'copy-directory)
+ (find-file-name-handler newname 'copy-directory))))
+ (if handler
+ (funcall handler 'copy-directory directory newname keep-time parents)
+
+ ;; Compute target name.
+ (setq directory (directory-file-name (expand-file-name directory))
+ newname (directory-file-name (expand-file-name newname)))
+ (if (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory directory)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory directory) newname)))
+ (if (not (file-directory-p newname)) (make-directory newname parents))
+
+ ;; Copy recursively.
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (tramp-compat-copy-directory file newname keep-time parents)
+ (copy-file file newname t keep-time)))
+ ;; We do not want to delete "." and "..".
+ (directory-files
+ directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
+
+ ;; Set directory attributes.
+ (set-file-modes newname (file-modes directory))
+ (if keep-time
+ (set-file-times newname (nth 5 (file-attributes directory)))))))))
;; TRASH has been introduced with Emacs 24.1.
(defun tramp-compat-delete-file (filename &optional trash)
(defun tramp-disable-ange-ftp ()
"Turn Ange-FTP off.
This is useful for unified remoting. See
-`tramp-file-name-structure-unified' and
-`tramp-file-name-structure-separate' for details. Requests suitable
-for Ange-FTP will be forwarded to Ange-FTP. Also see the variables
+`tramp-file-name-structure' for details. Requests suitable for
+Ange-FTP will be forwarded to Ange-FTP. Also see the variables
`tramp-ftp-method', `tramp-default-method', and
`tramp-default-method-alist'.
;; Define FTP method ...
;;;###tramp-autoload
(defconst tramp-ftp-method "ftp"
- "*When this method name is used, forward all calls to Ange-FTP.")
+ "When this method name is used, forward all calls to Ange-FTP.")
;; ... and add it to the method list.
;;;###tramp-autoload
;;;###tramp-autoload
(defsubst tramp-ftp-file-name-p (filename)
"Check if it's a filename that should be forwarded to Ange-FTP."
- (let ((v (tramp-dissect-file-name filename)))
- (string= (tramp-file-name-method v) tramp-ftp-method)))
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-ftp-method))
;;;###tramp-autoload
(unless (featurep 'xemacs)
;; D-Bus support in the Emacs core can be disabled with configuration
;; option "--without-dbus". Declare used subroutines and variables.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-call-method-asynchronously "dbusbind.c")
(declare-function dbus-get-unique-name "dbusbind.c")
-(declare-function dbus-register-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
;; Pacify byte-compiler
(eval-when-compile
;;;###tramp-autoload
(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
- "*List of methods for remote files, accessed with GVFS."
+ "List of methods for remote files, accessed with GVFS."
:group 'tramp
:version "23.2"
:type '(repeat (choice (const "dav")
(add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil))
(defcustom tramp-gvfs-zeroconf-domain "local"
- "*Zeroconf domain to be used for discovering services, like host names."
+ "Zeroconf domain to be used for discovering services, like host names."
:group 'tramp
:version "23.2"
:type 'string)
;; If there is a default location, expand tilde.
(when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
(save-match-data
- (tramp-gvfs-maybe-open-connection (vector method user host "/")))
+ (tramp-gvfs-maybe-open-connection (vector method user host "/" hop)))
(setq localname
(replace-match
(tramp-get-file-property v "/" "default-location" "~")
;; Define HTTP tunnel method ...
;;;###tramp-autoload
(defconst tramp-gw-tunnel-method "tunnel"
- "*Method to connect HTTP gateways.")
+ "Method to connect HTTP gateways.")
;; ... and port.
(defconst tramp-gw-default-tunnel-port 8080
- "*Default port for HTTP gateways.")
+ "Default port for HTTP gateways.")
;; Define SOCKS method ...
;;;###tramp-autoload
(defconst tramp-gw-socks-method "socks"
- "*Method to connect SOCKS servers.")
+ "Method to connect SOCKS servers.")
;; ... and port.
(defconst tramp-gw-default-socks-port 1080
- "*Default port for SOCKS servers.")
+ "Default port for SOCKS servers.")
;; Autoload the socks library. It is used only when we access a SOCKS server.
(autoload 'socks-open-network-stream "socks")
(memq (process-status tramp-gw-aux-proc) '(listen)))
(let ((aux-vec
(vector "aux" (tramp-file-name-user gw-vec)
- (tramp-file-name-host gw-vec) nil)))
+ (tramp-file-name-host gw-vec) nil nil)))
(setq tramp-gw-aux-proc
(make-network-process
:name (tramp-buffer-name aux-vec) :buffer nil :host 'local
;; `dired-insert-set-properties'.
(defcustom tramp-inline-compress-start-size 4096
- "*The minimum size of compressing where inline transfer.
+ "The minimum size of compressing where inline transfer.
When inline transfer, compress transferred data of file
whose size is this value or above (up to `tramp-copy-size-limit').
If it is nil, no compression at all will be applied."
:type '(choice (const nil) integer))
(defcustom tramp-copy-size-limit 10240
- "*The maximum file size where inline copying is preferred over an out-of-the-band copy.
-If it is nil, inline out-of-the-band copy will be used without a check."
+ "The maximum file size where inline copying is preferred over an \
+out-of-the-band copy.
+If it is nil, out-of-the-band copy will be used without a check."
:group 'tramp
:type '(choice (const nil) integer))
;;;###tramp-autoload
(defcustom tramp-terminal-type "dumb"
- "*Value of TERM environment variable for logging in to remote host.
+ "Value of TERM environment variable for logging in to remote host.
Because Tramp wants to parse the output of the remote shell, it is easily
confused by ANSI color escape sequences and suchlike. Often, shell init
files conditionalize this setup based on the TERM environment variable."
(tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
- (tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
(tramp-login-args (("-l" "%u") ("-P" "%p") ("-1" "-ssh") ("%h")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
- (tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
("-q") ("-r")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)
- (tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k")
("-q") ("-r")))
(tramp-copy-keep-date t)
- (tramp-copy-recursive t)
- (tramp-password-end-of-line "xy"))) ;see docstring for "xy"
+ (tramp-copy-recursive t)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
'("fcp"
;;;###tramp-autoload
(defconst tramp-completion-function-alist-putty
- '((tramp-parse-putty
- "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"))
- "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.")
+ `((tramp-parse-putty
+ ,(if (memq system-type '(windows-nt))
+ "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
+ "~/.putty/sessions")))
+ "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.")
;;;###tramp-autoload
(eval-after-load 'tramp
;; IRIX64: /usr/bin
;;;###tramp-autoload
(defcustom tramp-remote-path
- '(tramp-default-remote-path "/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin"
- "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
- "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
- "*List of directories to search for executables on remote host.
+ '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
+ "/usr/local/bin" "/usr/local/sbin" "/local/bin" "/local/freeware/bin"
+ "/local/gnu/bin" "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin"
+ "/opt/bin" "/opt/sbin" "/opt/local/bin")
+ "List of directories to search for executables on remote host.
For every remote host, this variable will be set buffer local,
keeping the list of existing directories on that host.
,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
"CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=\"\""
"autocorrect=" "correct=")
-
- "*List of environment variables to be set on the remote host.
+ "List of environment variables to be set on the remote host.
Each element should be a string of the form ENVVARNAME=VALUE. An
entry ENVVARNAME= disables the corresponding environment variable,
:type '(repeat string))
(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
- "*Alist specifying extra arguments to pass to the remote shell.
+ "Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
matching the shell file name and ARGS is a string specifying the
arguments.
(tramp-get-file-exists-command v)
(tramp-shell-quote-argument localname)))))))
-;; CCC: This should check for an error condition and signal failure
-;; when something goes wrong.
-;; Daniel Pittman <daniel@danann.net>
(defun tramp-sh-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%u" "\"%U\"")
- (if (eq id-format 'integer) "%g" "\"%G\"")
+ (if (eq id-format 'integer) "%ue0" "\"%U\"")
+ (if (eq id-format 'integer) "%ge0" "\"%G\"")
(tramp-shell-quote-argument localname))))
(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
;; but it does not work on all remote systems. Therefore, we
;; quote the filenames via sed.
- "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs "
- "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'); "
- "echo \")\"")
+ "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | "
+ "xargs %s -c "
+ "'(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'"
+ " 2>/dev/null); echo \")\"")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%u" "\"%U\"")
- (if (eq id-format 'integer) "%g" "\"%G\""))))
+ (if (eq id-format 'integer) "%ue0" "\"%U\"")
+ (if (eq id-format 'integer) "%ge0" "\"%G\""))))
;; This function should return "foo/" for directories and "bar" for
;; files.
p v nil tramp-actions-copy-out-of-band)))
;; Reset the transfer process properties.
- (tramp-message orig-vec 6 "%s" (buffer-string))
+ (tramp-message orig-vec 6 "\n%s" (buffer-string))
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil)))
"Recursively delete the directory given.
This is like `dired-recursive-delete-directory' for Tramp files."
(with-parsed-tramp-file-name filename nil
- ;; Run a shell command 'rm -r <localname>'
+ ;; Run a shell command 'rm -r <localname>'.
;; Code shamelessly stolen from the dired implementation and, um, hacked :)
(unless (file-exists-p filename)
(tramp-error v 'file-error "No such directory: %s" filename))
- ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
+ ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>).
(tramp-send-command
v
(format "rm -rf %s" (tramp-shell-quote-argument localname))
method user host
(tramp-drop-volume-letter
(tramp-run-real-handler
- 'expand-file-name (list localname))))))))
+ 'expand-file-name (list localname)))
+ hop)))))
;;; Remote commands:
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0))
- (unwind-protect
- (save-excursion
- (save-restriction
- (unless buffer
- ;; BUFFER can be nil. We use a temporary buffer.
- (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
- ;; Activate narrowing in order to save BUFFER contents.
- ;; Clear also the modification time; otherwise we might
- ;; be interrupted by `verify-visited-file-modtime'.
- (with-current-buffer (tramp-get-connection-buffer v)
- (let ((buffer-undo-list t))
+
+ (unless buffer
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification time;
+ ;; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (buffer-read-only nil)
+ (mark (point)))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-maybe-open-connection', in order
+ ;; to cleanup the prompt afterwards.
+ (tramp-maybe-open-connection v)
+ (widen)
+ (delete-region mark (point))
+ (narrow-to-region (point-max) (point-max))
+ ;; Now do it.
(if command
;; Send the command.
(tramp-send-command v command nil t) ; nooutput
;; Check, whether a pty is associated.
- (tramp-maybe-open-connection v)
(unless (tramp-compat-process-get
(tramp-get-connection-process v) 'remote-tty)
(tramp-error
v 'file-error
- "pty association is not supported for `%s'" name)))))
- (let ((p (tramp-get-connection-process v)))
- ;; Set query flag for this process.
- (tramp-compat-set-process-query-on-exit-flag p t)
- ;; Return process.
- p)))
- ;; Save exit.
- (with-current-buffer (tramp-get-connection-buffer v)
+ "pty association is not supported for `%s'" name))))
+ (let ((p (tramp-get-connection-process v)))
+ ;; Set query flag for this process. We ignore errors,
+ ;; because the process could have finished already.
+ (ignore-errors
+ (tramp-compat-set-process-query-on-exit-flag p t))
+ ;; Return process.
+ p)))
+
+ ;; Save exit.
(if (string-match tramp-temp-buffer-name (buffer-name))
(progn
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp)))
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)))))
+ (set-buffer-modified-p bmp))
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil))))))
(defun tramp-sh-handle-process-file
(program &optional infile destination display &rest args)
'write-region
(list start end localname append 'no-message lockname confirm))
- (let ((modes (save-excursion (tramp-default-file-modes filename)))
- ;; We use this to save the value of
- ;; `last-coding-system-used' after writing the tmp
- ;; file. At the end of the function, we set
- ;; `last-coding-system-used' to this saved value. This
- ;; way, any intermediary coding systems used while
- ;; talking to the remote shell or suchlike won't hose
- ;; this variable. This approach was snarfed from
- ;; ange-ftp.el.
- coding-system-used
- ;; Write region into a tmp file. This isn't really
- ;; needed if we use an encoding function, but currently
- ;; we use it always because this makes the logic
- ;; simpler.
- (tmpfile (or tramp-temp-buffer-file-name
- (tramp-compat-make-temp-file filename))))
+ (let* ((modes (save-excursion (tramp-default-file-modes filename)))
+ ;; We use this to save the value of
+ ;; `last-coding-system-used' after writing the tmp
+ ;; file. At the end of the function, we set
+ ;; `last-coding-system-used' to this saved value. This
+ ;; way, any intermediary coding systems used while
+ ;; talking to the remote shell or suchlike won't hose
+ ;; this variable. This approach was snarfed from
+ ;; ange-ftp.el.
+ coding-system-used
+ ;; Write region into a tmp file. This isn't really
+ ;; needed if we use an encoding function, but currently
+ ;; we use it always because this makes the logic
+ ;; simpler. We must also set `temporary-file-directory',
+ ;; because it could point to a remote directory.
+ (temporary-file-directory
+ (tramp-compat-temporary-file-directory))
+ (tmpfile (or tramp-temp-buffer-file-name
+ (tramp-compat-make-temp-file filename))))
;; If `append' is non-nil, we copy the file locally, and let
;; the native `write-region' implementation do the job.
(let (last-coding-system-used (need-chown t))
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
- (let ((file-attr (file-attributes filename)))
+ (let ((file-attr (tramp-compat-file-attributes filename 'integer)))
(set-visited-file-modtime
;; We must pass modtime explicitly, because filename can
;; be different from (buffer-file-name), f.e. if
;; `file-precious-flag' is set.
(nth 5 file-attr))
- (when (and (eq (nth 2 file-attr) uid)
- (eq (nth 3 file-attr) gid))
+ (when (and (= (nth 2 file-attr) uid)
+ (= (nth 3 file-attr) gid))
(setq need-chown nil))))
;; Set the ownership.
`((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
;; Here we collect only file names, which need an operation.
- (tramp-run-real-handler 'vc-registered (list file))
+ (ignore-errors (tramp-run-real-handler 'vc-registered (list file)))
(tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
;; Send just one command, in order to fill the cache.
((and fn (memq operation '(file-exists-p file-readable-p)))
(add-to-list 'tramp-vc-registered-file-names localname 'append)
nil)
+ ;; `process-file' and `start-file-process' shall be ignored.
+ ((and fn (eq operation 'process-file) 0))
+ ((and fn (eq operation 'start-file-process) nil))
;; Tramp file name handlers like `expand-file-name'. They
;; must still work.
- (fn
- (save-match-data (apply (cdr fn) args)))
+ (fn (save-match-data (apply (cdr fn) args)))
;; Default file name handlers, we don't care.
(t (tramp-run-real-handler operation args)))))))
;; `/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))
(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)
(defun tramp-find-shell (vec)
"Opens a shell on the remote host which groks tilde expansion."
- (unless (tramp-get-connection-property vec "remote-shell" nil)
- (let (shell)
- (with-current-buffer (tramp-get-buffer vec)
- (tramp-send-command vec "echo ~root" t)
- (cond
- ((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" "")))
- (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)))
- (unless shell
- (tramp-error
- vec 'file-error
- "Couldn't find a shell which groks tilde expansion"))
- (tramp-message
- vec 5 "Starting remote shell `%s' for tilde expansion"
- (tramp-set-connection-property vec "remote-shell" shell))
- (tramp-open-shell vec shell))
-
- (t (tramp-message
- vec 5 "Remote `%s' groks tilde expansion, good"
- (tramp-set-connection-property
- vec "remote-shell"
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-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" "")))
+
+ (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)))
+
+ default-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.
;; 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")
vec "uname"
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
(when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
- (with-current-buffer (tramp-get-debug-buffer vec)
- ;; Keep the debug buffer.
- (rename-buffer
- (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
- (tramp-cleanup-connection vec)
- (if (= (point-min) (point-max))
- (kill-buffer nil)
- (rename-buffer (tramp-debug-buffer-name vec) 'unique))
- ;; We call `tramp-get-buffer' in order to keep the debug buffer.
- (tramp-get-buffer vec)
- (tramp-message
- vec 3
- "Connection reset, because remote host changed from `%s' to `%s'"
- old-uname new-uname)
- (throw 'uname-changed (tramp-maybe-open-connection vec)))))
+ (tramp-cleanup vec)
+ (tramp-message
+ vec 3
+ "Connection reset, because remote host changed from `%s' to `%s'"
+ old-uname new-uname)
+ (throw 'uname-changed (tramp-maybe-open-connection vec))))
;; Check whether the remote host suffers from buggy
;; `send-process-string'. This is known for FreeBSD (see comment in
(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,
;; Disable unexpected output.
(tramp-send-command vec "mesg n; biff n" t)
- ;; Busyboxes tend to behave strange. We check for the existence.
- (with-connection-property vec "busybox"
- (tramp-send-command
- vec
- (format
- "%s --version" (tramp-get-connection-property vec "remote-shell" "echo"))
- t)
- (with-current-buffer (process-buffer proc)
- (let ((case-fold-search t))
- (and (string-match "busybox" (buffer-string)) t))))
-
;; IRIX64 bash expands "!" even when in single quotes. This
;; destroys our shell functions, we must disable it. See
;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
(b64 "recode data..base64" "recode base64..data")
(b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
(b64 tramp-perl-encode tramp-perl-decode)
- (uu "uuencode xxx" "uudecode -o /dev/stdout")
+ (uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout")
(uu "uuencode xxx" "uudecode -o -")
(uu "uuencode xxx" "uudecode -p")
(uu "uuencode xxx" tramp-uudecode)
"List of remote coding commands for inline transfer.
Each item is a list that looks like this:
-\(FORMAT ENCODING DECODING\)
+\(FORMAT ENCODING DECODING [TEST]\)
FORMAT is symbol describing the encoding/decoding format. It can be
`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
If they are variables, this variable is a string containing a Perl
implementation for this functionality. This Perl program will be transferred
-to the remote host, and it is available as shell function with the same name.")
+to the remote host, and it is available as shell function with the same name.
+
+The optional TEST command can be used for further tests, whether
+ENCODING and DECODING are applicable.")
(defun tramp-find-inline-encoding (vec)
"Find an inline transfer encoding that works.
(save-excursion
(let ((local-commands tramp-local-coding-commands)
(magic "xyzzy")
- loc-enc loc-dec rem-enc rem-dec litem ritem found)
+ (p (tramp-get-connection-process vec))
+ loc-enc loc-dec rem-enc rem-dec rem-test litem ritem found)
(while (and local-commands (not found))
(setq litem (pop local-commands))
(catch 'wont-work-local
(when (equal format (nth 0 ritem))
(setq rem-enc (nth 1 ritem))
(setq rem-dec (nth 2 ritem))
+ (setq rem-test (nth 3 ritem))
+ ;; Check the remote test command if exists.
+ (when (stringp rem-test)
+ (tramp-message
+ vec 5 "Checking remote test command `%s'" rem-test)
+ (unless (tramp-send-command-and-check vec rem-test t)
+ (throw 'wont-work-remote nil)))
;; Check if remote encoding and decoding commands can be
;; called remotely with null input and output. This makes
;; sure there are no syntax errors and the command is really
(tramp-error
vec 'file-error "Couldn't find an inline transfer encoding"))
- ;; Set connection properties.
+ ;; Set connection properties. Since the commands are risky (due
+ ;; to output direction), we cache them in the process cache.
(tramp-message vec 5 "Using local encoding `%s'" loc-enc)
- (tramp-set-connection-property vec "local-encoding" loc-enc)
+ (tramp-set-connection-property p "local-encoding" loc-enc)
(tramp-message vec 5 "Using local decoding `%s'" loc-dec)
- (tramp-set-connection-property vec "local-decoding" loc-dec)
+ (tramp-set-connection-property p "local-decoding" loc-dec)
(tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
- (tramp-set-connection-property vec "remote-encoding" rem-enc)
+ (tramp-set-connection-property p "remote-encoding" rem-enc)
(tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
- (tramp-set-connection-property vec "remote-decoding" rem-dec))))
+ (tramp-set-connection-property p "remote-decoding" rem-dec))))
(defun tramp-call-local-coding-command (cmd input output)
"Call the local encoding or decoding command.
(save-excursion
(let ((commands tramp-inline-compress-commands)
(magic "xyzzy")
- item compress decompress
- found)
+ (p (tramp-get-connection-process vec))
+ item compress decompress found)
(while (and commands (not found))
(catch 'next
(setq item (pop commands)
;; Did we find something?
(if found
(progn
- ;; Set connection properties.
+ ;; Set connection properties. Since the commands are
+ ;; risky (due to output direction), we cache them in the
+ ;; process cache.
(tramp-message
vec 5 "Using inline transfer compress command `%s'" compress)
- (tramp-set-connection-property vec "inline-compress" compress)
+ (tramp-set-connection-property p "inline-compress" compress)
(tramp-message
vec 5 "Using inline transfer decompress command `%s'" decompress)
- (tramp-set-connection-property vec "inline-decompress" decompress))
+ (tramp-set-connection-property p "inline-decompress" decompress))
- (tramp-set-connection-property vec "inline-compress" nil)
- (tramp-set-connection-property vec "inline-decompress" nil)
+ (tramp-set-connection-property p "inline-compress" nil)
+ (tramp-set-connection-property p "inline-decompress" nil)
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
"Expands VEC according to `tramp-default-proxies-alist'.
Gateway hops are already opened."
(let ((target-alist `(,vec))
- (choices tramp-default-proxies-alist)
- item proxy)
+ (hops (or (tramp-file-name-hop vec) ""))
+ (item vec)
+ choices proxy)
+
+ ;; Ad-hoc proxy definitions.
+ (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
+ (let ((user (tramp-file-name-user item))
+ (host (tramp-file-name-host item))
+ (proxy (concat
+ tramp-prefix-format proxy tramp-postfix-host-format)))
+ (tramp-message
+ vec 5 "Add proxy (\"%s\" \"%s\" \"%s\")"
+ (and (stringp host) (regexp-quote host))
+ (and (stringp user) (regexp-quote user))
+ proxy)
+ ;; Add the hop.
+ (add-to-list
+ 'tramp-default-proxies-alist
+ (list (and (stringp host) (regexp-quote host))
+ (and (stringp user) (regexp-quote user))
+ proxy))
+ (setq item (tramp-dissect-file-name proxy))))
+ ;; Save the new value.
+ (when (and hops tramp-save-ad-hoc-proxies)
+ (customize-save-variable
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))
;; Look for proxy hosts to be passed.
+ (setq choices tramp-default-proxies-alist)
(while choices
(setq item (pop choices)
proxy (eval (nth 2 item)))
(when (and
- ;; host
+ ;; Host.
(string-match (or (eval (nth 0 item)) "")
(or (tramp-file-name-host (car target-alist)) ""))
- ;; user
+ ;; User.
(string-match (or (eval (nth 1 item)) "")
(or (tramp-file-name-user (car target-alist)) "")))
(if (null proxy)
'target-alist
(vector
(tramp-file-name-method hop) (tramp-file-name-user hop)
- (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil))
+ (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil))
;; For the password prompt, we need the correct values.
;; Therefore, we must remember the gateway vector. But we
;; cannot do it as connection property, because it shouldn't
;; Result.
target-alist))
+(defvar tramp-current-connection nil
+ "Last connection timestamp.")
+
(defun tramp-maybe-open-connection (vec)
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
(process-environment (copy-sequence process-environment))
(pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
+ ;; If Tramp opens the same connection within a short time frame,
+ ;; there is a problem. We shall signal this.
+ (unless (or (and p (processp p) (memq (process-status p) '(run open)))
+ (not (equal (butlast (append vec nil))
+ (car tramp-current-connection)))
+ (> (tramp-time-diff
+ (current-time) (cdr tramp-current-connection))
+ 5))
+ (throw 'suppress 'suppress))
+
;; If too much time has passed since last command was sent, look
;; whether process is still alive. If it isn't, kill it. When
;; using ssh, it can sometimes happen that the remote end has
;; The error will be caught locally.
(tramp-error vec 'file-error "Awake did fail")))
(file-error
- (tramp-flush-connection-property vec)
- (tramp-flush-connection-property p)
- (delete-process p)
+ (tramp-cleanup vec)
(setq p nil)))
;; New connection must be opened.
;; We call `tramp-get-buffer' in order to get a debug
;; buffer for messages from the beginning.
(tramp-get-buffer vec)
+
+ ;; If `non-essential' is non-nil, don't reopen a new connection.
+ (when (and (boundp 'non-essential) (symbol-value 'non-essential))
+ (throw 'non-essential 'non-essential))
+
(tramp-with-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
(tramp-set-connection-property p "vector" vec)
(set-process-sentinel p 'tramp-process-sentinel)
(tramp-compat-set-process-query-on-exit-flag p nil)
+ (setq tramp-current-connection
+ (cons (butlast (append vec nil)) (current-time))
+ tramp-current-host (system-name))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
(expand-file-name
tramp-temp-name-prefix
(tramp-compat-temporary-file-directory)))))
- spec)
+ spec r-shell)
;; Add arguments for asynchronous processes.
(when (and process-name async-args)
(setq l-port (match-string 2 l-host)
l-host (match-string 1 l-host)))
+ ;; Check, whether there is a restricted shell.
+ (dolist (elt tramp-restricted-shell-hosts-alist)
+ (when (string-match elt tramp-current-host)
+ (setq r-shell t)))
+
;; Set variables for computing the prompt for
;; reading password. They can also be derived
;; from a gateway.
(concat
;; We do not want to see the trailing local
;; prompt in `start-file-process'.
- (unless (memq system-type '(windows-nt)) "exec ")
+ (unless r-shell "exec ")
command " "
(mapconcat
(lambda (x)
login-args " ")
;; Local shell could be a Windows COMSPEC. It
;; doesn't know the ";" syntax, but we must exit
- ;; always for `start-file-process'. "exec" does
- ;; not work either.
- (if (memq system-type '(windows-nt)) " && exit || exit")))
+ ;; always for `start-file-process'. It could
+ ;; also be a restricted shell, which does not
+ ;; allow "exec".
+ (when r-shell " && exit || exit")))
;; Send the command.
(tramp-message vec 3 "Sending command `%s'" command)
;; When the user did interrupt, we must cleanup.
(quit
- (let ((p (tramp-get-connection-process vec)))
- (when (and p (processp p))
- (tramp-flush-connection-property vec)
- (tramp-flush-connection-property p)
- (delete-process p)))
+ (tramp-cleanup vec)
;; Propagate the quit signal.
(signal (car err) (cdr err)))))))
If no corresponding command is found, nil is returned."
(when (and (integerp tramp-inline-compress-start-size)
(> size tramp-inline-compress-start-size))
- (with-connection-property vec prop
+ (with-connection-property (tramp-get-connection-process vec) prop
(tramp-find-inline-compress vec)
- (tramp-get-connection-property vec prop nil))))
+ (tramp-get-connection-property
+ (tramp-get-connection-process vec) prop nil))))
(defun tramp-get-inline-coding (vec prop size)
"Return the coding command related to PROP.
;; no inline coding is found.
(ignore-errors
(let ((coding
- (with-connection-property vec prop
+ (with-connection-property (tramp-get-connection-process vec) prop
(tramp-find-inline-encoding vec)
- (tramp-get-connection-property vec prop nil)))
+ (tramp-get-connection-property
+ (tramp-get-connection-process vec) prop nil)))
(prop1 (if (string-match "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
;; Define SMB method ...
;;;###tramp-autoload
(defconst tramp-smb-method "smb"
- "*Method to connect SAMBA and M$ SMB servers.")
+ "Method to connect SAMBA and M$ SMB servers.")
;; ... and add it to the method list.
;;;###tramp-autoload
;; We define an empty command, because `tramp-smb-call-winexe'
;; opens already the powershell. Used in `tramp-handle-shell-command'.
(tramp-remote-shell "")
- ;; This is just a guess. We don't know whether the share "$C"
+ ;; This is just a guess. We don't know whether the share "C$"
;; is available for public use, and whether the user has write
;; access.
(tramp-tmpdir "/C$/Temp"))))
'((tramp-parse-netrc "~/.netrc"))))
(defcustom tramp-smb-program "smbclient"
- "*Name of SMB client to run."
+ "Name of SMB client to run."
:group 'tramp
:type 'string)
(defcustom tramp-smb-conf "/dev/null"
- "*Path of the smb.conf file.
+ "Path of the smb.conf file.
If it is nil, no smb.conf will be added to the `tramp-smb-program'
call, letting the SMB client use the default one."
:group 'tramp
:type '(choice (const nil) (file :must-match t)))
(defvar tramp-smb-version nil
- "*Version string of the SMB client.")
+ "Version string of the SMB client.")
-(defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
- "Regexp used as prompt in smbclient.")
+(defconst tramp-smb-server-version
+ "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
+ "Regexp of SMB server identification.")
+
+(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
+ "Regexp used as prompt in smbclient or powershell.")
+
+(defconst tramp-smb-wrong-passwd-regexp
+ (regexp-opt
+ '("NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_WRONG_PASSWORD"))
+ "Regexp for login error strings of SMB servers.")
(defconst tramp-smb-errors
(mapconcat
See `tramp-actions-before-shell' for more info.")
+(defconst tramp-smb-actions-with-tar
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-with-tar))
+ "List of pattern/action pairs.
+This list is used for tar-like copy of directories.
+
+See `tramp-actions-before-shell' for more info.")
+
;; New handlers should be added here.
(defconst tramp-smb-file-name-handler-alist
'(
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
+ (process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
(set-file-modes . tramp-smb-handle-set-file-modes)
;; `set-file-selinux-context' performed by default handler.
(set-file-times . ignore)
(set-visited-file-modtime . ignore)
- (shell-command . ignore)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(vc-registered . ignore)
"Alist of handler functions for Tramp SMB method.
Operations not mentioned here will be handled by the default Emacs primitives.")
+;; Options for remote processes via winexe.
+(defcustom tramp-smb-winexe-program "winexe"
+ "Name of winexe client to run.
+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.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.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.3")
+
;;;###tramp-autoload
(defsubst tramp-smb-file-name-p (filename)
"Check if it's a filename for SMB servers."
- (let ((v (tramp-dissect-file-name filename)))
- (string= (tramp-file-name-method v) tramp-smb-method)))
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-smb-method))
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
"error with add-name-to-file, see buffer `%s' for details"
(buffer-name))))))
+(defun tramp-smb-action-with-tar (proc vec)
+ "Untar from connection buffer."
+ (if (not (memq (process-status proc) '(run open)))
+ (throw 'tramp-action 'process-died)
+
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (when (search-forward-regexp tramp-smb-server-version nil t)
+ ;; There might be a hidden password prompt.
+ (widen)
+ (forward-line)
+ (tramp-message vec 6 (buffer-substring (point-min) (point)))
+ (delete-region (point-min) (point))
+ (throw 'tramp-action 'ok)))))
+
(defun tramp-smb-handle-copy-directory
(dirname newname &optional keep-date parents copy-contents)
- "Like `copy-directory' for Tramp files. KEEP-DATE is not handled."
+ "Like `copy-directory' for Tramp files."
(setq dirname (expand-file-name dirname)
newname (expand-file-name newname))
(let ((t1 (tramp-tramp-file-p dirname))
(t2 (tramp-tramp-file-p newname)))
(with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (tramp-with-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
(cond
;; We must use a local temporary directory.
((and t1 t2)
;; We can copy recursively.
((or t1 t2)
- (let ((prompt (tramp-smb-send-command v "prompt"))
- (recurse (tramp-smb-send-command v "recurse")))
- (unless (file-directory-p newname)
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
(make-directory newname parents))
+
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory))))
+ (args (list tramp-smb-program
+ (concat "//" real-host "/" share) "-E")))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (shell-quote-argument tmpdir)))
+ ;; Target is remote.
+ (append (list "tar" "cfC" "-" (shell-quote-argument dirname)
+ "." "|")
+ args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qx -")))))
+
(unwind-protect
- (unless
- (and
- prompt recurse
- (tramp-smb-send-command
- v (format "cd \"%s\"" (tramp-smb-get-localname v)))
- (tramp-smb-send-command
- v (format "lcd \"%s\"" (if t1 newname dirname)))
- (if t1
- (tramp-smb-send-command v "mget *")
- (tramp-smb-send-command v "mput *")))
- ;; Error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-errors nil t)
- (tramp-error
- v 'file-error
- "%s `%s'" (match-string 0) (if t1 dirname newname))))
- ;; Go home.
- (tramp-smb-send-command
- v (format
- "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\")))
- ;; Toggle prompt and recurse OFF.
- (if prompt (tramp-smb-send-command v "prompt"))
- (if recurse (tramp-smb-send-command v "recurse")))))
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates always complete
+ ;; paths. We must emulate the directory structure,
+ ;; and symlink to the real target.
+ (make-directory
+ (expand-file-name ".." (concat tmpdir localname)) 'parents)
+ (make-symbolic-link
+ newname (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this, password
+ ;; can be handled.
+ (let* ((default-directory tmpdir)
+ (p (start-process-shell-command
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ (mapconcat 'identity args " "))))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-with-tar)
+
+ (while (memq (process-status p) '(run open))
+ (sit-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when t1 (delete-directory tmpdir 'recurse))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes dirname))))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname))))
;; We must do it file-wise.
(t
(tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents)))))))
+ 'copy-directory (list dirname newname keep-date parents))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-selinux-context)
"Like `copy-file' for Tramp files.
-KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
+KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
- (let ((tmpfile (file-local-copy filename)))
-
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (file-directory-p newname)
- (setq newname
- (expand-file-name (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless (tramp-smb-get-share v)
- (tramp-error
- v 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- filename (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
+ (if (file-directory-p filename)
+ (tramp-compat-copy-directory filename newname keep-date t t)
+
+ (let ((tmpfile (file-local-copy filename)))
+ (if tmpfile
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (file-directory-p newname)
+ (setq newname
+ (expand-file-name (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+ (unless (tramp-smb-get-share v)
+ (tramp-error
+ v 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v (format "put \"%s\" \"%s\""
+ filename (tramp-smb-get-localname v)))
+ (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
- ;; KEEP-DATE handling.
- (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))))
+ ;; KEEP-DATE handling.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes filename))))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive)
"Like `delete-directory' for Tramp files."
"Implement `file-attributes' for Tramp files using stat command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(let* (size id link uid gid atime mtime ctime mode inode)
(when (tramp-smb-send-command
vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
"error with make-symbolic-link, see buffer `%s' for details"
(buffer-name))))))
+(defun tramp-smb-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (let* ((name (file-name-nondirectory program))
+ (name1 name)
+ (i 0)
+ input tmpinput outbuf command ret)
+
+ ;; Determine input.
+ (when infile
+ (setq infile (expand-file-name infile))
+ (if (tramp-equal-remote default-directory infile)
+ ;; INFILE is on the same remote host.
+ (setq input (with-parsed-tramp-file-name infile nil localname))
+ ;; INFILE must be copied to remote host.
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name method user host input))
+ (copy-file infile tmpinput t))
+ ;; Transform input into a filename powershell does understand.
+ (setq input (format "//%s%s" host input)))
+
+ ;; Determine output.
+ (cond
+ ;; Just a buffer.
+ ((bufferp destination)
+ (setq outbuf destination))
+ ;; A buffer name.
+ ((stringp destination)
+ (setq outbuf (get-buffer-create destination)))
+ ;; (REAL-DESTINATION ERROR-DESTINATION)
+ ((consp destination)
+ ;; output.
+ (cond
+ ((bufferp (car destination))
+ (setq outbuf (car destination)))
+ ((stringp (car destination))
+ (setq outbuf (get-buffer-create (car destination))))
+ ((car destination)
+ (setq outbuf (current-buffer))))
+ ;; stderr.
+ (tramp-message v 2 "%s" "STDERR not supported"))
+ ;; 't
+ (destination
+ (setq outbuf (current-buffer))))
+
+ ;; Construct command.
+ (setq command (mapconcat 'identity (cons program args) " ")
+ command (if input
+ (format
+ "get-content %s | & %s"
+ (tramp-smb-shell-quote-argument input) command)
+ (format "& %s" command)))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property
+ v "process-buffer"
+ (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
+
+ ;; Call it.
+ (condition-case nil
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Preserve buffer contents.
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format "cd \"//%s%s\"" host (file-name-directory localname))))
+ (tramp-smb-send-command v command)
+ ;; Preserve command output.
+ (narrow-to-region (point-max) (point-max))
+ (let ((p (tramp-get-connection-process v)))
+ (tramp-smb-send-command v "exit $lasterrorcode")
+ (while (memq (process-status p) '(run open))
+ (sleep-for 0.1)
+ (setq ret (process-exit-status p))))
+ (delete-region (point-min) (point-max))
+ (widen))
+
+ ;; When the user did interrupt, we should do it also. We use
+ ;; return code -1 as marker.
+ (quit
+ (setq ret -1))
+ ;; Handle errors.
+ (error
+ (setq ret 1)))
+
+ ;; We should show the output anyway.
+ (when (and outbuf display) (display-buffer outbuf))
+
+ ;; Cleanup. We remove all file cache values for the connection,
+ ;; because the remote process could have changed them.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when tmpinput (delete-file tmpinput))
+ (unless outbuf
+ (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
+
+ ;; `process-file-side-effects' has been introduced with GNU
+ ;; Emacs 23.2. If set to `nil', no remote file will be changed
+ ;; by `program'. If it doesn't exist, we assume its default
+ ;; value `t'.
+ (unless (and (boundp 'process-file-side-effects)
+ (not (symbol-value 'process-file-side-effects)))
+ (tramp-flush-directory-property v ""))
+
+ ;; Return exit status.
+ (if (equal ret -1)
+ (keyboard-quit)
+ ret))))
+
(defun tramp-smb-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
+
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error
+ (tramp-dissect-file-name
+ (if (file-remote-p filename) filename newname))
+ 'file-already-exists newname))
+
(tramp-with-progress-reporter
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Renaming %s to %s" filename newname)
- (let ((tmpfile (file-local-copy filename)))
-
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (file-directory-p newname)
- (setq newname (expand-file-name
- (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless (tramp-smb-send-command
- v (format "put %s \"%s\""
- filename (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot rename `%s'" filename)))))
+ (if (and (tramp-equal-remote filename newname)
+ (string-equal
+ (tramp-smb-get-share (tramp-dissect-file-name filename))
+ (tramp-smb-get-share (tramp-dissect-file-name newname))))
+ ;; We can rename directly.
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v2 (file-name-directory v2-localname))
+ (tramp-flush-file-property v2 v2-localname)
+ (unless (tramp-smb-get-share v2)
+ (tramp-error
+ v2 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v2 (format "rename \"%s\" \"%s\""
+ (tramp-smb-get-localname v1)
+ (tramp-smb-get-localname v2)))
+ (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
- (delete-file filename)))
+ ;; We must rename via copy.
+ (tramp-compat-copy-file filename newname ok-if-already-exists t t t)
+ (if (file-directory-p filename)
+ (tramp-compat-delete-directory filename 'recursive)
+ (delete-file filename)))))
(defun tramp-smb-handle-set-file-modes (filename mode)
"Like `set-file-modes' for Tramp files."
(tramp-error
v 'file-error "Error while changing file's mode %s" filename)))))
+;; We use BUFFER also as connection buffer during setup. Because of
+;; this, its original contents must be saved, and restored once
+;; connection has been setup.
+(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
+ "Like `start-file-process' for Tramp files."
+ (with-parsed-tramp-file-name default-directory nil
+ (let ((command (mapconcat 'identity (cons program args) " "))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0))
+ (unwind-protect
+ (save-excursion
+ (save-restriction
+ (unless buffer
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ ;; Activate narrowing in order to save BUFFER contents.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let ((buffer-undo-list t))
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format
+ "cd \"//%s%s\""
+ host (file-name-directory localname))))
+ (tramp-message v 6 "(%s); exit" command)
+ (tramp-send-string v command)))
+ ;; Return value.
+ (tramp-get-connection-process v)))
+
+ ;; Save exit.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (if (string-match tramp-temp-buffer-name (buffer-name))
+ (progn
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))
+
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `handle-substitute-in-file-name' for Tramp files.
\"//\" substitutes only in the local filename part. Catches
(with-parsed-tramp-file-name (file-name-as-directory directory) nil
(setq localname (or localname "/"))
(with-file-property v localname "file-entries"
- (with-current-buffer (tramp-get-buffer v)
+ (with-current-buffer (tramp-get-connection-buffer v)
(let* ((share (tramp-smb-get-share v))
(cache (tramp-get-connection-property v "share-cache" nil))
res entry)
(tramp-get-connection-process vec) "cifs-capabilities"
(save-match-data
(when (tramp-smb-send-command vec "posix")
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(when
(re-search-forward "Server supports CIFS capabilities" nil t)
(tramp-send-string vec command)
(tramp-smb-wait-for-output vec))
-(defun tramp-smb-maybe-open-connection (vec)
+(defun tramp-smb-maybe-open-connection (vec &optional argument)
"Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
+connection if a previous connection has died for some reason.
+If ARGUMENT is non-nil, use it as argument for
+`tramp-smb-winexe-program', and suppress any checks."
(let* ((share (tramp-smb-get-share vec))
- (buf (tramp-get-buffer vec))
+ (buf (tramp-get-connection-buffer vec))
(p (get-buffer-process buf)))
;; Check whether we still have the same smbclient version.
;; Otherwise, we must delete the connection cache, because
;; capabilities migh have changed.
- (unless (processp p)
+ (unless (or argument (processp p))
(let ((default-directory (tramp-compat-temporary-file-directory))
(command (concat tramp-smb-program " -V")))
;; Check whether it is still the same share.
(unless
(and p (processp p) (memq (process-status p) '(run open))
- (string-equal
- share
- (tramp-get-connection-property p "smb-share" "")))
+ (or argument
+ (string-equal
+ share
+ (tramp-get-connection-property p "smb-share" ""))))
(save-match-data
;; There might be unread output from checking for share names.
(port (tramp-file-name-port vec))
args)
- (if share
- (setq args (list (concat "//" real-host "/" share)))
- (setq args (list "-g" "-L" real-host )))
+ (cond
+ (argument
+ (setq args (list (concat "//" real-host))))
+ (share
+ (setq args (list (concat "//" real-host "/" share))))
+ (t
+ (setq args (list "-g" "-L" real-host ))))
(if (not (zerop (length real-user)))
(setq args (append args (list "-U" real-user)))
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
+ (when argument
+ (setq args (append args (list argument))))
;; OK, let's go.
(tramp-with-progress-reporter
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(apply #'start-process
- (tramp-buffer-name vec) (tramp-get-buffer vec)
- tramp-smb-program args))))
+ (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ (if argument
+ tramp-smb-winexe-program tramp-smb-program)
+ args))))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
tramp-current-user user
tramp-current-host host)
- ;; Play login scenario.
- (tramp-process-actions
- p vec nil
- (if share
- tramp-smb-actions-with-share
- tramp-smb-actions-without-share))
-
- ;; Check server version.
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (search-forward-regexp
- "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t)
- (let ((smbserver-version (match-string 0)))
- (unless
- (string-equal
- smbserver-version
- (tramp-get-connection-property
- vec "smbserver-version" smbserver-version))
- (tramp-flush-directory-property vec "")
- (tramp-flush-connection-property vec))
- (tramp-set-connection-property
- vec "smbserver-version" smbserver-version)))
-
- ;; Set chunksize. Otherwise, `tramp-send-string' might
- ;; try it itself.
- (tramp-set-connection-property p "smb-share" share)
- (tramp-set-connection-property
- p "chunksize" tramp-chunksize))))))))
+ (condition-case err
+ (let (tramp-message-show-message)
+ ;; Play login scenario.
+ (tramp-process-actions
+ p vec nil
+ (if (or argument share)
+ tramp-smb-actions-with-share
+ tramp-smb-actions-without-share))
+
+ ;; Check server version.
+ (unless argument
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (search-forward-regexp tramp-smb-server-version nil t)
+ (let ((smbserver-version (match-string 0)))
+ (unless
+ (string-equal
+ smbserver-version
+ (tramp-get-connection-property
+ vec "smbserver-version" smbserver-version))
+ (tramp-flush-directory-property vec "")
+ (tramp-flush-connection-property vec))
+ (tramp-set-connection-property
+ vec "smbserver-version" smbserver-version))))
+
+ ;; Set chunksize. Otherwise, `tramp-send-string' might
+ ;; try it itself.
+ (tramp-set-connection-property p "smb-share" share)
+ (tramp-set-connection-property
+ p "chunksize" tramp-chunksize))
+
+ ;; Check for the error reason. If it was due to wrong
+ ;; password, reestablish the connection. We cannot
+ ;; handle this in `tramp-process-actions', because
+ ;; smbclient does not ask for the password, again.
+ (error
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (if (search-forward-regexp
+ tramp-smb-wrong-passwd-regexp nil t)
+ ;; Disable `auth-source' and `password-cache'.
+ (let (auth-sources)
+ (tramp-cleanup vec)
+ (tramp-smb-maybe-open-connection vec argument))
+ ;; Propagate the error.
+ (signal (car err) (cdr err)))))))))))))
;; We don't use timeouts. If needed, the caller shall wrap around.
(defun tramp-smb-wait-for-output (vec)
"Wait for output from smbclient command.
Returns nil if an error message has appeared."
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(let ((p (get-buffer-process (current-buffer)))
(found (progn (goto-char (point-min))
(re-search-forward tramp-smb-prompt nil t)))
(goto-char (point-min))
(setq found (re-search-forward tramp-smb-prompt nil t)))
- ;; Return value is whether no error message has appeared.
(tramp-message vec 6 "\n%s" (buffer-string))
+
+ ;; Remove prompt.
+ (when found
+ (goto-char (point-max))
+ (re-search-backward tramp-smb-prompt nil t)
+ (delete-region (point) (point-max)))
+
+ ;; Return value is whether no error message has appeared.
(not err))))
+(defun tramp-smb-kill-winexe-function ()
+ "Send SIGKILL to the winexe process."
+ (ignore-errors
+ (let ((p (get-buffer-process (current-buffer))))
+ (when (and p (processp p) (memq (process-status p) '(run open)))
+ (signal-process (process-id p) 'SIGINT)))))
+
+(defun tramp-smb-call-winexe (vec)
+ "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
+
+ ;; We call `tramp-get-buffer' in order to get a debug buffer for
+ ;; messages.
+ (tramp-get-buffer vec)
+
+ ;; Check for program.
+ (unless (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (executable-find tramp-smb-winexe-program))
+ (tramp-error
+ vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
+
+ ;; winexe does not supports ports.
+ (when (tramp-file-name-port vec)
+ (tramp-error vec 'file-error "Port not supported for remote processes"))
+
+ (tramp-smb-maybe-open-connection
+ vec
+ (format
+ "%s %s"
+ tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
+
+ (set (make-local-variable 'kill-buffer-hook)
+ '(tramp-smb-kill-winexe-function))
+
+ ;; Suppress "^M". Shouldn't we specify utf8?
+ (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
+
+ ;; Set width to 128. This avoids mixing prompt and long error messages.
+ (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
+ (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
+ (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
+ (tramp-smb-send-command vec "$bufsize.Width = 128")
+ (tramp-smb-send-command vec "$winsize.Width = 128")
+ (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
+ (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
+
+(defun tramp-smb-shell-quote-argument (s)
+ "Similar to `shell-quote-argument', but uses windows cmd syntax."
+ (let ((system-type 'ms-dos))
+ (shell-quote-argument s)))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-smb 'force)))
;;; TODO:
-;; * Error handling in case password is wrong.
;; * Return more comprehensive file permission string.
;; * Try to remove the inclusion of dummy "" directory. Seems to be at
;; several places, especially in `tramp-smb-handle-insert-directory'.
-;; * (RMS) Use unwind-protect to clean up the state so as to make the state
-;; regular again.
;; * Ignore case in file names.
;;; tramp-smb.el ends here
;;; Code:
+(eval-when-compile (require 'cl)) ; ignore-errors
(require 'tramp-compat)
;;; User Customizable Internal Variables:
(defgroup tramp nil
- "Edit remote files with a combination of rsh and rcp or similar programs."
+ "Edit remote files with a combination of ssh, scp, etc."
:group 'files
:group 'comm
:version "22.1")
;; Maybe we need once a real Tramp mode, with key bindings etc.
;;;###autoload
(defcustom tramp-mode t
- "*Whether Tramp is enabled.
+ "Whether Tramp is enabled.
If it is set to nil, all remote file names are used literally."
:group 'tramp
:type 'boolean)
(defcustom tramp-verbose 3
- "*Verbosity level for Tramp messages.
+ "Verbosity level for Tramp messages.
Any level x includes messages for all levels 1 .. x-1. The levels are
0 silent (no tramp messages at all)
(eval-and-compile
(when (featurep 'xemacs)
(defcustom tramp-bkup-backup-directory-info nil
- "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
+ "Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
It has the same meaning like `bkup-backup-directory-info' from package
`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
file name, the backup directory is prepended with Tramp file name prefix
:group 'tramp)))
(defcustom tramp-auto-save-directory nil
- "*Put auto-save files in this directory, if set.
+ "Put auto-save files in this directory, if set.
The idea is to use a local directory so that auto-saving is faster."
:group 'tramp
:type '(choice (const nil) string))
(if (memq system-type '(windows-nt))
(getenv "COMSPEC")
"/bin/sh")
- "*Use this program for encoding and decoding commands on the local host.
+ "Use this program for encoding and decoding commands on the local host.
This shell is used to execute the encoding and decoding command on the
local host, so if you want to use `~' in those commands, you should
choose a shell here which groks tilde expansion. `/bin/sh' normally
(if (string-match "cmd\\.exe" tramp-encoding-shell)
"/c"
"-c")
- "*Use this switch together with `tramp-encoding-shell' for local commands.
+ "Use this switch together with `tramp-encoding-shell' for local commands.
See the variable `tramp-encoding-shell' for more information."
:group 'tramp
:type 'string)
(defcustom tramp-encoding-command-interactive
(unless (string-match "cmd\\.exe" tramp-encoding-shell) "-i")
- "*Use this switch together with `tramp-encoding-shell' for interactive shells.
+ "Use this switch together with `tramp-encoding-shell' for interactive shells.
See the variable `tramp-encoding-shell' for more information."
:version "24.1"
:group 'tramp
;;;###tramp-autoload
(defvar tramp-methods nil
- "*Alist of methods for remote files.
+ "Alist of methods for remote files.
This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
Each NAME stands for a remote access method. Each PARAM is a
pair of the form (KEY VALUE). The following KEYs are defined:
* `tramp-gw-args'
As the attribute name says, additional arguments are specified here
when a method is applied via a gateway.
- * `tramp-password-end-of-line'
- This specifies the string to use for terminating the line after
- submitting the password. If this method parameter is nil, then the
- value of the normal variable `tramp-default-password-end-of-line'
- is used. This parameter is necessary because the \"plink\" program
- requires any two characters after sending the password. These do
- not have to be newline or carriage return characters. Other login
- programs are happy with just one character, the newline character.
- We use \"xy\" as the value for methods using \"plink\".
* `tramp-tmpdir'
A directory on the remote host for temporary files. If not
specified, \"/tmp\" is taken as default.
(t "ssh")))
;; Fallback.
(t "ftp"))
- "*Default method to use for transferring files.
+ "Default method to use for transferring files.
See `tramp-methods' for possibilities.
Also see `tramp-default-method-alist'."
:group 'tramp
;;;###tramp-autoload
(defcustom tramp-default-method-alist nil
- "*Default method to use for specific host/user pairs.
+ "Default method to use for specific host/user pairs.
This is an alist of items (HOST USER METHOD). The first matching item
specifies the method to use for a file name which does not specify a
method. HOST and USER are regular expressions or nil, which is
(choice :tag "Method name" string (const nil)))))
(defcustom tramp-default-user nil
- "*Default user to use for transferring files.
+ "Default user to use for transferring files.
It is nil by default; otherwise settings in configuration files like
\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
;;;###tramp-autoload
(defcustom tramp-default-user-alist nil
- "*Default user to use for specific method/host pairs.
+ "Default user to use for specific method/host pairs.
This is an alist of items (METHOD HOST USER). The first matching item
specifies the user to use for a file name which does not specify a
user. METHOD and USER are regular expressions or nil, which is
(choice :tag " User name" string (const nil)))))
(defcustom tramp-default-host (system-name)
- "*Default host to use for transferring files.
+ "Default host to use for transferring files.
Useful for su and sudo methods mostly."
:group 'tramp
:type 'string)
(defcustom tramp-default-proxies-alist nil
- "*Route to be followed for specific host/user pairs.
+ "Route to be followed for specific host/user pairs.
This is an alist of items (HOST USER PROXY). The first matching
item specifies the proxy to be passed for a file name located on
a remote target matching USER@HOST. HOST and USER are regular
(choice :tag "User regexp" regexp sexp)
(choice :tag " Proxy name" string (const nil)))))
+(defcustom tramp-save-ad-hoc-proxies nil
+ "Whether to save ad-hoc proxies persistently."
+ :group 'tramp
+ :type 'boolean)
+
+(defcustom tramp-restricted-shell-hosts-alist
+ (when (memq system-type '(windows-nt))
+ (list (concat "\\`" (regexp-quote (system-name)) "\\'")))
+ "List of hosts, which run a restricted shell.
+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.3"
+ :group 'tramp
+ :type '(repeat (regexp :tag "Host regexp")))
+
;;;###tramp-autoload
(defconst tramp-local-host-regexp
(concat
(regexp-opt
(list "localhost" "localhost6" (system-name) "127\.0\.0\.1" "::1") t)
"\\'")
- "*Host names which are regarded as local host.")
+ "Host names which are regarded as local host.")
(defvar tramp-completion-function-alist nil
- "*Alist of methods for remote files.
+ "Alist of methods for remote files.
This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\).
Each NAME stands for a remote access method. Each PAIR is of the form
\(FUNCTION FILE\). FUNCTION is responsible to extract user names and host
* `tramp-parse-hosts' for \"/etc/hosts\" like files,
* `tramp-parse-passwd' for \"/etc/passwd\" like files.
* `tramp-parse-netrc' for \"~/.netrc\" like files.
- * `tramp-parse-putty' for PuTTY registry keys.
+ * `tramp-parse-putty' for PuTTY registered sessions.
FUNCTION can also be a customer defined function. For more details see
the info pages.")
(defcustom tramp-local-end-of-line
(if (memq system-type '(windows-nt)) "\r\n" "\n")
- "*String used for end of line in local processes."
+ "String used for end of line in local processes."
:version "24.1"
:group 'tramp
:type 'string)
(defcustom tramp-rsh-end-of-line "\n"
- "*String used for end of line in rsh connections.
+ "String used for end of line in rsh connections.
I don't think this ever needs to be changed, so please tell me about it
-if you need to change this.
-Also see the method parameter `tramp-password-end-of-line' and the normal
-variable `tramp-default-password-end-of-line'."
- :group 'tramp
- :type 'string)
-
-(defcustom tramp-default-password-end-of-line
- tramp-rsh-end-of-line
- "*String used for end of line after sending a password.
-This variable provides the default value for the method parameter
-`tramp-password-end-of-line', see `tramp-methods' for more details.
-
-It seems that people using plink under Windows need to send
-\"\\r\\n\" (carriage-return, then newline) after a password, but just
-\"\\n\" after all other lines. This variable can be used for the
-password, see `tramp-rsh-end-of-line' for the other cases.
-
-The default value is to use the same value as `tramp-rsh-end-of-line'."
+if you need to change this."
:group 'tramp
:type 'string)
(defcustom tramp-login-prompt-regexp
".*ogin\\( .*\\)?: *"
- "*Regexp matching login-like prompts.
+ "Regexp matching login-like prompts.
The regexp should match at end of buffer.
Sometimes the prompt is reported to look like \"login as:\"."
;; Allow a prompt to start right after a ^M since it indeed would be
;; displayed at the beginning of the line (and Zsh uses it). This
;; regexp works only for GNU Emacs.
+ ;; Allow also [] style prompts. They can appear only during
+ ;; connection initialization; Tramp redefines the prompt afterwards.
(concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)")
- "[^#$%>\n]*#?[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
+ "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
"Regexp to match prompts from remote shell.
Normally, Tramp expects you to configure `shell-prompt-pattern'
correctly, but sometimes it happens that you are connecting to a
(defcustom tramp-password-prompt-regexp
"^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *"
- "*Regexp matching password-like prompts.
+ "Regexp matching password-like prompts.
The regexp should match at end of buffer.
The `sudo' program appears to insert a `^@' character into the prompt."
;; Here comes a list of regexes, separated by \\|
"Received signal [0-9]+"
"\\).*")
- "*Regexp matching a `login failed' message.
+ "Regexp matching a `login failed' message.
The regexp should match at end of buffer."
:group 'tramp
:type 'regexp)
:type 'regexp)
(defconst tramp-temp-name-prefix "tramp."
- "*Prefix to use for temporary files.
+ "Prefix to use for temporary files.
If this is a relative file name (such as \"tramp.\"), it is considered
relative to the directory name returned by the function
`tramp-compat-temporary-file-directory' (which see). It may also be an
((equal tramp-syntax 'sep) "/[")
((equal tramp-syntax 'url) "/")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching the very beginning of Tramp file names.
+ "String matching the very beginning of Tramp file names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-prefix-regexp
(concat "^" (regexp-quote tramp-prefix-format))
- "*Regexp matching the very beginning of Tramp file names.
+ "Regexp matching the very beginning of Tramp file names.
Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp
"[a-zA-Z_0-9-]+"
- "*Regexp matching methods identifiers.")
+ "Regexp matching methods identifiers.")
(defconst tramp-postfix-method-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "/")
((equal tramp-syntax 'url) "://")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching delimiter between method and user or host names.
+ "String matching delimiter between method and user or host names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-method-regexp
(regexp-quote tramp-postfix-method-format)
- "*Regexp matching delimiter between method and user or host names.
+ "Regexp matching delimiter between method and user or host names.
Derived from `tramp-postfix-method-format'.")
-(defconst tramp-user-regexp "[^:/ \t]+"
- "*Regexp matching user names.")
+(defconst tramp-user-regexp "[^/|: \t]+"
+ "Regexp matching user names.")
;;;###tramp-autoload
(defconst tramp-prefix-domain-format "%"
- "*String matching delimiter between user and domain names.")
+ "String matching delimiter between user and domain names.")
;;;###tramp-autoload
(defconst tramp-prefix-domain-regexp
(regexp-quote tramp-prefix-domain-format)
- "*Regexp matching delimiter between user and domain names.
+ "Regexp matching delimiter between user and domain names.
Derived from `tramp-prefix-domain-format'.")
(defconst tramp-domain-regexp "[-a-zA-Z0-9_.]+"
- "*Regexp matching domain names.")
+ "Regexp matching domain names.")
(defconst tramp-user-with-domain-regexp
(concat "\\(" tramp-user-regexp "\\)"
tramp-prefix-domain-regexp
"\\(" tramp-domain-regexp "\\)")
- "*Regexp matching user names with domain names.")
+ "Regexp matching user names with domain names.")
(defconst tramp-postfix-user-format "@"
- "*String matching delimiter between user and host names.
+ "String matching delimiter between user and host names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-user-regexp
(regexp-quote tramp-postfix-user-format)
- "*Regexp matching delimiter between user and host names.
+ "Regexp matching delimiter between user and host names.
Derived from `tramp-postfix-user-format'.")
(defconst tramp-host-regexp "[a-zA-Z0-9_.-]+"
- "*Regexp matching host names.")
+ "Regexp matching host names.")
(defconst tramp-prefix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "[")
((equal tramp-syntax 'sep) "")
((equal tramp-syntax 'url) "[")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching left hand side of IPv6 addresses.
+ "String matching left hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-prefix-ipv6-regexp
(regexp-quote tramp-prefix-ipv6-format)
- "*Regexp matching left hand side of IPv6 addresses.
+ "Regexp matching left hand side of IPv6 addresses.
Derived from `tramp-prefix-ipv6-format'.")
;; The following regexp is a bit sloppy. But it shall serve our
;; "::ffff:192.168.0.1".
(defconst tramp-ipv6-regexp
"\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+"
- "*Regexp matching IPv6 addresses.")
+ "Regexp matching IPv6 addresses.")
(defconst tramp-postfix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "]")
((equal tramp-syntax 'sep) "")
((equal tramp-syntax 'url) "]")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching right hand side of IPv6 addresses.
+ "String matching right hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-ipv6-regexp
(regexp-quote tramp-postfix-ipv6-format)
- "*Regexp matching right hand side of IPv6 addresses.
+ "Regexp matching right hand side of IPv6 addresses.
Derived from `tramp-postfix-ipv6-format'.")
(defconst tramp-prefix-port-format
((equal tramp-syntax 'sep) "#")
((equal tramp-syntax 'url) ":")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching delimiter between host names and port numbers.")
+ "String matching delimiter between host names and port numbers.")
(defconst tramp-prefix-port-regexp
(regexp-quote tramp-prefix-port-format)
- "*Regexp matching delimiter between host names and port numbers.
+ "Regexp matching delimiter between host names and port numbers.
Derived from `tramp-prefix-port-format'.")
(defconst tramp-port-regexp "[0-9]+"
- "*Regexp matching port numbers.")
+ "Regexp matching port numbers.")
(defconst tramp-host-with-port-regexp
(concat "\\(" tramp-host-regexp "\\)"
tramp-prefix-port-regexp
"\\(" tramp-port-regexp "\\)")
- "*Regexp matching host names with port numbers.")
+ "Regexp matching host names with port numbers.")
+
+(defconst tramp-postfix-hop-format "|"
+ "String matching delimiter after ad-hoc hop definitions.")
+
+(defconst tramp-postfix-hop-regexp
+ (regexp-quote tramp-postfix-hop-format)
+ "Regexp matching delimiter after ad-hoc hop definitions.
+Derived from `tramp-postfix-hop-format'.")
(defconst tramp-postfix-host-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "]")
((equal tramp-syntax 'url) "")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching delimiter between host names and localnames.
+ "String matching delimiter between host names and localnames.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-host-regexp
(regexp-quote tramp-postfix-host-format)
- "*Regexp matching delimiter between host names and localnames.
+ "Regexp matching delimiter between host names and localnames.
Derived from `tramp-postfix-host-format'.")
(defconst tramp-localname-regexp ".*$"
- "*Regexp matching localnames.")
+ "Regexp matching localnames.")
;;; File name format:
+(defconst tramp-remote-file-name-spec-regexp
+ (concat
+ "\\(?:" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
+ "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
+ "\\(" "\\(?:" tramp-host-regexp "\\|"
+ tramp-prefix-ipv6-regexp tramp-ipv6-regexp
+ tramp-postfix-ipv6-regexp "\\)"
+ "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")
+"Regular expression matching a Tramp file name between prefix and postfix.")
+
(defconst tramp-file-name-structure
(list
(concat
tramp-prefix-regexp
- "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
- "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
- "\\(" "\\(" tramp-host-regexp
- "\\|"
- tramp-prefix-ipv6-regexp tramp-ipv6-regexp
- tramp-postfix-ipv6-regexp "\\)"
- "\\(" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"
- tramp-postfix-host-regexp
+ "\\(" "\\(?:" tramp-remote-file-name-spec-regexp
+ tramp-postfix-hop-regexp "\\)+" "\\)?"
+ tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp
"\\(" tramp-localname-regexp "\\)")
- 2 4 5 8)
-
- "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
+ 5 6 7 8 1)
+ "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \
the Tramp file name structure.
The first element REGEXP is a regular expression matching a Tramp file
parentheses matches the method name. The third element USER is
similar, but for the user name. The fourth element HOST is similar,
but for the host name. The fifth element FILE is for the file name.
+The last element HOP is the ad-hoc hop definition, which could be a
+cascade of several hops.
+
These numbers are passed directly to `match-string', which see. That
means the opening parentheses are counted to identify the pair.
;;;###autoload
(defconst tramp-file-name-regexp-unified
(if (memq system-type '(cygwin windows-nt))
- "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):"
- "\\`/\\([^[/:]+\\|[^/]+]\\):")
+ "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):"
+ "\\`/\\([^[/|:]+\\|[^/|]+]\\):")
"Value for `tramp-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
Tramp. See `tramp-file-name-structure' for more explanations.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
-(defconst tramp-file-name-regexp-url "\\`/[^/:]+://"
+(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://"
"Value for `tramp-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
((equal tramp-syntax 'url) tramp-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
- "*Regular expression matching file names handled by Tramp.
+ "Regular expression matching file names handled by Tramp.
This regexp should match Tramp file names but no other file names.
When tramp.el is loaded, this regular expression is prepended to
`file-name-handler-alist', and that is searched sequentially. Thus,
((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
- "*Regular expression matching file names handled by Tramp completion.
+ "Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
Please note that the entry in `file-name-handler-alist' is made when
;; Parentheses in docstring starting at beginning of line are escaped.
;; Fontification is messed up when
;; `open-paren-in-column-0-is-defun-start' set to t.
- "*If non-nil, chunksize for sending input to local process.
+ "If non-nil, chunksize for sending input to local process.
It is necessary only on systems which have a buggy `process-send-string'
implementation. The necessity, whether this variable must be set, can be
checked via the following code:
;; internal data structure. Convenience functions for internal
;; data structure.
+(defun tramp-get-method-parameter (method param)
+ "Return the method parameter PARAM.
+If the `tramp-methods' entry does not exist, return nil."
+ (let ((entry (assoc param (assoc method tramp-methods))))
+ (when entry (cadr entry))))
+
(defun tramp-file-name-p (vec)
"Check, whether VEC is a Tramp object."
- (and (vectorp vec) (= 4 (length vec))))
+ (and (vectorp vec) (= 5 (length vec))))
(defun tramp-file-name-method (vec)
"Return method component of VEC."
"Return localname component of VEC."
(and (tramp-file-name-p vec) (aref vec 3)))
+(defun tramp-file-name-hop (vec)
+ "Return hop component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 4)))
+
;; The user part of a Tramp file name vector can be of kind
;; "user%domain". Sometimes, we must extract these parts.
(defun tramp-file-name-real-user (vec)
(let ((method (match-string (nth 1 tramp-file-name-structure) name))
(user (match-string (nth 2 tramp-file-name-structure) name))
(host (match-string (nth 3 tramp-file-name-structure) name))
- (localname (match-string (nth 4 tramp-file-name-structure) name)))
+ (localname (match-string (nth 4 tramp-file-name-structure) name))
+ (hop (match-string (nth 5 tramp-file-name-structure) name)))
(when host
(when (string-match tramp-prefix-ipv6-regexp host)
(setq host (replace-match "" nil t host)))
(when (string-match tramp-postfix-ipv6-regexp host)
(setq host (replace-match "" nil t host))))
(if nodefault
- (vector method user host localname)
+ (vector method user host localname hop)
(vector
(tramp-find-method method user host)
(tramp-find-user method user host)
(tramp-find-host method user host)
- localname))))))
+ localname hop))))))
(defun tramp-buffer-name (vec)
"A name for the connection buffer VEC."
(format "*tramp/%s %s@%s*" method user host)
(format "*tramp/%s %s*" method host))))
-(defun tramp-make-tramp-file-name (method user host localname)
- "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
- (concat tramp-prefix-format
+(defun tramp-make-tramp-file-name (method user host localname &optional hop)
+ "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
+When not nil, an optional HOP is prepended."
+ (concat tramp-prefix-format hop
(when (not (zerop (length method)))
(concat method tramp-postfix-method-format))
(when (not (zerop (length user)))
This variable is used to disable messages from `tramp-error'.
The messages are visible anyway, because an error is raised.")
+(defvar tramp-message-show-progress-reporter-message t
+ "Show Tramp progress reporter message in the minibuffer.
+This variable is used to disable recursive progress reporter messages.")
+
(defsubst tramp-message (vec-or-proc level fmt-string &rest args)
"Emit a message depending on verbosity level.
VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
(unwind-protect
(apply 'tramp-error vec-or-proc signal fmt-string args)
(when (and vec-or-proc
+ tramp-message-show-message
(not (zerop tramp-verbose))
(not (tramp-completion-mode-p)))
(let ((enable-recursive-minibuffers t))
(pop-to-buffer
(or (and (bufferp buffer) buffer)
(and (processp vec-or-proc) (process-buffer vec-or-proc))
- (tramp-get-buffer vec-or-proc)))
+ (tramp-get-connection-buffer vec-or-proc)))
(sit-for 30))))))
(defmacro with-parsed-tramp-file-name (filename var &rest body)
the filename structure. It is also used as a prefix for the variables
holding the components. For example, if VAR is the symbol `foo', then
`foo' will be bound to the whole structure, `foo-method' will be bound to
-the method component, and so on for `foo-user', `foo-host', `foo-localname'.
+the method component, and so on for `foo-user', `foo-host', `foo-localname',
+`foo-hop'.
Remaining args are Lisp expressions to be evaluated (inside an implicit
`progn').
If VAR is nil, then we bind `v' to the structure and `method', `user',
-`host', `localname' to the components."
+`host', `localname', `hop' to the components."
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
(,(if var (intern (concat (symbol-name var) "-method")) 'method)
(tramp-file-name-method ,(or var 'v)))
(,(if var (intern (concat (symbol-name var) "-host")) 'host)
(tramp-file-name-host ,(or var 'v)))
(,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
- (tramp-file-name-localname ,(or var 'v))))
+ (tramp-file-name-localname ,(or var 'v)))
+ (,(if var (intern (concat (symbol-name var) "-hop")) 'hop)
+ (tramp-file-name-hop ,(or var 'v))))
,@body))
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
(tramp-message ,vec ,level "%s..." ,message)
;; We start a pulsing progress reporter after 3 seconds. Feature
;; introduced in Emacs 24.1.
- (when (and tramp-message-show-message
+ (when (and tramp-message-show-progress-reporter-message
+ tramp-message-show-message
;; Display only when there is a minimum level.
(<= ,level (min tramp-verbose 3)))
(ignore-errors
tm (when pr
(run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
(unwind-protect
- ;; Execute the body. Unset `tramp-message-show-message' when
- ;; the timer object is created, in order to suppress
- ;; concurrent timers.
- (let ((tramp-message-show-message
- (and tramp-message-show-message (not tm))))
+ ;; Execute the body. Suppress concurrent progress reporter
+ ;; messages.
+ (let ((tramp-message-show-progress-reporter-message
+ (and tramp-message-show-progress-reporter-message (not tm))))
,@body)
;; Stop progress reporter.
(if tm (tramp-compat-funcall 'cancel-timer tm))
'identity))
+(if (featurep 'xemacs)
+ (defalias 'tramp-drop-volume-letter 'identity))
+
+(defun tramp-cleanup (vec)
+ "Cleanup connection VEC, but keep the debug buffer."
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ ;; Keep the debug buffer.
+ (rename-buffer
+ (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
+ (tramp-cleanup-connection vec)
+ (if (= (point-min) (point-max))
+ (kill-buffer nil)
+ (rename-buffer (tramp-debug-buffer-name vec) 'unique))
+ ;; We call `tramp-get-buffer' in order to keep the debug buffer.
+ (tramp-get-buffer vec)))
+
;;; Config Manipulation Functions:
;;;###tramp-autoload
FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
The FUNCTION is intended to parse FILE according its syntax.
It might be a predefined FUNCTION, or a user defined FUNCTION.
-Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
-`tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd',
-and `tramp-parse-netrc'.
+For the list of predefined FUNCTIONs see `tramp-completion-function-alist'.
Example:
(ignore-errors
(let ((end (or (tramp-compat-funcall
'overlay-end (symbol-value 'rfn-eshadow-overlay))
- (tramp-compat-funcall 'minibuffer-prompt-end))))
+ (tramp-compat-funcall 'minibuffer-prompt-end)))
+ ;; We do not want to send any remote command.
+ (non-essential t))
(when
(file-remote-p
(tramp-compat-funcall
;; Emacs 23+ only.
'copy-directory
;; Emacs 24+ only.
- 'file-equal-p 'file-in-directory-p
+ 'file-in-directory-p 'file-equal-p
;; XEmacs only.
'dired-make-relative-symlink
'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
(with-parsed-tramp-file-name filename nil
;; Call the backend function.
(if foreign
- (condition-case err
- (let ((sf (symbol-function foreign)))
+ (tramp-compat-condition-case-unless-debug err
+ (let ((sf (symbol-function foreign))
+ result)
;; Some packages set the default directory to a
;; remote path, before respective Tramp packages
;; are already loaded. This results in
(let ((default-directory
(tramp-compat-temporary-file-directory)))
(load (cadr sf) 'noerror 'nomessage)))
- (apply foreign operation args))
+ ;; If `non-essential' is non-nil, Tramp shall
+ ;; not open a new connection.
+ ;; If Tramp detects that it shouldn't continue
+ ;; to work, it throws the `suppress' event.
+ ;; This could happen for example, when Tramp
+ ;; tries to open the same connection twice in a
+ ;; short time frame.
+ ;; In both cases, we try the default handler then.
+ (setq result
+ (catch 'non-essential
+ (catch 'suppress
+ (apply foreign operation args))))
+ (cond
+ ((eq result 'non-essential)
+ (tramp-message
+ v 5 "Non-essential received in operation %s"
+ (append (list operation) args))
+ (tramp-run-real-handler operation args))
+ ((eq result 'suppress)
+ (let (tramp-message-show-message)
+ (tramp-message
+ v 1 "Suppress received in operation %s"
+ (append (list operation) args))
+ (tramp-cleanup v)
+ (tramp-run-real-handler operation args)))
+ (t result)))
;; Trace that somebody has interrupted the operation.
((debug quit)
;; operations shall return at least a default value
;; in order to give the user a chance to correct the
;; file name in the minibuffer.
- ;; We cannot use `debug' as error handler. In order
- ;; to get a full backtrace, one could apply
+ ;; In order to get a full backtrace, one could apply
;; (setq debug-on-error t debug-on-signal t)
(error
(cond
(defun tramp-completion-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for partial Tramp files."
- (let* ((fullname (tramp-drop-volume-letter
- (expand-file-name filename directory)))
- ;; Possible completion structures.
- (v (tramp-completion-dissect-file-name fullname))
- result result1)
-
- (while v
- (let* ((car (car v))
- (method (tramp-file-name-method car))
- (user (tramp-file-name-user car))
- (host (tramp-file-name-host car))
- (localname (tramp-file-name-localname car))
+ (let ((fullname
+ (tramp-drop-volume-letter (expand-file-name filename directory)))
+ hop result result1)
+
+ ;; Suppress hop from completion.
+ (when (string-match
+ (concat
+ tramp-prefix-regexp
+ "\\(" "\\(" tramp-remote-file-name-spec-regexp
+ tramp-postfix-hop-regexp
+ "\\)+" "\\)")
+ fullname)
+ (setq hop (match-string 1 fullname)
+ fullname (replace-match "" nil nil fullname 1)))
+
+ ;; Possible completion structures.
+ (dolist (elt (tramp-completion-dissect-file-name fullname))
+ (let* ((method (tramp-file-name-method elt))
+ (user (tramp-file-name-user elt))
+ (host (tramp-file-name-host elt))
+ (localname (tramp-file-name-localname elt))
(m (tramp-find-method method user host))
(tramp-current-user user) ; see `tramp-parse-passwd'
all-user-hosts)
;; Possible methods.
(setq result
- (append result (tramp-get-completion-methods m)))))
-
- (setq v (cdr v))))
+ (append result (tramp-get-completion-methods m)))))))
- ;; Unify list, remove nil elements.
- (while result
- (let ((car (car result)))
- (when car
- (add-to-list
- 'result1
- (substring car (length (tramp-drop-volume-letter directory)))))
- (setq result (cdr result))))
+ ;; Unify list, add hop, remove nil elements.
+ (dolist (elt result)
+ (when elt
+ (string-match tramp-prefix-regexp elt)
+ (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt))
+ (add-to-list
+ 'result1
+ (substring elt (length (tramp-drop-volume-letter directory))))))
;; Complete local parts.
(append
(concat tramp-prefix-regexp "/$"))
1 nil 3 nil)))
- (mapc (lambda (regexp)
+ (mapc (lambda (structure)
(add-to-list 'result
- (tramp-completion-dissect-file-name1 regexp name)))
+ (tramp-completion-dissect-file-name1 structure name)))
(list
tramp-completion-file-name-structure1
tramp-completion-file-name-structure2
(match-string (nth 3 structure) name)))
(localname (and (nth 4 structure)
(match-string (nth 4 structure) name))))
- (vector method user host localname)))))
+ (vector method user host localname nil)))))
;; This function returns all possible method completions, adding the
;; trailing method delimiter.
(mapcar 'car tramp-methods)))
;; Compares partial user and host names with possible completions.
-(defun tramp-get-completion-user-host (method partial-user partial-host user host)
+(defun tramp-get-completion-user-host
+ (method partial-user partial-host user host)
"Returns the most expanded string for user and host name completion.
PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
(cond
(unless (zerop (+ (length user) (length host)))
(tramp-completion-make-tramp-file-name method user host nil)))
-;;;###tramp-autoload
-(defun tramp-parse-rhosts (filename)
+;; Generic function.
+(defun tramp-parse-group (regexp match-level skip-regexp)
+ "Return a (user host) tuple allowed to access.
+User is always nil."
+ (let (result)
+ (when (re-search-forward regexp (point-at-eol) t)
+ (setq result (list nil (match-string match-level))))
+ (or
+ (> (skip-chars-forward skip-regexp) 0)
+ (forward-line 1))
+ result))
+
+;; Generic function.
+(defun tramp-parse-file (filename function)
"Return a list of (user host) tuples allowed to access.
-Either user or host may be nil."
+User is always nil."
;; On Windows, there are problems in completion when
;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
(when (file-readable-p filename)
(with-temp-buffer
(insert-file-contents filename)
(goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-rhosts-group) res))))
- res))
+ (loop while (not (eobp)) collect (funcall function))))))
+
+;;;###tramp-autoload
+(defun tramp-parse-rhosts (filename)
+ "Return a list of (user host) tuples allowed to access.
+Either user or host may be nil."
+ (tramp-parse-file filename 'tramp-parse-rhosts-group))
(defun tramp-parse-rhosts-group ()
"Return a (user host) tuple allowed to access.
(concat
"^\\(" tramp-host-regexp "\\)"
"\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (append (list (match-string 3) (match-string 1)))))
- (widen)
(forward-line 1)
result))
(defun tramp-parse-shosts (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-shosts-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-shosts-group))
(defun tramp-parse-shosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
- (regexp (concat "^\\(" tramp-host-regexp "\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
- (setq result (list nil (match-string 1))))
- (widen)
- (or
- (> (skip-chars-forward ",") 0)
- (forward-line 1))
- result))
+ (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ","))
;;;###tramp-autoload
(defun tramp-parse-sconfig (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-sconfig-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-sconfig-group))
(defun tramp-parse-sconfig-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
- (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
- (setq result (list nil (match-string 1))))
- (widen)
- (or
- (> (skip-chars-forward ",") 0)
- (forward-line 1))
- result))
+ (tramp-parse-group
+ (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)") 1 ","))
-;;;###tramp-autoload
-(defun tramp-parse-shostkeys (dirname)
+;; Generic function.
+(defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
"Return a list of (user host) tuples allowed to access.
User is always nil."
;; On Windows, there are problems in completion when
;; `default-directory' is remote.
(let* ((default-directory (tramp-compat-temporary-file-directory))
- (regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
- (files (when (file-directory-p dirname) (directory-files dirname)))
- result)
- (while files
- (when (string-match regexp (car files))
- (push (list nil (match-string 1 (car files))) result))
- (setq files (cdr files)))
- result))
+ (files (and (file-directory-p dirname) (directory-files dirname))))
+ (loop for f in files
+ when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f))
+ collect (list nil (match-string 1 f)))))
+;;;###tramp-autoload
+(defun tramp-parse-shostkeys (dirname)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ (tramp-parse-shostkeys-sknownhosts
+ dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")))
+
+;;;###tramp-autoload
(defun tramp-parse-sknownhosts (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let* ((default-directory (tramp-compat-temporary-file-directory))
- (regexp (concat "^\\(" tramp-host-regexp
- "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
- (files (when (file-directory-p dirname) (directory-files dirname)))
- result)
- (while files
- (when (string-match regexp (car files))
- (push (list nil (match-string 1 (car files))) result))
- (setq files (cdr files)))
- result))
+ (tramp-parse-shostkeys-sknownhosts
+ dirname
+ (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")))
;;;###tramp-autoload
(defun tramp-parse-hosts (filename)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-hosts-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-hosts-group))
(defun tramp-parse-hosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
- (regexp
- (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
- (setq result (list nil (match-string 1))))
- (widen)
- (or
- (> (skip-chars-forward " \t") 0)
- (forward-line 1))
- result))
+ (tramp-parse-group
+ (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t"))
;; For su-alike methods it would be desirable to return "root@localhost"
;; as default. Unfortunately, we have no information whether any user name
(defun tramp-parse-passwd (filename)
"Return a list of (user host) tuples allowed to access.
Host is always \"localhost\"."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (if (zerop (length tramp-current-user))
- '(("root" nil))
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-passwd-group) res))))
- res)))
+ (if (zerop (length tramp-current-user))
+ '(("root" nil))
+ (tramp-parse-file filename 'tramp-parse-passwd-group)))
(defun tramp-parse-passwd-group ()
"Return a (user host) tuple allowed to access.
Host is always \"localhost\"."
(let ((result)
(regexp (concat "^\\(" tramp-user-regexp "\\):")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (list (match-string 1) "localhost")))
- (widen)
(forward-line 1)
result))
(defun tramp-parse-netrc (filename)
"Return a list of (user host) tuples allowed to access.
User may be nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-netrc-group) res))))
- res))
+ (tramp-parse-file filename 'tramp-parse-netrc-group))
(defun tramp-parse-netrc-group ()
"Return a (user host) tuple allowed to access.
(concat
"^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
"\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (list (match-string 3) (match-string 1))))
- (widen)
(forward-line 1)
result))
;;;###tramp-autoload
-(defun tramp-parse-putty (registry)
+(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- res)
- (with-temp-buffer
- (when (zerop (tramp-compat-call-process "reg" nil t nil "query" registry))
- (goto-char (point-min))
- (while (not (eobp))
- (push (tramp-parse-putty-group registry) res))))
- res))
+ (if (memq system-type '(windows-nt))
+ (with-temp-buffer
+ (when (zerop (tramp-compat-call-process
+ "reg" nil t nil "query" registry-or-dirname))
+ (goto-char (point-min))
+ (loop while (not (eobp)) collect
+ (tramp-parse-putty-group registry-or-dirname))))
+ ;; UNIX case.
+ (tramp-parse-shostkeys-sknownhosts
+ registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$"))))
(defun tramp-parse-putty-group (registry)
"Return a (user host) tuple allowed to access.
User is always nil."
(let ((result)
(regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
- (narrow-to-region (point) (point-at-eol))
- (when (re-search-forward regexp nil t)
+ (when (re-search-forward regexp (point-at-eol) t)
(setq result (list nil (match-string 1))))
- (widen)
(forward-line 1)
result))
(setq filename (expand-file-name filename))
(let (result local-copy remote-copy)
(with-parsed-tramp-file-name filename nil
- (unwind-protect
- (if (not (file-exists-p filename))
- ;; We don't raise a Tramp error, because it might be
- ;; suppressed, like in `find-file-noselect-1'.
- (signal 'file-error
- (list "File not found on remote host" filename))
-
- (if (and (tramp-local-host-p v)
- (let (file-name-handler-alist)
- (file-readable-p localname)))
- ;; Short track: if we are on the local host, we can
- ;; run directly.
- (setq result
- (tramp-run-real-handler
- 'insert-file-contents
- (list localname visit beg end replace)))
-
- ;; When we shall insert only a part of the file, we copy
- ;; this part.
- (when (or beg end)
- (setq remote-copy (tramp-make-tramp-temp-file v))
- ;; This is defined in tramp-sh.el. Let's assume this
- ;; is loaded already.
- (tramp-compat-funcall 'tramp-send-command
- v
- (cond
- ((and beg end)
- (format "dd bs=1 skip=%d if=%s count=%d of=%s"
- beg (tramp-shell-quote-argument localname)
- (- end beg) remote-copy))
- (beg
- (format "dd bs=1 skip=%d if=%s of=%s"
- beg (tramp-shell-quote-argument localname)
- remote-copy))
- (end
- (format "dd bs=1 count=%d if=%s of=%s"
- end (tramp-shell-quote-argument localname)
- remote-copy)))))
-
- ;; `insert-file-contents-literally' takes care to avoid
- ;; calling jka-compr. By let-binding
- ;; `inhibit-file-name-operation', we propagate that care
- ;; to the `file-local-copy' operation.
- (setq local-copy
- (let ((inhibit-file-name-operation
- (when (eq inhibit-file-name-operation
- 'insert-file-contents)
- 'file-local-copy)))
- (cond
- ((stringp remote-copy)
- (file-local-copy
- (tramp-make-tramp-file-name
- method user host remote-copy)))
- ((stringp tramp-temp-buffer-file-name)
- (copy-file filename tramp-temp-buffer-file-name 'ok)
- tramp-temp-buffer-file-name)
- (t (file-local-copy filename)))))
-
- ;; When the file is not readable for the owner, it
- ;; cannot be inserted, even if it is readable for the
- ;; group or for everybody.
- (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600"))
-
- (when (and (null remote-copy)
- (tramp-get-method-parameter
- method 'tramp-copy-keep-tmpfile))
- ;; We keep the local file for performance reasons,
- ;; useful for "rsync".
- (setq tramp-temp-buffer-file-name local-copy))
-
- (tramp-with-progress-reporter
- v 3 (format "Inserting local temp file `%s'" local-copy)
+ (tramp-with-progress-reporter
+ v 3 (format "Inserting `%s'" filename)
+ (unwind-protect
+ (if (not (file-exists-p filename))
+ ;; We don't raise a Tramp error, because it might be
+ ;; suppressed, like in `find-file-noselect-1'.
+ (signal 'file-error
+ (list "File not found on remote host" filename))
+
+ (if (and (tramp-local-host-p v)
+ (let (file-name-handler-alist)
+ (file-readable-p localname)))
+ ;; Short track: if we are on the local host, we can
+ ;; run directly.
+ (setq result
+ (tramp-run-real-handler
+ 'insert-file-contents
+ (list localname visit beg end replace)))
+
+ ;; When we shall insert only a part of the file, we
+ ;; copy this part.
+ (when (or beg end)
+ (setq remote-copy (tramp-make-tramp-temp-file v))
+ ;; This is defined in tramp-sh.el. Let's assume
+ ;; this is loaded already.
+ (tramp-compat-funcall
+ 'tramp-send-command
+ v
+ (cond
+ ((and beg end)
+ (format "dd bs=1 skip=%d if=%s count=%d of=%s"
+ beg (tramp-shell-quote-argument localname)
+ (- end beg) remote-copy))
+ (beg
+ (format "dd bs=1 skip=%d if=%s of=%s"
+ beg (tramp-shell-quote-argument localname)
+ remote-copy))
+ (end
+ (format "dd bs=1 count=%d if=%s of=%s"
+ end (tramp-shell-quote-argument localname)
+ remote-copy)))))
+
+ ;; `insert-file-contents-literally' takes care to
+ ;; avoid calling jka-compr. By let-binding
+ ;; `inhibit-file-name-operation', we propagate that
+ ;; care to the `file-local-copy' operation.
+ (setq local-copy
+ (let ((inhibit-file-name-operation
+ (when (eq inhibit-file-name-operation
+ 'insert-file-contents)
+ 'file-local-copy)))
+ (cond
+ ((stringp remote-copy)
+ (file-local-copy
+ (tramp-make-tramp-file-name
+ method user host remote-copy)))
+ ((stringp tramp-temp-buffer-file-name)
+ (copy-file filename tramp-temp-buffer-file-name 'ok)
+ tramp-temp-buffer-file-name)
+ (t (file-local-copy filename)))))
+
+ ;; When the file is not readable for the owner, it
+ ;; cannot be inserted, even if it is readable for the
+ ;; group or for everybody.
+ (set-file-modes
+ local-copy (tramp-compat-octal-to-decimal "0600"))
+
+ (when (and (null remote-copy)
+ (tramp-get-method-parameter
+ method 'tramp-copy-keep-tmpfile))
+ ;; We keep the local file for performance reasons,
+ ;; useful for "rsync".
+ (setq tramp-temp-buffer-file-name local-copy))
+
;; We must ensure that `file-coding-system-alist'
;; matches `local-copy'.
(let ((file-coding-system-alist
filename local-copy)))
(setq result
(insert-file-contents
- local-copy nil nil nil replace))))))
-
- ;; Save exit.
- (progn
- (when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
- (set-visited-file-modtime)
- (set-buffer-modified-p nil))
- (when (and (stringp local-copy)
- (or remote-copy (null tramp-temp-buffer-file-name)))
- (delete-file local-copy))
- (when (stringp remote-copy)
- (delete-file
- (tramp-make-tramp-file-name method user host remote-copy))))))
+ local-copy nil nil nil replace)))))
+
+ ;; Save exit.
+ (progn
+ (when visit
+ (setq buffer-file-name filename)
+ (setq buffer-read-only (not (file-writable-p filename)))
+ (set-visited-file-modtime)
+ (set-buffer-modified-p nil))
+ (when (and (stringp local-copy)
+ (or remote-copy (null tramp-temp-buffer-file-name)))
+ (delete-file local-copy))
+ (when (stringp remote-copy)
+ (delete-file
+ (tramp-make-tramp-file-name method user host remote-copy)))))))
;; Result.
(list (expand-file-name filename)
(defun tramp-action-password (proc vec)
"Query the user for a password."
(with-current-buffer (process-buffer proc)
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
- (tramp-message vec 3 "Sending %s" (match-string 1))
- (tramp-enter-password proc)
- ;; Hide password prompt.
- (narrow-to-region (point-max) (point-max))))
+ (let ((enable-recursive-minibuffers t))
+ (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (tramp-message vec 3 "Sending %s" (match-string 1))
+ ;; We don't call `tramp-send-string' in order to hide the
+ ;; password from the debug buffer.
+ (process-send-string
+ proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
+ ;; Hide password prompt.
+ (narrow-to-region (point-max) (point-max)))))
(defun tramp-action-succeed (proc vec)
"Signal success in finding shell prompt."
connection buffer."
;; Preserve message for `progress-reporter'.
(tramp-compat-with-temp-message ""
- ;; Enable auth-source and password-cache. We must use
+ ;; Enable `auth-source' and `password-cache'. We must use
;; tramp-current-* variables in case we have several hops.
(tramp-set-connection-property
(tramp-dissect-file-name
;; Under Windows XP, accept-process-output doesn't return
;; sometimes. So we add an additional timeout.
(with-timeout ((or timeout 1))
- (accept-process-output proc timeout timeout-msecs)))
+ (if (featurep 'xemacs)
+ (accept-process-output proc timeout timeout-msecs)
+ (accept-process-output proc timeout timeout-msecs (and proc t)))))
(tramp-message proc 10 "\n%s" (buffer-string))))
(defun tramp-check-for-regexp (proc regexp)
'buffer-substring-no-properties
1 (min (1+ tramp-echo-mark-marker-length) (point-max))))))
;; No echo to be handled, now we can look for the regexp.
- (goto-char (point-min))
- (re-search-forward regexp nil t))))
+ ;; Sometimes, lines are much to long, and we run into a "Stack
+ ;; overflow in regexp matcher". For example, //DIRED// lines of
+ ;; directory listings with some thousand files. Therefore, we
+ ;; look from the end.
+ (goto-char (point-max))
+ (ignore-errors (re-search-backward regexp nil t)))))
(defun tramp-wait-for-regexp (proc timeout regexp)
"Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
(tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
found)))
-;; We don't call `tramp-send-string' in order to hide the password
-;; from the debug buffer, and because end-of-line handling of the
-;; string.
-(defun tramp-enter-password (proc)
- "Prompt for a password and send it to the remote end."
- (process-send-string
- proc (concat (tramp-read-passwd proc)
- (or (tramp-get-method-parameter
- tramp-current-method
- 'tramp-password-end-of-line)
- tramp-default-password-end-of-line))))
-
;; It seems that Tru64 Unix does not like it if long strings are sent
;; to it in one go. (This happens when sending the Perl
;; `file-attributes' implementation, for instance.) Therefore, we
(stringp (file-remote-p file2))
(string-equal (file-remote-p file1) (file-remote-p file2))))
-(defun tramp-get-method-parameter (method param)
- "Return the method parameter PARAM.
-If the `tramp-methods' entry does not exist, return nil."
- (let ((entry (assoc param (assoc method tramp-methods))))
- (when entry (cadr entry))))
-
+;;;###tramp-autoload
(defun tramp-mode-string-to-int (mode-string)
"Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
(let* (case-fold-search
(t (error "Tenth char `%c' must be one of `xtT-'"
other-execute-or-sticky)))))))
+;;;###tramp-autoload
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise."
;; We cannot use `tramp-file-name-real-host'. A port is an
dir
(tramp-error vec 'file-error "Directory %s not accessible" dir)))))
+;;;###tramp-autoload
(defun tramp-make-tramp-temp-file (vec)
"Create a temporary file on the remote host identified by VEC.
Return the local name of the temporary file."
;;; Compatibility functions section:
+;;;###tramp-autoload
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package.
(read-passwd pw-prompt))
(tramp-set-connection-property v "first-password-request" nil)))))
+;;;###tramp-autoload
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
(tramp-compat-funcall
("oct" . 10) ("nov" . 11) ("dec" . 12))
"Alist mapping month names to integers.")
+;;;###tramp-autoload
(defun tramp-time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2."
(unless t1 (setq t1 '(0 0)))
(list (- (car t1) (car t2) (if borrow 1 0))
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
+;;;###tramp-autoload
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
T1 and T2 are time values (as returned by `current-time' for example)."
;; again. (Greg Stark)
;; * Username and hostname completion.
;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'.
-;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
-;; Code is nearly identical.
;; * Make `tramp-default-user' obsolete.
;; * Implement a general server-local-variable mechanism, as there are
;; probably other variables that need different values for different
;; * Run emerge on two remote files. Bug is described here:
;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
;; (Bug#6850)
-;; * It would be very useful if it were possible to load or save a
-;; buffer using Tramp in a non-blocking way so that use of Emacs on
-;; other buffers could continue. (Bug#9617)
;;; tramp.el ends here
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.2.3-24.1"
+(defconst tramp-version "2.2.6"
"This version of Tramp.")
;;;###tramp-autoload
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
- (format "Tramp 2.2.3-24.1 is not fit for %s"
+ (format "Tramp 2.2.6 is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
;; example sites. You'll probably want to override it with your own favorite
;; sites. The documentation for the variable describes the syntax.
-;; You may wish to add something like the following to your `.emacs' file:
+;; You may wish to add something like the following to your init file:
;;
;; (require 'webjump)
;; (global-set-key "\C-cj" 'webjump)
(defvar webjump-sites
webjump-sample-sites
- "*Hotlist for WebJump.
+ "Hotlist for WebJump.
The hotlist is represented as an association list, with the CAR of each cell
being the name of the Web site, and the CDR being the definition for the URL of
;;; Code:
-;; D-Bus support in the Emacs core can be disabled with configuration
-;; option "--without-dbus". Declare used subroutines and variables.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
-
(require 'dbus)
-;; Pacify byte compiler.
-(eval-when-compile
- (require 'cl))
-
;; Widgets are used to highlight the search results.
(require 'widget)
(require 'wid-edit)
;; That is not the case now, so we set it ourselves.
;; Hopefully, this will change later.
(setq hit-fields
- (case (intern vendor-id)
- (Beagle
+ (pcase (intern vendor-id)
+ (`Beagle
'("xesam:mimeType" "xesam:url"))
- (Strigi
+ (`Strigi
'("xesam:author" "xesam:cc" "xesam:charset"
"xesam:contentType" "xesam:fileExtension"
"xesam:id" "xesam:lineCount" "xesam:links"
"xesam:mimeType" "xesam:name" "xesam:size"
"xesam:sourceModified" "xesam:subject" "xesam:to"
"xesam:url"))
- (TrackerXesamSession
+ (`TrackerXesamSession
'("xesam:relevancyRating" "xesam:url"))
- (Debbugs
+ (`Debbugs
'("xesam:keyword" "xesam:owner" "xesam:title"
"xesam:url" "xesam:sourceModified" "xesam:mimeType"
"debbugs:key"))
;; xesam-tools yahoo service.
- (t '("xesam:contentModified" "xesam:mimeType" "xesam:summary"
+ (_ '("xesam:contentModified" "xesam:mimeType" "xesam:summary"
"xesam:title" "xesam:url" "yahoo:displayUrl"))))
(xesam-set-property engine "hit.fields" hit-fields)
(defvar xesam-mode-map
(let ((map (copy-keymap special-mode-map)))
- (set-keymap-parent xesam-mode-map widget-keymap)
+ (set-keymap-parent map widget-keymap)
map))
(define-derived-mode xesam-mode special-mode "Xesam"
;; Pacify byte-compiler. D-Bus support in the Emacs core can be
;; disabled with configuration option "--without-dbus". Declare used
;; subroutines and variables of `dbus' therefore.
-(eval-when-compile
- (require 'cl))
-
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
(defvar dbus-debug)
(require 'dbus)
((string-equal (dbus-event-member-name last-input-event) "ItemNew")
;; Parameters: (interface protocol type domain flags)
;; Register a service browser.
- (let ((object-path (zeroconf-register-service-browser (nth-value 2 val))))
+ (let ((object-path (zeroconf-register-service-browser (nth 2 val))))
;; Register the signals.
(dolist (member '("ItemNew" "ItemRemove" "Failure"))
(dbus-register-signal
:type 'integer
:group 'comment)
(make-variable-buffer-local 'comment-column)
-;;;###autoload(put 'comment-column 'safe-local-variable 'integerp)
+;;;###autoload
+(put 'comment-column 'safe-local-variable 'integerp)
;;;###autoload
(defvar comment-start nil
- "*String to insert to start a new comment, or nil if no comment syntax.")
-;;;###autoload(put 'comment-start 'safe-local-variable 'string-or-null-p)
+ "String to insert to start a new comment, or nil if no comment syntax.")
+;;;###autoload
+(put 'comment-start 'safe-local-variable 'string-or-null-p)
;;;###autoload
(defvar comment-start-skip nil
- "*Regexp to match the start of a comment plus everything up to its body.
+ "Regexp to match the start of a comment plus everything up to its body.
If there are any \\(...\\) pairs, the comment delimiter text is held to begin
at the place matched by the close of the first pair.")
-;;;###autoload(put 'comment-start-skip 'safe-local-variable 'string-or-null-p)
+;;;###autoload
+(put 'comment-start-skip 'safe-local-variable 'string-or-null-p)
;;;###autoload
(defvar comment-end-skip nil
"Regexp to match the end of a comment plus everything back to its body.")
-;;;###autoload(put 'comment-end-skip 'safe-local-variable 'string-or-null-p)
+;;;###autoload
+(put 'comment-end-skip 'safe-local-variable 'string-or-null-p)
;;;###autoload
(defvar comment-end (purecopy "")
- "*String to insert to end a new comment.
+ "String to insert to end a new comment.
Should be an empty string if comments are terminated by end-of-line.")
-;;;###autoload(put 'comment-end 'safe-local-variable 'string-or-null-p)
+;;;###autoload
+(put 'comment-end 'safe-local-variable 'string-or-null-p)
;;;###autoload
(defvar comment-indent-function 'comment-indent-default
:type '(choice string integer (const nil))
:group 'comment)
+(defcustom comment-inline-offset 1
+ "Inline comments have to be preceded by at least this many spaces.
+This is useful when style-conventions require a certain minimal offset.
+Python's PEP8 for example recommends two spaces, so you could do:
+
+\(add-hook 'python-mode-hook
+ (lambda () (set (make-local-variable 'comment-inline-offset) 2)))
+
+See `comment-padding' for whole-line comments."
+ :version "24.3"
+ :type 'integer
+ :group 'comment)
+
;;;###autoload
(defcustom comment-multi-line nil
"Non-nil means `comment-indent-new-line' continues comments.
(save-excursion (end-of-line) (current-column)))))
(other nil)
(min (save-excursion (skip-chars-backward " \t")
- (if (bolp) 0 (1+ (current-column))))))
+ (if (bolp) 0 (+ comment-inline-offset (current-column))))))
;; Fix up the range.
(if (< max min) (setq max min))
;; Don't move past the fill column.
(save-excursion
(skip-chars-backward " \t")
(unless (bolp)
- (setq indent (max indent (1+ (current-column))))))
+ (setq indent (max indent
+ (+ (current-column) comment-inline-offset)))))
;; If that's different from comment's current position, change it.
(unless (= (current-column) indent)
(delete-region (point) (progn (skip-chars-backward " \t") (point)))
;;; Commentary:
;; This package provides an implementation of the Desktop Notifications
-;; <http://www.galago-project.org/specs/notification/>.
+;; <http://developer.gnome.org/notification-spec/>.
;; In order to activate this package, you must add the following code
;; into your .emacs:
;; active D-Bus session bus.
;;; Code:
-(eval-when-compile
- (require 'cl))
-
-;; Pacify byte-compiler. D-Bus support in the Emacs core can be
-;; disabled with configuration option "--without-dbus". Declare used
-;; subroutines and variables of `dbus' therefore.
-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")
-
(require 'dbus)
-(defconst notifications-specification-version "1.1"
+(defconst notifications-specification-version "1.2"
"The version of the Desktop Notifications Specification implemented.")
(defconst notifications-application-name "Emacs"
"D-Bus notifications service path.")
(defconst notifications-interface "org.freedesktop.Notifications"
- "D-Bus notifications service path.")
+ "D-Bus notifications service interface.")
(defconst notifications-notify-method "Notify"
- "D-Bus notifications service path.")
+ "D-Bus notifications notify method.")
(defconst notifications-close-notification-method "CloseNotification"
- "D-Bus notifications service path.")
+ "D-Bus notifications close notification method.")
+
+(defconst notifications-get-capabilities-method "GetCapabilities"
+ "D-Bus notifications get capabilities method.")
(defconst notifications-action-signal "ActionInvoked"
"D-Bus notifications action signal.")
(defun notifications-on-action-signal (id action)
"Dispatch signals to callback functions from `notifications-on-action-map'."
- (let* ((unique-name (dbus-event-service-name last-input-event))
- (entry (assoc (cons unique-name id) notifications-on-action-map)))
+ (let* ((bus (dbus-event-bus-name last-input-event))
+ (unique-name (dbus-event-service-name last-input-event))
+ (entry (assoc (list bus unique-name id) notifications-on-action-map)))
(when entry
(funcall (cadr entry) id action)
(when (and (not (setq notifications-on-action-map
"Dispatch signals to callback functions from `notifications-on-closed-map'."
;; notification-daemon prior 0.4.0 does not send a reason. So we
;; make it optional, and assume `undefined' as default.
- (let* ((unique-name (dbus-event-service-name last-input-event))
- (entry (assoc (cons unique-name id) notifications-on-close-map))
+ (let* ((bus (dbus-event-bus-name last-input-event))
+ (unique-name (dbus-event-service-name last-input-event))
+ (entry (assoc (list bus unique-name id) notifications-on-close-map))
(reason (or reason 4)))
(when entry
(funcall (cadr entry)
"Send notification via D-Bus using the Freedesktop notification protocol.
Various PARAMS can be set:
+ :bus The D-Bus bus, if different from `:session'.
:title The notification title.
:body The notification body text.
:app-name The name of the application sending the notification.
Default value is -1.
:urgency The urgency level.
Either `low', `normal' or `critical'.
+ :action-items Whether the TITLE of the actions is interpreted as
+ a named icon.
:category The type of notification this is.
:desktop-entry This specifies the name of the desktop filename representing
the calling program.
be \"message-new-instant\".
:suppress-sound Causes the server to suppress playing any sounds, if it has
that ability.
+ :resident When set the server will not automatically remove the
+ notification when an action has been invoked.
+ :transient When set the server will treat the notification as transient
+ and by-pass the server's persistence capability, if it
+ should exist.
:x Specifies the X location on the screen that the notification
should point to. The \"y\" hint must also be specified.
:y Specifies the Y location on the screen that the notification
- `undefined' if the notification server hasn't provided
a reason
+Which parameters are accepted by the notification server can be
+checked via `notifications-get-capabilities'.
+
This function returns a notification id, an integer, which can be
used to manipulate the notification item with
`notifications-close-notification' or the `:replaces-id' argument
of another `notifications-notify' call."
- (let ((title (plist-get params :title))
+ (let ((bus (or (plist-get params :bus) :session))
+ (title (plist-get params :title))
(body (plist-get params :body))
(app-name (plist-get params :app-name))
(replaces-id (plist-get params :replaces-id))
(desktop-entry (plist-get params :desktop-entry))
(image-data (plist-get params :image-data))
(image-path (plist-get params :image-path))
+ (action-items (plist-get params :action-items))
(sound-file (plist-get params :sound-file))
(sound-name (plist-get params :sound-name))
(suppress-sound (plist-get params :suppress-sound))
+ (resident (plist-get params :resident))
+ (transient (plist-get params :transient))
(x (plist-get params :x))
(y (plist-get params :y))
id)
(when urgency
(add-to-list 'hints `(:dict-entry
"urgency"
- (:variant :byte ,(case urgency
- (low 0)
- (critical 2)
- (t 1)))) t))
+ (:variant :byte ,(pcase urgency
+ (`low 0)
+ (`critical 2)
+ (_ 1)))) t))
(when category
(add-to-list 'hints `(:dict-entry
"category"
(:variant :string ,desktop-entry)) t))
(when image-data
(add-to-list 'hints `(:dict-entry
- "image_data"
+ "image-data"
(:variant :struct ,image-data)) t))
(when image-path
(add-to-list 'hints `(:dict-entry
- "image_path"
+ "image-path"
(:variant :string ,image-path)) t))
+ (when action-items
+ (add-to-list 'hints `(:dict-entry
+ "action-items"
+ (:variant :boolean ,action-items)) t))
(when sound-file
(add-to-list 'hints `(:dict-entry
"sound-file"
(add-to-list 'hints `(:dict-entry
"suppress-sound"
(:variant :boolean ,suppress-sound)) t))
+ (when resident
+ (add-to-list 'hints `(:dict-entry
+ "resident"
+ (:variant :boolean ,resident)) t))
+ (when transient
+ (add-to-list 'hints `(:dict-entry
+ "transient"
+ (:variant :boolean ,transient)) t))
(when x
(add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
(when y
(add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
- ;; Call Notify method
+ ;; Call Notify method.
(setq id
- (dbus-call-method :session
+ (dbus-call-method bus
notifications-service
notifications-path
notifications-interface
;; restarted.
(let ((on-action (plist-get params :on-action))
(on-close (plist-get params :on-close))
- (unique-name (dbus-get-name-owner :session notifications-service)))
+ (unique-name (dbus-get-name-owner bus notifications-service)))
(when on-action
(add-to-list 'notifications-on-action-map
- (list (cons unique-name id) on-action))
+ (list (list bus unique-name id) on-action))
(unless notifications-on-action-object
(setq notifications-on-action-object
(dbus-register-signal
- :session
+ bus
nil
notifications-path
notifications-interface
(when on-close
(add-to-list 'notifications-on-close-map
- (list (cons unique-name id) on-close))
+ (list (list bus unique-name id) on-close))
(unless notifications-on-close-object
(setq notifications-on-close-object
(dbus-register-signal
- :session
+ bus
nil
notifications-path
notifications-interface
;; Return notification id
id))
-(defun notifications-close-notification (id)
- "Close a notification with identifier ID."
- (dbus-call-method :session
+(defun notifications-close-notification (id &optional bus)
+ "Close a notification with identifier ID.
+BUS can be a string denoting a D-Bus connection, the default is `:session'."
+ (dbus-call-method (or bus :session)
notifications-service
notifications-path
notifications-interface
notifications-close-notification-method
:int32 id))
+(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
+
+(defun notifications-get-capabilities (&optional bus)
+ "Return the capabilities of the notification server, a list of strings.
+BUS can be a string denoting a D-Bus connection, the default is `:session'.
+The following capabilities can be expected:
+
+ :actions The server will provide the specified actions
+ to the user.
+ :action-icons Supports using icons instead of text for
+ displaying actions.
+ :body Supports body text.
+ :body-hyperlinks The server supports hyperlinks in the notifications.
+ :body-images The server supports images in the notifications.
+ :body-markup Supports markup in the body text.
+ :icon-multi The server will render an animation of all the
+ frames in a given image array.
+ :icon-static Supports display of exactly 1 frame of any
+ given image array. This value is mutually exclusive
+ with `:icon-multi'.
+ :persistence The server supports persistence of notifications.
+ :sound The server supports sounds on notifications.
+
+Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
+ (dbus-ignore-errors
+ (mapcar
+ (lambda (x) (intern (concat ":" x)))
+ (dbus-call-method (or bus :session)
+ notifications-service
+ notifications-path
+ notifications-interface
+ notifications-get-capabilities-method))))
+
(provide 'notifications)
;; The command is found in this-command
;; and the keys are returned by (this-command-keys).
-(eval-when-compile (require 'cl))
-
+;;;###autoload
+(define-obsolete-variable-alias 'disabled-command-hook
+ 'disabled-command-function "22.1")
;;;###autoload
(defvar disabled-command-function 'disabled-command-function
"Function to call to handle disabled commands.
If nil, the feature is disabled, i.e., all commands work normally.")
-;;;###autoload
-(define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1")
-
;; It is ok here to assume that this-command is a symbol
;; because we won't get called otherwise.
;;;###autoload
(ding)
(message "Please type y, n, ! or SPC (the space bar): "))))
(setq char (downcase char))
- (case char
+ (pcase char
(?\C-g (setq quit-flag t))
(?! (setq disabled-command-function nil))
(?y
(defun disable-command (command)
"Require special confirmation to execute COMMAND from now on.
COMMAND must be a symbol.
-This command alters the user's .emacs file so that this will apply
-to future sessions."
+This command alters your init file so that this choice applies to
+future sessions."
(interactive "CDisable command: ")
(en/disable-command command t))
;; The entry point to this file is `nxml-glyph-display-string'.
;; The current implementation is heuristic due to a lack of
;; Emacs primitives necessary to implement it properly. The user
-;; can tweak the heuristics using `nxml-glyph-set-hook'.
+;; can tweak the heuristics using `nxml-glyph-set-functions'.
;;; Code:
(#xFB01 . #xFB02)]
"Glyph set corresponding to Windows Glyph List 4.")
-(defvar nxml-glyph-set-hook nil
- "*Hook for determining the set of glyphs in a face.
-The hook will receive a single argument FACE. If it can determine
-the set of glyphs representable by FACE, it must set the variable
-`nxml-glyph-set' and return non-nil. Otherwise, it must return nil.
-The hook will be run until success. The constants
-`nxml-ascii-glyph-set', `nxml-latin1-glyph-set',
+(defvar nxml-glyph-set-functions nil
+ "Abnormal hook for determining the set of glyphs in a face.
+Each function in this hook is called in turn, unless one of them
+returns non-nil. Each function is called with a single argument
+FACE. If it can determine the set of glyphs representable by
+FACE, it must set the variable `nxml-glyph-set' and return
+non-nil. Otherwise, it must return nil.
+
+The constants `nxml-ascii-glyph-set', `nxml-latin1-glyph-set',
`nxml-misc-fixed-1-glyph-set', `nxml-misc-fixed-2-glyph-set',
`nxml-misc-fixed-3-glyph-set' and `nxml-wgl4-glyph-set' are
-predefined for use by `nxml-glyph-set-hook'.")
+predefined for use by `nxml-glyph-set-functions'.")
+
+(define-obsolete-variable-alias 'nxml-glyph-set-hook
+ 'nxml-glyph-set-functions "24.3")
(defvar nxml-glyph-set nil
- "Used by `nxml-glyph-set-hook' to return set of glyphs in a FACE.
+ "Used by `nxml-glyph-set-functions' to return set of glyphs in a FACE.
This should dynamically bound by any function that runs
-`nxml-glyph-set-hook'. The value must be either nil representing an
+`nxml-glyph-set-functions'. The value must be either nil representing an
empty set or a vector. Each member of the vector is either a single
integer or a cons (FIRST . LAST) representing the range of integers
from FIRST to LAST. An integer represents a glyph with that Unicode
(defun nxml-terminal-set-glyph-set (face)
(setq nxml-glyph-set nxml-ascii-glyph-set))
-(add-hook 'nxml-glyph-set-hook
+(add-hook 'nxml-glyph-set-functions
(or (cdr (assq window-system
'((x . nxml-x-set-glyph-set)
(w32 . nxml-w32-set-glyph-set)
FACE gives the face that will be used for displaying the string.
Return nil if the face cannot display a glyph for N."
(let ((nxml-glyph-set nil))
- (run-hook-with-args-until-success 'nxml-glyph-set-hook face)
+ (run-hook-with-args-until-success 'nxml-glyph-set-functions face)
(and nxml-glyph-set
(nxml-glyph-set-contains-p n nxml-glyph-set)
(let ((ch (decode-char 'ucs n)))
(when (featurep 'mucs)
(error "nxml-mode is not compatible with Mule-UCS"))
-(eval-when-compile (require 'cl)) ; for assert
+(eval-when-compile (require 'cl-lib))
(require 'xmltok)
(require 'nxml-enc)
(defcustom nxml-char-ref-display-glyph-flag t
"Non-nil means display glyph following character reference.
-The glyph is displayed in face `nxml-glyph'. The hook
-`nxml-glyph-set-hook' can be used to customize for which characters
-glyphs are displayed."
+The glyph is displayed in face `nxml-glyph'. The abnormal hook
+`nxml-glyph-set-functions' can be used to change the characters
+for which glyphs are displayed."
:group 'nxml
:type 'boolean)
(nxml-debug-change "nxml-fontify-matcher" (point) bound)
(when (< (point) nxml-prolog-end)
- ;; prolog needs to be fontified in one go, and
+ ;; Prolog needs to be fontified in one go, and
;; nxml-extend-region makes sure we start at BOB.
- (assert (bobp))
+ (cl-assert (bobp))
(nxml-fontify-prolog)
(goto-char nxml-prolog-end))
(let (xmltok-dependent-regions
xmltok-errors)
(while (and (nxml-tokenize-forward)
- (<= (point) bound)) ; intervals are open-ended
+ (<= (point) bound)) ; Intervals are open-ended.
(nxml-apply-fontify-rule)))
(setq nxml-last-fontify-end (point)))
(unless arg
(if nxml-slash-auto-complete-flag
(if end-tag-p
- (condition-case err
+ (condition-case nil
(let ((start-tag-end
(nxml-scan-element-backward (1- slash-pos) t)))
(when start-tag-end
(nxml-token-after)
(= xmltok-start bol))
(eq xmltok-type 'data))
- (condition-case err
+ (condition-case nil
(nxml-scan-element-backward
(point)
nil
(off 0))
(if value-boundary
;; inside an attribute value
- (let ((value-start (car value-boundary))
- (value-end (cdr value-boundary)))
+ (let ((value-start (car value-boundary)))
(goto-char pos)
(forward-line -1)
(if (< (point) value-start)
xmltok-name-end)
(t end)))
-(defun nxml-scan-backward-within (end)
+(defun nxml-scan-backward-within (_end)
(setq xmltok-start
(+ xmltok-start
(nxml-start-delimiter-length xmltok-type)))
'nxml-in-mixed-content-hook))
nil)
;; See if the matching tag does not start or end a line.
- ((condition-case err
+ ((condition-case nil
(progn
(setq matching-tag-pos
(xmltok-save
\\[nxml-dynamic-markup-word] removes the previously inserted markup
and attempts to find another possible way to do the markup."
(interactive "*")
- (let (search-start-pos done)
+ (let (search-start-pos)
(if (and (integerp nxml-dynamic-markup-prev-pos)
(= nxml-dynamic-markup-prev-pos (point))
(eq last-command this-command)
:group 'nxml
:type 'integer)
-(defface nxml-heading
- '((t (:weight bold)))
- "Face used for the contents of abbreviated heading elements."
+(defface nxml-heading '((t :weight bold))
+ "Face for the contents of abbreviated heading elements."
:group 'nxml-faces)
-(defface nxml-outline-indicator
- '((t (:inherit default)))
- "Face used for `+' or `-' before element names in outlines."
+(defface nxml-outline-indicator '((t))
+ "Face for `+' or `-' before element names in outlines."
:group 'nxml-faces)
(defface nxml-outline-active-indicator
- '((t (:box t :inherit nxml-outline-indicator)))
- "Face used for clickable `+' or `-' before element names in outlines."
+ '((t :box t :inherit nxml-outline-indicator))
+ "Face for clickable `+' or `-' before element names in outlines."
:group 'nxml-faces)
-(defface nxml-outline-ellipsis
- '((t (:bold t :inherit default)))
+(defface nxml-outline-ellipsis '((t :weight bold))
"Face used for `...' in outlines."
:group 'nxml-faces)
:group 'relax-ng)
(defvar rng-complete-end-tags-after-< t
- "*Non-nil means immediately after < complete on end-tag names.
+ "Non-nil means immediately after < complete on end-tag names.
Complete on start-tag names regardless.")
(defvar rng-nxml-easy-menu
-;;; assoc.el --- insert/delete functions on association lists
+;;; assoc.el --- insert/delete functions on association lists -*- lexical-binding: t -*-
;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
;; Keywords: extensions
+;; Obsolete-since: 24.3
;; This file is part of GNU Emacs.
sorted list."
(set alist-symbol
(sort (copy-alist (symbol-value alist-symbol))
- (function (lambda (a b) (equal (car a) key))))))
+ (lambda (a _b) (equal (car a) key)))))
(defun aelement (key value)
modified, but will be moved to the head of the alist. If the key-value
pair cannot be found in the alist, it will be inserted into the head
of the alist (with value nil if VALUE is nil or not supplied)."
- (lexical-let ((elem (aelement key value))
- alist)
+ (let ((elem (aelement key value))
+ alist)
(asort alist-symbol key)
(setq alist (symbol-value alist-symbol))
(cond ((null alist) (set alist-symbol elem))
Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
is pair matching KEY. Returns the altered alist."
(asort alist-symbol key)
- (lexical-let ((alist (symbol-value alist-symbol)))
+ (let ((alist (symbol-value alist-symbol)))
(cond ((null alist) nil)
((anot-head-p alist key) alist)
(t (set alist-symbol (cdr alist))))))
If no key-value pair matching KEY could be found in ALIST, or ALIST is
nil then nil is returned. ALIST is not altered."
+ (defvar copy)
(let ((copy (copy-alist alist)))
(cond ((null alist) nil)
((progn (asort 'copy key)
this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining
keys are associated with nil. If VALUELIST is larger than KEYLIST,
extra values are ignored. Returns the created alist."
- (lexical-let ((keycar (car keylist))
- (keycdr (cdr keylist))
- (valcar (car valuelist))
- (valcdr (cdr valuelist)))
+ (let ((keycar (car keylist))
+ (keycdr (cdr keylist))
+ (valcar (car valuelist))
+ (valcdr (cdr valuelist)))
(cond ((null keycdr)
(aput alist-symbol keycar valcar))
(t
;; Maintainer: FSF
;; Keywords: games
;; Created: Jan 1997
+;; Obsolete-since: 24.3
;; This file is part of GNU Emacs.
;;; cust-print.el --- handles print-level and print-circle
-;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Adapted-By: ESR
;; Keywords: extensions
+;; Obsolete-since: 24.3
;; LCD Archive Entry:
;; cust-print|Daniel LaLiberte|liberte@holonexus.org
:group 'erc-hecomplete)
(defcustom erc-nick-completion-ignore-case t
- "*Non-nil means don't consider case significant in nick completion.
+ "Non-nil means don't consider case significant in nick completion.
Case will be automatically corrected when non-nil.
For instance if you type \"dely TAB\" the word completes and changes to
\"delYsid\"."
(erc-get-channel-nickname-list)))
(defcustom erc-nick-completion-postfix ": "
- "*When `erc-complete' is used in the first word after the prompt,
+ "When `erc-complete' is used in the first word after the prompt,
add this string when a unique expansion was found."
:group 'erc-hecomplete
:type 'string)
;; User Variables:
(defcustom fast-lock-minimum-size 25600
- "*Minimum size of a buffer for cached fontification.
+ "Minimum size of a buffer for cached fontification.
Only buffers more than this can have associated Font Lock cache files saved.
If nil, means cache files are never created.
If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
(defcustom fast-lock-cache-directories '("~/.emacs-flc")
; - `internal', keep each file's Font Lock cache file in the same file.
; - `external', keep each file's Font Lock cache file in the same directory.
- "*Directories in which Font Lock cache files are saved and read.
+ "Directories in which Font Lock cache files are saved and read.
Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where
DIR is a directory name (relative or absolute) and REGEXP is a regexp.
(put 'fast-lock-cache-directories 'risky-local-variable t)
(defcustom fast-lock-save-events '(kill-buffer kill-emacs)
- "*Events under which caches will be saved.
+ "Events under which caches will be saved.
Valid events are `save-buffer', `kill-buffer' and `kill-emacs'.
If concurrent editing sessions use the same associated cache file for a file's
buffer, then you should add `save-buffer' to this list."
:group 'fast-lock)
(defcustom fast-lock-save-others t
- "*If non-nil, save Font Lock cache files irrespective of file owner.
+ "If non-nil, save Font Lock cache files irrespective of file owner.
If nil, means only buffer files known to be owned by you can have associated
Font Lock cache files saved. Ownership may be unknown for networked files."
:type 'boolean
:group 'fast-lock)
(defcustom fast-lock-verbose font-lock-verbose
- "*If non-nil, means show status messages for cache processing.
+ "If non-nil, means show status messages for cache processing.
If a number, only buffers greater than this size have processing messages."
:type '(choice (const :tag "never" nil)
(other :tag "always" t)
:group 'i18n)
(defcustom iso-accents-insert-offset nonascii-insert-offset
- "*Offset added by ISO Accents mode to character codes 0200 and above."
+ "Offset added by ISO Accents mode to character codes 0200 and above."
:type 'integer
:group 'iso-acc)
"Association list for ISO accent combinations, for the chosen language.")
(defcustom iso-accents-mode nil
- "*Non-nil enables ISO Accents mode.
+ "Non-nil enables ISO Accents mode.
Setting this variable makes it local to the current buffer.
See the function `iso-accents-mode'."
:type 'boolean
(make-variable-buffer-local 'iso-accents-mode)
(defcustom iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/)
- "*List of accent keys that become prefixes in ISO Accents mode.
+ "List of accent keys that become prefixes in ISO Accents mode.
The default is (?' ?` ?^ ?\" ?~ ?/), which contains all the supported
accent keys. If you set this variable to a list in which some of those
characters are missing, the missing ones do not act as accents.
;; Maintainer: FSF
;; Keywords: languages
+;; Obsolete-since: 24.3
;; This file is part of GNU Emacs.
;;; Commentary:
-;; This is a major mode for editing Liszt. See etc/LEDIT for details.
+;; This is a major mode for editing Liszt.
;;; Code:
;; Maintainer: FSF
;; Created: 13 Jan 1986
;; Keywords: mail
+;; Obsolete-since: 24.3
;;; Commentary:
;; Author: Mike Williams <mdub@bigfoot.com>
;; Keywords: mouse
+;; Obsolete-since: 24.3
;; This file is part of GNU Emacs.
interprogram-paste-function
mouse-sel-original-interprogram-paste-function))))
+(make-obsolete 'mouse-sel-mode "use the normal mouse modes" "24.3")
+
;;=== Internal Variables/Constants ========================================
(defvar mouse-sel-primary-thing nil
;; 4. Spaces followed by a TAB. (Almost always, we never want that).
;; 5. Spaces or TABS at the end of a line.
;;
-;; Whitespace errors are reported in a buffer, and on the modeline.
+;; Whitespace errors are reported in a buffer, and on the mode line.
;;
-;; Modeline will show a W:<x>!<y> to denote a particular type of whitespace,
+;; Mode line will show a W:<x>!<y> to denote a particular type of whitespace,
;; where `x' and `y' can be one (or more) of:
;;
;; e - End-of-Line whitespace.
;; s - Space followed by Tab.
;; t - Trailing whitespace.
;;
-;; If any of the whitespace checks is turned off, the modeline will display a
+;; If any of the whitespace checks is turned off, the mode line will display a
;; !<y>.
;;
;; (since (3) is the most controversial one, here is the rationale: Most
:group 'whitespace)
(defcustom whitespace-silent nil
- "All whitespace errors will be shown only in the modeline when t.
+ "All whitespace errors will be shown only in the mode line when t.
Note that setting this may cause all whitespaces introduced in a file to go
unnoticed when the buffer is killed, unless the user visits the `*Whitespace
nil)))
(defun whitespace-update-modeline (&optional whitespace-err)
- "Update modeline with whitespace errors.
+ "Update mode line with whitespace errors.
Also with whitespaces whose testing has been turned off."
(if whitespace-display-in-modeline
(progn
;; This file is part of GNU Emacs.
+;; Obsolete-since: 24.3
+
;;; Commentary:
;;; Code:
;;; Code:
(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args")
- "*This file is where arguments are placed for a suspended Emacs job.")
+ "This file is where arguments are placed for a suspended Emacs job.")
(defvar resume-emacs-args-buffer " *Command Line Args*"
"Buffer that is used by `resume-process-args'.")
"Abbrev table used while in scribe mode.")
(defcustom scribe-fancy-paragraphs nil
- "*Non-nil makes Scribe mode use a different style of paragraph separation."
+ "Non-nil makes Scribe mode use a different style of paragraph separation."
:type 'boolean
:group 'scribe)
(defcustom scribe-electric-quote nil
- "*Non-nil makes insert of double quote use `` or '' depending on context."
+ "Non-nil makes insert of double quote use `` or '' depending on context."
:type 'boolean
:group 'scribe)
(defcustom scribe-electric-parenthesis nil
- "*Non-nil makes parenthesis char ( (]}> ) automatically insert its close
+ "Non-nil makes parenthesis char ( (]}> ) automatically insert its close
if typed after an @Command form."
:type 'boolean
:group 'scribe)
(if vc-mcvs-use-edit
(vc-mcvs-command nil 0 file "edit")
(set-file-modes file (logior (file-modes file) 128))
- (if (equal file buffer-file-name) (toggle-read-only -1))))
+ (if (equal file buffer-file-name) (read-only-mode -1))))
;; Check out a particular revision (or recreate the file).
(vc-file-setprop file 'vc-working-revision nil)
(apply 'vc-mcvs-command nil 0 file
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.2 released.
+ Better seed support for (random).
+ * org-id.el (org-id-uuid):
+ Change (random t) to (random), now that the latter is more random.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.1 released.
+ Don't use the abbreviation "win" to refer to Windows (Bug#10421).
+ * ob-lilypond.el (ly-w32-ly-path): Rename from ly-win32-ly-path.
+ (ly-w32-pdf-path): Rename from ly-win32-pdf-path.
+ (ly-w32-midi-path): Rename from ly-win32-midi-path.
+ (ly-determine-ly-path, ly-determine-pdf-path, ly-determine-midi-path):
+ Check for "windows-nt", not "win32", in system-type.
-2012-05-25 Mark Shoulson <mark@kli.org> (tiny change)
+2012-06-02 Chong Yidong <cyd@gnu.org>
- * org.el (org-fontify-entities): Fix bug: The entities \sup[123]
- and \there4 were not "prettified" when org-pretty-entities was
- enabled.
+ * org-clock.el (org-clock-string-limit)
+ (org-clock-modeline-total, org-clock-task-overrun-text)
+ (org-clock-mode-line-entry): Doc fix, "modeline" -> "mode line".
-2012-05-25 Nicolas Goaziou <n.goaziou@gmail.com>
+2012-05-27 Mark Shoulson <mark@kli.org> (tiny change)
- * org.el (org-font-lock-add-priority-faces): Restrict priorities
- fontification to headlines and inlinetasks.
+ * org.el (org-fontify-entities): Fix bug: The entities \sup[123] and
+ \there4 were not "prettified" when org-pretty-entities was enabled.
-2012-05-25 Jambunathan K <kjambunathan@gmail.com>
+2012-05-27 Nicolas Goaziou <n.goaziou@gmail.com>
- * org-odt.el (org-odt-init-outfile): Fix previous commit. Make
- sure that nxml-mode is loaded before let-binding
- `nxml-auto-insert-xml-declaration-flag'.
+ * org.el (org-font-lock-add-priority-faces):
+ Restrict priorities fontification to headlines and inlinetasks.
-2012-05-25 Jambunathan K <kjambunathan@gmail.com>
+2012-05-27 Jambunathan K <kjambunathan@gmail.com>
* org-odt.el (org-odt-init-outfile)
- (org-odt-write-manifest-file): Disable
- `nxml-auto-insert-xml-declaration-flag'.
+ (org-odt-write-manifest-file):
+ Disable `nxml-auto-insert-xml-declaration-flag'.
- * org-lparse.el (org-do-lparse): Don't trigger auto-mode
- processing.
-
-2012-05-25 Bastien Guerry <bzg@gnu.org>
-
- * org.el (org-scan-tags): Fix bug when building the scanner
- regexp.
+ * org-lparse.el (org-do-lparse): Don't trigger auto-mode processing.
-2012-05-25 Eric Schulte <eric.schulte@gmx.com>
+2012-05-27 Bastien Guerry <bzg@gnu.org>
- * ob.el (org-babel-capitalize-examplize-region-markers): Controls
- the capitalization of begin and end example blocks.
- (org-babel-examplize-region): Optionally capitalize example block
- delimiters.
+ * org.el (org-scan-tags): Fix bug when building the scanner regexp.
-2012-05-25 Eric Schulte <eric.schulte@gmx.com>
+2012-05-27 Eric Schulte <eric.schulte@gmx.com>
- * ob-plantuml.el (org-babel-execute:plantuml): Adding a :java
- header argument to plantuml.
+ * ob.el (org-babel-capitalize-examplize-region-markers):
+ Controls the capitalization of begin and end example blocks.
+ (org-babel-examplize-region):
+ Optionally capitalize example block delimiters.
-2012-05-25 Eric Schulte <eric.schulte@gmx.com>
+ * ob-plantuml.el (org-babel-execute:plantuml):
+ Add a :java header argument to plantuml.
- * org-exp-blocks.el (org-export-blocks-preprocess): Even when the
- body of a block is not indented the boundary markers should be
- indented to their original positions so things like list
+ * org-exp-blocks.el (org-export-blocks-preprocess):
+ Even when the body of a block is not indented the boundary markers
+ should be indented to their original positions so things like list
indentation still work.
-2012-05-16 Eric Schulte <eric.schulte@gmx.com>
-
- * ob.el (org-babel-parse-src-block-match): Save match data during
- indentation check.
+ * ob.el (org-babel-parse-src-block-match):
+ Save match data during indentation check.
-2012-05-16 Bastien Guerry <bzg@gnu.org>
+2012-05-27 Bastien Guerry <bzg@gnu.org>
* org.el (org-scan-tags): Correctly match TODO keywords.
-2012-05-16 Nicolas Goaziou <n.goaziou@gmail.com>
+2012-05-27 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-list-struct): Fix white spaces.
- (org-list-swap-items, org-list-send-item): Fix visibility
- preservation.
+ (org-list-swap-items, org-list-send-item): Fix visibility preservation.
-2012-05-16 Nicolas Goaziou <n.goaziou@gmail.com>
+ * org-list.el (org-list-swap-items, org-list-send-item):
+ Preserve visibility when moving items.
- * org-list.el (org-list-swap-items, org-list-send-item): Preserve
- visibility when moving items.
+2012-05-27 Mark E. Shoulson <mark@kli.org> (tiny change)
-2012-05-16 Mark E. Shoulson <mark@kli.org> (tiny change)
+ * org.el (org-fontify-entities): Hide {} when prettifying entities.
- * org.el (org-fontify-entities): Hide {} when prettifying
- entities.
-
-2012-05-16 Bastien Guerry <bzg@gnu.org>
+2012-05-27 Bastien Guerry <bzg@gnu.org>
* org.el (org-cycle-internal-global): Prevent the display of
messages when cycling from with a Gnus article buffer.
-2012-05-16 Bastien Guerry <bzg@gnu.org>
-
- * org-table.el (org-table-time-seconds-to-string): Fix bug about
- handling a negative duration value.
+ * org-table.el (org-table-time-seconds-to-string):
+ Fix bug about handling a negative duration value.
-2012-05-16 Nicolas Goaziou <n.goaziou@gmail.com>
+2012-05-27 Nicolas Goaziou <n.goaziou@gmail.com>
* org.el (org-link-expand-abbrev): Fix docstring.
-2012-05-16 Nicolas Goaziou <n.goaziou@gmail.com>
-
* org.el (org-translate-link): Fix bug.
-2012-05-16 Bastien Guerry <bzg@gnu.org>
-
- * org-agenda.el (org-agenda-bulk-mark-regexp): Fix bug when
- setting the number of marked entries.
+2012-05-27 Bastien Guerry <bzg@gnu.org>
-2012-05-16 Bastien Guerry <bzg@gnu.org>
+ * org-agenda.el (org-agenda-bulk-mark-regexp):
+ Fix bug when setting the number of marked entries.
- * org-table.el (org-tbl-calc-modes): Rename from
- `org-table-modes'.
+ * org-table.el (org-tbl-calc-modes): Rename from `org-table-modes'.
(org-set-calc-mode, org-table-eval-formula): Use it.
-2012-05-16 Eric Schulte <eric.schulte@gmx.com>
+2012-05-27 Eric Schulte <eric.schulte@gmx.com>
- * ob.el (org-babel-find-named-result): Fix bug finding empty named
- results.
+ * ob.el (org-babel-find-named-result):
+ Fix bug finding empty named results.
-2012-05-16 Nicolas Goaziou <n.goaziou@gmail.com>
+2012-05-27 Nicolas Goaziou <n.goaziou@gmail.com>
- * org.el (org-set-regexps-and-options): Fix
- `org-planning-or-clock-line-re' regexp. Indeed "\\>" will never
+ * org.el (org-set-regexps-and-options):
+ Fix `org-planning-or-clock-line-re' regexp. Indeed "\\>" will never
match since time keywords must end with colons, which are not word
- constituent.
+ constituents.
-2012-05-16 Bastien Guerry <bzg@gnu.org>
+2012-05-27 Bastien Guerry <bzg@gnu.org>
- * org-ctags.el (org-ctags-new-topic-template): Fix the option
- default value back again.
+ * org-ctags.el (org-ctags-new-topic-template):
+ Fix the option default value back again.
-2012-05-16 Eric Schulte <eric.schulte@gmx.com>
+2012-05-27 Eric Schulte <eric.schulte@gmx.com>
- * org-bibtex.el (org-bibtex-export-to-kill-ring): Don't rely on
- kill-new to return a string.
+ * org-bibtex.el (org-bibtex-export-to-kill-ring):
+ Don't rely on kill-new to return a string.
-2012-05-16 Eric Schulte <eric.schulte@gmx.com>
+ * org-bibtex.el (org-bibtex-headline):
+ Remove call to bibtex-reformat which often hangs.
- * org-bibtex.el (org-bibtex-headline): Remove call to
- bibtex-reformat which often hangs.
+2012-04-27 Glenn Morris <rgm@gnu.org>
-2012-04-26 Nicolas Goaziou <n.goaziou@gmail.com>
+ * org-ctags.el (org-ctags-new-topic-template):
+ Revert 2012-04-09 removal of * from defcustom value, not doc.
+
+2012-04-27 Nicolas Goaziou <n.goaziou@gmail.com>
* org-table.el (org-table-number-fraction): Fix typo.
-2012-04-26 Eric Schulte <eric.schulte@gmx.com>
+2012-04-27 Eric Schulte <eric.schulte@gmx.com>
* ob-python.el (org-babel-execute:python): Ensure newline precedes
automatically-added returns.
-2012-04-26 Nicolas Goaziou <n.goaziou@gmail.com>
+2012-04-27 Nicolas Goaziou <n.goaziou@gmail.com>
* org-mouse.el (org-mode-hook): Do not move point when clicking on
a footnote reference.
-2012-04-26 Bastien Guerry <bzg@gnu.org>
+2012-04-27 Bastien Guerry <bzg@gnu.org>
* org-faces.el (org-date-selected): Fix docstring.
-2012-04-26 Nicolas Goaziou <n.goaziou@gmail.com>
+2012-04-27 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-list-struct-indent): Follow
`org-list-demote-modify-bullet' specifications for ordered
* org.el (org-shiftmetaleft, org-shiftmetaright): Allow to operate
on a region.
-2012-04-26 Nicolas Goaziou <n.goaziou@gmail.com>
+2012-04-27 Nicolas Goaziou <n.goaziou@gmail.com>
* org-footnote.el (org-footnote-normalize): Fix positioning in
HTML export without a footnote section.
-2012-04-26 Madan Ramakrishnan <madanr79@gmail.com> (tiny change)
+2012-04-27 Madan Ramakrishnan <madanr79@gmail.com> (tiny change)
* org-agenda.el (org-agenda-bulk-mark): Truly make arg optional as
advertised by the function.
-2012-04-26 Zachary Kanfer <zkanfer@gmail.com> (tiny change)
+2012-04-27 Zachary Kanfer <zkanfer@gmail.com> (tiny change)
* org.el (org-read-date-display): Fix bug when displaying the
overlay.
-2012-04-26 Bastien Guerry <bzg@gnu.org>
+2012-04-27 Bastien Guerry <bzg@gnu.org>
* org.el (org-mode): Don't use `buffer-face-mode' by default.
-2012-04-26 Bastien Guerry <bzg@gnu.org>
+2012-04-27 Bastien Guerry <bzg@gnu.org>
* org-faces.el (org-date-selected): New face.
-2012-04-26 Jambunathan K <kjambunathan@gmail.com>
+2012-04-27 Jambunathan K <kjambunathan@gmail.com>
* org-odt.el (org-odt-format-org-link): Pay no heed to whether the
internal links destined for headlines provide a description or
not. In fact, the `org-store-link' and `org-insert-link' create
internal links which do have a description.
-2012-04-26 Bastien Guerry <bzg@gnu.org>
+2012-04-27 Bastien Guerry <bzg@gnu.org>
* org-clock.el (org-program-exists): Fix docstring.
-2012-04-11 Bastien Guerry <bzg@gnu.org>
+2012-04-14 Bastien Guerry <bzg@gnu.org>
* org.el (org-point-at-end-of-empty-headline): Only try to match
- ̀org-todo-line-regexp' when the value is non-nil, e.g. in non-org
+ `org-todo-line-regexp' when the value is non-nil, e.g. in non-org
modes.
(org-fontify-meta-lines-and-blocks-1): Prevent errors when trying
to fontify beyond (point-max).
(org-table-get-range): Fix bug: make sure references to $0 are
correctly handled.
- * org-pcomplete.el (pcomplete/org-mode/file-option): Fix bug in
- `pcomplete/org-mode/file-option'.
+ * org-pcomplete.el (pcomplete/org-mode/file-option):
+ Fix bug in `pcomplete/org-mode/file-option'.
(org-thing-at-point): Also match line options like LATEX_CLASS
when pcompleting from LATEX_.
* org-agenda.el (org-agenda-filter-make-matcher)
(org-agenda-filter-apply): Allow filtering entries out by
category. Using `C-u <' from the agenda view will redisplay
- the agenda without entries from categories of the current
- line.
+ the agenda without entries from categories of the current line.
-2012-04-11 Eric Schulte <eric.schulte@gmx.com>
+2012-04-14 Eric Schulte <eric.schulte@gmx.com>
- * ob-C.el (org-babel-C-ensure-main-wrap): Add an explicit return
- to automatically generated main methods.
+ * ob-C.el (org-babel-C-ensure-main-wrap):
+ Add an explicit return to automatically generated main methods.
-2012-04-11 Matt Lundin <mdl@imapmail.org>
+2012-04-14 Matt Lundin <mdl@imapmail.org>
- * org.el (org-after-todo-state-change-hook): Fix docstring to
- reflect name change of state to `org-state'.
+ * org.el (org-after-todo-state-change-hook):
+ Fix docstring to reflect name change of state to `org-state'.
-2012-04-11 Mike Sperber <sperber@deinprogramm.de> (tiny change)
+2012-04-14 Mike Sperber <sperber@deinprogramm.de> (tiny change)
- * org-footnote.el (org-footnote-normalize): Correctly pass keyword
- arguments to `org-export-preprocess-string'.
+ * org-footnote.el (org-footnote-normalize):
+ Correctly pass keyword arguments to `org-export-preprocess-string'.
2012-04-03 Bastien Guerry <bzg@gnu.org>
2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu> (tiny change)
* org-colview.el (org-columns-cleanup-item): Handle case of empty
- headline
+ headline.
2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
2012-04-01 Ilya Shlyakhter <ilya_shl@alum.mit.edu>
- * org-clock.el: (org-clock-get-table-data): Make sure todo-only
+ * org-clock.el (org-clock-get-table-data): Make sure todo-only
does not leak when it is set by make-org-tags-macher.
2012-04-01 Bastien Guerry <bzg@gnu.org>
2012-04-01 Bernt Hansen <bernt@norang.ca>
* org.el (org-clone-subtree-with-time-shift): Fix task cloning for
- repeating tasks using .+n and ++n syntax
+ repeating tasks using .+n and ++n syntax.
2012-04-01 Karl Fogel <kfogel@red-bean.com> (tiny change)
2012-04-01 Toby S. Cubitt <tsc25@cantab.net> (tiny change)
- * org.el (org-goto): call org-refile-get-location with NO-EXCLUDE
+ * org.el (org-goto): Call org-refile-get-location with NO-EXCLUDE
argument set, otherwise not only are headlines in the current
subtree excluded, but it throws an error if point happens not to
be within a subtree (e.g. at start of buffer).
* org-clock.el (org-in-clocktable-p): Moved to org.el.
* org.el (org-in-clocktable-p): New function. Moved from
- org-clock.el
+ org-clock.el.
2012-04-01 David Maus <dmaus@ictsoc.de>
2012-04-01 Toby S. Cubitt <tsc25@cantab.net> (tiny change)
- * org.el (org-goto): call org-refile-get-location with NO-EXCLUDE
+ * org.el (org-goto): Call org-refile-get-location with NO-EXCLUDE
argument set, otherwise not only are headlines in the current
subtree excluded, but it throws an error if point happens not to
be within a subtree (e.g. at start of buffer).
2012-04-01 Bernt Hansen <bernt@norang.ca>
* org-clock.el (org-clock-out): Do not delete the current clocking
- task when org-clock-out-hook clocks in another task
+ task when org-clock-out-hook clocks in another task.
2012-04-01 David Maus <dmaus@ictsoc.de>
* org-clock.el (org-in-clocktable-p): Moved to org.el.
- * org.el (org-in-clocktable-p): New function. Moved from org-clock.el
+ * org.el (org-in-clocktable-p): New function. Moved from org-clock.el.
2012-04-01 David Maus <dmaus@ictsoc.de>
2012-04-01 Jambunathan K <kjambunathan@gmail.com>
* org-odt.el (org-odt-label-styles): Add a new style.
- (org-odt-category-map-alist): Use it.
+ (org-odt-category-map-alist): Use it.
2012-04-01 Jambunathan K <kjambunathan@gmail.com>
2012-04-01 Bernt Hansen <bernt@norang.ca>
- * org-agenda.el (org-agenda-switch-to): Widen org buffer only if point is
- outside the current restriction
+ * org-agenda.el (org-agenda-switch-to): Widen org buffer only if point
+ is outside the current restriction.
2012-04-01 Bernt Hansen <bernt@norang.ca>
- * org-agenda.el (org-agenda-clock-in): Save restriction when clocking in from the agenda
+ * org-agenda.el (org-agenda-clock-in): Save restriction when clocking
+ in from the agenda.
2012-04-01 Bernt Hansen <bernt@norang.ca>
- * org.el: Honour existing restrictions when regenerating the agenda
+ * org.el: Honour existing restrictions when regenerating the agenda.
2012-04-01 Bastien Guerry <bzg@gnu.org>
2012-04-01 Martyn Jago <martyn.jago@btinternet.com>
* ob-emacs-lisp.el: A comment on the last line of an emacs-lisp
- code block would cause an error when the block is was executed. This
- fix cures this behaviour.
+ code block would cause an error when the block is was executed.
+ This fix cures this behaviour.
2012-04-01 Eric Schulte <eric.schulte@gmx.com>
2012-01-03 Litvinov Sergey <slitvinov@gmail.com>
- * ob-octave.el: add graphical output to png file
+ * ob-octave.el: Add graphical output to png file.
2012-01-03 Eric Schulte <eric.schulte@gmx.com>
2012-01-03 Michael Brand <michael.ch.brand@gmail.com>
- * org.el (Key bindings): remap the Outline functions from
+ * org.el (Key bindings): Remap the Outline functions from
`outline-mode-prefix-map' where possible.
2012-01-03 Christian Moe <mail@christianmoe.com> (tiny change)
* org-special-blocks.el
(org-special-blocks-convert-html-special-cookies): Close
paragraph before opening or closing the <div>, and open
- paragraph after. Also changed newline placement to be the same
+ paragraph after. Also changed newline placement to be the same
as for other blocks.
2012-01-03 Roberto Huelga <rhuelga@gmail.com>
* ob-asymptote.el (org-babel-asymptote-table-to-array):
Require a new argument TYPE specifying the detected type of
array. If it's a string array, make sure every element is
- returned as a string. Also improve doc-string.
- (org-babel-asymptote-var-to-asymptote): Fill new argument. Small
- refactoring.
+ returned as a string. Also improve doc-string.
+ (org-babel-asymptote-var-to-asymptote): Fill new argument.
+ Small refactoring.
(org-babel-asymptote-define-type): Rewrite to avoid stopping
search at first float found, as strings have precedence over
floats.
* org-footnote.el (org-footnote-get-definition): The function has
to widen buffer if definition has not been found in the current
- narrowed part. Be sure to restore that restriction once the
+ narrowed part. Be sure to restore that restriction once the
definition is found.
2012-01-03 Michal Sojka <sojka@os.inf.tu-dresden.de> (tiny change)
2012-01-03 Suvayu Ali <fatkasuvayu+linux@gmail.com> (tiny change)
* org-inlinetask.el (org-inlinetask): New customizable face
- for inlinetasks
+ for inlinetasks.
2012-01-03 Bastien Guerry <bzg@gnu.org>
(org-indent-agent-resume-delay): Change value.
(org-indent-initialize-buffer): Change argument name.
(org-indent-add-properties): Change argument name and type
- expected. It must be a time value now.
+ expected. It must be a time value now.
2012-01-03 Bastien Guerry <bzg@gnu.org>
(org-indent-initialize-agent): New function.
(org-indent-initialize-buffer): Now requires a mandatory
buffer argument.
- (org-indent-add-properties): Reflect changes to variables. The resume
- timer is now global.
+ (org-indent-add-properties): Reflect changes to variables.
+ The resume timer is now global.
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
* org-indent.el (org-indent-modified-headline-flag): Renamed from
`org-indent-deleted-headline-flag'
(org-indent-notify-modified-headline): Renamed from
- `org-indent-notify-deleted-headline'. Handle situations when
+ `org-indent-notify-deleted-headline'. Handle situations when
the stars of an headline are modified.
(org-indent-refresh-maybe): Remove case now handled by
previous function.
(org-indent-initial-timer, org-indent-initial-lock): New
variables.
(org-indent-mode): At initialization, start an idle timer to indent
- the whole buffer. When the user is asking for control, interrupt the
+ the whole buffer. When the user is asking for control, interrupt the
process, and resume at the same point when idle again.
(org-indent-initialize-buffer): New function.
(org-indent-add-properties): Throw an interrupt when indentation of
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
* org-indent.el (org-indent-mode): Completely refresh buffer
- before starting org-indent-mode. Also set idle timer to refresh
+ before starting org-indent-mode. Also set idle timer to refresh
only visible portion of buffer, and refresh the subtree instead of
section when promoting or demoting it.
(org-indent-add-properties): Rewrite function to proceed line by
template for html so that the exported file is valid
xhtml. Added template for odt.
(org-inlinetask-export-handler): Fix typo in the regexp that
- trims content. Make sure that the content is flanked by
+ trims content. Make sure that the content is flanked by
paragraph boundaries on either side.
2012-01-03 Bastien Guerry <bzg@gnu.org>
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
* org.el (org-in-regexps-block-p): Return an useful value when
- point is between START-RE and END-RE. No incomplete block is
+ point is between START-RE and END-RE. No incomplete block is
allowed anymore. Add another optional argument to bound the
bottom part of the search.
(org-narrow-to-block, org-in-block-p): Apply modifications.
2011-07-28 Matt Lundin <mdl@imapmail.org>
* org-bibtex.el (org-bibtex-create, org-bibtex-write): Change
- argument of `org-toggle-tag' to 'on. (Other arguments, e.g., t,
+ argument of `org-toggle-tag' to 'on. (Other arguments, e.g., t,
have no effect).
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* ob-haskell.el (org-babel-haskell-export-to-lhs): Call
`kill-buffer' with argument indiciating to kill current
- buffer. Emacs 22 compatibility.
+ buffer. Emacs 22 compatibility.
2011-07-28 David Maus <dmaus@ictsoc.de>
* org-exp.el (org-export-preprocess-string): If the last subtree
is commented, footnotes inserted during normalizing at the end of
- the buffer may get deleted. This patch ensures deletion comes
+ the buffer may get deleted. This patch ensures deletion comes
first, normalization second.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
* org-footnote.el (org-footnote-goto-definition): Now, determining
if point is at a footnote reference is entirely determined by
- `org-footnote-at-reference-p'. No need to check if pattern isn't
+ `org-footnote-at-reference-p'. No need to check if pattern isn't
at beginning of the line elsewhere.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
* org-exp.el (org-export-backends): New variable.
(org-export-select-backend-specific-text): Use above
- variable. Also mark text between #+BACKEND and
+ variable. Also mark text between #+BACKEND and
#+BEGIN_BACKEND...#+END_BACKEND with org-native-text property.
This text property is currently used only by the new line-oriented
generic exporter (which is not yet part of the repo).
* org-exp.el (org-export): Use new compatibility function
`org-activate-mark'.
- * org-compat.el (org-activate-mark): New function. Provide
+ * org-compat.el (org-activate-mark): New function. Provide
`activate-mark' if not present (e.g. Emacs 22).
2011-07-28 David Maus <dmaus@ictsoc.de>
* org-html.el (org-export-as-html): Don't expand non-data lines of
table.el tables.
(org-html-expand): Removed the (buggy) test for non-data lines
- in table.el tables. The test is now done as part of
+ in table.el tables. The test is now done as part of
org-export-as-html.
(org-format-table-table-html-using-table-generate-source):
Added test for spanning of cells in table.el tables using
- table.el's own library routine. Optionlly Suppress export of
+ table.el's own library routine. Optionally suppress export of
simple table.el tables.
(org-format-table-html): Removed the (buggy) test for spanned
- table.el tables. The test is now done as part of
+ table.el tables. The test is now done as part of
org-format-table-table-html-using-table-generate-source.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
function would not pay attention to drawers or blocks indentation.
Thus, such constructs couldn't consistently end an item or a list.
This patch ensures line indentation is stored (if applicable)
- before skipping them. Also fixed doc-string and comments.
+ before skipping them. Also fixed doc-string and comments.
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
2011-07-28 Julien Danjou <julien@danjou.info>
* org-latex.el (org-export-latex-date-format): Change default date
- format to \today. This has the same result but respects the
+ format to \today. This has the same result but respects the
language set in the document by default.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
(org-agenda-change-all-lines): Stop using prefix-length.
* org-colview.el (org-columns-display-here): Stop using
- prefix-length. Always return claned items.
+ prefix-length. Always return claned items.
* org-mobile.el (org-mobile-write-agenda-for-mobile): Stop using
prefix-length.
2011-07-28 Bastien Guerry <bzg@gnu.org>
- * org-html.el (org-export-as-html): bugfix: insert email
+ * org-html.el (org-export-as-html): Bugfix: insert email
correctly.
2011-07-28 Bastien Guerry <bzg@gnu.org>
2011-07-28 Julien Danjou <julien@danjou.info>
* org-macs.el (org-with-point-at): Store evaluated version of
- pom. This fixes a potential bug when using (org-with-point-at
+ pom. This fixes a potential bug when using (org-with-point-at
(func) …), where (func) would be evaluated multiple times,
therefore might return different results if a marker was returned
and different each time.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
- * org.el (org-toggle-item): Now accepts a prefix argument. When
+ * org.el (org-toggle-item): Now accepts a prefix argument. When
used without argument on normal text, it will make the whole
region one item. With an argument, it defaults to old behavior:
change each line in region into an item.
* org-inlinetask.el (org-inlinetask-export-templates): Slightly
modify templates so environment boundaries don't interfere with
content of task. Unprotect content of task so it might benefit
- from further transformations. Set original-indentation property to
+ from further transformations. Set original-indentation property to
a high value to ensure that task is always in the last item of the
list. Also, apply templates later in export process.
* org-exp.el (org-export-preprocess-string): Mark list endings
before babel blocks preprocessing starts, so blank lines that may
be inserted do not break list's structure. Then, mark list with
- special properties required by exporters. Thus output from babel
+ special properties required by exporters. Thus output from babel
can easily be included in lists.
(org-export-mark-list-end): New function.
(org-export-mark-list-properties): New function.
helper function is not optional anymore.
(org-list-get-all-items): Shorten code with the help of cl.el.
(org-list-get-children): Now returns all children of item, even if
- they do not belong to the same list. Renamed from
+ they do not belong to the same list. Renamed from
`org-list-get-all-children'.
(org-list-get-list-begin): Function wasn't return value when item
was already the first item of the list at point.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-templates): New capture property
- `:kill-buffer'. (org-capture-finalize): Kill target buffer if that
- is desired.
- (org-capture-target-buffer): Remember if we have to make the
- buffer.
+ `:kill-buffer'.
+ (org-capture-finalize): Kill target buffer if that is desired.
+ (org-capture-target-buffer): Remember if we have to make the buffer.
2010-11-11 Carsten Dominik <carsten.dominik@gmail.com>
2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-list-insert-item-generic): Updating checkboxes
- can modifiy bottom point of a list, so make it a marker before
+ can modify bottom point of a list, so make it a marker before
calling `org-update-checkbox-count-maybe'.
2010-11-11 Dan Davison <davison@stats.ox.ac.uk>
* org.el (org-src-fontify-natively): Set to nil by default.
- Supply cutomize interface.
+ Supply customize interface.
2010-11-11 Bastien Guerry <bzg@gnu.org>
* org-list.el (org-insert-item-internal): New function to handle
positioning and contents of an item being inserted at a specific
- pos. It is not possible anymore to split a term in a description
+ pos. It is not possible anymore to split a term in a description
list or a checkbox when inserting a new item.
* org-list.el (org-insert-item): Refactored by using the new
2009-11-13 John Wiegley <jwiegley@gmail.com>
- * org-clock.el
- (org-clock-auto-clock-resolution): Now takes three values: nil, t
- and `when-no-clock-is-running'.
+ * org-clock.el (org-clock-auto-clock-resolution): Now takes three
+ values: nil, t and `when-no-clock-is-running'.
(org-clock-in): Use `org-clock-auto-clock-resolution' to determine
whether or not to resolve Org buffers on clock in.
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2008-2012 Free Software Foundation, Inc.
+ Copyright (C) 2008-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
;; Keywords: literate programming, reproducible research, fortran
;; Homepage: http://orgmode.org
-;; This program is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
+;; 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar ly-nix-pdf-path "evince")
(defvar ly-nix-midi-path "timidity")
-(defvar ly-win32-ly-path "lilypond")
-(defvar ly-win32-pdf-path "")
-(defvar ly-win32-midi-path "")
+(defvar ly-w32-ly-path "lilypond")
+(defvar ly-w32-pdf-path "")
+(defvar ly-w32-midi-path "")
(defvar ly-gen-png nil
"Image generation (png) can be turned on by default by setting
(or test system-type)))
(cond ((string= sys-type "darwin")
ly-OSX-ly-path)
- ((string= sys-type "win32")
- ly-win32-ly-path)
+ ((string= sys-type "windows-nt")
+ ly-w32-ly-path)
(t ly-nix-ly-path))))
(defun ly-determine-pdf-path (&optional test)
(or test system-type)))
(cond ((string= sys-type "darwin")
ly-OSX-pdf-path)
- ((string= sys-type "win32")
- ly-win32-pdf-path)
+ ((string= sys-type "windows-nt")
+ ly-w32-pdf-path)
(t ly-nix-pdf-path))))
(defun ly-determine-midi-path (&optional test)
(or test test system-type)))
(cond ((string= sys-type "darwin")
ly-OSX-midi-path)
- ((string= sys-type "win32")
- ly-win32-midi-path)
+ ((string= sys-type "windows-nt")
+ ly-w32-midi-path)
(t ly-nix-midi-path))))
(defun ly-toggle-midi-play ()
:group 'org-agenda-daily/weekly
:version "24.1"
:type '(choice
- (const :tag "Alwas show prewarning" nil)
+ (const :tag "Always show prewarning" nil)
(const :tag "Remove prewarning if entry is scheduled" t)
(integer :tag "Restart prewarning N days before deadline")))
:type 'function)
(defcustom org-clock-string-limit 0
- "Maximum length of clock strings in the modeline. 0 means no limit."
+ "Maximum length of clock strings in the mode line. 0 means no limit."
:group 'org-clock
:type 'integer)
(file :tag "Play sound file")))
(defcustom org-clock-modeline-total 'auto
- "Default setting for the time included for the modeline clock.
+ "Default setting for the time included for the mode line clock.
This can be overruled locally using the CLOCK_MODELINE_TOTAL property.
Allowed values are:
(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
(defcustom org-clock-task-overrun-text nil
- "The extra modeline text that should indicate that the clock is overrun.
+ "Extra mode line text to indicate that the clock is overrun.
The can be nil to indicate that instead of adding text, the clock time
should get a different face (`org-mode-line-clock-overrun').
When this is a string, it is prepended to the clock string as an indication,
(= 0 (call-process "which" nil nil nil program-name))))
(defvar org-clock-mode-line-entry nil
- "Information for the modeline about the running clock.")
+ "Information for the mode line about the running clock.")
(defun org-find-open-clocks (file)
"Search through the given file and find all open clocks."
(defun org-id-uuid ()
"Return string with random (version 4) UUID."
(let ((rnd (md5 (format "%s%s%s%s%s%s%s"
- (random t)
+ (random)
(current-time)
(user-uid)
(emacs-pid)
\\[universal-argument] \\[org-remember-finalize] to file the note.
When this variable is nil, \\[org-remember-finalize] gives you the prompts, and
-\\[universal-argument] \\[org-remember-finalize] triggers the fasttrack."
+\\[universal-argument] \\[org-remember-finalize] triggers the fast track."
:group 'org-remember
:type 'boolean)
(const :tag "List them, indented with leading dots" indented)))
(defcustom org-tags-sort-function nil
- "When set, tags are sorted using this function as a comparator."
+ "When set, tags are sorted using this comparison function."
:group 'org-tags
:type '(choice
(const :tag "No sorting" nil)
"Normal hook to be run after outline visibility changes.")
(defvar outline-mode-hook nil
- "*This hook is run when outline mode starts.")
+ "This hook is run when outline mode starts.")
(defvar outline-blank-line nil
- "*Non-nil means to leave unhidden blank line before heading.")
+ "Non-nil means to leave unhidden blank line before heading.")
;;;###autoload
(define-derived-mode outline-mode text-mode "Outline"
(show-all)))
\f
(defvar outline-level 'outline-level
- "*Function of no args to compute a header's nesting level in an outline.
+ "Function of no args to compute a header's nesting level in an outline.
It can assume point is at the beginning of a header line and that the match
data reflects the `outline-regexp'.")
;;;###autoload(put 'outline-level 'risky-local-variable t)
:group 'paren-showing)
(defcustom show-paren-delay 0.125
- "Time in seconds to delay before showing a matching paren."
+ "Time in seconds to delay before showing a matching paren.
+If you change this without using customize while `show-paren-mode' is
+active, you must toggle the mode off and on again for this to take effect."
:type '(number :tag "seconds")
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (if (not show-paren-mode)
+ (set sym val)
+ (show-paren-mode -1)
+ (set sym val)
+ (show-paren-mode 1)))
:group 'paren-showing)
(defcustom show-paren-priority 1000
'show-paren-mismatch "22.1")
(defvar show-paren-highlight-openparen t
- "*Non-nil turns on openparen highlighting when matching forward.")
+ "Non-nil turns on openparen highlighting when matching forward.")
(defvar show-paren-idle-timer nil)
correct. It is better to check the password before caching. If
you must use this function, take care to check passwords and
remove incorrect ones from the cache."
+ (declare (obsolete password-read "23.1"))
(let ((password (password-read prompt key)))
(when (and password key)
(password-cache-add key password))
password))
-(make-obsolete 'password-read-and-add 'password-read "23.1")
-
(defun password-cache-remove (key)
"Remove password indexed by KEY from password cache.
This is typically run by a timer setup from `password-cache-add',
+++ /dev/null
-;;; paths.el --- define pathnames for use by various Emacs commands -*- no-byte-compile: t -*-
-
-;; Copyright (C) 1986, 1988, 1994, 1999-2012 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: internal
-;; Package: emacs
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; These are default settings for names of certain files and directories
-;; that Emacs needs to refer to from time to time.
-
-;; If these settings are not right, override them with `setq'
-;; in site-init.el. Do not change this file.
-
-;;; Code:
-
-;; Docstrings in this file should, where reasonable, follow the
-;; conventions described in make-docfile, so that they get put in the
-;; DOC file rather than in memory.
-
-(defun prune-directory-list (dirs &optional keep reject)
- "\
-Return a copy of DIRS with all non-existent directories removed.
-The optional argument KEEP is a list of directories to retain even if
-they don't exist, and REJECT is a list of directories to remove from
-DIRS, even if they exist; REJECT takes precedence over KEEP.
-
-Note that membership in REJECT and KEEP is checked using simple string
-comparison."
- (apply #'nconc
- (mapcar (lambda (dir)
- (and (not (member dir reject))
- (or (member dir keep) (file-directory-p dir))
- (list dir)))
- dirs)))
-
-(defvar Info-default-directory-list
- (let* ((config-dir
- (file-name-as-directory configure-info-directory))
- (config
- (list config-dir))
- (unpruned-prefixes
- ;; Directory trees that may not exist at installation time, and
- ;; so shouldn't be pruned based on existence.
- '("/usr/local/"))
- (prefixes
- ;; Directory trees in which to look for info subdirectories
- (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/")
- unpruned-prefixes))
- (suffixes
- ;; Subdirectories in each directory tree that may contain info
- ;; directories.
- '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/"
- "emacs/" "lib/" "lib/emacs/"))
- (standard-info-dirs
- (apply #'nconc
- (mapcar (lambda (pfx)
- (let ((dirs
- (mapcar (lambda (sfx)
- (concat pfx sfx "info/"))
- suffixes)))
- (if (member pfx unpruned-prefixes)
- dirs
- (prune-directory-list dirs config))))
- prefixes))))
- ;; If $(prefix)/share/info is not one of the standard info
- ;; directories, they are probably installing an experimental
- ;; version of Emacs, so make sure that experimental version's Info
- ;; files override the ones in standard directories.
- (if (member config-dir standard-info-dirs)
- (nconc standard-info-dirs config)
- (cons config-dir standard-info-dirs)))
- "Default list of directories to search for Info documentation files.
-They are searched in the order they are given in the list.
-Therefore, the directory of Info files that come with Emacs
-normally should come last (so that local files override standard ones),
-unless Emacs is installed into a non-standard directory. In the latter
-case, the directory of Info files that come with Emacs should be
-first in this list.
-
-Once Info is started, the list of directories to search
-comes from the variable `Info-directory-list'.
-This variable `Info-default-directory-list' is used as the default
-for initializing `Info-directory-list' when Info is started, unless
-the environment variable INFOPATH is set.")
-
-(defvar news-directory
- (purecopy (if (file-exists-p "/usr/spool/news/")
- "/usr/spool/news/"
- "/var/spool/news/"))
- "The root directory below which all news files are stored.")
-(defvaralias 'news-path 'news-directory)
-
-(defvar news-inews-program
- (purecopy
- (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews")
- ((file-exists-p "/usr/local/inews") "/usr/local/inews")
- ((file-exists-p "/usr/local/bin/inews") "/usr/local/bin/inews")
- ((file-exists-p "/usr/contrib/lib/news/inews") "/usr/contrib/lib/news/inews")
- ((file-exists-p "/usr/lib/news/inews") "/usr/lib/news/inews")
- (t "inews")))
- "Program to post news.")
-
-;; set this to your local server
-(defvar gnus-default-nntp-server (purecopy "") "\
-The name of the host running an NNTP server.
-The null string means use the local host as the server site.")
-
-(defvar gnus-nntp-service (purecopy "nntp") "\
-NNTP service name, usually \"nntp\" or 119.
-Go to a local news spool if its value is nil, in which case `gnus-nntp-server'
-should be set to `(system-name)'.")
-
-(defvar gnus-local-organization nil "\
-*The name of your organization, as a string.
-The `ORGANIZATION' environment variable is used instead if defined.")
-
-(defcustom rmail-file-name (purecopy "~/RMAIL") "\
-Name of user's primary mail file."
- :type 'string
- :group 'rmail
- :version "21.1")
-
-(defvar rmail-spool-directory
- (purecopy
- (cond ((file-exists-p "/var/mail")
- ;; SVR4 and recent BSD are said to use this.
- ;; Rather than trying to know precisely which systems use it,
- ;; let's assume this dir is never used for anything else.
- "/var/mail/")
- ;; Many GNU/Linux systems use this name.
- ((file-exists-p "/var/spool/mail")
- "/var/spool/mail/")
- ((memq system-type '(hpux usg-unix-v irix))
- "/usr/mail/")
- (t "/usr/spool/mail/")))
- "Name of directory used by system mailer for delivering new mail.
-Its name should end with a slash.")
-
-(defcustom remote-shell-program
- (purecopy
- (cond
- ;; Some systems use rsh for the remote shell; others use that name for the
- ;; restricted shell and use remsh for the remote shell. Let's try to guess
- ;; based on what we actually find out there. The restricted shell is
- ;; almost certainly in /bin or /usr/bin, so it's probably safe to assume
- ;; that an rsh found elsewhere is the remote shell program. The converse
- ;; is not true: /usr/bin/rsh could be either one, so check that last.
- ((file-exists-p "/usr/ucb/remsh") "/usr/ucb/remsh")
- ((file-exists-p "/usr/bsd/remsh") "/usr/bsd/remsh")
- ((file-exists-p "/bin/remsh") "/bin/remsh")
- ((file-exists-p "/usr/bin/remsh") "/usr/bin/remsh")
- ((file-exists-p "/usr/local/bin/remsh") "/usr/local/bin/remsh")
- ((file-exists-p "/usr/ucb/rsh") "/usr/ucb/rsh")
- ((file-exists-p "/usr/bsd/rsh") "/usr/bsd/rsh")
- ((file-exists-p "/usr/local/bin/rsh") "/usr/local/bin/rsh")
- ((file-exists-p "/usr/bin/rcmd") "/usr/bin/rcmd")
- ((file-exists-p "/bin/rcmd") "/bin/rcmd")
- ((file-exists-p "/bin/rsh") "/bin/rsh")
- ((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh")
- (t "rsh")))
- "File name for remote-shell program (often rsh or remsh)."
- :group 'environment
- :type 'file)
-
-(defvar term-file-prefix (purecopy "term/") "\
-If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\")))
-You may set this variable to nil in your `.emacs' file if you do not wish
-the terminal-initialization file to be loaded.")
-
-;;; paths.el ends here
(require 'pcomplete)
+(defgroup pcmpl-rpm nil
+ "Options for rpm completion."
+ :group 'pcomplete
+ :prefix "pcmpl-rpm-")
+
+;; rpm -qa can be slow. Adding --nodigest --nosignature is MUCH faster.
+(defcustom pcmpl-rpm-query-options
+ (let (opts)
+ (with-temp-buffer
+ (when (ignore-errors (call-process "rpm" nil t nil "--help"))
+ (if (search-backward "--nodigest " nil 'move)
+ (setq opts '("--nodigest")))
+ (goto-char (point-min))
+ (if (search-forward "--nosignature " nil t)
+ (push "--nosignature" opts))))
+ opts)
+ "String, or list of strings, with extra options for an rpm query command."
+ :version "24.3"
+ :type '(choice (const :tag "No options" nil)
+ (string :tag "Single option")
+ (repeat :tag "List of options" string))
+ :group 'pcmpl-rpm)
+
+(defcustom pcmpl-rpm-cache t
+ "Whether to cache the list of installed packages."
+ :version "24.3"
+ :type 'boolean
+ :group 'pcmpl-rpm)
+
+(defconst pcmpl-rpm-cache-stamp-file "/var/lib/rpm/Packages"
+ "File used to check that the list of installed packages is up-to-date.")
+
+(defvar pcmpl-rpm-cache-time nil
+ "Time at which the list of installed packages was updated.")
+
+(defvar pcmpl-rpm-packages nil
+ "List of installed packages.")
+
;; Functions:
-;; FIXME rpm -qa can be slow, so:
-;; Adding --nodigest --nosignature is MUCH faster.
-;; (Probably need to test --help for those options though.)
-;; Consider caching the result (cf woman).
-;; Consider printing an explanatory message before running -qa.
-;;
-;; Seems pointless for this to be a defsubst.
-(defsubst pcmpl-rpm-packages ()
- (split-string (pcomplete-process-result "rpm" "-q" "-a")))
+(defun pcmpl-rpm-packages ()
+ "Return a list of all installed rpm packages."
+ (if (and pcmpl-rpm-cache
+ pcmpl-rpm-cache-time
+ (let ((mtime (nth 5 (file-attributes pcmpl-rpm-cache-stamp-file))))
+ (and mtime (not (time-less-p pcmpl-rpm-cache-time mtime)))))
+ pcmpl-rpm-packages
+ (message "Getting list of installed rpms...")
+ (setq pcmpl-rpm-cache-time (current-time)
+ pcmpl-rpm-packages
+ (split-string (apply 'pcomplete-process-result "rpm"
+ (append '("-q" "-a")
+ (if (stringp pcmpl-rpm-query-options)
+ (list pcmpl-rpm-query-options)
+ pcmpl-rpm-query-options)))))
+ (message "Getting list of installed rpms...done")
+ pcmpl-rpm-packages))
+;; Should this use pcmpl-rpm-query-options?
+;; I don't think it would speed it up at all (?).
(defun pcmpl-rpm-all-query (flag)
(message "Querying all packages with `%s'..." flag)
(let ((pkgs (pcmpl-rpm-packages))
;; Avoid connecting to the remote host when we're
;; only completing the host name.
(list string)
- (comint--table-subvert (pcomplete-all-entries)
- "" "/ssh:")))
+ (completion-table-subvert (pcomplete-all-entries)
+ "" "/ssh:")))
((string-match "/" string) ; Local file name.
(pcomplete-all-entries))
(t ;Host name or local file name.
;; argument position.
;;
;; To use pcomplete with shell-mode, for example, you will need the
-;; following in your .emacs file:
+;; following in your init file:
;;
;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup)
;;
;;; Code:
-(eval-when-compile (require 'cl))
(require 'comint)
(defgroup pcomplete nil
:type 'boolean
:group 'pcomplete)
-(defcustom pcomplete-arg-quote-list nil
- "List of characters to quote when completing an argument."
- :type '(choice (repeat character)
- (const :tag "Don't quote" nil))
- :group 'pcomplete)
-
-(defcustom pcomplete-quote-arg-hook nil
- "A hook which is run to quote a character within a filename.
-Each function is passed both the filename to be quoted, and the index
-to be considered. If the function wishes to provide an alternate
-quoted form, it need only return the replacement string. If no
-function provides a replacement, quoting shall proceed as normal,
-using a backslash to quote any character which is a member of
-`pcomplete-arg-quote-list'."
- :type 'hook
- :group 'pcomplete)
+(define-obsolete-variable-alias
+ '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.
;; it pretty much impossible to have completion other than
;; prefix-completion.
;;
-;; pcomplete--common-quoted-suffix and comint--table-subvert try to
-;; work around this difficulty with heuristics, but it's
-;; really a hack.
-
-(defvar pcomplete-unquote-argument-function nil)
-
-(defun pcomplete-unquote-argument (s)
- (cond
- (pcomplete-unquote-argument-function
- (funcall pcomplete-unquote-argument-function s))
- ((null pcomplete-arg-quote-list) s)
- (t
- (replace-regexp-in-string "\\\\\\(.\\)" "\\1" s t))))
-
-(defun pcomplete--common-quoted-suffix (s1 s2)
- ;; FIXME: Copied in comint.el.
- "Find the common suffix between S1 and S2 where S1 is the expanded S2.
-S1 is expected to be the unquoted and expanded version of S2.
-Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
-S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
-SS1 = (unquote SS2)."
- (let* ((cs (comint--common-suffix s1 s2))
- (ss1 (substring s1 (- (length s1) cs)))
- (qss1 (pcomplete-quote-argument ss1))
- qc s2b)
- (if (and (not (equal ss1 qss1))
- (setq qc (pcomplete-quote-argument (substring ss1 0 1)))
- (setq s2b (- (length s2) cs (length qc) -1))
- (>= s2b 0) ;bug#11158.
- (eq t (compare-strings s2 s2b (- (length s2) cs -1)
- qc nil nil)))
- ;; The difference found is just that one char is quoted in S2
- ;; but not in S1, keep looking before this difference.
- (pcomplete--common-quoted-suffix
- (substring s1 0 (- (length s1) cs))
- (substring s2 0 s2b))
- (cons (substring s1 0 (- (length s1) cs))
- (substring s2 0 (- (length s2) cs))))))
-
-;; I don't think such commands are usable before first setting up buffer-local
-;; variables to parse args, so there's no point autoloading it.
-;; ;;;###autoload
+;; pcomplete--common-suffix and completion-table-subvert try to work around
+;; this difficulty with heuristics, but it's really a hack.
+
+(defvar pcomplete-unquote-argument-function #'comint--unquote-argument)
+
+(defsubst pcomplete-unquote-argument (s)
+ (funcall pcomplete-unquote-argument-function s))
+
+(defvar pcomplete-requote-argument-function #'comint--requote-argument)
+
+(defun pcomplete--common-suffix (s1 s2)
+ ;; Since S2 is expected to be the "unquoted/expanded" version of S1,
+ ;; there shouldn't be any case difference, even if the completion is
+ ;; case-insensitive.
+ (let ((case-fold-search nil))
+ (string-match
+ ;; \x3FFF7F is just an arbitrary char among the ones Emacs accepts
+ ;; that hopefully will never appear in normal text.
+ "\\(?:.\\|\n\\)*?\\(\\(?:.\\|\n\\)*\\)\x3FFF7F\\(?:.\\|\n\\)*\\1\\'"
+ (concat s1 "\x3FFF7F" s2))
+ (- (match-end 1) (match-beginning 1))))
+
(defun pcomplete-completions-at-point ()
"Provide standard completion using pcomplete's completion tables.
Same as `pcomplete' but using the standard completion UI."
;; pcomplete-stub and works from the buffer's text instead,
;; we need to trick minibuffer-complete, into using
;; pcomplete-stub without its knowledge. To that end, we
- ;; use comint--table-subvert to construct a completion
+ ;; use completion-table-subvert to construct a completion
;; table which expects strings using a prefix from the
;; buffer's text but internally uses the corresponding
;; prefix from pcomplete-stub.
(beg (max (- (point) (length pcomplete-stub))
(pcomplete-begin)))
- (buftext (buffer-substring beg (point))))
+ (buftext (pcomplete-unquote-argument
+ (buffer-substring beg (point)))))
(when completions
(let ((table
- (cond
- ((not (equal pcomplete-stub buftext))
- ;; This isn't always strictly right (e.g. if
- ;; FOO="toto/$FOO", then completion of /$FOO/bar may
- ;; result in something incorrect), but given the lack of
- ;; any other info, it's about as good as it gets, and in
- ;; practice it should work just fine (fingers crossed).
- (let ((prefixes (pcomplete--common-quoted-suffix
+ (completion-table-with-quoting
+ (if (equal pcomplete-stub buftext)
+ completions
+ ;; This may not always be strictly right, but given the lack
+ ;; of any other info, it's about as good as it gets, and in
+ ;; practice it should work just fine (fingers crossed).
+ (let ((suf-len (pcomplete--common-suffix
pcomplete-stub buftext)))
- (comint--table-subvert
- completions (cdr prefixes) (car prefixes)
- #'pcomplete-quote-argument #'pcomplete-unquote-argument)))
- (t
- (lambda (string pred action)
- (let ((res (complete-with-action
- action completions string pred)))
- (if (stringp res)
- (pcomplete-quote-argument res)
- res))))))
+ (completion-table-subvert
+ completions
+ (substring buftext 0 (- (length buftext) suf-len))
+ (substring pcomplete-stub 0
+ (- (length pcomplete-stub) suf-len)))))
+ pcomplete-unquote-argument-function
+ pcomplete-requote-argument-function))
(pred
;; Pare it down, if applicable.
(when (and pcomplete-use-paring pcomplete-seen)
(list beg (point) table
:predicate pred
:exit-function
+ ;; If completion is finished, add a terminating space.
+ ;; We used to also do this if STATUS is `sole', but
+ ;; that does not work right when completion cycling.
(unless (zerop (length pcomplete-termination-string))
- (lambda (_s finished)
- (when (memq finished '(sole finished))
+ (lambda (_s status)
+ (when (eq status 'finished)
(if (looking-at
(regexp-quote pcomplete-termination-string))
(goto-char (match-end 0))
(defun pcomplete-parse-comint-arguments ()
"Parse whitespace separated arguments in the current region."
+ (declare (obsolete comint-parse-pcomplete-arguments "24.1"))
(let ((begin (save-excursion (comint-bol nil) (point)))
(end (point))
begins args)
(push (buffer-substring-no-properties (car begins) (point))
args))
(cons (nreverse args) (nreverse begins)))))
-(make-obsolete 'pcomplete-parse-comint-arguments
- 'comint-parse-pcomplete-arguments "24.1")
(defun pcomplete-parse-arguments (&optional expand-p)
"Parse the command line arguments. Most completions need this info."
(throw 'pcompleted t)
pcomplete-args))))))
-(defun pcomplete-quote-argument (filename)
- "Return FILENAME with magic characters quoted.
-Magic characters are those in `pcomplete-arg-quote-list'."
- (if (null pcomplete-arg-quote-list)
- filename
- (let ((index 0))
- (mapconcat (lambda (c)
- (prog1
- (or (run-hook-with-args-until-success
- 'pcomplete-quote-arg-hook filename index)
- (when (memq c pcomplete-arg-quote-list)
- (string ?\\ c))
- (char-to-string c))
- (setq index (1+ index))))
- filename
- ""))))
+(define-obsolete-function-alias
+ 'pcomplete-quote-argument #'comint-quote-filename "24.3")
;; file-system completion lists
;; The env-var is "out of bounds".
(if (eq action t)
(complete-with-action action table newstring pred)
- (list* 'boundaries
- (+ (car bounds) (- orig-length (length newstring)))
- (cdr bounds)))
+ `(boundaries
+ ,(+ (car bounds) (- orig-length (length newstring)))
+ . ,(cdr bounds)))
;; The env-var is in the file bounds.
(if (eq action t)
(let ((comps (complete-with-action
;; Strip the part of each completion that's actually
;; coming from the env-var.
(mapcar (lambda (s) (substring s len)) comps))
- (list* 'boundaries
- (+ envpos (- orig-length (length newstring)))
- (cdr bounds))))))))))
+ `(boundaries
+ ,(+ envpos (- orig-length (length newstring)))
+ . ,(cdr bounds))))))))))
(defsubst pcomplete-all-entries (&optional regexp predicate)
"Like `pcomplete-entries', but doesn't ignore any entries."
(if (not pcomplete-ignore-case)
(insert-and-inherit (if raw-p
(substring entry (length stub))
- (pcomplete-quote-argument
+ (comint-quote-filename
(substring entry (length stub)))))
;; the stub is not quoted at this time, so to determine the
;; length of what should be in the buffer, we must quote it
;; FIXME: Here we presume that quoting `stub' gives us the exact
;; text in the buffer before point, which is not guaranteed;
;; e.g. it is not the case in eshell when completing ${FOO}tm[TAB].
- (delete-char (- (length (pcomplete-quote-argument stub))))
+ (delete-char (- (length (comint-quote-filename stub))))
;; if there is already a backslash present to handle the first
;; character, don't bother quoting it
(when (eq (char-before) ?\\)
(setq entry (substring entry 1)))
(insert-and-inherit (if raw-p
entry
- (pcomplete-quote-argument entry))))
+ (comint-quote-filename entry))))
(let (space-added)
(when (and (not (memq (char-before) pcomplete-suffix-list))
addsuffix)
pcomplete-last-completion-stub stub)
space-added)))
-;; selection of completions
+;; Selection of completions.
(defun pcomplete-do-complete (stub completions)
"Dynamically complete at point using STUB and COMPLETIONS.
;; Things we need.
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; Customize options.
(defun 5x5-make-new-grid ()
"Create and return a new `5x5' grid structure."
(let ((grid (make-vector 5x5-grid-size nil)))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (aset grid y (make-vector 5x5-grid-size nil)))
+ (dotimes (y 5x5-grid-size)
+ (aset grid y (make-vector 5x5-grid-size nil)))
grid))
(defun 5x5-cell (grid y x)
(defun 5x5-copy-grid (grid)
"Make a new copy of GRID."
(let ((copy (5x5-make-new-grid)))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (5x5-set-cell copy y x (5x5-cell grid y x))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (5x5-set-cell copy y x (5x5-cell grid y x))))
copy))
(defun 5x5-make-move (grid row col)
(defun 5x5-row-value (row)
"Get the \"on-value\" for grid row ROW."
- (loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0)))
+ (cl-loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0)))
(defun 5x5-grid-value (grid)
"Get the \"on-value\" for grid GRID."
- (loop for y from 0 to (1- 5x5-grid-size) sum (5x5-row-value (aref grid y))))
+ (cl-loop for y from 0 to (1- 5x5-grid-size)
+ sum (5x5-row-value (aref grid y))))
(defun 5x5-draw-grid-end ()
"Draw the top/bottom of the grid."
(insert "+")
- (loop for x from 0 to (1- 5x5-grid-size) do
- (insert "-" (make-string 5x5-x-scale ?-)))
+ (dotimes (x 5x5-grid-size)
+ (insert "-" (make-string 5x5-x-scale ?-)))
(insert "-+ "))
(defun 5x5-draw-grid (grids)
"Draw the grids GRIDS into the current buffer."
(let ((inhibit-read-only t) grid-org)
(erase-buffer)
- (loop for grid in grids do (5x5-draw-grid-end))
+ (dolist (grid grids) (5x5-draw-grid-end))
(insert "\n")
(setq grid-org (point))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for lines from 0 to (1- 5x5-y-scale) do
- (loop for grid in grids do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (insert (if (zerop x) "| " " ")
- (make-string 5x5-x-scale
- (if (5x5-cell grid y x) ?# ?.))))
- (insert " | "))
- (insert "\n")))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (lines 5x5-y-scale)
+ (dolist (grid grids)
+ (dotimes (x 5x5-grid-size)
+ (insert (if (zerop x) "| " " ")
+ (make-string 5x5-x-scale
+ (if (5x5-cell grid y x) ?# ?.))))
+ (insert " | "))
+ (insert "\n")))
(when 5x5-solver-output
(if (= (car 5x5-solver-output) 5x5-moves)
(save-excursion
(goto-char grid-org)
(beginning-of-line (+ 1 (/ 5x5-y-scale 2)))
- (let ((solution-grid (cdadr 5x5-solver-output)))
- (dotimes (y 5x5-grid-size)
+ (let ((solution-grid (cl-cdadr 5x5-solver-output)))
+ (dotimes (y 5x5-grid-size)
(save-excursion
(forward-char (+ 1 (/ (1+ 5x5-x-scale) 2)))
- (dotimes (x 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
(when (5x5-cell solution-grid y x)
(if (= 0 (mod 5x5-x-scale 2))
(progn
(forward-char (1+ 5x5-x-scale))))
(forward-line 5x5-y-scale))))
(setq 5x5-solver-output nil)))
- (loop for grid in grids do (5x5-draw-grid-end))
+ (dolist (grid grids) (5x5-draw-grid-end))
(insert "\n")
(insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves))))
(defun 5x5-made-move ()
"Keep track of how many moves have been made."
- (incf 5x5-moves))
+ (cl-incf 5x5-moves))
(defun 5x5-make-random-grid (&optional move)
"Make a random grid."
(setq move (or move (symbol-function '5x5-flip-cell)))
(let ((grid (5x5-make-new-grid)))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (if (zerop (random 2))
- (funcall move grid y x))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (if (zerop (random 2))
+ (funcall move grid y x))))
grid))
;; Cracker functions.
(defun 5x5-make-xor-with-mutation (current best)
"Xor current and best solution then mutate the result."
(let ((xored (5x5-make-new-grid)))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (5x5-set-cell xored y x
- (5x5-xor (5x5-cell current y x)
- (5x5-cell best y x)))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (5x5-set-cell xored y x
+ (5x5-xor (5x5-cell current y x)
+ (5x5-cell best y x)))))
(5x5-mutate-solution xored)))
(defun 5x5-mutate-solution (solution)
"Randomly flip bits in the solution."
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2))
- (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2))
- (5x5-flip-cell solution y x))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2))
+ (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2))
+ (5x5-flip-cell solution y x))))
solution)
(defun 5x5-play-solution (solution best)
in progress because it is an animated attempt."
(5x5-new-game)
(let ((inhibit-quit t))
- (loop for y from 0 to (1- 5x5-grid-size) do
- (loop for x from 0 to (1- 5x5-grid-size) do
- (setq 5x5-y-pos y
- 5x5-x-pos x)
- (if (5x5-cell solution y x)
- (5x5-flip-current))
- (5x5-draw-grid (list 5x5-grid solution best))
- (5x5-position-cursor)
- (sit-for 5x5-animate-delay))))
+ (dotimes (y 5x5-grid-size)
+ (dotimes (x 5x5-grid-size)
+ (setq 5x5-y-pos y
+ 5x5-x-pos x)
+ (if (5x5-cell solution y x)
+ (5x5-flip-current))
+ (5x5-draw-grid (list 5x5-grid solution best))
+ (5x5-position-cursor)
+ (sit-for 5x5-animate-delay))))
5x5-grid)
;; Arithmetic solver
Solutions are sorted from least to greatest Hamming weight."
(require 'calc-ext)
- (flet ((5x5-mat-mode-2
- (a)
- (math-map-vec
- (lambda (y)
- (math-map-vec
- (lambda (x) `(mod ,x 2))
- y))
- a)))
+ (cl-flet ((5x5-mat-mode-2
+ (a)
+ (math-map-vec
+ (lambda (y)
+ (math-map-vec
+ (lambda (x) `(mod ,x 2))
+ y))
+ a)))
(let* (calc-command-flags
(grid-size-squared (* 5x5-grid-size 5x5-grid-size))
(cdr (5x5-mat-mode-2
'(vec (vec 0 1 1 1 0 1 0 1 0 1 1 1 0 1
1 1 0 1 0 1 0 1 1 1 0)
- (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
- 1 0 0 0 0 0 1 1 0 1 1)))))
+ (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1
+ 1 0 0 0 0 0 1 1 0 1 1)))))
(calcFunc-trn id))))
(inv-base-change
;; The Hamming Weight is computed by matrix reduction
;; with an ad-hoc operator.
(math-reduce-vec
- ;; (cadadr '(vec (mod x 2))) => x
- (lambda (r x) (+ (if (integerp r) r (cadadr r))
- (cadadr x)))
+ ;; (cl-cadadr '(vec (mod x 2))) => x
+ (lambda (r x) (+ (if (integerp r) r (cl-cadadr r))
+ (cl-cadadr x)))
solution); car
(5x5-vec-to-grid
(calcFunc-arrange solution 5x5-grid-size));cdr
"Move up."
(interactive)
(unless (zerop 5x5-y-pos)
- (decf 5x5-y-pos)
+ (cl-decf 5x5-y-pos)
(5x5-position-cursor)))
(defun 5x5-down ()
"Move down."
(interactive)
(unless (= 5x5-y-pos (1- 5x5-grid-size))
- (incf 5x5-y-pos)
+ (cl-incf 5x5-y-pos)
(5x5-position-cursor)))
(defun 5x5-left ()
"Move left."
(interactive)
(unless (zerop 5x5-x-pos)
- (decf 5x5-x-pos)
+ (cl-decf 5x5-x-pos)
(5x5-position-cursor)))
(defun 5x5-right ()
"Move right."
(interactive)
(unless (= 5x5-x-pos (1- 5x5-grid-size))
- (incf 5x5-x-pos)
+ (cl-incf 5x5-x-pos)
(5x5-position-cursor)))
(defun 5x5-bol ()
(y-or-n-p prompt)
t))
-(random t)
-
(provide '5x5)
;;; 5x5.el ends here
"*Number of steps `animate-string' will place a char before its last position.")
(defvar animation-buffer-name nil
- "*String naming the default buffer for animations.
+ "String naming the default buffer for animations.
When nil animations displayed in the buffer named *Animation*.")
;;;###autoload
(animate-string "my sunshine" 18 34)
(animate-string "to stay!" 19 34))
-(random t)
-
(provide 'animate)
;;; animate.el ends here
(bb-goto (cons bb-x bb-y)))
(defun bb-init-board (num-balls)
- (random t)
(let (board pos)
(while (>= (setq num-balls (1- num-balls)) 0)
(while
;; Installation
;; ------------
-;; Add the following lines to your Emacs startup file (`~/.emacs').
+;; Add the following lines to your init file:
;; (add-to-list 'load-path "/path/to/bubbles/")
;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
(defconst bubbles-version "0.5" "Version number of bubbles.el.")
(require 'gamegrid)
-(eval-when-compile (require 'cl)) ; for 'case
;; User options
(defsubst bubbles--grid-width ()
"Return the grid width for the current game theme."
- (car (case bubbles-game-theme
- (easy
+ (car (pcase bubbles-game-theme
+ (`easy
bubbles--grid-small)
- (medium
+ (`medium
bubbles--grid-medium)
- (difficult
+ (`difficult
bubbles--grid-large)
- (hard
+ (`hard
bubbles--grid-huge)
- (user-defined
+ (`user-defined
bubbles-grid-size))))
(defsubst bubbles--grid-height ()
"Return the grid height for the current game theme."
- (cdr (case bubbles-game-theme
- (easy
+ (cdr (pcase bubbles-game-theme
+ (`easy
bubbles--grid-small)
- (medium
+ (`medium
bubbles--grid-medium)
- (difficult
+ (`difficult
bubbles--grid-large)
- (hard
+ (`hard
bubbles--grid-huge)
- (user-defined
+ (`user-defined
bubbles-grid-size))))
(defsubst bubbles--colors ()
"Return the color list for the current game theme."
- (case bubbles-game-theme
- (easy
+ (pcase bubbles-game-theme
+ (`easy
bubbles--colors-2)
- (medium
+ (`medium
bubbles--colors-3)
- (difficult
+ (`difficult
bubbles--colors-4)
- (hard
+ (`hard
bubbles--colors-5)
- (user-defined
+ (`user-defined
bubbles-colors)))
(defsubst bubbles--shift-mode ()
"Return the shift mode for the current game theme."
- (case bubbles-game-theme
- (easy
+ (pcase bubbles-game-theme
+ (`easy
'default)
- (medium
+ (`medium
'default)
- (difficult
+ (`difficult
'always)
- (hard
+ (`hard
'always)
- (user-defined
+ (`user-defined
bubbles-shift-mode)))
(defun bubbles-save-settings ()
"Prepare images for playing `bubbles'."
(when (and (display-images-p)
(not (eq bubbles-graphics-theme 'ascii)))
- (let ((template (case bubbles-graphics-theme
- (circles bubbles--image-template-circle)
- (balls bubbles--image-template-ball)
- (squares bubbles--image-template-square)
- (diamonds bubbles--image-template-diamond)
- (emacs bubbles--image-template-emacs))))
+ (let ((template (pcase bubbles-graphics-theme
+ (`circles bubbles--image-template-circle)
+ (`balls bubbles--image-template-ball)
+ (`squares bubbles--image-template-square)
+ (`diamonds bubbles--image-template-diamond)
+ (`emacs bubbles--image-template-emacs))))
(setq bubbles--empty-image
(create-image (replace-regexp-in-string
"^\"\\(.*\\)\t.*c .*\",$"
;;; Code:
-; Randomize the seed in the random number generator.
-(random t)
-
(defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0"
"Delimiter used to separate cookie file entries.")
"Reads in the PHRASE-FILE, returns it as a vector of strings.
Emit STARTMSG and ENDMSG before and after. Caches the result; second
and subsequent calls on the same file won't go to disk."
+ (or (file-readable-p phrase-file)
+ (error "Cannot read file `%s'" phrase-file))
(let ((sym (intern-soft phrase-file cookie-cache)))
(and sym (not (equal (symbol-function sym)
(nth 5 (file-attributes phrase-file))))
;;; Variables:
;;;===================================================================
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup decipher nil
"Cryptanalyze monoalphabetic substitution ciphers."
("^)\\([A-Z ]+\\)\\([a-z ]+\\)"
(1 font-lock-keyword-face)
(2 font-lock-string-face)))
- "Expressions to fontify in Decipher mode.
-
-Ciphertext uses `font-lock-keyword-face', plaintext uses
-`font-lock-string-face', comments use `font-lock-comment-face', and
-checkpoints use `font-lock-constant-face'. You can customize the
-display by changing these variables. For best results, I recommend
-that all faces use the same background color.
-
-For example, to display ciphertext in the `bold' face, use
- (add-hook 'decipher-mode-hook
- (lambda () (set (make-local-variable 'font-lock-keyword-face)
- 'bold)))
-in your `.emacs' file.")
+ "Font Lock keywords for Decipher mode.")
(defvar decipher-mode-map
(let ((map (make-keymap)))
(let ((key ?a))
(while (<= key ?z)
(define-key map (vector key) 'decipher-keypress)
- (incf key)))
+ (cl-incf key)))
map)
"Keymap for Decipher mode.")
(c ?0))
(while (<= c ?9)
(modify-syntax-entry c "_" table) ;Digits are not part of words
- (incf c))
+ (cl-incf c))
(setq decipher-mode-syntax-table table)))
(defvar decipher-alphabet nil)
(if undo-rec
(progn
(push undo-rec decipher-undo-list)
- (incf decipher-undo-list-size)
+ (cl-incf decipher-undo-list-size)
(if (> decipher-undo-list-size decipher-undo-limit)
(let ((new-size (- decipher-undo-limit 100)))
;; Truncate undo list to NEW-SIZE elements:
(progn
(while (rassoc cipher-char decipher-alphabet)
;; Find the next unused letter
- (incf cipher-char))
+ (cl-incf cipher-char))
(push (cons ?\s cipher-char) undo-rec)
(decipher-set-map cipher-char (car plain-map) t))))
(decipher-add-undo undo-rec)))
(while (>= plain-char ?a)
(backward-char)
(push (cons plain-char (following-char)) decipher-alphabet)
- (decf plain-char)))))
+ (cl-decf plain-char)))))
;;;===================================================================
;;; Analyzing ciphertext:
(while temp-list
(insert (caar temp-list)
(format "%4d%3d%% "
- (cadar temp-list)
- (/ (* 100 (cadar temp-list)) total)))
+ (cl-cadar temp-list)
+ (/ (* 100 (cl-cadar temp-list)) total)))
(setq temp-list (nthcdr 4 temp-list)))
(insert ?\n)
(setq freq-list (cdr freq-list)
;; A vector of 26 integers, counting the number of occurrences
;; of the corresponding characters.
(setq decipher--digram (format "%c%c" decipher--prev-char decipher-char))
- (incf (cdr (or (assoc decipher--digram decipher--digram-list)
+ (cl-incf (cdr (or (assoc decipher--digram decipher--digram-list)
(car (push (cons decipher--digram 0)
decipher--digram-list)))))
(and (>= decipher--prev-char ?A)
- (incf (aref (aref decipher--before (- decipher--prev-char ?A))
+ (cl-incf (aref (aref decipher--before (- decipher--prev-char ?A))
(if (equal decipher-char ?\s)
26
(- decipher-char ?A)))))
(and (>= decipher-char ?A)
- (incf (aref decipher--freqs (- decipher-char ?A)))
- (incf (aref (aref decipher--after (- decipher-char ?A))
+ (cl-incf (aref decipher--freqs (- decipher-char ?A)))
+ (cl-incf (aref (aref decipher--after (- decipher-char ?A))
(if (equal decipher--prev-char ?\s)
26
(- decipher--prev-char ?A)))))
(let ((total 0))
(concat
(mapconcat (lambda (x)
- (cond ((> x 99) (incf total) "XX")
- ((> x 0) (incf total) (format "%2d" x))
+ (cond ((> x 99) (cl-incf total) "XX")
+ ((> x 0) (cl-incf total) (format "%2d" x))
(t " ")))
counts
"")
;; We do not include spaces (word divisions) in this count.
(let ((total 0)
(i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(if (or (> (aref before-count i) 0)
(> (aref after-count i) 0))
- (incf total)))
+ (cl-incf total)))
total))
(defun decipher-analyze-buffer ()
decipher--digram decipher--digram-list freq-list)
(message "Scanning buffer...")
(let ((i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(aset decipher--before i (make-vector 27 0))
(aset decipher--after i (make-vector 27 0))))
(if decipher-ignore-spaces
(decipher-loop-no-breaks 'decipher--analyze)
;; The first character of ciphertext was marked as following a space:
(let ((i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(aset (aref decipher--after i) 26 0))))
(decipher-loop-with-breaks 'decipher--analyze))
(message "Processing results...")
;; of times it occurs, and DIFFERENT is the number of different
;; letters it appears next to.
(let ((i 26))
- (while (>= (decf i) 0)
+ (while (>= (cl-decf i) 0)
(setq freq-list
(cons (list (+ i ?A)
(aref decipher--freqs i)
(insert ?\n)
;; Display frequency counts for letters in order of frequency:
(setq freq-list (sort freq-list
- (lambda (a b) (> (second a) (second b)))))
+ (lambda (a b) (> (cl-second a) (cl-second b)))))
(decipher-insert-frequency-counts freq-list total-chars)
;; Display letters in order of frequency:
(insert ?\n (mapconcat (lambda (a) (char-to-string (car a)))
;; Display adjacency list for each letter, sorted in descending
;; order of the number of adjacent letters:
(setq freq-list (sort freq-list
- (lambda (a b) (> (third a) (third b)))))
+ (lambda (a b) (> (cl-third a) (cl-third b)))))
(let ((temp-list freq-list)
entry i)
(while (setq entry (pop temp-list))
- (if (equal 0 (second entry))
+ (if (equal 0 (cl-second entry))
nil ;This letter was not used
(setq i (- (car entry) ?A))
(insert ?\n " "
(car entry)
": A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *"
(format "%4d %4d %3d%%\n "
- (third entry) (second entry)
- (/ (* 100 (second entry)) total-chars))
+ (cl-third entry) (cl-second entry)
+ (/ (* 100 (cl-second entry)) total-chars))
(decipher--digram-counts (aref decipher--after i)) ?\n))))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(funcall search-function overlap opoint t))))))
(sit-for 0))))
-(random t)
-
(provide 'dissociate)
;;; dissociate.el ends here
(doctor-read-print)
(newline arg)))
-(defun doctor-read-print nil
+(defun doctor-read-print ()
"Top level loop."
(interactive)
- (let ((sent (doctor-readin)))
- (insert "\n")
- (setq doctor--lincount (1+ doctor--lincount))
- (doctor-doc sent)
- (insert "\n")
- (setq doctor--bak sent)))
-
-(defun doctor-readin nil
+ (setq doctor-sent (doctor-readin))
+ (insert "\n")
+ (setq doctor--lincount (1+ doctor--lincount))
+ (doctor-doc)
+ (insert "\n")
+ (setq doctor--bak doctor-sent))
+
+(defun doctor-readin ()
"Read a sentence. Return it as a list of words."
(let (sentence)
(backward-sentence 1)
\f
;; Main processing function for sentences that have been read.
-(defun doctor-doc (sent)
+(defun doctor-doc ()
(cond
- ((equal sent '(foo))
+ ((equal doctor-sent '(foo))
(doctor-type '(bar! (doc$ doctor--please) (doc$ doctor--continue) \.)))
- ((member sent doctor--howareyoulst)
+ ((member doctor-sent doctor--howareyoulst)
(doctor-type '(i\'m ok \. (doc$ doctor--describe) yourself \.)))
- ((or (member sent '((good bye) (see you later) (i quit) (so long)
- (go away) (get lost)))
- (memq (car sent)
+ ((or (member doctor-sent '((good bye) (see you later) (i quit) (so long)
+ (go away) (get lost)))
+ (memq (car doctor-sent)
'(bye halt break quit done exit goodbye
bye\, stop pause goodbye\, stop pause)))
(doctor-type (doc$ doctor--bye)))
- ((and (eq (car sent) 'you)
- (memq (cadr sent) doctor--abusewords))
- (setq doctor-found (cadr sent))
+ ((and (eq (car doctor-sent) 'you)
+ (memq (cadr doctor-sent) doctor--abusewords))
+ (setq doctor-found (cadr doctor-sent))
(doctor-type (doc$ doctor--abuselst)))
- ((eq (car sent) 'whatmeans)
- (doctor-def (cadr sent)))
- ((equal sent '(parse))
+ ((eq (car doctor-sent) 'whatmeans)
+ (doctor-def (cadr doctor-sent)))
+ ((equal doctor-sent '(parse))
(doctor-type (list 'subj '= doctor-subj ", "
'verb '= doctor-verb "\n"
'object 'phrase '= doctor-obj ","
'sentence 'used 'was
"..."
'(doc// doctor--bak))))
- ((memq (car sent) '(are is do has have how when where who why))
+ ((memq (car doctor-sent) '(are is do has have how when where who why))
(doctor-type (doc$ doctor--qlist)))
;; ((eq (car sent) 'forget)
;; (set (cadr sent) nil)
;; (doctor-type '((doc$ doctor--isee) (doc$ doctor--please)
;; (doc$ doctor--continue)\.)))
(t
- (if (doctor-defq sent) (doctor-define sent doctor-found))
- (if (> (length sent) 12) (setq sent (doctor-shorten sent)))
- (setq sent (doctor-correct-spelling (doctor-replace sent doctor--replist)))
- (cond ((and (not (memq 'me sent)) (not (memq 'i sent))
- (memq 'am sent))
- (setq sent (doctor-replace sent '((am . (are)))))))
- (cond ((equal (car sent) 'yow) (doctor-zippy))
- ((< (length sent) 2)
- (cond ((eq (doctor-meaning (car sent)) 'howdy)
+ (if (doctor-defq doctor-sent) (doctor-define doctor-sent doctor-found))
+ (if (> (length doctor-sent) 12)
+ (setq doctor-sent (doctor-shorten doctor-sent)))
+ (setq doctor-sent (doctor-correct-spelling
+ (doctor-replace doctor-sent doctor--replist)))
+ (cond ((and (not (memq 'me doctor-sent)) (not (memq 'i doctor-sent))
+ (memq 'am doctor-sent))
+ (setq doctor-sent (doctor-replace doctor-sent '((am . (are)))))))
+ (cond ((equal (car doctor-sent) 'yow) (doctor-zippy))
+ ((< (length doctor-sent) 2)
+ (cond ((eq (doctor-meaning (car doctor-sent)) 'howdy)
(doctor-howdy))
(t (doctor-short))))
(t
- (if (memq 'am sent)
- (setq sent (doctor-replace sent '((me . (i))))))
- (setq sent (doctor-fixup sent))
- (if (and (eq (car sent) 'do) (eq (cadr sent) 'not))
+ (if (memq 'am doctor-sent)
+ (setq doctor-sent (doctor-replace doctor-sent '((me . (i))))))
+ (setq doctor-sent (doctor-fixup doctor-sent))
+ (if (and (eq (car doctor-sent) 'do) (eq (cadr doctor-sent) 'not))
(cond ((zerop (random 3))
(doctor-type '(are you (doc$ doctor--afraidof) that \?)))
((zerop (random 2))
(doctor-rthing))
(t
(doctor-type '((doc$ doctor--whysay) that i shouldn\'t
- (cddr sent)
+ (cddr doctor-sent)
\?))))
- (doctor-go (doctor-wherego sent))))))))
+ (doctor-go (doctor-wherego doctor-sent))))))))
\f
;; Things done to process sentences once read.
(defun doctor-chat () (doctor-type (doc$ doctor--chatlst)))
-(random t)
-
(provide 'doctor)
;;; doctor.el ends here
(dun-uexit nil)))
-(random t)
(setq tloc (+ 60 (random 18)))
(dun-replace dun-room-objects tloc
(append (nth tloc dun-room-objects) (list 18)))
;;; Code:
-(eval-when-compile
- (require 'cl))
-
;; ;;;;;;;;;;;;; buffer-local variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar gamegrid-use-glyphs t
(defun gamegrid-make-face (data-spec-list color-spec-list)
(let ((data (gamegrid-match-spec-list data-spec-list))
(color (gamegrid-match-spec-list color-spec-list)))
- (case data
- (color-x
+ (pcase data
+ (`color-x
(gamegrid-make-color-x-face color))
- (grid-x
+ (`grid-x
(unless gamegrid-grid-x-face
(setq gamegrid-grid-x-face (gamegrid-make-grid-x-face)))
gamegrid-grid-x-face)
- (mono-x
+ (`mono-x
(unless gamegrid-mono-x-face
(setq gamegrid-mono-x-face (gamegrid-make-mono-x-face)))
gamegrid-mono-x-face)
- (color-tty
+ (`color-tty
(gamegrid-make-color-tty-face color))
- (mono-tty
+ (`mono-tty
(unless gamegrid-mono-tty-face
(setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face)))
gamegrid-mono-tty-face))))
(intern (concat "gamegrid-face-" (buffer-name)))))
(when (eq gamegrid-display-mode 'glyph)
(let ((max-height nil))
- (loop for c from 0 to 255 do
- (let ((glyph (aref gamegrid-display-table c)))
- (when (and (listp glyph) (eq (car glyph) 'image))
- (let ((height (cdr (image-size glyph))))
- (if (or (null max-height)
- (< max-height height))
- (setq max-height height))))))
+ (dotimes (c 256)
+ (let ((glyph (aref gamegrid-display-table c)))
+ (when (and (listp glyph) (eq (car glyph) 'image))
+ (let ((height (cdr (image-size glyph))))
+ (if (or (null max-height)
+ (< max-height height))
+ (setq max-height height))))))
(when (and max-height (< max-height 1))
(let ((default-font-height (face-attribute 'default :height))
(resy (/ (display-pixel-height) (/ (display-mm-height) 25.4)))
(setq gamegrid-display-mode (gamegrid-display-type))
(setq gamegrid-display-table (make-display-table))
(setq gamegrid-face-table (make-vector 256 nil))
- (loop for c from 0 to 255 do
+ (dotimes (c 256)
(let* ((spec (aref gamegrid-display-options c))
- (glyph (gamegrid-make-glyph (car spec) (caddr spec)))
- (face (gamegrid-make-face (cadr spec) (caddr spec))))
+ (glyph (gamegrid-make-glyph (car spec) (nth 2 spec)))
+ (face (gamegrid-make-face (cadr spec) (nth 2 spec))))
(aset gamegrid-face-table c face)
(aset gamegrid-display-table c glyph)))
(gamegrid-setup-default-font)
On non-POSIX systems Emacs searches for FILE in the directory
specified by the variable `temporary-file-directory'. If necessary,
FILE is created there."
- (case system-type
- ((ms-dos windows-nt)
+ (pcase system-type
+ ((or `ms-dos `windows-nt)
(gamegrid-add-score-insecure file score))
- (t
+ (_
(gamegrid-add-score-with-update-game-score file score))))
;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
(defconst gomoku-square-width 4
- "*Horizontal spacing between squares on the Gomoku board.")
+ "Horizontal spacing between squares on the Gomoku board.")
(defconst gomoku-square-height 2
- "*Vertical spacing between squares on the Gomoku board.")
+ "Vertical spacing between squares on the Gomoku board.")
(defconst gomoku-x-offset 3
- "*Number of columns between the Gomoku board and the side of the window.")
+ "Number of columns between the Gomoku board and the side of the window.")
(defconst gomoku-y-offset 1
- "*Number of lines between the Gomoku board and the top of the window.")
+ "Number of lines between the Gomoku board and the top of the window.")
(defvar gomoku-mode-map
'(("O" . 'gomoku-O)
("X" . 'gomoku-X)
("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X)))
- "*Font lock rules for Gomoku.")
+ "Font lock rules for Gomoku.")
(put 'gomoku-mode 'front-sticky
(put 'gomoku-mode 'rear-nonsticky '(intangible)))
(move-to-column (+ gomoku-x-offset
(* gomoku-square-width (1- gomoku-board-width)))))
-(random t)
-
(provide 'gomoku)
;;; gomoku.el ends here
;; Installation
;;
;; type at your prompt "emacs -l handwrite.el" or put this file on your
-;; Emacs-Lisp load path, add the following into your ~/.emacs startup file
+;; Emacs-Lisp load path, add the following into your init file:
;;
;; (require 'handwrite)
;;
;;; Code:
-(eval-when-compile
- (require 'cl)
- ;; dynamic bondage:
- (defvar baseward-step)
- (defvar fly-step)
- (defvar fly-row-start)
- (defvar pole-width)
- (defvar pole-char)
- (defvar line-offset))
+(eval-when-compile (require 'cl-lib))
+;; dynamic bondage:
+(defvar baseward-step)
+(defvar fly-step)
+(defvar fly-row-start)
+(defvar pole-width)
+(defvar pole-char)
+(defvar line-offset)
(defgroup hanoi nil
"The Towers of Hanoi."
Repent before ring 31 moves."
(interactive)
(let* ((start (ftruncate (float-time)))
- (bits (loop repeat 32
- for x = (/ start (expt 2.0 31)) then (* x 2.0)
- collect (truncate (mod x 2.0))))
+ (bits (cl-loop repeat 32
+ for x = (/ start (expt 2.0 31)) then (* x 2.0)
+ collect (truncate (mod x 2.0))))
(hanoi-move-period 1.0))
(hanoi-internal 32 bits start)))
to be updated."
(interactive)
(let* ((start (ftruncate (float-time)))
- (bits (loop repeat 64
- for x = (/ start (expt 2.0 63)) then (* x 2.0)
- collect (truncate (mod x 2.0))))
+ (bits (cl-loop repeat 64
+ for x = (/ start (expt 2.0 63)) then (* x 2.0)
+ collect (truncate (mod x 2.0))))
(hanoi-move-period 1.0))
(hanoi-internal 64 bits start)))
(setq fly-row-start (1- line-offset))
(setq fly-step line-offset)
(setq baseward-step -1)
- (loop repeat base-len do
- (unless (zerop base-lines)
- (insert-char ?\ (1- base-lines))
- (insert base-char)
- (hanoi-put-face (1- (point)) (point) hanoi-base-face))
- (insert-char ?\ (+ 2 nrings))
- (insert ?\n))
+ (cl-loop repeat base-len do
+ (unless (zerop base-lines)
+ (insert-char ?\ (1- base-lines))
+ (insert base-char)
+ (hanoi-put-face (1- (point)) (point) hanoi-base-face))
+ (insert-char ?\ (+ 2 nrings))
+ (insert ?\n))
(delete-char -1)
- (loop for coord in pole-coords do
- (loop for row from (- coord (/ pole-width 2))
- for start = (+ (* row line-offset) base-lines 1)
- repeat pole-width do
- (subst-char-in-region start (+ start nrings 1)
- ?\ pole-char)
- (hanoi-put-face start (+ start nrings 1)
- hanoi-pole-face))))
+ (dolist (coord pole-coords)
+ (cl-loop for row from (- coord (/ pole-width 2))
+ for start = (+ (* row line-offset) base-lines 1)
+ repeat pole-width do
+ (subst-char-in-region start (+ start nrings 1)
+ ?\ pole-char)
+ (hanoi-put-face start (+ start nrings 1)
+ hanoi-pole-face))))
;; vertical
(setq line-offset (1+ base-len))
(setq fly-step 1)
(setq fly-row-start (point))
(insert-char ?\ base-len)
(insert ?\n)
- (loop repeat (1+ nrings)
- with pole-line =
- (loop with line = (make-string base-len ?\ )
- for coord in pole-coords
- for start = (- coord (/ pole-width 2))
- for end = (+ start pole-width) do
- (hanoi-put-face start end hanoi-pole-face line)
- (loop for i from start below end do
- (aset line i pole-char))
- finally return line)
- do (insert pole-line ?\n))
+ (cl-loop repeat (1+ nrings)
+ with pole-line =
+ (cl-loop with line = (make-string base-len ?\ )
+ for coord in pole-coords
+ for start = (- coord (/ pole-width 2))
+ for end = (+ start pole-width) do
+ (hanoi-put-face start end hanoi-pole-face line)
+ (cl-loop for i from start below end do
+ (aset line i pole-char))
+ finally return line)
+ do (insert pole-line ?\n))
(insert-char base-char base-len)
(hanoi-put-face (- (point) base-len) (point) hanoi-base-face)
(set-window-start (selected-window)
;; the car is the position of the top ring currently on the pole,
;; (or the base of the pole if it is empty).
;; the cdr is in the fly-row just above the pole.
- (poles (loop for coord in pole-coords
- for fly-pos = (+ fly-row-start (* fly-step coord))
- for base = (+ fly-pos (* baseward-step (+ 2 nrings)))
- collect (cons base fly-pos)))
+ (poles
+ (cl-loop for coord in pole-coords
+ for fly-pos = (+ fly-row-start (* fly-step coord))
+ for base = (+ fly-pos (* baseward-step (+ 2 nrings)))
+ collect (cons base fly-pos)))
;; compute the string for each ring and make the list of
;; ring pairs. Each ring pair is initially (str . diameter).
;; Once placed in buffer it is changed to (center-pos . diameter).
(rings
- (loop
- ;; radii are measured from the edge of the pole out.
- ;; So diameter = 2 * radius + pole-width. When
- ;; there's room, we make each ring's radius =
- ;; pole-number + 1. If there isn't room, we step
- ;; evenly from the max radius down to 1.
- with max-radius = (min nrings
- (/ (- max-ring-diameter pole-width) 2))
- for n from (1- nrings) downto 0
- for radius = (1+ (/ (* n max-radius) nrings))
- for diameter = (+ pole-width (* 2 radius))
- with format-str = (format "%%0%dd" pole-width)
- for str = (concat (if vert "<" "^")
- (make-string (1- radius) (if vert ?\- ?\|))
- (format format-str n)
- (make-string (1- radius) (if vert ?\- ?\|))
- (if vert ">" "v"))
- for face =
- (if (eq (logand n 1) 1) ; oddp would require cl at runtime
- hanoi-odd-ring-face hanoi-even-ring-face)
- do (hanoi-put-face 0 (length str) face str)
- collect (cons str diameter)))
+ (cl-loop
+ ;; radii are measured from the edge of the pole out.
+ ;; So diameter = 2 * radius + pole-width. When
+ ;; there's room, we make each ring's radius =
+ ;; pole-number + 1. If there isn't room, we step
+ ;; evenly from the max radius down to 1.
+ with max-radius = (min nrings
+ (/ (- max-ring-diameter pole-width) 2))
+ for n from (1- nrings) downto 0
+ for radius = (1+ (/ (* n max-radius) nrings))
+ for diameter = (+ pole-width (* 2 radius))
+ with format-str = (format "%%0%dd" pole-width)
+ for str = (concat (if vert "<" "^")
+ (make-string (1- radius) (if vert ?\- ?\|))
+ (format format-str n)
+ (make-string (1- radius) (if vert ?\- ?\|))
+ (if vert ">" "v"))
+ for face =
+ (if (eq (logand n 1) 1) ; oddp would require cl at runtime
+ hanoi-odd-ring-face hanoi-even-ring-face)
+ do (hanoi-put-face 0 (length str) face str)
+ collect (cons str diameter)))
;; Disable display of line and column numbers, for speed.
(line-number-mode nil) (column-number-mode nil))
;; do it!
- (hanoi-n bits rings (car poles) (cadr poles) (caddr poles)
+ (hanoi-n bits rings (car poles) (cadr poles) (cl-caddr poles)
start-time))
(message "Done"))
(setq buffer-read-only t)
;; put never-before-placed RING on POLE and update their cars.
(defun hanoi-insert-ring (ring pole)
- (decf (car pole) baseward-step)
+ (cl-decf (car pole) baseward-step)
(let ((str (car ring))
(start (- (car pole) (* (/ (cdr ring) 2) fly-step))))
(setcar ring (car pole))
- (loop for pos upfrom start by fly-step
- for i below (cdr ring) do
- (subst-char-in-region pos (1+ pos) (char-after pos) (aref str i))
- (set-text-properties pos (1+ pos) (text-properties-at i str)))
+ (cl-loop for pos upfrom start by fly-step
+ for i below (cdr ring) do
+ (subst-char-in-region pos (1+ pos) (char-after pos) (aref str i))
+ (set-text-properties pos (1+ pos) (text-properties-at i str)))
(hanoi-goto-char (car pole))))
;; like goto-char, but if position is outside the window, then move to
;; do one pole-to-pole move and update the ring and pole pairs.
(defun hanoi-move-ring (ring from to start-time)
- (incf (car from) baseward-step)
- (decf (car to) baseward-step)
+ (cl-incf (car from) baseward-step)
+ (cl-decf (car to) baseward-step)
(let* ;; We move flywards-steps steps up the pole to the fly row,
;; then fly fly-steps steps across the fly row, then go
;; baseward-steps steps down the new pole.
(/ (- tick flyward-ticks fly-ticks)
ticks-per-pole-step))))))))
(if hanoi-move-period
- (loop for elapsed = (- (float-time) start-time)
- while (< elapsed hanoi-move-period)
- with tick-period = (/ (float hanoi-move-period) total-ticks)
- for tick = (ceiling (/ elapsed tick-period)) do
- (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
- (hanoi-sit-for (- (* tick tick-period) elapsed)))
- (loop for tick from 1 to total-ticks by 2 do
- (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
- (hanoi-sit-for 0)))
+ (cl-loop for elapsed = (- (float-time) start-time)
+ while (< elapsed hanoi-move-period)
+ with tick-period = (/ (float hanoi-move-period) total-ticks)
+ for tick = (ceiling (/ elapsed tick-period)) do
+ (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
+ (hanoi-sit-for (- (* tick tick-period) elapsed)))
+ (cl-loop for tick from 1 to total-ticks by 2 do
+ (hanoi-ring-to-pos ring (funcall tick-to-pos tick))
+ (hanoi-sit-for 0)))
;; Always make last move to keep pole and ring data consistent
(hanoi-ring-to-pos ring (car to))
(if hanoi-move-period (+ start-time hanoi-move-period))))
(let* ((start (- (car ring) (* (/ (cdr ring) 2) fly-step)))
(new-start (- pos (- (car ring) start))))
(if hanoi-horizontal-flag
- (loop for i below (cdr ring)
- for j = (if (< new-start start) i (- (cdr ring) i 1))
- for old-pos = (+ start (* j fly-step))
- for new-pos = (+ new-start (* j fly-step)) do
- (transpose-regions old-pos (1+ old-pos) new-pos (1+ new-pos)))
+ (cl-loop for i below (cdr ring)
+ for j = (if (< new-start start) i (- (cdr ring) i 1))
+ for old-pos = (+ start (* j fly-step))
+ for new-pos = (+ new-start (* j fly-step)) do
+ (transpose-regions old-pos (1+ old-pos)
+ new-pos (1+ new-pos)))
(let ((end (+ start (cdr ring)))
(new-end (+ new-start (cdr ring))))
(if (< (abs (- new-start start)) (- end start))
(curr-char (if on-pole ?\ pole-char))
(face (if on-pole hanoi-pole-face nil)))
(if hanoi-horizontal-flag
- (loop for pos from pole-start below pole-end by line-offset do
- (subst-char-in-region pos (1+ pos) curr-char new-char)
- (hanoi-put-face pos (1+ pos) face))
+ (cl-loop for pos from pole-start below pole-end by line-offset do
+ (subst-char-in-region pos (1+ pos) curr-char new-char)
+ (hanoi-put-face pos (1+ pos) face))
(subst-char-in-region pole-start pole-end curr-char new-char)
(hanoi-put-face pole-start pole-end face))))
(setcar ring pos))
;; concise problem description.
;;;_* Require
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;_* From Gomoku
;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
(defconst landmark-square-width 2
- "*Horizontal spacing between squares on the Landmark board.")
+ "Horizontal spacing between squares on the Landmark board.")
(defconst landmark-square-height 1
- "*Vertical spacing between squares on the Landmark board.")
+ "Vertical spacing between squares on the Landmark board.")
(defconst landmark-x-offset 3
- "*Number of columns between the Landmark board and the side of the window.")
+ "Number of columns between the Landmark board and the side of the window.")
(defconst landmark-y-offset 1
- "*Number of lines between the Landmark board and the top of the window.")
+ "Number of lines between the Landmark board and the top of the window.")
;;;_ + LANDMARK MODE AND KEYMAP.
(defvar landmark-emacs-won ()
- "*For making font-lock use the winner's face for the line.")
+ "For making font-lock use the winner's face for the line.")
(defface landmark-font-lock-face-O '((((class color)) :foreground "red")
(t :weight bold))
("[-|/\\]" 0 (if landmark-emacs-won
'landmark-font-lock-face-O
'landmark-font-lock-face-X)))
- "*Font lock rules for Landmark.")
+ "Font lock rules for Landmark.")
(put 'landmark-mode 'front-sticky
(put 'landmark-mode 'rear-nonsticky '(intangible)))
(put 'z 't-1 (get 'z 't))
(put 'z 't (calc-smell-internal 'landmark-tree))
(if (= (- (get 'z 't) (get 'z 't-1)) 0.0)
- (incf landmark-no-payoff)
+ (cl-incf landmark-no-payoff)
(setf landmark-no-payoff 0)))
(defun landmark-store-old-y_t ()
(landmark-e forward-char)
(landmark-w backward-char)))
(landmark-plot-square (landmark-point-square) 1)
- (incf landmark-number-of-moves)
+ (cl-incf landmark-number-of-moves)
(if landmark-output-moves
(message "Moves made: %d" landmark-number-of-moves)))
; this a worka!
; (eval (cons '+ list))
;;;_ - landmark-set-landmark-signal-strengths ()
-;;; on a screen higher than wide, I noticed that the robot would amble
-;;; left and right and not move forward. examining *landmark-blackbox*
-;;; revealed that there was no scent from the north and south
-;;; landmarks, hence, they need less factoring down of the effect of
-;;; distance on scent.
+;; on a screen higher than wide, I noticed that the robot would amble
+;; left and right and not move forward. examining *landmark-blackbox*
+;; revealed that there was no scent from the north and south
+;; landmarks, hence, they need less factoring down of the effect of
+;; distance on scent.
(defun landmark-set-landmark-signal-strengths ()
(setq landmark-tree-r (* (sqrt (+ (square landmark-cx) (square landmark-cy))) 1.5))
;;;allout-layout: (0 : -1 -1 0)
;;;End:
-(random t)
-
(provide 'landmark)
;;; landmark.el ends here
;; Sadly, mode-line-format won't display numbers.
(defvar life-generation-string nil)
-(defvar life-initialized nil
- "Non-nil if `life' has been run at least once.")
-
;;;###autoload
(defun life (&optional sleeptime)
"Run Conway's Life simulation.
arg non-nil from a program) is the number of seconds to sleep between
generations (this defaults to 1)."
(interactive "p")
- (or life-initialized
- (random t))
- (setq life-initialized t)
(or sleeptime (setq sleeptime 1))
(life-setup)
(catch 'life-exit
:prefix "mpuz-"
:group 'games)
-(random t) ; randomize
-
(defcustom mpuz-silent 'error
"Set this to nil if you want dings on inputs.
The value t means never ding, and `error' means only ding on wrong input."
:group 'mpuz)
(defface mpuz-unsolved
- '((((class color)) (:foreground "red1" :bold t))
- (t (:bold t)))
- "Face to use for letters to be solved."
+ '((default :weight bold)
+ (((class color)) :foreground "red1"))
+ "Face for letters to be solved."
:group 'mpuz)
(defface mpuz-solved
- '((((class color)) (:foreground "green1" :bold t))
- (t (:bold t)))
- "Face to use for solved digits."
+ '((default :weight bold)
+ (((class color)) :foreground "green1"))
+ "Face for solved digits."
:group 'mpuz)
(defface mpuz-trivial
- '((((class color)) (:foreground "blue" :bold t))
- (t (:bold t)))
- "Face to use for trivial digits solved for you."
+ '((default :weight bold)
+ (((class color)) :foreground "blue"))
+ "Face for trivial digits solved for you."
:group 'mpuz)
(defface mpuz-text
- '((t (:inherit variable-pitch)))
- "Face to use for text on right."
+ '((t :inherit variable-pitch))
+ "Face for text on right."
:group 'mpuz)
\f
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'gamegrid)
(defun pong-display-options ()
"Computes display options (required by gamegrid for colors)."
(let ((options (make-vector 256 nil)))
- (loop for c from 0 to 255 do
+ (dotimes (c 256)
(aset options c
- (cond ((= c pong-blank)
- pong-blank-options)
+ (cond ((= c pong-blank)
+ pong-blank-options)
((= c pong-bat)
- pong-bat-options)
+ pong-bat-options)
((= c pong-ball)
- pong-ball-options)
+ pong-ball-options)
((= c pong-border)
- pong-border-options)
+ pong-border-options)
(t
- '(nil nil nil)))))
+ '(nil nil nil)))))
options))
?\s)
(let ((buffer-read-only nil))
- (loop for y from 0 to (1- pong-height) do
- (loop for x from 0 to (1- pong-width) do
- (gamegrid-set-cell x y pong-border)))
- (loop for y from 1 to (- pong-height 2) do
- (loop for x from 1 to (- pong-width 2) do
- (gamegrid-set-cell x y pong-blank))))
-
- (loop for y from pong-bat-player1 to (1- (+ pong-bat-player1 pong-bat-width)) do
- (gamegrid-set-cell 2 y pong-bat))
- (loop for y from pong-bat-player2 to (1- (+ pong-bat-player2 pong-bat-width)) do
- (gamegrid-set-cell (- pong-width 3) y pong-bat)))
+ (dotimes (y pong-height)
+ (dotimes (x pong-width)
+ (gamegrid-set-cell x y pong-border)))
+ (cl-loop for y from 1 to (- pong-height 2) do
+ (cl-loop for x from 1 to (- pong-width 2) do
+ (gamegrid-set-cell x y pong-blank))))
+ (cl-loop for y from pong-bat-player1
+ to (1- (+ pong-bat-player1 pong-bat-width))
+ do (gamegrid-set-cell 2 y pong-bat))
+ (cl-loop for y from pong-bat-player2
+ to (1- (+ pong-bat-player2 pong-bat-width))
+ do (gamegrid-set-cell (- pong-width 3) y pong-bat)))
(defun pong-move-left ()
(defun pong-update-score ()
"Update score and print it on bottom of the game grid."
- (let* ((string (format "Score: %d / %d" pong-score-player1 pong-score-player2))
+ (let* ((string (format "Score: %d / %d"
+ pong-score-player1 pong-score-player2))
(len (length string)))
- (loop for x from 0 to (1- len) do
- (if (string-equal (buffer-name (current-buffer)) pong-buffer-name)
- (gamegrid-set-cell x
- pong-height
- (aref string x))))))
+ (dotimes (x len)
+ (if (string-equal (buffer-name (current-buffer)) pong-buffer-name)
+ (gamegrid-set-cell x pong-height (aref string x))))))
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'gamegrid)
(defun snake-display-options ()
(let ((options (make-vector 256 nil)))
- (loop for c from 0 to 255 do
+ (dotimes (c 256)
(aset options c
(cond ((= c snake-blank)
snake-blank-options)
(defun snake-update-score ()
(let* ((string (format "Score: %05d" snake-score))
(len (length string)))
- (loop for x from 0 to (1- len) do
+ (dotimes (x len)
(gamegrid-set-cell (+ snake-score-x x)
snake-score-y
(aref string x)))))
snake-buffer-height
snake-space)
(let ((buffer-read-only nil))
- (loop for y from 0 to (1- snake-height) do
- (loop for x from 0 to (1- snake-width) do
- (gamegrid-set-cell x y snake-border)))
- (loop for y from 1 to (- snake-height 2) do
- (loop for x from 1 to (- snake-width 2) do
- (gamegrid-set-cell x y snake-blank)))))
+ (dotimes (y snake-height)
+ (dotimes (x snake-width)
+ (gamegrid-set-cell x y snake-border)))
+ (cl-loop for y from 1 to (- snake-height 2) do
+ (cl-loop for x from 1 to (- snake-width 2) do
+ (gamegrid-set-cell x y snake-blank)))))
(defun snake-reset-game ()
(gamegrid-kill-timer)
(dotimes (i snake-length)
(gamegrid-set-cell x y snake-snake)
(setq snake-positions (cons (vector x y) snake-positions))
- (incf x snake-velocity-x)
- (incf y snake-velocity-y)))
+ (cl-incf x snake-velocity-x)
+ (cl-incf y snake-velocity-y)))
(snake-update-score))
(defun snake-update-game (snake-buffer)
(= c snake-snake))
(snake-end-game)
(cond ((= c snake-dot)
- (incf snake-length)
- (incf snake-score)
+ (cl-incf snake-length)
+ (cl-incf snake-score)
(snake-update-score))
(t
(let* ((last-cons (nthcdr (- snake-length 2)
(if (= (% snake-cycle 5) 0)
snake-dot
snake-blank))
- (incf snake-cycle)
+ (cl-incf snake-cycle)
(setcdr last-cons nil))))
(gamegrid-set-cell x y snake-snake)
(setq snake-positions
(setq buffer-read-only t)
(setq solitaire-stones 32)
(solitaire-insert-board)
- (solitaire-build-modeline)
+ (solitaire-build-mode-line)
(goto-char (point-max))
(setq solitaire-center (search-backward "."))
(setq buffer-undo-list (list (point)))))
-(defun solitaire-build-modeline ()
+(defun solitaire-build-mode-line ()
(setq mode-line-format
(list "" "---" 'mode-line-buffer-identification
(if (< 1 solitaire-stones)
(insert ?o)
(goto-char target)
(setq solitaire-stones (1- solitaire-stones))
- (solitaire-build-modeline)
+ (solitaire-build-mode-line)
(if solitaire-auto-eval (solitaire-do-check))))))
(defun solitaire-undo (arg)
(<= (solitaire-current-line) solitaire-end-y)
(setq count (1+ count))))
count)))
- (solitaire-build-modeline)
+ (solitaire-build-mode-line)
(when solitaire-auto-eval (solitaire-do-check)))
(defun solitaire-check ()
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'gamegrid)
(defun tetris-display-options ()
(let ((options (make-vector 256 nil)))
- (loop for c from 0 to 255 do
+ (dotimes (c 256)
(aset options c
(cond ((= c tetris-blank)
- tetris-blank-options)
+ tetris-blank-options)
((and (>= c 0) (<= c 6))
(append
tetris-cell-options
`((((glyph color-x) ,(aref tetris-x-colors c))
(color-tty ,(aref tetris-tty-colors c))
(t nil)))))
- ((= c tetris-border)
- tetris-border-options)
- ((= c tetris-space)
- tetris-space-options)
+ ((= c tetris-border)
+ tetris-border-options)
+ ((= c tetris-space)
+ tetris-space-options)
(t
'(nil nil nil)))))
options))
(let ((strings (vector (format "Shapes: %05d" tetris-n-shapes)
(format "Rows: %05d" tetris-n-rows)
(format "Score: %05d" tetris-score))))
- (loop for y from 0 to 2 do
- (let* ((string (aref strings y))
- (len (length string)))
- (loop for x from 0 to (1- len) do
- (gamegrid-set-cell (+ tetris-score-x x)
- (+ tetris-score-y y)
- (aref string x)))))))
+ (dotimes (y 3)
+ (let* ((string (aref strings y))
+ (len (length string)))
+ (dotimes (x len)
+ (gamegrid-set-cell (+ tetris-score-x x)
+ (+ tetris-score-y y)
+ (aref string x)))))))
(defun tetris-update-score ()
(tetris-draw-score)
(tetris-update-score)))
(defun tetris-draw-next-shape ()
- (loop for x from 0 to 3 do
- (loop for y from 0 to 3 do
- (gamegrid-set-cell (+ tetris-next-x x)
- (+ tetris-next-y y)
- tetris-blank)))
- (loop for i from 0 to 3 do
- (let ((tetris-shape tetris-next-shape)
- (tetris-rot 0))
- (gamegrid-set-cell (+ tetris-next-x
- (aref (tetris-get-shape-cell i) 0))
- (+ tetris-next-y
- (aref (tetris-get-shape-cell i) 1))
- tetris-shape))))
+ (dotimes (x 4)
+ (dotimes (y 4)
+ (gamegrid-set-cell (+ tetris-next-x x)
+ (+ tetris-next-y y)
+ tetris-blank)))
+ (dotimes (i 4)
+ (let ((tetris-shape tetris-next-shape)
+ (tetris-rot 0))
+ (gamegrid-set-cell (+ tetris-next-x
+ (aref (tetris-get-shape-cell i) 0))
+ (+ tetris-next-y
+ (aref (tetris-get-shape-cell i) 1))
+ tetris-shape))))
(defun tetris-draw-shape ()
- (loop for i from 0 to 3 do
- (let ((c (tetris-get-shape-cell i)))
- (gamegrid-set-cell (+ tetris-top-left-x
- tetris-pos-x
- (aref c 0))
- (+ tetris-top-left-y
- tetris-pos-y
- (aref c 1))
- tetris-shape))))
+ (dotimes (i 4)
+ (let ((c (tetris-get-shape-cell i)))
+ (gamegrid-set-cell (+ tetris-top-left-x
+ tetris-pos-x
+ (aref c 0))
+ (+ tetris-top-left-y
+ tetris-pos-y
+ (aref c 1))
+ tetris-shape))))
(defun tetris-erase-shape ()
- (loop for i from 0 to 3 do
- (let ((c (tetris-get-shape-cell i)))
- (gamegrid-set-cell (+ tetris-top-left-x
- tetris-pos-x
- (aref c 0))
- (+ tetris-top-left-y
- tetris-pos-y
- (aref c 1))
- tetris-blank))))
+ (dotimes (i 4)
+ (let ((c (tetris-get-shape-cell i)))
+ (gamegrid-set-cell (+ tetris-top-left-x
+ tetris-pos-x
+ (aref c 0))
+ (+ tetris-top-left-y
+ tetris-pos-y
+ (aref c 1))
+ tetris-blank))))
(defun tetris-test-shape ()
(let ((hit nil))
- (loop for i from 0 to 3 do
- (unless hit
- (setq hit
- (let* ((c (tetris-get-shape-cell i))
- (xx (+ tetris-pos-x
- (aref c 0)))
- (yy (+ tetris-pos-y
- (aref c 1))))
- (or (>= xx tetris-width)
- (>= yy tetris-height)
- (/= (gamegrid-get-cell
- (+ xx tetris-top-left-x)
- (+ yy tetris-top-left-y))
- tetris-blank))))))
+ (dotimes (i 4)
+ (unless hit
+ (setq hit
+ (let* ((c (tetris-get-shape-cell i))
+ (xx (+ tetris-pos-x
+ (aref c 0)))
+ (yy (+ tetris-pos-y
+ (aref c 1))))
+ (or (>= xx tetris-width)
+ (>= yy tetris-height)
+ (/= (gamegrid-get-cell
+ (+ xx tetris-top-left-x)
+ (+ yy tetris-top-left-y))
+ tetris-blank))))))
hit))
(defun tetris-full-row (y)
(let ((full t))
- (loop for x from 0 to (1- tetris-width) do
- (if (= (gamegrid-get-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y))
- tetris-blank)
- (setq full nil)))
+ (dotimes (x tetris-width)
+ (if (= (gamegrid-get-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y))
+ tetris-blank)
+ (setq full nil)))
full))
(defun tetris-shift-row (y)
(if (= y 0)
- (loop for x from 0 to (1- tetris-width) do
+ (dotimes (x tetris-width)
(gamegrid-set-cell (+ tetris-top-left-x x)
(+ tetris-top-left-y y)
tetris-blank))
- (loop for x from 0 to (1- tetris-width) do
- (let ((c (gamegrid-get-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y -1))))
- (gamegrid-set-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y)
+ (dotimes (x tetris-width)
+ (let ((c (gamegrid-get-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y -1))))
+ (gamegrid-set-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y)
c)))))
(defun tetris-shift-down ()
- (loop for y0 from 0 to (1- tetris-height) do
- (if (tetris-full-row y0)
- (progn (setq tetris-n-rows (1+ tetris-n-rows))
- (loop for y from y0 downto 0 do
- (tetris-shift-row y))))))
+ (dotimes (y0 tetris-height)
+ (when (tetris-full-row y0)
+ (setq tetris-n-rows (1+ tetris-n-rows))
+ (cl-loop for y from y0 downto 0 do
+ (tetris-shift-row y)))))
(defun tetris-draw-border-p ()
(or (not (eq gamegrid-display-mode 'glyph))
tetris-space)
(let ((buffer-read-only nil))
(if (tetris-draw-border-p)
- (loop for y from -1 to tetris-height do
- (loop for x from -1 to tetris-width do
- (gamegrid-set-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y)
- tetris-border))))
- (loop for y from 0 to (1- tetris-height) do
- (loop for x from 0 to (1- tetris-width) do
- (gamegrid-set-cell (+ tetris-top-left-x x)
- (+ tetris-top-left-y y)
- tetris-blank)))
+ (cl-loop for y from -1 to tetris-height do
+ (cl-loop for x from -1 to tetris-width do
+ (gamegrid-set-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y)
+ tetris-border))))
+ (dotimes (y tetris-height)
+ (dotimes (x tetris-width)
+ (gamegrid-set-cell (+ tetris-top-left-x x)
+ (+ tetris-top-left-y y)
+ tetris-blank)))
(if (tetris-draw-border-p)
- (loop for y from -1 to 4 do
- (loop for x from -1 to 4 do
- (gamegrid-set-cell (+ tetris-next-x x)
- (+ tetris-next-y y)
- tetris-border))))))
+ (cl-loop for y from -1 to 4 do
+ (cl-loop for x from -1 to 4 do
+ (gamegrid-set-cell (+ tetris-next-x x)
+ (+ tetris-next-y y)
+ tetris-border))))))
(defun tetris-reset-game ()
(gamegrid-kill-timer)
(tetris-mode)
(tetris-start-game))
-(random t)
-
(provide 'tetris)
;;; tetris.el ends here
;;; yow.el --- quote random zippyisms
-;; Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Author: Richard Mlynarik
;;; Commentary:
;; Important pinheadery for GNU Emacs.
-;;
-;; See cookie1.el for implementation. Note --- the `n' argument of yow
-;; from the 18.xx implementation is no longer; we only support *random*
-;; random access now.
;;; Code:
:prefix "yow-"
:group 'games)
-(defcustom yow-file (concat data-directory "yow.lines")
+(defcustom yow-file (expand-file-name "yow.lines" data-directory)
"File containing pertinent pinhead phrases."
:type 'file
:group 'yow)
;;; zone.el --- idle display hacks
-;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Victor Zandy <zandy@cs.wisc.edu>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
;; Bored by the zone pyrotechnics? Write your own! Add it to
;; `zone-programs'. See `zone-call' for higher-ordered zoning.
-;; WARNING: Not appropriate for Emacs sessions over modems or
-;; computers as slow as mine.
-
;; THANKS: Christopher Mayer, Scott Flinchbaugh,
;; Rachel Kalmar, Max Froumentin, Juri Linkov,
;; Luigi Panzeri, John Paul Wallington.
"The timer we use to decide when to zone out, or nil if none.")
(defvar zone-timeout nil
- "*Seconds to timeout the zoning.
+ "Seconds to timeout the zoning.
If nil, don't interrupt for about 1^26 seconds.")
;; Vector of functions that zone out. `zone' will execute one of
`(with-current-buffer (get 'zone 'orig-buffer)
,@body))
-(defmacro zone-hiding-modeline (&rest body)
+(defmacro zone-hiding-mode-line (&rest body)
;; This formerly worked by temporarily altering face `mode-line',
;; which did not even work right, it seems.
`(let (mode-line-format)
(wp (1+ (- (window-point (selected-window))
(window-start)))))
(put 'zone 'orig-buffer (current-buffer))
- (put 'zone 'modeline-hidden-level 0)
(switch-to-buffer outbuf)
(setq mode-name "Zone")
(erase-buffer)
(setq ok (zerop (forward-line 1))
lines (cons (buffer-substring p (point)) lines))))
(sit-for 5)
- (zone-hiding-modeline
+ (zone-hiding-mode-line
(let ((msg "Zoning... (zone-pgm-stress)"))
(while (not (string= msg ""))
(message (setq msg (substring msg 1)))
(when (< 50 (random 100))
(goto-char (point-max))
(forward-line -1)
- (let ((kill-whole-line t))
- (kill-line))
+ (delete-region (point) (line-beginning-position 2))
(goto-char (point-min))
(insert (nth (random (length lines)) lines)))
(message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr"))
(defun zone-pgm-stress-destress ()
(zone-call 'zone-pgm-stress 25)
- (zone-hiding-modeline
+ (zone-hiding-mode-line
(sit-for 3)
(erase-buffer)
(sit-for 3)
;;;; the lyfe so short the craft so long to lerne --chaucer
(defvar zone-pgm-random-life-wait nil
- "*Seconds to wait between successive `life' generations.
+ "Seconds to wait between successive `life' generations.
If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
(defvar life-patterns) ; from life.el
(kill-buffer nil))))
-(random t)
-
;;;;;;;;;;;;;;;
(provide 'zone)
;;
;; One way to set variables is by calling `pr-customize', customize all
;; variables and save the customization by future sessions (see Options
-;; section). Other way is by coding your settings on Emacs init file (that is,
-;; ~/.emacs file), see below for a first setting template that it should be
-;; inserted on your ~/.emacs file (or c:/_emacs, if you're using Windows 9x/NT
-;; or MS-DOS):
+;; section). Other way is by adding code to your init file; see below
+;; for a first setting template that it should be inserted on your
+;; init file:
;;
;; * Example of setting for Windows system:
;;
;; Using `printing'
;; ----------------
;;
-;; To use `printing' insert in your ~/.emacs file (or c:/_emacs, if you're
-;; using Windows 9x/NT or MS-DOS):
+;; To use `printing' insert in your init file:
;;
;; (require 'printing)
;; ;; ...some user settings...
`http://bama.ua.edu/cgi-bin/man-cgi?lp'
`http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp'
-* GNU utilities for Win32 (cp.exe)
+* GNU utilities for w32 (cp.exe)
`http://unxutils.sourceforge.net/'
"
:type '(repeat
;; listed. See `proced-mode' for getting started.
;;
;; To do:
-;; - interactive temporary customizability of flags in `proced-grammar-alist'
-;; - allow "sudo kill PID", "renice PID"
+;; - Interactive temporary customizability of flags in `proced-grammar-alist'
+;; - Allow "sudo kill PID", "sudo renice PID"
+;; `proced-send-signal' operates on multiple processes one by one.
+;; With "sudo" we want to execute one "kill" or "renice" command
+;; for all marked processes. Is there a `sudo-call-process'?
;;
;; Thoughts and Ideas
;; - Currently, `process-attributes' returns the list of
:type '(choice (function :tag "function")
(string :tag "command")))
+(defcustom proced-renice-command "renice"
+ "Name of renice command."
+ :group 'proced
+ :type '(string :tag "command"))
+
(defcustom proced-signal-list
'( ;; signals supported on all POSIX compliant systems
("HUP" . " (1. Hangup)")
(define-key km "o" 'proced-omit-processes)
(define-key km "x" 'proced-send-signal) ; Dired compatibility
(define-key km "k" 'proced-send-signal) ; kill processes
+ (define-key km "r" 'proced-renice) ; renice processes
;; misc
(define-key km "h" 'describe-mode)
(define-key km "?" 'proced-help)
:style toggle
:selected (eval proced-auto-update-flag)
:help "Auto Update of Proced Buffer"]
+ "--"
["Send signal" proced-send-signal
- :help "Send Signal to Marked Processes"]))
+ :help "Send Signal to Marked Processes"]
+ ["Renice" proced-renice
+ :help "Renice Marked Processes"]))
;; helper functions
(defun proced-marker-regexp ()
;;;###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'.
+\\<proced-mode-map>
+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"))
(defun proced-time-lessp (t1 t2)
"Return t if time value T1 is less than time value T2.
Return `equal' if T1 equals T2. Return nil otherwise."
- (with-decoded-time-value ((high1 low1 micro1 t1)
- (high2 low2 micro2 t2))
+ (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1)
+ (high2 low2 micro2 pico2 type2 t2))
(cond ((< high1 high2))
((< high2 high1) nil)
((< low1 low2))
((< low2 low1) nil)
((< micro1 micro2))
((< micro2 micro1) nil)
+ ((< pico1 pico2))
+ ((< pico2 pico1) nil)
(t 'equal))))
;;; Sorting
(goto-char new-pos)
(goto-char (point-min))
(proced-move-to-goal-column)))
- ;; update modeline
- ;; Does the long `mode-name' clutter the modeline? It would be nice
+ ;; update mode line
+ ;; Does the long `mode-name' clutter the mode line? It would be nice
;; to have some other location for displaying the values of the various
;; flags that affect the behavior of proced (flags one might want
;; to change on the fly). Where??
Preserves point and marks."
(proced-update t))
-(defun proced-send-signal (&optional signal)
- "Send a SIGNAL to the marked processes.
-If no process is marked, operate on current process.
-SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
-If SIGNAL is nil display marked processes and query interactively for SIGNAL.
-After sending the signal, this command runs the normal hook
-`proced-after-send-signal-hook'."
- (interactive)
+(defun proced-marked-processes ()
+ "Return marked processes as alist of PIDs.
+If no process is marked return alist with the PID of the process point is on.
+The cdrs of the alist are the text strings displayed by Proced for these
+processes. They are used for error messages."
(let ((regexp (proced-marker-regexp))
process-alist)
;; collect marked processes
(+ 2 (line-beginning-position))
(line-end-position)))
process-alist)))
- (setq process-alist
- (if process-alist
- (nreverse process-alist)
- ;; take current process
- (list (cons (proced-pid-at-point)
+ (if process-alist
+ (nreverse process-alist)
+ ;; take current process
+ (let ((pid (proced-pid-at-point)))
+ (if pid
+ (list (cons pid
(buffer-substring-no-properties
(+ 2 (line-beginning-position))
- (line-end-position))))))
+ (line-end-position)))))))))
+
+(defmacro proced-with-processes-buffer (process-alist &rest body)
+ "Execute the forms in BODY in a temporary buffer displaying PROCESS-ALIST.
+PROCESS-ALIST is an alist of process PIDs as in `proced-process-alist'.
+The value returned is the value of the last form in BODY."
+ (declare (indent 1) (debug t))
+ ;; Use leading space in buffer name to make this buffer ephemeral
+ `(let ((bufname " *Marked Processes*")
+ (header-line (substring-no-properties proced-header-line)))
+ (with-current-buffer (get-buffer-create bufname)
+ (setq truncate-lines t
+ proced-header-line header-line ; inherit header line
+ header-line-format '(:eval (proced-header-line)))
+ (add-hook 'post-command-hook 'force-mode-line-update nil t)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (setq buffer-read-only t)
+ (dolist (process ,process-alist)
+ (insert " " (cdr process) "\n"))
+ (delete-char -1)
+ (goto-char (point-min)))
+ (save-window-excursion
+ ;; Analogous to `dired-pop-to-buffer'
+ ;; Don't split window horizontally. (Bug#1806)
+ (let (split-width-threshold)
+ (pop-to-buffer (current-buffer)))
+ (fit-window-to-buffer (get-buffer-window) nil 1)
+ ,@body))))
+
+(defun proced-send-signal (&optional signal process-alist)
+ "Send a SIGNAL to processes in PROCESS-ALIST.
+PROCESS-ALIST is an alist as returned by `proced-marked-processes'.
+Interactively, PROCESS-ALIST contains the marked processes.
+If no process is marked, it contains the process point is on,
+SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
+After sending SIGNAL to all processes in PROCESS-ALIST, this command
+runs the normal hook `proced-after-send-signal-hook'.
+
+For backward compatibility SIGNAL and PROCESS-ALIST may be nil.
+Then PROCESS-ALIST contains the marked processes or the process point is on
+and SIGNAL is queried interactively. This noninteractive usage is still
+supported but discouraged. It will be removed in a future version of Emacs."
+ (interactive
+ (let* ((process-alist (proced-marked-processes))
+ (pnum (if (= 1 (length process-alist))
+ "1 process"
+ (format "%d processes" (length process-alist))))
+ (completion-ignore-case t)
+ (completion-extra-properties
+ '(:annotation-function
+ (lambda (s) (cdr (assoc s proced-signal-list))))))
+ (proced-with-processes-buffer process-alist
+ (list (completing-read (concat "Send signal [" pnum
+ "] (default TERM): ")
+ proced-signal-list
+ nil nil nil nil "TERM")
+ process-alist))))
+
+ (unless (and signal process-alist)
+ ;; Discouraged usge (supported for backward compatibility):
+ ;; The new calling sequence separates more cleanly between the parts
+ ;; of the code required for interactive and noninteractive calls so that
+ ;; the command can be used more flexibly in noninteractive ways, too.
+ (unless (get 'proced-send-signal 'proced-outdated)
+ (put 'proced-send-signal 'proced-outdated t)
+ (message "Outdated usage of `proced-send-signal'")
+ (sit-for 2))
+ (setq process-alist (proced-marked-processes))
(unless signal
- ;; Display marked processes (code taken from `dired-mark-pop-up').
- (let ((bufname " *Marked Processes*") ; use leading space in buffer name
- ; to make this buffer ephemeral
- (header-line (substring-no-properties proced-header-line)))
- (with-current-buffer (get-buffer-create bufname)
- (setq truncate-lines t
- proced-header-line header-line ; inherit header line
- header-line-format '(:eval (proced-header-line)))
- (add-hook 'post-command-hook 'force-mode-line-update nil t)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (buffer-disable-undo)
- (setq buffer-read-only t)
- (dolist (process process-alist)
- (insert " " (cdr process) "\n"))
- (delete-char -1)
- (goto-char (point-min)))
- (save-window-excursion
- ;; Analogous to `dired-pop-to-buffer'
- ;; Don't split window horizontally. (Bug#1806)
- (let (split-width-threshold)
- (pop-to-buffer (current-buffer)))
- (fit-window-to-buffer (get-buffer-window) nil 1)
- (let* ((completion-ignore-case t)
- (pnum (if (= 1 (length process-alist))
- "1 process"
- (format "%d processes" (length process-alist))))
- (completion-extra-properties
- '(:annotation-function
- (lambda (s) (cdr (assoc s proced-signal-list))))))
- (setq signal
- (completing-read (concat "Send signal [" pnum
- "] (default TERM): ")
- proced-signal-list
- nil nil nil nil "TERM")))))))
- ;; send signal
- (let ((count 0)
- failures)
- ;; Why not always use `signal-process'? See
- ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html
- (if (functionp proced-signal-function)
- ;; use built-in `signal-process'
- (let ((signal (if (stringp signal)
- (if (string-match "\\`[0-9]+\\'" signal)
- (string-to-number signal)
- (make-symbol signal))
- signal))) ; number
- (dolist (process process-alist)
- (condition-case err
- (if (zerop (funcall
- proced-signal-function (car process) signal))
- (setq count (1+ count))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures))
- (error ; catch errors from failed signals
- (proced-log "%s\n" err)
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures)))))
- ;; use external system call
- (let ((signal (concat "-" (if (numberp signal)
- (number-to-string signal) signal))))
+ (let ((pnum (if (= 1 (length process-alist))
+ "1 process"
+ (format "%d processes" (length process-alist))))
+ (completion-ignore-case t)
+ (completion-extra-properties
+ '(:annotation-function
+ (lambda (s) (cdr (assoc s proced-signal-list))))))
+ (proced-with-processes-buffer process-alist
+ (setq signal (completing-read (concat "Send signal [" pnum
+ "] (default TERM): ")
+ proced-signal-list
+ nil nil nil nil "TERM"))))))
+
+ (let (failures)
+ ;; Why not always use `signal-process'? See
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html
+ (if (functionp proced-signal-function)
+ ;; use built-in `signal-process'
+ (let ((signal (if (stringp signal)
+ (if (string-match "\\`[0-9]+\\'" signal)
+ (string-to-number signal)
+ (make-symbol signal))
+ signal))) ; number
(dolist (process process-alist)
- (with-temp-buffer
- (condition-case nil
- (if (zerop (call-process
- proced-signal-function nil t nil
- signal (number-to-string (car process))))
- (setq count (1+ count))
- (proced-log (current-buffer))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures))
- (error ; catch errors from failed signals
- (proced-log (current-buffer))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures)))))))
- (if failures
- ;; Proced error message are not always very precise.
- ;; Can we issue a useful one-line summary in the
- ;; message area (using FAILURES) if only one signal failed?
- (proced-log-summary
- signal
- (format "%d of %d signal%s failed"
- (length failures) (length process-alist)
- (if (= 1 (length process-alist)) "" "s")))
- (proced-success-message "Sent signal to" count)))
- ;; final clean-up
- (run-hooks 'proced-after-send-signal-hook)))
+ (condition-case err
+ (unless (zerop (funcall
+ proced-signal-function (car process) signal))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed signals
+ (proced-log "%s\n" err)
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))
+ ;; use external system call
+ (let ((signal (format "-%s" signal)))
+ (dolist (process process-alist)
+ (with-temp-buffer
+ (condition-case nil
+ (unless (zerop (call-process
+ proced-signal-function nil t nil
+ signal (number-to-string (car process))))
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed signals
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))))
+ (if failures
+ ;; Proced error message are not always very precise.
+ ;; Can we issue a useful one-line summary in the
+ ;; message area (using FAILURES) if only one signal failed?
+ (proced-log-summary
+ (format "Signal %s" signal)
+ (format "%d of %d signal%s failed"
+ (length failures) (length process-alist)
+ (if (= 1 (length process-alist)) "" "s")))
+ (proced-success-message "Sent signal to" (length process-alist))))
+ ;; final clean-up
+ (run-hooks 'proced-after-send-signal-hook))
+
+(defun proced-renice (priority process-alist)
+ "Renice the processes in PROCESS-ALIST to PRIORITY.
+PROCESS-ALIST is an alist as returned by `proced-marked-processes'.
+Interactively, PROCESS-ALIST contains the marked processes.
+If no process is marked, it contains the process point is on,
+After renicing all processes in PROCESS-ALIST, this command runs
+the normal hook `proced-after-send-signal-hook'."
+ (interactive
+ (let ((process-alist (proced-marked-processes)))
+ (proced-with-processes-buffer process-alist
+ (list (read-number "New priority: ")
+ process-alist))))
+ (if (numberp priority)
+ (setq priority (number-to-string priority)))
+ (let (failures)
+ (dolist (process process-alist)
+ (with-temp-buffer
+ (condition-case nil
+ (unless (zerop (call-process
+ proced-renice-command nil t nil
+ priority (number-to-string (car process))))
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed renice
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))
+ (if failures
+ (proced-log-summary
+ (format "Renice %s" priority)
+ (format "%d of %d renice%s failed"
+ (length failures) (length process-alist)
+ (if (= 1 (length process-alist)) "" "s")))
+ (proced-success-message "Reniced" (length process-alist))))
+ ;; final clean-up
+ (run-hooks 'proced-after-send-signal-hook))
;; similar to `dired-why'
(defun proced-why ()
--- /dev/null
+;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Tomohiro Matsuyama <tomo@cx4a.org>
+;; Keywords: lisp
+
+;; 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
+;; (at your option) 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib))
+
+(defgroup profiler nil
+ "Emacs profiler."
+ :group 'lisp
+ :prefix "profiler-")
+
+(defcustom profiler-sample-interval 1
+ "Default sample interval in millisecond."
+ :type 'integer
+ :group 'profiler)
+
+;;; Utilities
+
+(defun profiler-ensure-string (object)
+ (cond ((stringp object)
+ object)
+ ((symbolp object)
+ (symbol-name object))
+ ((numberp object)
+ (number-to-string object))
+ (t
+ (format "%s" object))))
+
+(defun profiler-format (fmt &rest args)
+ (cl-loop for (width align subfmt) in fmt
+ for arg in args
+ for str = (cond
+ ((consp subfmt)
+ (apply 'profiler-format subfmt arg))
+ ((stringp subfmt)
+ (format subfmt arg))
+ ((and (symbolp subfmt)
+ (fboundp subfmt))
+ (funcall subfmt arg))
+ (t
+ (profiler-ensure-string arg)))
+ for len = (length str)
+ if (< width len)
+ collect (substring str 0 width) into frags
+ else
+ collect
+ (let ((padding (make-string (- width len) ?\s)))
+ (cl-ecase align
+ (left (concat str padding))
+ (right (concat padding str))))
+ into frags
+ finally return (apply #'concat frags)))
+
+(defun profiler-format-percent (number divisor)
+ (concat (number-to-string (/ (* number 100) divisor)) "%"))
+
+(defun profiler-format-nbytes (nbytes)
+ "Format NBYTES in humarn readable string."
+ (if (and (integerp nbytes) (> nbytes 0))
+ (cl-loop with i = (% (1+ (floor (log10 nbytes))) 3)
+ for c in (append (number-to-string nbytes) nil)
+ if (= i 0)
+ collect ?, into s
+ and do (setq i 3)
+ collect c into s
+ do (cl-decf i)
+ finally return
+ (apply 'string (if (eq (car s) ?,) (cdr s) s)))
+ (profiler-ensure-string nbytes)))
+
+\f
+;;; Entries
+
+(defun profiler-entry-format (entry)
+ "Format ENTRY in human readable string. ENTRY would be a
+function name of a function itself."
+ (cond ((memq (car-safe entry) '(closure lambda))
+ (format "#<lambda 0x%x>" (sxhash entry)))
+ ((byte-code-function-p entry)
+ (format "#<compiled 0x%x>" (sxhash entry)))
+ ((or (subrp entry) (symbolp entry) (stringp entry))
+ (format "%s" entry))
+ (t
+ (format "#<unknown 0x%x>" (sxhash entry)))))
+
+;;; Log data structure
+
+;; The C code returns the log in the form of a hash-table where the keys are
+;; vectors (of size profiler-max-stack-depth, holding truncated
+;; backtraces, where the first element is the top of the stack) and
+;; the values are integers (which count how many times this backtrace
+;; has been seen, multiplied by a "weight factor" which is either the
+;; sample-interval or the memory being allocated).
+;; We extend it by adding a few other entries to the hash-table, most notably:
+;; - Key `type' has a value indicating the kind of log (`memory' or `cpu').
+;; - Key `timestamp' has a value giving the time when the log was obtained.
+;; - Key `diff-p' indicates if this log represents a diff between two logs.
+
+(defun profiler-log-timestamp (log) (gethash 'timestamp log))
+(defun profiler-log-type (log) (gethash 'type log))
+(defun profiler-log-diff-p (log) (gethash 'diff-p log))
+
+(defun profiler-log-diff (log1 log2)
+ "Compare LOG1 with LOG2 and return a diff log. Both logs must
+be same type."
+ (unless (eq (profiler-log-type log1)
+ (profiler-log-type log2))
+ (error "Can't compare different type of logs"))
+ (let ((newlog (make-hash-table :test 'equal)))
+ ;; Make a copy of `log1' into `newlog'.
+ (maphash (lambda (backtrace count) (puthash backtrace count newlog))
+ log1)
+ (puthash 'diff-p t newlog)
+ (maphash (lambda (backtrace count)
+ (when (vectorp backtrace)
+ (puthash backtrace (- (gethash backtrace log1 0) count)
+ newlog)))
+ log2)
+ newlog))
+
+(defun profiler-log-fixup-entry (entry)
+ (if (symbolp entry)
+ entry
+ (profiler-entry-format entry)))
+
+(defun profiler-log-fixup-backtrace (backtrace)
+ (mapcar 'profiler-log-fixup-entry backtrace))
+
+(defun profiler-log-fixup (log)
+ "Fixup LOG so that the log could be serialized into file."
+ (let ((newlog (make-hash-table :test 'equal)))
+ (maphash (lambda (backtrace count)
+ (puthash (if (not (vectorp backtrace))
+ backtrace
+ (profiler-log-fixup-backtrace backtrace))
+ count newlog))
+ log)
+ newlog))
+
+(defun profiler-log-write-file (log filename &optional confirm)
+ "Write LOG into FILENAME."
+ (with-temp-buffer
+ (let (print-level print-length)
+ (print (profiler-log-fixup log) (current-buffer)))
+ (write-file filename confirm)))
+
+(defun profiler-log-read-file (filename)
+ "Read log from FILENAME."
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (read (current-buffer))))
+
+\f
+;;; Calltree data structure
+
+(cl-defstruct (profiler-calltree (:constructor profiler-make-calltree))
+ entry
+ (count 0) (count-percent "")
+ parent children)
+
+(defun profiler-calltree-leaf-p (tree)
+ (null (profiler-calltree-children tree)))
+
+(defun profiler-calltree-count< (a b)
+ (cond ((eq (profiler-calltree-entry a) t) t)
+ ((eq (profiler-calltree-entry b) t) nil)
+ (t (< (profiler-calltree-count a)
+ (profiler-calltree-count b)))))
+
+(defun profiler-calltree-count> (a b)
+ (not (profiler-calltree-count< a b)))
+
+(defun profiler-calltree-depth (tree)
+ (let ((parent (profiler-calltree-parent tree)))
+ (if (null parent)
+ 0
+ (1+ (profiler-calltree-depth parent)))))
+
+(defun profiler-calltree-find (tree entry)
+ "Return a child tree of ENTRY under TREE."
+ ;; OPTIMIZED
+ (let (result (children (profiler-calltree-children tree)))
+ ;; FIXME: Use `assoc'.
+ (while (and children (null result))
+ (let ((child (car children)))
+ (when (equal (profiler-calltree-entry child) entry)
+ (setq result child))
+ (setq children (cdr children))))
+ result))
+
+(defun profiler-calltree-walk (calltree function)
+ (funcall function calltree)
+ (dolist (child (profiler-calltree-children calltree))
+ (profiler-calltree-walk child function)))
+
+(defun profiler-calltree-build-1 (tree log &optional reverse)
+ ;; FIXME: Do a better job of reconstructing a complete call-tree
+ ;; when the backtraces have been truncated. Ideally, we should be
+ ;; able to reduce profiler-max-stack-depth to 3 or 4 and still
+ ;; get a meaningful call-tree.
+ (maphash
+ (lambda (backtrace count)
+ (when (vectorp backtrace)
+ (let ((node tree)
+ (max (length backtrace)))
+ (dotimes (i max)
+ (let ((entry (aref backtrace (if reverse i (- max i 1)))))
+ (when entry
+ (let ((child (profiler-calltree-find node entry)))
+ (unless child
+ (setq child (profiler-make-calltree
+ :entry entry :parent node))
+ (push child (profiler-calltree-children node)))
+ (cl-incf (profiler-calltree-count child) count)
+ (setq node child))))))))
+ log))
+
+(defun profiler-calltree-compute-percentages (tree)
+ (let ((total-count 0))
+ ;; FIXME: the memory profiler's total wraps around all too easily!
+ (dolist (child (profiler-calltree-children tree))
+ (cl-incf total-count (profiler-calltree-count child)))
+ (unless (zerop total-count)
+ (profiler-calltree-walk
+ tree (lambda (node)
+ (setf (profiler-calltree-count-percent node)
+ (profiler-format-percent (profiler-calltree-count node)
+ total-count)))))))
+
+(cl-defun profiler-calltree-build (log &key reverse)
+ (let ((tree (profiler-make-calltree)))
+ (profiler-calltree-build-1 tree log reverse)
+ (profiler-calltree-compute-percentages tree)
+ tree))
+
+(defun profiler-calltree-sort (tree predicate)
+ (let ((children (profiler-calltree-children tree)))
+ (setf (profiler-calltree-children tree) (sort children predicate))
+ (dolist (child (profiler-calltree-children tree))
+ (profiler-calltree-sort child predicate))))
+
+\f
+;;; Report rendering
+
+(defcustom profiler-report-closed-mark "+"
+ "An indicator of closed calltrees."
+ :type 'string
+ :group 'profiler)
+
+(defcustom profiler-report-open-mark "-"
+ "An indicator of open calltrees."
+ :type 'string
+ :group 'profiler)
+
+(defcustom profiler-report-leaf-mark " "
+ "An indicator of calltree leaves."
+ :type 'string
+ :group 'profiler)
+
+(defvar profiler-report-sample-line-format
+ '((60 left)
+ (14 right ((9 right)
+ (5 right)))))
+
+(defvar profiler-report-memory-line-format
+ '((55 left)
+ (19 right ((14 right profiler-format-nbytes)
+ (5 right)))))
+
+(defvar-local profiler-report-log nil
+ "The current profiler log.")
+
+(defvar-local profiler-report-reversed nil
+ "True if calltree is rendered in bottom-up. Do not touch this
+variable directly.")
+
+(defvar-local profiler-report-order nil
+ "The value can be `ascending' or `descending'. Do not touch
+this variable directly.")
+
+(defun profiler-report-make-entry-part (entry)
+ (let ((string (cond
+ ((eq entry t)
+ "Others")
+ ((and (symbolp entry)
+ (fboundp entry))
+ (propertize (symbol-name entry)
+ 'face 'link
+ 'mouse-face 'highlight
+ 'help-echo "mouse-2 or RET jumps to definition"))
+ (t
+ (profiler-entry-format entry)))))
+ (propertize string 'profiler-entry entry)))
+
+(defun profiler-report-make-name-part (tree)
+ (let* ((entry (profiler-calltree-entry tree))
+ (depth (profiler-calltree-depth tree))
+ (indent (make-string (* (1- depth) 2) ?\s))
+ (mark (if (profiler-calltree-leaf-p tree)
+ profiler-report-leaf-mark
+ profiler-report-closed-mark))
+ (entry (profiler-report-make-entry-part entry)))
+ (format "%s%s %s" indent mark entry)))
+
+(defun profiler-report-header-line-format (fmt &rest args)
+ (let* ((header (apply 'profiler-format fmt args))
+ (escaped (replace-regexp-in-string "%" "%%" header)))
+ (concat " " escaped)))
+
+(defun profiler-report-line-format (tree)
+ (let ((diff-p (profiler-log-diff-p profiler-report-log))
+ (name-part (profiler-report-make-name-part tree))
+ (count (profiler-calltree-count tree))
+ (count-percent (profiler-calltree-count-percent tree)))
+ (profiler-format (cl-ecase (profiler-log-type profiler-report-log)
+ (cpu profiler-report-sample-line-format)
+ (memory profiler-report-memory-line-format))
+ name-part
+ (if diff-p
+ (list (if (> count 0)
+ (format "+%s" count)
+ count)
+ "")
+ (list count count-percent)))))
+
+(defun profiler-report-insert-calltree (tree)
+ (let ((line (profiler-report-line-format tree)))
+ (insert (propertize (concat line "\n") 'calltree tree))))
+
+(defun profiler-report-insert-calltree-children (tree)
+ (mapc 'profiler-report-insert-calltree
+ (profiler-calltree-children tree)))
+
+\f
+;;; Report mode
+
+(defvar profiler-report-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; FIXME: Add menu.
+ (define-key map "n" 'profiler-report-next-entry)
+ (define-key map "p" 'profiler-report-previous-entry)
+ ;; I find it annoying more than helpful to not be able to navigate
+ ;; normally with the cursor keys. --Stef
+ ;; (define-key map [down] 'profiler-report-next-entry)
+ ;; (define-key map [up] 'profiler-report-previous-entry)
+ (define-key map "\r" 'profiler-report-toggle-entry)
+ (define-key map "\t" 'profiler-report-toggle-entry)
+ (define-key map "i" 'profiler-report-toggle-entry)
+ (define-key map "f" 'profiler-report-find-entry)
+ (define-key map "j" 'profiler-report-find-entry)
+ (define-key map [mouse-2] 'profiler-report-find-entry)
+ (define-key map "d" 'profiler-report-describe-entry)
+ (define-key map "C" 'profiler-report-render-calltree)
+ (define-key map "B" 'profiler-report-render-reversed-calltree)
+ (define-key map "A" 'profiler-report-ascending-sort)
+ (define-key map "D" 'profiler-report-descending-sort)
+ (define-key map "=" 'profiler-report-compare-log)
+ (define-key map (kbd "C-x C-w") 'profiler-report-write-log)
+ (define-key map "q" 'quit-window)
+ map))
+
+(defun profiler-report-make-buffer-name (log)
+ (format "*%s-Profiler-Report %s*"
+ (cl-ecase (profiler-log-type log) (cpu 'CPU) (memory 'Memory))
+ (format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log))))
+
+(defun profiler-report-setup-buffer (log)
+ "Make a buffer for LOG and return it."
+ (let* ((buf-name (profiler-report-make-buffer-name log))
+ (buffer (get-buffer-create buf-name)))
+ (with-current-buffer buffer
+ (profiler-report-mode)
+ (setq profiler-report-log log
+ profiler-report-reversed nil
+ profiler-report-order 'descending))
+ buffer))
+
+(define-derived-mode profiler-report-mode special-mode "Profiler-Report"
+ "Profiler Report Mode."
+ (setq buffer-read-only t
+ buffer-undo-list t
+ truncate-lines t))
+
+\f
+;;; Report commands
+
+(defun profiler-report-calltree-at-point ()
+ (get-text-property (point) 'calltree))
+
+(defun profiler-report-move-to-entry ()
+ (let ((point (next-single-property-change (line-beginning-position)
+ 'profiler-entry)))
+ (if point
+ (goto-char point)
+ (back-to-indentation))))
+
+(defun profiler-report-next-entry ()
+ "Move cursor to next entry."
+ (interactive)
+ (forward-line)
+ (profiler-report-move-to-entry))
+
+(defun profiler-report-previous-entry ()
+ "Move cursor to previous entry."
+ (interactive)
+ (forward-line -1)
+ (profiler-report-move-to-entry))
+
+(defun profiler-report-expand-entry ()
+ "Expand entry at point."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (when (search-forward (concat profiler-report-closed-mark " ")
+ (line-end-position) t)
+ (let ((tree (profiler-report-calltree-at-point)))
+ (when tree
+ (let ((inhibit-read-only t))
+ (replace-match (concat profiler-report-open-mark " "))
+ (forward-line)
+ (profiler-report-insert-calltree-children tree)
+ t))))))
+
+(defun profiler-report-collapse-entry ()
+ "Collpase entry at point."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (when (search-forward (concat profiler-report-open-mark " ")
+ (line-end-position) t)
+ (let* ((tree (profiler-report-calltree-at-point))
+ (depth (profiler-calltree-depth tree))
+ (start (line-beginning-position 2))
+ d)
+ (when tree
+ (let ((inhibit-read-only t))
+ (replace-match (concat profiler-report-closed-mark " "))
+ (while (and (eq (forward-line) 0)
+ (let ((child (get-text-property (point) 'calltree)))
+ (and child
+ (numberp (setq d (profiler-calltree-depth child)))))
+ (> d depth)))
+ (delete-region start (line-beginning-position)))))
+ t)))
+
+(defun profiler-report-toggle-entry ()
+ "Expand entry at point if the tree is collapsed,
+otherwise collapse."
+ (interactive)
+ (or (profiler-report-expand-entry)
+ (profiler-report-collapse-entry)))
+
+(defun profiler-report-find-entry (&optional event)
+ "Find entry at point."
+ (interactive (list last-nonmenu-event))
+ (if event (posn-set-point (event-end event)))
+ (let ((tree (profiler-report-calltree-at-point)))
+ (when tree
+ (let ((entry (profiler-calltree-entry tree)))
+ (find-function entry)))))
+
+(defun profiler-report-describe-entry ()
+ "Describe entry at point."
+ (interactive)
+ (let ((tree (profiler-report-calltree-at-point)))
+ (when tree
+ (let ((entry (profiler-calltree-entry tree)))
+ (require 'help-fns)
+ (describe-function entry)))))
+
+(cl-defun profiler-report-render-calltree-1
+ (log &key reverse (order 'descending))
+ (let ((calltree (profiler-calltree-build profiler-report-log
+ :reverse reverse)))
+ (setq header-line-format
+ (cl-ecase (profiler-log-type log)
+ (cpu
+ (profiler-report-header-line-format
+ profiler-report-sample-line-format
+ "Function" (list "Time (ms)" "%")))
+ (memory
+ (profiler-report-header-line-format
+ profiler-report-memory-line-format
+ "Function" (list "Bytes" "%")))))
+ (let ((predicate (cl-ecase order
+ (ascending #'profiler-calltree-count<)
+ (descending #'profiler-calltree-count>))))
+ (profiler-calltree-sort calltree predicate))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (profiler-report-insert-calltree-children calltree)
+ (goto-char (point-min))
+ (profiler-report-move-to-entry))))
+
+(defun profiler-report-rerender-calltree ()
+ (profiler-report-render-calltree-1 profiler-report-log
+ :reverse profiler-report-reversed
+ :order profiler-report-order))
+
+(defun profiler-report-render-calltree ()
+ "Render calltree view."
+ (interactive)
+ (setq profiler-report-reversed nil)
+ (profiler-report-rerender-calltree))
+
+(defun profiler-report-render-reversed-calltree ()
+ "Render reversed calltree view."
+ (interactive)
+ (setq profiler-report-reversed t)
+ (profiler-report-rerender-calltree))
+
+(defun profiler-report-ascending-sort ()
+ "Sort calltree view in ascending order."
+ (interactive)
+ (setq profiler-report-order 'ascending)
+ (profiler-report-rerender-calltree))
+
+(defun profiler-report-descending-sort ()
+ "Sort calltree view in descending order."
+ (interactive)
+ (setq profiler-report-order 'descending)
+ (profiler-report-rerender-calltree))
+
+(defun profiler-report-log (log)
+ (let ((buffer (profiler-report-setup-buffer log)))
+ (with-current-buffer buffer
+ (profiler-report-render-calltree))
+ (pop-to-buffer buffer)))
+
+(defun profiler-report-compare-log (buffer)
+ "Compare the current profiler log with another."
+ (interactive (list (read-buffer "Compare to: ")))
+ (let* ((log1 (with-current-buffer buffer profiler-report-log))
+ (log2 profiler-report-log)
+ (diff-log (profiler-log-diff log1 log2)))
+ (profiler-report-log diff-log)))
+
+(defun profiler-report-write-log (filename &optional confirm)
+ "Write the current profiler log into FILENAME."
+ (interactive
+ (list (read-file-name "Write log: " default-directory)
+ (not current-prefix-arg)))
+ (profiler-log-write-file profiler-report-log
+ filename
+ confirm))
+
+\f
+;;; Profiler commands
+
+;;;###autoload
+(defun profiler-start (mode)
+ "Start/restart profilers.
+MODE can be one of `cpu', `mem', or `cpu+mem'.
+If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
+Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
+ (interactive
+ (list (if (not (fboundp 'profiler-cpu-start)) 'mem
+ (intern (completing-read "Mode (default cpu): "
+ '("cpu" "mem" "cpu+mem")
+ nil t nil nil "cpu")))))
+ (cl-ecase mode
+ (cpu
+ (profiler-cpu-start profiler-sample-interval)
+ (message "CPU profiler started"))
+ (mem
+ (profiler-memory-start)
+ (message "Memory profiler started"))
+ (cpu+mem
+ (profiler-cpu-start profiler-sample-interval)
+ (profiler-memory-start)
+ (message "CPU and memory profiler started"))))
+
+(defun profiler-stop ()
+ "Stop started profilers. Profiler logs will be kept."
+ (interactive)
+ (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop)))
+ (mem (profiler-memory-stop)))
+ (message "%s profiler stopped"
+ (cond ((and mem cpu) "CPU and memory")
+ (mem "Memory")
+ (cpu "CPU")
+ (t "No")))))
+
+(defun profiler-reset ()
+ "Reset profiler log."
+ (interactive)
+ (when (fboundp 'profiler-cpu-log)
+ (ignore (profiler-cpu-log)))
+ (ignore (profiler-memory-log))
+ t)
+
+(defun profiler--report-cpu ()
+ (let ((log (if (fboundp 'profiler-cpu-log) (profiler-cpu-log))))
+ (when log
+ (puthash 'type 'cpu log)
+ (puthash 'timestamp (current-time) log)
+ (profiler-report-log log))))
+
+(defun profiler--report-memory ()
+ (let ((log (profiler-memory-log)))
+ (when log
+ (puthash 'type 'memory log)
+ (puthash 'timestamp (current-time) log)
+ (profiler-report-log log))))
+
+(defun profiler-report ()
+ "Report profiling results."
+ (interactive)
+ (profiler--report-cpu)
+ (profiler--report-memory))
+
+;;;###autoload
+(defun profiler-find-log (filename)
+ "Read a profiler log from FILENAME and report it."
+ (interactive
+ (list (read-file-name "Find log: " default-directory)))
+ (profiler-report-log (profiler-log-read-file filename)))
+
+\f
+;;; Profiling helpers
+
+;; (cl-defmacro with-sample-profiling ((&key interval) &rest body)
+;; `(unwind-protect
+;; (progn
+;; (ignore (profiler-cpu-log))
+;; (profiler-cpu-start ,interval)
+;; ,@body)
+;; (profiler-cpu-stop)
+;; (profiler--report-cpu)))
+
+;; (defmacro with-memory-profiling (&rest body)
+;; `(unwind-protect
+;; (progn
+;; (ignore (profiler-memory-log))
+;; (profiler-memory-start)
+;; ,@body)
+;; (profiler-memory-stop)
+;; (profiler--report-memory)))
+
+(provide 'profiler)
+;;; profiler.el ends here
;; should be loaded before the ada-mode, which will then setup some variables
;; to improve the support for Ada code.
;; Here is the list of these modes:
-;; `which-function-mode': Display in the modeline the name of the subprogram
+;; `which-function-mode': Display in the mode line the name of the subprogram
;; the cursor is in.
;; `outline-mode': Provides the capability to collapse or expand the code
;; for specific language constructs, for instance if you want to hide the
version-string)))
(defvar ada-mode-hook nil
- "*List of functions to call when Ada mode is invoked.
+ "List of functions to call when Ada mode is invoked.
This hook is automatically executed after the `ada-mode' is
fully loaded.
This is a good place to add Ada environment specific bindings.")
:group 'languages)
(defcustom ada-auto-case t
- "*Non-nil means automatically change case of preceding word while typing.
+ "Non-nil means automatically change case of preceding word while typing.
Casing is done according to `ada-case-keyword', `ada-case-identifier'
and `ada-case-attribute'."
:type 'boolean :group 'ada)
(defcustom ada-broken-decl-indent 0
- "*Number of columns to indent a broken declaration.
+ "Number of columns to indent a broken declaration.
An example is :
declare
:type 'integer :group 'ada)
(defcustom ada-broken-indent 2
- "*Number of columns to indent the continuation of a broken line.
+ "Number of columns to indent the continuation of a broken line.
An example is :
My_Var : My_Type := (Field1 =>
:type 'integer :group 'ada)
(defcustom ada-continuation-indent ada-broken-indent
- "*Number of columns to indent the continuation of broken lines in parenthesis.
+ "Number of columns to indent the continuation of broken lines in parenthesis.
An example is :
Func (Param1,
:type 'integer :group 'ada)
(defcustom ada-case-attribute 'ada-capitalize-word
- "*Function to call to adjust the case of Ada attributes.
+ "Function to call to adjust the case of Ada attributes.
It may be `downcase-word', `upcase-word', `ada-loose-case-word',
`ada-capitalize-word' or `ada-no-auto-case'."
:type '(choice (const downcase-word)
(defcustom ada-case-exception-file
(list (convert-standard-filename' "~/.emacs_case_exceptions"))
- "*List of special casing exceptions dictionaries for identifiers.
+ "List of special casing exceptions dictionaries for identifiers.
The first file is the one where new exceptions will be saved by Emacs
when you call `ada-create-case-exception'.
:group 'ada)
(defcustom ada-case-keyword 'downcase-word
- "*Function to call to adjust the case of an Ada keywords.
+ "Function to call to adjust the case of an Ada keywords.
It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
`ada-capitalize-word'."
:type '(choice (const downcase-word)
:group 'ada)
(defcustom ada-case-identifier 'ada-loose-case-word
- "*Function to call to adjust the case of an Ada identifier.
+ "Function to call to adjust the case of an Ada identifier.
It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
`ada-capitalize-word'."
:type '(choice (const downcase-word)
:group 'ada)
(defcustom ada-clean-buffer-before-saving t
- "*Non-nil means remove trailing spaces and untabify the buffer before saving."
+ "Non-nil means remove trailing spaces and untabify the buffer before saving."
:type 'boolean :group 'ada)
(make-obsolete-variable 'ada-clean-buffer-before-saving
"use the `write-file-functions' hook."
(defcustom ada-indent 3
- "*Size of Ada indentation.
+ "Size of Ada indentation.
An example is :
procedure Foo is
:type 'integer :group 'ada)
(defcustom ada-indent-after-return t
- "*Non-nil means automatically indent after RET or LFD."
+ "Non-nil means automatically indent after RET or LFD."
:type 'boolean :group 'ada)
(defcustom ada-indent-align-comments t
- "*Non-nil means align comments on previous line comments, if any.
+ "Non-nil means align comments on previous line comments, if any.
If nil, indentation is calculated as usual.
Note that indentation is calculated only if `ada-indent-comment-as-code' is t.
:type 'boolean :group 'ada)
(defcustom ada-indent-comment-as-code t
- "*Non-nil means indent comment lines as code.
+ "Non-nil means indent comment lines as code.
A nil value means do not auto-indent comments."
:type 'boolean :group 'ada)
(defcustom ada-indent-handle-comment-special nil
- "*Non-nil if comment lines should be handled specially inside parenthesis.
+ "Non-nil if comment lines should be handled specially inside parenthesis.
By default, if the line that contains the open parenthesis has some
text following it, then the following lines will be indented in the
same column as this text. This will not be true if the first line is
:type 'boolean :group 'ada)
(defcustom ada-indent-is-separate t
- "*Non-nil means indent 'is separate' or 'is abstract' if on a single line."
+ "Non-nil means indent 'is separate' or 'is abstract' if on a single line."
:type 'boolean :group 'ada)
(defcustom ada-indent-record-rel-type 3
- "*Indentation for 'record' relative to 'type' or 'use'.
+ "Indentation for 'record' relative to 'type' or 'use'.
An example is:
type A is
:type 'integer :group 'ada)
(defcustom ada-indent-renames ada-broken-indent
- "*Indentation for renames relative to the matching function statement.
+ "Indentation for renames relative to the matching function statement.
If `ada-indent-return' is null or negative, the indentation is done relative to
the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
:type 'integer :group 'ada)
(defcustom ada-indent-return 0
- "*Indentation for 'return' relative to the matching 'function' statement.
+ "Indentation for 'return' relative to the matching 'function' statement.
If `ada-indent-return' is null or negative, the indentation is done relative to
the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
:type 'integer :group 'ada)
(defcustom ada-indent-to-open-paren t
- "*Non-nil means indent according to the innermost open parenthesis."
+ "Non-nil means indent according to the innermost open parenthesis."
:type 'boolean :group 'ada)
(defcustom ada-fill-comment-prefix "-- "
- "*Text inserted in the first columns when filling a comment paragraph.
+ "Text inserted in the first columns when filling a comment paragraph.
Note: if you modify this variable, you will have to invoke `ada-mode'
again to take account of the new value."
:type 'string :group 'ada)
(defcustom ada-fill-comment-postfix " --"
- "*Text inserted at the end of each line when filling a comment paragraph.
+ "Text inserted at the end of each line when filling a comment paragraph.
Used by `ada-fill-comment-paragraph-postfix'."
:type 'string :group 'ada)
(defcustom ada-label-indent -4
- "*Number of columns to indent a label.
+ "Number of columns to indent a label.
An example is:
procedure Foo is
:type 'integer :group 'ada)
(defcustom ada-language-version 'ada95
- "*Ada language version; one of `ada83', `ada95', `ada2005'."
+ "Ada language version; one of `ada83', `ada95', `ada2005'."
:type '(choice (const ada83) (const ada95) (const ada2005)) :group 'ada)
(defcustom ada-move-to-declaration nil
- "*Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to 'begin'."
+ "Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to 'begin'."
:type 'boolean :group 'ada)
(defcustom ada-popup-key '[down-mouse-3]
- "*Key used for binding the contextual menu.
+ "Key used for binding the contextual menu.
If nil, no contextual menu is available."
:type '(restricted-sexp :match-alternatives (stringp vectorp))
:group 'ada)
(split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
'("/usr/adainclude" "/usr/local/adainclude"
"/opt/gnu/adainclude"))
- "*Default list of directories to search for Ada files.
+ "Default list of directories to search for Ada files.
See the description for the `ff-search-directories' variable. This variable
is the initial value of `ada-search-directories-internal'."
:type '(repeat (choice :tag "Directory"
`ada-search-directories'.")
(defcustom ada-stmt-end-indent 0
- "*Number of columns to indent the end of a statement on a separate line.
+ "Number of columns to indent the end of a statement on a separate line.
An example is:
if A = B
:type 'integer :group 'ada)
(defcustom ada-tab-policy 'indent-auto
- "*Control the behavior of the TAB key.
+ "Control the behavior of the TAB key.
Must be one of :
`indent-rigidly' : always adds `ada-indent' blanks at the beginning of the line.
`indent-auto' : use indentation functions in this file.
:group 'ada)
(defcustom ada-use-indent ada-broken-indent
- "*Indentation for the lines in a 'use' statement.
+ "Indentation for the lines in a 'use' statement.
An example is:
use Ada.Text_IO,
:type 'integer :group 'ada)
(defcustom ada-when-indent 3
- "*Indentation for 'when' relative to 'exception' or 'case'.
+ "Indentation for 'when' relative to 'exception' or 'case'.
An example is:
case A is
:type 'integer :group 'ada)
(defcustom ada-with-indent ada-broken-indent
- "*Indentation for the lines in a 'with' statement.
+ "Indentation for the lines in a 'with' statement.
An example is:
with Ada.Text_IO,
:type 'integer :group 'ada)
(defcustom ada-which-compiler 'gnat
- "*Name of the compiler to use.
+ "Name of the compiler to use.
This will determine what features are made available through the Ada mode.
The possible choices are:
`gnat': Use Ada Core Technologies' GNAT compiler. Add some cross-referencing
(re-search-backward ada-imenu-subprogram-menu-re nil t))
;; Get the function name, but not the properties, or this changes
- ;; the face in the modeline on Emacs 21
+ ;; the face in the mode line on Emacs 21
(setq func-name (match-string-no-properties 3))
(if (and (not (ada-in-comment-p))
(not (save-excursion
;; correctly highlight a with_clause that spans multiple lines.
(list (concat "\\<\\(goto\\|raise\\|use\\|with\\)"
"[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W")
- '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
+ '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t))
;;
;; Goto tags.
- '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)
+ '("<<\\(\\sw+\\)>>" 1 font-lock-constant-face)
;; Highlight based-numbers (R. Reagan <robin-reply@reagans.org>)
(list "\\([0-9]+#[0-9a-fA-F_]+#\\)" '(1 font-lock-constant-face t))
;; ------ User variables
(defcustom ada-xref-other-buffer t
- "*If nil, always display the cross-references in the same buffer.
+ "If nil, always display the cross-references in the same buffer.
Otherwise create either a new buffer or a new frame."
:type 'boolean :group 'ada)
(defcustom ada-xref-create-ali nil
- "*If non-nil, run gcc whenever the cross-references are not up-to-date.
+ "If non-nil, run gcc whenever the cross-references are not up-to-date.
If nil, the cross-reference mode never runs gcc."
:type 'boolean :group 'ada)
(defcustom ada-xref-confirm-compile nil
- "*If non-nil, ask for confirmation before compiling or running the application."
+ "If non-nil, ask for confirmation before compiling or running the application."
:type 'boolean :group 'ada)
(defcustom ada-krunch-args "0"
- "*Maximum number of characters for filenames created by `gnatkr'.
+ "Maximum number of characters for filenames created by `gnatkr'.
Set to 0, if you don't use crunched filenames. This should be a string."
:type 'string :group 'ada)
:type 'string :group 'ada)
(defcustom ada-gnatls-args '("-v")
- "*Arguments to pass to `gnatls' to find location of the runtime.
+ "Arguments to pass to `gnatls' to find location of the runtime.
Typical use is to pass `--RTS=soft-floats' on some systems that support it.
You can also add `-I-' if you do not want the current directory to be included.
(defcustom ada-prj-default-check-cmd
(concat "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current}"
" -cargs ${comp_opt}")
- "*Default command to be used to compile a single file.
+ "Default command to be used to compile a single file.
Emacs will substitute the current filename for ${full_current}, or add
the filename at the end. This is the same syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-comp-cmd
(concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
" ${comp_opt}")
- "*Default command to be used to compile a single file.
+ "Default command to be used to compile a single file.
Emacs will substitute the current filename for ${full_current}, or add
the filename at the end. This is the same syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
- "*Default name of the debugger."
+ "Default name of the debugger."
:type 'string :group 'ada)
(defcustom ada-prj-default-make-cmd
(concat "${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} "
"-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
- "*Default command to be used to compile the application.
+ "Default command to be used to compile the application.
This is the same syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-project-file ""
- "*Name of the current project file.
+ "Name of the current project file.
Emacs will not try to use the search algorithm to find the project file if
this string is not empty. It is set whenever a project file is found."
:type '(file :must-match t) :group 'ada)
(defcustom ada-gnatstub-opts "-q -I${src_dir}"
- "*Options to pass to `gnatsub' to generate the body of a package.
+ "Options to pass to `gnatsub' to generate the body of a package.
This has the same syntax as in the project file (with variable substitution)."
:type 'string :group 'ada)
(defcustom ada-always-ask-project nil
- "*If nil, use default values when no project file was found.
+ "If nil, use default values when no project file was found.
Otherwise, ask the user for the name of the project file to use."
:type 'boolean :group 'ada)
"True if we are running on Windows.")
(defcustom ada-tight-gvd-integration nil
- "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
+ "If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
If GVD is not the debugger used, nothing happens."
:type 'boolean :group 'ada)
(defcustom ada-xref-search-with-egrep t
- "*If non-nil, use egrep to find the possible declarations for an entity.
+ "If non-nil, use egrep to find the possible declarations for an entity.
This alternate method is used when the exact location was not found in the
information provided by GNAT. However, it might be expensive if you have a lot
of sources, since it will search in all the files in your project."
;; also a separate.
(with-current-buffer (get-file-buffer file)
- (let ((short-ali-file-name
- (concat (file-name-sans-extension (file-name-nondirectory file))
- ".ali"))
+ (let ((short-ali-file-name (concat (file-name-base file) ".ali"))
ali-file-name
is-spec)
(if is-spec
(set 'ali-file-name
(ada-find-ali-file-in-dir
- (concat (file-name-sans-extension
- (file-name-nondirectory
- (ada-other-file-name)))
- ".ali"))))
+ (concat (file-name-base (ada-other-file-name)) ".ali"))))
(setq ali-file-name
;; file_s.ada and file_b.ada), try to go to the other file
;; and look for its ali file
(ada-find-ali-file-in-dir
- (concat (file-name-sans-extension
- (file-name-nondirectory (ada-other-file-name)))
- ".ali"))
+ (concat (file-name-base (ada-other-file-name)) ".ali"))
;; If we still don't have an ali file, try to get the one
;; from the parent unit, in case we have a separate entity.
- (let ((parent-name (file-name-sans-extension
- (file-name-nondirectory file))))
+ (let ((parent-name (file-name-base file)))
(while (and (not ali-file-name)
(string-match "^\\(.*\\)[.-][^.-]*" parent-name))
;; This file requires Emacs-20.3, XEmacs-20.4 or higher and package cc-mode.
;; If antlr-mode is not part of your distribution, put this file into your
-;; load-path and the following into your ~/.emacs:
+;; load-path and the following into your init file:
;; (autoload 'antlr-mode "antlr-mode" nil t)
;; (setq auto-mode-alist (cons '("\\.g\\'" . antlr-mode) auto-mode-alist))
;; (add-hook 'speedbar-load-hook ; would be too late in antlr-mode.el
value of `antlr-language' if the first group in the string matched by
REGEXP in `antlr-language-limit-n-regexp' is one of the OPTION-VALUEs.
An OPTION-VALUE of nil denotes the fallback element. MODELINE-STRING is
-also displayed in the modeline next to \"Antlr\"."
+also displayed in the mode line next to \"Antlr\"."
:group 'antlr
:type '(repeat (group :value (java-mode "")
(function :tag "Major mode")
- (string :tag "Modeline string")
+ (string :tag "Mode line string")
(repeat :tag "ANTLR language option" :inline t
(choice (const :tag "Default" nil)
string )))))
(integer :tag "Hidden if longer than" :value 3)))
(defcustom antlr-indent-comment 'tab
- "*Non-nil, if the indentation should touch lines in block comments.
+ "Non-nil, if the indentation should touch lines in block comments.
If nil, no continuation line of a block comment is changed. If t, they
are changed according to `c-indentation-line'. When not nil and not t,
they are only changed by \\[antlr-indent-command]."
(boolean :tag "Indent-tabs-mode"))))
(defcustom antlr-indent-style "java"
- "*If non-nil, cc-mode indentation style used for `antlr-mode'.
+ "If non-nil, cc-mode indentation style used for `antlr-mode'.
See `c-set-style' and for details, where the most interesting part in
`c-style-alist' is the value of `c-basic-offset'."
:group 'antlr
;;;===========================================================================
(defcustom antlr-options-use-submenus t
- "*Non-nil, if the major mode menu should include option submenus.
+ "Non-nil, if the major mode menu should include option submenus.
If nil, the menu just includes a command to insert options. Otherwise,
it includes four submenus to insert file/grammar/rule/subrule options."
:group 'antlr
:type 'boolean)
(defcustom antlr-tool-version 20701
- "*The version number of the Antlr tool.
+ "The version number of the Antlr tool.
The value is an integer of the form XYYZZ which stands for vX.YY.ZZ.
This variable is used to warn about non-supported options and to supply
version correct option values when using \\[antlr-insert-option].
:type 'integer)
(defcustom antlr-options-auto-colon t
- "*Non-nil, if `:' is inserted with a rule or subrule options section.
+ "Non-nil, if `:' is inserted with a rule or subrule options section.
A `:' is only inserted if this value is non-nil, if a rule or subrule
option is inserted with \\[antlr-insert-option], if there was no rule or
subrule options section before, and if a `:' is not already present
:type '(repeat (symbol :tag "Style symbol")))
(defcustom antlr-options-push-mark t
- "*Non-nil, if inserting an option should set & push mark.
+ "Non-nil, if inserting an option should set & push mark.
If nil, never set mark when inserting an option with command
\\[antlr-insert-option]. If t, always set mark via `push-mark'. If a
number, only set mark if point was outside the options area before and
(sexp :tag "If outside options" :format "%t" :value outside)))
(defcustom antlr-options-assign-string " = "
- "*String containing `=' to use between option name and value.
+ "String containing `=' to use between option name and value.
This string is only used if the option to insert did not exist before
or if there was no `=' after it. In other words, the spacing around an
existing `=' won't be changed when changing an option value."
;;;===========================================================================
(defcustom antlr-tool-command "java antlr.Tool"
- "*Command used in \\[antlr-run-tool] to run the Antlr tool.
+ "Command used in \\[antlr-run-tool] to run the Antlr tool.
This variable should include all options passed to Antlr except the
option \"-glib\" which is automatically suggested if necessary."
:group 'antlr
:type 'string)
(defcustom antlr-ask-about-save t
- "*If not nil, \\[antlr-run-tool] asks which buffers to save.
+ "If not nil, \\[antlr-run-tool] asks which buffers to save.
Otherwise, it saves all modified buffers before running without asking."
:group 'antlr
:type 'boolean)
(defcustom antlr-makefile-specification
'("\n" ("GENS" "GENS%d" " \\\n\t") "$(ANTLR)")
- "*Variable to specify the appearance of the generated makefile rules.
+ "Variable to specify the appearance of the generated makefile rules.
This variable influences the output of \\[antlr-show-makefile-rules].
It looks like \(RULE-SEP GEN-VAR-SPEC COMMAND).
formats.")
(defvar antlr-unknown-file-formats '("?%s?.g" "?%s?")
- "*Formats which specify the names of unknown files.
+ "Formats which specify the names of unknown files.
The value looks like \(SUPER-GRAMMAR-FILE-FORMAT SUPER-EVOCAB-FORMAT).
SUPER-GRAMMAR-FORMAT is a format string, it specifies with substitution
;;;===========================================================================
(defcustom antlr-imenu-name t ; (featurep 'xemacs) ; TODO: Emacs-21 bug?
- "*Non-nil, if a \"Index\" menu should be added to the menubar.
+ "Non-nil, if a \"Index\" menu should be added to the menubar.
If it is a string, it is used instead \"Index\". Requires package
imenu."
:group 'antlr
;;;===========================================================================
(defcustom antlr-font-lock-maximum-decoration 'inherit
- "*The maximum decoration level for fontifying actions.
+ "The maximum decoration level for fontifying actions.
Value `none' means, do not fontify actions, just normal grammar code
according to `antlr-font-lock-additional-keywords'. Value `inherit'
means, use value of `font-lock-maximum-decoration'. Any other value is
:group 'languages)
(defcustom asm-comment-char ?\;
- "*The comment-start character assumed by Asm mode."
+ "The comment-start character assumed by Asm mode."
:type 'character
:group 'asm)
-;;; autoconf.el --- mode for editing Autoconf configure.in files
+;;; autoconf.el --- mode for editing Autoconf configure.ac files
;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;;; Commentary:
;; Provides fairly minimal font-lock, imenu and indentation support
-;; for editing configure.in files. Only Autoconf syntax is processed.
+;; for editing configure.ac files. Only Autoconf syntax is processed.
;; There is no attempt to deal with shell text -- probably that will
;; always lose.
-;; This is specialized for configure.in files. It doesn't inherit the
+;; This is specialized for configure.ac files. It doesn't inherit the
;; general M4 stuff from M4 mode.
;; There is also an autoconf-mode.el in existence. That appears to be
-;; for editing the Autoconf M4 source, rather than configure.in files.
+;; for editing the Autoconf M4 source, rather than configure.ac files.
;;; Code:
-(defvar font-lock-syntactic-keywords)
-
(defvar autoconf-mode-map (make-sparse-keymap))
(defvar autoconf-mode-hook nil
"Hook run by `autoconf-mode'.")
(defconst autoconf-definition-regexp
- "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*")
+ "A\\(?:H_TEMPLATE\\|C_\\(?:SUBST\\|DEFINE\\(?:_UNQUOTED\\)?\\)\\)(\\[*\\(\\sw+\\)\\]*")
(defvar autoconf-font-lock-keywords
`(("\\_<A[CHMS]_\\sw+" . font-lock-keyword-face)
(,autoconf-definition-regexp
- 3 font-lock-function-name-face)
- ;; Are any other M4 keywords really appropriate for configure.in,
+ 1 font-lock-function-name-face)
+ ;; Are any other M4 keywords really appropriate for configure.ac,
;; given that we do `dnl'?
("changequote" . font-lock-keyword-face)))
table))
(defvar autoconf-imenu-generic-expression
- (list (list nil autoconf-definition-regexp 3)))
+ (list (list nil autoconf-definition-regexp 1)))
;; It's not clear how best to implement this.
(defun autoconf-current-defun-function ()
(save-excursion
(with-syntax-table (copy-syntax-table autoconf-mode-syntax-table)
(modify-syntax-entry ?_ "w")
+ (skip-syntax-forward "w" (line-end-position))
(if (re-search-backward autoconf-definition-regexp
(save-excursion (beginning-of-defun) (point))
t)
- (match-string-no-properties 3)))))
+ (match-string-no-properties 1)))))
;;;###autoload
(define-derived-mode autoconf-mode prog-mode "Autoconf"
- "Major mode for editing Autoconf configure.in files."
+ "Major mode for editing Autoconf configure.ac files."
(set (make-local-variable 'parens-require-spaces) nil) ; for M4 arg lists
(set (make-local-variable 'defun-prompt-regexp)
"^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+")
;;; Code:
+(defgroup bug-reference nil
+ "Hyperlinking references to bug reports"
+ ;; Somewhat arbitrary, by analogy with eg goto-address.
+ :group 'comm)
+
(defvar bug-reference-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'bug-reference-push-button)
(and (symbolp s)
(get s 'bug-reference-url-format)))))
-(defconst bug-reference-bug-regexp
- "\\([Bb]ug ?#\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z-+]+/\\)\\([0-9]+\\)"
- "Regular expression which matches bug references.")
+(defcustom bug-reference-bug-regexp
+ "\\([Bb]ug ?#\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z-+]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
+ "Regular expression matching bug references.
+The second subexpression should match the bug reference (usually a number)."
+ :type 'string
+ :safe 'stringp
+ :group 'bug-reference)
(defun bug-reference-set-overlay-properties ()
"Set properties of bug reference overlays."
Turning on auto-newline automatically enables electric indentation.
When the auto-newline feature is enabled (indicated by \"/la\" on the
-modeline after the mode name) newlines are automatically inserted
+mode line after the mode name) newlines are automatically inserted
after special characters such as brace, comma, semi-colon, and colon."
(interactive "P")
(setq c-auto-newline
left out.
When the hungry-delete-key feature is enabled (indicated by \"/h\" on
-the modeline after the mode name) the delete key gobbles all preceding
+the mode line after the mode name) the delete key gobbles all preceding
whitespace in one fell swoop."
(interactive "P")
(setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key))
(t
;; Being evaluated interactively.
(buffer-file-name)))))
- (and file
- (file-name-sans-extension
- (file-name-nondirectory file)))))
+ (and file (file-name-base file))))
(defmacro c-lang-defconst-eval-immediately (form)
"Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
(eval form))
;; Only used at compile time - suppress "might not be defined at runtime".
-(declare-function cl-macroexpand-all "cl-extra" (form &optional env))
+(declare-function cl-macroexpand-all "cl" (form &optional env))
(defmacro c-lang-defconst (name &rest args)
"Set the language specific values of the language constant NAME.
;; high as possible.
(setq rung-pos (point)))
+ (with-silent-modifications
(while
(progn
(while
(1- last-put-in-sws-pos))
(c-remove-is-and-in-sws (1- last-put-in-sws-pos)
last-put-in-sws-pos))))
- )))
+ ))))
(defun c-backward-sws ()
;; Used by `c-backward-syntactic-ws' to implement the unbounded search.
(goto-char (setq rung-pos rung-is-marked))
(goto-char simple-ws-beg))
+ (with-silent-modifications
(while
(progn
(while
last-put-in-sws-pos)
(c-remove-is-and-in-sws last-put-in-sws-pos
(1+ last-put-in-sws-pos)))))
- )))
+ ))))
\f
;; Other whitespace tools
(setq c-state-point-min (point-min)))
(defun c-append-lower-brace-pair-to-state-cache (from &optional upper-lim)
- ;; If there is a brace pair preceding FROM in the buffer (not necessarily
- ;; immediately preceding), push a cons onto `c-state-cache' to represent it.
- ;; FROM must not be inside a literal. If UPPER-LIM is non-nil, we append
- ;; the highest brace pair whose "}" is below UPPER-LIM.
+ ;; If there is a brace pair preceding FROM in the buffer, at the same level
+ ;; of nesting (not necessarily immediately preceding), push a cons onto
+ ;; `c-state-cache' to represent it. FROM must not be inside a literal. If
+ ;; UPPER-LIM is non-nil, we append the highest brace pair whose "}" is below
+ ;; UPPER-LIM.
;;
;; Return non-nil when this has been done.
;;
+ ;; The situation it copes with is this transformation:
+ ;;
+ ;; OLD: { (.) {...........}
+ ;; ^ ^
+ ;; FROM HERE
+ ;;
+ ;; NEW: { {....} (.) {.........
+ ;; ^ ^ ^
+ ;; LOWER BRACE PAIR HERE or HERE
+ ;;
;; This routine should be fast. Since it can get called a LOT, we maintain
;; `c-state-brace-pair-desert', a small cache of "failures", such that we
;; reduce the time wasted in repeated fruitless searches in brace deserts.
(unless (and c-state-brace-pair-desert
(eq cache-pos (car c-state-brace-pair-desert))
(<= from (cdr c-state-brace-pair-desert)))
- ;; Only search what we absolutely need to:
- (if (and c-state-brace-pair-desert
- (eq cache-pos (car c-state-brace-pair-desert)))
- (narrow-to-region (cdr c-state-brace-pair-desert) (point-max)))
+ ;; DESERT-LIM. Only search what we absolutely need to,
+ (let ((desert-lim
+ (and c-state-brace-pair-desert
+ (eq cache-pos (car c-state-brace-pair-desert))
+ (cdr c-state-brace-pair-desert)))
+ ;; CACHE-LIM. This limit will be necessary when an opening
+ ;; paren at `cache-pos' has just had its matching close paren
+ ;; inserted. `cache-pos' continues to be a search bound, even
+ ;; though the algorithm below would skip over the new paren
+ ;; pair.
+ (cache-lim (and cache-pos (< cache-pos from) cache-pos)))
+ (narrow-to-region
+ (cond
+ ((and desert-lim cache-lim)
+ (max desert-lim cache-lim))
+ (desert-lim)
+ (cache-lim)
+ ((point-min)))
+ (point-max)))
;; In the next pair of nested loops, the inner one moves back past a
;; pair of (mis-)matching parens or brackets; the outer one moves
(cons new-cons (cdr c-state-cache))))
(t (setq c-state-cache (cons new-cons c-state-cache)))))
- ;; We haven't found a brace pair. Record this.
+ ;; We haven't found a brace pair. Record this in the cache.
(setq c-state-brace-pair-desert (cons cache-pos from))))))))
(defsubst c-state-push-any-brace-pair (bra+1 macro-start-or-here)
c-state-cache-good-pos 1
c-state-nonlit-pos-cache nil
c-state-nonlit-pos-cache-limit 1
+ c-state-semi-nonlit-pos-cache nil
+ c-state-semi-nonlit-pos-cache-limit 1
c-state-brace-pair-desert nil
c-state-point-min 1
c-state-point-min-lit-type nil
c-state-cache-good-pos
c-state-nonlit-pos-cache
c-state-nonlit-pos-cache-limit
+ c-state-semi-nonlit-pos-cache
+ c-state-semi-nonlit-pos-cache-limit
c-state-brace-pair-desert
c-state-point-min
c-state-point-min-lit-type
;; Suppress "might not be defined at runtime" warning.
;; This file is only used when compiling other cc files.
-(declare-function delete-duplicates "cl-seq" (cl-seq &rest cl-keys))
-(declare-function mapcan "cl-extra" (cl-func cl-seq &rest cl-rest))
-(declare-function cl-macroexpand-all "cl-extra" (form &optional env))
+;; These are defined in cl as aliases to the cl- versions.
+(declare-function delete-duplicates "cl-seq" (cl-seq &rest cl-keys) t)
+(declare-function mapcan "cl-extra" (cl-func cl-seq &rest cl-rest) t)
+(declare-function cl-macroexpand-all "cl" (form &optional env))
(eval-and-compile
;; Some helper functions used when building the language constants.
;;; cc-mode.el --- major mode for editing C and similar languages
-;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2012 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
(easy-menu-define c-pike-menu pike-mode-map "Pike Mode Commands"
(cons "Pike" (c-lang-const c-mode-menu pike)))
-;;;###autoload (add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(.in\\)?\\)\\'" . pike-mode))
+;;;###autoload (add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(\\.in\\)?\\)\\'" . pike-mode))
;;;###autoload (add-to-list 'interpreter-mode-alist '("pike" . pike-mode))
;;;###autoload
If DONT-OVERRIDE is neither nil nor t, style variables whose default values
have been set (more precisely, whose default values are not the symbol
`set-from-style') will not be changed. This avoids overriding global settings
-done in ~/.emacs. It is useful to call c-set-style from a mode hook in this
-way.
+done in your init file. It is useful to call c-set-style from a mode hook
+in this way.
If DONT-OVERRIDE is t, style variables that already have values (i.e., whose
values are not the symbol `set-from-style') will not be overridden. CC Mode
:group 'languages)
(defcustom cfengine-indent 2
- "*Size of a CFEngine indentation step in columns."
+ "Size of a CFEngine indentation step in columns."
:group 'cfengine
:type 'integer)
;; INSTALLATION ======================================================
-;; Put the following in your ~/.emacs file.
+;; Put the following in your init file.
;; If you want the *Macroexpansion* window to be not higher than
;; necessary:
;; making comments visible in the expansion.
;; - All work is done in core memory, no need for temporary files.
-;; ACKNOWLEDGEMENTS ==================================================
+;; ACKNOWLEDGMENTS ===================================================
;; A lot of thanks to Don Maszle who did a great work of testing, bug
;; reporting and suggestion of new features. This work has been
(defcustom c-macro-shrink-window-flag nil
- "*Non-nil means shrink the *Macroexpansion* window to fit its contents."
+ "Non-nil means shrink the *Macroexpansion* window to fit its contents."
:type 'boolean
:group 'c-macro)
(defcustom c-macro-prompt-flag nil
- "*Non-nil makes `c-macro-expand' prompt for preprocessor arguments."
+ "Non-nil makes `c-macro-expand' prompt for preprocessor arguments."
:type 'boolean
:group 'c-macro)
:group 'c-macro)
(defcustom c-macro-cppflags ""
- "*Preprocessor flags used by `c-macro-expand'."
+ "Preprocessor flags used by `c-macro-expand'."
:type 'string
:group 'c-macro)
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'tool-bar)
(require 'comint)
This is bound before running `compilation-filter-hook'.")
(defvar compilation-first-column 1
- "*This is how compilers number the first column, usually 1 or 0.
+ "This is how compilers number the first column, usually 1 or 0.
If this is buffer-local in the destination buffer, Emacs obeys
that value, otherwise it uses the value in the *compilation*
buffer. This enables a major-mode to specify its own value.")
;;;###autoload
(defvar compilation-process-setup-function nil
- "*Function to call to customize the compilation process.
+ "Function to call to customize the compilation process.
This function is called immediately before the compilation process is
started. It can be used to set any variables or functions that are used
while processing the output of the compilation process.")
;; due to matching filenames via \\(.*?\\). This might be faster.
(maven
;; Maven is a popular free software build tool for Java.
- "\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 1 2 3)
+ "\\([^ \n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 1 2 3)
(jikes-line
"^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
`compilation-message-face' applied. If this is nil, the text
matched by the whole REGEXP becomes the hyperlink.
-Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where SUBMATCH is
-the number of a submatch that should be highlighted when it matches,
-and FACE is an expression returning the face to use for that submatch.."
+Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where
+SUBMATCH is the number of a submatch and FACE is an expression
+which evaluates to a face name (a symbol or string).
+Alternatively, FACE can evaluate to a property list of the
+form (face FACE PROP1 VAL1 PROP2 VAL2 ...), in which case all the
+listed text properties PROP# are given values VAL# as well."
:type '(repeat (choice (symbol :tag "Predefined symbol")
(sexp :tag "Error specification")))
:link `(file-link :tag "example file"
(defvar compilation-locs ())
(defvar compilation-debug nil
- "*Set this to t before creating a *compilation* buffer.
+ "Set this to t before creating a *compilation* buffer.
Then every error line will have a debug text property with the matcher that
fit this line and the match data. Use `describe-text-properties'.")
:group 'compilation
:version "22.1")
+;; The next three faces must be able to stand out against the
+;; `mode-line' and `mode-line-inactive' faces.
+
+(defface compilation-mode-line-fail
+ '((default :inherit compilation-error)
+ (((class color) (min-colors 16)) (:foreground "Red1" :weight bold))
+ (((class color) (min-colors 8)) (:foreground "red"))
+ (t (:inverse-video t :weight bold)))
+ "Face for Compilation mode's \"error\" mode line indicator."
+ :group 'compilation
+ :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.3")
+
+(defface compilation-mode-line-exit
+ '((default :inherit compilation-info)
+ (((class color) (min-colors 16))
+ (:foreground "ForestGreen" :weight bold))
+ (((class color)) (:foreground "green" :weight bold))
+ (t (:weight bold)))
+ "Face for Compilation mode's \"exit\" mode line indicator."
+ :group 'compilation
+ :version "24.3")
+
(defface compilation-line-number
'((t :inherit font-lock-keyword-face))
"Face for displaying line numbers in compiler messages."
(defvar compilation-leave-directory-face 'font-lock-builtin-face
"Face name to use for leaving directory messages.")
-
-
;; Used for compatibility with the old compile.el.
(defvar compilation-parse-errors-function nil)
-(make-obsolete 'compilation-parse-errors-function
- 'compilation-error-regexp-alist "24.1")
+(make-obsolete-variable 'compilation-parse-errors-function
+ 'compilation-error-regexp-alist "24.1")
(defcustom compilation-auto-jump-to-first-error nil
"If non-nil, automatically jump to the first error during compilation."
;; (make-variable-buffer-local 'compilation-buffer-modtime)
(defvar compilation-skip-to-next-location t
- "*If non-nil, skip multiple error messages for the same source location.")
+ "If non-nil, skip multiple error messages for the same source location.")
(defcustom compilation-skip-threshold 1
"Compilation motion commands skip less important messages.
3)))
(setq compilation-skip-threshold level)
(message "Skipping %s"
- (case compilation-skip-threshold
+ (pcase compilation-skip-threshold
(0 "Nothing")
(1 "Info messages")
(2 "Warnings and info"))))
;; modified using the same *compilation* buffer. this necessitates
;; re-parsing markers.
-;; (defstruct (compilation--loc
+;; (cl-defstruct (compilation--loc
;; (:constructor nil)
;; (:copier nil)
;; (:constructor compilation--make-loc
;; These are the value of the `compilation-message' text-properties in the
;; compilation buffer.
-(defstruct (compilation--message
+(cl-defstruct (compilation--message
(:constructor nil)
(:copier nil)
;; (:type list) ;Old representation.
(goto-char end)
(unless (bolp)
;; We generally don't like to parse partial lines.
- (assert (eobp))
+ (cl-assert (eobp))
(when (let ((proc (get-buffer-process (current-buffer))))
(and proc (memq (process-status proc) '(run open))))
(setq end (line-beginning-position))))
(compilation--put-prop
end-col 'font-lock-face compilation-column-face)
+ ;; Obey HIGHLIGHT.
(dolist (extra-item (nthcdr 6 item))
(let ((mn (pop extra-item)))
(when (match-beginning mn)
(let ((face (eval (car extra-item))))
(cond
((null face))
- ((symbolp face)
+ ((or (symbolp face) (stringp face))
(put-text-property
(match-beginning mn) (match-end mn)
'font-lock-face face))
+ ((and (listp face)
+ (eq (car face) 'face)
+ (or (symbolp (cadr face))
+ (stringp (cadr face))))
+ (put-text-property
+ (match-beginning mn) (match-end mn)
+ 'font-lock-face (cadr face))
+ (add-text-properties
+ (match-beginning mn) (match-end mn)
+ (nthcdr 2 face)))
(t
(error "Don't know how to handle face %S"
face)))))))
(t
(concat "*" (downcase name-of-mode) "*"))))
-;; This is a rough emulation of the old hack, until the transition to new
-;; compile is complete.
-(defun compile-internal (command error-message
- &optional _name-of-mode parser
- error-regexp-alist name-function
- _enter-regexp-alist _leave-regexp-alist
- file-regexp-alist _nomessage-regexp-alist
- _no-async highlight-regexp _local-map)
- (if parser
- (error "Compile now works very differently, see `compilation-error-regexp-alist'"))
- (let ((compilation-error-regexp-alist
- (append file-regexp-alist (or error-regexp-alist
- compilation-error-regexp-alist)))
- (compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?"
- "\\1" error-message)))
- (compilation-start command nil name-function highlight-regexp)))
-(make-obsolete 'compile-internal 'compilation-start "22.1")
+(defcustom compilation-always-kill nil
+ "If t, always kill a running compilation process before starting a new one.
+If nil, ask to kill it."
+ :type 'boolean
+ :version "24.3"
+ :group 'compilation)
;;;###autoload
(defun compilation-start (command &optional mode name-function highlight-regexp)
(get-buffer-create
(compilation-buffer-name name-of-mode mode name-function)))
(let ((comp-proc (get-buffer-process (current-buffer))))
- (if comp-proc
- (if (or (not (eq (process-status comp-proc) 'run))
- (yes-or-no-p
- (format "A %s process is running; kill it? "
- name-of-mode)))
- (condition-case ()
- (progn
- (interrupt-process comp-proc)
- (sit-for 1)
- (delete-process comp-proc))
- (error nil))
- (error "Cannot have two processes in `%s' at once"
- (buffer-name)))))
+ (if comp-proc
+ (if (or (not (eq (process-status comp-proc) 'run))
+ (eq (process-query-on-exit-flag comp-proc) nil)
+ (yes-or-no-p
+ (format "A %s process is running; kill it? "
+ name-of-mode)))
+ (condition-case ()
+ (progn
+ (interrupt-process comp-proc)
+ (sit-for 1)
+ (delete-process comp-proc))
+ (error nil))
+ (error "Cannot have two processes in `%s' at once"
+ (buffer-name)))))
;; first transfer directory from where M-x compile was called
(setq default-directory thisdir)
;; Make compilation buffer read-only. The filter can still write it.
(let ((process-environment
(append
compilation-environment
- (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
+ (if (if (boundp 'system-uses-terminfo);`If' for compiler warning.
system-uses-terminfo)
(list "TERM=dumb" "TERMCAP="
(format "COLUMNS=%d" (window-width)))
nil `("-c" ,command))))
(start-file-process-shell-command (downcase mode-name)
outbuf command))))
- ;; Make the buffer's mode line show process state.
- (setq mode-line-process
- (list (propertize ":%s" 'face 'compilation-warning)))
- (set-process-sentinel proc 'compilation-sentinel)
- (unless (eq mode t)
- ;; Keep the comint filter, since it's needed for proper handling
- ;; of the prompts.
+ ;; Make the buffer's mode line show process state.
+ (setq mode-line-process
+ '(:propertize ":%s" face compilation-mode-line-run))
+
+ ;; Set the process as killable without query by default.
+ ;; This allows us to start a new compilation without
+ ;; getting prompted.
+ (when compilation-always-kill
+ (set-process-query-on-exit-flag proc nil))
+
+ (set-process-sentinel proc 'compilation-sentinel)
+ (unless (eq mode t)
+ ;; Keep the comint filter, since it's needed for proper
+ ;; handling of the prompts.
(set-process-filter proc 'compilation-filter))
;; Use (point-max) here so that output comes in
;; after the initial text,
(cons proc compilation-in-progress)))
;; No asynchronous processes available.
(message "Executing `%s'..." command)
- ;; Fake modeline display as if `start-process' were run.
+ ;; Fake mode line display as if `start-process' were run.
(setq mode-line-process
- (list (propertize ":run" 'face 'compilation-warning)))
+ '(:propertize ":run" face compilation-mode-line-run))
(force-mode-line-update)
(sit-for 0) ; Force redisplay
(save-excursion
(setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
+;;;###autoload
+(put 'define-compilation-mode 'doc-string-elt 3)
+
(defmacro define-compilation-mode (mode name doc &rest body)
"This is like `define-derived-mode' without the PARENT argument.
The parent is always `compilation-mode' and the customizable `compilation-...'
(car status)))))
(message "%s" msg)
(propertize out-string
- 'help-echo msg 'face (if (> exit-status 0)
- 'compilation-error
- 'compilation-info))))
+ 'help-echo msg
+ 'face (if (> exit-status 0)
+ 'compilation-mode-line-fail
+ 'compilation-mode-line-exit))))
;; Force mode line redisplay soon.
(force-mode-line-update)
(if (and opoint (< opoint omax))
(if (or (eq (get-text-property ,limit 'compilation-message)
(get-text-property opt 'compilation-message))
(eq pt opt))
- (error ,error compilation-error)
+ (user-error ,error compilation-error)
(setq pt ,limit)))
;; prop 'compilation-message usually has 2 changes, on and off, so
;; re-search if off
(or (setq msg (get-text-property pt 'compilation-message))
(if (setq pt (,property-change pt 'compilation-message nil ,limit))
(setq msg (get-text-property pt 'compilation-message)))
- (error ,error compilation-error))
+ (user-error ,error compilation-error))
(or (< (compilation--message->type msg) compilation-skip-threshold)
(if different-file
(eq (prog1 last
(push fs compilation-gcpro)
(let ((loc (compilation-assq (or line 1) (cdr fs))))
(setq loc (compilation-assq col loc))
- (assert (null (cdr loc)))
+ (cl-assert (null (cdr loc)))
(setcdr loc (compilation--make-cdrloc line fs marker))
loc)))
;; the error location if the two buffers are in two
;; different frames. So don't do it if it's not necessary.
pre-existing
- (let ((display-buffer-reuse-frames t)
- (pop-up-windows t))
- ;; Pop up a window.
- (display-buffer (marker-buffer msg)))))
+ (display-buffer (marker-buffer msg))))
(highlight-regexp (with-current-buffer (marker-buffer msg)
;; also do this while we change buffer
(compilation-set-window w msg)
(defun compilation--flush-file-structure (file)
(or (consp file) (setq file (list file)))
(let ((fs (compilation-get-file-structure file)))
- (assert (eq fs (gethash file compilation-locs)))
- (assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
+ (cl-assert (eq fs (gethash file compilation-locs)))
+ (cl-assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
compilation-locs)))
(maphash (lambda (k v)
(if (eq v fs) (remhash k compilation-locs)))
compilation-locs)))
-(add-to-list 'debug-ignored-errors "\\`No more [-a-z ]+s yet\\'")
-(add-to-list 'debug-ignored-errors "\\`Moved past last .*")
-
;;; Compatibility with the old compile.el.
(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
nil t)))) ; Only one
(progn
(forward-word 1)
- (setq name (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name)))
+ (setq name (file-name-base)
p (point))
(insert " NAME\n\n" name
" - \n\n=head1 SYNOPSIS\n\n\n\n"
:prefix "cpp-")
(defcustom cpp-config-file (convert-standard-filename ".cpp.el")
- "*File name to save cpp configuration."
+ "File name to save cpp configuration."
:type 'file
:group 'cpp)
:type '(choice (const invisible) (face)))
(defcustom cpp-known-face 'invisible
- "*Face used for known cpp symbols."
+ "Face used for known cpp symbols."
:type 'cpp-face
:group 'cpp)
(defcustom cpp-unknown-face 'highlight
- "*Face used for unknown cpp symbols."
+ "Face used for unknown cpp symbols."
:type 'cpp-face
:group 'cpp)
(defcustom cpp-face-type 'light
- "*Indicate what background face type you prefer.
+ "Indicate what background face type you prefer.
Can be either light or dark for color screens, mono for monochrome
screens, and none if you don't use a window system and don't have
a color-capable display."
:group 'cpp)
(defcustom cpp-known-writable t
- "*Non-nil means you are allowed to modify the known conditionals."
+ "Non-nil means you are allowed to modify the known conditionals."
:type 'boolean
:group 'cpp)
(defcustom cpp-unknown-writable t
- "*Non-nil means you are allowed to modify the unknown conditionals."
+ "Non-nil means you are allowed to modify the unknown conditionals."
:type 'boolean
:group 'cpp)
;;{{{ Dependencies
-(eval-when-compile (require 'cl))
-
(require 'custom)
(require 'font-lock)
(require 'cc-mode)
:version "21.1"
:group 'faces)
-(defvar cwarn-mode nil
- "*Non-nil when Cwarn mode is active.
-
-Never set this variable directly, use the command `cwarn-mode'
-instead.")
-
(defcustom cwarn-configuration
'((c-mode (not reference))
(c++-mode t))
(if font-lock-mode (font-lock-fontify-buffer)))
;;;###autoload
-(defun turn-on-cwarn-mode ()
- "Turn on CWarn mode.
-
-This function is designed to be added to hooks, for example:
- (add-hook 'c-mode-hook 'turn-on-cwarn-mode)"
- (cwarn-mode 1))
-(make-obsolete 'turn-on-cwarn-mode 'cwarn-mode "24.1")
+(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
;;}}}
;;{{{ Help functions
:group 'languages)
(defcustom dcl-basic-offset 4
- "*Number of columns to indent a block in DCL.
+ "Number of columns to indent a block in DCL.
A block is the commands between THEN-ELSE-ENDIF and between the commands
dcl-block-begin-regexp and dcl-block-end-regexp.
(defcustom dcl-continuation-offset 6
- "*Number of columns to indent a continuation line in DCL.
+ "Number of columns to indent a continuation line in DCL.
A continuation line is a line that follows a line ending with `-'.
The meaning of this variable may be changed if
(defcustom dcl-margin-offset 8
- "*Indentation for the first command line in DCL.
+ "Indentation for the first command line in DCL.
The first command line in a file or after a SUBROUTINE statement is indented
this much. Other command lines are indented the same number of columns as
the preceding command line.
(defcustom dcl-margin-label-offset 2
- "*Number of columns to indent a margin label in DCL.
+ "Number of columns to indent a margin label in DCL.
A margin label is a label that doesn't begin or end a block, i.e. it
doesn't match dcl-block-begin-regexp or dcl-block-end-regexp."
:type 'integer
(defcustom dcl-comment-line-regexp "^\\$!"
- "*Regexp describing the start of a comment line in DCL.
+ "Regexp describing the start of a comment line in DCL.
Comment lines are not indented."
:type 'regexp
:group 'dcl)
(defcustom dcl-block-begin-regexp "loop[0-9]*:"
- "*Regexp describing a command that begins an indented block in DCL.
+ "Regexp describing a command that begins an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
:type 'regexp
:group 'dcl)
(defcustom dcl-block-end-regexp "endloop[0-9]*:"
- "*Regexp describing a command that ends an indented block in DCL.
+ "Regexp describing a command that ends an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
:type 'regexp
:group 'dcl)
(defcustom dcl-calc-command-indent-function nil
- "*Function to calculate indentation for a command line in DCL.
+ "Function to calculate indentation for a command line in DCL.
If this variable is non-nil it is called as a function:
\(func INDENT-TYPE CUR-INDENT EXTRA-INDENT LAST-POINT THIS-POINT)
(defcustom dcl-calc-cont-indent-function 'dcl-calc-cont-indent-relative
- "*Function to calculate indentation for a continuation line.
+ "Function to calculate indentation for a continuation line.
If this variable is non-nil it is called as a function:
\(func CUR-INDENT EXTRA-INDENT)
(defcustom dcl-tab-always-indent t
- "*Controls the operation of the TAB key in DCL mode.
+ "Controls the operation of the TAB key in DCL mode.
If t, pressing TAB always indents the current line.
If nil, pressing TAB indents the current line if point is at the left margin.
Data lines (i.e. lines not part of a command line or continuation line) are
(defcustom dcl-electric-characters t
- "*Non-nil means reindent immediately when a label, ELSE or ENDIF is inserted."
+ "Non-nil means reindent immediately when a label, ELSE or ENDIF is inserted."
:type 'boolean
:group 'dcl)
(defcustom dcl-tempo-comma ", "
- "*Text to insert when a comma is needed in a template, in DCL mode."
+ "Text to insert when a comma is needed in a template, in DCL mode."
:type 'string
:group 'dcl)
(defcustom dcl-tempo-left-paren "("
- "*Text to insert when a left parenthesis is needed in a template in DCL."
+ "Text to insert when a left parenthesis is needed in a template in DCL."
:type 'string
:group 'dcl)
(defcustom dcl-tempo-right-paren ")"
- "*Text to insert when a right parenthesis is needed in a template in DCL."
+ "Text to insert when a right parenthesis is needed in a template in DCL."
:type 'string
:group 'dcl)
; I couldn't decide what looked best, so I'll let you decide...
; Remember, you can also customize this with imenu-submenu-name-format.
(defcustom dcl-imenu-label-labels "Labels"
- "*Imenu menu title for sub-listing with label names."
+ "Imenu menu title for sub-listing with label names."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-goto "GOTO"
- "*Imenu menu title for sub-listing with GOTO statements."
+ "Imenu menu title for sub-listing with GOTO statements."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-gosub "GOSUB"
- "*Imenu menu title for sub-listing with GOSUB statements."
+ "Imenu menu title for sub-listing with GOSUB statements."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-call "CALL"
- "*Imenu menu title for sub-listing with CALL statements."
+ "Imenu menu title for sub-listing with CALL statements."
:type 'string
:group 'dcl)
(,dcl-imenu-label-goto "\\s-GOTO[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
(,dcl-imenu-label-gosub "\\s-GOSUB[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
(,dcl-imenu-label-call "\\s-CALL[ \t]+\\([A-Za-z0-9_\$]+\\)" 1))
- "*Default imenu generic expression for DCL.
+ "Default imenu generic expression for DCL.
The default includes SUBROUTINE labels in the main listing and
sub-listings for other labels, CALL, GOTO and GOSUB statements.
(defcustom dcl-mode-hook nil
- "*Hook called by `dcl-mode'."
+ "Hook called by `dcl-mode'."
:type 'hook
:group 'dcl)
(defcustom dcl-electric-reindent-regexps
(list "endif" "else" dcl-label-r)
- "*Regexps that can trigger an electric reindent.
+ "Regexps that can trigger an electric reindent.
A list of regexps that will trigger a reindent if the last letter
is defined as dcl-electric-character.
"True if in debug mode.")
(defcustom delphi-search-path "."
- "*Directories to search when finding external units.
+ "Directories to search when finding external units.
It is a list of directory strings. If only a single directory,
it can be a single string instead of a list. If a directory
ends in \"...\" then that directory is recursively searched."
:group 'delphi)
(defcustom delphi-indent-level 3
- "*Indentation of Delphi statements with respect to containing block.
+ "Indentation of Delphi statements with respect to containing block.
E.g.
begin
:group 'delphi)
(defcustom delphi-compound-block-indent 0
- "*Extra indentation for blocks in compound statements. E.g.
+ "Extra indentation for blocks in compound statements. E.g.
// block indent = 0 vs // block indent = 2
if b then if b then
:group 'delphi)
(defcustom delphi-case-label-indent delphi-indent-level
- "*Extra indentation for case statement labels. E.g.
+ "Extra indentation for case statement labels. E.g.
// case indent = 0 vs // case indent = 3
case value of case value of
:group 'delphi)
(defcustom delphi-verbose t ; nil
- "*If true then Delphi token processing progress is reported to the user."
+ "If true then Delphi token processing progress is reported to the user."
:type 'boolean
:group 'delphi)
(defcustom delphi-tab-always-indents t
- "*Non-nil means TAB in Delphi mode should always reindent the current line,
+ "Non-nil means TAB in Delphi mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used."
:type 'boolean
:group 'delphi)
(defcustom delphi-newline-always-indents t
- "*Non-nil means NEWLINE in Delphi mode should always reindent the current
+ "Non-nil means NEWLINE in Delphi mode should always reindent the current
line, insert a blank line and move to the default indent column of the blank
line. If nil, then no indentation occurs, and NEWLINE does the usual
behavior. This is useful when one needs to do customized indentation that
:group 'delphi)
(defcustom delphi-comment-face 'font-lock-comment-face
- "*Face used to color Delphi comments."
+ "Face used to color Delphi comments."
:type 'face
:group 'delphi)
(defcustom delphi-string-face 'font-lock-string-face
- "*Face used to color Delphi strings."
+ "Face used to color Delphi strings."
:type 'face
:group 'delphi)
(defcustom delphi-keyword-face 'font-lock-keyword-face
- "*Face used to color Delphi keywords."
+ "Face used to color Delphi keywords."
:type 'face
:group 'delphi)
(defcustom delphi-other-face nil
- "*Face used to color everything else."
+ "Face used to color everything else."
:type '(choice (const :tag "None" nil) face)
:group 'delphi)
;; example: this_is_a_valid.name, Another_EXAMPLE, mIxEd.CaSe.
;;
;;
-;; Acknowledgements
-;; ----------------
+;; Acknowledgments
+;; ---------------
;;
;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
;; with %right, %left and %prec pragmas. His suggestion was extended to deal
;;
;; This package translates an EBNF to a syntactic chart on PostScript.
;;
-;; To use ebnf2ps, insert in your ~/.emacs:
+;; To use ebnf2ps, insert in your init file:
;;
;; (require 'ebnf2ps)
;;
;;
;; To set the above options you may:
;;
-;; a) insert the code in your ~/.emacs, like:
+;; a) insert the code in your init file, like:
;;
;; (setq ebnf-terminal-shape 'bevel)
;;
;; . Optimizations...
;;
;;
-;; Acknowledgements
-;; ----------------
+;; Acknowledgments
+;; ---------------
;;
;; Thanks to Eli Zaretskii <eliz@gnu.org> for some doc fixes.
;;
;;; Interface to the command system
(defgroup postscript nil
- "PostScript Group."
+ "Printing with PostScript"
:tag "PostScript"
:version "20"
- :group 'emacs)
+ :group 'environment)
(defgroup ebnf2ps nil
(defcustom ebnf-horizontal-orientation nil
- "*Non-nil means productions are drawn horizontally."
+ "Non-nil means productions are drawn horizontally."
:type 'boolean
:version "20"
:group 'ebnf-displacement)
(defcustom ebnf-horizontal-max-height nil
- "*Non-nil means to use maximum production height in horizontal orientation.
+ "Non-nil means to use maximum production height in horizontal orientation.
It is only used when `ebnf-horizontal-orientation' is non-nil."
:type 'boolean
(defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value
- "*Specify horizontal space in points between productions.
+ "Specify horizontal space in points between productions.
Value less or equal to zero forces ebnf2ps to set a proper default value."
:type 'number
(defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value
- "*Specify vertical space in points between productions.
+ "Specify vertical space in points between productions.
Value less or equal to zero forces ebnf2ps to set a proper default value."
:type 'number
(defcustom ebnf-justify-sequence 'center
- "*Specify justification of terms in a sequence inside alternatives.
+ "Specify justification of terms in a sequence inside alternatives.
Valid values are:
(defcustom ebnf-special-show-delimiter t
- "*Non-nil means special delimiter (character `?') is shown."
+ "Non-nil means special delimiter (character `?') is shown."
:type 'boolean
:version "20"
:group 'ebnf-special)
(defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic)
- "*Specify special font.
+ "Specify special font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Special Font"
(defcustom ebnf-special-shape 'bevel
- "*Specify special box shape.
+ "Specify special box shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Special Shape"
(defcustom ebnf-special-shadow nil
- "*Non-nil means special box will have a shadow."
+ "Non-nil means special box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-special)
(defcustom ebnf-special-border-width 0.5
- "*Specify border width for special box."
+ "Specify border width for special box."
:type 'number
:version "20"
:group 'ebnf-special)
(defcustom ebnf-special-border-color "Black"
- "*Specify border color for special box."
+ "Specify border color for special box."
:type 'string
:version "20"
:group 'ebnf-special)
(defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic)
- "*Specify except font.
+ "Specify except font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Except Font"
(defcustom ebnf-except-shape 'bevel
- "*Specify except box shape.
+ "Specify except box shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Except Shape"
(defcustom ebnf-except-shadow nil
- "*Non-nil means except box will have a shadow."
+ "Non-nil means except box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-except)
(defcustom ebnf-except-border-width 0.25
- "*Specify border width for except box."
+ "Specify border width for except box."
:type 'number
:version "20"
:group 'ebnf-except)
(defcustom ebnf-except-border-color "Black"
- "*Specify border color for except box."
+ "Specify border color for except box."
:type 'string
:version "20"
:group 'ebnf-except)
(defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic)
- "*Specify repeat font.
+ "Specify repeat font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Repeat Font"
(defcustom ebnf-repeat-shape 'bevel
- "*Specify repeat box shape.
+ "Specify repeat box shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Repeat Shape"
(defcustom ebnf-repeat-shadow nil
- "*Non-nil means repeat box will have a shadow."
+ "Non-nil means repeat box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-repeat)
(defcustom ebnf-repeat-border-width 0.0
- "*Specify border width for repeat box."
+ "Specify border width for repeat box."
:type 'number
:version "20"
:group 'ebnf-repeat)
(defcustom ebnf-repeat-border-color "Black"
- "*Specify border color for repeat box."
+ "Specify border color for repeat box."
:type 'string
:version "20"
:group 'ebnf-repeat)
(defcustom ebnf-terminal-font '(7 Courier "Black" "White")
- "*Specify terminal font.
+ "Specify terminal font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Terminal Font"
(defcustom ebnf-terminal-shape 'miter
- "*Specify terminal box shape.
+ "Specify terminal box shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Terminal Shape"
(defcustom ebnf-terminal-shadow nil
- "*Non-nil means terminal box will have a shadow."
+ "Non-nil means terminal box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-terminal-border-width 1.0
- "*Specify border width for terminal box."
+ "Specify border width for terminal box."
:type 'number
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-terminal-border-color "Black"
- "*Specify border color for terminal box."
+ "Specify border color for terminal box."
:type 'string
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-production-name-p t
- "*Non-nil means production name will be printed."
+ "Non-nil means production name will be printed."
:type 'boolean
:version "20"
:group 'ebnf-production)
(defcustom ebnf-sort-production nil
- "*Specify how productions are sorted.
+ "Specify how productions are sorted.
Valid values are:
(defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold)
- "*Specify production header font.
+ "Specify production header font.
It is a list with the following form:
(defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White")
- "*Specify non-terminal font.
+ "Specify non-terminal font.
See documentation for `ebnf-production-font'."
:type '(list :tag "Non-Terminal Font"
(defcustom ebnf-non-terminal-shape 'round
- "*Specify non-terminal box shape.
+ "Specify non-terminal box shape.
Valid values are:
(defcustom ebnf-non-terminal-shadow nil
- "*Non-nil means non-terminal box will have a shadow."
+ "Non-nil means non-terminal box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-non-terminal)
(defcustom ebnf-non-terminal-border-width 1.0
- "*Specify border width for non-terminal box."
+ "Specify border width for non-terminal box."
:type 'number
:version "20"
:group 'ebnf-non-terminal)
(defcustom ebnf-non-terminal-border-color "Black"
- "*Specify border color for non-terminal box."
+ "Specify border color for non-terminal box."
:type 'string
:version "20"
:group 'ebnf-non-terminal)
(defcustom ebnf-arrow-shape 'hollow
- "*Specify the arrow shape.
+ "Specify the arrow shape.
Valid values are:
(defcustom ebnf-chart-shape 'round
- "*Specify chart flow shape.
+ "Specify chart flow shape.
See documentation for `ebnf-non-terminal-shape'."
:type '(radio :tag "Chart Flow Shape"
(defcustom ebnf-user-arrow nil
- "*Specify a sexp for user arrow shape (a PostScript code).
+ "Specify a sexp for user arrow shape (a PostScript code).
When evaluated, the sexp should return nil or a string containing PostScript
code. PostScript code should draw a right arrow.
(defcustom ebnf-syntax 'ebnf
- "*Specify syntax to be recognized.
+ "Specify syntax to be recognized.
Valid values are:
(defcustom ebnf-lex-comment-char ?\;
- "*Specify the line comment character.
+ "Specify the line comment character.
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
(defcustom ebnf-lex-eop-char ?.
- "*Specify the end of production character.
+ "Specify the end of production character.
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
(defcustom ebnf-terminal-regexp nil
- "*Specify how it's a terminal name.
+ "Specify how it's a terminal name.
If it's nil, the terminal name must be enclosed by `\"'.
If it's a string, it should be a regexp that it'll be used to determine a
(defcustom ebnf-case-fold-search nil
- "*Non-nil means ignore case on matching.
+ "Non-nil means ignore case on matching.
It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
`ebnf'."
(defcustom ebnf-iso-alternative-p nil
- "*Non-nil means use alternative ISO EBNF.
+ "Non-nil means use alternative ISO EBNF.
It's only used when `ebnf-syntax' is `iso-ebnf'.
(defcustom ebnf-iso-normalize-p nil
- "*Non-nil means normalize ISO EBNF syntax names.
+ "Non-nil means normalize ISO EBNF syntax names.
Normalize a name means that several contiguous spaces inside name become a
single space, so \"A B C\" is normalized to \"A B C\".
(defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$"
- "*Specify file name suffix that contains EBNF.
+ "Specify file name suffix that contains EBNF.
See `ebnf-eps-directory' command."
:type 'regexp
(defcustom ebnf-eps-prefix "ebnf--"
- "*Specify EPS prefix file name.
+ "Specify EPS prefix file name.
See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
:type 'string
(defcustom ebnf-eps-header-font '(11 Helvetica "Black" "White" bold)
- "*Specify EPS header font.
+ "Specify EPS header font.
See documentation for `ebnf-production-font'.
(defcustom ebnf-eps-header nil
- "*Specify EPS header.
+ "Specify EPS header.
The value should be a string, a symbol or nil.
(defcustom ebnf-eps-footer-font '(7 Helvetica "Black" "White" bold)
- "*Specify EPS footer font.
+ "Specify EPS footer font.
See documentation for `ebnf-production-font'.
(defcustom ebnf-eps-footer nil
- "*Specify EPS footer.
+ "Specify EPS footer.
The value should be a string, a symbol or nil.
(defcustom ebnf-entry-percentage 0.5 ; middle
- "*Specify entry height on alternatives.
+ "Specify entry height on alternatives.
It must be a float between 0.0 (top) and 1.0 (bottom)."
:type 'number
(defcustom ebnf-default-width 0.6
- "*Specify additional border width over default terminal, non-terminal or
+ "Specify additional border width over default terminal, non-terminal or
special."
:type 'number
:version "20"
;; Printing color requires x-color-values.
(defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
(fboundp 'color-instance-rgb-components)) ; XEmacs
- "*Non-nil means use color."
+ "Non-nil means use color."
:type 'boolean
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-line-width 1.0
- "*Specify flow line width."
+ "Specify flow line width."
:type 'number
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-line-color "Black"
- "*Specify flow line color."
+ "Specify flow line color."
:type 'string
:version "20"
:group 'ebnf2ps)
(if (eq ebnf-arrow-shape 'none)
0.0
(* (sqrt 5.0) 0.65 ebnf-line-width))
- "*Specify extra width for arrow shape drawing.
+ "Specify extra width for arrow shape drawing.
The extra width is used to avoid that the arrowhead and the terminal border
overlap. It depends on `ebnf-arrow-shape' and `ebnf-line-width'."
(defcustom ebnf-arrow-scale 1.0
- "*Specify the arrow scale.
+ "Specify the arrow scale.
Values lower than 1.0, shrink the arrow.
Values greater than 1.0, expand the arrow."
(defcustom ebnf-debug-ps nil
- "*Non-nil means to generate PostScript debug procedures.
+ "Non-nil means to generate PostScript debug procedures.
It is intended to help PostScript programmers in debugging."
:type 'boolean
(defcustom ebnf-use-float-format t
- "*Non-nil means use `%f' float format.
+ "Non-nil means use `%f' float format.
The advantage of using float format is that ebnf2ps generates a little short
PostScript file.
(defcustom ebnf-stop-on-error nil
- "*Non-nil means signal error and stop. Otherwise, signal error and continue."
+ "Non-nil means signal error and stop. Otherwise, signal error and continue."
:type 'boolean
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-yac-ignore-error-recovery nil
- "*Non-nil means ignore error recovery.
+ "Non-nil means ignore error recovery.
It's only used when `ebnf-syntax' is `yacc'."
:type 'boolean
(defcustom ebnf-ignore-empty-rule nil
- "*Non-nil means ignore empty rules.
+ "Non-nil means ignore empty rules.
It's interesting to set this variable if your Yacc/Bison grammar has a lot of
middle action rule."
(defcustom ebnf-optimize nil
- "*Non-nil means optimize syntactic chart of rules.
+ "Non-nil means optimize syntactic chart of rules.
The following optimizations are done:
(defcustom ebnf-log nil
- "*Non-nil means generate log messages.
+ "Non-nil means generate log messages.
The log messages are generated into the buffer *Ebnf2ps Log*.
These messages are intended to help debugging ebnf2ps."
(require 'ebuff-menu)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'helper))
\f
"Settings for the C++ class browser."
:group 'tools)
-
(defcustom ebrowse-search-path nil
- "*List of directories to search for source files in a class tree.
+ "List of directories to search for source files in a class tree.
Elements should be directory names; nil as an element means to try
to find source files relative to the location of the BROWSE file loaded."
:group 'ebrowse
(defcustom ebrowse-view/find-hook nil
- "*Hooks run after finding or viewing a member or class."
+ "Hooks run after finding or viewing a member or class."
:group 'ebrowse
:type 'hook)
(defcustom ebrowse-not-found-hook nil
- "*Hooks run when finding or viewing a member or class was not successful."
+ "Hooks run when finding or viewing a member or class was not successful."
:group 'ebrowse
:type 'hook)
(defcustom ebrowse-electric-list-mode-hook nil
- "*Hook called by `ebrowse-electric-position-mode'."
+ "Hook called by `ebrowse-electric-position-mode'."
:group 'ebrowse
:type 'hook)
(defcustom ebrowse-max-positions 50
- "*Number of markers saved on electric position stack."
+ "Number of markers saved on electric position stack."
:group 'ebrowse
:type 'integer)
(defcustom ebrowse-tree-mode-hook nil
- "*Hook run in each new tree buffer."
+ "Hook run in each new tree buffer."
:group 'ebrowse-tree
:type 'hook)
(defcustom ebrowse-tree-buffer-name "*Tree*"
- "*The default name of class tree buffers."
+ "The default name of class tree buffers."
:group 'ebrowse-tree
:type 'string)
(defcustom ebrowse--indentation 4
- "*The amount by which subclasses are indented in the tree."
+ "The amount by which subclasses are indented in the tree."
:group 'ebrowse-tree
:type 'integer)
(defcustom ebrowse-source-file-column 40
- "*The column in which source file names are displayed in the tree."
+ "The column in which source file names are displayed in the tree."
:group 'ebrowse-tree
:type 'integer)
(defcustom ebrowse-tree-left-margin 2
- "*Amount of space left at the left side of the tree display.
+ "Amount of space left at the left side of the tree display.
This space is used to display markers."
:group 'ebrowse-tree
:type 'integer)
(defcustom ebrowse-default-declaration-column 25
- "*The column in which member declarations are displayed in member buffers."
+ "The column in which member declarations are displayed in member buffers."
:group 'ebrowse-member
:type 'integer)
(defcustom ebrowse-default-column-width 25
- "*The width of the columns in member buffers (short display form)."
+ "The width of the columns in member buffers (short display form)."
:group 'ebrowse-member
:type 'integer)
(defcustom ebrowse-member-buffer-name "*Members*"
- "*The name of the buffer for member display."
+ "The name of the buffer for member display."
:group 'ebrowse-member
:type 'string)
(defcustom ebrowse-member-mode-hook nil
- "*Run in each new member buffer."
+ "Run in each new member buffer."
:group 'ebrowse-member
:type 'hook)
"Faces used by Ebrowse."
:group 'ebrowse)
-
(defface ebrowse-tree-mark
- '((((min-colors 88)) (:foreground "red1"))
- (t (:foreground "red")))
- "*The face used for the mark character in the tree."
+ '((((min-colors 88)) :foreground "red1")
+ (t :foreground "red"))
+ "Face for the mark character in the Ebrowse tree."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-tree-mark-face 'ebrowse-tree-mark "22.1")
-
(defface ebrowse-root-class
- '((((min-colors 88)) (:weight bold :foreground "blue1"))
- (t (:weight bold :foreground "blue")))
- "*The face used for root classes in the tree."
+ '((((min-colors 88)) :weight bold :foreground "blue1")
+ (t :weight bold :foreground "blue"))
+ "Face for root classes in the Ebrowse tree."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-root-class-face 'ebrowse-root-class "22.1")
-
-(defface ebrowse-file-name
- '((t (:italic t)))
- "*The face for filenames displayed in the tree."
+(defface ebrowse-file-name '((t :slant italic))
+ "Face for filenames in the Ebrowse tree."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-file-name-face 'ebrowse-file-name "22.1")
-
-(defface ebrowse-default
- '((t nil))
- "*Face for everything else in the tree not having other faces."
+(defface ebrowse-default '((t))
+ "Face for items in the Ebrowse tree which do not have other faces."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-default-face 'ebrowse-default "22.1")
-
(defface ebrowse-member-attribute
- '((((min-colors 88)) (:foreground "red1"))
- (t (:foreground "red")))
- "*Face used to display member attributes."
+ '((((min-colors 88)) :foreground "red1")
+ (t :foreground "red"))
+ "Face for member attributes."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-member-attribute-face
- 'ebrowse-member-attribute "22.1")
-
(defface ebrowse-member-class
- '((t (:foreground "purple")))
- "*Face used to display the class title in member buffers."
+ '((t :foreground "purple"))
+ "Face used to display the class title in member buffers."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-member-class-face
- 'ebrowse-member-class "22.1")
-
(defface ebrowse-progress
- '((((min-colors 88)) (:background "blue1"))
- (t (:background "blue")))
- "*Face for progress indicator."
+ '((((min-colors 88)) :background "blue1")
+ (t :background "blue"))
+ "Face for progress indicator."
:group 'ebrowse-faces)
-(define-obsolete-face-alias 'ebrowse-progress-face 'ebrowse-progress "22.1")
-
\f
;;; Utilities.
(defmacro ebrowse-output (&rest body)
"Eval BODY with a writable current buffer.
Preserve buffer's modified state."
+ (declare (indent 0) (debug t))
(let ((modified (make-symbol "--ebrowse-output--")))
`(let (buffer-read-only (,modified (buffer-modified-p)))
(unwind-protect
(defmacro ebrowse-ignoring-completion-case (&rest body)
"Eval BODY with `completion-ignore-case' bound to t."
+ (declare (indent 0) (debug t))
`(let ((completion-ignore-case t))
,@body))
-
(defmacro ebrowse-save-selective (&rest body)
"Eval BODY with `selective-display' restored at the end."
- (let ((var (make-symbol "var")))
- `(let ((,var selective-display))
- (unwind-protect
- (progn ,@body)
- (setq selective-display ,var)))))
-
+ (declare (indent 0) (debug t))
+ ;; FIXME: Don't use selective-display.
+ `(let ((selective-display selective-display))
+ ,@body))
(defmacro ebrowse-for-all-trees (spec &rest body)
"For all trees in SPEC, eval BODY."
+ (declare (indent 1) (debug ((sexp form) body)))
(let ((var (make-symbol "var"))
(spec-var (car spec))
(array (cadr spec)))
- `(loop for ,var being the symbols of ,array
- as ,spec-var = (get ,var 'ebrowse-root) do
- (when (vectorp ,spec-var)
- ,@body))))
+ `(cl-loop for ,var being the symbols of ,array
+ as ,spec-var = (get ,var 'ebrowse-root) do
+ (when (vectorp ,spec-var)
+ ,@body))))
;;; Set indentation for macros above.
-(put 'ebrowse-output 'lisp-indent-hook 0)
-(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
-(put 'ebrowse-save-selective 'lisp-indent-hook 0)
-(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
(defsubst ebrowse-set-face (start end face)
(ebrowse-ignoring-completion-case
(completing-read prompt table nil t initial-input)))
-
-(defun ebrowse-value-in-buffer (sym buffer)
- "Return the value of SYM in BUFFER."
- (let ((old-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-buffer buffer)
- (symbol-value sym))
- (set-buffer old-buffer))))
-
-
(defun ebrowse-rename-buffer (new-name)
"Rename current buffer to NEW-NAME.
If a buffer with name NEW-NAME already exists, delete it first."
Replace sequences of newlines with a single space."
(when (string-match "^[ \t\n\r]+" string)
(setq string (substring string (match-end 0))))
- (loop while (string-match "[\n]+" string)
- finally return string do
- (setq string (replace-match " " nil t string))))
+ (cl-loop while (string-match "[\n]+" string)
+ finally return string do
+ (setq string (replace-match " " nil t string))))
(defun ebrowse-width-of-drawable-area ()
\f
;;; Structure definitions
-(defstruct (ebrowse-hs (:type vector) :named)
+(cl-defstruct (ebrowse-hs (:type vector) :named)
"Header structure found at the head of BROWSE files."
;; A version string that is compared against the version number of
;; the Lisp package when the file is loaded. This is done to
member-table)
-(defstruct (ebrowse-ts (:type vector) :named)
+(cl-defstruct (ebrowse-ts (:type vector) :named)
"Tree structure.
Following the header structure, a BROWSE file contains a number
of `ebrowse-ts' structures, each one describing one root class of
mark)
-(defstruct (ebrowse-bs (:type vector) :named)
+(cl-defstruct (ebrowse-bs (:type vector) :named)
"Common sub-structure.
A common structure defining an occurrence of some name in the
source files."
point)
-(defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named)
+(cl-defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named)
"Class structure.
This is the structure stored in the CLASS slot of a `ebrowse-ts'
structure. It describes the location of the class declaration."
source-file)
-(defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named)
+(cl-defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named)
"Member structure.
This is the structure describing a single member. The `ebrowse-ts'
structure contains various lists for the different types of
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(when (or (not marked-only) (ebrowse-ts-mark tree))
(let ((class (ebrowse-ts-class tree)))
- (when (zerop (% (incf i) 20))
+ (when (zerop (% (cl-incf i) 20))
(ebrowse-show-progress "Preparing file list" (zerop i)))
;; Add files mentioned in class description
(let ((source-file (ebrowse-cs-source-file class))
(when file
(puthash file file files))
;; For all member lists in this class
- (loop for accessor in ebrowse-member-list-accessors do
- (loop for m in (funcall accessor tree)
- for file = (ebrowse-ms-file m)
- for def-file = (ebrowse-ms-definition-file m) do
- (when file
- (puthash file file files))
- (when def-file
- (puthash def-file def-file files))))))))
+ (dolist (accessor ebrowse-member-list-accessors)
+ (cl-loop for m in (funcall accessor tree)
+ for file = (ebrowse-ms-file m)
+ for def-file = (ebrowse-ms-definition-file m) do
+ (when file
+ (puthash file file files))
+ (when def-file
+ (puthash def-file def-file files))))))))
files))
list))
-(defun* ebrowse-marked-classes-p ()
+(cl-defun ebrowse-marked-classes-p ()
"Value is non-nil if any class in the current class tree is marked."
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(when (ebrowse-ts-mark tree)
- (return-from ebrowse-marked-classes-p tree))))
+ (cl-return-from ebrowse-marked-classes-p tree))))
(defsubst ebrowse-globals-tree-p (tree)
(if qualified-names-p
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(setq alist
- (acons (ebrowse-qualified-class-name (ebrowse-ts-class tree))
- tree alist)))
+ (cl-acons (ebrowse-qualified-class-name
+ (ebrowse-ts-class tree))
+ tree alist)))
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(setq alist
- (acons (ebrowse-cs-name (ebrowse-ts-class tree))
- tree alist))))
+ (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree))
+ tree alist))))
alist))
computes this information lazily."
(or (ebrowse-ts-base-classes tree)
(setf (ebrowse-ts-base-classes tree)
- (loop with to-search = (list tree)
- with result = nil
- as search = (pop to-search)
- while search finally return result
- do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
- (when (memq search (ebrowse-ts-subclasses ti))
- (unless (memq ti result)
- (setq result (nconc result (list ti))))
- (push ti to-search)))))))
+ (cl-loop with to-search = (list tree)
+ with result = nil
+ as search = (pop to-search)
+ while search finally return result
+ do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
+ (when (memq search (ebrowse-ts-subclasses ti))
+ (unless (memq ti result)
+ (setq result (nconc result (list ti))))
+ (push ti to-search)))))))
(defun ebrowse-direct-base-classes (tree)
ACCESSOR is the accessor function for the member list.
Elements of the result have the form (NAME . ACCESSOR), where NAME
is the member name."
- (loop for member in (funcall accessor tree)
- collect (cons (ebrowse-ms-name member) accessor)))
+ (cl-loop for member in (funcall accessor tree)
+ collect (cons (ebrowse-ms-name member) accessor)))
(defun ebrowse-name/accessor-alist-for-visible-members ()
ebrowse--accessor)))
(if ebrowse--show-inherited-flag
(nconc list
- (loop for tree in (ebrowse-base-classes
- ebrowse--displayed-class)
- nconc (ebrowse-name/accessor-alist
- tree ebrowse--accessor)))
+ (cl-loop for tree in (ebrowse-base-classes
+ ebrowse--displayed-class)
+ nconc (ebrowse-name/accessor-alist
+ tree ebrowse--accessor)))
list)))
See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and
NOCONFIRM."
(when (or noconfirm (yes-or-no-p "Revert tree from disk? "))
- (loop for member-buffer in (ebrowse-same-tree-member-buffer-list)
- do (kill-buffer member-buffer))
+ (mapc #'kill-buffer (ebrowse-same-tree-member-buffer-list))
(erase-buffer)
(with-no-warnings
(insert-file (or buffer-file-name ebrowse--tags-file-name)))
ebrowse--frozen-flag nil)
(ebrowse-redraw-tree)
(set-buffer-modified-p nil)
- (case pop
- (switch (switch-to-buffer name))
- (pop (pop-to-buffer name)))
+ (pcase pop
+ (`switch (switch-to-buffer name))
+ (`pop (pop-to-buffer name)))
(current-buffer)))
(garbage-collect)
;; For all classes...
(ebrowse-for-all-trees (c ebrowse--tree-obarray)
- (when (zerop (% (incf i) 10))
+ (when (zerop (% (cl-incf i) 10))
(ebrowse-show-progress "Preparing member lookup" (zerop i)))
- (loop for f in ebrowse-member-list-accessors do
- (loop for m in (funcall f c) do
- (let* ((member-name (ebrowse-ms-name m))
- (value (gethash member-name members)))
- (push (list c f m) value)
- (puthash member-name value members)))))
+ (dolist (f ebrowse-member-list-accessors)
+ (dolist (m (funcall f c))
+ (let* ((member-name (ebrowse-ms-name m))
+ (value (gethash member-name members)))
+ (push (list c f m) value)
+ (puthash member-name value members)))))
(setf (ebrowse-hs-member-table ebrowse--header) members)))
"Return the member obarray. Build it if it hasn't been set up yet.
HEADER is the tree header structure of the class tree."
(when (null (ebrowse-hs-member-table header))
- (loop for buffer in (ebrowse-browser-buffer-list)
- until (eq header (ebrowse-value-in-buffer 'ebrowse--header buffer))
- finally do
- (with-current-buffer buffer
- (ebrowse-fill-member-table))))
+ (cl-loop for buffer in (ebrowse-browser-buffer-list)
+ until (eq header (buffer-local-value 'ebrowse--header buffer))
+ finally do
+ (with-current-buffer buffer
+ (ebrowse-fill-member-table))))
(ebrowse-hs-member-table header))
Build obarray of all classes in TREE."
(let ((classes (make-vector 127 0)))
;; Add root classes...
- (loop for root in tree
- as sym =
- (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) classes)
- do (unless (get sym 'ebrowse-root)
- (setf (get sym 'ebrowse-root) root)))
+ (cl-loop for root in tree
+ as sym =
+ (intern (ebrowse-qualified-class-name (ebrowse-ts-class root))
+ classes)
+ do (unless (get sym 'ebrowse-root)
+ (setf (get sym 'ebrowse-root) root)))
;; Process subclasses
(ebrowse-insert-supers tree classes)
classes))
We have to be cautious here not to end up in an infinite recursion
if for some reason a circle is in the inheritance graph."
- (loop for class in tree
- as subclasses = (ebrowse-ts-subclasses class) do
- ;; Make sure every class is represented by a unique object
- (loop for subclass on subclasses
- as sym = (intern
- (ebrowse-qualified-class-name (ebrowse-ts-class (car subclass)))
- classes)
- as next = nil
- do
- ;; Replace the subclass tree with the one found in
- ;; CLASSES if there is already an entry for that class
- ;; in it. Otherwise make a new entry.
- ;;
- ;; CAVEAT: If by some means (e.g., use of the
- ;; preprocessor in class declarations, a name is marked
- ;; as a subclass of itself on some path, we would end up
- ;; in an endless loop. We have to omit subclasses from
- ;; the recursion that already have been processed.
- (if (get sym 'ebrowse-root)
- (setf (car subclass) (get sym 'ebrowse-root))
- (setf (get sym 'ebrowse-root) (car subclass))))
- ;; Process subclasses
- (ebrowse-insert-supers subclasses classes)))
+ (cl-loop for class in tree
+ as subclasses = (ebrowse-ts-subclasses class) do
+ ;; Make sure every class is represented by a unique object
+ (cl-loop for subclass on subclasses
+ as sym = (intern
+ (ebrowse-qualified-class-name
+ (ebrowse-ts-class (car subclass)))
+ classes)
+ as next = nil
+ do
+ ;; Replace the subclass tree with the one found in
+ ;; CLASSES if there is already an entry for that class
+ ;; in it. Otherwise make a new entry.
+ ;;
+ ;; CAVEAT: If by some means (e.g., use of the
+ ;; preprocessor in class declarations, a name is marked
+ ;; as a subclass of itself on some path, we would end up
+ ;; in an endless loop. We have to omit subclasses from
+ ;; the recursion that already have been processed.
+ (if (get sym 'ebrowse-root)
+ (setf (car subclass) (get sym 'ebrowse-root))
+ (setf (get sym 'ebrowse-root) (car subclass))))
+ ;; Process subclasses
+ (ebrowse-insert-supers subclasses classes)))
\f
;;; Tree buffers
(unless (zerop (buffer-size))
(goto-char (point-min))
- (multiple-value-setq (header tree) (values-list (ebrowse-read)))
+ (cl-multiple-value-setq (header tree) (cl-values-list (ebrowse-read)))
(message "Sorting. Please be patient...")
(setq tree (ebrowse-sort-tree-list tree))
(erase-buffer)
;; Get the classes whose mark must be toggled. Note that
;; ebrowse-tree-at-point might issue an error.
(ignore-errors
- (loop repeat (or n-times 1)
- as tree = (ebrowse-tree-at-point)
- do (progn
- (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree)))
- (forward-line 1)
- (push tree to-change))))
+ (cl-loop repeat (or n-times 1)
+ as tree = (ebrowse-tree-at-point)
+ do (progn
+ (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree)))
+ (forward-line 1)
+ (push tree to-change))))
(save-excursion
;; For all these classes, reverse the mark char in the display
;; by a regexp replace over the whole buffer. The reason for this
;; is that classes might have multiple base classes. If this is
;; the case, they are displayed more than once in the tree.
(ebrowse-output
- (loop for tree in to-change
- as regexp = (concat "^.*\\b"
- (regexp-quote
- (ebrowse-cs-name (ebrowse-ts-class tree)))
- "\\b")
- do
- (goto-char (point-min))
- (loop while (re-search-forward regexp nil t)
- do (progn
- (goto-char (match-beginning 0))
- (delete-char 1)
- (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1)
- (ebrowse-set-mark-props (1- (point)) (point) tree)
- (goto-char (match-end 0)))))))))
+ (cl-loop
+ for tree in to-change
+ as regexp = (concat "^.*\\b"
+ (regexp-quote
+ (ebrowse-cs-name (ebrowse-ts-class tree)))
+ "\\b")
+ do
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (goto-char (match-beginning 0))
+ (delete-char 1)
+ (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1)
+ (ebrowse-set-mark-props (1- (point)) (point) tree)
+ (goto-char (match-end 0))))))))
(defun ebrowse-mark-all-classes (prefix)
(set (make-hash-table))
result)
(dolist (buffer buffers)
- (let ((tree (ebrowse-value-in-buffer 'ebrowse--tree buffer)))
+ (let ((tree (buffer-local-value 'ebrowse--tree buffer)))
(unless (gethash tree set)
(push buffer result))
(puthash tree t set)))
"Return a list of members buffers with same tree as current buffer."
(ebrowse-delete-if-not
(lambda (buffer)
- (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer)
+ (eq (buffer-local-value 'ebrowse--tree buffer)
ebrowse--tree))
(ebrowse-member-buffer-list)))
Switch to buffer if prefix ARG.
If no member buffer exists, make one."
(interactive "P")
- (let ((buf (or (first (ebrowse-same-tree-member-buffer-list))
+ (let ((buf (or (cl-first (ebrowse-same-tree-member-buffer-list))
(get-buffer ebrowse-member-buffer-name)
(ebrowse-tree-command:show-member-functions))))
(when buf
(defun ebrowse-kill-member-buffers-displaying (tree)
"Kill all member buffers displaying TREE."
- (loop for buffer in (ebrowse-member-buffer-list)
- as class = (ebrowse-value-in-buffer 'ebrowse--displayed-class buffer)
- when (eq class tree) do (kill-buffer buffer)))
+ (cl-loop for buffer in (ebrowse-member-buffer-list)
+ as class = (buffer-local-value 'ebrowse--displayed-class buffer)
+ when (eq class tree) do (kill-buffer buffer)))
(defun ebrowse-frozen-tree-buffer-name (tags-file)
(int-to-string ebrowse--indentation)
"): ")
nil nil ebrowse--indentation))))
- (when (plusp width)
+ (when (cl-plusp width)
(set (make-local-variable 'ebrowse--indentation) width)
(ebrowse-redraw-tree))))
(error "Not on a class")))
-(defun* ebrowse-view/find-class-declaration (&key view where)
+(cl-defun ebrowse-view/find-class-declaration (&key view where)
"View or find the declarator of the class point is on.
VIEW non-nil means view it. WHERE is additional position info."
(let* ((class (ebrowse-ts-class (ebrowse-tree-at-point)))
exit-action ebrowse--view-exit-action))
;; Delete the frame in which we viewed.
(mapc 'delete-frame
- (loop for frame in (frame-list)
- when (not (assq frame original-frame-configuration))
- collect frame))
+ (cl-loop for frame in (frame-list)
+ when (not (assq frame original-frame-configuration))
+ collect frame))
(when exit-action
(funcall exit-action buffer))))
(unless (boundp 'view-mode-hook)
(setq view-mode-hook nil))
(push 'ebrowse-find-pattern view-mode-hook)
- (case where
- (other-window (view-file-other-window file))
- (other-frame (ebrowse-view-file-other-frame file))
- (t (view-file file))))
+ (pcase where
+ (`other-window (view-file-other-window file))
+ (`other-frame (ebrowse-view-file-other-frame file))
+ (_ (view-file file))))
(t
- (case where
- (other-window (find-file-other-window file))
- (other-frame (find-file-other-frame file))
- (t (find-file file)))
+ (pcase where
+ (`other-window (find-file-other-window file))
+ (`other-frame (find-file-other-frame file))
+ (_ (find-file file)))
(ebrowse-find-pattern struc info))))
which may contain whitespace. For these symbols, replace white
space in the symbol name (generated by BROWSE) with a regular
expression matching any number of whitespace characters."
- (loop with regexp = (regexp-quote name)
- with start = 0
- finally return regexp
- while (string-match "[ \t]+" regexp start)
- do (setq regexp (concat (substring regexp 0 (match-beginning 0))
- "[ \t]*"
- (substring regexp (match-end 0)))
- start (+ (match-beginning 0) 5))))
+ (cl-loop with regexp = (regexp-quote name)
+ with start = 0
+ finally return regexp
+ while (string-match "[ \t]+" regexp start)
+ do (setq regexp (concat (substring regexp 0 (match-beginning 0))
+ "[ \t]*"
+ (substring regexp (match-end 0)))
+ start (+ (match-beginning 0) 5))))
(defun ebrowse-class-declaration-regexp (name)
(concat "^[ \t]*#[ \t]*define[ \t]+" (regexp-quote name)))
-(defun* ebrowse-find-pattern (&optional position info &aux viewing)
+(cl-defun ebrowse-find-pattern (&optional position info &aux viewing)
"Find a pattern.
This is a kluge: Ebrowse allows you to find or view a file containing
(start (ebrowse-bs-point position))
(offset 100)
found)
- (destructuring-bind (header class-or-member member-list) info
+ (pcase-let ((`(,header ,class-or-member ,member-list) info))
;; If no pattern is specified, construct one from the member name.
(when (stringp pattern)
(setq pattern (concat "^.*" (regexp-quote pattern))))
;; Construct a regular expression if none given.
(unless pattern
- (typecase class-or-member
+ (cl-typecase class-or-member
(ebrowse-ms
- (case member-list
- ((ebrowse-ts-member-variables
- ebrowse-ts-static-variables
- ebrowse-ts-types)
- (setf pattern (ebrowse-variable-declaration-regexp
- (ebrowse-bs-name position))))
- (otherwise
- (if (ebrowse-define-p class-or-member)
- (setf pattern (ebrowse-pp-define-regexp (ebrowse-bs-name position)))
- (setf pattern (ebrowse-function-declaration/definition-regexp
- (ebrowse-bs-name position)))))))
+ (setf pattern
+ (pcase member-list
+ ((or `ebrowse-ts-member-variables
+ `ebrowse-ts-static-variables
+ `ebrowse-ts-types)
+ (ebrowse-variable-declaration-regexp
+ (ebrowse-bs-name position)))
+ (_
+ (if (ebrowse-define-p class-or-member)
+ (ebrowse-pp-define-regexp (ebrowse-bs-name position))
+ (ebrowse-function-declaration/definition-regexp
+ (ebrowse-bs-name position)))))))
(ebrowse-cs
(setf pattern (ebrowse-class-declaration-regexp
(ebrowse-bs-name position))))))
(y-or-n-p (format "start = %d? " start))
(y-or-n-p pattern))
(setf found
- (loop do (goto-char (max (point-min) (- start offset)))
- when (re-search-forward pattern (+ start offset) t) return t
- never (bobp)
- do (incf offset offset)))
+ (cl-loop do (goto-char (max (point-min) (- start offset)))
+ when (re-search-forward pattern (+ start offset) t)
+ return t
+ never (bobp)
+ do (cl-incf offset offset)))
(cond (found
(beginning-of-line)
(run-hooks 'ebrowse-view/find-hook))
(ebrowse-set-face start end 'ebrowse-tree-mark))
-(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start)
+(cl-defun ebrowse-draw-tree-fn (&aux stack1 stack2 start)
"Display a single class and recursively its subclasses.
This function may look weird, but this is faster than recursion."
(setq stack1 (make-list (length ebrowse--tree) 0)
stack2 (copy-sequence ebrowse--tree))
- (loop while stack2
- as level = (pop stack1)
- as tree = (pop stack2)
- as class = (ebrowse-ts-class tree) do
- (let ((start-of-line (point))
- start-of-class-name end-of-class-name)
- ;; Insert mark
- (insert (if (ebrowse-ts-mark tree) ">" " "))
-
- ;; Indent and insert class name
- (indent-to (+ (* level ebrowse--indentation)
- ebrowse-tree-left-margin))
- (setq start (point))
- (insert (ebrowse-qualified-class-name class))
-
- ;; If template class, add <>
- (when (ebrowse-template-p class)
- (insert "<>"))
- (ebrowse-set-face start (point) (if (zerop level)
- 'ebrowse-root-class
- 'ebrowse-default))
- (setf start-of-class-name start
- end-of-class-name (point))
- ;; If filenames are to be displayed...
- (when ebrowse--show-file-names-flag
- (indent-to ebrowse-source-file-column)
- (setq start (point))
- (insert "("
- (or (ebrowse-cs-file class)
- "unknown")
- ")")
- (ebrowse-set-face start (point) 'ebrowse-file-name))
- (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
- (add-text-properties
- start-of-class-name end-of-class-name
- `(mouse-face highlight ebrowse-what class-name
- ebrowse-tree ,tree
- help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu"))
- (insert "\n"))
- ;; Push subclasses, if any.
- (when (ebrowse-ts-subclasses tree)
- (setq stack2
- (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2)
- stack1
- (nconc (make-list (length (ebrowse-ts-subclasses tree))
- (1+ level)) stack1)))))
+ (cl-loop while stack2
+ as level = (pop stack1)
+ as tree = (pop stack2)
+ as class = (ebrowse-ts-class tree) do
+ (let ((start-of-line (point))
+ start-of-class-name end-of-class-name)
+ ;; Insert mark
+ (insert (if (ebrowse-ts-mark tree) ">" " "))
+
+ ;; Indent and insert class name
+ (indent-to (+ (* level ebrowse--indentation)
+ ebrowse-tree-left-margin))
+ (setq start (point))
+ (insert (ebrowse-qualified-class-name class))
+
+ ;; If template class, add <>
+ (when (ebrowse-template-p class)
+ (insert "<>"))
+ (ebrowse-set-face start (point) (if (zerop level)
+ 'ebrowse-root-class
+ 'ebrowse-default))
+ (setf start-of-class-name start
+ end-of-class-name (point))
+ ;; If filenames are to be displayed...
+ (when ebrowse--show-file-names-flag
+ (indent-to ebrowse-source-file-column)
+ (setq start (point))
+ (insert "("
+ (or (ebrowse-cs-file class)
+ "unknown")
+ ")")
+ (ebrowse-set-face start (point) 'ebrowse-file-name))
+ (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
+ (add-text-properties
+ start-of-class-name end-of-class-name
+ `(mouse-face highlight ebrowse-what class-name
+ ebrowse-tree ,tree
+ help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu"))
+ (insert "\n"))
+ ;; Push subclasses, if any.
+ (when (ebrowse-ts-subclasses tree)
+ (setq stack2
+ (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2)
+ stack1
+ (nconc (make-list (length (ebrowse-ts-subclasses tree))
+ (1+ level)) stack1)))))
\f
"Read a browser buffer name from the minibuffer and return that buffer."
(let* ((buffers (ebrowse-known-class-trees-buffer-list)))
(if buffers
- (if (not (second buffers))
- (first buffers)
+ (if (not (cl-second buffers))
+ (cl-first buffers)
(or (ebrowse-electric-choose-tree) (error "No tree buffer")))
(let* ((insert-default-directory t)
(file (read-file-name "Find tree: " nil nil t)))
ebrowse--decl-column
ebrowse--column-width))
"): ")))))
- (when (plusp width)
+ (when (cl-plusp width)
(if ebrowse--long-display-flag
(setq ebrowse--decl-column width)
(setq ebrowse--column-width width))
(let ((index (ebrowse-position ebrowse--accessor
ebrowse-member-list-accessors)))
(setf ebrowse--accessor
- (cond ((plusp incr)
+ (cond ((cl-plusp incr)
(or (nth (1+ index)
ebrowse-member-list-accessors)
- (first ebrowse-member-list-accessors)))
- ((minusp incr)
- (or (and (>= (decf index) 0)
+ (cl-first ebrowse-member-list-accessors)))
+ ((cl-minusp incr)
+ (or (and (>= (cl-decf index) 0)
(nth index
ebrowse-member-list-accessors))
- (first (last ebrowse-member-list-accessors))))))
+ (cl-first (last ebrowse-member-list-accessors))))))
(ebrowse-display-member-list-for-accessor ebrowse--accessor)))
(ebrowse-view/find-member-declaration/definition prefix t))
-(defun* ebrowse-view/find-member-declaration/definition
+(cl-defun ebrowse-view/find-member-declaration/definition
(prefix view &optional definition info header tags-file)
"Find or view a member declaration or definition.
With PREFIX 4. find file in another window, with prefix 5
;; If not given as parameters, get the necessary information
;; out of the member buffer.
(if info
- (setq tree (first info)
- accessor (second info)
- member (third info))
- (multiple-value-setq (tree member on-class)
- (values-list (ebrowse-member-info-from-point)))
+ (setq tree (cl-first info)
+ accessor (cl-second info)
+ member (cl-third info))
+ (cl-multiple-value-setq (tree member on-class)
+ (cl-values-list (ebrowse-member-info-from-point)))
(setq accessor ebrowse--accessor))
;; View/find class if on a line containing a class name.
(when on-class
- (return-from ebrowse-view/find-member-declaration/definition
+ (cl-return-from ebrowse-view/find-member-declaration/definition
(ebrowse-view/find-file-and-search-pattern
(ebrowse-ts-class tree)
(list ebrowse--header (ebrowse-ts-class tree) nil)
mouse-face highlight
ebrowse-tree ,tree
help-echo "mouse-2: view definition; mouse-3: menu"))
- (incf i)
+ (cl-incf i)
(when (>= i ebrowse--n-columns)
(setf i 0)
(insert "\n")))))
- (when (plusp i)
+ (when (cl-plusp i)
(insert "\n"))
(goto-char (point-min))))
(error "Not found"))))
-(defun* ebrowse-move-point-to-member (name &optional count &aux member)
+(cl-defun ebrowse-move-point-to-member (name &optional count &aux member)
"Set point on member NAME in the member buffer
COUNT, if specified, says search the COUNT'th member with the same name."
(goto-char (point-min))
"Switch member buffer to a class read from the minibuffer.
Use TITLE as minibuffer prompt.
COMPL-LIST is a completion list to use."
- (let* ((initial (unless (second compl-list)
- (first (first compl-list))))
+ (let* ((initial (unless (cl-second compl-list)
+ (cl-first (cl-first compl-list))))
(class (or (ebrowse-completing-read-value title compl-list initial)
(error "Not found"))))
(setf ebrowse--displayed-class class
(interactive "P")
(let ((supers (or (ebrowse-direct-base-classes ebrowse--displayed-class)
(error "No base classes"))))
- (if (and arg (second supers))
- (let ((alist (loop for s in supers
- collect (cons (ebrowse-qualified-class-name
- (ebrowse-ts-class s))
- s))))
+ (if (and arg (cl-second supers))
+ (let ((alist (cl-loop for s in supers
+ collect (cons (ebrowse-qualified-class-name
+ (ebrowse-ts-class s))
+ s))))
(ebrowse-switch-member-buffer-to-other-class
"Goto base class: " alist))
- (setq ebrowse--displayed-class (first supers)
+ (setq ebrowse--displayed-class (cl-first supers)
ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer))))
(let ((containing-list ebrowse--tree)
index cls
(supers (ebrowse-direct-base-classes ebrowse--displayed-class)))
- (flet ((trees-alist (trees)
- (loop for tr in trees
- collect (cons (ebrowse-cs-name
- (ebrowse-ts-class tr)) tr))))
+ (cl-flet ((trees-alist (trees)
+ (cl-loop for tr in trees
+ collect (cons (ebrowse-cs-name
+ (ebrowse-ts-class tr))
+ tr))))
(when supers
- (let ((tree (if (second supers)
+ (let ((tree (if (cl-second supers)
(ebrowse-completing-read-value
"Relative to base class: "
(trees-alist supers) nil)
- (first supers))))
+ (cl-first supers))))
(unless tree (error "Not found"))
(setq containing-list (ebrowse-ts-subclasses tree)))))
(setq index (+ inc (ebrowse-position ebrowse--displayed-class
containing-list)))
- (cond ((minusp index) (message "No previous class"))
+ (cond ((cl-minusp index) (message "No previous class"))
((null (nth index containing-list)) (message "No next class")))
(setq index (max 0 (min index (1- (length containing-list)))))
(setq cls (nth index containing-list))
Prefix arg ARG says which class should be displayed. Default is
the first derived class."
(interactive "P")
- (flet ((ebrowse-tree-obarray-as-alist ()
- (loop for s in (ebrowse-ts-subclasses
- ebrowse--displayed-class)
- collect (cons (ebrowse-cs-name
- (ebrowse-ts-class s)) s))))
+ (cl-flet ((ebrowse-tree-obarray-as-alist ()
+ (cl-loop for s in (ebrowse-ts-subclasses
+ ebrowse--displayed-class)
+ collect (cons (ebrowse-cs-name
+ (ebrowse-ts-class s)) s))))
(let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
(error "No derived classes"))))
- (if (and arg (second subs))
+ (if (and arg (cl-second subs))
(ebrowse-switch-member-buffer-to-other-class
"Goto derived class: " (ebrowse-tree-obarray-as-alist))
- (setq ebrowse--displayed-class (first subs)
+ (setq ebrowse--displayed-class (cl-first subs)
ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))))
EVENT is the mouse event."
(interactive "e")
(mouse-set-point event)
- (case (event-click-count event)
+ (pcase (event-click-count event)
(2 (ebrowse-find-member-definition))
- (1 (case (get-text-property (posn-point (event-start event))
- 'ebrowse-what)
- (member-name
+ (1 (pcase (get-text-property (posn-point (event-start event))
+ 'ebrowse-what)
+ (`member-name
(ebrowse-popup-menu ebrowse-member-name-object-menu event))
- (class-name
+ (`class-name
(ebrowse-popup-menu ebrowse-member-class-name-object-menu event))
- (t
+ (_
(ebrowse-popup-menu ebrowse-member-buffer-object-menu event))))))
EVENT is the mouse event."
(interactive "e")
(mouse-set-point event)
- (case (event-click-count event)
+ (pcase (event-click-count event)
(2 (ebrowse-find-member-definition))
- (1 (case (get-text-property (posn-point (event-start event))
+ (1 (pcase (get-text-property (posn-point (event-start event))
'ebrowse-what)
- (member-name
+ (`member-name
(ebrowse-view-member-definition 0))))))
alist)
(when name
(dolist (info (gethash name table) alist)
- (unless (memq (first info) known-classes)
- (setf alist (acons (ebrowse-qualified-class-name
- (ebrowse-ts-class (first info)))
- info alist)
- known-classes (cons (first info) known-classes)))))))
+ (unless (memq (cl-first info) known-classes)
+ (setf alist (cl-acons (ebrowse-qualified-class-name
+ (ebrowse-ts-class (cl-first info)))
+ info alist)
+ known-classes (cons (cl-first info) known-classes)))))))
(defun ebrowse-choose-tree ()
the class tree, HEADER the header structure of the tree, and BUFFER
being the tree or member buffer containing the tree."
(let* ((buffer (ebrowse-choose-from-browser-buffers)))
- (if buffer (list (ebrowse-value-in-buffer 'ebrowse--tree buffer)
- (ebrowse-value-in-buffer 'ebrowse--header buffer)
+ (if buffer (list (buffer-local-value 'ebrowse--tree buffer)
+ (buffer-local-value 'ebrowse--header buffer)
buffer))))
from point as default. Value is a list (CLASS-NAME MEMBER-NAME)."
(save-excursion
(let ((members (ebrowse-member-table header)))
- (multiple-value-bind (class-name member-name)
- (values-list (ebrowse-tags-read-member+class-name))
+ (cl-multiple-value-bind (class-name member-name)
+ (cl-values-list (ebrowse-tags-read-member+class-name))
(unless member-name
(error "No member name at point"))
(if members
(unless (gethash name members)
(if (y-or-n-p "No exact match found. Try substrings? ")
(setq name
- (or (first (ebrowse-list-of-matching-members
+ (or (cl-first (ebrowse-list-of-matching-members
members (regexp-quote name) name))
(error "Sorry, nothing found")))
(error "Canceled")))
(let ((alist (or (ebrowse-class-alist-for-member header name)
(error "No classes with member `%s' found" name))))
(ebrowse-ignoring-completion-case
- (if (null (second alist))
- (cdr (first alist))
+ (if (null (cl-second alist))
+ (cdr (cl-first alist))
(push ?\? unread-command-events)
(cdr (assoc (completing-read "In class: "
alist nil t initial-class-name)
alist))))))
-(defun* ebrowse-tags-view/find-member-decl/defn
+(cl-defun ebrowse-tags-view/find-member-decl/defn
(prefix &key view definition member-name)
"If VIEW is t, view, else find an occurrence of MEMBER-NAME.
the user choose the class to use. As a last step, a tags search
is performed that positions point on the member declaration or
definition."
- (multiple-value-bind
- (tree header tree-buffer) (values-list (ebrowse-choose-tree))
+ (cl-multiple-value-bind
+ (tree header tree-buffer) (cl-values-list (ebrowse-choose-tree))
(unless tree (error "No class tree"))
(let* ((marker (point-marker))
class-name
(name member-name)
info)
(unless name
- (multiple-value-setq (class-name name)
- (values-list
+ (cl-multiple-value-setq (class-name name)
+ (cl-values-list
(ebrowse-tags-read-name
header
(concat (if view "View" "Find") " member "
(ebrowse-view/find-member-declaration/definition
prefix view definition info
header
- (ebrowse-value-in-buffer 'ebrowse--tags-file-name tree-buffer))
+ (buffer-local-value 'ebrowse--tags-file-name tree-buffer))
;; Record position jumped to
(ebrowse-push-position (point-marker) info t))))
(cond ((null buffer)
(set-buffer tree-buffer)
(switch-to-buffer (ebrowse-display-member-buffer
- (second info) nil (first info))))
+ (cl-second info) nil (cl-first info))))
(t
(switch-to-buffer buffer)
- (setq ebrowse--displayed-class (first info)
- ebrowse--accessor (second info)
+ (setq ebrowse--displayed-class (cl-first info)
+ ebrowse--accessor (cl-second info)
ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))
- (ebrowse-move-point-to-member (ebrowse-ms-name (third info)))))
+ (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info)))))
(defun ebrowse-tags-display-member-buffer (&optional fix-name)
FIX-NAME non-nil means display the buffer for that member.
Otherwise read a member name from point."
(interactive)
- (multiple-value-bind
- (tree header tree-buffer) (values-list (ebrowse-choose-tree))
+ (cl-multiple-value-bind
+ (tree header tree-buffer) (cl-values-list (ebrowse-choose-tree))
(unless tree (error "No class tree"))
(let* ((marker (point-marker)) class-name (name fix-name) info)
(unless name
- (multiple-value-setq (class-name name)
- (values-list
+ (cl-multiple-value-setq (class-name name)
+ (cl-values-list
(ebrowse-tags-read-name header
(concat "Find member list of: ")))))
(setq info (ebrowse-tags-choose-class tree header name class-name))
(interactive)
(let* ((buffer (or (ebrowse-choose-from-browser-buffers)
(error "No tree buffer")))
- (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
+ (header (buffer-local-value 'ebrowse--header buffer))
(members (ebrowse-member-table header))
temp-buffer-setup-hook
(regexp (read-from-minibuffer "List members matching regexp: ")))
(set-buffer standard-output)
(erase-buffer)
(insert "Members matching `" regexp "'\n\n")
- (loop for s in (ebrowse-list-of-matching-members members regexp) do
- (loop for info in (gethash s members) do
- (ebrowse-draw-file-member-info info))))))
+ (cl-loop for s in (ebrowse-list-of-matching-members members regexp) do
+ (cl-loop for info in (gethash s members) do
+ (ebrowse-draw-file-member-info info))))))
(defun ebrowse-tags-list-members-in-file ()
(error "No tree buffer")))
(files (with-current-buffer buffer (ebrowse-files-table)))
(file (completing-read "List members in file: " files nil t))
- (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
+ (header (buffer-local-value 'ebrowse--header buffer))
temp-buffer-setup-hook
(members (ebrowse-member-table header)))
(with-output-to-temp-buffer (concat "*Members in file " file "*")
(set-buffer standard-output)
(maphash
(lambda (_member-name list)
- (loop for info in list
- as member = (third info)
- as class = (ebrowse-ts-class (first info))
- when (or (and (null (ebrowse-ms-file member))
- (string= (ebrowse-cs-file class) file))
- (string= file (ebrowse-ms-file member)))
- do (ebrowse-draw-file-member-info info "decl.")
- when (or (and (null (ebrowse-ms-definition-file member))
- (string= (ebrowse-cs-source-file class) file))
- (string= file (ebrowse-ms-definition-file member)))
- do (ebrowse-draw-file-member-info info "defn.")))
+ (cl-loop for info in list
+ as member = (cl-third info)
+ as class = (ebrowse-ts-class (cl-first info))
+ when (or (and (null (ebrowse-ms-file member))
+ (string= (ebrowse-cs-file class) file))
+ (string= file (ebrowse-ms-file member)))
+ do (ebrowse-draw-file-member-info info "decl.")
+ when (or (and (null (ebrowse-ms-definition-file member))
+ (string= (ebrowse-cs-source-file class) file))
+ (string= file (ebrowse-ms-definition-file member)))
+ do (ebrowse-draw-file-member-info info "defn.")))
members))))
-(defun* ebrowse-draw-file-member-info (info &optional (kind ""))
+(cl-defun ebrowse-draw-file-member-info (info &optional (kind ""))
"Display a line in the members info buffer.
INFO describes the member. It has the form (TREE ACCESSOR MEMBER).
TREE is the class of the member to display.
ACCESSOR is the accessor symbol of its member list.
MEMBER is the member structure.
KIND is an additional string printed in the buffer."
- (let* ((tree (first info))
+ (let* ((tree (cl-first info))
(globals-p (ebrowse-globals-tree-p tree)))
(unless globals-p
(insert (ebrowse-cs-name (ebrowse-ts-class tree))))
- (insert "::" (ebrowse-ms-name (third info)))
+ (insert "::" (ebrowse-ms-name (cl-third info)))
(indent-to 40)
(insert kind)
(indent-to 50)
- (insert (case (second info)
- (ebrowse-ts-member-functions "member function")
- (ebrowse-ts-member-variables "member variable")
- (ebrowse-ts-static-functions "static function")
- (ebrowse-ts-static-variables "static variable")
- (ebrowse-ts-friends (if globals-p "define" "friend"))
- (ebrowse-ts-types "type")
- (t "unknown"))
+ (insert (pcase (cl-second info)
+ (`ebrowse-ts-member-functions "member function")
+ (`ebrowse-ts-member-variables "member variable")
+ (`ebrowse-ts-static-functions "static function")
+ (`ebrowse-ts-static-variables "static variable")
+ (`ebrowse-ts-friends (if globals-p "define" "friend"))
+ (`ebrowse-ts-types "type")
+ (_ "unknown"))
"\n")))
(defvar ebrowse-last-completion nil
If there's only one tree loaded, use that. Otherwise let the
use choose a tree."
(let* ((buffers (ebrowse-known-class-trees-buffer-list))
- (buffer (cond ((and (first buffers) (not (second buffers)))
- (first buffers))
+ (buffer (cond ((and (cl-first buffers) (not (cl-second buffers)))
+ (cl-first buffers))
(t (or (ebrowse-electric-choose-tree)
(error "No tree buffer")))))
- (header (ebrowse-value-in-buffer 'ebrowse--header buffer)))
+ (header (buffer-local-value 'ebrowse--header buffer)))
(ebrowse-member-table header)))
"Return the item following STRING in LIST.
If STRING is the last element, return the first element as successor."
(or (nth (1+ (ebrowse-position string list 'string=)) list)
- (first list)))
+ (cl-first list)))
\f
;;; Symbol completion
;;;###autoload
-(defun* ebrowse-tags-complete-symbol (prefix)
+(cl-defun ebrowse-tags-complete-symbol (prefix)
"Perform completion on the C++ symbol preceding point.
A second call of this function without changing point inserts the next match.
A call with prefix PREFIX reads the symbol to insert from the minibuffer with
;; buffer: Start new completion.
(t
(let* ((members (ebrowse-some-member-table))
- (completion (first (all-completions pattern members nil))))
+ (completion (cl-first (all-completions pattern members nil))))
(cond ((eq completion t))
((null completion)
(error "Can't find completion for `%s'" pattern))
looks like a function call to the member."
(interactive)
;; Choose the tree to use if there is more than one.
- (multiple-value-bind (tree header tree-buffer)
- (values-list (ebrowse-choose-tree))
+ (cl-multiple-value-bind (tree header tree-buffer)
+ (cl-values-list (ebrowse-choose-tree))
(unless tree
(error "No class tree"))
;; Get the member name NAME (class-name is ignored).
(let ((name fix-name) class-name regexp)
(unless name
- (multiple-value-setq (class-name name)
- (values-list (ebrowse-tags-read-name header "Find calls of: "))))
+ (cl-multiple-value-setq (class-name name)
+ (cl-values-list (ebrowse-tags-read-name header "Find calls of: "))))
;; Set tags loop form to search for member and begin loop.
(setq regexp (concat "\\<" name "[ \t]*(")
ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
;;; Structures of this kind are the elements of the position stack.
-(defstruct (ebrowse-position (:type vector) :named)
+(cl-defstruct (ebrowse-position (:type vector) :named)
file-name ; in which file
point ; point in file
target ; t if target of a jump
The string is printed in the electric position list buffer."
(let ((info (ebrowse-position-info position)))
(concat (if (ebrowse-position-target position) "at " "to ")
- (ebrowse-cs-name (ebrowse-ts-class (first info)))
- "::" (ebrowse-ms-name (third info)))))
+ (ebrowse-cs-name (ebrowse-ts-class (cl-first info)))
+ "::" (ebrowse-ms-name (cl-third info)))))
(defun ebrowse-view/find-position (position &optional view)
(let ((too-much (- (length ebrowse-position-stack)
ebrowse-max-positions)))
;; Do not let the stack grow to infinity.
- (when (plusp too-much)
+ (when (cl-plusp too-much)
(setq ebrowse-position-stack
(butlast ebrowse-position-stack too-much)))
;; Push the position.
(let ((tree-file (buffer-file-name))
temp-buffer-setup-hook)
(with-output-to-temp-buffer "*Tree Statistics*"
- (multiple-value-bind (classes member-functions member-variables
+ (cl-multiple-value-bind (classes member-functions member-variables
static-functions static-variables)
- (values-list (ebrowse-gather-statistics))
+ (cl-values-list (ebrowse-gather-statistics))
(set-buffer standard-output)
(erase-buffer)
(insert "STATISTICS FOR TREE " (or tree-file "unknown") ":\n\n")
(let ((classes 0) (member-functions 0) (member-variables 0)
(static-functions 0) (static-variables 0))
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
- (incf classes)
- (incf member-functions (length (ebrowse-ts-member-functions tree)))
- (incf member-variables (length (ebrowse-ts-member-variables tree)))
- (incf static-functions (length (ebrowse-ts-static-functions tree)))
- (incf static-variables (length (ebrowse-ts-static-variables tree))))
+ (cl-incf classes)
+ (cl-incf member-functions (length (ebrowse-ts-member-functions tree)))
+ (cl-incf member-variables (length (ebrowse-ts-member-variables tree)))
+ (cl-incf static-functions (length (ebrowse-ts-static-functions tree)))
+ (cl-incf static-variables (length (ebrowse-ts-static-variables tree))))
(list classes member-functions member-variables
static-functions static-variables)))
;; prefix `\C-c\C-m' to browse commands.
(defvar ebrowse-global-map nil
- "*Keymap for Ebrowse commands.")
+ "Keymap for Ebrowse commands.")
(defvar ebrowse-global-prefix-key "\C-c\C-m"
;; this will select the buffer from which the buffer menu was
;; invoked. But this buffer is not displayed in the buffer list if
;; it isn't a tree buffer. I therefore let the buffer menu command
-;; loop read the command `p' via `unread-command-char'. This command
+;; loop read the command `p' via `unread-command-events'. This command
;; has no effect since we are on the first line of the buffer.
(defvar electric-buffer-menu-mode-hook nil)
(mouse-set-point event)
(let* ((where (posn-point (event-start event)))
(property (get-text-property where 'ebrowse-what)))
- (case (event-click-count event)
+ (pcase (event-click-count event)
(1
- (case property
- (class-name
+ (pcase property
+ (`class-name
(ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event))
- (t
+ (_
(ebrowse-popup-menu ebrowse-tree-buffer-object-menu event)))))))
(mouse-set-point event)
(let* ((where (posn-point (event-start event)))
(property (get-text-property where 'ebrowse-what)))
- (case (event-click-count event)
- (1 (case property
- (class-name
+ (pcase (event-click-count event)
+ (1 (pcase property
+ (`class-name
(ebrowse-tree-command:show-member-functions)))))))
(mouse-set-point event)
(let* ((where (posn-point (event-start event)))
(property (get-text-property where 'ebrowse-what)))
- (case (event-click-count event)
- (2 (case property
- (class-name
+ (pcase (event-click-count event)
+ (2 (pcase property
+ (`class-name
(let ((collapsed (save-excursion (skip-chars-forward "^\r\n")
(looking-at "\r"))))
(ebrowse-collapse-fn (not collapsed))))
- (mark
+ (`mark
(ebrowse-toggle-mark-at-point 1)))))))
-;;; etags.el --- etags facility for Emacs
+;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2012
;; Free Software Foundation, Inc.
;;; Code:
-(eval-when-compile
- (require 'cl))
(require 'ring)
(require 'button)
;;;###autoload
(defvar tags-file-name nil
- "*File name of tags table.
+ "File name of tags table.
To switch to a new tags table, setting this variable is sufficient.
If you set this variable, do not also set `tags-table-list'.
Use the `etags' program to make a tags table file.")
;;;###autoload
(defcustom tags-case-fold-search 'default
- "*Whether tags operations should be case-sensitive.
+ "Whether tags operations should be case-sensitive.
A value of t means case-insensitive, a value of nil means case-sensitive.
Any other value means use the setting of `case-fold-search'."
:group 'etags
;;;###autoload
;; Use `visit-tags-table-buffer' to cycle through tags tables in this list.
(defcustom tags-table-list nil
- "*List of file names of tags tables to search.
+ "List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
To switch to a new list of tags tables, setting this variable is sufficient.
If you set this variable, do not also set `tags-file-name'.
;;;###autoload
(defcustom tags-compression-info-list
(purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz"))
- "*List of extensions tried by etags when jka-compr is used.
+ "List of extensions tried by etags when jka-compr is used.
An empty string means search the non-compressed file.
These extensions will be tried only if jka-compr was activated
\(i.e. via customize of `auto-compression-mode' or by calling the function
;;;###autoload
(defcustom tags-add-tables 'ask-user
- "*Control whether to add a new tags table to the current list.
+ "Control whether to add a new tags table to the current list.
t means do; nil means don't (always start a new list).
Any other value means ask the user whether to add a new tags table
to the current list (as opposed to starting a new list)."
(other :tag "Ask" ask-user)))
(defcustom tags-revert-without-query nil
- "*Non-nil means reread a TAGS table without querying, if it has changed."
+ "Non-nil means reread a TAGS table without querying, if it has changed."
:group 'etags
:type 'boolean)
;;;###autoload
(defcustom find-tag-hook nil
- "*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
+ "Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
The value in the buffer in which \\[find-tag] is done is used,
not the value in the buffer \\[find-tag] goes to."
:group 'etags
;;;###autoload
(defcustom find-tag-default-function nil
- "*A function of no arguments used by \\[find-tag] to pick a default tag.
+ "A function of no arguments used by \\[find-tag] to pick a default tag.
If nil, and the symbol that is the value of `major-mode'
has a `find-tag-default-function' property (see `put'), that is used.
Otherwise, `find-tag-default' is used."
:type '(choice (const nil) function))
(defcustom find-tag-marker-ring-length 16
- "*Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
+ "Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
:group 'etags
:type 'integer
:version "20.3")
(defcustom tags-tag-face 'default
- "*Face for tags in the output of `tags-apropos'."
+ "Face for tags in the output of `tags-apropos'."
:group 'etags
:type 'face
:version "21.1")
(cond ((eq cont 'same)
;; Use the ambient value of tags-file-name.
(or tags-file-name
- (error "%s"
- (substitute-command-keys
- (concat "No tags table in use; "
- "use \\[visit-tags-table] to select one")))))
-
+ (user-error "%s"
+ (substitute-command-keys
+ (concat "No tags table in use; "
+ "use \\[visit-tags-table] to select one")))))
((eq t cont)
;; Find the next table.
(if (tags-next-table)
(while (and (not (or (get-file-buffer tags-file-name)
(file-exists-p tags-file-name)))
(tags-next-table)))))
-
(t
;; Pick a table out of our hat.
(tags-table-check-computed-list) ;Get it up to date, we might use it.
(kill-local-variable 'tags-file-name)
(if (eq local-tags-file-name tags-file-name)
(setq tags-file-name nil))
- (error "File %s is not a valid tags table" local-tags-file-name)))))
+ (user-error "File %s is not a valid tags table"
+ local-tags-file-name)))))
(defun tags-reset-tags-tables ()
"Reset tags state to cancel effect of any previous \\[visit-tags-table] or \\[find-tag]."
(setq tags-completion-table nil)))))
(defun tags-lazy-completion-table ()
- (lexical-let ((buf (current-buffer)))
+ (let ((buf (current-buffer)))
(lambda (string pred action)
(with-current-buffer buf
(save-excursion
(tags-lazy-completion-table)
nil nil nil nil default)))
(if (equal spec "")
- (or default (error "There is no default tag"))
+ (or default (user-error "There is no default tag"))
spec)))
(defvar last-tag nil
(if (eq '- next-p)
;; Pop back to a previous location.
(if (ring-empty-p tags-location-ring)
- (error "No previous tag locations")
+ (user-error "No previous tag locations")
(let ((marker (ring-remove tags-location-ring 0)))
(prog1
;; Move to the saved location.
(set-marker (car tag-lines-already-matched) nil nil)
(setq tag-lines-already-matched (cdr tag-lines-already-matched)))
(set-marker match-marker nil nil)
- (error "No %stags %s %s" (if first-search "" "more ")
- matching pattern))
+ (user-error "No %stags %s %s" (if first-search "" "more ")
+ matching pattern))
;; Found a tag; extract location info.
(beginning-of-line)
offset (* 3 offset))) ; expand search window
(or found
(re-search-forward pat nil t)
- (error "Rerun etags: `%s' not found in %s"
- pat buffer-file-name)))
+ (user-error "Rerun etags: `%s' not found in %s"
+ pat buffer-file-name)))
;; Position point at the right place
;; if the search string matched an extra Ctrl-m at the beginning.
(and (eq selective-display t)
(re-search-backward re bol t)))))
\f
(defcustom tags-loop-revert-buffers nil
- "*Non-nil means tags-scanning loops should offer to reread changed files.
+ "Non-nil means tags-scanning loops should offer to reread changed files.
These loops normally read each file into Emacs, but when a file
is already visited, they use the existing buffer.
When this flag is non-nil, they offer to revert the existing buffer
(and novisit
(get-buffer " *next-file*")
(kill-buffer " *next-file*"))
- (error "All files processed"))
+ (user-error "All files processed"))
(let* ((next (car next-file-list))
(buffer (get-file-buffer next))
(new (not buffer)))
"Form for `tags-loop-continue' to eval to change one file.")
(defvar tags-loop-scan
- '(error "%s"
- (substitute-command-keys
- "No \\[tags-search] or \\[tags-query-replace] in progress"))
+ '(user-error "%s"
+ (substitute-command-keys
+ "No \\[tags-search] or \\[tags-query-replace] in progress"))
"Form for `tags-loop-continue' to eval to scan one file.
If it returns non-nil, this file needs processing by evalling
\`tags-loop-operate'. Otherwise, move on to the next file.")
(if (funcall list-tags-function file)
(setq gotany t)))
(or gotany
- (error "File %s not in current tags tables" file)))))
+ (user-error "File %s not in current tags tables" file)))))
(with-current-buffer "*Tags List*"
(require 'apropos)
(with-no-warnings
(interactive)
(or tags-table-list
tags-file-name
- (error "%s"
- (substitute-command-keys
- "No tags table loaded; try \\[visit-tags-table]")))
+ (user-error "%s"
+ (substitute-command-keys
+ "No tags table loaded; try \\[visit-tags-table]")))
(let ((comp-data (tags-completion-at-point-function)))
(if (null comp-data)
- (error "Nothing to complete")
+ (user-error "Nothing to complete")
(completion-in-region (car comp-data) (cadr comp-data)
(nth 2 comp-data)
(plist-get (nthcdr 3 comp-data) :predicate)))))
-
-(dolist (x '("^No tags table in use; use .* to select one$"
- "^There is no default tag$"
- "^No previous tag locations$"
- "^File .* is not a valid tags table$"
- "^No \\(more \\|\\)tags \\(matching\\|containing\\) "
- "^Rerun etags: `.*' not found in "
- "^All files processed$"
- "^No .* or .* in progress$"
- "^File .* not in current tags tables$"
- "^No tags table loaded"
- "^Nothing to complete$"))
- (add-to-list 'debug-ignored-errors x))
\f
(provide 'etags)
;; This used to default to `other', but that doesn't seem to have any
;; significance. fx 2000-02-11.
(defcustom executable-insert t ; 'other
- "*Non-nil means offer to add a magic number to a file.
+ "Non-nil means offer to add a magic number to a file.
This takes effect when you switch to certain major modes,
including Shell-script mode (`sh-mode').
When you type \\[executable-set-magic], it always offers to add or
(defcustom executable-query 'function
- "*If non-nil, ask user before changing an existing magic number.
+ "If non-nil, ask user before changing an existing magic number.
When this is `function', only ask when called non-interactively."
:type '(choice (const :tag "Don't Ask" nil)
(const :tag "Ask when non-interactive" function)
(defcustom executable-magicless-file-regexp "/[Mm]akefile$\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|.+shrc\\|esrc\\|rcrc\\|[kz]shenv\\)$"
- "*On files with this kind of name no magic is inserted or changed."
+ "On files with this kind of name no magic is inserted or changed."
:type 'regexp
:group 'executable)
-(defcustom executable-prefix "#! "
- "*Interpreter magic number prefix inserted when there was no magic number."
+(defcustom executable-prefix "#!"
+ "Interpreter magic number prefix inserted when there was no magic number."
+ :version "24.3" ; "#! " -> "#!"
:type 'string
:group 'executable)
(defcustom executable-chmod 73
- "*After saving, if the file is not executable, set this mode.
+ "After saving, if the file is not executable, set this mode.
This mode passed to `set-file-modes' is taken absolutely when negative, or
relative to the files existing modes. Do nothing if this is nil.
Typical values are 73 (+x) or -493 (rwxr-xr-x)."
(defvar executable-command nil)
(defcustom executable-self-display "tail"
- "*Command you use with argument `+2' to make text files self-display.
+ "Command you use with argument `+2' to make text files self-display.
Note that the like of `more' doesn't work too well under Emacs \\[shell]."
:type 'string
:group 'executable)
(defvar executable-font-lock-keywords
'(("\\`#!.*/\\([^ \t\n]+\\)" 1 font-lock-keyword-face t))
- "*Rules for highlighting executable scripts' magic number.
+ "Rules for highlighting executable scripts' magic number.
This can be included in `font-lock-keywords' by modes that call `executable'.")
;; (abbrev-mode 1) ; turn on abbreviation mode
;; (f90-add-imenu-menu) ; extra menu with functions etc.
;; (if f90-auto-keyword-case ; change case of all keywords on startup
-;; (f90-change-keywords f90-auto-keyword-case))
-;; ))
+;; (f90-change-keywords f90-auto-keyword-case))))
;;
-;; in your .emacs file. You can also customize the lists
+;; in your init file. You can also customize the lists
;; f90-font-lock-keywords, etc.
;;
;; The auto-fill and abbreviation minor modes are accessible from the F90 menu,
(defvar f90-font-lock-keywords
f90-font-lock-keywords-2
- "*Default expressions to highlight in F90 mode.
+ "Default expressions to highlight in F90 mode.
Can be overridden by the value of `font-lock-maximum-decoration'.")
"Typing `\\[help-command] or `? lists all the F90 abbrevs.
Any other key combination is executed normally."
(interactive "*")
- (insert last-command-event)
- (let (char event)
- (if (fboundp 'next-command-event) ; XEmacs
- (setq event (next-command-event)
- char (and (fboundp 'event-to-character)
- (event-to-character event)))
- (setq event (read-event)
- char event))
- ;; Insert char if not equal to `?', or if abbrev-mode is off.
- (if (and abbrev-mode (memq char (list ?? help-char)))
- (f90-abbrev-help)
- (setq unread-command-events (list event)))))
+ (self-insert-command 1)
+ (when abbrev-mode
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [??] 'f90-abbrev-help)
+ (define-key map (vector help-char) 'f90-abbrev-help)
+ map))))
(defun f90-abbrev-help ()
"List the currently defined abbrevs in F90 mode."
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(if (featurep 'xemacs) (require 'overlay))
(defvar flymake-is-running nil
(make-variable-buffer-local 'flymake-output-residual)
(defgroup flymake nil
- "A universal on-the-fly syntax checker."
+ "Universal on-the-fly syntax checker."
:version "23.1"
:group 'tools)
This function is used in sort to move most possible file names
to the beginning of the list (File.h -> File.cpp moved to top)."
(and (equal (file-name-sans-extension flymake-included-file-name)
- (file-name-sans-extension (file-name-nondirectory file-one)))
+ (file-name-base file-one))
(not (equal file-one file-two))))
(defcustom flymake-check-file-limit 8192
(defun flymake-er-get-line-err-info-list (err-info)
(nth 1 err-info))
-(defstruct (flymake-ler
+(cl-defstruct (flymake-ler
(:constructor nil)
(:constructor flymake-ler-make-ler (file line type text &optional full-file)))
file line type text full-file)
"Determine whether overlay OV was created by flymake."
(and (overlayp ov) (overlay-get ov 'flymake-overlay)))
-(defun flymake-make-overlay (beg end tooltip-text face mouse-face)
+(defcustom flymake-error-bitmap '(exclamation-mark error)
+ "Bitmap used in the fringe for indicating errors.
+The value may also be a list of two elements where the second
+element specifies the face for the bitmap."
+ :group 'flymake
+ :type 'symbol)
+
+(defcustom flymake-warning-bitmap 'question-mark
+ "Bitmap used in the fringe for indicating warnings.
+The value may also be a list of two elements where the second
+element specifies the face for the bitmap."
+ :group 'flymake
+ :type 'symbol)
+
+(defcustom flymake-fringe-indicator-position 'left-fringe
+ "The position to put flymake fringe indicator.
+The value can be nil, left-fringe or right-fringe.
+Fringe indicators are disabled if nil."
+ :group 'flymake
+ :type '(choice (const left-fringe)
+ (const right-fringe)
+ (const :tag "No fringe indicators" nil)))
+
+(defun flymake-make-overlay (beg end tooltip-text face bitmap mouse-face)
"Allocate a flymake overlay in range BEG and END."
(when (not (flymake-region-has-flymake-overlays beg end))
- (let ((ov (make-overlay beg end nil t t)))
+ (let ((ov (make-overlay beg end nil t t))
+ (fringe (and flymake-fringe-indicator-position
+ (propertize "!" 'display
+ (cons flymake-fringe-indicator-position
+ (if (listp bitmap)
+ bitmap
+ (list bitmap)))))))
(overlay-put ov 'face face)
(overlay-put ov 'mouse-face mouse-face)
(overlay-put ov 'help-echo tooltip-text)
(overlay-put ov 'flymake-overlay t)
(overlay-put ov 'priority 100)
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov 'before-string fringe)
;;+(flymake-log 3 "created overlay %s" ov)
ov)
(flymake-log 3 "created an overlay at (%d-%d)" beg end)))
has-flymake-overlays))
(defface flymake-errline
- '((((class color) (background dark)) (:background "Firebrick4"))
- (((class color) (background light)) (:background "LightPink"))
- (t (:bold t)))
+ '((t :inherit error))
"Face used for marking error lines."
:group 'flymake)
(defface flymake-warnline
- '((((class color) (background dark)) (:background "DarkBlue"))
- (((class color) (background light)) (:background "LightBlue2"))
- (t (:bold t)))
+ '((t :inherit warning))
"Face used for marking warning lines."
:group 'flymake)
(beg line-beg)
(end line-end)
(tooltip-text (flymake-ler-text (nth 0 line-err-info-list)))
- (face nil))
+ (face nil)
+ (bitmap nil))
(goto-char line-beg)
(while (looking-at "[ \t]")
(setq end (point)))
(if (> (flymake-get-line-err-count line-err-info-list "e") 0)
- (setq face 'flymake-errline)
- (setq face 'flymake-warnline))
+ (setq face 'flymake-errline
+ bitmap flymake-error-bitmap)
+ (setq face 'flymake-warnline
+ bitmap flymake-warning-bitmap))
- (flymake-make-overlay beg end tooltip-text face nil)))
+ (flymake-make-overlay beg end tooltip-text face bitmap nil)))
(defun flymake-parse-err-lines (err-info-list lines)
"Parse err LINES, store info in ERR-INFO-LIST."
(setq flymake-timer
(run-at-time nil 1 'flymake-on-timer-event (current-buffer)))
- (when flymake-start-syntax-check-on-find-file
- (flymake-start-syntax-check)))))
+ (when (and flymake-start-syntax-check-on-find-file
+ ;; Since we write temp files in current dir, there's no point
+ ;; trying if the directory is read-only (bug#8954).
+ (file-writable-p (file-name-directory buffer-file-name)))
+ (with-demoted-errors
+ (flymake-start-syntax-check))))))
;; Turning the mode OFF.
(t
(defcustom fortran-directive-re
"^[ \t]*#.*"
"Regexp to match a directive line.
-The matching text will be fontified with `font-lock-keyword-face'.
+The matching text will be fontified with `font-lock-preprocessor-face'.
The matching line will be given zero indentation."
:version "22.1"
:type 'regexp
;; Standard continuation character and in a TAB-formatted line.
'("^ \\{5\\}\\([^ 0\n]\\)" 1 font-lock-string-face)
'("^\t\\([1-9]\\)" 1 font-lock-string-face))
- `((,fortran-directive-re (0 font-lock-keyword-face t)))
+ `((,fortran-directive-re (0 font-lock-preprocessor-face t)))
;; `fortran-font-lock-keywords-2' without types (see above).
(cdr (nthcdr (length fortran-font-lock-keywords-1)
fortran-font-lock-keywords-2)))
(require 'gud)
(require 'json)
(require 'bindat)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(declare-function speedbar-change-initial-expansion-list
"speedbar" (new-default))
`gdb-debug-log-max' values. This variable is used to debug GDB-MI.")
;;;###autoload
-(defcustom gdb-enable-debug nil
- "Non-nil means record the process input and output in `gdb-debug-log'."
- :type 'boolean
+(define-minor-mode gdb-enable-debug
+ "Toggle logging of transaction between Emacs and Gdb.
+The log is stored in `gdb-debug-log' as an alist with elements
+whose cons is send, send-item or recv and whose cdr is the string
+being transferred. This list may grow up to a size of
+`gdb-debug-log-max' after which the oldest element (at the end of
+the list) is deleted every time a new one is added (at the front)."
+ :global t
:group 'gdb
:version "22.1")
;; Force mode line redisplay soon.
(force-mode-line-update)))))
-(defun gdb-enable-debug (arg)
- "Toggle logging of transaction between Emacs and Gdb.
-The log is stored in `gdb-debug-log' as an alist with elements
-whose cons is send, send-item or recv and whose cdr is the string
-being transferred. This list may grow up to a size of
-`gdb-debug-log-max' after which the oldest element (at the end of
-the list) is deleted every time a new one is added (at the front)."
- (interactive "P")
- (setq gdb-enable-debug
- (if (null arg)
- (not gdb-enable-debug)
- (> (prefix-numeric-value arg) 0)))
- (message (format "Logging of transaction %sabled"
- (if gdb-enable-debug "en" "dis"))))
-
;; These two are used for menu and toolbar
(defun gdb-control-all-threads ()
"Switch to non-stop/A mode."
(run-hooks 'gdb-mode-hook))
(defun gdb-init-1 ()
- ;; (re-)initialize
+ ;; (Re-)initialize.
(setq gdb-selected-frame nil
gdb-frame-number nil
gdb-thread-number nil
(gdb-clear-inferior-io)
(gdb-inferior-io--init-proc (get-process "gdb-inferior"))
- (if (eq window-system 'w32)
- (gdb-input "-gdb-set new-console off" 'ignore))
+ (when (eq system-type 'windows-nt)
+ ;; Don't create a separate console window for the debuggee.
+ (gdb-input "-gdb-set new-console off" 'ignore)
+ ;; Force GDB to behave as if its input and output stream were
+ ;; connected to a TTY device (since on Windows we use pipes for
+ ;; communicating with GDB).
+ (gdb-input "-gdb-set interactive-mode on" 'ignore))
(gdb-input "-gdb-set height 0" 'ignore)
(when gdb-non-stop
(gdb-input "-enable-pretty-printing" 'ignore)
- ;; find source file and compilation directory here
+ ;; Find source file and compilation directory here.
(if gdb-create-source-file-list
;; Needs GDB 6.2 onwards.
(gdb-input "-file-list-exec-source-files" 'gdb-get-source-file-list))
(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
(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 ()
(gdb-create-define-alist)
(add-hook 'after-save-hook 'gdb-create-define-alist nil t)))
-(defmacro gdb-if-arrow (arrow-position &rest body)
- `(if ,arrow-position
- (let ((buffer (marker-buffer ,arrow-position)) (line))
- (if (equal buffer (window-buffer (posn-window end)))
- (with-current-buffer buffer
- (when (or (equal start end)
- (equal (posn-point start)
- (marker-position ,arrow-position)))
- ,@body))))))
+(defmacro gdb--if-arrow (arrow-position start-posn end-posn &rest body)
+ (declare (indent 3))
+ (let ((buffer (make-symbol "buffer")))
+ `(if ,arrow-position
+ (let ((,buffer (marker-buffer ,arrow-position)))
+ (if (equal ,buffer (window-buffer (posn-window ,end-posn)))
+ (with-current-buffer ,buffer
+ (when (or (equal ,start-posn ,end-posn)
+ (equal (posn-point ,start-posn)
+ (marker-position ,arrow-position)))
+ ,@body)))))))
(defun gdb-mouse-until (event)
"Continue running until a source line past the current line.
(interactive "e")
(let ((start (event-start event))
(end (event-end event)))
- (gdb-if-arrow gud-overlay-arrow-position
- (setq line (line-number-at-pos (posn-point end)))
- (gud-call (concat "until " (number-to-string line))))
- (gdb-if-arrow gdb-disassembly-position
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- (line-number-at-pos (posn-point end))))
- (forward-char 2)
- (gud-call (concat "until *%a"))))))
+ (gdb--if-arrow gud-overlay-arrow-position start end
+ (let ((line (line-number-at-pos (posn-point end))))
+ (gud-call (concat "until " (number-to-string line)))))
+ (gdb--if-arrow gdb-disassembly-position start end
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- (line-number-at-pos (posn-point end))))
+ (forward-char 2)
+ (gud-call (concat "until *%a"))))))
(defun gdb-mouse-jump (event)
"Set execution address/line.
(interactive "e")
(let ((start (event-start event))
(end (event-end event)))
- (gdb-if-arrow gud-overlay-arrow-position
- (setq line (line-number-at-pos (posn-point end)))
- (progn
- (gud-call (concat "tbreak " (number-to-string line)))
- (gud-call (concat "jump " (number-to-string line)))))
- (gdb-if-arrow gdb-disassembly-position
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- (line-number-at-pos (posn-point end))))
- (forward-char 2)
- (progn
- (gud-call (concat "tbreak *%a"))
- (gud-call (concat "jump *%a")))))))
+ (gdb--if-arrow gud-overlay-arrow-position start end
+ (let ((line (line-number-at-pos (posn-point end))))
+ (gud-call (concat "tbreak " (number-to-string line)))
+ (gud-call (concat "jump " (number-to-string line)))))
+ (gdb--if-arrow gdb-disassembly-position start end
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- (line-number-at-pos (posn-point end))))
+ (forward-char 2)
+ (gud-call (concat "tbreak *%a"))
+ (gud-call (concat "jump *%a"))))))
(defcustom gdb-show-changed-values t
"If non-nil change the face of out of scope variables and changed values.
:group 'gdb
:version "22.2")
-(defcustom gdb-speedbar-auto-raise nil
- "If non-nil raise speedbar every time display of watch expressions is\
- updated."
- :type 'boolean
+(define-minor-mode gdb-speedbar-auto-raise
+ "Minor mode to automatically raise the speedbar for watch expressions.
+With prefix argument ARG, automatically raise speedbar if ARG is
+positive, otherwise don't automatically raise it."
+ :global t
:group 'gdb
:version "22.1")
:group 'gdb
:version "22.1")
-(defun gdb-speedbar-auto-raise (arg)
- "Toggle automatic raising of the speedbar for watch expressions.
-With prefix argument ARG, automatically raise speedbar if ARG is
-positive, otherwise don't automatically raise it."
- (interactive "P")
- (setq gdb-speedbar-auto-raise
- (if (null arg)
- (not gdb-speedbar-auto-raise)
- (> (prefix-numeric-value arg) 0)))
- (message (format "Auto raising %sabled"
- (if gdb-speedbar-auto-raise "en" "dis"))))
-
(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
-(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch)
+(define-key global-map (vconcat gud-key-prefix "\C-w") 'gud-watch)
(declare-function tooltip-identifier-from-point "tooltip" (point))
(defun gdb-edit-value (_text _token _indent)
"Assign a value to a variable displayed in the speedbar."
(let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
- (varnum (car var)) (value))
- (setq value (read-string "New value: "))
+ (varnum (car var))
+ (value (read-string "New value: ")))
(gdb-input (concat "-var-assign " varnum " " value)
`(lambda () (gdb-edit-value-handler ,value)))))
(with-current-buffer ,buffer
(apply ',expr args))))
-;; Used to define all gdb-frame-*-buffer functions except
-;; `gdb-frame-io-buffer'
-(defmacro def-gdb-frame-for-buffer (name buffer &optional doc)
- "Define a function NAME which shows gdb BUFFER in a separate frame.
-
-DOC is an optional documentation string."
- `(defun ,name (&optional thread)
- ,(when doc doc)
- (interactive)
- (let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist gdb-frame-parameters))
- (display-buffer (gdb-get-buffer-create ,buffer thread)))))
-
-(defmacro def-gdb-display-buffer (name buffer &optional doc)
- "Define a function NAME which shows gdb BUFFER.
-
-DOC is an optional documentation string."
- `(defun ,name (&optional thread)
- ,(when doc doc)
- (interactive)
- (gdb-display-buffer
- (gdb-get-buffer-create ,buffer thread) t)))
-
;; Used to display windows with thread-bound buffers
(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc
split-horizontal)
(defun gdb-display-io-buffer ()
"Display IO of debugged program in a separate window."
(interactive)
- (gdb-display-buffer
- (gdb-get-buffer-create 'gdb-inferior-io) t))
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))
(defun gdb-inferior-io--init-proc (proc)
;; 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)
(comint-exec io-buffer "gdb-inferior" nil nil nil)
(gdb-inferior-io--init-proc (get-buffer-process io-buffer))))))
-(defconst gdb-frame-parameters
- '((height . 14) (width . 80)
- (unsplittable . t)
- (tool-bar-lines . nil)
- (menu-bar-lines . nil)
- (minibuffer . nil)))
+(defvar gdb-display-buffer-other-frame-action
+ `((display-buffer-reuse-window display-buffer-pop-up-frame)
+ (reusable-frames . 0)
+ (inhibit-same-window . t)
+ (pop-up-frame-parameters (height . 14)
+ (width . 80)
+ (unsplittable . t)
+ (tool-bar-lines . nil)
+ (menu-bar-lines . nil)
+ (minibuffer . nil)))
+ "A `display-buffer' action for displaying GDB utility frames.")
+(put 'gdb-display-buffer-other-frame-action 'risky-local-variable t)
(defun gdb-frame-io-buffer ()
- "Display IO of debugged program in a new frame."
+ "Display IO of debugged program in another frame."
(interactive)
- (let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist gdb-frame-parameters))
- (display-buffer (gdb-get-buffer-create 'gdb-inferior-io))))
+ (display-buffer (gdb-get-buffer-create 'gdb-inferior-io)
+ gdb-display-buffer-other-frame-action))
(defvar gdb-inferior-io-mode-map
(let ((map (make-sparse-keymap)))
(defun gdb-inferior-filter (proc string)
(unless (string-equal string "")
- (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t))
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
(comint-output-filter proc string)))
(setq gud-running
(string= (bindat-get-field (gdb-current-buffer-thread) 'state)
"running"))
- ;; Set frame number to "0" when _current_ threads stops
+ ;; Set frame number to "0" when _current_ threads stops.
(when (and (gdb-current-buffer-thread)
(not (eq gud-running old-value)))
(setq gdb-frame-number "0"))))
(> (length gdb-debug-log) gdb-debug-log-max))
(setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil)))
- ;; Recall the left over gud-marker-acc from last time
+ ;; Recall the left over gud-marker-acc from last time.
(setq gud-marker-acc (concat gud-marker-acc string))
- ;; Start accumulating output for the GUD buffer
+ ;; Start accumulating output for the GUD buffer.
(setq gdb-filter-output "")
(let (output-record-list)
(defun gdb-gdb (_output-field))
(defun gdb-shell (output-field)
- (let ((gdb-output-sink gdb-output-sink))
- (setq gdb-filter-output
- (concat output-field gdb-filter-output))))
+ (setq gdb-filter-output
+ (concat output-field gdb-filter-output)))
(defun gdb-ignored-notification (_output-field))
(concat " --thread " thread-id)))
'gdb-register-names-handler))
-;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler
-;;; because synchronous GDB doesn't give these fields with CLI.
-;;; (when file
-;;; (setq
-;;; ;; Extract the frame position from the marker.
-;;; gud-last-frame (cons file
-;;; (string-to-number
-;;; (match-string 6 gud-marker-acc)))))
+ ;; Don't set gud-last-frame here as it's currently done in
+ ;; gdb-frame-handler because synchronous GDB doesn't give these fields
+ ;; with CLI.
+ ;;(when file
+ ;; (setq
+ ;; ;; Extract the frame position from the marker.
+ ;; gud-last-frame (cons file
+ ;; (string-to-number
+ ;; (match-string 6 gud-marker-acc)))))
(setq gdb-inferior-status (or reason "unknown"))
(gdb-force-mode-line-update
(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)
;; gdb-table struct is a way to programmatically construct simple
;; tables. It help to reliably align columns of data in GDB buffers
;; and provides
-(defstruct
- gdb-table
+(cl-defstruct gdb-table
(column-sizes nil)
(rows nil)
(row-properties nil)
(defun gdb-get-many-fields (struct &rest fields)
"Return a list of FIELDS values from STRUCT."
(let ((values))
- (dolist (field fields values)
- (setq values (append values (list (bindat-get-field struct field)))))))
+ (dolist (field fields)
+ (push (bindat-get-field struct field) values))
+ (nreverse values)))
(defmacro def-gdb-auto-update-trigger (trigger-name gdb-command
handler-name
(defun gdb-breakpoints-buffer-name ()
(concat "*breakpoints of " (gdb-get-target-string) "*"))
-(def-gdb-display-buffer
- gdb-display-breakpoints-buffer
- 'gdb-breakpoints-buffer
- "Display status of user-settable breakpoints.")
+(defun gdb-display-breakpoints-buffer (&optional thread)
+ "Display GDB breakpoints."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer thread)))
-(def-gdb-frame-for-buffer
- gdb-frame-breakpoints-buffer
- 'gdb-breakpoints-buffer
- "Display status of user-settable breakpoints in a new frame.")
+(defun gdb-frame-breakpoints-buffer (&optional thread)
+ "Display GDB breakpoints in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer thread)
+ gdb-display-buffer-other-frame-action))
(defvar gdb-breakpoints-mode-map
(let ((map (make-sparse-keymap))
(defun gdb-threads-buffer-name ()
(concat "*threads of " (gdb-get-target-string) "*"))
-(def-gdb-display-buffer
- gdb-display-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads.")
+(defun gdb-display-threads-buffer (&optional thread)
+ "Display GDB threads."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-threads-buffer thread)))
-(def-gdb-frame-for-buffer
- gdb-frame-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads in a new frame.")
+(defun gdb-frame-threads-buffer (&optional thread)
+ "Display GDB threads in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-threads-buffer thread)
+ gdb-display-buffer-other-frame-action))
(def-gdb-trigger-and-handler
gdb-invalidate-threads (gdb-current-context-command "-thread-info")
(add-to-list 'gdb-threads-list
(cons (bindat-get-field thread 'id)
thread))
- (if running
- (incf gdb-running-threads-count)
- (incf gdb-stopped-threads-count))
+ (cl-incf (if running
+ gdb-running-threads-count
+ gdb-stopped-threads-count))
(gdb-table-add-row table
(list
(def-gdb-thread-buffer-simple-command
gdb-frame-stack-for-thread
gdb-frame-stack-buffer
- "Display a new frame with stack buffer for the thread at
-current line.")
+ "Display another frame with stack buffer for thread at current line.")
(def-gdb-thread-buffer-simple-command
gdb-frame-locals-for-thread
gdb-frame-locals-buffer
- "Display a new frame with locals buffer for the thread at
-current line.")
+ "Display another frame with locals buffer for thread at current line.")
(def-gdb-thread-buffer-simple-command
gdb-frame-registers-for-thread
gdb-frame-registers-buffer
- "Display a new frame with registers buffer for the thread at
-current line.")
+ "Display another frame with registers buffer for the thread at current line.")
(def-gdb-thread-buffer-simple-command
gdb-frame-disassembly-for-thread
gdb-frame-disassembly-buffer
- "Display a new frame with disassembly buffer for the thread at
-current line.")
+ "Display another frame with disassembly buffer for the thread at current line.")
(defmacro def-gdb-thread-buffer-gud-command (name gud-command &optional doc)
"Define a NAME which will execute GUD-COMMAND with
(defun gdb-memory-buffer-name ()
(concat "*memory of " (gdb-get-target-string) "*"))
-(def-gdb-display-buffer
- gdb-display-memory-buffer
- 'gdb-memory-buffer
- "Display memory contents.")
+(defun gdb-display-memory-buffer (&optional thread)
+ "Display GDB memory contents."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-memory-buffer thread)))
(defun gdb-frame-memory-buffer ()
- "Display memory contents in a new frame."
+ "Display memory contents in another frame."
(interactive)
- (let* ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist
- `((left-fringe . 0)
- (right-fringe . 0)
- (width . 83)
- ,@gdb-frame-parameters)))
- (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer))))
+ (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)
+ gdb-display-buffer-other-frame-action))
\f
;;; Disassembly view
(gdb-current-context-buffer-name
(concat "disassembly of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-disassembly-buffer
- 'gdb-disassembly-buffer
- "Display disassembly for current stack frame.")
+(defun gdb-display-disassembly-buffer (&optional thread)
+ "Display GDB disassembly information."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-disassembly-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-disassembly-buffer
'gdb-disassembly-buffer)
-(def-gdb-frame-for-buffer
- gdb-frame-disassembly-buffer
- 'gdb-disassembly-buffer
- "Display disassembly in a new frame.")
+(defun gdb-frame-disassembly-buffer (&optional thread)
+ "Display GDB disassembly information in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-disassembly-buffer thread)
+ gdb-display-buffer-other-frame-action))
(def-gdb-auto-update-trigger gdb-invalidate-disassembly
(let* ((frame (gdb-current-buffer-frame))
(gdb-current-context-buffer-name
(concat "stack frames of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-stack-buffer
- 'gdb-stack-buffer
- "Display backtrace of current stack.")
+(defun gdb-display-stack-buffer (&optional thread)
+ "Display GDB backtrace for current stack."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-stack-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-stack-buffer
'gdb-stack-buffer nil t)
-(def-gdb-frame-for-buffer
- gdb-frame-stack-buffer
- 'gdb-stack-buffer
- "Display backtrace of current stack in a new frame.")
+(defun gdb-frame-stack-buffer (&optional thread)
+ "Display GDB backtrace for current stack in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-stack-buffer thread)
+ gdb-display-buffer-other-frame-action))
(defvar gdb-frames-mode-map
(let ((map (make-sparse-keymap)))
(gdb-current-context-buffer-name
(concat "locals of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-locals-buffer
- 'gdb-locals-buffer
- "Display local variables of current stack and their values.")
+(defun gdb-display-locals-buffer (&optional thread)
+ "Display the local variables of current GDB stack."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-locals-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-locals-buffer
'gdb-locals-buffer nil t)
-(def-gdb-frame-for-buffer
- gdb-frame-locals-buffer
- 'gdb-locals-buffer
- "Display local variables of current stack and their values in a new frame.")
+(defun gdb-frame-locals-buffer (&optional thread)
+ "Display the local variables of the current GDB stack in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-locals-buffer thread)
+ gdb-display-buffer-other-frame-action))
\f
;; Registers buffer.
(gdb-current-context-buffer-name
(concat "registers of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-registers-buffer
- 'gdb-registers-buffer
- "Display integer register contents.")
+(defun gdb-display-registers-buffer (&optional thread)
+ "Display GDB register contents."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-registers-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-registers-buffer
'gdb-registers-buffer nil t)
-(def-gdb-frame-for-buffer
- gdb-frame-registers-buffer
- 'gdb-registers-buffer
- "Display integer register contents in a new frame.")
+(defun gdb-frame-registers-buffer (&optional thread)
+ "Display GDB register contents in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-registers-buffer thread)
+ gdb-display-buffer-other-frame-action))
;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-get-changed-registers ()
(setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
;;;; Window management
-(defun gdb-display-buffer (buf dedicated &optional frame)
- "Show buffer BUF.
-
-If BUF is already displayed in some window, show it, deiconifying
-the frame if necessary. Otherwise, find least recently used
-window and show BUF there, if the window is not used for GDB
-already, in which case that window is split first."
- (let ((answer (get-buffer-window buf (or frame 0))))
- (if answer
- (display-buffer buf nil (or frame 0)) ;Deiconify frame if necessary.
- (let ((window (get-lru-window)))
- (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window))
- 'gdbmi)
- (let ((largest (get-largest-window)))
- (setq answer (split-window largest))
- (set-window-buffer answer buf)
- (set-window-dedicated-p answer dedicated)
- answer)
- (set-window-buffer window buf)
- window)))))
+(defun gdb-display-buffer (buf)
+ "Show buffer BUF, and make that window dedicated."
+ (let ((window (display-buffer buf)))
+ (set-window-dedicated-p window t)
+ window))
+
+ ;; (let ((answer (get-buffer-window buf 0)))
+ ;; (if answer
+ ;; (display-buffer buf nil 0) ;Deiconify frame if necessary.
+ ;; (let ((window (get-lru-window)))
+ ;; (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window))
+ ;; 'gdbmi)
+ ;; (let ((largest (get-largest-window)))
+ ;; (setq answer (split-window largest))
+ ;; (set-window-buffer answer buf)
+ ;; (set-window-dedicated-p answer t)
+ ;; answer)
+ ;; (set-window-buffer window buf)
+ ;; window)))))
+
(defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal)
"Find window displaying a buffer with the same
(if dedicated-window
(set-window-buffer
(split-window dedicated-window nil split-horizontal) buf)
- (gdb-display-buffer buf t))))))
+ (gdb-display-buffer buf))))))
(error "Null buffer")))
\f
;;; Shared keymap initialization:
'all-threads)
(defun gdb-frame-gdb-buffer ()
- "Display GUD buffer in a new frame."
+ "Display GUD buffer in another frame."
(interactive)
(display-buffer-other-frame gud-comint-buffer))
(defun gdb-setup-windows ()
"Layout the window pattern for `gdb-many-windows'."
- (gdb-display-locals-buffer)
- (gdb-display-stack-buffer)
- (delete-other-windows)
- (gdb-display-breakpoints-buffer)
- (delete-other-windows)
- ;; Don't dedicate.
+ (gdb-get-buffer-create 'gdb-locals-buffer)
+ (gdb-get-buffer-create 'gdb-stack-buffer)
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer)
+ (set-window-dedicated-p (selected-window) nil)
(switch-to-buffer gud-comint-buffer)
+ (delete-other-windows)
(let ((win0 (selected-window))
(win1 (split-window nil ( / ( * (window-height) 3) 4)))
(win2 (split-window nil ( / (window-height) 3)))
nil win5))
(select-window win0)))
-(defcustom gdb-many-windows nil
+(define-minor-mode gdb-many-windows
"If nil just pop up the GUD buffer unless `gdb-show-main' is t.
In this case it starts with two windows: one displaying the GUD
buffer and the other with the source file with the main routine
of the debugged program. Non-nil means display the layout shown for
`gdb'."
- :type 'boolean
+ :global t
:group 'gdb
- :version "22.1")
-
-(defun gdb-many-windows (arg)
- "Toggle the number of windows in the basic arrangement.
-With arg, display additional buffers iff arg is positive."
- (interactive "P")
- (setq gdb-many-windows
- (if (null arg)
- (not gdb-many-windows)
- (> (prefix-numeric-value arg) 0)))
- (message (format "Display of other windows %sabled"
- (if gdb-many-windows "en" "dis")))
+ :version "22.1"
(if (and gud-comint-buffer
(buffer-name gud-comint-buffer))
- (condition-case nil
- (gdb-restore-windows)
- (error nil))))
+ (ignore-errors
+ (gdb-restore-windows))))
(defun gdb-restore-windows ()
"Restore the basic arrangement of windows used by gdb.
;;; Code:
-(eval-when-compile
- (require 'cl))
-
-
;;; User variables
(defcustom glasses-original-separator "_"
- "*String to be displayed as `glasses-separator' in separator positions.
+ "String to be displayed as `glasses-separator' in separator positions.
For instance, if you set it to \"_\" and set `glasses-separator' to \"-\",
underscore separators are displayed as hyphens.
If `glasses-original-separator' is an empty string, no such display change is
;;;###autoload
(defcustom grep-window-height nil
- "*Number of lines in a grep window. If nil, use `compilation-window-height'."
+ "Number of lines in a grep window. If nil, use `compilation-window-height'."
:type '(choice (const :tag "Default" nil)
integer)
:version "22.1"
:group 'grep)
(defcustom grep-scroll-output nil
- "*Non-nil to scroll the *grep* buffer window as output appears.
+ "Non-nil to scroll the *grep* buffer window as output appears.
Setting it causes the grep commands to put point at the end of their
output window so that the end of the output is always visible rather
("tex" . "*.tex")
("texi" . "*.texi")
("asm" . "*.[sS]"))
- "*Alist of aliases for the FILES argument to `lgrep' and `rgrep'."
+ "Alist of aliases for the FILES argument to `lgrep' and `rgrep'."
:type 'alist
:group 'grep)
(defcustom grep-find-ignored-directories
vc-directory-exclusion-list
- "*List of names of sub-directories which `rgrep' shall not recurse into.
+ "List of names of sub-directories which `rgrep' shall not recurse into.
If an element is a cons cell, the car is called on the search directory
to determine whether cdr should not be recursed into."
:type '(choice (repeat :tag "Ignored directories" string)
(unless (string-match-p "/\\'" s)
(concat "*" s)))
completion-ignored-extensions)))
- "*List of file names which `rgrep' and `lgrep' shall exclude.
+ "List of file names which `rgrep' and `lgrep' shall exclude.
If an element is a cons cell, the car is called on the search directory
to determine whether cdr should not be excluded."
:type '(choice (repeat :tag "Ignored file" string)
:group 'grep)
(defcustom grep-error-screen-columns nil
- "*If non-nil, column numbers in grep hits are screen columns.
+ "If non-nil, column numbers in grep hits are screen columns.
See `compilation-error-screen-columns'"
:type '(choice (const :tag "Default" nil)
integer)
(defun grep-read-regexp ()
"Read regexp arg for interactive grep."
(let ((default (grep-tag-default)))
- (read-string
+ (read-regexp
(concat "Search for"
(if (and default (> (length default) 0))
(format " (default \"%s\"): " default) ": "))
- nil 'grep-regexp-history default)))
+ default 'grep-regexp-history)))
(defun grep-read-files (regexp)
"Read files arg for interactive grep."
(shell-quote-argument ")")
" -prune -o "))
(and grep-find-ignored-files
- (concat (shell-quote-argument "(")
+ (concat (shell-quote-argument "!") " -type d "
+ (shell-quote-argument "(")
;; we should use shell-quote-argument here
" -name "
(mapconcat
;;; Code:
-(eval-when-compile (require 'cl)) ; for case macro
-
(require 'comint)
(defvar gdb-active-process)
;; GUD commands must be visible in C buffers visited by GUD
(defgroup gud nil
- "Grand Unified Debugger mode for gdb and other debuggers under Emacs.
-Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python) and jdb."
+ "The \"Grand Unified Debugger\" interface.
+Supported debuggers include gdb, sdb, dbx, xdb, perldb,
+pdb (Python), and jdb."
:group 'processes
:group 'tools)
(defcustom gud-key-prefix "\C-x\C-a"
"Prefix of all GUD commands valid in C buffers."
- :type 'string
+ :type 'key-sequence
:group 'gud)
-(global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh)
+(global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh)
(define-key ctl-x-map " " 'gud-break) ;; backward compatibility hack
(defvar gud-marker-filter nil)
nil 'gdb-edit-value)
nil
(if gdb-show-changed-values
- (or parent (case status
- (changed 'font-lock-warning-face)
- (out-of-scope 'shadow)
- (t t)))
+ (or parent (pcase status
+ (`changed 'font-lock-warning-face)
+ (`out-of-scope 'shadow)
+ (_ t)))
t)
depth)
(if (eq status 'out-of-scope) (setq parent 'shadow))
nil 'gdb-edit-value)
nil
(if gdb-show-changed-values
- (or parent (case status
- (changed 'font-lock-warning-face)
- (out-of-scope 'shadow)
- (t t)))
+ (or parent (pcase status
+ (`changed 'font-lock-warning-face)
+ (`out-of-scope 'shadow)
+ (_ t)))
t)
depth)
(speedbar-make-tag-line
(defvar gud-dbx-history nil)
(defcustom gud-dbx-directories nil
- "*A list of directories that dbx should search for source code.
+ "A list of directories that dbx should search for source code.
If nil, only source files in the program directory
will be known to dbx.
(defvar gud-xdb-history nil)
(defcustom gud-xdb-directories nil
- "*A list of directories that xdb should search for source code.
+ "A list of directories that xdb should search for source code.
If nil, only source files in the program directory
will be known to xdb.
;; List of Java source file directories.
(defvar gud-jdb-directories (list ".")
- "*A list of directories that gud jdb should search for source code.
+ "A list of directories that gud jdb should search for source code.
The file names should be absolute, or relative to the current
directory.
(declare-function global-hl-line-highlight "hl-line" ())
(declare-function hl-line-highlight "hl-line" ())
(declare-function gdb-display-source-buffer "gdb-mi" (buffer))
-(declare-function gdb-display-buffer "gdb-mi" (buf dedicated &optional size))
;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
;; and that its line LINE is visible.
(window (and buffer
(or (get-buffer-window buffer)
(if (eq gud-minor-mode 'gdbmi)
- (or (if (get-buffer-window buffer 'visible)
- (display-buffer buffer nil 'visible))
- (unless (gdb-display-source-buffer buffer)
- (gdb-display-buffer buffer nil 'visible))))
+ (display-buffer buffer nil 'visible))
(display-buffer buffer))))
(pos))
(if buffer
(buffer-file-name)
(car frame)))))
((eq key ?F)
- (setq subst (file-name-sans-extension
- (file-name-nondirectory (if insource
- (buffer-file-name)
- (car frame))))))
+ (setq subst (file-name-base (if insource
+ (buffer-file-name)
+ (car frame)))))
((eq key ?d)
(setq subst (file-name-directory (if insource
(buffer-file-name)
(defun gud-tooltip-print-command (expr)
"Return a suitable command to print the expression EXPR."
- (case gud-minor-mode
- (gdbmi (concat "-data-evaluate-expression " expr))
- (dbx (concat "print " expr))
- ((xdb pdb) (concat "p " expr))
- (sdb (concat expr "/"))))
+ (pcase gud-minor-mode
+ (`gdbmi (concat "-data-evaluate-expression \"" expr "\""))
+ (`dbx (concat "print " expr))
+ ((or `xdb `pdb) (concat "p " expr))
+ (`sdb (concat expr "/"))))
(declare-function gdb-input "gdb-mi" (command handler))
(declare-function tooltip-expr-to-print "tooltip" (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)
;;
;; First make sure hideshow.el is in a directory in your `load-path'.
;; You can optionally byte-compile it using `M-x byte-compile-file'.
-;; Then, add the following to your ~/.emacs:
+;; Then, add the following to your init file:
;;
;; (load-library "hideshow")
;; (add-hook 'X-mode-hook ; other modes similarly
:group 'languages)
(defcustom hs-hide-comments-when-hiding-all t
- "*Hide the comments too when you do an `hs-hide-all'."
+ "Hide the comments too when you do an `hs-hide-all'."
:type 'boolean
:group 'hideshow)
(defcustom hs-minor-mode-hook nil
- "*Hook called when hideshow minor mode is activated or deactivated."
+ "Hook called when hideshow minor mode is activated or deactivated."
:type 'hook
:group 'hideshow
:version "21.1")
(defcustom hs-isearch-open 'code
- "*What kind of hidden blocks to open when doing `isearch'.
+ "What kind of hidden blocks to open when doing `isearch'.
One of the following symbols:
code -- open only code blocks
(bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
(java-mode "{" "}" "/[*/]" nil nil)
(js-mode "{" "}" "/[*/]" nil)))
- "*Alist for initializing the hideshow variables for different modes.
+ "Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
whitespace. Case does not matter.")
(defvar hs-hide-all-non-comment-function nil
- "*Function called if non-nil when doing `hs-hide-all' for non-comments.")
+ "Function called if non-nil when doing `hs-hide-all' for non-comments.")
(defvar hs-allow-nesting nil
- "*If non-nil, hiding remembers internal blocks.
+ "If non-nil, hiding remembers internal blocks.
This means that when the outer block is shown again,
any previously hidden internal blocks remain hidden.")
(defvar hs-hide-hook nil
- "*Hook called (with `run-hooks') at the end of commands to hide text.
+ "Hook called (with `run-hooks') at the end of commands to hide text.
These commands include the toggling commands (when the result is to hide
a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
(defvar hs-show-hook nil
- "*Hook called (with `run-hooks') at the end of commands to show text.
+ "Hook called (with `run-hooks') at the end of commands to show text.
These commands include the toggling commands (when the result is to show
a block), `hs-show-all' and `hs-show-block'.")
(defvar hs-set-up-overlay nil
- "*Function called with one arg, OV, a newly initialized overlay.
+ "Function called with one arg, OV, a newly initialized overlay.
Hideshow puts a unique overlay on each range of text to be hidden
in the buffer. Here is a simple example of how to use this variable:
(forward-comment (point-max)))
(re-search-forward re (point-max) t))
(if (match-beginning 1)
- ;; we have found a block beginning
+ ;; We have found a block beginning.
(progn
(goto-char (match-beginning 1))
- (if hs-hide-all-non-comment-function
- (funcall hs-hide-all-non-comment-function)
- (hs-hide-block-at-point t)))
+ (unless (if hs-hide-all-non-comment-function
+ (funcall hs-hide-all-non-comment-function)
+ (hs-hide-block-at-point t))
+ ;; Go to end of matched data to prevent from getting stuck
+ ;; with an endless loop.
+ (goto-char (match-end 0))))
;; found a comment, probably
(let ((c-reg (hs-inside-comment-p)))
(when (and c-reg (car c-reg))
:group 'languages)
(defcustom icon-indent-level 4
- "*Indentation of Icon statements with respect to containing block."
+ "Indentation of Icon statements with respect to containing block."
:type 'integer
:group 'icon)
(defcustom icon-brace-imaginary-offset 0
- "*Imagined indentation of a Icon open brace that actually follows a statement."
+ "Imagined indentation of a Icon open brace that actually follows a statement."
:type 'integer
:group 'icon)
(defcustom icon-brace-offset 0
- "*Extra indentation for braces, compared with other text in same context."
+ "Extra indentation for braces, compared with other text in same context."
:type 'integer
:group 'icon)
(defcustom icon-continued-statement-offset 4
- "*Extra indent for Icon lines not starting new statements."
+ "Extra indent for Icon lines not starting new statements."
:type 'integer
:group 'icon)
(defcustom icon-continued-brace-offset 0
- "*Extra indent for Icon substatements that start with open-braces.
+ "Extra indent for Icon substatements that start with open-braces.
This is in addition to `icon-continued-statement-offset'."
:type 'integer
:group 'icon)
(defcustom icon-auto-newline nil
- "*Non-nil means automatically newline before and after braces Icon code.
+ "Non-nil means automatically newline before and after braces Icon code.
This applies when braces are inserted."
:type 'boolean
:group 'icon)
(defcustom icon-tab-always-indent t
- "*Non-nil means TAB in Icon mode should always reindent the current line.
+ "Non-nil means TAB in Icon mode should always reindent the current line.
It will then reindent, regardless of where in the line point is
when the TAB command is used."
:type 'boolean
;;
;; INSTALLATION
;; ============
-;; Put this file on the emacs load path and load it with the following
-;; line in your .emacs file:
+;; Put this file on the emacs load path and load it with the following
+;; line in your init file:
;;
;; (add-hook 'idlwave-load-hook
;; (lambda () (require 'idlw-complete-structtag)))
"Obsolete variable. See `idlwave-html-help-location'.")
(defcustom idlwave-help-use-dedicated-frame t
- "*Non-nil means, use a separate frame for Online Help if possible."
+ "Non-nil means, use a separate frame for Online Help if possible."
:group 'idlwave-online-help
:type 'boolean)
:type 'symbol)
(defcustom idlwave-help-fontify-source-code nil
- "*Non-nil means, fontify source code displayed as help like normal code."
+ "Non-nil means, fontify source code displayed as help like normal code."
:group 'idlwave-online-help
:type 'boolean)
(defcustom idlwave-help-source-try-header t
- "*Non-nil means, try to find help in routine header when displaying source.
+ "Non-nil means, try to find help in routine header when displaying source.
Routines which are not documented in the system manual use their source as
help text. When this variable is non-nil, we try to find a description of
the help item in the first routine doclib header above the routine definition.
(defcustom idlwave-help-doclib-name "name"
- "*A regexp for the heading word to search for in doclib headers
+ "A regexp for the heading word to search for in doclib headers
which specifies the `name' section. Can be used for localization
support."
:group 'idlwave-online-help
:type 'string)
(defcustom idlwave-help-doclib-keyword "KEYWORD"
- "*A regexp for the heading word to search for in doclib headers
+ "A regexp for the heading word to search for in doclib headers
which specifies the `keywords' section. Can be used for localization
support."
:group 'idlwave-online-help
;;
;; Follow the instructions in the INSTALL file of the distribution.
;; In short, put this file on your load path and add the following
-;; lines to your .emacs file:
+;; lines to your init file:
;;
;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t)
;;
:group 'idlwave)
(defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> "
- "*Regexp to match IDL prompt at beginning of a line.
+ "Regexp to match IDL prompt at beginning of a line.
For example, \"^\r?IDL> \" or \"^\r?WAVE> \".
The \"^\r?\" is needed, to indicate the beginning of the line, with
optional return character (which IDL seems to output randomly).
This variable is used to initialize `comint-prompt-regexp' in the
-process buffer.
-
-This is a fine thing to set in your `.emacs' file."
+process buffer."
:group 'idlwave-shell-general-setup
:type 'regexp)
(defcustom idlwave-shell-process-name "idl"
- "*Name to be associated with the IDL process. The buffer for the
+ "Name to be associated with the IDL process. The buffer for the
process output is made by surrounding this name with `*'s."
:group 'idlwave-shell-general-setup
:type 'string)
;; (defcustom idlwave-shell-automatic-start...) See idlwave.el
(defcustom idlwave-shell-use-dedicated-window nil
- "*Non-nil means, never replace the shell frame with another buffer."
+ "Non-nil means, never replace the shell frame with another buffer."
:group 'idlwave-shell-general-setup
:type 'boolean)
(defcustom idlwave-shell-use-dedicated-frame nil
- "*Non-nil means, IDLWAVE should use a special frame to display shell buffer."
+ "Non-nil means, IDLWAVE should use a special frame to display shell buffer."
:group 'idlwave-shell-general-setup
:type 'boolean)
(cons symbol sexp)))
(defcustom idlwave-shell-raise-frame t
- "*Non-nil means, `idlwave-shell' raises the frame showing the shell window."
+ "Non-nil means, `idlwave-shell' raises the frame showing the shell window."
:group 'idlwave-shell-general-setup
:type 'boolean)
(defcustom idlwave-shell-arrows-do-history t
- "*Non-nil means UP and DOWN arrows move through command history.
+ "Non-nil means UP and DOWN arrows move through command history.
This variable can have 3 values:
nil Arrows just move the cursor
t Arrows force the cursor back to the current command line and
;; FIXME: add comint-input-ring-size?
(defcustom idlwave-shell-use-toolbar t
- "*Non-nil means, use the debugging toolbar in all IDL related buffers.
+ "Non-nil means, use the debugging toolbar in all IDL related buffers.
Starting the shell will then add the toolbar to all idlwave-mode buffers.
Exiting the shell will removed everywhere.
Available on XEmacs and on Emacs 21.x or later.
:type 'boolean)
(defcustom idlwave-shell-temp-pro-prefix "/tmp/idltemp"
- "*The prefix for temporary IDL files used when compiling regions.
+ "The prefix for temporary IDL files used when compiling regions.
It should be an absolute pathname.
The full temporary file name is obtained by using `make-temp-file'
so that the name will be unique among multiple Emacs processes."
:group 'idlwave-shell-general-setup
:type 'string)
-(defvar idlwave-shell-fix-inserted-breaks nil
- "*OBSOLETE VARIABLE, is no longer used.
-
-The documentation of this variable used to be:
-If non-nil then run `idlwave-shell-remove-breaks' to clean up IDL messages.")
-
(defcustom idlwave-shell-prefix-key "\C-c\C-d"
- "*The prefix key for the debugging map `idlwave-shell-mode-prefix-map'.
+ "The prefix key for the debugging map `idlwave-shell-mode-prefix-map'.
This variable must already be set when idlwave-shell.el is loaded.
Setting it in the mode-hook is too late."
:group 'idlwave-shell-general-setup
;; (defcustom idlwave-shell-debug-modifiers... See idlwave.el
-(defvar idlwave-shell-activate-alt-keybindings nil
- "Obsolete variable. See `idlwave-shell-debug-modifiers'.")
-
(defcustom idlwave-shell-use-truename nil
- "*Non-nil means, use `file-truename' when looking for buffers.
+ "Non-nil means, use `file-truename' when looking for buffers.
If this variable is non-nil, Emacs will use the function `file-truename' to
resolve symbolic links in the file paths printed by e.g., STOP commands.
This means, unvisited files will be loaded under their truename.
:type 'string)
(defcustom idlwave-shell-mode-hook '()
- "*Hook for customizing `idlwave-shell-mode'."
+ "Hook for customizing `idlwave-shell-mode'."
:group 'idlwave-shell-general-setup
:type 'hook)
(defcustom idlwave-shell-show-commands
'(run misc breakpoint)
- "*A list of command types to show output from in the shell.
+ "A list of command types to show output from in the shell.
Possibilities are 'run, 'debug, 'breakpoint, and 'misc. Unselected
types are not displayed in the shell. The type 'everything causes all
the copious shell traffic to be displayed."
(string :tag "Label ")
(string :tag "Command"))))
-(defvar idlwave-shell-print-expression-function nil
- "*OBSOLETE VARIABLE, is no longer used.")
-
(defcustom idlwave-shell-separate-examine-output t
- "*Non-nil means, put output of examine commands in their own buffer."
+ "Non-nil means, put output of examine commands in their own buffer."
:group 'idlwave-shell-command-setup
:type 'boolean)
(cons variable sexp)))
(defcustom idlwave-shell-query-for-class t
- "*Non-nil means query the shell for object class on object completions."
+ "Non-nil means query the shell for object class on object completions."
:group 'idlwave-shell-command-setup
:type 'boolean)
(defcustom idlwave-shell-use-input-mode-magic nil
- "*Non-nil means, IDLWAVE should check for input mode spells in output.
+ "Non-nil means, IDLWAVE should check for input mode spells in output.
The spells are strings printed by your IDL program and matched
by the regular expressions in `idlwave-shell-input-mode-spells'.
When these expressions match, IDLWAVE switches to character input mode and
(regexp :tag "Line-mode regexp")))
(defcustom idlwave-shell-breakpoint-popup-menu t
- "*If non-nil, provide a menu on mouse-3 on breakpoint lines, and
+ "If non-nil, provide a menu on mouse-3 on breakpoint lines, and
popup help text on the line."
:group 'idlwave-shell-command-setup
:type 'boolean)
:group 'idlwave)
(defcustom idlwave-shell-mark-stop-line t
- "*Non-nil means, mark the source code line where IDL is currently stopped.
+ "Non-nil means, mark the source code line where IDL is currently stopped.
Value decides about the method which is used to mark the line. Valid values
are:
(const :tag "Face or arrow." t)))
(defcustom idlwave-shell-overlay-arrow ">"
- "*The overlay arrow to display at source lines where execution halts.
+ "The overlay arrow to display at source lines where execution halts.
We use a single character by default, since the main block of IDL procedures
often has no indentation. Where possible, IDLWAVE will use overlays to
display the stop-lines. The arrow is only used on character-based terminals.
:type 'string)
(defcustom idlwave-shell-stop-line-face 'highlight
- "*The face for `idlwave-shell-stop-line-overlay'.
+ "The face for `idlwave-shell-stop-line-overlay'.
Allows you to choose the font, color and other properties for
line where IDL is stopped. See also `idlwave-shell-mark-stop-line'."
:group 'idlwave-shell-highlighting-and-faces
:type 'symbol)
(defcustom idlwave-shell-electric-stop-color "Violet"
- "*The color for the default face or overlay arrow when stopped."
+ "The color for the default face or overlay arrow when stopped."
:group 'idlwave-shell-highlighting-and-faces
:type 'string)
(defcustom idlwave-shell-electric-stop-line-face
(prog1
- (copy-face 'modeline 'idlwave-shell-electric-stop-line)
+ (copy-face 'mode-line 'idlwave-shell-electric-stop-line)
(set-face-background 'idlwave-shell-electric-stop-line
idlwave-shell-electric-stop-color)
(condition-case nil
(set-face-foreground 'idlwave-shell-electric-stop-line nil)
(error nil)))
- "*The face for `idlwave-shell-stop-line-overlay' when in electric debug mode.
+ "The face for `idlwave-shell-stop-line-overlay' when in electric debug mode.
Allows you to choose the font, color and other properties for the line
where IDL is stopped, when in Electric Debug Mode."
:group 'idlwave-shell-highlighting-and-faces
:type 'symbol)
(defcustom idlwave-shell-mark-breakpoints t
- "*Non-nil means, mark breakpoints in the source files.
+ "Non-nil means, mark breakpoints in the source files.
Valid values are:
nil Do not mark breakpoints.
'face Highlight line with `idlwave-shell-breakpoint-face'.
(const :tag "Display glyph (red dot)" glyph)
(const :tag "Glyph or face." t)))
-(defvar idlwave-shell-use-breakpoint-glyph t
- "Obsolete variable. See `idlwave-shell-mark-breakpoints'.")
-
(defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp
- "*The face for breakpoint lines in the source code.
+ "The face for breakpoint lines in the source code.
Allows you to choose the font, color and other properties for
lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
:group 'idlwave-shell-highlighting-and-faces
(defcustom idlwave-shell-disabled-breakpoint-face
'idlwave-shell-disabled-bp
- "*The face for disabled breakpoint lines in the source code.
+ "The face for disabled breakpoint lines in the source code.
Allows you to choose the font, color and other properties for
lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
:group 'idlwave-shell-highlighting-and-faces
(defcustom idlwave-shell-expression-face 'secondary-selection
- "*The face for `idlwave-shell-expression-overlay'.
+ "The face for `idlwave-shell-expression-overlay'.
Allows you to choose the font, color and other properties for
the expression printed by IDL."
:group 'idlwave-shell-highlighting-and-faces
:type 'symbol)
(defcustom idlwave-shell-output-face 'secondary-selection
- "*The face for `idlwave-shell-output-overlay'.
+ "The face for `idlwave-shell-output-overlay'.
Allows you to choose the font, color and other properties for
the expression output by IDL."
:group 'idlwave-shell-highlighting-and-faces
"^% Skipped to:"
"^% Stop encountered:"
)
- "*A list of regular expressions matching IDL messages.
+ "A list of regular expressions matching IDL messages.
These are the messages containing file and line information where
IDL is currently stopped.")
(defconst idlwave-shell-trace-message-re
"^% At " ;; First line of a trace message
- "*A regular expression matching IDL trace messages. These are the
+ "A regular expression matching IDL trace messages. These are the
messages containing file and line information of a current
traceback.")
(defconst idlwave-shell-step-messages
'("^% Stepped to:"
)
- "*A list of regular expressions matching stepped execution messages.
+ "A list of regular expressions matching stepped execution messages.
These are IDL messages containing file and line information where
IDL has currently stepped.")
(defvar idlwave-shell-break-message "^% Breakpoint at:"
- "*Regular expression matching an IDL breakpoint message line.")
+ "Regular expression matching an IDL breakpoint message line.")
(defconst idlwave-shell-electric-debug-help
" ==> IDLWAVE Electric Debug Mode Help <==
"\\([ \t]*\n[ \t]*[^ \t\n]+\\)*" ; continuation lines file name (6)
"\\)" ; end line number group (5)
)
- "*A regular expression to parse out the file name and line number.
+ "A regular expression to parse out the file name and line number.
The 1st group should match the subroutine name.
The 3rd group is the line number.
The 5th group is the file name.
([( ?[)] ?[ idlwave-shell-goto-previous-bp t t)
([( ?])] ?] idlwave-shell-goto-next-bp t t)
([(control ?f)] ?f idlwave-shell-window)))
- (mod (cond ((and idlwave-shell-debug-modifiers
- (listp idlwave-shell-debug-modifiers)
- (not (equal '() idlwave-shell-debug-modifiers)))
- idlwave-shell-debug-modifiers)
- (idlwave-shell-activate-alt-keybindings
- '(alt))))
+ (mod (and (listp idlwave-shell-debug-modifiers)
+ idlwave-shell-debug-modifiers))
(shift (memq 'shift mod))
(mod-noshift (delete 'shift (copy-sequence mod)))
s k1 c2 k2 cmd electric only-buffer cannotshift)
;;
;; Follow the instructions in the INSTALL file of the distribution.
;; In short, put this file on your load path and add the following
-;; lines to your .emacs file:
+;; lines to your init file:
;;
;; (autoload 'idlwave-mode "idlwave" "IDLWAVE Mode" t)
;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t)
:group 'idlwave)
(defcustom idlwave-main-block-indent 2
- "*Extra indentation for the main block of code.
+ "Extra indentation for the main block of code.
That is the block between the FUNCTION/PRO statement and the END
statement for that program unit."
:group 'idlwave-code-formatting
:type 'integer)
(defcustom idlwave-block-indent 3
- "*Extra indentation applied to block lines.
+ "Extra indentation applied to block lines.
If you change this, you probably also want to change `idlwave-end-offset'."
:group 'idlwave-code-formatting
:type 'integer)
(defcustom idlwave-end-offset -3
- "*Extra indentation applied to block END lines.
+ "Extra indentation applied to block END lines.
A value equal to negative `idlwave-block-indent' will make END lines
line up with the block BEGIN lines."
:group 'idlwave-code-formatting
:type 'integer)
(defcustom idlwave-continuation-indent 3
- "*Extra indentation applied to continuation lines.
+ "Extra indentation applied to continuation lines.
This extra offset applies to the first of a set of continuation lines.
The following lines receive the same indentation as the first."
:group 'idlwave-code-formatting
:type 'integer)
(defcustom idlwave-max-extra-continuation-indent 40
- "*Maximum additional indentation for special continuation indent.
+ "Maximum additional indentation for special continuation indent.
Several special indentations are tried to help line up continuation
lines in routine calls or definitions, other statements with
parentheses, or assignment statements. This variable specifies a
:type 'integer)
(defcustom idlwave-indent-to-open-paren t
- "*Non-nil means, indent continuation lines to innermost open parenthesis.
+ "Non-nil means, indent continuation lines to innermost open parenthesis.
This indentation occurs even if otherwise disallowed by
`idlwave-max-extra-continuation-indent'. Matching parens and the
interleaving args are lined up. Example:
:type 'boolean)
(defcustom idlwave-indent-parens-nested nil
- "*Non-nil means, indent continuation lines with parens by nesting
+ "Non-nil means, indent continuation lines with parens by nesting
lines at consecutively deeper levels."
:group 'idlwave-code-formatting
:type 'boolean)
(defcustom idlwave-hanging-indent t
- "*If set non-nil then comment paragraphs are indented under the
+ "If set non-nil then comment paragraphs are indented under the
hanging indent given by `idlwave-hang-indent-regexp' match in the first line
of the paragraph."
:group 'idlwave-code-formatting
:type 'boolean)
(defcustom idlwave-hang-indent-regexp "- "
- "*Regular expression matching the position of the hanging indent
+ "Regular expression matching the position of the hanging indent
in the first line of a comment paragraph. The size of the indent
extends to the end of the match for the regular expression."
:group 'idlwave-code-formatting
:type 'regexp)
(defcustom idlwave-use-last-hang-indent nil
- "*If non-nil then use last match on line for `idlwave-indent-regexp'."
+ "If non-nil then use last match on line for `idlwave-indent-regexp'."
:group 'idlwave-code-formatting
:type 'boolean)
(defcustom idlwave-fill-comment-line-only t
- "*If non-nil then auto fill will only operate on comment lines."
+ "If non-nil then auto fill will only operate on comment lines."
:group 'idlwave-code-formatting
:type 'boolean)
(defcustom idlwave-auto-fill-split-string t
- "*If non-nil then auto fill will split strings with the IDL `+' operator.
+ "If non-nil then auto fill will split strings with the IDL `+' operator.
When the line end falls within a string, string concatenation with the
'+' operator will be used to distribute a long string over lines.
If nil and a string is split then a terminal beep and warning are issued.
:type 'boolean)
(defcustom idlwave-split-line-string t
- "*If non-nil then `idlwave-split-line' will split strings with `+'.
+ "If non-nil then `idlwave-split-line' will split strings with `+'.
When the splitting point of a line falls inside a string, split the string
using the `+' string concatenation operator. If nil and a string is
split then a terminal beep and warning are issued."
:type 'boolean)
(defcustom idlwave-no-change-comment ";;;"
- "*The indentation of a comment that starts with this regular
+ "The indentation of a comment that starts with this regular
expression will not be changed. Note that the indentation of a comment
at the beginning of a line is never changed."
:group 'idlwave-code-formatting
:type 'string)
(defcustom idlwave-begin-line-comment nil
- "*A comment anchored at the beginning of line.
+ "A comment anchored at the beginning of line.
A comment matching this regular expression will not have its
indentation changed. If nil the default is \"^;\", i.e., any line
beginning with a \";\". Expressions for comments at the beginning of
'regexp))
(defcustom idlwave-code-comment ";;[^;]"
- "*A comment that starts with this regular expression on a line by
+ "A comment that starts with this regular expression on a line by
itself is indented as if it is a part of IDL code. As a result if
the comment is not preceded by whitespace it is unchanged."
:group 'idlwave-code-formatting
:group 'idlwave)
(defcustom idlwave-use-library-catalogs t
- "*Non-nil means search the IDL path for library catalog files.
+ "Non-nil means search the IDL path for library catalog files.
These files, named .idlwave_catalog, document routine information for
individual directories and libraries of IDL .pro files. Many popular
:type 'boolean)
(defcustom idlwave-init-rinfo-when-idle-after 10
- "*Seconds of idle time before routine info is automatically initialized.
+ "Seconds of idle time before routine info is automatically initialized.
Initializing the routine info can take a long time, in particular if a
large number of library catalogs are involved. When Emacs is idle for
more than the number of seconds specified by this variable, it starts
:type 'number)
(defcustom idlwave-scan-all-buffers-for-routine-info t
- "*Non-nil means, scan buffers for IDL programs when updating info.
+ "Non-nil means, scan buffers for IDL programs when updating info.
The scanning is done by the command `idlwave-update-routine-info'.
The following values are allowed:
(const :tag "Current buffer only" 'current)))
(defcustom idlwave-query-shell-for-routine-info t
- "*Non-nil means query the shell for info about compiled routines.
+ "Non-nil means query the shell for info about compiled routines.
Querying the shell is useful to get information about compiled modules,
and it is turned on by default. However, when you have a complete library
scan, this is not necessary."
(defcustom idlwave-auto-routine-info-updates
'(find-file save-buffer kill-buffer compile-buffer)
- "*Controls under what circumstances routine info is updated automatically.
+ "Controls under what circumstances routine info is updated automatically.
Possible values:
nil Never
t All available
(const :tag "After a buffer was compiled successfully, update shell info" compile-buffer))))
(defcustom idlwave-rinfo-max-source-lines 5
- "*Maximum number of source files displayed in the Routine Info window.
+ "Maximum number of source files displayed in the Routine Info window.
When an integer, it is the maximum number of source files displayed.
A value of t means to show all source files."
:group 'idlwave-routine-info
;; Configuration files
(defcustom idlwave-config-directory
(convert-standard-filename "~/.idlwave")
- "*Directory for configuration files and user-library catalog."
+ "Directory for configuration files and user-library catalog."
:group 'idlwave-routine-info
:type 'file)
(defvar idlwave-xml-system-rinfo-converted-file "idl_xml_rinfo.el")
(defvar idlwave-path-file "idlpath.el")
-(defvar idlwave-libinfo-file nil
- "*Obsolete variable, no longer used.")
-
(defcustom idlwave-special-lib-alist nil
"Alist of regular expressions matching special library directories.
When listing routine source locations, IDLWAVE gives a short hint where
,idlwave-tmp)))
(defcustom idlwave-completion-force-default-case nil
- "*Non-nil means, completion will always honor `idlwave-completion-case'.
+ "Non-nil means, completion will always honor `idlwave-completion-case'.
When nil, only the completion of a mixed case or upper case string
will honor the default settings in `idlwave-completion-case', while
the completion of lower case strings will be completed entirely in
:type 'boolean)
(defcustom idlwave-complete-empty-string-as-lower-case nil
- "*Non-nil means, the empty string is considered downcase for completion.
+ "Non-nil means, the empty string is considered downcase for completion.
The case of what is already in the buffer determines the case of completions.
When this variable is non-nil, the empty string is considered to be downcase.
Completing on the empty string then offers downcase versions of the possible
:group 'idlwave-completion
:type 'boolean)
-(defvar idlwave-default-completion-case-is-down nil
- "Obsolete variable. See `idlwave-complete-empty-string-as-lower-case' and
-`idlwave-completion-case'.")
-
(defcustom idlwave-buffer-case-takes-precedence nil
- "*Non-nil means, the case of tokens in buffers dominates over system stuff.
+ "Non-nil means, the case of tokens in buffers dominates over system stuff.
To make this possible, we need to re-case everything each time we update
the routine info from the buffers. This is slow.
The default is to consider the case given in the system and library files
:type 'boolean)
(defcustom idlwave-highlight-help-links-in-completion t
- "*Non-nil means, highlight completions for which system help is available.
+ "Non-nil means, highlight completions for which system help is available.
Help can then be accessed with mouse-3.
This option is only effective when the online help system is installed."
:group 'idlwave-completion
(defcustom idlwave-completion-show-classes 1
- "*Number of classes to show when completing object methods and keywords.
+ "Number of classes to show when completing object methods and keywords.
When completing methods or keywords for an object with unknown class,
the *Completions* buffer will show the valid classes for each completion
like this:
(integer :tag "Number of classes shown" 1)))
(defcustom idlwave-completion-fontify-classes t
- "*Non-nil means, fontify the classes in completions buffer.
+ "Non-nil means, fontify the classes in completions buffer.
This makes it easier to distinguish the completion items from the extra
class info listed. See `idlwave-completion-show-classes'."
:group 'idlwave-completion
(boolean :tag "Determine class for this method")))))
(defcustom idlwave-store-inquired-class t
- "*Non-nil means, store class of a method call as text property on `->'.
+ "Non-nil means, store class of a method call as text property on `->'.
IDLWAVE sometimes has to ask the user for the class associated with a
particular object method call. This happens during the commands
`idlwave-routine-info' and `idlwave-complete', depending upon the
:type 'boolean)
(defcustom idlwave-class-arrow-face 'bold
- "*Face to highlight object operator arrows `->' which carry a class property.
+ "Face to highlight object operator arrows `->' which carry a class property.
When IDLWAVE stores a class name as text property on an object arrow
\(see variable `idlwave-store-inquired-class', it highlights the arrow
with this font in order to remind the user that this arrow is special."
:type 'symbol)
(defcustom idlwave-resize-routine-help-window t
- "*Non-nil means, resize the Routine-info *Help* window to fit the content."
+ "Non-nil means, resize the Routine-info *Help* window to fit the content."
:group 'idlwave-completion
:type 'boolean)
(defcustom idlwave-keyword-completion-adds-equal t
- "*Non-nil means, completion automatically adds `=' after completed keywords."
+ "Non-nil means, completion automatically adds `=' after completed keywords."
:group 'idlwave-completion
:type 'boolean)
(defcustom idlwave-function-completion-adds-paren t
- "*Non-nil means, completion automatically adds `(' after completed function.
+ "Non-nil means, completion automatically adds `(' after completed function.
nil means, don't add anything.
A value of `2' means, also add the closing parenthesis and position cursor
between the two."
(const :tag "()" 2)))
(defcustom idlwave-completion-restore-window-configuration t
- "*Non-nil means, try to restore the window configuration after completion.
+ "Non-nil means, try to restore the window configuration after completion.
When completion is not unique, Emacs displays a list of completions.
This messes up your window configuration. With this variable set, IDLWAVE
restores the old configuration after successful completion."
:group 'idlwave)
(defcustom idlwave-do-actions nil
- "*Non-nil means performs actions when indenting.
+ "Non-nil means performs actions when indenting.
The actions that can be performed are listed in `idlwave-indent-action-table'."
:group 'idlwave-abbrev-and-indent-action
:type 'boolean)
(defcustom idlwave-abbrev-start-char "\\"
- "*A single character string used to start abbreviations in abbrev mode.
+ "A single character string used to start abbreviations in abbrev mode.
Possible characters to chose from: ~`\%
or even '?'. '.' is not a good choice because it can make structure
field names act like abbrevs in certain circumstances.
Changes to this in `idlwave-mode-hook' will have no effect. Instead a user
-must set it directly using `setq' in the .emacs file before idlwave.el
+must set it directly using `setq' in the init file before idlwave.el
is loaded."
:group 'idlwave-abbrev-and-indent-action
:type 'string)
(defcustom idlwave-surround-by-blank nil
- "*Non-nil means, enable `idlwave-surround'.
+ "Non-nil means, enable `idlwave-surround'.
If non-nil, `=',`<',`>',`&',`,', `->' are surrounded with spaces by
`idlwave-surround'.
See help for `idlwave-indent-action-table' for symbols using `idlwave-surround'.
:type 'boolean)
(defcustom idlwave-pad-keyword t
- "*Non-nil means pad '=' in keywords (routine calls or defs) like assignment.
+ "Non-nil means pad '=' in keywords (routine calls or defs) like assignment.
Whenever `idlwave-surround' is non-nil then this affects how '=' is
padded for keywords and for variables. If t, pad the same as for
assignments. If nil then spaces are removed. With any other value,
(const :tag "Keep space near `='" 'keep)))
(defcustom idlwave-show-block t
- "*Non-nil means point blinks to block beginning for `idlwave-show-begin'."
+ "Non-nil means point blinks to block beginning for `idlwave-show-begin'."
:group 'idlwave-abbrev-and-indent-action
:type 'boolean)
(defcustom idlwave-expand-generic-end nil
- "*Non-nil means expand generic END to ENDIF/ENDELSE/ENDWHILE etc."
+ "Non-nil means expand generic END to ENDIF/ENDELSE/ENDWHILE etc."
:group 'idlwave-abbrev-and-indent-action
:type 'boolean)
(defcustom idlwave-reindent-end t
- "*Non-nil means re-indent line after END was typed."
+ "Non-nil means re-indent line after END was typed."
:group 'idlwave-abbrev-and-indent-action
:type 'boolean)
(defcustom idlwave-abbrev-move t
- "*Non-nil means the abbrev hook can move point.
+ "Non-nil means the abbrev hook can move point.
Set to nil by `idlwave-expand-region-abbrevs'. To see the abbrev
definitions, use the command `list-abbrevs', for abbrevs that move
point. Moving point is useful, for example, to place point between
:type 'boolean)
(defcustom idlwave-abbrev-change-case nil
- "*Non-nil means all abbrevs will be forced to either upper or lower case.
+ "Non-nil means all abbrevs will be forced to either upper or lower case.
If the value t, all expanded abbrevs will be upper case.
If the value is 'down then abbrevs will be forced to lower case.
If nil, the case will not change.
:type 'boolean)
(defcustom idlwave-reserved-word-upcase nil
- "*Non-nil means, reserved words will be made upper case via abbrev expansion.
+ "Non-nil means, reserved words will be made upper case via abbrev expansion.
If nil case of reserved words is controlled by `idlwave-abbrev-change-case'.
Has effect only if in abbrev-mode."
:group 'idlwave-abbrev-and-indent-action
;; '(capitalize-word -1) t)
(defvar idlwave-indent-action-table nil
- "*Associated array containing action lists of search string (car),
+ "Associated array containing action lists of search string (car),
and function as a cdr. This table is used by `idlwave-indent-line'.
See documentation for `idlwave-do-action' for a complete description of
the action lists.
See help on `idlwave-action-and-binding' for examples.")
(defvar idlwave-indent-expand-table nil
- "*Associated array containing action lists of search string (car),
+ "Associated array containing action lists of search string (car),
and function as a cdr. The table is used by the
`idlwave-indent-and-action' function. See documentation for
`idlwave-do-action' for a complete description of the action lists.
;
;-
")
- "*A list (PATHNAME STRING) specifying the doc-header template to use for
+ "A list (PATHNAME STRING) specifying the doc-header template to use for
summarizing a file. If PATHNAME is non-nil then this file will be included.
Otherwise STRING is used. If nil, the file summary will be omitted.
For example you might set PATHNAME to the path for the
lib_template.pro file included in the IDL distribution.")
(defcustom idlwave-header-to-beginning-of-file t
- "*Non-nil means, the documentation header will always be at start of file.
+ "Non-nil means, the documentation header will always be at start of file.
When nil, the header is positioned between the PRO/FUNCTION line of
the current routine and the code, allowing several routine headers in
a file."
:type 'boolean)
(defcustom idlwave-timestamp-hook 'idlwave-default-insert-timestamp
- "*The hook function used to update the timestamp of a function."
+ "The hook function used to update the timestamp of a function."
:group 'idlwave-documentation
:type 'function)
(defcustom idlwave-doc-modifications-keyword "HISTORY"
- "*The modifications keyword to use with the log documentation commands.
+ "The modifications keyword to use with the log documentation commands.
A ':' is added to the keyword end.
Inserted by doc-header and used to position logs by doc-modification.
If nil it will not be inserted."
:type 'string)
(defcustom idlwave-doclib-start "^;+\\+"
- "*Regexp matching the start of a document library header."
+ "Regexp matching the start of a document library header."
:group 'idlwave-documentation
:type 'regexp)
(defcustom idlwave-doclib-end "^;+-"
- "*Regexp matching the end of a document library header."
+ "Regexp matching the end of a document library header."
:group 'idlwave-documentation
:type 'regexp)
:group 'idlwave)
(defcustom idlwave-shell-explicit-file-name "idl"
- "*If non-nil, this is the command to run IDL.
+ "If non-nil, this is the command to run IDL.
Should be an absolute file path or path relative to the current environment
execution search path. If you want to specify command line switches
for the IDL program, use `idlwave-shell-command-line-options'.
:type 'string)
(defcustom idlwave-shell-command-line-options nil
- "*A list of command line options for calling the IDL program.
+ "A list of command line options for calling the IDL program.
Since IDL is executed directly without going through a shell like /bin/sh,
this should be a list of strings like '(\"-rt=file\" \"-nw\") with a separate
string for each argument. But you may also give a single string which
:group 'idlwave-external-programs)
(defcustom idlwave-help-application "idlhelp"
- "*The external application providing reference help for programming.
+ "The external application providing reference help for programming.
Obsolete, if the IDL Assistant is being used for help."
:group 'idlwave-external-programs
:type 'string)
(const shift)))
(defcustom idlwave-shell-automatic-start nil
- "*If non-nil attempt invoke `idlwave-shell' if not already running.
+ "If non-nil attempt invoke `idlwave-shell' if not already running.
This is checked when an attempt to send a command to an
IDL process is made."
:group 'idlwave-shell-general-setup
:group 'idlwave)
(defcustom idlwave-startup-message t
- "*Non-nil displays a startup message when `idlwave-mode' is first called."
+ "Non-nil displays a startup message when `idlwave-mode' is first called."
:group 'idlwave-misc
:type 'boolean)
(common-blocks
'("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?"
(1 font-lock-keyword-face) ; "common"
- (2 font-lock-reference-face nil t) ; block name
+ (2 font-lock-constant-face nil t) ; block name
("[ \t]*\\(\\sw+\\)[ ,]*"
;; Start with point after block name and comma
(goto-char (match-end 0)) ; needed for XEmacs, could be nil
;; Labels
(label
- '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-reference-face)))
+ '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face)))
;; The goto statement and its label
(goto
'("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)"
(1 font-lock-keyword-face)
- (2 font-lock-reference-face)))
+ (2 font-lock-constant-face)))
;; Tags in structure definitions. Note that this definition
;; actually collides with labels, so we have to use the same
;; face. It also matches named subscript ranges,
;; e.g. vec{bottom:top]. No good way around this.
(structtag
- '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face)))
+ '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-constant-face)))
;; Structure names
(structname
;; fontification. Slow, use it only in fancy fontification.
(keyword-parameters
'("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\([ \t]*\\(;.*\\)?\n\\)*[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)"
- (6 font-lock-reference-face)))
+ (6 font-lock-constant-face)))
;; System variables start with a bang.
(system-variables
nil 'idlwave-load-rinfo-next-step)))
(error nil))))
-(defvar idlwave-library-routines nil "Obsolete variable.")
-
;;------ XML Help routine info system
(defun idlwave-load-system-routine-info ()
;; Load the system routine info from the cached routine info file,
class
(cond ((not (boundp 'idlwave-scanning-lib))
(list 'buffer (buffer-file-name)))
-; ((string= (downcase
-; (file-name-sans-extension
-; (file-name-nondirectory (buffer-file-name))))
+; ((string= (downcase (file-name-base))
; (downcase name))
; (list 'lib))
; (t (cons 'lib (file-name-nondirectory (buffer-file-name))))
;;;###autoload
(defcustom inferior-lisp-filter-regexp
(purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'")
- "*What not to save on inferior Lisp's input history.
+ "What not to save on inferior Lisp's input history.
Input matching this regexp is not saved on the input history in Inferior Lisp
mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
\(as in :a, :c, etc.)"
;;;###autoload
(defcustom inferior-lisp-program (purecopy "lisp")
- "*Program name for invoking an inferior Lisp in Inferior Lisp mode."
+ "Program name for invoking an inferior Lisp in Inferior Lisp mode."
:type 'string
:group 'inferior-lisp)
;;;###autoload
(defcustom inferior-lisp-load-command (purecopy "(load \"%s\")\n")
- "*Format-string for building a Lisp expression to load a file.
+ "Format-string for building a Lisp expression to load a file.
This format string should use `%s' to substitute a file name
and should result in a Lisp expression that will command the inferior Lisp
to load that file. The default works acceptably on most Lisps.
More precise choices:
Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
-kcl: \"^>+ *\"
-
-This is a fine thing to set in your .emacs file or through Custom."
+kcl: \"^>+ *\""
:type 'regexp
:group 'inferior-lisp)
;;;###autoload
(defvar inferior-lisp-mode-hook '()
- "*Hook for customizing Inferior Lisp mode.")
+ "Hook for customizing Inferior Lisp mode.")
(put 'inferior-lisp-mode 'mode-class 'special)
describing the last `lisp-load-file' or `lisp-compile-file' command.")
(defcustom lisp-source-modes '(lisp-mode)
- "*Used to determine if a buffer contains Lisp source code.
+ "Used to determine if a buffer contains Lisp source code.
If it's loaded into a buffer that is in one of these major modes, it's
considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'.
Used by these commands to determine defaults."
-;;; js.el --- Major mode for editing JavaScript
+;;; js.el --- Major mode for editing JavaScript -*- lexical-binding: t -*-
;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
(require 'json nil t)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'comint)
(require 'ido))
")
(defconst js--available-frameworks
- (loop with available-frameworks
- for style in js--class-styles
- for framework = (plist-get style :framework)
- unless (memq framework available-frameworks)
- collect framework into available-frameworks
- finally return available-frameworks)
+ (cl-loop for style in js--class-styles
+ for framework = (plist-get style :framework)
+ unless (memq framework available-frameworks)
+ collect framework into available-frameworks
+ finally return available-frameworks)
"List of available JavaScript frameworks symbols.")
(defconst js--function-heading-1-re
;; (The exception for b-end and its caveats is described below.)
;;
-(defstruct (js--pitem (:type list))
+(cl-defstruct (js--pitem (:type list))
;; IMPORTANT: Do not alter the position of fields within the list.
;; Various bits of code depend on their positions, particularly
;; anything that manipulates the list of children.
(defcustom js-indent-level 4
"Number of spaces for each indentation step in `js-mode'."
:type 'integer
+ :safe 'integerp
:group 'js)
(defcustom js-expr-indent-offset 0
"Number of additional spaces for indenting continued expressions.
The value must be no less than minus `js-indent-level'."
:type 'integer
+ :safe 'integerp
:group 'js)
(defcustom js-paren-indent-offset 0
"Number of additional spaces for indenting expressions in parentheses.
The value must be no less than minus `js-indent-level'."
:type 'integer
+ :safe 'integerp
:group 'js
:version "24.1")
"Number of additional spaces for indenting expressions in square braces.
The value must be no less than minus `js-indent-level'."
:type 'integer
+ :safe 'integerp
:group 'js
:version "24.1")
"Number of additional spaces for indenting expressions in curly braces.
The value must be no less than minus `js-indent-level'."
:type 'integer
+ :safe 'integerp
:group 'js
:version "24.1")
(make-variable-buffer-local 'js--state-at-last-parse-pos)
(defun js--flatten-list (list)
- (loop for item in list
- nconc (cond ((consp item)
- (js--flatten-list item))
- (item (list item)))))
+ (cl-loop for item in list
+ nconc (cond ((consp item)
+ (js--flatten-list item))
+ (item (list item)))))
(defun js--maybe-join (prefix separator suffix &rest list)
"Helper function for `js--update-quick-match-re'.
"Move forward over a whole JavaScript expression.
This function doesn't move over expressions continued across
lines."
- (loop
+ (cl-loop
;; non-continued case; simplistic, but good enough?
- do (loop until (or (eolp)
- (progn
- (forward-comment most-positive-fixnum)
- (memq (char-after) '(?\, ?\; ?\] ?\) ?\}))))
- do (forward-sexp))
+ do (cl-loop until (or (eolp)
+ (progn
+ (forward-comment most-positive-fixnum)
+ (memq (char-after) '(?\, ?\; ?\] ?\) ?\}))))
+ do (forward-sexp))
while (and (eq (char-after) ?\n)
(save-excursion
If this is a syntactically-correct non-expression function,
return the name of the function, or t if the name could not be
determined. Otherwise, return nil."
- (assert (looking-at "\\_<function\\_>"))
+ (cl-assert (looking-at "\\_<function\\_>"))
(let ((name t))
(forward-word)
(forward-comment most-positive-fixnum)
"Helper function for `js--beginning-of-defun-nested'.
If PSTATE represents a non-empty top-level defun, return the
top-most pitem. Otherwise, return nil."
- (loop for pitem in pstate
- with func-depth = 0
- with func-pitem
- if (eq 'function (js--pitem-type pitem))
- do (incf func-depth)
- and do (setq func-pitem pitem)
- finally return (if (eq func-depth 1) func-pitem)))
+ (cl-loop for pitem in pstate
+ with func-depth = 0
+ with func-pitem
+ if (eq 'function (js--pitem-type pitem))
+ do (cl-incf func-depth)
+ and do (setq func-pitem pitem)
+ finally return (if (eq func-depth 1) func-pitem)))
(defun js--beginning-of-defun-nested ()
"Helper function for `js--beginning-of-defun'.
Return the pitem of the function we went to the beginning of."
(or
;; Look for the smallest function that encloses point...
- (loop for pitem in (js--parse-state-at-point)
- if (and (eq 'function (js--pitem-type pitem))
- (js--inside-pitem-p pitem))
- do (goto-char (js--pitem-h-begin pitem))
- and return pitem)
+ (cl-loop for pitem in (js--parse-state-at-point)
+ if (and (eq 'function (js--pitem-type pitem))
+ (js--inside-pitem-p pitem))
+ do (goto-char (js--pitem-h-begin pitem))
+ and return pitem)
;; ...and if that isn't found, look for the previous top-level
;; defun
- (loop for pstate = (js--backward-pstate)
- while pstate
- if (js--pstate-is-toplevel-defun pstate)
- do (goto-char (js--pitem-h-begin it))
- and return it)))
+ (cl-loop for pstate = (js--backward-pstate)
+ while pstate
+ if (js--pstate-is-toplevel-defun pstate)
+ do (goto-char (js--pitem-h-begin it))
+ and return it)))
(defun js--beginning-of-defun-flat ()
"Helper function for `js-beginning-of-defun'."
"Value of `beginning-of-defun-function' for `js-mode'."
(setq arg (or arg 1))
(while (and (not (eobp)) (< arg 0))
- (incf arg)
+ (cl-incf arg)
(when (and (not js-flat-functions)
(or (eq (js-syntactic-context) 'function)
(js--function-prologue-beginning)))
(goto-char (point-max))))
(while (> arg 0)
- (decf arg)
+ (cl-decf arg)
;; If we're just past the end of a function, the user probably wants
;; to go to the beginning of *that* function
(when (eq (char-before) ?})
(defun js--ensure-cache--pop-if-ended (open-items paren-depth)
(let ((top-item (car open-items)))
(when (<= paren-depth (js--pitem-paren-depth top-item))
- (assert (not (get-text-property (1- (point)) 'js-pend)))
+ (cl-assert (not (get-text-property (1- (point)) 'js-pend)))
(put-text-property (1- (point)) (point) 'js--pend top-item)
(setf (js--pitem-b-end top-item) (point))
(setq open-items
;; open-items must contain at least two items for this to
;; work, but because we push a dummy item to start with,
;; that assumption holds.
- (cons (js--pitem-add-child (second open-items) top-item)
+ (cons (js--pitem-add-child (cl-second open-items) top-item)
(cddr open-items)))))
open-items)
;; Make sure parse-partial-sexp doesn't stop because we *entered*
;; the given depth -- i.e., make sure we're deeper than the target
;; depth.
- (assert (> (nth 0 parse)
+ (cl-assert (> (nth 0 parse)
(js--pitem-paren-depth (car open-items))))
(setq parse (parse-partial-sexp
prev-parse-point goal-point
(c-save-buffer-state
(open-items
- orig-match-start
- orig-match-end
- orig-depth
parse
prev-parse-point
name
case-fold-search
filtered-class-styles
- new-item
- goal-point
- end-prop)
+ goal-point)
;; Figure out which class styles we need to look for
(setq filtered-class-styles
- (loop for style in js--class-styles
- if (memq (plist-get style :framework)
- js-enabled-frameworks)
- collect style))
+ (cl-loop for style in js--class-styles
+ if (memq (plist-get style :framework)
+ js-enabled-frameworks)
+ collect style))
(save-excursion
(save-restriction
(unless (bobp)
(setq open-items (get-text-property (1- (point))
'js--pstate))
- (assert open-items))))
+ (cl-assert open-items))))
(unless open-items
;; Make a placeholder for the top-level definition
(narrow-to-region (point-min) limit)
- (loop while (re-search-forward js--quick-match-re-func nil t)
- for orig-match-start = (goto-char (match-beginning 0))
- for orig-match-end = (match-end 0)
- do (js--ensure-cache--update-parse)
- for orig-depth = (nth 0 parse)
-
- ;; Each of these conditions should return non-nil if
- ;; we should add a new item and leave point at the end
- ;; of the new item's header (h-end in the
- ;; js--pitem diagram). This point is the one
- ;; after the last character we need to unambiguously
- ;; detect this construct. If one of these evaluates to
- ;; nil, the location of the point is ignored.
- if (cond
- ;; In comment or string
- ((nth 8 parse) nil)
-
- ;; Regular function declaration
- ((and (looking-at "\\_<function\\_>")
- (setq name (js--forward-function-decl)))
-
- (when (eq name t)
- (setq name (js--guess-function-name orig-match-end))
- (if name
- (when js--guess-function-name-start
- (setq orig-match-start
- js--guess-function-name-start))
-
- (setq name t)))
-
- (assert (eq (char-after) ?{))
- (forward-char)
- (make-js--pitem
- :paren-depth orig-depth
- :h-begin orig-match-start
- :type 'function
- :name (if (eq name t)
- name
- (js--split-name name))))
-
- ;; Macro
- ((looking-at js--macro-decl-re)
-
- ;; Macros often contain unbalanced parentheses.
- ;; Make sure that h-end is at the textual end of
- ;; the macro no matter what the parenthesis say.
- (c-end-of-macro)
- (js--ensure-cache--update-parse)
-
- (make-js--pitem
- :paren-depth (nth 0 parse)
- :h-begin orig-match-start
- :type 'macro
- :name (list (match-string-no-properties 1))))
-
- ;; "Prototype function" declaration
- ((looking-at js--plain-method-re)
- (goto-char (match-beginning 3))
- (when (save-match-data
- (js--forward-function-decl))
- (forward-char)
- (make-js--pitem
- :paren-depth orig-depth
- :h-begin orig-match-start
- :type 'function
- :name (nconc (js--split-name
- (match-string-no-properties 1))
- (list (match-string-no-properties 2))))))
-
- ;; Class definition
- ((loop with syntactic-context =
- (js--syntactic-context-from-pstate open-items)
- for class-style in filtered-class-styles
- if (and (memq syntactic-context
- (plist-get class-style :contexts))
- (looking-at (plist-get class-style
- :class-decl)))
- do (goto-char (match-end 0))
- and return
- (make-js--pitem
- :paren-depth orig-depth
- :h-begin orig-match-start
- :type class-style
- :name (js--split-name
- (match-string-no-properties 1))))))
-
- do (js--ensure-cache--update-parse)
- and do (push it open-items)
- and do (put-text-property
- (1- (point)) (point) 'js--pstate open-items)
- else do (goto-char orig-match-end))
+ (cl-loop while (re-search-forward js--quick-match-re-func nil t)
+ for orig-match-start = (goto-char (match-beginning 0))
+ for orig-match-end = (match-end 0)
+ do (js--ensure-cache--update-parse)
+ for orig-depth = (nth 0 parse)
+
+ ;; Each of these conditions should return non-nil if
+ ;; we should add a new item and leave point at the end
+ ;; of the new item's header (h-end in the
+ ;; js--pitem diagram). This point is the one
+ ;; after the last character we need to unambiguously
+ ;; detect this construct. If one of these evaluates to
+ ;; nil, the location of the point is ignored.
+ if (cond
+ ;; In comment or string
+ ((nth 8 parse) nil)
+
+ ;; Regular function declaration
+ ((and (looking-at "\\_<function\\_>")
+ (setq name (js--forward-function-decl)))
+
+ (when (eq name t)
+ (setq name (js--guess-function-name orig-match-end))
+ (if name
+ (when js--guess-function-name-start
+ (setq orig-match-start
+ js--guess-function-name-start))
+
+ (setq name t)))
+
+ (cl-assert (eq (char-after) ?{))
+ (forward-char)
+ (make-js--pitem
+ :paren-depth orig-depth
+ :h-begin orig-match-start
+ :type 'function
+ :name (if (eq name t)
+ name
+ (js--split-name name))))
+
+ ;; Macro
+ ((looking-at js--macro-decl-re)
+
+ ;; Macros often contain unbalanced parentheses.
+ ;; Make sure that h-end is at the textual end of
+ ;; the macro no matter what the parenthesis say.
+ (c-end-of-macro)
+ (js--ensure-cache--update-parse)
+
+ (make-js--pitem
+ :paren-depth (nth 0 parse)
+ :h-begin orig-match-start
+ :type 'macro
+ :name (list (match-string-no-properties 1))))
+
+ ;; "Prototype function" declaration
+ ((looking-at js--plain-method-re)
+ (goto-char (match-beginning 3))
+ (when (save-match-data
+ (js--forward-function-decl))
+ (forward-char)
+ (make-js--pitem
+ :paren-depth orig-depth
+ :h-begin orig-match-start
+ :type 'function
+ :name (nconc (js--split-name
+ (match-string-no-properties 1))
+ (list (match-string-no-properties 2))))))
+
+ ;; Class definition
+ ((cl-loop
+ with syntactic-context =
+ (js--syntactic-context-from-pstate open-items)
+ for class-style in filtered-class-styles
+ if (and (memq syntactic-context
+ (plist-get class-style :contexts))
+ (looking-at (plist-get class-style
+ :class-decl)))
+ do (goto-char (match-end 0))
+ and return
+ (make-js--pitem
+ :paren-depth orig-depth
+ :h-begin orig-match-start
+ :type class-style
+ :name (js--split-name
+ (match-string-no-properties 1))))))
+
+ do (js--ensure-cache--update-parse)
+ and do (push it open-items)
+ and do (put-text-property
+ (1- (point)) (point) 'js--pstate open-items)
+ else do (goto-char orig-match-end))
(goto-char limit)
(js--ensure-cache--update-parse)
(defun js--end-of-defun-flat ()
"Helper function for `js-end-of-defun'."
- (loop while (js--re-search-forward "}" nil t)
- do (js--ensure-cache)
- if (get-text-property (1- (point)) 'js--pend)
- if (eq 'function (js--pitem-type it))
- return t
- finally do (goto-char (point-max))))
+ (cl-loop while (js--re-search-forward "}" nil t)
+ do (js--ensure-cache)
+ if (get-text-property (1- (point)) 'js--pend)
+ if (eq 'function (js--pitem-type it))
+ return t
+ finally do (goto-char (point-max))))
(defun js--end-of-defun-nested ()
"Helper function for `js-end-of-defun'."
"Value of `end-of-defun-function' for `js-mode'."
(setq arg (or arg 1))
(while (and (not (bobp)) (< arg 0))
- (incf arg)
+ (cl-incf arg)
(js-beginning-of-defun)
(js-beginning-of-defun)
(unless (bobp)
(js-end-of-defun)))
(while (> arg 0)
- (decf arg)
+ (cl-decf arg)
;; look for function backward. if we're inside it, go to that
;; function's end. otherwise, search for the next function's end and
;; go there
If FUNC is supplied, call it with no arguments before every
variable name in the spec. Return true iff this was actually a
spec. FUNC must preserve the match data."
- (case (char-after)
+ (pcase (char-after)
(?\[
(forward-char)
(while
(defun js--inside-pitem-p (pitem)
"Return whether point is inside the given pitem's header or body."
(js--ensure-cache)
- (assert (js--pitem-h-begin pitem))
- (assert (js--pitem-paren-depth pitem))
+ (cl-assert (js--pitem-h-begin pitem))
+ (cl-assert (js--pitem-paren-depth pitem))
(and (> (point) (js--pitem-h-begin pitem))
(or (null (js--pitem-b-end pitem))
;; Loop until we either hit a pitem at BOB or pitem ends after
;; point (or at point if we're at eob)
- (loop for pitem = (car pstate)
- until (or (eq (js--pitem-type pitem)
- 'toplevel)
- (js--inside-pitem-p pitem))
- do (pop pstate))
+ (cl-loop for pitem = (car pstate)
+ until (or (eq (js--pitem-type pitem)
+ 'toplevel)
+ (js--inside-pitem-p pitem))
+ do (pop pstate))
pstate))))
(defun js--class-decl-matcher (limit)
"Font lock function used by `js-mode'.
This performs fontification according to `js--class-styles'."
- (loop initially (js--ensure-cache limit)
- while (re-search-forward js--quick-match-re limit t)
- for orig-end = (match-end 0)
- do (goto-char (match-beginning 0))
- if (loop for style in js--class-styles
- for decl-re = (plist-get style :class-decl)
- if (and (memq (plist-get style :framework)
- js-enabled-frameworks)
- (memq (js-syntactic-context)
- (plist-get style :contexts))
- decl-re
- (looking-at decl-re))
- do (goto-char (match-end 0))
- and return t)
- return t
- else do (goto-char orig-end)))
+ (cl-loop initially (js--ensure-cache limit)
+ while (re-search-forward js--quick-match-re limit t)
+ for orig-end = (match-end 0)
+ do (goto-char (match-beginning 0))
+ if (cl-loop for style in js--class-styles
+ for decl-re = (plist-get style :class-decl)
+ if (and (memq (plist-get style :framework)
+ js-enabled-frameworks)
+ (memq (js-syntactic-context)
+ (plist-get style :contexts))
+ decl-re
+ (looking-at decl-re))
+ do (goto-char (match-end 0))
+ and return t)
+ return t
+ else do (goto-char orig-end)))
(defconst js--font-lock-keywords
'(js--font-lock-keywords-3 js--font-lock-keywords-1
(funcall
(syntax-propertize-rules
;; Distinguish /-division from /-regexp chars (and from /-comment-starter).
+ ;; FIXME: Allow regexps after infix ops like + ...
+ ;; https://developer.mozilla.org/en/JavaScript/Reference/Operators
+ ;; We can probably just add +, -, !, <, >, %, ^, ~, |, &, ?, : at which
+ ;; point I think only * and / would be missing which could also be added,
+ ;; but need care to avoid affecting the // and */ comment markers.
("\\(?:^\\|[=([{,:;]\\)\\(?:[ \t]\\)*\\(/\\)[^/*]"
(1 (ignore
(forward-char -1)
js-expr-indent-offset))
(t
(+ (current-column) js-indent-level
- (case (char-after (nth 1 parse-status))
+ (pcase (char-after (nth 1 parse-status))
(?\( js-paren-indent-offset)
(?\[ js-square-indent-offset)
(?\{ js-curly-indent-offset))))))
(defun js-c-fill-paragraph (&optional justify)
"Fill the paragraph with `c-fill-paragraph'."
(interactive "*P")
- (flet ((c-forward-sws
- (&optional limit)
- (js--forward-syntactic-ws limit))
- (c-backward-sws
- (&optional limit)
- (js--backward-syntactic-ws limit))
- (c-beginning-of-macro
- (&optional limit)
- (js--beginning-of-macro limit)))
+ ;; FIXME: Such redefinitions are bad style. We should try and use some other
+ ;; way to get the same result.
+ (cl-letf (((symbol-function 'c-forward-sws)
+ (lambda (&optional limit)
+ (js--forward-syntactic-ws limit)))
+ ((symbol-function 'c-backward-sws)
+ (lambda (&optional limit)
+ (js--backward-syntactic-ws limit)))
+ ((symbol-function 'c-beginning-of-macro)
+ (lambda (&optional limit)
+ (js--beginning-of-macro limit))))
(let ((fill-paragraph-function 'c-fill-paragraph))
(c-fill-paragraph justify))))
name-parts
(mapcar #'js--pitem-name items))
- (assert (stringp top-name))
- (assert (> (length top-name) 0))
+ (cl-assert (stringp top-name))
+ (cl-assert (> (length top-name) 0))
;; If top-name isn't found in items, then we build a copy of items
;; and throw it away. But that's okay, since most of the time, we
(defun js--pitem-add-child (pitem child)
"Copy `js--pitem' PITEM, and push CHILD onto its list of children."
- (assert (integerp (js--pitem-h-begin child)))
- (assert (if (consp (js--pitem-name child))
- (loop for part in (js--pitem-name child)
- always (stringp part))
+ (cl-assert (integerp (js--pitem-h-begin child)))
+ (cl-assert (if (consp (js--pitem-name child))
+ (cl-loop for part in (js--pitem-name child)
+ always (stringp part))
t))
;; This trick works because we know (based on our defstructs) that
;; name is a list here because down in
;; `js--ensure-cache', we made sure to only add
;; class entries with lists for :name
- (assert (consp name))
+ (cl-assert (consp name))
(js--splice-into-items (car pitem) child name))
(t
(setq pitem-name (js--pitem-strname pitem))
(when (eq pitem-name t)
(setq pitem-name (format "[unknown %s]"
- (incf (car unknown-ctr)))))
+ (cl-incf (car unknown-ctr)))))
(cond
((memq pitem-type '(function macro))
- (assert (integerp (js--pitem-h-begin pitem)))
+ (cl-assert (integerp (js--pitem-h-begin pitem)))
(push (cons pitem-name
(js--maybe-make-marker
(js--pitem-h-begin pitem)))
imenu-items))
((js--pitem-h-begin pitem)
- (assert (integerp (js--pitem-h-begin pitem)))
+ (cl-assert (integerp (js--pitem-h-begin pitem)))
(setq subitems (list
(cons "[empty]"
(js--maybe-make-marker
(widen)
(goto-char (point-max))
(js--ensure-cache)
- (assert (or (= (point-min) (point-max))
+ (cl-assert (or (= (point-min) (point-max))
(eq js--last-parse-pos (point))))
(when js--last-parse-pos
(let ((state js--state-at-last-parse-pos)
;; Make sure everything is closed
(while (cdr state)
(setq state
- (cons (js--pitem-add-child (second state) (car state))
+ (cons (js--pitem-add-child (cl-second state) (car state))
(cddr state))))
- (assert (= (length state) 1))
+ (cl-assert (= (length state) 1))
;; Convert the new-finalized state into what imenu expects
(js--pitems-to-imenu
(mapconcat #'identity parts "."))
(defun js--imenu-to-flat (items prefix symbols)
- (loop for item in items
- if (imenu--subalist-p item)
- do (js--imenu-to-flat
- (cdr item) (concat prefix (car item) ".")
- symbols)
- else
- do (let* ((name (concat prefix (car item)))
- (name2 name)
- (ctr 0))
+ (cl-loop for item in items
+ if (imenu--subalist-p item)
+ do (js--imenu-to-flat
+ (cdr item) (concat prefix (car item) ".")
+ symbols)
+ else
+ do (let* ((name (concat prefix (car item)))
+ (name2 name)
+ (ctr 0))
- (while (gethash name2 symbols)
- (setq name2 (format "%s<%d>" name (incf ctr))))
+ (while (gethash name2 symbols)
+ (setq name2 (format "%s<%d>" name (cl-incf ctr))))
- (puthash name2 (cdr item) symbols))))
+ (puthash name2 (cdr item) symbols))))
(defun js--get-all-known-symbols ()
"Return a hash table of all JavaScript symbols.
This searches all existing `js-mode' buffers. Each key is the
name of a symbol (possibly disambiguated with <N>, where N > 1),
and each value is a marker giving the location of that symbol."
- (loop with symbols = (make-hash-table :test 'equal)
- with imenu-use-markers = t
- for buffer being the buffers
- for imenu-index = (with-current-buffer buffer
- (when (derived-mode-p 'js-mode)
- (js--imenu-create-index)))
- do (js--imenu-to-flat imenu-index "" symbols)
- finally return symbols))
+ (cl-loop with symbols = (make-hash-table :test 'equal)
+ with imenu-use-markers = t
+ for buffer being the buffers
+ for imenu-index = (with-current-buffer buffer
+ (when (derived-mode-p 'js-mode)
+ (js--imenu-create-index)))
+ do (js--imenu-to-flat imenu-index "" symbols)
+ finally return symbols))
(defvar js--symbol-history nil
"History of entered JavaScript symbols.")
(let ((choice (ido-completing-read
prompt
- (loop for key being the hash-keys of symbols-table
- collect key)
+ (cl-loop for key being the hash-keys of symbols-table
+ collect key)
nil t initial-input 'js--symbol-history)))
(cons choice (gethash choice symbols-table))))
set. If START is non-nil, look for output starting from START.
Otherwise, use the current value of `process-mark'."
(with-current-buffer (process-buffer process)
- (loop with start-pos = (or start
- (marker-position (process-mark process)))
- with end-time = (+ (float-time) timeout)
- for time-left = (- end-time (float-time))
- do (goto-char (point-max))
- if (looking-back regexp start-pos) return t
- while (> time-left 0)
- do (accept-process-output process time-left nil t)
- do (goto-char (process-mark process))
- finally do (signal
- 'js-moz-bad-rpc
- (list (format "Timed out waiting for output matching %S" regexp))))))
-
-(defstruct js--js-handle
+ (cl-loop with start-pos = (or start
+ (marker-position (process-mark process)))
+ with end-time = (+ (float-time) timeout)
+ for time-left = (- end-time (float-time))
+ do (goto-char (point-max))
+ if (looking-back regexp start-pos) return t
+ while (> time-left 0)
+ do (accept-process-output process time-left nil t)
+ do (goto-char (process-mark process))
+ finally do (signal
+ 'js-moz-bad-rpc
+ (list (format "Timed out waiting for output matching %S" regexp))))))
+
+(cl-defstruct js--js-handle
;; Integer, mirrors the value we see in JS
(id nil :read-only t)
(inferior-moz-process) js--js-repl-prompt-regexp
js-js-timeout))
- (incf js--js-repl-depth)))
+ (cl-incf js--js-repl-depth)))
(defun js--js-leave-repl ()
- (assert (> js--js-repl-depth 0))
- (when (= 0 (decf js--js-repl-depth))
+ (cl-assert (> js--js-repl-depth 0))
+ (when (= 0 (cl-decf js--js-repl-depth))
(with-current-buffer inferior-moz-buffer
(goto-char (point-max))
(js--js-wait-for-eval-prompt)
(eval-and-compile
(defun js--optimize-arglist (arglist)
"Convert immediate js< and js! references to deferred ones."
- (loop for item in arglist
- if (eq (car-safe item) 'js<)
- collect (append (list 'list ''js--funcall
- '(list 'interactor "_getProp"))
- (js--optimize-arglist (cdr item)))
- else if (eq (car-safe item) 'js>)
- collect (append (list 'list ''js--funcall
- '(list 'interactor "_putProp"))
-
- (if (atom (cadr item))
- (list (cadr item))
- (list
- (append
- (list 'list ''js--funcall
- '(list 'interactor "_mkArray"))
- (js--optimize-arglist (cadr item)))))
- (js--optimize-arglist (cddr item)))
- else if (eq (car-safe item) 'js!)
- collect (destructuring-bind (ignored function &rest body) item
- (append (list 'list ''js--funcall
- (if (consp function)
- (cons 'list
- (js--optimize-arglist function))
- function))
- (js--optimize-arglist body)))
- else
- collect item)))
+ (cl-loop for item in arglist
+ if (eq (car-safe item) 'js<)
+ collect (append (list 'list ''js--funcall
+ '(list 'interactor "_getProp"))
+ (js--optimize-arglist (cdr item)))
+ else if (eq (car-safe item) 'js>)
+ collect (append (list 'list ''js--funcall
+ '(list 'interactor "_putProp"))
+
+ (if (atom (cadr item))
+ (list (cadr item))
+ (list
+ (append
+ (list 'list ''js--funcall
+ '(list 'interactor "_mkArray"))
+ (js--optimize-arglist (cadr item)))))
+ (js--optimize-arglist (cddr item)))
+ else if (eq (car-safe item) 'js!)
+ collect (pcase-let ((`(,_ ,function . ,body) item))
+ (append (list 'list ''js--funcall
+ (if (consp function)
+ (cons 'list
+ (js--optimize-arglist function))
+ function))
+ (js--optimize-arglist body)))
+ else
+ collect item)))
(defmacro js--js-get-service (class-name interface-name)
`(js! ("Components" "classes" ,class-name "getService")
`(progn
(js--js-enter-repl)
(unwind-protect
- (macrolet ((js? (&rest body) `(js--js-true ,@body))
- (js! (function &rest body)
- `(js--js-funcall
- ,(if (consp function)
- (cons 'list
- (js--optimize-arglist function))
- function)
- ,@(js--optimize-arglist body)))
-
- (js-new (function &rest body)
- `(js--js-new
+ (cl-macrolet ((js? (&rest body) `(js--js-true ,@body))
+ (js! (function &rest body)
+ `(js--js-funcall
,(if (consp function)
(cons 'list
(js--optimize-arglist function))
function)
- ,@body))
-
- (js-eval (thisobj js)
- `(js--js-eval
- ,@(js--optimize-arglist
- (list thisobj js))))
-
- (js-list (&rest args)
- `(js--js-list
- ,@(js--optimize-arglist args)))
-
- (js-get-service (&rest args)
- `(js--js-get-service
- ,@(js--optimize-arglist args)))
-
- (js-create-instance (&rest args)
- `(js--js-create-instance
- ,@(js--optimize-arglist args)))
-
- (js-qi (&rest args)
- `(js--js-qi
- ,@(js--optimize-arglist args)))
-
- (js< (&rest body) `(js--js-get
- ,@(js--optimize-arglist body)))
- (js> (props value)
- `(js--js-funcall
- '(interactor "_putProp")
- ,(if (consp props)
- (cons 'list
- (js--optimize-arglist props))
- props)
- ,@(js--optimize-arglist (list value))
- ))
- (js-handle? (arg) `(js--js-handle-p ,arg)))
+ ,@(js--optimize-arglist body)))
+
+ (js-new (function &rest body)
+ `(js--js-new
+ ,(if (consp function)
+ (cons 'list
+ (js--optimize-arglist function))
+ function)
+ ,@body))
+
+ (js-eval (thisobj js)
+ `(js--js-eval
+ ,@(js--optimize-arglist
+ (list thisobj js))))
+
+ (js-list (&rest args)
+ `(js--js-list
+ ,@(js--optimize-arglist args)))
+
+ (js-get-service (&rest args)
+ `(js--js-get-service
+ ,@(js--optimize-arglist args)))
+
+ (js-create-instance (&rest args)
+ `(js--js-create-instance
+ ,@(js--optimize-arglist args)))
+
+ (js-qi (&rest args)
+ `(js--js-qi
+ ,@(js--optimize-arglist args)))
+
+ (js< (&rest body) `(js--js-get
+ ,@(js--optimize-arglist body)))
+ (js> (props value)
+ `(js--js-funcall
+ '(interactor "_putProp")
+ ,(if (consp props)
+ (cons 'list
+ (js--optimize-arglist props))
+ props)
+ ,@(js--optimize-arglist (list value))
+ ))
+ (js-handle? (arg) `(js--js-handle-p ,arg)))
,@forms)
(js--js-leave-repl))))
If nil, the whole Array is treated as a JS symbol.")
(defun js--js-decode-retval (result)
- (ecase (intern (first result))
- (atom (second result))
- (special (intern (second result)))
- (array
- (mapcar #'js--js-decode-retval (second result)))
- (objid
- (or (gethash (second result)
- js--js-references)
- (puthash (second result)
- (make-js--js-handle
- :id (second result)
- :process (inferior-moz-process))
- js--js-references)))
-
- (error (signal 'js-js-error (list (second result))))))
+ (pcase (intern (cl-first result))
+ (`atom (cl-second result))
+ (`special (intern (cl-second result)))
+ (`array
+ (mapcar #'js--js-decode-retval (cl-second result)))
+ (`objid
+ (or (gethash (cl-second result)
+ js--js-references)
+ (puthash (cl-second result)
+ (make-js--js-handle
+ :id (cl-second result)
+ :process (inferior-moz-process))
+ js--js-references)))
+
+ (`error (signal 'js-js-error (list (cl-second result))))
+ (x (error "Unmatched case in js--js-decode-retval: %S" x))))
(defun js--js-funcall (function &rest arguments)
"Call the Mozilla function FUNCTION with arguments ARGUMENTS.
(looking-back js--js-prompt-regexp
(save-excursion (forward-line 0) (point))))))
- (setq keys (loop for x being the hash-keys
- of js--js-references
- collect x))
+ (setq keys (cl-loop for x being the hash-keys
+ of js--js-references
+ collect x))
(setq num (js--js-funcall '(repl "_jsGC") (or keys [])))
(setq js--js-last-gcs-done this-gcs-done)
(with-js
(let (windows)
- (loop with window-mediator = (js! ("Components" "classes"
- "@mozilla.org/appshell/window-mediator;1"
- "getService")
- (js< "Components" "interfaces"
- "nsIWindowMediator"))
- with enumerator = (js! (window-mediator "getEnumerator") nil)
-
- while (js? (js! (enumerator "hasMoreElements")))
- for window = (js! (enumerator "getNext"))
- for window-info = (js-list window
- (js< window "document" "title")
- (js! (window "location" "toString"))
- (js< window "closed")
- (js< window "windowState"))
-
- unless (or (js? (fourth window-info))
- (eq (fifth window-info) 2))
- do (push window-info windows))
-
- (loop for window-info in windows
- for window = (first window-info)
- collect (list (second window-info)
- (third window-info)
- window)
-
- for gbrowser = (js< window "gBrowser")
- if (js-handle? gbrowser)
- nconc (loop
- for x below (js< gbrowser "browsers" "length")
- collect (js-list (js< gbrowser
- "browsers"
- x
- "contentDocument"
- "title")
-
- (js! (gbrowser
- "browsers"
- x
- "contentWindow"
- "location"
- "toString"))
- (js< gbrowser
- "browsers"
- x)
-
- (js! (gbrowser
- "tabContainer"
- "childNodes"
- "item")
- x)
-
- gbrowser))))))
+ (cl-loop with window-mediator = (js! ("Components" "classes"
+ "@mozilla.org/appshell/window-mediator;1"
+ "getService")
+ (js< "Components" "interfaces"
+ "nsIWindowMediator"))
+ with enumerator = (js! (window-mediator "getEnumerator") nil)
+
+ while (js? (js! (enumerator "hasMoreElements")))
+ for window = (js! (enumerator "getNext"))
+ for window-info = (js-list window
+ (js< window "document" "title")
+ (js! (window "location" "toString"))
+ (js< window "closed")
+ (js< window "windowState"))
+
+ unless (or (js? (cl-fourth window-info))
+ (eq (cl-fifth window-info) 2))
+ do (push window-info windows))
+
+ (cl-loop for window-info in windows
+ for window = (cl-first window-info)
+ collect (list (cl-second window-info)
+ (cl-third window-info)
+ window)
+
+ for gbrowser = (js< window "gBrowser")
+ if (js-handle? gbrowser)
+ nconc (cl-loop
+ for x below (js< gbrowser "browsers" "length")
+ collect (js-list (js< gbrowser
+ "browsers"
+ x
+ "contentDocument"
+ "title")
+
+ (js! (gbrowser
+ "browsers"
+ x
+ "contentWindow"
+ "location"
+ "toString"))
+ (js< gbrowser
+ "browsers"
+ x)
+
+ (js! (gbrowser
+ "tabContainer"
+ "childNodes"
+ "item")
+ x)
+
+ gbrowser))))))
(defvar js-read-tab-history nil)
(ido-mode -1))
(with-js
- (lexical-let ((tabs (js--get-tabs)) selected-tab-cname
- selected-tab prev-hitab)
+ (let ((tabs (js--get-tabs)) selected-tab-cname
+ selected-tab prev-hitab)
;; Disambiguate names
- (setq tabs (loop with tab-names = (make-hash-table :test 'equal)
- for tab in tabs
- for cname = (format "%s (%s)" (second tab) (first tab))
- for num = (incf (gethash cname tab-names -1))
- if (> num 0)
- do (setq cname (format "%s <%d>" cname num))
- collect (cons cname tab)))
-
- (labels ((find-tab-by-cname
- (cname)
- (loop for tab in tabs
- if (equal (car tab) cname)
- return (cdr tab)))
-
- (mogrify-highlighting
- (hitab unhitab)
-
- ;; Hack to reduce the number of
- ;; round-trips to mozilla
- (let (cmds)
- (cond
- ;; Highlighting tab
- ((fourth hitab)
- (push '(js! ((fourth hitab) "setAttribute")
- "style"
- "color: red; font-weight: bold")
- cmds)
-
- ;; Highlight window proper
- (push '(js! ((third hitab)
- "setAttribute")
- "style"
- "border: 8px solid red")
- cmds)
-
- ;; Select tab, when appropriate
- (when js-js-switch-tabs
- (push
- '(js> ((fifth hitab) "selectedTab") (fourth hitab))
- cmds)))
-
- ;; Highlighting whole window
- ((third hitab)
- (push '(js! ((third hitab) "document"
- "documentElement" "setAttribute")
- "style"
- (concat "-moz-appearance: none;"
- "border: 8px solid red;"))
- cmds)))
-
- (cond
- ;; Unhighlighting tab
- ((fourth unhitab)
- (push '(js! ((fourth unhitab) "setAttribute") "style" "")
- cmds)
- (push '(js! ((third unhitab) "setAttribute") "style" "")
- cmds))
-
- ;; Unhighlighting window
- ((third unhitab)
- (push '(js! ((third unhitab) "document"
- "documentElement" "setAttribute")
- "style" "")
- cmds)))
-
- (eval (list 'with-js
- (cons 'js-list (nreverse cmds))))))
-
- (command-hook
- ()
- (let* ((tab (find-tab-by-cname (car ido-matches))))
- (mogrify-highlighting tab prev-hitab)
- (setq prev-hitab tab)))
-
- (setup-hook
- ()
- ;; Fiddle with the match list a bit: if our first match
- ;; is a tabbrowser window, rotate the match list until
- ;; the active tab comes up
- (let ((matched-tab (find-tab-by-cname (car ido-matches))))
- (when (and matched-tab
- (null (fourth matched-tab))
- (equal "navigator:browser"
- (js! ((third matched-tab)
- "document"
- "documentElement"
- "getAttribute")
- "windowtype")))
-
- (loop with tab-to-match = (js< (third matched-tab)
- "gBrowser"
- "selectedTab")
-
- with index = 0
- for match in ido-matches
- for candidate-tab = (find-tab-by-cname match)
- if (eq (fourth candidate-tab) tab-to-match)
- do (setq ido-cur-list (ido-chop ido-cur-list match))
- and return t)))
-
- (add-hook 'post-command-hook #'command-hook t t)))
+ (setq tabs
+ (cl-loop with tab-names = (make-hash-table :test 'equal)
+ for tab in tabs
+ for cname = (format "%s (%s)"
+ (cl-second tab) (cl-first tab))
+ for num = (cl-incf (gethash cname tab-names -1))
+ if (> num 0)
+ do (setq cname (format "%s <%d>" cname num))
+ collect (cons cname tab)))
+
+ (cl-labels
+ ((find-tab-by-cname
+ (cname)
+ (cl-loop for tab in tabs
+ if (equal (car tab) cname)
+ return (cdr tab)))
+
+ (mogrify-highlighting
+ (hitab unhitab)
+
+ ;; Hack to reduce the number of
+ ;; round-trips to mozilla
+ (let (cmds)
+ (cond
+ ;; Highlighting tab
+ ((cl-fourth hitab)
+ (push '(js! ((cl-fourth hitab) "setAttribute")
+ "style"
+ "color: red; font-weight: bold")
+ cmds)
+
+ ;; Highlight window proper
+ (push '(js! ((cl-third hitab)
+ "setAttribute")
+ "style"
+ "border: 8px solid red")
+ cmds)
+
+ ;; Select tab, when appropriate
+ (when js-js-switch-tabs
+ (push
+ '(js> ((cl-fifth hitab) "selectedTab") (cl-fourth hitab))
+ cmds)))
+
+ ;; Highlighting whole window
+ ((cl-third hitab)
+ (push '(js! ((cl-third hitab) "document"
+ "documentElement" "setAttribute")
+ "style"
+ (concat "-moz-appearance: none;"
+ "border: 8px solid red;"))
+ cmds)))
+
+ (cond
+ ;; Unhighlighting tab
+ ((cl-fourth unhitab)
+ (push '(js! ((cl-fourth unhitab) "setAttribute") "style" "")
+ cmds)
+ (push '(js! ((cl-third unhitab) "setAttribute") "style" "")
+ cmds))
+
+ ;; Unhighlighting window
+ ((cl-third unhitab)
+ (push '(js! ((cl-third unhitab) "document"
+ "documentElement" "setAttribute")
+ "style" "")
+ cmds)))
+
+ (eval (list 'with-js
+ (cons 'js-list (nreverse cmds))))))
+
+ (command-hook
+ ()
+ (let* ((tab (find-tab-by-cname (car ido-matches))))
+ (mogrify-highlighting tab prev-hitab)
+ (setq prev-hitab tab)))
+
+ (setup-hook
+ ()
+ ;; Fiddle with the match list a bit: if our first match
+ ;; is a tabbrowser window, rotate the match list until
+ ;; the active tab comes up
+ (let ((matched-tab (find-tab-by-cname (car ido-matches))))
+ (when (and matched-tab
+ (null (cl-fourth matched-tab))
+ (equal "navigator:browser"
+ (js! ((cl-third matched-tab)
+ "document"
+ "documentElement"
+ "getAttribute")
+ "windowtype")))
+
+ (cl-loop with tab-to-match = (js< (cl-third matched-tab)
+ "gBrowser"
+ "selectedTab")
+
+ for match in ido-matches
+ for candidate-tab = (find-tab-by-cname match)
+ if (eq (cl-fourth candidate-tab) tab-to-match)
+ do (setq ido-cur-list
+ (ido-chop ido-cur-list match))
+ and return t)))
+
+ (add-hook 'post-command-hook #'command-hook t t)))
(unwind-protect
(add-to-history 'js-read-tab-history selected-tab-cname)
- (setq selected-tab (loop for tab in tabs
- if (equal (car tab) selected-tab-cname)
- return (cdr tab)))
+ (setq selected-tab (cl-loop for tab in tabs
+ if (equal (car tab) selected-tab-cname)
+ return (cdr tab)))
- (if (fourth selected-tab)
- (cons 'browser (third selected-tab))
- (cons 'window (third selected-tab)))))))
+ (cons (if (cl-fourth selected-tab) 'browser 'window)
+ (cl-third selected-tab))))))
(defun js--guess-eval-defun-info (pstate)
"Helper function for `js-eval-defun'.
strings making up the class name and NAME is the name of the
function part."
(cond ((and (= (length pstate) 3)
- (eq (js--pitem-type (first pstate)) 'function)
- (= (length (js--pitem-name (first pstate))) 1)
- (consp (js--pitem-type (second pstate))))
+ (eq (js--pitem-type (cl-first pstate)) 'function)
+ (= (length (js--pitem-name (cl-first pstate))) 1)
+ (consp (js--pitem-type (cl-second pstate))))
- (append (js--pitem-name (second pstate))
- (list (first (js--pitem-name (first pstate))))))
+ (append (js--pitem-name (cl-second pstate))
+ (list (cl-first (js--pitem-name (cl-first pstate))))))
((and (= (length pstate) 2)
- (eq (js--pitem-type (first pstate)) 'function))
+ (eq (js--pitem-type (cl-first pstate)) 'function))
(append
- (butlast (js--pitem-name (first pstate)))
- (list (car (last (js--pitem-name (first pstate)))))))
+ (butlast (js--pitem-name (cl-first pstate)))
+ (list (car (last (js--pitem-name (cl-first pstate)))))))
(t (error "Function not a toplevel defun or class member"))))
(with-js
(when (or (null js--js-context)
(js--js-handle-expired-p (cdr js--js-context))
- (ecase (car js--js-context)
- (window (js? (js< (cdr js--js-context) "closed")))
- (browser (not (js? (js< (cdr js--js-context)
- "contentDocument"))))))
+ (pcase (car js--js-context)
+ (`window (js? (js< (cdr js--js-context) "closed")))
+ (`browser (not (js? (js< (cdr js--js-context)
+ "contentDocument"))))
+ (x (error "Unmatched case in js--get-js-context: %S" x))))
(setq js--js-context (js--read-tab "Javascript Context: ")))
js--js-context))
(defun js--js-content-window (context)
(with-js
- (ecase (car context)
- (window (cdr context))
- (browser (js< (cdr context)
- "contentWindow" "wrappedJSObject")))))
+ (pcase (car context)
+ (`window (cdr context))
+ (`browser (js< (cdr context)
+ "contentWindow" "wrappedJSObject"))
+ (x (error "Unmatched case in js--js-content-window: %S" x)))))
(defun js--make-nsilocalfile (path)
(with-js
(path-uri (js! (io-service "newFileURI") path-file)))
(js! (res-prot "setSubstitution") alias path-uri))))
-(defun* js-eval-defun ()
+(cl-defun js-eval-defun ()
"Update a Mozilla tab using the JavaScript defun at point."
(interactive)
(unless (y-or-n-p (format "Send %s to Mozilla? "
(mapconcat #'identity defun-info ".")))
(message "") ; question message lingers until next command
- (return-from js-eval-defun))
+ (cl-return-from js-eval-defun))
(delete-overlay overlay)))
(setq defun-body (buffer-substring-no-properties begin end))
comment-start-skip "\\(//+\\|/\\*+\\)\\s *")
(set (make-local-variable 'electric-indent-chars)
- (append "{}():;," electric-indent-chars))
+ (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*".
(set (make-local-variable 'electric-layout-rules)
'((?\; . after) (?\{ . after) (?\} . before)))
"Default font-lock-keywords for `m4 mode'.")
(defcustom m4-mode-hook nil
- "*Hook called by `m4-mode'."
+ "Hook called by `m4-mode'."
:type 'hook
:group 'm4)
:version "22.1")
(defcustom makefile-browser-buffer-name "*Macros and Targets*"
- "*Name of the macro- and target browser buffer."
+ "Name of the macro- and target browser buffer."
:type 'string
:group 'makefile)
(defcustom makefile-target-colon ":"
- "*String to append to all target names inserted by `makefile-insert-target'.
+ "String to append to all target names inserted by `makefile-insert-target'.
\":\" or \"::\" are common values."
:type 'string
:group 'makefile)
(defcustom makefile-macro-assign " = "
- "*String to append to all macro names inserted by `makefile-insert-macro'.
+ "String to append to all macro names inserted by `makefile-insert-macro'.
The normal value should be \" = \", since this is what
standard make expects. However, newer makes such as dmake
allow a larger variety of different macro assignments, so you
:group 'makefile)
(defcustom makefile-electric-keys nil
- "*If non-nil, Makefile mode should install electric keybindings.
+ "If non-nil, Makefile mode should install electric keybindings.
Default is nil."
:type 'boolean
:group 'makefile)
(defcustom makefile-use-curly-braces-for-macros-p nil
- "*Controls the style of generated macro references.
+ "Controls the style of generated macro references.
Non-nil means macro references should use curly braces, like `${this}'.
nil means use parentheses, like `$(this)'."
:type 'boolean
:group 'makefile)
(defcustom makefile-tab-after-target-colon t
- "*If non-nil, insert a TAB after a target colon.
+ "If non-nil, insert a TAB after a target colon.
Otherwise, a space is inserted.
The default is t."
:type 'boolean
:group 'makefile)
(defcustom makefile-browser-leftmost-column 10
- "*Number of blanks to the left of the browser selection mark."
+ "Number of blanks to the left of the browser selection mark."
:type 'integer
:group 'makefile)
(defcustom makefile-browser-cursor-column 10
- "*Column the cursor goes to when it moves up or down in the Makefile browser."
+ "Column the cursor goes to when it moves up or down in the Makefile browser."
:type 'integer
:group 'makefile)
(defcustom makefile-backslash-column 48
- "*Column in which `makefile-backslash-region' inserts backslashes."
+ "Column in which `makefile-backslash-region' inserts backslashes."
:type 'integer
:group 'makefile)
(defcustom makefile-backslash-align t
- "*If non-nil, `makefile-backslash-region' will align backslashes."
+ "If non-nil, `makefile-backslash-region' will align backslashes."
:type 'boolean
:group 'makefile)
(defcustom makefile-browser-selected-mark "+ "
- "*String used to mark selected entries in the Makefile browser."
+ "String used to mark selected entries in the Makefile browser."
:type 'string
:group 'makefile)
(defcustom makefile-browser-unselected-mark " "
- "*String used to mark unselected entries in the Makefile browser."
+ "String used to mark unselected entries in the Makefile browser."
:type 'string
:group 'makefile)
(defcustom makefile-browser-auto-advance-after-selection-p t
- "*If non-nil, cursor will move after item is selected in Makefile browser."
+ "If non-nil, cursor will move after item is selected in Makefile browser."
:type 'boolean
:group 'makefile)
(defcustom makefile-pickup-everything-picks-up-filenames-p nil
- "*If non-nil, `makefile-pickup-everything' picks up filenames as targets.
+ "If non-nil, `makefile-pickup-everything' picks up filenames as targets.
This means it calls `makefile-pickup-filenames-as-targets'.
Otherwise filenames are omitted."
:type 'boolean
:group 'makefile)
(defcustom makefile-cleanup-continuations nil
- "*If non-nil, automatically clean up continuation lines when saving.
+ "If non-nil, automatically clean up continuation lines when saving.
A line is cleaned up by removing all whitespace following a trailing
backslash. This is done silently.
IMPORTANT: Please note that enabling this option causes Makefile mode
:group 'makefile)
(defcustom makefile-mode-hook nil
- "*Normal hook run by `makefile-mode'."
+ "Normal hook run by `makefile-mode'."
:type 'hook
:group 'makefile)
(defcustom makefile-runtime-macros-list
'(("@") ("&") (">") ("<") ("*") ("^") ("+") ("?") ("%") ("$"))
- "*List of macros that are resolved by make at runtime.
+ "List of macros that are resolved by make at runtime.
If you insert a macro reference using `makefile-insert-macro-ref', the name
of the macro is checked against this list. If it can be found its name will
not be enclosed in { } or ( )."
;; ------------------------------------------------------------
(defcustom makefile-brave-make "make"
- "*How to invoke make, for `makefile-query-targets'.
+ "How to invoke make, for `makefile-query-targets'.
This should identify a `make' command that can handle the `-q' option."
:type 'string
:group 'makefile)
(defcustom makefile-query-one-target-method-function
'makefile-query-by-make-minus-q
- "*Function to call to determine whether a make target is up to date.
+ "Function to call to determine whether a make target is up to date.
The function must satisfy this calling convention:
* As its first argument, it must accept the name of the target to
'makefile-query-one-target-method-function)
(defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*"
- "*Name of the Up-to-date overview buffer."
+ "Name of the Up-to-date overview buffer."
:type 'string
:group 'makefile)
(setq buffer-read-only t))
(defun makefile-browse (targets macros)
- (interactive)
(if (zerop (+ (length targets) (length macros)))
(progn
(beep)
st)
"Syntax table used in Metafont or MetaPost mode.")
+(define-obsolete-variable-alias 'meta-mode-map 'meta-common-mode-map "24.1")
(defvar meta-common-mode-map
(let ((map (make-sparse-keymap)))
;; Comment Paragraphs:
;; (define-key map "\C-c\C-l" 'meta-recenter-output)
map)
"Keymap used in Metafont or MetaPost mode.")
-(define-obsolete-variable-alias 'meta-mode-map 'meta-common-mode-map "24.1")
(easy-menu-define
meta-mode-menu meta-common-mode-map
;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and
;; `ftp://ftp.gnu.org/pub/gnu/mdk'.
;;
-;; To use this mode, place the following in your .emacs file:
+;; To use this mode, place the following in your init file:
;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'.
;; When you load a file with the extension .mixal the mode will be started
;; automatic. If you want to start the mode manual, use `M-x mixal-mode'.
:group 'modula2)
(defcustom m2-end-comment-column 75
- "*Column for aligning the end of a comment, in Modula-2."
+ "Column for aligning the end of a comment, in Modula-2."
:type 'integer
:group 'modula2)
"Keymap used in Modula-2 mode.")
(defcustom m2-indent 5
- "*This variable gives the indentation in Modula-2-Mode."
+ "This variable gives the indentation in Modula-2-Mode."
:type 'integer
:group 'modula2)
(put 'm2-indent 'safe-local-variable
"Syntax table in use in inferior-octave-mode buffers.")
(defcustom inferior-octave-mode-hook nil
- "*Hook to be run when Inferior Octave mode is started."
+ "Hook to be run when Inferior Octave mode is started."
:type 'hook
:group 'octave-inferior)
Turning on Octave mode runs the hook `octave-mode-hook'.
To begin using this mode for all `.m' files that you edit, add the
-following lines to your `.emacs' file:
+following lines to your init file:
(add-to-list 'auto-mode-alist '(\"\\\\.m\\\\'\" . octave-mode))
To automatically turn on the abbrev and auto-fill features,
-add the following lines to your `.emacs' file as well:
+add the following lines to your init file as well:
(add-hook 'octave-mode-hook
(lambda ()
executed normally.
Note that all Octave mode abbrevs start with a grave accent."
(interactive)
- (if (not abbrev-mode)
- (self-insert-command 1)
- (let (c)
- (insert last-command-event)
- (if (if (featurep 'xemacs)
- (or (eq (event-to-character (setq c (next-event))) ??)
- (eq (event-to-character c) help-char))
- (or (eq (setq c (read-event)) ??)
- (eq c help-char)))
- (let ((abbrev-table-name-list '(octave-abbrev-table)))
- (list-abbrevs))
- (setq unread-command-events (list c))))))
+ (self-insert-command 1)
+ (when abbrev-mode
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [??] 'list-abbrevs)
+ (define-key map (vector help-char) 'list-abbrevs)
+ map))))
(define-skeleton octave-insert-defun
"Insert an Octave function skeleton.
\f
;;; Code:
-(eval-when-compile (require 'cl))
(defgroup pascal nil
"Major mode for editing Pascal source in Emacs."
(put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t))
(defcustom pascal-indent-level 3
- "*Indentation of Pascal statements with respect to containing block."
+ "Indentation of Pascal statements with respect to containing block."
:type 'integer
:group 'pascal)
(defcustom pascal-case-indent 2
- "*Indentation for case statements."
+ "Indentation for case statements."
:type 'integer
:group 'pascal)
(defcustom pascal-auto-newline nil
- "*Non-nil means automatically insert newlines in certain cases.
+ "Non-nil means automatically insert newlines in certain cases.
These include after semicolons and after the punctuation mark after an `end'."
:type 'boolean
:group 'pascal)
(defcustom pascal-indent-nested-functions t
- "*Non-nil means nested functions are indented."
+ "Non-nil means nested functions are indented."
:type 'boolean
:group 'pascal)
(defcustom pascal-tab-always-indent t
- "*Non-nil means TAB in Pascal mode should always reindent the current line.
+ "Non-nil means TAB in Pascal mode should always reindent the current line.
If this is nil, TAB inserts a tab if it is at the end of the line
and follows non-whitespace text."
:type 'boolean
:group 'pascal)
(defcustom pascal-auto-endcomments t
- "*Non-nil means automatically insert comments after certain `end's.
+ "Non-nil means automatically insert comments after certain `end's.
Specifically, this is done after the ends of cases statements and functions.
The name of the function or case is included between the braces."
:type 'boolean
:group 'pascal)
(defcustom pascal-auto-lineup '(all)
- "*List of contexts where auto lineup of :'s or ='s should be done.
+ "List of contexts where auto lineup of :'s or ='s should be done.
Elements can be of type: 'paramlist', 'declaration' or 'case', which will
do auto lineup in parameterlist, declarations or case-statements
respectively. The word 'all' will do all lineups. '(case paramlist) for
:group 'pascal)
(defvar pascal-toggle-completions nil
- "*Non-nil meant \\<pascal-mode-map>\\[pascal-complete-word] would try all possible completions one by one.
-Repeated use of \\[pascal-complete-word] would show you all of them.
-Normally, when there is more than one possible completion,
-it displays a list of all possible completions.")
+ "If non-nil, `pascal-complete-word' tries all possible completions.
+Repeated use of \\[pascal-complete-word] then shows all
+completions in turn, instead of displaying a list of all possible
+completions.")
(make-obsolete-variable 'pascal-toggle-completions
'completion-cycle-threshold "24.1")
(defcustom pascal-type-keywords
'("array" "file" "packed" "char" "integer" "real" "string" "record")
- "*Keywords for types used when completing a word in a declaration or parmlist.
+ "Keywords for types used when completing a word in a declaration or parmlist.
These include integer, real, char, etc.
The types defined within the Pascal program
are handled in another way, and should not be added to this list."
(defcustom pascal-start-keywords
'("begin" "end" "function" "procedure" "repeat" "until" "while"
"read" "readln" "reset" "rewrite" "write" "writeln")
- "*Keywords to complete when standing at the first word of a statement.
+ "Keywords to complete when standing at the first word of a statement.
These are keywords such as begin, repeat, until, readln.
The procedures and variables defined within the Pascal program
are handled in another way, and should not be added to this list."
(defcustom pascal-separator-keywords
'("downto" "else" "mod" "div" "then")
- "*Keywords to complete when NOT standing at the first word of a statement.
+ "Keywords to complete when NOT standing at the first word of a statement.
These are keywords such as downto, else, mod, then.
Variables and function names defined within the Pascal program
are handled in another way, and should not be added to this list."
;;;
;;; Interactive functions
;;;
+(defvar pascal--extra-indent 0)
+
(defun pascal-insert-block ()
"Insert Pascal begin ... end; block in the code with right indentation."
(interactive)
;;; Indentation
;;;
(defconst pascal-indent-alist
- '((block . (+ ind pascal-indent-level))
- (case . (+ ind pascal-case-indent))
- (caseblock . ind) (cpp . 0)
- (declaration . (+ ind pascal-indent-level))
+ '((block . (+ pascal--extra-indent pascal-indent-level))
+ (case . (+ pascal--extra-indent pascal-case-indent))
+ (caseblock . pascal--extra-indent) (cpp . 0)
+ (declaration . (+ pascal--extra-indent pascal-indent-level))
(paramlist . (pascal-indent-paramlist t))
(comment . (pascal-indent-comment))
- (defun . ind) (contexp . ind)
- (unknown . ind) (string . 0) (progbeg . 0)))
+ (defun . pascal--extra-indent) (contexp . pascal--extra-indent)
+ (unknown . pascal--extra-indent) (string . 0) (progbeg . 0)))
(defun pascal-indent-command ()
"Indent for special part of code."
(if (looking-at "[ \t]+$")
(skip-chars-forward " \t"))))
-(defvar ind) ;Used via `eval' in pascal-indent-alist.
(defun pascal-indent-line ()
"Indent current line as a Pascal statement."
(let* ((indent-str (pascal-calculate-indent))
(type (car indent-str))
- (ind (car (cdr indent-str))))
+ (pascal--extra-indent (car (cdr indent-str))))
;; Labels should not be indented.
(if (and (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
(not (eq type 'declaration)))
())
(; Other things should have no extra indent
(looking-at pascal-noindent-re)
- (indent-to ind))
+ (indent-to pascal--extra-indent))
(; Nested functions should be indented
(looking-at pascal-defun-re)
(if (and pascal-indent-nested-functions
(eq type 'defun))
- (indent-to (+ ind pascal-indent-level))
- (indent-to ind)))
+ (indent-to (+ pascal--extra-indent pascal-indent-level))
+ (indent-to pascal--extra-indent)))
(; But most lines are treated this way
(indent-to (eval (cdr (assoc type pascal-indent-alist))))
))))
(point-marker)
(re-search-backward "\\<case\\>" nil t)))
(beg (point))
- (ind 0))
+ (pascal--extra-indent 0))
;; Get right indent
(while (< (point) end)
(if (re-search-forward
(if (< (point) end)
(progn
(delete-horizontal-space)
- (if (> (current-column) ind)
- (setq ind (current-column)))
+ (if (> (current-column) pascal--extra-indent)
+ (setq pascal--extra-indent (current-column)))
(pascal-end-of-statement))))
(goto-char beg)
;; Indent all case statements
"^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
(marker-position end) 'move)
(forward-char -1))
- (indent-to (1+ ind))
+ (indent-to (1+ pascal--extra-indent))
(if (/= (following-char) ?:)
()
(forward-char 1)
(max (progn (pascal-declaration-end)
(point))
pos))))
- ind)
+ pascal--extra-indent)
(goto-char stpos)
;; Indent lines in record block
(forward-line 1)))
;; Do lineup
- (setq ind (pascal-get-lineup-indent stpos edpos lineup))
+ (setq pascal--extra-indent (pascal-get-lineup-indent stpos edpos lineup))
(goto-char stpos)
(while (and (<= (point) edpos) (not (eobp)))
(if (search-forward lineup (point-at-eol) 'move)
(forward-char -1))
(delete-horizontal-space)
- (indent-to ind)
+ (indent-to pascal--extra-indent)
(if (not (looking-at lineup))
(forward-line 1) ; No more indent if there is no : or =
(forward-char 1)
;from b to e nicely. The lineup string is str."
(defun pascal-get-lineup-indent (b e str)
(save-excursion
- (let ((ind 0)
+ (let ((pascal--extra-indent 0)
(reg (concat str "\\|\\(\\<record\\>\\)\\|" pascal-defun-re)))
(goto-char b)
;; Get rightmost position
(t
(goto-char (match-beginning 0))
(skip-chars-backward " \t")
- (if (> (current-column) ind)
- (setq ind (current-column)))
+ (if (> (current-column) pascal--extra-indent)
+ (setq pascal--extra-indent (current-column)))
(goto-char (match-end 0))
(end-of-line)
))))
;; In case no lineup was found
- (if (> ind 0)
- (1+ ind)
+ (if (> pascal--extra-indent 0)
+ (1+ pascal--extra-indent)
;; No lineup-string found
(goto-char b)
(end-of-line)
(default (if (pascal-comp-defun default nil 'lambda)
default ""))
(label
- ;; Do completion with default
+ ;; Do completion with default.
(completing-read (if (not (string= default ""))
(concat "Label (default " default "): ")
"Label: ")
;; Complete with the defuns found in the
;; current-buffer.
- (lexical-let ((buf (current-buffer)))
+ (let ((buf (current-buffer)))
(lambda (s p a)
(with-current-buffer buf
(pascal-comp-defun s p a))))
nil t "")))
- ;; If there was no response on prompt, use default value
+ ;; If there was no response on prompt, use default value.
(if (string= label "")
(setq label default))
- ;; Goto right place in buffer if label is not an empty string
+ ;; Goto right place in buffer if label is not an empty string.
(or (string= label "")
(progn
(goto-char (point-min))
;;; perl-mode.el --- Perl code editing commands for GNU Emacs
-;; Copyright (C) 1990, 1994, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1994, 2001-2012 Free Software Foundation, Inc.
;; Author: William F. Mann
;; Maintainer: FSF
;;; Commentary:
;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
-;; to your .emacs file and change the first line of your perl script to:
+;; to your init file and change the first line of your perl script to:
;; #!/usr/bin/perl -- # -*-Perl-*-
;; With arguments to perl:
;; #!/usr/bin/perl -P- # -*-Perl-*-
;; To handle files included with do 'filename.pl';, add something like
;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode))
;; auto-mode-alist))
-;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode.
+;; to your init file; otherwise the .pl suffix defaults to prolog-mode.
;; This code is based on the 18.53 version c-mode.el, with extensive
;; rewriting. Most of the features of c-mode survived intact.
;;; Code:
-(eval-when-compile (require 'cl))
(defvar font-lock-comment-face)
(defvar font-lock-doc-face)
map)
"Keymap used in Perl mode.")
-(autoload 'c-macro-expand "cmacexp"
- "Display the result of expanding all C macros occurring in the region.
-The expansion is entirely correct because it uses the C preprocessor."
- t)
-
(defvar perl-mode-syntax-table
(let ((st (make-syntax-table (standard-syntax-table))))
(modify-syntax-entry ?\n ">" st)
(t (funcall (default-value 'font-lock-syntactic-face-function) state))))
(defcustom perl-indent-level 4
- "*Indentation of Perl statements with respect to containing block."
+ "Indentation of Perl statements with respect to containing block."
:type 'integer
:group 'perl)
;;;###autoload(put 'perl-label-offset 'safe-local-variable 'integerp)
(defcustom perl-continued-statement-offset 4
- "*Extra indent for lines not starting new statements."
+ "Extra indent for lines not starting new statements."
:type 'integer
:group 'perl)
(defcustom perl-continued-brace-offset -4
- "*Extra indent for substatements that start with open-braces.
+ "Extra indent for substatements that start with open-braces.
This is in addition to `perl-continued-statement-offset'."
:type 'integer
:group 'perl)
(defcustom perl-brace-offset 0
- "*Extra indentation for braces, compared with other text in same context."
+ "Extra indentation for braces, compared with other text in same context."
:type 'integer
:group 'perl)
(defcustom perl-brace-imaginary-offset 0
- "*Imagined indentation of an open brace that actually follows a statement."
+ "Imagined indentation of an open brace that actually follows a statement."
:type 'integer
:group 'perl)
(defcustom perl-label-offset -2
- "*Offset of Perl label lines relative to usual indentation."
+ "Offset of Perl label lines relative to usual indentation."
:type 'integer
:group 'perl)
(defcustom perl-indent-continued-arguments nil
- "*If non-nil offset of argument lines relative to usual indentation.
+ "If non-nil offset of argument lines relative to usual indentation.
If nil, continued arguments are aligned with the first argument."
:type '(choice integer (const nil))
:group 'perl)
+(defcustom perl-indent-parens-as-block nil
+ "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.3"
+ :type 'boolean
+ :group 'perl)
+
(defcustom perl-tab-always-indent tab-always-indent
"Non-nil means TAB in Perl mode always indents the current line.
Otherwise it inserts a tab character if you type it past the first
;; I changed the default to nil for consistency with general Emacs
;; conventions -- rms.
(defcustom perl-tab-to-comment nil
- "*Non-nil means TAB moves to eol or makes a comment in some cases.
+ "Non-nil means TAB moves to eol or makes a comment in some cases.
For lines which don't need indenting, TAB either indents an
existing comment, moves to end-of-line, or if at end-of-line already,
create a new comment."
:group 'perl)
(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]"
- "*Lines starting with this regular expression are not auto-indented."
+ "Lines starting with this regular expression are not auto-indented."
:type 'regexp
:group 'perl)
(cond ((nth 3 state) 'noindent) ; In a quoted string?
((null containing-sexp) ; Line is at top level.
(skip-chars-forward " \t\f")
- (if (= (following-char) ?{)
+ (if (memq (following-char)
+ (if perl-indent-parens-as-block '(?\{ ?\( ?\[) '(?\{)))
0 ; move to beginning of line if it starts a function body
;; indent a little if this is a continuation line
(perl-backward-to-noncomment)
0 perl-continued-statement-offset)
(current-column)
(if (save-excursion (goto-char indent-point)
- (looking-at "[ \t]*{"))
+ (looking-at
+ (if perl-indent-parens-as-block
+ "[ \t]*[{(\[]" "[ \t]*{")))
perl-continued-brace-offset 0)))
;; This line starts a new statement.
;; Position at last unclosed open.
;;; Installation:
;;
-;; Insert the following lines in your init file--typically ~/.emacs
-;; (GNU Emacs and XEmacs <21.4), or ~/.xemacs/init.el (XEmacs
-;; 21.4)--to use this mode when editing Prolog files under Emacs:
+;; Insert the following lines in your init file:
;;
;; (setq load-path (cons "/usr/lib/xemacs/site-lisp" load-path))
;; (autoload 'run-prolog "prolog" "Start a Prolog sub-process." t)
(defgroup prolog nil
- "Major modes for editing and running Prolog and Mercury files."
+ "Editing and running Prolog and Mercury files."
:group 'languages)
(defgroup prolog-faces nil
)
table))
(defvar prolog-mode-abbrev-table nil)
-(defvar prolog-upper-case-string ""
- "A string containing all upper case characters.
-Set by prolog-build-case-strings.")
-(defvar prolog-lower-case-string ""
- "A string containing all lower case characters.
-Set by prolog-build-case-strings.")
-
-(defvar prolog-atom-char-regexp ""
- "Set by prolog-set-atom-regexps.")
-;; "Regexp specifying characters which constitute atoms without quoting.")
-(defvar prolog-atom-regexp ""
- "Set by prolog-set-atom-regexps.")
+
+(if (eval-when-compile
+ (and (string-match "[[:upper:]]" "A")
+ (with-temp-buffer
+ (insert "A") (skip-chars-backward "[:upper:]") (bolp))))
+ (progn
+ (defconst prolog-upper-case-string "[:upper:]"
+ "A string containing a char-range matching all upper case characters.")
+ (defconst prolog-lower-case-string "[:lower:]"
+ "A string containing a char-range matching all lower case characters."))
+
+ ;; GNU Emacs compatibility: GNU Emacs does not differentiate between
+ ;; ints and chars, or at least these two are interchangeable.
+ (defalias 'prolog-int-to-char
+ (if (fboundp 'int-to-char) #'int-to-char #'identity))
+
+ (defalias 'prolog-char-to-int
+ (if (fboundp 'char-to-int) #'char-to-int #'identity))
+
+ (defun prolog-ints-intervals (ints)
+ "Return a list of intervals (from . to) covering INTS."
+ (when ints
+ (setq ints (sort ints '<))
+ (let ((prev (car ints))
+ (interval-start (car ints))
+ intervals)
+ (while ints
+ (let ((next (car ints)))
+ (when (> next (1+ prev)) ; start of new interval
+ (setq intervals (cons (cons interval-start prev) intervals))
+ (setq interval-start next))
+ (setq prev next)
+ (setq ints (cdr ints))))
+ (setq intervals (cons (cons interval-start prev) intervals))
+ (reverse intervals))))
+
+ (defun prolog-dash-letters (string)
+ "Return a condensed regexp covering all letters in STRING."
+ (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
+ (string-to-list string))))
+ codes)
+ (while intervals
+ (let* ((i (car intervals))
+ (from (car i))
+ (to (cdr i))
+ (c (cond ((= from to) `(,from))
+ ((= (1+ from) to) `(,from ,to))
+ (t `(,from ?- ,to)))))
+ (setq codes (cons c codes)))
+ (setq intervals (cdr intervals)))
+ (apply 'concat (reverse codes))))
+
+ (let ((up_string "")
+ (low_string ""))
+ ;; Use `map-char-table' if it is defined. Otherwise enumerate all
+ ;; numbers between 0 and 255. `map-char-table' is probably safer.
+ ;;
+ ;; `map-char-table' causes problems under Emacs 23.0.0.1, the
+ ;; while loop seems to do its job well (Ryszard Szopa)
+ ;;
+ ;;(if (and (not (featurep 'xemacs))
+ ;; (fboundp 'map-char-table))
+ ;; (map-char-table
+ ;; (lambda (key value)
+ ;; (cond
+ ;; ((and
+ ;; (eq (prolog-int-to-char key) (downcase key))
+ ;; (eq (prolog-int-to-char key) (upcase key)))
+ ;; ;; Do nothing if upper and lower case are the same
+ ;; )
+ ;; ((eq (prolog-int-to-char key) (downcase key))
+ ;; ;; The char is lower case
+ ;; (setq low_string (format "%s%c" low_string key)))
+ ;; ((eq (prolog-int-to-char key) (upcase key))
+ ;; ;; The char is upper case
+ ;; (setq up_string (format "%s%c" up_string key)))
+ ;; ))
+ ;; (current-case-table))
+ ;; `map-char-table' was undefined.
+ (let ((key 0))
+ (while (< key 256)
+ (cond
+ ((and
+ (eq (prolog-int-to-char key) (downcase key))
+ (eq (prolog-int-to-char key) (upcase key)))
+ ;; Do nothing if upper and lower case are the same
+ )
+ ((eq (prolog-int-to-char key) (downcase key))
+ ;; The char is lower case
+ (setq low_string (format "%s%c" low_string key)))
+ ((eq (prolog-int-to-char key) (upcase key))
+ ;; The char is upper case
+ (setq up_string (format "%s%c" up_string key)))
+ )
+ (setq key (1+ key))))
+ ;; )
+ ;; The strings are single-byte strings.
+ (defconst prolog-upper-case-string (prolog-dash-letters up_string)
+ "A string containing a char-range matching all upper case characters.")
+ (defconst prolog-lower-case-string (prolog-dash-letters low_string)
+ "A string containing a char-range matching all lower case characters.")
+ ))
+
+(defconst prolog-atom-char-regexp
+ (if (string-match "[[:alnum:]]" "0")
+ "[[:alnum:]_$]"
+ (format "[%s%s0-9_$]" prolog-lower-case-string prolog-upper-case-string))
+ "Regexp specifying characters which constitute atoms without quoting.")
+(defconst prolog-atom-regexp
+ (format "[%s$]%s*" prolog-lower-case-string prolog-atom-char-regexp))
(defconst prolog-left-paren "[[({]" ;FIXME: Why not \\s(?
"The characters used as left parentheses for the indentation code.")
'(("dcg" . "-->") ("rule" . ":-") ("simplification" . "<=>")
("propagation" . "==>")))))
+;; SMIE support
+
+(require 'smie)
+
+(defvar prolog-use-smie t)
+
+(defun prolog-smie-forward-token ()
+ ;; FIXME: Add support for 0'<char>, if needed after adding it to
+ ;; syntax-propertize-functions.
+ (forward-comment (point-max))
+ (buffer-substring-no-properties
+ (point)
+ (progn (cond
+ ((looking-at "[!;]") (forward-char 1))
+ ((not (zerop (skip-chars-forward "#&*+-./:<=>?@\\^`~"))))
+ ((not (zerop (skip-syntax-forward "w_'"))))
+ ;; In case of non-ASCII punctuation.
+ ((not (zerop (skip-syntax-forward ".")))))
+ (point))))
+
+(defun prolog-smie-backward-token ()
+ ;; FIXME: Add support for 0'<char>, if needed after adding it to
+ ;; syntax-propertize-functions.
+ (forward-comment (- (point-max)))
+ (buffer-substring-no-properties
+ (point)
+ (progn (cond
+ ((memq (char-before) '(?! ?\;)) (forward-char -1))
+ ((not (zerop (skip-chars-backward "#&*+-./:<=>?@\\^`~"))))
+ ((not (zerop (skip-syntax-backward "w_'"))))
+ ;; In case of non-ASCII punctuation.
+ ((not (zerop (skip-syntax-backward ".")))))
+ (point))))
+
+(defconst prolog-smie-grammar
+ ;; Rather than construct the operator levels table from the BNF,
+ ;; we directly provide the operator precedences from GNU Prolog's
+ ;; manual (7.14.10 op/3). The only problem is that GNU Prolog's
+ ;; manual uses precedence levels in the opposite sense (higher
+ ;; numbers bind less tightly) than SMIE, so we use negative numbers.
+ '(("." -10000 -10000)
+ (":-" -1200 -1200)
+ ("-->" -1200 -1200)
+ (";" -1100 -1100)
+ ("->" -1050 -1050)
+ ("," -1000 -1000)
+ ("\\+" -900 -900)
+ ("=" -700 -700)
+ ("\\=" -700 -700)
+ ("=.." -700 -700)
+ ("==" -700 -700)
+ ("\\==" -700 -700)
+ ("@<" -700 -700)
+ ("@=<" -700 -700)
+ ("@>" -700 -700)
+ ("@>=" -700 -700)
+ ("is" -700 -700)
+ ("=:=" -700 -700)
+ ("=\\=" -700 -700)
+ ("<" -700 -700)
+ ("=<" -700 -700)
+ (">" -700 -700)
+ (">=" -700 -700)
+ (":" -600 -600)
+ ("+" -500 -500)
+ ("-" -500 -500)
+ ("/\\" -500 -500)
+ ("\\/" -500 -500)
+ ("*" -400 -400)
+ ("/" -400 -400)
+ ("//" -400 -400)
+ ("rem" -400 -400)
+ ("mod" -400 -400)
+ ("<<" -400 -400)
+ (">>" -400 -400)
+ ("**" -200 -200)
+ ("^" -200 -200)
+ ;; Prefix
+ ;; ("+" 200 200)
+ ;; ("-" 200 200)
+ ;; ("\\" 200 200)
+ (:smie-closer-alist (t . "."))
+ )
+ "Precedence levels of infix operators.")
+
+(defun prolog-smie-rules (kind token)
+ (pcase (cons kind token)
+ (`(:elem . basic) prolog-indent-width)
+ (`(:after . ".") '(column . 0)) ;; To work around smie-closer-alist.
+ (`(:after . ,(or `":-" `"->" `"-->")) prolog-indent-width)))
\f
;;-------------------------------------------------------------------
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
(set (make-local-variable 'normal-auto-fill-function) 'prolog-do-auto-fill)
- (set (make-local-variable 'indent-line-function) 'prolog-indent-line)
(set (make-local-variable 'comment-start) "%")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-add) 1)
;; inside quoted atoms or strings
(format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)"
prolog-quoted-atom-regexp prolog-string-regexp))
- (set (make-local-variable 'comment-indent-function) 'prolog-comment-indent)
(set (make-local-variable 'parens-require-spaces) nil)
;; Initialize Prolog system specific variables
(dolist (var '(prolog-keywords prolog-types prolog-mode-specificators
'(prolog-font-lock-keywords nil nil ((?_ . "w"))))
(set (make-local-variable 'syntax-propertize-function)
prolog-syntax-propertize-function)
+
+ (if prolog-use-smie
+ ;; Setup SMIE.
+ (smie-setup prolog-smie-grammar #'prolog-smie-rules
+ :forward-token #'prolog-smie-forward-token
+ :backward-token #'prolog-smie-backward-token)
+ (set (make-local-variable 'indent-line-function) 'prolog-indent-line))
)
(defun prolog-mode-keybindings-common (map)
((eq prolog-system 'gnu) "[GNU]")
(t ""))))
(prolog-mode-variables)
- (prolog-build-case-strings)
- (prolog-set-atom-regexps)
(dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar))
- ;; imenu entry moved to the appropriate hook for consistency
+ ;; `imenu' entry moved to the appropriate hook for consistency.
;; Load SICStus debugger if suitable
(if (and (eq prolog-system 'sicstus)
limit t)
(setq filepath (match-string 2)))
- ;; ###### Does this work with SICStus under Windows (i.e. backslashes and stuff?)
+ ;; ###### Does this work with SICStus under Windows
+ ;; (i.e. backslashes and stuff?)
(if (string-match "\\(.*/\\)\\([^/]*\\)$" filepath)
(progn
(setq dir (match-string 1 filepath))
(defface prolog-builtin-face
'((((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
- (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+ (((class grayscale) (background light))
+ :foreground "LightGray" :bold t)
(((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
(t (:bold t)))
"Face name to use for compiler warnings."
(if (eq prolog-system 'mercury)
(list
(prolog-make-keywords-regexp prolog-mode-specificators-i t)
- 0 'font-lock-reference-face)))
+ 0 'font-lock-constant-face)))
(directives
(if (eq prolog-system 'mercury)
(list
(prolog-insert-spaces-after-paren))
))
-(defun prolog-comment-indent ()
- "Compute prolog comment indentation."
- ;; FIXME: Only difference with default behavior is that %%% is not
- ;; flushed to column 0 but just left where the user put it.
- (cond ((looking-at "%%%") (prolog-indentation-level-of-line))
- ((looking-at "%%") (prolog-indent-level))
- (t
- (save-excursion
- (skip-chars-backward " \t")
- ;; Insert one space at least, except at left margin.
- (max (+ (current-column) (if (bolp) 0 1))
- comment-column)))
- ))
-
(defun prolog-indent-level ()
"Compute prolog indentation level."
(save-excursion
(save-excursion
(let ((state (prolog-clause-info))
(object (prolog-in-object)))
- (if (or (equal (nth 0 state) "") (equal (prolog-in-string-or-comment) 'cmt))
+ (if (or (equal (nth 0 state) "")
+ (equal (prolog-in-string-or-comment) 'cmt))
nil
(if (and (eq prolog-system 'sicstus)
object)
(defun prolog-pred-start ()
"Return the starting point of the first clause of the current predicate."
+ ;; FIXME: Use SMIE.
(save-excursion
(goto-char (prolog-clause-start))
;; Find first clause, unless it was a directive
(defun prolog-pred-end ()
"Return the position at the end of the last clause of the current predicate."
+ ;; FIXME: Use SMIE.
(save-excursion
- (goto-char (prolog-clause-end)) ; if we are before the first predicate
+ (goto-char (prolog-clause-end)) ; If we are before the first predicate.
(goto-char (prolog-clause-start))
(let* ((pinfo (prolog-clause-info))
(predname (nth 0 pinfo))
(defun prolog-beginning-of-predicate ()
"Go to the nearest beginning of predicate before current point.
Return the final point or nil if no such a beginning was found."
+ ;; FIXME: Hook into beginning-of-defun.
(interactive)
(let ((op (point))
(pos (prolog-pred-start)))
(defun prolog-end-of-predicate ()
"Go to the end of the current predicate."
+ ;; FIXME: Hook into end-of-defun.
(interactive)
(let ((op (point)))
(goto-char (prolog-pred-end))
(indent-for-comment)))
(defun prolog-indent-predicate ()
- "*Indent the current predicate."
+ "Indent the current predicate."
(interactive)
(indent-region (prolog-pred-start) (prolog-pred-end) nil))
(defun prolog-indent-buffer ()
- "*Indent the entire buffer."
+ "Indent the entire buffer."
(interactive)
(indent-region (point-min) (point-max) nil))
"Delete preceding character or whitespace.
If `prolog-hungry-delete-key-flag' is non-nil, then all preceding whitespace is
consumed. If however an ARG is supplied, or `prolog-hungry-delete-key-flag' is
-nil, or point is inside a literal then the function in the variable
+nil, or point is inside a literal then the function
`backward-delete-char' is called."
(interactive "P")
(if (or (not prolog-hungry-delete-key-flag)
(defun prolog-electric-if-then-else (arg)
"If `prolog-electric-if-then-else-flag' is non-nil, indent if-then-else constructs.
Bound to the >, ; and ( keys."
+ ;; FIXME: Use post-self-insert-hook or electric-indent-mode.
(interactive "P")
(self-insert-command (prefix-numeric-value arg))
(if prolog-electric-if-then-else-flag (prolog-insert-spaces-after-paren)))
That is, insert space (if appropriate), `:-' and newline if colon is pressed
at the end of a line that starts in the first column (i.e., clause
heads)."
+ ;; FIXME: Use post-self-insert-hook.
(interactive "P")
(if (and prolog-electric-colon-flag
(null arg)
(unless (save-excursion (backward-char 1) (looking-at "\\s "))
(insert " "))
(insert ":-\n")
- (prolog-indent-line))
+ (indent-according-to-mode))
(self-insert-command (prefix-numeric-value arg))))
(defun prolog-electric-dash (arg)
that is, insert space (if appropriate), `-->' and newline if dash is pressed
at the end of a line that starts in the first column (i.e., DCG
heads)."
+ ;; FIXME: Use post-self-insert-hook.
(interactive "P")
(if (and prolog-electric-dash-flag
(null arg)
(unless (save-excursion (backward-char 1) (looking-at "\\s "))
(insert " "))
(insert "-->\n")
- (prolog-indent-line))
+ (indent-according-to-mode))
(self-insert-command (prefix-numeric-value arg))))
(defun prolog-electric-dot (arg)
of the current predicate.
When called with prefix argument ARG, insert just dot."
+ ;; FIXME: Use post-self-insert-hook.
(interactive "P")
;; Check for situations when the electricity should not be active
(if (or (not prolog-electric-dot-flag)
on a variable then replace the variable with underscore and skip
the following comma and whitespace, if any.
If the point is not on a variable then insert underscore."
+ ;; FIXME: Use post-self-insert-hook.
(interactive)
(if prolog-electric-underscore-flag
(let (;start
(backward-char)))
)))
+;;(defun prolog-regexp-dash-continuous-chars (chars)
+;; (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
+;; (beg 0)
+;; (end 0))
+;; (if (null ints)
+;; chars
+;; (while (and (< (+ beg 1) (length chars))
+;; (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
+;; (= (nth beg ints) (nth (+ beg 1) ints)))))
+;; (setq beg (+ beg 1)))
+;; (setq beg (+ beg 1)
+;; end beg)
+;; (while (and (< (+ end 1) (length chars))
+;; (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
+;; (= (nth end ints) (nth (+ end 1) ints))))
+;; (setq end (+ end 1)))
+;; (if (equal (substring chars end) "")
+;; (substring chars 0 beg)
+;; (concat (substring chars 0 beg) "-"
+;; (prolog-regexp-dash-continuous-chars (substring chars end))))
+;; )))
+
+;;(defun prolog-condense-character-sets (regexp)
+;; "Condense adjacent characters in character sets of REGEXP."
+;; (let ((next -1))
+;; (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
+;; (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
+;; t t regexp 1))))
+;; regexp)
-(defun prolog-set-atom-regexps ()
- "Set the `prolog-atom-char-regexp' and `prolog-atom-regexp' variables.
-Must be called after `prolog-build-case-strings'."
- (setq prolog-atom-char-regexp
- (format "[%s%s0-9_$]"
- ;; FIXME: why not a-zA-Z?
- prolog-lower-case-string
- prolog-upper-case-string))
- (setq prolog-atom-regexp
- (format "[%s$]%s*"
- prolog-lower-case-string
- prolog-atom-char-regexp))
- )
-
-(defun prolog-build-case-strings ()
- "Set `prolog-upper-case-string' and `prolog-lower-case-string'.
-Uses the current case-table for extracting the relevant information."
- (let ((up_string "")
- (low_string ""))
- ;; Use `map-char-table' if it is defined. Otherwise enumerate all
- ;; numbers between 0 and 255. `map-char-table' is probably safer.
- ;;
- ;; `map-char-table' causes problems under Emacs 23.0.0.1, the
- ;; while loop seems to do its job well (Ryszard Szopa)
- ;;
- ;;(if (and (not (featurep 'xemacs))
- ;; (fboundp 'map-char-table))
- ;; (map-char-table
- ;; (lambda (key value)
- ;; (cond
- ;; ((and
- ;; (eq (prolog-int-to-char key) (downcase key))
- ;; (eq (prolog-int-to-char key) (upcase key)))
- ;; ;; Do nothing if upper and lower case are the same
- ;; )
- ;; ((eq (prolog-int-to-char key) (downcase key))
- ;; ;; The char is lower case
- ;; (setq low_string (format "%s%c" low_string key)))
- ;; ((eq (prolog-int-to-char key) (upcase key))
- ;; ;; The char is upper case
- ;; (setq up_string (format "%s%c" up_string key)))
- ;; ))
- ;; (current-case-table))
- ;; `map-char-table' was undefined.
- (let ((key 0))
- (while (< key 256)
- (cond
- ((and
- (eq (prolog-int-to-char key) (downcase key))
- (eq (prolog-int-to-char key) (upcase key)))
- ;; Do nothing if upper and lower case are the same
- )
- ((eq (prolog-int-to-char key) (downcase key))
- ;; The char is lower case
- (setq low_string (format "%s%c" low_string key)))
- ((eq (prolog-int-to-char key) (upcase key))
- ;; The char is upper case
- (setq up_string (format "%s%c" up_string key)))
- )
- (setq key (1+ key))))
- ;; )
- ;; The strings are single-byte strings
- (setq prolog-upper-case-string (prolog-dash-letters up_string))
- (setq prolog-lower-case-string (prolog-dash-letters low_string))
- ))
-
-;(defun prolog-regexp-dash-continuous-chars (chars)
-; (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
-; (beg 0)
-; (end 0))
-; (if (null ints)
-; chars
-; (while (and (< (+ beg 1) (length chars))
-; (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
-; (= (nth beg ints) (nth (+ beg 1) ints)))))
-; (setq beg (+ beg 1)))
-; (setq beg (+ beg 1)
-; end beg)
-; (while (and (< (+ end 1) (length chars))
-; (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
-; (= (nth end ints) (nth (+ end 1) ints))))
-; (setq end (+ end 1)))
-; (if (equal (substring chars end) "")
-; (substring chars 0 beg)
-; (concat (substring chars 0 beg) "-"
-; (prolog-regexp-dash-continuous-chars (substring chars end))))
-; )))
-
-(defun prolog-ints-intervals (ints)
- "Return a list of intervals (from . to) covering INTS."
- (when ints
- (setq ints (sort ints '<))
- (let ((prev (car ints))
- (interval-start (car ints))
- intervals)
- (while ints
- (let ((next (car ints)))
- (when (> next (1+ prev)) ; start of new interval
- (setq intervals (cons (cons interval-start prev) intervals))
- (setq interval-start next))
- (setq prev next)
- (setq ints (cdr ints))))
- (setq intervals (cons (cons interval-start prev) intervals))
- (reverse intervals))))
-
-(defun prolog-dash-letters (string)
- "Return a condensed regexp covering all letters in STRING."
- (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
- (string-to-list string))))
- codes)
- (while intervals
- (let* ((i (car intervals))
- (from (car i))
- (to (cdr i))
- (c (cond ((= from to) `(,from))
- ((= (1+ from) to) `(,from ,to))
- (t `(,from ?- ,to)))))
- (setq codes (cons c codes)))
- (setq intervals (cdr intervals)))
- (apply 'concat (reverse codes))))
-
-;(defun prolog-condense-character-sets (regexp)
-; "Condense adjacent characters in character sets of REGEXP."
-; (let ((next -1))
-; (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
-; (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
-; t t regexp 1))))
-; regexp)
-
-;; GNU Emacs compatibility: GNU Emacs does not differentiate between
-;; ints and chars, or at least these two are interchangeable.
-(defalias 'prolog-int-to-char
- (if (fboundp 'int-to-char) #'int-to-char #'identity))
-
-(defalias 'prolog-char-to-int
- (if (fboundp 'char-to-int) #'char-to-int #'identity))
-\f
;;-------------------------------------------------------------------
;; Menu stuff (both for the editing buffer and for the inferior
;; prolog buffer)
["Beginning of predicate" prolog-beginning-of-predicate t]
["End of predicate" prolog-end-of-predicate t]
"---"
- ["Indent line" prolog-indent-line t]
+ ["Indent line" indent-according-to-mode t]
["Indent region" indent-region (region-exists-p)]
["Indent predicate" prolog-indent-predicate t]
["Indent buffer" prolog-indent-buffer t]
;; User variables.
(defcustom ps-mode-auto-indent t
- "*Should we use autoindent?"
+ "Should we use autoindent?"
:group 'PostScript-edit
:type 'boolean)
(defcustom ps-mode-tab 4
- "*Number of spaces to use when indenting."
+ "Number of spaces to use when indenting."
:group 'PostScript-edit
:type 'integer)
(defcustom ps-mode-paper-size '(595 842)
- "*Default paper size.
+ "Default paper size.
When inserting an EPSF template these values are used
to set the boundingbox to include the whole page.
(lpr-command (if (memq system-type '(usg-unix-v hpux irix))
"lp" "lpr")))
(lpr-buffer)))
- "*Lisp function to print current buffer as PostScript."
+ "Lisp function to print current buffer as PostScript."
:group 'PostScript-edit
:type 'function)
(defcustom ps-run-prompt "\\(GS\\(<[0-9]+\\)?>\\)+"
- "*Regexp to match prompt in interactive PostScript."
+ "Regexp to match prompt in interactive PostScript."
:group 'PostScript-interaction
:type 'regexp)
("^\\(Current file position is\\) \\([0-9]+\\)"
(1 font-lock-comment-face nil nil)
(2 font-lock-warning-face nil nil))))
- "*Medium level highlighting of messages from the PostScript interpreter.
+ "Medium level highlighting of messages from the PostScript interpreter.
See documentation on font-lock for details."
:group 'PostScript-interaction
(boolean :tag "Laxmatch" :value t))))))
(defcustom ps-run-x '("gs" "-r72" "-sPAPERSIZE=a4")
- "*Command as list to run PostScript with graphic display."
+ "Command as list to run PostScript with graphic display."
:group 'PostScript-interaction
:type '(repeat string))
(defcustom ps-run-dumb '("gs" "-dNODISPLAY")
- "*Command as list to run PostScript without graphic display."
+ "Command as list to run PostScript without graphic display."
:group 'PostScript-interaction
:type '(repeat string))
(defcustom ps-run-init nil
- "*String of commands to send to PostScript to start interactive.
+ "String of commands to send to PostScript to start interactive.
Example: \"executive\"
:type '(choice (const nil) string))
(defcustom ps-run-error-line-numbers nil
- "*What values are used by the PostScript interpreter in error messages?"
+ "What values are used by the PostScript interpreter in error messages?"
:group 'PostScript-interaction
:type '(choice (const :tag "line numbers" t)
(const :tag "byte counts" nil)))
(defcustom ps-run-tmp-dir nil
- "*Name of directory to place temporary file.
+ "Name of directory to place temporary file.
If nil, use `temporary-file-directory'."
:group 'PostScript-interaction
:type '(choice (const nil) directory))
;; - 8bit characters (warning face)
;; Multiline strings are not supported. Strings with nested brackets are.
(defconst ps-mode-font-lock-keywords-1
- '(("\\`%!PS.*" . font-lock-reference-face)
+ '(("\\`%!PS.*" . font-lock-constant-face)
("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$"
- . font-lock-reference-face)
+ . font-lock-constant-face)
(ps-mode-match-string-or-comment
(1 font-lock-comment-face nil t)
(2 font-lock-string-face nil t))
-;;; python.el --- silly walks for Python -*- coding: iso-8859-1 -*-
+;;; python.el --- Python's flying circus support for Emacs
;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
-;; Author: Dave Love <fx@gnu.org>
+;; Author: Fabián E. Gallina <fabian@anue.biz>
+;; URL: https://github.com/fgallina/python.el
+;; Version: 0.24.2
;; Maintainer: FSF
-;; Created: Nov 2003
+;; Created: Jul 2010
;; Keywords: languages
;; 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.
+;; 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.
+;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
-;; Major mode for editing Python, with support for inferior processes.
-
-;; There is another Python mode, python-mode.el:
-;; http://launchpad.net/python-mode
-;; used by XEmacs, and originally maintained with Python.
-;; That isn't covered by an FSF copyright assignment (?), unlike this
-;; code, and seems not to be well-maintained for Emacs (though I've
-;; submitted fixes). This mode is rather simpler and is better in
-;; other ways. In particular, using the syntax functions with text
-;; properties maintained by font-lock makes it more correct with
-;; arbitrary string and comment contents.
-
-;; This doesn't implement all the facilities of python-mode.el. Some
-;; just need doing, e.g. catching exceptions in the inferior Python
-;; buffer (but see M-x pdb for debugging). [Actually, the use of
-;; `compilation-shell-minor-mode' now is probably enough for that.]
-;; Others don't seem appropriate. For instance,
-;; `forward-into-nomenclature' should be done separately, since it's
-;; not specific to Python, and I've installed a minor mode to do the
-;; job properly in Emacs 23. [CC mode 5.31 contains an incompatible
-;; feature, `subword-mode' which is intended to have a similar
-;; effect, but actually only affects word-oriented keybindings.]
-
-;; Other things seem more natural or canonical here, e.g. the
-;; {beginning,end}-of-defun implementation dealing with nested
-;; definitions, and the inferior mode following `cmuscheme'. (The
-;; inferior mode can find the source of errors from
-;; `python-send-region' & al via `compilation-shell-minor-mode'.)
-;; There is (limited) symbol completion using lookup in Python and
-;; Eldoc support also using the inferior process. Successive TABs
-;; cycle between possible indentations for the line.
-
-;; Even where it has similar facilities, this mode is incompatible
-;; with python-mode.el in some respects. For instance, various key
-;; bindings are changed to obey Emacs conventions.
-
-;; TODO: See various Fixmes below.
-
-;; Fixme: This doesn't support (the nascent) Python 3 .
+;; Major mode for editing Python files with some fontification and
+;; indentation bits extracted from original Dave Love's python.el
+;; found in GNU/Emacs.
+
+;; Implements Syntax highlighting, Indentation, Movement, Shell
+;; interaction, Shell completion, Shell virtualenv support, Pdb
+;; tracking, Symbol completion, Skeletons, FFAP, Code Check, Eldoc,
+;; imenu.
+
+;; Syntax highlighting: Fontification of code is provided and supports
+;; python's triple quoted strings properly.
+
+;; Indentation: Automatic indentation with indentation cycling is
+;; provided, it allows you to navigate different available levels of
+;; indentation by hitting <tab> several times. Also when inserting a
+;; colon the `python-indent-electric-colon' command is invoked and
+;; causes the current line to be dedented automatically if needed.
+
+;; Movement: `beginning-of-defun' and `end-of-defun' functions are
+;; properly implemented. There are also specialized
+;; `forward-sentence' and `backward-sentence' replacements called
+;; `python-nav-forward-block', `python-nav-backward-block'
+;; respectively which navigate between beginning of blocks of code.
+;; Extra functions `python-nav-forward-statement',
+;; `python-nav-backward-statement',
+;; `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' allows easy
+;; navigation between code blocks.
+
+;; Shell interaction: is provided and allows you to execute easily any
+;; block of code of your current buffer in an inferior Python process.
+
+;; Shell completion: hitting tab will try to complete the current
+;; word. Shell completion is implemented in a manner that if you
+;; change the `python-shell-interpreter' to any other (for example
+;; IPython) it should be easy to integrate another way to calculate
+;; completions. You just need to specify your custom
+;; `python-shell-completion-setup-code' and
+;; `python-shell-completion-string-code'.
+
+;; Here is a complete example of the settings you would use for
+;; iPython 0.11:
+
+;; (setq
+;; python-shell-interpreter "ipython"
+;; python-shell-interpreter-args ""
+;; python-shell-prompt-regexp "In \\[[0-9]+\\]: "
+;; python-shell-prompt-output-regexp "Out\\[[0-9]+\\]: "
+;; python-shell-completion-setup-code
+;; "from IPython.core.completerlib import module_completion"
+;; python-shell-completion-module-string-code
+;; "';'.join(module_completion('''%s'''))\n"
+;; python-shell-completion-string-code
+;; "';'.join(get_ipython().Completer.all_completions('''%s'''))\n")
+
+;; For iPython 0.10 everything would be the same except for
+;; `python-shell-completion-string-code' and
+;; `python-shell-completion-module-string-code':
+
+;; (setq python-shell-completion-string-code
+;; "';'.join(__IP.complete('''%s'''))\n"
+;; python-shell-completion-module-string-code "")
+
+;; Unfortunately running iPython on Windows needs some more tweaking.
+;; The way you must set `python-shell-interpreter' and
+;; `python-shell-interpreter-args' is as follows:
+
+;; (setq
+;; python-shell-interpreter "C:\\Python27\\python.exe"
+;; python-shell-interpreter-args
+;; "-i C:\\Python27\\Scripts\\ipython-script.py")
+
+;; That will spawn the iPython process correctly (Of course you need
+;; to modify the paths according to your system).
+
+;; Please note that the default completion system depends on the
+;; readline module, so if you are using some Operating System that
+;; bundles Python without it (like Windows) just install the
+;; pyreadline from http://ipython.scipy.org/moin/PyReadline/Intro and
+;; you should be good to go.
+
+;; Shell virtualenv support: The shell also contains support for
+;; virtualenvs and other special environment modifications thanks to
+;; `python-shell-process-environment' and `python-shell-exec-path'.
+;; These two variables allows you to modify execution paths and
+;; environment variables to make easy for you to setup virtualenv rules
+;; or behavior modifications when running shells. Here is an example
+;; of how to make shell processes to be run using the /path/to/env/
+;; virtualenv:
+
+;; (setq python-shell-process-environment
+;; (list
+;; (format "PATH=%s" (mapconcat
+;; 'identity
+;; (reverse
+;; (cons (getenv "PATH")
+;; '("/path/to/env/bin/")))
+;; ":"))
+;; "VIRTUAL_ENV=/path/to/env/"))
+;; (python-shell-exec-path . ("/path/to/env/bin/"))
+
+;; Since the above is cumbersome and can be programmatically
+;; calculated, the variable `python-shell-virtualenv-path' is
+;; provided. When this variable is set with the path of the
+;; virtualenv to use, `process-environment' and `exec-path' get proper
+;; values in order to run shells inside the specified virtualenv. So
+;; the following will achieve the same as the previous example:
+
+;; (setq python-shell-virtualenv-path "/path/to/env/")
+
+;; Also the `python-shell-extra-pythonpaths' variable have been
+;; introduced as simple way of adding paths to the PYTHONPATH without
+;; affecting existing values.
+
+;; Pdb tracking: when you execute a block of code that contains some
+;; call to pdb (or ipdb) it will prompt the block of code and will
+;; follow the execution of pdb marking the current line with an arrow.
+
+;; Symbol completion: you can complete the symbol at point. It uses
+;; the shell completion in background so you should run
+;; `python-shell-send-buffer' from time to time to get better results.
+
+;; Skeletons: 6 skeletons are provided for simple inserting of class,
+;; def, for, if, try and while. These skeletons are integrated with
+;; dabbrev. If you have `dabbrev-mode' activated and
+;; `python-skeleton-autoinsert' is set to t, then whenever you type
+;; the name of any of those defined and hit SPC, they will be
+;; automatically expanded.
+
+;; FFAP: You can find the filename for a given module when using ffap
+;; out of the box. This feature needs an inferior python shell
+;; running.
+
+;; Code check: Check the current file for errors with `python-check'
+;; using the program defined in `python-check-command'.
+
+;; Eldoc: returns documentation for object at point by using the
+;; inferior python subprocess to inspect its documentation. As you
+;; might guessed you should run `python-shell-send-buffer' from time
+;; to time to get better results too.
+
+;; imenu: This mode supports imenu in its most basic form, letting it
+;; build the necessary alist via `imenu-default-create-index-function'
+;; by having set `imenu-extract-index-name-function' to
+;; `python-info-current-defun'.
+
+;; If you used python-mode.el you probably will miss auto-indentation
+;; when inserting newlines. To achieve the same behavior you have
+;; two options:
+
+;; 1) Use GNU/Emacs' standard binding for `newline-and-indent': C-j.
+
+;; 2) Add the following hook in your .emacs:
+
+;; (add-hook 'python-mode-hook
+;; #'(lambda ()
+;; (define-key python-mode-map "\C-m" 'newline-and-indent)))
+
+;; I'd recommend the first one since you'll get the same behavior for
+;; all modes out-of-the-box.
+
+;;; Installation:
+
+;; Add this to your .emacs:
+
+;; (add-to-list 'load-path "/folder/containing/file")
+;; (require 'python)
+
+;;; TODO:
;;; Code:
-(require 'comint)
(require 'ansi-color)
+(require 'comint)
(eval-when-compile
- (require 'compile)
- (require 'hippie-exp))
+ (require 'cl)
+ ;; Avoid compiler warnings
+ (defvar view-return-to-alist)
+ (defvar compilation-error-regexp-alist)
+ (defvar outline-heading-end-regexp))
(autoload 'comint-mode "comint")
+;;;###autoload
+(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
+;;;###autoload
+(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode))
+
(defgroup python nil
- "Silly walks in the Python language."
+ "Python Language's flying circus support for Emacs."
:group 'languages
- :version "22.1"
+ :version "23.2"
:link '(emacs-commentary-link "python"))
+
\f
-;;;###autoload
-(add-to-list 'interpreter-mode-alist (cons (purecopy "jython") 'jython-mode))
-;;;###autoload
-(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode))
-;;;###autoload
-(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
+;;; Bindings
+
+(defvar python-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Movement
+ (substitute-key-definition 'backward-sentence
+ 'python-nav-backward-block
+ map global-map)
+ (substitute-key-definition 'forward-sentence
+ 'python-nav-forward-block
+ map global-map)
+ (define-key map "\C-c\C-j" 'imenu)
+ ;; Indent specific
+ (define-key map "\177" 'python-indent-dedent-line-backspace)
+ (define-key map (kbd "<backtab>") 'python-indent-dedent-line)
+ (define-key map "\C-c<" 'python-indent-shift-left)
+ (define-key map "\C-c>" 'python-indent-shift-right)
+ (define-key map ":" 'python-indent-electric-colon)
+ ;; Skeletons
+ (define-key map "\C-c\C-tc" 'python-skeleton-class)
+ (define-key map "\C-c\C-td" 'python-skeleton-def)
+ (define-key map "\C-c\C-tf" 'python-skeleton-for)
+ (define-key map "\C-c\C-ti" 'python-skeleton-if)
+ (define-key map "\C-c\C-tt" 'python-skeleton-try)
+ (define-key map "\C-c\C-tw" 'python-skeleton-while)
+ ;; Shell interaction
+ (define-key map "\C-c\C-p" 'run-python)
+ (define-key map "\C-c\C-s" 'python-shell-send-string)
+ (define-key map "\C-c\C-r" 'python-shell-send-region)
+ (define-key map "\C-\M-x" 'python-shell-send-defun)
+ (define-key map "\C-c\C-c" 'python-shell-send-buffer)
+ (define-key map "\C-c\C-l" 'python-shell-send-file)
+ (define-key map "\C-c\C-z" 'python-shell-switch-to-shell)
+ ;; Some util commands
+ (define-key map "\C-c\C-v" 'python-check)
+ (define-key map "\C-c\C-f" 'python-eldoc-at-point)
+ ;; Utilities
+ (substitute-key-definition 'complete-symbol 'completion-at-point
+ map global-map)
+ (easy-menu-define python-menu map "Python Mode menu"
+ `("Python"
+ :help "Python-specific Features"
+ ["Shift region left" python-indent-shift-left :active mark-active
+ :help "Shift region left by a single indentation step"]
+ ["Shift region right" python-indent-shift-right :active mark-active
+ :help "Shift region right by a single indentation step"]
+ "-"
+ ["Start of def/class" beginning-of-defun
+ :help "Go to start of outermost definition around point"]
+ ["End of def/class" end-of-defun
+ :help "Go to end of definition around point"]
+ ["Mark def/class" mark-defun
+ :help "Mark outermost definition around point"]
+ ["Jump to def/class" imenu
+ :help "Jump to a class or function definition"]
+ "--"
+ ("Skeletons")
+ "---"
+ ["Start interpreter" run-python
+ :help "Run inferior Python process in a separate buffer"]
+ ["Switch to shell" python-shell-switch-to-shell
+ :help "Switch to running inferior Python process"]
+ ["Eval string" python-shell-send-string
+ :help "Eval string in inferior Python session"]
+ ["Eval buffer" python-shell-send-buffer
+ :help "Eval buffer in inferior Python session"]
+ ["Eval region" python-shell-send-region
+ :help "Eval region in inferior Python session"]
+ ["Eval defun" python-shell-send-defun
+ :help "Eval defun in inferior Python session"]
+ ["Eval file" python-shell-send-file
+ :help "Eval file in inferior Python session"]
+ ["Debugger" pdb :help "Run pdb under GUD"]
+ "----"
+ ["Check file" python-check
+ :help "Check file for errors"]
+ ["Help on symbol" python-eldoc-at-point
+ :help "Get help on symbol at point"]
+ ["Complete symbol" completion-at-point
+ :help "Complete symbol before point"]))
+ map)
+ "Keymap for `python-mode'.")
+
+\f
+;;; Python specialized rx
+
+(eval-when-compile
+ (defconst python-rx-constituents
+ `((block-start . ,(rx symbol-start
+ (or "def" "class" "if" "elif" "else" "try"
+ "except" "finally" "for" "while" "with")
+ symbol-end))
+ (decorator . ,(rx line-start (* space) ?@ (any letter ?_)
+ (* (any word ?_))))
+ (defun . ,(rx symbol-start (or "def" "class") symbol-end))
+ (if-name-main . ,(rx line-start "if" (+ space) "__name__"
+ (+ space) "==" (+ space)
+ (any ?' ?\") "__main__" (any ?' ?\")
+ (* space) ?:))
+ (symbol-name . ,(rx (any letter ?_) (* (any word ?_))))
+ (open-paren . ,(rx (or "{" "[" "(")))
+ (close-paren . ,(rx (or "}" "]" ")")))
+ (simple-operator . ,(rx (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%)))
+ ;; FIXME: rx should support (not simple-operator).
+ (not-simple-operator . ,(rx
+ (not
+ (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%))))
+ ;; FIXME: Use regexp-opt.
+ (operator . ,(rx (or "+" "-" "/" "&" "^" "~" "|" "*" "<" ">"
+ "=" "%" "**" "//" "<<" ">>" "<=" "!="
+ "==" ">=" "is" "not")))
+ ;; FIXME: Use regexp-opt.
+ (assignment-operator . ,(rx (or "=" "+=" "-=" "*=" "/=" "//=" "%=" "**="
+ ">>=" "<<=" "&=" "^=" "|="))))
+ "Additional Python specific sexps for `python-rx'"))
+
+(defmacro python-rx (&rest regexps)
+ "Python mode specialized rx macro.
+This variant of `rx' supports common python named REGEXPS."
+ (let ((rx-constituents (append python-rx-constituents rx-constituents)))
+ (cond ((null regexps)
+ (error "No regexp"))
+ ((cdr regexps)
+ (rx-to-string `(and ,@regexps) t))
+ (t
+ (rx-to-string (car regexps) t)))))
+
\f
-;;;; Font lock
+;;; 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
- ;; From v 2.7 reference, § keywords.
- ;; def and class dealt with separately below
- (or "and" "as" "assert" "break" "continue" "del" "elif" "else"
- "except" "exec" "finally" "for" "from" "global" "if"
- "import" "in" "is" "lambda" "not" "or" "pass" "print"
- "raise" "return" "try" "while" "with" "yield"
- ;; Not real keywords, but close enough to be fontified as such
- "self" "True" "False"
- ;; Python 3
- "nonlocal")
- symbol-end)
- (,(rx symbol-start "None" symbol-end) ; see § Keywords in 2.7 manual
- . font-lock-constant-face)
- ;; Definitions
- (,(rx symbol-start (group "class") (1+ space) (group (1+ (or word ?_))))
- (1 font-lock-keyword-face) (2 font-lock-type-face))
- (,(rx symbol-start (group "def") (1+ space) (group (1+ (or word ?_))))
- (1 font-lock-keyword-face) (2 font-lock-function-name-face))
- ;; Top-level assignments are worth highlighting.
- (,(rx line-start (group (1+ (or word ?_))) (0+ space)
- (opt (or "+" "-" "*" "**" "/" "//" "&" "%" "|" "^" "<<" ">>")) "=")
- (1 font-lock-variable-name-face))
+ (or
+ "and" "del" "from" "not" "while" "as" "elif" "global" "or" "with"
+ "assert" "else" "if" "pass" "yield" "break" "except" "import" "class"
+ "in" "raise" "continue" "finally" "is" "return" "def" "for" "lambda"
+ "try"
+ ;; Python 2:
+ "print" "exec"
+ ;; Python 3:
+ ;; False, None, and True are listed as keywords on the Python 3
+ ;; documentation, but since they also qualify as constants they are
+ ;; fontified like that in order to keep font-lock consistent between
+ ;; Python versions.
+ "nonlocal"
+ ;; Extra:
+ "self")
+ symbol-end)
+ ;; functions
+ (,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_))))
+ (1 font-lock-function-name-face))
+ ;; classes
+ (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_))))
+ (1 font-lock-type-face))
+ ;; Constants
+ (,(rx symbol-start
+ (or
+ "Ellipsis" "False" "None" "NotImplemented" "True" "__debug__"
+ ;; copyright, license, credits, quit and exit are added by the site
+ ;; module and they are not intended to be used in programs
+ "copyright" "credits" "exit" "license" "quit")
+ symbol-end) . font-lock-constant-face)
;; Decorators.
(,(rx line-start (* (any " \t")) (group "@" (1+ (or word ?_))
- (0+ "." (1+ (or word ?_)))))
+ (0+ "." (1+ (or word ?_)))))
(1 font-lock-type-face))
- ;; Built-ins. (The next three blocks are from
- ;; `__builtin__.__dict__.keys()' in Python 2.7) These patterns
- ;; are debatable, but they at least help to spot possible
- ;; shadowing of builtins.
- (,(rx symbol-start (or
- ;; exceptions
- "ArithmeticError" "AssertionError" "AttributeError"
- "BaseException" "DeprecationWarning" "EOFError"
- "EnvironmentError" "Exception" "FloatingPointError"
- "FutureWarning" "GeneratorExit" "IOError" "ImportError"
- "ImportWarning" "IndentationError" "IndexError" "KeyError"
- "KeyboardInterrupt" "LookupError" "MemoryError" "NameError"
- "NotImplemented" "NotImplementedError" "OSError"
- "OverflowError" "PendingDeprecationWarning" "ReferenceError"
- "RuntimeError" "RuntimeWarning" "StandardError"
- "StopIteration" "SyntaxError" "SyntaxWarning" "SystemError"
- "SystemExit" "TabError" "TypeError" "UnboundLocalError"
- "UnicodeDecodeError" "UnicodeEncodeError" "UnicodeError"
- "UnicodeTranslateError" "UnicodeWarning" "UserWarning"
- "ValueError" "Warning" "ZeroDivisionError"
- ;; Python 2.7
- "BufferError" "BytesWarning" "WindowsError") symbol-end)
- . font-lock-type-face)
- (,(rx (or line-start (not (any ". \t"))) (* (any " \t")) symbol-start
- (group (or
- ;; callable built-ins, fontified when not appearing as
- ;; object attributes
- "abs" "all" "any" "apply" "basestring" "bool" "buffer" "callable"
- "chr" "classmethod" "cmp" "coerce" "compile" "complex"
- "copyright" "credits" "delattr" "dict" "dir" "divmod"
- "enumerate" "eval" "execfile" "exit" "file" "filter" "float"
- "frozenset" "getattr" "globals" "hasattr" "hash" "help"
- "hex" "id" "input" "int" "intern" "isinstance" "issubclass"
- "iter" "len" "license" "list" "locals" "long" "map" "max"
- "min" "object" "oct" "open" "ord" "pow" "property" "quit"
- "range" "raw_input" "reduce" "reload" "repr" "reversed"
- "round" "set" "setattr" "slice" "sorted" "staticmethod"
- "str" "sum" "super" "tuple" "type" "unichr" "unicode" "vars"
- "xrange" "zip"
- ;; Python 2.7.
- "bin" "bytearray" "bytes" "format" "memoryview" "next" "print"
- )) symbol-end)
- (1 font-lock-builtin-face))
- (,(rx symbol-start (or
- ;; other built-ins
- "True" "False" "None" "Ellipsis"
- "_" "__debug__" "__doc__" "__import__" "__name__" "__package__")
- symbol-end)
- . font-lock-builtin-face)))
+ ;; Builtin Exceptions
+ (,(rx symbol-start
+ (or
+ "ArithmeticError" "AssertionError" "AttributeError" "BaseException"
+ "DeprecationWarning" "EOFError" "EnvironmentError" "Exception"
+ "FloatingPointError" "FutureWarning" "GeneratorExit" "IOError"
+ "ImportError" "ImportWarning" "IndexError" "KeyError"
+ "KeyboardInterrupt" "LookupError" "MemoryError" "NameError"
+ "NotImplementedError" "OSError" "OverflowError"
+ "PendingDeprecationWarning" "ReferenceError" "RuntimeError"
+ "RuntimeWarning" "StopIteration" "SyntaxError" "SyntaxWarning"
+ "SystemError" "SystemExit" "TypeError" "UnboundLocalError"
+ "UnicodeDecodeError" "UnicodeEncodeError" "UnicodeError"
+ "UnicodeTranslateError" "UnicodeWarning" "UserWarning" "VMSError"
+ "ValueError" "Warning" "WindowsError" "ZeroDivisionError"
+ ;; Python 2:
+ "StandardError"
+ ;; Python 3:
+ "BufferError" "BytesWarning" "IndentationError" "ResourceWarning"
+ "TabError")
+ symbol-end) . font-lock-type-face)
+ ;; Builtins
+ (,(rx symbol-start
+ (or
+ "abs" "all" "any" "bin" "bool" "callable" "chr" "classmethod"
+ "compile" "complex" "delattr" "dict" "dir" "divmod" "enumerate"
+ "eval" "filter" "float" "format" "frozenset" "getattr" "globals"
+ "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance"
+ "issubclass" "iter" "len" "list" "locals" "map" "max" "memoryview"
+ "min" "next" "object" "oct" "open" "ord" "pow" "print" "property"
+ "range" "repr" "reversed" "round" "set" "setattr" "slice" "sorted"
+ "staticmethod" "str" "sum" "super" "tuple" "type" "vars" "zip"
+ "__import__"
+ ;; Python 2:
+ "basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce"
+ "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce"
+ "intern"
+ ;; Python 3:
+ "ascii" "bytearray" "bytes" "exec"
+ ;; Extra:
+ "__all__" "__doc__" "__name__" "__package__")
+ symbol-end) . font-lock-builtin-face)
+ ;; assignments
+ ;; support for a = b = c = 5
+ (,(lambda (limit)
+ (let ((re (python-rx (group (+ (any word ?. ?_)))
+ (? ?\[ (+ (not (any ?\]))) ?\]) (* space)
+ assignment-operator)))
+ (when (re-search-forward re limit t)
+ (while (and (python-syntax-context 'paren)
+ (re-search-forward re limit t)))
+ (if (and (not (python-syntax-context 'paren))
+ (not (equal (char-after (point-marker)) ?=)))
+ t
+ (set-match-data nil)))))
+ (1 font-lock-variable-name-face nil nil))
+ ;; support for a, b, c = (1, 2, 3)
+ (,(lambda (limit)
+ (let ((re (python-rx (group (+ (any word ?. ?_))) (* space)
+ (* ?, (* space) (+ (any word ?. ?_)) (* space))
+ ?, (* space) (+ (any word ?. ?_)) (* space)
+ assignment-operator)))
+ (when (and (re-search-forward re limit t)
+ (goto-char (nth 3 (match-data))))
+ (while (and (python-syntax-context 'paren)
+ (re-search-forward re limit t))
+ (goto-char (nth 3 (match-data))))
+ (if (not (python-syntax-context 'paren))
+ t
+ (set-match-data nil)))))
+ (1 font-lock-variable-name-face nil nil))))
(defconst python-syntax-propertize-function
- ;; Make outer chars of matching triple-quote sequences into generic
- ;; string delimiters. Fixme: Is there a better way?
- ;; First avoid a sequence preceded by an odd number of backslashes.
(syntax-propertize-rules
- (;; ¡Backrefs don't work in syntax-propertize-rules!
- (concat "\\(?:\\([RUru]\\)[Rr]?\\|^\\|[^\\]\\(?:\\\\.\\)*\\)" ;Prefix.
- "\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)")
- (3 (ignore (python-quote-syntax))))
- ;; This doesn't really help.
- ;;((rx (and ?\\ (group ?\n))) (1 " "))
- ))
-
-(defun python-quote-syntax ()
- "Put `syntax-table' property correctly on triple quote.
-Used for syntactic keywords. N is the match number (1, 2 or 3)."
- ;; Given a triple quote, we have to check the context to know
- ;; whether this is an opening or closing triple or whether it's
- ;; quoted anyhow, and should be ignored. (For that we need to do
- ;; the same job as `syntax-ppss' to be correct and it seems to be OK
- ;; to use it here despite initial worries.) We also have to sort
- ;; out a possible prefix -- well, we don't _have_ to, but I think it
- ;; should be treated as part of the string.
-
- ;; Test cases:
- ;; ur"""ar""" x='"' # """
- ;; x = ''' """ ' a
- ;; '''
- ;; x '"""' x """ \"""" x
- (save-excursion
- (goto-char (match-beginning 0))
- (let ((syntax (save-match-data (syntax-ppss))))
- (cond
- ((eq t (nth 3 syntax)) ; after unclosed fence
- ;; Consider property for the last char if in a fenced string.
- (goto-char (nth 8 syntax)) ; fence position
- (skip-chars-forward "uUrR") ; skip any prefix
- ;; Is it a matching sequence?
- (if (eq (char-after) (char-after (match-beginning 2)))
- (put-text-property (match-beginning 3) (match-end 3)
- 'syntax-table (string-to-syntax "|"))))
- ((match-end 1)
- ;; Consider property for initial char, accounting for prefixes.
- (put-text-property (match-beginning 1) (match-end 1)
- 'syntax-table (string-to-syntax "|")))
- (t
- ;; Consider property for initial char, accounting for prefixes.
- (put-text-property (match-beginning 2) (match-end 2)
- 'syntax-table (string-to-syntax "|"))))
- )))
-
-;; This isn't currently in `font-lock-defaults' as probably not worth
-;; it -- we basically only mess with a few normally-symbol characters.
-
-;; (defun python-font-lock-syntactic-face-function (state)
-;; "`font-lock-syntactic-face-function' for Python mode.
-;; Returns the string or comment face as usual, with side effect of putting
-;; a `syntax-table' property on the inside of the string or comment which is
-;; the standard syntax table."
-;; (if (nth 3 state)
-;; (save-excursion
-;; (goto-char (nth 8 state))
-;; (condition-case nil
-;; (forward-sexp)
-;; (error nil))
-;; (put-text-property (1+ (nth 8 state)) (1- (point))
-;; 'syntax-table (standard-syntax-table))
-;; 'font-lock-string-face)
-;; (put-text-property (1+ (nth 8 state)) (line-end-position)
-;; 'syntax-table (standard-syntax-table))
-;; 'font-lock-comment-face))
-\f
-;;;; Keymap and syntax
-
-(defvar python-mode-map
- (let ((map (make-sparse-keymap)))
- ;; Mostly taken from python-mode.el.
- (define-key map ":" 'python-electric-colon)
- (define-key map "\177" 'python-backspace)
- (define-key map "\C-c<" 'python-shift-left)
- (define-key map "\C-c>" 'python-shift-right)
- (define-key map "\C-c\C-k" 'python-mark-block)
- (define-key map "\C-c\C-d" 'python-pdbtrack-toggle-stack-tracking)
- (define-key map "\C-c\C-n" 'python-next-statement)
- (define-key map "\C-c\C-p" 'python-previous-statement)
- (define-key map "\C-c\C-u" 'python-beginning-of-block)
- (define-key map "\C-c\C-f" 'python-describe-symbol)
- (define-key map "\C-c\C-w" 'python-check)
- (define-key map "\C-c\C-v" 'python-check) ; a la sgml-mode
- (define-key map "\C-c\C-s" 'python-send-string)
- (define-key map [?\C-\M-x] 'python-send-defun)
- (define-key map "\C-c\C-r" 'python-send-region)
- (define-key map "\C-c\M-r" 'python-send-region-and-go)
- (define-key map "\C-c\C-c" 'python-send-buffer)
- (define-key map "\C-c\C-z" 'python-switch-to-python)
- (define-key map "\C-c\C-m" 'python-load-file)
- (define-key map "\C-c\C-l" 'python-load-file) ; a la cmuscheme
- (substitute-key-definition 'complete-symbol 'completion-at-point
- map global-map)
- (define-key map "\C-c\C-i" 'python-find-imports)
- (define-key map "\C-c\C-t" 'python-expand-template)
- (easy-menu-define python-menu map "Python Mode menu"
- `("Python"
- :help "Python-specific Features"
- ["Shift region left" python-shift-left :active mark-active
- :help "Shift by a single indentation step"]
- ["Shift region right" python-shift-right :active mark-active
- :help "Shift by a single indentation step"]
- "-"
- ["Mark block" python-mark-block
- :help "Mark innermost block around point"]
- ["Mark def/class" mark-defun
- :help "Mark innermost definition around point"]
- "-"
- ["Start of block" python-beginning-of-block
- :help "Go to start of innermost definition around point"]
- ["End of block" python-end-of-block
- :help "Go to end of innermost definition around point"]
- ["Start of def/class" beginning-of-defun
- :help "Go to start of innermost definition around point"]
- ["End of def/class" end-of-defun
- :help "Go to end of innermost definition around point"]
- "-"
- ("Templates..."
- :help "Expand templates for compound statements"
- :filter (lambda (&rest junk)
- (abbrev-table-menu python-mode-abbrev-table)))
- "-"
- ["Start interpreter" run-python
- :help "Run `inferior' Python in separate buffer"]
- ["Import/reload file" python-load-file
- :help "Load into inferior Python session"]
- ["Eval buffer" python-send-buffer
- :help "Evaluate buffer en bloc in inferior Python session"]
- ["Eval region" python-send-region :active mark-active
- :help "Evaluate region en bloc in inferior Python session"]
- ["Eval def/class" python-send-defun
- :help "Evaluate current definition in inferior Python session"]
- ["Switch to interpreter" python-switch-to-python
- :help "Switch to inferior Python buffer"]
- ["Set default process" python-set-proc
- :help "Make buffer's inferior process the default"
- :active (buffer-live-p python-buffer)]
- ["Check file" python-check :help "Run pychecker"]
- ["Debugger" pdb :help "Run pdb under GUD"]
- "-"
- ["Help on symbol" python-describe-symbol
- :help "Use pydoc on symbol at point"]
- ["Complete symbol" completion-at-point
- :help "Complete (qualified) symbol before point"]
- ["Find function" python-find-function
- :help "Try to find source definition of function at point"]
- ["Update imports" python-find-imports
- :help "Update list of top-level imports for completion"]))
- map))
-;; Fixme: add toolbar stuff for useful things like symbol help, send
-;; region, at least. (Shouldn't be specific to Python, obviously.)
-;; eric has items including: (un)indent, (un)comment, restart script,
-;; run script, debug script; also things for profiling, unit testing.
+ ((rx
+ ;; Match even number of backslashes.
+ (or (not (any ?\\ ?\' ?\")) point) (* ?\\ ?\\)
+ ;; Match single or triple quotes of any kind.
+ (group (or "\"" "\"\"\"" "'" "'''")))
+ (1 (ignore (python-syntax-stringify))))
+ ((rx
+ ;; Match odd number of backslashes.
+ (or (not (any ?\\)) point) ?\\ (* ?\\ ?\\)
+ ;; Followed by even number of equal quotes.
+ (group (or "\"\"" "\"\"\"\"" "''" "''''")))
+ (1 (ignore (python-syntax-stringify))))))
+
+(defsubst python-syntax-count-quotes (quote-char &optional point limit)
+ "Count number of quotes around point (max is 3).
+QUOTE-CHAR is the quote char to count. Optional argument POINT is
+the point where scan starts (defaults to current point) and LIMIT
+is used to limit the scan."
+ (let ((i 0))
+ (while (and (< i 3)
+ (or (not limit) (< (+ point i) limit))
+ (eq (char-after (+ point i)) quote-char))
+ (incf i))
+ i))
+
+(defun python-syntax-stringify ()
+ "Put `syntax-table' property correctly on single/triple quotes."
+ (let* ((num-quotes
+ (let ((n (length (match-string-no-properties 1))))
+ ;; This corrects the quote count when matching odd number
+ ;; of backslashes followed by even number of quotes.
+ (or (and (= 1 (logand n 1)) n) (1- n))))
+ (ppss (prog2
+ (backward-char num-quotes)
+ (syntax-ppss)
+ (forward-char num-quotes)))
+ (string-start (and (not (nth 4 ppss)) (nth 8 ppss)))
+ (quote-starting-pos (- (point) num-quotes))
+ (quote-ending-pos (point))
+ (num-closing-quotes
+ (and string-start
+ (python-syntax-count-quotes
+ (char-before) string-start quote-starting-pos))))
+ (cond ((and string-start (= num-closing-quotes 0))
+ ;; This set of quotes doesn't match the string starting
+ ;; kind. Do nothing.
+ nil)
+ ((not string-start)
+ ;; This set of quotes delimit the start of a string.
+ (put-text-property quote-starting-pos (1+ quote-starting-pos)
+ 'syntax-table (string-to-syntax "|")))
+ ((= num-quotes num-closing-quotes)
+ ;; This set of quotes delimit the end of a string.
+ (put-text-property (1- quote-ending-pos) quote-ending-pos
+ 'syntax-table (string-to-syntax "|")))
+ ((> num-quotes num-closing-quotes)
+ ;; This may only happen whenever a triple quote is closing
+ ;; a single quoted string. Add string delimiter syntax to
+ ;; all three quotes.
+ (put-text-property quote-starting-pos quote-ending-pos
+ 'syntax-table (string-to-syntax "|"))))))
(defvar python-mode-syntax-table
(let ((table (make-syntax-table)))
;; Give punctuation syntax to ASCII that normally has symbol
;; syntax or has word syntax and isn't a letter.
(let ((symbol (string-to-syntax "_"))
- (sst (standard-syntax-table)))
+ (sst (standard-syntax-table)))
(dotimes (i 128)
- (unless (= i ?_)
- (if (equal symbol (aref sst i))
- (modify-syntax-entry i "." table)))))
+ (unless (= i ?_)
+ (if (equal symbol (aref sst i))
+ (modify-syntax-entry i "." table)))))
(modify-syntax-entry ?$ "." table)
(modify-syntax-entry ?% "." table)
;; exceptions
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?' "\"" table)
(modify-syntax-entry ?` "$" table)
- table))
-\f
-;;;; Utility stuff
-
-(defsubst python-in-string/comment ()
- "Return non-nil if point is in a Python literal (a comment or string)."
- ;; We don't need to save the match data.
- (nth 8 (syntax-ppss)))
-
-(defconst python-space-backslash-table
- (let ((table (copy-syntax-table python-mode-syntax-table)))
- (modify-syntax-entry ?\\ " " table)
table)
- "`python-mode-syntax-table' with backslash given whitespace syntax.")
-
-(defun python-skip-comments/blanks (&optional backward)
- "Skip comments and blank lines.
-BACKWARD non-nil means go backwards, otherwise go forwards.
-Backslash is treated as whitespace so that continued blank lines
-are skipped. Doesn't move out of comments -- should be outside
-or at end of line."
- (let ((arg (if backward
- ;; If we're in a comment (including on the trailing
- ;; newline), forward-comment doesn't move backwards out
- ;; of it. Don't set the syntax table round this bit!
- (let ((syntax (syntax-ppss)))
- (if (nth 4 syntax)
- (goto-char (nth 8 syntax)))
- (- (point-max)))
- (point-max))))
- (with-syntax-table python-space-backslash-table
- (forward-comment arg))))
-
-(defun python-backslash-continuation-line-p ()
- "Non-nil if preceding line ends with backslash that is not in a comment."
- (and (eq ?\\ (char-before (line-end-position 0)))
- (not (syntax-ppss-context (syntax-ppss)))))
-
-(defun python-continuation-line-p ()
- "Return non-nil if current line continues a previous one.
-The criteria are that the previous line ends in a backslash outside
-comments and strings, or that point is within brackets/parens."
- (or (python-backslash-continuation-line-p)
- (let ((depth (syntax-ppss-depth
- (save-excursion ; syntax-ppss with arg changes point
- (syntax-ppss (line-beginning-position))))))
- (or (> depth 0)
- (if (< depth 0) ; Unbalanced brackets -- act locally
- (save-excursion
- (condition-case ()
- (progn (backward-up-list) t) ; actually within brackets
- (error nil))))))))
-
-(defun python-comment-line-p ()
- "Return non-nil if and only if current line has only a comment."
- (save-excursion
- (end-of-line)
- (when (eq 'comment (syntax-ppss-context (syntax-ppss)))
- (back-to-indentation)
- (looking-at (rx (or (syntax comment-start) line-end))))))
+ "Syntax table for Python files.")
-(defun python-blank-line-p ()
- "Return non-nil if and only if current line is blank."
- (save-excursion
- (beginning-of-line)
- (looking-at "\\s-*$")))
-
-(defun python-beginning-of-string ()
- "Go to beginning of string around point.
-Do nothing if not in string."
- (let ((state (syntax-ppss)))
- (when (eq 'string (syntax-ppss-context state))
- (goto-char (nth 8 state)))))
-
-(defun python-open-block-statement-p (&optional bos)
- "Return non-nil if statement at point opens a block.
-BOS non-nil means point is known to be at beginning of statement."
- (save-excursion
- (unless bos (python-beginning-of-statement))
- (looking-at (rx (and (or "if" "else" "elif" "while" "for" "def"
- "class" "try" "except" "finally" "with")
- symbol-end)))))
-
-(defun python-close-block-statement-p (&optional bos)
- "Return non-nil if current line is a statement closing a block.
-BOS non-nil means point is at beginning of statement.
-The criteria are that the line isn't a comment or in string and
- starts with keyword `raise', `break', `continue' or `pass'."
- (save-excursion
- (unless bos (python-beginning-of-statement))
- (back-to-indentation)
- (looking-at (rx (or "return" "raise" "break" "continue" "pass")
- symbol-end))))
+(defvar python-dotty-syntax-table
+ (let ((table (make-syntax-table python-mode-syntax-table)))
+ (modify-syntax-entry ?. "w" table)
+ (modify-syntax-entry ?_ "w" table)
+ table)
+ "Dotty syntax table for Python files.
+It makes underscores and dots word constituent chars.")
-(defun python-outdent-p ()
- "Return non-nil if current line should outdent a level."
- (save-excursion
- (back-to-indentation)
- (and (looking-at (rx (and (or "else" "finally" "except" "elif")
- symbol-end)))
- (not (python-in-string/comment))
- ;; Ensure there's a previous statement and move to it.
- (zerop (python-previous-statement))
- (not (python-close-block-statement-p t))
- ;; Fixme: check this
- (not (python-open-block-statement-p)))))
\f
-;;;; Indentation.
+;;; Indentation
-(defcustom python-indent 4
- "Number of columns for a unit of indentation in Python mode.
-See also `\\[python-guess-indent]'"
+(defcustom python-indent-offset 4
+ "Default indentation offset for Python."
:group 'python
- :type 'integer)
-(put 'python-indent 'safe-local-variable 'integerp)
-
-(defcustom python-guess-indent t
- "Non-nil means Python mode guesses `python-indent' for the buffer."
- :type 'boolean
- :group 'python)
+ :type 'integer
+ :safe 'integerp)
-(defcustom python-indent-string-contents t
- "Non-nil means indent contents of multi-line strings together.
-This means indent them the same as the preceding non-blank line.
-Otherwise preserve their indentation.
-
-This only applies to `doc' strings, i.e. those that form statements;
-the indentation is preserved in others."
- :type '(choice (const :tag "Align with preceding" t)
- (const :tag "Preserve indentation" nil))
- :group 'python)
-
-(defcustom python-honour-comment-indentation nil
- "Non-nil means indent relative to preceding comment line.
-Only do this for comments where the leading comment character is
-followed by space. This doesn't apply to comment lines, which
-are always indented in lines with preceding comments."
+(defcustom python-indent-guess-indent-offset t
+ "Non-nil tells Python mode to guess `python-indent-offset' value."
:type 'boolean
- :group 'python)
-
-(defcustom python-continuation-offset 4
- "Number of columns of additional indentation for continuation lines.
-Continuation lines follow a backslash-terminated line starting a
-statement."
:group 'python
- :type 'integer)
-
+ :safe 'booleanp)
-(defcustom python-pdbtrack-do-tracking-p t
- "*Controls whether the pdbtrack feature is enabled or not.
-
-When non-nil, pdbtrack is enabled in all comint-based buffers,
-e.g. shell interaction buffers and the *Python* buffer.
-
-When using pdb to debug a Python program, pdbtrack notices the
-pdb prompt and presents the line in the source file where the
-program is stopped in a pop-up buffer. It's similar to what
-gud-mode does for debugging C programs with gdb, but without
-having to restart the program."
- :type 'boolean
- :group 'python)
-(make-variable-buffer-local 'python-pdbtrack-do-tracking-p)
-
-(defcustom python-pdbtrack-minor-mode-string " PDB"
- "*Minor-mode sign to be displayed when pdbtrack is active."
- :type 'string
- :group 'python)
-
-;; Add a designator to the minor mode strings
-(or (assq 'python-pdbtrack-is-tracking-p minor-mode-alist)
- (push '(python-pdbtrack-is-tracking-p python-pdbtrack-minor-mode-string)
- minor-mode-alist))
-
-(defcustom python-shell-prompt-alist
- '(("ipython" . "^In \\[[0-9]+\\]: *")
- (t . "^>>> "))
- "Alist of Python input prompts.
-Each element has the form (PROGRAM . REGEXP), where PROGRAM is
-the value of `python-python-command' for the python process and
-REGEXP is a regular expression matching the Python prompt.
-PROGRAM can also be t, which specifies the default when no other
-element matches `python-python-command'."
- :type 'string
- :group 'python
- :version "24.1")
-
-(defcustom python-shell-continuation-prompt-alist
- '(("ipython" . "^ [.][.][.]+: *")
- (t . "^[.][.][.] "))
- "Alist of Python continued-line prompts.
-Each element has the form (PROGRAM . REGEXP), where PROGRAM is
-the value of `python-python-command' for the python process and
-REGEXP is a regular expression matching the Python prompt for
-continued lines.
-PROGRAM can also be t, which specifies the default when no other
-element matches `python-python-command'."
- :type 'string
- :group 'python
- :version "24.1")
+(define-obsolete-variable-alias
+ 'python-indent 'python-indent-offset "24.3")
-(defvar python-pdbtrack-is-tracking-p nil)
+(define-obsolete-variable-alias
+ 'python-guess-indent 'python-indent-guess-indent-offset "24.3")
-(defconst python-pdbtrack-stack-entry-regexp
- "^> \\(.*\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_<>]+\\)()"
- "Regular expression pdbtrack uses to find a stack trace entry.")
+(defvar python-indent-current-level 0
+ "Current indentation level `python-indent-line-function' is using.")
-(defconst python-pdbtrack-input-prompt "\n[(<]*[Ii]?[Pp]db[>)]+ "
- "Regular expression pdbtrack uses to recognize a pdb prompt.")
+(defvar python-indent-levels '(0)
+ "Levels of indentation available for `python-indent-line-function'.")
-(defconst python-pdbtrack-track-range 10000
- "Max number of characters from end of buffer to search for stack entry.")
+(defvar python-indent-dedenters '("else" "elif" "except" "finally")
+ "List of words that should be dedented.
+These make `python-indent-calculate-indentation' subtract the value of
+`python-indent-offset'.")
-(defun python-guess-indent ()
- "Guess step for indentation of current buffer.
-Set `python-indent' locally to the value guessed."
+(defun python-indent-guess-indent-offset ()
+ "Guess and set `python-indent-offset' for the current buffer."
(interactive)
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
- (let (done indent)
- (while (and (not done) (not (eobp)))
- (when (and (re-search-forward (rx ?: (0+ space)
- (or (syntax comment-start)
- line-end))
- nil 'move)
- (python-open-block-statement-p))
- (save-excursion
- (python-beginning-of-statement)
- (let ((initial (current-indentation)))
- (if (zerop (python-next-statement))
- (setq indent (- (current-indentation) initial)))
- (if (and indent (>= indent 2) (<= indent 8)) ; sanity check
- (setq done t))))))
- (when done
- (when (/= indent (default-value 'python-indent))
- (set (make-local-variable 'python-indent) indent)
- (unless (= tab-width python-indent)
- (setq indent-tabs-mode nil)))
- indent)))))
-
-;; Alist of possible indentations and start of statement they would
-;; close. Used in indentation cycling (below).
-(defvar python-indent-list nil
- "Internal use.")
-;; Length of the above
-(defvar python-indent-list-length nil
- "Internal use.")
-;; Current index into the alist.
-(defvar python-indent-index nil
- "Internal use.")
-
-(defun python-calculate-indentation ()
- "Calculate Python indentation for line at point."
- (setq python-indent-list nil
- python-indent-list-length 1)
- (save-excursion
- (beginning-of-line)
- (let ((syntax (syntax-ppss))
- start)
- (cond
- ((eq 'string (syntax-ppss-context syntax)) ; multi-line string
- (if (not python-indent-string-contents)
- (current-indentation)
- ;; Only respect `python-indent-string-contents' in doc
- ;; strings (defined as those which form statements).
- (if (not (save-excursion
- (python-beginning-of-statement)
- (looking-at (rx (or (syntax string-delimiter)
- (syntax string-quote))))))
- (current-indentation)
- ;; Find indentation of preceding non-blank line within string.
- (setq start (nth 8 syntax))
- (forward-line -1)
- (while (and (< start (point)) (looking-at "\\s-*$"))
- (forward-line -1))
- (current-indentation))))
- ((python-continuation-line-p) ; after backslash, or bracketed
- (let ((point (point))
- (open-start (cadr syntax))
- (backslash (python-backslash-continuation-line-p))
- (colon (eq ?: (char-before (1- (line-beginning-position))))))
- (if open-start
- ;; Inside bracketed expression.
- (progn
- (goto-char (1+ open-start))
- ;; Look for first item in list (preceding point) and
- ;; align with it, if found.
- (if (with-syntax-table python-space-backslash-table
- (let ((parse-sexp-ignore-comments t))
- (condition-case ()
- (progn (forward-sexp)
- (backward-sexp)
- (< (point) point))
- (error nil))))
- ;; Extra level if we're backslash-continued or
- ;; following a key.
- (if (or backslash colon)
- (+ python-indent (current-column))
- (current-column))
- ;; Otherwise indent relative to statement start, one
- ;; level per bracketing level.
- (goto-char (1+ open-start))
- (python-beginning-of-statement)
- (+ (current-indentation) (* (car syntax) python-indent))))
- ;; Otherwise backslash-continued.
- (forward-line -1)
- (if (python-continuation-line-p)
- ;; We're past first continuation line. Align with
- ;; previous line.
- (current-indentation)
- ;; First continuation line. Indent one step, with an
- ;; extra one if statement opens a block.
- (python-beginning-of-statement)
- (+ (current-indentation) python-continuation-offset
- (if (python-open-block-statement-p t)
- python-indent
- 0))))))
- ((bobp) 0)
- ;; Fixme: Like python-mode.el; not convinced by this.
- ((looking-at (rx (0+ space) (syntax comment-start)
- (not (any " \t\n")))) ; non-indentable comment
- (current-indentation))
- ((and python-honour-comment-indentation
- ;; Back over whitespace, newlines, non-indentable comments.
- (catch 'done
- (while (cond ((bobp) nil)
- ((not (forward-comment -1))
- nil) ; not at comment start
- ;; Now at start of comment -- trailing one?
- ((/= (current-column) (current-indentation))
- nil)
- ;; Indentable comment, like python-mode.el?
- ((and (looking-at (rx (syntax comment-start)
- (or space line-end)))
- (/= 0 (current-column)))
- (throw 'done (current-column)))
- ;; Else skip it (loop).
- (t))))))
- (t
- (python-indentation-levels)
- ;; Prefer to indent comments with an immediately-following
- ;; statement, e.g.
- ;; ...
- ;; # ...
- ;; def ...
- (when (and (> python-indent-list-length 1)
- (python-comment-line-p))
- (forward-line)
- (unless (python-comment-line-p)
- (let ((elt (assq (current-indentation) python-indent-list)))
- (setq python-indent-list
- (nconc (delete elt python-indent-list)
- (list elt))))))
- (caar (last python-indent-list)))))))
-
-;;;; Cycling through the possible indentations with successive TABs.
-
-;; These don't need to be buffer-local since they're only relevant
-;; during a cycle.
-
-(defun python-initial-text ()
- "Text of line following indentation and ignoring any trailing comment."
- (save-excursion
- (buffer-substring (progn
- (back-to-indentation)
- (point))
- (progn
- (end-of-line)
- (forward-comment -1)
- (point)))))
-
-(defconst python-block-pairs
- '(("else" "if" "elif" "while" "for" "try" "except")
- ("elif" "if" "elif")
- ("except" "try" "except")
- ("finally" "else" "try" "except"))
- "Alist of keyword matches.
-The car of an element is a keyword introducing a statement which
-can close a block opened by a keyword in the cdr.")
-
-(defun python-first-word ()
- "Return first word (actually symbol) on the line."
- (save-excursion
- (back-to-indentation)
- (current-word t)))
-
-(defun python-indentation-levels ()
- "Return a list of possible indentations for this line.
-It is assumed not to be a continuation line or in a multi-line string.
-Includes the default indentation and those which would close all
-enclosing blocks. Elements of the list are actually pairs:
-\(INDENTATION . TEXT), where TEXT is the initial text of the
-corresponding block opening (or nil)."
- (save-excursion
- (let ((initial "")
- levels indent)
- ;; Only one possibility immediately following a block open
- ;; statement, assuming it doesn't have a `suite' on the same line.
- (cond
- ((save-excursion (and (python-previous-statement)
- (python-open-block-statement-p t)
- (setq indent (current-indentation))
- ;; Check we don't have something like:
- ;; if ...: ...
- (if (progn (python-end-of-statement)
- (python-skip-comments/blanks t)
- (eq ?: (char-before)))
- (setq indent (+ python-indent indent)))))
- (push (cons indent initial) levels))
- ;; Only one possibility for comment line immediately following
- ;; another.
- ((save-excursion
- (when (python-comment-line-p)
- (forward-line -1)
- (if (python-comment-line-p)
- (push (cons (current-indentation) initial) levels)))))
- ;; Fixme: Maybe have a case here which indents (only) first
- ;; line after a lambda.
- (t
- (let ((start (car (assoc (python-first-word) python-block-pairs))))
- (python-previous-statement)
- ;; Is this a valid indentation for the line of interest?
- (unless (or (if start ; potentially only outdentable
- ;; Check for things like:
- ;; if ...: ...
- ;; else ...:
- ;; where the second line need not be outdented.
- (not (member (python-first-word)
- (cdr (assoc start
- python-block-pairs)))))
- ;; Not sensible to indent to the same level as
- ;; previous `return' &c.
- (python-close-block-statement-p))
- (push (cons (current-indentation) (python-initial-text))
- levels))
- (while (python-beginning-of-block)
- (when (or (not start)
- (member (python-first-word)
- (cdr (assoc start python-block-pairs))))
- (push (cons (current-indentation) (python-initial-text))
- levels))))))
- (prog1 (or levels (setq levels '((0 . ""))))
- (setq python-indent-list levels
- python-indent-list-length (length python-indent-list))))))
-
-;; This is basically what `python-indent-line' would be if we didn't
-;; do the cycling.
-(defun python-indent-line-1 (&optional leave)
- "Subroutine of `python-indent-line'.
-Does non-repeated indentation. LEAVE non-nil means leave
-indentation if it is valid, i.e. one of the positions returned by
-`python-calculate-indentation'."
- (let ((target (python-calculate-indentation))
- (pos (- (point-max) (point))))
- (if (or (= target (current-indentation))
- ;; Maybe keep a valid indentation.
- (and leave python-indent-list
- (assq (current-indentation) python-indent-list)))
- (if (< (current-column) (current-indentation))
- (back-to-indentation))
+ (let ((block-end))
+ (while (and (not block-end)
+ (re-search-forward
+ (python-rx line-start block-start) nil t))
+ (when (and
+ (not (python-syntax-context-type))
+ (progn
+ (goto-char (line-end-position))
+ (python-util-forward-comment -1)
+ (if (equal (char-before) ?:)
+ t
+ (forward-line 1)
+ (when (python-info-block-continuation-line-p)
+ (while (and (python-info-continuation-line-p)
+ (not (eobp)))
+ (forward-line 1))
+ (python-util-forward-comment -1)
+ (when (equal (char-before) ?:)
+ t)))))
+ (setq block-end (point-marker))))
+ (let ((indentation
+ (when block-end
+ (goto-char block-end)
+ (python-util-forward-comment)
+ (current-indentation))))
+ (if indentation
+ (setq python-indent-offset indentation)
+ (message "Can't guess python-indent-offset, using defaults: %s"
+ python-indent-offset)))))))
+
+(defun python-indent-context ()
+ "Get information on indentation context.
+Context information is returned with a cons with the form:
+ \(STATUS . START)
+
+Where status can be any of the following symbols:
+ * inside-paren: If point in between (), {} or []
+ * inside-string: If point is inside a string
+ * after-backslash: Previous line ends in a backslash
+ * after-beginning-of-block: Point is after beginning of block
+ * after-line: Point is after normal line
+ * no-indent: Point is at beginning of buffer or other special case
+START is the buffer position where the sexp starts."
+ (save-restriction
+ (widen)
+ (let ((ppss (save-excursion (beginning-of-line) (syntax-ppss)))
+ (start))
+ (cons
+ (cond
+ ;; Beginning of buffer
+ ((save-excursion
+ (goto-char (line-beginning-position))
+ (bobp))
+ 'no-indent)
+ ;; Inside a paren
+ ((setq start (python-syntax-context 'paren ppss))
+ 'inside-paren)
+ ;; Inside string
+ ((setq start (python-syntax-context 'string ppss))
+ 'inside-string)
+ ;; After backslash
+ ((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))
+ (- line-beg-pos 2)))))
+ 'after-backslash)
+ ;; After beginning of block
+ ((setq start (save-excursion
+ (when (progn
+ (back-to-indentation)
+ (python-util-forward-comment -1)
+ (equal (char-before) ?:))
+ ;; Move to the first block start that's not in within
+ ;; a string, comment or paren and that's not a
+ ;; continuation line.
+ (while (and (re-search-backward
+ (python-rx block-start) nil t)
+ (or
+ (python-syntax-context-type)
+ (python-info-continuation-line-p))))
+ (when (looking-at (python-rx block-start))
+ (point-marker)))))
+ 'after-beginning-of-block)
+ ;; After normal line
+ ((setq start (save-excursion
+ (back-to-indentation)
+ (python-util-forward-comment -1)
+ (python-nav-beginning-of-statement)
+ (point-marker)))
+ 'after-line)
+ ;; Do not indent
+ (t 'no-indent))
+ start))))
+
+(defun python-indent-calculate-indentation ()
+ "Calculate correct indentation offset for the current line."
+ (let* ((indentation-context (python-indent-context))
+ (context-status (car indentation-context))
+ (context-start (cdr indentation-context)))
+ (save-restriction
+ (widen)
+ (save-excursion
+ (case context-status
+ ('no-indent 0)
+ ;; When point is after beginning of block just add one level
+ ;; of indentation relative to the context-start
+ ('after-beginning-of-block
+ (goto-char context-start)
+ (+ (current-indentation) python-indent-offset))
+ ;; When after a simple line just use previous line
+ ;; indentation, in the case current line starts with a
+ ;; `python-indent-dedenters' de-indent one level.
+ ('after-line
+ (-
+ (save-excursion
+ (goto-char context-start)
+ (current-indentation))
+ (if (progn
+ (back-to-indentation)
+ (looking-at (regexp-opt python-indent-dedenters)))
+ python-indent-offset
+ 0)))
+ ;; When inside of a string, do nothing. just use the current
+ ;; indentation. XXX: perhaps it would be a good idea to
+ ;; invoke standard text indentation here
+ ('inside-string
+ (goto-char context-start)
+ (current-indentation))
+ ;; After backslash we have several possibilities.
+ ('after-backslash
+ (cond
+ ;; Check if current line is a dot continuation. For this
+ ;; the current line must start with a dot and previous
+ ;; line must contain a dot too.
+ ((save-excursion
+ (back-to-indentation)
+ (when (looking-at "\\.")
+ ;; If after moving one line back point is inside a paren it
+ ;; needs to move back until it's not anymore
+ (while (prog2
+ (forward-line -1)
+ (and (not (bobp))
+ (python-syntax-context 'paren))))
+ (goto-char (line-end-position))
+ (while (and (re-search-backward
+ "\\." (line-beginning-position) t)
+ (python-syntax-context-type)))
+ (if (and (looking-at "\\.")
+ (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
+ (current-column)
+ ;; No dot found on previous line, just add another
+ ;; indentation level.
+ (+ (current-indentation) python-indent-offset)))))
+ ;; Check if prev line is a block continuation
+ ((let ((block-continuation-start
+ (python-info-block-continuation-line-p)))
+ (when block-continuation-start
+ ;; If block-continuation-start is set jump to that
+ ;; marker and use first column after the block start
+ ;; as indentation value.
+ (goto-char block-continuation-start)
+ (re-search-forward
+ (python-rx block-start (* space))
+ (line-end-position) t)
+ (current-column))))
+ ;; Check if current line is an assignment continuation
+ ((let ((assignment-continuation-start
+ (python-info-assignment-continuation-line-p)))
+ (when assignment-continuation-start
+ ;; If assignment-continuation is set jump to that
+ ;; marker and use first column after the assignment
+ ;; operator as indentation value.
+ (goto-char assignment-continuation-start)
+ (current-column))))
+ (t
+ (forward-line -1)
+ (goto-char (python-info-beginning-of-backslash))
+ (if (save-excursion
+ (and
+ (forward-line -1)
+ (goto-char
+ (or (python-info-beginning-of-backslash) (point)))
+ (python-info-line-ends-backslash-p)))
+ ;; The two previous lines ended in a backslash so we must
+ ;; respect previous line indentation.
+ (current-indentation)
+ ;; What happens here is that we are dealing with the second
+ ;; line of a backslash continuation, in that case we just going
+ ;; to add one indentation level.
+ (+ (current-indentation) python-indent-offset)))))
+ ;; When inside a paren there's a need to handle nesting
+ ;; correctly
+ ('inside-paren
+ (cond
+ ;; If current line closes the outermost open paren use the
+ ;; current indentation of the context-start line.
+ ((save-excursion
+ (skip-syntax-forward "\s" (line-end-position))
+ (when (and (looking-at (regexp-opt '(")" "]" "}")))
+ (progn
+ (forward-char 1)
+ (not (python-syntax-context 'paren))))
+ (goto-char context-start)
+ (current-indentation))))
+ ;; If open paren is contained on a line by itself add another
+ ;; indentation level, else look for the first word after the
+ ;; opening paren and use it's column position as indentation
+ ;; level.
+ ((let* ((content-starts-in-newline)
+ (indent
+ (save-excursion
+ (if (setq content-starts-in-newline
+ (progn
+ (goto-char context-start)
+ (forward-char)
+ (save-restriction
+ (narrow-to-region
+ (line-beginning-position)
+ (line-end-position))
+ (python-util-forward-comment))
+ (looking-at "$")))
+ (+ (current-indentation) python-indent-offset)
+ (current-column)))))
+ ;; Adjustments
+ (cond
+ ;; If current line closes a nested open paren de-indent one
+ ;; level.
+ ((progn
+ (back-to-indentation)
+ (looking-at (regexp-opt '(")" "]" "}"))))
+ (- indent python-indent-offset))
+ ;; If the line of the opening paren that wraps the current
+ ;; line starts a block add another level of indentation to
+ ;; follow new pep8 recommendation. See: http://ur1.ca/5rojx
+ ((save-excursion
+ (when (and content-starts-in-newline
+ (progn
+ (goto-char context-start)
+ (back-to-indentation)
+ (looking-at (python-rx block-start))))
+ (+ indent python-indent-offset))))
+ (t indent)))))))))))
+
+(defun python-indent-calculate-levels ()
+ "Calculate `python-indent-levels' and reset `python-indent-current-level'."
+ (let* ((indentation (python-indent-calculate-indentation))
+ (remainder (% indentation python-indent-offset))
+ (steps (/ (- indentation remainder) python-indent-offset)))
+ (setq python-indent-levels (list 0))
+ (dotimes (step steps)
+ (push (* python-indent-offset (1+ step)) python-indent-levels))
+ (when (not (eq 0 remainder))
+ (push (+ (* python-indent-offset steps) remainder) python-indent-levels))
+ (setq python-indent-levels (nreverse python-indent-levels))
+ (setq python-indent-current-level (1- (length python-indent-levels)))))
+
+(defun python-indent-toggle-levels ()
+ "Toggle `python-indent-current-level' over `python-indent-levels'."
+ (setq python-indent-current-level (1- python-indent-current-level))
+ (when (< python-indent-current-level 0)
+ (setq python-indent-current-level (1- (length python-indent-levels)))))
+
+(defun python-indent-line (&optional force-toggle)
+ "Internal implementation of `python-indent-line-function'.
+Uses the offset calculated in
+`python-indent-calculate-indentation' and available levels
+indicated by the variable `python-indent-levels' to set the
+current indentation.
+
+When the variable `last-command' is equal to
+`indent-for-tab-command' or FORCE-TOGGLE is non-nil it cycles
+levels indicated in the variable `python-indent-levels' by
+setting the current level in the variable
+`python-indent-current-level'.
+
+When the variable `last-command' is not equal to
+`indent-for-tab-command' and FORCE-TOGGLE is nil it calculates
+possible indentation levels and saves it in the variable
+`python-indent-levels'. Afterwards it sets the variable
+`python-indent-current-level' correctly so offset is equal
+to (`nth' `python-indent-current-level' `python-indent-levels')"
+ (or
+ (and (or (and (eq this-command 'indent-for-tab-command)
+ (eq last-command this-command))
+ force-toggle)
+ (not (equal python-indent-levels '(0)))
+ (or (python-indent-toggle-levels) t))
+ (python-indent-calculate-levels))
+ (let* ((starting-pos (point-marker))
+ (indent-ending-position
+ (+ (line-beginning-position) (current-indentation)))
+ (follow-indentation-p
+ (or (bolp)
+ (and (<= (line-beginning-position) starting-pos)
+ (>= indent-ending-position starting-pos))))
+ (next-indent (nth python-indent-current-level python-indent-levels)))
+ (unless (= next-indent (current-indentation))
(beginning-of-line)
(delete-horizontal-space)
- (indent-to target)
- (if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos))))))
-
-(defun python-indent-line ()
- "Indent current line as Python code.
-When invoked via `indent-for-tab-command', cycle through possible
-indentations for current line. The cycle is broken by a command
-different from `indent-for-tab-command', i.e. successive TABs do
-the cycling."
- (interactive)
- (if (and (eq this-command 'indent-for-tab-command)
- (eq last-command this-command))
- (if (= 1 python-indent-list-length)
- (message "Sole indentation")
- (progn (setq python-indent-index
- (% (1+ python-indent-index) python-indent-list-length))
- (beginning-of-line)
- (delete-horizontal-space)
- (indent-to (car (nth python-indent-index python-indent-list)))
- (if (python-block-end-p)
- (let ((text (cdr (nth python-indent-index
- python-indent-list))))
- (if text
- (message "Closes: %s" text))))))
- (python-indent-line-1)
- (setq python-indent-index (1- python-indent-list-length))))
+ (indent-to next-indent)
+ (goto-char starting-pos))
+ (and follow-indentation-p (back-to-indentation)))
+ (python-info-closing-block-message))
+
+(defun python-indent-line-function ()
+ "`indent-line-function' for Python mode.
+See `python-indent-line' for details."
+ (python-indent-line))
+
+(defun python-indent-dedent-line ()
+ "De-indent current line."
+ (interactive "*")
+ (when (and (not (python-syntax-comment-or-string-p))
+ (<= (point-marker) (save-excursion
+ (back-to-indentation)
+ (point-marker)))
+ (> (current-column) 0))
+ (python-indent-line t)
+ t))
+
+(defun python-indent-dedent-line-backspace (arg)
+ "De-indent current line.
+Argument ARG is passed to `backward-delete-char-untabify' when
+point is not in between the indentation."
+ (interactive "*p")
+ (when (not (python-indent-dedent-line))
+ (backward-delete-char-untabify arg)))
+(put 'python-indent-dedent-line-backspace 'delete-selection 'supersede)
(defun python-indent-region (start end)
- "`indent-region-function' for Python.
-Leaves validly-indented lines alone, i.e. doesn't indent to
-another valid position."
- (save-excursion
- (goto-char end)
- (setq end (point-marker))
- (goto-char start)
- (or (bolp) (forward-line 1))
- (while (< (point) end)
- (or (and (bolp) (eolp))
- (python-indent-line-1 t))
- (forward-line 1))
- (move-marker end nil)))
-
-(defun python-block-end-p ()
- "Non-nil if this is a line in a statement closing a block,
-or a blank line indented to where it would close a block."
- (and (not (python-comment-line-p))
- (or (python-close-block-statement-p t)
- (< (current-indentation)
- (save-excursion
- (python-previous-statement)
- (current-indentation))))))
+ "Indent a python region automagically.
+
+Called from a program, START and END specify the region to indent."
+ (let ((deactivate-mark nil))
+ (save-excursion
+ (goto-char end)
+ (setq end (point-marker))
+ (goto-char start)
+ (or (bolp) (forward-line 1))
+ (while (< (point) end)
+ (or (and (bolp) (eolp))
+ (let (word)
+ (forward-line -1)
+ (back-to-indentation)
+ (setq word (current-word))
+ (forward-line 1)
+ (when word
+ (beginning-of-line)
+ (delete-horizontal-space)
+ (indent-to (python-indent-calculate-indentation)))))
+ (forward-line 1))
+ (move-marker end nil))))
+
+(defun python-indent-shift-left (start end &optional count)
+ "Shift lines contained in region START END by COUNT columns to the left.
+COUNT defaults to `python-indent-offset'. If region isn't
+active, the current line is shifted. The shifted region includes
+the lines in which START and END lie. An error is signaled if
+any lines in the region are indented less than COUNT columns."
+ (interactive
+ (if mark-active
+ (list (region-beginning) (region-end) current-prefix-arg)
+ (list (line-beginning-position) (line-end-position) current-prefix-arg)))
+ (if count
+ (setq count (prefix-numeric-value count))
+ (setq count python-indent-offset))
+ (when (> count 0)
+ (let ((deactivate-mark nil))
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (if (and (< (current-indentation) count)
+ (not (looking-at "[ \t]*$")))
+ (error "Can't shift all lines enough"))
+ (forward-line))
+ (indent-rigidly start end (- count))))))
+
+(add-to-list 'debug-ignored-errors "^Can't shift all lines enough")
+
+(defun python-indent-shift-right (start end &optional count)
+ "Shift lines contained in region START END by COUNT columns to the left.
+COUNT defaults to `python-indent-offset'. If region isn't
+active, the current line is shifted. The shifted region includes
+the lines in which START and END lie."
+ (interactive
+ (if mark-active
+ (list (region-beginning) (region-end) current-prefix-arg)
+ (list (line-beginning-position) (line-end-position) current-prefix-arg)))
+ (let ((deactivate-mark nil))
+ (if count
+ (setq count (prefix-numeric-value count))
+ (setq count python-indent-offset))
+ (indent-rigidly start end count)))
+
+(defun python-indent-electric-colon (arg)
+ "Insert a colon and maybe de-indent the current line.
+With numeric ARG, just insert that many colons. With
+\\[universal-argument], just insert a single colon."
+ (interactive "*P")
+ (self-insert-command (if (not (integerp arg)) 1 arg))
+ (when (and (not arg)
+ (eolp)
+ (not (equal ?: (char-after (- (point-marker) 2))))
+ (not (python-syntax-comment-or-string-p)))
+ (let ((indentation (current-indentation))
+ (calculated-indentation (python-indent-calculate-indentation)))
+ (python-info-closing-block-message)
+ (when (> indentation calculated-indentation)
+ (save-excursion
+ (indent-line-to calculated-indentation)
+ (when (not (python-info-closing-block-message))
+ (indent-line-to indentation)))))))
+(put 'python-indent-electric-colon 'delete-selection t)
+
+(defun python-indent-post-self-insert-function ()
+ "Adjust closing paren line indentation after a char is added.
+This function is intended to be added to the
+`post-self-insert-hook.' If a line renders a paren alone, after
+adding a char before it, the line will be re-indented
+automatically if needed."
+ (when (and (eq (char-before) last-command-event)
+ (not (bolp))
+ (memq (char-after) '(?\) ?\] ?\})))
+ (save-excursion
+ (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-syntax-context 'paren)
+ (let ((indentation (python-indent-calculate-indentation)))
+ (when (< (current-indentation) indentation)
+ (indent-line-to indentation)))))))
+
\f
-;;;; Movement.
-
-;; Fixme: Define {for,back}ward-sexp-function? Maybe skip units like
-;; block, statement, depending on context.
-
-(defun python-beginning-of-defun ()
- "`beginning-of-defun-function' for Python.
-Finds beginning of innermost nested class or method definition.
-Returns the name of the definition found at the end, or nil if
-reached start of buffer."
- (let ((ci (current-indentation))
- (def-re (rx line-start (0+ space) (or "def" "class") (1+ space)
- (group (1+ (or word (syntax symbol))))))
- found lep) ;; def-line
- (if (python-comment-line-p)
- (setq ci most-positive-fixnum))
- (while (and (not (bobp)) (not found))
- ;; Treat bol at beginning of function as outside function so
- ;; that successive C-M-a makes progress backwards.
- ;;(setq def-line (looking-at def-re))
- (unless (bolp) (end-of-line))
- (setq lep (line-end-position))
- (if (and (re-search-backward def-re nil 'move)
- ;; Must be less indented or matching top level, or
- ;; equally indented if we started on a definition line.
- (let ((in (current-indentation)))
- (or (and (zerop ci) (zerop in))
- (= lep (line-end-position)) ; on initial line
- ;; Not sure why it was like this -- fails in case of
- ;; last internal function followed by first
- ;; non-def statement of the main body.
-;; (and def-line (= in ci))
- (= in ci)
- (< in ci)))
- (not (python-in-string/comment)))
- (setq found t)))
+;;; Navigation
+
+(defvar python-nav-beginning-of-defun-regexp
+ (python-rx line-start (* space) defun (+ space) (group symbol-name))
+ "Regexp matching class or function definition.
+The name of the defun should be grouped so it can be retrieved
+via `match-string'.")
+
+(defun python-nav-beginning-of-defun (&optional arg)
+ "Move point to `beginning-of-defun'.
+With positive ARG move search backwards. With negative do the
+same but forward. When ARG is nil or 0 defaults to 1. This is
+the main part of `python-beginning-of-defun-function'. Return
+non-nil if point is moved to `beginning-of-defun'."
+ (when (or (null arg) (= arg 0)) (setq arg 1))
+ (let* ((re-search-fn (if (> arg 0)
+ #'re-search-backward
+ #'re-search-forward))
+ (line-beg-pos (line-beginning-position))
+ (line-content-start (+ line-beg-pos (current-indentation)))
+ (pos (point-marker))
+ (found
+ (progn
+ (when (and (< arg 0)
+ (python-info-looking-at-beginning-of-defun))
+ (end-of-line 1))
+ (while (and (funcall re-search-fn
+ python-nav-beginning-of-defun-regexp nil t)
+ (python-syntax-context-type)))
+ (and (python-info-looking-at-beginning-of-defun)
+ (or (not (= (line-number-at-pos pos)
+ (line-number-at-pos)))
+ (and (>= (point) line-beg-pos)
+ (<= (point) line-content-start)
+ (> pos line-content-start)))))))
+ (if found
+ (or (beginning-of-line 1) t)
+ (and (goto-char pos) nil))))
+
+(defun python-beginning-of-defun-function (&optional arg)
+ "Move point to the beginning of def or class.
+With positive ARG move that number of functions backwards. With
+negative do the same but forward. When ARG is nil or 0 defaults
+to 1. Return non-nil if point is moved to `beginning-of-defun'."
+ (when (or (null arg) (= arg 0)) (setq arg 1))
+ (let ((found))
+ (cond ((and (eq this-command 'mark-defun)
+ (python-info-looking-at-beginning-of-defun)))
+ (t
+ (dotimes (i (if (> arg 0) arg (- arg)))
+ (when (and (python-nav-beginning-of-defun arg)
+ (not found))
+ (setq found t)))))
found))
-(defun python-end-of-defun ()
- "`end-of-defun-function' for Python.
-Finds end of innermost nested class or method definition."
- (let ((orig (point))
- (pattern (rx line-start (0+ space) (or "def" "class") space)))
- ;; Go to start of current block and check whether it's at top
- ;; level. If it is, and not a block start, look forward for
- ;; definition statement.
- (when (python-comment-line-p)
- (end-of-line)
- (forward-comment most-positive-fixnum))
- (if (not (python-open-block-statement-p))
- (python-beginning-of-block))
- (if (zerop (current-indentation))
- (unless (python-open-block-statement-p)
- (while (and (re-search-forward pattern nil 'move)
- (python-in-string/comment))) ; just loop
- (unless (eobp)
- (beginning-of-line)))
- ;; Don't move before top-level statement that would end defun.
- (end-of-line)
- (python-beginning-of-defun))
- ;; If we got to the start of buffer, look forward for
- ;; definition statement.
- (if (and (bobp) (not (looking-at "def\\|class")))
- (while (and (not (eobp))
- (re-search-forward pattern nil 'move)
- (python-in-string/comment)))) ; just loop
- ;; We're at a definition statement (or end-of-buffer).
- (unless (eobp)
- (python-end-of-block)
- ;; Count trailing space in defun (but not trailing comments).
- (skip-syntax-forward " >")
- (unless (eobp) ; e.g. missing final newline
- (beginning-of-line)))
- ;; Catch pathological cases like this, where the beginning-of-defun
- ;; skips to a definition we're not in:
- ;; if ...:
- ;; ...
- ;; else:
- ;; ... # point here
- ;; ...
- ;; def ...
- (if (< (point) orig)
- (goto-char (point-max)))))
-
-(defun python-beginning-of-statement ()
- "Go to start of current statement.
-Accounts for continuation lines, multi-line strings, and
-multi-line bracketed expressions."
- (while
- (if (python-backslash-continuation-line-p)
- (progn (forward-line -1) t)
- (beginning-of-line)
- (or (python-beginning-of-string)
- (python-skip-out))))
- (back-to-indentation))
-
-(defun python-skip-out (&optional forward syntax)
- "Skip out of any nested brackets.
-Skip forward if FORWARD is non-nil, else backward.
-If SYNTAX is non-nil it is the state returned by `syntax-ppss' at point.
-Return non-nil if and only if skipping was done."
- ;; FIXME: Use syntax-ppss-toplevel-pos.
- (let ((depth (syntax-ppss-depth (or syntax (syntax-ppss))))
- (forward (if forward -1 1)))
- (unless (zerop depth)
- (if (> depth 0)
- ;; Skip forward out of nested brackets.
- (condition-case () ; beware invalid syntax
- (progn (backward-up-list (* forward depth)) t)
- (error nil))
- ;; Invalid syntax (too many closed brackets).
- ;; Skip out of as many as possible.
- (let (done)
- (while (condition-case ()
- (progn (backward-up-list forward)
- (setq done t))
- (error nil)))
- done)))))
-
-(defun python-end-of-statement ()
- "Go to the end of the current statement and return point.
-Usually this is the start of the next line, but if this is a
-multi-line statement we need to skip over the continuation lines.
-On a comment line, go to end of line."
- (end-of-line)
- (while (let (comment)
- ;; Move past any enclosing strings and sexps, or stop if
- ;; we're in a comment.
- (while (let ((s (syntax-ppss)))
- (cond ((eq 'comment (syntax-ppss-context s))
- (setq comment t)
- nil)
- ((eq 'string (syntax-ppss-context s))
- ;; Go to start of string and skip it.
- (let ((pos (point)))
- (goto-char (nth 8 s))
- (condition-case () ; beware invalid syntax
- (progn (forward-sexp) t)
- ;; If there's a mismatched string, make sure
- ;; we still overall move *forward*.
- (error (goto-char pos) (end-of-line)))))
- ((python-skip-out t s))))
- (end-of-line))
- (and (not comment)
- (not (eobp))
- (eq ?\\ (char-before)))) ; Line continued?
- (end-of-line 2)) ; Try next line.
- (point))
-
-(defun python-previous-statement (&optional count)
- "Go to start of previous statement.
-With argument COUNT, do it COUNT times. Stop at beginning of buffer.
-Return count of statements left to move."
- (interactive "p")
- (unless count (setq count 1))
- (if (< count 0)
- (python-next-statement (- count))
- (python-beginning-of-statement)
- (while (and (> count 0) (not (bobp)))
- (python-skip-comments/blanks t)
- (python-beginning-of-statement)
- (unless (bobp) (setq count (1- count))))
- count))
-
-(defun python-next-statement (&optional count)
- "Go to start of next statement.
-With argument COUNT, do it COUNT times. Stop at end of buffer.
-Return count of statements left to move."
- (interactive "p")
- (unless count (setq count 1))
- (if (< count 0)
- (python-previous-statement (- count))
- (beginning-of-line)
- (let (bogus)
- (while (and (> count 0) (not (eobp)) (not bogus))
- (python-end-of-statement)
- (python-skip-comments/blanks)
- (if (eq 'string (syntax-ppss-context (syntax-ppss)))
- (setq bogus t)
- (unless (eobp)
- (setq count (1- count))))))
- count))
-
-(defun python-beginning-of-block (&optional arg)
- "Go to start of current block.
-With numeric arg, do it that many times. If ARG is negative, call
-`python-end-of-block' instead.
-If point is on the first line of a block, use its outer block.
-If current statement is in column zero, don't move and return nil.
-Otherwise return non-nil."
- (interactive "p")
- (unless arg (setq arg 1))
- (cond
- ((zerop arg))
- ((< arg 0) (python-end-of-block (- arg)))
- (t
- (let ((point (point)))
- (if (or (python-comment-line-p)
- (python-blank-line-p))
- (python-skip-comments/blanks t))
- (python-beginning-of-statement)
- (let ((ci (current-indentation)))
- (if (zerop ci)
- (not (goto-char point)) ; return nil
- ;; Look upwards for less indented statement.
- (if (catch 'done
-;;; This is slower than the below.
-;;; (while (zerop (python-previous-statement))
-;;; (when (and (< (current-indentation) ci)
-;;; (python-open-block-statement-p t))
-;;; (beginning-of-line)
-;;; (throw 'done t)))
- (while (and (zerop (forward-line -1)))
- (when (and (< (current-indentation) ci)
- (not (python-comment-line-p))
- ;; Move to beginning to save effort in case
- ;; this is in string.
- (progn (python-beginning-of-statement) t)
- (python-open-block-statement-p t))
- (beginning-of-line)
- (throw 'done t)))
- (not (goto-char point))) ; Failed -- return nil
- (python-beginning-of-block (1- arg)))))))))
-
-(defun python-end-of-block (&optional arg)
- "Go to end of current block.
-With numeric arg, do it that many times. If ARG is negative,
-call `python-beginning-of-block' instead.
-If current statement is in column zero and doesn't open a block,
-don't move and return nil. Otherwise return t."
- (interactive "p")
- (unless arg (setq arg 1))
- (if (< arg 0)
- (python-beginning-of-block (- arg))
- (while (and (> arg 0)
- (let* ((point (point))
- (_ (if (python-comment-line-p)
- (python-skip-comments/blanks t)))
- (ci (current-indentation))
- (open (python-open-block-statement-p)))
- (if (and (zerop ci) (not open))
- (not (goto-char point))
- (catch 'done
- (while (zerop (python-next-statement))
- (when (or (and open (<= (current-indentation) ci))
- (< (current-indentation) ci))
- (python-skip-comments/blanks t)
- (beginning-of-line 2)
- (throw 'done t)))))))
+(defun python-end-of-defun-function ()
+ "Move point to the end of def or class.
+Returns nil if point is not in a def or class."
+ (interactive)
+ (let ((beg-defun-indent))
+ (when (or (python-info-looking-at-beginning-of-defun)
+ (python-beginning-of-defun-function 1)
+ (python-beginning-of-defun-function -1))
+ (setq beg-defun-indent (current-indentation))
+ (forward-line 1)
+ ;; Go as forward as possible
+ (while (and (or
+ (python-nav-beginning-of-defun -1)
+ (and (goto-char (point-max)) nil))
+ (> (current-indentation) beg-defun-indent)))
+ (beginning-of-line 1)
+ ;; Go as backwards as possible
+ (while (and (forward-line -1)
+ (not (bobp))
+ (or (not (current-word))
+ (equal (char-after (+ (point) (current-indentation))) ?#)
+ (<= (current-indentation) beg-defun-indent)
+ (looking-at (python-rx decorator))
+ (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-syntax-context-type)))
+ (when (memq context-type '(paren string))
+ ;; Slow but safe.
+ (while (and (not (eobp))
+ (python-syntax-context-type))
+ (forward-line 1)))))))
+
+(defun python-nav-beginning-of-statement ()
+ "Move to start of current statement."
+ (interactive "^")
+ (while (and (or (back-to-indentation) t)
+ (not (bobp))
+ (when (or
+ (save-excursion
+ (forward-line -1)
+ (python-info-line-ends-backslash-p))
+ (python-syntax-context 'string)
+ (python-syntax-context 'paren))
+ (forward-line -1)))))
+
+(defun python-nav-end-of-statement ()
+ "Move to end of current statement."
+ (interactive "^")
+ (while (and (goto-char (line-end-position))
+ (not (eobp))
+ (when (or
+ (python-info-line-ends-backslash-p)
+ (python-syntax-context 'string)
+ (python-syntax-context 'paren))
+ (forward-line 1)))))
+
+(defun python-nav-backward-statement (&optional arg)
+ "Move backward to previous statement.
+With ARG, repeat. See `python-nav-forward-statement'."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (python-nav-forward-statement (- arg)))
+
+(defun python-nav-forward-statement (&optional arg)
+ "Move forward to next statement.
+With ARG, repeat. With negative argument, move ARG times
+backward to previous statement."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (while (> arg 0)
+ (python-nav-end-of-statement)
+ (python-util-forward-comment)
+ (python-nav-beginning-of-statement)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (python-nav-beginning-of-statement)
+ (python-util-forward-comment -1)
+ (python-nav-beginning-of-statement)
+ (setq arg (1+ arg))))
+
+(defun python-nav-beginning-of-block ()
+ "Move to start of current block."
+ (interactive "^")
+ (let ((starting-pos (point))
+ (block-regexp (python-rx
+ line-start (* whitespace) block-start)))
+ (if (progn
+ (python-nav-beginning-of-statement)
+ (looking-at (python-rx block-start)))
+ (point-marker)
+ ;; Go to first line beginning a statement
+ (while (and (not (bobp))
+ (or (and (python-nav-beginning-of-statement) nil)
+ (python-info-current-line-comment-p)
+ (python-info-current-line-empty-p)))
+ (forward-line -1))
+ (let ((block-matching-indent
+ (- (current-indentation) python-indent-offset)))
+ (while
+ (and (python-nav-backward-block)
+ (> (current-indentation) block-matching-indent)))
+ (if (and (looking-at (python-rx block-start))
+ (= (current-indentation) block-matching-indent))
+ (point-marker)
+ (and (goto-char starting-pos) nil))))))
+
+(defun python-nav-end-of-block ()
+ "Move to end of current block."
+ (interactive "^")
+ (when (python-nav-beginning-of-block)
+ (let ((block-indentation (current-indentation)))
+ (python-nav-end-of-statement)
+ (while (and (forward-line 1)
+ (not (eobp))
+ (or (and (> (current-indentation) block-indentation)
+ (or (python-nav-end-of-statement) t))
+ (python-info-current-line-comment-p)
+ (python-info-current-line-empty-p))))
+ (python-util-forward-comment -1)
+ (point-marker))))
+
+(defun python-nav-backward-block (&optional arg)
+ "Move backward to previous block of code.
+With ARG, repeat. See `python-nav-forward-block'."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (python-nav-forward-block (- arg)))
+
+(defun python-nav-forward-block (&optional arg)
+ "Move forward to next block of code.
+With ARG, repeat. With negative argument, move ARG times
+backward to previous block."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (let ((block-start-regexp
+ (python-rx line-start (* whitespace) block-start))
+ (starting-pos (point)))
+ (while (> arg 0)
+ (python-nav-end-of-statement)
+ (while (and
+ (re-search-forward block-start-regexp nil t)
+ (python-syntax-context-type)))
(setq arg (1- arg)))
- (zerop arg)))
+ (while (< arg 0)
+ (python-nav-beginning-of-statement)
+ (while (and
+ (re-search-backward block-start-regexp nil t)
+ (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-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)
+ (python-nav--forward-sexp)
+ (setq arg (1- arg)))
+ (while (< arg 0)
+ (python-nav--backward-sexp)
+ (setq arg (1+ arg))))
-(defvar python-which-func-length-limit 40
- "Non-strict length limit for `python-which-func' output.")
+\f
+;;; Shell integration
-(defun python-which-func ()
- (let ((function-name (python-current-defun python-which-func-length-limit)))
- (set-text-properties 0 (length function-name) nil function-name)
- function-name))
+(defcustom python-shell-buffer-name "Python"
+ "Default buffer name for Python interpreter."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
-\f
-;;;; Imenu.
-
-;; For possibly speeding this up, here's the top of the ELP profile
-;; for rescanning pydoc.py (2.2k lines, 90kb):
-;; Function Name Call Count Elapsed Time Average Time
-;; ==================================== ========== ============= ============
-;; python-imenu-create-index 156 2.430906 0.0155827307
-;; python-end-of-defun 155 1.2718260000 0.0082053290
-;; python-end-of-block 155 1.1898689999 0.0076765741
-;; python-next-statement 2970 1.024717 0.0003450225
-;; python-end-of-statement 2970 0.4332190000 0.0001458649
-;; python-beginning-of-defun 265 0.0918479999 0.0003465962
-;; python-skip-comments/blanks 3125 0.0753319999 2.410...e-05
-
-(defvar python-recursing)
-(defun python-imenu-create-index ()
- "`imenu-create-index-function' for Python.
-
-Makes nested Imenu menus from nested `class' and `def' statements.
-The nested menus are headed by an item referencing the outer
-definition; it has a space prepended to the name so that it sorts
-first with `imenu--sort-by-name' (though, unfortunately, sub-menus
-precede it)."
- (unless (boundp 'python-recursing) ; dynamically bound below
- ;; Normal call from Imenu.
- (goto-char (point-min))
- ;; Without this, we can get an infloop if the buffer isn't all
- ;; fontified. I guess this is really a bug in syntax.el. OTOH,
- ;; _with_ this, imenu doesn't immediately work; I can't figure out
- ;; what's going on, but it must be something to do with timers in
- ;; font-lock.
- ;; This can't be right, especially not when jit-lock is not used. --Stef
- ;; (unless (get-text-property (1- (point-max)) 'fontified)
- ;; (font-lock-fontify-region (point-min) (point-max)))
- )
- (let (index-alist) ; accumulated value to return
- (while (re-search-forward
- (rx line-start (0+ space) ; leading space
- (or (group "def") (group "class")) ; type
- (1+ space) (group (1+ (or word ?_)))) ; name
- nil t)
- (unless (python-in-string/comment)
- (let ((pos (match-beginning 0))
- (name (match-string-no-properties 3)))
- (if (match-beginning 2) ; def or class?
- (setq name (concat "class " name)))
- (save-restriction
- (narrow-to-defun)
- (let* ((python-recursing t)
- (sublist (python-imenu-create-index)))
- (if sublist
- (progn (push (cons (concat " " name) pos) sublist)
- (push (cons name sublist) index-alist))
- (push (cons name pos) index-alist)))))))
- (unless (boundp 'python-recursing)
- ;; Look for module variables.
- (let (vars)
- (goto-char (point-min))
- (while (re-search-forward
- (rx line-start (group (1+ (or word ?_))) (0+ space) "=")
- nil t)
- (unless (python-in-string/comment)
- (push (cons (match-string 1) (match-beginning 1))
- vars)))
- (setq index-alist (nreverse index-alist))
- (if vars
- (push (cons "Module variables"
- (nreverse vars))
- index-alist))))
- index-alist))
-\f
-;;;; `Electric' commands.
+(defcustom python-shell-interpreter "python"
+ "Default Python interpreter for shell."
+ :type 'string
+ :group 'python)
-(defun python-electric-colon (arg)
- "Insert a colon and maybe outdent the line if it is a statement like `else'.
-With numeric ARG, just insert that many colons. With \\[universal-argument],
-just insert a single colon."
- (interactive "*P")
- (self-insert-command (if (not (integerp arg)) 1 arg))
- (and (not arg)
- (eolp)
- (python-outdent-p)
- (not (python-in-string/comment))
- (> (current-indentation) (python-calculate-indentation))
- (python-indent-line))) ; OK, do it
-(put 'python-electric-colon 'delete-selection t)
-
-(defun python-backspace (arg)
- "Maybe delete a level of indentation on the current line.
-Do so if point is at the end of the line's indentation outside
-strings and comments.
-Otherwise just call `backward-delete-char-untabify'.
-Repeat ARG times."
- (interactive "*p")
- (if (or (/= (current-indentation) (current-column))
- (bolp)
- (python-continuation-line-p)
- (python-in-string/comment))
- (backward-delete-char-untabify arg)
- ;; Look for the largest valid indentation which is smaller than
- ;; the current indentation.
- (let ((indent 0)
- (ci (current-indentation))
- (indents (python-indentation-levels))
- initial)
- (dolist (x indents)
- (if (< (car x) ci)
- (setq indent (max indent (car x)))))
- (setq initial (cdr (assq indent indents)))
- (if (> (length initial) 0)
- (message "Closes %s" initial))
- (delete-horizontal-space)
- (indent-to indent))))
-(put 'python-backspace 'delete-selection 'supersede)
-\f
-;;;; pychecker
+(defcustom python-shell-internal-buffer-name "Python Internal"
+ "Default buffer name for the Internal Python interpreter."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
-(defcustom python-check-command "pychecker --stdlib"
- "Command used to check a Python file."
+(defcustom python-shell-interpreter-args "-i"
+ "Default arguments for the Python interpreter."
:type 'string
:group 'python)
-(defvar python-saved-check-command nil
- "Internal use.")
+(defcustom python-shell-prompt-regexp ">>> "
+ "Regular Expression matching top\-level input prompt of python shell.
+It should not contain a caret (^) at the beginning."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
-;; After `sgml-validate-command'.
-(defun python-check (command)
- "Check a Python file (default current buffer's file).
-Runs COMMAND, a shell command, as if by `compile'.
-See `python-check-command' for the default."
- (interactive
- (list (read-string "Checker command: "
- (or python-saved-check-command
- (concat python-check-command " "
- (let ((name (buffer-file-name)))
- (if name
- (file-name-nondirectory name))))))))
- (set (make-local-variable 'python-saved-check-command) command)
- (require 'compile) ;To define compilation-* variables.
- (save-some-buffers (not compilation-ask-about-save) nil)
- (let ((compilation-error-regexp-alist
- (cons '("(\\([^,]+\\), line \\([0-9]+\\))" 1 2)
- compilation-error-regexp-alist)))
- (compilation-start command)))
-\f
-;;;; Inferior mode stuff (following cmuscheme).
+(defcustom python-shell-prompt-block-regexp "[.][.][.] "
+ "Regular Expression matching block input prompt of python shell.
+It should not contain a caret (^) at the beginning."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
+
+(defcustom python-shell-prompt-output-regexp ""
+ "Regular Expression matching output prompt of python shell.
+It should not contain a caret (^) at the beginning."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
-(defcustom python-python-command "python"
- "Shell command to run Python interpreter.
-Any arguments can't contain whitespace."
+(defcustom python-shell-prompt-pdb-regexp "[(<]*[Ii]?[Pp]db[>)]+ "
+ "Regular Expression matching pdb input prompt of python shell.
+It should not contain a caret (^) at the beginning."
+ :type 'string
:group 'python
- :type 'string)
+ :safe 'stringp)
-(defcustom python-jython-command "jython"
- "Shell command to run Jython interpreter.
-Any arguments can't contain whitespace."
+(defcustom python-shell-enable-font-lock t
+ "Should syntax highlighting be enabled in the python shell buffer?
+Restart the python shell after changing this variable for it to take effect."
+ :type 'boolean
:group 'python
- :type 'string)
-
-(defvar python-command python-python-command
- "Actual command used to run Python.
-May be `python-python-command' or `python-jython-command', possibly
-modified by the user. Additional arguments are added when the command
-is used by `run-python' et al.")
-
-(defvar python-buffer nil
- "*The current Python process buffer.
-
-Commands that send text from source buffers to Python processes have
-to choose a process to send to. This is determined by buffer-local
-value of `python-buffer'. If its value in the current buffer,
-i.e. both any local value and the default one, is nil, `run-python'
-and commands that send to the Python process will start a new process.
-
-Whenever \\[run-python] starts a new process, it resets the default
-value of `python-buffer' to be the new process's buffer and sets the
-buffer-local value similarly if the current buffer is in Python mode
-or Inferior Python mode, so that source buffer stays associated with a
-specific sub-process.
-
-Use \\[python-set-proc] to set the default value from a buffer with a
-local value.")
-(make-variable-buffer-local 'python-buffer)
-
-(defconst python-compilation-regexp-alist
- ;; FIXME: maybe these should move to compilation-error-regexp-alist-alist.
- ;; The first already is (for CAML), but the second isn't. Anyhow,
- ;; these are specific to the inferior buffer. -- fx
+ :safe 'booleanp)
+
+(defcustom python-shell-process-environment nil
+ "List of environment variables for Python shell.
+This variable follows the same rules as `process-environment'
+since it merges with it before the process creation routines are
+called. When this variable is nil, the Python shell is run with
+the default `process-environment'."
+ :type '(repeat string)
+ :group 'python
+ :safe 'listp)
+
+(defcustom python-shell-extra-pythonpaths nil
+ "List of extra pythonpaths for Python shell.
+The values of this variable are added to the existing value of
+PYTHONPATH in the `process-environment' variable."
+ :type '(repeat string)
+ :group 'python
+ :safe 'listp)
+
+(defcustom python-shell-exec-path nil
+ "List of path to search for binaries.
+This variable follows the same rules as `exec-path' since it
+merges with it before the process creation routines are called.
+When this variable is nil, the Python shell is run with the
+default `exec-path'."
+ :type '(repeat string)
+ :group 'python
+ :safe 'listp)
+
+(defcustom python-shell-virtualenv-path nil
+ "Path to virtualenv root.
+This variable, when set to a string, makes the values stored in
+`python-shell-process-environment' and `python-shell-exec-path'
+to be modified properly so shells are started with the specified
+virtualenv."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
+
+(defcustom python-shell-setup-codes '(python-shell-completion-setup-code
+ python-ffap-setup-code
+ python-eldoc-setup-code)
+ "List of code run by `python-shell-send-setup-codes'."
+ :type '(repeat symbol)
+ :group 'python
+ :safe 'listp)
+
+(defcustom python-shell-compilation-regexp-alist
`((,(rx line-start (1+ (any " \t")) "File \""
- (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c
- "\", line " (group (1+ digit)))
+ (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c
+ "\", line " (group (1+ digit)))
1 2)
(,(rx " in file " (group (1+ not-newline)) " on line "
- (group (1+ digit)))
+ (group (1+ digit)))
1 2)
- ;; pdb stack trace
(,(rx line-start "> " (group (1+ (not (any "(\"<"))))
- "(" (group (1+ digit)) ")" (1+ (not (any "("))) "()")
+ "(" (group (1+ digit)) ")" (1+ (not (any "("))) "()")
1 2))
- "`compilation-error-regexp-alist' for inferior Python.")
+ "`compilation-error-regexp-alist' for inferior Python."
+ :type '(alist string)
+ :group 'python)
+
+(defun python-shell-get-process-name (dedicated)
+ "Calculate the appropriate process name for inferior Python process.
+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'."
+ (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))))
+ process-name))
+
+(defun python-shell-internal-get-process-name ()
+ "Calculate the appropriate process name for Internal Python process.
+The name is calculated from `python-shell-global-buffer-name' and
+a hash of all relevant global shell settings in order to ensure
+uniqueness for different types of configurations."
+ (format "%s [%s]"
+ python-shell-internal-buffer-name
+ (md5
+ (concat
+ (python-shell-parse-command)
+ python-shell-prompt-regexp
+ python-shell-prompt-block-regexp
+ python-shell-prompt-output-regexp
+ (mapconcat #'symbol-value python-shell-setup-codes "")
+ (mapconcat #'identity python-shell-process-environment "")
+ (mapconcat #'identity python-shell-extra-pythonpaths "")
+ (mapconcat #'identity python-shell-exec-path "")
+ (or python-shell-virtualenv-path "")
+ (mapconcat #'identity python-shell-exec-path "")))))
+
+(defun python-shell-parse-command ()
+ "Calculate the string used to execute the inferior Python process."
+ (format "%s %s" python-shell-interpreter python-shell-interpreter-args))
+
+(defun python-shell-calculate-process-environment ()
+ "Calculate process environment given `python-shell-virtualenv-path'."
+ (let ((process-environment (append
+ python-shell-process-environment
+ process-environment nil))
+ (virtualenv (if python-shell-virtualenv-path
+ (directory-file-name python-shell-virtualenv-path)
+ nil)))
+ (when python-shell-extra-pythonpaths
+ (setenv "PYTHONPATH"
+ (format "%s%s%s"
+ (mapconcat 'identity
+ python-shell-extra-pythonpaths
+ path-separator)
+ path-separator
+ (or (getenv "PYTHONPATH") ""))))
+ (if (not virtualenv)
+ process-environment
+ (setenv "PYTHONHOME" nil)
+ (setenv "PATH" (format "%s/bin%s%s"
+ virtualenv path-separator
+ (or (getenv "PATH") "")))
+ (setenv "VIRTUAL_ENV" virtualenv))
+ process-environment))
+
+(defun python-shell-calculate-exec-path ()
+ "Calculate exec path given `python-shell-virtualenv-path'."
+ (let ((path (append python-shell-exec-path
+ exec-path nil)))
+ (if (not python-shell-virtualenv-path)
+ path
+ (cons (format "%s/bin"
+ (directory-file-name python-shell-virtualenv-path))
+ path))))
+
+(defun python-comint-output-filter-function (output)
+ "Hook run after content is put into comint buffer.
+OUTPUT is a string with the contents of the buffer."
+ (ansi-color-filter-apply output))
-(defvar inferior-python-mode-map
- (let ((map (make-sparse-keymap)))
- ;; This will inherit from comint-mode-map.
- (define-key map "\C-c\C-l" 'python-load-file)
- (define-key map "\C-c\C-v" 'python-check)
- ;; Note that we _can_ still use these commands which send to the
- ;; Python process even at the prompt if we have a normal prompt,
- ;; i.e. '>>> ' and not '... '. See the comment before
- ;; python-send-region. Fixme: uncomment these if we address that.
-
- ;; (define-key map [(meta ?\t)] 'python-complete-symbol)
- ;; (define-key map "\C-c\C-f" 'python-describe-symbol)
- map))
-
-(defvar inferior-python-mode-syntax-table
- (let ((st (make-syntax-table python-mode-syntax-table)))
- ;; Don't get confused by apostrophes in the process's output (e.g. if
- ;; you execute "help(os)").
- (modify-syntax-entry ?\' "." st)
- ;; Maybe we should do the same for double quotes?
- ;; (modify-syntax-entry ?\" "." st)
- st))
-
-;; Autoloaded.
-(declare-function compilation-shell-minor-mode "compile" (&optional arg))
-
-(defvar python--prompt-regexp nil)
-
-(defun python--set-prompt-regexp ()
- (let ((prompt (cdr-safe (or (assoc python-python-command
- python-shell-prompt-alist)
- (assq t python-shell-prompt-alist))))
- (cprompt (cdr-safe (or (assoc python-python-command
- python-shell-continuation-prompt-alist)
- (assq t python-shell-continuation-prompt-alist)))))
- (set (make-local-variable 'comint-prompt-regexp)
- (concat "\\("
- (mapconcat 'identity
- (delq nil (list prompt cprompt "^([Pp]db) "))
- "\\|")
- "\\)"))
- (set (make-local-variable 'python--prompt-regexp) prompt)))
-
-;; Fixme: This should inherit some stuff from `python-mode', but I'm
-;; not sure how much: at least some keybindings, like C-c C-f;
-;; syntax?; font-locking, e.g. for triple-quoted strings?
(define-derived-mode inferior-python-mode comint-mode "Inferior Python"
- "Major mode for interacting with an inferior Python process.
-A Python process can be started with \\[run-python].
-
-Hooks `comint-mode-hook' and `inferior-python-mode-hook' are run in
-that order.
-
-You can send text to the inferior Python process from other buffers
-containing Python source.
- * \\[python-switch-to-python] switches the current buffer to the Python
- process buffer.
- * \\[python-send-region] sends the current region to the Python process.
- * \\[python-send-region-and-go] switches to the Python process buffer
- after sending the text.
-For running multiple processes in multiple buffers, see `run-python' and
-`python-buffer'.
-
-\\{inferior-python-mode-map}"
- :group 'python
+ "Major mode for Python inferior process.
+Runs a Python interpreter as a subprocess of Emacs, with Python
+I/O through an Emacs buffer. Variables
+`python-shell-interpreter' and `python-shell-interpreter-args'
+controls which Python interpreter is run. Variables
+`python-shell-prompt-regexp',
+`python-shell-prompt-output-regexp',
+`python-shell-prompt-block-regexp',
+`python-shell-enable-font-lock',
+`python-shell-completion-setup-code',
+`python-shell-completion-string-code',
+`python-shell-completion-module-string-code',
+`python-eldoc-setup-code', `python-eldoc-string-code',
+`python-ffap-setup-code' and `python-ffap-string-code' can
+customize this mode for different Python interpreters.
+
+You can also add additional setup code to be run at
+initialization of the interpreter via `python-shell-setup-codes'
+variable.
+
+\(Type \\[describe-mode] in the process buffer for a list of commands.)"
+ (set-syntax-table python-mode-syntax-table)
(setq mode-line-process '(":%s"))
- (set (make-local-variable 'comint-input-filter) 'python-input-filter)
- (add-hook 'comint-preoutput-filter-functions #'python-preoutput-filter
- nil t)
- (python--set-prompt-regexp)
+ (setq comint-prompt-regexp (format "^\\(?:%s\\|%s\\|%s\\)"
+ python-shell-prompt-regexp
+ python-shell-prompt-block-regexp
+ python-shell-prompt-pdb-regexp))
+ (make-local-variable 'comint-output-filter-functions)
+ (add-hook 'comint-output-filter-functions
+ 'python-comint-output-filter-function)
+ (add-hook 'comint-output-filter-functions
+ 'python-pdbtrack-comint-output-filter-function)
(set (make-local-variable 'compilation-error-regexp-alist)
- python-compilation-regexp-alist)
+ python-shell-compilation-regexp-alist)
+ (define-key inferior-python-mode-map [remap complete-symbol]
+ 'completion-at-point)
+ (add-hook 'completion-at-point-functions
+ 'python-shell-completion-complete-at-point nil 'local)
+ (add-to-list (make-local-variable 'comint-dynamic-complete-functions)
+ '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))
+ (set (make-local-variable 'syntax-propertize-function)
+ python-syntax-propertize-function))
(compilation-shell-minor-mode 1))
-(defcustom inferior-python-filter-regexp "\\`\\s-*\\S-?\\S-?\\s-*\\'"
- "Input matching this regexp is not saved on the history list.
-Default ignores all inputs of 0, 1, or 2 non-blank characters."
- :type 'regexp
- :group 'python)
-
-(defcustom python-remove-cwd-from-path t
- "Whether to allow loading of Python modules from the current directory.
-If this is non-nil, Emacs removes '' from sys.path when starting
-an inferior Python process. This is the default, for security
-reasons, as it is easy for the Python process to be started
-without the user's realization (e.g. to perform completion)."
- :type 'boolean
- :group 'python
- :version "23.3")
-
-(defun python-input-filter (str)
- "`comint-input-filter' function for inferior Python.
-Don't save anything for STR matching `inferior-python-filter-regexp'."
- (not (string-match inferior-python-filter-regexp str)))
-
-;; Fixme: Loses with quoted whitespace.
-(defun python-args-to-list (string)
- (let ((where (string-match "[ \t]" string)))
- (cond ((null where) (list string))
- ((not (= where 0))
- (cons (substring string 0 where)
- (python-args-to-list (substring string (+ 1 where)))))
- (t (let ((pos (string-match "[^ \t]" string)))
- (if pos (python-args-to-list (substring string pos))))))))
-
-(defvar python-preoutput-result nil
- "Data from last `_emacs_out' line seen by the preoutput filter.")
-
-(defvar python-preoutput-continuation nil
- "If non-nil, funcall this when `python-preoutput-filter' sees `_emacs_ok'.")
-
-(defvar python-preoutput-leftover nil)
-(defvar python-preoutput-skip-next-prompt nil)
-
-;; Using this stops us getting lines in the buffer like
-;; >>> ... ... >>>
-;; Also look for (and delete) an `_emacs_ok' string and call
-;; `python-preoutput-continuation' if we get it.
-(defun python-preoutput-filter (s)
- "`comint-preoutput-filter-functions' function: ignore prompts not at bol."
- (when python-preoutput-leftover
- (setq s (concat python-preoutput-leftover s))
- (setq python-preoutput-leftover nil))
- (let ((start 0)
- (res ""))
- ;; First process whole lines.
- (while (string-match "\n" s start)
- (let ((line (substring s start (setq start (match-end 0)))))
- ;; Skip prompt if needed.
- (when (and python-preoutput-skip-next-prompt
- (string-match comint-prompt-regexp line))
- (setq python-preoutput-skip-next-prompt nil)
- (setq line (substring line (match-end 0))))
- ;; Recognize special _emacs_out lines.
- (if (and (string-match "\\`_emacs_out \\(.*\\)\n\\'" line)
- (local-variable-p 'python-preoutput-result))
- (progn
- (setq python-preoutput-result (match-string 1 line))
- (set (make-local-variable 'python-preoutput-skip-next-prompt) t))
- (setq res (concat res line)))))
- ;; Then process the remaining partial line.
- (unless (zerop start) (setq s (substring s start)))
- (cond ((and (string-match comint-prompt-regexp s)
- ;; Drop this prompt if it follows an _emacs_out...
- (or python-preoutput-skip-next-prompt
- ;; ... or if it's not gonna be inserted at BOL.
- ;; Maybe we could be more selective here.
- (if (zerop (length res))
- (not (bolp))
- (string-match ".\\'" res))))
- ;; The need for this seems to be system-dependent:
- ;; What is this all about, exactly? --Stef
- ;; (if (and (eq ?. (aref s 0)))
- ;; (accept-process-output (get-buffer-process (current-buffer)) 1))
- (setq python-preoutput-skip-next-prompt nil)
- res)
- ((let ((end (min (length "_emacs_out ") (length s))))
- (eq t (compare-strings s nil end "_emacs_out " nil end)))
- ;; The leftover string is a prefix of _emacs_out so we don't know
- ;; yet whether it's an _emacs_out or something else: wait until we
- ;; get more output so we can resolve this ambiguity.
- (set (make-local-variable 'python-preoutput-leftover) s)
- res)
- (t (concat res s)))))
-
-(autoload 'comint-check-proc "comint")
-
-(defvar python-version-checked nil)
-(defun python-check-version (cmd)
- "Check that CMD runs a suitable version of Python."
- ;; Fixme: Check on Jython.
- (unless (or python-version-checked
- (equal 0 (string-match (regexp-quote python-python-command)
- cmd)))
- (unless (shell-command-to-string cmd)
- (error "Can't run Python command `%s'" cmd))
- (let* ((res (shell-command-to-string
- (concat cmd
- " -c \"from sys import version_info;\
-print version_info >= (2, 2) and version_info < (3, 0)\""))))
- (unless (string-match "True" res)
- (error "Only Python versions >= 2.2 and < 3.0 are supported")))
- (setq python-version-checked t)))
+(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. 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 (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-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 process)
+ (and pop (pop-to-buffer buffer t))
+ (and internal (set-process-query-on-exit-flag process nil))))
+ proc-buffer-name)))
;;;###autoload
-(defun run-python (&optional cmd noshow new)
- "Run an inferior Python process, input and output via buffer *Python*.
-CMD is the Python command to run. NOSHOW non-nil means don't
-show the buffer automatically.
-
-Interactively, a prefix arg means to prompt for the initial
-Python command line (default is `python-command').
-
-A new process is started if one isn't running attached to
-`python-buffer', or if called from Lisp with non-nil arg NEW.
-Otherwise, if a process is already running in `python-buffer',
-switch to that buffer.
-
-This command runs the hook `inferior-python-mode-hook' after
-running `comint-mode-hook'. Type \\[describe-mode] in the
-process buffer for a list of commands.
-
-By default, Emacs inhibits the loading of Python modules from the
-current working directory, for security reasons. To disable this
-behavior, change `python-remove-cwd-from-path' to nil."
- (interactive (if current-prefix-arg
- (list (read-string "Run Python: " python-command) nil t)
- (list python-command)))
- (unless cmd (setq cmd python-command))
- (python-check-version cmd)
- (setq python-command cmd)
- ;; Fixme: Consider making `python-buffer' buffer-local as a buffer
- ;; (not a name) in Python buffers from which `run-python' &c is
- ;; invoked. Would support multiple processes better.
- (when (or new (not (comint-check-proc python-buffer)))
- (with-current-buffer
- (let* ((cmdlist
- (append (python-args-to-list cmd) '("-i")
- (if python-remove-cwd-from-path
- '("-c" "import sys; sys.path.remove('')"))))
- (path (getenv "PYTHONPATH"))
- (process-environment ; to import emacs.py
- (cons (concat "PYTHONPATH="
- (if path (concat path path-separator))
- data-directory)
- process-environment))
- ;; If we use a pipe, Unicode characters are not printed
- ;; correctly (Bug#5794) and IPython does not work at
- ;; all (Bug#5390).
- (process-connection-type t))
- (apply 'make-comint-in-buffer "Python"
- (generate-new-buffer "*Python*")
- (car cmdlist) nil (cdr cmdlist)))
- (setq-default python-buffer (current-buffer))
- (setq python-buffer (current-buffer))
- (accept-process-output (get-buffer-process python-buffer) 5)
- (inferior-python-mode)
- ;; Load function definitions we need.
- ;; Before the preoutput function was used, this was done via -c in
- ;; cmdlist, but that loses the banner and doesn't run the startup
- ;; file. The code might be inline here, but there's enough that it
- ;; seems worth putting in a separate file, and it's probably cleaner
- ;; to put it in a module.
- ;; Ensure we're at a prompt before doing anything else.
- (python-send-string "import emacs")
- ;; The following line was meant to ensure that we're at a prompt
- ;; before doing anything else. However, this can cause Emacs to
- ;; hang waiting for a response, if that Python function fails
- ;; (i.e. raises an exception).
- ;; (python-send-receive "print '_emacs_out ()'")
- ))
- (if (derived-mode-p 'python-mode)
- (setq python-buffer (default-value 'python-buffer))) ; buffer-local
- ;; Without this, help output goes into the inferior python buffer if
- ;; the process isn't already running.
- (sit-for 1 t) ;Should we use accept-process-output instead? --Stef
- (unless noshow (pop-to-buffer python-buffer t)))
-
-(defun python-send-command (command)
- "Like `python-send-string' but resets `compilation-shell-minor-mode'."
- (when (python-check-comint-prompt)
- (with-current-buffer (process-buffer (python-proc))
- (goto-char (point-max))
- (compilation-forget-errors)
- (python-send-string command)
- (setq compilation-last-buffer (current-buffer)))))
-
-(defun python-send-region (start end)
- "Send the region to the inferior Python process."
- ;; The region is evaluated from a temporary file. This avoids
- ;; problems with blank lines, which have different semantics
- ;; interactively and in files. It also saves the inferior process
- ;; buffer filling up with interpreter prompts. We need a Python
- ;; function to remove the temporary file when it has been evaluated
- ;; (though we could probably do it in Lisp with a Comint output
- ;; filter). This function also catches exceptions and truncates
- ;; tracebacks not to mention the frame of the function itself.
- ;;
- ;; The `compilation-shell-minor-mode' parsing takes care of relating
- ;; the reference to the temporary file to the source.
- ;;
- ;; Fixme: Write a `coding' header to the temp file if the region is
- ;; non-ASCII.
- (interactive "r")
- (let* ((f (make-temp-file "py"))
- (command
- ;; IPython puts the FakeModule module into __main__ so
- ;; emacs.eexecfile becomes useless.
- (if (string-match "^ipython" python-command)
- (format "execfile %S" f)
- (format "emacs.eexecfile(%S)" f)))
- (orig-start (copy-marker start)))
- (when (save-excursion
- (goto-char start)
- (/= 0 (current-indentation))) ; need dummy block
- (save-excursion
- (goto-char orig-start)
- ;; Wrong if we had indented code at buffer start.
- (set-marker orig-start (line-beginning-position 0)))
- (write-region "if True:\n" nil f nil 'nomsg))
- (write-region start end f t 'nomsg)
- (python-send-command command)
- (with-current-buffer (process-buffer (python-proc))
- ;; Tell compile.el to redirect error locations in file `f' to
- ;; positions past marker `orig-start'. It has to be done *after*
- ;; `python-send-command''s call to `compilation-forget-errors'.
- (compilation-fake-loc orig-start f))))
-
-(defun python-send-string (string)
- "Evaluate STRING in inferior Python process."
+(defun run-python (cmd &optional dedicated show)
+ "Run an inferior Python process.
+Input and output via buffer named after
+`python-shell-buffer-name'. If there is a process already
+running in that buffer, just switch to it.
+
+With argument, allows you to define CMD so you can edit the
+command used to call the interpreter and define DEDICATED, so a
+dedicated process for the current buffer is open. When numeric
+prefix arg is other than 0 or 4 do not SHOW.
+
+Runs the hook `inferior-python-mode-hook' (after the
+`comint-mode-hook' is run). \(Type \\[describe-mode] in the
+process buffer for a list of commands.)"
+ (interactive
+ (if current-prefix-arg
+ (list
+ (read-string "Run Python: " (python-shell-parse-command))
+ (y-or-n-p "Make dedicated process? ")
+ (= (prefix-numeric-value current-prefix-arg) 4))
+ (list (python-shell-parse-command) nil t)))
+ (python-shell-make-comint
+ cmd (python-shell-get-process-name dedicated) show)
+ dedicated)
+
+(defun run-python-internal ()
+ "Run an inferior Internal Python process.
+Input and output via buffer named after
+`python-shell-internal-buffer-name' and what
+`python-shell-internal-get-process-name' returns.
+
+This new kind of shell is intended to be used for generic
+communication related to defined configurations, the main
+difference with global or dedicated shells is that these ones are
+attached to a configuration, not a buffer. This means that can
+be used for example to retrieve the sys.path and other stuff,
+without messing with user shells. Note that
+`python-shell-enable-font-lock' and `inferior-python-mode-hook'
+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))
+ (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."
+ (let* ((dedicated-proc-name (python-shell-get-process-name t))
+ (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name))
+ (global-proc-name (python-shell-get-process-name nil))
+ (global-proc-buffer-name (format "*%s*" global-proc-name))
+ (dedicated-running (comint-check-proc dedicated-proc-buffer-name))
+ (global-running (comint-check-proc global-proc-buffer-name)))
+ ;; Always prefer dedicated
+ (get-buffer-process (or (and dedicated-running dedicated-proc-buffer-name)
+ (and global-running global-proc-buffer-name)))))
+
+(defun python-shell-get-or-create-process ()
+ "Get or create an inferior Python process for current buffer and return it."
+ (let* ((dedicated-proc-name (python-shell-get-process-name t))
+ (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name))
+ (global-proc-name (python-shell-get-process-name nil))
+ (global-proc-buffer-name (format "*%s*" global-proc-name))
+ (dedicated-running (comint-check-proc dedicated-proc-buffer-name))
+ (global-running (comint-check-proc global-proc-buffer-name))
+ (current-prefix-arg 16))
+ (when (and (not dedicated-running) (not global-running))
+ (if (call-interactively 'run-python)
+ (setq dedicated-running t)
+ (setq global-running t)))
+ ;; Always prefer dedicated
+ (get-buffer-process (if dedicated-running
+ dedicated-proc-buffer-name
+ global-proc-buffer-name))))
+
+(defvar python-shell-internal-buffer nil
+ "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.")
+
+(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.")
+
+(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)))
+ (when (not (process-live-p proc-name))
+ (run-python-internal)
+ (setq python-shell-internal-buffer proc-buffer-name)
+ ;; XXX: Why is this `sit-for' needed?
+ ;; `python-shell-make-comint' calls `accept-process-output'
+ ;; already but it is not helping to get proper output on
+ ;; 'gnu/linux when the internal shell process is not running and
+ ;; a call to `python-shell-internal-send-string' is issued.
+ (sit-for 0.1 t))
+ (get-buffer-process proc-buffer-name)))
+
+(define-obsolete-function-alias
+ 'python-proc 'python-shell-internal-get-or-create-process "24.3")
+
+(define-obsolete-variable-alias
+ 'python-buffer 'python-shell-internal-buffer "24.3")
+
+(define-obsolete-variable-alias
+ '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.
+When MSG is non-nil messages the first line of STRING."
(interactive "sPython command: ")
- (comint-send-string (python-proc) string)
- (unless (string-match "\n\\'" string)
- ;; Make sure the text is properly LF-terminated.
- (comint-send-string (python-proc) "\n"))
- (when (string-match "\n[ \t].*\n?\\'" string)
- ;; If the string contains a final indented line, add a second newline so
- ;; as to make sure we terminate the multiline instruction.
- (comint-send-string (python-proc) "\n")))
-
-(defun python-send-buffer ()
- "Send the current buffer to the inferior Python process."
- (interactive)
- (python-send-region (point-min) (point-max)))
+ (let ((process (or process (python-shell-get-or-create-process)))
+ (lines (split-string string "\n" t)))
+ (and msg (message "Sent: %s..." (nth 0 lines)))
+ (if (> (length lines) 1)
+ (let* ((temporary-file-directory
+ (if (file-remote-p default-directory)
+ (concat (file-remote-p default-directory) "/tmp")
+ temporary-file-directory))
+ (temp-file-name (make-temp-file "py"))
+ (file-name (or (buffer-file-name) temp-file-name)))
+ (with-temp-file temp-file-name
+ (insert string)
+ (delete-trailing-whitespace))
+ (python-shell-send-file file-name process temp-file-name))
+ (comint-send-string process string)
+ (when (or (not (string-match "\n$" string))
+ (string-match "\n[ \t].*\n?$" string))
+ (comint-send-string process "\n")))))
+
+(defun python-shell-send-string-no-output (string &optional process msg)
+ "Send STRING to PROCESS and inhibit output.
+When MSG is non-nil messages the first line of STRING. Return
+the output."
+ (let* ((output-buffer "")
+ (process (or process (python-shell-get-or-create-process)))
+ (comint-preoutput-filter-functions
+ (append comint-preoutput-filter-functions
+ '(ansi-color-filter-apply
+ (lambda (string)
+ (setq output-buffer (concat output-buffer string))
+ ""))))
+ (inhibit-quit t))
+ (or
+ (with-local-quit
+ (python-shell-send-string string process msg)
+ (accept-process-output process)
+ (replace-regexp-in-string
+ (if (> (length python-shell-prompt-output-regexp) 0)
+ (format "\n*%s$\\|^%s\\|\n$"
+ python-shell-prompt-regexp
+ (or python-shell-prompt-output-regexp ""))
+ (format "\n*$\\|^%s\\|\n$"
+ python-shell-prompt-regexp))
+ "" output-buffer))
+ (with-current-buffer (process-buffer process)
+ (comint-interrupt-subjob)))))
+
+(defun python-shell-internal-send-string (string)
+ "Send STRING to the Internal Python interpreter.
+Returns the output. See `python-shell-send-string-no-output'."
+ ;; XXX Remove `python-shell-internal-last-output' once CEDET is
+ ;; updated to support this new mode.
+ (setq python-shell-internal-last-output
+ (python-shell-send-string-no-output
+ ;; Makes this function compatible with the old
+ ;; python-send-receive. (At least for CEDET).
+ (replace-regexp-in-string "_emacs_out +" "" string)
+ (python-shell-internal-get-or-create-process) nil)))
+
+(define-obsolete-function-alias
+ 'python-send-receive 'python-shell-internal-send-string "24.3")
+
+(define-obsolete-function-alias
+ '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."
+ (interactive "r")
+ (python-shell-send-string (buffer-substring start end) nil t))
-;; Fixme: Try to define the function or class within the relevant
-;; module, not just at top level.
-(defun python-send-defun ()
- "Send the current defun (class or method) to the inferior Python process."
+(defun python-shell-send-buffer (&optional arg)
+ "Send the entire buffer to inferior Python process.
+With prefix ARG allow execution of code inside blocks delimited
+by \"if __name__== '__main__':\""
+ (interactive "P")
+ (save-restriction
+ (widen)
+ (let ((str (buffer-substring (point-min) (point-max))))
+ (and
+ (not arg)
+ (setq str (replace-regexp-in-string
+ (python-rx if-name-main)
+ "if __name__ == '__main__ ':" str)))
+ (python-shell-send-string str))))
+
+(defun python-shell-send-defun (arg)
+ "Send the current defun to inferior Python process.
+When argument ARG is non-nil do not include decorators."
+ (interactive "P")
+ (save-excursion
+ (python-shell-send-region
+ (progn
+ (end-of-line 1)
+ (while (and (or (python-beginning-of-defun-function)
+ (beginning-of-line 1))
+ (> (current-indentation) 0)))
+ (when (not arg)
+ (while (and (forward-line -1)
+ (looking-at (python-rx decorator))))
+ (forward-line 1))
+ (point-marker))
+ (progn
+ (or (python-end-of-defun-function)
+ (end-of-line 1))
+ (point-marker)))))
+
+(defun python-shell-send-file (file-name &optional process temp-file-name)
+ "Send FILE-NAME to inferior Python PROCESS.
+If TEMP-FILE-NAME is passed then that file is used for processing
+instead, while internally the shell will continue to use
+FILE-NAME."
+ (interactive "fFile to send: ")
+ (let* ((process (or process (python-shell-get-or-create-process)))
+ (temp-file-name (when temp-file-name
+ (expand-file-name
+ (or (file-remote-p temp-file-name 'localname)
+ temp-file-name))))
+ (file-name (or (when file-name
+ (expand-file-name
+ (or (file-remote-p file-name 'localname)
+ file-name)))
+ temp-file-name)))
+ (when (not file-name)
+ (error "If FILE-NAME is nil then TEMP-FILE-NAME must be non-nil"))
+ (python-shell-send-string
+ (format
+ (concat "__pyfile = open('''%s''');"
+ "exec(compile(__pyfile.read(), '''%s''', 'exec'));"
+ "__pyfile.close()")
+ (or temp-file-name file-name) file-name)
+ process)))
+
+(defun python-shell-switch-to-shell ()
+ "Switch to inferior Python process buffer."
(interactive)
- (save-excursion (python-send-region (progn (beginning-of-defun) (point))
- (progn (end-of-defun) (point)))))
+ (pop-to-buffer (process-buffer (python-shell-get-or-create-process)) t))
+
+(defun python-shell-send-setup-code ()
+ "Send all setup code for shell.
+This function takes the list of setup code to send from the
+`python-shell-setup-codes' list."
+ (let ((process (get-buffer-process (current-buffer))))
+ (dolist (code python-shell-setup-codes)
+ (when code
+ (message "Sent %s" code)
+ (python-shell-send-string
+ (symbol-value code) process)))))
+
+(add-hook 'inferior-python-mode-hook
+ #'python-shell-send-setup-code)
-(defun python-switch-to-python (eob-p)
- "Switch to the Python process buffer, maybe starting new process.
-With prefix arg, position cursor at end of buffer."
- (interactive "P")
- (pop-to-buffer (process-buffer (python-proc)) t) ;Runs python if needed.
- (when eob-p
- (push-mark)
- (goto-char (point-max))))
-
-(defun python-send-region-and-go (start end)
- "Send the region to the inferior Python process.
-Then switch to the process buffer."
- (interactive "r")
- (python-send-region start end)
- (python-switch-to-python t))
-
-(defcustom python-source-modes '(python-mode jython-mode)
- "Used to determine if a buffer contains Python source code.
-If a file is loaded into a buffer that is in one of these major modes,
-it is considered Python source by `python-load-file', which uses the
-value to determine defaults."
- :type '(repeat function)
+\f
+;;; Shell completion
+
+(defcustom python-shell-completion-setup-code
+ "try:
+ import readline
+except ImportError:
+ def __COMPLETER_all_completions(text): []
+else:
+ import rlcompleter
+ readline.set_completer(rlcompleter.Completer().complete)
+ def __COMPLETER_all_completions(text):
+ import sys
+ completions = []
+ try:
+ i = 0
+ while True:
+ res = readline.get_completer()(text, i)
+ if not res: break
+ i += 1
+ completions.append(res)
+ except NameError:
+ pass
+ return completions"
+ "Code used to setup completion in inferior Python processes."
+ :type 'string
:group 'python)
-(defvar python-prev-dir/file nil
- "Caches (directory . file) pair used in the last `python-load-file' command.
-Used for determining the default in the next one.")
-
-(autoload 'comint-get-source "comint")
-
-(defun python-load-file (file-name)
- "Load a Python file FILE-NAME into the inferior Python process.
-If the file has extension `.py' import or reload it as a module.
-Treating it as a module keeps the global namespace clean, provides
-function location information for debugging, and supports users of
-module-qualified names."
- (interactive (comint-get-source "Load Python file: " python-prev-dir/file
- python-source-modes
- t)) ; because execfile needs exact name
- (comint-check-source file-name) ; Check to see if buffer needs saving.
- (setq python-prev-dir/file (cons (file-name-directory file-name)
- (file-name-nondirectory file-name)))
- (with-current-buffer (process-buffer (python-proc)) ;Runs python if needed.
- ;; Fixme: I'm not convinced by this logic from python-mode.el.
- (python-send-command
- (if (string-match "\\.py\\'" file-name)
- (let ((module (file-name-sans-extension
- (file-name-nondirectory file-name))))
- (format "emacs.eimport(%S,%S)"
- module (file-name-directory file-name)))
- (format "execfile(%S)" file-name)))
- (message "%s loaded" file-name)))
-
-(defun python-proc ()
- "Return the current Python process.
-See variable `python-buffer'. Starts a new process if necessary."
- ;; Fixme: Maybe should look for another active process if there
- ;; isn't one for `python-buffer'.
- (unless (comint-check-proc python-buffer)
- (run-python nil t))
- (get-buffer-process (if (derived-mode-p 'inferior-python-mode)
- (current-buffer)
- python-buffer)))
-
-(defun python-set-proc ()
- "Set the default value of `python-buffer' to correspond to this buffer.
-If the current buffer has a local value of `python-buffer', set the
-default (global) value to that. The associated Python process is
-the one that gets input from \\[python-send-region] et al when used
-in a buffer that doesn't have a local value of `python-buffer'."
- (interactive)
- (if (local-variable-p 'python-buffer)
- (setq-default python-buffer python-buffer)
- (error "No local value of `python-buffer'")))
-\f
-;;;; Context-sensitive help.
+(defcustom python-shell-completion-string-code
+ "';'.join(__COMPLETER_all_completions('''%s'''))\n"
+ "Python code used to get a string of completions separated by semicolons."
+ :type 'string
+ :group 'python)
-(defconst python-dotty-syntax-table
- (let ((table (make-syntax-table)))
- (set-char-table-parent table python-mode-syntax-table)
- (modify-syntax-entry ?. "_" table)
- table)
- "Syntax table giving `.' symbol syntax.
-Otherwise inherits from `python-mode-syntax-table'.")
+(defcustom python-shell-completion-module-string-code ""
+ "Python code used to get completions separated by semicolons for imports.
-(defvar view-return-to-alist)
-(eval-when-compile (autoload 'help-buffer "help-fns"))
+For IPython v0.11, add the following line to
+`python-shell-completion-setup-code':
-(defvar python-imports) ; forward declaration
+from IPython.core.completerlib import module_completion
-;; Fixme: Should this actually be used instead of info-look, i.e. be
-;; bound to C-h S? [Probably not, since info-look may work in cases
-;; where this doesn't.]
-(defun python-describe-symbol (symbol)
- "Get help on SYMBOL using `help'.
-Interactively, prompt for symbol.
+and use the following as the value of this variable:
-Symbol may be anything recognized by the interpreter's `help'
-command -- e.g. `CALLS' -- not just variables in scope in the
-interpreter. This only works for Python version 2.2 or newer
-since earlier interpreters don't support `help'.
+';'.join(module_completion('''%s'''))\n"
+ :type 'string
+ :group 'python)
-In some cases where this doesn't find documentation, \\[info-lookup-symbol]
-will."
- ;; Note that we do this in the inferior process, not a separate one, to
- ;; ensure the environment is appropriate.
- (interactive
- (let ((symbol (with-syntax-table python-dotty-syntax-table
- (current-word)))
- (enable-recursive-minibuffers t))
- (list (read-string (if symbol
- (format "Describe symbol (default %s): " symbol)
- "Describe symbol: ")
- nil nil symbol))))
- (if (equal symbol "") (error "No symbol"))
- ;; Ensure we have a suitable help buffer.
- ;; Fixme: Maybe process `Related help topics' a la help xrefs and
- ;; allow C-c C-f in help buffer.
- (let ((temp-buffer-show-hook ; avoid xref stuff
- (lambda ()
- (toggle-read-only 1)
- (setq view-return-to-alist
- (list (cons (selected-window) help-return-method))))))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- ;; Fixme: Is this actually useful?
- (help-setup-xref (list 'python-describe-symbol symbol)
- (called-interactively-p 'interactive))
- (set (make-local-variable 'comint-redirect-subvert-readonly) t)
- (help-print-return-message))))
- (comint-redirect-send-command-to-process (format "emacs.ehelp(%S, %s)"
- symbol python-imports)
- "*Help*" (python-proc) nil nil))
-
-(add-to-list 'debug-ignored-errors "^No symbol")
-
-(defun python-send-receive (string)
- "Send STRING to inferior Python (if any) and return result.
-The result is what follows `_emacs_out' in the output.
-This is a no-op if `python-check-comint-prompt' returns nil."
- (python-send-string string)
- (let ((proc (python-proc)))
- (with-current-buffer (process-buffer proc)
- (when (python-check-comint-prompt proc)
- (set (make-local-variable 'python-preoutput-result) nil)
- (while (progn
- (accept-process-output proc 5)
- (null python-preoutput-result)))
- (prog1 python-preoutput-result
- (kill-local-variable 'python-preoutput-result))))))
-
-(defun python-check-comint-prompt (&optional proc)
- "Return non-nil if and only if there's a normal prompt in the inferior buffer.
-If there isn't, it's probably not appropriate to send input to return Eldoc
-information etc. If PROC is non-nil, check the buffer for that process."
- (with-current-buffer (process-buffer (or proc (python-proc)))
- (save-excursion
- (save-match-data
- (re-search-backward (concat python--prompt-regexp " *\\=")
- nil t)))))
+(defcustom python-shell-completion-pdb-string-code
+ "';'.join(globals().keys() + locals().keys())"
+ "Python code used to get completions separated by semicolons for [i]pdb."
+ :type 'string
+ :group 'python)
+
+(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-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)
+ (skip-syntax-backward syntax-string)
+ (when (or (equal (char-before) ?\))
+ (equal (char-before) ?\"))
+ (forward-char -1))
+ (while (or
+ ;; honor initial paren depth
+ (> (car (syntax-ppss)) paren-depth)
+ (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.
+If content before pointer is all whitespace indent. If not try
+to complete."
+ (interactive)
+ (if (string-match "^[[:space:]]*$"
+ (buffer-substring (comint-line-beginning-position)
+ (point-marker)))
+ (indent-for-tab-command)
+ (completion-at-point)))
-;; Fixme: Is there anything reasonable we can do with random methods?
-;; (Currently only works with functions.)
-(defun python-eldoc-function ()
- "`eldoc-documentation-function' for Python.
-Only works when point is in a function name, not its arg list, for
-instance. Assumes an inferior Python is running."
- (let ((symbol (with-syntax-table python-dotty-syntax-table
- (current-word))))
- ;; This is run from timers, so inhibit-quit tends to be set.
- (with-local-quit
- ;; First try the symbol we're on.
- (or (and symbol
- (python-send-receive (format "emacs.eargs(%S, %s)"
- symbol python-imports)))
- ;; Try moving to symbol before enclosing parens.
- (let ((s (syntax-ppss)))
- (unless (zerop (car s))
- (when (eq ?\( (char-after (nth 1 s)))
- (save-excursion
- (goto-char (nth 1 s))
- (skip-syntax-backward "-")
- (let ((point (point)))
- (skip-chars-backward "a-zA-Z._")
- (if (< (point) point)
- (python-send-receive
- (format "emacs.eargs(%S, %s)"
- (buffer-substring-no-properties (point) point)
- python-imports))))))))))))
\f
-;;;; Info-look functionality.
+;;; PDB Track integration
-(declare-function info-lookup-maybe-add-help "info-look" (&rest arg))
+(defcustom python-pdbtrack-activate t
+ "Non-nil makes python shell enable pdbtracking."
+ :type 'boolean
+ :group 'python
+ :safe 'booleanp)
-;;;###autoload
-(defun python-after-info-look ()
- "Set up info-look for Python.
-Used with `eval-after-load'."
- (let* ((version (let ((s (shell-command-to-string (concat python-command
- " -V"))))
- (string-match "^Python \\([0-9]+\\.[0-9]+\\>\\)" s)
- (match-string 1 s)))
- ;; Whether info files have a Python version suffix, e.g. in Debian.
- (versioned
- (with-temp-buffer
- (with-no-warnings (Info-mode))
- (condition-case ()
- ;; Don't use `info' because it would pop-up a *info* buffer.
- (with-no-warnings
- (Info-goto-node (format "(python%s-lib)Miscellaneous Index"
- version))
- t)
- (error nil)))))
- (info-lookup-maybe-add-help
- :mode 'python-mode
- :regexp "[[:alnum:]_]+"
- :doc-spec
- ;; Fixme: Can this reasonably be made specific to indices with
- ;; different rules? Is the order of indices optimal?
- ;; (Miscellaneous in -ref first prefers lookup of keywords, for
- ;; instance.)
- (if versioned
- ;; The empty prefix just gets us highlighted terms.
- `((,(concat "(python" version "-ref)Miscellaneous Index") nil "")
- (,(concat "(python" version "-ref)Module Index" nil ""))
- (,(concat "(python" version "-ref)Function-Method-Variable Index"
- nil ""))
- (,(concat "(python" version "-ref)Class-Exception-Object Index"
- nil ""))
- (,(concat "(python" version "-lib)Module Index" nil ""))
- (,(concat "(python" version "-lib)Class-Exception-Object Index"
- nil ""))
- (,(concat "(python" version "-lib)Function-Method-Variable Index"
- nil ""))
- (,(concat "(python" version "-lib)Miscellaneous Index" nil "")))
- '(("(python-ref)Miscellaneous Index" nil "")
- ("(python-ref)Module Index" nil "")
- ("(python-ref)Function-Method-Variable Index" nil "")
- ("(python-ref)Class-Exception-Object Index" nil "")
- ("(python-lib)Module Index" nil "")
- ("(python-lib)Class-Exception-Object Index" nil "")
- ("(python-lib)Function-Method-Variable Index" nil "")
- ("(python-lib)Miscellaneous Index" nil ""))))))
-(eval-after-load "info-look" '(python-after-info-look))
-\f
-;;;; Miscellany.
+(defcustom python-pdbtrack-stacktrace-info-regexp
+ "^> \\([^\"(<]+\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_<>]+\\)()"
+ "Regular Expression matching stacktrace information.
+Used to extract the current line and module being inspected."
+ :type 'string
+ :group 'python
+ :safe 'stringp)
+
+(defvar python-pdbtrack-tracked-buffer nil
+ "Variable containing the value of the current tracked buffer.
+Never set this variable directly, use
+`python-pdbtrack-set-tracked-buffer' instead.")
+
+(defvar python-pdbtrack-buffers-to-kill nil
+ "List of buffers to be deleted after tracking finishes.")
+
+(defun python-pdbtrack-set-tracked-buffer (file-name)
+ "Set the buffer for FILE-NAME as the tracked buffer.
+Internally it uses the `python-pdbtrack-tracked-buffer' variable.
+Returns the tracked buffer."
+ (let ((file-buffer (get-file-buffer file-name)))
+ (if file-buffer
+ (setq python-pdbtrack-tracked-buffer file-buffer)
+ (setq file-buffer (find-file-noselect file-name))
+ (when (not (member file-buffer python-pdbtrack-buffers-to-kill))
+ (add-to-list 'python-pdbtrack-buffers-to-kill file-buffer)))
+ file-buffer))
+
+(defun python-pdbtrack-comint-output-filter-function (output)
+ "Move overlay arrow to current pdb line in tracked buffer.
+Argument OUTPUT is a string with the output from the comint process."
+ (when (and python-pdbtrack-activate (not (string= output "")))
+ (let* ((full-output (ansi-color-filter-apply
+ (buffer-substring comint-last-input-end (point-max))))
+ (line-number)
+ (file-name
+ (with-temp-buffer
+ (insert full-output)
+ (goto-char (point-min))
+ ;; OK, this sucked but now it became a cool hack. The
+ ;; stacktrace information normally is on the first line
+ ;; but in some cases (like when doing a step-in) it is
+ ;; on the second.
+ (when (or (looking-at python-pdbtrack-stacktrace-info-regexp)
+ (and
+ (forward-line)
+ (looking-at python-pdbtrack-stacktrace-info-regexp)))
+ (setq line-number (string-to-number
+ (match-string-no-properties 2)))
+ (match-string-no-properties 1)))))
+ (if (and file-name line-number)
+ (let* ((tracked-buffer
+ (python-pdbtrack-set-tracked-buffer file-name))
+ (shell-buffer (current-buffer))
+ (tracked-buffer-window (get-buffer-window tracked-buffer))
+ (tracked-buffer-line-pos))
+ (with-current-buffer tracked-buffer
+ (set (make-local-variable 'overlay-arrow-string) "=>")
+ (set (make-local-variable 'overlay-arrow-position) (make-marker))
+ (setq tracked-buffer-line-pos (progn
+ (goto-char (point-min))
+ (forward-line (1- line-number))
+ (point-marker)))
+ (when tracked-buffer-window
+ (set-window-point
+ tracked-buffer-window tracked-buffer-line-pos))
+ (set-marker overlay-arrow-position tracked-buffer-line-pos))
+ (pop-to-buffer tracked-buffer)
+ (switch-to-buffer-other-window shell-buffer))
+ (when python-pdbtrack-tracked-buffer
+ (with-current-buffer python-pdbtrack-tracked-buffer
+ (set-marker overlay-arrow-position nil))
+ (mapc #'(lambda (buffer)
+ (ignore-errors (kill-buffer buffer)))
+ python-pdbtrack-buffers-to-kill)
+ (setq python-pdbtrack-tracked-buffer nil
+ python-pdbtrack-buffers-to-kill nil)))))
+ output)
-(defcustom python-jython-packages '("java" "javax" "org" "com")
- "Packages implying `jython-mode'.
-If these are imported near the beginning of the buffer, `python-mode'
-actually punts to `jython-mode'."
- :type '(repeat string)
- :group 'python)
+\f
+;;; Symbol completion
-;; Called from `python-mode', this causes a recursive call of the
-;; mode. See logic there to break out of the recursion.
-(defun python-maybe-jython ()
- "Invoke `jython-mode' if the buffer appears to contain Jython code.
-The criterion is either a match for `jython-mode' via
-`interpreter-mode-alist' or an import of a module from the list
-`python-jython-packages'."
- ;; The logic is taken from python-mode.el.
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((interpreter (if (looking-at auto-mode-interpreter-regexp)
- (match-string 2))))
- (if (and interpreter (eq 'jython-mode
- (cdr (assoc (file-name-nondirectory
- interpreter)
- interpreter-mode-alist))))
- (jython-mode)
- (if (catch 'done
- (while (re-search-forward
- (rx line-start (or "import" "from") (1+ space)
- (group (1+ (not (any " \t\n.")))))
- (+ (point-min) 10000) ; Probably not worth customizing.
- t)
- (if (member (match-string 1) python-jython-packages)
- (throw 'done t))))
- (jython-mode)))))))
-
-(defun python-fill-paragraph (&optional justify)
- "`fill-paragraph-function' handling multi-line strings and possibly comments.
-If any of the current line is in or at the end of a multi-line string,
-fill the string or the paragraph of it that point is in, preserving
-the string's indentation."
- (interactive "P")
- (or (fill-comment-paragraph justify)
- (save-excursion
- (end-of-line)
- (let* ((syntax (syntax-ppss))
- (orig (point))
- start end)
- (cond ((nth 4 syntax) ; comment. fixme: loses with trailing one
- (let (fill-paragraph-function)
- (fill-paragraph justify)))
- ;; The `paragraph-start' and `paragraph-separate'
- ;; variables don't allow us to delimit the last
- ;; paragraph in a multi-line string properly, so narrow
- ;; to the string and then fill around (the end of) the
- ;; current line.
- ((eq t (nth 3 syntax)) ; in fenced string
- (goto-char (nth 8 syntax)) ; string start
- (setq start (line-beginning-position))
- (setq end (condition-case () ; for unbalanced quotes
- (progn (forward-sexp)
- (- (point) 3))
- (error (point-max)))))
- ((re-search-backward "\\s|\\s-*\\=" nil t) ; end of fenced string
- (forward-char)
- (setq end (point))
- (condition-case ()
- (progn (backward-sexp)
- (setq start (line-beginning-position)))
- (error nil))))
- (when end
- (save-restriction
- (narrow-to-region start end)
- (goto-char orig)
- ;; Avoid losing leading and trailing newlines in doc
- ;; strings written like:
- ;; """
- ;; ...
- ;; """
- (let ((paragraph-separate
- ;; Note that the string could be part of an
- ;; expression, so it can have preceding and
- ;; trailing non-whitespace.
- (concat
- (rx (or
- ;; Opening triple quote without following text.
- (and (* nonl)
- (group (syntax string-delimiter))
- (repeat 2 (backref 1))
- ;; Fixme: Not sure about including
- ;; trailing whitespace.
- (* (any " \t"))
- eol)
- ;; Closing trailing quote without preceding text.
- (and (group (any ?\" ?')) (backref 2)
- (syntax string-delimiter))))
- "\\(?:" paragraph-separate "\\)"))
- fill-paragraph-function)
- (fill-paragraph justify))))))) t)
-
-(defun python-shift-left (start end &optional count)
- "Shift lines in region COUNT (the prefix arg) columns to the left.
-COUNT defaults to `python-indent'. If region isn't active, just shift
-current line. The region shifted includes the lines in which START and
-END lie. It is an error if any lines in the region are indented less than
-COUNT columns."
- (interactive
- (if mark-active
- (list (region-beginning) (region-end) current-prefix-arg)
- (list (line-beginning-position) (line-end-position) current-prefix-arg)))
- (if count
- (setq count (prefix-numeric-value count))
- (setq count python-indent))
- (when (> count 0)
- (save-excursion
- (goto-char start)
- (while (< (point) end)
- (if (and (< (current-indentation) count)
- (not (looking-at "[ \t]*$")))
- (error "Can't shift all lines enough"))
- (forward-line))
- (indent-rigidly start end (- count)))))
+(defun python-completion-complete-at-point ()
+ "Complete current symbol at point.
+For this to work the best as possible you should call
+`python-shell-send-buffer' from time to time so context in
+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-complete-at-point process))))
-(add-to-list 'debug-ignored-errors "^Can't shift all lines enough")
+(add-to-list 'debug-ignored-errors
+ "^Completion needs an inferior Python process running.")
-(defun python-shift-right (start end &optional count)
- "Shift lines in region COUNT (the prefix arg) columns to the right.
-COUNT defaults to `python-indent'. If region isn't active, just shift
-current line. The region shifted includes the lines in which START and
-END lie."
- (interactive
- (if mark-active
- (list (region-beginning) (region-end) current-prefix-arg)
- (list (line-beginning-position) (line-end-position) current-prefix-arg)))
- (if count
- (setq count (prefix-numeric-value count))
- (setq count python-indent))
- (indent-rigidly start end count))
-
-(defun python-outline-level ()
- "`outline-level' function for Python mode.
-The level is the number of `python-indent' steps of indentation
-of current line."
- (1+ (/ (current-indentation) python-indent)))
-
-;; Fixme: Consider top-level assignments, imports, &c.
-(defun python-current-defun (&optional length-limit)
- "`add-log-current-defun-function' for Python."
- (save-excursion
- ;; Move up the tree of nested `class' and `def' blocks until we
- ;; get to zero indentation, accumulating the defined names.
- (let ((accum)
- (length -1))
- (catch 'done
- (while (or (null length-limit)
- (null (cdr accum))
- (< length length-limit))
- (let ((started-from (point)))
- (python-beginning-of-block)
- (end-of-line)
- (beginning-of-defun)
- (when (= (point) started-from)
- (throw 'done nil)))
- (when (looking-at (rx (0+ space) (or "def" "class") (1+ space)
- (group (1+ (or word (syntax symbol))))))
- (push (match-string 1) accum)
- (setq length (+ length 1 (length (car accum)))))
- (when (= (current-indentation) 0)
- (throw 'done nil))))
- (when accum
- (when (and length-limit (> length length-limit))
- (setcar accum ".."))
- (mapconcat 'identity accum ".")))))
-
-(defun python-mark-block ()
- "Mark the block around point.
-Uses `python-beginning-of-block', `python-end-of-block'."
- (interactive)
- (push-mark)
- (python-beginning-of-block)
- (push-mark (point) nil t)
- (python-end-of-block)
- (exchange-point-and-mark))
-
-;; Fixme: Provide a find-function-like command to find source of a
-;; definition (separate from BicycleRepairMan). Complicated by
-;; finding the right qualified name.
-\f
-;;;; Completion.
-
-;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-01/msg00076.html
-(defvar python-imports "None"
- "String of top-level import statements updated by `python-find-imports'.")
-(make-variable-buffer-local 'python-imports)
-
-;; Fixme: Should font-lock try to run this when it deals with an import?
-;; Maybe not a good idea if it gets run multiple times when the
-;; statement is being edited, and is more likely to end up with
-;; something syntactically incorrect.
-;; However, what we should do is to trundle up the block tree from point
-;; to extract imports that appear to be in scope, and add those.
-(defun python-find-imports ()
- "Find top-level imports, updating `python-imports'."
- (interactive)
- (save-excursion
- (let (lines)
- (goto-char (point-min))
- (while (re-search-forward "^import\\>\\|^from\\>" nil t)
- (unless (syntax-ppss-context (syntax-ppss))
- (let ((start (line-beginning-position)))
- ;; Skip over continued lines.
- (while (and (eq ?\\ (char-before (line-end-position)))
- (= 0 (forward-line 1)))
- t)
- (push (buffer-substring start (line-beginning-position 2))
- lines))))
- (setq python-imports
- (if lines
- (apply #'concat
-;; This is probably best left out since you're unlikely to need the
-;; doc for a function in the buffer and the import will lose if the
-;; Python sub-process' working directory isn't the same as the
-;; buffer's.
-;; (if buffer-file-name
-;; (concat
-;; "import "
-;; (file-name-sans-extension
-;; (file-name-nondirectory buffer-file-name))))
- (nreverse lines))
- "None"))
- (when lines
- (set-text-properties 0 (length python-imports) nil python-imports)
- ;; The output ends up in the wrong place if the string we
- ;; send contains newlines (from the imports).
- (setq python-imports
- (replace-regexp-in-string "\n" "\\n"
- (format "%S" python-imports) t t))))))
-
-;; Fixme: This fails the first time if the sub-process isn't already
-;; running. Presumably a timing issue with i/o to the process.
-(defun python-symbol-completions (symbol)
- "Return a list of completions of the string SYMBOL from Python process.
-The list is sorted.
-Uses `python-imports' to load modules against which to complete."
- (when (stringp symbol)
- (let ((completions
- (condition-case ()
- (car (read-from-string
- (python-send-receive
- (format "emacs.complete(%S,%s)"
- (substring-no-properties symbol)
- python-imports))))
- (error nil))))
- (sort
- ;; We can get duplicates from the above -- don't know why.
- (delete-dups completions)
- #'string<))))
-
-(defun python-completion-at-point ()
- (let ((end (point))
- (start (save-excursion
- (and (re-search-backward
- (rx (or buffer-start (regexp "[^[:alnum:]._]"))
- (group (1+ (regexp "[[:alnum:]._]"))) point)
- nil t)
- (match-beginning 1)))))
- (when start
- (list start end
- (completion-table-dynamic 'python-symbol-completions)))))
\f
-;;;; FFAP support
+;;; Fill paragraph
-(defun python-module-path (module)
- "Function for `ffap-alist' to return path to MODULE."
- (python-send-receive (format "emacs.modpath (%S)" module)))
+(defcustom python-fill-comment-function 'python-fill-comment
+ "Function to fill comments.
+This is the function used by `python-fill-paragraph-function' to
+fill comments."
+ :type 'symbol
+ :group 'python
+ :safe 'symbolp)
-(eval-after-load "ffap"
- '(push '(python-mode . python-module-path) ffap-alist))
-\f
-;;;; Find-function support
+(defcustom python-fill-string-function 'python-fill-string
+ "Function to fill strings.
+This is the function used by `python-fill-paragraph-function' to
+fill strings."
+ :type 'symbol
+ :group 'python
+ :safe 'symbolp)
-;; Fixme: key binding?
+(defcustom python-fill-decorator-function 'python-fill-decorator
+ "Function to fill decorators.
+This is the function used by `python-fill-paragraph-function' to
+fill decorators."
+ :type 'symbol
+ :group 'python
+ :safe 'symbolp)
-(defun python-find-function (name)
- "Find source of definition of function NAME.
-Interactively, prompt for name."
- (interactive
- (let ((symbol (with-syntax-table python-dotty-syntax-table
- (current-word)))
- (enable-recursive-minibuffers t))
- (list (read-string (if symbol
- (format "Find location of (default %s): " symbol)
- "Find location of: ")
- nil nil symbol))))
- (unless python-imports
- (error "Not called from buffer visiting Python file"))
- (let* ((loc (python-send-receive (format "emacs.location_of (%S, %s)"
- name python-imports)))
- (loc (car (read-from-string loc)))
- (file (car loc))
- (line (cdr loc)))
- (unless file (error "Don't know where `%s' is defined" name))
- (pop-to-buffer (find-file-noselect file))
- (when (integerp line)
+(defcustom python-fill-paren-function 'python-fill-paren
+ "Function to fill parens.
+This is the function used by `python-fill-paragraph-function' to
+fill parens."
+ :type 'symbol
+ :group 'python
+ :safe 'symbolp)
+
+(defun python-fill-paragraph-function (&optional justify)
+ "`fill-paragraph-function' handling multi-line strings and possibly comments.
+If any of the current line is in or at the end of a multi-line string,
+fill the string or the paragraph of it that point is in, preserving
+the string's indentation.
+Optional argument JUSTIFY defines if the paragraph should be justified."
+ (interactive "P")
+ (save-excursion
+ (back-to-indentation)
+ (cond
+ ;; Comments
+ ((funcall python-fill-comment-function justify))
+ ;; Strings/Docstrings
+ ((save-excursion (skip-chars-forward "\"'uUrR")
+ (python-syntax-context 'string))
+ (funcall python-fill-string-function justify))
+ ;; Decorators
+ ((equal (char-after (save-excursion
+ (back-to-indentation)
+ (point-marker))) ?@)
+ (funcall python-fill-decorator-function justify))
+ ;; Parens
+ ((or (python-syntax-context 'paren)
+ (looking-at (python-rx open-paren))
+ (save-excursion
+ (skip-syntax-forward "^(" (line-end-position))
+ (looking-at (python-rx open-paren))))
+ (funcall python-fill-paren-function justify))
+ (t t))))
+
+(defun python-fill-comment (&optional justify)
+ "Comment fill function for `python-fill-paragraph-function'.
+JUSTIFY should be used (if applicable) as in `fill-paragraph'."
+ (fill-comment-paragraph justify))
+
+(defun python-fill-string (&optional justify)
+ "String fill function for `python-fill-paragraph-function'.
+JUSTIFY should be used (if applicable) as in `fill-paragraph'."
+ (let ((marker (point-marker))
+ (string-start-marker
+ (progn
+ (skip-chars-forward "\"'uUrR")
+ (goto-char (python-syntax-context 'string))
+ (skip-chars-forward "\"'uUrR")
+ (point-marker)))
+ (reg-start (line-beginning-position))
+ (string-end-marker
+ (progn
+ (while (python-syntax-context 'string)
+ (goto-char (1+ (point-marker))))
+ (skip-chars-backward "\"'")
+ (point-marker)))
+ (reg-end (line-end-position))
+ (fill-paragraph-function))
+ (save-restriction
+ (narrow-to-region reg-start reg-end)
+ (save-excursion
+ (goto-char string-start-marker)
+ (delete-region (point-marker) (progn
+ (skip-syntax-forward "> ")
+ (point-marker)))
+ (goto-char string-end-marker)
+ (delete-region (point-marker) (progn
+ (skip-syntax-backward "> ")
+ (point-marker)))
+ (save-excursion
+ (goto-char marker)
+ (fill-paragraph justify))
+ ;; If there is a newline in the docstring lets put triple
+ ;; quote in it's own line to follow pep 8
+ (when (save-excursion
+ (re-search-backward "\n" string-start-marker t))
+ (newline)
+ (newline-and-indent))
+ (fill-paragraph justify)))) t)
+
+(defun python-fill-decorator (&optional justify)
+ "Decorator fill function for `python-fill-paragraph-function'.
+JUSTIFY should be used (if applicable) as in `fill-paragraph'."
+ t)
+
+(defun python-fill-paren (&optional justify)
+ "Paren fill function for `python-fill-paragraph-function'.
+JUSTIFY should be used (if applicable) as in `fill-paragraph'."
+ (save-restriction
+ (narrow-to-region (progn
+ (while (python-syntax-context 'paren)
+ (goto-char (1- (point-marker))))
+ (point-marker)
+ (line-beginning-position))
+ (progn
+ (when (not (python-syntax-context 'paren))
+ (end-of-line)
+ (when (not (python-syntax-context 'paren))
+ (skip-syntax-backward "^)")))
+ (while (python-syntax-context 'paren)
+ (goto-char (1+ (point-marker))))
+ (point-marker)))
+ (let ((paragraph-start "\f\\|[ \t]*$")
+ (paragraph-separate ",")
+ (fill-paragraph-function))
(goto-char (point-min))
- (forward-line (1- line)))))
+ (fill-paragraph justify))
+ (while (not (eobp))
+ (forward-line 1)
+ (python-indent-line)
+ (goto-char (line-end-position)))) t)
+
\f
-;;;; Skeletons
+;;; Skeletons
-(defcustom python-use-skeletons nil
+(defcustom python-skeleton-autoinsert nil
"Non-nil means template skeletons will be automagically inserted.
This happens when pressing \"if<SPACE>\", for example, to prompt for
the if condition."
:type 'boolean
- :group 'python)
+ :group 'python
+ :safe 'booleanp)
+
+(define-obsolete-variable-alias
+ 'python-use-skeletons 'python-skeleton-autoinsert "24.3")
+
+(defvar python-skeleton-available '()
+ "Internal list of available skeletons.")
(define-abbrev-table 'python-mode-abbrev-table ()
"Abbrev table for Python mode."
;; Allow / inside abbrevs.
:regexp "\\(?:^\\|[^/]\\)\\<\\([[:word:]/]+\\)\\W*"
;; Only expand in code.
- :enable-function (lambda () (not (python-in-string/comment))))
-
-(eval-when-compile
- ;; Define a user-level skeleton and add it to the abbrev table.
-(defmacro def-python-skeleton (name &rest elements)
+ :enable-function (lambda ()
+ (and
+ (not (python-syntax-comment-or-string-p))
+ python-skeleton-autoinsert)))
+
+(defmacro python-skeleton-define (name doc &rest skel)
+ "Define a `python-mode' skeleton using NAME DOC and SKEL.
+The skeleton will be bound to python-skeleton-NAME and will
+be added to `python-mode-abbrev-table'."
(declare (indent 2))
(let* ((name (symbol-name name))
- (function (intern (concat "python-insert-" name))))
+ (function-name (intern (concat "python-skeleton-" name))))
`(progn
- ;; Usual technique for inserting a skeleton, but expand
- ;; to the original abbrev instead if in a comment or string.
- (when python-use-skeletons
- (define-abbrev python-mode-abbrev-table ,name ""
- ',function
- nil t)) ; system abbrev
- (define-skeleton ,function
- ,(format "Insert Python \"%s\" template." name)
- ,@elements)))))
-
-;; From `skeleton-further-elements' set below:
-;; `<': outdent a level;
-;; `^': delete indentation on current line and also previous newline.
-;; Not quite like `delete-indentation'. Assumes point is at
-;; beginning of indentation.
-
-(def-python-skeleton if
+ (define-abbrev python-mode-abbrev-table ,name "" ',function-name
+ :system t)
+ (setq python-skeleton-available
+ (cons ',function-name python-skeleton-available))
+ (define-skeleton ,function-name
+ ,(or doc
+ (format "Insert %s statement." name))
+ ,@skel))))
+
+(defmacro python-define-auxiliary-skeleton (name doc &optional &rest skel)
+ "Define a `python-mode' auxiliary skeleton using NAME DOC and SKEL.
+The skeleton will be bound to python-skeleton-NAME."
+ (declare (indent 2))
+ (let* ((name (symbol-name name))
+ (function-name (intern (concat "python-skeleton--" name)))
+ (msg (format
+ "Add '%s' clause? " name)))
+ (when (not skel)
+ (setq skel
+ `(< ,(format "%s:" name) \n \n
+ > _ \n)))
+ `(define-skeleton ,function-name
+ ,(or doc
+ (format "Auxiliary skeleton for %s statement." name))
+ nil
+ (unless (y-or-n-p ,msg)
+ (signal 'quit t))
+ ,@skel)))
+
+(python-define-auxiliary-skeleton else nil)
+
+(python-define-auxiliary-skeleton except nil)
+
+(python-define-auxiliary-skeleton finally nil)
+
+(python-skeleton-define if nil
"Condition: "
"if " str ":" \n
- > -1 ; Fixme: I don't understand the spurious space this removes.
_ \n
("other condition, %s: "
- < ; Avoid wrong indentation after block opening.
+ <
"elif " str ":" \n
> _ \n nil)
- '(python-else) | ^)
-
-(define-skeleton python-else
- "Auxiliary skeleton."
- nil
- (unless (eq ?y (read-char "Add `else' clause? (y for yes or RET for no) "))
- (signal 'quit t))
- < "else:" \n
- > _ \n)
+ '(python-skeleton--else) | ^)
-(def-python-skeleton while
+(python-skeleton-define while nil
"Condition: "
"while " str ":" \n
- > -1 _ \n
- '(python-else) | ^)
+ > _ \n
+ '(python-skeleton--else) | ^)
-(def-python-skeleton for
- "Target, %s: "
- "for " str " in " (skeleton-read "Expression, %s: ") ":" \n
- > -1 _ \n
- '(python-else) | ^)
+(python-skeleton-define for nil
+ "Iteration spec: "
+ "for " str ":" \n
+ > _ \n
+ '(python-skeleton--else) | ^)
-(def-python-skeleton try/except
+(python-skeleton-define try nil
nil
"try:" \n
- > -1 _ \n
+ > _ \n
("Exception, %s: "
- < "except " str '(python-target) ":" \n
+ <
+ "except " str ":" \n
> _ \n nil)
- < "except:" \n
- > _ \n
- '(python-else) | ^)
-
-(define-skeleton python-target
- "Auxiliary skeleton."
- "Target, %s: " ", " str | -2)
-
-(def-python-skeleton try/finally
- nil
- "try:" \n
- > -1 _ \n
- < "finally:" \n
- > _ \n)
-
-(def-python-skeleton def
- "Name: "
- "def " str " (" ("Parameter, %s: " (unless (equal ?\( (char-before)) ", ")
- str) "):" \n
- "\"\"\"" - "\"\"\"" \n ; Fixme: extra space inserted -- why?).
- > _ \n)
-
-(def-python-skeleton class
- "Name: "
+ resume:
+ '(python-skeleton--except)
+ '(python-skeleton--else)
+ '(python-skeleton--finally) | ^)
+
+(python-skeleton-define def nil
+ "Function name: "
+ "def " str " (" ("Parameter, %s: "
+ (unless (equal ?\( (char-before)) ", ")
+ str) "):" \n
+ "\"\"\"" - "\"\"\"" \n
+ > _ \n)
+
+(python-skeleton-define class nil
+ "Class name: "
"class " str " (" ("Inheritance, %s: "
- (unless (equal ?\( (char-before)) ", ")
- str)
- & ")" | -2 ; close list or remove opening
+ (unless (equal ?\( (char-before)) ", ")
+ str)
+ & ")" | -2
":" \n
"\"\"\"" - "\"\"\"" \n
> _ \n)
-(defvar python-default-template "if"
- "Default template to expand by `python-expand-template'.
-Updated on each expansion.")
+(defun python-skeleton-add-menu-items ()
+ "Add menu items to Python->Skeletons menu."
+ (let ((skeletons (sort python-skeleton-available 'string<))
+ (items))
+ (dolist (skeleton skeletons)
+ (easy-menu-add-item
+ nil '("Python" "Skeletons")
+ `[,(format
+ "Insert %s" (caddr (split-string (symbol-name skeleton) "-")))
+ ,skeleton t]))))
+\f
+;;; FFAP
+
+(defcustom python-ffap-setup-code
+ "def __FFAP_get_module_path(module):
+ try:
+ import os
+ path = __import__(module).__file__
+ if path[-4:] == '.pyc' and os.path.exists(path[0:-1]):
+ path = path[:-1]
+ return path
+ except:
+ return ''"
+ "Python code to get a module path."
+ :type 'string
+ :group 'python)
+
+(defcustom python-ffap-string-code
+ "__FFAP_get_module_path('''%s''')\n"
+ "Python code used to get a string with the path of a module."
+ :type 'string
+ :group 'python)
+
+(defun python-ffap-module-path (module)
+ "Function for `ffap-alist' to return path for MODULE."
+ (let ((process (or
+ (and (eq major-mode 'inferior-python-mode)
+ (get-buffer-process (current-buffer)))
+ (python-shell-get-process))))
+ (if (not process)
+ nil
+ (let ((module-file
+ (python-shell-send-string-no-output
+ (format python-ffap-string-code module) process)))
+ (when module-file
+ (substring-no-properties module-file 1 -1))))))
+
+(eval-after-load "ffap"
+ '(progn
+ (push '(python-mode . python-ffap-module-path) ffap-alist)
+ (push '(inferior-python-mode . python-ffap-module-path) ffap-alist)))
-(defun python-expand-template (name)
- "Expand template named NAME.
-Interactively, prompt for the name with completion."
- (interactive
- (list (completing-read (format "Template to expand (default %s): "
- python-default-template)
- python-mode-abbrev-table nil t nil nil
- python-default-template)))
- (if (equal "" name)
- (setq name python-default-template)
- (setq python-default-template name))
- (let ((sym (abbrev-symbol name python-mode-abbrev-table)))
- (if sym
- (abbrev-insert sym)
- (error "Undefined template: %s" name))))
\f
-;;;; Bicycle Repair Man support
-
-(autoload 'pymacs-load "pymacs" nil t)
-(autoload 'brm-init "bikeemacs")
-(defvar brm-menu)
-
-;; I'm not sure how useful BRM really is, and it's certainly dangerous
-;; the way it modifies files outside Emacs... Also note that the
-;; current BRM loses with tabs used for indentation -- I submitted a
-;; fix <URL:http://www.loveshack.ukfsn.org/emacs/bikeemacs.py.diff>.
-(defun python-setup-brm ()
- "Set up Bicycle Repair Man refactoring tool (if available).
-
-Note that the `refactoring' features change files independently of
-Emacs and may modify and save the contents of the current buffer
-without confirmation."
- (interactive)
- (condition-case data
- (unless (fboundp 'brm-rename)
- (pymacs-load "bikeemacs" "brm-") ; first line of normal recipe
- (let ((py-mode-map (make-sparse-keymap)) ; it assumes this
- (features (cons 'python-mode features))) ; and requires this
- (brm-init) ; second line of normal recipe
- (remove-hook 'python-mode-hook ; undo this from `brm-init'
- (lambda () (easy-menu-add brm-menu)))
- (easy-menu-define
- python-brm-menu python-mode-map
- "Bicycle Repair Man"
- '("BicycleRepairMan"
- :help "Interface to navigation and refactoring tool"
- "Queries"
- ["Find References" brm-find-references
- :help "Find references to name at point in compilation buffer"]
- ["Find Definition" brm-find-definition
- :help "Find definition of name at point"]
- "-"
- "Refactoring"
- ["Rename" brm-rename
- :help "Replace name at point with a new name everywhere"]
- ["Extract Method" brm-extract-method
- :active (and mark-active (not buffer-read-only))
- :help "Replace statements in region with a method"]
- ["Extract Local Variable" brm-extract-local-variable
- :active (and mark-active (not buffer-read-only))
- :help "Replace expression in region with an assignment"]
- ["Inline Local Variable" brm-inline-local-variable
- :help
- "Substitute uses of variable at point with its definition"]
- ;; Fixme: Should check for anything to revert.
- ["Undo Last Refactoring" brm-undo :help ""]))))
- (error (error "BicycleRepairMan setup failed: %s" data))))
+;;; Code check
+
+(defcustom python-check-command
+ "pyflakes"
+ "Command used to check a Python file."
+ :type 'string
+ :group 'python)
+
+(defcustom python-check-buffer-name
+ "*Python check: %s*"
+ "Buffer name used for check commands."
+ :type 'string
+ :group 'python)
+
+(defvar python-check-custom-command nil
+ "Internal use.")
+
+(defun python-check (command)
+ "Check a Python file (default current buffer's file).
+Runs COMMAND, a shell command, as if by `compile'. See
+`python-check-command' for the default."
+ (interactive
+ (list (read-string "Check command: "
+ (or python-check-custom-command
+ (concat python-check-command " "
+ (shell-quote-argument
+ (or
+ (let ((name (buffer-file-name)))
+ (and name
+ (file-name-nondirectory name)))
+ "")))))))
+ (setq python-check-custom-command command)
+ (save-some-buffers (not compilation-ask-about-save) nil)
+ (let ((process-environment (python-shell-calculate-process-environment))
+ (exec-path (python-shell-calculate-exec-path)))
+ (compilation-start command nil
+ (lambda (mode-name)
+ (format python-check-buffer-name command)))))
+
\f
-;;;; Modes.
+;;; Eldoc
+
+(defcustom python-eldoc-setup-code
+ "def __PYDOC_get_help(obj):
+ try:
+ import inspect
+ if hasattr(obj, 'startswith'):
+ obj = eval(obj, globals())
+ doc = inspect.getdoc(obj)
+ if not doc and callable(obj):
+ target = None
+ if inspect.isclass(obj) and hasattr(obj, '__init__'):
+ target = obj.__init__
+ objtype = 'class'
+ else:
+ target = obj
+ objtype = 'def'
+ if target:
+ args = inspect.formatargspec(
+ *inspect.getargspec(target)
+ )
+ name = obj.__name__
+ doc = '{objtype} {name}{args}'.format(
+ objtype=objtype, name=name, args=args
+ )
+ else:
+ doc = doc.splitlines()[0]
+ except:
+ doc = ''
+ try:
+ exec('print doc')
+ except SyntaxError:
+ print(doc)"
+ "Python code to setup documentation retrieval."
+ :type 'string
+ :group 'python)
+
+(defcustom python-eldoc-string-code
+ "__PYDOC_get_help('''%s''')\n"
+ "Python code used to get a string with the documentation of an object."
+ :type 'string
+ :group 'python)
+
+(defun python-eldoc--get-doc-at-point (&optional force-input force-process)
+ "Internal implementation to get documentation at point.
+If not FORCE-INPUT is passed then what
+`python-info-current-symbol' returns will be used. If not
+FORCE-PROCESS is passed what `python-shell-get-process' returns
+is used."
+ (let ((process (or force-process (python-shell-get-process))))
+ (if (not process)
+ (error "Eldoc needs an inferior Python process running")
+ (let ((input (or force-input
+ (python-info-current-symbol t))))
+ (and input
+ (python-shell-send-string-no-output
+ (format python-eldoc-string-code input)
+ process))))))
+
+(defun python-eldoc-function ()
+ "`eldoc-documentation-function' for Python.
+For this to work the best as possible you should call
+`python-shell-send-buffer' from time to time so context in
+inferior python process is updated properly."
+ (python-eldoc--get-doc-at-point))
-;; pdb tracking is alert once this file is loaded, but takes no action if
-;; `python-pdbtrack-do-tracking-p' is nil.
-(add-hook 'comint-output-filter-functions 'python-pdbtrack-track-stack-file)
+(defun python-eldoc-at-point (symbol)
+ "Get help on SYMBOL using `help'.
+Interactively, prompt for symbol."
+ (interactive
+ (let ((symbol (python-info-current-symbol t))
+ (enable-recursive-minibuffers t))
+ (list (read-string (if symbol
+ (format "Describe symbol (default %s): " symbol)
+ "Describe symbol: ")
+ nil nil symbol))))
+ (message (python-eldoc--get-doc-at-point symbol)))
-(defvar outline-heading-end-regexp)
-(defvar eldoc-documentation-function)
-(defvar python-mode-running) ;Dynamically scoped var.
+(add-to-list 'debug-ignored-errors
+ "^Eldoc needs an inferior Python process running.")
+
+\f
+;;; Misc helpers
+
+(defun python-info-current-defun (&optional include-type)
+ "Return name of surrounding function with Python compatible dotty syntax.
+Optional argument INCLUDE-TYPE indicates to include the type of the defun.
+This function is compatible to be used as
+`add-log-current-defun-function' since it returns nil if point is
+not inside a defun."
+ (let ((names '())
+ (starting-indentation)
+ (starting-point)
+ (first-run t))
+ (save-restriction
+ (widen)
+ (save-excursion
+ (setq starting-point (point-marker))
+ (setq starting-indentation (save-excursion
+ (python-nav-beginning-of-statement)
+ (current-indentation)))
+ (end-of-line 1)
+ (while (python-beginning-of-defun-function 1)
+ (when (or (< (current-indentation) starting-indentation)
+ (and first-run
+ (<
+ starting-point
+ (save-excursion
+ (python-end-of-defun-function)
+ (point-marker)))))
+ (setq first-run nil)
+ (setq starting-indentation (current-indentation))
+ (looking-at python-nav-beginning-of-defun-regexp)
+ (setq names (cons
+ (if (not include-type)
+ (match-string-no-properties 1)
+ (mapconcat 'identity
+ (split-string
+ (match-string-no-properties 0)) " "))
+ names))))))
+ (when names
+ (mapconcat (lambda (string) string) names "."))))
+
+(defun python-info-current-symbol (&optional replace-self)
+ "Return current symbol using dotty syntax.
+With optional argument REPLACE-SELF convert \"self\" to current
+parent defun name."
+ (let ((name
+ (and (not (python-syntax-comment-or-string-p))
+ (with-syntax-table python-dotty-syntax-table
+ (let ((sym (symbol-at-point)))
+ (and sym
+ (substring-no-properties (symbol-name sym))))))))
+ (when name
+ (if (not replace-self)
+ name
+ (let ((current-defun (python-info-current-defun)))
+ (if (not current-defun)
+ name
+ (replace-regexp-in-string
+ (python-rx line-start word-start "self" word-end ?.)
+ (concat
+ (mapconcat 'identity
+ (butlast (split-string current-defun "\\."))
+ ".") ".")
+ name)))))))
+
+(defsubst python-info-beginning-of-block-statement-p ()
+ "Return non-nil if current statement opens a block."
+ (save-excursion
+ (python-nav-beginning-of-statement)
+ (looking-at (python-rx block-start))))
+
+(defun python-info-closing-block ()
+ "Return the point of the block the current line closes."
+ (let ((closing-word (save-excursion
+ (back-to-indentation)
+ (current-word)))
+ (indentation (current-indentation)))
+ (when (member closing-word python-indent-dedenters)
+ (save-excursion
+ (forward-line -1)
+ (while (and (> (current-indentation) indentation)
+ (not (bobp))
+ (not (back-to-indentation))
+ (forward-line -1)))
+ (back-to-indentation)
+ (cond
+ ((not (equal indentation (current-indentation))) nil)
+ ((string= closing-word "elif")
+ (when (member (current-word) '("if" "elif"))
+ (point-marker)))
+ ((string= closing-word "else")
+ (when (member (current-word) '("if" "elif" "except" "for" "while"))
+ (point-marker)))
+ ((string= closing-word "except")
+ (when (member (current-word) '("try"))
+ (point-marker)))
+ ((string= closing-word "finally")
+ (when (member (current-word) '("except" "else"))
+ (point-marker))))))))
+
+(defun python-info-closing-block-message (&optional closing-block-point)
+ "Message the contents of the block the current line closes.
+With optional argument CLOSING-BLOCK-POINT use that instead of
+recalculating it calling `python-info-closing-block'."
+ (let ((point (or closing-block-point (python-info-closing-block))))
+ (when point
+ (save-restriction
+ (widen)
+ (message "Closes %s" (save-excursion
+ (goto-char point)
+ (back-to-indentation)
+ (buffer-substring
+ (point) (line-end-position))))))))
+
+(defun python-info-line-ends-backslash-p (&optional line-number)
+ "Return non-nil if current line ends with backslash.
+With optional argument LINE-NUMBER, check that line instead."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (when line-number
+ (goto-char line-number))
+ (while (and (not (eobp))
+ (goto-char (line-end-position))
+ (python-syntax-context 'paren)
+ (not (equal (char-before (point)) ?\\)))
+ (forward-line 1))
+ (when (equal (char-before) ?\\)
+ (point-marker)))))
+
+(defun python-info-beginning-of-backslash (&optional line-number)
+ "Return the point where the backslashed line start.
+Optional argument LINE-NUMBER forces the line number to check against."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (when line-number
+ (goto-char line-number))
+ (when (python-info-line-ends-backslash-p)
+ (while (save-excursion
+ (goto-char (line-beginning-position))
+ (python-syntax-context 'paren))
+ (forward-line -1))
+ (back-to-indentation)
+ (point-marker)))))
+
+(defun python-info-continuation-line-p ()
+ "Check if current line is continuation of another.
+When current line is continuation of another return the point
+where the continued line ends."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let* ((context-type (progn
+ (back-to-indentation)
+ (python-syntax-context-type)))
+ (line-start (line-number-at-pos))
+ (context-start (when 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).
+ (python-util-forward-comment -1)
+ (point-marker))
+ ((member context-type '(string comment))
+ ;; move forward an roll again
+ (goto-char context-start)
+ (python-util-forward-comment)
+ (python-info-continuation-line-p))
+ (t
+ ;; Not within a paren, string or comment, the only way
+ ;; we are dealing with a continuation line is that
+ ;; previous line contains a backslash, and this can
+ ;; only be the previous line from current
+ (back-to-indentation)
+ (python-util-forward-comment -1)
+ (when (and (equal (1- line-start) (line-number-at-pos))
+ (python-info-line-ends-backslash-p))
+ (point-marker))))))))
+
+(defun python-info-block-continuation-line-p ()
+ "Return non-nil if current line is a continuation of a block."
+ (save-excursion
+ (when (python-info-continuation-line-p)
+ (forward-line -1)
+ (back-to-indentation)
+ (when (looking-at (python-rx block-start))
+ (point-marker)))))
+
+(defun python-info-assignment-continuation-line-p ()
+ "Check if current line is a continuation of an assignment.
+When current line is continuation of another with an assignment
+return the point of the first non-blank character after the
+operator."
+ (save-excursion
+ (when (python-info-continuation-line-p)
+ (forward-line -1)
+ (back-to-indentation)
+ (when (and (not (looking-at (python-rx block-start)))
+ (and (re-search-forward (python-rx not-simple-operator
+ assignment-operator
+ not-simple-operator)
+ (line-end-position) t)
+ (not (python-syntax-context-type))))
+ (skip-syntax-forward "\s")
+ (point-marker)))))
+
+(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-syntax-context-type (or syntax-ppss (syntax-ppss))))
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at python-nav-beginning-of-defun-regexp))))
+
+(defun python-info-current-line-comment-p ()
+ "Check if current line is a comment line."
+ (char-equal (or (char-after (+ (point) (current-indentation))) ?_) ?#))
+
+(defun python-info-current-line-empty-p ()
+ "Check if current line is empty, ignoring whitespace."
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at
+ (python-rx line-start (* whitespace)
+ (group (* not-newline))
+ (* whitespace) line-end))
+ (string-equal "" (match-string-no-properties 1))))
+\f
+;;; Utility functions
+
+(defun python-util-position (item seq)
+ "Find the first occurrence of ITEM in SEQ.
+Return the index of the matching item, or nil if not found."
+ (let ((member-result (member item seq)))
+ (when member-result
+ (- (length seq) (length member-result)))))
+
+;; Stolen from org-mode
+(defun python-util-clone-local-variables (from-buffer &optional regexp)
+ "Clone local variables from FROM-BUFFER.
+Optional argument REGEXP selects variables to clone and defaults
+to \"^python-\"."
+ (mapc
+ (lambda (pair)
+ (and (symbolp (car pair))
+ (string-match (or regexp "^python-")
+ (symbol-name (car pair)))
+ (set (make-local-variable (car pair))
+ (cdr pair))))
+ (buffer-local-variables from-buffer)))
+
+(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-syntax-context 'comment))
+ (factor (if (< (or direction 0) 0)
+ -99999
+ 99999)))
+ (when comment-start
+ (goto-char comment-start))
+ (forward-comment factor)))
+
+\f
;;;###autoload
(define-derived-mode python-mode prog-mode "Python"
"Major mode for editing Python files.
-Turns on Font Lock mode unconditionally since it is currently required
-for correct parsing of the source.
-See also `jython-mode', which is actually invoked if the buffer appears to
-contain Jython code. See also `run-python' and associated Python mode
-commands for running Python under Emacs.
-
-The Emacs commands which work with `defun's, e.g. \\[beginning-of-defun], deal
-with nested `def' and `class' blocks. They take the innermost one as
-current without distinguishing method and class definitions. Used multiple
-times, they move over others at the same indentation level until they reach
-the end of definitions at that level, when they move up a level.
-\\<python-mode-map>
-Colon is electric: it outdents the line if appropriate, e.g. for
-an else statement. \\[python-backspace] at the beginning of an indented statement
-deletes a level of indentation to close the current block; otherwise it
-deletes a character backward. TAB indents the current line relative to
-the preceding code. Successive TABs, with no intervening command, cycle
-through the possibilities for indentation on the basis of enclosing blocks.
-
-\\[fill-paragraph] fills comments and multi-line strings appropriately, but has no
-effect outside them.
-
-Supports Eldoc mode (only for functions, using a Python process),
-Info-Look and Imenu. In Outline minor mode, `class' and `def'
-lines count as headers. Symbol completion is available in the
-same way as in the Python shell using the `rlcompleter' module
-and this is added to the Hippie Expand functions locally if
-Hippie Expand mode is turned on. Completion of symbols of the
-form x.y only works if the components are literal
-module/attribute names, not variables. An abbrev table is set up
-with skeleton expansions for compound statement templates.
-
-\\{python-mode-map}"
- :group 'python
+
+\\{python-mode-map}
+Entry to this mode calls the value of `python-mode-hook'
+if that value is non-nil."
+ (set (make-local-variable 'tab-width) 8)
+ (set (make-local-variable 'indent-tabs-mode) nil)
+
+ (set (make-local-variable 'comment-start) "# ")
+ (set (make-local-variable 'comment-start-skip) "#+\\s-*")
+
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+
+ (set (make-local-variable 'forward-sexp-function)
+ 'python-nav-forward-sexp)
+
(set (make-local-variable 'font-lock-defaults)
- '(python-font-lock-keywords nil nil nil nil
- ;; This probably isn't worth it.
- ;; (font-lock-syntactic-face-function
- ;; . python-font-lock-syntactic-face-function)
- ))
+ '(python-font-lock-keywords nil nil nil nil))
+
(set (make-local-variable 'syntax-propertize-function)
python-syntax-propertize-function)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'indent-line-function) #'python-indent-line)
+
+ (set (make-local-variable 'indent-line-function)
+ #'python-indent-line-function)
(set (make-local-variable 'indent-region-function) #'python-indent-region)
+
(set (make-local-variable 'paragraph-start) "\\s-*$")
- (set (make-local-variable 'fill-paragraph-function) 'python-fill-paragraph)
- (set (make-local-variable 'require-final-newline) mode-require-final-newline)
- (set (make-local-variable 'add-log-current-defun-function)
- #'python-current-defun)
- (set (make-local-variable 'outline-regexp)
- (rx (* space) (or "class" "def" "elif" "else" "except" "finally"
- "for" "if" "try" "while" "with")
- symbol-end))
- (set (make-local-variable 'outline-heading-end-regexp) ":\\s-*\n")
- (set (make-local-variable 'outline-level) #'python-outline-level)
- (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
+ (set (make-local-variable 'fill-paragraph-function)
+ 'python-fill-paragraph-function)
+
(set (make-local-variable 'beginning-of-defun-function)
- 'python-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function) 'python-end-of-defun)
- (add-hook 'which-func-functions 'python-which-func nil t)
- (setq imenu-create-index-function #'python-imenu-create-index)
+ #'python-beginning-of-defun-function)
+ (set (make-local-variable 'end-of-defun-function)
+ #'python-end-of-defun-function)
+
+ (add-hook 'completion-at-point-functions
+ 'python-completion-complete-at-point nil 'local)
+
+ (add-hook 'post-self-insert-hook
+ 'python-indent-post-self-insert-function nil 'local)
+
+ (set (make-local-variable 'imenu-extract-index-name-function)
+ #'python-info-current-defun)
+
+ (set (make-local-variable 'add-log-current-defun-function)
+ #'python-info-current-defun)
+
+ (add-hook 'which-func-functions #'python-info-current-defun nil t)
+
+ (set (make-local-variable 'skeleton-further-elements)
+ '((abbrev-mode nil)
+ (< '(backward-delete-char-untabify (min python-indent-offset
+ (current-column))))
+ (^ '(- (1+ (current-indentation))))))
+
(set (make-local-variable 'eldoc-documentation-function)
#'python-eldoc-function)
- (add-hook 'eldoc-mode-hook
- (lambda () (run-python nil t)) ; need it running
- nil t)
- (add-hook 'completion-at-point-functions
- 'python-completion-at-point nil 'local)
- ;; Fixme: should be in hideshow. This seems to be of limited use
- ;; since it isn't (can't be) indentation-based. Also hide-level
- ;; doesn't seem to work properly.
+
(add-to-list 'hs-special-modes-alist
- `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#"
- ,(lambda (_arg)
- (python-end-of-defun)
- (skip-chars-backward " \t\n"))
- nil))
- (set (make-local-variable 'skeleton-further-elements)
- '((< '(backward-delete-char-untabify (min python-indent
- (current-column))))
- (^ '(- (1+ (current-indentation))))))
- ;; Python defines TABs as being 8-char wide.
- (set (make-local-variable 'tab-width) 8)
- (when python-guess-indent (python-guess-indent))
- ;; Let's make it harder for the user to shoot himself in the foot.
- (unless (= tab-width python-indent)
- (setq indent-tabs-mode nil))
- (set (make-local-variable 'python-command) python-python-command)
- (python-find-imports)
- (unless (boundp 'python-mode-running) ; kill the recursion from jython-mode
- (let ((python-mode-running t))
- (python-maybe-jython))))
-
-;; Not done automatically in Emacs 21 or 22.
-(defcustom python-mode-hook nil
- "Hook run when entering Python mode."
- :group 'python
- :type 'hook)
-(custom-add-option 'python-mode-hook 'imenu-add-menubar-index)
-(custom-add-option 'python-mode-hook
- (lambda ()
- "Turn off Indent Tabs mode."
- (setq indent-tabs-mode nil)))
-(custom-add-option 'python-mode-hook 'turn-on-eldoc-mode)
-(custom-add-option 'python-mode-hook 'abbrev-mode)
-(custom-add-option 'python-mode-hook 'python-setup-brm)
+ `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#"
+ ,(lambda (arg)
+ (python-end-of-defun-function)) nil))
-;;;###autoload
-(define-derived-mode jython-mode python-mode "Jython"
- "Major mode for editing Jython files.
-Like `python-mode', but sets up parameters for Jython subprocesses.
-Runs `jython-mode-hook' after `python-mode-hook'."
- :group 'python
- (set (make-local-variable 'python-command) python-jython-command))
+ (set (make-local-variable 'mode-require-final-newline) t)
-\f
+ (set (make-local-variable 'outline-regexp)
+ (python-rx (* space) block-start))
+ (set (make-local-variable 'outline-heading-end-regexp) ":\\s-*\n")
+ (set (make-local-variable 'outline-level)
+ #'(lambda ()
+ "`outline-level' function for Python mode."
+ (1+ (/ (current-indentation) python-indent-offset))))
-;; pdbtrack features
-
-(defun python-pdbtrack-overlay-arrow (activation)
- "Activate or deactivate arrow at beginning-of-line in current buffer."
- (if activation
- (progn
- (setq overlay-arrow-position (make-marker)
- overlay-arrow-string "=>"
- python-pdbtrack-is-tracking-p t)
- (set-marker overlay-arrow-position
- (line-beginning-position)
- (current-buffer)))
- (setq overlay-arrow-position nil
- python-pdbtrack-is-tracking-p nil)))
-
-(defun python-pdbtrack-track-stack-file (_text)
- "Show the file indicated by the pdb stack entry line, in a separate window.
-
-Activity is disabled if the buffer-local variable
-`python-pdbtrack-do-tracking-p' is nil.
-
-We depend on the pdb input prompt being a match for
-`python-pdbtrack-input-prompt'.
-
-If the traceback target file path is invalid, we look for the
-most recently visited python-mode buffer which either has the
-name of the current function or class, or which defines the
-function or class. This is to provide for scripts not in the
-local file system (e.g., Zope's 'Script \(Python)', but it's not
-Zope specific). If you put a copy of the script in a buffer
-named for the script and activate python-mode, then pdbtrack will
-find it."
- ;; Instead of trying to piece things together from partial text
- ;; (which can be almost useless depending on Emacs version), we
- ;; monitor to the point where we have the next pdb prompt, and then
- ;; check all text from comint-last-input-end to process-mark.
- ;;
- ;; Also, we're very conservative about clearing the overlay arrow,
- ;; to minimize residue. This means, for instance, that executing
- ;; other pdb commands wipe out the highlight. You can always do a
- ;; 'where' (aka 'w') PDB command to reveal the overlay arrow.
-
- (let* ((origbuf (current-buffer))
- (currproc (get-buffer-process origbuf)))
-
- (if (not (and currproc python-pdbtrack-do-tracking-p))
- (python-pdbtrack-overlay-arrow nil)
-
- (let* ((procmark (process-mark currproc))
- (block (buffer-substring (max comint-last-input-end
- (- procmark
- python-pdbtrack-track-range))
- procmark))
- target target_fname target_lineno target_buffer)
-
- (if (not (string-match (concat python-pdbtrack-input-prompt "$") block))
- (python-pdbtrack-overlay-arrow nil)
-
- (setq block (ansi-color-filter-apply block))
- (setq target (python-pdbtrack-get-source-buffer block))
-
- (if (stringp target)
- (progn
- (python-pdbtrack-overlay-arrow nil)
- (message "pdbtrack: %s" target))
-
- (setq target_lineno (car target)
- target_buffer (cadr target)
- target_fname (buffer-file-name target_buffer))
- (switch-to-buffer-other-window target_buffer)
- (goto-char (point-min))
- (forward-line (1- target_lineno))
- (message "pdbtrack: line %s, file %s" target_lineno target_fname)
- (python-pdbtrack-overlay-arrow t)
- (pop-to-buffer origbuf t)
- ;; in large shell buffers, above stuff may cause point to lag output
- (goto-char procmark)
- )))))
- )
-
-(defun python-pdbtrack-get-source-buffer (block)
- "Return line number and buffer of code indicated by block's traceback text.
-
-We look first to visit the file indicated in the trace.
-
-Failing that, we look for the most recently visited python-mode buffer
-with the same name or having the named function.
-
-If we're unable find the source code we return a string describing the
-problem."
-
- (if (not (string-match python-pdbtrack-stack-entry-regexp block))
-
- "Traceback cue not found"
-
- (let* ((filename (match-string 1 block))
- (lineno (string-to-number (match-string 2 block)))
- (funcname (match-string 3 block))
- funcbuffer)
-
- (cond ((file-exists-p filename)
- (list lineno (find-file-noselect filename)))
-
- ((setq funcbuffer (python-pdbtrack-grub-for-buffer funcname lineno))
- (if (string-match "/Script (Python)$" filename)
- ;; Add in number of lines for leading '##' comments:
- (setq lineno
- (+ lineno
- (with-current-buffer funcbuffer
- (if (equal (point-min)(point-max))
- 0
- (count-lines
- (point-min)
- (max (point-min)
- (string-match "^\\([^#]\\|#[^#]\\|#$\\)"
- (buffer-substring
- (point-min) (point-max)))
- )))))))
- (list lineno funcbuffer))
-
- ((= (elt filename 0) ?\<)
- (format "(Non-file source: '%s')" filename))
-
- (t (format "Not found: %s(), %s" funcname filename)))
- )
- )
- )
-
-(defun python-pdbtrack-grub-for-buffer (funcname _lineno)
- "Find recent Python mode buffer named, or having function named FUNCNAME."
- (let ((buffers (buffer-list))
- buf
- got)
- (while (and buffers (not got))
- (setq buf (car buffers)
- buffers (cdr buffers))
- (if (and (with-current-buffer buf
- (string= major-mode "python-mode"))
- (or (string-match funcname (buffer-name buf))
- (string-match (concat "^\\s-*\\(def\\|class\\)\\s-+"
- funcname "\\s-*(")
- (with-current-buffer buf
- (buffer-substring (point-min)
- (point-max))))))
- (setq got buf)))
- got))
-
-;; Python subprocess utilities and filters
-(defun python-execute-file (proc filename)
- "Send to Python interpreter process PROC \"execfile('FILENAME')\".
-Make that process's buffer visible and force display. Also make
-comint believe the user typed this string so that
-`kill-output-from-shell' does The Right Thing."
- (let ((curbuf (current-buffer))
- (procbuf (process-buffer proc))
-; (comint-scroll-to-bottom-on-output t)
- (msg (format "## working on region in file %s...\n" filename))
- ;; add some comment, so that we can filter it out of history
- (cmd (format "execfile(r'%s') # PYTHON-MODE\n" filename)))
- (unwind-protect
- (with-current-buffer procbuf
- (goto-char (point-max))
- (move-marker (process-mark proc) (point))
- (funcall (process-filter proc) proc msg))
- (set-buffer curbuf))
- (process-send-string proc cmd)))
-
-(defun python-pdbtrack-toggle-stack-tracking (arg)
- (interactive "P")
- (if (not (get-buffer-process (current-buffer)))
- (error "No process associated with buffer '%s'" (current-buffer)))
- ;; missing or 0 is toggle, >0 turn on, <0 turn off
- (if (or (not arg)
- (zerop (setq arg (prefix-numeric-value arg))))
- (setq python-pdbtrack-do-tracking-p (not python-pdbtrack-do-tracking-p))
- (setq python-pdbtrack-do-tracking-p (> arg 0)))
- (message "%sabled Python's pdbtrack"
- (if python-pdbtrack-do-tracking-p "En" "Dis")))
-
-(defun turn-on-pdbtrack ()
- (interactive)
- (python-pdbtrack-toggle-stack-tracking 1))
+ (python-skeleton-add-menu-items)
-(defun turn-off-pdbtrack ()
- (interactive)
- (python-pdbtrack-toggle-stack-tracking 0))
+ (make-local-variable 'python-shell-internal-buffer)
-(defun python-sentinel (_proc _msg)
- (setq overlay-arrow-position nil))
+ (when python-indent-guess-indent-offset
+ (python-indent-guess-indent-offset)))
-(defun python-unload-function ()
- "Unload the Python library."
- (remove-hook 'comint-output-filter-functions 'python-pdbtrack-track-stack-file)
- (setq minor-mode-alist (assq-delete-all 'python-pdbtrack-is-tracking-p
- minor-mode-alist))
- (dolist (error '("^No symbol" "^Can't shift all lines enough"))
- (setq debug-ignored-errors (delete error debug-ignored-errors)))
- ;; continue standard unloading
- nil)
(provide 'python)
-(provide 'python-21)
+
+;; Local Variables:
+;; coding: utf-8
+;; indent-tabs-mode: nil
+;; End:
;;; python.el ends here
"Regexp to match keywords that nest without blocks.")
(defconst ruby-indent-beg-re
- (concat "\\(\\s *" (regexp-opt '("class" "module" "def") t) "\\)\\|"
- (regexp-opt '("if" "unless" "case" "while" "until" "for" "begin")))
+ (concat "^\\s *" (regexp-opt '("class" "module" "def" "if" "unless" "case"
+ "while" "until" "for" "begin")) "\\_>")
"Regexp to match where the indentation gets deeper.")
(defconst ruby-modifier-beg-keywords
(defconst ruby-block-end-re "\\_<end\\_>")
+(defconst ruby-defun-beg-re
+ '"\\(def\\|class\\|module\\)"
+ "Regexp to match the beginning of a defun, in the general sense.")
+
(eval-and-compile
(defconst ruby-here-doc-beg-re
"\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
(defvar ruby-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "{" 'ruby-electric-brace)
- (define-key map "}" 'ruby-electric-brace)
- (define-key map (kbd "M-C-a") 'ruby-beginning-of-defun)
- (define-key map (kbd "M-C-e") 'ruby-end-of-defun)
(define-key map (kbd "M-C-b") 'ruby-backward-sexp)
(define-key map (kbd "M-C-f") 'ruby-forward-sexp)
(define-key map (kbd "M-C-p") 'ruby-beginning-of-block)
(define-key map (kbd "M-C-n") 'ruby-end-of-block)
- (define-key map (kbd "M-C-h") 'ruby-mark-defun)
(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.")
((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
(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 "[!?]")
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)
(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))
(goto-char pnt))
((looking-at ":\\(['\"]\\)")
(goto-char (match-beginning 1))
- (ruby-forward-string (buffer-substring (match-beginning 1) (match-end 1)) end))
+ (ruby-forward-string (match-string 1) end t))
((looking-at ":\\([-,.+*/%&|^~<>]=?\\|===?\\|<=>\\|![~=]?\\)")
(goto-char (match-end 0)))
((looking-at ":\\([a-zA-Z_][a-zA-Z_0-9]*[!?=]?\\)?")
(not (looking-at "[a-z_]"))))
(and (looking-at ruby-operator-re)
(not (ruby-special-char-p))
- ;; operator at the end of line
+ ;; Operator at the end of line.
(let ((c (char-after (point))))
(and
;; (or (null begin)
;; (not (or (eolp) (looking-at "#")
;; (and (eq (car (nth 1 state)) ?{)
;; (looking-at "|"))))))
- (or (not (eq ?/ c))
- (null (nth 0 (ruby-parse-region (or begin parse-start) (point)))))
+ ;; Not a regexp or percent literal.
+ (null (nth 0 (ruby-parse-region (or begin parse-start)
+ (point))))
(or (not (eq ?| (char-after (point))))
(save-excursion
(or (eolp) (forward-char -1))
(+ indent ruby-indent-level)
indent))))
-(defun ruby-electric-brace (arg)
- "Insert a brace and re-indent the current line."
- (interactive "P")
- (self-insert-command (prefix-numeric-value arg))
- (ruby-indent-line t))
-
-;; TODO: Why isn't one ruby-*-of-defun written in terms of the other?
(defun ruby-beginning-of-defun (&optional arg)
"Move backward to the beginning of the current top-level defun.
With ARG, move backward multiple defuns. Negative ARG means
move forward."
(interactive "p")
- (and (re-search-backward (concat "^\\(" ruby-block-beg-re "\\)\\b")
- nil 'move (or arg 1))
+ (and (re-search-backward (concat "^\\s *" ruby-defun-beg-re "\\_>")
+ nil t (or arg 1))
(beginning-of-line)))
(defun ruby-end-of-defun (&optional arg)
With ARG, move forward multiple defuns. Negative ARG means
move backward."
(interactive "p")
- (and (re-search-forward (concat "^\\(" ruby-block-end-re "\\)\\($\\|\\b[^_]\\)")
- nil 'move (or arg 1))
- (beginning-of-line))
- (forward-line 1))
+ (ruby-forward-sexp)
+ (when (looking-back (concat "^\\s *" ruby-block-end-re))
+ (forward-line 1)))
(defun ruby-beginning-of-indent ()
- "TODO: document"
- ;; I don't understand this function.
- ;; It seems like it should move to the line where indentation should deepen,
- ;; but ruby-indent-beg-re only accounts for whitespace before class, module and def,
- ;; so this will only match other block beginners at the beginning of the line.
- (and (re-search-backward (concat "^\\(" ruby-indent-beg-re "\\)\\_>") nil 'move)
- (beginning-of-line)))
+ "Backtrack to a line which can be used as a reference for
+calculating indentation on the lines after it."
+ (while (and (re-search-backward ruby-indent-beg-re nil 'move)
+ (if (ruby-in-ppss-context-p 'anything)
+ t
+ ;; We can stop, then.
+ (beginning-of-line)))))
(defun ruby-move-to-block (n)
"Move to the beginning (N < 0) or the end (N > 0) of 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
(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.
((error)))
i)))
-(defun ruby-mark-defun ()
- "Put mark at end of this Ruby function, point at beginning."
- (interactive)
- (push-mark (point))
- (ruby-end-of-defun)
- (push-mark (point) nil t)
- (ruby-beginning-of-defun)
- (re-search-backward "^\n" (- (point) 1) t))
-
(defun ruby-indent-exp (&optional ignored)
"Indent each line in the balanced expression following the point."
(interactive "*P")
(let (mname mlist (indent 0))
;; get current method (or class/module)
(if (re-search-backward
- (concat "^[ \t]*\\(def\\|class\\|module\\)[ \t]+"
+ (concat "^[ \t]*" ruby-defun-beg-re "[ \t]+"
"\\("
;; \\. and :: for class method
"\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)"
(if mlist (concat mlist mname) mname)
mlist)))))
+(defun ruby-brace-to-do-end (orig end)
+ (let (beg-marker end-marker)
+ (goto-char end)
+ (when (eq (char-before) ?\})
+ (delete-char -1)
+ (when (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp)))
+ (insert "\n"))
+ (insert "end")
+ (setq end-marker (point-marker))
+ (when (and (not (eobp)) (eq (char-syntax (char-after)) ?w))
+ (insert " "))
+ (goto-char orig)
+ (delete-char 1)
+ (when (eq (char-syntax (char-before)) ?w)
+ (insert " "))
+ (insert "do")
+ (setq beg-marker (point-marker))
+ (when (looking-at "\\(\\s \\)*|")
+ (unless (match-beginning 1)
+ (insert " "))
+ (goto-char (1+ (match-end 0)))
+ (search-forward "|"))
+ (unless (looking-at "\\s *$")
+ (insert "\n"))
+ (indent-region beg-marker end-marker)
+ (goto-char beg-marker)
+ t)))
+
+(defun ruby-do-end-to-brace (orig end)
+ (let (beg-marker end-marker beg-pos end-pos)
+ (goto-char (- end 3))
+ (when (looking-at ruby-block-end-re)
+ (delete-char 3)
+ (setq end-marker (point-marker))
+ (insert "}")
+ (goto-char orig)
+ (delete-char 2)
+ (insert "{")
+ (setq beg-marker (point-marker))
+ (when (looking-at "\\s +|")
+ (delete-char (- (match-end 0) (match-beginning 0) 1))
+ (forward-char)
+ (re-search-forward "|" (line-end-position) t))
+ (save-excursion
+ (skip-chars-forward " \t\n\r")
+ (setq beg-pos (point))
+ (goto-char end-marker)
+ (skip-chars-backward " \t\n\r")
+ (setq end-pos (point)))
+ (when (or
+ (< end-pos beg-pos)
+ (and (= (line-number-at-pos beg-pos) (line-number-at-pos end-pos))
+ (< (+ (current-column) (- end-pos beg-pos) 2) fill-column)))
+ (just-one-space -1)
+ (goto-char end-marker)
+ (just-one-space -1))
+ (goto-char beg-marker)
+ t)))
+
+(defun ruby-toggle-block ()
+ "Toggle block type from do-end to braces or back.
+The block must begin on the current line or above it and end after the point.
+If the result is do-end block, it will always be multiline."
+ (interactive)
+ (let ((start (point)) beg end)
+ (end-of-line)
+ (unless
+ (if (and (re-search-backward "\\({\\)\\|\\_<do\\(\\s \\|$\\||\\)")
+ (progn
+ (setq beg (point))
+ (save-match-data (ruby-forward-sexp))
+ (setq end (point))
+ (> end start)))
+ (if (match-beginning 1)
+ (ruby-brace-to-do-end beg end)
+ (ruby-do-end-to-brace beg end)))
+ (goto-char start))))
+
(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit))
+(declare-function ruby-syntax-enclosing-percent-literal "ruby-mode" (limit))
+(declare-function ruby-syntax-propertize-percent-literal "ruby-mode" (limit))
(if (eval-when-compile (fboundp #'syntax-propertize-rules))
;; New code that works independently from font-lock.
(progn
+ (eval-and-compile
+ (defconst ruby-percent-literal-beg-re
+ "\\(%\\)[qQrswWx]?\\([[:punct:]]\\)"
+ "Regexp to match the beginning of percent literal.")
+
+ (defconst ruby-syntax-methods-before-regexp
+ '("gsub" "gsub!" "sub" "sub!" "scan" "split" "split!" "index" "match"
+ "assert_match" "Given" "Then" "When")
+ "Methods that can take regexp as the first argument.
+It will be properly highlighted even when the call omits parens."))
+
(defun ruby-syntax-propertize-function (start end)
"Syntactic keywords for Ruby mode. See `syntax-propertize-function'."
(goto-char start)
(ruby-syntax-propertize-heredoc end)
+ (ruby-syntax-enclosing-percent-literal end)
(funcall
(syntax-propertize-rules
- ;; #{ }, #$hoge, #@foo are not comments
- ("\\(#\\)[{$@]" (1 "."))
- ;; $' $" $` .... are variables
- ;; ?' ?" ?` are ascii codes
+ ;; $' $" $` .... are variables.
+ ;; ?' ?" ?` are ascii codes.
("\\([?$]\\)[#\"'`]"
(1 (unless (save-excursion
;; Not within a string.
(nth 3 (syntax-ppss (match-beginning 0))))
(string-to-syntax "\\"))))
- ;; regexps
- ("\\(^\\|[[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
- (4 "\"/")
- (6 "\"/"))
+ ;; Regexps: regexps are distinguished from division because
+ ;; of the keyword, symbol, or method name before them.
+ ((concat
+ ;; Special tokens that can't be followed by a division operator.
+ "\\(^\\|[[=(,~?:;<>]"
+ ;; Control flow keywords and operators following bol or whitespace.
+ "\\|\\(?:^\\|\\s \\)"
+ (regexp-opt '("if" "elsif" "unless" "while" "until" "when" "and"
+ "or" "not" "&&" "||"))
+ ;; Method name from the list.
+ "\\|\\_<"
+ (regexp-opt ruby-syntax-methods-before-regexp)
+ "\\)\\s *"
+ ;; The regular expression itself.
+ "\\(/\\)[^/\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.
+ ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re)
+ (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end)))))
(point) end))
(defun ruby-syntax-propertize-heredoc (limit)
(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.
;; Make extra sure we don't move back, lest we could fall into an
;; inf-loop.
(if (< (point) start) (goto-char start))))))
+
+ (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))
+ (when (looking-at ruby-percent-literal-beg-re)
+ (ruby-syntax-propertize-percent-literal limit))
+ (when (< (point) start) (goto-char start)))))
+
+ (defun ruby-syntax-propertize-percent-literal (limit)
+ (goto-char (match-beginning 2))
+ ;; 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,
(concat "-?\\([\"']\\|\\)" contents "\\1"))))))
(defconst ruby-font-lock-syntactic-keywords
- `( ;; #{ }, #$hoge, #@foo are not comments
- ("\\(#\\)[{$@]" 1 (1 . nil))
+ `(
;; the last $', $", $` in the respective string is not variable
;; the last ?', ?", ?` in the respective string is not ascii code
("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
(4 (7 . ?/))
(6 (7 . ?/)))
("^=en\\(d\\)\\_>" 1 "!")
+ ;; Percent literal.
+ ("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)"
+ (3 "\"")
+ (5 "\""))
("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
;; Currently, the following case is highlighted incorrectly:
;;
(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)))))))
;; variables
'("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>"
2 font-lock-variable-name-face)
+ ;; symbols
+ '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
+ 2 font-lock-constant-face)
;; variables
'("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W"
1 font-lock-variable-name-face)
'("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+"
0 font-lock-variable-name-face)
- ;; general delimited string
- '("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)"
- (2 font-lock-string-face))
;; constants
'("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)"
2 font-lock-type-face)
- ;; symbols
- '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
- 2 font-lock-reference-face)
- '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-reference-face)
+ '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face)
;; expression expansion
- '("#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)"
+ '(ruby-match-expression-expansion
0 font-lock-variable-name-face t)
;; warn lower camel case
;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)"
)
"Additional expressions to highlight in Ruby mode.")
+(defun ruby-match-expression-expansion (limit)
+ (when (re-search-forward "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)" limit 'move)
+ (or (ruby-in-ppss-context-p 'string)
+ (ruby-match-expression-expansion limit))))
+
;;;###autoload
(define-derived-mode ruby-mode prog-mode "Ruby"
"Major mode for editing Ruby scripts.
'ruby-imenu-create-index)
(set (make-local-variable 'add-log-current-defun-function)
'ruby-add-log-current-method)
+ (set (make-local-variable 'beginning-of-defun-function)
+ 'ruby-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ 'ruby-end-of-defun)
(add-hook
(cond ((boundp 'before-save-hook) 'before-save-hook)
In addition, if an inferior Scheme process is running, some additional
commands will be defined, for evaluating expressions and controlling
the interpreter, and the state of the process will be displayed in the
-modeline of all Scheme buffers. The names of commands that interact
+mode line of all Scheme buffers. The names of commands that interact
with the Scheme process start with \"xscheme-\" if you use the MIT
Scheme-specific `xscheme' package; for more information see the
documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to
(defcustom dsssl-sgml-declaration
"<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
"
- "*An SGML declaration for the DSSSL file.
+ "An SGML declaration for the DSSSL file.
If it is defined as a string this will be inserted into an empty buffer
which is in `dsssl-mode'. It is typically James Clark's style-sheet
doctype, as required for Jade."
;; This is shared by cmuscheme and xscheme.
(defcustom scheme-program-name "scheme"
- "*Program invoked by the `run-scheme' command."
+ "Program invoked by the `run-scheme' command."
:type 'string
:group 'scheme)
(eval-when-compile
(require 'skeleton)
- (require 'cl)
+ (require 'cl-lib)
(require 'comint))
(require 'executable)
(defcustom sh-imenu-generic-expression
`((sh
- . ((nil "^\\s-*\\(function\\s-+\\)?\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()" 2))))
+ . ((nil
+ ;; function FOO
+ ;; function FOO()
+ "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*\\(?:()\\)?"
+ 1)
+ ;; FOO()
+ (nil
+ "^\\s-*\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()"
+ 1)
+ )))
"Alist of regular expressions for recognizing shell function definitions.
See `sh-feature' and `imenu-generic-expression'."
:type '(alist :key-type (symbol :tag "Shell")
(define-key map "\C-c+" 'sh-add)
(define-key map "\C-\M-x" 'sh-execute-region)
(define-key map "\C-c\C-x" 'executable-interpret)
- ;; FIXME: Use post-self-insert-hook.
- (define-key map "<" 'sh-maybe-here-document)
- (define-key map "(" 'skeleton-pair-insert-maybe)
- (define-key map "{" 'skeleton-pair-insert-maybe)
- (define-key map "[" 'skeleton-pair-insert-maybe)
- (define-key map "'" 'skeleton-pair-insert-maybe)
- (define-key map "`" 'skeleton-pair-insert-maybe)
- (define-key map "\"" 'skeleton-pair-insert-maybe)
(define-key map [remap delete-backward-char]
'backward-delete-char-untabify)
(define-key map [menu-bar sh-script] (cons "Sh-Script" menu-map))
(define-key menu-map [sh-learn-buffer-indent]
'(menu-item "Learn buffer indentation" sh-learn-buffer-indent
- :help "Learn how to indent the buffer the way it currently is."))
+ :help "Learn how to indent the buffer the way it currently is."))
(define-key menu-map [sh-learn-line-indent]
'(menu-item "Learn line indentation" sh-learn-line-indent
- :help "Learn how to indent a line as it currently is indented"))
+ :help "Learn how to indent a line as it currently is indented"))
(define-key menu-map [sh-show-indent]
'(menu-item "Show indentation" sh-show-indent
:help "Show the how the current line would be indented"))
(define-key menu-map [sh-pair]
'(menu-item "Insert braces and quotes in pairs"
- (lambda ()
- (interactive)
- (require 'skeleton)
- (setq skeleton-pair (not skeleton-pair)))
- :button (:toggle . (and (boundp 'skeleton-pair)
- skeleton-pair))
- :help "Inserting a brace or quote automatically inserts the matching pair"))
+ electric-pair-mode
+ :button (:toggle . (bound-and-true-p electric-pair-mode))
+ :help "Inserting a brace or quote automatically inserts the matching pair"))
(define-key menu-map [sh-s0] '("--"))
;; Insert
:help "Insert a function definition"))
(define-key menu-map [sh-add]
'(menu-item "Addition..." sh-add
- :help "Insert an addition of VAR and prefix DELTA for Bourne (type) shell"))
+ :help "Insert an addition of VAR and prefix DELTA for Bourne (type) shell"))
(define-key menu-map [sh-until]
'(menu-item "Until Loop" sh-until
:help "Insert an until loop"))
(define-key menu-map [sh-s1] '("--"))
(define-key menu-map [sh-exec]
'(menu-item "Execute region" sh-execute-region
- :help "Pass optional header and region to a subshell for noninteractive execution"))
+ :help "Pass optional header and region to a subshell for noninteractive execution"))
(define-key menu-map [sh-exec-interpret]
'(menu-item "Execute script..." executable-interpret
- :help "Run script with user-specified args, and collect output in a buffer"))
+ :help "Run script with user-specified args, and collect output in a buffer"))
(define-key menu-map [sh-set-shell]
'(menu-item "Set shell type..." sh-set-shell
:help "Set this buffer's shell to SHELL (a string)"))
(define-key menu-map [sh-backslash-region]
'(menu-item "Backslash region" sh-backslash-region
- :help "Insert, align, or delete end-of-line backslashes on the lines in the region."))
+ :help "Insert, align, or delete end-of-line backslashes on the lines in the region."))
map)
"Keymap used in Shell-Script mode.")
:group 'sh-script)
(defcustom sh-assignment-regexp
- '((csh . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=")
+ `((csh . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=")
;; actually spaces are only supported in let/(( ... ))
- (ksh88 . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=")
+ (ksh88 . ,(concat "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?"
+ "[ \t]*\\(?:[-+*/%&|~^]\\|<<\\|>>\\)?="))
(bash . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?\\+?=")
(rc . "\\<\\([[:alnum:]_*]+\\)[ \t]*=")
(sh . "\\<\\([[:alnum:]_]+\\)="))
(while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit)
(< (point) limit)))
;; unescape " inside a $( ... ) construct.
- (case (char-after)
- (?\' (case state
- (double-quote nil)
- (t (forward-char 1) (skip-chars-forward "^'" limit))))
+ (pcase (char-after)
+ (?\' (pcase state
+ (`double-quote nil)
+ (_ (forward-char 1) (skip-chars-forward "^'" limit))))
(?\\ (forward-char 1))
- (?\" (case state
- (double-quote (setq state (pop states)))
- (t (push state states) (setq state 'double-quote)))
+ (?\" (pcase state
+ (`double-quote (setq state (pop states)))
+ (_ (push state states) (setq state 'double-quote)))
(if state (put-text-property (point) (1+ (point))
'syntax-table '(1))))
- (?\` (case state
- (backquote (setq state (pop states)))
- (t (push state states) (setq state 'backquote))))
+ (?\` (pcase state
+ (`backquote (setq state (pop states)))
+ (_ (push state states) (setq state 'backquote))))
(?\$ (if (not (eq (char-after (1+ (point))) ?\())
nil
(forward-char 1)
- (case state
- (t (push state states) (setq state 'code)))))
- (?\( (case state
- (double-quote nil)
- (t (push state states) (setq state 'code))))
- (?\) (case state
- (double-quote nil)
- (t (setq state (pop states)))))
- (t (error "Internal error in sh-font-lock-quoted-subshell")))
+ (pcase state
+ (_ (push state states) (setq state 'code)))))
+ (?\( (pcase state
+ (`double-quote nil)
+ (_ (push state states) (setq state 'code))))
+ (?\) (pcase state
+ (`double-quote nil)
+ (_ (setq state (pop states)))))
+ (_ (error "Internal error in sh-font-lock-quoted-subshell")))
(forward-char 1)))))
;; metacharacters. The list of special chars is taken from
;; the single-unix spec of the shell command language (under
;; `quoting') but with `$' removed.
- ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
+ ("\\(?:[^|&;<>()`\\\"' \t\n]\\|\\${\\)\\(#+\\)" (1 "_"))
;; In a '...' the backslash is not escaping.
("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
;; Make sure $@ and $? are correctly recognized as sexps.
(save-excursion
(sh-font-lock-quoted-subshell end)))))))
(point) end))
-
(defun sh-font-lock-syntactic-face-function (state)
(let ((q (nth 3 state)))
(if q
(defconst sh-indent-supported
- '((sh . t)
+ '((sh . sh)
(csh . nil)
- (rc . t))
- "Shell types that shell indenting can do something with.")
+ (rc . rc))
+ "Indentation rule set to use for each shell type.")
(defvar sh-indent-supported-here nil
"Non-nil if we support indentation for the current buffer's shell type.")
values of variables, and for the commands using indentation styles.")
(defvar sh-make-vars-local t
- "*Controls whether indentation variables are local to the buffer.
+ "Controls whether indentation variables are local to the buffer.
If non-nil, indentation variables are made local initially.
If nil, you can later make the variables local by invoking
command `sh-make-vars-local'.
\\[sh-set-shell] Set this buffer's shell, and maybe its magic number.
\\[sh-execute-region] Have optional header and region be executed in a subshell.
-\\[sh-maybe-here-document] Without prefix, following an unquoted < inserts here document.
-\{, (, [, ', \", `
- Unless quoted with \\, insert the pairs {}, (), [], or '', \"\", ``.
+`sh-electric-here-document-mode' controls whether insertion of two
+unquoted < insert a here document.
If you generally program a shell different from your login shell you can
set `sh-shell-file' accordingly. If your shell's file name doesn't correctly
#'sh-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
+ (sh-electric-here-document-mode 1)
(set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`)))
(set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p)
(set (make-local-variable 'skeleton-further-elements)
'((< '(- (min sh-indentation (current-column))))))
(set (make-local-variable 'skeleton-filter-function) 'sh-feature)
(set (make-local-variable 'skeleton-newline-indent-rigidly) t)
- (set (make-local-variable 'sh-indent-supported-here) nil)
(set (make-local-variable 'defun-prompt-regexp)
(concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)"))
;; Parse or insert magic number for exec, and set all variables depending
(goto-char (point-min))
(looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)"))
(match-string 2))
- ((not buffer-file-name)
- sh-shell-file)
+ ((not buffer-file-name) sh-shell-file)
;; Checks that use `buffer-file-name' follow.
- ((string-match "\\.m?spec\\'" buffer-file-name)
- "rpm")
- ((string-match "[.]sh\\>" buffer-file-name)
- "sh")
- ((string-match "[.]bash\\>" buffer-file-name)
- "bash")
- ((string-match "[.]ksh\\>" buffer-file-name)
- "ksh")
- ((string-match "[.]csh\\>" buffer-file-name)
- "csh")
- ((equal (file-name-nondirectory buffer-file-name) ".profile")
- "sh")
- (t
- sh-shell-file))
+ ((string-match "\\.m?spec\\'" buffer-file-name) "rpm")
+ ((string-match "[.]sh\\>" buffer-file-name) "sh")
+ ((string-match "[.]bash\\>" buffer-file-name) "bash")
+ ((string-match "[.]ksh\\>" buffer-file-name) "ksh")
+ ((string-match "[.]csh\\>" buffer-file-name) "csh")
+ ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh")
+ (t sh-shell-file))
nil nil))
;;;###autoload
"Function to get better fontification including keywords and builtins."
(sh-font-lock-keywords-1 t))
+;;; Indentation and navigation with SMIE.
+
+(require 'smie)
+
+;; The SMIE code should generally be preferred, but it currently does not obey
+;; the various indentation custom-vars, and it misses some important features
+;; of the old code, mostly: sh-learn-line/buffer-indent, sh-show-indent,
+;; sh-name/save/load-style.
+(defvar sh-use-smie nil
+ "Whether to use the SMIE code for navigation and indentation.")
+
+(defun sh-smie--keyword-p (tok)
+ "Non-nil if TOK (at which we're looking) really is a keyword."
+ (let ((prev (funcall smie-backward-token-function)))
+ (if (zerop (length prev))
+ (looking-back "\\s(" (1- (point)))
+ (assoc prev smie-grammar))))
+
+(defun sh-smie--newline-semi-p (&optional tok)
+ "Return non-nil if a newline should be treated as a semi-colon.
+Here we assume that a newline should be treated as a semi-colon unless it
+comes right after a special keyword.
+This function does not pay attention to line-continuations.
+If TOK is nil, point should be before the newline; otherwise, TOK is the token
+before the newline and in that case point should be just before the token."
+ (save-excursion
+ (unless tok
+ (setq tok (funcall smie-backward-token-function)))
+ (if (and (zerop (length tok))
+ (looking-back "\\s(" (1- (point))))
+ nil
+ (not (numberp (nth 2 (assoc tok smie-grammar)))))))
+
+;;;; SMIE support for `sh'.
+
+(defconst sh-smie-sh-grammar
+ (smie-prec2->grammar
+ (smie-bnf->prec2
+ '((exp) ;A constant, or a $var, or a sequence of them...
+ (cmd ("case" exp "in" branches "esac")
+ ("if" cmd "then" cmd "fi")
+ ("if" cmd "then" cmd "else" cmd "fi")
+ ("if" cmd "then" cmd "elif" cmd "then" cmd "fi")
+ ("if" cmd "then" cmd "elif" cmd "then" cmd "else" cmd "fi")
+ ("if" cmd "then" cmd "elif" cmd "then" cmd
+ "elif" cmd "then" cmd "else" cmd "fi")
+ ("while" cmd "do" cmd "done")
+ ("until" cmd "do" cmd "done")
+ ("for" exp "in" cmd "do" cmd "done")
+ ("for" exp "do" cmd "done")
+ ("select" exp "in" cmd "do" cmd "done") ;bash&zsh&ksh88.
+ ("repeat" exp "do" cmd "done") ;zsh.
+ (exp "always" exp) ;zsh.
+ (cmd "|" cmd) (cmd "|&" cmd)
+ (cmd "&&" cmd) (cmd "||" cmd)
+ (cmd ";" cmd) (cmd "&" cmd))
+ (pattern (pattern "|" pattern))
+ (branches (branches ";;" branches)
+ (branches ";&" branches) (branches ";;&" branches) ;bash.
+ (pattern "case-)" cmd)))
+ '((assoc ";;" ";&" ";;&"))
+ '((assoc ";" "&") (assoc "&&" "||") (assoc "|" "|&")))))
+
+(defconst sh-smie--sh-operators
+ (delq nil (mapcar (lambda (x)
+ (setq x (car x))
+ (and (stringp x)
+ (not (string-match "\\`[a-z]" x))
+ x))
+ sh-smie-sh-grammar)))
+
+(defconst sh-smie--sh-operators-re (regexp-opt sh-smie--sh-operators))
+(defconst sh-smie--sh-operators-back-re
+ (concat "\\(?:^\\|[^\\]\\)\\(?:\\\\\\\\\\)*"
+ "\\(" sh-smie--sh-operators-re "\\)"))
+
+(defun sh-smie--sh-keyword-in-p ()
+ "Assuming we're looking at \"in\", return non-nil if it's a keyword.
+Does not preserve point."
+ (let ((forward-sexp-function nil)
+ (words nil) ;We've seen words.
+ (newline nil) ;We've seen newlines after the words.
+ (res nil)
+ prev)
+ (while (not res)
+ (setq prev (funcall smie-backward-token-function))
+ (cond
+ ((zerop (length prev))
+ (if newline
+ (progn (cl-assert words) (setq res 'word))
+ (setq words t)
+ (condition-case nil
+ (forward-sexp -1)
+ (scan-error (setq res 'unknown)))))
+ ((equal prev ";")
+ (if words (setq newline t)
+ (setq res 'keyword)))
+ ((member prev '("case" "for" "select")) (setq res 'keyword))
+ ((assoc prev smie-grammar) (setq res 'word))
+ (t
+ (if newline
+ (progn (cl-assert words) (setq res 'word))
+ (setq words t)))))
+ (eq res 'keyword)))
+
+(defun sh-smie--sh-keyword-p (tok)
+ "Non-nil if TOK (at which we're looking) really is a keyword."
+ (if (equal tok "in")
+ (sh-smie--sh-keyword-in-p)
+ (sh-smie--keyword-p tok)))
+
+(defun sh-smie-sh-forward-token ()
+ (if (and (looking-at "[ \t]*\\(?:#\\|\\(\\s|\\)\\|$\\)")
+ (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp))))
+ (if (and (match-end 1) (not (nth 3 (syntax-ppss))))
+ ;; Right before a here-doc.
+ (let ((forward-sexp-function nil))
+ (forward-sexp 1)
+ ;; Pretend the here-document is a "newline representing a
+ ;; semi-colon", since the here-doc otherwise covers the newline(s).
+ ";")
+ (let ((semi (sh-smie--newline-semi-p)))
+ (forward-line 1)
+ (if semi ";"
+ (sh-smie-sh-forward-token))))
+ (forward-comment (point-max))
+ (cond
+ ((looking-at "\\\\\n") (forward-line 1) (sh-smie-sh-forward-token))
+ ((looking-at sh-smie--sh-operators-re)
+ (goto-char (match-end 0))
+ (let ((tok (match-string-no-properties 0)))
+ (if (and (memq (aref tok (1- (length tok))) '(?\; ?\& ?\|))
+ (looking-at "[ \t]*\\(?:#\\|$\\)"))
+ (forward-line 1))
+ tok))
+ (t
+ (let* ((pos (point))
+ (tok (smie-default-forward-token)))
+ (cond
+ ((equal tok ")") "case-)")
+ ((and tok (string-match "\\`[a-z]" tok)
+ (assoc tok smie-grammar)
+ (not
+ (save-excursion
+ (goto-char pos)
+ (sh-smie--sh-keyword-p tok))))
+ " word ")
+ (t tok)))))))
+
+(defun sh-smie--looking-back-at-continuation-p ()
+ (save-excursion
+ (and (if (eq (char-before) ?\n) (progn (forward-char -1) t) (eolp))
+ (looking-back "\\(?:^\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\\\"
+ (line-beginning-position)))))
+
+(defun sh-smie-sh-backward-token ()
+ (let ((bol (line-beginning-position))
+ pos tok)
+ (forward-comment (- (point)))
+ (cond
+ ((and (bolp) (not (bobp))
+ (equal (syntax-after (1- (point))) (string-to-syntax "|"))
+ (not (nth 3 (syntax-ppss))))
+ ;; Right after a here-document.
+ (let ((forward-sexp-function nil))
+ (forward-sexp -1)
+ ;; Pretend the here-document is a "newline representing a
+ ;; semi-colon", since the here-doc otherwise covers the newline(s).
+ ";"))
+ ((< (point) bol)
+ (cond
+ ((sh-smie--looking-back-at-continuation-p)
+ (forward-char -1)
+ (funcall smie-backward-token-function))
+ ((sh-smie--newline-semi-p) ";")
+ (t (funcall smie-backward-token-function))))
+ ((looking-back sh-smie--sh-operators-back-re
+ (line-beginning-position) 'greedy)
+ (goto-char (match-beginning 1))
+ (match-string-no-properties 1))
+ (t
+ (let ((tok (smie-default-backward-token)))
+ (cond
+ ((equal tok ")") "case-)")
+ ((and tok (string-match "\\`[a-z]" tok)
+ (assoc tok smie-grammar)
+ (not (save-excursion (sh-smie--sh-keyword-p tok))))
+ " word ")
+ (t tok)))))))
+
+(defcustom sh-indent-after-continuation t
+ "If non-nil, try to make sure text is indented after a line continuation."
+ :type 'boolean)
+
+(defun sh-smie--continuation-start-indent ()
+ "Return the initial indentation of a continued line.
+May return nil if the line should not be treated as continued."
+ (save-excursion
+ (forward-line -1)
+ (unless (sh-smie--looking-back-at-continuation-p)
+ (current-indentation))))
+
+(defun sh-smie-sh-rules (kind token)
+ (pcase (cons kind token)
+ (`(:elem . basic) sh-indentation)
+ (`(:after . "case-)") (or sh-indentation smie-indent-basic))
+ ((and `(:before . ,_)
+ (guard (when sh-indent-after-continuation
+ (save-excursion
+ (ignore-errors
+ (skip-chars-backward " \t")
+ (sh-smie--looking-back-at-continuation-p))))))
+ ;; After a line-continuation, make sure the rest is indented.
+ (let* ((sh-indent-after-continuation nil)
+ (indent (smie-indent-calculate))
+ (initial (sh-smie--continuation-start-indent)))
+ (when (and (numberp indent) (numberp initial)
+ (<= indent initial))
+ `(column . ,(+ initial sh-indentation)))))
+ (`(:before . ,(or `"(" `"{" `"["))
+ (if (smie-rule-hanging-p) (smie-rule-parent)))
+ ;; FIXME: Maybe this handling of ;; should be made into
+ ;; a smie-rule-terminator function that takes the substitute ";" as arg.
+ (`(:before . ,(or `";;" `";&" `";;&"))
+ (if (and (smie-rule-bolp) (looking-at ";;?&?[ \t]*\\(#\\|$\\)"))
+ (cons 'column (smie-indent-keyword ";"))
+ (smie-rule-separator kind)))
+ (`(:after . ,(or `";;" `";&" `";;&"))
+ (with-demoted-errors
+ (smie-backward-sexp token)
+ (cons 'column
+ (if (or (smie-rule-bolp)
+ (save-excursion
+ (and (member (funcall smie-backward-token-function)
+ '("in" ";;"))
+ (smie-rule-bolp))))
+ (current-column)
+ (smie-indent-calculate)))))
+ (`(:after . "|") (if (smie-rule-parent-p "|") nil 4))
+ ))
+
+;; (defconst sh-smie-csh-grammar
+;; (smie-prec2->grammar
+;; (smie-bnf->prec2
+;; '((exp) ;A constant, or a $var, or a sequence of them…
+;; (elseifcmd (cmd)
+;; (cmd "else" "else-if" exp "then" elseifcmd))
+;; (cmd ("switch" branches "endsw")
+;; ("if" exp)
+;; ("if" exp "then" cmd "endif")
+;; ("if" exp "then" cmd "else" cmd "endif")
+;; ("if" exp "then" elseifcmd "endif")
+;; ;; ("if" exp "then" cmd "else" cmd "endif")
+;; ;; ("if" exp "then" cmd "else" "if" exp "then" cmd "endif")
+;; ;; ("if" exp "then" cmd "else" "if" exp "then" cmd
+;; ;; "else" cmd "endif")
+;; ;; ("if" exp "then" cmd "else" "if" exp "then" cmd
+;; ;; "else" "if" exp "then" cmd "endif")
+;; ("while" cmd "end")
+;; ("foreach" cmd "end")
+;; (cmd "|" cmd) (cmd "|&" cmd)
+;; (cmd "&&" cmd) (cmd "||" cmd)
+;; (cmd ";" cmd) (cmd "&" cmd))
+;; ;; This is a lie, but (combined with the corresponding disambiguation
+;; ;; rule) it makes it more clear that `case' and `default' are the key
+;; ;; separators and the `:' is a secondary tokens.
+;; (branches (branches "case" branches)
+;; (branches "default" branches)
+;; (exp ":" branches)))
+;; '((assoc "else" "then" "endif"))
+;; '((assoc "case" "default") (nonassoc ":"))
+;; '((assoc ";;" ";&" ";;&"))
+;; '((assoc ";" "&") (assoc "&&" "||") (assoc "|" "|&")))))
+
+;;;; SMIE support for `rc'.
+
+(defconst sh-smie-rc-grammar
+ (smie-prec2->grammar
+ (smie-bnf->prec2
+ '((exp) ;A constant, or a $var, or a sequence of them...
+ (cmd (cmd "case" cmd)
+ ("if" exp)
+ ("switch" exp)
+ ("for" exp) ("while" exp)
+ (cmd "|" cmd) (cmd "|&" cmd)
+ (cmd "&&" cmd) (cmd "||" cmd)
+ (cmd ";" cmd) (cmd "&" cmd))
+ (pattern (pattern "|" pattern))
+ (branches (branches ";;" branches)
+ (branches ";&" branches) (branches ";;&" branches) ;bash.
+ (pattern "case-)" cmd)))
+ '((assoc ";;" ";&" ";;&"))
+ '((assoc "case") (assoc ";" "&") (assoc "&&" "||") (assoc "|" "|&")))))
+
+(defun sh-smie--rc-after-special-arg-p ()
+ "Check if we're after the first arg of an if/while/for/... construct.
+Returns the construct's token and moves point before it, if so."
+ (forward-comment (- (point)))
+ (when (looking-back ")\\|\\_<not" (- (point) 3))
+ (ignore-errors
+ (let ((forward-sexp-function nil))
+ (forward-sexp -1)
+ (car (member (funcall smie-backward-token-function)
+ '("if" "for" "switch" "while")))))))
+
+(defun sh-smie--rc-newline-semi-p ()
+ "Return non-nil if a newline should be treated as a semi-colon.
+Point should be before the newline."
+ (save-excursion
+ (let ((tok (funcall smie-backward-token-function)))
+ (if (or (when (equal tok "not") (forward-word 1) t)
+ (and (zerop (length tok)) (eq (char-before) ?\))))
+ (not (sh-smie--rc-after-special-arg-p))
+ (sh-smie--newline-semi-p tok)))))
+
+(defun sh-smie-rc-forward-token ()
+ ;; FIXME: Code duplication with sh-smie-sh-forward-token.
+ (if (and (looking-at "[ \t]*\\(?:#\\|\\(\\s|\\)\\|$\\)")
+ (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp))))
+ (if (and (match-end 1) (not (nth 3 (syntax-ppss))))
+ ;; Right before a here-doc.
+ (let ((forward-sexp-function nil))
+ (forward-sexp 1)
+ ;; Pretend the here-document is a "newline representing a
+ ;; semi-colon", since the here-doc otherwise covers the newline(s).
+ ";")
+ (let ((semi (sh-smie--rc-newline-semi-p)))
+ (forward-line 1)
+ (if semi ";"
+ (sh-smie-rc-forward-token))))
+ (forward-comment (point-max))
+ (cond
+ ((looking-at "\\\\\n") (forward-line 1) (sh-smie-rc-forward-token))
+ ;; ((looking-at sh-smie--rc-operators-re)
+ ;; (goto-char (match-end 0))
+ ;; (let ((tok (match-string-no-properties 0)))
+ ;; (if (and (memq (aref tok (1- (length tok))) '(?\; ?\& ?\|))
+ ;; (looking-at "[ \t]*\\(?:#\\|$\\)"))
+ ;; (forward-line 1))
+ ;; tok))
+ (t
+ (let* ((pos (point))
+ (tok (smie-default-forward-token)))
+ (cond
+ ;; ((equal tok ")") "case-)")
+ ((and tok (string-match "\\`[a-z]" tok)
+ (assoc tok smie-grammar)
+ (not
+ (save-excursion
+ (goto-char pos)
+ (sh-smie--keyword-p tok))))
+ " word ")
+ (t tok)))))))
+
+(defun sh-smie-rc-backward-token ()
+ ;; FIXME: Code duplication with sh-smie-sh-backward-token.
+ (let ((bol (line-beginning-position))
+ pos tok)
+ (forward-comment (- (point)))
+ (cond
+ ((and (bolp) (not (bobp))
+ (equal (syntax-after (1- (point))) (string-to-syntax "|"))
+ (not (nth 3 (syntax-ppss))))
+ ;; Right after a here-document.
+ (let ((forward-sexp-function nil))
+ (forward-sexp -1)
+ ;; Pretend the here-document is a "newline representing a
+ ;; semi-colon", since the here-doc otherwise covers the newline(s).
+ ";"))
+ ((< (point) bol) ;We skipped over a newline.
+ (cond
+ ;; A continued line.
+ ((and (eolp)
+ (looking-back "\\(?:^\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\\\"
+ (line-beginning-position)))
+ (forward-char -1)
+ (funcall smie-backward-token-function))
+ ((sh-smie--rc-newline-semi-p) ";")
+ (t (funcall smie-backward-token-function))))
+ ;; ((looking-back sh-smie--sh-operators-back-re
+ ;; (line-beginning-position) 'greedy)
+ ;; (goto-char (match-beginning 1))
+ ;; (match-string-no-properties 1))
+ (t
+ (let ((tok (smie-default-backward-token)))
+ (cond
+ ;; ((equal tok ")") "case-)")
+ ((and tok (string-match "\\`[a-z]" tok)
+ (assoc tok smie-grammar)
+ (not (save-excursion (sh-smie--keyword-p tok))))
+ " word ")
+ (t tok)))))))
+
+(defun sh-smie-rc-rules (kind token)
+ (pcase (cons kind token)
+ (`(:elem . basic) sh-indentation)
+ ;; (`(:after . "case") (or sh-indentation smie-indent-basic))
+ (`(:after . ";") (if (smie-rule-parent-p "case")
+ (smie-rule-parent sh-indentation)))
+ (`(:before . "{")
+ (save-excursion
+ (when (sh-smie--rc-after-special-arg-p)
+ `(column . ,(current-column)))))
+ (`(:before . ,(or `"(" `"{" `"["))
+ (if (smie-rule-hanging-p) (smie-rule-parent)))
+ ;; FIXME: SMIE parses "if (exp) cmd" as "(if ((exp) cmd))" so "cmd" is
+ ;; treated as an arg to (exp) by default, which indents it all wrong.
+ ;; To handle it right, we should extend smie-indent-exps so that the
+ ;; preceding keyword can give special rules. Currently the only special
+ ;; rule we have is the :list-intro hack, which we use here to align "cmd"
+ ;; with "(exp)", which is rarely the right thing to do, but is better
+ ;; than nothing.
+ (`(:list-intro . ,(or `"for" `"if" `"while")) t)
+ ))
+
+;;; End of SMIE code.
(defvar sh-regexp-for-done nil
"A buffer-local regexp to match opening keyword for done.")
(set-syntax-table sh-mode-syntax-table)))
(dolist (var (sh-feature sh-variables))
(sh-remember-variable var))
- (if (setq sh-indent-supported-here (sh-feature sh-indent-supported))
+ (if (set (make-local-variable 'sh-indent-supported-here)
+ (sh-feature sh-indent-supported))
(progn
(message "Setting up indent for shell type %s" sh-shell)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- (set (make-local-variable 'sh-kw-alist) (sh-feature sh-kw))
- (let ((regexp (sh-feature sh-kws-for-done)))
- (if regexp
- (set (make-local-variable 'sh-regexp-for-done)
- (sh-mkword-regexpr (regexp-opt regexp t)))))
- (message "setting up indent stuff")
- ;; sh-mode has already made indent-line-function local
- ;; but do it in case this is called before that.
- (set (make-local-variable 'indent-line-function) 'sh-indent-line)
+ (if sh-use-smie
+ (let ((mksym (lambda (name)
+ (intern (format "sh-smie-%s-%s"
+ sh-indent-supported-here name)))))
+ (smie-setup (symbol-value (funcall mksym "grammar"))
+ (funcall mksym "rules")
+ :forward-token (funcall mksym "forward-token")
+ :backward-token (funcall mksym "backward-token")))
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (set (make-local-variable 'sh-kw-alist) (sh-feature sh-kw))
+ (let ((regexp (sh-feature sh-kws-for-done)))
+ (if regexp
+ (set (make-local-variable 'sh-regexp-for-done)
+ (sh-mkword-regexpr (regexp-opt regexp t)))))
+ (message "setting up indent stuff")
+ ;; sh-mode has already made indent-line-function local
+ ;; but do it in case this is called before that.
+ (set (make-local-variable 'indent-line-function) 'sh-indent-line))
(if sh-make-vars-local
(sh-make-vars-local))
(message "Indentation setup for shell type %s" sh-shell))
\f
;; Indentation stuff.
(defun sh-must-support-indent ()
- "*Signal an error if the shell type for this buffer is not supported.
+ "Signal an error if the shell type for this buffer is not supported.
Also, the buffer must be in Shell-script mode."
(unless sh-indent-supported-here
(error "This buffer's shell does not support indentation through Emacs")))
;; Is this really worth having?
(defvar sh-learned-buffer-hook nil
- "*An abnormal hook, called with an alist of learned variables.")
+ "An abnormal hook, called with an alist of learned variables.")
;; Example of how to use sh-learned-buffer-hook
;;
;; (defun what-i-learned (list)
(defun sh-save-styles-to-buffer (buff)
"Save all current styles in elisp to buffer BUFF.
This is always added to the end of the buffer."
- (interactive (list
- (read-from-minibuffer "Buffer to save styles in? " "*scratch*")))
+ (interactive
+ (list
+ (read-from-minibuffer "Buffer to save styles in? " "*scratch*")))
(with-current-buffer (get-buffer-create buff)
(goto-char (point-max))
(insert "\n")
(defun sh-maybe-here-document (arg)
"Insert self. Without prefix, following unquoted `<' inserts here document.
The document is bounded by `sh-here-document-word'."
+ (declare (obsolete sh-electric-here-document-mode "24.3"))
(interactive "*P")
(self-insert-command (prefix-numeric-value arg))
- (or arg
- (not (looking-back "[^<]<<"))
+ (or arg (sh--maybe-here-document)))
+
+(defun sh--maybe-here-document ()
+ (or (not (looking-back "[^<]<<"))
(save-excursion
(backward-char 2)
(sh-quoted-p))
(insert ?\n tabs (replace-regexp-in-string
"\\`-?[ \t]*" "" delim))))))
+(define-minor-mode sh-electric-here-document-mode
+ "Make << insert a here document skeleton."
+ nil nil nil
+ (if sh-electric-here-document-mode
+ (add-hook 'post-self-insert-hook #'sh--maybe-here-document nil t)
+ (remove-hook 'post-self-insert-hook #'sh--maybe-here-document t)))
\f
;; various other commands
(defun sh-beginning-of-command ()
+ ;; FIXME: Redefine using SMIE.
"Move point to successive beginnings of commands."
(interactive)
(if (re-search-backward sh-beginning-of-command nil t)
(goto-char (match-beginning 2))))
(defun sh-end-of-command ()
+ ;; FIXME: Redefine using SMIE.
"Move point to successive ends of commands."
(interactive)
(if (re-search-forward sh-end-of-command nil t)
the run of whitespace at the beginning of the line.")
(defcustom simula-tab-always-indent simula-tab-always-indent-default
- "*Non-nil means TAB in SIMULA mode should always reindent the current line.
+ "Non-nil means TAB in SIMULA mode should always reindent the current line.
Otherwise TAB indents only when point is within
the run of whitespace at the beginning of the line."
:type 'boolean
"Indentation of SIMULA statements with respect to containing block.")
(defcustom simula-indent-level simula-indent-level-default
- "*Indentation of SIMULA statements with respect to containing block."
+ "Indentation of SIMULA statements with respect to containing block."
:type 'integer
:group 'simula)
"Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
(defcustom simula-substatement-offset simula-substatement-offset-default
- "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE."
+ "Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE."
:type 'integer
:group 'simula)
(defcustom simula-continued-statement-offset
simula-continued-statement-offset-default
- "*Extra indentation for lines not starting a statement or substatement.
+ "Extra indentation for lines not starting a statement or substatement.
If value is a list, each line in a multipleline continued statement
will have the car of the list extra indentation with respect to
the previous line of the statement."
"Offset of SIMULA label lines relative to usual indentation.")
(defcustom simula-label-offset simula-label-offset-default
- "*Offset of SIMULA label lines relative to usual indentation."
+ "Offset of SIMULA label lines relative to usual indentation."
:type 'integer
:group 'simula)
extra ELSE indentation. IF after ELSE is indented as the starting IF.")
(defcustom simula-if-indent simula-if-indent-default
- "*Extra indentation of THEN and ELSE with respect to the starting IF.
+ "Extra indentation of THEN and ELSE with respect to the starting IF.
Value is a cons cell, the car is extra THEN indentation and the cdr
extra ELSE indentation. IF after ELSE is indented as the starting IF."
:type '(cons integer integer)
and the cdr extra OTHERWISE indentation.")
(defcustom simula-inspect-indent simula-inspect-indent-default
- "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
+ "Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
Value is a cons cell, the car is extra WHEN indentation
and the cdr extra OTHERWISE indentation."
:type '(cons integer integer)
"Non-nil means `simula-indent-line' function may reindent previous line.")
(defcustom simula-electric-indent simula-electric-indent-default
- "*Non-nil means `simula-indent-line' function may reindent previous line."
+ "Non-nil means `simula-indent-line' function may reindent previous line."
:type 'boolean
:group 'simula)
\(as in) `abbrev-table' or nil if they should not be changed.")
(defcustom simula-abbrev-keyword simula-abbrev-keyword-default
- "*Specify how to convert case for SIMULA keywords.
+ "Specify how to convert case for SIMULA keywords.
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table' or nil if they should not be changed."
:type '(choice (const upcase) (const downcase) (const capitalize)(const nil))
\(as in) `abbrev-table', or nil if they should not be changed.")
(defcustom simula-abbrev-stdproc simula-abbrev-stdproc-default
- "*Specify how to convert case for standard SIMULA procedure and class names.
+ "Specify how to convert case for standard SIMULA procedure and class names.
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table', or nil if they should not be changed."
:type '(choice (const upcase) (const downcase) (const capitalize)
:group 'simula)
(defcustom simula-abbrev-file nil
- "*File with extra abbrev definitions for use in SIMULA mode.
+ "File with extra abbrev definitions for use in SIMULA mode.
These are used together with the standard abbrev definitions for SIMULA.
Please note that the standard definitions are required
for SIMULA mode to function correctly."
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 3.0
+;; Version: 3.1
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
;; Michael Mauger <mmaug@yahoo.com> -- improved product support
;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support
;; Harald Maier <maierh@myself.com> -- sql-send-string
-;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections; code polish
+;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections;
+;; code polish
;; Paul Sleigh <bat@flurf.net> -- MySQL keyword enhancement
;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug
+;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines
+;; incorrectly enabled by default
\f
(defcustom sql-password ""
"Default password.
-
-Storing your password in a textfile such as ~/.emacs could be dangerous.
-Customizing your password will store it in your ~/.emacs file."
+If you customize this, the value will be stored in your init
+file. Since that is a plaintext file, this could be dangerous."
:type 'string
:group 'SQL
:risky t)
:type 'boolean
:group 'SQL)
+(defcustom sql-db2-escape-newlines nil
+ "Non-nil if newlines should be escaped by a backslash in DB2 SQLi.
+
+When non-nil, Emacs will automatically insert a space and
+backslash prior to every newline in multi-line SQL statements as
+they are submitted to an interactive DB2 session."
+ :version "24.3"
+ :type 'boolean
+ :group 'SQL)
+
;; Customization for SQLite
(defcustom sql-sqlite-program (or (executable-find "sqlite3")
["List all objects" sql-list-all (sql-get-product-feature sql-product :list-all)]
["List table details" sql-list-table (sql-get-product-feature sql-product :list-table)]))
-;; Abbreviations -- if you want more of them, define them in your
-;; ~/.emacs file. Abbrevs have to be enabled in your ~/.emacs, too.
+;; Abbreviations -- if you want more of them, define them in your init
+;; file. Abbrevs have to be enabled in your init file, too.
(defvar sql-mode-abbrev-table nil
"Abbrev table used in `sql-mode' and `sql-interactive-mode'.")
(defun sql-get-login-ext (symbol prompt history-var plist)
"Prompt user with extended login parameters.
-The global value of SYMBOL is the last value and the global value
+The global value of SYMBOL is the last value and the global value
of the SYMBOL is set based on the user's input.
If PLIST is nil, then the user is simply prompted for a string
The `:completion' property prompts for a string specified by its
value. (The property value is used as the PREDICATE argument to
`completing-read'.)"
- (set-default
+ (set-default
symbol
(let* ((default (plist-get plist :default))
(last-value (default-value symbol))
;; Using DB2 interactively, newlines must be escaped with " \".
;; The space before the backslash is relevant.
+
(defun sql-escape-newlines-filter (string)
"Escape newlines in STRING.
Every newline in STRING will be preceded with a space and a backslash."
- (let ((result "") (start 0) mb me)
- (while (string-match "\n" string start)
- (setq mb (match-beginning 0)
- me (match-end 0)
- result (concat result
- (substring string start mb)
- (if (and (> mb 1)
- (string-equal " \\" (substring string (- mb 2) mb)))
- "" " \\\n"))
- start me))
- (concat result (substring string start))))
+ (if (not sql-db2-escape-newlines)
+ string
+ (let ((result "") (start 0) mb me)
+ (while (string-match "\n" string start)
+ (setq mb (match-beginning 0)
+ me (match-end 0)
+ result (concat result
+ (substring string start mb)
+ (if (and (> mb 1)
+ (string-equal " \\" (substring string (- mb 2) mb)))
+ "" " \\\n"))
+ start me))
+ (concat result (substring string start)))))
\f
`sql-interactive-mode'.
Note that SQL doesn't have an escape character unless you specify
-one. If you specify backslash as escape character in SQL,
-you must tell Emacs. Here's how to do that in your `~/.emacs' file:
+one. If you specify backslash as escape character in SQL, you
+must tell Emacs. Here's how to do that in your init file:
\(add-hook 'sql-mode-hook
(lambda ()
If you want to make SQL buffers limited in length, add the function
`comint-truncate-buffer' to `comint-output-filter-functions'.
-Here is an example for your .emacs file. It keeps the SQLi buffer a
+Here is an example for your init file. It keeps the SQLi buffer a
certain length.
\(add-hook 'sql-interactive-mode-hook
passed as command line arguments."
(let ((program (sql-get-product-feature product :sqli-program))
(buf-name "SQL"))
- ;; make sure we can find the program
- (unless (executable-find program)
+ ;; Make sure we can find the program. `executable-find' does not
+ ;; work for remote hosts; we suppress the check there.
+ (unless (or (file-remote-p default-directory)
+ (executable-find program))
(error "Unable to locate SQL program \'%s\'" program))
- ;; Make sure buffer name is unique
+ ;; Make sure buffer name is unique.
(when (sql-buffer-live-p (format "*%s*" buf-name))
(setq buf-name (format "SQL-%s" product))
(when (sql-buffer-live-p (format "*%s*" buf-name))
;;; Code:
+(defvar subword-forward-function 'subword-forward-internal
+ "Function to call for forward subword movement.")
+
+(defvar subword-backward-function 'subword-backward-internal
+ "Function to call for backward subword movement.")
+
+(defvar subword-forward-regexp
+ "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)"
+ "Regexp used by `subword-forward-internal'.")
+
+(defvar subword-backward-regexp
+ "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
+ "Regexp used by `subword-backward-internal'.")
+
(defvar subword-mode-map
(let ((map (make-sparse-keymap)))
(dolist (cmd '(forward-word backward-word mark-word kill-word
(cond
((< 0 arg)
(dotimes (i arg (point))
- (subword-forward-internal)))
+ (funcall subword-forward-function)))
((> 0 arg)
(dotimes (i (- arg) (point))
- (subword-backward-internal)))
+ (funcall subword-backward-function)))
(t
(point))))
(if (and
(save-excursion
(let ((case-fold-search nil))
- (re-search-forward
- (concat "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)")
- nil t)))
+ (re-search-forward subword-forward-regexp nil t)))
(> (match-end 0) (point)))
(goto-char
(cond
(defun subword-backward-internal ()
(if (save-excursion
(let ((case-fold-search nil))
- (re-search-backward
- (concat
- "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)"
- "\\|\\W\\w+\\)")
- nil t)))
+ (re-search-backward subword-backward-regexp nil t)))
(goto-char
(cond
((and (match-end 3)
(eval-when-compile
(require 'imenu)
- (require 'outline)
(require 'dabbrev)
(require 'add-log))
:group 'languages)
(defcustom tcl-indent-level 4
- "*Indentation of Tcl statements with respect to containing block."
+ "Indentation of Tcl statements with respect to containing block."
:type 'integer
:group 'tcl)
(put 'tcl-indent-level 'safe-local-variable 'integerp)
(defcustom tcl-continued-indent-level 4
- "*Indentation of continuation line relative to first line of command."
+ "Indentation of continuation line relative to first line of command."
:type 'integer
:group 'tcl)
(put 'tcl-continued-indent-level 'safe-local-variable 'integerp)
(defcustom tcl-auto-newline nil
- "*Non-nil means automatically newline before and after braces you insert."
+ "Non-nil means automatically newline before and after braces you insert."
:type 'boolean
:group 'tcl)
(defcustom tcl-tab-always-indent tab-always-indent
- "*Control effect of TAB key.
+ "Control effect of TAB key.
If t (the default), always indent current line.
If nil and point is not in the indentation area at the beginning of
the line, a TAB is inserted.
(defcustom tcl-electric-hash-style nil ;; 'smart
- "*Style of electric hash insertion to use.
+ "Style of electric hash insertion to use.
Possible values are `backslash', meaning that `\\' quoting should be
done; `quote', meaning that `\"' quoting should be done; `smart',
meaning that the choice between `backslash' and `quote' should be
:group 'tcl)
(defcustom tcl-help-directory-list nil
- "*List of topmost directories containing TclX help files."
+ "List of topmost directories containing TclX help files."
:type '(repeat directory)
:group 'tcl)
(defcustom tcl-use-smart-word-finder t
- "*If not nil, use smart way to find current word, for Tcl help feature."
+ "If not nil, use smart way to find current word, for Tcl help feature."
:type 'boolean
:group 'tcl)
(defcustom tcl-application "wish"
- "*Name of Tcl program to run in inferior Tcl mode."
+ "Name of Tcl program to run in inferior Tcl mode."
:type 'string
:group 'tcl)
(defcustom tcl-command-switches nil
- "*List of switches to supply to the `tcl-application' program."
+ "List of switches to supply to the `tcl-application' program."
:type '(repeat string)
:group 'tcl)
(defcustom tcl-prompt-regexp "^\\(% \\|\\)"
- "*If not nil, a regexp that will match the prompt in the inferior process.
+ "If not nil, a regexp that will match the prompt in the inferior process.
If nil, the prompt is the name of the application with \">\" appended.
The default is \"^\\(% \\|\\)\", which will match the default primary
:group 'tcl)
(defcustom inferior-tcl-source-command "source %s\n"
- "*Format-string for building a Tcl command to load a file.
+ "Format-string for building a Tcl command to load a file.
This format string should use `%s' to substitute a file name
and should result in a Tcl expression that will command the
inferior Tcl to load that file. The filename will be appropriately
["Tcl help" tcl-help-on-word tcl-help-directory-list]))
(defvar inferior-tcl-buffer nil
- "*The current inferior-tcl process buffer.
+ "The current inferior-tcl process buffer.
MULTIPLE PROCESS SUPPORT
===========================================================================
;; The mode itself.
;;
+(defvar outline-regexp)
+(defvar outline-level)
+
;;;###autoload
(define-derived-mode tcl-mode prog-mode "Tcl"
"Major mode for editing Tcl code.
:group 'languages)
(defcustom vera-basic-offset 2
- "*Amount of basic offset used for indentation."
+ "Amount of basic offset used for indentation."
:type 'integer
:group 'vera)
(defcustom vera-underscore-is-part-of-word nil
- "*Non-nil means consider the underscore character `_' as part of word.
+ "Non-nil means consider the underscore character `_' as part of word.
An identifier containing underscores is then treated as a single word in
select and move operations. All parts of an identifier separated by underscore
are treated as single words otherwise."
:group 'vera)
(defcustom vera-intelligent-tab t
- "*Non-nil means `TAB' does indentation, word completion and tab insertion.
+ "Non-nil means `TAB' does indentation, word completion and tab insertion.
That is, if preceding character is part of a word then complete word,
else if not at beginning of line then insert tab,
else if last command was a `TAB' or `RET' then dedent one step,
;;; Font locking
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; XEmacs compatibility
-(when (featurep 'xemacs)
- (require 'font-lock)
- (copy-face 'font-lock-reference-face 'font-lock-constant-face)
- (copy-face 'font-lock-preprocessor-face 'font-lock-builtin-face))
-
(defun vera-font-lock-match-item (limit)
"Match, and move over, any declaration item after point.
Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'."
"Face name to use for interface names.")
(defface vera-font-lock-number
- '((((class color) (background light)) (:foreground "Gold4"))
- (((class color) (background dark)) (:foreground "BurlyWood1"))
- (t (:italic t :bold t)))
+ '((((class color) (background light)) :foreground "Gold4")
+ (((class color) (background dark)) :foreground "BurlyWood1")
+ (t :slant italic :weight bold))
"Font lock mode face used to highlight @ definitions."
:group 'font-lock-highlighting-faces)
(defface vera-font-lock-function
- '((((class color) (background light)) (:foreground "DarkCyan"))
- (((class color) (background dark)) (:foreground "Orchid1"))
- (t (:italic t :bold t)))
+ '((((class color) (background light)) :foreground "DarkCyan")
+ (((class color) (background dark)) :foreground "Orchid1")
+ (t :slant italic :weight bold))
"Font lock mode face used to highlight predefined functions and tasks."
:group 'font-lock-highlighting-faces)
(defface vera-font-lock-interface
- '((((class color) (background light)) (:foreground "Grey40"))
- (((class color) (background dark)) (:foreground "Grey80"))
- (t (:italic t :bold t)))
+ '((((class color) (background light)) :foreground "Grey40")
+ (((class color) (background dark)) :foreground "Grey80")
+ (t :slant italic :weight bold))
"Font lock mode face used to highlight interface names."
:group 'font-lock-highlighting-faces)
;;; Code:
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "725"
+(defconst verilog-mode-version (substring "$$Revision: 820 $$" 12 -3)
"Version of this Verilog mode.")
-(defconst verilog-mode-release-date "2011-11-27-GNU"
+(defconst verilog-mode-release-date (substring "$$Date: 2012-09-17 20:43:10 -0400 (Mon, 17 Sep 2012) $$" 8 -3)
"Release date of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
(parse-partial-sexp (point-min) (or pos (point)))))
(defgroup verilog-mode nil
- "Facilitates easy editing of Verilog source text."
+ "Major mode for Verilog source code."
:version "22.2"
:group 'languages)
:group 'verilog-mode)
(defvar verilog-debug nil
- "If set, enable debug messages for `verilog-mode' internals.")
+ "Non-nil means enable debug messages for `verilog-mode' internals.")
+
+(defvar verilog-warn-fatal nil
+ "Non-nil means `verilog-warn-error' warnings are fatal `error's.")
(defcustom verilog-linter
"echo 'No verilog-linter set, see \"M-x describe-variable verilog-linter\"'"
- "*Unix program and arguments to call to run a lint checker on Verilog source.
+ "Unix program and arguments to call to run a lint checker on Verilog source.
Depending on the `verilog-set-compile-command', this may be invoked when
you type \\[compile]. When the compile completes, \\[next-error] will take
you to the next lint error."
(defcustom verilog-coverage
"echo 'No verilog-coverage set, see \"M-x describe-variable verilog-coverage\"'"
- "*Program and arguments to use to annotate for coverage Verilog source.
+ "Program and arguments to use to annotate for coverage Verilog source.
Depending on the `verilog-set-compile-command', this may be invoked when
you type \\[compile]. When the compile completes, \\[next-error] will take
you to the next lint error."
(defcustom verilog-simulator
"echo 'No verilog-simulator set, see \"M-x describe-variable verilog-simulator\"'"
- "*Program and arguments to use to interpret Verilog source.
+ "Program and arguments to use to interpret Verilog source.
Depending on the `verilog-set-compile-command', this may be invoked when
you type \\[compile]. When the compile completes, \\[next-error] will take
you to the next lint error."
(defcustom verilog-compiler
"echo 'No verilog-compiler set, see \"M-x describe-variable verilog-compiler\"'"
- "*Program and arguments to use to compile Verilog source.
+ "Program and arguments to use to compile Verilog source.
Depending on the `verilog-set-compile-command', this may be invoked when
you type \\[compile]. When the compile completes, \\[next-error] will take
you to the next lint error."
(defcustom verilog-preprocessor
;; Very few tools give preprocessed output, so we'll default to Verilog-Perl
"vppreproc __FLAGS__ __FILE__"
- "*Program and arguments to use to preprocess Verilog source.
+ "Program and arguments to use to preprocess Verilog source.
This is invoked with `verilog-preprocess', and depending on the
`verilog-set-compile-command', may also be invoked when you type
\\[compile]. When the compile completes, \\[next-error] will
`verilog-set-compile-command' for more information.")
(defcustom verilog-highlight-translate-off nil
- "*Non-nil means background-highlight code excluded from translation.
+ "Non-nil means background-highlight code excluded from translation.
That is, all code between \"// synopsys translate_off\" and
\"// synopsys translate_on\" is highlighted using a different background color
\(face `verilog-font-lock-translate-off-face').
(put 'verilog-highlight-translate-off 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-lineup 'declarations
- "*Type of statements to lineup across multiple lines.
+ "Type of statements to lineup across multiple lines.
If 'all' is selected, then all line ups described below are done.
If 'declaration', then just declarations are lined up with any
(const :tag "Line up Declarations" declarations)
(function :tag "Other"))
:group 'verilog-mode-indent )
+(put 'verilog-auto-lineup 'safe-local-variable
+ '(lambda (x) (memq x '(nil all assignments declarations))))
(defcustom verilog-indent-level 3
- "*Indentation of Verilog statements with respect to containing block."
+ "Indentation of Verilog statements with respect to containing block."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-indent-level 'safe-local-variable 'integerp)
(defcustom verilog-indent-level-module 3
- "*Indentation of Module level Verilog statements (eg always, initial).
+ "Indentation of Module level Verilog statements (eg always, initial).
Set to 0 to get initial and always statements lined up on the left side of
your screen."
:group 'verilog-mode-indent
(put 'verilog-indent-level-module 'safe-local-variable 'integerp)
(defcustom verilog-indent-level-declaration 3
- "*Indentation of declarations with respect to containing block.
+ "Indentation of declarations with respect to containing block.
Set to 0 to get them list right under containing block."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-indent-level-declaration 'safe-local-variable 'integerp)
(defcustom verilog-indent-declaration-macros nil
- "*How to treat macro expansions in a declaration.
+ "How to treat macro expansions in a declaration.
If nil, indent as:
input [31:0] a;
input `CP;
(put 'verilog-indent-declaration-macros 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-indent-lists t
- "*How to treat indenting items in a list.
+ "How to treat indenting items in a list.
If t (the default), indent as:
always @( posedge a or
reset ) begin
(put 'verilog-indent-lists 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-indent-level-behavioral 3
- "*Absolute indentation of first begin in a task or function block.
+ "Absolute indentation of first begin in a task or function block.
Set to 0 to get such code to start at the left side of the screen."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-indent-level-behavioral 'safe-local-variable 'integerp)
(defcustom verilog-indent-level-directive 1
- "*Indentation to add to each level of `ifdef declarations.
+ "Indentation to add to each level of `ifdef declarations.
Set to 0 to have all directives start at the left side of the screen."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-indent-level-directive 'safe-local-variable 'integerp)
(defcustom verilog-cexp-indent 2
- "*Indentation of Verilog statements split across lines."
+ "Indentation of Verilog statements split across lines."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-cexp-indent 'safe-local-variable 'integerp)
(defcustom verilog-case-indent 2
- "*Indentation for case statements."
+ "Indentation for case statements."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-case-indent 'safe-local-variable 'integerp)
(defcustom verilog-auto-newline t
- "*True means automatically newline after semicolons."
+ "Non-nil means automatically newline after semicolons."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-auto-newline 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-indent-on-newline t
- "*True means automatically indent line after newline."
+ "Non-nil means automatically indent line after newline."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-auto-indent-on-newline 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-tab-always-indent t
- "*True means TAB should always re-indent the current line.
+ "Non-nil means TAB should always re-indent the current line.
A nil value means TAB will only reindent when at the beginning of the line."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-tab-always-indent 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-tab-to-comment nil
- "*True means TAB moves to the right hand column in preparation for a comment."
+ "Non-nil means TAB moves to the right hand column in preparation for a comment."
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-tab-to-comment 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-indent-begin-after-if t
- "*If true, indent begin statements following if, else, while, for and repeat.
+ "Non-nil means indent begin statements following if, else, while, etc.
Otherwise, line them up."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-indent-begin-after-if 'safe-local-variable 'verilog-booleanp)
-
(defcustom verilog-align-ifelse nil
- "*If true, align `else' under matching `if'.
+ "Non-nil means align `else' under matching `if'.
Otherwise else is lined up with first character on line holding matching if."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-align-ifelse 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-minimum-comment-distance 10
- "*Minimum distance (in lines) between begin and end required before a comment.
+ "Minimum distance (in lines) between begin and end required before a comment.
Setting this variable to zero results in every end acquiring a comment; the
default avoids too many redundant comments in tight quarters."
:group 'verilog-mode-indent
(put 'verilog-minimum-comment-distance 'safe-local-variable 'integerp)
(defcustom verilog-highlight-p1800-keywords nil
- "*True means highlight words newly reserved by IEEE-1800.
+ "Non-nil means highlight words newly reserved by IEEE-1800.
These will appear in `verilog-font-lock-p1800-face' in order to gently
suggest changing where these words are used as variables to something else.
A nil value means highlight these words as appropriate for the SystemVerilog
(put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-highlight-grouping-keywords nil
- "*True means highlight grouping keywords 'begin' and 'end' more dramatically.
+ "Non-nil means highlight grouping keywords 'begin' and 'end' more dramatically.
If false, these words are in the `font-lock-type-face'; if True then they are in
`verilog-font-lock-ams-face'. Some find that special highlighting on these
grouping constructs allow the structure of the code to be understood at a glance."
(put 'verilog-highlight-grouping-keywords 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-highlight-modules nil
- "*True means highlight module statements for `verilog-load-file-at-point'.
+ "Non-nil means highlight module statements for `verilog-load-file-at-point'.
When true, mousing over module names will allow jumping to the
module definition. If false, this is not supported. Setting
this is experimental, and may lead to bad performance."
(put 'verilog-highlight-modules 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-highlight-includes t
- "*True means highlight module statements for `verilog-load-file-at-point'.
+ "Non-nil means highlight module statements for `verilog-load-file-at-point'.
When true, mousing over include file names will allow jumping to the
file referenced. If false, this is not supported."
:group 'verilog-mode-indent
(put 'verilog-highlight-includes 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-declare-nettype nil
- "*Non-nil specifies the data type to use with `verilog-auto-input' etc.
+ "Non-nil specifies the data type to use with `verilog-auto-input' etc.
Set this to \"wire\" if the Verilog code uses \"`default_nettype
none\". Note using `default_nettype none isn't recommended practice; this
mode is experimental."
- :version "24.1"
+ :version "24.1" ;; rev670
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-declare-nettype 'safe-local-variable `stringp)
(defcustom verilog-auto-wire-type nil
- "*Non-nil specifies the data type to use with `verilog-auto-wire' etc.
+ "Non-nil specifies the data type to use with `verilog-auto-wire' etc.
Set this to \"logic\" for SystemVerilog code, or use `verilog-auto-logic'."
- :version "24.1"
+ :version "24.1" ;; rev673
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-wire-type 'safe-local-variable `stringp)
(defcustom verilog-auto-endcomments t
- "*True means insert a comment /* ... */ after 'end's.
+ "Non-nil means insert a comment /* ... */ after 'end's.
The name of the function or case will be set between the braces."
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-endcomments 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-delete-trailing-whitespace nil
- "*True means to `delete-trailing-whitespace' in `verilog-auto'."
- :version "24.1"
+ "Non-nil means to `delete-trailing-whitespace' in `verilog-auto'."
+ :version "24.1" ;; rev703
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-delete-trailing-whitespace 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-ignore-concat nil
- "*True means ignore signals in {...} concatenations for AUTOWIRE etc.
+ "Non-nil means ignore signals in {...} concatenations for AUTOWIRE etc.
This will exclude signals referenced as pin connections in {...}
from AUTOWIRE, AUTOOUTPUT and friends. This flag should be set
for backward compatibility only and not set in new designs; it
(put 'verilog-auto-ignore-concat 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-read-includes nil
- "*True means to automatically read includes before AUTOs.
+ "Non-nil means to automatically read includes before AUTOs.
This will do a `verilog-read-defines' and `verilog-read-includes' before
each AUTO expansion. This makes it easier to embed defines and includes,
but can result in very slow reading times if there are many or large
(put 'verilog-auto-read-includes 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-save-policy nil
- "*Non-nil indicates action to take when saving a Verilog buffer with AUTOs.
+ "Non-nil indicates action to take when saving a Verilog buffer with AUTOs.
A value of `force' will always do a \\[verilog-auto] automatically if
needed on every save. A value of `detect' will do \\[verilog-auto]
automatically when it thinks necessary. A value of `ask' will query the
:type '(choice (const nil) (const ask) (const detect) (const force)))
(defcustom verilog-auto-star-expand t
- "*Non-nil indicates to expand a SystemVerilog .* instance ports.
-They will be expanded in the same way as if there was a AUTOINST in the
+ "Non-nil means to expand SystemVerilog .* instance ports.
+They will be expanded in the same way as if there was an AUTOINST in the
instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'."
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-star-expand 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-star-save nil
- "*Non-nil indicates to save to disk SystemVerilog .* instance expansions.
+ "Non-nil means save to disk SystemVerilog .* instance expansions.
A nil value indicates direct connections will be removed before saving.
Only meaningful to those created due to `verilog-auto-star-expand' being set.
"Text from file-local-variables during last evaluation.")
(defvar verilog-diff-function 'verilog-diff-report
- "*Function to run when `verilog-diff-auto' detects differences.
+ "Function to run when `verilog-diff-auto' detects differences.
Function takes three arguments, the original buffer, the
difference buffer, and the point in original buffer with the
first difference.")
("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 1 bold t)
("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 2 bold t)
)
- "*Keywords to also highlight in Verilog *compilation* buffers.
+ "Keywords to also highlight in Verilog *compilation* buffers.
Only used in XEmacs; GNU Emacs uses `verilog-error-regexp-emacs-alist'.")
(defcustom verilog-library-flags '("")
- "*List of standard Verilog arguments to use for /*AUTOINST*/.
+ "List of standard Verilog arguments to use for /*AUTOINST*/.
These arguments are used to find files for `verilog-auto', and match
the flags accepted by a standard Verilog-XL simulator.
(put 'verilog-library-flags 'safe-local-variable 'listp)
(defcustom verilog-library-directories '(".")
- "*List of directories when looking for files for /*AUTOINST*/.
+ "List of directories when looking for files for /*AUTOINST*/.
The directory may be relative to the current file, or absolute.
Environment variables are also expanded in the directory names.
Having at least the current directory is a good idea.
(put 'verilog-library-directories 'safe-local-variable 'listp)
(defcustom verilog-library-files '()
- "*List of files to search for modules.
+ "List of files to search for modules.
AUTOINST will use this when it needs to resolve a module name.
This is a complete path, usually to a technology file with many standard
cells defined in it.
(put 'verilog-library-files 'safe-local-variable 'listp)
(defcustom verilog-library-extensions '(".v" ".sv")
- "*List of extensions to use when looking for files for /*AUTOINST*/.
+ "List of extensions to use when looking for files for /*AUTOINST*/.
See also `verilog-library-flags', `verilog-library-directories'."
:type '(repeat string)
:group 'verilog-mode-auto)
(put 'verilog-library-extensions 'safe-local-variable 'listp)
(defcustom verilog-active-low-regexp nil
- "*If set, treat signals matching this regexp as active low.
+ "If set, treat signals matching this regexp as active low.
This is used for AUTORESET and AUTOTIEOFF. For proper behavior,
you will probably also need `verilog-auto-reset-widths' set."
:group 'verilog-mode-auto
(put 'verilog-active-low-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-sense-include-inputs nil
- "*If true, AUTOSENSE should include all inputs.
+ "Non-nil means AUTOSENSE should include all inputs.
If nil, only inputs that are NOT output signals in the same block are
included."
:group 'verilog-mode-auto
(put 'verilog-auto-sense-include-inputs 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-sense-defines-constant nil
- "*If true, AUTOSENSE should assume all defines represent constants.
+ "Non-nil means AUTOSENSE should assume all defines represent constants.
When true, the defines will not be included in sensitivity lists. To
maintain compatibility with other sites, this should be set at the bottom
of each Verilog file that requires it, rather than being set globally."
(put 'verilog-auto-sense-defines-constant 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-reset-blocking-in-non t
- "*If true, AUTORESET will reset those signals which were
-assigned with blocking assignments (=) even in a block with
-non-blocking assignments (<=).
+ "Non-nil means AUTORESET will reset blocking statements.
+When true, AUTORESET will reset in blocking statements those
+signals which were assigned with blocking assignments (=) even in
+a block with non-blocking assignments (<=).
If nil, all blocking assigned signals are ignored when any
non-blocking assignment is in the AUTORESET block. This allows
blocking assignments to be used for temporary values and not have
those temporaries reset. See example in `verilog-auto-reset'."
- :version "24.1"
+ :version "24.1" ;; rev718
:type 'boolean
:group 'verilog-mode-auto)
(put 'verilog-auto-reset-blocking-in-non 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-reset-widths t
- "*If true, AUTORESET should determine the width of signals.
+ "True means AUTORESET should determine the width of signals.
This is then used to set the width of the zero (32'h0 for example). This
is required by some lint tools that aren't smart enough to ignore widths of
-the constant zero. This may result in ugly code when parameters determine
-the MSB or LSB of a signal inside an AUTORESET."
+the constant zero. This may result in ugly code when parameters determine
+the MSB or LSB of a signal inside an AUTORESET.
+
+If nil, AUTORESET uses \"0\" as the constant.
+
+If 'unbased', AUTORESET used the unbased unsized literal \"'0\"
+as the constant. This setting is strongly recommended for
+SystemVerilog designs."
:type 'boolean
:group 'verilog-mode-auto)
-(put 'verilog-auto-reset-widths 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-reset-widths 'safe-local-variable
+ '(lambda (x) (memq x '(nil t unbased))))
(defcustom verilog-assignment-delay ""
- "*Text used for delays in delayed assignments. Add a trailing space if set."
+ "Text used for delays in delayed assignments. Add a trailing space if set."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-assignment-delay 'safe-local-variable 'stringp)
(defcustom verilog-auto-arg-sort nil
- "*If set, AUTOARG signal names will be sorted, not in declaration order.
+ "Non-nil means AUTOARG signal names will be sorted, not in declaration order.
Declaration order is advantageous with order based instantiations
and is the default for backward compatibility. Sorted order
reduces changes when declarations are moved around in a file, and
(put 'verilog-auto-arg-sort 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-dot-name nil
- "*If true, when creating ports with AUTOINST, use .name syntax.
+ "Non-nil means when creating ports with AUTOINST, use .name syntax.
This will use \".port\" instead of \".port(port)\" when possible.
This is only legal in SystemVerilog files, and will confuse older
simulators. Setting `verilog-auto-inst-vector' to nil may also
(put 'verilog-auto-inst-dot-name 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-param-value nil
- "*If set, AUTOINST will replace parameters with the parameter value.
+ "Non-nil means AUTOINST will replace parameters with the parameter value.
If nil, leave parameters as symbolic names.
Parameters must be in Verilog 2001 format #(...), and if a parameter is not
be replaced, and will remain symbolic.
For example, imagine a submodule uses parameters to declare the size of its
-inputs. This is then used by a upper module:
+inputs. This is then used by an upper module:
module InstModule (o,i);
parameter WIDTH;
(put 'verilog-auto-inst-param-value 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-sort nil
- "*If set, AUTOINST signal names will be sorted, not in declaration order.
+ "Non-nil means AUTOINST signals will be sorted, not in declaration order.
Also affects AUTOINSTPARAM. Declaration order is the default for
backward compatibility, and as some teams prefer signals that are
declared together to remain together. Sorted order reduces
changes when declarations are moved around in a file.
See also `verilog-auto-arg-sort'."
- :version "24.1"
+ :version "24.1" ;; rev688
:group 'verilog-mode-auto
:type 'boolean)
(put 'verilog-auto-inst-sort 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-vector t
- "*If true, when creating default ports with AUTOINST, use bus subscripts.
+ "Non-nil means when creating default ports with AUTOINST, use bus subscripts.
If nil, skip the subscript when it matches the entire bus as declared in
the module (AUTOWIRE signals always are subscripted, you must manually
declare the wire to have the subscripts removed.) Setting this to nil may
(put 'verilog-auto-inst-vector 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-template-numbers nil
- "*If true, when creating templated ports with AUTOINST, add a comment.
+ "If true, when creating templated ports with AUTOINST, add a comment.
If t, the comment will add the line number of the template that
was used for that port declaration. This setting is suggested
'(lambda (x) (memq x '(nil t lhs))))
(defcustom verilog-auto-inst-column 40
- "*Indent-to column number for net name part of AUTOINST created pin."
+ "Indent-to column number for net name part of AUTOINST created pin."
:group 'verilog-mode-indent
:type 'integer)
(put 'verilog-auto-inst-column 'safe-local-variable 'integerp)
+(defcustom verilog-auto-inst-interfaced-ports nil
+ "Non-nil means include interfaced ports in AUTOINST expansions."
+ :group 'verilog-mode-auto
+ :type 'boolean
+ :version "24.3")
+(put 'verilog-auto-inst-interfaced-ports 'safe-local-variable 'verilog-booleanp)
+
(defcustom verilog-auto-input-ignore-regexp nil
- "*If set, when creating AUTOINPUT list, ignore signals matching this regexp.
+ "If set, when creating AUTOINPUT list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-inout-ignore-regexp nil
- "*If set, when creating AUTOINOUT list, ignore signals matching this regexp.
+ "If set, when creating AUTOINOUT list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-output-ignore-regexp nil
- "*If set, when creating AUTOOUTPUT list, ignore signals matching this regexp.
+ "If set, when creating AUTOOUTPUT list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp)
+(defcustom verilog-auto-template-warn-unused nil
+ "Non-nil means report warning if an AUTO_TEMPLATE line is not used.
+This feature is not supported before Emacs 21.1 or XEmacs 21.4."
+ :group 'verilog-mode-auto
+ :type 'boolean)
+(put 'verilog-auto-template-warn-unused 'safe-local-variable 'verilog-booleanp)
+
(defcustom verilog-auto-tieoff-declaration "wire"
- "*Data type used for the declaration for AUTOTIEOFF. If \"wire\" then
-create a wire, if \"assign\" create an assignment, else the data type for
-variable creation."
- :version "24.1"
+ "Data type used for the declaration for AUTOTIEOFF.
+If \"wire\" then create a wire, if \"assign\" create an
+assignment, else the data type for variable creation."
+ :version "24.1" ;; rev713
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-tieoff-declaration 'safe-local-variable 'stringp)
(defcustom verilog-auto-tieoff-ignore-regexp nil
- "*If set, when creating AUTOTIEOFF list, ignore signals matching this regexp.
+ "If set, when creating AUTOTIEOFF list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-unused-ignore-regexp nil
- "*If set, when creating AUTOUNUSED list, ignore signals matching this regexp.
+ "If set, when creating AUTOUNUSED list, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-typedef-regexp nil
- "*If non-nil, regular expression that matches Verilog-2001 typedef names.
+ "If non-nil, regular expression that matches Verilog-2001 typedef names.
For example, \"_t$\" matches typedefs named with _t, as in the C language."
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-typedef-regexp 'safe-local-variable 'stringp)
(defcustom verilog-mode-hook 'verilog-set-compile-command
- "*Hook run after Verilog mode is loaded."
+ "Hook run after Verilog mode is loaded."
:type 'hook
:group 'verilog-mode)
(defcustom verilog-auto-hook nil
- "*Hook run after `verilog-mode' updates AUTOs."
+ "Hook run after `verilog-mode' updates AUTOs."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-before-auto-hook nil
- "*Hook run before `verilog-mode' updates AUTOs."
+ "Hook run before `verilog-mode' updates AUTOs."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-delete-auto-hook nil
- "*Hook run after `verilog-mode' deletes AUTOs."
+ "Hook run after `verilog-mode' deletes AUTOs."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-before-delete-auto-hook nil
- "*Hook run before `verilog-mode' deletes AUTOs."
+ "Hook run before `verilog-mode' deletes AUTOs."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-getopt-flags-hook nil
- "*Hook run after `verilog-getopt-flags' determines the Verilog option lists."
+ "Hook run after `verilog-getopt-flags' determines the Verilog option lists."
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-before-getopt-flags-hook nil
- "*Hook run before `verilog-getopt-flags' determines the Verilog option lists."
+ "Hook run before `verilog-getopt-flags' determines the Verilog option lists."
+ :group 'verilog-mode-auto
+ :type 'hook)
+
+(defcustom verilog-before-save-font-hook nil
+ "Hook run before `verilog-save-font-mods' removes highlighting."
+ :group 'verilog-mode-auto
+ :type 'hook)
+
+(defcustom verilog-after-save-font-hook nil
+ "Hook run after `verilog-save-font-mods' restores highlighting."
:group 'verilog-mode-auto
:type 'hook)
;; Customization variables:
;;
(defvar verilog-date-scientific-format nil
- "*If non-nil, dates are written in scientific format (e.g. 1997/09/17).
+ "If non-nil, dates are written in scientific format (e.g. 1997/09/17).
If nil, in European format (e.g. 17.09.1997). The brain-dead American
format (e.g. 09/17/1997) is not supported.")
(defvar verilog-company nil
- "*Default name of Company for Verilog header.
+ "Default name of Company for Verilog header.
If set will become buffer local.")
(make-variable-buffer-local 'verilog-company)
(defvar verilog-project nil
- "*Default name of Project for Verilog header.
+ "Default name of Project for Verilog header.
If set will become buffer local.")
(make-variable-buffer-local 'verilog-project)
:help "Help on AUTOARG - declaring module port list"]
["AUTOASCIIENUM" (describe-function 'verilog-auto-ascii-enum)
:help "Help on AUTOASCIIENUM - creating ASCII for enumerations"]
+ ["AUTOASSIGNMODPORT" (describe-function 'verilog-auto-assign-modport)
+ :help "Help on AUTOASSIGNMODPORT - creating assignments to/from modports"]
["AUTOINOUTCOMP" (describe-function 'verilog-auto-inout-comp)
:help "Help on AUTOINOUTCOMP - copying complemented i/o from another file"]
["AUTOINOUTIN" (describe-function 'verilog-auto-inout-in)
- :help "Help on AUTOINOUTCOMP - copying i/o from another file as all inputs"]
+ :help "Help on AUTOINOUTIN - copying i/o from another file as all inputs"]
+ ["AUTOINOUTMODPORT" (describe-function 'verilog-auto-inout-modport)
+ :help "Help on AUTOINOUTMODPORT - copying i/o from an interface modport"]
["AUTOINOUTMODULE" (describe-function 'verilog-auto-inout-module)
:help "Help on AUTOINOUTMODULE - copying i/o from another file"]
+ ["AUTOINOUTPARAM" (describe-function 'verilog-auto-inout-param)
+ :help "Help on AUTOINOUTPARAM - copying parameters from another file"]
["AUTOINSERTLISP" (describe-function 'verilog-auto-insert-lisp)
:help "Help on AUTOINSERTLISP - insert text from a lisp function"]
["AUTOINOUT" (describe-function 'verilog-auto-inout)
:help "Help on AUTOSENSE - sensitivity lists for always blocks"]
["AUTOTIEOFF" (describe-function 'verilog-auto-tieoff)
:help "Help on AUTOTIEOFF - tying off unused outputs"]
+ ["AUTOUNDEF" (describe-function 'verilog-auto-undef)
+ :help "Help on AUTOUNDEF - undefine all local defines"]
["AUTOUNUSED" (describe-function 'verilog-auto-unused)
:help "Help on AUTOUNUSED - terminating unused inputs"]
["AUTOWIRE" (describe-function 'verilog-auto-wire)
FIXEDCASE and LITERAL as in `replace-match`. STRING is what to replace.
The case (verilog-string-replace-matches \"o\" \"oo\" nil nil \"foobar\")
will break, as the o's continuously replace. xa -> x works ok though."
- ;; Hopefully soon to a emacs built-in
+ ;; Hopefully soon to an Emacs built-in
;; Also note \ in the replacement prevent multiple replacements; IE
;; (verilog-string-replace-matches "@" "\\\\([0-9]+\\\\)" nil nil "wire@_@")
;; Gives "wire\([0-9]+\)_@" not "wire\([0-9]+\)_\([0-9]+\)"
;;(verilog-re-search-backward-substr "-end" "get-end-of" nil t) ;;-end (test bait)
(defun verilog-delete-trailing-whitespace ()
- "Delete trailing spaces or tabs, but not newlines nor linefeeds."
+ "Delete trailing spaces or tabs, but not newlines nor linefeeds.
+Also add missing final newline.
+
+To call this from the command line, see \\[verilog-batch-diff-auto].
+
+To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'."
;; Similar to `delete-trailing-whitespace' but that's not present in XEmacs
(save-excursion
(goto-char (point-min))
(while (re-search-forward "[ \t]+$" nil t) ;; Not syntactic WS as no formfeed
- (replace-match "" nil nil))))
+ (replace-match "" nil nil))
+ (goto-char (point-max))
+ (unless (bolp) (insert "\n"))))
(defvar compile-command)
"\\|\\(\\<`[ou]vm_[a-z_]+_begin\\>\\)" ;28
"\\|\\(\\<`vmm_[a-z_]+_member_begin\\>\\)"
;;
-
))
(defconst verilog-end-block-ordered-rry
"endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass"
))))
(defconst verilog-disable-fork-re "\\(disable\\|wait\\)\\s-+fork\\>")
-(defconst verilog-extended-case-re "\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?")
+(defconst verilog-extended-case-re "\\(\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?\\)")
(defconst verilog-extended-complete-re
- (concat "\\(\\<extern\\s-+\\|\\<\\(\\<pure\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)"
- "\\|\\(\\<typedef\\>\\s-+\\)*\\(\\<struct\\>\\|\\<union\\>\\|\\<class\\>\\)"
- "\\|\\(\\<import\\>\\s-+\\)?\"DPI-C\"\\s-+\\(function\\>\\|task\\>\\)"
+ (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<pure\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)"
+ "\\|\\(\\(\\<typedef\\>\\s-+\\)*\\(\\<struct\\>\\|\\<union\\>\\|\\<class\\>\\)\\)"
+ "\\|\\(\\(\\<import\\>\\s-+\\)?\\(\"DPI-C\"\\s-+\\)?\\(\\<pure\\>\\s-+\\)?\\(function\\>\\|task\\>\\)\\)"
"\\|" verilog-extended-case-re ))
(defconst verilog-basic-complete-re
(eval-when-compile
))))
(defconst verilog-complete-reg
(concat
- verilog-extended-complete-re
- "\\|"
- verilog-basic-complete-re))
+ verilog-extended-complete-re "\\|\\(" verilog-basic-complete-re "\\)"))
(defconst verilog-end-statement-re
(concat "\\(" verilog-beg-block-re "\\)\\|\\("
(defvar verilog-font-lock-keywords-3 nil
"Gaudy level highlighting for Verilog mode.
See also `verilog-font-lock-extra-types'.")
-(defvar verilog-font-lock-translate-off-face
+
+(defvar verilog-font-lock-translate-off-face
'verilog-font-lock-translate-off-face
"Font to use for translated off regions.")
(defface verilog-font-lock-translate-off-face
(verilog-pragma-keywords
(eval-when-compile
(verilog-regexp-opt
- '("surefire" "synopsys" "rtl_synthesis" "verilint" "leda" "0in") nil
- )))
+ '("surefire" "auto" "synopsys" "rtl_synthesis" "verilint" "leda" "0in"
+ ) nil )))
(verilog-1800-2005-keywords
(eval-when-compile
(append verilog-font-lock-keywords-1
(list
;; Fontify pragmas
- (concat "\\(//\\s-*" verilog-pragma-keywords "\\s-.*\\)")
+ (concat "\\(//\\s-*\\(" verilog-pragma-keywords "\\)\\s-.*\\)")
;; Fontify escaped names
'("\\(\\\\\\S-*\\s-\\)" 0 font-lock-function-name-face)
;; Fontify macro definitions/ uses
after-change-functions)
(progn ,@body)))
+(defvar verilog-save-font-mod-hooked nil
+ "Local variable when inside a `verilog-save-font-mods' block.")
+(make-variable-buffer-local 'verilog-save-font-mod-hooked)
+
+(defmacro verilog-save-font-mods (&rest body)
+ "Execute BODY forms, disabling text modifications to allow performing BODY.
+Includes temporary disabling of `font-lock' to restore the buffer
+to full text form for parsing. Additional actions may be specified with
+`verilog-before-save-font-hook' and `verilog-after-save-font-hook'."
+ ;; Before version 20, match-string with font-lock returns a
+ ;; vector that is not equal to the string. IE if on "input"
+ ;; nil==(equal "input" (progn (looking-at "input") (match-string 0)))
+ `(let* ((hooked (unless verilog-save-font-mod-hooked
+ (verilog-run-hooks 'verilog-before-save-font-hook)
+ t))
+ (verilog-save-font-mod-hooked t)
+ (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode)
+ (font-lock-mode 0)
+ t)))
+ (unwind-protect
+ (progn ,@body)
+ ;; Unwind forms
+ (when fontlocked (font-lock-mode t))
+ (when hooked (verilog-run-hooks 'verilog-after-save-font-hook)))))
+
;;
;; Comment detection and caching
(defun verilog-insert (&rest stuff)
"Insert STUFF arguments, tracking for `verilog-inside-comment-or-string-p'.
-Any insert that includes a comment must have the entire commente
+Any insert that includes a comment must have the entire comment
inserted using a single call to `verilog-insert'."
(let ((pt (point)))
(while stuff
;; Stuff for GNU Emacs
(set (make-local-variable 'font-lock-defaults)
- `((verilog-font-lock-keywords verilog-font-lock-keywords-1
- verilog-font-lock-keywords-2
- verilog-font-lock-keywords-3)
+ `((verilog-font-lock-keywords
+ verilog-font-lock-keywords-1
+ verilog-font-lock-keywords-2
+ verilog-font-lock-keywords-3)
nil nil nil
,(if (functionp 'syntax-ppss)
;; verilog-beg-of-defun uses syntax-ppss, and syntax-ppss uses
(set (make-local-variable 'imenu-generic-expression)
verilog-imenu-generic-expression)
;; Tell which-func-modes that imenu knows about verilog
- (when (boundp 'which-func-modes)
+ (when (and (boundp 'which-func-modes) (listp which-func-modes))
(add-to-list 'which-func-modes 'verilog-mode))
;; hideshow support
(when (boundp 'hs-special-modes-alist)
(if (looking-at verilog-label-re)
(setq h (point))))
(goto-char h)))
- ;; stop if we see a complete reg, perhaps an extended one
+ ;; stop if we see an extended complete reg, perhaps a complete one
(and
(looking-at verilog-complete-reg)
(let* ((p (point)))
nil)))
(defun verilog-backward-up-list (arg)
- "Like `backward-up-list', but deal with comments."
+ "Call `backward-up-list' ARG, ignoring comments."
(let ((parse-sexp-ignore-comments t))
(backward-up-list arg)))
(defun verilog-forward-sexp-cmt (arg)
- "Call `forward-sexp', inside comments."
+ "Call `forward-sexp' ARG, inside comments."
(let ((parse-sexp-ignore-comments nil))
(forward-sexp arg)))
(defun verilog-forward-sexp-ign-cmt (arg)
- "Call `forward-sexp', ignoring comments."
+ "Call `forward-sexp' ARG, ignoring comments."
(let ((parse-sexp-ignore-comments t))
(forward-sexp arg)))
-(defun verilog-in-struct-region-p ()
- "Return true if in a struct region.
-More specifically, in a list after a struct|union keyword."
- (interactive)
- (save-excursion
- (let* ((state (verilog-syntax-ppss))
- (depth (nth 0 state)))
- (if depth
- (progn (verilog-backward-up-list depth)
- (verilog-beg-of-statement)
- (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>"))))))
-
(defun verilog-in-generate-region-p ()
"Return true if in a generate region.
More specifically, after a generate and before an endgenerate."
(cond
((match-end 5) ;; of verilog-end-block-ordered-re
(setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
- (setq name-re "\\w+\\s-*(")
- )
+ (setq name-re "\\w+\\s-*("))
((match-end 6) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)"))
+ (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
+ (setq name-re "\\w+\\s-*("))
((match-end 7) ;; of verilog-end-block-ordered-re
(setq reg "\\(\\<\\(macro\\)?module\\>\\)\\|\\<endmodule\\>"))
((match-end 8) ;; of verilog-end-block-ordered-re
(compile compile-command))
(defun verilog-preprocess (&optional command filename)
- "Preprocess the buffer, similar to `compile', but leave output in Verilog-Mode.
+ "Preprocess the buffer, similar to `compile', but put output in Verilog-Mode.
Takes optional COMMAND or defaults to `verilog-preprocessor', and
-FILENAME or defaults to `buffer-file-name`."
+FILENAME to find directory to run in, or defaults to `buffer-file-name`."
(interactive
(list
(let ((default (verilog-expand-command verilog-preprocessor)))
(set (make-local-variable `verilog-preprocessor)
- (read-from-minibuffer "Run Preprocessor (like this): "
- default nil nil
- 'verilog-preprocess-history default)))))
+ (read-from-minibuffer "Run Preprocessor (like this): "
+ default nil nil
+ 'verilog-preprocess-history default)))))
(unless command (setq command (verilog-expand-command verilog-preprocessor)))
(let* ((fontlocked (and (boundp 'font-lock-mode) font-lock-mode))
- (dir (file-name-directory (or filename buffer-file-name)))
- (file (file-name-nondirectory (or filename buffer-file-name)))
- (cmd (concat "cd " dir "; " command " " file)))
+ (dir (file-name-directory (or filename buffer-file-name)))
+ (cmd (concat "cd " dir "; " command)))
(with-output-to-temp-buffer "*Verilog-Preprocessed*"
(with-current-buffer (get-buffer "*Verilog-Preprocessed*")
(insert (concat "// " cmd "\n"))
- (shell-command cmd "*Verilog-Preprocessed*")
+ (call-process shell-file-name nil t nil shell-command-switch cmd)
(verilog-mode)
;; Without this force, it takes a few idle seconds
;; to get the color, which is very jarring
;; Batch
;;
+(defun verilog-warn (string &rest args)
+ "Print a warning with `format' using STRING and optional ARGS."
+ (apply 'message (concat "%%Warning: " string) args))
+
+(defun verilog-warn-error (string &rest args)
+ "Call `error' using STRING and optional ARGS.
+If `verilog-warn-fatal' is non-nil, call `verilog-warn' instead."
+ (if verilog-warn-fatal
+ (apply 'error string args)
+ (apply 'verilog-warn string args)))
+
(defmacro verilog-batch-error-wrapper (&rest body)
"Execute BODY and add error prefix to any errors found.
This lets programs calling batch mode to easily extract error messages."
- `(condition-case err
- (progn ,@body)
- (error
- (error "%%Error: %s%s" (error-message-string err)
- (if (featurep 'xemacs) "\n" ""))))) ;; XEmacs forgets to add a newline
+ `(let ((verilog-warn-fatal nil))
+ (condition-case err
+ (progn ,@body)
+ (error
+ (error "%%Error: %s%s" (error-message-string err)
+ (if (featurep 'xemacs) "\n" "")))))) ;; XEmacs forgets to add a newline
(defun verilog-batch-execute-func (funref &optional no-save)
- "Internal processing of a batch command, running FUNREF on all command arguments.
+ "Internal processing of a batch command.
+Runs FUNREF on all command arguments.
Save the result unless optional NO-SAVE is t."
(verilog-batch-error-wrapper
;; Setting global variables like that is *VERY NASTY* !!! --Stef
(error "Use verilog-batch-delete-auto only with --batch")) ;; Otherwise we'd mess up buffer modes
(verilog-batch-execute-func `verilog-delete-auto))
+(defun verilog-batch-delete-trailing-whitespace ()
+ "For use with --batch, perform whitespace deletion as a stand-alone tool.
+This sets up the appropriate Verilog mode environment, removes
+whitespace with \\[verilog-delete-trailing-whitespace] on all
+command-line files, and saves the buffers."
+ (unless noninteractive
+ (error "Use verilog-batch-delete-trailing-whitepace only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (verilog-batch-execute-func `verilog-delete-trailing-whitespace))
+
(defun verilog-batch-diff-auto ()
"For use with --batch, perform automatic differences as a stand-alone tool.
This sets up the appropriate Verilog mode environment, expand automatics
(verilog-batch-execute-func `verilog-inject-auto))
(defun verilog-batch-indent ()
- "For use with --batch, reindent an a entire file as a stand-alone tool.
+ "For use with --batch, reindent an entire file as a stand-alone tool.
This sets up the appropriate Verilog mode environment, calls
\\[verilog-indent-buffer] on all command-line files, and saves the buffers."
(unless noninteractive
(verilog-beg-of-statement) ;; doesn't get to beginning
(if (looking-at verilog-property-re)
(throw 'nesting 'statement) ; We don't need an endproperty for these
- (throw 'nesting 'block) ;We still need a endproperty
+ (throw 'nesting 'block) ;We still need an endproperty
))
(t ; endblock
; try to leap back to matching outward block by striding across
(t
(setq depth (verilog-current-indent-level)))))
(message "You are at nesting %s depth %d" type depth))))
-
(defun verilog-calc-1 ()
(catch 'nesting
(let ((re (concat "\\({\\|}\\|" verilog-indent-re "\\)")))
; endfunction
(verilog-beg-of-statement)
(if (looking-at verilog-beg-block-re-ordered)
- (throw 'nesting 'block)
- (throw 'nesting 'defun)))
+ (throw 'nesting 'block)
+ (throw 'nesting 'defun)))
+ ;;
((looking-at "\\<property\\>")
; *sigh*
; {assert|assume|cover} property (); are complete
(verilog-beg-of-statement)
(if (looking-at verilog-property-re)
(throw 'continue 'statement) ; We don't need an endproperty for these
- (throw 'nesting 'block) ;We still need a endproperty
+ (throw 'nesting 'block) ;We still need an endproperty
))
(t (throw 'nesting 'block))))
(forward-comment (- (buffer-size))))
(defun verilog-backward-syntactic-ws-quick ()
- "As with `verilog-backward-syntactic-ws' but uses `verilog-scan' cache."
+ "As with `verilog-backward-syntactic-ws' but use `verilog-scan' cache."
(while (cond ((bobp)
nil) ; Done
((> (skip-syntax-backward " ") 0)
(defun verilog-in-paren-quick ()
"Return true if in a parenthetical expression.
-Always starts from point-min, to allow inserts with hooks disabled."
+Always starts from `point-min', to allow inserts with hooks disabled."
;; The -quick refers to its use alongside the other -quick functions,
;; not that it's likely to be faster than verilog-in-paren.
(let ((state (save-excursion (parse-partial-sexp (point-min) (point)))))
(indent-line-to val)
(if (and (not verilog-indent-lists)
(verilog-in-paren))
- (verilog-pretty-declarations))
+ (verilog-pretty-declarations-auto))
))
((= (preceding-char) ?\) )
(goto-char here)
(looking-at verilog-declaration-re))))
(indent-line-to val)
(if decl
- (verilog-pretty-declarations))))
+ (verilog-pretty-declarations-auto))))
(;-- Handle the ends
(or
;;
+(defun verilog-pretty-declarations-auto (&optional quiet)
+ "Call `verilog-pretty-declarations' QUIET based on `verilog-auto-lineup'."
+ (when (or (eq 'all verilog-auto-lineup)
+ (eq 'declarations verilog-auto-lineup))
+ (verilog-pretty-declarations quiet)))
+
(defun verilog-pretty-declarations (&optional quiet)
"Line up declarations around point.
Be verbose about progress unless optional QUIET set."
(interactive)
(if (not (verilog-in-comment-or-string-p))
(save-excursion
- (let ((rexp (concat "^\\s-*" verilog-complete-reg)))
- (beginning-of-line)
- (if (and (not (looking-at rexp ))
- (looking-at verilog-assignment-operation-re)
- (save-excursion
- (goto-char (match-end 2))
- (and (not (verilog-in-attribute-p))
- (not (verilog-in-parameter-p))
- (not (verilog-in-comment-or-string-p)))))
- (let* ((here (point))
- (e) (r)
- (start
- (progn
- (beginning-of-line)
- (setq e (point))
- (verilog-backward-syntactic-ws)
- (beginning-of-line)
- (while (and (not (looking-at rexp ))
- (looking-at verilog-assignment-operation-re)
- (not (bobp))
- )
- (setq e (point))
- (verilog-backward-syntactic-ws)
- (beginning-of-line)
- ) ;Ack, need to grok `define
- e))
- (end
- (progn
- (goto-char here)
- (end-of-line)
- (setq e (point)) ;Might be on last line
- (verilog-forward-syntactic-ws)
- (beginning-of-line)
- (while (and
- (not (looking-at rexp ))
- (looking-at verilog-assignment-operation-re)
- (progn
- (end-of-line)
- (not (eq e (point)))))
- (setq e (point))
- (verilog-forward-syntactic-ws)
- (beginning-of-line)
- )
- e))
- (endpos (set-marker (make-marker) end))
- (ind)
- )
- (goto-char start)
- (verilog-do-indent (verilog-calculate-indent))
- (if (and (not quiet)
- (> (- end start) 100))
- (message "Lining up expressions..(please stand by)"))
-
- ;; Set indent to minimum throughout region
- (while (< (point) (marker-position endpos))
- (beginning-of-line)
- (verilog-just-one-space verilog-assignment-operation-re)
- (beginning-of-line)
- (verilog-do-indent (verilog-calculate-indent))
- (end-of-line)
- (verilog-forward-syntactic-ws)
- )
-
- ;; Now find biggest prefix
- (setq ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start endpos))
-
- ;; Now indent each line.
- (goto-char start)
- (while (progn (setq e (marker-position endpos))
- (setq r (- e (point)))
- (> r 0))
- (setq e (point))
- (if (not quiet) (message "%d" r))
- (cond
- ((looking-at verilog-assignment-operation-re)
- (goto-char (match-beginning 2))
- (if (not (or (verilog-in-parenthesis-p) ;; leave attributes and comparisons alone
- (verilog-in-coverage-p)))
- (if (eq (char-after) ?=)
- (indent-to (1+ ind)) ; line up the = of the <= with surrounding =
- (indent-to ind)
- ))
- )
- ((verilog-continued-line-1 start)
- (goto-char e)
- (indent-line-to ind))
- (t ; Must be comment or white space
- (goto-char e)
- (verilog-forward-ws&directives)
- (forward-line -1))
- )
- (forward-line 1))
- (unless quiet (message ""))
- ))))))
+ (let ( (rexp (concat "^\\s-*" verilog-complete-reg))
+ (rexp1 (concat "^\\s-*" verilog-basic-complete-re)))
+ (beginning-of-line)
+ (if (and (not (looking-at rexp ))
+ (looking-at verilog-assignment-operation-re)
+ (save-excursion
+ (goto-char (match-end 2))
+ (and (not (verilog-in-attribute-p))
+ (not (verilog-in-parameter-p))
+ (not (verilog-in-comment-or-string-p)))))
+ (let* ((here (point))
+ (e) (r)
+ (start
+ (progn
+ (beginning-of-line)
+ (setq e (point))
+ (verilog-backward-syntactic-ws)
+ (beginning-of-line)
+ (while (and (not (looking-at rexp1))
+ (looking-at verilog-assignment-operation-re)
+ (not (bobp))
+ )
+ (setq e (point))
+ (verilog-backward-syntactic-ws)
+ (beginning-of-line)
+ ) ;Ack, need to grok `define
+ e))
+ (end
+ (progn
+ (goto-char here)
+ (end-of-line)
+ (setq e (point)) ;Might be on last line
+ (verilog-forward-syntactic-ws)
+ (beginning-of-line)
+ (while (and
+ (not (looking-at rexp1 ))
+ (looking-at verilog-assignment-operation-re)
+ (progn
+ (end-of-line)
+ (not (eq e (point)))))
+ (setq e (point))
+ (verilog-forward-syntactic-ws)
+ (beginning-of-line)
+ )
+ e))
+ (endpos (set-marker (make-marker) end))
+ (ind)
+ )
+ (goto-char start)
+ (verilog-do-indent (verilog-calculate-indent))
+ (if (and (not quiet)
+ (> (- end start) 100))
+ (message "Lining up expressions..(please stand by)"))
+
+ ;; Set indent to minimum throughout region
+ (while (< (point) (marker-position endpos))
+ (beginning-of-line)
+ (verilog-just-one-space verilog-assignment-operation-re)
+ (beginning-of-line)
+ (verilog-do-indent (verilog-calculate-indent))
+ (end-of-line)
+ (verilog-forward-syntactic-ws)
+ )
+
+ ;; Now find biggest prefix
+ (setq ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start endpos))
+
+ ;; Now indent each line.
+ (goto-char start)
+ (while (progn (setq e (marker-position endpos))
+ (setq r (- e (point)))
+ (> r 0))
+ (setq e (point))
+ (if (not quiet) (message "%d" r))
+ (cond
+ ((looking-at verilog-assignment-operation-re)
+ (goto-char (match-beginning 2))
+ (if (not (or (verilog-in-parenthesis-p) ;; leave attributes and comparisons alone
+ (verilog-in-coverage-p)))
+ (if (eq (char-after) ?=)
+ (indent-to (1+ ind)) ; line up the = of the <= with surrounding =
+ (indent-to ind)
+ ))
+ )
+ ((verilog-continued-line-1 start)
+ (goto-char e)
+ (indent-line-to ind))
+ (t ; Must be comment or white space
+ (goto-char e)
+ (verilog-forward-ws&directives)
+ (forward-line -1))
+ )
+ (forward-line 1))
+ (unless quiet (message ""))
+ ))))))
(defun verilog-just-one-space (myre)
"Remove extra spaces around regular expression MYRE."
(defvar verilog-buffer-to-use nil)
(defvar verilog-flag nil)
(defvar verilog-toggle-completions nil
- "*True means \\<verilog-mode-map>\\[verilog-complete-word] should try all possible completions one by one.
+ "True means \\<verilog-mode-map>\\[verilog-complete-word] should try all possible completions one by one.
Repeated use of \\[verilog-complete-word] will show you all of them.
Normally, when there is more than one possible completion,
it displays a list of all possible completions.")
"rtranif1" "semaphore" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
"triand" "trior" "trireg" "wand" "wire" "wor" "xnor" "xor"
)
- "*Keywords for types used when completing a word in a declaration or parmlist.
+ "Keywords for types used when completing a word in a declaration or parmlist.
\(integer, real, reg...)")
(defvar verilog-cpp-keywords
'("module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else"
"endif")
- "*Keywords to complete when at first word of a line in declarative scope.
+ "Keywords to complete when at first word of a line in declarative scope.
\(initial, always, begin, assign...)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
"task" "endtask" "primitive" "endprimitive"
)
verilog-type-keywords)
- "*Keywords to complete when at first word of a line in declarative scope.
+ "Keywords to complete when at first word of a line in declarative scope.
\(initial, always, begin, assign...)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
"endgenerate" "endinterface" "endpackage" "endspecify" "endtask"
"for" "fork" "if" "join" "join_any" "join_none" "repeat" "return"
"while")
- "*Keywords to complete when at first word of a line in behavioral scope.
+ "Keywords to complete when at first word of a line in behavioral scope.
\(begin, if, then, else, for, fork...)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
(defvar verilog-tf-keywords
'("begin" "break" "fork" "join" "join_any" "join_none" "case" "end" "endtask" "endfunction" "if" "else" "for" "while" "repeat")
- "*Keywords to complete when at first word of a line in a task or function.
+ "Keywords to complete when at first word of a line in a task or function.
\(begin, if, then, else, for, fork.)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
(defvar verilog-case-keywords
'("begin" "fork" "join" "join_any" "join_none" "case" "end" "endcase" "if" "else" "for" "repeat")
- "*Keywords to complete when at first word of a line in case scope.
+ "Keywords to complete when at first word of a line in case scope.
\(begin, if, then, else, for, fork...)
The procedures and variables defined within the Verilog program
will be completed at runtime and should not be added to this list.")
(defvar verilog-separator-keywords
'("else" "then" "begin")
- "*Keywords to complete when NOT standing at the first word of a statement.
+ "Keywords to complete when NOT standing at the first word of a statement.
\(else, then, begin...)
Variables and function names defined within the Verilog program
will be completed at runtime and should not be added to this list.")
("tranif1" "inout" "inout")
("xnor" "output")
("xor" "output"))
- "*Map of direction for each positional argument to each gate primitive.")
+ "Map of direction for each positional argument to each gate primitive.")
(defvar verilog-gate-keywords (mapcar `car verilog-gate-ios)
- "*Keywords for gate primitives.")
+ "Keywords for gate primitives.")
(defun verilog-string-diff (str1 str2)
"Return index of first letter where STR1 and STR2 differs."
;;
;; Elements of a signal list
+;; Unfortunately we use 'assoc' on this, so can't be a vector
(defsubst verilog-sig-new (name bits comment mem enum signed type multidim modport)
(list name bits comment mem enum signed type multidim modport))
(defsubst verilog-sig-name (sig)
(nth 5 sig))
(defsubst verilog-sig-type (sig)
(nth 6 sig))
+(defsubst verilog-sig-type-set (sig type)
+ (setcar (nthcdr 6 sig) type))
(defsubst verilog-sig-multidim (sig)
(nth 7 sig))
(defsubst verilog-sig-multidim-string (sig)
(verilog-make-width-expression (verilog-sig-bits sig)))
(defsubst verilog-alw-new (outputs-del outputs-imm temps inputs)
- (list outputs-del outputs-imm temps inputs))
+ (vector outputs-del outputs-imm temps inputs))
(defsubst verilog-alw-get-outputs-delayed (sigs)
- (nth 0 sigs))
+ (aref sigs 0))
(defsubst verilog-alw-get-outputs-immediate (sigs)
- (nth 1 sigs))
+ (aref sigs 1))
(defsubst verilog-alw-get-temps (sigs)
- (nth 2 sigs))
+ (aref sigs 2))
(defsubst verilog-alw-get-inputs (sigs)
- (nth 3 sigs))
+ (aref sigs 3))
(defsubst verilog-alw-get-uses-delayed (sigs)
- (nth 0 sigs))
+ (aref sigs 0))
+
+(defsubst verilog-modport-new (name clockings decls)
+ (list name clockings decls))
+(defsubst verilog-modport-name (sig)
+ (car sig))
+(defsubst verilog-modport-clockings (sig)
+ (nth 1 sig)) ;; Returns list of names
+(defsubst verilog-modport-clockings-add (sig val)
+ (setcar (nthcdr 1 sig) (cons val (nth 1 sig))))
+(defsubst verilog-modport-decls (sig)
+ (nth 2 sig)) ;; Returns verilog-decls-* structure
+(defsubst verilog-modport-decls-set (sig val)
+ (setcar (nthcdr 2 sig) val))
(defsubst verilog-modi-new (name fob pt type)
(vector name fob pt type))
;; Signal reading for given module
;; Note these all take modi's - as returned from verilog-modi-current
-(defsubst verilog-decls-new (out inout in vars unuseds assigns consts gparams interfaces)
- (vector out inout in vars unuseds assigns consts gparams interfaces))
+(defsubst verilog-decls-new (out inout in vars modports assigns consts gparams interfaces)
+ (vector out inout in vars modports assigns consts gparams interfaces))
+(defsubst verilog-decls-append (a b)
+ (cond ((not a) b) ((not b) a)
+ (t (vector (append (aref a 0) (aref b 0)) (append (aref a 1) (aref b 1))
+ (append (aref a 2) (aref b 2)) (append (aref a 3) (aref b 3))
+ (append (aref a 4) (aref b 4)) (append (aref a 5) (aref b 5))
+ (append (aref a 6) (aref b 6)) (append (aref a 7) (aref b 7))
+ (append (aref a 8) (aref b 8))))))
(defsubst verilog-decls-get-outputs (decls)
(aref decls 0))
(defsubst verilog-decls-get-inouts (decls)
(aref decls 2))
(defsubst verilog-decls-get-vars (decls)
(aref decls 3))
-;;(defsubst verilog-decls-get-unused (decls)
-;; (aref decls 4))
+(defsubst verilog-decls-get-modports (decls) ;; Also for clocking blocks; contains another verilog-decls struct
+ (aref decls 4)) ;; Returns verilog-modport* structure
(defsubst verilog-decls-get-assigns (decls)
(aref decls 5))
(defsubst verilog-decls-get-consts (decls)
(defsubst verilog-decls-get-interfaces (decls)
(aref decls 8))
+
(defsubst verilog-subdecls-new (out inout in intf intfd)
(vector out inout in intf intfd))
(defsubst verilog-subdecls-get-outputs (subdecls)
(defsubst verilog-subdecls-get-interfaced (subdecls)
(aref subdecls 4))
+(defun verilog-signals-from-signame (signame-list)
+ "Return signals in standard form from SIGNAME-LIST, a simple list of names."
+ (mapcar (lambda (name) (verilog-sig-new name nil nil nil nil nil nil nil nil))
+ signame-list))
+
+(defun verilog-signals-in (in-list not-list)
+ "Return list of signals in IN-LIST that are also in NOT-LIST.
+Also remove any duplicates in IN-LIST.
+Signals must be in standard (base vector) form."
+ ;; This function is hot, so implemented as O(1)
+ (cond ((eval-when-compile (fboundp 'make-hash-table))
+ (let ((ht (make-hash-table :test 'equal :rehash-size 4.0))
+ (ht-not (make-hash-table :test 'equal :rehash-size 4.0))
+ out-list)
+ (while not-list
+ (puthash (car (car not-list)) t ht-not)
+ (setq not-list (cdr not-list)))
+ (while in-list
+ (when (and (gethash (verilog-sig-name (car in-list)) ht-not)
+ (not (gethash (verilog-sig-name (car in-list)) ht)))
+ (setq out-list (cons (car in-list) out-list))
+ (puthash (verilog-sig-name (car in-list)) t ht))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))
+ ;; Slower Fallback if no hash tables (pre Emacs 21.1/XEmacs 21.4)
+ (t
+ (let (out-list)
+ (while in-list
+ (if (and (assoc (verilog-sig-name (car in-list)) not-list)
+ (not (assoc (verilog-sig-name (car in-list)) out-list)))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))))
+;;(verilog-signals-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("C" "")))
+
(defun verilog-signals-not-in (in-list not-list)
"Return list of signals in IN-LIST that aren't also in NOT-LIST.
Also remove any duplicates in IN-LIST.
(puthash (car (car not-list)) t ht)
(setq not-list (cdr not-list)))
(while in-list
- (when (not (gethash (car (car in-list)) ht))
+ (when (not (gethash (verilog-sig-name (car in-list)) ht))
(setq out-list (cons (car in-list) out-list))
- (puthash (car (car in-list)) t ht))
+ (puthash (verilog-sig-name (car in-list)) t ht))
(setq in-list (cdr in-list)))
(nreverse out-list)))
;; Slower Fallback if no hash tables (pre Emacs 21.1/XEmacs 21.4)
(t
(let (out-list)
(while in-list
- (if (not (or (assoc (car (car in-list)) not-list)
- (assoc (car (car in-list)) out-list)))
+ (if (and (not (assoc (verilog-sig-name (car in-list)) not-list))
+ (not (assoc (verilog-sig-name (car in-list)) out-list)))
(setq out-list (cons (car in-list) out-list)))
(setq in-list (cdr in-list)))
(nreverse out-list)))))
(defun verilog-signals-sort-compare (a b)
"Compare signal A and B for sorting."
- (string< (car a) (car b)))
+ (string< (verilog-sig-name a) (verilog-sig-name b)))
(defun verilog-signals-not-params (in-list)
"Return list of signals in IN-LIST that aren't parameters or numeric constants."
(let (out-list)
(while in-list
- (unless (boundp (intern (concat "vh-" (car (car in-list)))))
+ (unless (boundp (intern (concat "vh-" (verilog-sig-name (car in-list)))))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))
+
+(defun verilog-signals-with (func in-list)
+ "Return IN-LIST with only signals where FUNC passed each signal is true."
+ (let (out-list)
+ (while in-list
+ (when (funcall func (car in-list))
(setq out-list (cons (car in-list) out-list)))
(setq in-list (cdr in-list)))
(nreverse out-list)))
;;
out-list))
-(defun verilog-sig-tieoff (sig &optional no-width)
+(defun verilog-sig-tieoff (sig)
"Return tieoff expression for given SIG, with appropriate width.
-Ignore width if optional NO-WIDTH is set."
- (let* ((width (if no-width nil (verilog-sig-width sig))))
- (concat
- (if (and verilog-active-low-regexp
- (string-match verilog-active-low-regexp (verilog-sig-name sig)))
- "~" "")
- (cond ((not width)
- "0")
- ((string-match "^[0-9]+$" width)
- (concat width (if (verilog-sig-signed sig) "'sh0" "'h0")))
- (t
- (concat "{" width "{1'b0}}"))))))
+Tieoff value uses `verilog-active-low-regexp' and
+`verilog-auto-reset-widths'."
+ (concat
+ (if (and verilog-active-low-regexp
+ (string-match verilog-active-low-regexp (verilog-sig-name sig)))
+ "~" "")
+ (cond ((not verilog-auto-reset-widths)
+ "0")
+ ((equal verilog-auto-reset-widths 'unbased)
+ "'0")
+ ;; Else presume verilog-auto-reset-widths is true
+ (t
+ (let* ((width (verilog-sig-width sig)))
+ (if (string-match "^[0-9]+$" width)
+ (concat width (if (verilog-sig-signed sig) "'sh0" "'h0"))
+ (concat "{" width "{1'b0}}")))))))
+
+;;
+;; Dumping
+;;
+
+(defun verilog-decls-princ (decls &optional header prefix)
+ "For debug, dump the `verilog-read-decls' structure DECLS."
+ (when decls
+ (if header (princ header))
+ (setq prefix (or prefix ""))
+ (verilog-signals-princ (verilog-decls-get-outputs decls)
+ (concat prefix "Outputs:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-inouts decls)
+ (concat prefix "Inout:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-inputs decls)
+ (concat prefix "Inputs:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-vars decls)
+ (concat prefix "Vars:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-assigns decls)
+ (concat prefix "Assigns:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-consts decls)
+ (concat prefix "Consts:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-gparams decls)
+ (concat prefix "Gparams:\n") (concat prefix " "))
+ (verilog-signals-princ (verilog-decls-get-interfaces decls)
+ (concat prefix "Interfaces:\n") (concat prefix " "))
+ (verilog-modport-princ (verilog-decls-get-modports decls)
+ (concat prefix "Modports:\n") (concat prefix " "))
+ (princ "\n")))
+
+(defun verilog-signals-princ (signals &optional header prefix)
+ "For debug, dump internal SIGNALS structures, with HEADER and PREFIX."
+ (when signals
+ (if header (princ header))
+ (while signals
+ (let ((sig (car signals)))
+ (setq signals (cdr signals))
+ (princ prefix)
+ (princ "\"") (princ (verilog-sig-name sig)) (princ "\"")
+ (princ " bits=") (princ (verilog-sig-bits sig))
+ (princ " cmt=") (princ (verilog-sig-comment sig))
+ (princ " mem=") (princ (verilog-sig-memory sig))
+ (princ " enum=") (princ (verilog-sig-enum sig))
+ (princ " sign=") (princ (verilog-sig-signed sig))
+ (princ " type=") (princ (verilog-sig-type sig))
+ (princ " dim=") (princ (verilog-sig-multidim sig))
+ (princ " modp=") (princ (verilog-sig-modport sig))
+ (princ "\n")))))
+
+(defun verilog-modport-princ (modports &optional header prefix)
+ "For debug, dump internal MODPORT structures, with HEADER and PREFIX."
+ (when modports
+ (if header (princ header))
+ (while modports
+ (let ((sig (car modports)))
+ (setq modports (cdr modports))
+ (princ prefix)
+ (princ "\"") (princ (verilog-modport-name sig)) (princ "\"")
+ (princ " clockings=") (princ (verilog-modport-clockings sig))
+ (princ "\n")
+ (verilog-decls-princ (verilog-modport-decls sig)
+ (concat prefix " syms:\n")
+ (concat prefix " "))))))
;;
;; Port/Wire/Etc Reading
(let ((olist))
(save-excursion
;; /*AUTOPUNT("parameter", "parameter")*/
- (search-backward "(")
+ (backward-sexp 1)
(while (looking-at "(?\\s *\"\\([^\"]*\\)\"\\s *,?")
(setq olist (cons (match-string 1) olist))
(goto-char (match-end 0))))
(defun verilog-read-decls ()
"Compute signal declaration information for the current module at point.
-Return a array of [outputs inouts inputs wire reg assign const]."
+Return an array of [outputs inouts inputs wire reg assign const]."
(let ((end-mod-point (or (verilog-get-end-of-defun t) (point-max)))
(functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t)
- in-modport ign-prop
+ in-modport in-clocking ptype ign-prop
sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const
- sigs-gparam sigs-intf
+ sigs-gparam sigs-intf sigs-modports
vec expect-signal keywd newsig rvalue enum io signed typedefed multidim
- modport)
+ modport
+ varstack tmp)
(save-excursion
(verilog-beg-of-defun-quick)
(setq sigs-const (verilog-read-auto-constants (point) end-mod-point))
;;(if dbg (setq dbg (concat dbg (format "Pt %s Vec %s C%c Kwd'%s'\n" (point) vec (following-char) keywd))))
(cond
((looking-at "//")
- (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
- (setq enum (match-string 1)))
+ (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ (setq enum (match-string 2)))
(search-forward "\n"))
((looking-at "/\\*")
(forward-char 2)
- (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
- (setq enum (match-string 1)))
+ (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ (setq enum (match-string 2)))
(or (search-forward "*/")
(error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
((looking-at "(\\*")
(or (re-search-forward "[^\\]\"" nil t) ;; don't forward-char first, since we look for a non backslash first
(error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point))))
((eq ?\; (following-char))
+ (when (and in-modport (not (eq in-modport t))) ;; end of a modport declaration
+ (verilog-modport-decls-set
+ in-modport
+ (verilog-decls-new sigs-out sigs-inout sigs-in
+ nil nil nil nil nil nil))
+ ;; Pop from varstack to restore state to pre-clocking
+ (setq tmp (car varstack)
+ varstack (cdr varstack)
+ sigs-out (aref tmp 0)
+ sigs-inout (aref tmp 1)
+ sigs-in (aref tmp 2)))
(setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil
v2kargs-ok nil in-modport nil ign-prop nil)
(forward-char 1))
(when (string-match "^\\\\" (match-string 1))
(setq keywd (concat keywd " ")))) ;; Escaped ID needs space at end
(cond ((equal keywd "input")
- (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-in io t modport nil))
+ (setq vec nil enum nil rvalue nil newsig nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-in io t sig-paren paren))
((equal keywd "output")
- (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-out io t modport nil))
+ (setq vec nil enum nil rvalue nil newsig nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-out io t sig-paren paren))
((equal keywd "inout")
- (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-inout io t modport nil))
+ (setq vec nil enum nil rvalue nil newsig nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-inout io t sig-paren paren))
((equal keywd "parameter")
- (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-gparam io t modport nil))
- ((member keywd '("wire"
- "tri" "tri0" "tri1" "triand" "trior" "wand" "wor"
- "reg" "trireg"
+ (setq vec nil enum nil rvalue nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-gparam io t sig-paren paren))
+ ((member keywd '("wire" "reg" ; Fast
+ ;; net_type
+ "tri" "tri0" "tri1" "triand" "trior" "trireg"
+ "uwire" "wand" "wor"
+ ;; integer_atom_type
"byte" "shortint" "int" "longint" "integer" "time"
+ "supply0" "supply1"
+ ;; integer_vector_type - "reg" above
"bit" "logic"
+ ;; non_integer_type
"shortreal" "real" "realtime"
+ ;; data_type
"string" "event" "chandle"))
- (unless io (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-var modport nil)))
+ (cond (io
+ (setq typedefed
+ (if typedefed (concat typedefed " " keywd) keywd)))
+ (t (setq vec nil enum nil rvalue nil signed nil
+ typedefed nil multidim nil sig-paren paren
+ expect-signal 'sigs-var modport nil))))
((equal keywd "assign")
- (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-assign modport nil))
- ((member keywd '("supply0" "supply1" "supply"
- "localparam" "genvar"))
- (unless io (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil sig-paren paren
- expect-signal 'sigs-const modport nil)))
+ (setq vec nil enum nil rvalue nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-assign sig-paren paren))
+ ((member keywd '("localparam" "genvar"))
+ (unless io
+ (setq vec nil enum nil rvalue nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-const sig-paren paren)))
((member keywd '("signed" "unsigned"))
(setq signed keywd))
((member keywd '("assert" "assume" "cover" "expect" "restrict"))
(setq ign-prop t))
- ((member keywd '("class" "clocking" "covergroup" "function"
+ ((member keywd '("class" "covergroup" "function"
"property" "randsequence" "sequence" "task"))
(unless ign-prop
(setq functask (1+ functask))))
- ((member keywd '("endclass" "endclocking" "endgroup" "endfunction"
+ ((member keywd '("endclass" "endgroup" "endfunction"
"endproperty" "endsequence" "endtask"))
(setq functask (1- functask)))
((equal keywd "modport")
(setq in-modport t))
+ ((equal keywd "clocking")
+ (setq in-clocking t))
+ ((equal keywd "type")
+ (setq ptype t))
;; Ifdef? Ignore name of define
((member keywd '("`ifdef" "`ifndef" "`elsif"))
(setq rvalue t))
;; Type?
- ((verilog-typedef-name-p keywd)
+ ((unless ptype
+ (verilog-typedef-name-p keywd))
(setq typedefed keywd))
;; Interface with optional modport in v2k arglist?
;; Skip over parsing modport, and take the interface name as the type
(not rvalue)
(looking-at "\\s-*\\(\\.\\(\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*\\)\\|\\)\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*"))
(when (match-end 2) (goto-char (match-end 2)))
- (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed keywd multidim nil sig-paren paren
- expect-signal 'sigs-intf io t modport (match-string 2)))
+ (setq vec nil enum nil rvalue nil signed nil
+ typedefed keywd multidim nil ptype nil modport (match-string 2)
+ newsig nil sig-paren paren
+ expect-signal 'sigs-intf io t ))
;; Ignore dotted LHS assignments: "assign foo.bar = z;"
((looking-at "\\s-*\\.")
(goto-char (match-end 0))
(when (not rvalue)
(setq expect-signal nil)))
+ ;; "modport <keywd>"
+ ((and (eq in-modport t)
+ (not (member keywd verilog-keywords)))
+ (setq in-modport (verilog-modport-new keywd nil nil))
+ (setq sigs-modports (cons in-modport sigs-modports))
+ ;; Push old sig values to stack and point to new signal list
+ (setq varstack (cons (vector sigs-out sigs-inout sigs-in)
+ varstack))
+ (setq sigs-in nil sigs-inout nil sigs-out nil))
+ ;; "modport x (clocking <keywd>)"
+ ((and in-modport in-clocking)
+ (verilog-modport-clockings-add in-modport keywd)
+ (setq in-clocking nil))
+ ;; endclocking
+ ((and in-clocking
+ (equal keywd "endclocking"))
+ (unless (eq in-clocking t)
+ (verilog-modport-decls-set
+ in-clocking
+ (verilog-decls-new sigs-out sigs-inout sigs-in
+ nil nil nil nil nil nil))
+ ;; Pop from varstack to restore state to pre-clocking
+ (setq tmp (car varstack)
+ varstack (cdr varstack)
+ sigs-out (aref tmp 0)
+ sigs-inout (aref tmp 1)
+ sigs-in (aref tmp 2)))
+ (setq in-clocking nil))
+ ;; "clocking <keywd>"
+ ((and (eq in-clocking t)
+ (not (member keywd verilog-keywords)))
+ (setq in-clocking (verilog-modport-new keywd nil nil))
+ (setq sigs-modports (cons in-clocking sigs-modports))
+ ;; Push old sig values to stack and point to new signal list
+ (setq varstack (cons (vector sigs-out sigs-inout sigs-in)
+ varstack))
+ (setq sigs-in nil sigs-inout nil sigs-out nil))
;; New signal, maybe?
((and expect-signal
(not rvalue)
(eq functask 0)
- (not in-modport)
(not (member keywd verilog-keywords)))
;; Add new signal to expect-signal's variable
(setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport))
(forward-char 1)))
(skip-syntax-forward " "))
;; Return arguments
- (verilog-decls-new (nreverse sigs-out)
- (nreverse sigs-inout)
- (nreverse sigs-in)
- (nreverse sigs-var)
- nil
- (nreverse sigs-assign)
- (nreverse sigs-const)
- (nreverse sigs-gparam)
- (nreverse sigs-intf)))))
+ (setq tmp (verilog-decls-new (nreverse sigs-out)
+ (nreverse sigs-inout)
+ (nreverse sigs-in)
+ (nreverse sigs-var)
+ (nreverse sigs-modports)
+ (nreverse sigs-assign)
+ (nreverse sigs-const)
+ (nreverse sigs-gparam)
+ (nreverse sigs-intf)))
+ ;;(if dbg (verilog-decls-princ tmp))
+ tmp)))
(defvar verilog-read-sub-decls-in-interfaced nil
"For `verilog-read-sub-decls', process next signal as under interfaced block.")
(eval-when-compile
;; Prevent compile warnings; these are let's, not globals
;; Do not remove the eval-when-compile
- ;; - we want a error when we are debugging this code if they are refed.
+ ;; - we want an error when we are debugging this code if they are refed.
(defvar sigs-in)
(defvar sigs-inout)
(defvar sigs-out)
(verilog-sig-memory portdata)
nil
(verilog-sig-signed portdata)
- (verilog-sig-type portdata)
+ (unless (member (verilog-sig-type portdata) '("wire" "reg"))
+ (verilog-sig-type portdata))
multidim nil)
sigs-inout)))
((or (setq portdata (assoc port (verilog-decls-get-outputs submoddecls)))
(verilog-sig-memory portdata)
nil
(verilog-sig-signed portdata)
- (verilog-sig-type portdata)
+ ;; Though ok in SV, in V2K code, propagating the
+ ;; "reg" in "output reg" upwards isn't legal.
+ ;; Also for backwards compatibility we don't propagate
+ ;; "input wire" upwards.
+ ;; See also `verilog-signals-edit-wire-reg'.
+ (unless (member (verilog-sig-type portdata) '("wire" "reg"))
+ (verilog-sig-type portdata))
multidim nil)
sigs-out)))
((or (setq portdata (assoc port (verilog-decls-get-inputs submoddecls)))
(verilog-sig-memory portdata)
nil
(verilog-sig-signed portdata)
- (verilog-sig-type portdata)
+ (unless (member (verilog-sig-type portdata) '("wire" "reg"))
+ (verilog-sig-type portdata))
multidim nil)
sigs-in)))
((setq portdata (assoc port (verilog-decls-get-interfaces submoddecls)))
(defun verilog-read-sub-decls ()
"Internally parse signals going to modules under this module.
-Return a array of [ outputs inouts inputs ] signals for modules that are
+Return an array of [ outputs inouts inputs ] signals for modules that are
instantiated in this module. For example if declare A A (.B(SIG)) and SIG
-is a output, then SIG will be included in the list.
+is an output, then SIG will be included in the list.
This only works on instantiations created with /*AUTOINST*/ converted by
\\[verilog-auto-inst]. Otherwise, it would have to read in the whole
(setq verilog-cache-has-lisp (re-search-forward "\\<AUTO_LISP(" nil t))))
(defun verilog-read-auto-lisp (start end)
- "Look for and evaluate a AUTO_LISP between START and END.
+ "Look for and evaluate an AUTO_LISP between START and END.
Must call `verilog-read-auto-lisp-present' before this function."
;; This function is expensive for large buffers, so we cache if any AUTO_LISP exists
(when verilog-cache-has-lisp
(backward-char)
(let* ((beg-pt (prog1 (point)
(verilog-forward-sexp-cmt 1))) ;; Closing paren
- (end-pt (point)))
+ (end-pt (point))
+ (verilog-in-hooks t))
(eval-region beg-pt end-pt nil))))))
(eval-when-compile
;; Prevent compile warnings; these are let's, not globals
;; Do not remove the eval-when-compile
- ;; - we want a error when we are debugging this code if they are refed.
+ ;; - we want an error when we are debugging this code if they are refed.
(defvar sigs-in)
(defvar sigs-out-d)
(defvar sigs-out-i)
instants-list))
-(defun verilog-read-auto-template (module)
- "Look for a auto_template for the instantiation of the given MODULE.
-If found returns the signal name connections. Return REGEXP and
-list of ( (signal_name connection_name)... )."
+(defun verilog-read-auto-template-middle ()
+ "With point in middle of an AUTO_TEMPLATE, parse it.
+Returns REGEXP and list of ( (signal_name connection_name)... )."
(save-excursion
;; Find beginning
(let ((tpl-regexp "\\([0-9]+\\)")
(lineno -1) ; -1 to offset for the AUTO_TEMPLATE's newline
(templateno 0)
- (pt (point))
tpl-sig-list tpl-wild-list tpl-end-pt rep)
+ ;; Parse "REGEXP"
+ ;; We reserve @"..." for future lisp expressions that evaluate
+ ;; once-per-AUTOINST
+ (when (looking-at "\\s-*\"\\([^\"]*\\)\"")
+ (setq tpl-regexp (match-string 1))
+ (goto-char (match-end 0)))
+ (search-forward "(")
+ ;; Parse lines in the template
+ (when (or verilog-auto-inst-template-numbers
+ verilog-auto-template-warn-unused)
+ (save-excursion
+ (let ((pre-pt (point)))
+ (goto-char (point-min))
+ (while (search-forward "AUTO_TEMPLATE" pre-pt t)
+ (setq templateno (1+ templateno)))
+ (while (< (point) pre-pt)
+ (forward-line 1)
+ (setq lineno (1+ lineno))))))
+ (setq tpl-end-pt (save-excursion
+ (backward-char 1)
+ (verilog-forward-sexp-cmt 1) ;; Moves to paren that closes argdecl's
+ (backward-char 1)
+ (point)))
+ ;;
+ (while (< (point) tpl-end-pt)
+ (cond ((looking-at "\\s-*\\.\\([a-zA-Z0-9`_$]+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
+ (setq tpl-sig-list
+ (cons (list
+ (match-string-no-properties 1)
+ (match-string-no-properties 2)
+ templateno lineno)
+ tpl-sig-list))
+ (goto-char (match-end 0)))
+ ;; Regexp form??
+ ((looking-at
+ ;; Regexp bug in XEmacs disallows ][ inside [], and wants + last
+ "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]+\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
+ (setq rep (match-string-no-properties 3))
+ (goto-char (match-end 0))
+ (setq tpl-wild-list
+ (cons (list
+ (concat "^"
+ (verilog-string-replace-matches "@" "\\\\([0-9]+\\\\)" nil nil
+ (match-string 1))
+ "$")
+ rep
+ templateno lineno)
+ tpl-wild-list)))
+ ((looking-at "[ \t\f]+")
+ (goto-char (match-end 0)))
+ ((looking-at "\n")
+ (setq lineno (1+ lineno))
+ (goto-char (match-end 0)))
+ ((looking-at "//")
+ (search-forward "\n")
+ (setq lineno (1+ lineno)))
+ ((looking-at "/\\*")
+ (forward-char 2)
+ (or (search-forward "*/")
+ (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
+ (t
+ (error "%s: AUTO_TEMPLATE parsing error: %s"
+ (verilog-point-text)
+ (progn (looking-at ".*$") (match-string 0))))))
+ ;; Return
+ (vector tpl-regexp
+ (list tpl-sig-list tpl-wild-list)))))
+
+(defun verilog-read-auto-template (module)
+ "Look for an auto_template for the instantiation of the given MODULE.
+If found returns `verilog-read-auto-template-inside' structure."
+ (save-excursion
+ ;; Find beginning
+ (let ((pt (point)))
;; Note this search is expensive, as we hunt from mod-begin to point
;; for every instantiation. Likewise in verilog-read-auto-lisp.
;; So, we look first for an exact string rather than a slow regexp.
;; need to record the relative position of each AUTOINST, as multiple
;; templates exist for each module, and we're inserting lines.
(cond ((or
+ ;; See also regexp in `verilog-auto-template-lint'
(verilog-re-search-backward-substr
"AUTO_TEMPLATE"
(concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t)
"AUTO_TEMPLATE"
(concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t)))
(goto-char (match-end 0))
- ;; Parse "REGEXP"
- ;; We reserve @"..." for future lisp expressions that evaluate
- ;; once-per-AUTOINST
- (when (looking-at "\\s-*\"\\([^\"]*\\)\"")
- (setq tpl-regexp (match-string 1))
- (goto-char (match-end 0)))
- (search-forward "(")
- ;; Parse lines in the template
- (when verilog-auto-inst-template-numbers
- (save-excursion
- (let ((pre-pt (point)))
- (goto-char (point-min))
- (while (search-forward "AUTO_TEMPLATE" pre-pt t)
- (setq templateno (1+ templateno)))
- (while (< (point) pre-pt)
- (forward-line 1)
- (setq lineno (1+ lineno))))))
- (setq tpl-end-pt (save-excursion
- (backward-char 1)
- (verilog-forward-sexp-cmt 1) ;; Moves to paren that closes argdecl's
- (backward-char 1)
- (point)))
- ;;
- (while (< (point) tpl-end-pt)
- (cond ((looking-at "\\s-*\\.\\([a-zA-Z0-9`_$]+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
- (setq tpl-sig-list
- (cons (list
- (match-string-no-properties 1)
- (match-string-no-properties 2)
- templateno lineno)
- tpl-sig-list))
- (goto-char (match-end 0)))
- ;; Regexp form??
- ((looking-at
- ;; Regexp bug in XEmacs disallows ][ inside [], and wants + last
- "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]+\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
- (setq rep (match-string-no-properties 3))
- (goto-char (match-end 0))
- (setq tpl-wild-list
- (cons (list
- (concat "^"
- (verilog-string-replace-matches "@" "\\\\([0-9]+\\\\)" nil nil
- (match-string 1))
- "$")
- rep
- templateno lineno)
- tpl-wild-list)))
- ((looking-at "[ \t\f]+")
- (goto-char (match-end 0)))
- ((looking-at "\n")
- (setq lineno (1+ lineno))
- (goto-char (match-end 0)))
- ((looking-at "//")
- (search-forward "\n")
- (setq lineno (1+ lineno)))
- ((looking-at "/\\*")
- (forward-char 2)
- (or (search-forward "*/")
- (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
- (t
- (error "%s: AUTO_TEMPLATE parsing error: %s"
- (verilog-point-text)
- (progn (looking-at ".*$") (match-string 0))))))
- ;; Return
- (vector tpl-regexp
- (list tpl-sig-list tpl-wild-list)))
+ (verilog-read-auto-template-middle))
;; If no template found
- (t (vector tpl-regexp nil))))))
+ (t (vector "" nil))))))
;;(progn (find-file "auto-template.v") (verilog-read-auto-template "ptl_entry"))
+(defvar verilog-auto-template-hits nil "Successful lookups with `verilog-read-auto-template-hit'.")
+(make-variable-buffer-local 'verilog-auto-template-hits)
+
+(defun verilog-read-auto-template-hit (tpl-ass)
+ "Record that TPL-ASS template from `verilog-read-auto-template' was used."
+ (when (eval-when-compile (fboundp 'make-hash-table)) ;; else feature not allowed
+ (when verilog-auto-template-warn-unused
+ (unless verilog-auto-template-hits
+ (setq verilog-auto-template-hits
+ (make-hash-table :test 'equal :rehash-size 4.0)))
+ (puthash (vector (nth 2 tpl-ass) (nth 3 tpl-ass)) t
+ verilog-auto-template-hits))))
+
(defun verilog-set-define (defname defvalue &optional buffer enumname)
"Set the definition DEFNAME to the DEFVALUE in the given BUFFER.
Optionally associate it with the specified enumeration ENUMNAME."
\\[find-alternate-file] RET to have these take effect after editing them!
If you want to disable the \"Process `eval' or hook local variables\"
-warning message, you need to add to your .emacs file:
+warning message, you need to add to your init file:
(setq enable-local-eval t)"
(let ((origbuf (current-buffer)))
(let (enumname)
;; The primary way of getting defines is verilog-read-decls
;; However, that isn't called yet for included files, so we'll add another scheme
- (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
- (setq enumname (match-string-no-properties 1)))
- (forward-comment 999)
+ (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
+ (setq enumname (match-string-no-properties 2)))
+ (forward-comment 99999)
(while (looking-at (concat "\\s-*,?\\s-*\\(?:/[/*].*?$\\)?\\s-*\\([a-zA-Z0-9_$]+\\)"
"\\s-*=\\s-*\\([^;,]*\\),?\\s-*\\(/[/*].*?$\\)?\\s-*"))
(verilog-set-define (match-string-no-properties 1)
(match-string-no-properties 2) origbuf enumname)
(goto-char (match-end 0))
- (forward-comment 999)))))))
+ (forward-comment 99999)))))))
(defun verilog-read-includes ()
"Read `includes for the current file.
variable over and over when many modules are compiled together, put a test
around the inside each include file:
-foo.v (a include):
+foo.v (an include file):
`ifdef _FOO_V // include if not already included
`else
`define _FOO_V
(defun verilog-library-filenames (filename &optional current check-ext)
"Return a search path to find the given FILENAME or module name.
-Uses the optional CURRENT filename or buffer-file-name, plus
+Uses the optional CURRENT filename or variable `buffer-file-name', plus
`verilog-library-directories' and `verilog-library-extensions'
variables to build the path. With optional CHECK-EXT also check
`verilog-library-extensions'."
;; A modi is: [module-name-string file-name begin-point]
(defvar verilog-cache-enabled t
- "If true, enable caching of signals, etc. Set to nil for debugging to make things SLOW!")
+ "Non-nil enables caching of signals, etc. Set to nil for debugging to make things SLOW!")
(defvar verilog-modi-cache-list nil
"Cache of ((Module Function) Buf-Tick Buf-Modtime Func-Returns)...
"Modification tick after which the cache is still considered valid.
Use `verilog-preserve-modi-cache' to set it.")
(defvar verilog-modi-cache-current-enable nil
- "If true, allow caching `verilog-modi-current', set by let().")
+ "Non-nil means allow caching `verilog-modi-current', set by let().")
(defvar verilog-modi-cache-current nil
"Currently active `verilog-modi-current', if any, set by let().")
(defvar verilog-modi-cache-current-max nil
;;(message "verilog-modi-lookup: HIT %S" modi)
modi)
;; Miss
- (t (let* ((realmod (verilog-symbol-detick module t))
- (orig-filenames (verilog-module-filenames realmod current))
+ (t (let* ((realname (verilog-symbol-detick module t))
+ (orig-filenames (verilog-module-filenames realname current))
(filenames orig-filenames)
mif)
(while (and filenames (not mif))
- (if (not (setq mif (verilog-module-inside-filename-p realmod (car filenames))))
+ (if (not (setq mif (verilog-module-inside-filename-p realname (car filenames))))
(setq filenames (cdr filenames))))
;; mif has correct form to become later elements of modi
(cond (mif (setq modi mif))
(or ignore-error
(error (concat (verilog-point-text)
": Can't locate " module " module definition"
- (if (not (equal module realmod))
- (concat " (Expanded macro to " realmod ")")
+ (if (not (equal module realname))
+ (concat " (Expanded macro to " realname ")")
"")
"\n Check the verilog-library-directories variable."
"\n I looked in (if not listed, doesn't exist):\n\t"
(t
;; Read from file
;; Clear then restore any highlighting to make emacs19 happy
- (let ((fontlocked (when (and (boundp 'font-lock-mode)
- font-lock-mode)
- (font-lock-mode 0)
- t))
- func-returns)
- (setq func-returns (funcall function))
- (when fontlocked (font-lock-mode t))
+ (let (func-returns)
+ (verilog-save-font-mods
+ (setq func-returns (funcall function)))
;; Cache for next time
(setq verilog-modi-cache-list
(cons (list (list modi function)
(progn ,@body)))
+(defun verilog-modi-modport-lookup-one (modi name &optional ignore-error)
+ "Given a MODI, return the declarations related to the given modport NAME."
+ ;; Recursive routine - see below
+ (let* ((realname (verilog-symbol-detick name t))
+ (modport (assoc name (verilog-decls-get-modports (verilog-modi-get-decls modi)))))
+ (or modport ignore-error
+ (error (concat (verilog-point-text)
+ ": Can't locate " name " modport definition"
+ (if (not (equal name realname))
+ (concat " (Expanded macro to " realname ")")
+ ""))))
+ (let* ((decls (verilog-modport-decls modport))
+ (clks (verilog-modport-clockings modport)))
+ ;; Now expand any clocking's
+ (while clks
+ (setq decls (verilog-decls-append
+ decls
+ (verilog-modi-modport-lookup-one modi (car clks) ignore-error)))
+ (setq clks (cdr clks)))
+ decls)))
+
+(defun verilog-modi-modport-lookup (modi name-re &optional ignore-error)
+ "Given a MODI, return the declarations related to the given modport NAME-RE.
+If the modport points to any clocking blocks, expand the signals to include
+those clocking block's signals."
+ ;; Recursive routine - see below
+ (let* ((mod-decls (verilog-modi-get-decls modi))
+ (clks (verilog-decls-get-modports mod-decls))
+ (name-re (concat "^" name-re "$"))
+ (decls (verilog-decls-new nil nil nil nil nil nil nil nil nil)))
+ ;; Pull in all modports
+ (while clks
+ (when (string-match name-re (verilog-modport-name (car clks)))
+ (setq decls (verilog-decls-append
+ decls
+ (verilog-modi-modport-lookup-one modi (verilog-modport-name (car clks)) ignore-error))))
+ (setq clks (cdr clks)))
+ decls))
+
(defun verilog-signals-matching-enum (in-list enum)
"Return all signals in IN-LIST matching the given ENUM."
(let (out-list)
(setq in-list (cdr in-list)))
(nreverse out-list))))
+(defun verilog-signals-edit-wire-reg (in-list)
+ "Return all signals in IN-LIST with wire/reg data types made blank."
+ (mapcar (lambda (sig)
+ (when (member (verilog-sig-type sig) '("wire" "reg"))
+ (verilog-sig-type-set sig nil))
+ sig) in-list))
+
;; Combined
(defun verilog-decls-get-signals (decls)
- "Return all declared signals, excluding 'assign' statements."
+ "Return all declared signals in DECLS, excluding 'assign' statements."
(append
(verilog-decls-get-outputs decls)
(verilog-decls-get-inouts decls)
(verilog-decls-get-inouts decls)
(verilog-decls-get-inputs decls)))
+(defun verilog-decls-get-iovars (decls)
+ (append
+ (verilog-decls-get-vars decls)
+ (verilog-decls-get-outputs decls)
+ (verilog-decls-get-inouts decls)
+ (verilog-decls-get-inputs decls)))
+
(defsubst verilog-modi-cache-add-outputs (modi sig-list)
(verilog-modi-cache-add modi 'verilog-read-decls 0 sig-list))
(defsubst verilog-modi-cache-add-inouts (modi sig-list)
(verilog-modi-cache-add modi 'verilog-read-decls 2 sig-list))
(defsubst verilog-modi-cache-add-vars (modi sig-list)
(verilog-modi-cache-add modi 'verilog-read-decls 3 sig-list))
+(defsubst verilog-modi-cache-add-gparams (modi sig-list)
+ (verilog-modi-cache-add modi 'verilog-read-decls 7 sig-list))
-(defun verilog-signals-from-signame (signame-list)
- "Return signals in standard form from SIGNAME-LIST, a simple list of signal names."
- (mapcar (function (lambda (name) (list name nil nil)))
- signame-list))
\f
;;
;; Auto creation utilities
(when verilog-auto-declare-nettype
(verilog-modi-cache-add-vars modi sigs)))
((equal direction "interface"))
+ ((equal direction "parameter")
+ (verilog-modi-cache-add-gparams modi sigs))
(t
(error "Unsupported verilog-insert-definition direction: %s" direction))))
(or dont-sort
stuff (cdr stuff)))))
;;(let ((indent-pt 10)) (verilog-insert-indent "hello\n" "addon" "there\n"))
+(defun verilog-forward-or-insert-line ()
+ "Move forward a line, unless at EOB, then insert a newline."
+ (if (eobp) (insert "\n")
+ (forward-line)))
+
(defun verilog-repair-open-comma ()
- "Insert comma if previous argument is other than a open parenthesis or endif."
+ "Insert comma if previous argument is other than an open parenthesis or endif."
;; We can't just search backward for ) as it might be inside another expression.
;; Also want "`ifdef X input foo `endif" to just leave things to the human to deal with
(save-excursion
(defun verilog-repair-close-comma ()
"If point is at a comma followed by a close parenthesis, fix it.
-This repairs those mis-inserted by a AUTOARG."
+This repairs those mis-inserted by an AUTOARG."
;; It would be much nicer if Verilog allowed extra commas like Perl does!
(save-excursion
(verilog-forward-close-paren)
"\\([])}:*+-]\\)")
out)
(setq out (replace-match "\\1\\2\\3" nil nil out)))
+ (while (string-match
+ (concat "\\([[({:*+-]\\)" ; - must be last
+ "\\$clog2\\s *(\\<\\([0-9]+\\))"
+ "\\([])}:*+-]\\)")
+ out)
+ (setq out (replace-match
+ (concat
+ (match-string 1 out)
+ (int-to-string (verilog-clog2 (string-to-number (match-string 2 out))))
+ (match-string 3 out))
+ nil nil out)))
;; For precedence do * before +/-
(while (string-match
(concat "\\([[({:*+-]\\)"
post)
nil nil out)) )))
out)))
+
;;(verilog-simplify-range-expression "[1:3]") ;; 1
;;(verilog-simplify-range-expression "[(1):3]") ;; 1
;;(verilog-simplify-range-expression "[(((16)+1)+1+(1+1))]") ;;20
;;(verilog-simplify-range-expression "[(FOO*4+1-1)]") ;; FOO*4+0
;;(verilog-simplify-range-expression "[(func(BAR))]") ;; func(BAR)
;;(verilog-simplify-range-expression "[FOO-1+1-1+1]") ;; FOO-0
+;;(verilog-simplify-range-expression "[$clog2(2)]") ;; 1
+;;(verilog-simplify-range-expression "[$clog2(7)]") ;; 3
+
+(defun verilog-clog2 (value)
+ "Compute $clog2 - ceiling log2 of VALUE."
+ (if (< value 1)
+ 0
+ (ceiling (/ (log value) (log 2)))))
(defun verilog-typedef-name-p (variable-name)
"Return true if the VARIABLE-NAME is a type definition."
Differences are between buffers B1 and B2, starting at point
DIFFPT. This function is called via `verilog-diff-function'."
(let ((name1 (with-current-buffer b1 (buffer-file-name))))
- (message "%%Warning: %s:%d: Difference in AUTO expansion found"
- name1 (with-current-buffer b1 (1+ (count-lines (point-min) (point)))))
+ (verilog-warn "%s:%d: Difference in AUTO expansion found"
+ name1 (with-current-buffer b1
+ (1+ (count-lines (point-min) (point)))))
(cond (noninteractive
(verilog-diff-file-with-buffer name1 b2 t t))
(t
(ediff-buffers b1 b2)))))
(defun verilog-diff-auto ()
- "Expand AUTOs in a temporary buffer and indicate any changes.
+ "Expand AUTOs in a temporary buffer and indicate any change.
Whitespace differences are ignored to determine identicalness, but
once a difference is detected, whitespace differences may be shown.
;;
(defun verilog-auto-arg-ports (sigs message indent-pt)
- "Print a list of ports for a AUTOINST.
+ "Print a list of ports for an AUTOINST.
Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT."
(when sigs
(when verilog-auto-arg-sort
(insert "\n"))
(indent-to verilog-indent-level-declaration))))
+(defun verilog-auto-assign-modport ()
+ "Expand AUTOASSIGNMODPORT statements, as part of \\[verilog-auto].
+Take input/output/inout statements from the specified interface
+and modport and use to build assignments into the modport, for
+making verification modules that connect to UVM interfaces.
+
+ The first parameter is the name of an interface.
+
+ The second parameter is a regexp of modports to read from in
+ that interface.
+
+ The third parameter is the instance name to use to dot reference into.
+
+ The optional fourth parameter is a regular expression, and only
+ signals matching the regular expression will be included.
+
+Limitations:
+
+ Interface names must be resolvable to filenames. See `verilog-auto-inst'.
+
+ Inouts are not supported, as assignments must be unidirectional.
+
+ If a signal is part of the interface header and in both a
+ modport and the interface itself, it will not be listed. (As
+ this would result in a syntax error when the connections are
+ made.)
+
+See the example in `verilog-auto-inout-modport'."
+ (save-excursion
+ (let* ((params (verilog-read-auto-params 3 4))
+ (submod (nth 0 params))
+ (modport-re (nth 1 params))
+ (inst-name (nth 2 params))
+ (regexp (nth 3 params))
+ direction-re submodi) ;; direction argument not supported until requested
+ ;; Lookup position, etc of co-module
+ ;; Note this may raise an error
+ (when (setq submodi (verilog-modi-lookup submod t))
+ (let* ((indent-pt (current-indentation))
+ (modi (verilog-modi-current))
+ (submoddecls (verilog-modi-get-decls submodi))
+ (submodportdecls (verilog-modi-modport-lookup submodi modport-re))
+ (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-inputs submodportdecls)
+ (verilog-decls-get-ports submoddecls))))
+ (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-outputs submodportdecls)
+ (verilog-decls-get-ports submoddecls)))))
+ (forward-line 1)
+ (setq sig-list-i (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-i regexp)
+ "input" direction-re))
+ sig-list-o (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-o regexp)
+ "output" direction-re)))
+ (setq sig-list-i (sort (copy-alist sig-list-i) `verilog-signals-sort-compare))
+ (setq sig-list-o (sort (copy-alist sig-list-o) `verilog-signals-sort-compare))
+ (when (or sig-list-i sig-list-o)
+ (verilog-insert-indent "// Beginning of automatic assignments from modport\n")
+ ;; Don't sort them so an upper AUTOINST will match the main module
+ (let ((sigs sig-list-o))
+ (while sigs
+ (verilog-insert-indent "assign " (verilog-sig-name (car sigs))
+ " = " inst-name
+ "." (verilog-sig-name (car sigs)) ";\n")
+ (setq sigs (cdr sigs))))
+ (let ((sigs sig-list-i))
+ (while sigs
+ (verilog-insert-indent "assign " inst-name
+ "." (verilog-sig-name (car sigs))
+ " = " (verilog-sig-name (car sigs)) ";\n")
+ (setq sigs (cdr sigs))))
+ (verilog-insert-indent "// End of automatics\n")))))))
+
(defun verilog-auto-inst-port-map (port-st)
nil)
(defvar vl-mbits nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defun verilog-auto-inst-port (port-st indent-pt tpl-list tpl-num for-star par-values)
- "Print out a instantiation connection for this PORT-ST.
+ "Print out an instantiation connection for this PORT-ST.
Insert to INDENT-PT, use template TPL-LIST.
@ are instantiation numbers, replaced with TPL-NUM.
@\"(expression @)\" are evaluated, with @ as a variable.
(insert "(" tpl-net ")"))
(insert ",")
(cond (tpl-ass
+ (verilog-read-auto-template-hit tpl-ass)
(indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
verilog-auto-inst-column))
;; verilog-insert requires the complete comment in one call - including the newline
(defun verilog-auto-inst-first ()
"Insert , etc before first ever port in this instant, as part of \\[verilog-auto-inst]."
;; Do we need a trailing comma?
- ;; There maybe a ifdef or something similar before us. What a mess. Thus
+ ;; There maybe an ifdef or something similar before us. What a mess. Thus
;; to avoid trouble we only insert on preceding ) or *.
;; Insert first port on new line
(insert "\n") ;; Must insert before search, so point will move forward if insert comma
wire [31:0] o = {32{i}};
endmodule
-This is then used in a upper level module:
+This is then used in an upper level module:
module ExampInst (o,i);
output o;
expanded `verilog-mode' simply searches up for the closest template.
Thus you can have multiple templates for the same module, just alternate
between the template for an instantiation and the instantiation itself.
+ (For backward compatibility if no template is found above, it
+ will also look below, but do not use this behavior in new designs.)
The module name must be the same as the name of the module in the
instantiation name, and the code \"AUTO_TEMPLATE\" must be in these exact
debugging is completed though, it will result in lots of extra differences
and merge conflicts.
+ Setting `verilog-auto-template-warn-unused' will report errors
+ if any template lines are unused.
+
For example:
/* InstModule AUTO_TEMPLATE (
(when (and (not (member submod verilog-gate-keywords))
(setq submodi (verilog-modi-lookup submod t)))
(setq submoddecls (verilog-modi-get-decls submodi))
- ;; If there's a number in the instantiation, it may be a argument to the
+ ;; If there's a number in the instantiation, it may be an argument to the
;; automatic variable instantiation program.
(let* ((tpl-info (verilog-read-auto-template submod))
(tpl-regexp (aref tpl-info 0)))
(verilog-decls-get-vars submoddecls)
skip-pins)))
(vl-dir "interfaced"))
- (when sig-list
+ (when (and sig-list
+ verilog-auto-inst-interfaced-ports)
(when (not did-first) (verilog-auto-inst-first) (setq did-first t))
;; Note these are searched for in verilog-read-sub-decls.
(verilog-insert-indent "// Interfaced\n")
parameter PAR;
endmodule
-This is then used in a upper level module:
+This is then used in an upper level module:
module ExampInst (o,i);
parameter PAR;
;; Note this may raise an error
(when (setq submodi (verilog-modi-lookup submod t))
(setq submoddecls (verilog-modi-get-decls submodi))
- ;; If there's a number in the instantiation, it may be a argument to the
+ ;; If there's a number in the instantiation, it may be an argument to the
;; automatic variable instantiation program.
(let* ((tpl-info (verilog-read-auto-template submod))
(tpl-regexp (aref tpl-info 0)))
(modsubdecls (verilog-modi-get-sub-decls modi))
(sig-list (verilog-signals-not-in
(verilog-decls-get-outputs moddecls)
- (append (verilog-decls-get-vars moddecls)
+ (append (verilog-signals-with ;; ignore typed signals
+ 'verilog-sig-type
+ (verilog-decls-get-outputs moddecls))
+ (verilog-decls-get-vars moddecls)
(verilog-decls-get-assigns moddecls)
(verilog-decls-get-consts moddecls)
(verilog-decls-get-gparams moddecls)
(verilog-subdecls-get-interfaced modsubdecls)
(verilog-subdecls-get-outputs modsubdecls)
(verilog-subdecls-get-inouts modsubdecls)))))
- (forward-line 1)
(when sig-list
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n")
(verilog-insert-definition modi sig-list "reg" indent-pt nil)
(verilog-insert-indent "// End of automatics\n")))))
(verilog-subdecls-get-inouts modsubdecls))
(append (verilog-decls-get-signals moddecls)
(verilog-decls-get-assigns moddecls))))))
- (forward-line 1)
(when sig-list
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n")
(verilog-insert-definition modi sig-list "reg" indent-pt nil)
(verilog-insert-indent "// End of automatics\n")))))
+(defun verilog-auto-logic-setup ()
+ "Prepare variables due to AUTOLOGIC."
+ (unless verilog-auto-wire-type
+ (set (make-local-variable 'verilog-auto-wire-type)
+ "logic")))
+
(defun verilog-auto-logic ()
"Expand AUTOLOGIC statements, as part of \\[verilog-auto].
Make wire statements using the SystemVerilog logic keyword.
In the future AUTOLOGIC may declare additional identifiers,
while AUTOWIRE will not."
(save-excursion
- (unless verilog-auto-wire-type
- (set (make-local-variable 'verilog-auto-wire-type)
- "logic"))
+ (verilog-auto-logic-setup)
(verilog-auto-wire)))
(defun verilog-auto-wire ()
"Expand AUTOWIRE statements, as part of \\[verilog-auto].
Make wire statements for instantiations outputs that aren't
-already declared. `verilog-auto-wire-type' may be used to change
+already declared. `verilog-auto-wire-type' may be used to change
the datatype of the declarations.
Limitations:
(append (verilog-subdecls-get-outputs modsubdecls)
(verilog-subdecls-get-inouts modsubdecls))
(verilog-decls-get-signals moddecls)))))
- (forward-line 1)
(when sig-list
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n")
(verilog-insert-definition modi sig-list "wire" indent-pt nil)
(verilog-insert-indent "// End of automatics\n")
;; syntax-ppss which is broken when change hooks are disabled.
))))
-(defun verilog-auto-output (&optional with-params)
+(defun verilog-auto-output ()
"Expand AUTOOUTPUT statements, as part of \\[verilog-auto].
Make output statements for any output signal from an /*AUTOINST*/ that
-isn't a input to another AUTOINST. This is useful for modules which
+isn't an input to another AUTOINST. This is useful for modules which
only instantiate other modules.
Limitations:
Verilog 2001 style, else uses Verilog 1995 style.
If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
- instantiation, all bets are off. (For example due to a AUTO_TEMPLATE).
+ instantiation, all bets are off. (For example due to an AUTO_TEMPLATE).
Typedefs must match `verilog-typedef-regexp', which is disabled by default.
(save-excursion
;; Point must be at insertion point.
(let* ((indent-pt (current-indentation))
- (regexp (and with-params
- (nth 0 (verilog-read-auto-params 1))))
+ (params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
(v2k (verilog-in-paren-quick))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
sig-list regexp)))
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-output-ignore-regexp))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(when v2k (verilog-repair-open-comma))
(when sig-list
(verilog-insert-indent "// Beginning of automatic outputs (from unused autoinst outputs)\n")
(defun verilog-auto-output-every ()
"Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto].
Make output statements for any signals that aren't primary inputs or
-outputs already. This makes every signal in the design a output. This is
+outputs already. This makes every signal in the design an output. This is
useful to get Synopsys to preserve every signal in the design, since it
won't optimize away the outputs.
(verilog-signals-not-in
(verilog-decls-get-signals moddecls)
(verilog-decls-get-ports moddecls)))))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(when v2k (verilog-repair-open-comma))
(when sig-list
(verilog-insert-indent "// Beginning of automatic outputs (every signal)\n")
(verilog-insert-indent "// End of automatics\n"))
(when v2k (verilog-repair-close-comma)))))
-(defun verilog-auto-input (&optional with-params)
+(defun verilog-auto-input ()
"Expand AUTOINPUT statements, as part of \\[verilog-auto].
Make input statements for any input signal into an /*AUTOINST*/ that
isn't declared elsewhere inside the module. This is useful for modules which
Verilog 2001 style, else uses Verilog 1995 style.
If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
- instantiation, all bets are off. (For example due to a AUTO_TEMPLATE).
+ instantiation, all bets are off. (For example due to an AUTO_TEMPLATE).
Typedefs must match `verilog-typedef-regexp', which is disabled by default.
/*AUTOINPUT(\"^i\")*/"
(save-excursion
(let* ((indent-pt (current-indentation))
- (regexp (and with-params
- (nth 0 (verilog-read-auto-params 1))))
+ (params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
(v2k (verilog-in-paren-quick))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
sig-list regexp)))
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-input-ignore-regexp))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(when v2k (verilog-repair-open-comma))
(when sig-list
(verilog-insert-indent "// Beginning of automatic inputs (from unused autoinst inputs)\n")
(verilog-insert-indent "// End of automatics\n"))
(when v2k (verilog-repair-close-comma)))))
-(defun verilog-auto-inout (&optional with-params)
+(defun verilog-auto-inout ()
"Expand AUTOINOUT statements, as part of \\[verilog-auto].
Make inout statements for any inout signal in an /*AUTOINST*/ that
isn't declared elsewhere inside the module.
Verilog 2001 style, else uses Verilog 1995 style.
If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
- instantiation, all bets are off. (For example due to a AUTO_TEMPLATE).
+ instantiation, all bets are off. (For example due to an AUTO_TEMPLATE).
Typedefs must match `verilog-typedef-regexp', which is disabled by default.
(save-excursion
;; Point must be at insertion point.
(let* ((indent-pt (current-indentation))
- (regexp (and with-params
- (nth 0 (verilog-read-auto-params 1))))
+ (params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
(v2k (verilog-in-paren-quick))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
sig-list regexp)))
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-inout-ignore-regexp))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(when v2k (verilog-repair-open-comma))
(when sig-list
(verilog-insert-indent "// Beginning of automatic inouts (from unused autoinst inouts)\n")
Module names must be resolvable to filenames. See `verilog-auto-inst'.
Signals are not inserted in the same order as in the original module,
- though they will appear to be in the same order to a AUTOINST
+ though they will appear to be in the same order to an AUTOINST
instantiating either module.
+ Signals declared as \"output reg\" or \"output wire\" etc will
+ lose the wire/reg declaration so that shell modules may
+ generate those outputs differently. However, \"output logic\"
+ is propagated.
+
An example:
module ExampShell (/*AUTOARG*/);
(verilog-decls-get-interfaces submoddecls)
(append (verilog-decls-get-interfaces moddecls)))))
(forward-line 1)
- (setq sig-list-i (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-i regexp)
- "input" direction-re)
- sig-list-o (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-o regexp)
- "output" direction-re)
- sig-list-io (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-io regexp)
- "inout" direction-re)
+ (setq sig-list-i (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-i regexp)
+ "input" direction-re))
+ sig-list-o (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-o regexp)
+ "output" direction-re))
+ sig-list-io (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-io regexp)
+ "inout" direction-re))
sig-list-if (verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-if regexp)
"interface" direction-re))
(when v2k (verilog-repair-open-comma))
(when (or sig-list-i sig-list-o sig-list-io)
(verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n")
- ;; Don't sort them so a upper AUTOINST will match the main module
+ ;; Don't sort them so an upper AUTOINST will match the main module
(verilog-insert-definition modi sig-list-o "output" indent-pt v2k t)
(verilog-insert-definition modi sig-list-io "inout" indent-pt v2k t)
(verilog-insert-definition modi sig-list-i "input" indent-pt v2k t)
Module names must be resolvable to filenames. See `verilog-auto-inst'.
Signals are not inserted in the same order as in the original module,
- though they will appear to be in the same order to a AUTOINST
+ though they will appear to be in the same order to an AUTOINST
instantiating either module.
An example:
Module names must be resolvable to filenames. See `verilog-auto-inst'.
Signals are not inserted in the same order as in the original module,
- though they will appear to be in the same order to a AUTOINST
+ though they will appear to be in the same order to an AUTOINST
instantiating either module.
An example:
/*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/"
(verilog-auto-inout-module nil t))
+(defun verilog-auto-inout-param ()
+ "Expand AUTOINOUTPARAM statements, as part of \\[verilog-auto].
+Take input/output/inout statements from the specified module and insert
+into the current module. This is useful for making null templates and
+shell modules which need to have identical I/O with another module.
+Any I/O which are already defined in this module will not be redefined.
+For the complement of this function, see `verilog-auto-inout-comp',
+and to make monitors with all inputs, see `verilog-auto-inout-in'.
+
+Limitations:
+ If placed inside the parenthesis of a module declaration, it creates
+ Verilog 2001 style, else uses Verilog 1995 style.
+
+ Concatenation and outputting partial buses is not supported.
+
+ Module names must be resolvable to filenames. See `verilog-auto-inst'.
+
+ Signals are not inserted in the same order as in the original module,
+ though they will appear to be in the same order to an AUTOINST
+ instantiating either module.
+
+ Signals declared as \"output reg\" or \"output wire\" etc will
+ lose the wire/reg declaration so that shell modules may
+ generate those outputs differently. However, \"output logic\"
+ is propagated.
+
+An example:
+
+ module ExampShell (/*AUTOARG*/);
+ /*AUTOINOUTMODULE(\"ExampMain\")*/
+ endmodule
+
+ module ExampMain (i,o,io);
+ input i;
+ output o;
+ inout io;
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ module ExampShell (/*AUTOARG*/i,o,io);
+ /*AUTOINOUTMODULE(\"ExampMain\")*/
+ // Beginning of automatic in/out/inouts (from specific module)
+ output o;
+ inout io;
+ input i;
+ // End of automatics
+ endmodule
+
+You may also provide an optional regular expression, in which case only
+signals matching the regular expression will be included. For example the
+same expansion will result from only extracting signals starting with i:
+
+ /*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/
+
+You may also provide an optional second regular expression, in
+which case only signals which have that pin direction and data
+type will be included. This matches against everything before
+the signal name in the declaration, for example against
+\"input\" (single bit), \"output logic\" (direction and type) or
+\"output [1:0]\" (direction and implicit type). You also
+probably want to skip spaces in your regexp.
+
+For example, the below will result in matching the output \"o\"
+against the previous example's module:
+
+ /*AUTOINOUTMODULE(\"ExampMain\",\"\",\"^output.*\")*/
+
+You may also provide an optional third regular expression, in
+which case any parameter names that match the given regexp will
+be included. Including parameters is off by default. To include
+all signals and parameters, use:
+
+ /*AUTOINOUTMODULE(\"ExampMain\",\".*\",\".*\",\".*\")*/"
+ (save-excursion
+ (let* ((params (verilog-read-auto-params 1 2))
+ (submod (nth 0 params))
+ (regexp (nth 1 params))
+ submodi)
+ ;; Lookup position, etc of co-module
+ ;; Note this may raise an error
+ (when (setq submodi (verilog-modi-lookup submod t))
+ (let* ((indent-pt (current-indentation))
+ (v2k (verilog-in-paren-quick))
+ (modi (verilog-modi-current))
+ (moddecls (verilog-modi-get-decls modi))
+ (submoddecls (verilog-modi-get-decls submodi))
+ (sig-list-p (verilog-signals-not-in
+ (verilog-decls-get-gparams submoddecls)
+ (append (verilog-decls-get-gparams moddecls)))))
+ (forward-line 1)
+ (setq sig-list-p (verilog-signals-matching-regexp sig-list-p regexp))
+ (when v2k (verilog-repair-open-comma))
+ (when sig-list-p
+ (verilog-insert-indent "// Beginning of automatic parameters (from specific module)\n")
+ ;; Don't sort them so an upper AUTOINST will match the main module
+ (verilog-insert-definition modi sig-list-p "parameter" indent-pt v2k t)
+ (verilog-insert-indent "// End of automatics\n"))
+ (when v2k (verilog-repair-close-comma)))))))
+
+(defun verilog-auto-inout-modport ()
+ "Expand AUTOINOUTMODPORT statements, as part of \\[verilog-auto].
+Take input/output/inout statements from the specified interface
+and modport and insert into the current module. This is useful
+for making verification modules that connect to UVM interfaces.
+
+ The first parameter is the name of an interface.
+
+ The second parameter is a regexp of modports to read from in
+ that interface.
+
+ The optional third parameter is a regular expression, and only
+ signals matching the regular expression will be included.
+
+Limitations:
+ If placed inside the parenthesis of a module declaration, it creates
+ Verilog 2001 style, else uses Verilog 1995 style.
+
+ Interface names must be resolvable to filenames. See `verilog-auto-inst'.
+
+As with other autos, any inputs/outputs declared in the module
+will suppress the AUTO from redeclarating an inputs/outputs by
+the same name.
+
+An example:
+
+ interface ExampIf
+ ( input logic clk );
+ logic req_val;
+ logic [7:0] req_dat;
+ clocking mon_clkblk @(posedge clk);
+ input req_val;
+ input req_dat;
+ endclocking
+ modport mp(clocking mon_clkblk);
+ endinterface
+
+ module ExampMain
+ ( input clk,
+ /*AUTOINOUTMODPORT(\"ExampIf\" \"mp\")*/
+ // Beginning of automatic in/out/inouts (from modport)
+ input [7:0] req_dat,
+ input req_val
+ // End of automatics
+ );
+ /*AUTOASSIGNMODPORT(\"ExampIf\" \"mp\")*/
+ endmodule
+
+Typing \\[verilog-auto] will make this into:
+
+ ...
+ module ExampMain
+ ( input clk,
+ /*AUTOINOUTMODPORT(\"ExampIf\" \"mp\")*/
+ // Beginning of automatic in/out/inouts (from modport)
+ input req_dat,
+ input req_val
+ // End of automatics
+ );
+
+If the modport is part of a UVM monitor/driver class, this
+creates a wrapper module that may be used to instantiate the
+driver/monitor using AUTOINST in the testbench."
+ (save-excursion
+ (let* ((params (verilog-read-auto-params 2 3))
+ (submod (nth 0 params))
+ (modport-re (nth 1 params))
+ (regexp (nth 2 params))
+ direction-re submodi) ;; direction argument not supported until requested
+ ;; Lookup position, etc of co-module
+ ;; Note this may raise an error
+ (when (setq submodi (verilog-modi-lookup submod t))
+ (let* ((indent-pt (current-indentation))
+ (v2k (verilog-in-paren-quick))
+ (modi (verilog-modi-current))
+ (moddecls (verilog-modi-get-decls modi))
+ (submoddecls (verilog-modi-get-decls submodi))
+ (submodportdecls (verilog-modi-modport-lookup submodi modport-re))
+ (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-inputs submodportdecls)
+ (append (verilog-decls-get-ports submoddecls)
+ (verilog-decls-get-ports moddecls)))))
+ (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-outputs submodportdecls)
+ (append (verilog-decls-get-ports submoddecls)
+ (verilog-decls-get-ports moddecls)))))
+ (sig-list-io (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (verilog-decls-get-vars submoddecls)
+ (verilog-signals-not-in
+ (verilog-decls-get-inouts submodportdecls)
+ (append (verilog-decls-get-ports submoddecls)
+ (verilog-decls-get-ports moddecls))))))
+ (forward-line 1)
+ (setq sig-list-i (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-i regexp)
+ "input" direction-re))
+ sig-list-o (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-o regexp)
+ "output" direction-re))
+ sig-list-io (verilog-signals-edit-wire-reg
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-io regexp)
+ "inout" direction-re)))
+ (when v2k (verilog-repair-open-comma))
+ (when (or sig-list-i sig-list-o sig-list-io)
+ (verilog-insert-indent "// Beginning of automatic in/out/inouts (from modport)\n")
+ ;; Don't sort them so an upper AUTOINST will match the main module
+ (verilog-insert-definition modi sig-list-o "output" indent-pt v2k t)
+ (verilog-insert-definition modi sig-list-io "inout" indent-pt v2k t)
+ (verilog-insert-definition modi sig-list-i "input" indent-pt v2k t)
+ (verilog-insert-indent "// End of automatics\n"))
+ (when v2k (verilog-repair-close-comma)))))))
+
(defun verilog-auto-insert-lisp ()
"Expand AUTOINSERTLISP statements, as part of \\[verilog-auto].
The Lisp code provided is called, and the Lisp code calls
// For this example we declare the function in the
// module's file itself. Often you'd define it instead
- // in a site-start.el or .emacs file.
+ // in a site-start.el or init file.
/*
Local Variables:
eval:
(backward-sexp 1) ;; Inside comment
(point))) ;; Beginning paren
(cmd (buffer-substring-no-properties cmd-beg-pt cmd-end-pt)))
- (forward-line 1)
+ (verilog-forward-or-insert-line)
;; Some commands don't move point (like insert-file) so we always
;; add the begin/end comments, then delete it if not needed
(verilog-insert-indent "// Beginning of automatic insert lisp\n")
Constant signals:
AUTOSENSE cannot always determine if a `define is a constant or a signal
- (it could be in a include file for example). If a `define or other signal
+ (it could be in an include file for example). If a `define or other signal
is put into the AUTOSENSE list and is not desired, use the AUTO_CONSTANT
declaration anywhere in the module (parenthesis are required):
and should not be automatically reset. This includes omitting any signals
used on the right hand side of assignments.
-By default, AUTORESET will include the width of the signal in the autos,
-this is a recent change. To control this behavior, see
-`verilog-auto-reset-widths'.
+By default, AUTORESET will include the width of the signal in the
+autos, SystemVerilog designs may want to change this. To control
+this behavior, see `verilog-auto-reset-widths'.
AUTORESET ties signals to deasserted, which is presumed to be zero.
Signals that match `verilog-active-low-regexp' will be deasserted by tying
(if (assoc (verilog-sig-name sig) dly-list)
(concat " <= " verilog-assignment-delay)
" = ")
- (verilog-sig-tieoff sig (not verilog-auto-reset-widths))
+ (verilog-sig-tieoff sig)
";\n")
(setq sig-list (cdr sig-list))))
(verilog-insert-indent "// End of automatics")))))
`verilog-auto-wire-type' may be used to change the datatype of
the declarations.
+`verilog-auto-reset-widths' may be used to change how the tieoff
+value's width is generated.
+
An example of making a stub for another module:
module ExampStub (/*AUTOINST*/);
+ /*AUTOINOUTPARAM(\"Foo\")*/
/*AUTOINOUTMODULE(\"Foo\")*/
/*AUTOTIEOFF*/
// verilator lint_off UNUSED
Typing \\[verilog-auto] will make this into:
module ExampStub (/*AUTOINST*/...);
+ /*AUTOINOUTPARAM(\"Foo\")*/
/*AUTOINOUTMODULE(\"Foo\")*/
// Beginning of autotieoff
output [2:0] foo;
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-tieoff-ignore-regexp))
(when sig-list
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n")
(setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare))
(verilog-modi-cache-add-vars modi sig-list) ; Before we trash list
(setq sig-list (cdr sig-list))))
(verilog-insert-indent "// End of automatics\n")))))
+(defun verilog-auto-undef ()
+ "Expand AUTOUNDEF statements, as part of \\[verilog-auto].
+Take any `defines since the last AUTOUNDEF in the current file
+and create `undefs for them. This is used to insure that
+file-local defines do not pollute the global `define name space.
+
+Limitations:
+ AUTOUNDEF presumes any identifier following `define is the
+ name of a define. Any `ifdefs are ignored.
+
+ AUTOUNDEF suppresses creating an `undef for any define that was
+ `undefed before the AUTOUNDEF. This may be used to work around
+ the ignoring of `ifdefs as shown below.
+
+An example:
+
+ `define XX_FOO
+ `define M_BAR(x)
+ `define M_BAZ
+ ...
+ `ifdef NEVER
+ `undef M_BAZ // Emacs will see this and not `undef M_BAZ
+ `endif
+ ...
+ /*AUTOUNDEF*/
+
+Typing \\[verilog-auto] will make this into:
+
+ ...
+ /*AUTOUNDEF*/
+ // Beginning of automatic undefs
+ `undef XX_FOO
+ `undef M_BAR
+ // End of automatics
+
+You may also provide an optional regular expression, in which case only
+defines the regular expression will be undefed."
+ (save-excursion
+ (let* ((params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
+ (indent-pt (current-indentation))
+ (end-pt (point))
+ defs def)
+ (save-excursion
+ ;; Scan from start of file, or last AUTOUNDEF
+ (or (verilog-re-search-backward-quick "/\\*AUTOUNDEF\\>" end-pt t)
+ (goto-char (point-min)))
+ (while (verilog-re-search-forward-quick
+ "`\\(define\\|undef\\)\\s-*\\([a-zA-Z_][a-zA-Z_0-9]*\\)" end-pt t)
+ (cond ((equal (match-string-no-properties 1) "define")
+ (setq def (match-string-no-properties 2))
+ (when (and (or (not regexp)
+ (string-match regexp def))
+ (not (member def defs))) ;; delete-dups not in 21.1
+ (setq defs (cons def defs))))
+ (t
+ (setq defs (delete (match-string-no-properties 2) defs))))))
+ ;; Insert
+ (setq defs (sort defs 'string<))
+ (when defs
+ (verilog-forward-or-insert-line)
+ (verilog-insert-indent "// Beginning of automatic undefs\n")
+ (while defs
+ (verilog-insert-indent "`undef " (car defs) "\n")
+ (setq defs (cdr defs)))
+ (verilog-insert-indent "// End of automatics\n")))))
+
(defun verilog-auto-unused ()
"Expand AUTOUNUSED statements, as part of \\[verilog-auto].
Replace the /*AUTOUNUSED*/ comment with a comma separated list of all unused
An example of making a stub for another module:
module ExampStub (/*AUTOINST*/);
+ /*AUTOINOUTPARAM(\"Examp\")*/
/*AUTOINOUTMODULE(\"Examp\")*/
/*AUTOTIEOFF*/
// verilator lint_off UNUSED
(setq sig-list (verilog-signals-not-matching-regexp
sig-list verilog-auto-unused-ignore-regexp))
(when sig-list
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic unused inputs\n")
(setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare))
(while sig-list
(defun verilog-auto-ascii-enum ()
"Expand AUTOASCIIENUM statements, as part of \\[verilog-auto].
-Create a register to contain the ASCII decode of a enumerated signal type.
+Create a register to contain the ASCII decode of an enumerated signal type.
This will allow trace viewers to show the ASCII name of states.
-First, parameters are built into a enumeration using the synopsys enum
+First, parameters are built into an enumeration using the synopsys enum
comment. The comment must be between the keyword and the symbol.
\(Annoying, but that's what Synopsys's dc_shell FSM reader requires.)
Next, registers which that enum applies to are also tagged with the same
enum.
-Finally, a AUTOASCIIENUM command is used.
+Finally, an AUTOASCIIENUM command is used.
The first parameter is the name of the signal to be decoded.
tell viewers like Dinotrace to display in ASCII format.
The third optional parameter is a string which will be removed
- from the state names. It defaults to "" which removes nothing.
+ from the state names. It defaults to \"\" which removes nothing.
The fourth optional parameter is \"onehot\" to force one-hot
- decoding. If unspecified, if and only if the first parameter
+ decoding. If unspecified, if and only if the first parameter
width is 2^(number of states in enum) and does NOT match the
- width of the enum, the signal is assumed to be a one hot
+ width of the enum, the signal is assumed to be a one-hot
decode. Otherwise, it's a normal encoded state vector.
`verilog-auto-wire-type' may be used to change the datatype of
the declarations.
+ \"auto enum\" may be used in place of \"synopsys enum\".
+
An example:
//== State enumeration
;;
(sig-list-consts (append (verilog-decls-get-consts moddecls)
(verilog-decls-get-gparams moddecls)))
- (sig-list-all (append (verilog-decls-get-vars moddecls)
- (verilog-decls-get-outputs moddecls)
- (verilog-decls-get-inouts moddecls)
- (verilog-decls-get-inputs moddecls)))
+ (sig-list-all (verilog-decls-get-iovars moddecls))
;;
(undecode-sig (or (assoc undecode-name sig-list-all)
(error "%s: Signal %s not found in design" (verilog-point-text) undecode-name)))
(undecode-enum (or (verilog-sig-enum undecode-sig)
- (error "%s: Signal %s does not have a enum tag" (verilog-point-text) undecode-name)))
+ (error "%s: Signal %s does not have an enum tag" (verilog-point-text) undecode-name)))
;;
(enum-sigs (verilog-signals-not-in
(or (verilog-signals-matching-enum sig-list-consts undecode-enum)
elim-regexp)))
tmp-sigs (cdr tmp-sigs))))
;;
- (forward-line 1)
+ (verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic ASCII enum decoding\n")
(let ((decode-sig-list (list (list ascii-name (format "[%d:0]" (- (* ascii-chars 8) 1))
(concat "Decode of " undecode-name) nil nil))))
(string-to-number (match-string 2)))))
t t))))
+(defun verilog-auto-template-lint ()
+ "Check AUTO_TEMPLATEs for unused lines.
+Enable with `verilog-auto-template-warn-unused'."
+ (let ((name1 (or (buffer-file-name) (buffer-name))))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\s-*/?\\*?\\s-*[a-zA-Z0-9`_$]+\\s-+AUTO_TEMPLATE" nil t)
+ (let* ((tpl-info (verilog-read-auto-template-middle))
+ (tpl-list (aref tpl-info 1))
+ (tlines (append (nth 0 tpl-list) (nth 1 tpl-list)))
+ tpl-ass)
+ (while tlines
+ (setq tpl-ass (car tlines)
+ tlines (cdr tlines))
+ ;;;
+ (unless (or (not (eval-when-compile (fboundp 'make-hash-table))) ;; Not supported, no warning
+ (not verilog-auto-template-hits)
+ (gethash (vector (nth 2 tpl-ass) (nth 3 tpl-ass))
+ verilog-auto-template-hits))
+ (verilog-warn-error "%s:%d: AUTO_TEMPLATE line unused: \".%s (%s)\""
+ name1
+ (+ (elt tpl-ass 3) ;; Template line number
+ (count-lines (point-min) (point)))
+ (elt tpl-ass 0) (elt tpl-ass 1))
+ )))))))
+
\f
;;
;; Auto top level
;;
-(defun verilog-auto (&optional inject) ; Use verilog-inject-auto instead of passing a arg
+(defun verilog-auto (&optional inject) ; Use verilog-inject-auto instead of passing an arg
"Expand AUTO statements.
Look for any /*AUTO...*/ commands in the code, as used in
instantiations or argument headers. Update the list of signals
Using \\[describe-function], see also:
`verilog-auto-arg' for AUTOARG module instantiations
`verilog-auto-ascii-enum' for AUTOASCIIENUM enumeration decoding
+ `verilog-auto-assign-modport' for AUTOASSIGNMODPORT assignment to/from modport
`verilog-auto-inout-comp' for AUTOINOUTCOMP copy complemented i/o
`verilog-auto-inout-in' for AUTOINOUTIN inputs for all i/o
+ `verilog-auto-inout-modport' for AUTOINOUTMODPORT i/o from an interface modport
`verilog-auto-inout-module' for AUTOINOUTMODULE copying i/o from elsewhere
+ `verilog-auto-inout-param' for AUTOINOUTPARAM copying params from elsewhere
`verilog-auto-inout' for AUTOINOUT making hierarchy inouts
`verilog-auto-input' for AUTOINPUT making hierarchy inputs
`verilog-auto-insert-lisp' for AUTOINSERTLISP insert code from lisp function
`verilog-auto-reset' for AUTORESET flop resets
`verilog-auto-sense' for AUTOSENSE always sensitivity lists
`verilog-auto-tieoff' for AUTOTIEOFF output tieoffs
+ `verilog-auto-undef' for AUTOUNDEF `undef of local `defines
`verilog-auto-unused' for AUTOUNUSED unused inputs/inouts
`verilog-auto-wire' for AUTOWIRE instantiation wires
(unless noninteractive (message "Updating AUTOs..."))
(if (fboundp 'dinotrace-unannotate-all)
(dinotrace-unannotate-all))
- (let ((oldbuf (if (not (buffer-modified-p))
- (buffer-string)))
- ;; Before version 20, match-string with font-lock returns a
- ;; vector that is not equal to the string. IE if on "input"
- ;; nil==(equal "input" (progn (looking-at "input") (match-string 0)))
- (fontlocked (when (and (boundp 'font-lock-mode)
- font-lock-mode)
- (font-lock-mode 0)
- t))
- ;; Cache directories; we don't write new files, so can't change
- (verilog-dir-cache-preserving t)
- ;; Cache current module
- (verilog-modi-cache-current-enable t)
- (verilog-modi-cache-current-max (point-min)) ; IE it's invalid
- verilog-modi-cache-current)
+ (verilog-save-font-mods
+ (let ((oldbuf (if (not (buffer-modified-p))
+ (buffer-string)))
+ ;; Cache directories; we don't write new files, so can't change
+ (verilog-dir-cache-preserving t)
+ ;; Cache current module
+ (verilog-modi-cache-current-enable t)
+ (verilog-modi-cache-current-max (point-min)) ; IE it's invalid
+ verilog-modi-cache-current)
(unwind-protect
;; Disable change hooks for speed
;; This let can't be part of above let; must restore
;; Wipe cache; otherwise if we AUTOed a block above this one,
;; we'll misremember we have generated IOs, confusing AUTOOUTPUT
(setq verilog-modi-cache-list nil)
+ ;; Local state
+ (setq verilog-auto-template-hits nil)
;; If we're not in verilog-mode, change syntax table so parsing works right
(unless (eq major-mode `verilog-mode) (verilog-mode))
;; Allow user to customize
(when verilog-auto-read-includes
(verilog-read-includes)
(verilog-read-defines nil nil t))
+ ;; Setup variables due to SystemVerilog expansion
+ (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic-setup)
;; This particular ordering is important
;; INST: Lower modules correct, no internal dependencies, FIRST
(verilog-preserve-modi-cache
(verilog-inject-arg))
;;
;; Do user inserts first, so their code can insert AUTOs
- ;; We may provide a AUTOINSERTLISPLAST if another cleanup pass is needed
+ ;; We may provide an AUTOINSERTLISPLAST if another cleanup pass is needed
(verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/"
'verilog-auto-insert-lisp)
;; Expand instances before need the signals the instances input/output
(verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense)
(verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset)
;; Must be done before autoin/out as creates a reg
- (verilog-auto-re-search-do "/\\*AUTOASCIIENUM([^)]*)\\*/" 'verilog-auto-ascii-enum)
+ (verilog-auto-re-search-do "/\\*AUTOASCIIENUM(.*?)\\*/" 'verilog-auto-ascii-enum)
;;
;; first in/outs from other files
- (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE([^)]*)\\*/" 'verilog-auto-inout-module)
- (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP([^)]*)\\*/" 'verilog-auto-inout-comp)
- (verilog-auto-re-search-do "/\\*AUTOINOUTIN([^)]*)\\*/" 'verilog-auto-inout-in)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTMODPORT(.*?)\\*/" 'verilog-auto-inout-modport)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE(.*?)\\*/" 'verilog-auto-inout-module)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP(.*?)\\*/" 'verilog-auto-inout-comp)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTIN(.*?)\\*/" 'verilog-auto-inout-in)
+ (verilog-auto-re-search-do "/\\*AUTOINOUTPARAM(.*?)\\*/" 'verilog-auto-inout-param)
;; next in/outs which need previous sucked inputs first
- (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((\"[^\"]*\")\\)\\*/"
- (lambda () (verilog-auto-output t)))
- (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\*/" 'verilog-auto-output)
- (verilog-auto-re-search-do "/\\*AUTOINPUT\\((\"[^\"]*\")\\)\\*/"
- (lambda () (verilog-auto-input t)))
- (verilog-auto-re-search-do "/\\*AUTOINPUT\\*/" 'verilog-auto-input)
- (verilog-auto-re-search-do "/\\*AUTOINOUT\\((\"[^\"]*\")\\)\\*/"
- (lambda () (verilog-auto-inout t)))
- (verilog-auto-re-search-do "/\\*AUTOINOUT\\*/" 'verilog-auto-inout)
+ (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((.*?)\\)?\\*/" 'verilog-auto-output)
+ (verilog-auto-re-search-do "/\\*AUTOINPUT\\((.*?)\\)?\\*/" 'verilog-auto-input)
+ (verilog-auto-re-search-do "/\\*AUTOINOUT\\((.*?)\\)?\\*/" 'verilog-auto-inout)
;; Then tie off those in/outs
(verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff)
+ ;; These can be anywhere after AUTOINSERTLISP
+ (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((.*?)\\)?\\*/" 'verilog-auto-undef)
;; Wires/regs must be after inputs/outputs
+ (verilog-auto-re-search-do "/\\*AUTOASSIGNMODPORT(.*?)\\*/" 'verilog-auto-assign-modport)
(verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic)
(verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire)
(verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg)
(verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg)
;; Fix line numbers (comments only)
(when verilog-auto-inst-template-numbers
- (verilog-auto-templated-rel))))
+ (verilog-auto-templated-rel))
+ (when verilog-auto-template-warn-unused
+ (verilog-auto-template-lint))))
;;
(verilog-run-hooks 'verilog-auto-hook)
;;
;; End of after-change protection
)))
;; Unwind forms
- (progn
- ;; Restore font-lock
- (when fontlocked (font-lock-mode t))))))
+ ;; Currently handled in verilog-save-font-mods
+ ))))
\f
;;
;;
;; Place the templates into Verilog Mode. They may be inserted under any key.
;; C-c C-t will be the default. If you use templates a lot, you
-;; may want to consider moving the binding to another key in your .emacs
+;; may want to consider moving the binding to another key in your init
;; file.
;;
;; Note \C-c and letter are reserved for users
(define-skeleton verilog-sk-def-reg
"Insert a reg definition."
()
- > "reg [" '(verilog-sk-prompt-width) | -1 verilog-sk-signal ";" \n (verilog-pretty-declarations) )
+ > "reg [" '(verilog-sk-prompt-width) | -1 verilog-sk-signal ";" \n (verilog-pretty-declarations-auto) )
(defun verilog-sk-define-signal ()
"Insert a definition of signal under point at top of module."
(concat "verilog-mode v" verilog-mode-version)
'(
verilog-active-low-regexp
+ verilog-after-save-font-hook
verilog-align-ifelse
verilog-assignment-delay
verilog-auto-arg-sort
+ verilog-auto-declare-nettype
+ verilog-auto-delete-trailing-whitespace
verilog-auto-endcomments
verilog-auto-hook
verilog-auto-ignore-concat
verilog-auto-input-ignore-regexp
verilog-auto-inst-column
verilog-auto-inst-dot-name
+ verilog-auto-inst-interfaced-ports
verilog-auto-inst-param-value
+ verilog-auto-inst-sort
verilog-auto-inst-template-numbers
verilog-auto-inst-vector
verilog-auto-lineup
verilog-auto-newline
verilog-auto-output-ignore-regexp
verilog-auto-read-includes
+ verilog-auto-reset-blocking-in-non
verilog-auto-reset-widths
verilog-auto-save-policy
verilog-auto-sense-defines-constant
verilog-auto-sense-include-inputs
verilog-auto-star-expand
verilog-auto-star-save
+ verilog-auto-template-warn-unused
+ verilog-auto-tieoff-declaration
+ verilog-auto-tieoff-ignore-regexp
verilog-auto-unused-ignore-regexp
+ verilog-auto-wire-type
verilog-before-auto-hook
verilog-before-delete-auto-hook
verilog-before-getopt-flags-hook
+ verilog-before-save-font-hook
+ verilog-cache-enabled
verilog-case-indent
verilog-cexp-indent
verilog-compiler
verilog-delete-auto-hook
verilog-getopt-flags-hook
verilog-highlight-grouping-keywords
+ verilog-highlight-includes
+ verilog-highlight-modules
verilog-highlight-p1800-keywords
verilog-highlight-translate-off
verilog-indent-begin-after-if
verilog-linter
verilog-minimum-comment-distance
verilog-mode-hook
+ verilog-mode-release-date
+ verilog-mode-release-emacs
+ verilog-mode-version
verilog-preprocessor
verilog-simulator
verilog-tab-always-indent
verilog-tab-to-comment
verilog-typedef-regexp
+ verilog-warn-fatal
)
nil nil
(concat "Hi Mac,
;; filed in the Emacs bug reporting system against this file, a copy
;; of the bug report be sent to the maintainer's email address.
-(defconst vhdl-version "3.33.6"
+(defconst vhdl-version "3.33.28"
"VHDL Mode version number.")
-(defconst vhdl-time-stamp "2005-08-30"
+(defconst vhdl-time-stamp "2010-09-22"
"VHDL Mode time stamp for last update.")
;; This file is part of GNU Emacs.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs Versions
-;; supported: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X
-;; tested on: GNU Emacs 20.4, XEmacs 21.1 (marginally)
+;; supported: GNU Emacs 20.X/21.X/22.X,23.X, XEmacs 20.X/21.X
+;; tested on: GNU Emacs 20.4/21.3/22.1,23.X, XEmacs 21.1 (marginally)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Installation
-;; Prerequisites: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X.
+;; Prerequisites: GNU Emacs 20.X/21.X/22.X/23.X, XEmacs 20.X/21.X.
;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
;; or into an arbitrary directory that is added to the load path by the
;; Add the following lines to the `site-start.el' file in the `site-lisp'
;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
-;; (not required in Emacs 20.X):
+;; (not required in Emacs 20 and higher):
;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist))
;; VHDL Mode distribution.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Acknowledgements
+;; Acknowledgments
;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>
;; and Steve Grout.
\".*\" \"\" inserts empty string")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User variables
+;; User variables (customization options)
(defgroup vhdl nil
"Customizations for VHDL Mode."
:group 'vhdl)
(defcustom vhdl-indent-tabs-mode nil
- "*Non-nil means indentation can insert tabs.
+ "Non-nil means indentation can insert tabs.
Overrides local variable `indent-tabs-mode'."
:type 'boolean
:group 'vhdl-mode)
(defcustom vhdl-compiler-alist
'(
+ ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1"
+ nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms"
+ ("\\s-\\([0-9]+\\):" 0 1 0) ("Compiling file \\(.+\\)" 1)
+ ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
+ "PACK/\\1.vif" "BODY/\\1.vif" upcase))
+ ;; Aldec
+ ;; COMP96 ERROR COMP96_0078: "Unknown identifier "Addr_Bits"." "<filename>" 40 30
+ ("Aldec" "vcom" "-93 -work \\1" "make" "-f \\1"
+ nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec"
+ (".+?[ \t]+\\(?:ERROR\\)[^:]+:.+?\\(?:.+\"\\(.+?\\)\"[ \t]+\\([0-9]+\\)\\)" 1 2 0) ("" 0)
+ nil)
;; Cadence Leapfrog: cv -file test.vhd
;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
("ncvhdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db"
"\\1/package/pc.db" "\\1/body/pc.db" downcase))
+ ;; ghdl vhdl: ghdl test.vhd
+ ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1"
+ nil "mkdir \\1" "./" "work/" "Makefile" "ghdl"
+ ("ghdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
+ ("\\1/entity" "\\2/\\1" "\\1/configuration"
+ "\\1/package" "\\1/body" downcase))
;; Ikos Voyager: analyze test.vhd
;; analyze test.vhd
;; E L4/C5: this library unit is inaccessible
;; ModelSim, Model Technology: vcom test.vhd
;; ERROR: test.vhd(14): Unknown identifier: positiv
;; WARNING[2]: test.vhd(85): Possible infinite loop
+ ;; ** Warning: [4] ../src/emacsvsim.vhd(43): An abstract ...
;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
- ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0)
+ ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\(.+\\)(\\([0-9]+\\)):" 3 4 0) ("" 0)
("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
"\\1/_primary.dat" "\\1/body.dat" downcase))
;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0)
("^ *Compiling \"\\(.+\\)\" " 1)
nil)
+ ;; Xilinx XST:
+ ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error
+ ("Xilinx XST" "xflow" "" "make" "-f \\1"
+ nil "mkdir \\1" "./" "work/" "Makefile" "xilinx"
+ ("^ERROR:HDLParsers:[0-9]+ - \"\\(.+\\)\" Line \\([0-9]+\\)\." 1 2 0) ("" 0)
+ nil)
)
- "*List of available VHDL compilers and their properties.
+ "List of available VHDL compilers and their properties.
Each list entry specifies the following items for a compiler:
Compiler:
Compiler name : name used in option `vhdl-compiler' to choose compiler
(vhdl-custom-set variable value 'vhdl-update-mode-menu))
:group 'vhdl-compile)
-(defcustom vhdl-compiler "ModelSim"
- "*Specifies the VHDL compiler to be used for syntax analysis.
+(defcustom vhdl-compiler "GHDL"
+ "Specifies the VHDL compiler to be used for syntax analysis.
Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
:type (let ((alist vhdl-compiler-alist) list)
(while alist
:group 'vhdl-compile)
(defcustom vhdl-compile-use-local-error-regexp t
- "*Non-nil means use buffer-local `compilation-error-regexp-alist'.
+ "Non-nil means use buffer-local `compilation-error-regexp-alist'.
In this case, only error message regexps for VHDL compilers are active if
compilation is started from a VHDL buffer. Otherwise, the error message
regexps are appended to the predefined global regexps, and all regexps are
:type 'boolean
:group 'vhdl-compile)
+(defcustom vhdl-makefile-default-targets '("all" "clean" "library")
+ "List of default target names in Makefiles.
+Automatically generated Makefiles include three default targets to compile
+the entire design, clean the entire design and to create the design library.
+This option allows to change the names of these targets to avoid conflicts
+with other user Makefiles."
+ :type '(list (string :tag "Compile entire design")
+ (string :tag "Clean entire design ")
+ (string :tag "Create design library"))
+ :group 'vhdl-compile)
+
(defcustom vhdl-makefile-generation-hook nil
- "*Functions to run at the end of Makefile generation.
+ "Functions to run at the end of Makefile generation.
Allows to insert user specific parts into a Makefile.
Example:
:group 'vhdl-compile)
(defcustom vhdl-default-library "work"
- "*Name of default library.
+ "Name of default library.
Is overwritten by project settings if a project is active."
:type 'string
:group 'vhdl-compile)
-- This is a multi-line project description
-- that can be used as a project dependent part of the file header.
"))
- "*List of projects and their properties.
+ "List of projects and their properties.
Name : name used in option `vhdl-project' to choose project
Title : title of project (single-line string)
Default directory: default project directory (absolute path)
:group 'vhdl-project)
(defcustom vhdl-project nil
- "*Specifies the default for the current project.
+ "Specifies the default for the current project.
Select a project name from the ones defined in option `vhdl-project-alist'.
Is used to determine the project title and description to be inserted in file
headers and the source files/directories to be scanned in the hierarchy
:group 'vhdl-project)
(defcustom vhdl-project-file-name '("\\1.prj")
- "*List of file names/paths for importing/exporting project setups.
+ "List of file names/paths for importing/exporting project setups.
\"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is
replaced by the user name (allows to have user-specific project setups).
The first entry is used as file name to import/export individual project
:group 'vhdl-project)
(defcustom vhdl-project-auto-load '(startup)
- "*Automatically load project setups from files.
+ "Automatically load project setups from files.
All project setup files that match the file names specified in option
`vhdl-project-file-name' are automatically loaded. The project of the
\(alphabetically) last loaded setup of the first `vhdl-project-file-name'
:group 'vhdl-project)
(defcustom vhdl-project-sort t
- "*Non-nil means projects are displayed in alphabetical order."
+ "Non-nil means projects are displayed in alphabetical order."
:type 'boolean
:group 'vhdl-project)
:group 'vhdl-port
:group 'vhdl-compose)
-(defcustom vhdl-standard '(87 nil)
- "*VHDL standards used.
+(defcustom vhdl-standard '(93 nil)
+ "VHDL standards used.
Basic standard:
VHDL'87 : IEEE Std 1076-1987
- VHDL'93 : IEEE Std 1076-1993
+ VHDL'93/02 : IEEE Std 1076-1993/2002
Additional standards:
VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal)
Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
\"Activate Options\"."
:type '(list (choice :tag "Basic standard"
(const :tag "VHDL'87" 87)
- (const :tag "VHDL'93" 93))
+ (const :tag "VHDL'93/02" 93))
(set :tag "Additional standards" :indent 2
(const :tag "VHDL-AMS" ams)
(const :tag "Math packages" math)))
:group 'vhdl-style)
(defcustom vhdl-basic-offset 2
- "*Amount of basic offset used for indentation.
+ "Amount of basic offset used for indentation.
This value is used by + and - symbols in `vhdl-offsets-alist'."
:type 'integer
:group 'vhdl-style)
(defcustom vhdl-upper-case-keywords nil
- "*Non-nil means convert keywords to upper case.
+ "Non-nil means convert keywords to upper case.
This is done when typed or expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
:group 'vhdl-style)
(defcustom vhdl-upper-case-types nil
- "*Non-nil means convert standardized types to upper case.
+ "Non-nil means convert standardized types to upper case.
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
:group 'vhdl-style)
(defcustom vhdl-upper-case-attributes nil
- "*Non-nil means convert standardized attributes to upper case.
+ "Non-nil means convert standardized attributes to upper case.
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
:group 'vhdl-style)
(defcustom vhdl-upper-case-enum-values nil
- "*Non-nil means convert standardized enumeration values to upper case.
+ "Non-nil means convert standardized enumeration values to upper case.
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
:group 'vhdl-style)
(defcustom vhdl-upper-case-constants t
- "*Non-nil means convert standardized constants to upper case.
+ "Non-nil means convert standardized constants to upper case.
This is done when expanded."
:type 'boolean
:set (lambda (variable value)
:group 'vhdl-style)
(defcustom vhdl-use-direct-instantiation 'standard
- "*Non-nil means use VHDL'93 direct component instantiation.
+ "Non-nil means use VHDL'93 direct component instantiation.
Never : never
Standard: only in VHDL standards that allow it (VHDL'93 and higher)
Always : always"
(const :tag "Always" always))
:group 'vhdl-style)
+(defcustom vhdl-array-index-record-field-in-sensitivity-list t
+ "Non-nil means include array indices / record fields in sensitivity list.
+If a signal read in a process is a record field or pointed to by an array
+index, the record field or array index is included with the record name in
+the sensitivity list (e.g. \"in1(0)\", \"in2.f0\").
+Otherwise, only the record name is included (e.g. \"in1\", \"in2\")."
+ :type 'boolean
+ :group 'vhdl-style)
(defgroup vhdl-naming nil
"Customizations for naming conventions."
(defcustom vhdl-entity-file-name '(".*" . "\\&")
(concat
- "*Specifies how the entity file name is obtained.
+ "Specifies how the entity file name is obtained.
The entity file name can be obtained by modifying the entity name (e.g.
attaching or stripping off a substring). The file extension is automatically
taken from the file name of the current buffer."
(defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2")
(concat
- "*Specifies how the architecture file name is obtained.
+ "Specifies how the architecture file name is obtained.
The architecture file name can be obtained by modifying the entity
and/or architecture name (e.g. attaching or stripping off a substring). The
file extension is automatically taken from the file name of the current
(defcustom vhdl-configuration-file-name '(".*" . "\\&")
(concat
- "*Specifies how the configuration file name is obtained.
+ "Specifies how the configuration file name is obtained.
The configuration file name can be obtained by modifying the configuration
name (e.g. attaching or stripping off a substring). The file extension is
automatically taken from the file name of the current buffer."
(defcustom vhdl-package-file-name '(".*" . "\\&")
(concat
- "*Specifies how the package file name is obtained.
+ "Specifies how the package file name is obtained.
The package file name can be obtained by modifying the package name (e.g.
attaching or stripping off a substring). The file extension is automatically
taken from the file name of the current buffer. Package files can be created
:group 'vhdl-compose)
(defcustom vhdl-file-name-case 'identity
- "*Specifies how to change case for obtaining file names.
+ "Specifies how to change case for obtaining file names.
When deriving a file name from a VHDL unit name, case can be changed as
follows:
As Is: case is not changed (taken as is)
:group 'vhdl)
(defcustom vhdl-electric-keywords '(vhdl user)
- "*Type of keywords for which electrification is enabled.
+ "Type of keywords for which electrification is enabled.
VHDL keywords: invoke built-in templates
User keywords: invoke user models (see option `vhdl-model-alist')"
:type '(set (const :tag "VHDL keywords" vhdl)
:group 'vhdl-template)
(defcustom vhdl-optional-labels 'process
- "*Constructs for which labels are to be queried.
+ "Constructs for which labels are to be queried.
Template generators prompt for optional labels for:
None : no constructs
Processes only: processes only (also procedurals in VHDL-AMS)
:group 'vhdl-template)
(defcustom vhdl-insert-empty-lines 'unit
- "*Specifies whether to insert empty lines in some templates.
+ "Specifies whether to insert empty lines in some templates.
This improves readability of code. Empty lines are inserted in:
None : no constructs
Design units only: entities, architectures, configurations, packages only
:group 'vhdl-compose)
(defcustom vhdl-argument-list-indent nil
- "*Non-nil means indent argument lists relative to opening parenthesis.
+ "Non-nil means indent argument lists relative to opening parenthesis.
That is, argument, association, and port lists start on the same line as the
opening parenthesis and subsequent lines are indented accordingly.
Otherwise, lists start on a new line and are indented as normal code."
:group 'vhdl-compose)
(defcustom vhdl-association-list-with-formals t
- "*Non-nil means write association lists with formal parameters.
+ "Non-nil means write association lists with formal parameters.
Templates prompt for formal and actual parameters (ports/generics).
When pasting component instantiations, formals are included.
If nil, only a list of actual parameters is entered."
:group 'vhdl-compose)
(defcustom vhdl-conditions-in-parenthesis nil
- "*Non-nil means place parenthesis around condition expressions."
+ "Non-nil means place parenthesis around condition expressions."
:type 'boolean
:group 'vhdl-template)
(defcustom vhdl-zero-string "'0'"
- "*String to use for a logic zero."
+ "String to use for a logic zero."
:type 'string
:group 'vhdl-template)
(defcustom vhdl-one-string "'1'"
- "*String to use for a logic one."
+ "String to use for a logic one."
:type 'string
:group 'vhdl-template)
-------------------------------------------------------------------------------
"
- "*String or file to insert as file header.
+ "String or file to insert as file header.
If the string specifies an existing file name, the contents of the file is
inserted, otherwise the string itself is inserted as file header.
Type `C-j' for newlines.
The following keywords for template generation are supported:
<filename> : replaced by the name of the buffer
<author> : replaced by the user name and email address
- \(`user-full-name', `mail-host-address', `user-mail-address')
+ \(`user-full-name',`mail-host-address', `user-mail-address')
+ <authorfull> : replaced by the user full name (`user-full-name')
<login> : replaced by user login name (`user-login-name')
<company> : replaced by contents of option `vhdl-company-name'
<date> : replaced by the current date
:group 'vhdl-header)
(defcustom vhdl-file-footer ""
- "*String or file to insert as file footer.
+ "String or file to insert as file footer.
If the string specifies an existing file name, the contents of the file is
inserted, otherwise the string itself is inserted as file footer (i.e. at
the end of the file).
:group 'vhdl-header)
(defcustom vhdl-company-name ""
- "*Name of company to insert in file header.
+ "Name of company to insert in file header.
See option `vhdl-file-header'."
:type 'string
:group 'vhdl-header)
-------------------------------------------------------------------------------
-- Copyright (c) <year> <company>
"
- "*Copyright string to insert in file header.
+ "Copyright string to insert in file header.
Can be multi-line string (type `C-j' for newline) and contain other file
header keywords (see option `vhdl-file-header')."
:type 'string
:group 'vhdl-header)
(defcustom vhdl-platform-spec ""
- "*Specification of VHDL platform to insert in file header.
+ "Specification of VHDL platform to insert in file header.
The platform specification should contain names and versions of the
simulation and synthesis tools used.
See option `vhdl-file-header'."
:group 'vhdl-header)
(defcustom vhdl-date-format "%Y-%m-%d"
- "*Specifies the date format to use in the header.
+ "Specifies the date format to use in the header.
This string is passed as argument to the command `format-time-string'.
For more information on format strings, see the documentation for the
`format-time-string' command (C-h f `format-time-string')."
:group 'vhdl-header)
(defcustom vhdl-modify-date-prefix-string "-- Last update: "
- "*Prefix string of modification date in VHDL file header.
+ "Prefix string of modification date in VHDL file header.
If actualization of the modification date is called (menu,
`\\[vhdl-template-modify]'), this string is searched and the rest
of the line replaced by the current date."
:group 'vhdl-header)
(defcustom vhdl-modify-date-on-saving t
- "*Non-nil means update the modification date when the buffer is saved.
+ "Non-nil means update the modification date when the buffer is saved.
Calls function `\\[vhdl-template-modify]').
NOTE: Activate the new setting in a VHDL buffer by using the menu entry
"Customizations for sequential processes."
:group 'vhdl-template)
-(defcustom vhdl-reset-kind 'async
- "*Specifies which kind of reset to use in sequential processes."
+(defcustom vhdl-reset-kind 'async
+ "Specifies which kind of reset to use in sequential processes."
:type '(choice (const :tag "None" none)
(const :tag "Synchronous" sync)
- (const :tag "Asynchronous" async))
+ (const :tag "Asynchronous" async)
+ (const :tag "Query" query))
:group 'vhdl-sequential-process)
(defcustom vhdl-reset-active-high nil
- "*Non-nil means reset in sequential processes is active high.
+ "Non-nil means reset in sequential processes is active high.
Otherwise, reset is active low."
:type 'boolean
:group 'vhdl-sequential-process)
(defcustom vhdl-clock-rising-edge t
- "*Non-nil means rising edge of clock triggers sequential processes.
+ "Non-nil means rising edge of clock triggers sequential processes.
Otherwise, falling edge triggers."
:type 'boolean
:group 'vhdl-sequential-process)
(defcustom vhdl-clock-edge-condition 'standard
- "*Syntax of the clock edge condition.
+ "Syntax of the clock edge condition.
Standard: \"clk'event and clk = '1'\"
Function: \"rising_edge(clk)\""
:type '(choice (const :tag "Standard" standard)
:group 'vhdl-sequential-process)
(defcustom vhdl-clock-name ""
- "*Name of clock signal to use in templates."
+ "Name of clock signal to use in templates."
:type 'string
:group 'vhdl-sequential-process)
(defcustom vhdl-reset-name ""
- "*Name of reset signal to use in templates."
+ "Name of reset signal to use in templates."
:type 'string
:group 'vhdl-sequential-process)
end if;
end process <label>;"
"e" ""))
- "*List of user models.
+ "List of user models.
VHDL models (templates) can be specified by the user in this list. They can be
invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword
electrification (i.e. overriding existing or creating new keywords, see
(defcustom vhdl-compose-architecture-name '(".*" . "str")
(concat
- "*Specifies how the component architecture name is obtained.
+ "Specifies how the component architecture name is obtained.
The component architecture name can be obtained by modifying the entity name
\(e.g. attaching or stripping off a substring).
If TO STRING is empty, the architecture name is queried."
(defcustom vhdl-compose-configuration-name
'("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg")
(concat
- "*Specifies how the configuration name is obtained.
+ "Specifies how the configuration name is obtained.
The configuration name can be obtained by modifying the entity and/or
architecture name (e.g. attaching or stripping off a substring). The string
that is matched against the regexp is the concatenation of the entity and the
(defcustom vhdl-components-package-name
'((".*" . "\\&_components") . "components")
(concat
- "*Specifies how the name for the components package is obtained.
+ "Specifies how the name for the components package is obtained.
The components package is a package containing all component declarations for
the current design. Its name can be obtained by modifying the project name
\(e.g. attaching or stripping off a substring). If no project is defined, the
:group 'vhdl-compose)
(defcustom vhdl-use-components-package nil
- "*Non-nil means use a separate components package for component declarations.
+ "Non-nil means use a separate components package for component declarations.
Otherwise, component declarations are inserted and searched for in the
architecture declarative parts."
:type 'boolean
:group 'vhdl-compose)
(defcustom vhdl-compose-include-header t
- "*Non-nil means include a header in automatically generated files."
+ "Non-nil means include a header in automatically generated files."
:type 'boolean
:group 'vhdl-compose)
(defcustom vhdl-compose-create-files 'single
- "*Specifies whether new files should be created for the new component.
+ "Specifies whether new files should be created for the new component.
The component's entity and architecture are inserted:
None : in current buffer
Single file : in new single file
:group 'vhdl-compose)
(defcustom vhdl-compose-configuration-create-file nil
- "*Specifies whether a new file should be created for the configuration.
+ "Specifies whether a new file should be created for the configuration.
If non-nil, a new file is created for the configuration.
The file name is obtained from variable `vhdl-configuration-file-name'."
:type 'boolean
:group 'vhdl-compose)
(defcustom vhdl-compose-configuration-hierarchical t
- "*Specifies whether hierarchical configurations should be created.
+ "Specifies whether hierarchical configurations should be created.
If non-nil, automatically created configurations are hierarchical and include
the whole hierarchy of subcomponents. Otherwise the configuration only
includes one level of subcomponents."
:group 'vhdl-compose)
(defcustom vhdl-compose-configuration-use-subconfiguration t
- "*Specifies whether subconfigurations should be used inside configurations.
+ "Specifies whether subconfigurations should be used inside configurations.
If non-nil, automatically created configurations use configurations in binding
indications for subcomponents, if such configurations exist. Otherwise,
entities are used in binding indications for subcomponents."
:group 'vhdl-compose)
(defcustom vhdl-include-port-comments nil
- "*Non-nil means include port comments when a port is pasted."
+ "Non-nil means include port comments when a port is pasted."
:type 'boolean
:group 'vhdl-port)
(defcustom vhdl-include-direction-comments nil
- "*Non-nil means include port direction in instantiations as comments."
+ "Non-nil means include port direction in instantiations as comments."
:type 'boolean
:group 'vhdl-port)
(defcustom vhdl-include-type-comments nil
- "*Non-nil means include generic/port type in instantiations as comments."
+ "Non-nil means include generic/port type in instantiations as comments."
:type 'boolean
:group 'vhdl-port)
(defcustom vhdl-include-group-comments 'never
- "*Specifies whether to include group comments and spacings.
+ "Specifies whether to include group comments and spacings.
The comments and empty lines between groups of ports are pasted:
Never : never
Declarations: in entity/component/constant/signal declarations only
(defcustom vhdl-actual-port-name '(".*" . "\\&")
(concat
- "*Specifies how actual port names are obtained from formal port names.
+ "Specifies how actual port names are obtained from formal port names.
In a component instantiation, an actual port name can be obtained by
modifying the formal port name (e.g. attaching or stripping off a substring)."
vhdl-name-doc-string)
(defcustom vhdl-instance-name '(".*" . "\\&_%d")
(concat
- "*Specifies how an instance name is obtained.
+ "Specifies how an instance name is obtained.
The instance name can be obtained by modifying the name of the component to be
instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced
by a unique number (starting with 1).
(defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb")
(concat
- "*Specifies how the testbench entity name is obtained.
+ "Specifies how the testbench entity name is obtained.
The entity name of a testbench can be obtained by modifying the name of
the component to be tested (e.g. attaching or stripping off a substring)."
vhdl-name-doc-string)
(defcustom vhdl-testbench-architecture-name '(".*" . "")
(concat
- "*Specifies how the testbench architecture name is obtained.
+ "Specifies how the testbench architecture name is obtained.
The testbench architecture name can be obtained by modifying the name of
the component to be tested (e.g. attaching or stripping off a substring).
If TO STRING is empty, the architecture name is queried."
(defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name
(concat
- "*Specifies how the testbench configuration name is obtained.
+ "Specifies how the testbench configuration name is obtained.
The configuration name of a testbench can be obtained by modifying the entity
and/or architecture name (e.g. attaching or stripping off a substring). The
string that is matched against the regexp is the concatenation of the entity
(defcustom vhdl-testbench-dut-name '(".*" . "DUT")
(concat
- "*Specifies how a DUT instance name is obtained.
+ "Specifies how a DUT instance name is obtained.
The design-under-test instance name (i.e. the component instantiated in the
testbench) can be obtained by modifying the component name (e.g. attaching
or stripping off a substring)."
:group 'vhdl-testbench)
(defcustom vhdl-testbench-include-header t
- "*Non-nil means include a header in automatically generated files."
+ "Non-nil means include a header in automatically generated files."
:type 'boolean
:group 'vhdl-testbench)
-- clock
signal Clk : std_logic := '1';
"
- "*String or file to be inserted in the testbench declarative part.
+ "String or file to be inserted in the testbench declarative part.
If the string specifies an existing file name, the contents of the file is
inserted, otherwise the string itself is inserted in the testbench
architecture before the BEGIN keyword.
wait until Clk = '1';
end process WaveGen_Proc;
"
- "*String or file to be inserted in the testbench statement part.
+ "String or file to be inserted in the testbench statement part.
If the string specifies an existing file name, the contents of the file is
inserted, otherwise the string itself is inserted in the testbench
architecture before the END keyword.
:group 'vhdl-testbench)
(defcustom vhdl-testbench-initialize-signals nil
- "*Non-nil means initialize signals with `0' when declared in testbench."
+ "Non-nil means initialize signals with `0' when declared in testbench."
:type 'boolean
:group 'vhdl-testbench)
(defcustom vhdl-testbench-include-library t
- "*Non-nil means a library/use clause for std_logic_1164 is included."
+ "Non-nil means a library/use clause for std_logic_1164 is included."
:type 'boolean
:group 'vhdl-testbench)
(defcustom vhdl-testbench-include-configuration t
- "*Non-nil means a testbench configuration is attached at the end."
+ "Non-nil means a testbench configuration is attached at the end."
:type 'boolean
:group 'vhdl-testbench)
(defcustom vhdl-testbench-create-files 'single
- "*Specifies whether new files should be created for the testbench.
+ "Specifies whether new files should be created for the testbench.
testbench entity and architecture are inserted:
None : in current buffer
Single file : in new single file
(defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name
(concat
- "*Specifies how the testbench entity file name is obtained.
+ "Specifies how the testbench entity file name is obtained.
The entity file name can be obtained by modifying the testbench entity name
\(e.g. attaching or stripping off a substring). The file extension is
automatically taken from the file name of the current buffer. Testbench
(defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name
(concat
- "*Specifies how the testbench architecture file name is obtained.
+ "Specifies how the testbench architecture file name is obtained.
The architecture file name can be obtained by modifying the testbench entity
and/or architecture name (e.g. attaching or stripping off a substring). The
string that is matched against the regexp is the concatenation of the entity
:group 'vhdl)
(defcustom vhdl-self-insert-comments t
- "*Non-nil means various templates automatically insert help comments."
+ "Non-nil means various templates automatically insert help comments."
:type 'boolean
:group 'vhdl-comment)
(defcustom vhdl-prompt-for-comments t
- "*Non-nil means various templates prompt for user definable comments."
+ "Non-nil means various templates prompt for user definable comments."
:type 'boolean
:group 'vhdl-comment)
(defcustom vhdl-inline-comment-column 40
- "*Column to indent and align inline comments to.
+ "Column to indent and align inline comments to.
Overrides local option `comment-column'.
NOTE: Activate the new setting in a VHDL buffer by using the menu entry
:group 'vhdl-comment)
(defcustom vhdl-end-comment-column 79
- "*End of comment column.
+ "End of comment column.
Comments that exceed this column number are wrapped.
NOTE: Activate the new setting in a VHDL buffer by using the menu entry
:group 'vhdl)
(defcustom vhdl-auto-align t
- "*Non-nil means align some templates automatically after generation."
+ "Non-nil means align some templates automatically after generation."
:type 'boolean
:group 'vhdl-align)
(defcustom vhdl-align-groups t
- "*Non-nil means align groups of code lines separately.
+ "Non-nil means align groups of code lines separately.
A group of code lines is a region of consecutive lines between two lines that
match the regexp in option `vhdl-align-group-separate'."
:type 'boolean
:group 'vhdl-align)
(defcustom vhdl-align-group-separate "^\\s-*$"
- "*Regexp for matching a line that separates groups of lines for alignment.
+ "Regexp for matching a line that separates groups of lines for alignment.
Examples:
\"^\\s-*$\": matches an empty line
\"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line"
:group 'vhdl-align)
(defcustom vhdl-align-same-indent t
- "*Non-nil means align blocks with same indent separately.
+ "Non-nil means align blocks with same indent separately.
When a region or the entire buffer is aligned, the code is divided into
blocks of same indent which are aligned separately (except for argument/port
lists). This gives nicer alignment in most cases.
:group 'vhdl)
(defcustom vhdl-highlight-keywords t
- "*Non-nil means highlight VHDL keywords and other standardized words.
+ "Non-nil means highlight VHDL keywords and other standardized words.
The following faces are used:
`font-lock-keyword-face' : keywords
`font-lock-type-face' : standardized types
:group 'vhdl-highlight)
(defcustom vhdl-highlight-names t
- "*Non-nil means highlight declaration names and construct labels.
+ "Non-nil means highlight declaration names and construct labels.
The following faces are used:
`font-lock-function-name-face' : names in declarations of units,
subprograms, components, as well as labels of VHDL constructs
:group 'vhdl-highlight)
(defcustom vhdl-highlight-special-words nil
- "*Non-nil means highlight words with special syntax.
+ "Non-nil means highlight words with special syntax.
The words with syntax and color specified in option `vhdl-special-syntax-alist'
are highlighted accordingly.
Can be used for visual support of naming conventions.
:group 'vhdl-highlight)
(defcustom vhdl-highlight-forbidden-words nil
- "*Non-nil means highlight forbidden words.
+ "Non-nil means highlight forbidden words.
The reserved words specified in option `vhdl-forbidden-words' or having the
syntax specified in option `vhdl-forbidden-syntax' are highlighted in a
warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to
:group 'vhdl-highlight)
(defcustom vhdl-highlight-verilog-keywords nil
- "*Non-nil means highlight Verilog keywords as reserved words.
+ "Non-nil means highlight Verilog keywords as reserved words.
Verilog keywords are highlighted in a warning color (face
`vhdl-font-lock-reserved-words-face') to indicate not to use them.
:group 'vhdl-highlight)
(defcustom vhdl-highlight-translate-off nil
- "*Non-nil means background-highlight code excluded from translation.
+ "Non-nil means background-highlight code excluded from translation.
That is, all code between \"-- pragma translate_off\" and
\"-- pragma translate_on\" is highlighted using a different background color
\(face `vhdl-font-lock-translate-off-face').
:group 'vhdl-highlight)
(defcustom vhdl-highlight-case-sensitive nil
- "*Non-nil means consider case for highlighting.
+ "Non-nil means consider case for highlighting.
Possible trade-off:
non-nil also upper-case VHDL words are highlighted, but case of words with
special syntax is not considered
:group 'vhdl-highlight)
(defcustom vhdl-special-syntax-alist
- '(("generic/constant" "\\w+_[cg]" "Gold3" "BurlyWood1")
- ("type" "\\w+_t" "ForestGreen" "PaleGreen")
- ("variable" "\\w+_v" "Grey50" "Grey80"))
- "*List of special syntax to be highlighted.
+ '(("generic/constant" "\\<\\w+_[cg]\\>" "Gold3" "BurlyWood1" nil)
+ ("type" "\\<\\w+_t\\>" "ForestGreen" "PaleGreen" nil)
+ ("variable" "\\<\\w+_v\\>" "Grey50" "Grey80" nil))
+ "List of special syntax to be highlighted.
If option `vhdl-highlight-special-words' is non-nil, words with the specified
syntax (as regular expression) are highlighted in the corresponding color.
Name : string of words and spaces
Regexp : regular expression describing word syntax
- (e.g. \"\\\w+_c\" matches word with suffix \"_c\")
+ (e.g. \"\\\\=\<\\\w+_c\\\\=\>\" matches word with suffix \"_c\")
+ expression must start with \"\\\\=\<\" and end with \"\\\\=\>\"
+ if only whole words should be matched (no substrings)
Color (light): foreground color for light background
(matching color examples: Gold3, Grey50, LimeGreen, Tomato,
LightSeaGreen, DodgerBlue, Gold, PaleVioletRed)
Color (dark) : foreground color for dark background
(matching color examples: BurlyWood1, Grey80, Green, Coral,
AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1)
+ In comments : If non-nil, words are also highlighted inside comments
Can be used for visual support of naming conventions, such as highlighting
different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
(string :tag "Name ")
(regexp :tag "Regexp " "\\w+_")
(string :tag "Color (light)")
- (string :tag "Color (dark) ")))
+ (string :tag "Color (dark) ")
+ (boolean :tag "In comments ")))
:set (lambda (variable value)
(vhdl-custom-set variable value 'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-forbidden-words '()
- "*List of forbidden words to be highlighted.
+ "List of forbidden words to be highlighted.
If option `vhdl-highlight-forbidden-words' is non-nil, these reserved
words are highlighted in a warning color to indicate not to use them.
:group 'vhdl-highlight)
(defcustom vhdl-forbidden-syntax ""
- "*Syntax of forbidden words to be highlighted.
+ "Syntax of forbidden words to be highlighted.
If option `vhdl-highlight-forbidden-words' is non-nil, words with this
syntax are highlighted in a warning color to indicate not to use them.
Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\"
:group 'vhdl-highlight)
(defcustom vhdl-directive-keywords '("pragma" "synopsys")
- "*List of compiler directive keywords recognized for highlighting.
+ "List of compiler directive keywords recognized for highlighting.
NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
entry \"Fontify Buffer\")."
:group 'vhdl)
(defcustom vhdl-speedbar-auto-open nil
- "*Non-nil means automatically open speedbar at startup.
+ "Non-nil means automatically open speedbar at startup.
Alternatively, the speedbar can be opened from the VHDL menu."
:type 'boolean
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-display-mode 'files
- "*Specifies the default displaying mode when opening speedbar.
+ "Specifies the default displaying mode when opening speedbar.
Alternatively, the displaying mode can be selected from the speedbar menu or
by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)."
:type '(choice (const :tag "Files" files)
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50))
- "*Limits scanning of large files and netlists.
+ "Limits scanning of large files and netlists.
Design units: maximum file size to scan for design units
Hierarchy (instances of subcomponents):
File size: maximum file size to scan for instances (in bytes)
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-jump-to-unit t
- "*Non-nil means jump to the design unit code when opened in a buffer.
+ "Non-nil means jump to the design unit code when opened in a buffer.
The buffer cursor position is left unchanged otherwise."
:type 'boolean
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-update-on-saving t
- "*Automatically update design hierarchy when buffer is saved."
+ "Automatically update design hierarchy when buffer is saved."
:type 'boolean
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-save-cache '(hierarchy display)
- "*Automatically save modified hierarchy caches when exiting Emacs.
+ "Automatically save modified hierarchy caches when exiting Emacs.
Hierarchy: design hierarchy information
Display: displaying information (which design units to expand)"
:type '(set (const :tag "Hierarchy" hierarchy)
:group 'vhdl-speedbar)
(defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2"
- "*Name of file for saving hierarchy cache.
+ "Name of file for saving hierarchy cache.
\"\\1\" is replaced by the project name if a project is specified,
\"directory\" otherwise. \"\\2\" is replaced by the user name (allows for
different users to have cache files in the same directory). Can also have
:group 'vhdl)
(defcustom vhdl-index-menu nil
- "*Non-nil means add an index menu for a source file when loading.
+ "Non-nil means add an index menu for a source file when loading.
Alternatively, the speedbar can be used. Note that the index menu scans a file
when it is opened, while speedbar only scans the file upon request."
:type 'boolean
:group 'vhdl-menu)
(defcustom vhdl-source-file-menu nil
- "*Non-nil means add a menu of all source files in current directory.
+ "Non-nil means add a menu of all source files in current directory.
Alternatively, the speedbar can be used."
:type 'boolean
:group 'vhdl-menu)
(defcustom vhdl-hideshow-menu nil
- "*Non-nil means add hideshow menu and functionality at startup.
+ "Non-nil means add hideshow menu and functionality at startup.
Hideshow can also be enabled from the VHDL Mode menu.
Hideshow allows hiding code of various VHDL constructs.
:group 'vhdl-menu)
(defcustom vhdl-hide-all-init nil
- "*Non-nil means hide all design units initially after a file is loaded."
+ "Non-nil means hide all design units initially after a file is loaded."
:type 'boolean
:group 'vhdl-menu)
:group 'vhdl)
(defcustom vhdl-print-two-column t
- "*Non-nil means print code in two columns and landscape format.
+ "Non-nil means print code in two columns and landscape format.
Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print')
prints VHDL files in a nice two-column landscape style.
:group 'vhdl-print)
(defcustom vhdl-print-customize-faces t
- "*Non-nil means use an optimized set of faces for PostScript printing.
+ "Non-nil means use an optimized set of faces for PostScript printing.
NOTE: Activate the new setting by restarting Emacs.
Overrides `ps-print' settings locally."
:group 'vhdl)
(defcustom vhdl-intelligent-tab t
- "*Non-nil means `TAB' does indentation, word completion and tab insertion.
+ "Non-nil means `TAB' does indentation, word completion and tab insertion.
That is, if preceding character is part of a word then complete word,
else if not at beginning of line then insert tab,
else if last command was a `TAB' or `RET' then dedent one step,
:group 'vhdl-misc)
(defcustom vhdl-indent-syntax-based t
- "*Non-nil means indent lines of code based on their syntactic context.
+ "Non-nil means indent lines of code based on their syntactic context.
Otherwise, a line is indented like the previous nonblank line. This can be
useful in large files where syntax-based indentation gets very slow."
:type 'boolean
:group 'vhdl-misc)
+(defcustom vhdl-indent-comment-like-next-code-line t
+ "*Non-nil means comment lines are indented like the following code line.
+Otherwise, comment lines are indented like the preceding code line.
+Indenting comment lines like the following code line gives nicer indentation
+when comments precede the code that they refer to."
+ :type 'boolean
+ :group 'vhdl-misc)
+
(defcustom vhdl-word-completion-case-sensitive nil
- "*Non-nil means word completion using `TAB' is case sensitive.
+ "Non-nil means word completion using `TAB' is case sensitive.
That is, `TAB' completes words that start with the same letters and case.
Otherwise, case is ignored."
:type 'boolean
:group 'vhdl-misc)
(defcustom vhdl-word-completion-in-minibuffer t
- "*Non-nil enables word completion in minibuffer (for template prompts).
+ "Non-nil enables word completion in minibuffer (for template prompts).
NOTE: Activate the new setting by restarting Emacs."
:type 'boolean
:group 'vhdl-misc)
(defcustom vhdl-underscore-is-part-of-word nil
- "*Non-nil means consider the underscore character `_' as part of word.
+ "Non-nil means consider the underscore character `_' as part of word.
An identifier containing underscores is then treated as a single word in
select and move operations. All parts of an identifier separated by underscore
are treated as single words otherwise.
(custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))
(custom-add-to-group 'vhdl-related 'ps-print 'custom-group)
(custom-add-to-group 'vhdl-related 'speedbar 'custom-group)
+(custom-add-to-group 'vhdl-related 'comment-style 'custom-variable)
(custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)
(unless (featurep 'xemacs)
(custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))
(custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable)
(custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Hidden user variables
+
+(defvar vhdl-compile-absolute-path nil
+ "If non-nil, use absolute instead of relative path for compiled files.")
+
+(defvar vhdl-comment-display-line-char ?-
+ "Character to use in comment display line.")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal variables
(defvar vhdl-menu-max-size 20
- "*Specifies the maximum size of a menu before splitting it into submenus.")
+ "Specifies the maximum size of a menu before splitting it into submenus.")
(defvar vhdl-progress-interval 1
- "*Interval used to update progress status during long operations.
+ "Interval used to update progress status during long operations.
If a number, percentage complete gets updated after each interval of
that many seconds. To inhibit all messages, set this option to nil.")
(defvar vhdl-inhibit-startup-warnings-p nil
- "*If non-nil, inhibits start up compatibility warnings.")
+ "If non-nil, inhibits start up compatibility warnings.")
(defvar vhdl-strict-syntax-p nil
- "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
+ "If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
If the syntactic symbol for a particular line does not match a symbol
in the offsets alist, an error is generated, otherwise no error is
reported and the syntactic symbol is ignored.")
(defvar vhdl-echo-syntactic-information-p nil
- "*If non-nil, syntactic info is echoed when the line is indented.")
+ "If non-nil, syntactic info is echoed when the line is indented.")
(defconst vhdl-offsets-alist-default
'((string . -1000)
more information.")
(defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)
- "*Association list of syntactic element symbols and indentation offsets.
+ "Association list of syntactic element symbols and indentation offsets.
As described below, each cons cell in this list has the form:
(SYNTACTIC-SYMBOL . OFFSET)
package-body -- inside a package body")
(defvar vhdl-comment-only-line-offset 0
- "*Extra offset for line which contains only the start of a comment.
+ "Extra offset for line which contains only the start of a comment.
Can contain an integer or a cons cell of the form:
(NON-ANCHORED-OFFSET . ANCHORED-OFFSET)
Just an integer as value is equivalent to (<val> . 0)")
(defvar vhdl-special-indent-hook nil
- "*Hook for user defined special indentation adjustments.
+ "Hook for user defined special indentation adjustments.
This hook gets called after a line is indented by the mode.")
(defvar vhdl-style-alist
(setq vhdl-style-alist (cons default vhdl-style-alist))))
(defvar vhdl-mode-hook nil
- "*Hook called by `vhdl-mode'.")
+ "Hook called by `vhdl-mode'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(list
(append
'("Package")
- (when (vhdl-standard-p 'math)
- '(["math_complex" vhdl-template-package-math-complex t]
- ["math_real" vhdl-template-package-math-real t]))
'(["numeric_bit" vhdl-template-package-numeric-bit t]
["numeric_std" vhdl-template-package-numeric-std t]
["std_logic_1164" vhdl-template-package-std-logic-1164 t]
["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t]
["std_logic_misc" vhdl-template-package-std-logic-misc t]
["std_logic_textio" vhdl-template-package-std-logic-textio t]
- "--"
- ["Insert Package..." vhdl-template-insert-package
+ "--")
+ (when (vhdl-standard-p 'ams)
+ '(["fundamental_constants" vhdl-template-package-fundamental-constants t]
+ ["material_constants" vhdl-template-package-material-constants t]
+ ["energy_systems" vhdl-template-package-energy-systems t]
+ ["electrical_systems" vhdl-template-package-electrical-systems t]
+ ["mechanical_systems" vhdl-template-package-mechanical-systems t]
+ ["radiant_systems" vhdl-template-package-radiant-systems t]
+ ["thermal_systems" vhdl-template-package-thermal-systems t]
+ ["fluidic_systems" vhdl-template-package-fluidic-systems t]
+ "--"))
+ (when (vhdl-standard-p 'math)
+ '(["math_complex" vhdl-template-package-math-complex t]
+ ["math_real" vhdl-template-package-math-real t]
+ "--"))
+ '(["Insert Package..." vhdl-template-insert-package
:keys "C-c C-i C-p"])))
'(("Directive"
["translate_on" vhdl-template-directive-translate-on t]
["Buffer" vhdl-beautify-buffer t])
("Fix"
["Generic/Port Clause" vhdl-fix-clause t]
+ ["Generic/Port Clause Buffer" vhdl-fix-clause t]
"--"
["Case Region" vhdl-fix-case-region (mark)]
["Case Buffer" vhdl-fix-case-buffer t]
("Mode"
["Electric Mode"
(progn (customize-set-variable 'vhdl-electric-mode
- (not vhdl-electric-mode)))
+ (not vhdl-electric-mode))
+ (vhdl-mode-line-update))
:style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"]
["Stutter Mode"
(progn (customize-set-variable 'vhdl-stutter-mode
- (not vhdl-stutter-mode)))
+ (not vhdl-stutter-mode))
+ (vhdl-mode-line-update))
:style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"]
["Indent Tabs Mode"
(progn (customize-set-variable 'vhdl-indent-tabs-mode
(customize-set-variable 'vhdl-compile-use-local-error-regexp
(not vhdl-compile-use-local-error-regexp))
:style toggle :selected vhdl-compile-use-local-error-regexp]
+ ["Makefile Default Targets..."
+ (customize-option 'vhdl-makefile-default-targets) t]
["Makefile Generation Hook..."
(customize-option 'vhdl-makefile-generation-hook) t]
["Default Library Name" (customize-option 'vhdl-default-library) t]
(list '87 (cadr vhdl-standard)))
(vhdl-activate-customizations))
:style radio :selected (eq '87 (car vhdl-standard))]
- ["VHDL'93"
+ ["VHDL'93/02"
(progn (customize-set-variable 'vhdl-standard
(list '93 (cadr vhdl-standard)))
(vhdl-activate-customizations))
["Always"
(customize-set-variable 'vhdl-use-direct-instantiation 'always)
:style radio :selected (eq 'always vhdl-use-direct-instantiation)])
+ ["Include Array Index and Record Field in Sensitivity List"
+ (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list
+ (not vhdl-array-index-record-field-in-sensitivity-list))
+ :style toggle :selected vhdl-array-index-record-field-in-sensitivity-list]
"--"
["Customize Group..." (customize-group 'vhdl-style) t])
("Naming"
:style radio :selected (eq 'sync vhdl-reset-kind)]
["Asynchronous"
(customize-set-variable 'vhdl-reset-kind 'async)
- :style radio :selected (eq 'async vhdl-reset-kind)])
+ :style radio :selected (eq 'async vhdl-reset-kind)]
+ ["Query"
+ (customize-set-variable 'vhdl-reset-kind 'query)
+ :style radio :selected (eq 'query vhdl-reset-kind)])
["Reset is Active High"
(customize-set-variable 'vhdl-reset-active-high
(not vhdl-reset-active-high))
(customize-set-variable 'vhdl-indent-syntax-based
(not vhdl-indent-syntax-based))
:style toggle :selected vhdl-indent-syntax-based]
+ ["Indent Comments Like Next Code Line"
+ (customize-set-variable 'vhdl-indent-comment-like-next-code-line
+ (not vhdl-indent-comment-like-next-code-line))
+ :style toggle :selected vhdl-indent-comment-like-next-code-line]
["Word Completion is Case Sensitive"
(customize-set-variable 'vhdl-word-completion-case-sensitive
(not vhdl-word-completion-case-sensitive))
"^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"
4)
("Instance"
- "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
+ "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
1)
("Component"
"^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
(set (make-local-variable 'imenu-generic-expression)
vhdl-imenu-generic-expression)
(when (and vhdl-index-menu (fboundp 'imenu))
- (if (or (not (boundp 'font-lock-maximum-size))
- (> font-lock-maximum-size (buffer-size)))
- (imenu-add-to-menubar "Index")
- (message "Scanning buffer for index...buffer too big"))))
+ (imenu-add-to-menubar "Index")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Source file menu (using `easy-menu.el')
brackets and removed if the queried string is left empty. Prompts for
mandatory arguments remain in the code if the queried string is left
empty. They can be queried again by `C-c C-t C-q'. Enabled
- electrification is indicated by `/e' in the modeline.
+ electrification is indicated by `/e' in the mode line.
Typing `M-SPC' after a keyword inserts a space without calling the
template generator. Automatic template generation (i.e.
Double striking of some keys inserts cumbersome VHDL syntax elements.
Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in
- the modeline. The stuttering keys and their effects are:
+ the mode line. The stuttering keys and their effects are:
;; --> \" : \" [ --> ( -- --> comment
;;; --> \" := \" [[ --> [ --CR --> comment-out code
with a comment in between.
`--CR' comments out code on that line. Re-hitting CR comments
out following lines.
- `C-c c' comments out a region if not commented out,
- uncomments a region if already commented out.
+ `C-c C-c' comments out a region if not commented out,
+ uncomments a region if already commented out. Option
+ `comment-style' defines where the comment characters
+ should be placed (beginning of line, indent, etc.).
You are prompted for comments after object definitions (i.e. signals,
variables, constants, ports) and after subprogram and process
`TAB' indents a line if at the beginning of the line. The amount of
indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l'
always indents the current line (is bound to `TAB' if option
- `vhdl-intelligent-tab' is nil).
+ `vhdl-intelligent-tab' is nil). If a region is active, `TAB' indents
+ the entire region.
Indentation can be done for a group of lines (`C-c C-i C-g'), a region
\(`M-C-\\') or the entire buffer (menu). Argument and port lists are
Syntax-based indentation can be very slow in large files. Option
`vhdl-indent-syntax-based' allows to use faster but simpler indentation.
+ Option `vhdl-indent-comment-like-next-code-line' controls whether
+ comment lines are indented like the preceding or like the following code
+ line.
+
ALIGNMENT:
The alignment functions align operators, keywords, and inline comments
STRUCTURAL COMPOSITION:
- Enables simple structural composition. `C-c C-c C-n' creates a skeleton
+ Enables simple structural composition. `C-c C-m C-n' creates a skeleton
for a new component. Subcomponents (i.e. component declaration and
instantiation) can be automatically placed from a previously read port
- \(`C-c C-c C-p') or directly from the hierarchy browser (`P'). Finally,
+ \(`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally,
all subcomponents can be automatically connected using internal signals
- and ports (`C-c C-c C-w') following these rules:
+ and ports (`C-c C-m C-w') following these rules:
- subcomponent actual ports with same name are considered to be
connected by a signal (internal signal or port)
- signals that are only inputs to subcomponents are considered as
Component declarations can be placed in a components package (option
`vhdl-use-components-package') which can be automatically generated for
- an entire directory or project (`C-c C-c M-p'). The VHDL'93 direct
+ an entire directory or project (`C-c C-m M-p'). The VHDL'93 direct
component instantiation is also supported (option
`vhdl-use-direct-instantiation').
-| Configuration declarations can automatically be generated either from
-| the menu (`C-c C-c C-f') (for the architecture the cursor is in) or from
-| the speedbar menu (for the architecture under the cursor). The
-| configurations can optionally be hierarchical (i.e. include all
-| component levels of a hierarchical design, option
-| `vhdl-compose-configuration-hierarchical') or include subconfigurations
-| (option `vhdl-compose-configuration-use-subconfiguration'). For
-| subcomponents in hierarchical configurations, the most-recently-analyzed
-| (mra) architecture is selected. If another architecture is desired, it
-| can be marked as most-recently-analyzed (speedbar menu) before
-| generating the configuration.
-|
-| Note: Configurations of subcomponents (i.e. hierarchical configuration
-| declarations) are currently not considered when displaying
-| configurations in speedbar.
+ Configuration declarations can automatically be generated either from
+ the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from
+ the speedbar menu (for the architecture under the cursor). The
+ configurations can optionally be hierarchical (i.e. include all
+ component levels of a hierarchical design, option
+ `vhdl-compose-configuration-hierarchical') or include subconfigurations
+ (option `vhdl-compose-configuration-use-subconfiguration'). For
+ subcomponents in hierarchical configurations, the most-recently-analyzed
+ (mra) architecture is selected. If another architecture is desired, it
+ can be marked as most-recently-analyzed (speedbar menu) before
+ generating the configuration.
+
+ Note: Configurations of subcomponents (i.e. hierarchical configuration
+ declarations) are currently not considered when displaying
+ configurations in speedbar.
See the options group `vhdl-compose' for all relevant user options.
The Makefile's default target \"all\" compiles the entire design, the
target \"clean\" removes it and the target \"library\" creates the
- library directory if not existent. The Makefile also includes a target
- for each primary library unit which allows selective compilation of this
- unit, its secondary units and its subhierarchy (example: compilation of
- a design specified by a configuration). User specific parts can be
- inserted into a Makefile with option `vhdl-makefile-generation-hook'.
+ library directory if not existent. These target names can be customized
+ by option `vhdl-makefile-default-targets'. The Makefile also includes a
+ target for each primary library unit which allows selective compilation
+ of this unit, its secondary units and its subhierarchy (example:
+ compilation of a design specified by a configuration). User specific
+ parts can be inserted into a Makefile with option
+ `vhdl-makefile-generation-hook'.
Limitations:
- Only library units and dependencies within the current library are
VHDL STANDARDS:
The VHDL standards to be used are specified in option `vhdl-standard'.
- Available standards are: VHDL'87/'93, VHDL-AMS, and Math Packages.
+ Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
KEYWORD CASE:
- Out parameters of procedures are considered to be read.
Use option `vhdl-entity-file-name' to specify the entity file name
\(used to obtain the port names).
+ Use option `vhdl-array-index-record-field-in-sensitivity-list' to
+ specify whether to include array indices and record fields in
+ sensitivity lists.
CODE FIXING:
to above mailing lists by sending an email to <reto@gnu.org>.
VHDL Mode is officially distributed at
-URL `http://opensource.ethz.ch/emacs/vhdl-mode.html'
+http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
where the latest version can be found.
Known problems:
---------------
-- Indentation bug in simultaneous if- and case-statements (VHDL-AMS).
- XEmacs: Incorrect start-up when automatically opening speedbar.
- XEmacs: Indentation in XEmacs 21.4 (and higher).
+- Indentation incorrect for new 'postponed' VHDL keyword.
+- Indentation incorrect for 'protected body' construct.
The VHDL Mode Authors
;;; Keywords and standardized words
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst vhdl-93-keywords
+(defconst vhdl-02-keywords
'(
"abs" "access" "after" "alias" "all" "and" "architecture" "array"
"assert" "attribute"
"map" "mod"
"nand" "new" "next" "nor" "not" "null"
"of" "on" "open" "or" "others" "out"
- "package" "port" "postponed" "procedure" "process" "pure"
+ "package" "port" "postponed" "procedure" "process" "protected" "pure"
"range" "record" "register" "reject" "rem" "report" "return"
"rol" "ror"
"select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype"
"wait" "when" "while" "with"
"xnor" "xor"
)
- "List of VHDL'93 keywords.")
+ "List of VHDL'02 keywords.")
(defconst vhdl-ams-keywords
'(
)
"List of Verilog keywords as candidate for additional reserved words.")
-(defconst vhdl-93-types
+(defconst vhdl-02-types
'(
"boolean" "bit" "bit_vector" "character" "severity_level" "integer"
"real" "time" "natural" "positive" "string" "line" "text" "side"
"std_logic" "std_logic_vector"
"std_ulogic" "std_ulogic_vector"
)
- "List of VHDL'93 standardized types.")
+ "List of VHDL'02 standardized types.")
(defconst vhdl-ams-types
+ ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004
'(
+ ;; package `standard'
"domain_type" "real_vector"
- ;; from `nature_pkg' package
- "voltage" "current" "electrical" "position" "velocity" "force"
- "mechanical_vf" "mechanical_pf" "rotvel" "torque" "rotational"
- "pressure" "flowrate" "fluid"
- )
+ ;; package `energy_systems'
+ "energy" "power" "periodicity" "real_across" "real_through" "unspecified"
+ "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector"
+ "real_across_vector" "real_through_vector"
+ ;; package `electrical_systems'
+ "voltage" "current" "charge" "resistance" "conductance" "capacitance"
+ "mmf" "electric_flux" "electric_flux_density" "electric_field_strength"
+ "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength"
+ "inductance" "reluctance" "electrical" "electrical_vector" "magnetic"
+ "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector"
+ "magnetic_flux_vector" "charge_vector" "resistance_vector"
+ "conductance_vector" "capacitance_vector" "electric_flux_vector"
+ "electric_flux_density_vector" "electric_field_strength_vector"
+ "magnetic_flux_density_vector" "magnetic_field_strength_vector"
+ "inductance_vector" "reluctance_vector" "ground"
+ ;; package `mechanical_systems'
+ "displacement" "force" "velocity" "acceleration" "mass" "stiffness"
+ "damping" "momentum" "angle" "torque" "angular_velocity"
+ "angular_acceleration" "moment_inertia" "angular_momentum"
+ "angular_stiffness" "angular_damping" "translational"
+ "translational_vector" "translational_velocity"
+ "translational_velocity_vector" "rotational" "rotational_vector"
+ "rotational_velocity" "rotational_velocity_vector" "displacement_vector"
+ "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector"
+ "torque_vector" "angular_velocity_vector" "torque_velocity_vector"
+ "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector"
+ "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector"
+ "angular_momentum_vector" "angular_stiffness_vector"
+ "angular_damping_vector" "anchor" "translational_v_ref"
+ "rotational_v_ref" "translational_v" "rotational_v"
+ ;; package `radiant_systems'
+ "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant"
+ "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector"
+ "illuminance_vector" "irradiance_vector"
+ ;; package `thermal_systems'
+ "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance"
+ "thermal_conductance" "thermal" "thermal_vector" "temperature_vector"
+ "heat_flow_vector" "thermal_capacitance_vector"
+ "thermal_resistance_vector" "thermal_conductance_vector"
+ ;; package `fluidic_systems'
+ "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity"
+ "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance"
+ "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector"
+ "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector"
+ "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector"
+ "density_vector" "viscosity_vector" "fresistance_vector"
+ "fconductance_vector" "fcapacitance_vector" "inertance_vector"
+ "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector"
+ "cfinertance_vector"
+ )
"List of VHDL-AMS standardized types.")
(defconst vhdl-math-types
'(
- "complex" "complex_polar"
+ "complex" "complex_polar" "positive_real" "principal_value"
)
"List of Math Packages standardized types.")
-(defconst vhdl-93-attributes
+(defconst vhdl-02-attributes
'(
"base" "left" "right" "high" "low" "pos" "val" "succ"
"pred" "leftof" "rightof" "range" "reverse_range"
"simple_name" "instance_name" "path_name"
"foreign"
)
- "List of VHDL'93 standardized attributes.")
+ "List of VHDL'02 standardized attributes.")
(defconst vhdl-ams-attributes
'(
)
"List of VHDL-AMS standardized attributes.")
-(defconst vhdl-93-enum-values
+(defconst vhdl-02-enum-values
'(
"true" "false"
"note" "warning" "error" "failure"
"fs" "ps" "ns" "us" "ms" "sec" "min" "hr"
"right" "left"
)
- "List of VHDL'93 standardized enumeration values.")
+ "List of VHDL'02 standardized enumeration values.")
(defconst vhdl-ams-enum-values
'(
)
"List of VHDL-AMS standardized enumeration values.")
+(defconst vhdl-ams-constants
+ ;; standard: IEEE Std 1076.1.1-2004
+ '(
+ ;; package `fundamental_constants'
+ "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok"
+ "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto"
+ "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega"
+ "giga" "tera" "peta" "exa" "zetta" "yotta" "deca"
+ ;; package `material_constants'
+ "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly"
+ "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2"
+ "ambient_temperature" "ambient_pressure" "ambient_illuminance"
+ )
+ "List of VHDL-AMS standardized constants.")
+
(defconst vhdl-math-constants
+ ;; standard: IEEE Std 1076.2-1996
'(
- "math_e" "math_1_over_e"
- "math_pi" "math_two_pi" "math_1_over_pi"
- "math_half_pi" "math_q_pi" "math_3_half_pi"
- "math_log_of_2" "math_log_of_10" "math_log2_of_e" "math_log10_of_e"
- "math_sqrt2" "math_sqrt1_2" "math_sqrt_pi"
- "math_deg_to_rad" "math_rad_to_deg"
- "cbase_1" "cbase_j" "czero"
+ "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi"
+ "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero"
+ "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e"
+ "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2"
+ "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2"
+ "math_sqrt_pi"
)
"List of Math Packages standardized constants.")
-(defconst vhdl-93-functions
+(defconst vhdl-02-functions
'(
"now" "resolved" "rising_edge" "falling_edge"
- "read" "readline" "write" "writeline" "endfile"
+ "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite"
+ "endfile"
"resize" "is_X" "std_match"
"shift_left" "shift_right" "rotate_left" "rotate_right"
"to_unsigned" "to_signed" "to_integer"
"shl" "shr" "ext" "sxt"
"deallocate"
)
- "List of VHDL'93 standardized functions.")
+ "List of VHDL'02 standardized functions.")
(defconst vhdl-ams-functions
'(
+ ;; package `standard'
"frequency"
)
"List of VHDL-AMS standardized functions.")
(defconst vhdl-math-functions
+ ;; standard: IEEE Std 1076.2-1996
'(
- "sign" "ceil" "floor" "round" "trunc" "fmax" "fmin" "uniform"
- "sqrt" "cbrt" "exp" "log"
- "sin" "cos" "tan" "arcsin" "arccos" "arctan"
- "sinh" "cosh" "tanh" "arcsinh" "arccosh" "arctanh"
- "cmplx" "complex_to_polar" "polar_to_complex" "arg" "conj"
+ "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg"
+ "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp"
+ "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex"
+ "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt"
+ "tan" "tanh" "trunc" "uniform"
)
"List of Math Packages standardized functions.")
-(defconst vhdl-93-packages
+(defconst vhdl-02-packages
'(
"std_logic_1164" "numeric_std" "numeric_bit"
"standard" "textio"
"std_logic_misc" "std_logic_textio"
"ieee" "std" "work"
)
- "List of VHDL'93 standardized packages and libraries.")
+ "List of VHDL'02 standardized packages and libraries.")
(defconst vhdl-ams-packages
'(
- ;; from `nature_pkg' package
- "nature_pkg"
+ "fundamental_constants" "material_constants" "energy_systems"
+ "electrical_systems" "mechanical_systems" "radiant_systems"
+ "thermal_systems" "fluidic_systems"
)
"List of VHDL-AMS standardized packages and libraries.")
(defvar vhdl-enum-values-regexp nil
"Regexp for VHDL standardized enumeration values.")
+(defvar vhdl-constants-regexp nil
+ "Regexp for VHDL standardized constants.")
+
(defvar vhdl-functions-regexp nil
"Regexp for VHDL standardized functions.")
(defvar vhdl-directive-keywords-regexp nil
"Regexp for compiler directive keywords.")
+(defun vhdl-upcase-list (condition list)
+ "Upcase all elements in LIST based on CONDITION."
+ (when condition
+ (let ((tmp-list list))
+ (while tmp-list
+ (setcar tmp-list (upcase (car tmp-list)))
+ (setq tmp-list (cdr tmp-list)))))
+ list)
+
(defun vhdl-words-init ()
"Initialize reserved words."
(setq vhdl-keywords
- (append vhdl-93-keywords
- (when (vhdl-standard-p 'ams) vhdl-ams-keywords)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords)
+ (append vhdl-02-keywords
+ (when (vhdl-standard-p 'ams) vhdl-ams-keywords))))
(setq vhdl-types
- (append vhdl-93-types
- (when (vhdl-standard-p 'ams) vhdl-ams-types)
- (when (vhdl-standard-p 'math) vhdl-math-types)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-types)
+ (append vhdl-02-types
+ (when (vhdl-standard-p 'ams) vhdl-ams-types)
+ (when (vhdl-standard-p 'math) vhdl-math-types))))
(setq vhdl-attributes
- (append vhdl-93-attributes
- (when (vhdl-standard-p 'ams) vhdl-ams-attributes)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes)
+ (append vhdl-02-attributes
+ (when (vhdl-standard-p 'ams) vhdl-ams-attributes))))
(setq vhdl-enum-values
- (append vhdl-93-enum-values
- (when (vhdl-standard-p 'ams) vhdl-ams-enum-values)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values)
+ (append vhdl-02-enum-values
+ (when (vhdl-standard-p 'ams) vhdl-ams-enum-values))))
(setq vhdl-constants
- (append (when (vhdl-standard-p 'math) vhdl-math-constants)))
+ (vhdl-upcase-list
+ (and vhdl-highlight-case-sensitive vhdl-upper-case-constants)
+ (append (when (vhdl-standard-p 'ams) vhdl-ams-constants)
+ (when (vhdl-standard-p 'math) vhdl-math-constants)
+ '(""))))
(setq vhdl-functions
- (append vhdl-93-functions
+ (append vhdl-02-functions
(when (vhdl-standard-p 'ams) vhdl-ams-functions)
(when (vhdl-standard-p 'math) vhdl-math-functions)))
(setq vhdl-packages
- (append vhdl-93-packages
+ (append vhdl-02-packages
(when (vhdl-standard-p 'ams) vhdl-ams-packages)
(when (vhdl-standard-p 'math) vhdl-math-packages)))
(setq vhdl-reserved-words
(concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>"))
(setq vhdl-enum-values-regexp
(concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>"))
+ (setq vhdl-constants-regexp
+ (concat "\\<\\(" (regexp-opt vhdl-constants) "\\)\\>"))
(setq vhdl-functions-regexp
(concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>"))
(setq vhdl-packages-regexp
class. Putting underscore in word class breaks forward word movement
behavior that users are familiar with.")
-(defconst vhdl-case-header-key "case[( \t\n][^;=>]+[) \t\n]is"
+(defconst vhdl-case-header-key "case[( \t\n\r\f][^;=>]+[) \t\n\r\f]is"
"Regexp describing a case statement header key.")
(defconst vhdl-label-key
"Check if point is in a string."
(eq (vhdl-in-literal) 'string))
+(defun vhdl-in-quote-p ()
+ "Check if point is in a quote ('x')."
+ (or (and (> (point) (point-min))
+ (< (1+ (point)) (point-max))
+ (= (char-before (point)) ?\')
+ (= (char-after (1+ (point))) ?\'))
+ (and (> (1- (point)) (point-min))
+ (< (point) (point-max))
+ (= (char-before (1- (point))) ?\')
+ (= (char-after (point)) ?\'))))
+
(defun vhdl-in-literal ()
"Determine if point is in a VHDL literal."
(save-excursion
((vhdl-beginning-of-macro) 'pound)
(t nil)))))
+(defun vhdl-in-extended-identifier-p ()
+ "Determine if point is inside extended identifier (delimited by '\')."
+ (save-match-data
+ (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t))
+ (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t)))))
+
(defun vhdl-forward-comment (&optional direction)
"Skip all comments (including whitespace). Skip backwards if DIRECTION is
negative, skip forward otherwise."
(if (and direction (< direction 0))
;; skip backwards
(progn
- (skip-chars-backward " \t\n")
+ (skip-chars-backward " \t\n\r\f")
(while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t)
(goto-char (match-beginning 3))
- (skip-chars-backward " \t\n")))
+ (skip-chars-backward " \t\n\r\f")))
;; skip forwards
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(while (looking-at "--.*")
(goto-char (match-end 0))
- (skip-chars-forward " \t\n"))))
+ (skip-chars-forward " \t\n\r\f"))))
;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
(unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
(defalias 'vhdl-forward-comment 'forward-comment))
+(defun vhdl-back-to-indentation ()
+ "Move point to the first non-whitespace character on this line."
+ (interactive)
+ (beginning-of-line 1)
+ (skip-syntax-forward " " (vhdl-point 'eol)))
+
+;; XEmacs hack: work around old `back-to-indentation' in XEmacs
+(when (featurep 'xemacs)
+ (defalias 'back-to-indentation 'vhdl-back-to-indentation))
+
;; This is the best we can do in Win-Emacs.
(defun vhdl-win-il (&optional lim)
"Determine if point is in a VHDL literal."
(and
(save-excursion
(forward-sexp)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(not (looking-at "is\\b[^_]")))
(save-excursion
(backward-sexp)
"is"))))
(defconst vhdl-begin-fwd-re
- "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b\\([^_]\\|\\'\\)"
+ "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)"
"A regular expression for searching forward that matches all known
\"begin\" keywords.")
(defconst vhdl-begin-bwd-re
- "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b[^_]"
+ "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]"
"A regular expression for searching backward that matches all known
\"begin\" keywords.")
(and (/= (following-char) ?\;)
(not (looking-at "is\\|begin\\|process\\|procedural\\|block")))))
t)
- ;; "begin", "then":
- ((looking-at "be\\|t")
+ ;; "begin", "then", "use":
+ ((looking-at "be\\|t\\|use")
t)
;; "else":
((and (looking-at "e")
;; make sure that the "else" isn't inside a
;; conditional signal assignment.
(save-excursion
- (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
+ (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
(or (eq (following-char) ?\;)
(eq (point) lim))))
t)
;; "block", "generate", "loop", "process", "procedural",
- ;; "units", "record":
- ((and (looking-at "bl\\|[glpur]")
+ ;; "units", "record", "protected body":
+ ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record")
(save-excursion
(backward-sexp)
(not (looking-at "end\\s-+\\w"))))
(cond
((looking-at "is\\|block\\|generate\\|process\\|procedural")
"begin")
- ((looking-at "then")
+ ((looking-at "then\\|use")
"<else>")
(t
"end")))
of an identifier that just happens to contain a \"begin\" keyword."
(save-excursion
(and (looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(/= (preceding-char) ?_)
(not (vhdl-in-literal))
(vhdl-begin-p lim)
(vhdl-beginning-of-statement-1 lim)
(vhdl-backward-skip-label lim)
(vhdl-first-word (point)))))))
- ;; "component", "units", "record":
- ((looking-at "[cur]")
+ ;; "component", "units", "record", "protected body":
+ ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record")
;; The first end found will close the block
(vector "end" nil))
;; "block", "process", "procedural":
(vhdl-backward-skip-label lim)
(vhdl-first-word (point))))))
;; "then":
- ((looking-at "t")
- (vector "elsif\\|else\\|end\\s-+if"
+ ((looking-at "t\\|use")
+ (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)"
(and (vhdl-last-word (point))
(or (vhdl-first-word (point))
(save-excursion
(vhdl-end-p lim))
(if (looking-at "el")
;; "else", "elsif":
- (vector "if\\|elsif" (vhdl-first-word (point)) "then" nil)
+ (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil)
;; "end ...":
(setq pos (point))
(forward-sexp)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(cond
;; "end if":
((looking-at "if\\b[^_]")
(vector "else\\|elsif\\|if"
(vhdl-first-word pos)
- "else\\|then" nil))
+ "else\\|then\\|use" nil))
;; "end component":
((looking-at "component\\b[^_]")
(vector (buffer-substring (match-beginning 1)
(match-end 1))
(vhdl-first-word pos)
nil nil))
- ;; "end units", "end record":
- ((looking-at "\\(units\\|record\\)\\b[^_]")
+ ;; "end units", "end record", "end protected":
+ ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]")
(vector (buffer-substring (match-beginning 1)
(match-end 1))
(vhdl-first-word pos)
(cond ((looking-at "block\\|process\\|procedural")
(if (save-excursion
(forward-sexp)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(= (following-char) ?\())
(forward-sexp 2)
(forward-sexp))
- (when (looking-at "[ \t\n]*is")
+ (when (looking-at "[ \t\n\r\f]*is")
(goto-char (match-end 0)))
(point))
((looking-at "component")
(forward-sexp 2)
- (when (looking-at "[ \t\n]*is")
+ (when (looking-at "[ \t\n\r\f]*is")
(goto-char (match-end 0)))
(point))
((looking-at "for")
(forward-sexp 2)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(while (looking-at "[,:(]")
(forward-sexp)
- (skip-chars-forward " \t\n"))
+ (skip-chars-forward " \t\n\r\f"))
(point))
(t nil)
)))
(defconst vhdl-trailer-re
- "\\b\\(is\\|then\\|generate\\|loop\\|record\\)\\b[^_]")
+ "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]")
(defconst vhdl-statement-fwd-re
- "\\b\\(if\\|for\\|while\\)\\b\\([^_]\\|\\'\\)"
+ "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)"
"A regular expression for searching forward that matches all known
\"statement\" keywords.")
(defconst vhdl-statement-bwd-re
- "\\b\\(if\\|for\\|while\\)\\b[^_]"
+ "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]"
"A regular expression for searching backward that matches all known
\"statement\" keywords.")
;; Make sure it's the start of a parameter specification.
(save-excursion
(forward-sexp 2)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(looking-at "in\\b[^_]"))
;; Make sure it's not an "end for".
(save-excursion
t)
))
-(defconst vhdl-case-alternative-re "when[( \t\n][^;=>]+=>"
+(defconst vhdl-case-alternative-re "when[( \t\n\r\f][^;=>]+=>"
"Regexp describing a case statement alternative key.")
(defun vhdl-case-alternative-p (&optional lim)
(cond
;; "begin" keyword:
((and (looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(/= (preceding-char) ?_)
(vhdl-begin-p lim))
(setq foundp 'begin))
(save-excursion
(while (> count 0)
;; skip whitespace
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
;; Check for an unbalanced "end" keyword
(if (and (looking-at vhdl-end-fwd-re)
(/= (preceding-char) ?_)
nil
(backward-sexp)
(if (and (looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion
+ (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(/= (preceding-char) ?_)
(not (vhdl-in-literal))
(vhdl-begin-p lim))
(re-search-forward vhdl-e-o-s-re))
(defconst vhdl-b-o-s-re
- (concat ";\\|\(\\|\)\\|\\bwhen\\b[^_]\\|"
+ (concat ";[^_]\\|\([^_]\\|\)[^_]\\|\\bwhen\\b[^_]\\|"
vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
(defun vhdl-beginning-of-statement-1 (&optional lim)
(while (and (not donep)
(not (bobp))
;; look backwards for a statement boundary
- (re-search-backward vhdl-b-o-s-re lim 'move))
+ (progn (forward-char) (re-search-backward vhdl-b-o-s-re lim 'move)))
(if (or (= (preceding-char) ?_)
(vhdl-in-literal))
(backward-char)
(vhdl-forward-syntactic-ws here)
(setq donep t))))
;; If we are looking at a semicolon, then stop
- ((eq (following-char) ?\;)
+ ((and (eq (following-char) ?\;) (not (vhdl-in-quote-p)))
(progn
(forward-char)
(vhdl-forward-syntactic-ws here)
(setq donep t)))
;; If we are looking at a "begin", then stop
((and (looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion
+ (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(/= (preceding-char) ?_)
(vhdl-begin-p nil))
;; If it's a leader "begin", then find the
(setq begin-after-ip (and
(not literal)
(looking-at vhdl-begin-fwd-re)
+ (or (not (looking-at "\\<use\\>"))
+ (save-excursion
+ (back-to-indentation)
+ (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
(vhdl-begin-p)))
(setq end-after-ip (and
(not literal)
((progn
(vhdl-backward-syntactic-ws lim)
(or (bobp)
- (= (preceding-char) ?\;)))
+ (and (= (preceding-char) ?\;)
+ (not (vhdl-in-quote-p)))))
(vhdl-add-syntax 'statement placeholder))
;; CASE 2D: we are looking at a top-level statement-cont
(t
(save-excursion
(vhdl-beginning-of-statement-1 containing-sexp)
(skip-chars-backward " \t(")
+ (while (and (= (preceding-char) ?\;)
+ (not (vhdl-in-quote-p)))
+ (vhdl-beginning-of-statement-1 containing-sexp)
+ (skip-chars-backward " \t("))
(<= (point) containing-sexp)))
(goto-char containing-sexp)
(vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi)))
(let* ((relpos (cdr langelem))
(assignp (save-excursion
(goto-char (vhdl-point 'boi))
- (and (re-search-forward "\\(<\\|:\\)="
+ (and (re-search-forward "\\(<\\|:\\|=\\)="
(vhdl-point 'eol) t)
(- (point) (vhdl-point 'boi)))))
(curcol (progn
foundp)
(while (and (not foundp)
(< (point) (vhdl-point 'eol)))
- (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move)
+ (re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol) 'move)
(if (vhdl-in-literal)
(forward-char)
(if (= (preceding-char) ?\()
(interactive)
(if (and (= (preceding-char) ? ) (vhdl-in-comment-p))
(indent-new-comment-line)
- (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
+ (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)
+ (not (vhdl-in-comment-p)))
(vhdl-fix-case-word -1))
(newline-and-indent)))
(interactive)
(let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context)))
(pos (- (point-max) (point)))
+ (is-comment nil)
(indent
(if syntax
;; indent syntax-based
(>= (vhdl-get-offset (car syntax)) comment-column))
;; special case: comments at or right of comment-column
(vhdl-get-offset (car syntax))
+ ;; align comments like following code line
+ (when vhdl-indent-comment-like-next-code-line
+ (save-excursion
+ (while (eq (caar syntax) 'comment)
+ (setq is-comment t)
+ (beginning-of-line 2)
+ (setq syntax (vhdl-get-syntactic-context)))))
+ (when is-comment
+ (setq syntax (cons (cons 'comment nil) syntax)))
(apply '+ (mapcar 'vhdl-get-offset syntax)))
;; indent like previous nonblank line
(save-excursion (beginning-of-line)
(shift-amt (- indent (current-indentation))))
(and vhdl-echo-syntactic-information-p
(message "syntax: %s, indent= %d" syntax indent))
- (unless (zerop shift-amt)
- (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
- (beginning-of-line)
- (indent-to indent))
+ (let ((has-formfeed
+ (save-excursion (beginning-of-line) (looking-at "\\s-*\f"))))
+ (when (or (not (zerop shift-amt)) has-formfeed)
+ (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
+ (beginning-of-line)
+ (when has-formfeed (insert "\f"))
+ (indent-to indent)))
(if (< (point) (vhdl-point 'boi))
(back-to-indentation)
;; If initial point was within line's indentation, position after
(vhdl-update-progress-info "Indenting" (vhdl-current-line))
shift-amt))
-(defun vhdl-indent-region (beg end column)
+(defun vhdl-indent-region (beg end &optional column)
"Indent region as VHDL code.
Adds progress reporting to `indent-region'."
(interactive "r\nP")
"Indent whole buffer as VHDL code.
Calls `indent-region' for whole buffer and adds progress reporting."
(interactive)
- (vhdl-indent-region (point-min) (point-max) nil))
+ (vhdl-indent-region (point-min) (point-max)))
(defun vhdl-indent-group ()
"Indent group of lines between empty lines."
(if (re-search-forward vhdl-align-group-separate nil t)
(point-marker)
(point-max-marker)))))
- (vhdl-indent-region beg end nil)))
+ (vhdl-indent-region beg end)))
(defun vhdl-indent-sexp (&optional endpos)
"Indent each line of the list starting just after point.
(defconst vhdl-align-alist
'(
;; after some keywords
- (vhdl-mode "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)[ \t]"
- "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)\\([ \t]+\\)" 2)
+ (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]"
+ "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2)
;; before ':'
(vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")
;; after direction specifications
(vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"
":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)
;; before "==", ":=", "=>", and "<="
- (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "<= ... =>" can occur
+ (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur
(vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
- (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "=> ... <=" can occur
+ (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur
;; before some keywords
(vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)
(vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)
(vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)
+ (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1)
+ (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1)
;; before "=>" since "when/else ... =>" can occur
(vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
)
(forward-list)
(setq end (point))
(goto-char (1+ beg))
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n\r\f")
(setq beg (point))))
;; run FUNCTION
(if beg
bol (setq begin (progn (beginning-of-line) (point))))
(while (< bol end)
(save-excursion
- (when (and (re-search-forward match eol t)
- (not (vhdl-in-literal)))
+ (when (and (vhdl-re-search-forward match eol t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (forward-char)
+ (and (not (vhdl-in-literal))
+ (not (vhdl-in-quote-p))
+ (not (vhdl-in-extended-identifier-p))))
+ (not (looking-at "\\s-*$")))
(setq distance (- (match-beginning substr) bol))
(when (> distance max)
(setq max distance))))
(goto-char (setq bol begin))
(setq eol (point-at-eol))
(while (> lines 0)
- (when (and (re-search-forward match eol t)
- (not (vhdl-in-literal)))
+ (when (and (vhdl-re-search-forward match eol t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (forward-char)
+ (and (not (vhdl-in-literal))
+ (not (vhdl-in-quote-p))
+ (not (vhdl-in-extended-identifier-p))))
+ (not (looking-at "\\s-*$"))
+ (> (match-beginning 0) ; not if at boi
+ (save-excursion (back-to-indentation) (point))))
(setq width (- (match-end substr) (match-beginning substr)))
(setq distance (- (match-beginning substr) bol))
(goto-char (match-beginning substr))
;; search for comment start positions and lengths
(while (< (point) end)
(when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
- (looking-at "^\\(.*[^ \t\n-]+\\)\\s-*\\(--.*\\)$")
+ (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$")
(not (save-excursion (goto-char (match-beginning 2))
(vhdl-in-literal))))
(setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
(while (< (point) end)
(setq cur-start nil)
(when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
- (or (and (looking-at "^\\(.*[^ \t\n-]+\\)\\(\\s-*\\)\\(--.*\\)$")
+ (or (and (looking-at "^\\(.*[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$")
(not (save-excursion
(goto-char (match-beginning 3))
(vhdl-in-literal))))
(setq end (point-marker))
;; have no space before and one space after `,' and ';'
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
(if (match-string 1)
(goto-char (match-end 1))
- (replace-match "\\3 " nil nil nil 3)))
+ (replace-match "\\3 " nil nil nil 2)))
;; have no space after `('
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\((\\)\\s-+" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\2")))
;; have no space before `)'
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\2")))
;; surround operator symbols by one space
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\([^/:<>=]\\)\\(:\\|=\\|<\\|>\\|:=\\|<=\\|>=\\|=>\\|/=\\)\\([^=>]\\|$\\)\\)" end t)
- (if (match-string 1)
- (goto-char (match-end 1))
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>]\\|$\\)\\)" end t)
+ (if (or (match-string 1)
+ (<= (match-beginning 0) ; not if at boi
+ (save-excursion (back-to-indentation) (point))))
+ (goto-char (match-end 0))
(replace-match "\\3 \\4 \\5")
(goto-char (match-end 2))))
;; eliminate multiple spaces and spaces at end of line
(goto-char beg)
(while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t))
+ (and (looking-at "--.*") (re-search-forward "--.*" end t))
(and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t))
(and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t)
(progn (replace-match "" nil nil) t))
(progn (replace-match " " nil nil) t))
(and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
(progn (replace-match " " nil nil) t))
+ (and (looking-at "-") (re-search-forward "-" end t))
; (re-search-forward "[^ \t-]+" end t))))
(re-search-forward "[^ \t\"-]+" end t))))
(unless no-message (message "Fixing up whitespace...done")))
`vhdl-fix-case-buffer'."
(interactive "r")
(setq end (save-excursion (goto-char end) (point-marker)))
- (vhdl-indent-region beg end nil)
+ (vhdl-indent-region beg end)
(let ((vhdl-align-groups t))
(vhdl-align-region beg end))
(vhdl-fix-case-region beg end))
(vhdl-prepare-search-2
(end-of-line)
;; look whether in process
- (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
+ (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
(equal (upcase (match-string 2)) "PROCESS")
(save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t))))
(error "ERROR: Not within a process")
(vhdl-prepare-search-2
(goto-char (point-min))
(message "Updating sensitivity lists...")
- (while (re-search-forward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?process\\>" nil t)
+ (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t)
(goto-char (match-beginning 0))
(condition-case nil (vhdl-update-sensitivity-list) (error "")))
(message "Updating sensitivity lists...done"))))
"Update sensitivity list."
(let ((proc-beg (point))
(proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
- (proc-mid (re-search-backward "^\\s-*begin\\>" nil t))
+ (proc-mid (vhdl-re-search-backward
+ "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t))
seq-region-list)
(cond
+ ;; error if 'begin' keyword missing
+ ((not (match-string 2))
+ (error "ERROR: No 'begin' keyword found"))
;; search for wait statement (no sensitivity list allowed)
((progn (goto-char proc-mid)
(vhdl-re-search-forward "\\<wait\\>" proc-end t))
;; case expression
((re-search-forward "^\\s-*case\\>" proc-end t)
(re-search-forward "\\<is\\>" proc-end t))
- ;; parameter list of procedure call
- ((and (re-search-forward "^\\s-*\\w+[ \t\n]*(" proc-end t)
+ ;; parameter list of procedure call, array index
+ ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t)
(1- (point)))
(progn (backward-char) (forward-sexp)
(while (looking-at "(") (forward-sexp)) (point)))))
- name read-list sens-list signal-list
+ name field read-list sens-list signal-list
sens-beg sens-end beg end margin)
;; scan for signals in old sensitivity list
(goto-char proc-beg)
(re-search-forward "\\<process\\>" proc-mid t)
- (if (not (looking-at "[ \t\n]*("))
+ (if (not (looking-at "[ \t\n\r\f]*("))
(setq sens-beg (point))
- (setq sens-beg (re-search-forward "\\([ \t\n]*\\)([ \t\n]*" nil t))
+ (setq sens-beg (re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t))
(goto-char (match-end 1))
(forward-sexp)
(setq sens-end (1- (point)))
(< (point) (caar tmp-list)))
(setq tmp-list (cdr tmp-list)))
(and tmp-list (< (point) (cdar tmp-list))))))
- (while (vhdl-re-search-forward "[^'\"]\\<\\([a-zA-Z]\\w*\\)\\>[ \t\n]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t)
+ (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t)
(setq name (match-string 1))
- (when (and (not (match-string 4)) ; not when formal parameter
- (not (and (match-string 3) ; not event attribute
- (not (member (downcase (match-string 3))
+ (when vhdl-array-index-record-field-in-sensitivity-list
+ (setq field (match-string 2)))
+ (when (and (not (match-string 6)) ; not when formal parameter
+ (not (and (match-string 5) ; not event attribute
+ (not (member (downcase (match-string 5))
'("event" "last_event" "transaction")))))
(member (downcase name) signal-list))
- (unless (member-ignore-case name read-list)
- (setq read-list (cons name read-list))))
+ (unless (member-ignore-case (concat name field) read-list)
+ (setq read-list (cons (concat name field) read-list))))
(goto-char (match-end 1)))))
(setq scan-regions-list (cdr scan-regions-list)))
;; update sensitivity list
(goto-char (point-min))
(if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
(error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name)
- (when (setq beg (re-search-forward
- "^\\s-*port[ \t\n]*("
+ (when (setq beg (vhdl-re-search-forward
+ "\\<port[ \t\n\r\f]*("
(save-excursion
(re-search-forward "^end\\>" nil t)) t))
(setq end (save-excursion
(backward-char) (forward-sexp) (point)))
(vhdl-forward-syntactic-ws)
(while (< (point) end)
- (when (looking-at "signal[ \t\n]+")
+ (when (looking-at "signal[ \t\n\r\f]+")
(goto-char (match-end 0)))
- (while (looking-at "\\(\\w+\\)[ \t\n,]+")
+ (while (looking-at "\\(\\w+\\)[ \t\n\r\f,]+")
(setq signal-list
(cons (downcase (match-string 1)) signal-list))
(goto-char (match-end 0))
(when (= 0 (nth 0 (parse-partial-sexp beg (point))))
(if (match-string 2)
;; scan signal name
- (while (looking-at "[ \t\n,]+\\(\\w+\\)")
+ (while (looking-at "[ \t\n\r\f,]+\\(\\w+\\)")
(setq signal-list
(cons (downcase (match-string 1)) signal-list))
(goto-char (match-end 0)))
;; scan alias name, check is alias of (declared) signal
- (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)")
+ (when (and (looking-at "[ \t\n\r\f]+\\(\\w+\\)[^;]*\\<is[ \t\n\r\f]+\\(\\w+\\)")
(member (downcase (match-string 2)) signal-list))
(setq signal-list
(cons (downcase (match-string 1)) signal-list))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Generic/port clause fixing
+(defun vhdl-fix-clause-buffer ()
+ "Fix all generic/port clauses in current buffer."
+ (interactive)
+ (save-excursion
+ (vhdl-prepare-search-2
+ (goto-char (point-min))
+ (message "Fixing generic/port clauses...")
+ (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t)
+ (goto-char (match-end 0))
+ (condition-case nil (vhdl-fix-clause) (error "")))
+ (message "Fixing generic/port clauses...done"))))
+
(defun vhdl-fix-clause ()
"Fix closing parenthesis within generic/port clause."
(interactive)
(vhdl-prepare-search-2
(let ((pos (point))
beg end)
- (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n]*(" nil t))
+ (end-of-line)
+ (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t))
(error "ERROR: Not within a generic/port clause")
;; search for end of clause
(goto-char (match-end 0))
(setq beg (1- (point)))
(vhdl-forward-syntactic-ws)
- (while (looking-at "\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*[ \t\n]*:[ \t\n]*\\w+[^;]*;")
+ (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;")
(goto-char (1- (match-end 0)))
(setq end (point-marker))
(forward-char)
(let ((margin (current-indentation))
(start (point))
label)
- (unless kind (setq kind (if (vhdl-sequential-statement-p) 'is 'use)))
+ (unless kind (setq kind (if (or (vhdl-sequential-statement-p)
+ (not (vhdl-standard-p 'ams))) 'is 'use)))
(if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
(vhdl-insert-keyword "CASE ")
(vhdl-insert-keyword ": CASE ")
(vhdl-insert-keyword
(concat " " (if (eq kind 'then) "THEN" "USE") "\n\n"))
(indent-to margin)
- (vhdl-insert-keyword "END IF")
+ (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE")))
(when label (insert " " label))
(insert ";")
(forward-line -1)
(interactive)
(let ((margin (current-indentation))
(start (point))
+ (reset-kind vhdl-reset-kind)
label seq input-signals clock reset final-pos)
(setq seq (if kind (eq kind 'seq)
(eq (vhdl-decision-query
(setq clock (or (and (not (equal "" vhdl-clock-name))
(progn (insert vhdl-clock-name) vhdl-clock-name))
(vhdl-template-field "clock name") "<clock>"))
- (when (eq vhdl-reset-kind 'async)
+ (when (eq reset-kind 'query)
+ (setq reset-kind
+ (if (eq (vhdl-decision-query
+ "" "(a)synchronous or (s)ynchronous reset?" t) ?a)
+ 'async
+ 'sync)))
+ (when (eq reset-kind 'async)
(insert ", ")
(setq reset (or (and (not (equal "" vhdl-reset-name))
(progn (insert vhdl-reset-name) vhdl-reset-name))
(unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
(insert "\n")
(vhdl-template-begin-end "PROCESS" label margin)
- (when seq (setq reset (vhdl-template-seq-process clock reset)))
+ (when seq (setq reset (vhdl-template-seq-process clock reset reset-kind)))
(when vhdl-prompt-for-comments
(setq final-pos (point-marker))
(vhdl-prepare-search-2
(in-arglist (vhdl-in-argument-list-p)))
(vhdl-prepare-search-2
(if (or (save-excursion
- (and (vhdl-re-search-backward
- "\\<function\\|procedure\\|process\\|procedural\\|end\\>"
- nil t)
- (not (progn (backward-word 1) (looking-at "\\<end\\>")))))
+ (progn (vhdl-beginning-of-block)
+ (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>")))
(save-excursion (backward-word 1) (looking-at "\\<shared\\>")))
(vhdl-insert-keyword "VARIABLE ")
- (vhdl-insert-keyword "SHARED VARIABLE ")))
+ (if (vhdl-standard-p '87)
+ (error "ERROR: Not within sequential block")
+ (vhdl-insert-keyword "SHARED VARIABLE "))))
(when (vhdl-template-field "names" nil t start (point))
(insert " : ")
(when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
(concat (if vhdl-clock-rising-edge "rising" "falling")
" clock edge")))))
-(defun vhdl-template-seq-process (clock reset)
+(defun vhdl-template-seq-process (clock reset reset-kind)
"Insert a template for the body of a sequential process."
(let ((margin (current-indentation))
position)
(vhdl-insert-keyword "IF ")
- (when (eq vhdl-reset-kind 'async)
+ (when vhdl-conditions-in-parenthesis (insert "("))
+ (when (eq reset-kind 'async)
(insert reset " = "
(if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
+ (when vhdl-conditions-in-parenthesis (insert ")"))
(vhdl-insert-keyword " THEN")
(vhdl-comment-insert-inline
(concat "asynchronous reset (active "
(insert "\n") (indent-to (+ margin vhdl-basic-offset))
(setq position (point))
(insert "\n") (indent-to margin)
- (vhdl-insert-keyword "ELSIF "))
+ (vhdl-insert-keyword "ELSIF ")
+ (when vhdl-conditions-in-parenthesis (insert "(")))
(if (eq vhdl-clock-edge-condition 'function)
(insert (if vhdl-clock-rising-edge "rising" "falling")
"_edge(" clock ")")
(vhdl-insert-keyword " AND ")
(insert clock " = "
(if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string)))
+ (when vhdl-conditions-in-parenthesis (insert ")"))
(vhdl-insert-keyword " THEN")
(vhdl-comment-insert-inline
(concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge"))
(insert "\n") (indent-to (+ margin vhdl-basic-offset))
- (when (eq vhdl-reset-kind 'sync)
+ (when (eq reset-kind 'sync)
(vhdl-insert-keyword "IF ")
+ (when vhdl-conditions-in-parenthesis (insert "("))
(setq reset (or (and (not (equal "" vhdl-reset-name))
(progn (insert vhdl-reset-name) vhdl-reset-name))
(vhdl-template-field "reset name") "<reset>"))
(insert " = "
(if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
+ (when vhdl-conditions-in-parenthesis (insert ")"))
(vhdl-insert-keyword " THEN")
(vhdl-comment-insert-inline
(concat "synchronous reset (active "
(insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
(insert "\n") (indent-to (+ margin vhdl-basic-offset))
(vhdl-insert-keyword "END IF;"))
- (when (eq vhdl-reset-kind 'none)
+ (when (eq reset-kind 'none)
(setq position (point)))
(insert "\n") (indent-to margin)
(vhdl-insert-keyword "END IF;")
(insert library ";")
(when package
(insert "\n")
- (indent-to margin)))
- (when package
- (vhdl-insert-keyword "USE ")
- (insert library "." package)
- (vhdl-insert-keyword ".ALL;")))))
-
-(defun vhdl-template-package-math-complex ()
- "Insert specification of `math_complex' package."
- (interactive)
- (vhdl-template-standard-package "ieee" "math_complex"))
-
-(defun vhdl-template-package-math-real ()
- "Insert specification of `math_real' package."
- (interactive)
- (vhdl-template-standard-package "ieee" "math_real"))
+ (indent-to margin))))
+ (when package
+ (vhdl-insert-keyword "USE ")
+ (insert library "." package)
+ (vhdl-insert-keyword ".ALL;"))))
(defun vhdl-template-package-numeric-bit ()
"Insert specification of `numeric_bit' package."
(interactive)
(vhdl-template-standard-package "std" "textio"))
+(defun vhdl-template-package-fundamental-constants ()
+ "Insert specification of `fundamental_constants' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "fundamental_constants"))
+
+(defun vhdl-template-package-material-constants ()
+ "Insert specification of `material_constants' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "material_constants"))
+
+(defun vhdl-template-package-energy-systems ()
+ "Insert specification of `energy_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "energy_systems"))
+
+(defun vhdl-template-package-electrical-systems ()
+ "Insert specification of `electrical_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "electrical_systems"))
+
+(defun vhdl-template-package-mechanical-systems ()
+ "Insert specification of `mechanical_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "mechanical_systems"))
+
+(defun vhdl-template-package-radiant-systems ()
+ "Insert specification of `radiant_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "radiant_systems"))
+
+(defun vhdl-template-package-thermal-systems ()
+ "Insert specification of `thermal_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "thermal_systems"))
+
+(defun vhdl-template-package-fluidic-systems ()
+ "Insert specification of `fluidic_systems' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "fluidic_systems"))
+
+(defun vhdl-template-package-math-complex ()
+ "Insert specification of `math_complex' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "math_complex"))
+
+(defun vhdl-template-package-math-real ()
+ "Insert specification of `math_real' package."
+ (interactive)
+ (vhdl-template-standard-package "ieee" "math_real"))
+
(defun vhdl-template-directive (directive)
"Insert directive."
(unless (= (current-indentation) (current-column))
(insert (user-full-name))
(when user-mail-address (insert " <" user-mail-address ">")))
(goto-char beg)
+ (while (search-forward "<authorfull>" end t)
+ (replace-match (user-full-name) t t))
+ (goto-char beg)
(while (search-forward "<login>" end t)
(replace-match (user-login-name) t t))
(goto-char beg)
(while (search-forward "<standard>" end t)
(replace-match
(concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
- ((vhdl-standard-p '93) "'93"))
+ ((vhdl-standard-p '93) "'93/02"))
(when (vhdl-standard-p 'ams) ", VHDL-AMS")
(when (vhdl-standard-p 'math) ", Math Packages")) t t))
(goto-char beg)
"Displays one line of dashes."
(interactive)
(while (= (preceding-char) ?-) (delete-char -2))
+ (insert "--")
(let* ((col (current-column))
(len (- end-comment-column col)))
- (insert-char ?- len)))
+ (insert-char vhdl-comment-display-line-char len)))
(defun vhdl-comment-append-inline ()
"Append empty inline comment to current line."
(goto-char beg)
(beginning-of-line)
(setq beg (point))
- (if (looking-at comment-start)
+ (if (looking-at (concat "\\s-*" comment-start))
(comment-region beg end '(4))
(comment-region beg end))))
(goto-char beg)
(beginning-of-line)
(while (< (point) end)
- (when (looking-at "^.*[^ \t\n-]+\\(\\s-*--.*\\)$")
+ (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$")
(delete-region (match-beginning 1) (match-end 1)))
(beginning-of-line 2))))
(self-insert-command count)
(cond ((>= (current-column) (+ 2 end-comment-column))
(backward-char 1)
- (skip-chars-backward "^ \t\n")
+ (skip-chars-backward "^ \t\n\r\f")
(indent-new-comment-line)
- (skip-chars-forward "^ \t\n")
+ (skip-chars-forward "^ \t\n\r\f")
(forward-char 1))
((>= (current-column) end-comment-column)
(indent-new-comment-line))
(vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes
(concat "'" vhdl-attributes-regexp))
(vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values
- vhdl-enum-values-regexp))
+ vhdl-enum-values-regexp)
+ (vhdl-fix-case-region-1 position (point) vhdl-upper-case-constants
+ vhdl-constants-regexp))
(when (or (not (equal string "")) (not optional))
(insert (or follow-string "")))
(if (equal string "") nil string)))
(defun vhdl-beginning-of-block ()
"Move cursor to the beginning of the enclosing block."
(let (pos)
- (save-excursion
- (beginning-of-line)
- ;; search backward for block beginning or end
- (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
- ;; not consider subprogram declarations
- (or (and (match-string 5)
- (save-match-data
- (save-excursion
- (goto-char (match-end 5))
- (forward-word 1)
- (vhdl-forward-syntactic-ws)
- (when (looking-at "(")
- (forward-sexp))
- (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
- (match-string 1)))
- ;; not consider configuration specifications
- (and (match-string 6)
- (save-match-data
- (save-excursion
- (vhdl-end-of-block)
- (beginning-of-line)
- (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
- (match-string 2))
- ;; skip subblock if block end found
- (vhdl-beginning-of-block)))
+ (vhdl-prepare-search-2
+ (save-excursion
+ (beginning-of-line)
+ ;; search backward for block beginning or end
+ (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
+ ;; not consider subprogram declarations
+ (or (and (match-string 5)
+ (save-match-data
+ (save-excursion
+ (goto-char (match-end 5))
+ (forward-word 1)
+ (vhdl-forward-syntactic-ws)
+ (when (looking-at "(")
+ (forward-sexp))
+ (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
+ (match-string 1)))
+ ;; not consider configuration specifications
+ (and (match-string 6)
+ (save-match-data
+ (save-excursion
+ (vhdl-end-of-block)
+ (beginning-of-line)
+ (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
+ (match-string 2))
+ ;; skip subblock if block end found
+ (vhdl-beginning-of-block))))
(when pos (goto-char pos))))
(defun vhdl-end-of-block ()
"Move cursor to the end of the enclosing block."
(let (pos)
- (save-excursion
- (end-of-line)
- ;; search forward for block beginning or end
- (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
- ;; not consider subprogram declarations
- (or (and (match-string 5)
- (save-match-data
- (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
- (match-string 1)))
- ;; not consider configuration specifications
- (and (match-string 6)
- (save-match-data
- (save-excursion
- (vhdl-end-of-block)
- (beginning-of-line)
- (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
- (not (match-string 2)))
- ;; skip subblock if block beginning found
- (vhdl-end-of-block)))
+ (vhdl-prepare-search-2
+ (save-excursion
+ (end-of-line)
+ ;; search forward for block beginning or end
+ (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
+ ;; not consider subprogram declarations
+ (or (and (match-string 5)
+ (save-match-data
+ (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
+ (match-string 1)))
+ ;; not consider configuration specifications
+ (and (match-string 6)
+ (save-match-data
+ (save-excursion
+ (vhdl-end-of-block)
+ (beginning-of-line)
+ (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
+ (not (match-string 2)))
+ ;; skip subblock if block beginning found
+ (vhdl-end-of-block))))
(when pos (goto-char pos))))
(defun vhdl-sequential-statement-p ()
(< start (point)))
;; ... a sequential block
(progn (vhdl-beginning-of-block)
- (looking-at "^\\s-*\\(\\(\\w+[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(\\w+[ \t\n]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
+ (looking-at "^\\s-*\\(\\(\\w+[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(\\w+[ \t\n\r\f]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
(defun vhdl-in-argument-list-p ()
"Check if within an argument list."
(progn
(insert " ")
(unexpand-abbrev)
- (delete-char -1))
+ (backward-word 1)
+ (vhdl-case-word 1)
+ (delete-char 1))
(if (not vhdl-electric-mode)
(progn
(insert " ")
(defun vhdl-parse-string (string &optional optional)
"Check that the text following point matches the regexp in STRING."
(if (looking-at string)
- (goto-char (match-end 0))
+ (progn (goto-char (match-end 0))
+ (when (vhdl-in-literal)
+ (end-of-line))
+ (point))
(unless optional
(throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\""
(vhdl-current-line) string)))
port-dir (car port-dir-car))
(setcar port-dir-car
(cond ((equal port-dir "in") "out")
+ ((equal port-dir "IN") "OUT")
((equal port-dir "out") "in")
+ ((equal port-dir "OUT") "IN")
(t port-dir)))
(setq port-list (cdr port-list)))
(setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction))
(message "Reading port of %s \"%s\"..." decl-type name)
(vhdl-forward-syntactic-ws)
;; parse generic clause
- (when (vhdl-parse-string "generic[ \t\n]*(" t)
+ (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t)
;; parse group comment and spacing
(setq group-comment (vhdl-parse-group-comment))
- (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
+ (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
(while (not end-of-list)
;; parse names (accept extended identifiers)
- (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
+ (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
(setq names (list (match-string-no-properties 1)))
- (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t)
+ (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
(setq names
(append names (list (match-string-no-properties 1)))))
;; parse type
- (vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)")
+ (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)")
(setq type (match-string-no-properties 1))
+ (when (vhdl-in-comment-p) ; if stuck in comment
+ (setq type (concat type (and (vhdl-parse-string ".*")
+ (match-string-no-properties 0)))))
(setq comment nil)
(while (looking-at "(")
(setq type
(setq type (substring type 0 (match-end 1)))
;; parse initialization expression
(setq init nil)
- (when (vhdl-parse-string ":=[ \t\n]*" t)
+ (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
(vhdl-parse-string "\\([^();\n]*\\)")
(setq init (match-string-no-properties 1))
(while (looking-at "(")
;; parse group comment and spacing
(setq group-comment (vhdl-parse-group-comment))))
;; parse port clause
- (when (vhdl-parse-string "port[ \t\n]*(" t)
+ (when (vhdl-parse-string "port[ \t\n\r\f]*(" t)
;; parse group comment and spacing
(setq group-comment (vhdl-parse-group-comment))
- (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
+ (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
(while (not end-of-list)
;; parse object
(setq object
- (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n]*" t)
+ (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t)
(match-string-no-properties 1)))
;; parse names (accept extended identifiers)
- (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
+ (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
(setq names (list (match-string-no-properties 1)))
- (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
+ (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
(setq names (append names (list (match-string-no-properties 1)))))
;; parse direction
- (vhdl-parse-string ":[ \t\n]*")
+ (vhdl-parse-string ":[ \t\n\r\f]*")
(setq direct
- (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n]+" t)
+ (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t)
(match-string-no-properties 1)))
;; parse type
(vhdl-parse-string "\\([^();\n]+\\)")
(setq type (match-string-no-properties 1))
+ (when (vhdl-in-comment-p) ; if stuck in comment
+ (setq type (concat type (and (vhdl-parse-string ".*")
+ (match-string-no-properties 0)))))
(setq comment nil)
(while (looking-at "(")
(setq type (concat type
(setq port-list (cdr port-list))
(insert (if port-list "," ");"))
;; paste comment
- (when (or vhdl-include-direction-comments
+ (when (or (and vhdl-include-direction-comments (nth 2 port))
vhdl-include-type-comments
(and vhdl-include-port-comments (nth 4 port)))
(vhdl-comment-insert-inline
;; paste type
(insert " : " (nth 3 port))
;; paste initialization (inputs only)
- (when (and initialize (equal "IN" (upcase (nth 2 port))))
- (insert " := " (if (string-match "(.+)" (nth 3 port))
- "(others => '0')" "'0'")))
+ (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port))))
+ (insert " := "
+ (cond ((string-match "integer" (nth 3 port)) "0")
+ ((string-match "natural" (nth 3 port)) "0")
+ ((string-match "positive" (nth 3 port)) "0")
+ ((string-match "real" (nth 3 port)) "0.0")
+ ((string-match "(.+)" (nth 3 port)) "(others => '0')")
+ (t "'0'"))))
(insert ";")
;; paste comment
- (when (or vhdl-include-direction-comments
+ (when (or (and vhdl-include-direction-comments (nth 2 port))
(and vhdl-include-port-comments (nth 4 port)))
(vhdl-comment-insert-inline
(concat
(setq name (car (nth 0 port)))
(insert (vhdl-replace-string vhdl-actual-port-name name))
;; paste initialization
- (insert " <= " (if (string-match "(.+)" (nth 3 port))
- "(others => '0')" "'0'") ";"))
+ (insert " <= "
+ (cond ((string-match "integer" (nth 3 port)) "0")
+ ((string-match "natural" (nth 3 port)) "0")
+ ((string-match "positive" (nth 3 port)) "0")
+ ((string-match "real" (nth 3 port)) "0.0")
+ ((string-match "(.+)" (nth 3 port)) "(others => '0')")
+ (t "'0'"))
+ ";"))
(setq port-list (cdr port-list))
(when (and port-list
(equal "IN" (upcase (nth 2 (car port-list)))))
;; paste custom declarations
(unless (equal "" vhdl-testbench-declarations)
(insert "\n")
- (vhdl-insert-string-or-file vhdl-testbench-declarations))
+ (setq position (point))
+ (vhdl-insert-string-or-file vhdl-testbench-declarations)
+ (vhdl-indent-region position (point)))
(setq position (point))
(insert "\n\n")
(vhdl-comment-display-line) (insert "\n")
;; paste custom statements
(unless (equal "" vhdl-testbench-statements)
(insert "\n")
- (vhdl-insert-string-or-file vhdl-testbench-statements))
+ (setq position (point))
+ (vhdl-insert-string-or-file vhdl-testbench-statements)
+ (vhdl-indent-region position (point)))
(insert "\n")
(indent-to vhdl-basic-offset)
(unless (eq vhdl-testbench-create-files 'none)
;; check if within function declaration
(setq pos (point))
(end-of-line)
- (when (looking-at "[ \t\n]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
- (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
+ (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
+ (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
(goto-char (match-end 0))
(save-excursion (backward-char)
(forward-sexp)
;; parse parameter list
(setq group-comment (vhdl-parse-group-comment))
(setq end-of-list (or end-of-list
- (vhdl-parse-string ")[ \t\n]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
+ (vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
(while (not end-of-list)
;; parse object
(setq object
- (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n]*" t)
+ (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t)
(match-string-no-properties 1)))
;; parse names (accept extended identifiers)
- (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
+ (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
(setq names (list (match-string-no-properties 1)))
- (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
+ (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
(setq names (append names (list (match-string-no-properties 1)))))
;; parse direction
- (vhdl-parse-string ":[ \t\n]*")
+ (vhdl-parse-string ":[ \t\n\r\f]*")
(setq direct
- (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t)
+ (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t)
(match-string-no-properties 1)))
;; parse type
(vhdl-parse-string "\\([^():;\n]+\\)")
(setq type (substring type 0 (match-end 1)))
;; parse initialization expression
(setq init nil)
- (when (vhdl-parse-string ":=[ \t\n]*" t)
+ (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
(vhdl-parse-string "\\([^();\n]*\\)")
(setq init (match-string-no-properties 1))
(while (looking-at "(")
(vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
;; parse return type
(when (match-string 3)
- (vhdl-parse-string "[ \t\n]*\\(.+\\)[ \t\n]*\\(;\\|is\\>\\)\\s-*")
+ (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*")
(setq return-type (match-string-no-properties 1))
(when (and return-type
(string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type))
(defalias 'he-list-beg 'vhdl-he-list-beg))
;; function for expanding abbrevs and dabbrevs
-(defun vhdl-expand-abbrev (arg))
-(fset 'vhdl-expand-abbrev (make-hippie-expand-function
- '(try-expand-dabbrev
- try-expand-dabbrev-all-buffers
- vhdl-try-expand-abbrev)))
+(defalias 'vhdl-expand-abbrev (make-hippie-expand-function
+ '(try-expand-dabbrev
+ try-expand-dabbrev-all-buffers
+ vhdl-try-expand-abbrev)))
;; function for expanding parenthesis
-(defun vhdl-expand-paren (arg))
-(fset 'vhdl-expand-paren (make-hippie-expand-function
- '(try-expand-list
- try-expand-list-all-buffers)))
+(defalias 'vhdl-expand-paren (make-hippie-expand-function
+ '(try-expand-list
+ try-expand-list-all-buffers)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Case fixing
(< vhdl-progress-interval
(- (nth 1 (current-time)) last-update)))
(message "Fixing case... (%2d%s)"
- (+ (* count 25) (/ (* 25 (- (point) beg)) (- end beg)))
+ (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg)))
"%")
(setq last-update (nth 1 (current-time)))))
(goto-char end)))))
beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
(vhdl-fix-case-region-1
beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
+ (vhdl-fix-case-region-1
+ beg end vhdl-upper-case-constants vhdl-constants-regexp 4)
(when vhdl-progress-interval (message "Fixing case...done")))
(defun vhdl-fix-case-buffer ()
(upcase-word 1))
(when (and vhdl-upper-case-enum-values
(looking-at vhdl-enum-values-regexp))
+ (upcase-word 1))
+ (when (and vhdl-upper-case-constants
+ (looking-at vhdl-constants-regexp))
(upcase-word 1)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(interactive)
(let ((no-stats 0)
(no-code-lines 0)
+ (no-empty-lines 0)
+ (no-comm-lines 0)
+ (no-comments 0)
(no-lines (count-lines (point-min) (point-max))))
(save-excursion
;; count statements
(while (not (eobp))
(unless (looking-at "^\\s-*\\(--.*\\)?$")
(setq no-code-lines (1+ no-code-lines)))
- (beginning-of-line 2)))
+ (beginning-of-line 2))
+ ;; count empty lines
+ (goto-char (point-min))
+ (while (and (re-search-forward "^\\s-*$" nil t)
+ (not (eq (point) (point-max))))
+ (if (match-string 1)
+ (goto-char (match-end 1))
+ (setq no-empty-lines (1+ no-empty-lines))
+ (unless (eq (point) (point-max))
+ (forward-char))))
+ ;; count comment-only lines
+ (goto-char (point-min))
+ (while (re-search-forward "^\\s-*--.*" nil t)
+ (if (match-string 1)
+ (goto-char (match-end 1))
+ (setq no-comm-lines (1+ no-comm-lines))))
+ ;; count comments
+ (goto-char (point-min))
+ (while (re-search-forward "--.*" nil t)
+ (if (match-string 1)
+ (goto-char (match-end 1))
+ (setq no-comments (1+ no-comments)))))
;; print results
(message "\n\
File statistics: \"%s\"\n\
---------------------\n\
-# statements : %5d\n\
-# code lines : %5d\n\
-# total lines : %5d\n\ "
- (buffer-file-name) no-stats no-code-lines no-lines)
+# statements : %5d\n\
+# code lines : %5d\n\
+# empty lines : %5d\n\
+# comment lines : %5d\n\
+# comments : %5d\n\
+# total lines : %5d\n\ "
+ (buffer-file-name) no-stats no-code-lines no-empty-lines
+ no-comm-lines no-comments no-lines)
(unless vhdl-emacs-21 (vhdl-show-messages))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(concat
"\\(^\\)\\s-*\\("
;; generic/port clause
- "\\(generic\\|port\\)[ \t\n]*(\\|"
+ "\\(generic\\|port\\)[ \t\n\r\f]*(\\|"
;; component
"component\\>\\|"
;; component instantiation
- "\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*"
- "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
- "\\(\\w\\|\\s_\\)+\\([ \t\n]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n]*"
- "\\(generic\\|port\\)[ \t\n]+map[ \t\n]*(\\|"
+ "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*"
+ "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
+ "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*"
+ "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|"
;; subprogram
"\\(function\\|procedure\\)\\>\\|"
;; process, block
- "\\(\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*\\)?\\(process\\|block\\)\\>\\|"
+ "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|"
;; configuration declaration
"configuration\\>"
"\\)")
(beginning-of-line)
(cond
;; generic/port clause
- ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n]*(")
+ ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(")
(goto-char (match-end 0))
(backward-char)
(forward-sexp))
;; component instantiation
((looking-at
(concat
- "^\\s-*\\w+\\s-*:[ \t\n]*"
- "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
- "\\w+\\(\\s-*(\\w+)\\)?[ \t\n]*"
- "\\(generic\\|port\\)\\s-+map[ \t\n]*("))
+ "^\\s-*\\w+\\s-*:[ \t\n\r\f]*"
+ "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
+ "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*"
+ "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*("))
(goto-char (match-end 0))
(backward-char)
(forward-sexp)
(setq pos (point))
(vhdl-forward-syntactic-ws)
- (when (looking-at "port\\s-+map[ \t\n]*(")
+ (when (looking-at "port\\s-+map[ \t\n\r\f]*(")
(goto-char (match-end 0))
(backward-char)
(forward-sexp)
;; highlight labels of common constructs
(list
(concat
- "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\("
+ "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\("
"assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|"
"postponed\\|process\\|"
(when (vhdl-standard-p 'ams) "procedural\\|")
;; highlight label and component name of component instantiations
(list
(concat
- "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\w+\\)"
- "\\(\\s-*\\(--[^\n]*\\)?$\\|\\s-+\\(generic\\|port\\)\\s-+map\\>\\)")
+ "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*"
+ "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>")
'(1 font-lock-function-name-face) '(2 font-lock-function-name-face))
;; highlight label and instantiated unit of component instantiations
(list
(concat
- "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*"
+ "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*"
"\\(component\\|configuration\\|entity\\)\\s-+"
"\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?")
'(1 font-lock-function-name-face) '(3 font-lock-function-name-face)
(list
(concat
"^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*"
- "\\(:[ \t\n]*\\(\\w+\\)\\|[^i \t]\\)")
+ "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)")
'(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t))
;; highlight names in library clauses
;; highlight type/nature name in (sub)type/(sub)nature declarations
(list
(concat
- "^\\s-*\\(sub\\)?\\(nature\\|type\\)\\s-+\\(\\w+\\)")
- 3 'font-lock-type-face)
+ "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)")
+ 5 'font-lock-type-face)
;; highlight signal/variable/constant declaration names
(list "\\(:[^=]\\)"
(list vhdl-functions-regexp 1 'vhdl-font-lock-function-face)
(list vhdl-packages-regexp 1 'vhdl-font-lock-function-face)
(list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face)
+ (list vhdl-constants-regexp 1 'font-lock-constant-face)
(list vhdl-keywords-regexp 1 'font-lock-keyword-face)))
;; highlight words with special syntax.
(setq vhdl-font-lock-keywords-3
(while syntax-alist
(setq keywords
(cons
- (cons (concat "\\<\\(" (nth 1 (car syntax-alist)) "\\)\\>")
+ (list (concat "\\(" (nth 1 (car syntax-alist)) "\\)") 1
(vhdl-function-name
- "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
+ "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")
+ (nth 4 (car syntax-alist)))
keywords))
(setq syntax-alist (cdr syntax-alist)))
keywords))
(when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)
(while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
(equal "USE" (upcase (match-string 1))))
- (when (looking-at "^[ \t]*use[ \t\n]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
+ (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
(setq lib-alist (cons (cons (match-string-no-properties 1)
(vhdl-match-string-downcase 2))
lib-alist))))))
(setq big-files t))
;; scan for entities
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*entity[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((ent-name (match-string-no-properties 1))
(ent-key (downcase ent-name))
(ent-entry (aget ent-alist ent-key t))
lib-alist)))))
;; scan for architectures
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((arch-name (match-string-no-properties 1))
(arch-key (downcase arch-name))
(ent-name (match-string-no-properties 2))
arch-key (nth 5 ent-entry))))))
;; scan for configurations
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*configuration[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((conf-name (match-string-no-properties 1))
(conf-key (downcase conf-name))
(conf-entry (aget conf-alist conf-key t))
arch-key comp-conf-list inst-key-list
inst-comp-key inst-ent-key inst-arch-key
inst-conf-key inst-lib-key)
- (when (vhdl-re-search-forward "\\<for[ \t\n]+\\(\\w+\\)")
+ (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)")
(setq arch-key (vhdl-match-string-downcase 1)))
(if conf-entry
(vhdl-warning-when-idle
(nth 2 conf-entry) file-name conf-line)
(setq conf-list (cons conf-key conf-list))
;; scan for subconfigurations and subentities
- (while (re-search-forward "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+" end-of-unit t)
+ (while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t)
(setq inst-comp-key (vhdl-match-string-downcase 3)
inst-key-list (split-string
(vhdl-match-string-downcase 1)
- "[ \t\n]*,[ \t\n]*"))
+ "[ \t\n\r\f]*,[ \t\n\r\f]*"))
(vhdl-forward-syntactic-ws)
- (when (looking-at "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n]*\\((\\(\\w+\\))\\)?")
+ (when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?")
(setq
inst-lib-key (vhdl-match-string-downcase 3)
inst-ent-key (and (match-string 2)
arch-key comp-conf-list lib-alist)))))
;; scan for packages
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*package[ \t\n]+\\(body[ \t\n]+\\)?\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((pack-name (match-string-no-properties 2))
(pack-key (downcase pack-name))
(is-body (match-string-no-properties 1))
;; scan for context clauses
(setq lib-alist (vhdl-scan-context-clause))
;; scan for component and subprogram declarations/bodies
- (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
+ (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
(if (equal (upcase (match-string 1)) "COMPONENT")
(setq comp-name (match-string-no-properties 2)
comp-alist
(setq big-files t))
;; scan for architectures
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
+ (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((ent-name (match-string-no-properties 2))
(ent-key (downcase ent-name))
(arch-name (match-string-no-properties 1))
inst-alist inst-path)
;; scan for contained instantiations
(while (and (re-search-forward
- (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
- "\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(generic\\|port\\)[ \t\n]+map\\>\\|"
- "component[ \t\n]+\\(\\w+\\)\\|"
- "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?\\|"
+ (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
+ "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|"
+ "component[ \t\n\r\f]+\\(\\w+\\)\\|"
+ "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|"
"\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
- "\\(^[ \t]*end[ \t\n]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
+ "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
(or (not limit-hier-inst-no)
(<= (setq inst-no (1+ inst-no))
limit-hier-inst-no)))
;; scan for contained configuration specifications
(goto-char beg-of-unit)
(while (re-search-forward
- (concat "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*"
- "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?") end-of-unit t)
+ (concat "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*"
+ "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t)
(let* ((inst-comp-name (match-string-no-properties 3))
(inst-ent-key
(and (match-string 6)
(inst-lib-key (vhdl-match-string-downcase 8))
(inst-key-list
(split-string (vhdl-match-string-downcase 1)
- "[ \t\n]*,[ \t\n]*"))
+ "[ \t\n\r\f]*,[ \t\n\r\f]*"))
(tmp-inst-alist inst-alist)
inst-entry)
(while tmp-inst-alist
(define-key vhdl-speedbar-key-map (int-to-string key)
`(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
(setq key (1+ key)))))
- (define-key speedbar-key-map "h"
+ (define-key speedbar-mode-map "h"
(lambda () (interactive)
(speedbar-change-initial-expansion-list "vhdl directory")))
- (define-key speedbar-key-map "H"
+ (define-key speedbar-mode-map "H"
(lambda () (interactive)
(speedbar-change-initial-expansion-list "vhdl project")))
;; menu
(read-from-minibuffer "architecture name: "
nil vhdl-minibuffer-local-map)
(vhdl-replace-string vhdl-compose-architecture-name ent-name)))
- ent-file-name arch-file-name ent-buffer arch-buffer project)
+ ent-file-name arch-file-name ent-buffer arch-buffer project end-pos)
(message "Creating component \"%s(%s)\"..." ent-name arch-name)
;; open entity file
(unless (eq vhdl-compose-create-files 'none)
;; insert header
(if vhdl-compose-include-header
(progn (vhdl-template-header)
+ (setq end-pos (point))
(goto-char (point-max)))
(vhdl-comment-display-line) (insert "\n\n"))
;; insert library clause
;; open architecture file
(if (not (eq vhdl-compose-create-files 'separate))
(insert "\n")
+ (goto-char (or end-pos (point-min)))
(setq ent-buffer (current-buffer))
(setq arch-file-name
(concat (vhdl-replace-string vhdl-architecture-file-name
(if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
(vhdl-template-footer)
(vhdl-comment-display-line) (insert "\n"))
- (goto-char (point-min))
+ (goto-char (or end-pos (point-min)))
(setq arch-buffer (current-buffer))
(when ent-buffer (set-buffer ent-buffer) (save-buffer))
(set-buffer arch-buffer) (save-buffer)
(error "ERROR: No port has been read")
(save-excursion
(vhdl-prepare-search-2
- (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
- (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
+ (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
+ (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t))
(error "ERROR: No architecture found"))
(let* ((ent-name (match-string 1))
(ent-file-name
(car vhdl-port-list) "\\>") nil t)))
(re-search-forward "^begin\\>" nil)
(beginning-of-line)
- (skip-chars-backward " \t\n")
+ (skip-chars-backward " \t\n\r\f")
(insert "\n\n") (indent-to vhdl-basic-offset)
(vhdl-port-paste-component t))
;; place component instantiation
(re-search-forward "^end\\>" nil)
(beginning-of-line)
- (skip-chars-backward " \t\n")
+ (skip-chars-backward " \t\n\r\f")
(insert "\n\n") (indent-to vhdl-basic-offset)
(vhdl-port-paste-instance nil t t)
;; place use clause for used packages
(when (file-exists-p ent-file-name)
(find-file ent-file-name))
(goto-char (point-min))
- (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
+ (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
(error "ERROR: Entity not found: \"%s\"" ent-name))
(goto-char (match-beginning 0))
(if (and (save-excursion
(interactive)
(save-excursion
(vhdl-prepare-search-2
- (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
- (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
+ (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
+ (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t))
(error "ERROR: No architecture found"))
(let* ((ent-name (match-string 1))
(ent-file-name
;; process all instances
(goto-char arch-stat-pos)
(while (re-search-forward
- (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
- "\\(component[ \t\n]+\\)?\\(\\w+\\)"
- "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\|"
- "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?"
- "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\)[ \t\n]*(") arch-end-pos t)
+ (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
+ "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)"
+ "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|"
+ "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?"
+ "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\)[ \t\n\r\f]*(") arch-end-pos t)
(setq inst-name (match-string-no-properties 1)
comp-name (match-string-no-properties 4)
comp-ent-name (match-string-no-properties 12)
(when vhdl-use-components-package pack-file-name) t
(save-excursion
(goto-char (point-min))
- (unless (re-search-forward (concat "^\\s-*component[ \t\n]+" comp-name "\\>") nil t)
+ (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t)
(error "ERROR: Component declaration not found: \"%s\"" comp-name))
(vhdl-port-copy)))
;; ... from entity declaration (direct instantiation)
comp-ent-file-name t
(save-excursion
(goto-char (point-min))
- (unless (re-search-forward (concat "^\\s-*entity[ \t\n]+" comp-ent-name "\\>") nil t)
+ (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t)
(error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name))
(vhdl-port-copy))))
(vhdl-port-flatten t)
(when has-generic
;; process all constants in generic map
(vhdl-forward-syntactic-ws)
- (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
+ (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
(setq constant-name (match-string-no-properties 3))
(setq constant-entry
(cons constant-name
(unless (match-string 1)
(setq generic-alist (cdr generic-alist)))
(vhdl-forward-syntactic-ws))
- (vhdl-re-search-forward "\\<port\\s-+map[ \t\n]*(" nil t))
+ (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t))
;; process all signals in port map
(vhdl-forward-syntactic-ws)
- (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
+ (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
(setq signal-name (match-string-no-properties 3))
(setq signal-entry (cons signal-name
(if (match-string 1)
;; prepare signal insertion
(vhdl-goto-marker arch-decl-pos)
(forward-line 1)
- (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n]*-*\n" arch-stat-pos t)
+ (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t)
(setq signal-pos (point-marker))
(while (progn (vhdl-forward-syntactic-ws)
(looking-at "signal\\>"))
(when (file-exists-p ent-file-name)
(find-file ent-file-name))
(goto-char (point-min))
- (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
+ (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
(error "ERROR: Entity not found: \"%s\"" ent-name))
;; prepare generic clause insertion
- (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n]*(\\)\\|^end\\>" nil t)
+ (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
(match-string 1))
(goto-char (match-beginning 0))
(indent-to vhdl-basic-offset)
(setq generic-beg-pos (point-marker) generic-pos (point-marker)
generic-inst-pos (point-marker) generic-end-pos (point-marker))
;; prepare port clause insertion
- (unless (and (re-search-forward "\\(^\\s-*port[ \t\n]*(\\)\\|^end\\>" nil t)
+ (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
(match-string 1))
(goto-char (match-beginning 0))
(indent-to vhdl-basic-offset)
(message "Generating components package \"%s\"...done\n File created: \"%s\""
pack-name pack-file-name)))
-(defun vhdl-compose-configuration-architecture (ent-name arch-name inst-alist
+(defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist
+ conf-alist inst-alist
&optional insert-conf)
"Generate block configuration for architecture."
(let ((margin (current-indentation))
(nth 3 ent-entry))
(indent-to (+ margin vhdl-basic-offset))
(vhdl-compose-configuration-architecture
- (nth 0 ent-entry) arch-name
+ (nth 0 ent-entry) arch-name ent-alist conf-alist
(nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t))))))
;; insert component configuration end
(indent-to margin)
(vhdl-insert-keyword " IS\n")
(indent-to vhdl-basic-offset)
;; insert block configuration (for architecture)
- (vhdl-compose-configuration-architecture ent-name arch-name inst-alist t)
+ (vhdl-compose-configuration-architecture
+ ent-name arch-name ent-alist conf-alist inst-alist t)
(vhdl-insert-keyword "END ") (insert conf-name ";")
(when conf-file-name
;; insert footer and save
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (using `compile.el')
+(defvar vhdl-compile-post-command ""
+ "String appended to compile command after file name.")
+
(defun vhdl-makefile-name ()
"Return the Makefile name of the current project or the current compiler if
no project is defined."
(compiler (or (aget vhdl-compiler-alist vhdl-compiler nil)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 0 compiler))
- (file-name (buffer-file-name))
- (options (vhdl-get-compile-options project compiler file-name))
(default-directory (vhdl-compile-directory))
+ (file-name (if vhdl-compile-absolute-path
+ (buffer-file-name)
+ (file-relative-name (buffer-file-name))))
+ (options (vhdl-get-compile-options project compiler file-name))
compilation-process-setup-function)
(unless (file-directory-p default-directory)
(error "ERROR: Compile directory does not exist: \"%s\"" default-directory))
(when (string-match " " file-name)
(setq file-name (concat "\"" file-name "\"")))
;; print out file name if compiler does not
- (setq vhdl-compile-file-name (buffer-file-name))
+ (setq vhdl-compile-file-name (if vhdl-compile-absolute-path
+ (buffer-file-name)
+ (file-relative-name (buffer-file-name))))
(when (and (= 0 (nth 1 (nth 10 compiler)))
(= 0 (nth 1 (nth 11 compiler))))
(setq compilation-process-setup-function 'vhdl-compile-print-file-name))
;; run compilation
(if options
(when command
- (compile (concat command " " options " " file-name)))
+ (compile (concat command " " options " " file-name
+ (unless (equal vhdl-compile-post-command "")
+ (concat " " vhdl-compile-post-command)))))
(vhdl-warning "Your project settings tell me not to compile this file"))))
(defvar vhdl-make-target "all"
(insert "\n\n# Define compilation command and options\n"
"\nCOMPILE = " (nth 0 compiler)
"\nOPTIONS = " (vhdl-get-compile-options project compiler nil)
+ (if (equal vhdl-compile-post-command "") ""
+ (concat "\nPOST-COMPILE = " vhdl-compile-post-command))
"\n")
;; insert library paths
(setq library-directory
(setq unit-list tmp-list)
;; insert `make all' rule
(insert "\n\n\n# Rule for compiling entire design\n"
- "\nall :"
- " \\\n\t\tlibrary"
+ "\n" (nth 0 vhdl-makefile-default-targets) " :"
+ " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)
" \\\n\t\t$(ALL_UNITS)\n")
;; insert `make clean' rule
(insert "\n\n# Rule for cleaning entire design\n"
- "\nclean : "
+ "\n" (nth 1 vhdl-makefile-default-targets) " : "
"\n\t-rm -f $(ALL_UNITS)\n")
;; insert `make library' rule
(insert "\n\n# Rule for creating library directory\n"
- "\nlibrary :"
+ "\n" (nth 2 vhdl-makefile-default-targets) " :"
" \\\n\t\t$(LIBRARY-" work-library ")\n"
"\n$(LIBRARY-" work-library ") :"
"\n\t"
(cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
(concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
"\n")
+ ;; insert '.PHONY' declaration
+ (insert "\n\n.PHONY : "
+ (nth 0 vhdl-makefile-default-targets) " "
+ (nth 1 vhdl-makefile-default-targets) " "
+ (nth 2 vhdl-makefile-default-targets) "\n")
;; insert rule for each library unit
(insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
(while prim-list
(unless (equal unit-key unit-name)
(insert " \\\n" unit-name))
(insert " :"
- " \\\n\t\tlibrary"
+ " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)
" \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
(while second-list
(insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
(if options
(insert "\n\t$(COMPILE) "
(if (eq options 'default) "$(OPTIONS)" options) " "
- (nth 0 rule) "\n")
+ (nth 0 rule)
+ (if (equal vhdl-compile-post-command "") ""
+ " $(POST-COMPILE)") "\n")
(setq tmp-list target-list)
(while target-list
(insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")"
'vhdl-compiler-alist
'vhdl-compiler
'vhdl-compile-use-local-error-regexp
+ 'vhdl-makefile-default-targets
'vhdl-makefile-generation-hook
'vhdl-default-library
'vhdl-standard
'vhdl-upper-case-enum-values
'vhdl-upper-case-constants
'vhdl-use-direct-instantiation
+ 'vhdl-array-index-record-field-in-sensitivity-list
'vhdl-compose-configuration-name
'vhdl-entity-file-name
'vhdl-architecture-file-name
'vhdl-print-customize-faces
'vhdl-intelligent-tab
'vhdl-indent-syntax-based
+ 'vhdl-indent-comment-like-next-code-line
'vhdl-word-completion-case-sensitive
'vhdl-word-completion-in-minibuffer
'vhdl-underscore-is-part-of-word
(See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.)
+Key Bindings
+------------
+
+For Emacs compliance the following key bindings have been changed:
+
+- `C-c c' -> `C-c C-c' `vhdl-comment-uncomment-region'
+- `C-c f' -> `C-c C-i C-f' `vhdl-fontify-buffer'
+- `C-c s' -> `C-c C-i C-s' `vhdl-statistics-buffer'
+- `C-c C-c ...' -> `C-c C-m ...' `vhdl-compose-...'
+
+
User Options
------------
Specify whether hierarchical configurations should be created.
`vhdl-compose-configuration-use-subconfiguration': (new)
Specify whether subconfigurations should be used inside configurations.
+`vhdl-makefile-default-targets': (new)
+ Customize names of Makefile default targets.
+`vhdl-indent-comment-like-next-code-line': (new)
+ Specify whether comment lines are indented like following code line.
+`vhdl-array-index-record-field-in-sensitivity-list': (new)
+ Specify whether to include array indices / record fields in sensitivity list.
")
Reserved words in VHDL
----------------------
-VHDL'93 (IEEE Std 1076-1993):
- `vhdl-93-keywords' : keywords
- `vhdl-93-types' : standardized types
- `vhdl-93-attributes' : standardized attributes
- `vhdl-93-enum-values' : standardized enumeration values
- `vhdl-93-functions' : standardized functions
- `vhdl-93-packages' : standardized packages and libraries
+VHDL'93/02 (IEEE Std 1076-1993/2002):
+ `vhdl-02-keywords' : keywords
+ `vhdl-02-types' : standardized types
+ `vhdl-02-attributes' : standardized attributes
+ `vhdl-02-enum-values' : standardized enumeration values
+ `vhdl-02-functions' : standardized functions
+ `vhdl-02-packages' : standardized packages and libraries
-VHDL-AMS (IEEE Std 1076.1):
+VHDL-AMS (IEEE Std 1076.1 / 1076.1.1):
`vhdl-ams-keywords' : keywords
`vhdl-ams-types' : standardized types
`vhdl-ams-attributes' : standardized attributes
`vhdl-ams-enum-values' : standardized enumeration values
+ `vhdl-ams-constants' : standardized constants
`vhdl-ams-functions' : standardized functions
Math Packages (IEEE Std 1076.2):
"Display VARIABLE's documentation in *Help* buffer."
(interactive)
(unless (featurep 'xemacs)
- (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
+ (help-setup-xref (list #'vhdl-doc-variable variable)
+ (called-interactively-p 'interactive)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ (documentation-property variable 'variable-documentation))
"Display VHDL Mode documentation in *Help* buffer."
(interactive)
(unless (featurep 'xemacs)
- (help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
+ (help-setup-xref (list #'vhdl-doc-mode)
+ (called-interactively-p 'interactive)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(princ mode-name)
;;; which-func.el --- print current function in mode line
-;; Copyright (C) 1994, 1997-1998, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1997-1998, 2001-2012 Free Software Foundation, Inc.
;; Author: Alex Rezinsky <alexr@msil.sps.mot.com>
;; (doesn't seem to be responsive any more)
"String to display in the mode line when current function is unknown.")
(defgroup which-func nil
- "Mode to display the current function name in the modeline."
+ "Display the current function name in the mode line."
:group 'tools
:version "20.3")
-(defcustom which-func-modes
- '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode python-mode
- makefile-mode sh-mode fortran-mode f90-mode ada-mode
- diff-mode)
+(defcustom which-func-modes t
+ ;; '(emacs-lisp-mode c-mode c++-mode objc-mode perl-mode cperl-mode python-mode
+ ;; makefile-mode sh-mode fortran-mode f90-mode ada-mode
+ ;; diff-mode)
"List of major modes for which Which Function mode should be used.
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.3" ; explicit list -> t
:type '(choice (const :tag "All modes" t)
(repeat (symbol :tag "Major mode"))))
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)
(defvar which-func-cleanup-function nil
"Function to transform a string before displaying it in the mode line.
The function is called with one argument, the string to display.
-Its return value is displayed in the modeline.
+Its return value is displayed in the mode line.
If nil, no function is called. The default value is nil.
This feature can be useful if Imenu is set up to make more
(setq imenu--index-alist
(save-excursion (funcall imenu-create-index-function))))
(error
- (unless (equal err '(error "This buffer cannot use `imenu-default-create-index-function'"))
+ (unless (equal err
+ '(user-error "This buffer cannot use `imenu-default-create-index-function'"))
(message "which-func-ff-hook error: %S" err))
(setq which-func-mode nil))))
(error "Error in which-func-update: %S" info))))))
;;;###autoload
-(defun which-func-mode (&optional arg)
- (which-function-mode arg))
-(make-obsolete 'which-func-mode 'which-function-mode "24.1")
+(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1")
(defvar which-func-update-timer nil)
(funcall which-func-cleanup-function name)
name))))
+\f
+;;; Integration with other packages
+
+(defun which-func-update-ediff-windows ()
+ "Update Which-Function mode display for Ediff windows.
+This function is meant to be called from `ediff-select-hook'."
+ (when (eq major-mode 'ediff-mode)
+ (when ediff-window-A
+ (which-func-update-1 ediff-window-A))
+ (when ediff-window-B
+ (which-func-update-1 ediff-window-B))
+ (when ediff-window-C
+ (which-func-update-1 ediff-window-C))))
+
+(add-hook 'ediff-select-hook 'which-func-update-ediff-windows)
+
(provide 'which-func)
;;; which-func.el ends here
"Name of xscheme buffer that we're currently interacting with.")
(defvar xscheme-expressions-ring-max 30
- "*Maximum length of Scheme expressions ring.")
+ "Maximum length of Scheme expressions ring.")
(defvar xscheme-expressions-ring nil
"List of expressions recently transmitted to the Scheme process.")
(defconst default-xscheme-runlight
'(": " xscheme-runlight-string)
- "Default global (shared) xscheme-runlight modeline format.")
+ "Default global (shared) xscheme-runlight mode line format.")
(defvar xscheme-runlight "")
(defvar xscheme-runlight-string nil)
:group 'lisp)
(defcustom scheme-band-name nil
- "*Band loaded by the `run-scheme' command."
+ "Band loaded by the `run-scheme' command."
:type '(choice (const nil) string)
:group 'xscheme)
(defcustom scheme-program-arguments nil
- "*Arguments passed to the Scheme program by the `run-scheme' command."
+ "Arguments passed to the Scheme program by the `run-scheme' command."
:type '(choice (const nil) string)
:group 'xscheme)
in the minibuffer. If an error occurs, the process buffer will
automatically pop up to show you the error message.
-While the Scheme process is running, the modelines of all buffers in
+While the Scheme process is running, the mode lines of all buffers in
scheme-mode are modified to show the state of the process. The
possible states and their meanings are:
run evaluating
gc garbage collecting
-The process buffer's modeline contains additional information where
+The process buffer's mode line contains additional information where
the buffer's name is normally displayed: the command interpreter level
and type.
(cons (process-filter process)
(process-sentinel process)))
(xscheme-process-filter-initialize t)
- (xscheme-modeline-initialize xscheme-buffer-name)
+ (xscheme-mode-line-initialize xscheme-buffer-name)
(set-process-sentinel process 'xscheme-process-sentinel)
(set-process-filter process 'xscheme-process-filter))
(setq xscheme-previous-process-state (cons nil nil)))))))
xscheme-buffer-name)
(set-marker (process-mark process) (point-max))
(xscheme-process-filter-initialize t)
- (xscheme-modeline-initialize xscheme-buffer-name)
+ (xscheme-mode-line-initialize xscheme-buffer-name)
(set-process-sentinel process 'xscheme-process-sentinel)
(set-process-filter process 'xscheme-process-filter)
(run-hooks 'xscheme-start-hook)))))
(if running-p
(let ((name (buffer-name (current-buffer))))
(setq scheme-mode-line-process '(": " xscheme-runlight-string))
- (xscheme-modeline-initialize name)
+ (xscheme-mode-line-initialize name)
(if (equal name (default-value 'xscheme-buffer-name))
(setq-default xscheme-runlight default-xscheme-runlight))))
(if (or (eq xscheme-runlight default-xscheme-runlight)
(set-buffer (process-buffer process))
(goto-char (process-mark process))))
-(defun xscheme-modeline-initialize (name)
+(defun xscheme-mode-line-initialize (name)
(setq xscheme-runlight-string "")
(if (equal name (default-value 'xscheme-buffer-name))
(setq-default xscheme-runlight-string ""))
;; variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
;; These variables contain lists of faces that ps-print should consider bold,
;; italic or underline; to set them, put code like the following into your
-;; .emacs file:
+;; init file:
;;
;; (setq ps-bold-faces '(my-blue-face))
;; (setq ps-italic-faces '(my-red-face))
;; * CUPS has enabled the option "Share published printers connected
;; to this system" (see <http://localhost:631/admin>).
-(eval-when-compile
- (require 'cl))
(require 'printing)
(require 'zeroconf)
(let ((km (copy-keymap recentf--shortcuts-keymap)))
(set-keymap-parent km widget-keymap)
(define-key km "q" 'recentf-cancel-dialog)
+ (define-key km "n" 'next-line)
+ (define-key km "p" 'previous-line)
(define-key km [follow-link] "\C-m")
km)
"Keymap used in recentf dialogs.")
;; ### NOTE: this file was almost completely rewritten by Didier Verna
;; <didier@xemacs.org> in July 1999.
-;;; Global key bindings
-
-;;;###autoload (define-key ctl-x-r-map "c" 'clear-rectangle)
-;;;###autoload (define-key ctl-x-r-map "k" 'kill-rectangle)
-;;;###autoload (define-key ctl-x-r-map "d" 'delete-rectangle)
-;;;###autoload (define-key ctl-x-r-map "y" 'yank-rectangle)
-;;;###autoload (define-key ctl-x-r-map "o" 'open-rectangle)
-;;;###autoload (define-key ctl-x-r-map "t" 'string-rectangle)
-;;;###autoload (define-key ctl-x-r-map "N" 'rectangle-number-lines)
-
;;; Code:
;; FIXME: this function should be replaced by `apply-on-rectangle'
(condition-case nil
(setq killed-rectangle (delete-extract-rectangle start end fill))
((buffer-read-only text-read-only)
+ (setq deactivate-mark t)
(setq killed-rectangle (extract-rectangle start end))
(if kill-read-only-ok
(progn (message "Read only text copied to kill ring") nil)
(barf-if-buffer-read-only)
(signal 'text-read-only (list (current-buffer)))))))
+;;;###autoload
+(defun copy-rectangle-as-kill (start end)
+ "Copy the region-rectangle and save it as the last killed one."
+ (interactive "r")
+ (setq killed-rectangle (extract-rectangle start end))
+ (setq deactivate-mark t)
+ (if (called-interactively-p 'interactive)
+ (indicate-copied-region (length (car killed-rectangle)))))
+
;;;###autoload
(defun yank-rectangle ()
"Yank the last killed rectangle with upper left corner at point."
;; pieces of buffer state to named variables. The entry points are
;; documented in the Emacs user's manual.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag))
(declare-function semantic-tag-buffer "semantic/tag" (tag))
(declare-function semantic-tag-start "semantic/tag" (tag))
-;;; Global key bindings
-
-(define-key ctl-x-r-map "\C-@" 'point-to-register)
-(define-key ctl-x-r-map [?\C-\ ] 'point-to-register)
-(define-key ctl-x-r-map " " 'point-to-register)
-(define-key ctl-x-r-map "j" 'jump-to-register)
-(define-key ctl-x-r-map "s" 'copy-to-register)
-(define-key ctl-x-r-map "x" 'copy-to-register)
-(define-key ctl-x-r-map "i" 'insert-register)
-(define-key ctl-x-r-map "g" 'insert-register)
-(define-key ctl-x-r-map "r" 'copy-rectangle-to-register)
-(define-key ctl-x-r-map "n" 'number-to-register)
-(define-key ctl-x-r-map "+" 'increment-register)
-(define-key ctl-x-r-map "w" 'window-configuration-to-register)
-(define-key ctl-x-r-map "f" 'frame-configuration-to-register)
-
;;; Code:
-(defstruct
+(cl-defstruct
(registerv (:constructor nil)
(:constructor registerv--make (&optional data print-func
jump-func insert-func))
(jump-func nil :read-only t)
(insert-func nil :read-only t))
-(defun* registerv-make (data &key print-func jump-func insert-func)
+(cl-defun registerv-make (data &key print-func jump-func insert-func)
"Create a register value object.
DATA can be any value.
A list of the form (FRAME-CONFIGURATION POSITION)
represents a saved frame configuration plus a saved value of point.")
+(defgroup register nil
+ "Register commands."
+ :group 'convenience
+ :version "24.3")
+
+(defcustom register-separator nil
+ "Register containing the text to put between collected texts, or nil if none.
+
+When collecting text with
+`append-to-register' (resp. `prepend-to-register') contents of
+this register is added to the beginning (resp. end) of the marked
+text."
+ :group 'register
+ :type '(choice (const :tag "None" nil)
+ (character :tag "Use register" :value ?+)))
+
(defun get-register (register)
"Return contents of Emacs register named REGISTER, or nil if none."
(cdr (assq register register-alist)))
(let ((val (get-register register)))
(cond
((registerv-p val)
- (assert (registerv-jump-func val) nil
+ (cl-assert (registerv-jump-func val) nil
"Don't know how to jump to register %s"
(single-key-description register))
(funcall (registerv-jump-func val) (registerv-data val)))
(string-to-number (match-string 0)))
0))))
-(defun increment-register (number register)
- "Add NUMBER to the contents of register REGISTER.
-Interactively, NUMBER is the prefix arg."
- (interactive "p\ncIncrement register: ")
- (or (numberp (get-register register))
- (error "Register does not contain a number"))
- (set-register register (+ number (get-register register))))
+(defun increment-register (prefix register)
+ "Augment contents of REGISTER.
+Interactively, PREFIX is in raw form.
+
+If REGISTER contains a number, add `prefix-numeric-value' of
+PREFIX to it.
+
+If REGISTER is empty or if it contains text, call
+`append-to-register' with `delete-flag' set to PREFIX."
+ (interactive "P\ncIncrement register: ")
+ (let ((register-val (get-register register)))
+ (cond
+ ((numberp register-val)
+ (let ((number (prefix-numeric-value prefix)))
+ (set-register register (+ number register-val))))
+ ((or (not register-val) (stringp register-val))
+ (append-to-register register (region-beginning) (region-end) prefix))
+ (t (error "Register does not contain a number or text")))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
(let ((val (get-register register)))
(cond
((registerv-p val)
- (assert (registerv-insert-func val) nil
+ (cl-assert (registerv-insert-func val) nil
"Don't know how to insert register %s"
(single-key-description register))
(funcall (registerv-insert-func val) (registerv-data val)))
START and END are buffer positions indicating what to copy."
(interactive "cCopy to register: \nr\nP")
(set-register register (filter-buffer-substring start end))
- (if delete-flag (delete-region start end)))
+ (setq deactivate-mark t)
+ (cond (delete-flag
+ (delete-region start end))
+ ((called-interactively-p 'interactive)
+ (indicate-copied-region))))
(defun append-to-register (register start end &optional delete-flag)
"Append region to text in register REGISTER.
START and END are buffer positions indicating what to append."
(interactive "cAppend to register: \nr\nP")
(let ((reg (get-register register))
- (text (filter-buffer-substring start end)))
+ (text (filter-buffer-substring start end))
+ (separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
- ((stringp reg) (concat reg text))
+ ((stringp reg) (concat reg separator text))
(t (error "Register does not contain text")))))
- (if delete-flag (delete-region start end)))
+ (cond (delete-flag
+ (delete-region start end))
+ ((called-interactively-p 'interactive)
+ (indicate-copied-region))))
(defun prepend-to-register (register start end &optional delete-flag)
"Prepend region to text in register REGISTER.
START and END are buffer positions indicating what to prepend."
(interactive "cPrepend to register: \nr\nP")
(let ((reg (get-register register))
- (text (filter-buffer-substring start end)))
+ (text (filter-buffer-substring start end))
+ (separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
- ((stringp reg) (concat text reg))
+ ((stringp reg) (concat text separator reg))
(t (error "Register does not contain text")))))
- (if delete-flag (delete-region start end)))
+ (cond (delete-flag
+ (delete-region start end))
+ ((called-interactively-p 'interactive)
+ (indicate-copied-region))))
(defun copy-rectangle-to-register (register start end &optional delete-flag)
"Copy rectangular region into register REGISTER.
Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions giving two corners of rectangle."
(interactive "cCopy rectangle to register: \nr\nP")
- (set-register register
- (if delete-flag
- (delete-extract-rectangle start end)
- (extract-rectangle start end))))
+ (let ((rectangle (if delete-flag
+ (delete-extract-rectangle start end)
+ (extract-rectangle start end))))
+ (set-register register rectangle)
+ (when (and (null delete-flag)
+ (called-interactively-p 'interactive))
+ (setq deactivate-mark t)
+ (indicate-copied-region (length (car rectangle))))))
+
(provide 'register)
;;; register.el ends here
-;;; repeat.el --- convenient way to repeat the previous command
+;;; repeat.el --- convenient way to repeat the previous command -*- lexical-binding: t -*-
;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
;; `repeat' now repeats that command instead of `real-last-command' to
;; avoid a "... must be bound to an event with parameters" error.
-(defvar repeat-last-self-insert nil
- "If last repeated command was `self-insert-command', it inserted this.")
-
-;; That'll require another keystroke count so we know we're in a string of
-;; repetitions of self-insert commands:
-
-(defvar repeat-num-input-keys-at-self-insert -1
- "# key sequences read in Emacs session when `self-insert-command' repeated.")
-
;;;;; *************** ANALOGOUS HACKS TO `repeat' ITSELF **************** ;;;;;
;; That mechanism of checking num-input-keys to figure out what's really
(defvar repeat-previous-repeated-command nil
"The previous repeated command.")
-;; The following variable counts repeated self-insertions. The idea is
-;; that repeating a self-insertion command and subsequently undoing it
-;; should have almost the same effect as if the characters were inserted
-;; manually. The basic difference is that we leave in one undo-boundary
-;; between the original insertion and its first repetition.
-(defvar repeat-undo-count nil
- "Number of self-insertions since last `undo-boundary'.")
-
;;;###autoload
(defun repeat (repeat-arg)
"Repeat most recently executed command.
-With prefix arg, apply new prefix arg to that command; otherwise,
-use the prefix arg that was used before (if any).
-This command is like the `.' command in the vi editor.
+If REPEAT-ARG is non-nil (interactively, with a prefix argument),
+supply a prefix argument to that command. Otherwise, give the
+command the same prefix argument it was given before, if any.
If this command is invoked by a multi-character key sequence, it
can then be repeated by repeating the final character of that
(let ((repeat-repeat-char
(if (eq repeat-on-final-keystroke t)
last-command-event
- ;; allow only specified final keystrokes
+ ;; Allow only specified final keystrokes.
(car (memq last-command-event
(listify-key-sequence
repeat-on-final-keystroke))))))
(setq current-prefix-arg repeat-arg)
(repeat-message
"Repeating command %S %S" repeat-arg last-repeatable-command))
- (if (eq last-repeatable-command 'self-insert-command)
- (let ((insertion
- (if (<= (- num-input-keys
- repeat-num-input-keys-at-self-insert)
- 1)
- repeat-last-self-insert
- (let ((range (nth 1 buffer-undo-list)))
- (condition-case nil
- (setq repeat-last-self-insert
- (buffer-substring (car range)
- (cdr range)))
- (error (error "%s %s %s" ;Danger, Will Robinson!
- "repeat can't intuit what you"
- "inserted before auto-fill"
- "clobbered it, sorry")))))))
- (setq repeat-num-input-keys-at-self-insert num-input-keys)
- ;; If the self-insert had a repeat count, INSERTION
- ;; includes that many copies of the same character.
- ;; So use just the first character
- ;; and repeat it the right number of times.
- (setq insertion (substring insertion -1))
- (let ((count (prefix-numeric-value repeat-arg))
- (i 0))
- ;; Run pre- and post-command hooks for self-insertion too.
- (run-hooks 'pre-command-hook)
- (cond
- ((not repeat-undo-count))
- ((< repeat-undo-count 20)
- ;; Don't make an undo-boundary here.
- (setq repeat-undo-count (1+ repeat-undo-count)))
- (t
- ;; Make an undo-boundary after 20 repetitions only.
- (undo-boundary)
- (setq repeat-undo-count 1)))
- (while (< i count)
- (repeat-self-insert insertion)
- (setq i (1+ i)))
- (run-hooks 'post-command-hook)))
- (let ((indirect (indirect-function last-repeatable-command)))
- ;; Make each repetition undo separately.
- (undo-boundary)
- (if (or (stringp indirect)
- (vectorp indirect))
- ;; Bind real-last-command so that executing the macro does
- ;; not alter it. Do the same for last-repeatable-command.
- (let ((real-last-command real-last-command)
- (last-repeatable-command last-repeatable-command))
- (execute-kbd-macro last-repeatable-command))
- (run-hooks 'pre-command-hook)
- (call-interactively last-repeatable-command)
- (run-hooks 'post-command-hook)))))
+ (when (eq last-repeatable-command 'self-insert-command)
+ ;; We used to use a much more complex code to try and figure out
+ ;; what key was used to run that self-insert-command:
+ ;; (if (<= (- num-input-keys
+ ;; repeat-num-input-keys-at-self-insert)
+ ;; 1)
+ ;; repeat-last-self-insert
+ ;; (let ((range (nth 1 buffer-undo-list)))
+ ;; (condition-case nil
+ ;; (setq repeat-last-self-insert
+ ;; (buffer-substring (car range)
+ ;; (cdr range)))
+ ;; (error (error "%s %s %s" ;Danger, Will Robinson!
+ ;; "repeat can't intuit what you"
+ ;; "inserted before auto-fill"
+ ;; "clobbered it, sorry")))))
+ (setq last-command-event (char-before)))
+ (let ((indirect (indirect-function last-repeatable-command)))
+ (if (or (stringp indirect)
+ (vectorp indirect))
+ ;; Bind last-repeatable-command so that executing the macro does
+ ;; not alter it.
+ (let ((last-repeatable-command last-repeatable-command))
+ (execute-kbd-macro last-repeatable-command))
+ (call-interactively last-repeatable-command))))
(when repeat-repeat-char
- ;; A simple recursion here gets into trouble with max-lisp-eval-depth
- ;; on long sequences of repetitions of a command like `forward-word'
- ;; (only 32 repetitions are possible given the default value of 200 for
- ;; max-lisp-eval-depth), but if I now locally disable the repeat char I
- ;; can iterate indefinitely here around a single level of recursion.
- (let (repeat-on-final-keystroke
- ;; Bind `undo-inhibit-record-point' to t in order to avoid
- ;; recording point in `buffer-undo-list' here. We have to
- ;; do this since the command loop does not set the last
- ;; position of point thus confusing the point recording
- ;; mechanism when inserting or deleting text.
- (undo-inhibit-record-point t))
- (setq real-last-command 'repeat)
- (setq repeat-undo-count 1)
- (unwind-protect
- (while (let ((evt (read-key)))
- ;; For clicks, we need to strip the meta-data to
- ;; check the underlying event name.
- (eq (or (car-safe evt) evt)
- (or (car-safe repeat-repeat-char)
- repeat-repeat-char)))
- (repeat repeat-arg))
- ;; Make sure `repeat-undo-count' is reset.
- (setq repeat-undo-count nil))
- (setq unread-command-events (list last-input-event))))))
-
-(defun repeat-self-insert (string)
- (let ((i 0))
- (while (< i (length string))
- (let ((last-command-event (aref string i)))
- (self-insert-command 1))
- (setq i (1+ i)))))
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (vector repeat-repeat-char)
+ (if (null repeat-message-function) 'repeat
+ ;; If repeat-message-function is let-bound, preserve it for the
+ ;; next "iterations of the loop".
+ (let ((fun repeat-message-function))
+ (lambda ()
+ (interactive)
+ (let ((repeat-message-function fun))
+ (setq this-command 'repeat)
+ (call-interactively 'repeat))))))
+ map)))))
(defun repeat-message (format &rest args)
"Like `message' but displays with `repeat-message-function' if non-nil."
:type 'boolean
:group 'matching)
+(defcustom replace-lax-whitespace nil
+ "Non-nil means `query-replace' matches a sequence of whitespace chars.
+When you enter a space or spaces in the strings to be replaced,
+it will match any sequence matched by the regexp `search-whitespace-regexp'."
+ :type 'boolean
+ :group 'matching
+ :version "24.3")
+
+(defcustom replace-regexp-lax-whitespace nil
+ "Non-nil means `query-replace-regexp' matches a sequence of whitespace chars.
+When you enter a space or spaces in the regexps to be replaced,
+it will match any sequence matched by the regexp `search-whitespace-regexp'."
+ :type 'boolean
+ :group 'matching
+ :version "24.3")
+
(defvar query-replace-history nil
"Default history list for query-replace commands.
See `query-replace-from-history-variable' and
(if query-replace-interactive
(car (if regexp-flag regexp-search-ring search-ring))
(let* ((history-add-new-input nil)
+ (prompt
+ (if query-replace-defaults
+ (format "%s (default %s -> %s): " prompt
+ (query-replace-descr (car query-replace-defaults))
+ (query-replace-descr (cdr query-replace-defaults)))
+ (format "%s: " prompt)))
(from
;; The save-excursion here is in case the user marks and copies
;; a region in order to specify the minibuffer input.
;; That should not clobber the region for the query-replace itself.
(save-excursion
- (read-from-minibuffer
- (if query-replace-defaults
- (format "%s (default %s -> %s): " prompt
- (query-replace-descr (car query-replace-defaults))
- (query-replace-descr (cdr query-replace-defaults)))
- (format "%s: " prompt))
- nil nil nil
- query-replace-from-history-variable
- nil t))))
+ (if regexp-flag
+ (read-regexp prompt nil query-replace-from-history-variable)
+ (read-from-minibuffer
+ prompt nil nil nil query-replace-from-history-variable nil t)))))
(if (and (zerop (length from)) query-replace-defaults)
(cons (car query-replace-defaults)
(query-replace-compile-replacement
matched is all caps, or capitalized, then its replacement is upcased
or capitalized.)
+If `replace-lax-whitespace' is non-nil, a space or spaces in the string
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on.
all caps, or capitalized, then its replacement is upcased or
capitalized.)
+If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on.
Preserves case in each replacement if `case-replace' and `case-fold-search'
are non-nil and REGEXP has no uppercase letters.
+If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches that are surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on."
+ (declare (obsolete "use the `\\,' feature of `query-replace-regexp'
+for interactive calls, and `search-forward-regexp'/`replace-match'
+for Lisp calls." "22.1"))
(interactive
(progn
- (barf-if-buffer-read-only)
- (let* ((from
- ;; Let-bind the history var to disable the "foo -> bar" default.
- ;; Maybe we shouldn't disable this default, but for now I'll
- ;; leave it off. --Stef
- (let ((query-replace-to-history-variable nil))
- (query-replace-read-from "Query replace regexp" t)))
- (to (list (read-from-minibuffer
- (format "Query replace regexp %s with eval: "
- (query-replace-descr from))
- nil nil t query-replace-to-history-variable from t))))
- ;; We make TO a list because replace-match-string-symbols requires one,
- ;; and the user might enter a single token.
- (replace-match-string-symbols to)
- (list from (car to) current-prefix-arg
- (if (and transient-mark-mode mark-active)
- (region-beginning))
- (if (and transient-mark-mode mark-active)
- (region-end))))))
+ (barf-if-buffer-read-only)
+ (let* ((from
+ ;; Let-bind the history var to disable the "foo -> bar"
+ ;; default. Maybe we shouldn't disable this default, but
+ ;; for now I'll leave it off. --Stef
+ (let ((query-replace-to-history-variable nil))
+ (query-replace-read-from "Query replace regexp" t)))
+ (to (list (read-from-minibuffer
+ (format "Query replace regexp %s with eval: "
+ (query-replace-descr from))
+ nil nil t query-replace-to-history-variable from t))))
+ ;; We make TO a list because replace-match-string-symbols requires one,
+ ;; and the user might enter a single token.
+ (replace-match-string-symbols to)
+ (list from (car to) current-prefix-arg
+ (if (and transient-mark-mode mark-active)
+ (region-beginning))
+ (if (and transient-mark-mode mark-active)
+ (region-end))))))
(perform-replace regexp (cons 'replace-eval-replacement to-expr)
t 'literal delimited nil nil start end))
-(make-obsolete 'query-replace-regexp-eval
- "for interactive use, use the special `\\,' feature of
-`query-replace-regexp' instead. Non-interactively, a loop
-using `search-forward-regexp' and `replace-match' is preferred." "22.1")
-
(defun map-query-replace-regexp (regexp to-strings &optional n start end)
"Replace some matches for REGEXP with various strings, in rotation.
The second argument TO-STRINGS contains the replacement strings, separated
\(Preserving case means that if the string matched is all caps, or capitalized,
then its replacement is upcased or capitalized.)
+If `replace-lax-whitespace' is non-nil, a space or spaces in the string
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
Preserve case in each match if `case-replace' and `case-fold-search'
are non-nil and REGEXP has no uppercase letters.
+If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
(defvar occur-collect-regexp-history '("\\1")
"History of regexp for occur's collect operation")
-(defun read-regexp (prompt &optional default-value)
- "Read regexp as a string using the regexp history and some useful defaults.
-Prompt for a regular expression with PROMPT (without a colon and
-space) in the minibuffer. The optional argument DEFAULT-VALUE
-provides the value to display in the minibuffer prompt that is
-returned if the user just types RET.
-Values available via M-n are the string at point, the last isearch
-regexp, the last isearch string, and the last replacement regexp."
- (let* ((defaults
- (list (regexp-quote
- (or (funcall (or find-tag-default-function
- (get major-mode 'find-tag-default-function)
- 'find-tag-default))
- ""))
- (car regexp-search-ring)
- (regexp-quote (or (car search-ring) ""))
- (car (symbol-value
- query-replace-from-history-variable))))
+(defun read-regexp (prompt &optional defaults history)
+ "Read and return a regular expression as a string.
+When PROMPT doesn't end with a colon and space, it adds a final \": \".
+If DEFAULTS is non-nil, it displays the first default in the prompt.
+
+Non-nil optional arg DEFAULTS is a string or a list of strings that
+are prepended to a list of standard default values, which include the
+string at point, the last isearch regexp, the last isearch string, and
+the last replacement regexp.
+
+Non-nil HISTORY is a symbol to use for the history list.
+If HISTORY is nil, `regexp-history' is used."
+ (let* ((default (if (consp defaults) (car defaults) defaults))
+ (defaults
+ (append
+ (if (listp defaults) defaults (list defaults))
+ (list (regexp-quote
+ (or (funcall (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default))
+ ""))
+ (car regexp-search-ring)
+ (regexp-quote (or (car search-ring) ""))
+ (car (symbol-value
+ query-replace-from-history-variable)))))
(defaults (delete-dups (delq nil (delete "" defaults))))
- ;; Don't add automatically the car of defaults for empty input
+ ;; Do not automatically add default to the history for empty input.
(history-add-new-input nil)
- (input
- (read-from-minibuffer
- (if default-value
- (format "%s (default %s): " prompt
- (query-replace-descr default-value))
- (format "%s: " prompt))
- nil nil nil 'regexp-history defaults t)))
+ (input (read-from-minibuffer
+ (cond ((string-match-p ":[ \t]*\\'" prompt)
+ prompt)
+ (default
+ (format "%s (default %s): " prompt
+ (query-replace-descr default)))
+ (t
+ (format "%s: " prompt)))
+ nil nil nil (or history 'regexp-history) defaults t)))
(if (equal input "")
- (or default-value input)
+ (or default input)
(prog1 input
- (add-to-history 'regexp-history input)))))
+ (add-to-history (or history 'regexp-history) input)))))
(defalias 'delete-non-matching-lines 'keep-lines)
\f
(defvar occur-menu-map
(let ((map (make-sparse-keymap)))
- (define-key map [next-error-follow-minor-mode]
- `(menu-item ,(purecopy "Auto Occurrence Display")
+ (bindings--define-key map [next-error-follow-minor-mode]
+ '(menu-item "Auto Occurrence Display"
next-error-follow-minor-mode
- :help ,(purecopy
- "Display another occurrence when moving the cursor")
+ :help "Display another occurrence when moving the cursor"
:button (:toggle . (and (boundp 'next-error-follow-minor-mode)
next-error-follow-minor-mode))))
- (define-key map [separator-1] menu-bar-separator)
- (define-key map [kill-this-buffer]
- `(menu-item ,(purecopy "Kill Occur Buffer") kill-this-buffer
- :help ,(purecopy "Kill the current *Occur* buffer")))
- (define-key map [quit-window]
- `(menu-item ,(purecopy "Quit Occur Window") quit-window
- :help ,(purecopy "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame")))
- (define-key map [revert-buffer]
- `(menu-item ,(purecopy "Revert Occur Buffer") revert-buffer
- :help ,(purecopy "Replace the text in the *Occur* buffer with the results of rerunning occur")))
- (define-key map [clone-buffer]
- `(menu-item ,(purecopy "Clone Occur Buffer") clone-buffer
- :help ,(purecopy "Create and return a twin copy of the current *Occur* buffer")))
- (define-key map [occur-rename-buffer]
- `(menu-item ,(purecopy "Rename Occur Buffer") occur-rename-buffer
- :help ,(purecopy "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")))
- (define-key map [occur-edit-buffer]
- `(menu-item ,(purecopy "Edit Occur Buffer") occur-edit-mode
- :help ,(purecopy "Edit the *Occur* buffer and apply changes to the original buffers.")))
- (define-key map [separator-2] menu-bar-separator)
- (define-key map [occur-mode-goto-occurrence-other-window]
- `(menu-item ,(purecopy "Go To Occurrence Other Window") occur-mode-goto-occurrence-other-window
- :help ,(purecopy "Go to the occurrence the current line describes, in another window")))
- (define-key map [occur-mode-goto-occurrence]
- `(menu-item ,(purecopy "Go To Occurrence") occur-mode-goto-occurrence
- :help ,(purecopy "Go to the occurrence the current line describes")))
- (define-key map [occur-mode-display-occurrence]
- `(menu-item ,(purecopy "Display Occurrence") occur-mode-display-occurrence
- :help ,(purecopy "Display in another window the occurrence the current line describes")))
- (define-key map [occur-next]
- `(menu-item ,(purecopy "Move to Next Match") occur-next
- :help ,(purecopy "Move to the Nth (default 1) next match in an Occur mode buffer")))
- (define-key map [occur-prev]
- `(menu-item ,(purecopy "Move to Previous Match") occur-prev
- :help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer")))
+ (bindings--define-key map [separator-1] menu-bar-separator)
+ (bindings--define-key map [kill-this-buffer]
+ '(menu-item "Kill Occur Buffer" kill-this-buffer
+ :help "Kill the current *Occur* buffer"))
+ (bindings--define-key map [quit-window]
+ '(menu-item "Quit Occur Window" quit-window
+ :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"))
+ (bindings--define-key map [revert-buffer]
+ '(menu-item "Revert Occur Buffer" revert-buffer
+ :help "Replace the text in the *Occur* buffer with the results of rerunning occur"))
+ (bindings--define-key map [clone-buffer]
+ '(menu-item "Clone Occur Buffer" clone-buffer
+ :help "Create and return a twin copy of the current *Occur* buffer"))
+ (bindings--define-key map [occur-rename-buffer]
+ '(menu-item "Rename Occur Buffer" occur-rename-buffer
+ :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*."))
+ (bindings--define-key map [occur-edit-buffer]
+ '(menu-item "Edit Occur Buffer" occur-edit-mode
+ :help "Edit the *Occur* buffer and apply changes to the original buffers."))
+ (bindings--define-key map [separator-2] menu-bar-separator)
+ (bindings--define-key map [occur-mode-goto-occurrence-other-window]
+ '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window
+ :help "Go to the occurrence the current line describes, in another window"))
+ (bindings--define-key map [occur-mode-goto-occurrence]
+ '(menu-item "Go To Occurrence" occur-mode-goto-occurrence
+ :help "Go to the occurrence the current line describes"))
+ (bindings--define-key map [occur-mode-display-occurrence]
+ '(menu-item "Display Occurrence" occur-mode-display-occurrence
+ :help "Display in another window the occurrence the current line describes"))
+ (bindings--define-key map [occur-next]
+ '(menu-item "Move to Next Match" occur-next
+ :help "Move to the Nth (default 1) next match in an Occur mode buffer"))
+ (bindings--define-key map [occur-prev]
+ '(menu-item "Move to Previous Match" occur-prev
+ :help "Move to the Nth (default 1) previous match in an Occur mode buffer"))
map)
"Menu keymap for `occur-mode'.")
(define-key map "r" 'occur-rename-buffer)
(define-key map "c" 'clone-buffer)
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
- (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map))
+ (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map))
map)
"Keymap for `occur-mode'.")
(define-key map "\C-c\C-c" 'occur-cease-edit)
(define-key map "\C-o" 'occur-mode-display-occurrence)
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
- (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map))
+ (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map))
map)
"Keymap for `occur-edit-mode'.")
(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
"\\&"
;; Get the regexp for collection pattern.
(let ((default (car occur-collect-regexp-history)))
- (read-string
+ (read-regexp
(format "Regexp to collect (default %s): " default)
- nil 'occur-collect-regexp-history default)))
+ default 'occur-collect-regexp-history)))
;; Otherwise normal occur takes numerical prefix argument.
(when current-prefix-arg
(prefix-numeric-value current-prefix-arg))))))
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))))
(cons
(let* ((default (car regexp-history))
(input
- (read-from-minibuffer
+ (read-regexp
(if current-prefix-arg
"List lines in buffers whose names match regexp: "
- "List lines in buffers whose filenames match regexp: ")
- nil
- nil
- nil
- 'regexp-history)))
+ "List lines in buffers whose filenames match regexp: "))))
(if (equal input "")
default
input))
(define-key map "?" 'help)
(define-key map "\C-g" 'quit)
(define-key map "\C-]" 'quit)
- (define-key map "\e" 'exit-prefix)
+ (define-key map "\C-v" 'scroll-up)
+ (define-key map "\M-v" 'scroll-down)
+ (define-key map [next] 'scroll-up)
+ (define-key map [prior] 'scroll-down)
+ (define-key map [?\C-\M-v] 'scroll-other-window)
+ (define-key map [M-next] 'scroll-other-window)
+ (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
+ (define-key map [M-prior] 'scroll-other-window-down)
+ ;; Binding ESC would prohibit the M-v binding. Instead, callers
+ ;; should check for ESC specially.
+ ;; (define-key map "\e" 'exit-prefix)
(define-key map [escape] 'exit-prefix)
map)
- "Keymap that defines the responses to questions in `query-replace'.
+ "Keymap of responses to questions posed by commands like `query-replace'.
The \"bindings\" in this map are not commands; they are answers.
The valid answers include `act', `skip', `act-and-show',
-`exit', `act-and-exit', `edit', `edit-replacement', `delete-and-edit',
-`recenter', `automatic', `backup', `exit-prefix', `quit', and `help'.")
+`act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up',
+`scroll-down', `scroll-other-window', `scroll-other-window-down',
+`edit', `edit-replacement', `delete-and-edit', `automatic',
+`backup', `quit', and `help'.
+
+This keymap is used by `y-or-n-p' as well as `query-replace'.")
(defvar multi-query-replace-map
(let ((map (make-sparse-keymap)))
(replace-match newtext fixedcase literal)
noedit)
-(defvar replace-search-function 'search-forward
+(defvar replace-search-function nil
"Function to use when searching for strings to replace.
It is used by `query-replace' and `replace-string', and is called
with three arguments, as if it were `search-forward'.")
-(defvar replace-re-search-function 're-search-forward
+(defvar replace-re-search-function nil
"Function to use when searching for regexps to replace.
It is used by `query-replace-regexp', `replace-regexp',
`query-replace-regexp-eval', and `map-query-replace-regexp'.
(nocasify (not (and case-replace case-fold-search)))
(literal (or (not regexp-flag) (eq regexp-flag 'literal)))
(search-function
- (if regexp-flag
- replace-re-search-function
- replace-search-function))
+ (or (if regexp-flag
+ replace-re-search-function
+ replace-search-function)
+ (let ((isearch-regexp regexp-flag)
+ (isearch-word delimited-flag)
+ (isearch-lax-whitespace
+ replace-lax-whitespace)
+ (isearch-regexp-lax-whitespace
+ replace-regexp-lax-whitespace)
+ (isearch-case-fold-search case-fold-search)
+ (isearch-forward t))
+ (isearch-search-fun))))
(search-string from-string)
(real-match-data nil) ; The match data for the current match.
(next-replacement nil)
(vector repeat-count repeat-count
replacements replacements)))))
- (if delimited-flag
- (setq search-function 're-search-forward
- search-string (concat "\\b"
- (if regexp-flag from-string
- (regexp-quote from-string))
- "\\b")))
(when query-replace-lazy-highlight
(setq isearch-lazy-highlight-last-string nil))
(replace-highlight
(nth 0 real-match-data) (nth 1 real-match-data)
start end search-string
- (or delimited-flag regexp-flag) case-fold-search))
+ regexp-flag delimited-flag case-fold-search))
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
(replace-highlight
(match-beginning 0) (match-end 0)
start end search-string
- (or delimited-flag regexp-flag) case-fold-search)
+ regexp-flag delimited-flag case-fold-search)
;; Bind message-log-max so we don't fill up the message log
;; with a bunch of identical messages.
(let ((message-log-max nil)
(if (= replace-count 1) "" "s")))
(or (and keep-going stack) multi-buffer)))
-(defvar isearch-error)
-(defvar isearch-forward)
-(defvar isearch-case-fold-search)
-(defvar isearch-string)
-
(defvar replace-overlay nil)
(defun replace-highlight (match-beg match-end range-beg range-end
- string regexp case-fold)
+ search-string regexp-flag delimited-flag
+ case-fold-search)
(if query-replace-highlight
(if replace-overlay
(move-overlay replace-overlay match-beg match-end (current-buffer))
(overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
(overlay-put replace-overlay 'face 'query-replace)))
(if query-replace-lazy-highlight
- (let ((isearch-string string)
- (isearch-regexp regexp)
- ;; Set isearch-word to nil because word-replace is regexp-based,
- ;; so `isearch-search-fun' should not use `word-search-forward'.
- (isearch-word nil)
- (search-whitespace-regexp nil)
- (isearch-case-fold-search case-fold)
+ (let ((isearch-string search-string)
+ (isearch-regexp regexp-flag)
+ (isearch-word delimited-flag)
+ (isearch-lax-whitespace
+ replace-lax-whitespace)
+ (isearch-regexp-lax-whitespace
+ replace-regexp-lax-whitespace)
+ (isearch-case-fold-search case-fold-search)
(isearch-forward t)
(isearch-error nil))
(isearch-lazy-highlight-new-loop range-beg range-end))))
If `savehist-file' is in the old format that doesn't record
the value of `savehist-minibuffer-history-variables', that
value is deducted from the contents of the file."
+ (declare (obsolete savehist-mode "22.1"))
(savehist-mode 1)
;; Old versions of savehist distributed with XEmacs didn't save
;; savehist-minibuffer-history-variables. If that variable is nil
;; Collect VAR, i.e. (nth form 1).
(push (nth 1 form) vars))
vars)))))
-(make-obsolete 'savehist-load 'savehist-mode "22.1")
(defun savehist-install ()
"Hook savehist into Emacs.
(print-level nil)
(print-readably t)
(print-quoted t))
+ ;; 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.3 release.
+ (dolist (sym savehist-minibuffer-history-variables)
+ (if (and (symbolp sym) (equal (symbol-name sym) "forget-history"))
+ (setq savehist-minibuffer-history-variables
+ (delq sym savehist-minibuffer-history-variables))))
;; Save the minibuffer histories, along with the value of
;; savehist-minibuffer-history-variables itself.
(when savehist-save-minibuffer-history
where it was when you previously visited the same file.
This variable is automatically buffer-local.
-If you wish your place in any file to always be automatically saved,
-simply put this in your `~/.emacs' file:
+If you wish your place in any file to always be automatically
+saved, set this to t using the Customize facility, or put the
+following code in your init file:
\(setq-default save-place t)
-\(require 'saveplace)
-
-or else use the Custom facility to set this option."
+\(require 'saveplace)"
:type 'boolean
:require 'saveplace
:group 'save-place)
If called with a prefix arg, the mode is enabled if and only if
the argument is positive.
-To save places automatically in all files, put this in your `.emacs' file:
+To save places automatically in all files, put this in your init
+file:
\(setq-default save-place t\)"
(interactive "P")
nil " *SL*" nil
:global t
:group 'windows
- :group 'scrolling
(if scroll-all-mode
(add-hook 'post-command-hook 'scroll-all-check-to-scroll)
(remove-hook 'post-command-hook 'scroll-all-check-to-scroll)))
;;; Code:
(require 'mouse)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
\f
;;;; Utilities.
;; If it is set again, that is for real.
(setq scroll-bar-mode-explicit t)
-(defun get-scroll-bar-mode () scroll-bar-mode)
-(defsetf get-scroll-bar-mode set-scroll-bar-mode)
+(defun get-scroll-bar-mode ()
+ (declare (gv-setter set-scroll-bar-mode))
+ scroll-bar-mode)
(define-minor-mode scroll-bar-mode
"Toggle vertical scroll bars on all frames (Scroll Bar mode).
This command applies to all frames that exist and frames to be
created in the future."
- :variable (eq (get-scroll-bar-mode)
- (or previous-scroll-bar-mode
- default-frame-scroll-bars)))
+ :variable ((get-scroll-bar-mode)
+ . (lambda (v) (set-scroll-bar-mode
+ (if v (or previous-scroll-bar-mode
+ default-frame-scroll-bars))))))
(defun toggle-scroll-bar (arg)
"Toggle whether or not the selected frame has vertical scroll bars.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup server nil
"Emacs running as a server process."
(setq val t)
(unless load-in-progress
(message "Local sockets unsupported, using TCP sockets")))
- (when val (random t))
(set-default sym val))
:group 'server
:type 'boolean
;;;###autoload
(put 'server-auth-dir 'risky-local-variable t)
+(defcustom server-auth-key nil
+ "Server authentication key.
+
+Normally, the authentication key is randomly generated when the
+server starts, which guarantees some level of security. It is
+recommended to leave it that way. Using a long-lived shared key
+will decrease security (especially since the key is transmitted as
+plain text).
+
+In some situations however, it can be difficult to share randomly
+generated passwords with remote hosts (eg. no shared directory),
+so you can set the key with this variable and then copy the
+server file to the remote host (with possible changes to IP
+address and/or port if that applies).
+
+The key must consist of 64 ASCII printable characters except for
+space (this means characters from ! to ~; or from code 33 to 126).
+
+You can use \\[server-generate-key] to get a random authentication
+key."
+ :group 'server
+ :type '(choice
+ (const :tag "Random" nil)
+ (string :tag "Password"))
+ :version "24.3")
+
(defcustom server-raise-frame t
"If non-nil, raise frame when switching to a buffer."
:group 'server
See `server-quote-arg' and `server-process-filter'."
(replace-regexp-in-string
"&." (lambda (s)
- (case (aref s 1)
+ (pcase (aref s 1)
(?& "&")
(?- "-")
(?n "\n")
- (t " ")))
+ (_ " ")))
arg t t))
(defun server-quote-arg (arg)
See `server-unquote-arg' and `server-process-filter'."
(replace-regexp-in-string
"[-&\n ]" (lambda (s)
- (case (aref s 0)
+ (pcase (aref s 0)
(?& "&&")
(?- "&-")
(?\n "&n")
(setq dir (directory-file-name dir))
(let ((attrs (file-attributes dir 'integer)))
(unless attrs
- (letf (((default-file-modes) ?\700)) (make-directory dir t))
+ (cl-letf (((default-file-modes) ?\700)) (make-directory dir t))
(setq attrs (file-attributes dir 'integer)))
;; Check that it's safe for use.
(let* ((uid (nth 2 attrs))
(w32 (eq system-type 'windows-nt))
- (safe (catch :safe
- (unless (eq t (car attrs)) ; is a dir?
- (throw :safe nil))
- (when (and w32 (zerop uid)) ; on FAT32?
- (display-warning
- 'server
- (format "Using `%s' to store Emacs-server authentication files.
+ (safe (cond
+ ((not (eq t (car attrs))) nil) ; is a dir?
+ ((and w32 (zerop uid)) ; on FAT32?
+ (display-warning
+ 'server
+ (format "Using `%s' to store Emacs-server authentication files.
Directories on FAT32 filesystems are NOT secure against tampering.
See variable `server-auth-dir' for details."
- (file-name-as-directory dir))
- :warning)
- (throw :safe t))
- (unless (or (= uid (user-uid)) ; is the dir ours?
- (and w32
- ;; Files created on Windows by
- ;; Administrator (RID=500) have
- ;; the Administrators (RID=544)
- ;; group recorded as the owner.
- (= uid 544) (= (user-uid) 500)))
- (throw :safe nil))
- (when w32 ; on NTFS?
- (throw :safe t))
- (unless (zerop (logand ?\077 (file-modes dir)))
- (throw :safe nil))
- t)))
+ (file-name-as-directory dir))
+ :warning)
+ t)
+ ((and (/= uid (user-uid)) ; is the dir ours?
+ (or (not w32)
+ ;; Files created on Windows by Administrator
+ ;; (RID=500) have the Administrators (RID=544)
+ ;; group recorded as the owner.
+ (/= uid 544) (/= (user-uid) 500)))
+ nil)
+ (w32 t) ; on NTFS?
+ (t ; else, check permissions
+ (zerop (logand ?\077 (file-modes dir)))))))
(unless safe
(error "The directory `%s' is unsafe" dir)))))
+(defun server-generate-key ()
+ "Generate and return a random authentication key.
+The key is a 64-byte string of random chars in the range `!'..`~'.
+If called interactively, also inserts it into current buffer."
+ (interactive)
+ (let ((auth-key
+ (cl-loop repeat 64
+ collect (+ 33 (random 94)) into auth
+ finally return (concat auth))))
+ (if (called-interactively-p 'interactive)
+ (insert auth-key))
+ auth-key))
+
+(defun server-get-auth-key ()
+ "Return server's authentication key.
+
+If `server-auth-key' is nil, just call `server-generate-key'.
+Otherwise, if `server-auth-key' is a valid key, return it.
+If the key is not valid, signal an error."
+ (if server-auth-key
+ (if (string-match-p "^[!-~]\\{64\\}$" server-auth-key)
+ server-auth-key
+ (error "The key '%s' is invalid" server-auth-key))
+ (server-generate-key)))
+
;;;###autoload
(defun server-start (&optional leave-dead inhibit-prompt)
"Allow this Emacs process to be a server for client processes.
-This starts a server communications subprocess through which
-client \"editors\" can send your editing commands to this Emacs
-job. To use the server, set up the program `emacsclient' in the
-Emacs distribution as your standard \"editor\".
+This starts a server communications subprocess through which client
+\"editors\" can send your editing commands to this Emacs job.
+To use the server, set up the program `emacsclient' in the Emacs
+distribution as your standard \"editor\".
Optional argument LEAVE-DEAD (interactively, a prefix arg) means just
kill any existing server communications subprocess.
(server-ensure-safe-dir server-dir)
(when server-process
(server-log (message "Restarting server")))
- (letf (((default-file-modes) ?\700))
+ (cl-letf (((default-file-modes) ?\700))
(add-hook 'suspend-tty-functions 'server-handle-suspend-tty)
(add-hook 'delete-frame-functions 'server-handle-delete-frame)
- (add-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)
- (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
+ (add-hook 'kill-buffer-query-functions
+ 'server-kill-buffer-query-function)
+ (add-hook 'kill-emacs-query-functions
+ 'server-kill-emacs-query-function)
(add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit.
(setq server-process
(apply #'make-network-process
(unless server-process (error "Could not start server process"))
(process-put server-process :server-file server-file)
(when server-use-tcp
- (let ((auth-key
- (loop
- ;; The auth key is a 64-byte string of random chars in the
- ;; range `!'..`~'.
- repeat 64
- collect (+ 33 (random 94)) into auth
- finally return (concat auth))))
+ (let ((auth-key (server-get-auth-key)))
(process-put server-process :auth-key auth-key)
(with-temp-file server-file
(set-buffer-multibyte nil)
(select-frame frame)
(process-put proc 'frame frame)
(process-put proc 'terminal (frame-terminal frame))
-
- ;; Display *scratch* by default.
- (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
-
frame))
(defun server-create-window-system-frame (display nowait proc parent-id
(select-frame frame)
(process-put proc 'frame frame)
(process-put proc 'terminal (frame-terminal frame))
-
- ;; Display *scratch* by default.
- (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
frame)))
(defun server-goto-toplevel (proc)
(process-put proc 'continuation nil)
(if continuation (ignore-errors (funcall continuation)))))
-(defun* server-process-filter (proc string)
+(cl-defun server-process-filter (proc string)
"Process a request from the server to edit some files.
PROC is the server process. STRING consists of a sequence of
commands prefixed by a dash. Some commands have arguments;
;; receive the error string and shut down on its own.
(sit-for 1)
(delete-process proc)
- ;; We return immediately
- (return-from server-process-filter)))
+ ;; We return immediately.
+ (cl-return-from server-process-filter)))
(let ((prev (process-get proc 'previous-string)))
(when prev
(setq string (concat prev string))
;; In earlier versions of server.el (where we used an `emacsserver'
;; process), there could be multiple lines. Nowadays this is not
;; supported any more.
- (assert (eq (match-end 0) (length string)))
+ (cl-assert (eq (match-end 0) (length string)))
(let ((request (substring string 0 (match-beginning 0)))
(coding-system (and (default-value 'enable-multibyte-characters)
(or file-name-coding-system
;; -window-system: Open a new X frame.
(`"-window-system"
- (setq dontkill t)
- (setq tty-name 'window-system))
+ (if (fboundp 'x-create-frame)
+ (setq dontkill t
+ tty-name 'window-system)))
;; -resume: Resume a suspended tty frame.
(`"-resume"
(setq dontkill t)
(pop args-left))
- ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client.
+ ;; -tty DEVICE-NAME TYPE: Open a new tty frame.
+ ;; (But if we see -window-system later, use that.)
(`"-tty"
(setq tty-name (pop args-left)
tty-type (pop args-left)
(setq dir (pop args-left))
(if coding-system
(setq dir (decode-coding-string dir coding-system)))
- (setq dir (command-line-normalize-file-name dir)))
+ (setq dir (command-line-normalize-file-name dir))
+ (process-put proc 'server-client-directory dir))
;; Unknown command.
(arg (error "Unknown command: %s" arg))))
;; including code that needs to wait.
(with-local-quit
(condition-case err
- (let* ((buffers
- (when files
- (server-visit-files files proc nowait))))
-
+ (let ((buffers (server-visit-files files proc nowait)))
(mapc 'funcall (nreverse commands))
+ ;; If we were told only to open a new client, obey
+ ;; `initial-buffer-choice' if it specifies a file.
+ (unless (or files commands)
+ (if (stringp initial-buffer-choice)
+ (find-file initial-buffer-choice)
+ (switch-to-buffer (get-buffer-create "*scratch*")
+ 'norecord)))
+
;; Delete the client if necessary.
(cond
(nowait
;;; Code:
(require 'unsafep)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;----------------------------------------------------------------------------
(defgroup ses nil
"Simple Emacs Spreadsheet."
+ :tag "SES"
:group 'applications
:prefix "ses-"
:version "21.1")
ses--numcols ses--numrows ses--symbolic-formulas
ses--data-marker ses--params-marker (ses--Dijkstra-attempt-nb . 0)
ses--Dijkstra-weight-bound
+ ;; This list is useful to speed-up clean-up of symbols when
+ ;; an area containing renamed cell is deleted.
+ ses--renamed-cell-symb-list
;; Global variables that we override
mode-line-process next-line-add-newlines transient-mark-mode)
"Buffer-local variables used by SES.")
"From a CELL or a pair (ROW,COL), get the function that computes its value."
`(aref ,(if col `(ses-get-cell ,row ,col) row) 1))
+(defmacro ses-cell-formula-aset (cell formula)
+ "From a CELL set the function that computes its value."
+ `(aset ,cell 1 ,formula))
+
(defmacro ses-cell-printer (row &optional col)
"From a CELL or a pair (ROW,COL), get the function that prints its value."
`(aref ,(if col `(ses-get-cell ,row ,col) row) 2))
functions refer to its value."
`(aref ,(if col `(ses-get-cell ,row ,col) row) 3))
+(defmacro ses-cell-references-aset (cell references)
+ "From a CELL set the list REFERENCES of symbols for cells the
+function of which refer to its value."
+ `(aset ,cell 3 ,references))
+
+(defun ses-cell-p (cell)
+ "Return non `nil' is CELL is a cell of current buffer."
+ (and (vectorp cell)
+ (= (length cell) 5)
+ (eq cell (let ((rowcol (ses-sym-rowcol (ses-cell-symbol cell))))
+ (and (consp rowcol)
+ (ses-get-cell (car rowcol) (cdr rowcol)))))))
+
(defun ses-cell-property-get-fun (property-name cell)
;; To speed up property fetching, each time a property is found it is placed
;; in the first position. This way, after the first get, the full property
(put sym 'ses-cell (cons xrow xcol))
(make-local-variable sym)))))
+(defun ses-create-cell-variable (sym row col)
+ "Create a buffer-local variable `SYM' for cell at position (ROW, COL).
+
+SYM is the symbol for that variable, ROW and COL are integers for
+row and column of the cell, with numbering starting from 0.
+
+Return nil in case of failure."
+ (unless (local-variable-p sym)
+ (make-local-variable sym)
+ (put sym 'ses-cell (cons row col))))
+
;; We do not delete the ses-cell properties for the cell-variables, in
;; case a formula that refers to this cell is in the kill-ring and is
;; later pasted back in.
(let (sym)
(dotimes (row (1+ (- maxrow minrow)))
(dotimes (col (1+ (- maxcol mincol)))
- (setq sym (ses-create-cell-symbol (+ row minrow) (+ col mincol)))
+ (let ((xrow (+ row minrow)) (xcol (+ col mincol)))
+ (setq sym (if (and (< xrow ses--numrows) (< xcol ses--numcols))
+ (ses-cell-symbol xrow xcol)
+ (ses-create-cell-symbol xrow xcol))))
(if (boundp sym)
(push `(apply ses-set-with-undo ,sym ,(symbol-value sym))
buffer-undo-list))
;; The data area
;;----------------------------------------------------------------------------
-(defun ses-narrowed-p () (/= (- (point-max) (point-min)) (buffer-size)))
-
(defun ses-widen ()
"Turn off narrowing, to be reenabled at end of command loop."
- (if (ses-narrowed-p)
+ (if (buffer-narrowed-p)
(setq ses--deferred-narrow t))
(widen))
Sets `ses-relocate-return' to 'delete if cell-references were removed."
(let (rowcol result)
(if (or (atom formula) (eq (car formula) 'quote))
- (if (setq rowcol (ses-sym-rowcol formula))
+ (if (and (setq rowcol (ses-sym-rowcol formula))
+ (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name formula)))
(ses-relocate-symbol formula rowcol
startrow startcol rowincr colincr)
formula) ; Pass through as-is.
(funcall field (ses-sym-rowcol min))))
;; This range has changed size.
(setq ses-relocate-return 'range))
- `(ses-range ,min ,max ,@(cdddr range)))))
+ `(ses-range ,min ,max ,@(cl-cdddr range)))))
(defun ses-relocate-all (minrow mincol rowincr colincr)
"Alter all cell values, symbols, formulas, and reference-lists to relocate
the rectangle (MINROW,MINCOL)..(NUMROWS,NUMCOLS) by adding ROWINCR and COLINCR
to each symbol."
(let (reform)
- (let (mycell newval)
+ (let (mycell newval xrow)
(dotimes-with-progress-reporter
(row ses--numrows) "Relocating formulas..."
(dotimes (col ses--numcols)
(setq ses-relocate-return nil
mycell (ses-get-cell row col)
newval (ses-relocate-formula (ses-cell-formula mycell)
- minrow mincol rowincr colincr))
+ minrow mincol rowincr colincr)
+ xrow (- row rowincr))
(ses-set-cell row col 'formula newval)
(if (eq ses-relocate-return 'range)
;; This cell contains a (ses-range X Y) where a cell has been
minrow mincol rowincr colincr))
(ses-set-cell row col 'references newval)
(and (>= row minrow) (>= col mincol)
- (ses-set-cell row col 'symbol
- (ses-create-cell-symbol row col))))))
+ (let ((sym (ses-cell-symbol row col))
+ (xcol (- col colincr)))
+ (if (and
+ sym
+ (>= xrow 0)
+ (>= xcol 0)
+ (null (eq sym
+ (ses-create-cell-symbol xrow xcol))))
+ ;; This is a renamed cell, do not update the cell
+ ;; name, but just update the coordinate property.
+ (put sym 'ses-cell (cons row col))
+ (ses-set-cell row col 'symbol
+ (setq sym (ses-create-cell-symbol row col)))
+ (unless (and (boundp sym) (local-variable-p sym))
+ (set (make-local-variable sym) nil)
+ (put sym 'ses-cell (cons row col)))))) )))
;; Relocate the cell values.
(let (oldval myrow mycol xrow xcol)
(cond
(setq mycol (+ col mincol)
xrow (- myrow rowincr)
xcol (- mycol colincr))
- (if (and (< xrow ses--numrows) (< xcol ses--numcols))
- (setq oldval (ses-cell-value xrow xcol))
- ;; Cell is off the end of the array.
- (setq oldval (symbol-value (ses-create-cell-symbol xrow xcol))))
- (ses-set-cell myrow mycol 'value oldval))))
+ (let ((sym (ses-cell-symbol myrow mycol))
+ (xsym (ses-create-cell-symbol xrow xcol)))
+ ;; Make the value relocation only when if the cell is not
+ ;; a renamed cell. Otherwise this is not needed.
+ (and (eq sym xsym)
+ (ses-set-cell myrow mycol 'value
+ (if (and (< xrow ses--numrows) (< xcol ses--numcols))
+ (ses-cell-value xrow xcol)
+ ;;Cell is off the end of the array
+ (symbol-value xsym))))))))
+
((and (wholenump rowincr) (wholenump colincr))
;; Insertion of rows and/or columns. Run the loop backwards.
(let ((disty (1- ses--numrows))
(message "Upgrading from SES-1 file format")))
(or (= ses--file-format 2)
(error "This file needs a newer version of the SES library code"))
- (ses-create-cell-variable-range 0 (1- ses--numrows) 0 (1- ses--numcols))
;; Initialize cell array.
(setq ses--cells (make-vector ses--numrows nil))
(dotimes (row ses--numrows)
(dotimes (row ses--numrows)
(dotimes (col ses--numcols)
(let* ((x (read (current-buffer)))
- (rowcol (ses-sym-rowcol (car-safe (cdr-safe x)))))
+ (sym (car-safe (cdr-safe x))))
(or (and (looking-at "\n")
(eq (car-safe x) 'ses-cell)
- (eq row (car rowcol))
- (eq col (cdr rowcol)))
+ (ses-create-cell-variable sym row col))
(error "Cell-def error"))
(eval x)))
(or (looking-at "\n\n")
;; do the narrowing.
(narrow-to-region (point-min) ses--data-marker)
(setq ses--deferred-narrow nil))
- ;; Update the modeline.
+ ;; Update the mode line.
(let ((oldcell ses--curcell))
(ses-set-curcell)
(unless (eq ses--curcell oldcell)
(mouse-set-point event)
(ses-insert-ses-range))
+(defun ses-replace-name-in-formula (formula old-name new-name)
+ (let ((new-formula formula))
+ (unless (and (consp formula)
+ (eq (car-safe formula) 'quote))
+ (while formula
+ (let ((elt (car-safe formula)))
+ (cond
+ ((consp elt)
+ (setcar formula (ses-replace-name-in-formula elt old-name new-name)))
+ ((and (symbolp elt)
+ (eq (car-safe formula) old-name))
+ (setcar formula new-name))))
+ (setq formula (cdr formula))))
+ new-formula))
+
+(defun ses-rename-cell (new-name &optional cell)
+ "Rename current cell."
+ (interactive "*SEnter new name: ")
+ (and (local-variable-p new-name)
+ (ses-sym-rowcol new-name)
+ ;; this test is needed because ses-cell property of deleted cells
+ ;; is not deleted in case of subsequent undo
+ (memq new-name ses--renamed-cell-symb-list)
+ (error "Already a cell name"))
+ (and (boundp new-name)
+ (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? "
+ new-name)))
+ (error "Already a bound cell name"))
+ (let* ((sym (if (ses-cell-p cell)
+ (ses-cell-symbol cell)
+ (setq cell nil)
+ (ses-check-curcell)
+ ses--curcell))
+ (rowcol (ses-sym-rowcol sym))
+ (row (car rowcol))
+ (col (cdr rowcol)))
+ (setq cell (or cell (ses-get-cell row col)))
+ (push `(ses-rename-cell ,(ses-cell-symbol cell) ,cell) buffer-undo-list)
+ (put new-name 'ses-cell rowcol)
+ ;; replace name by new name in formula of cells refering to renamed cell
+ (dolist (ref (ses-cell-references cell))
+ (let* ((x (ses-sym-rowcol ref))
+ (xcell (ses-get-cell (car x) (cdr x))))
+ (ses-cell-formula-aset xcell
+ (ses-replace-name-in-formula
+ (ses-cell-formula xcell)
+ sym
+ new-name))))
+ ;; replace name by new name in reference list of cells to which renamed cell refers to
+ (dolist (ref (ses-formula-references (ses-cell-formula cell)))
+ (let* ((x (ses-sym-rowcol ref))
+ (xcell (ses-get-cell (car x) (cdr x))))
+ (ses-cell-references-aset xcell
+ (cons new-name (delq sym
+ (ses-cell-references xcell))))))
+ (push new-name ses--renamed-cell-symb-list)
+ (set new-name (symbol-value sym))
+ (aset cell 0 new-name)
+ (put sym 'ses-cell nil)
+ (makunbound sym)
+ (setq sym new-name)
+ (let* ((pos (point))
+ (inhibit-read-only t)
+ (col (current-column))
+ (end (save-excursion
+ (move-to-column (1+ col))
+ (if (eolp)
+ (+ pos (ses-col-width col) 1)
+ (point)))))
+ (put-text-property pos end 'intangible new-name))
+ ;; update mode line
+ (setq mode-line-process (list " cell "
+ (symbol-name sym)))
+ (force-mode-line-update)))
;;----------------------------------------------------------------------------
;; Checking formulas for safety
(push result-row result)
(while rest
(let ((x (pop rest)))
- (case x
- ((>v) (setq transpose nil reorient-x nil reorient-y nil))
- ((>^)(setq transpose nil reorient-x nil reorient-y t))
- ((<^)(setq transpose nil reorient-x t reorient-y t))
- ((<v)(setq transpose nil reorient-x t reorient-y nil))
- ((v>)(setq transpose t reorient-x nil reorient-y t))
- ((^>)(setq transpose t reorient-x nil reorient-y nil))
- ((^<)(setq transpose t reorient-x t reorient-y nil))
- ((v<)(setq transpose t reorient-x t reorient-y t))
- ((* *2 *1) (setq vectorize x))
- ((!) (setq clean 'ses--clean-!))
- ((_) (setq clean `(lambda (&rest x) (ses--clean-_ x ,(if rest (pop rest) 0)))))
- (t
+ (pcase x
+ (`>v (setq transpose nil reorient-x nil reorient-y nil))
+ (`>^ (setq transpose nil reorient-x nil reorient-y t))
+ (`<^ (setq transpose nil reorient-x t reorient-y t))
+ (`<v (setq transpose nil reorient-x t reorient-y nil))
+ (`v> (setq transpose t reorient-x nil reorient-y t))
+ (`^> (setq transpose t reorient-x nil reorient-y nil))
+ (`^< (setq transpose t reorient-x t reorient-y nil))
+ (`v< (setq transpose t reorient-x t reorient-y t))
+ ((or `* `*2 `*1) (setq vectorize x))
+ (`! (setq clean 'ses--clean-!))
+ (`_ (setq clean `(lambda (&rest x)
+ (ses--clean-_ x ,(if rest (pop rest) 0)))))
+ (_
(cond
; shorthands one row
((and (null (cddr result)) (memq x '(> <)))
(setq iter (cdr iter))))
(setq result ret)))
- (flet ((vectorize-*1
- (clean result)
- (cons clean (cons (quote 'vec) (apply 'append result))))
- (vectorize-*2
- (clean result)
- (cons clean (cons (quote 'vec) (mapcar (lambda (x)
- (cons clean (cons (quote 'vec) x)))
- result)))))
- (case vectorize
- ((nil) (cons clean (apply 'append result)))
- ((*1) (vectorize-*1 clean result))
- ((*2) (vectorize-*2 clean result))
- ((*) (if (cdr result)
- (vectorize-*2 clean result)
- (vectorize-*1 clean result)))))))
+ (cl-flet ((vectorize-*1
+ (clean result)
+ (cons clean (cons (quote 'vec) (apply 'append result))))
+ (vectorize-*2
+ (clean result)
+ (cons clean (cons (quote 'vec)
+ (mapcar (lambda (x)
+ (cons clean (cons (quote 'vec) x)))
+ result)))))
+ (pcase vectorize
+ (`nil (cons clean (apply 'append result)))
+ (`*1 (vectorize-*1 clean result))
+ (`*2 (vectorize-*2 clean result))
+ (`* (funcall (if (cdr result)
+ #'vectorize-*2
+ #'vectorize-*1)
+ clean result))))))
(defun ses-delete-blanks (&rest args)
"Return ARGS reversed, with the blank elements (nil and *skip*) removed."
;; YOUR .EMACS FILE
;;=============================================================================
-;; Some suggestions for your .emacs file.
+;; Some suggestions for your init file.
;;
;; ;; Define M-# to run some strange command:
;; (eval-after-load "shell"
;;; Code:
-(eval-when-compile (require 'cl))
(require 'comint)
(require 'pcomplete)
The pattern should probably not match more than one line. If it does,
Shell mode may become confused trying to distinguish prompt from input
-on lines which don't start with a prompt.
-
-This is a fine thing to set in your `.emacs' file."
+on lines which don't start with a prompt."
:type 'regexp
:group 'shell)
"List of suffixes to be disregarded during file/command completion.
This variable is used to initialize `comint-completion-fignore' in the shell
buffer. The default is nil, for compatibility with most shells.
-Some people like (\"~\" \"#\" \"%\").
-
-This is a fine thing to set in your `.emacs' file."
+Some people like (\"~\" \"#\" \"%\")."
:type '(repeat (string :tag "Suffix"))
:group 'shell)
shell buffer. The value may depend on the operating system or shell."
:type '(choice (const nil)
(repeat :tag "List of characters" character))
- ;; Reverted.
-;; :version "24.1" ; changed to nil (bug#8027)
:group 'shell)
-(defvar shell-file-name-chars
+(defcustom shell-file-name-chars
(if (memq system-type '(ms-dos windows-nt cygwin))
"~/A-Za-z0-9_^$!#%&{}@`'.,:()-"
"[]~/A-Za-z0-9+@:_.$#%,={}-")
"String of characters valid in a file name.
This variable is used to initialize `comint-file-name-chars' in the
-shell buffer. The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
+shell buffer. The value may depend on the operating system or shell."
+ :type 'string
+ :group 'shell)
-(defvar shell-file-name-quote-list
+(defcustom shell-file-name-quote-list
(if (memq system-type '(ms-dos windows-nt))
nil
(append shell-delimiter-argument-list '(?\s ?$ ?\* ?\! ?\" ?\' ?\` ?\# ?\\)))
"List of characters to quote when in a file name.
This variable is used to initialize `comint-file-name-quote-list' in the
-shell buffer. The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
+shell buffer. The value may depend on the operating system or shell."
+ :type '(repeat character)
+ :group 'shell)
-(defvar shell-dynamic-complete-functions
+(defcustom shell-dynamic-complete-functions
'(comint-c-a-p-replace-by-expanded-history
shell-environment-variable-completion
shell-command-completion
comint-filename-completion)
"List of functions called to perform completion.
This variable is used to initialize `comint-dynamic-complete-functions' in the
-shell buffer.
-
-This is a fine thing to set in your `.emacs' file.")
+shell buffer."
+ :type '(repeat function)
+ :group 'shell)
(defcustom shell-command-regexp "[^;&|\n]+"
"Regexp to match a single command within a pipeline.
;;; Basic Procedures
-(defun shell-parse-pcomplete-arguments ()
+(defun shell--unquote&requote-argument (qstr &optional upos)
+ (unless upos (setq upos 0))
+ (let* ((qpos 0)
+ (dquotes nil)
+ (ustrs '())
+ (re (concat
+ "[\"']"
+ "\\|\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
+ "\\|{\\(?1:[^{}]+\\)}\\)"
+ (when (memq system-type '(ms-dos windows-nt))
+ "\\|%\\(?1:[^\\\\/]*\\)%")
+ (when comint-file-name-quote-list
+ "\\|\\\\\\(.\\)")))
+ (qupos nil)
+ (push (lambda (str end)
+ (push str ustrs)
+ (setq upos (- upos (length str)))
+ (unless (or qupos (> upos 0))
+ (setq qupos (if (< end 0) (- end) (+ upos end))))))
+ match)
+ (while (setq match (string-match re qstr qpos))
+ (funcall push (substring qstr qpos match) match)
+ (cond
+ ((match-beginning 2) (funcall push (match-string 2 qstr) (match-end 0)))
+ ((match-beginning 1) (funcall push (getenv (match-string 1 qstr))
+ (- (match-end 0))))
+ ((eq (aref qstr match) ?\") (setq dquotes (not dquotes)))
+ ((eq (aref qstr match) ?\')
+ (cond
+ (dquotes (funcall push "'" (match-end 0)))
+ ((< match (1+ (length qstr)))
+ (let ((end (string-match "'" qstr (1+ match))))
+ (funcall push (substring qstr (1+ match) end)
+ (or end (length qstr)))))
+ (t nil)))
+ (t (error "Unexpected case in shell--unquote&requote-argument!")))
+ (setq qpos (match-end 0)))
+ (funcall push (substring qstr qpos) (length qstr))
+ (list (mapconcat #'identity (nreverse ustrs) "")
+ qupos #'comint-quote-filename)))
+
+(defun shell--unquote-argument (str)
+ (car (shell--unquote&requote-argument str)))
+(defun shell--requote-argument (upos qstr)
+ ;; See `completion-table-with-quoting'.
+ (let ((res (shell--unquote&requote-argument qstr upos)))
+ (cons (nth 1 res) (nth 2 res))))
+
+(defun shell--parse-pcomplete-arguments ()
"Parse whitespace separated arguments in the current region."
+ ;; FIXME: share code with shell--unquote&requote-argument.
(let ((begin (save-excursion (shell-backward-command 1) (point)))
(end (point))
begins args)
(cond
((match-beginning 3) ;Backslash escape.
(push (cond
- ((null pcomplete-arg-quote-list)
+ ((null comint-file-name-quote-list)
(goto-char (match-beginning 3)) "\\")
((= (match-beginning 3) (match-end 3)) "\\")
(t (match-string 3)))
arg))
((match-beginning 2) ;Double quote.
- (push (if (null pcomplete-arg-quote-list) (match-string 2)
+ (push (if (null comint-file-name-quote-list) (match-string 2)
(replace-regexp-in-string
"\\\\\\(.\\)" "\\1" (match-string 2)))
arg))
shell-file-name-quote-list)
(set (make-local-variable 'comint-dynamic-complete-functions)
shell-dynamic-complete-functions)
+ (setq-local comint-unquote-function #'shell--unquote-argument)
+ (setq-local comint-requote-function #'shell--requote-argument)
(set (make-local-variable 'pcomplete-parse-arguments-function)
- #'shell-parse-pcomplete-arguments)
- (set (make-local-variable 'pcomplete-arg-quote-list)
- comint-file-name-quote-list)
+ #'shell--parse-pcomplete-arguments)
(set (make-local-variable 'pcomplete-termination-string)
(cond ((not comint-completion-addsuffix) "")
((stringp comint-completion-addsuffix)
(variables (mapcar (lambda (x)
(substring x 0 (string-match "=" x)))
process-environment))
- (suffix (case (char-before start) (?\{ "}") (?\( ")") (t ""))))
+ (suffix (pcase (char-before start) (?\{ "}") (?\( ")") (_ ""))))
(list start end variables
:exit-function
(lambda (s finished)
;;; Code:
-(eval-when-compile (require 'cl)) ;For define-minor-mode.
-
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
(define-key map ">" 'end-of-buffer)
(define-key map "<" 'beginning-of-buffer)
(define-key map "g" 'revert-buffer)
- (define-key map "z" 'kill-this-buffer)
map))
(put 'special-mode 'mode-class 'special)
(if (looking-at "^[ \t]*\n\\'")
(delete-region (point) (point-max)))))
+(defcustom delete-trailing-lines t
+ "If non-nil, \\[delete-trailing-whitespace] deletes trailing lines.
+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.3")
+
(defun delete-trailing-whitespace (&optional start end)
- "Delete all the trailing whitespace across the current buffer.
-All whitespace after the last non-whitespace character in a line is deleted.
-This respects narrowing, created by \\[narrow-to-region] and friends.
-A formfeed is not considered whitespace by this function.
-If END is nil, also delete all trailing lines at the end of the buffer.
-If the region is active, only delete whitespace within the region."
+ "Delete trailing whitespace between START and END.
+If called interactively, START and END are the start/end of the
+region if the mark is active, or of the buffer's accessible
+portion if the mark is inactive.
+
+This command deletes whitespace characters after the last
+non-whitespace character in each line between START and END. It
+does not consider formfeed characters to be whitespace.
+
+If this command acts on the entire buffer (i.e. if called
+interactively with the mark inactive, or called from Lisp with
+END nil), it also deletes all trailing lines at the end of the
+buffer if the variable `delete-trailing-lines' is non-nil."
(interactive (progn
(barf-if-buffer-read-only)
(if (use-region-p)
;; Delete trailing empty lines.
(goto-char end-marker)
(when (and (not end)
+ delete-trailing-lines
;; Really the end of buffer.
(save-restriction (widen) (eobp))
(<= (skip-chars-backward "\n") -2))
(concat " in " (buffer-name buffer))
"")))
;; Read the argument, offering that number (if any) as default.
- (list (read-number (format (if default "Goto line%s (%s): "
- "Goto line%s: ")
- buffer-prompt
- default)
- default)
+ (list (read-number (format "Goto line%s: " buffer-prompt)
+ (list default (line-number-at-pos)))
buffer))))
;; Switch to the desired buffer, one way or another.
(if buffer
(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 (if current-prefix-arg
+ (list nil nil current-prefix-arg)
+ (list (region-beginning) (region-end) nil)))
+ (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.
((use-region-p)
(call-interactively 'count-words-region))
(t
- (count-words--message "Buffer" (point-min) (point-max)))))
+ (count-words--buffer-message))))
+
+(defun count-words--buffer-message ()
+ (count-words--message
+ (if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer")
+ (point-min) (point-max)))
(defun count-words--message (str start end)
(let ((lines (count-lines start end))
"M-x ")
obarray 'commandp t nil 'extended-command-history)))
+(defcustom suggest-key-bindings t
+ "Non-nil means show the equivalent key-binding when M-x command has one.
+The value can be a length of time to show the message for.
+If the value is non-nil and not a number, we wait 2 seconds."
+ :group 'keyboard
+ :type '(choice (const :tag "off" nil)
+ (integer :tag "time" 2)
+ (other :tag "on")))
+
+(defun execute-extended-command (prefixarg &optional command-name)
+ ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
+ ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
+ "Read function name, then read its arguments and call it.
+
+To pass a numeric argument to the command you are invoking with, specify
+the numeric argument to this command.
+
+Noninteractively, the argument PREFIXARG is the prefix argument to
+give to the command you invoke, if it asks for an argument."
+ (interactive (list current-prefix-arg (read-extended-command)))
+ ;; Emacs<24 calling-convention was with a single `prefixarg' argument.
+ (if (null command-name) (setq command-name (read-extended-command)))
+ (let* ((function (and (stringp command-name) (intern-soft command-name)))
+ (binding (and suggest-key-bindings
+ (not executing-kbd-macro)
+ (where-is-internal function overriding-local-map t))))
+ (unless (commandp function)
+ (error "`%s' is not a valid command name" command-name))
+ (setq this-command function)
+ ;; Normally `real-this-command' should never be changed, but here we really
+ ;; want to pretend that M-x <cmd> RET is nothing more than a "key
+ ;; binding" for <cmd>, so the command the user really wanted to run is
+ ;; `function' and not `execute-extended-command'. The difference is
+ ;; visible in cases such as M-x <cmd> RET and then C-x z (bug#11506).
+ (setq real-this-command function)
+ (let ((prefix-arg prefixarg))
+ (command-execute function 'record))
+ ;; If enabled, show which key runs this command.
+ (when binding
+ ;; But first wait, and skip the message if there is input.
+ (let* ((waited
+ ;; If this command displayed something in the echo area;
+ ;; wait a few seconds, then display our suggestion message.
+ (sit-for (cond
+ ((zerop (length (current-message))) 0)
+ ((numberp suggest-key-bindings) suggest-key-bindings)
+ (t 2)))))
+ (when (and waited (not (consp unread-command-events)))
+ (with-temp-message
+ (format "You can run the command `%s' with %s"
+ function (key-description binding))
+ (sit-for (if (numberp suggest-key-bindings)
+ suggest-key-bindings
+ 2))))))))
\f
(defvar minibuffer-history nil
"Default minibuffer history list.
(list (if (string= regexp "")
(if minibuffer-history-search-history
(car minibuffer-history-search-history)
- (error "No previous history search regexp"))
+ (user-error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(unless (zerop n)
(setq prevpos pos)
(setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
(when (= pos prevpos)
- (error (if (= pos 1)
- "No later matching history item"
- "No earlier matching history item")))
+ (user-error (if (= pos 1)
+ "No later matching history item"
+ "No earlier matching history item")))
(setq match-string
(if (eq minibuffer-history-sexp-flag (minibuffer-depth))
(let ((print-level nil))
(list (if (string= regexp "")
(if minibuffer-history-search-history
(car minibuffer-history-search-history)
- (error "No previous history search regexp"))
+ (user-error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
(setq minibuffer-text-before-history
(minibuffer-contents-no-properties)))
(if (< nabs minimum)
- (if minibuffer-default
- (error "End of defaults; no next item")
- (error "End of history; no default available")))
+ (user-error (if minibuffer-default
+ "End of defaults; no next item"
+ "End of history; no default available")))
(if (> nabs (length (symbol-value minibuffer-history-variable)))
- (error "Beginning of history; no preceding item"))
+ (user-error "Beginning of history; no preceding item"))
(unless (memq last-command '(next-history-element
previous-history-element))
(let ((prompt-end (minibuffer-prompt-end)))
(defun minibuffer-history-isearch-search ()
"Return the proper search function, for isearch in minibuffer history."
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (t
- (lambda (string bound noerror)
- (let ((search-fun
- ;; Use standard functions to search within minibuffer text
- (cond
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
- found)
- ;; Avoid lazy-highlighting matches in the minibuffer prompt when
- ;; searching forward. Lazy-highlight calls this lambda with the
- ;; bound arg, so skip the minibuffer prompt.
- (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
- (goto-char (minibuffer-prompt-end)))
- (or
- ;; 1. First try searching in the initial minibuffer text
- (funcall search-fun string
- (if isearch-forward bound (minibuffer-prompt-end))
- noerror)
- ;; 2. If the above search fails, start putting next/prev history
- ;; elements in the minibuffer successively, and search the string
- ;; in them. Do this only when bound is nil (i.e. not while
- ;; lazy-highlighting search strings in the current minibuffer text).
- (unless bound
- (condition-case nil
- (progn
- (while (not found)
- (cond (isearch-forward
- (next-history-element 1)
- (goto-char (minibuffer-prompt-end)))
- (t
- (previous-history-element 1)
- (goto-char (point-max))))
- (setq isearch-barrier (point) isearch-opoint (point))
- ;; After putting the next/prev history element, search
- ;; the string in them again, until next-history-element
- ;; or previous-history-element raises an error at the
- ;; beginning/end of history.
- (setq found (funcall search-fun string
- (unless isearch-forward
- ;; For backward search, don't search
- ;; in the minibuffer prompt
- (minibuffer-prompt-end))
- noerror)))
- ;; Return point of the new search result
- (point))
- ;; Return nil when next(prev)-history-element fails
- (error nil)))))))))
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within minibuffer text
+ (isearch-search-fun-default))
+ found)
+ ;; Avoid lazy-highlighting matches in the minibuffer prompt when
+ ;; searching forward. Lazy-highlight calls this lambda with the
+ ;; bound arg, so skip the minibuffer prompt.
+ (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
+ (goto-char (minibuffer-prompt-end)))
+ (or
+ ;; 1. First try searching in the initial minibuffer text
+ (funcall search-fun string
+ (if isearch-forward bound (minibuffer-prompt-end))
+ noerror)
+ ;; 2. If the above search fails, start putting next/prev history
+ ;; elements in the minibuffer successively, and search the string
+ ;; in them. Do this only when bound is nil (i.e. not while
+ ;; lazy-highlighting search strings in the current minibuffer text).
+ (unless bound
+ (condition-case nil
+ (progn
+ (while (not found)
+ (cond (isearch-forward
+ (next-history-element 1)
+ (goto-char (minibuffer-prompt-end)))
+ (t
+ (previous-history-element 1)
+ (goto-char (point-max))))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After putting the next/prev history element, search
+ ;; the string in them again, until next-history-element
+ ;; or previous-history-element raises an error at the
+ ;; beginning/end of history.
+ (setq found (funcall search-fun string
+ (unless isearch-forward
+ ;; For backward search, don't search
+ ;; in the minibuffer prompt
+ (minibuffer-prompt-end))
+ noerror)))
+ ;; Return point of the new search result
+ (point))
+ ;; Return nil when next(prev)-history-element fails
+ (error nil)))))))
(defun minibuffer-history-isearch-message (&optional c-q-hack ellipsis)
"Display the minibuffer history search prompt.
"Wrap the minibuffer history search when search fails.
Move point to the first history element for a forward search,
or to the last history element for a backward search."
- (unless isearch-word
- ;; When `minibuffer-history-isearch-search' fails on reaching the
- ;; beginning/end of the history, wrap the search to the first/last
- ;; minibuffer history element.
- (if isearch-forward
- (goto-history-element (length (symbol-value minibuffer-history-variable)))
- (goto-history-element 0))
- (setq isearch-success t))
+ ;; When `minibuffer-history-isearch-search' fails on reaching the
+ ;; beginning/end of the history, wrap the search to the first/last
+ ;; minibuffer history element.
+ (if isearch-forward
+ (goto-history-element (length (symbol-value minibuffer-history-variable)))
+ (goto-history-element 0))
+ (setq isearch-success t)
(goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))
(defun minibuffer-history-isearch-push-state ()
;; another undo command will find the undo history empty
;; and will get another error. To begin undoing the undos,
;; you must type some other command.
- (let ((modified (buffer-modified-p))
- (recent-save (recent-auto-save-p))
- message)
+ (let* ((modified (buffer-modified-p))
+ ;; For an indirect buffer, look in the base buffer for the
+ ;; auto-save data.
+ (base-buffer (or (buffer-base-buffer) (current-buffer)))
+ (recent-save (with-current-buffer base-buffer
+ (recent-auto-save-p)))
+ message)
;; If we get an error in undo-start,
;; the next command should not be a "consecutive undo".
;; So set `this-command' to something other than `undo'.
;; so, ask the user whether she wants to skip the redo/undo pair.
(let ((equiv (gethash pending-undo-list undo-equiv-table)))
(or (eq (selected-window) (minibuffer-window))
- (setq message (if undo-in-region
- (if equiv "Redo in region!" "Undo in region!")
- (if equiv "Redo!" "Undo!"))))
+ (setq message (format "%s%s!"
+ (if (or undo-no-redo (not equiv))
+ "Undo" "Redo")
+ (if undo-in-region " in region" ""))))
(when (and (consp equiv) undo-no-redo)
;; The equiv entry might point to another redo record if we have done
;; undo-redo-undo-redo-... so skip to the very last equiv.
;; Record what the current undo list says,
;; so the next command can tell if the buffer was modified in between.
(and modified (not (buffer-modified-p))
- (delete-auto-save-file-if-necessary recent-save))
+ (with-current-buffer base-buffer
+ (delete-auto-save-file-if-necessary recent-save)))
;; Display a message announcing success.
(if message
(message "%s" message))))
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or (listp pending-undo-list)
- (error (concat "No further undo information"
- (and undo-in-region " for region"))))
+ (user-error (concat "No further undo information"
+ (and undo-in-region " for region"))))
(let ((undo-in-progress t))
;; Note: The following, while pulling elements off
;; `pending-undo-list' will call primitive change functions which
that apply to text between BEG and END are used; other undo elements
are ignored. If BEG and END are nil, all undo elements are used."
(if (eq buffer-undo-list t)
- (error "No undo information in this buffer"))
+ (user-error "No undo information in this buffer"))
(setq pending-undo-list
(if (and beg end (not (= beg end)))
(undo-make-selective-list (min beg end) (max beg end))
"Switch used to have the shell execute its command line argument.")
(defvar shell-command-default-error-buffer nil
- "*Buffer name for `shell-command' and `shell-command-on-region' error output.
+ "Buffer name for `shell-command' and `shell-command-on-region' error output.
This buffer is used when `shell-command' or `shell-command-on-region'
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
(or hist 'shell-command-history)
args)))
+(defcustom async-shell-command-buffer 'confirm-new-buffer
+ "What to do when the output buffer is used by another shell command.
+This option specifies how to resolve the conflict where a new command
+wants to direct its output to the buffer `*Async Shell Command*',
+but this buffer is already taken by another running shell command.
+
+The value `confirm-kill-process' is used to ask for confirmation before
+killing the already running process and running a new process
+in the same buffer, `confirm-new-buffer' for confirmation before running
+the command in a new buffer with a name other than the default buffer name,
+`new-buffer' for doing the same without confirmation,
+`confirm-rename-buffer' for confirmation before renaming the existing
+output buffer and running a new command in the default buffer,
+`rename-buffer' for doing the same without confirmation."
+ :type '(choice (const :tag "Confirm killing of running command"
+ confirm-kill-process)
+ (const :tag "Confirm creation of a new buffer"
+ confirm-new-buffer)
+ (const :tag "Create a new buffer"
+ new-buffer)
+ (const :tag "Confirm renaming of existing buffer"
+ confirm-rename-buffer)
+ (const :tag "Rename the existing buffer"
+ rename-buffer))
+ :group 'shell
+ :version "24.3")
+
(defun async-shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND asynchronously in background.
-Like `shell-command' but if COMMAND doesn't end in ampersand, adds `&'
-surrounded by whitespace and executes the command asynchronously.
+Like `shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
The output appears in the buffer `*Async Shell Command*'.
+That buffer is in shell mode.
In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of a
(interactive
(list
(read-shell-command "Async shell command: " nil nil
- (and buffer-file-name
- (file-relative-name buffer-file-name)))
+ (let ((filename
+ (cond
+ (buffer-file-name)
+ ((eq major-mode 'dired-mode)
+ (dired-get-filename nil t)))))
+ (and filename (file-relative-name filename))))
current-prefix-arg
shell-command-default-error-buffer))
(unless (string-match "&[ \t]*\\'" command)
"Execute string COMMAND in inferior shell; display output, if any.
With prefix argument, insert the COMMAND's output at point.
-If COMMAND ends in ampersand, execute it asynchronously.
+If COMMAND ends in `&', execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
-That buffer is in shell mode.
+That buffer is in shell mode. You can also use
+`async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously. The output appears in
the buffer `*Shell Command Output*'. If the output is short enough to
proc)
;; Remove the ampersand.
(setq command (substring command 0 (match-beginning 0)))
- ;; If will kill a process, query first.
+ ;; Ask the user what to do with already running process.
(setq proc (get-buffer-process buffer))
- (if proc
- (if (yes-or-no-p "A command is running. Kill it? ")
+ (when proc
+ (cond
+ ((eq async-shell-command-buffer 'confirm-kill-process)
+ ;; If will kill a process, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Kill it? ")
(kill-process proc)
(error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'confirm-new-buffer)
+ ;; If will create a new buffer, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell Command*")))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'new-buffer)
+ ;; It will create a new buffer.
+ (setq buffer (generate-new-buffer
+ (or output-buffer "*Async Shell Command*"))))
+ ((eq async-shell-command-buffer 'confirm-rename-buffer)
+ ;; If will rename the buffer, query first.
+ (if (yes-or-no-p "A command is running in the default buffer. Rename it? ")
+ (progn
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*"))))
+ (error "Shell command in progress")))
+ ((eq async-shell-command-buffer 'rename-buffer)
+ ;; It will rename the buffer.
+ (with-current-buffer buffer
+ (rename-uniquely))
+ (setq buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*"))))))
(with-current-buffer buffer
(setq buffer-read-only nil)
;; Setting buffer-read-only to nil doesn't suffice
falling back to `default-process-coding-system' if no match for COMMAND
is found in `process-coding-system-alist'.
-The noninteractive arguments are START, END, COMMAND,
-OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.
in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
-`resize-mini-windows' is non-nil), it is shown there. Otherwise
-it is displayed in the buffer `*Shell Command Output*'. The output
-is available in that buffer in both cases.
+`resize-mini-windows' is non-nil), it is shown there.
+Otherwise it is displayed in the buffer `*Shell Command Output*'.
+The output is available in that buffer in both cases.
If there is output and an error, a message about the error
-appears at the end of the output.
-
-If there is no output, or if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
-
-If the optional fourth argument OUTPUT-BUFFER is non-nil,
-that says to put the output in some other buffer.
-If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
-If OUTPUT-BUFFER is not a buffer and not nil,
-insert output in the current buffer.
-In either case, the output is inserted after point (leaving mark after it).
-
-If REPLACE, the optional fifth argument, is non-nil, that means insert
-the output in place of text from START to END, putting point and mark
+appears at the end of the output. If there is no output, or if
+output is inserted in the current buffer, the buffer `*Shell
+Command Output*' is deleted.
+
+Optional fourth arg OUTPUT-BUFFER specifies where to put the
+command's output. If the value is a buffer or buffer name, put
+the output there. Any other value, including nil, means to
+insert the output in the current buffer. In either case, the
+output is inserted after point (leaving mark after it).
+
+Optional fifth arg REPLACE, if non-nil, means to insert the
+output in place of text from START to END, putting point and mark
around it.
-If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
-or buffer name to which to direct the command's standard error output.
-If it is nil, error output is mingled with regular output.
-If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
-were any errors. (This is always t, interactively.)
-In an interactive call, the variable `shell-command-default-error-buffer'
-specifies the value of ERROR-BUFFER."
+Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer
+or buffer name to which to direct the command's standard error
+output. If nil, error output is mingled with regular output.
+When called interactively, `shell-command-default-error-buffer'
+is used for ERROR-BUFFER.
+
+Optional seventh arg DISPLAY-ERROR-BUFFER, if non-nil, means to
+display the error buffer if there were any errors. When called
+interactively, this is t."
(interactive (let (string)
(unless (mark)
(error "The mark is not set now, so there is no region"))
"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)"
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)
(defvar interprogram-cut-function nil
"Function to call to make a killed region available to other programs.
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls whenever text
-is put in the kill ring, to make the new kill available to other
-programs.
-
-The function takes one argument, TEXT, which is a string containing
-the text which should be made available.")
+This variable holds a function that Emacs calls whenever text is
+put in the kill ring, to make the new kill available to other
+programs. The function takes one argument, TEXT, which is a
+string containing the text which should be made available.")
(defvar interprogram-paste-function nil
"Function to call to get text cut from other programs.
-
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls to obtain
-text that other programs have provided for pasting.
-
-The function should be called with no arguments. If the function
-returns nil, then no other program has provided such text, and the top
-of the Emacs kill ring should be used. If the function returns a
-string, then the caller of the function \(usually `current-kill')
-should put this string in the kill ring as the latest kill.
-
-This function may also return a list of strings if the window
+Most window systems provide a facility for cutting and pasting
+text between different programs, such as the clipboard on X and
+MS-Windows, or the pasteboard on Nextstep/Mac OS.
+
+This variable holds a function that Emacs calls to obtain text
+that other programs have provided for pasting. The function is
+called with no arguments. If no other program has provided text
+to paste, the function should return nil (in which case the
+caller, usually `current-kill', should use the top of the Emacs
+kill ring). If another program has provided text to paste, the
+function should return that text as a string (in which case the
+caller should put this string in the kill ring as the latest
+kill).
+
+The function may also return a list of strings if the window
system supports multiple selections. The first string will be
-used as the pasted text, but the other will be placed in the
-kill ring for easy access via `yank-pop'.
-
-Note that the function should return a string only if a program other
-than Emacs has provided a string for pasting; if Emacs provided the
-most recent string, the function should return nil. If it is
-difficult to tell whether Emacs or some other program provided the
-current string, it is probably good enough to return nil if the string
-is equal (according to `string=') to the last text Emacs provided.")
+used as the pasted text, but the other will be placed in the kill
+ring for easy access via `yank-pop'.
+
+Note that the function should return a string only if a program
+other than Emacs has provided a string for pasting; if Emacs
+provided the most recent string, the function should return nil.
+If it is difficult to tell whether Emacs or some other program
+provided the current string, it is probably good enough to return
+nil if the string is equal (according to `string=') to the last
+text Emacs provided.")
\f
(set-advertised-calling-convention 'kill-append '(string before-p) "23.3")
(defcustom yank-pop-change-selection nil
- "If non-nil, rotating the kill ring changes the window system selection."
+ "Whether rotating the kill ring changes the window system selection.
+If non-nil, whenever the kill ring is rotated (usually via the
+`yank-pop' command), Emacs also calls `interprogram-cut-function'
+to copy the new kill to the window system selection."
:type 'boolean
:group 'killing
:version "23.1")
:type 'boolean
:group 'killing)
-(put 'text-read-only 'error-conditions
- '(text-read-only buffer-read-only error))
-(put 'text-read-only 'error-message (purecopy "Text is read-only"))
-
(defun kill-region (beg end &optional yank-handler)
"Kill (\"cut\") text between point and mark.
This deletes the text from the buffer and saves it in the kill ring.
visual feedback indicating the extent of the region being copied."
(interactive "r")
(copy-region-as-kill beg end)
- ;; This use of called-interactively-p is correct
- ;; because the code it controls just gives the user visual feedback.
+ ;; This use of called-interactively-p is correct because the code it
+ ;; controls just gives the user visual feedback.
(if (called-interactively-p 'interactive)
- (let ((other-end (if (= (point) beg) end beg))
- (opoint (point))
- ;; Inhibit quitting so we can make a quit here
- ;; look like a C-g typed as a command.
- (inhibit-quit t))
- (if (pos-visible-in-window-p other-end (selected-window))
- ;; Swap point-and-mark quickly so as to show the region that
- ;; was selected. Don't do it if the region is highlighted.
- (unless (and (region-active-p)
- (face-background 'region))
- ;; Swap point and mark.
- (set-marker (mark-marker) (point) (current-buffer))
- (goto-char other-end)
- (sit-for blink-matching-delay)
- ;; Swap back.
- (set-marker (mark-marker) other-end (current-buffer))
- (goto-char opoint)
- ;; If user quit, deactivate the mark
- ;; as C-g would as a command.
- (and quit-flag mark-active
- (deactivate-mark)))
- (let* ((killed-text (current-kill 0))
- (message-len (min (length killed-text) 40)))
- (if (= (point) beg)
- ;; Don't say "killed"; that is misleading.
- (message "Saved text until \"%s\""
- (substring killed-text (- message-len)))
- (message "Saved text from \"%s\""
- (substring killed-text 0 message-len))))))))
+ (indicate-copied-region)))
+
+(defun indicate-copied-region (&optional message-len)
+ "Indicate that the region text has been copied interactively.
+If the mark is visible in the selected window, blink the cursor
+between point and mark if there is currently no active region
+highlighting.
+
+If the mark lies outside the selected window, display an
+informative message containing a sample of the copied text. The
+optional argument MESSAGE-LEN, if non-nil, specifies the length
+of this sample text; it defaults to 40."
+ (let ((mark (mark t))
+ (point (point))
+ ;; Inhibit quitting so we can make a quit here
+ ;; look like a C-g typed as a command.
+ (inhibit-quit t))
+ (if (pos-visible-in-window-p mark (selected-window))
+ ;; Swap point-and-mark quickly so as to show the region that
+ ;; was selected. Don't do it if the region is highlighted.
+ (unless (and (region-active-p)
+ (face-background 'region))
+ ;; Swap point and mark.
+ (set-marker (mark-marker) (point) (current-buffer))
+ (goto-char mark)
+ (sit-for blink-matching-delay)
+ ;; Swap back.
+ (set-marker (mark-marker) mark (current-buffer))
+ (goto-char point)
+ ;; If user quit, deactivate the mark
+ ;; as C-g would as a command.
+ (and quit-flag mark-active
+ (deactivate-mark)))
+ (let ((len (min (abs (- mark point))
+ (or message-len 40))))
+ (if (< point mark)
+ ;; Don't say "killed"; that is misleading.
+ (message "Saved text until \"%s\""
+ (buffer-substring-no-properties (- mark len) mark))
+ (message "Saved text from \"%s\""
+ (buffer-substring-no-properties mark (+ mark len))))))))
(defun append-next-kill (&optional interactive)
"Cause following command, if it kills, to append to previous kill.
\f
;; Yanking.
+(defcustom yank-handled-properties
+ '((font-lock-face . yank-handle-font-lock-face-property)
+ (category . yank-handle-category-property))
+ "List of special text property handling conditions for yanking.
+Each element should have the form (PROP . FUN), where PROP is a
+property symbol and FUN is a function. When the `yank' command
+inserts text into the buffer, it scans the inserted text for
+stretches of text that have `eq' values of the text property
+PROP; for each such stretch of text, FUN is called with three
+arguments: the property's value in that text, and the start and
+end positions of the text.
+
+This is done prior to removing the properties specified by
+`yank-excluded-properties'."
+ :group 'killing
+ :version "24.3")
+
;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
- '(read-only invisible intangible field mouse-face help-echo local-map keymap
- yank-handler follow-link fontified)
+ '(category field follow-link fontified font-lock-face help-echo
+ intangible invisible keymap local-map mouse-face read-only
+ yank-handler)
"Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
-which means to discard all text properties."
+which means to discard all text properties.
+
+See also `yank-handled-properties'."
:type '(choice (const :tag "All" t) (repeat symbol))
:group 'killing
- :version "22.1")
+ :version "24.3")
(defvar yank-window-start nil)
(defvar yank-undo-function nil
(defun yank (&optional arg)
"Reinsert (\"paste\") the last stretch of killed text.
-More precisely, reinsert the stretch of killed text most recently
-killed OR yanked. Put point at end, and set mark at beginning.
-With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
-With argument N, reinsert the Nth most recently killed stretch of killed
-text.
+More precisely, reinsert the most recent kill, which is the
+stretch of killed text most recently killed OR yanked. Put point
+at the end, and set mark at the beginning without activating it.
+With just \\[universal-argument] as argument, put point at beginning, and mark at end.
+With argument N, reinsert the Nth most recent kill.
-When this command inserts killed text into the buffer, it honors
-`yank-excluded-properties' and `yank-handler' as described in the
-doc string for `insert-for-yank-1', which see.
+When this command inserts text into the buffer, it honors the
+`yank-handled-properties' and `yank-excluded-properties'
+variables, and the `yank-handler' text property. See
+`insert-for-yank-1' for details.
See also the command `yank-pop' (\\[yank-pop])."
(interactive "*P")
"Kill up to and including ARGth occurrence of CHAR.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found."
- (interactive "p\ncZap to char: ")
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ (read-char "Zap to char: " t)))
;; Avoid "obsolete" warnings for translation-table-for-input.
(with-no-warnings
(if (char-table-p translation-table-for-input)
(setq char (or (aref translation-table-for-input char) char))))
(kill-region (point) (progn
(search-forward (char-to-string char) nil nil arg)
-; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
(point))))
;; kill-line and its subroutines.
(cond (saved-region-selection
(x-set-selection 'PRIMARY saved-region-selection)
(setq saved-region-selection nil))
- ((/= (region-beginning) (region-end))
+ ;; If another program has acquired the selection, region
+ ;; deactivation should not clobber it (Bug#11772).
+ ((and (/= (region-beginning) (region-end))
+ (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)
;; a cleaner solution to the problem of making C-n do something
;; useful given a tall image.
(defun line-move (arg &optional noerror to-end try-vscroll)
- (unless (and auto-window-vscroll try-vscroll
- ;; Only vscroll for single line moves
- (= (abs arg) 1)
- ;; But don't vscroll in a keyboard macro.
- (not defining-kbd-macro)
- (not executing-kbd-macro)
- (line-move-partial arg noerror to-end))
- (set-window-vscroll nil 0 t)
- (if (and line-move-visual
- ;; Display-based column are incompatible with goal-column.
- (not goal-column)
- ;; When the text in the window is scrolled to the left,
- ;; display-based motion doesn't make sense (because each
- ;; logical line occupies exactly one screen line).
- (not (> (window-hscroll) 0)))
- (line-move-visual arg noerror)
- (line-move-1 arg noerror to-end))))
+ (if noninteractive
+ (forward-line arg)
+ (unless (and auto-window-vscroll try-vscroll
+ ;; Only vscroll for single line moves
+ (= (abs arg) 1)
+ ;; But don't vscroll in a keyboard macro.
+ (not defining-kbd-macro)
+ (not executing-kbd-macro)
+ (line-move-partial arg noerror to-end))
+ (set-window-vscroll nil 0 t)
+ (if (and line-move-visual
+ ;; Display-based column are incompatible with goal-column.
+ (not goal-column)
+ ;; When the text in the window is scrolled to the left,
+ ;; display-based motion doesn't make sense (because each
+ ;; logical line occupies exactly one screen line).
+ (not (> (window-hscroll) 0)))
+ (line-move-visual arg noerror)
+ (line-move-1 arg noerror to-end)))))
;; Display-based alternative to line-move-1.
;; Arg says how many lines to move. The value is t if we can move the
t)))
(defvar comment-line-break-function 'comment-indent-new-line
- "*Mode-specific function which line breaks and continues a comment.
+ "Mode-specific function which line breaks and continues a comment.
This function is called during auto-filling when a comment syntax
is defined.
The function should take a single optional argument, which is a flag
The value of `normal-auto-fill-function' specifies the function to use
for `auto-fill-function' when turning Auto Fill mode on."
- :variable (eq auto-fill-function normal-auto-fill-function))
+ :variable (auto-fill-function
+ . (lambda (v) (setq auto-fill-function
+ (if v normal-auto-fill-function)))))
;; This holds a document string used to document auto-fill-mode.
(defun auto-fill-function ()
filled in. \\[quoted-insert] still inserts characters in
overwrite mode; this is supposed to make it easier to insert
characters when necessary."
- :variable (eq overwrite-mode 'overwrite-mode-textual))
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-textual)))))
(define-minor-mode binary-overwrite-mode
"Toggle Binary Overwrite mode.
Note that Binary Overwrite mode is not its own minor mode; it is
a specialization of overwrite mode, entered by setting the
`overwrite-mode' variable to `overwrite-mode-binary'."
- :variable (eq overwrite-mode 'overwrite-mode-binary))
+ :variable (overwrite-mode
+ . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-binary)))))
(define-minor-mode line-number-mode
"Toggle line number display in the mode line (Line Number mode).
With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive
(let* ((default-var (variable-at-point))
- (var (if (user-variable-p default-var)
+ (var (if (custom-variable-p default-var)
(read-variable (format "Set variable (default %s): " default-var)
default-var)
(read-variable "Set variable: ")))
(setq beg (previous-single-property-change beg 'mouse-face))
(setq end (or (next-single-property-change end 'mouse-face)
(point-max)))
- (buffer-substring-no-properties beg end))))
- (owindow (selected-window)))
+ (buffer-substring-no-properties beg end)))))
(unless (buffer-live-p buffer)
(error "Destination buffer is dead"))
- (select-window (posn-window (event-start event)))
- (if (and (one-window-p t 'selected-frame)
- (window-dedicated-p (selected-window)))
- ;; This is a special buffer's frame
- (iconify-frame (selected-frame))
- (or (window-dedicated-p (selected-window))
- (bury-buffer)))
- (select-window
- (or (get-buffer-window buffer 0)
- owindow))
+ (quit-window nil (posn-window (event-start event)))
(with-current-buffer buffer
(choose-completion-string
(point))))
(defun choose-completion-delete-max-match (string)
+ (declare (obsolete choose-completion-guess-base-position "23.2"))
(delete-region (choose-completion-guess-base-position string) (point)))
-(make-obsolete 'choose-completion-delete-max-match
- 'choose-completion-guess-base-position "23.2")
(defvar choose-completion-string-functions nil
"Functions that may override the normal insertion of a completion choice.
"Finish setup of the completions buffer.
Called from `temp-buffer-show-hook'."
(when (eq major-mode 'completion-list-mode)
- (toggle-read-only 1)))
+ (setq buffer-read-only t)))
(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
have both Backspace, Delete and F1 keys.
See also `normal-erase-is-backspace'."
- :variable (eq (terminal-parameter
- nil 'normal-erase-is-backspace) 1)
+ :variable ((eq (terminal-parameter nil 'normal-erase-is-backspace) 1)
+ . (lambda (v)
+ (setf (terminal-parameter nil 'normal-erase-is-backspace)
+ (if v 1 0))))
(let ((enabled (eq 1 (terminal-parameter
nil 'normal-erase-is-backspace))))
(defvar vis-mode-saved-buffer-invisibility-spec nil
"Saved value of `buffer-invisibility-spec' when Visible mode is on.")
+(define-minor-mode read-only-mode
+ "Change whether the current buffer is read-only.
+With prefix argument ARG, make the buffer read-only if ARG is
+positive, otherwise make it writable. If buffer is read-only
+and `view-read-only' is non-nil, enter view mode.
+
+Do not call this from a Lisp program unless you really intend to
+do the same thing as the \\[read-only-mode] command, including
+possibly enabling or disabling View mode. Also, note that this
+command works by setting the variable `buffer-read-only', which
+does not affect read-only regions caused by text properties. To
+ignore read-only status in a Lisp program (whether due to text
+properties or buffer state), bind `inhibit-read-only' temporarily
+to a non-nil value."
+ :variable buffer-read-only
+ (cond
+ ((and (not buffer-read-only) view-mode)
+ (View-exit-and-edit)
+ (make-local-variable 'view-read-only)
+ (setq view-read-only t)) ; Must leave view mode.
+ ((and buffer-read-only view-read-only
+ ;; If view-mode is already active, `view-mode-enter' is a nop.
+ (not view-mode)
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))))
+
(define-minor-mode visible-mode
"Toggle making all invisible text temporarily visible (Visible mode).
With a prefix argument ARG, enable Visible mode if ARG is
(defvar skeleton-transformation-function 'identity
- "*If non-nil, function applied to literal strings before they are inserted.
+ "If non-nil, function applied to literal strings before they are inserted.
It should take strings and characters and return them transformed, or nil
which means no transformation.
Typical examples might be `upcase' or `capitalize'.")
(defvar skeleton-subprompt
(substitute-command-keys
"RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]")
- "*Replacement for %s in prompts of recursive subskeletons.")
+ "Replacement for %s in prompts of recursive subskeletons.")
(defvar skeleton-debug nil
- "*If non-nil `define-skeleton' will override previous definition.")
+ "If non-nil `define-skeleton' will override previous definition.")
(defvar skeleton-positions nil
"List of positions marked with @, after skeleton insertion.
"Define a user-configurable COMMAND that enters a statement skeleton.
DOCUMENTATION is that of the command.
SKELETON is as defined under `skeleton-insert'."
- (declare (debug (&define name stringp skeleton-edebug-spec)))
+ (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec)))
(if skeleton-debug
(set command skeleton))
`(progn
;; obarray
;; (lambda (symbol)
;; (or (eq symbol 'eval)
-;; (user-variable-p symbol)))
+;; (custom-variable-p symbol)))
;; t)
;; comment-start str ": "
;; (read-from-minibuffer "Expression: " nil read-expression-map nil
;; Variables and command for automatically inserting pairs like () or "".
(defvar skeleton-pair nil
- "*If this is nil pairing is turned off, no matter what else is set.
+ "If this is nil pairing is turned off, no matter what else is set.
Otherwise modes with `skeleton-pair-insert-maybe' on some keys
will attempt to insert pairs of matching characters.")
(defvar skeleton-pair-on-word nil
- "*If this is nil, paired insertion is inhibited before or inside a word.")
+ "If this is nil, paired insertion is inhibited before or inside a word.")
(defvar skeleton-pair-filter-function (lambda () nil)
;;;###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.
-
-With a negative prefix arg sorts in reverse order.
+ "Sort the text in the region region lexicographically.
+If called interactively, prompt for two regular expressions,
+RECORD-REGEXP and KEY-REGEXP.
+
+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.
;;; speedbar --- quick access to files and tags in a frame
-;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
;;; TODO:
;; - Timeout directories we haven't visited in a while.
-(require 'assoc)
(require 'easymenu)
(require 'dframe)
(require 'sb-image)
singular expression. This variable will be turned into
`speedbar-file-regexp' for use with speedbar. You should use the
function `speedbar-add-supported-extension' to add a new extension at
-runtime, or use the configuration dialog to set it in your .emacs file.
+runtime, or use the configuration dialog to set it in your init file.
If you add an extension to this list, and it does not appear, you may
need to also modify `completion-ignored-extension' which will also help
file completion."
"Non-nil means to automatically update the display.
When this is nil then speedbar will not follow the attached frame's directory.
If you want to change this while speedbar is active, either use
-\\[customize] or call \\<speedbar-key-map> `\\[speedbar-toggle-updates]'."
+\\[customize] or call \\<speedbar-mode-map> `\\[speedbar-toggle-updates]'."
:group 'speedbar
:initialize 'custom-initialize-default
:set (lambda (sym val)
(defvar speedbar-update-flag-disable nil
"Permanently disable changing of the update flag.")
+(define-obsolete-variable-alias
+ 'speedbar-syntax-table 'speedbar-mode-syntax-table "24.1")
(defvar speedbar-mode-syntax-table
(let ((st (make-syntax-table)))
;; Turn off paren matching around here.
(modify-syntax-entry ?\] " " st)
st)
"Syntax-table used on the speedbar.")
-(define-obsolete-variable-alias
- 'speedbar-syntax-table 'speedbar-mode-syntax-table "24.1")
+(define-obsolete-variable-alias 'speedbar-key-map 'speedbar-mode-map "24.1")
(defvar speedbar-mode-map
(let ((map (make-keymap)))
(suppress-keymap map t)
(dframe-update-keymap map)
map)
"Keymap used in speedbar buffer.")
-(define-obsolete-variable-alias 'speedbar-key-map 'speedbar-mode-map "24.1")
(defun speedbar-make-specialized-keymap ()
"Create a keymap for use with a speedbar major or minor display mode.
(set (make-local-variable 'dframe-delete-frame-function)
'speedbar-handle-delete-frame)
;; hscroll
- (set (make-local-variable 'automatic-hscrolling) nil) ; Emacs 21
+ (set (make-local-variable 'auto-hscroll-mode) nil)
;; reset the selection variable
(setq speedbar-last-selected-file nil))
(define-derived-mode speedbar-mode fundamental-mode "Speedbar"
"Major mode for managing a display of directories and tags.
-\\<speedbar-key-map>
+\\<speedbar-mode-map>
The first line represents the default directory of the speedbar frame.
Each directory segment is a button which jumps speedbar's default
directory to that directory. Buttons are activated by clicking `\\[speedbar-click]'.
tags start with >. Click the name of the tag to go to that position
in the selected file.
-\\{speedbar-key-map}"
+\\{speedbar-mode-map}"
(save-excursion
(setq font-lock-keywords nil) ;; no font-locking please
(setq truncate-lines t)
(dframe-power-click arg)
deactivate-mark)
;; We need to hack something so this works in detached frames.
- (while dl
- (adelete 'speedbar-directory-contents-alist (car dl))
- (setq dl (cdr dl)))
+ (dolist (d dl)
+ (setq speedbar-directory-contents-alist
+ (delq (assoc d speedbar-directory-contents-alist)
+ speedbar-directory-contents-alist)))
(if (<= 1 speedbar-verbosity-level)
(speedbar-message "Refreshing speedbar..."))
(speedbar-update-contents)
;; If it is autoloaded, we need to load it now so that
;; we have access to the variable -speedbar-menu-items.
;; Is this XEmacs safe?
- (let ((sf (symbol-function v)))
- (if (and (listp sf) (eq (car sf) 'autoload))
- (load-library (car (cdr sf)))))
+ (autoload-do-load (symbol-function v) v)
(setq speedbar-special-mode-expansion-list (list v))
(setq v (intern-soft (concat ms "-speedbar-key-map")))
(if (not v)
`speedbar-directory-contents-alist' and use that cache before scanning
the file-system."
(setq directory (expand-file-name directory))
- ;; If in powerclick mode, then the directory we are getting
- ;; should be rescanned.
- (if dframe-power-click
- (adelete 'speedbar-directory-contents-alist directory))
;; find the directory, either in the cache, or build it.
- (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
+ (or (and (not dframe-power-click) ;; In powerclick mode, always rescan.
+ (cdr-safe (assoc directory speedbar-directory-contents-alist)))
(let ((default-directory directory)
(dir (directory-files directory nil))
(dirs nil)
(setq dirs (cons (car dir) dirs))
(setq files (cons (car dir) files))))
(setq dir (cdr dir)))
- (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
- (aput 'speedbar-directory-contents-alist directory nl)
+ (let ((nl (cons (nreverse dirs) (list (nreverse files))))
+ (ae (assoc directory speedbar-directory-contents-alist)))
+ (if ae (setcdr ae nl)
+ (push (cons directory nl)
+ speedbar-directory-contents-alist))
nl))
))
;;; Color loading section.
;;
(defface speedbar-button-face '((((class color) (background light))
- (:foreground "green4"))
+ :foreground "green4")
(((class color) (background dark))
- (:foreground "green3")))
- "Face used for +/- buttons."
+ :foreground "green3"))
+ "Speedbar face for +/- buttons."
:group 'speedbar-faces)
(defface speedbar-file-face '((((class color) (background light))
- (:foreground "cyan4"))
+ :foreground "cyan4")
(((class color) (background dark))
- (:foreground "cyan"))
- (t (:bold t)))
- "Face used for file names."
+ :foreground "cyan")
+ (t :weight bold))
+ "Speedbar face for file names."
:group 'speedbar-faces)
(defface speedbar-directory-face '((((class color) (background light))
- (:foreground "blue4"))
+ :foreground "blue4")
(((class color) (background dark))
- (:foreground "light blue")))
- "Face used for directory names."
+ :foreground "light blue"))
+ "Speedbar face for directory names."
:group 'speedbar-faces)
+
(defface speedbar-tag-face '((((class color) (background light))
- (:foreground "brown"))
+ :foreground "brown")
(((class color) (background dark))
- (:foreground "yellow")))
- "Face used for displaying tags."
+ :foreground "yellow"))
+ "Speedbar face for tags."
:group 'speedbar-faces)
(defface speedbar-selected-face '((((class color) (background light))
- (:foreground "red" :underline t))
+ :foreground "red" :underline t)
(((class color) (background dark))
- (:foreground "red" :underline t))
- (t (:underline t)))
- "Face used to underline the file in the active window."
+ :foreground "red" :underline t)
+ (t :underline t))
+ "Speedbar face for the file in the active window."
:group 'speedbar-faces)
(defface speedbar-highlight-face '((((class color) (background light))
- (:background "green"))
+ :background "green")
(((class color) (background dark))
- (:background "sea green"))
- (((class grayscale monochrome)
- (background light))
- (:background "black"))
- (((class grayscale monochrome)
- (background dark))
- (:background "white")))
- "Face used for highlighting buttons with the mouse."
+ :background "sea green"))
+ "Speedbar face for highlighting buttons with the mouse."
:group 'speedbar-faces)
(defface speedbar-separator-face '((((class color) (background light))
- (:background "blue"
- :foreground "white"
- :overline "gray"))
+ :background "blue"
+ :foreground "white"
+ :overline "gray")
(((class color) (background dark))
- (:background "blue"
- :foreground "white"
- :overline "gray"))
+ :background "blue"
+ :foreground "white"
+ :overline "gray")
(((class grayscale monochrome)
(background light))
- (:background "black"
- :foreground "white"
- :overline "white"))
+ :background "black"
+ :foreground "white"
+ :overline "white")
(((class grayscale monochrome)
(background dark))
- (:background "white"
- :foreground "black"
- :overline "black")))
- "Face used for separator labels in a display."
+ :background "white"
+ :foreground "black"
+ :overline "black"))
+ "Speedbar face for separator labels in a display."
:group 'speedbar-faces)
;; some edebug hooks
"Non-nil inhibits the initial startup echo area message.
Setting this variable takes effect
only if you do it with the customization buffer
-or if your `.emacs' file contains a line of this form:
+or if your init file contains a line of this form:
(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
-If your `.emacs' file is byte-compiled, use the following form instead:
+If your init file is byte-compiled, use the following form
+instead:
(eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
-Thus, someone else using a copy of your `.emacs' file will see
-the startup message unless he personally acts to inhibit it."
+Thus, someone else using a copy of your init file will see the
+startup message unless he personally acts to inhibit it."
:type '(choice (const :tag "Don't inhibit")
(string :tag "Enter your user name, to inhibit"))
:group 'initialization)
"List of command-line args not yet processed.")
(defvaralias 'argv 'command-line-args-left
- ;; FIXME: Bad name for a dynamically bound variable.
"List of command-line args not yet processed.
This is a convenience alias, so that one can write \(pop argv\)
inside of --eval command line arguments in order to access
following arguments.")
+(internal-make-var-non-special 'argv)
-(with-no-warnings
- ;; FIXME: Bad name for a dynamically bound variable
- (defvar argi nil
- "Current command-line argument."))
+(defvar argi nil
+ "Current command-line argument.")
+(internal-make-var-non-special 'argi)
(defvar command-line-functions nil ;; lrs 7/31/89
"List of functions to process unrecognized command-line arguments.
"Default directory to use for command line arguments.
This is normally copied from `default-directory' when Emacs starts.")
-;;; This is here, rather than in x-win.el, so that we can ignore these
-;;; options when we are not using X.
+;; This is here, rather than in x-win.el, so that we can ignore these
+;; options when we are not using X.
(defconst command-line-x-option-alist
'(("-bw" 1 x-handle-numeric-switch border-width)
("-d" 1 x-handle-display)
("-fn" 1 x-handle-switch font)
("-font" 1 x-handle-switch font)
("-ib" 1 x-handle-numeric-switch internal-border-width)
- ;;("-g" . x-handle-geometry)
- ;;("-geometry" . x-handle-geometry)
+ ("-g" 1 x-handle-geometry)
+ ("-geometry" 1 x-handle-geometry)
("-fg" 1 x-handle-switch foreground-color)
("-foreground" 1 x-handle-switch foreground-color)
("-bg" 1 x-handle-switch background-color)
"Normal hook run after handling urgent options but before loading init files.")
(defvar after-init-hook nil
- "Normal hook run after loading the init files, `~/.emacs' and `default.el'.
-There is no `condition-case' around the running of these functions;
-therefore, if you set `debug-on-error' non-nil in `.emacs',
-an error in one of these functions will invoke the debugger.")
+ "Normal hook run after initializing the Emacs session.
+It is run after Emacs loads the init file, `default' library, the
+abbrevs file, and additional Lisp packages (if any), and setting
+the value of `after-init-time'.
+
+There is no `condition-case' around the running of this hook;
+therefore, if `debug-on-error' is non-nil, an error in one of
+these functions will invoke the debugger.")
(defvar emacs-startup-hook nil
"Normal hook run after loading init files and handling the command line.")
:group 'initialization)
(defvar init-file-user nil
- "Identity of user whose `.emacs' file is or was read.
+ "Identity of user whose init file is or was read.
The value is nil if `-q' or `--no-init-file' was specified,
meaning do not load any init file.
use that person's init file.
In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
-evaluates to the name of the directory where the `.emacs' file was
+evaluates to the name of the directory where the init file was
looked for.
Setting `init-file-user' does not prevent Emacs from loading
(t
(concat user-emacs-directory "auto-save-list/.saves-")))
"Prefix for generating `auto-save-list-file-name'.
-This is used after reading your `.emacs' file to initialize
+This is used after reading your init file to initialize
`auto-save-list-file-name', by appending Emacs's pid and the system name,
if you have not already set `auto-save-list-file-name' yourself.
Directories in the prefix will be created if necessary.
;; of that dir into load-path,
;; Look for a leim-list.el file too. Loading it will register
;; available input methods.
- (let ((tail load-path) dir)
+ (let ((tail load-path)
+ (lispdir (expand-file-name "../lisp" data-directory))
+ ;; For out-of-tree builds, leim-list is generated in the build dir.
+;;; (leimdir (expand-file-name "../leim" doc-directory))
+ dir)
(while tail
(setq dir (car tail))
(let ((default-directory dir))
(load (expand-file-name "subdirs.el") t t t))
- (let ((default-directory dir))
- (load (expand-file-name "leim-list.el") t t t))
+ ;; Do not scan standard directories that won't contain a leim-list.el.
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
+ (or (string-match (concat "\\`" lispdir) dir)
+ (let ((default-directory dir))
+ (load (expand-file-name "leim-list.el") t t t)))
;; We don't use a dolist loop and we put this "setq-cdr" command at
;; the end, because the subdirs.el files may add elements to the end
;; of load-path and we want to take it into account.
(run-hooks 'before-init-hook)
- ;; Under X, this creates the X frame and deletes the terminal frame.
+ ;; Under X, create the X frame and delete the terminal frame.
(unless (daemonp)
-
- ;; If X resources are available, use them to initialize the values
- ;; of `tool-bar-mode' and `menu-bar-mode', as well as the value of
- ;; `no-blinking-cursor' and the `cursor' face.
- (cond
- ((or noninteractive emacs-basic-display)
- (setq menu-bar-mode nil
- tool-bar-mode nil
- no-blinking-cursor t))
- ((memq initial-window-system '(x w32 ns))
- (let ((no-vals '("no" "off" "false" "0")))
- (if (member (x-get-resource "menuBar" "MenuBar") no-vals)
- (setq menu-bar-mode nil))
- (if (member (x-get-resource "toolBar" "ToolBar") no-vals)
- (setq tool-bar-mode nil))
- (if (member (x-get-resource "cursorBlink" "CursorBlink")
- no-vals)
- (setq no-blinking-cursor t)))
- ;; If the cursorColor X resource exists, alter the `cursor' face
- ;; spec, but mark it as changed outside of Customize.
- (let ((color (x-get-resource "cursorColor" "Foreground")))
- (when color
- (put 'cursor 'theme-face
- `((changed ((t :background ,color)))))
- (put 'cursor 'face-modified t)))))
+ (if (or noninteractive emacs-basic-display)
+ (setq menu-bar-mode nil
+ tool-bar-mode nil
+ no-blinking-cursor t))
(frame-initialize))
(when (fboundp 'x-create-frame)
nil
(display-warning 'initialization
(format "User %s has no home directory"
- init-file-user)
+ (if (equal init-file-user "")
+ (user-real-login-name)
+ init-file-user))
:error))))
;; Load that user's init file, or the default one, or none.
(or mail-host-address
(system-name))))))
- ;; Originally face attributes were specified via
- ;; `font-lock-face-attributes'. Users then changed the default
- ;; face attributes by setting that variable. However, we try and
- ;; be back-compatible and respect its value if set except for
- ;; faces where M-x customize has been used to save changes for the
- ;; face.
- (when (boundp 'font-lock-face-attributes)
- (let ((face-attributes font-lock-face-attributes))
- (while face-attributes
- (let* ((face-attribute (pop face-attributes))
- (face (car face-attribute)))
- ;; Rustle up a `defface' SPEC from a
- ;; `font-lock-face-attributes' entry.
- (unless (get face 'saved-face)
- (let ((foreground (nth 1 face-attribute))
- (background (nth 2 face-attribute))
- (bold-p (nth 3 face-attribute))
- (italic-p (nth 4 face-attribute))
- (underline-p (nth 5 face-attribute))
- face-spec)
- (when foreground
- (setq face-spec (cons ':foreground (cons foreground face-spec))))
- (when background
- (setq face-spec (cons ':background (cons background face-spec))))
- (when bold-p
- (setq face-spec (append '(:weight bold) face-spec)))
- (when italic-p
- (setq face-spec (append '(:slant italic) face-spec)))
- (when underline-p
- (setq face-spec (append '(:underline t) face-spec)))
- (face-spec-set face (list (list t face-spec)) nil)))))))
-
;; If parameter have been changed in the init file which influence
;; face realization, clear the face cache so that new faces will
;; be realized.
(with-no-warnings
(emacs-session-restore x-session-previous-id))))
+(defun x-apply-session-resources ()
+ "Apply X resources which specify initial values for Emacs variables.
+This is called from a window-system initialization function, such
+as `x-initialize-window-system' for X, either at startup (prior
+to reading the init file), or afterwards when the user first
+opens a graphical frame.
+
+This can set the values of `menu-bar-mode', `tool-bar-mode', and
+`no-blinking-cursor', as well as the `cursor' face. Changed
+settings will be marked as \"CHANGED outside of Customize\"."
+ (let ((no-vals '("no" "off" "false" "0"))
+ (settings '(("menuBar" "MenuBar" menu-bar-mode nil)
+ ("toolBar" "ToolBar" tool-bar-mode nil)
+ ("cursorBlink" "CursorBlink" no-blinking-cursor t))))
+ (dolist (x settings)
+ (if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals)
+ (set (nth 2 x) (nth 3 x)))))
+ (let ((color (x-get-resource "cursorColor" "Foreground")))
+ (when color
+ (put 'cursor 'theme-face
+ `((changed ((t :background ,color)))))
+ (put 'cursor 'face-modified t))))
+
(defcustom initial-scratch-message (purecopy "\
;; This buffer is for notes you don't want to save, and for Lisp evaluation.
;; If you want to create a file, visit that file with C-x C-f,
(title (with-temp-buffer
(insert-file-contents
(expand-file-name tut tutorial-directory)
- nil 0 256)
+ ;; We used to read only the first 256 bytes of
+ ;; the tutorial, but that prevents the coding:
+ ;; setting, if any, in file-local variables
+ ;; section to be seen by insert-file-contents,
+ ;; and results in gibberish when the language
+ ;; environment's preferred encoding is
+ ;; different from what the file-local variable
+ ;; says. One case in point is Hebrew.
+ nil)
(search-forward ".")
(buffer-substring (point-min) (1- (point))))))
;; If there is a specific tutorial for the current language
(if (image-type-available-p 'xpm)
"splash.xpm"
"splash.pbm"))
- ((image-type-available-p 'svg)
+ ((or (image-type-available-p 'svg)
+ (image-type-available-p 'imagemagick))
"splash.svg")
((image-type-available-p 'png)
"splash.png")
;;; Requirements and provisions...
(autoload 'mail-position-on-field "sendmail")
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Constants...
:link '(emacs-commentary-link "strokes")
:group 'mouse)
-(defcustom strokes-modeline-string " Strokes"
- "Modeline identification when Strokes mode is on \(default is \" Strokes\"\)."
+(defcustom strokes-lighter " Strokes"
+ "Mode line identifier for Strokes mode."
:type 'string
:group 'strokes)
+(define-obsolete-variable-alias 'strokes-modeline-string 'strokes-lighter "24.3")
+
(defcustom strokes-character ?@
"Character used when drawing strokes in the strokes buffer.
\(The default is `@', which works well.\)"
(defun strokes-eliminate-consecutive-redundancies (entries)
"Return a list with no consecutive redundant entries."
;; defun a grande vitesse grace a Dave G.
- (loop for element on entries
- if (not (equal (car element) (cadr element)))
- collect (car element)))
-;; (loop for element on entries
+ (cl-loop for element on entries
+ if (not (equal (car element) (cadr element)))
+ collect (car element)))
+;; (cl-loop for element on entries
;; nconc (if (not (equal (car el) (cadr el)))
;; (list (car el)))))
;; yet another (orig) way of doing it...
(if (and (strokes-click-p unfilled-stroke)
(not force))
unfilled-stroke
- (loop for grid-locs on unfilled-stroke
- nconc (let* ((current (car grid-locs))
- (current-is-a-point-p (consp current))
- (next (cadr grid-locs))
- (next-is-a-point-p (consp next))
- (both-are-points-p (and current-is-a-point-p
- next-is-a-point-p))
- (x1 (and current-is-a-point-p
- (car current)))
- (y1 (and current-is-a-point-p
- (cdr current)))
- (x2 (and next-is-a-point-p
- (car next)))
- (y2 (and next-is-a-point-p
- (cdr next)))
- (delta-x (and both-are-points-p
- (- x2 x1)))
- (delta-y (and both-are-points-p
- (- y2 y1)))
- (slope (and both-are-points-p
- (if (zerop delta-x)
- nil ; undefined vertical slope
- (/ (float delta-y)
- delta-x)))))
- (cond ((not both-are-points-p)
- (list current))
- ((null slope) ; undefined vertical slope
- (if (>= delta-y 0)
- (loop for y from y1 below y2
- collect (cons x1 y))
- (loop for y from y1 above y2
- collect (cons x1 y))))
- ((zerop slope) ; (= y1 y2)
- (if (>= delta-x 0)
- (loop for x from x1 below x2
- collect (cons x y1))
- (loop for x from x1 above x2
- collect (cons x y1))))
- ((>= (abs delta-x) (abs delta-y))
- (if (> delta-x 0)
- (loop for x from x1 below x2
- collect (cons x
- (+ y1
- (round (* slope
- (- x x1))))))
- (loop for x from x1 above x2
- collect (cons x
- (+ y1
- (round (* slope
- (- x x1))))))))
- (t ; (< (abs delta-x) (abs delta-y))
- (if (> delta-y 0)
- (loop for y from y1 below y2
- collect (cons (+ x1
- (round (/ (- y y1)
- slope)))
- y))
- (loop for y from y1 above y2
- collect (cons (+ x1
- (round (/ (- y y1)
- slope)))
- y))))))))))
+ (cl-loop
+ for grid-locs on unfilled-stroke
+ nconc (let* ((current (car grid-locs))
+ (current-is-a-point-p (consp current))
+ (next (cadr grid-locs))
+ (next-is-a-point-p (consp next))
+ (both-are-points-p (and current-is-a-point-p
+ next-is-a-point-p))
+ (x1 (and current-is-a-point-p
+ (car current)))
+ (y1 (and current-is-a-point-p
+ (cdr current)))
+ (x2 (and next-is-a-point-p
+ (car next)))
+ (y2 (and next-is-a-point-p
+ (cdr next)))
+ (delta-x (and both-are-points-p
+ (- x2 x1)))
+ (delta-y (and both-are-points-p
+ (- y2 y1)))
+ (slope (and both-are-points-p
+ (if (zerop delta-x)
+ nil ; undefined vertical slope
+ (/ (float delta-y)
+ delta-x)))))
+ (cond ((not both-are-points-p)
+ (list current))
+ ((null slope) ; undefined vertical slope
+ (if (>= delta-y 0)
+ (cl-loop for y from y1 below y2
+ collect (cons x1 y))
+ (cl-loop for y from y1 above y2
+ collect (cons x1 y))))
+ ((zerop slope) ; (= y1 y2)
+ (if (>= delta-x 0)
+ (cl-loop for x from x1 below x2
+ collect (cons x y1))
+ (cl-loop for x from x1 above x2
+ collect (cons x y1))))
+ ((>= (abs delta-x) (abs delta-y))
+ (if (> delta-x 0)
+ (cl-loop for x from x1 below x2
+ collect (cons x
+ (+ y1
+ (round (* slope
+ (- x x1))))))
+ (cl-loop for x from x1 above x2
+ collect (cons x
+ (+ y1
+ (round (* slope
+ (- x x1))))))))
+ (t ; (< (abs delta-x) (abs delta-y))
+ (if (> delta-y 0)
+ ;; FIXME: Reduce redundancy between branches.
+ (cl-loop for y from y1 below y2
+ collect (cons (+ x1
+ (round (/ (- y y1)
+ slope)))
+ y))
+ (cl-loop for y from y1 above y2
+ collect (cons (+ x1
+ (round (/ (- y y1)
+ slope)))
+ y))))))))))
(defun strokes-rate-stroke (stroke1 stroke2)
"Rates STROKE1 with STROKE2 and return a score based on a distance metric.
(defsubst strokes-fill-current-buffer-with-whitespace ()
"Erase the contents of the current buffer and fill it with whitespace."
(erase-buffer)
- (loop repeat (frame-height) do
- (insert-char ?\s (1- (frame-width)))
- (newline))
+ (cl-loop repeat (frame-height) do
+ (insert-char ?\s (1- (frame-width)))
+ (newline))
(goto-char (point-min)))
;;;###autoload
extracting the strokes for editing use once again, so the editing
cycle can continue.
-Strokes are easy to program and fun to use. To start strokes going,
-you'll want to put the following line in your .emacs file as mentioned
-in the commentary to strokes.el.
-
-This will load strokes when and only when you start Emacs on a window
-system, with a mouse or other pointer device defined.
-
-To toggle strokes-mode, you just do
+To toggle strokes-mode, invoke the command
> M-x strokes-mode
(set-buffer buf)
(erase-buffer)
(insert strokes-xpm-header)
- (loop repeat 33 do
- (insert ?\")
- (insert-char ?\s 33)
- (insert "\",")
- (newline)
- finally
- (forward-line -1)
- (end-of-line)
- (insert "}\n"))
- (loop for point in stroke
- for x = (car-safe point)
- for y = (cdr-safe point) do
- (cond ((consp point)
- ;; draw a point, and possibly a starting-point
- (if (and lift-flag (not b/w-only))
- ;; mark starting point with the appropriate color
- (let ((char (or (car rainbow-chars) ?\.)))
- (loop for i from 0 to 2 do
- (loop for j from 0 to 2 do
- (goto-char (point-min))
- (forward-line (+ 15 i y))
- (forward-char (+ 1 j x))
- (delete-char 1)
- (insert char)))
- (setq rainbow-chars (cdr rainbow-chars)
- lift-flag nil))
- ;; Otherwise, just plot the point...
- (goto-char (point-min))
- (forward-line (+ 16 y))
- (forward-char (+ 2 x))
- (subst-char-in-region (point) (1+ (point)) ?\s ?\*)))
- ((strokes-lift-p point)
- ;; a lift--tell the loop to X out the next point...
- (setq lift-flag t))))
+ (cl-loop repeat 33 do
+ (insert ?\")
+ (insert-char ?\s 33)
+ (insert "\",")
+ (newline)
+ finally
+ (forward-line -1)
+ (end-of-line)
+ (insert "}\n"))
+ (cl-loop for point in stroke
+ for x = (car-safe point)
+ for y = (cdr-safe point) do
+ (cond ((consp point)
+ ;; draw a point, and possibly a starting-point
+ (if (and lift-flag (not b/w-only))
+ ;; mark starting point with the appropriate color
+ (let ((char (or (car rainbow-chars) ?\.)))
+ (cl-loop for i from 0 to 2 do
+ (cl-loop for j from 0 to 2 do
+ (goto-char (point-min))
+ (forward-line (+ 15 i y))
+ (forward-char (+ 1 j x))
+ (delete-char 1)
+ (insert char)))
+ (setq rainbow-chars (cdr rainbow-chars)
+ lift-flag nil))
+ ;; Otherwise, just plot the point...
+ (goto-char (point-min))
+ (forward-line (+ 16 y))
+ (forward-char (+ 2 x))
+ (subst-char-in-region (point) (1+ (point)) ?\s ?\*)))
+ ((strokes-lift-p point)
+ ;; a lift--tell the loop to X out the next point...
+ (setq lift-flag t))))
(when (called-interactively-p 'interactive)
(pop-to-buffer " *strokes-xpm*")
;; (xpm-mode 1)
;; (insert
;; "Command Stroke\n"
;; "------- ------")
-;; (loop for def in strokes-map
+;; (cl-loop for def in strokes-map
;; for i from 0 to (1- (length strokes-map)) do
;; (let ((stroke (car def))
;; (command-name (symbol-name (cdr def))))
(insert
"Command Stroke\n"
"------- ------")
- (loop for def in strokes-map do
- (let ((stroke (car def))
- (command-name (if (symbolp (cdr def))
- (symbol-name (cdr def))
- (prin1-to-string (cdr def)))))
- (strokes-xpm-for-stroke stroke " *strokes-xpm*")
- (newline 2)
- (insert-char ?\s 45)
- (beginning-of-line)
- (insert command-name)
- (beginning-of-line)
- (forward-char 45)
- (insert-image
- (create-image (with-current-buffer " *strokes-xpm*"
- (buffer-string))
- 'xpm t
- :color-symbols
- `(("foreground"
- . ,(frame-parameter nil 'foreground-color))))))
- finally do (unless (eobp)
- (kill-region (1+ (point)) (point-max))))
+ (cl-loop
+ for def in strokes-map do
+ (let ((stroke (car def))
+ (command-name (if (symbolp (cdr def))
+ (symbol-name (cdr def))
+ (prin1-to-string (cdr def)))))
+ (strokes-xpm-for-stroke stroke " *strokes-xpm*")
+ (newline 2)
+ (insert-char ?\s 45)
+ (beginning-of-line)
+ (insert command-name)
+ (beginning-of-line)
+ (forward-char 45)
+ (insert-image
+ (create-image (with-current-buffer " *strokes-xpm*"
+ (buffer-string))
+ 'xpm t
+ :color-symbols
+ `(("foreground"
+ . ,(frame-parameter nil 'foreground-color))))))
+ finally do (unless (eobp)
+ (kill-region (1+ (point)) (point-max))))
(view-buffer "*Strokes List*" nil)
(set (make-local-variable 'view-mode-map)
(let ((map (copy-keymap view-mode-map)))
\\[strokes-decode-buffer].
\\{strokes-mode-map}"
- nil strokes-modeline-string strokes-mode-map
+ nil strokes-lighter strokes-mode-map
:group 'strokes :global t
(cond ((not (display-mouse-p))
(error "Can't use Strokes without a mouse"))
;; yet another of the same bit-type, so we continue
;; counting...
(progn
- (incf count)
+ (cl-incf count)
(forward-char 1))
;; otherwise, it's the opposite bit-type, so we do a
;; write and then restart count ### NOTE (for myself
(delete-char 1)
(setq current-char-is-on-p (not current-char-is-on-p)))
(goto-char (point-min))
- (loop repeat 33 do
- (insert ?\")
- (forward-char 33)
- (insert "\",\n"))
+ (cl-loop repeat 33 do
+ (insert ?\")
+ (forward-char 33)
+ (insert "\",\n"))
(goto-char (point-min))
(insert strokes-xpm-header))))
;;; Code:
+;; Beware: while this file has tag `utf-8', before it's compiled, it gets
+;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
+
(defvar custom-declare-variable-list nil
"Record `defcustom' calls made before `custom.el' is loaded to handle them.
Each element of this list holds the arguments to one call to `defcustom'.")
(defmacro noreturn (form)
"Evaluate FORM, expecting it not to return.
If FORM does return, signal an error."
+ (declare (debug t))
`(prog1 ,form
(error "Form marked with `noreturn' did return")))
"Evaluate FORM, expecting a constant return value.
This is the global do-nothing version. There is also `testcover-1value'
that complains if FORM ever does return differing values."
+ (declare (debug t))
form)
(defmacro def-edebug-spec (symbol spec)
BODY should be a list of Lisp expressions.
\(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)"
+ (declare (doc-string 2) (indent defun)
+ (debug (&define lambda-list
+ [&optional stringp]
+ [&optional ("interactive" interactive)]
+ def-body)))
;; Note that this definition should not use backquotes; subr.el should not
;; depend on backquote.el.
(list 'function (cons 'lambda cdr)))
+(defmacro setq-local (var val)
+ "Set variable VAR to value VAL in current buffer."
+ ;; Can't use backquote here, it's too early in the bootstrap.
+ (list 'set (list 'make-local-variable (list 'quote var)) val))
+
+(defmacro defvar-local (var val &optional docstring)
+ "Define VAR as a buffer-local variable with default value VAL.
+Like `defvar' but additionally marks the variable as being automatically
+buffer-local wherever it is set."
+ (declare (debug defvar) (doc-string 3))
+ ;; Can't use backquote here, it's too early in the bootstrap.
+ (list 'progn (list 'defvar var val docstring)
+ (list 'make-variable-buffer-local (list 'quote var))))
+
(defun apply-partially (fun &rest args)
"Return a function that is a partial application of FUN to ARGS.
ARGS is a list of the first N arguments to pass to FUN.
`(closure (t) (&rest args)
(apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args)))
-(if (null (featurep 'cl))
- (progn
- ;; If we reload subr.el after having loaded CL, be careful not to
- ;; overwrite CL's extended definition of `dolist', `dotimes',
- ;; `declare', `push' and `pop'.
-(defmacro push (newelt listname)
- "Add NEWELT to the list stored in the symbol LISTNAME.
-This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)).
-LISTNAME must be a symbol."
- (declare (debug (form sexp)))
- (list 'setq listname
- (list 'cons newelt listname)))
-
-(defmacro pop (listname)
- "Return the first element of LISTNAME's value, and remove it from the list.
-LISTNAME must be a symbol whose value is a list.
+(defmacro push (newelt place)
+ "Add NEWELT to the list stored in the generalized variable PLACE.
+This is morally equivalent to (setf PLACE (cons NEWELT PLACE)),
+except that PLACE is only evaluated once (after NEWELT)."
+ (declare (debug (form gv-place)))
+ (if (symbolp place)
+ ;; Important special case, to avoid triggering GV too early in
+ ;; the bootstrap.
+ (list 'setq place
+ (list 'cons newelt place))
+ (require 'macroexp)
+ (macroexp-let2 macroexp-copyable-p v newelt
+ (gv-letplace (getter setter) place
+ (funcall setter `(cons ,v ,getter))))))
+
+(defmacro pop (place)
+ "Return the first element of PLACE's value, and remove it from the list.
+PLACE must be a generalized variable whose value is a list.
If the value is nil, `pop' returns nil but does not actually
change the list."
- (declare (debug (sexp)))
+ (declare (debug (gv-place)))
(list 'car
- (list 'prog1 listname
- (list 'setq listname (list 'cdr listname)))))
-))
+ (if (symbolp place)
+ ;; So we can use `pop' in the bootstrap before `gv' can be used.
+ (list 'prog1 place (list 'setq place (list 'cdr place)))
+ (gv-letplace (getter setter) place
+ `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
(defmacro when (cond &rest body)
"If COND yields non-nil, do BODY, else return nil.
(if (null (featurep 'cl))
(progn
;; If we reload subr.el after having loaded CL, be careful not to
- ;; overwrite CL's extended definition of `dolist', `dotimes',
- ;; `declare', `push' and `pop'.
+ ;; overwrite CL's extended definition of `dolist', `dotimes', `declare'.
(defmacro dolist (spec &rest body)
"Loop over a list.
,@(cdr (cdr spec))))))
(defmacro declare (&rest _specs)
- "Do not evaluate any arguments and return nil.
-Treated as a declaration when used at the right place in a
-`defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)"
+ "Do not evaluate any arguments, and return nil.
+If a `declare' form appears as the first form in the body of a
+`defun' or `defmacro' form, SPECS specifies various additional
+information about the function or macro; these go into effect
+during the evaluation of the `defun' or `defmacro' form.
+
+The possible values of SPECS are specified by
+`defun-declarations-alist' and `macro-declarations-alist'."
+ ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
nil)
))
(signal 'error (list (apply 'format args)))))
(set-advertised-calling-convention 'error '(string &rest args) "23.1")
+(defun user-error (format &rest args)
+ "Signal a pilot error, making error message by passing all args to `format'.
+In Emacs, the convention is that error messages start with a capital
+letter but *do not* end with a period. Please follow this convention
+for the sake of consistency.
+This is just like `error' except that `user-error's are expected to be the
+result of an incorrect manipulation on the part of the user, rather than the
+result of an actual problem."
+ (while t
+ (signal 'user-error (list (apply #'format format args)))))
+
;; We put this here instead of in frame.el so that it's defined even on
;; systems where frame.el isn't loaded.
(defun frame-configuration-p (object)
(setq tail (cdr tail)))
value))
-(make-obsolete 'assoc-ignore-case 'assoc-string "22.1")
(defun assoc-ignore-case (key alist)
"Like `assoc', but ignores differences in case and text representation.
KEY must be a string. Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison."
+ (declare (obsolete assoc-string "22.1"))
(assoc-string key alist t))
-(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1")
(defun assoc-ignore-representation (key alist)
"Like `assoc', but ignores differences in text representation.
KEY must be a string.
Unibyte strings are converted to multibyte for comparison."
+ (declare (obsolete assoc-string "22.1"))
(assoc-string key alist nil))
(defun member-ignore-case (elt list)
\f
;;;; Keymap support.
-(defmacro kbd (keys)
+(defun kbd (keys)
"Convert KEYS to the internal Emacs key representation.
KEYS should be a string constant in the format used for
saving keyboard macros (see `edmacro-mode')."
+ ;; Don't use a defalias, since the `pure' property is only true for
+ ;; the calling convention of `kbd'.
(read-kbd-macro keys))
+(put 'kbd 'pure t)
(defun undefined ()
"Beep to tell the user this binding is undefined."
;; Process the bindings starting from the end.
(dolist (binding (prog1 bindings (setq bindings ())))
(let* ((key (car binding))
- (item (cdr binding))
(oldbind (assq key bindings)))
(push (if (not oldbind)
;; The normal case: no duplicate bindings.
(put 'keyboard-translate-table 'char-table-extra-slots 0)
(defun keyboard-translate (from to)
- "Translate character FROM to TO at a low level.
+ "Translate character FROM to TO on the current terminal.
This function creates a `keyboard-translate-table' if necessary
and then modifies one entry in it."
(or (char-table-p keyboard-translate-table)
c)))
key)))
-(defsubst eventp (obj)
+(defun eventp (obj)
"True if the argument is an event object."
- (or (and (integerp obj)
- ;; Filter out integers too large to be events.
- ;; M is the biggest modifier.
- (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1)))))
- (characterp (event-basic-type obj)))
- (and (symbolp obj)
- (get obj 'event-symbol-elements))
- (and (consp obj)
- (symbolp (car obj))
- (get (car obj) 'event-symbol-elements))))
+ (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.
;; 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
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
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.
\f
;;;; 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'
(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.3")
(defun insert-string (&rest args)
"Mocklisp-compatibility insert function.
Like the function `insert' except that any argument that is a number
is converted into a string by expressing it in decimal."
+ (declare (obsolete insert "22.1"))
(dolist (el args)
(insert (if (integerp el) (number-to-string el) el))))
-(make-obsolete 'insert-string 'insert "22.1")
-(defun makehash (&optional test) (make-hash-table :test (or test 'eql)))
-(make-obsolete 'makehash 'make-hash-table "22.1")
+(defun makehash (&optional test)
+ (declare (obsolete make-hash-table "22.1"))
+ (make-hash-table :test (or test 'eql)))
;; These are used by VM and some old programs
(defalias 'focus-frame 'ignore "")
(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.3")
\f
;;;; Obsolescence declarations for variables, and aliases.
(make-obsolete 'process-filter-multibyte-p nil "23.1")
(make-obsolete 'set-process-filter-multibyte nil "23.1")
-(make-obsolete-variable
- 'mode-line-inverse-video
- "use the appropriate faces instead."
- "21.1")
-(make-obsolete-variable
- 'unread-command-char
- "use `unread-command-events' instead. That variable is a list of events
-to reread, so it now uses nil to mean `no event', instead of -1."
- "before 19.15")
-
;; Lisp manual only updated in 22.1.
(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
"before 19.34")
(make-obsolete-variable 'translation-table-for-input nil "23.1")
(defvaralias 'messages-buffer-max-lines 'message-log-max)
-
-;; These aliases exist in Emacs 19.34, and probably before, but were
-;; only marked as obsolete in 23.1.
-;; The lisp manual (since at least Emacs 21) describes them as
-;; existing "for compatibility with Emacs version 18".
-(define-obsolete-variable-alias 'last-input-char 'last-input-event
- "at least 19.34")
-(define-obsolete-variable-alias 'last-command-char 'last-command-event
- "at least 19.34")
-
\f
;;;; Alternate names for functions - these are not being phased out.
(or keep-all
(not (equal (car history) newelt))))
(if history-delete-duplicates
- (delete newelt history))
+ (setq history (delete newelt history)))
(setq history (cons newelt history))
(when (integerp maxelt)
(if (= 0 maxelt)
\f
;;; Load history
+(defsubst autoloadp (object)
+ "Non-nil if OBJECT is an autoload."
+ (eq 'autoload (car-safe object)))
+
+;; (defun autoload-type (object)
+;; "Returns the type of OBJECT or `function' or `command' if the type is nil.
+;; OBJECT should be an autoload object."
+;; (when (autoloadp object)
+;; (let ((type (nth 3 object)))
+;; (cond ((null type) (if (nth 2 object) 'command 'function))
+;; ((eq 'keymap t) 'macro)
+;; (type)))))
+
+;; (defalias 'autoload-file #'cadr
+;; "Return the name of the file from which AUTOLOAD will be loaded.
+;; \n\(fn AUTOLOAD)")
+
(defun symbol-file (symbol &optional type)
"Return the name of the file that defined SYMBOL.
The value is normally an absolute file name. It can also be nil,
definition, variable definition, or face definition only."
(if (and (or (null type) (eq type 'defun))
(symbolp symbol) (fboundp symbol)
- (eq 'autoload (car-safe (symbol-function symbol))))
+ (autoloadp (symbol-function symbol)))
(nth 1 (symbol-function symbol))
(let ((files load-history)
file)
"Read the following input sexp, and run it whenever FILE is loaded.
This makes or adds to an entry on `after-load-alist'.
FILE should be the name of a library, with no directory name."
+ (declare (obsolete eval-after-load "23.2"))
(eval-after-load file (read)))
-(make-obsolete 'eval-next-after-load `eval-after-load "23.2")
(defun display-delayed-warnings ()
"Display delayed warnings from `delayed-warnings-list'.
;;;; Input and display facilities.
(defvar read-quoted-char-radix 8
- "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
+ "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
Legitimate radix values are 8, 10 and 16.")
(custom-declare-variable-early
So escape sequences and keyboard encoding are taken into account.
When there's an ambiguity because the key looks like the prefix of
some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
+ ;; This overriding-terminal-local-map binding also happens to
+ ;; disable quail's input methods, so although read-key-sequence
+ ;; always inherits the input method, in practice read-key does not
+ ;; inherit the input method (at least not if it's based on quail).
(let ((overriding-terminal-local-map read-key-empty-map)
(overriding-local-map nil)
(echo-keystrokes 0)
This function echoes `.' for each character that the user types.
-The user ends with RET, LFD, or ESC. DEL or C-h rubs out.
-C-y yanks the current kill. C-u kills line.
-C-g quits; if `inhibit-quit' was non-nil around this function,
-then it returns nil if the user types C-g, but `quit-flag' remains set.
-
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
- (with-local-quit
- (if confirm
- (let (success)
- (while (not success)
- (let ((first (read-passwd prompt nil default))
- (second (read-passwd "Confirm password: " nil default)))
- (if (equal first second)
- (progn
- (and (arrayp second) (clear-string second))
- (setq success first))
- (and (arrayp first) (clear-string first))
- (and (arrayp second) (clear-string second))
- (message "Password not repeated accurately; please start over")
- (sit-for 1))))
- success)
- (let ((pass nil)
- ;; Copy it so that add-text-properties won't modify
- ;; the object that was passed in by the caller.
- (prompt (copy-sequence prompt))
- (c 0)
- (echo-keystrokes 0)
- (cursor-in-echo-area t)
- (message-log-max nil)
- (stop-keys (list 'return ?\r ?\n ?\e))
- (rubout-keys (list 'backspace ?\b ?\177)))
- (add-text-properties 0 (length prompt)
- minibuffer-prompt-properties prompt)
- (while (progn (message "%s%s"
- prompt
- (make-string (length pass) ?.))
- (setq c (read-key))
- (not (memq c stop-keys)))
- (clear-this-command-keys)
- (cond ((memq c rubout-keys) ; rubout
- (when (> (length pass) 0)
- (let ((new-pass (substring pass 0 -1)))
- (and (arrayp pass) (clear-string pass))
- (setq pass new-pass))))
- ((eq c ?\C-g) (keyboard-quit))
- ((not (numberp c)))
- ((= c ?\C-u) ; kill line
- (and (arrayp pass) (clear-string pass))
- (setq pass ""))
- ((= c ?\C-y) ; yank
- (let* ((str (condition-case nil
- (current-kill 0)
- (error nil)))
- new-pass)
- (when str
- (setq new-pass
- (concat pass
- (substring-no-properties str)))
- (and (arrayp pass) (clear-string pass))
- (setq c ?\0)
- (setq pass new-pass))))
- ((characterp c) ; insert char
- (let* ((new-char (char-to-string c))
- (new-pass (concat pass new-char)))
- (and (arrayp pass) (clear-string pass))
- (clear-string new-char)
- (setq c ?\0)
- (setq pass new-pass)))))
- (message nil)
- (or pass default "")))))
+ (if confirm
+ (let (success)
+ (while (not success)
+ (let ((first (read-passwd prompt nil default))
+ (second (read-passwd "Confirm password: " nil default)))
+ (if (equal first second)
+ (progn
+ (and (arrayp second) (clear-string second))
+ (setq success first))
+ (and (arrayp first) (clear-string first))
+ (and (arrayp second) (clear-string second))
+ (message "Password not repeated accurately; please start over")
+ (sit-for 1))))
+ success)
+ (let ((hide-chars-fun
+ (lambda (beg end _len)
+ (clear-this-command-keys)
+ (setq beg (min end (max (minibuffer-prompt-end)
+ beg)))
+ (dotimes (i (- end beg))
+ (put-text-property (+ i beg) (+ 1 i beg)
+ 'display (string ?.)))))
+ minibuf)
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq minibuf (current-buffer))
+ ;; Turn off electricity.
+ (set (make-local-variable 'post-self-insert-hook) nil)
+ (add-hook 'after-change-functions hide-chars-fun nil 'local))
+ (unwind-protect
+ (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
+ ;; minibuffer is not always properly reset later on, so undo
+ ;; whatever we've done here (bug#11392).
+ (remove-hook 'after-change-functions hide-chars-fun 'local)
+ (kill-local-variable 'post-self-insert-hook)
+ ;; And of course, don't keep the sensitive data around.
+ (erase-buffer))))))))
;; This should be used by `call-interactively' for `n' specs.
(defun read-number (prompt &optional default)
"Read a numeric value in the minibuffer, prompting with PROMPT.
DEFAULT specifies a default value to return if the user just types RET.
The value of DEFAULT is inserted into PROMPT."
- (let ((n nil))
- (when default
+ (let ((n nil)
+ (default1 (if (consp default) (car default) default)))
+ (when default1
(setq prompt
(if (string-match "\\(\\):[ \t]*\\'" prompt)
- (replace-match (format " (default %s)" default) t t prompt 1)
+ (replace-match (format " (default %s)" default1) t t prompt 1)
(replace-regexp-in-string "[ \t]*\\'"
- (format " (default %s) " default)
+ (format " (default %s) " default1)
prompt t t))))
(while
(progn
- (let ((str (read-from-minibuffer prompt nil nil nil nil
- (and default
- (number-to-string default)))))
+ (let ((str (read-from-minibuffer
+ prompt nil nil nil nil
+ (when default
+ (if (consp default)
+ (mapcar 'number-to-string (delq nil default))
+ (number-to-string default))))))
(condition-case nil
(setq n (cond
- ((zerop (length str)) default)
- ((stringp str) (read str))))
+ ((zerop (length str)) default1)
+ ((stringp str) (string-to-number str))))
(error nil)))
(unless (numberp n)
(message "Please enter a number.")
(error "Called `read-char-choice' without valid char choices"))
(let (char done show-help (helpbuf " *Char Help*"))
(let ((cursor-in-echo-area t)
- (executing-kbd-macro executing-kbd-macro))
+ (executing-kbd-macro executing-kbd-macro)
+ (esc-flag nil))
(save-window-excursion ; in case we call help-form-show
(while (not done)
(unless (get-text-property 0 'face prompt)
;; there are no more events in the macro. Attempt to
;; get an event interactively.
(setq executing-kbd-macro nil))
- ((and (not inhibit-keyboard-quit) (eq char ?\C-g))
- (keyboard-quit))))))
+ ((not inhibit-keyboard-quit)
+ (cond
+ ((and (null esc-flag) (eq char ?\e))
+ (setq esc-flag t))
+ ((memq char '(?\C-g ?\e))
+ (keyboard-quit))))))))
;; Display the question with the answer. But without cursor-in-echo-area.
(message "%s%s" prompt (char-to-string char))
char))
PROMPT is the string to display to ask the question. It should
end in a space; `y-or-n-p' adds \"(y or n) \" to it.
-No confirmation of the answer is requested; a single character is enough.
-Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses
-the bindings in `query-replace-map'; see the documentation of that variable
-for more information. In this case, the useful bindings are `act', `skip',
-`recenter', and `quit'.\)
+No confirmation of the answer is requested; a single character is
+enough. SPC also means yes, and DEL means no.
+
+To be precise, this function translates user input into responses
+by consulting the bindings in `query-replace-map'; see the
+documentation of that variable for more information. In this
+case, the useful bindings are `act', `skip', `recenter',
+`scroll-up', `scroll-down', and `quit'.
+An `act' response means yes, and a `skip' response means no.
+A `quit' response means to invoke `keyboard-quit'.
+If the user enters `recenter', `scroll-up', or `scroll-down'
+responses, perform the requested window recentering or scrolling
+and ask again.
Under a windowing system a dialog box will be used if `last-nonmenu-event'
is nil and `use-dialog-box' is non-nil."
"" " ")
"(y or n) "))
(while
- (let* ((key
+ (let* ((scroll-actions '(recenter scroll-up scroll-down
+ scroll-other-window scroll-other-window-down))
+ (key
(let ((cursor-in-echo-area t))
(when minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
- (read-key (propertize (if (eq answer 'recenter)
+ (read-key (propertize (if (memq answer scroll-actions)
prompt
(concat "Please answer y or n. "
prompt))
'face 'minibuffer-prompt)))))
(setq answer (lookup-key query-replace-map (vector key) t))
(cond
- ((memq answer '(skip act)) nil)
- ((eq answer 'recenter) (recenter) t)
- ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
- (t t)))
+ ((memq answer '(skip act)) nil)
+ ((eq answer 'recenter)
+ (recenter) t)
+ ((eq answer 'scroll-up)
+ (ignore-errors (scroll-up-command)) t)
+ ((eq answer 'scroll-down)
+ (ignore-errors (scroll-down-command)) t)
+ ((eq answer 'scroll-other-window)
+ (ignore-errors (scroll-other-window)) t)
+ ((eq answer 'scroll-other-window-down)
+ (ignore-errors (scroll-other-window-down)) t)
+ ((or (memq answer '(exit-prefix quit)) (eq key ?\e))
+ (signal 'quit nil) t)
+ (t t)))
(ding)
(discard-input))))
(let ((ret (eq answer 'act)))
This finishes the change group by accepting its changes as final."
(dolist (elt handle)
(with-current-buffer (car elt)
- (if (eq elt t)
+ (if (eq (cdr elt) t)
(setq buffer-undo-list t)))))
(defun cancel-change-group (handle)
;;;; Display-related functions.
;; For compatibility.
-(defalias 'redraw-modeline 'force-mode-line-update)
+(define-obsolete-function-alias 'redraw-modeline
+ '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.
\f
;;;; Misc. useful functions.
+(defsubst buffer-narrowed-p ()
+ "Return non-nil if the current buffer is narrowed."
+ (/= (- (point-max) (point-min)) (buffer-size)))
+
(defun find-tag-default ()
"Determine default tag to search for, based on text at point.
If there is no plausible default, return nil."
form."
(secure-hash 'sha1 object start end binary))
+(defun function-get (f prop &optional autoload)
+ "Return the value of property PROP of function F.
+If AUTOLOAD is non-nil and F is autoloaded, try to autoload it
+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
+ (if (eq autoload 'macro)
+ 'macro)))))
+ nil ;Re-try `get' on the same `f'.
+ (setq f fundef))))
+ val))
\f
;;;; Support for yanking and text properties.
+(defvar yank-handled-properties)
(defvar yank-excluded-properties)
(defun remove-yank-excluded-properties (start end)
- "Remove `yank-excluded-properties' between START and END positions.
-Replaces `category' properties with their defined properties."
+ "Process text properties between START and END, inserted for a `yank'.
+Perform the handling specified by `yank-handled-properties', then
+remove properties specified by `yank-excluded-properties'."
(let ((inhibit-read-only t))
- ;; Replace any `category' property with the properties it stands
- ;; for. This is to remove `mouse-face' properties that are placed
- ;; on categories in *Help* buffers' buttons. See
- ;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
- ;; for the details.
- (unless (memq yank-excluded-properties '(t nil))
- (save-excursion
- (goto-char start)
- (while (< (point) end)
- (let ((cat (get-text-property (point) 'category))
- run-end)
- (setq run-end
- (next-single-property-change (point) 'category nil end))
- (when cat
- (let (run-end2 original)
- (remove-list-of-text-properties (point) run-end '(category))
- (while (< (point) run-end)
- (setq run-end2 (next-property-change (point) nil run-end))
- (setq original (text-properties-at (point)))
- (set-text-properties (point) run-end2 (symbol-plist cat))
- (add-text-properties (point) run-end2 original)
- (goto-char run-end2))))
- (goto-char run-end)))))
+ (dolist (handler yank-handled-properties)
+ (let ((prop (car handler))
+ (fun (cdr handler))
+ (run-start start))
+ (while (< run-start end)
+ (let ((value (get-text-property run-start prop))
+ (run-end (next-single-property-change
+ run-start prop nil end)))
+ (funcall fun value run-start run-end)
+ (setq run-start run-end)))))
(if (eq yank-excluded-properties t)
(set-text-properties start end nil)
(remove-list-of-text-properties start end yank-excluded-properties))))
(insert-for-yank-1 string))
(defun insert-for-yank-1 (string)
- "Insert STRING at point, stripping some text properties.
-
-Strip text properties from the inserted text according to
-`yank-excluded-properties'. Otherwise just like (insert STRING).
-
-If STRING has a non-nil `yank-handler' property on the first character,
-the normal insert behavior is modified in various ways. The value of
-the yank-handler property must be a list with one to four elements
-with the following format: (FUNCTION PARAM NOEXCLUDE UNDO).
-When FUNCTION is present and non-nil, it is called instead of `insert'
- to insert the string. FUNCTION takes one argument--the object to insert.
-If PARAM is present and non-nil, it replaces STRING as the object
- passed to FUNCTION (or `insert'); for example, if FUNCTION is
- `yank-rectangle', PARAM may be a list of strings to insert as a
- rectangle.
-If NOEXCLUDE is present and non-nil, the normal removal of the
+ "Insert STRING at point for the `yank' command.
+This function is like `insert', except it honors the variables
+`yank-handled-properties' and `yank-excluded-properties', and the
+`yank-handler' text property.
+
+Properties listed in `yank-handled-properties' are processed,
+then those listed in `yank-excluded-properties' are discarded.
+
+If STRING has a non-nil `yank-handler' property on its first
+character, the normal insert behavior is altered. The value of
+the `yank-handler' property must be a list of one to four
+elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO).
+FUNCTION, if non-nil, should be a function of one argument, an
+ object to insert; it is called instead of `insert'.
+PARAM, if present and non-nil, replaces STRING as the argument to
+ FUNCTION or `insert'; e.g. if FUNCTION is `yank-rectangle', PARAM
+ may be a list of strings to insert as a rectangle.
+If NOEXCLUDE is present and non-nil, the normal removal of
`yank-excluded-properties' is not performed; instead FUNCTION is
- responsible for removing those properties. This may be necessary
- if FUNCTION adjusts point before or after inserting the object.
-If UNDO is present and non-nil, it is a function that will be called
+ responsible for the removal. This may be necessary if FUNCTION
+ adjusts point before or after inserting the object.
+UNDO, if present and non-nil, should be a function to be called
by `yank-pop' to undo the insertion of the current object. It is
- called with two arguments, the start and end of the current region.
- FUNCTION may set `yank-undo-function' to override the UNDO value."
+ given two arguments, the start and end of the region. FUNCTION
+ may set `yank-undo-function' to override UNDO."
(let* ((handler (and (stringp string)
(get-text-property 0 'yank-handler string)))
(param (or (nth 1 handler) string))
end)
(setq yank-undo-function t)
- (if (nth 0 handler) ;; FUNCTION
+ (if (nth 0 handler) ; FUNCTION
(funcall (car handler) param)
(insert param))
(setq end (point))
;; following text property changes.
(setq inhibit-read-only t)
- ;; What should we do with `font-lock-face' properties?
- (if font-lock-defaults
- ;; No, just wipe them.
- (remove-list-of-text-properties opoint end '(font-lock-face))
- ;; Convert them to `face'.
- (save-excursion
- (goto-char opoint)
- (while (< (point) end)
- (let ((face (get-text-property (point) 'font-lock-face))
- run-end)
- (setq run-end
- (next-single-property-change (point) 'font-lock-face nil end))
- (when face
- (remove-text-properties (point) run-end '(font-lock-face nil))
- (put-text-property (point) run-end 'face face))
- (goto-char run-end)))))
-
- (unless (nth 2 handler) ;; NOEXCLUDE
- (remove-yank-excluded-properties opoint (point)))
+ (unless (nth 2 handler) ; NOEXCLUDE
+ (remove-yank-excluded-properties opoint end))
;; If last inserted char has properties, mark them as rear-nonsticky.
(if (and (> end opoint)
(text-properties-at (1- end)))
(put-text-property (1- end) end 'rear-nonsticky t))
- (if (eq yank-undo-function t) ;; not set by FUNCTION
- (setq yank-undo-function (nth 3 handler))) ;; UNDO
- (if (nth 4 handler) ;; COMMAND
+ (if (eq yank-undo-function t) ; not set by FUNCTION
+ (setq yank-undo-function (nth 3 handler))) ; UNDO
+ (if (nth 4 handler) ; COMMAND
(setq this-command (nth 4 handler)))))
(defun insert-buffer-substring-no-properties (buffer &optional start end)
(insert-buffer-substring buffer start end)
(remove-yank-excluded-properties opoint (point))))
+(defun yank-handle-font-lock-face-property (face start end)
+ "If `font-lock-defaults' is nil, apply FACE as a `face' property.
+START and END denote the start and end of the text to act on.
+Do nothing if FACE is nil."
+ (and face
+ (null font-lock-defaults)
+ (put-text-property start end 'face face)))
+
+;; This removes `mouse-face' properties in *Help* buffer buttons:
+;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
+(defun yank-handle-category-property (category start end)
+ "Apply property category CATEGORY's properties between START and END."
+ (when category
+ (let ((start2 start))
+ (while (< start2 end)
+ (let ((end2 (next-property-change start2 nil end))
+ (original (text-properties-at start2)))
+ (set-text-properties start2 end2 (symbol-plist category))
+ (add-text-properties start2 end2 original)
+ (setq start2 end2))))))
+
\f
;;;; Synchronous shell commands.
(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.
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-window (selected-window))
- ;; It is necessary to save all of these, because calling
- ;; select-window changes frame-selected-window for whatever
- ;; frame that window is in.
- (save-selected-window-alist
- (mapcar (lambda (frame) (list frame (frame-selected-window frame)))
- (frame-list))))
+ `(let ((save-selected-window--state
+ (internal--before-with-selected-window ,window)))
(save-current-buffer
(unwind-protect
- (progn (select-window ,window 'norecord)
+ (progn (select-window (car save-selected-window--state) 'norecord)
,@body)
- (dolist (elt save-selected-window-alist)
- (and (frame-live-p (car elt))
- (window-live-p (cadr elt))
- (set-frame-selected-window (car elt) (cadr elt) 'norecord)))
- (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.
(unwind-protect (progn ,@body)
(set-window-configuration ,c)))))
+(defun temp-output-buffer-show (buffer)
+ "Internal function for `with-output-to-temp-buffer'."
+ (with-current-buffer buffer
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))
+
+ (if temp-buffer-show-function
+ (funcall temp-buffer-show-function buffer)
+ (with-current-buffer buffer
+ (let* ((window
+ (let ((window-combination-limit
+ ;; When `window-combination-limit' equals
+ ;; `temp-buffer' or `temp-buffer-resize' and
+ ;; `temp-buffer-resize-mode' is enabled in this
+ ;; buffer bind it to t so resizing steals space
+ ;; preferably from the window that was split.
+ (if (or (eq window-combination-limit 'temp-buffer)
+ (and (eq window-combination-limit
+ 'temp-buffer-resize)
+ temp-buffer-resize-mode))
+ t
+ window-combination-limit)))
+ (display-buffer buffer)))
+ (frame (and window (window-frame window))))
+ (when window
+ (unless (eq frame (selected-frame))
+ (make-frame-visible frame))
+ (setq minibuffer-scroll-window window)
+ (set-window-hscroll window 0)
+ ;; Don't try this with NOFORCE non-nil!
+ (set-window-start window (point-min) t)
+ ;; This hould not be necessary.
+ (set-window-point window (point-min))
+ ;; Run `temp-buffer-show-hook', with the chosen window selected.
+ (with-selected-window window
+ (run-hooks 'temp-buffer-show-hook))))))
+ ;; Return nil.
+ nil)
+
(defmacro with-output-to-temp-buffer (bufname &rest body)
"Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
(run-hooks 'temp-buffer-setup-hook)))))
(standard-output ,buf))
(prog1 (progn ,@body)
- (internal-temp-output-buffer-show ,buf)))))
+ (temp-output-buffer-show ,buf)))))
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
(replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
- => \" bar foo\"
-"
+ => \" bar foo\""
;; To avoid excessive consing from multiple matches in long strings,
;; don't just call `replace-match' continually. Walk down the
table))
(defun syntax-after (pos)
- "Return the raw syntax of the char after POS.
+ "Return the raw syntax descriptor for the char after POS.
If POS is outside the buffer's accessible portion, return nil."
(unless (or (< pos (point-min)) (>= pos (point-max)))
(let ((st (if parse-sexp-lookup-properties
(aref (or st (syntax-table)) (char-after pos))))))
(defun syntax-class (syntax)
- "Return the syntax class part of the syntax descriptor SYNTAX.
+ "Return the code for the syntax class described by SYNTAX.
+
+SYNTAX should be a raw syntax descriptor; the return value is a
+integer which encodes the corresponding syntax class. See Info
+node `(elisp)Syntax Table Internals' for a list of codes.
+
If SYNTAX is nil, return nil."
(and syntax (logand (car syntax) 65535)))
\f
(put symbol 'abortfunc (or abortfunc 'kill-buffer))
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
\f
+(defun set-temporary-overlay-map (map &optional keep-pred)
+ "Set MAP as a temporary overlay map.
+When KEEP-PRED is `t', using a key from the temporary keymap
+leaves this keymap activated. KEEP-PRED can also be a function,
+which will have the same effect when it returns `t'.
+When KEEP-PRED is nil, the temporary keymap is used only once."
+ (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
+ (overlaysym (make-symbol "t"))
+ (alist (list (cons overlaysym map)))
+ (clearfun
+ ;; FIXME: Use lexical-binding.
+ `(lambda ()
+ (unless ,(cond ((null keep-pred) nil)
+ ((eq t keep-pred)
+ `(eq this-command
+ (lookup-key ',map
+ (this-command-keys-vector))))
+ (t `(funcall ',keep-pred)))
+ (set ',overlaysym nil) ;Just in case.
+ (remove-hook 'pre-command-hook ',clearfunsym)
+ (setq emulation-mode-map-alists
+ (delq ',alist emulation-mode-map-alists))))))
+ (set overlaysym overlaysym)
+ (fset clearfunsym clearfun)
+ (add-hook 'pre-command-hook clearfunsym)
+ ;; FIXME: That's the keymaps with highest precedence, except for
+ ;; the `keymap' text-property ;-(
+ (push alist emulation-mode-map-alists)))
+
;;;; Progress reporters.
;; Progress reporter has the following structure:
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup tar nil
"Simple editing of tar files."
;; state correctly: the raw data is expected to be always larger than
;; the summary.
(progn
- (assert (or (= (buffer-size tar-data-buffer) (buffer-size))
+ (cl-assert (or (= (buffer-size tar-data-buffer) (buffer-size))
(eq tar-data-swapped
(> (buffer-size tar-data-buffer) (buffer-size)))))
tar-data-swapped)))
\f
;;; down to business.
-(defstruct (tar-header
+(cl-defstruct (tar-header
(:constructor nil)
(:type vector)
:named
This is a list of name, mode, uid, gid, size,
write-date, checksum, link-type, and link-name."
(if (> (+ pos 512) (point-max)) (error "Malformed Tar header"))
- (assert (zerop (mod (- pos (point-min)) 512)))
- (assert (not enable-multibyte-characters))
+ (cl-assert (zerop (mod (- pos (point-min)) 512)))
+ (cl-assert (not enable-multibyte-characters))
(let ((string (buffer-substring pos (setq pos (+ pos 512)))))
(when ;(some 'plusp string) ; <-- oops, massive cycle hog!
(or (not (= 0 (aref string 0))) ; This will do.
(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))))
(defun tar-header-block-checksum (string)
"Compute and return a tar-acceptable checksum for this block."
- (assert (not (multibyte-string-p string)))
+ (cl-assert (not (multibyte-string-p string)))
(let* ((chk-field-start tar-chk-offset)
(chk-field-end (+ chk-field-start 8))
(sum 0)
(defun tar-clip-time-string (time)
(let ((str (current-time-string time)))
- (concat " " (substring str 4 16) (substring str 19 24))))
+ (concat " " (substring str 4 16) (format-time-string " %Y" time))))
(defun tar-grind-file-mode (mode)
"Construct a `-rw--r--r--' string indicating MODE.
((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)
(defun tar-summarize-buffer ()
"Parse the contents of the tar file in the current buffer."
- (assert (tar-data-swapped-p))
+ (cl-assert (tar-data-swapped-p))
(let* ((modified (buffer-modified-p))
(result '())
(pos (point-min))
(define-key map "R" 'tar-rename-entry)
(define-key map "u" 'tar-unflag)
(define-key map "v" 'tar-view)
+ (define-key map "w" 'woman-tar-extract-file)
(define-key map "x" 'tar-expunge)
(define-key map "\177" 'tar-unflag-backwards)
(define-key map "E" 'tar-extract-other-window)
(define-key map [menu-bar immediate]
(cons "Immediate" (make-sparse-keymap "Immediate")))
+ (define-key map [menu-bar immediate woman]
+ '("Read Man Page (WoMan)" . woman-tar-extract-file))
(define-key map [menu-bar immediate view]
'("View This File" . tar-view))
(define-key map [menu-bar immediate display]
(widen)
;; Now move the Tar data into an auxiliary buffer, so we can use the main
;; buffer for the summary.
- (assert (not (tar-data-swapped-p)))
+ (cl-assert (not (tar-data-swapped-p)))
(set (make-local-variable 'revert-buffer-function) 'tar-mode-revert)
;; We started using write-contents-functions, but this hook is not
;; used during auto-save, so we now use
(fundamental-mode)
(signal (car err) (cdr err)))))
+(autoload 'woman-tar-extract-file "woman"
+ "In tar mode, run the WoMan man-page browser on this file." t)
(define-minor-mode tar-subfile-mode
"Minor mode for editing an element of a tar-file.
((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))
(insert (tar-header-block-summarize descriptor) "\n")))
(forward-line -1) (move-to-column col))
- (assert (tar-data-swapped-p))
+ (cl-assert (tar-data-swapped-p))
(with-current-buffer tar-data-buffer
(let* ((start (- (tar-header-data-start descriptor) 512)))
;;
;; delete the old field and insert a new one.
(goto-char (+ start data-position))
(delete-region (point) (+ (point) (length new-data-string))) ; <--
- (assert (not (or enable-multibyte-characters
- (multibyte-string-p new-data-string))))
+ (cl-assert (not (or enable-multibyte-characters
+ (multibyte-string-p new-data-string))))
(insert new-data-string)
;;
;; compute a new checksum and insert it.
;;
;; Blink, is not supported. Currently it's mapped as bold.
;;
-;; Important caveat:
-;; -----------------
-;; if you want custom colors in term.el redefine term-default-fg-color
-;; and term-default-bg-color BEFORE loading it.
-;;
;; ----------------------------------------
;;
;; If you'd like to check out my complete configuration, you can download
;; so it is important to increase it if there are protocol-relevant changes.
(defconst term-protocol-version "0.96")
-(eval-when-compile
- (require 'ange-ftp)
- (require 'cl))
+(eval-when-compile (require 'ange-ftp))
(require 'ring)
(require 'ehelp)
"A queue of strings whose echo we want suppressed.")
(defvar term-terminal-parameter)
(defvar term-terminal-previous-parameter)
-(defvar term-current-face 'default)
+(defvar term-current-face 'term-face)
(defvar term-scroll-start 0 "Top-most line (inclusive) of scrolling region.")
(defvar term-scroll-end) ; Number of line (zero-based) after scrolling region.
(defvar term-pager-count nil
(define-key map "\C-c\C-k" 'term-char-mode)
(define-key map "\C-c\C-j" 'term-line-mode)
(define-key map "\C-c\C-q" 'term-pager-toggle)
+ ;; completion: (line mode only)
+ (easy-menu-define nil map "Complete menu for Term mode."
+ '("Complete"
+ ["Complete Before Point" term-dynamic-complete t]
+ ["Complete File Name" term-dynamic-complete-filename t]
+ ["File Completion Listing" term-dynamic-list-filename-completions t]
+ ["Expand File Name" term-replace-by-expanded-filename t]))
+ ;; Input history: (line mode only)
+ (easy-menu-define nil map "In/Out menu for Term mode."
+ '("In/Out"
+ ["Expand History Before Point" term-replace-by-expanded-history
+ term-input-autoexpand]
+ ["List Input History" term-dynamic-list-input-ring t]
+ ["Previous Input" term-previous-input t]
+ ["Next Input" term-next-input t]
+ ["Previous Matching Current Input"
+ term-previous-matching-input-from-input t]
+ ["Next Matching Current Input" term-next-matching-input-from-input t]
+ ["Previous Matching Input..." term-previous-matching-input t]
+ ["Next Matching Input..." term-next-matching-input t]
+ ["Backward Matching Input..." term-backward-matching-input t]
+ ["Forward Matching Input..." term-forward-matching-input t]
+ ["Copy Old Input" term-copy-old-input t]
+ ["Kill Current Input" term-kill-input t]
+ ["Show Current Output Group" term-show-output t]
+ ["Show Maximum Output" term-show-maximum-output t]
+ ["Backward Output Group" term-previous-prompt t]
+ ["Forward Output Group" term-next-prompt t]
+ ["Kill Current Output Group" term-kill-output t]))
+ map)
+ "Keymap for Term mode.")
- ;; ;; completion:
- ;; (define-key map [menu-bar completion]
- ;; (cons "Complete" (make-sparse-keymap "Complete")))
- ;; (define-key map [menu-bar completion complete-expand]
- ;; '("Expand File Name" . term-replace-by-expanded-filename))
- ;; (define-key map [menu-bar completion complete-listing]
- ;; '("File Completion Listing" . term-dynamic-list-filename-completions))
- ;; (define-key map [menu-bar completion complete-file]
- ;; '("Complete File Name" . term-dynamic-complete-filename))
- ;; (define-key map [menu-bar completion complete]
- ;; '("Complete Before Point" . term-dynamic-complete))
- ;; ;; Put them in the menu bar:
- ;; (setq menu-bar-final-items (append '(terminal completion inout signals)
- ;; menu-bar-final-items))
- map))
-
-(defvar term-raw-map nil
- "Keyboard map for sending characters directly to the inferior process.")
(defvar term-escape-char nil
"Escape character for char sub-mode of term mode.
Do not change it directly; use `term-set-escape-char' instead.")
-(defvar term-raw-escape-map nil)
-(defvar term-pager-break-map nil)
+(defvar term-pager-break-map
+ (let ((map (make-keymap)))
+ ;; (dotimes (i 128)
+ ;; (define-key map (make-string 1 i) 'term-send-raw))
+ (define-key map "\e" (lookup-key (current-global-map) "\e"))
+ (define-key map "\C-x" (lookup-key (current-global-map) "\C-x"))
+ (define-key map "\C-u" (lookup-key (current-global-map) "\C-u"))
+ (define-key map " " 'term-pager-page)
+ (define-key map "\r" 'term-pager-line)
+ (define-key map "?" 'term-pager-help)
+ (define-key map "h" 'term-pager-help)
+ (define-key map "b" 'term-pager-back-page)
+ (define-key map "\177" 'term-pager-back-line)
+ (define-key map "q" 'term-pager-discard)
+ (define-key map "D" 'term-pager-disable)
+ (define-key map "<" 'term-pager-bob)
+ (define-key map ">" 'term-pager-eob)
+ map)
+ "Keymap used in Term pager mode.")
(defvar term-ptyp t
"True if communications via pty; false if by pipe. Buffer local.
; assuming this is Emacs 19.20 or newer.
(defvar term-pager-filter t)
-(put 'term-replace-by-expanded-history 'menu-enable 'term-input-autoexpand)
(put 'term-input-ring 'permanent-local t)
(put 'term-input-ring-index 'permanent-local t)
(put 'term-input-autoexpand 'permanent-local t)
(defmacro term-handling-pager () 'term-pager-old-local-map)
(defmacro term-using-alternate-sub-buffer () 'term-saved-home-marker)
-(defvar term-signals-menu)
-(defvar term-terminal-menu)
-
;; Let's silence the byte-compiler -mm
(defvar term-ansi-at-host nil)
(defvar term-ansi-at-dir nil)
(defvar term-terminal-previous-parameter-3 -1)
(defvar term-terminal-previous-parameter-4 -1)
-;;; faces -mm
-
-(defcustom term-default-fg-color
- ;; FIXME: This depends on the current frame, so depending on when
- ;; it's loaded, the result may be different.
- (face-foreground term-current-face)
- "Default color for foreground in `term'."
+;;; Faces
+(defvar ansi-term-color-vector
+ [term-face
+ term-color-black
+ term-color-red
+ term-color-green
+ term-color-yellow
+ term-color-blue
+ term-color-magenta
+ term-color-cyan
+ term-color-white])
+
+(defcustom term-default-fg-color nil
+ "If non-nil, default color for foreground in Term mode.
+This is deprecated in favor of customizing the `term-face' face."
:group 'term
:type 'string)
-(defcustom term-default-bg-color
- ;; FIXME: This depends on the current frame, so depending on when
- ;; it's loaded, the result may be different.
- (face-background term-current-face)
- "Default color for background in `term'."
+(defcustom term-default-bg-color nil
+ "If non-nil, default color for foreground in Term mode.
+This is deprecated in favor of customizing the `term-face' face."
:group 'term
:type 'string)
-;; Use the same colors that xterm uses, see `xterm-standard-colors'.
-(defvar ansi-term-color-vector
- [unspecified "black" "red3" "green3" "yellow3" "blue2"
- "magenta3" "cyan3" "white"])
+(defface term-face
+ `((t
+ :foreground ,term-default-fg-color
+ :background ,term-default-bg-color
+ :inherit default))
+ "Default face to use in Term mode."
+ :group 'term)
+
+(defface term-bold
+ '((t :bold t))
+ "Default face to use for bold text."
+ :group 'term)
+
+(defface term-underline
+ '((t :underline t))
+ "Default face to use for underlined text."
+ :group 'term)
+
+(defface term-color-black
+ '((t :foreground "black" :background "black"))
+ "Face used to render black color code."
+ :group 'term)
+
+(defface term-color-red
+ '((t :foreground "red3" :background "red3"))
+ "Face used to render red color code."
+ :group 'term)
+
+(defface term-color-green
+ '((t :foreground "green3" :background "green3"))
+ "Face used to render green color code."
+ :group 'term)
+
+(defface term-color-yellow
+ '((t :foreground "yellow3" :background "yellow3"))
+ "Face used to render yellow color code."
+ :group 'term)
+
+(defface term-color-blue
+ '((t :foreground "blue2" :background "blue2"))
+ "Face used to render blue color code."
+ :group 'term)
+
+(defface term-color-magenta
+ '((t :foreground "magenta3" :background "magenta3"))
+ "Face used to render magenta color code."
+ :group 'term)
+
+(defface term-color-cyan
+ '((t :foreground "cyan3" :background "cyan3"))
+ "Face used to render cyan color code."
+ :group 'term)
+
+(defface term-color-white
+ '((t :foreground "white" :background "white"))
+ "Face used to render white color code."
+ :group 'term)
;; Inspiration came from comint.el -mm
(defcustom term-buffer-maximum-size 2048
:group 'term
:type 'integer)
\f
-(when (featurep 'xemacs)
- (defvar term-terminal-menu
- '("Terminal"
- [ "Character mode" term-char-mode (term-in-line-mode)]
- [ "Line mode" term-line-mode (term-in-char-mode)]
- [ "Enable paging" term-pager-toggle (not term-pager-count)]
- [ "Disable paging" term-pager-toggle term-pager-count])))
-
-;; Menu bars:
-(unless (featurep 'xemacs)
- ;; terminal:
- (let (newmap)
- (setq newmap (make-sparse-keymap "Terminal"))
- (define-key newmap [terminal-pager-enable]
- '(menu-item "Enable paging" term-fake-pager-enable
- :help "Enable paging feature"))
- (define-key newmap [terminal-pager-disable]
- '(menu-item "Disable paging" term-fake-pager-disable
- :help "Disable paging feature"))
- (define-key newmap [terminal-char-mode]
- '(menu-item "Character mode" term-char-mode
- :help "Switch to char (raw) sub-mode of term mode"))
- (define-key newmap [terminal-line-mode]
- '(menu-item "Line mode" term-line-mode
- :help "Switch to line (cooked) sub-mode of term mode"))
- (setq term-terminal-menu (cons "Terminal" newmap))
-
- ;; completion: (line mode only)
- (defvar term-completion-menu (make-sparse-keymap "Complete"))
- (define-key term-mode-map [menu-bar completion]
- (cons "Complete" term-completion-menu))
- (define-key term-completion-menu [complete-expand]
- '("Expand File Name" . term-replace-by-expanded-filename))
- (define-key term-completion-menu [complete-listing]
- '("File Completion Listing" . term-dynamic-list-filename-completions))
- (define-key term-completion-menu [menu-bar completion complete-file]
- '("Complete File Name" . term-dynamic-complete-filename))
- (define-key term-completion-menu [menu-bar completion complete]
- '("Complete Before Point" . term-dynamic-complete))
-
- ;; Input history: (line mode only)
- (defvar term-inout-menu (make-sparse-keymap "In/Out"))
- (define-key term-mode-map [menu-bar inout]
- (cons "In/Out" term-inout-menu))
- (define-key term-inout-menu [kill-output]
- '("Kill Current Output Group" . term-kill-output))
- (define-key term-inout-menu [next-prompt]
- '("Forward Output Group" . term-next-prompt))
- (define-key term-inout-menu [previous-prompt]
- '("Backward Output Group" . term-previous-prompt))
- (define-key term-inout-menu [show-maximum-output]
- '("Show Maximum Output" . term-show-maximum-output))
- (define-key term-inout-menu [show-output]
- '("Show Current Output Group" . term-show-output))
- (define-key term-inout-menu [kill-input]
- '("Kill Current Input" . term-kill-input))
- (define-key term-inout-menu [copy-input]
- '("Copy Old Input" . term-copy-old-input))
- (define-key term-inout-menu [forward-matching-history]
- '("Forward Matching Input..." . term-forward-matching-input))
- (define-key term-inout-menu [backward-matching-history]
- '("Backward Matching Input..." . term-backward-matching-input))
- (define-key term-inout-menu [next-matching-history]
- '("Next Matching Input..." . term-next-matching-input))
- (define-key term-inout-menu [previous-matching-history]
- '("Previous Matching Input..." . term-previous-matching-input))
- (define-key term-inout-menu [next-matching-history-from-input]
- '("Next Matching Current Input" . term-next-matching-input-from-input))
- (define-key term-inout-menu [previous-matching-history-from-input]
- '("Previous Matching Current Input" .
- term-previous-matching-input-from-input))
- (define-key term-inout-menu [next-history]
- '("Next Input" . term-next-input))
- (define-key term-inout-menu [previous-history]
- '("Previous Input" . term-previous-input))
- (define-key term-inout-menu [list-history]
- '("List Input History" . term-dynamic-list-input-ring))
- (define-key term-inout-menu [expand-history]
- '("Expand History Before Point" . term-replace-by-expanded-history))
-
- ;; Signals
- (setq newmap (make-sparse-keymap "Signals"))
- (define-key term-mode-map [menu-bar signals]
- (setq term-signals-menu (cons "Signals" newmap)))
- (define-key newmap [eof]
- '(menu-item "EOF" term-send-eof
- :help "Send an EOF to the current buffer's process"))
- (define-key newmap [kill]
- '(menu-item "KILL" term-kill-subjob
- :help "Send kill signal to the current subjob"))
- (define-key newmap [quit]
- '(menu-item "QUIT" term-quit-subjob
- :help "Send quit signal to the current subjob."))
- (define-key newmap [cont]
- '(menu-item "CONT" term-continue-subjob
- :help "Send CONT signal to process buffer's process group"))
- (define-key newmap [stop]
- '(menu-item "STOP" term-stop-subjob
- :help "Stop the current subjob"))
- (define-key newmap [brk]
- '(menu-item "BREAK" term-interrupt-subjob
- :help "Interrupt the current subjob"))
- ))
-\f
;; Set up term-raw-map, etc.
-(defun term-set-escape-char (c)
+(defvar term-raw-map
+ (let* ((map (make-keymap))
+ (esc-map (make-keymap))
+ (i 0))
+ (while (< i 128)
+ (define-key map (make-string 1 i) 'term-send-raw)
+ ;; Avoid O and [. They are used in escape sequences for various keys.
+ (unless (or (eq i ?O) (eq i 91))
+ (define-key esc-map (make-string 1 i) 'term-send-raw-meta))
+ (setq i (1+ i)))
+ (define-key map [remap self-insert-command] 'term-send-raw)
+ (define-key map "\e" esc-map)
+
+ ;; Added nearly all the 'gray keys' -mm
+
+ (if (featurep 'xemacs)
+ (define-key map [button2] 'term-mouse-paste)
+ (define-key map [mouse-2] 'term-mouse-paste))
+ (define-key map [up] 'term-send-up)
+ (define-key map [down] 'term-send-down)
+ (define-key map [right] 'term-send-right)
+ (define-key map [left] 'term-send-left)
+ (define-key map [delete] 'term-send-del)
+ (define-key map [deletechar] 'term-send-del)
+ (define-key map [backspace] 'term-send-backspace)
+ (define-key map [home] 'term-send-home)
+ (define-key map [end] 'term-send-end)
+ (define-key map [insert] 'term-send-insert)
+ (define-key map [S-prior] 'scroll-down)
+ (define-key map [S-next] 'scroll-up)
+ (define-key map [S-insert] 'term-paste)
+ (define-key map [prior] 'term-send-prior)
+ (define-key map [next] 'term-send-next)
+ map)
+ "Keyboard map for sending characters directly to the inferior process.")
+
+(easy-menu-define term-terminal-menu
+ (list term-mode-map term-raw-map term-pager-break-map)
+ "Terminal menu for Term mode."
+ '("Terminal"
+ ["Line mode" term-line-mode :active (term-in-char-mode)
+ :help "Switch to line (cooked) sub-mode of term mode"]
+ ["Character mode" term-char-mode :active (term-in-line-mode)
+ :help "Switch to char (raw) sub-mode of term mode"]
+ ["Paging" term-pager-toggle :style toggle :selected term-pager-count
+ :help "Toggle paging feature"]))
+
+(easy-menu-define term-signals-menu
+ (list term-mode-map term-raw-map term-pager-break-map)
+ "Signals menu for Term mode."
+ '("Signals"
+ ["BREAK" term-interrupt-subjob :active t
+ :help "Interrupt the current subjob"]
+ ["STOP" term-stop-subjob :active t :help "Stop the current subjob"]
+ ["CONT" term-continue-subjob :active t
+ :help "Send CONT signal to process buffer's process group"]
+ ["QUIT" term-quit-subjob :active t
+ :help "Send quit signal to the current subjob"]
+ ["KILL" term-kill-subjob :active t
+ :help "Send kill signal to the current subjob"]
+ ["EOF" term-send-eof :active t
+ :help "Send an EOF to the current buffer's process"]))
+
+(easy-menu-define term-pager-menu term-pager-break-map
+ "Menu for Term pager mode."
+ '("More pages?"
+ ["1 page forwards" term-pager-page t]
+ ["1 page backwards" term-pager-back-page t]
+ ["1 line backwards" term-pager-back-line t]
+ ["1 line forwards" term-pager-line t]
+ ["Goto to beginning" term-pager-bob t]
+ ["Goto to end" term-pager-eob t]
+ ["Discard remaining output" term-pager-discard t]
+ ["Disable paging" term-pager-toggle t]
+ ["Help" term-pager-help t]))
+
+(defvar term-raw-escape-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map 'Control-X-prefix)
+ ;; Define standard bindings in term-raw-escape-map.
+ (define-key map "\C-v" (lookup-key (current-global-map) "\C-v"))
+ (define-key map "\C-u" (lookup-key (current-global-map) "\C-u"))
+ (define-key map "\C-q" 'term-pager-toggle)
+ ;; The keybinding for term-char-mode is needed by the menubar code.
+ (define-key map "\C-k" 'term-char-mode)
+ (define-key map "\C-j" 'term-line-mode)
+ ;; It's convenient to have execute-extended-command here.
+ (define-key map [?\M-x] 'execute-extended-command)
+ map))
+
+(defun term-set-escape-char (key)
"Change `term-escape-char' and keymaps that depend on it."
(when term-escape-char
+ ;; Undo previous term-set-escape-char.
(define-key term-raw-map term-escape-char 'term-send-raw))
- (setq c (make-string 1 c))
- (define-key term-raw-map c term-raw-escape-map)
- ;; Define standard bindings in term-raw-escape-map
- (define-key term-raw-escape-map "\C-v"
- (lookup-key (current-global-map) "\C-v"))
- (define-key term-raw-escape-map "\C-u"
- (lookup-key (current-global-map) "\C-u"))
- (define-key term-raw-escape-map c 'term-send-raw)
- (define-key term-raw-escape-map "\C-q" 'term-pager-toggle)
- ;; The keybinding for term-char-mode is needed by the menubar code.
- (define-key term-raw-escape-map "\C-k" 'term-char-mode)
- (define-key term-raw-escape-map "\C-j" 'term-line-mode)
- ;; It's convenient to have execute-extended-command here.
- (define-key term-raw-escape-map [?\M-x] 'execute-extended-command))
-
-(let* ((map (make-keymap))
- (esc-map (make-keymap))
- (i 0))
- (while (< i 128)
- (define-key map (make-string 1 i) 'term-send-raw)
- ;; Avoid O and [. They are used in escape sequences for various keys.
- (unless (or (eq i ?O) (eq i 91))
- (define-key esc-map (make-string 1 i) 'term-send-raw-meta))
- (setq i (1+ i)))
- (define-key map [remap self-insert-command] 'term-send-raw)
- (define-key map "\e" esc-map)
- (setq term-raw-map map)
- (setq term-raw-escape-map (copy-keymap 'Control-X-prefix))
-
- ;; Added nearly all the 'gray keys' -mm
+ (setq term-escape-char (vector key))
+ (define-key term-raw-map term-escape-char term-raw-escape-map)
+ ;; FIXME: If we later call term-set-escape-char again with another key,
+ ;; we should undo this binding.
+ (define-key term-raw-escape-map term-escape-char 'term-send-raw))
- (if (featurep 'xemacs)
- (define-key term-raw-map [button2] 'term-mouse-paste)
- (define-key term-raw-map [mouse-2] 'term-mouse-paste)
- (define-key term-raw-map [menu-bar terminal] term-terminal-menu)
- (define-key term-raw-map [menu-bar signals] term-signals-menu))
- (define-key term-raw-map [up] 'term-send-up)
- (define-key term-raw-map [down] 'term-send-down)
- (define-key term-raw-map [right] 'term-send-right)
- (define-key term-raw-map [left] 'term-send-left)
- (define-key term-raw-map [delete] 'term-send-del)
- (define-key term-raw-map [deletechar] 'term-send-del)
- (define-key term-raw-map [backspace] 'term-send-backspace)
- (define-key term-raw-map [home] 'term-send-home)
- (define-key term-raw-map [end] 'term-send-end)
- (define-key term-raw-map [insert] 'term-send-insert)
- (define-key term-raw-map [S-prior] 'scroll-down)
- (define-key term-raw-map [S-next] 'scroll-up)
- (define-key term-raw-map [S-insert] 'term-paste)
- (define-key term-raw-map [prior] 'term-send-prior)
- (define-key term-raw-map [next] 'term-send-next))
-
-(term-set-escape-char ?\C-c)
+(term-set-escape-char (or term-escape-char ?\C-c))
(defvar overflow-newline-into-fringe)
(defun term-window-width ()
- (if (featurep 'xemacs)
- (1- (window-width))
- (if (and window-system overflow-newline-into-fringe)
- (window-width)
- (1- (window-width)))))
+ (if (and (not (featurep 'xemacs))
+ (display-graphic-p)
+ overflow-newline-into-fringe
+ (/= (frame-parameter nil 'right-fringe) 0))
+ (window-width)
+ (1- (window-width))))
\f
(put 'term-mode 'mode-class 'special)
dt))
(defun term-ansi-reset ()
- (setq term-current-face (nconc
- (if term-default-bg-color
- (list :background term-default-bg-color))
- (if term-default-fg-color
- (list :foreground term-default-fg-color))))
+ (setq term-current-face 'term-face)
(setq term-ansi-current-underline nil)
(setq term-ansi-current-bold nil)
(setq term-ansi-current-reverse nil)
(setq term-ansi-current-color 0)
(setq term-ansi-current-invisible nil)
- (setq term-ansi-face-already-done t)
+ ;; Stefan thought this should be t, but could not remember why.
+ ;; Setting it to t seems to cause bug#11785. Setting it to nil
+ ;; again to see if there are other consequences...
+ (setq term-ansi-face-already-done nil)
(setq term-ansi-current-bg-color 0))
-(defun term-mode ()
+(define-derived-mode term-mode fundamental-mode "Term"
"Major mode for interacting with an inferior interpreter.
The interpreter name is same as buffer name, sans the asterisks.
\\{term-mode-map}
Entry to this mode runs the hooks on `term-mode-hook'."
- (interactive)
- ;; Do not remove this. All major modes must do this.
- (kill-all-local-variables)
- (setq major-mode 'term-mode)
- (setq mode-name "Term")
- (use-local-map term-mode-map)
;; we do not want indent to sneak in any tabs
(setq indent-tabs-mode nil)
(setq buffer-display-table term-display-table)
- (make-local-variable 'term-home-marker)
- (setq term-home-marker (copy-marker 0))
+ (set (make-local-variable 'term-home-marker) (copy-marker 0))
+ (set (make-local-variable 'term-height) (1- (window-height)))
+ (set (make-local-variable 'term-width) (term-window-width))
+ (set (make-local-variable 'term-last-input-start) (make-marker))
+ (set (make-local-variable 'term-last-input-end) (make-marker))
+ (set (make-local-variable 'term-last-input-match) "")
+ (set (make-local-variable 'term-command-hook)
+ (symbol-function 'term-command-hook))
+
+ ;; These local variables are set to their local values:
(make-local-variable 'term-saved-home-marker)
- (make-local-variable 'term-height)
- (make-local-variable 'term-width)
- (setq term-width (term-window-width))
- (setq term-height (1- (window-height)))
(make-local-variable 'term-terminal-parameter)
(make-local-variable 'term-saved-cursor)
- (make-local-variable 'term-last-input-start)
- (setq term-last-input-start (make-marker))
- (make-local-variable 'term-last-input-end)
- (setq term-last-input-end (make-marker))
- (make-local-variable 'term-last-input-match)
- (setq term-last-input-match "")
- (make-local-variable 'term-prompt-regexp) ; Don't set; default
- (make-local-variable 'term-input-ring-size) ; ...to global val.
+ (make-local-variable 'term-prompt-regexp)
+ (make-local-variable 'term-input-ring-size)
(make-local-variable 'term-input-ring)
(make-local-variable 'term-input-ring-file-name)
- (or (and (boundp 'term-input-ring) term-input-ring)
- (setq term-input-ring (make-ring term-input-ring-size)))
(make-local-variable 'term-input-ring-index)
- (or (and (boundp 'term-input-ring-index) term-input-ring-index)
- (setq term-input-ring-index nil))
-
- (make-local-variable 'term-command-hook)
- (setq term-command-hook (symbol-function 'term-command-hook))
+ (unless term-input-ring
+ (setq term-input-ring (make-ring term-input-ring-size)))
;; I'm not sure these saves are necessary but, since I
;; haven't tested the whole thing on a net connected machine with
;; a properly configured ange-ftp, I've decided to be conservative
;; and put them in. -mm
- (make-local-variable 'term-ansi-at-host)
- (setq term-ansi-at-host (system-name))
-
- (make-local-variable 'term-ansi-at-dir)
- (setq term-ansi-at-dir default-directory)
-
- (make-local-variable 'term-ansi-at-message)
- (setq term-ansi-at-message nil)
+ (set (make-local-variable 'term-ansi-at-host) (system-name))
+ (set (make-local-variable 'term-ansi-at-dir) default-directory)
+ (set (make-local-variable 'term-ansi-at-message) nil)
;; For user tracking purposes -mm
(make-local-variable 'ange-ftp-default-user)
(make-local-variable 'term-current-row)
(make-local-variable 'term-log-buffer)
(make-local-variable 'term-scroll-start)
- (make-local-variable 'term-scroll-end)
- (setq term-scroll-end term-height)
+ (set (make-local-variable 'term-scroll-end) term-height)
(make-local-variable 'term-scroll-with-delete)
(make-local-variable 'term-pager-count)
(make-local-variable 'term-pager-old-local-map)
(make-local-variable 'term-ptyp)
(make-local-variable 'term-exec-hook)
(make-local-variable 'term-vertical-motion)
- (make-local-variable 'term-pending-delete-marker)
- (setq term-pending-delete-marker (make-marker))
+ (set (make-local-variable 'term-pending-delete-marker) (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
- (make-local-variable 'term-pending-frame)
- (setq term-pending-frame nil)
+ (set (make-local-variable 'term-pending-frame) nil)
;; Cua-mode's keybindings interfere with the term keybindings, disable it.
(set (make-local-variable 'cua-mode) nil)
- (run-mode-hooks 'term-mode-hook)
- (when (featurep 'xemacs)
- (set-buffer-menubar
- (append current-menubar (list term-terminal-menu))))
+
+ (set (make-local-variable 'font-lock-defaults) '(nil t))
+
+ (easy-menu-add term-terminal-menu)
+ (easy-menu-add term-signals-menu)
(or term-input-ring
(setq term-input-ring (make-ring term-input-ring-size)))
(term-update-mode-line))
found))
(defun term-check-size (process)
- (when (or (/= term-height (1- (window-height)))
+ (when (or (/= term-height (window-text-height))
(/= term-width (term-window-width)))
- (term-reset-size (1- (window-height)) (term-window-width))
+ (term-reset-size (window-text-height) (term-window-width))
(set-process-window-size process term-height term-width)))
(defun term-send-raw-string (chars)
(defun term-send-raw-meta ()
(interactive)
(let ((char last-input-event))
- (when (symbolp last-input-event)
+ (when (symbolp char)
;; Convert `return' to C-m, etc.
(let ((tmp (get char 'event-symbol-elements)))
- (when tmp
- (setq char (car tmp)))
- (when (symbolp char)
- (setq tmp (get char 'ascii-character))
- (when tmp
- (setq char tmp)))))
- (setq char (event-basic-type char))
- (term-send-raw-string (if (and (numberp char)
- (> char 127)
- (< char 256))
- (make-string 1 char)
- (format "\e%c" char)))))
+ (if tmp (setq char (car tmp)))
+ (and (symbolp char)
+ (setq tmp (get char 'ascii-character))
+ (setq char tmp))))
+ (when (numberp char)
+ (let ((base (event-basic-type char))
+ (mods (delq 'meta (event-modifiers char))))
+ (if (memq 'control mods)
+ (setq mods (delq 'shift mods)))
+ (term-send-raw-string
+ (format "\e%c"
+ (event-convert-list (append mods (list base)))))))))
(defun term-mouse-paste (click)
"Insert the primary selection at the position clicked on."
(when (term-in-line-mode)
(setq term-old-mode-map (current-local-map))
(use-local-map term-raw-map)
+ (easy-menu-add term-terminal-menu)
+ (easy-menu-add term-signals-menu)
;; Send existing partial line to inferior (without newline).
(let ((pmark (process-mark (get-buffer-process (current-buffer))))
(term-update-mode-line)))
(defun term-update-mode-line ()
- (let ((term-mode (if (term-in-char-mode) "char" "line"))
- (term-page (when (term-pager-enabled) " page"))
+ (let ((term-mode
+ (if (term-in-char-mode)
+ (propertize "char"
+ 'help-echo "mouse-1: Switch to line mode"
+ 'mouse-face 'mode-line-highlight
+ 'local-map
+ '(keymap
+ (mode-line keymap (down-mouse-1 . term-line-mode))))
+ (propertize "line"
+ 'help-echo "mouse-1: Switch to char mode"
+ 'mouse-face 'mode-line-highlight
+ 'local-map
+ '(keymap
+ (mode-line keymap (down-mouse-1 . term-char-mode))))))
+ (term-page
+ (when (term-pager-enabled)
+ (concat " "
+ (propertize
+ "page"
+ 'help-echo "mouse-1: Disable paging"
+ 'mouse-face 'mode-line-highlight
+ 'local-map
+ '(keymap
+ (mode-line keymap (down-mouse-1 .
+ term-pager-toggle)))))))
(serial-item-speed)
(serial-item-config)
(proc (get-buffer-process (current-buffer))))
;; from the last character on the line, set the face for the chars
;; to default.
(when (> (point) point-at-eol)
- (put-text-property point-at-eol (point) 'face 'default))))
+ (put-text-property point-at-eol (point) 'font-lock-face 'default))))
;; Insert COUNT copies of CHAR in the default face.
(defun term-insert-char (char count)
(let ((old-point (point)))
(insert-char char count)
- (put-text-property old-point (point) 'face 'default)))
+ (put-text-property old-point (point) 'font-lock-face 'default)))
(defun term-current-row ()
(cond (term-current-row)
(str-length (length str)))
(save-selected-window
- ;; Let's handle the messages. -mm
-
- (let* ((newstr (term-handle-ansi-terminal-messages str)))
- (when (not (eq str newstr))
+ (let ((newstr (term-handle-ansi-terminal-messages str)))
+ (unless (eq str newstr)
(setq handled-ansi-message t
str newstr)))
(setq str-length (length str))
(delete-region term-pending-delete-marker (process-mark proc))
(set-marker term-pending-delete-marker nil))
+ (when (/= (point) (process-mark proc))
+ (setq save-point (point-marker)))
+
+ ;; Note if the window size has changed. We used to reset
+ ;; point too, but that gives incorrect results (Bug#4635).
(if (eq (window-buffer) (current-buffer))
(progn
(setq term-vertical-motion (symbol-function 'vertical-motion))
(term-check-size proc))
(setq term-vertical-motion
(symbol-function 'term-buffer-vertical-motion)))
-
(setq save-marker (copy-marker (process-mark proc)))
-
- (when (/= (point) (process-mark proc))
- (setq save-point (point-marker))
- (goto-char (process-mark proc)))
+ (goto-char (process-mark proc))
(save-restriction
;; If the buffer is in line mode, and there is a partial
(setq term-current-column nil)
(put-text-property old-point (point)
- 'face term-current-face)
+ 'font-lock-face term-current-face)
;; If the last char was written in last column,
;; back up one column, but remember we did so.
;; Thus we emulate xterm/vt100-style line-wrapping.
;; New function to deal with ansi colorized output, as you can see you can
;; have any bold/underline/fg/bg/reverse combination. -mm
-(defvar term-bold-attribute '(:weight bold)
- "Attribute to use for the bold terminal attribute.
-Set it to nil to disable bold.")
-
(defun term-handle-colors-array (parameter)
(cond
;; term-ansi-current-color
;; term-ansi-current-bg-color)
-
(unless term-ansi-face-already-done
(if term-ansi-current-invisible
(let ((color
(if term-ansi-current-reverse
- (if (= term-ansi-current-color 0)
- term-default-fg-color
- (elt ansi-term-color-vector term-ansi-current-color))
- (if (= term-ansi-current-bg-color 0)
- term-default-bg-color
- (elt ansi-term-color-vector term-ansi-current-bg-color)))))
+ (face-foreground
+ (elt ansi-term-color-vector term-ansi-current-color))
+ (face-background
+ (elt ansi-term-color-vector term-ansi-current-bg-color)))))
(setq term-current-face
(list :background color
:foreground color))
) ;; No need to bother with anything else if it's invisible.
-
(setq term-current-face
- (if term-ansi-current-reverse
- (if (= term-ansi-current-color 0)
- (list :background term-default-fg-color
- :foreground term-default-bg-color)
- (list :background
- (elt ansi-term-color-vector term-ansi-current-color)
- :foreground
- (elt ansi-term-color-vector term-ansi-current-bg-color)))
-
- (if (= term-ansi-current-color 0)
- (list :foreground term-default-fg-color
- :background term-default-bg-color)
- (list :foreground
- (elt ansi-term-color-vector term-ansi-current-color)
- :background
- (elt ansi-term-color-vector term-ansi-current-bg-color)))))
+ (list :foreground
+ (face-foreground (elt ansi-term-color-vector term-ansi-current-color))
+ :background
+ (face-background (elt ansi-term-color-vector term-ansi-current-bg-color))
+ :inverse-video term-ansi-current-reverse))
(when term-ansi-current-bold
(setq term-current-face
- (append term-bold-attribute term-current-face)))
+ `(,term-current-face :inherit term-bold)))
+
(when term-ansi-current-underline
(setq term-current-face
- (list* :underline t term-current-face)))))
+ `(,term-current-face :inherit term-underline)))))
;; (message "Debug %S" term-current-face)
;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef
;; The page is full, so enter "pager" mode, and wait for input.
(defun term-process-pager ()
- (when (not term-pager-break-map)
- (let* ((map (make-keymap))
- ;; (i 0)
- tmp)
- ;; (while (< i 128)
- ;; (define-key map (make-string 1 i) 'term-send-raw)
- ;; (setq i (1+ i)))
- (define-key map "\e"
- (lookup-key (current-global-map) "\e"))
- (define-key map "\C-x"
- (lookup-key (current-global-map) "\C-x"))
- (define-key map "\C-u"
- (lookup-key (current-global-map) "\C-u"))
- (define-key map " " 'term-pager-page)
- (define-key map "\r" 'term-pager-line)
- (define-key map "?" 'term-pager-help)
- (define-key map "h" 'term-pager-help)
- (define-key map "b" 'term-pager-back-page)
- (define-key map "\177" 'term-pager-back-line)
- (define-key map "q" 'term-pager-discard)
- (define-key map "D" 'term-pager-disable)
- (define-key map "<" 'term-pager-bob)
- (define-key map ">" 'term-pager-eob)
-
- ;; Add menu bar.
- (unless (featurep 'xemacs)
- (define-key map [menu-bar terminal] term-terminal-menu)
- (define-key map [menu-bar signals] term-signals-menu)
- (setq tmp (make-sparse-keymap "More pages?"))
- (define-key tmp [help] '("Help" . term-pager-help))
- (define-key tmp [disable]
- '("Disable paging" . term-fake-pager-disable))
- (define-key tmp [discard]
- '("Discard remaining output" . term-pager-discard))
- (define-key tmp [eob] '("Goto to end" . term-pager-eob))
- (define-key tmp [bob] '("Goto to beginning" . term-pager-bob))
- (define-key tmp [line] '("1 line forwards" . term-pager-line))
- (define-key tmp [bline] '("1 line backwards" . term-pager-back-line))
- (define-key tmp [back] '("1 page backwards" . term-pager-back-page))
- (define-key tmp [page] '("1 page forwards" . term-pager-page))
- (define-key map [menu-bar page] (cons "More pages?" tmp))
- )
-
- (setq term-pager-break-map map)))
;; (let ((process (get-buffer-process (current-buffer))))
;; (stop-process process))
(setq term-pager-old-local-map (current-local-map))
(use-local-map term-pager-break-map)
+ (easy-menu-add term-terminal-menu)
+ (easy-menu-add term-signals-menu)
+ (easy-menu-add term-pager-menu)
(make-local-variable 'term-old-mode-line-format)
(setq term-old-mode-line-format mode-line-format)
(setq mode-line-format
(interactive)
(if (term-pager-enabled) (term-pager-disable) (term-pager-enable)))
-(unless (featurep 'xemacs)
- (defalias 'term-fake-pager-enable 'term-pager-toggle)
- (defalias 'term-fake-pager-disable 'term-pager-toggle)
- (put 'term-char-mode 'menu-enable '(term-in-line-mode))
- (put 'term-line-mode 'menu-enable '(term-in-char-mode))
- (put 'term-fake-pager-enable 'menu-enable '(not term-pager-count))
- (put 'term-fake-pager-disable 'menu-enable 'term-pager-count))
-
(defun term-pager-help ()
"Provide help on commands available in a terminal-emulator **MORE** break."
(interactive)
(when wrapped
(insert ? ))
(insert ?\n)
- (put-text-property saved-point (point) 'face 'default)
+ (put-text-property saved-point (point) 'font-lock-face 'default)
(goto-char saved-point))))
(defun term-erase-in-display (kind)
;; from the last character on the line, set the face for the chars
;; to default.
(when (>= (point) pnt-at-eol)
- (put-text-property pnt-at-eol (point) 'face 'default))
+ (put-text-property pnt-at-eol (point) 'font-lock-face 'default))
(when (> save-eol (point))
(delete-region (point) save-eol))
(goto-char save-point)
Returns `listed' if a completion listing was shown.
See also `term-dynamic-complete-filename'."
+ (declare (obsolete completion-in-region "23.2"))
(let* ((completion-ignore-case nil)
(candidates (mapcar (function (lambda (x) (list x))) candidates))
(completions (all-completions stub candidates)))
(t
(message "Partially completed")
'partial)))))))
-(make-obsolete 'term-dynamic-simple-complete 'completion-in-region "23.2")
-
(defun term-dynamic-list-filename-completions ()
"List in help buffer possible completions of the filename at point."
-;;; AT386.el --- terminal support package for IBM AT keyboards -*- no-byte-compile: t -*-
+;;; AT386.el --- terminal support package for IBM AT keyboards
;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
-;; -*- no-byte-compile: t -*-
(defun terminal-init-apollo ()
"Terminal initialization function for apollo."
(tty-run-terminal-initialization (selected-frame) "vt100"))
-;; -*- no-byte-compile: t -*-
(defun terminal-init-bobcat ()
"Terminal initialization function for bobcat."
-;;; cygwin.el --- support for the Cygwin terminal -*- no-byte-compile: t -*-
+;;; cygwin.el --- support for the Cygwin terminal
;;; The Cygwin terminal can't really display underlines.
-;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps -*- no-byte-compile: t -*-
+;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps
;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
"Terminal initialization function for iris-ansi."
;; Use inheritance to let the main keymap override these defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap iris-function-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m)))
-;; -*- no-byte-compile: t -*-
;; The Linux console handles Latin-1 by default.
+(declare-function gpm-mouse-enable "t-mouse" ())
+
(defun terminal-init-linux ()
"Terminal initialization function for linux."
(unless (terminal-coding-system)
-;; -*- no-byte-compile: t -*-
;; Define function key sequences for DEC terminals.
(defvar lk201-function-map
(defun terminal-init-lk201 ()
;; Use inheritance to let the main keymap override these defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap lk201-function-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m)))
-;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard -*- no-byte-compile: t -*-
+;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard
;; Copyright (C) 1989, 1993, 2001-2012 Free Software Foundation, Inc.
-;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system
+;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system -*- lexical-binding: t -*-
;; Copyright (C) 1993-1994, 2005-2012 Free Software Foundation, Inc.
(error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
(invocation-name)))
-(eval-when-compile (require 'cl)) ; lexical-let
-
;; Documentation-purposes only: actually loaded in loadup.el.
(require 'frame)
(require 'mouse)
;; nsterm.m.
(defvar ns-input-file)
-(defun ns-handle-nxopen (switch &optional temp)
+(defun ns-handle-nxopen (_switch &optional temp)
(setq unread-command-events (append unread-command-events
(if temp '(ns-open-temp-file)
'(ns-open-file)))
(defun ns-handle-nxopentemp (switch)
(ns-handle-nxopen switch t))
-(defun ns-ignore-1-arg (switch)
+(defun ns-ignore-1-arg (_switch)
(setq x-invocation-args (cdr x-invocation-args)))
(defun ns-parse-geometry (geom)
(mapconcat 'identity (cons "ns-service" path) "-")))))
;; This defines the function.
(defalias name
- (lexical-let ((service service))
- (lambda (arg)
- (interactive "p")
- (let* ((in-string
- (cond ((stringp arg) arg)
- (mark-active
- (buffer-substring (region-beginning) (region-end)))))
- (out-string (ns-perform-service service in-string)))
- (cond
- ((stringp arg) out-string)
- ((and out-string (or (not in-string)
- (not (string= in-string out-string))))
- (if mark-active (delete-region (region-beginning) (region-end)))
- (insert out-string)
- (setq deactivate-mark nil)))))))
+ (lambda (arg)
+ (interactive "p")
+ (let* ((in-string
+ (cond ((stringp arg) arg)
+ (mark-active
+ (buffer-substring (region-beginning) (region-end)))))
+ (out-string (ns-perform-service service in-string)))
+ (cond
+ ((stringp arg) out-string)
+ ((and out-string (or (not in-string)
+ (not (string= in-string out-string))))
+ (if mark-active (delete-region (region-beginning) (region-end)))
+ (insert out-string)
+ (setq deactivate-mark nil))))))
(cond
((lookup-key global-map mapping)
(while (cdr path)
parameters))))))))
;; frame will be focused anyway, so select it
-;; (if this is not done, modeline is dimmed until first interaction)
+;; (if this is not done, mode line is dimmed until first interaction)
(add-hook 'after-make-frame-functions 'select-frame)
(defvar tool-bar-mode)
((not window-pos)
nil)
((eq window-pos 'mode-line)
- 'modeline)
+ 'mode-line)
((eq window-pos 'vertical-line)
'default)
((consp window-pos)
;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html
(ns-set-resource nil "ApplePressAndHoldEnabled" "NO")
+ (x-apply-session-resources)
(setq ns-initialized t))
(add-to-list 'handle-args-function-alist '(ns . x-handle-args))
;; Use inheritance to let the main keymap override those defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap rxvt-function-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m))
-;; -*- no-byte-compile: t -*-
;; Treat a screen terminal similar to an xterm.
(load "term/xterm")
+(declare-function xterm-register-default-colors "xterm" ())
+
(defun terminal-init-screen ()
"Terminal initialization function for screen."
;; Use the xterm color initialization code.
2R delete region |
3R copy region |
-on modeline on \"scroll bar\" in minibuffer
+on mode line on \"scroll bar\" in minibuffer
L scroll-up line to top execute-extended-command
C proportional goto-char line to middle mouse-help
R scroll-down line to bottom eval-expression"
(old-window (selected-window))
(in-minibuf-p (eq y (1- (frame-height))))
(same-window-p (and (not in-minibuf-p) (eq window old-window)))
- (in-modeline-p (eq y (1- (nth 3 edges))))
+ (in-mode-line-p (eq y (1- (nth 3 edges))))
(in-scrollbar-p (>= x (1- (nth 2 edges)))))
(setq x (- x (nth 0 edges)))
(setq y (- y (nth 1 edges)))
; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
- (cond (in-modeline-p
+ (cond (in-mode-line-p
(select-window window)
(cond ((= buttons mouse-left)
(scroll-up))
;;; Code:
-(eval-when-compile (require 'cl))
-
(defvar tvi970-terminal-map
(let ((map (make-sparse-keymap)))
"Terminal initialization function for tvi970."
;; Use inheritance to let the main keymap override these defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap tvi970-terminal-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m))
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt102 ()
"Terminal initialization function for vt102."
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt125 ()
"Terminal initialization function for vt125."
-;; -*- no-byte-compile: t -*-
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt200 ()
-;; -*- no-byte-compile: t -*-
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt201 ()
-;; -*- no-byte-compile: t -*-
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt220 ()
-;; -*- no-byte-compile: t -*-
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt240 ()
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt300 ()
"Terminal initialization function for vt300."
(tty-run-terminal-initialization (selected-frame) "vt100")
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt320 ()
"Terminal initialization function for vt320."
(tty-run-terminal-initialization (selected-frame) "vt100")
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt400 ()
"Terminal initialization function for vt400."
(tty-run-terminal-initialization (selected-frame) "vt100")
-;; -*- no-byte-compile: t -*-
(defun terminal-init-vt420 ()
"Terminal initialization function for vt420."
(tty-run-terminal-initialization (selected-frame) "vt100")
'(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
'(glib "libglib-2.0-0.dll")
'(gobject "libgobject-2.0-0.dll")
- '(gnutls "libgnutls-28.dll" "libgnutls-26.dll")))
+ '(gnutls "libgnutls-28.dll" "libgnutls-26.dll")
+ '(libxml2 "libxml2-2.dll" "libxml2.dll")))
;;; multi-tty support
(defvar w32-initialized nil
;; Set to a system sound if you want a fancy bell.
(set-message-beep 'ok)
+ (x-apply-session-resources)
(setq w32-initialized t))
(add-to-list 'handle-args-function-alist '(w32 . x-handle-args))
"Terminal initialization function for w32 console."
;; Share function key initialization with w32 gui frames
(x-setup-function-keys (selected-frame))
+ ;; Set terminal and keyboard encodings to the current OEM codepage.
+ (let ((oem-code-page-coding
+ (intern (format "cp%d" (w32-get-console-codepage))))
+ (oem-code-page-output-coding
+ (intern (format "cp%d" (w32-get-console-output-codepage))))
+ oem-cs-p oem-o-cs-p)
+ (setq oem-cs-p (coding-system-p oem-code-page-coding))
+ (setq oem-o-cs-p (coding-system-p oem-code-page-output-coding))
+ (when oem-cs-p
+ (set-keyboard-coding-system oem-code-page-coding)
+ (set-terminal-coding-system
+ (if oem-o-cs-p oem-code-page-output-coding oem-code-page-coding))))
(let* ((colors w32-tty-standard-colors)
(color (car colors)))
(tty-color-clear)
-;;; wyse50.el --- terminal support code for Wyse 50 -*- no-byte-compile: t -*-
+;;; wyse50.el --- terminal support code for Wyse 50
;; Copyright (C) 1989, 1993-1994, 2001-2012 Free Software Foundation, Inc.
"Terminal initialization function for wyse50."
;; Use inheritance to let the main keymap override these defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(let ((m (copy-keymap wyse50-terminal-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m))
M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar"
(interactive)
;; Not needed any more now that we use input-decode-map.
- ;; (dolist (key-definition
+ ;; (dolist (key-definition
;; ;; By unsetting C-a and then binding it to a prefix, we
;; ;; allow the rest of the function keys which start with C-a
;; ;; to be recognized.
(declare-function accelerate-menu "xmenu.c" (&optional frame) t)
(defun x-menu-bar-open (&optional frame)
- "Open the menu bar if `menu-bar-mode' is on, otherwise call `tmm-menubar'."
+ "Open the menu bar if it is shown.
+`popup-menu' is used if it is off."
(interactive "i")
- (if (and menu-bar-mode
- (fboundp 'accelerate-menu))
- (accelerate-menu frame)
- (tmm-menubar)))
+ (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) last-nonmenu-event))))
\f
;;; Window system initialization.
;; :help "Paste (yank) text most recently cut/copied")
;; nil))
+ (x-apply-session-resources)
(setq x-initialized t))
(add-to-list 'handle-args-function-alist '(x . x-handle-args))
(defgroup xterm nil
"XTerm support."
:version "24.1"
- :group 'emacs)
+ :group 'environment)
(defcustom xterm-extra-capabilities 'check
"Whether Xterm supports some additional, more modern, features.
;; Use inheritance to let the main keymap override those defaults.
;; This way we don't override terminfo-derived settings or settings
- ;; made in the .emacs file.
+ ;; made in the init file.
(set-keymap-parent map (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map map)))
(and (memq 'reportBackground tocheck-capabilities)
version
(>= version 242)))
+ (discard-input)
(send-string-to-terminal "\e]11;?\e\\")
(when (and (equal (read-event nil nil 2) ?\e)
(equal (read-event nil nil 2) ?\]))
(defvar artist-pointer-shape (if (eq window-system 'x) x-pointer-crosshair nil)
- "*If in X Windows, use this pointer shape while drawing with the mouse.")
+ "If in X Windows, use this pointer shape while drawing with the mouse.")
(defcustom artist-text-renderer-function 'artist-figlet
;; This is a defvar, not a defcustom, since the custom
;; package shows lists of characters as a lists of integers,
;; which is confusing
- "*Characters (``color'') to use when spraying.
+ "Characters (``color'') to use when spraying.
They should be ordered from the ``lightest'' to the ``heaviest''
since spraying replaces a light character with the next heavier one.")
(defvar artist-spray-new-char ?.
- "*Initial character to use when spraying.
+ "Initial character to use when spraying.
This character is used if spraying upon a character that is not in
`artist-spray-chars'. The character defined by this variable should
be in `artist-spray-chars', or spraying will behave strangely.")
;;; ---------------------------------
;;;###autoload
-(defun artist-mode (&optional state)
+(define-minor-mode artist-mode
"Toggle Artist mode.
-With argument STATE, turn Artist mode on if STATE is positive.
+With argument ARG, turn Artist mode on if ARG is positive.
Artist lets you draw lines, squares, rectangles and poly-lines,
ellipses and circles with your mouse and/or keyboard.
Hooks
- When entering artist-mode, the hook `artist-mode-init-hook' is called.
- When quitting artist-mode, the hook `artist-mode-exit-hook' is called.
+ Turning the mode on or off runs `artist-mode-hook'.
Keymap summary
\\{artist-mode-map}"
- (interactive)
- (if (setq artist-mode
- (if (null state) (not artist-mode)
- (> (prefix-numeric-value state) 0)))
- (artist-mode-init)
- (artist-mode-exit)))
-
-;; insert our minor mode string
-(or (assq 'artist-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons '(artist-mode artist-mode-name)
- minor-mode-alist)))
-
-;; insert our minor mode keymap
-(or (assq 'artist-mode minor-mode-map-alist)
- (setq minor-mode-map-alist
- (cons (cons 'artist-mode artist-mode-map)
- minor-mode-map-alist)))
-
+ :init-value nil :group 'artist :lighter artist-mode-name
+ :keymap artist-mode-map
+ (cond ((null artist-mode)
+ ;; Turn mode off
+ (artist-mode-exit))
+ (t
+ ;; Turn mode on
+ (artist-mode-init))))
;; Init and exit
(defun artist-mode-init ()
- "Init Artist mode. This will call the hook `artist-mode-init-hook'."
+ "Init Artist mode. This will call the hook `artist-mode-hook'."
;; Set up a conversion table for mapping tabs and new-lines to spaces.
;; the last case, 0, is for the last position in buffer/region, where
;; the `following-char' function returns 0.
(progn
(picture-mode)
(message "")))
- (run-hooks 'artist-mode-init-hook)
(artist-mode-line-show-curr-operation artist-key-is-drawing))
(defun artist-mode-exit ()
- "Exit Artist mode. This will call the hook `artist-mode-exit-hook'."
+ "Exit Artist mode. This will call the hook `artist-mode-hook'."
(if (and artist-picture-compatibility (eq major-mode 'picture-mode))
(picture-mode-exit))
- (kill-local-variable 'next-line-add-newlines)
- (run-hooks 'artist-mode-exit-hook))
+ (kill-local-variable 'next-line-add-newlines))
(defun artist-mode-off ()
"Turn Artist mode off."
;;
(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'."
;;
(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
(defcustom bib-auto-capitalize t
- "*True to automatically capitalize appropriate fields in Bib mode."
+ "True to automatically capitalize appropriate fields in Bib mode."
:type 'boolean
:group 'bib)
:group 'bibtex
:type '(repeat file))
-(defvar bibtex-string-file-path (getenv "BIBINPUTS")
- "*Colon separated list of paths to search for `bibtex-string-files'.")
+(defcustom bibtex-string-file-path (getenv "BIBINPUTS")
+ "Colon-separated list of paths to search for `bibtex-string-files'."
+ :group 'bibtex
+ :type 'string)
(defcustom bibtex-files nil
"List of BibTeX files that are searched for entry keys.
:type '(repeat (choice (const :tag "bibtex-file-path" bibtex-file-path)
directory file)))
-(defvar bibtex-file-path (getenv "BIBINPUTS")
- "*Colon separated list of paths to search for `bibtex-files'.")
+(defcustom bibtex-file-path (getenv "BIBINPUTS")
+ "Colon separated list of paths to search for `bibtex-files'."
+ :group 'bibtex
+ :type 'string)
(defcustom bibtex-search-entry-globally nil
"If non-nil, interactive calls of `bibtex-search-entry' search globally.
("\\\\`\\|\\\\'\\|\\\\\\^\\|\\\\~\\|\\\\=\\|\\\\\\.\\|\\\\u\\|\\\\v\\|\\\\H\\|\\\\t\\|\\\\c\\|\\\\d\\|\\\\b" . "")
;; braces, quotes, concatenation.
("[`'\"{}#]" . "")
+ ("\\\\-" . "") ; \- ->
;; spaces
("\\\\?[ \t\n]+\\|~" . " "))
"Alist of (OLD-REGEXP . NEW-STRING) pairs.
,@(mapcar (lambda (matcher)
`((lambda (bound) (bibtex-font-lock-cite ',matcher bound))))
bibtex-cite-matcher-alist))
- "*Default expressions to highlight in BibTeX mode.")
+ "Default expressions to highlight in BibTeX mode.")
(defvar bibtex-font-lock-url-regexp
;; Assume that field names begin at the beginning of a line.
(if use-previous-options
bibtex-reformat-previous-options
(setq bibtex-reformat-previous-options
- (mapcar (lambda (option)
- (if (y-or-n-p (car option)) (cdr option)))
- `(("Realign entries (recommended)? " . 'realign)
- ("Remove empty optional and alternative fields? " . 'opts-or-alts)
- ("Remove delimiters around pure numerical fields? " . 'numerical-fields)
- (,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
- " comma at end of entry? ") . 'last-comma)
- ("Replace double page dashes by single ones? " . 'page-dashes)
- ("Delete whitespace at the beginning and end of fields? " . 'whitespace)
- ("Inherit booktitle? " . 'inherit-booktitle)
- ("Force delimiters? " . 'delimiters)
- ("Unify case of entry types and field names? " . 'unify-case)
- ("Enclose parts of field entries by braces? " . 'braces)
- ("Replace parts of field entries by string constants? " . 'strings)
- ("Sort fields? " . 'sort-fields))))))
+ (delq nil
+ (mapcar (lambda (option)
+ (if (y-or-n-p (car option)) (cdr option)))
+ `(("Realign entries (recommended)? " . realign)
+ ("Remove empty optional and alternative fields? " . opts-or-alts)
+ ("Remove delimiters around pure numerical fields? " . numerical-fields)
+ (,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
+ " comma at end of entry? ") . last-comma)
+ ("Replace double page dashes by single ones? " . page-dashes)
+ ("Delete whitespace at the beginning and end of fields? " . whitespace)
+ ("Inherit booktitle? " . inherit-booktitle)
+ ("Force delimiters? " . delimiters)
+ ("Unify case of entry types and field names? " . unify-case)
+ ("Enclose parts of field entries by braces? " . braces)
+ ("Replace parts of field entries by string constants? " . strings)
+ ("Sort fields? " . sort-fields)))))))
;; Do not include required-fields because `bibtex-reformat'
;; cannot handle the error messages of `bibtex-format-entry'.
;; Use `bibtex-validate' to check for required fields.
"Cascading Style Sheets (CSS) editing mode."
:group 'languages)
-(eval-when-compile (require 'cl))
(defun css-extract-keyword-list (res)
(with-temp-buffer
(if current-prefix-arg 'full))))
(unless (memq justify '(t nil none full center left right))
(setq justify 'full))
- (let (max beg fill-pfx)
+ (let ((start-point (point-marker))
+ max beg fill-pfx)
(goto-char (max from to))
(when to-eop
(skip-chars-backward "\n")
(setq fill-pfx
(fill-region-as-paragraph (point) end justify nosqueeze))
(goto-char end))))
+ (goto-char start-point)
+ (set-marker start-point nil)
fill-pfx))
\f
:type '(repeat (symbol)))
(defcustom flyspell-default-deplacement-commands
- '(next-line
- previous-line
- scroll-up
- scroll-down)
+ '(next-line previous-line
+ handle-switch-frame handle-select-window
+ scroll-up scroll-down)
"The standard list of deplacement commands for Flyspell.
See `flyspell-deplacement-commands'."
:group 'flyspell
:type 'boolean)
(defcustom flyspell-mode-line-string " Fly"
- "String displayed on the modeline when flyspell is active.
-Set this to nil if you don't want a modeline indicator."
+ "String displayed on the mode line when flyspell is active.
+Set this to nil if you don't want a mode line indicator."
:group 'flyspell
:type '(choice string (const :tag "None" nil)))
;;* Mode specific options enable users to disable flyspell on */
;;* certain word depending of the emacs mode. For instance, when */
;;* using flyspell with mail-mode add the following expression */
-;;* in your .emacs file: */
+;;* in your init file: */
;;* (add-hook 'mail-mode */
-;;* (lambda () (setq flyspell-generic-check-word-predicate */
+;;* (lambda () (setq flyspell-generic-check-word-predicate */
;;* 'mail-mode-flyspell-verify))) */
;;*---------------------------------------------------------------------*/
(defvar flyspell-generic-check-word-predicate nil
;; dash character machinery
(defvar flyspell-consider-dash-as-word-delimiter-flag nil
- "*Non-nil means that the `-' char is considered as a word delimiter.")
+ "Non-nil means that the `-' char is considered as a word delimiter.")
(make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag)
(defvar flyspell-dash-dictionary nil)
(make-variable-buffer-local 'flyspell-dash-dictionary)
;;*---------------------------------------------------------------------*/
;;* Highlighting */
;;*---------------------------------------------------------------------*/
-(defface flyspell-incorrect
- '((((class color)) (:foreground "OrangeRed" :bold t :underline t))
- (t (:bold t)))
- "Face used for marking a misspelled word in Flyspell."
+(defface flyspell-incorrect '((t :underline t :inherit error))
+ "Flyspell face for misspelled words."
:group 'flyspell)
-(define-obsolete-face-alias 'flyspell-incorrect-face 'flyspell-incorrect "22.1")
-(defface flyspell-duplicate
- '((((class color)) (:foreground "Gold3" :bold t :underline t))
- (t (:bold t)))
- "Face used for marking a misspelled word that appears twice in the buffer.
+(defface flyspell-duplicate '((t :underline t :inherit warning))
+ "Flyspell face for words that appear twice in a row.
See also `flyspell-duplicate-distance'."
:group 'flyspell)
-(define-obsolete-face-alias 'flyspell-duplicate-face 'flyspell-duplicate "22.1")
(defvar flyspell-overlay nil)
Consider using the `ispell-parser' to check your text. For instance
consider adding:
\(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
-in your .emacs file.
+in your init file.
\\[flyspell-region] checks all words inside a region.
\\[flyspell-buffer] checks the whole buffer."
;; the welcome message
(if (and flyspell-issue-message-flag
flyspell-issue-welcome-flag
- (called-interactively-p 'interactive))
+ (if (featurep 'xemacs)
+ (interactive-p) ;; XEmacs does not have (called-interactively-p)
+ (called-interactively-p 'interactive)))
(let ((binding (where-is-internal 'flyspell-auto-correct-word
nil 'non-ascii)))
(message "%s"
(defun flyspell-delay-commands ()
"Install the standard set of Flyspell delayed commands."
(mapc 'flyspell-delay-command flyspell-default-delayed-commands)
- (mapcar 'flyspell-delay-command flyspell-delayed-commands))
+ (mapc 'flyspell-delay-command flyspell-delayed-commands))
;;*---------------------------------------------------------------------*/
;;* flyspell-delay-command ... */
(defun flyspell-delay-command (command)
"Set COMMAND to be delayed, for Flyspell.
When flyspell `post-command-hook' is invoked because a delayed command
-as been used the current word is not immediately checked.
+has been used, the current word is not immediately checked.
It will be checked only after `flyspell-delay' seconds."
(interactive "SDelay Flyspell after Command: ")
(put command 'flyspell-delayed t))
(defun flyspell-deplacement-commands ()
"Install the standard set of Flyspell deplacement commands."
(mapc 'flyspell-deplacement-command flyspell-default-deplacement-commands)
- (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands))
+ (mapc 'flyspell-deplacement-command flyspell-deplacement-commands))
;;*---------------------------------------------------------------------*/
;;* flyspell-deplacement-command ... */
;;*---------------------------------------------------------------------*/
(defun flyspell-deplacement-command (command)
"Set COMMAND that implement cursor movements, for Flyspell.
-When flyspell `post-command-hook' is invoked because of a deplacement command
-as been used the current word is checked only if the previous command was
-not the very same deplacement command."
+When flyspell `post-command-hook' is invoked because a deplacement command
+has been used, the current word is not checked."
(interactive "SDeplacement Flyspell after Command: ")
(put command 'flyspell-deplacement t))
;;* post command hook, we will check, if the word at this position */
;;* has to be spell checked. */
;;*---------------------------------------------------------------------*/
-(defvar flyspell-pre-buffer nil)
-(defvar flyspell-pre-point nil)
-(defvar flyspell-pre-column nil)
+(defvar flyspell-pre-buffer nil "Buffer current before `this-command'.")
+(defvar flyspell-pre-point nil "Point before running `this-command'")
+(defvar flyspell-pre-column nil "Column before running `this-command'")
(defvar flyspell-pre-pre-buffer nil)
(defvar flyspell-pre-pre-point nil)
-(make-variable-buffer-local 'flyspell-pre-point)
+(make-variable-buffer-local 'flyspell-pre-point) ;Why?? --Stef
;;*---------------------------------------------------------------------*/
;;* flyspell-previous-command ... */
;;;###autoload
(defun flyspell-mode-off ()
"Turn Flyspell mode off."
- ;; we remove the hooks
+ ;; We remove the hooks.
(remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
(remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
(remove-hook 'after-change-functions 'flyspell-after-change-function t)
(remove-hook 'hack-local-variables-hook
(function flyspell-hack-local-variables-hook) t)
- ;; we remove all the flyspell highlightings
+ ;; We remove all the flyspell highlightings.
(flyspell-delete-all-overlays)
- ;; we have to erase pre cache variables
+ ;; We have to erase pre cache variables.
(setq flyspell-pre-buffer nil)
(setq flyspell-pre-point nil)
- ;; we mark the mode as killed
+ ;; We mark the mode as killed.
(setq flyspell-mode nil))
;;*---------------------------------------------------------------------*/
"Return non-nil if we should check the word before point.
More precisely, it applies to the word that was before point
before the current command."
- (cond
- ((or (not (numberp flyspell-pre-point))
- (not (bufferp flyspell-pre-buffer))
- (not (buffer-live-p flyspell-pre-buffer)))
- nil)
- ((and (eq flyspell-pre-pre-point flyspell-pre-point)
- (eq flyspell-pre-pre-buffer flyspell-pre-buffer))
- nil)
- ((or (and (= flyspell-pre-point (- (point) 1))
- (eq (char-syntax (char-after flyspell-pre-point)) ?w))
- (= flyspell-pre-point (point))
- (= flyspell-pre-point (+ (point) 1)))
- nil)
- ((and (symbolp this-command)
- (not executing-kbd-macro)
- (or (get this-command 'flyspell-delayed)
- (and (get this-command 'flyspell-deplacement)
- (eq flyspell-previous-command this-command)))
- (or (= (current-column) 0)
- (= (current-column) flyspell-pre-column)
- ;; If other post-command-hooks change the buffer,
- ;; flyspell-pre-point can lie past eob (bug#468).
- (null (char-after flyspell-pre-point))
- (eq (char-syntax (char-after flyspell-pre-point)) ?w)))
- nil)
- ((not (eq (current-buffer) flyspell-pre-buffer))
- t)
- ((not (and (numberp flyspell-word-cache-start)
- (numberp flyspell-word-cache-end)))
- t)
- (t
- (or (< flyspell-pre-point flyspell-word-cache-start)
- (> flyspell-pre-point flyspell-word-cache-end)))))
+ (let ((ispell-otherchars (ispell-get-otherchars)))
+ (cond
+ ((not (and (numberp flyspell-pre-point)
+ (buffer-live-p flyspell-pre-buffer)))
+ nil)
+ ((and (eq flyspell-pre-pre-point flyspell-pre-point)
+ (eq flyspell-pre-pre-buffer flyspell-pre-buffer))
+ nil)
+ ((or (and (= flyspell-pre-point (- (point) 1))
+ (or (eq (char-syntax (char-after flyspell-pre-point)) ?w)
+ (and (not (string= "" ispell-otherchars))
+ (string-match
+ ispell-otherchars
+ (buffer-substring-no-properties
+ flyspell-pre-point (1+ flyspell-pre-point))))))
+ (= flyspell-pre-point (point))
+ (= flyspell-pre-point (+ (point) 1)))
+ nil)
+ ((and (symbolp this-command)
+ (not executing-kbd-macro)
+ (or (get this-command 'flyspell-delayed)
+ (and (get this-command 'flyspell-deplacement)
+ (eq flyspell-previous-command this-command)))
+ (or (= (current-column) 0)
+ (= (current-column) flyspell-pre-column)
+ ;; If other post-command-hooks change the buffer,
+ ;; flyspell-pre-point can lie past eob (bug#468).
+ (null (char-after flyspell-pre-point))
+ (or (eq (char-syntax (char-after flyspell-pre-point)) ?w)
+ (and (not (string= "" ispell-otherchars))
+ (string-match
+ ispell-otherchars
+ (buffer-substring-no-properties
+ flyspell-pre-point (1+ flyspell-pre-point)))))))
+ nil)
+ ((not (eq (current-buffer) flyspell-pre-buffer))
+ t)
+ ((not (and (numberp flyspell-word-cache-start)
+ (numberp flyspell-word-cache-end)))
+ t)
+ (t
+ (or (< flyspell-pre-point flyspell-word-cache-start)
+ (> flyspell-pre-point flyspell-word-cache-end))))))
;;*---------------------------------------------------------------------*/
;;* The flyspell after-change-hook, store the change position. In */
;;* flyspell-check-changed-word-p ... */
;;*---------------------------------------------------------------------*/
(defun flyspell-check-changed-word-p (start stop)
- "Return t when the changed word has to be checked.
+ "Return non-nil when the changed word has to be checked.
The answer depends of several criteria.
Mostly we check word delimiters."
- (cond
- ((and (memq (char-after start) '(?\n ? )) (> stop start))
- t)
- ((not (numberp flyspell-pre-point))
- t)
- ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop))
- nil)
- ((let ((pos (point)))
- (or (>= pos start) (<= pos stop) (= pos (1+ stop))))
- nil)
- (t
- t)))
+ (not (and (not (and (memq (char-after start) '(?\n ? )) (> stop start)))
+ (numberp flyspell-pre-point)
+ (or
+ (and (>= flyspell-pre-point start) (<= flyspell-pre-point stop))
+ (let ((pos (point)))
+ (or (>= pos start) (<= pos stop) (= pos (1+ stop))))))))
;;*---------------------------------------------------------------------*/
;;* flyspell-check-word-p ... */
"Return t when the word at `point' has to be checked.
The answer depends of several criteria.
Mostly we check word delimiters."
- (cond
- ((<= (- (point-max) 1) (point-min))
- ;; the buffer is not filled enough
- nil)
- ((and (and (> (current-column) 0)
- (not (eq (current-column) flyspell-pre-column)))
- (save-excursion
- (backward-char 1)
- (and (looking-at (flyspell-get-not-casechars))
- (or flyspell-consider-dash-as-word-delimiter-flag
- (not (looking-at "-"))))))
- ;; yes because we have reached or typed a word delimiter.
- t)
- ((symbolp this-command)
+ (let ((ispell-otherchars (ispell-get-otherchars)))
(cond
- ((get this-command 'flyspell-deplacement)
- (not (eq flyspell-previous-command this-command)))
- ((get this-command 'flyspell-delayed)
- ;; the current command is not delayed, that
- ;; is that we must check the word now
- (and (not unread-command-events)
- (sit-for flyspell-delay)))
- (t t)))
- (t t)))
+ ((<= (- (point-max) 1) (point-min))
+ ;; The buffer is not filled enough.
+ nil)
+ ((and (and (> (current-column) 0)
+ (not (eq (current-column) flyspell-pre-column)))
+ (save-excursion
+ (backward-char 1)
+ (and (looking-at (flyspell-get-not-casechars))
+ (or (string= "" ispell-otherchars)
+ (not (looking-at ispell-otherchars)))
+ (or flyspell-consider-dash-as-word-delimiter-flag
+ (not (looking-at "-"))))))
+ ;; Yes because we have reached or typed a word delimiter.
+ t)
+ ((symbolp this-command)
+ (cond
+ ((get this-command 'flyspell-deplacement)
+ (not (eq flyspell-previous-command this-command)))
+ ((get this-command 'flyspell-delayed)
+ ;; The current command is not delayed, that
+ ;; is that we must check the word now.
+ (and (not unread-command-events)
+ (sit-for flyspell-delay)))
+ (t t)))
+ (t t))))
;;*---------------------------------------------------------------------*/
;;* flyspell-debug-signal-no-check ... */
;;*---------------------------------------------------------------------*/
(defun flyspell-debug-signal-word-checked ()
(setq debug-on-error t)
- (let ((oldbuf (current-buffer))
+ (let ((ispell-otherchars (ispell-get-otherchars))
+ (oldbuf (current-buffer))
(point (point)))
(with-current-buffer (get-buffer-create "*flyspell-debug*")
- (insert "WORD:\n")
- (insert (format " this-cmd : %S\n" this-command))
- (insert (format " delayed : %S\n" (and (symbolp this-command)
- (get this-command 'flyspell-delayed))))
- (insert (format " point : %S\n" point))
- (insert (format " prev-char : [%c] %S\n"
- (with-current-buffer oldbuf
- (let ((c (if (> (point) (point-min))
- (save-excursion
- (backward-char 1)
- (char-after (point)))
- ? )))
- c))
- (with-current-buffer oldbuf
- (let ((c (if (> (point) (point-min))
- (save-excursion
- (backward-char 1)
- (and (and (looking-at (flyspell-get-not-casechars)) 1)
- (and (or flyspell-consider-dash-as-word-delimiter-flag
- (not (looking-at "\\-"))) 2))))))
- c))))
- (insert (format " because : %S\n"
- (cond
- ((not (and (symbolp this-command)
- (get this-command 'flyspell-delayed)))
- ;; the current command is not delayed, that
- ;; is that we must check the word now
- 'not-delayed)
- ((with-current-buffer oldbuf
- (let ((c (if (> (point) (point-min))
- (save-excursion
- (backward-char 1)
- (and (looking-at (flyspell-get-not-casechars))
- (or flyspell-consider-dash-as-word-delimiter-flag
- (not (looking-at "\\-"))))))))
- c))
- ;; yes because we have reached or typed a word delimiter.
- 'separator)
- ((not (integerp flyspell-delay))
- ;; yes because the user had set up a no-delay configuration.
- 'no-delay)
- (t
- 'sit-for))))
+ (insert
+ "WORD:\n"
+ (format " this-cmd : %S\n" this-command)
+ (format " delayed : %S\n" (and (symbolp this-command)
+ (get this-command
+ 'flyspell-delayed)))
+ (format " point : %S\n" point)
+ (format " prev-char : [%c] %S\n"
+ (with-current-buffer oldbuf
+ (if (bobp) ?\ (char-before)))
+ (with-current-buffer oldbuf
+ (if (bobp)
+ nil
+ (save-excursion
+ (backward-char 1)
+ (and (looking-at (flyspell-get-not-casechars))
+ (or (string= "" ispell-otherchars)
+ (not (looking-at ispell-otherchars)))
+ (or flyspell-consider-dash-as-word-delimiter-flag
+ (not (looking-at "\\-")))
+ 2)))))
+ (format " because : %S\n"
+ (cond
+ ((not (and (symbolp this-command)
+ (get this-command 'flyspell-delayed)))
+ ;; The current command is not delayed, that
+ ;; is that we must check the word now.
+ 'not-delayed)
+ ((with-current-buffer oldbuf
+ (if (bobp)
+ nil
+ (save-excursion
+ (backward-char 1)
+ (and (looking-at (flyspell-get-not-casechars))
+ (or (string= "" ispell-otherchars)
+ (not (looking-at ispell-otherchars)))
+ (or flyspell-consider-dash-as-word-delimiter-flag
+ (not (looking-at "\\-")))))))
+ ;; Yes because we have reached or typed a word delimiter.
+ 'separator)
+ ((not (integerp flyspell-delay))
+ ;; Yes because the user set up a no-delay configuration.
+ 'no-delay)
+ (t
+ 'sit-for))))
(goto-char (point-max)))))
;;*---------------------------------------------------------------------*/
;;* 2- the word that used to be the current word before the */
;;* THIS-COMMAND is checked if: */
;;* a- the previous word is different from the current word */
-;;* b- the previous word as not just been checked by the */
+;;* b- the previous word has not just been checked by the */
;;* previous FLYSPELL-POST-COMMAND-HOOK */
;;* 3- the words changed by the THIS-COMMAND that are neither the */
;;* previous word nor the current word */
;; we remember which word we have just checked.
;; this will be used next time we will check a word
;; to compare the next current word with the word
- ;; that as been registered in the pre-command-hook
+ ;; that has been registered in the pre-command-hook
;; that is these variables are used within the predicate
;; FLYSPELL-CHECK-PRE-WORD-P
(setq flyspell-pre-pre-buffer (current-buffer))
(ispell-send-string (concat "^" word "\n"))
;; we mark the ispell process so it can be killed
;; when emacs is exited without query
- (set-process-query-on-exit-flag ispell-process nil)
+ (if (featurep 'xemacs)
+ (process-kill-without-query ispell-process)
+ (set-process-query-on-exit-flag ispell-process nil))
;; Wait until ispell has processed word.
(while (progn
(accept-process-output ispell-process)
(>= (match-end 0) b))))))
(flyspell-math-tex-command-p)))
-;;*---------------------------------------------------------------------*/
-;;* flyspell-casechars-cache ... */
-;;*---------------------------------------------------------------------*/
-(defvar flyspell-casechars-cache nil)
-(defvar flyspell-ispell-casechars-cache nil)
-(make-variable-buffer-local 'flyspell-casechars-cache)
-(make-variable-buffer-local 'flyspell-ispell-casechars-cache)
-
-;;*---------------------------------------------------------------------*/
-;;* flyspell-get-casechars ... */
-;;*---------------------------------------------------------------------*/
-(defun flyspell-get-casechars ()
- "This function builds a string that is the regexp of word chars.
-In order to avoid one useless string construction,
-this function changes the last char of the `ispell-casechars' string."
- (let ((ispell-casechars (ispell-get-casechars)))
- (cond
- ((eq ispell-parser 'tex)
- (setq flyspell-ispell-casechars-cache ispell-casechars)
- (setq flyspell-casechars-cache
- (concat (substring ispell-casechars
- 0
- (- (length ispell-casechars) 1))
- "]"))
- flyspell-casechars-cache)
- (t
- (setq flyspell-ispell-casechars-cache ispell-casechars)
- (setq flyspell-casechars-cache ispell-casechars)
- flyspell-casechars-cache))))
-
-;;*---------------------------------------------------------------------*/
-;;* flyspell-get-not-casechars-cache ... */
-;;*---------------------------------------------------------------------*/
-(defvar flyspell-not-casechars-cache nil)
-(defvar flyspell-ispell-not-casechars-cache nil)
-(make-variable-buffer-local 'flyspell-not-casechars-cache)
-(make-variable-buffer-local 'flyspell-ispell-not-casechars-cache)
-
-;;*---------------------------------------------------------------------*/
-;;* flyspell-get-not-casechars ... */
-;;*---------------------------------------------------------------------*/
-(defun flyspell-get-not-casechars ()
- "This function builds a string that is the regexp of non-word chars."
- (let ((ispell-not-casechars (ispell-get-not-casechars)))
- (cond
- ((eq ispell-parser 'tex)
- (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
- (setq flyspell-not-casechars-cache
- (concat (substring ispell-not-casechars
- 0
- (- (length ispell-not-casechars) 1))
- "]"))
- flyspell-not-casechars-cache)
- (t
- (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
- (setq flyspell-not-casechars-cache ispell-not-casechars)
- flyspell-not-casechars-cache))))
+(defalias 'flyspell-get-casechars 'ispell-get-casechars)
+(defalias 'flyspell-get-not-casechars 'ispell-get-not-casechars)
;;*---------------------------------------------------------------------*/
;;* flyspell-get-word ... */
(goto-char buffer-scan-pos)
(let ((keep t))
;; Iterate on string search until string is found as word,
- ;; not as substring
+ ;; not as substring.
(while keep
(if (search-forward word
flyspell-large-region-end t)
(when (or
;; Size matches, we really found it.
(= found-length misspell-length)
- ;; Matches as part of a boundary-char separated word
+ ;; Matches as part of a boundary-char separated
+ ;; word.
(member word
(split-string found ispell-otherchars))
;; Misspelling has higher length than
- ;; what flyspell considers the
- ;; word. Caused by boundary-chars
- ;; mismatch. Validating seems safe.
+ ;; what flyspell considers the word.
+ ;; Caused by boundary-chars mismatch.
+ ;; Validating seems safe.
(< found-length misspell-length)
;; ispell treats beginning of some TeX
;; commands as nroff control sequences
;;* declared correct. */
;;*---------------------------------------------------------------------*/
(defun flyspell-process-localwords (misspellings-buffer)
- (let (localwords case-fold-search
+ (let ((localwords ispell-buffer-session-localwords)
+ case-fold-search
(ispell-casechars (ispell-get-casechars)))
;; Get localwords from the original buffer
(save-excursion
(if ispell-encoding8-command
(setq args
(append args
- (list
- (concat ispell-encoding8-command
- (symbol-name
- encoding))))))
+ (if ispell-really-hunspell
+ (list ispell-encoding8-command
+ (upcase (symbol-name encoding)))
+ (list (concat ispell-encoding8-command
+ (symbol-name encoding)))))))
(let ((process-coding-system-alist (list (cons "\\.*" encoding))))
(setq c (apply 'ispell-call-process-region beg
;;*---------------------------------------------------------------------*/
(defun flyspell-delete-region-overlays (beg end)
"Delete overlays used by flyspell in a given region."
- (remove-overlays beg end 'flyspell-overlay t))
-
+ (if (featurep 'emacs)
+ (remove-overlays beg end 'flyspell-overlay t)
+ ;; XEmacs does not have `remove-overlays'
+ (let ((l (overlays-in beg end)))
+ (while (consp l)
+ (progn
+ (if (flyspell-overlay-p (car l))
+ (delete-overlay (car l)))
+ (setq l (cdr l)))))))
(defun flyspell-delete-all-overlays ()
"Delete all the overlays used by flyspell."
- (remove-overlays (point-min) (point-max) 'flyspell-overlay t))
+ (flyspell-delete-region-overlays (point-min) (point-max)))
;;*---------------------------------------------------------------------*/
;;* flyspell-unhighlight-at ... */
(interactive)
(let ((pos (point))
(old-max (point-max)))
- ;; use the correct dictionary
+ ;; Use the correct dictionary.
(flyspell-accept-buffer-local-defs)
(if (and (eq flyspell-auto-correct-pos pos)
(consp flyspell-auto-correct-region))
- ;; we have already been using the function at the same location
+ ;; We have already been using the function at the same location.
(let* ((start (car flyspell-auto-correct-region))
(len (cdr flyspell-auto-correct-region)))
(flyspell-unhighlight-at start)
(flyspell-display-next-corrections flyspell-auto-correct-ring))
(flyspell-ajust-cursor-point pos (point) old-max)
(setq flyspell-auto-correct-pos (point)))
- ;; fetch the word to be checked
+ ;; Fetch the word to be checked.
(let ((word (flyspell-get-word)))
(if (consp word)
(let ((start (car (cdr word)))
(word (car word))
poss ispell-filter)
(setq flyspell-auto-correct-word word)
- ;; now check spelling of word.
- (ispell-send-string "%\n") ;put in verbose mode
+ ;; Now check spelling of word..
+ (ispell-send-string "%\n") ;Put in verbose mode.
(ispell-send-string (concat "^" word "\n"))
- ;; wait until ispell has processed word.
+ ;; Wait until ispell has processed word.
(while (progn
(accept-process-output ispell-process)
(not (string= "" (car ispell-filter)))))
- ;; Remove leading empty element
+ ;; Remove leading empty element.
(setq ispell-filter (cdr ispell-filter))
- ;; ispell process should return something after word is sent.
- ;; Tag word as valid (i.e., skip) otherwise
+ ;; Ispell process should return something after word is sent.
+ ;; Tag word as valid (i.e., skip) otherwise.
(or ispell-filter
(setq ispell-filter '(*)))
(if (consp ispell-filter)
(setq poss (ispell-parse-output (car ispell-filter))))
(cond
((or (eq poss t) (stringp poss))
- ;; don't correct word
+ ;; Don't correct word.
t)
((null poss)
- ;; ispell error
+ ;; Ispell error.
(error "Ispell: error in Ispell process"))
(t
- ;; the word is incorrect, we have to propose a replacement
+ ;; The word is incorrect, we have to propose a replacement.
(let ((replacements (if flyspell-sort-corrections
(sort (car (cdr (cdr poss))) 'string<)
(car (cdr (cdr poss))))))
(setq ispell-pdict-modified-p '(t)))
((or (eq replace 'buffer) (eq replace 'session))
(ispell-send-string (concat "@" word "\n"))
+ (add-to-list 'ispell-buffer-session-localwords word)
+ (or ispell-buffer-local-name ; session localwords might conflict
+ (setq ispell-buffer-local-name (buffer-name)))
(flyspell-unhighlight-at cursor-location)
(if (null ispell-pdict-modified-p)
(setq ispell-pdict-modified-p
(save-excursion
(re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
+;;; XEmacs21 does not have `with-no-warnings'. Taken from org mode.
+(defmacro ispell-with-no-warnings (&rest body)
+ (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
+
;;; Code:
(defvar mail-yank-prefix)
;;; ******* THIS FILE IS WRITTEN FOR ISPELL VERSION 3.1+
(defcustom ispell-highlight-p 'block
- "*Highlight spelling errors when non-nil.
+ "Highlight spelling errors when non-nil.
When set to `block', assumes a block cursor with TTY displays."
:type '(choice (const block) (const :tag "off" nil) (const :tag "on" t))
:group 'ispell)
(defcustom ispell-lazy-highlight (boundp 'lazy-highlight-cleanup)
- "*Controls the lazy-highlighting of spelling errors.
+ "Controls the lazy-highlighting of spelling errors.
When non-nil, all text in the buffer matching the current spelling
error is highlighted lazily using isearch lazy highlighting (see
`lazy-highlight-initial-delay' and `lazy-highlight-interval')."
:version "22.1")
(defcustom ispell-highlight-face (if ispell-lazy-highlight 'isearch 'highlight)
- "*The face used for Ispell highlighting. For Emacsen with overlays.
-Possible values are `highlight', `modeline', `secondary-selection',
-`region', and `underline'.
+ "Face used for Ispell highlighting.
This variable can be set by the user to whatever face they desire.
It's most convenient if the cursor color and highlight color are
slightly different."
:group 'ispell)
(defcustom ispell-check-comments t
- "*Spelling of comments checked when non-nil.
+ "Spelling of comments checked when non-nil.
When set to `exclusive', ONLY comments are checked. (For code comments).
Warning! Not checking comments, when a comment start is embedded in strings,
may produce undesired results."
(lambda (a) (memq a '(nil t exclusive))))
(defcustom ispell-query-replace-choices nil
- "*Corrections made throughout region when non-nil.
+ "Corrections made throughout region when non-nil.
Uses `query-replace' (\\[query-replace]) for corrections."
:type 'boolean
:group 'ispell)
(defcustom ispell-skip-tib nil
- "*Does not spell check `tib' bibliography references when non-nil.
+ "Does not spell check `tib' bibliography references when non-nil.
Skips any text between strings matching regular expressions
`ispell-tib-ref-beginning' and `ispell-tib-ref-end'.
"Regexp matching the end of a Tib reference.")
(defcustom ispell-keep-choices-win t
- "*If non-nil, keep the `*Choices*' window for the entire spelling session.
+ "If non-nil, keep the `*Choices*' window for the entire spelling session.
This minimizes redisplay thrashing."
:type 'boolean
:group 'ispell)
(defcustom ispell-choices-win-default-height 2
- "*The default size of the `*Choices*' window, including the mode line.
+ "The default size of the `*Choices*' window, including the mode line.
Must be greater than 1."
:type 'integer
:group 'ispell)
(defcustom ispell-program-name
- (or (locate-file "aspell" exec-path exec-suffixes 'file-executable-p)
- (locate-file "ispell" exec-path exec-suffixes 'file-executable-p)
- (locate-file "hunspell" exec-path exec-suffixes 'file-executable-p)
+ (or (executable-find "aspell")
+ (executable-find "ispell")
+ (executable-find "hunspell")
"ispell")
"Program invoked by \\[ispell-word] and \\[ispell-region] commands."
:type 'string
((file-readable-p "/usr/share/lib/dict/words")
"/usr/share/lib/dict/words")
((file-readable-p "/sys/dict") "/sys/dict"))
- "*Alternate plain word-list dictionary for spelling help."
+ "Alternate plain word-list dictionary for spelling help."
:type '(choice file (const :tag "None" nil))
:group 'ispell)
(defcustom ispell-complete-word-dict nil
- "*Plain word-list dictionary used for word completion if
+ "Plain word-list dictionary used for word completion if
different from `ispell-alternate-dictionary'."
:type '(choice file (const :tag "None" nil))
:group 'ispell)
(defcustom ispell-message-dictionary-alist nil
- "*List used by `ispell-message' to select a new dictionary.
+ "List used by `ispell-message' to select a new dictionary.
It consists of pairs (REGEXP . DICTIONARY). If REGEXP is found
in the message headers, `ispell-local-dictionary' will be set to
DICTIONARY if `ispell-local-dictionary' is not buffer-local.
(defcustom ispell-message-fcc-skip 50000
- "*Query before saving Fcc message copy if attachment larger than this value.
+ "Query before saving Fcc message copy if attachment larger than this value.
Always stores Fcc copy of message when nil."
:type '(choice integer (const :tag "off" nil))
:group 'ispell)
:group 'ispell)
(defcustom ispell-look-p (file-exists-p ispell-look-command)
- "*Non-nil means use `look' rather than `grep'.
+ "Non-nil means use `look' rather than `grep'.
Default is based on whether `look' seems to be available."
:type 'boolean
:group 'ispell)
(defcustom ispell-have-new-look nil
- "*Non-nil means use the `-r' option (regexp) when running `look'."
+ "Non-nil means use the `-r' option (regexp) when running `look'."
:type 'boolean
:group 'ispell)
:group 'ispell)
(defcustom ispell-following-word nil
- "*Non-nil means `ispell-word' checks the word around or after point.
+ "Non-nil means `ispell-word' checks the word around or after point.
Otherwise `ispell-word' checks the preceding word."
:type 'boolean
:group 'ispell)
(defcustom ispell-help-in-bufferp nil
- "*Non-nil means display interactive keymap help in a buffer.
+ "Non-nil means display interactive keymap help in a buffer.
The following values are supported:
nil Expand the minibuffer and display a short help message
there for a couple of seconds.
:group 'ispell)
(defcustom ispell-quietly nil
- "*Non-nil means suppress messages in `ispell-word'."
+ "Non-nil means suppress messages in `ispell-word'."
:type 'boolean
:group 'ispell)
(defcustom ispell-format-word-function (function upcase)
- "*Formatting function for displaying word being spell checked.
+ "Formatting function for displaying word being spell checked.
The function must take one string argument and return a string."
:type 'function
:group 'ispell)
;;;###autoload
(defcustom ispell-personal-dictionary nil
- "*File name of your personal spelling dictionary, or nil.
+ "File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary, (\"~/.ispell_DICTNAME\" for ispell or
\"~/.aspell.LANG.pws\" for aspell) is used, where DICTNAME is the name of your
default dictionary and LANG the two letter language code."
:group 'ispell)
(defcustom ispell-silently-savep nil
- "*When non-nil, save personal dictionary without asking for confirmation."
+ "When non-nil, save personal dictionary without asking for confirmation."
:type 'boolean
:group 'ispell)
:group 'ispell)
(defcustom ispell-extra-args nil
- "*If non-nil, a list of extra switches to pass to the Ispell program.
+ "If non-nil, a list of extra switches to pass to the Ispell program.
For example, (\"-W\" \"3\") to cause it to accept all 1-3 character
words as correct. See also `ispell-dictionary-alist', which may be used
for language-specific arguments."
(defcustom ispell-skip-html 'use-mode-name
- "*Indicates whether ispell should skip spell checking of SGML markup.
+ "Indicates whether ispell should skip spell checking of SGML markup.
If t, always skip SGML markup; if nil, never skip; if non-t and non-nil,
guess whether SGML markup should be skipped according to the name of the
buffer's major mode."
(defcustom ispell-local-dictionary-alist nil
- "*List of local or customized dictionary definitions.
+ "List of local or customized dictionary definitions.
These can override the values in `ispell-dictionary-alist'.
To make permanent changes to your dictionary definitions, you
(defvar ispell-dictionary-base-alist
- '((nil
+ '((nil ; default
;; The default dictionary. It may be English.aff, or any other
;; dictionary depending on locale and such things. We should probably
;; ask ispell what dictionary it's using, but until we do that, let's
- ;; just use an approximate regexp.
- "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil iso-8859-1)
+ ;; just use a minimal regexp. [:alpha:] will later be set if possible.
+ "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1)
("american" ; Yankee English
"[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1)
("brasileiro" ; Brazilian mode
(make-obsolete-variable 'ispell-aspell-supports-utf8
'ispell-encoding8-command "23.1")
+(defvar ispell-emacs-alpha-regexp
+ (if (string-match "^[[:alpha:]]+$" "abcde")
+ "[[:alpha:]]"
+ nil)
+ "[[:alpha:]] if Emacs supports [:alpha:] regexp, nil
+otherwise (current XEmacs does not support it).")
;;; **********************************************************************
;;; The following are used by ispell, and should not be changed.
(setq ispell-really-aspell nil)))
(ispell-really-hunspell
(if (ispell-check-minver hunspell8-minver ispell-really-hunspell)
- (setq ispell-encoding8-command "-i ")
+ (setq ispell-encoding8-command "-i")
(setq ispell-really-hunspell nil))))))
result))
;;;###autoload
(defvar ispell-menu-map nil "Key map for ispell menu.")
-;;; redo menu when loading ispell to get dictionary modifications
+;; Redo menu when loading ispell to get dictionary modifications
(setq ispell-menu-map nil)
;;;###autoload
;; Ensure aspell's alias dictionary will override standard
;; definitions.
(setq found (ispell-aspell-add-aliases found))
- ;; Merge into FOUND any elements from the standard ispell-dictionary-alist
+ ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist
;; which have no element in FOUND at all.
- (dolist (dict ispell-dictionary-alist)
+ (dolist (dict ispell-dictionary-base-alist)
(unless (assoc (car dict) found)
(setq found (nconc found (list dict)))))
(setq ispell-aspell-dictionary-alist found)
(insert-file-contents alias-file)
;; Look for a line "add FOO.multi", extract FOO
(when (search-forward-regexp "^add \\([^.]+\\)\\.multi" nil t)
- (let* ((aliasname (file-name-sans-extension
- (file-name-nondirectory alias-file)))
+ (let* ((aliasname (file-name-base alias-file))
(already-exists-p (assoc aliasname alist))
(realname (match-string 1))
(realdict (assoc realname alist)))
(error nil))
ispell-really-aspell
ispell-encoding8-command
- ;; XEmacs does not like [:alpha:] regexps.
- (string-match "^[[:alpha:]]+$" "abcde"))
+ ispell-emacs-alpha-regexp)
(unless ispell-aspell-dictionary-alist
(ispell-find-aspell-dictionaries)))
ispell-dictionary-base-alist))
(unless (assoc (car dict) all-dicts-alist)
(add-to-list 'all-dicts-alist dict)))
- (setq ispell-dictionary-alist all-dicts-alist))))
-
+ (setq ispell-dictionary-alist all-dicts-alist))
+
+ ;; If Emacs flavor supports [:alpha:] use it for global dicts. If
+ ;; spellchecker also supports UTF-8 via command-line option use it
+ ;; in communication. This does not affect definitions in your
+ ;; init file.
+ (if ispell-emacs-alpha-regexp
+ (let (tmp-dicts-alist)
+ (dolist (adict ispell-dictionary-alist)
+ (add-to-list 'tmp-dicts-alist
+ (list
+ (nth 0 adict) ; dict name
+ "[[:alpha:]]" ; casechars
+ "[^[:alpha:]]" ; not-casechars
+ (nth 3 adict) ; otherchars
+ (nth 4 adict) ; many-otherchars-p
+ (nth 5 adict) ; ispell-args
+ (nth 6 adict) ; extended-character-mode
+ (if ispell-encoding8-command
+ 'utf-8
+ (nth 7 adict)))))
+ (setq ispell-dictionary-alist tmp-dicts-alist)))))
(defun ispell-valid-dictionary-list ()
"Return a list of valid dictionaries.
(push name dict-list)))
dict-list))
-;;; define commands in menu in opposite order you want them to appear.
+;; Define commands in menu in opposite order you want them to appear.
;;;###autoload
(if ispell-menu-map-needed
(progn
`(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary
:help ,(purecopy "Supply explicit dictionary file name")))
(define-key ispell-menu-map [ispell-kill-ispell]
- `(menu-item ,(purecopy "Kill Process") ispell-kill-ispell
+ `(menu-item ,(purecopy "Kill Process")
+ (lambda () (interactive) (ispell-kill-ispell nil 'clear))
:enable (and (boundp 'ispell-process) ispell-process
(eq (ispell-process-status) 'run))
:help ,(purecopy "Terminate Ispell subprocess")))
["Continue Check" ispell-continue t]
["Complete Word Frag"ispell-complete-word-interior-frag t]
["Complete Word" ispell-complete-word t]
- ["Kill Process" ispell-kill-ispell t]
+ ["Kill Process" (ispell-kill-ispell nil 'clear) t]
["Customize..." (customize-group 'ispell) t]
;; flyspell-mode may not be bound...
;;["flyspell" flyspell-mode
(defvar ispell-pdict-modified-p nil
"Non-nil means personal dictionary has modifications to be saved.")
-;;; If you want to save the dictionary when quitting, must do so explicitly.
-;;; When non-nil, the spell session is terminated.
-;;; When numeric, contains cursor location in buffer, and cursor remains there.
+;; If you want to save the dictionary when quitting, must do so explicitly.
+;; When non-nil, the spell session is terminated.
+;; When numeric, contains cursor location in buffer, and cursor remains there.
(defvar ispell-quit nil)
(defvar ispell-process-directory nil
("list" ispell-tex-arg-end 2)
("program" . "\\\\end[ \t\n]*{[ \t\n]*program[ \t\n]*}")
("verbatim\\*?" . "\\\\end[ \t\n]*{[ \t\n]*verbatim\\*?[ \t\n]*}"))))
- "*Lists of regions to be skipped in TeX mode.
+ "Lists of regions to be skipped in TeX mode.
First list is used raw.
Second list has key placed inside \\begin{}.
("<[tT][tT]/" "/")
("<[^ \t\n>]" ">")
("&[^ \t\n;]" "[; \t\n]"))
- "*Lists of start and end keys to skip in HTML buffers.
+ "Lists of start and end keys to skip in HTML buffers.
Same format as `ispell-skip-region-alist'.
Note - substrings of other matches must come last
(e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").")
"Contains the buffer name if local word definitions were used.
Ispell is then restarted because the local words could conflict.")
+(defvar ispell-buffer-session-localwords nil
+ "List of words accepted for session in this buffer.")
+
+(make-variable-buffer-local 'ispell-buffer-session-localwords)
+
(defvar ispell-parser 'use-mode-name
- "*Indicates whether ispell should parse the current buffer as TeX Code.
+ "Indicates whether ispell should parse the current buffer as TeX Code.
Special value `use-mode-name' tries to guess using the name of `major-mode'.
Default parser is `nroff'.
Currently the only other valid parser is `tex'.
(setq more-lines (= 0 (forward-line))))))))))))))
-;; Insert WORD while possibly translating characters by
-;; translation-table-for-input.
-(defun ispell-insert-word (word)
- (let ((pos (point)))
- (insert word)
- ;; Avoid "obsolete" warnings for translation-table-for-input.
- (with-no-warnings
- (if (char-table-p translation-table-for-input)
- (translate-region pos (point) translation-table-for-input)))))
-
;;;###autoload
(defun ispell-word (&optional following quietly continue region)
"Check spelling of word under or before the cursor.
quit spell session exited."
(interactive (list ispell-following-word ispell-quietly current-prefix-arg t))
(cond
- ((and region (use-region-p))
+ ((and region
+ (if (featurep 'emacs)
+ (use-region-p)
+ (and (boundp 'transient-mark-mode) transient-mark-mode
+ (boundp 'mark-active) mark-active
+ (not (eq (region-beginning) (region-end))))))
(ispell-region (region-beginning) (region-end)))
(continue (ispell-continue))
(t
;; Insert first and then delete,
;; to avoid collapsing markers before and after
;; into a single place.
- (ispell-insert-word new-word)
+ (insert new-word)
(delete-region (point) end)
;; It is meaningless to preserve the cursor position
;; inside a word that has changed.
(list word start end))))
-;;; Global ispell-pdict-modified-p is set by ispell-command-loop and
-;;; tracks changes in the dictionary. The global may either be
-;;; a value or a list, whose value is the state of whether the
-;;; dictionary needs to be saved.
+;; Global ispell-pdict-modified-p is set by ispell-command-loop and
+;; tracks changes in the dictionary. The global may either be
+;; a value or a list, whose value is the state of whether the
+;; dictionary needs to be saved.
;;;###autoload
(defun ispell-pdict-save (&optional no-query force-save)
" -- dict: " (or ispell-current-dictionary "default")
" -- prog: " (file-name-nondirectory ispell-program-name)))
;; XEmacs: no need for horizontal scrollbar in choices window
- (with-no-warnings
+ (ispell-with-no-warnings
(and (fboundp 'set-specifier)
(boundp 'horizontal-scrollbar-visible-p)
(set-specifier horizontal-scrollbar-visible-p nil
nil)
((or (= char ?a) (= char ?A)) ; accept word without insert
(ispell-send-string (concat "@" word "\n"))
+ (add-to-list 'ispell-buffer-session-localwords word)
+ (or ispell-buffer-local-name ; session localwords might conflict
+ (setq ispell-buffer-local-name (buffer-name)))
(if (null ispell-pdict-modified-p)
(setq ispell-pdict-modified-p
(list ispell-pdict-modified-p)))
(setq start end)))))) ; else move start to next line of input
-;;; This function destroys the mark location if it is in the word being
-;;; highlighted.
+;; This function destroys the mark location if it is in the word being
+;; highlighted.
(defun ispell-highlight-spelling-error-generic (start end &optional highlight
refresh)
"Highlight the word from START to END with a kludge using `inverse-video'.
(set-window-start (next-window) top))))
-;;; Should we add a compound word match return value?
+;; Should we add a compound word match return value?
(defun ispell-parse-output (output &optional accept-list shift)
"Parse the OUTPUT string from Ispell process and return:
1: t for an exact match.
(defun ispell-start-process ()
- "Start the ispell process, with support for no asynchronous processes.
-Keeps argument list for future ispell invocations for no async support."
+ "Start the Ispell process, with support for no asynchronous processes.
+Keeps argument list for future Ispell invocations for no async support."
;; Local dictionary becomes the global dictionary in use.
(setq ispell-current-dictionary
(or ispell-local-dictionary ispell-dictionary))
;; right encoding for communication. ispell or older aspell/hunspell
;; does not support this.
(if ispell-encoding8-command
- (list
- (concat ispell-encoding8-command
- (symbol-name (ispell-get-coding-system)))))
+ (if ispell-really-hunspell
+ (list ispell-encoding8-command
+ (upcase (symbol-name (ispell-get-coding-system))))
+ (list
+ (concat ispell-encoding8-command
+ (symbol-name (ispell-get-coding-system))))))
ispell-extra-args)))
;; Initially we don't know any buffer's local words.
(setq ispell-filter nil ispell-filter-continue nil)
;; may need to restart to select new personal dictionary.
(ispell-kill-ispell t)
- (message "Starting new Ispell process [%s] ..."
+ (message "Starting new Ispell process [%s::%s] ..."
+ ispell-program-name
(or ispell-local-dictionary ispell-dictionary "default"))
(sit-for 0)
(setq ispell-library-directory (ispell-check-version)
(process-kill-without-query ispell-process)))))))
;;;###autoload
-(defun ispell-kill-ispell (&optional no-error)
+(defun ispell-kill-ispell (&optional no-error clear)
"Kill current Ispell process (so that you may start a fresh one).
-With NO-ERROR, just return non-nil if there was no Ispell running."
+With NO-ERROR, just return non-nil if there was no Ispell running.
+With CLEAR, buffer session localwords are cleaned."
(interactive)
;; This hook is typically used by flyspell to flush some variables used
;; to optimize the common cases.
(run-hooks 'ispell-kill-ispell-hook)
+ (if (or clear
+ (if (featurep 'xemacs)
+ (interactive-p)
+ (called-interactively-p 'interactive)))
+ (setq ispell-buffer-session-localwords nil))
(if (not (and ispell-process
(eq (ispell-process-status) 'run)))
(or no-error
- (error "There is no ispell process running!"))
+ (error "There is no Ispell process running!"))
(if ispell-async-processp
(delete-process ispell-process)
- ;; synchronous processes
- (ispell-send-string "\n") ; make sure side effects occurred.
+ ;; Synchronous processes.
+ (ispell-send-string "\n") ; Make sure side effects occurred.
(kill-buffer ispell-output-buffer)
(kill-buffer ispell-session-buffer)
(setq ispell-output-buffer nil
(message "Ispell process killed")
nil))
-;;; ispell-change-dictionary is set in some people's hooks. Maybe this should
-;;; call ispell-init-process rather than wait for a spell checking command?
+;; ispell-change-dictionary is set in some people's hooks. Maybe this should
+;; call ispell-init-process rather than wait for a spell checking command?
;;;###autoload
(defun ispell-change-dictionary (dict &optional arg)
;; Specified dictionary is the default already. Could reload
;; the dictionaries if needed.
(ispell-internal-change-dictionary)
- (and (interactive-p)
+ (and (if (featurep 'xemacs)
+ (interactive-p)
+ (called-interactively-p 'interactive))
(message "No change, using %s dictionary" dict)))
(t ; reset dictionary!
(if (or (assoc dict ispell-local-dictionary-alist)
(setq ispell-local-dictionary-overridden t))
(error "Undefined dictionary: %s" dict))
(ispell-internal-change-dictionary)
+ (setq ispell-buffer-session-localwords nil)
(message "%s Ispell dictionary set to %s"
(if arg "Global" "Local")
dict))))
(delete-region (point) (+ word-len (point)))
(if (not (listp replace))
(progn
- (ispell-insert-word replace) ; insert dictionary word
+ (insert replace) ; insert dictionary word
(ispell-send-replacement (car poss) replace)
(setq accept-list (cons replace accept-list)))
(let ((replace-word (car replace)))
sequence inside of a word.
Standard ispell choices are then available."
+ ;; FIXME: completion-at-point-function.
(interactive "P")
(let ((cursor-location (point))
(case-fold-search-val case-fold-search)
(setq word (if (atom replacement) replacement (car replacement))
cursor-location (+ (- (length word) (- end start))
cursor-location))
- (ispell-insert-word word)
+ (insert word)
(if (not (atom replacement)) ; recheck spelling of replacement.
(progn
(goto-char cursor-location)
;; Matches commonly used "cut" boundaries
"^\\(- \\)?[-=_]+\\s ?\\(cut here\\|Environment Follows\\)")
"\\|")
- "*Text beyond which `ispell-message' will not spell-check.
+ "Text beyond which `ispell-message' will not spell-check.
If it is a string, limit is the first occurrence of that regular expression.
Otherwise, it must be a function which is called to get the limit.")
(put 'ispell-message-text-end 'risky-local-variable t)
The `X' command aborts sending the message so that you can edit the buffer.
To spell-check whenever a message is sent, include the appropriate lines
-in your .emacs file:
+in your init file:
(add-hook 'message-send-hook 'ispell-message) ;; GNUS 5
(add-hook 'news-inews-hook 'ispell-message) ;; GNUS 4
(add-hook 'mail-send-hook 'ispell-message)
(cite-regexp ;Prefix of quoted text
(cond
((functionp 'sc-cite-regexp) ; sc 3.0
- (with-no-warnings
- (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
- (ispell-non-empty-string sc-reference-tag-string))))
+ (ispell-with-no-warnings
+ (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
+ (ispell-non-empty-string sc-reference-tag-string))))
((boundp 'sc-cite-regexp) ; sc 2.3
(concat "\\(" sc-cite-regexp "\\)" "\\|"
- (with-no-warnings
+ (ispell-with-no-warnings
(ispell-non-empty-string sc-reference-tag-string))))
((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below
(equal major-mode 'message-mode)) ;GNUS 5
(concat "In article <" "\\|"
"[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|"
- (with-no-warnings message-cite-prefix-regexp)
+ (ispell-with-no-warnings message-cite-prefix-regexp)
"\\|"
default-prefix))
((equal major-mode 'mh-letter-mode) ; mh mail message
(concat "[^,;&+=\n]+ writes:" "\\|"
- (with-no-warnings
+ (ispell-with-no-warnings
(ispell-non-empty-string mh-ins-buf-prefix))))
((not internal-messagep) ; Assume nn sent us this message.
(concat "In [a-zA-Z.]+ you write:" "\\|"
;; Actually start a new ispell process, because we need
;; to send commands now to specify the local words to it.
(ispell-init-process)
+ (dolist (session-localword ispell-buffer-session-localwords)
+ (ispell-send-string (concat "@" session-localword "\n")))
+ (or ispell-buffer-local-name
+ (if ispell-buffer-session-localwords
+ (setq ispell-buffer-local-name (buffer-name))))
(save-excursion
(goto-char (point-min))
(while (search-forward ispell-words-keyword nil t)
(ispell-send-string (concat "@" string "\n"))))))))
-;;; returns optionally adjusted region-end-point.
+;; Returns optionally adjusted region-end-point.
;; If comment-padright is defined, newcomment must be loaded.
(declare-function comment-add "newcomment" (arg))
; LocalWords: alists minibuffer bufferp autoload loaddefs aff Dansk KOI SPC op
; LocalWords: Francais Nederlands charset autoloaded popup nonmenu regexp num
; LocalWords: AMStex hspace includeonly nocite epsfig displaymath eqnarray reg
-; LocalWords: minipage modeline pers dict unhighlight buf grep sync prev inc
+; LocalWords: minipage pers dict unhighlight buf grep sync prev inc
; LocalWords: fn oldot NB AIX msg init read's bufs pt cmd Quinlan eg
; LocalWords: uuencoded unidiff sc nn VM SGML eval IspellPersDict
; LocalWords: lns XEmacs HTML casechars Multibyte
;;; Code:
(defgroup picture nil
- "Picture mode --- editing using quarter-plane screen model."
+ "Editing text-based pictures (\"ASCII art\")."
:prefix "picture-"
:group 'wp)
;; Picture Movement Commands
-;; When a cursor is on a wide-column character (e.g. Chinese,
-;; Japanese, Korean), this variable tells the desired current column
-;; which may be different from (current-column).
-(defvar picture-desired-column 0)
+(defvar picture-desired-column 0
+ "Desired current column for Picture mode.
+When a cursor is on a wide-column character (e.g. Chinese,
+Japanese, Korean), this may may be different from `current-column'.")
+
-;; If the value of picture-desired-column is far from the current
-;; column, or if the arg ADJUST-TO-CURRENT is non-nil, set it to the
-;; current column. Return the current column.
(defun picture-update-desired-column (adjust-to-current)
+ "Maybe update `picture-desired-column'.
+If the value of `picture-desired-column' is more than one column
+from `current-column', or if the argument ADJUST-TO-CURRENT is
+non-nil, set it to the current column. Return `current-column'."
(let ((current-column (current-column)))
(if (or adjust-to-current
(< picture-desired-column (1- current-column))
(spacing (when (display-graphic-p frame)
(or (with-current-buffer (window-buffer window)
line-spacing)
- (frame-parameter frame 'line-spacing))))
- rows cols)
+ (frame-parameter frame 'line-spacing)))))
(cond ((floatp spacing)
(setq spacing (truncate (* spacing char-ht))))
((null spacing)
(defalias 'picture-delete-char 'delete-char)
-(defvar picture-mode-map nil)
-
-(defun picture-substitute (oldfun newfun)
- (define-key picture-mode-map (vector 'remap oldfun) newfun))
-
-(if (not picture-mode-map)
- (progn
- (setq picture-mode-map (make-keymap))
- (picture-substitute 'self-insert-command 'picture-self-insert)
- (picture-substitute 'completion-separator-self-insert-command
+(defvar picture-mode-map
+ (let ((map (make-keymap)))
+ (define-key map [remap self-insert-command] 'picture-self-insert)
+ (define-key map [remap self-insert-command] 'picture-self-insert)
+ (define-key map [remap completion-separator-self-insert-command]
'picture-self-insert)
- (picture-substitute 'completion-separator-self-insert-autofilling
+ (define-key map [remap completion-separator-self-insert-autofilling]
'picture-self-insert)
- (picture-substitute 'forward-char 'picture-forward-column)
- (picture-substitute 'right-char 'picture-forward-column)
- (picture-substitute 'backward-char 'picture-backward-column)
- (picture-substitute 'left-char 'picture-backward-column)
- (picture-substitute 'delete-char 'picture-clear-column)
+ (define-key map [remap forward-char] 'picture-forward-column)
+ (define-key map [remap right-char] 'picture-forward-column)
+ (define-key map [remap backward-char] 'picture-backward-column)
+ (define-key map [remap left-char] 'picture-backward-column)
+ (define-key map [remap delete-char] 'picture-clear-column)
;; There are two possibilities for what is normally on DEL.
- (picture-substitute 'backward-delete-char-untabify 'picture-backward-clear-column)
- (picture-substitute 'delete-backward-char 'picture-backward-clear-column)
- (picture-substitute 'kill-line 'picture-clear-line)
- (picture-substitute 'open-line 'picture-open-line)
- (picture-substitute 'newline 'picture-newline)
- (picture-substitute 'newline-and-indent 'picture-duplicate-line)
- (picture-substitute 'next-line 'picture-move-down)
- (picture-substitute 'previous-line 'picture-move-up)
- (picture-substitute 'move-beginning-of-line 'picture-beginning-of-line)
- (picture-substitute 'move-end-of-line 'picture-end-of-line)
- (picture-substitute 'mouse-set-point 'picture-mouse-set-point)
-
- (define-key picture-mode-map "\C-c\C-d" 'picture-delete-char)
- (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)
- (define-key picture-mode-map "\t" 'picture-tab)
- (define-key picture-mode-map "\e\t" 'picture-tab-search)
- (define-key picture-mode-map "\C-c\t" 'picture-set-tab-stops)
- (define-key picture-mode-map "\C-c\C-k" 'picture-clear-rectangle)
- (define-key picture-mode-map "\C-c\C-w" 'picture-clear-rectangle-to-register)
- (define-key picture-mode-map "\C-c\C-y" 'picture-yank-rectangle)
- (define-key picture-mode-map "\C-c\C-x" 'picture-yank-rectangle-from-register)
- (define-key picture-mode-map "\C-c\C-r" 'picture-draw-rectangle)
- (define-key picture-mode-map "\C-c\C-c" 'picture-mode-exit)
- (define-key picture-mode-map "\C-c\C-f" 'picture-motion)
- (define-key picture-mode-map "\C-c\C-b" 'picture-motion-reverse)
- (define-key picture-mode-map "\C-c<" 'picture-movement-left)
- (define-key picture-mode-map "\C-c>" 'picture-movement-right)
- (define-key picture-mode-map "\C-c^" 'picture-movement-up)
- (define-key picture-mode-map "\C-c." 'picture-movement-down)
- (define-key picture-mode-map "\C-c`" 'picture-movement-nw)
- (define-key picture-mode-map "\C-c'" 'picture-movement-ne)
- (define-key picture-mode-map "\C-c/" 'picture-movement-sw)
- (define-key picture-mode-map "\C-c\\" 'picture-movement-se)
- (define-key picture-mode-map [(control ?c) left] 'picture-movement-left)
- (define-key picture-mode-map [(control ?c) right] 'picture-movement-right)
- (define-key picture-mode-map [(control ?c) up] 'picture-movement-up)
- (define-key picture-mode-map [(control ?c) down] 'picture-movement-down)
- (define-key picture-mode-map [(control ?c) home] 'picture-movement-nw)
- (define-key picture-mode-map [(control ?c) prior] 'picture-movement-ne)
- (define-key picture-mode-map [(control ?c) end] 'picture-movement-sw)
- (define-key picture-mode-map [(control ?c) next] 'picture-movement-se)))
+ (define-key map [remap backward-delete-char-untabify]
+ 'picture-backward-clear-column)
+ (define-key map [remap delete-backward-char] 'picture-backward-clear-column)
+ (define-key map [remap kill-line] 'picture-clear-line)
+ (define-key map [remap open-line] 'picture-open-line)
+ (define-key map [remap newline] 'picture-newline)
+ (define-key map [remap newline-and-indent] 'picture-duplicate-line)
+ (define-key map [remap next-line] 'picture-move-down)
+ (define-key map [remap previous-line] 'picture-move-up)
+ (define-key map [remap move-beginning-of-line] 'picture-beginning-of-line)
+ (define-key map [remap move-end-of-line] 'picture-end-of-line)
+ (define-key map [remap mouse-set-point] 'picture-mouse-set-point)
+ (define-key map "\C-c\C-d" 'picture-delete-char)
+ (define-key map "\e\t" 'picture-toggle-tab-state)
+ (define-key map "\t" 'picture-tab)
+ (define-key map "\e\t" 'picture-tab-search)
+ (define-key map "\C-c\t" 'picture-set-tab-stops)
+ (define-key map "\C-c\C-k" 'picture-clear-rectangle)
+ (define-key map "\C-c\C-w" 'picture-clear-rectangle-to-register)
+ (define-key map "\C-c\C-y" 'picture-yank-rectangle)
+ (define-key map "\C-c\C-x" 'picture-yank-rectangle-from-register)
+ (define-key map "\C-c\C-r" 'picture-draw-rectangle)
+ (define-key map "\C-c\C-c" 'picture-mode-exit)
+ (define-key map "\C-c\C-f" 'picture-motion)
+ (define-key map "\C-c\C-b" 'picture-motion-reverse)
+ (define-key map "\C-c<" 'picture-movement-left)
+ (define-key map "\C-c>" 'picture-movement-right)
+ (define-key map "\C-c^" 'picture-movement-up)
+ (define-key map "\C-c." 'picture-movement-down)
+ (define-key map "\C-c`" 'picture-movement-nw)
+ (define-key map "\C-c'" 'picture-movement-ne)
+ (define-key map "\C-c/" 'picture-movement-sw)
+ (define-key map "\C-c\\" 'picture-movement-se)
+ (define-key map [(control ?c) left] 'picture-movement-left)
+ (define-key map [(control ?c) right] 'picture-movement-right)
+ (define-key map [(control ?c) up] 'picture-movement-up)
+ (define-key map [(control ?c) down] 'picture-movement-down)
+ (define-key map [(control ?c) home] 'picture-movement-nw)
+ (define-key map [(control ?c) prior] 'picture-movement-ne)
+ (define-key map [(control ?c) end] 'picture-movement-sw)
+ (define-key map [(control ?c) next] 'picture-movement-se)
+ map)
+ "Keymap used in `picture-mode'.")
(defcustom picture-mode-hook nil
"If non-nil, its value is called on entry to Picture mode.
:group 'wp)
(defcustom r2b-trace-on nil
- "*Non-nil means trace conversion."
+ "Non-nil means trace conversion."
:type 'boolean
:group 'refbib)
This is in addition to the `r2b-capitalize-title-stop-words'.")
(defcustom r2b-delimit-with-quote t
- "*If true, then use \" to delimit fields, otherwise use braces."
+ "If true, then use \" to delimit fields, otherwise use braces."
:type 'boolean
:group 'refbib)
(buffer-substring (match-beginning exp) (match-end exp)))
(defcustom r2b-out-buf-name "*Out*"
- "*Name of buffer for output from refer-to-bibtex."
+ "Name of buffer for output from refer-to-bibtex."
:type 'string
:group 'refbib)
(defcustom r2b-log-name "*Log*"
- "*Name of buffer for logs errors from refer-to-bibtex."
+ "Name of buffer for logs errors from refer-to-bibtex."
:type 'string
:group 'refbib)
;;; Code:
-(eval-when-compile (require 'cl))
-
(defgroup refill nil
"Refilling paragraphs on changes."
:group 'fill)
"Post-command function to do refilling (conditionally)."
(when refill-doit ; there was a change
;; There's probably scope for more special cases here...
- (case this-command
- (self-insert-command
+ (pcase this-command
+ (`self-insert-command
;; Treat self-insertion commands specially, since they don't
;; always reset `refill-doit' -- for self-insertion commands that
;; *don't* cause a refill, we want to leave it turned on so that
;; newline, covered below).
(refill-fill-paragraph-at refill-doit)
(setq refill-doit nil)))
- ((quoted-insert fill-paragraph fill-region) nil)
- ((newline newline-and-indent open-line indent-new-comment-line
- reindent-then-newline-and-indent)
+ ((or `quoted-insert `fill-paragraph `fill-region) nil)
+ ((or `newline `newline-and-indent `open-line `indent-new-comment-line
+ `reindent-then-newline-and-indent)
;; Don't zap what was just inserted.
(save-excursion
(beginning-of-line) ; for newline-and-indent
(save-restriction
(narrow-to-region (line-beginning-position) (point-max))
(refill-fill-paragraph-at refill-doit))))
- (t
+ (_
(refill-fill-paragraph-at refill-doit)))
(setq refill-doit nil)))
(t ""))))
(setq authors (reftex-truncate authors 30 t t))
(when (reftex-use-fonts)
- (put-text-property 0 (length key) 'face
- (reftex-verified-face reftex-label-face
- 'font-lock-constant-face
- 'font-lock-reference-face)
+ (put-text-property 0 (length key) 'face reftex-label-face
key)
(put-text-property 0 (length authors) 'face reftex-bib-author-face
authors)
(run-hooks 'reftex-display-copied-context-hook)))))
(defvar reftex-use-itimer-in-xemacs nil
- "*Non-nil means use the idle timers in XEmacs for crossref display.
+ "Non-nil means use the idle timers in XEmacs for crossref display.
Currently, idle timer restart is broken and we use the post-command-hook.")
(defun reftex-toggle-auto-view-crossref ()
;; variable `multi-isearch-next-buffer-function'.
(defun reftex-isearch-wrap-function ()
- (if (not isearch-word)
- (switch-to-buffer
- (funcall isearch-next-buffer-function (current-buffer) t)))
+ (switch-to-buffer
+ (funcall isearch-next-buffer-function (current-buffer) t))
(goto-char (if isearch-forward (point-min) (point-max))))
(defun reftex-isearch-push-state-function ()
(defun reftex-isearch-isearch-search (string bound noerror)
(let ((nxt-buff nil)
- (search-fun
- (cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward)))))
+ (search-fun (isearch-search-fun-default)))
(or
(funcall search-fun string bound noerror)
(unless bound
(kill-local-variable 'isearch-next-buffer-function))
(setq reftex-isearch-minor-mode nil))))
(remove-hook 'reftex-mode-hook 'reftex-isearch-minor-mode)))
- ;; Force modeline redisplay.
+ ;; Force mode line redisplay.
(set-buffer-modified-p (buffer-modified-p))))
(add-minor-mode 'reftex-isearch-minor-mode "/I" nil nil
(and newtag (cdr cell) (not (member newtag (cdr cell)))
(push newtag (cdr cell)))))
+(define-obsolete-variable-alias
+ 'reftex-index-map 'reftex-index-mode-map "24.1")
(defvar reftex-index-mode-map
(let ((map (make-sparse-keymap)))
;; Index map
map)
"Keymap used for *Index* buffers.")
-(define-obsolete-variable-alias
- 'reftex-index-map 'reftex-index-mode-map "24.1")
(defvar reftex-index-menu)
(if (memq reftex-highlight-selection '(mouse both))
reftex-mouse-selected-face
nil))
- (index-face (reftex-verified-face reftex-label-face
- 'font-lock-constant-face
- 'font-lock-reference-face))
+ (index-face reftex-label-face)
sublist cell from to first-char)
;; Make the sublist and sort it
"Font lock keywords for reftex-index-phrases-mode.")
(defvar reftex-index-phrases-font-lock-defaults nil
"Font lock defaults for reftex-index-phrases-mode.")
+(define-obsolete-variable-alias
+ 'reftex-index-phrases-map 'reftex-index-phrases-mode-map "24.1")
(defvar reftex-index-phrases-mode-map
(let ((map (make-sparse-keymap)))
;; Keybindings and Menu for phrases buffer
map)
"Keymap used for *toc* buffer.")
-(define-obsolete-variable-alias
- 'reftex-index-phrases-map 'reftex-index-phrases-mode-map "24.1")
(defun reftex-index-phrase-selection-or-word (arg)
(save-match-data
(cond
((equal letter "f")
- (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name))))
+ (file-name-base))
((equal letter "F")
(let ((masterdir (file-name-directory (reftex-TeX-master-file)))
(file (file-name-sans-extension (buffer-file-name))))
(substring file (length masterdir))
file)))
((equal letter "m")
- (file-name-sans-extension
- (file-name-nondirectory (reftex-TeX-master-file))))
+ (file-name-base (reftex-TeX-master-file)))
((equal letter "M")
(file-name-nondirectory
(substring (file-name-directory (reftex-TeX-master-file))
(define-key map "-" 'negative-argument)
map))
+(define-obsolete-variable-alias
+ 'reftex-select-label-map 'reftex-select-label-mode-map "24.1")
(defvar reftex-select-label-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map reftex-select-shared-map)
"Keymap used for *RefTeX Select* buffer, when selecting a label.
This keymap can be used to configure the label selection process which is
started with the command \\[reftex-reference].")
-(define-obsolete-variable-alias
- 'reftex-select-label-map 'reftex-select-label-mode-map "24.1")
(define-derived-mode reftex-select-label-mode fundamental-mode "LSelect"
"Major mode for selecting a label in a LaTeX document.
;; We do not set a local map - reftex-select-item does this.
)
+(define-obsolete-variable-alias
+ 'reftex-select-bib-map 'reftex-select-bib-mode-map "24.1")
(defvar reftex-select-bib-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map reftex-select-shared-map)
"Keymap used for *RefTeX Select* buffer, when selecting a BibTeX entry.
This keymap can be used to configure the BibTeX selection process which is
started with the command \\[reftex-citation].")
-(define-obsolete-variable-alias
- 'reftex-select-bib-map 'reftex-select-bib-mode-map "24.1")
(define-derived-mode reftex-select-bib-mode fundamental-mode "BSelect"
"Major mode for selecting a citation key in a LaTeX document.
(if (memq reftex-highlight-selection '(mouse both))
reftex-mouse-selected-face
nil))
- (label-face (reftex-verified-face reftex-label-face
- 'font-lock-constant-face
- 'font-lock-reference-face))
- (index-face (reftex-verified-face reftex-index-face
- 'font-lock-constant-face
- 'font-lock-reference-face))
+ (label-face reftex-label-face)
+ (index-face reftex-index-face)
all cell text label typekey note comment master-dir-re
prev-inserted offset from to index-tag docstruct-symbol)
(require 'reftex)
;;;
+(define-obsolete-variable-alias 'reftex-toc-map 'reftex-toc-mode-map "24.1")
(defvar reftex-toc-mode-map
(let ((map (make-sparse-keymap)))
map)
"Keymap used for *toc* buffer.")
-(define-obsolete-variable-alias 'reftex-toc-map 'reftex-toc-mode-map "24.1")
(defvar reftex-toc-menu)
(defvar reftex-last-window-height nil)
(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)
;; The label macro is hard coded, but it *could* be defined like this:
;;("\\label{*}" nil nil nil nil)
- ))
-
- )
+ )))
"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.")
(symbol :tag "function " my-level-func)))))
(defcustom reftex-toc-max-level 100
- "*The maximum level of toc entries which will be included in the TOC.
+ "The maximum level of toc entries which will be included in the TOC.
Section headings with a bigger level will be ignored. In RefTeX, chapters
are level 1, sections are level 2 etc.
This variable can be changed from within the *toc* buffer with the `t' key."
:type 'integer)
(defcustom reftex-part-resets-chapter nil
- "*Non-nil means, \\part is like any other sectioning command.
+ "Non-nil means, \\part is like any other sectioning command.
This means, part numbers will be included in the numbering of chapters, and
chapter counters will be reset for each part.
When nil (the default), parts are special, do not reset the chapter counter
(defcustom reftex-auto-recenter-toc 'frame
- "*Non-nil means, turn automatic recentering of *TOC* window on.
+ "Non-nil means, turn automatic recentering of *TOC* window on.
When active, the *TOC* window will always show the section you
are currently working in. Recentering happens whenever Emacs is idle for
more than `reftex-idle-time' seconds.
(const :tag "in dedicated frame only" frame)))
(defcustom reftex-toc-split-windows-horizontally nil
- "*Non-nil means, create TOC window by splitting window horizontally."
+ "Non-nil means, create TOC window by splitting window horizontally."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-split-windows-fraction .3
- "*Fraction of the width or height of the frame to be used for TOC window.
+ "Fraction of the width or height of the frame to be used for TOC window.
See also `reftex-toc-split-windows-horizontally'."
:group 'reftex-table-of-contents-browser
:type 'number)
"This variable is obsolete, use `reftex-toc-split-windows-fraction' instead.")
(defcustom reftex-toc-keep-other-windows t
- "*Non-nil means, split the selected window to display the *toc* buffer.
+ "Non-nil means, split the selected window to display the *toc* buffer.
This helps to keep the window configuration, but makes the *toc* small.
When nil, all other windows except the selected one will be deleted, so
that the *toc* window fills half the frame."
:type 'boolean)
(defcustom reftex-toc-include-file-boundaries nil
- "*Non-nil means, include file boundaries in *toc* buffer.
+ "Non-nil means, include file boundaries in *toc* buffer.
This flag can be toggled from within the *toc* buffer with the `F' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-include-labels nil
- "*Non-nil means, include labels in *toc* buffer.
+ "Non-nil means, include labels in *toc* buffer.
This flag can be toggled from within the *toc* buffer with the `l' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-include-index-entries nil
- "*Non-nil means, include index entries in *toc* buffer.
+ "Non-nil means, include index entries in *toc* buffer.
This flag can be toggled from within the *toc* buffer with the `i' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-confirm-promotion 2
- "*Non-nil means, promotion/demotion commands first prompt for confirmation.
+ "Non-nil means, promotion/demotion commands first prompt for confirmation.
When nil, the command is executed immediately. When this is an integer
N, ask for confirmation only if N or more section commands are going to be
changed."
(number :tag "When more than N sections" :value 2)))
(defcustom reftex-toc-include-context nil
- "*Non-nil means, include context with labels in the *toc* buffer.
+ "Non-nil means, include context with labels in the *toc* buffer.
Context will only be shown when labels are visible as well.
This flag can be toggled from within the *toc* buffer with the `c' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-toc-follow-mode nil
- "*Non-nil means, point in *toc* buffer will cause other window to follow.
+ "Non-nil means, point in *toc* buffer will cause other window to follow.
The other window will show the corresponding part of the document.
This flag can be toggled from within the *toc* buffer with the `f' key."
:group 'reftex-table-of-contents-browser
:type 'boolean)
(defcustom reftex-revisit-to-follow nil
- "*Non-nil means, follow-mode will revisit files if necessary.
+ "Non-nil means, follow-mode will revisit files if necessary.
When nil, follow-mode will be suspended for stuff in unvisited files."
:group 'reftex-table-of-contents-browser
:group 'reftex-referencing-labels
(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
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
:type '(repeat (cons (character) (string))))
(defcustom reftex-vref-is-default nil
- "*Non-nil means, the varioref macro \\vref is used as default.
+ "Non-nil means, the varioref macro \\vref is used as default.
In the selection buffer, the `v' key toggles the reference macro between
`\\ref' and `\\vref'. The value of this variable determines the default
which is active when entering the selection process.
;;;###autoload(put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
(defcustom reftex-fref-is-default nil
- "*Non-nil means, the fancyref macro \\fref is used as default.
+ "Non-nil means, the fancyref macro \\fref is used as default.
In the selection buffer, the `V' key toggles the reference macro between
`\\ref', `\\fref' and `\\Fref'. The value of this variable determines
the default which is active when entering the selection process.
;;;###autoload(put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
(defcustom reftex-level-indent 2
- "*Number of spaces to be used for indentation per section level."
+ "Number of spaces to be used for indentation per section level."
:group 'reftex-referencing-labels
:type 'integer)
;;;###autoload(put 'reftex-level-indent 'safe-local-variable 'integerp)
(defcustom reftex-guess-label-type t
- "*Non-nil means, `reftex-reference' will try to guess the label type.
+ "Non-nil means, `reftex-reference' will try to guess the label type.
To do that, RefTeX will look at the word before the cursor and compare it with
the words given in `reftex-label-alist'. When it finds a match, RefTeX will
immediately offer the correct label menu - otherwise it will prompt you for
(defvar reftex-bibfile-ignore-list nil) ; compatibility
(defcustom reftex-bibfile-ignore-regexps nil
- "*List of regular expressions to exclude files in \\bibliography{..}.
+ "List of regular expressions to exclude files in \\bibliography{..}.
File names matched by these regexps will not be parsed by RefTeX.
Intended for files which contain only `@string' macro definitions and the
like, which are ignored by RefTeX anyway."
:type '(repeat (regexp)))
(defcustom reftex-default-bibliography nil
- "*List of BibTeX database files which should be used if none are specified.
+ "List of BibTeX database files which should be used if none are specified.
When `reftex-citation' is called from a document which has neither a
`\\bibliography{..}' statement nor a `thebibliography' environment,
RefTeX will scan these files instead. Intended for using `reftex-citation'
:type '(repeat (file)))
(defcustom reftex-sort-bibtex-matches 'reverse-year
- "*Sorting of the entries found in BibTeX databases by reftex-citation.
+ "Sorting of the entries found in BibTeX databases by reftex-citation.
Possible values:
nil Do not sort entries.
'author Sort entries by author name.
(const :tag "by year, reversed" reverse-year)))
(defcustom reftex-cite-format 'default
- "*The format of citations to be inserted into the buffer.
+ "The format of citations to be inserted into the buffer.
It can be a string or an alist or a symbol. In the simplest case this
is just the string \"\\cite{%l}\", which is also the default. See the
definition of `reftex-cite-format-builtin' for more complex examples.
(string :tag "Format string" "")))))
(defcustom reftex-cite-prompt-optional-args 'maybe
- "*Non-nil means, prompt for empty optional arguments in cite macros.
+ "Non-nil means, prompt for empty optional arguments in cite macros.
When an entry in `reftex-cite-format' ist given with square brackets to
indicate optional arguments (for example \\cite[][]{%l}), RefTeX can
prompt for values. Possible values are:
(const :tag "Never" nil)))
(defcustom reftex-cite-cleanup-optional-args t
- "*Non-nil means, remove unnecessary empty optional arguments in cite macros.
+ "Non-nil means, remove unnecessary empty optional arguments in cite macros.
The cite macros provided by some packages (for example
natbib) allow specifying two optional arguments, one for a prefix to
the citation, and a second for a postfix. When only one optional
:type 'boolean)
(defcustom reftex-comment-citations nil
- "*Non-nil means add a comment for each citation describing the full entry.
+ "Non-nil means add a comment for each citation describing the full entry.
The comment is formatted according to `reftex-cite-comment-format'."
:group 'reftex-citation-support
:type 'boolean)
:group 'reftex)
(defcustom reftex-support-index t
- "*Non-nil means, index entries are parsed as well.
+ "Non-nil means, index entries are parsed as well.
Index support is resource intensive and the internal structure holding the
parsed information can become quite big. Therefore it can be turned off.
When this is nil and you execute a command which requires index support,
:type 'regexp)
(defcustom reftex-index-phrases-search-whole-words t
- "*Non-nil means phrases search will look for whole words, not subwords.
+ "Non-nil means phrases search will look for whole words, not subwords.
This works by requiring word boundaries at the beginning and end of
the search string. When the search phrase already has a non-word-char
at one of these points, no word boundary is required there."
:type 'boolean)
(defcustom reftex-index-phrases-case-fold-search t
- "*Non-nil means, searching for index phrases will ignore case."
+ "Non-nil means, searching for index phrases will ignore case."
:group 'reftex-index-support
:type 'boolean)
(function)))
(defcustom reftex-index-phrases-skip-indexed-matches nil
- "*Non-nil means, skip matches which appear to be indexed already.
+ "Non-nil means, skip matches which appear to be indexed already.
When doing global indexing from the phrases buffer, searches for some
phrases may match at places where that phrase was already indexed. In
particular when indexing an already processed document again, this
:type 'boolean)
(defcustom reftex-index-phrases-wrap-long-lines nil
- "*Non-nil means, when indexing from the phrases buffer, wrap lines.
+ "Non-nil means, when indexing from the phrases buffer, wrap lines.
Inserting indexing commands in a line makes the line longer - often
so long that it does not fit onto the screen. When this variable is
non-nil, newlines will be added as necessary before and/or after the
:type 'boolean)
(defcustom reftex-index-phrases-sort-prefers-entry nil
- "*Non-nil means when sorting phrase lines, the explicit index entry is used.
+ "Non-nil means when sorting phrase lines, the explicit index entry is used.
Phrase lines in the phrases buffer contain a search phrase, and
sorting is normally based on these. Some phrase lines also have
an explicit index argument specified. When this variable is non-nil,
:type 'boolean)
(defcustom reftex-index-phrases-sort-in-blocks t
- "*Non-nil means, empty and comment lines separate phrase buffer into blocks.
+ "Non-nil means, empty and comment lines separate phrase buffer into blocks.
Sorting will then preserve blocks, so that lines are re-arranged only
within blocks."
:group 'reftex-index-support
:type '(string :tag "Capital letters"))
(defcustom reftex-index-include-context nil
- "*Non-nil means, display the index definition context in the index buffer.
+ "Non-nil means, display the index definition context in the index buffer.
This flag may also be toggled from the index buffer with the `c' key."
:group 'reftex-index-support
:type 'boolean)
(defcustom reftex-index-follow-mode nil
- "*Non-nil means, point in *Index* buffer will cause other window to follow.
+ "Non-nil means, point in *Index* buffer will cause other window to follow.
The other window will show the corresponding part of the document.
This flag can be toggled from within the *Index* buffer with the `f' key."
:group 'reftex-table-of-contents-browser
(integer :tag "Highlight Group"))))
(defcustom reftex-auto-view-crossref t
- "*Non-nil means, initially turn automatic viewing of crossref info on.
+ "Non-nil means, initially turn automatic viewing of crossref info on.
Automatic viewing of crossref info normally uses the echo area.
Whenever point is idle for more than `reftex-idle-time' seconds on the
argument of a \\ref or \\cite macro, and no other message is being
(const :tag "in Other Window" window)))
(defcustom reftex-idle-time 1.2
- "*Time (secs) Emacs has to be idle before automatic crossref display is done.
+ "Time (secs) Emacs has to be idle before automatic crossref display is done.
Applies also to toc recentering."
:group 'reftex-viewing-cross-references
:type 'number)
(defcustom reftex-revisit-to-echo nil
- "*Non-nil means, automatic citation display will revisit files if necessary.
+ "Non-nil means, automatic citation display will revisit files if necessary.
When nil, citation display in echo area will only be active for cached
entries and for BibTeX database files with live associated buffers."
:group 'reftex-viewing-cross-references
:type 'boolean)
(defcustom reftex-cache-cite-echo t
- "*Non-nil means, the information displayed in the echo area for cite macros
+ "Non-nil means, the information displayed in the echo area for cite macros
is cached and even saved along with the parsing information. The cache
survives document scans. In order to clear it, use M-x reftex-reset-mode."
:group 'reftex-viewing-cross-references
:group 'reftex)
(defcustom reftex-texpath-environment-variables '("TEXINPUTS")
- "*List of specifications how to retrieve the search path for TeX files.
+ "List of specifications how to retrieve the search path for TeX files.
Several entries are possible.
- If an element is the name of an environment variable, its content is used.
- If an element starts with an exclamation mark, it is used as a command
:type '(repeat (string :tag "Specification")))
(defcustom reftex-bibpath-environment-variables '("BIBINPUTS" "TEXBIB")
- "*List of specifications how to retrieve search path for .bib database files.
+ "List of specifications how to retrieve search path for .bib database files.
Several entries are possible.
- If an element is the name of an environment variable, its content is used.
- If an element starts with an exclamation mark, it is used as a command
(defcustom reftex-file-extensions '(("tex" . (".tex" ".ltx"))
("bib" . (".bib")))
- "*Association list with file extensions for different file types.
+ "Association list with file extensions for different file types.
This is a list of items, each item is like: (TYPE . (DEF-EXT OTHER-EXT ...))
TYPE: File type like \"bib\" or \"tex\".
:type 'boolean)
(defcustom reftex-search-unrecursed-path-first t
- "*Non-nil means, search all specified directories before trying recursion.
+ "Non-nil means, search all specified directories before trying recursion.
Thus, in a path \".//:/tex/\", search first \"./\", then \"/tex/\" and then
all subdirectories of \"./\". If this option is nil, the subdirectories of
\"./\" are searched before \"/tex/\". This is mainly for speed - most of the
:type 'boolean)
(defcustom reftex-use-external-file-finders nil
- "*Non-nil means, use external programs to find files.
+ "Non-nil means, use external programs to find files.
Normally, RefTeX searches the paths given in the environment variables
TEXINPUTS and BIBINPUTS to find TeX files and BibTeX database files.
With this option turned on, it calls an external program specified in the
(defcustom reftex-external-file-finders '(("tex" . "kpsewhich -format=.tex %f")
("bib" . "kpsewhich -format=.bib %f"))
- "*Association list with external programs to call for finding files.
+ "Association list with external programs to call for finding files.
Each entry is a cons cell (TYPE . PROGRAM).
TYPE is either \"tex\" or \"bib\". PROGRAM is the external program to use with
any arguments. %f will be replaced by the name of the file to be found.
:group 'reftex)
(defcustom reftex-keep-temporary-buffers 1
- "*Non-nil means, keep buffers created for parsing and lookup.
+ "Non-nil means, keep buffers created for parsing and lookup.
RefTeX sometimes needs to visit files related to the current document.
We distinguish files visited for
PARSING: Parts of a multifile document loaded when (re)-parsing the document.
(const :tag "Keep lookup buffers only" 1)))
(defcustom reftex-initialize-temporary-buffers nil
- "*Non-nil means do initializations even when visiting file temporarily.
+ "Non-nil means do initializations even when visiting file temporarily.
When nil, RefTeX may turn off find-file hooks and other stuff to briefly
visit a file.
When t, the full default initializations are done (find-file-hook etc.).
(function-item))))
(defcustom reftex-no-include-regexps '("\\.pstex_t\\'")
- "*List of regular expressions to exclude certain input files from parsing.
+ "List of regular expressions to exclude certain input files from parsing.
If the name of a file included via \\include or \\input is matched by any
of the regular expressions in this list, that file is not parsed by RefTeX."
:group 'reftex-optimizations-for-large-documents
:type '(repeat (regexp)))
(defcustom reftex-enable-partial-scans nil
- "*Non-nil means, re-parse only 1 file when asked to re-parse.
+ "Non-nil means, re-parse only 1 file when asked to re-parse.
Re-parsing is normally requested with a `C-u' prefix to many RefTeX commands,
or with the `r' key in menus. When this option is t in a multifile document,
we will only parse the current buffer, or the file associated with the label
:type 'boolean)
(defcustom reftex-allow-automatic-rescan t
- "*Non-nil means, RefTeX may rescan the document when this seems necessary.
+ "Non-nil means, RefTeX may rescan the document when this seems necessary.
Currently this applies only to rescanning after label insertion, when
the new label cannot be inserted correctly into the internal label
list."
:type 'boolean)
(defcustom reftex-save-parse-info nil
- "*Non-nil means, save information gathered with parsing in a file.
+ "Non-nil means, save information gathered with parsing in a file.
The file MASTER.rel in the same directory as MASTER.tex is used to save the
information. When this variable is t,
- accessing the parsing information for the first time in an editing session
:type 'boolean)
(defcustom reftex-parse-file-extension ".rel"
- "*File extension for the file in which parser information is stored.
+ "File extension for the file in which parser information is stored.
This extension is added to the base name of the master file."
:group 'reftex-optimizations-for-large-documents
:type 'string)
(defcustom reftex-use-multiple-selection-buffers nil
- "*Non-nil means use a separate selection buffer for each label type.
+ "Non-nil means use a separate selection buffer for each label type.
These buffers are kept from one selection to the next and need not to be
created for each use - so the menu generally comes up faster. The
selection buffers will be erased (and therefore updated) automatically
:type 'boolean)
(defcustom reftex-auto-update-selection-buffers t
- "*Non-nil means, selection buffers will be updated automatically.
+ "Non-nil means, selection buffers will be updated automatically.
When a new label is defined with `reftex-label', all selection buffers
associated with that label category are emptied, in order to force an
update upon next use. When nil, the buffers are left alone and have to be
:group 'reftex)
(defcustom reftex-use-fonts t
- "*Non-nil means, use fonts in *toc* and selection buffers.
+ "Non-nil means, use fonts in *toc* and selection buffers.
Font-lock must be loaded as well to actually get fontified display.
When changing this option, a rescan may be necessary to activate the change."
:group 'reftex-fontification-configurations
:type 'boolean)
(defcustom reftex-refontify-context 1
- "*Non-nil means, re-fontify the context in the label menu with font-lock.
+ "Non-nil means, re-fontify the context in the label menu with font-lock.
This slightly slows down the creation of the label menu. It is only necessary
when you definitely want the context fontified.
(const :tag "When necessary" 1)))
(defcustom reftex-highlight-selection 'cursor
- "*Non-nil mean, highlight selected text in selection and *toc* buffers.
+ "Non-nil mean, highlight selected text in selection and *toc* buffers.
Normally, the text near the cursor is the selected text, and it is
highlighted. This is the entry most keys in the selection and *toc*
buffers act on. However, if you mainly use the mouse to select an
:type 'boolean)
(defcustom reftex-plug-into-AUCTeX nil
- "*Plug-in flags for AUCTeX interface.
+ "Plug-in flags for AUCTeX interface.
This variable is a list of 4 boolean flags. When a flag is non-nil,
RefTeX will
)))
(defcustom reftex-allow-detached-macro-args nil
- "*Non-nil means, allow arguments of macros to be detached by whitespace.
+ "Non-nil means, allow arguments of macros to be detached by whitespace.
When this is t, `aaa' will be considered as argument of \\bb in the following
construct: \\bbb [xxx] {aaa}."
:group 'reftex-miscellaneous-configurations
;; To turn RefTeX Mode on and off in a buffer, use `M-x reftex-mode'.
;;
;; To turn on RefTeX Mode for all LaTeX files, add the following lines
-;; to your .emacs file:
+;; to your init file:
;;
;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; AUCTeX LaTeX mode
;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; Emacs latex mode
;;
;; To turn RefTeX Mode on and off in a particular buffer, use `M-x
;; reftex-mode'. To turn on RefTeX Mode for all LaTeX files, add the
-;; following lines to your `.emacs' file:
+;; following lines to your init file:
;;
;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode
;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode
; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*")
(wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because
;;; because match number are hard coded
- (label-re "\\\\label{\\([^}]*\\)}")
+ (label-re (concat "\\(?:"
+ ;; Normal \label{...}
+ "\\\\label{\\([^}]*\\)}"
+ "\\|"
+ ;; keyvals [..., label = {foo}, ...]
+ ;; forms used by ctable, listings,
+ ;; minted, ...
+ "\\[[^]]*label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?"
+ "\\)"))
(include-re (concat wbol
"\\\\\\("
(mapconcat 'identity
"\\)\\([[{][^]}]*[]}]\\)*[[{]\\(%s\\)[]}]"))
(find-label-re-format
(concat "\\("
+ "label[[:space:]]*=[[:space:]]*"
+ "\\|"
(mapconcat 'regexp-quote (append '("\\label")
macros-with-labels) "\\|")
"\\)\\([[{][^]}]*[]}]\\)*[[{]\\(%s\\)[]}]"))
;; Return the first valid face in FACES, or nil if none is valid.
;; Also, when finding a nil element in FACES, return nil. This
;; function is just a safety net to catch name changes of builtin
- ;; fonts. Currently it is only used for reftex-label-face, which has
- ;; as default font-lock-reference-face, which was recently renamed
- ;; to font-lock-constant-face.
+ ;; fonts. Currently it is only used for reftex-label-face.
(let (face)
(catch 'exit
(while (setq face (pop faces))
;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
-;; Authors: Martin Blais <blais@furius.ca>,
-;; Stefan Merten <smerten@oekonux.de>,
-;; David Goodger <goodger@python.org>
+;; Maintainer: Stefan Merten <smerten@oekonux.de>
+;; Author: Stefan Merten <smerten@oekonux.de>,
+;; Martin Blais <blais@furius.ca>,
+;; David Goodger <goodger@python.org>,
+;; Wei-Wei Guo <wwguocn@gmail.com>
;; This file is part of GNU Emacs.
;;; Commentary:
-;; This package provides major mode rst-mode, which supports documents marked up
-;; using the reStructuredText format. Support includes font locking as well as
-;; some convenience functions for editing. It does this by defining a Emacs
-;; major mode: rst-mode (ReST). This mode is derived from text-mode (and
-;; inherits much of it). This package also contains:
+;; This package provides major mode rst-mode, which supports documents marked
+;; up using the reStructuredText format. Support includes font locking as well
+;; as a lot of convenience functions for editing. It does this by defining a
+;; Emacs major mode: rst-mode (ReST). This mode is derived from text-mode.
+;; This package also contains:
;;
;; - Functions to automatically adjust and cycle the section underline
-;; decorations;
+;; adornments;
;; - A mode that displays the table of contents and allows you to jump anywhere
;; from it;
;; - Functions to insert and automatically update a TOC in your source
;; document;
-;; - Font-lock highlighting of notable reStructuredText structures;
+;; - Function to insert list, processing item bullets and enumerations
+;; automatically;
+;; - Font-lock highlighting of most reStructuredText structures;
+;; - Indentation and filling according to reStructuredText syntax;
+;; - Cursor movement according to reStructuredText syntax;
;; - Some other convenience functions.
;;
;; See the accompanying document in the docutils documentation about
;; http://docutils.sourceforge.net/docs/user/emacs.html
;;
;;
-;; There are a number of convenient keybindings provided by rst-mode.
-;; The main one is
-;;
-;; C-c C-a (also C-=): rst-adjust
-;;
-;; Updates or rotates the section title around point or promotes/demotes the
-;; decorations within the region (see full details below). Note that C-= is a
-;; good binding, since it allows you to specify a negative arg easily with C--
-;; C-= (easy to type), as well as ordinary prefix arg with C-u C-=.
-;;
+;; There are a number of convenient key bindings provided by rst-mode.
;; For more on bindings, see rst-mode-map below. There are also many variables
-;; that can be customized, look for defcustom and defvar in this file.
+;; that can be customized, look for defcustom in this file.
;;
;; If you use the table-of-contents feature, you may want to add a hook to
-;; update the TOC automatically everytime you adjust a section title::
+;; update the TOC automatically every time you adjust a section title::
;;
;; (add-hook 'rst-adjust-hook 'rst-toc-update)
;;
;;
;; (setq font-lock-global-modes '(not rst-mode ...))
;;
-
-
-;; CUSTOMIZATION
-;;
-;; rst
-;; ---
-;; This group contains some general customizable features.
-;;
-;; The group is contained in the wp group.
-;;
-;; rst-faces
-;; ---------
-;; This group contains all necessary for customizing fonts. The default
-;; settings use standard font-lock-*-face's so if you set these to your
-;; liking they are probably good in rst-mode also.
-;;
-;; The group is contained in the faces group as well as in the rst group.
-;;
-;; rst-faces-defaults
-;; ------------------
-;; This group contains all necessary for customizing the default fonts used for
-;; section title faces.
-;;
-;; The general idea for section title faces is to have a non-default background
-;; but do not change the background. The section level is shown by the
-;; lightness of the background color. If you like this general idea of
-;; generating faces for section titles but do not like the details this group
-;; is the point where you can customize the details. If you do not like the
-;; general idea, however, you should customize the faces used in
-;; rst-adornment-faces-alist.
;;
-;; Note: If you are using a dark background please make sure the variable
-;; frame-background-mode is set to the symbol dark. This triggers
-;; some default values which are probably right for you.
;;
-;; The group is contained in the rst-faces group.
+;; Customization is done by customizable variables contained in customization
+;; group "rst" and subgroups. Group "rst" is contained in the "wp" group.
;;
-;; All customizable features have a comment explaining their meaning.
-;; Refer to the customization of your Emacs (try ``M-x customize``).
-
;;; DOWNLOAD
-;; The latest version of this file lies in the docutils source code repository:
-;; http://svn.berlios.de/svnroot/repos/docutils/trunk/docutils/tools/editors/emacs/rst.el
-
+;; The latest release of this file lies in the docutils source code repository:
+;; http://docutils.svn.sourceforge.net/svnroot/docutils/trunk/docutils/tools/editors/emacs/rst.el
;;; INSTALLATION
-;; Add the following lines to your `.emacs' file:
+;; Add the following lines to your init file:
;;
;; (require 'rst)
;;
;; want automatically enter rst-mode from any file with compatible extensions:
;;
;; (setq auto-mode-alist
-;; (append '(("\\.txt$" . rst-mode)
-;; ("\\.rst$" . rst-mode)
-;; ("\\.rest$" . rst-mode)) auto-mode-alist))
+;; (append '(("\\.txt\\'" . rst-mode)
+;; ("\\.rst\\'" . rst-mode)
+;; ("\\.rest\\'" . rst-mode)) auto-mode-alist))
;;
-;;; BUGS
-
-;; - rst-enumeration-region: Select a single paragraph, with the top at one
-;; blank line before the beginning, and it will fail.
-;; - The active region goes away when we shift it left or right, and this
-;; prevents us from refilling it automatically when shifting many times.
-;; - The suggested decorations when adjusting should not have to cycle
-;; below one below the last section decoration level preceding the
-;; cursor. We need to fix that.
-
-;;; TODO LIST
-
-;; rst-toc-insert features
-;; ------------------------
-;; - rst-toc-insert: We should parse the contents:: options to figure out how
-;; deep to render the inserted TOC.
-;; - On load, detect any existing TOCs and set the properties for links.
-;; - TOC insertion should have an option to add empty lines.
-;; - TOC insertion should deal with multiple lines.
-;; - There is a bug on redo after undo of adjust when rst-adjust-hook uses the
-;; automatic toc update. The cursor ends up in the TOC and this is
-;; annoying. Gotta fix that.
-;; - numbering: automatically detect if we have a section-numbering directive in
-;; the corresponding section, to render the toc.
-;;
-;; bulleted and enumerated list items
-;; ----------------------------------
-;; - We need to provide way to rebullet bulleted lists, and that would include
-;; automatic enumeration as well.
-;;
-;; Other
-;; -----
-;; - It would be nice to differentiate between text files using
-;; reStructuredText_ and other general text files. If we had a
-;; function to automatically guess whether a .txt file is following the
-;; reStructuredText_ conventions, we could trigger rst-mode without
-;; having to hard-code this in every text file, nor forcing the user to
-;; add a local mode variable at the top of the file.
-;; We could perform this guessing by searching for a valid decoration
-;; at the top of the document or searching for reStructuredText_
-;; directives further on.
-;;
-;; - We should support imenu in our major mode, with the menu filled with the
-;; section titles (this should be really easy).
-;;
-;; - We should rename "adornment" to "decoration" or vice-versa in this
-;; document (Stefan's code ("adornment") vs Martin ("decoration")), maybe some
-;; functions even overlap.
-;;
-;; - We need to automatically recenter on rst-forward-section movement commands.
+;;; Code:
+;; FIXME: Check through major mode conventions again.
-;;; HISTORY
-;;
+;; FIXME: Add proper ";;;###autoload" comments.
-;;; Code:
+;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*-
+;; lexical-binding: t -*-" in the first line.
-\f
-(defgroup rst nil "Support for reStructuredText documents."
- :group 'wp
- :version "23.1"
- :link '(url-link "http://docutils.sourceforge.net/rst.html"))
+;; FIXME: Use `testcover'.
+;; FIXME: The adornment classification often called `ado' should be a
+;; `defstruct'.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Support for `testcover'
+
+(when (and (boundp 'testcover-1value-functions)
+ (boundp 'testcover-compose-functions))
+ ;; Below `lambda' is used in a loop with varying parameters and is thus not
+ ;; 1valued.
+ (setq testcover-1value-functions
+ (delq 'lambda testcover-1value-functions))
+ (add-to-list 'testcover-compose-functions 'lambda))
+
+(defun rst-testcover-defcustom ()
+ "Remove all customized variables from `testcover-module-constants'.
+This seems to be a bug in `testcover': `defcustom' variables are
+considered constants. Revert it with this function after each `defcustom'."
+ (when (boundp 'testcover-module-constants)
+ (setq testcover-module-constants
+ (delq nil
+ (mapcar
+ (lambda (sym)
+ (if (not (plist-member (symbol-plist sym) 'standard-value))
+ sym))
+ testcover-module-constants)))))
+
+(defun rst-testcover-add-compose (fun)
+ "Add FUN to `testcover-compose-functions'."
+ (when (boundp 'testcover-compose-functions)
+ (add-to-list 'testcover-compose-functions fun)))
+
+(defun rst-testcover-add-1value (fun)
+ "Add FUN to `testcover-1value-functions'."
+ (when (boundp 'testcover-1value-functions)
+ (add-to-list 'testcover-1value-functions fun)))
-\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Define some generic support functions.
+;; Common Lisp stuff
-(eval-when-compile (require 'cl)) ;; We need this for destructuring-bind below.
+;; Only use of macros is allowed - may be replaced by `cl-lib' some time.
+(eval-when-compile
+ (require 'cl))
+;; Redefine some functions from `cl.el' in a proper namespace until they may be
+;; used from there.
-;; From Emacs-22
-(unless (fboundp 'line-number-at-pos)
- (defun line-number-at-pos (&optional pos)
- "Return (narrowed) buffer line number at position POS.
- If POS is nil, use current buffer location."
- (let ((opoint (or pos (point))) start)
- (save-excursion
- (goto-char (point-min))
- (setq start (point))
- (goto-char opoint)
- (forward-line 0)
- (1+ (count-lines start (point)))))) )
+(defun rst-signum (x)
+ "Return 1 if X is positive, -1 if negative, 0 if zero."
+ (cond
+ ((> x 0) 1)
+ ((< x 0) -1)
+ (t 0)))
+
+(defun rst-some (seq &optional pred)
+ "Return non-nil if any element of SEQ yields non-nil when PRED is applied.
+Apply PRED to each element of list SEQ until the first non-nil
+result is yielded and return this result. PRED defaults to
+`identity'."
+ (unless pred
+ (setq pred 'identity))
+ (catch 'rst-some
+ (dolist (elem seq)
+ (let ((r (funcall pred elem)))
+ (when r
+ (throw 'rst-some r))))))
+
+(defun rst-position-if (pred seq)
+ "Return position of first element satisfying PRED in list SEQ or nil."
+ (catch 'rst-position-if
+ (let ((i 0))
+ (dolist (elem seq)
+ (when (funcall pred elem)
+ (throw 'rst-position-if i))
+ (incf i)))))
+
+(defun rst-position (elem seq)
+ "Return position of ELEM in list SEQ or nil.
+Comparison done with `equal'."
+ ;; Create a closure containing `elem' so the `lambda' always sees our
+ ;; parameter instead of an `elem' which may be in dynamic scope at the time
+ ;; of execution of the `lambda'.
+ (lexical-let ((elem elem))
+ (rst-position-if (function (lambda (e)
+ (equal elem e)))
+ seq)))
+
+;; FIXME: Embed complicated `defconst's in `eval-when-compile'.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Versions
+
+;; testcover: ok.
+(defun rst-extract-version (delim-re head-re re tail-re var &optional default)
+ "Extract the version from a variable according to the given regexes.
+Return the version after regex DELIM-RE and HEAD-RE matching RE
+and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
+ (if (string-match
+ (concat delim-re head-re "\\(" re "\\)" tail-re delim-re)
+ var)
+ (match-string 1 var)
+ default))
+
+;; Use CVSHeader to really get information from CVS and not other version
+;; control systems.
+(defconst rst-cvs-header
+ "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.2 2012-09-23 14:44:25 stefan Exp $")
+(defconst rst-cvs-rev
+ (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+"
+ " .*" rst-cvs-header "0.0")
+ "The CVS revision of this file. CVS revision is the development revision.")
+(defconst rst-cvs-timestamp
+ (rst-extract-version "\\$" "CVSHeader: \\S + \\S + "
+ "[0-9]+-[0-9]+-[0-9]+ [0-9]+:[0-9]+:[0-9]+" " .*"
+ rst-cvs-header "1970-01-01 00:00:00")
+ "The CVS time stamp of this file.")
+
+;; Use LastChanged... to really get information from SVN.
+(defconst rst-svn-rev
+ (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " "
+ "$LastChangedRevision: 7515 $")
+ "The SVN revision of this file.
+SVN revision is the upstream (docutils) revision.")
+(defconst rst-svn-timestamp
+ (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " "
+ "$LastChangedDate: 2012-09-20 23:28:53 +0200 (Thu, 20 Sep 2012) $")
+ "The SVN time stamp of this file.")
+
+;; Maintained by the release process.
+(defconst rst-official-version
+ (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
+ "%OfficialVersion: 1.4.0 %")
+ "Official version of the package.")
+(defconst rst-official-cvs-rev
+ (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
+ "$Revision: 1.327.2.2 $")
+ "CVS revision of this file in the official version.")
+
+(defconst rst-version
+ (if (equal rst-official-cvs-rev rst-cvs-rev)
+ rst-official-version
+ (format "%s (development %s [%s])" rst-official-version
+ rst-cvs-rev rst-cvs-timestamp))
+ "The version string.
+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.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")
+ ("1.4.0" . "24.3")
+ ))
+
+(unless (assoc rst-official-version rst-package-emacs-version-alist)
+ (error "Version %s not listed in `rst-package-emacs-version-alist'"
+ rst-version))
+
+(add-to-list 'customize-package-emacs-version-alist
+ (cons 'ReST rst-package-emacs-version-alist))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Initialize customization
+
+\f
+(defgroup rst nil "Support for reStructuredText documents."
+ :group 'wp
+ :version "23.1"
+ :link '(url-link "http://docutils.sourceforge.net/rst.html"))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Facilities for regular expressions used everywhere
+
+;; The trailing numbers in the names give the number of referenceable regex
+;; groups contained in the regex.
+
+;; Used to be customizable but really is not customizable but fixed by the reST
+;; syntax.
+(defconst rst-bullets
+ ;; Sorted so they can form a character class when concatenated.
+ '(?- ?* ?+ ?\u2022 ?\u2023 ?\u2043)
+ "List of all possible bullet characters for bulleted lists.")
+
+(defconst rst-uri-schemes
+ '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https" "imap"
+ "ldap" "mailto" "mid" "modem" "news" "nfs" "nntp" "pop" "prospero" "rtsp"
+ "service" "sip" "tel" "telnet" "tip" "urn" "vemmi" "wais")
+ "Supported URI schemes.")
+
+(defconst rst-adornment-chars
+ ;; Sorted so they can form a character class when concatenated.
+ '(?\]
+ ?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?+ ?, ?. ?/ ?: ?\; ?< ?= ?> ?? ?@ ?\[ ?\\
+ ?^ ?_ ?` ?{ ?| ?} ?~
+ ?-)
+ "Characters which may be used in adornments for sections and transitions.")
+
+(defconst rst-max-inline-length
+ 1000
+ "Maximum length of inline markup to recognize.")
+
+(defconst rst-re-alist-def
+ ;; `*-beg' matches * at the beginning of a line.
+ ;; `*-end' matches * at the end of a line.
+ ;; `*-prt' matches a part of *.
+ ;; `*-tag' matches *.
+ ;; `*-sta' matches the start of * which may be followed by respective content.
+ ;; `*-pfx' matches the delimiter left of *.
+ ;; `*-sfx' matches the delimiter right of *.
+ ;; `*-hlp' helper for *.
+ ;;
+ ;; A trailing number says how many referenceable groups are contained.
+ `(
+
+ ;; Horizontal white space (`hws')
+ (hws-prt "[\t ]")
+ (hws-tag hws-prt "*") ; Optional sequence of horizontal white space.
+ (hws-sta hws-prt "+") ; Mandatory sequence of horizontal white space.
+
+ ;; Lines (`lin')
+ (lin-beg "^" hws-tag) ; Beginning of a possibly indented line.
+ (lin-end hws-tag "$") ; End of a line with optional trailing white space.
+ (linemp-tag "^" hws-tag "$") ; Empty line with optional white space.
+
+ ;; Various tags and parts
+ (ell-tag "\\.\\.\\.") ; Ellipsis
+ (bul-tag ,(concat "[" rst-bullets "]")) ; A bullet.
+ (ltr-tag "[a-zA-Z]") ; A letter enumerator tag.
+ (num-prt "[0-9]") ; A number enumerator part.
+ (num-tag num-prt "+") ; A number enumerator tag.
+ (rom-prt "[IVXLCDMivxlcdm]") ; A roman enumerator part.
+ (rom-tag rom-prt "+") ; A roman enumerator tag.
+ (aut-tag "#") ; An automatic enumerator tag.
+ (dcl-tag "::") ; Double colon.
+
+ ;; Block lead in (`bli')
+ (bli-sfx (:alt hws-sta "$")) ; Suffix of a block lead-in with *optional*
+ ; immediate content.
+
+ ;; Various starts
+ (bul-sta bul-tag bli-sfx) ; Start of a bulleted item.
+
+ ;; Explicit markup tag (`exm')
+ (exm-tag "\\.\\.")
+ (exm-sta exm-tag hws-sta)
+ (exm-beg lin-beg exm-sta)
+
+ ;; Counters in enumerations (`cnt')
+ (cntany-tag (:alt ltr-tag num-tag rom-tag aut-tag)) ; An arbitrary counter.
+ (cntexp-tag (:alt ltr-tag num-tag rom-tag)) ; An arbitrary explicit counter.
+
+ ;; Enumerator (`enm')
+ (enmany-tag (:alt
+ (:seq cntany-tag "\\.")
+ (:seq "(?" cntany-tag ")"))) ; An arbitrary enumerator.
+ (enmexp-tag (:alt
+ (:seq cntexp-tag "\\.")
+ (:seq "(?" cntexp-tag ")"))) ; An arbitrary explicit
+ ; enumerator.
+ (enmaut-tag (:alt
+ (:seq aut-tag "\\.")
+ (:seq "(?" aut-tag ")"))) ; An automatic enumerator.
+ (enmany-sta enmany-tag bli-sfx) ; An arbitrary enumerator start.
+ (enmexp-sta enmexp-tag bli-sfx) ; An arbitrary explicit enumerator start.
+ (enmexp-beg lin-beg enmexp-sta) ; An arbitrary explicit enumerator start
+ ; at the beginning of a line.
+
+ ;; Items may be enumerated or bulleted (`itm')
+ (itmany-tag (:alt enmany-tag bul-tag)) ; An arbitrary item tag.
+ (itmany-sta-1 (:grp itmany-tag) bli-sfx) ; An arbitrary item start, group
+ ; is the item tag.
+ (itmany-beg-1 lin-beg itmany-sta-1) ; An arbitrary item start at the
+ ; beginning of a line, group is the
+ ; item tag.
+
+ ;; Inline markup (`ilm')
+ (ilm-pfx (:alt "^" hws-prt "[-'\"([{<\u2018\u201c\u00ab\u2019/:]"))
+ (ilm-sfx (:alt "$" hws-prt "[]-'\")}>\u2019\u201d\u00bb/:.,;!?\\]"))
+
+ ;; Inline markup content (`ilc')
+ (ilcsgl-tag "\\S ") ; A single non-white character.
+ (ilcast-prt (:alt "[^*\\]" "\\\\.")) ; Part of non-asterisk content.
+ (ilcbkq-prt (:alt "[^`\\]" "\\\\.")) ; Part of non-backquote content.
+ (ilcbkqdef-prt (:alt "[^`\\\n]" "\\\\.")) ; Part of non-backquote
+ ; definition.
+ (ilcbar-prt (:alt "[^|\\]" "\\\\.")) ; Part of non-vertical-bar content.
+ (ilcbardef-prt (:alt "[^|\\\n]" "\\\\.")) ; Part of non-vertical-bar
+ ; definition.
+ (ilcast-sfx "[^\t *\\]") ; Suffix of non-asterisk content.
+ (ilcbkq-sfx "[^\t `\\]") ; Suffix of non-backquote content.
+ (ilcbar-sfx "[^\t |\\]") ; Suffix of non-vertical-bar content.
+ (ilcrep-hlp ,(format "\\{0,%d\\}" rst-max-inline-length)) ; Repeat count.
+ (ilcast-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcast-prt ilcrep-hlp
+ ilcast-sfx))) ; Non-asterisk content.
+ (ilcbkq-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcbkq-prt ilcrep-hlp
+ ilcbkq-sfx))) ; Non-backquote content.
+ (ilcbkqdef-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcbkqdef-prt ilcrep-hlp
+ ilcbkq-sfx))) ; Non-backquote definition.
+ (ilcbar-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcbar-prt ilcrep-hlp
+ ilcbar-sfx))) ; Non-vertical-bar content.
+ (ilcbardef-tag (:alt ilcsgl-tag
+ (:seq ilcsgl-tag
+ ilcbardef-prt ilcrep-hlp
+ ilcbar-sfx))) ; Non-vertical-bar definition.
+
+ ;; Fields (`fld')
+ (fldnam-prt (:alt "[^:\n]" "\\\\:")) ; Part of a field name.
+ (fldnam-tag fldnam-prt "+") ; A field name.
+ (fld-tag ":" fldnam-tag ":") ; A field marker.
+
+ ;; Options (`opt')
+ (optsta-tag (:alt "[-+/]" "--")) ; Start of an option.
+ (optnam-tag "\\sw" (:alt "-" "\\sw") "*") ; Name of an option.
+ (optarg-tag (:shy "[ =]\\S +")) ; Option argument.
+ (optsep-tag (:shy "," hws-prt)) ; Separator between options.
+ (opt-tag (:shy optsta-tag optnam-tag optarg-tag "?")) ; A complete option.
+
+ ;; Footnotes and citations (`fnc')
+ (fncnam-prt "[^\]\n]") ; Part of a footnote or citation name.
+ (fncnam-tag fncnam-prt "+") ; A footnote or citation name.
+ (fnc-tag "\\[" fncnam-tag "]") ; A complete footnote or citation tag.
+ (fncdef-tag-2 (:grp exm-sta)
+ (:grp fnc-tag)) ; A complete footnote or citation definition
+ ; tag. First group is the explicit markup
+ ; start, second group is the footnote /
+ ; citation tag.
+ (fnc-sta-2 fncdef-tag-2 bli-sfx) ; Start of a footnote or citation
+ ; definition. First group is the explicit
+ ; markup start, second group is the
+ ; footnote / citation tag.
+
+ ;; Substitutions (`sub')
+ (sub-tag "|" ilcbar-tag "|") ; A complete substitution tag.
+ (subdef-tag "|" ilcbardef-tag "|") ; A complete substitution definition
+ ; tag.
+
+ ;; Symbol (`sym')
+ (sym-prt "[-+.:_]") ; Non-word part of a symbol.
+ (sym-tag (:shy "\\sw+" (:shy sym-prt "\\sw+") "*"))
+
+ ;; URIs (`uri')
+ (uri-tag (:alt ,@rst-uri-schemes))
+
+ ;; Adornment (`ado')
+ (ado-prt "[" ,(concat rst-adornment-chars) "]")
+ (adorep3-hlp "\\{3,\\}") ; There must be at least 3 characters because
+ ; otherwise explicit markup start would be
+ ; recognized.
+ (adorep2-hlp "\\{2,\\}") ; As `adorep3-hlp' but when the first of three
+ ; characters is matched differently.
+ (ado-tag-1-1 (:grp ado-prt)
+ "\\1" adorep2-hlp) ; A complete adornment, group is the first
+ ; adornment character and MUST be the FIRST
+ ; group in the whole expression.
+ (ado-tag-1-2 (:grp ado-prt)
+ "\\2" adorep2-hlp) ; A complete adornment, group is the first
+ ; adornment character and MUST be the
+ ; SECOND group in the whole expression.
+ (ado-beg-2-1 "^" (:grp ado-tag-1-2)
+ lin-end) ; A complete adornment line; first group is the whole
+ ; adornment and MUST be the FIRST group in the whole
+ ; expression; second group is the first adornment
+ ; character.
+
+ ;; Titles (`ttl')
+ (ttl-tag "\\S *\\w\\S *") ; A title text.
+ (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line.
+
+ ;; Directives and substitution definitions (`dir')
+ (dir-tag-3 (:grp exm-sta)
+ (:grp (:shy subdef-tag hws-sta) "?")
+ (:grp sym-tag dcl-tag)) ; A directive or substitution definition
+ ; tag. First group is explicit markup
+ ; start, second group is a possibly
+ ; empty substitution tag, third group is
+ ; the directive tag including the double
+ ; colon.
+ (dir-sta-3 dir-tag-3 bli-sfx) ; Start of a directive or substitution
+ ; definition. Groups are as in dir-tag-3.
+
+ ;; Literal block (`lit')
+ (lit-sta-2 (:grp (:alt "[^.\n]" "\\.[^.\n]") ".*") "?"
+ (:grp dcl-tag) "$") ; Start of a literal block. First group is
+ ; any text before the double colon tag which
+ ; may not exist, second group is the double
+ ; colon tag.
+
+ ;; Comments (`cmt')
+ (cmt-sta-1 (:grp exm-sta) "[^\[|_\n]"
+ (:alt "[^:\n]" (:seq ":" (:alt "[^:\n]" "$")))
+ "*$") ; Start of a comment block; first group is explicit markup
+ ; start.
+
+ ;; Paragraphs (`par')
+ (par-tag- (:alt itmany-tag fld-tag opt-tag fncdef-tag-2 dir-tag-3 exm-tag)
+ ) ; Tag at the beginning of a paragraph; there may be groups in
+ ; certain cases.
+ )
+ "Definition alist of relevant regexes.
+Each entry consists of the symbol naming the regex and an
+argument list for `rst-re'.")
+
+(defvar rst-re-alist) ; Forward declare to use it in `rst-re'.
+
+;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel.
+(rst-testcover-add-compose 'rst-re)
+;; testcover: ok.
+(defun rst-re (&rest args)
+ "Interpret ARGS as regular expressions and return a regex string.
+Each element of ARGS may be one of the following:
+
+A string which is inserted unchanged.
+
+A character which is resolved to a quoted regex.
+
+A symbol which is resolved to a string using `rst-re-alist-def'.
+
+A list with a keyword in the car. Each element of the cdr of such
+a list is recursively interpreted as ARGS. The results of this
+interpretation are concatenated according to the keyword.
+
+For the keyword `:seq' the results are simply concatenated.
+
+For the keyword `:shy' the results are concatenated and
+surrounded by a shy-group (\"\\(?:...\\)\").
+
+For the keyword `:alt' the results form an alternative (\"\\|\")
+which is shy-grouped (\"\\(?:...\\)\").
+
+For the keyword `:grp' the results are concatenated and form a
+referenceable group (\"\\(...\\)\").
+
+After interpretation of ARGS the results are concatenated as for
+`:seq'."
+ (apply 'concat
+ (mapcar
+ (lambda (re)
+ (cond
+ ((stringp re)
+ re)
+ ((symbolp re)
+ (cadr (assoc re rst-re-alist)))
+ ((characterp re)
+ (regexp-quote (char-to-string re)))
+ ((listp re)
+ (let ((nested
+ (mapcar (lambda (elt)
+ (rst-re elt))
+ (cdr re))))
+ (cond
+ ((eq (car re) :seq)
+ (mapconcat 'identity nested ""))
+ ((eq (car re) :shy)
+ (concat "\\(?:" (mapconcat 'identity nested "") "\\)"))
+ ((eq (car re) :grp)
+ (concat "\\(" (mapconcat 'identity nested "") "\\)"))
+ ((eq (car re) :alt)
+ (concat "\\(?:" (mapconcat 'identity nested "\\|") "\\)"))
+ (t
+ (error "Unknown list car: %s" (car re))))))
+ (t
+ (error "Unknown object type for building regex: %s" re))))
+ args)))
+
+;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'.
+(with-no-warnings ; Silence byte-compiler about this construction.
+ (defconst rst-re-alist
+ ;; Shadow global value we are just defining so we can construct it step by
+ ;; step.
+ (let (rst-re-alist)
+ (dolist (re rst-re-alist-def rst-re-alist)
+ (setq rst-re-alist
+ (nconc rst-re-alist
+ (list (list (car re) (apply 'rst-re (cdr re))))))))
+ "Alist mapping symbols from `rst-re-alist-def' to regex strings."))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Mode definition.
+;; Mode definition
+
+;; testcover: ok.
+(defun rst-define-key (keymap key def &rest deprecated)
+ "Bind like `define-key' but add deprecated key definitions.
+KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key
+definitions should be in vector notation. These are defined as
+well but give an additional message."
+ (define-key keymap key def)
+ (dolist (dep-key deprecated)
+ (define-key keymap dep-key
+ `(lambda ()
+ ,(format "Deprecated binding for %s, use \\[%s] instead." def def)
+ (interactive)
+ (call-interactively ',def)
+ (message "[Deprecated use of key %s; use key %s instead]"
+ (key-description (this-command-keys))
+ (key-description ,key))))))
;; Key bindings.
(defvar rst-mode-map
(let ((map (make-sparse-keymap)))
+ ;; \C-c is the general keymap.
+ (rst-define-key map [?\C-c ?\C-h] 'describe-prefix-bindings)
+
;;
- ;; Section Decorations.
+ ;; Section Adornments
;;
- ;; The adjustment function that decorates or rotates a section title.
- (define-key map [(control c) (control a)] 'rst-adjust)
- (define-key map [(control c) (control ?=)] 'rst-adjust)
- (define-key map [(control ?=)] 'rst-adjust) ;; (Does not work on the Mac OSX.)
- ;; Display the hierarchy of decorations implied by the current document contents.
- (define-key map [(control c) (control h)] 'rst-display-decorations-hierarchy)
- ;; Homogenize the decorations in the document.
- (define-key map [(control c) (control s)] 'rst-straighten-decorations)
-;; (define-key map [(control c) (control s)] 'rst-straighten-deco-spacing)
+ ;; The adjustment function that adorns or rotates a section title.
+ (rst-define-key map [?\C-c ?\C-=] 'rst-adjust [?\C-c ?\C-a t])
+ (rst-define-key map [?\C-=] 'rst-adjust) ; Does not work on the Mac OSX and
+ ; on consoles.
+
+ ;; \C-c \C-a is the keymap for adornments.
+ (rst-define-key map [?\C-c ?\C-a ?\C-h] 'describe-prefix-bindings)
+ ;; Another binding which works with all types of input.
+ (rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust)
+ ;; Display the hierarchy of adornments implied by the current document
+ ;; contents.
+ (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-adornments-hierarchy)
+ ;; Homogenize the adornments in the document.
+ (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments
+ [?\C-c ?\C-s])
;;
- ;; Section Movement and Selection.
+ ;; Section Movement and Selection
;;
;; Mark the subsection where the cursor is.
- (define-key map [(control c) (control m)] 'rst-mark-section)
- ;; Move forward/backward between section titles.
- (define-key map [(control c) (control n)] 'rst-forward-section)
- (define-key map [(control c) (control p)] 'rst-backward-section)
+ (rst-define-key map [?\C-\M-h] 'rst-mark-section
+ ;; Same as mark-defun sgml-mark-current-element.
+ [?\C-c ?\C-m])
+ ;; Move backward/forward between section titles.
+ ;; FIXME: Also bind similar to outline mode.
+ (rst-define-key map [?\C-\M-a] 'rst-backward-section
+ ;; Same as beginning-of-defun.
+ [?\C-c ?\C-n])
+ (rst-define-key map [?\C-\M-e] 'rst-forward-section
+ ;; Same as end-of-defun.
+ [?\C-c ?\C-p])
+
+ ;;
+ ;; Operating on regions
+ ;;
+ ;; \C-c \C-r is the keymap for regions.
+ (rst-define-key map [?\C-c ?\C-r ?\C-h] 'describe-prefix-bindings)
+ ;; Makes region a line-block.
+ (rst-define-key map [?\C-c ?\C-r ?\C-l] 'rst-line-block-region
+ [?\C-c ?\C-d])
+ ;; Shift region left or right according to tabs.
+ (rst-define-key map [?\C-c ?\C-r tab] 'rst-shift-region
+ [?\C-c ?\C-r t] [?\C-c ?\C-l t])
;;
- ;; Operating on Blocks of Text.
+ ;; Operating on lists
;;
+ ;; \C-c \C-l is the keymap for lists.
+ (rst-define-key map [?\C-c ?\C-l ?\C-h] 'describe-prefix-bindings)
;; Makes paragraphs in region as a bullet list.
- (define-key map [(control c) (control b)] 'rst-bullet-list-region)
+ (rst-define-key map [?\C-c ?\C-l ?\C-b] 'rst-bullet-list-region
+ [?\C-c ?\C-b])
;; Makes paragraphs in region as a enumeration.
- (define-key map [(control c) (control e)] 'rst-enumerate-region)
+ (rst-define-key map [?\C-c ?\C-l ?\C-e] 'rst-enumerate-region
+ [?\C-c ?\C-e])
;; Converts bullets to an enumeration.
- (define-key map [(control c) (control v)] 'rst-convert-bullets-to-enumeration)
- ;; Makes region a line-block.
- (define-key map [(control c) (control d)] 'rst-line-block-region)
+ (rst-define-key map [?\C-c ?\C-l ?\C-c] 'rst-convert-bullets-to-enumeration
+ [?\C-c ?\C-v])
;; Make sure that all the bullets in the region are consistent.
- (define-key map [(control c) (control w)] 'rst-straighten-bullets-region)
- ;; Shift region left or right (taking into account of enumerations/bullets, etc.).
- (define-key map [(control c) (control l)] 'rst-shift-region-left)
- (define-key map [(control c) (control r)] 'rst-shift-region-right)
- ;; Comment/uncomment the active region.
- (define-key map [(control c) (control c)] 'comment-region)
+ (rst-define-key map [?\C-c ?\C-l ?\C-s] 'rst-straighten-bullets-region
+ [?\C-c ?\C-w])
+ ;; Insert a list item.
+ (rst-define-key map [?\C-c ?\C-l ?\C-i] 'rst-insert-list)
;;
- ;; Table-of-Contents Features.
+ ;; Table-of-Contents Features
;;
+ ;; \C-c \C-t is the keymap for table of contents.
+ (rst-define-key map [?\C-c ?\C-t ?\C-h] 'describe-prefix-bindings)
;; Enter a TOC buffer to view and move to a specific section.
- (define-key map [(control c) (control t)] 'rst-toc)
+ (rst-define-key map [?\C-c ?\C-t ?\C-t] 'rst-toc)
;; Insert a TOC here.
- (define-key map [(control c) (control i)] 'rst-toc-insert)
+ (rst-define-key map [?\C-c ?\C-t ?\C-i] 'rst-toc-insert
+ [?\C-c ?\C-i])
;; Update the document's TOC (without changing the cursor position).
- (define-key map [(control c) (control u)] 'rst-toc-update)
- ;; Got to the section under the cursor (cursor must be in TOC).
- (define-key map [(control c) (control f)] 'rst-goto-section)
+ (rst-define-key map [?\C-c ?\C-t ?\C-u] 'rst-toc-update
+ [?\C-c ?\C-u])
+ ;; Go to the section under the cursor (cursor must be in TOC).
+ (rst-define-key map [?\C-c ?\C-t ?\C-j] 'rst-goto-section
+ [?\C-c ?\C-f])
;;
- ;; Converting Documents from Emacs.
+ ;; Converting Documents from Emacs
;;
+ ;; \C-c \C-c is the keymap for compilation.
+ (rst-define-key map [?\C-c ?\C-c ?\C-h] 'describe-prefix-bindings)
;; Run one of two pre-configured toolset commands on the document.
- (define-key map [(control c) (?1)] 'rst-compile)
- (define-key map [(control c) (?2)] 'rst-compile-alt-toolset)
+ (rst-define-key map [?\C-c ?\C-c ?\C-c] 'rst-compile
+ [?\C-c ?1])
+ (rst-define-key map [?\C-c ?\C-c ?\C-a] 'rst-compile-alt-toolset
+ [?\C-c ?2])
;; Convert the active region to pseudo-xml using the docutils tools.
- (define-key map [(control c) (?3)] 'rst-compile-pseudo-region)
+ (rst-define-key map [?\C-c ?\C-c ?\C-x] 'rst-compile-pseudo-region
+ [?\C-c ?3])
;; Convert the current document to PDF and launch a viewer on the results.
- (define-key map [(control c) (?4)] 'rst-compile-pdf-preview)
+ (rst-define-key map [?\C-c ?\C-c ?\C-p] 'rst-compile-pdf-preview
+ [?\C-c ?4])
;; Convert the current document to S5 slides and view in a web browser.
- (define-key map [(control c) (?5)] 'rst-compile-slides-preview)
+ (rst-define-key map [?\C-c ?\C-c ?\C-s] 'rst-compile-slides-preview
+ [?\C-c ?5])
map)
"Keymap for reStructuredText mode commands.
;; Abbrevs.
-(defvar rst-mode-abbrev-table nil
- "Abbrev table used while in Rst mode.")
(define-abbrev-table 'rst-mode-abbrev-table
(mapcar (lambda (x) (append x '(nil 0 system)))
'(("contents" ".. contents::\n..\n ")
("skip" "\n\n[...]\n\n ")
("seq" "\n\n[...]\n\n ")
;; FIXME: Add footnotes, links, and more.
- )))
+ ))
+ "Abbrev table used while in `rst-mode'.")
;; Syntax table.
(defvar rst-mode-syntax-table
(let ((st (copy-syntax-table text-mode-syntax-table)))
-
(modify-syntax-entry ?$ "." st)
(modify-syntax-entry ?% "." st)
(modify-syntax-entry ?& "." st)
(modify-syntax-entry ?' "." st)
(modify-syntax-entry ?* "." st)
(modify-syntax-entry ?+ "." st)
- (modify-syntax-entry ?. "_" st)
+ (modify-syntax-entry ?- "." st)
(modify-syntax-entry ?/ "." st)
(modify-syntax-entry ?< "." st)
(modify-syntax-entry ?= "." st)
(modify-syntax-entry ?> "." st)
(modify-syntax-entry ?\\ "\\" st)
- (modify-syntax-entry ?| "." st)
(modify-syntax-entry ?_ "." st)
+ (modify-syntax-entry ?| "." st)
+ (modify-syntax-entry ?\u00ab "." st)
+ (modify-syntax-entry ?\u00bb "." st)
+ (modify-syntax-entry ?\u2018 "." st)
+ (modify-syntax-entry ?\u2019 "." st)
+ (modify-syntax-entry ?\u201c "." st)
+ (modify-syntax-entry ?\u201d "." st)
st)
"Syntax table used while in `rst-mode'.")
(defcustom rst-mode-hook nil
- "Hook run when Rst mode is turned on.
-The hook for Text mode is run before this one."
+ "Hook run when `rst-mode' is turned on.
+The hook for `text-mode' is run before this one."
:group 'rst
:type '(hook))
+(rst-testcover-defcustom)
-
-(defcustom rst-mode-lazy t
- "If non-nil Rst mode tries to font-lock multi-line elements correctly.
-Because this is really slow it should be set to nil if neither `jit-lock-mode'
-not `lazy-lock-mode' and activated.
-
-If nil, comments and literal blocks are font-locked only on the line they start.
-
-The value of this variable is used when Rst mode is turned on."
- :group 'rst
- :type '(boolean))
+;; Pull in variable definitions silencing byte-compiler.
+(require 'newcomment)
;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files
;; use *.txt, but this is too generic to be set as a default.
(define-derived-mode rst-mode text-mode "ReST"
"Major mode for editing reStructuredText documents.
\\<rst-mode-map>
-There are a number of convenient keybindings provided by
-Rst mode. The main one is \\[rst-adjust], it updates or rotates
-the section title around point or promotes/demotes the
-decorations within the region (see full details below).
-Use negative prefix arg to rotate in the other direction.
Turning on `rst-mode' calls the normal hooks `text-mode-hook'
and `rst-mode-hook'. This mode also supports font-lock
-highlighting. You may customize `rst-mode-lazy' to toggle
-font-locking of blocks.
+highlighting.
\\{rst-mode-map}"
:abbrev-table rst-mode-abbrev-table
:syntax-table rst-mode-syntax-table
:group 'rst
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'indent-line-function) 'indent-relative-maybe)
+ ;; Paragraph recognition.
+ (set (make-local-variable 'paragraph-separate)
+ (rst-re '(:alt
+ "\f"
+ lin-end)))
(set (make-local-variable 'paragraph-start)
- "\f\\|>*[ \t]*$\\|>*[ \t]*[-+*] \\|>*[ \t]*[0-9#]+\\. ")
- (set (make-local-variable 'adaptive-fill-mode) t)
+ (rst-re '(:alt
+ "\f"
+ lin-end
+ (:seq hws-tag par-tag- bli-sfx))))
- ;; FIXME: No need to reset this.
- ;; (set (make-local-variable 'indent-line-function) 'indent-relative)
+ ;; Indenting and filling.
+ (set (make-local-variable 'indent-line-function) 'rst-indent-line)
+ (set (make-local-variable 'adaptive-fill-mode) t)
+ (set (make-local-variable 'adaptive-fill-regexp)
+ (rst-re 'hws-tag 'par-tag- "?" 'hws-tag))
+ (set (make-local-variable 'adaptive-fill-function) 'rst-adaptive-fill)
+ (set (make-local-variable 'fill-paragraph-handle-comment) nil)
- ;; The details of the following comment setup is important because it affects
- ;; auto-fill, and it is pretty common in running text to have an ellipsis
- ;; ("...") which trips because of the rest comment syntax (".. ").
+ ;; Comments.
(set (make-local-variable 'comment-start) ".. ")
- (set (make-local-variable 'comment-start-skip) "^\\.\\. ")
- (set (make-local-variable 'comment-multi-line) nil)
-
- ;; Special variables
- (make-local-variable 'rst-adornment-level-alist)
-
- ;; Font lock
+ (set (make-local-variable 'comment-start-skip)
+ (rst-re 'lin-beg 'exm-tag 'bli-sfx))
+ (set (make-local-variable 'comment-continue) " ")
+ (set (make-local-variable 'comment-multi-line) t)
+ (set (make-local-variable 'comment-use-syntax) nil)
+ ;; reStructuredText has not really a comment ender but nil is not really a
+ ;; permissible value.
+ (set (make-local-variable 'comment-end) "")
+ (set (make-local-variable 'comment-end-skip) nil)
+
+ ;; Commenting in reStructuredText is very special so use our own set of
+ ;; functions.
+ (set (make-local-variable 'comment-line-break-function)
+ 'rst-comment-line-break)
+ (set (make-local-variable 'comment-indent-function)
+ 'rst-comment-indent)
+ (set (make-local-variable 'comment-insert-comment-function)
+ 'rst-comment-insert-comment)
+ (set (make-local-variable 'comment-region-function)
+ 'rst-comment-region)
+ (set (make-local-variable 'uncomment-region-function)
+ 'rst-uncomment-region)
+
+ ;; Imenu and which function.
+ ;; FIXME: Check documentation of `which-function' for alternative ways to
+ ;; determine the current function name.
+ (set (make-local-variable 'imenu-create-index-function)
+ 'rst-imenu-create-index)
+
+ ;; Font lock.
(set (make-local-variable 'font-lock-defaults)
- '(rst-font-lock-keywords-function
+ '(rst-font-lock-keywords
t nil nil nil
+ (font-lock-multiline . t)
(font-lock-mark-block-function . mark-paragraph)))
- ;; `jit-lock-mode' has been the default since Emacs-21.1, so there's no
- ;; point messing around with font-lock-support-mode any more.
- ;; (when (boundp 'font-lock-support-mode)
- ;; ;; rst-mode has its own mind about font-lock-support-mode
- ;; (make-local-variable 'font-lock-support-mode)
- ;; ;; jit-lock-mode replaced lazy-lock-mode in GNU Emacs 21.
- ;; (let ((jit-or-lazy-lock-mode
- ;; (cond
- ;; ((fboundp 'lazy-lock-mode) 'lazy-lock-mode)
- ;; ((fboundp 'jit-lock-mode) 'jit-lock-mode)
- ;; ;; if neither lazy-lock nor jit-lock is supported,
- ;; ;; tell user and disable rst-mode-lazy
- ;; (t (when rst-mode-lazy
- ;; (message "Disabled lazy fontification, because no known support mode found.")
- ;; (setq rst-mode-lazy nil))))))
- ;; (cond
- ;; ((and (not rst-mode-lazy) (not font-lock-support-mode)))
- ;; ;; No support mode set and none required - leave it alone
- ;; ((or (not font-lock-support-mode) ;; No support mode set (but required)
- ;; (symbolp font-lock-support-mode)) ;; or a fixed mode for all
- ;; (setq font-lock-support-mode
- ;; (list (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode))
- ;; (cons t font-lock-support-mode))))
- ;; ((and (listp font-lock-support-mode)
- ;; (not (assoc 'rst-mode font-lock-support-mode)))
- ;; ;; A list of modes missing rst-mode
- ;; (setq font-lock-support-mode
- ;; (cons (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode))
- ;; font-lock-support-mode))))))
-
- )
+ (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t)
+ ;; Text after a changed line may need new fontification.
+ (set (make-local-variable 'jit-lock-contextually) t))
;;;###autoload
(define-minor-mode rst-minor-mode
:group 'rst)
;; FIXME: can I somehow install these too?
-;; :abbrev-table rst-mode-abbrev-table
-;; :syntax-table rst-mode-syntax-table
-
-
-
-
-\f
-;; Bulleted item lists.
-(defcustom rst-bullets
- '(?- ?* ?+)
- "List of all possible bullet characters for bulleted lists."
- :group 'rst)
-
-
+;; :abbrev-table rst-mode-abbrev-table
+;; :syntax-table rst-mode-syntax-table
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Section Decoration Adjustment
-;; =============================
+;; Section Adornment Adjustment
+;; ============================
;;
;; The following functions implement a smart automatic title sectioning feature.
;; The idea is that with the cursor sitting on a section title, we try to get as
;; much information from context and try to do the best thing automatically.
;; This function can be invoked many times and/or with prefix argument to rotate
-;; between the various sectioning decorations.
+;; between the various sectioning adornments.
;;
;; Definitions: the two forms of sectioning define semantically separate section
-;; levels. A sectioning DECORATION consists in:
+;; levels. A sectioning ADORNMENT consists in:
;;
;; - a CHARACTER
;;
;; how many characters and over-and-under style is hanging outside of the
;; title at the beginning and ending.
;;
-;; Important note: an existing decoration must be formed by at least two
-;; characters to be recognized.
-;;
-;; Here are two examples of decorations (| represents the window border, column
+;; Here are two examples of adornments (| represents the window border, column
;; 0):
;;
;; |
;; - The underlining character that is used depends on context. The file is
;; scanned to find other sections and an appropriate character is selected.
;; If the function is invoked on a section that is complete, the character is
-;; rotated among the existing section decorations.
+;; rotated among the existing section adornments.
;;
;; Note that when rotating the characters, if we come to the end of the
-;; hierarchy of decorations, the variable rst-preferred-decorations is
-;; consulted to propose a new underline decoration, and if continued, we cycle
-;; the decorations all over again. Set this variable to nil if you want to
-;; limit the underlining character propositions to the existing decorations in
+;; hierarchy of adornments, the variable rst-preferred-adornments is
+;; consulted to propose a new underline adornment, and if continued, we cycle
+;; the adornments all over again. Set this variable to nil if you want to
+;; limit the underlining character propositions to the existing adornments in
;; the file.
;;
-;; - A prefix argument can be used to alternate the style.
-;;
;; - An underline/overline that is not extended to the column at which it should
;; be hanging is dubbed INCOMPLETE. For example::
;;
;;
;; In over-and-under style, when alternating the style, a variable is
;; available to select how much default indent to use (it can be zero). Note
-;; that if the current section decoration already has an indent, we don't
+;; that if the current section adornment already has an indent, we don't
;; adjust it to the default, we rather use the current indent that is already
;; there for adjustment (unless we cycle, in which case we use the indent
;; that has been found previously).
(defgroup rst-adjust nil
- "Settings for adjustment and cycling of section title decorations."
+ "Settings for adjustment and cycling of section title adornments."
:group 'rst
:version "21.1")
-(defcustom rst-preferred-decorations '( (?= over-and-under 1)
- (?= simple 0)
- (?- simple 0)
- (?~ simple 0)
- (?+ simple 0)
- (?` simple 0)
- (?# simple 0)
- (?@ simple 0) )
- "Preferred ordering of section title decorations.
-
-This sequence is consulted to offer a new decoration suggestion
+(define-obsolete-variable-alias
+ 'rst-preferred-decorations 'rst-preferred-adornments "1.0.0")
+(defcustom rst-preferred-adornments '((?= over-and-under 1)
+ (?= simple 0)
+ (?- simple 0)
+ (?~ simple 0)
+ (?+ simple 0)
+ (?` simple 0)
+ (?# simple 0)
+ (?@ simple 0))
+ "Preferred hierarchy of section title adornments.
+
+A list consisting of lists of the form (CHARACTER STYLE INDENT).
+CHARACTER is the character used. STYLE is one of the symbols
+OVER-AND-UNDER or SIMPLE. INDENT is an integer giving the wanted
+indentation for STYLE OVER-AND-UNDER. CHARACTER and STYLE are
+always used when a section adornment is described. In other
+places t instead of a list stands for a transition.
+
+This sequence is consulted to offer a new adornment suggestion
when we rotate the underlines at the end of the existing
hierarchy of characters, or when there is no existing section
-title in the file."
- :group 'rst-adjust)
-
+title in the file.
+
+Set this to an empty list to use only the adornment found in the
+file."
+ :group 'rst-adjust
+ :type `(repeat
+ (group :tag "Adornment specification"
+ (choice :tag "Adornment character"
+ ,@(mapcar (lambda (char)
+ (list 'const
+ :tag (char-to-string char) char))
+ rst-adornment-chars))
+ (radio :tag "Adornment type"
+ (const :tag "Overline and underline" over-and-under)
+ (const :tag "Underline only" simple))
+ (integer :tag "Indentation for overline and underline type"
+ :value 0))))
+(rst-testcover-defcustom)
(defcustom rst-default-indent 1
"Number of characters to indent the section title.
-This is used for when toggling decoration styles, when switching
-from a simple decoration style to a over-and-under decoration
+This is used for when toggling adornment styles, when switching
+from a simple adornment style to a over-and-under adornment
style."
- :group 'rst-adjust)
-
-
-(defvar rst-section-text-regexp "^[ \t]*\\S-*\\w\\S-*"
- "Regular expression for valid section title text.")
-
-
-(defun rst-line-homogeneous-p (&optional accept-special)
- "Return true if the line is homogeneous.
-
-Predicate that returns the unique char if the current line is
-composed only of a single repeated non-whitespace character.
-This returns the char even if there is whitespace at the
-beginning of the line.
-
-If ACCEPT-SPECIAL is specified we do not ignore special sequences
-which normally we would ignore when doing a search on many lines.
-For example, normally we have cases to ignore commonly occurring
-patterns, such as :: or ...; with the flag do not ignore them."
- (save-excursion
- (back-to-indentation)
- (unless (looking-at "\n")
- (let ((c (thing-at-point 'char)))
- (if (and (looking-at (format "[%s]+[ \t]*$" c))
- (or accept-special
- (and
- ;; Common patterns.
- (not (looking-at "::[ \t]*$"))
- (not (looking-at "\\.\\.\\.[ \t]*$"))
- ;; Discard one char line
- (not (looking-at ".[ \t]*$"))
- )))
- (string-to-char c))
- ))
- ))
-
-(defun rst-line-homogeneous-nodent-p (&optional accept-special)
- "Return true if the line is homogeneous with no indent.
-See `rst-line-homogeneous-p' about ACCEPT-SPECIAL."
- (save-excursion
- (beginning-of-line)
- (if (looking-at "^[ \t]+")
- nil
- (rst-line-homogeneous-p accept-special)
- )))
+ :group 'rst-adjust
+ :type '(integer))
+(rst-testcover-defcustom)
-
-(defun rst-compare-decorations (deco1 deco2)
- "Compare decorations.
-Return true if both DECO1 and DECO2 decorations are equal,
+(defun rst-compare-adornments (ado1 ado2)
+ "Compare adornments.
+Return true if both ADO1 and ADO2 adornments are equal,
according to restructured text semantics (only the character and
the style are compared, the indentation does not matter)."
- (and (eq (car deco1) (car deco2))
- (eq (cadr deco1) (cadr deco2))))
+ (and (eq (car ado1) (car ado2))
+ (eq (cadr ado1) (cadr ado2))))
-(defun rst-get-decoration-match (hier deco)
- "Return the index (level) in hierarchy HIER of decoration DECO.
+(defun rst-get-adornment-match (hier ado)
+ "Return the index (level) in hierarchy HIER of adornment ADO.
This basically just searches for the item using the appropriate
comparison and returns the index. Return nil if the item is
not found."
(let ((cur hier))
- (while (and cur (not (rst-compare-decorations (car cur) deco)))
+ (while (and cur (not (rst-compare-adornments (car cur) ado)))
(setq cur (cdr cur)))
cur))
+;; testcover: FIXME: Test with `rst-preferred-adornments' == nil. Add test
+;; `rst-adjust-no-preference'.
+(defun rst-suggest-new-adornment (allados &optional prev)
+ "Suggest a new, different adornment from all that have been seen.
-(defun rst-suggest-new-decoration (alldecos &optional prev)
- "Suggest a new, different decoration from all that have been seen.
-
-ALLDECOS is the set of all decorations, including the line numbers.
-PREV is the optional previous decoration, in order to suggest a
+ALLADOS is the set of all adornments, including the line numbers.
+PREV is the optional previous adornment, in order to suggest a
better match."
- ;; For all the preferred decorations...
+ ;; For all the preferred adornments...
(let* (
;; If 'prev' is given, reorder the list to start searching after the
;; match.
(fplist
- (cdr (rst-get-decoration-match rst-preferred-decorations prev)))
+ (cdr (rst-get-adornment-match rst-preferred-adornments prev)))
;; List of candidates to search.
- (curpotential (append fplist rst-preferred-decorations)))
+ (curpotential (append fplist rst-preferred-adornments)))
(while
- ;; For all the decorations...
- (let ((cur alldecos)
+ ;; For all the adornments...
+ (let ((cur allados)
found)
(while (and cur (not found))
- (if (rst-compare-decorations (car cur) (car curpotential))
+ (if (rst-compare-adornments (car cur) (car curpotential))
;; Found it!
(setq found (car curpotential))
(setq cur (cdr cur))))
(line-beginning-position 2)))
(defun rst-update-section (char style &optional indent)
- "Unconditionally update the style of a section decoration.
+ "Unconditionally update the style of a section adornment.
Do this using the given character CHAR, with STYLE 'simple
or 'over-and-under, and with indent INDENT. If the STYLE
is always assumed to be 0).
If there are existing overline and/or underline from the
-existing decoration, they are removed before adding the
-requested decoration."
-
- (interactive)
- (end-of-line)
+existing adornment, they are removed before adding the
+requested adornment."
+ (end-of-line)
(let ((marker (point-marker))
len)
- ;; Fixup whitespace at the beginning and end of the line
- (if (or (null indent) (eq style 'simple))
+ ;; Fixup whitespace at the beginning and end of the line.
+ (if (or (null indent) (eq style 'simple)) ;; testcover: ok.
(setq indent 0))
(beginning-of-line)
(delete-horizontal-space)
(end-of-line)
(delete-horizontal-space)
- ;; Set the current column, we're at the end of the title line
+ ;; Set the current column, we're at the end of the title line.
(setq len (+ (current-column) indent))
- ;; Remove previous line if it consists only of a single repeated character
+ ;; Remove previous line if it is an adornment.
(save-excursion
- (forward-line -1)
- (and (rst-line-homogeneous-p 1)
- ;; Avoid removing the underline of a title right above us.
- (save-excursion (forward-line -1)
- (not (looking-at rst-section-text-regexp)))
- (rst-delete-entire-line)))
-
- ;; Remove following line if it consists only of a single repeated
- ;; character
+ (forward-line -1) ;; testcover: FIXME: Doesn't work when in first line
+ ;; of buffer.
+ (if (and (looking-at (rst-re 'ado-beg-2-1))
+ ;; Avoid removing the underline of a title right above us.
+ (save-excursion (forward-line -1)
+ (not (looking-at (rst-re 'ttl-beg)))))
+ (rst-delete-entire-line)))
+
+ ;; Remove following line if it is an adornment.
(save-excursion
- (forward-line +1)
- (and (rst-line-homogeneous-p 1)
- (rst-delete-entire-line))
+ (forward-line +1) ;; testcover: FIXME: Doesn't work when in last line
+ ;; of buffer.
+ (if (looking-at (rst-re 'ado-beg-2-1))
+ (rst-delete-entire-line))
;; Add a newline if we're at the end of the buffer, for the subsequence
- ;; inserting of the underline
+ ;; inserting of the underline.
(if (= (point) (buffer-end 1))
(newline 1)))
- ;; Insert overline
+ ;; Insert overline.
(if (eq style 'over-and-under)
(save-excursion
(beginning-of-line)
(open-line 1)
(insert (make-string len char))))
- ;; Insert underline
- (forward-line +1)
+ ;; Insert underline.
+ (1value ;; Line has been inserted above.
+ (forward-line +1))
(open-line 1)
(insert (make-string len char))
- (forward-line +1)
- (goto-char marker)
- ))
-
-
-(defun rst-normalize-cursor-position ()
- "Normalize the cursor position.
-If the cursor is on a decoration line or an empty line , place it
-on the section title line (at the end). Returns the line offset
-by which the cursor was moved. This works both over or under a
-line."
- (if (save-excursion (beginning-of-line)
- (or (rst-line-homogeneous-p 1)
- (looking-at "^[ \t]*$")))
- (progn
- (beginning-of-line)
- (cond
- ((save-excursion (forward-line -1)
- (beginning-of-line)
- (and (looking-at rst-section-text-regexp)
- (not (rst-line-homogeneous-p 1))))
- (progn (forward-line -1) -1))
- ((save-excursion (forward-line +1)
- (beginning-of-line)
- (and (looking-at rst-section-text-regexp)
- (not (rst-line-homogeneous-p 1))))
- (progn (forward-line +1) +1))
- (t 0)))
- 0 ))
-
-
-(defun rst-find-all-decorations ()
- "Find all the decorations in the file.
-Return a list of (line, decoration) pairs. Each decoration
-consists in a (char, style, indent) triple.
-
-This function does not detect the hierarchy of decorations, it
-just finds all of them in a file. You can then invoke another
-function to remove redundancies and inconsistencies."
-
- (let ((positions ())
- (curline 1))
- ;; Iterate over all the section titles/decorations in the file.
- (save-excursion
- (goto-char (point-min))
- (while (< (point) (buffer-end 1))
- (if (rst-line-homogeneous-nodent-p)
- (progn
- (setq curline (+ curline (rst-normalize-cursor-position)))
-
- ;; Here we have found a potential site for a decoration,
- ;; characterize it.
- (let ((deco (rst-get-decoration)))
- (if (cadr deco) ;; Style is existing.
- ;; Found a real decoration site.
- (progn
- (push (cons curline deco) positions)
- ;; Push beyond the underline.
- (forward-line 1)
- (setq curline (+ curline 1))
- )))
- ))
- (forward-line 1)
- (setq curline (+ curline 1))
- ))
- (reverse positions)))
-
-
-(defun rst-infer-hierarchy (decorations)
- "Build a hierarchy of decorations using the list of given DECORATIONS.
-
-This function expects a list of (char, style, indent) decoration
+ (1value ;; Line has been inserted above.
+ (forward-line +1))
+ (goto-char marker)))
+
+(defun rst-classify-adornment (adornment end)
+ "Classify adornment for section titles and transitions.
+ADORNMENT is the complete adornment string as found in the buffer
+with optional trailing whitespace. END is the point after the
+last character of ADORNMENT.
+
+Return a list. The first entry is t for a transition or a
+cons (CHARACTER . STYLE). Check `rst-preferred-adornments' for
+the meaning of CHARACTER and STYLE.
+
+The remaining list forms four match groups as returned by
+`match-data'. Match group 0 matches the whole construct. Match
+group 1 matches the overline adornment if present. Match group 2
+matches the section title text or the transition. Match group 3
+matches the underline adornment.
+
+Return nil if no syntactically valid adornment is found."
+ (save-excursion
+ (save-match-data
+ (when (string-match (rst-re 'ado-beg-2-1) adornment)
+ (goto-char end)
+ (let* ((ado-ch (string-to-char (match-string 2 adornment)))
+ (ado-re (rst-re ado-ch 'adorep3-hlp))
+ (end-pnt (point))
+ (beg-pnt (progn
+ (1value ;; No lines may be left to move.
+ (forward-line 0))
+ (point)))
+ (nxt-emp ; Next line nonexistent or empty
+ (save-excursion
+ (or (not (zerop (forward-line 1)))
+ ;; testcover: FIXME: Add test classifying at the end of
+ ;; buffer.
+ (looking-at (rst-re 'lin-end)))))
+ (prv-emp ; Previous line nonexistent or empty
+ (save-excursion
+ (or (not (zerop (forward-line -1)))
+ (looking-at (rst-re 'lin-end)))))
+ (ttl-blw ; Title found below starting here.
+ (save-excursion
+ (and
+ (zerop (forward-line 1)) ;; testcover: FIXME: Add test
+ ;; classifying at the end of
+ ;; buffer.
+ (looking-at (rst-re 'ttl-beg))
+ (point))))
+ (ttl-abv ; Title found above starting here.
+ (save-excursion
+ (and
+ (zerop (forward-line -1))
+ (looking-at (rst-re 'ttl-beg))
+ (point))))
+ (und-fnd ; Matching underline found starting here.
+ (save-excursion
+ (and ttl-blw
+ (zerop (forward-line 2)) ;; testcover: FIXME: Add test
+ ;; classifying at the end of
+ ;; buffer.
+ (looking-at (rst-re ado-re 'lin-end))
+ (point))))
+ (ovr-fnd ; Matching overline found starting here.
+ (save-excursion
+ (and ttl-abv
+ (zerop (forward-line -2))
+ (looking-at (rst-re ado-re 'lin-end))
+ (point))))
+ key beg-ovr end-ovr beg-txt end-txt beg-und end-und)
+ (cond
+ ((and nxt-emp prv-emp)
+ ;; A transition.
+ (setq key t
+ beg-txt beg-pnt
+ end-txt end-pnt))
+ ((or und-fnd ovr-fnd)
+ ;; An overline with an underline.
+ (setq key (cons ado-ch 'over-and-under))
+ (let (;; Prefer overline match over underline match.
+ (und-pnt (if ovr-fnd beg-pnt und-fnd))
+ (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt))
+ (txt-pnt (if ovr-fnd ttl-abv ttl-blw)))
+ (goto-char ovr-pnt)
+ (setq beg-ovr (point)
+ end-ovr (line-end-position))
+ (goto-char txt-pnt)
+ (setq beg-txt (point)
+ end-txt (line-end-position))
+ (goto-char und-pnt)
+ (setq beg-und (point)
+ end-und (line-end-position))))
+ (ttl-abv
+ ;; An underline.
+ (setq key (cons ado-ch 'simple)
+ beg-und beg-pnt
+ end-und end-pnt)
+ (goto-char ttl-abv)
+ (setq beg-txt (point)
+ end-txt (line-end-position)))
+ (t
+ ;; Invalid adornment.
+ (setq key nil)))
+ (if key
+ (list key
+ (or beg-ovr beg-txt)
+ (or end-und end-txt)
+ beg-ovr end-ovr beg-txt end-txt beg-und end-und)))))))
+
+(defun rst-find-title-line ()
+ "Find a section title line around point and return its characteristics.
+If the point is on an adornment line find the respective title
+line. If the point is on an empty line check previous or next
+line whether it is a suitable title line and use it if so. If
+point is on a suitable title line use it.
+
+If no title line is found return nil.
+
+Otherwise return as `rst-classify-adornment' does. However, if
+the title line has no syntactically valid adornment STYLE is nil
+in the first element. If there is no adornment around the title
+CHARACTER is also nil and match groups for overline and underline
+are nil."
+ (save-excursion
+ (1value ;; No lines may be left to move.
+ (forward-line 0))
+ (let ((orig-pnt (point))
+ (orig-end (line-end-position)))
+ (cond
+ ((looking-at (rst-re 'ado-beg-2-1))
+ (let ((char (string-to-char (match-string-no-properties 2)))
+ (r (rst-classify-adornment (match-string-no-properties 0)
+ (match-end 0))))
+ (cond
+ ((not r)
+ ;; Invalid adornment - check whether this is an incomplete overline.
+ (if (and
+ (zerop (forward-line 1))
+ (looking-at (rst-re 'ttl-beg)))
+ (list (cons char nil) orig-pnt (line-end-position)
+ orig-pnt orig-end (point) (line-end-position) nil nil)))
+ ((consp (car r))
+ ;; A section title - not a transition.
+ r))))
+ ((looking-at (rst-re 'lin-end))
+ (or
+ (save-excursion
+ (if (and (zerop (forward-line -1))
+ (looking-at (rst-re 'ttl-beg)))
+ (list (cons nil nil) (point) (line-end-position)
+ nil nil (point) (line-end-position) nil nil)))
+ (save-excursion
+ (if (and (zerop (forward-line 1))
+ (looking-at (rst-re 'ttl-beg)))
+ (list (cons nil nil) (point) (line-end-position)
+ nil nil (point) (line-end-position) nil nil)))))
+ ((looking-at (rst-re 'ttl-beg))
+ ;; Try to use the underline.
+ (let ((r (rst-classify-adornment
+ (buffer-substring-no-properties
+ (line-beginning-position 2) (line-end-position 2))
+ (line-end-position 2))))
+ (if r
+ r
+ ;; No valid adornment found.
+ (list (cons nil nil) (point) (line-end-position)
+ nil nil (point) (line-end-position) nil nil))))))))
+
+;; The following function and variables are used to maintain information about
+;; current section adornment in a buffer local cache. Thus they can be used for
+;; font-locking and manipulation commands.
+
+(defvar rst-all-sections nil
+ "All section adornments in the buffer as found by `rst-find-all-adornments'.
+t when no section adornments were found.")
+(make-variable-buffer-local 'rst-all-sections)
+
+;; FIXME: If this variable is set to a different value font-locking of section
+;; headers is wrong.
+(defvar rst-section-hierarchy nil
+ "Section hierarchy in the buffer as determined by `rst-get-hierarchy'.
+t when no section adornments were found. Value depends on
+`rst-all-sections'.")
+(make-variable-buffer-local 'rst-section-hierarchy)
+
+(rst-testcover-add-1value 'rst-reset-section-caches)
+(defun rst-reset-section-caches ()
+ "Reset all section cache variables.
+Should be called by interactive functions which deal with sections."
+ (setq rst-all-sections nil
+ rst-section-hierarchy nil))
+
+(defun rst-find-all-adornments ()
+ "Return all the section adornments in the current buffer.
+Return a list of (LINE . ADORNMENT) with ascending LINE where
+LINE is the line containing the section title. ADORNMENT consists
+of a (CHARACTER STYLE INDENT) triple as described for
+`rst-preferred-adornments'.
+
+Uses and sets `rst-all-sections'."
+ (unless rst-all-sections
+ (let (positions)
+ ;; Iterate over all the section titles/adornments in the file.
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward (rst-re 'ado-beg-2-1) nil t)
+ (let ((ado-data (rst-classify-adornment
+ (match-string-no-properties 0) (point))))
+ (when (and ado-data
+ (consp (car ado-data))) ; Ignore transitions.
+ (set-match-data (cdr ado-data))
+ (goto-char (match-beginning 2)) ; Goto the title start.
+ (push (cons (1+ (count-lines (point-min) (point)))
+ (list (caar ado-data)
+ (cdar ado-data)
+ (current-indentation)))
+ positions)
+ (goto-char (match-end 0))))) ; Go beyond the whole thing.
+ (setq positions (nreverse positions))
+ (setq rst-all-sections (or positions t)))))
+ (if (eq rst-all-sections t)
+ nil
+ rst-all-sections))
+
+(defun rst-infer-hierarchy (adornments)
+ "Build a hierarchy of adornments using the list of given ADORNMENTS.
+
+ADORNMENTS is a list of (CHARACTER STYLE INDENT) adornment
specifications, in order that they appear in a file, and will
-infer a hierarchy of section levels by removing decorations that
-have already been seen in a forward traversal of the decorations,
-comparing just the character and style.
+infer a hierarchy of section levels by removing adornments that
+have already been seen in a forward traversal of the adornments,
+comparing just CHARACTER and STYLE.
-Similarly returns a list of (char, style, indent), where each
+Similarly returns a list of (CHARACTER STYLE INDENT), where each
list element should be unique."
-
- (let ((hierarchy-alist (list)))
- (dolist (x decorations)
+ (let (hierarchy-alist)
+ (dolist (x adornments)
(let ((char (car x))
(style (cadr x)))
(unless (assoc (cons char style) hierarchy-alist)
- (push (cons (cons char style) x) hierarchy-alist))
- ))
+ (push (cons (cons char style) x) hierarchy-alist))))
+ (mapcar 'cdr (nreverse hierarchy-alist))))
- (mapcar 'cdr (nreverse hierarchy-alist))
- ))
-
-
-(defun rst-get-hierarchy (&optional alldecos ignore)
+(defun rst-get-hierarchy (&optional ignore)
"Return the hierarchy of section titles in the file.
-Return a list of decorations that represents the hierarchy of
-section titles in the file. Reuse the list of decorations
-already computed in ALLDECOS if present. If the line number in
-IGNORE is specified, the decoration found on that line (if there
-is one) is not taken into account when building the hierarchy."
- (let ((all (or alldecos (rst-find-all-decorations))))
- (setq all (assq-delete-all ignore all))
- (rst-infer-hierarchy (mapcar 'cdr all))))
-
-
-(defun rst-get-decoration (&optional point)
- "Get the decoration at POINT.
-
-Looks around point and finds the characteristics of the
-decoration that is found there. Assumes that the cursor is
-already placed on the title line (and not on the overline or
-underline).
-
-This function returns a (char, style, indent) triple. If the
-characters of overline and underline are different, return
-the underline character. The indent is always calculated.
-A decoration can be said to exist if the style is not nil.
-
-A point can be specified to go to the given location before
-extracting the decoration."
-
- (let (char style)
- (save-excursion
- (if point (goto-char point))
- (beginning-of-line)
- (if (looking-at rst-section-text-regexp)
- (let* ((over (save-excursion
- (forward-line -1)
- (rst-line-homogeneous-nodent-p)))
-
- (under (save-excursion
- (forward-line +1)
- (rst-line-homogeneous-nodent-p)))
- )
-
- ;; Check that the line above the overline is not part of a title
- ;; above it.
- (if (and over
- (save-excursion
- (and (equal (forward-line -2) 0)
- (looking-at rst-section-text-regexp))))
- (setq over nil))
-
- (cond
- ;; No decoration found, leave all return values nil.
- ((and (eq over nil) (eq under nil)))
-
- ;; Overline only, leave all return values nil.
- ;;
- ;; Note: we don't return the overline character, but it could
- ;; perhaps in some cases be used to do something.
- ((and over (eq under nil)))
-
- ;; Underline only.
- ((and under (eq over nil))
- (setq char under
- style 'simple))
-
- ;; Both overline and underline.
- (t
- (setq char under
- style 'over-and-under)))))
- ;; Return values.
- (list char style
- ;; Find indentation.
- (save-excursion (back-to-indentation) (current-column))))))
-
-
-(defun rst-get-decorations-around (&optional alldecos)
- "Return the decorations around point.
-
-Given the list of all decorations ALLDECOS (with positions),
-find the decorations before and after the given point.
-A list of the previous and next decorations is returned."
- (let* ((all (or alldecos (rst-find-all-decorations)))
+Return a list of adornments that represents the hierarchy of
+section titles in the file. Each element consists of (CHARACTER
+STYLE INDENT) as described for `rst-find-all-adornments'. If the
+line number in IGNORE is specified, a possibly adornment found on
+that line is not taken into account when building the hierarchy.
+
+Uses and sets `rst-section-hierarchy' unless IGNORE is given."
+ (if (and (not ignore) rst-section-hierarchy)
+ (if (eq rst-section-hierarchy t)
+ nil
+ rst-section-hierarchy)
+ (let ((r (rst-infer-hierarchy
+ (mapcar 'cdr
+ (assq-delete-all
+ ignore
+ (rst-find-all-adornments))))))
+ (setq rst-section-hierarchy
+ (if ignore
+ ;; Clear cache reflecting that a possible update is not
+ ;; reflected.
+ nil
+ (or r t)))
+ r)))
+
+(defun rst-get-adornments-around ()
+ "Return the adornments around point.
+Return a list of the previous and next adornments."
+ (let* ((all (rst-find-all-adornments))
(curline (line-number-at-pos))
prev next
(cur all))
- ;; Search for the decorations around the current line.
+ ;; Search for the adornments around the current line.
(while (and cur (< (caar cur) curline))
(setq prev cur
cur (cdr cur)))
- ;; 'cur' is the following decoration.
+ ;; 'cur' is the following adornment.
(if (and cur (caar cur))
(setq next (if (= curline (caar cur)) (cdr cur) cur)))
- (mapcar 'cdar (list prev next))
- ))
-
+ (mapcar 'cdar (list prev next))))
-(defun rst-decoration-complete-p (deco)
- "Return true if the decoration DECO around point is complete."
+(defun rst-adornment-complete-p (ado)
+ "Return true if the adornment ADO around point is complete."
;; Note: we assume that the detection of the overline as being the underline
;; of a preceding title has already been detected, and has been eliminated
- ;; from the decoration that is given to us.
+ ;; from the adornment that is given to us.
;; There is some sectioning already present, so check if the current
;; sectioning is complete and correct.
- (let* ((char (car deco))
- (style (cadr deco))
- (indent (caddr deco))
- (endcol (save-excursion (end-of-line) (current-column)))
- )
+ (let* ((char (car ado))
+ (style (cadr ado))
+ (indent (caddr ado))
+ (endcol (save-excursion (end-of-line) (current-column))))
(if char
- (let ((exps (concat "^"
- (regexp-quote (make-string (+ endcol indent) char))
- "$")))
+ (let ((exps (rst-re "^" char (format "\\{%d\\}" (+ endcol indent)) "$")))
(and
(save-excursion (forward-line +1)
(beginning-of-line)
(or (not (eq style 'over-and-under))
(save-excursion (forward-line -1)
(beginning-of-line)
- (looking-at exps))))
- ))
- ))
+ (looking-at exps))))))))
-(defun rst-get-next-decoration
- (curdeco hier &optional suggestion reverse-direction)
- "Get the next decoration for CURDECO, in given hierarchy HIER.
-If suggesting, suggest for new decoration SUGGESTION.
+(defun rst-get-next-adornment
+ (curado hier &optional suggestion reverse-direction)
+ "Get the next adornment for CURADO, in given hierarchy HIER.
+If suggesting, suggest for new adornment SUGGESTION.
REVERSE-DIRECTION is used to reverse the cycling order."
(let* (
- (char (car curdeco))
- (style (cadr curdeco))
+ (char (car curado))
+ (style (cadr curado))
- ;; Build a new list of decorations for the rotation.
- (rotdecos
+ ;; Build a new list of adornments for the rotation.
+ (rotados
(append hier
- ;; Suggest a new decoration.
+ ;; Suggest a new adornment.
(list suggestion
- ;; If nothing to suggest, use first decoration.
+ ;; If nothing to suggest, use first adornment.
(car hier)))) )
(or
- ;; Search for next decoration.
+ ;; Search for next adornment.
(cadr
- (let ((cur (if reverse-direction rotdecos
- (reverse rotdecos))))
+ (let ((cur (if reverse-direction rotados
+ (reverse rotados))))
(while (and cur
(not (and (eq char (caar cur))
(eq style (cadar cur)))))
(setq cur (cdr cur)))
cur))
- ;; If not found, take the first of all decorations.
- suggestion
- )))
+ ;; If not found, take the first of all adornments.
+ suggestion)))
-(defun rst-adjust ()
- "Auto-adjust the decoration around point.
+;; FIXME: A line "``/`` full" is not accepted as a section title.
+(defun rst-adjust (pfxarg)
+ "Auto-adjust the adornment around point.
-Adjust/rotate the section decoration for the section title
-around point or promote/demote the decorations inside the region,
+Adjust/rotate the section adornment for the section title around
+point or promote/demote the adornments inside the region,
depending on if the region is active. This function is meant to
be invoked possibly multiple times, and can vary its behavior
-with a positive prefix argument (toggle style), or with a
-negative prefix argument (alternate behavior).
+with a positive PFXARG (toggle style), or with a negative
+PFXARG (alternate behavior).
-This function is the main focus of this module and is a bit of a
-swiss knife. It is meant as the single most essential function
-to be bound to invoke to adjust the decorations of a section
-title in restructuredtext. It tries to deal with all the
-possible cases gracefully and to do `the right thing' in all
-cases.
+This function is a bit of a swiss knife. It is meant to adjust
+the adornments of a section title in reStructuredText. It tries
+to deal with all the possible cases gracefully and to do `the
+right thing' in all cases.
-See the documentations of `rst-adjust-decoration' and
+See the documentations of `rst-adjust-adornment-work' and
`rst-promote-region' for full details.
Prefix Arguments
The method can take either (but not both) of
a. a (non-negative) prefix argument, which means to toggle the
- decoration style. Invoke with a prefix arg for example;
+ adornment style. Invoke with a prefix argument for example;
b. a negative numerical argument, which generally inverts the
direction of search in the file or hierarchy. Invoke with C--
prefix for example."
- (interactive)
+ (interactive "P")
(let* (;; Save our original position on the current line.
(origpt (point-marker))
- ;; Parse the positive and negative prefix arguments.
- (reverse-direction
- (and current-prefix-arg
- (< (prefix-numeric-value current-prefix-arg) 0)))
- (toggle-style
- (and current-prefix-arg (not reverse-direction))))
+ (reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0)))
+ (toggle-style (and pfxarg (not reverse-direction))))
- (if (rst-portable-mark-active-p)
- ;; Adjust decorations within region.
- (rst-promote-region current-prefix-arg)
- ;; Adjust decoration around point.
- (rst-adjust-decoration toggle-style reverse-direction))
+ (if (use-region-p)
+ ;; Adjust adornments within region.
+ (rst-promote-region (and pfxarg t))
+ ;; Adjust adornment around point.
+ (rst-adjust-adornment-work toggle-style reverse-direction))
;; Run the hooks to run after adjusting.
(run-hooks 'rst-adjust-hook)
;; Make sure to reset the cursor position properly after we're done.
- (goto-char origpt)
-
- ))
-
-(defvar rst-adjust-hook nil
- "Hooks to be run after running `rst-adjust'.")
+ (goto-char origpt)))
+
+(defcustom rst-adjust-hook nil
+ "Hooks to be run after running `rst-adjust'."
+ :group 'rst-adjust
+ :type '(hook)
+ :package-version '(rst . "1.1.0"))
+(rst-testcover-defcustom)
+
+(defcustom rst-new-adornment-down nil
+ "Controls level of new adornment for section headers."
+ :group 'rst-adjust
+ :type '(choice
+ (const :tag "Same level as previous one" nil)
+ (const :tag "One level down relative to the previous one" t))
+ :package-version '(rst . "1.1.0"))
+(rst-testcover-defcustom)
+
+(defun rst-adjust-adornment (pfxarg)
+ "Call `rst-adjust-adornment-work' interactively.
+
+Keep this for compatibility for older bindings (are there any?).
+Argument PFXARG has the same meaning as for `rst-adjust'."
+ (interactive "P")
-(defvar rst-new-decoration-down nil
- "Non-nil if new decoration is added deeper.
-If non-nil, a new decoration being added will be initialized to
-be one level down from the previous decoration. If nil, a new
-decoration will be equal to the level of the previous
-decoration.")
+ (let* ((reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0)))
+ (toggle-style (and pfxarg (not reverse-direction))))
+ (rst-adjust-adornment-work toggle-style reverse-direction)))
-(defun rst-adjust-decoration (&optional toggle-style reverse-direction)
-"Adjust/rotate the section decoration for the section title around point.
+(defun rst-adjust-adornment-work (toggle-style reverse-direction)
+"Adjust/rotate the section adornment for the section title around point.
This function is meant to be invoked possibly multiple times, and
can vary its behavior with a true TOGGLE-STYLE argument, or with
it is meant to be invoked possibly more than once to rotate among
the various possibilities. Basically, this function deals with:
-- adding a decoration if the title does not have one;
+- adding a adornment if the title does not have one;
- adjusting the length of the underline characters to fit a
modified title;
-- rotating the decoration in the set of already existing
- sectioning decorations used in the file;
+- rotating the adornment in the set of already existing
+ sectioning adornments used in the file;
- switching between simple and over-and-under styles.
would expect.
-Decoration Definitions
-======================
+Adornment Definitions
+=====================
-The decorations consist in
+The adornments consist in
1. a CHARACTER
complicated, but really, it does the most obvious thing in all
the particular cases):
-Before applying the decoration change, the cursor is placed on
+Before applying the adornment change, the cursor is placed on
the closest line that could contain a section title.
-Case 1: No Decoration
----------------------
+Case 1: No Adornment
+--------------------
-If the current line has no decoration around it,
+If the current line has no adornment around it,
-- search backwards for the last previous decoration, and apply
- the decoration one level lower to the current line. If there
- is no defined level below this previous decoration, we suggest
- the most appropriate of the `rst-preferred-decorations'.
+- search backwards for the last previous adornment, and apply
+ the adornment one level lower to the current line. If there
+ is no defined level below this previous adornment, we suggest
+ the most appropriate of the `rst-preferred-adornments'.
If REVERSE-DIRECTION is true, we simply use the previous
- decoration found directly.
+ adornment found directly.
-- if there is no decoration found in the given direction, we use
- the first of `rst-preferred-decorations'.
+- if there is no adornment found in the given direction, we use
+ the first of `rst-preferred-adornments'.
-The prefix argument forces a toggle of the prescribed decoration
-style.
+TOGGLE-STYLE forces a toggle of the prescribed adornment style.
-Case 2: Incomplete Decoration
------------------------------
+Case 2: Incomplete Adornment
+----------------------------
-If the current line does have an existing decoration, but the
-decoration is incomplete, that is, the underline/overline does
+If the current line does have an existing adornment, but the
+adornment is incomplete, that is, the underline/overline does
not extend to exactly the end of the title line (it is either too
short or too long), we simply extend the length of the
underlines/overlines to fit exactly the section title.
-If the prefix argument is given, we toggle the style of the
-decoration as well.
+If TOGGLE-STYLE we toggle the style of the adornment as well.
REVERSE-DIRECTION has no effect in this case.
-Case 3: Complete Existing Decoration
-------------------------------------
+Case 3: Complete Existing Adornment
+-----------------------------------
-If the decoration is complete (i.e. the underline (overline)
+If the adornment is complete (i.e. the underline (overline)
length is already adjusted to the end of the title line), we
search/parse the file to establish the hierarchy of all the
-decorations (making sure not to include the decoration around
-point), and we rotate the current title's decoration from within
+adornments (making sure not to include the adornment around
+point), and we rotate the current title's adornment from within
that list (by default, going *down* the hierarchy that is present
in the file, i.e. to a lower section level). This is meant to be
-used potentially multiple times, until the desired decoration is
+used potentially multiple times, until the desired adornment is
found around the title.
If we hit the boundary of the hierarchy, exactly one choice from
-the list of preferred decorations is suggested/chosen, the first
-of those decoration that has not been seen in the file yet (and
-not including the decoration around point), and the next
+the list of preferred adornments is suggested/chosen, the first
+of those adornment that has not been seen in the file yet (and
+not including the adornment around point), and the next
invocation rolls over to the other end of the hierarchy (i.e. it
cycles). This allows you to avoid having to set which character
to use.
If REVERSE-DIRECTION is true, the effect is to change the
-direction of rotation in the hierarchy of decorations, thus
+direction of rotation in the hierarchy of adornments, thus
instead going *up* the hierarchy.
-However, if there is a non-negative prefix argument, we do not
-rotate the decoration, but instead simply toggle the style of the
-current decoration (this should be the most common way to toggle
-the style of an existing complete decoration).
+However, if TOGGLE-STYLE, we do not rotate the adornment, but
+instead simply toggle the style of the current adornment (this
+should be the most common way to toggle the style of an existing
+complete adornment).
Point Location
My Title
--------
-are invalid in restructuredtext and thus not recognized by the
+are invalid in reStructuredText and thus not recognized by the
parser. This code will thus not work in a way that would support
indented sections (it would be ambiguous anyway).
Section titles that are right next to each other may not be
treated well. More work might be needed to support those, and
-special conditions on the completeness of existing decorations
+special conditions on the completeness of existing adornments
might be required to make it non-ambiguous.
-For now we assume that the decorations are disjoint, that is,
-there is at least a single line between the titles/decoration
-lines.
-
-
-Suggested Binding
-=================
-
-We suggest that you bind this function on C-=. It is close to
-C-- so a negative argument can be easily specified with a flick
-of the right hand fingers and the binding is unused in `text-mode'."
- (interactive)
-
- ;; If we were invoked directly, parse the prefix arguments into the
- ;; arguments of the function.
- (if current-prefix-arg
- (setq reverse-direction
- (and current-prefix-arg
- (< (prefix-numeric-value current-prefix-arg) 0))
-
- toggle-style
- (and current-prefix-arg (not reverse-direction))))
-
- (let* (;; Check if we're on an underline around a section title, and move the
- ;; cursor to the title if this is the case.
- (moved (rst-normalize-cursor-position))
-
- ;; Find the decoration and completeness around point.
- (curdeco (rst-get-decoration))
- (char (car curdeco))
- (style (cadr curdeco))
- (indent (caddr curdeco))
-
- ;; New values to be computed.
- char-new style-new indent-new
- )
-
- ;; We've moved the cursor... if we're not looking at some text, we have
- ;; nothing to do.
- (if (save-excursion (beginning-of-line)
- (looking-at rst-section-text-regexp))
- (progn
- (cond
- ;;-------------------------------------------------------------------
- ;; Case 1: No Decoration
- ((and (eq char nil) (eq style nil))
-
- (let* ((alldecos (rst-find-all-decorations))
-
- (around (rst-get-decorations-around alldecos))
- (prev (car around))
- cur
-
- (hier (rst-get-hierarchy alldecos))
- )
-
- ;; Advance one level down.
- (setq cur
- (if prev
- (if (not reverse-direction)
- (or (funcall (if rst-new-decoration-down 'cadr 'car)
- (rst-get-decoration-match hier prev))
- (rst-suggest-new-decoration hier prev))
- prev)
- (copy-sequence (car rst-preferred-decorations))))
-
- ;; Invert the style if requested.
- (if toggle-style
- (setcar (cdr cur) (if (eq (cadr cur) 'simple)
- 'over-and-under 'simple)) )
-
- (setq char-new (car cur)
- style-new (cadr cur)
- indent-new (caddr cur))
- ))
-
- ;;-------------------------------------------------------------------
- ;; Case 2: Incomplete Decoration
- ((not (rst-decoration-complete-p curdeco))
-
- ;; Invert the style if requested.
- (if toggle-style
- (setq style (if (eq style 'simple) 'over-and-under 'simple)))
-
- (setq char-new char
- style-new style
- indent-new indent))
-
- ;;-------------------------------------------------------------------
- ;; Case 3: Complete Existing Decoration
- (t
- (if toggle-style
-
- ;; Simply switch the style of the current decoration.
- (setq char-new char
- style-new (if (eq style 'simple) 'over-and-under 'simple)
- indent-new rst-default-indent)
-
- ;; Else, we rotate, ignoring the decoration around the current
- ;; line...
- (let* ((alldecos (rst-find-all-decorations))
-
- (hier (rst-get-hierarchy alldecos (line-number-at-pos)))
-
- ;; Suggestion, in case we need to come up with something
- ;; new
- (suggestion (rst-suggest-new-decoration
- hier
- (car (rst-get-decorations-around alldecos))))
-
- (nextdeco (rst-get-next-decoration
- curdeco hier suggestion reverse-direction))
-
- )
-
- ;; Indent, if present, always overrides the prescribed indent.
- (setq char-new (car nextdeco)
- style-new (cadr nextdeco)
- indent-new (caddr nextdeco))
-
- )))
- )
-
- ;; Override indent with present indent!
- (setq indent-new (if (> indent 0) indent indent-new))
-
- (if (and char-new style-new)
- (rst-update-section char-new style-new indent-new))
- ))
-
-
- ;; Correct the position of the cursor to more accurately reflect where it
- ;; was located when the function was invoked.
- (unless (= moved 0)
- (forward-line (- moved))
- (end-of-line))
-
- ))
+For now we assume that the adornments are disjoint, that is,
+there is at least a single line between the titles/adornment
+lines."
+ (rst-reset-section-caches)
+ (let ((ttl-fnd (rst-find-title-line))
+ (orig-pnt (point)))
+ (when ttl-fnd
+ (set-match-data (cdr ttl-fnd))
+ (goto-char (match-beginning 2))
+ (let* ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt)))
+ (char (caar ttl-fnd))
+ (style (cdar ttl-fnd))
+ (indent (current-indentation))
+ (curado (list char style indent))
+ char-new style-new indent-new)
+ (cond
+ ;;-------------------------------------------------------------------
+ ;; Case 1: No valid adornment
+ ((not style)
+ (let ((prev (car (rst-get-adornments-around)))
+ cur
+ (hier (rst-get-hierarchy)))
+ ;; Advance one level down.
+ (setq cur
+ (if prev
+ (if (or (and rst-new-adornment-down reverse-direction)
+ (and (not rst-new-adornment-down)
+ (not reverse-direction)))
+ prev
+ (or (cadr (rst-get-adornment-match hier prev))
+ (rst-suggest-new-adornment hier prev)))
+ (copy-sequence (car rst-preferred-adornments))))
+ ;; Invert the style if requested.
+ (if toggle-style
+ (setcar (cdr cur) (if (eq (cadr cur) 'simple)
+ 'over-and-under 'simple)) )
+ (setq char-new (car cur)
+ style-new (cadr cur)
+ indent-new (caddr cur))))
+ ;;-------------------------------------------------------------------
+ ;; Case 2: Incomplete Adornment
+ ((not (rst-adornment-complete-p curado))
+ ;; Invert the style if requested.
+ (if toggle-style
+ (setq style (if (eq style 'simple) 'over-and-under 'simple)))
+ (setq char-new char
+ style-new style
+ indent-new indent))
+ ;;-------------------------------------------------------------------
+ ;; Case 3: Complete Existing Adornment
+ (t
+ (if toggle-style
+ ;; Simply switch the style of the current adornment.
+ (setq char-new char
+ style-new (if (eq style 'simple) 'over-and-under 'simple)
+ indent-new rst-default-indent)
+ ;; Else, we rotate, ignoring the adornment around the current
+ ;; line...
+ (let* ((hier (rst-get-hierarchy (line-number-at-pos)))
+ ;; Suggestion, in case we need to come up with something new.
+ (suggestion (rst-suggest-new-adornment
+ hier
+ (car (rst-get-adornments-around))))
+ (nextado (rst-get-next-adornment
+ curado hier suggestion reverse-direction)))
+ ;; Indent, if present, always overrides the prescribed indent.
+ (setq char-new (car nextado)
+ style-new (cadr nextado)
+ indent-new (caddr nextado))))))
+ ;; Override indent with present indent!
+ (setq indent-new (if (> indent 0) indent indent-new))
+ (if (and char-new style-new)
+ (rst-update-section char-new style-new indent-new))
+ ;; Correct the position of the cursor to more accurately reflect where
+ ;; it was located when the function was invoked.
+ (unless (zerop moved)
+ (forward-line (- moved))
+ (end-of-line))))))
;; Maintain an alias for compatibility.
(defalias 'rst-adjust-section-title 'rst-adjust)
-(defun rst-promote-region (&optional demote)
+(defun rst-promote-region (demote)
"Promote the section titles within the region.
With argument DEMOTE or a prefix argument, demote the section
titles instead. The algorithm used at the boundaries of the
-hierarchy is similar to that used by `rst-adjust-decoration'."
- (interactive)
-
- (let* ((demote (or current-prefix-arg demote))
- (alldecos (rst-find-all-decorations))
- (cur alldecos)
-
- (hier (rst-get-hierarchy alldecos))
- (suggestion (rst-suggest-new-decoration hier))
+hierarchy is similar to that used by `rst-adjust-adornment-work'."
+ (interactive "P")
+ (rst-reset-section-caches)
+ (let* ((cur (rst-find-all-adornments))
+ (hier (rst-get-hierarchy))
+ (suggestion (rst-suggest-new-adornment hier))
(region-begin-line (line-number-at-pos (region-beginning)))
(region-end-line (line-number-at-pos (region-end)))
- marker-list
- )
+ marker-list)
- ;; Skip the markers that come before the region beginning
+ ;; Skip the markers that come before the region beginning.
(while (and cur (< (caar cur) region-begin-line))
(setq cur (cdr cur)))
- ;; Create a list of markers for all the decorations which are found within
+ ;; Create a list of markers for all the adornments which are found within
;; the region.
(save-excursion
(let (line)
;; Apply modifications.
(dolist (p marker-list)
- ;; Go to the decoration to promote.
- (goto-char (car p))
+ ;; Go to the adornment to promote.
+ (goto-char (car p))
- ;; Update the decoration.
- (apply 'rst-update-section
- ;; Rotate the next decoration.
- (rst-get-next-decoration
- (cadr p) hier suggestion demote))
+ ;; Update the adornment.
+ (apply 'rst-update-section
+ ;; Rotate the next adornment.
+ (rst-get-next-adornment
+ (cadr p) hier suggestion demote))
- ;; Clear marker to avoid slowing down the editing after we're done.
- (set-marker (car p) nil))
- (setq deactivate-mark nil)
- )))
+ ;; Clear marker to avoid slowing down the editing after we're done.
+ (set-marker (car p) nil))
+ (setq deactivate-mark nil))))
-(defun rst-display-decorations-hierarchy (&optional decorations)
- "Display the current file's section title decorations hierarchy.
-This function expects a list of (char, style, indent) triples in
-DECORATIONS."
+(defun rst-display-adornments-hierarchy (&optional adornments)
+ "Display the current file's section title adornments hierarchy.
+This function expects a list of (CHARACTER STYLE INDENT) triples
+in ADORNMENTS."
(interactive)
-
- (if (not decorations)
- (setq decorations (rst-get-hierarchy)))
+ (rst-reset-section-caches)
+ (if (not adornments)
+ (setq adornments (rst-get-hierarchy)))
(with-output-to-temp-buffer "*rest section hierarchy*"
(let ((level 1))
(with-current-buffer standard-output
- (dolist (x decorations)
+ (dolist (x adornments)
(insert (format "\nSection Level %d" level))
(apply 'rst-update-section x)
(goto-char (point-max))
(insert "\n")
- (incf level)
- ))
- )))
-
-(defun rst-position (elem list)
- "Return position of ELEM in LIST or nil."
- (let ((tail (member elem list)))
- (if tail (- (length list) (length tail)))))
-
-(defun rst-straighten-decorations ()
- "Redo all the decorations in the current buffer.
-This is done using our preferred set of decorations. This can be
+ (incf level))))))
+
+(defun rst-straighten-adornments ()
+ "Redo all the adornments in the current buffer.
+This is done using our preferred set of adornments. This can be
used, for example, when using somebody else's copy of a document,
in order to adapt it to our preferred style."
(interactive)
+ (rst-reset-section-caches)
(save-excursion
- (let* ((alldecos (rst-find-all-decorations))
- (hier (rst-get-hierarchy alldecos))
-
- ;; Get a list of pairs of (level . marker)
- (levels-and-markers (mapcar
- (lambda (deco)
- (cons (rst-position (cdr deco) hier)
- (progn
- (goto-char (point-min))
- (forward-line (1- (car deco)))
- (point-marker))))
- alldecos))
- )
+ (let (;; Get a list of pairs of (level . marker).
+ (levels-and-markers (mapcar
+ (lambda (ado)
+ (cons (rst-position (cdr ado)
+ (rst-get-hierarchy))
+ (progn
+ (goto-char (point-min))
+ (forward-line (1- (car ado)))
+ (point-marker))))
+ (rst-find-all-adornments))))
(dolist (lm levels-and-markers)
- ;; Go to the appropriate position
+ ;; Go to the appropriate position.
(goto-char (cdr lm))
- ;; Apply the new styule
- (apply 'rst-update-section (nth (car lm) rst-preferred-decorations))
-
- ;; Reset the market to avoid slowing down editing until it gets GC'ed
- (set-marker (cdr lm) nil)
- )
- )))
-
-
-
+ ;; Apply the new style.
+ (apply 'rst-update-section (nth (car lm) rst-preferred-adornments))
-(defun rst-straighten-deco-spacing ()
- "Adjust the spacing before and after decorations in the entire document.
-The spacing will be set to two blank lines before the first two
-section levels, and one blank line before any of the other
-section levels."
-;; FIXME: we need to take care of subtitle at some point.
- (interactive)
- (save-excursion
- (let* ((alldecos (rst-find-all-decorations)))
-
- ;; Work the list from the end, so that we don't have to use markers to
- ;; adjust for the changes in the document.
- (dolist (deco (nreverse alldecos))
- ;; Go to the appropriate position.
- (goto-char (point-min))
- (forward-line (1- (car deco)))
- (insert "@\n")
-;; FIXME: todo, we
- )
- )))
+ ;; Reset the marker to avoid slowing down editing until it gets GC'ed.
+ (set-marker (cdr lm) nil)))))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Insert list items
+;; =================
+
+
+;=================================================
+; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>.
+; I needed to make some tiny changes to the functions, so I put it here.
+; -- Wei-Wei Guo
+
+(defconst rst-arabic-to-roman
+ '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
+ (100 . "C") (90 . "XC") (50 . "L") (40 . "XL")
+ (10 . "X") (9 . "IX") (5 . "V") (4 . "IV")
+ (1 . "I"))
+ "List of maps between Arabic numbers and their Roman numeral equivalents.")
+
+(defun rst-arabic-to-roman (num &optional arg)
+ "Convert Arabic number NUM to its Roman numeral representation.
+
+Obviously, NUM must be greater than zero. Don't blame me, blame the
+Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with
+apologies to Monty Python).
+If optional prefix ARG is non-nil, insert in current buffer."
+ (let ((map rst-arabic-to-roman)
+ res)
+ (while (and map (> num 0))
+ (if (or (= num (caar map))
+ (> num (caar map)))
+ (setq res (concat res (cdar map))
+ num (- num (caar map)))
+ (setq map (cdr map))))
+ res))
+
+(defun rst-roman-to-arabic (string &optional arg)
+ "Convert STRING of Roman numerals to an Arabic number.
+
+If STRING contains a letter which isn't a valid Roman numeral, the rest
+of the string from that point onwards is ignored.
+
+Hence:
+MMD == 2500
+and
+MMDFLXXVI == 2500.
+If optional ARG is non-nil, insert in current buffer."
+ (let ((res 0)
+ (map rst-arabic-to-roman))
+ (while map
+ (if (string-match (concat "^" (cdar map)) string)
+ (setq res (+ res (caar map))
+ string (replace-match "" nil t string))
+ (setq map (cdr map))))
+ res))
+;=================================================
(defun rst-find-pfx-in-region (beg end pfx-re)
"Find all the positions of prefixes in region between BEG and END.
-This is used to find bullets and enumerated list items. PFX-RE
-is a regular expression for matching the lines with items."
+This is used to find bullets and enumerated list items. PFX-RE is
+a regular expression for matching the lines after indentation
+with items. Returns a list of cons cells consisting of the point
+and the column of the point."
(let ((pfx ()))
(save-excursion
(goto-char beg)
(while (< (point) end)
(back-to-indentation)
(when (and
- (looking-at pfx-re)
+ (looking-at pfx-re) ; pfx found and...
(let ((pfx-col (current-column)))
(save-excursion
- (forward-line -1)
+ (forward-line -1) ; ...previous line is...
(back-to-indentation)
- (or (looking-at "^[ \t]*$")
- (> (current-column) pfx-col)
+ (or (looking-at (rst-re 'lin-end)) ; ...empty,
+ (> (current-column) pfx-col) ; ...deeper level, or
(and (= (current-column) pfx-col)
- (looking-at pfx-re))))))
+ (looking-at pfx-re)))))) ; ...pfx at same level.
(push (cons (point) (current-column))
pfx))
- (forward-line 1)) )
+ (forward-line 1)))
(nreverse pfx)))
-(defvar rst-re-bullets
- (format "\\([%s][ \t]\\)[^ \t]" (regexp-quote (concat rst-bullets)))
- "Regexp for finding bullets.")
+(defun rst-insert-list-pos (newitem)
+ "Arrange relative position of a newly inserted list item of style NEWITEM.
+
+Adding a new list might consider three situations:
-;; (defvar rst-re-enumerations
-;; "\\(\\(#\\|[0-9]+\\)\\.[ \t]\\)[^ \t]"
-;; "Regexp for finding bullets.")
+ (a) Current line is a blank line.
+ (b) Previous line is a blank line.
+ (c) Following line is a blank line.
-(defvar rst-re-items
- (format "\\(%s\\|%s\\)[^ \t]"
- (format "[%s][ \t]" (regexp-quote (concat rst-bullets)))
- "\\(#\\|[0-9]+\\)\\.[ \t]")
- "Regexp for finding bullets.")
+When (a) and (b), just add the new list at current line.
-(defvar rst-preferred-bullets
- '(?- ?* ?+)
- "List of favorite bullets to set for straightening bullets.")
+when (a) and not (b), a blank line is added before adding the new list.
+
+When not (a), first forward point to the end of the line, and add two
+blank lines, then add the new list.
+
+Other situations are just ignored and left to users themselves."
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at (rst-re 'lin-end)))
+ (if (save-excursion
+ (forward-line -1)
+ (looking-at (rst-re 'lin-end)))
+ (insert newitem " ")
+ (insert "\n" newitem " "))
+ (end-of-line)
+ (insert "\n\n" newitem " ")))
+
+;; FIXME: Isn't this a `defconst'?
+(defvar rst-initial-enums
+ (let (vals)
+ (dolist (fmt '("%s." "(%s)" "%s)"))
+ (dolist (c '("1" "a" "A" "I" "i"))
+ (push (format fmt c) vals)))
+ (cons "#." (nreverse vals)))
+ "List of initial enumerations.")
+
+;; FIXME: Isn't this a `defconst'?
+(defvar rst-initial-items
+ (append (mapcar 'char-to-string rst-bullets) rst-initial-enums)
+ "List of initial items. It's collection of bullets and enumerations.")
+
+(defun rst-insert-list-new-item ()
+ "Insert a new list item.
+
+User is asked to select the item style first, for example (a), i), +. Use TAB
+for completion and choices.
+
+If user selects bullets or #, it's just added with position arranged by
+`rst-insert-list-pos'.
+
+If user selects enumerations, a further prompt is given. User need to input a
+starting item, for example 'e' for 'A)' style. The position is also arranged by
+`rst-insert-list-pos'."
+ (interactive)
+ ;; FIXME: Make this comply to `interactive' standards.
+ (let* ((itemstyle (completing-read
+ "Select preferred item style [#.]: "
+ rst-initial-items nil t nil nil "#."))
+ (cnt (if (string-match (rst-re 'cntexp-tag) itemstyle)
+ (match-string 0 itemstyle)))
+ (no
+ (save-match-data
+ ;; FIXME: Make this comply to `interactive' standards.
+ (cond
+ ((equal cnt "a")
+ (let ((itemno (read-string "Give starting value [a]: "
+ nil nil "a")))
+ (downcase (substring itemno 0 1))))
+ ((equal cnt "A")
+ (let ((itemno (read-string "Give starting value [A]: "
+ nil nil "A")))
+ (upcase (substring itemno 0 1))))
+ ((equal cnt "I")
+ (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (rst-arabic-to-roman itemno)))
+ ((equal cnt "i")
+ (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (downcase (rst-arabic-to-roman itemno))))
+ ((equal cnt "1")
+ (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (number-to-string itemno)))))))
+ (if no
+ (setq itemstyle (replace-match no t t itemstyle)))
+ (rst-insert-list-pos itemstyle)))
+
+(defcustom rst-preferred-bullets
+ '(?* ?- ?+)
+ "List of favorite bullets."
+ :group 'rst
+ :type `(repeat
+ (choice ,@(mapcar (lambda (char)
+ (list 'const
+ :tag (char-to-string char) char))
+ rst-bullets)))
+ :package-version '(rst . "1.1.0"))
+(rst-testcover-defcustom)
+
+(defun rst-insert-list-continue (curitem prefer-roman)
+ "Insert a list item with list start CURITEM including its indentation level.
+If PREFER-ROMAN roman numbering is preferred over using letters."
+ (end-of-line)
+ (insert
+ "\n" ; FIXME: Separating lines must be possible.
+ (cond
+ ((string-match (rst-re '(:alt enmaut-tag
+ bul-tag)) curitem)
+ curitem)
+ ((string-match (rst-re 'num-tag) curitem)
+ (replace-match (number-to-string
+ (1+ (string-to-number (match-string 0 curitem))))
+ nil nil curitem))
+ ((and (string-match (rst-re 'rom-tag) curitem)
+ (save-match-data
+ (if (string-match (rst-re 'ltr-tag) curitem) ; Also a letter tag.
+ (save-excursion
+ ;; FIXME: Assumes one line list items without separating
+ ;; empty lines.
+ (if (and (zerop (forward-line -1))
+ (looking-at (rst-re 'enmexp-beg)))
+ (string-match
+ (rst-re 'rom-tag)
+ (match-string 0)) ; Previous was a roman tag.
+ prefer-roman)) ; Don't know - use flag.
+ t))) ; Not a letter tag.
+ (replace-match
+ (let* ((old (match-string 0 curitem))
+ (new (save-match-data
+ (rst-arabic-to-roman
+ (1+ (rst-roman-to-arabic
+ (upcase old)))))))
+ (if (equal old (upcase old))
+ (upcase new)
+ (downcase new)))
+ t nil curitem))
+ ((string-match (rst-re 'ltr-tag) curitem)
+ (replace-match (char-to-string
+ (1+ (string-to-char (match-string 0 curitem))))
+ nil nil curitem)))))
+
+
+(defun rst-insert-list (&optional prefer-roman)
+ "Insert a list item at the current point.
+
+The command can insert a new list or a continuing list. When it is called at a
+non-list line, it will promote to insert new list. When it is called at a list
+line, it will insert a list with the same list style.
+
+1. When inserting a new list:
+
+User is asked to select the item style first, for example (a), i), +. Use TAB
+for completion and choices.
+
+ (a) If user selects bullets or #, it's just added.
+ (b) If user selects enumerations, a further prompt is given. User needs to
+ input a starting item, for example 'e' for 'A)' style.
+
+The position of the new list is arranged according to whether or not the
+current line and the previous line are blank lines.
+
+2. When continuing a list, one thing need to be noticed:
+
+List style alphabetical list, such as 'a.', and roman numerical list, such as
+'i.', have some overlapping items, for example 'v.' The function can deal with
+the problem elegantly in most situations. But when those overlapped list are
+preceded by a blank line, it is hard to determine which type to use
+automatically. The function uses alphabetical list by default. If you want
+roman numerical list, just use a prefix to set PREFER-ROMAN."
+ (interactive "P")
+ (beginning-of-line)
+ (if (looking-at (rst-re 'itmany-beg-1))
+ (rst-insert-list-continue (match-string 0) prefer-roman)
+ (rst-insert-list-new-item)))
(defun rst-straighten-bullets-region (beg end)
"Make all the bulleted list items in the region consistent.
`rst-preferred-bullets' list, they are not modified."
(interactive "r")
- (let ((bullets (rst-find-pfx-in-region beg end
- rst-re-bullets))
+ (let ((bullets (rst-find-pfx-in-region beg end (rst-re 'bul-sta)))
(levtable (make-hash-table :size 4)))
;; Create a map of levels to list of positions.
(insert (string (car bullets))))
(setq bullets (cdr bullets))))))))
-(defun rst-rstrip (str)
- "Strips the whitespace at the end of string STR."
- (string-match "[ \t\n]*\\'" str)
- (substring str 0 (match-beginning 0)))
-
-(defun rst-get-stripped-line ()
- "Return the line at cursor, stripped from whitespace."
- (re-search-forward "\\S-.*\\S-" (line-end-position))
- (buffer-substring-no-properties (match-beginning 0)
- (match-end 0)) )
-
-(defun rst-section-tree (alldecos)
- "Get the hierarchical tree of section titles.
-
-Returns a hierarchical tree of the sections titles in the
-document, for decorations ALLDECOS. This can be used to generate
-a table of contents for the document. The top node will always
-be a nil node, with the top level titles as children (there may
-potentially be more than one).
-
-Each section title consists in a cons of the stripped title
-string and a marker to the section in the original text document.
-
-If there are missing section levels, the section titles are
-inserted automatically, and the title string is set to nil, and
-the marker set to the first non-nil child of itself.
-Conceptually, the nil nodes--i.e. those which have no title--are
-to be considered as being the same line as their first non-nil
-child. This has advantages later in processing the graph."
-
- (let* ((hier (rst-get-hierarchy alldecos))
- (levels (make-hash-table :test 'equal :size 10))
- lines)
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Table of contents
+;; =================
+
+;; FIXME: Return value should be a `defstruct'.
+(defun rst-section-tree ()
+ "Return the hierarchical tree of section titles.
+A tree entry looks like ((TITLE MARKER) CHILD...). TITLE is the
+stripped text of the section title. MARKER is a marker for the
+beginning of the title text. For the top node or a missing
+section level node TITLE is nil and MARKER points to the title
+text of the first child. Each CHILD is another tree entry. The
+CHILD list may be empty."
+ (let ((hier (rst-get-hierarchy))
+ (ch-sty2level (make-hash-table :test 'equal :size 10))
+ lev-ttl-mrk-l)
(let ((lev 0))
- (dolist (deco hier)
+ (dolist (ado hier)
;; Compare just the character and indent in the hash table.
- (puthash (cons (car deco) (cadr deco)) lev levels)
+ (puthash (cons (car ado) (cadr ado)) lev ch-sty2level)
(incf lev)))
- ;; Create a list of lines that contains (text, level, marker) for each
- ;; decoration.
+ ;; Create a list that contains (LEVEL TITLE MARKER) for each adornment.
(save-excursion
- (setq lines
- (mapcar (lambda (deco)
+ (setq lev-ttl-mrk-l
+ (mapcar (lambda (ado)
(goto-char (point-min))
- (forward-line (1- (car deco)))
- (list (gethash (cons (cadr deco) (caddr deco)) levels)
- (rst-get-stripped-line)
- (progn
- (beginning-of-line 1)
- (point-marker))))
- alldecos)))
-
- (let ((lcontnr (cons nil lines)))
- (rst-section-tree-rec lcontnr -1))))
-
-
-(defun rst-section-tree-rec (decos lev)
- "Recursive guts of the section tree construction.
-DECOS is a cons cell whose cdr is the remaining list of
-decorations, and we change it as we consume them. LEV is
-the current level of that node. This function returns a
-pair of the subtree that was built. This treats the DECOS
-list destructively."
-
- (let ((ndeco (cadr decos))
- node
- children)
-
- ;; If the next decoration matches our level
- (when (and ndeco (= (car ndeco) lev))
- ;; Pop the next decoration and create the current node with it
- (setcdr decos (cddr decos))
- (setq node (cdr ndeco)) )
- ;; Else we let the node title/marker be unset.
-
- ;; Build the child nodes
- (while (and (cdr decos) (> (caadr decos) lev))
- (setq children
- (cons (rst-section-tree-rec decos (1+ lev))
- children)))
+ (1value ;; This should really succeed.
+ (forward-line (1- (car ado))))
+ (list (gethash (cons (cadr ado) (caddr ado)) ch-sty2level)
+ ;; Get title.
+ (save-excursion
+ (if (re-search-forward
+ (rst-re "\\S .*\\S ") (line-end-position) t)
+ (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0))
+ ""))
+ (point-marker)))
+ (rst-find-all-adornments))))
+ (cdr (rst-section-tree-rec lev-ttl-mrk-l -1))))
+
+;; FIXME: Return value should be a `defstruct'.
+(defun rst-section-tree-rec (remaining lev)
+ "Process the first entry of REMAINING expected to be on level LEV.
+REMAINING is the remaining list of adornments consisting
+of (LEVEL TITLE MARKER) entries.
+
+Return (UNPROCESSED (TITLE MARKER) CHILD...) for the first entry
+of REMAINING where TITLE is nil if the expected level is not
+matched. UNPROCESSED is the list of still unprocessed entries.
+Each CHILD is a child of this entry in the same format but
+without UNPROCESSED."
+ (let ((cur (car remaining))
+ (unprocessed remaining)
+ ttl-mrk children)
+ ;; If the current adornment matches expected level.
+ (when (and cur (= (car cur) lev))
+ ;; Consume the current entry and create the current node with it.
+ (setq unprocessed (cdr remaining))
+ (setq ttl-mrk (cdr cur)))
+
+ ;; Build the child nodes as long as they have deeper level.
+ (while (and unprocessed (> (caar unprocessed) lev))
+ (let ((rem-children (rst-section-tree-rec unprocessed (1+ lev))))
+ (setq children (cons (cdr rem-children) children))
+ (setq unprocessed (car rem-children))))
(setq children (reverse children))
- ;; If node is still unset, we use the marker of the first child.
- (when (eq node nil)
- (setq node (cons nil (cdaar children))))
-
- ;; Return this node with its children.
- (cons node children)
- ))
-
-
-(defun rst-section-tree-point (node &optional point)
- "Find tree node at point.
-Given a computed and valid section tree in NODE and a point
-POINT (default being the current point in the current buffer),
-find and return the node within the sectree where the cursor
-lives.
-
-Return values: a pair of (parent path, container subtree).
-The parent path is simply a list of the nodes above the
-container subtree node that we're returning."
-
- (let (path outtree)
-
- (let* ((curpoint (or point (point))))
-
- ;; Check if we are before the current node.
- (if (and (cadar node) (>= curpoint (cadar node)))
-
- ;; Iterate all the children, looking for one that might contain the
- ;; current section.
- (let ((curnode (cdr node))
- last)
-
- (while (and curnode (>= curpoint (cadaar curnode)))
- (setq last curnode
- curnode (cdr curnode)))
-
- (if last
- (let ((sub (rst-section-tree-point (car last) curpoint)))
- (setq path (car sub)
- outtree (cdr sub)))
- (setq outtree node))
-
- )))
- (cons (cons (car node) path) outtree)
- ))
-
+ (cons unprocessed
+ (cons (or ttl-mrk
+ ;; Node on this level missing - use nil as text and the
+ ;; marker of the first child.
+ (cons nil (cdaar children)))
+ children))))
+
+(defun rst-section-tree-point (tree &optional point)
+ "Return section containing POINT by returning the closest node in TREE.
+TREE is a section tree as returned by `rst-section-tree'
+consisting of (NODE CHILD...) entries. POINT defaults to the
+current point. A NODE must have the structure (IGNORED MARKER
+...).
+
+Return (PATH NODE CHILD...). NODE is the node where POINT is in
+if any. PATH is a list of nodes from the top of the tree down to
+and including NODE. List of CHILD are the children of NODE if
+any."
+ (setq point (or point (point)))
+ (let ((cur (car tree))
+ (children (cdr tree)))
+ ;; Point behind current node?
+ (if (and (cadr cur) (>= point (cadr cur)))
+ ;; Iterate all the children, looking for one that might contain the
+ ;; current section.
+ (let (found)
+ (while (and children (>= point (cadaar children)))
+ (setq found children
+ children (cdr children)))
+ (if found
+ ;; Found section containing point in children.
+ (let ((sub (rst-section-tree-point (car found) point)))
+ ;; Extend path with current node and return NODE CHILD... from
+ ;; sub.
+ (cons (cons cur (car sub)) (cdr sub)))
+ ;; Point in this section: Start a new path with current node and
+ ;; return current NODE CHILD...
+ (cons (list cur) tree)))
+ ;; Current node behind point: start a new path with current node and
+ ;; no NODE CHILD...
+ (list (list cur)))))
(defgroup rst-toc nil
"Settings for reStructuredText table of contents."
"Indentation for table-of-contents display.
Also used for formatting insertion, when numbering is disabled."
:group 'rst-toc)
+(rst-testcover-defcustom)
(defcustom rst-toc-insert-style 'fixed
"Insertion style for table-of-contents.
- aligned: numbering, titles aligned under each other
- listed: numbering, with dashes like list items (EXPERIMENTAL)"
:group 'rst-toc)
+(rst-testcover-defcustom)
(defcustom rst-toc-insert-number-separator " "
"Separator that goes between the TOC number and the title."
:group 'rst-toc)
+(rst-testcover-defcustom)
;; This is used to avoid having to change the user's mode.
(defvar rst-toc-insert-click-keymap
(defcustom rst-toc-insert-max-level nil
"If non-nil, maximum depth of the inserted TOC."
:group 'rst-toc)
-
+(rst-testcover-defcustom)
(defun rst-toc-insert (&optional pfxarg)
"Insert a simple text rendering of the table of contents.
to the specified level.
The TOC is inserted indented at the current column."
-
(interactive "P")
-
- (let* (;; Check maximum level override
+ (rst-reset-section-caches)
+ (let* (;; Check maximum level override.
(rst-toc-insert-max-level
(if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0))
(prefix-numeric-value pfxarg) rst-toc-insert-max-level))
;; Get the section tree for the current cursor point.
(sectree-pair
(rst-section-tree-point
- (rst-section-tree (rst-find-all-decorations))))
+ (rst-section-tree)))
;; Figure out initial indent.
(initial-indent (make-string (current-column) ? ))
(delete-region init-point (+ init-point (length initial-indent)))
;; Delete the last newline added.
- (delete-char -1)
- )))
+ (delete-char -1))))
(defun rst-toc-insert-node (node level indent pfx)
"Insert tree node NODE in table-of-contents.
;; is generated automatically.
(put-text-property b (point) 'mouse-face 'highlight)
(put-text-property b (point) 'rst-toc-target (cadar node))
- (put-text-property b (point) 'keymap rst-toc-insert-click-keymap)
-
- )
+ (put-text-property b (point) 'keymap rst-toc-insert-click-keymap))
(insert "\n")
;; Prepare indent for children.
((eq rst-toc-insert-style 'listed)
(concat (substring indent 0 -3)
- (concat (make-string (+ (length pfx) 2) ? ) " - ")))
- ))
- )
+ (concat (make-string (+ (length pfx) 2) ? ) " - "))))))
(if (or (eq rst-toc-insert-max-level nil)
(< level rst-toc-insert-max-level))
fmt)
(if do-child-numbering
(progn
- ;; Add a separating dot if there is already a prefix
- (if (> (length pfx) 0)
- (setq pfx (concat (rst-rstrip pfx) ".")))
+ ;; Add a separating dot if there is already a prefix.
+ (when (> (length pfx) 0)
+ (string-match (rst-re "[ \t\n]*\\'") pfx)
+ (setq pfx (concat (replace-match "" t t pfx) ".")))
;; Calculate the amount of space that the prefix will require
;; for the numbers.
(if (cdr node)
(setq fmt (format "%%-%dd"
(1+ (floor (log10 (length
- (cdr node))))))))
- ))
+ (cdr node))))))))))
(dolist (child (cdr node))
(rst-toc-insert-node child
indent
(if do-child-numbering
(concat pfx (format fmt count)) pfx))
- (incf count)))
+ (incf count))))))
- )))
-
-
-(defun rst-toc-insert-find-delete-contents ()
- "Find and delete an existing comment after the first contents directive.
-Delete that region. Return t if found and the cursor is left after the comment."
- (goto-char (point-min))
- ;; We look for the following and the following only (in other words, if your
- ;; syntax differs, this won't work. If you would like a more flexible thing,
- ;; contact the author, I just can't imagine that this requirement is
- ;; unreasonable for now).
- ;;
- ;; .. contents:: [...anything here...]
- ;; ..
- ;; XXXXXXXX
- ;; XXXXXXXX
- ;; [more lines]
- ;;
- (let ((beg
- (re-search-forward "^\\.\\. contents[ \t]*::\\(.*\\)\n\\.\\."
- nil t))
- last-real)
- (when beg
- ;; Look for the first line that starts at the first column.
- (forward-line 1)
- (beginning-of-line)
- (while (and
- (< (point) (point-max))
- (or (and (looking-at "[ \t]+[^ \t]") (setq last-real (point)) t)
- (looking-at "[ \t]*$")))
- (forward-line 1)
- )
- (if last-real
- (progn
- (goto-char last-real)
- (end-of-line)
- (delete-region beg (point)))
- (goto-char beg))
- t
- )))
(defun rst-toc-update ()
"Automatically find the contents section of a document and update.
Updates the inserted TOC if present. You can use this in your
file-write hook to always make it up-to-date automatically."
(interactive)
- (let ((p (point)))
- (save-excursion
- (when (rst-toc-insert-find-delete-contents)
- (insert "\n ")
- (rst-toc-insert)
- ))
- ;; Somehow save-excursion does not really work well.
- (goto-char p))
+ (save-excursion
+ ;; Find and delete an existing comment after the first contents directive.
+ ;; Delete that region.
+ (goto-char (point-min))
+ ;; We look for the following and the following only (in other words, if your
+ ;; syntax differs, this won't work.).
+ ;;
+ ;; .. contents:: [...anything here...]
+ ;; [:field: value]...
+ ;; ..
+ ;; XXXXXXXX
+ ;; XXXXXXXX
+ ;; [more lines]
+ (let ((beg (re-search-forward
+ (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n"
+ "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag) nil t))
+ last-real)
+ (when beg
+ ;; Look for the first line that starts at the first column.
+ (forward-line 1)
+ (while (and
+ (< (point) (point-max))
+ (or (if (looking-at
+ (rst-re 'hws-sta "\\S ")) ; indented content.
+ (setq last-real (point)))
+ (looking-at (rst-re 'lin-end)))) ; empty line.
+ (forward-line 1))
+ (if last-real
+ (progn
+ (goto-char last-real)
+ (end-of-line)
+ (delete-region beg (point)))
+ (goto-char beg))
+ (insert "\n ")
+ (rst-toc-insert))))
;; Note: always return nil, because this may be used as a hook.
- )
+ nil)
;; Note: we cannot bind the TOC update on file write because it messes with
;; undo. If we disable undo, since it adds and removes characters, the
;; ;; Disable undo for the write file hook.
;; (let ((buffer-undo-list t)) (rst-toc-update) ))
-(defalias 'rst-toc-insert-update 'rst-toc-update) ;; backwards compat.
+(defalias 'rst-toc-insert-update 'rst-toc-update) ; backwards compat.
;;------------------------------------------------------------------------------
;; Add link on lines.
(put-text-property b (point) 'rst-toc-target (cadar node))
- (insert "\n")
- ))
+ (insert "\n")))
(dolist (child (cdr node))
(rst-toc-node child (1+ level))))
(defvar rst-toc-buffer-name "*Table of Contents*"
"Name of the Table of Contents buffer.")
-(defvar rst-toc-return-buffer nil
- "Buffer to which to return when leaving the TOC.")
+(defvar rst-toc-return-wincfg nil
+ "Window configuration to which to return when leaving the TOC.")
(defun rst-toc ()
"Display a table-of-contents.
-Finds all the section titles and their decorations in the
+Finds all the section titles and their adornments in the
file, and displays a hierarchically-organized list of the
titles, which is essentially a table-of-contents of the
document.
The Emacs buffer can be navigated, and selecting a section
brings the cursor in that section."
(interactive)
- (let* ((curbuf (current-buffer))
-
- ;; Get the section tree
- (alldecos (rst-find-all-decorations))
- (sectree (rst-section-tree alldecos))
+ (rst-reset-section-caches)
+ (let* ((curbuf (list (current-window-configuration) (point-marker)))
+ (sectree (rst-section-tree))
(our-node (cdr (rst-section-tree-point sectree)))
line
;; Create a temporary buffer.
- (buf (get-buffer-create rst-toc-buffer-name))
- )
+ (buf (get-buffer-create rst-toc-buffer-name)))
(with-current-buffer buf
(let ((inhibit-read-only t))
;; Count the lines to our found node.
(let ((linefound (rst-toc-count-lines sectree our-node)))
- (setq line (if (cdr linefound) (car linefound) 0)))
- ))
+ (setq line (if (cdr linefound) (car linefound) 0)))))
(display-buffer buf)
(pop-to-buffer buf)
;; Save the buffer to return to.
- (set (make-local-variable 'rst-toc-return-buffer) curbuf)
+ (set (make-local-variable 'rst-toc-return-wincfg) curbuf)
;; Move the cursor near the right section in the TOC.
(goto-char (point-min))
- (forward-line (1- line))
- ))
+ (forward-line (1- line))))
(defun rst-toc-mode-find-section ()
(error "Buffer for this section was killed"))
pos))
+;; FIXME: Cursor before or behind the list must be handled properly; before the
+;; list should jump to the top and behind the list to the last normal
+;; paragraph.
(defun rst-goto-section (&optional kill)
- "Go to the section the current line describes."
+ "Go to the section the current line describes.
+If KILL a toc buffer is destroyed."
(interactive)
(let ((pos (rst-toc-mode-find-section)))
(when kill
+ ;; FIXME: This should rather go to `rst-toc-mode-goto-section'.
+ (set-window-configuration (car rst-toc-return-wincfg))
(kill-buffer (get-buffer rst-toc-buffer-name)))
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
EVENT is the input event."
(interactive "e")
(let ((pos
- (with-current-buffer (window-buffer (posn-window (event-end event)))
- (save-excursion
- (goto-char (posn-point (event-end event)))
+ (with-current-buffer (window-buffer (posn-window (event-end event)))
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
(rst-toc-mode-find-section)))))
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
(recenter 5)))
(defun rst-toc-mode-mouse-goto-kill (event)
- "Same as `rst-toc-mode-mouse-goto', but kill TOC buffer as well."
+ "Same as `rst-toc-mode-mouse-goto', but kill TOC buffer as well.
+EVENT is the input event."
(interactive "e")
(call-interactively 'rst-toc-mode-mouse-goto event)
(kill-buffer (get-buffer rst-toc-buffer-name)))
(defun rst-toc-quit-window ()
"Leave the current TOC buffer."
(interactive)
- (quit-window)
- (pop-to-buffer rst-toc-return-buffer))
+ (let ((retbuf rst-toc-return-wincfg))
+ (set-window-configuration (car retbuf))
+ (goto-char (cadr retbuf))))
(defvar rst-toc-mode-map
(let ((map (make-sparse-keymap)))
;; Note: use occur-mode (replace.el) as a good example to complete missing
;; features.
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Section movement commands.
-;;
+;; Section movement commands
+;; =========================
(defun rst-forward-section (&optional offset)
- "Skip to the next restructured text section title.
+ "Skip to the next reStructuredText section title.
OFFSET specifies how many titles to skip. Use a negative OFFSET to move
backwards in the file (default is to use 1)."
(interactive)
+ (rst-reset-section-caches)
(let* (;; Default value for offset.
(offset (or offset 1))
- ;; Get all the decorations in the file, with their line numbers.
- (alldecos (rst-find-all-decorations))
+ ;; Get all the adornments in the file, with their line numbers.
+ (allados (rst-find-all-adornments))
;; Get the current line.
(curline (line-number-at-pos))
- (cur alldecos)
- (idx 0)
- )
+ (cur allados)
+ (idx 0))
- ;; Find the index of the "next" decoration w.r.t. to the current line.
+ ;; Find the index of the "next" adornment w.r.t. to the current line.
(while (and cur (< (caar cur) curline))
(setq cur (cdr cur))
(incf idx))
- ;; 'cur' is the decoration on or following the current line.
+ ;; 'cur' is the adornment on or following the current line.
(if (and (> offset 0) cur (= (caar cur) curline))
(incf idx))
;; Find the final index.
(setq idx (+ idx (if (> offset 0) (- offset 1) offset)))
- (setq cur (nth idx alldecos))
+ (setq cur (nth idx allados))
;; If the index is positive, goto the line, otherwise go to the buffer
;; boundaries.
(progn
(goto-char (point-min))
(forward-line (1- (car cur))))
- (if (> offset 0) (goto-char (point-max)) (goto-char (point-min))))
- ))
+ (if (> offset 0) (goto-char (point-max)) (goto-char (point-min))))))
(defun rst-backward-section ()
"Like `rst-forward-section', except move back one title."
(interactive)
(rst-forward-section -1))
-(defun rst-mark-section (&optional arg allow-extend)
- "Select the section that point is currently in."
+;; FIXME: What is `allow-extend' for?
+(defun rst-mark-section (&optional count allow-extend)
+ "Select COUNT sections around point.
+Mark following sections for positive COUNT or preceding sections
+for negative COUNT."
;; Cloned from mark-paragraph.
(interactive "p\np")
- (unless arg (setq arg 1))
- (when (zerop arg)
+ (unless count (setq count 1))
+ (when (zerop count)
(error "Cannot mark zero sections"))
(cond ((and allow-extend
(or (and (eq last-command this-command) (mark t))
- (rst-portable-mark-active-p)))
+ (use-region-p)))
(set-mark
(save-excursion
(goto-char (mark))
- (rst-forward-section arg)
+ (rst-forward-section count)
(point))))
(t
- (rst-forward-section arg)
+ (rst-forward-section count)
(push-mark nil t t)
- (rst-forward-section (- arg)))))
-
-
-
-
+ (rst-forward-section (- count)))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to work on item lists (e.g. indent/dedent, enumerate), which are
;; always 2 or 3 characters apart horizontally with rest.
-;; (FIXME: there is currently a bug that makes the region go away when we do that.)
-(defvar rst-shift-fill-region nil
- "If non-nil, automatically re-fill the region that is being shifted.")
-
(defun rst-find-leftmost-column (beg end)
- "Find the leftmost column in the region."
- (let ((mincol 1000))
+ "Return the leftmost column in region BEG to END."
+ (let (mincol)
(save-excursion
(goto-char beg)
(while (< (point) end)
(back-to-indentation)
- (unless (looking-at "[ \t]*$")
- (setq mincol (min mincol (current-column))))
- (forward-line 1)
- ))
+ (unless (looking-at (rst-re 'lin-end))
+ (setq mincol (if mincol
+ (min mincol (current-column))
+ (current-column))))
+ (forward-line 1)))
mincol))
-
-;; What we really need to do is compute all the possible alignment possibilities
-;; and then select one.
-;;
-;; .. line-block::
-;;
-;; a) sdjsds
-;;
-;; - sdjsd jsjds
-;;
-;; sdsdsjdsj
-;;
-;; 11. sjdss jddjs
-;;
-;; * * * * * * *
-;;
-;; Move backwards, accumulate the beginning positions, and also the second
-;; positions, in case the line matches the bullet pattern, and then sort.
-
-(defun rst-compute-bullet-tabs (&optional pt)
- "Build the list of possible horizontal alignment points.
-Search backwards from point (or point PT if specified) to
-build the list of possible horizontal alignment points that
-includes the beginning and contents of a restructuredtext
-bulleted or enumerated list item. Return a sorted list
-of (COLUMN-NUMBER . LINE) pairs."
- (save-excursion
- (when pt (goto-char pt))
-
- ;; We work our way backwards and towards the left.
- (let ((leftcol 100000) ;; Current column.
- (tablist nil) ;; List of tab positions.
- )
-
- ;; Start by skipping the current line.
- (beginning-of-line 0)
-
- ;; Search backwards for each line.
- (while (and (> (point) (point-min))
- (> leftcol 0))
-
- ;; Skip empty lines.
- (unless (looking-at "^[ \t]*$")
- ;; Inspect the current non-empty line
- (back-to-indentation)
-
- ;; Skip lines that are beyond the current column (we want to move
- ;; towards the left).
- (let ((col (current-column)))
- (when (< col leftcol)
-
- ;; Add the beginning of the line as a tabbing point.
- (unless (memq col (mapcar 'car tablist))
- (push (cons col (point)) tablist))
-
- ;; Look at the line to figure out if it is a bulleted or enumerate
- ;; list item.
- (when (looking-at
- (concat
- "\\(?:"
- "\\(\\(?:[0-9a-zA-Z#]\\{1,3\\}[.):-]\\|[*+-]\\)[ \t]+\\)[^ \t\n]"
- "\\|"
- (format "\\(%s%s+[ \t]+\\)[^ \t\n]"
- (regexp-quote (thing-at-point 'char))
- (regexp-quote (thing-at-point 'char)))
- "\\)"
- ))
- ;; Add the column of the contained item.
- (let* ((matchlen (length (or (match-string 1) (match-string 2))))
- (newcol (+ col matchlen)))
- (unless (or (>= newcol leftcol)
- (memq (+ col matchlen) (mapcar 'car tablist)))
- (push (cons (+ col matchlen) (+ (point) matchlen))
- tablist)))
- )
-
- (setq leftcol col)
- )))
-
- ;; Move backwards one line.
- (beginning-of-line 0))
-
- (sort tablist (lambda (x y) (<= (car x) (car y))))
- )))
-
-(defun rst-debug-print-tabs (tablist)
- "Insert a line and place special characters at the tab points in TABLIST."
- (beginning-of-line)
- (insert (concat "\n" (make-string 1000 ? ) "\n"))
- (beginning-of-line 0)
- (dolist (col tablist)
- (beginning-of-line)
- (forward-char (car col))
- (delete-char 1)
- (insert "@")
- ))
-
-(defun rst-debug-mark-found (tablist)
- "Insert a line and place special characters at the tab points in TABLIST."
- (dolist (col tablist)
- (when (cdr col)
- (goto-char (cdr col))
- (insert "@"))))
-
-
-(defvar rst-shift-basic-offset 2
- "Basic horizontal shift distance when there is no preceding alignment tabs.")
-
-(defun rst-shift-region-guts (find-next-fun offset-fun)
- "(See `rst-shift-region-right' for a description)."
- (let* ((mbeg (copy-marker (region-beginning)))
- (mend (copy-marker (region-end)))
- (tabs (rst-compute-bullet-tabs mbeg))
- (leftmostcol (rst-find-leftmost-column (region-beginning) (region-end)))
- )
- ;; Add basic offset tabs at the end of the list. This is a better
- ;; implementation technique than hysteresis and a basic offset because it
- ;; insures that movement in both directions is consistently using the same
- ;; column positions. This makes it more predictable.
- (setq tabs
- (append tabs
- (mapcar (lambda (x) (cons x nil))
- (let ((maxcol 120)
- (max-lisp-eval-depth 2000))
- (flet ((addnum (x)
- (if (> x maxcol)
- nil
- (cons x (addnum
- (+ x rst-shift-basic-offset))))))
- (addnum (or (caar (last tabs)) 0))))
- )))
-
- ;; (For debugging.)
- ;;; (save-excursion (goto-char mbeg) (forward-char -1) (rst-debug-print-tabs tabs))))
- ;;; (print tabs)
- ;;; (save-excursion (rst-debug-mark-found tabs))
-
- ;; Apply the indent.
- (indent-rigidly
- mbeg mend
-
- ;; Find the next tab after the leftmost column.
- (let ((tab (funcall find-next-fun tabs leftmostcol)))
-
- (if tab
- (progn
- (when (cdar tab)
- (message "Aligned on '%s'"
- (save-excursion
- (goto-char (cdar tab))
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position))))
- )
- (- (caar tab) leftmostcol)) ;; Num chars.
-
- ;; Otherwise use the basic offset
- (funcall offset-fun rst-shift-basic-offset)
- )))
-
- ;; Optionally reindent.
- (when rst-shift-fill-region
- (fill-region mbeg mend))
- ))
-
-(defun rst-shift-region-right (pfxarg)
- "Indent region rigidly, by a few characters to the right.
-This function first computes all possible alignment columns by
-inspecting the lines preceding the region for bulleted or
-enumerated list items. If the leftmost column is beyond the
-preceding lines, the region is moved to the right by
-`rst-shift-basic-offset'. With a prefix argument, do not
-automatically fill the region."
- (interactive "P")
- (let ((rst-shift-fill-region
- (if (not pfxarg) rst-shift-fill-region)))
- (rst-shift-region-guts (lambda (tabs leftmostcol)
- (let ((cur tabs))
- (while (and cur (<= (caar cur) leftmostcol))
- (setq cur (cdr cur)))
- cur))
- 'identity
- )))
-
-(defun rst-shift-region-left (pfxarg)
- "Like `rst-shift-region-right', except we move to the left.
-Also, if invoked with a negative prefix arg, the entire
-indentation is removed, up to the leftmost character in the
-region, and automatic filling is disabled."
- (interactive "P")
- (let ((mbeg (copy-marker (region-beginning)))
- (mend (copy-marker (region-end)))
- (leftmostcol (rst-find-leftmost-column
- (region-beginning) (region-end)))
- (rst-shift-fill-region
- (if (not pfxarg) rst-shift-fill-region)))
-
- (when (> leftmostcol 0)
- (if (and pfxarg (< (prefix-numeric-value pfxarg) 0))
- (progn
- (indent-rigidly (region-beginning) (region-end) (- leftmostcol))
- (when rst-shift-fill-region
- (fill-region mbeg mend))
- )
- (rst-shift-region-guts (lambda (tabs leftmostcol)
- (let ((cur (reverse tabs)))
- (while (and cur (>= (caar cur) leftmostcol))
- (setq cur (cdr cur)))
- cur))
- '-
- ))
- )))
-
+;; FIXME: This definition is old and deprecated. We need to move to the newer
+;; version below.
(defmacro rst-iterate-leftmost-paragraphs
(beg end first-only body-consequent body-alternative)
- "FIXME This definition is old and deprecated / we need to move
-to the newer version below:
-
-Call FUN at the beginning of each line, with an argument that
+ ;; FIXME: The following comment is pretty useless.
+ "Call FUN at the beginning of each line, with an argument that
specifies whether we are at the first line of a paragraph that
starts at the leftmost column of the given region BEG and END.
Set FIRST-ONLY to true if you want to callback on the first line
(let ((leftcol (rst-find-leftmost-column ,beg ,end))
(endm (copy-marker ,end)))
- (do* (;; Iterate lines
+ (do* (;; Iterate lines.
(l (progn (goto-char ,beg) (back-to-indentation))
(progn (forward-line 1) (back-to-indentation)))
(current-column))
(valid (and (= curcol leftcol)
- (not (looking-at "[ \t]*$")))
+ (not (looking-at (rst-re 'lin-end))))
(and (= curcol leftcol)
- (not (looking-at "[ \t]*$"))))
- )
+ (not (looking-at (rst-re 'lin-end))))))
((>= (point) endm))
(if (if ,first-only
(and valid (not previous))
valid)
,body-consequent
- ,body-alternative)
-
- ))))
-
+ ,body-alternative)))))
+;; FIXME: This needs to be refactored. Probably this is simply a function
+;; applying BODY rather than a macro.
(defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body)
"Evaluate BODY for each line in region defined by BEG END.
LEFTMOST is set to true if the line is one of the leftmost of the
(let ((,leftmost (rst-find-leftmost-column ,beg ,end))
(endm (copy-marker ,end)))
- (do* (;; Iterate lines
+ (do* (;; Iterate lines.
(l (progn (goto-char ,beg) (back-to-indentation))
(progn (forward-line 1) (back-to-indentation)))
(empty-line-previous nil ,isempty)
- (,isempty (looking-at "[ \t]*$")
- (looking-at "[ \t]*$"))
+ (,isempty (looking-at (rst-re 'lin-end))
+ (looking-at (rst-re 'lin-end)))
(,parabegin (not ,isempty)
(and empty-line-previous
(,isleftmost (and (not ,isempty)
(= (current-column) ,leftmost))
(and (not ,isempty)
- (= (current-column) ,leftmost)))
- )
+ (= (current-column) ,leftmost))))
((>= (point) endm))
- (progn ,@body)
+ (progn ,@body))))))
- )))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Indentation
+;; FIXME: At the moment only block comments with leading empty comment line are
+;; supported. Comment lines with leading comment markup should be also
+;; supported. May be a customizable option could control which style to
+;; prefer.
+
+(defgroup rst-indent nil "Settings for indentation in reStructuredText.
+
+In reStructuredText indentation points are usually determined by
+preceding lines. Sometimes the syntax allows arbitrary
+indentation points such as where to start the first line
+following a directive. These indentation widths can be customized
+here."
+ :group 'rst
+ :package-version '(rst . "1.1.0"))
+
+(define-obsolete-variable-alias
+ 'rst-shift-basic-offset 'rst-indent-width "1.0.0")
+(defcustom rst-indent-width 2
+ "Indentation when there is no more indentation point given."
+ :group 'rst-indent
+ :type '(integer))
+(rst-testcover-defcustom)
+
+(defcustom rst-indent-field 3
+ "Indentation for first line after a field or 0 to always indent for content."
+ :group 'rst-indent
+ :type '(integer))
+(rst-testcover-defcustom)
+
+(defcustom rst-indent-literal-normal 3
+ "Default indentation for literal block after a markup on an own line."
+ :group 'rst-indent
+ :type '(integer))
+(rst-testcover-defcustom)
+
+(defcustom rst-indent-literal-minimized 2
+ "Default indentation for literal block after a minimized markup."
+ :group 'rst-indent
+ :type '(integer))
+(rst-testcover-defcustom)
+
+(defcustom rst-indent-comment 3
+ "Default indentation for first line of a comment."
+ :group 'rst-indent
+ :type '(integer))
+(rst-testcover-defcustom)
+
+;; FIXME: Must consider other tabs:
+;; * Line blocks
+;; * Definition lists
+;; * Option lists
+(defun rst-line-tabs ()
+ "Return tabs of the current line or nil for no tab.
+The list is sorted so the tab where writing continues most likely
+is the first one. Each tab is of the form (COLUMN . INNER).
+COLUMN is the column of the tab. INNER is non-nil if this is an
+inner tab. I.e. a tab which does come from the basic indentation
+and not from inner alignment points."
+ (save-excursion
+ (forward-line 0)
+ (save-match-data
+ (unless (looking-at (rst-re 'lin-end))
+ (back-to-indentation)
+ ;; Current indentation is always the least likely tab.
+ (let ((tabs (list (list (point) 0 nil)))) ; (POINT OFFSET INNER)
+ ;; Push inner tabs more likely to continue writing.
+ (cond
+ ;; Item.
+ ((looking-at (rst-re '(:grp itmany-tag hws-sta) '(:grp "\\S ") "?"))
+ (when (match-string 2)
+ (push (list (match-beginning 2) 0 t) tabs)))
+ ;; Field.
+ ((looking-at (rst-re '(:grp fld-tag) '(:grp hws-tag)
+ '(:grp "\\S ") "?"))
+ (unless (zerop rst-indent-field)
+ (push (list (match-beginning 1) rst-indent-field t) tabs))
+ (if (match-string 3)
+ (push (list (match-beginning 3) 0 t) tabs)
+ (if (zerop rst-indent-field)
+ (push (list (match-end 2)
+ (if (string= (match-string 2) "") 1 0)
+ t) tabs))))
+ ;; Directive.
+ ((looking-at (rst-re 'dir-sta-3 '(:grp "\\S ") "?"))
+ (push (list (match-end 1) 0 t) tabs)
+ (unless (string= (match-string 2) "")
+ (push (list (match-end 2) 0 t) tabs))
+ (when (match-string 4)
+ (push (list (match-beginning 4) 0 t) tabs)))
+ ;; Footnote or citation definition.
+ ((looking-at (rst-re 'fnc-sta-2 '(:grp "\\S ") "?"))
+ (push (list (match-end 1) 0 t) tabs)
+ (when (match-string 3)
+ (push (list (match-beginning 3) 0 t) tabs)))
+ ;; Comment.
+ ((looking-at (rst-re 'cmt-sta-1))
+ (push (list (point) rst-indent-comment t) tabs)))
+ ;; Start of literal block.
+ (when (looking-at (rst-re 'lit-sta-2))
+ (let ((tab0 (first tabs)))
+ (push (list (first tab0)
+ (+ (second tab0)
+ (if (match-string 1)
+ rst-indent-literal-minimized
+ rst-indent-literal-normal))
+ t) tabs)))
+ (mapcar (lambda (tab)
+ (goto-char (first tab))
+ (cons (+ (current-column) (second tab)) (third tab)))
+ tabs))))))
+
+(defun rst-compute-tabs (pt)
+ "Build the list of possible tabs for all lines above.
+Search backwards from point PT to build the list of possible
+tabs. Return a list of tabs sorted by likeliness to continue
+writing like `rst-line-tabs'. Nearer lines have generally a
+higher likeliness than farther lines. Return nil if no tab is found
+in the text above."
+ (save-excursion
+ (goto-char pt)
+ (let (leftmost ; Leftmost column found so far.
+ innermost ; Leftmost column for inner tab.
+ tablist)
+ (while (and (zerop (forward-line -1))
+ (or (not leftmost)
+ (> leftmost 0)))
+ (let* ((tabs (rst-line-tabs))
+ (leftcol (if tabs (apply 'min (mapcar 'car tabs)))))
+ (when tabs
+ ;; Consider only lines indented less or same if not INNERMOST.
+ (when (or (not leftmost)
+ (< leftcol leftmost)
+ (and (not innermost) (= leftcol leftmost)))
+ (dolist (tab tabs)
+ (let ((inner (cdr tab))
+ (newcol (car tab)))
+ (when (and
+ (or
+ (and (not inner)
+ (or (not leftmost)
+ (< newcol leftmost)))
+ (and inner
+ (or (not innermost)
+ (< newcol innermost))))
+ (not (memq newcol tablist)))
+ (push newcol tablist))))
+ (setq innermost (if (rst-some (mapcar 'cdr tabs)) ; Has inner.
+ leftcol
+ innermost))
+ (setq leftmost leftcol)))))
+ (nreverse tablist))))
+
+(defun rst-indent-line (&optional dflt)
+ "Indent current line to next best reStructuredText tab.
+The next best tab is taken from the tab list returned by
+`rst-compute-tabs' which is used in a cyclic manner. If the
+current indentation does not end on a tab use the first one. If
+the current indentation is on a tab use the next tab. This allows
+a repeated use of \\[indent-for-tab-command] to cycle through all
+possible tabs. If no indentation is possible return `noindent' or
+use DFLT. Return the indentation indented to. When point is in
+indentation it ends up at its end. Otherwise the point is kept
+relative to the content."
+ (let* ((pt (point-marker))
+ (cur (current-indentation))
+ (clm (current-column))
+ (tabs (rst-compute-tabs (point)))
+ (fnd (rst-position cur tabs))
+ ind)
+ (if (and (not tabs) (not dflt))
+ 'noindent
+ (if (not tabs)
+ (setq ind dflt)
+ (if (not fnd)
+ (setq fnd 0)
+ (setq fnd (1+ fnd))
+ (if (>= fnd (length tabs))
+ (setq fnd 0)))
+ (setq ind (nth fnd tabs)))
+ (indent-line-to ind)
+ (if (> clm cur)
+ (goto-char pt))
+ (set-marker pt nil)
+ ind)))
+
+(defun rst-shift-region (beg end cnt)
+ "Shift region BEG to END by CNT tabs.
+Shift by one tab to the right (CNT > 0) or left (CNT < 0) or
+remove all indentation (CNT = 0). A tab is taken from the text
+above. If no suitable tab is found `rst-indent-width' is used."
+ (interactive "r\np")
+ (let ((tabs (sort (rst-compute-tabs beg) (lambda (x y) (<= x y))))
+ (leftmostcol (rst-find-leftmost-column beg end)))
+ (when (or (> leftmostcol 0) (> cnt 0))
+ ;; Apply the indent.
+ (indent-rigidly
+ beg end
+ (if (zerop cnt)
+ (- leftmostcol)
+ ;; Find the next tab after the leftmost column.
+ (let* ((cmp (if (> cnt 0) '> '<))
+ (tabs (if (> cnt 0) tabs (reverse tabs)))
+ (len (length tabs))
+ (dir (rst-signum cnt)) ; Direction to take.
+ (abs (abs cnt)) ; Absolute number of steps to take.
+ ;; Get the position of the first tab beyond leftmostcol.
+ (fnd (lexical-let ((cmp cmp)
+ (leftmostcol leftmostcol)) ; Create closure.
+ (rst-position-if (lambda (elt)
+ (funcall cmp elt leftmostcol))
+ tabs)))
+ ;; Virtual position of tab.
+ (pos (+ (or fnd len) (1- abs)))
+ (tab (if (< pos len)
+ ;; Tab exists - use it.
+ (nth pos tabs)
+ ;; Column needs to be computed.
+ (let ((col (+ (or (car (last tabs)) leftmostcol)
+ ;; Base on last known column.
+ (* (- pos (1- len)) ; Distance left.
+ dir ; Direction to take.
+ rst-indent-width))))
+ (if (< col 0) 0 col)))))
+ (- tab leftmostcol)))))))
+
+;; FIXME: A paragraph with an (incorrectly) indented second line is not filled
+;; correctly::
+;;
+;; Some start
+;; continued wrong
+(defun rst-adaptive-fill ()
+ "Return fill prefix found at point.
+Value for `adaptive-fill-function'."
+ (let ((fnd (if (looking-at adaptive-fill-regexp)
+ (match-string-no-properties 0))))
+ (if (save-match-data
+ (not (string-match comment-start-skip fnd)))
+ ;; An non-comment prefix is fine.
+ fnd
+ ;; Matches a comment - return whitespace instead.
+ (make-string (-
+ (save-excursion
+ (goto-char (match-end 0))
+ (current-column))
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (current-column))) ? ))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Comments
+
+(defun rst-comment-line-break (&optional soft)
+ "Break line and indent, continuing reStructuredText comment if within one.
+Value for `comment-line-break-function'. If SOFT use soft
+newlines as mandated by `comment-line-break-function'."
+ (if soft
+ (insert-and-inherit ?\n)
+ (newline 1))
+ (save-excursion
+ (forward-char -1)
+ (delete-horizontal-space))
+ (delete-horizontal-space)
+ (let ((tabs (rst-compute-tabs (point))))
+ (when tabs
+ (indent-line-to (car tabs)))))
+
+(defun rst-comment-indent ()
+ "Return indentation for current comment line."
+ (car (rst-compute-tabs (point))))
+
+(defun rst-comment-insert-comment ()
+ "Insert a comment in the current line."
+ (rst-indent-line 0)
+ (insert comment-start))
+
+(defun rst-comment-region (beg end &optional arg)
+ "Comment or uncomment the current region.
+Region is from from BEG to END. Uncomment if ARG."
+ (save-excursion
+ (if (consp arg)
+ (rst-uncomment-region beg end arg)
+ (goto-char beg)
+ (let ((ind (current-indentation))
+ bol)
+ (forward-line 0)
+ (setq bol (point))
+ (indent-rigidly bol end rst-indent-comment)
+ (goto-char bol)
+ (open-line 1)
+ (indent-line-to ind)
+ (insert (comment-string-strip comment-start t t))))))
+
+(defun rst-uncomment-region (beg end &optional arg)
+ "Uncomment the current region.
+Region is from BEG to END. ARG is ignored"
+ (save-excursion
+ (let (bol eol)
+ (goto-char beg)
+ (forward-line 0)
+ (setq bol (point))
+ (forward-line 1)
+ (setq eol (point))
+ (indent-rigidly eol end (- rst-indent-comment))
+ (delete-region bol eol))))
;;------------------------------------------------------------------------------
-;; FIXME: these next functions should become part of a larger effort to redo the
-;; bullets in bulleted lists. The enumerate would just be one of the possible
-;; outputs.
+;; FIXME: These next functions should become part of a larger effort to redo
+;; the bullets in bulleted lists. The enumerate would just be one of
+;; the possible outputs.
;;
-;; FIXME: TODO we need to do the enumeration removal as well.
+;; FIXME: We need to do the enumeration removal as well.
-(defun rst-enumerate-region (beg end)
+(defun rst-enumerate-region (beg end all)
"Add enumeration to all the leftmost paragraphs in the given region.
-The region is specified between BEG and END. With prefix argument,
+The region is specified between BEG and END. With ALL,
do all lines instead of just paragraphs."
- (interactive "r")
+ (interactive "r\nP")
(let ((count 0)
(last-insert-len nil))
(rst-iterate-leftmost-paragraphs
- beg end (not current-prefix-arg)
+ beg end (not all)
(let ((ins-string (format "%d. " (incf count))))
(setq last-insert-len (length ins-string))
(insert ins-string))
- (insert (make-string last-insert-len ?\ ))
- )))
+ (insert (make-string last-insert-len ?\ )))))
-(defun rst-bullet-list-region (beg end)
+(defun rst-bullet-list-region (beg end all)
"Add bullets to all the leftmost paragraphs in the given region.
-The region is specified between BEG and END. With prefix argument,
+The region is specified between BEG and END. With ALL,
do all lines instead of just paragraphs."
- (interactive "r")
+ (interactive "r\nP")
(rst-iterate-leftmost-paragraphs
- beg end (not current-prefix-arg)
- (insert "- ")
- (insert " ")
- ))
-
-
-;; FIXME: there are some problems left with the following function
-;; implementation:
-;;
-;; * It does not deal with a varying number of digits appropriately
-;; * It does not deal with multiple levels independently, and it should.
-;;
-;; I suppose it does 90% of the job for now.
+ beg end (not all)
+ (insert (car rst-preferred-bullets) " ")
+ (insert " ")))
+;; FIXME: Does not deal with a varying number of digits appropriately.
+;; FIXME: Does not deal with multiple levels independently.
+;; FIXME: Does not indent a multiline item correctly.
(defun rst-convert-bullets-to-enumeration (beg end)
- "Convert all the bulleted items and enumerated items in the
-region to enumerated lists, renumbering as necessary."
+ "Convert the bulleted and enumerated items in the region to enumerated lists.
+Renumber as necessary. Region is from BEG to END."
(interactive "r")
(let* (;; Find items and convert the positions to markers.
(items (mapcar
(lambda (x)
(cons (copy-marker (car x))
(cdr x)))
- (rst-find-pfx-in-region beg end rst-re-items)))
- (count 1)
- )
+ (rst-find-pfx-in-region beg end (rst-re 'itmany-sta-1))))
+ (count 1))
(save-excursion
(dolist (x items)
(goto-char (car x))
- (looking-at rst-re-items)
- (replace-match (format "%d. " count) nil nil nil 1)
- (incf count)
- ))
- ))
-
-
+ (looking-at (rst-re 'itmany-beg-1))
+ (replace-match (format "%d." count) nil nil nil 1)
+ (incf count)))))
;;------------------------------------------------------------------------------
(defun rst-line-block-region (rbeg rend &optional pfxarg)
"Toggle line block prefixes for a region.
-With prefix argument set the empty lines too."
+Region is from RBEG to REND. With PFXARG set the empty lines too."
(interactive "r\nP")
(let ((comment-start "| ")
(comment-end "")
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Font lock
+;; =========
(require 'font-lock)
+;; FIXME: The obsolete variables need to disappear.
+
+;; The following versions have been done inside Emacs and should not be
+;; replaced by `:package-version' attributes until a change.
+
(defgroup rst-faces nil "Faces used in Rst Mode."
:group 'rst
:group 'faces
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-block-face
"customize the face `rst-block' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-external-face
"customize the face `rst-external' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-definition-face
"customize the face `rst-definition' instead."
"24.1")
"Directives and roles."
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-directive-face
"customize the face `rst-directive' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-comment-face
"customize the face `rst-comment' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis1-face
"customize the face `rst-emphasis1' instead."
"24.1")
"Double emphasis."
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis2-face
"customize the face `rst-emphasis2' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-literal-face
"customize the face `rst-literal' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-reference-face
"customize the face `rst-reference' instead."
"24.1")
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defface rst-transition '((t :inherit font-lock-keyword-face))
+ "Face used for a transition."
+ :package-version '(rst . "1.3.0")
+ :group 'rst-faces)
-(defgroup rst-faces-defaults nil
- "Values used to generate default faces for section titles on all levels.
-Tweak these if you are content with how section title faces are built in
-general but you do not like the details."
- :group 'rst-faces
- :version "21.1")
+(defface rst-adornment '((t :inherit font-lock-keyword-face))
+ "Face used for the adornment of a section header."
+ :package-version '(rst . "1.3.0")
+ :group 'rst-faces)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun rst-set-level-default (sym val)
- "Set custom var SYM affecting section title text face and recompute the faces."
- (custom-set-default sym val)
- ;; Also defines the faces initially when all values are available
- (and (boundp 'rst-level-face-max)
- (boundp 'rst-level-face-format-light)
- (boundp 'rst-level-face-base-color)
- (boundp 'rst-level-face-step-light)
- (boundp 'rst-level-face-base-light)
- (fboundp 'rst-define-level-faces)
- (rst-define-level-faces)))
-
-;; Faces for displaying items on several levels; these definitions define
-;; different shades of gray where the lightest one (i.e. least contrasting) is
-;; used for level 1
-(defcustom rst-level-face-max 6
- "Maximum depth of levels for which section title faces are defined."
- :group 'rst-faces-defaults
- :type '(integer)
- :set 'rst-set-level-default)
-(defcustom rst-level-face-base-color "grey"
- "The base name of the color to be used for creating background colors in
-section title faces for all levels."
- :group 'rst-faces-defaults
- :type '(string)
- :set 'rst-set-level-default)
-(defcustom rst-level-face-base-light
- (if (eq frame-background-mode 'dark)
- 15
- 85)
- "The lightness factor for the base color. This value is used for level 1.
-The default depends on whether the value of `frame-background-mode' is
-`dark' or not."
- :group 'rst-faces-defaults
- :type '(integer)
- :set 'rst-set-level-default)
-(defcustom rst-level-face-format-light "%2d"
- "The format for the lightness factor appended to the base name of the color.
-This value is expanded by `format' with an integer."
- :group 'rst-faces-defaults
- :type '(string)
- :set 'rst-set-level-default)
-(defcustom rst-level-face-step-light
- (if (eq frame-background-mode 'dark)
- 7
- -7)
- "The step width to use for the next color.
-The formula
-
- `rst-level-face-base-light'
- + (`rst-level-face-max' - 1) * `rst-level-face-step-light'
-
-must result in a color level which appended to `rst-level-face-base-color'
-using `rst-level-face-format-light' results in a valid color such as `grey50'.
-This color is used as background for section title text on level
-`rst-level-face-max'."
- :group 'rst-faces-defaults
- :type '(integer)
- :set 'rst-set-level-default)
+(dolist (var '(rst-level-face-max rst-level-face-base-color
+ rst-level-face-base-light
+ rst-level-face-format-light
+ rst-level-face-step-light
+ rst-level-1-face
+ rst-level-2-face
+ rst-level-3-face
+ rst-level-4-face
+ rst-level-5-face
+ rst-level-6-face))
+ (make-obsolete-variable var "customize the faces `rst-level-*' instead."
+ "24.3"))
+
+;; Define faces for the first 6 levels. More levels are possible, however.
+(defface rst-level-1 '((((background light)) (:background "grey85"))
+ (((background dark)) (:background "grey15")))
+ "Default face for section title text at level 1."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-2 '((((background light)) (:background "grey78"))
+ (((background dark)) (:background "grey22")))
+ "Default face for section title text at level 2."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-3 '((((background light)) (:background "grey71"))
+ (((background dark)) (:background "grey29")))
+ "Default face for section title text at level 3."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-4 '((((background light)) (:background "grey64"))
+ (((background dark)) (:background "grey36")))
+ "Default face for section title text at level 4."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-5 '((((background light)) (:background "grey57"))
+ (((background dark)) (:background "grey43")))
+ "Default face for section title text at level 5."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-6 '((((background light)) (:background "grey50"))
+ (((background dark)) (:background "grey50")))
+ "Default face for section title text at level 6."
+ :package-version '(rst . "1.4.0"))
(defcustom rst-adornment-faces-alist
- (let ((alist '((t . font-lock-keyword-face)
- (nil . font-lock-keyword-face)))
- (i 1))
- (while (<= i rst-level-face-max)
- (nconc alist (list (cons i (intern (format "rst-level-%d-face" i)))))
- (setq i (1+ i)))
- alist)
- "Faces for the various adornment types.
-Key is a number (for the section title text of that level),
-t (for transitions) or nil (for section title adornment).
-If you generally do not like how section title text faces are
-set up tweak here. If the general idea is ok for you but you do not like the
-details check the Rst Faces Defaults group."
+ '((t . rst-transition)
+ (nil . rst-adornment)
+ (1 . rst-level-1)
+ (2 . rst-level-2)
+ (3 . rst-level-3)
+ (4 . rst-level-4)
+ (5 . rst-level-5)
+ (6 . rst-level-6))
+ "Faces for the various adornment types.
+Key is a number (for the section title text of that level
+starting with 1), t (for transitions) or nil (for section title
+adornment). If you need levels beyond 6 you have to define faces
+of your own."
:group 'rst-faces
:type '(alist
:key-type
(choice
- (integer
- :tag
- "Section level (may not be bigger than `rst-level-face-max')")
- (boolean :tag "transitions (on) / section title adornment (off)"))
- :value-type (face))
- :set-after '(rst-level-face-max))
-
-(defun rst-define-level-faces ()
- "Define the faces for the section title text faces from the values."
- ;; All variables used here must be checked in `rst-set-level-default'
- (let ((i 1))
- (while (<= i rst-level-face-max)
- (let ((sym (intern (format "rst-level-%d-face" i)))
- (doc (format "Face for showing section title text at level %d" i))
- (col (format (concat "%s" rst-level-face-format-light)
- rst-level-face-base-color
- (+ (* (1- i) rst-level-face-step-light)
- rst-level-face-base-light))))
- (unless (facep sym)
- (make-empty-face sym)
- (set-face-doc-string sym doc)
- (set-face-background sym col)
- (set sym sym))
- (setq i (1+ i))))))
-
-(rst-define-level-faces)
+ (integer :tag "Section level")
+ (const :tag "transitions" t)
+ (const :tag "section title adornment" nil))
+ :value-type (face)))
+(rst-testcover-defcustom)
-\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Font lock
-(defvar rst-use-char-classes
- (string-match "[[:alpha:]]" "b")
- "Non-nil if we can use the character classes in our regexps.")
-
-(defun rst-font-lock-keywords-function ()
- "Return keywords to highlight in Rst mode according to current settings."
+(defvar rst-font-lock-keywords
;; The reST-links in the comments below all relate to sections in
- ;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html
- (let* ( ;; This gets big - so let's define some abbreviations
- ;; horizontal white space
- (re-hws "[\t ]")
- ;; beginning of line with possible indentation
- (re-bol (concat "^" re-hws "*"))
- ;; Separates block lead-ins from their content
- (re-blksep1 (concat "\\(" re-hws "+\\|$\\)"))
- ;; explicit markup tag
- (re-emt "\\.\\.")
- ;; explicit markup start
- (re-ems (concat re-emt re-hws "+"))
- ;; inline markup prefix
- (re-imp1 (concat "\\(^\\|" re-hws "\\|[-'\"([{</:]\\)"))
- ;; inline markup suffix
- (re-ims1 (concat "\\(" re-hws "\\|[]-'\")}>/:.,;!?\\]\\|$\\)"))
- ;; symbol character
- (re-sym1 "\\(\\sw\\|\\s_\\)")
- ;; inline markup content begin
- (re-imbeg2 "\\(\\S \\|\\S \\([^")
-
- ;; There seems to be a bug leading to error "Stack overflow in regexp
- ;; matcher" when "|" or "\\*" are the characters searched for
- (re-imendbeg "\\]\\|\\\\.")
- ;; inline markup content end
- (re-imend (concat re-imendbeg "\\)*[^\t \\\\]\\)"))
- ;; inline markup content without asterisk
- (re-ima2 (concat re-imbeg2 "*" re-imend))
- ;; inline markup content without backquote
- (re-imb2 (concat re-imbeg2 "`" re-imend))
- ;; inline markup content without vertical bar
- (re-imv2 (concat re-imbeg2 "|" re-imend))
- ;; Supported URI schemes
- (re-uris1 "\\(acap\\|cid\\|data\\|dav\\|fax\\|file\\|ftp\\|gopher\\|http\\|https\\|imap\\|ldap\\|mailto\\|mid\\|modem\\|news\\|nfs\\|nntp\\|pop\\|prospero\\|rtsp\\|service\\|sip\\|tel\\|telnet\\|tip\\|urn\\|vemmi\\|wais\\)")
- ;; Line starting with adornment and optional whitespace; complete
- ;; adornment is in (match-string 1); there must be at least 3
- ;; characters because otherwise explicit markup start would be
- ;; recognized
- (re-ado2 (concat "^\\(\\(["
- (if rst-use-char-classes
- "^[:word:][:space:][:cntrl:]" "^\\w \t\x00-\x1F")
- "]\\)\\2\\2+\\)" re-hws "*$"))
- )
- (list
- ;; FIXME: Block markup is not recognized in blocks after explicit markup
- ;; start
-
- ;; Simple `Body Elements`_
- ;; `Bullet Lists`_
- `(,(concat re-bol "\\([-*+]" re-blksep1 "\\)")
- 1 rst-block-face)
- ;; `Enumerated Lists`_
- `(,(concat re-bol "\\((?\\(#\\|[0-9]+\\|[A-Za-z]\\|[IVXLCMivxlcm]+\\)[.)]"
- re-blksep1 "\\)")
- 1 rst-block-face)
- ;; `Definition Lists`_ FIXME: missing
- ;; `Field Lists`_
- `(,(concat re-bol "\\(:[^:\n]+:\\)" re-blksep1)
- 1 rst-external-face)
- ;; `Option Lists`_
- `(,(concat re-bol "\\(\\(\\(\\([-+/]\\|--\\)\\sw\\(-\\|\\sw\\)*"
- "\\([ =]\\S +\\)?\\)\\(,[\t ]\\)?\\)+\\)\\($\\|[\t ]\\{2\\}\\)")
- 1 rst-block-face)
-
- ;; `Tables`_ FIXME: missing
-
- ;; All the `Explicit Markup Blocks`_
- ;; `Footnotes`_ / `Citations`_
- `(,(concat re-bol "\\(" re-ems "\\[[^[\n]+\\]\\)" re-blksep1)
- 1 rst-definition-face)
- ;; `Directives`_ / `Substitution Definitions`_
- `(,(concat re-bol "\\(" re-ems "\\)\\(\\(|[^|\n]+|[\t ]+\\)?\\)\\("
- re-sym1 "+::\\)" re-blksep1)
- (1 rst-directive-face)
- (2 rst-definition-face)
- (4 rst-directive-face))
- ;; `Hyperlink Targets`_
- `(,(concat re-bol "\\(" re-ems "_\\([^:\\`\n]\\|\\\\.\\|`[^`\n]+`\\)+:\\)"
- re-blksep1)
- 1 rst-definition-face)
- `(,(concat re-bol "\\(__\\)" re-blksep1)
- 1 rst-definition-face)
-
- ;; All `Inline Markup`_
- ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented
- ;; `Strong Emphasis`_
- `(,(concat re-imp1 "\\(\\*\\*" re-ima2 "\\*\\*\\)" re-ims1)
- 2 rst-emphasis2-face)
- ;; `Emphasis`_
- `(,(concat re-imp1 "\\(\\*" re-ima2 "\\*\\)" re-ims1)
- 2 rst-emphasis1-face)
- ;; `Inline Literals`_
- `(,(concat re-imp1 "\\(``" re-imb2 "``\\)" re-ims1)
- 2 rst-literal-face)
- ;; `Inline Internal Targets`_
- `(,(concat re-imp1 "\\(_`" re-imb2 "`\\)" re-ims1)
- 2 rst-definition-face)
- ;; `Hyperlink References`_
- ;; FIXME: `Embedded URIs`_ not considered
- `(,(concat re-imp1 "\\(\\(`" re-imb2 "`\\|\\(\\sw\\(\\sw\\|-\\)+\\sw\\)\\)__?\\)" re-ims1)
- 2 rst-reference-face)
- ;; `Interpreted Text`_
- `(,(concat re-imp1 "\\(\\(:" re-sym1 "+:\\)?\\)\\(`" re-imb2 "`\\)\\(\\(:"
- re-sym1 "+:\\)?\\)" re-ims1)
- (2 rst-directive-face)
- (5 rst-external-face)
- (8 rst-directive-face))
- ;; `Footnote References`_ / `Citation References`_
- `(,(concat re-imp1 "\\(\\[[^]]+\\]_\\)" re-ims1)
- 2 rst-reference-face)
- ;; `Substitution References`_
- `(,(concat re-imp1 "\\(|" re-imv2 "|\\)" re-ims1)
- 2 rst-reference-face)
- ;; `Standalone Hyperlinks`_
- `(;; FIXME: This takes it easy by using a whitespace as delimiter
- ,(concat re-imp1 "\\(" re-uris1 ":\\S +\\)" re-ims1)
- 2 rst-definition-face)
- `(,(concat re-imp1 "\\(" re-sym1 "+@" re-sym1 "+\\)" re-ims1)
- 2 rst-definition-face)
-
- ;; Do all block fontification as late as possible so 'append works
-
- ;; Sections_ / Transitions_
- (append
- (list
- re-ado2)
- (if (not rst-mode-lazy)
- '(1 rst-block-face)
- (list
- (list 'rst-font-lock-handle-adornment
- '(progn
- (setq rst-font-lock-adornment-point (match-end 1))
- (point-max))
- nil
- (list 1 '(cdr (assoc nil rst-adornment-faces-alist))
- 'append t)
- (list 2 '(cdr (assoc rst-font-lock-level
- rst-adornment-faces-alist))
- 'append t)
- (list 3 '(cdr (assoc nil rst-adornment-faces-alist))
- 'append t)))))
-
- ;; `Comments`_
- (append
- (list
- (concat re-bol "\\(" re-ems "\\)\[^[|_]\\([^:\n]\\|:\\([^:\n]\\|$\\)\\)*$")
-
- '(1 rst-comment-face))
- (if rst-mode-lazy
- (list
- (list 'rst-font-lock-find-unindented-line
- '(progn
- (setq rst-font-lock-indentation-point (match-end 1))
- (point-max))
- nil
- '(0 rst-comment-face append)))))
- (append
- (list
- (concat re-bol "\\(" re-emt "\\)\\(\\s *\\)$")
- '(1 rst-comment-face)
- '(2 rst-comment-face))
- (if rst-mode-lazy
- (list
- (list 'rst-font-lock-find-unindented-line
- '(progn
- (setq rst-font-lock-indentation-point 'next)
- (point-max))
- nil
- '(0 rst-comment-face append)))))
-
- ;; `Literal Blocks`_
- (append
- (list
- (concat re-bol "\\(\\([^.\n]\\|\\.[^.\n]\\).*\\)?\\(::\\)$")
- '(3 rst-block-face))
- (if rst-mode-lazy
- (list
- (list 'rst-font-lock-find-unindented-line
- '(progn
- (setq rst-font-lock-indentation-point t)
- (point-max))
- nil
- '(0 rst-literal-face append)))))
+ ;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html.
+ `(;; FIXME: Block markup is not recognized in blocks after explicit markup
+ ;; start.
+
+ ;; Simple `Body Elements`_
+ ;; `Bullet Lists`_
+ ;; FIXME: A bullet directly after a field name is not recognized.
+ (,(rst-re 'lin-beg '(:grp bul-sta))
+ 1 rst-block-face)
+ ;; `Enumerated Lists`_
+ (,(rst-re 'lin-beg '(:grp enmany-sta))
+ 1 rst-block-face)
+ ;; `Definition Lists`_
+ ;; FIXME: missing.
+ ;; `Field Lists`_
+ (,(rst-re 'lin-beg '(:grp fld-tag) 'bli-sfx)
+ 1 rst-external-face)
+ ;; `Option Lists`_
+ (,(rst-re 'lin-beg '(:grp opt-tag (:shy optsep-tag opt-tag) "*")
+ '(:alt "$" (:seq hws-prt "\\{2\\}")))
+ 1 rst-block-face)
+ ;; `Line Blocks`_
+ ;; Only for lines containing no more bar - to distinguish from tables.
+ (,(rst-re 'lin-beg '(:grp "|" bli-sfx) "[^|\n]*$")
+ 1 rst-block-face)
+
+ ;; `Tables`_
+ ;; FIXME: missing
+
+ ;; All the `Explicit Markup Blocks`_
+ ;; `Footnotes`_ / `Citations`_
+ (,(rst-re 'lin-beg 'fnc-sta-2)
+ (1 rst-definition-face)
+ (2 rst-definition-face))
+ ;; `Directives`_ / `Substitution Definitions`_
+ (,(rst-re 'lin-beg 'dir-sta-3)
+ (1 rst-directive-face)
+ (2 rst-definition-face)
+ (3 rst-directive-face))
+ ;; `Hyperlink Targets`_
+ (,(rst-re 'lin-beg
+ '(:grp exm-sta "_" (:alt
+ (:seq "`" ilcbkqdef-tag "`")
+ (:seq (:alt "[^:\\\n]" "\\\\.") "+")) ":")
+ 'bli-sfx)
+ 1 rst-definition-face)
+ (,(rst-re 'lin-beg '(:grp "__") 'bli-sfx)
+ 1 rst-definition-face)
+
+ ;; All `Inline Markup`_
+ ;; Most of them may be multiline though this is uninteresting.
+
+ ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented
+ ;; `Strong Emphasis`_.
+ (,(rst-re 'ilm-pfx '(:grp "\\*\\*" ilcast-tag "\\*\\*") 'ilm-sfx)
+ 1 rst-emphasis2-face)
+ ;; `Emphasis`_
+ (,(rst-re 'ilm-pfx '(:grp "\\*" ilcast-tag "\\*") 'ilm-sfx)
+ 1 rst-emphasis1-face)
+ ;; `Inline Literals`_
+ (,(rst-re 'ilm-pfx '(:grp "``" ilcbkq-tag "``") 'ilm-sfx)
+ 1 rst-literal-face)
+ ;; `Inline Internal Targets`_
+ (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx)
+ 1 rst-definition-face)
+ ;; `Hyperlink References`_
+ ;; FIXME: `Embedded URIs`_ not considered.
+ ;; FIXME: Directly adjacent marked up words are not fontified correctly
+ ;; unless they are not separated by two spaces: foo_ bar_.
+ (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`")
+ (:seq "\\sw" (:alt "\\sw" "-") "+\\sw"))
+ "__?") 'ilm-sfx)
+ 1 rst-reference-face)
+ ;; `Interpreted Text`_
+ (,(rst-re 'ilm-pfx '(:grp (:shy ":" sym-tag ":") "?")
+ '(:grp "`" ilcbkq-tag "`")
+ '(:grp (:shy ":" sym-tag ":") "?") 'ilm-sfx)
+ (1 rst-directive-face)
+ (2 rst-external-face)
+ (3 rst-directive-face))
+ ;; `Footnote References`_ / `Citation References`_
+ (,(rst-re 'ilm-pfx '(:grp fnc-tag "_") 'ilm-sfx)
+ 1 rst-reference-face)
+ ;; `Substitution References`_
+ ;; FIXME: References substitutions like |this|_ or |this|__ are not
+ ;; fontified correctly.
+ (,(rst-re 'ilm-pfx '(:grp sub-tag) 'ilm-sfx)
+ 1 rst-reference-face)
+ ;; `Standalone Hyperlinks`_
+ ;; FIXME: This takes it easy by using a whitespace as delimiter.
+ (,(rst-re 'ilm-pfx '(:grp uri-tag ":\\S +") 'ilm-sfx)
+ 1 rst-definition-face)
+ (,(rst-re 'ilm-pfx '(:grp sym-tag "@" sym-tag ) 'ilm-sfx)
+ 1 rst-definition-face)
+
+ ;; Do all block fontification as late as possible so 'append works.
+
+ ;; Sections_ / Transitions_
+ ;; For sections this is multiline.
+ (,(rst-re 'ado-beg-2-1)
+ (rst-font-lock-handle-adornment-matcher
+ (rst-font-lock-handle-adornment-pre-match-form
+ (match-string-no-properties 1) (match-end 1))
+ nil
+ (1 (cdr (assoc nil rst-adornment-faces-alist)) append t)
+ (2 (cdr (assoc rst-font-lock-adornment-level
+ rst-adornment-faces-alist)) append t)
+ (3 (cdr (assoc nil rst-adornment-faces-alist)) append t)))
+
+ ;; FIXME: FACESPEC could be used instead of ordinary faces to set
+ ;; properties on comments and literal blocks so they are *not*
+ ;; inline fontified. See (elisp)Search-based Fontification.
+
+ ;; FIXME: And / or use `syntax-propertize` functions as in `octave-mod.el`
+ ;; and other V24 modes. May make `font-lock-extend-region`
+ ;; superfluous.
+
+ ;; `Comments`_
+ ;; This is multiline.
+ (,(rst-re 'lin-beg 'cmt-sta-1)
+ (1 rst-comment-face)
+ (rst-font-lock-find-unindented-line-match
+ (rst-font-lock-find-unindented-line-limit (match-end 1))
+ nil
+ (0 rst-comment-face append)))
+ (,(rst-re 'lin-beg '(:grp exm-tag) '(:grp hws-tag) "$")
+ (1 rst-comment-face)
+ (2 rst-comment-face)
+ (rst-font-lock-find-unindented-line-match
+ (rst-font-lock-find-unindented-line-limit 'next)
+ nil
+ (0 rst-comment-face append)))
+
+ ;; FIXME: This is not rendered as comment::
+ ;; .. .. list-table::
+ ;; :stub-columns: 1
+ ;; :header-rows: 1
+
+ ;; FIXME: This is rendered wrong::
+ ;;
+ ;; xxx yyy::
+ ;;
+ ;; ----|> KKKKK <|----
+ ;; / \
+ ;; -|> AAAAAAAAAAPPPPPP <|- -|> AAAAAAAAAABBBBBBB <|-
+ ;; | | | |
+ ;; | | | |
+ ;; PPPPPP PPPPPPDDDDDDD BBBBBBB PPPPPPBBBBBBB
+ ;;
+ ;; Indentation needs to be taken from the line with the ``::`` and not from
+ ;; the first content line.
- ;; `Doctest Blocks`_
- (append
- (list
- (concat re-bol "\\(>>>\\|\\.\\.\\.\\)\\(.+\\)")
- '(1 rst-block-face)
- '(2 rst-literal-face)))
- )))
+ ;; `Indented Literal Blocks`_
+ ;; This is multiline.
+ (,(rst-re 'lin-beg 'lit-sta-2)
+ (2 rst-block-face)
+ (rst-font-lock-find-unindented-line-match
+ (rst-font-lock-find-unindented-line-limit t)
+ nil
+ (0 rst-literal-face append)))
+ ;; FIXME: `Quoted Literal Blocks`_ missing.
+ ;; This is multiline.
+ ;; `Doctest Blocks`_
+ ;; FIXME: This is wrong according to the specification:
+ ;;
+ ;; Doctest blocks are text blocks which begin with ">>> ", the Python
+ ;; interactive interpreter main prompt, and end with a blank line.
+ ;; Doctest blocks are treated as a special case of literal blocks,
+ ;; without requiring the literal block syntax. If both are present, the
+ ;; literal block syntax takes priority over Doctest block syntax:
+ ;;
+ ;; This is an ordinary paragraph.
+ ;;
+ ;; >>> print 'this is a Doctest block'
+ ;; this is a Doctest block
+ ;;
+ ;; The following is a literal block::
+ ;;
+ ;; >>> This is not recognized as a doctest block by
+ ;; reStructuredText. It *will* be recognized by the doctest
+ ;; module, though!
+ ;;
+ ;; Indentation is not required for doctest blocks.
+ (,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+"))
+ (1 rst-block-face)
+ (2 rst-literal-face)))
+ "Keywords to highlight in rst mode.")
+
+(defvar font-lock-beg)
+(defvar font-lock-end)
+
+(defun rst-font-lock-extend-region ()
+ "Extend the font-lock region if it might be in a multi-line construct.
+Return non-nil if so. Font-lock region is from `font-lock-beg'
+to `font-lock-end'."
+ (let ((r (rst-font-lock-extend-region-internal font-lock-beg font-lock-end)))
+ (when r
+ (setq font-lock-beg (car r))
+ (setq font-lock-end (cdr r))
+ t)))
+
+(defun rst-font-lock-extend-region-internal (beg end)
+ "Check the region BEG / END for being in the middle of a multi-line construct.
+Return nil if not or a cons with new values for BEG / END"
+ (let ((nbeg (rst-font-lock-extend-region-extend beg -1))
+ (nend (rst-font-lock-extend-region-extend end 1)))
+ (if (or nbeg nend)
+ (cons (or nbeg beg) (or nend end)))))
+
+(defun rst-forward-line (&optional n)
+ "Like `forward-line' but always end up in column 0 and return accordingly.
+Move N lines forward just as `forward-line'."
+ (let ((moved (forward-line n)))
+ (if (bolp)
+ moved
+ (forward-line 0)
+ (- moved (rst-signum n)))))
+
+;; FIXME: If a single line is made a section header by `rst-adjust' the header
+;; is not always fontified immediately.
+(defun rst-font-lock-extend-region-extend (pt dir)
+ "Extend the region starting at point PT and extending in direction DIR.
+Return extended point or nil if not moved."
+ ;; There are many potential multiline constructs but there are two groups
+ ;; which are really relevant. The first group consists of
+ ;;
+ ;; * comment lines without leading explicit markup tag and
+ ;;
+ ;; * literal blocks following "::"
+ ;;
+ ;; which are both indented. Thus indentation is the first thing recognized
+ ;; here. The second criteria is an explicit markup tag which may be a comment
+ ;; or a double colon at the end of a line.
+ ;;
+ ;; The second group consists of the adornment cases.
+ (if (not (get-text-property pt 'font-lock-multiline))
+ ;; Move only if we don't start inside a multiline construct already.
+ (save-excursion
+ (let (;; Non-empty non-indented line, explicit markup tag or literal
+ ;; block tag.
+ (stop-re (rst-re '(:alt "[^ \t\n]"
+ (:seq hws-tag exm-tag)
+ (:seq ".*" dcl-tag lin-end)))))
+ ;; The comments below are for dir == -1 / dir == 1.
+ (goto-char pt)
+ (forward-line 0)
+ (setq pt (point))
+ (while (and (not (looking-at stop-re))
+ (zerop (rst-forward-line dir)))) ; try previous / next
+ ; line if it exists.
+ (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline /
+ ; overline.
+ (if (zerop (rst-forward-line dir))
+ (if (looking-at (rst-re 'ttl-beg)) ; title found, i.e.
+ ; underline / overline
+ ; found.
+ (if (zerop (rst-forward-line dir))
+ (if (not
+ (looking-at (rst-re 'ado-beg-2-1))) ; no
+ ; overline /
+ ; underline.
+ (rst-forward-line (- dir)))) ; step back to title
+ ; / adornment.
+ (if (< dir 0) ; keep downward adornment.
+ (rst-forward-line (- dir))))) ; step back to adornment.
+ (if (looking-at (rst-re 'ttl-beg)) ; may be a title.
+ (if (zerop (rst-forward-line dir))
+ (if (not
+ (looking-at (rst-re 'ado-beg-2-1))) ; no overline /
+ ; underline.
+ (rst-forward-line (- dir)))))) ; step back to line.
+ (if (not (= (point) pt))
+ (point))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Indented blocks
(forward-line 1)
(when (< (point) limit)
(setq beg (point))
- (if (looking-at "\\s *$")
- (setq cand (or cand beg)) ; An empty line is a candidate
+ (if (looking-at (rst-re 'lin-end))
+ (setq cand (or cand beg)) ; An empty line is a candidate.
(move-to-column clm)
;; FIXME: No indentation [(zerop clm)] must be handled in some
- ;; useful way - though it is not clear what this should mean at all
+ ;; useful way - though it is not clear what this should mean
+ ;; at all.
(if (string-match
- "^\\s *$" (buffer-substring-no-properties beg (point)))
- (setq cand nil) ; An indented line resets a candidate
+ (rst-re 'linemp-tag)
+ (buffer-substring-no-properties beg (point)))
+ (setq cand nil) ; An indented line resets a candidate.
(setq fnd (or cand beg)))))))
(goto-char (or fnd start))
fnd))
-;; Stores the point where the current indentation ends if a number. If `next'
-;; indicates `rst-font-lock-find-unindented-line' shall take the indentation
-;; from the next line if this is not empty. If non-nil indicates
-;; `rst-font-lock-find-unindented-line' shall take the indentation from the
-;; next non-empty line. Also used as a trigger for
-;; `rst-font-lock-find-unindented-line'.
-(defvar rst-font-lock-indentation-point nil)
-
-(defun rst-font-lock-find-unindented-line (limit)
- (let* ((ind-pnt rst-font-lock-indentation-point)
- (beg-pnt ind-pnt))
- ;; May run only once - enforce this
- (setq rst-font-lock-indentation-point nil)
- (when (and ind-pnt (not (numberp ind-pnt)))
- ;; Find indentation point in next line if any
- (setq ind-pnt
- (save-excursion
- (save-match-data
- (if (eq ind-pnt 'next)
- (when (and (zerop (forward-line 1)) (< (point) limit))
- (setq beg-pnt (point))
- (when (not (looking-at "\\s *$"))
- (looking-at "\\s *")
- (match-end 0)))
- (while (and (zerop (forward-line 1)) (< (point) limit)
- (looking-at "\\s *$")))
- (when (< (point) limit)
- (setq beg-pnt (point))
- (looking-at "\\s *")
- (match-end 0)))))))
- (when ind-pnt
- (goto-char ind-pnt)
- ;; Always succeeds because the limit set by PRE-MATCH-FORM is the
- ;; ultimate point to find
- (goto-char (or (rst-forward-indented-block nil limit) limit))
- (save-excursion
- ;; Include subsequent empty lines in the font-lock block,
- ;; in case the user subsequently changes the indentation of the next
- ;; non-empty line to move it into the indented element.
- (skip-chars-forward " \t\n")
- (put-text-property beg-pnt (point) 'font-lock-multiline t))
- (set-match-data (list beg-pnt (point)))
- t)))
+(defvar rst-font-lock-find-unindented-line-begin nil
+ "Beginning of the match if `rst-font-lock-find-unindented-line-end'.")
+
+(defvar rst-font-lock-find-unindented-line-end nil
+ "End of the match as determined by `rst-font-lock-find-unindented-line-limit'.
+Also used as a trigger for
+`rst-font-lock-find-unindented-line-match'.")
+
+(defun rst-font-lock-find-unindented-line-limit (ind-pnt)
+ "Find the next unindented line relative to indentation at IND-PNT.
+Return this point, the end of the buffer or nil if nothing found.
+If IND-PNT is `next' take the indentation from the next line if
+this is not empty and indented more than the current one. If
+IND-PNT is non-nil but not a number take the indentation from the
+next non-empty line if this is indented more than the current
+one."
+ (setq rst-font-lock-find-unindented-line-begin ind-pnt)
+ (setq rst-font-lock-find-unindented-line-end
+ (save-excursion
+ (when (not (numberp ind-pnt))
+ ;; Find indentation point in next line if any.
+ (setq ind-pnt
+ ;; FIXME: Should be refactored to two different functions
+ ;; giving their result to this function, may be
+ ;; integrated in caller.
+ (save-match-data
+ (let ((cur-ind (current-indentation)))
+ (if (eq ind-pnt 'next)
+ (when (and (zerop (forward-line 1))
+ (< (point) (point-max)))
+ ;; Not at EOF.
+ (setq rst-font-lock-find-unindented-line-begin
+ (point))
+ (when (and (not (looking-at (rst-re 'lin-end)))
+ (> (current-indentation) cur-ind))
+ ;; Use end of indentation if non-empty line.
+ (looking-at (rst-re 'hws-tag))
+ (match-end 0)))
+ ;; Skip until non-empty line or EOF.
+ (while (and (zerop (forward-line 1))
+ (< (point) (point-max))
+ (looking-at (rst-re 'lin-end))))
+ (when (< (point) (point-max))
+ ;; Not at EOF.
+ (setq rst-font-lock-find-unindented-line-begin
+ (point))
+ (when (> (current-indentation) cur-ind)
+ ;; Indentation bigger than line of departure.
+ (looking-at (rst-re 'hws-tag))
+ (match-end 0))))))))
+ (when ind-pnt
+ (goto-char ind-pnt)
+ (or (rst-forward-indented-block nil (point-max))
+ (point-max))))))
+
+(defun rst-font-lock-find-unindented-line-match (limit)
+ "Set the match found earlier if match were found.
+Match has been found by
+`rst-font-lock-find-unindented-line-limit' the first time called
+or no match is found. Return non-nil if match was found. LIMIT
+is not used but mandated by the caller."
+ (when rst-font-lock-find-unindented-line-end
+ (set-match-data
+ (list rst-font-lock-find-unindented-line-begin
+ rst-font-lock-find-unindented-line-end))
+ (put-text-property rst-font-lock-find-unindented-line-begin
+ rst-font-lock-find-unindented-line-end
+ 'font-lock-multiline t)
+ ;; Make sure this is called only once.
+ (setq rst-font-lock-find-unindented-line-end nil)
+ t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Adornments
-(defvar rst-font-lock-adornment-point nil
- "Stores the point where the current adornment ends.
-Also used as a trigger for `rst-font-lock-handle-adornment'.")
-
-;; Here `rst-font-lock-handle-adornment' stores the section level of the
-;; current adornment or t for a transition.
-(defvar rst-font-lock-level nil)
-
-;; FIXME: It would be good if this could be used to markup section titles of
-;; given level with a special key; it would be even better to be able to
-;; customize this so it can be used for a generally available personal style
-;;
-;; FIXME: There should be some way to reset and reload this variable - probably
-;; a special key
-;;
-;; FIXME: Some support for `outline-mode' would be nice which should be based
-;; on this information
-(defvar rst-adornment-level-alist nil
- "Associates adornments with section levels.
-The key is a two character string. The first character is the adornment
-character. The second character distinguishes underline section titles (`u')
-from overline/underline section titles (`o'). The value is the section level.
-
-This is made buffer local on start and adornments found during font lock are
-entered.")
-
-;; Returns section level for adornment key KEY. Adds new section level if KEY
-;; is not found and ADD. If KEY is not a string it is simply returned.
-(defun rst-adornment-level (key &optional add)
- (let ((fnd (assoc key rst-adornment-level-alist))
- (new 1))
- (cond
- ((not (stringp key))
- key)
- (fnd
- (cdr fnd))
- (add
- (while (rassoc new rst-adornment-level-alist)
- (setq new (1+ new)))
- (setq rst-adornment-level-alist
- (append rst-adornment-level-alist (list (cons key new))))
- new))))
-
-;; Classifies adornment for section titles and transitions. ADORNMENT is the
-;; complete adornment string as found in the buffer. END is the point after the
-;; last character of ADORNMENT. For overline section adornment LIMIT limits the
-;; search for the matching underline. Returns a list. The first entry is t for
-;; a transition, or a key string for `rst-adornment-level' for a section title.
-;; The following eight values forming four match groups as can be used for
-;; `set-match-data'. First match group contains the maximum points of the whole
-;; construct. Second and last match group matched pure section title adornment
-;; while third match group matched the section title text or the transition.
-;; Each group but the first may or may not exist.
-(defun rst-classify-adornment (adornment end limit)
- (save-excursion
- (save-match-data
- (goto-char end)
- (let ((ado-ch (aref adornment 0))
- (ado-re (regexp-quote adornment))
- (end-pnt (point))
- (beg-pnt (progn
- (forward-line 0)
- (point)))
- (nxt-emp
- (save-excursion
- (or (not (zerop (forward-line 1)))
- (looking-at "\\s *$"))))
- (prv-emp
- (save-excursion
- (or (not (zerop (forward-line -1)))
- (looking-at "\\s *$"))))
- key beg-ovr end-ovr beg-txt end-txt beg-und end-und)
- (cond
- ((and nxt-emp prv-emp)
- ;; A transition
- (setq key t)
- (setq beg-txt beg-pnt)
- (setq end-txt end-pnt))
- (prv-emp
- ;; An overline
- (setq key (concat (list ado-ch) "o"))
- (setq beg-ovr beg-pnt)
- (setq end-ovr end-pnt)
- (forward-line 1)
- (setq beg-txt (point))
- (while (and (< (point) limit) (not end-txt))
- (if (looking-at "\\s *$")
- ;; No underline found
- (setq end-txt (1- (point)))
- (when (looking-at (concat "\\(" ado-re "\\)\\s *$"))
- (setq end-und (match-end 1))
- (setq beg-und (point))
- (setq end-txt (1- beg-und))))
- (forward-line 1)))
- (t
- ;; An underline
- (setq key (concat (list ado-ch) "u"))
- (setq beg-und beg-pnt)
- (setq end-und end-pnt)
- (setq end-txt (1- beg-und))
- (setq beg-txt (progn
- (if (re-search-backward "^\\s *$" 1 'move)
- (forward-line 1))
- (point)))))
- (list key
- (or beg-ovr beg-txt beg-und)
- (or end-und end-txt end-und)
- beg-ovr end-ovr beg-txt end-txt beg-und end-und)))))
-
-;; Handles adornments for font-locking section titles and transitions. Returns
-;; three match groups. First and last match group matched pure overline /
-;; underline adornment while second group matched section title text. Each
-;; group may not exist.
-(defun rst-font-lock-handle-adornment (limit)
- (let ((ado-pnt rst-font-lock-adornment-point))
- ;; May run only once - enforce this
- (setq rst-font-lock-adornment-point nil)
- (if ado-pnt
- (let* ((ado (rst-classify-adornment (match-string-no-properties 1)
- ado-pnt limit))
- (key (car ado))
- (mtc (cdr ado)))
- (setq rst-font-lock-level (rst-adornment-level key t))
- (goto-char (nth 1 mtc))
- (put-text-property (nth 0 mtc) (nth 1 mtc) 'font-lock-multiline t)
- (set-match-data mtc)
- t))))
-
-
+(defvar rst-font-lock-adornment-level nil
+ "Storage for `rst-font-lock-handle-adornment-matcher'.
+Either section level of the current adornment or t for a transition.")
+
+(defun rst-adornment-level (key)
+ "Return section level for adornment KEY.
+KEY is the first element of the return list of
+`rst-classify-adornment'. If KEY is not a cons return it. If KEY is found
+in the hierarchy return its level. Otherwise return a level one
+beyond the existing hierarchy."
+ (if (not (consp key))
+ key
+ (let* ((hier (rst-get-hierarchy))
+ (char (car key))
+ (style (cdr key)))
+ (1+ (or (lexical-let ((char char)
+ (style style)
+ (hier hier)) ; Create closure.
+ (rst-position-if (lambda (elt)
+ (and (equal (car elt) char)
+ (equal (cadr elt) style))) hier))
+ (length hier))))))
+
+(defvar rst-font-lock-adornment-match nil
+ "Storage for match for current adornment.
+Set by `rst-font-lock-handle-adornment-pre-match-form'. Also used
+as a trigger for `rst-font-lock-handle-adornment-matcher'.")
+
+(defun rst-font-lock-handle-adornment-pre-match-form (ado ado-end)
+ "Determine limit for adornments.
+Determine all things necessary for font-locking section titles
+and transitions and put the result to
+`rst-font-lock-adornment-match' and
+`rst-font-lock-adornment-level'. ADO is the complete adornment
+matched. ADO-END is the point where ADO ends. Return the point
+where the whole adorned construct ends.
+
+Called as a PRE-MATCH-FORM in the sense of `font-lock-keywords'."
+ (let ((ado-data (rst-classify-adornment ado ado-end)))
+ (if (not ado-data)
+ (setq rst-font-lock-adornment-level nil
+ rst-font-lock-adornment-match nil)
+ (setq rst-font-lock-adornment-level
+ (rst-adornment-level (car ado-data)))
+ (setq rst-font-lock-adornment-match (cdr ado-data))
+ (goto-char (nth 1 ado-data)) ; Beginning of construct.
+ (nth 2 ado-data)))) ; End of construct.
+
+(defun rst-font-lock-handle-adornment-matcher (limit)
+ "Set the match found earlier if match were found.
+Match has been found by
+`rst-font-lock-handle-adornment-pre-match-form' the first time
+called or no match is found. Return non-nil if match was found.
+
+Called as a MATCHER in the sense of `font-lock-keywords'.
+LIMIT is not used but mandated by the caller."
+ (let ((match rst-font-lock-adornment-match))
+ ;; May run only once - enforce this.
+ (setq rst-font-lock-adornment-match nil)
+ (when match
+ (set-match-data match)
+ (goto-char (match-end 0))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'font-lock-multiline t)
+ t)))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Support for conversion from within Emacs
+;; Compilation
(defgroup rst-compile nil
"Settings for support of conversion of reStructuredText
".pdf" nil)
(s5 ,(if (executable-find "rst2s5.py") "rst2s5.py" "rst2s5")
".html" nil))
- "Table describing the command to use for each toolset.
-An association list of the toolset to a list of the (command to use,
+ "Table describing the command to use for each tool-set.
+An association list of the tool-set to a list of the (command to use,
extension of produced filename, options to the tool (nil or a
string)) to be used for converting the document."
+ ;; FIXME: These are not options but symbols which may be referenced by
+ ;; `rst-compile-*-toolset` below. The `:validate' keyword of
+ ;; `defcustom' may help to define this properly in newer Emacs
+ ;; versions (> 23.1).
:type '(alist :options (html latex newlatex pseudoxml xml pdf s5)
:key-type symbol
:value-type (list :tag "Specification"
(const :tag "No options" nil)
(string :tag "Options"))))
:group 'rst
- :version "24.1")
-
-;; Note for Python programmers not familiar with association lists: you can set
-;; values in an alists like this, e.g. :
-;; (setcdr (assq 'html rst-compile-toolsets)
-;; '("rst2html.py" ".htm" "--stylesheet=/docutils.css"))
-
+ :package-version "1.2.0")
+(rst-testcover-defcustom)
+;; FIXME: Must be `defcustom`.
(defvar rst-compile-primary-toolset 'html
- "The default toolset for `rst-compile'.")
+ "The default tool-set for `rst-compile'.")
+;; FIXME: Must be `defcustom`.
(defvar rst-compile-secondary-toolset 'latex
- "The default toolset for `rst-compile' with a prefix argument.")
+ "The default tool-set for `rst-compile' with a prefix argument.")
(defun rst-compile-find-conf ()
"Look for the configuration file in the parents of the current path."
(setq prevdir dir)
(setq dir (expand-file-name (file-name-directory
(directory-file-name
- (file-name-directory dir)))))
- )
- (or (and dir (concat dir file-name)) nil)
- )))
-
+ (file-name-directory dir))))))
+ (or (and dir (concat dir file-name)) nil))))
(require 'compile)
-(defun rst-compile (&optional pfxarg)
+(defun rst-compile (&optional use-alt)
"Compile command to convert reST document into some output file.
Attempts to find configuration file, if it can, overrides the
-options. There are two commands to choose from, with a prefix
-argument, select the alternative toolset."
+options. There are two commands to choose from, with USE-ALT,
+select the alternative tool-set."
(interactive "P")
;; Note: maybe we want to check if there is a Makefile too and not do anything
;; if that is the case. I dunno.
- (let* ((toolset (cdr (assq (if pfxarg
+ (let* ((toolset (cdr (assq (if use-alt
rst-compile-secondary-toolset
rst-compile-primary-toolset)
rst-compile-toolsets)))
(list command
(or options "")
(if conffile
- (concat "--config=\"" conffile "\"")
+ (concat "--config=" (shell-quote-argument conffile))
"")
- bufname
- (concat outname extension))
+ (shell-quote-argument bufname)
+ (shell-quote-argument (concat outname extension)))
" "))
;; Invoke the compile command.
- (if (or compilation-read-command current-prefix-arg)
+ (if (or compilation-read-command use-alt)
(call-interactively 'compile)
- (compile compile-command))
- ))
+ (compile compile-command))))
(defun rst-compile-alt-toolset ()
- "Compile command with the alternative toolset."
+ "Compile command with the alternative tool-set."
(interactive)
- (rst-compile 't))
+ (rst-compile t))
(defun rst-compile-pseudo-region ()
- "Show the pseudo-XML rendering of the current active region,
-or of the entire buffer, if the region is not selected."
+ "Show pseudo-XML rendering.
+Rendering is done of the current active region, or of the entire
+buffer, if the region is not selected."
+ ;; FIXME: The region should be given interactively.
(interactive)
(with-output-to-temp-buffer "*pseudoxml*"
(shell-command-on-region
(cadr (assq 'pseudoxml rst-compile-toolsets))
standard-output)))
+;; FIXME: Should be `defcustom`.
(defvar rst-pdf-program "xpdf"
"Program used to preview PDF files.")
(defun rst-compile-pdf-preview ()
"Convert the document to a PDF file and launch a preview program."
(interactive)
- (let* ((tmp-filename (make-temp-file "rst-out" nil ".pdf"))
- (command (format "%s %s %s && %s %s"
+ (let* ((tmp-filename (make-temp-file "rst_el" nil ".pdf"))
+ (command (format "%s %s %s && %s %s ; rm %s"
(cadr (assq 'pdf rst-compile-toolsets))
buffer-file-name tmp-filename
- rst-pdf-program tmp-filename)))
+ rst-pdf-program tmp-filename tmp-filename)))
(start-process-shell-command "rst-pdf-preview" nil command)
;; Note: you could also use (compile command) to view the compilation
;; output.
))
+;; FIXME: Should be `defcustom` or use something like `browse-url`.
(defvar rst-slides-program "firefox"
"Program used to preview S5 slides.")
(defun rst-compile-slides-preview ()
"Convert the document to an S5 slide presentation and launch a preview program."
(interactive)
- (let* ((tmp-filename (make-temp-file "rst-slides" nil ".html"))
- (command (format "%s %s %s && %s %s"
+ (let* ((tmp-filename (make-temp-file "rst_el" nil ".html"))
+ (command (format "%s %s %s && %s %s ; rm %s"
(cadr (assq 's5 rst-compile-toolsets))
buffer-file-name tmp-filename
- rst-slides-program tmp-filename)))
+ rst-slides-program tmp-filename tmp-filename)))
(start-process-shell-command "rst-slides-preview" nil command)
;; Note: you could also use (compile command) to view the compilation
;; output.
))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Imenu support.
+
+;; FIXME: Integrate this properly. Consider a key binding.
+
+;; Based on code from Masatake YAMATO <yamato@redhat.com>.
+
+(defun rst-imenu-find-adornments-for-position (adornments pos)
+ "Find adornments cell in ADORNMENTS for position POS."
+ (let ((a nil))
+ (while adornments
+ (if (and (car adornments)
+ (eq (car (car adornments)) pos))
+ (setq a adornments
+ adornments nil)
+ (setq adornments (cdr adornments))))
+ a))
+
+(defun rst-imenu-convert-cell (elt adornments)
+ "Convert a cell ELT in a tree returned from `rst-section-tree' to imenu index.
+ADORNMENTS is used as hint information for conversion."
+ (let* ((kar (car elt))
+ (kdr (cdr elt))
+ (title (car kar)))
+ (if kar
+ (let* ((p (marker-position (cadr kar)))
+ (adornments
+ (rst-imenu-find-adornments-for-position adornments p))
+ (a (car adornments))
+ (adornments (cdr adornments))
+ ;; FIXME: Overline adornment characters need to be in front so
+ ;; they become visible even for long title lines. May be
+ ;; an additional level number is also useful.
+ (title (format "%s%s%s"
+ (make-string (1+ (nth 3 a)) (nth 1 a))
+ title
+ (if (eq (nth 2 a) 'simple)
+ ""
+ (char-to-string (nth 1 a))))))
+ (cons title
+ (if (null kdr)
+ p
+ (cons
+ ;; A bit ugly but this make which-func happy.
+ (cons title p)
+ (mapcar (lambda (elt0)
+ (rst-imenu-convert-cell elt0 adornments))
+ kdr)))))
+ nil)))
+
+;; FIXME: Document title and subtitle need to be handled properly. They should
+;; get an own "Document" top level entry.
+(defun rst-imenu-create-index ()
+ "Create index for imenu.
+Return as described for `imenu--index-alist'."
+ (rst-reset-section-caches)
+ (let ((tree (rst-section-tree))
+ ;; Translate line notation to point notation.
+ (adornments (save-excursion
+ (mapcar (lambda (ln-ado)
+ (cons (progn
+ (goto-char (point-min))
+ (forward-line (1- (car ln-ado)))
+ ;; FIXME: Need to consider
+ ;; `imenu-use-markers' here?
+ (point))
+ (cdr ln-ado)))
+ (rst-find-all-adornments)))))
+ (delete nil (mapcar (lambda (elt)
+ (rst-imenu-convert-cell elt adornments))
+ tree))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
;; Generic text functions that are more convenient than the defaults.
-;;
+;; FIXME: Unbound command - should be bound or removed.
(defun rst-replace-lines (fromchar tochar)
- "Replace flush-left lines, consisting of multiple FROMCHAR characters,
-with equal-length lines of TOCHAR."
+ "Replace flush-left lines of FROMCHAR with equal-length lines of TOCHAR."
(interactive "\
cSearch for flush-left lines of char:
cand replace with char: ")
(save-excursion
- (let ((searchre (concat "^" (regexp-quote (string fromchar)) "+\\( *\\)$"))
+ (let ((searchre (rst-re "^" fromchar "+\\( *\\)$"))
(found 0))
(while (search-forward-regexp searchre nil t)
(setq found (1+ found))
(insert-char tochar width)))
(message (format "%d lines replaced." found)))))
+;; FIXME: Unbound command - should be bound or removed.
(defun rst-join-paragraph ()
"Join lines in current paragraph into one line, removing end-of-lines."
(interactive)
- (let ((fill-column 65000)) ; some big number
+ (let ((fill-column 65000)) ; Some big number.
(call-interactively 'fill-paragraph)))
+;; FIXME: Unbound command - should be bound or removed.
(defun rst-force-fill-paragraph ()
"Fill paragraph at point, first joining the paragraph's lines into one.
This is useful for filling list item paragraphs."
(fill-paragraph nil))
+;; FIXME: Unbound command - should be bound or removed.
;; Generic character repeater function.
;; For sections, better to use the specialized function above, but this can
;; be useful for creating separators.
-(defun rst-repeat-last-character (&optional tofill)
- "Fill the current line up to the length of the preceding line (if not
-empty), using the last character on the current line. If the preceding line is
-empty, we use the `fill-column'.
+(defun rst-repeat-last-character (use-next)
+ "Fill the current line using the last character on the current line.
+Fill up to the length of the preceding line or up to
+`fill-column' if preceding line is empty.
-If a prefix argument is provided, use the next line rather than the preceding
-line.
+If USE-NEXT, use the next line rather than the preceding line.
If the current line is longer than the desired length, shave the characters off
the current line to fit the desired length.
As an added convenience, if the command is repeated immediately, the alternative
column is used (fill-column vs. end of previous/next line)."
- (interactive)
+ (interactive "P")
(let* ((curcol (current-column))
(curline (+ (count-lines (point-min) (point))
- (if (eq curcol 0) 1 0)))
+ (if (zerop curcol) 1 0)))
(lbp (line-beginning-position 0))
- (prevcol (if (and (= curline 1) (not current-prefix-arg))
+ (prevcol (if (and (= curline 1) (not use-next))
fill-column
(save-excursion
- (forward-line (if current-prefix-arg 1 -1))
+ (forward-line (if use-next 1 -1))
(end-of-line)
(skip-chars-backward " \t" lbp)
(let ((cc (current-column)))
- (if (= cc 0) fill-column cc)))))
+ (if (zerop cc) fill-column cc)))))
(rightmost-column
- (cond (tofill fill-column)
- ((equal last-command 'rst-repeat-last-character)
+ (cond ((equal last-command 'rst-repeat-last-character)
(if (= curcol fill-column) prevcol fill-column))
(t (save-excursion
- (if (= prevcol 0) fill-column prevcol)))
- )) )
+ (if (zerop prevcol) fill-column prevcol))))))
(end-of-line)
(if (> (current-column) rightmost-column)
- ;; shave characters off the end
+ ;; Shave characters off the end.
(delete-region (- (point)
(- (current-column) rightmost-column))
(point))
- ;; fill with last characters
+ ;; Fill with last characters.
(insert-char (preceding-char)
- (- rightmost-column (current-column))))
- ))
+ (- rightmost-column (current-column))))))
+\f
-(defun rst-portable-mark-active-p ()
- "A portable function that returns non-nil if the mark is active."
- (cond
- ((fboundp 'region-active-p) (region-active-p))
- ((boundp 'transient-mark-mode) (and transient-mark-mode mark-active))
- (t mark-active)))
+;; LocalWords: docutils http sourceforge rst html wp svn svnroot txt reST regex
+;; LocalWords: regexes alist seq alt grp keymap abbrev overline overlines toc
+;; LocalWords: XML PNT propertized
+
+;; Local Variables:
+;; sentence-end-double-space: t
+;; End:
-\f
(provide 'rst)
;;; rst.el ends here
(eval-when-compile
(require 'skeleton)
- (require 'outline)
- (require 'cl))
+ (require 'cl-lib))
(defgroup sgml nil
"SGML editing mode."
;; for font-lock, but must be defvar'ed after
;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
(defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
- "*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.")
+ "Rules for highlighting SGML code. See also `sgml-tag-face-alist'.")
(defconst sgml-syntax-propertize-function
(syntax-propertize-rules
N defaults to -1, which means to wrap it around the current region.
If you like upcased tags, put (setq sgml-transformation-function 'upcase)
-in your `.emacs' file.
+in your init file.
Use \\[sgml-validate] to validate your document with an SGML parser.
\f
;; Parsing
-(defstruct (sgml-tag
+(cl-defstruct (sgml-tag
(:constructor sgml-make-tag (type start end name)))
type start end name)
(throw 'found (sgml-parse-tag-backward limit))))
(point))))
(goto-char (1+ tag-start))
- (case (char-after)
+ (pcase (char-after)
(?! (setq tag-type 'decl)) ; declaration
(?? (setq tag-type 'pi)) ; processing-instruction
(?% (setq tag-type 'jsp)) ; JSP tags
(forward-char 1)
(setq tag-type 'close
name (sgml-parse-tag-name)))
- (t ; open or empty tag
+ (_ ; open or empty tag
(setq tag-type 'open
name (sgml-parse-tag-name))
(if (or (eq ?/ (char-before (- tag-end 1)))
Depending on context, inserts a matching close-tag, or closes
the current start-tag or the current comment or the current cdata, ..."
(interactive)
- (case (car (sgml-lexical-context))
- (comment (insert " -->"))
- (cdata (insert "]]>"))
- (pi (insert " ?>"))
- (jsp (insert " %>"))
- (tag (insert " />"))
- (text
+ (pcase (car (sgml-lexical-context))
+ (`comment (insert " -->"))
+ (`cdata (insert "]]>"))
+ (`pi (insert " ?>"))
+ (`jsp (insert " %>"))
+ (`tag (insert " />"))
+ (`text
(let ((context (save-excursion (sgml-get-context))))
(if context
(progn
(insert "</" (sgml-tag-name (car (last context))) ">")
(indent-according-to-mode)))))
- (otherwise
+ (_
(error "Nothing to close"))))
(defun sgml-empty-tag-p (tag-name)
(save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
(setq lcon (cons 'comment (+ (cdr lcon) 2))))
- (case (car lcon)
+ (pcase (car lcon)
- (string
+ (`string
;; Go back to previous non-empty line.
(while (and (> (point) (cdr lcon))
(zerop (forward-line -1))
(goto-char (cdr lcon))
(1+ (current-column))))
- (comment
+ (`comment
(let ((mark (looking-at "--")))
;; Go back to previous non-empty line.
(while (and (> (point) (cdr lcon))
(current-column)))
;; We don't know how to indent it. Let's be honest about it.
- (cdata nil)
+ (`cdata nil)
;; We don't know how to indent it. Let's be honest about it.
- (pi nil)
+ (`pi nil)
- (tag
+ (`tag
(goto-char (1+ (cdr lcon)))
(skip-chars-forward "^ \t\n") ;Skip tag name.
(skip-chars-forward " \t")
(goto-char (1+ (cdr lcon)))
(+ (current-column) sgml-basic-offset)))
- (text
+ (`text
(while (looking-at "</")
(forward-sexp 1)
(skip-chars-forward " \t"))
(+ (current-column)
(* sgml-basic-offset (length context)))))))
- (otherwise
+ (_
(error "Unrecognized context %s" (car lcon)))
))
'((bold . "b")
(italic . "i")
(underline . "u")
- (modeline . "rev"))
+ (mode-line . "rev"))
"Value of `sgml-face-tag-alist' for HTML mode.")
(defvar html-tag-face-alist
("h5" . underline)
("h6" . underline)
("i" . italic)
- ("rev" . modeline)
+ ("rev" . mode-line)
("s" . underline)
("small" . default)
("strong" . bold)
("u")
("var")
("wbr" t)))
- "*Value of `sgml-tag-alist' for HTML mode.")
+ "Value of `sgml-tag-alist' for HTML mode.")
(defvar html-tag-help
`(,@sgml-tag-help
("ul" . "Unordered list")
("var" . "Math variable face")
("wbr" . "Enable <br> within <nobr>"))
- "*Value of `sgml-tag-help' for HTML mode.")
+ "Value of `sgml-tag-help' for HTML mode.")
+
+(defvar outline-regexp)
+(defvar outline-heading-end-regexp)
+(defvar outline-level)
\f
;;;###autoload
(defvar html-imenu-regexp
"\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
- "*A regular expression matching a head line to be added to the menu.
+ "A regular expression matching a head line to be added to the menu.
The first `match-string' should be a number from 1-9.
The second `match-string' matches extra tags and is ignored.
The third `match-string' will be the used in the menu.")
;; again.
;;
;; To use the package regularly place this file in the site library
-;; directory and add the next expression in your .emacs file. Make
+;; directory and add the next expression in your init file. Make
;; sure that directory is included in the `load-path'.
;;
;; (require 'table)
;; (function (lambda ()
;; (local-set-key [<key sequence>] '<function>))))
;;
-;; Above code is well known ~/.emacs idiom for customizing a mode
-;; specific keymap however it does not work for this package. This is
-;; because there is no table mode in effect. This package does not
-;; use a local map therefore you must modify `table-cell-map'
+;; Adding the above to your init file is a common way to customize a
+;; mode specific keymap. However it does not work for this package.
+;; This is because there is no table mode in effect. This package
+;; does not use a local map therefore you must modify `table-cell-map'
;; explicitly. The correct way of achieving above task is:
;;
;; (add-hook 'table-cell-map-hook
:group 'table)
(defface table-cell
- '((((min-colors 88) (class color))
- (:foreground "gray90" :background "blue1"))
- (((class color))
- (:foreground "gray90" :background "blue"))
- (t (:bold t)))
+ '((((min-colors 88) (class color)) :foreground "gray90" :background "blue1")
+ (((class color)) :foreground "gray90" :background "blue")
+ (t :weight bold))
"Face used for table cell contents."
:tag "Cell Face"
:group 'table)
(defvar table-disable-menu (null (and (locate-library "easymenu")
(require 'easymenu)
(fboundp 'easy-menu-add-item)))
- "*When non-nil, use of menu by table package is disabled.
+ "When non-nil, use of menu by table package is disabled.
It must be set before loading this package `table.el' for the first
time.")
;; Pacify the byte-compiler
(eval-when-compile
(require 'compare-w)
- (require 'cl)
+ (require 'cl-lib)
(require 'skeleton))
(defvar font-lock-comment-face)
tex shell terminates.")
(defvar tex-command "tex"
- "*Command to run TeX.
+ "Command to run TeX.
If this string contains an asterisk \(`*'\), that is replaced by the file name;
otherwise the value of `tex-start-options', the \(shell-quoted\)
value of `tex-start-commands', and the file name are added at the end
'("input" "include" "includeonly" "bibliography"
"epsfig" "psfig" "epsf" "nofiles" "usepackage"
"documentstyle" "documentclass" "verbatiminput"
- "includegraphics" "includegraphics*"
- "url" "nolinkurl")
+ "includegraphics" "includegraphics*")
t))
+ (verbish (regexp-opt '("url" "nolinkurl" "path") t))
;; Miscellany.
(slash "\\\\")
(opt " *\\(\\[[^]]*\\] *\\)*")
;; This would allow highlighting \newcommand\CMD but requires
;; adapting subgroup numbers below.
;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)"))
- (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
- (list
- ;; display $$ math $$
- ;; We only mark the match between $$ and $$ because the $$ delimiters
- ;; themselves have already been marked (along with $..$) by syntactic
- ;; fontification. Also this is done at the very beginning so as to
- ;; interact with the other keywords in the same way as $...$ does.
- (list "\\$\\$\\([^$]+\\)\\$\\$" 1 'tex-math-face)
- ;; Heading args.
- (list (concat slash headings "\\*?" opt arg)
- ;; If ARG ends up matching too much (if the {} don't match, e.g.)
- ;; jit-lock will do funny things: when updating the buffer
- ;; the re-highlighting is only done locally so it will just
- ;; match the local line, but defer-contextually will
- ;; match more lines at a time, so ARG will end up matching
- ;; a lot more, which might suddenly include a comment
- ;; so you get things highlighted bold when you type them
- ;; but they get turned back to normal a little while later
- ;; because "there's already a face there".
- ;; Using `keep' works around this un-intuitive behavior as well
- ;; as improves the behavior in the very rare case where you do
- ;; have a comment in ARG.
- 3 'font-lock-function-name-face 'keep)
- (list (concat slash "\\(?:provide\\|\\(?:re\\)?new\\)command\\** *\\(\\\\[A-Za-z@]+\\)")
- 1 'font-lock-function-name-face 'keep)
- ;; Variable args.
- (list (concat slash variables " *" arg) 2 'font-lock-variable-name-face)
- ;; Include args.
- (list (concat slash includes opt arg) 3 'font-lock-builtin-face)
- ;; Definitions. I think.
- '("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)"
+ (inbraces-re (lambda (re)
+ (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)")))
+ (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)")))
+ `( ;; Highlight $$math$$ and $math$.
+ ;; This is done at the very beginning so as to interact with the other
+ ;; keywords in the same way as comments and strings.
+ (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{"
+ (funcall inbraces-re
+ (concat "{" (funcall inbraces-re "{[^}]*}") "*}"))
+ "*}\\)+\\$?\\$")
+ (0 tex-math-face))
+ ;; Heading args.
+ (,(concat slash headings "\\*?" opt arg)
+ ;; If ARG ends up matching too much (if the {} don't match, e.g.)
+ ;; jit-lock will do funny things: when updating the buffer
+ ;; the re-highlighting is only done locally so it will just
+ ;; match the local line, but defer-contextually will
+ ;; match more lines at a time, so ARG will end up matching
+ ;; a lot more, which might suddenly include a comment
+ ;; so you get things highlighted bold when you type them
+ ;; but they get turned back to normal a little while later
+ ;; because "there's already a face there".
+ ;; Using `keep' works around this un-intuitive behavior as well
+ ;; as improves the behavior in the very rare case where you do
+ ;; have a comment in ARG.
+ 3 font-lock-function-name-face keep)
+ (,(concat slash "\\(?:provide\\|\\(?:re\\)?new\\)command\\** *\\(\\\\[A-Za-z@]+\\)")
+ 1 font-lock-function-name-face keep)
+ ;; Variable args.
+ (,(concat slash variables " *" arg) 2 font-lock-variable-name-face)
+ ;; Include args.
+ (,(concat slash includes opt arg) 3 font-lock-builtin-face)
+ ;; Verbatim-like args.
+ (,(concat slash verbish opt arg) 3 'tex-verbatim)
+ ;; Definitions. I think.
+ ("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)"
1 font-lock-function-name-face))))
"Subdued expressions to highlight in TeX modes.")
(1 (tex-font-lock-suscript (match-beginning 0)) append))))
"Experimental expressions to highlight in TeX modes.")
-(defvar tex-font-lock-keywords tex-font-lock-keywords-1
+(defconst tex-font-lock-keywords tex-font-lock-keywords-1
"Default expressions to highlight in TeX modes.")
(defvar tex-verbatim-environments
(set (make-local-variable 'font-lock-defaults)
'((tex-font-lock-keywords tex-font-lock-keywords-1
tex-font-lock-keywords-2 tex-font-lock-keywords-3)
- nil nil ((?$ . "\"")) nil
+ nil nil nil nil
;; Who ever uses that anyway ???
(font-lock-mark-block-function . mark-paragraph)
(font-lock-syntactic-face-function
(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 ()
(defvar latex-complete-bibtex-cache nil)
-(defun latex-string-prefix-p (str1 str2)
- (eq t (compare-strings str1 nil nil str2 0 (length str1))))
+(define-obsolete-function-alias 'latex-string-prefix-p
+ 'string-prefix-p "24.3")
(defvar bibtex-reference-key)
(declare-function reftex-get-bibfile-list "reftex-cite.el" ())
keys)
(if (and (eq (car latex-complete-bibtex-cache)
(reftex-get-bibfile-list))
- (latex-string-prefix-p (nth 1 latex-complete-bibtex-cache)
+ (string-prefix-p (nth 1 latex-complete-bibtex-cache)
key))
;; Use the cache.
(setq keys (nth 2 latex-complete-bibtex-cache))
(save-excursion
(let ((pt (point)))
(skip-chars-backward "^ {}\n\t\\\\")
- (case (char-before)
- ((nil ?\s ?\n ?\t ?\}) nil)
+ (pcase (char-before)
+ ((or `nil ?\s ?\n ?\t ?\}) nil)
(?\\
;; TODO: Complete commands.
nil)
"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))
(if (not (eq (char-syntax (preceding-char)) ?/))
(progn
;; Don't count single-char words.
- (unless (looking-at ".\\>") (incf count))
+ (unless (looking-at ".\\>") (cl-incf count))
(forward-char 1))
(let ((cmd
(buffer-substring-no-properties
(let* ((dir (file-name-directory tex-last-temp-file))
(list (and (file-directory-p dir)
(file-name-all-completions
- (file-name-sans-extension
- (file-name-nondirectory tex-last-temp-file))
+ (file-name-base tex-last-temp-file)
dir))))
(while list
(if not-all
OUT describes the output file and is either a %-escaped string
or nil to indicate that there is no output file.")
-;; defsubst* gives better byte-code than defsubst.
-(defsubst* tex-string-prefix-p (str1 str2)
- "Return non-nil if STR1 is a prefix of STR2"
- (eq t (compare-strings str2 nil (length str1) str1 nil nil)))
+(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'.
(with-current-buffer buf
(when (and (cond
((null all) (equal dir default-directory))
- ((eq all 'sub) (tex-string-prefix-p default-directory dir))
+ ((eq all 'sub) (string-prefix-p default-directory dir))
(t))
(stringp tex-main-file))
(throw 'found (expand-file-name tex-main-file)))))
(with-current-buffer buf
(when (and (cond
((null all) (equal dir default-directory))
- ((eq all 'sub) (tex-string-prefix-p default-directory dir))
+ ((eq all 'sub) (string-prefix-p default-directory dir))
(t))
buffer-file-name
;; (or (easy-mmode-derived-mode-p 'latex-mode)
"Syntax table used while computing indentation.")
(defun latex-indent (&optional arg)
- (if (and (eq (get-text-property (line-beginning-position) 'face)
+ (if (and (eq (get-text-property (if (and (eobp) (bolp))
+ (max (point-min) (1- (point)))
+ (line-beginning-position)) 'face)
'tex-verbatim))
'noindent
(with-syntax-table tex-latex-indent-syntax-table
(cons (append (car font-lock-defaults) '(doctex-font-lock-keywords))
(mapcar
(lambda (x)
- (case (car-safe x)
- (font-lock-syntactic-face-function
+ (pcase (car-safe x)
+ (`font-lock-syntactic-face-function
(cons (car x) 'doctex-font-lock-syntactic-face-function))
- (t x)))
+ (_ x)))
(cdr font-lock-defaults))))
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-rules doctex-syntax-propertize-rules)))
(@unnumberedsubsubsec . @unnumberedsubsec)
(@subsubheading . @subheading)
(@appendixsubsubsec . @appendixsubsec))
- "*An alist of next higher levels for chapters, sections, etc...
+ "An alist of next higher levels for chapters, sections, etc...
For example, section to chapter, subsection to section.
Used by `texinfo-raise-lower-sections'.
The keys specify types of section; the values correspond to the next
(@unnumberedsubsubsec . @unnumberedsubsubsec)
(@subsubheading . @subsubheading)
(@appendixsubsubsec . @appendixsubsubsec))
- "*An alist of next lower levels for chapters, sections, etc...
+ "An alist of next lower levels for chapters, sections, etc...
For example, chapter to section, section to subsection.
Used by `texinfo-raise-lower-sections'.
The keys specify types of section; the values correspond to the next
"done. Now save it." "done.")))))
(defvar texinfo-region-buffer-name "*Info Region*"
- "*Name of the temporary buffer used by \\[texinfo-format-region].")
+ "Name of the temporary buffer used by \\[texinfo-format-region].")
(defvar texinfo-pre-format-hook nil
"Hook called before the conversion of the Texinfo file to Info format.
;; Texinfo commands.
(defvar texinfo-extra-inter-column-width 0
- "*Number of extra spaces between entries (columns) in @multitable.")
+ "Number of extra spaces between entries (columns) in @multitable.")
(defvar texinfo-multitable-buffer-name "*multitable-temporary-buffer*")
(defvar texinfo-multitable-rectangle-name "texinfo-multitable-temp-")
("pg" . texinfo-format-pindex)
("ky" . texinfo-format-kindex)))
+\f
+;;; Sort and index
+
+;; Sort an index which is in the current buffer between START and END.
+(defun texinfo-sort-region (start end)
+ (require 'sort)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun)))
+
+;; Subroutine for sorting an index.
+;; At start of a line, return a string to sort the line under.
+(defun texinfo-sort-startkeyfun ()
+ (let ((line (buffer-substring-no-properties (point) (line-end-position))))
+ ;; Canonicalize whitespace and eliminate funny chars.
+ (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line)
+ (setq line (concat (substring line 0 (match-beginning 0))
+ " "
+ (substring line (match-end 0)))))
+ line))
+
\f
;;; @printindex
(insert "\n* Menu:\n\n")
(setq opoint (point))
(texinfo-print-index nil indexelts)
- (shell-command-on-region opoint (point) "sort -fd" 1)))
+ (texinfo-sort-region opoint (point))))
(defun texinfo-print-index (file indexelts)
(while indexelts
;;; Code:
-(eval-when-compile (require 'tex-mode) (require 'cl))
+(eval-when-compile (require 'tex-mode))
(defvar outline-heading-alist)
(defgroup texinfo nil
(3 . (concat "\\(^@\\)\\(" texinfo-section-level-regexp "\\)\\>[ \t]*"))
(4 . (concat "\\(^@\\)\\(" texinfo-subsection-level-regexp "\\)\\>[ \t]+"))
(5 . (concat "\\(^@\\)\\(" texinfo-subsubsection-level-regexp "\\)\\>[ \t]+")))
- "*Regexps for searching for same level sections in a Texinfo file.
+ "Regexps for searching for same level sections in a Texinfo file.
The keys are strings specifying the general hierarchical level in the
document; the values are regular expressions.")
"\\|"
texinfo-chapter-level-regexp
"\\)\\>[ \t]*\\)")))
- "*Regexps for searching for higher level sections in a Texinfo file.
+ "Regexps for searching for higher level sections in a Texinfo file.
The keys are strings specifying the general hierarchical level in the
document; the values are regular expressions.")
"\\)\\>[ \t]+\\)"))
;; There's nothing below 5, use a bogus regexp that can't match.
(5 . "a\\(^\\)"))
- "*Regexps for searching for lower level sections in a Texinfo file.
+ "Regexps for searching for lower level sections in a Texinfo file.
The keys are strings specifying the general hierarchical level in the
document; the values are regular expressions.")
;; try 32, but perhaps 24 is better
(defvar texinfo-column-for-description 32
- "*Column at which descriptions start in a Texinfo menu.")
+ "Column at which descriptions start in a Texinfo menu.")
(defun texinfo-insert-menu (menu-list node-name)
"Insert formatted menu at point.
(defgroup tildify nil
- "Adding missing hard spaces or other text fragments into texts."
+ "Add hard spaces or other text fragments to text buffers."
:version "21.1"
:group 'wp)
;;; Code:
-\f
+(defgroup two-column nil
+ "Minor mode for editing of two-column text."
+ :prefix "2C-"
+ :group 'frames)
+
+(defcustom 2C-mode-line-format
+ '("-%*- %15b --" (-3 . "%p") "--%[(" mode-name
+ minor-mode-alist "%n" mode-line-process ")%]%-")
+ "Value of `mode-line-format' for a buffer in two-column minor mode."
+ :type 'sexp
+ :group 'two-column)
+
+(defcustom 2C-other-buffer-hook 'text-mode
+ "Hook run in new buffer when it is associated with current one."
+ :type 'function
+ :group 'two-column)
-;; Lucid patch
-(or (fboundp 'frame-width)
- (fset 'frame-width 'screen-width))
+(defcustom 2C-separator ""
+ "A string inserted between the two columns when merging.
+This gets set locally by \\[2C-split]."
+ :type 'string
+ :group 'two-column)
+(put '2C-separator 'permanent-local t)
+
+(defcustom 2C-window-width 40
+ "The width of the first column. (Must be at least `window-min-width'.)
+This value is local for every buffer that sets it."
+ :type 'integer
+ :group 'two-column)
+(make-variable-buffer-local '2C-window-width)
+(put '2C-window-width 'permanent-local t)
+(defcustom 2C-beyond-fill-column 4
+ "Base for calculating `fill-column' for a buffer in two-column minor mode.
+The value of `fill-column' becomes `2C-window-width' for this buffer
+minus this value."
+ :type 'integer
+ :group 'two-column)
-;;;;; Set up keymap ;;;;;
+(defcustom 2C-autoscroll t
+ "If non-nil, Emacs attempts to keep the two column's buffers aligned."
+ :type 'boolean
+ :group 'two-column)
+\f
(defvar 2C-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "2" '2C-two-columns)
map)
"Keymap for commands for setting up two-column mode.")
-
-
;;;###autoload (autoload '2C-command "two-column" () t 'keymap)
(fset '2C-command 2C-mode-map)
;;;###autoload (global-set-key [f2] '2C-command)
-
(defvar 2C-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "1" '2C-merge)
map)
"Keymap for commands for use in two-column mode.")
-
(setq minor-mode-map-alist
(cons (cons '2C-mode
(let ((map (make-sparse-keymap)))
map (current-global-map))
map))
minor-mode-map-alist))
-\f
-;;;;; variable declarations ;;;;;
-
-(defgroup two-column nil
- "Minor mode for editing of two-column text."
- :prefix "2C-"
- :group 'frames)
-
+\f
;; Markers seem to be the only buffer-id not affected by renaming a buffer.
;; This nevertheless loses when a buffer is killed. The variable-name is
;; required by `describe-mode'.
(make-variable-buffer-local '2C-mode)
(put '2C-mode 'permanent-local t)
-
-
(setq minor-mode-alist (cons '(2C-mode " 2C") minor-mode-alist))
-
-
-;; rearranged, so that the pertinent info will show in 40 columns
-(defcustom 2C-mode-line-format
- '("-%*- %15b --" (-3 . "%p") "--%[(" mode-name
- minor-mode-alist "%n" mode-line-process ")%]%-")
- "Value of `mode-line-format' for a buffer in two-column minor mode."
- :type 'sexp
- :group 'two-column)
-
-
-(defcustom 2C-other-buffer-hook 'text-mode
- "Hook run in new buffer when it is associated with current one."
- :type 'function
- :group 'two-column)
-
-
-(defcustom 2C-separator ""
- "A string inserted between the two columns when merging.
-This gets set locally by \\[2C-split]."
- :type 'string
- :group 'two-column)
-(put '2C-separator 'permanent-local t)
-
-
-
-(defcustom 2C-window-width 40
- "The width of the first column. (Must be at least `window-min-width')
-This value is local for every buffer that sets it."
- :type 'integer
- :group 'two-column)
-(make-variable-buffer-local '2C-window-width)
-(put '2C-window-width 'permanent-local t)
-
-
-
-(defcustom 2C-beyond-fill-column 4
- "Base for calculating `fill-column' for a buffer in two-column minor mode.
-The value of `fill-column' becomes `2C-window-width' for this buffer
-minus this value."
- :type 'integer
- :group 'two-column)
-
-
-
-(defcustom 2C-autoscroll t
- "If non-nil, Emacs attempts to keep the two column's buffers aligned."
- :type 'boolean
- :group 'two-column)
-
-
-
(defvar 2C-autoscroll-start nil)
(make-variable-buffer-local '2C-autoscroll-start)
\f
(if req (error "You must first set two-column minor mode"))))
-
;; function for setting up two-column minor mode in a buffer associated
;; with the buffer pointed to by the marker other.
(defun 2C-mode (other)
\\[2C-merge] Merge both buffers
\\[2C-dissociate] Dissociate the two buffers
-These keybindings can be customized in your ~/.emacs by `2C-mode-map',
-`2C-minor-mode-map' and by binding `2C-command' to some prefix.
+These keybindings can be customized in your init file by
+`2C-mode-map', `2C-minor-mode-map' and by binding `2C-command' to
+some prefix.
The appearance of the screen can be customized by the variables
`2C-window-width', `2C-beyond-fill-column', `2C-mode-line-format' and
(run-hooks '2C-mode-hook))
-
;;;###autoload
(defun 2C-two-columns (&optional buffer)
"Split current window vertically for two-column editing.
(other-window -1)))))
-
;;;###autoload
(defun 2C-associate-buffer ()
"Associate another buffer with this one in two-column minor mode.
(let ((b1 (current-buffer))
(b2 (or (2C-other)
(read-buffer "Associate buffer: " (other-buffer)))))
- (save-excursion
- (setq 2C-mode nil)
- (set-buffer b2)
+ (setq 2C-mode nil)
+ (with-current-buffer b2
(and (2C-other)
(not (eq b1 (2C-other)))
(error "Buffer already associated with buffer `%s'"
(2C-two-columns b2)))
-
;;;###autoload
(defun 2C-split (arg)
"Split a two-column text at point, into two buffers in two-column minor mode.
(move-to-column column)))))
-
-
(defun 2C-dissociate ()
"Turn off two-column minor mode in current and associated buffer.
If the associated buffer is unmodified and empty, it is killed."
(interactive)
- (let ((buffer (current-buffer)))
- (save-excursion
- (and (2C-other)
- (set-buffer (2C-other))
- (or (not (2C-other))
- (eq buffer (2C-other)))
- (if (and (not (buffer-modified-p))
- (eobp) (bobp))
- (kill-buffer nil)
- (kill-local-variable '2C-mode)
- (kill-local-variable '2C-window-width)
- (kill-local-variable '2C-separator)
- (kill-local-variable 'mode-line-format)
- (kill-local-variable 'fill-column))))
- (kill-local-variable '2C-mode)
- (kill-local-variable '2C-window-width)
- (kill-local-variable '2C-separator)
- (kill-local-variable 'mode-line-format)
- (kill-local-variable 'fill-column)))
-
+ (let ((buffer (current-buffer))
+ (other (2C-other)))
+ (if other
+ (with-current-buffer other
+ (when (or (not (2C-other)) (eq buffer (2C-other)))
+ (if (and (not (buffer-modified-p)) (zerop (buffer-size)))
+ (kill-buffer)
+ (kill-local-variable '2C-mode)
+ (kill-local-variable '2C-window-width)
+ (kill-local-variable '2C-separator)
+ (kill-local-variable 'mode-line-format)
+ (kill-local-variable 'fill-column))))))
+ (kill-local-variable '2C-mode)
+ (kill-local-variable '2C-window-width)
+ (kill-local-variable '2C-separator)
+ (kill-local-variable 'mode-line-format)
+ (kill-local-variable 'fill-column)
+ (force-mode-line-update))
;; this doesn't use yank-rectangle, so that the first column can
(message "Autoscrolling is off.")))
-
(defun 2C-autoscroll ()
(if 2C-autoscroll
;; catch a mouse scroll on non-selected scrollbar
(select-window (car (car (cdr last-command-event)))))
;; In some cases scrolling causes an error, but post-command-hook
;; shouldn't, and should always stay in the original window
- (condition-case ()
- (and (or 2C-autoscroll-start (2C-toggle-autoscroll t) nil)
- (/= (window-start) 2C-autoscroll-start)
- (2C-other)
- (get-buffer-window (2C-other))
- (let ((lines (count-lines (window-start)
- 2C-autoscroll-start)))
- (if (< (window-start) 2C-autoscroll-start)
- (setq lines (- lines)))
- (setq 2C-autoscroll-start (window-start))
- (select-window (get-buffer-window (2C-other)))
- ;; make sure that other buffer has enough lines
- (save-excursion
- (insert-char
- ?\n (- lines (count-lines (window-start)
- (goto-char (point-max)))
- -1)))
- (scroll-up lines)
- (setq 2C-autoscroll-start (window-start))))
- (error))))))
-
+ (ignore-errors
+ (and (or 2C-autoscroll-start (2C-toggle-autoscroll t) nil)
+ (/= (window-start) 2C-autoscroll-start)
+ (2C-other)
+ (get-buffer-window (2C-other))
+ (let ((lines (count-lines (window-start)
+ 2C-autoscroll-start)))
+ (if (< (window-start) 2C-autoscroll-start)
+ (setq lines (- lines)))
+ (setq 2C-autoscroll-start (window-start))
+ (select-window (get-buffer-window (2C-other)))
+ ;; make sure that other buffer has enough lines
+ (save-excursion
+ (insert-char
+ ?\n (- lines (count-lines (window-start)
+ (goto-char (point-max)))
+ -1)))
+ (scroll-up lines)
+ (setq 2C-autoscroll-start (window-start)))))))))
(defun 2C-enlarge-window-horizontally (arg)
(2C-enlarge-window-horizontally (- arg)))
-
(provide 'two-column)
;;; two-column.el ends here
With prefix argument ARG, do it ARG times if positive, or move
backwards ARG times if negative."
(interactive "p")
+ (or arg (setq arg 1))
(while (< arg 0)
(skip-syntax-backward
(char-to-string (char-syntax (char-before))))
;; static char *ts = "sdmain.c Time-stamp: <2001-08-13 10:20:51 gildea>";
;; See the top of `time-stamp.el' for another example.
-;; To use time-stamping, add this line to your .emacs file:
+;; To use time-stamping, add this line to your init file:
;; (add-hook 'before-save-hook 'time-stamp)
;; Now any time-stamp templates in your files will be updated automatically.
(defun time-stamp ()
"Update the time stamp string(s) in the buffer.
A template in a file can be automatically updated with a new time stamp
-every time you save the file. Add this line to your .emacs file:
+every time you save the file. Add this line to your init file:
(add-hook 'before-save-hook 'time-stamp)
or customize `before-save-hook' through Custom.
Normally the template must appear in the first 8 lines of a file and
(seconds (substring time 17 19))
(time-zone (car (cdr (current-time-zone now))))
(day (substring time 8 10))
- (year (substring time 20 24))
+ (year (format-time-string "%Y" now))
(monthname (substring time 4 7))
(month
(cdr
(let ((list timer-list))
(while list
(let ((elt (pop list)))
- (when (equal (symbol-name (aref elt 5)) "display-time-world-timer")
+ (when (equal (symbol-name (timer--function elt))
+ "display-time-world-timer")
(cancel-timer elt)))))))
;;;###autoload
("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600)
("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900)
("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200))
- "*Time differentials of timezone from GMT in +-HHMM form.
+ "Time differentials of timezone from GMT in +-HHMM form.
This list is obsolescent, and is present only for backwards compatibility,
because time zone names are ambiguous in practice.
Use `current-time-zone' instead.")
;; tmm-km-list is an alist of (STRING . MEANING).
;; It has no other elements.
;; The order of elements in tmm-km-list is the order of the menu bar.
- (mapc (lambda (elt)
- (cond
- ((stringp elt) (setq gl-str elt))
- ((listp elt) (tmm-get-keymap elt not-menu))
- ((vectorp elt)
- (dotimes (i (length elt))
- (tmm-get-keymap (cons i (aref elt i)) not-menu)))))
- menu)
+ (dolist (elt menu)
+ (cond
+ ((stringp elt) (setq gl-str elt))
+ ((listp elt) (tmm-get-keymap elt not-menu))
+ ((vectorp elt)
+ (dotimes (i (length elt))
+ (tmm-get-keymap (cons i (aref elt i)) not-menu)))))
;; Choose an element of tmm-km-list; put it in choice.
(if (and not-menu (= 1 (length tmm-km-list)))
;; If this is the top-level of an x-popup-menu menu,
(- (* 2 history-len) index-of-default))))))))
(setq choice (cdr (assoc out tmm-km-list)))
(and (null choice)
- (> (length out) (length tmm-c-prompt))
- (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt)
+ (string-prefix-p tmm-c-prompt out)
(setq out (substring out (length tmm-c-prompt))
choice (cdr (assoc out tmm-km-list))))
(and (null choice) out
(defun tmm-define-keys (minibuffer)
(let ((map (make-sparse-keymap)))
(suppress-keymap map t)
- (mapc
- (lambda (c)
- (if (listp tmm-shortcut-style)
- (define-key map (char-to-string c) 'tmm-shortcut)
- ;; only one kind of letters are shortcuts, so map both upcase and
- ;; downcase input to the same
- (define-key map (char-to-string (downcase c)) 'tmm-shortcut)
- (define-key map (char-to-string (upcase c)) 'tmm-shortcut)))
- tmm-short-cuts)
+ (dolist (c tmm-short-cuts)
+ (if (listp tmm-shortcut-style)
+ (define-key map (char-to-string c) 'tmm-shortcut)
+ ;; only one kind of letters are shortcuts, so map both upcase and
+ ;; downcase input to the same
+ (define-key map (char-to-string (downcase c)) 'tmm-shortcut)
+ (define-key map (char-to-string (upcase c)) 'tmm-shortcut)))
(if minibuffer
(progn
(define-key map [pageup] 'tmm-goto-completions)
(use-local-map (append map (current-local-map))))))
(defun tmm-completion-delete-prompt ()
- (set-buffer standard-output)
+ (with-current-buffer standard-output
(goto-char (point-min))
- (delete-region (point) (search-forward "Possible completions are:\n")))
+ (delete-region (point) (search-forward "Possible completions are:\n"))))
(defun tmm-remove-inactive-mouse-face ()
"Remove the mouse-face property from inactive menu items."
(set-buffer-modified-p nil)))
(defun tmm-add-prompt ()
- (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t)
(unless tmm-c-prompt
(error "No active menu entries"))
(setq tmm-old-mb-map (tmm-define-keys t))
;; Get window and hide it for electric mode to get correct size
- (save-window-excursion
- (let ((completions
- (mapcar 'car minibuffer-completion-table)))
- (or tmm-completion-prompt
- (add-hook 'completion-setup-hook
- 'tmm-completion-delete-prompt 'append))
- (unwind-protect
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list completions))
- (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt)))
- (set-buffer "*Completions*")
+ (or tmm-completion-prompt
+ (add-hook 'completion-setup-hook
+ 'tmm-completion-delete-prompt 'append))
+ (unwind-protect
+ (minibuffer-completion-help)
+ (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt))
+ (with-current-buffer "*Completions*"
(tmm-remove-inactive-mouse-face)
(when tmm-completion-prompt
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (insert tmm-completion-prompt))))
- (save-selected-window
- (other-window 1) ; Electric-pop-up-window does
- ; not work in minibuffer
- (Electric-pop-up-window "*Completions*"))
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (insert tmm-completion-prompt))))
(insert tmm-c-prompt))
-(defun tmm-delete-map ()
- (remove-hook 'minibuffer-exit-hook 'tmm-delete-map t)
- (if tmm-old-mb-map
- (use-local-map tmm-old-mb-map)))
-
(defun tmm-shortcut ()
"Choose the shortcut that the user typed."
(interactive)
(choose-completion))
;; In minibuffer
(delete-region (minibuffer-prompt-end) (point-max))
- (mapc (lambda (elt)
- (if (string=
- (substring (car elt) 0
- (min (1+ (length tmm-mid-prompt))
- (length (car elt))))
- (concat (char-to-string c) tmm-mid-prompt))
- (setq s (car elt))))
- tmm-km-list)
+ (dolist (elt tmm-km-list)
+ (if (string=
+ (substring (car elt) 0
+ (min (1+ (length tmm-mid-prompt))
+ (length (car elt))))
+ (concat (char-to-string c) tmm-mid-prompt))
+ (setq s (car elt))))
(insert s)
(exit-minibuffer)))))
(progn
;; Otherwise, it is a prefix, so make a list of the subcommands.
;; Make a list of all the bindings in all the keymaps.
+ ;; FIXME: we'd really like to just use `key-binding' now that it
+ ;; returns a keymap that contains really all the bindings under that
+ ;; prefix, but `keyseq' is always [menu-bar], so the desired order of
+ ;; the bindings is difficult to recover.
(setq minorbind (mapcar 'cdr (minor-mode-key-binding keyseq)))
(setq localbind (local-key-binding keyseq))
(setq globalbind (copy-sequence (cdr (global-key-binding keyseq))))
(setq allbind (cons globalbind (cons localbind minorbind)))
;; Merge all the elements of ALLBIND into one keymap.
- (mapc (lambda (in)
- (if (and (symbolp in) (keymapp in))
- (setq in (symbol-function in)))
- (and in (keymapp in)
- (if (keymapp bind)
- (setq bind (nconc bind (copy-sequence (cdr in))))
- (setq bind (copy-sequence in)))))
- allbind)
+ (dolist (in allbind)
+ (if (and (symbolp in) (keymapp in))
+ (setq in (symbol-function in)))
+ (and in (keymapp in)
+ (setq bind (if (keymapp bind)
+ (nconc bind (copy-sequence (cdr in)))
+ (copy-sequence in)))))
;; Return that keymap.
bind))))
-;; Huh? What's that about? --Stef
-(add-hook 'calendar-load-hook (lambda () (require 'cal-menu)))
-
(provide 'tmm)
;;; tmm.el ends here
;;; Code:
+(require 'syntax)
+
(defvar comint-prompt-regexp)
(defgroup tooltip nil
\f
;;; Variables that are not customizable.
+(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
+
(defvar tooltip-functions nil
"Functions to call to display tooltips.
Each function is called with one argument EVENT which is a copy
functions displays the tooltip, it should return non-nil and the
rest are not called.")
-(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
-
(defvar tooltip-timeout-id nil
"The id of the timeout started when Emacs becomes idle.")
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)))))))
;;
;;; Code:
-(eval-when-compile (require 'cl))
(require 'wid-edit)
\f
;;; Customization
(not (get-text-property (match-beginning 1) 'tutorial-remark))
(let* ((desc (car changed-key))
(ck (cdr changed-key))
- (key (nth 0 ck))
(def-fun (nth 1 ck))
(where (nth 3 ck))
s1 s2 help-string)
saved-file
(error-message-string err))))
;; An error is raised here?? Is this a bug?
- (condition-case err
+ (condition-case nil
(undo-only)
(error nil))
;; Restore point
-;;; type-break.el --- encourage rests from typing at appropriate intervals
+;;; type-break.el --- encourage rests from typing at appropriate intervals -*- lexical-binding: t -*-
;; Copyright (C) 1994-1995, 1997, 2000-2012 Free Software Foundation, Inc.
:prefix "type-break"
:group 'keyboard)
-;;;###autoload
-(defcustom type-break-mode nil
- "Toggle typing break mode.
-See the docstring for the `type-break-mode' command for more information.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `type-break-mode'."
- :set (lambda (_symbol value)
- (type-break-mode (if value 1 -1)))
- :initialize 'custom-initialize-default
- :type 'boolean
- :group 'type-break
- :require 'type-break)
-
-;;;###autoload
(defcustom type-break-interval (* 60 60)
"Number of seconds between scheduled typing breaks."
:type 'integer
:group 'type-break)
-;;;###autoload
(defcustom type-break-good-rest-interval (/ type-break-interval 6)
"Number of seconds of idle time considered to be an adequate typing rest.
If a break is interrupted before this much time elapses, the user will be
asked whether or not really to interrupt the break."
+ :set-after '(type-break-interval)
:type 'integer
:group 'type-break)
-;;;###autoload
(defcustom type-break-good-break-interval nil
"Number of seconds considered to be an adequate explicit typing rest.
:type 'integer
:group 'type-break)
-;;;###autoload
(defcustom type-break-keystroke-threshold
;; Assuming typing speed is 35wpm (on the average, do you really
;; type more than that in a minute? I spend a lot of time reading mail
The command `type-break-guesstimate-keystroke-threshold' can be used to
guess a reasonably good pair of values for this variable."
+ :set-after '(type-break-interval)
:type 'sexp
:group 'type-break)
(""
type-break-mode-line-break-message
type-break-mode-line-warning))
- "*Format of messages in the mode line concerning typing breaks.")
+ "Format of messages in the mode line concerning typing breaks.")
(defvar type-break-mode-line-break-message
'(type-break-mode-line-break-message-p
\f
;;;###autoload
-(defun type-break-mode (&optional prefix)
+(define-minor-mode type-break-mode
"Enable or disable typing-break mode.
This is a minor mode, but it is global to all buffers by default.
across Emacs sessions. This provides recovery of the break status between
sessions and after a crash. Manual changes to the file may result in
problems."
- (interactive "P")
- (type-break-check-post-command-hook)
+ :lighter type-break-mode-line-format
+ :global t
- (let ((already-enabled type-break-mode))
- (setq type-break-mode (>= (prefix-numeric-value prefix) 0))
+ (type-break-check-post-command-hook)
- (cond
- ((and already-enabled type-break-mode)
- (and (called-interactively-p 'interactive)
- (message "Type Break mode is already enabled")))
- (type-break-mode
- (when type-break-file-name
- (with-current-buffer (find-file-noselect type-break-file-name 'nowarn)
- (setq buffer-save-without-query t)))
-
- (or global-mode-string
- (setq global-mode-string '("")))
- (or (assq 'type-break-mode-line-message-mode
- minor-mode-alist)
- (setq minor-mode-alist
- (cons type-break-mode-line-format
- minor-mode-alist)))
- (type-break-keystroke-reset)
- (type-break-mode-line-countdown-or-break nil)
-
- (setq type-break-time-last-break
- (or (type-break-get-previous-time)
- (current-time)))
-
- ;; schedule according to break time from session file
- (type-break-schedule
- (let (diff)
- (if (and type-break-time-last-break
- (< (setq diff (type-break-time-difference
- type-break-time-last-break
- (current-time)))
- type-break-interval))
- ;; use the file's value
- (progn
- (setq type-break-keystroke-count
- (type-break-get-previous-count))
- ;; file the time, in case it was read from the auto-save file
- (type-break-file-time type-break-interval-start)
- (setq type-break-interval-start type-break-time-last-break)
- (- type-break-interval diff))
- ;; schedule from now
- (setq type-break-interval-start (current-time))
- (type-break-file-time type-break-interval-start)
- type-break-interval))
- type-break-interval-start
- type-break-interval)
-
- (and (called-interactively-p 'interactive)
- (message "Type Break mode is enabled and set")))
- (t
- (type-break-keystroke-reset)
- (type-break-mode-line-countdown-or-break nil)
- (type-break-cancel-schedule)
- (do-auto-save)
- (when type-break-file-name
- (with-current-buffer (find-file-noselect type-break-file-name
- 'nowarn)
- (set-buffer-modified-p nil)
- (unlock-buffer)
- (kill-this-buffer)))
- (and (called-interactively-p 'interactive)
- (message "Type Break mode is disabled")))))
- type-break-mode)
+ (cond
+ ;; ((and already-enabled type-break-mode)
+ ;; (and (called-interactively-p 'interactive)
+ ;; (message "Type Break mode is already enabled")))
+ (type-break-mode
+ (when type-break-file-name
+ (with-current-buffer (find-file-noselect type-break-file-name 'nowarn)
+ (setq buffer-save-without-query t)))
+
+ (or global-mode-string (setq global-mode-string '(""))) ;FIXME: Why?
+ (type-break-keystroke-reset)
+ (type-break-mode-line-countdown-or-break nil)
+
+ (setq type-break-time-last-break
+ (or (type-break-get-previous-time)
+ (current-time)))
+
+ ;; Schedule according to break time from session file.
+ (type-break-schedule
+ (let (diff)
+ (if (and type-break-time-last-break
+ (< (setq diff (type-break-time-difference
+ type-break-time-last-break
+ (current-time)))
+ type-break-interval))
+ ;; Use the file's value.
+ (progn
+ (setq type-break-keystroke-count
+ (type-break-get-previous-count))
+ ;; File the time, in case it was read from the auto-save file.
+ (type-break-file-time type-break-interval-start)
+ (setq type-break-interval-start type-break-time-last-break)
+ (- type-break-interval diff))
+ ;; Schedule from now.
+ (setq type-break-interval-start (current-time))
+ (type-break-file-time type-break-interval-start)
+ type-break-interval))
+ type-break-interval-start
+ type-break-interval))
+ (t
+ (type-break-keystroke-reset)
+ (type-break-mode-line-countdown-or-break nil)
+ (type-break-cancel-schedule)
+ (do-auto-save)
+ (when type-break-file-name
+ (with-current-buffer (find-file-noselect type-break-file-name
+ 'nowarn)
+ (set-buffer-modified-p nil)
+ (unlock-buffer)
+ (kill-this-buffer))))))
(define-minor-mode type-break-mode-line-message-mode
"Toggle warnings about typing breaks in the mode line.
(unless type-break-terse-messages
(message "Press any key to resume from typing break."))
- (random t)
(let* ((len (length type-break-demo-functions))
(idx (random len))
(fn (nth idx type-break-demo-functions)))
;; "low" bits and format the time incorrectly.
(defun type-break-time-sum (&rest tmlist)
(let ((sum '(0 0 0)))
- (dolist (tem tmlist sum)
+ (dolist (tem tmlist)
(setq sum (time-add sum (if (integerp tem)
(list (floor tem 65536) (mod tem 65536))
- tem))))))
+ tem))))
+ sum))
(defun type-break-time-stamp (&optional when)
(if (fboundp 'format-time-string)
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; User-visible variables
;;; Utilities
;; uniquify-fix-list data structure
-(defstruct (uniquify-item
+(cl-defstruct (uniquify-item
(:constructor nil) (:copier nil)
(:constructor uniquify-make-item
(base dirname buffer &optional proposed)))
(defun uniquify-get-proposed-name (base dirname &optional depth)
(unless depth (setq depth uniquify-min-dir-content))
- (assert (equal (directory-file-name dirname) dirname)) ;No trailing slash.
+ (cl-assert (equal (directory-file-name dirname) dirname)) ;No trailing slash.
;; Distinguish directories by adding extra separator.
(if (and uniquify-trailing-separator-p
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-25 Chong Yidong <cyd@gnu.org>
- * Version 24.2 released.
+ * url-parse.el (url-recreate-url-attributes):
+ * url-util.el (url-generate-unique-filename): Use declare to mark
+ obsolete.
-2012-06-23 Leo Liu <sdl.web@gmail.com>
+2012-08-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url-http.el (url-http-parse-headers): Re-enable file-name-handlers
+ (bug#11981).
+
+2012-08-12 David Engster <deng@randomsample.de>
+
+ * 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 <jasonr@gnu.org>
+
+ * url-http.el (url-http-create-request): Use url-http-proxy to
+ look up proxy credentials (Bug#12069).
+
+2012-07-28 David Engster <deng@randomsample.de>
+
+ * 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
+ from XML before parsing. Change call to `xml-parse-region' to do
+ namespace expansion with simple qualified names (Bug#11916).
+ (url-dav-request): Add autoload.
+ (url-dav-directory-files): Properly deal with empty directories.
+ Unhex URL before generating relative URLs.
+ (url-dav-file-directory-p): Fix check for 'DAV:collection.
+
+2012-07-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url.el, url-queue.el, url-parse.el, url-http.el, url-future.el:
+ * url-dav.el, url-cookie.el: Use cl-lib.
+ * url-util.el, url-privacy.el, url-nfs.el, url-misc.el, url-methods.el:
+ * url-gw.el, url-file.el, url-expand.el: Dont use CL.
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * url-vars.el (mm-mime-mule-charset-alist, mm-coding-system-p):
+ Declare.
+
+2012-06-21 Chong Yidong <cyd@gnu.org>
+
+ * url.el (url-retrieve-internal): Fix last change (Bug#11627).
+
+2012-06-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * url-handlers.el (url-handler-regexp): Declare.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * url-handlers.el: Re-order file to avoid recursive load.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * url-handlers.el (url-handler-regexp):
+ * url-nfs.el (url-nfs-automounter-directory-spec):
+ * url-vars.el (url-load-hook): Convert to defcustom.
+
+2012-05-25 Leo Liu <sdl.web@gmail.com>
* url-http.el (url-http-codes): Fix mal-formed defconst.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-05-15 Ian Eure <ian@simplegeo.com>
+
+ * url-util.el (url-build-query-string): New function (Bug#8706).
+ (url-parse-query-string): Allow that '=' is not required and split
+ URL parameters on ';', not just '&'.
- * Version 24.1 released.
+2012-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-expand.el (url-default-expander): Copy over the fullness of
+ the new URL object based on the definition URL object.
+
+2012-05-10 Chong Yidong <cyd@gnu.org>
+
+ * 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
+ url-scheme-get-property.
+
+ * url-util.el (url-encode-url): Use url-path-and-query.
+
+ * url-vars.el (url-mime-charset-string): Load mm-util lazily.
+
+2012-05-09 Chong Yidong <cyd@gnu.org>
+
+ * url-util.el (url-encode-url): New function for URL quoting.
+ (url-encoding-table, url-host-allowed-chars)
+ (url-path-allowed-chars): New constants.
+ (url--allowed-chars): New helper function. Use upper-case.
+ (url-hexify-string): Use them.
+
+ * url-parse.el: Improve RFC 3986 conformance.
+ (url-generic-parse-url): Do not populate the ATTRIBUTES slot,
+ since this is not reliable for general RFC 3986 URIs. Keep the
+ whole path and query inside the FILENAME slot. Improve docstring.
+ (url-recreate-url-attributes): Mark as obsolete.
+ (url-recreate-url): Handle missing scheme and userinfo.
+ (url-path-and-query): New function.
+
+ * url-http.el (url-http-create-request): Ignore obsolete
+ attributes slot of url-object.
+
+ * url-vars.el (url-nonrelative-link): Make the regexp stricter.
+
+ * url.el (url-retrieve-internal): Use url-encode-url (Bug#7017).
+
+2012-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url.el (url-retrieve-synchronously): Replace lexical-let by
+ lexical-binding.
+
+2012-04-10 William Xu <william.xwl@gmail.com> (tiny change)
+
+ * url.el (url-retrieve-internal): Hexify multibye URL string first
+ when necessary (bug#7017).
+
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url.el (url-retrieve-internal): Mention utf-8 encoding.
+ (url-retrieve): Ditto.
+
+2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-domsurf.el: New file (bug#1401).
+
+ * url-cookie.el (url-cookie-two-dot-domains): Remove.
+ (url-cookie-host-can-set-p): Use `url-domsuf-cookie-allowed-p'
+ instead of the variable above.
2012-03-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
2012-03-11 Chong Yidong <cyd@gnu.org>
- * url-http.el (url-http-end-of-document-sentinel): Handle
- keepalive expiry by calling url-http again (Bug#10223).
+ * url-http.el (url-http-end-of-document-sentinel):
+ Handle keepalive expiry by calling url-http again (Bug#10223).
(url-http): New arg, for the above.
2012-03-11 Devon Sean McCullough <emacs-hacker2012@jovi.net>
* url-queue.el (url-queue-retrieve): Take an optional
`inhibit-cookies' parameter.
- * url.el (url-retrieve): Ditto
+ * url.el (url-retrieve): Ditto.
* url-http.el (url-http-create-request): Don't send cookies unless
requested.
2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * url-http.el (url-http-wait-for-headers-change-function): Remove
- pointless "HTTP/0.9 How I hate thee!" message (bug#6735).
+ * url-http.el (url-http-wait-for-headers-change-function):
+ Remove pointless "HTTP/0.9 How I hate thee!" message (bug#6735).
2011-06-04 Andreas Schwab <schwab@linux-m68k.org>
(require 'url-util)
(require 'url-parse)
+(require 'url-domsuf)
-(eval-when-compile (require 'cl)) ; defstruct
+(eval-when-compile (require 'cl-lib))
(defgroup url-cookie nil
"URL cookies."
;; A cookie is stored internally as a vector of 7 slots
;; [ url-cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
-(defstruct (url-cookie
+(cl-defstruct (url-cookie
(:constructor url-cookie-create)
(:copier nil)
(:type vector)
(concat retval "\r\n")
"")))
-(defvar url-cookie-two-dot-domains
- (concat "\\.\\("
- (mapconcat 'identity (list "com" "edu" "net" "org" "gov" "mil" "int")
- "\\|")
- "\\)$")
- "A regexp of top level domains that only require two matching
-'.'s in the domain name in order to set a cookie.")
-
(defcustom url-cookie-trusted-urls nil
"A list of regular expressions matching URLs to always accept cookies from."
:type '(repeat regexp)
:group 'url-cookie)
(defun url-cookie-host-can-set-p (host domain)
- (let ((numdots 0)
- (last nil)
- (case-fold-search t)
- (mindots 3))
- (while (setq last (string-match "\\." domain last))
- (setq numdots (1+ numdots)
- last (1+ last)))
- (if (string-match url-cookie-two-dot-domains domain)
- (setq mindots 2))
- (cond
- ((string= host domain) ; Apparently netscape lets you do this
- t)
- ((>= numdots mindots) ; We have enough dots in domain name
- ;; Need to check and make sure the host is actually _in_ the
- ;; domain it wants to set a cookie for though.
- (string-match (concat (regexp-quote
- ;; Remove the dot from wildcard domains
- ;; before matching.
- (if (eq ?. (aref domain 0))
- (substring domain 1)
- domain))
- "$") host))
- (t
- nil))))
+ (let ((last nil)
+ (case-fold-search t))
+ (if (string= host domain) ; Apparently netscape lets you do this
+ t
+ ;; Remove the dot from wildcard domains before matching.
+ (when (eq ?. (aref domain 0))
+ (setq domain (substring domain 1)))
+ (and (url-domsuf-cookie-allowed-p domain)
+ ;; Need to check and make sure the host is actually _in_ the
+ ;; domain it wants to set a cookie for though.
+ (string-match (concat (regexp-quote domain)
+ "$") host)))))
(defun url-cookie-handle-set-cookie (str)
(setq url-cookies-changed-since-last-save t)
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'xml)
(require 'url-util)
(defvar url-dav-supported-protocols '(1 2)
"List of supported DAV versions.")
+(defvar url-http-content-type)
+(defvar url-http-response-status)
+(defvar url-http-end-of-headers)
+
(defun url-intersection (l1 l2)
"Return a list of the elements occurring in both of the lists L1 and L2."
(if (null l2)
;;;###autoload
(defun url-dav-supported-p (url)
- (and (featurep 'xml)
- (fboundp 'xml-expand-namespace)
- (url-intersection url-dav-supported-protocols
- (plist-get (url-http-options url) 'dav))))
+ "Return WebDAV protocol version supported by URL.
+Returns nil if WebDAV is not supported."
+ (url-intersection url-dav-supported-protocols
+ (plist-get (url-http-options url) 'dav)))
(defun url-dav-node-text (node)
"Return the text data from the XML node NODE."
"unknown"))
value nil)
- (case node-type
- ((dateTime.iso8601tz
- dateTime.iso8601
- dateTime.tz
- dateTime.rfc1123
- dateTime
- date) ; date is our 'special' one...
+ (pcase node-type
+ ((or `dateTime.iso8601tz
+ `dateTime.iso8601
+ `dateTime.tz
+ `dateTime.rfc1123
+ `dateTime
+ `date) ; date is our 'special' one...
;; Some type of date/time string.
(setq value (url-dav-process-date-property node)))
- (int
+ (`int
;; Integer type...
(setq value (url-dav-process-integer-property node)))
- ((number float)
+ ((or `number `float)
(setq value (url-dav-process-number-property node)))
- (boolean
+ (`boolean
(setq value (url-dav-process-boolean-property node)))
- (uri
+ (`uri
(setq value (url-dav-process-uri-property node)))
- (otherwise
+ (_
(if (not (eq node-type 'unknown))
(url-debug 'dav "Unknown data type in url-dav-process-prop: %s"
node-type))
The buffer must have been retrieved by HTTP or HTTPS and contain an
XML document."
- (declare (special url-http-content-type
- url-http-response-status
- url-http-end-of-headers))
(let ((tree nil)
(overall-status nil))
(when buffer
(unwind-protect
(with-current-buffer buffer
+ ;; First remove all indentation and line endings
(goto-char url-http-end-of-headers)
+ (indent-rigidly (point) (point-max) -1000)
+ (save-excursion
+ (while (re-search-forward "\r?\n" nil t)
+ (replace-match "")))
(setq overall-status url-http-response-status)
;; XML documents can be transferred as either text/xml or
url-http-content-type
(string-match "\\`\\(text\\|application\\)/xml"
url-http-content-type))
- (setq tree (xml-parse-region (point) (point-max)))))
+ (setq tree (xml-parse-region (point) (point-max) nil nil 'symbol-qnames))))
;; Clean up after ourselves.
(kill-buffer buffer)))
;; nobody but us needs to know the difference.
(list (cons url properties))))))
+;;;###autoload
(defun url-dav-request (url method tag body
&optional depth headers namespaces)
"Perform WebDAV operation METHOD on URL. Return the parsed responses.
\f
;;; Locking support
(defvar url-dav-lock-identifier (concat "mailto:" user-mail-address)
- "*URL used as contact information when creating locks in DAV.
+ "URL used as contact information when creating locks in DAV.
This will be used as the contents of the DAV:owner/DAV:href tag to
identify the owner of a LOCK when requesting it. This will be shown
to other users when the DAV:lockdiscovery property is requested, so
(defun url-dav-unlock-resource (url lock-token)
"Release the lock on URL represented by LOCK-TOKEN.
Returns t if the lock was successfully released."
- (declare (special url-http-response-status))
(let* ((url-request-extra-headers (list (cons "Lock-Token"
(concat "<" lock-token ">"))))
(url-request-method "UNLOCK")
(while supported-locks
(setq lock (car supported-locks)
supported-locks (cdr supported-locks))
- (case (car lock)
- (DAV:write
- (case (cdr lock)
- (DAV:shared ; group permissions (possibly world)
+ (pcase (car lock)
+ (`DAV:write
+ (pcase (cdr lock)
+ (`DAV:shared ; group permissions (possibly world)
(aset modes 5 ?w))
- (DAV:exclusive
+ (`DAV:exclusive
(aset modes 2 ?w)) ; owner permissions?
- (otherwise
+ (_
(url-debug 'dav "Unrecognized DAV:lockscope (%S)" (cdr lock)))))
- (otherwise
+ (_
(url-debug 'dav "Unrecognized DAV:locktype (%S)" (car lock)))))
modes))
"Save OBJ as URL using WebDAV.
URL must be a fully qualified URL.
OBJ may be a buffer or a string."
- (declare (special url-http-response-status))
(let ((buffer nil)
(result nil)
(url-request-extra-headers nil)
(defun url-dav-directory-files (url &optional full match nosort files-only)
"Return a list of names of files in URL.
There are three optional arguments:
-If FULL is non-nil, return absolute file names. Otherwise return names
- that are relative to the specified directory.
+If FULL is non-nil, return absolute URLs. Otherwise return names
+ that are relative to the specified URL.
If MATCH is non-nil, mention only file names that match the regexp MATCH.
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
NOSORT is useful if you plan to sort the result yourself."
(files nil)
(parsed-url (url-generic-parse-url url)))
- (if (= (length properties) 1)
- (signal 'file-error (list "Opening directory" "not a directory" url)))
+ (when (and (= (length properties) 1)
+ (not (url-dav-file-directory-p url)))
+ (signal 'file-error (list "Opening directory" "not a directory" url)))
(while properties
(setq child-props (pop properties)
;; are not supposed to return fully-qualified names.
(setq child-url (url-expand-file-name child-url parsed-url))
(if (not full)
- (setq child-url (substring child-url (length url))))
+ ;; Parts of the URL might be hex'ed.
+ (setq child-url (substring (url-unhex-string child-url)
+ (length url))))
;; We don't want '/' as the last character in filenames...
(if (string-match "/$" child-url)
(defun url-dav-file-directory-p (url)
"Return t if URL names an existing DAV collection."
(let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype)))))
- (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection)))
+ (when (member 'DAV:collection (plist-get properties 'DAV:resourcetype))
+ t)))
(defun url-dav-make-directory (url &optional parents)
"Create the directory DIR and any nonexistent parent dirs."
- (declare (special url-http-response-status))
(let* ((url-request-extra-headers nil)
(url-request-method "MKCOL")
(url-request-data nil)
(when buffer
(unwind-protect
(with-current-buffer buffer
- (case url-http-response-status
+ (pcase url-http-response-status
(201 ; Collection created in its entirety
(setq result t))
(403 ; Forbidden
nil)
(507 ; Insufficient storage
nil)
- (otherwise
+ (_
nil)))
(kill-buffer buffer)))
result))
(setq failed t)))
(if failed
(setq searching nil)
- (incf n)))
+ (cl-incf n)))
(substring (car matches) 0 n))))))
(defun url-dav-register-handler (op)
--- /dev/null
+;;; url-domsuf.el --- Say what domain names can have cookies set.
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+;; Keywords: comm, data, processes, hypermedia
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The rules for what domains can have cookies set is defined here:
+;; http://publicsuffix.org/list/
+
+;;; Code:
+
+(defvar url-domsuf-domains nil)
+
+(defun url-domsuf-parse-file ()
+ (with-temp-buffer
+ (insert-file-contents
+ (expand-file-name "publicsuffix.txt" data-directory))
+ (let ((domains nil)
+ domain exception)
+ (while (not (eobp))
+ (when (not (looking-at "[/\n\t ]"))
+ ;; !pref.aichi.jp means that it's allowed.
+ (if (not (eq (following-char) ?!))
+ (setq exception nil)
+ (setq exception t)
+ (forward-char 1))
+ (setq domain (buffer-substring (point) (line-end-position)))
+ (cond
+ ((string-match "\\`\\*\\." domain)
+ (setq domain (substring domain 2))
+ (push (cons domain (1+ (length (split-string domain "[.]"))))
+ domains))
+ (exception
+ (push (cons domain t) domains))
+ (t
+ (push (cons domain nil) domains))))
+ (forward-line 1))
+ (setq url-domsuf-domains (nreverse domains)))))
+
+(defun url-domsuf-cookie-allowed-p (domain)
+ (unless url-domsuf-domains
+ (url-domsuf-parse-file))
+ (let* ((allowedp t)
+ (domain-bits (split-string domain "[.]"))
+ (length (length domain-bits))
+ (upper-domain (mapconcat 'identity (cdr domain-bits) "."))
+ entry modifier)
+ (dolist (elem url-domsuf-domains)
+ (setq entry (car elem)
+ modifier (cdr elem))
+ (cond
+ ;; "com"
+ ((and (null modifier)
+ (string= domain entry))
+ (setq allowedp nil))
+ ;; "!pref.hokkaido.jp"
+ ((and (eq modifier t)
+ (string= domain entry))
+ (setq allowedp t))
+ ;; "*.ar"
+ ((and (numberp modifier)
+ (= length modifier)
+ (string= entry upper-domain))
+ (setq allowedp nil))))
+ allowedp))
+
+;; Tests:
+
+;; (url-domsuf-cookie-allowed-p "com") => nil
+;; (url-domsuf-cookie-allowed-p "foo.bar.ar") => t
+;; (url-domsuf-cookie-allowed-p "bar.ar") => nil
+;; (url-domsuf-cookie-allowed-p "co.uk") => nil
+;; (url-domsuf-cookie-allowed-p "foo.bar.hokkaido.jo") => t
+;; (url-domsuf-cookie-allowed-p "bar.hokkaido.jp") => nil
+;; (url-domsuf-cookie-allowed-p "pref.hokkaido.jp") => t
+
+(provide 'url-domsuf)
+
+;;; url-domsuf.el ends here
(require 'url-methods)
(require 'url-util)
(require 'url-parse)
-(eval-when-compile (require 'cl))
(defun url-expander-remove-relative-links (name)
;; Strip . and .. from pathnames
(setf (url-port urlobj) (or (url-port urlobj)
(and (string= (url-type urlobj)
(url-type defobj))
- (url-port defobj))))
+ (url-port defobj))))
(if (not (string= "file" (url-type urlobj)))
(setf (url-host urlobj) (or (url-host urlobj) (url-host defobj))))
(if (string= "ftp" (url-type urlobj))
(setf (url-user urlobj) (or (url-user urlobj) (url-user defobj))))
(if (string= (url-filename urlobj) "")
(setf (url-filename urlobj) "/"))
+ ;; If the object we're expanding from is full, then we are now
+ ;; full.
+ (unless (url-fullness urlobj)
+ (setf (url-fullness urlobj) (url-fullness defobj)))
(if (string-match "^/" (url-filename urlobj))
nil
(let ((query nil)
;;; Code:
-(eval-when-compile (require 'cl))
(require 'mailcap)
(require 'url-vars)
(require 'url-parse)
filename))
(setq content-type (mailcap-extension-to-mime
(url-file-extension uncompressed-filename))
- content-encoding (case (intern (url-file-extension filename))
- ((\.z \.gz) "gzip")
- (\.Z "compress")
- (\.uue "x-uuencoded")
- (\.hqx "x-hqx")
- (\.bz2 "x-bzip2")
- (otherwise nil)))
+ content-encoding (pcase (url-file-extension filename)
+ ((or ".z" ".gz") "gzip")
+ (".Z" "compress")
+ (".uue" "x-uuencoded")
+ (".hqx" "x-hqx")
+ (".bz2" "x-bzip2")
+ (_ nil)))
(if (file-directory-p filename)
;; A directory is done the same whether we are local or remote
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
-(defstruct url-future callback errorback status value)
+(cl-defstruct url-future callback errorback status value)
(defmacro url-future-done-p (url-future)
`(url-future-status ,url-future))
;;; Code:
-(eval-when-compile (require 'cl))
(require 'url-vars)
;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program?
;; right coding systems in both Emacs and XEmacs.
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
- (setq conn (case gw-method
- ((tls ssl native)
+ (setq conn (pcase gw-method
+ ((or `tls `ssl `native)
(if (eq gw-method 'native)
(setq gw-method 'plain))
(open-network-stream
;; Use non-blocking socket if we can.
:nowait (featurep 'make-network-process
'(:nowait t))))
- (socks
+ (`socks
(socks-open-network-stream name buffer host service))
- (telnet
+ (`telnet
(url-open-telnet name buffer host service))
- (rlogin
+ (`rlogin
(url-open-rlogin name buffer host service))
- (otherwise
+ (_
(error "Bad setting of url-gateway-method: %s"
url-gateway-method))))))
conn)))
;; verify-visited-file-modtime
;; write-region
-(defvar url-handler-regexp
- "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
- "*A regular expression for matching URLs handled by `file-name-handler-alist'.
-Some valid URL protocols just do not make sense to visit interactively
-\(about, data, info, irc, mailto, etc\). This regular expression
-avoids conflicts with local files that look like URLs \(Gnus is
-particularly bad at this\).")
+(defvar url-handler-regexp) ; defined below to avoid recursive load (revno:108572)
;;;###autoload
(define-minor-mode url-handler-mode
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil."
:global t :group 'url
- (if (not (boundp 'file-name-handler-alist))
- ;; Can't be turned ON anyway.
- (setq url-handler-mode nil)
- ;; Remove old entry, if any.
- (setq file-name-handler-alist
- (delq (rassq 'url-file-handler file-name-handler-alist)
- file-name-handler-alist))
- (if url-handler-mode
- (push (cons url-handler-regexp 'url-file-handler)
- file-name-handler-alist))))
+ ;; Remove old entry, if any.
+ (setq file-name-handler-alist
+ (delq (rassq 'url-file-handler file-name-handler-alist)
+ file-name-handler-alist))
+ (if url-handler-mode
+ (push (cons url-handler-regexp 'url-file-handler)
+ file-name-handler-alist)))
+
+(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
+ "Regular expression for URLs handled by `url-handler-mode'.
+When URL Handler mode is enabled, this regular expression is
+added to `file-name-handler-alist'.
+
+Some valid URL protocols just do not make sense to visit
+interactively \(about, data, info, irc, mailto, etc\). This
+regular expression avoids conflicts with local files that look
+like URLs \(Gnus is particularly bad at this\)."
+ :group 'url
+ :type 'regexp
+ :set (lambda (symbol value)
+ (let ((enable url-handler-mode))
+ (url-handler-mode 0)
+ (set-default symbol value)
+ (if enable
+ (url-handler-mode)))))
(defun url-run-real-handler (operation args)
(let ((inhibit-file-name-handlers (cons 'url-file-handler
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
+(defvar url-callback-arguments)
+(defvar url-callback-function)
+(defvar url-current-object)
+(defvar url-http-after-change-function)
+(defvar url-http-chunked-counter)
+(defvar url-http-chunked-length)
+(defvar url-http-chunked-start)
+(defvar url-http-connection-opened)
+(defvar url-http-content-length)
+(defvar url-http-content-type)
+(defvar url-http-data)
+(defvar url-http-end-of-headers)
(defvar url-http-extra-headers)
-(defvar url-http-target-url)
+(defvar url-http-method)
(defvar url-http-no-retry)
+(defvar url-http-process)
(defvar url-http-proxy)
-(defvar url-http-connection-opened)
+(defvar url-http-response-status)
+(defvar url-http-response-version)
+(defvar url-http-target-url)
+(defvar url-http-transfer-encoding)
+(defvar url-http-end-of-headers)
+(defvar url-show-status)
+
(require 'url-gw)
(require 'url-util)
(require 'url-parse)
(defun url-http-create-request (&optional ref-url)
"Create an HTTP request for `url-http-target-url', referred to by REF-URL."
- (declare (special proxy-info
- url-http-method url-http-data
- url-http-extra-headers))
(let* ((extra-headers)
(request nil)
(no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))
nil
(let ((url-basic-auth-storage
'url-http-proxy-basic-auth-storage))
- (url-get-authentication url-http-target-url nil 'any nil))))
- (real-fname (concat (url-filename url-http-target-url)
- (url-recreate-url-attributes url-http-target-url)))
+ (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))
nil
"Remove trailing \r from header lines.
This allows us to use `mail-fetch-field', etc.
Return the number of characters removed."
- (declare (special url-http-end-of-headers))
(let ((end (marker-position url-http-end-of-headers)))
(goto-char (point-min))
(while (re-search-forward "\r$" url-http-end-of-headers t)
(replace-match ""))
(- end url-http-end-of-headers)))
+(defvar status)
+(defvar success)
+
(defun url-http-handle-authentication (proxy)
- (declare (special status success url-http-method url-http-data
- url-callback-function url-callback-arguments))
(url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
(let ((auths (or (nreverse
(mail-fetch-field
(defun url-http-parse-response ()
"Parse just the response code."
- (declare (special url-http-end-of-headers url-http-response-status
- url-http-response-version))
(if (not url-http-end-of-headers)
(error "Trying to parse HTTP response code in odd buffer: %s" (buffer-name)))
(url-http-debug "url-http-parse-response called in (%s)" (buffer-name))
should be shown to the user."
;; The comments after each status code handled are taken from RFC
;; 2616 (HTTP/1.1)
- (declare (special url-http-end-of-headers url-http-response-status
- url-http-response-version
- url-http-method url-http-data url-http-process
- url-callback-function url-callback-arguments))
-
(url-http-mark-connection-as-free (url-host url-current-object)
(url-port url-current-object)
url-http-process)
(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))
- (case class
+ (pcase class
;; Classes of response codes
;;
;; 5xx = Server Error
;; 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
;; 205 Reset content
;; 206 Partial content
;; 207 Multi-status (Added by DAV)
- (case status-symbol
- ((no-content reset-content)
+ (pcase status-symbol
+ ((or `no-content `reset-content)
;; No new data, just stay at the same document
(url-mark-buffer-as-dead buffer)
(setq success t))
- (otherwise
+ (_
;; Generic success for all others. Store in the cache, and
;; mark it as successful.
(widen)
;; 307 Temporary redirect
(let ((redirect-uri (or (mail-fetch-field "Location")
(mail-fetch-field "URI"))))
- (case status-symbol
- (multiple-choices ; 300
+ (pcase status-symbol
+ (`multiple-choices ; 300
;; Quoth the spec (section 10.3.1)
;; -------------------------------
;; The requested resource corresponds to any one of a set of
;; We do not support agent-driven negotiation, so we just
;; redirect to the preferred URI if one is provided.
nil)
- ((moved-permanently found temporary-redirect) ; 301 302 307
+ ((or `moved-permanently `found `temporary-redirect) ; 301 302 307
;; If the 301|302 status code is received in response to a
;; request other than GET or HEAD, the user agent MUST NOT
;; automatically redirect the request unless it can be
;; conditions under which the request was issued.
(unless (member url-http-method '("HEAD" "GET"))
(setq redirect-uri nil)))
- (see-other ; 303
+ (`see-other ; 303
;; The response to the request can be found under a different
;; URI and SHOULD be retrieved using a GET method on that
;; resource.
(setq url-http-method "GET"
url-http-data nil))
- (not-modified ; 304
+ (`not-modified ; 304
;; The 304 response MUST NOT contain a message-body.
(url-http-debug "Extracting document from cache... (%s)"
(url-cache-create-filename (url-view-url t)))
(url-cache-extract (url-cache-create-filename (url-view-url t)))
(setq redirect-uri nil
success t))
- (use-proxy ; 305
+ (`use-proxy ; 305
;; The requested resource MUST be accessed through the
;; proxy given by the Location field. The Location field
;; gives the URI of the proxy. The recipient is expected
;; responses MUST only be generated by origin servers.
(error "Redirection thru a proxy server not supported: %s"
redirect-uri))
- (otherwise
+ (_
;; Treat everything like '300'
nil))
(when redirect-uri
;; 422 Unprocessable Entity (Added by DAV)
;; 423 Locked
;; 424 Failed Dependency
- (case status-symbol
- (unauthorized ; 401
+ (pcase status-symbol
+ (`unauthorized ; 401
;; The request requires user authentication. The response
;; MUST include a WWW-Authenticate header field containing a
;; challenge applicable to the requested resource. The
;; client MAY repeat the request with a suitable
;; Authorization header field.
(url-http-handle-authentication nil))
- (payment-required ; 402
+ (`payment-required ; 402
;; This code is reserved for future use
(url-mark-buffer-as-dead buffer)
(error "Somebody wants you to give them money"))
- (forbidden ; 403
+ (`forbidden ; 403
;; The server understood the request, but is refusing to
;; fulfill it. Authorization will not help and the request
;; SHOULD NOT be repeated.
(setq success t))
- (not-found ; 404
+ (`not-found ; 404
;; Not found
(setq success t))
- (method-not-allowed ; 405
+ (`method-not-allowed ; 405
;; The method specified in the Request-Line is not allowed
;; for the resource identified by the Request-URI. The
;; response MUST include an Allow header containing a list of
;; valid methods for the requested resource.
(setq success t))
- (not-acceptable ; 406
+ (`not-acceptable ; 406
;; The resource identified by the request is only capable of
;; generating response entities which have content
;; characteristics not acceptable according to the accept
;; headers sent in the request.
(setq success t))
- (proxy-authentication-required ; 407
+ (`proxy-authentication-required ; 407
;; This code is similar to 401 (Unauthorized), but indicates
;; that the client must first authenticate itself with the
;; proxy. The proxy MUST return a Proxy-Authenticate header
;; field containing a challenge applicable to the proxy for
;; the requested resource.
(url-http-handle-authentication t))
- (request-timeout ; 408
+ (`request-timeout ; 408
;; The client did not produce a request within the time that
;; the server was prepared to wait. The client MAY repeat
;; the request without modifications at any later time.
(setq success t))
- (conflict ; 409
+ (`conflict ; 409
;; The request could not be completed due to a conflict with
;; the current state of the resource. This code is only
;; allowed in situations where it is expected that the user
;; information for the user to recognize the source of the
;; conflict.
(setq success t))
- (gone ; 410
+ (`gone ; 410
;; The requested resource is no longer available at the
;; server and no forwarding address is known.
(setq success t))
- (length-required ; 411
+ (`length-required ; 411
;; The server refuses to accept the request without a defined
;; Content-Length. The client MAY repeat the request if it
;; adds a valid Content-Length header field containing the
;; `url-http-create-request' automatically calculates the
;; content-length.
(setq success t))
- (precondition-failed ; 412
+ (`precondition-failed ; 412
;; The precondition given in one or more of the
;; request-header fields evaluated to false when it was
;; tested on the server.
(setq success t))
- ((request-entity-too-large request-uri-too-large) ; 413 414
+ ((or `request-entity-too-large `request-uri-too-large) ; 413 414
;; The server is refusing to process a request because the
;; request entity|URI is larger than the server is willing or
;; able to process.
(setq success t))
- (unsupported-media-type ; 415
+ (`unsupported-media-type ; 415
;; The server is refusing to service the request because the
;; entity of the request is in a format not supported by the
;; requested resource for the requested method.
(setq success t))
- (requested-range-not-satisfiable ; 416
+ (`requested-range-not-satisfiable ; 416
;; A server SHOULD return a response with this status code if
;; a request included a Range request-header field, and none
;; of the range-specifier values in this field overlap the
;; current extent of the selected resource, and the request
;; did not include an If-Range request-header field.
(setq success t))
- (expectation-failed ; 417
+ (`expectation-failed ; 417
;; The expectation given in an Expect request-header field
;; could not be met by this server, or, if the server is a
;; proxy, the server has unambiguous evidence that the
;; request could not be met by the next-hop server.
(setq success t))
- (otherwise
+ (_
;; The request could not be understood by the server due to
;; malformed syntax. The client SHOULD NOT repeat the
;; request without modifications.
;; 505 HTTP version not supported
;; 507 Insufficient storage
(setq success t)
- (case url-http-response-status
- (not-implemented ; 501
+ (pcase url-http-response-status
+ (`not-implemented ; 501
;; The server does not support the functionality required to
;; fulfill the request.
nil)
- (bad-gateway ; 502
+ (`bad-gateway ; 502
;; The server, while acting as a gateway or proxy, received
;; an invalid response from the upstream server it accessed
;; in attempting to fulfill the request.
nil)
- (service-unavailable ; 503
+ (`service-unavailable ; 503
;; The server is currently unable to handle the request due
;; to a temporary overloading or maintenance of the server.
;; The implication is that this is a temporary condition
;; header. If no Retry-After is given, the client SHOULD
;; handle the response as it would for a 500 response.
nil)
- (gateway-timeout ; 504
+ (`gateway-timeout ; 504
;; The server, while acting as a gateway or proxy, did not
;; receive a timely response from the upstream server
;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other
;; auxiliary server (e.g. DNS) it needed to access in
;; attempting to complete the request.
nil)
- (http-version-not-supported ; 505
+ (`http-version-not-supported ; 505
;; The server does not support, or refuses to support, the
;; HTTP protocol version that was used in the request
;; message.
nil)
- (insufficient-storage ; 507 (DAV)
+ (`insufficient-storage ; 507 (DAV)
;; The method could not be performed on the resource
;; because the server is unable to store the representation
;; needed to successfully complete the request. This
(setf (car url-callback-arguments)
(nconc (list :error (list 'error 'http url-http-response-status))
(car url-callback-arguments)))))
- (otherwise
+ (_
(error "Unknown class of HTTP response code: %d (%d)"
class url-http-response-status)))
(if (not success)
;; Miscellaneous
(defun url-http-activate-callback ()
"Activate callback specified when this buffer was created."
- (declare (special url-http-process
- url-callback-function
- url-callback-arguments))
(url-http-mark-connection-as-free (url-host url-current-object)
(url-port url-current-object)
url-http-process)
(defun url-http-simple-after-change-function (st nd length)
;; Function used when we do NOT know how long the document is going to be
;; Just _very_ simple 'downloaded %d' type of info.
- (declare (special url-http-end-of-headers))
(url-lazy-message "Reading %s..." (url-pretty-length nd)))
(defun url-http-content-length-after-change-function (st nd length)
More sophisticated percentage downloaded, etc.
Also does minimal parsing of HTTP headers and will actually cause
the callback to be triggered."
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-length
- url-http-content-type
- url-http-process))
(if url-http-content-type
(url-display-percentage
"Reading [%s]... %s of %s (%d%%)"
Cannot give a sophisticated percentage, but we need a different
function to look for the special 0-length chunk that signifies
the end of the document."
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-type
- url-http-chunked-length
- url-http-chunked-counter
- url-http-process url-http-chunked-start))
(save-excursion
(goto-char st)
(let ((read-next-chunk t)
(defun url-http-wait-for-headers-change-function (st nd length)
;; This will wait for the headers to arrive and then splice in the
;; next appropriate after-change-function, etc.
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-type
- url-http-content-length
- url-http-transfer-encoding
- url-callback-function
- url-callback-arguments
- url-http-process
- url-http-method
- url-http-after-change-function
- url-http-response-status))
(url-http-debug "url-http-wait-for-headers-change-function (%s)"
(buffer-name))
(let ((end-of-headers nil)
Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
previous `url-http' call, which is being re-attempted."
- (check-type url vector "Need a pre-parsed URL.")
- (declare (special url-current-object
- url-http-end-of-headers
- url-http-content-type
- url-http-content-length
- url-http-transfer-encoding
- url-http-after-change-function
- url-callback-function
- url-callback-arguments
- url-show-status
- url-http-method
- url-http-extra-headers
- url-http-data
- url-http-chunked-length
- url-http-chunked-start
- url-http-chunked-counter
- url-http-process))
+ (cl-check-type url vector "Need a pre-parsed URL.")
(let* ((host (url-host (or url-using-proxy url)))
(port (url-port (or url-using-proxy url)))
(connection (url-http-find-free-connection host port))
(buffer (or retry-buffer
- (generate-new-buffer (format " *http %s:%d*" host port)))))
+ (generate-new-buffer
+ (format " *http %s:%d*" host port)))))
(if (not connection)
;; Failed to open the connection for some reason
(progn
;; Asynchronous connection failed
(error "Could not create connection to %s:%d" host port))
(t
- (set-process-sentinel connection 'url-http-end-of-document-sentinel)
+ (set-process-sentinel connection
+ 'url-http-end-of-document-sentinel)
(process-send-string connection (url-http-create-request)))))))
buffer))
(defun url-http-async-sentinel (proc why)
- (declare (special url-callback-arguments))
;; We are performing an asynchronous connection, and a status change
;; has occurred.
(when (buffer-name (process-buffer proc))
;; Sometimes we get a zero-length data chunk after the process has
;; been changed to 'free', which means it has no buffer associated
;; with it. Do nothing if there is no buffer, or 0 length data.
- (declare (special url-http-after-change-function))
(and (process-buffer proc)
(/= (length data) 0)
(with-current-buffer (process-buffer proc)
("facsimiletelephonenumber" . "Fax")
("postaladdress" . "Mailing Address")
("description" . "Notes"))
- "*An assoc list mapping LDAP attribute names to pretty descriptions of them.")
+ "An assoc list mapping LDAP attribute names to pretty descriptions of them.")
(defvar url-ldap-attribute-formatters
'(("mail" . (lambda (x) (format "<a href='mailto:%s'>%s</a>" x x)))
("namingcontexts" . url-ldap-dn-formatter)
("defaultnamingcontext" . url-ldap-dn-formatter)
("member" . url-ldap-dn-formatter))
- "*An assoc list mapping LDAP attribute names to pretty formatters for them.")
+ "An assoc list mapping LDAP attribute names to pretty formatters for them.")
(defsubst url-ldap-attribute-pretty-name (n)
(or (cdr-safe (assoc (downcase n) url-ldap-pretty-names)) n))
;;; Code:
-(eval-when-compile
- (require 'cl))
-
;; This loads up some of the small, silly URLs that I really don't
;; want to bother putting in their own separate files.
(require 'url-parse)
;; Store any proxying information - this will not overwrite an old
;; entry, so that people can still set this information in their
- ;; .emacs file
+ ;; init file
(cond
(cur-proxy nil) ; Keep their old settings
((null env-proxy) nil) ; No proxy setup
(let ((symbol (intern-soft (format "%s-%s" stub (car cell))))
(type (cdr cell)))
(if symbol
- (case type
- (function
+ (pcase type
+ (`function
;; Store the symbol name of a function
(if (fboundp symbol)
(setq desc (plist-put desc (car cell) symbol))))
- (variable
+ (`variable
;; Store the VALUE of a variable
(if (boundp symbol)
(setq desc (plist-put desc (car cell)
(symbol-value symbol)))))
- (otherwise
+ (_
(error "Malformed url-scheme-methods entry: %S"
cell))))))
(puthash scheme desc url-scheme-registry)))))
;;; Code:
-(eval-when-compile (require 'cl))
(require 'url-vars)
(require 'url-parse)
(autoload 'Info-goto-node "info" "" t)
(defun url-do-terminal-emulator (type server port user)
(terminal-emulator
(generate-new-buffer (format "%s%s" (if user (concat user "@") "") server))
- (case type
- (rlogin "rlogin")
- (telnet "telnet")
- (tn3270 "tn3270")
- (otherwise
+ (pcase type
+ (`rlogin "rlogin")
+ (`telnet "telnet")
+ (`tn3270 "tn3270")
+ (_
(error "Unknown terminal emulator required: %s" type)))
- (case type
- (rlogin
+ (pcase type
+ (`rlogin
(if user
(list server "-l" user)
(list server)))
- (telnet
+ (`telnet
(if user (message "Please log in as user: %s" user))
(if port
(list server port)
(list server)))
- (tn3270
+ (`tn3270
(if user (message "Please log in as user: %s" user))
(list server)))))
;;; Code:
-(eval-when-compile (require 'cl))
(require 'url-parse)
(require 'url-file)
-(defvar url-nfs-automounter-directory-spec
- "file:/net/%h%f"
- "*How to invoke the NFS automounter. Certain % sequences are recognized.
+(defcustom url-nfs-automounter-directory-spec "file:/net/%h%f"
+ "How to invoke the NFS automounter. Certain % sequences are recognized.
%h -- the hostname of the NFS server
%n -- the port # of the NFS server
%f -- the filename on the remote server
%% -- a literal %
-Each can be used any number of times.")
+Each can be used any number of times."
+ :group 'url
+ :type 'string)
(defun url-nfs-unescape (format host port user pass file)
(with-current-buffer (get-buffer-create " *nfs-parse*")
(while (re-search-forward "%\\(.\\)" nil t)
(let ((escape (aref (match-string 1) 0)))
(replace-match "" t t)
- (case escape
+ (pcase escape
(?% (insert "%"))
(?h (insert host))
(?n (insert (or port "")))
(require 'url-vars)
(require 'auth-source)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(autoload 'url-scheme-get-property "url-methods")
-(defstruct (url
+(cl-defstruct (url
(:constructor nil)
(:constructor url-parse-make-urlobj
(&optional type user password host portspec filename
silent (use-cookies t))
(defsubst url-port (urlobj)
+ "Return the port number for the URL specified by URLOBJ."
+ (declare (gv-setter (lambda (port) `(setf (url-portspec ,urlobj) ,port))))
(or (url-portspec urlobj)
- (if (url-fullness urlobj)
+ (if (url-type urlobj)
(url-scheme-get-property (url-type urlobj) 'default-port))))
-(defsetf url-port (urlobj) (port) `(setf (url-portspec ,urlobj) ,port))
+
+(defun url-path-and-query (urlobj)
+ "Return the path and query components of URLOBJ.
+These two components are store together in the FILENAME slot of
+the object. The return value of this function is (PATH . QUERY),
+where each of PATH and QUERY are strings or nil."
+ (let ((name (url-filename urlobj))
+ path query)
+ (when name
+ (if (string-match "\\?" name)
+ (setq path (substring name 0 (match-beginning 0))
+ query (substring name (match-end 0)))
+ (setq path name)))
+ (if (equal path "") (setq path nil))
+ (if (equal query "") (setq query nil))
+ (cons path query)))
+
+(defun url-port-if-non-default (urlobj)
+ "Return the port number specified by URLOBJ, if it is not the default.
+If the specified port number is the default, return nil."
+ (let ((port (url-portspec urlobj))
+ type)
+ (and port
+ (or (null (setq type (url-type urlobj)))
+ (not (equal port (url-scheme-get-property type 'default-port))))
+ port)))
;;;###autoload
(defun url-recreate-url (urlobj)
"Recreate a URL string from the parsed URLOBJ."
- (concat (url-type urlobj) ":" (if (url-host urlobj) "//" "")
- (if (url-user urlobj)
- (concat (url-user urlobj)
- (if (url-password urlobj)
- (concat ":" (url-password urlobj)))
- "@"))
- (url-host urlobj)
- (if (and (url-port urlobj)
- (not (equal (url-port urlobj)
- (url-scheme-get-property (url-type urlobj) 'default-port))))
- (format ":%d" (url-port urlobj)))
- (or (url-filename urlobj) "/")
- (url-recreate-url-attributes urlobj)
- (if (url-target urlobj)
- (concat "#" (url-target urlobj)))))
+ (let* ((type (url-type urlobj))
+ (user (url-user urlobj))
+ (pass (url-password urlobj))
+ (host (url-host urlobj))
+ ;; RFC 3986: "omit the port component and its : delimiter if
+ ;; port is empty or if its value would be the same as that of
+ ;; the scheme's default."
+ (port (url-port-if-non-default urlobj))
+ (file (url-filename urlobj))
+ (frag (url-target urlobj)))
+ (concat (if type (concat type ":"))
+ (if (url-fullness urlobj) "//")
+ (if (or user pass)
+ (concat user
+ (if pass (concat ":" pass))
+ "@"))
+ host
+ (if port (format ":%d" (url-port urlobj)))
+ (or file "/")
+ (if frag (concat "#" frag)))))
(defun url-recreate-url-attributes (urlobj)
"Recreate the attributes of an URL string from the parsed URLOBJ."
+ (declare (obsolete nil "24.3"))
(when (url-attributes urlobj)
(concat ";"
(mapconcat (lambda (x)
(defun url-generic-parse-url (url)
"Return an URL-struct of the parts of URL.
The CL-style struct contains the following fields:
-TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS."
- ;; See RFC 3986.
- (cond
- ((null url)
- (url-parse-make-urlobj))
- ((or (not (string-match url-nonrelative-link url))
- (= ?/ (string-to-char url)))
- ;; This isn't correct, as a relative URL can be a fragment link
- ;; (e.g. "#foo") and many other things (see section 4.2).
- ;; However, let's not fix something that isn't broken, especially
- ;; when close to a release.
- (url-parse-make-urlobj nil nil nil nil nil url))
- (t
+
+TYPE is the URI scheme (string or nil).
+USER is the user name (string or nil).
+PASSWORD is the password (string [deprecated] or nil).
+HOST is the host (a registered name, IP literal in square
+ brackets, or IPv4 address in dotted-decimal form).
+PORTSPEC is the specified port (a number), or nil.
+FILENAME is the path AND the query component of the URI.
+TARGET is the fragment identifier component (used to refer to a
+ subordinate resource, e.g. a part of a webpage).
+ATTRIBUTES is nil; this slot originally stored the attribute and
+ value alists for IMAP URIs, but this feature was removed
+ since it conflicts with RFC 3986.
+FULLNESS is non-nil iff the hierarchical sequence component of
+ the URL starts with two slashes, \"//\".
+
+The parser follows RFC 3986, except that it also tries to handle
+URIs that are not fully specified (e.g. lacking TYPE), and it
+does not check for or perform %-encoding.
+
+Here is an example. The URL
+
+ foo://bob:pass@example.com:42/a/b/c.dtb?type=animal&name=narwhal#nose
+
+parses to
+
+ TYPE = \"foo\"
+ USER = \"bob\"
+ PASSWORD = \"pass\"
+ HOST = \"example.com\"
+ PORTSPEC = 42
+ FILENAME = \"/a/b/c.dtb?type=animal&name=narwhal\"
+ TARGET = \"nose\"
+ ATTRIBUTES = nil
+ FULLNESS = t"
+ (if (null url)
+ (url-parse-make-urlobj)
(with-temp-buffer
;; Don't let those temp-buffer modifications accidentally
;; deactivate the mark of the current-buffer.
(let ((deactivate-mark nil))
(set-syntax-table url-parse-syntax-table)
- (let ((save-pos nil)
- (prot nil)
- (user nil)
- (pass nil)
- (host nil)
- (port nil)
- (file nil)
- (refs nil)
- (attr nil)
- (full nil)
+ (erase-buffer)
+ (insert url)
+ (goto-char (point-min))
+ (let ((save-pos (point))
+ scheme user pass host port file fragment full
(inhibit-read-only t))
- (erase-buffer)
- (insert url)
- (goto-char (point-min))
- (setq save-pos (point))
;; 3.1. Scheme
- (unless (looking-at "//")
- (skip-chars-forward "a-zA-Z+.\\-")
- (downcase-region save-pos (point))
- (setq prot (buffer-substring save-pos (point)))
- (skip-chars-forward ":")
- (setq save-pos (point)))
+ ;; This is nil for a URI that is not fully specified.
+ (when (looking-at "\\([a-zA-Z][-a-zA-Z0-9+.]*\\):")
+ (goto-char (match-end 0))
+ (setq save-pos (point))
+ (setq scheme (downcase (match-string 1))))
;; 3.2. Authority
(when (looking-at "//")
(setq full t)
(forward-char 2)
(setq save-pos (point))
- (skip-chars-forward "^/")
+ (skip-chars-forward "^/?#")
(setq host (buffer-substring save-pos (point)))
+ ;; 3.2.1 User Information
(if (string-match "^\\([^@]+\\)@" host)
(setq user (match-string 1 host)
- host (substring host (match-end 0) nil)))
- (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user))
+ host (substring host (match-end 0))))
+ (if (and user (string-match "\\`\\([^:]*\\):\\(.*\\)" user))
(setq pass (match-string 2 user)
user (match-string 1 user)))
- ;; This gives wrong results for IPv6 literal addresses.
- (if (string-match ":\\([0-9+]+\\)" host)
- (setq port (string-to-number (match-string 1 host))
- host (substring host 0 (match-beginning 0))))
- (if (string-match ":$" host)
- (setq host (substring host 0 (match-beginning 0))))
- (setq host (downcase host)
- save-pos (point)))
-
- (if (not port)
- (setq port (url-scheme-get-property prot 'default-port)))
-
- ;; 3.3. Path
- ;; Gross hack to preserve ';' in data URLs
+ (cond
+ ;; IPv6 literal address.
+ ((string-match "^\\(\\[[^]]+\\]\\)\\(?::\\([0-9]*\\)\\)?$" host)
+ (setq port (match-string 2 host)
+ host (match-string 1 host)))
+ ;; Registered name or IPv4 address.
+ ((string-match ":\\([0-9]*\\)$" host)
+ (setq port (match-string 1 host)
+ host (substring host 0 (match-beginning 0)))))
+ (cond ((equal port "")
+ (setq port nil))
+ (port
+ (setq port (string-to-number port))))
+ (setq host (downcase host)))
+
+ ;; Now point is on the / ? or # which terminates the
+ ;; authority, or at the end of the URI, or (if there is no
+ ;; authority) at the beginning of the absolute path.
+
(setq save-pos (point))
+ (if (string= "data" scheme)
+ ;; For the "data" URI scheme, all the rest is the FILE.
+ (setq file (buffer-substring save-pos (point-max)))
+ ;; For hysterical raisins, our data structure returns the
+ ;; path and query components together in one slot.
+ ;; 3.3. Path
+ (skip-chars-forward "^?#")
+ ;; 3.4. Query
+ (when (looking-at "?")
+ (skip-chars-forward "^#"))
+ (setq file (buffer-substring save-pos (point)))
+ ;; 3.5 Fragment
+ (when (looking-at "#")
+ (let ((opoint (point)))
+ (forward-char 1)
+ (unless (eobp)
+ (setq fragment (buffer-substring (point) (point-max))))
+ (delete-region opoint (point-max)))))
- ;; 3.4. Query
- (if (string= "data" prot)
- (goto-char (point-max))
- ;; Now check for references
- (skip-chars-forward "^#")
- (if (eobp)
- nil
- (delete-region
- (point)
- (progn
- (skip-chars-forward "#")
- (setq refs (buffer-substring (point) (point-max)))
- (point-max))))
- (goto-char save-pos)
- (skip-chars-forward "^;")
- (unless (eobp)
- (setq attr (url-parse-args (buffer-substring (point) (point-max))
- t)
- attr (nreverse attr))))
-
- (setq file (buffer-substring save-pos (point)))
(if (and host (string-match "%[0-9][0-9]" host))
(setq host (url-unhex-string host)))
- (url-parse-make-urlobj
- prot user pass host port file refs attr full)))))))
+ (url-parse-make-urlobj scheme user pass host port file
+ fragment nil full))))))
(defmacro url-bit-for-url (method lookfor url)
`(let* ((urlobj (url-generic-parse-url url))
;;; Code:
-(eval-when-compile (require 'cl))
(require 'url-vars)
(defun url-device-type (&optional device)
((memq (url-device-type) '(win32 w32)) "Windows; 32bit")
((eq (url-device-type) 'pm) "OS/2; 32bit")
(t
- (case (url-device-type)
- (x "X11")
- (ns "OpenStep")
- (tty "TTY")
- (otherwise nil)))))
+ (pcase (url-device-type)
+ (`x "X11")
+ (`ns "OpenStep")
+ (`tty "TTY")
+ (_ nil)))))
(setq url-personal-mail-address (or url-personal-mail-address
user-mail-address
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'browse-url)
(require 'url-parse)
(defvar url-queue nil)
-(defstruct url-queue
+(cl-defstruct url-queue
url callback cbargs silentp
buffer start-time pre-triggered
inhibit-cookiesp)
(cond
((or (url-queue-start-time entry)
(url-queue-pre-triggered entry))
- (incf running))
+ (cl-incf running))
((not waiting)
(setq waiting entry))))
(when (and waiting
(dolist (entry url-queue)
(cond
((url-queue-start-time entry)
- (incf running))
+ (cl-incf running))
((not waiting)
(setq waiting entry))))
(when (and waiting
(require 'url-parse)
(require 'url-vars)
-(eval-when-compile (require 'cl))
(autoload 'timezone-parse-date "timezone")
(autoload 'timezone-make-date-arpa-standard "timezone")
(autoload 'mail-header-extract "mailheader")
(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)
(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)
(let (retval pairs cur key val)
- (setq pairs (split-string query "&"))
+ (setq pairs (split-string query "[;&]"))
(while pairs
(setq cur (car pairs)
pairs (cdr pairs))
- (if (not (string-match "=" cur))
- nil ; Grace
- (setq key (url-unhex-string (substring cur 0 (match-beginning 0))
- allow-newlines))
- (setq val (url-unhex-string (substring cur (match-end 0) nil)
- allow-newlines))
- (if downcase
- (setq key (downcase key)))
- (setq cur (assoc key retval))
- (if cur
- (setcdr cur (cons val (cdr cur)))
- (setq retval (cons (list key val) retval)))))
+ (unless (string-match "=" cur)
+ (setq cur (concat cur "=")))
+
+ (when (string-match "=" cur)
+ (setq key (url-unhex-string (substring cur 0 (match-beginning 0))
+ allow-newlines))
+ (setq val (url-unhex-string (substring cur (match-end 0) nil)
+ allow-newlines))
+ (if downcase
+ (setq key (downcase key)))
+ (setq cur (assoc key retval))
+ (if cur
+ (setcdr cur (cons val (cdr cur)))
+ (setq retval (cons (list key val) retval)))))
retval))
+;;;###autoload
+(defun url-build-query-string (query &optional semicolons keep-empty)
+ "Build a query-string.
+
+Given a QUERY in the form:
+'((key1 val1)
+ (key2 val2)
+ (key3 val1 val2)
+ (key4)
+ (key5 ""))
+
+\(This is the same format as produced by `url-parse-query-string')
+
+This will return a string
+\"key1=val1&key2=val2&key3=val1&key3=val2&key4&key5\". Keys may
+be strings or symbols; if they are symbols, the symbol name will
+be used.
+
+When SEMICOLONS is given, the separator will be \";\".
+
+When KEEP-EMPTY is given, empty values will show as \"key=\"
+instead of just \"key\" as in the example above."
+ (mapconcat
+ (lambda (key-vals)
+ (let ((escaped
+ (mapcar (lambda (sym)
+ (url-hexify-string (format "%s" sym))) key-vals)))
+ (mapconcat (lambda (val)
+ (let ((vprint (format "%s" val))
+ (eprint (format "%s" (car escaped))))
+ (concat eprint
+ (if (or keep-empty
+ (and val (not (zerop (length vprint)))))
+ "="
+ "")
+ vprint)))
+ (or (cdr escaped) '("")) (if semicolons ";" "&"))))
+ query (if semicolons ";" "&")))
+
(defun url-unhex (x)
(if (> x ?9)
(if (>= x ?a)
" ")
(t (byte-to-string code))))
str (substring str (match-end 0)))))
- (setq tmp (concat tmp str))
- tmp))
+ (concat tmp str)))
(defconst url-unreserved-chars
- '(
- ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
+ '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
- ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
- "A list of characters that are _NOT_ reserved in the URL spec.
-This is taken from RFC 2396.")
+ ?- ?_ ?. ?~)
+ "List of characters that are unreserved in the URL spec.
+This is taken from RFC 3986 (section 2.3).")
+
+(defconst url-encoding-table
+ (let ((vec (make-vector 256 nil)))
+ (dotimes (byte 256)
+ ;; RFC 3986 (Section 2.1): For consistency, URI producers and
+ ;; normalizers should use uppercase hexadecimal digits for all
+ ;; percent-encodings.
+ (aset vec byte (format "%%%02X" byte)))
+ vec)
+ "Vector translating bytes to URI-encoded %-sequences.")
+
+(defun url--allowed-chars (char-list)
+ "Return an \"allowed character\" mask (a 256-slot vector).
+The Nth element is non-nil if character N is in CHAR-LIST. The
+result can be passed as the second arg to `url-hexify-string'."
+ (let ((vec (make-vector 256 nil)))
+ (dolist (byte char-list)
+ (ignore-errors (aset vec byte t)))
+ vec))
;;;###autoload
-(defun url-hexify-string (string)
- "Return a new string that is STRING URI-encoded.
-First, STRING is converted to utf-8, if necessary. Then, for each
-character in the utf-8 string, those found in `url-unreserved-chars'
-are left as-is, all others are represented as a three-character
-string: \"%\" followed by two lowercase hex digits."
- ;; To go faster and avoid a lot of consing, we could do:
- ;;
- ;; (defconst url-hexify-table
- ;; (let ((map (make-vector 256 nil)))
- ;; (dotimes (byte 256) (aset map byte
- ;; (if (memq byte url-unreserved-chars)
- ;; (char-to-string byte)
- ;; (format "%%%02x" byte))))
- ;; map))
- ;;
- ;; (mapconcat (curry 'aref url-hexify-table) ...)
+(defun url-hexify-string (string &optional allowed-chars)
+ "URI-encode STRING and return the result.
+If STRING is multibyte, it is first converted to a utf-8 byte
+string. Each byte corresponding to an allowed character is left
+as-is, while all other bytes are converted to a three-character
+string: \"%\" followed by two upper-case hex digits.
+
+The allowed characters are specified by ALLOWED-CHARS. If this
+argument is nil, the list `url-unreserved-chars' determines the
+allowed characters. Otherwise, ALLOWED-CHARS should be a vector
+whose Nth element is non-nil if character N is allowed."
+ (unless allowed-chars
+ (setq allowed-chars (url--allowed-chars url-unreserved-chars)))
(mapconcat (lambda (byte)
- (if (memq byte url-unreserved-chars)
- (char-to-string byte)
- (format "%%%02x" byte)))
- (if (multibyte-string-p string)
- (encode-coding-string string 'utf-8)
- string)
- ""))
+ (if (aref allowed-chars byte)
+ (char-to-string byte)
+ (aref url-encoding-table byte)))
+ (if (multibyte-string-p string)
+ (encode-coding-string string 'utf-8)
+ string)
+ ""))
+
+(defconst url-host-allowed-chars
+ ;; Allow % to avoid re-encoding %-encoded sequences.
+ (url--allowed-chars (append '(?% ?! ?$ ?& ?' ?\( ?\) ?* ?+ ?, ?\; ?=)
+ url-unreserved-chars))
+ "Allowed-character byte mask for the host segment of a URI.
+These characters are specified in RFC 3986, Appendix A.")
+
+(defconst url-path-allowed-chars
+ (let ((vec (copy-sequence url-host-allowed-chars)))
+ (aset vec ?/ t)
+ (aset vec ?: t)
+ (aset vec ?@ t)
+ vec)
+ "Allowed-character byte mask for the path segment of a URI.
+These characters are specified in RFC 3986, Appendix A.")
+
+(defconst url-query-allowed-chars
+ (let ((vec (copy-sequence url-path-allowed-chars)))
+ (aset vec ?? t)
+ vec)
+ "Allowed-character byte mask for the query segment of a URI.
+These characters are specified in RFC 3986, Appendix A.")
+
+;;;###autoload
+(defun url-encode-url (url)
+ "Return a properly URI-encoded version of URL.
+This function also performs URI normalization, e.g. converting
+the scheme to lowercase if it is uppercase. Apart from
+normalization, if URL is already URI-encoded, this function
+should return it unchanged."
+ (if (multibyte-string-p url)
+ (setq url (encode-coding-string url 'utf-8)))
+ (let* ((obj (url-generic-parse-url url))
+ (user (url-user obj))
+ (pass (url-password obj))
+ (host (url-host obj))
+ (path-and-query (url-path-and-query obj))
+ (path (car path-and-query))
+ (query (cdr path-and-query))
+ (frag (url-target obj)))
+ (if user
+ (setf (url-user obj) (url-hexify-string user)))
+ (if pass
+ (setf (url-password obj) (url-hexify-string pass)))
+ ;; No special encoding for IPv6 literals.
+ (and host
+ (not (string-match "\\`\\[.*\\]\\'" host))
+ (setf (url-host obj)
+ (url-hexify-string host url-host-allowed-chars)))
+
+ (if path
+ (setq path (url-hexify-string path url-path-allowed-chars)))
+ (if query
+ (setq query (url-hexify-string query url-query-allowed-chars)))
+ (setf (url-filename obj) (if query (concat path "?" query) path))
+
+ (if frag
+ (setf (url-target obj)
+ (url-hexify-string frag url-query-allowed-chars)))
+ (url-recreate-url obj)))
;;;###autoload
(defun url-file-extension (fname &optional x)
(defun url-generate-unique-filename (&optional fmt)
"Generate a unique filename in `url-temporary-directory'."
+ (declare (obsolete make-temp-file "23.1"))
;; This variable is obsolete, but so is this function.
(let ((tempdir (with-no-warnings url-temporary-directory)))
(if (not fmt)
(setq x (1+ x)
fname (format fmt (concat base (int-to-string x)))))
(expand-file-name fname tempdir)))))
-(make-obsolete 'url-generate-unique-filename 'make-temp-file "23.1")
(defun url-extract-mime-headers ()
"Set `url-current-mime-headers' in current buffer."
;;; Code:
-(require 'mm-util)
-
(defconst url-version "Emacs"
"Version number of URL package.")
;; FIXME!! (RFC 2616 gives examples like `compress, gzip'.)
(defvar url-mime-encoding-string nil
- "*String to send in the Accept-encoding: field in HTTP requests.")
+ "String to send in the Accept-encoding: field in HTTP requests.")
+
+(defvar mm-mime-mule-charset-alist)
+(declare-function mm-coding-system-p "mm-util" (cs))
;; Perhaps the first few should actually be given decreasing `q's and
;; the list should be trimmed significantly.
(defun url-mime-charset-string ()
"Generate a list of preferred MIME charsets for HTTP requests.
Generated according to current coding system priorities."
+ (require 'mm-util)
(if (fboundp 'sort-coding-systems)
(let ((ordered (sort-coding-systems
(let (accum)
";q=0.5"))))
(defvar url-mime-charset-string nil
- "*String to send in the Accept-charset: field in HTTP requests.
+ "String to send in the Accept-charset: field in HTTP requests.
The MIME charset corresponding to the most preferred coding system is
given priority 1 and the rest are given priority 0.5.")
:type '(choice (const :tag "None" :value nil) string)
:group 'url)
+;; From RFC3986: Scheme names consist of a sequence of characters
+;; beginning with a letter and followed by any combination of letters,
+;; digits, plus ("+"), period ("."), or hyphen ("-").
+
(defvar url-nonrelative-link
- "\\`\\([-a-zA-Z0-9+.]+:\\)"
+ "\\`\\([a-zA-Z][-a-zA-Z0-9+.]*:\\)"
"A regular expression that will match an absolute URL.")
(defcustom url-max-redirections 30
(defvar url-parse-syntax-table
(copy-syntax-table emacs-lisp-mode-syntax-table)
- "*A syntax table for parsing URLs.")
+ "A syntax table for parsing URLs.")
(modify-syntax-entry ?' "\"" url-parse-syntax-table)
(modify-syntax-entry ?` "\"" url-parse-syntax-table)
(modify-syntax-entry ?> ")<" url-parse-syntax-table)
(modify-syntax-entry ?/ " " url-parse-syntax-table)
-(defvar url-load-hook nil
- "*Hooks to be run after initializing the URL library.")
+(defcustom url-load-hook nil
+ "Hook run after initializing the URL library."
+ :group 'url
+ :type 'hook)
;;; Make OS/2 happy - yeeks
;; (defvar tcp-binary-process-input-services nil
-;;; url.el --- Uniform Resource Locator retrieval tool
+;;; url.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t -*-
;; Copyright (C) 1996-1999, 2001, 2004-2012 Free Software Foundation, Inc.
;;; Code:
-(eval-when-compile (require 'cl))
(require 'mailcap)
;;;###autoload
(defun url-retrieve (url callback &optional cbargs silent inhibit-cookies)
"Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
-URL is either a string or a parsed URL.
+URL is either a string or a parsed URL. If it is a string
+containing characters that are not valid in a URI, those
+characters are percent-encoded; see `url-encode-url'.
CALLBACK is called when the object has been completely retrieved, with
the current buffer containing the object, and any MIME headers associated
If SILENT, then don't message progress reports and the like.
If INHIBIT-COOKIES, cookies will neither be stored nor sent to
-the server."
+the server.
+If URL is a multibyte string, it will be encoded as utf-8 and
+URL-encoded before it's used."
;;; XXX: There is code in Emacs that does dynamic binding
;;; of the following variables around url-retrieve:
;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
If SILENT, don't message progress reports and the like.
If INHIBIT-COOKIES, cookies will neither be stored nor sent to
-the server."
+the server.
+If URL is a multibyte string, it will be encoded as utf-8 and
+URL-encoded before it's used."
(url-do-setup)
(url-gc-dead-buffers)
- (if (stringp url)
- (set-text-properties 0 (length url) nil url))
+ (when (stringp url)
+ (set-text-properties 0 (length url) nil url)
+ (setq url (url-encode-url url)))
(if (not (vectorp url))
(setq url (url-generic-parse-url url)))
(if (not (functionp callback))
no further processing). URL is either a string or a parsed URL."
(url-do-setup)
- (lexical-let ((retrieval-done nil)
- (asynch-buffer nil))
+ (let ((retrieval-done nil)
+ (asynch-buffer nil))
(setq asynch-buffer
(url-retrieve url (lambda (&rest ignored)
(url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
The buffer in question is current when this function is called."
(discard-input)
(save-window-excursion
- (let (answer)
+ (let ((prompt
+ (format "%s changed on disk; \
+really edit the buffer? (y, n, r or C-h) "
+ (file-name-nondirectory fn)))
+ (choices '(?y ?n ?r ?? ?\C-h))
+ answer)
(while (null answer)
- (message "%s changed on disk; really edit the buffer? (y, n, r or C-h) "
- (file-name-nondirectory fn))
- (let ((tem (downcase (let ((cursor-in-echo-area t))
- (read-char-exclusive)))))
- (setq answer
- (if (= tem help-char)
- 'help
- (cdr (assoc tem '((?n . yield)
- (?\C-g . yield)
- (?y . proceed)
- (?r . revert)
- (?? . help))))))
- (cond ((null answer)
- (beep)
- (message "Please type y, n or r; or ? for help")
- (sit-for 3))
- ((eq answer 'help)
- (ask-user-about-supersession-help)
- (setq answer nil))
- ((eq answer 'revert)
- (revert-buffer nil (not (buffer-modified-p)))
- ; ask confirmation if buffer modified
- (signal 'file-supersession
- (list "File reverted" fn)))
- ((eq answer 'yield)
- (signal 'file-supersession
- (list "File changed on disk" fn))))))
+ (setq answer (read-char-choice prompt choices))
+ (cond ((memq answer '(?? ?\C-h))
+ (ask-user-about-supersession-help)
+ (setq answer nil))
+ ((eq answer ?r)
+ ;; Ask for confirmation if buffer modified
+ (revert-buffer nil (not (buffer-modified-p)))
+ (signal 'file-supersession
+ (list "File reverted" fn)))
+ ((eq answer ?n)
+ (signal 'file-supersession
+ (list "File changed on disk" fn)))))
(message
- "File on disk now will become a backup file if you save these changes.")
+ "File on disk now will become a backup file if you save these changes.")
(setq buffer-backed-up nil))))
(defun ask-user-about-supersession-help ()
(define-obsolete-face-alias 'change-log-function-face
'change-log-function "22.1")
-(defface change-log-acknowledgement
+(defface change-log-acknowledgment
'((t (:inherit font-lock-comment-face)))
"Face for highlighting acknowledgments."
:version "21.1"
:group 'change-log)
+(define-obsolete-face-alias 'change-log-acknowledgement
+ 'change-log-acknowledgment "24.3")
(define-obsolete-face-alias 'change-log-acknowledgement-face
- 'change-log-acknowledgement "22.1")
+ 'change-log-acknowledgment "22.1")
(defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)")
(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*")
;; Function of change.
("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function))
;;
- ;; Acknowledgements.
+ ;; Acknowledgments.
;; Don't include plain "From" because that is vague;
;; we want to encourage people to say something more specific.
;; Note that the FSF does not use "Patches by"; our convention
;; is to put the name of the author of the changes at the top
;; of the change log entry.
("\\(^\\( +\\|\t\\)\\| \\)\\(Thanks to\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
- 3 'change-log-acknowledgement))
+ 3 'change-log-acknowledgment))
"Additional expressions to highlight in Change Log mode.")
(defun change-log-search-file-name (where)
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.
;;;###autoload
(defvar add-log-lisp-like-modes
'(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode)
- "*Modes that look like Lisp to `add-log-current-defun'.")
+ "Modes that look like Lisp to `add-log-current-defun'.")
;;;###autoload
(defvar add-log-c-like-modes
'(c-mode c++-mode c++-c-mode objc-mode)
- "*Modes that look like C to `add-log-current-defun'.")
+ "Modes that look like C to `add-log-current-defun'.")
;;;###autoload
(defvar add-log-tex-like-modes
'(TeX-mode plain-TeX-mode LaTeX-mode tex-mode)
- "*Modes that look like TeX to `add-log-current-defun'.")
+ "Modes that look like TeX to `add-log-current-defun'.")
(declare-function c-cpp-define-name "cc-cmds" ())
(declare-function c-defun-name "cc-cmds" ())
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;;
;; Tagelt, tag element
;;
-(defstruct (cvs-tag
+(cl-defstruct (cvs-tag
(:constructor nil)
(:constructor cvs-tag-make
(vlist &optional name type))
(save-excursion
(or (= (forward-line 1) 0) (insert "\n"))
(cvs-tree-print rest printer column))))
- (assert (>= prefix column))
+ (cl-assert (>= prefix column))
(move-to-column prefix t)
- (assert (eolp))
+ (cl-assert (eolp))
(insert (cvs-car name))
(dolist (br (cvs-cdr rev))
(let* ((column (current-column))
(defun cvs-tree-merge (tree1 tree2)
"Merge tags trees TREE1 and TREE2 into one.
BEWARE: because of stability issues, this is not a symmetric operation."
- (assert (and (listp tree1) (listp tree2)))
+ (cl-assert (and (listp tree1) (listp tree2)))
(cond
((null tree1) tree2)
((null tree2) tree1)
(l2 (length vl2)))
(cond
((= l1 l2)
- (case (cvs-tag-compare tag1 tag2)
- (more1 (list* rev2 (cvs-tree-merge tree1 (cdr tree2))))
- (more2 (list* rev1 (cvs-tree-merge (cdr tree1) tree2)))
- (equal
+ (pcase (cvs-tag-compare tag1 tag2)
+ (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2))))
+ (`more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2)))
+ (`equal
(cons (cons (cvs-tag-merge tag1 tag2)
(cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
(cvs-tree-merge (cdr tree1) (cdr tree2))))))
(cvs-tree-use-jisx0208 'jisx0208)
((char-displayable-p ?━) 'unicode)
((char-displayable-p (make-char 'japanese-jisx0208 40 44)) 'jisx0208))
- "*Non-nil if we should use the graphical glyphs from `japanese-jisx0208'.
+ "Non-nil if we should use the graphical glyphs from `japanese-jisx0208'.
Otherwise, default to ASCII chars like +, - and |.")
(defconst cvs-tree-char-space
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 33 33))
- (unicode " ")
- (t " ")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 33 33))
+ (`unicode " ")
+ (_ " ")))
(defconst cvs-tree-char-hbar
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 44))
- (unicode "━")
- (t "--")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 44))
+ (`unicode "━")
+ (_ "--")))
(defconst cvs-tree-char-vbar
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 45))
- (unicode "┃")
- (t "| ")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 45))
+ (`unicode "┃")
+ (_ "| ")))
(defconst cvs-tree-char-branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 50))
- (unicode "┣")
- (t "+-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 50))
+ (`unicode "┣")
+ (_ "+-")))
(defconst cvs-tree-char-eob ;end of branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 49))
- (unicode "┗")
- (t "`-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 49))
+ (`unicode "┗")
+ (_ "`-")))
(defconst cvs-tree-char-bob ;beginning of branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 51))
- (unicode "┳")
- (t "+-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 51))
+ (`unicode "┳")
+ (_ "+-")))
(defun cvs-tag-lessp (tag1 tag2)
(eq (cvs-tag-compare tag1 tag2) 'more2))
(pe t) ;"prev equal"
(nas nil)) ;"next afters" to be returned
(insert " ")
- (do* ((vs vlist (cdr vs))
- (ps prev (cdr ps))
- (as after (cdr as)))
+ (cl-do* ((vs vlist (cdr vs))
+ (ps prev (cdr ps))
+ (as after (cdr as)))
((and (null as) (null vs) (null ps))
(let ((revname (cvs-status-vl-to-str vlist)))
(if (cvs-every 'identity (cvs-map 'equal prev vlist))
;; - Handle `diff -b' output in context->unified.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar add-log-buffer-file-name-function)
;;;;
(easy-mmode-defmap diff-mode-shared-map
- '(;; From Pavel Machek's patch-mode.
- ("n" . diff-hunk-next)
+ '(("n" . diff-hunk-next)
("N" . diff-file-next)
("p" . diff-hunk-prev)
("P" . diff-file-prev)
([backtab] . diff-hunk-prev)
("k" . diff-hunk-kill)
("K" . diff-file-kill)
- ;; From compilation-minor-mode.
- ("}" . diff-file-next)
+ ("}" . diff-file-next) ; From compilation-minor-mode.
("{" . diff-file-prev)
("\C-m" . diff-goto-source)
([mouse-2] . diff-goto-source)
- ;; From XEmacs's diff-mode.
("W" . widen)
- ;;("." . diff-goto-source) ;display-buffer
- ;;("f" . diff-goto-source) ;find-file
- ("o" . diff-goto-source) ;other-window
- ;;("w" . diff-goto-source) ;other-frame
- ;;("N" . diff-narrow)
- ;;("h" . diff-show-header)
- ;;("j" . diff-show-difference) ;jump to Nth diff
- ;;("q" . diff-quit)
- ;; Not useful if you have to metafy them.
- ;;(" " . scroll-up)
- ;;("\177" . scroll-down)
+ ("o" . diff-goto-source) ; other-window
("A" . diff-ediff-patch)
("r" . diff-restrict-view)
- ("R" . diff-reverse-direction))
+ ("R" . diff-reverse-direction)
+ ("/" . diff-undo)
+ ([remap undo] . diff-undo))
"Basic keymap for `diff-mode', bound to various prefix keys."
:inherit special-mode-map)
["Unified -> Context" diff-unified->context
:help "Convert unified diffs to context diffs"]
;;["Fixup Headers" diff-fixup-modifs (not buffer-read-only)]
+ ["Remove trailing whitespace" diff-remove-trailing-whitespace
+ :help "Remove trailing whitespace problems introduced by the diff"]
["Show trailing whitespace" whitespace-mode
:style toggle :selected (bound-and-true-p whitespace-mode)
:help "Show trailing whitespace in modified lines"]
:background "grey80")
(((class color) (min-colors 88) (background dark))
:background "grey45")
- (((class color) (background light))
+ (((class color))
:foreground "blue1" :weight bold)
- (((class color) (background dark))
- :foreground "green" :weight bold)
(t :weight bold))
"`diff-mode' face inherited by hunk and index header faces."
:group 'diff-mode)
:background "grey70" :weight bold)
(((class color) (min-colors 88) (background dark))
:background "grey60" :weight bold)
- (((class color) (background light))
- :foreground "green" :weight bold)
- (((class color) (background dark))
+ (((class color))
:foreground "cyan" :weight bold)
(t :weight bold)) ; :height 1.3
"`diff-mode' face used to highlight file header lines."
(defvar diff-hunk-header-face 'diff-hunk-header)
(defface diff-removed
- '((t :inherit diff-changed))
+ '((default
+ :inherit diff-changed)
+ (((class color) (min-colors 88) (background light))
+ :background "#ffdddd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#553333")
+ (((class color))
+ :foreground "red"))
"`diff-mode' face used to highlight removed lines."
:group 'diff-mode)
(define-obsolete-face-alias 'diff-removed-face 'diff-removed "22.1")
(defvar diff-removed-face 'diff-removed)
(defface diff-added
- '((t :inherit diff-changed))
+ '((default
+ :inherit diff-changed)
+ (((class color) (min-colors 88) (background light))
+ :background "#ddffdd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#335533")
+ (((class color))
+ :foreground "green"))
"`diff-mode' face used to highlight added lines."
:group 'diff-mode)
(define-obsolete-face-alias 'diff-added-face 'diff-added "22.1")
'((((class color grayscale) (min-colors 88)))
;; If the terminal lacks sufficient colors for shadowing,
;; highlight changed lines explicitly.
- (((class color) (background light))
- :foreground "magenta" :weight bold :slant italic)
- (((class color) (background dark))
- :foreground "yellow" :weight bold :slant italic))
+ (((class color))
+ :foreground "yellow"))
"`diff-mode' face used to highlight changed lines."
:group 'diff-mode)
(define-obsolete-face-alias 'diff-changed-face 'diff-changed "22.1")
(defconst diff-context-mid-hunk-header-re
"--- \\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? ----$")
+(defvar diff-use-changed-face (and (face-differs-from-default-p diff-changed-face)
+ (not (face-equal diff-changed-face diff-added-face))
+ (not (face-equal diff-changed-face diff-removed-face)))
+ "If non-nil, use the face `diff-changed' for changed lines in context diffs.
+Otherwise, use the face `diff-removed' for removed lines,
+and the face `diff-added' for added lines.")
+
(defvar diff-font-lock-keywords
`((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$")
(1 diff-hunk-header-face) (6 diff-function-face))
("^\\([+>]\\)\\(.*\n\\)"
(1 diff-indicator-added-face) (2 diff-added-face))
("^\\(!\\)\\(.*\n\\)"
- (1 diff-indicator-changed-face) (2 diff-changed-face))
- ("^Index: \\(.+\\).*\n"
+ (1 (if diff-use-changed-face
+ diff-indicator-changed-face
+ ;; Otherwise, search for `diff-context-mid-hunk-header-re' and
+ ;; if the line of context diff is above, use `diff-removed-face';
+ ;; if below, use `diff-added-face'.
+ (save-match-data
+ (let ((limit (save-excursion (diff-beginning-of-hunk))))
+ (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t))
+ diff-indicator-added-face
+ diff-indicator-removed-face)))))
+ (2 (if diff-use-changed-face
+ diff-changed-face
+ ;; Otherwise, use the same method as above.
+ (save-match-data
+ (let ((limit (save-excursion (diff-beginning-of-hunk))))
+ (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t))
+ diff-added-face
+ diff-removed-face))))))
+ ("^\\(?:Index\\|revno\\): \\(.+\\).*\n"
(0 diff-header-face) (1 diff-index-face prepend))
("^Only in .*\n" . diff-nonexistent-face)
("^\\(#\\)\\(.*\\)"
style)
(defun diff-end-of-hunk (&optional style donttrustheader)
+ "Advance to the end of the current hunk, and return its position."
(let (end)
(when (looking-at diff-hunk-header-re)
;; Especially important for unified (because headers are ambiguous).
;; We may have a first evaluation of `end' thanks to the hunk header.
(unless end
(setq end (and (re-search-forward
- (case style
- (unified (concat (if diff-valid-unified-empty-line
- "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
- ;; A `unified' header is ambiguous.
- diff-file-header-re))
- (context "^[^-+#! \\]")
- (normal "^[^<>#\\]")
- (t "^[^-+#!<> \\]"))
+ (pcase style
+ (`unified
+ (concat (if diff-valid-unified-empty-line
+ "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
+ ;; A `unified' header is ambiguous.
+ diff-file-header-re))
+ (`context "^[^-+#! \\]")
+ (`normal "^[^<>#\\]")
+ (_ "^[^-+#!<> \\]"))
nil t)
(match-beginning 0)))
(when diff-valid-unified-empty-line
(goto-char (or end (point-max)))))
(defun diff-beginning-of-hunk (&optional try-harder)
- "Move back to beginning of hunk.
-If TRY-HARDER is non-nil, try to cater to the case where we're not in a hunk
-but in the file header instead, in which case move forward to the first hunk."
+ "Move back to the previous hunk beginning, and return its position.
+If point is in a file header rather than a hunk, advance to the
+next hunk if TRY-HARDER is non-nil; otherwise signal an error."
(beginning-of-line)
- (unless (looking-at diff-hunk-header-re)
+ (if (looking-at diff-hunk-header-re)
+ (point)
(forward-line 1)
(condition-case ()
(re-search-backward diff-hunk-header-re)
(error
- (if (not try-harder)
- (error "Can't find the beginning of the hunk")
- (diff-beginning-of-file-and-junk)
- (diff-hunk-next))))))
+ (unless try-harder
+ (error "Can't find the beginning of the hunk"))
+ (diff-beginning-of-file-and-junk)
+ (diff-hunk-next)
+ (point)))))
(defun diff-unified-hunk-p ()
(save-excursion
(easy-mmode-define-navigation
diff-file diff-file-header-re "file" diff-end-of-file)
+(defun diff-bounds-of-hunk ()
+ "Return the bounds of the diff hunk at point.
+The return value is a list (BEG END), which are the hunk's start
+and end positions. Signal an error if no hunk is found. If
+point is in a file header, return the bounds of the next hunk."
+ (save-excursion
+ (let ((pos (point))
+ (beg (diff-beginning-of-hunk t))
+ (end (diff-end-of-hunk)))
+ (cond ((>= end pos)
+ (list beg end))
+ ;; If this hunk ends above POS, consider the next hunk.
+ ((re-search-forward diff-hunk-header-re nil t)
+ (list (match-beginning 0) (diff-end-of-hunk)))
+ (t (error "No hunk found"))))))
+
+(defun diff-bounds-of-file ()
+ "Return the bounds of the file segment at point.
+The return value is a list (BEG END), which are the segment's
+start and end positions."
+ (save-excursion
+ (let ((pos (point))
+ (beg (progn (diff-beginning-of-file-and-junk)
+ (point))))
+ (diff-end-of-file)
+ ;; bzr puts a newline after the last hunk.
+ (while (looking-at "^\n")
+ (forward-char 1))
+ (if (> pos (point))
+ (error "Not inside a file diff"))
+ (list beg (point)))))
+
(defun diff-restrict-view (&optional arg)
"Restrict the view to the current hunk.
If the prefix ARG is given, restrict the view to the current file instead."
(interactive "P")
- (save-excursion
- (if arg (diff-beginning-of-file) (diff-beginning-of-hunk 'try-harder))
- (narrow-to-region (point)
- (progn (if arg (diff-end-of-file) (diff-end-of-hunk))
- (point)))
- (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))))
-
+ (apply 'narrow-to-region
+ (if arg (diff-bounds-of-file) (diff-bounds-of-hunk)))
+ (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk)))
(defun diff-hunk-kill ()
- "Kill current hunk."
+ "Kill the hunk at point."
(interactive)
- (diff-beginning-of-hunk)
- (let* ((start (point))
- ;; Search the second match, since we're looking at the first.
- (nexthunk (when (re-search-forward diff-hunk-header-re nil t 2)
- (match-beginning 0)))
- (firsthunk (ignore-errors
- (goto-char start)
- (diff-beginning-of-file) (diff-hunk-next) (point)))
- (nextfile (ignore-errors (diff-file-next) (point)))
+ (let* ((hunk-bounds (diff-bounds-of-hunk))
+ (file-bounds (ignore-errors (diff-bounds-of-file)))
+ ;; If the current hunk is the only one for its file, kill the
+ ;; file header too.
+ (bounds (if (and file-bounds
+ (progn (goto-char (car file-bounds))
+ (= (progn (diff-hunk-next) (point))
+ (car hunk-bounds)))
+ (progn (goto-char (cadr hunk-bounds))
+ ;; bzr puts a newline after the last hunk.
+ (while (looking-at "^\n")
+ (forward-char 1))
+ (= (point) (cadr file-bounds))))
+ file-bounds
+ hunk-bounds))
(inhibit-read-only t))
- (goto-char start)
- (if (and firsthunk (= firsthunk start)
- (or (null nexthunk)
- (and nextfile (> nexthunk nextfile))))
- ;; It's the only hunk for this file, so kill the file.
- (diff-file-kill)
- (diff-end-of-hunk)
- (kill-region start (point)))))
+ (apply 'kill-region bounds)
+ (goto-char (car bounds))))
;; "index ", "old mode", "new mode", "new file mode" and
;; "deleted file mode" are output by git-diff.
(defconst diff-file-junk-re
- "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode")
+ "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|=== modified file")
(defun diff-beginning-of-file-and-junk ()
"Go to the beginning of file-related diff-info.
(defun diff-file-kill ()
"Kill current file's hunks."
(interactive)
- (let ((orig (point))
- (start (progn (diff-beginning-of-file-and-junk) (point)))
- (inhibit-read-only t))
- (diff-end-of-file)
- (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs.
- (if (> orig (point)) (error "Not inside a file diff"))
- (kill-region start (point))))
+ (let ((inhibit-read-only t))
+ (apply 'kill-region (diff-bounds-of-file))))
(defun diff-kill-junk ()
"Kill spurious empty diffs."
(save-excursion
(let ((n 0))
(goto-char start)
- (while (re-search-forward re end t) (incf n))
+ (while (re-search-forward re end t) (cl-incf n))
n)))
(defun diff-splittable-p ()
(interactive)
(beginning-of-line)
(let ((pos (point))
- (start (progn (diff-beginning-of-hunk) (point))))
+ (start (diff-beginning-of-hunk)))
(unless (looking-at diff-hunk-header-re-unified)
(error "diff-split-hunk only works on unified context diffs"))
(forward-line 1)
;; use any previously used preference
(cdr (assoc fs diff-remembered-files-alist))
;; try to be clever and use previous choices as an inspiration
- (dolist (rf diff-remembered-files-alist)
+ (cl-dolist (rf diff-remembered-files-alist)
(let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
- (if (and newfile (file-exists-p newfile)) (return newfile))))
+ (if (and newfile (file-exists-p newfile)) (cl-return newfile))))
;; look for each file in turn. If none found, try again but
;; ignoring the first level of directory, ...
- (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
- (file nil nil))
+ (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
+ (file nil nil))
((or (null files)
- (setq file (do* ((files files (cdr files))
- (file (car files) (car files)))
+ (setq file (cl-do* ((files files (cdr files))
+ (file (car files) (car files)))
;; Use file-regular-p to avoid
;; /dev/null, directories, etc.
((or (null file) (file-regular-p file))
(diff-find-file-name old noprompt (match-string 1)))
;; if all else fails, ask the user
(unless noprompt
- (let ((file (expand-file-name (or (first fs) ""))))
+ (let ((file (expand-file-name (or (car fs) ""))))
(setq file
(read-file-name (format "Use file %s: " file)
(file-name-directory file) file t
(let ((modif nil) last-pt)
(while (progn (setq last-pt (point))
(= (forward-line -1) 0))
- (case (char-after)
+ (pcase (char-after)
(?\s (insert " ") (setq modif nil) (backward-char 1))
(?+ (delete-region (point) last-pt) (setq modif t))
(?- (if (not modif)
- (progn (forward-char 1)
- (insert " "))
- (delete-char 1)
- (insert "! "))
- (backward-char 2))
+ (progn (forward-char 1)
+ (insert " "))
+ (delete-char 1)
+ (insert "! "))
+ (backward-char 2))
(?\\ (when (save-excursion (forward-line -1)
- (= (char-after) ?+))
- (delete-region (point) last-pt) (setq modif t)))
+ (= (char-after) ?+))
+ (delete-region (point) last-pt)
+ (setq modif t)))
;; diff-valid-unified-empty-line.
- (?\n (insert " ") (setq modif nil) (backward-char 2))
- (t (setq modif nil))))))
+ (?\n (insert " ") (setq modif nil)
+ (backward-char 2))
+ (_ (setq modif nil))))))
(goto-char (point-max))
(save-excursion
(insert "--- " line2 ","
(if (not (save-excursion (re-search-forward "^+" nil t)))
(delete-region (point) (point-max))
(let ((modif nil) (delete nil))
- (if (save-excursion (re-search-forward "^\\+.*\n-" nil t))
+ (if (save-excursion (re-search-forward "^\\+.*\n-"
+ nil t))
;; Normally, lines in a substitution come with
;; first the removals and then the additions, and
;; the context->unified function follows this
;; context->unified as an undo command.
(setq reversible nil))
(while (not (eobp))
- (case (char-after)
+ (pcase (char-after)
(?\s (insert " ") (setq modif nil) (backward-char 1))
(?- (setq delete t) (setq modif t))
(?+ (if (not modif)
- (progn (forward-char 1)
- (insert " "))
- (delete-char 1)
- (insert "! "))
- (backward-char 2))
+ (progn (forward-char 1)
+ (insert " "))
+ (delete-char 1)
+ (insert "! "))
+ (backward-char 2))
(?\\ (when (save-excursion (forward-line 1)
- (not (eobp)))
- (setq delete t) (setq modif t)))
+ (not (eobp)))
+ (setq delete t) (setq modif t)))
;; diff-valid-unified-empty-line.
(?\n (insert " ") (setq modif nil) (backward-char 2)
(setq reversible nil))
- (t (setq modif nil)))
+ (_ (setq modif nil)))
(let ((last-pt (point)))
(forward-line 1)
(when delete
(goto-char pt1)
(forward-line 1)
(while (< (point) pt2)
- (case (char-after)
+ (pcase (char-after)
(?! (delete-char 2) (insert "-") (forward-line 1))
(?- (forward-char 1) (delete-char 1) (forward-line 1))
- (?\s ;merge with the other half of the chunk
+ (?\s ;merge with the other half of the chunk
(let* ((endline2
(save-excursion
(goto-char pt2) (forward-line 1) (point))))
- (case (char-after pt2)
- ((?! ?+)
+ (pcase (char-after pt2)
+ ((or ?! ?+)
(insert "+"
- (prog1 (buffer-substring (+ pt2 2) endline2)
+ (prog1
+ (buffer-substring (+ pt2 2) endline2)
(delete-region pt2 endline2))))
(?\s
(unless (= (- endline2 pt2)
(delete-char 1)
(forward-line 1))
(?\\ (forward-line 1))
- (t (setq reversible nil)
+ (_ (setq reversible nil)
(delete-char 1) (forward-line 1)))))
- (t (setq reversible nil) (forward-line 1))))
+ (_ (setq reversible nil) (forward-line 1))))
(while (looking-at "[+! ] ")
(if (/= (char-after) ?!) (forward-char 1)
(delete-char 1) (insert "+"))
(replace-match "@@ -\\8 +\\7 @@" nil)
(forward-line 1)
(let ((c (char-after)) first last)
- (while (case (setq c (char-after))
+ (while (pcase (setq c (char-after))
(?- (setq first (or first (point)))
- (delete-char 1) (insert "+") t)
+ (delete-char 1) (insert "+") t)
(?+ (setq last (or last (point)))
- (delete-char 1) (insert "-") t)
- ((?\\ ?#) t)
- (t (when (and first last (< first last))
+ (delete-char 1) (insert "-") t)
+ ((or ?\\ ?#) t)
+ (_ (when (and first last (< first last))
(insert (delete-and-extract-region first last)))
(setq first nil last nil)
(memq c (if diff-valid-unified-empty-line
(concat diff-hunk-header-re-unified
"\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$"
"\\|--- .+\n\\+\\+\\+ ")))
- (case (char-after)
- (?\s (incf space))
- (?+ (incf plus))
- (?- (incf minus))
- (?! (incf bang))
- ((?\\ ?#) nil)
- (t (setq space 0 plus 0 minus 0 bang 0)))
+ (pcase (char-after)
+ (?\s (cl-incf space))
+ (?+ (cl-incf plus))
+ (?- (cl-incf minus))
+ (?! (cl-incf bang))
+ ((or ?\\ ?#) nil)
+ (_ (setq space 0 plus 0 minus 0 bang 0)))
(cond
((looking-at diff-hunk-header-re-unified)
(let* ((old1 (match-string 2))
(set (make-local-variable 'end-of-defun-function)
'diff-end-of-file)
- ;; Set up `whitespace-mode' so that turning it on will show trailing
- ;; whitespace problems on the modified lines of the diff.
- (set (make-local-variable 'whitespace-style) '(face trailing))
- (set (make-local-variable 'whitespace-trailing-regexp)
- "^[-\+!<>].*?\\([\t ]+\\)$")
+ (diff-setup-whitespace)
(setq buffer-read-only diff-default-read-only)
;; setup change hooks
;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun diff-setup-whitespace ()
+ "Set up Whitespace mode variables for the current Diff mode buffer.
+This sets `whitespace-style' and `whitespace-trailing-regexp' so
+that Whitespace mode shows trailing whitespace problems on the
+modified lines of the diff."
+ (set (make-local-variable 'whitespace-style) '(face trailing))
+ (let ((style (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward diff-hunk-header-re nil t)
+ (goto-char (match-beginning 0))
+ (diff-hunk-style)))))
+ (set (make-local-variable 'whitespace-trailing-regexp)
+ (if (eq style 'context)
+ "^[-\+!] .*?\\([\t ]+\\)$"
+ "^[-\+!<>].*?\\([\t ]+\\)$"))))
+
(defun diff-delete-if-empty ()
;; An empty diff file means there's no more diffs to integrate, so we
;; can just remove the file altogether. Very handy for .rej files if we
(cond
((and (memq (char-after) '(?\s ?! ?+ ?-))
(memq (char-after (1+ (point))) '(?\s ?\t)))
- (decf count) t)
+ (cl-decf count) t)
((or (zerop count) (= count lines)) nil)
((memq (char-after) '(?! ?+ ?-))
(if (not (and (eq (char-after (1+ (point))) ?\n)
(after (string-to-number (or (match-string 4) "1"))))
(forward-line)
(while
- (case (char-after)
- (?\s (decf before) (decf after) t)
+ (pcase (char-after)
+ (?\s (cl-decf before) (cl-decf after) t)
(?-
(if (and (looking-at diff-file-header-re)
(zerop before) (zerop after))
;; line so that our code which doesn't count lines
;; will not get confused.
(progn (save-excursion (insert "\n")) nil)
- (decf before) t))
- (?+ (decf after) t)
- (t
+ (cl-decf before) t))
+ (?+ (cl-decf after) t)
+ (_
(cond
((and diff-valid-unified-empty-line
;; Not just (eolp) so we don't infloop at eob.
(eq (char-after) ?\n)
(> before 0) (> after 0))
- (decf before) (decf after) t)
+ (cl-decf before) (cl-decf after) t)
((and (zerop before) (zerop after)) nil)
((or (< before 0) (< after 0))
(error (if (or (zerop before) (zerop after))
NOPROMPT, if non-nil, means not to prompt the user."
(save-excursion
(let* ((other (diff-xor other-file diff-jump-to-old-file))
- (char-offset (- (point) (progn (diff-beginning-of-hunk 'try-harder)
- (point))))
+ (char-offset (- (point) (diff-beginning-of-hunk t)))
;; Check that the hunk is well-formed. Otherwise diff-mode and
;; the user may disagree on what constitutes the hunk
;; (e.g. because an empty line truncates the hunk mid-course),
With a prefix argument, REVERSE the hunk."
(interactive "P")
- (destructuring-bind (buf line-offset pos old new &optional switched)
- ;; Sometimes we'd like to have the following behavior: if REVERSE go
- ;; to the new file, otherwise go to the old. But that means that by
- ;; default we use the old file, which is the opposite of the default
- ;; for diff-goto-source, and is thus confusing. Also when you don't
- ;; know about it it's pretty surprising.
- ;; TODO: make it possible to ask explicitly for this behavior.
- ;;
- ;; This is duplicated in diff-test-hunk.
- (diff-find-source-location nil reverse)
+ (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched)
+ ;; Sometimes we'd like to have the following behavior: if
+ ;; REVERSE go to the new file, otherwise go to the old.
+ ;; But that means that by default we use the old file, which is
+ ;; the opposite of the default for diff-goto-source, and is thus
+ ;; confusing. Also when you don't know about it it's
+ ;; pretty surprising.
+ ;; TODO: make it possible to ask explicitly for this behavior.
+ ;;
+ ;; This is duplicated in diff-test-hunk.
+ (diff-find-source-location nil reverse)))
(cond
((null line-offset)
(error "Can't find the text to patch"))
"See whether it's possible to apply the current hunk.
With a prefix argument, try to REVERSE the hunk."
(interactive "P")
- (destructuring-bind (buf line-offset pos src _dst &optional switched)
- (diff-find-source-location nil reverse)
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location nil reverse)))
(set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
(diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
;; This is a convenient detail when using smerge-diff.
(if event (posn-set-point (event-end event)))
(let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
- (destructuring-bind (buf line-offset pos src _dst &optional switched)
- (diff-find-source-location other-file rev)
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location other-file rev)))
(pop-to-buffer buf)
(goto-char (+ (car pos) (cdr src)))
(diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
(when (looking-at diff-hunk-header-re)
(forward-line 1)
(re-search-forward "^[^ ]" nil t))
- (destructuring-bind (&optional buf _line-offset pos src dst switched)
- ;; Use `noprompt' since this is used in which-func-mode and such.
- (ignore-errors ;Signals errors in place of prompting.
- (diff-find-source-location nil nil 'noprompt))
+ (pcase-let ((`(,buf ,_line-offset ,pos ,src ,dst ,switched)
+ (ignore-errors ;Signals errors in place of prompting.
+ ;; Use `noprompt' since this is used in which-func-mode
+ ;; and such.
+ (diff-find-source-location nil nil 'noprompt))))
(when buf
(beginning-of-line)
(or (when (memq (char-after) '(?< ?-))
(defun diff-ignore-whitespace-hunk ()
"Re-diff the current hunk, ignoring whitespace differences."
(interactive)
- (let* ((char-offset (- (point) (progn (diff-beginning-of-hunk 'try-harder)
- (point))))
- (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b")))
+ (let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
+ (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
(line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
(error "Can't find line number"))
(string-to-number (match-string 1))))
(let ((status
(call-process diff-command nil t nil
opts file1 file2)))
- (case status
- (0 nil) ;Nothing to reformat.
+ (pcase status
+ (0 nil) ;Nothing to reformat.
(1 (goto-char (point-min))
- ;; Remove the file-header.
- (when (re-search-forward diff-hunk-header-re nil t)
- (delete-region (point-min) (match-beginning 0))))
- (t (goto-char (point-max))
+ ;; Remove the file-header.
+ (when (re-search-forward diff-hunk-header-re nil t)
+ (delete-region (point-min) (match-beginning 0))))
+ (_ (goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert hunk)))
(setq hunk (buffer-string))
(defface diff-refine-change
'((((class color) (min-colors 88) (background light))
- :background "grey85")
+ :background "#ffff55")
(((class color) (min-colors 88) (background dark))
- :background "grey60")
- (((class color) (background light))
- :background "yellow")
- (((class color) (background dark))
- :background "green")
- (t :weight bold))
+ :background "#aaaa22")
+ (t :inverse-video t))
"Face used for char-based changes shown by `diff-refine-hunk'."
:group 'diff-mode)
+(defface diff-refine-removed
+ '((default
+ :inherit diff-refine-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#ffaaaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aa2222"))
+ "Face used for removed characters shown by `diff-refine-hunk'."
+ :group 'diff-mode
+ :version "24.3")
+
+(defface diff-refine-added
+ '((default
+ :inherit diff-refine-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#aaffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#22aa22"))
+ "Face used for added characters shown by `diff-refine-hunk'."
+ :group 'diff-mode
+ :version "24.3")
+
(defun diff-refine-preproc ()
(while (re-search-forward "^[+>]" nil t)
;; Remove spurious changes due to the fact that one side of the hunk is
)
(declare-function smerge-refine-subst "smerge-mode"
- (beg1 end1 beg2 end2 props &optional preproc))
+ (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a))
(defun diff-refine-hunk ()
"Highlight changes of hunk at point at a finer granularity."
(interactive)
(require 'smerge-mode)
(save-excursion
- (diff-beginning-of-hunk 'try-harder)
+ (diff-beginning-of-hunk t)
(let* ((start (point))
(style (diff-hunk-style)) ;Skips the hunk header as well.
(beg (point))
- (props '((diff-mode . fine) (face diff-refine-change)))
+ (props-c '((diff-mode . fine) (face diff-refine-change)))
+ (props-r '((diff-mode . fine) (face diff-refine-removed)))
+ (props-a '((diff-mode . fine) (face diff-refine-added)))
;; Be careful to go back to `start' so diff-end-of-hunk gets
;; to read the hunk header's line info.
(end (progn (goto-char start) (diff-end-of-hunk) (point))))
(remove-overlays beg end 'diff-mode 'fine)
(goto-char beg)
- (case style
- (unified
+ (pcase style
+ (`unified
(while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+"
end t)
(smerge-refine-subst (match-beginning 0) (match-end 1)
(match-end 1) (match-end 0)
- props 'diff-refine-preproc)))
- (context
+ nil 'diff-refine-preproc props-r props-a)))
+ (`context
(let* ((middle (save-excursion (re-search-forward "^---")))
(other middle))
(while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
(setq other (match-end 0))
(match-beginning 0))
other
- props 'diff-refine-preproc))))
- (t ;; Normal diffs.
+ (if diff-use-changed-face props-c)
+ 'diff-refine-preproc
+ (unless diff-use-changed-face props-r)
+ (unless diff-use-changed-face props-a)))))
+ (_ ;; Normal diffs.
(let ((beg1 (1+ (point))))
(when (re-search-forward "^---.*\n" end t)
;; It's a combined add&remove, so there's something to do.
(smerge-refine-subst beg1 (match-beginning 0)
(match-end 0) end
- props 'diff-refine-preproc))))))))
+ nil 'diff-refine-preproc props-r props-a))))))))
+(defun diff-undo (&optional arg)
+ "Perform `undo', ignoring the buffer's read-only status."
+ (interactive "P")
+ (let ((inhibit-read-only t))
+ (undo arg)))
(defun diff-add-change-log-entries-other-window ()
"Iterate through the current diff and create ChangeLog entries.
;; 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.el --- run `diff'
+;;; diff.el --- run `diff' -*- lexical-binding: t -*-
;; Copyright (C) 1992, 1994, 1996, 2001-2012 Free Software Foundation, Inc.
;;; Code:
-(eval-when-compile (require 'cl))
+(declare-function diff-setup-whitespace "diff-mode" ())
(defgroup diff nil
"Comparing files with `diff'."
delete the temporary files so named."
(if old-temp-file (delete-file old-temp-file))
(if new-temp-file (delete-file new-temp-file))
+ (diff-setup-whitespace)
+ (goto-char (point-min))
(save-excursion
(goto-char (point-max))
(let ((inhibit-read-only t))
(buffer-enable-undo (current-buffer))
(diff-mode)
(set (make-local-variable 'revert-buffer-function)
- (lexical-let ((old old) (new new)
- (switches switches)
- (no-async no-async))
- (lambda (ignore-auto noconfirm)
- (diff-no-select old new switches no-async (current-buffer)))))
+ (lambda (_ignore-auto _noconfirm)
+ (diff-no-select old new switches no-async (current-buffer))))
(setq default-directory thisdir)
(let ((inhibit-read-only t))
(insert command "\n"))
(let ((proc (start-process "Diff" buf shell-file-name
shell-command-switch command)))
(set-process-filter proc 'diff-process-filter)
- (lexical-let ((old-alt old-alt) (new-alt new-alt))
- (set-process-sentinel
- proc (lambda (proc msg)
- (with-current-buffer (process-buffer proc)
- (diff-sentinel (process-exit-status proc)
- old-alt new-alt))))))
+ (set-process-sentinel
+ proc (lambda (proc _msg)
+ (with-current-buffer (process-buffer proc)
+ (diff-sentinel (process-exit-status proc)
+ old-alt new-alt)))))
;; Async processes aren't available.
(let ((inhibit-read-only t))
(diff-sentinel
ori file))
(diff bak ori switches)))
-(defun diff-latest-backup-file (fn) ; actually belongs into files.el
+;;;###autoload
+(defun diff-latest-backup-file (fn)
"Return the latest existing backup of FILE, or nil."
(let ((handler (find-file-name-handler fn 'diff-latest-backup-file)))
(if handler
:group 'ediff-diff)
(ediff-defvar-local ediff-ignore-case nil
- "*If t, skip over difference regions that differ only in letter case.
+ "If t, skip over difference regions that differ only in letter case.
This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
Use `setq-default' if setting it in .emacs")
(ediff-defvar-local ediff-ignore-similar-regions nil
- "*If t, skip over difference regions that differ only in the white space and line breaks.
+ "If t, skip over difference regions that differ only in the white space and line breaks.
This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
(ediff-defvar-local ediff-auto-refine-limit 14000
- "*Auto-refine only the regions of this size \(in bytes\) or less.")
+ "Auto-refine only the regions of this size \(in bytes\) or less.")
;;; General
;;; Word functions used to refine the current diff
(defvar ediff-forward-word-function 'ediff-forward-word
- "*Function to call to move to the next word.
+ "Function to call to move to the next word.
Used for splitting difference regions into individual words.")
(make-variable-buffer-local 'ediff-forward-word-function)
;; \240 is Unicode symbol for nonbreakable whitespace
(defvar ediff-whitespace " \n\t\f\r\240"
- "*Characters constituting white space.
+ "Characters constituting white space.
These characters are ignored when differing regions are split into words.")
(make-variable-buffer-local 'ediff-whitespace)
(defvar ediff-word-1
(if (featurep 'xemacs) "a-zA-Z---_" "-[:word:]_")
- "*Characters that constitute words of type 1.
+ "Characters that constitute words of type 1.
More precisely, [ediff-word-1] is a regexp that matches type 1 words.
See `ediff-forward-word' for more details.")
(make-variable-buffer-local 'ediff-word-1)
(defvar ediff-word-2 "0-9.,"
- "*Characters that constitute words of type 2.
+ "Characters that constitute words of type 2.
More precisely, [ediff-word-2] is a regexp that matches type 2 words.
See `ediff-forward-word' for more details.")
(make-variable-buffer-local 'ediff-word-2)
(defvar ediff-word-3 "`'?!:;\"{}[]()"
- "*Characters that constitute words of type 3.
+ "Characters that constitute words of type 3.
More precisely, [ediff-word-3] is a regexp that matches type 3 words.
See `ediff-forward-word' for more details.")
(make-variable-buffer-local 'ediff-word-3)
(defvar ediff-word-4
(concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace)
- "*Characters that constitute words of type 4.
+ "Characters that constitute words of type 4.
More precisely, [ediff-word-4] is a regexp that matches type 4 words.
See `ediff-forward-word' for more details.")
(make-variable-buffer-local 'ediff-word-4)
"Return t if files F1 and F2 have identical contents."
(if (and (not (file-directory-p f1))
(not (file-directory-p f2)))
- (let ((res
- (apply 'call-process ediff-cmp-program nil nil nil
- (append ediff-cmp-options (list (expand-file-name f1)
- (expand-file-name f2))))
- ))
- (and (numberp res) (eq res 0)))
- ))
+ (if (equal (file-remote-p f1) (file-remote-p f2))
+ (let ((res
+ ;; In the remote case, this works only if F1 and F2 are
+ ;; located on the same remote host.
+ (apply 'process-file ediff-cmp-program nil nil nil
+ (append ediff-cmp-options
+ (list (or (file-remote-p f1 'localname)
+ (expand-file-name f1))
+ (or (file-remote-p f2 'localname)
+ (expand-file-name f2)))))
+ ))
+ (and (numberp res) (eq res 0)))
+
+ ;; F1 and F2 are not located on the same host.
+ (let ((t1 (file-local-copy f1))
+ (t2 (file-local-copy f2)))
+ (unwind-protect
+ (ediff-same-file-contents (or t1 f1) (or t2 f2))
+ (and t1 (delete-file t1))
+ (and t2 (delete-file t2))))
+ )))
(defun ediff-same-contents (d1 d2 &optional filter-re)
(ediff-defvar-local ediff-start-narrowed t
"Non-nil means start narrowed, if doing ediff-windows-* or ediff-regions-*")
(ediff-defvar-local ediff-quit-widened t
- "*Non-nil means: when finished, Ediff widens buffers A/B.
+ "Non-nil means: when finished, Ediff widens buffers A/B.
Actually, Ediff restores the scope of visibility that existed at startup.")
(defcustom ediff-keep-variants t
"Check the current version against MAJOR and MINOR version numbers.
The comparison uses operator OP, which may be any of: =, >, >=, <, <=.
TYPE-OF-EMACS is either 'xemacs or 'emacs."
+ (declare (obsolete version< "23.1"))
(and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs))
((eq type-of-emacs 'emacs) (featurep 'emacs))
(t))
(t
(error "%S: Invalid op in ediff-check-version" op)))))
-;; ediff-check-version seems to be totally unused anyway.
-(make-obsolete 'ediff-check-version 'version< "23.1")
-
(defun ediff-color-display-p ()
(condition-case nil
(if (featurep 'xemacs)
"")
-(if (ediff-window-display-p)
- (if (featurep 'xemacs)
- (progn
- (defalias 'ediff-display-pixel-width 'device-pixel-width)
- (defalias 'ediff-display-pixel-height 'device-pixel-height))
- (defalias 'ediff-display-pixel-width
- (if (fboundp 'display-pixel-width)
- 'display-pixel-width
- 'x-display-pixel-width))
- (defalias 'ediff-display-pixel-height
- (if (fboundp 'display-pixel-height)
- 'display-pixel-height
- 'x-display-pixel-height))))
+(if (featurep 'xemacs)
+ (progn
+ (defalias 'ediff-display-pixel-width 'device-pixel-width)
+ (defalias 'ediff-display-pixel-height 'device-pixel-height))
+ (defalias 'ediff-display-pixel-width 'display-pixel-width)
+ (defalias 'ediff-display-pixel-height 'display-pixel-height))
;; A-list of current-diff-overlay symbols associated with buf types
(defconst ediff-current-diff-overlay-alist
(defface ediff-current-diff-A
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffdddd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#553333")
+ (((class color) (min-colors 16))
(:foreground "firebrick" :background "pale green"))
(((class color))
(:foreground "blue3" :background "yellow3"))
(defface ediff-current-diff-B
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ddffdd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#335533")
+ (((class color) (min-colors 16))
(:foreground "DarkOrchid" :background "Yellow"))
(((class color))
(:foreground "magenta3" :background "yellow3"
(defface ediff-current-diff-C
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#888833")
+ (((class color) (min-colors 16))
(:foreground "Navy" :background "Pink"))
(((class color))
(:foreground "cyan3" :background "yellow3" :weight bold))
(defface ediff-fine-diff-A
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffaaaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aa2222")
+ (((class color) (min-colors 16))
(:foreground "Navy" :background "sky blue"))
(((class color))
(:foreground "white" :background "sky blue" :weight bold))
(defface ediff-fine-diff-B
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88) (background light))
+ :background "#aaffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#22aa22")
+ (((class color) (min-colors 16))
(:foreground "Black" :background "cyan"))
(((class color))
(:foreground "magenta3" :background "cyan3"))
(defface ediff-fine-diff-C
(if (featurep 'emacs)
- '((((type pc))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffff55")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aaaa22")
+ (((type pc))
(:foreground "white" :background "Turquoise"))
(((class color) (min-colors 16))
(:foreground "Black" :background "Turquoise"))
;; Determine which window setup function to use based on current window system.
(defun ediff-choose-window-setup-function-automatically ()
+ (declare (obsolete ediff-setup-windows-default "24.3"))
(if (ediff-window-display-p)
'ediff-setup-windows-multiframe
'ediff-setup-windows-plain))
-(defcustom ediff-window-setup-function (ediff-choose-window-setup-function-automatically)
+(defcustom ediff-window-setup-function 'ediff-setup-windows-default
"Function called to set up windows.
-Ediff provides a choice of two functions: `ediff-setup-windows-plain', for
-doing everything in one frame and `ediff-setup-windows-multiframe', which sets
-the control panel in a separate frame. By default, the appropriate function is
-chosen automatically depending on the current window system.
-However, `ediff-toggle-multiframe' can be used to toggle between the multiframe
-display and the single frame display.
-If the multiframe function detects that one of the buffers A/B is seen in some
-other frame, it will try to keep that buffer in that frame.
+Ediff provides a choice of three functions:
+ (1) `ediff-setup-windows-multiframe', which sets the control panel
+ in a separate frame.
+ (2) `ediff-setup-windows-plain', which does everything in one frame
+ (3) `ediff-setup-windows-default' (the default), which does (1)
+ on a graphical display and (2) on a text terminal.
+
+The command \\[ediff-toggle-multiframe] can be used to toggle
+between the multiframe display and the single frame display. If
+the multiframe function detects that one of the buffers A/B is
+seen in some other frame, it will try to keep that buffer in that
+frame.
If you don't like any of the two provided functions, write your own one.
The basic guidelines:
Buffer C may not be used in jobs that compare only two buffers.
If you plan to do something fancy, take a close look at how the two
provided functions are written."
- :type '(choice (const :tag "Multi Frame" ediff-setup-windows-multiframe)
+ :type '(choice (const :tag "Choose Automatically" ediff-setup-windows-default)
+ (const :tag "Multi Frame" ediff-setup-windows-multiframe)
(const :tag "Single Frame" ediff-setup-windows-plain)
(function :tag "Other function"))
- :group 'ediff-window)
+ :group 'ediff-window
+ :version "24.3")
;; indicates if we are in a multiframe setup
(ediff-defvar-local ediff-multiframe nil "")
buffer-A buffer-B buffer-C control-buffer))
(run-hooks 'ediff-after-setup-windows-hook))
+(defun ediff-setup-windows-default (buffer-A buffer-B buffer-C control-buffer)
+ (funcall (if (display-graphic-p)
+ 'ediff-setup-windows-multiframe
+ 'ediff-setup-windows-plain)
+ buffer-A buffer-B buffer-C control-buffer))
+
;; Just set up 3 windows.
;; Usually used without windowing systems
;; With windowing, we want to use dedicated frames.
(and (eq this-command 'ediff-toggle-help)
dont-iconify-ctl-frame))
- ;; 1 more line for the modeline
+ ;; 1 more line for the mode line
(setq lines (1+ (count-lines (point-min) (point-max)))
fheight lines
fwidth (max (+ (ediff-help-message-line-length) 2)
;; Revise the mode line to display which difference we have selected
-;; Also resets modelines of buffers A/B, since they may be clobbered by
+;; Also resets mode lines of buffers A/B, since they may be clobbered by
;; other invocations of Ediff.
(defun ediff-refresh-mode-lines ()
(let (buf-A-state-diff buf-B-state-diff buf-C-state-diff buf-C-state-merge)
;; and on any buffer.
-;;; Acknowledgements:
+;;; Acknowledgments:
;; Ediff was inspired by Dale R. Worley's <drw@math.mit.edu> emerge.el.
;; Ediff would not have been possible without the help and encouragement of
(require 'ediff-mult) ; required because of the registry stuff
(defgroup ediff nil
- "A comprehensive visual interface to diff & patch."
+ "Comprehensive visual interface to `diff' and `patch'."
:tag "Ediff"
:group 'tools)
;; Used as a startup hook to set `_orig' patch file read-only.
(defun ediff-set-read-only-in-buf-A ()
(ediff-with-current-buffer ediff-buffer-A
- (toggle-read-only 1)))
+ (setq buffer-read-only t)))
;; Return a plausible default for ediff's first file:
;; In dired, return the file number FILENO (or 0) in the list
(setq buf-B-file-name (file-name-nondirectory buf-B-file-name)))
(if (stringp buf-C-file-name)
(setq buf-C-file-name (file-name-nondirectory buf-C-file-name)))
-
+
(setq file-A (ediff-make-temp-file buf-A buf-A-file-name)
file-B (ediff-make-temp-file buf-B buf-B-file-name))
(if buf-C-is-alive
(setq file-C (ediff-make-temp-file buf-C buf-C-file-name)))
-
+
(ediff-setup (get-buffer buf-A) file-A
(get-buffer buf-B) file-B
(if buf-C-is-alive (get-buffer buf-C))
(default-regexp (eval ediff-default-filtering-regexp))
f)
(list (setq f (read-directory-name
- "Directory A to compare:" dir-A nil 'must-match))
- (read-directory-name "Directory B to compare:"
+ "Directory A to compare: " dir-A nil 'must-match))
+ (read-directory-name "Directory B to compare: "
(if ediff-use-last-dir
ediff-last-dir-B
(ediff-strip-last-dir f))
(ediff-with-current-buffer buffer-B
(setq beg-B (move-marker (make-marker) beg-B)
end-B (move-marker (make-marker) end-B)))
-
+
;; make file-A
(if word-mode
(ediff-wordify beg-A end-A buffer-A tmp-buffer)
(ediff-wordify beg-B end-B buffer-B tmp-buffer)
(ediff-copy-to-buffer beg-B end-B buffer-B tmp-buffer))
(setq file-B (ediff-make-temp-file tmp-buffer "regB"))
-
+
(setq overl-A (ediff-make-bullet-proof-overlay beg-A end-A buffer-A))
(setq overl-B (ediff-make-bullet-proof-overlay beg-B end-B buffer-B))
(ediff-setup buffer-A file-A
Commands must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode,
but can be invoked directly in `fast' mode.")
-(define-obsolete-variable-alias 'emerge-version 'emacs-version "23.2")
-
-(defun emerge-version ()
- "Return string describing the version of Emerge.
-When called interactively, displays the version."
- (interactive)
- (if (called-interactively-p 'interactive)
- (message "Emerge version %s" emacs-version)
- emacs-version))
-
-(make-obsolete 'emerge-version 'emacs-version "23.2")
-
;;; Emerge configuration variables
(defgroup emerge nil
(emerge-defvar-local emerge-old-keymap nil
"The original local keymap for the merge buffer.")
(emerge-defvar-local emerge-auto-advance nil
- "*If non-nil, emerge-select-A and emerge-select-B automatically advance to
+ "If non-nil, emerge-select-A and emerge-select-B automatically advance to
the next difference.")
(emerge-defvar-local emerge-skip-prefers nil
- "*If non-nil, differences for which there is a preference are automatically
+ "If non-nil, differences for which there is a preference are automatically
skipped.")
(emerge-defvar-local emerge-quit-hook nil
"Hooks to run in the merge buffer after the merge has been finished.
;;; Code:
-(eval-when-compile (require 'cl))
(require 'add-log) ; for all the ChangeLog goodies
(require 'pcvs-util)
(require 'ring)
:group 'log-edit
:type 'boolean)
-(defvar cvs-commit-buffer-require-final-newline t)
-(make-obsolete-variable 'cvs-commit-buffer-require-final-newline
- 'log-edit-require-final-newline
- "21.1")
-
-(defcustom log-edit-require-final-newline
- cvs-commit-buffer-require-final-newline
+(defcustom log-edit-require-final-newline t
"Enforce a newline at the end of commit log messages.
Enforce it silently if t, query if non-nil and don't do anything if nil."
:group 'log-edit
:group 'log-edit
:version "24.1")
-(defvar cvs-changelog-full-paragraphs t)
-(make-obsolete-variable 'cvs-changelog-full-paragraphs
- 'log-edit-changelog-full-paragraphs
- "21.1")
-
-(defvar log-edit-changelog-full-paragraphs cvs-changelog-full-paragraphs
- "*If non-nil, include full ChangeLog paragraphs in the log.
+(defvar log-edit-changelog-full-paragraphs t
+ "If non-nil, include full ChangeLog paragraphs in the log.
This may be set in the ``local variables'' section of a ChangeLog, to
indicate the policy for that ChangeLog.
(defvar log-edit-parent-buffer nil)
+(defvar log-edit-vc-backend nil
+ "VC fileset corresponding to the current log.")
+
;;; Originally taken from VC-Log mode
(defconst log-edit-maximum-comment-ring-size 32
"Maximum number of saved comments in the comment ring.")
+(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1")
(defvar log-edit-comment-ring (make-ring log-edit-maximum-comment-ring-size))
+(define-obsolete-variable-alias 'vc-comment-ring-index
+ 'log-edit-comment-ring-index "22.1")
(defvar log-edit-comment-ring-index nil)
(defvar log-edit-last-comment-match "")
(insert "\n"))))
;; Compatibility with old names.
-(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1")
-(define-obsolete-variable-alias 'vc-comment-ring-index 'log-edit-comment-ring-index "22.1")
(define-obsolete-function-alias 'vc-previous-comment 'log-edit-previous-comment "22.1")
(define-obsolete-function-alias 'vc-next-comment 'log-edit-next-comment "22.1")
(define-obsolete-function-alias 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1")
(defvar log-edit-font-lock-keywords
;; Copied/inspired by message-font-lock-keywords.
`((log-edit-match-to-eoh
- (,(concat "^\\(\\([a-z]+\\):\\)" log-edit-header-contents-regexp)
+ (,(concat "^\\(\\([[:alpha:]]+\\):\\)" log-edit-header-contents-regexp)
(progn (goto-char (match-beginning 0)) (match-end 0)) nil
(1 (if (assoc (match-string 2) log-edit-headers-alist)
'log-edit-header
'log-edit-header)
nil lax)))))
-;; Used in Emacs 24.3+, and in Emacs's .dir-locals.el file. This is a
-;; convenience setting so that people committing files to Emacs trunk
-;; with Emacs 24.2 do not always get queried about this variable being
-;; potentially unsafe.
+(defvar log-edit-font-lock-gnu-style nil
+ "If non-nil, highlight common failures to follow the GNU coding standards.")
(put 'log-edit-font-lock-gnu-style 'safe-local-variable 'booleanp)
+(defconst log-edit-font-lock-gnu-keywords
+ ;; Use
+ ;; * foo.el (bla, bli)
+ ;; (blo, blu): Toto.
+ ;; Rather than
+ ;; * foo.el (bla, bli,
+ ;; blo, blu): Toto.
+ '(("^[ \t]*\\(?:\\* .*\\)?\\(([^\n)]*,\\s-*\\)$"
+ (1 '(face font-lock-warning-face
+ help-echo "Continue function lists with \")\\n(\".") t))
+ ;; Don't leave a lone word on a single line.
+ ;;("^\\s-*\\(\\S-*[^\n:)]\\)\\s-*$" (1 font-lock-warning-face t))
+ ;; Don't cut a sentence right after the first word (better to move
+ ;; the sentence on the next line, then).
+ ;;("[.:]\\s-+\\(\\sw+\\)\\s-*$" (1 font-lock-warning-face t))
+ ;; Change Log entries should use present tense.
+ ("):[ \t\n]*[[:alpha:]]+\\(ed\\)\\>"
+ (1 '(face font-lock-warning-face help-echo "Use present tense.") t))
+ ;; Change log entries start with a capital letter.
+ ("): [a-z]" (0 '(face font-lock-warning-face help-echo "Capitalize.") t))
+ ("[^[:upper:]]\\(\\. [[:upper:]]\\)"
+ (1 '(face font-lock-warning-face
+ help-echo "Use two spaces to end a sentence") t))
+ ("^("
+ (0 (let ((beg (max (point-min) (- (match-beginning 0) 2))))
+ (put-text-property beg (match-end 0) 'font-lock-multiline t)
+ (if (eq (char-syntax (char-after beg)) ?w)
+ '(face font-lock-warning-face
+ help-echo "Punctuate previous line.")))
+ t))
+ ))
+
+(defun log-edit-font-lock-keywords ()
+ (if log-edit-font-lock-gnu-style
+ (append log-edit-font-lock-keywords
+ log-edit-font-lock-gnu-keywords)
+ log-edit-font-lock-keywords))
+
;;;###autoload
(defun log-edit (callback &optional setup params buffer mode &rest _ignore)
"Setup a buffer to enter a log message.
-\\<log-edit-mode-map>The buffer will be put in mode MODE or `log-edit-mode'
-if MODE is nil.
-If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run.
-Mark and point will be set around the entire contents of the buffer so
-that it is easy to kill the contents of the buffer with \\[kill-region].
-Once you're done editing the message, pressing \\[log-edit-done] will call
-`log-edit-done' which will end up calling CALLBACK to do the actual commit.
-
-PARAMS if non-nil is an alist. Possible keys and associated values:
+The buffer is put in mode MODE or `log-edit-mode' if MODE is nil.
+\\<log-edit-mode-map>
+If SETUP is non-nil, erase the buffer and run `log-edit-hook'.
+Set mark and point around the entire contents of the buffer, so
+that it is easy to kill the contents of the buffer with
+\\[kill-region]. Once the user is done editing the message,
+invoking the command \\[log-edit-done] (`log-edit-done') will
+call CALLBACK to do the actual commit.
+
+PARAMS if non-nil is an alist of variables and buffer-local
+values to give them in the Log Edit buffer. Possible keys and
+associated values:
`log-edit-listfun' -- function taking no arguments that returns the list of
files that are concerned by the current operation (using relative names);
`log-edit-diff-function' -- function taking no arguments that
displays a diff of the files concerned by the current operation.
+ `vc-log-fileset' -- the VC fileset to be committed (if any).
-If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the
-log message and go back to the current buffer when done. Otherwise, it
-uses the current buffer."
+If BUFFER is non-nil `log-edit' will jump to that buffer, use it
+to edit the log message and go back to the current buffer when
+done. Otherwise, it uses the current buffer."
(let ((parent (current-buffer)))
(if buffer (pop-to-buffer buffer))
(when (and log-edit-setup-invert (not (eq setup 'force)))
\\{log-edit-mode-map}"
(set (make-local-variable 'font-lock-defaults)
- '(log-edit-font-lock-keywords t t))
+ '(log-edit-font-lock-keywords t))
(make-local-variable 'log-edit-comment-ring-index)
(hack-dir-local-variables-non-file-buffer))
;;; Code:
-(eval-when-compile (require 'cl))
(require 'pcvs-util)
(autoload 'vc-find-revision "vc")
(autoload 'vc-diff-internal "vc")
'(log-view-font-lock-keywords t nil nil nil))
(defvar log-view-vc-fileset nil
- "Set this to the fileset corresponding to the current log.")
+ "The VC fileset corresponding to the current log.")
(defvar log-view-vc-backend nil
- "Set this to the VC backend that created the current log.")
+ "The VC backend that created the current log.")
;;;;
;;;; Actual code
(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)
(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)
(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))
;;; Code:
-(eval-when-compile (require 'cl))
(require 'pcvs-util)
;;;; -------------------------------------------------------
;;;; START OF THINGS TO CHECK WHEN INSTALLING
(defvar cvs-program "cvs"
- "*Name or full path of the cvs executable.")
+ "Name or full path of the cvs executable.")
(defvar cvs-version
;; With the divergence of the CVSNT codebase and version numbers, this is
nil t)
(cons (string-to-number (match-string 1))
(string-to-number (match-string 2))))))
- "*Version of `cvs' installed on your system.
+ "Version of `cvs' installed on your system.
It must be in the (MAJOR . MINOR) format.")
;; FIXME: this is only used by cvs-mode-diff-backup
(defvar cvs-diff-program (or (and (boundp 'diff-command) diff-command) "diff")
- "*Name or full path of the best diff program you've got.
+ "Name or full path of the best diff program you've got.
NOTE: there are some nasty bugs in the context diff variants of some vendor
versions, such as the one in SunOS-4.")
;;;; END OF THINGS TO CHECK WHEN INSTALLING
;;;; --------------------------------------------------------
-;;;;
;;;; User configuration variables:
-;;;;
-;;;; NOTE: these should be set in your ~/.emacs (or site-lisp/default.el) file.
-;;;;
(defgroup pcl-cvs nil
"Special support for the CVS versioning system."
"List of flags whose settings is shared among several commands.")
(defvar cvs-cvsroot nil
- "*Specifies where the (current) cvs master repository is.
+ "Specifies where the (current) cvs master repository is.
Overrides the environment variable $CVSROOT by sending \" -d dir\" to
all CVS commands. This switch is useful if you have multiple CVS
repositories. It can be set interactively with \\[cvs-change-cvsroot.]
:group 'pcl-cvs
:type '(boolean))
-(defvar cvs-diff-ignore-marks t)
-(make-obsolete-variable 'cvs-diff-ignore-marks
- 'cvs-invert-ignore-marks
- "21.1")
-
(defcustom cvs-invert-ignore-marks
(let ((l ()))
- (unless (equal cvs-diff-ignore-marks cvs-default-ignore-marks)
+ (unless (equal cvs-default-ignore-marks t)
(push "diff" l))
(when (and cvs-force-dir-tag (not cvs-default-ignore-marks))
(push "tag" l))
:type '(choice (const :tag "Prompt" nil)
(string)))
-(defvar cvs-diff-buffer-name "*cvs-diff*")
-(make-obsolete-variable 'cvs-diff-buffer-name
- 'cvs-buffer-name-alist
- "21.1")
-
(defcustom cvs-find-file-and-jump nil
"Jump to the modified area when finding a file.
If non-nil, `cvs-mode-find-file' will place the cursor at the beginning of
:type '(boolean))
(defcustom cvs-buffer-name-alist
- '(("diff" cvs-diff-buffer-name diff-mode)
+ '(("diff" "*cvs-diff*" diff-mode)
("status" "*cvs-info*" cvs-status-mode)
("tree" "*cvs-info*" cvs-status-mode)
("message" "*cvs-commit*" nil log-edit)
;; Was '(expand-file-name " *cvs-tmp*" dir), but that causes them to
;; become non-hidden if uniquification is done `forward'.
" *cvs-tmp*"
- "*Name of the cvs temporary buffer.
+ "Name of the cvs temporary buffer.
Output from cvs is placed here for asynchronous commands.")
(defcustom cvs-idiff-imerge-handlers
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;(require 'pcvs-defs)
;; Constructor:
-(defstruct (cvs-fileinfo
+(cl-defstruct (cvs-fileinfo
(:constructor nil)
(:copier nil)
(:constructor -cvs-create-fileinfo (type dir file full-log
(string= file (file-name-nondirectory file)))
(setq check 'type) (symbolp type)
(setq check 'consistency)
- (case type
- (DIRCHANGE (and (null subtype) (string= "." file)))
- ((NEED-UPDATE ADDED MISSING DEAD MODIFIED MESSAGE UP-TO-DATE
- REMOVED NEED-MERGE CONFLICT UNKNOWN MESSAGE)
+ (pcase type
+ (`DIRCHANGE (and (null subtype) (string= "." file)))
+ ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE
+ `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN)
t)))
fi
(error "Invalid :%s in cvs-fileinfo %s" check fi))))
(defun cvs-add-face (str face &optional keymap &rest props)
(when keymap
(when (keymapp keymap)
- (setq props (list* 'keymap keymap props)))
- (setq props (list* 'mouse-face 'highlight props)))
- (add-text-properties 0 (length str) (list* 'font-lock-face face props) str)
+ (setq props `(keymap ,keymap ,@props)))
+ (setq props `(mouse-face highlight ,@props)))
+ (add-text-properties 0 (length str) `(font-lock-face ,face ,@props) str)
str)
(defun cvs-fileinfo-pp (fileinfo)
(let ((type (cvs-fileinfo->type fileinfo))
(subtype (cvs-fileinfo->subtype fileinfo)))
(insert
- (case type
- (DIRCHANGE (concat "In directory "
- (cvs-add-face (cvs-fileinfo->full-name fileinfo)
- 'cvs-header t 'cvs-goal-column t)
- ":"))
- (MESSAGE
+ (pcase type
+ (`DIRCHANGE (concat "In directory "
+ (cvs-add-face (cvs-fileinfo->full-name fileinfo)
+ 'cvs-header t 'cvs-goal-column t)
+ ":"))
+ (`MESSAGE
(cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
'cvs-msg))
- (t
+ (_
(let* ((status (if (cvs-fileinfo->marked fileinfo)
(cvs-add-face "*" 'cvs-marked)
" "))
(base (or (cvs-fileinfo->base-rev fileinfo) ""))
(head (cvs-fileinfo->head-rev fileinfo))
(type
- (let ((str (case type
+ (let ((str (pcase type
;;(MOD-CONFLICT "Not Removed")
- (DEAD "")
- (t (capitalize (symbol-name type)))))
+ (`DEAD "")
+ (_ (capitalize (symbol-name type)))))
(face (let ((sym (intern
(concat "cvs-fi-"
(downcase (symbol-name type))
;;; Code:
-(eval-when-compile (require 'cl))
-
(require 'pcvs-util)
(require 'pcvs-info)
then assign the variables as specified in MATCHES (via `setq')."
(cons 'cvs-do-match
(cons re (mapcar (lambda (match)
- `(cons ',(first match) ,(second match)))
+ `(cons ',(car match) ,(cadr match)))
matches))))
(defun cvs-do-match (re &rest matches)
(cvs-or
(funcall parse-spec)
- (dolist (re cvs-parse-ignored-messages)
- (when (cvs-match re) (return t)))
+ (cl-dolist (re cvs-parse-ignored-messages)
+ (when (cvs-match re) (cl-return t)))
;; This is a parse error. Create a message-type fileinfo.
(and
;; ?: Unknown file.
(let ((code (aref c 0)))
(cvs-parsed-fileinfo
- (case code
+ (pcase code
(?M 'MODIFIED)
(?A 'ADDED)
(?R 'REMOVED)
(if (re-search-forward "^<<<<<<< " nil t)
'CONFLICT 'NEED-MERGE))))
(?J 'NEED-MERGE) ;not supported by standard CVS
- ((?U ?P)
+ ((or ?U ?P)
(if dont-change-disc 'NEED-UPDATE
(cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED)))))
path 'trust)))
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;;
;;;; list processing
(while (and l (> n 1))
(setcdr nl (list (pop l)))
(setq nl (cdr nl))
- (decf n))
+ (cl-decf n))
ret))))
(defun cvs-partition (p l)
(if noreuse (generate-new-buffer name)
(get-buffer-create name)))
(unless noreuse
- (dolist (buf (buffer-list))
+ (cl-dolist (buf (buffer-list))
(with-current-buffer buf
(when (equal name list-buffers-directory)
- (return buf)))))
+ (cl-return buf)))))
(with-current-buffer (create-file-buffer name)
(setq list-buffers-directory name)
(current-buffer))))
(if oneline (line-end-position) (point-max))))
(file-error nil)))
-(defun cvs-string-prefix-p (str1 str2)
- "Tell whether STR1 is a prefix of STR2."
- (eq t (compare-strings str2 nil (length str1) str1 nil nil)))
+(define-obsolete-function-alias 'cvs-string-prefix-p 'string-prefix-p "24.3")
;;;;
;;;; file names
;;;; (interactive <foo>) support function
;;;;
-(defstruct (cvs-qtypedesc
- (:constructor nil) (:copier nil)
- (:constructor cvs-qtypedesc-create
- (str2obj obj2str &optional complete hist-sym require)))
+(cl-defstruct (cvs-qtypedesc
+ (:constructor nil) (:copier nil)
+ (:constructor cvs-qtypedesc-create
+ (str2obj obj2str &optional complete hist-sym require)))
str2obj
obj2str
hist-sym
;;;; Flags handling
;;;;
-(defstruct (cvs-flags
- (:constructor nil)
- (:constructor -cvs-flags-make
- (desc defaults &optional qtypedesc hist-sym)))
+(cl-defstruct (cvs-flags
+ (:constructor nil)
+ (:constructor -cvs-flags-make
+ (desc defaults &optional qtypedesc hist-sym)))
defaults persist desc qtypedesc hist-sym)
(defmacro cvs-flags-define (sym defaults
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'ewoc) ;Ewoc was once cookie
(require 'pcvs-defs)
(require 'pcvs-util)
(autoload 'cvs-status-get-tags "cvs-status")
(defun cvs-tags-list ()
"Return a list of acceptable tags, ready for completions."
- (assert (cvs-buffer-p))
+ (cl-assert (cvs-buffer-p))
(let ((marked (cvs-get-marked)))
- (list* '("BASE") '("HEAD")
- (when marked
- (with-temp-buffer
- (process-file cvs-program
- nil ;no input
- t ;output to current-buffer
- nil ;don't update display while running
- "status"
- "-v"
- (cvs-fileinfo->full-name (car marked)))
- (goto-char (point-min))
- (let ((tags (cvs-status-get-tags)))
- (when (listp tags) tags)))))))
+ `(("BASE") ("HEAD")
+ ,@(when marked
+ (with-temp-buffer
+ (process-file cvs-program
+ nil ;no input
+ t ;output to current-buffer
+ nil ;don't update display while running
+ "status"
+ "-v"
+ (cvs-fileinfo->full-name (car marked)))
+ (goto-char (point-min))
+ (let ((tags (cvs-status-get-tags)))
+ (when (listp tags) tags)))))))
(defvar cvs-tag-history nil)
(defconst cvs-qtypedesc-tag
;; look for another cvs buffer visiting the same directory
(save-excursion
(unless new
- (dolist (buffer (cons (current-buffer) (buffer-list)))
+ (cl-dolist (buffer (cons (current-buffer) (buffer-list)))
(set-buffer buffer)
(and (cvs-buffer-p)
- (case cvs-reuse-cvs-buffer
- (always t)
- (subdir
- (or (cvs-string-prefix-p default-directory dir)
- (cvs-string-prefix-p dir default-directory)))
- (samedir (string= default-directory dir)))
- (return buffer)))))
+ (pcase cvs-reuse-cvs-buffer
+ (`always t)
+ (`subdir
+ (or (string-prefix-p default-directory dir)
+ (string-prefix-p dir default-directory)))
+ (`samedir (string= default-directory dir)))
+ (cl-return buffer)))))
;; we really have to create a new buffer:
;; we temporarily bind cwd to "" to prevent
;; create-file-buffer from using directory info
;;(set-buffer buf)
buffer))))))
-(defun* cvs-cmd-do (cmd dir flags fis new
+(cl-defun cvs-cmd-do (cmd dir flags fis new
&key cvsargs noexist dont-change-disc noshow)
(let* ((dir (file-name-as-directory
(abbreviate-file-name (expand-file-name dir))))
;; cvsbuf))))
(defun cvs-run-process (args fis postprocess &optional single-dir)
- (assert (cvs-buffer-p cvs-buffer))
+ (cl-assert (cvs-buffer-p cvs-buffer))
(save-current-buffer
(let ((procbuf (current-buffer))
(cvsbuf cvs-buffer)
(let ((inhibit-read-only t))
(insert "pcl-cvs: descending directory " dir "\n"))
;; loop to find the same-dir-elems
- (do* ((files () (cons (cvs-fileinfo->file fi) files))
- (fis fis (cdr fis))
- (fi (car fis) (car fis)))
+ (cl-do* ((files () (cons (cvs-fileinfo->file fi) files))
+ (fis fis (cdr fis))
+ (fi (car fis) (car fis)))
((not (and fis (string= dir (cvs-fileinfo->dir fi))))
(list dir files fis))))))
(dir (nth 0 dir+files+rest))
(while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
(setq tin (ewoc-prev c tin)))
(if (null tin) (ewoc-enter-first c fi) ;empty collection
- (assert (not (cvs-fileinfo< fi (ewoc-data tin))))
+ (cl-assert (not (cvs-fileinfo< fi (ewoc-data tin))))
(let ((next-tin (ewoc-next c tin)))
(while (not (or (null next-tin)
(cvs-fileinfo< fi (ewoc-data next-tin))))
(let* ((type (cvs-fileinfo->type fi))
(subtype (cvs-fileinfo->subtype fi))
(keep
- (case type
+ (pcase type
;; remove temp messages and keep the others
- (MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
+ (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
;; remove entries
- (DEAD nil)
+ (`DEAD nil)
;; handled also?
- (UP-TO-DATE (not rm-handled))
+ (`UP-TO-DATE (not rm-handled))
;; keep the rest
- (t (not (run-hook-with-args-until-success
+ (_ (not (run-hook-with-args-until-success
'cvs-cleanup-functions fi))))))
;; mark dirs for removal
(eq (cvs-fileinfo->type last-fi) 'DIRCHANGE)
(not (when first-dir (setq first-dir nil) t))
(or (eq rm-dirs 'all)
- (not (cvs-string-prefix-p
+ (not (string-prefix-p
(cvs-fileinfo->dir last-fi)
(cvs-fileinfo->dir fi)))
(and (eq type 'DIRCHANGE) (eq rm-dirs 'empty))
fis))))
(nreverse fis)))
-(defun* cvs-mode-marked (filter &optional cmd
+(cl-defun cvs-mode-marked (filter &optional cmd
&key read-only one file noquery)
"Get the list of marked FIS.
CMD is used to determine whether to use the marks or not.
(let ((msg (buffer-substring-no-properties (point-min) (point-max))))
(cvs-mode!)
;;(pop-to-buffer cvs-buffer)
- (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
+ (cvs-mode-do "commit" `("-m" ,msg ,@flags) 'commit)))
;;;; Editing existing commit log messages.
(or current-prefix-arg (not cvs-add-default-message)))
(read-from-minibuffer "Enter description: ")
(or cvs-add-default-message "")))
- (flags (list* "-m" msg flags))
+ (flags `("-m" ,msg ,@flags))
(postproc
;; setup postprocessing for the directory entries
(when dirs
(set-buffer-modified-p nil)
(let ((buffer-file-name (expand-file-name file)))
(after-find-file))
- (toggle-read-only 1)
+ (setq buffer-read-only t)
(message "Retrieving revision %s... Done" rev)
(current-buffer))))))
(setq buffer-file-name (expand-file-name buffer-file-name))
(let (ret)
(dolist (fi (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))
- (when (cvs-string-prefix-p
+ (when (string-prefix-p
(expand-file-name (cvs-fileinfo->full-name fi) dir)
buffer-file-name)
(setq ret t)))
ret)))
-(defun* cvs-mode-run (cmd flags fis
+(cl-defun cvs-mode-run (cmd flags fis
&key (buf (cvs-temp-buffer))
dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
(cvs-run-process args fis postproc single-dir))))
-(defun* cvs-mode-do (cmd flags filter
+(cl-defun cvs-mode-do (cmd flags filter
&key show dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
Executes `cvs CVSARGS CMD FLAGS' on the selected files.
(defun cvs-dir-member-p (fileinfo dir)
"Return true if FILEINFO represents a file in directory DIR."
(and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE))
- (cvs-string-prefix-p dir (cvs-fileinfo->dir fileinfo))))
+ (string-prefix-p dir (cvs-fileinfo->dir fileinfo))))
(defun cvs-execute-single-file (fi extractor program constant-args)
"Internal function for `cvs-execute-single-file-list'."
(set-buffer cvs-buf)
;; look for a corresponding pcl-cvs buffer
(when (and (eq major-mode 'cvs-mode)
- (cvs-string-prefix-p default-directory dir))
+ (string-prefix-p default-directory dir))
(let ((subdir (substring dir (length default-directory))))
(set-buffer buffer)
(set (make-local-variable 'cvs-buffer) cvs-buf)
(set-buffer cvs-buf)
;; look for a corresponding pcl-cvs buffer
(when (and (eq major-mode 'cvs-mode)
- (cvs-string-prefix-p default-directory file))
+ (string-prefix-p default-directory file))
(let* ((file (substring file (length default-directory)))
(fi (cvs-create-fileinfo
(if (string= "0" version)
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'diff-mode) ;For diff-auto-refine-mode.
(require 'newcomment)
:type 'boolean)
(defface smerge-mine
- '((((min-colors 88) (background light))
- (:foreground "blue1"))
- (((background light))
- (:foreground "blue"))
- (((min-colors 88) (background dark))
- (:foreground "cyan1"))
- (((background dark))
- (:foreground "cyan")))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffdddd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#553333")
+ (((class color))
+ :foreground "red"))
"Face for your code."
:group 'smerge)
(define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1")
(defvar smerge-mine-face 'smerge-mine)
(defface smerge-other
- '((((background light))
- (:foreground "darkgreen"))
- (((background dark))
- (:foreground "lightgreen")))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ddffdd")
+ (((class color) (min-colors 88) (background dark))
+ :background "#335533")
+ (((class color))
+ :foreground "green"))
"Face for the other code."
:group 'smerge)
(define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1")
(defvar smerge-other-face 'smerge-other)
(defface smerge-base
- '((((min-colors 88) (background light))
- (:foreground "red1"))
- (((background light))
- (:foreground "red"))
- (((background dark))
- (:foreground "orange")))
+ '((((class color) (min-colors 88) (background light))
+ :background "#ffffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#888833")
+ (((class color))
+ :foreground "yellow"))
"Face for the base code."
:group 'smerge)
(define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1")
(defvar smerge-markers-face 'smerge-markers)
(defface smerge-refined-change
- '((t :background "yellow"))
+ '((t nil))
"Face used for char-based changes shown by `smerge-refine'."
:group 'smerge)
+(defface smerge-refined-removed
+ '((default
+ :inherit smerge-refined-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#ffaaaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aa2222")
+ (t :inverse-video t))
+ "Face used for removed characters shown by `smerge-refine'."
+ :group 'smerge
+ :version "24.3")
+
+(defface smerge-refined-added
+ '((default
+ :inherit smerge-refined-change)
+ (((class color) (min-colors 88) (background light))
+ :background "#aaffaa")
+ (((class color) (min-colors 88) (background dark))
+ :background "#22aa22")
+ (t :inverse-video t))
+ "Face used for added characters shown by `smerge-refine'."
+ :group 'smerge
+ :version "24.3")
+
(easy-mmode-defmap smerge-basic-map
`(("n" . smerge-next)
("p" . smerge-prev)
))))
(defvar smerge-resolve-function
- (lambda () (error "Don't know how to resolve"))
+ (lambda () (user-error "Don't know how to resolve"))
"Mode-specific merge function.
The function is called with zero or one argument (non-nil if the resolution
function should only apply safe heuristics) and with the match data set
according to `smerge-match-conflict'.")
-(add-to-list 'debug-ignored-errors "Don't know how to resolve")
(defvar smerge-text-properties
`(help-echo "merge conflict: mouse-3 shows a menu"
(set-match-data md)
(smerge-keep-n choice))
(t
- (error "Don't know how to resolve"))))
+ (user-error "Don't know how to resolve"))))
(if (buffer-name buf) (kill-buffer buf))
(if m (delete-file m))
(if b (delete-file b))
(while (or (not (match-end i))
(< (point) (match-beginning i))
(>= (point) (match-end i)))
- (decf i))
+ (cl-decf i))
i))
(defun smerge-keep-current ()
(filename (or (match-string 1) ""))
(_ (re-search-forward smerge-end-re))
- (_ (assert (< orig-point (match-end 0))))
+ (_ (cl-assert (< orig-point (match-end 0))))
(other-end (match-beginning 0))
(end (match-end 0))
(when base-start (1- base-start)) base-start
(1- other-start) other-start))
t)
- (search-failed (error "Point not in conflict region")))))
-
-(add-to-list 'debug-ignored-errors "Point not in conflict region")
+ (search-failed (user-error "Point not in conflict region")))))
(defun smerge-conflict-overlay (pos)
"Return the conflict overlay at POS if any."
(dolist (x props) (overlay-put ol (car x) (cdr x)))
ol)))))
-(defun smerge-refine-subst (beg1 end1 beg2 end2 props &optional preproc)
+(defun smerge-refine-subst (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)
"Show fine differences in the two regions BEG1..END1 and BEG2..END2.
-PROPS is an alist of properties to put (via overlays) on the changes.
+PROPS-C is an alist of properties to put (via overlays) on the changes.
+PROPS-R is an alist of properties to put on removed characters.
+PROPS-A is an alist of properties to put on added characters.
+If PROPS-R and PROPS-A are nil, put PROPS-C on all changes.
+If PROPS-C is nil, but PROPS-R and PROPS-A are non-nil,
+put PROPS-A on added characters, PROPS-R on removed characters.
+If PROPS-C, PROPS-R and PROPS-A are non-nil, put PROPS-C on changed characters,
+PROPS-A on added characters, and PROPS-R on removed characters.
+
If non-nil, PREPROC is called with no argument in a buffer that contains
a copy of a region, just before preparing it to for `diff'. It can be
used to replace chars to try and eliminate some spurious differences."
(m5 (match-string 5)))
(when (memq op '(?d ?c))
(setq last1
- (smerge-refine-highlight-change buf beg1 m1 m2 props)))
+ (smerge-refine-highlight-change
+ buf beg1 m1 m2
+ ;; Try to use props-c only for changed chars,
+ ;; fallback to props-r for changed/removed chars,
+ ;; but if props-r is nil then fallback to props-c.
+ (or (and (eq op '?c) props-c) props-r props-c))))
(when (memq op '(?a ?c))
(setq last2
- (smerge-refine-highlight-change buf beg2 m4 m5 props))))
+ (smerge-refine-highlight-change
+ buf beg2 m4 m5
+ ;; Same logic as for removed chars above.
+ (or (and (eq op '?c) props-c) props-a props-c)))))
(forward-line 1) ;Skip hunk header.
(and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
(goto-char (match-beginning 0))))
- ;; (assert (or (null last1) (< (overlay-start last1) end1)))
- ;; (assert (or (null last2) (< (overlay-start last2) end2)))
+ ;; (cl-assert (or (null last1) (< (overlay-start last1) end1)))
+ ;; (cl-assert (or (null last2) (< (overlay-start last2) end2)))
(if smerge-refine-weight-hack
(progn
- ;; (assert (or (null last1) (<= (overlay-end last1) end1)))
- ;; (assert (or (null last2) (<= (overlay-end last2) end2)))
+ ;; (cl-assert (or (null last1) (<= (overlay-end last1) end1)))
+ ;; (cl-assert (or (null last2) (<= (overlay-end last2) end2)))
)
;; smerge-refine-forward-function when calling in chopup may
;; have stopped because it bumped into EOB whereas in
((eq (match-end 3) (match-beginning 3)) 3)
(t 2)))
(let ((n1 (if (eq part 1) 2 1))
- (n2 (if (eq part 3) 2 3)))
+ (n2 (if (eq part 3) 2 3))
+ (smerge-use-changed-face
+ (and (face-differs-from-default-p 'smerge-refined-change)
+ (not (face-equal 'smerge-refined-change 'smerge-refined-added))
+ (not (face-equal 'smerge-refined-change 'smerge-refined-removed)))))
(smerge-ensure-match n1)
(smerge-ensure-match n2)
(with-silent-modifications
(cons (buffer-chars-modified-tick) part)))
(smerge-refine-subst (match-beginning n1) (match-end n1)
(match-beginning n2) (match-end n2)
- '((smerge . refine)
- (face . smerge-refined-change)))))
+ (if smerge-use-changed-face
+ '((smerge . refine) (face . smerge-refined-change)))
+ nil
+ (unless smerge-use-changed-face
+ '((smerge . refine) (face . smerge-refined-removed)))
+ (unless smerge-use-changed-face
+ '((smerge . refine) (face . smerge-refined-added))))))
(defun smerge-diff (n1 n2)
(smerge-match-conflict)
(progn (pop-mark) (mark))
(when current-prefix-arg (pop-mark) (mark))))
;; Start from the end so as to avoid problems with pos-changes.
- (destructuring-bind (pt1 pt2 pt3 &optional pt4)
- (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=)
+ (pcase-let ((`(,pt1 ,pt2 ,pt3 ,pt4)
+ (sort `(,pt1 ,pt2 ,pt3 ,@(if pt4 (list pt4))) '>=)))
(goto-char pt1) (beginning-of-line)
(insert ">>>>>>> OTHER\n")
(goto-char pt2) (beginning-of-line)
(require 'vc)
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defcustom vc-annotate-display-mode 'fullscale
"Which mode to color the output of \\[vc-annotate] with by default."
(let ((bol (point))
(date (vc-call-backend vc-annotate-backend 'annotate-time))
(inhibit-read-only t))
- (assert (>= (point) bol))
+ (cl-assert (>= (point) bol))
(put-text-property bol (point) 'invisible 'vc-annotate-annotation)
date))
(car rev-at-line) t 1)))))))
(defun vc-annotate-show-diff-revision-at-line-internal (filediff)
- (if (not (equal major-mode 'vc-annotate-mode))
+ (if (not (derived-mode-p 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
(let* ((rev-at-line (vc-annotate-extract-revision-at-line))
- (prev-rev nil)
- (rev (car rev-at-line))
- (fname (cdr rev-at-line)))
+ (prev-rev nil)
+ (rev (car rev-at-line))
+ (fname (cdr rev-at-line)))
(if (not rev-at-line)
(message "Cannot extract revision number from the current line")
(setq prev-rev
(if filediff fname nil) rev))
(if (not prev-rev)
(message "Cannot diff from any revision prior to %s" rev)
- (save-window-excursion
- (vc-diff-internal
- nil
- ;; The value passed here should follow what
- ;; `vc-deduce-fileset' returns.
- (list vc-annotate-backend
- (if filediff
- (list fname)
- nil))
- prev-rev rev))
- (switch-to-buffer "*vc-diff*"))))))
+ (vc-diff-internal
+ t
+ ;; The value passed here should follow what
+ ;; `vc-deduce-fileset' returns.
+ (list vc-annotate-backend
+ (if filediff
+ (list fname)
+ nil))
+ prev-rev rev))))))
(defun vc-annotate-show-diff-revision-at-line ()
"Visit the diff of the revision at line from its previous revision."
-;;; vc-arch.el --- VC backend for the Arch version-control system
+;;; vc-arch.el --- VC backend for the Arch version-control system -*- lexical-binding: t -*-
;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;; Code:
-(eval-when-compile (require 'vc) (require 'cl))
+(eval-when-compile (require 'vc))
;;; Properties of the backend
(defun vc-arch-revision-granularity () 'repository)
-(defun vc-arch-checkout-model (files) 'implicit)
+(defun vc-arch-checkout-model (_files) 'implicit)
;;;
;;; Customization options
(vc-file-setprop
file 'arch-root root)))))
-(defun vc-arch-register (files &optional rev comment)
+(defun vc-arch-register (files &optional rev _comment)
(if rev (error "Explicit initial revision not supported for Arch"))
(dolist (file files)
(let ((tagmet (vc-arch-tagging-method file)))
;; Strip the terminating newline.
(buffer-substring (point-min) (1- (point-max)))))))))
-(defun vc-arch-workfile-unchanged-p (file)
+(defun vc-arch-workfile-unchanged-p (_file)
"Stub: arch workfiles are always considered to be in a changed state,"
nil)
:group 'vc-arch)
(defun vc-arch-mode-line-string (file)
- "Return string for placement in modeline by `vc-mode-line' for FILE."
+ "Return a string for `vc-mode-line' to put in the mode line for FILE."
(let ((rev (vc-working-revision file)))
(dolist (rule vc-arch-mode-line-rewrite)
(if (string-match (car rule) rev)
(setq rev (replace-match (cdr rule) t nil rev))))
(format "Arch%c%s"
- (case (vc-state file)
- ((up-to-date needs-update) ?-)
- (added ?@)
+ (pcase (vc-state file)
+ ((or `up-to-date `needs-update) ?-)
+ (`added ?@)
(t ?:))
rev)))
"*"))))))
(defun vc-arch-revision-completion-table (files)
- (lexical-let ((files files))
- (lambda (string pred action)
- ;; FIXME: complete revision patches as well.
- (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files))))
- (table (vc-arch--version-completion-table root string)))
- (complete-with-action action table string pred)))))
+ (lambda (string pred action)
+ ;; FIXME: complete revision patches as well.
+ (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files))))
+ (table (vc-arch--version-completion-table root string)))
+ (complete-with-action action table string pred))))
;;; Trimming revision libraries.
minrev))
(defun vc-arch-trim-make-sentinel (revs)
- (if (null revs) (lambda (proc msg) (message "VC-Arch trimming ... done"))
- (lexical-let ((revs revs))
- (lambda (proc msg)
- (message "VC-Arch trimming %s..." (file-name-nondirectory (car revs)))
- (rename-file (car revs) (concat (car revs) "*rm*"))
- (setq proc (start-process "vc-arch-trim" nil
- "rm" "-rf" (concat (car revs) "*rm*")))
+ (if (null revs) (lambda (_proc _msg) (message "VC-Arch trimming ... done"))
+ (lambda (_proc _msg)
+ (message "VC-Arch trimming %s..." (file-name-nondirectory (car revs)))
+ (rename-file (car revs) (concat (car revs) "*rm*"))
+ (let ((proc (start-process "vc-arch-trim" nil
+ "rm" "-rf" (concat (car revs) "*rm*"))))
(set-process-sentinel proc (vc-arch-trim-make-sentinel (cdr revs)))))))
(defun vc-arch-trim-one-revlib (dir)
'car-less-than-car))
(subdirs nil))
(when (cddr revs)
- (dotimes (i (/ (length revs) 2))
+ (dotimes (_i (/ (length revs) 2))
(let ((minrev (vc-arch-trim-find-least-useful-rev revs)))
(setq revs (delq minrev revs))
(push minrev subdirs)))
-;;; vc-bzr.el --- VC backend for the bzr revision control system
+;;; vc-bzr.el --- VC backend for the bzr revision control system -*- lexical-binding: t -*-
;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; are bzr-versioned, `vc-bzr` presently runs `bzr status` on the
;; symlink, thereby not detecting whether the actual contents
;; (that is, the target contents) are changed.
-;; See https://bugs.launchpad.net/vc-bzr/+bug/116607
;;; Properties of the backend
(defun vc-bzr-revision-granularity () 'repository)
-(defun vc-bzr-checkout-model (files) 'implicit)
+(defun vc-bzr-checkout-model (_files) 'implicit)
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc) ;; for vc-exec-after
(require 'vc-dir))
:group 'vc-bzr
:type 'string)
-(defcustom vc-bzr-sha1-program '("sha1sum")
- "Name of program to compute SHA1.
-It must be a string \(program name\) or list of strings \(name and its args\)."
- :type '(repeat string)
- :group 'vc-bzr)
-
-(define-obsolete-variable-alias 'sha1-program 'vc-bzr-sha1-program "24.1")
-
(defcustom vc-bzr-diff-switches nil
"String or list of strings specifying switches for bzr diff under VC.
If nil, use the value of `vc-diff-switches'. If t, use no switches."
`LC_MESSAGES=C' to the environment. If BZR-COMMAND is \"status\",
prepends `vc-bzr-status-switches' to ARGS."
(let ((process-environment
- (list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
- "LC_MESSAGES=C" ; Force English output
- process-environment)))
+ `("BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
+ "LC_MESSAGES=C" ; Force English output
+ ,@process-environment)))
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
file-or-list bzr-command
(if (and (string-equal "status" bzr-command)
`vc-do-async-command', and specify an output buffer named
\"*vc-bzr : ROOT*\". Return this buffer."
(let* ((process-environment
- (list* "BZR_PROGRESS_BAR=none" "LC_MESSAGES=C"
- process-environment))
+ `("BZR_PROGRESS_BAR=none" "LC_MESSAGES=C"
+ ,@process-environment))
(root (vc-bzr-root default-directory))
(buffer (format "*vc-bzr : %s*" (expand-file-name root))))
(apply 'vc-do-async-command buffer root
(defun vc-bzr-sha1 (file)
(with-temp-buffer
(set-buffer-multibyte nil)
- (let ((prog vc-bzr-sha1-program)
- (args nil)
- process-file-side-effects)
- (when (consp prog)
- (setq args (cdr prog))
- (setq prog (car prog)))
- (apply 'process-file prog (file-relative-name file) t nil args)
- (buffer-substring (point-min) (+ (point-min) 40)))))
+ (insert-file-contents-literally file)
+ (sha1 (current-buffer))))
(defun vc-bzr-state-heuristic (file)
"Like `vc-bzr-state' but hopefully without running Bzr."
- ;; `bzr status' was excruciatingly slow with large histories and
- ;; pending merges, so try to avoid using it until they fix their
- ;; performance problems.
+ ;; `bzr status' could be slow with large histories and pending merges,
+ ;; so this tries to avoid calling it if possible. bzr status is
+ ;; faster now, so this is not as important as it was.
+ ;;
;; This function tries first to parse Bzr internal file
;; `checkout/dirstate', but it may fail if Bzr internal file format
;; has changed. As a safeguard, the `checkout/dirstate' file is
;; + working ( = packed_stat )
;; parent = common ( as above ) + history ( = rev_id )
;; kinds = (r)elocated, (a)bsent, (d)irectory, (f)ile, (l)ink
- (lexical-let ((root (vc-bzr-root file)))
- (when root ; Short cut.
- (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
- (condition-case nil
- (with-temp-buffer
- (insert-file-contents dirstate)
- (goto-char (point-min))
- (if (not (looking-at "#bazaar dirstate flat format 3"))
- (vc-bzr-state file) ; Some other unknown format?
- (let* ((relfile (file-relative-name file root))
- (reldir (file-name-directory relfile)))
- (if (re-search-forward
- (concat "^\0"
- (if reldir (regexp-quote
- (directory-file-name reldir)))
- "\0"
- (regexp-quote (file-name-nondirectory relfile))
- "\0"
- "[^\0]*\0" ;id?
- "\\([^\0]*\\)\0" ;"a/f/d", a=removed?
- "\\([^\0]*\\)\0" ;sha1 (empty if conflicted)?
- "\\([^\0]*\\)\0" ;size?p
- ;; y/n. Whether or not the current copy
- ;; was executable the last time bzr checked?
- "[^\0]*\0"
- "[^\0]*\0" ;?
- ;; Parent information. Absent in a new repo.
- "\\(?:\\([^\0]*\\)\0" ;"a/f/d" a=added?
- "\\([^\0]*\\)\0" ;sha1 again?
- "\\([^\0]*\\)\0" ;size again?
- ;; y/n. Whether or not the repo thinks
- ;; the file should be executable?
- "\\([^\0]*\\)\0"
- "[^\0]*\0\\)?" ;last revid?
- ;; There are more fields when merges are pending.
- )
- nil t)
- ;; Apparently the second sha1 is the one we want: when
- ;; there's a conflict, the first sha1 is absent (and the
- ;; first size seems to correspond to the file with
- ;; conflict markers).
- (cond
- ((eq (char-after (match-beginning 1)) ?a) 'removed)
- ;; If there is no parent, this must be a new repo.
- ;; If file is in dirstate, can only be added (b#8025).
- ((or (not (match-beginning 4))
- (eq (char-after (match-beginning 4)) ?a)) 'added)
- ((or (and (eq (string-to-number (match-string 3))
- (nth 7 (file-attributes file)))
- (equal (match-string 5)
- (vc-bzr-sha1 file))
- ;; For a file, does the executable state match?
- ;; (Bug#7544)
- (or (not
- (eq (char-after (match-beginning 1)) ?f))
- (let ((exe
- (memq
- ?x
- (mapcar
- 'identity
- (nth 8 (file-attributes file))))))
- (if (eq (char-after (match-beginning 7))
- ?y)
- exe
- (not exe)))))
- (and
- ;; It looks like for lightweight
- ;; checkouts \2 is empty and we need to
- ;; look for size in \6.
- (eq (match-beginning 2) (match-end 2))
- (eq (string-to-number (match-string 6))
- (nth 7 (file-attributes file)))
- (equal (match-string 5)
- (vc-bzr-sha1 file))))
- 'up-to-date)
- (t 'edited))
- 'unregistered))))
- ;; Either the dirstate file can't be read, or the sha1
- ;; executable is missing, or ...
- ;; In either case, recent versions of Bzr aren't that slow
- ;; any more.
- (error (vc-bzr-state file)))))))
+ (let* ((root (vc-bzr-root file))
+ (dirstate (expand-file-name vc-bzr-admin-dirstate root)))
+ (when root ; Short cut.
+ (condition-case err
+ (with-temp-buffer
+ (insert-file-contents dirstate)
+ (goto-char (point-min))
+ (if (not (looking-at "#bazaar dirstate flat format 3"))
+ (vc-bzr-state file) ; Some other unknown format?
+ (let* ((relfile (file-relative-name file root))
+ (reldir (file-name-directory relfile)))
+ (cond
+ ((not
+ (re-search-forward
+ (concat "^\0"
+ (if reldir (regexp-quote
+ (directory-file-name reldir)))
+ "\0"
+ (regexp-quote (file-name-nondirectory relfile))
+ "\0"
+ "[^\0]*\0" ;id?
+ "\\([^\0]*\\)\0" ;"a/f/d", a=removed?
+ "\\([^\0]*\\)\0" ;sha1 (empty if conflicted)?
+ "\\([^\0]*\\)\0" ;size?p
+ ;; y/n. Whether or not the current copy
+ ;; was executable the last time bzr checked?
+ "[^\0]*\0"
+ "[^\0]*\0" ;?
+ ;; Parent information. Absent in a new repo.
+ "\\(?:\\([^\0]*\\)\0" ;"a/f/d" a=added?
+ "\\([^\0]*\\)\0" ;sha1 again?
+ "\\([^\0]*\\)\0" ;size again?
+ ;; y/n. Whether or not the repo thinks
+ ;; the file should be executable?
+ "\\([^\0]*\\)\0"
+ "[^\0]*\0\\)?" ;last revid?
+ ;; There are more fields when merges are pending.
+ )
+ nil t))
+ 'unregistered)
+ ;; Apparently the second sha1 is the one we want: when
+ ;; there's a conflict, the first sha1 is absent (and the
+ ;; first size seems to correspond to the file with
+ ;; conflict markers).
+ ((eq (char-after (match-beginning 1)) ?a) 'removed)
+ ;; If there is no parent, this must be a new repo.
+ ;; If file is in dirstate, can only be added (b#8025).
+ ((or (not (match-beginning 4))
+ (eq (char-after (match-beginning 4)) ?a)) 'added)
+ ((or (and (eq (string-to-number (match-string 3))
+ (nth 7 (file-attributes file)))
+ (equal (match-string 5)
+ (save-match-data (vc-bzr-sha1 file)))
+ ;; For a file, does the executable state match?
+ ;; (Bug#7544)
+ (or (not
+ (eq (char-after (match-beginning 1)) ?f))
+ (let ((exe
+ (memq
+ ?x
+ (mapcar
+ 'identity
+ (nth 8 (file-attributes file))))))
+ (if (eq (char-after (match-beginning 7))
+ ?y)
+ exe
+ (not exe)))))
+ (and
+ ;; It looks like for lightweight
+ ;; checkouts \2 is empty and we need to
+ ;; look for size in \6.
+ (eq (match-beginning 2) (match-end 2))
+ (eq (string-to-number (match-string 6))
+ (nth 7 (file-attributes file)))
+ (equal (match-string 5)
+ (vc-bzr-sha1 file))))
+ 'up-to-date)
+ (t 'edited)))))
+ ;; The dirstate file can't be read, or some other problem.
+ (error
+ (message "Falling back on \"slow\" status detection (%S)" err)
+ (vc-bzr-state file))))))
(defun vc-bzr-registered (file)
(defun vc-bzr-file-name-relative (filename)
"Return file name FILENAME stripped of the initial Bzr repository path."
- (lexical-let*
- ((filename* (expand-file-name filename))
- (rootdir (vc-bzr-root filename*)))
+ (let* ((filename* (expand-file-name filename))
+ (rootdir (vc-bzr-root filename*)))
(when rootdir
(file-relative-name filename* rootdir))))
-(defvar vc-bzr-error-regex-alist
+(defvar vc-bzr-error-regexp-alist
'(("^\\( M[* ]\\|+N \\|-D \\|\\| \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1)
("^C \\(.+\\)" 2)
("^Text conflict in \\(.+\\)" 1 nil nil 2)
command (cadr args)
args (cddr args)))
(let ((buf (apply 'vc-bzr-async-command command args)))
- (with-current-buffer buf
- (vc-exec-after
- `(progn
- (let ((compilation-error-regexp-alist
- vc-bzr-error-regex-alist))
- (compilation-mode))
- (set (make-local-variable 'compilation-error-regexp-alist)
- vc-bzr-error-regex-alist))))
+ (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
(defun vc-bzr-merge-branch ()
(command (cadr cmd))
(args (cddr cmd)))
(let ((buf (apply 'vc-bzr-async-command command args)))
- (with-current-buffer buf
- (vc-exec-after
- `(progn
- (let ((compilation-error-regexp-alist
- vc-bzr-error-regex-alist))
- (compilation-mode))
- (set (make-local-variable 'compilation-error-regexp-alist)
- vc-bzr-error-regex-alist))))
+ (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
(defun vc-bzr-status (file)
`ignored', `kindchanged', `modified', `removed', `renamed', `unknown',
which directly correspond to `bzr status' output, or 'unchanged
for files whose copy in the working tree is identical to the one
-in the branch repository, or nil for files that are not
-registered with Bzr.
-
-If any error occurred in running `bzr status', then return nil."
+in the branch repository (or whose status not be determined)."
+;; Doc used to also say the following, but AFAICS, it has never been true.
+;;
+;; ", or nil for files that are not registered with Bzr.
+;; If any error occurred in running `bzr status', then return nil."
+;;
+;; Rather than returning nil in case of an error, it returns
+;; (unchanged . WARNING). FIXME unchanged is not the best status to
+;; return in case of error.
(with-temp-buffer
- (let ((ret (condition-case nil
- (vc-bzr-command "status" t 0 file)
- (file-error nil))) ; vc-bzr-program not found.
- (status 'unchanged))
- ;; the only secure status indication in `bzr status' output
- ;; is a couple of lines following the pattern::
- ;; | <status>:
- ;; | <file name>
- ;; if the file is up-to-date, we get no status report from `bzr',
- ;; so if the regexp search for the above pattern fails, we consider
- ;; the file to be up-to-date.
- (goto-char (point-min))
- (when (re-search-forward
- ;; bzr prints paths relative to the repository root.
- (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
- (regexp-quote (vc-bzr-file-name-relative file))
- ;; Bzr appends a '/' to directory names and
- ;; '*' to executable files
- (if (file-directory-p file) "/?" "\\*?")
- "[ \t\n]*$")
- nil t)
- (lexical-let ((statusword (match-string 1)))
- ;; Erase the status text that matched.
- (delete-region (match-beginning 0) (match-end 0))
- (setq status
- (intern (replace-regexp-in-string " " "" statusword)))))
- (when status
- (goto-char (point-min))
- (skip-chars-forward " \n\t") ;Throw away spaces.
- (cons status
- ;; "bzr" will output warnings and informational messages to
- ;; stderr; due to Emacs's `vc-do-command' (and, it seems,
- ;; `start-process' itself) limitations, we cannot catch stderr
- ;; and stdout into different buffers. So, if there's anything
- ;; left in the buffer after removing the above status
- ;; keywords, let us just presume that any other message from
- ;; "bzr" is a user warning, and display it.
- (unless (eobp) (buffer-substring (point) (point-max))))))))
+ ;; This is with-demoted-errors without the condition-case-unless-debug
+ ;; annoyance, which makes it fail during ert testing.
+ (condition-case err (vc-bzr-command "status" t 0 file)
+ (error (message "Error: %S" err) nil))
+ (let ((status 'unchanged))
+ ;; the only secure status indication in `bzr status' output
+ ;; is a couple of lines following the pattern::
+ ;; | <status>:
+ ;; | <file name>
+ ;; if the file is up-to-date, we get no status report from `bzr',
+ ;; so if the regexp search for the above pattern fails, we consider
+ ;; the file to be up-to-date.
+ (goto-char (point-min))
+ (when (re-search-forward
+ ;; bzr prints paths relative to the repository root.
+ (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
+ (regexp-quote (vc-bzr-file-name-relative file))
+ ;; Bzr appends a '/' to directory names and
+ ;; '*' to executable files
+ (if (file-directory-p file) "/?" "\\*?")
+ "[ \t\n]*$")
+ nil t)
+ (let ((statusword (match-string 1)))
+ ;; Erase the status text that matched.
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq status
+ (intern (replace-regexp-in-string " " "" statusword)))))
+ (when status
+ (goto-char (point-min))
+ (skip-chars-forward " \n\t") ;Throw away spaces.
+ (cons status
+ ;; "bzr" will output warnings and informational messages to
+ ;; stderr; due to Emacs's `vc-do-command' (and, it seems,
+ ;; `start-process' itself) limitations, we cannot catch stderr
+ ;; and stdout into different buffers. So, if there's anything
+ ;; left in the buffer after removing the above status
+ ;; keywords, let us just presume that any other message from
+ ;; "bzr" is a user warning, and display it.
+ (unless (eobp) (buffer-substring (point) (point-max))))))))
(defun vc-bzr-state (file)
- (lexical-let ((result (vc-bzr-status file)))
+ (let ((result (vc-bzr-status file)))
(when (consp result)
(let ((warnings (cdr result)))
(when warnings
(defun vc-bzr-working-revision (file)
;; Together with the code in vc-state-heuristic, this makes it possible
;; to get the initial VC state of a Bzr file even if Bzr is not installed.
- (lexical-let*
- ((rootdir (vc-bzr-root file))
- (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
- rootdir))
- (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir))
- (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir)))
+ (let* ((rootdir (vc-bzr-root file))
+ (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
+ rootdir))
+ (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir))
+ (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir)))
;; This looks at internal files to avoid forking a bzr process.
;; May break if they change their format.
(if (and (file-exists-p branch-format-file)
- ;; For lightweight checkouts (obtained with bzr checkout --lightweight)
+ ;; For lightweight checkouts (obtained with bzr co --lightweight)
;; the branch-format-file does not contain the revision
;; information, we need to look up the branch-format-file
;; in the place where the lightweight checkout comes
(when (re-search-forward "file://\\(.+\\)" nil t)
(let ((l-c-parent-dir (match-string 1)))
(when (and (memq system-type '(ms-dos windows-nt))
- (string-match-p "^/[[:alpha:]]:" l-c-parent-dir))
- ;;; The non-Windows code takes a shortcut by using the host/path
- ;;; separator slash as the start of the absolute path. That
- ;;; does not work on Windows, so we must remove it (bug#5345)
+ (string-match-p "^/[[:alpha:]]:"
+ l-c-parent-dir))
+ ;;; The non-Windows code takes a shortcut by using
+ ;;; the host/path separator slash as the start of
+ ;;; the absolute path. That does not work on
+ ;;; Windows, so we must remove it (bug#5345)
(setq l-c-parent-dir (substring l-c-parent-dir 1)))
(setq branch-format-file
(expand-file-name vc-bzr-admin-branch-format-file
l-c-parent-dir))
(setq lastrev-file
- (expand-file-name vc-bzr-admin-lastrev l-c-parent-dir))
- ;; FIXME: maybe it's overkill to check if both these files exist.
+ (expand-file-name vc-bzr-admin-lastrev
+ l-c-parent-dir))
+ ;; FIXME: maybe it's overkill to check if both these
+ ;; files exist.
(and (file-exists-p branch-format-file)
- (file-exists-p lastrev-file)))))
+ (file-exists-p lastrev-file)
+ (equal (emacs-bzr-version-dirstate l-c-parent-dir)
+ (emacs-bzr-version-dirstate rootdir))))))
t)))
(with-temp-buffer
(insert-file-contents branch-format-file)
(insert-file-contents lastrev-file)
(when (re-search-forward "[0-9]+" nil t)
(buffer-substring (match-beginning 0) (match-end 0))))))
- ;; fallback to calling "bzr revno"
- (lexical-let*
- ((result (vc-bzr-command-discarding-stderr
- vc-bzr-program "revno" (file-relative-name file)))
- (exitcode (car result))
- (output (cdr result)))
+ ;; Fallback to calling "bzr revno --tree".
+ ;; The "--tree" matters for lightweight checkouts not on the same
+ ;; revision as the parent.
+ (let* ((result (vc-bzr-command-discarding-stderr
+ vc-bzr-program "revno" "--tree"
+ (file-relative-name file)))
+ (exitcode (car result))
+ (output (cdr result)))
(cond
- ((eq exitcode 0) (substring output 0 -1))
+ ((and (eq exitcode 0) (not (zerop (length output))))
+ (substring output 0 -1))
(t nil))))))
(defun vc-bzr-create-repo ()
"Create a new Bzr repository."
(vc-bzr-command "init" nil 0 nil))
-(defun vc-bzr-init-revision (&optional file)
+(defun vc-bzr-init-revision (&optional _file)
"Always return nil, as Bzr cannot register explicit versions."
nil)
-(defun vc-bzr-previous-revision (file rev)
+(defun vc-bzr-previous-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1- (string-to-number rev)))
(concat "before:" rev)))
-(defun vc-bzr-next-revision (file rev)
+(defun vc-bzr-next-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1+ (string-to-number rev)))
(error "Don't know how to compute the next revision of %s" rev)))
-(defun vc-bzr-register (files &optional rev comment)
+(defun vc-bzr-register (files &optional rev _comment)
"Register FILES under bzr.
Signal an error unless REV is nil.
COMMENT is ignored."
(vc-bzr-command "cat" t 0 file "-r" rev)
(vc-bzr-command "cat" t 0 file))))
-(defun vc-bzr-checkout (file &optional editable rev)
+(defun vc-bzr-checkout (_file &optional _editable rev)
(if rev (error "Operation not supported")
;; Else, there's nothing to do.
nil))
property containing author and date information."
(apply #'vc-bzr-command "annotate" buffer 'async file "--long" "--all"
(if revision (list "-r" revision)))
- (lexical-let ((table (make-hash-table :test 'equal)))
+ (let ((table (make-hash-table :test 'equal)))
(set-process-filter
(get-buffer-process buffer)
(lambda (proc string)
(apply #'process-file command nil (list (current-buffer) nil) nil args)
(buffer-substring (point-min) (point-max)))))
-(defstruct (vc-bzr-extra-fileinfo
+(cl-defstruct (vc-bzr-extra-fileinfo
(:copier nil)
(:constructor vc-bzr-create-extra-fileinfo (extra-name))
(:conc-name vc-bzr-extra-fileinfo->))
;; frob the results accordingly.
(file-relative-name ,dir (vc-bzr-root ,dir)))))
-(defun vc-bzr-dir-status-files (dir files default-state update-function)
+(defun vc-bzr-dir-status-files (dir files _default-state update-function)
"Return a list of conses (file . state) for DIR."
(apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
(vc-exec-after
"revno" "submit" "tag")))
(defun vc-bzr-revision-completion-table (files)
- (lexical-let ((files files))
- ;; What about using `files'?!? --Stef
- (lambda (string pred action)
- (cond
- ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
- string)
- (completion-table-with-context (substring string 0 (match-end 0))
- (apply-partially
- 'completion-table-with-predicate
- 'completion-file-name-table
- 'file-directory-p t)
- (substring string (match-end 0))
- pred
- action))
- ((string-match "\\`\\(before\\):" string)
- (completion-table-with-context (substring string 0 (match-end 0))
- (vc-bzr-revision-completion-table files)
- (substring string (match-end 0))
- pred
- action))
- ((string-match "\\`\\(tag\\):" string)
- (let ((prefix (substring string 0 (match-end 0)))
- (tag (substring string (match-end 0)))
- (table nil)
- process-file-side-effects)
- (with-temp-buffer
- ;; "bzr-1.2 tags" is much faster with --show-ids.
- (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids")
- ;; The output is ambiguous, unless we assume that revids do not
- ;; contain spaces.
- (goto-char (point-min))
- (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t)
- (push (match-string-no-properties 1) table)))
- (completion-table-with-context prefix table tag pred action)))
-
- ((string-match "\\`annotate:" string)
- (completion-table-with-context
- (substring string 0 (match-end 0))
- (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`")
- #'completion-file-name-table)
- (substring string (match-end 0)) pred action))
-
- ((string-match "\\`date:" string)
- (completion-table-with-context
- (substring string 0 (match-end 0))
- '("yesterday" "today" "tomorrow")
- (substring string (match-end 0)) pred action))
-
- ((string-match "\\`\\([a-z]+\\):" string)
- ;; no actual completion for the remaining keywords.
- (completion-table-with-context (substring string 0 (match-end 0))
- (if (member (match-string 1 string)
- vc-bzr-revision-keywords)
- ;; If it's a valid keyword,
- ;; use a non-empty table to
- ;; indicate it.
- '("") nil)
- (substring string (match-end 0))
- pred
- action))
- (t
- ;; Could use completion-table-with-terminator, except that it
- ;; currently doesn't work right w.r.t pcm and doesn't give
- ;; the *Completions* output we want.
- (complete-with-action action (eval-when-compile
- (mapcar (lambda (s) (concat s ":"))
- vc-bzr-revision-keywords))
- string pred))))))
+ ;; What about using `files'?!? --Stef
+ (lambda (string pred action)
+ (cond
+ ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
+ string)
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (apply-partially
+ 'completion-table-with-predicate
+ 'completion-file-name-table
+ 'file-directory-p t)
+ (substring string (match-end 0))
+ pred
+ action))
+ ((string-match "\\`\\(before\\):" string)
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (vc-bzr-revision-completion-table files)
+ (substring string (match-end 0))
+ pred
+ action))
+ ((string-match "\\`\\(tag\\):" string)
+ (let ((prefix (substring string 0 (match-end 0)))
+ (tag (substring string (match-end 0)))
+ (table nil)
+ process-file-side-effects)
+ (with-temp-buffer
+ ;; "bzr-1.2 tags" is much faster with --show-ids.
+ (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids")
+ ;; The output is ambiguous, unless we assume that revids do not
+ ;; contain spaces.
+ (goto-char (point-min))
+ (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t)
+ (push (match-string-no-properties 1) table)))
+ (completion-table-with-context prefix table tag pred action)))
+
+ ((string-match "\\`annotate:" string)
+ (completion-table-with-context
+ (substring string 0 (match-end 0))
+ (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`")
+ #'completion-file-name-table)
+ (substring string (match-end 0)) pred action))
+
+ ((string-match "\\`date:" string)
+ (completion-table-with-context
+ (substring string 0 (match-end 0))
+ '("yesterday" "today" "tomorrow")
+ (substring string (match-end 0)) pred action))
+
+ ((string-match "\\`\\([a-z]+\\):" string)
+ ;; no actual completion for the remaining keywords.
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (if (member (match-string 1 string)
+ vc-bzr-revision-keywords)
+ ;; If it's a valid keyword,
+ ;; use a non-empty table to
+ ;; indicate it.
+ '("") nil)
+ (substring string (match-end 0))
+ pred
+ action))
+ (t
+ ;; Could use completion-table-with-terminator, except that it
+ ;; currently doesn't work right w.r.t pcm and doesn't give
+ ;; the *Completions* output we want.
+ (complete-with-action action (eval-when-compile
+ (mapcar (lambda (s) (concat s ":"))
+ vc-bzr-revision-keywords))
+ string pred)))))
(provide 'vc-bzr)
-;;; vc-cvs.el --- non-resident support for CVS version-control
+;;; vc-cvs.el --- non-resident support for CVS version-control -*- lexical-binding: t -*-
;; Copyright (C) 1995, 1998-2012 Free Software Foundation, Inc.
;;; Code:
-(eval-when-compile (require 'cl) (require 'vc))
+(eval-when-compile (require 'vc))
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
(vc-file-getprop file 'vc-working-revision))
(defun vc-cvs-mode-line-string (file)
- "Return string for placement into the modeline for FILE.
+ "Return a string for `vc-mode-line' to put in the mode line for FILE.
Compared to the default implementation, this function does two things:
Handle the special case of a CVS file that is added but not yet
committed and support display of sticky tags."
;;; State-changing functions
;;;
-(defun vc-cvs-register (files &optional rev comment)
+(defun vc-cvs-register (files &optional _rev comment)
"Register FILES into the CVS version-control system.
COMMENT can be used to provide an initial description of FILES.
Passes either `vc-cvs-register-switches' or `vc-register-switches'
(if vc-cvs-use-edit
(vc-cvs-command nil 0 file "edit")
(set-file-modes file (logior (file-modes file) 128))
- (if (equal file buffer-file-name) (toggle-read-only -1))))
+ (if (equal file buffer-file-name) (read-only-mode -1))))
;; Check out a particular revision (or recreate the file).
(vc-file-setprop file 'vc-working-revision nil)
(apply 'vc-cvs-command nil 0 file
(declare-function vc-rcs-print-log-cleanup "vc-rcs" ())
-(defun vc-cvs-print-log (files buffer &optional shortlog start-revision-ignored limit)
+(defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit)
"Get change logs associated with FILES."
(require 'vc-rcs)
;; It's just the catenation of the individual logs.
((= len 3)
;; :METHOD:PATH or :METHOD:USER@HOSTNAME/PATH
(cons (cadr root-list)
- (vc-cvs-parse-uhp (caddr root-list))))
+ (vc-cvs-parse-uhp (nth 2 root-list))))
(t
;; :METHOD:[USER@]HOST:PATH
(cdr root-list)))))
(vc-exec-after
`(vc-cvs-after-dir-status (quote ,update-function))))))
-(defun vc-cvs-dir-status-files (dir files default-state update-function)
+(defun vc-cvs-dir-status-files (dir files _default-state update-function)
"Create a list of conses (file . state) for DIR."
(apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
(vc-exec-after
(buffer-substring (point) (point-max)))
(file-error nil)))
-(defun vc-cvs-dir-extra-headers (dir)
+(defun vc-cvs-dir-extra-headers (_dir)
"Extract and represent per-directory properties of a CVS working copy."
(let ((repo
(condition-case nil
(parse-time-string (concat time " +0000")))))
(cond ((and (not (string-match "\\+" time))
(car parsed-time)
- (equal mtime (apply 'encode-time parsed-time)))
+ ;; Compare just the seconds part of the file time,
+ ;; since CVS file time stamp resolution is just 1 second.
+ (let ((ptime (apply 'encode-time parsed-time)))
+ (and (eq (car mtime) (car ptime))
+ (eq (cadr mtime) (cadr ptime)))))
(vc-file-setprop file 'vc-checkout-time mtime)
(if set-state (vc-file-setprop file 'vc-state 'up-to-date)))
(t
res)))
(defun vc-cvs-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-cvs-revision-table (car files)))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-cvs-revision-table (car files))))))
table))
-;;; vc-dir.el --- Directory status display under VC
+;;; vc-dir.el --- Directory status display under VC -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <dann@ics.uci.edu>
;; Keywords: vc tools
(require 'ewoc)
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defcustom vc-dir-mode-hook nil
"Normal hook run by `vc-dir-mode'.
;; Used to store information for the files displayed in the directory buffer.
;; Each item displayed corresponds to one of these defstructs.
-(defstruct (vc-dir-fileinfo
+(cl-defstruct (vc-dir-fileinfo
(:copier nil)
(:type list) ;So we can use `member' on lists of FIs.
(:constructor
(let* ;; Look for another buffer name BNAME visiting the same directory.
((buf (save-excursion
(unless create-new
- (dolist (buffer vc-dir-buffers)
+ (cl-dolist (buffer vc-dir-buffers)
(when (buffer-live-p buffer)
(set-buffer buffer)
(when (and (derived-mode-p 'vc-dir-mode)
(eq vc-dir-backend backend)
(string= default-directory dir))
- (return buffer))))))))
+ (cl-return buffer))))))))
(or buf
;; Create a new buffer named BNAME.
;; We pass a filename to create-file-buffer because it is what
(defun vc-dir-mark-unmark (mark-unmark-function)
(if (use-region-p)
- (let ((firstl (line-number-at-pos (region-beginning)))
+ (let (;; (firstl (line-number-at-pos (region-beginning)))
(lastl (line-number-at-pos (region-end))))
(save-excursion
(goto-char (region-beginning))
;; Non-nil iff a parent directory of arg is marked.
;; Return value, if non-nil is the `ewoc-data' for the marked parent.
(let* ((argdir (vc-dir-node-directory arg))
- (arglen (length argdir))
+ ;; (arglen (length argdir))
(crt arg)
(found nil))
;; Go through the predecessors, checking if any directory that is
(let ((data (ewoc-data crt))
(dir (vc-dir-node-directory crt)))
(and (vc-dir-fileinfo->directory data)
- (vc-string-prefix-p dir argdir)
+ (string-prefix-p dir argdir)
(vc-dir-fileinfo->marked data)
(setq found data))))
found))
;; FIXME: use vc-dir-child-files-and-states here instead of duplicating it.
(if (vc-dir-fileinfo->directory crt-data)
(let* ((dir (vc-dir-fileinfo->directory crt-data))
- (dirlen (length dir))
+ ;; (dirlen (length dir))
data)
(while
(and (setq crt (ewoc-next vc-ewoc crt))
- (vc-string-prefix-p dir
+ (string-prefix-p dir
(progn
(setq data (ewoc-data crt))
(vc-dir-node-directory crt))))
result)
(if (vc-dir-fileinfo->directory crt-data)
(let* ((dir (vc-dir-fileinfo->directory crt-data))
- (dirlen (length dir))
+ ;; (dirlen (length dir))
data)
(while
(and (setq crt (ewoc-next vc-ewoc crt))
- (vc-string-prefix-p dir (progn
+ (string-prefix-p dir (progn
(setq data (ewoc-data crt))
(vc-dir-node-directory crt))))
(unless (vc-dir-fileinfo->directory data)
(defun vc-dir-recompute-file-state (fname def-dir)
(let* ((file-short (file-relative-name fname def-dir))
- (remove-me-when-CVS-works
+ (_remove-me-when-CVS-works
(when (eq vc-dir-backend 'CVS)
;; FIXME: Warning: UGLY HACK. The CVS backend caches the state
;; info, this forces the backend to update it.
;; Give a DIRNAME string return the list of all child files shown in
;; the current *vc-dir* buffer.
(let ((crt (ewoc-nth vc-ewoc 0))
- children
- dname)
+ children)
;; Find DIR
- (while (and crt (not (vc-string-prefix-p
+ (while (and crt (not (string-prefix-p
dirname (vc-dir-node-directory crt))))
(setq crt (ewoc-next vc-ewoc crt)))
- (while (and crt (vc-string-prefix-p
+ (while (and crt (string-prefix-p
dirname
- (setq dname (vc-dir-node-directory crt))))
+ (vc-dir-node-directory crt)))
(let ((data (ewoc-data crt)))
(unless (vc-dir-fileinfo->directory data)
(push (expand-file-name (vc-dir-fileinfo->name data)) children)))
(if (not (derived-mode-p 'vc-dir-mode))
(push status-buf drop)
(let ((ddir default-directory))
- (when (vc-string-prefix-p ddir file)
+ (when (string-prefix-p ddir file)
(if (file-directory-p file)
(progn
(vc-dir-resync-directory-files file)
(unless (buffer-live-p vc-dir-process-buffer)
(setq vc-dir-process-buffer
(generate-new-buffer (format " *VC-%s* tmp status" backend))))
- (lexical-let ((buffer (current-buffer)))
+ (let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
(setq default-directory def-dir)
(erase-buffer)
(not (vc-dir-fileinfo->needs-update info))))))))))))
-(defun vc-dir-revert-buffer-function (&optional ignore-auto noconfirm)
+(defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm)
(vc-dir-refresh))
(defun vc-dir-refresh ()
;; Bzr has serious locking problems, so setup the headers first (this is
;; synchronous) rather than doing it while dir-status is running.
(ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "")
- (lexical-let ((buffer (current-buffer)))
+ (let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
(setq default-directory def-dir)
(erase-buffer)
(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
(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."
(let ((use-vc-backend backend))
(vc-dir-mode))))
-(defun vc-default-dir-extra-headers (backend dir)
+(defun vc-default-dir-extra-headers (_backend _dir)
;; Be loud by default to remind people to add code to display
;; backend specific headers.
;; XXX: change this to return nil before the release.
map)
"Local keymap for visiting a file.")
-(defun vc-default-dir-printer (backend fileentry)
+(defun vc-default-dir-printer (_backend fileentry)
"Pretty print FILEENTRY."
;; If you change the layout here, change vc-dir-move-to-goal-column.
;; VC backends can implement backend specific versions of this
'mouse-face 'highlight
'keymap vc-dir-filename-mouse-map))))
-(defun vc-default-extra-status-menu (backend)
+(defun vc-default-extra-status-menu (_backend)
nil)
-(defun vc-default-status-fileinfo-extra (backend file)
+(defun vc-default-status-fileinfo-extra (_backend _file)
"Default absence of extra information returned for a file."
nil)
(set-window-start window new-window-start))
buffer))
+(defun vc-compilation-mode (backend)
+ "Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'."
+ (let* ((error-regexp-alist
+ (vc-make-backend-sym backend 'error-regexp-alist))
+ (compilation-error-regexp-alist
+ (and (boundp error-regexp-alist)
+ (symbol-value error-regexp-alist))))
+ (compilation-mode)
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ compilation-error-regexp-alist)))
+
(defun vc-set-async-update (process-buffer)
"Set a `vc-exec-after' action appropriate to the current buffer.
This action will update the current buffer after the current
(kill-buffer (current-buffer)))))
(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
-(declare-function vc-string-prefix-p "vc" (prefix string))
(defun vc-resynch-buffers-in-directory (directory &optional keep noquery reset-vc-info)
"Resync all buffers that visit files in DIRECTORY."
(dolist (buffer (buffer-list))
(let ((fname (buffer-file-name buffer)))
- (when (and fname (vc-string-prefix-p directory fname))
+ (when (and fname (string-prefix-p directory fname))
(with-current-buffer buffer
(vc-resynch-buffer fname keep noquery reset-vc-info))))))
;; Set up key bindings for use while editing log messages
-(defun vc-log-edit (fileset mode)
+(defun vc-log-edit (fileset mode backend)
"Set up `log-edit' for use on FILE."
(setq default-directory
- (with-current-buffer vc-parent-buffer default-directory))
+ (buffer-local-value 'default-directory vc-parent-buffer))
(log-edit 'vc-finish-logentry
nil
`((log-edit-listfun . (lambda ()
;; for directories.
(mapcar 'file-relative-name
',fileset)))
- (log-edit-diff-function . (lambda () (vc-diff nil))))
+ (log-edit-diff-function . vc-diff)
+ (log-edit-vc-backend . ,backend)
+ (vc-log-fileset . ,fileset))
nil
mode)
- (set (make-local-variable 'vc-log-fileset) fileset)
(set-buffer-modified-p nil)
(setq buffer-file-name nil))
-(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook)
+(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend)
"Accept a comment for an operation on FILES.
If COMMENT is nil, pop up a LOGBUF buffer, emit MSG, and set the
action on close to ACTION. If COMMENT is a string and
empty comment. Remember the file's buffer in `vc-parent-buffer'
\(current one if no file). Puts the log-entry buffer in major-mode
MODE, defaulting to `log-edit-mode' if MODE is nil.
-AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'."
+AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'.
+BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer."
(let ((parent
(if (vc-dispatcher-browsing)
;; If we are called from a directory browser, the parent buffer is
(set (make-local-variable 'vc-parent-buffer) parent)
(set (make-local-variable 'vc-parent-buffer-name)
(concat " from " (buffer-name vc-parent-buffer)))
- (vc-log-edit files mode)
+ (vc-log-edit files mode backend)
(make-local-variable 'vc-log-after-operation-hook)
(when after-hook
(setq vc-log-after-operation-hook after-hook))
-;;; vc-git.el --- VC backend for the git version control system
+;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*-
;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; To install: put this file on the load-path and add Git to the list
;; of supported backends in `vc-handled-backends'; the following line,
-;; placed in your ~/.emacs, will accomplish this:
+;; placed in your init file, will accomplish this:
;;
;; (add-to-list 'vc-handled-backends 'Git)
;; - find-file-hook () NOT NEEDED
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc)
(require 'vc-dir)
(require 'grep))
;;; BACKEND PROPERTIES
(defun vc-git-revision-granularity () 'repository)
-(defun vc-git-checkout-model (files) 'implicit)
+(defun vc-git-checkout-model (_files) 'implicit)
;;; STATE-QUERYING FUNCTIONS
(let ((dir (vc-git-root file)))
(when dir
(with-temp-buffer
- (let* (process-file-side-effects
- ;; Do not use the `file-name-directory' here: git-ls-files
- ;; sometimes fails to return the correct status for relative
- ;; path specs.
- ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
- (name (file-relative-name file dir))
- (str (ignore-errors
- (cd dir)
- (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
- ;; If result is empty, use ls-tree to check for deleted
- ;; file.
- (when (eq (point-min) (point-max))
- (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
- "--" name))
- (buffer-string))))
- (and str
- (> (length str) (length name))
- (string= (substring str 0 (1+ (length name)))
- (concat name "\0"))))))))
+ (let* (process-file-side-effects
+ ;; Do not use the `file-name-directory' here: git-ls-files
+ ;; sometimes fails to return the correct status for relative
+ ;; path specs.
+ ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
+ (name (file-relative-name file dir))
+ (str (ignore-errors
+ (cd dir)
+ (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
+ ;; If result is empty, use ls-tree to check for deleted
+ ;; file.
+ (when (eq (point-min) (point-max))
+ (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
+ "--" name))
+ (buffer-string))))
+ (and str
+ (> (length str) (length name))
+ (string= (substring str 0 (1+ (length name)))
+ (concat name "\0"))))))))
(defun vc-git--state-code (code)
"Convert from a string to a added/deleted/modified state."
- (case (string-to-char code)
+ (pcase (string-to-char code)
(?M 'edited)
(?A 'added)
(?D 'removed)
;; is direct ancestor of corresponding upstream branch, and the file
;; was modified upstream. But we can't check that without a network
;; operation.
- (if (not (vc-git-registered file))
- 'unregistered
- (let ((diff (vc-git--run-command-string
- file "diff-index" "-p" "--raw" "-z" "HEAD" "--")))
- (if (and diff
- (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0\\(.*\n.\\)?"
- diff))
- (let ((diff-letter (match-string 1 diff)))
- (if (not (match-beginning 2))
- ;; Empty diff: file contents is the same as the HEAD
- ;; revision, but timestamps are different (eg, file
- ;; was "touch"ed). Update timestamp in index:
- (prog1 'up-to-date
- (vc-git--call nil "add" "--refresh" "--"
- (file-relative-name file)))
- (vc-git--state-code diff-letter)))
- (if (vc-git--empty-db-p) 'added 'up-to-date)))))
-
-(defun vc-git-working-revision (file)
+ ;; This assumes that status is known to be not `unregistered' because
+ ;; we've been successfully dispatched here from `vc-state', that
+ ;; means `vc-git-registered' returned t earlier once. Bug#11757
+ (let ((diff (vc-git--run-command-string
+ file "diff-index" "-p" "--raw" "-z" "HEAD" "--")))
+ (if (and diff
+ (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0\\(.*\n.\\)?"
+ diff))
+ (let ((diff-letter (match-string 1 diff)))
+ (if (not (match-beginning 2))
+ ;; Empty diff: file contents is the same as the HEAD
+ ;; revision, but timestamps are different (eg, file
+ ;; was "touch"ed). Update timestamp in index:
+ (prog1 'up-to-date
+ (vc-git--call nil "add" "--refresh" "--"
+ (file-relative-name file)))
+ (vc-git--state-code diff-letter)))
+ (if (vc-git--empty-db-p) 'added 'up-to-date))))
+
+(defun vc-git-working-revision (_file)
"Git-specific version of `vc-working-revision'."
(let* (process-file-side-effects
(str (with-output-to-string
(eq 'up-to-date (vc-git-state file)))
(defun vc-git-mode-line-string (file)
- "Return string for placement into the modeline for FILE."
- (let* ((branch (vc-git-working-revision file))
+ "Return a string for `vc-mode-line' to put in the mode line for FILE."
+ (let* ((branch (vc-working-revision file))
(def-ml (vc-default-mode-line-string 'Git file))
(help-echo (get-text-property 0 'help-echo def-ml)))
(if (zerop (length branch))
(propertize def-ml
'help-echo (concat help-echo "\nCurrent branch: " branch)))))
-(defstruct (vc-git-extra-fileinfo
+(cl-defstruct (vc-git-extra-fileinfo
(:copier nil)
(:constructor vc-git-create-extra-fileinfo
(old-perm new-perm &optional rename-state orig-name))
(if (string-match "[\n\t\"\\]" name)
(concat "\""
(mapconcat (lambda (c)
- (case c
+ (pcase c
(?\n "\\n")
(?\t "\\t")
(?\\ "\\\\")
(?\" "\\\"")
- (t (char-to-string c))))
+ (_ (char-to-string c))))
name "")
"\"")
name))
"Return a string describing the file type based on its permissions."
(let* ((old-type (lsh (or old-perm 0) -9))
(new-type (lsh (or new-perm 0) -9))
- (str (case new-type
+ (str (pcase new-type
(?\100 ;; File.
- (case old-type
+ (pcase old-type
(?\100 nil)
(?\120 " (type change symlink -> file)")
(?\160 " (type change subproject -> file)")))
(?\120 ;; Symlink.
- (case old-type
+ (pcase old-type
(?\100 " (type change file -> symlink)")
(?\160 " (type change subproject -> symlink)")
(t " (symlink)")))
(?\160 ;; Subproject.
- (case old-type
+ (pcase old-type
(?\100 " (type change file -> subproject)")
(?\120 " (type change symlink -> subproject)")
(t " (subproject)")))
(?\110 nil) ;; Directory (internal, not a real git state).
(?\000 ;; Deleted or unknown.
- (case old-type
+ (pcase old-type
(?\120 " (symlink)")
(?\160 " (subproject)")))
- (t (format " (unknown type %o)" new-type)))))
+ (_ (format " (unknown type %o)" new-type)))))
(cond (str (propertize str 'face 'font-lock-comment-face))
((eq new-type ?\110) "/")
(t ""))))
"Process sentinel for the various dir-status stages."
(let (next-stage result)
(goto-char (point-min))
- (case stage
- (update-index
+ (pcase stage
+ (`update-index
(setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
(if files 'ls-files-up-to-date 'diff-index))))
- (ls-files-added
+ (`ls-files-added
(setq next-stage 'ls-files-unknown)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
(let ((new-perm (string-to-number (match-string 1) 8))
(name (match-string 2)))
(push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm))
result))))
- (ls-files-up-to-date
+ (`ls-files-up-to-date
(setq next-stage 'diff-index)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
(let ((perm (string-to-number (match-string 1) 8))
(push (list name 'up-to-date
(vc-git-create-extra-fileinfo perm perm))
result))))
- (ls-files-unknown
+ (`ls-files-unknown
(when files (setq next-stage 'ls-files-ignored))
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(push (list (match-string 1) 'unregistered
(vc-git-create-extra-fileinfo 0 0))
result)))
- (ls-files-ignored
+ (`ls-files-ignored
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(push (list (match-string 1) 'ignored
(vc-git-create-extra-fileinfo 0 0))
result)))
- (diff-index
+ (`diff-index
(setq next-stage 'ls-files-unknown)
(while (re-search-forward
":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0"
(defun vc-git-dir-status-goto-stage (stage files update-function)
(erase-buffer)
- (case stage
- (update-index
+ (pcase stage
+ (`update-index
(if files
(vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
(vc-git-command (current-buffer) 'async nil
"update-index" "--refresh")))
- (ls-files-added
+ (`ls-files-added
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
- (ls-files-up-to-date
+ (`ls-files-up-to-date
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
- (ls-files-unknown
+ (`ls-files-unknown
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
- (ls-files-ignored
+ (`ls-files-ignored
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "-i" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
;; --relative added in Git 1.5.5.
- (diff-index
+ (`diff-index
(vc-git-command (current-buffer) 'async files
"diff-index" "--relative" "-z" "-M" "HEAD" "--")))
(vc-exec-after
`(vc-git-after-dir-status-stage ',stage ',files ',update-function)))
-(defun vc-git-dir-status (dir update-function)
+(defun vc-git-dir-status (_dir update-function)
"Return a list of (FILE STATE EXTRA) entries for DIR."
;; Further things that would have to be fixed later:
;; - how to handle unregistered directories
;; - how to support vc-dir on a subdir of the project tree
(vc-git-dir-status-goto-stage 'update-index nil update-function))
-(defun vc-git-dir-status-files (dir files default-state update-function)
+(defun vc-git-dir-status-files (_dir files _default-state update-function)
"Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
(vc-git-dir-status-goto-stage 'update-index files update-function))
:help "Show the contents of the current stash"))
map))
-(defun vc-git-dir-extra-headers (dir)
+(defun vc-git-dir-extra-headers (_dir)
(let ((str (with-output-to-string
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
"Return the existing branches, as a list of strings.
The car of the list is the current branch."
(with-temp-buffer
- (call-process vc-git-program nil t nil "branch")
+ (vc-git--call t "branch")
(goto-char (point-min))
(let (current-branch branches)
(while (not (eobp))
"Create a new Git repository."
(vc-git-command nil 0 nil "init"))
-(defun vc-git-register (files &optional rev comment)
+(defun vc-git-register (files &optional _rev _comment)
"Register FILES into the git version-control system."
(let (flist dlist)
(dolist (crt files)
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-git-checkin (files rev comment)
+(defun vc-git-checkin (files _rev comment)
(let ((coding-system-for-write vc-git-commits-coding-system))
(apply 'vc-git-command nil 0 files
(nconc (list "commit" "-m")
nil
"cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
-(defun vc-git-checkout (file &optional editable rev)
+(defun vc-git-checkout (file &optional _editable rev)
(vc-git-command nil 0 file "checkout" (or rev "HEAD")))
(defun vc-git-revert (file &optional contents-done)
(vc-git-command nil 0 file "reset" "-q" "--")
(vc-git-command nil nil file "checkout" "-q" "--")))
+(defvar vc-git-error-regexp-alist
+ '(("^ \\(.+\\) |" 1 nil nil 0))
+ "Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
+
(defun vc-git-pull (prompt)
"Pull changes into the current Git branch.
Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
command (cadr args)
args (cddr args)))
(apply 'vc-do-async-command buffer root git-program command args)
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
(defun vc-git-merge-branch ()
nil t)))
(apply 'vc-do-async-command buffer root vc-git-program "merge"
(list merge-source))
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
;;; HISTORY FUNCTIONS
(list (cons (nth 1 vc-git-root-log-format)
(nth 2 vc-git-root-log-format)))
(append
- `((,log-view-message-re (1 'change-log-acknowledgement)))
+ `((,log-view-message-re (1 'change-log-acknowledgment)))
;; Handle the case:
;; user: foo@bar
'(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
(1 'change-log-name)
(2 'change-log-email))
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
- (1 'change-log-acknowledgement)
- (2 'change-log-acknowledgement))
+ (1 'change-log-acknowledgment)
+ (2 'change-log-acknowledgment))
("^Date: \\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
(append (vc-switches 'git 'diff)
(list "-p" (or rev1 "HEAD") rev2 "--")))))
-(defun vc-git-revision-table (files)
+(defun vc-git-revision-table (_files)
;; What about `files'?!? --Stef
(let (process-file-side-effects
(table (list "HEAD")))
table))
(defun vc-git-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-git-revision-table files))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-git-revision-table files)))))
table))
(defun vc-git-annotate-command (file buf &optional rev)
(vc-git-command nil 0 nil "checkout" "-b" name)
(vc-git-command nil 0 nil "tag" name)))))
-(defun vc-git-retrieve-tag (dir name update)
+(defun vc-git-retrieve-tag (dir name _update)
(let ((default-directory dir))
(vc-git-command nil 0 nil "checkout" name)
;; FIXME: update buffers if `update' is true
(defun vc-git-extra-status-menu () vc-git-extra-menu-map)
(defun vc-git-root (file)
- (vc-find-root file ".git"))
+ (or (vc-file-getprop file 'git-root)
+ (vc-file-setprop file 'git-root (vc-find-root file ".git"))))
;; Derived from `lgrep'.
(defun vc-git-grep (regexp &optional files dir)
-;;; vc-hg.el --- VC backend for the mercurial version control system
+;;; vc-hg.el --- VC backend for the mercurial version control system -*- lexical-binding: t -*-
;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Ivan Kanis
+;; Maintainer: FSF
;; Keywords: vc tools
;; Package: vc
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc)
(require 'vc-dir))
(defvar vc-hg-history nil)
(defun vc-hg-revision-granularity () 'repository)
-(defun vc-hg-checkout-model (files) 'implicit)
+(defun vc-hg-checkout-model (_files) 'implicit)
;;; State querying functions
;; Modeled after the similar function in vc-cvs.el
(defun vc-hg-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-hg-revision-table files))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-hg-revision-table files)))))
table))
(defun vc-hg-annotate-command (file buffer &optional revision)
(expand-file-name (match-string-no-properties 4)
(vc-hg-root default-directory)))))))
-(defun vc-hg-previous-revision (file rev)
+(defun vc-hg-previous-revision (_file rev)
(let ((newrev (1- (string-to-number rev))))
(when (>= newrev 0)
(number-to-string newrev))))
-(defun vc-hg-next-revision (file rev)
+(defun vc-hg-next-revision (_file rev)
(let ((newrev (1+ (string-to-number rev)))
(tip-revision
(with-temp-buffer
"Rename file from OLD to NEW using `hg mv'."
(vc-hg-command nil 0 new "mv" old))
-(defun vc-hg-register (files &optional rev comment)
+(defun vc-hg-register (files &optional _rev _comment)
"Register FILES under hg.
REV is ignored.
COMMENT is ignored."
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-hg-checkin (files rev comment)
+(defun vc-hg-checkin (files _rev comment)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
(apply 'vc-hg-command nil 0 files
(vc-hg-command buffer 0 file "cat"))))
;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-checkout (file &optional editable rev)
+(defun vc-hg-checkout (file &optional _editable rev)
"Retrieve a revision of FILE.
EDITABLE is ignored.
REV is the revision to check out into WORKFILE."
(defvar log-view-vc-backend)
-(defstruct (vc-hg-extra-fileinfo
+(cl-defstruct (vc-hg-extra-fileinfo
(:copier nil)
(:constructor vc-hg-create-extra-fileinfo (rename-state extra-name))
(:conc-name vc-hg-extra-fileinfo->))
(when extra
(insert (propertize
(format " (%s %s)"
- (case (vc-hg-extra-fileinfo->rename-state extra)
- (copied "copied from")
- (renamed-from "renamed from")
- (renamed-to "renamed to"))
+ (pcase (vc-hg-extra-fileinfo->rename-state extra)
+ (`copied "copied from")
+ (`renamed-from "renamed from")
+ (`renamed-to "renamed to"))
(vc-hg-extra-fileinfo->extra-name extra))
'face 'font-lock-comment-face)))))
(defun vc-hg-after-dir-status (update-function)
- (let ((status-char nil)
- (file nil)
+ (let ((file nil)
(translation '((?= . up-to-date)
(?C . up-to-date)
(?A . added)
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
-(defun vc-hg-dir-status-files (dir files default-state update-function)
+(defun vc-hg-dir-status-files (dir files _default-state update-function)
(apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files)
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
(mapcar (lambda (arg) (list "-r" arg)) marked-list)))
(error "No log entries selected for push"))))
+(defvar vc-hg-error-regexp-alist nil
+ ;; 'hg pull' does not list modified files, so, for now, the only
+ ;; benefit of `vc-compilation-mode' is that one can get rid of
+ ;; *vc-hg* buffer with 'q' or 'z'.
+ ;; TODO: call 'hg incoming' before pull/merge to get the list of
+ ;; modified files
+ "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.")
+
(defun vc-hg-pull (prompt)
"Issue a Mercurial pull command.
If called interactively with a set of marked Log View buffers,
args (cddr args)))
(apply 'vc-do-async-command buffer root hg-program
command args)
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))))
(defun vc-hg-merge-branch ()
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root))))
(apply 'vc-do-async-command buffer root vc-hg-program '("merge"))
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
;;; Internal functions
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
;; Customization Variables (the rest is in vc.el)
-(defvar vc-ignore-vc-files nil)
-(make-obsolete-variable 'vc-ignore-vc-files
- "set `vc-handled-backends' to nil to disable VC."
- "21.1")
-
-(defvar vc-master-templates ())
-(make-obsolete-variable 'vc-master-templates
- "to define master templates for a given BACKEND, use
-vc-BACKEND-master-templates. To enable or disable VC for a given
-BACKEND, use `vc-handled-backends'."
- "21.1")
-
(defcustom vc-ignore-dir-regexp
;; Stop SMB, automounter, AFS, and DFS host lookups.
locate-dominating-stop-dir-regexp
:group 'vc)
(defcustom vc-display-status t
- "If non-nil, display revision number and lock status in modeline.
+ "If non-nil, display revision number and lock status in mode line.
Otherwise, not displayed."
:type 'boolean
:group 'vc)
(let ((filepos 0))
(while
(and (< 0 (cadr (insert-file-contents
- file nil filepos (incf filepos blocksize))))
+ file nil filepos (cl-incf filepos blocksize))))
(progn (beginning-of-line)
(let ((pos (re-search-forward limit nil 'move)))
(when pos (delete-region (match-beginning 0)
(if (or (not (eq (cadr err)
(indirect-function
(vc-find-backend-function backend 'diff))))
- (not (eq (caddr err) 4)))
+ (not (eq (cl-caddr err) 4)))
(signal (car err) (cdr err))
(vc-call-backend backend 'diff (list file)))))))
"Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
(let ((sym (vc-make-backend-sym backend 'master-templates)))
(unless (get backend 'vc-templates-grabbed)
- (put backend 'vc-templates-grabbed t)
- (set sym (append (delq nil
- (mapcar
- (lambda (template)
- (and (consp template)
- (eq (cdr template) backend)
- (car template)))
- (with-no-warnings
- vc-master-templates)))
- (symbol-value sym))))
+ (put backend 'vc-templates-grabbed t))
(let ((result (vc-check-master-templates file (symbol-value sym))))
(if (stringp result)
(vc-file-setprop file 'vc-name result)
(let ((file buffer-file-name)
backend)
(ignore-errors ;Be careful not to prevent saving the file.
+ (unless (file-exists-p file)
+ (vc-file-clearprops file))
(and (setq backend (vc-backend file))
(vc-up-to-date-p file)
(eq (vc-checkout-model backend (list file)) 'implicit)
backend)
(defun vc-default-mode-line-string (backend file)
- "Return string for placement in modeline by `vc-mode-line' for FILE.
+ "Return a string for `vc-mode-line' to put in the mode line for FILE.
Format:
\"BACKEND-REV\" if the file is up-to-date
(let (backend)
(cond
((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
- ;; Compute the state and put it in the modeline.
+ ;; Compute the state and put it in the mode line.
(vc-mode-line buffer-file-name backend)
(unless vc-make-backup-files
;; Use this variable, not make-backup-files,
(let ((map (make-sparse-keymap "Version Control")))
;;(define-key map [show-files]
;; '("Show Files under VC" . (vc-directory t)))
- (define-key map [vc-retrieve-tag]
- `(menu-item ,(purecopy "Retrieve Tag") vc-retrieve-tag
- :help ,(purecopy "Retrieve tagged version or branch")))
- (define-key map [vc-create-tag]
- `(menu-item ,(purecopy "Create Tag") vc-create-tag
- :help ,(purecopy "Create version tag")))
- (define-key map [separator1] menu-bar-separator)
- (define-key map [vc-annotate]
- `(menu-item ,(purecopy "Annotate") vc-annotate
- :help ,(purecopy "Display the edit history of the current file using colors")))
- (define-key map [vc-rename-file]
- `(menu-item ,(purecopy "Rename File") vc-rename-file
- :help ,(purecopy "Rename file")))
- (define-key map [vc-revision-other-window]
- `(menu-item ,(purecopy "Show Other Version") vc-revision-other-window
- :help ,(purecopy "Visit another version of the current file in another window")))
- (define-key map [vc-diff]
- `(menu-item ,(purecopy "Compare with Base Version") vc-diff
- :help ,(purecopy "Compare file set with the base version")))
- (define-key map [vc-root-diff]
- `(menu-item ,(purecopy "Compare Tree with Base Version") vc-root-diff
- :help ,(purecopy "Compare current tree with the base version")))
- (define-key map [vc-update-change-log]
- `(menu-item ,(purecopy "Update ChangeLog") vc-update-change-log
- :help ,(purecopy "Find change log file and add entries from recent version control logs")))
- (define-key map [vc-log-out]
- `(menu-item ,(purecopy "Show Outgoing Log") vc-log-outgoing
- :help ,(purecopy "Show a log of changes that will be sent with a push operation")))
- (define-key map [vc-log-in]
- `(menu-item ,(purecopy "Show Incoming Log") vc-log-incoming
- :help ,(purecopy "Show a log of changes that will be received with a pull operation")))
- (define-key map [vc-print-log]
- `(menu-item ,(purecopy "Show History") vc-print-log
- :help ,(purecopy "List the change log of the current file set in a window")))
- (define-key map [vc-print-root-log]
- `(menu-item ,(purecopy "Show Top of the Tree History ") vc-print-root-log
- :help ,(purecopy "List the change log for the current tree in a window")))
- (define-key map [separator2] menu-bar-separator)
- (define-key map [vc-insert-header]
- `(menu-item ,(purecopy "Insert Header") vc-insert-headers
- :help ,(purecopy "Insert headers into a file for use with a version control system.
-")))
- (define-key map [undo]
- `(menu-item ,(purecopy "Undo Last Check-In") vc-rollback
- :help ,(purecopy "Remove the most recent changeset committed to the repository")))
- (define-key map [vc-revert]
- `(menu-item ,(purecopy "Revert to Base Version") vc-revert
- :help ,(purecopy "Revert working copies of the selected file set to their repository contents")))
- (define-key map [vc-update]
- `(menu-item ,(purecopy "Update to Latest Version") vc-update
- :help ,(purecopy "Update the current fileset's files to their tip revisions")))
- (define-key map [vc-next-action]
- `(menu-item ,(purecopy "Check In/Out") vc-next-action
- :help ,(purecopy "Do the next logical version control operation on the current fileset")))
- (define-key map [vc-register]
- `(menu-item ,(purecopy "Register") vc-register
- :help ,(purecopy "Register file set into a version control system")))
- (define-key map [vc-dir]
- `(menu-item ,(purecopy "VC Dir") vc-dir
- :help ,(purecopy "Show the VC status of files in a directory")))
+ (bindings--define-key map [vc-retrieve-tag]
+ '(menu-item "Retrieve Tag" vc-retrieve-tag
+ :help "Retrieve tagged version or branch"))
+ (bindings--define-key map [vc-create-tag]
+ '(menu-item "Create Tag" vc-create-tag
+ :help "Create version tag"))
+ (bindings--define-key map [separator1] menu-bar-separator)
+ (bindings--define-key map [vc-annotate]
+ '(menu-item "Annotate" vc-annotate
+ :help "Display the edit history of the current file using colors"))
+ (bindings--define-key map [vc-rename-file]
+ '(menu-item "Rename File" vc-rename-file
+ :help "Rename file"))
+ (bindings--define-key map [vc-revision-other-window]
+ '(menu-item "Show Other Version" vc-revision-other-window
+ :help "Visit another version of the current file in another window"))
+ (bindings--define-key map [vc-diff]
+ '(menu-item "Compare with Base Version" vc-diff
+ :help "Compare file set with the base version"))
+ (bindings--define-key map [vc-root-diff]
+ '(menu-item "Compare Tree with Base Version" vc-root-diff
+ :help "Compare current tree with the base version"))
+ (bindings--define-key map [vc-update-change-log]
+ '(menu-item "Update ChangeLog" vc-update-change-log
+ :help "Find change log file and add entries from recent version control logs"))
+ (bindings--define-key map [vc-log-out]
+ '(menu-item "Show Outgoing Log" vc-log-outgoing
+ :help "Show a log of changes that will be sent with a push operation"))
+ (bindings--define-key map [vc-log-in]
+ '(menu-item "Show Incoming Log" vc-log-incoming
+ :help "Show a log of changes that will be received with a pull operation"))
+ (bindings--define-key map [vc-print-log]
+ '(menu-item "Show History" vc-print-log
+ :help "List the change log of the current file set in a window"))
+ (bindings--define-key map [vc-print-root-log]
+ '(menu-item "Show Top of the Tree History " vc-print-root-log
+ :help "List the change log for the current tree in a window"))
+ (bindings--define-key map [separator2] menu-bar-separator)
+ (bindings--define-key map [vc-insert-header]
+ '(menu-item "Insert Header" vc-insert-headers
+ :help "Insert headers into a file for use with a version control system.
+"))
+ (bindings--define-key map [undo]
+ '(menu-item "Undo Last Check-In" vc-rollback
+ :help "Remove the most recent changeset committed to the repository"))
+ (bindings--define-key map [vc-revert]
+ '(menu-item "Revert to Base Version" vc-revert
+ :help "Revert working copies of the selected file set to their repository contents"))
+ (bindings--define-key map [vc-update]
+ '(menu-item "Update to Latest Version" vc-update
+ :help "Update the current fileset's files to their tip revisions"))
+ (bindings--define-key map [vc-next-action]
+ '(menu-item "Check In/Out" vc-next-action
+ :help "Do the next logical version control operation on the current fileset"))
+ (bindings--define-key map [vc-register]
+ '(menu-item "Register" vc-register
+ :help "Register file set into a version control system"))
+ (bindings--define-key map [vc-dir]
+ '(menu-item "VC Dir" vc-dir
+ :help "Show the VC status of files in a directory"))
map))
(defalias 'vc-menu-map vc-menu-map)
-;;; vc-mtn.el --- VC backend for Monotone
+;;; vc-mtn.el --- VC backend for Monotone -*- lexical-binding: t -*-
;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;;; Code:
-(eval-when-compile (require 'cl) (require 'vc))
+(eval-when-compile (require 'vc))
(defgroup vc-mtn nil
"VC Monotone (mtn) backend."
;;;###autoload (vc-mtn-registered file))))
(defun vc-mtn-revision-granularity () 'repository)
-(defun vc-mtn-checkout-model (files) 'implicit)
+(defun vc-mtn-checkout-model (_files) 'implicit)
(defun vc-mtn-root (file)
(setq file (if (file-directory-p file)
:group 'vc-mtn)
(defun vc-mtn-mode-line-string (file)
- "Return string for placement in modeline by `vc-mode-line' for FILE."
+ "Return a string for `vc-mode-line' to put in the mode line for FILE."
(let ((branch (vc-mtn-workfile-branch file)))
(dolist (rule vc-mtn-mode-line-rewrite)
(if (string-match (car rule) branch)
(setq branch (replace-match (cdr rule) t nil branch))))
(format "Mtn%c%s"
- (case (vc-state file)
- ((up-to-date needs-update) ?-)
- (added ?@)
- (t ?:))
+ (pcase (vc-state file)
+ ((or `up-to-date `needs-update) ?-)
+ (`added ?@)
+ (_ ?:))
branch)))
-(defun vc-mtn-register (files &optional rev comment)
+(defun vc-mtn-register (files &optional _rev _comment)
(vc-mtn-command nil 0 files "add"))
(defun vc-mtn-responsible-p (file) (vc-mtn-root file))
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-mtn-checkin (files rev comment)
+(defun vc-mtn-checkin (files _rev comment)
(apply 'vc-mtn-command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers '(("Author" . "--author")
;; (defun vc-mtn-rollback (files)
;; )
-(defun vc-mtn-print-log (files buffer &optional shortlog start-revision limit)
+(defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit)
(apply 'vc-mtn-command buffer 0 files "log"
(append
(when start-revision (list "--from" (format "%s" start-revision)))
(push (match-string 0) ids))
ids)))
-(defun vc-mtn-revision-completion-table (files)
- ;; TODO: Implement completion for selectors
- ;; TODO: Implement completion for composite selectors.
- (lexical-let ((files files))
- ;; What about using `files'?!? --Stef
- (lambda (string pred action)
- (cond
- ;; "Tag" selectors.
- ((string-match "\\`t:" string)
+(defun vc-mtn-revision-completion-table (_files)
+ ;; 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" or "Head" selectors.
+ ((string-match "\\`[hb]:" string)
+ (let ((prefix (match-string 0 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))
+ (mapcar (lambda (tag) (concat prefix tag))
(vc-mtn-list-branches))
- string pred))
- ;; "ID" selectors.
- ((string-match "\\`i:" string)
- (complete-with-action action
- (mapcar (lambda (tag) (concat "i:" tag))
- (vc-mtn-list-revision-ids
- (substring string (match-end 0))))
- string pred))
- (t
- (complete-with-action action
- '("t:" "b:" "h:" "i:"
- ;; Completion not implemented for these.
- "a:" "c:" "d:" "e:" "l:")
- string pred))))))
+ string pred)))
+ ;; "ID" selectors.
+ ((string-match "\\`i:" string)
+ (complete-with-action action
+ (mapcar (lambda (tag) (concat "i:" tag))
+ (vc-mtn-list-revision-ids
+ (substring string (match-end 0))))
+ string pred))
+ (t
+ (complete-with-action action
+ '("t:" "b:" "h:" "i:"
+ ;; Completion not implemented for these.
+ "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)))))
;;; vc-rcs.el --- support for RCS version-control
-;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;;;
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc))
(defgroup vc-rcs nil
;; Apply reverse-chronological edits on the trunk, computing and
;; accumulating forward-chronological edits after some point, for
;; later.
- (flet ((r/d/a () (vector pre
- (cdr (assq 'date meta))
- (cdr (assq 'author meta)))))
+ (cl-flet ((r/d/a () (vector pre
+ (cdr (assq 'date meta))
+ (cdr (assq 'author meta)))))
(while (when (setq pre cur cur (cdr (assq 'next meta)))
(not (string= "" cur)))
(setq
(goto-char (point-min))
(forward-line (1- (pop insn)))
(setq p (point))
- (case (pop insn)
- (k (setq s (buffer-substring-no-properties
- p (progn (forward-line (car insn))
- (point))))
- (when prda
- (push `(,p . ,(propertize s :vc-rcs-r/d/a prda)) path))
- (delete-region p (point)))
- (i (setq s (car insn))
- (when prda
- (push `(,p . ,(length s)) path))
- (insert s)))))
+ (pcase (pop insn)
+ (`k (setq s (buffer-substring-no-properties
+ p (progn (forward-line (car insn))
+ (point))))
+ (when prda
+ (push `(,p . ,(propertize s :vc-rcs-r/d/a prda)) path))
+ (delete-region p (point)))
+ (`i (setq s (car insn))
+ (when prda
+ (push `(,p . ,(length s)) path))
+ (insert s)))))
;; For the initial revision, setting `:vc-rcs-r/d/a' directly is
;; equivalent to pushing an insert instruction (of the entire buffer
;; contents) onto `path' then erasing the buffer, but less wasteful.
(dolist (insn (cdr (assq :insn meta)))
(goto-char (point-min))
(forward-line (1- (pop insn)))
- (case (pop insn)
- (k (delete-region
- (point) (progn (forward-line (car insn))
- (point))))
- (i (insert (propertize
- (car insn)
- :vc-rcs-r/d/a
- (or prda (setq prda (r/d/a))))))))
+ (pcase (pop insn)
+ (`k (delete-region
+ (point) (progn (forward-line (car insn))
+ (point))))
+ (`i (insert (propertize
+ (car insn)
+ :vc-rcs-r/d/a
+ (or prda (setq prda (r/d/a))))))))
(prog1 (not (string= (if nbls (caar nbls) revision) pre))
(setq pre (cdr (assq 'next meta)))))))))
;; Lastly, for each line, insert at bol nicely-formatted history info.
ht)
(setq maxw (max w maxw))))
(let ((padding (make-string maxw 32)))
- (flet ((pad (w) (substring-no-properties padding w))
- (render (rda &rest ls)
- (propertize
- (apply 'concat
- (format-time-string "%Y-%m-%d" (aref rda 1))
- " "
- (aref rda 0)
- ls)
- :vc-annotate-prefix t
- :vc-rcs-r/d/a rda)))
+ (cl-flet ((pad (w) (substring-no-properties padding w))
+ (render (rda &rest ls)
+ (propertize
+ (apply 'concat
+ (format-time-string "%Y-%m-%d" (aref rda 1))
+ " "
+ (aref rda 0)
+ ls)
+ :vc-annotate-prefix t
+ :vc-rcs-r/d/a rda)))
(maphash
(if all-me
(lambda (rda w)
(minor-num (string-to-number (vc-rcs-minor-part rev))))
(concat branch "." (number-to-string (1+ minor-num))))))
+;; Note that most GNU/Linux distributions seem to supply rcs2log in a
+;; standard bin directory. Eg both Red Hat and Debian include it in
+;; their cvs packages. It's not obvious why Emacs still needs to
+;; provide it as well...
+(defvar vc-rcs-rcs2log-program
+ (let (exe)
+ (cond ((file-executable-p
+ (setq exe (expand-file-name "rcs2log" exec-directory)))
+ exe)
+ ;; In the unlikely event that someone is running an
+ ;; uninstalled Emacs and wants to do something RCS-related.
+ ((file-executable-p
+ (setq exe (expand-file-name "lib-src/rcs2log" source-directory)))
+ exe)
+ (t "rcs2log")))
+ "Path to the `rcs2log' program (normally in `exec-directory').")
+
(defun vc-rcs-update-changelog (files)
"Default implementation of update-changelog.
Uses `rcs2log' which only works for RCS and CVS."
(unwind-protect
(progn
(setq default-directory odefault)
- (if (eq 0 (apply 'call-process
- (expand-file-name "rcs2log"
- exec-directory)
+ (if (eq 0 (apply 'call-process vc-rcs-rcs2log-program
nil (list t tempfile) nil
"-c" changelog
"-u" (concat login-name
;; to "de-@@-format" the printed representation as the first step
;; to translating it into some value. See internal func `gather'.
@-holes)
- (flet ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
- (at (tag) (save-excursion (eq tag (read buffer))))
- (to-eol () (buffer-substring-no-properties
- (point) (progn (forward-line 1)
- (1- (point)))))
- (to-semi () (setq b (point)
- e (progn (search-forward ";")
- (1- (point)))))
- (to-one@ () (setq @-holes nil
- b (progn (search-forward "@") (point))
- e (progn (while (and (search-forward "@")
- (= ?@ (char-after))
- (progn
- (push (point) @-holes)
- (forward-char 1)
- (push (point) @-holes))))
- (1- (point)))))
- (tok+val (set-b+e name &optional proc)
- (unless (eq name (setq tok (read buffer)))
- (error "Missing `%s' while parsing %s" name context))
- (sw)
- (funcall set-b+e)
- (cons tok (if proc
- (funcall proc)
- (buffer-substring-no-properties b e))))
- (k-semi (name &optional proc) (tok+val 'to-semi name proc))
- (gather () (let ((pairs `(,e ,@@-holes ,b))
- acc)
- (while pairs
- (push (buffer-substring-no-properties
- (cadr pairs) (car pairs))
- acc)
- (setq pairs (cddr pairs)))
- (apply 'concat acc)))
- (k-one@ (name &optional later) (tok+val 'to-one@ name
- (if later
- (lambda () t)
- 'gather))))
+ (cl-flet*
+ ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
+ (at (tag) (save-excursion (eq tag (read buffer))))
+ (to-eol () (buffer-substring-no-properties
+ (point) (progn (forward-line 1)
+ (1- (point)))))
+ (to-semi () (setq b (point)
+ e (progn (search-forward ";")
+ (1- (point)))))
+ (to-one@ () (setq @-holes nil
+ b (progn (search-forward "@") (point))
+ e (progn (while (and (search-forward "@")
+ (= ?@ (char-after))
+ (progn
+ (push (point) @-holes)
+ (forward-char 1)
+ (push (point) @-holes))))
+ (1- (point)))))
+ (tok+val (set-b+e name &optional proc)
+ (unless (eq name (setq tok (read buffer)))
+ (error "Missing `%s' while parsing %s" name context))
+ (sw)
+ (funcall set-b+e)
+ (cons tok (if proc
+ (funcall proc)
+ (buffer-substring-no-properties b e))))
+ (k-semi (name &optional proc) (tok+val #'to-semi name proc))
+ (gather () (let ((pairs `(,e ,@@-holes ,b))
+ acc)
+ (while pairs
+ (push (buffer-substring-no-properties
+ (cadr pairs) (car pairs))
+ acc)
+ (setq pairs (cddr pairs)))
+ (apply 'concat acc)))
+ (k-one@ (name &optional later) (tok+val #'to-one@ name
+ (if later
+ (lambda () t)
+ #'gather))))
(save-excursion
(goto-char (point-min))
;; headers
(setq context 'headers)
- (flet ((hpush (name &optional proc)
- (push (k-semi name proc) headers)))
+ (cl-flet ((hpush (name &optional proc)
+ (push (k-semi name proc) headers)))
(hpush 'head)
(when (at 'branch)
(hpush 'branch))
(when (< (car ls) 100)
(setcar ls (+ 1900 (car ls))))
(apply 'encode-time (nreverse ls)))))
- ,@(mapcar 'k-semi '(author state))
+ ,@(mapcar #'k-semi '(author state))
,(k-semi 'branches
(lambda ()
(split-string
;; only the former since it behaves identically to the
;; latter in the absence of "@@".)
sub)
- (flet ((incg (beg end) (let ((b beg) (e end) @-holes)
- (while (and asc (< (car asc) e))
- (push (pop asc) @-holes))
- ;; Self-deprecate when work is done.
- ;; Folding many dimensions into one.
- ;; Thanks B.Mandelbrot, for complex sum.
- ;; O beauteous math! --the Unvexed Bum
- (unless asc
- (setq sub 'buffer-substring-no-properties))
- (gather))))
+ (cl-flet ((incg (beg end)
+ (let ((b beg) (e end) @-holes)
+ (while (and asc (< (car asc) e))
+ (push (pop asc) @-holes))
+ ;; Self-deprecate when work is done.
+ ;; Folding many dimensions into one.
+ ;; Thanks B.Mandelbrot, for complex sum.
+ ;; O beauteous math! --the Unvexed Bum
+ (unless asc
+ (setq sub #'buffer-substring-no-properties))
+ (gather))))
(while (and (sw)
(not (eobp))
(setq context (to-eol)
(setcdr (cadr rev) (gather))
(if @-holes
(setq asc (nreverse @-holes)
- sub 'incg)
- (setq sub 'buffer-substring-no-properties))
+ sub #'incg)
+ (setq sub #'buffer-substring-no-properties))
(goto-char b)
(setq acc nil)
(while (< (point) e)
start (read (current-buffer))
act (read (current-buffer)))
(forward-char 1)
- (push (case cmd
+ (push (pcase cmd
(?d
;; `d' means "delete lines".
;; For Emacs spirit, we use `k' for "kill".
`(,(1+ start) i
,(funcall sub (point) (progn (forward-line act)
(point)))))
- (t (error "Bad command `%c' in `text' for rev `%s'"
+ (_ (error "Bad command `%c' in `text' for rev `%s'"
cmd context)))
acc))
(goto-char (1+ e))
;;; vc-sccs.el --- support for SCCS version-control
-;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;;; Commentary:
-;; Proper function of the SCCS diff commands requires the shellscript vcdiff
-;; to be installed somewhere on Emacs's path for executables.
-;;
-
;;; Code:
(eval-when-compile
;;;
;; ;; Maybe a better solution is to not use "get" but "sccs get".
-;; (defcustom vc-sccs-path
-;; (let ((path ()))
-;; (dolist (dir '("/usr/sccs" "/usr/lib/sccs" "/usr/libexec/sccs"))
-;; (if (file-directory-p dir)
-;; (push dir path)))
-;; path)
-;; "List of extra directories to search for SCCS commands."
-;; :type '(repeat directory)
-;; :group 'vc)
+;; ;; Note for GNU CSSC, you can parse sccs -V to get the libexec path.
+;; (defcustom vc-sccs-path
+;; (prune-directory-list '("/usr/ccs/bin" "/usr/sccs" "/usr/lib/sccs"
+;; "/usr/libexec/sccs"))
+;; "List of extra directories to search for SCCS commands."
+;; :type '(repeat directory)
+;; :group 'vc)
(defgroup vc-sccs nil
"VC SCCS backend."
(vc-insert-file (vc-name file) "^\001e\n\001[^s]")
(vc-parse-buffer "^\001d D \\([^ ]+\\)" 1)))
+;; Cf vc-sccs-find-revision.
+(defun vc-sccs-write-revision (file outfile &optional rev)
+ "Write the SCCS version of input file FILE to output file OUTFILE.
+Optional string REV is a revision."
+ (with-temp-buffer
+ (apply 'vc-sccs-do-command t 0 "get" (vc-name file)
+ (append '("-s" "-p" "-k") ; -k: no keyword expansion
+ (if rev (list (concat "-r" rev)))))
+ (write-region nil nil outfile nil 'silent)))
+
(defun vc-sccs-workfile-unchanged-p (file)
"SCCS-specific implementation of `vc-workfile-unchanged-p'."
- (zerop (apply 'vc-do-command "*vc*" 1 "vcdiff" (vc-name file)
- (list "--brief" "-q"
- (concat "-r" (vc-working-revision file))))))
+ (let ((tempfile (make-temp-file "vc-sccs")))
+ (unwind-protect
+ (progn
+ (vc-sccs-write-revision file tempfile (vc-working-revision file))
+ (zerop (vc-do-command "*vc*" 1 "cmp" file tempfile)))
+ (delete-file tempfile))))
\f
;;;
(vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-name files))
(when limit 'limit-unsupported))
+;; FIXME use sccsdiff if present?
(defun vc-sccs-diff (files &optional oldvers newvers buffer)
"Get a difference report using SCCS between two filesets."
(setq files (vc-expand-dirs files))
(setq oldvers (vc-sccs-lookup-triple (car files) oldvers))
(setq newvers (vc-sccs-lookup-triple (car files) newvers))
- (apply 'vc-do-command (or buffer "*vc-diff*")
- 1 "vcdiff" (mapcar 'vc-name (vc-expand-dirs files))
- (append (list "-q"
- (and oldvers (concat "-r" oldvers))
- (and newvers (concat "-r" newvers)))
- (vc-switches 'SCCS 'diff))))
+ (or buffer (setq buffer "*vc-diff*"))
+ ;; We have to reimplement pieces of vc-do-command, because
+ ;; we want to run multiple external commands, and only do the setup
+ ;; and exit pieces once.
+ (save-current-buffer
+ (unless (or (eq buffer t)
+ (and (stringp buffer) (string= (buffer-name) buffer))
+ (eq buffer (current-buffer)))
+ (vc-setup-buffer buffer))
+ (let* ((fake-flags (append (vc-switches 'SCCS 'diff)
+ (if oldvers (list (concat " -r" oldvers)))
+ (if newvers (list (concat " -r" newvers)))))
+ (fake-command
+ (format "diff%s %s"
+ (if fake-flags
+ (concat " " (mapconcat 'identity fake-flags " "))
+ "")
+ (vc-delistify files)))
+ (status 0)
+ (oldproc (get-buffer-process (current-buffer))))
+ (when vc-command-messages
+ (message "Running %s in foreground..." fake-command))
+ (if oldproc (delete-process oldproc))
+ (dolist (file files)
+ (let ((oldfile (make-temp-file "vc-sccs"))
+ newfile)
+ (unwind-protect
+ (progn
+ (vc-sccs-write-revision file oldfile oldvers)
+ (if newvers
+ (vc-sccs-write-revision file (setq newfile
+ (make-temp-file "vc-sccs"))
+ newvers))
+ (let* ((inhibit-read-only t)
+ (buffer-undo-list t)
+ (process-environment
+ (cons "LC_MESSAGES=C" process-environment))
+ (w32-quote-process-args t)
+ (this-status
+ (apply 'process-file "diff" nil t nil
+ (append (vc-switches 'SCCS 'diff)
+ (list oldfile
+ (or newfile
+ (file-relative-name file)))))))
+ (or (integerp this-status) (setq status 'error))
+ (and (integerp status)
+ (> this-status status)
+ (setq status this-status))))
+ (delete-file oldfile)
+ (if newfile (delete-file newfile)))))
+ (when (or (not (integerp status)) (> status 1))
+ (unless (eq ?\s (aref (buffer-name (current-buffer)) 0))
+ (pop-to-buffer (current-buffer))
+ (goto-char (point-min))
+ (shrink-window-if-larger-than-buffer))
+ (error "Running %s...FAILED (%s)" fake-command
+ (if (integerp status) (format "status %d" status) status)))
+ (when vc-command-messages
+ (message "Running %s...OK = %d" fake-command status))
+ ;; Should we pretend we ran sccsdiff instead?
+ ;; This might not actually be a valid diff command.
+ (run-hook-with-args 'vc-post-command-functions "diff" files fake-flags)
+ status)))
\f
;;;
-;;; vc.el --- drive a version-control system from within Emacs
+;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1992-1998, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1998, 2000-2012 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
(require 'vc-hooks)
(require 'vc-dispatcher)
-(require 'ediff)
+
+(declare-function diff-setup-whitespace "diff-mode" ())
(eval-when-compile
- (require 'cl)
(require 'dired))
(unless (assoc 'vc-parent-buffer minor-mode-alist)
;; General customization
(defgroup vc nil
- "Version-control system in Emacs."
+ "Emacs interface to version control systems."
:group 'tools)
(defcustom vc-initial-comment nil
(string :tag "Comment End")))
:group 'vc)
-(defcustom vc-checkout-carefully (= (user-uid) 0)
- "Non-nil means be extra-careful in checkout.
-Verify that the file really is not locked
-and that its contents match what the repository version says."
- :type 'boolean
- :group 'vc)
-(make-obsolete-variable 'vc-checkout-carefully
- "the corresponding checks are always done now."
- "21.1")
-
\f
;; Variables users don't need to see
(if (file-directory-p file)
(dolist (buffer (buffer-list))
(let ((fname (buffer-file-name buffer)))
- (when (and fname (vc-string-prefix-p file fname))
+ (when (and fname (string-prefix-p file fname))
(push fname flist))))
(push file flist)))
,form
(lambda (arg)
(message "arg %s" arg)
(and (file-directory-p arg)
- (vc-string-prefix-p (expand-file-name arg) def-dir)))))))
+ (string-prefix-p (expand-file-name arg) def-dir)))))))
(let ((default-directory repo-dir))
(vc-call-backend bk 'create-repo))
(throw 'found bk))))
(defvar vc-dir-backend)
(defvar log-view-vc-backend)
+(defvar log-edit-vc-backend)
(defvar diff-vc-backend)
(defun vc-deduce-backend ()
(cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
((derived-mode-p 'log-view-mode) log-view-vc-backend)
+ ((derived-mode-p 'log-edit-mode) log-edit-vc-backend)
((derived-mode-p 'diff-mode) diff-vc-backend)
;; Maybe we could even use comint-mode rather than shell-mode?
((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode)
(let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
(backend (car vc-fileset))
(files (nth 1 vc-fileset))
- (fileset-only-files (nth 2 vc-fileset))
+ ;; (fileset-only-files (nth 2 vc-fileset))
;; FIXME: We used to call `vc-recompute-state' here.
(state (nth 3 vc-fileset))
;; The backend should check that the checkout-model is consistent
;; Files have local changes
((vc-compatible-state state 'edited)
(let ((ready-for-commit files))
- ;; If files are edited but read-only, give user a chance to correct.
- (dolist (file files)
- ;; If committing a mix of removed and edited files, the
- ;; fileset has state = 'edited. Rather than checking the
- ;; state of each individual file in the fileset, it seems
- ;; simplest to just check if the file exists. Bug#9781.
- (when (and (file-exists-p file) (not (file-writable-p file)))
- ;; Make the file+buffer read-write.
- (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file))
- (error "Aborted"))
- ;; Maybe we somehow lost permissions on the directory.
- (condition-case nil
- (set-file-modes file (logior (file-modes file) 128))
- (error (error "Unable to make file writable")))
- (let ((visited (get-file-buffer file)))
- (when visited
- (with-current-buffer visited
- (toggle-read-only -1))))))
+ ;; CVS, SVN and bzr don't care about read-only (bug#9781).
+ ;; RCS does, SCCS might (someone should check...).
+ (when (memq backend '(RCS SCCS))
+ ;; If files are edited but read-only, give user a chance to correct.
+ (dolist (file files)
+ ;; If committing a mix of removed and edited files, the
+ ;; fileset has state = 'edited. Rather than checking the
+ ;; state of each individual file in the fileset, it seems
+ ;; simplest to just check if the file exists. Bug#9781.
+ (when (and (file-exists-p file) (not (file-writable-p file)))
+ ;; Make the file+buffer read-write.
+ (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file))
+ (error "Aborted"))
+ ;; Maybe we somehow lost permissions on the directory.
+ (condition-case nil
+ (set-file-modes file (logior (file-modes file) 128))
+ (error (error "Unable to make file writable")))
+ (let ((visited (get-file-buffer file)))
+ (when visited
+ (with-current-buffer visited
+ (read-only-mode -1)))))))
;; Allow user to revert files with no changes
(save-excursion
(dolist (file files)
;; Maybe the backend is not installed ;-(
(when writable
(let ((buf (get-file-buffer file)))
- (when buf (with-current-buffer buf (toggle-read-only -1)))))
+ (when buf (with-current-buffer buf (read-only-mode -1)))))
(signal (car err) (cdr err))))
`((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
(not writable))
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(when vc-before-checkin-hook
(run-hooks 'vc-before-checkin-hook))
- (lexical-let
- ((backend backend))
- (vc-start-logentry
- files comment initial-contents
- "Enter a change comment."
- "*vc-log*"
- (lambda ()
- (vc-call-backend backend 'log-edit-mode))
- (lexical-let ((rev rev))
- (lambda (files comment)
- (message "Checking in %s..." (vc-delistify files))
- ;; "This log message intentionally left almost blank".
- ;; RCS 5.7 gripes about white-space-only comments too.
- (or (and comment (string-match "[^\t\n ]" comment))
- (setq comment "*** empty log message ***"))
- (with-vc-properties
- files
- ;; We used to change buffers to get local value of
- ;; vc-checkin-switches, but 'the' local buffer is
- ;; not a well-defined concept for filesets.
- (progn
- (vc-call-backend backend 'checkin files rev comment)
- (mapc 'vc-delete-automatic-version-backups files))
- `((vc-state . up-to-date)
- (vc-checkout-time . ,(nth 5 (file-attributes file)))
- (vc-working-revision . nil)))
- (message "Checking in %s...done" (vc-delistify files))))
- 'vc-checkin-hook)))
+ (vc-start-logentry
+ files comment initial-contents
+ "Enter a change comment."
+ "*vc-log*"
+ (lambda ()
+ (vc-call-backend backend 'log-edit-mode))
+ (lambda (files comment)
+ (message "Checking in %s..." (vc-delistify files))
+ ;; "This log message intentionally left almost blank".
+ ;; RCS 5.7 gripes about white-space-only comments too.
+ (or (and comment (string-match "[^\t\n ]" comment))
+ (setq comment "*** empty log message ***"))
+ (with-vc-properties
+ files
+ ;; We used to change buffers to get local value of
+ ;; vc-checkin-switches, but 'the' local buffer is
+ ;; not a well-defined concept for filesets.
+ (progn
+ (vc-call-backend backend 'checkin files rev comment)
+ (mapc 'vc-delete-automatic-version-backups files))
+ `((vc-state . up-to-date)
+ (vc-checkout-time . ,(nth 5 (file-attributes file)))
+ (vc-working-revision . nil)))
+ (message "Checking in %s...done" (vc-delistify files)))
+ 'vc-checkin-hook
+ backend))
;;; Additional entry points for examining version histories
(when (listp switches) switches))))
;; Old def for compatibility with Emacs-21.[123].
-(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
-(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1")
+(defmacro vc-diff-switches-list (backend)
+ (declare (obsolete vc-switches "22.1"))
+ `(vc-switches ',backend 'diff))
(defun vc-diff-finish (buffer messages)
;; The empty sync output case has already been handled, so the only
;; possibility of an empty output is for an async process.
(when (buffer-live-p buffer)
(let ((window (get-buffer-window buffer t))
- (emptyp (zerop (buffer-size buffer))))
+ (emptyp (zerop (buffer-size buffer))))
(with-current-buffer buffer
- (and messages emptyp
- (let ((inhibit-read-only t))
- (insert (cdr messages) ".\n")
- (message "%s" (cdr messages))))
- (goto-char (point-min))
- (when window
- (shrink-window-if-larger-than-buffer window)))
+ (and messages emptyp
+ (let ((inhibit-read-only t))
+ (insert (cdr messages) ".\n")
+ (message "%s" (cdr messages))))
+ (diff-setup-whitespace)
+ (goto-char (point-min))
+ (when window
+ (shrink-window-if-larger-than-buffer window)))
(when (and messages (not emptyp))
- (message "%sdone" (car messages))))))
+ (message "%sdone" (car messages))))))
(defvar vc-diff-added-files nil
"If non-nil, diff added files by comparing them to /dev/null.")
(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
(list files rev1 rev2))))
;;;###autoload
-(defun vc-version-diff (files rev1 rev2)
+(defun vc-version-diff (_files rev1 rev2)
"Report diffs between revisions of the fileset in the repository history."
(interactive (vc-diff-build-argument-list-internal))
;; All that was just so we could do argument completion!
(called-interactively-p 'interactive)))
;;;###autoload
-(defun vc-diff (historic &optional not-urgent)
+(defun vc-diff (&optional historic not-urgent)
"Display diffs between file revisions.
Normally this compares the currently selected fileset with their
working revisions. With a prefix argument HISTORIC, it reads two revision
(vc-diff-internal t (vc-deduce-fileset t) nil nil
(called-interactively-p 'interactive))))
-(declare-function ediff-vc-internal (rev1 rev2 &optional startup-hooks))
+(declare-function ediff-load-version-control "ediff" (&optional silent))
+(declare-function ediff-vc-internal "ediff-vers"
+ (rev1 rev2 &optional startup-hooks))
;;;###autoload
(defun vc-version-ediff (files rev1 rev2)
;; FIXME We only support running ediff on one file for now.
;; We could spin off an ediff session per file in the file set.
((= (length files) 1)
- (ediff-load-version-control)
+ (require 'ediff)
+ (ediff-load-version-control) ; loads ediff-vers
(find-file (car files)) ;FIXME: find-file from Elisp is bad.
(ediff-vc-internal rev1 rev2 nil))
(t
(call-interactively 'vc-version-diff)
(when buffer-file-name (vc-buffer-sync not-urgent))
(let ((backend (vc-deduce-backend))
+ (default-directory default-directory)
rootdir working-revision)
- (unless backend
- (error "Buffer is not version controlled"))
- (setq rootdir (vc-call-backend backend 'root default-directory))
+ (if backend
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq rootdir (read-directory-name "Directory for VC root-diff: "))
+ (setq backend (vc-responsible-backend rootdir))
+ (if backend
+ (setq default-directory rootdir)
+ (error "Directory is not version controlled")))
(setq working-revision (vc-working-revision rootdir))
;; VC diff for the root directory produces output that is
;; relative to it. Bind default-directory to the root directory
"Enter a replacement change comment."
"*vc-log*"
(lambda () (vc-call-backend backend 'log-edit-mode))
- (lexical-let ((rev rev)
- (backend backend))
- (lambda (files comment)
- (vc-call-backend backend
- 'modify-change-comment files rev comment))))))
+ (lambda (files comment)
+ (vc-call-backend backend
+ 'modify-change-comment files rev comment)))))
;;;###autoload
(defun vc-merge ()
(error "Sorry, merging is not implemented for %s" backend)))))
-(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
+(defun vc-maybe-resolve-conflicts (file status &optional _name-A _name-B)
(vc-resynch-buffer file t (not (buffer-modified-p)))
(if (zerop status) (message "Merge successful")
(smerge-mode 1)
(when (and limit (not (eq 'limit-unsupported pl-return))
(not is-start-revision))
(goto-char (point-max))
- (lexical-let ((working-revision working-revision)
- (limit limit))
- (insert "\n")
- (insert-text-button "Show 2X entries"
- 'action (lambda (&rest ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil (* 2 limit)))
- 'help-echo "Show the log again, and double the number of log entries shown")
- (insert " ")
- (insert-text-button "Show unlimited entries"
- 'action (lambda (&rest ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil nil))
- 'help-echo "Show the log again, including all entries"))))
+ (insert "\n")
+ (insert-text-button "Show 2X entries"
+ 'action (lambda (&rest _ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil (* 2 limit)))
+ 'help-echo "Show the log again, and double the number of log entries shown")
+ (insert " ")
+ (insert-text-button "Show unlimited entries"
+ 'action (lambda (&rest _ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil nil))
+ 'help-echo "Show the log again, including all entries")))
(defun vc-print-log-internal (backend files working-revision
&optional is-start-revision limit)
(let ((dir-present nil)
(vc-short-log nil)
(buffer-name "*vc-change-log*")
- type
- pl-return)
+ type)
(dolist (file files)
(when (file-directory-p file)
(setq dir-present t)))
(memq 'directory vc-log-short-style)
(memq 'file vc-log-short-style)))))
(setq type (if vc-short-log 'short 'long))
- (lexical-let
- ((working-revision working-revision)
- (backend backend)
- (limit limit)
- (shortlog vc-short-log)
- (files files)
- (is-start-revision is-start-revision))
+ (let ((shortlog vc-short-log))
(vc-log-internal-common
backend buffer-name files type
- (lambda (bk buf type-arg files-arg)
- (vc-call-backend bk 'print-log files-arg buf
- shortlog (when is-start-revision working-revision) limit))
- (lambda (bk files-arg ret)
+ (lambda (bk buf _type-arg files-arg)
+ (vc-call-backend bk 'print-log files-arg buf shortlog
+ (when is-start-revision working-revision) limit))
+ (lambda (_bk _files-arg ret)
(vc-print-log-setup-buttons working-revision
is-start-revision limit ret))
(lambda (bk)
(vc-call-backend bk 'show-log-entry working-revision))
- (lambda (ignore-auto noconfirm)
- (vc-print-log-internal backend files working-revision is-start-revision limit))))))
+ (lambda (_ignore-auto _noconfirm)
+ (vc-print-log-internal backend files working-revision
+ is-start-revision limit))))))
(defvar vc-log-view-type nil
"Set this to differentiate the different types of logs.")
(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
(vc-log-internal-common
backend buffer-name nil type
- (lexical-let
- ((remote-location remote-location))
- (lambda (bk buf type-arg files)
- (vc-call-backend bk type-arg buf remote-location)))
- (lambda (bk files-arg ret))
- (lambda (bk)
- (goto-char (point-min)))
- (lexical-let
- ((backend backend)
- (remote-location remote-location)
- (buffer-name buffer-name)
- (type type))
- (lambda (ignore-auto noconfirm)
- (vc-incoming-outgoing-internal backend remote-location buffer-name type)))))
+ (lambda (bk buf type-arg _files)
+ (vc-call-backend bk type-arg buf remote-location))
+ (lambda (_bk _files-arg _ret) nil)
+ (lambda (_bk) (goto-char (point-min)))
+ (lambda (_ignore-auto _noconfirm)
+ (vc-incoming-outgoing-internal backend remote-location buffer-name type))))
;;;###autoload
(defun vc-print-log (&optional working-revision limit)
(t
(list (when (> vc-log-show-limit 0) vc-log-show-limit)))))
(let ((backend (vc-deduce-backend))
+ (default-directory default-directory)
rootdir working-revision)
- (unless backend
- (error "Buffer is not version controlled"))
- (setq rootdir (vc-call-backend backend 'root default-directory))
+ (if backend
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq rootdir (read-directory-name "Directory for VC root-log: "))
+ (setq backend (vc-responsible-backend rootdir))
+ (if backend
+ (setq default-directory rootdir)
+ (error "Directory is not version controlled")))
(setq working-revision (vc-working-revision rootdir))
(vc-print-log-internal backend (list rootdir) working-revision nil limit)))
(interactive
(when current-prefix-arg
(list (read-string "Remote location (empty for default): "))))
- (let ((backend (vc-deduce-backend))
- rootdir working-revision)
+ (let ((backend (vc-deduce-backend)))
(unless backend
(error "Buffer is not version controlled"))
- (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" 'log-incoming)))
+ (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*"
+ 'log-incoming)))
;;;###autoload
(defun vc-log-outgoing (&optional remote-location)
(interactive
(when current-prefix-arg
(list (read-string "Remote location (empty for default): "))))
- (let ((backend (vc-deduce-backend))
- rootdir working-revision)
+ (let ((backend (vc-deduce-backend)))
(unless backend
(error "Buffer is not version controlled"))
- (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" 'log-outgoing)))
+ (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*"
+ 'log-outgoing)))
;;;###autoload
(defun vc-revert ()
(if (= nfiles 1) "" "s"))))))
(error "Revert canceled")))
(when diff-buffer
- (quit-windows-on diff-buffer t)))
+ (quit-windows-on diff-buffer)))
(dolist (file files)
(message "Reverting %s..." (vc-delistify files))
(vc-revert-file file)
;; Display changes
(unless (yes-or-no-p "Discard these revisions? ")
(error "Rollback canceled"))
- (quit-windows-on "*vc-diff*" t)
+ (quit-windows-on "*vc-diff*")
;; Do the actual reversions
(message "Rolling back %s..." (vc-delistify files))
(with-vc-properties
(when index
(substring rev 0 index))))
-(defun vc-default-responsible-p (backend file)
+(defun vc-default-responsible-p (_backend _file)
"Indicate whether BACKEND is responsible for FILE.
The default is to return nil always."
nil)
-(defun vc-default-could-register (backend file)
+(defun vc-default-could-register (_backend _file)
"Return non-nil if BACKEND could be used to register FILE.
The default implementation returns t for all files."
t)
-(defun vc-default-latest-on-branch-p (backend file)
+(defun vc-default-latest-on-branch-p (_backend _file)
"Return non-nil if FILE is the latest on its branch.
This default implementation always returns non-nil, which means that
editing non-current revisions is not supported by default."
t)
-(defun vc-default-init-revision (backend) vc-default-init-revision)
+(defun vc-default-init-revision (_backend) vc-default-init-revision)
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
(insert-file-contents-literally tmpfile)))
(delete-file tmpfile))))
-(defun vc-default-rename-file (backend old new)
+(defun vc-default-rename-file (_backend old new)
(condition-case nil
(add-name-to-file old new)
(error (rename-file old new)))
(declare-function log-edit-mode "log-edit" ())
-(defun vc-default-log-edit-mode (backend) (log-edit-mode))
+(defun vc-default-log-edit-mode (_backend) (log-edit-mode))
-(defun vc-default-log-view-mode (backend) (log-view-mode))
+(defun vc-default-log-view-mode (_backend) (log-view-mode))
-(defun vc-default-show-log-entry (backend rev)
+(defun vc-default-show-log-entry (_backend rev)
(with-no-warnings
(log-view-goto-rev rev)))
(defalias 'vc-default-revision-completion-table 'ignore)
(defalias 'vc-default-mark-resolved 'ignore)
-(defun vc-default-dir-status-files (backend dir files default-state update-function)
+(defun vc-default-dir-status-files (_backend _dir files default-state update-function)
(funcall update-function
(mapcar (lambda (file) (list file default-state)) files)))
\f
;; These things should probably be generally available
-
-(defun vc-string-prefix-p (prefix string)
- (let ((lpref (length prefix)))
- (and (>= (length string) lpref)
- (eq t (compare-strings prefix nil nil string nil lpref)))))
+(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.
(or window-system
(display-color-p)
(overlay-put vcursor-overlay 'before-string vcursor-string))
- (overlay-put vcursor-overlay 'face 'vcursor))
+ (overlay-put vcursor-overlay 'face 'vcursor)
+ ;; 200 is purely an arbitrary "high" number. See bug#9663.
+ (overlay-put vcursor-overlay 'priority 200))
(or leave-w (vcursor-find-window nil t))
;; vcursor-window now contains the right buffer
(or (pos-visible-in-window-p pt vcursor-window)
- (set-window-point vcursor-window pt)))
- )
+ (set-window-point vcursor-window pt))))
(defun vcursor-insert (text)
"Insert TEXT, respecting `vcursor-interpret-input'."
;;; Commentary:
-;; This file is loaded uncompiled when dumping Emacs.
-;; Doc-strings should adhere to the conventions of make-docfile.
-
;;; Code:
-(defconst emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-number (match-string 0 emacs-version))) "\
-Major version number of this version of Emacs.
+(defconst emacs-major-version
+ (progn (string-match "^[0-9]+" emacs-version)
+ (string-to-number (match-string 0 emacs-version)))
+ "Major version number of this version of Emacs.
This variable first existed in version 19.23.")
-(defconst emacs-minor-version (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) (string-to-number (match-string 1 emacs-version))) "\
-Minor version number of this version of Emacs.
+(defconst emacs-minor-version
+ (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version)
+ (string-to-number (match-string 1 emacs-version)))
+ "Minor version number of this version of Emacs.
This variable first existed in version 19.23.")
-(defconst emacs-build-time (current-time) "\
-Time at which Emacs was dumped out.")
+(defconst emacs-build-time (current-time)
+ "Time at which Emacs was dumped out.")
+
+(defconst emacs-build-system (system-name)
+ "Name of the system on which Emacs was built.")
-(defconst emacs-build-system (system-name) "\
-Name of the system on which Emacs was built.")
+(defvar motif-version-string)
+(defvar gtk-version-string)
+(defvar ns-version-string)
-(defun emacs-version (&optional here) "\
-Return string describing the version of Emacs that is running.
+(defun emacs-version (&optional here)
+ "Return string describing the version of Emacs that is running.
If optional argument HERE is non-nil, insert string at point.
Don't use this function in programs to choose actions according
to the system configuration; look at `system-configuration' instead."
;; We hope that this alias is easier for people to find.
(defalias 'version 'emacs-version)
+;; Set during dumping, this is a defvar so that it can be setq'd.
+(defvar emacs-bzr-version nil
+ "String giving the bzr revision from which this Emacs was built.
+The format is: [revno] revision_id, where revno may be absent.
+Value is nil if Emacs was not built from a bzr checkout, or if we could
+not determine the revision.")
+
+(defun emacs-bzr-version-dirstate (dir)
+ "Try to return as a string the bzr revision ID of directory DIR.
+This uses the dirstate file's parent revision entry.
+Returns nil if unable to find this information."
+ (let ((file (expand-file-name ".bzr/checkout/dirstate" dir)))
+ (when (file-readable-p file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (and (looking-at "#bazaar dirstate flat format 3")
+ (forward-line 3)
+ (looking-at "[0-9]+\0\\([^\0\n]+\\)\0")
+ (match-string 1))))))
+
+(defun emacs-bzr-version-bzr (dir)
+ "Ask bzr itself for the version information for directory DIR."
+ ;; Comments on `bzr version-info':
+ ;; i) Unknown files also cause clean != 1.
+ ;; ii) It can be slow, contacting the upstream repo to get the
+ ;; branch nick if one is not set locally, even with a custom
+ ;; template that is not asking for the nick (as used here). You'd
+ ;; think the latter part would be trivial to fix:
+ ;; https://bugs.launchpad.net/bzr/+bug/882541/comments/3
+ ;; https://bugs.launchpad.net/bzr/+bug/629150
+ ;; You can set the nick locally with `bzr nick ...', which speeds
+ ;; things up enormously. `bzr revno' does not have this issue, but
+ ;; has no way to print the revision_id AFAICS.
+ (message "Waiting for bzr...")
+ (with-temp-buffer
+ (if (zerop
+ (call-process "bzr" nil '(t nil) nil "version-info"
+ "--custom"
+ "--template={revno} {revision_id} (clean = {clean})"
+ "dir"))
+ (buffer-string))))
+
+(defun emacs-bzr-get-version (&optional dir external)
+ "Try to return as a string the bzr revision of the Emacs sources.
+The format is: [revno] revision_id, where revno may be absent.
+Value is nil if the sources do not seem to be under bzr, or if we could
+not determine the revision. Note that this reports on the current state
+of the sources, which may not correspond to the running Emacs.
+
+Optional argument DIR is a directory to use instead of `source-directory'.
+Optional argument EXTERNAL non-nil means to maybe ask `bzr' itself,
+if the sources appear to be under bzr. If `force', always ask bzr.
+Otherwise only ask bzr if we cannot find any information ourselves."
+ (or dir (setq dir source-directory))
+ (when (file-directory-p (expand-file-name ".bzr/branch" dir))
+ (if (eq external 'force)
+ (emacs-bzr-version-bzr dir)
+ (let (file loc rev)
+ (cond ((file-readable-p
+ (setq file (expand-file-name ".bzr/branch/last-revision" dir)))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-max))
+ (if (looking-back "\n")
+ (delete-char -1))
+ (buffer-string)))
+ ;; OK, no last-revision. Is it a lightweight checkout?
+ ((file-readable-p
+ (setq file (expand-file-name ".bzr/branch/location" dir)))
+ (setq rev (emacs-bzr-version-dirstate dir))
+ ;; If the parent branch is local, try looking there for the rev.
+ ;; Note: there is no guarantee that the parent branch's rev
+ ;; corresponds to this branch. This branch could have
+ ;; been made with a specific -r revno argument, or the
+ ;; parent could have been updated since this branch was created.
+ ;; To try and detect this, we check the dirstate revids
+ ;; to see if they match.
+ (if (and (setq loc (with-temp-buffer
+ (insert-file-contents file)
+ (if (looking-at "file://\\(.*\\)")
+ (match-string 1))))
+ (equal rev (emacs-bzr-version-dirstate loc)))
+ (emacs-bzr-get-version loc)
+ ;; If parent does not match, the best we can do without
+ ;; calling external commands is to use the dirstate rev.
+ rev))
+ (external
+ (emacs-bzr-version-bzr dir)))))))
+
;; We put version info into the executable in the form that `ident' uses.
-(or (eq system-type 'windows-nt)
- (purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
- " $\n")))
-
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; End:
+(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
+ " $\n"))
;;; version.el ends here
function `view-mode-exit'. If `view-return-to-alist' contains an
entry for the selected window, purge that entry from
`view-return-to-alist' before adding ITEM."
+ (declare (obsolete "this function has no effect." "24.1"))
(with-current-buffer buffer
(when view-return-to-alist
(let* ((list view-return-to-alist)
(when item
(setq view-return-to-alist
(cons item view-return-to-alist)))))
-(make-obsolete 'view-return-to-alist-update "this function has no effect." "24.1")
;;;###autoload
(defun view-mode-enter (&optional quit-restore exit-action)
(w32-get-locale-info locale)
(w32-get-locale-info locale t))))))
-;; Setup Info-default-directory-list to include the info directory
-;; near where Emacs executable was installed. We used to set INFOPATH,
-;; but when this is set Info-default-directory-list is ignored. We
-;; also cannot rely upon what is set in paths.el because they assume
-;; that configuration during build time is correct for runtime.
-(defun w32-init-info ()
- (let* ((instdir (file-name-directory invocation-directory))
- (dir1 (expand-file-name "../info/" instdir))
- (dir2 (expand-file-name "../../../info/" instdir)))
- (if (file-exists-p dir1)
- (setq Info-default-directory-list
- (append Info-default-directory-list (list dir1)))
- (if (file-exists-p dir2)
- (setq Info-default-directory-list
- (append Info-default-directory-list (list dir2)))))))
-
-(add-hook 'before-init-hook 'w32-init-info)
-
;; The variable source-directory is used to initialize Info-directory-list.
;; However, the common case is that Emacs is being used from a binary
;; distribution, and the value of source-directory is meaningless in that
(defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var
-(eval-when-compile (require 'cl))
(require 'dired)
(autoload 'dired-do-create-files-regexp "dired-aux")
(defun wdired-mode ()
- "\\<wdired-mode-map>File Names Editing mode.
+ "Writable Dired (WDired) mode.
+\\<wdired-mode-map>
+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.
+
+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.
-Press \\[wdired-finish-edit] to make the changes to take effect
-and exit. To abort the edit, use \\[wdired-abort-changes].
+Type \\[wdired-abort-changes] to abort your edits and exit WDired mode.
-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 \\[customize-group] RET wdired to customize WDired behavior.
The only editable texts in a WDired buffer are filenames,
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.
\\<wdired-mode-map>
-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))
;; There are also the following useful commands:
;;
;; `whitespace-newline-mode'
-;; Toggle NEWLINE minor mode visualization ("nl" on modeline).
+;; Toggle NEWLINE minor mode visualization ("nl" on mode line).
;;
;; `global-whitespace-newline-mode'
-;; Toggle NEWLINE global minor mode visualization ("NL" on modeline).
+;; Toggle NEWLINE global minor mode visualization ("NL" on mode line).
;;
;; `whitespace-report'
;; Report some blank problems in buffer.
;; buffer is visited or written.
;;
;;
-;; Acknowledgements
-;; ----------------
+;; Acknowledgments
+;; ---------------
;;
;; Thanks to felix (EmacsWiki) for keeping highlight when switching between
;; major modes on a file.
(defface whitespace-space
'((((class color) (background dark))
- (:background "grey20" :foreground "darkgray"))
+ :background "grey20" :foreground "darkgray")
(((class color) (background light))
- (:background "LightYellow" :foreground "lightgray"))
- (t (:inverse-video t)))
+ :background "LightYellow" :foreground "lightgray")
+ (t :inverse-video t))
"Face used to visualize SPACE."
:group 'whitespace)
(defface whitespace-hspace ; 'nobreak-space
'((((class color) (background dark))
- (:background "grey24" :foreground "darkgray"))
+ :background "grey24" :foreground "darkgray")
(((class color) (background light))
- (:background "LemonChiffon3" :foreground "lightgray"))
- (t (:inverse-video t)))
+ :background "LemonChiffon3" :foreground "lightgray")
+ (t :inverse-video t))
"Face used to visualize HARD SPACE."
:group 'whitespace)
(defface whitespace-tab
'((((class color) (background dark))
- (:background "grey22" :foreground "darkgray"))
+ :background "grey22" :foreground "darkgray")
(((class color) (background light))
- (:background "beige" :foreground "lightgray"))
- (t (:inverse-video t)))
+ :background "beige" :foreground "lightgray")
+ (t :inverse-video t))
"Face used to visualize TAB."
:group 'whitespace)
(defface whitespace-newline
- '((((class color) (background dark))
- (:foreground "darkgray" :bold nil))
- (((class color) (min-colors 88) (background light))
- (:foreground "lightgray" :bold nil))
+ '((default :weight normal)
+ (((class color) (background dark)) :foreground "darkgray")
+ (((class color) (min-colors 88) (background light)) :foreground "lightgray")
;; Displays with 16 colors use lightgray as background, so using a
;; lightgray foreground makes the newline mark invisible.
- (((class color) (background light))
- (:foreground "brown" :bold nil))
- (t (:underline t :bold nil)))
+ (((class color) (background light)) :foreground "brown")
+ (t :underline t))
"Face used to visualize NEWLINE char mapping.
See `whitespace-display-mappings'."
(defface whitespace-trailing ; 'trailing-whitespace
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "red1" :foreground "yellow" :bold t)))
+ '((default :weight bold)
+ (((class mono)) :inverse-video t :underline t)
+ (t :background "red1" :foreground "yellow"))
"Face used to visualize trailing blanks."
:group 'whitespace)
(defface whitespace-line
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "gray20" :foreground "violet")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "gray20" :foreground "violet"))
"Face used to visualize \"long\" lines.
See `whitespace-line-column'."
(defface whitespace-space-before-tab
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "DarkOrange" :foreground "firebrick")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "DarkOrange" :foreground "firebrick"))
"Face used to visualize SPACEs before TAB."
:group 'whitespace)
(defface whitespace-indentation
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "yellow" :foreground "firebrick")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "yellow" :foreground "firebrick"))
"Face used to visualize 8 or more SPACEs at beginning of line."
:group 'whitespace)
(defface whitespace-empty
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "yellow" :foreground "firebrick")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "yellow" :foreground "firebrick"))
"Face used to visualize empty lines at beginning and/or end of buffer."
:group 'whitespace)
(defface whitespace-space-after-tab
- '((((class mono)) (:inverse-video t :bold t :underline t))
- (t (:background "yellow" :foreground "firebrick")))
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "yellow" :foreground "firebrick"))
"Face used to visualize 8 or more SPACEs after TAB."
:group 'whitespace)
'(
(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
(when (memq 'empty whitespace-style)
(let (overwrite-mode) ; enforce no overwrite
(goto-char (point-min))
- (when (re-search-forward
- (concat "\\`" whitespace-empty-at-bob-regexp) nil t)
+ (when (looking-at whitespace-empty-at-bob-regexp)
(delete-region (match-beginning 1) (match-end 1)))
(when (re-search-forward
(concat whitespace-empty-at-eob-regexp "\\'") nil t)
(require 'easymenu)
(require 'custom)
(require 'wid-edit)
-(eval-when-compile (require 'cl))
(defgroup widget-browse nil
"Customization support for browsing widgets."
(push (widget-convert-button widget-documentation-link-type
begin end :value name)
buttons)))))
- (widget-put widget :buttons buttons)))
- (let ((indent (widget-get widget :indent)))
- (when (and indent (not (zerop indent)))
- (save-excursion
- (save-restriction
- (narrow-to-region from to)
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (insert-char ?\s indent)))))))
+ (widget-put widget :buttons buttons))))
;;; The `documentation-string' Widget.
(start (point)))
(if (string-match "\n" doc)
(let ((before (substring doc 0 (match-beginning 0)))
- (after (substring doc (match-beginning 0)))
- button)
- (when (and indent (not (zerop indent)))
- (insert-char ?\s indent))
+ (after (substring doc (match-end 0)))
+ button end)
+ (widget-documentation-string-indent-to indent)
(insert before ?\s)
(widget-documentation-link-add widget start (point))
(setq button
:action 'widget-parent-action
shown))
(when shown
+ (insert ?\n)
(setq start (point))
(when (and indent (not (zerop indent)))
(insert-char ?\s indent))
(insert after)
- (widget-documentation-link-add widget start (point)))
+ (setq end (point))
+ (widget-documentation-link-add widget start end)
+ ;; Indent the subsequent lines.
+ (when (and indent (> indent 0))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward "\n" nil t)
+ (widget-documentation-string-indent-to indent))))))
(widget-put widget :buttons (list button)))
- (when (and indent (not (zerop indent)))
- (insert-char ?\s indent))
+ (widget-documentation-string-indent-to indent)
(insert doc)
(widget-documentation-link-add widget start (point))))
(insert ?\n))
+(defun widget-documentation-string-indent-to (col)
+ (when (and (numberp col)
+ (> col 0))
+ (let ((opoint (point)))
+ (indent-to col)
+ (put-text-property opoint (point)
+ 'display `(space :align-to ,col)))))
+
(defun widget-documentation-string-action (widget &rest _ignore)
;; Toggle documentation.
(let ((parent (widget-get widget :parent)))
;; Installation:
;;
-;; Put the following line in your `.emacs' file:
+;; Put the following line in your init file:
;;
;; (windmove-default-keybindings) ; shifted arrow keys
;;
;; (setq windmove-window-distance-delta 2)
;;
-;; Acknowledgements:
+;; Acknowledgments:
;;
;; Special thanks to Julian Assange (proff@iq.org), whose
;; change-windows-intuitively.el predates Windmove, and provided the
;;; Code:
-(eval-when-compile (require 'cl))
-
(defmacro save-selected-window (&rest body)
"Execute BODY, then select the previously selected window.
The value returned is the value of the last form in BODY.
are not altered by this macro (unless they are altered in BODY)."
(declare (indent 0) (debug t))
`(let ((save-selected-window-window (selected-window))
- ;; It is necessary to save all of these, because calling
- ;; select-window changes frame-selected-window for whatever
- ;; frame that window is in.
+ ;; We save and restore all frames' selected windows, because
+ ;; `select-window' can change the frame-selected-window of
+ ;; whatever frame that window is in. Each text terminal's
+ ;; top-frame is preserved by putting it last in the list.
(save-selected-window-alist
- (mapcar (lambda (frame) (cons frame (frame-selected-window frame)))
- (frame-list))))
+ (apply 'append
+ (mapcar (lambda (terminal)
+ (let ((frames (frames-on-display-list terminal))
+ (top-frame (tty-top-frame terminal))
+ alist)
+ (if top-frame
+ (setq frames
+ (cons top-frame
+ (delq top-frame frames))))
+ (dolist (f frames)
+ (push (cons f (frame-selected-window f))
+ alist))))
+ (terminal-list)))))
(save-current-buffer
(unwind-protect
(progn ,@body)
(when (window-live-p save-selected-window-window)
(select-window save-selected-window-window 'norecord))))))
+(defvar temp-buffer-window-setup-hook nil
+ "Normal hook run by `with-temp-buffer-window' before buffer display.
+This hook is run by `with-temp-buffer-window' with the buffer to be
+displayed current.")
+
+(defvar temp-buffer-window-show-hook nil
+ "Normal hook run by `with-temp-buffer-window' after buffer display.
+This hook is run by `with-temp-buffer-window' with the buffer
+displayed and current and its window selected.")
+
+(defun temp-buffer-window-setup (buffer-or-name)
+ "Set up temporary buffer specified by BUFFER-OR-NAME.
+Return the buffer."
+ (let ((old-dir default-directory)
+ (buffer (get-buffer-create buffer-or-name)))
+ (with-current-buffer buffer
+ (kill-all-local-variables)
+ (setq default-directory old-dir)
+ (delete-all-overlays)
+ (setq buffer-read-only nil)
+ (setq buffer-file-name nil)
+ (setq buffer-undo-list t)
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (erase-buffer)
+ (run-hooks 'temp-buffer-window-setup-hook))
+ ;; Return the buffer.
+ buffer)))
+
+(defun temp-buffer-window-show (&optional buffer action)
+ "Show temporary buffer BUFFER in a window.
+Return the window showing BUFFER. Pass ACTION as action argument
+to `display-buffer'."
+ (let (window frame)
+ (with-current-buffer buffer
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (goto-char (point-min))
+ (when (let ((window-combination-limit
+ ;; When `window-combination-limit' equals
+ ;; `temp-buffer' or `temp-buffer-resize' and
+ ;; `temp-buffer-resize-mode' is enabled in this
+ ;; buffer bind it to t so resizing steals space
+ ;; preferably from the window that was split.
+ (if (or (eq window-combination-limit 'temp-buffer)
+ (and (eq window-combination-limit
+ 'temp-buffer-resize)
+ temp-buffer-resize-mode))
+ t
+ window-combination-limit)))
+ (setq window (display-buffer buffer action)))
+ (setq frame (window-frame window))
+ (unless (eq frame (selected-frame))
+ (raise-frame frame))
+ (setq minibuffer-scroll-window window)
+ (set-window-hscroll window 0)
+ (with-selected-window window
+ (run-hooks 'temp-buffer-window-show-hook)
+ (when temp-buffer-resize-mode
+ (resize-temp-buffer-window window)))
+ ;; Return the window.
+ window))))
+
+(defmacro with-temp-buffer-window (buffer-or-name action quit-function &rest body)
+ "Evaluate BODY and display buffer specified by BUFFER-OR-NAME.
+BUFFER-OR-NAME must specify either a live buffer or the name of a
+buffer. If no buffer with such a name exists, create one.
+
+Make sure the specified buffer is empty before evaluating BODY.
+Do not make that buffer current for BODY. Instead, bind
+`standard-output' to that buffer, so that output generated with
+`prin1' and similar functions in BODY goes into that buffer.
+
+After evaluating BODY, mark the specified buffer unmodified and
+read-only, and display it in a window via `display-buffer'. Pass
+ACTION as action argument to `display-buffer'. Automatically
+shrink the window used if `temp-buffer-resize-mode' is enabled.
+
+Return the value returned by BODY unless QUIT-FUNCTION specifies
+a function. In that case, run the function with two arguments -
+the window showing the specified buffer and the value returned by
+BODY - and return the value returned by that function.
+
+If the buffer is displayed on a new frame, the window manager may
+decide to select that frame. In that case, it's usually a good
+strategy if the function specified by QUIT-FUNCTION selects the
+window showing the buffer before reading a value from the
+minibuffer, for example, when asking a `yes-or-no-p' question.
+
+This construct is similar to `with-output-to-temp-buffer' but
+does neither put the buffer in help mode nor does it call
+`temp-buffer-show-function'. It also runs different hooks,
+namely `temp-buffer-window-setup-hook' (with the specified buffer
+current) and `temp-buffer-window-show-hook' (with the specified
+buffer current and the window showing it selected).
+
+Since this macro calls `display-buffer', the window displaying
+the buffer is usually not selected and the specified buffer
+usually not made current. QUIT-FUNCTION can override that."
+ (declare (debug t))
+ (let ((buffer (make-symbol "buffer"))
+ (window (make-symbol "window"))
+ (value (make-symbol "value")))
+ `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name))
+ (standard-output ,buffer)
+ ,window ,value)
+ (with-current-buffer ,buffer
+ (setq ,value (progn ,@body))
+ (setq ,window (temp-buffer-window-show ,buffer ,action)))
+
+ (if (functionp ,quit-function)
+ (funcall ,quit-function ,window ,value)
+ ,value))))
+
;; The following two functions are like `window-next-sibling' and
;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
;; they don't substitute the selected window for nil), and they return
(and window (window-parent window) (window-prev-sibling window)))
(defun window-child (window)
- "Return WINDOW's first child window."
+ "Return WINDOW's first child window.
+WINDOW can be any window."
(or (window-top-child window) (window-left-child window)))
(defun window-child-count (window)
- "Return number of WINDOW's child windows."
+ "Return number of WINDOW's child windows.
+WINDOW can be any window."
(let ((count 0))
(when (and (windowp window) (setq window (window-child window)))
(while window
count))
(defun window-last-child (window)
- "Return last child window of WINDOW."
+ "Return last child window of WINDOW.
+WINDOW can be any window."
(when (and (windowp window) (setq window (window-child window)))
(while (window-next-sibling window)
(setq window (window-next-sibling window))))
window)
-(defun window-valid-p (object)
- "Return t if OBJECT denotes a live window or internal window.
-Otherwise, return nil; this includes the case where OBJECT is a
-deleted window."
- (and (windowp object)
- (or (window-buffer object) (window-child object))
- t))
-
(defun window-normalize-buffer (buffer-or-name)
"Return buffer specified by BUFFER-OR-NAME.
BUFFER-OR-NAME must be either a buffer or a string naming a live
(selected-frame)))
(defun window-normalize-window (window &optional live-only)
- "Return window specified by WINDOW.
-If WINDOW is nil, return `selected-window'.
-If WINDOW is a live window or internal window, return WINDOW;
- if LIVE-ONLY is non-nil, return WINDOW for a live window only.
+ "Return the window specified by WINDOW.
+If WINDOW is nil, return the selected window. Otherwise, if
+WINDOW is a live or an internal window, return WINDOW; if
+LIVE-ONLY is non-nil, return WINDOW for a live window only.
Otherwise, signal an error."
- (cond ((null window)
- (selected-window))
- (live-only
- (if (window-live-p window)
- window
- (error "%s is not a live window" window)))
- ((if (window-valid-p window)
- window
- (error "%s is not a window" window)))))
+ (cond
+ ((null window)
+ (selected-window))
+ (live-only
+ (if (window-live-p window)
+ window
+ (error "%s is not a live window" window)))
+ ((window-valid-p window)
+ window)
+ (t
+ (error "%s is not a valid window" window))))
(defvar ignore-window-parameters nil
"If non-nil, standard functions ignore window parameters.
(defun window-combined-p (&optional window horizontal)
"Return non-nil if WINDOW has siblings in a given direction.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
HORIZONTAL determines a direction for the window combination.
If HORIZONTAL is omitted or nil, return non-nil if WINDOW is part
(defun window-combinations (window &optional horizontal)
"Return largest number of windows vertically arranged within WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
If HORIZONTAL is non-nil, return the largest number of
windows horizontally arranged within WINDOW."
(setq window (window-normalize-window window))
(setq walk-window-tree-window
(window-right walk-window-tree-window))))))
-(defun walk-window-tree (fun &optional frame any)
+(defun walk-window-tree (fun &optional frame any minibuf)
"Run function FUN on each live window of FRAME.
FUN must be a function with one argument - a window. FRAME must
be a live frame and defaults to the selected one. ANY, if
-non-nil means to run FUN on all live and internal windows of
+non-nil, means to run FUN on all live and internal windows of
FRAME.
+Optional argument MINIBUF t means run FUN on FRAME's minibuffer
+window even if it isn't active. MINIBUF nil or omitted means run
+FUN on FRAME's minibuffer window only if it's active. In both
+cases the minibuffer window must be part of FRAME. MINIBUF
+neither nil nor t means never run FUN on the minibuffer window.
+
This function performs a pre-order, depth-first traversal of the
window tree. If FUN changes the window tree, the result is
unpredictable."
- (let ((walk-window-tree-frame (window-normalize-frame frame)))
- (walk-window-tree-1
- fun (frame-root-window walk-window-tree-frame) any)))
+ (setq frame (window-normalize-frame frame))
+ (walk-window-tree-1 fun (frame-root-window frame) any)
+ (when (memq minibuf '(nil t))
+ ;; Run FUN on FRAME's minibuffer window if requested.
+ (let ((minibuffer-window (minibuffer-window frame)))
+ (when (and (window-live-p minibuffer-window)
+ (eq (window-frame minibuffer-window) frame)
+ (or (eq minibuf t)
+ (minibuffer-window-active-p minibuffer-window)))
+ (funcall fun minibuffer-window)))))
(defun walk-window-subtree (fun &optional window any)
"Run function FUN on the subtree of windows rooted at WINDOW.
(setq window (window-normalize-window window))
(walk-window-tree-1 fun window any t))
-(defun window-with-parameter (parameter &optional value frame any)
+(defun window-with-parameter (parameter &optional value frame any minibuf)
"Return first window on FRAME with PARAMETER non-nil.
FRAME defaults to the selected frame. Optional argument VALUE
non-nil means only return a window whose window-parameter value
for PARAMETER equals VALUE (comparison is done with `equal').
Optional argument ANY non-nil means consider internal windows
-too."
+too.
+
+Optional argument MINIBUF t means consider FRAME's minibuffer
+window even if it isn't active. MINIBUF nil or omitted means
+consider FRAME's minibuffer window only if it's active. In both
+cases the minibuffer window must be part of FRAME. MINIBUF
+neither nil nor t means never consider the minibuffer window."
(let (this-value)
(catch 'found
(walk-window-tree
(when (and (setq this-value (window-parameter window parameter))
(or (not value) (equal value this-value)))
(throw 'found window)))
- frame any))))
+ frame any minibuf))))
;;; Atomic windows.
(defun window-atom-root (&optional window)
"Return root of atomic window WINDOW is a part of.
-WINDOW can be any window and defaults to the selected one.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW is not part of an atomic window."
(setq window (window-normalize-window window))
(let (root)
window t)
window))
+(defun display-buffer-in-atom-window (buffer alist)
+ "Display BUFFER in an atomic window.
+This function displays BUFFER in a new window that will be
+combined with an existing window to form an atomic window. If
+the existing window is already part of an atomic window, add the
+new window to that atomic window. Operations like `split-window'
+or `delete-window', when applied to a constituent of an atomic
+window, are applied atomically to the root of that atomic window.
+
+ALIST is an association list of symbols and values. The
+following symbols can be used.
+
+`window' specifies the existing window the new window shall be
+ combined with. Use `window-atom-root' to make the new window a
+ sibling of an atomic window's root. If an internal window is
+ specified here, all children of that window become part of the
+ atomic window too. If no window is specified, the new window
+ becomes a sibling of the selected window.
+
+`side' denotes the side of the existing window where the new
+ window shall be located. Valid values are `below', `right',
+ `above' and `left'. The default is `below'.
+
+The return value is the new window, nil when creating that window
+failed."
+ (let ((ignore-window-parameters t)
+ (window-combination-limit t)
+ (window (cdr (assq 'window alist)))
+ (side (cdr (assq 'side alist)))
+ new)
+ (setq window (window-normalize-window window))
+ ;; Split off new window
+ (when (setq new (split-window window nil side))
+ ;; Make sure we have a valid atomic window.
+ (window-make-atom (window-parent window))
+ ;; Display BUFFER in NEW and return NEW.
+ (window--display-buffer
+ buffer new 'window display-buffer-mark-dedicated))))
+
(defun window--atom-check-1 (window)
"Subroutine of `window--atom-check'."
(when window
(integer :tag "Number" :value 3 :size 5)))
:group 'windows)
+(defun window--major-non-side-window (&optional frame)
+ "Return the major non-side window of frame FRAME.
+The optional argument FRAME must be a live frame and defaults to
+the selected one.
+
+If FRAME has at least one side window, the major non-side window
+is either an internal non-side window such that all other
+non-side windows on FRAME descend from it, or the single live
+non-side window of FRAME. If FRAME has no side windows, return
+its root window."
+ (let ((frame (window-normalize-frame frame))
+ major sibling)
+ ;; Set major to the _last_ window found by `walk-window-tree' that
+ ;; is not a side window but has a side window as its sibling.
+ (walk-window-tree
+ (lambda (window)
+ (and (not (window-parameter window 'window-side))
+ (or (and (setq sibling (window-prev-sibling window))
+ (window-parameter sibling 'window-side))
+ (and (setq sibling (window-next-sibling window))
+ (window-parameter sibling 'window-side)))
+ (setq major window)))
+ frame t)
+ (or major (frame-root-window frame))))
+
+(defun window--major-side-window (side)
+ "Return major side window on SIDE.
+SIDE must be one of the symbols `left', `top', `right' or
+`bottom'. Return nil if no such window exists."
+ (let ((root (frame-root-window))
+ window)
+ ;; (1) If a window on the opposite side exists, return that window's
+ ;; sibling.
+ ;; (2) If the new window shall span the entire side, return the
+ ;; frame's root window.
+ ;; (3) If a window on an orthogonal side exists, return that
+ ;; window's sibling.
+ ;; (4) Otherwise return the frame's root window.
+ (cond
+ ((or (and (eq side 'left)
+ (setq window (window-with-parameter 'window-side 'right nil t)))
+ (and (eq side 'top)
+ (setq window (window-with-parameter 'window-side 'bottom nil t))))
+ (window-prev-sibling window))
+ ((or (and (eq side 'right)
+ (setq window (window-with-parameter 'window-side 'left nil t)))
+ (and (eq side 'bottom)
+ (setq window (window-with-parameter 'window-side 'top nil t))))
+ (window-next-sibling window))
+ ((memq side '(left right))
+ (cond
+ (window-sides-vertical
+ root)
+ ((setq window (window-with-parameter 'window-side 'top nil t))
+ (window-next-sibling window))
+ ((setq window (window-with-parameter 'window-side 'bottom nil t))
+ (window-prev-sibling window))
+ (t root)))
+ ((memq side '(top bottom))
+ (cond
+ ((not window-sides-vertical)
+ root)
+ ((setq window (window-with-parameter 'window-side 'left nil t))
+ (window-next-sibling window))
+ ((setq window (window-with-parameter 'window-side 'right nil t))
+ (window-prev-sibling window))
+ (t root))))))
+
+(defun display-buffer-in-major-side-window (buffer side slot &optional alist)
+ "Display BUFFER in a new window on SIDE of the selected frame.
+SIDE must be one of `left', `top', `right' or `bottom'. SLOT
+specifies the slot to use. ALIST is an association list of
+symbols and values as passed to `display-buffer-in-side-window'.
+This function may be called only if no window on SIDE exists yet.
+The new window automatically becomes the \"major\" side window on
+SIDE. Return the new window, nil if its creation window failed."
+ (let* ((root (frame-root-window))
+ (left-or-right (memq side '(left right)))
+ (size (or (assq 'size alist)
+ (/ (window-total-size (frame-root-window) left-or-right)
+ ;; By default use a fourth of the size of the
+ ;; frame's root window. This has to be made
+ ;; customizable via ALIST.
+ 4)))
+ (major (window--major-side-window side))
+ (selected-window (selected-window))
+ (on-side (cond
+ ((eq side 'top) 'above)
+ ((eq side 'bottom) 'below)
+ (t side)))
+ ;; The following two bindings will tell `split-window' to take
+ ;; the space for the new window from `major' and not make a new
+ ;; parent window unless needed.
+ (window-combination-resize 'side)
+ (window-combination-limit nil)
+ (new (split-window major (- size) on-side))
+ fun)
+ (when new
+ ;; Initialize `window-side' parameter of new window to SIDE.
+ (set-window-parameter new 'window-side side)
+ ;; Install `window-slot' parameter of new window.
+ (set-window-parameter new 'window-slot slot)
+ ;; Install `delete-window' parameter thus making sure that when
+ ;; the new window is deleted, a side window on the opposite side
+ ;; does not get resized.
+ (set-window-parameter new 'delete-window 'delete-side-window)
+ ;; Install BUFFER in new window and return NEW.
+ (window--display-buffer buffer new 'window 'side))))
+
+(defun delete-side-window (window)
+ "Delete side window WINDOW."
+ (let ((window-combination-resize
+ (window-parameter (window-parent window) 'window-side))
+ (ignore-window-parameters t))
+ (delete-window window)))
+
+(defun display-buffer-in-side-window (buffer alist)
+ "Display BUFFER in a window on side SIDE of the selected frame.
+ALIST is an association list of symbols and values. The
+following symbols can be used:
+
+`side' denotes the side of the existing window where the new
+ window shall be located. Valid values are `bottom', `right',
+ `top' and `left'. The default is `bottom'.
+
+`slot' if non-nil, specifies the window slot where to display
+ BUFFER. A value of zero or nil means use the middle slot on
+ the specified side. A negative value means use a slot
+ preceding (that is, above or on the left of) the middle slot.
+ A positive value means use a slot following (that is, below or
+ on the right of) the middle slot. The default is zero."
+ (let ((side (or (cdr (assq 'side alist)) 'bottom))
+ (slot (or (cdr (assq 'slot alist)) 0))
+ new)
+ (cond
+ ((not (memq side '(top bottom left right)))
+ (error "Invalid side %s specified" side))
+ ((not (numberp slot))
+ (error "Invalid slot %s specified" slot)))
+
+ (let* ((major (window-with-parameter 'window-side side nil t))
+ ;; `major' is the major window on SIDE, `windows' the list of
+ ;; life windows on SIDE.
+ (windows
+ (when major
+ (let (windows)
+ (walk-window-tree
+ (lambda (window)
+ (when (eq (window-parameter window 'window-side) side)
+ (setq windows (cons window windows)))))
+ (nreverse windows))))
+ (slots (when major (max 1 (window-child-count major))))
+ (max-slots
+ (nth (cond
+ ((eq side 'left) 0)
+ ((eq side 'top) 1)
+ ((eq side 'right) 2)
+ ((eq side 'bottom) 3))
+ window-sides-slots))
+ (selected-window (selected-window))
+ window this-window this-slot prev-window next-window
+ best-window best-slot abs-slot new-window)
+
+ (cond
+ ((and (numberp max-slots) (<= max-slots 0))
+ ;; No side-slots available on this side. Don't create an error,
+ ;; just return nil.
+ nil)
+ ((not windows)
+ ;; No major window exists on this side, make one.
+ (display-buffer-in-major-side-window buffer side slot alist))
+ (t
+ ;; Scan windows on SIDE.
+ (catch 'found
+ (dolist (window windows)
+ (setq this-slot (window-parameter window 'window-slot))
+ (cond
+ ;; The following should not happen and probably be checked
+ ;; by window--side-check.
+ ((not (numberp this-slot)))
+ ((= this-slot slot)
+ ;; A window with a matching slot has been found.
+ (setq this-window window)
+ (throw 'found t))
+ (t
+ ;; Check if this window has a better slot value wrt the
+ ;; slot of the window we want.
+ (setq abs-slot
+ (if (or (and (> this-slot 0) (> slot 0))
+ (and (< this-slot 0) (< slot 0)))
+ (abs (- slot this-slot))
+ (+ (abs slot) (abs this-slot))))
+ (unless (and best-slot (<= best-slot abs-slot))
+ (setq best-window window)
+ (setq best-slot abs-slot))
+ (cond
+ ((<= this-slot slot)
+ (setq prev-window window))
+ ((not next-window)
+ (setq next-window window)))))))
+
+ ;; `this-window' is the first window with the same SLOT.
+ ;; `prev-window' is the window with the largest slot < SLOT. A new
+ ;; window will be created after it.
+ ;; `next-window' is the window with the smallest slot > SLOT. A new
+ ;; window will be created before it.
+ ;; `best-window' is the window with the smallest absolute difference
+ ;; of its slot and SLOT.
+
+ ;; Note: We dedicate the window used softly to its buffer to
+ ;; avoid that "other" (non-side) buffer display functions steal
+ ;; it from us. This must eventually become customizable via
+ ;; ALIST (or, better, avoided in the "other" functions).
+ (or (and this-window
+ ;; Reuse `this-window'.
+ (window--display-buffer buffer this-window 'reuse 'side))
+ (and (or (not max-slots) (< slots max-slots))
+ (or (and next-window
+ ;; Make new window before `next-window'.
+ (let ((next-side
+ (if (memq side '(left right)) 'above 'left))
+ (window-combination-resize 'side))
+ (setq window (split-window next-window nil next-side))
+ ;; When the new window is deleted, its space
+ ;; is returned to other side windows.
+ (set-window-parameter
+ window 'delete-window 'delete-side-window)
+ window))
+ (and prev-window
+ ;; Make new window after `prev-window'.
+ (let ((prev-side
+ (if (memq side '(left right)) 'below 'right))
+ (window-combination-resize 'side))
+ (setq window (split-window prev-window nil prev-side))
+ ;; When the new window is deleted, its space
+ ;; is returned to other side windows.
+ (set-window-parameter
+ window 'delete-window 'delete-side-window)
+ window)))
+ (set-window-parameter window 'window-slot slot)
+ (window--display-buffer buffer window 'window 'side))
+ (and best-window
+ ;; Reuse `best-window'.
+ (progn
+ ;; Give best-window the new slot value.
+ (set-window-parameter best-window 'window-slot slot)
+ (window--display-buffer buffer best-window 'reuse 'side)))))))))
+
(defun window--side-check (&optional frame)
- "Check the window-side parameter of all windows on FRAME.
-FRAME defaults to the selected frame. If the configuration is
-invalid, reset all window-side parameters to nil.
-
-A valid configuration has to preserve the following invariant:
-
-- If a window has a non-nil window-side parameter, it must have a
- parent window and the parent window's window-side parameter
- must be either nil or the same as for window.
-
-- If windows with non-nil window-side parameters exist, there
- must be at most one window of each side and non-side with a
- parent whose window-side parameter is nil and there must be no
- leaf window whose window-side parameter is nil."
- (let (normal none left top right bottom
- side parent parent-side)
+ "Check the side window configuration of FRAME.
+FRAME defaults to the selected frame.
+
+A valid side window configuration preserves the following two
+invariants:
+
+- If there exists a window whose window-side parameter is
+ non-nil, there must exist at least one live window whose
+ window-side parameter is nil.
+
+- If a window W has a non-nil window-side parameter (i) it must
+ have a parent window and that parent's window-side parameter
+ must be either nil or the same as for W, and (ii) any child
+ window of W must have the same window-side parameter as W.
+
+If the configuration is invalid, reset the window-side parameters
+of all windows on FRAME to nil."
+ (let (left top right bottom none side parent parent-side)
(when (or (catch 'reset
(walk-window-tree
(lambda (window)
;; A parent whose window-side is non-nil must
;; have a child with the same window-side.
(throw 'reset t)))
- ;; Now check that there's more than one main window
- ;; for any of none, left, top, right and bottom.
- ((eq side 'none)
- (if none
- (throw 'reset t)
+ ((not side)
+ (when (window-buffer window)
+ ;; Record that we have at least one non-side,
+ ;; live window.
(setq none t)))
+ ((if (memq side '(left top))
+ (window-prev-sibling window)
+ (window-next-sibling window))
+ ;; Left and top major side windows must not have a
+ ;; previous sibling, right and bottom major side
+ ;; windows must not have a next sibling.
+ (throw 'reset t))
+ ;; Now check that there's no more than one major
+ ;; window for any of left, top, right and bottom.
((eq side 'left)
- (if left
- (throw 'reset t)
- (setq left t)))
+ (if left (throw 'reset t) (setq left t)))
((eq side 'top)
- (if top
- (throw 'reset t)
- (setq top t)))
+ (if top (throw 'reset t) (setq top t)))
((eq side 'right)
- (if right
- (throw 'reset t)
- (setq right t)))
+ (if right (throw 'reset t) (setq right t)))
((eq side 'bottom)
- (if bottom
- (throw 'reset t)
- (setq bottom t)))
- ((window-buffer window)
- ;; A leaf window without window-side parameter,
- ;; record its existence.
- (setq normal t))))
+ (if bottom (throw 'reset t) (setq bottom t)))
+ (t
+ (throw 'reset t))))
frame t))
- (if none
- ;; At least one non-side window exists, so there must
- ;; be at least one side-window and no normal window.
- (or (not (or left top right bottom)) normal)
- ;; No non-side window exists, so there must be no side
- ;; window either.
- (or left top right bottom)))
+ ;; If there's a side window, there must be at least one
+ ;; non-side window.
+ (and (or left top right bottom) (not none)))
(walk-window-tree
(lambda (window)
(set-window-parameter window 'window-side nil))
window).")
(make-variable-buffer-local 'window-size-fixed)
-(defun window--size-ignore (window ignore)
+(defun window--size-ignore-p (window ignore)
"Return non-nil if IGNORE says to ignore size restrictions for WINDOW."
(if (window-valid-p ignore) (eq window ignore) ignore))
(defun window-min-size (&optional window horizontal ignore)
"Return the minimum size of WINDOW.
-WINDOW can be an arbitrary window and defaults to the selected
-one. Optional argument HORIZONTAL non-nil means return the
-minimum number of columns of WINDOW; otherwise return the minimum
-number of WINDOW's lines.
+WINDOW must be a valid window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means return the minimum
+number of columns of WINDOW; otherwise return the minimum number
+of WINDOW's lines.
Optional argument IGNORE, if non-nil, means ignore restrictions
imposed by fixed size windows, `window-min-height' or
value)
(with-current-buffer (window-buffer window)
(cond
- ((and (not (window--size-ignore window ignore))
+ ((and (not (window--size-ignore-p window ignore))
(window-size-fixed-p window horizontal))
;; The minimum size of a fixed size window is its size.
(window-total-size window horizontal))
(ceiling (or (frame-parameter frame 'scroll-bar-width) 14)
(frame-char-width)))
(t 0)))
- (if (and (not (window--size-ignore window ignore))
+ (if (and (not (window--size-ignore-p window ignore))
(numberp window-min-width))
window-min-width
0))))
(max (+ window-safe-min-height
(if header-line-format 1 0)
(if mode-line-format 1 0))
- (if (and (not (window--size-ignore window ignore))
+ (if (and (not (window--size-ignore-p window ignore))
(numberp window-min-height))
window-min-height
0))))))))
(defun window-sizable (window delta &optional horizontal ignore)
"Return DELTA if DELTA lines can be added to WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return DELTA if DELTA
columns can be added to WINDOW. A return value of zero means
that no lines (or columns) can be added to WINDOW.
(max (- (window-min-size window horizontal ignore)
(window-total-size window horizontal))
delta))
- ((window--size-ignore window ignore)
+ ((window--size-ignore-p window ignore)
delta)
((> delta 0)
(if (window-size-fixed-p window horizontal)
(defun window-sizable-p (window delta &optional horizontal ignore)
"Return t if WINDOW can be resized by DELTA lines.
+WINDOW must be a valid window and defaults to the selected one.
For the meaning of the arguments of this function see the
doc-string of `window-sizable'."
(setq window (window-normalize-window window))
(defun window-size-fixed-p (&optional window horizontal)
"Return non-nil if WINDOW's height is fixed.
-WINDOW can be an arbitrary window and defaults to the selected
-window. Optional argument HORIZONTAL non-nil means return
-non-nil if WINDOW's width is fixed.
+WINDOW must be a valid window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means return non-nil if
+WINDOW's width is fixed.
If this function returns nil, this does not necessarily mean that
WINDOW can be resized in the desired direction. The function
((eq sub window)
(setq skip (eq trail 'before)))
(skip)
- ((and (not (window--size-ignore window ignore))
+ ((and (not (window--size-ignore-p window ignore))
(window-size-fixed-p sub horizontal)))
(t
;; We found a non-fixed-size child window.
(defun window-min-delta (&optional window horizontal ignore trail noup nodown)
"Return number of lines by which WINDOW can be shrunk.
-WINDOW can be an arbitrary window and defaults to the selected
-window. Return zero if WINDOW cannot be shrunk.
+WINDOW must be a valid window and defaults to the selected one.
+Return zero if WINDOW cannot be shrunk.
Optional argument HORIZONTAL non-nil means return number of
columns by which WINDOW can be shrunk.
;; child window is fixed-size.
(while sub
(when (and (not (eq sub window))
- (not (window--size-ignore sub ignore))
+ (not (window--size-ignore-p sub ignore))
(window-size-fixed-p sub horizontal))
(throw 'fixed delta))
(setq sub (window-right sub))))
(defun window-max-delta (&optional window horizontal ignore trail noup nodown)
"Return maximum number of lines by which WINDOW can be enlarged.
-WINDOW can be an arbitrary window and defaults to the selected
-window. The return value is zero if WINDOW cannot be enlarged.
+WINDOW must be a valid window and defaults to the selected one.
+The return value is zero if WINDOW cannot be enlarged.
Optional argument HORIZONTAL non-nil means return maximum number
of columns by which WINDOW can be enlarged.
WINDOW itself (and its child windows) can be enlarged; check
only whether other windows can be shrunk appropriately."
(setq window (window-normalize-window window))
- (if (and (not (window--size-ignore window ignore))
+ (if (and (not (window--size-ignore-p window ignore))
(not nodown) (window-size-fixed-p window horizontal))
;; With IGNORE and NOWDON nil return zero if WINDOW has fixed
;; size.
;; Make NOUP also inhibit the min-size check.
(defun window--resizable (window delta &optional horizontal ignore trail noup nodown)
"Return DELTA if WINDOW can be resized vertically by DELTA lines.
+WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
can be resized horizontally by DELTA columns. A return value of
zero means that WINDOW is not resizable.
(defun window--resizable-p (window delta &optional horizontal ignore trail noup nodown)
"Return t if WINDOW can be resized vertically by DELTA lines.
+WINDOW must be a valid window and defaults to the selected one.
For the meaning of the arguments of this function see the
doc-string of `window--resizable'."
(setq window (window-normalize-window window))
(defun window-resizable (window delta &optional horizontal ignore)
"Return DELTA if WINDOW can be resized vertically by DELTA lines.
+WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
can be resized horizontally by DELTA columns. A return value of
zero means that WINDOW is not resizable.
(defun window-total-size (&optional window horizontal)
"Return the total height or width of WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
If HORIZONTAL is omitted or nil, return the total height of
WINDOW, in lines, like `window-total-height'. Otherwise return
"Return t if WINDOW is as high as its containing frame.
More precisely, return t if and only if the total height of
WINDOW equals the total height of the root window of WINDOW's
-frame. WINDOW can be any window and defaults to the selected
-one."
+frame. WINDOW must be a valid window and defaults to the
+selected one."
(setq window (window-normalize-window window))
(= (window-total-size window)
(window-total-size (frame-root-window window))))
"Return t if WINDOW is as wide as its containing frame.
More precisely, return t if and only if the total width of WINDOW
equals the total width of the root window of WINDOW's frame.
-WINDOW can be any window and defaults to the selected one."
+WINDOW must be a valid window and defaults to the selected one."
(setq window (window-normalize-window window))
(= (window-total-size window t)
(window-total-size (frame-root-window window) t)))
(defun window-body-size (&optional window horizontal)
"Return the height or width of WINDOW's text area.
-If WINDOW is omitted or nil, it defaults to the selected window.
-Signal an error if the window is not live.
+WINDOW must be a live window and defaults to the selected one.
If HORIZONTAL is omitted or nil, return the height of the text
area, like `window-body-height'. Otherwise, return the width of
(dolist (walk-windows-window (window-list-1 nil minibuf all-frames))
(funcall fun walk-windows-window))))
-(defun window-point-1 (&optional window)
- "Return value of WINDOW's point.
-WINDOW can be any live window and defaults to the selected one.
-
-This function is like `window-point' with one exception: If
-WINDOW is selected, it returns the value of `point' of WINDOW's
-buffer regardless of whether that buffer is current or not."
- (setq window (window-normalize-window window t))
- (if (eq window (selected-window))
- (with-current-buffer (window-buffer window)
- (point))
- (window-point window)))
-
-(defun set-window-point-1 (window pos)
- "Set value of WINDOW's point to POS.
-WINDOW can be any live window and defaults to the selected one.
-
-This function is like `set-window-point' with one exception: If
-WINDOW is selected, it moves `point' of WINDOW's buffer to POS
-regardless of whether that buffer is current or not."
- (setq window (window-normalize-window window t))
- (if (eq window (selected-window))
- (with-current-buffer (window-buffer window)
- (goto-char pos))
- (set-window-point window pos)))
-
(defun window-at-side-p (&optional window side)
"Return t if WINDOW is at SIDE of its containing frame.
-WINDOW can be any window and defaults to the selected one. SIDE
-can be any of the symbols `left', `top', `right' or `bottom'.
-The default value nil is handled like `bottom'."
+WINDOW must be a valid window and defaults to the selected one.
+SIDE can be any of the symbols `left', `top', `right' or
+`bottom'. The default value nil is handled like `bottom'."
(setq window (window-normalize-window window))
(let ((edge
(cond
(lambda (window)
(when (window-at-side-p window side)
(setq windows (cons window windows))))
- frame)
+ frame nil 'nomini)
(nreverse windows)))
(defun window--in-direction-2 (window posn &optional horizontal)
(- left posn)
(- posn left (window-total-width window))))))
+;; Predecessors to the below have been devised by Julian Assange in
+;; change-windows-intuitively.el and Hovav Shacham in windmove.el.
+;; Neither of these allow to selectively ignore specific windows
+;; (windows whose `no-other-window' parameter is non-nil) as targets of
+;; the movement.
(defun window-in-direction (direction &optional window ignore)
"Return window in DIRECTION as seen from WINDOW.
+More precisely, return the nearest window in direction DIRECTION
+as seen from the position of `window-point' in window WINDOW.
DIRECTION must be one of `above', `below', `left' or `right'.
WINDOW must be a live window and defaults to the selected one.
-IGNORE non-nil means a window can be returned even if its
-`no-other-window' parameter is non-nil."
+
+Do not return a window whose `no-other-window' parameter is
+non-nil. If the nearest window's `no-other-window' parameter is
+non-nil, try to find another window in the indicated direction.
+If, however, the optional argument IGNORE is non-nil, return that
+window even if its `no-other-window' parameter is non-nil.
+
+Return nil if no suitable window can be found."
(setq window (window-normalize-window window t))
(unless (memq direction '(above below left right))
(error "Wrong direction %s" direction))
(last (+ first (if hor
(window-total-width window)
(window-total-height window))))
- (posn-cons (nth 6 (posn-at-point (window-point-1 window) window)))
+ (posn-cons (nth 6 (posn-at-point (window-point window) window)))
;; The column / row value of `posn-at-point' can be nil for the
;; mini-window, guard against that.
(posn (if hor
(setq best-edge-2 w-top)
(setq best-diff-2 best-diff-2-new)
(setq best-2 w)))))))
- (window-frame window))
+ frame)
(or best best-2)))
(defun get-window-with-predicate (predicate &optional minibuf all-frames default)
(defalias 'some-window 'get-window-with-predicate)
-(defun get-lru-window (&optional all-frames dedicated)
+(defun get-lru-window (&optional all-frames dedicated not-selected)
"Return the least recently used window on frames specified by ALL-FRAMES.
Return a full-width window if possible. A minibuffer window is
never a candidate. A dedicated window is never a candidate
unless DEDICATED is non-nil, so if all windows are dedicated, the
value is nil. Avoid returning the selected window if possible.
+Optional argument NOT-SELECTED non-nil means never return the
+selected window.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
selected frame and no others."
(let (best-window best-time second-best-window second-best-time time)
(dolist (window (window-list-1 nil 'nomini all-frames))
- (when (or dedicated (not (window-dedicated-p window)))
+ (when (and (or dedicated (not (window-dedicated-p window)))
+ (or (not not-selected) (not (eq window (selected-window)))))
(setq time (window-use-time window))
(if (or (eq window (selected-window))
(not (window-full-width-p window)))
(setq best-window window)))))
(or best-window second-best-window)))
-(defun get-mru-window (&optional all-frames)
+(defun get-mru-window (&optional all-frames dedicated not-selected)
"Return the most recently used window on frames specified by ALL-FRAMES.
-Do not return a minibuffer window.
+A minibuffer window is never a candidate. A dedicated window is
+never a candidate unless DEDICATED is non-nil, so if all windows
+are dedicated, the value is nil. Optional argument NOT-SELECTED
+non-nil means never return the selected window.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
(let (best-window best-time time)
(dolist (window (window-list-1 nil 'nomini all-frames))
(setq time (window-use-time window))
- (when (or (not best-time) (> time best-time))
+ (when (and (or dedicated (not (window-dedicated-p window)))
+ (or (not not-selected) (not (eq window (selected-window))))
+ (or (not best-time) (> time best-time)))
(setq best-time time)
(setq best-window window)))
best-window))
-(defun get-largest-window (&optional all-frames dedicated)
+(defun get-largest-window (&optional all-frames dedicated not-selected)
"Return the largest window on frames specified by ALL-FRAMES.
A minibuffer window is never a candidate. A dedicated window is
never a candidate unless DEDICATED is non-nil, so if all windows
-are dedicated, the value is nil.
+are dedicated, the value is nil. Optional argument NOT-SELECTED
+non-nil means never return the selected window.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
(let ((best-size 0)
best-window size)
(dolist (window (window-list-1 nil 'nomini all-frames))
- (when (or dedicated (not (window-dedicated-p window)))
+ (when (and (or dedicated (not (window-dedicated-p window)))
+ (or (not not-selected) (not (eq window (selected-window)))))
(setq size (* (window-total-size window)
(window-total-size window t)))
(when (> size best-size)
(cond
((eq window (frame-root-window frame))
(error "Cannot resize the root window of a frame"))
- ((window-minibuffer-p window)
+ ((window-minibuffer-p window)
(if horizontal
(error "Cannot resize minibuffer window horizontally")
(window--resize-mini-window window delta)))
Return the symbol `normalized' if new normal sizes have been
already set by this routine."
(let* ((first (window-child parent))
- (sub first)
+ (last (window-last-child parent))
(parent-total (+ (window-total-size parent horizontal) delta))
- best-window best-value)
+ sub best-window best-value)
(if (and edge (memq trail '(before after))
(progn
;; normal sizes have been already set.
'normalized)
;; Resize all windows proportionally.
- (setq sub first)
+ (setq sub last)
(while sub
(cond
((or (window--resize-child-windows-skip-p sub)
parent-total)
(window-normal-size sub horizontal)))))
- (setq sub (window-right sub)))
+ (setq sub (window-left sub)))
(cond
((< delta 0)
;; Shrink windows by delta.
(setq best-window t)
(while (and best-window (not (zerop delta)))
- (setq sub first)
+ (setq sub last)
(setq best-window nil)
(setq best-value most-negative-fixnum)
(while sub
(setq best-window sub)
(setq best-value (cdr (window-new-normal sub))))
- (setq sub (window-right sub)))
+ (setq sub (window-left sub)))
(when best-window
(setq delta (1+ delta)))
;; Enlarge windows by delta.
(setq best-window t)
(while (and best-window (not (zerop delta)))
- (setq sub first)
+ (setq sub last)
(setq best-window nil)
(setq best-value most-positive-fixnum)
(while sub
(setq best-window sub)
(setq best-value (window-new-normal sub)))
- (setq sub (window-right sub)))
+ (setq sub (window-left sub)))
(when best-window
(setq delta (1- delta)))
(window-normal-size best-window horizontal))))))
(when best-window
- (setq sub first)
+ (setq sub last)
(while sub
(when (or (consp (window-new-normal sub))
(numberp (window-new-normal sub)))
;; recursively even if it's size does not change.
(window--resize-this-window
sub delta horizontal ignore nil trail edge))))
- (setq sub (window-right sub)))))))
+ (setq sub (window-left sub)))))))
(defun window--resize-siblings (window delta &optional horizontal ignore trail edge)
"Resize other windows when WINDOW is resized vertically by DELTA lines.
;; Make sure this sibling is left alone when
;; resizing its siblings.
(set-window-new-normal sub 'ignore))
- ((or (window--size-ignore sub ignore)
+ ((or (window--size-ignore-p sub ignore)
(not (window-size-fixed-p sub horizontal)))
;; Set this-delta to t to signal that we found a sibling
;; of WINDOW whose size is not fixed.
This function is only called by the minibuffer window resizing
routines. It resizes windows proportionally and never deletes
any windows."
- (when (numberp delta)
- (let (ignore)
- (cond
- ((< delta 0)
- (setq delta (window-sizable window delta)))
- ((> delta 0)
- (unless (window-sizable window delta)
- (setq ignore t))))
-
- (window--resize-reset (window-frame window))
- ;; Ideally, we would resize just the last window in a combination
- ;; but that's not feasible for the following reason: If we grow
- ;; the minibuffer window and the last window cannot be shrunk any
- ;; more, we shrink another window instead. But if we then shrink
- ;; the minibuffer window again, the last window might get enlarged
- ;; and the state after shrinking is not the state before growing.
- ;; So, in practice, we'd need a history variable to record how to
- ;; proceed. But I'm not sure how such a variable could work with
- ;; repeated minibuffer window growing steps.
- (window--resize-this-window window delta nil ignore t)
- delta)))
+ (let ((frame (window-frame window))
+ ignore)
+ (cond
+ ((not (numberp delta))
+ (setq delta 0))
+ ((zerop delta))
+ ((< delta 0)
+ (setq delta (window-sizable window delta))
+ (window--resize-reset frame)
+ ;; When shrinking the root window, emulate an edge drag in order
+ ;; to not resize other windows if we can avoid it (Bug#12419).
+ (window--resize-this-window
+ window delta nil ignore t 'before
+ (+ (window-top-line window) (window-total-size window)))
+ ;; Don't record new normal sizes to make sure that shrinking back
+ ;; proportionally works as intended.
+ (walk-window-tree
+ (lambda (window) (set-window-new-normal window 'ignore)) frame t))
+ ((> delta 0)
+ (window--resize-reset frame)
+ (unless (window-sizable window delta)
+ (setq ignore t))
+ ;; When growing the root window, resize proportionally. This
+ ;; should give windows back their original sizes (hopefully).
+ (window--resize-this-window window delta nil ignore t)))
+ ;; Return the possibly adjusted DELTA.
+ delta))
(defun adjust-window-trailing-edge (window delta &optional horizontal)
"Move WINDOW's bottom edge by DELTA lines.
Optional argument HORIZONTAL non-nil means move WINDOW's right
-edge by DELTA columns. WINDOW defaults to the selected window.
+edge by DELTA columns. WINDOW must be a valid window and
+defaults to the selected one.
If DELTA is greater than zero, move the edge downwards or to the
right. If DELTA is less than zero, move the edge upwards or to
(defun maximize-window (&optional window)
"Maximize WINDOW.
Make WINDOW as large as possible without deleting any windows.
-WINDOW can be any window and defaults to the selected window."
+WINDOW must be a valid window and defaults to the selected one."
(interactive)
(setq window (window-normalize-window window))
(window-resize window (window-max-delta window))
(defun minimize-window (&optional window)
"Minimize WINDOW.
Make WINDOW as small as possible without deleting any windows.
-WINDOW can be any window and defaults to the selected window."
+WINDOW must be a valid window and defaults to the selected one."
(interactive)
(setq window (window-normalize-window window))
(window-resize window (- (window-min-delta window)))
;;; Deleting windows.
(defun window-deletable-p (&optional window)
"Return t if WINDOW can be safely deleted from its frame.
-Return `frame' if deleting WINDOW should also delete its
-frame."
+WINDOW must be a valid window and defaults to the selected one.
+Return `frame' if deleting WINDOW should also delete its frame."
(setq window (window-normalize-window window))
(unless ignore-window-parameters
(when (window-parameter window 'window-atom)
(setq window (window-atom-root window))))
- (let ((parent (window-parent window))
- (frame (window-frame window)))
+ (let ((frame (window-frame window)))
(cond
((frame-root-window-p window)
;; WINDOW's frame can be deleted only if there are other frames
- ;; on the same terminal.
- (unless (eq frame (next-frame frame 0))
+ ;; on the same terminal, and it does not contain the active
+ ;; minibuffer.
+ (unless (or (eq frame (next-frame frame 0))
+ (let ((minibuf (active-minibuffer-window)))
+ (and minibuf (eq frame (window-frame minibuf)))))
'frame))
((or ignore-window-parameters
- (not (eq (window-parameter window 'window-side) 'none))
- (and parent (eq (window-parameter parent 'window-side) 'none)))
- ;; WINDOW can be deleted unless it is the main window of its
- ;; frame.
+ (not (eq window (window--major-non-side-window frame))))
+ ;; WINDOW can be deleted unless it is the major non-side window of
+ ;; its frame.
t))))
(defun window--in-subtree-p (window root)
(defun delete-window (&optional window)
"Delete WINDOW.
-WINDOW can be an arbitrary window and defaults to the selected
-one. Return nil.
+WINDOW must be a valid window and defaults to the selected one.
+Return nil.
If the variable `ignore-window-parameters' is non-nil or the
`delete-window' parameter of WINDOW equals t, do not process any
Otherwise, if WINDOW is part of an atomic window, call
`delete-window' with the root of the atomic window as its
-argument. If WINDOW is the only window on its frame or the last
-non-side window, signal an error."
+argument. Signal an error if WINDOW is either the only window on
+its frame, the last non-side window, or part of an atomic window
+that is its frame's root window."
(interactive)
(setq window (window-normalize-window window))
(let* ((frame (window-frame window))
((and (window-parameter window 'window-atom)
(setq atom-root (window-atom-root window))
(not (eq atom-root window)))
- (throw 'done (delete-window atom-root)))
- ((and (eq (window-parameter window 'window-side) 'none)
- (or (not parent)
- (not (eq (window-parameter parent 'window-side) 'none))))
- (error "Attempt to delete last non-side window"))
+ (if (eq atom-root (frame-root-window frame))
+ (error "Root of atomic window is root window of its frame")
+ (throw 'done (delete-window atom-root))))
((not parent)
- (error "Attempt to delete minibuffer or sole ordinary window")))
+ (error "Attempt to delete minibuffer or sole ordinary window"))
+ ((eq window (window--major-non-side-window frame))
+ (error "Attempt to delete last non-side window")))
(let* ((horizontal (window-left-child parent))
(size (window-total-size window horizontal))
(defun delete-other-windows (&optional window)
"Make WINDOW fill its frame.
-WINDOW may be any window and defaults to the selected one.
+WINDOW must be a valid window and defaults to the selected one.
Return nil.
If the variable `ignore-window-parameters' is non-nil or the
((and (window-parameter window 'window-atom)
(setq atom-root (window-atom-root window))
(not (eq atom-root window)))
- (throw 'done (delete-other-windows atom-root)))
- ((eq window-side 'none)
- ;; Set side-main to the major non-side window.
- (setq side-main (window-with-parameter 'window-side 'none frame t)))
+ (if (eq atom-root (frame-root-window frame))
+ (error "Root of atomic window is root window of its frame")
+ (throw 'done (delete-other-windows atom-root))))
((memq window-side window-sides)
- (error "Cannot make side window the only window")))
- ;; If WINDOW is the main non-side window, do nothing.
+ (error "Cannot make side window the only window"))
+ ((and (window-minibuffer-p window)
+ (not (eq window (frame-root-window window))))
+ (error "Can't expand minibuffer to full frame")))
+
+ ;; If WINDOW is the major non-side window, do nothing.
+ (if (window-with-parameter 'window-side)
+ (setq side-main (window--major-non-side-window frame))
+ (setq side-main (frame-root-window frame)))
(unless (eq window side-main)
(delete-other-windows-internal window side-main)
(run-window-configuration-change-hook frame)
(while (not (eq (setq w (next-window w 1)) window))
(let ((e (window-edges w)))
(when (and (= (car e) (car edges))
- (= (caddr e) (caddr edges)))
+ (= (nth 2 e) (nth 2 edges)))
(push w delenda))))
(mapc 'delete-window delenda)))
;; Add an entry for buffer to WINDOW's previous buffers.
(with-current-buffer buffer
(let ((start (window-start window))
- (point (window-point-1 window)))
+ (point (window-point window)))
(setq entry
(cons buffer
(if entry
(defun set-window-buffer-start-and-point (window buffer &optional start point)
"Set WINDOW's buffer to BUFFER.
+WINDOW must be a live window and defaults to the selected one.
Optional argument START non-nil means set WINDOW's start position
to START. Optional argument POINT non-nil means set WINDOW's
point to POINT. If WINDOW is selected this also sets BUFFER's
`point' to POINT. If WINDOW is selected and the buffer it showed
before was current this also makes BUFFER the current buffer."
+ (setq window (window-normalize-window window t))
(let ((selected (eq window (selected-window)))
(current (eq (window-buffer window) (current-buffer))))
(set-window-buffer window buffer)
;; Don't force window-start here (even if POINT is nil).
(set-window-start window start t))
(when point
- (set-window-point-1 window point))))
+ (set-window-point window point))))
(defcustom switch-to-visible-buffer t
"If non-nil, allow switching to an already visible buffer.
(defun switch-to-prev-buffer (&optional window bury-or-kill)
"In WINDOW switch to previous buffer.
WINDOW must be a live window and defaults to the selected one.
+Return the buffer switched to, nil if no suitable buffer could be
+found.
Optional argument BURY-OR-KILL non-nil means the buffer currently
shown in WINDOW is about to be buried or killed and consequently
-shall not be switched to in future invocations of this command."
+shall not be switched to in future invocations of this command.
+
+As a special case, if BURY-OR-KILL equals `append', this means to
+move the buffer to the end of WINDOW's previous buffers list so a
+future invocation of `switch-to-prev-buffer' less likely switches
+to it."
(interactive)
(let* ((window (window-normalize-window window t))
(frame (window-frame window))
(old-buffer (window-buffer window))
;; Save this since it's destroyed by `set-window-buffer'.
(next-buffers (window-next-buffers window))
+ (pred (frame-parameter frame 'buffer-predicate))
entry new-buffer killed-buffers visible)
+ (when (window-minibuffer-p window)
+ ;; Don't switch in minibuffer window.
+ (unless (setq window (minibuffer-selected-window))
+ (error "Window %s is a minibuffer window" window)))
+
(when (window-dedicated-p window)
+ ;; Don't switch in dedicated window.
(error "Window %s is dedicated to buffer %s" window old-buffer))
(catch 'found
(not (setq killed-buffers
(cons new-buffer killed-buffers))))
(not (eq new-buffer old-buffer))
- (or bury-or-kill
- (not (memq new-buffer next-buffers))))
+ (or (null pred) (funcall pred new-buffer))
+ ;; When BURY-OR-KILL is nil, avoid switching to a
+ ;; buffer in WINDOW's next buffers list.
+ (or bury-or-kill (not (memq new-buffer next-buffers))))
(if (and (not switch-to-visible-buffer)
(get-buffer-window new-buffer frame))
- ;; Try to avoid showing a buffer visible in some other window.
+ ;; Try to avoid showing a buffer visible in some other
+ ;; window.
(setq visible new-buffer)
- (set-window-buffer-start-and-point
- window new-buffer (nth 1 entry) (nth 2 entry))
- (throw 'found t))))
+ (set-window-buffer-start-and-point
+ window new-buffer (nth 1 entry) (nth 2 entry))
+ (throw 'found t))))
;; Scan reverted buffer list of WINDOW's frame next, skipping
;; entries of next buffers. Note that when we bury or kill a
;; buffer we don't reverse the global buffer list to avoid showing
(nreverse (buffer-list frame))))
(when (and (buffer-live-p buffer)
(not (eq buffer old-buffer))
+ (or (null pred) (funcall pred buffer))
(not (eq (aref (buffer-name buffer) 0) ?\s))
(or bury-or-kill (not (memq buffer next-buffers))))
(if (get-buffer-window buffer frame)
(not (setq killed-buffers
(cons buffer killed-buffers))))
(not (eq buffer old-buffer))
+ (or (null pred) (funcall pred buffer))
(setq entry (assq buffer (window-prev-buffers window))))
(setq new-buffer buffer)
(set-window-buffer-start-and-point
(set-window-buffer-start-and-point window new-buffer)))
(if bury-or-kill
- ;; Remove `old-buffer' from WINDOW's previous and (restored list
- ;; of) next buffers.
- (progn
+ (let ((entry (and (eq bury-or-kill 'append)
+ (assq old-buffer (window-prev-buffers window)))))
+ ;; Remove `old-buffer' from WINDOW's previous and (restored list
+ ;; of) next buffers.
(set-window-prev-buffers
window (assq-delete-all old-buffer (window-prev-buffers window)))
- (set-window-next-buffers window (delq old-buffer next-buffers)))
+ (set-window-next-buffers window (delq old-buffer next-buffers))
+ (when entry
+ ;; Append old-buffer's entry to list of WINDOW's previous
+ ;; buffers so it's less likely to get switched to soon but
+ ;; `display-buffer-in-previous-window' can nevertheless find
+ ;; it.
+ (set-window-prev-buffers
+ window (append (window-prev-buffers window) (list entry)))))
;; Move `old-buffer' to head of WINDOW's restored list of next
;; buffers.
(set-window-next-buffers
(defun switch-to-next-buffer (&optional window)
"In WINDOW switch to next buffer.
-WINDOW must be a live window and defaults to the selected one."
+WINDOW must be a live window and defaults to the selected one.
+Return the buffer switched to, nil if no suitable buffer could be
+found."
(interactive)
(let* ((window (window-normalize-window window t))
(frame (window-frame window))
(old-buffer (window-buffer window))
(next-buffers (window-next-buffers window))
+ (pred (frame-parameter frame 'buffer-predicate))
new-buffer entry killed-buffers visible)
+ (when (window-minibuffer-p window)
+ ;; Don't switch in minibuffer window.
+ (unless (setq window (minibuffer-selected-window))
+ (error "Window %s is a minibuffer window" window)))
+
(when (window-dedicated-p window)
+ ;; Don't switch in dedicated window.
(error "Window %s is dedicated to buffer %s" window old-buffer))
(catch 'found
(not (setq killed-buffers
(cons buffer killed-buffers))))
(not (eq buffer old-buffer))
+ (or (null pred) (funcall pred buffer))
(setq entry (assq buffer (window-prev-buffers window))))
(setq new-buffer buffer)
(set-window-buffer-start-and-point
;; Scan the buffer list of WINDOW's frame next, skipping previous
;; buffers entries.
(dolist (buffer (buffer-list frame))
- (when (and (buffer-live-p buffer) (not (eq buffer old-buffer))
+ (when (and (buffer-live-p buffer)
+ (not (eq buffer old-buffer))
+ (or (null pred) (funcall pred buffer))
(not (eq (aref (buffer-name buffer) 0) ?\s))
(not (assq buffer (window-prev-buffers window))))
(if (get-buffer-window buffer frame)
(or (buffer-live-p new-buffer)
(not (setq killed-buffers
(cons new-buffer killed-buffers))))
- (not (eq new-buffer old-buffer)))
+ (not (eq new-buffer old-buffer))
+ (or (null pred) (funcall pred new-buffer)))
(if (and (not switch-to-visible-buffer)
(get-buffer-window new-buffer frame))
;; Try to avoid showing a buffer visible in some other window.
(defun next-buffer ()
"In selected window switch to next buffer."
(interactive)
- (if (window-minibuffer-p)
- (error "Cannot switch buffers in minibuffer window"))
- (switch-to-next-buffer))
+ (cond
+ ((window-minibuffer-p)
+ (error "Cannot switch buffers in minibuffer window"))
+ ((eq (window-dedicated-p) t)
+ (error "Window is strongly dedicated to its buffer"))
+ (t
+ (switch-to-next-buffer))))
(defun previous-buffer ()
"In selected window switch to previous buffer."
(interactive)
- (if (window-minibuffer-p)
- (error "Cannot switch buffers in minibuffer window"))
- (switch-to-prev-buffer))
+ (cond
+ ((window-minibuffer-p)
+ (error "Cannot switch buffers in minibuffer window"))
+ ((eq (window-dedicated-p) t)
+ (error "Window is strongly dedicated to its buffer"))
+ (t
+ (switch-to-prev-buffer))))
(defun delete-windows-on (&optional buffer-or-name frame)
"Delete all windows showing BUFFER-OR-NAME.
;; Unrecord BUFFER in WINDOW.
(unrecord-window-buffer window buffer)))))
-(defun quit-window (&optional kill window)
- "Quit WINDOW and bury its buffer.
+(defun quit-restore-window (&optional window bury-or-kill)
+ "Quit WINDOW and deal with its buffer.
WINDOW must be a live window and defaults to the selected one.
-With prefix argument KILL non-nil, kill the buffer instead of
-burying it.
According to information stored in WINDOW's `quit-restore' window
parameter either (1) delete WINDOW and its frame, (2) delete
WINDOW, (3) restore the buffer previously displayed in WINDOW,
or (4) make WINDOW display some other buffer than the present
-one. If non-nil, reset `quit-restore' parameter to nil."
- (interactive "P")
+one. If non-nil, reset `quit-restore' parameter to nil.
+
+Optional second argument BURY-OR-KILL tells how to proceed with
+the buffer of WINDOW. The following values are handled:
+
+`nil' means to not handle the buffer in a particular way. This
+ means that if WINDOW is not deleted by this function, invoking
+ `switch-to-prev-buffer' will usually show the buffer again.
+
+`append' means that if WINDOW is not deleted, move its buffer to
+ the end of WINDOW's previous buffers so it's less likely that a
+ future invocation of `switch-to-prev-buffer' will switch to it.
+ Also, move the buffer to the end of the frame's buffer list.
+
+`bury' means that if WINDOW is not deleted, remove its buffer
+ from WINDOW'S list of previous buffers. Also, move the buffer
+ to the end of the frame's buffer list. This value provides the
+ most reliable remedy to not have `switch-to-prev-buffer' switch
+ to this buffer again without killing the buffer.
+
+`kill' means to kill WINDOW's buffer."
(setq window (window-normalize-window window t))
(let* ((buffer (window-buffer window))
(quit-restore (window-parameter window 'quit-restore))
(not (eq (setq prev-buffer (cadr prev-buffers))
buffer))))
prev-buffer)))
- quad resize)
+ quad entry)
(cond
((and (not prev-buffer)
(memq (nth 1 quit-restore) '(window frame))
(eq (nth 3 quit-restore) buffer)
;; Delete WINDOW if possible.
- (window--delete window nil kill))
+ (window--delete window nil (eq bury-or-kill 'kill)))
;; If the previously selected window is still alive, select it.
(when (window-live-p (nth 2 quit-restore))
(select-window (nth 2 quit-restore))))
(buffer-live-p (car quad))
(eq (nth 3 quit-restore) buffer))
;; Show another buffer stored in quit-restore parameter.
- (setq resize (with-current-buffer buffer
- (and temp-buffer-resize-mode
- (/= (nth 3 quad) (window-total-size window)))))
- (set-window-dedicated-p window nil)
- (when resize
+ (when (and (integerp (nth 3 quad))
+ (/= (nth 3 quad) (window-total-size window)))
;; Try to resize WINDOW to its old height but don't signal an
;; error.
(condition-case nil
(window-resize window (- (nth 3 quad) (window-total-size window)))
(error nil)))
+ (set-window-dedicated-p window nil)
;; Restore WINDOW's previous buffer, start and point position.
(set-window-buffer-start-and-point
window (nth 0 quad) (nth 1 quad) (nth 2 quad))
- ;; Unrecord WINDOW's buffer here (Bug#9937) to make sure it's not
- ;; re-recorded by `set-window-buffer'.
- (unrecord-window-buffer window buffer)
+ ;; Deal with the buffer we just removed from WINDOW.
+ (setq entry (and (eq bury-or-kill 'append)
+ (assq buffer (window-prev-buffers window))))
+ (when bury-or-kill
+ ;; Remove buffer from WINDOW's previous and next buffers.
+ (set-window-prev-buffers
+ window (assq-delete-all buffer (window-prev-buffers window)))
+ (set-window-next-buffers
+ window (delq buffer (window-next-buffers window))))
+ (when entry
+ ;; Append old buffer's entry to list of WINDOW's previous
+ ;; buffers so it's less likely to get switched to soon but
+ ;; `display-buffer-in-previous-window' can nevertheless find it.
+ (set-window-prev-buffers
+ window (append (window-prev-buffers window) (list entry))))
;; Reset the quit-restore parameter.
(set-window-parameter window 'quit-restore nil)
;; Select old window.
(set-window-parameter window 'quit-restore nil)
;; Make sure that WINDOW is no more dedicated.
(set-window-dedicated-p window nil)
- (switch-to-prev-buffer window 'bury-or-kill)))
+ (switch-to-prev-buffer window bury-or-kill)))
+
+ ;; Deal with the buffer.
+ (cond
+ ((not (buffer-live-p buffer)))
+ ((eq bury-or-kill 'kill)
+ (kill-buffer buffer))
+ (bury-or-kill
+ (bury-buffer-internal buffer)))))
+
+(defun quit-window (&optional kill window)
+ "Quit WINDOW and bury its buffer.
+WINDOW must be a live window and defaults to the selected one.
+With prefix argument KILL non-nil, kill the buffer instead of
+burying it.
- ;; Kill WINDOW's old-buffer if requested
- (if kill
- (kill-buffer buffer)
- (bury-buffer-internal buffer))))
+According to information stored in WINDOW's `quit-restore' window
+parameter either (1) delete WINDOW and its frame, (2) delete
+WINDOW, (3) restore the buffer previously displayed in WINDOW,
+or (4) make WINDOW display some other buffer than the present
+one. If non-nil, reset `quit-restore' parameter to nil."
+ (interactive "P")
+ (quit-restore-window window (if kill 'kill 'bury)))
(defun quit-windows-on (&optional buffer-or-name kill frame)
"Quit all windows showing BUFFER-OR-NAME.
(defun split-window (&optional window size side)
"Make a new window adjacent to WINDOW.
-WINDOW can be any window and defaults to the selected one.
+WINDOW must be a valid window and defaults to the selected one.
Return the new window which is always a live window.
Optional argument SIZE a positive number means make WINDOW SIZE
((not side) 'below)
((memq side '(below above right left)) side)
(t 'right)))
- (horizontal (not (memq side '(nil below above))))
+ (horizontal (not (memq side '(below above))))
(frame (window-frame window))
(parent (window-parent window))
(function (window-parameter window 'split-window))
(window-side (window-parameter window 'window-side))
- ;; Rebind `window-combination-limit' since in some cases we may
- ;; have to override its value.
+ ;; Rebind the following two variables since in some cases we
+ ;; have to override their value.
(window-combination-limit window-combination-limit)
+ (window-combination-resize window-combination-resize)
atom-root)
(window--check frame)
((and (window-parameter window 'window-atom)
(setq atom-root (window-atom-root window))
(not (eq atom-root window)))
- (throw 'done (split-window atom-root size side))))
-
- (when (and window-side
- (or (not parent)
- (not (window-parameter parent 'window-side))))
- ;; WINDOW is a side root window. To make sure that a new parent
- ;; window gets created set `window-combination-limit' to t.
- (setq window-combination-limit t))
-
- (when (and window-combination-resize size (> size 0))
- ;; If `window-combination-resize' is non-nil and SIZE is a
- ;; non-negative integer, we cannot reasonably resize other
- ;; windows. Rather bind `window-combination-limit' to t to make
- ;; sure that subsequent window deletions are handled correctly.
+ (throw 'done (split-window atom-root size side)))
+ ;; If WINDOW is a side window or its first or last child is a
+ ;; side window, throw an error unless `window-combination-resize'
+ ;; equals 'side.
+ ((and (not (eq window-combination-resize 'side))
+ (or (window-parameter window 'window-side)
+ (and (window-child window)
+ (or (window-parameter
+ (window-child window) 'window-side)
+ (window-parameter
+ (window-last-child window) 'window-side)))))
+ (error "Cannot split side window or parent of side window"))
+ ;; If `window-combination-resize' is 'side and window has a side
+ ;; window sibling, bind `window-combination-limit' to t.
+ ((and (not (eq window-combination-resize 'side))
+ (or (and (window-prev-sibling window)
+ (window-parameter
+ (window-prev-sibling window) 'window-side))
+ (and (window-next-sibling window)
+ (window-parameter
+ (window-next-sibling window) 'window-side))))
+ (setq window-combination-limit t)))
+
+ ;; If `window-combination-resize' is t and SIZE is non-negative,
+ ;; bind `window-combination-limit' to t.
+ (when (and (eq window-combination-resize t) size (> size 0))
(setq window-combination-limit t))
(let* ((parent-size
;; `resize' non-nil means we are supposed to resize other
;; windows in WINDOW's combination.
(resize
- (and window-combination-resize (not window-combination-limit)
+ (and window-combination-resize
+ (or (window-parameter window 'window-side)
+ (not (eq window-combination-resize 'side)))
+ (not (eq window-combination-limit t))
;; Resize makes sense in iso-combinations only.
(window-combined-p window horizontal)))
;; `old-size' is the current size of WINDOW.
;; Make new-parent non-nil if we need a new parent window;
;; either because we want to nest or because WINDOW is not
;; iso-combined.
- (or window-combination-limit
+ (or (eq window-combination-limit t)
(not (window-combined-p window horizontal))))
(setq new-normal
;; Make new-normal the normal size of the new window.
new-normal)))
(let* ((new (split-window-internal window new-size side new-normal)))
- ;; Inherit window-side parameters, if any.
- (when (and window-side new-parent)
- (set-window-parameter (window-parent new) 'window-side window-side)
- (set-window-parameter new 'window-side window-side))
+ ;; Assign window-side parameters, if any.
+ (when (eq window-combination-resize 'side)
+ (let ((window-side
+ (cond
+ (window-side window-side)
+ ((eq side 'above) 'top)
+ ((eq side 'below) 'bottom)
+ (t side))))
+ ;; We made a new side window.
+ (set-window-parameter new 'window-side window-side)
+ (when (and new-parent (window-parameter window 'window-side))
+ ;; We've been splitting a side root window. Give the
+ ;; new parent the same window-side parameter.
+ (set-window-parameter
+ (window-parent new) 'window-side window-side))))
(run-window-configuration-change-hook frame)
(window--check frame)
amount of redisplay; this is convenient on slow terminals."
(interactive "P")
(let ((old-window (selected-window))
- (old-point (window-point-1))
+ (old-point (window-point))
(size (and size (prefix-numeric-value size)))
moved-by-window-height moved new-window bottom)
(when (and size (< size 0) (< (- size) window-min-height))
(setq bottom (point)))
(and moved-by-window-height
(<= bottom (point))
- (set-window-point-1 old-window (1- bottom)))
+ (set-window-point old-window (1- bottom)))
(and moved-by-window-height
(<= (window-start new-window) old-point)
(set-window-point new-window old-point)
(defun balance-windows-2 (window horizontal)
"Subroutine of `balance-windows-1'.
WINDOW must be a vertical combination (horizontal if HORIZONTAL
-is non-nil."
+is non-nil)."
(let* ((first (window-child window))
(sub first)
(number-of-children 0)
`((parameters . ,list))))
,@(when buffer
;; All buffer related things go in here.
- (let ((point (window-point-1 window))
+ (let ((point (window-point window))
(start (window-start window)))
`((buffer
,(buffer-name buffer)
(scroll-bars . ,(window-scroll-bars window))
(vscroll . ,(window-vscroll window))
(dedicated . ,(window-dedicated-p window))
- (point . ,(if writable point (copy-marker point)))
+ (point . ,(if writable point
+ (copy-marker point
+ (buffer-local-value
+ 'window-point-insertion-type
+ buffer))))
(start . ,(if writable start (copy-marker start)))))))))
(tail
(when (memq type '(vc hc))
(list 'other
;; A quadruple of WINDOW's buffer, start, point and height.
(list (window-buffer window) (window-start window)
- (window-point-1 window) (window-total-size window))
+ (window-point window) (window-total-size window))
(selected-window) buffer))))
((eq type 'window)
;; WINDOW has been created on an existing frame.
(function :tag "function"))
:group 'windows)
+(make-obsolete-variable 'display-buffer-function
+ 'display-buffer-alist "24.3")
+
+;; Eventually, we want to turn this into a defvar; instead of
+;; customizing this, the user should use a `pop-up-frame-parameters'
+;; alist entry in `display-buffer-base-action'.
(defcustom pop-up-frame-alist nil
"Alist of parameters for automatically generated new frames.
-You can set this in your init file; for example,
-
- (setq pop-up-frame-alist '((width . 80) (height . 20)))
-
If non-nil, the value you specify here is used by the default
`pop-up-frame-function' for the creation of new frames.
(repeat :tag "Arguments" (sexp)))))
:group 'windows
:group 'frames)
-
-;;;###autoload
+(make-obsolete-variable 'special-display-buffer-names 'display-buffer-alist "24.3")
(put 'special-display-buffer-names 'risky-local-variable t)
(defcustom special-display-regexps nil
(repeat :tag "Arguments" (sexp)))))
:group 'windows
:group 'frames)
+(make-obsolete-variable 'special-display-regexps 'display-buffer-alist "24.3")
+(put 'special-display-regexps 'risky-local-variable t)
(defun special-display-p (buffer-name)
"Return non-nil if a buffer named BUFFER-NAME gets a special frame.
entry."
(let (tmp)
(cond
- ((not (stringp buffer-name)))
((member buffer-name special-display-buffer-names)
t)
((setq tmp (assoc buffer-name special-display-buffer-names))
(symbol :tag "Parameter")
(sexp :tag "Value")))
:group 'frames)
+(make-obsolete-variable 'special-display-frame-alist 'display-buffer-alist "24.3")
(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.
BUFFER in a window of the selected frame.
If ARGS is a list whose car is a symbol, use (car ARGS) as a
-function to do the work. Pass it BUFFER as first argument,
-and (cdr ARGS) as second."
+function to do the work. Pass it BUFFER as first argument, and
+pass the elements of (cdr ARGS) as the remaining arguments."
(if (and args (symbolp (car args)))
(apply (car args) buffer (cdr args))
(let ((window (get-buffer-window buffer 0)))
(make-frame (append args special-display-frame-alist))))
(window (frame-selected-window frame)))
(display-buffer-record-window 'frame window buffer)
- ;; FIXME: Use window--display-buffer-2?
- (set-window-buffer window buffer)
- ;; Reset list of WINDOW's previous buffers to nil.
- (set-window-prev-buffers window nil)
+ (unless (eq buffer (window-buffer window))
+ (set-window-buffer window buffer)
+ (set-window-prev-buffers window nil))
(set-window-dedicated-p window t)
window)))))
of the window used."
:type 'function
:group 'frames)
+(make-obsolete-variable 'special-display-function 'display-buffer-alist "24.3")
(defcustom same-window-buffer-names nil
"List of names of buffers that should appear in the \"same\" window.
:version "21.1"
:group 'windows)
+(make-obsolete-variable
+ 'display-buffer-reuse-frames
+ "use a `reusable-frames' alist entry in `display-buffer-alist'."
+ "24.3")
+
(defcustom pop-up-windows t
"Non-nil means `display-buffer' should make a new window."
:type 'boolean
;; A window can be split vertically when its height is not
;; fixed, it is at least `split-height-threshold' lines high,
;; and it is at least twice as high as `window-min-height' and 2
- ;; if it has a modeline or 1.
+ ;; if it has a mode line or 1.
(and (memq window-size-fixed '(nil width))
(numberp split-height-threshold)
(>= (window-height window)
(* 2 (max window-min-height
(if mode-line-format 2 1))))))))))
-(defun split-window-sensibly (window)
+(defun split-window-sensibly (&optional window)
"Split WINDOW in a way suitable for `display-buffer'.
+WINDOW defaults to the currently selected window.
If `split-height-threshold' specifies an integer, WINDOW is at
least `split-height-threshold' lines tall and can be split
vertically, split WINDOW into two windows one above the other and
Have a look at the function `window-splittable-p' if you want to
know how `split-window-sensibly' determines whether WINDOW can be
split."
- (or (and (window-splittable-p window)
- ;; Split window vertically.
- (with-selected-window window
- (split-window-below)))
- (and (window-splittable-p window t)
- ;; Split window horizontally.
- (with-selected-window window
- (split-window-right)))
- (and (eq window (frame-root-window (window-frame window)))
- (not (window-minibuffer-p window))
- ;; If WINDOW is the only window on its frame and is not the
- ;; minibuffer window, try to split it vertically disregarding
- ;; the value of `split-height-threshold'.
- (let ((split-height-threshold 0))
- (when (window-splittable-p window)
- (with-selected-window window
- (split-window-below)))))))
+ (let ((window (or window (selected-window))))
+ (or (and (window-splittable-p window)
+ ;; Split window vertically.
+ (with-selected-window window
+ (split-window-below)))
+ (and (window-splittable-p window t)
+ ;; Split window horizontally.
+ (with-selected-window window
+ (split-window-right)))
+ (and (eq window (frame-root-window (window-frame window)))
+ (not (window-minibuffer-p window))
+ ;; If WINDOW is the only window on its frame and is not the
+ ;; minibuffer window, try to split it vertically disregarding
+ ;; the value of `split-height-threshold'.
+ (let ((split-height-threshold 0))
+ (when (window-splittable-p window)
+ (with-selected-window window
+ (split-window-below))))))))
(defun window--try-to-split-window (window)
"Try to split WINDOW.
represents a live window, nil otherwise."
(and (window-live-p window)
(not (frame-parameter (window-frame window) 'unsplittable))
- (let ((new-window
- ;; Since `split-window-preferred-function' might
- ;; throw an error use `condition-case'.
- (condition-case nil
- (funcall split-window-preferred-function window)
- (error nil))))
+ (let* ((window-combination-limit
+ ;; When `window-combination-limit' equals
+ ;; `display-buffer' bind it to t so resizing steals
+ ;; space preferably from the window that was split.
+ (if (eq window-combination-limit 'display-buffer)
+ t
+ window-combination-limit))
+ (new-window
+ ;; Since `split-window-preferred-function' might
+ ;; throw an error use `condition-case'.
+ (condition-case nil
+ (funcall split-window-preferred-function window)
+ (error nil))))
(and (window-live-p new-window) new-window))))
(defun window--frame-usable-p (frame)
other, `even-window-heights' is non-nil, and the selected window
is higher than WINDOW."
(when (and even-window-heights
- (not (eq window (selected-window)))
- ;; Don't resize minibuffer windows.
- (not (window-minibuffer-p (selected-window)))
- (> (window-height (selected-window)) (window-height window))
- (eq (window-frame window) (window-frame (selected-window)))
- (let ((sel-edges (window-edges (selected-window)))
- (win-edges (window-edges window)))
- (and (= (nth 0 sel-edges) (nth 0 win-edges))
- (= (nth 2 sel-edges) (nth 2 win-edges))
- (or (= (nth 1 sel-edges) (nth 3 win-edges))
- (= (nth 3 sel-edges) (nth 1 win-edges))))))
- (let ((window-min-height 1))
- ;; Don't throw an error if we can't even window heights for
- ;; whatever reason.
- (condition-case nil
- (enlarge-window (/ (- (window-height window) (window-height)) 2))
- (error nil)))))
+ ;; Even iff WINDOW forms a vertical combination with the
+ ;; selected window, and WINDOW's height exceeds that of the
+ ;; selected window, see also bug#11880.
+ (window-combined-p window)
+ (= (window-child-count (window-parent window)) 2)
+ (eq (window-parent) (window-parent window))
+ (> (window-total-height) (window-total-height window)))
+ ;; Don't throw an error if we can't even window heights for
+ ;; whatever reason.
+ (condition-case nil
+ (enlarge-window
+ (/ (- (window-total-height window) (window-total-height)) 2))
+ (error nil))))
-(defun window--display-buffer-1 (window)
- "Raise the frame containing WINDOW.
-Do not raise the selected frame. Return WINDOW."
- (let* ((frame (window-frame window))
- (visible (frame-visible-p frame)))
+(defun window--display-buffer (buffer window type &optional dedicated)
+ "Display BUFFER in WINDOW and make its frame visible.
+TYPE must be one of the symbols `reuse', `window' or `frame' and
+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))
+ (display-buffer-record-window type window buffer)
+ (unless (eq buffer (window-buffer window))
+ (set-window-dedicated-p window nil)
+ (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))
+
+(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.
+ ;; 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--display-buffer-2 (buffer window &optional dedicated)
- "Display BUFFER in WINDOW and make its frame visible.
-Set `window-dedicated-p' to DEDICATED if non-nil.
-Return WINDOW."
- (when (and (buffer-live-p buffer) (window-live-p window))
- (set-window-buffer window buffer)
- (when dedicated
- (set-window-dedicated-p window dedicated))
- (window--display-buffer-1 window)))
+ (raise-frame frame))))
;; FIXME: Not implemented.
;; FIXME: By the way, there could be more levels of dedication:
`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'.
+ `pop-up-frame-parameters' -- Value specifies an alist of frame
+ parameters to give a new frame, if
+ one is created.
+
The ACTION argument to `display-buffer' can also have a non-nil
and non-list value. This means to display the buffer in a window
other than the selected one, even if it is already displayed in
(unless (or (cdr (assq 'inhibit-same-window alist))
(window-minibuffer-p)
(window-dedicated-p))
- (display-buffer-record-window 'reuse (selected-window) buffer)
- (window--display-buffer-2 buffer (selected-window))))
+ (window--display-buffer buffer (selected-window) 'reuse)))
(defun display-buffer--maybe-same-window (buffer alist)
"Conditionally display BUFFER in the selected 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)
(car (delq (selected-window)
(get-buffer-window-list buffer 'nomini
frames))))))
- (when window
- (display-buffer-record-window 'reuse window buffer)
- (window--display-buffer-1 window))))
+ (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.
(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."
- (let ((fun pop-up-frame-function)
- frame window)
+return the window used; otherwise return nil.
+
+If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
+raising the new frame.
+
+If ALIST has a non-nil `pop-up-frame-parameters' entry, the
+corresponding value is an alist of frame parameters to give the
+new frame."
+ (let* ((params (cdr (assq 'pop-up-frame-parameters alist)))
+ (pop-up-frame-alist (append params pop-up-frame-alist))
+ (fun pop-up-frame-function)
+ frame window)
(when (and fun
(setq frame (funcall fun))
(setq window (frame-selected-window frame)))
- (display-buffer-record-window 'frame window buffer)
- (window--display-buffer-2 buffer window display-buffer-mark-dedicated)
- ;; Reset list of WINDOW's previous buffers to nil.
- (set-window-prev-buffers window nil)
- window)))
+ (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)
(get-largest-window frame t))
(window--try-to-split-window
(get-lru-window frame t)))))
- (display-buffer-record-window 'window window buffer)
- (window--display-buffer-2 buffer window display-buffer-mark-dedicated)
- ;; Reset list of WINDOW's previous buffers to nil.
- (set-window-prev-buffers window nil)
- window)))
+ (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'.
(and pop-up-windows
(display-buffer-pop-up-window buffer alist))))
+(defun display-buffer-below-selected (buffer _alist)
+ "Try displaying BUFFER in a window below the selected window.
+This either splits the selected window or reuses the window below
+the selected one."
+ (let (window)
+ (or (and (not (frame-parameter nil 'unsplittable))
+ (setq window (window--try-to-split-window (selected-window)))
+ (window--display-buffer
+ buffer window 'window display-buffer-mark-dedicated))
+ (and (setq window (window-in-direction 'below))
+ (not (window-dedicated-p window))
+ (window--display-buffer
+ buffer window 'reuse display-buffer-mark-dedicated)))))
+
+(defun display-buffer-at-bottom (buffer _alist)
+ "Try displaying BUFFER in a window at the botom of the selected frame.
+This either splits the window at the bottom of the frame or the
+frame's root window, or reuses an existing window at the bottom
+of the selected frame."
+ (let (bottom-window window)
+ (walk-window-tree (lambda (window) (setq bottom-window window)))
+ (or (and (not (frame-parameter nil 'unsplittable))
+ (setq window (window--try-to-split-window bottom-window))
+ (window--display-buffer
+ buffer window 'window display-buffer-mark-dedicated))
+ (and (not (frame-parameter nil 'unsplittable))
+ (setq window
+ (condition-case nil
+ (split-window (frame-root-window))
+ (error nil)))
+ (window--display-buffer
+ buffer window 'window display-buffer-mark-dedicated))
+ (and (setq window bottom-window)
+ (not (window-dedicated-p window))
+ (window--display-buffer
+ buffer window 'reuse display-buffer-mark-dedicated)))))
+
+(defun display-buffer-in-previous-window (buffer alist)
+ "Display BUFFER in a window previously showing it.
+If ALIST has a non-nil `inhibit-same-window' entry, the selected
+window is not eligible for reuse.
+
+If ALIST contains a `reusable-frames' entry, its value determines
+which frames to search for a reusable window:
+ nil -- the selected frame (actually the last non-minibuffer frame)
+ A frame -- just that frame
+ `visible' -- all visible frames
+ 0 -- all frames on the current terminal
+ t -- all frames.
+
+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.
+
+If ALIST has a `previous-window' entry, the window specified by
+that entry will override any other window found by the methods
+above, even if that window never showed BUFFER before."
+ (let* ((alist-entry (assq 'reusable-frames alist))
+ (inhibit-same-window
+ (cdr (assq 'inhibit-same-window alist)))
+ (frames (cond
+ (alist-entry (cdr alist-entry))
+ ((if (eq pop-up-frames 'graphic-only)
+ (display-graphic-p)
+ pop-up-frames)
+ 0)
+ (display-buffer-reuse-frames 0)
+ (t (last-nonminibuffer-frame))))
+ entry best-window second-best-window window)
+ ;; Scan windows whether they have shown the buffer recently.
+ (catch 'best
+ (dolist (window (window-list-1 (frame-first-window) 'nomini frames))
+ (when (and (assq buffer (window-prev-buffers window))
+ (not (window-dedicated-p window)))
+ (if (eq window (selected-window))
+ (unless inhibit-same-window
+ (setq second-best-window window))
+ (setq best-window window)
+ (throw 'best t)))))
+ ;; When ALIST has a `previous-window' entry, that entry may override
+ ;; anything we found so far.
+ (when (and (setq window (cdr (assq 'previous-window alist)))
+ (window-live-p window)
+ (not (window-dedicated-p window)))
+ (if (eq window (selected-window))
+ (unless inhibit-same-window
+ (setq second-best-window window))
+ (setq best-window window)))
+ ;; Return best or second best window found.
+ (when (setq window (or best-window second-best-window))
+ (window--display-buffer buffer window 'reuse))))
+
(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)))
- (window-to-undedicate
- ;; When NOT-THIS-WINDOW is non-nil, temporarily dedicate the
- ;; selected window to its buffer, to prevent any of the
- ;; `get-' routines below from choosing it. (Bug#1415)
- (and not-this-window (not (window-dedicated-p))
- (set-window-dedicated-p (selected-window) t)
- (selected-window)))
(frame (or (window--frame-usable-p (selected-frame))
(window--frame-usable-p (last-nonminibuffer-frame))))
- window)
- (unwind-protect
- (setq window
- ;; Reuse an existing window.
- (or (get-lru-window frame)
- (let ((window (get-buffer-window buffer 'visible)))
- (unless (and not-this-window
- (eq window (selected-window)))
- window))
- (get-largest-window 'visible)
- (let ((window (get-buffer-window buffer 0)))
- (unless (and not-this-window
- (eq window (selected-window)))
- window))
- (get-largest-window 0)))
- (when (window-live-p window-to-undedicate)
- ;; Restore dedicated status of selected window.
- (set-window-dedicated-p window-to-undedicate nil)))
- (when window
- (display-buffer-record-window 'reuse window buffer)
- (window--even-window-heights window)
- (window--display-buffer-2 buffer window))))
+ (window
+ ;; Reuse an existing window.
+ (or (get-lru-window frame nil not-this-window)
+ (let ((window (get-buffer-window buffer 'visible)))
+ (unless (and not-this-window
+ (eq window (selected-window)))
+ window))
+ (get-largest-window 'visible nil not-this-window)
+ (let ((window (get-buffer-window buffer 0)))
+ (unless (and not-this-window
+ (eq window (selected-window)))
+ window))
+ (get-largest-window 0 not-this-window))))
+ (when (window-live-p window)
+ (prog1
+ (window--display-buffer buffer window 'reuse)
+ (window--even-window-heights window)
+ (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)
"Select buffer BUFFER in some window, preferably a different one.
BUFFER may be a buffer, a string (a buffer name), or nil. If it
(defun switch-to-buffer (buffer-or-name &optional norecord force-same-window)
"Switch to buffer BUFFER-OR-NAME in the selected window.
-If called interactively, prompt for the buffer name using the
+If the selected window cannot display the specified
+buffer (e.g. if it is a minibuffer window or strongly dedicated
+to another buffer), call `pop-to-buffer' to select the buffer in
+another window.
+
+If called interactively, read the buffer name using the
minibuffer. The variable `confirm-nonexistent-file-or-buffer'
determines whether to request confirmation before creating a new
buffer.
-BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
-nil. If BUFFER-OR-NAME is a string that does not identify an
-existing buffer, create a buffer with that name. If
-BUFFER-OR-NAME is nil, switch to the buffer returned by
-`other-buffer'.
+BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil.
+If BUFFER-OR-NAME is a string that does not identify an existing
+buffer, create a buffer with that name. If BUFFER-OR-NAME is
+nil, switch to the buffer returned by `other-buffer'.
-Optional argument NORECORD non-nil means do not put the buffer
-specified by BUFFER-OR-NAME at the front of the buffer list and
-do not make the window displaying it the most recently selected
-one.
+If optional argument NORECORD is non-nil, do not put the buffer
+at the front of the buffer list, and do not make the window
+displaying it the most recently selected one.
-If FORCE-SAME-WINDOW is non-nil, BUFFER-OR-NAME must be displayed
-in the selected window; signal an error if that is
-impossible (e.g. if the selected window is minibuffer-only). If
-nil, BUFFER-OR-NAME may be displayed in another window.
+If optional argument FORCE-SAME-WINDOW is non-nil, the buffer
+must be displayed in the selected window; if that is impossible,
+signal an error rather than calling `pop-to-buffer'.
Return the buffer switched to."
(interactive
((eq buffer (window-buffer)))
((window-minibuffer-p)
(if force-same-window
- (error "Cannot switch buffers in minibuffer window")
+ (user-error "Cannot switch buffers in minibuffer window")
(pop-to-buffer buffer norecord)))
((eq (window-dedicated-p) t)
(if force-same-window
- (error "Cannot switch buffers in a dedicated window")
+ (user-error "Cannot switch buffers in a dedicated window")
(pop-to-buffer buffer norecord)))
(t (set-window-buffer nil buffer)))
\f
(defun set-window-text-height (window height)
"Set the height in lines of the text display area of WINDOW to HEIGHT.
-WINDOW must be a live window. HEIGHT doesn't include the mode
-line or header line, if any, or any partial-height lines in the
-text display area.
+WINDOW must be a live window and defaults to the selected one.
+HEIGHT doesn't include the mode line or header line, if any, or
+any partial-height lines in the text display area.
Note that the current implementation of this function cannot
always set the height exactly, but attempts to be conservative,
(unless (zerop delta)
;; Setting window-min-height to a value like 1 can lead to very
;; bizarre displays because it also allows Emacs to make *other*
- ;; windows 1-line tall, which means that there's no more space for
- ;; the modeline.
- (let ((window-min-height (min 2 height))) ; One text line plus a modeline.
+ ;; windows one line tall, which means that there's no more space
+ ;; for the mode line.
+ (let ((window-min-height (min 2 height)))
(window-resize window delta)))))
(defun enlarge-window-horizontally (delta)
(1+ (vertical-motion (buffer-size) window))))))
(defun window-buffer-height (window)
- "Return the height (in screen lines) of the buffer that WINDOW is displaying."
+ "Return the height (in screen lines) of the buffer that WINDOW is displaying.
+WINDOW must be a live window and defaults to the selected one."
+ (setq window (window-normalize-window window t))
(with-current-buffer (window-buffer window)
(max 1
(count-screen-lines (point-min) (point-max)
window))))
;;; Resizing buffers to fit their contents exactly.
-(defun fit-window-to-buffer (&optional window max-height min-height override)
+(defun fit-window-to-buffer (&optional window max-height min-height)
"Adjust height of WINDOW to display its buffer's contents exactly.
-WINDOW can be any live window and defaults to the selected one.
+WINDOW must be a live window and defaults to the selected one.
Optional argument MAX-HEIGHT specifies the maximum height of
WINDOW and defaults to the height of WINDOW's frame. Optional
are specified in lines and include the mode line and header line,
if any.
-Optional argument OVERRIDE non-nil means override restrictions
-imposed by `window-min-height' and `window-min-width' on the size
-of WINDOW.
-
Return the number of lines by which WINDOW was enlarged or
shrunk. If an error occurs during resizing, return nil but don't
signal an error.
_all_ lines of its buffer you might not see the first lines when
WINDOW was scrolled."
(interactive)
- ;; Do all the work in WINDOW and its buffer and restore the selected
- ;; window and the current buffer when we're done.
(setq window (window-normalize-window window t))
;; Can't resize a full height or fixed-size window.
(unless (or (window-size-fixed-p window)
(window-full-height-p window))
- ;; `with-selected-window' should orderly restore the current buffer.
(with-selected-window window
- ;; We are in WINDOW's buffer now.
- (let* (;; Adjust MIN-HEIGHT.
+ (let* ((height (window-total-size))
(min-height
- (if override
- (window-min-size window nil window)
- (max (or min-height window-min-height)
- window-safe-min-height)))
- (max-window-height
- (window-total-size (frame-root-window window)))
- ;; Adjust MAX-HEIGHT.
+ ;; Adjust MIN-HEIGHT.
+ (if (numberp min-height)
+ ;; Can't get smaller than `window-safe-min-height'.
+ (max min-height window-safe-min-height)
+ ;; Preserve header and mode line if present.
+ (window-min-size nil nil t)))
(max-height
- (if (or override (not max-height))
- max-window-height
- (min max-height max-window-height)))
+ ;; Adjust MAX-HEIGHT.
+ (if (numberp max-height)
+ ;; Can't get larger than height of frame.
+ (min max-height
+ (window-total-size (frame-root-window window)))
+ ;, Don't delete other windows.
+ (+ height (window-max-delta nil nil window))))
;; Make `desired-height' the height necessary to show
;; all of WINDOW's buffer, constrained by MIN-HEIGHT
;; and MAX-HEIGHT.
(window-max-delta window nil window))
(max desired-delta
(- (window-min-delta window nil window))))))
- ;; This `condition-case' shouldn't be necessary, but who knows?
(condition-case nil
(if (zerop delta)
;; Return zero if DELTA became zero in the process.
(error (setq delta nil)))
delta))))
+(defcustom fit-frame-to-buffer-bottom-margin 4
+ "Bottom margin for `fit-frame-to-buffer'.
+This is the number of lines `fit-frame-to-buffer' leaves free at the
+bottom of the display in order to not obscure the system task bar."
+ :type 'integer
+ :version "24.2"
+ :group 'windows)
+
+(defun fit-frame-to-buffer (&optional frame max-height min-height)
+ "Adjust height of FRAME to display its buffer's contents exactly.
+FRAME can be any live frame and defaults to the selected one.
+
+Optional argument MAX-HEIGHT specifies the maximum height of
+FRAME and defaults to the height of the display below the current
+top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN.
+Optional argument MIN-HEIGHT specifies the minimum height of
+FRAME."
+ (interactive)
+ (setq frame (window-normalize-frame frame))
+ (let* ((root (frame-root-window frame))
+ (frame-min-height
+ (+ (- (frame-height frame) (window-total-size root))
+ window-min-height))
+ (frame-top (frame-parameter frame 'top))
+ (top (if (consp frame-top)
+ (funcall (car frame-top) (cadr frame-top))
+ frame-top))
+ (frame-max-height
+ (- (/ (- (x-display-pixel-height frame) top)
+ (frame-char-height frame))
+ fit-frame-to-buffer-bottom-margin))
+ (compensate 0)
+ delta)
+ (when (and (window-live-p root) (not (window-size-fixed-p root)))
+ (with-selected-window root
+ (cond
+ ((not max-height)
+ (setq max-height frame-max-height))
+ ((numberp max-height)
+ (setq max-height (min max-height frame-max-height)))
+ (t
+ (error "%s is an invalid maximum height" max-height)))
+ (cond
+ ((not min-height)
+ (setq min-height frame-min-height))
+ ((numberp min-height)
+ (setq min-height (min min-height frame-min-height)))
+ (t
+ (error "%s is an invalid minimum height" min-height)))
+ ;; When tool-bar-mode is enabled and we have just created a new
+ ;; frame, reserve lines for toolbar resizing. This is needed
+ ;; because for reasons unknown to me Emacs (1) reserves one line
+ ;; for the toolbar when making the initial frame and toolbars
+ ;; are enabled, and (2) later adds the remaining lines needed.
+ ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a
+ ;; system that behaves differently.
+ (let ((quit-restore (window-parameter root 'quit-restore))
+ (lines (tool-bar-lines-needed frame)))
+ (when (and quit-restore (eq (car quit-restore) 'frame)
+ (not (zerop lines)))
+ (setq compensate (1- lines))))
+ (message "%s" compensate)
+ (setq delta
+ ;; Always count a final newline - we don't do any
+ ;; post-processing, so let's play safe.
+ (+ (count-screen-lines nil nil t)
+ (- (window-body-size))
+ compensate)))
+ ;; Move away from final newline.
+ (when (and (eobp) (bolp) (not (bobp)))
+ (set-window-point root (line-beginning-position 0)))
+ (set-window-start root (point-min))
+ (set-window-vscroll root 0)
+ (condition-case nil
+ (set-frame-height
+ frame
+ (min (max (+ (frame-height frame) delta)
+ min-height)
+ max-height))
+ (error (setq delta nil))))
+ delta))
+
(defun window-safely-shrinkable-p (&optional window)
"Return t if WINDOW can be shrunk without shrinking other windows.
WINDOW defaults to the selected window."
"Shrink height of WINDOW if its buffer doesn't need so many lines.
More precisely, shrink WINDOW vertically to be as small as
possible, while still showing the full contents of its buffer.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
Do not shrink WINDOW to less than `window-min-height' lines. Do
nothing if the buffer contains more lines than the present window
\(depending on scrolling direction) when no more scrolling possible.
When point is already on that position, then signal an error."
:type 'boolean
- :group 'scrolling
+ :group 'windows
:version "24.1")
(defun scroll-up-command (&optional arg)
(put 'scroll-down-line 'scroll-command t)
\f
-(defun scroll-other-window-down (lines)
+(defun scroll-other-window-down (&optional lines)
"Scroll the \"other window\" down.
For more details, see the documentation for `scroll-other-window'."
(interactive "P")
(setq mouse-autoselect-window-state nil)
;; Run `mouse-leave-buffer-hook' when autoselecting window.
(run-hooks 'mouse-leave-buffer-hook))
+ ;; Clear echo area.
+ (message nil)
(select-window window))))
(defun truncated-partial-width-window-p (&optional window)
"Return non-nil if lines in WINDOW are specifically truncated due to its width.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
Return nil if WINDOW is not a partial-width window
(regardless of the value of `truncate-lines').
Otherwise, consult the value of `truncate-partial-width-windows'
for the buffer shown in WINDOW."
- (unless window
- (setq window (selected-window)))
+ (setq window (window-normalize-window window t))
(unless (window-full-width-p window)
(let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
(window-buffer window))))
;;; Code:
-(eval-when-compile
- (require 'cl))
-
-
-(defmacro winner-active-region ()
+(eval-when-compile (require 'cl-lib))
+
+(defun winner-active-region ()
+ (declare (gv-setter (lambda (store)
+ (if (featurep 'xemacs)
+ `(if ,store (zmacs-activate-region)
+ (zmacs-deactivate-region))
+ `(setq mark-active ,store)))))
(if (boundp 'mark-active)
- 'mark-active
- '(region-active-p)))
-
-(defsetf winner-active-region () (store)
- (if (featurep 'xemacs)
- `(if ,store (zmacs-activate-region)
- (zmacs-deactivate-region))
- `(setq mark-active ,store)))
+ mark-active
+ (region-active-p)))
(defalias 'winner-edges
(if (featurep 'xemacs) 'window-pixel-edges 'window-edges))
(defun winner-sorted-window-list ()
(sort (winner-window-list)
(lambda (x y)
- (loop for a in (winner-edges x)
- for b in (winner-edges y)
- while (= a b)
- finally return (< a b)))))
+ (cl-loop for a in (winner-edges x)
+ for b in (winner-edges y)
+ while (= a b)
+ finally return (< a b)))))
(defun winner-win-data ()
;; Essential properties of the windows in the selected frame.
- (loop for win in (winner-sorted-window-list)
- collect (cons (winner-edges win) (window-buffer win))))
+ (cl-loop for win in (winner-sorted-window-list)
+ collect (cons (winner-edges win) (window-buffer win))))
;; This variable is updated with the current window configuration
;; every time it changes.
;; Consult `winner-currents'.
(defun winner-configuration (&optional frame)
(or (cdr (assq (or frame (selected-frame)) winner-currents))
- (letf (((selected-frame) frame))
+ (with-selected-frame frame
(winner-conf))))
(let* ((miniwin (minibuffer-window))
(chosen (selected-window))
(minisize (window-height miniwin)))
- (letf (((window-buffer miniwin))
- ((window-point miniwin)))
+ (cl-letf (((window-buffer miniwin))
+ ((window-point miniwin)))
(set-window-configuration winconf))
(cond
((window-live-p chosen) (select-window chosen))
((window-minibuffer-p (selected-window))
(other-window 1)))
(when (/= minisize (window-height miniwin))
- (letf (((selected-window) miniwin) )
+ (with-selected-window miniwin
(setf (window-height) minisize)))))
;; Format of entries: (buffer (mark . mark-active) (window . point) ..)
(defun winner-make-point-alist ()
- (letf (((current-buffer)))
- (loop with alist
- for win in (winner-window-list)
- for entry =
- (or (assq (window-buffer win) alist)
- (car (push (list (set-buffer (window-buffer win))
- (cons (mark t) (winner-active-region)))
- alist)))
- do (push (cons win (window-point win))
- (cddr entry))
- finally return alist)))
+ (save-current-buffer
+ (cl-loop with alist
+ for win in (winner-window-list)
+ for entry =
+ (or (assq (window-buffer win) alist)
+ (car (push (list (set-buffer (window-buffer win))
+ (cons (mark t) (winner-active-region)))
+ alist)))
+ do (push (cons win (window-point win))
+ (cddr entry))
+ finally return alist)))
(defun winner-get-point (buf win)
;; Consult (and possibly extend) `winner-point-alist'.
(entry
(or (cdr (assq win (cddr entry)))
(cdr (assq nil (cddr entry)))
- (letf (((current-buffer) buf))
+ (with-current-buffer buf
(push (cons nil (point)) (cddr entry))
(point))))
- (t (letf (((current-buffer) buf))
+ (t (with-current-buffer buf
(push (list buf
(cons (mark t) (winner-active-region))
(cons nil (point)))
(let* ((buffers nil)
(alive
;; Possibly update `winner-point-alist'
- (loop for buf in (mapcar 'cdr (cdr conf))
- for pos = (winner-get-point buf nil)
- if (and pos (not (memq buf buffers)))
- do (push buf buffers)
- collect pos)))
+ (cl-loop for buf in (mapcar 'cdr (cdr conf))
+ for pos = (winner-get-point buf nil)
+ if (and pos (not (memq buf buffers)))
+ do (push buf buffers)
+ collect pos)))
(winner-set-conf (car conf))
(let (xwins) ; to be deleted
(push win xwins))) ; delete this window
;; Restore marks
- (letf (((current-buffer)))
- (loop for buf in buffers
- for entry = (cadr (assq buf winner-point-alist))
- do (progn (set-buffer buf)
- (set-mark (car entry))
- (setf (winner-active-region) (cdr entry)))))
+ (save-current-buffer
+ (cl-loop for buf in buffers
+ for entry = (cadr (assq buf winner-point-alist))
+ do (progn (set-buffer buf)
+ (set-mark (car entry))
+ (setf (winner-active-region) (cdr entry)))))
;; Delete windows, whose buffers are dead or boring.
;; Return t if this is still a possible configuration.
(or (null xwins)
(setq winner-pending-undo-ring (winner-ring (selected-frame)))
(setq winner-undo-counter 0)
(setq winner-undone-data (list (winner-win-data))))
- (incf winner-undo-counter) ; starting at 1
+ (cl-incf winner-undo-counter) ; starting at 1
(when (and (winner-undo-this)
(not (window-minibuffer-p (selected-window))))
(message "Winner undo (%d / %d)"
\f
(defun winner-undo-this () ; The heart of winner undo.
- (loop
+ (cl-loop
(cond
((>= winner-undo-counter (ring-length winner-pending-undo-ring))
(message "No further window configuration undo information")
- (return nil))
+ (cl-return nil))
((and ; If possible configuration
(winner-set (ring-ref winner-pending-undo-ring
(let ((data (winner-win-data)))
(and (not (member data winner-undone-data))
(push data winner-undone-data))))
- (return t)) ; .. then everything is fine.
+ (cl-return t)) ; .. then everything is fine.
(t ;; Otherwise, discharge it (and try the next one).
(ring-remove winner-pending-undo-ring winner-undo-counter)))))
;;; woman.el --- browse UN*X manual pages `wo (without) man'
-;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
;; Maintainer: FSF
;; package will over-write the WoMan binding to "w", whereas (by
;; default) WoMan will not overwrite the `dired-x' binding.)
-;; The following is based on suggestions by Guy Gascoigne-Piggford and
-;; Juanma Barranquero. If you really want to square the man-woman
-;; circle then you might care to define the following bash function in
-;; .bashrc:
-
-;; man() { gnudoit -q '(raise-frame (selected-frame)) (woman' \"$1\" ')' ; }
-
-;; If you use Microsoft COMMAND.COM then you can create a file called
-;; man.bat somewhere in your path containing the two lines:
-
-;; @echo off
-;; gnudoit -q (raise-frame (selected-frame)) (woman \"%1\")
-
-;; and then (e.g. from a command prompt or the Run... option in the
-;; Start menu) just execute
-
-;; man man_page_name
-
-
;; Using the word at point as the default topic
;; ============================================
;; http://cm.bell-labs.com/7thEdMan/
-;; Acknowledgements
-;; ================
+;; Acknowledgments
+;; ===============
;; For Heather, Kathryn and Madelyn, the women in my life
;; (although they will probably never use it)!
(eval-when-compile ; to avoid compiler warnings
(require 'dired)
- (require 'cl)
+ (require 'cl-lib)
(require 'apropos))
(defun woman-mapcan (fn x)
(woman-process-buffer)
(goto-char (point-min)))))
-;; There is currently no `tar-mode-hook' so use ...
-(eval-after-load "tar-mode"
- '(progn
- (define-key tar-mode-map "w" 'woman-tar-extract-file)
- (define-key-after (lookup-key tar-mode-map [menu-bar immediate])
- [woman] '("Read Man Page (WoMan)" . woman-tar-extract-file) 'view)))
-
-
(defvar woman-last-file-name nil
"The full pathname of the last file formatted by WoMan.")
(lambda (symbol)
(and
(or (commandp symbol)
- (user-variable-p symbol))
+ (custom-variable-p symbol))
(not (get symbol 'apropos-inhibit))))))
;; Find documentation strings:
(let ((p apropos-accumulator)
(if (setq doc (documentation symbol t))
(substring doc 0 (string-match "\n" doc))
"(not documented)"))
- (if (user-variable-p symbol) ; 3. variable doc
+ (if (custom-variable-p symbol) ; 3. variable doc
(if (setq doc (documentation-property
symbol 'variable-documentation t))
(substring doc 0 (string-match "\n" doc))))))
(copy-sequence standard-display-table)
(make-display-table)))
;; Display the following internal chars correctly:
- (aset buffer-display-table woman-unpadded-space-char [?\ ])
+ (aset buffer-display-table woman-unpadded-space-char [?\s])
(aset buffer-display-table woman-escaped-escape-char [?\\]))
\f
(if woman-negative-vertical-space
(woman-negative-vertical-space from))
- (if woman-preserve-ascii
- ;; Re-instate escaped escapes to just `\' and unpaddable
- ;; spaces to just `space', without inheriting any text
- ;; properties. This is not necessary, UNLESS the buffer is to
- ;; be saved as ASCII.
- (progn
- (goto-char from)
- (while (search-forward woman-escaped-escape-string nil t)
- (delete-char -1) (insert ?\\))
- (goto-char from)
- (while (search-forward woman-unpadded-space-string nil t)
- (delete-char -1) (insert ?\ ))))
+ (when woman-preserve-ascii
+ ;; Re-instate escaped escapes to just `\' and unpaddable spaces
+ ;; to just `space'. This is not necessary for display since
+ ;; there are display table entries for the escaped chars, but it
+ ;; is necessary if the buffer might be saved as ASCII.
+ ;;
+ ;; `subst-char-in-region' preserves text properties on the
+ ;; characters, which is necessary for bold, underline, etc on
+ ;; \e. There's usually no face on spaces, but if there is then
+ ;; it's good to keep that too.
+ (subst-char-in-region from (point-max)
+ woman-escaped-escape-char ?\\)
+ (subst-char-in-region from (point-max)
+ woman-unpadded-space-char ?\s))
;; Must return the new end of file if used in format-alist.
(point-max)))
;; first backwards then forwards:
(while (and
(<= (setq N (1+ N)) 0)
- (cond ((memq (preceding-char) '(?\ ?\t))
+ (cond ((memq (preceding-char) '(?\s ?\t))
(delete-char -1) t)
- ((memq (following-char) '(?\ ?\t))
+ ((memq (following-char) '(?\s ?\t))
(delete-char 1) t)
(t nil))))
(if (<= N 0)
(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 recognized 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)
;; then use the WoMan search mechanism to find the filename ...
(setq filename
(woman-file-name
- (file-name-sans-extension
- (file-name-nondirectory name))))
+ (file-name-base name)))
;; Cannot find the file, so ...
(kill-buffer (current-buffer))
(error "File `%s' not found" name))
(re-search-forward "[^ \t\n]+")
(let ((string (match-string 0)))
(skip-chars-forward " \t")
-; (setq string
-; (cons string
-; ;; hack (?) for CGI.man!
-; (cond ((looking-at "\"\"") "\"")
-; ((looking-at ".*") (match-string 0)))
-; ))
- ;; Above hack causes trouble in arguments!
- (looking-at ".*")
- (setq string (cons string (match-string 0)))
+ (if (= ?\" (following-char))
+ ;; Double-quote starts a string, eg.
+ ;; .ds foo "blah...
+ ;; is value blah... through to newline. There's no
+ ;; closing " (per the groff manual), but rather any
+ ;; further " is included literally in the string. Eg.
+ ;; .ds foo ""
+ ;; sets foo to a single " character.
+ (forward-char))
+ (setq string (cons string
+ (buffer-substring (point)
+ (line-end-position))))
;; This should be an update, but consing a new string
;; onto the front of the alist has the same effect:
(setq woman-string-alist (cons string woman-string-alist))
;; this used to be globally bound to nil, to avoid an error. Instead
;; we can use bound-and-true-p in woman-translate.
(defvar woman-translations)
-;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil.
+;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\s)) or nil.
(defun woman-get-next-char ()
"Return and delete next char in buffer, including special chars."
(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!"))
(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:
(setq fn 'woman2-format-paragraphs))))
()
;; Find next control line:
- (set-marker to (woman-find-next-control-line))
+ (if (equal woman-request "TS")
+ (set-marker to (woman-find-next-control-line "TE"))
+ (set-marker to (woman-find-next-control-line)))
;; Call the appropriate function:
(funcall fn to)))
(if (not (eobp)) ; This should not happen, but ...
(fset 'insert-and-inherit insert-and-inherit)
(set-marker to nil))))
-(defun woman-find-next-control-line ()
- "Find and return start of next control line."
-; (let ((to (save-excursion
-; (re-search-forward "^\\." nil t))))
-; (if to (1- to) (point-max)))
- (let (to)
+(defun woman-find-next-control-line (&optional pat)
+ "Find and return start of next control line.
+PAT, if non-nil, specifies an additional component of the control
+line regexp to search for, which is appended to the default
+regexp, \"\\(\\\\c\\)?\\n[.']\"."
+ (let ((pattern (concat "\\(\\\\c\\)?\n[.']" pat))
+ to)
(save-excursion
;; Must handle
;; ...\c
;; BEWARE THAT THIS CODE MAY BE UNRELIABLE!!!!!
(while
(and
- (setq to (re-search-forward "\\(\\\\c\\)?\n[.']" nil t))
+ (setq to (re-search-forward pattern nil t))
(match-beginning 1)
(looking-at "br"))
(goto-char (match-beginning 0))
(woman-delete-line 2)))
- (if to (1- to) (point-max))))
+ (if to
+ (- to (+ 1 (length pat)))
+ (point-max))))
(defun woman2-PD (to)
".PD d -- Set the interparagraph distance to d.
(insert (substring overlap i eol))
(setq i (or eol imax)))
)
- ((eq c ?\ ) ; skip
+ ((eq c ?\s) ; skip
(forward-char))
((eq c ?\t) ; skip
(if (eq (following-char) ?\t)
(forward-char) ; both tabs, just skip
(dotimes (i woman-tab-width)
(if (eolp)
- (insert ?\ ) ; extend line
+ (insert ?\s) ; extend line
(forward-char)) ; skip
)))
(t
- (if (or (eq (following-char) ?\ ) ; overwrite OK
+ (if (or (eq (following-char) ?\s) ; overwrite OK
overwritten) ; warning only once per ".sp -"
()
(setq overwritten t)
(defun woman2-process-escapes (to &optional numeric)
"Process remaining escape sequences up to marker TO, preserving point.
Optional argument NUMERIC, if non-nil, means the argument is numeric."
- (assert (and (markerp to) (marker-insertion-type to)))
+ (cl-assert (and (markerp to) (marker-insertion-type to)))
;; The first two cases below could be merged (maybe)!
(let ((from (point)))
;; Discard zero width filler character used to hide leading dots
(while (re-search-forward "\\\\[&|^]" to t)
(woman-delete-match 0)
;; If on a line by itself, consume newline as well (Bug#3651).
- (and (eq (char-before (match-beginning 0)) ?\n)
+ ;; But not in a .nf region, preserve all newlines in that case.
+ (and (not woman-nofill)
+ (eq (char-before (match-beginning 0)) ?\n)
(eq (char-after (match-beginning 0)) ?\n)
(delete-char 1)))
tab (- tab (if (eq type ?C) (/ n 2) n))) )
(setq n (- tab (current-column)))
(insert-char ?\s n))
- (insert ?\ ))))
+ (insert ?\s))))
(defun woman2-DT (to)
".DT -- Restore default tabs. Format paragraphs upto TO.
(if (eolp)
(woman-delete-whole-line) ; ignore!
(let ((delim (following-char))
- (pad ?\ ) end) ; pad defaults to space
+ (pad ?\s) end) ; pad defaults to space
(forward-char)
(skip-chars-forward " \t")
(or (eolp) (setq pad (following-char)))
(defun woman2-TS (to)
".TS -- Start of table code for the tbl processor.
Format paragraphs upto TO."
- ;; This is a preliminary hack that seems to suffice for lilo.8.
- (woman-delete-line 1) ; ignore any arguments
(when woman-emulate-tbl
;; Assumes column separator is \t and intercolumn spacing is 3.
;; The first line may optionally be a list of options terminated by
(woman-delete-line 1)
;; For each column, find its width and align it:
(let ((start (point)) (col 1))
+ (WoMan-log "%s" (buffer-substring start (+ start 40)))
+ ;; change T{ T} to tabs
+ (while (search-forward "T{\n" to t)
+ (replace-match "")
+ (catch 'end
+ (while (search-forward "\n" to t)
+ (replace-match " ")
+ (if (looking-at "T}")
+ (progn
+ (delete-char 2)
+ (throw 'end t))))))
+ (goto-char start)
+ ;; strip space and headers
+ (while (re-search-forward "^\\.TH\\|\\.sp" to t)
+ (woman-delete-whole-line))
+ (goto-char start)
(while (prog1 (search-forward "\t" to t) (goto-char start))
;; Find current column width:
(while (< (point) to)
(while (< (point) to)
(when (search-forward "\t" to t)
(delete-char -1)
- (insert-char ?\ (- col (current-column))))
+ (insert-char ?\s (- col (current-column))))
(forward-line))
+ (goto-char start))
+ ;; find maximum width
+ (let ((max-col 0))
+ (while (search-forward "\n" to t)
+ (backward-char)
+ (if (> (current-column) max-col)
+ (setq max-col (current-column)))
+ (forward-char))
+ (goto-char start)
+ ;; break lines if they are too long
+ (when (and (> max-col woman-fill-column)
+ (> woman-fill-column col))
+ (setq max-col woman-fill-column)
+ (woman-break-table col to start)
+ (goto-char start))
+ (while (re-search-forward "^_$" to t)
+ (replace-match (make-string max-col ?_)))
(goto-char start))))
;; Format table with no filling or adjusting (cf. woman2-nf):
(setq woman-nofill t)
;; ".TE -- End of table code for the tbl processor."
;; Turn filling and adjusting back on.
+(defun woman-break-table (start-column to start)
+ (while (< (point) to)
+ (move-to-column woman-fill-column)
+ (if (eolp)
+ (forward-line)
+ (if (and (search-backward " " start t)
+ (> (current-column) start-column))
+ (progn
+ (insert-char ?\n 1)
+ (insert-char ?\s (- start-column 5)))
+ (forward-line)))))
\f
;;; WoMan message logging:
(buffer-substring (point)
(line-end-position))))
(if (and (> (length tail) 0)
- (/= (string-to-char tail) ?\ ))
+ (/= (string-to-char tail) ?\s))
(setq tail (concat " " tail)))
(WoMan-log-1
(concat "** " request tail " request " ignored))))
;; a worthwhile tradeoff especially since we're usually parsing files
;; instead of hand-crafted XML.
-;;*******************************************************************
-;;**
-;;** Macros to parse the list
-;;**
-;;*******************************************************************
+;;; Macros to parse the list
(defconst xml-undefined-entity "?"
"What to substitute for undefined entities")
+(defconst xml-default-ns '(("" . "")
+ ("xml" . "http://www.w3.org/XML/1998/namespace")
+ ("xmlns" . "http://www.w3.org/2000/xmlns/"))
+ "Alist mapping default XML namespaces to their URIs.")
+
(defvar xml-entity-alist
- '(("lt" . "<")
+ '(("lt" . "<")
("gt" . ">")
("apos" . "'")
("quot" . "\"")
- ("amp" . "&"))
- "The defined entities. Entities are added to this when the DTD is parsed.")
+ ("amp" . "&"))
+ "Alist mapping XML entities to their replacement text.")
+
+(defvar xml-entity-expansion-limit 20000
+ "The maximum size of entity reference expansions.
+If the size of the buffer increases by this many characters while
+expanding entity references in a segment of character data, the
+XML parser signals an error. Setting this to nil removes the
+limit (making the parser vulnerable to XML bombs).")
+
+(defvar xml-parameter-entity-alist nil
+ "Alist of defined XML parametric entities.")
(defvar xml-sub-parser nil
- "Dynamically set this to a non-nil value if you want to parse an XML fragment.")
+ "Non-nil when the XML parser is parsing an XML fragment.")
(defvar xml-validating-parser nil
"Set to non-nil to get validity checking.")
would be represented by
- '(\"\" . \"foo\")."
+ '(\"\" . \"foo\").
+
+If you'd just like a plain symbol instead, use 'symbol-qnames in
+the PARSE-NS argument."
(car node))
See also `xml-get-attribute-or-nil'."
(or (xml-get-attribute-or-nil node attribute) ""))
-;;*******************************************************************
-;;**
-;;** Creating the list
-;;**
-;;*******************************************************************
+;;; Regular expressions for XML components
-;;;###autoload
-(defun xml-parse-file (file &optional parse-dtd parse-ns)
- "Parse the well-formed XML file FILE.
-If FILE is already visited, use its buffer and don't kill it.
-Returns the top node with all its children.
-If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
-If PARSE-NS is non-nil, then QNAMES are expanded."
- (if (get-file-buffer file)
- (with-current-buffer (get-file-buffer file)
- (save-excursion
- (xml-parse-region (point-min)
- (point-max)
- (current-buffer)
- parse-dtd parse-ns)))
- (with-temp-buffer
- (insert-file-contents file)
- (xml-parse-region (point-min)
- (point-max)
- (current-buffer)
- parse-dtd parse-ns))))
-
-
-(defvar xml-name-re)
-(defvar xml-entity-value-re)
-(defvar xml-att-def-re)
-(let* ((start-chars (concat "[:alpha:]:_"))
- (name-chars (concat "-[:digit:]." start-chars))
- ;;[3] S ::= (#x20 | #x9 | #xD | #xA)+
- (whitespace "[ \t\n\r]"))
- ;;[4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6]
- ;; | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF]
- ;; | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF]
- ;; | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF]
- (defvar xml-name-start-char-re (concat "[" start-chars "]"))
- ;;[4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]
- (defvar xml-name-char-re (concat "[" name-chars "]"))
- ;;[5] Name ::= NameStartChar (NameChar)*
- (defvar xml-name-re (concat xml-name-start-char-re xml-name-char-re "*"))
- ;;[6] Names ::= Name (#x20 Name)*
- (defvar xml-names-re (concat xml-name-re "\\(?: " xml-name-re "\\)*"))
- ;;[7] Nmtoken ::= (NameChar)+
- (defvar xml-nmtoken-re (concat xml-name-char-re "+"))
- ;;[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)*
- (defvar xml-nmtokens-re (concat xml-nmtoken-re "\\(?: " xml-name-re "\\)*"))
- ;;[66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';'
- (defvar xml-char-ref-re "\\(?:&#[0-9]+;\\|&#x[0-9a-fA-F]+;\\)")
- ;;[68] EntityRef ::= '&' Name ';'
- (defvar xml-entity-ref (concat "&" xml-name-re ";"))
- ;;[69] PEReference ::= '%' Name ';'
- (defvar xml-pe-reference-re (concat "%" xml-name-re ";"))
- ;;[67] Reference ::= EntityRef | CharRef
- (defvar xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)"))
- ;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"
- (defvar xml-att-value-re (concat "\\(?:\"\\(?:[^&\"]\\|" xml-reference-re "\\)*\"\\|"
- "'\\(?:[^&']\\|" xml-reference-re "\\)*'\\)"))
- ;;[56] TokenizedType ::= 'ID' [VC: ID] [VC: One ID per Element Type] [VC: ID Attribute Default]
- ;; | 'IDREF' [VC: IDREF]
- ;; | 'IDREFS' [VC: IDREF]
- ;; | 'ENTITY' [VC: Entity Name]
- ;; | 'ENTITIES' [VC: Entity Name]
- ;; | 'NMTOKEN' [VC: Name Token]
- ;; | 'NMTOKENS' [VC: Name Token]
- (defvar xml-tokenized-type-re "\\(?:ID\\|IDREF\\|IDREFS\\|ENTITY\\|ENTITIES\\|NMTOKEN\\|NMTOKENS\\)")
- ;;[58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'
- (defvar xml-notation-type-re (concat "\\(?:NOTATION" whitespace "(" whitespace "*" xml-name-re
- "\\(?:" whitespace "*|" whitespace "*" xml-name-re "\\)*" whitespace "*)\\)"))
- ;;[59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' [VC: Enumeration] [VC: No Duplicate Tokens]
- (defvar xml-enumeration-re (concat "\\(?:(" whitespace "*" xml-nmtoken-re
- "\\(?:" whitespace "*|" whitespace "*" xml-nmtoken-re "\\)*"
- whitespace ")\\)"))
- ;;[57] EnumeratedType ::= NotationType | Enumeration
- (defvar xml-enumerated-type-re (concat "\\(?:" xml-notation-type-re "\\|" xml-enumeration-re "\\)"))
- ;;[54] AttType ::= StringType | TokenizedType | EnumeratedType
- ;;[55] StringType ::= 'CDATA'
- (defvar xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re "\\|" xml-notation-type-re"\\|" xml-enumerated-type-re "\\)"))
- ;;[60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)
- (defvar xml-default-decl-re (concat "\\(?:#REQUIRED\\|#IMPLIED\\|\\(?:#FIXED" whitespace "\\)*" xml-att-value-re "\\)"))
- ;;[53] AttDef ::= S Name S AttType S DefaultDecl
- (defvar xml-att-def-re (concat "\\(?:" whitespace "*" xml-name-re
- whitespace "*" xml-att-type-re
- whitespace "*" xml-default-decl-re "\\)"))
- ;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"'
- ;; | "'" ([^%&'] | PEReference | Reference)* "'"
- (defvar xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re
- "\\|" xml-reference-re "\\)*\"\\|'\\(?:[^%&']\\|"
- xml-pe-reference-re "\\|" xml-reference-re "\\)*'\\)")))
-;;[75] ExternalID ::= 'SYSTEM' S SystemLiteral
-;; | 'PUBLIC' S PubidLiteral S SystemLiteral
-;;[76] NDataDecl ::= S 'NDATA' S
-;;[73] EntityDef ::= EntityValue| (ExternalID NDataDecl?)
-;;[71] GEDecl ::= '<!ENTITY' S Name S EntityDef S? '>'
-;;[74] PEDef ::= EntityValue | ExternalID
-;;[72] PEDecl ::= '<!ENTITY' S '%' S Name S PEDef S? '>'
-;;[70] EntityDecl ::= GEDecl | PEDecl
+;; The following regexps are used as subexpressions in regexps that
+;; are `eval-when-compile'd for efficiency, so they must be defined at
+;; compile time.
+(eval-and-compile
+
+;; [4] NameStartChar
+;; See the definition of word syntax in `xml-syntax-table'.
+(defconst xml-name-start-char-re (concat "[[:word:]:_]"))
+
+;; [4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7
+;; | [#x0300-#x036F] | [#x203F-#x2040]
+(defconst xml-name-char-re (concat "[-0-9.[:word:]:_·̀-ͯ‿-⁀]"))
+
+;; [5] Name ::= NameStartChar (NameChar)*
+(defconst xml-name-re (concat xml-name-start-char-re xml-name-char-re "*"))
+
+;; [6] Names ::= Name (#x20 Name)*
+(defconst xml-names-re (concat xml-name-re "\\(?: " xml-name-re "\\)*"))
+
+;; [7] Nmtoken ::= (NameChar)+
+(defconst xml-nmtoken-re (concat xml-name-char-re "+"))
+
+;; [8] Nmtokens ::= Nmtoken (#x20 Nmtoken)*
+(defconst xml-nmtokens-re (concat xml-nmtoken-re "\\(?: " xml-name-re "\\)*"))
+
+;; [66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';'
+(defconst xml-char-ref-re "\\(?:&#[0-9]+;\\|&#x[0-9a-fA-F]+;\\)")
+
+;; [68] EntityRef ::= '&' Name ';'
+(defconst xml-entity-ref (concat "&" xml-name-re ";"))
+
+(defconst xml-entity-or-char-ref-re (concat "&\\(?:#\\(x\\)?\\([0-9]+\\)\\|\\("
+ xml-name-re "\\)\\);"))
+
+;; [69] PEReference ::= '%' Name ';'
+(defconst xml-pe-reference-re (concat "%\\(" xml-name-re "\\);"))
+
+;; [67] Reference ::= EntityRef | CharRef
+(defconst xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)"))
+
+;; [10] AttValue ::= '"' ([^<&"] | Reference)* '"'
+;; | "'" ([^<&'] | Reference)* "'"
+(defconst xml-att-value-re (concat "\\(?:\"\\(?:[^&\"]\\|"
+ xml-reference-re "\\)*\"\\|"
+ "'\\(?:[^&']\\|" xml-reference-re
+ "\\)*'\\)"))
+
+;; [56] TokenizedType ::= 'ID'
+;; [VC: ID] [VC: One ID / Element Type] [VC: ID Attribute Default]
+;; | 'IDREF' [VC: IDREF]
+;; | 'IDREFS' [VC: IDREF]
+;; | 'ENTITY' [VC: Entity Name]
+;; | 'ENTITIES' [VC: Entity Name]
+;; | 'NMTOKEN' [VC: Name Token]
+;; | 'NMTOKENS' [VC: Name Token]
+(defconst xml-tokenized-type-re (concat "\\(?:ID\\|IDREF\\|IDREFS\\|ENTITY\\|"
+ "ENTITIES\\|NMTOKEN\\|NMTOKENS\\)"))
+
+;; [58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'
+(defconst xml-notation-type-re
+ (concat "\\(?:NOTATION\\s-+(\\s-*" xml-name-re
+ "\\(?:\\s-*|\\s-*" xml-name-re "\\)*\\s-*)\\)"))
+
+;; [59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'
+;; [VC: Enumeration] [VC: No Duplicate Tokens]
+(defconst xml-enumeration-re (concat "\\(?:(\\s-*" xml-nmtoken-re
+ "\\(?:\\s-*|\\s-*" xml-nmtoken-re
+ "\\)*\\s-+)\\)"))
+
+;; [57] EnumeratedType ::= NotationType | Enumeration
+(defconst xml-enumerated-type-re (concat "\\(?:" xml-notation-type-re
+ "\\|" xml-enumeration-re "\\)"))
+
+;; [54] AttType ::= StringType | TokenizedType | EnumeratedType
+;; [55] StringType ::= 'CDATA'
+(defconst xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re
+ "\\|" xml-notation-type-re
+ "\\|" xml-enumerated-type-re "\\)"))
+
+;; [60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)
+(defconst xml-default-decl-re (concat "\\(?:#REQUIRED\\|#IMPLIED\\|"
+ "\\(?:#FIXED\\s-+\\)*"
+ xml-att-value-re "\\)"))
+
+;; [53] AttDef ::= S Name S AttType S DefaultDecl
+(defconst xml-att-def-re (concat "\\(?:\\s-*" xml-name-re
+ "\\s-*" xml-att-type-re
+ "\\s-*" xml-default-decl-re "\\)"))
+
+;; [9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"'
+;; | "'" ([^%&'] | PEReference | Reference)* "'"
+(defconst xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|"
+ xml-pe-reference-re
+ "\\|" xml-reference-re
+ "\\)*\"\\|'\\(?:[^%&']\\|"
+ xml-pe-reference-re "\\|"
+ xml-reference-re "\\)*'\\)"))
+) ; End of `eval-when-compile'
+
+
+;; [75] ExternalID ::= 'SYSTEM' S SystemLiteral
+;; | 'PUBLIC' S PubidLiteral S SystemLiteral
+;; [76] NDataDecl ::= S 'NDATA' S
+;; [73] EntityDef ::= EntityValue| (ExternalID NDataDecl?)
+;; [71] GEDecl ::= '<!ENTITY' S Name S EntityDef S? '>'
+;; [74] PEDef ::= EntityValue | ExternalID
+;; [72] PEDecl ::= '<!ENTITY' S '%' S Name S PEDef S? '>'
+;; [70] EntityDecl ::= GEDecl | PEDecl
;; Note that this is setup so that we can do whitespace-skipping with
;; `(skip-syntax-forward " ")', inter alia. Previously this was slow
-;; compared with `re-search-forward', but that has been fixed. Also
-;; note that the standard syntax table contains other characters with
-;; whitespace syntax, like NBSP, but they are invalid in contexts in
-;; which we might skip whitespace -- specifically, they're not
-;; NameChars [XML 4].
+;; compared with `re-search-forward', but that has been fixed.
(defvar xml-syntax-table
- (let ((table (make-syntax-table)))
- ;; Get space syntax correct per XML [3].
- (dotimes (c 31)
- (modify-syntax-entry c "." table)) ; all are space in standard table
- (dolist (c '(?\t ?\n ?\r)) ; these should be space
+ ;; By default, characters have symbol syntax.
+ (let ((table (make-char-table 'syntax-table '(3))))
+ ;; The XML space chars [3], and nothing else, have space syntax.
+ (dolist (c '(?\s ?\t ?\r ?\n))
(modify-syntax-entry c " " table))
- ;; For skipping attributes.
- (modify-syntax-entry ?\" "\"" table)
- (modify-syntax-entry ?' "\"" table)
- ;; Non-alnum name chars should be symbol constituents (`-' and `_'
- ;; are OK by default).
- (modify-syntax-entry ?. "_" table)
- (modify-syntax-entry ?: "_" table)
- ;; XML [89]
- (unless (featurep 'xemacs)
- (dolist (c '(#x00B7 #x02D0 #x02D1 #x0387 #x0640 #x0E46 #x0EC6 #x3005
- #x3031 #x3032 #x3033 #x3034 #x3035 #x309D #x309E #x30FC
- #x30FD #x30FE))
- (modify-syntax-entry (decode-char 'ucs c) "w" table)))
- ;; Fixme: rest of [4]
+ ;; The characters in NameStartChar [4], aside from ':' and '_',
+ ;; have word syntax. This is used by `xml-name-start-char-re'.
+ (modify-syntax-entry '(?A . ?Z) "w" table)
+ (modify-syntax-entry '(?a . ?z) "w" table)
+ (modify-syntax-entry '(#xC0 . #xD6) "w" table)
+ (modify-syntax-entry '(#xD8 . #XF6) "w" table)
+ (modify-syntax-entry '(#xF8 . #X2FF) "w" table)
+ (modify-syntax-entry '(#x370 . #X37D) "w" table)
+ (modify-syntax-entry '(#x37F . #x1FFF) "w" table)
+ (modify-syntax-entry '(#x200C . #x200D) "w" table)
+ (modify-syntax-entry '(#x2070 . #x218F) "w" table)
+ (modify-syntax-entry '(#x2C00 . #x2FEF) "w" table)
+ (modify-syntax-entry '(#x3001 . #xD7FF) "w" table)
+ (modify-syntax-entry '(#xF900 . #xFDCF) "w" table)
+ (modify-syntax-entry '(#xFDF0 . #xFFFD) "w" table)
+ (modify-syntax-entry '(#x10000 . #xEFFFF) "w" table)
table)
- "Syntax table used by `xml-parse-region'.")
+ "Syntax table used by the XML parser.
+In this syntax table, the XML space characters [ \\t\\r\\n], and
+only those characters, have whitespace syntax.")
-;; XML [5]
-;; Note that [:alpha:] matches all multibyte chars with word syntax.
-(eval-and-compile
- (defconst xml-name-regexp "[[:alpha:]_:][[:alnum:]._:-]*"))
+;;; Entry points:
-;; Fixme: This needs re-writing to deal with the XML grammar properly, i.e.
-;; document ::= prolog element Misc*
-;; prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
+;;;###autoload
+(defun xml-parse-file (file &optional parse-dtd parse-ns)
+ "Parse the well-formed XML file FILE.
+Return the top node with all its children.
+If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
+
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST)."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (xml--parse-buffer parse-dtd parse-ns)))
;;;###autoload
-(defun xml-parse-region (beg end &optional buffer parse-dtd parse-ns)
+(defun xml-parse-region (&optional beg end buffer parse-dtd parse-ns)
"Parse the region from BEG to END in BUFFER.
+Return the XML parse tree, or raise an error if the region does
+not contain well-formed XML.
+
+If BEG is nil, it defaults to `point-min'.
+If END is nil, it defaults to `point-max'.
If BUFFER is nil, it defaults to the current buffer.
-Returns the XML list for the region, or raises an error if the region
-is not well-formed XML.
-If PARSE-DTD is non-nil, the DTD is parsed rather than skipped,
-and returned as the first element of the list.
-If PARSE-NS is non-nil, then QNAMES are expanded."
+If PARSE-DTD is non-nil, parse the DTD and return it as the first
+element of the list.
+If PARSE-NS is non-nil, then QNAMES are expanded. By default,
+the variable `xml-default-ns' is the mapping from namespaces to
+URIs, and expanded names will be returned as a cons
+
+ (\"namespace:\" . \"foo\").
+
+If PARSE-NS is an alist, it will be used as the mapping from
+namespace to URIs instead.
+
+If it is the symbol 'symbol-qnames, expanded names will be
+returned as a plain symbol 'namespace:foo instead of a cons.
+
+Both features can be combined by providing a cons cell
+
+ (symbol-qnames . ALIST)."
;; Use fixed syntax table to ensure regexp char classes and syntax
;; specs DTRT.
- (with-syntax-table (standard-syntax-table)
+ (unless buffer
+ (setq buffer (current-buffer)))
+ (with-temp-buffer
+ (insert-buffer-substring-no-properties buffer beg end)
+ (xml--parse-buffer parse-dtd parse-ns)))
+
+;; XML [5]
+
+;; Fixme: This needs re-writing to deal with the XML grammar properly, i.e.
+;; document ::= prolog element Misc*
+;; prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
+
+(defun xml--parse-buffer (parse-dtd parse-ns)
+ (with-syntax-table xml-syntax-table
(let ((case-fold-search nil) ; XML is case-sensitive.
+ ;; Prevent entity definitions from changing the defaults
+ (xml-entity-alist xml-entity-alist)
+ (xml-parameter-entity-alist xml-parameter-entity-alist)
xml result dtd)
- (save-excursion
- (if buffer
- (set-buffer buffer))
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (not (eobp))
- (if (search-forward "<" nil t)
- (progn
- (forward-char -1)
- (setq result (xml-parse-tag parse-dtd parse-ns))
- (cond
- ((null result)
- ;; Not looking at an xml start tag.
- (unless (eobp)
- (forward-char 1)))
- ((and xml (not xml-sub-parser))
- ;; Translation of rule [1] of XML specifications
- (error "XML: (Not Well-Formed) Only one root tag allowed"))
- ((and (listp (car result))
- parse-dtd)
- (setq dtd (car result))
- (if (cdr result) ; possible leading comment
- (add-to-list 'xml (cdr result))))
- (t
- (add-to-list 'xml result))))
- (goto-char (point-max))))
- (if parse-dtd
- (cons dtd (nreverse xml))
- (nreverse xml)))))))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (search-forward "<" nil t)
+ (progn
+ (forward-char -1)
+ (setq result (xml-parse-tag-1 parse-dtd parse-ns))
+ (cond
+ ((null result)
+ ;; Not looking at an xml start tag.
+ (unless (eobp)
+ (forward-char 1)))
+ ((and xml (not xml-sub-parser))
+ ;; Translation of rule [1] of XML specifications
+ (error "XML: (Not Well-Formed) Only one root tag allowed"))
+ ((and (listp (car result))
+ parse-dtd)
+ (setq dtd (car result))
+ (if (cdr result) ; possible leading comment
+ (add-to-list 'xml (cdr result))))
+ (t
+ (add-to-list 'xml result))))
+ (goto-char (point-max))))
+ (if parse-dtd
+ (cons dtd (nreverse xml))
+ (nreverse xml)))))
(defun xml-maybe-do-ns (name default xml-ns)
"Perform any namespace expansion.
During namespace-aware parsing, any name without a namespace is
put into the namespace identified by DEFAULT. nil is used to
-specify that the name shouldn't be given a namespace."
+specify that the name shouldn't be given a namespace.
+Expanded names will by default be returned as a cons. If you
+would like to get plain symbols instead, provide a cons cell
+
+ (symbol-qnames . ALIST)
+
+in the XML-NS argument."
(if (consp xml-ns)
- (let* ((nsp (string-match ":" name))
+ (let* ((symbol-qnames (eq (car-safe xml-ns) 'symbol-qnames))
+ (nsp (string-match ":" name))
(lname (if nsp (substring name (match-end 0)) name))
(prefix (if nsp (substring name 0 (match-beginning 0)) default))
(special (and (string-equal lname "xmlns") (not prefix)))
;; Setting default to nil will insure that there is not
;; matching cons in xml-ns. In which case we
(ns (or (cdr (assoc (if special "xmlns" prefix)
- xml-ns))
+ (if symbol-qnames (cdr xml-ns) xml-ns)))
"")))
- (cons ns (if special "" lname)))
+ (if (and symbol-qnames
+ (not (string= prefix "xmlns")))
+ (intern (concat ns lname))
+ (cons ns (if special "" lname))))
(intern name)))
-(defun xml-parse-fragment (&optional parse-dtd parse-ns)
- "Parse xml-like fragments."
- (let ((xml-sub-parser t)
- children)
- (while (not (eobp))
- (let ((bit (xml-parse-tag
- parse-dtd parse-ns)))
- (if children
- (setq children (append (list bit) children))
- (if (stringp bit)
- (setq children (list bit))
- (setq children bit)))))
- (reverse children)))
-
(defun xml-parse-tag (&optional parse-dtd parse-ns)
"Parse the tag at point.
If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and
returned as the first element in the list.
-If PARSE-NS is non-nil, then QNAMES are expanded.
-Returns one of:
+If PARSE-NS is non-nil, expand QNAMES; for further details, see
+`xml-parse-region'.
+
+Return one of:
- a list : the matching node
- nil : the point is not looking at a tag.
- a pair : the first element is the DTD, the second is the node."
- (let ((xml-validating-parser (or parse-dtd xml-validating-parser))
- (xml-ns (if (consp parse-ns)
- parse-ns
- (if parse-ns
- (list
- ;; Default for empty prefix is no namespace
- (cons "" "")
- ;; "xml" namespace
- (cons "xml" "http://www.w3.org/XML/1998/namespace")
- ;; We need to seed the xmlns namespace
- (cons "xmlns" "http://www.w3.org/2000/xmlns/"))))))
+ (let* ((case-fold-search nil)
+ ;; Prevent entity definitions from changing the defaults
+ (xml-entity-alist xml-entity-alist)
+ (xml-parameter-entity-alist xml-parameter-entity-alist)
+ (buf (current-buffer))
+ (pos (point)))
+ (with-temp-buffer
+ (with-syntax-table xml-syntax-table
+ (insert-buffer-substring-no-properties buf pos)
+ (goto-char (point-min))
+ (xml-parse-tag-1 parse-dtd parse-ns)))))
+
+(defun xml-parse-tag-1 (&optional parse-dtd parse-ns)
+ "Like `xml-parse-tag', but possibly modify the buffer while working."
+ (let* ((xml-validating-parser (or parse-dtd xml-validating-parser))
+ (xml-ns
+ (cond ((eq parse-ns 'symbol-qnames)
+ (cons 'symbol-qnames xml-default-ns))
+ ((or (consp (car-safe parse-ns))
+ (and (eq (car-safe parse-ns) 'symbol-qnames)
+ (listp (cdr parse-ns))))
+ parse-ns)
+ (parse-ns
+ xml-default-ns))))
(cond
- ;; Processing instructions (like the <?xml version="1.0"?> tag at the
- ;; beginning of a document).
+ ;; Processing instructions, like <?xml version="1.0"?>.
((looking-at "<\\?")
(search-forward "?>")
(skip-syntax-forward " ")
- (xml-parse-tag parse-dtd xml-ns))
- ;; Character data (CDATA) sections, in which no tag should be interpreted
+ (xml-parse-tag-1 parse-dtd xml-ns))
+ ;; Character data (CDATA) sections, in which no tag should be interpreted
((looking-at "<!\\[CDATA\\[")
(let ((pos (match-end 0)))
(unless (search-forward "]]>" nil t)
(concat
(buffer-substring-no-properties pos (match-beginning 0))
(xml-parse-string))))
- ;; DTD for the document
- ((looking-at "<!DOCTYPE")
+ ;; DTD for the document
+ ((looking-at "<!DOCTYPE[ \t\n\r]")
(let ((dtd (xml-parse-dtd parse-ns)))
(skip-syntax-forward " ")
(if xml-validating-parser
- (cons dtd (xml-parse-tag nil xml-ns))
- (xml-parse-tag nil xml-ns))))
- ;; skip comments
+ (cons dtd (xml-parse-tag-1 nil xml-ns))
+ (xml-parse-tag-1 nil xml-ns))))
+ ;; skip comments
((looking-at "<!--")
(search-forward "-->")
+ ;; FIXME: This loses the skipped-over spaces.
(skip-syntax-forward " ")
(unless (eobp)
- (xml-parse-tag parse-dtd xml-ns)))
- ;; end tag
+ (let ((xml-sub-parser t))
+ (xml-parse-tag-1 parse-dtd xml-ns))))
+ ;; end tag
((looking-at "</")
'())
- ;; opening tag
- ((looking-at "<\\([^/>[:space:]]+\\)")
+ ;; opening tag
+ ((looking-at (eval-when-compile (concat "<\\(" xml-name-re "\\)")))
(goto-char (match-end 1))
-
;; Parse this node
(let* ((node-name (match-string-no-properties 1))
;; Parse the attribute list.
(attrs (xml-parse-attlist xml-ns))
children)
-
;; add the xmlns:* attrs to our cache
(when (consp xml-ns)
(dolist (attr attrs)
(equal "http://www.w3.org/2000/xmlns/"
(caar attr)))
(push (cons (cdar attr) (cdr attr))
- xml-ns))))
-
+ (if (symbolp (car xml-ns))
+ (cdr xml-ns)
+ xml-ns)))))
(setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns)))
+ (cond
+ ;; is this an empty element ?
+ ((looking-at "/>")
+ (forward-char 2)
+ (nreverse children))
+ ;; is this a valid start tag ?
+ ((eq (char-after) ?>)
+ (forward-char 1)
+ ;; Now check that we have the right end-tag.
+ (let ((end (concat "</" node-name "\\s-*>")))
+ (while (not (looking-at end))
+ (cond
+ ((eobp)
+ (error "XML: (Not Well-Formed) End of document while reading element `%s'"
+ node-name))
+ ((looking-at "</")
+ (forward-char 2)
+ (error "XML: (Not Well-Formed) Invalid end tag `%s' (expecting `%s')"
+ (let ((pos (point)))
+ (buffer-substring pos (if (re-search-forward "\\s-*>" nil t)
+ (match-beginning 0)
+ (point-max))))
+ node-name))
+ ;; Read a sub-element and push it onto CHILDREN.
+ ((= (char-after) ?<)
+ (let ((tag (xml-parse-tag-1 nil xml-ns)))
+ (when tag
+ (push tag children))))
+ ;; Read some character data.
+ (t
+ (let ((expansion (xml-parse-string)))
+ (push (if (stringp (car children))
+ ;; If two strings were separated by a
+ ;; comment, concat them.
+ (concat (pop children) expansion)
+ expansion)
+ children)))))
+ ;; Move point past the end-tag.
+ (goto-char (match-end 0))
+ (nreverse children)))
+ ;; Otherwise this was an invalid start tag (expected ">" not found.)
+ (t
+ (error "XML: (Well-Formed) Couldn't parse tag: %s"
+ (buffer-substring-no-properties (- (point) 10) (+ (point) 1)))))))
- ;; is this an empty element ?
- (if (looking-at "/>")
- (progn
- (forward-char 2)
- (nreverse children))
-
- ;; is this a valid start tag ?
- (if (eq (char-after) ?>)
- (progn
- (forward-char 1)
- ;; Now check that we have the right end-tag. Note that this
- ;; one might contain spaces after the tag name
- (let ((end (concat "</" node-name "\\s-*>")))
- (while (not (looking-at end))
- (cond
- ((looking-at "</")
- (error "XML: (Not Well-Formed) Invalid end tag (expecting %s) at pos %d"
- node-name (point)))
- ((= (char-after) ?<)
- (let ((tag (xml-parse-tag nil xml-ns)))
- (when tag
- (push tag children))))
- (t
- (let ((expansion (xml-parse-string)))
- (setq children
- (if (stringp expansion)
- (if (stringp (car children))
- ;; The two strings were separated by a comment.
- (setq children (append (list (concat (car children) expansion))
- (cdr children)))
- (setq children (append (list expansion) children)))
- (setq children (append expansion children))))))))
-
- (goto-char (match-end 0))
- (nreverse children)))
- ;; This was an invalid start tag (Expected ">", but didn't see it.)
- (error "XML: (Well-Formed) Couldn't parse tag: %s"
- (buffer-substring-no-properties (- (point) 10) (+ (point) 1)))))))
- (t ;; (Not one of PI, CDATA, Comment, End tag, or Start tag)
- (unless xml-sub-parser ; Usually, we error out.
+ ;; (Not one of PI, CDATA, Comment, End tag, or Start tag)
+ (t
+ (unless xml-sub-parser ; Usually, we error out.
(error "XML: (Well-Formed) Invalid character"))
-
;; However, if we're parsing incrementally, then we need to deal
;; with stray CDATA.
(xml-parse-string)))))
(defun xml-parse-string ()
- "Parse the next whatever. Could be a string, or an element."
- (let* ((pos (point))
- (string (progn (skip-chars-forward "^<")
- (buffer-substring-no-properties pos (point)))))
- ;; Clean up the string. As per XML specifications, the XML
- ;; processor should always pass the whole string to the
- ;; application. But \r's should be replaced:
- ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends
- (setq pos 0)
- (while (string-match "\r\n?" string pos)
- (setq string (replace-match "\n" t t string))
- (setq pos (1+ (match-beginning 0))))
-
- (xml-substitute-special string)))
+ "Parse character data at point, and return it as a string.
+Leave point at the start of the next thing to parse. This
+function can modify the buffer by expanding entity and character
+references."
+ (let ((start (point))
+ ;; Keep track of the size of the rest of the buffer:
+ (old-remaining-size (- (buffer-size) (point)))
+ ref val)
+ (while (and (not (eobp))
+ (not (looking-at "<")))
+ ;; Find the next < or & character.
+ (skip-chars-forward "^<&")
+ (when (eq (char-after) ?&)
+ ;; If we find an entity or character reference, expand it.
+ (unless (looking-at xml-entity-or-char-ref-re)
+ (error "XML: (Not Well-Formed) Invalid entity reference"))
+ ;; For a character reference, the next entity or character
+ ;; reference must be after the replacement. [4.6] "Numerical
+ ;; character references are expanded immediately when
+ ;; recognized and MUST be treated as character data."
+ (if (setq ref (match-string 2))
+ (progn ; Numeric char reference
+ (setq val (save-match-data
+ (decode-char 'ucs (string-to-number
+ ref (if (match-string 1) 16)))))
+ (and (null val)
+ xml-validating-parser
+ (error "XML: (Validity) Invalid character reference `%s'"
+ (match-string 0)))
+ (replace-match (or (string val) xml-undefined-entity) t t))
+ ;; For an entity reference, search again from the start of
+ ;; the replaced text, since the replacement can contain
+ ;; entity or character references, or markup.
+ (setq ref (match-string 3)
+ val (assoc ref xml-entity-alist))
+ (and (null val)
+ xml-validating-parser
+ (error "XML: (Validity) Undefined entity `%s'" ref))
+ (replace-match (cdr val) t t)
+ (goto-char (match-beginning 0)))
+ ;; Check for XML bombs.
+ (and xml-entity-expansion-limit
+ (> (- (buffer-size) (point))
+ (+ old-remaining-size xml-entity-expansion-limit))
+ (error "XML: Entity reference expansion \
+surpassed `xml-entity-expansion-limit'"))))
+ ;; [2.11] Clean up line breaks.
+ (let ((end-marker (point-marker)))
+ (goto-char start)
+ (while (re-search-forward "\r\n?" end-marker t)
+ (replace-match "\n" t t))
+ (goto-char end-marker)
+ (buffer-substring start (point)))))
(defun xml-parse-attlist (&optional xml-ns)
"Return the attribute-list after point.
end-pos name)
(skip-syntax-forward " ")
(while (looking-at (eval-when-compile
- (concat "\\(" xml-name-regexp "\\)\\s-*=\\s-*")))
+ (concat "\\(" xml-name-re "\\)\\s-*=\\s-*")))
(setq end-pos (match-end 0))
(setq name (xml-maybe-do-ns (match-string-no-properties 1) nil xml-ns))
(goto-char end-pos)
(replace-regexp-in-string "\\s-\\{2,\\}" " " string)
(let ((expansion (xml-substitute-special string)))
(unless (stringp expansion)
- ; We say this is the constraint. It is actually that neither
- ; external entities nor "<" can be in an attribute value.
+ ;; We say this is the constraint. It is actually that
+ ;; neither external entities nor "<" can be in an
+ ;; attribute value.
(error "XML: (Not Well-Formed) Entities in attributes cannot expand into elements"))
(push (cons name expansion) attlist)))
(skip-syntax-forward " "))
(nreverse attlist)))
-;;*******************************************************************
-;;**
-;;** The DTD (document type declaration)
-;;** The following functions know how to skip or parse the DTD of
-;;** a document
-;;**
-;;*******************************************************************
+;;; DTD (document type declaration)
-;; Fixme: This fails at least if the DTD contains conditional sections.
+;; The following functions know how to skip or parse the DTD of a
+;; document. FIXME: it fails at least if the DTD contains conditional
+;; sections.
(defun xml-skip-dtd ()
"Skip the DTD at point.
(error "XML: (Validity) Invalid DTD (expecting name of the document)"))
;; Get the name of the document
- (looking-at xml-name-regexp)
+ (looking-at xml-name-re)
(let ((dtd (list (match-string-no-properties 0) 'dtd))
- type element end-pos)
+ (xml-parameter-entity-alist xml-parameter-entity-alist)
+ next-parameter-entity)
(goto-char (match-end 0))
-
(skip-syntax-forward " ")
- ;; XML [75]
+
+ ;; External subset (XML [75])
(cond ((looking-at "PUBLIC\\s-+")
(goto-char (match-end 0))
(unless (or (re-search-forward
(error "XML: Missing System ID"))
(push (list (match-string-no-properties 1) 'system) dtd)))
(skip-syntax-forward " ")
- (if (eq ?> (char-after))
- (forward-char)
- (if (not (eq (char-after) ?\[))
- (error "XML: Bad DTD")
+
+ (if (eq (char-after) ?>)
+
+ ;; No internal subset
(forward-char)
- ;; Parse the rest of the DTD
- ;; Fixme: Deal with NOTATION, PIs.
- (while (not (looking-at "\\s-*\\]"))
- (skip-syntax-forward " ")
- (cond
-
- ;; Translation of rule [45] of XML specifications
- ((looking-at
- "<!ELEMENT\\s-+\\([[:alnum:].%;]+\\)\\s-+\\([^>]+\\)>")
-
- (setq element (match-string-no-properties 1)
- type (match-string-no-properties 2))
- (setq end-pos (match-end 0))
- ;; Translation of rule [46] of XML specifications
+ ;; Internal subset (XML [28b])
+ (unless (eq (char-after) ?\[)
+ (error "XML: Bad DTD"))
+ (forward-char)
+
+ ;; [2.8]: "markup declarations may be made up in whole or in
+ ;; part of the replacement text of parameter entities."
+
+ ;; Since parameter entities are valid only within the DTD, we
+ ;; first search for the position of the next possible parameter
+ ;; entity. Then, search for the next DTD element; if it ends
+ ;; before the next parameter entity, expand the parameter entity
+ ;; and try again.
+ (setq next-parameter-entity
+ (save-excursion
+ (if (re-search-forward xml-pe-reference-re nil t)
+ (match-beginning 0))))
+
+ ;; Parse the rest of the DTD
+ ;; Fixme: Deal with NOTATION, PIs.
+ (while (not (looking-at "\\s-*\\]"))
+ (skip-syntax-forward " ")
+ (cond
+ ((eobp)
+ (error "XML: (Well-Formed) End of document while reading DTD"))
+ ;; Element declaration [45]:
+ ((and (looking-at (eval-when-compile
+ (concat "<!ELEMENT\\s-+\\(" xml-name-re
+ "\\)\\s-+\\([^>]+\\)>")))
+ (or (null next-parameter-entity)
+ (<= (match-end 0) next-parameter-entity)))
+ (let ((element (match-string-no-properties 1))
+ (type (match-string-no-properties 2))
+ (end-pos (match-end 0)))
+ ;; Translation of rule [46] of XML specifications
(cond
- ((string-match "^EMPTY[ \t\n\r]*$" type) ;; empty declaration
+ ((string-match "\\`EMPTY\\s-*\\'" type) ; empty declaration
(setq type 'empty))
- ((string-match "^ANY[ \t\n\r]*$" type) ;; any type of contents
+ ((string-match "\\`ANY\\s-*$" type) ; any type of contents
(setq type 'any))
- ((string-match "^(\\(.*\\))[ \t\n\r]*$" type) ;; children ([47])
- (setq type (xml-parse-elem-type (match-string-no-properties 1 type))))
- ((string-match "^%[^;]+;[ \t\n\r]*$" type) ;; substitution
+ ((string-match "\\`(\\(.*\\))\\s-*\\'" type) ; children ([47])
+ (setq type (xml-parse-elem-type
+ (match-string-no-properties 1 type))))
+ ((string-match "^%[^;]+;[ \t\n\r]*\\'" type) ; substitution
nil)
- (t
- (if xml-validating-parser
- (error "XML: (Validity) Invalid element type in the DTD"))))
+ (xml-validating-parser
+ (error "XML: (Validity) Invalid element type in the DTD")))
- ;; rule [45]: the element declaration must be unique
- (if (and (assoc element dtd)
- xml-validating-parser)
- (error "XML: (Validity) Element declarations must be unique in a DTD (<%s>)"
- element))
+ ;; rule [45]: the element declaration must be unique
+ (and (assoc element dtd)
+ xml-validating-parser
+ (error "XML: (Validity) DTD element declarations must be unique (<%s>)"
+ element))
;; Store the element in the DTD
(push (list element type) dtd)
- (goto-char end-pos))
-
- ;; Translation of rule [52] of XML specifications
- ((looking-at (concat "<!ATTLIST[ \t\n\r]*\\(" xml-name-re
- "\\)[ \t\n\r]*\\(" xml-att-def-re
- "\\)*[ \t\n\r]*>"))
-
- ;; We don't do anything with ATTLIST currently
- (goto-char (match-end 0)))
-
- ((looking-at "<!--")
- (search-forward "-->"))
- ((looking-at (concat "<!ENTITY[ \t\n\r]*\\(" xml-name-re
- "\\)[ \t\n\r]*\\(" xml-entity-value-re
- "\\)[ \t\n\r]*>"))
- (let ((name (match-string-no-properties 1))
- (value (substring (match-string-no-properties 2) 1
- (- (length (match-string-no-properties 2)) 1))))
- (goto-char (match-end 0))
- (setq xml-entity-alist
- (append xml-entity-alist
- (list (cons name
- (with-temp-buffer
- (insert value)
- (goto-char (point-min))
- (xml-parse-fragment
- xml-validating-parser
- parse-ns))))))))
- ((or (looking-at (concat "<!ENTITY[ \t\n\r]+\\(" xml-name-re
- "\\)[ \t\n\r]+SYSTEM[ \t\n\r]+"
- "\\(\"[^\"]*\"\\|'[^']*'\\)[ \t\n\r]*>"))
- (looking-at (concat "<!ENTITY[ \t\n\r]+\\(" xml-name-re
- "\\)[ \t\n\r]+PUBLIC[ \t\n\r]+"
- "\"[- \r\na-zA-Z0-9'()+,./:=?;!*#@$_%]*\""
- "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'"
- "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)"
- "[ \t\n\r]*>")))
- (let ((name (match-string-no-properties 1))
- (file (substring (match-string-no-properties 2) 1
- (- (length (match-string-no-properties 2)) 1))))
- (goto-char (match-end 0))
- (setq xml-entity-alist
- (append xml-entity-alist
- (list (cons name (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (xml-parse-fragment
- xml-validating-parser
- parse-ns))))))))
- ;; skip parameter entity declarations
- ((or (looking-at (concat "<!ENTITY[ \t\n\r]+%[ \t\n\r]+\\(" xml-name-re
- "\\)[ \t\n\r]+SYSTEM[ \t\n\r]+"
- "\\(\"[^\"]*\"\\|'[^']*'\\)[ \t\n\r]*>"))
- (looking-at (concat "<!ENTITY[ \t\n\r]+"
- "%[ \t\n\r]+"
- "\\(" xml-name-re "\\)[ \t\n\r]+"
- "PUBLIC[ \t\n\r]+"
- "\\(\"[- \r\na-zA-Z0-9'()+,./:=?;!*#@$_%]*\""
- "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'\\)[ \t\n\r]+"
- "\\(\"[^\"]+\"\\|'[^']+'\\)"
- "[ \t\n\r]*>")))
- (goto-char (match-end 0)))
- ;; skip parameter entities
- ((looking-at (concat "%" xml-name-re ";"))
- (goto-char (match-end 0)))
- (t
- (when xml-validating-parser
- (error "XML: (Validity) Invalid DTD item"))))))
+ (goto-char end-pos)))
+
+ ;; Attribute-list declaration [52] (currently unsupported):
+ ((and (looking-at (eval-when-compile
+ (concat "<!ATTLIST[ \t\n\r]*\\(" xml-name-re
+ "\\)[ \t\n\r]*\\(" xml-att-def-re
+ "\\)*[ \t\n\r]*>")))
+ (or (null next-parameter-entity)
+ (<= (match-end 0) next-parameter-entity)))
+ (goto-char (match-end 0)))
+
+ ;; Comments (skip to end, ignoring parameter entity):
+ ((looking-at "<!--")
+ (search-forward "-->")
+ (and next-parameter-entity
+ (> (point) next-parameter-entity)
+ (setq next-parameter-entity
+ (save-excursion
+ (if (re-search-forward xml-pe-reference-re nil t)
+ (match-beginning 0))))))
+
+ ;; Internal entity declarations:
+ ((and (looking-at (eval-when-compile
+ (concat "<!ENTITY[ \t\n\r]+\\(%[ \t\n\r]+\\)?\\("
+ xml-name-re "\\)[ \t\n\r]*\\("
+ xml-entity-value-re "\\)[ \t\n\r]*>")))
+ (or (null next-parameter-entity)
+ (<= (match-end 0) next-parameter-entity)))
+ (let* ((name (prog1 (match-string-no-properties 2)
+ (goto-char (match-end 0))))
+ (alist (if (match-string 1)
+ 'xml-parameter-entity-alist
+ 'xml-entity-alist))
+ ;; Retrieve the deplacement text:
+ (value (xml--entity-replacement-text
+ ;; Entity value, sans quotation marks:
+ (substring (match-string-no-properties 3) 1 -1))))
+ ;; If the same entity is declared more than once, the
+ ;; first declaration is binding.
+ (unless (assoc name (symbol-value alist))
+ (set alist (cons (cons name value) (symbol-value alist))))))
+
+ ;; External entity declarations (currently unsupported):
+ ((and (or (looking-at (eval-when-compile
+ (concat "<!ENTITY[ \t\n\r]+\\(%[ \t\n\r]+\\)?\\("
+ xml-name-re "\\)[ \t\n\r]+SYSTEM[ \t\n\r]+"
+ "\\(\"[^\"]*\"\\|'[^']*'\\)[ \t\n\r]*>")))
+ (looking-at (eval-when-compile
+ (concat "<!ENTITY[ \t\n\r]+\\(%[ \t\n\r]+\\)?\\("
+ xml-name-re "\\)[ \t\n\r]+PUBLIC[ \t\n\r]+"
+ "\"[- \r\na-zA-Z0-9'()+,./:=?;!*#@$_%]*\""
+ "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'"
+ "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)"
+ "[ \t\n\r]*>"))))
+ (or (null next-parameter-entity)
+ (<= (match-end 0) next-parameter-entity)))
+ (goto-char (match-end 0)))
+
+ ;; If a parameter entity is in the way, expand it.
+ (next-parameter-entity
+ (save-excursion
+ (goto-char next-parameter-entity)
+ (unless (looking-at xml-pe-reference-re)
+ (error "XML: Internal error"))
+ (let* ((entity (match-string 1))
+ (beg (point-marker))
+ (elt (assoc entity xml-parameter-entity-alist)))
+ (if elt
+ (progn
+ (replace-match (cdr elt) t t)
+ ;; The replacement can itself be a parameter entity.
+ (goto-char next-parameter-entity))
+ (goto-char (match-end 0))))
+ (setq next-parameter-entity
+ (if (re-search-forward xml-pe-reference-re nil t)
+ (match-beginning 0)))))
+
+ ;; Anything else is garbage (ignored if not validating).
+ (xml-validating-parser
+ (error "XML: (Validity) Invalid DTD item"))
+ (t
+ (skip-chars-forward "^]"))))
+
(if (looking-at "\\s-*]>")
(goto-char (match-end 0))))
(nreverse dtd)))
+(defun xml--entity-replacement-text (string)
+ "Return the replacement text for the entity value STRING.
+The replacement text is obtained by replacing character
+references and parameter-entity references."
+ (let ((ref-re (eval-when-compile
+ (concat "\\(?:&#\\([0-9]+\\)\\|&#x\\([0-9a-fA-F]+\\)\\|%\\("
+ xml-name-re "\\)\\);")))
+ children)
+ (while (string-match ref-re string)
+ (push (substring string 0 (match-beginning 0)) children)
+ (let ((remainder (substring string (match-end 0)))
+ ref val)
+ (cond ((setq ref (match-string 1 string))
+ ;; Decimal character reference
+ (setq val (decode-char 'ucs (string-to-number ref)))
+ (if val (push (string val) children)))
+ ;; Hexadecimal character reference
+ ((setq ref (match-string 2 string))
+ (setq val (decode-char 'ucs (string-to-number ref 16)))
+ (if val (push (string val) children)))
+ ;; Parameter entity reference
+ ((setq ref (match-string 3 string))
+ (setq val (assoc ref xml-parameter-entity-alist))
+ (and (null val)
+ xml-validating-parser
+ (error "XML: (Validity) Undefined parameter entity `%s'" ref))
+ (push (or (cdr val) xml-undefined-entity) children)))
+ (setq string remainder)))
+ (mapconcat 'identity (nreverse (cons string children)) "")))
+
(defun xml-parse-elem-type (string)
"Convert element type STRING into a Lisp structure."
(t
elem))))
-;;*******************************************************************
-;;**
-;;** Substituting special XML sequences
-;;**
-;;*******************************************************************
+;;; Substituting special XML sequences
(defun xml-substitute-special (string)
- "Return STRING, after substituting entity references."
- ;; This originally made repeated passes through the string from the
- ;; beginning, which isn't correct, since then either "&amp;" or
- ;; "&amp;" won't DTRT.
-
- (let ((point 0)
- children end-point)
- (while (string-match "&\\([^;]*\\);" string point)
- (setq end-point (match-end 0))
- (let* ((this-part (match-string-no-properties 1 string))
- (prev-part (substring string point (match-beginning 0)))
- (entity (assoc this-part xml-entity-alist))
- (expansion
- (cond ((string-match "#\\([0-9]+\\)" this-part)
- (let ((c (decode-char
- 'ucs
- (string-to-number (match-string-no-properties 1 this-part)))))
- (if c (string c))))
- ((string-match "#x\\([[:xdigit:]]+\\)" this-part)
- (let ((c (decode-char
- 'ucs
- (string-to-number (match-string-no-properties 1 this-part) 16))))
- (if c (string c))))
- (entity
- (cdr entity))
- ((eq (length this-part) 0)
- (error "XML: (Not Well-Formed) No entity given"))
- (t
- (if xml-validating-parser
- (error "XML: (Validity) Undefined entity `%s'"
- this-part)
- xml-undefined-entity)))))
-
- (cond ((null children)
- ;; FIXME: If we have an entity that expands into XML, this won't work.
- (setq children
- (concat prev-part expansion)))
- ((stringp children)
- (if (stringp expansion)
- (setq children (concat children prev-part expansion))
- (setq children (list expansion (concat prev-part children)))))
- ((and (stringp expansion)
- (stringp (car children)))
- (setcar children (concat prev-part expansion (car children))))
- ((stringp expansion)
- (setq children (append (concat prev-part expansion)
- children)))
- ((stringp (car children))
- (setcar children (concat (car children) prev-part))
- (setq children (append expansion children)))
- (t
- (setq children (list expansion
- prev-part
- children))))
- (setq point end-point)))
- (cond ((stringp children)
- (concat children (substring string point)))
- ((stringp (car (last children)))
- (concat (car (last children)) (substring string point)))
- ((null children)
- string)
- (t
- (concat (mapconcat 'identity
- (nreverse children)
- "")
- (substring string point))))))
+ "Return STRING, after substituting entity and character references.
+STRING is assumed to occur in an XML attribute value."
+ (let ((strlen (length string))
+ children)
+ (while (string-match xml-entity-or-char-ref-re string)
+ (push (substring string 0 (match-beginning 0)) children)
+ (let* ((remainder (substring string (match-end 0)))
+ (is-hex (match-string 1 string)) ; Is it a hex numeric reference?
+ (ref (match-string 2 string))) ; Numeric part of reference
+ (if ref
+ ;; [4.6] Character references are included as
+ ;; character data.
+ (let ((val (decode-char 'ucs (string-to-number ref (if is-hex 16)))))
+ (push (cond (val (string val))
+ (xml-validating-parser
+ (error "XML: (Validity) Undefined character `x%s'" ref))
+ (t xml-undefined-entity))
+ children)
+ (setq string remainder
+ strlen (length string)))
+ ;; [4.4.5] Entity references are "included in literal".
+ ;; Note that we don't need do anything special to treat
+ ;; quotes as normal data characters.
+ (setq ref (match-string 3 string)) ; entity name
+ (let ((val (or (cdr (assoc ref xml-entity-alist))
+ (if xml-validating-parser
+ (error "XML: (Validity) Undefined entity `%s'" ref)
+ xml-undefined-entity))))
+ (setq string (concat val remainder)))
+ (and xml-entity-expansion-limit
+ (> (length string) (+ strlen xml-entity-expansion-limit))
+ (error "XML: Passed `xml-entity-expansion-limit' while expanding `&%s;'"
+ ref)))))
+ (mapconcat 'identity (nreverse (cons string children)) "")))
(defun xml-substitute-numeric-entities (string)
"Substitute SGML numeric entities by their respective utf characters.
string)
nil))
-;;*******************************************************************
-;;**
-;;** Printing a tree.
-;;** This function is intended mainly for debugging purposes.
-;;**
-;;*******************************************************************
+;;; Printing a parse tree (mainly for debugging).
(defun xml-debug-print (xml &optional indent-string)
"Outputs the XML in the current buffer.
(defalias 'xml-print 'xml-debug-print)
(defun xml-escape-string (string)
- "Return the string with entity substitutions made from
-xml-entity-alist."
- (mapconcat (lambda (byte)
- (let ((char (char-to-string byte)))
- (if (rassoc char xml-entity-alist)
- (concat "&" (car (rassoc char xml-entity-alist)) ";")
- char)))
- ;; This differs from the non-unicode branch. Just
- ;; grabbing the string works here.
- string ""))
+ "Convert STRING into a string containing valid XML character data.
+Replace occurrences of &<>'\" in STRING with their default XML
+entity references (e.g. replace each & with &).
+
+XML character data must not contain & or < characters, nor the >
+character under some circumstances. The XML spec does not impose
+restriction on \" or ', but we just substitute for these too
+\(as is permitted by the spec)."
+ (with-temp-buffer
+ (insert string)
+ (dolist (substitution '(("&" . "&")
+ ("<" . "<")
+ (">" . ">")
+ ("'" . "'")
+ ("\"" . """)))
+ (goto-char (point-min))
+ (while (search-forward (car substitution) nil t)
+ (replace-match (cdr substitution) t t nil)))
+ (buffer-string)))
(defun xml-debug-print-internal (xml indent-string)
"Outputs the XML tree in the current buffer.
;; Mouse events symbols must have an 'event-kind property with
;; the value 'mouse-click.
(dolist (event-type '(mouse-1 mouse-2 mouse-3
- M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
+ M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
(put event-type 'event-kind 'mouse-click))
(defun xterm-mouse-translate (_event)
"Read a click and release event from XTerm."
+ (xterm-mouse-translate-1))
+
+(defun xterm-mouse-translate-extended (_event)
+ "Read a click and release event from XTerm.
+Similar to `xterm-mouse-translate', but using the \"1006\"
+extension, which supports coordinates >= 231 (see
+http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
+ (xterm-mouse-translate-1 1006))
+
+(defun xterm-mouse-translate-1 (&optional extension)
(save-excursion
(save-window-excursion
(deactivate-mark)
- (let* ((xterm-mouse-last)
- (down (xterm-mouse-event))
+ (let* ((xterm-mouse-last nil)
+ (down (xterm-mouse-event extension))
(down-command (nth 0 down))
- (down-data (nth 1 down))
- (down-where (nth 1 down-data))
+ (down-data (nth 1 down))
+ (down-where (nth 1 down-data))
(down-binding (key-binding (if (symbolp down-where)
(vector down-where down-command)
(vector down-command))))
(is-click (string-match "^mouse" (symbol-name (car down)))))
+ ;; Retrieve the expected preface for the up-event.
(unless is-click
- (unless (and (eq (read-char) ?\e)
- (eq (read-char) ?\[)
- (eq (read-char) ?M))
+ (unless (cond ((null extension)
+ (and (eq (read-event) ?\e)
+ (eq (read-event) ?\[)
+ (eq (read-event) ?M)))
+ ((eq extension 1006)
+ (and (eq (read-event) ?\e)
+ (eq (read-event) ?\[)
+ (eq (read-event) ?<))))
(error "Unexpected escape sequence from XTerm")))
- (let* ((click (if is-click down (xterm-mouse-event)))
- ;; (click-command (nth 0 click))
- (click-data (nth 1 click))
+ ;; Process the up-event.
+ (let* ((click (if is-click down (xterm-mouse-event extension)))
+ (click-data (nth 1 click))
(click-where (nth 1 click-data)))
(if (memq down-binding '(nil ignore))
(if (and (symbolp click-where)
(vector (list click-where click-data) click)
(vector click))
(setq unread-command-events
- (if (eq down-where click-where)
- (list click)
- (list
- ;; Cheat `mouse-drag-region' with move event.
- (list 'mouse-movement click-data)
- ;; Generate a drag event.
- (if (symbolp down-where)
- 0
- (list (intern (format "drag-mouse-%d"
- (+ 1 xterm-mouse-last)))
- down-data click-data)))))
+ (append (if (eq down-where click-where)
+ (list click)
+ (list
+ ;; Cheat `mouse-drag-region' with move event.
+ (list 'mouse-movement click-data)
+ ;; Generate a drag event.
+ (if (symbolp down-where)
+ 0
+ (list (intern (format "drag-mouse-%d"
+ (1+ xterm-mouse-last)))
+ down-data click-data))))
+ unread-command-events))
(if xterm-mouse-debug-buffer
(print unread-command-events xterm-mouse-debug-buffer))
(if (and (symbolp down-where)
(terminal-parameter nil 'xterm-mouse-y))))
pos)
-;; read xterm sequences above ascii 127 (#x7f)
+;; Read XTerm sequences above ASCII 127 (#x7f)
(defun xterm-mouse-event-read ()
;; We get the characters decoded by the keyboard coding system. Try
;; to recover the raw character.
- (let ((c (read-char)))
+ (let ((c (read-event)))
(cond ;; If meta-flag is t we get a meta character
((>= c ?\M-\^@)
(- c (- ?\M-\^@ 128)))
(fdiff (- f (* 1.0 maxwrap dbig))))
(+ (truncate fdiff) (* maxwrap dbig))))))
-(defun xterm-mouse-event ()
- "Convert XTerm mouse event to Emacs mouse event."
- (let* ((type (- (xterm-mouse-event-read) #o40))
- (x (- (xterm-mouse-event-read) #o40 1))
- (y (- (xterm-mouse-event-read) #o40 1))
+;; Normal terminal mouse click reporting: expect three bytes, of the
+;; form <BUTTON+32> <X+32> <Y+32>. Return a list (EVENT-TYPE X Y).
+(defun xterm-mouse--read-event-sequence-1000 ()
+ (list (let ((code (- (xterm-mouse-event-read) 32)))
+ (intern
+ ;; For buttons > 3, the release-event looks differently
+ ;; (see xc/programs/xterm/button.c, function EditorButton),
+ ;; and come in a release-event only, no down-event.
+ (cond ((>= code 64)
+ (format "mouse-%d" (- code 60)))
+ ((memq code '(8 9 10))
+ (setq xterm-mouse-last code)
+ (format "M-down-mouse-%d" (- code 7)))
+ ((= code 11)
+ (format "M-mouse-%d" (- xterm-mouse-last 7)))
+ ((= code 3)
+ ;; For buttons > 5 xterm only reports a
+ ;; button-release event. Avoid error by mapping
+ ;; them all to mouse-1.
+ (format "mouse-%d" (+ 1 (or xterm-mouse-last 0))))
+ (t
+ (setq xterm-mouse-last code)
+ (format "down-mouse-%d" (+ 1 code))))))
+ ;; x and y coordinates
+ (- (xterm-mouse-event-read) 33)
+ (- (xterm-mouse-event-read) 33)))
+
+;; XTerm's 1006-mode terminal mouse click reporting has the form
+;; <BUTTON> ; <X> ; <Y> <M or m>, where the button and ordinates are
+;; in encoded (decimal) form. Return a list (EVENT-TYPE X Y).
+(defun xterm-mouse--read-event-sequence-1006 ()
+ (let (button-bytes x-bytes y-bytes c)
+ (while (not (eq (setq c (xterm-mouse-event-read)) ?\;))
+ (push c button-bytes))
+ (while (not (eq (setq c (xterm-mouse-event-read)) ?\;))
+ (push c x-bytes))
+ (while (not (memq (setq c (xterm-mouse-event-read)) '(?m ?M)))
+ (push c y-bytes))
+ (list (let* ((code (string-to-number
+ (apply 'string (nreverse button-bytes))))
+ (wheel (>= code 64))
+ (down (and (not wheel)
+ (eq c ?M))))
+ (intern (format "%s%smouse-%d"
+ (cond (wheel "")
+ ((< code 4) "")
+ ((< code 8) "S-")
+ ((< code 12) "M-")
+ ((< code 16) "M-S-")
+ ((< code 20) "C-")
+ ((< code 24) "C-S-")
+ ((< code 28) "C-M-")
+ ((< code 32) "C-M-S-")
+ (t
+ (error "Unexpected escape sequence from XTerm")))
+ (if down "down-" "")
+ (if wheel
+ (- code 60)
+ (1+ (setq xterm-mouse-last (mod code 4)))))))
+ (1- (string-to-number (apply 'string (nreverse x-bytes))))
+ (1- (string-to-number (apply 'string (nreverse y-bytes)))))))
+
+(defun xterm-mouse-event (&optional extension)
+ "Convert XTerm mouse event to Emacs mouse event.
+EXTENSION, if non-nil, means to use an extension to the usual
+terminal mouse protocol; we currently support the value 1006,
+which is the \"1006\" extension implemented in Xterm >= 277."
+ (let* ((click (cond ((null extension)
+ (xterm-mouse--read-event-sequence-1000))
+ ((eq extension 1006)
+ (xterm-mouse--read-event-sequence-1006))
+ (t
+ (error "Unsupported XTerm mouse protocol"))))
+ (type (nth 0 click))
+ (x (nth 1 click))
+ (y (nth 2 click))
;; Emulate timestamp information. This is accurate enough
;; for default value of mouse-1-click-follows-link (450msec).
(timestamp (xterm-mouse-truncate-wrap
(- (float-time)
(or xt-mouse-epoch
(setq xt-mouse-epoch (float-time)))))))
- (mouse (intern
- ;; For buttons > 3, the release-event looks
- ;; differently (see xc/programs/xterm/button.c,
- ;; function EditorButton), and there seems to come in
- ;; a release-event only, no down-event.
- (cond ((>= type 64)
- (format "mouse-%d" (- type 60)))
- ((memq type '(8 9 10))
- (setq xterm-mouse-last type)
- (format "M-down-mouse-%d" (- type 7)))
- ((= type 11)
- (format "mouse-%d" (- xterm-mouse-last 7)))
- ((= type 3)
- ;; For buttons > 5 xterm only reports a
- ;; button-release event. Avoid error by mapping
- ;; them all to mouse-1.
- (format "mouse-%d" (+ 1 (or xterm-mouse-last 0))))
- (t
- (setq xterm-mouse-last type)
- (format "down-mouse-%d" (+ 1 type))))))
(w (window-at x y))
(ltrb (window-edges w))
(left (nth 0 ltrb))
(top (nth 1 ltrb)))
-
(set-terminal-parameter nil 'xterm-mouse-x x)
(set-terminal-parameter nil 'xterm-mouse-y y)
(setq
last-input-event
- (list mouse
+ (list type
(let ((event (if w
(posn-at-x-y (- x left) (- y top) w t)
(append (list nil 'menu-bar)
;; FIXME: is there more elegant way to detect the initial terminal?
(not (string= (terminal-name terminal) "initial_terminal")))
(unless (terminal-parameter terminal 'xterm-mouse-mode)
- ;; Simulate selecting a terminal by selecting one of its frames ;-(
+ ;; Simulate selecting a terminal by selecting one of its frames
(with-selected-frame (car (frames-on-display-list terminal))
- (define-key input-decode-map "\e[M" 'xterm-mouse-translate))
+ (define-key input-decode-map "\e[M" 'xterm-mouse-translate)
+ (define-key input-decode-map "\e[<" 'xterm-mouse-translate-extended))
(set-terminal-parameter terminal 'xterm-mouse-mode t))
- (send-string-to-terminal "\e[?1000h" terminal)))
+ (send-string-to-terminal "\e[?1000h" terminal)
+ ;; Request extended mouse support, if available (xterm >= 277).
+ (send-string-to-terminal "\e[?1006h" terminal)))
(defun turn-off-xterm-mouse-tracking-on-terminal (terminal)
"Disable xterm mouse tracking on TERMINAL."
;; command too many times (or to catch an unintended key sequence), than
;; to send it too few times (or to fail to let xterm-mouse events
;; pass by untranslated).
- (send-string-to-terminal "\e[?1000l" terminal)))
+ (send-string-to-terminal "\e[?1000l" terminal)
+ (send-string-to-terminal "\e[?1006l" terminal)))
(provide 'xt-mouse)
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-08-16 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.2 released.
+ Use ASCII tests for character types.
+ * lwlib-Xaw.c, lwlib.c, xlwmenu.c:
+ Don't include <ctype.h>; no longer needed.
+ * lwlib-Xaw.c (openFont):
+ * xlwmenu.c (openXftFont): Test just for ASCII digits.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-08-01 Glenn Morris <rgm@gnu.org>
- * Version 24.1 released.
+ * Makefile.in (config_h): Add conf_post.h.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid unused variable warning if --with-x-toolkit=motif.
+ * lwlib-Xm.c (make_menu_in_widget): Remove unused variable.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ * lwlib.c: Include c-strcase.h.
+ (lwlib_strcasecmp): Remove. All uses replaced with c_strcasecmp.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * Makefile.in (ALL_CFLAGS): Remove -DHAVE_CONFIG_H.
+ * lwlib-Xaw.c, lwlib-Xlw.c, lwlib-Xm.c, lwlib-utils.c, lwlib.c:
+ * xlwmenu.c: Include <config.h> unconditionally.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * lwlib.c (my_strcasecmp): Rename to lwlib_strcasecmp, which
+ may be defined to library function strcasecmp if available.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ * xlwmenu.c (abort_gracefully):
+ Use _Noreturn rather than NO_RETURN.
+ No need for separate decl merely because of _Noreturn.
+
+2012-05-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove obsolete '#define static' cruft.
+ * xlwmenu.c [emacs]: Include "bitmaps/gray.xbm".
+ (gray_bitmap_width, gray_bitmap_height, gray_bitmap_bits) [!emacs]:
+ Remove; all uses replaced with definiens.
+
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * Makefile.in (C_WARNINGS_SWITCH): Remove.
+ (WARN_CFLAGS, WERROR_CFLAGS): New macros.
+ (ALL_CFLAGS): Use new macros rather than old.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (C_SWITCH_X_SYSTEM): Remove.
+ (ALL_CFLAGS): Remove C_SWITCH_X_SYSTEM.
2011-10-13 Dmitry Antipov <dmantipov@yandex.ru>
* xlwmenuP.h (_XlwMenu_part): Add top_depth.
- * xlwmenu.h: Removed declaration of pop_up_menu
+ * xlwmenu.h: Removed declaration of pop_up_menu.
* xlwmenu.c (Start): Get correct time if time in event is CurrentTime.
(find_first_selectable, find_next_selectable)
;; coding: utf-8
;; End:
- Copyright (C) 1995-1999, 2001-2012 Free Software Foundation, Inc.
+ Copyright (C) 1995-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
# Copyright (C) 1992, 1993 Lucid, Inc.
-# Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
#
# This file is part of the Lucid Widget Library.
#
VPATH=@srcdir@
@SET_MAKE@
C_SWITCH_X_SITE=@C_SWITCH_X_SITE@
-C_SWITCH_X_SYSTEM=@C_SWITCH_X_SYSTEM@
C_SWITCH_SYSTEM=@C_SWITCH_SYSTEM@
C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
+WARN_CFLAGS = `echo @WARN_CFLAGS@ | sed 's/ -Wwrite-strings//'`
+WERROR_CFLAGS = @WERROR_CFLAGS@
CC=@CC@
CFLAGS=@CFLAGS@
## $(srcdir) is where the lwlib sources are.
## There are no generated lwlib files, hence no need for -I.
ALL_CFLAGS= $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
- $(C_SWITCH_X_SYSTEM) $(C_SWITCH_MACHINE) \
- $(C_WARNINGS_SWITCH) $(PROFILING_CFLAGS) $(CFLAGS) \
- -DHAVE_CONFIG_H -Demacs -I../src \
+ $(C_SWITCH_MACHINE) \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(PROFILING_CFLAGS) $(CFLAGS) \
+ -Demacs -I../src \
-I$(srcdir) -I$(srcdir)/../src -I../lib -I$(srcdir)/../lib
.c.o:
$(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
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <stdio.h>
#include <setjmp.h>
-#include <ctype.h>
#include <lisp.h>
XftFont *fn;
/* Try to convert Gtk-syntax (Sans 9) to Xft syntax Sans-9. */
- while (i > 0 && isdigit (fname[i]))
+ while (i > 0 && '0' <= fname[i] && fname[i] <= '9')
--i;
if (fname[i] == ' ')
{
{
int w = 0, h = 0;
char *bp = text;
-
+
while (bp && *bp != '\0')
{
XGlyphInfo gi;
Widget parent = XtParent (widget);
struct widget_xft_data *data = NULL;
int nr;
- while (parent && !inst)
+ while (parent && !inst)
{
inst = lw_get_widget_instance (parent);
parent = XtParent (parent);
}
if (!inst || !inst->xft_data || !inst->xft_data[0].xft_font) return 0;
- for (nr = 0; data == NULL && nr < inst->nr_xft_data; ++nr)
+ for (nr = 0; data == NULL && nr < inst->nr_xft_data; ++nr)
{
- if (inst->xft_data[nr].widget == widget)
+ if (inst->xft_data[nr].widget == widget)
data = &inst->xft_data[nr];
}
Cardinal *num_params)
{
struct widget_xft_data *data = find_xft_data (widget);
- if (data)
+ if (data)
{
char *lbl;
/* Since this isn't used for rectangle buttons, use it to for armed. */
Cardinal *num_params)
{
struct widget_xft_data *data = find_xft_data (widget);
- if (data)
+ if (data)
{
Dimension cr;
XtVaGetValues (widget, XtNcornerRoundPercent, &cr, NULL);
- if (cr == 1)
+ if (cr == 1)
{
char *lbl;
XtVaSetValues (widget, XtNcornerRoundPercent, 0, NULL);
xaw_destroy_instance (widget_instance *instance)
{
#ifdef HAVE_XFT
- if (instance->xft_data)
+ if (instance->xft_data)
{
int i;
- for (i = 0; i < instance->nr_xft_data; ++i)
+ for (i = 0; i < instance->nr_xft_data; ++i)
{
if (instance->xft_data[i].xft_draw)
XftDrawDestroy (instance->xft_data[i].xft_draw);
- if (instance->xft_data[i].p != None)
+ if (instance->xft_data[i].p != None)
{
XtVaSetValues (instance->xft_data[i].widget, XtNbitmap, None,
NULL);
static Boolean actions_initted = False;
#ifdef HAVE_XFT
-static XtActionsRec button_actions[] =
+static XtActionsRec button_actions[] =
{
{ "my_reset", command_reset },
{ "my_press", command_press },
XtVaGetValues (dialog,
XtNnumChildren, &num,
XtNchildren, &ch, NULL);
- for (i = 0; i < num; ++i)
+ for (i = 0; i < num; ++i)
{
if (!XtIsSubclass (ch[i], commandWidgetClass)
&& XtIsSubclass (ch[i], labelWidgetClass))
}
instance->xft_data = 0;
instance->nr_xft_data = 0;
- if (w)
+ if (w)
{
- XtResource rec[] =
+ XtResource rec[] =
{ { "font", "Font", XtRString, sizeof(String), 0, XtRString,
(XtPointer)"Sans-10" }};
char *fontName = NULL;
else
XFreeFont (XtDisplay (dialog), xfn);
}
-
- if (xft_font)
+
+ if (xft_font)
{
instance->nr_xft_data = left_buttons + right_buttons + 1;
instance->xft_data = calloc (instance->nr_xft_data,
{
ac = 0;
XtSetArg (av [ac], XtNfromHoriz, button); ac++;
- if (i == 0)
+ if (i == 0)
{
/* Separator to the other buttons. */
XtSetArg (av [ac], XtNhorizDistance, 30); ac++;
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <setjmp.h>
#include <lisp.h>
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <unistd.h>
#include <stdio.h>
int child_index;
widget_value* cur;
Widget button = 0;
- Widget title = 0;
Widget menu;
Arg al [256];
int ac;
{
ac = 0;
XtSetArg (al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++;
- title = button = XmCreateLabel (widget, cur->name, al, ac);
+ button = XmCreateLabel (widget, cur->name, al, ac);
}
else if (lw_separator_p (cur->name, &separator, 1))
{
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <setjmp.h>
#include <lisp.h>
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <setjmp.h>
#include <lisp.h>
+#include <c-strcase.h>
#include <sys/types.h>
#include <stdio.h>
-#include <ctype.h>
#include "lwlib-int.h"
#include "lwlib-utils.h"
#include <X11/StringDefs.h>
widget_value *,
int, int *);
static void instantiate_widget_instance (widget_instance *);
-static int my_strcasecmp (const char *, const char *);
static void safe_free_str (char *);
static void free_widget_value_tree (widget_value *);
static widget_value *copy_widget_value_tree (widget_value *,
return result;
}
-/* Like strcmp but ignore differences in case. */
-
-static int
-my_strcasecmp (const char *s1, const char *s2)
-{
- while (1)
- {
- int c1 = *s1++;
- int c2 = *s2++;
- if (isupper (c1))
- c1 = tolower (c1);
- if (isupper (c2))
- c2 = tolower (c2);
- if (c1 != c2)
- return (c1 > c2 ? 1 : -1);
- if (c1 == 0)
- return 0;
- }
-}
-
static void
safe_free_str (char *s)
{
{
const widget_creation_entry* cur;
for (cur = table; cur->type; cur++)
- if (!my_strcasecmp (type, cur->type))
+ if (!c_strcasecmp (type, cur->type))
return cur->function;
return NULL;
}
/* Created by devin@lucid.com */
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#include <setjmp.h>
#include <lisp.h>
#include <stdio.h>
-#include <ctype.h>
#include <sys/types.h>
#if (defined __sun) && !(defined SUNOS41)
#ifdef emacs
-/* Defined in xfns.c. When config.h defines `static' as empty, we get
- redefinition errors when gray_bitmap is included more than once, so
- we're referring to the one include in xfns.c here. */
-
-extern int gray_bitmap_width;
-extern int gray_bitmap_height;
-extern char *gray_bitmap_bits;
-
#include <xterm.h>
+#include "bitmaps/gray.xbm"
#else /* not emacs */
#include <X11/bitmaps/gray>
-#define gray_bitmap_width gray_width
-#define gray_bitmap_height gray_height
-#define gray_bitmap_bits gray_bits
#endif /* not emacs */
static void Nothing(Widget w, XEvent *ev, String *params, Cardinal *num_params);
static int separator_height (enum menu_separator);
static void pop_up_menu (XlwMenuWidget, XButtonPressedEvent *);
-static void abort_gracefully (Widget w) NO_RETURN;
static XtActionsRec
xlwMenuActionsList [] =
/* Like abort, but remove grabs from widget W before. */
-static void
+static _Noreturn void
abort_gracefully (Widget w)
{
if (XtIsShell (XtParent (w)))
int screen = XScreenNumberOfScreen (mw->core.screen);
int len = strlen (fname), i = len-1;
/* Try to convert Gtk-syntax (Sans 9) to Xft syntax Sans-9. */
- while (i > 0 && isdigit (fname[i]))
+ while (i > 0 && '0' <= fname[i] && fname[i] <= '9')
--i;
if (fname[i] == ' ')
{
mw->menu.cursor = mw->menu.cursor_shape;
mw->menu.gray_pixmap
- = XCreatePixmapFromBitmapData (display, window, gray_bitmap_bits,
- gray_bitmap_width, gray_bitmap_height,
+ = XCreatePixmapFromBitmapData (display, window, gray_bits,
+ gray_width, gray_height,
(unsigned long)1, (unsigned long)0, 1);
#ifdef HAVE_XFT
# 00gnulib.m4 serial 2
-dnl Copyright (C) 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-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.
-# alloca.m4 serial 13
-dnl Copyright (C) 2002-2004, 2006-2007, 2009-2011 Free Software Foundation,
+# alloca.m4 serial 14
+dnl Copyright (C) 2002-2004, 2006-2007, 2009-2012 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
# _AC_LIBOBJ_ALLOCA
# -----------------
-# Set up the LIBOBJ replacement of `alloca'. Well, not exactly
-# AC_LIBOBJ since we actually set the output variable `ALLOCA'.
+# Set up the LIBOBJ replacement of 'alloca'. Well, not exactly
+# AC_LIBOBJ since we actually set the output variable 'ALLOCA'.
# Nevertheless, for Automake, AC_LIBSOURCES it.
m4_define([_AC_LIBOBJ_ALLOCA],
[# The SVR3 libPW and SVR4 libucb both contain incompatible functions
# use ar to extract alloca.o from them instead of compiling alloca.c.
AC_LIBSOURCES(alloca.c)
AC_SUBST([ALLOCA], [\${LIBOBJDIR}alloca.$ac_objext])dnl
-AC_DEFINE(C_ALLOCA, 1, [Define to 1 if using `alloca.c'.])
+AC_DEFINE(C_ALLOCA, 1, [Define to 1 if using 'alloca.c'.])
-AC_CACHE_CHECK(whether `alloca.c' needs Cray hooks, ac_cv_os_cray,
+AC_CACHE_CHECK(whether 'alloca.c' needs Cray hooks, ac_cv_os_cray,
[AC_EGREP_CPP(webecray,
[#if defined CRAY && ! defined CRAY2
webecray
for ac_func in _getb67 GETB67 getb67; do
AC_CHECK_FUNC($ac_func,
[AC_DEFINE_UNQUOTED(CRAY_STACKSEG_END, $ac_func,
- [Define to one of `_getb67', `GETB67',
- `getb67' for Cray-2 and Cray-YMP
+ [Define to one of '_getb67', 'GETB67',
+ 'getb67' for Cray-2 and Cray-YMP
systems. This function is required for
- `alloca.c' support on those systems.])
+ 'alloca.c' support on those systems.])
break])
done
fi
# c-strtod.m4 serial 14
-# Copyright (C) 2004-2006, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 2004-2006, 2009-2012 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
--- /dev/null
+# clock_time.m4 serial 10
+dnl Copyright (C) 2002-2006, 2009-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.
+
+# Check for clock_gettime and clock_settime, and set LIB_CLOCK_GETTIME.
+# For a program named, say foo, you should add a line like the following
+# in the corresponding Makefile.am file:
+# foo_LDADD = $(LDADD) $(LIB_CLOCK_GETTIME)
+
+AC_DEFUN([gl_CLOCK_TIME],
+[
+ dnl Persuade glibc and Solaris <time.h> to declare these functions.
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+ # Solaris 2.5.1 needs -lposix4 to get the clock_gettime function.
+ # Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4.
+
+ # Save and restore LIBS so e.g., -lrt, isn't added to it. Otherwise, *all*
+ # programs in the package would end up linked with that potentially-shared
+ # library, inducing unnecessary run-time overhead.
+ LIB_CLOCK_GETTIME=
+ AC_SUBST([LIB_CLOCK_GETTIME])
+ gl_saved_libs=$LIBS
+ AC_SEARCH_LIBS([clock_gettime], [rt posix4],
+ [test "$ac_cv_search_clock_gettime" = "none required" ||
+ LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime])
+ AC_CHECK_FUNCS([clock_gettime clock_settime])
+ LIBS=$gl_saved_libs
+])
-#serial 16
-dnl Copyright (C) 2002, 2005, 2007, 2009-2011 Free Software Foundation, Inc.
+#serial 18
+dnl Copyright (C) 2002, 2005, 2007, 2009-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.
[gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no],
[case "$host_os" in
mingw*) # on this platform, dup2 always returns 0 for success
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
linux*) # On linux between 2008-07-27 and 2009-05-11, dup2 of a
# closed fd may yield -EBADF instead of -1 / errno=EBADF.
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF.
- gl_cv_func_dup2_works=no;;
+ gl_cv_func_dup2_works="guessing no" ;;
haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
- gl_cv_func_dup2_works=no;;
- *) gl_cv_func_dup2_works=yes;;
+ gl_cv_func_dup2_works="guessing no" ;;
+ *) gl_cv_func_dup2_works="guessing yes" ;;
esac])
])
- if test "$gl_cv_func_dup2_works" = no; then
- REPLACE_DUP2=1
- fi
+ case "$gl_cv_func_dup2_works" in
+ *yes) ;;
+ *)
+ REPLACE_DUP2=1
+ ;;
+ esac
fi
dnl Replace dup2() for supporting the gnulib-defined fchdir() function,
dnl to keep fchdir's bookkeeping up-to-date.
m4_ifdef([gl_FUNC_FCHDIR], [
gl_TEST_FCHDIR
if test $HAVE_FCHDIR = 0; then
- REPLACE_DUP2=1
+ if test $HAVE_DUP2 = 1; then
+ REPLACE_DUP2=1
+ fi
fi
])
])
--- /dev/null
+# environ.m4 serial 6
+dnl Copyright (C) 2001-2004, 2006-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_ONCE([gl_ENVIRON],
+[
+ AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ dnl Persuade glibc <unistd.h> to declare environ.
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_HEADERS_ONCE([unistd.h])
+ gt_CHECK_VAR_DECL(
+ [#if HAVE_UNISTD_H
+ #include <unistd.h>
+ #endif
+ /* mingw, BeOS, Haiku declare environ in <stdlib.h>, not in <unistd.h>. */
+ #include <stdlib.h>
+ ],
+ [environ])
+ if test $gt_cv_var_environ_declaration != yes; then
+ HAVE_DECL_ENVIRON=0
+ fi
+])
+
+# Check if a variable is properly declared.
+# gt_CHECK_VAR_DECL(includes,variable)
+AC_DEFUN([gt_CHECK_VAR_DECL],
+[
+ define([gt_cv_var], [gt_cv_var_]$2[_declaration])
+ AC_MSG_CHECKING([if $2 is properly declared])
+ AC_CACHE_VAL([gt_cv_var], [
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[$1
+ extern struct { int foo; } $2;]],
+ [[$2.foo = 1;]])],
+ [gt_cv_var=no],
+ [gt_cv_var=yes])])
+ AC_MSG_RESULT([$gt_cv_var])
+ if test $gt_cv_var = yes; then
+ AC_DEFINE([HAVE_]m4_translit($2, [a-z], [A-Z])[_DECL], 1,
+ [Define if you have the declaration of $2.])
+ fi
+ undefine([gt_cv_var])
+])
--- /dev/null
+# Check for GNU-style execinfo.h.
+
+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_EXECINFO_H],
+[
+ AC_CHECK_HEADERS_ONCE([execinfo.h])
+
+ LIB_EXECINFO=''
+ EXECINFO_H='execinfo.h'
+
+ if test $ac_cv_header_execinfo_h = yes; then
+ gl_saved_libs=$LIBS
+ AC_SEARCH_LIBS([backtrace_symbols_fd], [execinfo],
+ [test "$ac_cv_search_backtrace_symbols_fd" = "none required" ||
+ LIB_EXECINFO=$ac_cv_search_backtrace_symbols_fd])
+ LIBS=$gl_saved_libs
+ test "$ac_cv_search_backtrace_symbols_fd" = no || EXECINFO_H=''
+ fi
+
+ if test -n "$EXECINFO_H"; then
+ AC_LIBOBJ([execinfo])
+ fi
+
+ AC_SUBST([EXECINFO_H])
+ AC_SUBST([LIB_EXECINFO])
+ AM_CONDITIONAL([GL_GENERATE_EXECINFO_H], [test -n "$EXECINFO_H"])
+])
-# serial 10 -*- Autoconf -*-
+# serial 12 -*- Autoconf -*-
# Enable extensions on systems that normally disable them.
-# Copyright (C) 2003, 2006-2011 Free Software Foundation, Inc.
+# Copyright (C) 2003, 2006-2012 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
AC_CHECK_HEADER([minix/config.h], [MINIX=yes], [MINIX=])
if test "$MINIX" = yes; then
AC_DEFINE([_POSIX_SOURCE], [1],
- [Define to 1 if you need to in order for `stat' and other
+ [Define to 1 if you need to in order for 'stat' and other
things to work.])
AC_DEFINE([_POSIX_1_SOURCE], [2],
[Define to 2 if the system does not provide POSIX.1 features
#ifndef _ALL_SOURCE
# undef _ALL_SOURCE
#endif
-/* Enable general extensions on MacOS X. */
+/* Enable general extensions on Mac OS X. */
#ifndef _DARWIN_C_SOURCE
# undef _DARWIN_C_SOURCE
#endif
--- /dev/null
+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
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>.
+ _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
+#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
+# if __GNUC_GNU_INLINE__
+ /* __gnu_inline__ suppresses a GCC 4.2 diagnostic. */
+# define _GL_INLINE extern inline __attribute__ ((__gnu_inline__))
+# else
+# define _GL_INLINE extern inline
+# endif
+# define _GL_EXTERN_INLINE extern
+#else
+# define _GL_INLINE static inline
+# define _GL_EXTERN_INLINE static inline
+#endif
+
+#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+# if __GNUC_STDC_INLINE__
+# define _GL_INLINE_HEADER_CONST_PRAGMA
+# else
+# define _GL_INLINE_HEADER_CONST_PRAGMA \
+ _Pragma ("GCC diagnostic ignored \"-Wsuggest-attribute=const\"")
+# endif
+# define _GL_INLINE_HEADER_BEGIN \
+ _Pragma ("GCC diagnostic push") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") \
+ _GL_INLINE_HEADER_CONST_PRAGMA
+# define _GL_INLINE_HEADER_END \
+ _Pragma ("GCC diagnostic pop")
+#else
+# define _GL_INLINE_HEADER_BEGIN
+# define _GL_INLINE_HEADER_END
+#endif])
+])
# filemode.m4 serial 8
-dnl Copyright (C) 2002, 2005-2006, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2005-2006, 2009-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.
# Check for getloadavg.
-# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2011 Free Software
+# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2012 Free Software
# Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-#serial 5
+#serial 6
# Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent.
# New applications should use gl_GETLOADAVG instead.
gl_save_LIBS=$LIBS
-# getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0,
+# getloadvg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0,
# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7.
HAVE_GETLOADAVG=1
AC_CHECK_FUNC([getloadavg], [],
# gl_PREREQ_GETLOADAVG
# --------------------
-# Set up the AC_LIBOBJ replacement of `getloadavg'.
+# Set up the AC_LIBOBJ replacement of 'getloadavg'.
AC_DEFUN([gl_PREREQ_GETLOADAVG],
[
# Figure out what our getloadavg.c needs.
+AC_CHECK_HEADERS_ONCE([sys/param.h])
+
# On HPUX9, an unprivileged user can get load averages this way.
if test $gl_func_getloadavg_done = no; then
AC_CHECK_FUNCS([pstat_getdynamic], [gl_func_getloadavg_done=yes])
-# getopt.m4 serial 38
-dnl Copyright (C) 2002-2006, 2008-2011 Free Software Foundation, Inc.
+# getopt.m4 serial 44
+dnl Copyright (C) 2002-2006, 2008-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.
[
m4_divert_text([DEFAULTS], [gl_getopt_required=POSIX])
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([gl_GETOPT_CHECK_HEADERS])
dnl Other modules can request the gnulib implementation of the getopt
dnl functions unconditionally, by defining gl_REPLACE_GETOPT_ALWAYS.
dnl argp.m4 does this.
m4_ifdef([gl_REPLACE_GETOPT_ALWAYS], [
- gl_GETOPT_IFELSE([], [])
REPLACE_GETOPT=1
], [
REPLACE_GETOPT=0
- gl_GETOPT_IFELSE([
+ if test -n "$gl_replace_getopt"; then
REPLACE_GETOPT=1
- ],
- [])
+ fi
])
if test $REPLACE_GETOPT = 1; then
dnl Arrange for getopt.h to be created.
gl_GETOPT_SUBSTITUTE_HEADER
- dnl Arrange for unistd.h to include getopt.h.
- GNULIB_UNISTD_H_GETOPT=1
fi
])
AC_REQUIRE([gl_FUNC_GETOPT_POSIX])
])
-# emacs' configure.in uses this.
-AC_DEFUN([gl_GETOPT_IFELSE],
-[
- AC_REQUIRE([gl_GETOPT_CHECK_HEADERS])
- AS_IF([test -n "$gl_replace_getopt"], [$1], [$2])
-])
-
# Determine whether to replace the entire getopt facility.
AC_DEFUN([gl_GETOPT_CHECK_HEADERS],
[
AC_CHECK_FUNCS([getopt_long_only], [], [gl_replace_getopt=yes])
fi
- dnl mingw's getopt (in libmingwex.a) does weird things when the options
- dnl strings starts with '+' and it's not the first call. Some internal state
- dnl is left over from earlier calls, and neither setting optind = 0 nor
- dnl setting optreset = 1 get rid of this internal state.
- dnl POSIX is silent on optind vs. optreset, so we allow either behavior.
dnl POSIX 2008 does not specify leading '+' behavior, but see
dnl http://austingroupbugs.net/view.php?id=191 for a recommendation on
dnl the next version of POSIX. For now, we only guarantee leading '+'
AC_CACHE_CHECK([whether getopt is POSIX compatible],
[gl_cv_func_getopt_posix],
[
- dnl BSD getopt_long uses an incompatible method to reset option
- dnl processing. Existence of the optreset variable, in and of
- dnl itself, is not a reason to replace getopt, but knowledge
- dnl of the variable is needed to determine how to reset and
- dnl whether a reset reparses the environment. Solaris
- dnl supports neither optreset nor optind=0, but keeps no state
- dnl that needs a reset beyond setting optind=1; detect Solaris
- dnl by getopt_clip.
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [[#include <unistd.h>]],
- [[int *p = &optreset; return optreset;]])],
- [gl_optind_min=1],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM(
- [[#include <getopt.h>]],
- [[return !getopt_clip;]])],
- [gl_optind_min=1],
- [gl_optind_min=0])])
-
- dnl This test fails on mingw and succeeds on many other platforms.
- gl_save_CPPFLAGS=$CPPFLAGS
- CPPFLAGS="$CPPFLAGS -DOPTIND_MIN=$gl_optind_min"
- AC_RUN_IFELSE([AC_LANG_SOURCE([[
+ dnl Merging these three different test programs into a single one
+ dnl would require a reset mechanism. On BSD systems, it can be done
+ dnl through 'optreset'; on some others (glibc), it can be done by
+ dnl setting 'optind' to 0; on others again (HP-UX, IRIX, OSF/1,
+ dnl Solaris 9, musl libc), there is no such mechanism.
+ if test $cross_compiling = no; then
+ dnl Sanity check. Succeeds everywhere (except on MSVC,
+ dnl which lacks <unistd.h> and getopt() entirely).
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
#include <unistd.h>
#include <stdlib.h>
#include <string.h>
int
main ()
{
- {
- static char program[] = "program";
- static char a[] = "-a";
- static char foo[] = "foo";
- static char bar[] = "bar";
- char *argv[] = { program, a, foo, bar, NULL };
- int c;
+ static char program[] = "program";
+ static char a[] = "-a";
+ static char foo[] = "foo";
+ static char bar[] = "bar";
+ char *argv[] = { program, a, foo, bar, NULL };
+ int c;
- optind = OPTIND_MIN;
- opterr = 0;
-
- c = getopt (4, argv, "ab");
- if (!(c == 'a'))
- return 1;
- c = getopt (4, argv, "ab");
- if (!(c == -1))
- return 2;
- if (!(optind == 2))
- return 3;
- }
- /* Some internal state exists at this point. */
- {
- static char program[] = "program";
- static char donald[] = "donald";
- static char p[] = "-p";
- static char billy[] = "billy";
- static char duck[] = "duck";
- static char a[] = "-a";
- static char bar[] = "bar";
- char *argv[] = { program, donald, p, billy, duck, a, bar, NULL };
- int c;
+ c = getopt (4, argv, "ab");
+ if (!(c == 'a'))
+ return 1;
+ c = getopt (4, argv, "ab");
+ if (!(c == -1))
+ return 2;
+ if (!(optind == 2))
+ return 3;
+ return 0;
+}
+]])],
+ [gl_cv_func_getopt_posix=maybe],
+ [gl_cv_func_getopt_posix=no])
+ if test $gl_cv_func_getopt_posix = maybe; then
+ dnl Sanity check with '+'. Succeeds everywhere (except on MSVC,
+ dnl which lacks <unistd.h> and getopt() entirely).
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
- optind = OPTIND_MIN;
- opterr = 0;
+int
+main ()
+{
+ static char program[] = "program";
+ static char donald[] = "donald";
+ static char p[] = "-p";
+ static char billy[] = "billy";
+ static char duck[] = "duck";
+ static char a[] = "-a";
+ static char bar[] = "bar";
+ char *argv[] = { program, donald, p, billy, duck, a, bar, NULL };
+ int c;
- c = getopt (7, argv, "+abp:q:");
- if (!(c == -1))
- return 4;
- if (!(strcmp (argv[0], "program") == 0))
- return 5;
- if (!(strcmp (argv[1], "donald") == 0))
- return 6;
- if (!(strcmp (argv[2], "-p") == 0))
- return 7;
- if (!(strcmp (argv[3], "billy") == 0))
- return 8;
- if (!(strcmp (argv[4], "duck") == 0))
- return 9;
- if (!(strcmp (argv[5], "-a") == 0))
- return 10;
- if (!(strcmp (argv[6], "bar") == 0))
- return 11;
- if (!(optind == 1))
- return 12;
- }
- /* Detect MacOS 10.5, AIX 7.1 bug. */
- {
- static char program[] = "program";
- static char ab[] = "-ab";
- char *argv[3] = { program, ab, NULL };
- optind = OPTIND_MIN;
- opterr = 0;
- if (getopt (2, argv, "ab:") != 'a')
- return 13;
- if (getopt (2, argv, "ab:") != '?')
- return 14;
- if (optopt != 'b')
- return 15;
- if (optind != 2)
- return 16;
- }
+ c = getopt (7, argv, "+abp:q:");
+ if (!(c == -1))
+ return 4;
+ if (!(strcmp (argv[0], "program") == 0))
+ return 5;
+ if (!(strcmp (argv[1], "donald") == 0))
+ return 6;
+ if (!(strcmp (argv[2], "-p") == 0))
+ return 7;
+ if (!(strcmp (argv[3], "billy") == 0))
+ return 8;
+ if (!(strcmp (argv[4], "duck") == 0))
+ return 9;
+ if (!(strcmp (argv[5], "-a") == 0))
+ return 10;
+ if (!(strcmp (argv[6], "bar") == 0))
+ return 11;
+ if (!(optind == 1))
+ return 12;
+ return 0;
+}
+]])],
+ [gl_cv_func_getopt_posix=maybe],
+ [gl_cv_func_getopt_posix=no])
+ fi
+ if test $gl_cv_func_getopt_posix = maybe; then
+ dnl Detect Mac OS X 10.5, AIX 7.1, mingw bug.
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
+int
+main ()
+{
+ static char program[] = "program";
+ static char ab[] = "-ab";
+ char *argv[3] = { program, ab, NULL };
+ if (getopt (2, argv, "ab:") != 'a')
+ return 13;
+ if (getopt (2, argv, "ab:") != '?')
+ return 14;
+ if (optopt != 'b')
+ return 15;
+ if (optind != 2)
+ return 16;
return 0;
}
]])],
- [gl_cv_func_getopt_posix=yes], [gl_cv_func_getopt_posix=no],
- [case "$host_os" in
- mingw*) gl_cv_func_getopt_posix="guessing no";;
- darwin* | aix*) gl_cv_func_getopt_posix="guessing no";;
- *) gl_cv_func_getopt_posix="guessing yes";;
- esac
- ])
- CPPFLAGS=$gl_save_CPPFLAGS
+ [gl_cv_func_getopt_posix=yes],
+ [gl_cv_func_getopt_posix=no])
+ fi
+ else
+ case "$host_os" in
+ darwin* | aix* | mingw*) gl_cv_func_getopt_posix="guessing no";;
+ *) gl_cv_func_getopt_posix="guessing yes";;
+ esac
+ fi
])
case "$gl_cv_func_getopt_posix" in
*no) gl_replace_getopt=yes ;;
nocrash_init();
/* This code succeeds on glibc 2.8, OpenBSD 4.0, Cygwin, mingw,
- and fails on MacOS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
+ and fails on Mac OS X 10.5, AIX 5.2, HP-UX 11, IRIX 6.5,
OSF/1 5.1, Solaris 10. */
{
static char conftest[] = "conftest";
result |= 1;
}
/* This code succeeds on glibc 2.8, mingw,
- and fails on MacOS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11,
+ and fails on Mac OS X 10.5, OpenBSD 4.0, AIX 5.2, HP-UX 11,
IRIX 6.5, OSF/1 5.1, Solaris 10, Cygwin 1.5.x. */
{
static char program[] = "program";
if (getopt (3, argv, "-p") != 1)
result |= 16;
else if (getopt (3, argv, "-p") != 'p')
- result |= 32;
+ result |= 16;
}
/* This code fails on glibc 2.11. */
{
char *argv[] = { program, b, a, NULL };
optind = opterr = 0;
if (getopt (3, argv, "+:a:b") != 'b')
- result |= 64;
+ result |= 32;
else if (getopt (3, argv, "+:a:b") != ':')
- result |= 64;
+ result |= 32;
}
/* This code dumps core on glibc 2.14. */
{
char *argv[] = { program, w, dummy, NULL };
optind = opterr = 1;
if (getopt (3, argv, "W;") != 'W')
- result |= 128;
+ result |= 64;
}
return result;
]])],
[gl_cv_func_getopt_gnu=yes],
[gl_cv_func_getopt_gnu=no],
- [dnl Cross compiling. Guess based on host and declarations.
- case $host_os:$ac_cv_have_decl_optreset in
- *-gnu*:* | mingw*:*) gl_cv_func_getopt_gnu=no;;
- *:yes) gl_cv_func_getopt_gnu=no;;
- *) gl_cv_func_getopt_gnu=yes;;
- esac
+ [dnl Cross compiling. Assume the worst, even on glibc platforms.
+ gl_cv_func_getopt_gnu="guessing no"
])
case $gl_had_POSIXLY_CORRECT in
exported) ;;
*) AS_UNSET([POSIXLY_CORRECT]) ;;
esac
])
- if test "$gl_cv_func_getopt_gnu" = "no"; then
+ if test "$gl_cv_func_getopt_gnu" != yes; then
gl_replace_getopt=yes
+ else
+ AC_CACHE_CHECK([for working GNU getopt_long function],
+ [gl_cv_func_getopt_long_gnu],
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <getopt.h>
+ #include <stddef.h>
+ #include <string.h>
+ ]],
+ [[static const struct option long_options[] =
+ {
+ { "xtremely-",no_argument, NULL, 1003 },
+ { "xtra", no_argument, NULL, 1001 },
+ { "xtreme", no_argument, NULL, 1002 },
+ { "xtremely", no_argument, NULL, 1003 },
+ { NULL, 0, NULL, 0 }
+ };
+ /* This code fails on OpenBSD 5.0. */
+ {
+ static char program[] = "program";
+ static char xtremel[] = "--xtremel";
+ char *argv[] = { program, xtremel, NULL };
+ int option_index;
+ optind = 1; opterr = 0;
+ if (getopt_long (2, argv, "", long_options, &option_index) != 1003)
+ return 1;
+ }
+ return 0;
+ ]])],
+ [gl_cv_func_getopt_long_gnu=yes],
+ [gl_cv_func_getopt_long_gnu=no],
+ [dnl Cross compiling. Guess no on OpenBSD, yes otherwise.
+ case "$host_os" in
+ openbsd*) gl_cv_func_getopt_long_gnu="guessing no";;
+ *) gl_cv_func_getopt_long_gnu="guessing yes";;
+ esac
+ ])
+ ])
+ case "$gl_cv_func_getopt_long_gnu" in
+ *yes) ;;
+ *) gl_replace_getopt=yes ;;
+ esac
fi
fi
])
-# emacs' configure.in uses this.
AC_DEFUN([gl_GETOPT_SUBSTITUTE_HEADER],
[
GETOPT_H=getopt.h
])
# Prerequisites of lib/getopt*.
-# emacs' configure.in uses this.
AC_DEFUN([gl_PREREQ_GETOPT],
[
AC_CHECK_DECLS_ONCE([getenv])
--- /dev/null
+# gettime.m4 serial 8
+dnl Copyright (C) 2002, 2004-2006, 2009-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_GETTIME],
+[
+ dnl Prerequisites of lib/gettime.c.
+ AC_REQUIRE([gl_CLOCK_TIME])
+ AC_REQUIRE([gl_TIMESPEC])
+ AC_CHECK_FUNCS_ONCE([gettimeofday nanotime])
+])
--- /dev/null
+# serial 20
+
+# Copyright (C) 2001-2003, 2005, 2007, 2009-2012 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering.
+
+AC_DEFUN([gl_FUNC_GETTIMEOFDAY],
+[
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H])
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS])
+ AC_CHECK_FUNCS_ONCE([gettimeofday])
+
+ gl_gettimeofday_timezone=void
+ if test $ac_cv_func_gettimeofday != yes; then
+ HAVE_GETTIMEOFDAY=0
+ else
+ gl_FUNC_GETTIMEOFDAY_CLOBBER
+ AC_CACHE_CHECK([for gettimeofday with POSIX signature],
+ [gl_cv_func_gettimeofday_posix_signature],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/time.h>
+ struct timeval c;
+ int gettimeofday (struct timeval *restrict, void *restrict);
+ ]],
+ [[/* glibc uses struct timezone * rather than the POSIX void *
+ if _GNU_SOURCE is defined. However, since the only portable
+ use of gettimeofday uses NULL as the second parameter, and
+ since the glibc definition is actually more typesafe, it is
+ not worth wrapping this to get a compliant signature. */
+ int (*f) (struct timeval *restrict, void *restrict)
+ = gettimeofday;
+ int x = f (&c, 0);
+ return !(x | c.tv_sec | c.tv_usec);
+ ]])],
+ [gl_cv_func_gettimeofday_posix_signature=yes],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/time.h>
+int gettimeofday (struct timeval *restrict, struct timezone *restrict);
+ ]])],
+ [gl_cv_func_gettimeofday_posix_signature=almost],
+ [gl_cv_func_gettimeofday_posix_signature=no])])])
+ if test $gl_cv_func_gettimeofday_posix_signature = almost; then
+ gl_gettimeofday_timezone='struct timezone'
+ elif test $gl_cv_func_gettimeofday_posix_signature != yes; then
+ REPLACE_GETTIMEOFDAY=1
+ fi
+ dnl If we override 'struct timeval', we also have to override gettimeofday.
+ if test $REPLACE_STRUCT_TIMEVAL = 1; then
+ REPLACE_GETTIMEOFDAY=1
+ fi
+ m4_ifdef([gl_FUNC_TZSET_CLOBBER], [
+ gl_FUNC_TZSET_CLOBBER
+ case "$gl_cv_func_tzset_clobber" in
+ *yes)
+ REPLACE_GETTIMEOFDAY=1
+ gl_GETTIMEOFDAY_REPLACE_LOCALTIME
+ AC_DEFINE([tzset], [rpl_tzset],
+ [Define to rpl_tzset if the wrapper function should be used.])
+ AC_DEFINE([TZSET_CLOBBERS_LOCALTIME], [1],
+ [Define if tzset clobbers localtime's static buffer.])
+ ;;
+ esac
+ ])
+ fi
+ AC_DEFINE_UNQUOTED([GETTIMEOFDAY_TIMEZONE], [$gl_gettimeofday_timezone],
+ [Define this to 'void' or 'struct timezone' to match the system's
+ declaration of the second argument to gettimeofday.])
+])
+
+
+dnl See if gettimeofday clobbers the static buffer that localtime uses
+dnl for its return value. The gettimeofday function from Mac OS X 10.0.4
+dnl (i.e., Darwin 1.3.7) has this problem.
+dnl
+dnl If it does, then arrange to use gettimeofday and localtime only via
+dnl the wrapper functions that work around the problem.
+
+AC_DEFUN([gl_FUNC_GETTIMEOFDAY_CLOBBER],
+[
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+
+ AC_CACHE_CHECK([whether gettimeofday clobbers localtime buffer],
+ [gl_cv_func_gettimeofday_clobber],
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <string.h>
+ #include <sys/time.h>
+ #include <time.h>
+ #include <stdlib.h>
+ ]],
+ [[
+ time_t t = 0;
+ struct tm *lt;
+ struct tm saved_lt;
+ struct timeval tv;
+ lt = localtime (&t);
+ saved_lt = *lt;
+ gettimeofday (&tv, NULL);
+ return memcmp (lt, &saved_lt, sizeof (struct tm)) != 0;
+ ]])],
+ [gl_cv_func_gettimeofday_clobber=no],
+ [gl_cv_func_gettimeofday_clobber=yes],
+ [# When cross-compiling:
+ case "$host_os" in
+ # Guess all is fine on glibc systems.
+ *-gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_gettimeofday_clobber="guessing yes" ;;
+ esac
+ ])])
+
+ case "$gl_cv_func_gettimeofday_clobber" in
+ *yes)
+ REPLACE_GETTIMEOFDAY=1
+ gl_GETTIMEOFDAY_REPLACE_LOCALTIME
+ AC_DEFINE([GETTIMEOFDAY_CLOBBERS_LOCALTIME], [1],
+ [Define if gettimeofday clobbers the localtime buffer.])
+ ;;
+ esac
+])
+
+AC_DEFUN([gl_GETTIMEOFDAY_REPLACE_LOCALTIME], [
+ AC_DEFINE([gmtime], [rpl_gmtime],
+ [Define to rpl_gmtime if the replacement function should be used.])
+ AC_DEFINE([localtime], [rpl_localtime],
+ [Define to rpl_localtime if the replacement function should be used.])
+])
+
+# Prerequisites of lib/gettimeofday.c.
+AC_DEFUN([gl_PREREQ_GETTIMEOFDAY], [
+ AC_CHECK_HEADERS([sys/timeb.h])
+ AC_CHECK_FUNCS([_ftime])
+])
-# gnulib-common.m4 serial 31
-dnl Copyright (C) 2007-2011 Free Software Foundation, Inc.
+# gnulib-common.m4 serial 33
+dnl Copyright (C) 2007-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_COMMON_BODY], [
AH_VERBATIM([_Noreturn],
-[/* The _Noreturn keyword of draft C1X. */
-#ifndef _Noreturn
+[/* The _Noreturn keyword of C11. */
+#if ! (defined _Noreturn \
+ || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__))
# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__) \
|| 0x5110 <= __SUNPRO_C)
# define _Noreturn __attribute__ ((__noreturn__))
-# elif 1200 <= _MSC_VER
+# elif defined _MSC_VER && 1200 <= _MSC_VER
# define _Noreturn __declspec (noreturn)
# else
# define _Noreturn
[/* Work around a bug in Apple GCC 4.0.1 build 5465: In C99 mode, it supports
the ISO C 99 semantics of 'extern inline' (unlike the GNU C semantics of
earlier versions), but does not display it by setting __GNUC_STDC_INLINE__.
- __APPLE__ && __MACH__ test for MacOS X.
+ __APPLE__ && __MACH__ test for Mac OS X.
__APPLE_CC__ tests for the Apple compiler and its version.
__STDC_VERSION__ tests for the C99 mode. */
#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__
# - When AC_PROG_CC_STDC is invoked twice, it adds the C99 enabling options
# to CC twice
# <http://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00431.html>.
-# - AC_PROG_CC_STDC is likely to change when C1X is an ISO standard.
+# - AC_PROG_CC_STDC is likely to change now that C11 is an ISO standard.
AC_DEFUN([gl_PROG_CC_C99],
[
dnl Change that version number to the minimum Autoconf version that supports
# DO NOT EDIT! GENERATED AUTOMATICALLY!
-# Copyright (C) 2002-2011 Free Software Foundation, Inc.
+# Copyright (C) 2002-2012 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# other built files.
-# This macro should be invoked from ./configure.in, in the section
+# This macro should be invoked from ./configure.ac, in the section
# "Checks for programs", right after AC_PROG_CC, and certainly before
# any checks for libraries, header files, types and library functions.
AC_DEFUN([gl_EARLY],
AC_REQUIRE([gl_PROG_AR_RANLIB])
# Code from module alloca-opt:
# Code from module allocator:
+ # Code from module c-ctype:
+ # Code from module c-strcase:
# Code from module careadlinkat:
+ # Code from module clock-time:
# Code from module crypto/md5:
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module crypto/sha512:
# Code from module dosname:
# Code from module dtoastr:
+ # Code from module dtotimespec:
# Code from module dup2:
+ # Code from module environ:
+ # Code from module execinfo:
# 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:
# Code from module getopt-posix:
# Code from module gettext-h:
+ # Code from module gettime:
+ # Code from module gettimeofday:
# Code from module ignore-value:
# Code from module include_next:
# Code from module intprops:
# Code from module largefile:
AC_REQUIRE([AC_SYS_LARGEFILE])
# Code from module lstat:
+ # Code from module manywarnings:
# Code from module mktime:
# Code from module multiarch:
# Code from module nocrash:
# Code from module pathmax:
+ # Code from module pselect:
# Code from module pthread_sigmask:
# Code from module readlink:
# Code from module signal-h:
- # Code from module sigprocmask:
# Code from module snippet/_Noreturn:
# Code from module snippet/arg-nonnull:
# Code from module snippet/c++defs:
# Code from module socklen:
# Code from module ssize_t:
# Code from module stat:
+ # Code from module stat-time:
+ # Code from module stdalign:
# Code from module stdarg:
dnl Some compilers (e.g., AIX 5.3 cc) need to be in c99 mode
dnl for the builtin va_copy to work. With Autoconf 2.60 or later,
# Code from module strtoull:
# Code from module strtoumax:
# Code from module symlink:
+ # Code from module sys_select:
# Code from module sys_stat:
+ # Code from module sys_time:
# Code from module time:
# Code from module time_r:
+ # Code from module timer-time:
+ # Code from module timespec:
+ # Code from module timespec-add:
+ # Code from module timespec-sub:
# Code from module u64:
# Code from module unistd:
+ # Code from module utimens:
# Code from module verify:
+ # Code from module warnings:
])
-# This macro should be invoked from ./configure.in, in the section
+# This macro should be invoked from ./configure.ac, in the section
# "Check for header files, types and library functions".
AC_DEFUN([gl_INIT],
[
m4_pushdef([gl_LIBSOURCES_DIR], [])
gl_COMMON
gl_source_base='lib'
-gl_FUNC_ALLOCA
-AC_CHECK_FUNCS_ONCE([readlinkat])
-gl_MD5
-gl_SHA1
-gl_SHA256
-gl_SHA512
-AC_REQUIRE([gl_C99_STRTOLD])
-gl_FUNC_DUP2
-if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
- AC_LIBOBJ([dup2])
- gl_PREREQ_DUP2
-fi
-gl_UNISTD_MODULE_INDICATOR([dup2])
-gl_FILEMODE
-gl_GETLOADAVG
-if test $HAVE_GETLOADAVG = 0; then
- AC_LIBOBJ([getloadavg])
- gl_PREREQ_GETLOADAVG
-fi
-gl_STDLIB_MODULE_INDICATOR([getloadavg])
-gl_FUNC_GETOPT_GNU
-if test $REPLACE_GETOPT = 1; then
- AC_LIBOBJ([getopt])
- AC_LIBOBJ([getopt1])
- gl_PREREQ_GETOPT
-fi
-gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu])
-gl_FUNC_GETOPT_POSIX
-if test $REPLACE_GETOPT = 1; then
- AC_LIBOBJ([getopt])
- AC_LIBOBJ([getopt1])
- gl_PREREQ_GETOPT
-fi
-AC_REQUIRE([AC_C_INLINE])
-gl_INTTYPES_INCOMPLETE
-gl_FUNC_LSTAT
-if test $REPLACE_LSTAT = 1; then
- AC_LIBOBJ([lstat])
- gl_PREREQ_LSTAT
-fi
-gl_SYS_STAT_MODULE_INDICATOR([lstat])
-gl_FUNC_MKTIME
-if test $REPLACE_MKTIME = 1; then
- AC_LIBOBJ([mktime])
- gl_PREREQ_MKTIME
-fi
-gl_TIME_MODULE_INDICATOR([mktime])
-gl_MULTIARCH
-gl_FUNC_PTHREAD_SIGMASK
-if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
- AC_LIBOBJ([pthread_sigmask])
- gl_PREREQ_PTHREAD_SIGMASK
-fi
-gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask])
-gl_FUNC_READLINK
-if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
- AC_LIBOBJ([readlink])
- gl_PREREQ_READLINK
-fi
-gl_UNISTD_MODULE_INDICATOR([readlink])
-gl_SIGNAL_H
-gl_TYPE_SOCKLEN_T
-gt_TYPE_SSIZE_T
-gl_STDARG_H
-AM_STDBOOL_H
-gl_STDDEF_H
-gl_STDINT_H
-gl_STDIO_H
-gl_STDLIB_H
-gl_FUNC_GNU_STRFTIME
-gl_FUNC_STRTOIMAX
-if test $ac_cv_func_strtoimax = no; then
- AC_LIBOBJ([strtoimax])
- gl_PREREQ_STRTOIMAX
-fi
-gl_INTTYPES_MODULE_INDICATOR([strtoimax])
-gl_FUNC_STRTOUMAX
-if test $ac_cv_func_strtoumax = no; then
- AC_LIBOBJ([strtoumax])
- gl_PREREQ_STRTOUMAX
-fi
-gl_INTTYPES_MODULE_INDICATOR([strtoumax])
-gl_FUNC_SYMLINK
-if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
- AC_LIBOBJ([symlink])
-fi
-gl_UNISTD_MODULE_INDICATOR([symlink])
-gl_HEADER_SYS_STAT_H
-AC_PROG_MKDIR_P
-gl_HEADER_TIME_H
-gl_TIME_R
-if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
- AC_LIBOBJ([time_r])
- gl_PREREQ_TIME_R
-fi
-gl_TIME_MODULE_INDICATOR([time_r])
-AC_REQUIRE([AC_C_INLINE])
-gl_UNISTD_H
+ gl_FUNC_ALLOCA
+ AC_CHECK_FUNCS_ONCE([readlinkat])
+ gl_CLOCK_TIME
+ gl_MD5
+ gl_SHA1
+ gl_SHA256
+ gl_SHA512
+ AC_REQUIRE([gl_C99_STRTOLD])
+ gl_FUNC_DUP2
+ if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then
+ AC_LIBOBJ([dup2])
+ gl_PREREQ_DUP2
+ fi
+ gl_UNISTD_MODULE_INDICATOR([dup2])
+ gl_ENVIRON
+ gl_UNISTD_MODULE_INDICATOR([environ])
+ gl_EXECINFO_H
+ AC_REQUIRE([gl_EXTERN_INLINE])
+ gl_FILEMODE
+ gl_GETLOADAVG
+ if test $HAVE_GETLOADAVG = 0; then
+ AC_LIBOBJ([getloadavg])
+ gl_PREREQ_GETLOADAVG
+ fi
+ gl_STDLIB_MODULE_INDICATOR([getloadavg])
+ gl_FUNC_GETOPT_GNU
+ if test $REPLACE_GETOPT = 1; then
+ AC_LIBOBJ([getopt])
+ AC_LIBOBJ([getopt1])
+ gl_PREREQ_GETOPT
+ dnl Arrange for unistd.h to include getopt.h.
+ GNULIB_GL_UNISTD_H_GETOPT=1
+ fi
+ AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT])
+ gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu])
+ gl_FUNC_GETOPT_POSIX
+ if test $REPLACE_GETOPT = 1; then
+ AC_LIBOBJ([getopt])
+ AC_LIBOBJ([getopt1])
+ gl_PREREQ_GETOPT
+ dnl Arrange for unistd.h to include getopt.h.
+ GNULIB_GL_UNISTD_H_GETOPT=1
+ fi
+ AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT])
+ gl_GETTIME
+ gl_FUNC_GETTIMEOFDAY
+ if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then
+ AC_LIBOBJ([gettimeofday])
+ gl_PREREQ_GETTIMEOFDAY
+ fi
+ gl_SYS_TIME_MODULE_INDICATOR([gettimeofday])
+ gl_INTTYPES_INCOMPLETE
+ AC_REQUIRE([gl_LARGEFILE])
+ gl_FUNC_LSTAT
+ if test $REPLACE_LSTAT = 1; then
+ AC_LIBOBJ([lstat])
+ gl_PREREQ_LSTAT
+ fi
+ gl_SYS_STAT_MODULE_INDICATOR([lstat])
+ gl_FUNC_MKTIME
+ if test $REPLACE_MKTIME = 1; then
+ AC_LIBOBJ([mktime])
+ gl_PREREQ_MKTIME
+ fi
+ gl_TIME_MODULE_INDICATOR([mktime])
+ gl_MULTIARCH
+ gl_FUNC_PSELECT
+ if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then
+ AC_LIBOBJ([pselect])
+ fi
+ gl_SYS_SELECT_MODULE_INDICATOR([pselect])
+ gl_FUNC_PTHREAD_SIGMASK
+ if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
+ AC_LIBOBJ([pthread_sigmask])
+ gl_PREREQ_PTHREAD_SIGMASK
+ fi
+ gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask])
+ gl_FUNC_READLINK
+ if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
+ AC_LIBOBJ([readlink])
+ gl_PREREQ_READLINK
+ fi
+ gl_UNISTD_MODULE_INDICATOR([readlink])
+ gl_SIGNAL_H
+ gl_TYPE_SOCKLEN_T
+ gt_TYPE_SSIZE_T
+ gl_STAT_TIME
+ gl_STAT_BIRTHTIME
+ gl_STDALIGN_H
+ gl_STDARG_H
+ AM_STDBOOL_H
+ gl_STDDEF_H
+ gl_STDINT_H
+ gl_STDIO_H
+ gl_STDLIB_H
+ gl_FUNC_GNU_STRFTIME
+ gl_FUNC_STRTOIMAX
+ if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
+ AC_LIBOBJ([strtoimax])
+ gl_PREREQ_STRTOIMAX
+ fi
+ gl_INTTYPES_MODULE_INDICATOR([strtoimax])
+ gl_FUNC_STRTOUMAX
+ if test $ac_cv_func_strtoumax = no; then
+ AC_LIBOBJ([strtoumax])
+ gl_PREREQ_STRTOUMAX
+ fi
+ gl_INTTYPES_MODULE_INDICATOR([strtoumax])
+ gl_FUNC_SYMLINK
+ if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then
+ AC_LIBOBJ([symlink])
+ fi
+ gl_UNISTD_MODULE_INDICATOR([symlink])
+ gl_HEADER_SYS_SELECT
+ AC_PROG_MKDIR_P
+ gl_HEADER_SYS_STAT_H
+ AC_PROG_MKDIR_P
+ gl_HEADER_SYS_TIME_H
+ AC_PROG_MKDIR_P
+ gl_HEADER_TIME_H
+ gl_TIME_R
+ if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
+ AC_LIBOBJ([time_r])
+ gl_PREREQ_TIME_R
+ fi
+ gl_TIME_MODULE_INDICATOR([time_r])
+ gl_TIMER_TIME
+ gl_TIMESPEC
+ gl_UNISTD_H
+ gl_UTIMENS
gl_gnulib_enabled_dosname=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
gl_gnulib_enabled_pathmax=false
- gl_gnulib_enabled_sigprocmask=false
gl_gnulib_enabled_stat=false
gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_strtoull=false
func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 ()
{
if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then
-AC_SUBST([LIBINTL])
-AC_SUBST([LTLIBINTL])
+ AC_SUBST([LIBINTL])
+ AC_SUBST([LTLIBINTL])
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true
fi
}
func_gl_gnulib_m4code_pathmax ()
{
if ! $gl_gnulib_enabled_pathmax; then
-gl_PATHMAX
+ gl_PATHMAX
gl_gnulib_enabled_pathmax=true
fi
}
- func_gl_gnulib_m4code_sigprocmask ()
- {
- if ! $gl_gnulib_enabled_sigprocmask; then
-gl_SIGNALBLOCKING
-if test $HAVE_POSIX_SIGNALBLOCKING = 0; then
- AC_LIBOBJ([sigprocmask])
- gl_PREREQ_SIGPROCMASK
-fi
-gl_SIGNAL_MODULE_INDICATOR([sigprocmask])
- gl_gnulib_enabled_sigprocmask=true
- fi
- }
func_gl_gnulib_m4code_stat ()
{
if ! $gl_gnulib_enabled_stat; then
-gl_FUNC_STAT
-if test $REPLACE_STAT = 1; then
- AC_LIBOBJ([stat])
- gl_PREREQ_STAT
-fi
-gl_SYS_STAT_MODULE_INDICATOR([stat])
+ gl_FUNC_STAT
+ if test $REPLACE_STAT = 1; then
+ AC_LIBOBJ([stat])
+ gl_PREREQ_STAT
+ fi
+ gl_SYS_STAT_MODULE_INDICATOR([stat])
gl_gnulib_enabled_stat=true
if test $REPLACE_STAT = 1; then
func_gl_gnulib_m4code_dosname
func_gl_gnulib_m4code_strtoll ()
{
if ! $gl_gnulib_enabled_strtoll; then
-gl_FUNC_STRTOLL
-if test $HAVE_STRTOLL = 0; then
- AC_LIBOBJ([strtoll])
- gl_PREREQ_STRTOLL
-fi
-gl_STDLIB_MODULE_INDICATOR([strtoll])
+ gl_FUNC_STRTOLL
+ if test $HAVE_STRTOLL = 0; then
+ AC_LIBOBJ([strtoll])
+ gl_PREREQ_STRTOLL
+ fi
+ gl_STDLIB_MODULE_INDICATOR([strtoll])
gl_gnulib_enabled_strtoll=true
fi
}
func_gl_gnulib_m4code_strtoull ()
{
if ! $gl_gnulib_enabled_strtoull; then
-gl_FUNC_STRTOULL
-if test $HAVE_STRTOULL = 0; then
- AC_LIBOBJ([strtoull])
- gl_PREREQ_STRTOULL
-fi
-gl_STDLIB_MODULE_INDICATOR([strtoull])
+ gl_FUNC_STRTOULL
+ if test $HAVE_STRTOULL = 0; then
+ AC_LIBOBJ([strtoull])
+ gl_PREREQ_STRTOULL
+ fi
+ gl_STDLIB_MODULE_INDICATOR([strtoull])
gl_gnulib_enabled_strtoull=true
fi
}
if test $REPLACE_LSTAT = 1; then
func_gl_gnulib_m4code_stat
fi
- if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then
- func_gl_gnulib_m4code_sigprocmask
- fi
if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then
func_gl_gnulib_m4code_stat
fi
- if test $ac_cv_func_strtoimax = no; then
- func_gl_gnulib_m4code_verify
- fi
- if test $ac_cv_func_strtoimax = no && test $ac_cv_type_long_long_int = yes; then
+ if { test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then
func_gl_gnulib_m4code_strtoll
fi
- if test $ac_cv_func_strtoumax = no; then
+ if test $HAVE_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
func_gl_gnulib_m4code_verify
fi
if test $ac_cv_func_strtoumax = no && test $ac_cv_type_unsigned_long_long_int = yes; then
func_gl_gnulib_m4code_strtoull
fi
+ if test $ac_cv_func_strtoumax = no; then
+ func_gl_gnulib_m4code_verify
+ fi
m4_pattern_allow([^gl_GNULIB_ENABLED_])
AM_CONDITIONAL([gl_GNULIB_ENABLED_dosname], [$gl_gnulib_enabled_dosname])
AM_CONDITIONAL([gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36], [$gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36])
AM_CONDITIONAL([gl_GNULIB_ENABLED_pathmax], [$gl_gnulib_enabled_pathmax])
- AM_CONDITIONAL([gl_GNULIB_ENABLED_sigprocmask], [$gl_gnulib_enabled_sigprocmask])
AM_CONDITIONAL([gl_GNULIB_ENABLED_stat], [$gl_gnulib_enabled_stat])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoull], [$gl_gnulib_enabled_strtoull])
lib/alloca.in.h
lib/allocator.c
lib/allocator.h
+ lib/c-ctype.c
+ lib/c-ctype.h
+ lib/c-strcase.h
+ lib/c-strcasecmp.c
+ lib/c-strncasecmp.c
lib/careadlinkat.c
lib/careadlinkat.h
lib/dosname.h
lib/dtoastr.c
+ lib/dtotimespec.c
lib/dup2.c
+ lib/execinfo.c
+ lib/execinfo.in.h
lib/filemode.c
lib/filemode.h
lib/ftoastr.c
lib/getopt1.c
lib/getopt_int.h
lib/gettext.h
+ lib/gettime.c
+ lib/gettimeofday.c
lib/ignore-value.h
lib/intprops.h
lib/inttypes.in.h
lib/mktime-internal.h
lib/mktime.c
lib/pathmax.h
+ lib/pselect.c
lib/pthread_sigmask.c
lib/readlink.c
lib/sha1.c
lib/sha512.c
lib/sha512.h
lib/signal.in.h
- lib/sigprocmask.c
+ lib/stat-time.c
+ lib/stat-time.h
lib/stat.c
+ lib/stdalign.in.h
lib/stdarg.in.h
lib/stdbool.in.h
lib/stddef.in.h
lib/strtoull.c
lib/strtoumax.c
lib/symlink.c
+ lib/sys_select.in.h
lib/sys_stat.in.h
+ lib/sys_time.in.h
lib/time.in.h
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
+ lib/utimens.h
lib/verify.h
m4/00gnulib.m4
m4/alloca.m4
m4/c-strtod.m4
+ m4/clock_time.m4
m4/dup2.m4
+ m4/environ.m4
+ m4/execinfo.m4
m4/extensions.m4
+ m4/extern-inline.m4
m4/filemode.m4
m4/getloadavg.m4
m4/getopt.m4
+ m4/gettime.m4
+ m4/gettimeofday.m4
m4/gnulib-common.m4
m4/include_next.m4
m4/inttypes.m4
m4/largefile.m4
m4/longlong.m4
m4/lstat.m4
+ m4/manywarnings.m4
m4/md5.m4
m4/mktime.m4
m4/multiarch.m4
m4/nocrash.m4
+ m4/off_t.m4
m4/pathmax.m4
+ m4/pselect.m4
m4/pthread_sigmask.m4
m4/readlink.m4
m4/sha1.m4
m4/sha256.m4
m4/sha512.m4
m4/signal_h.m4
- m4/signalblocking.m4
m4/socklen.m4
m4/ssize_t.m4
m4/st_dm_mode.m4
+ m4/stat-time.m4
m4/stat.m4
+ m4/stdalign.m4
m4/stdarg.m4
m4/stdbool.m4
m4/stddef_h.m4
m4/strtoull.m4
m4/strtoumax.m4
m4/symlink.m4
+ m4/sys_select_h.m4
+ m4/sys_socket_h.m4
m4/sys_stat_h.m4
+ m4/sys_time_h.m4
m4/time_h.m4
m4/time_r.m4
+ m4/timer_time.m4
+ m4/timespec.m4
m4/tm_gmtoff.m4
m4/unistd_h.m4
+ m4/utimbuf.m4
+ m4/utimens.m4
+ m4/utimes.m4
m4/warn-on-use.m4
+ m4/warnings.m4
m4/wchar_t.m4
])
# gnulib-tool.m4 serial 2
-dnl Copyright (C) 2004-2005, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2004-2005, 2009-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.
-# include_next.m4 serial 22
-dnl Copyright (C) 2006-2011 Free Software Foundation, Inc.
+# include_next.m4 serial 23
+dnl Copyright (C) 2006-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.
# even if the compiler does not support include_next.
# The three "///" are to pacify Sun C 5.8, which otherwise would say
# "warning: #include of /usr/include/... may be non-portable".
-# Use `""', not `<>', so that the /// cannot be confused with a C99 comment.
+# Use '""', not '<>', so that the /// cannot be confused with a C99 comment.
# Note: This macro assumes that the header file is not empty after
# preprocessing, i.e. it does not only define preprocessor macros but also
# provides some type/enum definitions or function/variable declarations.
gl_dirsep_regex='[/\\]'
;;
*)
- gl_dirsep_regex='/'
+ gl_dirsep_regex='\/'
;;
esac
+ dnl A sed expression that turns a string into a basic regular
+ dnl expression, for use within "/.../".
+ gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g'
changequote([,])
- gl_absolute_header_sed='\|'"${gl_dirsep_regex}"']m4_defn([gl_HEADER_NAME])[|{
- s|.*"\(.*'"${gl_dirsep_regex}"']m4_defn([gl_HEADER_NAME])[\)".*|\1|
+ gl_header_literal_regex=`echo ']m4_defn([gl_HEADER_NAME])[' \
+ | sed -e "$gl_make_literal_regex_sed"`
+ gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{
+ s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/
changequote(,)dnl
s|^/[^/]|//&|
changequote([,])dnl
-# inttypes.m4 serial 24
-dnl Copyright (C) 2006-2011 Free Software Foundation, Inc.
+# inttypes.m4 serial 26
+dnl Copyright (C) 2006-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_REQUIRE([gl_MULTIARCH])
- dnl Ensure that <stdint.h> defines the limit macros, since gnulib's
- dnl <inttypes.h> relies on them. This macro is only needed when a
- dnl C++ compiler is in use; it has no effect for a C compiler.
- dnl Also be careful to define __STDC_LIMIT_MACROS only when gnulib's
- dnl <inttypes.h> is going to be created, and to avoid redefinition warnings
- dnl if the __STDC_LIMIT_MACROS is already defined through the CPPFLAGS.
- AC_DEFINE([GL_TRIGGER_STDC_LIMIT_MACROS], [1],
- [Define to make the limit macros in <stdint.h> visible.])
- AH_VERBATIM([__STDC_LIMIT_MACROS_ZZZ],
-[/* Ensure that <stdint.h> defines the limit macros, since gnulib's
- <inttypes.h> relies on them. */
-#if defined __cplusplus && !defined __STDC_LIMIT_MACROS && GL_TRIGGER_STDC_LIMIT_MACROS
-# define __STDC_LIMIT_MACROS 1
-#endif
-])
-
dnl Check for declarations of anything we want to poison if the
dnl corresponding gnulib module is not in use.
gl_WARN_ON_USE_PREPARE([[#include <inttypes.h>
HAVE_DECL_IMAXDIV=1; AC_SUBST([HAVE_DECL_IMAXDIV])
HAVE_DECL_STRTOIMAX=1; AC_SUBST([HAVE_DECL_STRTOIMAX])
HAVE_DECL_STRTOUMAX=1; AC_SUBST([HAVE_DECL_STRTOUMAX])
+ REPLACE_STRTOIMAX=0; AC_SUBST([REPLACE_STRTOIMAX])
INT32_MAX_LT_INTMAX_MAX=1; AC_SUBST([INT32_MAX_LT_INTMAX_MAX])
INT64_MAX_EQ_LONG_MAX='defined _LP64'; AC_SUBST([INT64_MAX_EQ_LONG_MAX])
PRI_MACROS_BROKEN=0; AC_SUBST([PRI_MACROS_BROKEN])
# Enable large files on systems where this is not the default.
-# Copyright 1992-1996, 1998-2011 Free Software Foundation, Inc.
+# Copyright 1992-1996, 1998-2012 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
])# AC_SYS_LARGEFILE
])# m4_version_prereq 2.69
+
+# Enable large files on systems where this is implemented by Gnulib, not by the
+# system headers.
+# Set the variables WINDOWS_64_BIT_OFF_T, WINDOWS_64_BIT_ST_SIZE if Gnulib
+# overrides ensure that off_t or 'struct size.st_size' are 64-bit, respectively.
+AC_DEFUN([gl_LARGEFILE],
+[
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ case "$host_os" in
+ mingw*)
+ dnl Native Windows.
+ dnl mingw64 defines off_t to a 64-bit type already, if
+ dnl _FILE_OFFSET_BITS=64, which is ensured by AC_SYS_LARGEFILE.
+ AC_CACHE_CHECK([for 64-bit off_t], [gl_cv_type_off_t_64],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/types.h>
+ int verify_off_t_size[sizeof (off_t) >= 8 ? 1 : -1];
+ ]],
+ [[]])],
+ [gl_cv_type_off_t_64=yes], [gl_cv_type_off_t_64=no])
+ ])
+ if test $gl_cv_type_off_t_64 = no; then
+ WINDOWS_64_BIT_OFF_T=1
+ else
+ WINDOWS_64_BIT_OFF_T=0
+ fi
+ dnl But all native Windows platforms (including mingw64) have a 32-bit
+ dnl st_size member in 'struct stat'.
+ WINDOWS_64_BIT_ST_SIZE=1
+ ;;
+ *)
+ dnl Nothing to do on gnulib's side.
+ dnl A 64-bit off_t is
+ dnl - already the default on Mac OS X, FreeBSD, NetBSD, OpenBSD, IRIX,
+ dnl OSF/1, Cygwin,
+ dnl - enabled by _FILE_OFFSET_BITS=64 (ensured by AC_SYS_LARGEFILE) on
+ dnl glibc, HP-UX, Solaris,
+ dnl - enabled by _LARGE_FILES=1 (ensured by AC_SYS_LARGEFILE) on AIX,
+ dnl - impossible to achieve on Minix 3.1.8.
+ WINDOWS_64_BIT_OFF_T=0
+ WINDOWS_64_BIT_ST_SIZE=0
+ ;;
+ esac
+])
-# longlong.m4 serial 16
-dnl Copyright (C) 1999-2007, 2009-2011 Free Software Foundation, Inc.
+# longlong.m4 serial 17
+dnl Copyright (C) 1999-2007, 2009-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.
fi])
if test $ac_cv_type_long_long_int = yes; then
AC_DEFINE([HAVE_LONG_LONG_INT], [1],
- [Define to 1 if the system has the type `long long int'.])
+ [Define to 1 if the system has the type 'long long int'.])
fi
])
fi])
if test $ac_cv_type_unsigned_long_long_int = yes; then
AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1],
- [Define to 1 if the system has the type `unsigned long long int'.])
+ [Define to 1 if the system has the type 'unsigned long long int'.])
fi
])
-# serial 23
+# serial 25
-# Copyright (C) 1997-2001, 2003-2011 Free Software Foundation, Inc.
+# Copyright (C) 1997-2001, 2003-2012 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
AC_CHECK_FUNCS_ONCE([lstat])
if test $ac_cv_func_lstat = yes; then
AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
- if test $gl_cv_func_lstat_dereferences_slashed_symlink = no; then
- REPLACE_LSTAT=1
- fi
+ case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ *no)
+ REPLACE_LSTAT=1
+ ;;
+ esac
else
HAVE_LSTAT=0
fi
]])],
[gl_cv_func_lstat_dereferences_slashed_symlink=yes],
[gl_cv_func_lstat_dereferences_slashed_symlink=no],
- [# When cross-compiling, be pessimistic so we will end up using the
- # replacement version of lstat that checks for trailing slashes and
- # calls lstat a second time when necessary.
- gl_cv_func_lstat_dereferences_slashed_symlink=no
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;;
+ esac
])
else
# If the 'ln -s' command failed, then we probably don't even
# have an lstat function.
- gl_cv_func_lstat_dereferences_slashed_symlink=no
+ gl_cv_func_lstat_dereferences_slashed_symlink="guessing no"
fi
rm -f conftest.sym conftest.file
])
- test $gl_cv_func_lstat_dereferences_slashed_symlink = yes &&
- AC_DEFINE_UNQUOTED([LSTAT_FOLLOWS_SLASHED_SYMLINK], [1],
- [Define to 1 if `lstat' dereferences a symlink specified
- with a trailing slash.])
+ case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ *yes)
+ AC_DEFINE_UNQUOTED([LSTAT_FOLLOWS_SLASHED_SYMLINK], [1],
+ [Define to 1 if 'lstat' dereferences a symlink specified
+ with a trailing slash.])
+ ;;
+ esac
])
--- /dev/null
+# manywarnings.m4 serial 4
+dnl Copyright (C) 2008-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.
+
+dnl From Simon Josefsson
+
+# gl_MANYWARN_COMPLEMENT(OUTVAR, LISTVAR, REMOVEVAR)
+# --------------------------------------------------
+# Copy LISTVAR to OUTVAR except for the entries in REMOVEVAR.
+# Elements separated by whitespace. In set logic terms, the function
+# does OUTVAR = LISTVAR \ REMOVEVAR.
+AC_DEFUN([gl_MANYWARN_COMPLEMENT],
+[
+ gl_warn_set=
+ set x $2; shift
+ for gl_warn_item
+ do
+ case " $3 " in
+ *" $gl_warn_item "*)
+ ;;
+ *)
+ gl_warn_set="$gl_warn_set $gl_warn_item"
+ ;;
+ esac
+ done
+ $1=$gl_warn_set
+])
+
+# gl_MANYWARN_ALL_GCC(VARIABLE)
+# -----------------------------
+# Add all documented GCC warning parameters to variable VARIABLE.
+# Note that you need to test them using gl_WARN_ADD if you want to
+# make sure your gcc understands it.
+AC_DEFUN([gl_MANYWARN_ALL_GCC],
+[
+ dnl First, check if -Wno-missing-field-initializers is needed.
+ dnl -Wmissing-field-initializers is implied by -W, but that issues
+ dnl warnings with GCC version before 4.7, for the common idiom
+ dnl of initializing types on the stack to zero, using { 0, }
+ AC_REQUIRE([AC_PROG_CC])
+ if test -n "$GCC"; then
+
+ dnl First, check -W -Werror -Wno-missing-field-initializers is supported
+ dnl with the current $CC $CFLAGS $CPPFLAGS.
+ AC_MSG_CHECKING([whether -Wno-missing-field-initializers is supported])
+ AC_CACHE_VAL([gl_cv_cc_nomfi_supported], [
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -W -Werror -Wno-missing-field-initializers"
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[]], [[]])],
+ [gl_cv_cc_nomfi_supported=yes],
+ [gl_cv_cc_nomfi_supported=no])
+ CFLAGS="$gl_save_CFLAGS"])
+ AC_MSG_RESULT([$gl_cv_cc_nomfi_supported])
+
+ if test "$gl_cv_cc_nomfi_supported" = yes; then
+ dnl Now check whether -Wno-missing-field-initializers is needed
+ dnl for the { 0, } construct.
+ AC_MSG_CHECKING([whether -Wno-missing-field-initializers is needed])
+ AC_CACHE_VAL([gl_cv_cc_nomfi_needed], [
+ gl_save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -W -Werror"
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[void f (void)
+ {
+ typedef struct { int a; int b; } s_t;
+ s_t s1 = { 0, };
+ }
+ ]],
+ [[]])],
+ [gl_cv_cc_nomfi_needed=no],
+ [gl_cv_cc_nomfi_needed=yes])
+ CFLAGS="$gl_save_CFLAGS"
+ ])
+ AC_MSG_RESULT([$gl_cv_cc_nomfi_needed])
+ fi
+ fi
+
+ gl_manywarn_set=
+ for gl_manywarn_item in \
+ -W \
+ -Wabi \
+ -Waddress \
+ -Wall \
+ -Warray-bounds \
+ -Wattributes \
+ -Wbad-function-cast \
+ -Wbuiltin-macro-redefined \
+ -Wcast-align \
+ -Wchar-subscripts \
+ -Wclobbered \
+ -Wcomment \
+ -Wcomments \
+ -Wcoverage-mismatch \
+ -Wcpp \
+ -Wdeprecated \
+ -Wdeprecated-declarations \
+ -Wdisabled-optimization \
+ -Wdiv-by-zero \
+ -Wdouble-promotion \
+ -Wempty-body \
+ -Wendif-labels \
+ -Wenum-compare \
+ -Wextra \
+ -Wformat-contains-nul \
+ -Wformat-extra-args \
+ -Wformat-nonliteral \
+ -Wformat-security \
+ -Wformat-y2k \
+ -Wformat-zero-length \
+ -Wformat=2 \
+ -Wfree-nonheap-object \
+ -Wignored-qualifiers \
+ -Wimplicit \
+ -Wimplicit-function-declaration \
+ -Wimplicit-int \
+ -Winit-self \
+ -Winline \
+ -Wint-to-pointer-cast \
+ -Winvalid-memory-model \
+ -Winvalid-pch \
+ -Wjump-misses-init \
+ -Wlogical-op \
+ -Wmain \
+ -Wmaybe-uninitialized \
+ -Wmissing-braces \
+ -Wmissing-declarations \
+ -Wmissing-field-initializers \
+ -Wmissing-format-attribute \
+ -Wmissing-include-dirs \
+ -Wmissing-noreturn \
+ -Wmissing-parameter-type \
+ -Wmissing-prototypes \
+ -Wmudflap \
+ -Wmultichar \
+ -Wnarrowing \
+ -Wnested-externs \
+ -Wnonnull \
+ -Wnormalized=nfc \
+ -Wold-style-declaration \
+ -Wold-style-definition \
+ -Woverflow \
+ -Woverlength-strings \
+ -Woverride-init \
+ -Wpacked \
+ -Wpacked-bitfield-compat \
+ -Wparentheses \
+ -Wpointer-arith \
+ -Wpointer-sign \
+ -Wpointer-to-int-cast \
+ -Wpragmas \
+ -Wreturn-type \
+ -Wsequence-point \
+ -Wshadow \
+ -Wsizeof-pointer-memaccess \
+ -Wstack-protector \
+ -Wstrict-aliasing \
+ -Wstrict-overflow \
+ -Wstrict-prototypes \
+ -Wsuggest-attribute=const \
+ -Wsuggest-attribute=format \
+ -Wsuggest-attribute=noreturn \
+ -Wsuggest-attribute=pure \
+ -Wswitch \
+ -Wswitch-default \
+ -Wsync-nand \
+ -Wsystem-headers \
+ -Wtrampolines \
+ -Wtrigraphs \
+ -Wtype-limits \
+ -Wuninitialized \
+ -Wunknown-pragmas \
+ -Wunreachable-code \
+ -Wunsafe-loop-optimizations \
+ -Wunused \
+ -Wunused-but-set-parameter \
+ -Wunused-but-set-variable \
+ -Wunused-function \
+ -Wunused-label \
+ -Wunused-local-typedefs \
+ -Wunused-macros \
+ -Wunused-parameter \
+ -Wunused-result \
+ -Wunused-value \
+ -Wunused-variable \
+ -Wvarargs \
+ -Wvariadic-macros \
+ -Wvector-operation-performance \
+ -Wvla \
+ -Wvolatile-register-var \
+ -Wwrite-strings \
+ \
+ ; do
+ gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item"
+ done
+
+ # Disable the missing-field-initializers warning if needed
+ if test "$gl_cv_cc_nomfi_needed" = yes; then
+ gl_manywarn_set="$gl_manywarn_set -Wno-missing-field-initializers"
+ fi
+
+ $1=$gl_manywarn_set
+])
# md5.m4 serial 12
-dnl Copyright (C) 2002-2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2008-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.
-# serial 21
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2011 Free Software Foundation,
+# serial 24
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2012 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
AC_CHECK_FUNCS_ONCE([alarm])
AC_REQUIRE([gl_MULTIARCH])
if test $APPLE_UNIVERSAL_BUILD = 1; then
- # A universal build on Apple MacOS X platforms.
+ # A universal build on Apple Mac OS X platforms.
# The test result would be 'yes' in 32-bit mode and 'no' in 64-bit mode.
# But we need a configuration result that is valid in both modes.
gl_cv_func_working_mktime=no
if (tz_strings[i])
putenv (tz_strings[i]);
- for (t = 0; t <= time_t_max - delta; t += delta)
+ for (t = 0; t <= time_t_max - delta && (result & 1) == 0; t += delta)
if (! mktime_test (t))
result |= 1;
- if (! (mktime_test ((time_t) 1)
- && mktime_test ((time_t) (60 * 60))
- && mktime_test ((time_t) (60 * 60 * 24))))
+ if ((result & 2) == 0
+ && ! (mktime_test ((time_t) 1)
+ && mktime_test ((time_t) (60 * 60))
+ && mktime_test ((time_t) (60 * 60 * 24))))
result |= 2;
- for (j = 1; ; j <<= 1)
- if (! bigtime_test (j))
- result |= 4;
- else if (INT_MAX / 2 < j)
- break;
- if (! bigtime_test (INT_MAX))
+ for (j = 1; (result & 4) == 0; j <<= 1)
+ {
+ if (! bigtime_test (j))
+ result |= 4;
+ if (INT_MAX / 2 < j)
+ break;
+ }
+ if ((result & 8) == 0 && ! bigtime_test (INT_MAX))
result |= 8;
}
if (! irix_6_4_bug ())
])
# Prerequisites of lib/mktime.c.
-AC_DEFUN([gl_PREREQ_MKTIME],
-[
- AC_REQUIRE([AC_C_INLINE])
-])
+AC_DEFUN([gl_PREREQ_MKTIME], [:])
-# multiarch.m4 serial 6
-dnl Copyright (C) 2008-2011 Free Software Foundation, Inc.
+# multiarch.m4 serial 7
+dnl Copyright (C) 2008-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.
# Determine whether the compiler is or may be producing universal binaries.
#
-# On MacOS X 10.5 and later systems, the user can create libraries and
+# On Mac OS X 10.5 and later systems, the user can create libraries and
# executables that work on multiple system types--known as "fat" or
# "universal" binaries--by specifying multiple '-arch' options to the
# compiler but only a single '-arch' option to the preprocessor. Like
-# nocrash.m4 serial 3
-dnl Copyright (C) 2005, 2009-2011 Free Software Foundation, Inc.
+# nocrash.m4 serial 4
+dnl Copyright (C) 2005, 2009-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_NOCRASH],[[
#include <stdlib.h>
#if defined __MACH__ && defined __APPLE__
-/* Avoid a crash on MacOS X. */
+/* Avoid a crash on Mac OS X. */
#include <mach/mach.h>
#include <mach/mach_error.h>
#include <mach/thread_status.h>
--- /dev/null
+# off_t.m4 serial 1
+dnl Copyright (C) 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.
+
+dnl Check whether to override the 'off_t' type.
+dnl Set WINDOWS_64_BIT_OFF_T.
+
+AC_DEFUN([gl_TYPE_OFF_T],
+[
+ m4_ifdef([gl_LARGEFILE], [
+ AC_REQUIRE([gl_LARGEFILE])
+ ], [
+ WINDOWS_64_BIT_OFF_T=0
+ ])
+ AC_SUBST([WINDOWS_64_BIT_OFF_T])
+])
# pathmax.m4 serial 10
-dnl Copyright (C) 2002-2003, 2005-2006, 2009-2011 Free Software Foundation,
+dnl Copyright (C) 2002-2003, 2005-2006, 2009-2012 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
--- /dev/null
+# pselect.m4
+dnl Copyright (C) 2011-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_FUNC_PSELECT],
+[
+ AC_REQUIRE([gl_HEADER_SYS_SELECT])
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_CHECK_FUNCS_ONCE([pselect])
+
+ if test $ac_cv_func_pselect = yes; then
+ AC_CACHE_CHECK([whether signature of pselect conforms to POSIX],
+ gl_cv_sig_pselect,
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/select.h>
+ ]],
+ [[int (*p) (int, fd_set *, fd_set *, fd_set *restrict,
+ struct timespec const *restrict,
+ sigset_t const *restrict) = pselect;
+ return !p;]])],
+ [gl_cv_sig_pselect=yes],
+ [gl_cv_sig_pselect=no])])
+ fi
+
+ if test $ac_cv_func_pselect = no || test $gl_cv_sig_pselect = no; then
+ REPLACE_PSELECT=1
+ fi
+])
-# pthread_sigmask.m4 serial 12
-dnl Copyright (C) 2011 Free Software Foundation, Inc.
+# pthread_sigmask.m4 serial 13
+dnl Copyright (C) 2011-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_FUNC_PTHREAD_SIGMASK],
[
+ AC_REQUIRE([gl_SIGNAL_H_DEFAULTS])
+
AC_CHECK_FUNCS_ONCE([pthread_sigmask])
LIB_PTHREAD_SIGMASK=
-# readlink.m4 serial 11
-dnl Copyright (C) 2003, 2007, 2009-2011 Free Software Foundation, Inc.
+# readlink.m4 serial 12
+dnl Copyright (C) 2003, 2007, 2009-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_FUNC_READLINK],
[
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CHECK_FUNCS_ONCE([readlink])
if test $ac_cv_func_readlink = no; then
HAVE_READLINK=0
]], [[char buf[20];
return readlink ("conftest.lnk2/", buf, sizeof buf) != -1;]])],
[gl_cv_func_readlink_works=yes], [gl_cv_func_readlink_works=no],
- [gl_cv_func_readlink_works="guessing no"])
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_readlink_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_readlink_works="guessing no" ;;
+ esac
+ ])
rm -f conftest.link conftest.lnk2])
- if test "$gl_cv_func_readlink_works" != yes; then
- AC_DEFINE([READLINK_TRAILING_SLASH_BUG], [1], [Define to 1 if readlink
- fails to recognize a trailing slash.])
- REPLACE_READLINK=1
- elif test "$gl_cv_decl_readlink_works" != yes; then
- REPLACE_READLINK=1
- fi
+ case "$gl_cv_func_readlink_works" in
+ *yes)
+ if test "$gl_cv_decl_readlink_works" != yes; then
+ REPLACE_READLINK=1
+ fi
+ ;;
+ *)
+ AC_DEFINE([READLINK_TRAILING_SLASH_BUG], [1], [Define to 1 if readlink
+ fails to recognize a trailing slash.])
+ REPLACE_READLINK=1
+ ;;
+ esac
fi
])
# sha1.m4 serial 10
-dnl Copyright (C) 2002-2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2008-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.
# sha256.m4 serial 5
-dnl Copyright (C) 2005, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2008-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.
# sha512.m4 serial 6
-dnl Copyright (C) 2005-2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2006, 2008-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.
# signal_h.m4 serial 18
-dnl Copyright (C) 2007-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-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.
+++ /dev/null
-# signalblocking.m4 serial 13
-dnl Copyright (C) 2001-2002, 2006-2011 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.
-
-# Determine available signal blocking primitives. Three different APIs exist:
-# 1) POSIX: sigemptyset, sigaddset, sigprocmask
-# 2) SYSV: sighold, sigrelse
-# 3) BSD: sigblock, sigsetmask
-# For simplicity, here we check only for the POSIX signal blocking.
-AC_DEFUN([gl_SIGNALBLOCKING],
-[
- AC_REQUIRE([gl_SIGNAL_H_DEFAULTS])
- AC_REQUIRE([gl_CHECK_TYPE_SIGSET_T])
- if test $gl_cv_type_sigset_t = yes; then
- AC_CHECK_FUNC([sigprocmask], [gl_cv_func_sigprocmask=1])
- fi
- if test -z "$gl_cv_func_sigprocmask"; then
- HAVE_POSIX_SIGNALBLOCKING=0
- fi
-])
-
-# Prerequisites of lib/sigprocmask.c.
-AC_DEFUN([gl_PREREQ_SIGPROCMASK], [
- AC_REQUIRE([AC_C_INLINE])
-])
# socklen.m4 serial 10
-dnl Copyright (C) 2005-2007, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2007, 2009-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.
# ssize_t.m4 serial 5 (gettext-0.18.2)
-dnl Copyright (C) 2001-2003, 2006, 2010-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2003, 2006, 2010-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.
# serial 6
-# Copyright (C) 1998-1999, 2001, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 1998-1999, 2001, 2009-2012 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
--- /dev/null
+# Checks for stat-related time functions.
+
+# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2012 Free Software
+# Foundation, Inc.
+
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Paul Eggert.
+
+# st_atim.tv_nsec - Linux, Solaris, Cygwin
+# st_atimespec.tv_nsec - FreeBSD, NetBSD, if ! defined _POSIX_SOURCE
+# st_atimensec - FreeBSD, NetBSD, if defined _POSIX_SOURCE
+# st_atim.st__tim.tv_nsec - UnixWare (at least 2.1.2 through 7.1)
+
+# st_birthtimespec - FreeBSD, NetBSD (hidden on OpenBSD 3.9, anyway)
+# st_birthtim - Cygwin 1.7.0+
+
+AC_DEFUN([gl_STAT_TIME],
+[
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_CHECK_HEADERS_ONCE([sys/time.h])
+
+ AC_CHECK_MEMBERS([struct stat.st_atim.tv_nsec],
+ [AC_CACHE_CHECK([whether struct stat.st_atim is of type struct timespec],
+ [ac_cv_typeof_struct_stat_st_atim_is_struct_timespec],
+ [AC_COMPILE_IFELSE([AC_LANG_PROGRAM(
+ [[
+ #include <sys/types.h>
+ #include <sys/stat.h>
+ #if HAVE_SYS_TIME_H
+ # include <sys/time.h>
+ #endif
+ #include <time.h>
+ struct timespec ts;
+ struct stat st;
+ ]],
+ [[
+ st.st_atim = ts;
+ ]])],
+ [ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=yes],
+ [ac_cv_typeof_struct_stat_st_atim_is_struct_timespec=no])])
+ if test $ac_cv_typeof_struct_stat_st_atim_is_struct_timespec = yes; then
+ AC_DEFINE([TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC], [1],
+ [Define to 1 if the type of the st_atim member of a struct stat is
+ struct timespec.])
+ fi],
+ [AC_CHECK_MEMBERS([struct stat.st_atimespec.tv_nsec], [],
+ [AC_CHECK_MEMBERS([struct stat.st_atimensec], [],
+ [AC_CHECK_MEMBERS([struct stat.st_atim.st__tim.tv_nsec], [], [],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])
+])
+
+# Check for st_birthtime, a feature from UFS2 (FreeBSD, NetBSD, OpenBSD, etc.)
+# and NTFS (Cygwin).
+# There was a time when this field was named st_createtime (21 June
+# 2002 to 16 July 2002) But that window is very small and applied only
+# to development code, so systems still using that configuration are
+# not supported. See revisions 1.10 and 1.11 of FreeBSD's
+# src/sys/ufs/ufs/dinode.h.
+#
+AC_DEFUN([gl_STAT_BIRTHTIME],
+[
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_CHECK_HEADERS_ONCE([sys/time.h])
+ AC_CHECK_MEMBERS([struct stat.st_birthtimespec.tv_nsec], [],
+ [AC_CHECK_MEMBERS([struct stat.st_birthtimensec], [],
+ [AC_CHECK_MEMBERS([struct stat.st_birthtim.tv_nsec], [], [],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])],
+ [#include <sys/types.h>
+ #include <sys/stat.h>])
+])
-# serial 8
+# serial 10
-# Copyright (C) 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 2009-2012 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
mingw*) gl_cv_func_stat_dir_slash="guessing no";;
*) gl_cv_func_stat_dir_slash="guessing yes";;
esac])])
- dnl AIX 7.1, Solaris 9 mistakenly succeed on stat("file/")
- dnl FreeBSD 7.2 mistakenly succeeds on stat("link-to-file/")
+ dnl AIX 7.1, Solaris 9, mingw64 mistakenly succeed on stat("file/").
+ dnl (For mingw, this is due to a broken stat() override in libmingwex.a.)
+ dnl FreeBSD 7.2 mistakenly succeeds on stat("link-to-file/").
AC_CACHE_CHECK([whether stat handles trailing slashes on files],
[gl_cv_func_stat_file_slash],
[touch conftest.tmp
return result;
]])],
[gl_cv_func_stat_file_slash=yes], [gl_cv_func_stat_file_slash=no],
- [gl_cv_func_stat_file_slash="guessing no"])
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_stat_file_slash="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_stat_file_slash="guessing no" ;;
+ esac
+ ])
rm -f conftest.tmp conftest.lnk])
case $gl_cv_func_stat_dir_slash in
*no) REPLACE_STAT=1
--- /dev/null
+# Check for stdalign.h that conforms to C11.
+
+dnl Copyright 2011-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.
+
+# Prepare for substituting <stdalign.h> if it is not supported.
+
+AC_DEFUN([gl_STDALIGN_H],
+[
+ AC_CACHE_CHECK([for working stdalign.h],
+ [gl_cv_header_working_stdalign_h],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <stdalign.h>
+ #include <stddef.h>
+
+ /* Test that alignof yields a result consistent with offsetof.
+ This catches GCC bug 52023
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
+ #ifdef __cplusplus
+ template <class t> struct alignof_helper { char a; t b; };
+ # define ao(type) offsetof (alignof_helper<type>, b)
+ #else
+ # define ao(type) offsetof (struct { char a; type b; }, b)
+ #endif
+ char test_double[ao (double) % _Alignof (double) == 0 ? 1 : -1];
+ char test_long[ao (long int) % _Alignof (long int) == 0 ? 1 : -1];
+ char test_alignof[alignof (double) == _Alignof (double) ? 1 : -1];
+
+ /* Test _Alignas only on platforms where gnulib can help. */
+ #if \
+ (__GNUC__ || __IBMC__ || __IBMCPP__ \
+ || 0x5110 <= __SUNPRO_C || 1300 <= _MSC_VER)
+ int alignas (8) alignas_int = 1;
+ char test_alignas[_Alignof (alignas_int) == 8 ? 1 : -1];
+ #endif
+ ]])],
+ [gl_cv_header_working_stdalign_h=yes],
+ [gl_cv_header_working_stdalign_h=no])])
+
+ if test $gl_cv_header_working_stdalign_h = yes; then
+ STDALIGN_H=''
+ else
+ STDALIGN_H='stdalign.h'
+ fi
+
+ AC_SUBST([STDALIGN_H])
+ AM_CONDITIONAL([GL_GENERATE_STDALIGN_H], [test -n "$STDALIGN_H"])
+])
# stdarg.m4 serial 6
-dnl Copyright (C) 2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2008-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.
# Check for stdbool.h that conforms to C99.
-dnl Copyright (C) 2002-2006, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2009-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.
dnl A placeholder for POSIX 2008 <stddef.h>, for platforms that have issues.
# stddef_h.m4 serial 4
-dnl Copyright (C) 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-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.
-# stdint.m4 serial 41
-dnl Copyright (C) 2001-2011 Free Software Foundation, Inc.
+# stdint.m4 serial 43
+dnl Copyright (C) 2001-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.
[gl_cv_header_working_stdint_h=no
AC_COMPILE_IFELSE([
AC_LANG_PROGRAM([[
-#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
-#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
#include <stdint.h>
/* Dragonfly defines WCHAR_MIN, WCHAR_MAX only in <wchar.h>. */
dnl This detects a bug on HP-UX 11.23/ia64.
AC_RUN_IFELSE([
AC_LANG_PROGRAM([[
-#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
-#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
#include <stdint.h>
]
-# stdio_h.m4 serial 41
-dnl Copyright (C) 2007-2011 Free Software Foundation, Inc.
+# stdio_h.m4 serial 42
+dnl Copyright (C) 2007-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.
dnl No need to create extra modules for these functions. Everyone who uses
dnl <stdio.h> likely needs them.
GNULIB_FSCANF=1
+ gl_MODULE_INDICATOR([fscanf])
GNULIB_SCANF=1
+ gl_MODULE_INDICATOR([scanf])
GNULIB_FGETC=1
GNULIB_GETC=1
GNULIB_GETCHAR=1
dnl Check for declarations of anything we want to poison if the
dnl corresponding gnulib module is not in use, and which is not
- dnl guaranteed by C89 and C11.
+ dnl guaranteed by both C89 and C11.
gl_WARN_ON_USE_PREPARE([[#include <stdio.h>
]], [dprintf fpurge fseeko ftello getdelim getline gets pclose popen
renameat snprintf tmpfile vdprintf vsnprintf])
-# stdlib_h.m4 serial 37
-dnl Copyright (C) 2007-2011 Free Software Foundation, Inc.
+# stdlib_h.m4 serial 41
+dnl Copyright (C) 2007-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.
#if HAVE_RANDOM_H
# include <random.h>
#endif
- ]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt mkdtemp
- mkostemp mkostemps mkstemp mkstemps ptsname random_r initstat_r srandom_r
- setstate_r realpath rpmatch setenv strtod strtoll strtoull unlockpt
- unsetenv])
+ ]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt
+ initstate initstate_r mkdtemp mkostemp mkostemps mkstemp mkstemps
+ posix_openpt ptsname ptsname_r random random_r realpath rpmatch
+ setenv setstate setstate_r srandom srandom_r
+ strtod strtoll strtoull unlockpt unsetenv])
])
AC_DEFUN([gl_STDLIB_MODULE_INDICATOR],
GNULIB_MKOSTEMPS=0; AC_SUBST([GNULIB_MKOSTEMPS])
GNULIB_MKSTEMP=0; AC_SUBST([GNULIB_MKSTEMP])
GNULIB_MKSTEMPS=0; AC_SUBST([GNULIB_MKSTEMPS])
+ GNULIB_POSIX_OPENPT=0; AC_SUBST([GNULIB_POSIX_OPENPT])
GNULIB_PTSNAME=0; AC_SUBST([GNULIB_PTSNAME])
+ GNULIB_PTSNAME_R=0; AC_SUBST([GNULIB_PTSNAME_R])
GNULIB_PUTENV=0; AC_SUBST([GNULIB_PUTENV])
+ GNULIB_RANDOM=0; AC_SUBST([GNULIB_RANDOM])
GNULIB_RANDOM_R=0; AC_SUBST([GNULIB_RANDOM_R])
GNULIB_REALLOC_POSIX=0; AC_SUBST([GNULIB_REALLOC_POSIX])
GNULIB_REALPATH=0; AC_SUBST([GNULIB_REALPATH])
HAVE_MKOSTEMPS=1; AC_SUBST([HAVE_MKOSTEMPS])
HAVE_MKSTEMP=1; AC_SUBST([HAVE_MKSTEMP])
HAVE_MKSTEMPS=1; AC_SUBST([HAVE_MKSTEMPS])
+ HAVE_POSIX_OPENPT=1; AC_SUBST([HAVE_POSIX_OPENPT])
HAVE_PTSNAME=1; AC_SUBST([HAVE_PTSNAME])
+ HAVE_PTSNAME_R=1; AC_SUBST([HAVE_PTSNAME_R])
+ HAVE_RANDOM=1; AC_SUBST([HAVE_RANDOM])
HAVE_RANDOM_H=1; AC_SUBST([HAVE_RANDOM_H])
HAVE_RANDOM_R=1; AC_SUBST([HAVE_RANDOM_R])
HAVE_REALPATH=1; AC_SUBST([HAVE_REALPATH])
REPLACE_MALLOC=0; AC_SUBST([REPLACE_MALLOC])
REPLACE_MBTOWC=0; AC_SUBST([REPLACE_MBTOWC])
REPLACE_MKSTEMP=0; AC_SUBST([REPLACE_MKSTEMP])
+ REPLACE_PTSNAME_R=0; AC_SUBST([REPLACE_PTSNAME_R])
REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV])
+ REPLACE_RANDOM_R=0; AC_SUBST([REPLACE_RANDOM_R])
REPLACE_REALLOC=0; AC_SUBST([REPLACE_REALLOC])
REPLACE_REALPATH=0; AC_SUBST([REPLACE_REALPATH])
REPLACE_SETENV=0; AC_SUBST([REPLACE_SETENV])
# serial 33
-# Copyright (C) 1996-1997, 1999-2007, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2007, 2009-2012 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
-# strtoimax.m4 serial 11
-dnl Copyright (C) 2002-2004, 2006, 2009-2011 Free Software Foundation, Inc.
+# strtoimax.m4 serial 13
+dnl Copyright (C) 2002-2004, 2006, 2009-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.
if test "$ac_cv_have_decl_strtoimax" != yes; then
HAVE_DECL_STRTOIMAX=0
fi
+
+ if test $ac_cv_func_strtoimax = yes; then
+ HAVE_STRTOIMAX=1
+ dnl On AIX 5.1, strtoimax() fails for values outside the 'int' range.
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+ AC_CACHE_CHECK([whether strtoimax works], [gl_cv_func_strtoimax],
+ [AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <errno.h>
+#include <string.h>
+#include <inttypes.h>
+int main ()
+{
+ if (sizeof (intmax_t) > sizeof (int))
+ {
+ const char *s = "4294967295";
+ char *p;
+ intmax_t res;
+ errno = 0;
+ res = strtoimax (s, &p, 10);
+ if (p != s + strlen (s))
+ return 1;
+ if (errno != 0)
+ return 2;
+ if (res != (intmax_t) 65535 * (intmax_t) 65537)
+ return 3;
+ }
+ else
+ {
+ const char *s = "2147483647";
+ char *p;
+ intmax_t res;
+ errno = 0;
+ res = strtoimax (s, &p, 10);
+ if (p != s + strlen (s))
+ return 1;
+ if (errno != 0)
+ return 2;
+ if (res != 2147483647)
+ return 3;
+ }
+ return 0;
+}
+]])],
+ [gl_cv_func_strtoimax=yes],
+ [gl_cv_func_strtoimax=no],
+ [case "$host_os" in
+ # Guess no on AIX 5.
+ aix5*) gl_cv_func_strtoimax="guessing no" ;;
+ # Guess yes otherwise.
+ *) gl_cv_func_strtoimax="guessing yes" ;;
+ esac
+ ])
+ ])
+ case "$gl_cv_func_strtoimax" in
+ *no) REPLACE_STRTOIMAX=1 ;;
+ esac
+ else
+ HAVE_STRTOIMAX=0
+ fi
])
# Prerequisites of lib/strtoimax.c.
# strtoll.m4 serial 7
-dnl Copyright (C) 2002, 2004, 2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2004, 2006, 2008-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.
# strtoull.m4 serial 7
-dnl Copyright (C) 2002, 2004, 2006, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2004, 2006, 2008-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.
# strtoumax.m4 serial 11
-dnl Copyright (C) 2002-2004, 2006, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2006, 2009-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.
-# serial 5
+# serial 6
# See if we need to provide symlink replacement.
-dnl Copyright (C) 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2009-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_FUNC_SYMLINK],
[
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CHECK_FUNCS_ONCE([symlink])
dnl The best we can do on mingw is provide a dummy that always fails, so
dnl that compilation can proceed with fewer ifdefs. On FreeBSD 7.2, AIX 7.1,
return result;
]])],
[gl_cv_func_symlink_works=yes], [gl_cv_func_symlink_works=no],
- [gl_cv_func_symlink_works="guessing no"])
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_symlink_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_symlink_works="guessing no" ;;
+ esac
+ ])
rm -f conftest.f conftest.link conftest.lnk2])
- if test "$gl_cv_func_symlink_works" != yes; then
- REPLACE_SYMLINK=1
- fi
+ case "$gl_cv_func_symlink_works" in
+ *yes) ;;
+ *)
+ REPLACE_SYMLINK=1
+ ;;
+ esac
fi
])
--- /dev/null
+# sys_select_h.m4 serial 20
+dnl Copyright (C) 2006-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_HEADER_SYS_SELECT],
+[
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_REQUIRE([gl_SYS_SELECT_H_DEFAULTS])
+ AC_CACHE_CHECK([whether <sys/select.h> is self-contained],
+ [gl_cv_header_sys_select_h_selfcontained],
+ [
+ dnl Test against two bugs:
+ dnl 1. On many platforms, <sys/select.h> assumes prior inclusion of
+ dnl <sys/types.h>.
+ dnl 2. On OSF/1 4.0, <sys/select.h> provides only a forward declaration
+ dnl of 'struct timeval', and no definition of this type.
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/select.h>]],
+ [[struct timeval b;]])],
+ [gl_cv_header_sys_select_h_selfcontained=yes],
+ [gl_cv_header_sys_select_h_selfcontained=no])
+ dnl Test against another bug:
+ dnl 3. On Solaris 10, <sys/select.h> provides an FD_ZERO implementation
+ dnl that relies on memset(), but without including <string.h>.
+ if test $gl_cv_header_sys_select_h_selfcontained = yes; then
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/select.h>]],
+ [[int memset; int bzero;]])
+ ],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/select.h>]], [[
+ #undef memset
+ #define memset nonexistent_memset
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void *memset (void *, int, unsigned long);
+ #undef bzero
+ #define bzero nonexistent_bzero
+ extern
+ #ifdef __cplusplus
+ "C"
+ #endif
+ void bzero (void *, unsigned long);
+ fd_set fds;
+ FD_ZERO (&fds);
+ ]])
+ ],
+ [],
+ [gl_cv_header_sys_select_h_selfcontained=no])
+ ])
+ fi
+ ])
+ dnl <sys/select.h> is always overridden, because of GNULIB_POSIXCHECK.
+ gl_CHECK_NEXT_HEADERS([sys/select.h])
+ if test $ac_cv_header_sys_select_h = yes; then
+ HAVE_SYS_SELECT_H=1
+ else
+ HAVE_SYS_SELECT_H=0
+ fi
+ AC_SUBST([HAVE_SYS_SELECT_H])
+ gl_PREREQ_SYS_H_WINSOCK2
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+/* Some systems require prerequisite headers. */
+#include <sys/types.h>
+#if !(defined __GLIBC__ && !defined __UCLIBC__) && HAVE_SYS_TIME_H
+# include <sys/time.h>
+#endif
+#include <sys/select.h>
+ ]], [pselect select])
+])
+
+AC_DEFUN([gl_SYS_SELECT_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_SYS_SELECT_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_SYS_SELECT_H_DEFAULTS],
+[
+ GNULIB_PSELECT=0; AC_SUBST([GNULIB_PSELECT])
+ GNULIB_SELECT=0; AC_SUBST([GNULIB_SELECT])
+ dnl Assume proper GNU behavior unless another module says otherwise.
+ HAVE_PSELECT=1; AC_SUBST([HAVE_PSELECT])
+ REPLACE_PSELECT=0; AC_SUBST([REPLACE_PSELECT])
+ REPLACE_SELECT=0; AC_SUBST([REPLACE_SELECT])
+])
--- /dev/null
+# sys_socket_h.m4 serial 22
+dnl Copyright (C) 2005-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.
+
+dnl From Simon Josefsson.
+
+AC_DEFUN([gl_HEADER_SYS_SOCKET],
+[
+ AC_REQUIRE([gl_SYS_SOCKET_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ AC_REQUIRE([AC_C_INLINE])
+
+ dnl On OSF/1, the functions recv(), send(), recvfrom(), sendto() have
+ dnl old-style declarations (with return type 'int' instead of 'ssize_t')
+ dnl unless _POSIX_PII_SOCKET is defined.
+ case "$host_os" in
+ osf*)
+ AC_DEFINE([_POSIX_PII_SOCKET], [1],
+ [Define to 1 in order to get the POSIX compatible declarations
+ of socket functions.])
+ ;;
+ esac
+
+ AC_CACHE_CHECK([whether <sys/socket.h> is self-contained],
+ [gl_cv_header_sys_socket_h_selfcontained],
+ [
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/socket.h>]], [[]])],
+ [gl_cv_header_sys_socket_h_selfcontained=yes],
+ [gl_cv_header_sys_socket_h_selfcontained=no])
+ ])
+ if test $gl_cv_header_sys_socket_h_selfcontained = yes; then
+ dnl If the shutdown function exists, <sys/socket.h> should define
+ dnl SHUT_RD, SHUT_WR, SHUT_RDWR.
+ AC_CHECK_FUNCS([shutdown])
+ if test $ac_cv_func_shutdown = yes; then
+ AC_CACHE_CHECK([whether <sys/socket.h> defines the SHUT_* macros],
+ [gl_cv_header_sys_socket_h_shut],
+ [
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <sys/socket.h>]],
+ [[int a[] = { SHUT_RD, SHUT_WR, SHUT_RDWR };]])],
+ [gl_cv_header_sys_socket_h_shut=yes],
+ [gl_cv_header_sys_socket_h_shut=no])
+ ])
+ if test $gl_cv_header_sys_socket_h_shut = no; then
+ SYS_SOCKET_H='sys/socket.h'
+ fi
+ fi
+ fi
+ # We need to check for ws2tcpip.h now.
+ gl_PREREQ_SYS_H_SOCKET
+ AC_CHECK_TYPES([struct sockaddr_storage, sa_family_t],,,[
+ /* sys/types.h is not needed according to POSIX, but the
+ sys/socket.h in i386-unknown-freebsd4.10 and
+ powerpc-apple-darwin5.5 required it. */
+#include <sys/types.h>
+#ifdef HAVE_SYS_SOCKET_H
+#include <sys/socket.h>
+#endif
+#ifdef HAVE_WS2TCPIP_H
+#include <ws2tcpip.h>
+#endif
+])
+ if test $ac_cv_type_struct_sockaddr_storage = no; then
+ HAVE_STRUCT_SOCKADDR_STORAGE=0
+ fi
+ if test $ac_cv_type_sa_family_t = no; then
+ HAVE_SA_FAMILY_T=0
+ fi
+ if test $ac_cv_type_struct_sockaddr_storage != no; then
+ AC_CHECK_MEMBERS([struct sockaddr_storage.ss_family],
+ [],
+ [HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY=0],
+ [#include <sys/types.h>
+ #ifdef HAVE_SYS_SOCKET_H
+ #include <sys/socket.h>
+ #endif
+ #ifdef HAVE_WS2TCPIP_H
+ #include <ws2tcpip.h>
+ #endif
+ ])
+ fi
+ if test $HAVE_STRUCT_SOCKADDR_STORAGE = 0 || test $HAVE_SA_FAMILY_T = 0 \
+ || test $HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY = 0; then
+ SYS_SOCKET_H='sys/socket.h'
+ fi
+ gl_PREREQ_SYS_H_WINSOCK2
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+/* Some systems require prerequisite headers. */
+#include <sys/types.h>
+#include <sys/socket.h>
+ ]], [socket connect accept bind getpeername getsockname getsockopt
+ listen recv send recvfrom sendto setsockopt shutdown accept4])
+])
+
+AC_DEFUN([gl_PREREQ_SYS_H_SOCKET],
+[
+ dnl Check prerequisites of the <sys/socket.h> replacement.
+ AC_REQUIRE([gl_CHECK_SOCKET_HEADERS])
+ gl_CHECK_NEXT_HEADERS([sys/socket.h])
+ if test $ac_cv_header_sys_socket_h = yes; then
+ HAVE_SYS_SOCKET_H=1
+ HAVE_WS2TCPIP_H=0
+ else
+ HAVE_SYS_SOCKET_H=0
+ if test $ac_cv_header_ws2tcpip_h = yes; then
+ HAVE_WS2TCPIP_H=1
+ else
+ HAVE_WS2TCPIP_H=0
+ fi
+ fi
+ AC_SUBST([HAVE_SYS_SOCKET_H])
+ AC_SUBST([HAVE_WS2TCPIP_H])
+])
+
+# Common prerequisites of the <sys/socket.h> replacement and of the
+# <sys/select.h> replacement.
+# Sets and substitutes HAVE_WINSOCK2_H.
+AC_DEFUN([gl_PREREQ_SYS_H_WINSOCK2],
+[
+ m4_ifdef([gl_UNISTD_H_DEFAULTS], [AC_REQUIRE([gl_UNISTD_H_DEFAULTS])])
+ m4_ifdef([gl_SYS_IOCTL_H_DEFAULTS], [AC_REQUIRE([gl_SYS_IOCTL_H_DEFAULTS])])
+ AC_CHECK_HEADERS_ONCE([sys/socket.h])
+ if test $ac_cv_header_sys_socket_h != yes; then
+ dnl We cannot use AC_CHECK_HEADERS_ONCE here, because that would make
+ dnl the check for those headers unconditional; yet cygwin reports
+ dnl that the headers are present but cannot be compiled (since on
+ dnl cygwin, all socket information should come from sys/socket.h).
+ AC_CHECK_HEADERS([winsock2.h])
+ fi
+ if test "$ac_cv_header_winsock2_h" = yes; then
+ HAVE_WINSOCK2_H=1
+ UNISTD_H_HAVE_WINSOCK2_H=1
+ SYS_IOCTL_H_HAVE_WINSOCK2_H=1
+ else
+ HAVE_WINSOCK2_H=0
+ fi
+ AC_SUBST([HAVE_WINSOCK2_H])
+])
+
+AC_DEFUN([gl_SYS_SOCKET_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_SYS_SOCKET_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_SYS_SOCKET_H_DEFAULTS],
+[
+ GNULIB_SOCKET=0; AC_SUBST([GNULIB_SOCKET])
+ GNULIB_CONNECT=0; AC_SUBST([GNULIB_CONNECT])
+ GNULIB_ACCEPT=0; AC_SUBST([GNULIB_ACCEPT])
+ GNULIB_BIND=0; AC_SUBST([GNULIB_BIND])
+ GNULIB_GETPEERNAME=0; AC_SUBST([GNULIB_GETPEERNAME])
+ GNULIB_GETSOCKNAME=0; AC_SUBST([GNULIB_GETSOCKNAME])
+ GNULIB_GETSOCKOPT=0; AC_SUBST([GNULIB_GETSOCKOPT])
+ GNULIB_LISTEN=0; AC_SUBST([GNULIB_LISTEN])
+ GNULIB_RECV=0; AC_SUBST([GNULIB_RECV])
+ GNULIB_SEND=0; AC_SUBST([GNULIB_SEND])
+ GNULIB_RECVFROM=0; AC_SUBST([GNULIB_RECVFROM])
+ GNULIB_SENDTO=0; AC_SUBST([GNULIB_SENDTO])
+ GNULIB_SETSOCKOPT=0; AC_SUBST([GNULIB_SETSOCKOPT])
+ GNULIB_SHUTDOWN=0; AC_SUBST([GNULIB_SHUTDOWN])
+ GNULIB_ACCEPT4=0; AC_SUBST([GNULIB_ACCEPT4])
+ HAVE_STRUCT_SOCKADDR_STORAGE=1; AC_SUBST([HAVE_STRUCT_SOCKADDR_STORAGE])
+ HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY=1;
+ AC_SUBST([HAVE_STRUCT_SOCKADDR_STORAGE_SS_FAMILY])
+ HAVE_SA_FAMILY_T=1; AC_SUBST([HAVE_SA_FAMILY_T])
+ HAVE_ACCEPT4=1; AC_SUBST([HAVE_ACCEPT4])
+])
-# sys_stat_h.m4 serial 26 -*- Autoconf -*-
-dnl Copyright (C) 2006-2011 Free Software Foundation, Inc.
+# sys_stat_h.m4 serial 28 -*- Autoconf -*-
+dnl Copyright (C) 2006-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_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
- dnl For the mkdir substitute.
- AC_REQUIRE([AC_C_INLINE])
-
dnl Check for broken stat macros.
AC_REQUIRE([AC_HEADER_STAT])
dnl Ensure the type mode_t gets defined.
AC_REQUIRE([AC_TYPE_MODE_T])
+ dnl Whether to override 'struct stat'.
+ m4_ifdef([gl_LARGEFILE], [
+ AC_REQUIRE([gl_LARGEFILE])
+ ], [
+ WINDOWS_64_BIT_ST_SIZE=0
+ ])
+ AC_SUBST([WINDOWS_64_BIT_ST_SIZE])
+ if test $WINDOWS_64_BIT_ST_SIZE = 1; then
+ AC_DEFINE([_GL_WINDOWS_64_BIT_ST_SIZE], [1],
+ [Define to 1 if Gnulib overrides 'struct stat' on Windows so that
+ struct stat.st_size becomes 64-bit.])
+ fi
+
dnl Define types that are supposed to be defined in <sys/types.h> or
dnl <sys/stat.h>.
AC_CHECK_TYPE([nlink_t], [],
--- /dev/null
+# Configure a replacement for <sys/time.h>.
+# serial 8
+
+# Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# Written by Paul Eggert and Martin Lambers.
+
+AC_DEFUN([gl_HEADER_SYS_TIME_H],
+[
+ dnl Use AC_REQUIRE here, so that the REPLACE_GETTIMEOFDAY=0 statement
+ dnl below is expanded once only, before all REPLACE_GETTIMEOFDAY=1
+ dnl statements that occur in other macros.
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H_BODY])
+])
+
+AC_DEFUN([gl_HEADER_SYS_TIME_H_BODY],
+[
+ AC_REQUIRE([AC_C_RESTRICT])
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS])
+ AC_CHECK_HEADERS_ONCE([sys/time.h])
+ gl_CHECK_NEXT_HEADERS([sys/time.h])
+
+ if test $ac_cv_header_sys_time_h != yes; then
+ HAVE_SYS_TIME_H=0
+ fi
+
+ dnl On native Windows with MSVC, 'struct timeval' is defined in <winsock2.h>
+ dnl only. So include that header in the list.
+ gl_PREREQ_SYS_H_WINSOCK2
+ AC_CACHE_CHECK([for struct timeval], [gl_cv_sys_struct_timeval],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #if HAVE_WINSOCK2_H
+ # include <winsock2.h>
+ #endif
+ ]],
+ [[static struct timeval x; x.tv_sec = x.tv_usec;]])],
+ [gl_cv_sys_struct_timeval=yes],
+ [gl_cv_sys_struct_timeval=no])
+ ])
+ if test $gl_cv_sys_struct_timeval != yes; then
+ HAVE_STRUCT_TIMEVAL=0
+ else
+ dnl On native Windows with a 64-bit 'time_t', 'struct timeval' is defined
+ dnl (in <sys/time.h> and <winsock2.h> for mingw64, in <winsock2.h> only
+ dnl for MSVC) with a tv_sec field of type 'long' (32-bit!), which is
+ dnl smaller than the 'time_t' type mandated by POSIX.
+ dnl On OpenBSD 5.1 amd64, tv_sec is 64 bits and time_t 32 bits, but
+ dnl that is good enough.
+ AC_CACHE_CHECK([for wide-enough struct timeval.tv_sec member],
+ [gl_cv_sys_struct_timeval_tv_sec],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #if HAVE_WINSOCK2_H
+ # include <winsock2.h>
+ #endif
+ ]],
+ [[static struct timeval x;
+ typedef int verify_tv_sec_type[
+ sizeof (time_t) <= sizeof x.tv_sec ? 1 : -1
+ ];
+ ]])],
+ [gl_cv_sys_struct_timeval_tv_sec=yes],
+ [gl_cv_sys_struct_timeval_tv_sec=no])
+ ])
+ if test $gl_cv_sys_struct_timeval_tv_sec != yes; then
+ REPLACE_STRUCT_TIMEVAL=1
+ fi
+ fi
+
+ dnl Check for declarations of anything we want to poison if the
+ dnl corresponding gnulib module is not in use.
+ gl_WARN_ON_USE_PREPARE([[
+#if HAVE_SYS_TIME_H
+# include <sys/time.h>
+#endif
+#include <time.h>
+ ]], [gettimeofday])
+])
+
+AC_DEFUN([gl_SYS_TIME_MODULE_INDICATOR],
+[
+ dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+ AC_REQUIRE([gl_HEADER_SYS_TIME_H_DEFAULTS])
+ gl_MODULE_INDICATOR_SET_VARIABLE([$1])
+ dnl Define it also as a C macro, for the benefit of the unit tests.
+ gl_MODULE_INDICATOR_FOR_TESTS([$1])
+])
+
+AC_DEFUN([gl_HEADER_SYS_TIME_H_DEFAULTS],
+[
+ GNULIB_GETTIMEOFDAY=0; AC_SUBST([GNULIB_GETTIMEOFDAY])
+ dnl Assume POSIX behavior unless another module says otherwise.
+ HAVE_GETTIMEOFDAY=1; AC_SUBST([HAVE_GETTIMEOFDAY])
+ HAVE_STRUCT_TIMEVAL=1; AC_SUBST([HAVE_STRUCT_TIMEVAL])
+ HAVE_SYS_TIME_H=1; AC_SUBST([HAVE_SYS_TIME_H])
+ REPLACE_GETTIMEOFDAY=0; AC_SUBST([REPLACE_GETTIMEOFDAY])
+ REPLACE_STRUCT_TIMEVAL=0; AC_SUBST([REPLACE_STRUCT_TIMEVAL])
+])
--- /dev/null
+# sys_types_h.m4 serial 4
+dnl Copyright (C) 2011-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_SYS_TYPES_H],
+[
+ AC_REQUIRE([gl_SYS_TYPES_H_DEFAULTS])
+ gl_NEXT_HEADERS([sys/types.h])
+
+ dnl Ensure the type pid_t gets defined.
+ AC_REQUIRE([AC_TYPE_PID_T])
+
+ dnl Ensure the type mode_t gets defined.
+ AC_REQUIRE([AC_TYPE_MODE_T])
+
+ dnl Whether to override the 'off_t' type.
+ AC_REQUIRE([gl_TYPE_OFF_T])
+])
+
+AC_DEFUN([gl_SYS_TYPES_H_DEFAULTS],
+[
+])
# Configure a more-standard replacement for <time.h>.
-# Copyright (C) 2000-2001, 2003-2007, 2009-2011 Free Software Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
-# serial 6
+# serial 7
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC])
])
-dnl Define HAVE_STRUCT_TIMESPEC if `struct timespec' is declared
+dnl Check whether 'struct timespec' is declared
dnl in time.h, sys/time.h, or pthread.h.
AC_DEFUN([gl_CHECK_TYPE_STRUCT_TIMESPEC],
dnl Reentrant time functions: localtime_r, gmtime_r.
-dnl Copyright (C) 2003, 2006-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2006-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.
dnl Some systems don't declare localtime_r() and gmtime_r() if _REENTRANT is
dnl not defined.
- AC_CHECK_DECLS_ONCE([localtime_r])
+ AC_CHECK_DECLS([localtime_r], [], [], [[#include <time.h>]])
if test $ac_cv_have_decl_localtime_r = no; then
HAVE_DECL_LOCALTIME_R=0
fi
--- /dev/null
+# timer_time.m4 serial 2
+dnl Copyright (C) 2011-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.
+
+# Check for timer_settime, and set LIB_TIMER_TIME.
+
+AC_DEFUN([gl_TIMER_TIME],
+[
+ dnl Based on clock_time.m4. See details there.
+
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_REQUIRE([gl_THREADLIB])
+
+ LIB_TIMER_TIME=
+ AC_SUBST([LIB_TIMER_TIME])
+ gl_saved_libs=$LIBS
+ AC_SEARCH_LIBS([timer_settime], [rt posix4],
+ [test "$ac_cv_search_timer_settime" = "none required" ||
+ LIB_TIMER_TIME=$ac_cv_search_timer_settime])
+ dnl GLIBC uses threads to emulate posix timers when kernel support
+ dnl is not available (like Linux < 2.6 or when used with kFreeBSD)
+ dnl Now the pthread lib is linked automatically in the normal case,
+ dnl but when linking statically, it needs to be explicitly specified.
+ AC_EGREP_CPP([Thread],
+ [
+#include <features.h>
+#ifdef __GNU_LIBRARY__
+ #if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || (__GLIBC__ > 2)) \
+ && !defined __UCLIBC__
+ Thread emulation available
+ #endif
+#endif
+ ],
+ [LIB_TIMER_TIME="$LIB_TIMER_TIME $LIBMULTITHREAD"])
+ AC_CHECK_FUNCS([timer_settime])
+ LIBS=$gl_saved_libs
+])
--- /dev/null
+#serial 15
+
+# Copyright (C) 2000-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc.
+
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering
+
+AC_DEFUN([gl_TIMESPEC], [:])
# tm_gmtoff.m4 serial 3
-dnl Copyright (C) 2002, 2009-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2009-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.
-# unistd_h.m4 serial 61
-dnl Copyright (C) 2006-2011 Free Software Foundation, Inc.
+# unistd_h.m4 serial 65
+dnl Copyright (C) 2006-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.
dnl Ensure the type pid_t gets defined.
AC_REQUIRE([AC_TYPE_PID_T])
+ dnl Determine WINDOWS_64_BIT_OFF_T.
+ AC_REQUIRE([gl_TYPE_OFF_T])
+
dnl Check for declarations of anything we want to poison if the
dnl corresponding gnulib module is not in use.
gl_WARN_ON_USE_PREPARE([[
#endif
]], [chdir chown dup dup2 dup3 environ euidaccess faccessat fchdir fchownat
fdatasync fsync ftruncate getcwd getdomainname getdtablesize getgroups
- gethostname getlogin getlogin_r getpagesize getusershell setusershell
- endusershell group_member lchown link linkat lseek pipe pipe2 pread pwrite
- readlink readlinkat rmdir sleep symlink symlinkat ttyname_r unlink unlinkat
- usleep])
+ gethostname getlogin getlogin_r getpagesize
+ getusershell setusershell endusershell
+ group_member isatty lchown link linkat lseek pipe pipe2 pread pwrite
+ readlink readlinkat rmdir sethostname sleep symlink symlinkat ttyname_r
+ unlink unlinkat usleep])
])
AC_DEFUN([gl_UNISTD_MODULE_INDICATOR],
GNULIB_GETPAGESIZE=0; AC_SUBST([GNULIB_GETPAGESIZE])
GNULIB_GETUSERSHELL=0; AC_SUBST([GNULIB_GETUSERSHELL])
GNULIB_GROUP_MEMBER=0; AC_SUBST([GNULIB_GROUP_MEMBER])
+ GNULIB_ISATTY=0; AC_SUBST([GNULIB_ISATTY])
GNULIB_LCHOWN=0; AC_SUBST([GNULIB_LCHOWN])
GNULIB_LINK=0; AC_SUBST([GNULIB_LINK])
GNULIB_LINKAT=0; AC_SUBST([GNULIB_LINKAT])
GNULIB_READLINK=0; AC_SUBST([GNULIB_READLINK])
GNULIB_READLINKAT=0; AC_SUBST([GNULIB_READLINKAT])
GNULIB_RMDIR=0; AC_SUBST([GNULIB_RMDIR])
+ GNULIB_SETHOSTNAME=0; AC_SUBST([GNULIB_SETHOSTNAME])
GNULIB_SLEEP=0; AC_SUBST([GNULIB_SLEEP])
GNULIB_SYMLINK=0; AC_SUBST([GNULIB_SYMLINK])
GNULIB_SYMLINKAT=0; AC_SUBST([GNULIB_SYMLINKAT])
GNULIB_TTYNAME_R=0; AC_SUBST([GNULIB_TTYNAME_R])
- GNULIB_UNISTD_H_GETOPT=0; AC_SUBST([GNULIB_UNISTD_H_GETOPT])
GNULIB_UNISTD_H_NONBLOCKING=0; AC_SUBST([GNULIB_UNISTD_H_NONBLOCKING])
GNULIB_UNISTD_H_SIGPIPE=0; AC_SUBST([GNULIB_UNISTD_H_SIGPIPE])
GNULIB_UNLINK=0; AC_SUBST([GNULIB_UNLINK])
HAVE_PWRITE=1; AC_SUBST([HAVE_PWRITE])
HAVE_READLINK=1; AC_SUBST([HAVE_READLINK])
HAVE_READLINKAT=1; AC_SUBST([HAVE_READLINKAT])
+ HAVE_SETHOSTNAME=1; AC_SUBST([HAVE_SETHOSTNAME])
HAVE_SLEEP=1; AC_SUBST([HAVE_SLEEP])
HAVE_SYMLINK=1; AC_SUBST([HAVE_SYMLINK])
HAVE_SYMLINKAT=1; AC_SUBST([HAVE_SYMLINKAT])
HAVE_DECL_GETLOGIN_R=1; AC_SUBST([HAVE_DECL_GETLOGIN_R])
HAVE_DECL_GETPAGESIZE=1; AC_SUBST([HAVE_DECL_GETPAGESIZE])
HAVE_DECL_GETUSERSHELL=1; AC_SUBST([HAVE_DECL_GETUSERSHELL])
+ HAVE_DECL_SETHOSTNAME=1; AC_SUBST([HAVE_DECL_SETHOSTNAME])
HAVE_DECL_TTYNAME_R=1; AC_SUBST([HAVE_DECL_TTYNAME_R])
HAVE_OS_H=0; AC_SUBST([HAVE_OS_H])
HAVE_SYS_PARAM_H=0; AC_SUBST([HAVE_SYS_PARAM_H])
REPLACE_DUP=0; AC_SUBST([REPLACE_DUP])
REPLACE_DUP2=0; AC_SUBST([REPLACE_DUP2])
REPLACE_FCHOWNAT=0; AC_SUBST([REPLACE_FCHOWNAT])
+ REPLACE_FTRUNCATE=0; AC_SUBST([REPLACE_FTRUNCATE])
REPLACE_GETCWD=0; AC_SUBST([REPLACE_GETCWD])
REPLACE_GETDOMAINNAME=0; AC_SUBST([REPLACE_GETDOMAINNAME])
REPLACE_GETLOGIN_R=0; AC_SUBST([REPLACE_GETLOGIN_R])
REPLACE_GETGROUPS=0; AC_SUBST([REPLACE_GETGROUPS])
REPLACE_GETPAGESIZE=0; AC_SUBST([REPLACE_GETPAGESIZE])
+ REPLACE_ISATTY=0; AC_SUBST([REPLACE_ISATTY])
REPLACE_LCHOWN=0; AC_SUBST([REPLACE_LCHOWN])
REPLACE_LINK=0; AC_SUBST([REPLACE_LINK])
REPLACE_LINKAT=0; AC_SUBST([REPLACE_LINKAT])
--- /dev/null
+# serial 9
+
+# Copyright (C) 1998-2001, 2003-2004, 2007, 2009-2012 Free Software Foundation,
+# Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering
+
+dnl Define HAVE_STRUCT_UTIMBUF if 'struct utimbuf' is declared --
+dnl usually in <utime.h>.
+dnl Some systems have utime.h but don't declare the struct anywhere.
+
+AC_DEFUN([gl_CHECK_TYPE_STRUCT_UTIMBUF],
+[
+ AC_CHECK_HEADERS_ONCE([sys/time.h utime.h])
+ AC_CACHE_CHECK([for struct utimbuf], [gl_cv_sys_struct_utimbuf],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#if HAVE_SYS_TIME_H
+ #include <sys/time.h>
+ #endif
+ #include <time.h>
+ #ifdef HAVE_UTIME_H
+ #include <utime.h>
+ #endif
+ ]],
+ [[static struct utimbuf x; x.actime = x.modtime;]])],
+ [gl_cv_sys_struct_utimbuf=yes],
+ [gl_cv_sys_struct_utimbuf=no])])
+
+ if test $gl_cv_sys_struct_utimbuf = yes; then
+ AC_DEFINE([HAVE_STRUCT_UTIMBUF], [1],
+ [Define if struct utimbuf is declared -- usually in <utime.h>.
+ Some systems have utime.h but don't declare the struct anywhere. ])
+ fi
+])
--- /dev/null
+dnl Copyright (C) 2003-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.
+
+dnl serial 7
+
+AC_DEFUN([gl_UTIMENS],
+[
+ dnl Prerequisites of lib/utimens.c.
+ AC_REQUIRE([gl_FUNC_UTIMES])
+ AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC])
+ AC_REQUIRE([gl_CHECK_TYPE_STRUCT_UTIMBUF])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+ AC_CHECK_FUNCS_ONCE([futimes futimesat futimens utimensat lutimes])
+
+ if test $ac_cv_func_futimens = no && test $ac_cv_func_futimesat = yes; then
+ dnl FreeBSD 8.0-rc2 mishandles futimesat(fd,NULL,time). It is not
+ dnl standardized, but Solaris implemented it first and uses it as
+ dnl its only means to set fd time.
+ AC_CACHE_CHECK([whether futimesat handles NULL file],
+ [gl_cv_func_futimesat_works],
+ [touch conftest.file
+ AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+#include <stddef.h>
+#include <sys/times.h>
+#include <fcntl.h>
+]], [[ int fd = open ("conftest.file", O_RDWR);
+ if (fd < 0) return 1;
+ if (futimesat (fd, NULL, NULL)) return 2;
+ ]])],
+ [gl_cv_func_futimesat_works=yes],
+ [gl_cv_func_futimesat_works=no],
+ [case "$host_os" in
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_futimesat_works="guessing no" ;;
+ esac
+ ])
+ rm -f conftest.file])
+ case "$gl_cv_func_futimesat_works" in
+ *yes) ;;
+ *)
+ AC_DEFINE([FUTIMESAT_NULL_BUG], [1],
+ [Define to 1 if futimesat mishandles a NULL file name.])
+ ;;
+ esac
+ fi
+])
--- /dev/null
+# Detect some bugs in glibc's implementation of utimes.
+# serial 3
+
+dnl Copyright (C) 2003-2005, 2009-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.
+
+# See if we need to work around bugs in glibc's implementation of
+# utimes from 2003-07-12 to 2003-09-17.
+# First, there was a bug that would make utimes set mtime
+# and atime to zero (1970-01-01) unconditionally.
+# Then, there was code to round rather than truncate.
+# Then, there was an implementation (sparc64, Linux-2.4.28, glibc-2.3.3)
+# that didn't honor the NULL-means-set-to-current-time semantics.
+# Finally, there was also a version of utimes that failed on read-only
+# files, while utime worked fine (linux-2.2.20, glibc-2.2.5).
+#
+# From Jim Meyering, with suggestions from Paul Eggert.
+
+AC_DEFUN([gl_FUNC_UTIMES],
+[
+ AC_CACHE_CHECK([whether the utimes function works],
+ [gl_cv_func_working_utimes],
+ [
+ AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <sys/time.h>
+#include <time.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <utime.h>
+
+static int
+inorder (time_t a, time_t b, time_t c)
+{
+ return a <= b && b <= c;
+}
+
+int
+main ()
+{
+ int result = 0;
+ char const *file = "conftest.utimes";
+ static struct timeval timeval[2] = {{9, 10}, {999999, 999999}};
+
+ /* Test whether utimes() essentially works. */
+ {
+ struct stat sbuf;
+ FILE *f = fopen (file, "w");
+ if (f == NULL)
+ result |= 1;
+ else if (fclose (f) != 0)
+ result |= 1;
+ else if (utimes (file, timeval) != 0)
+ result |= 2;
+ else if (lstat (file, &sbuf) != 0)
+ result |= 1;
+ else if (!(sbuf.st_atime == timeval[0].tv_sec
+ && sbuf.st_mtime == timeval[1].tv_sec))
+ result |= 4;
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ /* Test whether utimes() with a NULL argument sets the file's timestamp
+ to the current time. Use 'fstat' as well as 'time' to
+ determine the "current" time, to accommodate NFS file systems
+ if there is a time skew between the host and the NFS server. */
+ {
+ int fd = open (file, O_WRONLY|O_CREAT, 0644);
+ if (fd < 0)
+ result |= 1;
+ else
+ {
+ time_t t0, t2;
+ struct stat st0, st1, st2;
+ if (time (&t0) == (time_t) -1)
+ result |= 1;
+ else if (fstat (fd, &st0) != 0)
+ result |= 1;
+ else if (utimes (file, timeval) != 0)
+ result |= 2;
+ else if (utimes (file, NULL) != 0)
+ result |= 8;
+ else if (fstat (fd, &st1) != 0)
+ result |= 1;
+ else if (write (fd, "\n", 1) != 1)
+ result |= 1;
+ else if (fstat (fd, &st2) != 0)
+ result |= 1;
+ else if (time (&t2) == (time_t) -1)
+ result |= 1;
+ else
+ {
+ int m_ok_POSIX = inorder (t0, st1.st_mtime, t2);
+ int m_ok_NFS = inorder (st0.st_mtime, st1.st_mtime, st2.st_mtime);
+ if (! (st1.st_atime == st1.st_mtime))
+ result |= 16;
+ if (! (m_ok_POSIX || m_ok_NFS))
+ result |= 32;
+ }
+ if (close (fd) != 0)
+ result |= 1;
+ }
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ /* Test whether utimes() with a NULL argument works on read-only files. */
+ {
+ int fd = open (file, O_WRONLY|O_CREAT, 0444);
+ if (fd < 0)
+ result |= 1;
+ else if (close (fd) != 0)
+ result |= 1;
+ else if (utimes (file, NULL) != 0)
+ result |= 64;
+ if (unlink (file) != 0)
+ result |= 1;
+ }
+
+ return result;
+}
+ ]])],
+ [gl_cv_func_working_utimes=yes],
+ [gl_cv_func_working_utimes=no],
+ [gl_cv_func_working_utimes=no])])
+
+ if test $gl_cv_func_working_utimes = yes; then
+ AC_DEFINE([HAVE_WORKING_UTIMES], [1], [Define if utimes works properly. ])
+ fi
+])
--- /dev/null
+# warnings.m4 serial 7
+dnl Copyright (C) 2008-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.
+
+dnl From Simon Josefsson
+
+# gl_AS_VAR_APPEND(VAR, VALUE)
+# ----------------------------
+# Provide the functionality of AS_VAR_APPEND if Autoconf does not have it.
+m4_ifdef([AS_VAR_APPEND],
+[m4_copy([AS_VAR_APPEND], [gl_AS_VAR_APPEND])],
+[m4_define([gl_AS_VAR_APPEND],
+[AS_VAR_SET([$1], [AS_VAR_GET([$1])$2])])])
+
+
+# gl_COMPILER_OPTION_IF(OPTION, [IF-SUPPORTED], [IF-NOT-SUPPORTED],
+# [PROGRAM = AC_LANG_PROGRAM()])
+# -----------------------------------------------------------------
+# Check if the compiler supports OPTION when compiling PROGRAM.
+#
+# FIXME: gl_Warn must be used unquoted until we can assume Autoconf
+# 2.64 or newer.
+AC_DEFUN([gl_COMPILER_OPTION_IF],
+[AS_VAR_PUSHDEF([gl_Warn], [gl_cv_warn_[]_AC_LANG_ABBREV[]_$1])dnl
+AS_VAR_PUSHDEF([gl_Flags], [_AC_LANG_PREFIX[]FLAGS])dnl
+AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], m4_defn([gl_Warn]), [
+ gl_save_compiler_FLAGS="$gl_Flags"
+ gl_AS_VAR_APPEND(m4_defn([gl_Flags]), [" $1"])
+ AC_COMPILE_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([])])],
+ [AS_VAR_SET(gl_Warn, [yes])],
+ [AS_VAR_SET(gl_Warn, [no])])
+ gl_Flags="$gl_save_compiler_FLAGS"
+])
+AS_VAR_IF(gl_Warn, [yes], [$2], [$3])
+AS_VAR_POPDEF([gl_Flags])dnl
+AS_VAR_POPDEF([gl_Warn])dnl
+])
+
+
+# gl_WARN_ADD(OPTION, [VARIABLE = WARN_CFLAGS],
+# [PROGRAM = AC_LANG_PROGRAM()])
+# ---------------------------------------------
+# Adds parameter to WARN_CFLAGS if the compiler supports it when
+# compiling PROGRAM. For example, gl_WARN_ADD([-Wparentheses]).
+#
+# If VARIABLE is a variable name, AC_SUBST it.
+AC_DEFUN([gl_WARN_ADD],
+[gl_COMPILER_OPTION_IF([$1],
+ [gl_AS_VAR_APPEND(m4_if([$2], [], [[WARN_CFLAGS]], [[$2]]), [" $1"])],
+ [],
+ [$3])
+m4_ifval([$2],
+ [AS_LITERAL_IF([$2], [AC_SUBST([$2])])],
+ [AC_SUBST([WARN_CFLAGS])])dnl
+])
+
+# Local Variables:
+# mode: autoconf
+# End:
# wchar_t.m4 serial 4 (gettext-0.18.2)
-dnl Copyright (C) 2002-2003, 2008-2011 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2008-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.
#!/bin/sh
### make-dist: create an Emacs distribution tar file from current srcdir
-## Copyright (C) 1995, 1997-1998, 2000-2012 Free Software Foundation, Inc.
+## Copyright (C) 1995, 1997-1998, 2000-2012 Free Software Foundation, Inc.
## This file is part of GNU Emacs.
### Find out which version of Emacs this is.
version=`
- sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <configure.in
+ sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <configure.ac
` || version=
if [ ! "${version}" ]; then
echo "${progname}: can't find current Emacs version in \`./src/emacs.c'" >&2
if [ $update = yes ]; then
- ## Make sure configure is newer than configure.in.
- if [ "x`ls -t configure configure.in | sed q`" != "xconfigure" ]; then
- echo "\`./configure.in' is newer than \`./configure'" >&2
- echo "Running autoconf" >&2
- autoconf || { x=$?; echo Autoconf FAILED! >&2; exit $x; }
- fi
+ ## Make sure configure is newer than configure.ac, etc.
+ ## It is better to let autoreconf do what is needed than
+ ## for us to try and duplicate all its checks.
+ echo "Running autoreconf"
+ autoreconf -i -I m4 || { x=$?; echo Autoreconf FAILED! >&2; exit $x; }
- ## Make sure src/stamp-h.in is newer than configure.in.
- if [ "x`ls -t src/stamp-h.in configure.in | sed q`" != "xsrc/stamp-h.in" ]; then
- echo "\`./configure.in' is newer than \`./src/stamp-h.in'" >&2
- echo "Running autoheader" >&2
- autoheader || { x=$?; echo Autoheader FAILED! >&2; exit $x; }
- rm -f src/stamp-h.in
- echo timestamp > src/stamp-h.in
- fi
+ ## Make sure src/stamp-h.in is newer than configure.ac.
+ rm -f src/stamp-h.in
+ echo timestamp > src/stamp-h.in
echo "Updating Info files"
- (cd doc/emacs; make info)
- (cd doc/misc; make info)
- (cd doc/lispref; make info)
- (cd doc/lispintro; make info)
+ make info-real
echo "Updating finder, custom and autoload data"
- (cd lisp; make updates EMACS="$EMACS")
+ (cd lisp && make updates EMACS="$EMACS")
- if test -f leim/leim-list.el; then
- echo "Updating leim-list.el"
- (cd leim; make leim-list.el EMACS="$EMACS")
- fi
+ echo "Updating leim-list.el"
+ (cd leim && make leim-list.el EMACS="$EMACS")
echo "Recompiling Lisp files"
$EMACS -batch -f batch-byte-recompile-directory lisp leim
### README while the rest of the tar file is still unpacking. Whoopee.
echo "Making links to top-level files"
ln INSTALL README BUGS ${tempdir}
-ln ChangeLog Makefile.in configure configure.in ${tempdir}
-ln config.bat make-dist update-subdirs vpath.sed .dir-locals.el ${tempdir}
+ln ChangeLog Makefile.in autogen.sh configure configure.ac ${tempdir}
+ln config.bat make-dist .dir-locals.el ${tempdir}
ln aclocal.m4 ${tempdir}
echo "Creating subdirectories"
leim leim/CXTERM-DIC leim/MISC-DIC \
leim/SKK-DIC leim/ja-dic leim/quail \
build-aux build-aux/snippet \
- src src/m 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 \
info m4 msdos \
- nextstep nextstep/Cocoa nextstep/Cocoa/Emacs.base \
+ nextstep nextstep/templates \
+ nextstep/Cocoa nextstep/Cocoa/Emacs.base \
nextstep/Cocoa/Emacs.base/Contents \
nextstep/Cocoa/Emacs.base/Contents/Resources \
- nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj \
nextstep/GNUstep \
nextstep/GNUstep/Emacs.base \
nextstep/GNUstep/Emacs.base/Resources
echo "Making links to \`build-aux'"
(cd build-aux
ln compile config.guess config.sub depcomp ../${tempdir}/build-aux
- ln install-sh missing move-if-change ../${tempdir}/build-aux)
+ ln install-sh missing move-if-change update-subdirs ../${tempdir}/build-aux)
echo "Making links to \`build-aux/snippet'"
(cd build-aux/snippet
(cd src/bitmaps
ln README *.xbm ../../${tempdir}/src/bitmaps)
-echo "Making links to \`src/m'"
-(cd src/m
- ln README [a-zA-Z0-9]*.h ../../${tempdir}/src/m)
-
-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
echo "Making links to \`lib-src'"
(cd lib-src
ln [a-zA-Z]*.[ch] ../${tempdir}/lib-src
- ln ChangeLog Makefile.in README testfile vcdiff ../${tempdir}/lib-src
- ln grep-changelog rcs2log rcs-checkin ../${tempdir}/lib-src
+ ln ChangeLog Makefile.in README testfile ../${tempdir}/lib-src
+ ln grep-changelog rcs2log ../${tempdir}/lib-src
ln makefile.w32-in ../${tempdir}/lib-src)
echo "Making links to \`m4'"
echo "Making links to \`nextstep'"
(cd nextstep
- ln ChangeLog README INSTALL ../${tempdir}/nextstep)
+ ln ChangeLog README INSTALL Makefile.in ../${tempdir}/nextstep)
+
+echo "Making links to \`nextstep/templates'"
+(cd nextstep/templates
+ ln Emacs.desktop.in Info-gnustep.plist.in Info.plist.in InfoPlist.strings.in ../../${tempdir}/nextstep/templates)
echo "Making links to \`nextstep/Cocoa/Emacs.base/Contents'"
(cd nextstep/Cocoa/Emacs.base/Contents
- ln Info.plist PkgInfo ../../../../${tempdir}/nextstep/Cocoa/Emacs.base/Contents)
+ ln PkgInfo ../../../../${tempdir}/nextstep/Cocoa/Emacs.base/Contents)
echo "Making links to \`nextstep/Cocoa/Emacs.base/Contents/Resources'"
(cd nextstep/Cocoa/Emacs.base/Contents/Resources
ln Credits.html *.icns ../../../../../${tempdir}/nextstep/Cocoa/Emacs.base/Contents/Resources)
-echo "Making links to \`nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj'"
-(cd nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj
- ln InfoPlist.strings ../../../../../../${tempdir}/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj)
-
echo "Making links to \`nextstep/GNUstep/Emacs.base/Resources'"
(cd nextstep/GNUstep/Emacs.base/Resources
- ln Emacs.desktop Info-gnustep.plist README emacs.tiff ../../../../${tempdir}/nextstep/GNUstep/Emacs.base/Resources )
+ ln README emacs.tiff ../../../../${tempdir}/nextstep/GNUstep/Emacs.base/Resources )
echo "Making links to \`oldXMenu'"
(cd oldXMenu
echo "Making links to \`doc/lispref'"
(cd doc/lispref
ln *.texi *.in makefile.w32-in README ChangeLog* ../../${tempdir}/doc/lispref
- ln *.txt *.el spellfile tindex.pl ../../${tempdir}/doc/lispref
- ln two-volume.make ../../${tempdir}/doc/lispref)
+ ln spellfile ../../${tempdir}/doc/lispref
+ ln two-volume.make two-volume-cross-refs.txt ../../${tempdir}/doc/lispref)
echo "Making links to \`doc/lispintro'"
(cd doc/lispintro
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-27 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.2 released.
+ Check more robustly for timer_settime.
+ * sed1v2.inp, sed3v2.inp (LIB_TIMER_TIME): New macro.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-08-04 Eli Zaretskii <eliz@gnu.org>
- * Version 24.1 released.
+ * 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 <rgm@gnu.org>
+
+ * 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 <rgm@gnu.org>
+
+ * sed1v2.inp (S_FILE): Update for format change.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib stdalign module (Bug#9772, Bug#9960).
+ * sed2v2.inp (HAVE_ATTRIBUTE_ALIGNED): Remove edit.
+ * sedlibmk.inp (STDALIGN_H, @GL_GENERATE_STDALIGN_H_TRUE@)
+ (GL_GENERATE_STDALIGN_H_FALSE): New edits.
+
+2012-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ * sed1v2.inp: In the recipe for $(leimdir)/leim-list.el, edit the
+ prerequisites to be "temacs$(EXEEXT) $(BOOTSTRAPEMACS)", to avoid
+ the need to rebuild $(bootstrap_exe), which requires a Unixy shell
+ via lisp/Makefile.in's "update-subdirs" command.
+
+ * sedlibmk.inp (am_libgnu_a_OBJECTS): Adjust the removal of
+ careadlinkat.$(OBJEXT) to the changes in lib/Makefile.in.
+
+ * sed2v2.inp (DATA_START, GC_SETJMP_WORKS, HAVE_MENUS)
+ (HAVE_MOUSE): Edit for DJGPP, according to what was previously
+ done on src/s/msdos.h.
+
+2012-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ * mainmake.v2 (bootstrap-clean): Do a maintainer-clean in lib, not
+ bootstrap-clean (which doesn't exist).
+
+ * inttypes.h (PRIuMAX) [__DJGPP__ < 2.04]: Define to "llu".
+
+ * sedleim.inp (MKDIR_P): Edit to DOS "md" command.
+
+ * sed1v2.inp (LIB_CLOCK_GETTIME): Edit to empty.
+ Remove lines that invoke PAXCTL.
+ (clean): Fix recipe not to run Unixy shell commands.
+
+ * sed2v2.inp (GETTIMEOFDAY_TIMEZONE): Edit to 'struct timezone'.
+ (HAVE_STRNCASECMP): Edit to 1.
+
+ * sed3v2.inp (LIB_CLOCK_GETTIME): Edit to empty.
+ (C_SWITCH_SYSTEM): Add "-I../msdos".
+
+ * sedlibmk.inp (GNULIB_GETTIMEOFDAY, GNULIB_PSELECT)
+ (GNULIB_SELECT, HAVE_STRUCT_TIMEVAL, HAVE_SYS_SELECT_H)
+ (HAVE_SYS_TIME_H, NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H)
+ (NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H, NEXT_SYS_SELECT_H)
+ (NEXT_SYS_TIME_H, REPLACE_GETTIMEOFDAY, REPLACE_PSELECT)
+ (REPLACE_STRUCT_TIMEVAL): Edit to appropriate values.
+ (BUILT_SOURCES): Edit out sys/select.h and sys/time.h.
+ (mostlyclean-local, distclean-generic): Fix recipe not to run
+ Unixy shell commands.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * sedlibmk.inp (DEFS): Don't add -DHAVE_CONFIG_H.
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * sed2v2.inp (SYSTEM_TYPE): Set it.
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * sedlibmk.inp (GNULIB_GL_UNISTD_H_GETOPT, GNULIB_POSIX_OPENPT)
+ (GNULIB_ISATTY, GNULIB_PTSNAME_R, GNULIB_RANDOM)
+ (GNULIB_SETHOSTNAME, HAVE_POSIX_OPENPT, HAVE_PTSNAME_R)
+ (HAVE_RANDOM, HAVE_SETHOSTNAME, NEXT_SYS_TYPES_H)
+ (NEXT_AS_FIRST_DIRECTIVE_SYS_TYPES_H, REPLACE_FTRUNCATE)
+ (REPLACE_ISATTY, REPLACE_PTSNAME_R, REPLACE_RANDOM_R)
+ (REPLACE_STRTOIMAX, STDALIGN_H, WINDOWS_64_BIT_OFF_T)
+ (WINDOWS_64_BIT_ST_SIZE, GL_GENERATE_STDALIGN_H_TRUE)
+ (GL_GENERATE_STDALIGN_H_FALSE): Edit as appropriate for DJGPP.
+ (cat FOO): Edit into "sed -e '' FOO >>".
+
+2012-05-25 Eli Zaretskii <eliz@gnu.org>
+
+ * sed6.inp (INFO_EXT): Edit to .info.
+ (INFO_OPTS): Edit to --no-split.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * mainmake.v2 (TAGS tags): Don't look at $(CURDIR)/src/m/intel386.h.
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sed2v2.inp (HAVE_MBLEN): Remove.
+ * sed2x.inp (HAVE_XSETWMPROTOCOLS): Remove.
+
+2012-04-21 Eli Zaretskii <eliz@gnu.org>
+
+ * sedleim.inp (RUN_EMACS): Replace BUILT_EMACS with EMACS.
+ Remove stale editing of "else make quail".
+ (.PHONY, compile-targets): Remove targets.
+ (compile-main): Edit into something that can be done without
+ requiring a Unixy shell.
+ (bootstrap-clean): Likewise: edit to not require $(setwins).
+
+ * sed1v2.inp: Edit "cd $(leimdir) && $(MAKE) ..." into the
+ equivalent "$(MAKE) $(MFLAGS) -C $(leimdir) ..." command.
+
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * sed1v2.inp, sed3v2.inp, sedlibmk.inp: GNULIB_WARN_CFLAGS,
+ WARN_CFLAGS, and WERROR_CFLAGS replace C_WARNINGS_SWITCH.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * sedlibmk.inp, sed1v2.inp: GNUSTEP_CFLAGS replaces C_SWITCH_X_SYSTEM.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * sed2v2.inp: Bump version to 24.1.50.
2012-02-04 Eli Zaretskii <eliz@gnu.org>
;; coding: utf-8
;; End:
- Copyright (C) 1994-1999, 2001-2012 Free Software Foundation, Inc.
+ Copyright (C) 1994-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <stdlib.h>
#define strtoumax strtoull
#define strtoimax strtoll
+#define PRIuMAX "llu"
#endif /* __DJGPP__ < 2.04 */
#endif
cd src
../bin/etags --include=../lisp/TAGS \
--regex='/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/' \
- $(CURDIR)/src/*.c $(CURDIR)/src/*.h \
- $(CURDIR)/src/s/msdos.h $(CURDIR)/src/m/intel386.h
+ $(CURDIR)/src/*.c $(CURDIR)/src/*.h
cd ..
./bin/etags --include=src/TAGS
bootstrap-clean: FRC
cd lib
- $(MAKE) $(MFLAGS) $@
+ -$(MAKE) $(MFLAGS) maintainer-clean
cd ..
cd src
$(MAKE) $(MFLAGS) $@
bootstrap: bootstrap-clean FRC
command.com /e:2048 /c config msdos
$(MAKE) $(MFLAGS) info all
-
# Configuration script for src/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
/^LIBOBJS *=/s/@[^@\n]*@//
/^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@//
/^C_SWITCH_SYSTEM *=/s/@C_SWITCH_SYSTEM@//
-/^C_SWITCH_X_SYSTEM *=/s/@C_SWITCH_X_SYSTEM@//
+/^GNUSTEP_CFLAGS *=/s/@GNUSTEP_CFLAGS@//
/^C_SWITCH_X_SITE *=/s/@C_SWITCH_X_SITE@//
-/^C_WARNINGS_SWITCH *=/s/@C_WARNINGS_SWITCH@//
+/^WARN_CFLAGS *=/s/@WARN_CFLAGS@//
+/^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@//
/^PROFILING_CFLAGS *=/s/@PROFILING_CFLAGS@//
#/^LD_SWITCH_X_SITE *=/s/@LD_SWITCH_X_SITE@//
/^LD_SWITCH_SYSTEM_TEMACS *=/s/@LD_SWITCH_SYSTEM_TEMACS@//
/^LIBRESOLV *=/s/@LIBRESOLV@//
/^LIBSELINUX_LIBS *=/s/@LIBSELINUX_LIBS@//
/^LIB_PTHREAD_SIGMASK *=/s/@[^@\n]*@//
+/^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g
+/^LIB_TIMER_TIME *=/s/@[^@\n]*@//g
/^LIBGNUTLS_LIBS *=/s/@[^@\n]*@//
/^LIBGNUTLS_CFLAGS *=/s/@[^@\n]*@//
/^GETLOADAVG_LIBS *=/s/@[^@\n]*@//
/^DEPFLAGS *=/s/@DEPFLAGS@//
/^MKDEPDIR *=/s/@MKDEPDIR@//
/^version *=/s/@[^@\n]*@//
-/^M_FILE *=/s!@M_FILE@!$(srcdir)/m/intel386.h!
-/^S_FILE *=/s!@S_FILE@!$(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!
/^.\$(libsrc)\/make-doc/s!>.*$!!
/^ [ ]*\$(libsrc)\/make-docfile /s!`[^`]*`!$(lisp); cd ../src!
/^[\f ]*$/d
+/^\$(leimdir)\/leim-list.el: /s/bootstrap-emacs\$(EXEEXT)/temacs$(EXEEXT) $(BOOTSTRAPEMACS)/
/^ if test -f/,/^ fi$/c\
command.com /c if exist .gdbinit rm -f _gdbinit
+/^ *test "X\$(PAXCTL)" = X/d
+/^ *test "\$(CANNOT_DUMP)" = "yes"/d
/^ if test "\$(CANNOT_DUMP)" =/,/^ else /d
+/^ -\{0,1\} *ln -/s/bootstrap-emacs\$(EXEEXT).*$/bootstrap-emacs$(EXEEXT)/
/^ fi/d
/^ *LC_ALL=C \$(RUN_TEMACS)/i\
stubedit temacs.exe minstack=1024k
/^ echo[ ][ ]*timestamp/s/echo /djecho /
/^ .*djecho timestamp/a\
@rm -f gl-tmp
+/^ cd \$(leimdir) && \$(MAKE)/c\
+ $(MAKE) $(MFLAGS) -C $(leimdir) leim-list.el EMACS=$(bootstrap_exe)
/^ cd \$(lib) && \$(MAKE)/c\
$(MAKE) $(MFLAGS) -C $(lib) libgnu.a
/^RUN_TEMACS *=/s|`/bin/pwd`|.|
/^ *THEFILE=/s|$|\; cd ../src|
/^ echo.* buildobj.h/s|echo |djecho |
# Make the GCC command line fit one screen line
-/^[ ][ ]*\$(C_SWITCH_X_SYSTEM)/d
+/^[ ][ ]*\$(GNUSTEP_CFLAGS)/d
/^[ ][ ]*\$(GCONF_CFLAGS)/d
/^[ ][ ]*\$(LIBGNUTLS_CFLAGS)/d
s/\$(LIBOTF_CFLAGS) \$(M17N_FLT_CFLAGS) \$(DEPFLAGS) //
s| -I\$(srcdir)/../lib||
# Add our local inttypes.h to prerequisites where needed
/^lread\.o:/s|lread\.c|& ../msdos/inttypes.h|
+/^ *test "X/d
#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/
/^#undef HAVE_FREXP *$/s/^.*$/#define HAVE_FREXP 1/
/^#undef HAVE_FMOD *$/s/^.*$/#define HAVE_FMOD 1/
/^#undef HAVE_RINT *$/s/^.*$/#define HAVE_RINT 1/
-/^#undef HAVE_ATTRIBUTE_ALIGNED *$/s/^.*$/#define HAVE_ATTRIBUTE_ALIGNED 1/
/^#undef HAVE_C99_STRTOLD *$/s/^.*$/#define HAVE_C99_STRTOLD 1/
/^#undef HAVE_CBRT *$/s/^.*$/#define HAVE_CBRT 1/
/^#undef HAVE_DIFFTIME *$/s/^.*$/#define HAVE_DIFFTIME 1/
/^#undef HAVE_MEMMOVE *$/s/^.*$/#define HAVE_MEMMOVE 1/
/^#undef HAVE_SETRLIMIT *$/s/^.*$/#define HAVE_SETRLIMIT 1/
/^#undef HAVE_GETRUSAGE *$/s/^.*$/#define HAVE_GETRUSAGE 1/
+/^#undef GETTIMEOFDAY_TIMEZONE *$/s/^.*$/#define GETTIMEOFDAY_TIMEZONE struct timezone/
/^#undef HAVE_TM_GMTOFF *$/s/^.*$/#define HAVE_TM_GMTOFF 1/
-/^#undef HAVE_MBLEN *$/s/^.*$/#define HAVE_MBLEN 1/
/^#undef HAVE_STRUCT_TIMEZONE *$/s/^.*$/#define HAVE_STRUCT_TIMEZONE 1/
/^#undef HAVE_SIZE_T *$/s/^.*$/#define HAVE_SIZE_T 1/
/^#undef HAVE_MKSTEMP *$/s/^.*$/#define HAVE_MKSTEMP 1/
+/^#undef HAVE_STRNCASECMP *$/s/^.*$/#define HAVE_STRNCASECMP 1/
/^#undef HAVE_STRUCT_TM_TM_ZONE *$/s/^.*$/#define HAVE_STRUCT_TM_TM_ZONE 1/
/^#undef HAVE_SYNC *$/s/^.*$/#define HAVE_SYNC 1/
/^#undef HAVE___BUILTIN_UNWIND_INIT *$/s/^.*$/#define HAVE___BUILTIN_UNWIND_INIT 1/
+/^#undef HAVE_MENUS *$/s/^.*$/#define HAVE_MENUS 1/
+/^#undef HAVE_MOUSE *$/s/^.*$/#define HAVE_MOUSE 1/
+/^#undef DATA_START/s/^.*$/#define DATA_START (\&etext + 1)/
+/^#undef GC_SETJMP_WORKS/s/^.*$/#define GC_SETJMP_WORKS 1/
/^#undef ORDINARY_LINK/s/^.*$/#define ORDINARY_LINK 1/
/^#undef PACKAGE_BUGREPORT/s/^.*$/#define PACKAGE_BUGREPORT ""/
/^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/
/^#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.2"/
+/^#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/
/^#undef HAVE_DIRENT_H/s/^.*$/#define HAVE_DIRENT_H 1/
/^#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=<CM>:cl=<CL>:ce=<CE>::se=</SO>:so=<SO>:us=<UL>:ue=</UL>:md=<BD>:mh=<DIM>:mb=<BL>:mr=<RV>:me=<NV>::AB=<BG %d>:AF=<FG %d>:op=<DefC>:",
+/^#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/
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\
# might be defined in sys/config.h we include at the top of config.h.
/^#undef BSTRING/s|#undef|# undef|
/^#undef .*$/s|^.*$|/* & */|
-
/^#undef HAVE_X11 *$/s/undef/define/
/^#undef HAVE_X_MENU *$/s/undef/define/
/^#undef HAVE_XSCREENNUMBEROFSCREEN *$/s/undef/define/
-/^#undef HAVE_XSETWMPROTOCOLS *$/s/undef/define/
/^#undef HAVE_SELECT *$/s/undef/define/
/^LIBRESOLV *=/s/@[^@\n]*@//g
/^LIBS_MAIL *=/s/@[^@\n]*@//g
/^LIBS_SYSTEM *=/s/@[^@\n]*@//g
+/^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g
+/^LIB_TIMER_TIME *=/s/@[^@\n]*@//g
/^CFLAGS *=/s!=.*$!=-O2 -g!
-/^C_SWITCH_SYSTEM *=/s!=.*$!=-DMSDOS!
+/^C_SWITCH_SYSTEM *=/s!=.*$!=-DMSDOS -I../msdos!
/^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@//
-/^C_WARNINGS_SWITCH *=/s/@C_WARNINGS_SWITCH@//
+/^WARN_CFLAGS *=/s/@WARN_CFLAGS@//
+/^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@//
/^PROFILING_CFLAGS *=/s/@PROFILING_CFLAGS@//
/^ALLOCA *=/s!@ALLOCA@!!
/^EXEEXT *=/s!@EXEEXT@!!
}
/^insrcdir=/s/^.*$/\#&/
/^ *\$(insrcdir) ||/s,\$(insrcdir) ||,command.com /c if not exist $(<F),
-
/^srcdir *=/s/@[^@\n]*@/./
/^VPATH *=/s/@[^@\n]*@/./
/^MAKEINFO *=/s/@[^@\n]*@/makeinfo/
+/^INFO_EXT *=/s/@[^@\n]*@/.info/
+/^INFO_OPTS *=/s/@[^@\n]*@/--no-split/
/^ENVADD/,/^$/c\
ENVADD =\
export TEXINPUTS := $(srcdir)";"$(TEXINPUTS)\
/RUN_EMACS *=/,/^$/c\
export EMACSLOADPATH=${buildlisppath}\
-RUN_EMACS = ${BUILT_EMACS} -batch --no-site-file
+RUN_EMACS = ${EMACS} -batch --no-site-file
+
+/^MKDIR_P *=/s,@MKDIR_P@,command.com /c md,
/^ cd ../c\
${MAKE} -C ../src ${MFLAGS} emacs
-/else make quail/c\
- if not exist quail\\nul make quail
-
/if \[ -f $@ \]\; then true/d
/fi$/s/; fi$//
/^ --eval/,/; \\$/s|\; \\||
}
+/^setwins=/,/^$/d
+/^\.PHONY: compile-targets/d
+/^compile-targets:/d
+/^compile-main:/,/^$/c\
+compile-main: ${TIT_MISC}\
+ $(MAKE) $(MFLAGS) $(foreach f,$(wildcard ja-dic/*.el),$(basename $f).elc)\
+ $(MAKE) $(MFLAGS) $(foreach f,$(wildcard quail/*.el),$(basename $f).elc)\
+
+
/^install:/,/^$/c\
install: all\
+/^bootstrap-clean:/,/^$/c\
+bootstrap-clean: clean\
+ rm -f ja-dic/*.elc quail/*.elc\
+
+
/^ if test -f/d
/^distclean:/,/^$/ {
s|\(rm -f Makefile\)|\1 stamp-subdir|
# Configuration script for lib/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 2011-2012 Free Software Foundation, Inc.
+# Copyright (C) 2011-2012 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
# otherwise edit them to zero:
#
# /^REPLACE_CALLOC *=/s/@REPLACE_CALLOC@/0/
-#
+#
# . If the module is a header or adds headers, edit the corresponding
# variable to either an empty value or to the name of the header.
# Examples:
# s/'\; \\ *$/' >> $@-t/
# }
#
+# . If the recipe for generating a header file uses 'cat', replace it with
+#
+# sed -e ''
+#
+# (if needed; there's already an edit command that should take care of
+# this).
+#
# The following Awk script is useful for editing portions of
# autogen/Makefile.in into Sed commands that define the corresponding
# variables to zero (which is what is required in the absolute
/^CYGWIN_OBJ *=/s/@[^@\n]*@//
/^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@//
/^C_SWITCH_SYSTEM *=/s/@C_SWITCH_SYSTEM@//
-/^C_SWITCH_X_SYSTEM *=/s/@C_SWITCH_X_SYSTEM@//
+/^GNUSTEP_CFLAGS *=/s/@GNUSTEP_CFLAGS@//
/^C_SWITCH_X_SITE *=/s/@C_SWITCH_X_SITE@//
-/^C_WARNINGS_SWITCH *=/s/@C_WARNINGS_SWITCH@//
-/^DEFS *=/s/@[^@\n]*@/-DHAVE_CONFIG_H/
+/^GNULIB_WARN_CFLAGS *=/s/@GNULIB_WARN_CFLAGS@//
+/^WARN_CFLAGS *=/s/@WARN_CFLAGS@//
+/^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@//
+/^DEFS *=/s/@[^@\n]*@//
/^DEPDIR *=/s/@[^@\n]*@/deps/
/^DEPFLAGS *=/s/@[^@\n]*@/-MMD -MF ${DEPDIR}\/$*.d/
/^ECHO_N *=/s/@[^@\n]*@/-n/
/^GNULIB_GETLOGIN *=/s/@GNULIB_GETLOGIN@/0/
/^GNULIB_GETLOGIN_R *=/s/@GNULIB_GETLOGIN_R@/0/
/^GNULIB_GETPAGESIZE *=/s/@GNULIB_GETPAGESIZE@/0/
-/^GNULIB_GETS *=/s/@GNULIB_GETS@/0/
+/^GNULIB_GL_UNISTD_H_GETOPT *=/s/@GNULIB_GL_UNISTD_H_GETOPT@/1/
/^GNULIB_GETSUBOPT *=/s/@GNULIB_GETSUBOPT@/0/
+/^GNULIB_GETTIMEOFDAY *=/s/@GNULIB_GETTIMEOFDAY@/0/
/^GNULIB_GETUSERSHELL *=/s/@GNULIB_GETUSERSHELL@/0/
/^GNULIB_GRANTPT *=/s/@GNULIB_GRANTPT@/0/
/^GNULIB_GROUP_MEMBER *=/s/@GNULIB_GROUP_MEMBER@/0/
+/^GNULIB_ISATTY *=/s/@GNULIB_ISATTY@/0/
/^GNULIB_LCHMOD *=/s/@GNULIB_LCHMOD@/0/
/^GNULIB_LCHOWN *=/s/@GNULIB_LCHOWN@/0/
/^GNULIB_LINK *=/s/@GNULIB_LINK@/0/
/^GNULIB_PIPE *=/s/@GNULIB_PIPE@/0/
/^GNULIB_PIPE2 *=/s/@GNULIB_PIPE2@/0/
/^GNULIB_POPEN *=/s/@GNULIB_POPEN@/0/
+/^GNULIB_POSIX_OPENPT *=/s/@GNULIB_POSIX_OPENPT@/0/
/^GNULIB_PREAD *=/s/@GNULIB_PREAD@/0/
/^GNULIB_PRINTF *=/s/@GNULIB_PRINTF@/0/
/^GNULIB_PRINTF_POSIX *=/s/@GNULIB_PRINTF_POSIX@/0/
+/^GNULIB_PSELECT *=/s/@GNULIB_PSELECT@/0/
/^GNULIB_PTHREAD_SIGMASK *=/s/@GNULIB_PTHREAD_SIGMASK@/0/
/^GNULIB_PTSNAME *=/s/@GNULIB_PTSNAME@/0/
+/^GNULIB_PTSNAME_R *=/s/@GNULIB_PTSNAME_R@/0/
/^GNULIB_PUTC *=/s/@GNULIB_PUTC@/0/
/^GNULIB_PUTCHAR *=/s/@GNULIB_PUTCHAR@/0/
/^GNULIB_PUTENV *=/s/@GNULIB_PUTENV@/0/
/^GNULIB_PUTS *=/s/@GNULIB_PUTS@/0/
/^GNULIB_PWRITE *=/s/@GNULIB_PWRITE@/0/
/^GNULIB_RAISE *=/s/@GNULIB_RAISE@/0/
+/^GNULIB_RANDOM *=/s/@GNULIB_RANDOM@/0/
/^GNULIB_RANDOM_R *=/s/@GNULIB_RANDOM_R@/0/
/^GNULIB_READ *=/s/@GNULIB_READ@/0/
/^GNULIB_READLINK *=/s/@GNULIB_READLINK@/0/
/^GNULIB_RMDIR *=/s/@GNULIB_RMDIR@/0/
/^GNULIB_RPMATCH *=/s/@GNULIB_RPMATCH@/0/
/^GNULIB_SCANF *=/s/@GNULIB_SCANF@/0/
+/^GNULIB_SELECT *=/s/@GNULIB_SELECT@/0/
/^GNULIB_SETENV *=/s/@GNULIB_SETENV@/0/
+/^GNULIB_SETHOSTNAME *=/s/@GNULIB_SETHOSTNAME@/0/
/^GNULIB_SIGACTION *=/s/@GNULIB_SIGACTION@/0/
/^GNULIB_SIGNAL_H_SIGPIPE *=/s/@GNULIB_SIGNAL_H_SIGPIPE@/0/
/^GNULIB_SIGPROCMASK *=/s/@GNULIB_SIGPROCMASK@/0/
/^GNULIB_TIME_R *=/s/@GNULIB_TIME_R@/1/
/^GNULIB_TMPFILE *=/s/@GNULIB_TMPFILE@/0/
/^GNULIB_TTYNAME_R *=/s/@GNULIB_TTYNAME_R@/0/
-/^GNULIB_UNISTD_H_GETOPT *=/s/@GNULIB_UNISTD_H_GETOPT@/1/
/^GNULIB_UNISTD_H_NONBLOCKING *=/s/@GNULIB_UNISTD_H_NONBLOCKING@/0/
/^GNULIB_UNISTD_H_SIGPIPE *=/s/@GNULIB_UNISTD_H_SIGPIPE@/0/
/^GNULIB_UNLINK *=/s/@GNULIB_UNLINK@/0/
/^HAVE_DECL_GETUSERSHELL *=/s/@HAVE_DECL_GETUSERSHELL@/0/
/^HAVE_DECL_LOCALTIME_R *=/s/@HAVE_DECL_LOCALTIME_R@/0/
/^HAVE_DECL_OBSTACK_PRINTF *=/s/@HAVE_DECL_OBSTACK_PRINTF@/0/
+/^HAVE_DECL_SETHOSTNAME *=/s/@HAVE_DECL_SETHOSTNAME@/0/
/^HAVE_DECL_SETENV *=/s/@HAVE_DECL_SETENV@/1/
/^HAVE_DECL_SNPRINTF *=/s/@HAVE_DECL_SNPRINTF@/0/
/^HAVE_DECL_TTYNAME_R *=/s/@HAVE_DECL_TTYNAME_R@/0/
/^HAVE_PIPE2 *=/s/@HAVE_PIPE2@/0/
/^HAVE_POPEN *=/s/@HAVE_POPEN@/1/
/^HAVE_POSIX_SIGNALBLOCKING *=/s/@HAVE_POSIX_SIGNALBLOCKING@/1/
+/^HAVE_POSIX_OPENPT *=/s/@HAVE_POSIX_OPENPT@/0/
/^HAVE_PREAD *=/s/@HAVE_PREAD@/0/
/^HAVE_PTSNAME *=/s/@HAVE_PTSNAME@/0/
+/^HAVE_PTSNAME_R *=/s/@HAVE_PTSNAME_R@/0/
/^HAVE_PTHREAD_SIGMASK *=/s/@HAVE_PTHREAD_SIGMASK@/0/
/^HAVE_PWRITE *=/s/@HAVE_PWRITE@/0/
/^HAVE_RANDOM_H *=/s/@HAVE_RANDOM_H@/1/
/^HAVE_RAISE *=/s/@HAVE_RAISE@/1/
+/^HAVE_RANDOM *=/s/@HAVE_RANDOM@/1/
/^HAVE_RANDOM_R *=/s/@HAVE_RANDOM_R@/0/
/^HAVE_READLINK *=/s/@HAVE_READLINK@/0/
/^HAVE_READLINKAT *=/s/@HAVE_READLINKAT@/0/
/^HAVE_RENAMEAT *=/s/@HAVE_RENAMEAT@/0/
/^HAVE_RPMATCH *=/s/@HAVE_RPMATCH@/0/
/^HAVE_SETENV *=/s/@HAVE_SETENV@/1/
+/^HAVE_SETHOSTNAME *=/s/@HAVE_SETHOSTNAME@/0/
/^HAVE_SIGACTION *=/s/@HAVE_SIGACTION@/1/
/^HAVE_SIGHANDLER_T *=/s/@HAVE_SIGHANDLER_T@/0/
/^HAVE_SIGINFO_T *=/s/@HAVE_SIGINFO_T@/0/
/^HAVE_STRTOULL *=/s/@HAVE_STRTOULL@/1/
/^HAVE_STRUCT_SIGACTION_SA_SIGACTION *=/s/@HAVE_STRUCT_SIGACTION_SA_SIGACTION@/0/
/^HAVE_STRUCT_RANDOM_DATA *=/s/@HAVE_STRUCT_RANDOM_DATA@/0/
+/^HAVE_STRUCT_TIMEVAL *=/s/@HAVE_STRUCT_TIMEVAL@/1/
/^HAVE_SYMLINK *=/s/@HAVE_SYMLINK@/1/
/^HAVE_SYMLINKAT *=/s/@HAVE_SYMLINKAT@/0/
/^HAVE_SYS_BITYPES_H *=/s/@HAVE_SYS_BITYPES_H@/0/
/^HAVE_SYS_INTTYPES_H *=/s/@HAVE_SYS_INTTYPES_H@/0/
/^HAVE_SYS_LOADAVG_H *=/s/@HAVE_SYS_LOADAVG_H@/0/
/^HAVE_SYS_PARAM_H *=/s/@HAVE_SYS_PARAM_H@/1/
+/^HAVE_SYS_SELECT_H *=/s/@HAVE_SYS_SELECT_H@/0/
+/^HAVE_SYS_TIME_H *=/s/@HAVE_SYS_TIME_H@/1/
/^HAVE_SYS_TYPES_H *=/s/@HAVE_SYS_TYPES_H@/1/
/^HAVE_TIMEGM *=/s/@HAVE_TIMEGM@/0/
/^HAVE_TYPE_VOLATILE_SIG_ATOMIC_T *=/s/@HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@/1/
/^NEXT_AS_FIRST_DIRECTIVE_STDINT_H *=/s/@[^@\n]*@/<stdint.h>/
/^NEXT_AS_FIRST_DIRECTIVE_STDIO_H *=/s/@[^@\n]*@/<stdio.h>/
/^NEXT_AS_FIRST_DIRECTIVE_STDLIB_H *=/s/@[^@\n]*@/<stdlib.h>/
+/^NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H *=/s/@[^@\n]*@//
/^NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H *=/s!@[^@\n]*@!<sys/stat.h>!
+/^NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H *=/s/@[^@\n]*@//
+/^NEXT_AS_FIRST_DIRECTIVE_SYS_TYPES_H *=/s!@[^@\n]*@!<sys/types.h>!
/^NEXT_AS_FIRST_DIRECTIVE_TIME_H *=/s/@[^@\n]*@/<time.h>/
/^NEXT_AS_FIRST_DIRECTIVE_UNISTD_H *=/s/@[^@\n]*@/<unistd.h>/
/^NEXT_GETOPT_H *=/s/@[^@\n]*@/<getopt.h>/
/^NEXT_STDIO_H *=/s/@[^@\n]*@/<stdio.h>/
/^NEXT_STDINT_H *=/s/@[^@\n]*@/<stdint.h>/
/^NEXT_STDLIB_H *=/s/@[^@\n]*@/<stdlib.h>/
+/^NEXT_SYS_SELECT_H *=/s/@[^@\n]*@//
/^NEXT_SYS_STAT_H *=/s!@[^@\n]*@!<sys/stat.h>!
+/^NEXT_SYS_TIME_H *=/s/@[^@\n]*@//
+/^NEXT_SYS_TYPES_H *=/s!@[^@\n]*@!<sys/types.h>!
/^NEXT_TIME_H *=/s/@[^@\n]*@/<time.h>/
/^NEXT_UNISTD_H *=/s/@[^@\n]*@/<unistd.h>/
/^OBJEXT *=/s/@[^@\n]*@/o/
/^REPLACE_FSTATAT *=/s/@REPLACE_FSTATAT@/0/
/^REPLACE_FTELL *=/s/@REPLACE_FTELL@/0/
/^REPLACE_FTELLO *=/s/@REPLACE_FTELLO@/0/
+/^REPLACE_FTRUNCATE *=/s/@REPLACE_FTRUNCATE@/0/
/^REPLACE_GETCWD *=/s/@REPLACE_GETCWD@/0/
/^REPLACE_GETDELIM *=/s/@REPLACE_GETDELIM@/0/
/^REPLACE_GETDOMAINNAME *=/s/@REPLACE_GETDOMAINNAME@/0/
/^REPLACE_GETLINE *=/s/@REPLACE_GETLINE@/0/
/^REPLACE_GETLOGIN_R *=/s/@REPLACE_GETLOGIN_R@/0/
/^REPLACE_GETPAGESIZE *=/s/@REPLACE_GETPAGESIZE@/0/
+/^REPLACE_GETTIMEOFDAY *=/s/@REPLACE_GETTIMEOFDAY@/0/
+/^REPLACE_ISATTY *=/s/@REPLACE_ISATTY@/0/
/^REPLACE_LCHOWN *=/s/@REPLACE_LCHOWN@/0/
/^REPLACE_LINK *=/s/@REPLACE_LINK@/0/
/^REPLACE_LINKAT *=/s/@REPLACE_LINKAT@/0/
/^REPLACE_PREAD *=/s/@REPLACE_PREAD@/0/
/^REPLACE_PRINTF *=/s/@REPLACE_PRINTF@/0/
/^REPLACE_PTHREAD_SIGMASK *=/s/@REPLACE_PTHREAD_SIGMASK@/0/
+/^REPLACE_PSELECT *=/s/@REPLACE_PSELECT@/0/
+/^REPLACE_PTSNAME_R *=/s/@REPLACE_PTSNAME_R@/0/
/^REPLACE_PUTENV *=/s/@REPLACE_PUTENV@/0/
/^REPLACE_PWRITE *=/s/@REPLACE_PWRITE@/0/
+/^REPLACE_RANDOM_R *=/s/@REPLACE_RANDOM_R@/0/
/^REPLACE_READ *=/s/@REPLACE_READ@/0/
/^REPLACE_RAISE *=/s/@REPLACE_RAISE@/0/
/^REPLACE_READLINK *=/s/@REPLACE_READLINK@/0/
/^REPLACE_STDIO_READ_FUNCS *=/s/@REPLACE_STDIO_READ_FUNCS@/0/
/^REPLACE_STDIO_WRITE_FUNCS *=/s/@REPLACE_STDIO_WRITE_FUNCS@/0/
/^REPLACE_STRTOD *=/s/@REPLACE_STRTOD@/0/
+/^REPLACE_STRTOIMAX *=/s/@REPLACE_STRTOIMAX@/0/
+/^REPLACE_STRUCT_TIMEVAL *=/s/@REPLACE_STRUCT_TIMEVAL@/0/
/^REPLACE_SYMLINK *=/s/@REPLACE_SYMLINK@/0/
/^REPLACE_TIMEGM *=/s/@REPLACE_TIMEGM@/0/
/^REPLACE_TMPFILE *=/s/@REPLACE_TMPFILE@/0/
/^SIZE_T_SUFFIX *=/s/@SIZE_T_SUFFIX@/u/
/^ALLOCA_H *=/s/@[^@\n]*@/alloca.h/
/^STDBOOL_H *=/s/@[^@\n]*@//
+/^STDALIGN_H *=/s/@[^@\n]*@/stdalign.h/
/^STDARG_H *=/s/@[^@\n]*@//
/^STDDEF_H *=/s/@[^@\n]*@//
/^STDINT_H *=/s/@[^@\n]*@/stdint.h/
/^UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS *=/s/@[^@\n]*@/0/
/^WCHAR_T_SUFFIX *=/s/@WCHAR_T_SUFFIX@/h/
/^WINT_T_SUFFIX *=/s/@WINT_T_SUFFIX@//
+/^WINDOWS_64_BIT_OFF_T *=/s/@WINDOWS_64_BIT_OFF_T@/0/
+/^WINDOWS_64_BIT_ST_SIZE *=/s/@WINDOWS_64_BIT_ST_SIZE@/0/
/am__append_1 *=.*gettext\.h/s/@[^@\n]*@/\#/
/am__append_2 *=.*verify\.h/s/@[^@\n]*@//
/^gl_LIBOBJS *=/s/@[^@\n]*@/getopt.o getopt1.o strftime.o time_r.o getloadavg.o pthread_sigmask.o/
/^BUILT_SOURCES *=/s/ *inttypes\.h//
-/^am_libgnu_a_OBJECTS *=/s/careadlinkat\.\$(OBJEXT)//
-/^am_libgnu_a_OBJECTS *=/s/allocator\.\$(OBJEXT)//
+/^BUILT_SOURCES *=/,/^[^ ]/{
+ s| *sys/select\.h||
+ s| *sys/time\.h||
+}
+/^am_libgnu_a_OBJECTS *=/,/^[^ ]/{
+ s/allocator\.\$(OBJEXT) //
+ s/careadlinkat\.\$(OBJEXT) //
+}
/^srcdir *=/s/@[^@\n]*@/./
/^top_srcdir *=/s/@[^@\n]*@/../
/^top_builddir *=/s/@[^@\n]*@/../
s/^@GL_GENERATE_ALLOCA_H_FALSE@/\#/
s/^@GL_GENERATE_STDBOOL_H_TRUE@/\#/
s/^@GL_GENERATE_STDBOOL_H_FALSE@//
+s/^@GL_GENERATE_STDALIGN_H_TRUE@//
+s/^@GL_GENERATE_STDALIGN_H_FALSE@/\#/
s/^@GL_GENERATE_STDARG_H_TRUE@/\#/
s/^@GL_GENERATE_STDARG_H_FALSE@/\#/
s/^@GL_GENERATE_STDDEF_H_TRUE@/\#/
s/^@GL_GENERATE_STDDEF_H_FALSE@/\#/
s/^@GL_GENERATE_STDINT_H_TRUE@//
s/^@GL_GENERATE_STDINT_H_FALSE@/\#/
+s/^@GL_GENERATE_STDALIGN_H_TRUE@//
+s/^@GL_GENERATE_STDALIGN_H_FALSE@/\#/
/^arg-nonnull\.h:/,/^[ ][ ]*mv /c\
arg-nonnull.h: $(top_srcdir)/build-aux/snippet/arg-nonnull.h\
sed -n -e '/GL_ARG_NONNULL/,$$p' < $(top_srcdir)/build-aux/snippet/arg-nonnull.h > $@
sed -n -e '/^.ifndef/,$$p' < $(top_srcdir)/build-aux/snippet/warn-on-use.h > $@
s/^ [ ]*{ echo \(.*\); \\/ djecho \1 > $@-t/
s/^ [ ]*{ echo \(.*\) && \\/ djecho \1 > $@-t/
+s/^ [ ]*cat \(.*\); \\/ sed -e '' \1 >> $@-t/
s/ \&\& \\ *$//
s/\.in-h\; *\\$/.in-h >> $@-t/
/^ [ ]*} /d
s/'\; \\ *$/' >> $@-t/
}
s!\$(MKDIR_P)[ ][ ]*sys!command.com /c "if not exist sys\\stat.h md sys"!
+/^ @for dir in/,/^[^ ]/c\
+ -rm -rf $(MOSTLYCLEANDIRS)
+/^ *-test . /d
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-17 Glenn Morris <rgm@gnu.org>
- * Version 24.2 released.
+ * templates/Info-gnustep.plist.in, templates/InfoPlist.strings.in:
+ * templates/Info.plist.in: Let configure set copyright.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-09-16 Glenn Morris <rgm@gnu.org>
- * Version 24.1 released.
+ * Makefile.in: New file.
+ * templates: New directory.
+ * templates/Emacs.desktop.in, templates/Info-gnustep.plist.in:
+ * templates/Info.plist.in, templates/InfoPlist.strings.in:
+ Move here from various Cocoa/, GNUstep/ locations.
+ Let configure set the version number.
+ * Cocoa/Emacs.base/Contents/Info.plist:
+ * Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:
+ * GNUstep/Emacs.base/Resources/Info-gnustep.plist:
+ * GNUstep/Emacs.base/Resources/Emacs.desktop: Move to templates/.
+ * Cocoa/Emacs.base/Contents/Resources/English.lproj: Remove directory.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * Cocoa/Emacs.base/Contents/Info.plist:
+ * Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:
+ * GNUstep/Emacs.base/Resources/Info-gnustep.plist:
+ * GNUstep/Emacs.base/Resources/Emacs.desktop:
+ Bump version to 24.1.50.
2012-01-05 Glenn Morris <rgm@gnu.org>
+++ /dev/null
-/* Localized versions of Info.plist keys */
-
-CFBundleName = "Emacs";
-CFBundleShortVersionString = "Version 24.2";
-CFBundleGetInfoString = "Emacs version 24.2, NS Windowing";
-NSHumanReadableCopyright = "Copyright (C) 2012 Free Software Foundation, Inc.";
make install
-This will assemble the app in nextstep/Emacs.app.
+This will assemble the app in nextstep/Emacs.app (i.e., the --prefix
+argument has no effect in this case).
If you pass the --disable-ns-self-contained option to configure, the lisp
files will be installed under whatever 'prefix' is set to (defaults to
--- /dev/null
+### nextstep/Makefile for GNU Emacs
+
+## 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 <http://www.gnu.org/licenses/>.
+
+### Commentary:
+
+### Code:
+SHELL = /bin/sh
+
+srcdir = @srcdir@
+EXEEXT = @EXEEXT@
+
+@SET_MAKE@
+MKDIR_P = @MKDIR_P@
+
+ns_appdir = @ns_appdir@
+ns_appbindir = @ns_appbindir@
+ns_appsrc = @ns_appsrc@
+
+${ns_appdir}: ${srcdir}/${ns_appsrc} ${ns_appsrc}
+ rm -rf ${ns_appdir}
+ ${MKDIR_P} ${ns_appdir}
+ ( cd ${srcdir}/${ns_appsrc} ; tar cfh - . ) | \
+ ( cd ${ns_appdir} ; umask 022; tar xf - )
+ [ `cd ${srcdir} && /bin/pwd` = `/bin/pwd` ] || \
+ ( cd ${ns_appsrc} ; tar cfh - . ) | \
+ ( cd ${ns_appdir} ; umask 022; tar xf - )
+
+${ns_appbindir}/Emacs: ${ns_appdir} ../src/emacs${EXEEXT}
+ ${MKDIR_P} ${ns_appbindir}
+ cp -f ../src/emacs${EXEEXT} ${ns_appbindir}/Emacs
+
+.PHONY: all
+
+all: ${ns_appdir} ${ns_appbindir}/Emacs
+
+
+.PHONY: clean distclean maintainer-clean
+
+clean:
+ rm -rf ${ns_appdir}
+
+distclean: clean
+ rm -f Makefile
+ rm -f GNUstep/Emacs.base/Resources/Info-gnustep.plist \
+ GNUstep/Emacs.base/Resources/Emacs.desktop \
+ Cocoa/Emacs.base/Contents/Info.plist \
+ Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings
+
+maintainer-clean: distclean
+
+### Makefile.in ends here
[Desktop Entry]
Encoding=UTF-8
Type=Application
-Version=24.2
+Version=@version@
Categories=GNUstep
Name=Emacs
Comment=GNU Emacs for NeXT/Open/GNUstep and OS X
ApplicationDescription = "GNU Emacs for GNUstep / OS X";
ApplicationIcon = emacs.tiff;
ApplicationName = Emacs;
- ApplicationRelease = "24.2";
+ ApplicationRelease = "@version@";
Authors = (
"Adrian Robert (GNUstep)",
"Christophe de Dinechin (MacOS X)",
"Carl Edman (NeXTstep)",
"..see etc/NEXTSTEP"
);
- Copyright = "Copyright (C) 2012 Free Software Foundation, Inc.";
+ Copyright = "@copyright@";
CopyrightDescription = "Released under the GNU General Public License Version 3 or later";
- FullVersionID = "Emacs 24.2, NS Windowing";
+ FullVersionID = "Emacs @version@, NS Windowing";
NSExecutable = Emacs;
NSIcon = emacs.tiff;
NSPrincipalClass = NSApplication;
<key>CFBundleExecutable</key>
<string>Emacs</string>
<key>CFBundleGetInfoString</key>
- <string>Emacs 24.2 Copyright (C) 2012 Free Software Foundation, Inc.</string>
+ <string>Emacs @version@ @copyright@</string>
<key>CFBundleIconFile</key>
<string>Emacs.icns</string>
<key>CFBundleIdentifier</key>
<string>APPL</string>
<!-- This should be the emacs version number. -->
<key>CFBundleShortVersionString</key>
- <string>24.2</string>
+ <string>@version@</string>
<key>CFBundleSignature</key>
<string>EMAx</string>
<!-- This SHOULD be a build number. -->
--- /dev/null
+/* Localized versions of Info.plist keys */
+
+CFBundleName = "Emacs";
+CFBundleShortVersionString = "Version @version@";
+CFBundleGetInfoString = "Emacs version @version@, NS Windowing";
+NSHumanReadableCopyright = "@copyright@";
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-23 Eli Zaretskii <eliz@gnu.org>
- * Version 24.2 released.
+ * inc/ms-w32.h (emacs_raise): Redefine to invoke emacs_abort.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.1 released.
+ Simplify and avoid signal-handling races (Bug#12471).
+ * inc/ms-w32.h (emacs_raise): New macro.
-2012-05-29 Eli Zaretskii <eliz@gnu.org>
+2012-09-18 Eli Zaretskii <eliz@gnu.org>
- * nmake.defs (MWINDOWS): Define as
- "-subsystem:windows -entry:mainCRTStartup". Suggested by Fabrice
- Popineau <fabrice.popineau@supelec.fr>. (Bug#11405)
+ * configure.bat: Include stddef.h before gif_lib.h, to have size_t
+ defined, as needed by giflib-5.0.0. (Bug#12464)
- * gmake.defs (MWINDOWS): Define as "-mwindows".
+2012-09-17 Juanma Barranquero <lekktu@gmail.com>
-2012-05-28 Eli Zaretskii <eliz@gnu.org>
+ * config.nt: Sync with autogen/config.in.
+ (BROKEN_SA_RESTART, SYNC_INPUT): Remove.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * config.nt (COPYRIGHT): New.
+
+2012-09-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port _setjmp fix to POSIXish hosts as well as Microsoft.
+ * config.nt: Attempt to sync with autogen/config.in.
+ (HAVE_SIGSETJMP, HAVE__SETJMP): New macros.
+ (_longjmp, _setjmp): Remove.
+
+2012-09-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (BROKEN_FIONREAD, BROKEN_SIGAIO, BROKEN_SIGIO, BROKEN_SIGPOLL)
+ (BROKEN_SIGPTY, HAVE_CBRT, HAVE_LOGB, NO_TERMIO): Remove.
+ (USABLE_FIONREAD, USABLE_SIGIO): New macros.
+
+2012-09-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (FLOAT_CHECK_DOMAIN, HAVE_FMOD, HAVE_FREXP)
+ (HAVE_INVERSE_HYPERBOLIC, NO_MATHERR): Remove.
+
+2012-09-08 Eli Zaretskii <eliz@gnu.org>
+
+ * configure.bat <use_extensions>: Don't leave it set in the
+ environment when the script exits.
+
+2012-09-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (NO_ABORT, SIGNAL_H_AHB): Remove.
+
+2012-09-07 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/ms-w32.h (struct sigaction): Declare sa_handler __cdecl.
+
+2012-09-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify redefinition of 'abort' (Bug#12316).
+ * inc/ms-w32.h (w32_abort) [HAVE_NTGUI]: Remove.
+
+2012-09-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_EXECINFO_H, TERM_HEADER): New macros.
+
+2012-09-01 Daniel Colascione <dancol@dancol.org>
+
+ * inc/ms-w32.h (TERM_HEADER): Add for refactoring
+
+2012-08-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-08-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_POSIX_OPENPT): New macro.
+
+2012-08-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (_GL_INLINE_HEADER_BEGIN): Update.
+
+2012-08-10 Glenn Morris <rgm@gnu.org>
+
+ * config.nt (DIRECTORY_SEP): Move here from src/lisp.h.
+
+2012-08-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * 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 <rgm@gnu.org>
+
+ * config.nt (GNU_LIBRARY_PENDING_OUTPUT_COUNT): Remove.
+ (PENDING_OUTPUT_COUNT): Define it as dispnew.c used to.
+
+2012-08-04 Eli Zaretskii <eliz@gnu.org>
+
+ * 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 <lekktu@gmail.com>
+
+ * 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 <eliz@gnu.org>
+
+ * 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 <eggert@cs.ucla.edu>
+
+ 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 <rgm@gnu.org>
+
+ * inc/ms-w32.h: Move here from ../src/s.
+ * config.nt (config_opsysfile): Change to <ms-w32.h>.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * 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 <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ Remove code moved to conf_post.h and include <conf_post.h>
+ (NULL_DEVICE, SEPCHAR, SIGNAL_H_AHB, TIOCSIGSEND, USER_FULL_NAME)
+ (USG5_4, WRETCODE, _longjmp, _setjmp, wait3): New macros.
+
+2012-07-29 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (HAVE_ENVIRON_DECL): New macro.
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/stdalign.h (_Alignas, alignas): Define.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib stdalign module (Bug#9772, Bug#9960).
+ * config.nt (HAVE_ATTRIBUTE_ALIGNED): Remove.
+
+2012-07-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (GC_MARK_SECONDARY_STACK, GC_MARK_STACK, GC_SETJMP_WORKS)
+ (SETUP_SLAVE_PTY): New macros.
+
+2012-07-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (BROKEN_FIONREAD, BROKEN_GET_CURRENT_DIR_NAME)
+ (BROKEN_PTY_READ_AFTER_EAGAIN, BROKEN_SIGAIO, BROKEN_SIGPOLL)
+ (BROKEN_SIGPTY, BSD4_2, BSD_SYSTEM, BSD_SYSTEM_AHB, CYGWIN, DARWIN_OS)
+ (FIRST_PTY_LETTER, GNU_LINUX, G_SLICE_ALWAYS_MALLOC, HAVE_PTYS)
+ (HAVE_SOCKETS, HPUX, INTERRUPT_INPUT, IRIX6_5, NARROWPROTO, NO_ABORT)
+ (NO_EDITRES, NSIG_MINIMUM, PREFER_VSUSP, PTY_ITERATION)
+ (PTY_NAME_SPRINTF, PTY_OPEN, PTY_TTY_NAME_SPRINTF, RUN_TIME_REMAP)
+ (SETPGRP_RELEASES_CTTY, SOLARIS2, TAB3, TABDLY, ULIMIT_BREAK_VALUE)
+ (UNIX98_PTYS, USG, USG5, XOS_NEEDS_TIME_H, _AIX): New macros.
+ (HAVE_ATTRIBUTE_ALIGNED, HAVE_C99_STRTOLD, HAVE___BUILTIN_UNWIND_INIT):
+ Set in src/s/ms-w32.h, not here.
+
+2012-07-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+ (CLASH_DETECTION, DEFAULT_SOUND_DEVICE, DONT_REOPEN_PTY)
+ (GNU_LIBRARY_PENDING_OUTPUT_COUNT, SIGNALS_VIA_CHARACTERS): New macros.
+ (HAVE_MKDIR, HAVE_RENAME, HAVE_RMDIR, HAVE_STRERROR): Remove.
+
+2012-07-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ * config.nt (ATTRIBUTE_CONST): Add, to sync with configure.ac.
+
+2012-07-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt: Sync with autogen/config.in.
+
+2012-07-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt (HAVE_STRCASECMP, HAVE_STRNCASECMP): Remove.
+
+2012-07-06 Juanma Barranquero <lekktu@gmail.com>
+ Eli Zaretskii <eliz@gnu.org>
+
+ * config.nt: Complete rework to bring it in sync with autogen/config.in.
+ All Windows-specific code moved to src/s/ms-w32.h.
+
+2012-07-04 Juanma Barranquero <lekktu@gmail.com>
+ Eli Zaretskii <eliz@gnu.org>
+
+ * configure.bat (enablechecking): Enable checks through src/config.h,
+ not the compiler's command line.
+
+ * nmake.defs (CHECKING_CFLAGS): Remove.
+ (CFLAGS, ESC_CFLAGS): Do not include $(CHECKING_CFLAGS).
+
+ * gmake.defs (DEBUG_CFLAGS): Add -fno-crossjumping.
+ (CHECKING_CFLAGS): Remove.
+ (CFLAGS, ESC_CFLAGS): Do not include $(CHECKING_CFLAGS).
+
+2012-07-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * config.nt (LISP_FLOAT_TYPE, HAVE_XFREE386, USE_TEXT_PROPERTIES)
+ (GSSAPI, HAVE_LIBINTL, HAVE_LIBGSSAPI_KRB5, HAVE_LIBGSSAPI)
+ (HAVE_GSSAPI_H, HAVE_LIBXBD, HAVE_MEMCPY, HAVE_MEMMOVE, HAVE_MEMSET)
+ (HAVE_MEMCMP): Remove, obsolete.
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * paths.h (PATH_SITELOADSEARCH): New.
+
+2012-06-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * nmake.defs (CHECKING_CFLAGS):
+ * gmake.defs (CHECKING_CFLAGS): Remove XASSERTS.
+
+2012-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ * config.nt (_Noreturn): Don't reference __SUNPRO_C.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ * config.nt (_Noreturn): New macro.
+ (NO_RETURN): Remove. All uses replaced with _Noreturn.
+ (w32_abort) [HAVE_NTGUI]: Use _Noreturn rather than NO_RETURN.
+
+2012-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/sys/time.h (struct timespec): Don't define it here, it is
+ now defined in src/s/ms-w32.h.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build broken by 2012-06-22T21:17:42Z!eggert@cs.ucla.edu.
+ * inc/sys/time.h (struct timespec): Define.
+
+2012-06-16 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (install-addpm): New target.
+ (dist): Depend on it.
+ (install-shortcuts): Depend on install-addpm instead of copying
+ addpm.exe as part of the recipe. See
+ http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00171.html
+ for the related problem and discussions.
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * config.nt (SYSTEM_TYPE): Define it.
+
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
* configure.bat (genmakefiles): Move the redirection away from the
end of the command, to avoid excess whitespace at the end of Make
descriptor and eaten up. This fixes breakage introduced by the
last change, without reintroducing the bug fixed by that change.
-2012-05-18 Eli Zaretskii <eliz@gnu.org>
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ * nmake.defs (MWINDOWS): Define as
+ "-subsystem:windows -entry:mainCRTStartup". Suggested by Fabrice
+ Popineau <fabrice.popineau@supelec.fr>. (Bug#11405)
+
+ * gmake.defs (MWINDOWS): Define as "-mwindows".
+
+2012-05-28 Eli Zaretskii <eliz@gnu.org>
+
+ * config.nt (HAVE_SYSINFO): Remove; unused.
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/stdalign.h: New file.
* configure.bat: Ensure a space between %var% expansion and
redirection symbol '>', which breaks when %var% ends in a digit,
such as 1.
-2012-04-11 Dani Moncayo <dmoncayo@gmail.com> (tiny change)
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ * config.nt: Do not include "m/intel386.h"; file was removed.
+ (BITS_PER_CHAR, BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
+ Move to src/lisp.h.
+ (EMACS_INT_MAX): New macro.
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * config.nt (HAVE_GETDOMAINNAME, HAVE_XSETWMPROTOCOLS)
+ (HAVE_GETSOCKOPT, HAVE_SETSOCKOPT): Remove; not needed.
+
+ * config.nt (HAVE_FTIME): Remove undef; not needed.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * config.nt (HAVE_LIBNCURSES): Remove undef; not needed.
+
+2012-04-14 Dani Moncayo <dmoncayo@gmail.com> (tiny change)
* makefile.w32-in: Fix typo (Bug#10261).
+2012-04-10 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (emacs, misc, lispref, lispintro): New targets,
+ each runs makeinfo in its own subdirectory of 'doc'.
+ (info-gmake): Depend on these new targets.
+
+2012-04-07 Glenn Morris <rgm@gnu.org>
+
+ * config.nt, makefile.w32-in, emacs.rc, emacsclient.rc:
+ Bump version to 24.1.50.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * configure.bat: Support building with libxml2.
+
+ * INSTALL:
+ * README.W32: Add information about libxml2.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in: Convert to Unix EOL format.
+ (all): Don't depend on stamp_BLD and on maybe-bootstrap.
+ (all-other-dirs-$(MAKETYPE)): Depend on maybe-bootstrap.
+ (bootstrap-gmake): Invoke the "clean" and build targets in 2
+ separate commands, so they run in that order even under "make -j".
+
2012-03-29 Eli Zaretskii <eliz@gnu.org>
* config.nt: Discourage from defining HAVE_GETCWD.
2008-04-04 Jason Rumney <jasonr@gnu.org>
- * INSTALL: Update W32 API requirements.
+ * INSTALL: Update Windows API requirements.
2008-04-03 Jason Rumney <jasonr@gnu.org>
2005-06-05 Eli Zaretskii <eliz@gnu.org>
* inc/sys/socket.h: Change arg 4 of sys_setsockopt to
- `const void *', for consistency with Posix.
+ `const void *', for consistency with POSIX.
2005-06-04 Eli Zaretskii <eliz@gnu.org>
* makefile.def (CP_DIR): Use platform independent switches for xcopy.
* makefile.nt (install, fast_install, real_install, clean):
- Don't use switches to del not supported by Win95.
+ Don't use switches to del not supported by Windows 95.
1995-11-07 Kevin Gallo <kgallo@microsoft.com>
1995-05-27 Geoff Voelker <voelker@cs.washington.edu>
* ebuild.bat, emacs.bat, fast-install.bat, install.bat:
- Add carriage returns; necessary for batch files on Win95.
+ Add carriage returns; necessary for batch files on Windows 95.
1995-05-25 Geoff Voelker <voelker@cs.washington.edu>
To compile Emacs, you will need either Microsoft Visual C++ 2.0, or
later and nmake, or a Windows port of GCC 2.95 or later with MinGW
- and W32 API support and a port of GNU Make. You can use the Cygwin
+ and Windows API support and a port of GNU Make. You can use the Cygwin
ports of GCC, but Emacs requires the MinGW headers and libraries to
build (latest versions of the Cygwin toolkit, at least since v1.3.3,
include the MinGW headers and libraries as an integral part).
You can get pre-built binaries (including any required DLL and the
header files) at http://sourceforge.net/projects/ezwinports/files/.
+* Optional libxml2 support
+
+ If configure.bat finds the libxml/HTMLparser.h file in the include path,
+ Emacs is built with libxml2 support by default; to avoid that you can
+ pass the argument --without-libxml2.
+
+ In order to support libxml2 at runtime, a libxml2-enabled Emacs must
+ be able to find the relevant DLLs during startup; failure to do so
+ is not an error, but libxml2 features won't be available to the
+ running session.
+
+ One place where you can get pre-built Windows binaries of libxml2
+ (including any required DLL and the header files) is here:
+
+ http://sourceforge.net/projects/ezwinports/files/
+
+ To compile Emacs with libxml2 from that site, you will need to pass
+ the "--cflags -I/path/to/include/libxml2" option to configure.bat,
+ because libxml2 header files are installed in the include/libxml2
+ subdirectory of the directory where you unzip the binary
+ distribution. Other binary distributions might use other
+ directories, although include/libxml2 is the canonical place where
+ libxml2 headers are installed on Posix platforms.
+
+ You will also need to install the libiconv "development" tarball,
+ because the libiconv headers need to be available to the compiler
+ when you compile with libxml2 support. A MinGW port of libiconv can
+ be found on the MinGW site:
+
+ http://sourceforge.net/projects/mingw/files/MinGW/Base/libiconv/
+
+ You need the libiconv-X.Y.Z-N-mingw32-dev.tar.lzma tarball from that
+ site.
+
* Experimental SVG support
SVG support is currently experimental, and not built by default.
* Trouble-shooting
The main problems that are likely to be encountered when building
- Emacs stem from using an old version of GCC, or old MinGW or W32 API
+ Emacs stem from using an old version of GCC, or old MinGW or Windows API
headers. Additionally, Cygwin ports of GNU make may require the Emacs
source tree to be mounted with text!=binary, because the makefiles
generated by configure.bat necessarily use DOS line endings. Also,
2.95 or later is needed, because that is when the Windows port gained
sufficient support for anonymous structs and unions to cope with some
definitions from winnt.h that are used by addsection.c.
- Older versions of the W32 API headers that come with Cygwin and MinGW
+ Older versions of the Windows API headers that come with Cygwin and MinGW
may be missing some definitions required by Emacs, or broken in other
ways. In particular, uniscribe APIs were added to MinGW CVS only on
2006-03-26, so releases from before then cannot be used.
You can get pre-built binaries (including any required DLL and the
header files) at http://sourceforge.net/projects/ezwinports/files/.
+* libxml2 support
+
+ In order to support libxml2 at runtime, a libxml2-enabled Emacs must
+ be able to find the relevant DLLs during startup; failure to do so
+ is not an error, but libxml2 features won't be available to the
+ running session.
+
+ You can get pre-built binaries (including any required DLL and the
+ header files) at http://sourceforge.net/projects/ezwinports/files/.
+
* Uninstalling Emacs
If you should need to uninstall Emacs, simply delete all the files
-/* GNU Emacs site configuration template file. -*- C -*-
+/* 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.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+/* NOTE:
+ 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 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. */
-/* No code in Emacs #includes config.h twice, but some of the code
+/* No code in Emacs #includes config.h twice, but some bits of code
intended to work with other packages as well (like gmalloc.c)
think they can include it as many times as they like. */
#ifndef EMACS_CONFIG_H
#define EMACS_CONFIG_H
-/* These are all defined in the top-level Makefile by configure.
- They're here only for reference. */
-/* Define LISP_FLOAT_TYPE if you want emacs to support floating-point
- numbers. */
-#undef LISP_FLOAT_TYPE
+/* Define if building universal (internal helper macro) */
+#undef AC_APPLE_UNIVERSAL_BUILD
-/* Define GNU_MALLOC if you want to use the GNU memory allocator. */
-#define GNU_MALLOC
+/* Define to use the convention that & in the full name stands for the login
+ id. */
+#undef AMPERSAND_FULL_NAME
-/* Define if you are using the GNU C Library. */
-#undef DOUG_LEA_MALLOC
+/* Define to the number of bits in type 'ptrdiff_t'. */
+#undef BITSIZEOF_PTRDIFF_T
-/* Define REL_ALLOC if you want to use the relocating allocator for
- buffer space. */
-#define REL_ALLOC
+/* Define to the number of bits in type 'sig_atomic_t'. */
+#undef BITSIZEOF_SIG_ATOMIC_T
-/* Enable conservative stack marking for GC. */
-#define GC_MARK_STACK 1
+/* Define to the number of bits in type 'size_t'. */
+#undef BITSIZEOF_SIZE_T
-/* MSVC ignores the "register" keyword, so test fails even though
- setjmp does work. */
-#define GC_SETJMP_WORKS 1
+/* Define to the number of bits in type 'wchar_t'. */
+#undef BITSIZEOF_WCHAR_T
-/* Define HAVE_X_WINDOWS if you want to use the X window system. */
-#undef HAVE_X_WINDOWS
+/* Define to the number of bits in type 'wint_t'. */
+#undef BITSIZEOF_WINT_T
-/* Define HAVE_X11 if you want to use version 11 of X windows.
- Otherwise, Emacs expects to use version 10. */
-#undef HAVE_X11
+/* Define if getwd should not be used. */
+#undef BROKEN_GETWD
-/* Define if using an X toolkit. */
-#undef USE_X_TOOLKIT
+/* Define if get_current_dir_name should not be used. */
+#undef BROKEN_GET_CURRENT_DIR_NAME
-/* Define this if you're using XFree386. */
-#undef HAVE_XFREE386
+/* Define on FreeBSD to work around an issue when reading from a PTY. */
+#undef BROKEN_PTY_READ_AFTER_EAGAIN
-/* Define this if you have Motif 2.1 or newer. */
-#undef HAVE_MOTIF_2_1
+/* Define if the system is compatible with BSD 4.2. */
+#undef BSD4_2
-/* Define HAVE_MENUS if you have mouse menus.
- (This is automatic if you use X, but the option to specify it remains.)
- It is also defined with other window systems that support xmenu.c. */
-#undef HAVE_MENUS
+/* Define if the system is compatible with BSD 4.2. */
+#undef BSD_SYSTEM
-/* Define if we have the X11R6 or newer version of Xt. */
-#undef HAVE_X11XTR6
+/* Define if AH_BOTTOM should change BSD_SYSTEM. */
+#undef BSD_SYSTEM_AHB
-/* Define if we have the X11R6 or newer version of Xlib. */
-#undef HAVE_X11R6
+/* Define if Emacs cannot be dumped on your system. */
+#undef CANNOT_DUMP
-/* Define if netdb.h declares h_errno. */
-#undef HAVE_H_ERRNO
+/* Define this to enable compile time checks for the Lisp_Object data type. */
+#undef CHECK_LISP_OBJECT_TYPE
-/* If we're using any sort of window system, define some consequences. */
-#ifdef HAVE_X_WINDOWS
-#define HAVE_WINDOW_SYSTEM
-#define HAVE_MOUSE
-#endif
+/* Define if you want lock files to be written, so that Emacs can tell
+ instantly when you try to modify a file that someone else has modified in
+ his/her Emacs. */
+#undef CLASH_DETECTION
-/* Define USE_TEXT_PROPERTIES to support visual and other properties
- on text. */
-#define USE_TEXT_PROPERTIES
+/* Short copyright string for this version of Emacs. */
+#define COPYRIGHT "Copyright (C) 2012 Free Software Foundation, Inc."
-/* Define USER_FULL_NAME to return a string
- that is the user's full name.
- It can assume that the variable `pw'
- points to the password file entry for this user.
+/* Define to one of '_getb67', 'GETB67', 'getb67' for Cray-2 and Cray-YMP
+ systems. This function is required for 'alloca.c' support on those systems.
+ */
+#undef CRAY_STACKSEG_END
- At some sites, the pw_gecos field contains
- the user's full name. If neither this nor any other
- field contains the right thing, use pw_name,
- giving the user's login name, since that is better than nothing. */
-#define USER_FULL_NAME pw->pw_gecos
+/* Define if the system is Cygwin. */
+#undef CYGWIN
-/* Define AMPERSAND_FULL_NAME if you use the convention
- that & in the full name stands for the login id. */
-#undef AMPERSAND_FULL_NAME
+/* Define to 1 if using 'alloca.c'. */
+#undef C_ALLOCA
-/* Things set by --with options in the configure script. */
+/* Define if the system is Darwin. */
+#undef DARWIN_OS
-/* Define to support POP mail retrieval. */
-#undef MAIL_USE_POP
+/* Extra bits to be or'd in with any pointers stored in a Lisp_Object. */
+#undef DATA_SEG_BITS
-/* Define to support Kerberos-authenticated POP mail retrieval. */
-#undef KERBEROS
-/* Define to use Kerberos 5 instead of Kerberos 4 */
-#undef KERBEROS5
-/* Define to support GSS-API in addition to (or instead of) Kerberos */
-#undef GSSAPI
+/* Address of the start of the data segment. */
+#undef DATA_START
-/* Define to support using a Hesiod database to find the POP server. */
-#undef HESIOD
+/* Name of the default sound device. */
+#undef DEFAULT_SOUND_DEVICE
-/* Some things figured out by the configure script, grouped as they are in
- configure.in. */
-#ifndef _ALL_SOURCE /* suppress warning if this is pre-defined */
-#undef _ALL_SOURCE
-#endif
-#undef HAVE_SYS_SELECT_H
-#undef HAVE_SYS_TIMEB_H
-#undef HAVE_SYS_TIME_H
-#undef HAVE_UNISTD_H
-#undef HAVE_UTIME_H
-#undef HAVE_LINUX_VERSION_H
-#undef HAVE_SYS_SYSTEMINFO_H
-#undef HAVE_TERMIOS_H
-#undef HAVE_STRINGS_H
-#undef HAVE_PWD_H
+/* Character that separates a device in a file name. */
+#define DEVICE_SEP ':'
-#undef HAVE_LIBDNET
-#undef HAVE_LIBPTHREADS
-#undef HAVE_LIBRESOLV
-#undef HAVE_LIBXMU
-#undef HAVE_LIBNCURSES
-#undef HAVE_LIBINTL
+/* Define to 1 for DGUX with <sys/dg_sys_info.h>. */
+#undef DGUX
-/* movemail Kerberos support */
-/* libraries */
-#undef HAVE_LIBKRB
-#undef HAVE_LIBKRB4
-#undef HAVE_LIBDES
-#undef HAVE_LIBDES425
-#undef HAVE_LIBKRB5
-#undef HAVE_LIBCRYPTO
-#undef HAVE_LIBCOM_ERR
-/* header files */
-#undef HAVE_KRB5_H
-#undef HAVE_DES_H
-#undef HAVE_KRB_H
-#undef HAVE_KERBEROSIV_DES_H
-#undef HAVE_KERBEROSIV_KRB_H
-#undef HAVE_KERBEROS_DES_H
-#undef HAVE_KERBEROS_KRB_H
-#undef HAVE_COM_ERR_H
+/* Character that separates directories in a file name. */
+#define DIRECTORY_SEP '/'
-/* GSS-API libraries and headers */
-#undef HAVE_LIBGSSAPI_KRB5
-#undef HAVE_LIBGSSAPI
-#undef HAVE_GSSAPI_H
+/* Define if dispnew.c should include stdio_ext.h. */
+#undef DISPNEW_NEEDS_STDIO_EXT
-/* Mail-file locking */
-#undef HAVE_LIBMAIL
-#undef HAVE_MAILLOCK_H
-#undef HAVE_TOUCHLOCK
+/* 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
-#undef HAVE_ALLOCA_H
+/* Define if the system is MS DOS or MS Windows. */
+#define DOS_NT
-#undef HAVE_GETTIMEOFDAY
-/* If we don't have gettimeofday,
- the test for GETTIMEOFDAY_ONE_ARGUMENT may succeed,
- but we should ignore it. */
-#ifdef HAVE_GETTIMEOFDAY
-#undef GETTIMEOFDAY_ONE_ARGUMENT
-#endif
-#undef HAVE_GETHOSTNAME
-#undef HAVE_GETDOMAINNAME
-#undef HAVE_DUP2
-#undef HAVE_RENAME
-#undef HAVE_CLOSEDIR
+/* Define to 1 if you are using the GNU C Library. */
+#undef DOUG_LEA_MALLOC
-#undef TM_IN_SYS_TIME
-#undef HAVE_TM_ZONE
+/* Define to the canonical Emacs configuration name. */
+#undef EMACS_CONFIGURATION
-/* Define to 1 if you don't have `tm_zone' but do have the external array
- `tzname'. */
-#define HAVE_TZNAME 1
+/* Define to the options passed to configure. */
+#undef EMACS_CONFIG_OPTIONS
-/* Define to 1 if you have the declaration of `tzname', and to 0 if you don't.
+/* Define to 1 if expensive run-time data type and consistency checks are
+ enabled. */
+#undef ENABLE_CHECKING
+
+/* Letter to use in finding device name of first PTY, if PTYs are supported.
*/
-#define HAVE_DECL_TZNAME 1
+#define FIRST_PTY_LETTER 'a'
-#undef const
+/* Enable compile-time and run-time bounds-checking, and some warnings,
+ without upsetting glibc 2.15+. */
+ #if defined __OPTIMIZE__ && __OPTIMIZE__
+ # define _FORTIFY_SOURCE 2
+ #endif
-#undef HAVE_LONG_FILE_NAMES
-#undef CRAY_STACKSEG_END
+/* Define to 1 if futimesat mishandles a NULL file name. */
+#undef FUTIMESAT_NULL_BUG
-#undef HAVE_LIBXBSD
-#undef HAVE_XRMSETDATABASE
-#undef HAVE_XSCREENRESOURCESTRING
-#undef HAVE_XSCREENNUMBEROFSCREEN
-#undef HAVE_XSETWMPROTOCOLS
+/* Define this to check for errors in cons list. */
+#undef GC_CHECK_CONS_LIST
-#undef HAVE_MKDIR
-#undef HAVE_RMDIR
-#undef HAVE_SYSINFO
-#undef HAVE_RANDOM
-#undef HAVE_LRAND48
-#undef HAVE_MEMCPY
-#undef HAVE_MEMMOVE
-#undef HAVE_MEMSET
-#undef HAVE_MEMCMP
-#undef HAVE_LOGB
-#undef HAVE_FREXP
-#undef HAVE_FMOD
-#undef HAVE_RINT
-#undef HAVE_CBRT
-#undef HAVE_FTIME
-#undef HAVE_RES_INIT /* For -lresolv on Suns. */
-#undef HAVE_SETSID
-#undef HAVE_FPATHCONF
-#undef HAVE_SELECT
-#undef HAVE_EUIDACCESS
-#undef HAVE_GETPAGESIZE
-#undef HAVE_GET_CURRENT_DIR_NAME
-#undef HAVE_TZSET
-#undef HAVE_SETLOCALE
-#undef HAVE_UTIMES
-#undef HAVE_SETRLIMIT
-#undef HAVE_SETPGID
-/* If you think about defining HAVE_GETCWD, don't: the alternative
- getwd is redefined on w32.c, and does not really return the current
- directory, to get the desired results elsewhere in Emacs */
-#undef HAVE_GETCWD
-#undef HAVE_SHUTDOWN
-#undef HAVE_STRFTIME
-/* Standard Windows strftime does not support POSIX.2 extensions. */
-#define STRFTIME_NO_POSIX2 1
+/* Define this temporarily to hunt a bug. If defined, the size of strings is
+ redundantly recorded in sdata structures so that it can be compared to the
+ sizes recorded in Lisp strings. */
+#undef GC_CHECK_STRING_BYTES
-#define HAVE_SENDTO 1
-#define HAVE_RECVFROM 1
-#define HAVE_GETSOCKOPT 1
-#define HAVE_SETSOCKOPT 1
-#define HAVE_GETSOCKNAME 1
-#define HAVE_GETPEERNAME 1
-#define HAVE_SNPRINTF 1
-#define HAVE_LANGINFO_CODESET 1
-/* Local (unix) sockets are not supported. */
-#undef HAVE_SYS_UN_H
+/* Define this to check the string free list. */
+#undef GC_CHECK_STRING_FREE_LIST
-#define LOCALTIME_CACHE
-#undef HAVE_INET_SOCKETS
+/* Define this to check for short string overrun. */
+#undef GC_CHECK_STRING_OVERRUN
-#undef HAVE_AIX_SMT_EXP
+/* Mark a secondary stack, like the register stack on the ia64. */
+#undef GC_MARK_SECONDARY_STACK
-/* Define if you have the ANSI `strerror' function.
- Otherwise you must have the variable `char *sys_errlist[]'. */
-#undef HAVE_STRERROR
+/* Define to GC_USE_GCPROS_AS_BEFORE if conservative garbage collection is not
+ known to work. */
+#define GC_MARK_STACK 1
-/* Define if `sys_siglist' is declared by <signal.h>. */
-#undef SYS_SIGLIST_DECLARED
+/* Define if setjmp is known to save all registers relevant for conservative
+ garbage collection in the jmp_buf.
+ MSVC ignores the "register" keyword, so test fails even though
+ setjmp does work. */
+#define GC_SETJMP_WORKS 1
-/* Define if `struct utimbuf' is declared by <utime.h>. */
-#undef HAVE_STRUCT_UTIMBUF
+/* Define to 1 if the `getpgrp' function requires zero arguments. */
+#undef GETPGRP_VOID
-/* Define if `struct timeval' is declared by <sys/time.h>. */
-#undef HAVE_TIMEVAL
+/* Define if gettimeofday clobbers the localtime buffer. */
+#undef GETTIMEOFDAY_CLOBBERS_LOCALTIME
-/* Define to 1 if you have the <getopt.h> header file. */
-#undef HAVE_GETOPT_H
+/* Define this to 'void' or 'struct timezone' to match the system's
+ declaration of the second argument to gettimeofday. */
+#undef GETTIMEOFDAY_TIMEZONE
-/* Define to 1 if you have the `getopt_long_only' function. */
-#undef HAVE_GETOPT_LONG_ONLY
+/* Define this to enable glyphs debugging code. */
+/* #undef GLYPH_DEBUG */
-/* Preprocessor macros needed for gnulib imports. */
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module fscanf shall be considered present. */
+#undef GNULIB_FSCANF
-/* Define to 1 if GCC-style __attribute__ ((__aligned__ (expr))) works. */
-#ifdef __GNUC__
-#define HAVE_ATTRIBUTE_ALIGNED 1
-#else
-#undef HAVE_ATTRIBUTE_ALIGNED
-#endif
+/* enable some gnulib portability checks */
+#undef GNULIB_PORTCHECK
+
+/* Define to a C preprocessor expression that evaluates to 1 or 0, depending
+ whether the gnulib module scanf shall be considered present. */
+#undef GNULIB_SCANF
+
+/* Define if ths system is compatible with GNU/Linux. */
+#undef GNU_LINUX
+
+/* Define to 1 if you want to use the GNU memory allocator. */
+#define GNU_MALLOC 1
+
+/* Define to set the G_SLICE environment variable to "always-malloc" at
+ startup, if using GTK. */
+#undef G_SLICE_ALWAYS_MALLOC
+
+/* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */
+#undef HAVE_AIX_SMT_EXP
+
+/* Define to 1 if you have the `alarm' function. */
+#undef HAVE_ALARM
+
+/* Define to 1 if you have 'alloca' after including <alloca.h>, a header that
+ may be supplied by this distribution. */
+#undef HAVE_ALLOCA
+
+/* Define to 1 if you have <alloca.h> and it should be used (not on Ultrix).
+ */
+#undef HAVE_ALLOCA_H
+
+/* Define to 1 if ALSA is available. */
+#undef HAVE_ALSA
/* Define to 1 if strtold conforms to C99. */
-#ifdef __GNUC__
-#define HAVE_C99_STRTOLD 1
-#else
#undef HAVE_C99_STRTOLD
-#endif
+
+/* Define to 1 if you have the `cfmakeraw' function. */
+#undef HAVE_CFMAKERAW
+
+/* Define to 1 if you have the `cfsetspeed' function. */
+#undef HAVE_CFSETSPEED
+
+/* Define to 1 if you have the `clock_gettime' function. */
+#undef HAVE_CLOCK_GETTIME
+
+/* Define to 1 if you have the `clock_settime' function. */
+#undef HAVE_CLOCK_SETTIME
+
+/* Define to 1 if you have the `closedir' function. */
+#define HAVE_CLOSEDIR 1
+
+/* Define to 1 if you have the <coff.h> header file. */
+#undef HAVE_COFF_H
+
+/* Define to 1 if you have the <com_err.h> header file. */
+#undef HAVE_COM_ERR_H
+
+/* Define to 1 if you have the `copysign' function. */
+#undef HAVE_COPYSIGN
+
+/* Define to 1 if using D-Bus. */
+#undef HAVE_DBUS
+
+/* Define to 1 if you have the `dbus_type_is_valid' function. */
+#undef HAVE_DBUS_TYPE_IS_VALID
+
+/* Define to 1 if you have the `dbus_validate_bus_name' function. */
+#undef HAVE_DBUS_VALIDATE_BUS_NAME
+
+/* Define to 1 if you have the `dbus_validate_interface' function. */
+#undef HAVE_DBUS_VALIDATE_INTERFACE
+
+/* Define to 1 if you have the `dbus_validate_member' function. */
+#undef HAVE_DBUS_VALIDATE_MEMBER
+
+/* Define to 1 if you have the `dbus_validate_path' function. */
+#undef HAVE_DBUS_VALIDATE_PATH
+
+/* Define to 1 if you have the `dbus_watch_get_unix_fd' function. */
+#undef HAVE_DBUS_WATCH_GET_UNIX_FD
/* Define to 1 if you have the declaration of `getenv', and to 0 if you don't.
*/
don't. */
#undef HAVE_DECL_LOCALTIME_R
-/* Define to 1 if you have the `localtime_r' function. */
-#undef HAVE_LOCALTIME_R
+/* Define to 1 if you have the declaration of `strmode', and to 0 if you
+ don't. */
+#undef HAVE_DECL_STRMODE
+
+/* Define to 1 if you have the declaration of `strtoimax', and to 0 if you
+ don't. */
+#undef HAVE_DECL_STRTOIMAX
/* Define to 1 if you have the declaration of `strtoll', and to 0 if you
don't. */
don't. */
#define HAVE_DECL_STRTOUMAX 1
-/* Define to 1 if you have the `strtoull' function. */
-#define HAVE_STRTOULL 1
+/* Define to 1 if you have the declaration of `sys_siglist', and to 0 if you
+ don't. */
+#undef HAVE_DECL_SYS_SIGLIST
-/* Define to 1 if you have the `strtoumax' function. */
-#define HAVE_STRTOUMAX 1
+/* Define to 1 if you have the declaration of `tzname', and to 0 if you don't.
+ */
+#define HAVE_DECL_TZNAME 1
-/* Define if you have the 'wchar_t' type. */
-#define HAVE_WCHAR_T 1
+/* Define to 1 if you have the declaration of `__sys_siglist', and to 0 if you
+ don't. */
+#undef HAVE_DECL___SYS_SIGLIST
-/* Name of package */
-#define PACKAGE "emacs"
+/* Define to 1 if you have the <des.h> header file. */
+#undef HAVE_DES_H
-/* Version number of package */
-#define VERSION "24.2"
+/* Define to 1 if dynamic ptys are supported. */
+#undef HAVE_DEV_PTMX
-/* Define to `__inline__' or `__inline' if that's what the C compiler
- calls it, or to nothing if 'inline' is not supported under any name. */
-#ifdef __GNUC__
-#ifndef __cplusplus
-#undef inline
-#endif
-#else /* MSVC */
-#define inline __inline
-#endif
+/* Define to 1 if you have the `difftime' function. */
+#undef HAVE_DIFFTIME
-/* Define to the equivalent of the C99 'restrict' keyword, or to
- nothing if this is not supported. Do not define if restrict is
- supported directly. */
-#ifdef __GNUC__
-# define restrict __restrict__
-#else
-# define restrict
-#endif
+/* Define to 1 if you have the <dirent.h> header file. */
+#undef HAVE_DIRENT_H
-/* `mode_t' is not defined for MSVC. Define. */
-#ifdef _MSC_VER
-typedef unsigned short mode_t;
-#endif
+/* Define to 1 if you have the 'dup2' function. */
+#define HAVE_DUP2 1
-/* A va_copy replacement for MSVC. */
-#ifdef _MSC_VER
-# ifdef _WIN64
-# ifndef va_copy /* Need to be checked (?) */
-# define va_copy(d,s) ((d) = (s))
-# endif
-# else /* not _WIN64 */
-# define va_copy(d,s) ((d) = (s))
-# endif /* not _WIN64 */
-#endif /* _MSC_VER */
+/* Define to 1 if you have the `endgrent' function. */
+#undef HAVE_ENDGRENT
-/* Define as a marker that can be attached to declarations that might not
- be used. This helps to reduce warnings, such as from
- GCC -Wunused-parameter. */
-#if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define _GL_UNUSED __attribute__ ((__unused__))
-#else
-# define _GL_UNUSED
-#endif
-/* The name _UNUSED_PARAMETER_ is an earlier spelling, although the name
- is a misnomer outside of parameter lists. */
-#define _UNUSED_PARAMETER_ _GL_UNUSED
+/* Define to 1 if you have the `endpwent' function. */
+#undef HAVE_ENDPWENT
-/* End of gnulib-related stuff. */
+/* Define if you have the declaration of environ. */
+#undef HAVE_ENVIRON_DECL
-#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
-#define NO_INLINE __attribute__((noinline))
-#else
-#define NO_INLINE
-#endif
+/* Define to 1 if you have the `euidaccess' function. */
+#undef HAVE_EUIDACCESS
-#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1))
-#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
-#else
-#define EXTERNALLY_VISIBLE
-#endif
+/* Define to 1 if you have the <execinfo.h> header file. */
+#define HAVE_EXECINFO_H 1
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define ATTRIBUTE_FORMAT(spec) /* empty */
-#endif
+/* Define to 1 if you have the <fcntl.h> header file. */
+#undef HAVE_FCNTL_H
-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
-#else
-# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
-#endif
+/* Define to 1 if you have the `fork' function. */
+#undef HAVE_FORK
-#if (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 8))
-#define HAVE___BUILTIN_UNWIND_INIT 1
-#endif
+/* Define to 1 if you have the `fpathconf' function. */
+#undef HAVE_FPATHCONF
-#undef EMACS_CONFIGURATION
+/* Define to 1 if you have the `freeifaddrs' function. */
+#undef HAVE_FREEIFADDRS
-#undef EMACS_CONFIG_OPTIONS
+/* Define to 1 if using the freetype and fontconfig libraries. */
+#undef HAVE_FREETYPE
-/* The configuration script defines opsysfile to be the name of the
- s/SYSTEM.h file that describes the system type you are using. The file
- is chosen based on the configuration name you give.
+/* Define to 1 if fseeko (and presumably ftello) exists and is declared. */
+#undef HAVE_FSEEKO
- See the file ../etc/MACHINES for a list of systems and the
- configuration names to use for them.
+/* Define to 1 if you have the `fsync' function. */
+#define HAVE_FSYNC 1
- See s/template.h for documentation on writing s/SYSTEM.h files. */
-#undef config_opsysfile
-#include "s/ms-w32.h"
+/* Define to 1 if you have the `futimens' function. */
+#undef HAVE_FUTIMENS
-/* The configuration script defines machfile to be the name of the
- m/MACHINE.h file that describes the machine you are using. The file is
- chosen based on the configuration name you give.
+/* Define to 1 if you have the `futimes' function. */
+#undef HAVE_FUTIMES
- See the file ../etc/MACHINES for a list of machines and the
- configuration names to use for them.
+/* Define to 1 if you have the `futimesat' function. */
+#undef HAVE_FUTIMESAT
- See m/template.h for documentation on writing m/MACHINE.h files. */
-#undef config_machfile
-#include "m/intel386.h"
+/* Define to 1 if you have the `gai_strerror' function. */
+#undef HAVE_GAI_STRERROR
-/* Define `subprocesses' should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- Only MSDOS does not support this. */
+/* Define to 1 if using GConf. */
+#undef HAVE_GCONF
-#define subprocesses
+/* Define to 1 if you have the `getaddrinfo' function. */
+#undef HAVE_GETADDRINFO
-/* Define STACK_DIRECTION here, but not if m/foo.h did. */
-#ifndef STACK_DIRECTION
-#undef STACK_DIRECTION
-#endif
+/* Define to 1 if you have the `getcwd' function.
+ If you think about defining HAVE_GETCWD, don't: the alternative
+ getwd is redefined on w32.c, and does not really return the current
+ directory, to get the desired results elsewhere in Emacs. */
+#undef HAVE_GETCWD
-#ifdef emacs /* Don't do this for lib-src. */
-/* Tell regex.c to use a type compatible with Emacs. */
-#define RE_TRANSLATE_TYPE Lisp_Object
-#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C)
-#define RE_TRANSLATE_P(TBL) (XFASTINT (TBL) != 0)
-#endif
+/* Define to 1 if you have the `getdelim' function. */
+#undef HAVE_GETDELIM
-#define my_strftime nstrftime /* for strftime.c */
+/* Define to 1 if you have the `getgrent' function. */
+#undef HAVE_GETGRENT
-/* Define to the type of st_nlink in struct stat, or a supertype. */
-#define nlink_t short
+/* Define to 1 if you have the `gethostname' function. */
+#define HAVE_GETHOSTNAME 1
-#ifndef WINDOWSNT
-/* Some of the files of Emacs which are intended for use with other
- programs assume that if you have a config.h file, you must declare
- the type of getenv. */
-extern char *getenv ();
-#endif
+/* Define to 1 if you have the `getifaddrs' function. */
+#undef HAVE_GETIFADDRS
-#endif /* EMACS_CONFIG_H */
+/* Define to 1 if you have the `getline' function. */
+#undef HAVE_GETLINE
-/* These default definitions are good for almost all machines.
- The exceptions override them in m/MACHINE.h. */
+/* Define to 1 if you have the <getopt.h> header file. */
+#undef HAVE_GETOPT_H
-#ifndef BITS_PER_CHAR
-#define BITS_PER_CHAR 8
-#endif
+/* Define to 1 if you have the `getopt_long_only' function. */
+#undef HAVE_GETOPT_LONG_ONLY
-#ifndef BITS_PER_SHORT
-#define BITS_PER_SHORT 16
-#endif
+/* Define to 1 if you have the `getpagesize' function. */
+#define HAVE_GETPAGESIZE 1
-/* Note that lisp.h uses this in a preprocessor conditional, so it
- would not work to use sizeof. That being so, we do all of them
- without sizeof, for uniformity's sake. */
-#ifndef BITS_PER_INT
-#define BITS_PER_INT 32
-#endif
+/* Define to 1 if you have the `getpeername' function. */
+#define HAVE_GETPEERNAME 1
-#ifndef BITS_PER_LONG
-#define BITS_PER_LONG 32
-#endif
+/* Define to 1 if you have the `getpt' function. */
+#undef HAVE_GETPT
-#if defined (__MINGW32__) || _MSC_VER >= 1400
+/* Define to 1 if you have the `getpwent' function. */
+#undef HAVE_GETPWENT
-/* Define to 1 if the system has the type `long long int'. */
-# define HAVE_LONG_LONG_INT 1
+/* Define to 1 if you have the `getrlimit' function. */
+#undef HAVE_GETRLIMIT
-/* Define to 1 if the system has the type `unsigned long long int'. */
-# define HAVE_UNSIGNED_LONG_LONG_INT 1
+/* Define to 1 if you have the `getrusage' function. */
+#undef HAVE_GETRUSAGE
-#elif _MSC_VER >= 1200
+/* Define to 1 if you have the `getsockname' function. */
+#define HAVE_GETSOCKNAME 1
-/* Temporarily disable wider-than-pointer integers until they're tested more.
- Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */
-/* #undef WIDE_EMACS_INT */
+/* Define to 1 if you have the `gettimeofday' function. */
+#define HAVE_GETTIMEOFDAY 1
-# ifdef WIDE_EMACS_INT
+/* Define to 1 if you have the `getwd' function. */
+#undef HAVE_GETWD
-/* Use pre-C99-style 64-bit integers. */
-# define EMACS_INT __int64
-# define BITS_PER_EMACS_INT 64
-# define pI "I64"
+/* Define to 1 if you have the `get_current_dir_name' function. */
+#undef HAVE_GET_CURRENT_DIR_NAME
-# endif
+/* Define to 1 if you have a gif (or ungif) library. */
+#undef HAVE_GIF
-#endif
+/* Define if using GnuTLS. */
+#undef HAVE_GNUTLS
-#ifndef POINTER_TYPE
-#define POINTER_TYPE void
-#endif
+/* Define if using GnuTLS certificate verification callbacks. */
+#undef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
-#ifndef PROTOTYPES
-#define PROTOTYPES 1
-#endif
+/* Define to 1 if you have the `gnutls_certificate_set_verify_function'
+ function. */
+#undef HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION
-#include "string.h"
-#ifdef HAVE_STRINGS_H
-#include "strings.h"
-#endif
-#include <stdlib.h>
+/* Define to 1 if you have the gpm library (-lgpm). */
+#undef HAVE_GPM
-#ifndef NO_RETURN
-#if defined __GNUC__ && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR >= 5))
-#define NO_RETURN __attribute__ ((__noreturn__))
-#else
-#define NO_RETURN /* nothing */
-#endif
-#endif
+/* Define to 1 if you have the `grantpt' function. */
+#undef HAVE_GRANTPT
-/* Redefine abort. */
-#ifdef HAVE_NTGUI
-#define abort w32_abort
-void w32_abort (void) NO_RETURN;
-#endif
+/* Define to 1 if using GSettings. */
+#undef HAVE_GSETTINGS
+
+/* Define to 1 if using GTK 3 or later. */
+#undef HAVE_GTK3
+
+/* Define to 1 if you have the `gtk_adjustment_get_page_size' function. */
+#undef HAVE_GTK_ADJUSTMENT_GET_PAGE_SIZE
+
+/* Define to 1 if you have the `gtk_dialog_get_action_area' function. */
+#undef HAVE_GTK_DIALOG_GET_ACTION_AREA
+
+/* Define to 1 if you have the `gtk_file_selection_new' function. */
+#undef HAVE_GTK_FILE_SELECTION_NEW
+
+/* Define to 1 if you have the `gtk_main' function. */
+#undef HAVE_GTK_MAIN
+
+/* Define to 1 if you have the `gtk_orientable_set_orientation' function. */
+#undef HAVE_GTK_ORIENTABLE_SET_ORIENTATION
+
+/* Define to 1 if you have the `gtk_widget_get_mapped' function. */
+#undef HAVE_GTK_WIDGET_GET_MAPPED
+
+/* Define to 1 if you have the `gtk_widget_get_sensitive' function. */
+#undef HAVE_GTK_WIDGET_GET_SENSITIVE
+
+/* Define to 1 if you have the `gtk_widget_get_window' function. */
+#undef HAVE_GTK_WIDGET_GET_WINDOW
+
+/* Define to 1 if you have the `gtk_widget_set_has_window' function. */
+#undef HAVE_GTK_WIDGET_SET_HAS_WINDOW
+
+/* Define to 1 if you have the `gtk_window_set_has_resize_grip' function. */
+#undef HAVE_GTK_WINDOW_SET_HAS_RESIZE_GRIP
+
+/* Define to 1 if you have the `g_type_init' function. */
+#undef HAVE_G_TYPE_INIT
+
+/* Define to 1 if netdb.h declares h_errno. */
+#define HAVE_H_ERRNO 1
+
+/* Define to 1 if you have the <ifaddrs.h> header file. */
+#undef HAVE_IFADDRS_H
+
+/* Define to 1 if using imagemagick. */
+#undef HAVE_IMAGEMAGICK
+
+/* Define to 1 if you have inet sockets. */
+#define HAVE_INET_SOCKETS 1
+
+/* Define to 1 if you have the <inttypes.h> header file. */
+#undef HAVE_INTTYPES_H
+
+/* Define to 1 if you have the jpeg library (-ljpeg). */
+#undef HAVE_JPEG
+
+/* Define to 1 if you have the <kerberosIV/des.h> header file. */
+#undef HAVE_KERBEROSIV_DES_H
+
+/* Define to 1 if you have the <kerberosIV/krb.h> header file. */
+#undef HAVE_KERBEROSIV_KRB_H
+
+/* Define to 1 if you have the <kerberos/des.h> header file. */
+#undef HAVE_KERBEROS_DES_H
+
+/* Define to 1 if you have the <kerberos/krb.h> header file. */
+#undef HAVE_KERBEROS_KRB_H
+
+/* Define to 1 if `e_text' is a member of `krb5_error'. */
+#undef HAVE_KRB5_ERROR_E_TEXT
+
+/* Define to 1 if `text' is a member of `krb5_error'. */
+#undef HAVE_KRB5_ERROR_TEXT
+
+/* Define to 1 if you have the <krb5.h> header file. */
+#undef HAVE_KRB5_H
+
+/* Define to 1 if you have the <krb.h> header file. */
+#undef HAVE_KRB_H
+
+/* Define if you have <langinfo.h> and nl_langinfo(CODESET). */
+#define HAVE_LANGINFO_CODESET 1
+
+/* Define to 1 if you have the `com_err' library (-lcom_err). */
+#undef HAVE_LIBCOM_ERR
+
+/* Define to 1 if you have the `crypto' library (-lcrypto). */
+#undef HAVE_LIBCRYPTO
+
+/* Define to 1 if you have the `des' library (-ldes). */
+#undef HAVE_LIBDES
+
+/* Define to 1 if you have the `des425' library (-ldes425). */
+#undef HAVE_LIBDES425
+
+/* Define to 1 if you have the `dgc' library (-ldgc). */
+#undef HAVE_LIBDGC
+
+/* Define to 1 if you have the `dnet' library (-ldnet). */
+#undef HAVE_LIBDNET
+
+/* Define to 1 if you have the hesiod library (-lhesiod). */
+#undef HAVE_LIBHESIOD
-/* Prevent accidental use of features unavailable in
- older Windows versions we still support. */
-#define _WIN32_WINNT 0x0400
+/* Define to 1 if you have the `k5crypto' library (-lk5crypto). */
+#undef HAVE_LIBK5CRYPTO
+
+/* Define to 1 if you have the `krb' library (-lkrb). */
+#undef HAVE_LIBKRB
+
+/* Define to 1 if you have the `krb4' library (-lkrb4). */
+#undef HAVE_LIBKRB4
+
+/* Define to 1 if you have the `krb5' library (-lkrb5). */
+#undef HAVE_LIBKRB5
+
+/* Define to 1 if you have the `kstat' library (-lkstat). */
+#undef HAVE_LIBKSTAT
+
+/* Define to 1 if you have the `lockfile' library (-llockfile). */
+#undef HAVE_LIBLOCKFILE
+
+/* Define to 1 if you have the `m' library (-lm). */
+#undef HAVE_LIBM
+
+/* Define to 1 if you have the `mail' library (-lmail). */
+#undef HAVE_LIBMAIL
+
+/* Define to 1 if using libotf. */
+#undef HAVE_LIBOTF
+
+/* Define to 1 if you have the `perfstat' library (-lperfstat). */
+#undef HAVE_LIBPERFSTAT
+
+/* Define to 1 if you have the <libpng/png.h> header file. */
+#undef HAVE_LIBPNG_PNG_H
+
+/* Define to 1 if you have the `pthreads' library (-lpthreads). */
+#undef HAVE_LIBPTHREADS
+
+/* Define to 1 if you have the resolv library (-lresolv). */
+#undef HAVE_LIBRESOLV
+
+/* Define to 1 if using SELinux. */
+#undef HAVE_LIBSELINUX
+
+/* Define to 1 if you have the `Xext' library (-lXext). */
+#undef HAVE_LIBXEXT
+
+/* Define to 1 if you have the libxml library (-lxml2). */
+#undef HAVE_LIBXML2
+
+/* Define to 1 if you have the `Xmu' library (-lXmu). */
+#undef HAVE_LIBXMU
+
+/* Define to 1 if you have the <linux/version.h> header file. */
+#undef HAVE_LINUX_VERSION_H
+
+/* Define to 1 if you have the `localtime_r' function. */
+#undef HAVE_LOCALTIME_R
+
+/* Define to 1 if you support file names longer than 14 characters. */
+#define HAVE_LONG_FILE_NAMES 1
+
+/* Define to 1 if the system has the type 'long long int'. */
+#undef HAVE_LONG_LONG_INT
+
+/* Define to 1 if you have the `lrand48' function. */
+#undef HAVE_LRAND48
+
+/* Define to 1 if you have the `lstat' function. */
+#undef HAVE_LSTAT
+
+/* Define to 1 if you have the `lutimes' function. */
+#undef HAVE_LUTIMES
+
+/* Define to 1 if using libm17n-flt. */
+#undef HAVE_M17N_FLT
+
+/* Define to 1 if you have the <machine/soundcard.h> header file. */
+#undef HAVE_MACHINE_SOUNDCARD_H
+
+/* Define to 1 if you have the <mach/mach.h> header file. */
+#undef HAVE_MACH_MACH_H
+
+/* Define to 1 if you have the `MagickExportImagePixels' function. */
+#undef HAVE_MAGICKEXPORTIMAGEPIXELS
+
+/* Define to 1 if you have the `MagickMergeImageLayers' function. */
+#undef HAVE_MAGICKMERGEIMAGELAYERS
+
+/* Define to 1 if you have the <maillock.h> header file. */
+#undef HAVE_MAILLOCK_H
+
+/* Define to 1 if you have the <malloc/malloc.h> header file. */
+#undef HAVE_MALLOC_MALLOC_H
+
+/* Define to 1 if <wchar.h> declares mbstate_t. */
+#undef HAVE_MBSTATE_T
+
+/* Define to 1 if you have the <memory.h> header file. */
+#undef HAVE_MEMORY_H
+
+/* Define to 1 if you have mouse menus. (This is automatic if you use X, but
+ the option to specify it remains.) It is also defined with other window
+ systems that support xmenu.c. */
+#undef HAVE_MENUS
+
+/* Define to 1 if you have the `mkstemp' function. */
+#undef HAVE_MKSTEMP
+
+/* Define to 1 if you have a working `mmap' system call. */
+#undef HAVE_MMAP
+
+/* Define if you have mouse support. */
+#define HAVE_MOUSE 1
+
+/* Define to 1 if you have the `nanotime' function. */
+#undef HAVE_NANOTIME
+
+/* Define to 1 if you have the <net/if_dl.h> header file. */
+#undef HAVE_NET_IF_DL_H
+
+/* Define to 1 if you have the <net/if.h> header file. */
+#undef HAVE_NET_IF_H
+
+/* Define to 1 if you have the <nlist.h> header file. */
+#undef HAVE_NLIST_H
+
+/* Define to 1 if you are using the NeXTstep API, either GNUstep or Cocoa on
+ Mac OS X. */
+#undef HAVE_NS
+
+/* Define to 1 if libotf has OTF_get_variation_glyphs. */
+#undef HAVE_OTF_GET_VARIATION_GLYPHS
+
+/* Define to 1 if personality LINUX32 can be set. */
+#undef HAVE_PERSONALITY_LINUX32
+
+/* Define to 1 if you have the png library (-lpng). */
+#undef HAVE_PNG
+
+/* Define to 1 if you have the <png.h> header file. */
+#undef HAVE_PNG_H
+
+/* Define to 1 if you have the `posix_memalign' function. */
+#undef HAVE_POSIX_MEMALIGN
+
+/* Define to 1 if you have the `posix_openpt' function. */
+#undef HAVE_POSIX_OPENPT
+
+/* Define if you have the /proc filesystem. */
+#undef HAVE_PROCFS
+
+/* Define to 1 if you have the `pselect' function. */
+#undef HAVE_PSELECT
+
+/* Define to 1 if you have the `pstat_getdynamic' function. */
+#undef HAVE_PSTAT_GETDYNAMIC
+
+/* Define to 1 if you have pthread (-lpthread). */
+#undef HAVE_PTHREAD
+
+/* Define to 1 if you have the <pthread.h> header file. */
+#undef HAVE_PTHREAD_H
+
+/* Define to 1 if the pthread_sigmask function can be used (despite bugs). */
+#undef HAVE_PTHREAD_SIGMASK
+
+/* Define if the system supports pty devices. */
+#undef HAVE_PTYS
+
+/* Define to 1 if you have the <pty.h> header file. */
+#undef HAVE_PTY_H
+
+/* Define to 1 if you have the <pwd.h> header file. */
+#define HAVE_PWD_H 1
+
+/* Define to 1 if you have the `random' function. */
+#define HAVE_RANDOM 1
+
+/* Define to 1 if you have the `readlink' function. */
+#undef HAVE_READLINK
+
+/* Define to 1 if you have the `readlinkat' function. */
+#undef HAVE_READLINKAT
+
+/* Define to 1 if you have the `recvfrom' function. */
+#define HAVE_RECVFROM 1
+
+/* Define to 1 if res_init is available. */
+#undef HAVE_RES_INIT
+
+/* Define to 1 if you have the `rint' function. */
+#undef HAVE_RINT
+
+/* Define to 1 if using librsvg. */
+#undef HAVE_RSVG
+
+/* Define to 1 if you have the `select' function. */
+#define HAVE_SELECT 1
+
+/* Define to 1 if you have the `sendto' function. */
+#define HAVE_SENDTO 1
+
+/* Define to 1 if you have the `setitimer' function. */
+#undef HAVE_SETITIMER
+
+/* Define to 1 if you have the `setlocale' function. */
+#define HAVE_SETLOCALE 1
+
+/* Define to 1 if you have the `setpgid' function. */
+#undef HAVE_SETPGID
+
+/* Define to 1 if you have the `setrlimit' function. */
+#undef HAVE_SETRLIMIT
+
+/* Define to 1 if you have the `setsid' function. */
+#undef HAVE_SETSID
+
+/* Define to 1 if you have the `shutdown' function. */
+#define HAVE_SHUTDOWN 1
+
+/* Define to 1 if 'sig_atomic_t' is a signed integer type. */
+#undef HAVE_SIGNED_SIG_ATOMIC_T
+
+/* Define to 1 if 'wchar_t' is a signed integer type. */
+#undef HAVE_SIGNED_WCHAR_T
+
+/* Define to 1 if 'wint_t' is a signed integer type. */
+#undef HAVE_SIGNED_WINT_T
+
+/* Define to 1 if sigsetjmp and siglongjmp work. The value of this symbol is
+ irrelevant if HAVE__SETJMP is defined. */
+#undef HAVE_SIGSETJMP
+
+/* Define to 1 if the system has the type `sigset_t'. */
+#undef HAVE_SIGSET_T
+
+/* Define to 1 if you have the `snprintf' function. */
+#define HAVE_SNPRINTF 1
+
+/* Define if the system supports 4.2-compatible sockets.
+ NT supports Winsock which is close enough (with some hacks). */
+#define HAVE_SOCKETS 1
+
+/* Define to 1 if you have sound support. */
+#define HAVE_SOUND 1
+
+/* Define to 1 if you have the <soundcard.h> header file. */
+#undef HAVE_SOUNDCARD_H
+
+/* Define to 1 if `speed_t' is declared by <termios.h>. */
+#undef HAVE_SPEED_T
+
+/* Define to 1 if you have the <stdint.h> header file. */
+#undef HAVE_STDINT_H
+
+/* Define to 1 if you have the <stdio_ext.h> header file. */
+#undef HAVE_STDIO_EXT_H
+
+/* Define to 1 if you have the <stdlib.h> header file. */
+#undef HAVE_STDLIB_H
+
+/* Define to 1 if you have the <strings.h> header file. */
+#undef HAVE_STRINGS_H
+
+/* Define to 1 if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* Define to 1 if you have the `strsignal' function. */
+#undef HAVE_STRSIGNAL
+
+/* Define to 1 if you have the `strtoimax' function. */
+#undef HAVE_STRTOIMAX
+
+/* Define to 1 if you have the `strtoll' function. */
+#undef HAVE_STRTOLL
+
+/* Define to 1 if you have the `strtoull' function. */
+#define HAVE_STRTOULL 1
+
+/* Define to 1 if you have the `strtoumax' function. */
+#define HAVE_STRTOUMAX 1
+
+/* Define to 1 if `ifr_addr' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_ADDR
+
+/* Define to 1 if `ifr_addr.sa_len' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
+
+/* Define to 1 if `ifr_broadaddr' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_BROADADDR
+
+/* Define to 1 if `ifr_flags' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_FLAGS
+
+/* Define to 1 if `ifr_hwaddr' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_HWADDR
+
+/* Define to 1 if `ifr_netmask' is a member of `struct ifreq'. */
+#undef HAVE_STRUCT_IFREQ_IFR_NETMASK
+
+/* Define to 1 if `n_un.n_name' is a member of `struct nlist'. */
+#undef HAVE_STRUCT_NLIST_N_UN_N_NAME
+
+/* Define to 1 if `st_atimensec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIMENSEC
+
+/* Define to 1 if `st_atimespec.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC
+
+/* Define to 1 if `st_atim.st__tim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC
+
+/* Define to 1 if `st_atim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
+
+/* Define to 1 if `st_birthtimensec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
+
+/* Define to 1 if `st_birthtimespec.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
+
+/* Define to 1 if `st_birthtim.tv_nsec' is a member of `struct stat'. */
+#undef HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC
+
+/* Define to 1 if `tm_zone' is a member of `struct tm'. */
+#undef HAVE_STRUCT_TM_TM_ZONE
+
+/* Define if struct utimbuf is declared -- usually in <utime.h>. Some systems
+ have utime.h but don't declare the struct anywhere. */
+#undef HAVE_STRUCT_UTIMBUF
+
+/* Define if struct stat has an st_dm_mode member. */
+#undef HAVE_ST_DM_MODE
+
+/* Define to 1 if you have the `symlink' function. */
+#undef HAVE_SYMLINK
+
+/* Define to 1 if you have the `sync' function. */
+#undef HAVE_SYNC
+
+/* Define to 1 if you have the <sys/bitypes.h> header file. */
+#undef HAVE_SYS_BITYPES_H
+
+/* Define to 1 if you have the <sys/inttypes.h> header file. */
+#undef HAVE_SYS_INTTYPES_H
+
+/* Define to 1 if you have the <sys/loadavg.h> header file. */
+#undef HAVE_SYS_LOADAVG_H
+
+/* Define to 1 if you have the <sys/param.h> header file. */
+#undef HAVE_SYS_PARAM_H
+
+/* Define to 1 if you have the <sys/resource.h> header file. */
+#undef HAVE_SYS_RESOURCE_H
+
+/* Define to 1 if you have the <sys/select.h> header file. */
+#undef HAVE_SYS_SELECT_H
+
+/* Define to 1 if you have the <sys/socket.h> header file. */
+#undef HAVE_SYS_SOCKET_H
+
+/* Define to 1 if you have the <sys/soundcard.h> header file. */
+#undef HAVE_SYS_SOUNDCARD_H
+
+/* Define to 1 if you have the <sys/stat.h> header file. */
+#undef HAVE_SYS_STAT_H
+
+/* Define to 1 if you have the <sys/systeminfo.h> header file. */
+#undef HAVE_SYS_SYSTEMINFO_H
+
+/* Define to 1 if you have the <sys/timeb.h> header file. */
+#define HAVE_SYS_TIMEB_H 1
+
+/* Define to 1 if you have the <sys/time.h> header file. */
+#define HAVE_SYS_TIME_H 1
+
+/* Define to 1 if you have the <sys/types.h> header file. */
+#undef HAVE_SYS_TYPES_H
+
+/* Define to 1 if you have the <sys/un.h> header file. */
+#undef HAVE_SYS_UN_H
+
+/* Define to 1 if you have the <sys/utsname.h> header file. */
+#undef HAVE_SYS_UTSNAME_H
+
+/* Define to 1 if you have the <sys/vlimit.h> header file. */
+#undef HAVE_SYS_VLIMIT_H
+
+/* Define to 1 if you have <sys/wait.h> that is POSIX.1 compatible. */
+#undef HAVE_SYS_WAIT_H
+
+/* Define to 1 if you have the <term.h> header file. */
+#undef HAVE_TERM_H
+
+/* Define to 1 if you have the tiff library (-ltiff). */
+#undef HAVE_TIFF
+
+/* Define if struct tm has the tm_gmtoff member. */
+#undef HAVE_TM_GMTOFF
+
+/* Define to 1 if your `struct tm' has `tm_zone'. Deprecated, use
+ `HAVE_STRUCT_TM_TM_ZONE' instead. */
+#undef HAVE_TM_ZONE
+
+/* Define to 1 if you have the `touchlock' function. */
+#undef HAVE_TOUCHLOCK
+
+/* Define to 1 if you don't have `tm_zone' but do have the external array
+ `tzname'. */
+#define HAVE_TZNAME 1
+
+/* Define to 1 if you have the `tzset' function. */
+#define HAVE_TZSET 1
+
+/* Define to 1 if you have the <unistd.h> header file. */
+#define HAVE_UNISTD_H 1
+
+/* Define to 1 if the system has the type 'unsigned long long int'. */
+#undef HAVE_UNSIGNED_LONG_LONG_INT
+
+/* Define to 1 if you have the <util.h> header file. */
+#undef HAVE_UTIL_H
+
+/* Define to 1 if you have the `utimensat' function. */
+#undef HAVE_UTIMENSAT
+
+/* Define to 1 if you have the `utimes' function. */
+#undef HAVE_UTIMES
+
+/* Define to 1 if you have the <utime.h> header file. */
+#undef HAVE_UTIME_H
+
+/* Define to 1 if you have the <utmp.h> header file. */
+#undef HAVE_UTMP_H
+
+/* Define to 1 if you have the `vfork' function. */
+#undef HAVE_VFORK
+
+/* Define to 1 if you have the <vfork.h> header file. */
+#undef HAVE_VFORK_H
+
+/* Define to 1 if you have the <wchar.h> header file. */
+#undef HAVE_WCHAR_H
+
+/* Define if you have the 'wchar_t' type. */
+#define HAVE_WCHAR_T 1
+
+/* Define if you have a window system. */
+#undef HAVE_WINDOW_SYSTEM
+
+/* Define to 1 if you have the <winsock2.h> header file. */
+#undef HAVE_WINSOCK2_H
+
+/* Define to 1 if `fork' works. */
+#undef HAVE_WORKING_FORK
+
+/* Define if utimes works properly. */
+#undef HAVE_WORKING_UTIMES
+
+/* Define to 1 if `vfork' works. */
+#undef HAVE_WORKING_VFORK
+
+/* Define to 1 if you have the <ws2tcpip.h> header file. */
+#undef HAVE_WS2TCPIP_H
+
+/* Define to 1 if you want to use version 11 of X windows. Otherwise, Emacs
+ expects to use version 10. */
+#undef HAVE_X11
+
+/* Define to 1 if you have the X11R6 or newer version of Xlib. */
+#undef HAVE_X11R6
+
+/* Define if you have usable X11R6-style XIM support. */
+#undef HAVE_X11R6_XIM
+
+/* Define to 1 if you have the X11R6 or newer version of Xt. */
+#undef HAVE_X11XTR6
+
+/* Define to 1 if you have the Xaw3d library (-lXaw3d). */
+#undef HAVE_XAW3D
+
+/* Define to 1 if you have the Xft library. */
+#undef HAVE_XFT
+
+/* Define to 1 if XIM is available */
+#undef HAVE_XIM
+
+/* Define to 1 if you have the XkbGetKeyboard function. */
+#undef HAVE_XKBGETKEYBOARD
+
+/* Define to 1 if you have the Xpm library (-lXpm). */
+#undef HAVE_XPM
+
+/* Define to 1 if you have the `XrmSetDatabase' function. */
+#undef HAVE_XRMSETDATABASE
+
+/* Define to 1 if you have the `XScreenNumberOfScreen' function. */
+#undef HAVE_XSCREENNUMBEROFSCREEN
+
+/* Define to 1 if you have the `XScreenResourceString' function. */
+#undef HAVE_XSCREENRESOURCESTRING
+
+/* Define if you have usable i18n support. */
+#undef HAVE_X_I18N
+
+/* Define to 1 if you have the SM library (-lSM). */
+#undef HAVE_X_SM
+
+/* Define to 1 if you want to use the X window system. */
+#undef HAVE_X_WINDOWS
+
+/* Define to 1 if the system has the type `_Bool'. */
+#undef HAVE__BOOL
+
+/* Define to 1 if you have the `_ftime' function. */
+#undef HAVE__FTIME
+
+/* Define to 1 if _setjmp and _longjmp work. */
+#define HAVE__SETJMP 1
+
+/* Define to 1 if you have the `__builtin_unwind_init' function. */
+#undef HAVE___BUILTIN_UNWIND_INIT
+
+/* Define to 1 if you have the `__executable_start' function. */
+#undef HAVE___EXECUTABLE_START
+
+/* Define to 1 if you have the `__fpending' function. */
+#undef HAVE___FPENDING
+
+/* Define to support using a Hesiod database to find the POP server. */
+#undef HESIOD
+
+/* 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
+
+/* Define to use Kerberos 5 instead of Kerberos 4. */
+#undef KERBEROS5
+
+/* Define to 1 if localtime caches TZ. */
+#define LOCALTIME_CACHE 1
+
+/* Define to 1 if 'lstat' dereferences a symlink specified with a trailing
+ slash. */
+#undef LSTAT_FOLLOWS_SLASHED_SYMLINK
+
+/* String giving fallback POP mail host. */
+#undef MAILHOST
+
+/* Define to unlink, rather than empty, mail spool after reading. */
+#undef MAIL_UNLINK_SPOOL
+
+/* Define if the mailer uses flock to interlock the mail spool. */
+#undef MAIL_USE_FLOCK
+
+/* Define if the mailer uses lockf to interlock the mail spool. */
+#undef MAIL_USE_LOCKF
+
+/* Define to support MMDF mailboxes in movemail. */
+#undef MAIL_USE_MMDF
+
+/* 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
+
+/* Define if XEditRes should not be used. */
+#undef NO_EDITRES
+
+/* Define to 1 if your C compiler doesn't accept -c and -o together. */
+#undef NO_MINUS_C_MINUS_O
+
+/* Minimum value of NSIG. */
+#undef NSIG_MINIMUM
+
+/* Define to 1 if `NSInteger' is defined. */
+#undef NS_HAVE_NSINTEGER
+
+/* Define to 1 if you are using NS windowing under MacOS X. */
+#undef NS_IMPL_COCOA
+
+/* Define to 1 if you are using NS windowing under GNUstep. */
+#undef NS_IMPL_GNUSTEP
+
+/* Name of the file to open to get a null file, or a data sink. */
+#define NULL_DEVICE "NUL:"
+
+/* Define to 1 if the nlist n_name member is a pointer */
+#undef N_NAME_POINTER
+
+/* Define if the C compiler is the linker. */
+#define ORDINARY_LINK 1
+
+/* Name of package */
+#define PACKAGE "emacs"
+
+/* Define to the address where bug reports for this package should be sent. */
+#undef PACKAGE_BUGREPORT
+
+/* Define to the full name of this package. */
+#undef PACKAGE_NAME
+
+/* Define to the full name and version of this package. */
+#undef PACKAGE_STRING
+
+/* Define to the one symbol short name of this package. */
+#undef PACKAGE_TARNAME
+
+/* Define to the home page for this package. */
+#undef PACKAGE_URL
+
+/* Define to the version of this package. */
+#undef PACKAGE_VERSION
+
+/* Number of chars of output in the buffer of a stdio stream. */
+#undef PENDING_OUTPUT_COUNT
+
+/* Define to empty to suppress deprecation warnings when building with
+ --enable-gcc-warnings and with libpng versions before 1.5, which lack
+ png_longjmp. */
+#undef PNG_DEPSTRUCT
+
+/* Define if process_send_signal should use VSUSP instead of VSWTCH. */
+#undef PREFER_VSUSP
+
+/* Define to 1 if pthread_sigmask(), when it fails, returns -1 and sets errno.
+ */
+#undef PTHREAD_SIGMASK_FAILS_WITH_ERRNO
+
+/* Define to 1 if pthread_sigmask() may returns 0 and have no effect. */
+#undef PTHREAD_SIGMASK_INEFFECTIVE
+
+/* Define to 1 if pthread_sigmask() unblocks signals incorrectly. */
+#undef PTHREAD_SIGMASK_UNBLOCK_BUG
+
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'ptrdiff_t'. */
+#undef PTRDIFF_T_SUFFIX
+
+/* How to iterate over PTYs. */
+#undef PTY_ITERATION
+
+/* How to get the device name of the control end of a PTY, if non-standard. */
+#undef PTY_NAME_SPRINTF
+
+/* How to open a PTY, if non-standard. */
+#undef PTY_OPEN
+
+/* How to get device name of the tty end of a PTY, if non-standard. */
+#undef PTY_TTY_NAME_SPRINTF
+
+/* Define to 1 if readlink fails to recognize a trailing slash. */
+#undef READLINK_TRAILING_SLASH_BUG
+
+/* Define REL_ALLOC if you want to use the relocating allocator for buffer
+ space. */
+#define REL_ALLOC 1
+
+/* Define to 1 if stat needs help when passed a directory name with a trailing
+ slash */
+#undef REPLACE_FUNC_STAT_DIR
+
+/* Define to 1 if stat needs help when passed a file name with a trailing
+ slash */
+#undef REPLACE_FUNC_STAT_FILE
+
+/* Define if emacs.c needs to call run_time_remap; for HPUX. */
+#undef RUN_TIME_REMAP
+
+/* Character that separates PATH elements. */
+#define SEPCHAR ';'
+
+/* Define if process.c:child_setup should not call setpgrp. */
+#undef SETPGRP_RELEASES_CTTY
+
+/* How to set up a slave PTY, if needed. */
+#undef SETUP_SLAVE_PTY
+
+/* Make process_send_signal work by "typing" a signal character on the pty. */
+#undef SIGNALS_VIA_CHARACTERS
+
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'sig_atomic_t'. */
+#undef SIG_ATOMIC_T_SUFFIX
+
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'size_t'. */
+#undef SIZE_T_SUFFIX
+
+/* Define if the system is Solaris. */
+#undef SOLARIS2
+
+/* If using the C implementation of alloca, define if you know the
+ direction of stack growth for your system; otherwise it will be
+ automatically deduced at runtime.
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown */
+#undef STACK_DIRECTION
+
+/* Define to 1 if the `S_IS*' macros in <sys/stat.h> do not work properly. */
+#undef STAT_MACROS_BROKEN
+
+/* Define to 1 if you have the ANSI C header files. */
+#undef STDC_HEADERS
+
+/* Define to 1 on System V Release 4. */
+#undef SVR4
+
+/* Define to use system malloc. */
+#undef SYSTEM_MALLOC
+
+/* The type of system you are compiling for; sets `system-type'. */
+#define SYSTEM_TYPE "windows-nt"
+
+/* Undocumented. */
+#undef TAB3
+
+/* Undocumented. */
+#undef TABDLY
+
+/* Define to 1 if you use terminfo instead of termcap. */
+#undef TERMINFO
+
+/* Define to the header for the built-in window system. */
+#undef TERM_HEADER
+
+/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
+#define TIME_WITH_SYS_TIME 1
+
+/* Some platforms redefine this. */
+#undef TIOCSIGSEND
+
+/* Define to 1 if your <sys/time.h> declares `struct tm'. */
+#undef TM_IN_SYS_TIME
+
+/* Define to 1 if the type of the st_atim member of a struct stat is struct
+ timespec. */
+#undef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC
+
+/* Undocumented. */
+#undef ULIMIT_BREAK_VALUE
+
+/* Define to 1 for Encore UMAX. */
+#undef UMAX
+
+/* Define to 1 for Encore UMAX 4.3 that has <inq_status/cpustats.h> instead of
+ <sys/cpustats.h>. */
+#undef UMAX4_3
+
+/* Define if the system has Unix98 PTYs. */
+#undef UNIX98_PTYS
+
+/* Define to 1 if FIONREAD is usable. */
+#define USABLE_FIONREAD 1
+
+/* Define to 1 if SIGIO is usable. */
+#undef USABLE_SIGIO
+
+/* How to get a user's full name. */
+#define USER_FULL_NAME pw->pw_gecos
+
+/* Define to 1 if using GTK. */
+#undef USE_GTK
+
+/* Define to 1 if using the Lucid X toolkit. */
+#undef USE_LUCID
+
+/* Define to use mmap to allocate buffer text. */
+#undef USE_MMAP_FOR_BUFFERS
+
+/* Define to 1 if using the Motif X toolkit. */
+#undef USE_MOTIF
+
+/* Define to 1 if we should use toolkit scroll bars. */
+#define USE_TOOLKIT_SCROLL_BARS 1
+
+/* Define to 1 if we should use XIM, if it is available. */
+#undef USE_XIM
+
+/* Define to 1 if using an X toolkit. */
+#undef USE_X_TOOLKIT
+
+/* Define if the system is compatible with System III. */
+#undef USG
+
+/* Define if the system is compatible with System V. */
+#undef USG5
+
+/* Define if the system is compatible with System V Release 4. */
+#undef USG5_4
+
+/* Define for USG systems where it works to open a pty's tty in the parent
+ process, then close and reopen it in the child. */
+#undef USG_SUBTTY_WORKS
+
+/* Version number of package */
+#define VERSION "24.2.50"
+
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'wchar_t'. */
+#undef WCHAR_T_SUFFIX
+
+/* Use long long for EMACS_INT if available. */
+/* #undef WIDE_EMACS_INT */
+
+/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type
+ 'wint_t'. */
+#undef WINT_T_SUFFIX
+
+/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
+ significant byte first (like Motorola and SPARC, unlike Intel). */
+#if defined AC_APPLE_UNIVERSAL_BUILD
+# if defined __BIG_ENDIAN__
+# define WORDS_BIGENDIAN 1
+# endif
+#else
+# ifndef WORDS_BIGENDIAN
+# undef WORDS_BIGENDIAN
+# endif
+#endif
+
+/* Define this to check for malloc buffer overrun. */
+#undef XMALLOC_OVERRUN_CHECK
+
+/* Compensate for a bug in Xos.h on some systems, where it requires time.h. */
+#undef XOS_NEEDS_TIME_H
+
+/* Define to the type of the 6th arg of XRegisterIMInstantiateCallback, either
+ XPointer or XPointer*. */
+#undef XRegisterIMInstantiateCallback_arg6
+
+/* Define if the system is AIX. */
+#undef _AIX
+
+/* Enable large inode numbers on Mac OS X. */
+#ifndef _DARWIN_USE_64_BIT_INODE
+# define _DARWIN_USE_64_BIT_INODE 1
+#endif
+
+/* Number of bits in a file offset, on hosts where this is settable. */
+#undef _FILE_OFFSET_BITS
+
+/* Define to 1 if Gnulib overrides 'struct stat' on Windows so that struct
+ stat.st_size becomes 64-bit. */
+#undef _GL_WINDOWS_64_BIT_ST_SIZE
+
+/* Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2). */
+#undef _LARGEFILE_SOURCE
+
+/* Define for large files, on AIX-style hosts. */
+#undef _LARGE_FILES
+
+/* Define to 1 if on MINIX. */
+#undef _MINIX
+
+/* Define if GNUstep uses ObjC exceptions. */
+#undef _NATIVE_OBJC_EXCEPTIONS
+
+/* The _Noreturn keyword of C11. */
+#if ! (defined _Noreturn \
+ || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__))
+# if (3 <= __GNUC__ || (__GNUC__ == 2 && 8 <= __GNUC_MINOR__))
+# define _Noreturn __attribute__ ((__noreturn__))
+# elif defined _MSC_VER && 1200 <= _MSC_VER
+# define _Noreturn __declspec (noreturn)
+# else
+# define _Noreturn
+# endif
+#endif
+
+
+/* Define to 2 if the system does not provide POSIX.1 features except with
+ this defined. */
+#undef _POSIX_1_SOURCE
+
+/* Define to 1 if you need to in order for 'stat' and other things to work. */
+#undef _POSIX_SOURCE
+
+/* Needed for system_process_attributes on Solaris. */
+#undef _STRUCTURED_PROC
+
+/* Define to 500 only on HP-UX. */
+#undef _XOPEN_SOURCE
+
+/* Enable extensions on AIX 3, Interix. */
+#ifndef _ALL_SOURCE
+# undef _ALL_SOURCE
+#endif
+/* Enable general extensions on Mac OS X. */
+#ifndef _DARWIN_C_SOURCE
+# undef _DARWIN_C_SOURCE
+#endif
+/* Enable GNU extensions on systems that have them. */
+#ifndef _GNU_SOURCE
+# undef _GNU_SOURCE
+#endif
+/* Enable threading extensions on Solaris. */
+#ifndef _POSIX_PTHREAD_SEMANTICS
+# undef _POSIX_PTHREAD_SEMANTICS
+#endif
+/* Enable extensions on HP NonStop. */
+#ifndef _TANDEM_SOURCE
+# undef _TANDEM_SOURCE
+#endif
+/* Enable general extensions on Solaris. */
+#ifndef __EXTENSIONS__
+# undef __EXTENSIONS__
+#endif
+
+
+/* Define to rpl_ if the getopt replacement functions and variables should be
+ used. */
+#undef __GETOPT_PREFIX
+
+/* Define to compiler's equivalent of C99 restrict keyword in array
+ declarations. Define as empty for no equivalent. */
+#undef __restrict_arr
+
+/* Some platforms that do not use configure define this to include extra
+ configuration information. */
+#define config_opsysfile <ms-w32.h>
+
+/* _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
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>.
+ _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
+#elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__)
+# if __GNUC_GNU_INLINE__
+ /* __gnu_inline__ suppresses a GCC 4.2 diagnostic. */
+# define _GL_INLINE extern inline __attribute__ ((__gnu_inline__))
+# else
+# define _GL_INLINE extern inline
+# endif
+# define _GL_EXTERN_INLINE extern
+#else
+# define _GL_INLINE static inline
+# define _GL_EXTERN_INLINE static inline
+#endif
+
+#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
+# if __GNUC_STDC_INLINE__
+# define _GL_INLINE_HEADER_CONST_PRAGMA
+# else
+# define _GL_INLINE_HEADER_CONST_PRAGMA \
+ _Pragma ("GCC diagnostic ignored \"-Wsuggest-attribute=const\"")
+# endif
+# define _GL_INLINE_HEADER_BEGIN \
+ _Pragma ("GCC diagnostic push") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \
+ _Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") \
+ _GL_INLINE_HEADER_CONST_PRAGMA
+# define _GL_INLINE_HEADER_END \
+ _Pragma ("GCC diagnostic pop")
+#else
+# 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))
+
+/* Define to rpl_gmtime if the replacement function should be used. */
+#undef gmtime
+
+/* Define to `__inline__' or `__inline' if that's what the C compiler
+ calls it, or to nothing if 'inline' is not supported under any name. */
+#ifndef __cplusplus
+#undef inline
+#endif
+
+/* Work around a bug in Apple GCC 4.0.1 build 5465: In C99 mode, it supports
+ the ISO C 99 semantics of 'extern inline' (unlike the GNU C semantics of
+ earlier versions), but does not display it by setting __GNUC_STDC_INLINE__.
+ __APPLE__ && __MACH__ test for Mac OS X.
+ __APPLE_CC__ tests for the Apple compiler and its version.
+ __STDC_VERSION__ tests for the C99 mode. */
+#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__
+# define __GNUC_STDC_INLINE__ 1
+#endif
+
+/* Define to 1 if the compiler is checking for lint. */
+#undef lint
+
+/* Define to rpl_localtime if the replacement function should be used. */
+#undef localtime
+
+/* Define to a type if <wchar.h> does not define. */
+#undef mbstate_t
+
+/* Define to `int' if <sys/types.h> does not define. */
+#undef mode_t
+
+/* Define to the name of the strftime replacement function. */
+#define my_strftime nstrftime
+
+/* Define to the type of st_nlink in struct stat, or a supertype. */
+#define nlink_t short
+
+/* Define to `int' if <sys/types.h> does not define. */
+#undef pid_t
+
+/* Define to the equivalent of the C99 'restrict' keyword, or to
+ nothing if this is not supported. Do not define if restrict is
+ supported directly. */
+#undef restrict
+/* Work around a bug in Sun C++: it does not support _Restrict or
+ __restrict__, even though the corresponding Sun C compiler ends up with
+ "#define restrict _Restrict" or "#define restrict __restrict__" in the
+ previous line. Perhaps some future version of Sun C++ will work with
+ restrict; if so, hopefully it defines __RESTRICT like Sun C does. */
+#if defined __SUNPRO_CC && !defined __RESTRICT
+# define _Restrict
+# define __restrict__
+#endif
+
+/* type to use in place of socklen_t if not defined */
+#undef socklen_t
+
+/* Define as a signed type of the same size as size_t. */
+#undef ssize_t
+
+/* Define to enable asynchronous subprocesses. */
+#define subprocesses
+
+/* Define to any substitute for sys_siglist. */
+#undef sys_siglist
+
+/* Define as a marker that can be attached to declarations that might not
+ be used. This helps to reduce warnings, such as from
+ GCC -Wunused-parameter. */
+#if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+# define _GL_UNUSED __attribute__ ((__unused__))
+#else
+# define _GL_UNUSED
+#endif
+/* The name _UNUSED_PARAMETER_ is an earlier spelling, although the name
+ is a misnomer outside of parameter lists. */
+#define _UNUSED_PARAMETER_ _GL_UNUSED
+
+/* The __pure__ attribute was added in gcc 2.96. */
+#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+#else
+# define _GL_ATTRIBUTE_PURE /* empty */
+#endif
+
+/* The __const__ attribute was added in gcc 2.95. */
+#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 95)
+# define _GL_ATTRIBUTE_CONST __attribute__ ((__const__))
+#else
+# define _GL_ATTRIBUTE_CONST /* empty */
+#endif
+
+
+/* Define as a macro for copying va_list variables. */
+#undef va_copy
+
+/* Define as `fork' if `vfork' does not work. */
+#undef vfork
+
+#include <conf_post.h>
+
+#endif /* EMACS_CONFIG_H */
-/* Make a leaner executable. */
-#define WIN32_LEAN_AND_MEAN 1
+/*
+Local Variables:
+mode: c
+End:
+*/
rem\r
rem + MS Windows 95, NT or later\r
rem + either MSVC 2.x or later, or gcc-2.95 or later (with GNU make 3.75\r
-rem or later) and the Mingw32 and W32 API headers and libraries.\r
+rem or later) and the Mingw32 and Windows API headers and libraries.\r
rem + Visual Studio 2005 is not supported at this time.\r
rem\r
rem For reference, here is a list of which builds of GNU make are known to\r
if "%1" == "--without-gif" goto withoutgif\r
if "%1" == "--without-tiff" goto withouttiff\r
if "%1" == "--without-gnutls" goto withoutgnutls\r
+if "%1" == "--without-libxml2" goto withoutlibxml2\r
if "%1" == "--without-xpm" goto withoutxpm\r
if "%1" == "--with-svg" goto withsvg\r
if "%1" == "--distfiles" goto distfiles\r
echo. --with-msvc use MSVC to compile Emacs\r
echo. --no-debug exclude debug info from executables\r
echo. --no-opt disable optimization\r
-echo. --enable-checking enable checks and assertions\r
+echo. --enable-checking enable additional run-time checks\r
echo. --profile enable profiling\r
echo. --no-cygwin use -mno-cygwin option with GCC\r
echo. --cflags FLAG pass FLAG to compiler\r
echo. --without-tiff do not use TIFF library even if it is installed\r
echo. --without-xpm do not use XPM library even if it is installed\r
echo. --without-gnutls do not use GnuTLS library even if it is installed\r
+echo. --without-libxml2 do not use libxml2 library even if it is installed\r
echo. --with-svg use the RSVG library (experimental)\r
echo. --distfiles path to files for make dist, e.g. libXpm.dll\r
if "%use_extensions%" == "0" goto end\r
\r
rem ----------------------------------------------------------------------\r
\r
+:withoutlibxml2\r
+set libxml2support=N\r
+set HAVE_LIBXML2=\r
+shift\r
+goto again\r
+\r
+rem ----------------------------------------------------------------------\r
+\r
:withouttiff\r
set tiffsupport=N\r
set HAVE_TIFF=\r
rem of w32api-xxx.zip from Anders Norlander since 1999-11-18 at least.\r
rem Beginning with Emacs 23, we need usp10.h.\r
rem\r
-echo Checking whether W32 API headers are too old...\r
+echo Checking whether Windows API headers are too old...\r
echo #include "windows.h" >junk.c\r
echo #include "usp10.h" >>junk.c\r
echo test(PIMAGE_NT_HEADERS pHeader) >>junk.c\r
echo.\r
echo Configure failed.\r
echo To configure Emacs for Windows, you need to have either\r
-echo gcc-2.95 or later with Mingw32 and the W32 API headers,\r
+echo gcc-2.95 or later with Mingw32 and the Windows API headers,\r
echo or MSVC 2.x or later.\r
del junk.c\r
goto end\r
:tlsDone\r
rm -f junk.c junk.obj\r
\r
+if (%libxml2support%) == (N) goto xml2Done\r
+\r
+echo Checking for libxml2....\r
+echo #include "libxml/HTMLparser.h" >junk.c\r
+echo main(){} >>junk.c\r
+echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log\r
+%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log\r
+if exist junk.obj goto havelibxml2\r
+\r
+echo ...libxml/HTMLparser.h not found, building without libxml2 support\r
+echo The failed program was: >>config.log\r
+type junk.c >>config.log\r
+set HAVE_LIBXML2=\r
+goto xml2Done\r
+\r
+:havelibxml2\r
+echo ...libxml2 header available, building with libxml2 support\r
+set HAVE_LIBXML2=1\r
+\r
+:xml2Done\r
+rm -f junk.c junk.obj\r
+\r
if (%jpegsupport%) == (N) goto jpegDone\r
\r
echo Checking for jpeg-6b...\r
if (%gifsupport%) == (N) goto gifDone\r
\r
echo Checking for libgif...\r
-echo #include "gif_lib.h" >junk.c\r
+rem giflib-5.0.0 needs size_t defined before gif_lib.h is included\r
+rem redirection characters need to be protected from the shell\r
+echo #include ^<stddef.h^> >junk.c\r
+echo #include "gif_lib.h" >>junk.c\r
echo main (){} >>junk.c\r
rem -o option is ignored with cl, but allows result to be consistent.\r
echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log\r
if not "(%dbginfo%)" == "()" >>config.settings echo DEBUG_INFO=%dbginfo%\r
if (%nodebug%) == (Y) >>config.settings echo NODEBUG=1\r
if (%noopt%) == (Y) >>config.settings echo NOOPT=1\r
-if (%enablechecking%) == (Y) >>config.settings echo ENABLECHECKS=1\r
if (%profile%) == (Y) >>config.settings echo PROFILE=1\r
if (%nocygwin%) == (Y) >>config.settings echo NOCYGWIN=1\r
if not "(%prefix%)" == "()" >>config.settings echo INSTALL_DIR=%prefix%\r
if (%docflags%) == (Y) echo #define USER_CFLAGS " %escusercflags%" >>config.tmp\r
if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %escuserldflags%" >>config.tmp\r
if (%profile%) == (Y) echo #define PROFILING 1 >>config.tmp\r
+if (%enablechecking%) == (Y) echo #define ENABLE_CHECKING 1 >>config.tmp\r
if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>config.tmp\r
if not "(%HAVE_GNUTLS%)" == "()" echo #define HAVE_GNUTLS 1 >>config.tmp\r
+if not "(%HAVE_LIBXML2%)" == "()" echo #define HAVE_LIBXML2 1 >>config.tmp\r
if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>config.tmp\r
if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>config.tmp\r
if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>config.tmp\r
set distFilesOk=\r
set pngsupport=\r
set tlssupport=\r
+set libxml2support=\r
set jpegsupport=\r
set gifsupport=\r
set tiffsupport=\r
set HAVE_TIFF=\r
set HAVE_XPM=\r
set dbginfo=\r
+endlocal\r
+set use_extensions=\r
\r
#endif
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 24,2,0,0
- PRODUCTVERSION 24,2,0,0
+ FILEVERSION 24,2,50,0
+ PRODUCTVERSION 24,2,50,0
FILEFLAGSMASK 0x3FL
#ifdef EMACSDEBUG
FILEFLAGS 0x1L
BEGIN
VALUE "CompanyName", "Free Software Foundation\0"
VALUE "FileDescription", "GNU Emacs: The extensible self-documenting text editor\0"
- VALUE "FileVersion", "24, 2, 0, 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, 2, 0, 0\0"
+ VALUE "ProductVersion", "24, 2, 50, 0\0"
VALUE "OLESelfRegister", "\0"
END
END
#endif
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 24,2,0,0
- PRODUCTVERSION 24,2,0,0
+ FILEVERSION 24,2,50,0
+ PRODUCTVERSION 24,2,50,0
FILEFLAGSMASK 0x3FL
#ifdef EMACSDEBUG
FILEFLAGS 0x1L
BEGIN
VALUE "CompanyName", "Free Software Foundation\0"
VALUE "FileDescription", "GNU EmacsClient: Client for the extensible self-documenting text editor\0"
- VALUE "FileVersion", "24, 2, 0, 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, 2, 0, 0\0"
+ VALUE "ProductVersion", "24, 2, 50, 0\0"
VALUE "OLESelfRegister", "\0"
END
END
OBJ2_c = $(patsubst $(BLD)%.$(O),$(CURDIR)%.c,$(OBJ2))
ifdef NOOPT
-DEBUG_CFLAGS = -DEMACSDEBUG
+DEBUG_CFLAGS = -DEMACSDEBUG -fno-crossjumping
else
DEBUG_CFLAGS =
endif
-ifdef ENABLECHECKS
-CHECKING_CFLAGS = -DENABLE_CHECKING -DXASSERTS -fno-crossjumping
-else
-CHECKING_CFLAGS =
-endif
-
MWINDOWS = -mwindows
-CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(PROFILE_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)
-ESC_CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(PROFILE_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS)
+CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(PROFILE_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)
+ESC_CFLAGS = -I. $(ARCH_CFLAGS) $(DEBUG_CFLAGS) $(PROFILE_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS)
EMACS_EXTRA_C_FLAGS = -DUSE_CRT_DLL=1
ifdef PROFILE
#ifndef WINDOWSNT
#define WINDOWSNT
#endif
-#ifndef DOS_NT
-#define DOS_NT /* MSDOS or WINDOWSNT */
+
+/* #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
convention must be whatever standard the libraries expect. */
#define _CALLBACK_ __cdecl
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "windows-nt"
-
-#define NO_MATHERR 1
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'a' means it is /dev/ptya0 */
-#define FIRST_PTY_LETTER 'a'
-
/* Define HAVE_TIMEVAL if the system supports the BSD style clock values.
Look in <sys/time.h> for a timeval structure. */
#define HAVE_TIMEVAL 1
-/* NT supports Winsock which is close enough (with some hacks). */
-#define HAVE_SOCKETS 1
-
/* But our select implementation doesn't allow us to make non-blocking
connects. So until that is fixed, this is necessary: */
#define BROKEN_NON_BLOCKING_CONNECT 1
for received packets, so datagrams are broken too. */
#define BROKEN_DATAGRAM_SOCKETS 1
-#define MAIL_USE_POP 1
#define MAIL_USE_SYSTEM_LOCK 1
-/* If the character used to separate elements of the executable path
- is not ':', #define this to be the appropriate character constant. */
-#define SEPCHAR ';'
+/* Define to 1 if GCC-style __attribute__ ((__aligned__ (expr))) works. */
+#ifdef __GNUC__
+#define HAVE_ATTRIBUTE_ALIGNED 1
+#endif
+
+/* Define to 1 if strtold conforms to C99. */
+#ifdef __GNUC__
+#define HAVE_C99_STRTOLD 1
+#endif
-#define ORDINARY_LINK 1
+#if (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 8))
+#define HAVE___BUILTIN_UNWIND_INIT 1
+#endif
/* ============================================================ */
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 ':'
+#ifdef __GNUC__
+#ifndef __cplusplus
+#undef inline
+#endif
+#else /* MSVC */
+#define inline __inline
+#endif
+
+#ifdef __GNUC__
+# define restrict __restrict__
+#else
+# define restrict
+#endif
-/* 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_))
+/* `mode_t' is not defined for MSVC. Define. */
+#ifdef _MSC_VER
+typedef unsigned short mode_t;
+#endif
+
+/* A va_copy replacement for MSVC. */
+#ifdef _MSC_VER
+# ifdef _WIN64
+# ifndef va_copy /* Need to be checked (?) */
+# define va_copy(d,s) ((d) = (s))
+# endif
+# else /* not _WIN64 */
+# define va_copy(d,s) ((d) = (s))
+# endif /* not _WIN64 */
+#endif /* _MSC_VER */
+
+#ifndef WINDOWSNT
+/* Some of the files of Emacs which are intended for use with other
+ programs assume that if you have a config.h file, you must declare
+ the type of getenv. */
+extern char *getenv ();
+#endif
+#ifdef HAVE_STRINGS_H
+#include "strings.h"
+#endif
#include <sys/types.h>
#ifdef _MSC_VER
struct sigaction {
int sa_flags;
- void (*sa_handler)(int);
+ void (_CALLBACK_ *sa_handler)(int);
sigset_t sa_mask;
};
#define SIG_BLOCK 1
#define SIG_SETMASK 2
#define SIG_UNBLOCK 3
-/* The null device on Windows NT. */
-#define NULL_DEVICE "NUL:"
-
#ifndef MAXPATHLEN
#define MAXPATHLEN _MAX_PATH
#endif
-#define HAVE_SOUND 1
-#define LISP_FLOAT_TYPE 1
-
-#define HAVE_SYS_TIMEB_H 1
-#define HAVE_SYS_TIME_H 1
-#define HAVE_UNISTD_H 1
-#undef HAVE_UTIME_H
-#undef HAVE_LINUX_VERSION_H
-#undef HAVE_SYS_SYSTEMINFO_H
-#define HAVE_PWD_H 1
-#define TIME_WITH_SYS_TIME 1
-
-#define HAVE_GETTIMEOFDAY 1
-#define HAVE_GETHOSTNAME 1
-#undef HAVE_GETDOMAINNAME
-#define HAVE_DUP2 1
-#define HAVE_RENAME 1
-#define HAVE_CLOSEDIR 1
-#define HAVE_FSYNC 1 /* fsync is called _commit in MSVC. */
-
-#undef TM_IN_SYS_TIME
-#undef HAVE_TM_ZONE
-
-#define HAVE_LONG_FILE_NAMES 1
-
-#define HAVE_MKDIR 1
-#define HAVE_RMDIR 1
-#define HAVE_RANDOM 1
-#undef HAVE_SYSINFO
-#undef HAVE_LRAND48
-#define HAVE_MEMCMP 1
-#define HAVE_MEMCPY 1
-#define HAVE_MEMMOVE 1
-#define HAVE_MEMSET 1
-#define HAVE_LOGB 1
-#define HAVE_FREXP 1
-#define HAVE_FMOD 1
-#undef HAVE_RINT
-#undef HAVE_CBRT
-#define HAVE_FTIME 1
-#undef HAVE_RES_INIT /* For -lresolv on Suns. */
-#undef HAVE_SETSID
-#undef HAVE_FPATHCONF
-#define HAVE_SELECT 1
-#undef HAVE_EUIDACCESS
-#define HAVE_GETPAGESIZE 1
-#define HAVE_TZSET 1
-#define HAVE_SETLOCALE 1
-#undef HAVE_UTIMES
-#undef HAVE_SETRLIMIT
-#undef HAVE_SETPGID
-/* If you think about defining HAVE_GETCWD, don't: the alternative
- getwd is redefined on w32.c, and does not really return the current
- directory, to get the desired results elsewhere in Emacs */
-#undef HAVE_GETCWD
-#define HAVE_SHUTDOWN 1
-
-#define LOCALTIME_CACHE
-#define HAVE_INET_SOCKETS 1
-
-#undef HAVE_AIX_SMT_EXP
-#define USE_TOOLKIT_SCROLL_BARS 1
-
-/* Define if you have the ANSI `strerror' function.
- Otherwise you must have the variable `char *sys_errlist[]'. */
-#define HAVE_STRERROR 1
-
-/* Define if `struct utimbuf' is declared by <utime.h>. */
-#undef HAVE_STRUCT_UTIMBUF
-
-#define HAVE_MOUSE 1
-#define HAVE_H_ERRNO 1
-
#ifdef HAVE_NTGUI
#define HAVE_WINDOW_SYSTEM 1
#define HAVE_MENUS 1
#define rename sys_rename
#define rmdir sys_rmdir
#define select sys_select
+#define pselect sys_select
#define sleep sys_sleep
#define strerror sys_strerror
#undef unlink
#define kill sys_kill
#define signal sys_signal
+/* Internal signals. */
+#define emacs_raise(sig) emacs_abort()
+
/* termcap.c calls that are emulated. */
#define tputs sys_tputs
#define tgetstr sys_tgetstr
#define utime _utime
#endif
+/* 'struct timespec' is used by time-related functions in lib/ and
+ elsewhere, but we don't use lib/time.h where the structure is
+ defined. */
+struct timespec
+{
+ time_t tv_sec; /* seconds */
+ long int tv_nsec; /* nanoseconds */
+};
+
/* This is hacky, but is necessary to avoid warnings about macro
redefinitions using the SDK compilers. */
#ifndef __STDC__
#define _WINSOCKAPI_ 1
#define _WINSOCK_H
+/* Prevent accidental use of features unavailable in
+ older Windows versions we still support. */
+#define _WIN32_WINNT 0x0400
+
+/* Make a leaner executable. */
+#define WIN32_LEAN_AND_MEAN 1
+
/* Defines size_t and alloca (). */
#ifdef emacs
#define malloc e_malloc
#include <malloc.h>
#endif
+#include <stdlib.h>
#include <sys/stat.h>
/* Define for those source files that do not include enough NT system files. */
#endif
/* For proper declaration of environ. */
-#include <stdlib.h>
#ifndef sys_nerr
#define sys_nerr _sys_nerr
#endif
-#include <string.h>
extern int getloadavg (double *, int);
+#if defined (__MINGW32__) || _MSC_VER >= 1400
+
+/* Define to 1 if the system has the type `long long int'. */
+# define HAVE_LONG_LONG_INT 1
+
+/* Define to 1 if the system has the type `unsigned long long int'. */
+# define HAVE_UNSIGNED_LONG_LONG_INT 1
+
+#elif _MSC_VER >= 1200
+
+/* Temporarily disable wider-than-pointer integers until they're tested more.
+ Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */
+
+# ifdef WIDE_EMACS_INT
+
+/* Use pre-C99-style 64-bit integers. */
+typedef __int64 EMACS_INT;
+typedef unsigned __int64 EMACS_UINT;
+# define EMACS_INT_MAX _I64_MAX
+# define pI "I64"
+
+# endif
+
+#endif
+
/* We need a little extra space, see ../../lisp/loadup.el. */
#define SYSTEM_PURESIZE_EXTRA 50000
+#define DATA_START get_data_start ()
+
/* For unexec to work on Alpha systems, we need to put Emacs'
initialized data into a separate section from the CRT initialized
data (because the Alpha linker freely reorders data variables, even
#define DebPrint(stuff)
#endif
+#define TERM_HEADER "w32term.h"
+
/* ============================================================ */
--- /dev/null
+#ifndef _NT_STDALIGN_H_
+#define _NT_STDALIGN_H_
+
+/* This header has the necessary stuff from lib/stdalign.in.h, but
+ avoids the need to have Sed at build time. */
+
+#include <stddef.h>
+#if defined __cplusplus
+ template <class __t> struct __alignof_helper { char __a; __t __b; };
+# define _Alignof(type) offsetof (__alignof_helper<type>, __b)
+#else
+# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b)
+#endif
+#define alignof _Alignof
+
+#if __GNUC__
+# define _Alignas(a) __attribute__ ((__aligned__ (a)))
+#elif 1300 <= _MSC_VER
+# define _Alignas(a) __declspec (align (a))
+#endif
+#ifdef _Alignas
+# define alignas _Alignas
+#endif
+
+#endif /* _NT_STDALIGN_H_ */
#include <sys/types.h>
#include <time.h>
-#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
#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
#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
_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_ */
*/
struct timeval
- {
- long tv_sec; /* seconds */
- long tv_usec; /* microseconds */
- };
+{
+ long tv_sec; /* seconds */
+ long tv_usec; /* microseconds */
+};
+
struct timezone
- {
- int tz_minuteswest; /* minutes west of Greenwich */
- int tz_dsttime; /* type of dst correction */
- };
+{
+ int tz_minuteswest; /* minutes west of Greenwich */
+ int tz_dsttime; /* type of dst correction */
+};
void gettimeofday (struct timeval *, struct timezone *);
#ifndef _UNISTD_H
#define _UNISTD_H
+/* On Microsoft platforms, <stdlib.h> declares 'environ'; on POSIX
+ platforms, <unistd.h> does. Every file in Emacs that includes
+ <unistd.h> also includes <stdlib.h>, so there's no need to declare
+ 'environ' here. */
+
extern ssize_t readlink (const char *, char *, size_t);
extern int symlink (char const *, char const *);
#endif /* _UNISTD_H */
-
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.\r
-# Copyright (C) 2000-2012 Free Software Foundation, Inc.\r
-#\r
-# Top level makefile for building GNU Emacs on Windows NT\r
-#\r
-# This file is part of GNU Emacs.\r
-\r
-# GNU Emacs is free software: you can redistribute it and/or modify\r
-# it under the terms of the GNU General Public License as published by\r
-# the Free Software Foundation, either version 3 of the License, or\r
-# (at your option) any later version.\r
-\r
-# GNU Emacs is distributed in the hope that it will be useful,\r
-# but WITHOUT ANY WARRANTY; without even the implied warranty of\r
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
-# GNU General Public License for more details.\r
-\r
-# You should have received a copy of the GNU General Public License\r
-# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.\r
-\r
-\r
-# FIXME: This file uses DOS EOLs. Convert to Unix after 22.1 is out\r
-# (and remove or replace this comment).\r
-\r
-VERSION = 24.2\r
-\r
-TMP_DIST_DIR = emacs-$(VERSION)\r
-\r
-TRES = $(BLD)/emacs.res\r
-CLIENTRES = $(BLD)/emacsclient.res\r
-\r
-XMFLAGS =\r
-\r
-ALL = addpm ddeclient runemacs cmdproxy addsection preprep\r
-\r
-.PHONY: $(ALL)\r
-\r
-\r
-addpm: stamp_BLD $(BLD)/addpm.exe\r
-$(BLD)/addpm.exe: $(BLD)/addpm.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) \\r
- $(USER32) $(OLE32) $(UUID) $(SHELL32)\r
-\r
-ddeclient: stamp_BLD $(BLD)/ddeclient.exe\r
-$(BLD)/ddeclient.exe: $(BLD)/ddeclient.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)\r
-\r
-cmdproxy: stamp_BLD $(BLD)/cmdproxy.exe\r
-$(BLD)/cmdproxy.exe: $(BLD)/cmdproxy.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)\r
-\r
-addsection: stamp_BLD $(BLD)/addsection.exe\r
-$(BLD)/addsection.exe: $(BLD)/addsection.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)\r
-\r
-preprep: stamp_BLD $(BLD)/preprep.exe\r
-$(BLD)/preprep.exe: $(BLD)/preprep.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS)\r
-\r
-#\r
-# The resource file. NT 3.10 requires the use of cvtres; even though\r
-# it is not necessary on later versions, it is still ok to use it.\r
-#\r
-$(TRES): emacs.rc icons/emacs.ico emacs.manifest stamp_BLD\r
- $(RC) $(RC_OUT)$(TRES) emacs.rc\r
-\r
-$(CLIENTRES): emacsclient.rc stamp_BLD\r
- $(RC) $(RC_OUT)$(CLIENTRES) emacsclient.rc\r
-\r
-runemacs: stamp_BLD $(BLD)/runemacs.exe\r
-$(BLD)/runemacs.exe: $(BLD)/runemacs.$(O) $(TRES)\r
- $(LINK) $(LINK_OUT)$@ $(SUBSYSTEM_WINDOWS) \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)\r
-\r
-which-sh:\r
- @echo Using $(THE_SHELL) as shell.\r
-\r
-# These depend on stamp_BLD to make sure the $(BLD) directory is created\r
-# before the compilation begins, even if Make runs several commands\r
-# in parallel under "make -j".\r
-#\r
-$(BLD)/addpm.$(O) $(BLD)/ddeclient.$(O) $(BLD)/runemacs.$(O) $(BLD)/cmdproxy.$(O) $(BLD)/addsection.$(O) $(BLD)/preprep.$(O): stamp_BLD\r
-\r
-#\r
-# Build emacs\r
-#\r
-all: which-sh stamp_BLD $(ALL) $(CLIENTRES) maybe-bootstrap all-other-dirs-$(MAKETYPE)\r
-\r
-all-other-dirs-nmake: addsection\r
- cd ..\lib\r
- $(MAKE) $(MFLAGS) all\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) all\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) all\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) all\r
- cd ..\leim\r
- $(MAKE) $(MFLAGS) all\r
- cd ..\nt\r
-\r
-all-other-dirs-gmake: addsection\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib all\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src all\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src all\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp all\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim all\r
-\r
-recompile: recompile-$(MAKETYPE)\r
-\r
-recompile-nmake:\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) recompile\r
- cd ..\nt\r
-\r
-recompile-gmake:\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp recompile\r
-\r
-#### Bootstrapping.\r
-\r
-### This is meant for Emacs maintainers only. It first cleans the\r
-### lisp subdirectory, removing all compiled Lisp files. Then a\r
-### special emacs executable is built from Lisp sources, which is then\r
-### used to compile Lisp files. The last step is a "normal" make.\r
-\r
-maybe-bootstrap: maybe-bootstrap-$(SHELLTYPE)\r
-\r
-# dummy target to force other targets to be evaluated.\r
-doit:\r
-\r
-maybe-bootstrap-CMD: doit\r
- @echo .\r
- @if not EXIST ..\lisp\abbrev.elc echo Essential Lisp files seem to be missing. You should either\r
- @if not EXIST ..\lisp\abbrev.elc echo do 'make bootstrap' or create 'lisp/abbrev.elc' somehow\r
- @echo .\r
- @if not EXIST ..\lisp\abbrev.elc exit -1\r
-\r
-maybe-bootstrap-SH: doit\r
- @if [ ! -f ../lisp/abbrev.elc ] ; then \\r
- echo; \\r
- echo "Essential Lisp files seem to be missing. You should either"; \\r
- echo "do \`make bootstrap' or create \`lisp/abbrev.elc' somehow."; \\r
- echo; \\r
- exit -1; \\r
- fi\r
-\r
-# Bootstrap depends on cmdproxy because some Lisp functions\r
-# loaded during bootstrap may need to run shell commands.\r
-bootstrap: addsection cmdproxy bootstrap-$(MAKETYPE)\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) all\r
-\r
-bootstrap-nmake: addsection cmdproxy\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) bootstrap-clean\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) clean make-docfile\r
- cd ..\lib\r
- $(MAKE) $(MFLAGS) clean all\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) bootstrap\r
- $(MAKE) $(MFLAGS) bootstrap-clean\r
- cd ..\nt\r
- $(CP) $(BLD)/cmdproxy.exe ../bin\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) SHELL=$(SHELLTYPE) bootstrap\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) DOC\r
- cd ..\nt\r
-\r
-bootstrap-gmake: addsection cmdproxy\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src clean make-docfile\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean all\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap-clean\r
- $(CP) $(BLD)/cmdproxy.exe ../bin\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src DOC\r
-\r
-bootstrap-clean: bootstrap-clean-$(MAKETYPE)\r
-\r
-bootstrap-clean-nmake:\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) bootstrap-clean\r
- cd ..\lib\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) bootstrap-clean\r
-\r
-bootstrap-clean-gmake:\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap-clean\r
-\r
-$(INSTALL_DIR):\r
- - mkdir "$(INSTALL_DIR)"\r
-\r
-$(INSTALL_DIR)/bin: $(INSTALL_DIR)\r
- - mkdir "$(INSTALL_DIR)/bin"\r
-\r
-#\r
-# Build and install emacs in INSTALL_DIR\r
-#\r
-.PHONY: install-bin install-shortcuts\r
-\r
-install: install-bin install-shortcuts\r
-\r
-install-bin: all $(INSTALL_DIR)/bin install-other-dirs-$(MAKETYPE)\r
- - $(CP) $(BLD)/ddeclient.exe $(INSTALL_DIR)/bin\r
- - $(CP) $(BLD)/cmdproxy.exe $(INSTALL_DIR)/bin\r
- - $(CP) $(BLD)/runemacs.exe $(INSTALL_DIR)/bin\r
- - $(CP) README.W32 $(INSTALL_DIR)\r
- - $(DEL) ../$(DIRNAME)_same-dir.tst\r
- - $(DEL) $(INSTALL_DIR)/$(DIRNAME)_same-dir.tst\r
- echo SameDirTest > "$(INSTALL_DIR)/$(DIRNAME)_same-dir.tst"\r
- - mkdir "$(INSTALL_DIR)/etc"\r
- - mkdir "$(INSTALL_DIR)/info"\r
- - mkdir "$(INSTALL_DIR)/lock"\r
- - mkdir "$(INSTALL_DIR)/data"\r
- - mkdir "$(INSTALL_DIR)/site-lisp"\r
- - mkdir "$(INSTALL_DIR)/etc/icons"\r
- $(IFNOTSAMEDIR) $(CP) ../site-lisp/subdirs.el $(INSTALL_DIR)/site-lisp $(ENDIF)\r
- $(IFNOTSAMEDIR) $(CP_DIR) ../etc $(INSTALL_DIR) $(ENDIF)\r
- - $(CP_DIR) icons $(INSTALL_DIR)/etc\r
- $(IFNOTSAMEDIR) $(CP_DIR) ../info $(INSTALL_DIR) $(ENDIF)\r
- $(IFNOTSAMEDIR) $(CP) ../COPYING $(INSTALL_DIR) $(ENDIF)\r
- - $(CP) ../COPYING $(INSTALL_DIR)/bin\r
- - $(DEL) ../$(DIRNAME)_same-dir.tst\r
- - $(DEL) $(INSTALL_DIR)/$(DIRNAME)_same-dir.tst\r
-\r
-install-other-dirs-nmake: all\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) install\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) install\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) install\r
- cd ..\leim\r
- $(MAKE) $(MFLAGS) install\r
- cd ..\nt\r
-\r
-install-other-dirs-gmake: all\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src install\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src install\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp install\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim install\r
-\r
-install-shortcuts: $(INSTALL_DIR)/bin\r
- - $(CP) $(BLD)/addpm.exe $(INSTALL_DIR)/bin\r
- "$(INSTALL_DIR)/bin/addpm" -q\r
-\r
-maybe-copy-distfiles: maybe-copy-distfiles-$(SHELLTYPE)\r
-\r
-maybe-copy-distfiles-CMD: create-tmp-dist-dir doit\r
- @if not $(ARGQUOTE)$(DIST_FILES)$(ARGQUOTE) == "" $(CP_DIR) $(DIST_FILES) $(TMP_DIST_DIR)/bin\r
-\r
-maybe-copy-distfiles-SH: create-tmp-dist-dir doit\r
- @if [ ! $(ARGQUOTE)$(DIST_FILES)$(ARGQUOTE) == "" ] ; then \\r
- $(CP_DIR) $(DIST_FILES) $(TMP_DIST_DIR)/bin ; \\r
- fi\r
-\r
-create-tmp-dist-dir:\r
- mkdir "$(TMP_DIST_DIR)"\r
-# Also create bin directory for dist files.\r
- mkdir "$(TMP_DIST_DIR)/bin"\r
-\r
-dist: install-bin maybe-copy-distfiles\r
- $(CP) "$(INSTALL_DIR)/BUGS" $(TMP_DIST_DIR)\r
- $(CP) "$(INSTALL_DIR)/COPYING" $(TMP_DIST_DIR)\r
- $(CP) "$(INSTALL_DIR)/README" $(TMP_DIST_DIR)\r
- $(CP) "$(INSTALL_DIR)/README.W32" $(TMP_DIST_DIR)\r
- $(CP_DIR) "$(INSTALL_DIR)/bin" $(TMP_DIST_DIR)\r
- $(CP_DIR) "$(INSTALL_DIR)/etc" $(TMP_DIST_DIR)\r
- $(CP_DIR) "$(INSTALL_DIR)/info" $(TMP_DIST_DIR)\r
- $(CP_DIR) "$(INSTALL_DIR)/lisp" $(TMP_DIST_DIR)\r
- $(CP_DIR) "$(INSTALL_DIR)/leim" $(TMP_DIST_DIR)\r
- $(CP_DIR) "$(INSTALL_DIR)/site-lisp" $(TMP_DIST_DIR)\r
- $(COMSPEC)$(ComSpec) /c $(ARGQUOTE)zipdist.bat $(VERSION)$(ARGQUOTE)\r
- $(DEL_TREE) $(TMP_DIST_DIR)\r
-\r
-force-info:\r
-# Note that doc/emacs/makefile knows how to\r
-# put the info files in $(infodir),\r
-# so we can do ok running make in the build dir.\r
-info: force-info info-$(MAKETYPE)\r
-\r
-info-nmake:\r
- cd ..\doc\emacs\r
- $(MAKE) $(MFLAGS) info\r
- cd ..\misc\r
- $(MAKE) $(MFLAGS) info\r
- cd ..\lispref\r
- $(MAKE) $(MFLAGS) info\r
- cd ..\lispintro\r
- $(MAKE) $(MFLAGS) info\r
- cd $(MAKEDIR)\r
-\r
-info-gmake:\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs info\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc info\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref info\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro info\r
-#\r
-# Maintenance\r
-#\r
-clean: clean-other-dirs-$(MAKETYPE)\r
- - $(DEL) $(COMPILER_TEMP_FILES)\r
- - $(DEL_TREE) $(OBJDIR)\r
- - $(DEL) stamp_BLD\r
- - $(DEL) ../etc/DOC ../etc/DOC-X\r
-\r
-clean-other-dirs-nmake:\r
- cd ..\lib\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\doc\lispintro\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\lispref\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\..\leim\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\doc\emacs\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\misc\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\..\nt\r
-\r
-clean-other-dirs-gmake:\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref clean\r
-\r
-cleanall-other-dirs-nmake:\r
- cd ..\lib\r
- $(MAKE) $(MFLAGS) cleanall\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) cleanall\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) cleanall\r
- cd ..\nt\r
-\r
-cleanall-other-dirs-gmake:\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib cleanall\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src cleanall\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src cleanall\r
-\r
-# We used to delete *~ here, but that might inadvertently remove\r
-# precious files if it happens to match their short 8+3 aliases.\r
-cleanall: clean cleanall-other-dirs-$(MAKETYPE)\r
- - $(DEL_TREE) obj\r
- - $(DEL_TREE) obj-spd\r
- - $(DEL_TREE) oo\r
- - $(DEL_TREE) oo-spd\r
-\r
-top-distclean:\r
- - $(DEL) $(COMPILER_TEMP_FILES)\r
- - $(DEL_TREE) obj\r
- - $(DEL_TREE) obj-spd\r
- - $(DEL_TREE) oo\r
- - $(DEL_TREE) oo-spd\r
- - $(DEL) stamp_BLD\r
- - $(DEL) ../etc/DOC ../etc/DOC-X\r
- - $(DEL) config.log Makefile\r
- - $(DEL) ../README.W32\r
-\r
-distclean: distclean-other-dirs-$(MAKETYPE) top-distclean\r
-\r
-distclean-other-dirs-nmake:\r
- cd ..\lib\r
- $(MAKE) $(MFLAGS) distclean\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) distclean\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) distclean\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) distclean\r
- cd ..\leim\r
- $(MAKE) $(MFLAGS) distclean\r
- cd ..\doc\emacs\r
- $(MAKE) $(MFLAGS) distclean\r
- cd ..\misc\r
- $(MAKE) $(MFLAGS) distclean\r
- cd ..\lispintro\r
- $(MAKE) $(MFLAGS) distclean\r
- cd ..\lispref\r
- $(MAKE) $(MFLAGS) distclean\r
- cd ..\..\nt\r
-\r
-distclean-other-dirs-gmake:\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib distclean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src distclean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src distclean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp distclean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim distclean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs distclean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc distclean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro distclean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref distclean\r
-\r
-maintainer-clean: maintainer-clean-other-dirs-$(MAKETYPE) top-distclean\r
-\r
-maintainer-clean-other-dirs-nmake:\r
- cd ..\lib\r
- $(MAKE) $(MFLAGS) maintainer-clean\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) maintainer-clean\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) maintainer-clean\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) maintainer-clean\r
- cd ..\leim\r
- $(MAKE) $(MFLAGS) maintainer-clean\r
- cd ..\doc\emacs\r
- $(MAKE) $(MFLAGS) maintainer-clean\r
- cd ..\misc\r
- $(MAKE) $(MFLAGS) maintainer-clean\r
- cd ..\lispintro\r
- $(MAKE) $(MFLAGS) maintainer-clean\r
- cd ..\lispref\r
- $(MAKE) $(MFLAGS) maintainer-clean\r
- cd ..\..\nt\r
-\r
-maintainer-clean-other-dirs-gmake:\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib maintainer-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src maintainer-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src maintainer-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp maintainer-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim maintainer-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs maintainer-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc maintainer-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro maintainer-clean\r
- $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref maintainer-clean\r
-\r
-realclean: cleanall\r
- - $(DEL_TREE) ../bin\r
-\r
-TAGS: TAGS-$(MAKETYPE)\r
-\r
-frc:\r
-TAGS-gmake: frc\r
- ../lib-src/$(BLD)/etags $(CURDIR)/*.c\r
- $(MAKE) $(MFLAGS) -C ../src TAGS TAGS-LISP\r
- $(MAKE) $(MFLAGS) -C ../lib-src TAGS\r
- $(MAKE) $(MFLAGS) -C ../lib TAGS\r
-\r
-TAGS-nmake:\r
- echo This target is not supported with NMake\r
-\r
-.PHONY: frc\r
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
+# Copyright (C) 2000-2012 Free Software Foundation, Inc.
+#
+# Top level makefile for building GNU Emacs on Windows NT
+#
+# 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 <http://www.gnu.org/licenses/>.
+
+
+# FIXME: This file uses DOS EOLs. Convert to Unix after 22.1 is out
+# (and remove or replace this comment).
+
+VERSION = 24.2.50
+
+TMP_DIST_DIR = emacs-$(VERSION)
+
+TRES = $(BLD)/emacs.res
+CLIENTRES = $(BLD)/emacsclient.res
+
+XMFLAGS =
+
+ALL = addpm ddeclient runemacs cmdproxy addsection preprep
+
+.PHONY: $(ALL)
+
+
+addpm: stamp_BLD $(BLD)/addpm.exe
+$(BLD)/addpm.exe: $(BLD)/addpm.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) \
+ $(USER32) $(OLE32) $(UUID) $(SHELL32)
+
+ddeclient: stamp_BLD $(BLD)/ddeclient.exe
+$(BLD)/ddeclient.exe: $(BLD)/ddeclient.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)
+
+cmdproxy: stamp_BLD $(BLD)/cmdproxy.exe
+$(BLD)/cmdproxy.exe: $(BLD)/cmdproxy.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)
+
+addsection: stamp_BLD $(BLD)/addsection.exe
+$(BLD)/addsection.exe: $(BLD)/addsection.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)
+
+preprep: stamp_BLD $(BLD)/preprep.exe
+$(BLD)/preprep.exe: $(BLD)/preprep.$(O)
+ $(LINK) $(LINK_OUT)$@ \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS)
+
+#
+# The resource file. NT 3.10 requires the use of cvtres; even though
+# it is not necessary on later versions, it is still ok to use it.
+#
+$(TRES): emacs.rc icons/emacs.ico emacs.manifest stamp_BLD
+ $(RC) $(RC_OUT)$(TRES) emacs.rc
+
+$(CLIENTRES): emacsclient.rc stamp_BLD
+ $(RC) $(RC_OUT)$(CLIENTRES) emacsclient.rc
+
+runemacs: stamp_BLD $(BLD)/runemacs.exe
+$(BLD)/runemacs.exe: $(BLD)/runemacs.$(O) $(TRES)
+ $(LINK) $(LINK_OUT)$@ $(SUBSYSTEM_WINDOWS) \
+ $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)
+
+which-sh:
+ @echo Using $(THE_SHELL) as shell.
+
+# These depend on stamp_BLD to make sure the $(BLD) directory is created
+# before the compilation begins, even if Make runs several commands
+# in parallel under "make -j".
+#
+$(BLD)/addpm.$(O) $(BLD)/ddeclient.$(O) $(BLD)/runemacs.$(O) $(BLD)/cmdproxy.$(O) $(BLD)/addsection.$(O) $(BLD)/preprep.$(O): stamp_BLD
+
+#
+# Build emacs
+#
+all: which-sh $(ALL) $(CLIENTRES) all-other-dirs-$(MAKETYPE)
+
+all-other-dirs-$(MAKETYPE): maybe-bootstrap
+
+all-other-dirs-nmake: addsection
+ cd ..\lib
+ $(MAKE) $(MFLAGS) all
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) all
+ cd ..\src
+ $(MAKE) $(MFLAGS) all
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) all
+ cd ..\leim
+ $(MAKE) $(MFLAGS) all
+ cd ..\nt
+
+all-other-dirs-gmake: addsection
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim all
+
+recompile: recompile-$(MAKETYPE)
+
+recompile-nmake:
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) recompile
+ cd ..\nt
+
+recompile-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp recompile
+
+#### Bootstrapping.
+
+### This is meant for Emacs maintainers only. It first cleans the
+### lisp subdirectory, removing all compiled Lisp files. Then a
+### special emacs executable is built from Lisp sources, which is then
+### used to compile Lisp files. The last step is a "normal" make.
+
+maybe-bootstrap: maybe-bootstrap-$(SHELLTYPE)
+
+# dummy target to force other targets to be evaluated.
+doit:
+
+maybe-bootstrap-CMD: doit
+ @echo .
+ @if not EXIST ..\lisp\abbrev.elc echo Essential Lisp files seem to be missing. You should either
+ @if not EXIST ..\lisp\abbrev.elc echo do 'make bootstrap' or create 'lisp/abbrev.elc' somehow
+ @echo .
+ @if not EXIST ..\lisp\abbrev.elc exit -1
+
+maybe-bootstrap-SH: doit
+ @if [ ! -f ../lisp/abbrev.elc ] ; then \
+ echo; \
+ echo "Essential Lisp files seem to be missing. You should either"; \
+ echo "do \`make bootstrap' or create \`lisp/abbrev.elc' somehow."; \
+ echo; \
+ exit -1; \
+ fi
+
+# Bootstrap depends on cmdproxy because some Lisp functions
+# loaded during bootstrap may need to run shell commands.
+bootstrap: addsection cmdproxy bootstrap-$(MAKETYPE)
+ $(MAKE) $(MFLAGS) $(XMFLAGS) all
+
+bootstrap-nmake: addsection cmdproxy
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) bootstrap-clean
+ cd ..\src
+ $(MAKE) $(MFLAGS) clean
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) clean make-docfile
+ cd ..\lib
+ $(MAKE) $(MFLAGS) clean all
+ cd ..\src
+ $(MAKE) $(MFLAGS) bootstrap
+ $(MAKE) $(MFLAGS) bootstrap-clean
+ cd ..\nt
+ $(CP) $(BLD)/cmdproxy.exe ../bin
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) SHELL=$(SHELLTYPE) bootstrap
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) DOC
+ cd ..\nt
+
+bootstrap-gmake: addsection cmdproxy
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src make-docfile
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap-clean
+ $(CP) $(BLD)/cmdproxy.exe ../bin
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src DOC
+
+bootstrap-clean: bootstrap-clean-$(MAKETYPE)
+
+bootstrap-clean-nmake:
+ cd ..\src
+ $(MAKE) $(MFLAGS) bootstrap-clean
+ cd ..\lib
+ $(MAKE) $(MFLAGS) clean
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) bootstrap-clean
+
+bootstrap-clean-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src bootstrap-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp bootstrap-clean
+
+$(INSTALL_DIR):
+ - mkdir "$(INSTALL_DIR)"
+
+$(INSTALL_DIR)/bin: $(INSTALL_DIR)
+ - mkdir "$(INSTALL_DIR)/bin"
+
+#
+# Build and install emacs in INSTALL_DIR
+#
+.PHONY: install-bin install-shortcuts
+
+install: install-bin install-shortcuts
+
+install-bin: all $(INSTALL_DIR)/bin install-other-dirs-$(MAKETYPE)
+ - $(CP) $(BLD)/ddeclient.exe $(INSTALL_DIR)/bin
+ - $(CP) $(BLD)/cmdproxy.exe $(INSTALL_DIR)/bin
+ - $(CP) $(BLD)/runemacs.exe $(INSTALL_DIR)/bin
+ - $(CP) README.W32 $(INSTALL_DIR)
+ - $(DEL) ../$(DIRNAME)_same-dir.tst
+ - $(DEL) $(INSTALL_DIR)/$(DIRNAME)_same-dir.tst
+ echo SameDirTest > "$(INSTALL_DIR)/$(DIRNAME)_same-dir.tst"
+ - mkdir "$(INSTALL_DIR)/etc"
+ - mkdir "$(INSTALL_DIR)/info"
+ - mkdir "$(INSTALL_DIR)/lock"
+ - mkdir "$(INSTALL_DIR)/data"
+ - mkdir "$(INSTALL_DIR)/site-lisp"
+ - mkdir "$(INSTALL_DIR)/etc/icons"
+ $(IFNOTSAMEDIR) $(CP) ../site-lisp/subdirs.el $(INSTALL_DIR)/site-lisp $(ENDIF)
+ $(IFNOTSAMEDIR) $(CP_DIR) ../etc $(INSTALL_DIR) $(ENDIF)
+ - $(CP_DIR) icons $(INSTALL_DIR)/etc
+ $(IFNOTSAMEDIR) $(CP_DIR) ../info $(INSTALL_DIR) $(ENDIF)
+ $(IFNOTSAMEDIR) $(CP) ../COPYING $(INSTALL_DIR) $(ENDIF)
+ - $(CP) ../COPYING $(INSTALL_DIR)/bin
+ - $(DEL) ../$(DIRNAME)_same-dir.tst
+ - $(DEL) $(INSTALL_DIR)/$(DIRNAME)_same-dir.tst
+
+install-other-dirs-nmake: all
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) install
+ cd ..\src
+ $(MAKE) $(MFLAGS) install
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) install
+ cd ..\leim
+ $(MAKE) $(MFLAGS) install
+ cd ..\nt
+
+install-other-dirs-gmake: all
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src install
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src install
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp install
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim install
+
+install-addpm: $(INSTALL_DIR)/bin addpm
+ - $(CP) $(BLD)/addpm.exe $(INSTALL_DIR)/bin
+
+install-shortcuts: install-addpm
+ "$(INSTALL_DIR)/bin/addpm" -q
+
+maybe-copy-distfiles: maybe-copy-distfiles-$(SHELLTYPE)
+
+maybe-copy-distfiles-CMD: create-tmp-dist-dir doit
+ @if not $(ARGQUOTE)$(DIST_FILES)$(ARGQUOTE) == "" $(CP_DIR) $(DIST_FILES) $(TMP_DIST_DIR)/bin
+
+maybe-copy-distfiles-SH: create-tmp-dist-dir doit
+ @if [ ! $(ARGQUOTE)$(DIST_FILES)$(ARGQUOTE) == "" ] ; then \
+ $(CP_DIR) $(DIST_FILES) $(TMP_DIST_DIR)/bin ; \
+ fi
+
+create-tmp-dist-dir:
+ mkdir "$(TMP_DIST_DIR)"
+# Also create bin directory for dist files.
+ mkdir "$(TMP_DIST_DIR)/bin"
+
+dist: install-bin install-addpm maybe-copy-distfiles
+ $(CP) "$(INSTALL_DIR)/BUGS" $(TMP_DIST_DIR)
+ $(CP) "$(INSTALL_DIR)/COPYING" $(TMP_DIST_DIR)
+ $(CP) "$(INSTALL_DIR)/README" $(TMP_DIST_DIR)
+ $(CP) "$(INSTALL_DIR)/README.W32" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/bin" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/etc" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/info" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/lisp" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/leim" $(TMP_DIST_DIR)
+ $(CP_DIR) "$(INSTALL_DIR)/site-lisp" $(TMP_DIST_DIR)
+ $(COMSPEC)$(ComSpec) /c $(ARGQUOTE)zipdist.bat $(VERSION)$(ARGQUOTE)
+ $(DEL_TREE) $(TMP_DIST_DIR)
+
+force-info:
+# Note that doc/emacs/makefile knows how to
+# put the info files in $(infodir),
+# so we can do ok running make in the build dir.
+info: force-info info-$(MAKETYPE)
+
+info-nmake:
+ cd ..\doc\emacs
+ $(MAKE) $(MFLAGS) info
+ cd ..\misc
+ $(MAKE) $(MFLAGS) info
+ cd ..\lispref
+ $(MAKE) $(MFLAGS) info
+ cd ..\lispintro
+ $(MAKE) $(MFLAGS) info
+ cd $(MAKEDIR)
+
+info-gmake: emacs misc lispref lispintro
+
+emacs misc lispref lispintro:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/$@ info
+
+#
+# Maintenance
+#
+clean: clean-other-dirs-$(MAKETYPE)
+ - $(DEL) $(COMPILER_TEMP_FILES)
+ - $(DEL_TREE) $(OBJDIR)
+ - $(DEL) stamp_BLD
+ - $(DEL) ../etc/DOC ../etc/DOC-X
+
+clean-other-dirs-nmake:
+ cd ..\lib
+ $(MAKE) $(MFLAGS) clean
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) clean
+ cd ..\src
+ $(MAKE) $(MFLAGS) clean
+ cd ..\doc\lispintro
+ $(MAKE) $(MFLAGS) clean
+ cd ..\lispref
+ $(MAKE) $(MFLAGS) clean
+ cd ..\..\leim
+ $(MAKE) $(MFLAGS) clean
+ cd ..\doc\emacs
+ $(MAKE) $(MFLAGS) clean
+ cd ..\misc
+ $(MAKE) $(MFLAGS) clean
+ cd ..\..\nt
+
+clean-other-dirs-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref clean
+
+cleanall-other-dirs-nmake:
+ cd ..\lib
+ $(MAKE) $(MFLAGS) cleanall
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) cleanall
+ cd ..\src
+ $(MAKE) $(MFLAGS) cleanall
+ cd ..\nt
+
+cleanall-other-dirs-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib cleanall
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src cleanall
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src cleanall
+
+# We used to delete *~ here, but that might inadvertently remove
+# precious files if it happens to match their short 8+3 aliases.
+cleanall: clean cleanall-other-dirs-$(MAKETYPE)
+ - $(DEL_TREE) obj
+ - $(DEL_TREE) obj-spd
+ - $(DEL_TREE) oo
+ - $(DEL_TREE) oo-spd
+
+top-distclean:
+ - $(DEL) $(COMPILER_TEMP_FILES)
+ - $(DEL_TREE) obj
+ - $(DEL_TREE) obj-spd
+ - $(DEL_TREE) oo
+ - $(DEL_TREE) oo-spd
+ - $(DEL) stamp_BLD
+ - $(DEL) ../etc/DOC ../etc/DOC-X
+ - $(DEL) config.log Makefile
+ - $(DEL) ../README.W32
+
+distclean: distclean-other-dirs-$(MAKETYPE) top-distclean
+
+distclean-other-dirs-nmake:
+ cd ..\lib
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\src
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\leim
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\doc\emacs
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\misc
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\lispintro
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\lispref
+ $(MAKE) $(MFLAGS) distclean
+ cd ..\..\nt
+
+distclean-other-dirs-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro distclean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref distclean
+
+maintainer-clean: maintainer-clean-other-dirs-$(MAKETYPE) top-distclean
+
+maintainer-clean-other-dirs-nmake:
+ cd ..\lib
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\lib-src
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\src
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\lisp
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\leim
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\doc\emacs
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\misc
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\lispintro
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\lispref
+ $(MAKE) $(MFLAGS) maintainer-clean
+ cd ..\..\nt
+
+maintainer-clean-other-dirs-gmake:
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lib-src maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../src maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../lisp maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../leim maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/misc maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispintro maintainer-clean
+ $(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/lispref maintainer-clean
+
+realclean: cleanall
+ - $(DEL_TREE) ../bin
+
+TAGS: TAGS-$(MAKETYPE)
+
+frc:
+TAGS-gmake: frc
+ ../lib-src/$(BLD)/etags $(CURDIR)/*.c
+ $(MAKE) $(MFLAGS) -C ../src TAGS TAGS-LISP
+ $(MAKE) $(MFLAGS) -C ../lib-src TAGS
+ $(MAKE) $(MFLAGS) -C ../lib TAGS
+
+TAGS-nmake:
+ echo This target is not supported with NMake
+
+.PHONY: frc
DEBUG_CFLAGS =\r
!endif\r
\r
-!ifdef ENABLECHECKS\r
-CHECKING_CFLAGS = -DENABLE_CHECKING -DXASSERTS\r
-!else\r
-CHECKING_CFLAGS =\r
-!endif\r
-\r
MWINDOWS = -subsystem:windows -entry:mainCRTStartup\r
\r
CFLAGS = -I. $(ARCH_CFLAGS) \\r
- $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)\r
+ $(DEBUG_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)\r
ESC_CFLAGS = -I. $(ARCH_CFLAGS) \\r
- $(DEBUG_CFLAGS) $(CHECKING_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS)\r
+ $(DEBUG_CFLAGS) $(ESC_USER_CFLAGS) $(LOCAL_FLAGS)\r
\r
#SYS_LDFLAGS = -nologo -release -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj\r
!ifdef NOOPT\r
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+/* 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".
- This sets load-path. */
+ 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 "%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
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. */
/* 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"
-
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.2 released.
+ * Makefile.in (ALL_CFLAGS): Add -I../lib -I${srcdir}/../lib.
+ This is needed for hosts that lack <alloca.h>, when Emacs is
+ configured --with-x-toolkit=no. Problem reported by Herbert
+ J. Skuhra for FreeBSD.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
- * Version 24.1 released.
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * Makefile.in (C_WARNINGS_SWITCH): Remove.
+ (WARN_CFLAGS, WERROR_CFLAGS): New macros.
+ (ALL_CFLAGS): Use new macros rather than old.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (C_SWITCH_X_SYSTEM): Remove.
+ (ALL_CFLAGS): Remove C_SWITCH_X_SYSTEM.
2011-04-16 Paul Eggert <eggert@cs.ucla.edu>
* copyright.h: New file (copied from X11R4 distribution)
* All files: Replaced occurrences of #include <X11/copyright.h>
- with #include "copyright.h"
+ with #include "copyright.h".
1991-10-25 Richard Stallman (rms@mole.gnu.ai.mit.edu)
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2012 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
-## Makefile for oldXMenu
+## Makefile for oldXMenu
## Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology
## without express or implied warranty.
-## Copyright (C) 2001-2012 Free Software Foundation, Inc.
+## Copyright (C) 2001-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
srcdir=@srcdir@
VPATH=@srcdir@
C_SWITCH_X_SITE=@C_SWITCH_X_SITE@
-C_SWITCH_X_SYSTEM=@C_SWITCH_X_SYSTEM@
C_SWITCH_SYSTEM=@C_SWITCH_SYSTEM@
C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
+WARN_CFLAGS = @WARN_CFLAGS@
+WERROR_CFLAGS = @WERROR_CFLAGS@
EXTRA=insque.o
CC=@CC@
all:: libXMenu11.a
ALL_CFLAGS=$(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \
- $(C_SWITCH_X_SITE) $(C_SWITCH_X_SYSTEM) \
- ${C_WARNINGS_SWITCH} ${PROFILING_CFLAGS} \
+ $(C_SWITCH_X_SITE) \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) ${PROFILING_CFLAGS} \
$(CPPFLAGS) $(CFLAGS) -DEMACS_BITMAP_FILES \
- -I../src -I${srcdir} -I${srcdir}/../src
+ -I../src -I../lib -I${srcdir} -I${srcdir}/../src -I${srcdir}/../lib
.c.o:
$(CC) -c ${ALL_CFLAGS} $<
# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
# Boston, MA 02110-1301, USA.
-# Force loading of symbols, enough to give us gdb_valbits etc.
-set main
+# Force loading of symbols, enough to give us VALBITS etc.
+set $dummy = main + 8
# With some compilers, we need this to give us struct Lisp_Symbol etc.:
-set Fmake_symbol
+set $dummy = Fmake_symbol + 8
# Find lwlib source files too.
dir ../lwlib
# debugging.
handle SIGALRM ignore
-# $valmask and $tagmask are mask values set up by the xreload macro below.
-
# Use $bugfix so that the value isn't a constant.
# Using a constant runs into GDB bugs sometimes.
define xgetptr
- set $bugfix = $arg0
- set $ptr = (gdb_use_union ? (gdb_use_lsb ? $bugfix.u.val << gdb_gctypebits : $bugfix.u.val) : $bugfix & $valmask) | gdb_data_seg_bits
+ if (CHECK_LISP_OBJECT_TYPE)
+ set $bugfix = $arg0.i
+ else
+ set $bugfix = $arg0
+ end
+ set $ptr = ($bugfix & VALMASK) | DATA_SEG_BITS
end
define xgetint
- set $bugfix = $arg0
- set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
+ if (CHECK_LISP_OBJECT_TYPE)
+ set $bugfix = $arg0.i
+ else
+ set $bugfix = $arg0
+ end
+ set $int = $bugfix << (USE_LSB_TAG ? 0 : INTTYPEBITS) >> INTTYPEBITS
end
define xgettype
- set $bugfix = $arg0
- set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
+ if (CHECK_LISP_OBJECT_TYPE)
+ set $bugfix = $arg0.i
+ else
+ set $bugfix = $arg0
+ end
+ set $type = (enum Lisp_Type) (USE_LSB_TAG ? $bugfix & (1 << GCTYPEBITS) - 1 : $bugfix >> VALBITS)
end
# Set up something to print out s-expressions.
set $tmp = $arg0
set $output_debug = print_output_debug_flag
set print_output_debug_flag = 0
- set safe_debug_print ($tmp)
+ call safe_debug_print ($tmp)
set print_output_debug_flag = $output_debug
end
document pp
set $tmp = "$arg0"
set $output_debug = print_output_debug_flag
set print_output_debug_flag = 0
- set safe_debug_print (find_symbol_value (intern ($tmp)))
+ call safe_debug_print (find_symbol_value (intern ($tmp)))
set print_output_debug_flag = $output_debug
end
document pv
define xvectype
xgetptr $
set $size = ((struct Lisp_Vector *) $ptr)->header.size
- output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
+ if ($size & PSEUDOVECTOR_FLAG)
+ output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS)
+ else
+ output $size & ~ARRAY_MARK_FLAG
+ end
echo \n
end
document xvectype
This command assumes that $ is an Emacs Lisp Misc value.
end
-define xintfwd
- xgetptr $
- print (struct Lisp_Intfwd *) $ptr
-end
-document xintfwd
-Print $ as an integer forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xboolfwd
- xgetptr $
- print (struct Lisp_Boolfwd *) $ptr
-end
-document xboolfwd
-Print $ as a boolean forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xobjfwd
- xgetptr $
- print (struct Lisp_Objfwd *) $ptr
-end
-document xobjfwd
-Print $ as an object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xbufobjfwd
- xgetptr $
- print (struct Lisp_Buffer_Objfwd *) $ptr
-end
-document xbufobjfwd
-Print $ as a buffer-local object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xkbobjfwd
- xgetptr $
- print (struct Lisp_Kboard_Objfwd *) $ptr
-end
-document xkbobjfwd
-Print $ as a kboard-local object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xbuflocal
- xgetptr $
- print (struct Lisp_Buffer_Local_Value *) $ptr
-end
-document xbuflocal
-Print $ as a buffer-local-value pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
define xsymbol
set $sym = $
xgetptr $sym
define xvector
xgetptr $
print (struct Lisp_Vector *) $ptr
- output ($->header.size > 50) ? 0 : ($->contents[0])@($->header.size & ~gdb_array_mark_flag)
+ output ($->header.size > 50) ? 0 : ($->contents[0])@($->header.size & ~ARRAY_MARK_FLAG)
echo \n
end
document xvector
define xboolvector
xgetptr $
print (struct Lisp_Bool_Vector *) $ptr
- output ($->header.size > 256) ? 0 : ($->data[0])@((($->header.size & ~gdb_array_mark_flag) + 7)/ 8)
+ output ($->size > 256) ? 0 : ($->data[0])@(($->size + BOOL_VECTOR_BITS_PER_CHAR - 1)/ BOOL_VECTOR_BITS_PER_CHAR)
echo \n
end
document xboolvector
define xpr
xtype
- if $type == Lisp_Int
+ if $type == Lisp_Int0 || $type == Lisp_Int1
xint
end
if $type == Lisp_Symbol
if $misc == Lisp_Misc_Free
xmiscfree
end
- if $misc == Lisp_Misc_Boolfwd
- xboolfwd
- end
if $misc == Lisp_Misc_Marker
xmarker
end
- if $misc == Lisp_Misc_Intfwd
- xintfwd
- end
- if $misc == Lisp_Misc_Boolfwd
- xboolfwd
- end
- if $misc == Lisp_Misc_Objfwd
- xobjfwd
- end
- if $misc == Lisp_Misc_Buffer_Objfwd
- xbufobjfwd
- end
- if $misc == Lisp_Misc_Buffer_Local_Value
- xbuflocal
- end
-# if $misc == Lisp_Misc_Some_Buffer_Local_Value
-# xvalue
-# end
if $misc == Lisp_Misc_Overlay
xoverlay
end
- if $misc == Lisp_Misc_Kboard_Objfwd
- xkbobjfwd
- end
# if $misc == Lisp_Misc_Save_Value
# xsavevalue
# end
end
if $type == Lisp_Vectorlike
set $size = ((struct Lisp_Vector *) $ptr)->header.size
- if ($size & PVEC_FLAG)
- set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
+ if ($size & PSEUDOVECTOR_FLAG)
+ set $vec = (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS)
if $vec == PVEC_NORMAL_VECTOR
xvector
end
define xprintstr
set $data = (char *) $arg0->data
- output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
+ output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~ARRAY_MARK_FLAG : $arg0->size_byte)
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
end
define xcoding
- set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & $valmask) | gdb_data_seg_bits)
- set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
+ set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & VALMASK) | DATA_SEG_BITS)
+ set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & VALMASK) | DATA_SEG_BITS)
set $name = $tmp->contents[$arg0 * 2]
print $name
pr
end
define xcharset
- set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & $valmask) | gdb_data_seg_bits)
- set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
+ set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & VALMASK) | DATA_SEG_BITS)
+ set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & VALMASK) | DATA_SEG_BITS)
p $tmp->contents[charset_table[$arg0].hash_index * 2]
pr
end
if $type == Lisp_Vectorlike
xgetptr (*$bt->function)
set $size = ((struct Lisp_Vector *) $ptr)->header.size
- output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
+ if ($size & PSEUDOVECTOR_FLAG)
+ output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_SIZE_BITS)
+ else
+ output $size & ~ARRAY_MARK_FLAG
+ end
else
printf "Lisp type %d", $type
end
define xprintbytestr
set $data = (char *) $arg0->data
printf "Bytecode: "
- output/u ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
+ output/u ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~ARRAY_MARK_FLAG : $arg0->size_byte)
end
document xprintbytestr
Print a string of byte code.
define xwhichsymbols
set $output_debug = print_output_debug_flag
set print_output_debug_flag = 0
- set safe_debug_print (which_symbols ($arg0, $arg1))
+ call safe_debug_print (which_symbols ($arg0, $arg1))
set print_output_debug_flag = $output_debug
end
document xwhichsymbols
end
end
-define xreload
- set $tagmask = (((long)1 << gdb_gctypebits) - 1)
- # The consing_since_gc business widens the 1 to EMACS_INT,
- # a symbol not directly visible to GDB.
- set $valmask = gdb_use_lsb ? ~($tagmask) : ((consing_since_gc - consing_since_gc + 1) << gdb_valbits) - 1
-end
-document xreload
- When starting Emacs a second time in the same gdb session under
- FreeBSD 2.2.5, gdb 4.13, $valmask have lost
- their values. (The same happens on current (2000) versions of GNU/Linux
- with gdb 5.0.)
- This function reloads them.
-end
-xreload
-
# Flush display (X only)
define ff
set x_flush (0)
end
-define hook-run
- xreload
-end
-
-# Call xreload if a new Emacs executable is loaded.
-define hookpost-run
- xreload
-end
-
set print pretty on
set print sevenbit-strings
show environment DISPLAY
show environment TERM
-# People get bothered when they see messages about non-existent functions...
-xgetptr globals.f_Vsystem_type
-# $ptr is NULL in temacs
-if ($ptr != 0)
- set $tem = (struct Lisp_Symbol *) $ptr
- xgetptr $tem->xname
- set $tem = (struct Lisp_String *) $ptr
- set $tem = (char *) $tem->data
-
- # Don't let abort actually run, as it will make stdio stop working and
- # therefore the `pr' command above as well.
- if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
- # The windows-nt build replaces abort with its own function.
- break w32_abort
- else
- break abort
- end
-end
+# When debugging, it is handy to be able to "return" from
+# terminate_due_to_signal when an assertion failure is non-fatal.
+break terminate_due_to_signal
# x_error_quitter is defined only on X. But window-system is set up
# only at run time, during Emacs startup, so we need to defer setting
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
config.h
epaths.h
stamp_BLD
+stamp-h.in
oo/
oo-spd/
-2012-09-24 Glenn Morris <rgm@gnu.org>
+2012-09-28 Glenn Morris <rgm@gnu.org>
* eval.c (Frun_hook_with_args, Frun_hook_with_args_until_success)
(Frun_hook_with_args_until_failure): Doc fixes.
+2012-09-28 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (syms_of_xdisp) <Qredisplay_internal>: Rename from
+ Qautomatic_redisplay and change the symbol name. All users changed.
+
+2012-09-28 Tomohiro Matsuyama <tomo@cx4a.org>
+
+ * profiler.c (sigprof_handler): Fix race condition.
+
+2012-09-28 Glenn Morris <rgm@gnu.org>
+
+ * lread.c (lisp_file_lexically_bound_p): Handle #! lines. (Bug#12528)
+
+2012-09-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check more robustly for timer_settime.
+ * Makefile.in (LIB_TIMER_TIME): New macro.
+ (LIBES): Add it.
+ * atimer.c (alarm_timer, alarm_timer_ok, set_alarm, init_atimer):
+ Use HAVE_TIMER_SETTIME, not SIGEV_SIGNAL, to decide whether to
+ call timer_settime.
+
+2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org>
+
+ * profiler.c (Fprofiler_cpu_start): Remove unnecessary flag SA_SIGINFO.
+
+2012-09-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/profiler.$(O)): Update dependencies.
+
+2012-09-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * character.h (MAYBE_UNIFY_CHAR): Remove.
+ * charset.c, charset.h (maybe_unify_char): Now static.
+ * charset.c (decode_char): Use maybe_unify_char, not MAYBE_UNIFY_CHAR.
+ Since this stuff is now private to charset.c, there's no need for
+ a public macro and no need to inline by hand.
+
+2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+ Juanma Barranquero <lekktu@gmail.com>
+
+ * profiler.c: New file.
+ * Makefile.in (base_obj): Add profiler.o.
+ * makefile.w32-in (OBJ2, GLOBAL_SOURCES): Add profiler.c.
+ ($(BLD)/profiler.$(O)): New target.
+ * emacs.c (main): Call syms_of_profiler.
+ * alloc.c (Qautomatic_gc): New constant.
+ (MALLOC_PROBE): New macro.
+ (xmalloc, xzalloc, xrealloc, lisp_malloc, lisp_align_malloc): Use it.
+ (total_bytes_of_live_objects): New function.
+ (Fgarbage_collect): Use it. Record itself in backtrace_list.
+ Call malloc_probe for the memory profiler.
+ (syms_of_alloc): Define Qautomatic_gc.
+ * eval.c (eval_sub, Ffuncall): Reorder assignments to avoid
+ race condition.
+ (struct backtrace): Move definition...
+ * lisp.h (struct backtrace): ..here.
+ (Qautomatic_gc, profiler_memory_running): Declare vars.
+ (malloc_probe, syms_of_profiler): Declare functions.
+ * xdisp.c (Qautomatic_redisplay): New constant.
+ (redisplay_internal): Record itself in backtrace_list.
+ (syms_of_xdisp): Define Qautomatic_redisplay.
+
+2012-09-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/callproc.$(O)): Update dependencies.
+
+2012-09-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer POSIX timers if available.
+ They avoid a race if the timer is too close to the current time.
+ * atimer.c (alarm_timer, alarm_timer_ok) [SIGEV_SIGNAL]: New static vars.
+ (set_alarm) [SIGEV_SIGNAL]: Use POSIX timers if available.
+ (init_atimer) [SIGEV_SIGNAL]: Initialize them.
+
+2012-09-25 Eli Zaretskii <eliz@gnu.org>
+
+ * coding.c (CHAR_STRING_ADVANCE_NO_UNIFY): Make it an alias of
+ CHAR_STRING_ADVANCE.
+ (STRING_CHAR_ADVANCE_NO_UNIFY): Make it an alias of
+ STRING_CHAR_ADVANCE.
+
+2012-09-25 Juanma Barranquero <lekktu@gmail.com>
+
+ Move Vlibrary_cache to emacs.c and reset before dumping.
+
+ * lisp.h (reset_image_types): Declare.
+ [WINDOWSNT] (Vlibrary_cache): Declare.
+
+ * image.c (reset_image_types): New function.
+
+ * emacs.c [WINDOWSNT] (Vlibrary_cache): Move from w32.c.
+ (syms_of_emacs) [WINDOWSNT] <Vlibrary_cache>: Initialize and staticpro.
+ (Fdump_emacs): Reset Vlibrary_cache and image_types.
+
+ * w32.c (Vlibrary_cache): Do not define; moved to emacs.c
+ (globals_of_w32) <Vlibrary_cache>: Do not initialize.
+
+ * w32.h (Vlibrary_cache): Do not declare.
+
+2012-09-25 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (sys_signal): Handle all signals defined by the
+ MS-Windows runtime, not just SIGCHLD. Actually install the signal
+ handlers for signals supported by Windows. Don't override
+ term_ntproc as the handler for SIGABRT.
+ (sigaction): Rewrite to call sys_signal instead of duplicating its
+ code.
+ (sys_kill): Improve commentary.
+
+ * w32.c (term_ntproc): Accept (and ignore) one argument, for
+ consistency with a signature of a signal handler. All callers
+ changed.
+ (init_ntproc): Accept an argument DUMPING. If dumping, don't
+ install term_ntproc as a signal handler for SIGABRT, as that
+ should be done by the dumped Emacs.
+
+ * w32.h (init_ntproc, term_ntproc): Adjust prototypes.
+
+ * w32select.c (term_w32select): Protect against repeated
+ invocation by setting clipboard_owner to NULL after calling
+ DestroyWindow.
+
+ * emacs.c (shut_down_emacs, main): Adapt the calls to init_ntproc
+ and term_ntproc to their modified signatures.
+
+ * character.c (char_string, string_char): Remove calls to
+ MAYBE_UNIFY_CHAR. See the discussion starting at
+ http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00433.html
+ for the details.
+
+2012-09-25 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (mode_line_inverse_video): Delete obsolete variable.
+
+2012-09-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * bytecode.c (exec_byte_code): Signal an error instead of aborting,
+ when encountering an unknown bytecode.
+
+2012-09-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ image.c, indent.c: Use bool for booleans.
+ * dispextern.h (struct image_type): Members valid_p, load, init
+ now return bool, not int. All uses changed.
+ * image.c: Omit unnecessary static decls.
+ (x_create_bitmap_mask, x_build_heuristic_mask):
+ Return void, not int, since callers don't care about the return value.
+ (x_create_bitmap_mask, define_image_type, valid_image_p)
+ (struct image_keyword, parse_image_spec, image_spec_value)
+ (check_image_size, image_background)
+ (image_background_transparent, x_clear_image_1)
+ (postprocess_image, lookup_image, x_check_image_size)
+ (x_create_x_image_and_pixmap, xbm_image_p)
+ (Create_Pixmap_From_Bitmap_Data, xbm_read_bitmap_data)
+ (xbm_load_image, xbm_file_p, xbm_load, xpm_lookup_color)
+ (init_xpm_functions, xpm_valid_color_symbols_p, xpm_image_p)
+ (xpm_load, xpm_load_image, lookup_rgb_color, lookup_pixel_color)
+ (x_to_xcolors, x_build_heuristic_mask, pbm_image_p, pbm_load)
+ (png_image_p, init_png_functions, png_load_body, png_load)
+ (jpeg_image_p, init_jpeg_functions, jpeg_load_body, jpeg_load)
+ (tiff_image_p, init_tiff_functions, tiff_load, gif_image_p)
+ (init_gif_functions, gif_load, imagemagick_image_p)
+ (imagemagick_load_image, imagemagick_load, svg_image_p)
+ (init_svg_functions, svg_load, svg_load_image, gs_image_p)
+ (gs_load):
+ * nsimage.m (ns_load_image):
+ * nsterm.m (ns_defined_color):
+ * xfaces.c (tty_lookup_color, tty_defined_color, defined_color):
+ * xfns.c (x_defined_color):
+ * xterm.c (x_alloc_lighter_color_for_widget)
+ (x_alloc_nearest_color_1, x_alloc_nearest_color)
+ (x_alloc_lighter_color):
+ * indent.c (disptab_matches_widthtab, current_column)
+ (scan_for_column, string_display_width, indented_beyond_p)
+ (compute_motion, vmotion, Fvertical_motion):
+ Use bool for booleans.
+
+2012-09-24 Chong Yidong <cyd@gnu.org>
+
+ * chartab.c (Fset_char_table_default): Obsolete function removed.
+
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Move pid_t related decls out of lisp.h.
+ * lisp.h, syswait.h (record_child_status_change, wait_for_termination)
+ (interruptible_wait_for_termination):
+ Move these decls from lisp.h to syswait.h, since they use pid_t.
+ Needed on FreeBSD; see Herbert J. Skuhra in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00571.html>.
+ * callproc.c: Include syswait.h.
+
+ gnutls.c, gtkutil.c: Use bool for boolean.
+ * gnutls.c (gnutls_global_initialized, init_gnutls_functions)
+ (emacs_gnutls_handle_error):
+ * gtkutil.c (xg_check_special_colors, xg_prepare_tooltip)
+ (xg_hide_tooltip, xg_create_frame_widgets)
+ (create_dialog, xg_uses_old_file_dialog)
+ (xg_get_file_with_chooser, xg_get_file_with_selection)
+ (xg_get_file_name, xg_have_tear_offs, create_menus, xg_create_widget)
+ (xg_item_label_same_p, xg_update_menubar)
+ (xg_modify_menubar_widgets, xg_event_is_for_menubar)
+ (xg_ignore_gtk_scrollbar, xg_set_toolkit_scroll_bar_thumb)
+ (xg_event_is_for_scrollbar, xg_pack_tool_bar, xg_make_tool_item)
+ (is_box_type, xg_tool_item_stale_p, xg_update_tool_bar_sizes)
+ (update_frame_tool_bar, free_frame_tool_bar):
+ * gtkutil.c, w32term.c, xterm.c (x_wm_set_size_hint):
+ * nsmenu.m (ns_update_menubar):
+ * nsmenu.m, w32menu.c, xmenu.c (set_frame_menubar):
+ * xfns.c (Fx_show_tip) [USE_GTK]:
+ Use bool for boolean.
+ * gtkutil.c (xg_update_frame_menubar):
+ * xmenu.c (update_frame_menubar):
+ Return void, not int, since caller ignores return value.
+ * gtkutil.c (xg_change_toolbar_position):
+ Return void, not 1.
+
+2012-09-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (BLOCKINPUT_H): Remove.
+ (SYSSIGNAL_H): New macro.
+ ($(BLD)/alloc.$(O), $(BLD)/atimer.$(O), $(BLD)/buffer.$(O))
+ ($(BLD)/callproc.$(O), $(BLD)/data.$(O), $(BLD)/dired.$(O))
+ ($(BLD)/dispnew.$(O), $(BLD)/editfns.$(O), $(BLD)/emacs.$(O))
+ ($(BLD)/eval.$(O), $(BLD)/fileio.$(O), $(BLD)/floatfns.$(O))
+ ($(BLD)/fns.$(O), $(BLD)/fontset.$(O), $(BLD)/frame.$(O))
+ ($(BLD)/fringe.$(O), $(BLD)/image.$(O), $(BLD)/insdel.$(O))
+ ($(BLD)/keyboard.$(O), $(BLD)/keymap.$(O), $(BLD)/lread.$(O))
+ ($(BLD)/menu.$(O), $(BLD)/w32inevt.$(O), $(BLD)/w32proc.$(O))
+ ($(BLD)/print.$(O), $(BLD)/process.$(O), $(BLD)/ralloc.$(O))
+ ($(BLD)/search.$(O), $(BLD)/sound.$(O), $(BLD)/sysdep.$(O))
+ ($(BLD)/term.$(O), $(BLD)/window.$(O), $(BLD)/xdisp.$(O))
+ ($(BLD)/xfaces.$(O), $(BLD)/w32fns.$(O), $(BLD)/w32menu.$(O))
+ ($(BLD)/w32term.$(O), $(BLD)/w32select.$(O), $(BLD)/w32reg.$(O))
+ ($(BLD)/w32xfns.$(O)): Update dependencies.
+
+2012-09-23 Eli Zaretskii <eliz@gnu.org>
+
+ * .gdbinit: Set breakpoint on terminate_due_to_signal, not on
+ fatal_error_backtrace.
+
+ * w32proc.c (sys_kill): Undo last change: don't do anything when
+ invoked to deliver SIGABRT to our own process. This is now
+ handled by emacs_raise.
+
+2012-09-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32term.c (w32_read_socket): Remove leftover reference to
+ interrupt_input_pending.
+
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not use SA_NODEFER.
+ Problem reported by Dani Moncayo in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00557.html>.
+ * alloc.c (die):
+ * sysdep.c (emacs_abort): Do not reset signal handler.
+ * emacs.c (terminate_due_to_signal): Reset signal handler here.
+ * sysdep.c (init_signals): Do not use SA_NODEFER. It wasn't
+ wanted even on POSIXish hosts, and it doesn't work on Windows.
+
+2012-09-23 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xterm.c (x_term_init): Call fixup_locale before and after calling
+ gtk_init (Bug#12392).
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * w32.c (w32_delayed_load): Remove LIBRARIES argument; always use
+ Vdynamic_library_alist.
+
+ * gnutls.c (init_gnutls_functions): Caller changed; remove arg.
+ (Fgnutls_available_p): Caller changed.
+
+ * xml.c (init_libxml2_functions, Flibxml_parse_html_region)
+ (Flibxml_parse_xml_region): Likewise.
+
+ * dispextern.h (struct image_type): Remove arg from init function.
+
+ * image.c (Finit_image_library, lookup_image_type)
+ (define_image_type): Remove now-unneeded second arg.
+ (init_xpm_functions, init_png_functions, init_jpeg_functions)
+ (init_tiff_functions, init_gif_functions, init_svg_functions):
+ Arglist and w32_delayed_load calling convention changed.
+ (gs_type): Remove init_gs_functions; there is no such function.
+ (valid_image_p, make_image): Fix caller to lookup_image_type.
+
+2012-09-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify and avoid signal-handling races (Bug#12471).
+ * alloc.c (die):
+ * sysdep.c (emacs_abort) [HAVE_NTGUI]:
+ Avoid recursive loop if there's a fatal error in the function itself.
+ * atimer.c (pending_atimers):
+ * blockinput.h: Don't include "atimer.h"; no longer needed.
+ (interrupt_input_pending): Remove. All uses removed.
+ pending_signals now counts both atimers and ordinary interrupts.
+ This is less racy than having three separate pending-signal flags.
+ (block_input, unblock_input, totally_unblock_input, unblock_input_to)
+ (input_blocked_p):
+ Rename from their upper-case counterparts BLOCK_INPUT,
+ UNBLOCK_INPUT, TOTALLY_UNBLOCK_INPUT, UNBLOCK_INPUT_TO,
+ INPUT_BLOCKED_P, and turn into functions. All uses changed.
+ This makes it easier to access volatile variables more accurately.
+ (BLOCK_INPUT_RESIGNAL): Remove. All uses replaced by unblock_input ().
+ (input_blocked_p): Prefer this to 'interrupt_input_blocked', as
+ that's more reliable if the code is buggy and sets
+ interrupt_input_blocked to a negative value. All uses changed.
+ * atimer.c (deliver_alarm_signal):
+ Remove. No need to deliver this to the parent; any thread can
+ handle this signal now. All uses replaced by underlying handler.
+ * atimer.c (turn_on_atimers):
+ * dispnew.c (handle_window_change_signal):
+ * emacs.c (handle_danger_signal):
+ * keyboard.c (kbd_buffer_get_event):
+ Don't reestablish signal handler; not needed with sigaction.
+ * blockinput.h (UNBLOCK_INPUT_TO, TOTALLY_UNBLOCK_INPUT)
+ (UNBLOCK_INPUT_TO):
+ Rework to avoid unnecessary accesses to volatile variables.
+ (UNBLOCK_INPUT_TO): Now a function.
+ (totally_unblock_input, unblock_input): New decls.
+ * data.c (handle_arith_signal, deliver_arith_signal): Move to sysdep.c
+ (init_data): Remove. Necessary stuff now done in init_signal.
+ * emacs.c, xdisp.c: Include "atimer.h", since we invoke atimer functions.
+ * emacs.c (handle_fatal_signal, deliver_fatal_signal): Move to sysdep.c.
+ (fatal_error_code): Remove; no longer needed.
+ (terminate_due_to_signal): Rename from fatal_error_backtrace, since
+ it doesn't always backtrace. All uses changed. No need to reset
+ signal to default, since sigaction and/or die does that for us now.
+ Use emacs_raise (FOO), not kill (getpid (), FOO).
+ (main): Check more-accurately whether we're dumping.
+ Move fatal-error setup to sysdep.c
+ * floatfns.c: Do not include "syssignal.h"; no longer needed.
+ * gtkutil.c (xg_get_file_name, xg_get_font):
+ Remove no-longer-needed signal-mask manipulation.
+ * keyboard.c, process.c (POLL_FOR_INPUT):
+ Don't depend on USE_ASYNC_EVENTS, a symbol that is never defined.
+ * keyboard.c (read_avail_input): Remove.
+ All uses replaced by gobble_input.
+ (Ftop_level): Use TOTALLY_UNBLOCK_INPUT rather than open code.
+ (kbd_buffer_store_event_hold, gobble_input):
+ (record_asynch_buffer_change) [USABLE_SIGIO]:
+ (store_user_signal_events):
+ No need to mess with signal mask.
+ (gobble_input): If blocking input and there are terminals, simply
+ set pending_signals to 1 and return. All hooks changed to not
+ worry about whether input is blocked.
+ (process_pending_signals): Clear pending_signals before processing
+ them, in case a signal comes in while we're processing.
+ By convention callers now test pending_signals before calling us.
+ (UNBLOCK_INPUT_TO, unblock_input, totally_unblock_input):
+ New functions, to support changes to blockinput.h.
+ (handle_input_available_signal): Now extern.
+ (reinvoke_input_signal): Remove. All uses replaced by
+ handle_async_input.
+ (quit_count): Now volatile, since a signal handler uses it.
+ (handle_interrupt): Now takes bool IN_SIGNAL_HANDLER as arg.
+ All callers changed. Block SIGINT only if not already blocked.
+ Clear sigmask reliably, even if Fsignal returns, which it can.
+ Omit unnecessary accesses to volatile var.
+ (quit_throw_to_read_char): No need to restore sigmask.
+ * keyboard.c (gobble_input, handle_user_signal):
+ * process.c (wait_reading_process_output):
+ Call signal-handling code rather than killing ourselves.
+ * lisp.h: Include <float.h>, for...
+ (IEEE_FLOATING_POINT): New macro, moved here to avoid duplication.
+ (pending_signals): Now volatile.
+ (syms_of_data): Now const if IEEE floating point.
+ (handle_input_available_signal) [USABLE_SIGIO]:
+ (terminate_due_to_signal, record_child_status_change): New decls.
+ * process.c (create_process): Avoid disaster if memory is exhausted
+ while we're processing a vfork, by tightening the critical section
+ around the vfork.
+ (send_process_frame, process_sent_to, handle_pipe_signal)
+ (deliver_pipe_signal): Remove. No longer needed, as Emacs now
+ ignores SIGPIPE.
+ (send_process): No need for setjmp/longjmp any more, since the
+ SIGPIPE stuff is now gone. Instead, report an error if errno
+ is EPIPE.
+ (record_child_status_change): Now extern. PID and W are now args.
+ Return void, not bool. All callers changed.
+ * sysdep.c (wait_debugging) [(BSD_SYSTEM || HPUX) && !defined (__GNU__)]:
+ Remove. All uses removed. This bug should be fixed now in a
+ different way.
+ (wait_for_termination_1): Use waitpid rather than sigsuspend,
+ and record the child status change directly. This avoids the
+ need to futz with the signal mask.
+ (process_fatal_action): Move here from emacs.c.
+ (emacs_sigaction_flags): New function, containing
+ much of what used to be in emacs_sigaction_init.
+ (emacs_sigaction_init): Use it. Block nonfatal system signals that are
+ caught by emacs, to make races less likely.
+ (deliver_process_signal): Rename from handle_on_main_thread.
+ All uses changed.
+ (BACKTRACE_LIMIT_MAX): Now at top level.
+ (thread_backtrace_buffer, threadback_backtrace_pointers):
+ New static vars.
+ (deliver_thread_signal, deliver_fatal_thread_signal):
+ New functions, for more-accurate delivery of thread-specific signals.
+ (handle_fatal_signal, deliver_fatal_signal): Move here from emacs.c.
+ (deliver_arith_signal): Handle in this thread, not
+ in the main thread, since it's triggered by this thread.
+ (maybe_fatal_sig): New function.
+ (init_signals): New arg DUMPING so that we can be more accurate
+ about whether we're dumping. Caller changed.
+ Treat thread-specific signals differently from process-general signals.
+ Block all signals while handling fatal error; that's safer.
+ xsignal from SIGFPE only on non-IEEE hosts, treating it as fatal
+ on IEEE hosts.
+ When batch, ignore SIGHUP, SIGINT, SIGTERM if they were already ignored.
+ Ignore SIGPIPE unless batch.
+ (emacs_backtrace): Output backtrace for the appropriate thread,
+ which is not necessarily the main thread.
+ * syssignal.h: Include <stdbool.h>.
+ (emacs_raise): New macro.
+ * xterm.c (x_connection_signal): Remove; no longer needed
+ now that we use sigaction.
+ (x_connection_closed): No need to mess with sigmask now.
+ (x_initialize): No need to reset SIGPIPE handler here, since
+ init_signals does this for us now.
+
+2012-09-23 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_dumpglyphs_image): dr is a new rect to draw image into,
+ background rect may be larger (Bug#12245).
+
+2012-09-23 Chong Yidong <cyd@gnu.org>
+
+ * keyboard.c (timer_check): Avoid quitting during Fcopy_sequence.
+
+2012-09-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * .gdbinit: Just stop at fatal_error_backtrace.
+ See Stefan Monnier's request in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00549.html>.
+ Remove no-longer-used query of system type.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * search.c (Freplace_match): Doc fix (Bug#12325).
+
+ * minibuf.c (Finternal_complete_buffer): Doc fix (Bug#12391).
+
+ * editfns.c (Fline_beginning_position): Doc fix (Bug#12416).
+ (Fline_end_position): Doc fix.
+
+ * cmds.c (Fforward_char, Fbackward_char): Doc fix (Bug#12414).
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * dispextern.h (struct image_type): Add new slot, storing a type
+ initialization function.
+
+ * image.c (define_image_type): Call the image initializer function
+ if it is defined. Arguments and return value changed.
+ (valid_image_p, make_image): Callers changed.
+ (xbm_type, xpm_type, pbm_type, png_type, jpeg_type, tiff_type)
+ (gif_type, imagemagick_type, svg_type, gs_type):
+ Add initialization functions.
+ (Finit_image_library): Call lookup_image_type.
+ (CHECK_LIB_AVAILABLE): Macro deleted.
+ (lookup_image_type): Call define_image_type here, rather than via
+ Finit_image_library, and without using CHECK_LIB_AVAILABLE.
+ (syms_of_image): Move define_image_type calls for xbm_type and
+ pbm_type to lookup_image_type.
+
+2012-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (timer_check_2): Move calculation of 'timers' and
+ 'idle_timers' from here ...
+ (timer_check): ... to here. Use Fcopy_sequence to copy the timer
+ lists, to avoid infloops when the timer does something stupid,
+ like reinvoke itself with the same or smaller time-out.
+ (Bug#12447)
+
+2012-09-22 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fsplit_window_internal): Handle only Qt value of
+ Vwindow_combination_limit separately.
+ (Qtemp_buffer_resize): New symbol.
+ (Vwindow_combination_limit): New default value.
+ Rewrite doc-string.
+
+2012-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (next_overlay_string): Initialize it->end_charpos for
+ the new overlay string. (Bug#10159)
+
+2012-09-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs.c (shut_down_emacs): Don't assume stderr is buffered,
+ or that fprintf is async-signal-safe. POSIX doesn't require
+ either assumption.
+
+2012-09-22 Chong Yidong <cyd@gnu.org>
+
+ * buffer.c (Fset_buffer_modified_p): Handle indirect buffers
+ (Bug#8207).
+
+2012-09-22 Kenichi Handa <handa@gnu.org>
+
+ * composite.c (composition_reseat_it): Handle the case that a
+ grapheme cluster is not covered by a single font (Bug#12352).
+
2012-09-21 Chong Yidong <cyd@gnu.org>
* image.c (define_image_type): Avoid adding duplicate types to
image_types (Bug#12463). Suggested by Jörg Walter.
-2012-09-20 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+2012-09-21 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* unexmacosx.c: Define LC_DATA_IN_CODE if not defined.
(print_load_command_name): Add case LC_DATA_IN_CODE.
(dump_it) [LC_DATA_IN_CODE]: Call copy_linkedit_data.
-2012-09-18 Glenn Morris <rgm@gnu.org>
+2012-09-21 Glenn Morris <rgm@gnu.org>
* eval.c (Frun_hook_with_args_until_success)
(Frun_hook_with_args_until_failure): Doc fixes. (Bug#12393)
-2012-09-14 Andreas Schwab <schwab@linux-m68k.org>
+2012-09-21 Andreas Schwab <schwab@linux-m68k.org>
* fileio.c (Ffile_selinux_context): Only call freecon when
lgetfilecon succeeded.
(Fset_file_selinux_context): Likewise. (Bug#12444)
-2012-09-12 Eli Zaretskii <eliz@gnu.org>
+2012-09-21 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (try_window_reusing_current_matrix): Under bidi
reordering, locate the cursor by calling set_cursor_from_row; if
(compute_stop_pos_backwards): Fix a typo that caused crashes while
scrolling through multibyte text.
-2012-09-12 Jan Djärv <jan.h.d@swipnet.se>
+2012-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
- * gtkutil.c (x_wm_set_size_hint): Use 1 col for base_width so it
- does not become zero (Bug#12234). Backport from trunk.
+ * alloc.c (mark_object) <PVEC_WINDOW>: Mark prev/next_buffers *after*
+ calling mark_vectorlike since that's the one that marks the window.
+ (mark_discard_killed_buffers): Mark the final cdr.
+ * window.h (struct window): Move prev/next_buffers to the
+ non-standard fields.
+ * window.c (make_window): Initialize prev/next_buffers manually.
+
+2012-09-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Omit unused arg EXPECTED from socket hooks.
+ * keyboard.c (gobble_input, read_avail_input, tty_read_avail_input):
+ * nsterm.m (ns_term_init):
+ * termhooks.h (struct terminal.read_socket_hook):
+ * w32inevt.c (w32_console_read_socket):
+ * w32term.c (w32_read_socket):
+ * xterm.c (XTread_socket):
+ Omit unused arg EXPECTED. All callers changed.
+ (store_user_signal_events): Return void, not int, since callers no
+ longer care about the return value. All uses changed.
+
+2012-09-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32gui.h (XParseGeometry): Do not declare.
+
+2012-09-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * w32inevt.c (w32_console_read_socket): Return -1 on failure, not 0.
+ Ignore 'expected'. See Eli Zaretskii in
+ <http://bugs.gnu.org/12471#8> (last line).
+
+ * frame.c (read_integer): Remove. All uses replaced by strtol/strtoul.
+ (XParseGeometry): Now static. Substitute extremal values for
+ values that are out of range.
+
+2012-09-19 Jan Djärv <jan.h.d@swipnet.se>
+
+ * w32xfns.c (read_integer, XParseGeometry): Move to frame.c.
+
+ * nsfns.m (XParseGeometry): Remove.
+ (Fx_create_frame): Call x_set_offset to correctly interpret
+ top_pos in geometry.
+
+ * frame.c (read_integer, XParseGeometry): Move from w32xfns.c.
+ (Fx_parse_geometry): If there is a space in string, call
+ Qns_parse_geometry, otherwise do as on other terms (Bug#12368).
+
+2012-09-17 Eli Zaretskii <eliz@gnu.org>
+
+ * search.c (scan_buffer): Use character positions in calls to
+ region_cache_forward and region_cache_backward, not byte
+ positions. (Bug#12196)
+
+ * w32term.c (w32_read_socket): Set pending_signals to 1, like
+ xterm.c does. Reported by Daniel Colascione <dancol@dancol.org>.
+
+ * ralloc.c (r_alloc_init) [!SYSTEM_MALLOC]: Initialize
+ __malloc_extra_blocks to 32 instead of 64, like alloc.c did in
+ emacs_blocked_malloc, now deleted.
+
+2012-09-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-needed Solaris 2.4 vfork bug workaround.
+ The workaround was for improving performance on Solaris 2.4, but
+ is getting in the way now. Emacs will still work if someone is
+ still running Solaris 2.4 in a museum somewhere; Sun dropped
+ support for Solaris 2.4 in 2003.
+ * callproc.c (Fcall_process) [HAVE_WORKING_VFORK]:
+ * process.c (create_process) [HAVE_WORKING_VFORK]:
+ Omit now-unnecessary workaround for the Solaris 2.4 vfork bug,
+ since Emacs no longer uses vfork on that platform.
+
+2012-09-17 Glenn Morris <rgm@gnu.org>
+
+ * emacs.c: Use COPYRIGHT.
+
+2012-09-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove configure's --without-sync-input option (Bug#12450).
+ When auditing signal-handling in preparation for cleaning it up,
+ I found that SYNC_INPUT has race conditions and would be a real
+ pain to fix. Since it's an undocumented and deprecated
+ configure-time option, now seems like a good time to remove it.
+ Also see <http://bugs.gnu.org/11080#16>.
+ * alloc.c (_bytes_used, __malloc_extra_blocks, _malloc_internal)
+ (_free_internal) [!DOUG_LEA_MALLOC]: Remove decls.
+ (alloc_mutex) [!SYSTEM_MALLOC && !SYNC_INPUT && HAVE_PTHREAD]:
+ (malloc_hysteresis):
+ (check_depth) [XMALLOC_OVERRUN_CHECK]:
+ (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT):
+ (__malloc_hook, __realloc_hook, __free_hook, BYTES_USED)
+ (dont_register_blocks, bytes_used_when_reconsidered)
+ (bytes_used_when_full, emacs_blocked_free, emacs_blocked_malloc)
+ (emacs_blocked_realloc, reset_malloc_hooks, uninterrupt_malloc):
+ [!SYSTEM_MALLOC && !SYNC_INPUT]:
+ Remove. All uses removed.
+ (MALLOC_BLOCK_INPUT, MALLOC_UNBLOCK_INPUT): Use a different
+ implementation, one that depends on whether the new macro
+ XMALLOC_BLOCK_INPUT_CHECK is defined, not on whether SYNC_INPUT
+ is defined.
+ * atimer.c (run_timers, handle_alarm_signal):
+ * keyboard.c (pending_signal, poll_for_input_1, poll_for_input)
+ (handle_async_input, process_pending_signals)
+ (handle_input_available_signal, init_keyboard):
+ * nsterm.m (ns_read_socket):
+ * process.c (wait_reading_process_output):
+ * regex.c (immediate_quit, IMMEDIATE_QUIT_CHECK):
+ * sysdep.c (emacs_sigaction_init) [SA_RESTART]:
+ (emacs_write):
+ * xterm.c (XTread_socket):
+ Assume SYNC_INPUT.
+ * conf_post.h (SA_RESTART) [IRIX6_5]: Do not #undef.
+ * eval.c (handling_signal): Remove. All uses removed.
+ * lisp.h (ELSE_PENDING_SIGNALS): Remove.
+ All uses replaced with the SYNC_INPUT version.
+ (reset_malloc_hooks, uninterrupt_malloc, handling_signal):
+ Remove decls.
+ * sysdep.c, syssignal.h (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ Now static.
+
+ * font.c (Ffont_shape_gstring): Remove unused local.
+
+2012-09-16 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (clean): No longer run nextstep's clean.
+
+ * Makefile.in (ns_appdir, ns_appbindir, ns_appsrc): Remove variables.
+ (ns_frag): Remove.
+ (ns-app): Move here from ns.mk, and simplify.
+ (clean): Simplify nextstep entry.
+ * ns.mk: Remove file.
+
+2012-09-17 Kenichi Handa <handa@gnu.org>
+
+ * font.c (Ffont_shape_gstring): Fix previous change; GLYPHs may
+ not covert the last few charactes.
+
+2012-09-16 Kenichi Handa <handa@gnu.org>
+
+ * font.c (Ffont_shape_gstring): Don't adjust grapheme cluster
+ here, but just check the validity of glyphs in the glyph-string.
+
+2012-09-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fwindow_parameter, Fset_window_parameter):
+ Accept any window as argument (Bug#12452).
+
+2012-09-16 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfns.m (Fx_open_connection): Move initialization of ns_*_types
+ to ns_term_init to avoid memory leak.
+
+ * nsterm.m (ns_update_begin): Initialize bp after lcokFocus, use
+ explicit retain/release.
+ (ns_term_init): Only allow one display. Initialize outerpool and
+ ns_*_types.
+
+2012-09-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port _setjmp fix to POSIXish hosts as well as Microsoft.
+ * image.c (_setjmp) [!HAVE__SETJMP]: Restore definition, as
+ it's needed on POSIXish hosts that lack _setjmp. Attempt to solve
+ the Microsoft problem in a different way, by altering ../nt/config.nt.
+
+2012-09-15 Eli Zaretskii <eliz@gnu.org>
+
+ * w32xfns.c:
+ * w32uniscribe.c:
+ * w32term.c:
+ * w32select.c:
+ * w32reg.c:
+ * w32proc.c:
+ * w32menu.c:
+ * w32inevt.c:
+ * w32heap.c:
+ * w32font.c:
+ * w32fns.c:
+ * w32console.c:
+ * w32.c:
+ * w16select.c: Remove inclusion of setjmp.h, as it is now included
+ by lisp.h. This completes removal of setjmp.h inclusion
+ erroneously announced in the previous commit. (Bug#12446)
+
+ * lisp.h [!HAVE__SETJMP, !HAVE_SIGSETJMP]: Make the commentary
+ more accurate.
+
+ * image.c (_setjmp) [!HAVE__SETJMP]: Define only if 'setjmp' is
+ not defined as a macro. The latter happens on MS-Windows.
+ (Bug#12446)
+
+2012-09-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port better to POSIX hosts lacking _setjmp (Bug#12446).
+ * lisp.h: Include <setjmp.h> here, since we use its symbols here.
+ Some instances of '#include <setjmp.h>' removed, if the
+ only reason for the instance was because "lisp.h" was included.
+ (sys_jmp_buf, sys_setjmp, sys_longjmp): New symbols.
+ Unless otherwise specified, replace all uses of jmp_buf, _setjmp,
+ and _longjmp with the new symbols. Emacs already uses _setjmp if
+ available, so this change affects only POSIXish hosts that have
+ sigsetjmp but not _setjmp, such as some versions of Solaris and
+ Unixware. (Also, POSIX-2008 marks _setjmp as obsolescent.)
+ * image.c (_setjmp, _longjmp) [HAVE_PNG && !HAVE__SETJMP]: New macros.
+ (png_load_body) [HAVE_PNG]:
+ (PNG_LONGJMP) [HAVE_PNG && PNG_LIBPNG_VER < 10500]:
+ (PNG_JMPBUF) [HAVE_PNG && PNG_LIBPNG_VER >= 10500]:
+ Use _setjmp and _longjmp rather than sys_setjmp and sys_longjmp,
+ since PNG requires jmp_buf. This is the only exception to the
+ general rule that we now use sys_setjmp and sys_longjmp.
+ This exception is OK since this code does not change the signal
+ mask or longjmp out of a signal handler.
+
+2012-09-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c [!SYSTEM_MALLOC && !SYNC_INPUT && HAVE_PTHREAD]:
+ Include "syssignal.h", for 'main_thread'.
+
+2012-09-14 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid out-of-range marker position (Bug#12426).
+ * insdel.c (replace_range, replace_range_2):
+ Adjust markers before overlays, as suggested by comments.
+ (insert_1_both, insert_from_buffer_1, adjust_after_replace):
+ Remove redundant check before calling offset_intervals.
+
+2012-09-14 Martin Rudalics <rudalics@gmx.at>
+
+ * xdisp.c (Fformat_mode_line): Unconditionally save/restore
+ current buffer (Bug#12387).
+
+2012-09-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/alloc.$(O)): Update dependencies.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use a more backwards-compatible timer format (Bug#12430).
+ * keyboard.c (decode_timer): Get PSECS from the 8th (origin-0)
+ vector element, not from the 4th, since PSECS is now at the end.
+ (Fcurrent_idle_time): Doc fix.
+
+2012-09-13 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Function to mark objects and remove killed buffers at once.
+ * alloc.c (discard_killed_buffers): Rename to ...
+ (mark_discard_killed buffers) ... new name. Add marking
+ of remaining objects. Fix comment. Adjust users.
+ (mark_object): Do not touch frame buffer lists here.
+ * frame.c (delete_frame): Reset frame buffer lists here.
+
+2012-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better workaround for GNOME bug when --enable-gcc-warnings.
+ * emacsgtkfixed.c (G_STATIC_ASSERT): Remove, undoing last change.
+ Instead, disable -Wunused-local-typedefs. See Dmitry Antipov in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00335.html>.
+
+ Simplify SIGIO usage (Bug#12408).
+ The code that dealt with SIGIO was crufty and confusing, e.g., it
+ played tricks like "#undef SIGIO" but these tricks were not used
+ consistently. Simplify mostly by not #undeffing standard symbols,
+ e.g., use "defined USABLE_SIGIO" (our symbol, which we can define
+ or not as we please) rather than "defined SIGIO" (standard symbol
+ that we probably shouldn't #undef).
+ * conf_post.h [USG5_4]: Do not include <sys/wait.h> here.
+ Modules that need it can include it.
+ [USG5_4 && emacs]: Likewise, do not include the streams stuff here.
+ * dispextern.h (ignore_sigio): New decl.
+ * emacs.c (shut_down_emacs): Invoke unrequest_sigio
+ unconditionally, since it's now a no-op if !USABLE_SIGIO.
+ * emacs.c (shut_down_emacs):
+ * keyboard.c (kbd_buffer_store_event_hold):
+ Use ignore_sigio rather than invoking 'signal' directly.
+ * keyboard.c (USABLE_FIONREAD && USG5_4): Include <sys/filio.h>,
+ for FIONREAD.
+ (FIONREAD, SIGIO): Do not #undef.
+ (tty_read_avail_input): Use #error rather than a syntax error.
+ * process.c [USG5_4]: Include <sys/stream.h> and <sys/stropts.h>,
+ for I_PIPE, used by SETUP_SLAVE_PTY.
+ (DATAGRAM_SOCKETS): Simplify defn, based on USABLE_FIONREAD.
+ * sysdep.c (croak): Remove; no longer needed. This bit of
+ temporary code, with Fred N. Fish's comment that it's temporary,
+ has been in Emacs since at least 1992!
+ (init_sigio, reset_sigio, request_sigio, unrequest_sigio):
+ Arrange for them to be no-ops in all cases when ! USABLE_SIGIO.
+ * syssignal.h (croak): Remove decl.
+ (SIGIO, SIGPOO, SIGAIO, SIGPTY): Do not #undef; that's too fragile.
+ * systty.h [!NO_TERMIO]: Do not include <termio.h>; no longer needed
+ now that we're termios-only.
+ (FIONREAD, ASYNC) [BROKEN_FIONREAD]: Do not #undef.
+ * term.c (dissociate_if_controlling_tty): Use #error rather than
+ a run-time error.
+
+ Work around GCC and GNOME bugs when --enable-gcc-warnings.
+ * emacsgtkfixed.c (G_STATIC_ASSERT): Redefine to use 'verify',
+ to work around GNOME bug 683906.
+ * image.c (jpeg_load_body) [HAVE_JPEG && lint]: Pacify gcc -Wclobber.
+ (struct my_jpeg_error_mgr) [HAVE_JPEG && lint]: New member fp.
+ This works around GCC bug 54561.
+
+2012-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ More fixes for 'volatile' and setjmp/longjmp.
+ * eval.c (Fdefvar, Fcondition_case): Remove unnecessary 'volatile's.
+ * image.c (struct png_load_context) [HAVE_PNG]: New type.
+ (png_load_body) [HAVE_PNG]:
+ (jpeg_load_body) [HAVE_JPEG]:
+ New function, with most of the old parent function's body.
+ (png_load) [HAVE_PNG]:
+ (jpeg_load) [HAVE_JPEG]:
+ Invoke the new function, to avoid longjmp munging our locals.
+ (struct my_jpeg_error_mgr) [HAVE_JPEG]: New members cinfo, failure_code.
+ (my_error_exit) [HAVE_JPEG]: Don't trust 'setjmp' to return 2 when
+ longjmp is passed 2, as the C standard doesn't guarantee this.
+ Instead, store the failure code into mgr->failure_code.
+
+2012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keyboard.c (read_char, requeued_events_pending_p, Finput_pending_p)
+ (Fdiscard_input, quit_throw_to_read_char, init_keyboard)
+ (syms_of_keyboard): Remove support for unread-command-char.
+
+2012-09-12 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (sys_kill): If PID is our process ID and the signal is
+ SIGABRT, call emacs_abort. Avoids silently exiting upon assertion
+ violation. (Bug#12426)
+
+2012-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * image.c (jpeg_memory_src): Don't assume string len fits in unsigned.
+
+2012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c: Add `inhibit-debugger'.
+ (Qinhibit_debugger): New symbol.
+ (call_debugger): Bind it instead of Qdebug_on_error.
+ (maybe_call_debugger): Test Vinhibit_debugger.
+ (syms_of_eval): Define inhibit-debugger.
+ * xdisp.c (set_message): Don't bind Qinhibit_debug_on_message.
+ (syms_of_xdisp): Remove inhibit-debug-on-message.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid _setjmp/_longjmp problems with local nonvolatile variables.
+ If a nonvolatile local variable is written before a _longjmp to
+ the frame containing the variable, and is read after the _longjmp,
+ the value read is indeterminate. Some local variables of type
+ 'struct handler' and 'struct catchtag' are used in this way, so
+ mark each of their slots as volatile if the slot can be set before
+ _longjmp and read afterwards.
+ * lisp.h (struct handler): var and chosen_clause are now volatile.
+ (struct catchtag): val, next, and pdlcount are now volatile.
+
+ * bidi.c (bidi_push_it, bidi_pop_it):
+ * fns.c (copy_hash_table):
+ * image.c (define_image_type):
+ * keyboard.c (kbd_buffer_store_event_hold):
+ * process.c (Fprocess_send_eof):
+ * xfaces.c (x_create_gc) [HAVE_NS]:
+ * xgselect.c (xg_select):
+ Prefer assignment to memcpy when either will do.
+
+ * alloc.c (discard_killed_buffers): Tune and simplify a bit.
+ Use pointer-to-a-pointer to simplify and avoid a NILP check each
+ time an item is removed. No need to mark this function 'inline';
+ the compiler knows better than we do.
+
+2012-09-11 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_judge_scroll_bars): Pass NO to updateFrameSize.
+ (updateFrameSize:): Add delay parameter to updateFrameSize, send it
+ to change_frame_size (Bug#12388).
+ (windowDidResize:): Pass YES to updateFrameSize.
+
+ * nsterm.h: Add delay parameter to updateFrameSize.
+
+2012-09-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Discard killed buffers from deleted window and frame objects.
+ This reduces an amount of references to killed buffers and
+ helps GC to reclaim them faster.
+ * alloc.c (discard_killed_buffers): New function.
+ (mark_object): Use it for deleted windows and frames.
+ (mark_object): If symbol's value is set up for a killed buffer
+ or deleted frame, restore it's global binding.
+ * data.c (swap_in_global_binding): Add GC notice.
+ (swap_in_symval_forwarding): Use convenient set_blv_where.
+ * window.c (wset_next_buffers, wset_prev_buffers): Move ...
+ * window.h: ... to here.
+
+2012-09-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Convenient macro to check whether the buffer is live.
+ * buffer.h (BUFFER_LIVE_P): New macro.
+ * alloc.c, buffer.c, editfns.c, insdel.c, lread.c, marker.c:
+ * minibuf.c, print.c, process.c, window.c, xdisp.c: Use it.
+
+2012-09-11 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * xdisp.c (right_overwritten, right_overwriting): Also handle gstring
+ composition cases (Bug#12364).
+
+ * xterm.c (x_draw_glyph_string): Avoid overwriting inverted left
+ overhang of succeeding glyphs overlapping box cursor.
+
+ * w32term.c (x_draw_glyph_string): Likewise.
+
+2012-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify, document, and port floating-point (Bug#12381).
+ The porting part of this patch fixes bugs on non-IEEE platforms
+ with frexp, ldexp, logb.
+ * data.c, lisp.h (Qdomain_error, Qsingularity_error, Qunderflow_error):
+ Now static.
+ * floatfns.c: Simplify discussion of functions that Emacs doesn't
+ support, by removing commented-out code and briefly listing the
+ C89 functions excluded. The commented-out stuff was confusing
+ maintenance, e.g., we thought we needed cbrt but it was commented out.
+ (logb): Remove decl; no longer needed.
+ (isfinite): New macro, if not already supplied.
+ (isnan): Don't replace any existing macro.
+ (Ffrexp, Fldexp): Define even if !HAVE_COPYSIGN, as frexp and ldexp
+ are present on all C89 platforms.
+ (Ffrexp): Do not special-case zero, as frexp does the right thing
+ for that case.
+ (Flogb): Do not use logb, as it doesn't have the desired meaning
+ on hosts that use non-base-2 floating point. Instead, stick with
+ frexp, which is C89 anyway. Do not pass an infinity or a NaN to
+ frexp, to avoid getting an unspecified result.
+
+ * xdisp.c (Qinhibit_debug_on_message): Now static.
+
+2012-09-10 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_update_begin): Set clip path to whole view by using
+ NSBezierPath (Bug#12131).
+
+2012-09-10 Chong Yidong <cyd@gnu.org>
+
+ * fns.c (Fdelq, Fdelete): Doc fix.
+
+2012-09-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (XSETINT, XSETCONS, XSETVECTOR, XSETSTRING, XSETSYMBOL)
+ (XSETFLOAT, XSETMISC): Parenthesize macro bodies.
+
+2012-09-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp.h (make_lisp_ptr): New macro to replace XSET.
+ (XSETCONS, XSETVECTOR, XSETSTRING, XSETSYMBOL, XSETFLOAT, XSETMISC):
+ Use it.
+
+2012-09-09 Eli Zaretskii <eliz@gnu.org>
+
+ * fringe.c (draw_fringe_bitmap_1): Don't reduce the width of the
+ left fringe if the window has a left margin. This avoids leaving
+ traces of the cursor because its leftmost pixel is not drawn over.
+
+ * dispnew.c (update_window_line): When the left margin area of a
+ screen line is updated, set the redraw_fringe_bitmaps_p flag of
+ that screen line. (Bug#12277)
+
+2012-09-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later for math functions (Bug#12381).
+ This simplifies the code, and makes it a bit smaller and faster,
+ and (most important) makes it easier to clean up signal handling
+ since we can stop worring about floating-point exceptions in
+ library code. That was a problem before C89, but the problem
+ went away many years ago on all practical Emacs targets.
+ * data.c, image.c, lread.c, print.c:
+ Don't include <math.h>; no longer needed.
+ * data.c, floatfns.c (IEEE_FLOATING_POINT): Don't worry that it
+ might be autoconfigured, as that never happens.
+ * data.c (fmod):
+ * doprnt.c (DBL_MAX_10_EXP):
+ * print.c (DBL_DIG):
+ Remove. C89 or later always defines these.
+ * floatfns.c (HAVE_MATHERR, FLOAT_CHECK_ERRNO, FLOAT_CHECK_DOMAIN)
+ (in_float, float_error_arg, float_error_arg2, float_error_fn_name)
+ (arith_error, domain_error, domain_error2):
+ Remove all this pre-C89 cruft. Do not include <errno.h> as that's
+ no longer needed -- we simply return what C returns. All uses removed.
+ (IN_FLOAT, IN_FLOAT2): Remove. All uses replaced with
+ the wrapped code.
+ (FLOAT_TO_INT, FLOAT_TO_INT2, range_error, range_error2):
+ Remove. All uses expanded, as these macros are no longer used
+ more than once and are now more trouble than they're worth.
+ (Ftan): Use tan, not sin / cos.
+ (Flogb): Assume C89 frexp.
+ (fmod_float): Assume C89 fmod.
+ (matherr) [HAVE_MATHERR]: Remove; no longer needed.
+ (init_floatfns): Remove. All uses removed.
+
+2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_draw_fringe_bitmap, ns_dumpglyphs_image): Take back
+ compositeToPoint for OSX < 10.6 (Bug#12390).
+
+2012-09-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * floatfns.c (Ftan): Use tan (x), not (sin (x) / cos (x)).
+ This produces more-accurate results.
+
+2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (updateFrameSize): Call setFrame: on the view when size
+ changes (Bug#12088).
+
+2012-09-08 Chong Yidong <cyd@gnu.org>
+
+ * syntax.c (Fstring_to_syntax): Doc fix.
+
+2012-09-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_clip_to_row): Remove code that deals with drawing fringe
+ in the internal border.
+ (x_set_window_size): Remove static variables and their usage.
+ (ns_redraw_scroll_bars): Fix NSTRACE arg.
+ (ns_after_update_window_line, ns_draw_fringe_bitmap):
+ Remove fringe/internal border adjustment (Bug#11052).
+ (ns_draw_fringe_bitmap): Make code more like other terms (xterm.c).
+ (ns_draw_window_cursor): Remove fringe/internal border adjustment.
+ (ns_fix_rect_ibw): Remove.
+ (ns_get_glyph_string_clip_rect): Remove call to ns_fix_rect_ibw.
+ (ns_dumpglyphs_box_or_relief): Ditto.
+ (ns_maybe_dumpglyphs_background): Remove fringe/internal border
+ adjustment.
+ (ns_dumpglyphs_image): Ditto.
+ (ns_dumpglyphs_stretch): Fix coding style. Remove fringe/internal
+ border adjustment.
+ (ns_set_vertical_scroll_bar): Remove variables barOnVeryLeft/Right and
+ their usage. Add fringe_extended_p and its use as in other terms.
+ (ns_judge_scroll_bars): Code style fix. Call updateFrameSize if
+ scroll bar was removed.
+ (updateFrameSize): New function.
+ (windowDidResize): Move code to updateFrameSize and call it.
+
+ * nsterm.h (EmacsView): Add updateFrameSize.
+
+2012-09-07 Chong Yidong <cyd@gnu.org>
+
+ * textprop.c (Fget_text_property): Minor doc fix (Bug#12323).
+
+ * data.c (Flocal_variable_if_set_p): Doc fix (Bug#10713).
+
+2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ More signal-handler cleanup (Bug#12327).
+ * emacs.c (main): Convert three 'signal' calls to 'sigaction' calls.
+ Problem introduced when merging patches. Noted by Eli Zaretskii in
+ <http://bugs.gnu.org/12327#67>.
+ * floatfns.c: Comment fix.
+ * lisp.h (force_auto_save_soon): Declare regardless of SIGDANGER.
+ SIGDANGER might not be in scope so "#ifdef SIGDANGER" is not right,
+ and anyway the declaration is harmless even if SIGDANGER is not defined.
+ * syssignal.h (SIGIO): Also #undef if (! defined FIONREAD ||
+ defined BROKEN_FIONREAD). systty.h formerly did this, but other
+ source files not surprisingly expected syssignal.h to define, or
+ not define, SIGIO, and it's cleaner to do it that way, for consistency.
+ Include <sys/ioctl.h>, for FIONREAD.
+ * systty.h (SIGIO): Do not #undef here; it's now syssignal.h's job.
+ This eliminates a problem whereby other files mysteriously had
+ to include "syssignal.h" before including "systty.h" if they
+ wanted to use "#ifdef SIGIO".
+
+2012-09-07 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (sigaction): New function, emulates Posix 'sigaction'.
+
+ * w32.c (sigemptyset): Empty the set.
+ (sigsetmask, sigmask, sigblock, sigunblock): Remove unused functions.
+
+ * alloc.c [ENABLE_CHECKING]: Include signal.h, since we need SIGABRT.
+
+2012-09-07 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (mark_buffer): Revert unsafe marking optimization.
+ (mark_object): Likewise for frame objects.
+
+2012-09-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * syssignal.h (handle_on_main_thread): Always declare,
+ even if FORWARD_SIGNAL_TO_MAIN_THREAD is not defined.
+ This ports to platforms without HAVE_PTHREAD.
+
+2012-09-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Signal-handler cleanup (Bug#12327).
+ Emacs's signal handlers were written in the old 4.2BSD style with
+ sigblock and sigmask and so forth, and this led to some
+ inefficiencies and confusion. Rewrite these to use
+ pthread_sigmask etc. without copying signal sets around. Also,
+ get rid of the confusing macros 'SIGNAL_THREAD_CHECK' and
+ 'signal', and instead use functions that do not attempt to take
+ over the system name space. This patch causes Emacs's text
+ segment to shrink by 0.7% on my platform, Fedora 17 x86-64.
+ * alloc.c, emacsgtkfixed.c, nsfns.m, widget.c, xmenu.c:
+ Do not include <signal.h> or "syssignal.h", as these
+ modules do not use signals.
+ * atimer.c, callproc.c, data.c, dispnew.c, emacs.c, floatfns.c:
+ * gtkutil.c, keyboard.c, process.c, sound.c, sysdep.c, term.c, xterm.c:
+ Do not include <signal.h>, as "syssignal.h" does that for us now.
+ * atimer.c (sigmask_atimers): New function.
+ (block_atimers, unblock_atimers): New functions,
+ replacing the old macros BLOCK_ATIMERS and UNBLOCK_ATIMERS.
+ All uses replaced.
+ * conf_post.h [SIGNAL_H_AHB]: Do not include <signal.h>;
+ no longer needed here.
+ * emacs.c (main): Inspect existing signal handler with sigaction,
+ so that there's no need to block and unblock SIGHUP.
+ * sysdep.c (struct save_signal): New member 'action', replacing
+ old member 'handler'.
+ (save_signal_handlers, restore_signal_handlers):
+ Use sigaction instead of 'signal' to save and restore.
+ (get_set_sighandler, set_sighandler) [!WINDOWSNT]:
+ New function. All users of 'signal' modified to use set_sighandler
+ if they're writeonly, and to use sys_signal if they're read+write.
+ (emacs_sigaction_init, forwarded_signal): New functions.
+ (sys_signal): Remove. All uses replaced by calls to sigaction
+ and emacs_sigaction_init, or by direct calls to 'signal'.
+ (sys_sigmask) [!__GNUC__]: Remove; no longer needed.
+ (sys_sigblock, sys_sigunblock, sys_sigsetmask): Remove;
+ all uses replaced by pthread_sigmask etc. calls.
+ * syssignal.h: Include <signal.h>.
+ (emacs_sigaction_init, forwarded_signal): New decls.
+ (SIGMASKTYPE): Remove. All uses replaced by its definiens, sigset_t.
+ (SIGEMPTYMASK): Remove; all uses replaced by its definiens, empty_mask.
+ (sigmask, sys_sigmask): Remove; no longer needed.
+ (sigpause): Remove. All uses replaced by its definiens, sigsuspend.
+ (sigblock, sigunblock, sigfree):
+ (sigsetmask) [!defined sigsetmask]:
+ Remove. All uses replaced by pthread_sigmask.
+ (signal): Remove. Its remaining uses (with SIG_DFL and SIG_IGN)
+ no longer need to be replaced, and its typical old uses
+ are now done via emacs_sigaction_init and sigaction.
+ (sys_sigblock, sys_sigunblock, sys_sigsetmask): Remove decls.
+ (sys_sigdel): Remove; unused.
+ (NSIG): Remove a FIXME; the code's fine. Remove an unnecessary ifdef.
+
+2012-09-06 Eli Zaretskii <eliz@gnu.org>
+
+ * process.c (CAN_HANDLE_MULTIPLE_CHILDREN): Fix a typo that broke
+ SIGCHLD handling on systems that don't have WNOHANG. (Bug#12327)
+
+2012-09-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Explicitly mark buffer_defaults and buffer_local_symbols.
+ * alloc.c (Fgarbage_collect): Mark buffer_defaults and
+ mark_local_symbols here.
+ (mark_object): If GC_CHECK_MARKED_OBJECTS, simplify checking
+ since special buffers aren't marked here any more.
+ (allocate_buffer): Chain new buffer with all_buffers here...
+ * buffer.c (Fget_buffer_create, Fmake_indirect_buffer): ...and
+ not here.
+ (Vbuffer_defaults, Vbuffer_local_symbols): Remove.
+ (syms_of_buffer): Remove staticpro of the above.
+ (init_buffer_once): Set names for buffer_defaults and
+ buffer_local_symbols.
+
+2012-09-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use bool for booleans in font-related modules.
+ * font.c (font_intern_prop, font_style_to_value)
+ (font_style_symbolic, font_parse_xlfd, font_parse_fcname)
+ (generate_otf_features, font_check_otf_features, font_check_otf)
+ (font_match_p, font_list_entities, font_at):
+ * fontset.c (fontset_id_valid_p, reorder_font_vector
+ (fontset_find_font, Fset_fontset_font)
+ (face_suitable_for_char_p) [0]:
+ * ftfont.c (fc_initialized, ftfont_get_open_type_spec)
+ (ftfont_open, ftfont_text_extents, ftfont_check_otf):
+ (m17n_flt_initialized, ftfont_shape_by_flt):
+ * ftxfont.c (ftxfont_draw_bitmap, ftxfont_draw):
+ * nsfont.m (nsfont_draw):
+ * w32font.c (w32font_draw):
+ * w32term.c (x_draw_glyphless_glyph_string_foreground):
+ Use bool for booleans.
+ * font.h: Adjust to above API changes.
+ (struct font, struct font_driver, struct font_driver_list):
+ Use bool for booleans.
+ (struct font): Remove useless member encoding_type.
+ All users removed.
+ * fontset.c, xftfont.c: Omit unnecessary static decls.
+
+2012-09-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (mark_object): Revert window marking code
+ since it's unsafe for the Fset_window_configuration.
+
+2012-09-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix race conditions with signal handlers and errno (Bug#12327).
+ Be more systematic about preserving errno whenever a signal
+ handler returns, even if it's not in the main thread. Do this by
+ renaming signal handlers to distinguish between signal delivery
+ and signal handling. All uses changed.
+ * atimer.c (deliver_alarm_signal): Rename from alarm_signal_handler.
+ * data.c (deliver_arith_signal): Rename from arith_error.
+ * dispnew.c (deliver_window_change_signal): Rename from
+ window_change_signal.
+ * emacs.c (deliver_error_signal): Rename from fatal_error_signal.
+ (deliver_danger_signal) [SIGDANGER]: Rename from memory_warning_signal.
+ * keyboard.c (deliver_input_available_signal): Rename from
+ input_available_signal.
+ (deliver_user_signal): Rename from handle_user_signal.
+ (deliver_interrupt_signal): Rename from interrupt_signal.
+ * process.c (deliver_pipe_signal): Rename from send_process_trap.
+ (deliver_child_signal): Rename from sigchld_handler.
+ * atimer.c (handle_alarm_signal):
+ * data.c (handle_arith_signal):
+ * dispnew.c (handle_window_change_signal):
+ * emacs.c (handle_fatal_signal, handle_danger_signal):
+ * keyboard.c (handle_input_available_signal):
+ * keyboard.c (handle_user_signal, handle_interrupt_signal):
+ * process.c (handle_pipe_signal, handle_child_signal):
+ New functions, with the actual signal-handling code taken from the
+ original respective signal handlers, sans the sporadic attempts to
+ preserve errno, since that's now done by handle_on_main_thread.
+ * atimer.c (alarm_signal_handler): Remove unnecessary decl.
+ * emacs.c, floatfns.c, lisp.h: Remove unused FLOAT_CATCH_SIGKILL cruft.
+ * emacs.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ Move to sysdep.c.
+ (main) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ Move initialization of main_thread to sysdep.c's init_signals.
+ * process.c (waitpid) [!WNOHANG]: #define to wait; that's good enough for
+ our usage, and simplifies the mainline code.
+ (record_child_status_change): New static function, as a helper
+ for handle_child_signal, and with most of the old child handler's
+ contents.
+ (CAN_HANDLE_MULTIPLE_CHILDREN): New constant.
+ (handle_child_signal): Use the above.
+ * sysdep.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ Moved here from emacs.c.
+ (init_signals) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Initialize it;
+ code moved here from emacs.c's main function.
+ * sysdep.c, syssignal.h (handle_on_main_thread): New function,
+ replacing the old SIGNAL_THREAD_CHECK. All uses changed.
+ This lets callers save and restore errno properly.
+
+2012-09-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove redundant or unused things here and there.
+ * lisp.h (CYCLE_CHECK, CHAR_TABLE_TRANSLATE): Remove.
+ * conf_post.h (RE_TRANSLATE): Use char_table_translate.
+ * editfns.c (Fcompare_buffer_substrings): Likewise.
+ * frame.h (struct terminal, struct font_driver_list):
+ Remove redundant declarations.
+ * window.h (Qleft, Qright): Likewise.
+
+2012-09-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not mark objects from deleted buffers, windows and frames.
+ * alloc.c (mark_buffer): Mark just the buffer if it is dead.
+ (mark_object): Likewise for windows and frames.
+
+2012-09-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (valid_lisp_object_p): Treat killed buffers,
+ buffer_defaults and buffer_local_symbols as valid objects.
+ Return special value to denote them.
+
+2012-09-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c, filelock.c, floatfns.c, fns.c: Use bool for boolean.
+ * fileio.c (auto_saving, auto_save_error_occurred, make_temp_name)
+ (Fexpand_file_name, barf_or_query_if_file_exists, Fcopy_file)
+ (file_name_absolute_p, Fsubstitute_in_file_name):
+ (check_executable, check_writable, Ffile_accessible_directory_p)
+ (Fset_file_selinux_context, Fdefault_file_modes)
+ (Finsert_file_contents, choose_write_coding_system)
+ (Fwrite_region, build_annotations, a_write, e_write)
+ (Fdo_auto_save):
+ * filelock.c (boot_time_initialized, get_boot_time)
+ (get_boot_time_1, lock_file_1, within_one_second):
+ * floatfns.c (in_float):
+ * fns.c (concat, internal_equal, Frequire, base64_encode_1)
+ (base64_decode_1, cmpfn_eql, cmpfn_user_defined)
+ (sweep_weak_table, sweep_weak_hash_tables, secure_hash):
+ * lisp.h (struct Lisp_Hash_Table.cmpfn):
+ * window.c (compare_window_configurations):
+ Use bool for booleans.
+ * fileio.c (auto_saving_dir_umask, auto_saving_mode_bits)
+ (Fdefault_file_modes): Now mode_t, not int, for modes.
+ (Fdo_auto_save): Set a boolean to 1 rather than using ++.
+ (internal_delete_file): Now returns void, not a (boolean) int,
+ since nobody was looking at the return value.
+ * lisp.h, window.h: Adjust to above API changes.
+
+ * xdisp.c (set_message): Simplify and reindent last change.
+
+2012-09-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/sysdep.$(O)): Update dependencies.
+
+2012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * eval.c (call_debugger): Make the function non-static so that we
+ can call it from set_message.
+
+ * xdisp.c (set_message): Implement the new variable `debug-on-message'.
+ (syms_of_xdisp): Defvar it and `inhibit-debug-on-message'.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Give more-useful info on a fatal error (Bug#12328).
+ * alloc.c [ENABLE_CHECKING]: Do not include <execinfo.h>.
+ (die) [ENABLE_CHECKING]: Call fatal_error_backtrace instead
+ of doing the work ourselves.
+ * emacs.c (fatal_error_signal): Let fatal_error_backtrace
+ do most of the work.
+ (fatal_error_backtrace): New function, taken from the guts
+ of the old fatal_error_signal, but with a new option to output
+ a backtrace.
+ (shut_down_emacs) [!DOS_NT]: Use strsignal to give more-useful
+ info about the signal than just its number.
+ * lisp.h (fatal_error_backtrace, emacs_backtrace): New decls.
+ * sysdep.c: Include <execinfo.h>
+ (emacs_backtrace): New function, taken partly from the previous
+ code of the 'die' function.
+ (emacs_abort): Call fatal_error_backtrace rather than abort.
+
+2012-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lread.c (readevalloop): Call internal-macroexpand-for-load to perform
+ eager (load-time) macro-expansion.
+ * lisp.mk (lisp): Add macroexp.
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify redefinition of 'abort' (Bug#12316).
+ Do not try to redefine the 'abort' function. Instead, redo
+ the code so that it calls 'emacs_abort' rather than 'abort'.
+ This removes the need for the NO_ABORT configure-time macro
+ and makes it easier to change the abort code to do a backtrace.
+ * .gdbinit: Just stop at emacs_abort, not at w32_abort or abort.
+ * emacs.c (abort) [!DOS_NT && !NO_ABORT]:
+ Remove; sysdep.c's emacs_abort now takes its place.
+ * lisp.h (emacs_abort): New decl. All calls from Emacs code to
+ 'abort' changed to use 'emacs_abort'.
+ * msdos.c (dos_abort) [defined abort]: Remove; not used.
+ (abort) [!defined abort]: Rename to ...
+ (emacs_abort): ... new name.
+ * sysdep.c (emacs_abort) [!HAVE_NTGUI]: New function, taking
+ the place of the old 'abort' in emacs.c.
+ * w32.c, w32fns.c (abort): Do not #undef.
+ * w32.c (emacs_abort): Rename from w32_abort.
+
+2012-09-04 Eli Zaretskii <eliz@gnu.org>
+
+ * w32uniscribe.c (uniscribe_shape): Reverse the sign of
+ offsets[j].dv, since the y axis of the screen coordinates points
+ down, while the y axis of the font definition coordinates points
+ up. This fixes display of Arabic diacritics such as KASRA and
+ KASRATAN. (Bug#11860)
+
+2012-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Be more systematic about _setjmp vs setjmp.
+ * alloc.c (test_setjmp, mark_stack):
+ * image.c (PNG_LONGJMP) [PNG_LIBPNG_VER < 10500]:
+ (PNG_JMPBUF) [! (PNG_LIBPNG_VER < 10500)]:
+ (png_load, my_error_exit, jpeg_load):
+ * process.c (send_process_trap, send_process):
+ Uniformly prefer _setjmp and _longjmp to setjmp and longjmp.
+ The underscored versions are up to 30x faster on some hosts.
+ Formerly, the code used setjmp+longjmp sometimes and
+ _setjmp+_longjmp at other times, with no particular reason to
+ prefer setjmp+longjmp.
+
+2012-09-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor problem found by static checking.
+ * buffer.c (Fdelete_all_overlays): Return nil.
+
+2012-09-03 Martin Rudalics <rudalics@gmx.at>
+
+ * buffer.c (Fdelete_all_overlays): New function.
+
+2012-09-03 Chong Yidong <cyd@gnu.org>
+
+ * gtkutil.c: Add extern decl for Qxft.
+
+2012-09-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs.c, eval.c: Use bool for boolean.
+ * emacs.c (initialized, inhibit_window_system, running_asynch_code):
+ (malloc_using_checking) [DOUG_LEA_MALLOC]:
+ (display_arg) [HAVE_X_WINDOWS || HAVE_NS]:
+ (noninteractive, no_site_lisp, fatal_error_in_progress, argmatch)
+ (main, decode_env_path, Fdaemon_initialized):
+ * eval.c (call_debugger, Finteractive_p, interactive_p):
+ (unwind_to_catch, Fsignal, wants_debugger, skip_debugger)
+ (maybe_call_debugger, Fbacktrace):
+ * process.c (read_process_output, exec_sentinel):
+ Use bool for booleans.
+ * emacs.c (shut_down_emacs): Omit unused boolean argument NO_X.
+ All callers changed.
+ * eval.c (interactive_p): Omit always-true boolean argument
+ EXCLUDE_SUBRS_P. All callers changed.
+ * dispextern.h, lisp.h: Reflect above API changes.
+ * firstfile.c (dummy): Use the address of 'main', whose signature
+ won't change, instead of the address of 'initialize', whose
+ signature just changed from int to bool.
+ * lisp.h (fatal_error_in_progress): New decl of boolean, moved here ...
+ * msdos.c (fatal_error_in_progress): ... from here.
+ * xdisp.c (redisplaying_p): Now a boolean. Set it to 1 instead
+ of incrementing it.
+ (redisplay_internal, unwind_redisplay): Simply clear
+ REDISPLAYING_P when unwinding, instead of saving its previous,
+ always-false value and then restoring it.
+
+ Clean up some extern decls.
+ Mostly, this hoists extern decls out of .c files and into .h files.
+ That way, we're more likely to catch errors if the interfaces change.
+ * alloc.c [USE_GTK]: Include "gtkutil.h" so that we need not
+ declare xg_mark_data.
+ * dispextern.h (x_frame_parm_handlers):
+ * font.h (Qxft):
+ * lisp.h (Qlexical_binding, Qinternal_interpreter_environment)
+ (Qextra_light, Qlight, Qsemi_light, Qsemi_bold, Qbold, Qextra_bold)
+ (Qultra_bold, Qoblique, Qitalic):
+ Move extern decl here from .c file.
+ * alloc.c (xg_mark_data) [USE_GTK]:
+ * doc.c (Qclosure):
+ * eval.c (Qlexical_binding):
+ * fns.c (time) [!HAVE_UNISTD_H]:
+ * gtkutil.c (Qxft, Qnormal, Qextra_light, Qlight, Qsemi_light)
+ (Qsemi_bold, Qbold, Qextra_bold, Qultra_bold, Qoblique, Qitalic):
+ * image.c (Vlibrary_cache, QCloaded_from) [HAVE_NTGUI]:
+ * lread.c (Qinternal_interpreter_environment):
+ * minibuf.c (Qbuffer):
+ * process.c (QCfamily, QCfilter):
+ * widget.c (free_frame_faces):
+ * xfaces.c (free_frame_menubar) [USE_X_TOOLKIT]:
+ * xfont.c (x_clear_errors):
+ * xterm.c (x_frame_parm_handlers):
+ Remove now-redundant extern decls.
+ * keyboard.c, keyboard.h (ignore_mouse_drag_p) [USE_GTK || HAVE_NS]:
+ * xfaces.c (Qultra_light, Qreverse_oblique, Qreverse_italic):
+ Now static.
+ * xfaces.c: Remove unnecessary static decls.
+ * xterm.c (updating_frame): Remove decl of nonexistent object.
+
+ * Makefile.in (gl-stamp): Don't scan $(SOME_MACHINE_OBJECTS)
+ when building globals.h, as the objects that are not built on
+ this host are not needed to compile C files on this host.
+
+2012-09-02 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.h: Remove prototype for x_wm_set_size_hint.
+
+ * frame.h: Add missing prototype for x_wm_set_size_hint.
+
+2012-09-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * doc.c, editfns.c, insdel.c, intervals.c: Use bool for boolean.
+ * doc.c (read_bytecode_char, get_doc_string, reread_doc_file)
+ (Fdocumentation, Fdocumentation_property, Fsnarf_documentation)
+ (Fsubstitute_command_keys):
+ * editfns.c (region_limit, find_field, Fconstrain_to_field)
+ (save_excursion_save, save_excursion_restore)
+ (disassemble_lisp_time, decode_time_components, emacs_nmemftime)
+ (format_time_string, general_insert_function)
+ (make_buffer_string, make_buffer_string_both)
+ (Fsubst_char_in_region, Ftranslate_region_internal, Fformat):
+ * insdel.c (check_markers, gap_left, adjust_markers_for_insert)
+ (copy_text, insert_1, insert_1_both, insert_from_string)
+ (insert_from_string_before_markers, insert_from_string_1)
+ (insert_from_buffer, insert_from_buffer_1, replace_range)
+ (replace_range_2, del_range_1, del_range_byte, del_range_both)
+ (del_range_2, modify_region):
+ * intervals.c (intervals_equal, balance_possible_root_interval)
+ (adjust_intervals_for_insertion, merge_properties_sticky)
+ (graft_intervals_into_buffer, lookup_char_property)
+ (adjust_for_invis_intang, set_point_both)
+ (get_property_and_range, compare_string_intervals)
+ (set_intervals_multibyte_1, set_intervals_multibyte):
+ * keyboard.c (decode_timer):
+ Use bool for boolean.
+ * intervals.h, lisp.h, systime.h: Reflect above API changes.
+ * editfns.c (struct info): Use 1-bit unsigned bitfields for booleans.
+
+2012-09-02 Chong Yidong <cyd@gnu.org>
+
+ * keymap.c (push_key_description): Print M-TAB as C-M-i
+ (Bug#11758).
+
+2012-09-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (CCL_H, W32FONT_H): New macros.
+ (ATIMER_H, FONT_H, $(BLD)/alloc.$(O), $(BLD)/callproc.$(O))
+ ($(BLD)/editfns.$(O), $(BLD)/ccl.$(O), $(BLD)/chartab.$(O))
+ ($(BLD)/coding.$(O), $(BLD)/sysdep.$(O), $(BLD)/fontset.$(O))
+ ($(BLD)/sysdep.$(O), $(BLD)/w32fns.$(O), $(BLD)/keyboard.$(O))
+ ($(BLD)/w32term.$(O), $(BLD)/w32menu.$(O), $(BLD)/process.$(O))
+ ($(BLD)/w32font.$(O), $(BLD)/w32uniscribe.$(O)): Update dependencies.
+
+2012-09-01 Eli Zaretskii <eliz@gnu.org>
+
+ * w32uniscribe.c (uniscribe_shape): Handle correctly the case of
+ more than one grapheme cluster passed to the shaper: compute the
+ offset adjustment values separately for each cluster. (Bug#11860)
+
+ * image.c: Restore mistakenly removed inclusion of w32.h. Without
+ it, GCC doesn't see prototypes of w32_delayed_load, and complains
+ about implicit conversions from integer to pointer.
+
+2012-09-01 Daniel Colascione <dancol@dancol.org>
+
+ * w32fns.c (x_display_info_for_name): Prevent crash if w32 window
+ system used too early.
+
+2012-09-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better seed support for (random).
+ * emacs.c (main): Call init_random.
+ * fns.c (Frandom): Set the seed from a string argument, if given.
+ Remove long-obsolete Gentzel cruft.
+ * lisp.h, sysdep.c (seed_random): Now takes address and size, not long.
+ (init_random): New function.
+
+2012-09-01 Daniel Colascione <dancol@dancol.org>
-2012-08-24 Chong Yidong <cyd@gnu.org>
+ * xterm.h: Add header guards. Declare x_menubar_window_to_frame.
+ Remove x_set_frame_alpha, x_bitmap_icon, x_make_frame_visible,
+ x_make_frame_invisible, x_iconify_frame, x_free_frame_resources,
+ x_wm_set_size_hint, x_query_colors, x_real_positions,
+ x_set_menu_bar_lines, x_char_width, x_char_height, x_sync,
+ x_set_tool_bar_lines, x_activate_menubar, and free_frame_menubar,
+ all of which have been moved to common code.
- * Version 24.2 released.
+ * xfaces.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
-2012-08-24 Eli Zaretskii <eliz@gnu.org>
+ * w32xfns.c (x_sync): Correct definition of x_sync (a no-op here)
+ to match header.
+
+ * w32term.h (FRAME_X_WINDOW): Use FRAME_W32_WINDOW instead of
+ directly accessing frame internals.
+
+ * w32font.h: Include font.h. Define syms_of_w32font and
+ globals_of_w32font.
+
+ * process.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * nsterm.h: Remove declarations now in frame.h.
+ Define FRAME_X_SCREEN, FRAME_X_VISUAL.
+
+ * menu.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * keyboard.h: Declare ignore_mouse_drag_p whenever we have a
+ window system.
+
+ * keyboard.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * image.c: Include TERM_HEADER instead of listing all possible
+ window-system headers. Declare Vlibrary_cache when compiling for
+ Windows.
+
+ * gtkutil.h (xg_list_node_): Include xterm.h to pick up needed
+ window system declarations.
+
+ * frame.h: Move common functions here: set_frame_menubar,
+ x_set_window_size, x_sync, x_get_focus_frame,
+ x_set_mouse_position, x_set_mouse_pixel_position,
+ x_make_frame_visible, x_make_frame_invisible, x_iconify_frame,
+ x_char_width, x_char_height, x_pixel_width, x_pixel_height,
+ x_set_frame_alpha, x_set_menu_bar_lines, x_set_tool_bar_lines,
+ x_activate_menubar, x_real_positions, x_bitmap_icon,
+ x_set_menu_bar_lines, free_frame_menubar, x_free_frame_resources,
+ and x_query_colors.
+
+ * frame.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * font.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * emacs.c: Include TERM_HEADER.
+
+ * dispnew.c: Include TERM_HEADER instead of listing all possible
+ window-system headers.
+
+ * ccl.h: Include character.h.
+
+ * Makefile.in: Define WINDOW_SYSTEM_OBJ to hold objects needed for
+ the current window system; include in list of objects to link into
+ Emacs.
+
+2012-08-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove mark_ttys function and fix tty_display_info initialization.
+ * lisp.h (mark_ttys): Remove prototype.
+ * alloc.c (Fgarbage_collect): Remove redundant (and the only) call
+ to mark_ttys because all possible values of 'top_frame' slot are
+ the frames which are reachable from Vframe_list.
+ * term.c (mark_ttys): Remove.
+ (init_tty): Safely initialize 'top_frame' slot with Qnil.
+
+2012-08-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Change struct frame bitfields from unsigned char to unsigned.
+ * frame.h (struct frame): Change type of 'display_preempted',
+ 'visible', 'iconified', 'has_minibuffer', 'wants_modeline',
+ 'auto_raise', 'auto_lower', 'no_split', 'explicit_name',
+ 'window_sizes_changed', 'mouse_moved' and 'pointer_invisible'
+ bitfields from unsigned char to unsigned.
+
+2012-08-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove unused member of struct x_output and struct w32_output.
+ * xterm.h (struct x_output): Remove unused field 'needs_exposure'.
+ * w32term.h (struct w32_output): Likewise.
+
+2012-08-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (x_wm_set_size_hint): Use 1 col for base_width so it
+ does not become zero (Bug#12234).
+
+2012-08-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dispnew.c (update_frame_1): Pacify gcc -Wstrict-overflow
+ for GCC 4.7.1 x86-64.
+
+2012-08-30 Glenn Morris <rgm@gnu.org>
+
+ * lread.c (init_lread): For out-of-tree builds, only add the
+ source directory's site-lisp dir to the load-path if it exists,
+ consistent with in-tree builds. (Bug#12302)
+
+2012-08-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsmenu.m (initWithContentRect:styleMask:backing:defer:): Initialize
+ button_values to NULL. Call setStykeMask so dialogs get a close button.
+ (windowShouldClose:): Set window_closed.
+ (dealloc): New member, free button_values.
+ (process_dialog:): Make member function. Remove window argument,
+ replace window with self. Count buttons and allocate and store values
+ in button_values.
+ (addButton:value:row:): value is int with the name tag. Call setTag
+ with tag. Remove return self, declare return value as void.
+ (addString:row:): Remove return self, declare return value as void.
+ (addSplit): Remove return self, declare return value as void.
+ (clicked:): Remove return self, declare return value as void.
+ Set dialog_return to button_values[seltag]. Code formatting change.
+ (initFromContents:isQuestion:): Adjust call to process_dialog.
+ Code formatting change.
+ (timeout_handler:): Set timer_fired to YES.
+ (runDialogAt:): Set timer_fired to NO.
+ Handle click on close button as quit.
+
+ * nsterm.h (EmacsDialogPanel): Make timer_fired BOOL.
+ Add window_closed and button_values. Add void as return value for
+ add(Button|String|Split). addButton takes int instead of Lisp_Object.
+ Add process_dialog as new member.
+
+2012-08-28 Eli Zaretskii <eliz@gnu.org>
* ralloc.c (free_bloc): Don't dereference a 'heap' structure if it
is not one of the heaps we manage. (Bug#12242)
-2012-08-14 Glenn Morris <rgm@gnu.org>
+2012-08-28 Glenn Morris <rgm@gnu.org>
* eval.c (Fcalled_interactively_p): Doc fix. (Bug#11747)
-2012-08-14 Ulrich Mueller <ulm@gentoo.org>
+2012-08-28 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fset_window_configuration): Remove handling of
+ auto-buffer-name window parameter. Install revision of reverted
+ fix.
+
+2012-08-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not allow to set major mode for a dead buffer.
+ * buffer.c (Fset_buffer_major_mode): Signal an error
+ if the buffer is dead.
+ (Fother_buffer, other_buffer_safely): Remove redundant
+ nested declaration.
+
+2012-08-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Always use set_buffer_if_live to restore original buffer at unwind.
+ * buffer.h (record_unwind_current_buffer): New function.
+ * bytecode.c, dispnew.c, editfns.c, fileio.c, fns.c, insdel.c:
+ * keyboard.c, keymap.c, minibuf.c, print.c, process.c, textprop.c:
+ * undo.c, window.c: Adjust users.
+ * buffer.c (set_buffer_if_live): Fix comment.
+
+2012-08-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix usage of set_buffer_internal.
+ * buffer.h (set_buffer_internal): Make it BUFFER_INLINE.
+ * buffer.c (set_buffer_if_live): Use set_buffer_internal.
+ * coding.c (decode_coding): Omit redundant test.
+ * fileio.c (decide_coding_unwind): Likewise.
+ * fns.c (secure_hash): Likewise.
+ * insdel.c (modify_region): Likewise.
+ * keyboard.c (command_loop_1): Likewise.
+ * print.c (PRINTFINISH): Likewise.
+ * xdisp.c (run_window_scroll_functions): Use set_buffer_internal.
+
+2012-08-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dispnew.c: Use bool for boolean.
+ (frame_garbaged, display_completed, delayed_size_change)
+ (fonts_changed_p, add_window_display_history)
+ (add_frame_display_history, verify_row_hash)
+ (adjust_glyph_matrix, clear_window_matrices, glyph_row_slice_p)
+ (row_equal_p, realloc_glyph_pool)
+ (allocate_matrices_for_frame_redisplay)
+ (showing_window_margins_p)
+ (adjust_frame_glyphs_for_frame_redisplay)
+ (build_frame_matrix_from_leaf_window, make_current)
+ (mirrored_line_dance, mirror_line_dance, update_frame)
+ (update_window_tree, update_single_window)
+ (check_current_matrix_flags, update_window, update_text_area)
+ (update_window_line, set_window_update_flags, scrolling_window)
+ (update_frame_1, scrolling, buffer_posn_from_coords)
+ (do_pending_window_change, change_frame_size)
+ (change_frame_size_1, sit_for):
+ Use bool for boolean.
+ (clear_glyph_matrix_rows): Rename from enable_glyph_matrix_rows,
+ and remove last int (actually boolean) argument, which was always 0.
+ All callers changed.
+ * dispextern.h, frame.h, lisp.h: Reflect above API changes.
+ * dispextern.h (struct composition_it): Use bool for boolean.
+ (struct glyph_matrix): Don't assume buffer sizes can fit in 'int'.
+ (struct bidi_it): Use unsigned:1, not int, for boolean prev_was_pdf.
+ * dired.c (file_name_completion):
+ Use bool for boolean. (This was missed in an earlier change.)
+
+2012-08-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fset_window_configuration): Revert first part of
+ last change.
+
+2012-08-27 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.h (NSPanel): New class variable dialog_return.
+
+ * nsmenu.m (initWithContentRect:styleMask:backing:defer:):
+ Initialize dialog_return.
+ (windowShouldClose:): Use stop instead of stopModalWithCode.
+ (clicked:): Ditto, and also set dialog_return (Bug#12258).
+ (timeout_handler:): Use stop instead of abortModal. Send a dummy
+ event.
+ (runDialogAt:): Make ret Lisp_Object. Set it from dialog_return when
+ modal loop returns.
+
+2012-08-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * composite.c, data.c, dbusbind.c, dired.c: Use bool for booleans.
+ * composite.c (find_composition, composition_gstring_p)
+ (composition_reseat_it, find_automatic_composition):
+ * data.c (let_shadows_buffer_binding_p)
+ (let_shadows_global_binding_p, set_internal, make_blv)
+ (Fmake_variable_buffer_local, Fmake_local_variable)
+ (Fmake_variable_frame_local, arithcompare, cons_to_unsigned)
+ (cons_to_signed, arith_driver):
+ * dbusbind.c (xd_in_read_queued_messages):
+ * dired.c (directory_files_internal, file_name_completion):
+ Use bool for booleans.
+ * dired.c (file_name_completion):
+ * process.h (fd_callback):
+ Omit int (actually boolean) argument. It wasn't being used.
+ All uses changed.
+ * composite.h, lisp.h: Reflect above API changes.
+
+ * cmds.c, coding.c: Use bool for booleans.
+ * cmds.c (move_point, Fself_insert_command):
+ * coding.h (struct composition status, struct coding_system):
+ * coding.c (detect_coding_utf_8, encode_coding_utf_8)
+ (detect_coding_utf_16, encode_coding_utf_16, detect_coding_emacs_mule)
+ (emacs_mule_char, decode_coding_emacs_mule)
+ (encode_coding_emacs_mule, detect_coding_iso_2022)
+ (decode_coding_iso_2022, encode_invocation_designation)
+ (encode_designation_at_bol, encode_coding_iso_2022)
+ (detect_coding_sjis, detect_coding_big5, decode_coding_sjis)
+ (decode_coding_big5, encode_coding_sjis, encode_coding_big5)
+ (detect_coding_ccl, encode_coding_ccl, decode_coding_raw_text)
+ (encode_coding_raw_text, detect_coding_charset)
+ (decode_coding_charset, encode_coding_charset, detect_eol)
+ (detect_coding, get_translation_table, produce_chars)
+ (consume_chars, reused_workbuf_in_use)
+ (make_conversion_work_buffer, code_conversion_save)
+ (decode_coding_object, encode_coding_object)
+ (detect_coding_system, char_encodable_p)
+ (Funencodable_char_position, code_convert_region)
+ (code_convert_string, code_convert_string_norecord)
+ (Fset_coding_system_priority):
+ * fileio.c (Finsert_file_contents):
+ Use bool for booleans.
+ * coding.h, lisp.h: Reflect above API changes.
+ * coding.c: Remove unnecessary static function decls.
+ (detect_coding): Use unsigned, not signed, to copy an unsigned field.
+ (decode_coding, encode_coding, decode_coding_gap): Return 'void',
+ not a boolean 'int', since callers never look at the return value.
+ (ALLOC_CONVERSION_WORK_AREA): Assume caller returns 'void', not 'int'.
+ * coding.h (decoding_buffer_size, encoding_buffer_size)
+ (emacs_mule_string_char): Remove unused extern decls.
+ (struct iso_2022_spec, struct coding_system):
+ Use 'unsigned int : 1' for boolean fields, since there's more than one.
+ (struct emacs_mule_spec): Remove unused field 'full_support'.
+ All initializations removed.
+ * cmds.c (internal_self_insert): Don't assume EMACS_INT fits in 'int'.
+
+2012-08-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix spare memory change (Bug#12286).
+ * alloc.c (mark_maybe_pointer): Handle MEM_TYPE_SPARE.
+ (valid_lisp_object_p): Likewise.
+
+2012-08-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fset_window_configuration): Record any window's old
+ buffer if it's replaced (see Bug#8789). If the new current
+ buffer doesn't appear in the selected window, go to its old
+ point (Bug#12208).
+
+2012-08-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Special MEM_TYPE_SPARE to denote reserved memory.
+ * alloc.c (enum mem_type): New memory type.
+ (refill_memory_reserve): Use new type for spare memory.
+ This prevents live_cons_p and live_string_p from incorrect
+ detection of uninitialized objects from spare memory as live.
+
+2012-08-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * Makefile.in (.PHONY): versioclean -> versionclean.
- * systime.h (EMACS_TIME_CMP): Don't cast time_t values to long
- (Bug#11712).
+ Remove unused external symbols.
+ * data.c (Qcons, Qfloat, Qmisc, Qstring, Qvector):
+ * window.c (Qwindow_valid_p, decode_valid_window):
+ Now static, not extern.
+ * data.c (Qinterval): Remove; unused.
+ (syms_of_data): Do not define 'interval'.
+ * lisp.h (Qinteger, Qstring, Qmisc, Qvector, Qfloat, Qcons):
+ * window.h (decode_valid_window):
+ Remove decls.
-2012-08-13 Eli Zaretskii <eliz@gnu.org>
+ * character.c, charset.c, chartab.c: Use bool for booleans.
+ * character.c (lisp_string_width, string_count_byte8)
+ (string_escape_byte8):
+ * charset.c (charset_map_loaded, load_charset_map, read_hex):
+ (load_charset_map_from_file, map_charset_chars)
+ (Fdefine_charset_internal, define_charset_internal)
+ (Fdeclare_equiv_charset, find_charsets_in_text)
+ (Ffind_charset_region, char_charset, Fiso_charset):
+ * chartab.c (sub_char_table_ref, sub_char_table_ref_and_range)
+ (sub_char_table_set, sub_char_table_set_range)
+ (char_table_set_range, optimize_sub_char_table)
+ (map_sub_char_table):
+ Use bool for boolean.
+ * character.c (str_to_unibyte): Omit last boolean argument; it was
+ always 0. All callers changed.
+ * character.h, charset.h: Adjust to match previous changes.
+ * character.h (char_printable_p): Remove decl of nonexistent function.
+ * charset.h (struct charset): Members code_linear_p, iso_chars_96,
+ ascii_compatible_p, supplementary_p, compact_codes_p, unified_p
+ are all boolean, so make them single-bit bitfields.
+
+ * lisp.h (ASET): Remove attempt to detect side effects.
+ It was meant to be temporary and it often doesn't work,
+ because when IDX has side effects the behavior of IDX==IDX
+ is undefined. See Stefan Monnier in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00762.html>.
+
+2012-08-26 Barry OReilly <gundaetiapo@gmail.com> (tiny change)
+
+ * lisp.h (functionp): New function (extracted from Ffunctionp).
+ (FUNCTIONP): Use it.
+ * eval.c (Ffunctionp): Use it.
+
+2012-08-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xgselect.c (xg_select): Use auto storage for the GPollFD buffer
+ as that's faster and simpler than static storage. Don't bother
+ with the g_main_context_query overhead if g_main_context_pending
+ says no events are pending.
+ (gfds, gfds_size): Remove these static vars.
+ (xgselect_initialize): Remove; no longer needed.
+ All uses and decls removed.
+
+ * emacs.c (fatal_error_signal_hook): Remove.
+ All uses removed. This leftover from old code was always 0.
+
+ * casefiddle.c, casetab.c, category.c: Use bool for boolean.
+ * casefiddle.c (casify_object, casify_region):
+ * casetab.c (set_case_table):
+ * category.c, category.h (word_boundary_p):
+ * category.h (CHAR_HAS_CATEGORY):
+ Use bool for booleans, instead of int.
+
+2012-08-25 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in ($(BLD)/alloc.$(O)): Depend on $(GNU_LIB)/execinfo.h.
+
+2012-08-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ On assertion failure, print backtrace if available.
+ * alloc.c [ENABLE_CHECKING]: Include <execinfo.h>.
+ (die) [ENABLE_CHECKING]: Print a backtrace if available.
+ * Makefile.in (LIB_EXECINFO): New macro.
+ (LIBES): Use it.
- * w32menu.c: Include w32heap.h.
- (add_menu_item): If the call to AppendMenuW (via
- unicode_append_menu) fails, disable Unicode menus only if we are
- running on Windows 9X/Me.
+ * bytecode.c, callint.c, callproc.c: Use bool for boolean.
+ * bytecode.c (exec_byte_code):
+ * callint.c (check_mark, Fcall_interactively):
+ * callproc.c (Fcall_process, add_env, child_setup, getenv_internal_1)
+ (getenv_internal, sync_process_alive, call_process_exited):
+ * lisp.h (USE_SAFE_ALLOCA):
+ Use bool for booleans, instead of int.
+ * lisp.h, process.h: Adjust prototypes to match above changes.
+ * callint.c (Fcall_interactively): Don't assume the mark's
+ offset fits in 'int'.
+
+2012-08-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.c, buffer.h: Use bool for boolean.
+ * buffer.c (reset_buffer_local_variables)
+ (buffer_lisp_local_variables, Fset_buffer_modified_p)
+ (Frestore_buffer_modified_p, Fset_buffer_multibyte):
+ (overlays_at, overlays_in, mouse_face_overlay_overlaps)
+ (overlay_touches_p, overlay_strings, Foverlay_put)
+ (report_overlay_modification, call_overlay_mod_hooks):
+ (mmap_enlarge, mmap_set_vars):
+ * buffer.h (buffer_has_overlays, uppercasep, lowercasep):
+ Use bool for booleans, instead of int.
+ * buffer.c (compact_buffer, mmap_free_1): Return void, not int,
+ since the 1-or-0 return value is always ignored anyway.
+ (mmap_initialized_p):
+ * buffer.h (struct buffer_text.inhibit_shrinking): Now bool, not int.
+ * buffer.h, lisp.h: Adjust prototypes to match above changes.
+
+2012-08-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * bidi.c: Use bool for boolean.
+ This is a bit more readable, and makes the text segment of bidi.o
+ 0.4% smaller on my platform (GCC 4.7.1 x86-64, Fedora 15).
+ Presumably it's faster too.
+ (bidi_initialized, bidi_ignore_explicit_marks_for_paragraph_level):
+ Now bool.
+ (bidi_cache_find_level_change, bidi_cache_iterator_state)
+ (bidi_unshelve_cache, bidi_init_it, bidi_count_bytes)
+ (bidi_char_at_pos, bidi_fetch_char, bidi_paragraph_init)
+ (bidi_explicit_dir_char, bidi_level_of_next_char)
+ (bidi_find_other_level_edge, bidi_move_to_visually_next):
+ Use bool for booleans, instead of int.
+ * dispextern.h (bidi_init_it, bidi_paragraph_init)
+ (bidi_unshelve_cache): Adjust decls to match code.
- * makefile.w32-in ($(BLD)/w32menu.$(O)): Depend on w32heap.h.
+2012-08-23 Martin Rudalics <rudalics@gmx.at>
- * window.c (Fdelete_other_windows_internal)
- (Fdelete_window_internal): Don't access frame's mouse highlight
- info of the initial frame. (Bug#11677)
+ * keyboard.c (Fposn_at_x_y): Do not allow internal window as
+ argument.
+
+2012-08-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * atimer.c, atimer.h (turn_on_atimers): Use bool for boolean.
+ * atimer.h: Include <stdbool.h>.
+
+2012-08-22 Dan Nicolaescu <dann@gnu.org>
+
+ * frame.h (FRAME_W32_P, FRAME_MSDOS_P, FRAME_NS_P): Change to
+ compile time tests instead of run time tests on systems that do
+ not use them.
+ (FRAME_MAC_P): Remove leftover from deleted code.
+ * frame.c (syms_of_frame): Remove leftover from deleted code.
+
+2012-08-22 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (insertText:): Don't clear modifiers if code is space.
+
+2012-08-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fontset.c (FONTSET_ADD): Return void, not Lisp_Object.
+ Otherwise, the compiler complains about (A?B:C) where B is void
+ and C is Lisp_Object. This fixes an incompatibility with Sun C 5.12.
+ (fontset_add): Return void, for FONTSET_ADD.
+
+2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c: Use bool for booleans.
+ (gc_in_progress, abort_on_gc)
+ (setjmp_tested_p) [!GC_SAVE_REGISTERS_ON_STACK && !GC_SETJMP_WORKS]:
+ (dont_register_blocks) [GC_MALLOC_CHECK]:
+ (suppress_checking) [ENABLE_CHECKING]: Now bool, not int.
+ (check_string_bytes, make_specified_string, memory_full)
+ (live_string_p, live_cons_p, live_symbol_p, live_float_p)
+ (live_misc_p, live_vector_p, live_buffer_p, mark_maybe_object)
+ (mark_stack, valid_pointer_p, make_pure_string)
+ (Fgarbage_collect, survives_gc_p, gc_sweep):
+ Use bool for booleans, instead of int.
+ (test_setjmp) [!GC_SAVE_REGISTERS_ON_STACK && !GC_SETJMP_WORKS]:
+ Remove unused local.
+ * alloc.c (PURE_POINTER_P):
+ * lisp.h (STRING_MULTIBYTE): Document that it returns a boolean.
+ * editfns.c (Fformat):
+ * fileio.c (Fexpand_file_name, Fsubstitute_in_file_name)
+ (Fdo_auto_save):
+ * fns.c (sweep_weak_table):
+ * lisp.h (suppress_checking, push_message, survives_gc_p)
+ (make_pure_string, gc_in_progress, abort_on_gc):
+ * lread.c (readchar, read1):
+ * print.c (Fprin1_to_string):
+ * xdisp.c (push_message):
+ Use bool for booleans affected directly or indirectly by
+ alloc.c's changes.
+
+ Make recently-introduced setters macros.
+ * fontset.c (set_fontset_id, set_fontset_name, set_fontset_ascii)
+ (set_fontset_base, set_fontset_frame, set_fontset_nofont_face)
+ (set_fontset_default, set_fontset_fallback): Rename from their
+ upper-case counterparts, and make them functions rather than macros.
+ This is more consistent with the other recently-introduced setters.
+ These don't need to be inline, since they're local.
+
+2012-08-21 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (fd_handler:): Alloc and release a NSAutoreleasePool in
+ the loop (Bug#12247).
+
+2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (vcopy): Use memcpy rather than our own loop.
+ This fixes a performance regression introduced by the recent
+ addition of vcopy. This means 'vcopy' will need to be modified
+ for a copying collector, but that's OK. Also, tighten the
+ checking in the assertion.
+
+2012-08-21 Eli Zaretskii <eliz@gnu.org>
+
+ * w32uniscribe.c (uniscribe_shape): Fix producing gstring
+ components for RTL text (Bug#11860). Adjust X-OFFSET of each
+ non-base glyph for the width of the base character, according to
+ what x_draw_composite_glyph_string_foreground expects.
+ Generate WADJUST value according to composition_gstring_width's
+ expectations, to produce correct width of the composed character.
+ Reverse the sign of the DU offset produced by ScriptPlace.
+
+2012-08-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dbusbind.c (xd_remove_watch): Do not assume C99 comments.
+
+2012-08-21 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid direct writes to contents member of struct Lisp_Vector.
+ * lisp.h (vcopy): New function to copy data into vector.
+ * dispnew.c (Fframe_or_buffer_changed_p): Use AREF and ASET.
+ * fns.c (Ffillarray): Use ASET.
+ * keyboard.c (timer_check_2): Use AREF and ASET.
+ (append_tool_bar_item, Frecent_keys): Use vcopy.
+ * lread.c (read_vector): Use ASET.
+ * msdos.c (Frecent_doskeys): Use vcopy.
+ * xface.c (Finternal_copy_lisp_face): Use vcopy.
+ (Finternal_merge_in_global_face): Use ASET and vcopy.
+ * xfont.c (xfont_list_pattern): Likewise.
+
+2012-08-21 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (Fwindow_point): For the selected window always return
+ the position of its buffer's point.
+ (Fset_window_point): For the selected window always go in its
+ buffer to the specified position.
+
+2012-08-21 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Setter macros for fontsets.
+ * fontset.c (SET_FONTSET_ID, SET_FONTSET_NAME, SET_FONTSET_ASCII)
+ (SET_FONTSET_BASE, SET_FONTSET_FRAME, SET_FONTSET_NOFONT_FACE)
+ (SET_FONTSET_DEFAULT, SET_FONTSET_FALLBACK): New macros.
+ Adjust users.
+
+2012-08-20 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (emacs$(EXEEXT), bootstrap-emacs$(EXEEXT)):
+ Don't assume that `ln -f' works.
+
+2012-08-20 Eli Zaretskii <eliz@gnu.org>
+
+ * .gdbinit: Use "set $dummy = ..." to avoid warnings from GDB 7.5
+ and later about non-assignments with no effect. See discussion at
+ http://sourceware.org/ml/gdb-patches/2012-08/msg00518.html for
+ details.
+
+2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Inline setter functions for Lisp_Objects slots of struct specbinding.
+ * eval.c (set_specpdl_symbol, set_specpdl_old_value): New functions.
+ Adjust users.
+
+2012-08-20 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (select_window): Always make selected window's buffer
+ current.
+
+2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use AREF and ASET for docstrings of category tables.
+ * category.h (CATEGORY_DOCSTRING): Use AREF.
+ (SET_CATEGORY_DOCSTRING): Use ASET.
+ * category.c (Fdefine_category): Use SET_CATEGORY_DOCSTRING.
+
+2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Inline setter functions for hash table members.
+ * lisp.h (set_hash_key, set_hash_value, set_hash_next)
+ (set_hash_hash, set_hash_index): Rename with _slot suffix.
+ (set_hash_key_and_value, set_hash_index, set_hash_next)
+ (set_hash_hash): New functions.
+ * charset.c, fns.c: Adjust users.
+
+2012-08-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Inline getter and setter functions for per-buffer values.
+ * buffer.h (per_buffer_default, set_per_buffer_default)
+ (per_buffer_value, set_per_buffer_value): New functions.
+ (PER_BUFFER_VALUE, PER_BUFFER_DEFAULT): Remove.
+ * buffer.c, data.c: Adjust users.
+
+2012-08-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/vm-limit.$(O)): Update dependencies.
+
+2012-08-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rely on <config.h> + <unistd.h> to declare 'environ',
+ as gnulib does this if the system doesn't.
+ * callproc.c, editfns.c, process.c (environ) [!USE_CRT_DLL]:
+ Remove declaration. MS-Windows declares it on stdlib.h which is
+ included by conf_post.h.
+ * emacs.c (environ) [DOUG_LEA_MALLOC]:
+ * vm-limit.c (environ) [ORDINARY_LINK]: Remove decl.
+ * vm-limit.c: Include <unistd.h>, for 'environ'.
+
+ * unexaix.c, unexcoff.c: Include "mem-limits.h".
+ (start_of_data): Remove decl; mem-limits.h provides it.
+
+ * xdisp.c (handle_invisible_prop): Make it a bit faster
+ and avoid a gcc -Wmaybe-uninitialized diagnostic.
+
+2012-08-19 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (handle_invisible_prop): Fix ellipses at overlay string
+ ends (Bug#3874).
+
+2012-08-19 Andreas Schwab <schwab@linux-m68k.org>
+
+ * .gdbinit: Use call instead of set when calling a function in the
+ inferior.
+
+ * data.c (set_internal): Don't use set_blv_found.
+ (Fkill_local_variable): Likewise.
+
+2012-08-18 Alp Aker <alp.tekin.aker@gmail.com>
+
+ * nsfont.m (ns_ascii_average_width): Ensure the string
+ ascii_printable is initialized with a null-terminated character
+ array. Otherwise, it can contain undesired extra characters.
+
+2012-08-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ port new setting code to Sun C 5.8 2005/10/13
+ * chartab.c, lisp.h (char_table_set, char_table_set_range):
+ Return void, not Lisp_Object. Otherwise, the compiler
+ complains about (A?B:C) where B is void and C is Lisp_Object
+ when compiling CHAR_TABLE_SET, due to the recent change to
+ the API of sub_char_table_set_contents.
+
+2012-08-18 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (handle_invisible_prop): Obey TEXT_PROP_MEANS_INVISIBLE
+ for the string case (Bug#3874).
+
+2012-08-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.h (BSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ (bset_bidi_paragraph_direction, bset_case_canon_table)
+ (bset_case_eqv_table, bset_directory, bset_display_count)
+ (bset_display_time, bset_downcase_table)
+ (bset_enable_multibyte_characters, bset_filename, bset_keymap)
+ (bset_last_selected_window, bset_local_var_alist)
+ (bset_mark_active, bset_point_before_scroll, bset_read_only)
+ (bset_truncate_lines, bset_undo_list, bset_upcase_table)
+ (bset_width_table):
+ * buffer.c (bset_abbrev_mode, bset_abbrev_table)
+ (bset_auto_fill_function, bset_auto_save_file_format)
+ (bset_auto_save_file_name, bset_backed_up, bset_begv_marker)
+ (bset_bidi_display_reordering, bset_buffer_file_coding_system)
+ (bset_cache_long_line_scans, bset_case_fold_search)
+ (bset_ctl_arrow, bset_cursor_in_non_selected_windows)
+ (bset_cursor_type, bset_display_table, bset_extra_line_spacing)
+ (bset_file_format, bset_file_truename, bset_fringe_cursor_alist)
+ (bset_fringe_indicator_alist, bset_fringes_outside_margins)
+ (bset_header_line_format, bset_indicate_buffer_boundaries)
+ (bset_indicate_empty_lines, bset_invisibility_spec)
+ (bset_left_fringe_width, bset_major_mode, bset_mark)
+ (bset_minor_modes, bset_mode_line_format, bset_mode_name)
+ (bset_name, bset_overwrite_mode, bset_pt_marker)
+ (bset_right_fringe_width, bset_save_length)
+ (bset_scroll_bar_width, bset_scroll_down_aggressively)
+ (bset_scroll_up_aggressively, bset_selective_display)
+ (bset_selective_display_ellipses, bset_vertical_scroll_bar_type)
+ (bset_word_wrap, bset_zv_marker):
+ * category.c (bset_category_table):
+ * syntax.c (bset_syntax_table):
+ New setter functions.
+
+ * process.h (PSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (PROCESS_INLINE): New macro.
+ (pset_childp): New setter function.
+ (pset_gnutls_cred_type) [HAVE_GNUTLS]: New setter function.
+ * process.c (PROCESS_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (pset_buffer, pset_command, pset_decode_coding_system)
+ (pset_decoding_buf, pset_encode_coding_system)
+ (pset_encoding_buf, pset_filter, pset_log, pset_mark, pset_name)
+ (pset_plist, pset_sentinel, pset_status, pset_tty_name)
+ (pset_type, pset_write_queue): New setter functions.
+
+ * window.h (WSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (WINDOW_INLINE): New macro.
+ (wset_buffer, wset_frame, wset_left_col, wset_next, wset_prev)
+ (wset_redisplay_end_trigger, wset_top_line, wset_total_cols)
+ (wset_total_lines, wset_vertical_scroll_bar)
+ (wset_window_end_pos, wset_window_end_valid)
+ (wset_window_end_vpos): New setter functions.
+ * window.c (WINDOW_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (wset_combination_limit, wset_dedicated, wset_display_table)
+ (wset_hchild, wset_left_fringe_width, wset_left_margin_cols)
+ (wset_new_normal, wset_new_total, wset_next_buffers)
+ (wset_normal_cols, wset_normal_lines, wset_parent, wset_pointm)
+ (wset_prev_buffers, wset_right_fringe_width)
+ (wset_right_margin_cols, wset_scroll_bar_width, wset_start)
+ (wset_temslot, wset_vchild, wset_vertical_scroll_bar_type)
+ (wset_window_parameters):
+ * xdisp.c (wset_base_line_number, wset_base_line_pos)
+ (wset_column_number_displayed, wset_region_showing):
+ New setter functions.
+
+ * termhooks.h (TSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (TERMHOOKS_INLINE): New macro.
+ (tset_charset_list, tset_selection_alist): New setter functions.
+ * terminal.c (TERMHOOKS_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (tset_param_alist): New setter function.
+
+2012-08-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.h (KSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (KEYBOARD_INLINE): New macro.
+ (kset_default_minibuffer_frame, kset_defining_kbd_macro)
+ (kset_input_decode_map, kset_last_command, kset_last_kbd_macro)
+ (kset_prefix_arg, kset_system_key_alist, kset_window_system):
+ New setter functions.
+ * keyboard.c (KEYBOARD_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (kset_echo_string, kset_kbd_queue)
+ (kset_keyboard_translate_table, kset_last_prefix_arg)
+ (kset_last_repeatable_command, kset_local_function_key_map)
+ (kset_overriding_terminal_local_map, kset_real_last_command)
+ (kset_system_key_syms): New setter functions.
+
+ * frame.h (FSET): Remove (Bug#12215).
+ Replace all uses with calls to new setter functions.
+ Use INLINE_HEADER_BEGIN, INLINE_HEADER_END.
+ (FRAME_INLINE): New macro.
+ (fset_buffer_list, fset_buried_buffer_list, fset_condemned_scroll_bars)
+ (fset_current_tool_bar_string, fset_desired_tool_bar_string)
+ (fset_face_alist, fset_focus_frame, fset_icon_name, fset_menu_bar_items)
+ (fset_menu_bar_vector, fset_menu_bar_window, fset_name)
+ (fset_param_alist, fset_root_window, fset_scroll_bars)
+ (fset_selected_window, fset_title, fset_tool_bar_items)
+ (fset_tool_bar_position, fset_tool_bar_window): New functions.
+ * frame.c (FRAME_INLINE):
+ Define to EXTERN_INLINE, so that the corresponding functions
+ are compiled into code.
+ (fset_buffer_predicate, fset_minibuffer_window): New setter functions.
+
+ A few more naming-convention fixes for getters and setters.
+ * buffer.c (set_buffer_overlays_before): Move here from buffer.h,
+ and rename from buffer_overlays_set_before.
+ (set_buffer_overlays_after): Move here from buffer.h, and rename
+ from buffer_overlays_set_after.
+ * buffer.h (buffer_intervals): Rename from buffer_get_intervals.
+ All uses changed.
+ (set_buffer_intervals): Rename from buffer_set_intervals.
+ * intervals.c (set_interval_object): Move here from intervals.h,
+ and rename from interval_set_object.
+ (set_interval_left): Move here from intervals.h, and rename from
+ interval_set_left.
+ (set_interval_right): Move here from intervals.h, and rename from
+ interval_set_right.
+ (copy_interval_parent): Move here from intervals.h, and rename from
+ interval_copy_parent.
+ * intervals.h (set_interval_parent): Rename from interval_set_parent.
+ (set_interval_plist): Rename from interval_set_plist.
+ Return void, not Lisp_Object, since no caller uses the result.
+ * lisp.h (string_intervals): Rename from string_get_intervals.
+ (set_string_intervals): Rename from string_set_intervals.
+
+ * lisp.h (set_char_table_extras): Rename from char_table_set_extras.
+ (set_char_table_contents): Rename from char_table_set_contents.
+ (set_sub_char_table_contents): Rename from sub_char_table_set_contents.
+ All uses changed. See the end of
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00549.html>.
+
+ * lisp.h (CSET): Remove (Bug#12215).
+ (set_char_table_ascii, set_char_table_defalt, set_char_table_parent)
+ (set_char_table_purpose): New functions,
+ replacing CSET. All uses changed. For example, replace
+ "CSET (XCHAR_TABLE (char_table), parent, parent);" with
+ "set_char_table_parent (char_table, parent);".
+ The old version was confusing because it used the same name
+ 'parent' for two different things.
+
+2012-08-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Functions to get and set Lisp_Object fields of buffer-local variables.
+ * lisp.h (blv_found, set_blv_found, blv_value, set_blv_value)
+ (set_blv_where, set_blv_defcell, set_blv_valcell): New functions.
+ (BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): Remove.
+ * data.c, eval.c, frame.c: Adjust users.
+
+2012-08-17 Chong Yidong <cyd@gnu.org>
+
+ * xfaces.c (merge_face_vectors): If the target font specfies a
+ font spec, make the font's attributes take precedence over
+ directly-specified attributes.
+ (merge_face_ref): Recognize :font.
+
+2012-08-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not use memcpy for copying intervals.
+ * intervals.c (reproduce_interval): New function.
+ (reproduce_tree, reproduce_tree_obj): Use it.
+ (reproduce_tree_obj): Remove prototype.
+
+2012-08-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (duration_to_sec_usec): Remove unused decl.
+
+2012-08-17 Alp Aker <alp.tekin.aker@gmail.com>
+
+ * nsfont.m (ns_ascii_average_width): Send initWithFormat selector
+ to an allocated instance of NSString, not to the class itself.
+
+2012-08-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (C_CTYPE_H): New macro.
+ (LISP_H, $(BLD)/ccl.$(O), $(BLD)/doc.$(O), $(BLD)/w32console.$(O)):
+ ($(BLD)/fontset.$(O), $(BLD)/frame.$(O), $(BLD)/composite.$(O)):
+ ($(BLD)/sysdep.$(O), $(BLD)/w32uniscribe.$(O)): Update dependencies.
+
+2012-08-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use ASCII tests for character types.
+ * category.c, dispnew.c, doprnt.c, editfns.c, syntax.c, term.c:
+ * xfns.c, xterm.c:
+ Don't include <ctype.h>; was not needed.
+ * charset.c, doc.c, fileio.c, font.c, frame.c, gtkutil.c, image.c:
+ * sysdep.c, xfaces.c:
+ Include <c-ctype.h> instead of <ctype.h>.
+ * nsterm.m: Include <c-ctype.h>.
+ * charset.c (read_hex):
+ * doc.c (Fsnarf_documentation):
+ * fileio.c (IS_DRIVE) [WINDOWSNT]:
+ (DRIVE_LETTER) [DOS_NT]:
+ (Ffile_name_directory, Fexpand_file_name)
+ (Fsubstitute_in_file_name):
+ * font.c (font_parse_xlfd, font_parse_fcname):
+ * frame.c (x_set_font_backend):
+ * gtkutil.c (xg_get_font):
+ * image.c (xbm_scan, xpm_scan, pbm_scan_number):
+ * nsimage.m (hexchar):
+ * nsterm.m (ns_xlfd_to_fontname):
+ * sysdep.c (system_process_attributes):
+ * xfaces.c (hash_string_case_insensitive):
+ Use C-locale tests instead of locale-specific tests for character
+ types, since we want the ASCII interpretation here, not the
+ interpretation suitable for whatever happens to be the current locale.
+
+2012-08-16 Martin Rudalics <rudalics@gmx.at>
+
+ Consistently check windows for validity/liveness
+ (Bug#11984, Bug#12025, Bug#12026).
+ * lisp.h (CHECK_VALID_WINDOW): New macro.
+ * window.c (decode_window): Rename to decode_live_window.
+ (decode_valid_window, Fwindow_valid_p): New functions.
+ (Fwindow_frame, Fframe_root_window, Fwindow_minibuffer_p)
+ (Fframe_first_window, Fframe_selected_window, Fwindow_parent)
+ (Fwindow_top_child, Fwindow_left_child, Fwindow_next_sibling)
+ (Fwindow_prev_sibling, Fwindow_combination_limit)
+ (Fset_window_combination_limit, Fwindow_use_time)
+ (Fwindow_total_height, Fwindow_total_width, Fwindow_new_total)
+ (Fwindow_normal_size, Fwindow_new_normal, Fwindow_left_column)
+ (Fwindow_top_line, Fwindow_body_height, Fwindow_body_width)
+ (Fwindow_hscroll, Fset_window_hscroll)
+ (Fwindow_redisplay_end_trigger)
+ (Fset_window_redisplay_end_trigger, Fwindow_edges)
+ (Fwindow_pixel_edges, Fwindow_absolute_pixel_edges)
+ (Fwindow_inside_edges, Fwindow_inside_pixel_edges)
+ (Fcoordinates_in_window_p, Fwindow_point, Fwindow_start)
+ (Fwindow_end, Fset_window_point, Fset_window_start)
+ (Fpos_visible_in_window_p, Fwindow_line_height)
+ (Fwindow_dedicated_p, Fset_window_dedicated_p)
+ (Fwindow_prev_buffers, Fset_window_prev_buffers)
+ (Fwindow_next_buffers, Fwindow_parameters, Fwindow_parameter)
+ (Fset_window_parameter, Fwindow_display_table)
+ (Fset_window_display_table, Fdelete_other_windows_internal)
+ (Fset_window_buffer, Fset_window_new_total)
+ (Fset_window_new_normal, Fdelete_window_internal)
+ (Fwindow_text_height, Fset_window_margins, Fwindow_margins)
+ (Fset_window_fringes, Fwindow_fringes, Fset_window_scroll_bars)
+ (Fwindow_scroll_bars): Check whether argument window is a valid or
+ live window. Update doc-strings.
+ (syms_of_window): New symbol Qwindow_valid_p.
+ * keyboard.c (Fposn_at_x_y): Check whether argument
+ frame_or_window denotes a valid window.
+
+2012-08-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix previous char table change.
+ * lisp.h (CHAR_TABLE_SET): Use sub_char_table_set_contents.
+ * chartab.c (optimize_sub_char_table): Likewise.
+
+2012-08-16 Chong Yidong <cyd@gnu.org>
+
+ * gtkutil.c (xg_get_font): Demand an Xft font (Bug#3228).
+
+ * xfont.c (xfont_open):
+ * xftfont.c (xftfont_open): Set the font's max_width field.
+
+ * nsfont.m (nsfont_open): Similar to the Xft backend, set
+ min_width to space_width and average_width to the average over
+ printable ASCII characters.
+ (ns_char_width): Code cleanup.
+ (ns_ascii_average_width): New utility function.
+
+ * font.h (struct font): Update comments.
+
+2012-08-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simple interface to set Lisp_Object fields of character tables.
+ * lisp.h (CSET): New macro.
+ (char_table_set_extras, char_table_set_contents)
+ (sub_char_table_set_contents): New function.
+ * casetab.c, category.c, chartab.c, fns.c, fontset.c, search.c:
+ * syntax.c: Adjust users.
+
+2012-08-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (eval_sub): Bind lexical-binding.
+ * lread.c (Qlexical_binding): Make non-static.
+
+2012-08-15 Jan Djärv <jan.h.d@swipnet.se>
+
+ * 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 <eliz@gnu.org>
+
+ * 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 <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ * gtkutil.c (xg_get_font): Use pango_units_to_double.
+
+2012-08-15 Chong Yidong <cyd@gnu.org>
+
+ * 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 <monnier@iro.umontreal.ca>
+
+ * minibuf.c (read_minibuf): Ignore caller's inhibit-read-only
+ (bug#12117).
+
+2012-08-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (Fgarbage_collect): Use plural form consistently.
+
+2012-08-14 Eli Zaretskii <eliz@gnu.org>
+
+ * 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 <eggert@cs.ucla.edu>
+
+ 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 <stdbool.h>.
+ (struct Lisp_Boolfwd, defvar_bool):
+ * lread.c (defvar_bool): Use bool, not int, for Lisp booleans.
+ * regex.c [!emacs]: Include <stdbool.h>.
+ (false, true): Remove; <stdbool.h> does this for us now.
+
+2012-08-14 Chong Yidong <cyd@gnu.org>
+
+ * 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 <gundaetiapo@gmail.com> (tiny change)
+
+ * keyboard.c (access_keymap_keyremap): Accept anonymous functions
+ (bug#12022).
+
+2012-08-14 Martin Rudalics <rudalics@gmx.at>
+
+ * 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 <eggert@cs.ucla.edu>
+
+ * intervals.c (offset_intervals): Remove obsolete comment.
+
+2012-08-14 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gtkutil.c (find_rtl_image, update_frame_tool_bar): Use NILP.
+
+2012-08-14 Gergely Risko <gergely@risko.hu>
+
+ * coding.c (decode_coding): Record buffer modification before
+ disabling undo_list (Bug#11773).
+
+2012-08-14 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ * gtkutil.c (update_frame_tool_bar): Use EQ where appropriate.
+
+2012-08-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * gtkutil.c (xg_mark_data): Don't assume C99.
+
+2012-08-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * 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 <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ 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 <bpt@hcoop.net> (tiny change)
+
+ * lread.c (syms_of_lread): Initialize Vlexical_binding.
+
+2012-08-11 Jan Djärv <jan.h.d@swipnet.se>
+
+ * 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 <moilinki@gmail.com>.
+
+2012-08-11 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * 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 <rgm@gnu.org>
+
+ * 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 <dmantipov@yandex.ru>
+
+ Fix last change to allow compilation with low optimization levels.
+ * intervals.c (INTERVALS_INLINE): Define to EXTERN_INLINE.
+ Reported by Jan Djärv <jan.h.d@swipnet.se>.
+
+2012-08-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use common inline syntax in intervals.h.
+ * intervals.h (INTERVALS_INLINE): New macro.
+ Change all users from LISP_INLINE.
+
+2012-08-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ Remove unused macros from intervals.h.
+ * intervals.h (MERGE_INSERTIONS, DISPLAY_INVISIBLE_GLYPH): Remove.
+ * intervals.c: Adjust comment.
+
+2012-08-10 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c <w32_unicode_gui>: 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 <joakim.harsman@gmail.com> (tiny change)
+ Eli Zaretskii <eliz@gnu.org>
+
+ 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 <rgm@gnu.org>
+
+ * 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 <dmantipov@yandex.ru>
+
+ 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 <monnier@iro.umontreal.ca>
+
+ * 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 <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ 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 <rgm@gnu.org>
+
+ * lisp.mk (lisp): Remove language/persian.elc.
+
+2012-08-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ 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 <eliz@gnu.org>
+
+ * .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 <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ 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 <cyd@gnu.org>
+
+ * 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 <dmantipov@yandex.ru>
+
+ 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 <lekktu@gmail.com>
+
+ * w32.c: Silence compiler warnings.
+ (map_w32_filename): Remove unused variable `is_fat'.
+ (chase_symlinks): Add parentheses around expression.
+
+2012-08-06 Glenn Morris <rgm@gnu.org>
+
+ * 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 <dmantipov@yandex.ru>
+
+ 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 <eliz@gnu.org>
+
+ * w32menu.c (set_frame_menubar, initialize_frame_menubar):
+ Don't use FRAME_MENU_BAR_ITEMS as an lvalue.
+
+2012-08-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * buffer.h (struct buffer): Revert `indirections' to a simple int;
+ that should be sufficient for everyone.
+
+2012-08-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * keyboard.c (timer_check_2): Add break so timer_check returns next
+ timeout.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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 <andrewjmoreton@gmail.com>.
+
+2012-08-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_frame_rehighlight): Use FSET.
+
+ * nsmenu.m (ns_update_menubar): Use FSET.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ 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 <dmantipov@yandex.ru>
+
+ 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 <andrewjmoreton@gmail.com>.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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 <bzg@gnu.org>.
+
+2012-08-06 Glenn Morris <rgm@gnu.org>
+
+ * lisp.mk (lisp): Add language/persian.elc.
+
+2012-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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 <schwab@linux-m68k.org>
+
+ * emacs.c (decode_env_path): Only use defaulted if WINDOWSNT.
+
+2012-08-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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 <wence@gmx.li>
+
+ * search.c (Freplace_match): Treat \? in the replacement text
+ literally (Bug#8161).
+
+2012-08-05 Chong Yidong <cyd@gnu.org>
+
+ * 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 <eliz@gnu.org>
+
+ * xfns.c (x_set_menu_bar_lines): Fix compilation error in
+ --with-x-toolkit=no builds.
+ Reported by Carsten Mattner <carstenmattner@gmail.com>.
+
+2012-08-04 Chong Yidong <cyd@gnu.org>
+
+ * syntax.c (Fmodify_syntax_entry): Doc fix.
+
+2012-08-04 Eli Zaretskii <eliz@gnu.org>
+
+ 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 <eggert@cs.ucla.edu>
+
+ Export DEFAULT_REHASH_* to GDB.
+ * lisp.h (DEFAULT_REHASH_THRESHOLD, DEFAULT_REHASH_SIZE):
+ Now constants, not macros.
+
+2012-08-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ 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 <http://bugs.gnu.org/12118#25>.
+ (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 <eliz@gnu.org>
+
+ 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.
+ <static BOOL g_b_init_get_security_info>:
+ <g_b_init_create_symbolic_link>: 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 <eggert@cs.ucla.edu>
+
+ 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 <rgm@gnu.org>
+
+ * 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 <eggert@cs.ucla.edu>
+
+ Port to Solaris 8.
+ * syswait.h (WRETCODE): Remove, consistently with ../configure.ac.
+
+2012-08-02 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (ns_exec_path, ns_load_path): Use SEPCHAR rather than
+ hard-coding the path separator.
+
+2012-08-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ 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
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00026.html>.
+ * 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 <alp.tekin.aker@gmail.com>
+
+ * 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 <eliz@gnu.org>
+
+ * .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 <rgm@gnu.org>
+
+ * 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 <lekktu@gmail.com>
+
+ * s/ms-w32.h (DEVICE_SEP, IS_DIRECTORY_SEP, IS_ANY_SEP):
+ Remove; moved to nt/config.nt.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use INTERNAL_FIELD for conses and overlays.
+ * lisp.h (struct Lisp_Cons): Use INTERNAL_FIELD.
+ Remove obsolete comment.
+ (MVAR): New macro.
+ (struct Lisp_Overlay): Use INTERNAL_FIELD.
+ * alloc.c, buffer.c, buffer.h, fns.c: Adjust users.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use INTERNAL_FIELD for symbols.
+ * lisp.h (SVAR): New macro. Adjust users.
+ * alloc.c, bytecode.c, cmds.c, data.c, doc.c, eval.c:
+ * fns.c, keyboard.c, lread.c, xterm.c: Users changed.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use INTERNAL_FIELD for processes.
+ * process.h (PVAR): New macro. Adjust style.
+ (struct Lisp_Process): Change Lisp_Object members to INTERNAL_FIELD.
+ * print.c, process.c, sysdep.c, w32.c, xdisp.c: Users changed.
+
+2012-08-01 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use INTERNAL_FIELD for windows.
+ * window.h (WVAR): New macro.
+ (struct window): Change Lisp_Object members to 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, nsterm.m, print.c:
+ * textprop.c, w32fns.c, w32menu.c, w32term.c, window.c, xdisp.c:
+ * xfaces.c, xfns.c, xmenu.c, xterm.c: Users changed.
+
+2012-08-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * coding.h (CODING_ATTR_FLUSHING): Remove; unused and wouldn't work.
+
+2012-08-01 Glenn Morris <rgm@gnu.org>
+
+ * lisp.h (IS_DIRECTORY_SEP, IS_DEVICE_SEP, IS_ANY_SEP):
+ Move to configure.ac.
+
+2012-08-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (CONFIG_H): Update dependencies.
+ (CONF_POST_H): New macro.
+
+ * s/ms-w32.h (SEPCHAR, NULL_DEVICE): Remove; moved to nt/config.nt.
+
+2012-07-31 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (S_FILE): No longer set by configure.
+
+ * conf_post.h (config_opsysfile): Move earlier, so that WINDOWSNT
+ is available.
+ (alloca.h) [WINDOWSNT]: Don't include it on MS Windows.
+
+ * process.h (NULL_DEVICE):
+ * emacs.c (SEPCHAR):
+ * editfns.c (USER_FULL_NAME): Let configure set them.
+
+ * s/README, s/template.h: Remove files.
+
+ * conf_post.h [HPUX]: Undefine HAVE_RANDOM and HAVE_RINT.
+
+ * conf_post.h (AMPERSAND_FULL_NAME, subprocesses):
+ Move to configure.ac.
+
+2012-07-31 Eli Zaretskii <eliz@gnu.org>
+
+ * .gdbinit (xframe): Adapt to introduction of FVAR and the
+ resulting renaming of 'struct frame' members.
+
+ * w32menu.c (w32_menu_show): Revert bogus introduction of FVAR.
+
+ * fontset.c (dump_fontset): Fix compilation with ENABLE_CHECKING
+ after introduction of FVAR.
+
+2012-07-31 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsmenu.m (update_frame_tool_bar): Change key from NSObject* to id.
+
+ * nsterm.m (ns_draw_fringe_bitmap, ns_dumpglyphs_image): Use drawInRect
+ instead of compositeToPoint.
+ (applicationShouldTerminate): Pass NS String literal to NSRunAlertPanel.
+
+ * nsfns.m, nsmenu.m, nsterm.m: Adopt to struct frame/FVAR changes.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Generalize INTERNAL_FIELD between buffers, keyboards and frames.
+ * lisp.h (INTERNAL_FIELD): New macro.
+ * buffer.h (BUFFER_INTERNAL_FIELD): Remove.
+ (BVAR): Change to use INTERNAL_FIELD.
+ * keyboard.h (KBOARD_INTERNAL_FIELD): Likewise.
+ (KVAR): Change to use INTERNAL_FIELD.
+ * frame.h (FVAR): New macro.
+ (struct frame): Use INTERNAL_FIELD for all Lisp_Object fields.
+ * alloc.c, buffer.c, data.c, dispnew.c, dosfns.c, eval.c, frame.c:
+ * fringe.c, gtkutil.c, minibuf.c, nsfns.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: Users changed.
+
+2012-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Miscellaneous fixes for non-default X toolkits.
+ * xfns.c (Fx_file_dialog): Change to SSDATA to avoid warnings.
+ * xterm.c (x_frame_of_widget): Remove redundant prototype.
+ Move under #ifdef USE_LUCID.
+ (x_create_toolkit_scroll_bar): Adjust scroll_bar_name
+ definition and usage to avoid warnings.
+
+2012-07-31 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (openFiles): Fix previous checkin.
+
+2012-07-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ * indent.c (compute_motion): Remove unused local.
+
+2012-07-31 Glenn Morris <rgm@gnu.org>
+
+ * s/usg5-4-common.h (wait3, WRETCODE): Let configure set them.
+
+ * conf_post.h [USG5_4]:
+ Move remaining contents of s/usg5-4-common.h here.
+ * s/usg5-4-common.h: Remove file.
+
+ * conf_post.h [IRIX6_5]: Move remaining contents of s/irix6-5.h here.
+ * s/irix6-5.h: Remove file.
+
+ * conf_post.h [DARWIN_OS]: Move remaining contents of s/darwin.h here.
+ * s/darwin.h: Remove file.
+
+ * conf_post.h [HPUX]: Move random, srandom here from s/hpux10-20.h.
+ * s/hpux10-20.h: Remove file, which is now empty.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * conf_post.h: New, split from configure.ac's AH_BOTTOM.
+ * Makefile.in (config_h): Add conf_post.h.
+ * makefile.w32-in (CONFIG_H): Add conf_post.h.
+
+2012-07-30 Jan Djärv <jan.h.d@swipnet.se>
+
+ * 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.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (SWITCH_ENUM_CAST): Remove. All uses removed.
+ This no-op macro hasn't been needed for many years.
+ * src/regex.c (SWITCH_ENUM_CAST) [!emacs]: Likewise.
+
+ Export DIRECTORY_SEP, TYPEMASK, VALMASK to GDB.
+ * alloc.c (gdb_make_enums_visible) [USE_LSB_TAG]: Add lsb_bits.
+ * lisp.h (enum lsb_bits) [USE_LSB_TAG]: New enum, for
+ gdb_make_enums_visible.
+ (TYPEMASK, VALMASK) [USE_LSB_TAGS]: Now enum constants, not macros.
+ (DIRECTORY_SEP): Now a constant, not a macro.
+
+2012-07-30 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (w32_wnd_proc): Pass w32_keyboard_codepage to
+ w32_kbd_patch_key as the 2nd arg. (Bug#12082)
+
+ * w32term.c <w32_keyboard_codepage>: Renamed from
+ keyboard_codepage and now external. All users changed.
+
+ * w32term.h: Add declaration of w32_keyboard_codepage.
+
+ * w32inevt.c (w32_kbd_patch_key): Accept an additional argument --
+ the codepage to translate keys to Unicode. If this argument is
+ -1, use the value returned by GetConsoleCP. All callers changed.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .PHONY listings in makefiles.
+ * Makefile.in (.PHONY): Add all, mostlyclean, clean,
+ bootstrap-clean, distclean, maintainer-clean, versioclean,
+ extraclean, frc.
+
+ * lisp.h (STRING_BYTES_BOUND): Cast entire result to ptrdiff_t.
+ This is a bit clearer. Fix some commentary typos.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * s/netbsd.h: Let configure include signal.h if needed.
+ Remove file, which is now empty.
+
+ * s/usg5-4-common.h (_longjmp, _setjmp, TIOCSIGSEND):
+ Let configure set them.
+ * s/irix6-5.h (_longjmp, _setjmp, TIOCSIGSEND):
+ No more need to undefine.
+
+2012-07-30 Andreas Schwab <schwab@linux-m68k.org>
+
+ * keymap.c (Fkey_description): Don't remove 0x80 bit from
+ non-single-byte char when adding meta modifier. (Bug#12090)
+
+2012-07-30 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Convert safe_call to use variable number of arguments.
+ * xdisp.c (safe_call): Convert to use varargs. Adjust users.
+ (safe_call2): Fix comment.
+ * lisp.h (safe_call): Adjust prototype.
+ * coding.c (encode_coding_object): Change to use safe_call2.
+ * xfaces.c (merge_face_heights): Change to use safe_call1.
+
+2012-07-30 Glenn Morris <rgm@gnu.org>
+
+ * s/aix4-2.h (sigmask): No need to undefine it, since syssignal.h
+ does that unconditionally. Remove file, which is now empty.
+
+ * s/freebsd.h, s/gnu-linux.h, s/sol2-6.h, s/unixware.h:
+ Remove empty files.
+
+2012-07-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Export to GDB most of lisp.h's remaining object-like macros.
+ * lisp.h (min, max): Move earlier, because they're used earlier now.
+ (INTMASK, ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK)
+ (CHAR_TABLE_STANDARD_SLOTS, CHARTAB_SIZE_BITS_0)
+ (CHARTAB_SIZE_BITS_1, CHARTAB_SIZE_BITS_2, CHARTAB_SIZE_BITS_3)
+ (DEFAULT_HASH_SIZE, COMPILED_ARGLIST, COMPILED_BYTECODE)
+ (COMPILED_CONSTANTS, COMPILED_STACK_DEPTH, COMPILED_DOC_STRING)
+ (COMPILED_INTERACTIVE, CHAR_ALT, CHAR_SUPER, CHAR_HYPER, CHAR_SHIFT)
+ (CHAR_CTL, CHAR_META, CHAR_MODIFIER_MASK, CHARACTERBITS)
+ (MANY, UNEVALLED, FLOAT_TO_STRING_BUFSIZE, MAX_ALLOCA):
+ Now constants, for GDB. They need not be macros.
+ (MOST_POSITIVE_FIXNUM, MOST_NEGATIVE_FIXNUM, STRING_BYTES_BOUND):
+ Now constants, for GDB, as well as macros, for static initializers.
+ (CHAR_TABLE_STANDARD_SLOTS, CHAR_TABLE_EXTRA_SLOTS):
+ Move to after the definition of struct Lisp_Char_Table,
+ since the former now needs that type defined.
+ (enum CHARTAB_SIZE_BITS, enum CHAR_TABLE_STANDARD_SLOTS)
+ (enum DEFAULT_HASH_SIZE, enum Lisp_Compiled, enum char_bits)
+ (enum maxargs, enum FLOAT_TO_STRING_BUFSIZE, enum MAX_ALLOCA):
+ New enums, for gdb_make_enums_visible.
+ (GLYPH_MODE_LINE_FACE): Remove; unused.
+ * alloc.c (STRING_BYTES_MAX): Now a constant, not a macro.
+ (gdb_make_enums_visible): Add enum CHARTAB_SIZE_BITS, enum
+ CHAR_TABLE_STANDARD_SLOTS, enum char_bits, enum DEFAULT_HASH_SIZE,
+ enum FLOAT_TO_STRING_BUFSIZE, enum Lisp_Bits, enum Lisp_Compiled,
+ enum maxargs, enum MAX_ALLOCA.
+ (ARRAY_MARK_FLAG_VAL, PSEUDOVECTOR_FLAG_VAL, VALMASK_VAL): Remove.
+ (ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK): Remove;
+ no longer needed, now that they are done in lisp.h.
+
+2012-07-30 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup string bytes checking.
+ * alloc.c (GC_STRING_BYTES, CHECK_STRING_BYTES): Remove. Convert
+ all users to STRING_BYTES or string_bytes if GC_CHECK_STRING_BYTES.
+ (check_string_bytes): Define to empty if not GC_CHECK_STRING_BYTES.
+ (check_sblock, compact_small_strings): Simplify.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (LISP_INT_TAG, LISP_INT1_TAG, LISP_STRING_TAG): Remove.
+ These macros are confusing and no longer need to be defined, as
+ the enum values now suffice. All uses replaced with definiens.
+ (Lisp_Int1, Lisp_String): Define directly; this is clearer.
+
+2012-07-29 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (LISP_H, $(BLD)/emacs.$(O), $(BLD)/w32inevt.$(O))
+ ($(BLD)/w32console.$(O)): Update dependencies.
+
+2012-07-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove HIDE_LISP_IMPLEMENTATION and cleanup cons free list check.
+ * lisp.h (HIDE_LISP_IMPLEMENTATION): Remove as useless for a long
+ time. Adjust users.
+ (CHECK_CONS_LIST): Remove. Convert all users to check_cons_list.
+
+2012-07-29 Jan Djärv <jan.h.d@swipnet.se>
+
+ * lread.c (init_lread): Remove if-statement in ifdef HAVE_NS before
+ setting sitelisp (Bug#12010).
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * w32heap.h (OS_9X): Rename from OS_WINDOWS_95.
+
+ * w32heap.c (cache_system_info):
+ * w32.c (sys_rename):
+ * w32proc.c (find_child_console, sys_kill): All users changed.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (Fgarbage_collect): Indent as per usual Emacs style.
+
+2012-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (LISP_H): Add $(NT_INC)/stdalign.h.
+
+2012-07-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup statistics calculation in Fgarbage_collect.
+ * alloc.c (Fgarbage_collect): Rename t1 to meaningful start.
+ Fix zombies percentage calculation. Simplify elapsed time calculation.
+
+2012-07-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Generalize marker debugging code under MARKER_DEBUG and use eassert.
+ * insdel.c (CHECK_MARKERS, check_markers_debug_flag): Remove.
+ (gap_left, gap_right, adjust_markers_for_delete, insert_1_both)
+ (insert_from_string_1, insert_from_gap, insert_from_buffer_1)
+ (replace_range, replace_range_2, del_range_2): Change to eassert.
+ * marker.c (byte_char_debug_check): Adjust style.
+
+2012-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't use the abbreviation "win" to refer to Windows (Bug#10421).
+ * regex.c (MAX_BUF_SIZE): Remove some incorrect and
+ long-ago-commented-out code that talks about "WIN32".
+ * w32heap.h (OS_WINDOWS_95): Rename from OS_WIN95.
+ All uses changed.
+
+2012-07-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use Gnulib stdalign module (Bug#9772, Bug#9960).
+ * alloc.c (XMALLOC_BASE_ALIGNMENT, GC_POINTER_ALIGNMENT, pure_alloc):
+ Simplify by using alignof.
+ (pure_alloc) [! USE_LSB_TAG]: Don't over-align EMACS_INT values.
+ * lisp.h: Include <stdalign.h>.
+ (GCALIGNMENT): New macro and constant.
+ (DECL_ALIGN): Remove. All uses replaced by alignas (GCALIGNMENT).
+ (USE_LSB_TAG): ifdef on alignas, not on DECL_ALIGN.
+ (stdalign): New macro, if not already defined.
+
+2012-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ Fix non-ASCII input in non-GUI frames on MS-Windows. (Bug#12055)
+ * w32inevt.c: Include w32inevt.h.
+ (w32_read_console_input): New inline function, calls either
+ ReadConsoleInputA or ReadConsoleInputW, depending on the value of
+ w32_console_unicode_input.
+ (fill_queue): Call w32_read_console_input instead of ReadConsoleInput.
+ (w32_kbd_patch_key, key_event): Use the codepage returned by
+ GetConsoleCP, rather than the ANSI codepage returned by GetLocaleInfo.
+ (key_event): use uChar.UnicodeChar only if
+ w32_console_unicode_input is non-zero.
+
+ * w32console.c: Include w32heap.h.
+ <w32_console_unicode_input>: New global variable.
+ (initialize_w32_display): Set w32_console_unicode_input to 1 on NT
+ family of Windows, zero otherwise.
+
+ * w32inevt.h: Declare w32_console_unicode_input.
+
+ * xdisp.c (init_iterator): Don't reference tip_frame in a build
+ --without-x. (Bug#11742)
+
+2012-07-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ 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 <http://bugs.gnu.org/12036#30>.
+
+2012-07-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (XD_DBUS_VALIDATE_BUS_ADDRESS): Canonicalize session
+ bus address.
+ (xd_close_bus, Fdbus_init_bus): Handle reference counter properly.
+
+2012-07-27 Eli Zaretskii <eliz@gnu.org>
+
+ * alloc.c (listn): Fix the order the arguments are consed onto the
+ list.
+
+ * lisp.h (enum constype): Use CONSTYPE_HEAP and CONSTYPE_PURE for
+ enumeration constants, as PURE and HEAP are too general, and clash
+ with other headers and sources, such as gmalloc.c and the
+ MS-Windows system headers. All users changed.
+
+2012-07-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Revert last save_excursion_save and save_excursion_restore changes.
+ * alloc.c, editfns.c, marker.c, lisp.h: Revert.
+ Lots of crashes reported by Chong Yidong <cyd@gnu.org>.
+
+2012-07-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix recently-introduced typos in Windows port.
+ Reported by Martin Rudalics <rudalics@gmx.at>.
+ * w32.c (init_environment): Replace comma with semicolon.
+ * w32fns.c (syms_of_w32fns): Add missing parenthesis.
+
+2012-07-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve GDB symbol export (Bug#12036).
+ * .gdbinit (xgetptr, xgetint, xgettype): Set $bugfix in different
+ arms of an 'if', not using conditional expressions; otherwise GDB
+ complains about the types in the unevaluated arm when the argument
+ is an integer literal.
+ (xgetint): Simplify expression.
+ * alloc.c (gdb_make_enums_visible): New constant. This ports to
+ GCC 3.4.2 the export of symbols to GDB. Problem reported by Eli
+ Zaretskii in <http://bugs.gnu.org/12036#13>.
+ * lisp.h (PUBLISH_TO_GDB): Remove. All uses removed. No longer
+ needed now that we have gdb_make_enums_visible.
+ (enum CHECK_LISP_OBJECT_TYPE, enum Lisp_Bits, enum More_Lisp_Bits)
+ (enum enum_USE_LSB_TAG):
+ New enum types, packaging up enums that need to be exported to GDB.
+
+2012-07-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Utility function to make a list from specified amount of objects.
+ * lisp.h (enum constype): New datatype.
+ (listn): New prototype.
+ * alloc.c (listn): New function.
+ (Fmemory_use_count, syms_of_alloc): Use it.
+ * buffer.c (syms_of_buffer): Likewise.
+ * callint.c (syms_of_callint): Likewise.
+ * charset.c (define_charset_internal): Likewise.
+ * coding.c (syms_of_coding): Likewise.
+ * keymap.c (syms_of_keymap): Likewise.
+ * search.c (syms_of_search): Likewise.
+ * syntax.c (syms_of_syntax): Likewise.
+ * w32.c (init_environment): Likewise.
+ * w32fns.c (Fw32_battery_status, syms_of_w32fns): Likewise.
+ * xdisp.c (syms_of_xdisp): Likewise.
+ * xfns.c (syms_of_xfns): Likewise.
+
+2012-07-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fast save_excursion_save and save_excursion_restore.
+ * lisp.h (struct Lisp_Excursion): New data type.
+ (PVEC_EXCURSION): New pseudovector type.
+ (XEXCURSION, XSETEXCURSION, EXCURSIONP): Convenient macros
+ to deal with it. Adjust comments.
+ (init_marker, attach_marker): New prototype.
+ (unchain_marker): Adjust prototype.
+ * marker.c (attach_marker): Change to global.
+ (init_marker): New function.
+ * alloc.c (Fmake_marker, build_marker): Use it.
+ (build_marker): More easserts.
+ (mark_object): Handle struct Lisp_Excursion.
+ * editfns.c (save_excursion_save, save_excursion_restore):
+ Reimplement to use struct Lisp_Excursion. Add comments.
+
+2012-07-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix export of symbols to GDB (Bug#12036).
+ * alloc.c (ARRAY_MARK_FLAG_VAL, PSEUDOVECTOR_FLAG_VAL, VALMASK_VAL)
+ (ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK): Move these here from
+ emacs.c, as this is a more-suitable home. Had this been done earlier
+ the fix for 12036 would have avoided some of the problems noted in
+ <http://bugs.gnu.org/12036#13> by Eli Zaretskii, as the scope problems
+ would have been more obvious.
+ * emacs.c: Do not include <verify.h>; no longer needed.
+ (gdb_CHECK_LISP_OBJECT_TYPE, gdb_DATA_SEG_BITS)
+ (gdb_GCTYPEBITS, gdb_USE_LSB_TAG)
+ (CHECK_LISP_OBJECT_TYPE, DATA_SEG_BITS, GCTYPEBITS, USE_LSB_TAG):
+ Remove; now done in lisp.h.
+ * lisp.h (PUBLISH_TO_GDB): New macro.
+ (GCTYPEBITS, USE_LSB_TAG, CHECK_LISP_OBJECT_TYPE, enum pvec_type)
+ (DATA_SEG_BITS): Use it.
+ (GCTYPEBITS, USE_LSB_TAG): Now also an enum, for GDB.
+ (CHECK_LISP_OBJECT_TYPE, DATA_SEG_BITS): Now just an enum, for GDB.
+ * mem-limits.h (EXCEEDS_LISP_PTR): Redo so that DATA_SEG_BITS need
+ not be usable in #if. This simplifies things.
+
+2012-07-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/emacs.$(O)): Update dependencies.
+
+2012-07-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify export of symbols to GDB (Bug#12036).
+ * .gdbinit (xgetptr, xgetint, xgettype): Don't use "set $bugfix =
+ $bugfix.i", as this doesn't work (with GDB 7.4.1, anyway).
+ (xgetptr, xgetint, xgettype, xcoding, xcharset, xprintbytestr):
+ Adjust to changes in lisp.h and emacs.c, by using
+ CHECK_LISP_OBJECT_TYPE rather than gdb_use_struct, VALMASK instead
+ of $valmask, DATA_SEG_BITS instead of gdb_data_seg_bits,
+ INTTYPEBITS instead of gdb_gctypebits - 1, USE_LSB_TAG instead of
+ gdb_use_lsb, (1 << GCTYPEBITS) - 1 instead of $tagmask, VALBITS
+ instead of gdb_valbits.
+ (xvectype, xvector, xpr, xprintstr, xbacktrace): Similarly, use
+ PSEUDOVECTOR_FLAG instead of PVEC_FLAG, and ARRAY_MARK_FLAG
+ instead of gdb_array_mark_flag.
+ (xboolvector): Get size from $->size, not $->header.size.
+ Use BOOL_VECTOR_BITS_PER_CHAR rather than mystery constants.
+ (xreload, hook-run, hookpost-run): Remove.
+ * emacs.c: Include <verify.h>.
+ (gdb_use_lsb, gdb_use_struct, gdb_valbits, gdb_gctypebits)
+ (gdb_data_seg_bits, PVEC_FLAG, gdb_array_mark_flag, gdb_pvec_type):
+ Remove.
+ (gdb_CHECK_LISP_OBJECT_TYPE, gdb_DATA_SEG_BITS, gdb_GCTYPEBITS)
+ (gdb_USE_LSB_TAG): New enum constants.
+ (CHECK_LISP_OBJECT_TYPE, DATA_SEG_BITS, GCTYPEBITS, USE_LSB_TAG):
+ Also define these as enum constants, so they're visible to GDB.
+ (ARRAY_MARK_FLAG_VAL, PSEUDOVECTOR_FLAG_VAL, VALMASK_VAL): New macros.
+ (ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK): Also define these
+ as constants, so they're visible to GDB.
+ * lisp.h (VALBITS, INTTYPEBITS, FIXNUM_BITS, PSEUDOVECTOR_SIZE_BITS)
+ (PSEUDOVECTOR_SIZE_MASK, PVEC_TYPE_MASK, BOOL_VECTOR_BITS_PER_CHAR):
+ Now enum constants, not macros, so they're visible to GDB.
+ (CHECK_LISP_OBJECT_TYPE, DATA_SEG_BITS): Default to 0, as this is
+ more convenient now. All uses changed.
+ (VALMASK) [USE_LSB_TAG]: Also define in this case.
+ * mem-limits.h (EXCEEDS_LISP_PTR): Adjust to DATA_SEG_BITS change.
+
+2012-07-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Explicitly free restriction data that are not needed anymore.
+ * editfns.c (save_restriction_restore): Free restriction data.
+
+2012-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fautoload_do_load): Rename from do_autoload, export to Lisp,
+ add argument, tune behavior, and adjust all callers.
+
+2012-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use typedef for EMACS_INT, EMACS_UINT.
+ * lisp.h, s/ms-w32.h (EMACS_INT, EMACS_UINT): Use typedefs rather
+ than macros. This simplifies debugging in the usual case, since
+ it lets GDB show addresses as 'EMACS_INT *' rather than 'long int *'
+ and it allows expressions involving EMACS_INT casts.
+ * .gdbinit (xreload): Simplify by using EMACS_INT cast.
+
+2012-07-25 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (ns_read_socket): Return early if there is a modal
+ window (Bug#12043).
+
+2012-07-25 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.c (Fredirect_frame_focus): In doc-string don't mention
+ that FOCUS-FRAME can be omitted.
+
+2012-07-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Adjust buffer text indirection counters at the end of Fkill_buffer.
+ * buffer.c (Fkill_buffer): Adjust indirection counters when the
+ buffer is definitely dead. This should really fix an issue reported
+ by Christoph Scholtes again. (Bug#12007).
+ (init_buffer_once): Initialize indirection counters of
+ buffer_defaults and buffer_local_symbols (for sanity and safety).
+
+2012-07-24 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (init_iterator): Don't compute dimensions of truncation
+ and continuation glyphs on tooltip frames, leave them at zero.
+ Avoids continued lines in tooltips. (Bug#11832)
+
+2012-07-24 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simplify copy_overlay.
+ * buffer.c (copy_overlay): Simplify. Use build_marker.
+ * lisp.h (struct Lisp_Overlay): Restore comment with minor tweaks.
+
+2012-07-23 Eli Zaretskii <eliz@gnu.org>
+
+ * print.c (print_object): Don't crash when a frame's name is nil
+ or invalid. (Bug#12025)
+
+ * window.c (decode_any_window): Disable CHECK_LIVE_FRAME test, as
+ it signals an error when a tooltip frame is being created.
+
+2012-07-23 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup miscellaneous objects allocation and initialization.
+ * alloc.c (allocate_misc): Change to static. Add argument to
+ specify the subtype. Adjust comment and users.
+ (build_overlay): New function.
+ * buffer.c (copy_overlays, Fmake_overlay): Use it.
+ * lisp.h (struct Lisp_Overlay): Remove obsolete comment.
+ (allocate_misc): Remove prototype.
+ (build_overlay): Add prototype.
+
+2012-07-23 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Swap buffer text indirection counters in Fbuffer_swap_text.
+ * buffer.c (Fbuffer_swap_text): Swap indirections too.
+ This avoids crash reported by Christoph Scholtes at
+ http://lists.gnu.org/archive/html/bug-gnu-emacs/2012-07/msg00785.html.
+
+2012-07-22 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsmenu.m (Popdown_data): New struct.
+ (pop_down_menu): p->pointer is Popdown_data. Release the pool and
+ free Popdown_data.
+ (ns_popup_dialog): Use NSAutoreleasePool and pass it to pop_down_menu.
+ (initWithContentRect): Make imgView and contentView non-static
+ and autorelease them. Also autorelease img and matrix (Bug#12005).
+ (dealloc): Remove (Bug#12005).
+
+2012-07-22 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Adjust consing_since_gc when objects are explicitly freed.
+ * alloc.c (GC_DEFAULT_THRESHOLD): New macro.
+ (Fgarbage_collect): Use it. Change minimum to 1/10 of default.
+ (free_cons, free_misc): Subtract object size from consing_since_gc.
+
+2012-07-22 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simplify and cleanup markers positioning code.
+ * marker.c (attach_marker): More useful eassert.
+ (live_buffer, set_marker_internal): New function.
+ (Fset_marker, set_marker_restricted): Use set_marker_internal.
+ (set_marker_both, set_marker_restricted_both): Use live_buffer.
+
+2012-07-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.h (struct buffer.indirections): Now ptrdiff_t, not int,
+ as it's limited by the amount of memory, not by INT_MAX.
+
+2012-07-21 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (keys_of_keyboard): Bind language-change to 'ignore'
+ in special-event-map. See the discussion at
+ http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00417.html
+ 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 <fabrice.popineau@supelec.fr>.
+
+2012-07-21 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (accessibilityAttributeValue): New function. (Bug#11134).
+ (conversationIdentifier): Return value is NSInteger.
+ * nsterm.m (accessibilityAttributeValue): Surround with NS_IMPL_COCOA.
+
+2012-07-21 Chong Yidong <cyd@gnu.org>
+
+ * window.c (decode_any_window): Signal an error if the window is
+ on a dead frame (Bug#11984).
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Add indirection counting to speed up Fkill_buffer.
+ * buffer.h (struct buffer): New member.
+ * buffer.c (Fget_buffer_create): Set indirection counter to 0.
+ (Fmake_indirect_buffer): Set indirection counter to -1, increment
+ base buffer indirection counter.
+ (compact_buffer): If ENABLE_CHECKING, verify indirection counters.
+ (Fkill_buffer): Adjust indirection counters as needed, don't walk
+ through buffer list if indirection counter is 0.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Extend the value returned by Fgarbage_collect with heap statistics.
+ * alloc.c (Qheap): New symbol.
+ (syms_of_alloc): DEFSYM it.
+ (Fgarbage_collect): If DOUG_LEA_MALLOC, add mallinfo data.
+ (Fmemory_free): Remove.
+ (syms_of_alloc): Don't defsubr it.
+ * buffer.c (Fcompact_buffer): Remove.
+ (syms_of_buffer): Don't defsubr it.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Make maybe_gc inline.
+ Verify that inlining is always possible (GCC 4.7.1, -O3 -Winline).
+ * lisp.h (consing_since_gc, gc_relative_threshold)
+ (memory_full_cons_threshold): Revert declaration.
+ (maybe_gc): Remove prototype, define as inline.
+ * alloc.c: Remove old commented-out code.
+ (consing_since_gc, gc_relative_threshold)
+ (memory_full_cons_threshold): Revert to global.
+ (maybe_gc): Remove.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simple wrapper for make_unibyte_string, adjust font_open_by_name.
+ * lisp.h (build_unibyte_string): New function.
+ * dosfns.c, fileio.c, fns.c, ftfont.c, process.c:
+ * sysdep.c, w32fns.c, xfns.c: Use it.
+ * font.c (font_open_by_name): Change 2nd and 3rd args to the only arg
+ of type Lisp_Object to avoid redundant calls to make_unibyte_string.
+ Adjust users accordingly.
+ * font.h (font_open_by_name): Adjust prototype.
+
+2012-07-20 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup calls to Fgarbage_collect.
+ * lisp.h (maybe_gc): New prototype.
+ (consing_since_gc, gc_relative_threshold, memory_full_cons_threshold):
+ Remove declarations.
+ * alloc.c (maybe_gc): New function.
+ (consing_since_gc, gc_relative_threshold, memory_full_cons_threshold):
+ Make them static.
+ * bytecode.c (MAYBE_GC): Use maybe_gc.
+ * eval.c (eval_sub, Ffuncall): Likewise.
+ * keyboard.c (read_char): Likewise. Adjust call to maybe_gc
+ to avoid dependency from auto-save feature.
+
+2012-07-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * buffer.h (FOR_EACH_BUFFER): Rename from 'for_each_buffer'.
+ (FOR_EACH_PER_BUFFER_OBJECT_AT): Rename from
+ 'for_each_per_buffer_object_at'.
+ All uses changed. It's better to use upper-case for macros that
+ cannot be implemented as functions, to give the reader a clue
+ that they're special.
+
+2012-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (Fgarbage_collect): Tweak docstring.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Tweak the value returned from Fgarbage_collect again.
+ * alloc.c (Fgarbage_collect): New return value, as confirmed in
+ http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00418.html.
+ Adjust documentation.
+ (total_vector_bytes): Rename to total_vector_slots, adjust
+ accounting.
+ (total_free_vector_bytes): Rename to total_free_vector_slots,
+ adjust accounting.
+ (Qstring_bytes, Qvector_slots): New symbols.
+ (syms_of_alloc): DEFSYM them.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Buffer compaction primitive which may be used from Lisp.
+ * buffer.c (compact_buffer, Fcompact_buffer): New function.
+ (syms_of_buffer): Register Fcompact_buffer.
+ * alloc.c (Fgarbage_collect): Use compact_buffer.
+ * buffer.h (compact_buffer): New prototype.
+ (struct buffer_text): New member.
+
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ New macro to iterate over all buffers, miscellaneous cleanups.
+ * lisp.h (all_buffers): Remove declaration.
+ * buffer.h (all_buffers): Add declaration, with comment.
+ (for_each_buffer): New macro.
+ * alloc.c (Fgarbage_collect, mark_object): Use it.
+ * buffer.c (Fkill_buffer, Fbuffer_swap_text, Fset_buffer_multibyte)
+ (init_buffer): Likewise.
+ * data.c (Fset_default): Likewise.
+ * coding.c (code_conversion_restore): Remove redundant check
+ for dead buffer.
+ * buffer.c (Fkill_buffer): Likewise. Remove obsolete comment.
+
+2012-07-18 Andreas Schwab <schwab@linux-m68k.org>
+
+ Fix bug that created negative-length intervals.
+ * intervals.c (merge_interval_right, merge_interval_left):
+ Do not zero out this interval if it is absorbed by its children,
+ as this interval's total length doesn't change in that case. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00403.html>.
+
+2012-07-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (Fmake_bool_vector): Fix off-by-8 bug
+ when invoking (make-bool-vector N t) and N is a positive
+ multiple of 8 -- the last 8 bits were mistakenly cleared.
+
+ Remove some struct layout assumptions in bool vectors.
+ * alloc.c (bool_header_size): New constant.
+ (header_size, word_size): Move earlier, as they're now used earlier.
+ Use 'word_size' in a few more places, where it's appropriate.
+ (Fmake_bool_vector, sweep_vectors): Don't assume that there is no
+ padding before the data member of a bool vector.
+ (sweep_vectors): Use PSEUDOVECTOR_TYPEP, in an eassert, rather
+ than doing the check by hand with an abort ().
+
+2012-07-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fdefvar): Don't check constants since we only set the var if
+ it's not yet defined anyway (bug#11904).
+
+ * lisp.h (last_undo_boundary): Declare new var.
+ * keyboard.c (command_loop_1): Set it.
+ * cmds.c (Fself_insert_command): Use it to only remove boundaries that
+ were auto-added by the command loop (bug#11774).
+
+2012-07-18 Andreas Schwab <schwab@linux-m68k.org>
+
+ * w32font.c (Qsymbol): Remove local definition.
+ (syms_of_w32font): Don't DEFSYM it.
+
+2012-07-18 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix sweep_vectors to handle large bool vectors correctly.
+ * alloc.c (sweep_vectors): Account total_vector_bytes for
+ bool vectors larger than VBLOCK_BYTES_MAX.
+
+2012-07-18 Chong Yidong <cyd@gnu.org>
+
+ * frame.c (x_set_frame_parameters): Revert bogus change introduced
+ in 2012-05-25 commit by Paul Eggert (Bug#11738).
+
+2012-07-18 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Return more descriptive data from Fgarbage_collect.
+ Suggested by Stefan Monnier in
+ http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00369.html.
+ * alloc.c (bounded_number): New function.
+ (total_buffers, total_vectors): New variable.
+ (total_string_size): Rename to total_string_bytes, adjust users.
+ (total_vector_size): Rename to total_vector_bytes, adjust users.
+ (sweep_vectors): Account total_vectors and total_vector_bytes.
+ (Fgarbage_collect): New return value. Adjust documentation.
+ (gc_sweep): Account total_buffers.
+ (Fmemory_free, Fmemory_use_counts): Use bounded_number.
+ (VECTOR_SIZE): Remove.
+ * data.c (Qfloat, Qvector, Qsymbol, Qstring, Qcons): Make global.
+ (Qinterval, Qmisc): New symbols.
+ (syms_of_data): Initialize them.
+ * lisp.h (Qinterval, Qsymbol, Qstring, Qmisc, Qvector, Qfloat)
+ (Qcons, Qbuffer): New declarations.
+
+2012-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (Fmemory_free): Account for memory-free's own storage.
+ Round up, not down. Improve doc.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Restore old code in allocate_string_data to avoid Faset breakage.
+ Reported by Julien Danjou <julien@danjou.info> in
+ http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00371.html.
+ * alloc.c (allocate_string_data): Restore old code with minor
+ adjustments, fix comment to explain this subtle issue.
+
+2012-07-17 Eli Zaretskii <eliz@gnu.org>
+
+ Remove FILE_SYSTEM_CASE.
+ * s/msdos.h (FILE_SYSTEM_CASE): Don't define.
+
+ * fileio.c (FILE_SYSTEM_CASE): Don't define.
+ (Ffile_name_directory, Fexpand_file_name): Don't use FILE_SYSTEM_CASE.
+ Fixes problems on MS-DOS with Vtemp_file_name_pattern when
+ call-process-region passes it through expand-file-name.
+
+ * dired.c (file_name_completion): Don't use FILE_SYSTEM_CASE.
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ Fix crash when creating indirect buffer (Bug#11917)
+ * buffer.c (buffer_lisp_local_variables): Add argument CLONE.
+ Don't handle unbound variables specially if non-zero.
+ (Fbuffer_local_variables): Pass zero.
+ (clone_per_buffer_values): Pass non-zero.
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnutls.c (emacs_gnutls_handshake): Revert last change. Add QUIT
+ to make the loop interruptible.
+
+2012-07-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnutls.c (emacs_gnutls_handshake): Only retry if
+ GNUTLS_E_INTERRUPTED.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup and convert miscellaneous checks to eassert.
+ * alloc.c (mark_interval): Fix comment, partially rephrase
+ old comment from intervals.h (see below).
+ * intervals.c (find_interval, adjust_intervals_for_insertion)
+ (delete_interval, adjust_intervals_for_deletion)
+ (graft_intervals_into_buffer, temp_set_point_both, copy_intervals):
+ Convert to eassert.
+ (adjust_intervals_for_insertion, make_new_interval):
+ Remove obsolete and unused code.
+ * intervals.h (struct interval): Remove obsolete comment.
+ * textprotp.c (erase_properties): Remove unused code.
+ (Fadd_text_properties, set_text_properties_1, Fremove_text_properties)
+ (Fremove_list_of_text_properties): Convert to eassert.
+
+2012-07-17 Chong Yidong <cyd@gnu.org>
+
+ * editfns.c (Finsert_char): Doc fix.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix previous change to make Fmemory_free always accurate.
+ * alloc.c (make_interval): Update total_free_intervals.
+ (make_float): Likewise for total_free_floats.
+ (free_cons, Fcons): Likewise for total_free_conses.
+ (SETUP_ON_FREE_LIST, allocate_vector_from_block):
+ Likewise for total_free_vector_bytes.
+ (Fmake_symbol): Likewise for total_free_symbols.
+ (bytes_free): Remove.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simple free memory accounting feature.
+ * alloc.c (bytes_free, total_free_vector_bytes): New variable.
+ (sweep_vectors): Accumulate size of free vectors.
+ (Fgarbage_collect): Setup bytes_free.
+ (Fmemory_free): New function.
+ (syms_of_alloc): Register it.
+
+2012-07-17 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup overlays checking.
+ * buffer.h (OVERLAY_VALID): Remove as useless synonym of OVERLAYP.
+ * buffer.c (overlay_touches_p, recenter_overlay_lists): Change to
+ eassert and OVERLAYP.
+ (sort_overlays): Change to use OVERLAYP.
+
+2012-07-16 René Kyllingstad <Rene@Kyllingstad.com> (tiny change)
+
+ * editfns.c (Finsert_char): Make it interactive, and make the
+ second arg optional. Copy interactive spec and docstring from
+ ucs-insert.
+
+2012-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * floatfns.c (Fabs): Do not wrap fabs inside IN_FLOAT (Bug#11913).
+ Unlike the other wrapped functions, fabs has an unspecified
+ effect on errno.
+
+2012-07-16 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (keyDown): Interpret flags without left/right bits
+ as the left key (Bug#11670).
+
+2012-07-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Remove empty and useless init functions.
+ * lisp.h (init_character_once, init_fns, init_image)
+ (init_filelock, init_sound): Remove prototype.
+ * character.c (init_character_once): Remove.
+ * filelock.c (init_filelock): Likewise.
+ * fns.c (init_fns): Likewise.
+ * image.c (init_image): Likewise.
+ * sound.c (init_sound): Likewise.
+ * emacs.c (main): Adjust accordingly.
+
+2012-07-16 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * gtkutil.h: Tiny cleanups.
+ (use_old_gtk_file_dialog): Remove useless declaration.
+ (xg_uses_old_file_dialog): Add suggested const attribute.
+
+2012-07-15 Eli Zaretskii <eliz@gnu.org>
+
+ * bidi.c (MAX_STRONG_CHAR_SEARCH): New macro.
+ (bidi_paragraph_init): Use it to limit search forward for a strong
+ directional character in abnormally large paragraphs full of
+ neutral or weak characters. (Bug#11943)
+
+2012-07-15 Stefano Facchini <stefano.facchini@gmail.com> (tiny change)
+
+ * gtkutil.c (xg_create_tool_bar): Apply "primary-toolbar" style to
+ the toolbar (Bug#9451).
+ (xg_make_tool_item): Give the widget event box a transparent
+ background.
+
+2012-07-15 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup basic allocation variables and functions.
+ * alloc.c (ignore_warnings, init_intervals, init_float)
+ (init_cons, init_symbol, init_marker): Remove.
+ (interval_block_index): Initialize to INTERVAL_BLOCK_SIZE.
+ (float_block_index): Initialize to FLOAT_BLOCK_SIZE.
+ (cons_block_index): Initialize to CONS_BLOCK_SIZE.
+ (symbol_block_size): Initialize to SYMBOL_BLOCK_SIZE.
+ (marker_block_index): Initialize to MARKER_BLOCK_SIZE.
+ (staticidx, init_alloc_once, init_strings, free_ablock):
+ Remove redundant initialization.
+ * fns.c (init_weak_hash_tables): Remove.
+ * lisp.h (init_weak_hash_tables): Remove prototype.
+
+2012-07-15 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use zero_vector where appropriate.
+ * alloc.c (zero_vector): Define as Lisp_Object. Adjust users
+ accordingly.
+ * lisp.h (zero_vector): New declaration.
+ * font.c (null_vector): Remove.
+ (syms_of_font): Remove initialization and staticpro.
+ (font_list_entities, font_find_for_lface): Change to use zero_vector.
+ * keymap.c (Faccessible_keymaps): Likewise.
+
+2012-07-15 Leo Liu <sdl.web@gmail.com>
+
+ * fringe.c: Fix typo in comments.
+
+2012-07-14 Leo Liu <sdl.web@gmail.com>
+
+ * fringe.c: Add a new bitmap exclamation-mark.
+
+2012-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ * gmalloc.c (GMALLOC_INHIBIT_VALLOC): Don't reference.
+
+ * s/msdos.h (BSD_SYSTEM, DATA_START, GC_SETJMP_WORKS, HAVE_MOUSE)
+ (HAVE_MENUS): Don't define, defined by editing config.in with
+ msdos/sed2v2.inp.
+ (GMALLOC_INHIBIT_VALLOC): Don't define.
+ (MODE_LINE_BINARY_TEXT): Remove, not used anymore.
+
+2012-07-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * s/ms-w32.h (GC_SETJMP_WORKS, GC_MARK_STACK): Set in nt/config.nt.
+
+2012-07-14 Glenn Morris <rgm@gnu.org>
+
+ * s/aix4-2.h, s/freebsd.h, s/gnu-linux.h, s/hpux10-20.h:
+ * s/irix6-5.h, s/netbsd.h, s/sol2-6.h, s/unixware.h:
+ Let configure set GC_SETJMP_WORKS, GC_MARK_STACK.
+
+2012-07-13 Glenn Morris <rgm@gnu.org>
+
+ * s/gnu-linux.h (GC_MARK_SECONDARY_STACK): Let configure set it.
+
+ * s/usg5-4-common.h (SETUP_SLAVE_PTY): Let configure set it.
+ * s/irix6-5.h (SETUP_SLAVE_PTY): No more need to unset it.
+
+2012-07-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (uRect): Only define if NS_IMPL_GNUSTEP.
+ (x_free_frame_resources): Pass x_free_frame_resources to NSTRACE.
+ (ns_lisp_to_color, ns_string_to_lispmod, ns_term_init)
+ (ns_term_shutdown, requestService, initFrameFromEmacs): Use SSDATA
+ where appropriate.
+ (ns_exec_path, ns_load_path, changeFont): Put () around assignment used
+ as boolean expression.
+ (x_set_window_size): Remove unused variable toolbar.
+ (ns_get_color_default, ns_mod_to_lisp): Remove.
+ (ns_mouse_position): Remove unused variables xchar and ychar.
+ (ns_compute_glyph_string_overhangs): Remove unused variable face.
+ (ns_set_vertical_scroll_bar): Remove unused variable count.
+ (ns_delete_terminal): Remove unused variable i.
+ (ns_term_init): Remove unused variables r, g and b.
+ (mouseDown): Remove unused variable window.
+ (windowDidResize): Move definition of theWindow inside NS_IMPL_GNUSTEP.
+ (initFrameFromEmacs): Remove unused variable vbextra.
+ (mouseEntered): Remove unused variables p and dpyinfo.
+ (mouseExited): Remove unused variables p and r.
+ (ns_define_frame_cursor, ns_clear_frame_area)
+ (ns_draw_window_cursor, ns_initialize_display_info): Make static.
+ (menuDown): Assign [sender tag] to variable and cast the variable.
+
+ * nsterm.h (menuDown): Add id as type to argument sender.
+ (ns_display_info_for_name): Add Lisp_Object argument.
+ (ns_term_init): Add Lisp_Object argument.
+ (ns_map_event_to_object): Add void argument.
+ (ns_string_from_pasteboard, ns_string_to_pasteboard): Add correct
+ prototype with arguments and only declare if __OBJC__.
+ (nxatoms_of_nsselect): Add void argument.
+ (ns_lisp_to_cursor_type): Add Lisp_Object argument.
+ (ns_alloc_autorelease_pool): Add void argument.
+ (ns_release_autorelease_pool): Add void* argument.
+ (ns_get_defaults_value): Add const char* argument.
+
+ * nsmenu.m (ns_update_menubar, ns_menu_show, process_dialog)
+ (initFromContents): Use SSDATA where appropriate.
+ (ns_update_menubar): Add braces to ambigous if-else.
+ (initWithTitle): Put () around assignment in if statement.
+ (ns_menu_show): Remove unused variables window and keymap.
+ (update_frame_tool_bar): Remove unused variable selected_p.
+ (initWithContentRect): Remove unused variable this_cmd_name.
+
+ * nsimage.m (ns_load_image, allocInitFromFile): Use SSDATA where
+ appropriate.
+ (setXBMColor): Remove unused variable len.
+ (setPixmapData): Put () around assignment in loop statement.
+
+ * nsfont.m (ns_get_family, ns_lang_to_script, ns_otf_to_script)
+ (ns_registry_to_script, ns_get_req_script, nsfont_open): Use SSDATA
+ where appropriate.
+ (ns_get_covering_families, ns_findfonts, nsfont_list_family): Put ()
+ around assignment in loop statement.
+ (nsfont_open): Remove unused variable i.
+ (nsfont_open): Remove unused variable len.
+ (nsfont_draw): Remove unused variable cs.
+
+ * nsfns.m (x_set_icon_name, ns_set_name_internal)
+ (ns_set_name_as_filename, ns_implicitly_set_icon_type)
+ (x_set_icon_type, ns_lisp_to_cursor_type, Fns_read_file_name)
+ (Fns_get_resource, Fns_set_resource, Fx_open_connection)
+ (Fns_font_name, Fns_perform_service)
+ (Fns_convert_utf8_nfd_to_nfc, ns_do_applescript)
+ (Fns_do_applescript, Fx_show_tip): Use SSDATA where appropriate.
+ (ns_set_name): Remove unused variable view.
+ (x_set_menu_bar_lines): Remove unused variable olines.
+ (x_set_tool_bar_lines): Remove unused variable root_window.
+ (Fns_list_colors): Put () around assignment in while statement.
+ (Fns_perform_service): Remove unused variable len.
+ (Fns_display_usable_bounds): Remove unused variable top.
+ (syms_of_nsfns): Remove unused variable i.
+
+ * nsmenu.m (ns_update_menubar): Exchange place of argument 2 and 3 to
+ memcpy (Bug#11907).
+
+2012-07-13 Kalle Kankare <kalle.kankare@iki.fi> (tiny change)
+
+ * image.c (Fimagemagick_types): Initialize ex with GetExceptionInfo
+ and free it with DestroyExceptionInfo (Bug#11558).
+
+2012-07-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * s/ms-w32.h (FIRST_PTY_LETTER, HAVE_SOCKETS): Move to nt/config.nt.
+ (HAVE_ATTRIBUTE_ALIGNED, HAVE_C99_STRTOLD, HAVE___BUILTIN_UNWIND_INIT):
+ Set here, not in nt/config.nt.
+
+2012-07-13 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (move_it_in_display_line_to): On GUI terminals, allow
+ cursor overflow into the last glyph on display line when the right
+ fringe is off. (Bug#11832)
+
+2012-07-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xdisp.c (produce_special_glyphs): Now static.
+ * dispextern.h (produce_special_glyphs): Remove decl.
+
+2012-07-13 Glenn Morris <rgm@gnu.org>
+
+ * s/bsd-common.h, s/cygwin.h: Remove empty files.
+ * s/freebsd.h, s/netbsd.h: Do not include bsd-common.h.
+
+ * s/usg5-4-common.h (USG, USG5):
+ * s/template.h (USG5, USG, HPUX, BSD4_2, BSD_SYSTEM):
+ * s/sol2-6.h (SOLARIS2):
+ * s/irix6-5.h (IRIX6_5):
+ * s/hpux10-20.h (USG, USG5, HPUX):
+ * s/gnu-linux.h (USG, GNU_LINUX):
+ * s/freebsd.h (BSD_SYSTEM):
+ * s/darwin.h (BSD4_2, BSD_SYSTEM, DARWIN_OS):
+ * s/cygwin.h (CYGWIN):
+ * s/bsd-common.h (BSD_SYSTEM, BSD4_2):
+ * s/aix4-2.h (USG, USG5, _AIX): Move "system type" macros to configure.
+
+2012-07-13 BT Templeton <bpt@hcoop.net> (tiny change)
+
+ * nsfont.m (ns_charset_covers): Don't abort if no bitmap (Bug#11853).
+
+2012-07-13 Glenn Morris <rgm@gnu.org>
+
+ * s/usg5-4-common.h (NSIG_MINIMUM): Let configure set it.
+
+ * s/gnu-linux.h, s/irix6-5.h: Let configure set ULIMIT_BREAK_VALUE.
+
+ * process.c (init_process_emacs): Replace MIN_PTY_KERNEL_VERSION.
+ * s/darwin.h (MIN_PTY_KERNEL_VERSION): Remove single-use macro.
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * s/darwin.h (SYSTEM_PURESIZE_EXTRA): Move to configure.
+
+ * process.c (init_process_emacs): Rename from init_process.
+ The old name is also the name of a Mach system call.
+ * lisp.h, emacs.c: Update for this name change.
+ * nsgui.h, sysselect.h, s/darwin.h: Remove workaround that is no
+ longer needed.
+
+2012-07-12 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (insert_left_trunc_glyphs): Fix incorrect size in
+ memmove call that removes glyphs covered by the left truncation
+ glyph. Improve commentary.
+ (display_line): Fix display of continuation glyphs on GUI frames
+ when the right fringe is turned off and variable-size fonts are
+ used in the window. Move the code that appends a stretch glyph to
+ produce_special_glyphs, so that it could be used for truncation
+ and continuation glyphs alike.
+ (produce_special_glyphs) [HAVE_WINDOW_SYSTEM]: Produce a stretch
+ glyph of a suitably computed width, to align the special glyphs at
+ the window margin. Code moved from display_line. (Bug#11832)
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * s/aix4-2.h, s/hpux10-20.h: Let configure set NO_EDITRES.
+
+ * s/gnu-linux.h, s/hpux10-20.h:
+ Do not unconditionally define HAVE_XRMSETDATABASE.
+
+ * s/gnu-linux.h (UNIX98_PTYS): Let configure set it.
+
+2012-07-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix typos that broke OS X build.
+ Reported by Randal L. Schwartz in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00225.html>.
+ * nsterm.m (ns_timeout): Add missing local decl.
+ (ns_get_color): snprintf -> sprintf, to fix typo.
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * src/s/aix4-2.h, src/s/cygwin.h, src/s/darwin.h:
+ * src/s/gnu-linux.h, src/s/hpux10-20.h, src/s/irix6-5.h:
+ * src/s/sol2-6.h, src/s/unixware.h, src/s/usg5-4-common.h:
+ Move PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF to configure.
+
+ * s/cygwin.h, s/darwin.h, s/gnu-linux.h, s/irix6-5.h:
+ Move PTY_OPEN to configure.
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/darwin.h:
+ * s/gnu-linux.h, s/hpux10-20.h, s/irix6-5.h, s/template.h:
+ * s/usg5-4-common.h: Move FIRST_PTY_LETTER, PTY_ITERATION to configure.
+
+2012-07-12 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use empty_unibyte_string where applicable.
+ * keyboard.c (parse_tool_bar_item): Use empty_unibyte_string.
+ * lread.c (read1): Likewise.
+ * xsettings.c (syms_of_xsettings): Likewise.
+
+2012-07-12 Glenn Morris <rgm@gnu.org>
+
+ * s/cygwin.h (G_SLICE_ALWAYS_MALLOC):
+ * s/freebsd.h (BROKEN_PTY_READ_AFTER_EAGAIN):
+ * s/irix6-5.h (SETPGRP_RELEASES_CTTY, PREFER_VSUSP):
+ * s/hpux10-20.h (RUN_TIME_REMAP):
+ * s/bsd-common.h (TABDLY): Move to configure.
+
+ * s/hpux10-20.h, s/sol2-6.h: Move XOS_NEEDS_TIME_H to configure.
+
+ * s/bsd-common.h, s/darwin.h: Move TAB3 to configure.
+
+ * s/aix4-2.h (BROKEN_FIONREAD, BROKEN_SIGAIO, BROKEN_SIGPTY)
+ (BROKEN_SIGPOLL, BROKEN_GET_CURRENT_DIR_NAME): Let configure set them.
+
+ * s/darwin.h (NO_ABORT, NO_MATHERR): Let configure set them.
+
+ * s/bsd-common.h, s/cygwin.h, s/gnu-linux.h, s/irix6-5.h:
+ * s/template.h: Move NARROWPROTO to configure.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * s/gnu-linux.h, s/sol2-6.h: No longer define POSIX,
+ unused since 2011-01-17 change to systty.h.
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/darwin.h, s/gnu-linux.h:
+ * s/hpux10-20.h, s/template.h, s/usg5-4-common.h:
+ Move HAVE_PTYS and HAVE_SOCKETS to configure.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * s/sol2-6.h (HAVE_LIBKSTAT): Remove. (Bug#11914)
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * s/darwin.h, s/gnu-linux.h, s/template.h:
+ Move INTERRUPT_INPUT to configure.
+
+2012-07-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Minor adjustments to interning code.
+ * 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.
+ * font.c (font_intern_prop): Likewise. Adjust comment.
+ * w32font.c (intern_font_name): Likewise.
+
+2012-07-11 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnutls.c (Fgnutls_boot): Properly parse :keylist argument.
+
+ * coding.c (Fdefine_coding_system_internal): Use XCAR/XCDR instead
+ of Fcar/Fcdr if possible.
+ * font.c (check_otf_features): Likewise.
+ * fontset.c (Fnew_fontset): Likewise.
+ * gnutls.c (Fgnutls_boot): Likewise.
+ * minibuf.c (read_minibuf): Likewise.
+ * msdos.c (IT_set_frame_parameters): Likewise.
+ * xmenu.c (Fx_popup_dialog): Likewise.
+ * w32menu.c (Fx_popup_dialog): Likewise.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * s/bsd-common.h, s/cygwin.h: No need to undefine INTERRUPT_INPUT,
+ since nothing has defined it on these platforms.
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/gnu-linux.h:
+ * s/irix6-5.h: Move SIGNALS_VIA_CHARACTERS to configure.
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/darwin.h:
+ * s/gnu-linux.h, s/hpux10-20.h, s/template.h, s/usg5-4-common.h:
+ Move CLASH_DETECTION to configure.
+
+ * s/gnu.h: Remove file, which is now empty.
+
+ * s/gnu.h, s/gnu-linux.h:
+ Move GNU_LIBRARY_PENDING_OUTPUT_COUNT to configure.
+
+2012-07-11 John Wiegley <johnw@newartisans.com>
+
+ * alloc.c (mark_memory): Guard the "no_address_safety_analysis"
+ function attribute, so we only use it if it exists in the
+ compiler.
+
+2012-07-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid call to strlen in fast_c_string_match_ignore_case.
+ * search.c (fast_c_string_match_ignore_case): Change to use
+ length argument. Adjust users accordingly.
+ * lisp.h (fast_c_string_match_ignore_case): Adjust prototype.
+
+2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume mkdir, rmdir.
+ * sysdep.c (mkdir) [!HAVE_MKDIR]: Remove.
+ * sysdep.c (rmdir) [!HAVE_RMDIR]: Remove.
+
+ Assume rename.
+ * sysdep.c (rename) [!HAVE_RENAME]: Remove.
+
+ Assume perror.
+ * s/hpux10-20.h (HAVE_PERROR): Remove.
+ * sysdep.c (perror) [HPUX && !HAVE_PERROR]:
+ Remove dummy definition, as this problem was obsolete long ago.
+
+ Assume strerror.
+ * sysdep.c (strerror) [!HAVE_STRERROR && !WINDOWSNT]: Remove.
+
+2012-07-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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.h (font_open_by_name, font_parse_xlfd, font_unparse_xlfd):
+ Adjust prototypes.
+ * xfont.c (xfont_decode_coding_xlfd, font_unparse_xlfd):
+ Change to return ptrdiff_t.
+ (xfont_list_pattern, xfont_match): Use length returned by
+ xfont_decode_coding_xlfd.
+ * xfns.c (x_default_font_parameter): Omit useless xstrdup.
+
+2012-07-11 Glenn Morris <rgm@gnu.org>
+
+ * s/darwin.h, s/freebsd.h, s/netbsd.h:
+ Move DONT_REOPEN_PTY to configure.
+
+ * sound.c (DEFAULT_SOUND_DEVICE) [!WINDOWSNT]:
+ * s/netbsd.h (DEFAULT_SOUND_DEVICE): Let configure set it.
+
+2012-07-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove "#define unix" that is no longer needed (Bug#11905).
+ * s/aix4-2.h (unix): Remove; no longer needed.
+
+ EMACS_TIME simplification (Bug#11875).
+ This replaces macros (which typically do not work in GDB)
+ with functions, typedefs and enums, making the code easier to debug.
+ The functional style also makes code easier to read and maintain.
+ * systime.h: Include <sys/time.h> on all hosts, not just if
+ WINDOWSNT, since 'struct timeval' is needed in general.
+ (EMACS_TIME): Now a typedef, not a macro.
+ (EMACS_TIME_RESOLUTION, LOG10_EMACS_TIME_RESOLUTION): Now constants,
+ not macros.
+ (EMACS_SECS, EMACS_NSECS, EMACS_TIME_SIGN, EMACS_TIME_VALID_P)
+ (EMACS_TIME_FROM_DOUBLE, EMACS_TIME_TO_DOUBLE, EMACS_TIME_EQ)
+ (EMACS_TIME_NE, EMACS_TIME_GT, EMACS_TIME_GE, EMACS_TIME_LT)
+ (EMACS_TIME_LE): Now functions, not macros.
+ (EMACS_SET_SECS, EMACS_SET_NSECS, EMACS_SET_SECS_NSECS)
+ (EMACS_SET_USECS, EMACS_SET_SECS_USECS): Remove these macros,
+ which are not functions. All uses rewritten to use:
+ (make_emacs_time): New function.
+ (EMACS_SECS_ADDR, EMACS_SET_INVALID_TIME, EMACS_GET_TIME)
+ (EMACS_ADD_TIME, EMACS_SUB_TIME): Remove these macros, which are
+ not functions. All uses rewritten to use the following, respectively:
+ (emacs_secs_addr, invalid_emacs_time, get_emacs_time)
+ (add_emacs_time, sub_emacs_time): New functions.
+ * atimer.c: Don't include <sys/time.h>, as "systime.h" does this.
+ * fileio.c (Fcopy_file):
+ * xterm.c (XTflash): Get the current time closer to when it's used.
+ * makefile.w32-in ($(BLD)/atimer.$(O)): Update dependencies.
+
+ * bytecode.c (targets): Suppress -Woverride-init warnings.
+
+ Simplify by avoiding confusing use of strncpy etc.
+ * doc.c (Fsnarf_documentation):
+ * fileio.c (Ffile_name_directory, Fsubstitute_in_file_name):
+ * frame.c (Fmake_terminal_frame):
+ * gtkutil.c (get_utf8_string):
+ * lread.c (openp):
+ * nsmenu.m (ns_update_menubar):
+ * regex.c (regerror):
+ Prefer memcpy to strncpy and strncat when either will do.
+ * fileio.c (Fsubstitute_in_file_name):
+ * keyboard.c (MULTI_LETTER_MOD, parse_modifiers_uncached)
+ (menu_separator_name_p):
+ * nsmenu.m (ns_update_menubar):
+ Prefer memcmp to strncmp when either will do.
+ * nsterm.m: Include <ftoastr.h>.
+ (ns_get_color):
+ * s/gnu-linux.h, s/sol2-6.h, s/unixware.h (PTY_TTY_NAME_SPRINTF):
+ Prefer snprintf to strncpy.
+ * nsterm.m (ns_term_init):
+ * widget.c (set_frame_size) [0]: Prefer xstrdup to xmalloc + strncpy.
+ * nsterm.m (ns_term_init):
+ Avoid the need for strncpy, by using build_string or
+ make_unibyte_string directly. Use dtoastr, not snprintf.
+ * process.c (Fmake_network_process): Diagnose service names that
+ are too long, rather than silently truncating them or creating
+ non-null-terminated names.
+ (Fnetwork_interface_info): Likewise, for interface names.
+ * sysdep.c (system_process_attributes) [GNU_LINUX]:
+ Prefer sprintf to strncat.
+ * xdisp.c (debug_method_add) [GLYPH_DEBUG]:
+ Prefer vsnprintf to vsprintf + strncpy.
+
+2012-07-10 Glenn Morris <rgm@gnu.org>
+
+ * dispnew.c (PENDING_OUTPUT_COUNT) [!__GNU_LIBRARY__]:
+ Clarify fallback case.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use XCAR and XCDR instead of Fcar and Fcdr where possible.
+ * callint.c, coding.c, doc.c, editfns.c, eval.c, font.c, fontset.c,
+ * frame.c, gnutls.c, minibuf.c, msdos.c, textprop.c, w32fns.c,
+ * w32menu.c, window.c, xmenu.c: Change to use XCAR and XCDR
+ where argument type is known to be a Lisp_Cons.
+
+2012-07-10 Tom Tromey <tromey@redhat.com>
+
+ * bytecode.c (BYTE_CODE_THREADED): New macro.
+ (BYTE_CODES): New macro. Replaces all old byte-code defines.
+ (enum byte_code_op): New type.
+ (CASE, NEXT, FIRST, CASE_DEFAULT, CASE_ABORT): New macros.
+ (exec_byte_code): Use them. Use token threading when applicable.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Optimize pure C strings initialization.
+ * lisp.h (make_pure_string): Fix prototype.
+ (build_pure_c_string): New function, defined as static inline. This
+ provides a better opportunity to optimize away calls to strlen when
+ the function is called with compile-time constant argument.
+ * alloc.c (make_pure_c_string): Fix comment. Change to add nchars
+ argument, adjust users accordingly. Use build_pure_c_string where
+ appropriate.
+ * buffer.c, coding.c, data.c, dbusbind.c, fileio.c, fontset.c, frame.c,
+ * keyboard.c, keymap.c, lread.c, search.c, syntax.c, w32fns.c, xdisp.c,
+ * xfaces.c, xfns.c, xterm.c: Use build_pure_c_string where appropriate.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid calls to strlen in miscellaneous functions.
+ * buffer.c (init_buffer): Use precalculated len, adjust if needed.
+ * font.c (Ffont_xlfd_name): Likewise. Change to call make_string.
+ * lread.c (openp): Likewise.
+
+2012-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid calls to strlen in path processing functions.
+ * fileio.c (file_name_as_directory): Add comment. Change to add
+ 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.
+ * filelock.c (fill_in_lock_file_name): Avoid calls to strlen.
+
+2012-07-10 Glenn Morris <rgm@gnu.org>
+
+ * s/cygwin.h, s/darwin.h, s/freebsd.h, s/netbsd.h, s/unixware.h:
+ Move PENDING_OUTPUT_COUNT definition to configure.
+
+ * s/irix6-5.h (DATA_START, DATA_SEG_BITS):
+ * s/hpux10-20.h (DATA_SEG_BITS, DATA_START):
+ * s/gnu.h (DATA_START): Move definitions to configure.
+
+ * s/irix6-5.h (SETUP_SLAVE_PTY, PTY_NAME_SPRINTF): Drop ifdef guards.
+ We include usg5-4-common.h, which defines them both.
+
+ * s/gnu.h: Don't include fcntl.h (every file in Emacs that uses
+ O_RDONLY already includes it).
+
+ Stop ns builds setting the EMACSLOADPATH environment variable.
+ * nsterm.m (ns_load_path): Rename from ns_init_paths.
+ Now it does not set EMACSLOADPATH, just returns the load-path string.
+ * nsterm.h: Update accordingly.
+ * lread.c [HAVE_NS]: Include nsterm.h.
+ (init_lread) [HAVE_NS]: Use ns_load_path.
+ * emacs.c (main) [HAVE_NS]: No longer call ns_init_paths.
+
+2012-07-09 Glenn Morris <rgm@gnu.org>
+
+ * s/gnu.h (SIGNALS_VIA_CHARACTERS): No need to define it here,
+ since the included bsd-common.h does so.
+
+ Stop ns builds setting the EMACSPATH environment variable.
+ * nsterm.m (ns_exec_path): New function, split from ns_init_paths.
+ (ns_init_paths): Do not set EMACSPATH.
+ * nsterm.h (ns_exec_path): Add it.
+ * callproc.c (init_callproc_1, init_callproc) [HAVE_NS]:
+ Use ns_exec_path.
+
+ * nsterm.m, nsterm.h (ns_etc_directory): Fix type, empty return.
+
+2012-07-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ * process.c (wait_reading_process_output): 'waitchannels' was unset
+ when read_kbd || !NILP (wait_for_cell); fix this.
+
+ Add GCC-style 'const' attribute to functions that can use it.
+ * character.h (char_resolve_modifier_mask):
+ * keyboard.h (make_ctrl_char):
+ * lisp.h (multibyte_char_to_unibyte, multibyte_char_to_unibyte_safe)
+ (init_character_once, next_almost_prime, init_fns, init_image)
+ (flush_pending_output, init_sound):
+ * mem-limits.h (start_of_data):
+ * menu.h (finish_menu_items):
+ Add ATTRIBUTE_CONST.
+ * emacs.c (DEFINE_DUMMY_FUNCTION):
+ Declare the dummy function with ATTRIBUTE_CONST.
+ * lisp.h (Fbyteorder, Fmax_char, Fidentity):
+ Add decls with ATTRIBUTE_CONST.
+
+ Minor improvements to make_formatted_string.
+ * alloc.c (make_formatted_string): Prefer int to ptrdiff_t
+ where int is good enough, as vsprintf returns an int.
+ * lisp.h (make_formatted_string): Add ATTRIBUTE_FORMAT_PRINTF.
+
+2012-07-09 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Use make_formatted_string to avoid double length calculation.
+ * lisp.h (make_formatted_string): New prototype.
+ * alloc.c (make_formatted_string): New function.
+ * buffer.c (Fgenerate_new_buffer_name): Use it.
+ * dbus.c (syms_of_dbusbind): Likewise.
+ * editfns.c (Fcurrent_time_zone): Likewise.
+ * filelock.c (get_boot_time): Likewise.
+ * frame.c (make_terminal_frame, set_term_frame_name)
+ (x_report_frame_params): Likewise.
+ * image.c (gs_load): Likewise.
+ * minibuf.c (get_minibuffer): Likewise.
+ * msdos.c (dos_set_window_size): Likewise.
+ * process.c (make_process): Likewise.
+ * xdisp.c (ensure_echo_area_buffers): Likewise.
+ * xsettings.c (apply_xft_settings): Likewise.
+
+2012-07-09 Glenn Morris <rgm@gnu.org>
+
+ Stop ns builds polluting the environment with EMACSDATA, EMACSDOC.
+ * nsterm.m (ns_etc_directory): New function, split from ns_init_paths.
+ (ns_init_paths): Do not set EMACSDATA, EMACSDOC.
+ * nsterm.h (ns_etc_directory): Add it.
+ * callproc.c [HAVE_NS]: Include nsterm.h.
+ (init_callproc_1, init_callproc) [HAVE_NS]: Use ns_etc_directory.
+
+2012-07-09 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Move marker debugging code under MARKER_DEBUG.
+ * marker.c (MARKER_DEBUG): Move marker debugging code under
+ #ifdef MARKER_DEBUG because byte_char_debug_check is too slow
+ for bootstrap with --enable-checking (~3x slowdown reported
+ by Juanma Barranquero <lekktu@gmail.com>).
+ (verify_bytepos): Move under #ifdef MARKER_DEBUG.
+
+2012-07-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * systime.h (EMACS_SUB_TIME): Clarify behavior with unsigned time_t.
+ See <http://bugs.gnu.org/11825#29>.
+
+2012-07-08 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (fill_glyphless_glyph_string): If the face of the glyph
+ has no font, use the frame's font. (Bug#11813)
+ (display_line): Add commentary about displaying truncation glyphs
+ on GUI frames.
+ (produce_special_glyphs): Move here from term.c.
+
+ * term.c (produce_special_glyphs): Move to xdisp.c.
+
+ * dispextern.h (produce_special_glyphs): Move prototype to xdisp.c
+ section.
+
+2012-07-07 Andreas Schwab <schwab@linux-m68k.org>
+
+ * xdisp.c (display_line): Avoid warning about implicit declaration
+ of FRAME_FONT.
+
+ * frame.c (get_frame_param): Define only if HAVE_WINDOW_SYSTEM.
+
+ * lisp.h: Remove empty conditional.
+
+2012-07-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lread.c (load_path_check): Now static.
+
+ Fix some minor --with-ns problems found by static checking.
+ * frame.c (Ftool_bar_pixel_width) [!FRAME_TOOLBAR_WIDTH]:
+ (x_set_font) [!HAVE_X_WINDOWS]:
+ * image.c (xpm_load_image) [HAVE_NS]:
+ (x_to_xcolors) [!HAVE_X_WINDOWS && !HAVE_NTGUI]:
+ (x_disable_image) [!HAVE_NS && !HAVE_NTGUI]:
+ Remove unused local.
+ (Fx_parse_geometry) [HAVE_NS]: Don't return garbage.
+ (xpm_load_image) [HAVE_NS && !HAVE_XPM]: Remove unused label.
+ * image.c (x_create_bitmap_from_file) [HAVE_NS]:
+ (xpm_load_image, xpm_load) [HAVE_NS && !HAVE_XPM]:
+ * nsselect.m (symbol_to_nsstring, ns_string_to_pasteboard_internal):
+ * xfaces.c (Fx_load_color_file) [!HAVE_X_WINDOWS]:
+ Fix pointer signedness problem.
+ * xfaces.c (FRAME_X_FONT_TABLE):
+ * xterm.h (FRAME_X_FONT_TABLE): Remove unused, incompatible macros.
+
+2012-07-07 Glenn Morris <rgm@gnu.org>
+
+ * lread.c (load_path_check): New function, split from init_lread.
+ (init_lread): Reorganize. Motivation:
+ If EMACSLOADPATH is set, check/warn about that rather than the
+ defaults, which we are not going to use. Hence we can remove
+ the turn_off_warning and WINDOWSNT || HAVE_NS tests.
+ Don't warn if site-lisp directories are missing.
+ If not installed, start from a blank load-path, since
+ PATH_LOADSEARCH refers to the eventual installation directories.
+
+2012-07-07 Eli Zaretskii <eliz@gnu.org>
+
+ 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,
+ 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
+ glyphs.
+ (insert_left_trunc_glyphs): Support GUI frames: make sure
+ truncation glyphs overwrite enough glyphs from the current line to
+ have sufficient space in pixels.
+ (display_line): Support truncation and continuation glyphs on GUI
+ frames. If some spare pixels are left on the line after inserting
+ the truncation glyphs, fill that space with a stretch glyph of a
+ suitably computed width.
+
+ * term.c (produce_special_glyphs): Call PRODUCE_GLYPHS, not
+ produce_glyphs, to support GUI sessions.
+
+2012-07-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c (ULLONG_MAX): Define if not already defined (Bug#11781).
+
+ * sysdep.c (list_system_processes): Port to NetBSD-current (Bug#11797).
+
+ Do not require float-time's arg to fit in time_t (Bug#11825).
+ This works better on hosts where time_t is unsigned, and where
+ float-time is applied to the (negative) difference between two times.
+ * editfns.c (decode_time_components): Last arg is now double *,
+ not int *, and means to store all the result as a double, without
+ worrying about whether the seconds part fits in time_t.
+ All callers changed.
+ (lisp_time_argument): Remove last int * arg, as it's no longer needed.
+ All callers changed.
+ (Ffloat_time): Do not fail merely because the specified time falls
+ outside of time_t range.
+
+2012-07-07 Glenn Morris <rgm@gnu.org>
+
+ * s/darwin.h (HAVE_RES_INIT, HAVE_LIBRESOLV):
+ * s/hpux10-20.h (HAVE_RINT, HAVE_RANDOM):
+ * s/unixware.h (HAVE_GETWD): Move undefs to configure (effectively).
+
+2012-07-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in (DISPEXTERN_H, $(BLD)/regex.$(O)):
+ Update dependencies.
+
+ * s/ms-w32.h [_MSC_VER]: Remove strcasecmp, strncasecmp.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786).
+ * dispextern.h, nsfns.m, nsterm.m: Include <c-strcase.h>.
+ * dispextern.h (xstrcasecmp): Rewrite using c_strcasecmp.
+ * nsfns.m (x_get_string_resource): Use c_strncasecmp, not strncasecmp.
+ * nsterm.m (ns_default): Use c_strcasecmp, not strcasecmp.
+ * xfaces.c (xstrcasecmp) [!HAVE_STRCASECMP]: Remove.
+
+ * xfont.c (compare_font_names): Redo to omit the need for casts.
+
+2012-07-06 Andreas Schwab <schwab@linux-m68k.org>
+
+ * xfns.c (Fx_change_window_property): Doc fix.
+ * w32fns.c (Fx_change_window_property): Doc fix.
+
+ * w32fns.c (Fx_window_property): Accept the same arguments as the
+ X Windows version. Doc fix.
+ * xfns.c (Fx_window_property): Doc fix. (Bug#11870)
+
+2012-07-06 Juanma Barranquero <lekktu@gmail.com>
+ Eli Zaretskii <eliz@gnu.org>
+
+ * s/ms-w32.h: Settings not specific to Windows moved to nt/config.nt.
+ Windows-specific code from nt/config.nt moved here.
+ Obsolete settings removed.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ * process.c: Avoid unnecessary calls to gettime.
+ (wait_reading_process_output): Don't get the time of day
+ when gobbling data immediately and not waiting, as there's no need
+ for it in that case. This removes a FIXME.
+
+2012-07-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (xg_event_is_for_scrollbar): Assign gwin when HAVE_GTK3
+ is defined (Bug#11768).
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix marker debugging code.
+ * marker.c (byte_char_debug_check): Do not perform the check
+ if buffer is not multibyte.
+ (buf_charpos_to_bytepos, buf_bytepos_to_charpos):
+ Call byte_char_debug_check with correct arguments.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Compile marker debugging code only if ENABLE_CHECKING is defined.
+ * marker.c (byte_char_debug_check, count_markers):
+ Use only if ENABLE_CHECKING is defined.
+ (byte_debug_flag): Remove.
+ (CONSIDER, buf_charpos_to_bytepos, buf_bytepos_to_charpos):
+ Always call byte_char_debug_check if ENABLE_CHECKING is defined.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Avoid code repetition in marker-related functions.
+ * marker.c (attach_marker): New function.
+ (Fset_marker, set_marker_restricted, set_marker_both)
+ (set_marker_restricted_both): Use it.
+ (Fset_marker, set_marker_restricted, Fbuffer_has_markers_at):
+ Consistently rename charno to charpos.
+ (marker_position): Add eassert.
+ (marker_byte_position): Convert to eassert.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Simplify list operations in unchain_overlay and unchain_marker.
+ * buffer.c (unchain_overlay): Simplify. Add comment.
+ * marker.c (unchain_marker): Simplify. Fix comments.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Introduce fast path for the widely used marker operation.
+ * alloc.c (build_marker): New function.
+ * lisp.h (build_marker): New prototype.
+ * buffer.c (clone_per_buffer_values, Fmake_indirect_buffer): Use it.
+ * composite.c (autocmp_chars): Likewise.
+ * editfns.c (buildmark): Remove.
+ (Fpoint_marker, Fpoint_min_marker, Fpoint_max_marker)
+ (save_restriction_save): Use build_marker.
+ * marker.c (buf_charpos_to_bytepos, buf_bytepos_to_charpos): Likewise.
+ * window.c (save_window_save): Likewise.
+
+2012-07-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not use Fdelete_overlay in delete_all_overlays
+ to avoid redundant calls to unchain_overlay.
+ * buffer.c (drop_overlay): New function.
+ (delete_all_overlays, Fdelete_overlay): Use it.
+ * minibuf.c (get_minibuffer): Fix comment.
+
+2012-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to OpenBSD 5.1 amd64.
+ * sysdep.c [BSD_SYSTEM]: Include <sys/param.h> before <sys/sysctl.h>.
+ This is needed for OpenBSD, and should be harmless on all BSD systems.
+ Also, include <sys/sysctl.h>, as it should be available on all
+ BSD_SYSTEM hosts given that we're already calling sysctl in that case.
+ (list_system_processes) [__OpenBSD__]: Use DARWIN_OS style mib, but
+ use p_pid member, not kp_proc.pid.
+
+2012-07-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (emacs$(EXEEXT)): Don't check for load-path shadows.
+
+2012-07-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ More xmalloc and related cleanup.
+ * alloc.c, bidi.c, buffer.c, buffer.h, bytecode.c, callint.c:
+ * callproc.c, charset.c, coding.c, composite.c, data.c, dispnew.c:
+ * doc.c, editfns.c, emacs.c, eval.c, fileio.c, filelock.c, fns.c:
+ * font.c, fontset.c, frame.c, fringe.c, ftfont.c, ftxfont.c, gmalloc.c:
+ * gtkutil.c, image.c, keyboard.c, keymap.c, lread.c, macros.c, menu.c:
+ * nsfns.m, nsfont.m, nsmenu.m, nsterm.m, print.c, process.c, ralloc.c:
+ * regex.c, region-cache.c, scroll.c, search.c, sound.c, syntax.c:
+ * sysdep.c, term.c, termcap.c, unexmacosx.c, window.c, xdisp.c:
+ * xfaces.c, xfns.c, xftfont.c, xgselect.c, xmenu.c, xrdb.c, xselect.c:
+ * xterm.c:
+ Omit needless casts involving void * pointers and allocation.
+ Prefer "P = xmalloc (sizeof *P)" to "P = xmalloc (sizeof (TYPE_OF_P))",
+ as the former is more robust if P's type is changed.
+ Prefer xzalloc to xmalloc + memset 0.
+ Simplify malloc-or-realloc to realloc.
+ Don't worry about xmalloc returning a null pointer.
+ Prefer xstrdup to xmalloc + strcpy.
+ * editfns.c (Fmessage_box): Grow message_text by at least 80 when
+ growing it.
+ * keyboard.c (apply_modifiers_uncached): Prefer local array to
+ alloca of a constant.
+
+2012-07-05 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (display_line): Fix horizontal pixel coordinates when
+ hscroll is larger than the line width. Fixes long and futile
+ looping inside extend_face_to_end_of_line (on a TTY) producing
+ glyphs that are not needed and thrown away.
+
+2012-07-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * marker.c (set_marker_restricted_both): Simplify by using
+ clip_to_bounds.
+
+2012-07-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ * editfns.c (region_limit): Simplify by using clip_to_bounds.
+
+2012-07-05 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (gtk_scrollbar_new, gtk_box_new): Define when HAVE_GTK3 is
+ not defined (Bug#11768).
+ (xg_create_frame_widgets): Use gtk_plug_new_for_display (Bug#11768).
+ (xg_create_frame_widgets, create_dialog, xg_get_file_with_chooser)
+ (make_widget_for_menu_item, xg_make_tool_item): Use gtk_box_new
+ followed by gtk_box_set_homogeneous (Bug#11768).
+ (xg_update_menu_item): Use GTK_IS_BOX (Bug#11768).
+ (update_theme_scrollbar_width, xg_create_scroll_bar):
+ Use gtk_scrollbar_new (Bug#11768).
+ (xg_event_is_for_scrollbar): Use Gdk Device functions for HAVE_GTK3.
+ (is_box_type): New function (Bug#11768).
+ (xg_tool_item_stale_p): Call is_box_type.
+ (xg_initialize): Get settings by calling gtk_settings_get_for_screen
+ with default display (Bug#11768).
+
+2012-07-05 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (window_hscroll_limited): New function.
+ (pos_visible_p, init_iterator): Use it to avoid overflow of pixel
+ coordinates when window's hscroll is set to insanely large
+ values. (Bug#11857)
+
+2012-07-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/dired.$(O), $(BLD)/fileio.$(O)): Fix typo.
+ ($(BLD)/terminal.$(O), $(BLD)/syntax.$(O)): Update dependencies.
+
+2012-07-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup xmalloc.
+ * lisp.h (xzalloc): New prototype. Omit needless casts.
+ * alloc.c (xzalloc): New function. Omit needless casts.
+ * charset.c: Omit needless casts. Convert all calls to
+ xmalloc with following memset to xzalloc.
+ * dispnew.c: Likewise.
+ * fringe.c: Likewise.
+ * image.c: Likewise.
+ * sound.c: Likewise.
+ * term.c: Likewise.
+ * w32fns.c: Likewise.
+ * w32font.c: Likewise.
+ * w32term.c: Likewise.
+ * xfaces.c: Likewise.
+ * xfns.c: Likewise.
+ * xterm.c: Likewise.
+ * atimer.c: Omit needless casts.
+ * buffer.c: Likewise.
+ * callproc.c: Likewise.
+ * ccl.c: Likewise.
+ * coding.c: Likewise.
+ * composite.c: Likewise.
+ * doc.c: Likewise.
+ * doprnt.c: Likewise.
+ * editfns.c: Likewise.
+ * emacs.c: Likewise.
+ * eval.c: Likewise.
+ * filelock.c: Likewise.
+ * fns.c: Likewise.
+ * gtkutil.c: Likewise.
+ * keyboard.c: Likewise.
+ * lisp.h: Likewise.
+ * lread.c: Likewise.
+ * minibuf.c: Likewise.
+ * msdos.c: Likewise.
+ * print.c: Likewise.
+ * process.c: Likewise.
+ * region-cache.c: Likewise.
+ * search.c: Likewise.
+ * sysdep.c: Likewise.
+ * termcap.c: Likewise.
+ * terminal.c: Likewise.
+ * tparam.c: Likewise.
+ * w16select.c: Likewise.
+ * w32.c: Likewise.
+ * w32reg.c: Likewise.
+ * w32select.c: Likewise.
+ * w32uniscribe.c: Likewise.
+ * widget.c: Likewise.
+ * xdisp.c: Likewise.
+ * xmenu.c: Likewise.
+ * xrdb.c: Likewise.
+ * xselect.c: Likewise.
+
+2012-07-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c (time_error_value): Check the right error number.
+ Problem reported by Troels Nielsen in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00095.html>.
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * window.c (set_window_hscroll): Revert the 100000 hscroll limit.
+ This should be fixed in a better way; see Eli Zaretskii in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00088.html>.
+ (HSCROLL_MAX): Remove; this is now internal to set_window_hscroll.
+
+ * fileio.c (time_error_value): Rename from special_mtime.
+ The old name's problems were noted by Eli Zaretskii in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00087.html>.
+
+ * emacs.c (gdb_pvec_type): Change it back to enum pvec_type.
+ This variable's comment says Emacs needs at least one GDB-visible
+ symbol of type enum pvec_type, to work around GDB problems.
+ The symbol's value doesn't matter.
+
+ * alloc.c (PSEUDOVECTOR_NBYTES): Remove stray ';'
+ that causes compilation to fail on pre-C99 compilers.
+
+2012-07-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * s/ms-w32.h (LISP_FLOAT_TYPE, HAVE_MEMCMP, HAVE_MEMCPY)
+ (HAVE_MEMMOVE, HAVE_MEMSET): Don't set, obsolete.
+
+2012-07-04 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * buffer.c (init_buffer_once): Fix initialization of
+ headers for buffer_defaults and buffer_local_symbols.
+ Reported by Juanma Barranquero <lekktu@gmail.com>.
+
+2012-07-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Turn VECTOR_FREE_LIST_FLAG into PVEC_FREE.
+ * lisp.h (enum pvec_type): Use fewer bits.
+ (PSEUDOVECTOR_SIZE_BITS): New constant.
+ (PSEUDOVECTOR_SIZE_MASK, PVEC_TYPE_MASK): Use it.
+ (XSETPVECTYPESIZE, XSETTYPED_PSEUDOVECTOR, DEFUN): Adapt code to
+ change in pvec_type.
+ (PSEUDOVECTOR_TYPEP): New macro.
+ (TYPED_PSEUDOVECTORP): Use it.
+ * fns.c (internal_equal): Adapt code to extract pvectype.
+ * emacs.c (gdb_pvec_type): Update type.
+ * alloc.c (PSEUDOVECTOR_NBYTES): New macro.
+ (VECTOR_FREE_LIST_SIZE_MASK): Remove (=> PSEUDOVECTOR_SIZE_MASK).
+ (VECTOR_FREE_LIST_FLAG): Remove (=> PVEC_FREE).
+ (SETUP_ON_FREE_LIST): Use XSETPVECTYPESIZE.
+ (sweep_vectors): Use it. Use local var `total_bytes' instead of
+ abusing vector->header.next.nbytes.
+ (live_vector_p): Use PVEC_TYPE.
+ (mark_object): Adapt code to extract pvectype. Use switch.
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * doprnt.c (doprnt): Don't assume string length fits in 'int'.
+ Tighten new eassert a bit.
+
+2012-07-04 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Fix compilation with --enable-gcc-warnings and -O1
+ optimization level.
+ * doprnt.c (doprnt): Change type of tem to int, initialize
+ to avoid compiler warning. Add eassert.
+ * search.c (simple_search): Initialize match_byte to avoid
+ compiler warning. Add eassert.
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid weird behavior with large horizontal scrolls.
+ Without this change, for example, large hscroll values would
+ mess up Emacs's display on Fedora 15 x86, presumably due to
+ overflows in int calculations in the display code.
+ Also, if buffers had long lines, Emacs would freeze.
+ * window.c (HSCROLL_MAX): Reduce to 100000, and make it visible to GDB.
+ (set_window_hscroll): New function, containing the old guts of
+ Fset_window_hscroll. Return the clipped value.
+ (Fset_window_hscroll, Fscroll_left, Fscroll_right): Use it.
+ This avoids the need to check against PTRDIFF_MAX.
+
+ * buffer.c (Fgenerate_new_buffer_name): Fix sprintf format mismatch.
+
+2012-07-04 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * buffer.c (Fgenerate_new_buffer_name): Fix type mismatch.
+
+2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * regex.c: Suppress GCC warning on RHEL 6. (Bug#11207)
+ Conditionalize the pragmas on GCC 4.5 or later, not GCC 4.3 or later,
+ since GCC 4.4.6 issues a bogus warning for them.
+
+ Fix bugs in file timestamp newness comparisons.
+ * fileio.c (Ffile_newer_than_file_p):
+ * lread.c (Fload): Use full timestamp resolution of files,
+ not just the 1-second resolution, so that files that are only
+ slightly newer still count as newer.
+ * fileio.c (Ffile_newer_than_file_p): Don't assume file
+ timestamps fit in 'int'; this fixes a Y2038 bug on most hosts.
+
+2012-07-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c: Improve handling of file time marker. (Bug#11852)
+ (special_mtime): New function.
+ (Finsert_file_contents, Fverify_visited_file_modtime):
+ Use it to set special mtime values consistently.
+
+2012-07-03 Andreas Schwab <schwab@linux-m68k.org>
+
+ * fileio.c (Finsert_file_contents): Properly handle st_mtime
+ marker for non-existing file. (Bug#11852)
+
+2012-07-03 Glenn Morris <rgm@gnu.org>
+
+ * lisp.h (Fread_file_name): Restore EXFUN (it's not a normal DEFUN
+ and did not make it into globals.h).
+
+2012-07-03 Tom Tromey <tromey@redhat.com>
+
+ * window.c (Fset_window_margins, Fset_window_fringes)
+ (Fset_window_scroll_bars, Fset_window_vscroll): No longer static.
+ * textprop.c (Fprevious_property_change): No longer static.
+ * syntax.c (Fsyntax_table_p): No longer static.
+ * process.c (Fget_process, Fprocess_datagram_address): No longer
+ static.
+ * keymap.c (Flookup_key, Fcopy_keymap): No longer static.
+ * keyboard.c (Fcommand_execute): No longer static.
+ Remove EXFUN.
+ * insdel.c (Fcombine_after_change_execute): No longer static.
+ * image.c (Finit_image_library): No longer static.
+ * fileio.c (Fmake_symbolic_link): No longer static.
+ * eval.c (Ffetch_bytecode): No longer static.
+ * editfns.c (Fuser_full_name): No longer static.
+ * doc.c (Fdocumentation_property, Fsnarf_documentation):
+ No longer static.
+ * buffer.c (Fset_buffer_major_mode, Fdelete_overlay): No longer
+ static.
+ * dired.c (Ffile_attributes): No longer static.
+ * composite.c (Fcomposition_get_gstring): No longer static.
+ * callproc.c (Fgetenv_internal): No longer static.
+
+ * ccl.h: Remove EXFUNs.
+ * buffer.h: Remove EXFUNs.
+ * dispextern.h: Remove EXFUNs.
+ * intervals.h: Remove EXFUNs.
+ * fontset.h: Remove EXFUN.
+ * font.h: Remove EXFUNs.
+ * dosfns.c (system_process_attributes): Remove EXFUN.
+ * keymap.h: Remove EXFUNs.
+ * lisp.h: Remove EXFUNs.
+ * w32term.h: Remove EXFUNs.
+ * window.h: Remove EXFUNs.
+ * xsettings.h: Remove EXFUN.
+ * xterm.h: Remove EXFUN.
+
+2012-07-03 Glenn Morris <rgm@gnu.org>
+
+ * lisp.h (Frandom): Make it visible to C.
+ * buffer.c (Fgenerate_new_buffer_name): Speed up finding a new
+ buffer for invisible buffers. (Bug#1229)
+
+2012-07-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ 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
+ accordingly.
+
+2012-07-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp.h (Lisp_Misc, Lisp_Fwd): Move around to group better.
+
+ * alloc.c (mark_object): Revert part of last patch to use `switch'.
+
+2012-07-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_vector_block): Remove redundant
+ calls to mallopt if DOUG_LEA_MALLOC is defined.
+ (allocate_vectorlike): If DOUG_LEA_MALLOC is defined,
+ avoid calls to mallopt if zero_vector is returned.
+
+2012-07-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (check_string_bytes): If GC_CHECK_STRING_BYTES
+ is enabled, avoid dereferencing NULL current_sblock if
+ running undumped.
+
+2012-07-03 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Cleanup basic buffer management.
+ * buffer.h (struct buffer): Change layout to use generic vector
+ marking code. Fix some comments. Change type of 'clip_changed'
+ to bitfield. Remove unused #ifndef old.
+ (FIRST_FIELD_PER_BUFFER, LAST_FIELD_PER_BUFFER): Remove.
+ (GET_OVERLAYS_AT): Fix indentation.
+ (for_each_per_buffer_object_at): New macro.
+ * buffer.c (clone_per_buffer_values, reset_buffer_local_variables)
+ (Fbuffer_local_variables): Use it.
+ (init_buffer_once, syms_of_buffer): Remove unused #ifndef old.
+ * alloc.c (allocate_buffer): Adjust to match new layout of
+ struct buffer. Fix comment.
+ (mark_overlay): New function.
+ (mark_buffer): Use it. Use mark_vectorlike to mark normal
+ Lisp area of struct buffer.
+ (mark_object): Use it. Adjust marking of misc objects
+ and related comments.
+
+2012-07-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (mark_object): Remove "#ifdef GC_CHECK_MARKED_OBJECTS"
+ wrapper that is not needed because the wrapped code is a no-op (zero
+ machine instructions) when GC_CHECK_MARKED_OBJECTS is not defined.
+ This avoids a -Wunused-macros diagnostic with GCC 4.7.1 x86-64.
+
+2012-07-02 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * 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.
+
+2012-06-30 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (ns_init_paths): Ignore site-lisp if --no-site-lisp.
+
+ * epaths.in (PATH_SITELOADSEARCH): New.
+ * lread.c (init_lread): Use PATH_SITELOADSEARCH.
+ This is rather than relying on --enable-locallisppath elements
+ having "site-lisp" in their names. (Bug#10208#25, 11658)
+
+2012-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (sys_select): Accept and ignore one more argument.
+
+ * w32.c (emacs_gnutls_pull): Call select with one more argument.
+
+ * sysselect.h [DOS_NT]: Don't include sys/select.h.
+ (pselect) [!MS_DOS]: Redirect to sys_select.
+
+ * sysdep.c: Don't include dos.h and dosfns.h.
+
+ * process.c (sys_select):
+ * msdos.c (sys_select): Accept one more argument and ignore it.
+
+ * msdos.c (event_timestamp, sys_select): Use gnulib's gettime;
+ adapt data types and code to that.
+
+ * dosfns.c:
+ * msdos.c (gettime, settime): Define away the prototypes in dos.h,
+ which clashes with the gnulib function of the same name.
+
+2012-06-30 Andreas Schwab <schwab@linux-m68k.org>
+
+ * font.c (font_style_to_value, font_style_symbolic)
+ (font_prop_validate_style): Add type checks for values in
+ font_style_table.
+
+ * lisp.h (CHECK_RANGED_INTEGER): Make value to check the first
+ argument.
+ * character.c, charset.c, menu.c, process.c, window.c: Adjust all
+ uses.
+
+2012-06-29 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (try_window_id): Undo last change.
+
+ * w32.c (getwd): Adjust commentary about startup_dir.
+ (init_environment): Always call sys_access, even in non-MSVC
+ builds. Don't chdir to the directory of the Emacs executable.
+ This undoes code from 1997 which was justified by the need to
+ "avoid conflicts when removing and renaming directories". But its
+ downside was that every relative file name was being interpreted
+ relative to the directory of the Emacs executable, which can never
+ be TRT. In particular, it broke sys_access when called with
+ relative file names.
+ (sys_access): Map GetLastError to errno.
+
+2012-06-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.h (struct window): Change type of 'fringes_outside_margins'
+ to bitfield. Fix comment. Adjust users accordingly.
+ (struct window): Change type of 'window_end_bytepos' to ptrdiff_t.
+ Adjust comment.
+ * xdisp.c (try_window_id): Change type of 'first_vpos' and 'vpos'
+ to ptrdiff_t.
+
+2012-06-29 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnutls.c (emacs_gnutls_handshake):
+ Add QUIT to make the loop interruptible.
+
+2012-06-29 Glenn Morris <rgm@gnu.org>
+
+ * charset.c (init_charset): Make lack of etc/charsets fatal.
+
+2012-06-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * editfns.c (region_limit): Fix type mismatch.
+
+2012-06-29 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * nsfns.m: Fix GLYPH_DEBUG usage assuming that it may be
+ undefined. Convert from xassert to eassert.
+ * nsmenu.m: Convert from xassert to eassert.
+ * nsterm.m: Likewise.
+
+2012-06-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * editfns.c (region_limit): Clip to narrowing (bug#11770).
+
+2012-06-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid integer overflow on scroll-left and scroll-right.
+ * window.c (HSCROLL_MAX): New macro.
+ (Fscroll_left, Fscroll_right): Avoid undefined behavior on integer
+ overflow when requested scroll falls outside ptrdiff_t range.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.h (struct window): Change type of 'hscroll',
+ 'min_hscroll' and 'last_point' from Lisp_Object to ptrdiff_t,
+ 'last_modified' and 'last_overlay_modified' to EMACS_INT.
+ Adjust users accordingly.
+ * xdisp.c (try_cursor_movement): Replace type check with eassert.
+ * window.c (Fscroll_left, Fscroll_right): Change type of 'hscroll'
+ from EMACS_INT to ptrdiff_t.
+ (make_window): Omit redundant initialization.
+
+2012-06-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/regex.$(O)): Update dependencies.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.h (struct window): Change type of 'use_time' and
+ 'sequence_number' from Lisp_Object to int.
+ * frame.c (make_frame): Adjust users accordingly.
+ * print.c (print_object): Likewise.
+ * window.c (select_window, Fwindow_use_time, make_parent_window)
+ (make_window): Likewise.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * dispextern.h (GLYPH_DEBUG): Now defined in config.h if
+ enabled with --enable-checking=[all,glyphs] configure option.
+ Fix GLYPH_DEBUG usage assuming that it may be undefined,
+ adjust comments accordingly.
+ * dispnew.c: Fix GLYPH_DEBUG usage assuming that it may be
+ undefined, adjust comments accordingly.
+ * image.c: Likewise.
+ * scroll.c: Likewise.
+ * w32fns.c: Likewise.
+ * w32term.c: Likewise.
+ * xdisp.c: Likewise.
+ * xfaces.c: Likewise.
+ * xfns.c: Likewise.
+ * xterm.c: Likewise.
+
+2012-06-28 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Generalize run-time debugging checks.
+ * dispextern.h (XASSERTS): Remove.
+ * fontset.c (xassert): Remove.
+ Convert from xassert to eassert.
+ * alloc.c: Convert from xassert to eassert.
+ * bidi.c: Likewise.
+ * dispnew.c: Likewise.
+ * fns.c: Likewise.
+ * fringe.c: Likewise.
+ * ftfont.c: Likewise.
+ * gtkutil.c: Likewise.
+ * image.c: Likewise.
+ * keyboard.c: Likewise.
+ * menu.c: Likewise.
+ * process.c: Likewise.
+ * scroll.c: Likewise.
+ * sound.c: Likewise.
+ * term.c: Likewise.
+ * w32console.c: Likewise.
+ * w32fns.c: Likewise.
+ * w32term.c: Likewise.
+ * window.c: Likewise.
+ * xdisp.c: Likewise.
+ * xfaces.c: Likewise.
+ * xfns.c: Likewise.
+ * xselect.c: Likewise.
+ * xterm.c: Likewise.
+
+2012-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * fns.c (maybe_resize_hash_table): Output message when growing the
+ purify-hashtable.
+
+2012-06-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_string_data): Remove dead code.
+ * xsettings.c (XSETTINGS_FONT_NAME): Move under HAVE_XFT to
+ avoid GCC warning about unused macro.
+
+2012-06-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_string): Omit intervals initialization.
+ * alloc.c (make_uninit_multibyte_string): Initialize intervals
+ as in make_pure_string and make_pure_c_string.
+
+2012-06-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_string): Fix last change.
+
+2012-06-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_string): Remove two redundant calls
+ to memset, add explicit initialization where appropriate.
+
+2012-06-27 Glenn Morris <rgm@gnu.org>
+
+ * lisp.mk (lisp): Remove paths.elc.
+
+2012-06-27 Chong Yidong <cyd@gnu.org>
+
+ * doc.c (Fsubstitute_command_keys): Fix punctuation.
+
+2012-06-26 John Wiegley <johnw@newartisans.com>
+
+ * unexmacosx.c (copy_data_segment): Add two section names used
+ on Mac OS X Lion: __mod_init_func and __mod_term_func.
+
+ * alloc.c (mark_memory): Do not check with -faddress-sanitizer
+ when building with Clang.
+
+2012-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fapply): Allow calling it with a single argument.
+
+2012-06-26 Eli Zaretskii <eliz@gnu.org>
+
+ * s/ms-w32.h (strcasecmp, strncasecmp) [_MSC_VER]: Redirect to
+ _stricmp and _strnicmp.
+ (HAVE_STRCASECMP, HAVE_STRNCASECMP): Define to 1.
+
+2012-06-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c (allocate_window): Zero out non-Lisp part of newly
+ allocated window.
+ (allocate_process): Likewise for new process.
+ (allocate_terminal): Change to use offsetof.
+ (allocate_frame): Likewise.
+ * frame.c (make_frame): Omit redundant initialization.
+ * window.c (make_parent_window): Use memset.
+ (make_window): Omit redundant initialization.
+ * process.c (make_process): Omit redundant initialization.
+ * terminal.c (create_terminal): Likewise.
+
+2012-06-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * term.c (delete_tty): Remove redundant call to memset.
+
+2012-06-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c: Remove build_string.
+ * lisp.h: Define build_string as static inline. This provides
+ a better opportunity to optimize away calls to strlen when the
+ function is called with compile-time constant argument.
+ * image.c (imagemagick_error): Convert to build_string.
+ * w32proc.c (sys_spawnve): Likewise.
+ * xterm.c (x_term_init): Likewise.
+
+2012-06-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use sprintf return value instead of invoking strlen on result.
+ In the old days this wasn't portable, since some sprintf
+ implementations returned char *. But they died out years ago and
+ Emacs already assumes sprintf returns int.
+ Similarly for float_to_string.
+ This patch speeds up (number-to-string 1000) by 3% on Fedora 15 x86-64.
+ * ccl.c (ccl_driver):
+ * character.c (string_escape_byte8):
+ * data.c (Fnumber_to_string):
+ * doprnt.c (doprnt):
+ * print.c (print_object):
+ * xdisp.c (message_dolog):
+ * xfns.c (syms_of_xfns):
+ Use sprintf or float_to_string result to avoid need to call strlen.
+ * data.c (Fnumber_to_string):
+ Use make_unibyte_string, since the string must be ASCII.
+ * lisp.h, print.c (float_to_string): Now returns int length.
+ * term.c (produce_glyphless_glyph):
+ Use sprintf result rather than recomputing it.
+
+ Clean out last vestiges of the old HAVE_CONFIG_H stuff.
+ * Makefile.in (ALL_CFLAGS):
+ * makefile.w32-in (LOCAL_FLAGS): Remove -DHAVE_CONFIG_H.
+ * gmalloc.c, regex.c: Include <config.h> unconditionally.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * dispextern.h (xstrcasecmp): Define to library function
+ strcasecmp if available.
+ * xfaces.c: Do not use xstrcasecmp if strcasecmp is available.
+
+2012-06-25 Andreas Schwab <schwab@linux-m68k.org>
+
+ * keyboard.c (menu_bar_items, menu_bar_item, read_key_sequence):
+ Avoid comma operator.
+ * menu.c (push_submenu_start, push_submenu_end)
+ (push_left_right_boundary, push_menu_pane): Likewise.
+ * msdos.c (dos_rawgetc): Likewise.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xfns.c (xic_create_fontsetname): Remove redundant calls
+ to memset.
+
+2012-06-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ * gtkutil.c (get_utf8_string): Remove redundant assignment.
+ sprintf already null-terminates its output.
+
+ * xfns.c (x_window): Remove redundant cast.
+
+2012-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * xmenu.c (xmenu_show, xdialog_show): Explicit cast from
+ `const char *' to `char *' to avoid compiler warning.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xterm.c (x_term_init): Build proper-sized _XSETTINGS_Snnn string
+ instead of truncating it to 63 (admittedly a generous limit).
+
+ * process.c: Fix spelling and caps in comments.
+
+2012-06-24 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * emacs.c (setpgrp): Remove definition, unused.
+ * sysdep.c (setpgrp): Remove definition, not used in this file.
+
+2012-06-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in: Update dependencies.
+
+2012-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ * makefile.w32-in (TIMESPEC_H): Remove nt/inc/sys/time.h.
+ (SYSTIME_H): Add nt/inc/sys/time.h.
+
+ * systime.h [WINDOWSNT]: Include sys/time.h.
+
+ * s/ms-w32.h (struct timespec): Definition moved from
+ nt/inc/sys/time.h. Suggested by Paul Eggert <eggert@cs.ucla.edu>.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from NO_RETURN to C11's _Noreturn (Bug#11750).
+ * buffer.h (buffer_slot_type_mismatch):
+ * data.c (arith_error) [!FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ * eval.c (unwind_to_catch):
+ * image.c (my_png_error, my_error_exit):
+ * keyboard.c (quit_throw_to_read_char, user_error)
+ (Fexit_recursive_edit, Fabort_recursive_edit):
+ * lisp.h (die, args_out_of_range, args_out_of_range_3)
+ (wrong_type_argument, buffer_overflow, __executable_start)
+ (memory_full, buffer_memory_full, string_overflow, Fthrow)
+ (xsignal, xsignal0, xsignal1, xsignal2, xsignal3, signal_error)
+ (error, verror, nsberror, report_file_error, Ftop_level, Fkill_emacs)
+ (fatal):
+ (child_setup) [!DOS_NT]:
+ * lread.c (end_of_file_error, invalid_syntax):
+ * process.c (send_process_trap) [!FORWARD_SIGNAL_TO_MAIN_THREAD]:
+ * puresize.h (pure_write_error):
+ * search.c (matcher_overflow):
+ * sound.c (sound_perror, alsa_sound_perror):
+ * sysdep.c, syssignal.h (croak):
+ * term.c (maybe_fatal, vfatal):
+ * textprop.c (text_read_only):
+ * undo.c (user_error):
+ * unexmacosx.c (unexec_error):
+ * xterm.c (x_ins_del_lines, x_delete_glyphs):
+ Use _Noreturn rather than NO_RETURN.
+ No need for separate decl merely because of _Noreturn.
+ * sound.c (sound_warning, parse_sound):
+ Remove unnecessary forward decls.
+
+2012-06-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bug when time_t is unsigned and as wide as intmax_t (Bug#9000).
+ * lisp.h (WAIT_READING_MAX): New macro.
+ * dispnew.c (Fsleep_for, sit_for):
+ * keyboard.c (kbd_buffer_get_event):
+ * process.c (Faccept_process_output):
+ Use it to avoid bogus compiler warnings with obsolescent GCC versions.
+ This improves on the previous patch, which introduced a bug
+ when time_t is unsigned and as wide as intmax_t.
+ See <http://bugs.gnu.org/9000#51>.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ * dispnew.c (sit_for, Fsleep_for):
+ * keyboard.c (kbd_buffer_get_event):
+ * process.c (Faccept_process_output): Avoid compiler warnings when
+ comparing a 32-bit time_t with a 64-bit INTMAX_MAX.
+
+2012-06-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in: Update dependencies.
+
+ * w32.c (ltime): Add return type and declare static.
+ (w32_get_internal_run_time): Remove usused variable `time_100ns'.
+
+2012-06-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c [__FreeBSD__]: Fix more recently-introduced typos.
+ Privately reported by Herbert J. Skuhra.
+ (make_lisp_timeval) [__FreeBSD__]: Rename from TIMELIST.
+ All uses changed.
+ (system_process_attributes) [__FreeBSD__]: Invoke make_lisp_time,
+ not make_lisp_timeval, when the argument is of type EMACS_TIME.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ * w32proc.c (Fw32_get_locale_info): Fix an off-by-one error in
+ last argument of make_unibyte_string.
+
+ * keyboard.c (kbd_buffer_get_event): Include the codepage and the
+ language ID in the event parameters.
+
+ * w32term.c (w32_read_socket): Put the new keyboard codepage into
+ event.code, not the obscure "character set ID".
+
+2012-06-23 Chong Yidong <cyd@gnu.org>
+
+ * xmenu.c (x_menu_wait_for_event): Adapt GTK3 to new xg_select.
+
+2012-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build broken by 2012-06-22T21:17:42Z!eggert@cs.ucla.edu.
+ * w32.c (fdutimens): New function.
+
+ * w32proc.c (sys_select): Adapt to change in the EMACS_TIME type.
+
+ * s/ms-w32.h (pselect): Redirect to sys_select.
+
+ * sysselect.h [WINDOWSNT]: Don't include sys/select.h.
+
+ * ralloc.c (r_alloc_inhibit_buffer_relocation): Fix stupid thinko
+ in the logic of incrementing and decrementing the value of
+ use_relocatable_buffers.
+
+2012-06-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c [__FreeBSD__]: Fix recently-introduced typos.
+ Privately reported by Herbert J. Skuhra.
+ [__FreeBSD__]: Remove "*/" typo after "#include".
+ (timeval_to_EMACS_TIME) [__FreeBSD__]: New static function.
+ (TIMEVAL) [__FreeBSD__]: Now a static function rather than a macro.
+ (TIMEVAL, system_process_attributes) [__FreeBSD__]:
+ Don't assume EMACS_TIME and struct timeval are the same type.
+
+2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Support higher-resolution time stamps (Bug#9000).
+ The time stamps are only nanosecond-resolution at the C level,
+ since that's the best that any real-world system supports now.
+ But they are picosecond-resolution at the Lisp level, as that's
+ easy, and leaves room for future OS improvements.
+
+ * Makefile.in (LIB_CLOCK_GETTIME): New macro.
+ (LIBES): Use it.
+
+ * alloc.c (Fgarbage_collect): Port to higher-res time stamps.
+ Don't get current time unless it's needed.
+
+ * atimer.c: Include <sys/time.h> unconditionally, since gnulib
+ now provides it if it's absent.
+ (start_atimer): Port to higher-res time stamps.
+ Check for time stamp overflow. Don't get current time more
+ often than is needed.
+
+ * buffer.h (struct buffer): Buffer modtime now has high resolution.
+ Include systime.h, not time.h.
+ (NONEXISTENT_MODTIME_NSECS, UNKNOWN_MODTIME_NSECS): New macros.
+
+ * dired.c: Include stat-time.h.
+ (Ffile-attributes): File times now have higher resolution.
+
+ * dispextern.h [HAVE_WINDOW_SYSTEM]: Include systime.h.
+ (struct image): Timestamp now has higher resolution.
+
+ * dispnew.c (PERIODIC_PREEMPTION_CHECKING): Remove, as Emacs always
+ has at least microseconds now. All uses removed.
+ (update_frame, update_single_window, update_window, update_frame_1)
+ (Fsleep_for, sit_for): Port to higher-resolution time stamps.
+ (duration_to_sec_usec): Remove; no longer needed.
+
+ * editfns.c (time_overflow): Now extern.
+ (Fcurrent_time, Fget_internal_run_time, make_time, lisp_time_argument)
+ (float-time, Fformat_time_string, Fcurrent_time_string)
+ (Fcurrent_time_zone): Accept and generate higher-resolution
+ time stamps.
+ (make_time_tail, make_lisp_time, dissassemble_lisp_time)
+ (decode_time_components, lisp_seconds_argument): New functions.
+ (make_time): Now static.
+ (lisp_time_argument): Now returns EMACS_TIME. New arg ppsec.
+ Report an error if the time is invalid, rather than having the caller
+ do that.
+
+ * fileio.c: Include <stat-time.h>
+ (Fcopy_file): Copy higher-resolution time stamps.
+ Prefer to set the time stamp via a file descriptor if that works.
+ (Fset_file_times, Finsert_file_contents, Fwrite_region)
+ (Fverify_visited_file_modtime, Fclear_visited_file_modtime)
+ (Fvisited_file_modtime, Fset_visited_file_modtime):
+ Support higher-resolution time stamps.
+
+ * fns.c (Frandom): Use nanoseconds, not microseconds, for seed.
+
+ * gtkutil.c (xg_maybe_add_timer): Port to higher-res time stamps.
+
+ * image.c (prepare_image_for_display, clear_image_cache)
+ (lookup_image): Port to higer-resolution time stamps.
+
+ * keyboard.c (start_polling, bind_polling_period):
+ Check for time stamp overflow.
+ (read_char, kbd_buffer_get_event, timer_start_idle)
+ (timer_stop_idle, timer_resume_idle, timer_check_2, timer_check)
+ (Fcurrent_idle_time, init_keyboard, set_waiting_for_input):
+ Port to higher-resolution time stamps. Do not assume time_t is signed.
+ (decode_timer): New function. Timers are now vectors of length 9,
+ not 8, to accommodate the picosecond component.
+ (timer_check_2): Use it.
+
+ * nsterm.m (select_timeout, timeval_subtract): Remove.
+ (ns_timeout): Use Emacs's facilities for time stamp arithmetic,
+ as they're a bit more accurate and handle overflow better.
+ (ns_select): Change prototype to be compatible with pselect.
+ (ns_select, ns_term_shutdown): Port to ns-resolution time stamps.
+ * nsterm.h (ns_select): Adjust prototype.
+
+ * msdos.c (EMACS_TIME_ZERO_OR_NEG_P): Remove, as it assumes
+ us-resolution time stamps.
+ (sys_select): Use the new EMACS_TIME_SIGN macro instead.
+
+ * lread.c (read_filtered_event): Port to ns-resolution time stamps.
+
+ * lisp.h (time_overflow): New decl.
+ (wait_reading_process_output): First arg is now intmax_t, not int,
+ to accommodate larger waits.
+
+ * process.h (struct Lisp_Process.read_output_delay):
+ Now counts nanoseconds, not microseconds.
+ * process.c (ADAPTIVE_READ_BUFFERING): Don't worry about
+ EMACS_HAS_USECS.
+ (READ_OUTPUT_DELAY_INCREMENT, Faccept_process_output)
+ (wait_reading_process_output):
+ Port to ns-resolution time stamps.
+ (Faccept_process_output, wait_reading_process_output):
+ Check for time stamp overflow. Do not assume time_t is signed.
+ (select_wrapper): Remove; we now use pselect.
+ (Fprocess_attributes): Now generates ns-resolution time stamps.
+
+ * sysdep.c: Include utimens.h. Don't include utime.h
+ or worry about struct utimbuf; gnulib does that for us now.
+ (gettimeofday): Remove; gnulib provides a substitute.
+ (make_timeval): New function.
+ (set_file_times): Now sets ns-resolution time stamps.
+ New arg FD; all uses changed.
+ (time_from_jiffies, ltime_from_jiffies, get_up_time)
+ (system_process_attributes):
+ Now returns ns-resolution time stamp. All uses changed.
+ Check for time stamp overflow.
+
+ * sysselect.h: Don't depend on HAVE_SYS_SELECT_H; gnulib
+ provides a substitute now.
+
+ * systime.h: Include timespec.h rather than sys/time.h and time.h,
+ since it guarantees struct timespec.
+ (EMACS_TIME): Now struct timespec, so that we can support
+ ns-resolution time stamps.
+ (EMACS_TIME_RESOLUTION, LOG10_EMACS_TIME_RESOLUTION): New macros.
+ (EMACS_HAS_USECS): Remove; Emacs always has sub-second time stamps now.
+ (EMACS_USECS): Remove.
+ (EMACS_SET_USECS): The underlying time stamp now has ns resolution,
+ so multiply the arg by 1000 before storing it.
+ (EMACS_NSECS, EMACS_SECS_ADDR, EMACS_SET_NSECS, EMACS_SET_SECS_NSECS):
+ New macros.
+ (EMACS_GET_TIME, EMACS_ADD_TIME, EMACS_SUB_TIME):
+ Port to ns-resolution time stamps.
+ (EMACS_TIME_NEG_P): Remove; replaced by....
+ (EMACS_TIME_SIGN): New macro.
+ (EMACS_SET_INVALID_TIME, EMACS_TIME_VALID_P)
+ (EMACS_TIME_FROM_DOUBLE, EMACS_TIME_TO_DOUBLE): New macros.
+ (set_file_times, make_time, lisp_time_argument): Adjust signature.
+ (make_timeval, make_lisp_time, decode_time_components): New decls.
+ (EMACS_TIME_CMP): Remove; no longer used. Plus, it was buggy, in
+ that it mishandled time_t overflow. You can't compare by subtracting!
+ (EMACS_TIME_EQ, EMACS_TIME_NE, EMACS_TIME_GT, EMACS_TIME_GE)
+ (EMACS_TIME_LT, EMACS_TIME_LE): Rewrite in terms of timespec_cmp.
+
+ * term.c: Include <sys/time.h>.
+ (timeval_to_Time): New function, for proper overflow wraparound.
+ (term_mouse_position, term_mouse_click): Use it.
+
+ * undo.c (record_first_change): Support higher-resolution time stamps
+ in the undo buffer.
+ (Fprimitive_undo): Use them when restoring time stamps.
+
+ * w32.c (ltime, U64_TO_LISP_TIME, process_times, emacs_gnutls_pull)
+ (w32_get_internal_run_time):
+ Port to higher-resolution Emacs time stamps.
+ (ltime): Now accepts single 64-bit integer, as that's more convenient
+ for callers.
+
+ * xdisp.c (start_hourglass): Port to ns-resolution time stamps.
+
+ * xgselect.c, xgselect.h (xg_select): Add sigmask argument,
+ for compatibility with pselect. Support ns-resolution time stamps.
+
+ * xmenu.c (x_menu_wait_for_event): Support ns-resolution time stamps.
+
+ * xselect.c (wait_for_property_change, x_get_foreign_selection):
+ Check for time stamp overflow, and support ns-resolution time stamps.
+
+ * xterm.c: Don't include sys/time.h; gnulib does that for us now.
+ Don't worry about whether HAVE_TIMEVAL and HAVE_SELECT are set.
+ (timeval_subtract): Remove; no longer needed.
+ (XTflash, XTring_bell, x_wait_for_event):
+ Port to ns-resolution time stamps. Don't assume time_t is signed.
+
+2012-06-22 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (x_consider_frame_title): Revert last change.
+
+2012-06-22 Eli Zaretskii <eliz@gnu.org>
+
+ * alloc.c (NSTATICS): Enlarge to 0x650. Otherwise, Emacs compiled
+ with -DENABLE_CHECKING -DXASSERTS -DGLYPH_DEBUG=1 -DBYTE_CODE_METER
+ aborts in staticpro during startup. (Without -DBYTE_CODE_METER,
+ staticidx goes up to 1597 out of 1600 = 0x640.)
+
+2012-06-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * fileio.c (Fdefault_file_modes): Block input while fiddling with umask.
+ Otherwise, the umask might be mistakenly 0 while handling input signals.
+
+2012-06-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuf.c (Fread_string): Bind minibuffer-completion-table.
+
+2012-06-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * alloc.c, bytecode.c, ccl.c, coding.c, composite.c, data.c, dosfns.c:
+ * font.c, image.c, keyboard.c, lread.c, menu.c, minibuf.c, msdos.c:
+ * print.c, syntax.c, window.c, xmenu.c, xselect.c: Replace direct
+ access to `contents' member of Lisp_Vector objects with AREF and ASET
+ where appropriate.
+
+2012-06-19 Chong Yidong <cyd@gnu.org>
+
+ * frame.c (delete_frame): When selecting a frame on a different
+ text terminal, do not alter the terminal's top-frame.
+
+ * xdisp.c (format_mode_line_unwind_data): Record the target
+ frame's selected window and its terminal's top-frame.
+ (unwind_format_mode_line): Restore them.
+ (x_consider_frame_title, display_mode_line, Fformat_mode_line):
+ Callers changed.
+ (x_consider_frame_title): Do not condition on HAVE_WINDOW_SYSTEM,
+ since tty frames can be explicitly named.
+ (prepare_menu_bars): Likewise.
+
+ * term.c (Ftty_top_frame): New function.
+
+2012-06-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port byte-code-meter to modern targets.
+ * bytecode.c (METER_CODE) [BYTE_CODE_METER]: Don't assume
+ !CHECK_LISP_OBJECT_TYPE && !USE_LSB_TAG. Problem with
+ CHECK_LISP_OBJECT_TYPE reported by Dmitry Antipov in
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00282.html>.
+ (METER_1, METER_2): Simplify.
+
+2012-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * data.c (Fdefalias): Return `symbol' (bug#11686).
+
+2012-06-18 Martin Rudalics <rudalics@gmx.at>
+
+ * buffer.c (Fkill_buffer): Don't throw an error when the buffer
+ gets killed during executing of this function (Bug#11665).
+ Try to always return Qt when the buffer has been actually killed.
+ (Vkill_buffer_query_functions): In doc-string say that functions
+ run by this hook should not change the current buffer.
+
+2012-06-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix recently-introduced process.c problems found by static checking.
+ * process.c (write_queue_push, write_queue_pop, send_process):
+ Use ptrdiff_t, not int or EMACS_INT, for buffer lengths and offsets.
+ (write_queue_pop): Fix pointer signedness problem.
+ (send_process): Remove unused local.
+
+2012-06-17 Chong Yidong <cyd@gnu.org>
+
+ * xdisp.c (redisplay_internal): No need to redisplay terminal
+ frames that are not on top.
+
+2012-06-17 Troels Nielsen <bn.troels@gmail.com>
+
+ * process.c (make_process): Initialize write_queue.
+ (write_queue_push, write_queue_pop): New functions.
+ (send_process): Use them to maintain correct ordering of process
+ writes (Bug#10815).
+
+2012-06-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h (eassert): Assume C89 or later.
+ This removes the need for CHECK.
+ (CHECK): Remove. Its comments about always evaluating its
+ argument were confusing, as 'eassert' typically does not evaluate
+ its argument.
+
+ * coding.c (produce_chars): Use ptrdiff_t, not int.
+
+ * xterm.c (x_draw_underwave): Check for integer overflow.
+ This pacifies gcc 4.7.0 -Wunsafe-loop-optimizations on x86-64.
+
+2012-06-17 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (x_free_frame_resources): Move xfree so freed memory isn't
+ referenced (Bug#11583).
+
+2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com>
+
+ Implement wave-style variant of underlining.
+ * dispextern.h (face_underline_type): New enum.
+ (face): Add field for underline type.
+ * nsterm.m (ns_draw_underwave): New function.
+ (ns_draw_text_decoration): Use it.
+ * w32term.c (w32_restore_glyph_string_clip, w32_draw_underwave):
+ New functions.
+ (x_draw_glyph_string): Use them.
+ * xfaces.c (Qline, Qwave): New Lisp objects.
+ (check_lface_attrs, merge_face_ref)
+ (Finternal_set_lisp_face_attribute, realize_x_face):
+ Handle wave-style underline face attributes.
+ * xterm.c (x_draw_underwave): New function.
+ (x_draw_glyph_string): Use it.
+
+2012-06-16 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/emacs.$(O), $(BLD)/fringe.$(O))
+ ($(BLD)/xml.$(O), $(BLD)/intervals.$(O), $(BLD)/macros.$(O))
+ ($(BLD)/minibuf.$(O), $(BLD)/regex.$(O), $(BLD)/region-cache.$(O))
+ ($(BLD)/textprop.$(O), $(BLD)/undo.$(O), $(BLD)/window.$(O))
+ ($(BLD)/w32select.$(O)): Update dependencies.
+
+2012-06-16 Andreas Schwab <schwab@linux-m68k.org>
+
+ * buffer.h (FETCH_MULTIBYTE_CHAR): Define as inline.
+ (BUF_FETCH_MULTIBYTE_CHAR): Likewise.
+ * character.c (_fetch_multibyte_char_p): Remove.
+ * alloc.c: Include "character.h" before "buffer.h".
+ * bidi.c: Likewise.
+ * buffer.c: Likewise.
+ * bytecode.c: Likewise.
+ * callint.c: Likewise.
+ * callproc.c: Likewise.
+ * casefiddle.c: Likewise.
+ * casetab.c: Likewise.
+ * category.c: Likewise.
+ * cmds.c: Likewise.
+ * coding.c: Likewise.
+ * composite.c: Likewise.
+ * dired.c: Likewise.
+ * dispnew.c: Likewise.
+ * doc.c: Likewise.
+ * dosfns.c: Likewise.
+ * editfns.c: Likewise.
+ * emacs.c: Likewise.
+ * fileio.c: Likewise.
+ * filelock.c: Likewise.
+ * font.c: Likewise.
+ * fontset.c: Likewise.
+ * fringe.c: Likewise.
+ * indent.c: Likewise.
+ * insdel.c: Likewise.
+ * intervals.c: Likewise.
+ * keyboard.c: Likewise.
+ * keymap.c: Likewise.
+ * lread.c: Likewise.
+ * macros.c: Likewise.
+ * marker.c: Likewise.
+ * minibuf.c: Likewise.
+ * nsfns.m: Likewise.
+ * nsmenu.m: Likewise.
+ * print.c: Likewise.
+ * process.c: Likewise.
+ * regex.c: Likewise.
+ * region-cache.c: Likewise.
+ * search.c: Likewise.
+ * syntax.c: Likewise.
+ * term.c: Likewise.
+ * textprop.c: Likewise.
+ * undo.c: Likewise.
+ * unexsol.c: Likewise.
+ * w16select.c: Likewise.
+ * w32fns.c: Likewise.
+ * w32menu.c: Likewise.
+ * window.c: Likewise.
+ * xdisp.c: Likewise.
+ * xfns.c: Likewise.
+ * xmenu.c: Likewise.
+ * xml.c: Likewise.
+ * xselect.c: Likewise.
+
+2012-06-16 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (set_cursor_from_row): Don't dereference glyphs_end.
+ If all the glyphs of the glyph row came from strings, and we have no
+ cursor positioning clues, put the cursor on the first glyph of the
+ row.
+ (handle_face_prop): Use chunk-relative overlay string index when
+ indexing into it->string_overlays array. (Bug#11653)
+ (set_cursor_from_row): Use the leftmost glyph as GLYPH_BEFORE, not
+ the rightmost. (Bug#11720)
+
+2012-06-16 Andreas Schwab <schwab@linux-m68k.org>
+
+ * category.h (CHAR_HAS_CATEGORY): Define as inline.
+ (CATEGORY_MEMBER): Enforce 1/0 value.
+ * category.c (_temp_category_set): Remove.
+
+2012-06-16 Eli Zaretskii <eliz@gnu.org>
+
+ * window.c (Fdelete_other_windows_internal)
+ (Fdelete_window_internal): Don't access frame's mouse highlight
+ info of the initial frame. (Bug#11677)
+
+2012-06-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * .gdbinit (xgetint): Fix recently-introduced paren typo.
+ Assume USE_2_TAGS_FOR_INTS.
+ (xreload): Adjust $tagmask width to match recent lisp.h change.
+
+ Simplify lisp.h in minor ways that should not affect code.
+ * lisp.h (USE_2_TAGS_FOR_INTS): Remove, as it was always defined.
+ (LISP_INT_TAG, case_Lisp_Int, LISP_STRING_TAG, LISP_INT_TAG_P)
+ (LISP_INT1_TAG, enum Lisp_Type, XINT, XUINT, make_number):
+ Simplify under the assumption that USE_2_TAGS_FOR_INTS is defined.
+ (INTTYPEBITS): New macro, for clarity.
+ (INTMASK, MOST_POSITIVE_FIXNUM): Use it.
+ (LISP_INT1_TAG, LISP_STRING_TAG, LISP_INT_TAG_P):
+ Simplify now that USE_LSB_TAG is always defined.
+ (TYPEMASK, XINT) [USE_LSB_TAG]: Remove unnecessary cast.
+ (make_number) [!USE_LSB_TAG]: Use INTMASK; that's simpler.
+
+2012-06-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/data.$(O)): Update dependencies.
+
+2012-06-13 Glenn Morris <rgm@gnu.org>
+
+ * s/bsd-common.h (BSD4_3):
+ * s/usg5-4-common.h (USG5_4): No longer define; unused.
+
+2012-06-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp.h (Lisp_Object) [CHECK_LISP_OBJECT_TYPE]: Define as struct
+ instead of union.
+ (XLI, XIL): Define.
+ (XHASH, XTYPE, XINT, XUINT, make_number, XSET, XPNTR, XUNTAG):
+ Use them.
+ * emacs.c (gdb_use_struct): Rename from gdb_use_union.
+ * .gdbinit: Check gdb_use_struct instead of gdb_use_union.
+ * alloc.c (widen_to_Lisp_Object): Remove.
+ (mark_memory): Use XIL instead of widen_to_Lisp_Object.
+ * frame.c (delete_frame): Remove outdated comment.
+ * w32fns.c (Fw32_register_hot_key): Use XLI instead of checking
+ USE_LISP_UNION_TYPE.
+ (Fw32_unregister_hot_key): Likewise.
+ (Fw32_toggle_lock_key): Likewise.
+ * w32menu.c (add_menu_item): Likewise.
+ (w32_menu_display_help): Use XIL instead of checking
+ USE_LISP_UNION_TYPE.
+ * w32heap.c (allocate_heap): Don't check USE_LISP_UNION_TYPE.
+ (init_heap): Likewise.
+ * w32term.c (w32_read_socket): Update comment.
+
+2012-06-13 Glenn Morris <rgm@gnu.org>
+
+ * s/usg5-4-common.h, src/s/unixware.h:
+ Remove define/undef of HAVE_SYSV_SIGPAUSE (not used since 2010-05-04).
+
+ * s/gnu.h (POSIX_SIGNALS): Remove (not used since 2010-05-04).
+
+2012-06-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ USE_LISP_UNION_TYPE + USE_LSB_TAG cleanup (Bug#11604)
+ * alloc.c (make_number) [!defined make_number]:
+ Remove, as lisp.h always defines this now.
+ (mark_maybe_pointer): Simplify since USE_LSB_TAG is always defined now.
+ (roundup_size): Verify that it is a power of 2.
+ * data.c (Fmake_variable_buffer_local, Fmake_local_variable):
+ * ftfont.c (ftfont_driver): Use LISP_INITIALLY_ZERO.
+ * lisp.h (USE_LSB_TAG): Allow the builder to compile with
+ -DUSE_LSB_TAG=0, to override the automatically-selected default.
+ USE_LSB_TAG now is always defined to be either 0 or 1.
+ All uses changed.
+ (union Lisp_Object): Don't worry about WORDS_BIGENDIAN; the
+ code works fine either way, and efficiency is not a concern here,
+ as the union type is for debugging, not for production.
+ (LISP_MAKE_RVALUE, make_number) [USE_LISP_UNION_TYPE]:
+ Use an inline function on all platforms when using the union type,
+ since this is simpler and 'static inline' can be used portably
+ within Emacs now.
+ (LISP_INITIALLY_ZERO): New macro.
+ (XFASTINT, XSETFASTINT) [USE_LISP_UNION_TYPE]: Remove.
+ (XSET) [USE_LISP_UNION_TYPE]: Don't overparenthesize.
+
+2012-06-12 Glenn Morris <rgm@gnu.org>
+
+ * s/gnu-kfreebsd.h, s/hpux11.h, s/openbsd.h, s/sol2-10.h: Remove files.
+
+ * s/gnu-linux.h (HAVE_PROCFS): Move to configure.
+
+ * s/hpux10-20.h, s/openbsd.h, s/usg5-4-common.h:
+ Move BROKEN_SIGIO to configure.
+
+ * s/bsd-common.h, s/darwin.h, s/gnu-kfreebsd.h, s/hpux10-20.h:
+ Move NO_TERMIO to configure.
+
+2012-06-12 Chong Yidong <cyd@gnu.org>
+
+ * image.c (imagemagick_load_image): Use MagickFlattenImage if
+ MagickMergeImageLayers is undefined. Use pixel pusher loop if
+ MagickExportImagePixels is undefined.
+
+2012-06-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * image.c (imagemagick_load_image): Remove unused label.
+
+2012-06-11 Glenn Morris <rgm@gnu.org>
+
+ * s/aix4-2.h, s/bsd-common.h, s/cygwin.h, s/darwin.h:
+ * s/gnu-kfreebsd.h, s/gnu-linux.h, s/gnu.h, s/hpux10-20.h:
+ * s/irix6-5.h, s/ms-w32.h, s/msdos.h, s/template.h:
+ * s/usg5-4-common.h: Move SYSTEM_TYPE to configure.
+
+2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (make_byte_code): New function.
+ (Fmake_byte_code): Use it. Don't purify here.
+ * lread.c (read1): Use it as well to avoid extra allocation.
+
+2012-06-11 Chong Yidong <cyd@gnu.org>
+
+ * image.c (imagemagick_load_image): Implement transparency.
+
+2012-06-10 Andreas Schwab <schwab@linux-m68k.org>
+
+ * regex.c (at_begline_loc_p): Also recognize `(?N:' and correctly
+ account for preceding backslashes. (Bug#11663)
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * term.c: Support italics in capable terminals (Bug#9652).
+ (no_color_bit): Replace unused NC_BLINK with NC_ITALIC.
+ (turn_on_face): Output using TS_enter_italic_mode if available.
+ Don't handle unused blinking and alt-charset cases.
+ (turn_off_face): Handle italic case; discard unused tty_blinking_p
+ and tty_alt_charset_p cases.
+ (tty_capable_p, init_tty): Support italics.
+
+ * termchar.h (struct tty_display_info): Add field for italics.
+ Remove unused blink field.
+
+ * xfaces.c (tty_supports_face_attributes_p, realize_tty_face):
+ Handle slant.
+
+ * dispextern.h: Replace unused TTY_CAP_BLINK with TTY_CAP_ITALIC.
+ (struct face): Remove unused fields tty_dim_p, tty_blinking_p, and
+ tty_alt_charset_p. Add tty_italic_p.
+
+2012-06-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (XD_BASIC_DBUS_TYPE): Use dbus_type_is_valid and
+ dbus_type_is_basic if available.
+ (xd_extract_signed, xd_extract_unsigned): Rename from
+ extract_signed and extract_unsigned, respectively. Adapt callers.
+
+2012-06-09 Chong Yidong <cyd@gnu.org>
+
+ * xfaces.c (face_for_overlay_string): Handle face remapping (Bug#2066).
+
+ * fringe.c (Fset_fringe_bitmap_face): Handle the noninteractive
+ case (Bug#9752).
+
+2012-06-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xdisp.c (vmessage): Treat frame message as multibyte.
+ Without this change, (let ((§ 1)) (make-variable-buffer-local '§))
+ would generate the diagnostic "Making \302\247 buffer-local while
+ let-bound!".
+
+2012-06-08 Eli Zaretskii <eliz@gnu.org>
+
+ * dispnew.c (showing_window_margins_p): Undo last change, which
+ was done due to an inadvertent commit.
+ (adjust_frame_glyphs_for_frame_redisplay): Do call
+ showing_window_margins_p.
+
+2012-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fmake_var_non_special): New primitive.
+ (syms_of_eval): Defsubr it.
+ * lread.c (syms_of_lread): Mark `values' as lexically scoped.
+
+2012-06-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * dispnew.c (showing_window_margins_p): Wrap in #if 0 to prevent unused
+ function warning (the only call is inside #if 0 since 2012-06-08T08:44:45Z!eliz@gnu.org).
+
+2012-06-08 Eli Zaretskii <eliz@gnu.org>
+
+ * alloc.c (allocate_vectorlike): Fix last change.
+
+2012-06-08 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Block-based vector allocation of small vectors.
+ * lisp.h (struct vectorlike_header): New field `nbytes',
+ adjust comment accordingly.
+ * alloc.c (enum mem_type): New type `MEM_TYPE_VECTOR_BLOCK'
+ to denote vector blocks. Adjust users (live_vector_p,
+ mark_maybe_pointer, valid_lisp_object_p) accordingly.
+ (COMMON_MULTIPLE): Move outside #if USE_LSB_TAG.
+ (VECTOR_BLOCK_SIZE, vroundup, VECTOR_BLOCK_BYTES),
+ (VBLOCK_BYTES_MIN, VBLOCK_BYTES_MAX, VECTOR_MAX_FREE_LIST_INDEX),
+ (VECTOR_FREE_LIST_FLAG, ADVANCE, VINDEX, SETUP_ON_FREE_LIST),
+ (VECTOR_SIZE, VECTOR_IN_BLOCK): New macros.
+ (roundup_size): New constant.
+ (struct vector_block): New data type.
+ (vector_blocks, vector_free_lists, zero_vector): New variables.
+ (all_vectors): Rename to `large_vectors'.
+ (allocate_vector_from_block, init_vectors, allocate_vector_from_block)
+ (sweep_vectors): New functions.
+ (allocate_vectorlike): Return `zero_vector' as the only vector of
+ 0 items. Allocate new vector from block if vector size is less than
+ or equal to VBLOCK_BYTES_MAX.
+ (Fgarbage_collect): Move all vector sweeping code to sweep_vectors.
+ (init_alloc_once): Add call to init_vectors.
+
+2012-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fmacroexpand): Stop if the macro returns the same form.
-2012-08-12 Jan Djärv <jan.h.d@swipnet.se>
+2012-06-07 Paul Eggert <eggert@cs.ucla.edu>
- * nsterm.m (ns_read_socket): Return early if there is a modal
- window (Bug#12043).
+ * doprnt.c (doprnt): Truncate multibyte char correctly.
+ Without this change, doprnt (buf, 2, "%s", FORMAT_END, AP)
+ would mishandle a string argument "Xc" if X was a multibyte
+ character of length 2: it would truncate after X's first byte
+ rather than including all of X.
- * nsmenu.m (Popdown_data): New struct.
- (pop_down_menu): p->pointer is Popdown_data. Release the pool and
- free Popdown_data.
- (ns_popup_dialog): Use NSAutoreleasePool and pass it to pop_down_menu.
- (initWithContentRect): Make imgView and contentView non-static
- and autorelease them. Also autorelease img and matrix (Bug#12005).
- (dealloc): Remove (Bug#12005).
+2012-06-06 Chong Yidong <cyd@gnu.org>
- * nsterm.m (keyDown:): Interpret flags without left/right bits
- as the left key (Bug#11670).
+ * buffer.c (word_wrap): Doc fix.
- * nsmenu.m (ns_update_menubar): Add braces to ambigous if-else.
+2012-06-04 Paul Eggert <eggert@cs.ucla.edu>
-2012-08-08 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+ * xdisp.c (note_mode_line_or_margin_highlight): Pacify gcc -Wall.
- * unexmacosx.c (copy_data_segment): Copy initialized data in
- statically linked libraries from input file rather than memory.
+2012-06-03 Glenn Morris <rgm@gnu.org>
-2012-08-07 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+ * xdisp.c (tool-bar-style): Doc fix.
- * 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-06-03 Ulrich Müller <ulm@gentoo.org>
-2012-07-19 Chong Yidong <cyd@gnu.org>
+ * Makefile.in (PAXCTL): Define.
+ (temacs$(EXEEXT)): Disable memory randomization for the temacs
+ binary via PaX flags if the paxctl utility is available.
+ (emacs$(EXEEXT), bootstrap-emacs$(EXEEXT)):
+ Restore PaX flags to their default. (Bug#11398)
- * window.c (Fwindow_absolute_pixel_edges)
- (Fdelete_other_windows_internal): Signal an error if the window is
- on a dead frame (Bug#11984).
+2012-06-03 Chong Yidong <cyd@gnu.org>
-2012-07-14 Eli Zaretskii <eliz@gnu.org>
+ * xdisp.c (decode_mode_spec_coding): Display a space for a unibyte
+ buffer (Bug#11226).
- Remove FILE_SYSTEM_CASE.
- * s/msdos.h (FILE_SYSTEM_CASE): Don't define.
+2012-06-03 Chong Yidong <cyd@gnu.org>
- * fileio.c (FILE_SYSTEM_CASE): Don't define.
- (Ffile_name_directory, Fexpand_file_name): Don't use FILE_SYSTEM_CASE.
- Fixes problems on MS-DOS with Vtemp_file_name_pattern when
- call-process-region passes it through expand-file-name.
+ * xdisp.c (calc_pixel_width_or_height): Use Fbuffer_local_value.
+ (note_mode_line_or_margin_highlight): If there is no help echo,
+ use mode-line-default-help-echo. Handle the case where the mouse
+ position is past the end of the mode line string.
- * dired.c (file_name_completion): Don't use FILE_SYSTEM_CASE.
+ * buffer.c (buffer_local_value_1): New function, split from
+ Fbuffer_local_value; can return Qunbound.
+ (Fbuffer_local_value): Use it.
+ (Vmode_line_format): Docstring tweaks.
-2012-07-12 Andreas Schwab <schwab@linux-m68k.org>
+2012-06-02 Paul Eggert <eggert@cs.ucla.edu>
- Fix crash when creating indirect buffer (Bug#11917)
- * buffer.c (buffer_lisp_local_variables): Add argument CLONE.
- Don't handle unbound variables specially if non-zero.
- (Fbuffer_local_variables): Pass zero.
- (clone_per_buffer_values): Pass non-zero.
+ * sysdep.c (system_process_attributes): Improve comment.
-2012-06-28 Andreas Schwab <schwab@linux-m68k.org>
+2012-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
- * gnutls.c (emacs_gnutls_handshake): Revert last change. Add QUIT
- to make the loop interruptible.
+ * keyboard.c: Export real-this-command to Elisp.
+ (syms_of_keyboard): Rename real_this_command to Vreal_this_command
+ and DEFVAR it. Update all users.
-2012-06-26 Andreas Schwab <schwab@linux-m68k.org>
+2012-06-02 Paul Eggert <eggert@cs.ucla.edu>
- * gnutls.c (emacs_gnutls_handshake): Only retry if
- GNUTLS_E_INTERRUPTED.
+ * minibuf.c (Fassoc_string): Remove duplicate declaration.
-2012-06-23 Eli Zaretskii <eliz@gnu.org>
+ * sysdep.c (system_process_attributes) [SOLARIS2 && HAVE_PROCFS]:
+ Convert pctcpu and pctmem to Lisp float properly.
+ Let the compiler fold better, as 100.0/0x8000 is exact.
- * ralloc.c (r_alloc_inhibit_buffer_relocation): Fix stupid thinko
- in the logic of incrementing and decrementing the value of
- use_relocatable_buffers.
+2012-06-02 Andreas Schwab <schwab@linux-m68k.org>
-2012-06-21 Glenn Morris <rgm@gnu.org>
+ * alloc.c (CONS_BLOCK_SIZE): Account for padding at the end of
+ cons_block.
- * charset.c (init_charset): Make lack of etc/charsets fatal.
+2012-06-01 Paul Eggert <eggert@cs.ucla.edu>
-2012-06-11 Jan Djärv <jan.h.d@swipnet.se>
+ * xfns.c (x_set_tool_bar_lines) [USE_GTK]: Adjust to bitfield change.
- * nsterm.m (x_free_frame_resources): Move xfree so freed memory isn't
- referenced (Bug#11583).
+2012-06-01 Dmitry Antipov <dmantipov@yandex.ru>
-2012-06-01 Chong Yidong <cyd@gnu.org>
+ For a 'struct window', replace some Lisp_Object fields to
+ bitfields where appropriate, remove unused fields.
+ * window.h (struct window): Remove unused 'last_mark_x' and
+ 'last_mark_y' fields. Rename 'mini_p' field to 'mini',
+ change it's type from Lisp_Object to bitfield.
+ Change type of 'force_start', 'optional_new_start',
+ 'last_had_star', 'update_mode_line' and 'start_at_line_beg'
+ fields from Lisp_Object to bitfield. Adjust users accordingly.
- * Version 24.1 released.
+2012-05-31 Paul Eggert <eggert@cs.ucla.edu>
-2012-05-30 Eli Zaretskii <eliz@gnu.org>
+ Pacify gcc -Wdouble-precision when using Xaw.
+ * xterm.c (xaw_jump_callback, x_set_toolkit_scroll_bar_thumb)
+ [HAVE_X_WINDOWS && USE_TOOLKIT_SCROLL_BARS && !USE_MOTIF && !USE_GTK]:
+ Use 'float' consistently, rather than 'float' in most places
+ and 'double' in a couple of places.
+
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (handle_stop): Detect whether we have overlay strings
loaded by testing it->current.overlay_string_index to be
non-negative, instead of checking whether n_overlay_strings is
positive. (Bug#11587)
-2012-05-30 Chong Yidong <cyd@gnu.org>
+2012-05-31 Chong Yidong <cyd@gnu.org>
* keymap.c (describe_map_tree): Revert 2011-07-07 change (Bug#1169).
* doc.c (Fsubstitute_command_keys): Doc fix.
-2012-05-29 Eli Zaretskii <eliz@gnu.org>
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
* search.c (search_buffer): Remove calls to
r_alloc_inhibit_buffer_relocation, as it is now called by
maybe_unify_char, which was the cause of relocation of buffer text
in bug#11519.
-2012-05-23 Eli Zaretskii <eliz@gnu.org>
+2012-05-31 Eli Zaretskii <eliz@gnu.org>
* charset.c (maybe_unify_char): Inhibit relocation of buffer text
for the duration of call to load_charset, to avoid problems with
decrement the inhibition flag, instead of just setting or
resetting it.
-2012-05-24 Ken Brown <kbrown@cornell.edu>
+2012-05-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove obsolete '#define static' cruft.
+ * s/hpux10-20.h (_FILE_OFFSET_BITS): Don't #undef.
+ This #undef was "temporary" in 2000; it is no longer needed
+ now that '#define static' has gone away.
+ * xfns.c, xterm.h (gray_bitmap_width, gray_bitmap_height)
+ (gray_bitmap_bits): Remove; no longer needed.
+ All uses replaced with definiens.
+ * xterm.c: Include "bitmaps/gray.xbm".
+
+2012-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean up __executable_start, monstartup when --enable-profiling.
+ The following changes affect the code only when profiling.
+ * dispnew.c (__executable_start): Rename from safe_bcopy.
+ Define only on platforms that need it.
+ * emacs.c: Include <sys/gmon.h> when profiling.
+ (_mcleanup): Remove decl, since <sys/gmon.h> does it now.
+ (__executable_start): Remove decl, since lisp.h does it now.
+ (safe_bcopy): Remove decl; no longer has that name.
+ (main): Coalesce #if into single bit of code, for simplicity.
+ Cast pointers to uintptr_t, since standard libraries want integers
+ and not pointers.
+ * lisp.h (__executable_start): New decl.
+
+2012-05-31 Glenn Morris <rgm@gnu.org>
+
+ * image.c (Fimagemagick_types): Doc fix.
+
+2012-05-30 Jim Meyering <meyering@redhat.com>
+
+ * callproc.c (Fcall_process_region): Include directory component
+ in mkstemp error message (Bug#11586).
+
+2012-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c, lisp.h (make_pure_vector): Now static.
+
+2012-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function):
+ Move to byte-run.el.
+ (Fautoload): Do the hash-doc more carefully.
+ * data.c (Fdefalias): Purify definition, except for keymaps.
+ (Qdefun): Move from eval.c.
+ * lisp.h (Qdefun): Remove.
+ * lread.c (read1): Tiny simplification.
+
+2012-05-29 Troels Nielsen <bn.troels@gmail.com>
+
+ Do not create empty overlays with the evaporate property (Bug#9642).
+ * buffer.c (Fmove_overlay): Reinstate the earlier fix for
+ Bug#9642, but explicitly check that the buffer the overlay would
+ be moved to is live and rearrange lines to make sure that errors
+ will not put the overlay in an inconsistent state.
+ (Fdelete_overlay): Cosmetics.
+
+2012-05-28 Eli Zaretskii <eliz@gnu.org>
+
+ * w32term.c (my_bring_window_to_top): New function.
+ (x_raise_frame): Use handle returned by DeferWindowPos, which
+ could be different from the original one.
+ Call my_bring_window_to_top instead of my_set_foreground_window.
+ (Bug#11513)
+
+ * w32fns.c (w32_wnd_proc): Accept and process WM_EMACS_BRINGTOTOP
+ by calling BringWindowToTop.
+
+ * w32term.h (WM_EMACS_BRINGTOTOP): New message.
+ (WM_EMACS_END): Increase by one.
+
+2012-05-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * bidi.c (bidi_mirror_char): Put eassert before conversion to int.
+ This avoids undefined behavior that might cause the eassert
+ to not catch an out-of-range value.
+
+2012-05-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/w32inevt.$(O), $(BLD)/w32console.$(O)):
+ Update dependencies.
+
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ * bidi.c (bidi_mirror_char): Fix last change.
+
+2012-05-27 Andreas Schwab <schwab@linux-m68k.org>
+
+ * unexmacosx.c (copy_data_segment): Truncate after 16 characters
+ when referring to sectname field in printf format.
+
+2012-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp.h [REL_ALLOC]: Omit duplicate prototypes.
+ Only r_alloc_inhibit_buffer_relocation needed to be added;
+ the others were already declared.
+
+ * bidi.c (bidi_mirror_char): Don't possibly truncate the integer
+ before checking whether it's out of range. Put the check inside
+ eassert. See
+ <http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00485.html>.
+
+2012-05-27 Ken Brown <kbrown@cornell.edu>
* callproc.c (Fcall_process): Restore a line that was accidentally
commented out in the 2011-02-13 change (bug#11547).
-2012-05-23 Eli Zaretskii <eliz@gnu.org>
+2012-05-27 Eli Zaretskii <eliz@gnu.org>
* lisp.h [REL_ALLOC]: Add prototypes for external functions
defined on ralloc.c.
text while re_search_2 is doing its job, because re_search_2 is
passed C pointers to buffer text. (Bug#11519)
-2012-05-21 Eli Zaretskii <eliz@gnu.org>
-
* msdos.c (internal_terminal_init) <Vwindow_system_version>:
Update value to 24.
-2012-05-19 Eli Zaretskii <eliz@gnu.org>
-
* xdisp.c (move_it_to): Under MOVE_TO_Y, when restoring iterator
state after an additional call to move_it_in_display_line_to, keep
the values of it->max_ascent and it->max_descent found for the
was in revid eliz@gnu.org-20120513182235-4p6386j761ld0nwb.
(Bug#11464)
-2012-05-15 Eli Zaretskii <eliz@gnu.org>
+2012-05-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix coding-related core dumps with gcc -ftrapv.
+ The code was computing A - B, where A and B are pointers, and B is
+ random garbage. This can lead to core dumps on platforms that
+ have special pointer registers, and it also leads to core dumps on
+ x86-64 when compiled with gcc -ftrapv. The fix is to compute
+ A - B only when B is initialized properly.
+ * coding.c (coding_set_source, coding_set_destination): Return void.
+ (coding_change_source, coding_change_destinations): New functions,
+ with the old behaviors of coding_set_source and coding_set_destination.
+ All callers that need an offset changed to use these new functions.
+
+2012-05-26 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (ns_init_paths): Don't mess with INFOPATH. (Bug#2791)
+
+2012-05-26 Eli Zaretskii <eliz@gnu.org>
+
+ Extend mouse support on W32 text-mode console.
+ * xdisp.c (draw_row_with_mouse_face):
+ Call tty_draw_row_with_mouse_face for WINDOWSNT as well.
+
+ * w32console.c: Include window.h.
+ (w32con_write_glyphs_with_face, tty_draw_row_with_mouse_face):
+ New functions.
+ (initialize_w32_display): Initialize mouse-highlight data.
+
+ * w32inevt.c: Include termchar.h and window.h.
+ (do_mouse_event): Support mouse-autoselect-window. When the mouse
+ moves, call note_mouse_highlight. If help_echo changed, call
+ gen_help_event to produce help-echo message in the echo area.
+ Call clear_mouse_face if mouse_face_hidden is set in the mouse
+ highlight info.
+
+2012-05-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lread.c (read1): Simplify slightly to avoid an overflow warning
+ with GCC 4.7.0 on x86-64.
+
+2012-05-26 Eli Zaretskii <eliz@gnu.org>
+
+ * bidi.c (bidi_mirror_char): Revert last change: an int is
+ definitely wide enough here.
+
+2012-05-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix integer width and related bugs (Bug#9874).
+ * alloc.c (pure_bytes_used_lisp, pure_bytes_used_non_lisp):
+ (allocate_vectorlike, buffer_memory_full, struct sdata, SDATA_SIZE)
+ (string_bytes, check_sblock, allocate_string_data):
+ (compact_small_strings, Fmake_bool_vector, make_string)
+ (make_unibyte_string, make_multibyte_string)
+ (make_string_from_bytes, make_specified_string)
+ (allocate_vectorlike, Fmake_vector, find_string_data_in_pure)
+ (make_pure_string, make_pure_c_string, make_pure_vector, Fpurecopy)
+ (mark_vectorlike):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (allocate_pseudovector):
+ Use int, not EMACS_INT, where int is wide enough.
+ (inhibit_garbage_collection, Fgarbage_collect):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * bidi.c (bidi_mirror_char): Use EMACS_INT, not int, where
+ int might not be wide enough.
+ (bidi_cache_search, bidi_cache_find, bidi_init_it)
+ (bidi_count_bytes, bidi_char_at_pos, bidi_fetch_char)
+ (bidi_at_paragraph_end, bidi_find_paragraph_start)
+ (bidi_paragraph_init, bidi_resolve_explicit, bidi_resolve_weak)
+ (bidi_level_of_next_char, bidi_move_to_visually_next):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * buffer.c (copy_overlays, Fgenerate_new_buffer_name)
+ (Fkill_buffer, Fset_buffer_major_mode)
+ (advance_to_char_boundary, Fbuffer_swap_text)
+ (Fset_buffer_multibyte, overlays_at, overlays_in)
+ (overlay_touches_p, struct sortvec, record_overlay_string)
+ (overlay_strings, recenter_overlay_lists)
+ (adjust_overlays_for_insert, adjust_overlays_for_delete)
+ (fix_start_end_in_overlays, fix_overlays_before, modify_overlay)
+ (Fmove_overlay, Fnext_overlay_change, Fprevious_overlay_change)
+ (Foverlay_recenter, last_overlay_modification_hooks_used)
+ (report_overlay_modification, evaporate_overlays, enlarge_buffer_text):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (validate_region): Omit unnecessary test for b <= e,
+ since that's guaranteed by the previous test.
+ (adjust_overlays_for_delete): Avoid pos + length overflow.
+ (Fmove_overlay, Fdelete_overlay, add_overlay_mod_hooklist)
+ (report_overlay_modification):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Foverlays_at, Fnext_overlay_change, Fprevious_overlay_change):
+ Omit pointer cast, which isn't needed anyway, and doesn't work
+ after the EMACS_INT -> ptrdiff_t change.
+ (Fmove_overlay): Clip BEG and END to ptrdiff_t to avoid overflow.
+ * buffer.h: Adjust decls to match defn changes elsewhere.
+ (struct buffer_text, struct buffer):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ Use EMACS_INT, not int, where int might not be wide enough.
+ * bytecode.c (unmark_byte_stack, exec_byte_code): Use ptrdiff_t,
+ not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (exec_byte_code): Use tighter memory-full test, one that checks
+ for alloca overflow. Don't compute the address of the object just
+ before an array, as that's not portable. Use EMACS_INT, not
+ ptrdiff_t or int, where ptrdiff_t or int might not be wide enough.
+ * callint.c (Fcall_interactively):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * callproc.c (call_process_kill, Fcall_process):
+ Don't assume pid_t fits into an Emacs fixnum.
+ (call_process_cleanup, Fcall_process, child_setup):
+ Don't assume pid_t fits into int.
+ (call_process_cleanup, Fcall_process, delete_temp_file)
+ (Fcall_process_region):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fcall_process): Simplify handling of volatile integers.
+ Use int, not EMACS_INT, where int will do.
+ * casefiddle.c (casify_object, casify_region, operate_on_word)
+ (Fupcase_word, Fdowncase_word, Fcapitalize_word):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (casify_object): Avoid integer overflow when overallocating buffer.
+ * casetab.c (set_identity, shuffle): Prefer int to unsigned when
+ either works. Use lint_assume to convince GCC 4.6.1 that it's OK.
+ * category.c (Fchar_category_set): Don't assume fixnum fits in int.
+ * category.h (CATEGORYP): Don't assume arg is nonnegative.
+ * ccl.c (GET_CCL_INT): Remove; no longer needed, since the
+ integers are now checked earlier. All uses replaced with XINT.
+ (ccl_driver):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ For CCL_MapSingle, check that content and value are in int range.
+ (ccl_driver, Fregister_code_conversion_map):
+ Check that Vcode_version_map_vector is a vector.
+ (resolve_symbol_ccl_program): Check that vector header is in range.
+ Always copy the vector, so that we can check its contents reliably
+ now rather than having to recheck each instruction as it's being
+ executed. Check that vector words fit in 'int'.
+ (ccl_get_compiled_code, Fregister_ccl_program)
+ (Fregister_code_conversion_map): Use ptrdiff_t, not int, for
+ program indexes, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fccl_execute, Fccl_execute_on_string): Check that initial reg
+ contents are in range.
+ (Fccl_execute_on_string): Check that status is in range.
+ * ccl.h (struct ccl_program.idx): Now ptrdiff_t, not int.
+ * character.c (char_resolve_modifier_mask, Fchar_resolve_modifiers):
+ Accept and return EMACS_INT, not int, because callers can pass values
+ out of 'int' range.
+ (c_string_width, strwidth, lisp_string_width, chars_in_text)
+ (multibyte_chars_in_text, parse_str_as_multibyte)
+ (str_as_multibyte, count_size_as_multibyte, str_to_multibyte)
+ (str_as_unibyte, str_to_unibyte, string_count_byte8)
+ (string_escape_byte8, Fget_byte):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Funibyte_string): Use CHECK_RANGED_INTEGER, not CHECK_NATNUM, to
+ avoid mishandling large integers.
+ * character.h: Adjust decls to match defn changes elsewhere.
+ * charset.c (load_charset_map_from_file, find_charsets_in_text)
+ (Ffind_charset_region):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (load_charset_map_from_file): Redo idx calculation to avoid overflow.
+ (load_charset_map_from_vector, Fdefine_charset_internal):
+ Don't assume fixnum fits in int.
+ (load_charset_map_from_vector, Fmap_charset_chars):
+ Remove now-unnecessary CHECK_NATNUMs.
+ (Fdefine_charset_internal): Check ranges here, more carefully.
+ Don't rely on undefined behavior with signed left shift overflow.
+ Don't assume unsigned int fits into fixnum, or that fixnum fits
+ into unsigned int. Don't require max_code to be a valid fixnum;
+ that's not true for gb10830 4-byte on a 32-bit host. Allow
+ invalid_code to be a cons, for the same reason. Require code_offset
+ to be a character. Avoid int overflow if max_char is close
+ to INT_MAX.
+ (CODE_POINT_TO_INDEX): On 32-bit hosts, return int, not unsigned;
+ this is intended anyway and avoids some undefined behavior.
+ (load_charset_map): Pass unsigned, not int, as 2nd arg of
+ INDEX_TO_CODE_POINT, as that's what it expects.
+ (Funify_charset, encode_char): Don't stuff unsigned vals into int vars.
+ * charset.h (DECODE_CHAR): Return int, not unsigned;
+ this is what was intended anyway, and it avoids undefined behavior.
+ (CHARSET_OFFSET): Remove unused macro, instead of fixing its
+ integer-overflow issues.
+ (ENCODE_CHAR): Return unsigned on all hosts, not just on 32-bit hosts.
+ Formerly, it returned EMACS_INT on 64-bit hosts in the common case
+ where the argument is EMACS_INT, and this behavior is not intended.
+ * chartab.c (Fmake_char_table, Fset_char_table_range)
+ (uniprop_get_decoder, uniprop_get_encoder):
+ Don't assume fixnum fits in int.
+ * cmds.c (move_point): New function, that does the gist of
+ Fforward_char and Fbackward_char, but does so while checking
+ for integer overflow more accurately.
+ (Fforward_char, Fbackward_char): Use it.
+ (Fforward_line, Fend_of_line, internal_self_insert)
+ (internal_self_insert):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ Fix a FIXME, by checking for integer overflow when calculating
+ target_clm and actual_clm.
+ * coding.c (detect_coding_XXX, encode_coding_XXX, CODING_DECODE_CHAR)
+ (CODING_ENCODE_CHAR, CODING_CHAR_CHARSET, CODING_CHAR_CHARSET_P)
+ (ASSURE_DESTINATION, coding_alloc_by_realloc)
+ (coding_alloc_by_making_gap, alloc_destination)
+ (detect_coding_utf_8, encode_coding_utf_8, decode_coding_utf_16)
+ (encode_coding_utf_16, detect_coding_emacs_mule)
+ (decode_coding_emacs_mule, encode_coding_emacs_mule)
+ (detect_coding_iso_2022, decode_coding_iso_2022)
+ (encode_invocation_designation, encode_designation_at_bol)
+ (encode_coding_iso_2022, detect_coding_sjis, detect_coding_big5)
+ (decode_coding_sjis, decode_coding_big5, encode_coding_sjis)
+ (encode_coding_big5, detect_coding_ccl, decode_coding_ccl)
+ (encode_coding_ccl, encode_coding_raw_text)
+ (detect_coding_charset, decode_coding_charset)
+ (encode_coding_charset, detect_eol, decode_eol, produce_chars)
+ (produce_composition, produce_charset, produce_annotation)
+ (decode_coding, handle_composition_annotation)
+ (handle_charset_annotation, consume_chars, decode_coding_gap)
+ (decode_coding_object, encode_coding_object, detect_coding_system)
+ (Ffind_coding_systems_region_internal, Fcheck_coding_systems_region)
+ (code_convert_region, code_convert_string)
+ (Fdefine_coding_system_internal)
+ (coding_set_source, coding_set_destination):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (setup_iso_safe_charsets, consume_chars, Funencodable_char_position)
+ (Fdefine_coding_system_internal):
+ Don't assume fixnums fit in int.
+ (decode_coding_gap, decode_coding_object, encode_coding_object)
+ (Fread_coding_system, Fdetect_coding_region)
+ (Funencodable_char_position, Fcheck_coding_systems_region)
+ (get_translation, handle_composition_annotation, consume_chars):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (consume_chars): Rewrite to not calculate an address outside buffer.
+ (Ffind_operation_coding_system): NATNUMP can eval its arg twice.
+ Don't access memory outside of the args array.
+ (Fdefine_coding_system_internal): Check for charset-id overflow.
+ (ENCODE_ISO_CHARACTER): Use unsigned, not int, to store the unsigned
+ result of ENCODE_CHAR.
+ * coding.h: Adjust decls to match defn changes elsewhere.
+ (struct coding_system):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * composite.c (get_composition_id, find_composition)
+ (run_composition_function, update_compositions)
+ (compose_text, composition_gstring_put_cache)
+ (composition_gstring_p, composition_gstring_width)
+ (fill_gstring_header, fill_gstring_body, autocmp_chars)
+ (composition_compute_stop_pos, composition_reseat_it)
+ (composition_update_it, struct position_record)
+ (find_automatic_composition, composition_adjust_point)
+ (Fcomposition_get_gstring, Ffind_composition_internal):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (update_compositions):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * composite.h: Adjust decls to match defn changes elsewhere.
+ (struct composition):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * data.c (let_shadows_buffer_binding_p, let_shadows_global_binding_p):
+ Do not attempt to compute the address of the object just before a
+ buffer; this is not portable.
+ (Faref, Faset):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Faset): Use int, not EMACS_INT, where int is wide enough.
+ (Fstring_to_number): Don't assume fixnums fit in int.
+ (Frem): Don't assume arg is nonnegative.
+ * dbusbind.c (xd_append_arg): Check for integers out of range.
+ (Fdbus_call_method): Don't overflow the timeout int.
+ (extract_signed, extract_unsigned): New functions.
+ (XD_CHECK_DBUS_SERIAL): Remove; superseded by extract_unsigned.
+ (xd_get_connection_references): Return ptrdiff_t, not int.
+ All uses changed.
+ (xd_signature, xd_append_arg, xd_retrieve_arg, Fdbus_message_internal)
+ (xd_read_message_1):
+ Use int, not unsigned, where the dbus API uses int.
+ (Fdbus_message_internal): Don't overflow mtype.
+ (syms_of_dbusbind): Allocate right-sized buffer for integers.
+ * dired.c (directory_files_internal, file_name_completion, scmp)
+ (file_name_completion_stat):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (file_name_completion): Don't overflow matchcount.
+ (file_name_completion_stat): Use SAFE_ALLOCA, not alloca.
+ * dispextern.h: Adjust decls to match defn changes elsewhere.
+ (struct text_pos, struct glyph, struct bidi_saved_info)
+ (struct bidi_string_data, struct bidi_it, struct composition_it)
+ (struct it):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (struct display_pos, struct composition_it, struct it):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * dispnew.c (increment_matrix_positions)
+ (increment_row_positions, mode_line_string)
+ (marginal_area_string):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (change_frame_size_1, Fredisplay, Fframe_or_buffer_changed_p):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (duration_to_sec_usec): New function, to check for overflow better.
+ (Fsleep_for, sit_for): Use it.
+ * doc.c (get_doc_string, store_function_docstring):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (get_doc_string, Fsnarf_documentation):
+ Use int, not EMACS_INT, where int is wide enough.
+ (get_doc_string):
+ Use SAFE_ALLOCA, not alloca.
+ Check for overflow when converting EMACS_INT to off_t.
+ * doprnt.c (doprnt):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * editfns.c (init_editfns, Fuser_uid, Fuser_real_uid):
+ Don't assume uid_t fits into fixnum.
+ (buildmark, Fgoto_char, overlays_around, find_field, Fdelete_field)
+ (Ffield_string, Ffield_string_no_properties, Ffield_beginning)
+ (Ffield_end, Fconstrain_to_field, Fline_beginning_position)
+ (Fline_end_position, Fprevious_char, Fchar_after, Fchar_before)
+ (general_insert_function)
+ (Finsert_char, make_buffer_string, make_buffer_string_both)
+ (update_buffer_properties, Fbuffer_substring)
+ (Fbuffer_substring_no_properties, Fcompare_buffer_substrings)
+ (Fsubst_char_in_region, check_translation)
+ (Ftranslate_region_internal, save_restriction_restore, Fformat)
+ (transpose_markers, Ftranspose_regions):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (clip_to_bounds): Move to lisp.h as an inline function).
+ (Fconstrain_to_field): Don't assume integers are nonnegative.
+ (Fline_beginning_position, Fsave_excursion, Fsave_current_buffer):
+ (Fsubst_char_in_region, Fsave_restriction):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Femacs_pid): Don't assume pid_t fits into fixnum.
+ (lo_time): Use int, not EMACS_INT, when int suffices.
+ (lisp_time_argument): Check for usec out of range.
+ (Fencode_time): Don't assume fixnum fits in int.
+ (Fuser_login_name, Fuser_full_name): Signal an error
+ if a uid argument is out of range, rather than relying on
+ undefined behavior.
+ (Fformat_time_string): Remove now-unnecessary check.
+ lisp_time_argument checks for out-of-range usec now.
+ Use ptrdiff_t, not size_t, where ptrdiff_t will do.
+ * emacs.c (gdb_valbits, gdb_gctypebits): Now int, not EMACS_INT.
+ (gdb_data_seg_bits): Now uintptr_t, not EMACS_INT.
+ (PVEC_FLAG, gdb_array_mark_flag): Now ptrdiff_t, not EMACS_INT.
+ (init_cmdargs, Fdump_emacs):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fkill_emacs): Don't assume fixnum fits in int; instead, take just
+ the bottom (typically) 32 bits of the fixnum.
+ * eval.c (specpdl_size, call_debugger):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (when_entered_debugger, Fbacktrace_debug):
+ Don't assume fixnum can fit in int.
+ (Fdefvaralias, Fdefvar): Do not attempt to compute the address of
+ the object just before a buffer; this is not portable.
+ (FletX, Flet, Funwind_protect, do_autoload, Feval, funcall_lambda)
+ (grow_specpdl, unbind_to):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fapply, apply_lambda): Don't assume ptrdiff_t can hold fixnum.
+ (grow_specpdl): Simplify allocation by using xpalloc.
+ (Fprog1, Fprog2): Don't assume list length fits in int. Simplify.
+ * fileio.c (Ffind_file_name_handler, Fcopy_file, Frename_file)
+ (Finsert_file_contents, Fwrite_region, Fdo_auto_save):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Ffind_file_name_handler, non_regular_inserted, Finsert_file_contents)
+ (a_write, e_write):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fcopy_file, non_regular_nbytes, read_non_regular)
+ (Finsert_file_contents):
+ Use int, not EMACS_INT, where int is wide enough.
+ (READ_BUF_SIZE): Verify that it fits in int.
+ (Finsert_file_contents): Check that counts are in proper range,
+ rather than assuming fixnums fit into ptrdiff_t etc.
+ Don't assume fixnums fit into int.
+ * floatfns.c (Fexpt): Avoid undefined signed * signed overflow.
+ * fns.c (Fcompare_strings, Fstring_lessp, struct textprop_rec, concat)
+ (string_char_byte_cache_charpos, string_char_byte_cache_bytepos)
+ (string_char_to_byte, string_byte_to_char)
+ (string_make_multibyte, string_to_multibyte)
+ (string_make_unibyte, Fstring_as_unibyte, Fstring_as_multibyte)
+ (Fstring_to_unibyte, Fsubstring, Fsubstring_no_properties)
+ (substring_both, Fdelete, internal_equal, Ffillarray)
+ (Fclear_string, mapcar1)
+ (Fbase64_encode_region, Fbase64_encode_string, base64_encode_1)
+ (Fbase64_decode_region, Fbase64_decode_string, base64_decode_1)
+ (larger_vector, make_hash_table, maybe_resize_hash_table)
+ (hash_lookup, hash_remove_from_table, hash_clear, sweep_weak_table)
+ (Fmaphash, secure_hash):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (concat): Check for string index and length overflow.
+ (Fmapconcat): Don't assume fixnums fit into ptrdiff_t.
+ (Frequire):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (larger_vector): New API (vec, incr_min, size_max) replaces old
+ one (vec, new_size, init). This catches size overflow.
+ INIT was removed because it was always Qnil.
+ All callers changed.
+ (INDEX_SIZE_BOUND): New macro, which calculates more precisely
+ the upper bound on a hash table index size.
+ (make_hash_table, maybe_resize_hash_table): Use it.
+ (secure_hash): Computer start_byte and end_byte only after
+ they're known to be in ptrdiff_t range.
+ * font.c (font_intern_prop, font_at, font_range, Ffont_shape_gstring)
+ (Ffont_get_glyphs, Ffont_at):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (font_style_to_value, font_prop_validate_style, font_expand_wildcards)
+ (Flist_fonts, Fopen_font):
+ Don't assume fixnum can fit in int.
+ (check_gstring): Don't assume index can fit in int.
+ (font_match_p): Check that fixnum is a character, not a nonnegative
+ fixnum, since the later code needs to stuff it into an int.
+ (font_find_for_lface): Use SAFE_ALLOCA_LISP, not alloca.
+ (font_fill_lglyph_metrics): Use unsigned, not EMACS_INT, to avoid
+ conversion overflow issues.
+ (Fopen_font): Check for integer out of range.
+ (Ffont_get_glyphs): Don't assume index can fit in int.
+ * font.h: Adjust decls to match defn changes elsewhere.
+ * fontset.c (reorder_font_vector): Redo score calculation to avoid
+ integer overflow.
+ (num_auto_fontsets, fontset_from_font): Use ptrdiff_t, not
+ printmax_t, where ptrdiff_t is wide enough.
+ (Finternal_char_font):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * frame.c (Fset_mouse_position, Fset_mouse_pixel_position)
+ (Fset_frame_height, Fset_frame_width, Fset_frame_size)
+ (Fset_frame_position, x_set_frame_parameters)
+ (x_set_line_spacing, x_set_border_width)
+ (x_set_internal_border_width, x_set_alpha, x_figure_window_size):
+ Check that fixnums are in proper range for system types.
+ (frame_name_fnn_p, Fframe_parameter, Fmodify_frame_parameters):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fmodify_frame_parameters): Don't assume fixnum fits in int.
+ Use SAFE_ALLOCA_LISP, not alloca.
+ * frame.h (struct frame): Use intptr_t, not EMACS_INT, where
+ intptr_t is wide enough.
+ * fringe.c (lookup_fringe_bitmap, get_logical_fringe_bitmap)
+ (Fdefine_fringe_bitmap): Don't assume fixnum fits in int.
+ (Ffringe_bitmaps_at_pos): Don't assume index fits in int.
+ Check for fixnum out of range.
+ * ftfont.c (ftfont_list): Don't assume index fits in int.
+ Check that fixnums are in proper range for system types.
+ (ftfont_shape_by_flt):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * gnutls.c (emacs_gnutls_write, emacs_gnutls_read):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fgnutls_error_fatalp, Fgnutls_error_string, Fgnutls_boot):
+ Check that fixnums are in proper range for system types.
+ * gnutls.h: Adjust decls to match defn changes elsewhere.
+ * gtkutil.c (xg_dialog_run):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (update_frame_tool_bar):
+ Check that fixnums are in proper range for system types.
+ * image.c (parse_image_spec): Redo count calculation to avoid overflow.
+ (lookup_image): Check that fixnums are in range for system types.
+ * indent.c (last_known_column, last_known_column_point):
+ (current_column_bol_cache):
+ (skip_invisible, current_column, check_display_width):
+ (check_display_width, scan_for_column, current_column_1)
+ (Findent_to, Fcurrent_indentation, position_indentation)
+ (indented_beyond_p, Fmove_to_column, compute_motion):
+ (Fcompute_motion, Fvertical_motion):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (last_known_column_modified): Use EMACS_INT, not int.
+ (check_display_width):
+ (Fcompute_motion):
+ Check that fixnums and floats are in proper range for system types.
+ (compute_motion): Don't assume index or fixnum fits in int.
+ (compute_motion, Fcompute_motion):
+ Use int, not EMACS_INT, when it is wide enough.
+ (vmotion): Omit local var start_hpos that is always 0; that way
+ we don't need to worry about overflow in expressions involving it.
+ * indent.h: Adjust decls to match defn changes elsewhere.
+ (struct position):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ Use int, not EMACS_INT, where int is wide enough.
+ Remove unused members ovstring_chars_done and tab_offset;
+ all uses removed.
+ * insdel.c (move_gap, move_gap_both, gap_left, gap_right)
+ (adjust_markers_for_delete, adjust_markers_for_insert, adjust_point)
+ (adjust_markers_for_replace, make_gap_larger, make_gap_smaller)
+ (make_gap, copy_text, insert, insert_and_inherit)
+ (insert_before_markers, insert_before_markers_and_inherit)
+ (insert_1, count_combining_before, count_combining_after)
+ (insert_1_both, insert_from_string)
+ (insert_from_string_before_markers, insert_from_string_1)
+ (insert_from_gap, insert_from_buffer, insert_from_buffer_1)
+ (adjust_after_replace, adjust_after_insert, replace_range)
+ (replace_range_2, del_range, del_range_1, del_range_byte)
+ (del_range_both, del_range_2, modify_region)
+ (prepare_to_modify_buffer, signal_before_change)
+ (signal_after_change, Fcombine_after_change_execute):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * intervals.c (traverse_intervals, rotate_right, rotate_left)
+ (balance_an_interval, split_interval_right, split_interval_left)
+ (find_interval, next_interval, update_interval)
+ (adjust_intervals_for_insertion, delete_node, delete_interval)
+ (interval_deletion_adjustment, adjust_intervals_for_deletion)
+ (static_offset_intervals, offset_intervals)
+ (merge_interval_right, merge_interval_left, make_new_interval)
+ (graft_intervals_into_buffer, temp_set_point_both)
+ (temp_set_point, set_point, adjust_for_invis_intang)
+ (set_point_both, move_if_not_intangible, get_property_and_range)
+ (get_local_map, copy_intervals, copy_intervals_to_string)
+ (compare_string_intervals, set_intervals_multibyte_1):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * intervals.h: Adjust decls to match defn changes elsewhere.
+ (struct interval):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * keyboard.c (this_command_key_count, this_single_command_key_start)
+ (before_command_key_count, before_command_echo_length, echo_now)
+ (echo_length, recursive_edit_1, Frecursive_edit, Ftrack_mouse)
+ (command_loop_1, safe_run_hooks, read_char, timer_check_2)
+ (menu_item_eval_property, read_key_sequence, Fread_key_sequence)
+ (Fread_key_sequence_vector, Fexecute_extended_command, Fsuspend_emacs):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (last_non_minibuf_size, last_point_position, echo_truncate)
+ (command_loop_1, adjust_point_for_property, read_char, gen_help_event)
+ (make_lispy_position, make_lispy_event, parse_modifiers_uncached)
+ (parse_modifiers, modify_event_symbol, Fexecute_extended_command)
+ (stuff_buffered_input):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (last_auto_save, command_loop_1, read_char):
+ Use EMACS_INT, not int, to avoid integer overflow.
+ (record_char): Avoid overflow in total_keys computation.
+ (parse_modifiers_uncached): Redo index calculation to avoid overflow.
+ * keyboard.h: Adjust decls to match defn changes elsewhere.
+ * keymap.c (Fdefine_key, Fcurrent_active_maps, accessible_keymaps_1)
+ (Fkey_description, Fdescribe_vector, Flookup_key):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (click_position): New function, to check that positions are in range.
+ (Fcurrent_active_maps):
+ (describe_command):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Faccessible_keymaps, Fkey_description):
+ (preferred_sequence_p):
+ Don't assume fixnum can fit into int.
+ (Fkey_description): Use SAFE_ALLOCA_LISP, not alloca.
+ Check for integer overflow in size calculations.
+ (Ftext_char_description): Use CHECK_CHARACTER, not CHECK_NUMBER, to
+ avoid mishandling large integers.
+ * lisp.h: Adjust decls to match defn changes elsewhere.
+ (ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, struct Lisp_String)
+ (struct vectorlike_header, struct Lisp_Subr, struct Lisp_Hash_Table)
+ (struct Lisp_Marker):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (clip_to_bounds): Now an inline function, moved here from editfns.c.
+ (GLYPH_CODE_P): Check for overflow in system types, subsuming the
+ need for GLYPH_CODE_CHAR_VALID_P and doing proper checking ourselves.
+ All callers changed.
+ (GLYPH_CODE_CHAR, GLYPH_CODE_FACE):
+ Assume the arg has valid form, since it always does.
+ (TYPE_RANGED_INTEGERP): Avoid bug when checking against a wide
+ unsigned integer system type.
+ (CHECK_RANGED_INTEGER, CHECK_TYPE_RANGED_INTEGER): New macros.
+ (struct catchtag, specpdl_size, SPECPDL_INDEX, USE_SAFE_ALLOCA):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (struct catchtag): Use EMACS_INT, not int, since it may be a fixnum.
+ (duration_to_sec_usec): New decl.
+ * lread.c (read_from_string_index, read_from_string_index_byte)
+ (read_from_string_limit, readchar, unreadchar, openp)
+ (read_internal_start, read1, oblookup):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fload, readevalloop, Feval_buffer, Feval_region):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (openp): Check for out-of-range argument to 'access'.
+ (read1): Use int, not EMACS_INT, where int is wide enough.
+ Don't assume fixnum fits into int.
+ Fix off-by-one error that can read outside a buffer.
+ (read_filtered_event): Use duration_to_sec_usec
+ to do proper overflow checking on durations.
+ * macros.c (Fstart_kbd_macro): Use xpalloc to check for overflow
+ in size calculation.
+ (Fexecute_kbd_macro):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * marker.c (cached_charpos, cached_bytepos, CONSIDER)
+ (byte_char_debug_check, buf_charpos_to_bytepos, verify_bytepos)
+ (buf_bytepos_to_charpos, Fset_marker, set_marker_restricted)
+ (set_marker_both, set_marker_restricted_both, marker_position)
+ (marker_byte_position, Fbuffer_has_markers_at):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fset_marker, set_marker_restricted): Don't assume fixnum fits in int.
+ * menu.c (ensure_menu_items): Rename from grow_menu_items.
+ It now merely ensures that the menu is large enough, without
+ necessarily growing it, as this avoids some integer overflow issues.
+ All callers changed.
+ (keymap_panes, parse_single_submenu, Fx_popup_menu):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (parse_single_submenu, Fx_popup_menu): Don't assume fixnum fits in int.
+ Use SAFE_ALLOCA_LISP, not alloca.
+ (find_and_return_menu_selection): Avoid unnecessary casts of pointers
+ to EMACS_INT. Check that fixnums are in proper range for system types.
+ * minibuf.c (minibuf_prompt_width, string_to_object)
+ (Fminibuffer_contents, Fminibuffer_contents_no_properties)
+ (Fminibuffer_completion_contents, Ftry_completion, Fall_completions):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (get_minibuffer, read_minibuf_unwind):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (read_minibuf): Omit unnecessary arg BACKUP_N, which is always nil;
+ this simplifies overflow checking. All callers changed.
+ (read_minibuf, Fread_buffer, Ftry_completion, Fall_completions)
+ (Ftest_completion):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * nsfns.m (check_ns_display_info): Don't assume fixnum fits in long.
+ (x_set_menu_bar_lines, x_set_tool_bar_lines, Fx_create_frame):
+ Check that fixnums are in proper range for system types.
+ (Fx_create_frame, Fx_show_tip):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * nsfont.m (ns_findfonts, nsfont_list_family):
+ Don't assume fixnum fits in long.
+ * nsmenu.m (ns_update_menubar, ns_menu_show, ns_popup_dialog):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (ns_update_menubar): Use intptr_t, not EMACS_INT, when intptr_t is
+ wide enough.
+ * nsselect.m (ns_get_local_selection, clean_local_selection_data):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * print.c (print_buffer_size, print_buffer_pos, print_buffer_pos_byte)
+ (PRINTDECLARE, PRINTPREPARE):
+ (strout, print_string):
+ (print, print_preprocess, print_check_string_charset_prop)
+ (print_object):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (PRINTDECLARE):
+ (temp_output_buffer_setup, Fprin1_to_string, print_object):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (PRINTPREPARE): Use int, not ptrdiff_t, where int is wide enough.
+ (printchar, strout): Use xpalloc to catch size calculation overflow.
+ (Fexternal_debugging_output): Don't overflow EMACS_INT->int conversion.
+ (print_error_message): Use SAFE_ALLOCA, not alloca.
+ (print_object): Use int, not EMACS_INT, where int is wide enough.
+ (print_depth, new_backquote_output, print_number_index):
+ Use ptrdiff_t, not int, where int might not be wide enough.
+ * process.c (Fdelete_process): Don't assume pid fits into EMACS_INT.
+ (Fset_process_window_size, Fformat_network_address)
+ (get_lisp_to_sockaddr_size, set_socket_option, Fmake_network_process)
+ (sigchld_handler):
+ Check that fixnums are in proper range for system types.
+ (Fsignal_process): Simplify by avoiding a goto.
+ Check for process-ids out of pid_t range rather than relying on
+ undefined behavior.
+ (process_tick, update_tick): Use EMACS_INT, not int.
+ (Fformat_network_address, read_process_output, send_process)
+ (Fprocess_send_region, status_notify):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fformat_network_address, Fmake_serial_process, Fmake_network_process)
+ (wait_reading_process_output, read_process_output, exec_sentinel):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (conv_lisp_to_sockaddr): Don't assume fixnums fit into int.
+ (Faccept_process_output): Use duration_to_sec_usec to do proper
+ overflow checking on durations.
+ (emacs_get_tty_pgrp, Fprocess_running_child_p, process_send_signal):
+ Don't assume pid_t fits in int.
+ * process.h (struct Lisp_Process): Members tick and update_tick
+ are now of type EMACS_INT, not int.
+ * puresize.h (PURESIZE_RATIO): Shrink this to 8/6 on 32-bit hosts
+ configured --with-wide-int.
+ * scroll.c (calculate_scrolling, calculate_direct_scrolling)
+ (line_ins_del): Use int, not EMACS_INT, where int is wide enough.
+ * search.c (looking_at_1, string_match_1):
+ (fast_string_match, fast_c_string_match_ignore_case)
+ (fast_string_match_ignore_case, fast_looking_at, scan_buffer)
+ (scan_newline, find_before_next_newline, search_command)
+ (trivial_regexp_p, search_buffer, simple_search, boyer_moore)
+ (set_search_regs, wordify):
+ (Freplace_match):
+ (Fmatch_data):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (string_match_1, search_buffer, set_search_regs):
+ (Fmatch_data):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (wordify): Check for overflow in size calculation.
+ (Freplace_match): Avoid potential buffer overflow in search_regs.start.
+ (Fset_match_data): Don't assume fixnum fits in ptrdiff_t.
+ Check that fixnums are in proper range for system types.
+ * sound.c (struct sound_device)
+ (wav_play, au_play, vox_write, alsa_period_size, alsa_write):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fplay_sound_internal):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * syntax.c (struct lisp_parse_state, find_start_modiff)
+ (Finternal_describe_syntax_value, scan_lists, scan_sexps_forward):
+ (Fparse_partial_sexp):
+ Don't assume fixnums can fit in int.
+ (struct lisp_parse_state, find_start_pos, find_start_value)
+ (find_start_value_byte, find_start_begv)
+ (update_syntax_table, char_quoted, dec_bytepos)
+ (find_defun_start, prev_char_comend_first, back_comment):
+ (scan_words, skip_chars, skip_syntaxes, forw_comment, Fforward_comment)
+ (scan_lists, Fbackward_prefix_chars, scan_sexps_forward):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Finternal_describe_syntax_value): Check that match_lisp is a
+ character, not an integer, since the code stuffs it into int.
+ (scan_words, scan_sexps_forward):
+ Check that fixnums are in proper range for system types.
+ (Fforward_word):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (scan_sexps_forward):
+ Use CHARACTERP, not INTEGERP, since the value must fit into int.
+ (Fparse_partial_sexp): Fix doc; element 8 is not ignored.
+ * syntax.h: Adjust decls to match defn changes elsewhere.
+ (struct gl_state_s):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (SETUP_SYNTAX_TABLE_FOR_OBJECT): Use PTRDIFF_MAX, not
+ MOST_POSITIVE_FIXNUM.
+ * sysdep.c (wait_for_termination_1, wait_for_termination)
+ (interruptible_wait_for_termination, mkdir):
+ Don't assume pid_t fits in int; on 64-bit AIX pid_t is 64-bit.
+ (emacs_read, emacs_write):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (system_process_attributes): Don't assume uid_t, gid_t, EMACS_INT,
+ and double all fit in int.
+ * term.c (set_tty_color_mode):
+ Check that fixnums are in proper range for system types.
+ * termhooks.h (struct input_event):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * textprop.c (validate_interval_range, interval_of)
+ (Fadd_text_properties, set_text_properties_1)
+ (Fremove_text_properties, Fremove_list_of_text_properties)
+ (Ftext_property_any, Ftext_property_not_all)
+ (copy_text_properties, text_property_list, extend_property_ranges)
+ (verify_interval_modification):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fnext_single_char_property_change)
+ (Fprevious_single_char_property_change):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (copy_text_properties):
+ Check for integer overflow in index calculation.
+ * undo.c (last_boundary_position, record_point, record_insert)
+ (record_delete, record_marker_adjustment, record_change)
+ (record_property_change):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (truncate_undo_list, Fprimitive_undo): Don't assume fixnum fits in int.
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * w32fns.c (Fx_create_frame, x_create_tip_frame, Fx_show_tip)
+ (Fx_hide_tip, Fx_file_dialog):
+ * w32menu.c (set_frame_menubar):
+ Use ptrdiff_t, not int, for consistency with rest of code.
+ * window.c (window_scroll_preserve_hpos, window_scroll_preserve_vpos)
+ (select_window, Fdelete_other_windows_internal)
+ (window_scroll_pixel_based, window_scroll_line_based)
+ (Frecenter, Fset_window_configuration):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (Fset_window_hscroll, run_window_configuration_change_hook)
+ (set_window_buffer, temp_output_buffer_show, scroll_command)
+ (Fscroll_other_window, Frecenter):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fwindow_line_height, window_scroll, Fscroll_left, Fscroll_right):
+ Don't assume fixnum fits in int.
+ (Fset_window_scroll_bars):
+ Check that fixnums are in proper range for system types.
+ * xdisp.c (help_echo_pos, pos_visible_p, string_pos_nchars_ahead)
+ (string_pos, c_string_pos, number_of_chars, init_iterator)
+ (in_ellipses_for_invisible_text_p, init_from_display_pos)
+ (compute_stop_pos, next_overlay_change, compute_display_string_pos)
+ (compute_display_string_end, handle_face_prop)
+ (face_before_or_after_it_pos, handle_invisible_prop)
+ (handle_display_prop, handle_display_spec, handle_single_display_spec)
+ (display_prop_intangible_p, string_buffer_position_lim)
+ (string_buffer_position, handle_composition_prop, load_overlay_strings)
+ (get_overlay_strings_1, get_overlay_strings)
+ (iterate_out_of_display_property, forward_to_next_line_start)
+ (back_to_previous_visible_line_start, reseat, reseat_to_string)
+ (get_next_display_element, set_iterator_to_next)
+ (get_visually_first_element, compute_stop_pos_backwards)
+ (handle_stop_backwards, next_element_from_buffer)
+ (move_it_in_display_line_to, move_it_in_display_line)
+ (move_it_to, move_it_vertically_backward, move_it_by_lines)
+ (add_to_log, message_dolog, message_log_check_duplicate)
+ (message2, message2_nolog, message3, message3_nolog
+ (with_echo_area_buffer, display_echo_area_1, resize_mini_window_1)
+ (current_message_1, truncate_echo_area, truncate_message_1)
+ (set_message, set_message_1, store_mode_line_noprop)
+ (hscroll_window_tree, debug_delta, debug_delta_bytes, debug_end_vpos)
+ (text_outside_line_unchanged_p, check_point_in_composition)
+ (reconsider_clip_changes)
+ (redisplay_internal, set_cursor_from_row, try_scrolling)
+ (try_cursor_movement, set_vertical_scroll_bar, redisplay_window)
+ (redisplay_window, find_last_unchanged_at_beg_row)
+ (find_first_unchanged_at_end_row, row_containing_pos, try_window_id)
+ (trailing_whitespace_p, find_row_edges, display_line)
+ (RECORD_MAX_MIN_POS, Fcurrent_bidi_paragraph_direction)
+ (display_mode_element, store_mode_line_string)
+ (pint2str, pint2hrstr, decode_mode_spec)
+ (display_count_lines, display_string, draw_glyphs)
+ (x_produce_glyphs, x_insert_glyphs)
+ (rows_from_pos_range, mouse_face_from_buffer_pos)
+ (fast_find_string_pos, mouse_face_from_string_pos)
+ (note_mode_line_or_margin_highlight, note_mouse_highlight):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (safe_call, init_from_display_pos, handle_fontified_prop)
+ (handle_single_display_spec, load_overlay_strings)
+ (with_echo_area_buffer, setup_echo_area_for_printing)
+ (display_echo_area, echo_area_display)
+ (x_consider_frame_title, prepare_menu_bars, update_menu_bar)
+ (update_tool_bar, hscroll_window_tree, redisplay_internal)
+ (redisplay_window, dump_glyph_row, display_mode_line)
+ (Fformat_mode_line, decode_mode_spec, on_hot_spot_p):
+ (handle_display_spec, display_prop_string_p):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (handle_single_display_spec, build_desired_tool_bar_string)
+ (redisplay_tool_bar, scroll_window_tree, Fdump_glyph_matrix)
+ (get_specified_cursor_type):
+ Check that fixnums are in proper range for system types.
+ (struct overlay_entry, resize_mini_window, Fdump_glyph_row)
+ (Flookup_image_map):
+ Don't assume fixnums fit in int.
+ (compare_overlay_entries):
+ Avoid mishandling comparisons due to subtraction overflow.
+ (load_overlay_strings): Use SAFE_NALLOCA, not alloca.
+ (last_escape_glyph_face_id, last_glyphless_glyph_face_id):
+ (handle_tool_bar_click):
+ Use int, not unsigned, since we prefer signed and the signedness
+ doesn't matter here.
+ (get_next_display_element, next_element_from_display_vector):
+ Use int, not EMACS_INT, when int is wide enough.
+ (start_hourglass): Use duration_to_sec_usec to do proper
+ overflow checking on durations.
+ * xfaces.c (Fbitmap_spec_p):
+ Check that fixnums are in proper range for system types.
+ (compare_fonts_by_sort_order):
+ Avoid mishandling comparisons due to subtraction overflow.
+ (Fx_family_fonts, realize_basic_faces):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fx_family_fonts):
+ Don't assume fixnum fits in int.
+ Use SAFE_ALLOCA_LISP, not alloca.
+ (merge_face_heights): Remove unnecessary cast to EMACS_INT.
+ (Finternal_make_lisp_face): Don't allocate more than MAX_FACE_ID.
+ (face_at_buffer_position, face_for_overlay_string)
+ (face_at_string_position):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ (merge_faces): Use int, not EMACS_INT, where int is wide enough.
+ * xfns.c (x_set_menu_bar_lines, x_set_tool_bar_lines, x_icon_verify)
+ (Fx_show_tip):
+ Check that fixnums are in proper range for system types.
+ (Fx_create_frame, x_create_tip_frame, Fx_show_tip)
+ (Fx_hide_tip, Fx_file_dialog, Fx_select_font):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (Fx_change_window_property): Don't assume fixnums fit in int.
+ * xfont.c (xfont_chars_supported):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * xmenu.c (Fx_popup_dialog, set_frame_menubar)
+ (create_and_show_popup_menu, create_and_show_dialog, xmenu_show):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * xml.c (parse_region):
+ * xrdb.c (magic_file_p):
+ Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
+ * xselect.c (TRACE1): Don't assume pid_t promotes to int.
+ (x_get_local_selection, x_reply_selection_request)
+ (x_handle_selection_request, wait_for_property_change):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ (selection_data_to_lisp_data): Use short, not EMACS_INT, where
+ short is wide enough.
+ (x_send_client_event): Don't assume fixnum fits in int.
+ * xterm.c (x_x_to_emacs_modifiers):
+ Don't assume EMACS_INT overflows nicely into int.
+ (x_emacs_to_x_modifiers): Use EMACS_INT, not int, because values
+ may come from Lisp.
+ (handle_one_xevent): NATNUMP can eval its arg twice.
+ (x_connection_closed):
+ Use ptrdiff_t, not int, to avoid needless 32-bit limit on 64-bit hosts.
+ * xterm.h: Adjust decls to match defn changes elsewhere.
+ (struct scroll_bar): Use struct vectorlike_header
+ rather than rolling our own approximation.
+ (SCROLL_BAR_VEC_SIZE): Remove; not used.
+
+2012-05-25 Glenn Morris <rgm@gnu.org>
+
+ * lisp.mk (lisp): Update for more files being compiled now.
+
+2012-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lread.c: Remove `read_pure' which makes no difference.
+ (read_pure): Remove var.
+ (unreadpure): Remove function.
+ (readevalloop): Don't call read_list with -1 flag.
+ (read1, read_vector): Don't test read_pure any more.
+ (read_list): Simplify.
+
+ * fileio.c, character.h: Minor style tweaks.
+
+2012-05-24 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * window.h (clip_changed): Remove useless declaration.
+
+2012-05-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in: Follow-up to 2012-05-22T16:20:27Z!eggert@cs.ucla.edu.
+ (TAGS, TAGS-gmake, CONFIG_H): Remove further references to m/intel386.h.
+
+2012-05-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove src/m/*.
+ This directory predates autoconf and is no longer needed nowadays.
+ Move its few remaining bits of functionality to where they're needed.
+ * m/README, m/alpha.h, m/amdx86-64.h, m/ia64.h, m/ibmrs6000.h:
+ * m/ibms390x.h, m/intel386.h, m/m68k.h, m/macppc.h, m/sparc.h:
+ * m/template.h: Remove.
+ * Makefile.in (M_FILE): Remove. All uses removed.
+ * alloc.c (POINTERS_MIGHT_HIDE_IN_OBJECTS):
+ * lisp.h (USE_LSB_TAG):
+ * mem-limits.h (EXCEEDS_LISP_PTR):
+ Use VAL_MAX, not VALBITS, in #if.
+ * lisp.h (EMACS_INT_MAX): New macro, useful in #if.
+ (EMACS_UINT): Define unconditionally now.
+ (BITS_PER_CHAR, BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG)
+ (BITS_PER_EMACS_INT): New constants, replacing
+ what used to be in config.h, but not useful in #if.
+ (GCTYPEBITS, VALBITS): Define unconditionally, since m/* files don't
+ define them any more.
+ (VAL_MAX): New macro.
+ (VALMASK): Use it.
+ * puresize.h (PURESIZE_RATIO): Use EMACS_INT_MAX, not
+ BITS_PER_EMACS_INT, in #if.
+ * s/aix4-2.h (BROKEN_FIONREAD, BROKEN_SIGAIO, BROKEN_SIGPTY)
+ (BROKEN_SIGPOLL): Move here from m/ibmrs6000.h, which was removed.
+ * s/gnu-linux.h (ULIMIT_BREAK_VALUE) [__i386__]:
+ * s/ms-w32.h (DATA_START):
+ Move here from removed file m/intel386.h.
+ * s/gnu.h (NLIST_STRUCT): Remove undef; 'configure' does this.
+ * s/irix6-5.h (_LP64): Remove; lisp.h no longer needs this.
+
+2012-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Assume C89 or later.
+ * alloc.c, buffer.c, lisp.h: Replace POINTER_TYPE with void.
+ * alloc.c (overrun_check_malloc, overrun_check_realloc, xmalloc)
+ (xrealloc):
+ * buffer.c (mmap_free_1, mmap_enlarge): Omit needless casts.
+ * editfns.c, fns.c, gmalloc.c, insdel.c, sysdep.c, termcap.c (NULL):
+ * textprop.c, tparam.c (NULL): Remove.
+ * ralloc.c, vm-limit.c (POINTER): Assume void * works.
+ * regex.c (SIGN_EXTEND_CHAR): Assume signed char works.
+ * regex.h (_RE_ARGS): Remove. All uses rewritten to use prototypes.
+ * unexelf.c (ElfBitsW): Assume c89 preprocessor or better.
+ * xterm.c (input_signal_count): Assume volatile works.
+
+2012-05-21 Ken Brown <kbrown@cornell.edu>
+
+ * xgselect.c (xg_select): Fix first argument in call to 'select'
+ (bug#11508).
+
+2012-05-20 Ken Brown <kbrown@cornell.edu>
+
+ * gmalloc.c (_free_internal_nolock, _realloc_internal_nolock)
+ [CYGWIN]: Cast ptr to (char *) before comparing to _heapbase.
+
+2012-05-19 Ken Brown <kbrown@cornell.edu>
+
+ * xfns.c (x_in_use): Remove `static' qualifier.
+ * xterm.h (x_in_use): Declare.
+ * xgselect.c: Include xterm.h.
+ (xg_select): Test `x_in_use' instead of `inhibit_window_system'
+ and `display_arg' (bug#9754).
+
+2012-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * s/ms-w32.h (HAVE_GETDOMAINNAME): Remove; not needed.
- * xdisp.c (pos_visible_p): Fix last change. (Bug#11464)
+ * m/vax.h: Remove; no longer needed since HAVE_FTIME is being removed.
+ * s/ms-w32.h (HAVE_FTIME): Remove; not needed.
-2012-05-13 Eli Zaretskii <eliz@gnu.org>
+2012-05-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation with -DGLYPH_DEBUG=1 on MS-Windows.
+
+ * w32term.c [GLYPH_DEBUG]: Add prototype for x_check_font.
+ (x_check_font) [GLYPH_DEBUG]: New function, copied from xterm.c.
+
+ * w32fns.c (unwind_create_frame) [GLYPH_DEBUG]: Fix broken
+ reference to image_cache->refcount.
+ (x_create_tip_frame): Fix broken use of FRAME_IMAGE_CACHE.
+
+2012-05-17 Juri Linkov <juri@jurta.org>
+
+ * search.c (Fword_search_regexp, Fword_search_backward)
+ (Fword_search_forward, Fword_search_backward_lax)
+ (Fword_search_forward_lax): Move functions to isearch.el
+ (bug#10145, bug#11381).
+
+2012-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xgselect.c (xg_select): Just invoke 'select' if -nw (Bug#9754).
+
+2012-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lread.c (init_obarray): Declare Qt and Qnil as special.
+
+2012-05-14 Glenn Morris <rgm@gnu.org>
+
+ * nsterm.m (ns_init_paths): Fix typo ("libexec" not "lib-exec").
+ Put "libexec" before "bin", for the sake of init_callproc_1.
+
+2012-05-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.c (kbd_buffer_get_event) [!HAVE_DBUS]: Omit unused local.
+
+ * unexaix.c: Port to more-recent AIX compilers.
+ (report_error, report_error_1, make_hdr, copy_sym)
+ (mark_x, adjust_lnnoptrs, unrelocate_symbols):
+ Make arguments const char *, not char *, to avoid violations of C
+ standard and to fix some AIX warnings reported by Gilles Pion.
+
+2012-05-14 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (handle_stop): Don't call get_overlay_strings_1 if we
already have overlays loaded.
stopped at the last line of window, which happens to be scanned
backwards by the bidi iteration. (Bug#11464)
-2012-05-11 Eli Zaretskii <eliz@gnu.org>
+2012-05-14 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (handle_single_display_spec): Return 1 for left-margin
and right-margin display specs even if the spec is invalid or we
- are on a TTY, and thus unable to display on the fringes. That's
- because the text with the property will not be displayed anyway,
+ are on a TTY, and thus unable to display on the fringes.
+ That's because the text with the property will not be displayed anyway,
so we need to signal to the caller that this is a "replacing"
display spec. This fixes display when the spec is invalid or we
are on a TTY.
-2012-05-09 Paul Eggert <eggert@cs.ucla.edu>
+2012-05-14 Paul Eggert <eggert@cs.ucla.edu>
* unexaix.c (make_hdr): Fix typo in prototype.
This bug broke the build on AIX. Problem reported by Gilles Pion.
-2012-05-05 Eli Zaretskii <eliz@gnu.org>
+2012-05-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * keyboard.c (kbd_buffer_get_event): Read special events also in
+ batch mode. (Bug#11415)
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * ns.mk: Update for ns_appbindir no longer having trailing "/".
+
+2012-05-12 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp.mk (lisp): Add newcomment.elc.
+
+2012-05-12 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (MKDIR_P): New, set by configure.
+ * ns.mk (${ns_appdir}, ${ns_appbindir}Emacs): Use $MKDIR_P.
+
+2012-05-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove unused function hourglass_started.
+ * dispextern.h (hourglass_started):
+ * w32fns.c (hourglass_started):
+ * xdisp.c (hourglass_started): Remove.
+
+2012-05-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * makefile.w32-in ($(BLD)/gmalloc.$(O), $(BLD)/w32menu.$(O)):
+ Update dependencies.
+
+2012-05-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xgselect.c (xg_select): Put maxfds+1 into a var.
+ This is slightly clearer, and pacifies Ubuntu 12.04 gcc.
+
+ * sound.c (DEFAULT_ALSA_SOUND_DEVICE): Define only if HAVE_ALSA.
+
+2012-05-10 Dave Abrahams <dave@boostpro.com>
+
+ * filelock.c (syms_of_filelock): New boolean create-lockfiles.
+ (lock_file): If create_lockfiles is 0, do nothing. (Bug#11227)
+
+2012-05-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (xd_registered_buses): New internal Lisp object.
+ Rename all occurences of Vdbus_registered_buses to xd_registered_buses.
+ (syms_of_dbusbind): Remove declaration of Vdbus_registered_buses.
+ Initialize xd_registered_buses.
+
+2012-05-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Untag more efficiently if USE_LSB_TAG.
+ This is based on a proposal by YAMAMOTO Mitsuharu in
+ <http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01876.html>.
+ For an admittedly artificial (nth 8000 longlist) benchmark on
+ Fedora 15 x86-64, this yields a 25% CPU speedup. Also, it shrinks
+ Emacs's overall text size by 1%.
+ * lisp.h (XUNTAG): New macro.
+ (XCONS, XVECTOR, XSTRING, XSYMBOL, XFLOAT, XMISC, XPROCESS, XWINDOW)
+ (XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE, XSUB_CHAR_TABLE, XBOOL_VECTOR)
+ (XSETTYPED_PSEUDOVECTOR, XHASH_TABLE, TYPED_PSEUDOVECTORP): Use it.
+ * eval.c (Fautoload):
+ * font.h (XFONT_SPEC, XFONT_ENTITY, XFONT_OBJECT):
+ * frame.h (XFRAME): Use XUNTAG.
+
+ Port recent dbusbind.c changes to 32-bit --with-wide-int.
+ * dbusbind.c (xd_append_arg, xd_retrieve_arg, Fdbus_message_internal):
+ Remove unportable assumptions about print widths of types like
+ dbus_uint32_t.
+ (xd_get_connection_address, Fdbus_init_bus): Cast Emacs integer to
+ intptr_t when converting between pointer and integer, to avoid GCC
+ warnings about wrong width.
+
+2012-05-09 Eli Zaretskii <eliz@gnu.org>
* w32proc.c (new_child): Force Windows to reserve only 64KB of
stack for each reader_thread, instead of defaulting to 8MB
subprocesses on Windows 7, see the discussion in this thread:
http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00119.html.
-2012-05-02 Jim Meyering <meyering@redhat.com>
+2012-05-07 Jérémy Compostella <jeremy.compostella@gmail.com>
+
+ Fix up display of the *Minibuf-0* buffer in the mini window.
+ * keyboard.c (read_char): Don't clear the echo area if there's no
+ message to clear.
+ * xdisp.c (redisplay_internal): Redisplay the mini window (with the
+ contents of *Minibuf-0*) if there's no message displayed in its stead.
+
+2012-05-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (XD_DEBUG_MESSAGE): Don't print message twice in
+ batch mode.
+
+2012-05-06 Chong Yidong <cyd@gnu.org>
+
+ * lisp.mk (lisp): Update.
+
+2012-05-05 Jim Meyering <meyering@redhat.com>
* w32font.c (fill_in_logfont): NUL-terminate a string (Bug#11372).
-2012-04-29 Eli Zaretskii <eliz@gnu.org>
+2012-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * data.c (PUT_ERROR): New macro.
+ (syms_of_data): Use it. Add new error type `user-error'.
+ * undo.c (user_error): New function.
+ (Fprimitive_undo): Use it.
+ * print.c (print_error_message): Adjust print style for `user-error'.
+ * keyboard.c (user_error): New function.
+ (Fexit_recursive_edit, Fabort_recursive_edit): Use it.
+
+2012-05-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not limit current-time-string to years 1000..9999.
+ * editfns.c (TM_YEAR_IN_ASCTIME_RANGE): Remove.
+ (Fcurrent_time_string): Support any year that is supported by the
+ underlying localtime representation. Don't use asctime, as it
+ has undefined behavior for years outside the range -999..9999.
+
+2012-05-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix race conditions involving setenv, gmtime, localtime, asctime.
+ Without this fix, interrupts could mess up code that uses these
+ nonreentrant functions, since setting TZ invalidates existing
+ tm_zone or tzname values, and since most of these functions return
+ pointers to static storage.
+ * editfns.c (format_time_string, Fdecode_time, Fencode_time)
+ (Fcurrent_time_string, Fcurrent_time_zone, Fset_time_zone_rule):
+ Grow the critical sections to include not just invoking
+ localtime/gmtime, but also accessing these functions' results
+ including their tm_zone values if any, and any related TZ setting.
+ (format_time_string): Last arg is now struct tm *, not struct tm **,
+ so that the struct tm is saved in the critical section.
+ All callers changed. Simplify allocation of initial buffer, partly
+ motivated by the fact that memory allocation needs to be outside
+ the critical section.
+
+2012-05-02 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * intervals.c (adjust_intervals_for_insertion): Initialize `newi'
+ with RESET_INTERVAL.
+
+ * buffer.c (Fget_buffer_create, Fmake_indirect_buffer):
+ Remove duplicated buffer name initialization.
+
+2012-05-02 Jim Meyering <jim@meyering.net>
+
+ * xterm.c (x_term_init): Use memcpy instead of strncpy (Bug#11373).
+
+ * xfns.c (x_window): Use xstrdup (Bug#11375).
+
+2012-05-02 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (pos_visible_p): If already at a newline from the
display string before the 'while' loop, don't walk back the glyphs
from it3.glyph_row. Solves assertion violation when the display
string begins with a newline (egg.el). (Bug#11367)
-2012-04-24 Chong Yidong <cyd@gnu.org>
+2012-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keyboard.c (Fexecute_extended_command, Vsuggest_key_bindings):
+ Move to simple.el.
+
+2012-05-01 Glenn Morris <rgm@gnu.org>
+
+ * syssignal.h: Remove reference to BROKEN_SIGINFO (last used in
+ s/ptx4.h), BROKEN_SIGTSTP (last used in m/ustation.h, m/dpx2.h),
+ and BROKEN_SIGURG (was in s/gnu-linux.h prior to 2008-02-10).
+ All were removed before 23.1.
+
+ * dispnew.c: Remove HAVE_LIBNCURSES test;
+ it is always true on relevant platforms.
+
+ * Makefile.in (LD_SWITCH_X_SITE_RPATH):
+ Rename from LD_SWITCH_X_SITE_AUX_RPATH.
+
+ * Makefile.in (LD_SWITCH_X_SITE_AUX): Remove; no longer used.
+
+2012-04-30 Andreas Schwab <schwab@linux-m68k.org>
+
+ * .gdbinit (xpr): Remove checks for no longer existing misc types.
+ (xintfwd, xboolfwd, xobjfwd, xbufobjfwd, xkbobjfwd, xbuflocal):
+ Remove.
+
+2012-04-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not avoid creating empty evaporating overlays (Bug#9642).
+ * buffer.c (Fmove_overlay): Revert the change of 2012-04-23.
+ That is, do not delete an evaporating overlay if it becomes
+ empty after its bounds are adjusted to fit within its buffer.
+ This fix caused other problems, and I'm reverting it until we get
+ to the bottom of them.
+
+2012-04-27 Chong Yidong <cyd@gnu.org>
* xselect.c (x_convert_selection): Initialize a pointer (Bug#11315).
-2012-04-23 Eli Zaretskii <eliz@gnu.org>
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (pos_visible_p): If the window start position is beyond
ZV, start the display from buffer beginning. Prevents assertion
* window.c (window_scroll_pixel_based): Likewise.
-2012-04-23 Chong Yidong <cyd@gnu.org>
+2012-04-27 Chong Yidong <cyd@gnu.org>
* keymap.c (where_is_internal): Doc fix (Bug#10872).
-2012-04-20 Glenn Morris <rgm@gnu.org>
+2012-04-27 Glenn Morris <rgm@gnu.org>
* fileio.c (Fcopy_file, Fset_file_selinux_context):
Ignore ENOTSUP failures from setfilecon functions. (Bug#11245)
-2012-04-20 Eli Zaretskii <eliz@gnu.org>
+2012-04-27 Eli Zaretskii <eliz@gnu.org>
- * dispnew.c (swap_glyph_pointers, copy_row_except_pointers): Don't
- overrun array limits of glyph row's used[] array. (Bug#11288)
+ * dispnew.c (swap_glyph_pointers, copy_row_except_pointers):
+ Don't overrun array limits of glyph row's used[] array. (Bug#11288)
+
+2012-04-26 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (IT_DISPLAYING_WHITESPACE): In addition to the loaded
+ display element, check also the underlying string or buffer
+ character. (Bug#11341)
+
+ * w32menu.c: Include w32heap.h.
+ (add_menu_item): If the call to AppendMenuW (via
+ unicode_append_menu) fails, disable Unicode menus only if we are
+ running on Windows 9X/Me.
+
+2012-04-24 Andreas Schwab <schwab@linux-m68k.org>
+
+ * .gdbinit (xpr): Handle USE_2_TAGS_FOR_INTS.
+ (xgetint): Add missing shift for LSB tags.
+
+2012-04-24 Martin Rudalics <rudalics@gmx.at>
+
+ * keyboard.c (read_char): Don't wipe echo area for select window
+ events: These might get delayed via `mouse-autoselect-window'
+ (Bug#11304).
+
+2012-04-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnutls.c (init_gnutls_functions): Protect against (unlikely)
+ manipulation of :loaded-from data.
+
+2012-04-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnutls.c (init_gnutls_functions): The value of :loaded-from is
+ now a cons (bug#11311).
+
+2012-04-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not create empty overlays with the evaporate property (Bug#9642).
+ * buffer.c (Fmove_overlay): Delete an evaporating overlay
+ if it becomes empty after its bounds are adjusted to fit within
+ its buffer. Without this fix, in a nonempty buffer (let ((o
+ (make-overlay 1 2))) (overlay-put o 'evaporate t) (move-overlay o 0 1))
+ yields an empty overlay that has the evaporate property, which is
+ not supposed to happen.
+
+ Fix minor GTK3 problems found by static checking.
+ * emacsgtkfixed.c (EMACS_TYPE_FIXED, EMACS_FIXED, EmacsFixed)
+ (EmacsFixedPrivate, EmacsFixedClass, struct _EmacsFixed)
+ (struct _EmacsFixedClass, emacs_fixed_get_type):
+ Move decls here from emacsgtkfixed.h, since they needn't be public.
+ (emacs_fixed_get_type): Now static.
+ (emacs_fixed_class_init): Omit unused local.
+ (emacs_fixed_child_type): Remove; unused.
+ * emacsgtkfixed.h (EMACS_TYPE_FIXED, EMACS_FIXED, EmacsFixed)
+ (EmacsFixedPrivate, EmacsFixedClass, struct _EmacsFixed)
+ (struct _EmacsFixedClass): Move to emacsgtkfixed.c.
+ (EMACS_FIXED_CLASS, EMACS_IS_FIXED, EMACS_IS_FIXED_CLASS)
+ (EMACS_FIXED_GET_CLASS): Remove; unused.
+ * gtkutil.c (xg_create_frame_widgets) [!HAVE_GTK3]: Omit unused local.
+
+ * keyboard.c (handle_async_input): Define only if SYNC_INPUT || SIGIO.
+ Problem reported by Juanma Barranquero for Windows -Wunused-function.
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Modernize and clean up gmalloc.c to assume C89 (Bug#9119).
+ * gmalloc.c (_MALLOC_INTERNAL, _MALLOC_H, _PP, __ptr_t)
+ (__malloc_size_t, __malloc_ptrdiff_t):
+ Remove. All uses removed, replaced by the definiens if needed,
+ since we can assume C89 or better now.
+ Include <stdint.h>, for PTRDIFF_MAX, uintptr_t.
+ (protect_malloc_state, align, get_contiguous_space)
+ (malloc_atfork_handler_prepare, malloc_atfork_handler_parent)
+ (malloc_atfork_handler_child, malloc_enable_thread)
+ (malloc_initialize_1, __malloc_initialize, morecore_nolock)
+ (_malloc_internal_nolock, _malloc_internal, malloc, _malloc)
+ (_free, _realloc, _free_internal_nolock, _free_internal, free, cfree)
+ (special_realloc, _realloc_internal_nolock, _realloc_internal)
+ (realloc, calloc, __default_morecore, memalign, valloc, checkhdr)
+ (freehook, mallochook, reallochook, mabort, mcheck, mprobe):
+ Define using prototypes, not old style.
+ (align, _malloc_internal_nolock, _free_internal_nolock, memalign):
+ Don't assume ptrdiff_t and uintptr_t are no wider than unsigned long.
+ (align): Don't assume that signed integer overflow wraps around.
+ Omit unused local var.
+ (malloc_initialize_1, morecore_nolock, _malloc_internal_nolock)
+ (_free_internal_nolock, memalign, mallochook, reallochook):
+ Omit no-longer-needed casts.
+ (valloc): Use getpagesize, not __getpagesize.
+ (MAGICWORD, MAGICFREE): Now randomish size_t values, not 32-bit.
+ (struct hdr): The 'magic' member is now size_t, not unsigned long.
+
+ * dbusbind.c (XD_DBUS_VALIDATE_OBJECT): Define only if needed.
+
+2012-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Move functions from C to Lisp. Make non-blocking method calls
+ the default. Implement further D-Bus standard interfaces.
+
+ * dbusbind.c (DBUS_NUM_MESSAGE_TYPES): Declare.
+ (QCdbus_request_name_allow_replacement)
+ (QCdbus_request_name_replace_existing)
+ (QCdbus_request_name_do_not_queue)
+ (QCdbus_request_name_reply_primary_owner)
+ (QCdbus_request_name_reply_in_queue)
+ (QCdbus_request_name_reply_exists)
+ (QCdbus_request_name_reply_already_owner): Move to dbus.el.
+ (QCdbus_registered_serial, QCdbus_registered_method)
+ (QCdbus_registered_signal): New Lisp objects.
+ (XD_DEBUG_MESSAGE): Use sizeof.
+ (XD_MESSAGE_TYPE_TO_STRING, XD_OBJECT_TO_STRING)
+ (XD_DBUS_VALIDATE_BUS_ADDRESS, XD_DBUS_VALIDATE_OBJECT)
+ (XD_DBUS_VALIDATE_BUS_NAME, XD_DBUS_VALIDATE_PATH)
+ (XD_DBUS_VALIDATE_INTERFACE, XD_DBUS_VALIDATE_MEMBER): New macros.
+ (XD_CHECK_DBUS_SERIAL): Rename from CHECK_DBUS_SERIAL_GET_SERIAL.
+ (xd_signature, xd_append_arg): Allow float for integer types.
+ (xd_get_connection_references): New function.
+ (xd_get_connection_address): Rename from xd_initialize.
+ Return cached address.
+ (xd_remove_watch): Do not unset $DBUS_SESSION_BUS_ADDRESS.
+ (xd_close_bus): Rename from Fdbus_close_bus. Not needed on Lisp
+ level.
+ (Fdbus_init_bus): New optional arg PRIVATE. Cache address.
+ Return number of refcounts.
+ (Fdbus_get_unique_name): Make stronger parameter check.
+ (Fdbus_message_internal): New defun.
+ (Fdbus_call_method, Fdbus_call_method_asynchronously)
+ (Fdbus_method_return_internal, Fdbus_method_error_internal)
+ (Fdbus_send_signal, Fdbus_register_service)
+ (Fdbus_register_signal, Fdbus_register_method): Move to dbus.el.
+ (xd_read_message_1): Obey new structure of Vdbus_registered_objects.
+ (xd_read_queued_messages): Obey new structure of Vdbus_registered_buses.
+ (Vdbus_compiled_version, Vdbus_runtime_version)
+ (Vdbus_message_type_invalid, Vdbus_message_type_method_call)
+ (Vdbus_message_type_method_return, Vdbus_message_type_error)
+ (Vdbus_message_type_signal): New defvars.
+ (Vdbus_registered_buses, Vdbus_registered_objects_table):
+ Adapt docstring.
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix GC_MALLOC_CHECK debugging output on 64-bit hosts.
+ * alloc.c (emacs_blocked_malloc) [GC_MALLOC_CHECK]:
+ Do not assume ptrdiff_t is the same width as 'int'.
+
+ * alloc.c: Handle unusual debugging option combinations.
+ (GC_CHECK_MARKED_OBJECTS): Undef if ! GC_MARK_STACK,
+ since the two debugging options are incompatible.
+ (GC_MALLOC_CHECK): Similarly, undef if GC_CHECK_MARKED_OBJECTS
+ is defined.
+ (mem_init, mem_insert, mem_insert_fixup):
+ Define if GC_MARK_STACK || GC_MALLOC_CHECK.
+ (NEED_MEM_INSERT): Remove; no longer needed.
+
+2012-04-22 Leo Liu <sdl.web@gmail.com>
+
+ * sysdep.c (list_system_processes): Support Darwin (Bug#5725).
+
+2012-04-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ * sysdep.c [__FreeBSD__]: Minor cleanups.
+ (list_system_processes, system_process_attributes) [__FreeBSD__]:
+ Use Emacs indenting style more consistently. Avoid some casts.
+ Use 'double' consistently rather than mixing 'float' and 'double'.
+
+2012-04-21 Eduard Wiebe <usenet@pusto.de>
+
+ * sysdep.c (list_system_processes, system_process_attributes):
+ Add implementation for FreeBSD (Bug#5243).
+
+2012-04-21 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp.mk (lisp): Update.
+
+2012-04-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * keyboard.c (process_pending_signals): Define only if SYNC_INPUT.
+ It is never used otherwise.
+
+2012-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * print.c (print_preprocess): Only check print_depth if print-circle
+ is nil.
+ (print_object): Check for cycles even when print-circle is nil and
+ print-gensym is t, but only check print_depth if print-circle is nil.
2012-04-20 Chong Yidong <cyd@gnu.org>
* process.c (wait_reading_process_output): If EIO occurs on a pty,
set the status to "failed" and ensure that sentinel is run.
-2012-04-18 Glenn Morris <rgm@gnu.org>
+2012-04-20 Glenn Morris <rgm@gnu.org>
* process.c (Fset_process_inherit_coding_system_flag)
(Fset_process_query_on_exit_flag): Doc fix (mention return value).
(Fmake_network_process, Fmake_serial_process): Doc fix.
-2012-04-17 Eli Zaretskii <eliz@gnu.org>
+2012-04-20 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (string_buffer_position_lim): Limit starting position to
BEGV.
(set_cursor_from_row): If called for a mode-line or header-line
row, return zero immediately.
(try_cursor_movement): If inside continuation line, don't back up
- farther than the first row after the header line, if any. Don't
- consider the header-line row as "partially visible", even if
+ farther than the first row after the header line, if any.
+ Don't consider the header-line row as "partially visible", even if
MATRIX_ROW_PARTIALLY_VISIBLE_P returns non-zero. (Bug#11261)
-2012-04-13 Atsuo Ohki <ohki@gssm.otsuka.tsukuba.ac.jp> (tiny change)
+2012-04-20 Atsuo Ohki <ohki@gssm.otsuka.tsukuba.ac.jp> (tiny change)
+
+ * lread.c (lisp_file_lexically_bound_p): Fix hang at ";-*-\n"
+ (bug#11238).
+
+2012-04-20 Teodor Zlatanov <tzz@lifelogs.com>
+2012-04-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ configure: new option --enable-gcc-warnings (Bug#11207)
+ * Makefile.in (C_WARNINGS_SWITCH): Remove.
+ (WARN_CFLAGS, WERROR_CFLAGS): New macros.
+ (ALL_CFLAGS): Use new macros rather than old.
+ * process.c: Ignore -Wstrict-overflow to work around GCC bug 52904.
+ * regex.c: Ignore -Wstrict-overflow. If !emacs, also ignore
+ -Wunused-but-set-variable, -Wunused-function, -Wunused-macros,
+ -Wunused-result, -Wunused-variable. This should go away once
+ the Emacs and Gnulib regex code is merged.
+ (xmalloc, xrealloc): Now static.
+
+2012-04-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dired.c (Fsystem_groups): Remove unused local.
+
+2012-04-17 Glenn Morris <rgm@gnu.org>
+
+ * dired.c (Fsystem_users): Doc fix.
+
+2012-04-17 Dmitry Antipov <dmantipov@yandex.ru>
- * lread.c (lisp_file_lexically_bound_p): Fix hang at ";-*-\n" (bug#11238).
+ * dired.c (Fsystem_users, Fsystem_groups): New functions. (Bug#7900)
+ (syms_of_dired): Add them.
-2012-04-10 Teodor Zlatanov <tzz@lifelogs.com>
+2012-04-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor alloc.c problems found by static checking.
+ * alloc.c (_malloc_internal, _free_internal) [!DOUG_LEA_MALLOC]:
+ New extern decls, to avoid calling undeclared functions.
+ (dont_register_blocks): Define if ((!SYSTEM_MALLOC && !SYNC_INPUT)
+ && GC_MALLOC_CHECK), not if ((GC_MARK_STACK || defined
+ GC_MALLOC_CHECK) && GC_MALLOC_CHECK), to match when it's used.
+ (NEED_MEM_INSERT): New macro.
+ (mem_insert, mem_insert_fixup) [!NEED_MEM_INSERT]: Remove; unused.
+ Remove one incorrect comment and fix another.
+
+ Fix minor ralloc.c problems found by static checking.
+ See http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html
+ * ralloc.c (ALIGNED, ROUND_TO_PAGE, HEAP_PTR_SIZE)
+ (r_alloc_size_in_use, r_alloc_freeze, r_alloc_thaw): Remove; unused.
+ (r_alloc_sbrk): Now static.
+
+ Improve ralloc.c interface checking.
+ See http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html
+ * buffer.c (ralloc_reset_variable, r_alloc, r_re_alloc)
+ (r_alloc_free) [REL_ALLOC]: Move decls from here ...
+ * lisp.h (r_alloc, r_alloc_free, r_re_alloc, r_alloc_reset_variable)
+ [REL_ALLOC]: ... to here, to check interface.
+ * m/ia64.h (r_alloc, r_alloc_free) [REL_ALLOC && !_MALLOC_INTERNAL]:
+ Remove decls. This fixes an "It stinks!".
+
+ * alloc.c (which_symbols): Fix alignment issue / type clash.
+
+2012-04-15 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp.h (struct Lisp_Symbol): Remove explicit padding.
+ (struct Lisp_Misc_Any): Likewise.
+ (struct Lisp_Free): Likewise.
+ * alloc.c (union aligned_Lisp_Symbol): Define.
+ (SYMBOL_BLOCK_SIZE, struct symbol_block): Use union
+ aligned_Lisp_Symbol instead of struct Lisp_Symbol.
+ (union aligned_Lisp_Misc): Define.
+ (MARKER_BLOCK_SIZE, struct marker_block): Use union
+ aligned_Lisp_Misc instead of union Lisp_Misc.
+ (Fmake_symbol, allocate_misc, gc_sweep): Adjust.
+
+2012-04-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make GC_MAKE_GCPROS_NOOPS the default (Bug#9926).
+ * lisp.h (GC_MARK_STACK): Default to GC_MAKE_GCPROS_NOOPS.
+ * s/cygwin.h, s/darwin.h, s/freebsd.h, s/gnu.h, s/irix6-5.h, s/msdos.h:
+ * s/netbsd.h, s/sol2-6.h:
+ Remove definition of GC_MARK_STACK, since the default now works.
+ * s/aix4-2.h, s/hpux10-20.h, s/unixware.h:
+ Define GC_MARK_STACK to GC_USE_GCPROS_AS_BEFORE, since that's
+ no longer the default.
+ * s/gnu-linux.h (GC_MARK_STACK): Adjust to change in default.
+
+2012-04-14 Atsuo Ohki <ohki@gssm.otsuka.tsukuba.ac.jp> (tiny change)
+
+ * lread.c (lisp_file_lexically_bound_p):
+ Fix hang at ";-*-\n" (bug#11238).
+
+2012-04-14 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (find_last_unchanged_at_beg_row): Don't consider a row
+ "unchanged" if its end.pos is beyond ZV. (Bug#11199)
+
+2012-04-14 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsterm.m (constrainFrameRect): Always constrain when there is only
+ one screen (Bug#10962).
+
+2012-04-13 Ken Brown <kbrown@cornell.edu>
+
+ * s/cygwin.h (PTY_OPEN): Don't try to close a bogus file descriptor.
+
+2012-04-13 Reuben Thomas <rrt@sc3d.org>
+
+ * indent.c (Fmove_to_column): Change interactive spec (Bug#739).
+
+2012-04-11 Daniel Colascione <dancol@dancol.org>
+
+ * s/cygwin.h: The vfork the #define in cygwin.h was protecting
+ against is gone. It's better to use vfork now so that when Cygwin
+ gains a new, working vfork, we use it automatically (bug#10398).
+
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.c (save_window_save): Obey window-point-insertion-type.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (GNUSTEP_CFLAGS): Rename from C_SWITCH_X_SYSTEM.
+
+2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (lisp_align_malloc): Remove unneeded prototype.
+
+2012-04-10 Jason S. Cornez <jcornez@ravenpack.com> (tiny change)
+
+ * keyboard.c: Override inhibit-quit after the third C-g (bug#6585).
+ (force_quit_count): New var.
+ (handle_interrupt): Use it.
+
+2012-04-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32.c (w32_delayed_load): Record the full path of the library
+ being loaded (bug#10424).
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * doc.c (Fsnarf_documentation): Check variables, functions are bound,
+ not just in the obarray, before snarfing them. (Bug#11036)
+
+ * Makefile.in ($(leimdir)/leim-list.el):
+ Pass EMACS rather than BUILT_EMACS.
+
+2012-04-09 Teodor Zlatanov <tzz@lifelogs.com>
* process.c (make_process):
* process.h: Add integer `gnutls_handshakes_tried' member to
`GNUTLS_EMACS_HANDSHAKES_LIMIT' to limit the number of handshake
attempts per process (connection).
+2012-04-09 Chong Yidong <cyd@gnu.org>
+
+ * eval.c (Fuser_variable_p, user_variable_p_eh)
+ (lisp_indirect_variable): Functions deleted.
+ (Fdefvar): Caller changed.
+
+ * callint.c (Finteractive, Fcall_interactively):
+ * minibuf.c (Fread_variable): Callers changed.
+
2012-04-09 Eli Zaretskii <eliz@gnu.org>
- * xdisp.c (find_last_unchanged_at_beg_row): Don't consider a row
- "unchanged" if its end.pos is beyond ZV. (Bug#11199)
+ * xdisp.c (set_cursor_from_row): If the display string appears in
+ the buffer at position that is closer to point than the position
+ after the display string, display the cursor on the first glyph of
+ the display string. Fixes cursor display when a 'display' text
+ property immediately follows invisible text. (Bug#11094)
-2012-04-09 Jan Djärv <jan.h.d@swipnet.se>
+2012-04-09 Paul Eggert <eggert@cs.ucla.edu>
- * nsterm.m (constrainFrameRect): Always constrain when there is only
- one screen (Bug#10962).
+ composite.c: use 'double' consistently
+ * composite.c (get_composition_id): Use 'double' consistently
+ instead of converting 'float' to 'double' and vice versa; this is
+ easier to understand and avoids a GCC warning.
+
+2012-04-09 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Generate leim-list with bootstrap-emacs, in
+ preparation for dumping it with emacs. (Bug#4789)
+ (leimdir): New variable.
+ ($(leimdir)/leim-list.el): New rule.
+ (emacs$(EXEEXT)): Depend on leim-list.el.
+
+ * buffer.c (Qucs_set_table_for_input): Remove. (Bug#9821)
+ (Fget_buffer_create): Don't call Qucs_set_table_for_input.
+ (init_buffer_once, syms_of_buffer): Remove Qucs_set_table_for_input.
+
+2012-04-08 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp.h (struct Lisp_Symbol): Add explicit padding to ensure
+ proper alignment.
+
+2012-04-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * xml.c (init_libxml2_functions) [WINDOWSNT]:
+ Remove unused local variable.
+
+2012-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid unnecessary pointer scanning in garbage collection (Bug#10780).
+ * alloc.c (POINTERS_MIGHT_HIDE_IN_OBJECTS): New macro.
+ (mark_memory): Mark Lisp_Objects only if pointers might hide in
+ objects, as mark_maybe_pointer will catch them otherwise.
+ (GC_LISP_OBJECT_ALIGNMENT): Remove; no longer needed.
+ * s/gnu-linux.h (GC_LISP_OBJECT_ALIGNMENT) [__mc68000__]: Likewise.
+
+2012-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix typo that broke non-Windows builds.
+ * xml.c (libxml2_loaded_p) [!!WINDOWSNT]: 'inine' -> 'inline'.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ Support building on MS-Windows with libxml2.
+
+ * makefile.w32-in (OBJ2): Add xml.$(O).
+ (GLOBAL_SOURCES): Add xml.c.
+ ($(BLD)/xml.$(O)): New dependency list.
+
+ * xml.c (DEF_XML2_FN, LOAD_XML2_FN) [WINDOWSNT]: New macros.
+ (fn_htmlReadMemory, fn_xmlReadMemory, fn_xmlDocGetRootElement)
+ (fn_xmlFreeDoc, fn_xmlCleanupParser, fn_xmlCheckVersion)
+ [!WINDOWSNT]: New macros.
+ (init_libxml2_functions, libxml2_loaded_p): New functions.
+ (parse_region): Call fn_xmlCheckVersion instead of using the macro
+ LIBXML_TEST_VERSION. Call libxml2 functions via the fn_* macros.
+ (xml_cleanup_parser): New function, export for fn_xmlCleanupParser.
+ Calls xmlCleanupParser only if libxml2 was loaded (or statically
+ linked in).
+ (Flibxml_parse_html_region, Flibxml_parse_xml_region):
+ Call init_libxml2_functions before calling libxml2 functions.
+ (syms_of_xml) <Qlibxml2_dll>: DEFSYM it.
+
+ * emacs.c: Don't include libxml/parser.h.
+ (shut_down_emacs): Call xml_cleanup_parser, instead of calling
+ xmlCleanupParser directly.
+
+ * lisp.h [HAVE_LIBXML2]: Add prototype for xml_cleanup_parser.
+
+2012-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * indent.c (Fvertical_motion): If there is a display string at
+ point, use it.vpos to compute how many lines to backtrack after
+ move_it_to point. (Bug#11133)
2012-04-06 Eli Zaretskii <eliz@gnu.org>
* xfns.c (unwind_create_frame): Fix comment.
(Fx_create_frame, x_create_tip_frame):
Move terminal->reference_count++ just before making the frame
- official. Move initialization of image_cache_refcount and
+ official. Move initialization of image_cache_refcount and
dpyinfo_refcount before calling init_frame_faces (Bug#9943).
2011-11-05 Eli Zaretskii <eliz@gnu.org>
(EmacsToolbar): Implements NSToolbarDelegate on OSX >= 10.6.
* nsselect.m (ns_string_from_pasteboard): Don't use deprecated methods
- cString and lossyCString on OSX >= 10.4
+ cString and lossyCString on OSX >= 10.4.
* nsmenu.m (fillWithWidgetValue): Don't use deprecated method
sizeToFit on OSX >= 10.2.
* Makefile.in (SETTINGS_LIBS): Fix typo.
-2011-07-01 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny patch)
+2011-07-01 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change)
* coding.c (Fencode_coding_string): Record the last coding system
used, as the function doc string says (bug#8738).
* xfaces.c <Qunspecified>: Make extern again.
* syntax.c: Include sys/types.h before including regex.h, as
- required by Posix.
+ required by POSIX.
* doc.c (get_doc_string): Improve the format passed to `error'.
;; coding: utf-8
;; End:
- Copyright (C) 2011-2012 Free Software Foundation, Inc.
+ Copyright (C) 2011-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
* w32term.c (w32_draw_fringe_bitmap): Copy unadapted code from
xterm.c to handle overlaid fringe bitmaps and to use cursor color
for displaying cursor in fringe.
- (w32_define_fringe_bitmap, w32_destroy_fringe_bitmap): New W32
+ (w32_define_fringe_bitmap, w32_destroy_fringe_bitmap): New Windows
specific functions to define and destroy fringe bitmaps in fringe_bmp.
(w32_redisplay_interface): Add them to redisplay_interface.
(w32_term_init): Call w32_init_fringe instead of explicitly
"Emacs built on Windows 9x/ME crashes at startup on Windows XP,
or Emacs builtpart of on XP crashes at startup on Windows 9x/ME."
- * w32.c: Added wrapper functions around the win32 API functions
+ * w32.c: Added wrapper functions around the Windows API functions
OpenProcessToken, GetTokenInformation, LookupAccountSid, and
GetSidIdentifierAuthority. These wrapper functions serve two
purposes:
the version of advapi32.dll that is found in the 9x branch of
Microsoft Windows.
- * w32.c (init_user_info): Replace the calls to the win32 API
+ * w32.c (init_user_info): Replace the calls to the Windows API
functions OpenProcessToken, GetTokenInformation, LookupAccountSid,
and GetSidIdentifierAuthority with calls to the newly added
wrapper functions.
* macterm.c (do_ae_open_documents) [MAC_OSX]: Call FSpMakeFSRef
and FSRefMakePath to convert FSSpec returned with Apple Event to
- Posix pathname.
+ POSIX pathname.
(mac_initialize) [TARGET_API_MAC_CARBON]:
Call init_required_apple_events and disable the `Quit' menu item
provided automatically by the Carbon Toolbox.
2010-09-24 Juanma Barranquero <lekktu@gmail.com>
- Remove W32 API function pointer unused since 2005-02-15 (revno 2005-02-15T23:19:26Z!jasonr@gnu.org).
+ Remove Windows API function pointer unused since 2005-02-15 (revno
+ 2005-02-15T23:19:26Z!jasonr@gnu.org).
* w32fns.c (clipboard_sequence_fn): Don't declare.
(globals_of_w32fns): Don't initialize it.
(update_frame_tool_bar): Remove old_req, new_req. Do not get tool bar
height, call xg_update_tool_bar_sizes instead.
(free_frame_tool_bar): Remove from hbox or vbox depending on
- toolbar_in_hbox, Set all FRAME_TOOLBAR_*_(WIDTH|HEIGHT) to zero.
+ toolbar_in_hbox. Set all FRAME_TOOLBAR_*_(WIDTH|HEIGHT) to zero.
(xg_change_toolbar_position): New function.
* frame.h (struct frame): Add tool_bar_position.
2010-03-12 Eli Zaretskii <eliz@gnu.org>
- These changes remove termcap.c from the build on Posix platforms.
+ These changes remove termcap.c from the build on POSIX platforms.
* Makefile.in (termcapobj): Move termcap.o from here...
(MSDOS_OBJ): ...to here.
(termcapobj) [!LIBS_TERMCAP]: Remove specialized value, as it is
1986-12-11 Richard Mlynarik (mly@prep)
- * emacs.c, dispnew.c:
+ * emacs.c, dispnew.c:
Rename inhibit_x_windows inhibit_window_system.
Understand "-nw" command-line option.
Reorganize init_display a little to make other window-system
(classify_object): Removed code to look up a function key in the
global and local function key keymaps, since this will be done
more generally.
- (Fexecute_mouse_event): Elided this function with a #if 0; I
+ (Fexecute_mouse_event): Elided this function with a #if 0; I
think it will go away once the more general keymap stuff is
implemented, but I'm not sure.
(syms_of_keyboard): Removed defsubr for Sexecute_mouse_event.
"light", "extralight", and "thin" fonts.
(x_to_win32_charset, win32_to_x_charset): New functions.
(win32_to_x_font): Use new height units. Use win32_to_x_charset.
- (x_to_win32_font): Use x_to_win32_charset. Support Win32 font names
+ (x_to_win32_font): Use x_to_win32_charset. Support w32 font names
in addition to X font names.
(win32_load_font, Fx_list_fonts, Fx_display_color_cells)
1995-12-12 Paul Eggert <eggert@twinsun.com>
- * process.c (create_process): Use Posix signal handling to
+ * process.c (create_process): Use POSIX signal handling to
block signals, if available. If HAVE_VFORK, save and restore
signal handlers that the child might change, since in many
systems (e.g. Solaris 2.4) if the child changes the signal
* xdisp.c [HAVE_NTGUI] (set_menu_framebar): Declare external.
[HAVE_NTGUI] (frame_title_buf, frame_title_ptr): Include variables
- for Win32 window system.
+ for w32 window system.
[HAVE_NTGUI] (store_frame_title, x_consider_frame_title): Include
- procedures for Win32 window system.
- [HAVE_NTGUI] (x_consider_frame_title): Test for Win32 frame.
- [HAVE_NTGUI] (display_text_line): Test for Win32 frame on face change.
+ procedures for w32 window system.
+ [HAVE_NTGUI] (x_consider_frame_title): Test for w32 frame.
+ [HAVE_NTGUI] (display_text_line): Test for w32 frame on face change.
[HAVE_NTGUI] (display_menu_bar): Perform no-op for NT window system.
* window.c [HAVE_NTGUI] (Fset_window_configuration): Set menu
(make_lispy_event): Use FUNCTION_KEY_OFFSET to modify event codes
before applying modifiers.
- * frame.c [HAVE_NTGUI]: Test for a Win32 frame in procedures
+ * frame.c [HAVE_NTGUI]: Test for a w32 frame in procedures
that test for an X frame.
* frame.h (output_method): New method: output_win32.
* emacs.c [HAVE_NTGUI]: Declare Vwindow_system.
[HAVE_NTGUI] (main): Enable inhibit_window_system.
Initialize environment from registry.
- Declare syms of Win32 windowing modules.
+ Declare syms of w32 windowing modules.
* dispnew.c [HAVE_NTGUI]: Include w32term.h.
Include dispextern.h before cm.h since dispextern.h includes windows.h.
[HAVE_NTGUI] (make_frame_glyphs, free_frame_glyphs, scroll_frame_lines)
- (update_frame, update_line): Test for WIN32 frame.
- [HAVE_NTGUI] (init_display): Initialize WIN32 window system.
+ (update_frame, update_line): Test for w32 frame.
+ [HAVE_NTGUI] (init_display): Initialize w32 window system.
* dispextern.h [HAVE_NTGUI]: Include win32.h.
[HAVE_NTGUI] (struct frame_glyphs): Include pixel fields.
(sys_select): Ignore children dead children with pending input.
Delay sending SIGCHLD until all output has been read.
(sys_kill): Sleep to allow focus change events to propagate.
- Use TerminateProcess on Win95.
+ Use TerminateProcess on Windows 95.
(int_from_hex, enum_locale_fn, Fw32_get_valid_locale_ids):
New functions.
(Vw32_valid_locale_ids): New variable.
Loop over handles round robin to ensure fairness.
(sys_kill): Send ctrl-break and ctrl-c keystrokes to subprocesses
on SIGINT if not sharing consoles, otherwise generate ctrl-break event.
- On other termination signals, send WM_QUIT message to Win95 apps
+ On other termination signals, send WM_QUIT message to Windows 95 apps
and WM_CLOSE to NT apps.
(syms_of_ntproc): Intern new symbols. defsubr new functions.
DEFVAR new variables.
- * w32term.c (SIF_*): Win95 macros defined for NT.
- (struct tagSCROLLINFO): Win95 struct defined for NT.
+ * w32term.c (SIF_*): Windows 95 macros defined for NT.
+ (struct tagSCROLLINFO): Windows 95 struct defined for NT.
(vertical_scroll_bar_min_handle, vertical_scroll_bar_top_border)
(vertical_scroll_bar_bottom_border, last_scroll_bar_drag_pos)
(Vw32_gab_focus_on_raise, Vw32_capslock_is_shiftlock):
* w32.c (stat): GetFileInformationByHandle can legitimately fail,
so don't rely on it succeeding.
- * w32fns.c (x_to_w32_font): Specify DEFAULT_CHARSET in the w32
+ * w32fns.c (x_to_w32_font): Specify DEFAULT_CHARSET in the Windows
LOGFONT struct if x font doesn't specify the charset.
(x_to_w32_charset): Change >= to == when testing results of
stricmp.
# Substitute an assignment for the MAKE variable, because
# BSD doesn't have it as a default.
@SET_MAKE@
+MKDIR_P = @MKDIR_P@
# Don't use LIBS. configure puts stuff in it that either shouldn't be
# linked with Emacs or is duplicated by the other stuff below.
# LIBS = @LIBS@
lib = ../lib
libsrc = ../lib-src
etc = ../etc
+leimdir = ../leim
oldXMenudir = ../oldXMenu
lwlibdir = ../lwlib
lispdir = ../lisp
# Configuration files for .o files to depend on.
-M_FILE = @M_FILE@
-S_FILE = @S_FILE@
-config_h = config.h $(M_FILE) $(S_FILE)
+config_h = config.h $(srcdir)/conf_post.h
bootstrap_exe = $(abs_builddir)/bootstrap-emacs$(EXEEXT)
PROFILING_CFLAGS = @PROFILING_CFLAGS@
## Flags to pass to the compiler to enable build warnings
-C_WARNINGS_SWITCH = @C_WARNINGS_SWITCH@
+WARN_CFLAGS = @WARN_CFLAGS@
+WERROR_CFLAGS = @WERROR_CFLAGS@
## Machine-specific CFLAGS.
C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
## System-specific CFLAGS.
C_SWITCH_SYSTEM=@C_SWITCH_SYSTEM@
-## Currently only set if NS_IMPL_GNUSTEP.
-## C_SWITCH_X_SITE may override this.
-C_SWITCH_X_SYSTEM=@C_SWITCH_X_SYSTEM@
+GNUSTEP_CFLAGS=@GNUSTEP_CFLAGS@
## Define C_SWITCH_X_SITE to contain any special flags your compiler
## may need to deal with X Windows. For instance, if you've defined
## HAVE_X_WINDOWS and your X include files aren't in a place that your
## compiler can find on its own, you might want to add "-I/..." or
## something similar. This is normally set by configure.
-## This is used before C_SWITCH_X_SYSTEM and may override it.
C_SWITCH_X_SITE=@C_SWITCH_X_SITE@
## Define LD_SWITCH_X_SITE to contain any special flags your loader
## substituted in this or any other Makefile. Cf C_SWITCH_X_SITE.
LD_SWITCH_X_SITE=
-## Next two must come before LD_SWITCH_SYSTEM.
-## If needed, a -R option that says where to find X windows at run time.
-LD_SWITCH_X_SITE_AUX=@LD_SWITCH_X_SITE_AUX@
-## As above, but using -rpath instead.
-LD_SWITCH_X_SITE_AUX_RPATH=@LD_SWITCH_X_SITE_AUX_RPATH@
+## This must come before LD_SWITCH_SYSTEM.
+## If needed, a -rpath option that says where to find X windows at run time.
+LD_SWITCH_X_SITE_RPATH=@LD_SWITCH_X_SITE_RPATH@
## System-specific LDFLAGS.
LD_SWITCH_SYSTEM=@LD_SWITCH_SYSTEM@
## $LDFLAGS or empty if NS_IMPL_GNUSTEP (for some reason).
TEMACS_LDFLAGS2 = @TEMACS_LDFLAGS2@
+## If available, the full path to the paxctl program.
+## On grsecurity/PaX systems, unexec will fail due to a gap between
+## the bss section and the heap. This can be prevented by disabling
+## memory randomization in temacs with "paxctl -r". See bug#11398.
+PAXCTL = @PAXCTL@
+
## Some systems define this to request special libraries.
LIBS_SYSTEM=@LIBS_SYSTEM@
M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@
M17N_FLT_LIBS = @M17N_FLT_LIBS@
+LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@
+LIB_TIMER_TIME=@LIB_TIMER_TIME@
+
DBUS_CFLAGS = @DBUS_CFLAGS@
DBUS_LIBS = @DBUS_LIBS@
## dbusbind.o if HAVE_DBUS, else empty.
DBUS_OBJ = @DBUS_OBJ@
+LIB_EXECINFO=@LIB_EXECINFO@
+
SETTINGS_CFLAGS = @SETTINGS_CFLAGS@
SETTINGS_LIBS = @SETTINGS_LIBS@
## xmenu.o if HAVE_X_WINDOWS, else empty.
XMENU_OBJ=@XMENU_OBJ@
-## xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o fringe.o image.o
-## xsettings.o xgselect.o if HAVE_X_WINDOWS, else empty.
+## xterm.o xfns.o xselect.o xrdb.o xsmfns.o xsettings.o xgselect.o if
+## HAVE_X_WINDOWS, else empty.
XOBJ=@XOBJ@
TOOLKIT_LIBW=@TOOLKIT_LIBW@
## sheap.o if CYGWIN, otherwise empty.
CYGWIN_OBJ=@CYGWIN_OBJ@
+## fontset.o fringe.o image.o if we have any window system
+WINDOW_SYSTEM_OBJ=@WINDOW_SYSTEM_OBJ@
+
## dosfns.o msdos.o w16select.o if MSDOS.
MSDOS_OBJ =
## w16select.o termcap.o if MSDOS && HAVE_X_WINDOWS.
MSDOS_X_OBJ =
-ns_appdir=@ns_appdir@
-ns_appbindir=@ns_appbindir@
-ns_appsrc=@ns_appsrc@
-## fontset.o fringe.o image.o if HAVE_NS, else empty.
NS_OBJ=@NS_OBJ@
## nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o if HAVE_NS.
NS_OBJC_OBJ=@NS_OBJC_OBJ@
DEPDIR=deps
## -MMD -MF $(DEPDIR)/$*.d if AUTO_DEPEND; else empty.
DEPFLAGS=@DEPFLAGS@
-## test -d $(DEPDIR) || mkdir $(DEPDIR) (if AUTO_DEPEND); else ':'.
+## ${MKDIR_P} ${DEPDIR} (if AUTO_DEPEND); else ':'.
MKDEPDIR=@MKDEPDIR@
## DO NOT use -R. There is a special hack described in lastfile.c
## -Demacs is needed to make some files produce the correct version
## for use in Emacs.
##
-## -DHAVE_CONFIG_H is needed for some other files to take advantage of
-## the information in `config.h'.
-##
-## C_SWITCH_X_SITE must come before C_SWITCH_X_SYSTEM
-## since it may have -I options that should override those.
-##
## FIXME? MYCPPFLAGS only referenced in etc/DEBUG.
-ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I$(srcdir) \
+ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
-I$(lib) -I$(srcdir)/../lib \
$(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
- $(C_SWITCH_X_SYSTEM) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
+ $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
$(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) $(PROFILING_CFLAGS) \
$(LIBGNUTLS_CFLAGS) \
- $(C_WARNINGS_SWITCH) $(CFLAGS)
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS)
ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS)
.SUFFIXES: .m
process.o gnutls.o callproc.o \
region-cache.o sound.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o \
- $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ)
+ profiler.o \
+ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
+ $(WINDOW_SYSTEM_OBJ)
obj = $(base_obj) $(NS_OBJC_OBJ)
## Object files used on some machine or other.
## duplicated symbols. If the standard libraries were compiled
## with GCC, we might need LIB_GCC again after them.
LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \
- $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(DBUS_LIBS) \
+ $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_CLOCK_GETTIME) $(LIB_TIMER_TIME) \
+ $(DBUS_LIBS) $(LIB_EXECINFO) \
$(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC)
all: emacs$(EXEEXT) $(OTHER_FILES)
+.PHONY: all
+
+$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT)
+ cd $(leimdir) && $(MAKE) $(MFLAGS) leim-list.el EMACS=$(bootstrap_exe)
-## Does anyone ever pay attention to the load-path-shadows output here?
## The dumped Emacs is as functional and more efficient than
## bootstrap-emacs, so we replace the latter with the former.
## Strictly speaking, emacs does not depend directly on all of $lisp,
## since not all pieces are used on all platforms. But DOC depends
## on all of $lisp, and emacs depends on DOC, so it is ok to use $lisp here.
-emacs$(EXEEXT): temacs$(EXEEXT) $(etc)/DOC $(lisp)
+emacs$(EXEEXT): temacs$(EXEEXT) $(etc)/DOC $(lisp) $(leimdir)/leim-list.el
if test "$(CANNOT_DUMP)" = "yes"; then \
- ln -f temacs$(EXEEXT) emacs$(EXEEXT); \
- EMACSLOADPATH=$(lispsource) ./emacs -batch \
- -f list-load-path-shadows || true; \
+ rm -f emacs$(EXEEXT); \
+ ln temacs$(EXEEXT) emacs$(EXEEXT); \
else \
LC_ALL=C $(RUN_TEMACS) -batch -l loadup dump || exit 1; \
- ln -f emacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
- ./emacs -batch -f list-load-path-shadows || true; \
+ test "X$(PAXCTL)" = X || $(PAXCTL) -zex emacs$(EXEEXT); \
+ rm -f bootstrap-emacs$(EXEEXT); \
+ ln emacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
fi
## We run make-docfile twice because the command line may get too long
gl-stamp: $(libsrc)/make-docfile$(EXEEXT) $(GLOBAL_SOURCES)
@rm -f gl-tmp
- $(libsrc)/make-docfile -d $(srcdir) -g $(SOME_MACHINE_OBJECTS) $(obj) > gl-tmp
+ $(libsrc)/make-docfile -d $(srcdir) -g $(obj) > gl-tmp
$(srcdir)/../build-aux/move-if-change gl-tmp globals.h
echo timestamp > $@
temacs$(EXEEXT): $(START_FILES) stamp-oldxmenu $(obj) $(otherobj) $(lib)/libgnu.a
$(CC) $(LD_FIRSTFLAG) $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(TEMACS_LDFLAGS2) \
-o temacs $(START_FILES) $(obj) $(otherobj) $(lib)/libgnu.a $(LIBES)
+ test "$(CANNOT_DUMP)" = "yes" || \
+ test "X$(PAXCTL)" = X || $(PAXCTL) -r temacs$(EXEEXT)
## The following oldxmenu-related rules are only (possibly) used if
## HAVE_X11 && !USE_GTK, but there is no harm in always defining them
doc.o: buildobj.h
-## If HAVE_NS, some ns-specific rules (for OTHER_FILES) are inserted here.
-@ns_frag@
+ns-app: emacs$(EXEEXT)
+ cd ../nextstep && $(MAKE) $(MFLAGS) all
+
+.PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean
+.PHONY: versionclean extraclean frc
mostlyclean:
rm -f temacs$(EXEEXT) core *.core \#* *.o libXMenu11.a liblw.a
clean: mostlyclean
rm -f emacs-*.*.*$(EXEEXT) emacs$(EXEEXT)
-rm -rf $(DEPDIR)
- test "X$(ns_appdir)" = "X" || rm -rf $(ns_appdir)
## bootstrap-clean is used to clean up just before a bootstrap.
## It should remove all files generated during a compilation/bootstrap,
ctagsfiles1 = [xyzXYZ]*.[hcm]
ctagsfiles2 = [a-wA-W]*.[hcm]
-TAGS: $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(M_FILE) $(S_FILE)
+TAGS: $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(S_FILE)
../lib-src/etags --include=TAGS-LISP --include=$(lwlibdir)/TAGS \
--regex='/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/' \
- $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(M_FILE) $(S_FILE)
+ $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(S_FILE)
frc:
TAGS-LISP: frc
$(MAKE) -f $(lispdir)/Makefile TAGS-LISP ETAGS=../lib-src/etags
bootstrap-emacs$(EXEEXT): temacs$(EXEEXT)
cd ../lisp; $(MAKE) $(MFLAGS) update-subdirs
if test "$(CANNOT_DUMP)" = "yes"; then \
- ln -f temacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
+ rm -f bootstrap-emacs$(EXEEXT); \
+ ln temacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
else \
$(RUN_TEMACS) --batch --load loadup bootstrap || exit 1; \
+ test "X$(PAXCTL)" = X || $(PAXCTL) -zex emacs$(EXEEXT); \
mv -f emacs$(EXEEXT) bootstrap-emacs$(EXEEXT); \
fi
@: Compile some files earlier to speed up further compilation.
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+
+#define LISP_INLINE EXTERN_INLINE
+
#include <stdio.h>
#include <limits.h> /* For CHAR_BIT. */
-#include <setjmp.h>
-#include <signal.h>
+#ifdef ENABLE_CHECKING
+#include <signal.h> /* For SIGABRT. */
+#endif
#ifdef HAVE_PTHREAD
#include <pthread.h>
#endif
-/* This file is part of the core Lisp implementation, and thus must
- deal with the real data structures. If the Lisp implementation is
- replaced, this file likely will not be used. */
-
-#undef HIDE_LISP_IMPLEMENTATION
#include "lisp.h"
#include "process.h"
#include "intervals.h"
#include "puresize.h"
+#include "character.h"
#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
-#include "character.h"
-#include "syssignal.h"
#include "termhooks.h" /* For struct terminal. */
-#include <setjmp.h>
+
#include <verify.h>
+/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
+ Doable only if GC_MARK_STACK. */
+#if ! GC_MARK_STACK
+# undef GC_CHECK_MARKED_OBJECTS
+#endif
+
/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
- memory. Can do this only if using gmalloc.c. */
+ memory. Can do this only if using gmalloc.c and if not checking
+ marked objects. */
-#if defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC
+#if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \
+ || defined GC_CHECK_MARKED_OBJECTS)
#undef GC_MALLOC_CHECK
#endif
#include <unistd.h>
#ifndef HAVE_UNISTD_H
-extern POINTER_TYPE *sbrk ();
+extern void *sbrk ();
#endif
#include <fcntl.h>
+#ifdef USE_GTK
+# include "gtkutil.h"
+#endif
#ifdef WINDOWSNT
#include "w32.h"
#endif
#define MMAP_MAX_AREAS 100000000
-#else /* not DOUG_LEA_MALLOC */
-
-/* The following come from gmalloc.c. */
-
-extern size_t _bytes_used;
-extern size_t __malloc_extra_blocks;
-
#endif /* not DOUG_LEA_MALLOC */
-#if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT
-#ifdef HAVE_PTHREAD
-
-/* When GTK uses the file chooser dialog, different backends can be loaded
- dynamically. One such a backend is the Gnome VFS backend that gets loaded
- if you run Gnome. That backend creates several threads and also allocates
- memory with malloc.
-
- Also, gconf and gsettings may create several threads.
-
- If Emacs sets malloc hooks (! SYSTEM_MALLOC) and the emacs_blocked_*
- functions below are called from malloc, there is a chance that one
- of these threads preempts the Emacs main thread and the hook variables
- end up in an inconsistent state. So we have a mutex to prevent that (note
- that the backend handles concurrent access to malloc within its own threads
- but Emacs code running in the main thread is not included in that control).
-
- When UNBLOCK_INPUT is called, reinvoke_input_signal may be called. If this
- happens in one of the backend threads we will have two threads that tries
- to run Emacs code at once, and the code is not prepared for that.
- To prevent that, we only call BLOCK/UNBLOCK from the main thread. */
-
-static pthread_mutex_t alloc_mutex;
-
-#define BLOCK_INPUT_ALLOC \
- do \
- { \
- if (pthread_equal (pthread_self (), main_thread)) \
- BLOCK_INPUT; \
- pthread_mutex_lock (&alloc_mutex); \
- } \
- while (0)
-#define UNBLOCK_INPUT_ALLOC \
- do \
- { \
- pthread_mutex_unlock (&alloc_mutex); \
- if (pthread_equal (pthread_self (), main_thread)) \
- UNBLOCK_INPUT; \
- } \
- while (0)
-
-#else /* ! defined HAVE_PTHREAD */
-
-#define BLOCK_INPUT_ALLOC BLOCK_INPUT
-#define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT
-
-#endif /* ! defined HAVE_PTHREAD */
-#endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */
-
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
#define VECTOR_UNMARK(V) ((V)->header.size &= ~ARRAY_MARK_FLAG)
#define VECTOR_MARKED_P(V) (((V)->header.size & ARRAY_MARK_FLAG) != 0)
-/* Value is the number of bytes of S, a pointer to a struct Lisp_String.
- Be careful during GC, because S->size contains the mark bit for
- strings. */
+/* Default value of gc_cons_threshold (see below). */
-#define GC_STRING_BYTES(S) (STRING_BYTES (S))
+#define GC_DEFAULT_THRESHOLD (100000 * word_size)
/* Global variables. */
struct emacs_globals globals;
EMACS_INT memory_full_cons_threshold;
-/* Nonzero during GC. */
+/* True during GC. */
-int gc_in_progress;
+bool gc_in_progress;
-/* Nonzero means abort if try to GC.
+/* True means abort if try to GC.
This is for code which is written on the assumption that
no GC will happen, so as to verify that assumption. */
-int abort_on_gc;
+bool abort_on_gc;
/* Number of live and free conses etc. */
-static EMACS_INT total_conses, total_markers, total_symbols, total_vector_size;
+static EMACS_INT total_conses, total_markers, total_symbols, total_buffers;
static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
static EMACS_INT total_free_floats, total_floats;
#define SPARE_MEMORY (1 << 14)
-/* Number of extra blocks malloc should get when it needs more core. */
-
-static int malloc_hysteresis;
-
/* Initialize it to a nonzero value to force it into data space
(rather than bss space). That way unexec will remap it into text
space (pure), on some systems. We have not implemented the
static ptrdiff_t pure_bytes_used_before_overflow;
-/* Value is non-zero if P points into pure space. */
+/* True if P points into pure space. */
#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 EMACS_INT pure_bytes_used_lisp;
+static ptrdiff_t pure_bytes_used_lisp;
/* Number of bytes allocated for non-Lisp objects in pure storage. */
-static EMACS_INT pure_bytes_used_non_lisp;
+static ptrdiff_t pure_bytes_used_non_lisp;
/* If nonzero, this is a warning delivered by malloc and not yet
displayed. */
static ptrdiff_t stack_copy_size;
#endif
-/* Non-zero means ignore malloc warnings. Set during initialization.
- Currently not used. */
-
-static int ignore_warnings;
-
+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 Qautomatic_gc;
Lisp_Object Qchar_table_extra_slots;
/* Hook run after GC has finished. */
static Lisp_Object Qpost_gc_hook;
-static void mark_buffer (Lisp_Object);
static void mark_terminals (void);
static void gc_sweep (void);
+static Lisp_Object make_pure_vector (ptrdiff_t);
static void mark_glyph_matrix (struct glyph_matrix *);
static void mark_face_cache (struct face_cache *);
+static void mark_buffer (struct buffer *);
#if !defined REL_ALLOC || defined SYSTEM_MALLOC
static void refill_memory_reserve (void);
process, hash_table, frame, terminal, and window, but we never made
use of the distinction, so it only caused source-code complexity
and runtime slowdown. Minor but pointless. */
- MEM_TYPE_VECTORLIKE
+ MEM_TYPE_VECTORLIKE,
+ /* Special type to denote vector blocks. */
+ MEM_TYPE_VECTOR_BLOCK,
+ /* Special type to denote reserved memory. */
+ MEM_TYPE_SPARE
};
-static POINTER_TYPE *lisp_align_malloc (size_t, enum mem_type);
-static POINTER_TYPE *lisp_malloc (size_t, enum mem_type);
+static void *lisp_malloc (size_t, enum mem_type);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
#ifdef GC_MALLOC_CHECK
enum mem_type allocated_mem_type;
-static int dont_register_blocks;
#endif /* GC_MALLOC_CHECK */
static struct mem_node mem_z;
#define MEM_NIL &mem_z
-static struct Lisp_Vector *allocate_vectorlike (EMACS_INT);
-static void lisp_free (POINTER_TYPE *);
+static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
+static void lisp_free (void *);
static void mark_stack (void);
-static int live_vector_p (struct mem_node *, void *);
-static int live_buffer_p (struct mem_node *, void *);
-static int live_string_p (struct mem_node *, void *);
-static int live_cons_p (struct mem_node *, void *);
-static int live_symbol_p (struct mem_node *, void *);
-static int live_float_p (struct mem_node *, void *);
-static int live_misc_p (struct mem_node *, void *);
+static bool live_vector_p (struct mem_node *, void *);
+static bool live_buffer_p (struct mem_node *, void *);
+static bool live_string_p (struct mem_node *, void *);
+static bool live_cons_p (struct mem_node *, void *);
+static bool live_symbol_p (struct mem_node *, void *);
+static bool live_float_p (struct mem_node *, void *);
+static bool live_misc_p (struct mem_node *, void *);
static void mark_maybe_object (Lisp_Object);
static void mark_memory (void *, void *);
+#if GC_MARK_STACK || defined GC_MALLOC_CHECK
static void mem_init (void);
static struct mem_node *mem_insert (void *, void *, enum mem_type);
static void mem_insert_fixup (struct mem_node *);
static void mem_delete (struct mem_node *);
static void mem_delete_fixup (struct mem_node *);
static inline struct mem_node *mem_find (void *);
+#endif
#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 0x640
+#define NSTATICS 0x650
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
-static int staticidx = 0;
+static int staticidx;
-static POINTER_TYPE *pure_alloc (size_t, int);
+static void *pure_alloc (size_t, int);
/* Value is SZ rounded up to the next multiple of ALIGNMENT.
ALIGNMENT must be a power of 2. */
#define ALIGN(ptr, ALIGNMENT) \
- ((POINTER_TYPE *) ((((uintptr_t) (ptr)) + (ALIGNMENT) - 1) \
- & ~((ALIGNMENT) - 1)))
+ ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
+ & ~ ((ALIGNMENT) - 1)))
\f
/* Called if we can't allocate relocatable space for a buffer. */
void
-buffer_memory_full (EMACS_INT nbytes)
+buffer_memory_full (ptrdiff_t nbytes)
{
/* If buffers use the relocating allocator, no need to free
spare_memory, because we may have plenty of malloc space left
xsignal (Qnil, Vmemory_signal_data);
}
+/* A common multiple of the positive integers A and B. Ideally this
+ would be the least common multiple, but there's no way to do that
+ as a constant expression in C, so do the best that we can easily do. */
+#define COMMON_MULTIPLE(a, b) \
+ ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
#ifndef XMALLOC_OVERRUN_CHECK
#define XMALLOC_OVERRUN_CHECK_OVERHEAD 0
hold a size_t value and (2) the header size is a multiple of the
alignment that Emacs needs for C types and for USE_LSB_TAG. */
#define XMALLOC_BASE_ALIGNMENT \
- offsetof ( \
- struct { \
- union { long double d; intmax_t i; void *p; } u; \
- char c; \
- }, \
- c)
-#ifdef USE_LSB_TAG
-/* A common multiple of the positive integers A and B. Ideally this
- would be the least common multiple, but there's no way to do that
- as a constant expression in C, so do the best that we can easily do. */
-# define COMMON_MULTIPLE(a, b) \
- ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
+ alignof (union { long double d; intmax_t i; void *p; })
+
+#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
}
-/* The call depth in overrun_check functions. For example, this might happen:
- xmalloc()
- overrun_check_malloc()
- -> malloc -> (via hook)_-> emacs_blocked_malloc
- -> overrun_check_malloc
- call malloc (hooks are NULL, so real malloc is called).
- malloc returns 10000.
- add overhead, return 10016.
- <- (back in overrun_check_malloc)
- add overhead again, return 10032
- xmalloc returns 10032.
-
- (time passes).
-
- xfree(10032)
- overrun_check_free(10032)
- decrease overhead
- free(10016) <- crash, because 10000 is the original pointer. */
-
-static ptrdiff_t check_depth;
-
/* Like malloc, but wraps allocated block with header and trailer. */
-static POINTER_TYPE *
+static void *
overrun_check_malloc (size_t size)
{
register unsigned char *val;
- int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
- if (SIZE_MAX - overhead < size)
- abort ();
+ if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
+ emacs_abort ();
- val = (unsigned char *) malloc (size + overhead);
- if (val && check_depth == 1)
+ val = malloc (size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
+ if (val)
{
memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memcpy (val + size, xmalloc_overrun_check_trailer,
XMALLOC_OVERRUN_CHECK_SIZE);
}
- --check_depth;
- return (POINTER_TYPE *)val;
+ return val;
}
/* Like realloc, but checks old block for overrun, and wraps new block
with header and trailer. */
-static POINTER_TYPE *
-overrun_check_realloc (POINTER_TYPE *block, size_t size)
+static void *
+overrun_check_realloc (void *block, size_t size)
{
register unsigned char *val = (unsigned char *) block;
- int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
- if (SIZE_MAX - overhead < size)
- abort ();
+ if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
+ emacs_abort ();
if (val
- && check_depth == 1
&& memcmp (xmalloc_overrun_check_header,
val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
XMALLOC_OVERRUN_CHECK_SIZE) == 0)
size_t osize = xmalloc_get_size (val);
if (memcmp (xmalloc_overrun_check_trailer, val + osize,
XMALLOC_OVERRUN_CHECK_SIZE))
- abort ();
+ emacs_abort ();
memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
}
- val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + overhead);
+ val = realloc (val, size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
- if (val && check_depth == 1)
+ if (val)
{
memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memcpy (val + size, xmalloc_overrun_check_trailer,
XMALLOC_OVERRUN_CHECK_SIZE);
}
- --check_depth;
- return (POINTER_TYPE *)val;
+ return val;
}
/* Like free, but checks block for overrun. */
static void
-overrun_check_free (POINTER_TYPE *block)
+overrun_check_free (void *block)
{
unsigned char *val = (unsigned char *) block;
- ++check_depth;
if (val
- && check_depth == 1
&& memcmp (xmalloc_overrun_check_header,
val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
XMALLOC_OVERRUN_CHECK_SIZE) == 0)
size_t osize = xmalloc_get_size (val);
if (memcmp (xmalloc_overrun_check_trailer, val + osize,
XMALLOC_OVERRUN_CHECK_SIZE))
- abort ();
+ emacs_abort ();
#ifdef XMALLOC_CLEAR_FREE_MEMORY
val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_OVERHEAD);
}
free (val);
- --check_depth;
}
#undef malloc
#define free overrun_check_free
#endif
-#ifdef SYNC_INPUT
-/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
- there's no need to block input around malloc. */
-#define MALLOC_BLOCK_INPUT ((void)0)
-#define MALLOC_UNBLOCK_INPUT ((void)0)
+/* If compiled with XMALLOC_BLOCK_INPUT_CHECK, define a symbol
+ BLOCK_INPUT_IN_MEMORY_ALLOCATORS that is visible to the debugger.
+ If that variable is set, block input while in one of Emacs's memory
+ allocation functions. There should be no need for this debugging
+ option, since signal handlers do not allocate memory, but Emacs
+ formerly allocated memory in signal handlers and this compile-time
+ option remains as a way to help debug the issue should it rear its
+ ugly head again. */
+#ifdef XMALLOC_BLOCK_INPUT_CHECK
+bool block_input_in_memory_allocators EXTERNALLY_VISIBLE;
+static void
+malloc_block_input (void)
+{
+ if (block_input_in_memory_allocators)
+ block_input ();
+}
+static void
+malloc_unblock_input (void)
+{
+ if (block_input_in_memory_allocators)
+ unblock_input ();
+}
+# define MALLOC_BLOCK_INPUT malloc_block_input ()
+# define MALLOC_UNBLOCK_INPUT malloc_unblock_input ()
#else
-#define MALLOC_BLOCK_INPUT BLOCK_INPUT
-#define MALLOC_UNBLOCK_INPUT UNBLOCK_INPUT
+# define MALLOC_BLOCK_INPUT ((void) 0)
+# define MALLOC_UNBLOCK_INPUT ((void) 0)
#endif
+#define MALLOC_PROBE(size) \
+ do { \
+ if (profiler_memory_running) \
+ malloc_probe (size); \
+ } while (0)
+
+
/* Like malloc but check for no memory and block interrupt input.. */
-POINTER_TYPE *
+void *
xmalloc (size_t size)
{
- register POINTER_TYPE *val;
+ void *val;
MALLOC_BLOCK_INPUT;
- val = (POINTER_TYPE *) malloc (size);
+ val = malloc (size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
memory_full (size);
+ MALLOC_PROBE (size);
return val;
}
+/* Like the above, but zeroes out the memory just allocated. */
+
+void *
+xzalloc (size_t size)
+{
+ void *val;
+
+ MALLOC_BLOCK_INPUT;
+ val = malloc (size);
+ MALLOC_UNBLOCK_INPUT;
+
+ if (!val && size)
+ memory_full (size);
+ memset (val, 0, size);
+ MALLOC_PROBE (size);
+ return val;
+}
/* Like realloc but check for no memory and block interrupt input.. */
-POINTER_TYPE *
-xrealloc (POINTER_TYPE *block, size_t size)
+void *
+xrealloc (void *block, size_t size)
{
- register POINTER_TYPE *val;
+ void *val;
MALLOC_BLOCK_INPUT;
/* We must call malloc explicitly when BLOCK is 0, since some
reallocs don't do this. */
if (! block)
- val = (POINTER_TYPE *) malloc (size);
+ val = malloc (size);
else
- val = (POINTER_TYPE *) realloc (block, size);
+ val = realloc (block, size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
memory_full (size);
+ MALLOC_PROBE (size);
return val;
}
/* Like free but block interrupt input. */
void
-xfree (POINTER_TYPE *block)
+xfree (void *block)
{
if (!block)
return;
free (block);
MALLOC_UNBLOCK_INPUT;
/* We don't call refill_memory_reserve here
- because that duplicates doing so in emacs_blocked_free
- and the criterion should go there. */
+ because in practice the call in r_alloc_free seems to suffice. */
}
void *
xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
{
- xassert (0 <= nitems && 0 < item_size);
+ eassert (0 <= nitems && 0 < item_size);
if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
memory_full (SIZE_MAX);
return xmalloc (nitems * item_size);
void *
xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
{
- xassert (0 <= nitems && 0 < item_size);
+ eassert (0 <= nitems && 0 < item_size);
if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
memory_full (SIZE_MAX);
return xrealloc (pa, nitems * item_size);
ptrdiff_t nitems_incr_max = n_max - n;
ptrdiff_t incr = max (nitems_incr_min, min (incr_estimate, nitems_incr_max));
- xassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
+ eassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
if (! pa)
*nitems = 0;
if (nitems_incr_max < incr)
xstrdup (const char *s)
{
size_t len = strlen (s) + 1;
- char *p = (char *) xmalloc (len);
+ char *p = xmalloc (len);
memcpy (p, s, len);
return p;
}
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
allocated memory block (for strings, for conses, ...). */
-#ifndef USE_LSB_TAG
-static void *lisp_malloc_loser;
+#if ! USE_LSB_TAG
+void *lisp_malloc_loser EXTERNALLY_VISIBLE;
#endif
-static POINTER_TYPE *
+static void *
lisp_malloc (size_t nbytes, enum mem_type type)
{
register void *val;
allocated_mem_type = type;
#endif
- val = (void *) malloc (nbytes);
+ val = malloc (nbytes);
-#ifndef USE_LSB_TAG
+#if ! USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp
object's pointer, and it needs to be,
that's equivalent to running out of memory. */
MALLOC_UNBLOCK_INPUT;
if (!val && nbytes)
memory_full (nbytes);
+ MALLOC_PROBE (nbytes);
return val;
}
call to lisp_malloc. */
static void
-lisp_free (POINTER_TYPE *block)
+lisp_free (void *block)
{
MALLOC_BLOCK_INPUT;
free (block);
MALLOC_UNBLOCK_INPUT;
}
-/* Allocation of aligned blocks of memory to store Lisp data. */
-/* The entry point is lisp_align_malloc which returns blocks of at most */
-/* BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
+/***** Allocation of aligned blocks of memory to store Lisp data. *****/
+
+/* The entry point is lisp_align_malloc which returns blocks of at most
+ BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
-/* Use posix_memalloc if the system has it and we're using the system's
- malloc (because our gmalloc.c routines don't have posix_memalign although
- its memalloc could be used). */
#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
#define USE_POSIX_MEMALIGN 1
#endif
struct ablock blocks[ABLOCKS_SIZE];
};
-/* Size of the block requested from malloc or memalign. */
+/* Size of the block requested from malloc or posix_memalign. */
#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
#define ABLOCK_ABASE(block) \
/* Allocate an aligned block of nbytes.
Alignment is on a multiple of BLOCK_ALIGN and `nbytes' has to be
smaller or equal to BLOCK_BYTES. */
-static POINTER_TYPE *
+static void *
lisp_align_malloc (size_t nbytes, enum mem_type type)
{
void *base, *val;
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
-#ifndef USE_LSB_TAG
+#if ! USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp
object's pointer, and it needs to be, that's equivalent to
running out of memory. */
#endif
/* Initialize the blocks and put them on the free list.
- Is `base' was not properly aligned, we can't use the last block. */
+ If `base' was not properly aligned, we can't use the last block. */
for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++)
{
abase->blocks[i].abase = abase;
MALLOC_UNBLOCK_INPUT;
+ MALLOC_PROBE (nbytes);
+
eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN);
return val;
}
static void
-lisp_align_free (POINTER_TYPE *block)
+lisp_align_free (void *block)
{
struct ablock *ablock = block;
struct ablocks *abase = ABLOCK_ABASE (ablock);
ablock->x.next_free = free_ablock;
free_ablock = ablock;
/* Update busy count. */
- ABLOCKS_BUSY (abase) =
- (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
+ ABLOCKS_BUSY (abase)
+ = (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
if (2 > (intptr_t) ABLOCKS_BUSY (abase))
{ /* All the blocks are free. */
MALLOC_UNBLOCK_INPUT;
}
-/* Return a new buffer structure allocated from the heap with
- a call to lisp_malloc. */
-
-struct buffer *
-allocate_buffer (void)
-{
- struct buffer *b
- = (struct buffer *) lisp_malloc (sizeof (struct buffer),
- MEM_TYPE_BUFFER);
- XSETPVECTYPESIZE (b, PVEC_BUFFER,
- ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1)
- / sizeof (EMACS_INT)));
- return b;
-}
-
-\f
-#ifndef SYSTEM_MALLOC
-
-/* Arranging to disable input signals while we're in malloc.
-
- This only works with GNU malloc. To help out systems which can't
- use GNU malloc, all the calls to malloc, realloc, and free
- elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT
- pair; unfortunately, we have no idea what C library functions
- might call malloc, so we can't really protect them unless you're
- using GNU malloc. Fortunately, most of the major operating systems
- can use GNU malloc. */
-
-#ifndef SYNC_INPUT
-/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
- there's no need to block input around malloc. */
-
-#ifndef DOUG_LEA_MALLOC
-extern void * (*__malloc_hook) (size_t, const void *);
-extern void * (*__realloc_hook) (void *, size_t, const void *);
-extern void (*__free_hook) (void *, const void *);
-/* Else declared in malloc.h, perhaps with an extra arg. */
-#endif /* DOUG_LEA_MALLOC */
-static void * (*old_malloc_hook) (size_t, const void *);
-static void * (*old_realloc_hook) (void *, size_t, const void*);
-static void (*old_free_hook) (void*, const void*);
-
-#ifdef DOUG_LEA_MALLOC
-# define BYTES_USED (mallinfo ().uordblks)
-#else
-# define BYTES_USED _bytes_used
-#endif
-
-static size_t bytes_used_when_reconsidered;
-
-/* Value of _bytes_used, when spare_memory was freed. */
-
-static size_t bytes_used_when_full;
-
-/* This function is used as the hook for free to call. */
-
-static void
-emacs_blocked_free (void *ptr, const void *ptr2)
-{
- BLOCK_INPUT_ALLOC;
-
-#ifdef GC_MALLOC_CHECK
- if (ptr)
- {
- struct mem_node *m;
-
- m = mem_find (ptr);
- if (m == MEM_NIL || m->start != ptr)
- {
- fprintf (stderr,
- "Freeing `%p' which wasn't allocated with malloc\n", ptr);
- abort ();
- }
- else
- {
- /* fprintf (stderr, "free %p...%p (%p)\n", m->start, m->end, ptr); */
- mem_delete (m);
- }
- }
-#endif /* GC_MALLOC_CHECK */
-
- __free_hook = old_free_hook;
- free (ptr);
-
- /* If we released our reserve (due to running out of memory),
- and we have a fair amount free once again,
- try to set aside another reserve in case we run out once more. */
- if (! NILP (Vmemory_full)
- /* Verify there is enough space that even with the malloc
- hysteresis this call won't run out again.
- The code here is correct as long as SPARE_MEMORY
- is substantially larger than the block size malloc uses. */
- && (bytes_used_when_full
- > ((bytes_used_when_reconsidered = BYTES_USED)
- + max (malloc_hysteresis, 4) * SPARE_MEMORY)))
- refill_memory_reserve ();
-
- __free_hook = emacs_blocked_free;
- UNBLOCK_INPUT_ALLOC;
-}
-
-
-/* This function is the malloc hook that Emacs uses. */
-
-static void *
-emacs_blocked_malloc (size_t size, const void *ptr)
-{
- void *value;
-
- BLOCK_INPUT_ALLOC;
- __malloc_hook = old_malloc_hook;
-#ifdef DOUG_LEA_MALLOC
- /* Segfaults on my system. --lorentey */
- /* mallopt (M_TOP_PAD, malloc_hysteresis * 4096); */
-#else
- __malloc_extra_blocks = malloc_hysteresis;
-#endif
-
- value = (void *) malloc (size);
-
-#ifdef GC_MALLOC_CHECK
- {
- struct mem_node *m = mem_find (value);
- if (m != MEM_NIL)
- {
- fprintf (stderr, "Malloc returned %p which is already in use\n",
- value);
- fprintf (stderr, "Region in use is %p...%p, %u bytes, type %d\n",
- m->start, m->end, (char *) m->end - (char *) m->start,
- m->type);
- abort ();
- }
-
- if (!dont_register_blocks)
- {
- mem_insert (value, (char *) value + max (1, size), allocated_mem_type);
- allocated_mem_type = MEM_TYPE_NON_LISP;
- }
- }
-#endif /* GC_MALLOC_CHECK */
-
- __malloc_hook = emacs_blocked_malloc;
- UNBLOCK_INPUT_ALLOC;
-
- /* fprintf (stderr, "%p malloc\n", value); */
- return value;
-}
-
-
-/* This function is the realloc hook that Emacs uses. */
-
-static void *
-emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2)
-{
- void *value;
-
- BLOCK_INPUT_ALLOC;
- __realloc_hook = old_realloc_hook;
-
-#ifdef GC_MALLOC_CHECK
- if (ptr)
- {
- struct mem_node *m = mem_find (ptr);
- if (m == MEM_NIL || m->start != ptr)
- {
- fprintf (stderr,
- "Realloc of %p which wasn't allocated with malloc\n",
- ptr);
- abort ();
- }
-
- mem_delete (m);
- }
-
- /* fprintf (stderr, "%p -> realloc\n", ptr); */
-
- /* Prevent malloc from registering blocks. */
- dont_register_blocks = 1;
-#endif /* GC_MALLOC_CHECK */
-
- value = (void *) realloc (ptr, size);
-
-#ifdef GC_MALLOC_CHECK
- dont_register_blocks = 0;
-
- {
- struct mem_node *m = mem_find (value);
- if (m != MEM_NIL)
- {
- fprintf (stderr, "Realloc returns memory that is already in use\n");
- abort ();
- }
-
- /* Can't handle zero size regions in the red-black tree. */
- mem_insert (value, (char *) value + max (size, 1), MEM_TYPE_NON_LISP);
- }
-
- /* fprintf (stderr, "%p <- realloc\n", value); */
-#endif /* GC_MALLOC_CHECK */
-
- __realloc_hook = emacs_blocked_realloc;
- UNBLOCK_INPUT_ALLOC;
-
- return value;
-}
-
-
-#ifdef HAVE_PTHREAD
-/* Called from Fdump_emacs so that when the dumped Emacs starts, it has a
- normal malloc. Some thread implementations need this as they call
- malloc before main. The pthread_self call in BLOCK_INPUT_ALLOC then
- calls malloc because it is the first call, and we have an endless loop. */
-
-void
-reset_malloc_hooks (void)
-{
- __free_hook = old_free_hook;
- __malloc_hook = old_malloc_hook;
- __realloc_hook = old_realloc_hook;
-}
-#endif /* HAVE_PTHREAD */
-
-
-/* Called from main to set up malloc to use our hooks. */
-
-void
-uninterrupt_malloc (void)
-{
-#ifdef HAVE_PTHREAD
-#ifdef DOUG_LEA_MALLOC
- pthread_mutexattr_t attr;
-
- /* GLIBC has a faster way to do this, but let's keep it portable.
- This is according to the Single UNIX Specification. */
- pthread_mutexattr_init (&attr);
- pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE);
- pthread_mutex_init (&alloc_mutex, &attr);
-#else /* !DOUG_LEA_MALLOC */
- /* Some systems such as Solaris 2.6 don't have a recursive mutex,
- and the bundled gmalloc.c doesn't require it. */
- pthread_mutex_init (&alloc_mutex, NULL);
-#endif /* !DOUG_LEA_MALLOC */
-#endif /* HAVE_PTHREAD */
-
- if (__free_hook != emacs_blocked_free)
- old_free_hook = __free_hook;
- __free_hook = emacs_blocked_free;
-
- if (__malloc_hook != emacs_blocked_malloc)
- old_malloc_hook = __malloc_hook;
- __malloc_hook = emacs_blocked_malloc;
-
- if (__realloc_hook != emacs_blocked_realloc)
- old_realloc_hook = __realloc_hook;
- __realloc_hook = emacs_blocked_realloc;
-}
-
-#endif /* not SYNC_INPUT */
-#endif /* not SYSTEM_MALLOC */
-
-
\f
/***********************************************************************
Interval Allocation
/* Index in interval_block above of the next unused interval
structure. */
-static int interval_block_index;
+static int interval_block_index = INTERVAL_BLOCK_SIZE;
/* Number of free and live intervals. */
static INTERVAL interval_free_list;
-
-/* Initialize interval allocation. */
-
-static void
-init_intervals (void)
-{
- interval_block = NULL;
- interval_block_index = INTERVAL_BLOCK_SIZE;
- interval_free_list = 0;
-}
-
-
/* Return a new interval. */
INTERVAL
{
INTERVAL val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (interval_free_list)
{
if (interval_block_index == INTERVAL_BLOCK_SIZE)
{
- register struct interval_block *newi;
-
- newi = (struct interval_block *) lisp_malloc (sizeof *newi,
- MEM_TYPE_NON_LISP);
+ struct interval_block *newi
+ = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP);
newi->next = interval_block;
interval_block = newi;
interval_block_index = 0;
+ total_free_intervals += INTERVAL_BLOCK_SIZE;
}
val = &interval_block->intervals[interval_block_index++];
}
consing_since_gc += sizeof (struct interval);
intervals_consed++;
+ total_free_intervals--;
RESET_INTERVAL (val);
val->gcmarkbit = 0;
return val;
}
-/* Mark Lisp objects in interval I. */
+/* Mark Lisp objects in interval I. */
static void
mark_interval (register INTERVAL i, Lisp_Object dummy)
{
- eassert (!i->gcmarkbit); /* Intervals are never shared. */
+ /* Intervals should never be shared. So, if extra internal checking is
+ enabled, GC aborts if it seems to have visited an interval twice. */
+ eassert (!i->gcmarkbit);
i->gcmarkbit = 1;
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)
-
-\f
-/* Number support. If USE_LISP_UNION_TYPE is in effect, we
- can't create number objects in macros. */
-#ifndef make_number
-Lisp_Object
-make_number (EMACS_INT n)
-{
- Lisp_Object obj;
- obj.s.val = n;
- obj.s.type = Lisp_Int;
- return obj;
-}
-#endif
-\f
-/* Convert the pointer-sized word P to EMACS_INT while preserving its
- type and ptr fields. */
-static Lisp_Object
-widen_to_Lisp_Object (void *p)
-{
- intptr_t i = (intptr_t) p;
-#ifdef USE_LISP_UNION_TYPE
- Lisp_Object obj;
- obj.i = i;
- return obj;
-#else
- return i;
-#endif
-}
-\f
/***********************************************************************
String Allocation
***********************************************************************/
#ifdef GC_CHECK_STRING_BYTES
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
unsigned char data[1];
#define SDATA_NBYTES(S) (S)->nbytes
unsigned char data[1];
/* When STRING is null. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
} u;
#define SDATA_NBYTES(S) (S)->u.nbytes
/* Number of bytes used by live strings. */
-static EMACS_INT total_string_size;
+static EMACS_INT total_string_bytes;
/* Given a pointer to a Lisp_String S which is on the free-list
string_free_list, return a pointer to its successor in the
#define SDATA_SIZE(NBYTES) \
((SDATA_DATA_OFFSET \
+ (NBYTES) + 1 \
- + sizeof (EMACS_INT) - 1) \
- & ~(sizeof (EMACS_INT) - 1))
+ + sizeof (ptrdiff_t) - 1) \
+ & ~(sizeof (ptrdiff_t) - 1))
#else /* not GC_CHECK_STRING_BYTES */
/* The 'max' reserves space for the nbytes union member even when NBYTES + 1 is
less than the size of that member. The 'max' is not needed when
- SDATA_DATA_OFFSET is a multiple of sizeof (EMACS_INT), because then the
+ SDATA_DATA_OFFSET is a multiple of sizeof (ptrdiff_t), because then the
alignment code reserves enough space. */
#define SDATA_SIZE(NBYTES) \
((SDATA_DATA_OFFSET \
- + (SDATA_DATA_OFFSET % sizeof (EMACS_INT) == 0 \
+ + (SDATA_DATA_OFFSET % sizeof (ptrdiff_t) == 0 \
? NBYTES \
- : max (NBYTES, sizeof (EMACS_INT) - 1)) \
+ : max (NBYTES, sizeof (ptrdiff_t) - 1)) \
+ 1 \
- + sizeof (EMACS_INT) - 1) \
- & ~(sizeof (EMACS_INT) - 1))
+ + sizeof (ptrdiff_t) - 1) \
+ & ~(sizeof (ptrdiff_t) - 1))
#endif /* not GC_CHECK_STRING_BYTES */
STRING_BYTES_BOUND, nor can it be so long that the size_t
arithmetic in allocate_string_data would overflow while it is
calculating a value to be passed to malloc. */
-#define STRING_BYTES_MAX \
- min (STRING_BYTES_BOUND, \
- ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD \
- - GC_STRING_EXTRA \
- - offsetof (struct sblock, first_data) \
- - SDATA_DATA_OFFSET) \
- & ~(sizeof (EMACS_INT) - 1)))
+static ptrdiff_t const STRING_BYTES_MAX =
+ min (STRING_BYTES_BOUND,
+ ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD
+ - GC_STRING_EXTRA
+ - offsetof (struct sblock, first_data)
+ - SDATA_DATA_OFFSET)
+ & ~(sizeof (EMACS_INT) - 1)));
/* Initialize string allocation. Called from init_alloc_once. */
static void
init_strings (void)
{
- total_strings = total_free_strings = total_string_size = 0;
- oldest_sblock = current_sblock = large_sblocks = NULL;
- string_blocks = NULL;
- string_free_list = NULL;
empty_unibyte_string = make_pure_string ("", 0, 0, 0);
empty_multibyte_string = make_pure_string ("", 0, 0, 1);
}
static int check_string_bytes_count;
-#define CHECK_STRING_BYTES(S) STRING_BYTES (S)
-
+/* Like STRING_BYTES, but with debugging check. Can be
+ called during GC, so pay attention to the mark bit. */
-/* Like GC_STRING_BYTES, but with debugging check. */
-
-EMACS_INT
+ptrdiff_t
string_bytes (struct Lisp_String *s)
{
- EMACS_INT nbytes =
+ ptrdiff_t nbytes =
(s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
if (!PURE_POINTER_P (s)
&& s->data
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
- abort ();
+ emacs_abort ();
return nbytes;
}
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
/* Check that the string size recorded in the string is the
- same as the one recorded in the sdata structure. */
- if (from->string)
- CHECK_STRING_BYTES (from->string);
-
- if (from->string)
- nbytes = GC_STRING_BYTES (from->string);
- else
- nbytes = SDATA_NBYTES (from);
-
- nbytes = SDATA_SIZE (nbytes);
+ same as the one recorded in the sdata structure. */
+ nbytes = SDATA_SIZE (from->string ? string_bytes (from->string)
+ : SDATA_NBYTES (from));
from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
}
}
/* Check validity of Lisp strings' string_bytes member. ALL_P
- non-zero means check all strings, otherwise check only most
+ means check all strings, otherwise check only most
recently allocated strings. Used for hunting a bug. */
static void
-check_string_bytes (int all_p)
+check_string_bytes (bool all_p)
{
if (all_p)
{
{
struct Lisp_String *s = b->first_data.string;
if (s)
- CHECK_STRING_BYTES (s);
+ string_bytes (s);
}
for (b = oldest_sblock; b; b = b->next)
check_sblock (b);
}
- else
+ else if (current_sblock)
check_sblock (current_sblock);
}
+#else /* not GC_CHECK_STRING_BYTES */
+
+#define check_string_bytes(all) ((void) 0)
+
#endif /* GC_CHECK_STRING_BYTES */
#ifdef GC_CHECK_STRING_FREE_LIST
while (s != NULL)
{
if ((uintptr_t) s < 1024)
- abort ();
+ emacs_abort ();
s = NEXT_FREE_LISP_STRING (s);
}
}
{
struct Lisp_String *s;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
/* If the free-list is empty, allocate a new string_block, and
add all the Lisp_Strings in it to the free-list. */
if (string_free_list == NULL)
{
- struct string_block *b;
+ struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING);
int i;
- b = (struct string_block *) lisp_malloc (sizeof *b, MEM_TYPE_STRING);
- memset (b, 0, sizeof *b);
b->next = string_blocks;
string_blocks = b;
for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i)
{
s = b->strings + i;
+ /* Every string on a free list should have NULL data pointer. */
+ s->data = NULL;
NEXT_FREE_LISP_STRING (s) = string_free_list;
string_free_list = s;
}
MALLOC_UNBLOCK_INPUT;
- /* Probably not strictly necessary, but play it safe. */
- memset (s, 0, sizeof *s);
-
--total_free_strings;
++total_strings;
++strings_consed;
{
struct sdata *data, *old_data;
struct sblock *b;
- EMACS_INT needed, old_nbytes;
+ ptrdiff_t needed, old_nbytes;
if (STRING_BYTES_MAX < nbytes)
string_overflow ();
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
needed = SDATA_SIZE (nbytes);
- old_data = s->data ? SDATA_OF_STRING (s) : NULL;
- old_nbytes = GC_STRING_BYTES (s);
+ if (s->data)
+ {
+ old_data = SDATA_OF_STRING (s);
+ old_nbytes = STRING_BYTES (s);
+ }
+ else
+ old_data = NULL;
MALLOC_BLOCK_INPUT;
mallopt (M_MMAP_MAX, 0);
#endif
- b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
+ b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
< (needed + GC_STRING_EXTRA)))
{
/* Not enough room in the current sblock. */
- b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
+ b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
b->next_free = &b->first_data;
b->first_data.string = NULL;
b->next = NULL;
GC_STRING_OVERRUN_COOKIE_SIZE);
#endif
- /* If S had already data assigned, mark that as free by setting its
- string back-pointer to null, and recording the size of the data
- in it. */
+ /* Note that Faset may call to this function when S has already data
+ assigned. In this case, mark data as free by setting it's string
+ back-pointer to null, and record the size of the data in it. */
if (old_data)
{
SDATA_NBYTES (old_data) = old_nbytes;
string_free_list = NULL;
total_strings = total_free_strings = 0;
- total_string_size = 0;
+ total_string_bytes = 0;
/* Scan strings_blocks, free Lisp_Strings that aren't marked. */
for (b = string_blocks; b; b = next)
/* 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_size += STRING_BYTES (s);
+ total_string_bytes += STRING_BYTES (s);
}
else
{
how large that is. Reset the sdata's string
back-pointer so that we know it's free. */
#ifdef GC_CHECK_STRING_BYTES
- if (GC_STRING_BYTES (s) != SDATA_NBYTES (data))
- abort ();
+ if (string_bytes (s) != SDATA_NBYTES (data))
+ emacs_abort ();
#else
- data->u.nbytes = GC_STRING_BYTES (s);
+ data->u.nbytes = STRING_BYTES (s);
#endif
data->string = NULL;
for (b = oldest_sblock; b; b = b->next)
{
end = b->next_free;
- xassert ((char *) end <= (char *) b + SBLOCK_SIZE);
+ eassert ((char *) end <= (char *) b + SBLOCK_SIZE);
for (from = &b->first_data; from < end; from = from_end)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
+ struct Lisp_String *s = from->string;
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
- if (from->string
- && GC_STRING_BYTES (from->string) != SDATA_NBYTES (from))
- abort ();
+ if (s && string_bytes (s) != SDATA_NBYTES (from))
+ emacs_abort ();
#endif /* GC_CHECK_STRING_BYTES */
- if (from->string)
- nbytes = GC_STRING_BYTES (from->string);
- else
- nbytes = SDATA_NBYTES (from);
-
- if (nbytes > LARGE_STRING_BYTES)
- abort ();
+ nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
+ eassert (nbytes <= LARGE_STRING_BYTES);
nbytes = SDATA_SIZE (nbytes);
from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
if (memcmp (string_overrun_cookie,
(char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE,
GC_STRING_OVERRUN_COOKIE_SIZE))
- abort ();
+ emacs_abort ();
#endif
- /* FROM->string non-null means it's alive. Copy its data. */
- if (from->string)
+ /* Non-NULL S means it's alive. Copy its data. */
+ if (s)
{
/* If TB is full, proceed with the next sblock. */
to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
/* Copy, and update the string's `data' pointer. */
if (from != to)
{
- xassert (tb != b || to < from);
+ eassert (tb != b || to < from);
memmove (to, from, nbytes + GC_STRING_EXTRA);
to->string->data = SDATA_DATA (to);
}
{
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
- EMACS_INT length_in_chars, length_in_elts;
+ ptrdiff_t length_in_chars;
+ EMACS_INT length_in_elts;
int bits_per_value;
+ int extra_bool_elts = ((bool_header_size - header_size + word_size - 1)
+ / word_size);
CHECK_NATNUM (length);
bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
- length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
- /* We must allocate one more elements than LENGTH_IN_ELTS for the
- slot `size' of the struct Lisp_Bool_Vector. */
- val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
+ val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil);
/* No Lisp_Object to trace in there. */
XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0);
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
+ length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
if (length_in_chars)
{
memset (p->data, ! NILP (init) ? -1 : 0, length_in_chars);
/* Clear any extraneous bits in the last byte. */
p->data[length_in_chars - 1]
- &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ &= (1 << ((XFASTINT (length) - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)) - 1;
}
return val;
multibyte, depending on the contents. */
Lisp_Object
-make_string (const char *contents, EMACS_INT nbytes)
+make_string (const char *contents, ptrdiff_t nbytes)
{
register Lisp_Object val;
- EMACS_INT nchars, multibyte_nbytes;
+ ptrdiff_t nchars, multibyte_nbytes;
parse_str_as_multibyte ((const unsigned char *) contents, nbytes,
&nchars, &multibyte_nbytes);
/* Make an unibyte string from LENGTH bytes at CONTENTS. */
Lisp_Object
-make_unibyte_string (const char *contents, EMACS_INT length)
+make_unibyte_string (const char *contents, ptrdiff_t length)
{
register Lisp_Object val;
val = make_uninit_string (length);
Lisp_Object
make_multibyte_string (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes)
+ ptrdiff_t nchars, ptrdiff_t nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
Lisp_Object
make_string_from_bytes (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes)
+ ptrdiff_t nchars, ptrdiff_t nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
Lisp_Object
make_specified_string (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte)
{
- register Lisp_Object val;
+ Lisp_Object val;
if (nchars < 0)
{
}
-/* Make a string from the data at STR, treating it as multibyte if the
- data warrants. */
-
-Lisp_Object
-build_string (const char *str)
-{
- return make_string (str, strlen (str));
-}
-
-
/* Return an unibyte Lisp_String set up to hold LENGTH characters
occupying LENGTH bytes. */
struct Lisp_String *s;
if (nchars < 0)
- abort ();
+ emacs_abort ();
if (!nbytes)
return empty_multibyte_string;
s = allocate_string ();
+ s->intervals = NULL;
allocate_string_data (s, nchars, nbytes);
XSETSTRING (string, s);
string_chars_consed += nbytes;
return string;
}
+/* Print arguments to BUF according to a FORMAT, then return
+ a Lisp_String initialized with the data from BUF. */
+
+Lisp_Object
+make_formatted_string (char *buf, const char *format, ...)
+{
+ va_list ap;
+ int length;
+
+ va_start (ap, format);
+ length = vsprintf (buf, format, ap);
+ va_end (ap);
+ return make_string (buf, length);
+}
\f
/***********************************************************************
/* Index of first unused Lisp_Float in the current float_block. */
-static int float_block_index;
+static int float_block_index = FLOAT_BLOCK_SIZE;
/* Free-list of Lisp_Floats. */
static struct Lisp_Float *float_free_list;
-
-/* Initialize float allocation. */
-
-static void
-init_float (void)
-{
- float_block = NULL;
- float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */
- float_free_list = 0;
-}
-
-
-/* Return a new float object with value FLOAT_VALUE. */
+/* Return a new float object with value FLOAT_VALUE. */
Lisp_Object
make_float (double float_value)
{
register Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (float_free_list)
{
if (float_block_index == FLOAT_BLOCK_SIZE)
{
- register struct float_block *new;
-
- new = (struct float_block *) lisp_align_malloc (sizeof *new,
- MEM_TYPE_FLOAT);
+ struct float_block *new
+ = lisp_align_malloc (sizeof *new, MEM_TYPE_FLOAT);
new->next = float_block;
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
float_block = new;
float_block_index = 0;
+ total_free_floats += FLOAT_BLOCK_SIZE;
}
XSETFLOAT (val, &float_block->floats[float_block_index]);
float_block_index++;
eassert (!FLOAT_MARKED_P (XFLOAT (val)));
consing_since_gc += sizeof (struct Lisp_Float);
floats_consed++;
+ total_free_floats--;
return val;
}
GC are put on a free list to be reallocated before allocating
any new cons cells from the latest cons_block. */
-#define CONS_BLOCK_SIZE \
- (((BLOCK_BYTES - sizeof (struct cons_block *)) * CHAR_BIT) \
+#define CONS_BLOCK_SIZE \
+ (((BLOCK_BYTES - sizeof (struct cons_block *) \
+ /* The compiler might add padding at the end. */ \
+ - (sizeof (struct Lisp_Cons) - sizeof (int))) * CHAR_BIT) \
/ (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
#define CONS_BLOCK(fptr) \
/* Index of first unused Lisp_Cons in the current block. */
-static int cons_block_index;
+static int cons_block_index = CONS_BLOCK_SIZE;
/* Free-list of Lisp_Cons structures. */
static struct Lisp_Cons *cons_free_list;
-
-/* Initialize cons allocation. */
-
-static void
-init_cons (void)
-{
- cons_block = NULL;
- cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */
- cons_free_list = 0;
-}
-
-
/* Explicitly free a cons cell by putting it on the free-list. */
void
ptr->car = Vdead;
#endif
cons_free_list = ptr;
+ consing_since_gc -= sizeof *ptr;
+ total_free_conses++;
}
DEFUN ("cons", Fcons, Scons, 2, 2, 0,
{
register Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (cons_free_list)
{
if (cons_block_index == CONS_BLOCK_SIZE)
{
- register struct cons_block *new;
- new = (struct cons_block *) lisp_align_malloc (sizeof *new,
- MEM_TYPE_CONS);
+ struct cons_block *new
+ = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS);
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
new->next = cons_block;
cons_block = new;
cons_block_index = 0;
+ total_free_conses += CONS_BLOCK_SIZE;
}
XSETCONS (val, &cons_block->conses[cons_block_index]);
cons_block_index++;
XSETCDR (val, cdr);
eassert (!CONS_MARKED_P (XCONS (val)));
consing_since_gc += sizeof (struct Lisp_Cons);
+ total_free_conses--;
cons_cells_consed++;
return val;
}
Fcons (arg5, Qnil)))));
}
+/* Make a list of COUNT Lisp_Objects, where ARG is the
+ first one. Allocate conses from pure space if TYPE
+ is CONSTYPE_PURE, or allocate as usual if type is CONSTYPE_HEAP. */
+
+Lisp_Object
+listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...)
+{
+ va_list ap;
+ ptrdiff_t i;
+ Lisp_Object val, *objp;
+
+ /* Change to SAFE_ALLOCA if you hit this eassert. */
+ eassert (count <= MAX_ALLOCA / word_size);
+
+ objp = alloca (count * word_size);
+ objp[0] = arg;
+ va_start (ap, arg);
+ for (i = 1; i < count; i++)
+ objp[i] = va_arg (ap, Lisp_Object);
+ va_end (ap);
+
+ for (val = Qnil, i = count - 1; i >= 0; i--)
+ {
+ if (type == CONSTYPE_PURE)
+ val = pure_cons (objp[i], val);
+ else if (type == CONSTYPE_HEAP)
+ val = Fcons (objp[i], val);
+ else
+ emacs_abort ();
+ }
+ return val;
+}
DEFUN ("list", Flist, Slist, 0, MANY, 0,
doc: /* Return a newly created list with specified arguments as elements.
Vector Allocation
***********************************************************************/
-/* Singly-linked list of all vectors. */
+/* This value is balanced well enough to avoid too much internal overhead
+ for the most common cases; it's not required to be a power of two, but
+ it's expected to be a mult-of-ROUNDUP_SIZE (see below). */
-static struct Lisp_Vector *all_vectors;
+#define VECTOR_BLOCK_SIZE 4096
-/* Handy constants for vectorlike objects. */
+/* Align allocation request sizes to be a multiple of ROUNDUP_SIZE. */
enum
{
- header_size = offsetof (struct Lisp_Vector, contents),
- word_size = sizeof (Lisp_Object)
+ roundup_size = COMMON_MULTIPLE (word_size, USE_LSB_TAG ? GCALIGNMENT : 1)
};
+/* ROUNDUP_SIZE must be a power of 2. */
+verify ((roundup_size & (roundup_size - 1)) == 0);
+
+/* Verify assumptions described above. */
+verify ((VECTOR_BLOCK_SIZE % roundup_size) == 0);
+verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
+
+/* Round up X to nearest mult-of-ROUNDUP_SIZE. */
+
+#define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1))
+
+/* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */
+
+#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup (sizeof (void *)))
+
+/* Size of the minimal vector allocated from block. */
+
+#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector))
+
+/* Size of the largest vector allocated from block. */
+
+#define VBLOCK_BYTES_MAX \
+ vroundup ((VECTOR_BLOCK_BYTES / 2) - word_size)
+
+/* We maintain one free list for each possible block-allocated
+ vector size, and this is the number of free lists we have. */
+
+#define VECTOR_MAX_FREE_LIST_INDEX \
+ ((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1)
+
+/* Common shortcut to advance vector pointer over a block data. */
+
+#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes)))
+
+/* Common shortcut to calculate NBYTES-vector index in VECTOR_FREE_LISTS. */
+
+#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size)
+
+/* Common shortcut to setup vector on a free list. */
+
+#define SETUP_ON_FREE_LIST(v, nbytes, index) \
+ do { \
+ XSETPVECTYPESIZE (v, PVEC_FREE, nbytes); \
+ eassert ((nbytes) % roundup_size == 0); \
+ (index) = VINDEX (nbytes); \
+ eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \
+ (v)->header.next.vector = vector_free_lists[index]; \
+ vector_free_lists[index] = (v); \
+ total_free_vector_slots += (nbytes) / word_size; \
+ } while (0)
+
+struct vector_block
+{
+ char data[VECTOR_BLOCK_BYTES];
+ struct vector_block *next;
+};
+
+/* Chain of vector blocks. */
+
+static struct vector_block *vector_blocks;
+
+/* Vector free lists, where NTH item points to a chain of free
+ vectors of the same NBYTES size, so NTH == VINDEX (NBYTES). */
+
+static struct Lisp_Vector *vector_free_lists[VECTOR_MAX_FREE_LIST_INDEX];
+
+/* Singly-linked list of large vectors. */
+
+static struct Lisp_Vector *large_vectors;
+
+/* The only vector with 0 slots, allocated from pure space. */
+
+Lisp_Object zero_vector;
+
+/* Number of live vectors. */
+
+static EMACS_INT total_vectors;
+
+/* Total size of live and free vectors, in Lisp_Object units. */
+
+static EMACS_INT total_vector_slots, total_free_vector_slots;
+
+/* Get a new vector block. */
+
+static struct vector_block *
+allocate_vector_block (void)
+{
+ struct vector_block *block = xmalloc (sizeof *block);
+
+#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+ mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
+ MEM_TYPE_VECTOR_BLOCK);
+#endif
+
+ block->next = vector_blocks;
+ vector_blocks = block;
+ return block;
+}
+
+/* Called once to initialize vector allocation. */
+
+static void
+init_vectors (void)
+{
+ zero_vector = make_pure_vector (0);
+}
+
+/* Allocate vector from a vector block. */
+
+static struct Lisp_Vector *
+allocate_vector_from_block (size_t nbytes)
+{
+ struct Lisp_Vector *vector, *rest;
+ struct vector_block *block;
+ size_t index, restbytes;
+
+ eassert (VBLOCK_BYTES_MIN <= nbytes && nbytes <= VBLOCK_BYTES_MAX);
+ eassert (nbytes % roundup_size == 0);
+
+ /* First, try to allocate from a free list
+ containing vectors of the requested size. */
+ index = VINDEX (nbytes);
+ if (vector_free_lists[index])
+ {
+ vector = vector_free_lists[index];
+ vector_free_lists[index] = vector->header.next.vector;
+ vector->header.next.nbytes = nbytes;
+ total_free_vector_slots -= nbytes / word_size;
+ return vector;
+ }
+
+ /* Next, check free lists containing larger vectors. Since
+ we will split the result, we should have remaining space
+ large enough to use for one-slot vector at least. */
+ for (index = VINDEX (nbytes + VBLOCK_BYTES_MIN);
+ index < VECTOR_MAX_FREE_LIST_INDEX; index++)
+ if (vector_free_lists[index])
+ {
+ /* This vector is larger than requested. */
+ vector = vector_free_lists[index];
+ vector_free_lists[index] = vector->header.next.vector;
+ vector->header.next.nbytes = nbytes;
+ total_free_vector_slots -= nbytes / word_size;
+
+ /* Excess bytes are used for the smaller vector,
+ which should be set on an appropriate free list. */
+ restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes;
+ eassert (restbytes % roundup_size == 0);
+ rest = ADVANCE (vector, nbytes);
+ SETUP_ON_FREE_LIST (rest, restbytes, index);
+ return vector;
+ }
+
+ /* Finally, need a new vector block. */
+ block = allocate_vector_block ();
+
+ /* New vector will be at the beginning of this block. */
+ vector = (struct Lisp_Vector *) block->data;
+ vector->header.next.nbytes = nbytes;
+
+ /* If the rest of space from this block is large enough
+ for one-slot vector at least, set up it on a free list. */
+ restbytes = VECTOR_BLOCK_BYTES - nbytes;
+ if (restbytes >= VBLOCK_BYTES_MIN)
+ {
+ eassert (restbytes % roundup_size == 0);
+ rest = ADVANCE (vector, nbytes);
+ SETUP_ON_FREE_LIST (rest, restbytes, index);
+ }
+ return vector;
+ }
+
+/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */
+
+#define VECTOR_IN_BLOCK(vector, block) \
+ ((char *) (vector) <= (block)->data \
+ + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN)
+
+/* Number of bytes used by vector-block-allocated object. This is the only
+ place where we actually use the `nbytes' field of the vector-header.
+ I.e. we could get rid of the `nbytes' field by computing it based on the
+ vector-type. */
+
+#define PSEUDOVECTOR_NBYTES(vector) \
+ (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \
+ ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \
+ : vector->header.next.nbytes)
+
+/* Reclaim space used by unmarked vectors. */
+
+static void
+sweep_vectors (void)
+{
+ struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
+ struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
+
+ total_vectors = total_vector_slots = total_free_vector_slots = 0;
+ memset (vector_free_lists, 0, sizeof (vector_free_lists));
+
+ /* Looking through vector blocks. */
+
+ for (block = vector_blocks; block; block = *bprev)
+ {
+ bool free_this_block = 0;
+
+ for (vector = (struct Lisp_Vector *) block->data;
+ VECTOR_IN_BLOCK (vector, block); vector = next)
+ {
+ if (VECTOR_MARKED_P (vector))
+ {
+ VECTOR_UNMARK (vector);
+ total_vectors++;
+ total_vector_slots += vector->header.next.nbytes / word_size;
+ next = ADVANCE (vector, vector->header.next.nbytes);
+ }
+ else
+ {
+ ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector);
+ ptrdiff_t total_bytes = nbytes;
+
+ next = ADVANCE (vector, nbytes);
+
+ /* While NEXT is not marked, try to coalesce with VECTOR,
+ thus making VECTOR of the largest possible size. */
+
+ while (VECTOR_IN_BLOCK (next, block))
+ {
+ if (VECTOR_MARKED_P (next))
+ break;
+ nbytes = PSEUDOVECTOR_NBYTES (next);
+ total_bytes += nbytes;
+ next = ADVANCE (next, nbytes);
+ }
+
+ eassert (total_bytes % roundup_size == 0);
+
+ if (vector == (struct Lisp_Vector *) block->data
+ && !VECTOR_IN_BLOCK (next, block))
+ /* This block should be freed because all of it's
+ space was coalesced into the only free vector. */
+ free_this_block = 1;
+ else
+ {
+ int tmp;
+ SETUP_ON_FREE_LIST (vector, total_bytes, tmp);
+ }
+ }
+ }
+
+ if (free_this_block)
+ {
+ *bprev = block->next;
+#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+ mem_delete (mem_find (block->data));
+#endif
+ xfree (block);
+ }
+ else
+ bprev = &block->next;
+ }
+
+ /* Sweep large vectors. */
+
+ for (vector = large_vectors; vector; vector = *vprev)
+ {
+ if (VECTOR_MARKED_P (vector))
+ {
+ VECTOR_UNMARK (vector);
+ total_vectors++;
+ if (vector->header.size & PSEUDOVECTOR_FLAG)
+ {
+ struct Lisp_Bool_Vector *b = (struct Lisp_Bool_Vector *) vector;
+
+ /* All non-bool pseudovectors are small enough to be allocated
+ from vector blocks. This code should be redesigned if some
+ pseudovector type grows beyond VBLOCK_BYTES_MAX. */
+ eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR));
+
+ total_vector_slots
+ += (bool_header_size
+ + ((b->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR)) / word_size;
+ }
+ else
+ total_vector_slots
+ += header_size / word_size + vector->header.size;
+ vprev = &vector->header.next.vector;
+ }
+ else
+ {
+ *vprev = vector->header.next.vector;
+ lisp_free (vector);
+ }
+ }
+}
+
/* Value is a pointer to a newly allocated Lisp_Vector structure
with room for LEN Lisp_Objects. */
static struct Lisp_Vector *
-allocate_vectorlike (EMACS_INT len)
+allocate_vectorlike (ptrdiff_t len)
{
struct Lisp_Vector *p;
- size_t nbytes;
MALLOC_BLOCK_INPUT;
+ if (len == 0)
+ p = XVECTOR (zero_vector);
+ else
+ {
+ size_t nbytes = header_size + len * word_size;
+
#ifdef DOUG_LEA_MALLOC
- /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
- because mapped region contents are not preserved in
- a dumped Emacs. */
- mallopt (M_MMAP_MAX, 0);
+ /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
+ because mapped region contents are not preserved in
+ a dumped Emacs. */
+ mallopt (M_MMAP_MAX, 0);
#endif
- /* This gets triggered by code which I haven't bothered to fix. --Stef */
- /* eassert (!handling_signal); */
-
- nbytes = header_size + len * word_size;
- p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
+ if (nbytes <= VBLOCK_BYTES_MAX)
+ p = allocate_vector_from_block (vroundup (nbytes));
+ else
+ {
+ p = lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
+ p->header.next.vector = large_vectors;
+ large_vectors = p;
+ }
#ifdef DOUG_LEA_MALLOC
- /* Back to a reasonable maximum of mmap'ed areas. */
- mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+ /* Back to a reasonable maximum of mmap'ed areas. */
+ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
- consing_since_gc += nbytes;
- vector_cells_consed += len;
-
- p->header.next.vector = all_vectors;
- all_vectors = p;
+ consing_since_gc += nbytes;
+ vector_cells_consed += len;
+ }
MALLOC_UNBLOCK_INPUT;
/* Allocate other vector-like structures. */
struct Lisp_Vector *
-allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag)
+allocate_pseudovector (int memlen, int lisplen, int tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
int i;
return v;
}
+struct buffer *
+allocate_buffer (void)
+{
+ struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER);
+
+ XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text)
+ - header_size) / word_size);
+ /* Put B on the chain of all buffers including killed ones. */
+ b->header.next.buffer = all_buffers;
+ all_buffers = b;
+ /* Note that the rest fields of B are not initialized. */
+ return b;
+}
+
struct Lisp_Hash_Table *
allocate_hash_table (void)
{
return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE);
}
-
struct window *
allocate_window (void)
{
- return ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW);
-}
+ struct window *w;
+ w = ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW);
+ /* Users assumes that non-Lisp data is zeroed. */
+ memset (&w->current_matrix, 0,
+ sizeof (*w) - offsetof (struct window, current_matrix));
+ return w;
+}
struct terminal *
allocate_terminal (void)
{
- struct terminal *t = ALLOCATE_PSEUDOVECTOR (struct terminal,
- next_terminal, PVEC_TERMINAL);
- /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
- memset (&t->next_terminal, 0,
- (char*) (t + 1) - (char*) &t->next_terminal);
+ struct terminal *t;
+ t = ALLOCATE_PSEUDOVECTOR (struct terminal, next_terminal, PVEC_TERMINAL);
+ /* Users assumes that non-Lisp data is zeroed. */
+ memset (&t->next_terminal, 0,
+ sizeof (*t) - offsetof (struct terminal, next_terminal));
return t;
}
struct frame *
allocate_frame (void)
{
- struct frame *f = ALLOCATE_PSEUDOVECTOR (struct frame,
- face_cache, PVEC_FRAME);
- /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
+ struct frame *f;
+
+ f = ALLOCATE_PSEUDOVECTOR (struct frame, face_cache, PVEC_FRAME);
+ /* Users assumes that non-Lisp data is zeroed. */
memset (&f->face_cache, 0,
- (char *) (f + 1) - (char *) &f->face_cache);
+ sizeof (*f) - offsetof (struct frame, face_cache));
return f;
}
-
struct Lisp_Process *
allocate_process (void)
{
- return ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
-}
+ struct Lisp_Process *p;
+ p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
+ /* Users assumes that non-Lisp data is zeroed. */
+ memset (&p->pid, 0,
+ sizeof (*p) - offsetof (struct Lisp_Process, pid));
+ return p;
+}
DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
(register Lisp_Object length, Lisp_Object init)
{
Lisp_Object vector;
- register EMACS_INT sizei;
- register EMACS_INT i;
+ register ptrdiff_t sizei;
+ register ptrdiff_t i;
register struct Lisp_Vector *p;
CHECK_NATNUM (length);
- sizei = XFASTINT (length);
- p = allocate_vector (sizei);
+ p = allocate_vector (XFASTINT (length));
+ sizei = XFASTINT (length);
for (i = 0; i < sizei; i++)
p->contents[i] = init;
return val;
}
+void
+make_byte_code (struct Lisp_Vector *v)
+{
+ if (v->header.size > 1 && STRINGP (v->contents[1])
+ && STRING_MULTIBYTE (v->contents[1]))
+ /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
+ earlier because they produced a raw 8-bit string for byte-code
+ and now such a byte-code string is loaded as multibyte while
+ raw 8-bit characters converted to multibyte form. Thus, now we
+ must convert them back to the original unibyte form. */
+ v->contents[1] = Fstring_as_unibyte (v->contents[1]);
+ XSETPVECTYPE (v, PVEC_COMPILED);
+}
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements.
ptrdiff_t i;
register struct Lisp_Vector *p;
- XSETFASTINT (len, nargs);
- if (!NILP (Vpurify_flag))
- val = make_pure_vector (nargs);
- else
- val = Fmake_vector (len, Qnil);
+ /* We used to purecopy everything here, if purify-flga was set. This worked
+ OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
+ dangerous, since make-byte-code is used during execution to build
+ closures, so any closure built during the preload phase would end up
+ copied into pure space, including its free variables, which is sometimes
+ just wasteful and other times plainly wrong (e.g. those free vars may want
+ to be setcar'd). */
- if (nargs > 1 && STRINGP (args[1]) && STRING_MULTIBYTE (args[1]))
- /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
- earlier because they produced a raw 8-bit string for byte-code
- and now such a byte-code string is loaded as multibyte while
- raw 8-bit characters converted to multibyte form. Thus, now we
- must convert them back to the original unibyte form. */
- args[1] = Fstring_as_unibyte (args[1]);
+ XSETFASTINT (len, nargs);
+ val = Fmake_vector (len, Qnil);
p = XVECTOR (val);
for (i = 0; i < nargs; i++)
- {
- if (!NILP (Vpurify_flag))
- args[i] = Fpurecopy (args[i]);
- p->contents[i] = args[i];
- }
- XSETPVECTYPE (p, PVEC_COMPILED);
+ p->contents[i] = args[i];
+ make_byte_code (p);
XSETCOMPILED (val, p);
return val;
}
Symbol Allocation
***********************************************************************/
+/* Like struct Lisp_Symbol, but padded so that the size is a multiple
+ of the required alignment if LSB tags are used. */
+
+union aligned_Lisp_Symbol
+{
+ struct Lisp_Symbol s;
+#if USE_LSB_TAG
+ unsigned char c[(sizeof (struct Lisp_Symbol) + GCALIGNMENT - 1)
+ & -GCALIGNMENT];
+#endif
+};
+
/* Each symbol_block is just under 1020 bytes long, since malloc
really allocates in units of powers of two and uses 4 bytes for its
- own overhead. */
+ own overhead. */
#define SYMBOL_BLOCK_SIZE \
- ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol))
+ ((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol))
struct symbol_block
{
/* Place `symbols' first, to preserve alignment. */
- struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
+ union aligned_Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
struct symbol_block *next;
};
structure in it. */
static struct symbol_block *symbol_block;
-static int symbol_block_index;
+static int symbol_block_index = SYMBOL_BLOCK_SIZE;
/* List of free symbols. */
static struct Lisp_Symbol *symbol_free_list;
-
-/* Initialize symbol allocation. */
-
-static void
-init_symbol (void)
-{
- symbol_block = NULL;
- symbol_block_index = SYMBOL_BLOCK_SIZE;
- symbol_free_list = 0;
-}
-
-
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
doc: /* Return a newly allocated uninterned symbol whose name is NAME.
Its value and function definition are void, and its property list is nil. */)
CHECK_STRING (name);
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (symbol_free_list)
{
if (symbol_block_index == SYMBOL_BLOCK_SIZE)
{
- struct symbol_block *new;
- new = (struct symbol_block *) lisp_malloc (sizeof *new,
- MEM_TYPE_SYMBOL);
+ struct symbol_block *new
+ = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL);
new->next = symbol_block;
symbol_block = new;
symbol_block_index = 0;
+ total_free_symbols += SYMBOL_BLOCK_SIZE;
}
- XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
+ XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index].s);
symbol_block_index++;
}
MALLOC_UNBLOCK_INPUT;
p = XSYMBOL (val);
- p->xname = name;
- p->plist = Qnil;
+ set_symbol_name (val, name);
+ set_symbol_plist (val, Qnil);
p->redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (p, Qunbound);
- 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;
p->declared_special = 0;
consing_since_gc += sizeof (struct Lisp_Symbol);
symbols_consed++;
+ total_free_symbols--;
return val;
}
Marker (Misc) Allocation
***********************************************************************/
+/* Like union Lisp_Misc, but padded so that its size is a multiple of
+ the required alignment when LSB tags are used. */
+
+union aligned_Lisp_Misc
+{
+ union Lisp_Misc m;
+#if USE_LSB_TAG
+ unsigned char c[(sizeof (union Lisp_Misc) + GCALIGNMENT - 1)
+ & -GCALIGNMENT];
+#endif
+};
+
/* Allocation of markers and other objects that share that structure.
Works like allocation of conses. */
#define MARKER_BLOCK_SIZE \
- ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
+ ((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc))
struct marker_block
{
/* Place `markers' first, to preserve alignment. */
- union Lisp_Misc markers[MARKER_BLOCK_SIZE];
+ union aligned_Lisp_Misc markers[MARKER_BLOCK_SIZE];
struct marker_block *next;
};
static struct marker_block *marker_block;
-static int marker_block_index;
+static int marker_block_index = MARKER_BLOCK_SIZE;
static union Lisp_Misc *marker_free_list;
-static void
-init_marker (void)
-{
- marker_block = NULL;
- marker_block_index = MARKER_BLOCK_SIZE;
- marker_free_list = 0;
-}
-
-/* Return a newly allocated Lisp_Misc object, with no substructure. */
+/* Return a newly allocated Lisp_Misc object of specified TYPE. */
-Lisp_Object
-allocate_misc (void)
+static Lisp_Object
+allocate_misc (enum Lisp_Misc_Type type)
{
Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (marker_free_list)
{
if (marker_block_index == MARKER_BLOCK_SIZE)
{
- struct marker_block *new;
- new = (struct marker_block *) lisp_malloc (sizeof *new,
- MEM_TYPE_MISC);
+ struct marker_block *new = lisp_malloc (sizeof *new, MEM_TYPE_MISC);
new->next = marker_block;
marker_block = new;
marker_block_index = 0;
total_free_markers += MARKER_BLOCK_SIZE;
}
- XSETMISC (val, &marker_block->markers[marker_block_index]);
+ XSETMISC (val, &marker_block->markers[marker_block_index].m);
marker_block_index++;
}
--total_free_markers;
consing_since_gc += sizeof (union Lisp_Misc);
misc_objects_consed++;
+ XMISCTYPE (val) = type;
XMISCANY (val)->gcmarkbit = 0;
return val;
}
XMISCTYPE (misc) = Lisp_Misc_Free;
XMISC (misc)->u_free.chain = marker_free_list;
marker_free_list = XMISC (misc);
-
+ consing_since_gc -= sizeof (union Lisp_Misc);
total_free_markers++;
}
register Lisp_Object val;
register struct Lisp_Save_Value *p;
- val = allocate_misc ();
- XMISCTYPE (val) = Lisp_Misc_Save_Value;
+ val = allocate_misc (Lisp_Misc_Save_Value);
p = XSAVE_VALUE (val);
p->pointer = pointer;
p->integer = integer;
return val;
}
+/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
+
+Lisp_Object
+build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist)
+{
+ register Lisp_Object overlay;
+
+ overlay = allocate_misc (Lisp_Misc_Overlay);
+ OVERLAY_START (overlay) = start;
+ OVERLAY_END (overlay) = end;
+ set_overlay_plist (overlay, plist);
+ XOVERLAY (overlay)->next = NULL;
+ return overlay;
+}
+
DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
doc: /* Return a newly allocated marker which does not point at any place. */)
(void)
register Lisp_Object val;
register struct Lisp_Marker *p;
- val = allocate_misc ();
- XMISCTYPE (val) = Lisp_Misc_Marker;
+ val = allocate_misc (Lisp_Misc_Marker);
p = XMARKER (val);
p->buffer = 0;
p->bytepos = 0;
return val;
}
+/* Return a newly allocated marker which points into BUF
+ at character position CHARPOS and byte position BYTEPOS. */
+
+Lisp_Object
+build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
+{
+ Lisp_Object obj;
+ struct Lisp_Marker *m;
+
+ /* No dead buffers here. */
+ eassert (BUFFER_LIVE_P (buf));
+
+ /* Every character is at least one byte. */
+ eassert (charpos <= bytepos);
+
+ obj = allocate_misc (Lisp_Misc_Marker);
+ m = XMARKER (obj);
+ m->buffer = buf;
+ m->charpos = charpos;
+ m->bytepos = bytepos;
+ m->insertion_type = 0;
+ m->next = BUF_MARKERS (buf);
+ BUF_MARKERS (buf) = m;
+ return obj;
+}
+
/* Put MARKER back on the free list after using it temporarily. */
void
memory_full (size_t nbytes)
{
/* Do not go into hysterics merely because a large request failed. */
- int enough_free_memory = 0;
+ bool enough_free_memory = 0;
if (SPARE_MEMORY < nbytes)
{
void *p;
lisp_free (spare_memory[i]);
spare_memory[i] = 0;
}
-
- /* Record the space now used. When it decreases substantially,
- we can refill the memory reserve. */
-#if !defined SYSTEM_MALLOC && !defined SYNC_INPUT
- bytes_used_when_full = BYTES_USED;
-#endif
}
/* This used to call error, but if we've run out of memory, we could
{
#ifndef SYSTEM_MALLOC
if (spare_memory[0] == 0)
- spare_memory[0] = (char *) malloc (SPARE_MEMORY);
+ spare_memory[0] = malloc (SPARE_MEMORY);
if (spare_memory[1] == 0)
- spare_memory[1] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[1] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_SPARE);
if (spare_memory[2] == 0)
- spare_memory[2] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[2] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_SPARE);
if (spare_memory[3] == 0)
- spare_memory[3] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[3] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_SPARE);
if (spare_memory[4] == 0)
- spare_memory[4] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[4] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_SPARE);
if (spare_memory[5] == 0)
- spare_memory[5] = (char *) lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_STRING);
+ spare_memory[5] = lisp_malloc (sizeof (struct string_block),
+ MEM_TYPE_SPARE);
if (spare_memory[6] == 0)
- spare_memory[6] = (char *) lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_STRING);
+ spare_memory[6] = lisp_malloc (sizeof (struct string_block),
+ MEM_TYPE_SPARE);
if (spare_memory[0] && spare_memory[1] && spare_memory[5])
Vmemory_full = Qnil;
#endif
while (c != MEM_NIL)
{
if (start >= c->start && start < c->end)
- abort ();
+ emacs_abort ();
parent = c;
c = start < c->start ? c->left : c->right;
}
/* Create a new node. */
#ifdef GC_MALLOC_CHECK
- x = (struct mem_node *) _malloc_internal (sizeof *x);
+ x = malloc (sizeof *x);
if (x == NULL)
- abort ();
+ emacs_abort ();
#else
- x = (struct mem_node *) xmalloc (sizeof *x);
+ x = xmalloc (sizeof *x);
#endif
x->start = start;
x->end = end;
mem_delete_fixup (x);
#ifdef GC_MALLOC_CHECK
- _free_internal (y);
+ free (y);
#else
xfree (y);
#endif
/* Value is non-zero if P is a pointer to a live Lisp string on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static inline bool
live_string_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_STRING)
/* Value is non-zero if P is a pointer to a live Lisp cons on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static inline bool
live_cons_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
/* Value is non-zero if P is a pointer to a live Lisp symbol on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static inline bool
live_symbol_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
&& offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
&& (b != symbol_block
|| offset / sizeof b->symbols[0] < symbol_block_index)
- && !EQ (((struct Lisp_Symbol *) p)->function, Vdead));
+ && !EQ (((struct Lisp_Symbol *)p)->function, Vdead));
}
else
return 0;
/* Value is non-zero if P is a pointer to a live Lisp float on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static inline bool
live_float_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_FLOAT)
/* Value is non-zero if P is a pointer to a live Lisp Misc on
the heap. M is a pointer to the mem_block for P. */
-static inline int
+static inline bool
live_misc_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
/* Value is non-zero if P is a pointer to a live vector-like object.
M is a pointer to the mem_block for P. */
-static inline int
+static inline bool
live_vector_p (struct mem_node *m, void *p)
{
- return (p == m->start && m->type == MEM_TYPE_VECTORLIKE);
+ if (m->type == MEM_TYPE_VECTOR_BLOCK)
+ {
+ /* This memory node corresponds to a vector block. */
+ struct vector_block *block = (struct vector_block *) m->start;
+ struct Lisp_Vector *vector = (struct Lisp_Vector *) block->data;
+
+ /* P is in the block's allocation range. Scan the block
+ up to P and see whether P points to the start of some
+ vector which is not on a free list. FIXME: check whether
+ some allocation patterns (probably a lot of short vectors)
+ may cause a substantial overhead of this loop. */
+ while (VECTOR_IN_BLOCK (vector, block)
+ && vector <= (struct Lisp_Vector *) p)
+ {
+ if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
+ vector = ADVANCE (vector, (vector->header.size
+ & PSEUDOVECTOR_SIZE_MASK));
+ else if (vector == p)
+ return 1;
+ else
+ vector = ADVANCE (vector, vector->header.next.nbytes);
+ }
+ }
+ else if (m->type == MEM_TYPE_VECTORLIKE && p == m->start)
+ /* This memory node corresponds to a large vector. */
+ return 1;
+ return 0;
}
/* Value is non-zero if P is a pointer to a live buffer. M is a
pointer to the mem_block for P. */
-static inline int
+static inline bool
live_buffer_p (struct mem_node *m, void *p)
{
/* P must point to the start of the block, and the buffer
must not have been killed. */
return (m->type == MEM_TYPE_BUFFER
&& p == m->start
- && !NILP (((struct buffer *) p)->BUFFER_INTERNAL_FIELD (name)));
+ && !NILP (((struct buffer *) p)->INTERNAL_FIELD (name)));
}
#endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
if (m != MEM_NIL)
{
- int mark_p = 0;
+ bool mark_p = 0;
switch (XTYPE (obj))
{
{
struct mem_node *m;
- /* Quickly rule out some values which can't point to Lisp data. */
- if ((intptr_t) p %
-#ifdef USE_LSB_TAG
- 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */
-#else
- 2 /* We assume that Lisp data is aligned on even addresses. */
-#endif
- )
+ /* Quickly rule out some values which can't point to Lisp data.
+ 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 ? GCALIGNMENT : 2))
return;
m = mem_find (p);
switch (m->type)
{
case MEM_TYPE_NON_LISP:
+ case MEM_TYPE_SPARE:
/* Nothing to do; not a pointer to Lisp memory. */
break;
break;
case MEM_TYPE_VECTORLIKE:
+ case MEM_TYPE_VECTOR_BLOCK:
if (live_vector_p (m, p))
{
Lisp_Object tem;
break;
default:
- abort ();
+ emacs_abort ();
}
if (!NILP (obj))
}
-/* Alignment of Lisp_Object and pointer values. Use offsetof, as it
- sometimes returns a smaller alignment than GCC's __alignof__ and
- mark_memory might miss objects if __alignof__ were used. For
- example, on x86 with WIDE_EMACS_INT, __alignof__ (Lisp_Object) is 8
- but GC_LISP_OBJECT_ALIGNMENT should be 4. */
-#ifndef GC_LISP_OBJECT_ALIGNMENT
-# define GC_LISP_OBJECT_ALIGNMENT offsetof (struct {char a; Lisp_Object b;}, b)
+/* Alignment of pointer values. Use alignof, as it sometimes returns
+ a smaller alignment than GCC's __alignof__ and mark_memory might
+ miss objects if __alignof__ were used. */
+#define GC_POINTER_ALIGNMENT alignof (void *)
+
+/* Define POINTERS_MIGHT_HIDE_IN_OBJECTS to 1 if marking via C pointers does
+ not suffice, which is the typical case. A host where a Lisp_Object is
+ wider than a pointer might allocate a Lisp_Object in non-adjacent halves.
+ If USE_LSB_TAG, the bottom half is not a valid pointer, but it should
+ suffice to widen it to to a Lisp_Object and check it that way. */
+#if USE_LSB_TAG || VAL_MAX < UINTPTR_MAX
+# if !USE_LSB_TAG && VAL_MAX < UINTPTR_MAX >> GCTYPEBITS
+ /* If tag bits straddle pointer-word boundaries, neither mark_maybe_pointer
+ nor mark_maybe_object can follow the pointers. This should not occur on
+ any practical porting target. */
+# error "MSB type bits straddle pointer-word boundaries"
+# endif
+ /* Marking via C pointers does not suffice, because Lisp_Objects contain
+ pointer words that hold pointers ORed with type bits. */
+# define POINTERS_MIGHT_HIDE_IN_OBJECTS 1
+#else
+ /* Marking via C pointers suffices, because Lisp_Objects contain pointer
+ words that hold unmodified pointers. */
+# define POINTERS_MIGHT_HIDE_IN_OBJECTS 0
#endif
-#define GC_POINTER_ALIGNMENT offsetof (struct {char a; void *b;}, b)
/* Mark Lisp objects referenced from the address range START+OFFSET..END
or END+OFFSET..START. */
static void
mark_memory (void *start, void *end)
+#if defined (__clang__) && defined (__has_feature)
+#if __has_feature(address_sanitizer)
+ /* Do not allow -faddress-sanitizer to check this function, since it
+ crosses the function stack boundary, and thus would yield many
+ false positives. */
+ __attribute__((no_address_safety_analysis))
+#endif
+#endif
{
- Lisp_Object *p;
void **pp;
int i;
end = tem;
}
- /* Mark Lisp_Objects. */
- for (p = start; (void *) p < end; p++)
- for (i = 0; i < sizeof *p; i += GC_LISP_OBJECT_ALIGNMENT)
- mark_maybe_object (*(Lisp_Object *) ((char *) p + i));
-
/* Mark Lisp data pointed to. This is necessary because, in some
situations, the C compiler optimizes Lisp objects away, so that
only a pointer to them remains. Example:
for (pp = start; (void *) pp < end; pp++)
for (i = 0; i < sizeof *pp; i += GC_POINTER_ALIGNMENT)
{
- void *w = *(void **) ((char *) pp + i);
- mark_maybe_pointer (w);
-
-#ifdef USE_LSB_TAG
- /* A host where a Lisp_Object is wider than a pointer might
- allocate a Lisp_Object in non-adjacent halves. If
- USE_LSB_TAG, the bottom half is not a valid pointer, so
- widen it to to a Lisp_Object and check it that way. */
- if (sizeof w < sizeof (Lisp_Object))
- mark_maybe_object (widen_to_Lisp_Object (w));
-#endif
+ void *p = *(void **) ((char *) pp + i);
+ mark_maybe_pointer (p);
+ if (POINTERS_MIGHT_HIDE_IN_OBJECTS)
+ mark_maybe_object (XIL ((intptr_t) p));
}
}
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
-static int setjmp_tested_p, longjmps_done;
+static bool setjmp_tested_p;
+static int longjmps_done;
#define SETJMP_WILL_LIKELY_WORK "\
\n\
{
char buf[10];
register int x;
- jmp_buf jbuf;
- int result = 0;
+ sys_jmp_buf jbuf;
/* Arrange for X to be put in a register. */
sprintf (buf, "1");
x = strlen (buf);
x = 2 * x - 1;
- setjmp (jbuf);
+ sys_setjmp (jbuf);
if (longjmps_done == 1)
{
/* Came here after the longjmp at the end of the function.
++longjmps_done;
x = 2;
if (longjmps_done == 1)
- longjmp (jbuf, 1);
+ sys_longjmp (jbuf, 1);
}
#endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */
if (!survives_gc_p (p->var[i]))
/* FIXME: It's not necessarily a bug. It might just be that the
GCPRO is unnecessary or should release the object sooner. */
- abort ();
+ emacs_abort ();
}
#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
/* jmp_buf may not be aligned enough on darwin-ppc64 */
union aligned_jmpbuf {
Lisp_Object o;
- jmp_buf j;
+ sys_jmp_buf j;
} j;
- volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
+ volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base;
#endif
/* This trick flushes the register windows so that all the state of
the process is contained in the stack. */
}
#endif /* GC_SETJMP_WORKS */
- setjmp (j.j);
+ sys_setjmp (j.j);
end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
#endif /* not HAVE___BUILTIN_UNWIND_INIT */
if (pipe (fd) == 0)
{
- int valid = (emacs_write (fd[1], (char *) p, 16) == 16);
+ bool valid = emacs_write (fd[1], (char *) p, 16) == 16;
emacs_close (fd[1]);
emacs_close (fd[0]);
return valid;
#endif
}
-/* Return 1 if OBJ is a valid lisp object.
+/* Return 2 if OBJ is a killed or special buffer object.
+ Return 1 if OBJ is a valid lisp object.
Return 0 if OBJ is NOT a valid lisp object.
Return -1 if we cannot validate OBJ.
This function can be quite slow,
if (PURE_POINTER_P (p))
return 1;
+ if (p == &buffer_defaults || p == &buffer_local_symbols)
+ return 2;
+
#if !GC_MARK_STACK
return valid_pointer_p (p);
#else
switch (m->type)
{
case MEM_TYPE_NON_LISP:
+ case MEM_TYPE_SPARE:
return 0;
case MEM_TYPE_BUFFER:
- return live_buffer_p (m, p);
+ return live_buffer_p (m, p) ? 1 : 2;
case MEM_TYPE_CONS:
return live_cons_p (m, p);
return live_float_p (m, p);
case MEM_TYPE_VECTORLIKE:
+ case MEM_TYPE_VECTOR_BLOCK:
return live_vector_p (m, p);
default:
pointer to it. TYPE is the Lisp type for which the memory is
allocated. TYPE < 0 means it's not used for a Lisp object. */
-static POINTER_TYPE *
+static void *
pure_alloc (size_t size, int type)
{
- POINTER_TYPE *result;
-#ifdef USE_LSB_TAG
- size_t alignment = (1 << GCTYPEBITS);
+ void *result;
+#if USE_LSB_TAG
+ size_t alignment = GCALIGNMENT;
#else
- size_t alignment = sizeof (EMACS_INT);
+ size_t alignment = alignof (EMACS_INT);
/* Give Lisp_Floats an extra alignment. */
if (type == Lisp_Float)
- {
-#if defined __GNUC__ && __GNUC__ >= 2
- alignment = __alignof (struct Lisp_Float);
-#else
- alignment = sizeof (struct Lisp_Float);
-#endif
- }
+ alignment = alignof (struct Lisp_Float);
#endif
again:
/* Don't allocate a large amount here,
because it might get mmap'd and then its address
might not be usable. */
- purebeg = (char *) xmalloc (10000);
+ purebeg = xmalloc (10000);
pure_size = 10000;
pure_bytes_used_before_overflow += pure_bytes_used - size;
pure_bytes_used = 0;
address. Return NULL if not found. */
static char *
-find_string_data_in_pure (const char *data, EMACS_INT nbytes)
+find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
{
int i;
- EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max;
+ ptrdiff_t skip, bm_skip[256], last_char_skip, infinity, start, start_max;
const unsigned char *p;
char *non_lisp_beg;
- if (pure_bytes_used_non_lisp < nbytes + 1)
+ if (pure_bytes_used_non_lisp <= nbytes)
return NULL;
/* Set up the Boyer-Moore table. */
/* Return a string allocated in pure space. DATA is a buffer holding
NCHARS characters, and NBYTES bytes of string data. MULTIBYTE
- non-zero means make the result string multibyte.
+ means make the result string multibyte.
Must get an error if pure storage is full, since if it cannot hold
a large string it may be able to hold conses that point to that
Lisp_Object
make_pure_string (const char *data,
- EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, bool 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;
}
-/* Return a string a string allocated in pure space. Do not allocate
- the string data, just point to DATA. */
+/* Return a string allocated in pure space. Do not
+ allocate the string data, just point to DATA. */
Lisp_Object
-make_pure_c_string (const char *data)
+make_pure_c_string (const char *data, ptrdiff_t nchars)
{
Lisp_Object string;
- struct Lisp_String *s;
- EMACS_INT nchars = strlen (data);
-
- 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;
}
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));
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;
/* Return a vector with room for LEN Lisp_Objects allocated from
pure space. */
-Lisp_Object
-make_pure_vector (EMACS_INT len)
+static Lisp_Object
+make_pure_vector (ptrdiff_t len)
{
Lisp_Object new;
- struct Lisp_Vector *p;
- size_t size = (offsetof (struct Lisp_Vector, contents)
- + len * sizeof (Lisp_Object));
-
- p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike);
+ size_t size = header_size + len * word_size;
+ struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike);
XSETVECTOR (new, p);
XVECTOR (new)->header.size = len;
return new;
else if (COMPILEDP (obj) || VECTORP (obj))
{
register struct Lisp_Vector *vec;
- register EMACS_INT i;
- EMACS_INT size;
+ register ptrdiff_t i;
+ ptrdiff_t size;
size = ASIZE (obj);
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
vec = XVECTOR (make_pure_vector (size));
for (i = 0; i < size; i++)
- vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
+ vec->contents[i] = Fpurecopy (AREF (obj, i));
if (COMPILEDP (obj))
{
XSETPVECTYPE (vec, PVEC_COMPILED);
{
staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
- abort ();
+ emacs_abort ();
}
\f
/* Temporarily prevent garbage collection. */
-int
+ptrdiff_t
inhibit_garbage_collection (void)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
return count;
}
+/* Used to avoid possible overflows when
+ converting from C to Lisp integers. */
+
+static inline Lisp_Object
+bounded_number (EMACS_INT number)
+{
+ return make_number (min (MOST_POSITIVE_FIXNUM, number));
+}
+
+/* Calculate total bytes of live objects. */
+
+static size_t
+total_bytes_of_live_objects (void)
+{
+ size_t tot = 0;
+ tot += total_conses * sizeof (struct Lisp_Cons);
+ tot += total_symbols * sizeof (struct Lisp_Symbol);
+ tot += total_markers * sizeof (union Lisp_Misc);
+ tot += total_string_bytes;
+ tot += total_vector_slots * word_size;
+ tot += total_floats * sizeof (struct Lisp_Float);
+ tot += total_intervals * sizeof (struct interval);
+ tot += total_strings * sizeof (struct Lisp_String);
+ return tot;
+}
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
doc: /* Reclaim storage for Lisp objects no longer needed.
Garbage collection happens automatically if you cons more than
`gc-cons-threshold' bytes of Lisp data since previous garbage collection.
-`garbage-collect' normally returns a list with info on amount of space in use:
- ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
- (USED-MISCS . FREE-MISCS) USED-STRING-CHARS USED-VECTOR-SLOTS
- (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
- (USED-STRINGS . FREE-STRINGS))
+`garbage-collect' normally returns a list with info on amount of space in use,
+where each entry has the form (NAME SIZE USED FREE), where:
+- NAME is a symbol describing the kind of objects this entry represents,
+- SIZE is the number of bytes used by each one,
+- USED is the number of those objects that were found live in the heap,
+- FREE is the number of those objects that are not live but that Emacs
+ keeps around for future allocations (maybe because it does not know how
+ to return them to the OS).
However, if there was overflow in pure space, `garbage-collect'
returns nil, because real GC can't be done.
See Info node `(elisp)Garbage Collection'. */)
(void)
{
- register struct specbinding *bind;
+ struct specbinding *bind;
+ struct buffer *nextb;
char stack_top_variable;
ptrdiff_t i;
- int message_p;
- Lisp_Object total[8];
- int count = SPECPDL_INDEX ();
- EMACS_TIME t1, t2, t3;
+ bool message_p;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ EMACS_TIME start;
+ Lisp_Object retval = Qnil;
+ size_t tot_before = 0;
+ struct backtrace backtrace;
if (abort_on_gc)
- abort ();
+ emacs_abort ();
/* Can't GC if pure storage overflowed because we can't determine
if something is a pure object or not. */
if (pure_bytes_used_before_overflow)
return Qnil;
- CHECK_CONS_LIST ();
+ /* Record this function, so it appears on the profiler's backtraces. */
+ backtrace.next = backtrace_list;
+ backtrace.function = &Qautomatic_gc;
+ backtrace.args = &Qautomatic_gc;
+ backtrace.nargs = 0;
+ backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
+
+ check_cons_list ();
/* Don't keep undo information around forever.
Do this early on, so it is no problem if the user quits. */
- {
- register struct buffer *nextb = all_buffers;
-
- while (nextb)
- {
- /* If a buffer's undo list is Qt, that means that undo is
- turned off in that buffer. Calling truncate_undo_list on
- Qt tends to return NULL, which effectively turns undo back on.
- So don't call truncate_undo_list if undo_list is Qt. */
- if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
- truncate_undo_list (nextb);
-
- /* Shrink buffer gaps, but skip indirect and dead buffers. */
- if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name))
- && ! nextb->text->inhibit_shrinking)
- {
- /* If a buffer's gap size is more than 10% of the buffer
- size, or larger than 2000 bytes, then shrink it
- accordingly. Keep a minimum size of 20 bytes. */
- int size = min (2000, max (20, (nextb->text->z_byte / 10)));
-
- if (nextb->text->gap_size > size)
- {
- struct buffer *save_current = current_buffer;
- current_buffer = nextb;
- make_gap (-(nextb->text->gap_size - size));
- current_buffer = save_current;
- }
- }
+ FOR_EACH_BUFFER (nextb)
+ compact_buffer (nextb);
- nextb = nextb->header.next.buffer;
- }
- }
+ if (profiler_memory_running)
+ tot_before = total_bytes_of_live_objects ();
- EMACS_GET_TIME (t1);
+ start = current_emacs_time ();
/* In case user calls debug_print during GC,
don't let that cause a recursive GC. */
{
if (stack_copy_size < stack_size)
{
- stack_copy = (char *) xrealloc (stack_copy, stack_size);
+ stack_copy = xrealloc (stack_copy, stack_size);
stack_copy_size = stack_size;
}
memcpy (stack_copy, stack, stack_size);
if (garbage_collection_messages)
message1_nolog ("Garbage collecting...");
- BLOCK_INPUT;
+ block_input ();
shrink_regexp_cache ();
gc_in_progress = 1;
- /* clear_marks (); */
-
/* Mark all the special slots that serve as the roots of accessibility. */
+ mark_buffer (&buffer_defaults);
+ mark_buffer (&buffer_local_symbols);
+
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
}
mark_terminals ();
mark_kboards ();
- mark_ttys ();
#ifdef USE_GTK
- {
- extern void xg_mark_data (void);
- xg_mark_data ();
- }
+ xg_mark_data ();
#endif
#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
Look thru every buffer's undo list
for elements that update markers that were not marked,
and delete them. */
- {
- register struct buffer *nextb = all_buffers;
-
- while (nextb)
- {
- /* If a buffer's undo list is Qt, that means that undo is
- turned off in that buffer. Calling truncate_undo_list on
- Qt tends to return NULL, which effectively turns undo back on.
- So don't call truncate_undo_list if undo_list is Qt. */
- if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
- {
- Lisp_Object tail, prev;
- tail = nextb->BUFFER_INTERNAL_FIELD (undo_list);
- prev = Qnil;
- while (CONSP (tail))
- {
- if (CONSP (XCAR (tail))
- && MARKERP (XCAR (XCAR (tail)))
- && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
- {
- if (NILP (prev))
- nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
- else
- {
- tail = XCDR (tail);
- XSETCDR (prev, tail);
- }
- }
- else
- {
- prev = tail;
- tail = XCDR (tail);
- }
- }
- }
- /* Now that we have stripped the elements that need not be in the
- undo_list any more, we can finally mark the list. */
- mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
-
- nextb = nextb->header.next.buffer;
- }
- }
+ FOR_EACH_BUFFER (nextb)
+ {
+ /* If a buffer's undo list is Qt, that means that undo is
+ turned off in that buffer. Calling truncate_undo_list on
+ Qt tends to return NULL, which effectively turns undo back on.
+ So don't call truncate_undo_list if undo_list is Qt. */
+ if (! EQ (nextb->INTERNAL_FIELD (undo_list), Qt))
+ {
+ Lisp_Object tail, prev;
+ tail = nextb->INTERNAL_FIELD (undo_list);
+ prev = Qnil;
+ while (CONSP (tail))
+ {
+ if (CONSP (XCAR (tail))
+ && MARKERP (XCAR (XCAR (tail)))
+ && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
+ {
+ if (NILP (prev))
+ nextb->INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
+ else
+ {
+ tail = XCDR (tail);
+ XSETCDR (prev, tail);
+ }
+ }
+ else
+ {
+ prev = tail;
+ tail = XCDR (tail);
+ }
+ }
+ }
+ /* Now that we have stripped the elements that need not be in the
+ undo_list any more, we can finally mark the list. */
+ mark_object (nextb->INTERNAL_FIELD (undo_list));
+ }
gc_sweep ();
dump_zombies ();
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
- CHECK_CONS_LIST ();
+ check_cons_list ();
- /* clear_marks (); */
gc_in_progress = 0;
consing_since_gc = 0;
- if (gc_cons_threshold < 10000)
- gc_cons_threshold = 10000;
+ if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10)
+ gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10;
gc_relative_threshold = 0;
if (FLOATP (Vgc_cons_percentage))
{ /* Set gc_cons_combined_threshold. */
- double tot = 0;
-
- tot += total_conses * sizeof (struct Lisp_Cons);
- tot += total_symbols * sizeof (struct Lisp_Symbol);
- tot += total_markers * sizeof (union Lisp_Misc);
- tot += total_string_size;
- tot += total_vector_size * sizeof (Lisp_Object);
- tot += total_floats * sizeof (struct Lisp_Float);
- tot += total_intervals * sizeof (struct interval);
- tot += total_strings * sizeof (struct Lisp_String);
+ double tot = total_bytes_of_live_objects ();
tot *= XFLOAT_DATA (Vgc_cons_percentage);
if (0 < tot)
}
unbind_to (count, Qnil);
+ {
+ Lisp_Object total[11];
+ int total_size = 10;
+
+ total[0] = list4 (Qconses, make_number (sizeof (struct Lisp_Cons)),
+ bounded_number (total_conses),
+ bounded_number (total_free_conses));
+
+ total[1] = list4 (Qsymbols, make_number (sizeof (struct Lisp_Symbol)),
+ bounded_number (total_symbols),
+ bounded_number (total_free_symbols));
+
+ total[2] = list4 (Qmiscs, make_number (sizeof (union Lisp_Misc)),
+ bounded_number (total_markers),
+ bounded_number (total_free_markers));
+
+ 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[0] = Fcons (make_number (total_conses),
- make_number (total_free_conses));
- total[1] = Fcons (make_number (total_symbols),
- make_number (total_free_symbols));
- total[2] = Fcons (make_number (total_markers),
- make_number (total_free_markers));
- total[3] = make_number (total_string_size);
- total[4] = make_number (total_vector_size);
- total[5] = Fcons (make_number (total_floats),
- make_number (total_free_floats));
- total[6] = Fcons (make_number (total_intervals),
- make_number (total_free_intervals));
- total[7] = Fcons (make_number (total_strings),
- make_number (total_free_strings));
+ 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[7] = list4 (Qfloats, make_number (sizeof (struct Lisp_Float)),
+ bounded_number (total_floats),
+ bounded_number (total_free_floats));
+
+ total[8] = list4 (Qintervals, make_number (sizeof (struct interval)),
+ bounded_number (total_intervals),
+ bounded_number (total_free_intervals));
+
+ total[9] = list3 (Qbuffers, make_number (sizeof (struct buffer)),
+ bounded_number (total_buffers));
+
+#ifdef DOUG_LEA_MALLOC
+ 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 = 0;
-
- for (i = 0; i < 7; ++i)
- if (CONSP (total[i]))
- nlive += XFASTINT (XCAR (total[i]));
+ 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);
avg_zombies = (avg_zombies * ngcs + nzombies) / (ngcs + 1);
max_zombies = max (nzombies, max_zombies);
++ngcs;
- }
+ }
#endif
if (!NILP (Vpost_gc_hook))
{
- int gc_count = inhibit_garbage_collection ();
+ ptrdiff_t gc_count = inhibit_garbage_collection ();
safe_run_hooks (Qpost_gc_hook);
unbind_to (gc_count, Qnil);
}
/* Accumulate statistics. */
- EMACS_GET_TIME (t2);
- EMACS_SUB_TIME (t3, t2, t1);
if (FLOATP (Vgc_elapsed))
- Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) +
- EMACS_SECS (t3) +
- EMACS_USECS (t3) * 1.0e-6);
+ {
+ EMACS_TIME since_start = sub_emacs_time (current_emacs_time (), start);
+ Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed)
+ + EMACS_TIME_TO_DOUBLE (since_start));
+ }
+
gcs_done++;
- return Flist (sizeof total / sizeof *total, total);
+ /* Collect profiling data. */
+ if (profiler_memory_running)
+ {
+ size_t swept = 0;
+ size_t tot_after = total_bytes_of_live_objects ();
+ if (tot_before > tot_after)
+ swept = tot_before - tot_after;
+ malloc_probe (swept);
+ }
+
+ backtrace_list = backtrace.next;
+ return retval;
}
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
- EMACS_INT size = ptr->header.size;
- EMACS_INT i;
+ ptrdiff_t size = ptr->header.size;
+ ptrdiff_t i;
eassert (!VECTOR_MARKED_P (ptr));
- VECTOR_MARK (ptr); /* Else mark it */
+ VECTOR_MARK (ptr); /* Else mark it. */
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
/* Note that this size is not the memory-footprint size, but only
the number of Lisp_Object fields that we should trace.
The distinction is used e.g. by Lisp_Process which places extra
- non-Lisp_Object fields at the end of the structure. */
- for (i = 0; i < size; i++) /* and then mark its elements */
+ non-Lisp_Object fields at the end of the structure... */
+ for (i = 0; i < size; i++) /* ...and then mark its elements. */
mark_object (ptr->contents[i]);
}
}
}
+/* Mark the chain of overlays starting at PTR. */
+
+static void
+mark_overlay (struct Lisp_Overlay *ptr)
+{
+ for (; ptr && !ptr->gcmarkbit; ptr = ptr->next)
+ {
+ ptr->gcmarkbit = 1;
+ mark_object (ptr->start);
+ mark_object (ptr->end);
+ mark_object (ptr->plist);
+ }
+}
+
+/* Mark Lisp_Objects and special pointers in BUFFER. */
+
+static void
+mark_buffer (struct buffer *buffer)
+{
+ /* This is handled much like other pseudovectors... */
+ mark_vectorlike ((struct Lisp_Vector *) buffer);
+
+ /* ...but there are some buffer-specific things. */
+
+ MARK_INTERVAL_TREE (buffer_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
+ some of its elements that are not needed any more. */
+
+ mark_overlay (buffer->overlays_before);
+ mark_overlay (buffer->overlays_after);
+
+ /* If this is an indirect buffer, mark its base buffer. */
+ if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
+ mark_buffer (buffer->base_buffer);
+}
+
+/* Remove killed buffers or items whose car is a killed buffer from
+ LIST, and mark other items. Return changed LIST, which is marked. */
+
+static Lisp_Object
+mark_discard_killed_buffers (Lisp_Object list)
+{
+ Lisp_Object tail, *prev = &list;
+
+ for (tail = list; CONSP (tail) && !CONS_MARKED_P (XCONS (tail));
+ tail = XCDR (tail))
+ {
+ Lisp_Object tem = XCAR (tail);
+ if (CONSP (tem))
+ tem = XCAR (tem);
+ if (BUFFERP (tem) && !BUFFER_LIVE_P (XBUFFER (tem)))
+ *prev = XCDR (tail);
+ else
+ {
+ CONS_MARK (XCONS (tail));
+ mark_object (XCAR (tail));
+ prev = &XCDR_AS_LVALUE (tail);
+ }
+ }
+ mark_object (tail);
+ return list;
+}
+
+/* Determine type of generic Lisp_Object and mark it accordingly. */
+
void
mark_object (Lisp_Object arg)
{
do { \
m = mem_find (po); \
if (m == MEM_NIL) \
- abort (); \
+ emacs_abort (); \
} while (0)
/* Check that the object pointed to by PO is live, using predicate
#define CHECK_LIVE(LIVEP) \
do { \
if (!LIVEP (m, po)) \
- abort (); \
+ emacs_abort (); \
} while (0)
/* Check both of the above conditions. */
#endif /* not GC_CHECK_MARKED_OBJECTS */
- switch (SWITCH_ENUM_CAST (XTYPE (obj)))
+ switch (XTYPE (obj))
{
case Lisp_String:
{
if (STRING_MARKED_P (ptr))
break;
CHECK_ALLOCATED_AND_LIVE (live_string_p);
- MARK_INTERVAL_TREE (ptr->intervals);
MARK_STRING (ptr);
+ MARK_INTERVAL_TREE (ptr->intervals);
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
- same as the one recorded in the sdata structure. */
- CHECK_STRING_BYTES (ptr);
+ same as the one recorded in the sdata structure. */
+ string_bytes (ptr);
#endif /* GC_CHECK_STRING_BYTES */
}
break;
case Lisp_Vectorlike:
- if (VECTOR_MARKED_P (XVECTOR (obj)))
- break;
+ {
+ register struct Lisp_Vector *ptr = XVECTOR (obj);
+ register ptrdiff_t pvectype;
+
+ if (VECTOR_MARKED_P (ptr))
+ break;
+
#ifdef GC_CHECK_MARKED_OBJECTS
- m = mem_find (po);
- if (m == MEM_NIL && !SUBRP (obj)
- && po != &buffer_defaults
- && po != &buffer_local_symbols)
- abort ();
+ m = mem_find (po);
+ if (m == MEM_NIL && !SUBRP (obj))
+ emacs_abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
- if (BUFFERP (obj))
- {
+ if (ptr->header.size & PSEUDOVECTOR_FLAG)
+ pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
+ >> PSEUDOVECTOR_SIZE_BITS);
+ else
+ pvectype = 0;
+
+ if (pvectype != PVEC_SUBR && pvectype != PVEC_BUFFER)
+ CHECK_LIVE (live_vector_p);
+
+ switch (pvectype)
+ {
+ case PVEC_BUFFER:
#ifdef GC_CHECK_MARKED_OBJECTS
- if (po != &buffer_defaults && po != &buffer_local_symbols)
{
struct buffer *b;
- for (b = all_buffers; b && b != po; b = b->header.next.buffer)
- ;
+ FOR_EACH_BUFFER (b)
+ if (b == po)
+ break;
if (b == NULL)
- abort ();
+ emacs_abort ();
}
#endif /* GC_CHECK_MARKED_OBJECTS */
- mark_buffer (obj);
- }
- else if (SUBRP (obj))
- break;
- else if (COMPILEDP (obj))
- /* We could treat this just like a vector, but it is better to
- save the COMPILED_CONSTANTS element for last and avoid
- recursion there. */
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
- int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
- int i;
+ mark_buffer ((struct buffer *) ptr);
+ break;
- CHECK_LIVE (live_vector_p);
- VECTOR_MARK (ptr); /* Else mark it */
- for (i = 0; i < size; i++) /* and then mark its elements */
+ case PVEC_COMPILED:
+ { /* We could treat this just like a vector, but it is better
+ to save the COMPILED_CONSTANTS element for last and avoid
+ recursion there. */
+ int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+ int i;
+
+ VECTOR_MARK (ptr);
+ for (i = 0; i < size; i++)
+ if (i != COMPILED_CONSTANTS)
+ mark_object (ptr->contents[i]);
+ if (size > COMPILED_CONSTANTS)
+ {
+ obj = ptr->contents[COMPILED_CONSTANTS];
+ goto loop;
+ }
+ }
+ break;
+
+ case PVEC_FRAME:
+ mark_vectorlike (ptr);
+ mark_face_cache (((struct frame *) ptr)->face_cache);
+ break;
+
+ case PVEC_WINDOW:
{
- if (i != COMPILED_CONSTANTS)
- mark_object (ptr->contents[i]);
+ struct window *w = (struct window *) ptr;
+ bool leaf = NILP (w->hchild) && NILP (w->vchild);
+
+ mark_vectorlike (ptr);
+
+ /* Mark glyphs for leaf windows. Marking window
+ matrices is sufficient because frame matrices
+ use the same glyph memory. */
+ if (leaf && w->current_matrix)
+ {
+ mark_glyph_matrix (w->current_matrix);
+ mark_glyph_matrix (w->desired_matrix);
+ }
+
+ /* Filter out killed buffers from both buffer lists
+ in attempt to help GC to reclaim killed buffers faster.
+ We can do it elsewhere for live windows, but this is the
+ best place to do it for dead windows. */
+ wset_prev_buffers
+ (w, mark_discard_killed_buffers (w->prev_buffers));
+ wset_next_buffers
+ (w, mark_discard_killed_buffers (w->next_buffers));
}
- obj = ptr->contents[COMPILED_CONSTANTS];
- goto loop;
- }
- else if (FRAMEP (obj))
- {
- register struct frame *ptr = XFRAME (obj);
- mark_vectorlike (XVECTOR (obj));
- mark_face_cache (ptr->face_cache);
- }
- else if (WINDOWP (obj))
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
- struct window *w = XWINDOW (obj);
- mark_vectorlike (ptr);
- /* Mark glyphs for leaf windows. Marking window matrices is
- sufficient because frame matrices use the same glyph
- memory. */
- if (NILP (w->hchild)
- && NILP (w->vchild)
- && w->current_matrix)
+ break;
+
+ case PVEC_HASH_TABLE:
{
- mark_glyph_matrix (w->current_matrix);
- mark_glyph_matrix (w->desired_matrix);
+ struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr;
+
+ mark_vectorlike (ptr);
+ /* If hash table is not weak, mark all keys and values.
+ For weak tables, mark only the vector. */
+ if (NILP (h->weak))
+ mark_object (h->key_and_value);
+ else
+ VECTOR_MARK (XVECTOR (h->key_and_value));
}
- }
- else if (HASH_TABLE_P (obj))
- {
- struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- mark_vectorlike ((struct Lisp_Vector *)h);
- /* If hash table is not weak, mark all keys and values.
- For weak tables, mark only the vector. */
- if (NILP (h->weak))
- mark_object (h->key_and_value);
- else
- VECTOR_MARK (XVECTOR (h->key_and_value));
- }
- else if (CHAR_TABLE_P (obj))
- mark_char_table (XVECTOR (obj));
- else
- mark_vectorlike (XVECTOR (obj));
+ break;
+
+ case PVEC_CHAR_TABLE:
+ mark_char_table (ptr);
+ break;
+
+ case PVEC_BOOL_VECTOR:
+ /* No Lisp_Objects to mark in a bool vector. */
+ VECTOR_MARK (ptr);
+ break;
+
+ case PVEC_SUBR:
+ break;
+
+ case PVEC_FREE:
+ emacs_abort ();
+
+ default:
+ mark_vectorlike (ptr);
+ }
+ }
break;
case Lisp_Symbol:
case SYMBOL_LOCALIZED:
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr);
- /* If the value is forwarded to a buffer or keyboard field,
- these are marked when we see the corresponding object.
- And if it's forwarded to a C variable, either it's not
- a Lisp_Object var, or it's staticpro'd already. */
+ Lisp_Object where = blv->where;
+ /* If the value is set up for a killed buffer or deleted
+ frame, restore it's global binding. If the value is
+ forwarded to a C variable, either it's not a Lisp_Object
+ var, or it's staticpro'd already. */
+ if ((BUFFERP (where) && !BUFFER_LIVE_P (XBUFFER (where)))
+ || (FRAMEP (where) && !FRAME_LIVE_P (XFRAME (where))))
+ swap_in_global_binding (ptr);
mark_object (blv->where);
mark_object (blv->valcell);
mark_object (blv->defcell);
And if it's forwarded to a C variable, either it's not
a Lisp_Object var, or it's staticpro'd already. */
break;
- default: abort ();
+ default: emacs_abort ();
}
- if (!PURE_POINTER_P (XSTRING (ptr->xname)))
- MARK_STRING (XSTRING (ptr->xname));
- MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));
+ if (!PURE_POINTER_P (XSTRING (ptr->name)))
+ MARK_STRING (XSTRING (ptr->name));
+ MARK_INTERVAL_TREE (string_intervals (ptr->name));
ptr = ptr->next;
if (ptr)
{
- ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */
+ ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun. */
XSETSYMBOL (obj, ptrx);
goto loop;
}
case Lisp_Misc:
CHECK_ALLOCATED_AND_LIVE (live_misc_p);
+
if (XMISCANY (obj)->gcmarkbit)
break;
- XMISCANY (obj)->gcmarkbit = 1;
switch (XMISCTYPE (obj))
{
-
case Lisp_Misc_Marker:
/* DO NOT mark thru the marker's chain.
The buffer's markers chain does not preserve markers from gc;
instead, markers are removed from the chain when freed by gc. */
+ XMISCANY (obj)->gcmarkbit = 1;
break;
case Lisp_Misc_Save_Value:
+ XMISCANY (obj)->gcmarkbit = 1;
#if GC_MARK_STACK
{
register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
break;
case Lisp_Misc_Overlay:
- {
- struct Lisp_Overlay *ptr = XOVERLAY (obj);
- mark_object (ptr->start);
- mark_object (ptr->end);
- mark_object (ptr->plist);
- if (ptr->next)
- {
- XSETMISC (obj, ptr->next);
- goto loop;
- }
- }
+ mark_overlay (XOVERLAY (obj));
break;
default:
- abort ();
+ emacs_abort ();
}
break;
obj = ptr->u.cdr;
cdr_count++;
if (cdr_count == mark_object_loop_halt)
- abort ();
+ emacs_abort ();
goto loop;
}
break;
default:
- abort ();
+ emacs_abort ();
}
#undef CHECK_LIVE
#undef CHECK_ALLOCATED
#undef CHECK_ALLOCATED_AND_LIVE
}
-
-/* Mark the pointers in a buffer structure. */
-
-static void
-mark_buffer (Lisp_Object buf)
-{
- register struct buffer *buffer = XBUFFER (buf);
- register Lisp_Object *ptr, tmp;
- Lisp_Object base_buffer;
-
- eassert (!VECTOR_MARKED_P (buffer));
- VECTOR_MARK (buffer);
-
- MARK_INTERVAL_TREE (BUF_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
- some of its elements that are not needed any more. */
-
- if (buffer->overlays_before)
- {
- XSETMISC (tmp, buffer->overlays_before);
- mark_object (tmp);
- }
- if (buffer->overlays_after)
- {
- XSETMISC (tmp, buffer->overlays_after);
- mark_object (tmp);
- }
-
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name);
- ptr <= &PER_BUFFER_VALUE (buffer,
- PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER));
- ptr++)
- mark_object (*ptr);
-
- /* If this is an indirect buffer, mark its base buffer. */
- if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
- {
- XSETBUFFER (base_buffer, buffer->base_buffer);
- mark_buffer (base_buffer);
- }
-}
-
/* Mark the Lisp pointers in the terminal objects.
- Called by the Fgarbage_collector. */
+ Called by Fgarbage_collect. */
static void
mark_terminals (void)
/* Value is non-zero if OBJ will survive the current GC because it's
either marked or does not need to be marked to survive. */
-int
+bool
survives_gc_p (Lisp_Object obj)
{
- int survives_p;
+ bool survives_p;
switch (XTYPE (obj))
{
break;
default:
- abort ();
+ emacs_abort ();
}
return survives_p || PURE_POINTER_P ((void *) XPNTR (obj));
sweep_weak_hash_tables ();
sweep_strings ();
-#ifdef GC_CHECK_STRING_BYTES
- if (!noninteractive)
- check_string_bytes (1);
-#endif
+ check_string_bytes (!noninteractive);
/* Put all unmarked conses on free list */
{
{
if (!iblk->intervals[i].gcmarkbit)
{
- SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list);
+ set_interval_parent (&iblk->intervals[i], interval_free_list);
interval_free_list = &iblk->intervals[i];
this_free++;
}
for (sblk = symbol_block; sblk; sblk = *sprev)
{
int this_free = 0;
- struct Lisp_Symbol *sym = sblk->symbols;
- struct Lisp_Symbol *end = sym + lim;
+ union aligned_Lisp_Symbol *sym = sblk->symbols;
+ union aligned_Lisp_Symbol *end = sym + lim;
for (; sym < end; ++sym)
{
/* 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->xname));
+ bool pure_p = PURE_POINTER_P (XSTRING (sym->s.name));
- if (!sym->gcmarkbit && !pure_p)
+ if (!sym->s.gcmarkbit && !pure_p)
{
- if (sym->redirect == SYMBOL_LOCALIZED)
- xfree (SYMBOL_BLV (sym));
- sym->next = symbol_free_list;
- symbol_free_list = sym;
+ if (sym->s.redirect == SYMBOL_LOCALIZED)
+ xfree (SYMBOL_BLV (&sym->s));
+ sym->s.next = symbol_free_list;
+ symbol_free_list = &sym->s;
#if GC_MARK_STACK
symbol_free_list->function = Vdead;
#endif
{
++num_used;
if (!pure_p)
- UNMARK_STRING (XSTRING (sym->xname));
- sym->gcmarkbit = 0;
+ UNMARK_STRING (XSTRING (sym->s.name));
+ sym->s.gcmarkbit = 0;
}
}
{
*sprev = sblk->next;
/* Unhook from the free list. */
- symbol_free_list = sblk->symbols[0].next;
+ symbol_free_list = sblk->symbols[0].s.next;
lisp_free (sblk);
}
else
for (i = 0; i < lim; i++)
{
- if (!mblk->markers[i].u_any.gcmarkbit)
+ if (!mblk->markers[i].m.u_any.gcmarkbit)
{
- if (mblk->markers[i].u_any.type == Lisp_Misc_Marker)
- unchain_marker (&mblk->markers[i].u_marker);
+ if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
+ unchain_marker (&mblk->markers[i].m.u_marker);
/* Set the type of the freed object to Lisp_Misc_Free.
We could leave the type alone, since nobody checks it,
but this might catch bugs faster. */
- mblk->markers[i].u_marker.type = Lisp_Misc_Free;
- mblk->markers[i].u_free.chain = marker_free_list;
- marker_free_list = &mblk->markers[i];
+ mblk->markers[i].m.u_marker.type = Lisp_Misc_Free;
+ mblk->markers[i].m.u_free.chain = marker_free_list;
+ marker_free_list = &mblk->markers[i].m;
this_free++;
}
else
{
num_used++;
- mblk->markers[i].u_any.gcmarkbit = 0;
+ mblk->markers[i].m.u_any.gcmarkbit = 0;
}
}
lim = MARKER_BLOCK_SIZE;
{
*mprev = mblk->next;
/* Unhook from the free list. */
- marker_free_list = mblk->markers[0].u_free.chain;
+ marker_free_list = mblk->markers[0].m.u_free.chain;
lisp_free (mblk);
}
else
{
register struct buffer *buffer = all_buffers, *prev = 0, *next;
+ total_buffers = 0;
while (buffer)
if (!VECTOR_MARKED_P (buffer))
{
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;
}
}
- /* Free all unmarked vectors */
- {
- register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next;
- total_vector_size = 0;
-
- while (vector)
- if (!VECTOR_MARKED_P (vector))
- {
- if (prev)
- prev->header.next = vector->header.next;
- else
- all_vectors = vector->header.next.vector;
- next = vector->header.next.vector;
- lisp_free (vector);
- vector = next;
-
- }
- else
- {
- VECTOR_UNMARK (vector);
- if (vector->header.size & PSEUDOVECTOR_FLAG)
- total_vector_size += PSEUDOVECTOR_SIZE_MASK & vector->header.size;
- else
- total_vector_size += vector->header.size;
- prev = vector, vector = vector->header.next.vector;
- }
- }
-
-#ifdef GC_CHECK_STRING_BYTES
- if (!noninteractive)
- check_string_bytes (1);
-#endif
+ sweep_vectors ();
+ check_string_bytes (!noninteractive);
}
(but the contents of a buffer's text do not count here). */)
(void)
{
- Lisp_Object consed[8];
-
- consed[0] = make_number (min (MOST_POSITIVE_FIXNUM, cons_cells_consed));
- consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed));
- consed[2] = make_number (min (MOST_POSITIVE_FIXNUM, vector_cells_consed));
- consed[3] = make_number (min (MOST_POSITIVE_FIXNUM, symbols_consed));
- consed[4] = make_number (min (MOST_POSITIVE_FIXNUM, string_chars_consed));
- consed[5] = make_number (min (MOST_POSITIVE_FIXNUM, misc_objects_consed));
- consed[6] = make_number (min (MOST_POSITIVE_FIXNUM, intervals_consed));
- consed[7] = make_number (min (MOST_POSITIVE_FIXNUM, strings_consed));
-
- return Flist (8, consed);
+ return listn (CONSTYPE_HEAP, 8,
+ bounded_number (cons_cells_consed),
+ bounded_number (floats_consed),
+ bounded_number (vector_cells_consed),
+ bounded_number (symbols_consed),
+ bounded_number (string_chars_consed),
+ bounded_number (misc_objects_consed),
+ bounded_number (intervals_consed),
+ bounded_number (strings_consed));
}
/* Find at most FIND_MAX symbols which have OBJ as their value or
which_symbols (Lisp_Object obj, EMACS_INT find_max)
{
struct symbol_block *sblk;
- int gc_count = inhibit_garbage_collection ();
+ ptrdiff_t gc_count = inhibit_garbage_collection ();
Lisp_Object found = Qnil;
if (! DEADP (obj))
{
for (sblk = symbol_block; sblk; sblk = sblk->next)
{
- struct Lisp_Symbol *sym = sblk->symbols;
+ union aligned_Lisp_Symbol *aligned_sym = sblk->symbols;
int bn;
- for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, sym++)
+ for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, aligned_sym++)
{
+ struct Lisp_Symbol *sym = &aligned_sym->s;
Lisp_Object val;
Lisp_Object tem;
}
#ifdef ENABLE_CHECKING
-int suppress_checking;
+
+bool suppress_checking;
void
die (const char *msg, const char *file, int line)
{
fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n",
file, line, msg);
- abort ();
+ terminate_due_to_signal (SIGABRT, INT_MAX);
}
#endif
\f
/* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
purebeg = PUREBEG;
pure_size = PURESIZE;
- pure_bytes_used = 0;
- pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
- pure_bytes_used_before_overflow = 0;
-
- /* Initialize the list of free aligned blocks. */
- free_ablock = NULL;
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
Vdead = make_pure_string ("DEAD", 4, 4, 0);
#endif
- all_vectors = 0;
- ignore_warnings = 1;
#ifdef DOUG_LEA_MALLOC
mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */
#endif
init_strings ();
- init_cons ();
- init_symbol ();
- init_marker ();
- init_float ();
- init_intervals ();
- init_weak_hash_tables ();
-
-#ifdef REL_ALLOC
- malloc_hysteresis = 32;
-#else
- malloc_hysteresis = 0;
-#endif
+ init_vectors ();
refill_memory_reserve ();
-
- ignore_warnings = 0;
- gcprolist = 0;
- byte_stack_list = 0;
- staticidx = 0;
- consing_since_gc = 0;
- gc_cons_threshold = 100000 * sizeof (Lisp_Object);
- gc_relative_threshold = 0;
+ gc_cons_threshold = GC_DEFAULT_THRESHOLD;
}
void
syms_of_alloc (void)
{
DEFVAR_INT ("gc-cons-threshold", gc_cons_threshold,
- doc: /* *Number of bytes of consing between garbage collections.
+ doc: /* Number of bytes of consing between garbage collections.
Garbage collection can happen automatically once this many bytes have been
allocated since the last garbage collection. All data types count.
See also `gc-cons-percentage'. */);
DEFVAR_LISP ("gc-cons-percentage", Vgc_cons_percentage,
- doc: /* *Portion of the heap used for allocation.
+ doc: /* Portion of the heap used for allocation.
Garbage collection can happen automatically once this portion of the heap
has been allocated since the last garbage collection.
If this portion is smaller than `gc-cons-threshold', this is ignored. */);
/* We build this in advance because if we wait until we need it, we might
not be able to allocate the memory to hold it. */
Vmemory_signal_data
- = pure_cons (Qerror,
- pure_cons (make_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil));
+ = listn (CONSTYPE_PURE, 2, Qerror,
+ build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
DEFVAR_LISP ("memory-full", Vmemory_full,
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");
+ DEFSYM (Qautomatic_gc, "Automatic GC");
+
DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
defsubr (&Sgc_status);
#endif
}
+
+/* When compiled with GCC, GDB might say "No enum type named
+ pvec_type" if we don't have at least one symbol with that type, and
+ then xbacktrace could fail. Similarly for the other enums and
+ their values. */
+union
+{
+ enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS;
+ enum CHAR_TABLE_STANDARD_SLOTS CHAR_TABLE_STANDARD_SLOTS;
+ enum char_bits char_bits;
+ enum CHECK_LISP_OBJECT_TYPE CHECK_LISP_OBJECT_TYPE;
+ enum DEFAULT_HASH_SIZE DEFAULT_HASH_SIZE;
+ enum enum_USE_LSB_TAG enum_USE_LSB_TAG;
+ enum FLOAT_TO_STRING_BUFSIZE FLOAT_TO_STRING_BUFSIZE;
+ enum Lisp_Bits Lisp_Bits;
+ enum Lisp_Compiled Lisp_Compiled;
+ enum maxargs maxargs;
+ enum MAX_ALLOCA MAX_ALLOCA;
+ enum More_Lisp_Bits More_Lisp_Bits;
+ enum pvec_type pvec_type;
+#if USE_LSB_TAG
+ enum lsb_bits lsb_bits;
+#endif
+} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "syssignal.h"
#include "systime.h"
#include "atimer.h"
#include <unistd.h>
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#endif
-
/* Free-list of atimer structures. */
static struct atimer *free_atimers;
static struct atimer *atimers;
-/* Non-zero means alarm_signal_handler has found ripe timers but
- interrupt_input_blocked was non-zero. In this case, timer
- functions are not called until the next UNBLOCK_INPUT because timer
- functions are expected to call X, and X cannot be assumed to be
- reentrant. */
-
-int pending_atimers;
+/* The alarm timer and whether it was properly initialized, if
+ POSIX timers are available. */
+#ifdef HAVE_TIMER_SETTIME
+static timer_t alarm_timer;
+static bool alarm_timer_ok;
+#endif
/* Block/unblock SIGALRM. */
-#define BLOCK_ATIMERS sigblock (sigmask (SIGALRM))
-#define UNBLOCK_ATIMERS sigunblock (sigmask (SIGALRM))
+static void
+sigmask_atimers (int how)
+{
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGALRM);
+ pthread_sigmask (how, &blocked, 0);
+}
+static void
+block_atimers (void)
+{
+ sigmask_atimers (SIG_BLOCK);
+}
+static void
+unblock_atimers (void)
+{
+ sigmask_atimers (SIG_UNBLOCK);
+}
/* Function prototypes. */
static void schedule_atimer (struct atimer *);
static struct atimer *append_atimer_lists (struct atimer *,
struct atimer *);
-static void alarm_signal_handler (int signo);
-
/* Start a new atimer of type TYPE. TIME specifies when the timer is
ripe. FN is the function to call when the timer fires.
/* Round TIME up to the next full second if we don't have
itimers. */
#ifndef HAVE_SETITIMER
- if (EMACS_USECS (timestamp) != 0)
- {
- EMACS_SET_USECS (timestamp, 0);
- EMACS_SET_SECS (timestamp, EMACS_SECS (timestamp) + 1);
- }
+ if (EMACS_NSECS (timestamp) != 0
+ && EMACS_SECS (timestamp) < TYPE_MAXIMUM (time_t))
+ timestamp = make_emacs_time (EMACS_SECS (timestamp) + 1, 0);
#endif /* not HAVE_SETITIMER */
/* Get an atimer structure from the free-list, or allocate
free_atimers = t->next;
}
else
- t = (struct atimer *) xmalloc (sizeof *t);
+ t = xmalloc (sizeof *t);
/* Fill the atimer structure. */
memset (t, 0, sizeof *t);
t->fn = fn;
t->client_data = client_data;
- BLOCK_ATIMERS;
+ block_atimers ();
/* Compute the timer's expiration time. */
switch (type)
break;
case ATIMER_RELATIVE:
- EMACS_GET_TIME (t->expiration);
- EMACS_ADD_TIME (t->expiration, t->expiration, timestamp);
+ t->expiration = add_emacs_time (current_emacs_time (), timestamp);
break;
case ATIMER_CONTINUOUS:
- EMACS_GET_TIME (t->expiration);
- EMACS_ADD_TIME (t->expiration, t->expiration, timestamp);
+ t->expiration = add_emacs_time (current_emacs_time (), timestamp);
t->interval = timestamp;
break;
}
/* Insert the timer in the list of active atimers. */
schedule_atimer (t);
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
/* Arrange for a SIGALRM at the time the next atimer is ripe. */
set_alarm ();
{
int i;
- BLOCK_ATIMERS;
+ block_atimers ();
for (i = 0; i < 2; ++i)
{
}
}
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
}
void
stop_other_atimers (struct atimer *t)
{
- BLOCK_ATIMERS;
+ block_atimers ();
if (t)
{
stopped_atimers = append_atimer_lists (atimers, stopped_atimers);
atimers = t;
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
}
struct atimer *t = atimers;
struct atimer *next;
- BLOCK_ATIMERS;
+ block_atimers ();
atimers = stopped_atimers;
stopped_atimers = NULL;
t = next;
}
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
}
}
{
if (atimers)
{
- EMACS_TIME now, timestamp;
#ifdef HAVE_SETITIMER
struct itimerval it;
#endif
+ EMACS_TIME now, interval;
- /* Determine s/us till the next timer is ripe. */
- EMACS_GET_TIME (now);
- EMACS_SUB_TIME (timestamp, atimers->expiration, now);
-
-#ifdef HAVE_SETITIMER
- /* Don't set the interval to 0; this disables the timer. */
- if (EMACS_TIME_LE (atimers->expiration, now))
+#ifdef HAVE_TIMER_SETTIME
+ if (alarm_timer_ok)
{
- EMACS_SET_SECS (timestamp, 0);
- EMACS_SET_USECS (timestamp, 1000);
+ struct itimerspec ispec;
+ ispec.it_value = atimers->expiration;
+ ispec.it_interval.tv_sec = ispec.it_interval.tv_nsec = 0;
+ if (timer_settime (alarm_timer, 0, &ispec, 0) == 0)
+ return;
}
+#endif
+
+ /* Determine interval till the next timer is ripe.
+ Don't set the interval to 0; this disables the timer. */
+ now = current_emacs_time ();
+ interval = (EMACS_TIME_LE (atimers->expiration, now)
+ ? make_emacs_time (0, 1000 * 1000)
+ : sub_emacs_time (atimers->expiration, now));
+
+#ifdef HAVE_SETITIMER
memset (&it, 0, sizeof it);
- it.it_value = timestamp;
+ it.it_value = make_timeval (interval);
setitimer (ITIMER_REAL, &it, 0);
#else /* not HAVE_SETITIMER */
- alarm (max (EMACS_SECS (timestamp), 1));
+ alarm (max (EMACS_SECS (interval), 1));
#endif /* not HAVE_SETITIMER */
}
}
static void
run_timers (void)
{
- EMACS_TIME now;
-
- EMACS_GET_TIME (now);
+ EMACS_TIME now = current_emacs_time ();
- while (atimers
- && (pending_atimers = interrupt_input_blocked) == 0
- && EMACS_TIME_LE (atimers->expiration, now))
+ while (atimers && EMACS_TIME_LE (atimers->expiration, now))
{
- struct atimer *t;
-
- t = atimers;
+ struct atimer *t = atimers;
atimers = atimers->next;
t->fn (t);
if (t->type == ATIMER_CONTINUOUS)
{
- EMACS_ADD_TIME (t->expiration, now, t->interval);
+ t->expiration = add_emacs_time (now, t->interval);
schedule_atimer (t);
}
else
t->next = free_atimers;
free_atimers = t;
}
-
- EMACS_GET_TIME (now);
}
- if (! atimers)
- pending_atimers = 0;
-
-#ifdef SYNC_INPUT
- if (pending_atimers)
- pending_signals = 1;
- else
- {
- pending_signals = interrupt_input_pending;
- set_alarm ();
- }
-#else
- if (! pending_atimers)
- set_alarm ();
-#endif
+ set_alarm ();
}
/* Signal handler for SIGALRM. SIGNO is the signal number, i.e.
SIGALRM. */
-void
-alarm_signal_handler (int signo)
+static void
+handle_alarm_signal (int sig)
{
-#ifndef SYNC_INPUT
- SIGNAL_THREAD_CHECK (signo);
-#endif
-
- pending_atimers = 1;
-#ifdef SYNC_INPUT
pending_signals = 1;
-#else
- run_timers ();
-#endif
}
-/* Call alarm_signal_handler for pending timers. */
+/* Do pending timers. */
void
do_pending_atimers (void)
{
- if (pending_atimers)
+ if (atimers)
{
- BLOCK_ATIMERS;
+ block_atimers ();
run_timers ();
- UNBLOCK_ATIMERS;
+ unblock_atimers ();
}
}
some systems like HPUX (see process.c). */
void
-turn_on_atimers (int on)
+turn_on_atimers (bool on)
{
if (on)
- {
- signal (SIGALRM, alarm_signal_handler);
- set_alarm ();
- }
+ set_alarm ();
else
alarm (0);
}
void
init_atimer (void)
{
+ struct sigaction action;
+#ifdef HAVE_TIMER_SETTIME
+ struct sigevent sigev;
+ sigev.sigev_notify = SIGEV_SIGNAL;
+ sigev.sigev_signo = SIGALRM;
+ sigev.sigev_value.sival_ptr = &alarm_timer;
+ alarm_timer_ok = timer_create (CLOCK_REALTIME, &sigev, &alarm_timer) == 0;
+#endif
free_atimers = stopped_atimers = atimers = NULL;
- pending_atimers = 0;
/* pending_signals is initialized in init_keyboard.*/
- signal (SIGALRM, alarm_signal_handler);
+ emacs_sigaction_init (&action, handle_alarm_signal);
+ sigaction (SIGALRM, &action, 0);
}
#define EMACS_ATIMER_H
#include "systime.h" /* for EMACS_TIME */
+#include <stdbool.h>
/* Forward declaration. */
void cancel_atimer (struct atimer *);
void do_pending_atimers (void);
void init_atimer (void);
-void turn_on_atimers (int);
+void turn_on_atimers (bool);
void stop_other_atimers (struct atimer *);
Lisp_Object unwind_stop_other_atimers (Lisp_Object);
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "dispextern.h"
-static int bidi_initialized = 0;
+static bool bidi_initialized = 0;
static Lisp_Object bidi_type_table, bidi_mirror_table;
/* UAX#9 says to search only for L, AL, or R types of characters, and
ignore RLE, RLO, LRE, and LRO, when determining the base paragraph
level. Yudit indeed ignores them. This variable is therefore set
- by default to ignore them, but setting it to zero will take them
- into account. */
-extern int bidi_ignore_explicit_marks_for_paragraph_level EXTERNALLY_VISIBLE;
-int bidi_ignore_explicit_marks_for_paragraph_level = 1;
+ by default to ignore them, but clearing it will take them into
+ account. */
+extern bool bidi_ignore_explicit_marks_for_paragraph_level EXTERNALLY_VISIBLE;
+bool bidi_ignore_explicit_marks_for_paragraph_level = 1;
static Lisp_Object paragraph_start_re, paragraph_separate_re;
static Lisp_Object Qparagraph_start, Qparagraph_separate;
if (ch == BIDI_EOB)
return NEUTRAL_B;
if (ch < 0 || ch > MAX_CHAR)
- abort ();
+ emacs_abort ();
default_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch));
/* Every valid character code, even those that are unassigned by the
DerivedBidiClass.txt file. Therefore, if we ever get UNKNOWN_BT
(= zero) code from CHAR_TABLE_REF, that's a bug. */
if (default_type == UNKNOWN_BT)
- abort ();
+ emacs_abort ();
if (override == NEUTRAL_DIR)
return default_type;
else if (override == R2L)
return STRONG_R;
else
- abort (); /* can't happen: handled above */
+ emacs_abort (); /* can't happen: handled above */
}
}
}
static inline void
bidi_check_type (bidi_type_t type)
{
- xassert (UNKNOWN_BT <= type && type <= NEUTRAL_ON);
+ eassert (UNKNOWN_BT <= type && type <= NEUTRAL_ON);
}
/* Given a bidi TYPE of a character, return its category. */
case NEUTRAL_ON:
return NEUTRAL;
default:
- abort ();
+ emacs_abort ();
}
}
if (c == BIDI_EOB)
return c;
if (c < 0 || c > MAX_CHAR)
- abort ();
+ emacs_abort ();
val = CHAR_TABLE_REF (bidi_mirror_table, c);
if (INTEGERP (val))
{
- int v = XINT (val);
+ int v;
+
+ /* When debugging, check before assigning to V, so that the check
+ isn't broken by undefined behavior due to int overflow. */
+ eassert (CHAR_VALID_P (XINT (val)));
+ v = XINT (val);
+
+ /* Minimal test we must do in optimized builds, to prevent weird
+ crashes further down the road. */
if (v < 0 || v > MAX_CHAR)
- abort ();
+ emacs_abort ();
return v;
}
int level, bidi_dir_t override)
{
bidi_it->stack_idx++;
- xassert (bidi_it->stack_idx < BIDI_MAXLEVEL);
+ eassert (bidi_it->stack_idx < BIDI_MAXLEVEL);
bidi_it->level_stack[bidi_it->stack_idx].level = level;
bidi_it->level_stack[bidi_it->stack_idx].override = override;
}
{
if (bidi_cache_size > BIDI_CACHE_CHUNK)
{
- bidi_cache
- = (struct bidi_it *) xrealloc (bidi_cache, BIDI_CACHE_CHUNK * elsz);
+ bidi_cache = xrealloc (bidi_cache, BIDI_CACHE_CHUNK * elsz);
bidi_cache_size = BIDI_CACHE_CHUNK;
}
bidi_cache_reset ();
int current_scan_dir = bidi_it->scan_dir;
if (idx < bidi_cache_start || idx >= bidi_cache_idx)
- abort ();
+ emacs_abort ();
bidi_copy_it (bidi_it, &bidi_cache[idx]);
bidi_it->scan_dir = current_scan_dir;
resolved levels in cached states. DIR, if non-zero, means search
in that direction from the last cache hit. */
static inline ptrdiff_t
-bidi_cache_search (EMACS_INT charpos, int level, int dir)
+bidi_cache_search (ptrdiff_t charpos, int level, int dir)
{
ptrdiff_t i, i_start;
that is lower than LEVEL, and return its cache slot index. DIR is
the direction to search, starting with the last used cache slot.
If DIR is zero, we search backwards from the last occupied cache
- slot. BEFORE, if non-zero, means return the index of the slot that
+ slot. BEFORE means return the index of the slot that
is ``before'' the level change in the search direction. That is,
given the cached levels like this:
and assuming we are at the position cached at the slot marked with
C, searching backwards (DIR = -1) for LEVEL = 2 will return the
index of slot B or A, depending whether BEFORE is, respectively,
- non-zero or zero. */
+ true or false. */
static ptrdiff_t
-bidi_cache_find_level_change (int level, int dir, int before)
+bidi_cache_find_level_change (int level, int dir, bool before)
{
if (bidi_cache_idx)
{
ptrdiff_t i = dir ? bidi_cache_last_idx : bidi_cache_idx - 1;
int incr = before ? 1 : 0;
- xassert (!dir || bidi_cache_last_idx >= 0);
+ eassert (!dir || bidi_cache_last_idx >= 0);
if (!dir)
dir = -1;
}
static inline void
-bidi_cache_iterator_state (struct bidi_it *bidi_it, int resolved)
+bidi_cache_iterator_state (struct bidi_it *bidi_it, bool resolved)
{
ptrdiff_t idx;
/* We should never cache on backward scans. */
if (bidi_it->scan_dir == -1)
- abort ();
+ emacs_abort ();
idx = bidi_cache_search (bidi_it->charpos, -1, 1);
if (idx < 0)
idx = bidi_cache_start;
}
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
bidi_copy_it (&bidi_cache[idx], bidi_it);
if (!resolved)
bidi_cache[idx].resolved_level = -1;
}
static inline bidi_type_t
-bidi_cache_find (EMACS_INT charpos, int level, struct bidi_it *bidi_it)
+bidi_cache_find (ptrdiff_t charpos, int level, struct bidi_it *bidi_it)
{
ptrdiff_t i = bidi_cache_search (charpos, level, bidi_it->scan_dir);
bidi_peek_at_next_level (struct bidi_it *bidi_it)
{
if (bidi_cache_idx == bidi_cache_start || bidi_cache_last_idx == -1)
- abort ();
+ emacs_abort ();
return bidi_cache[bidi_cache_last_idx + bidi_it->scan_dir].resolved_level;
}
/* Save the current iterator state in its entirety after the last
used cache slot. */
bidi_cache_ensure_space (bidi_cache_idx);
- memcpy (&bidi_cache[bidi_cache_idx++], bidi_it, sizeof (struct bidi_it));
+ bidi_cache[bidi_cache_idx++] = *bidi_it;
/* Push the current cache start onto the stack. */
- xassert (bidi_cache_sp < IT_STACK_SIZE);
+ eassert (bidi_cache_sp < IT_STACK_SIZE);
bidi_cache_start_stack[bidi_cache_sp++] = bidi_cache_start;
/* Start a new level of cache, and make it empty. */
bidi_pop_it (struct bidi_it *bidi_it)
{
if (bidi_cache_start <= 0)
- abort ();
+ emacs_abort ();
/* Reset the next free cache slot index to what it was before the
call to bidi_push_it. */
bidi_cache_idx = bidi_cache_start - 1;
/* Restore the bidi iterator state saved in the cache. */
- memcpy (bidi_it, &bidi_cache[bidi_cache_idx], sizeof (struct bidi_it));
+ *bidi_it = bidi_cache[bidi_cache_idx];
/* Pop the previous cache start from the stack. */
if (bidi_cache_sp <= 0)
- abort ();
+ emacs_abort ();
bidi_cache_start = bidi_cache_start_stack[--bidi_cache_sp];
/* Invalidate the last-used cache slot data. */
/* Restore the cache state from a copy stashed away by
bidi_shelve_cache, and free the buffer used to stash that copy.
- JUST_FREE non-zero means free the buffer, but don't restore the
+ JUST_FREE means free the buffer, but don't restore the
cache; used when the corresponding iterator is discarded instead of
being restored. */
void
-bidi_unshelve_cache (void *databuf, int just_free)
+bidi_unshelve_cache (void *databuf, bool just_free)
{
unsigned char *p = databuf;
{
bidi_type_table = uniprop_table (intern ("bidi-class"));
if (NILP (bidi_type_table))
- abort ();
+ emacs_abort ();
staticpro (&bidi_type_table);
bidi_mirror_table = uniprop_table (intern ("mirroring"));
if (NILP (bidi_mirror_table))
- abort ();
+ emacs_abort ();
staticpro (&bidi_mirror_table);
Qparagraph_start = intern ("paragraph-start");
/* Initialize the bidi iterator from buffer/string position CHARPOS. */
void
-bidi_init_it (EMACS_INT charpos, EMACS_INT bytepos, int frame_window_p,
+bidi_init_it (ptrdiff_t charpos, ptrdiff_t bytepos, bool frame_window_p,
struct bidi_it *bidi_it)
{
if (! bidi_initialized)
/* Count bytes in string S between BEG/BEGBYTE and END. BEG and END
are zero-based character positions in S, BEGBYTE is byte position
- corresponding to BEG. UNIBYTE, if non-zero, means S is a unibyte
- string. */
-static inline EMACS_INT
-bidi_count_bytes (const unsigned char *s, const EMACS_INT beg,
- const EMACS_INT begbyte, const EMACS_INT end, int unibyte)
+ corresponding to BEG. UNIBYTE means S is a unibyte string. */
+static inline ptrdiff_t
+bidi_count_bytes (const unsigned char *s, const ptrdiff_t beg,
+ const ptrdiff_t begbyte, const ptrdiff_t end, bool unibyte)
{
- EMACS_INT pos = beg;
+ ptrdiff_t pos = beg;
const unsigned char *p = s + begbyte, *start = p;
if (unibyte)
else
{
if (!CHAR_HEAD_P (*p))
- abort ();
+ emacs_abort ();
while (pos < end)
{
/* Fetch and returns the character at byte position BYTEPOS. If S is
non-NULL, fetch the character from string S; otherwise fetch the
- character from the current buffer. UNIBYTE non-zero means S is a
+ character from the current buffer. UNIBYTE means S is a
unibyte string. */
static inline int
-bidi_char_at_pos (EMACS_INT bytepos, const unsigned char *s, int unibyte)
+bidi_char_at_pos (ptrdiff_t bytepos, const unsigned char *s, bool unibyte)
{
if (s)
{
specifies the character position of the next display string, or -1
if not yet computed. When the next character is at or beyond that
position, the function updates DISP_POS with the position of the
- next display string. DISP_PROP non-zero means that there's really
+ next display string. *DISP_PROP non-zero means that there's really
a display string at DISP_POS, as opposed to when we searched till
- DISP_POS without finding one. If DISP_PROP is 2, it means the
+ DISP_POS without finding one. If *DISP_PROP is 2, it means the
display spec is of the form `(space ...)', which is replaced with
u+2029 to handle it as a paragraph separator. STRING->s is the C
string to iterate, or NULL if iterating over a buffer or a Lisp
string; in the latter case, STRING->lstring is the Lisp string. */
static inline int
-bidi_fetch_char (EMACS_INT bytepos, EMACS_INT charpos, EMACS_INT *disp_pos,
+bidi_fetch_char (ptrdiff_t bytepos, ptrdiff_t charpos, ptrdiff_t *disp_pos,
int *disp_prop, struct bidi_string_data *string,
- int frame_window_p, EMACS_INT *ch_len, EMACS_INT *nchars)
+ bool frame_window_p, ptrdiff_t *ch_len, ptrdiff_t *nchars)
{
int ch;
- EMACS_INT endpos
+ ptrdiff_t endpos
= (string->s || STRINGP (string->lstring)) ? string->schars : ZV;
struct text_pos pos;
int len;
}
else if (charpos >= *disp_pos && *disp_prop)
{
- EMACS_INT disp_end_pos;
+ ptrdiff_t disp_end_pos;
/* We don't expect to find ourselves in the middle of a display
property. Hopefully, it will never be needed. */
if (charpos > *disp_pos)
- abort ();
+ emacs_abort ();
/* Text covered by `display' properties and overlays with
display properties or display strings is handled as a single
character that represents the entire run of characters
}
*nchars = disp_end_pos - *disp_pos;
if (*nchars <= 0)
- abort ();
+ emacs_abort ();
if (string->s)
*ch_len = bidi_count_bytes (string->s, *disp_pos, bytepos,
disp_end_pos, string->unibyte);
following the buffer position, -1 if position is at the beginning
of a new paragraph, or -2 if position is neither at beginning nor
at end of a paragraph. */
-static EMACS_INT
-bidi_at_paragraph_end (EMACS_INT charpos, EMACS_INT bytepos)
+static ptrdiff_t
+bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos)
{
Lisp_Object sep_re;
Lisp_Object start_re;
- EMACS_INT val;
+ ptrdiff_t val;
sep_re = paragraph_separate_re;
start_re = paragraph_start_re;
Value is the byte position of the paragraph's beginning, or
BEGV_BYTE if paragraph_start_re is still not found after looking
back MAX_PARAGRAPH_SEARCH lines in the buffer. */
-static EMACS_INT
-bidi_find_paragraph_start (EMACS_INT pos, EMACS_INT pos_byte)
+static ptrdiff_t
+bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte)
{
Lisp_Object re = paragraph_start_re;
- EMACS_INT limit = ZV, limit_byte = ZV_BYTE;
- EMACS_INT n = 0;
+ ptrdiff_t limit = ZV, limit_byte = ZV_BYTE;
+ ptrdiff_t n = 0;
while (pos_byte > BEGV_BYTE
&& n++ < MAX_PARAGRAPH_SEARCH
return pos_byte;
}
+/* On a 3.4 GHz machine, searching forward for a strong directional
+ character in a long paragraph full of weaks or neutrals takes about
+ 1 ms for each 20K characters. The number below limits each call to
+ bidi_paragraph_init to less than 10 ms even on slow machines. */
+#define MAX_STRONG_CHAR_SEARCH 100000
+
/* Determine the base direction, a.k.a. base embedding level, of the
paragraph we are about to iterate through. If DIR is either L2R or
R2L, just use that. Otherwise, determine the paragraph direction
from the first strong directional character of the paragraph.
- NO_DEFAULT_P non-zero means don't default to L2R if the paragraph
+ NO_DEFAULT_P means don't default to L2R if the paragraph
has no strong directional characters and both DIR and
bidi_it->paragraph_dir are NEUTRAL_DIR. In that case, search back
in the buffer until a paragraph is found with a strong character,
direction as the preceding paragraph, even though Emacs generally
views the separator as not belonging to any paragraph. */
void
-bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p)
+bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p)
{
- EMACS_INT bytepos = bidi_it->bytepos;
- int string_p = bidi_it->string.s != NULL || STRINGP (bidi_it->string.lstring);
- EMACS_INT pstartbyte;
+ ptrdiff_t bytepos = bidi_it->bytepos;
+ bool string_p = bidi_it->string.s || STRINGP (bidi_it->string.lstring);
+ ptrdiff_t pstartbyte;
/* Note that begbyte is a byte position, while end is a character
position. Yes, this is ugly, but we are trying to avoid costly
calls to BYTE_TO_CHAR and its ilk. */
- EMACS_INT begbyte = string_p ? 0 : BEGV_BYTE;
- EMACS_INT end = string_p ? bidi_it->string.schars : ZV;
+ ptrdiff_t begbyte = string_p ? 0 : BEGV_BYTE;
+ ptrdiff_t end = string_p ? bidi_it->string.schars : ZV;
/* Special case for an empty buffer. */
if (bytepos == begbyte && bidi_it->charpos == end)
dir = L2R;
/* We should never be called at EOB or before BEGV. */
else if (bidi_it->charpos >= end || bytepos < begbyte)
- abort ();
+ emacs_abort ();
if (dir == L2R)
{
else if (dir == NEUTRAL_DIR) /* P2 */
{
int ch;
- EMACS_INT ch_len, nchars;
- EMACS_INT pos, disp_pos = -1;
+ ptrdiff_t ch_len, nchars;
+ ptrdiff_t pos, disp_pos = -1;
int disp_prop = 0;
bidi_type_t type;
const unsigned char *s;
bidi_it->separator_limit = -1;
bidi_it->new_paragraph = 0;
- /* The following loop is run more than once only if NO_DEFAULT_P
- is non-zero, and only if we are iterating on a buffer. */
+ /* The following loop is run more than once only if NO_DEFAULT_P,
+ and only if we are iterating on a buffer. */
do {
+ ptrdiff_t pos1;
+
bytepos = pstartbyte;
if (!string_p)
pos = BYTE_TO_CHAR (bytepos);
bidi_it->frame_window_p, &ch_len, &nchars);
type = bidi_get_type (ch, NEUTRAL_DIR);
+ pos1 = pos;
for (pos += nchars, bytepos += ch_len;
- (bidi_get_category (type) != STRONG)
- || (bidi_ignore_explicit_marks_for_paragraph_level
- && (type == RLE || type == RLO
- || type == LRE || type == LRO));
+ ((bidi_get_category (type) != STRONG)
+ || (bidi_ignore_explicit_marks_for_paragraph_level
+ && (type == RLE || type == RLO
+ || type == LRE || type == LRO)))
+ /* Stop when searched too far into an abnormally large
+ paragraph full of weak or neutral characters. */
+ && pos - pos1 < MAX_STRONG_CHAR_SEARCH;
type = bidi_get_type (ch, NEUTRAL_DIR))
{
if (pos >= end)
bidi_it->paragraph_dir = L2R; /* P3 and HL1 */
else
{
- EMACS_INT prevpbyte = pstartbyte;
- EMACS_INT p = BYTE_TO_CHAR (pstartbyte), pbyte = pstartbyte;
+ ptrdiff_t prevpbyte = pstartbyte;
+ ptrdiff_t p = BYTE_TO_CHAR (pstartbyte), pbyte = pstartbyte;
/* Find the beginning of the previous paragraph, if any. */
while (pbyte > BEGV_BYTE && prevpbyte >= pstartbyte)
&& no_default_p && bidi_it->paragraph_dir == NEUTRAL_DIR);
}
else
- abort ();
+ emacs_abort ();
/* Contrary to UAX#9 clause P3, we only default the paragraph
direction to L2R if we have no previous usable paragraph
The rest of this file constitutes the core of the UBA implementation.
***********************************************************************/
-static inline int
+static inline bool
bidi_explicit_dir_char (int ch)
{
bidi_type_t ch_type;
if (!bidi_initialized)
- abort ();
+ emacs_abort ();
ch_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch));
return (ch_type == LRE || ch_type == LRO
|| ch_type == RLE || ch_type == RLO
int current_level;
int new_level;
bidi_dir_t override;
- int string_p = bidi_it->string.s != NULL || STRINGP (bidi_it->string.lstring);
+ bool string_p = bidi_it->string.s || STRINGP (bidi_it->string.lstring);
/* If reseat()'ed, don't advance, so as to start iteration from the
position where we were reseated. bidi_it->bytepos can be less
/* Advance to the next character, skipping characters covered by
display strings (nchars > 1). */
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
bidi_it->charpos += bidi_it->nchars;
if (bidi_it->ch_len == 0)
- abort ();
+ emacs_abort ();
bidi_it->bytepos += bidi_it->ch_len;
}
{
int prev_level = bidi_it->level_stack[bidi_it->stack_idx].level;
int new_level = bidi_resolve_explicit_1 (bidi_it);
- EMACS_INT eob = bidi_it->string.s ? bidi_it->string.schars : ZV;
+ ptrdiff_t eob = bidi_it->string.s ? bidi_it->string.schars : ZV;
const unsigned char *s
= (STRINGP (bidi_it->string.lstring)
? SDATA (bidi_it->string.lstring)
}
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
if (level == prev_level) /* empty embedding */
saved_it.ignore_bn_limit = bidi_it->charpos + bidi_it->nchars;
else /* this embedding is non-empty */
int next_char;
bidi_type_t type_of_next;
struct bidi_it saved_it;
- EMACS_INT eob
+ ptrdiff_t eob
= ((STRINGP (bidi_it->string.lstring) || bidi_it->string.s)
? bidi_it->string.schars : ZV);
|| type == RLE
|| type == RLO
|| type == PDF)
- abort ();
+ emacs_abort ();
if (new_level != prev_level
|| bidi_it->type == NEUTRAL_B)
else if (bidi_it->sor == L2R)
type = STRONG_L;
else /* shouldn't happen! */
- abort ();
+ emacs_abort ();
}
if (type == WEAK_EN /* W2 */
&& bidi_it->last_strong.type_after_w1 == STRONG_AL)
}
else if (bidi_it->next_en_pos >=0)
{
- EMACS_INT en_pos = bidi_it->charpos + bidi_it->nchars;
+ ptrdiff_t en_pos = bidi_it->charpos + bidi_it->nchars;
const unsigned char *s = (STRINGP (bidi_it->string.lstring)
? SDATA (bidi_it->string.lstring)
: bidi_it->string.s);
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
next_char
= (bidi_it->charpos + bidi_it->nchars >= eob
? BIDI_EOB
|| type == NEUTRAL_S
|| type == NEUTRAL_WS
|| type == NEUTRAL_ON))
- abort ();
+ emacs_abort ();
if ((type != NEUTRAL_B /* Don't risk entering the long loop below if
we are already at paragraph end. */
bidi_type_t next_type;
if (bidi_it->scan_dir == -1)
- abort ();
+ emacs_abort ();
bidi_copy_it (&saved_it, bidi_it);
/* Scan the text forward until we find the first non-neutral
case STRONG_AL:
/* Actually, STRONG_AL cannot happen here, because
bidi_resolve_weak converts it to STRONG_R, per W3. */
- xassert (type != STRONG_AL);
+ eassert (type != STRONG_AL);
next_type = type;
break;
case WEAK_EN:
break;
case WEAK_BN:
if (!bidi_explicit_dir_char (bidi_it->ch))
- abort (); /* can't happen: BNs are skipped */
+ emacs_abort (); /* can't happen: BNs are skipped */
/* FALLTHROUGH */
case NEUTRAL_B:
/* Marched all the way to the end of this level run.
}
break;
default:
- abort ();
+ emacs_abort ();
}
type = bidi_resolve_neutral_1 (saved_it.prev_for_neutral.type,
next_type, current_level);
/* This should always be called during a forward scan. */
if (bidi_it->scan_dir != 1)
- abort ();
+ emacs_abort ();
/* Reset the limit until which to ignore BNs if we step out of the
area where we found only empty levels. */
bidi_type_t type;
int level, prev_level = -1;
struct bidi_saved_info next_for_neutral;
- EMACS_INT next_char_pos = -2;
+ ptrdiff_t next_char_pos = -2;
if (bidi_it->scan_dir == 1)
{
- EMACS_INT eob
+ ptrdiff_t eob
= ((bidi_it->string.s || STRINGP (bidi_it->string.lstring))
? bidi_it->string.schars : ZV);
if (bidi_it->scan_dir > 0)
{
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
next_char_pos = bidi_it->charpos + bidi_it->nchars;
}
else if (bidi_it->charpos >= bob)
if (bidi_it->scan_dir == -1)
/* If we are going backwards, the iterator state is already cached
from previous scans, and should be fully resolved. */
- abort ();
+ emacs_abort ();
if (type == UNKNOWN_BT)
type = bidi_type_of_next_char (bidi_it);
|| (type == WEAK_BN && prev_level == level))
{
if (bidi_it->next_for_neutral.type == UNKNOWN_BT)
- abort ();
+ emacs_abort ();
/* If the cached state shows a neutral character, it was not
resolved by bidi_resolve_neutral, so do it now. */
|| type == WEAK_BN
|| type == WEAK_EN
|| type == WEAK_AN))
- abort ();
+ emacs_abort ();
bidi_it->type = type;
bidi_check_type (bidi_it->type);
&& bidi_it->next_for_ws.type == UNKNOWN_BT)
{
int ch;
- EMACS_INT clen = bidi_it->ch_len;
- EMACS_INT bpos = bidi_it->bytepos;
- EMACS_INT cpos = bidi_it->charpos;
- EMACS_INT disp_pos = bidi_it->disp_pos;
- EMACS_INT nc = bidi_it->nchars;
+ ptrdiff_t clen = bidi_it->ch_len;
+ ptrdiff_t bpos = bidi_it->bytepos;
+ ptrdiff_t cpos = bidi_it->charpos;
+ ptrdiff_t disp_pos = bidi_it->disp_pos;
+ ptrdiff_t nc = bidi_it->nchars;
struct bidi_string_data bs = bidi_it->string;
bidi_type_t chtype;
- int fwp = bidi_it->frame_window_p;
+ bool fwp = bidi_it->frame_window_p;
int dpp = bidi_it->disp_prop;
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
do {
ch = bidi_fetch_char (bpos += clen, cpos += nc, &disp_pos, &dpp, &bs,
fwp, &clen, &nc);
return level;
}
-/* Move to the other edge of a level given by LEVEL. If END_FLAG is
- non-zero, we are at the end of a level, and we need to prepare to
+/* Move to the other edge of a level given by LEVEL. If END_FLAG,
+ we are at the end of a level, and we need to prepare to
resume the scan of the lower level.
If this level's other edge is cached, we simply jump to it, filling
function moves to point C, whereas the UAX#9 ``level 2 run'' ends
at point B. */
static void
-bidi_find_other_level_edge (struct bidi_it *bidi_it, int level, int end_flag)
+bidi_find_other_level_edge (struct bidi_it *bidi_it, int level, bool end_flag)
{
int dir = end_flag ? -bidi_it->scan_dir : bidi_it->scan_dir;
ptrdiff_t idx;
{
int new_level;
+ /* If we are at end of level, its edges must be cached. */
if (end_flag)
- abort (); /* if we are at end of level, its edges must be cached */
+ emacs_abort ();
bidi_cache_iterator_state (bidi_it, 1);
do {
struct gcpro gcpro1;
if (bidi_it->charpos < 0 || bidi_it->bytepos < 0)
- abort ();
+ emacs_abort ();
if (bidi_it->scan_dir == 0)
{
scanning the text whenever we find a level change. */
if (new_level != old_level)
{
- int ascending = new_level > old_level;
+ bool ascending = new_level > old_level;
int level_to_search = ascending ? old_level + 1 : old_level;
int incr = ascending ? 1 : -1;
int expected_next_level = old_level + incr;
bidi_it->separator_limit = bidi_it->string.schars;
else if (bidi_it->bytepos < ZV_BYTE)
{
- EMACS_INT sep_len
+ ptrdiff_t sep_len
= bidi_at_paragraph_end (bidi_it->charpos + bidi_it->nchars,
bidi_it->bytepos + bidi_it->ch_len);
if (bidi_it->nchars <= 0)
- abort ();
+ emacs_abort ();
if (sep_len >= 0)
{
bidi_it->new_paragraph = 1;
fputs ("\n", stderr);
fputs ("pos ", stderr);
for (i = 0; i < bidi_cache_idx; i++)
- fprintf (stderr, "%*"pI"d", ndigits, bidi_cache[i].charpos);
+ fprintf (stderr, "%*"pD"d", ndigits, bidi_cache[i].charpos);
fputs ("\n", stderr);
}
#ifndef EMACS_BLOCKINPUT_H
#define EMACS_BLOCKINPUT_H
-#include "atimer.h"
+INLINE_HEADER_BEGIN
+#ifndef BLOCKINPUT_INLINE
+# define BLOCKINPUT_INLINE INLINE
+#endif
-/* When Emacs is using signal-driven input, the processing of those
- input signals can get pretty hairy. For example, when Emacs is
- running under X windows, handling an input signal can entail
- retrieving events from the X event queue, or making other X calls.
-
- If an input signal occurs while Emacs is in the midst of some
- non-reentrant code, and the signal processing invokes that same
- code, we lose. For example, malloc and the Xlib functions aren't
- usually re-entrant, and both are used by the X input signal handler
- - if we try to process an input signal in the midst of executing
- any of these functions, we'll lose.
+/* Emacs should avoid doing anything hairy in a signal handler, because
+ so many system functions are non-reentrant. For example, malloc
+ and the Xlib functions aren't usually re-entrant, so if they were
+ used by the SIGIO handler, we'd lose.
To avoid this, we make the following requirements:
- * Everyone must evaluate BLOCK_INPUT before entering these functions,
- and then call UNBLOCK_INPUT after performing them. Calls
- BLOCK_INPUT and UNBLOCK_INPUT may be nested.
+ * Everyone must evaluate BLOCK_INPUT before performing actions that
+ might conflict with a signal handler, and then call UNBLOCK_INPUT
+ after performing them. Calls BLOCK_INPUT and UNBLOCK_INPUT may be
+ nested.
* Any complicated interrupt handling code should test
- interrupt_input_blocked, and put off its work until later.
+ INPUT_BLOCKED_P, and put off its work until later.
* If the interrupt handling code wishes, it may set
- interrupt_input_pending to a non-zero value. If that flag is set
- when input becomes unblocked, UNBLOCK_INPUT will send a new SIGIO. */
-
-extern volatile int interrupt_input_blocked;
+ pending_signals to a non-zero value. If that flag is set
+ when input becomes unblocked, UNBLOCK_INPUT will then read
+ input and process timers.
-/* Nonzero means an input interrupt has arrived
- during the current critical section. */
-extern int interrupt_input_pending;
+ Historically, Emacs signal handlers did much more than they do now,
+ and this caused many BLOCK_INPUT calls to be sprinkled around the code.
+ FIXME: Remove calls that aren't needed now. */
+extern volatile int interrupt_input_blocked;
-/* Non-zero means asynchronous timers should be run when input is
- unblocked. */
-
-extern int pending_atimers;
+/* Begin critical section. */
+BLOCKINPUT_INLINE void
+block_input (void)
+{
+ interrupt_input_blocked++;
+}
-/* Begin critical section. */
-#define BLOCK_INPUT (interrupt_input_blocked++)
-
-/* End critical section.
-
- If doing signal-driven input, and a signal came in when input was
- blocked, reinvoke the signal handler now to deal with it.
-
- We used to have two possible definitions of this macro - one for
- when SIGIO was #defined, and one for when it wasn't; when SIGIO
- wasn't #defined, we wouldn't bother to check if we should re-invoke
- the signal handler. But that doesn't work very well; some of the
- files which use this macro don't #include the right files to get
- SIGIO.
-
- So, we always test interrupt_input_pending now; that's not too
- expensive, and it'll never get set if we don't need to resignal. */
-
-#define UNBLOCK_INPUT \
- do \
- { \
- --interrupt_input_blocked; \
- if (interrupt_input_blocked == 0) \
- { \
- if (interrupt_input_pending) \
- reinvoke_input_signal (); \
- if (pending_atimers) \
- do_pending_atimers (); \
- } \
- else if (interrupt_input_blocked < 0) \
- abort (); \
- } \
- while (0)
-
-/* Undo any number of BLOCK_INPUT calls,
- and also reinvoke any pending signal. */
-
-#define TOTALLY_UNBLOCK_INPUT \
- do if (interrupt_input_blocked != 0) \
- { \
- interrupt_input_blocked = 1; \
- UNBLOCK_INPUT; \
- } \
- while (0)
-
-/* Undo any number of BLOCK_INPUT calls down to level LEVEL,
- and also (if the level is now 0) reinvoke any pending signal. */
-
-#define UNBLOCK_INPUT_TO(LEVEL) \
- do \
- { \
- interrupt_input_blocked = (LEVEL) + 1; \
- UNBLOCK_INPUT; \
- } \
- while (0)
-
-#define UNBLOCK_INPUT_RESIGNAL UNBLOCK_INPUT
+extern void unblock_input (void);
+extern void totally_unblock_input (void);
+extern void unblock_input_to (int);
/* In critical section ? */
-#define INPUT_BLOCKED_P (interrupt_input_blocked > 0)
-/* Defined in keyboard.c */
-extern void reinvoke_input_signal (void);
+BLOCKINPUT_INLINE bool
+input_blocked_p (void)
+{
+ return 0 < interrupt_input_blocked;
+}
-#endif /* EMACS_BLOCKINPUT_H */
+INLINE_HEADER_END
+#endif /* EMACS_BLOCKINPUT_H */
#include <config.h>
+#define BUFFER_INLINE EXTERN_INLINE
+
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/param.h>
#include <errno.h>
#include <stdio.h>
-#include <setjmp.h>
#include <unistd.h>
#include <verify.h>
#include "intervals.h"
#include "window.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "region-cache.h"
#include "indent.h"
#include "blockinput.h"
#include "keymap.h"
#include "frame.h"
-struct buffer *current_buffer; /* the current buffer */
+struct buffer *current_buffer; /* The current buffer. */
/* First buffer in chain of all buffers (in reverse order of creation).
Threaded through ->header.next.buffer. */
Setting the default value also goes through the alist of buffers
and stores into each buffer that does not say it has a local value. */
-DECL_ALIGN (struct buffer, buffer_defaults);
-
-/* A Lisp_Object pointer to the above, used for staticpro */
-
-static Lisp_Object Vbuffer_defaults;
+struct buffer alignas (GCALIGNMENT) buffer_defaults;
/* This structure marks which slots in a buffer have corresponding
default values in buffer_defaults.
and the corresponding slot in buffer_defaults is not used.
If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
- zero, that is a bug */
+ zero, that is a bug. */
struct buffer buffer_local_flags;
/* This structure holds the names of symbols whose values may be
- buffer-local. It is indexed and accessed in the same way as the above. */
+ buffer-local. It is indexed and accessed in the same way as the above. */
-DECL_ALIGN (struct buffer, buffer_local_symbols);
-
-/* A Lisp_Object pointer to the above, used for staticpro */
-static Lisp_Object Vbuffer_local_symbols;
+struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
/* Return the symbol of the per-buffer variable at offset OFFSET in
the buffer structure. */
/* 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. */
int last_per_buffer_idx;
-static Lisp_Object Fset_buffer_major_mode (Lisp_Object);
-static Lisp_Object Fdelete_overlay (Lisp_Object);
static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
- int after, Lisp_Object arg1,
+ bool after, Lisp_Object arg1,
Lisp_Object arg2, Lisp_Object arg3);
static void swap_out_buffer_local_variables (struct buffer *b);
-static void reset_buffer_local_variables (struct buffer *b, int permanent_too);
+static void reset_buffer_local_variables (struct buffer *, bool);
-/* Alist of all buffer names vs the buffers. */
+/* Alist of all buffer names vs the buffers. */
/* This used to be a variable, but is no longer,
to prevent lossage due to user rplac'ing this alist or its elements. */
Lisp_Object Vbuffer_alist;
Lisp_Object Qfirst_change_hook;
Lisp_Object Qbefore_change_functions;
Lisp_Object Qafter_change_functions;
-static Lisp_Object Qucs_set_table_for_input;
static Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
static Lisp_Object Qpermanent_local_hook;
static Lisp_Object Qprotected_field;
-static Lisp_Object QSFundamental; /* A string "Fundamental" */
+static Lisp_Object QSFundamental; /* A string "Fundamental". */
static Lisp_Object Qkill_buffer_hook;
static Lisp_Object Qbuffer_list_update_hook;
static void alloc_buffer_text (struct buffer *, ptrdiff_t);
static void free_buffer_text (struct buffer *b);
static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *);
-static void modify_overlay (struct buffer *, EMACS_INT, EMACS_INT);
-static Lisp_Object buffer_lisp_local_variables (struct buffer *, int);
+static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
+static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
+
+/* These setters are used only in this file, so they can be private. */
+static inline void
+bset_abbrev_mode (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (abbrev_mode) = val;
+}
+static inline void
+bset_abbrev_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (abbrev_table) = val;
+}
+static inline void
+bset_auto_fill_function (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (auto_fill_function) = val;
+}
+static inline void
+bset_auto_save_file_format (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (auto_save_file_format) = val;
+}
+static inline void
+bset_auto_save_file_name (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (auto_save_file_name) = val;
+}
+static inline void
+bset_backed_up (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (backed_up) = val;
+}
+static inline void
+bset_begv_marker (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (begv_marker) = val;
+}
+static inline void
+bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (bidi_display_reordering) = val;
+}
+static inline void
+bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (buffer_file_coding_system) = val;
+}
+static inline void
+bset_cache_long_line_scans (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (cache_long_line_scans) = val;
+}
+static inline void
+bset_case_fold_search (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (case_fold_search) = val;
+}
+static inline void
+bset_ctl_arrow (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (ctl_arrow) = val;
+}
+static inline void
+bset_cursor_in_non_selected_windows (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (cursor_in_non_selected_windows) = val;
+}
+static inline void
+bset_cursor_type (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (cursor_type) = val;
+}
+static inline void
+bset_display_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (display_table) = val;
+}
+static inline void
+bset_extra_line_spacing (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (extra_line_spacing) = val;
+}
+static inline void
+bset_file_format (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (file_format) = val;
+}
+static inline void
+bset_file_truename (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (file_truename) = val;
+}
+static inline void
+bset_fringe_cursor_alist (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (fringe_cursor_alist) = val;
+}
+static inline void
+bset_fringe_indicator_alist (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (fringe_indicator_alist) = val;
+}
+static inline void
+bset_fringes_outside_margins (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (fringes_outside_margins) = val;
+}
+static inline void
+bset_header_line_format (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (header_line_format) = val;
+}
+static inline void
+bset_indicate_buffer_boundaries (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (indicate_buffer_boundaries) = val;
+}
+static inline void
+bset_indicate_empty_lines (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (indicate_empty_lines) = val;
+}
+static inline void
+bset_invisibility_spec (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (invisibility_spec) = val;
+}
+static inline void
+bset_left_fringe_width (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (left_fringe_width) = val;
+}
+static inline void
+bset_major_mode (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (major_mode) = val;
+}
+static inline void
+bset_mark (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (mark) = val;
+}
+static inline void
+bset_minor_modes (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (minor_modes) = val;
+}
+static inline void
+bset_mode_line_format (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (mode_line_format) = val;
+}
+static inline void
+bset_mode_name (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (mode_name) = val;
+}
+static inline void
+bset_name (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (name) = val;
+}
+static inline void
+bset_overwrite_mode (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (overwrite_mode) = val;
+}
+static inline void
+bset_pt_marker (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (pt_marker) = val;
+}
+static inline void
+bset_right_fringe_width (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (right_fringe_width) = val;
+}
+static inline void
+bset_save_length (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (save_length) = val;
+}
+static inline void
+bset_scroll_bar_width (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (scroll_bar_width) = val;
+}
+static inline void
+bset_scroll_down_aggressively (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (scroll_down_aggressively) = val;
+}
+static inline void
+bset_scroll_up_aggressively (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (scroll_up_aggressively) = val;
+}
+static inline void
+bset_selective_display (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (selective_display) = val;
+}
+static inline void
+bset_selective_display_ellipses (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (selective_display_ellipses) = val;
+}
+static inline void
+bset_vertical_scroll_bar_type (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (vertical_scroll_bar_type) = val;
+}
+static inline void
+bset_word_wrap (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (word_wrap) = val;
+}
+static inline void
+bset_zv_marker (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (zv_marker) = val;
+}
/* For debugging; temporary. See set_buffer_internal. */
/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
Value is nil if OBJECT is not a buffer or if it has been killed. */)
(Lisp_Object object)
{
- return ((BUFFERP (object) && ! NILP (BVAR (XBUFFER (object), name)))
+ return ((BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
? Qt : Qnil);
}
/* An ordinary buffer uses its own struct buffer_text. */
b->text = &b->own_text;
- b->base_buffer = 0;
+ b->base_buffer = NULL;
+ /* No one shares the text with us now. */
+ b->indirections = 0;
BUF_GAP_SIZE (b) = 20;
- BLOCK_INPUT;
+ block_input ();
/* We allocate extra 1-byte at the tail and keep it always '\0' for
anchoring a search. */
alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
- UNBLOCK_INPUT;
+ unblock_input ();
if (! BUF_BEG_ADDR (b))
buffer_memory_full (BUF_GAP_SIZE (b) + 1);
BUF_CHARS_MODIFF (b) = 1;
BUF_OVERLAY_MODIFF (b) = 1;
BUF_SAVE_MODIFF (b) = 1;
- BUF_INTERVALS (b) = 0;
+ set_buffer_intervals (b, NULL);
BUF_UNCHANGED_MODIFIED (b) = 1;
BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
BUF_END_UNCHANGED (b) = 0;
b->newline_cache = 0;
b->width_run_cache = 0;
- BVAR (b, width_table) = Qnil;
+ bset_width_table (b, Qnil);
b->prevent_redisplay_optimizations_p = 1;
- /* Put this on the chain of all buffers including killed ones. */
- b->header.next.buffer = all_buffers;
- all_buffers = b;
-
/* 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_pt_marker (b, Qnil);
+ bset_begv_marker (b, Qnil);
+ bset_zv_marker (b, Qnil);
name = Fcopy_sequence (buffer_or_name);
- STRING_SET_INTERVALS (name, NULL_INTERVAL);
- BVAR (b, name) = name;
+ set_string_intervals (name, NULL);
+ bset_name (b, name);
- BVAR (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt;
+ bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
reset_buffer (b);
reset_buffer_local_variables (b, 1);
- BVAR (b, mark) = Fmake_marker ();
+ bset_mark (b, Fmake_marker ());
BUF_MARKERS (b) = NULL;
- BVAR (b, name) = name;
/* Put this in the alist of all live buffers. */
XSETBUFFER (buffer, b);
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, Qbuffer_list_update_hook);
- /* An error in calling the function here (should someone redefine it)
- can lead to infinite regress until you run out of stack. rms
- says that's not worth protecting against. */
- if (!NILP (Ffboundp (Qucs_set_table_for_input)))
- /* buffer is on buffer-alist, so no gcpro. */
- call1 (Qucs_set_table_for_input, buffer);
-
return buffer;
}
static struct Lisp_Overlay *
copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
{
- Lisp_Object buffer;
struct Lisp_Overlay *result = NULL, *tail = NULL;
- XSETBUFFER (buffer, b);
-
for (; list; list = list->next)
{
- Lisp_Object overlay, start, end, old_overlay;
- EMACS_INT charpos;
-
- XSETMISC (old_overlay, list);
- charpos = marker_position (OVERLAY_START (old_overlay));
- start = Fmake_marker ();
- Fset_marker (start, make_number (charpos), buffer);
- XMARKER (start)->insertion_type
- = XMARKER (OVERLAY_START (old_overlay))->insertion_type;
-
- charpos = marker_position (OVERLAY_END (old_overlay));
- end = Fmake_marker ();
- Fset_marker (end, make_number (charpos), buffer);
- XMARKER (end)->insertion_type
- = XMARKER (OVERLAY_END (old_overlay))->insertion_type;
-
- overlay = allocate_misc ();
- XMISCTYPE (overlay) = Lisp_Misc_Overlay;
- OVERLAY_START (overlay) = start;
- OVERLAY_END (overlay) = end;
- OVERLAY_PLIST (overlay) = Fcopy_sequence (OVERLAY_PLIST (old_overlay));
- XOVERLAY (overlay)->next = NULL;
+ Lisp_Object overlay, start, end;
+ struct Lisp_Marker *m;
+
+ 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 (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 (list->plist));
if (tail)
tail = tail->next = XOVERLAY (overlay);
else
return result;
}
+/* Set an appropriate overlay of B. */
+
+static inline void
+set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
+{
+ b->overlays_before = o;
+}
+
+static inline void
+set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
+{
+ b->overlays_after = o;
+}
/* Clone per-buffer values of buffer FROM.
static void
clone_per_buffer_values (struct buffer *from, struct buffer *to)
{
- Lisp_Object to_buffer;
int offset;
- XSETBUFFER (to_buffer, to);
-
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
- offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
- offset += sizeof (Lisp_Object))
+ FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
{
Lisp_Object obj;
if (offset == PER_BUFFER_VAR_OFFSET (name))
continue;
- obj = PER_BUFFER_VALUE (from, offset);
+ obj = per_buffer_value (from, offset);
if (MARKERP (obj) && XMARKER (obj)->buffer == from)
{
struct Lisp_Marker *m = XMARKER (obj);
- obj = Fmake_marker ();
+
+ obj = build_marker (to, m->charpos, m->bytepos);
XMARKER (obj)->insertion_type = m->insertion_type;
- set_marker_both (obj, to_buffer, m->charpos, m->bytepos);
}
- PER_BUFFER_VALUE (to, offset) = obj;
+ set_per_buffer_value (to, offset, obj);
}
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);
+ set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
+ set_buffer_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_local_var_alist (to, buffer_lisp_local_variables (from, 1));
}
base_buffer = Fget_buffer (base_buffer);
if (NILP (base_buffer))
error ("No such buffer: `%s'", SDATA (tem));
- if (NILP (BVAR (XBUFFER (base_buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (base_buffer)))
error ("Base buffer has been killed");
if (SCHARS (name) == 0)
b = allocate_buffer ();
+ /* No double indirection - if base buffer is indirect,
+ new buffer becomes an indirect to base's base. */
b->base_buffer = (XBUFFER (base_buffer)->base_buffer
? XBUFFER (base_buffer)->base_buffer
: XBUFFER (base_buffer));
/* Use the base buffer's text object. */
b->text = b->base_buffer->text;
+ /* We have no own text. */
+ b->indirections = -1;
+ /* Notify base buffer that we share the text now. */
+ b->base_buffer->indirections++;
b->pt = b->base_buffer->pt;
b->begv = b->base_buffer->begv;
b->newline_cache = 0;
b->width_run_cache = 0;
- BVAR (b, width_table) = Qnil;
-
- /* Put this on the chain of all buffers including killed ones. */
- b->header.next.buffer = all_buffers;
- all_buffers = b;
+ bset_width_table (b, Qnil);
name = Fcopy_sequence (name);
- STRING_SET_INTERVALS (name, NULL_INTERVAL);
- BVAR (b, name) = name;
+ set_string_intervals (name, NULL);
+ bset_name (b, name);
reset_buffer (b);
reset_buffer_local_variables (b, 1);
XSETBUFFER (buf, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
- BVAR (b, mark) = Fmake_marker ();
- BVAR (b, name) = name;
+ bset_mark (b, Fmake_marker ());
/* The multibyte status belongs to the base buffer. */
- BVAR (b, enable_multibyte_characters) = BVAR (b->base_buffer, enable_multibyte_characters);
+ bset_enable_multibyte_characters
+ (b, 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)))
eassert (NILP (BVAR (b->base_buffer, begv_marker)));
eassert (NILP (BVAR (b->base_buffer, zv_marker)));
- BVAR (b->base_buffer, pt_marker) = Fmake_marker ();
- set_marker_both (BVAR (b->base_buffer, pt_marker), base_buffer,
- b->base_buffer->pt,
- b->base_buffer->pt_byte);
+ bset_pt_marker (b->base_buffer,
+ build_marker (b->base_buffer, b->base_buffer->pt,
+ b->base_buffer->pt_byte));
+
+ bset_begv_marker (b->base_buffer,
+ build_marker (b->base_buffer, b->base_buffer->begv,
+ b->base_buffer->begv_byte));
- BVAR (b->base_buffer, begv_marker) = Fmake_marker ();
- set_marker_both (BVAR (b->base_buffer, begv_marker), base_buffer,
- b->base_buffer->begv,
- b->base_buffer->begv_byte);
+ bset_zv_marker (b->base_buffer,
+ build_marker (b->base_buffer, b->base_buffer->zv,
+ b->base_buffer->zv_byte));
- BVAR (b->base_buffer, zv_marker) = Fmake_marker ();
- set_marker_both (BVAR (b->base_buffer, zv_marker), base_buffer,
- b->base_buffer->zv,
- b->base_buffer->zv_byte);
XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
}
if (NILP (clone))
{
/* Give the indirect buffer markers for its narrowing. */
- BVAR (b, pt_marker) = Fmake_marker ();
- set_marker_both (BVAR (b, pt_marker), buf, b->pt, b->pt_byte);
- BVAR (b, begv_marker) = Fmake_marker ();
- set_marker_both (BVAR (b, begv_marker), buf, b->begv, b->begv_byte);
- BVAR (b, zv_marker) = Fmake_marker ();
- set_marker_both (BVAR (b, zv_marker), buf, b->zv, b->zv_byte);
+ bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
+ bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
+ bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
}
else
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_filename (b, Qnil);
+ bset_file_truename (b, Qnil);
+ bset_display_count (b, make_number (0));
+ bset_backed_up (b, Qnil);
+ bset_auto_save_file_name (b, Qnil);
set_buffer_internal_1 (b);
Fset (intern ("buffer-save-without-query"), Qnil);
Fset (intern ("buffer-file-number"), Qnil);
return buf;
}
+/* Mark OV as no longer associated with B. */
+
+static void
+drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
+{
+ 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);
+
+}
+
+/* Delete all overlays of B and reset it's overlay lists. */
+
void
delete_all_overlays (struct buffer *b)
{
- Lisp_Object overlay;
+ struct Lisp_Overlay *ov, *next;
- /* `reset_buffer' blindly sets the list of overlays to NULL, so we
- have to empty the list, otherwise we end up with overlays that
- think they belong to this buffer while the buffer doesn't know about
- them any more. */
- while (b->overlays_before)
+ for (ov = b->overlays_before; ov; ov = next)
{
- XSETMISC (overlay, b->overlays_before);
- Fdelete_overlay (overlay);
+ drop_overlay (b, ov);
+ next = ov->next;
+ ov->next = NULL;
}
- while (b->overlays_after)
+
+ for (ov = b->overlays_after; ov; ov = next)
{
- XSETMISC (overlay, b->overlays_after);
- Fdelete_overlay (overlay);
+ drop_overlay (b, ov);
+ next = ov->next;
+ ov->next = NULL;
}
- eassert (b->overlays_before == NULL);
- eassert (b->overlays_after == NULL);
+
+ set_buffer_overlays_before (b, NULL);
+ set_buffer_overlays_after (b, NULL);
}
/* Reinitialize everything about a buffer except its name and contents
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;
- b->modtime = 0;
+ bset_filename (b, Qnil);
+ bset_file_truename (b, Qnil);
+ bset_directory (b, 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);
b->last_window_start = 1;
/* 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_backed_up (b, 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_auto_save_file_name (b, Qnil);
+ bset_read_only (b, Qnil);
+ set_buffer_overlays_before (b, NULL);
+ set_buffer_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_mark_active (b, Qnil);
+ bset_point_before_scroll (b, Qnil);
+ bset_file_format (b, Qnil);
+ bset_auto_save_file_format (b, Qt);
+ bset_last_selected_window (b, Qnil);
+ bset_display_count (b, make_number (0));
+ bset_display_time (b, Qnil);
+ bset_enable_multibyte_characters
+ (b, BVAR (&buffer_defaults, enable_multibyte_characters));
+ bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type));
+ bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing));
b->display_error_modiff = 0;
}
it does not treat permanent locals consistently.
Instead, use Fkill_all_local_variables.
- If PERMANENT_TOO is 1, then we reset permanent
- buffer-local variables. If PERMANENT_TOO is 0,
- we preserve those. */
+ If PERMANENT_TOO, reset permanent buffer-local variables.
+ If not, preserve those. */
static void
-reset_buffer_local_variables (register struct buffer *b, int permanent_too)
+reset_buffer_local_variables (struct buffer *b, bool permanent_too)
{
- register int offset;
- int i;
+ int offset, i;
/* Reset the major mode to Fundamental, together with all the
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_major_mode (b, Qfundamental_mode);
+ bset_keymap (b, Qnil);
+ bset_mode_name (b, QSFundamental);
+ bset_minor_modes (b, Qnil);
/* If the standard case table has been altered and invalidated,
fix up its insides first. */
&& 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_downcase_table (b, Vascii_downcase_table);
+ bset_upcase_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[0]);
+ bset_case_canon_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[1]);
+ bset_case_eqv_table (b, XCHAR_TABLE (Vascii_downcase_table)->extras[2]);
+ bset_invisibility_spec (b, Qt);
/* Reset all (or most) per-buffer variables to their defaults. */
if (permanent_too)
- BVAR (b, local_var_alist) = Qnil;
+ bset_local_var_alist (b, Qnil);
else
{
Lisp_Object tmp, prop, last = Qnil;
}
/* Delete this local variable. */
else if (NILP (last))
- BVAR (b, local_var_alist) = XCDR (tmp);
+ bset_local_var_alist (b, XCDR (tmp));
else
XSETCDR (last, XCDR (tmp));
}
if (permanent_too || buffer_permanent_local_flags[i] == 0)
SET_PER_BUFFER_VALUE_P (b, i, 0);
- /* For each slot that has a default value,
- copy that into the slot. */
-
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
- offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
- offset += sizeof (Lisp_Object))
+ /* For each slot that has a default value, copy that into the slot. */
+ FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
{
int idx = PER_BUFFER_IDX (offset);
if ((idx > 0
&& (permanent_too
|| buffer_permanent_local_flags[idx] == 0)))
- PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
+ set_per_buffer_value (b, offset, per_buffer_default (offset));
}
}
Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
\(starting at 2) until an unused name is found, and then return that name.
Optional second argument IGNORE specifies a name that is okay to use (if
-it is in the sequence to be tried) even if a buffer with that name exists. */)
+it is in the sequence to be tried) even if a buffer with that name exists.
+
+If NAME begins with a space (i.e., a buffer that is not normally
+visible to users), then if buffer NAME already exists a random number
+is first appended to NAME, to speed up finding a non-existent buffer. */)
(register Lisp_Object name, Lisp_Object ignore)
{
- register Lisp_Object gentemp, tem;
- EMACS_INT count;
- char number[INT_BUFSIZE_BOUND (EMACS_INT) + sizeof "<>"];
+ register Lisp_Object gentemp, tem, tem2;
+ ptrdiff_t count;
+ char number[INT_BUFSIZE_BOUND (ptrdiff_t) + sizeof "<>"];
CHECK_STRING (name);
if (NILP (tem))
return name;
+ if (!strncmp (SSDATA (name), " ", 1)) /* see bug#1229 */
+ {
+ /* Note fileio.c:make_temp_name does random differently. */
+ tem2 = concat2 (name, make_formatted_string
+ (number, "-%"pI"d",
+ XFASTINT (Frandom (make_number (999999)))));
+ tem = Fget_buffer (tem2);
+ if (NILP (tem))
+ return tem2;
+ }
+ else
+ tem2 = name;
+
count = 1;
while (1)
{
- sprintf (number, "<%"pI"d>", ++count);
- gentemp = concat2 (name, build_string (number));
+ gentemp = concat2 (tem2, make_formatted_string
+ (number, "<%"pD"d>", ++count));
tem = Fstring_equal (gentemp, ignore);
if (!NILP (tem))
return gentemp;
If VARIABLE does not have a buffer-local binding in BUFFER, the value
is the default binding of the variable. */)
(register Lisp_Object variable, register Lisp_Object buffer)
+{
+ register Lisp_Object result = buffer_local_value_1 (variable, buffer);
+
+ if (EQ (result, Qunbound))
+ xsignal1 (Qvoid_variable, variable);
+
+ return result;
+}
+
+
+/* Like Fbuffer_local_value, but return Qunbound if the variable is
+ locally unbound. */
+
+Lisp_Object
+buffer_local_value_1 (Lisp_Object variable, Lisp_Object buffer)
{
register struct buffer *buf;
register Lisp_Object result;
{
union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (fwd))
- result = PER_BUFFER_VALUE (buf, XBUFFER_OBJFWD (fwd)->offset);
+ result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
else
result = Fdefault_value (variable);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
- if (!EQ (result, Qunbound))
- return result;
-
- xsignal1 (Qvoid_variable, variable);
+ return result;
}
/* Return an alist of the Lisp-level buffer-local bindings of
buffer BUF. That is, don't include the variables maintained
in special slots in the buffer object.
- If CLONE is zero elements of the form (VAR . unbound) are replaced
+ If not CLONE, replace elements of the form (VAR . unbound)
by VAR. */
static Lisp_Object
-buffer_lisp_local_variables (struct buffer *buf, int clone)
+buffer_lisp_local_variables (struct buffer *buf, bool clone)
{
Lisp_Object result = Qnil;
- register Lisp_Object tail;
+ Lisp_Object tail;
for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
{
Lisp_Object val, elt;
{
int offset, idx;
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER);
- offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER);
- /* sizeof EMACS_INT == sizeof Lisp_Object */
- offset += (sizeof (EMACS_INT)))
+ FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
{
idx = PER_BUFFER_IDX (offset);
if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
&& SYMBOLP (PER_BUFFER_SYMBOL (offset)))
{
Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
- Lisp_Object val = PER_BUFFER_VALUE (buf, offset);
+ Lisp_Object val = per_buffer_value (buf, offset);
result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
result);
}
1, 1, 0,
doc: /* Mark current buffer as modified or unmodified according to FLAG.
A non-nil FLAG means mark the buffer modified. */)
- (register Lisp_Object flag)
+ (Lisp_Object flag)
{
- register int already;
- register Lisp_Object fn;
- Lisp_Object buffer, window;
+ Lisp_Object fn, buffer, window;
#ifdef CLASH_DETECTION
/* If buffer becoming modified, lock the file.
If buffer becoming unmodified, unlock the file. */
- fn = BVAR (current_buffer, file_truename);
+ struct buffer *b = current_buffer->base_buffer
+ ? current_buffer->base_buffer
+ : current_buffer;
+
+ fn = BVAR (b, file_truename);
/* Test buffer-file-name so that binding it to nil is effective. */
- if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename)))
+ if (!NILP (fn) && ! NILP (BVAR (b, filename)))
{
- already = SAVE_MODIFF < MODIFF;
+ bool already = SAVE_MODIFF < MODIFF;
if (!already && !NILP (flag))
lock_file (fn);
else if (already && NILP (flag))
/* Test buffer-file-name so that binding it to nil is effective. */
if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename)))
{
- int already = SAVE_MODIFF < MODIFF;
+ bool already = SAVE_MODIFF < MODIFF;
if (!already && !NILP (flag))
lock_file (fn);
else if (already && NILP (flag))
error ("Buffer name `%s' is in use", SDATA (newname));
}
- BVAR (current_buffer, name) = newname;
+ bset_name (current_buffer, newname);
/* Catch redisplay's attention. Unless we do this, the mode lines for
any windows displaying current_buffer will stay unchanged. */
exists, return the buffer `*scratch*' (creating it if necessary). */)
(register Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame)
{
- Lisp_Object Fset_buffer_major_mode (Lisp_Object buffer);
Lisp_Object tail, buf, pred;
Lisp_Object notsogood = Qnil;
{
buf = XCAR (tail);
if (BUFFERP (buf) && !EQ (buf, buffer)
- && !NILP (BVAR (XBUFFER (buf), name))
+ && BUFFER_LIVE_P (XBUFFER (buf))
&& (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')
/* If the frame has a buffer_predicate, disregard buffers that
don't fit the predicate. */
{
buf = Fcdr (XCAR (tail));
if (BUFFERP (buf) && !EQ (buf, buffer)
- && !NILP (BVAR (XBUFFER (buf), name))
+ && BUFFER_LIVE_P (XBUFFER (buf))
&& (SREF (BVAR (XBUFFER (buf), name), 0) != ' ')
/* If the frame has a buffer_predicate, disregard buffers that
don't fit the predicate. */
Lisp_Object
other_buffer_safely (Lisp_Object buffer)
{
- Lisp_Object Fset_buffer_major_mode (Lisp_Object buffer);
Lisp_Object tail, buf;
tail = Vbuffer_alist;
{
buf = Fcdr (XCAR (tail));
if (BUFFERP (buf) && !EQ (buf, buffer)
- && !NILP (BVAR (XBUFFER (buf), name))
+ && BUFFER_LIVE_P (XBUFFER (buf))
&& (SREF (BVAR (XBUFFER (buf), name), 0) != ' '))
return buf;
}
}
if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt))
- BVAR (XBUFFER (real_buffer), undo_list) = Qnil;
+ bset_undo_list (XBUFFER (real_buffer), Qnil);
return Qnil;
}
-/*
- DEFVAR_LISP ("kill-buffer-hook", ..., "\
-Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
-The buffer being killed will be current while the hook is running.\n\
-See `kill-buffer'."
- */
+/* Truncate undo list and shrink the gap of BUFFER. */
+
+void
+compact_buffer (struct buffer *buffer)
+{
+ /* Verify indirection counters. */
+ if (buffer->base_buffer)
+ {
+ eassert (buffer->indirections == -1);
+ eassert (buffer->base_buffer->indirections > 0);
+ }
+ else
+ eassert (buffer->indirections >= 0);
+
+ /* Skip dead buffers, indirect buffers and buffers
+ which aren't changed since last compaction. */
+ if (!NILP (buffer->INTERNAL_FIELD (name))
+ && (buffer->base_buffer == NULL)
+ && (buffer->text->compact != buffer->text->modiff))
+ {
+ /* If a buffer's undo list is Qt, that means that undo is
+ turned off in that buffer. Calling truncate_undo_list on
+ Qt tends to return NULL, which effectively turns undo back on.
+ So don't call truncate_undo_list if undo_list is Qt. */
+ if (!EQ (buffer->INTERNAL_FIELD (undo_list), Qt))
+ truncate_undo_list (buffer);
+
+ /* Shrink buffer gaps. */
+ if (!buffer->text->inhibit_shrinking)
+ {
+ /* If a buffer's gap size is more than 10% of the buffer
+ size, or larger than 2000 bytes, then shrink it
+ accordingly. Keep a minimum size of 20 bytes. */
+ int size = min (2000, max (20, (buffer->text->z_byte / 10)));
+
+ if (buffer->text->gap_size > size)
+ {
+ struct buffer *save_current = current_buffer;
+ current_buffer = buffer;
+ make_gap (-(buffer->text->gap_size - size));
+ current_buffer = save_current;
+ }
+ }
+ buffer->text->compact = buffer->text->modiff;
+ }
+}
+
DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
- doc: /* Kill buffer BUFFER-OR-NAME.
+ doc: /* Kill the buffer specified by BUFFER-OR-NAME.
The argument may be a buffer or the name of an existing buffer.
Argument nil or omitted means kill the current buffer. Return t if the
buffer is actually killed, nil otherwise.
-This function calls `replace-buffer-in-windows' for cleaning up all
-windows currently displaying the buffer to be killed. The functions in
-`kill-buffer-query-functions' are called with the buffer to be killed as
-the current buffer. If any of them returns nil, the buffer is not
-killed. The hook `kill-buffer-hook' is run before the buffer is
-actually killed. The buffer being killed will be current while the hook
-is running.
+The functions in `kill-buffer-query-functions' are called with the
+buffer to be killed as the current buffer. If any of them returns nil,
+the buffer is not killed. The hook `kill-buffer-hook' is run before the
+buffer is actually killed. The buffer being killed will be current
+while the hook is running. Functions called by any of these hooks are
+supposed to not change the current buffer.
Any processes that have this buffer as the `process-buffer' are killed
-with SIGHUP. */)
+with SIGHUP. This function calls `replace-buffer-in-windows' for
+cleaning up all windows currently displaying the buffer to be killed. */)
(Lisp_Object buffer_or_name)
{
Lisp_Object buffer;
b = XBUFFER (buffer);
/* Avoid trouble for buffer already dead. */
- if (NILP (BVAR (b, name)))
+ if (!BUFFER_LIVE_P (b))
return Qnil;
/* Query if the buffer is still modified. */
/* Run hooks with the buffer to be killed the current buffer. */
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object arglist[1];
record_unwind_protect (save_excursion_restore, save_excursion_save ());
unbind_to (count, Qnil);
}
+ /* If the hooks have killed the buffer, exit now. */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
+
/* We have no more questions to ask. Verify that it is valid
to kill the buffer. This must be done after the questions
since anything can happen within do_yes_or_no_p. */
if (EQ (buffer, XWINDOW (minibuf_window)->buffer))
return Qnil;
- if (NILP (BVAR (b, name)))
- return Qnil;
-
- /* When we kill a base buffer, kill all its indirect buffers.
+ /* When we kill an ordinary buffer which shares it's buffer text
+ with indirect buffer(s), we must kill indirect buffer(s) too.
We do it at this stage so nothing terrible happens if they
ask questions or their hooks get errors. */
- if (! b->base_buffer)
+ if (!b->base_buffer && b->indirections > 0)
{
struct buffer *other;
GCPRO1 (buffer);
- for (other = all_buffers; other; other = other->header.next.buffer)
- /* all_buffers contains dead buffers too;
- don't re-kill them. */
- if (other->base_buffer == b && !NILP (BVAR (other, name)))
+ FOR_EACH_BUFFER (other)
+ if (other->base_buffer == b)
{
Lisp_Object buf;
XSETBUFFER (buf, other);
}
UNGCPRO;
+
+ /* Exit if we now have killed the base buffer (Bug#11665). */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
}
/* Run replace_buffer_in_windows before making another buffer current
buffer. (Bug#10114) */
replace_buffer_in_windows (buffer);
- /* Make this buffer not be current.
- In the process, notice if this is the sole visible buffer
- and give up if so. */
+ /* Exit if replacing the buffer in windows has killed our buffer. */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
+
+ /* Make this buffer not be current. Exit if it is the sole visible
+ buffer. */
if (b == current_buffer)
{
tem = Fother_buffer (buffer, Qnil, Qnil);
return Qnil;
}
- /* Notice if the buffer to kill is the sole visible buffer
- when we're currently in the mini-buffer, and give up if so. */
+ /* 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, XWINDOW (minibuf_window)->buffer))
- {
- tem = Fother_buffer (buffer, Qnil, Qnil);
- if (EQ (buffer, tem))
- return Qnil;
- }
+ if (EQ (tem, XWINDOW (minibuf_window)->buffer)
+ && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil)))
+ return Qnil;
/* Now there is no question: we can kill the buffer. */
kill_buffer_processes (buffer);
UNGCPRO;
- /* Killing buffer processes may run sentinels which may
- have called kill-buffer. */
-
- if (NILP (BVAR (b, name)))
- return Qnil;
+ /* Killing buffer processes may run sentinels which may have killed
+ our buffer. */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
/* These may run Lisp code and into infinite loops (if someone
insisted on circular lists) so allow quitting here. */
Vinhibit_quit = Qt;
/* Remove the buffer from the list of all buffers. */
Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
- /* If replace_buffer_in_windows didn't do its job correctly fix that
- now. */
+ /* If replace_buffer_in_windows didn't do its job fix that now. */
replace_buffer_in_windows_safely (buffer);
Vinhibit_quit = tem;
internal_delete_file (BVAR (b, auto_save_file_name));
}
+ /* Deleting an auto-save file could have killed our buffer. */
+ if (!BUFFER_LIVE_P (b))
+ return Qt;
+
if (b->base_buffer)
{
/* Unchain all markers that belong to this indirect buffer.
m = next;
}
BUF_MARKERS (b) = NULL;
- BUF_INTERVALS (b) = NULL_INTERVAL;
+ set_buffer_intervals (b, NULL);
/* Perhaps we should explicitly free the interval tree here... */
}
swap_out_buffer_local_variables (b);
reset_buffer_local_variables (b, 1);
- BVAR (b, name) = Qnil;
+ bset_name (b, Qnil);
- BLOCK_INPUT;
- if (! b->base_buffer)
+ block_input ();
+ if (b->base_buffer)
+ {
+ /* Notify our base buffer that we don't share the text anymore. */
+ eassert (b->indirections == -1);
+ b->base_buffer->indirections--;
+ eassert (b->base_buffer->indirections >= 0);
+ }
+ else
+ /* No one shares our buffer text, can free it. */
free_buffer_text (b);
if (b->newline_cache)
free_region_cache (b->width_run_cache);
b->width_run_cache = 0;
}
- BVAR (b, width_table) = Qnil;
- UNBLOCK_INPUT;
- BVAR (b, undo_list) = Qnil;
+ bset_width_table (b, Qnil);
+ unblock_input ();
+ bset_undo_list (b, Qnil);
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
Vinhibit_quit = tem;
/* Update buffer list of selected frame. */
- f->buffer_list = Fcons (buffer, Fdelq (buffer, f->buffer_list));
- f->buried_buffer_list = Fdelq (buffer, f->buried_buffer_list);
+ fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
+ fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
Vinhibit_quit = tem;
/* Update buffer lists of selected frame. */
- f->buffer_list = Fdelq (buffer, f->buffer_list);
- f->buried_buffer_list = Fcons (buffer, Fdelq (buffer, f->buried_buffer_list));
+ fset_buffer_list (f, Fdelq (buffer, f->buffer_list));
+ fset_buried_buffer_list
+ (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
the current buffer's major mode. */)
(Lisp_Object buffer)
{
- int count;
+ ptrdiff_t count;
Lisp_Object function;
CHECK_BUFFER (buffer);
- if (STRINGP (BVAR (XBUFFER (buffer), name))
- && strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
+ if (!BUFFER_LIVE_P (XBUFFER (buffer)))
+ error ("Attempt to set major mode for a dead buffer");
+
+ if (strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0)
function = find_symbol_value (intern ("initial-major-mode"));
else
{
XSETBUFFER (buf, current_buffer);
return buf;
}
-\f
-/* Set the current buffer to B.
-
- We previously set windows_or_buffers_changed here to invalidate
- global unchanged information in beg_unchanged and end_unchanged.
- This is no longer necessary because we now compute unchanged
- information on a buffer-basis. Every action affecting other
- windows than the selected one requires a select_window at some
- time, and that increments windows_or_buffers_changed. */
-
-void
-set_buffer_internal (register struct buffer *b)
-{
- if (current_buffer != b)
- set_buffer_internal_1 (b);
-}
/* Set the current buffer to B, and do not set windows_or_buffers_changed.
This is used by redisplay. */
/* 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_undo_list (old_buf->base_buffer, 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. */
/* 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_undo_list (b, 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. */
buffer = Fget_buffer (buffer_or_name);
if (NILP (buffer))
nsberror (buffer_or_name);
- if (NILP (BVAR (XBUFFER (buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (buffer)))
error ("Selecting deleted buffer");
set_buffer_internal (XBUFFER (buffer));
return buffer;
}
-/* Set the current buffer to BUFFER provided it is alive. */
+/* Set the current buffer to BUFFER provided if it is alive. */
Lisp_Object
set_buffer_if_live (Lisp_Object buffer)
{
- if (! NILP (BVAR (XBUFFER (buffer), name)))
- Fset_buffer (buffer);
+ if (BUFFER_LIVE_P (XBUFFER (buffer)))
+ set_buffer_internal (XBUFFER (buffer));
return Qnil;
}
\f
tem = *b; *b = *e; *e = tem;
}
- if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
- && XINT (*e) <= ZV))
+ if (! (BEGV <= XINT (*b) && XINT (*e) <= ZV))
args_out_of_range (*b, *e);
}
\f
/* Advance BYTE_POS up to a character boundary
and return the adjusted position. */
-static EMACS_INT
-advance_to_char_boundary (EMACS_INT byte_pos)
+static ptrdiff_t
+advance_to_char_boundary (ptrdiff_t byte_pos)
{
int c;
{
/* We should advance BYTE_POS only when C is a constituent of a
multibyte sequence. */
- EMACS_INT orig_byte_pos = byte_pos;
+ ptrdiff_t orig_byte_pos = byte_pos;
do
{
CHECK_BUFFER (buffer);
other_buffer = XBUFFER (buffer);
- if (NILP (BVAR (other_buffer, name)))
+ if (!BUFFER_LIVE_P (other_buffer))
error ("Cannot swap a dead buffer's text");
/* Actually, it probably works just fine.
{ /* This is probably harder to make work. */
struct buffer *other;
- for (other = all_buffers; other; other = other->header.next.buffer)
+ FOR_EACH_BUFFER (other)
if (other->base_buffer == other_buffer
|| other->base_buffer == current_buffer)
error ("One of the buffers to swap has indirect buffers");
#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_##field (other_buffer, BVAR (current_buffer, field)); \
+ bset_##field (current_buffer, tmp##field); \
} while (0)
swapfield (own_text, struct buffer_text);
eassert (current_buffer->text == ¤t_buffer->own_text);
eassert (other_buffer->text == &other_buffer->own_text);
#ifdef REL_ALLOC
- r_alloc_reset_variable ((POINTER_TYPE **) ¤t_buffer->own_text.beg,
- (POINTER_TYPE **) &other_buffer->own_text.beg);
- r_alloc_reset_variable ((POINTER_TYPE **) &other_buffer->own_text.beg,
- (POINTER_TYPE **) ¤t_buffer->own_text.beg);
+ r_alloc_reset_variable ((void **) ¤t_buffer->own_text.beg,
+ (void **) &other_buffer->own_text.beg);
+ r_alloc_reset_variable ((void **) &other_buffer->own_text.beg,
+ (void **) ¤t_buffer->own_text.beg);
#endif /* REL_ALLOC */
- swapfield (pt, EMACS_INT);
- swapfield (pt_byte, EMACS_INT);
- swapfield (begv, EMACS_INT);
- swapfield (begv_byte, EMACS_INT);
- swapfield (zv, EMACS_INT);
- swapfield (zv_byte, EMACS_INT);
+ swapfield (pt, ptrdiff_t);
+ swapfield (pt_byte, ptrdiff_t);
+ swapfield (begv, ptrdiff_t);
+ swapfield (begv_byte, ptrdiff_t);
+ swapfield (zv, ptrdiff_t);
+ swapfield (zv_byte, ptrdiff_t);
eassert (!current_buffer->base_buffer);
eassert (!other_buffer->base_buffer);
+ swapfield (indirections, ptrdiff_t);
current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
swapfield (newline_cache, struct region_cache *);
swapfield (width_run_cache, struct region_cache *);
other_buffer->prevent_redisplay_optimizations_p = 1;
swapfield (overlays_before, struct Lisp_Overlay *);
swapfield (overlays_after, struct Lisp_Overlay *);
- swapfield (overlay_center, EMACS_INT);
+ swapfield (overlay_center, ptrdiff_t);
swapfield_ (undo_list, Lisp_Object);
swapfield_ (mark, Lisp_Object);
swapfield_ (enable_multibyte_characters, Lisp_Object);
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_point_before_scroll (current_buffer, Qnil);
+ bset_point_before_scroll (other_buffer, Qnil);
current_buffer->text->modiff++; other_buffer->text->modiff++;
current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
&& (EQ (XWINDOW (w)->buffer, buf1)
|| EQ (XWINDOW (w)->buffer, buf2)))
Fset_marker (XWINDOW (w)->pointm,
- make_number (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
+ make_number
+ (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
XWINDOW (w)->buffer);
w = Fnext_window (w, Qt, Qt);
}
{
struct Lisp_Marker *tail, *markers;
struct buffer *other;
- EMACS_INT begv, zv;
- int narrowed = (BEG != BEGV || Z != ZV);
- int modified_p = !NILP (Fbuffer_modified_p (Qnil));
+ ptrdiff_t begv, zv;
+ bool narrowed = (BEG != BEGV || Z != ZV);
+ bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
Lisp_Object old_undo = BVAR (current_buffer, undo_list);
struct gcpro gcpro1;
/* Don't record these buffer changes. We will put a special undo entry
instead. */
- BVAR (current_buffer, undo_list) = Qt;
+ bset_undo_list (current_buffer, Qt);
/* If the cached position is for this buffer, clear it out. */
clear_charpos_cache (current_buffer);
if (NILP (flag))
{
- EMACS_INT pos, stop;
+ ptrdiff_t pos, stop;
unsigned char *p;
/* Do this first, so it can use CHAR_TO_BYTE
to calculate the old correspondences. */
set_intervals_multibyte (0);
- BVAR (current_buffer, enable_multibyte_characters) = Qnil;
+ bset_enable_multibyte_characters (current_buffer, Qnil);
Z = Z_BYTE;
BEGV = BEGV_BYTE;
}
else
{
- EMACS_INT pt = PT;
- EMACS_INT pos, stop;
+ ptrdiff_t pt = PT;
+ ptrdiff_t pos, stop;
unsigned char *p, *pend;
/* Be sure not to have a multibyte sequence striding over the GAP.
while (! CHAR_HEAD_P (*q) && q > BEG_ADDR) q--;
if (LEADING_CODE_P (*q))
{
- EMACS_INT new_gpt = GPT_BYTE - (GPT_ADDR - q);
+ ptrdiff_t new_gpt = GPT_BYTE - (GPT_ADDR - q);
move_gap_both (new_gpt, new_gpt);
}
/* 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_enable_multibyte_characters (current_buffer, Qt);
GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
{
- EMACS_INT byte = advance_to_char_boundary (PT_BYTE);
- EMACS_INT position;
+ ptrdiff_t byte = advance_to_char_boundary (PT_BYTE);
+ ptrdiff_t position;
if (byte > GPT_BYTE)
position = chars_in_text (GAP_END_ADDR, byte - GPT_BYTE) + GPT;
/* Make sure no markers were put on the chain
while the chain value was incorrect. */
if (BUF_MARKERS (current_buffer))
- abort ();
+ emacs_abort ();
BUF_MARKERS (current_buffer) = markers;
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_undo_list (current_buffer,
+ Fcons (list3 (Qapply,
+ intern ("set-buffer-multibyte"),
+ NILP (flag) ? Qt : Qnil),
+ old_undo));
}
UNGCPRO;
/* Copy this buffer's new multibyte status
into all of its indirect buffers. */
- for (other = all_buffers; other; other = other->header.next.buffer)
- if (other->base_buffer == current_buffer && !NILP (BVAR (other, name)))
+ FOR_EACH_BUFFER (other)
+ if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
{
BVAR (other, enable_multibyte_characters)
= BVAR (current_buffer, enable_multibyte_characters);
*VEC_PTR and *LEN_PTR should contain a valid vector and size
when this function is called.
- If EXTEND is non-zero, we make the vector bigger if necessary.
- If EXTEND is zero, we never extend the vector,
- and we store only as many overlays as will fit.
- But we still return the total number of overlays.
+ If EXTEND, make the vector bigger if necessary.
+ If not, never extend the vector,
+ and store only as many overlays as will fit.
+ But still return the total number of overlays.
- If CHANGE_REQ is true, then any position written into *PREV_PTR or
+ If CHANGE_REQ, any position written into *PREV_PTR or
*NEXT_PTR is guaranteed to be not equal to POS, unless it is the
default (BEGV or ZV). */
ptrdiff_t
-overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr,
+overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
ptrdiff_t *len_ptr,
- EMACS_INT *next_ptr, EMACS_INT *prev_ptr, int change_req)
+ ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
{
Lisp_Object overlay, start, end;
struct Lisp_Overlay *tail;
ptrdiff_t idx = 0;
ptrdiff_t len = *len_ptr;
Lisp_Object *vec = *vec_ptr;
- EMACS_INT next = ZV;
- EMACS_INT prev = BEGV;
- int inhibit_storing = 0;
+ ptrdiff_t next = ZV;
+ ptrdiff_t prev = BEGV;
+ bool inhibit_storing = 0;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
XSETMISC (overlay, tail);
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
XSETMISC (overlay, tail);
*VEC_PTR and *LEN_PTR should contain a valid vector and size
when this function is called.
- If EXTEND is non-zero, we make the vector bigger if necessary.
- If EXTEND is zero, we never extend the vector,
- and we store only as many overlays as will fit.
- But we still return the total number of overlays. */
+ If EXTEND, make the vector bigger if necessary.
+ If not, never extend the vector,
+ and store only as many overlays as will fit.
+ But still return the total number of overlays. */
static ptrdiff_t
-overlays_in (EMACS_INT beg, EMACS_INT end, int extend,
+overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
- EMACS_INT *next_ptr, EMACS_INT *prev_ptr)
+ ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
{
Lisp_Object overlay, ostart, oend;
struct Lisp_Overlay *tail;
ptrdiff_t idx = 0;
ptrdiff_t len = *len_ptr;
Lisp_Object *vec = *vec_ptr;
- EMACS_INT next = ZV;
- EMACS_INT prev = BEGV;
- int inhibit_storing = 0;
- int end_is_Z = end == Z;
+ ptrdiff_t next = ZV;
+ ptrdiff_t prev = BEGV;
+ bool inhibit_storing = 0;
+ bool end_is_Z = end == Z;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
XSETMISC (overlay, tail);
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
XSETMISC (overlay, tail);
}
-/* Return non-zero if there exists an overlay with a non-nil
+/* Return true if there exists an overlay with a non-nil
`mouse-face' property overlapping OVERLAY. */
-int
+bool
mouse_face_overlay_overlaps (Lisp_Object overlay)
{
- EMACS_INT start = OVERLAY_POSITION (OVERLAY_START (overlay));
- EMACS_INT end = OVERLAY_POSITION (OVERLAY_END (overlay));
+ ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
+ ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
ptrdiff_t n, i, size;
Lisp_Object *v, tem;
size = 10;
- v = (Lisp_Object *) alloca (size * sizeof *v);
+ v = alloca (size * sizeof *v);
n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
if (n > size)
{
- v = (Lisp_Object *) alloca (n * sizeof *v);
+ v = alloca (n * sizeof *v);
overlays_in (start, end, 0, &v, &n, NULL, NULL);
}
\f
/* Fast function to just test if we're at an overlay boundary. */
-int
-overlay_touches_p (EMACS_INT pos)
+bool
+overlay_touches_p (ptrdiff_t pos)
{
Lisp_Object overlay;
struct Lisp_Overlay *tail;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT endpos;
+ ptrdiff_t endpos;
XSETMISC (overlay ,tail);
- if (!OVERLAYP (overlay))
- abort ();
+ eassert (OVERLAYP (overlay));
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
if (endpos < pos)
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos;
+ ptrdiff_t startpos;
XSETMISC (overlay, tail);
- if (!OVERLAYP (overlay))
- abort ();
+ eassert (OVERLAYP (overlay));
startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
if (pos < startpos)
struct sortvec
{
Lisp_Object overlay;
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
EMACS_INT priority;
};
sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t noverlays, struct window *w)
{
ptrdiff_t i, j;
- struct sortvec *sortvec;
- sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
+ struct sortvec *sortvec = alloca (noverlays * sizeof *sortvec);
/* Put the valid and relevant overlays into sortvec. */
Lisp_Object overlay;
overlay = overlay_vec[i];
- if (OVERLAY_VALID (overlay)
+ if (OVERLAYP (overlay)
&& OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
&& OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
{
record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
Lisp_Object str2, Lisp_Object pri, ptrdiff_t size)
{
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
if (ssl->used == ssl->size)
ssl->buf = xpalloc (ssl->buf, &ssl->size, 5, -1, sizeof *ssl->buf);
PSTR, if that variable is non-null. The string may be overwritten by
subsequent calls. */
-EMACS_INT
-overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr)
+ptrdiff_t
+overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
{
Lisp_Object overlay, window, str;
struct Lisp_Overlay *ov;
- EMACS_INT startpos, endpos;
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t startpos, endpos;
+ bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
overlay_heads.used = overlay_heads.bytes = 0;
overlay_tails.used = overlay_tails.bytes = 0;
if (overlay_heads.bytes || overlay_tails.bytes)
{
Lisp_Object tem;
- EMACS_INT i;
+ ptrdiff_t i;
unsigned char *p;
ptrdiff_t total;
p = overlay_str_buf;
for (i = overlay_tails.used; --i >= 0;)
{
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
tem = overlay_tails.buf[i].string;
nbytes = copy_text (SDATA (tem), p,
SBYTES (tem),
}
for (i = 0; i < overlay_heads.used; ++i)
{
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
tem = overlay_heads.buf[i].string;
nbytes = copy_text (SDATA (tem), p,
SBYTES (tem),
}
}
if (p != overlay_str_buf + total)
- abort ();
+ emacs_abort ();
if (pstr)
*pstr = overlay_str_buf;
return total;
/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
void
-recenter_overlay_lists (struct buffer *buf, EMACS_INT pos)
+recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
{
Lisp_Object overlay, beg, end;
struct Lisp_Overlay *prev, *tail, *next;
{
next = tail->next;
XSETMISC (overlay, tail);
-
- /* If the overlay is not valid, get rid of it. */
- if (!OVERLAY_VALID (overlay))
-#if 1
- abort ();
-#else
- {
- /* Splice the cons cell TAIL out of overlays_before. */
- if (!NILP (prev))
- XCDR (prev) = next;
- else
- buf->overlays_before = next;
- tail = prev;
- continue;
- }
-#endif
+ eassert (OVERLAYP (overlay));
beg = OVERLAY_START (overlay);
end = OVERLAY_END (overlay);
if (OVERLAY_POSITION (end) > pos)
{
/* OVERLAY needs to be moved. */
- EMACS_INT where = OVERLAY_POSITION (beg);
+ ptrdiff_t where = OVERLAY_POSITION (beg);
struct Lisp_Overlay *other, *other_prev;
/* Splice the cons cell TAIL out of overlays_before. */
if (prev)
prev->next = next;
else
- buf->overlays_before = next;
+ set_buffer_overlays_before (buf, next);
/* Search thru overlays_after for where to put it. */
other_prev = NULL;
Lisp_Object otherbeg, otheroverlay;
XSETMISC (otheroverlay, other);
- eassert (OVERLAY_VALID (otheroverlay));
+ eassert (OVERLAYP (otheroverlay));
otherbeg = OVERLAY_START (otheroverlay);
if (OVERLAY_POSITION (otherbeg) >= where)
if (other_prev)
other_prev->next = tail;
else
- buf->overlays_after = tail;
+ set_buffer_overlays_after (buf, tail);
tail = prev;
}
else
{
next = tail->next;
XSETMISC (overlay, tail);
-
- /* If the overlay is not valid, get rid of it. */
- if (!OVERLAY_VALID (overlay))
-#if 1
- abort ();
-#else
- {
- /* Splice the cons cell TAIL out of overlays_after. */
- if (!NILP (prev))
- XCDR (prev) = next;
- else
- buf->overlays_after = next;
- tail = prev;
- continue;
- }
-#endif
+ eassert (OVERLAYP (overlay));
beg = OVERLAY_START (overlay);
end = OVERLAY_END (overlay);
if (OVERLAY_POSITION (end) <= pos)
{
/* OVERLAY needs to be moved. */
- EMACS_INT where = OVERLAY_POSITION (end);
+ ptrdiff_t where = OVERLAY_POSITION (end);
struct Lisp_Overlay *other, *other_prev;
/* Splice the cons cell TAIL out of overlays_after. */
if (prev)
prev->next = next;
else
- buf->overlays_after = next;
+ set_buffer_overlays_after (buf, next);
/* Search thru overlays_before for where to put it. */
other_prev = NULL;
Lisp_Object otherend, otheroverlay;
XSETMISC (otheroverlay, other);
- eassert (OVERLAY_VALID (otheroverlay));
+ eassert (OVERLAYP (otheroverlay));
otherend = OVERLAY_END (otheroverlay);
if (OVERLAY_POSITION (otherend) <= where)
if (other_prev)
other_prev->next = tail;
else
- buf->overlays_before = tail;
+ set_buffer_overlays_before (buf, tail);
tail = prev;
}
}
}
void
-adjust_overlays_for_insert (EMACS_INT pos, EMACS_INT length)
+adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
{
/* After an insertion, the lists are still sorted properly,
but we may need to update the value of the overlay center. */
}
void
-adjust_overlays_for_delete (EMACS_INT pos, EMACS_INT length)
+adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
{
if (current_buffer->overlay_center < pos)
/* The deletion was to our right. No change needed; the before- and
after-lists are still consistent. */
;
- else if (current_buffer->overlay_center > pos + length)
+ else if (current_buffer->overlay_center - pos > length)
/* The deletion was to our left. We need to adjust the center value
to account for the change in position, but the lists are consistent
given the new value. */
Such an overlay might even have negative size at this point.
If so, we'll make the overlay empty. */
void
-fix_start_end_in_overlays (register EMACS_INT start, register EMACS_INT end)
+fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
{
Lisp_Object overlay;
struct Lisp_Overlay *before_list IF_LINT (= NULL);
current_buffer->overlays_before or overlays_after, depending
which loop we're in. */
struct Lisp_Overlay *tail, *parent;
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
/* This algorithm shifts links around instead of consing and GCing.
The loop invariant is that before_list (resp. after_list) is a
beforep = tail;
}
if (!parent)
- current_buffer->overlays_before = tail->next;
+ set_buffer_overlays_before (current_buffer, tail->next);
else
parent->next = tail->next;
tail = tail->next;
beforep = tail;
}
if (!parent)
- current_buffer->overlays_after = tail->next;
+ set_buffer_overlays_after (current_buffer, tail->next);
else
parent->next = tail->next;
tail = tail->next;
if (beforep)
{
beforep->next = current_buffer->overlays_before;
- current_buffer->overlays_before = before_list;
+ set_buffer_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;
+ set_buffer_overlays_after (current_buffer, after_list);
}
recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
}
was at PREV, and now is at POS. */
void
-fix_overlays_before (struct buffer *bp, EMACS_INT prev, EMACS_INT pos)
+fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
{
/* If parent is nil, replace overlays_before; otherwise, parent->next. */
struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
Lisp_Object tem;
- EMACS_INT end IF_LINT (= 0);
+ ptrdiff_t end IF_LINT (= 0);
/* After the insertion, the several overlays may be in incorrect
order. The possibility is that, in the list `overlays_before',
if (!right_pair)
{
found->next = bp->overlays_before;
- bp->overlays_before = found;
+ set_buffer_overlays_before (bp, found);
}
else
{
if (!NILP (rear_advance))
XMARKER (end)->insertion_type = 1;
- overlay = allocate_misc ();
- XMISCTYPE (overlay) = Lisp_Misc_Overlay;
- XOVERLAY (overlay)->start = beg;
- XOVERLAY (overlay)->end = end;
- XOVERLAY (overlay)->plist = Qnil;
- XOVERLAY (overlay)->next = NULL;
+ overlay = build_overlay (beg, end, Qnil);
/* Put the new overlay on the wrong list. */
end = OVERLAY_END (overlay);
{
if (b->overlays_after)
XOVERLAY (overlay)->next = b->overlays_after;
- b->overlays_after = XOVERLAY (overlay);
+ set_buffer_overlays_after (b, XOVERLAY (overlay));
}
else
{
if (b->overlays_before)
XOVERLAY (overlay)->next = b->overlays_before;
- b->overlays_before = XOVERLAY (overlay);
+ set_buffer_overlays_before (b, XOVERLAY (overlay));
}
/* This puts it in the right list, and in the right order. */
/* Mark a section of BUF as needing redisplay because of overlays changes. */
static void
-modify_overlay (struct buffer *buf, EMACS_INT start, EMACS_INT end)
+modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
{
if (start > end)
{
- EMACS_INT temp = start;
+ ptrdiff_t temp = start;
start = end;
end = temp;
}
++BUF_OVERLAY_MODIFF (buf);
}
-\f
+/* Remove OVERLAY from LIST. */
+
static struct Lisp_Overlay *
unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
{
- struct Lisp_Overlay *tmp, *prev;
- for (tmp = list, prev = NULL; tmp; prev = tmp, tmp = tmp->next)
- if (tmp == overlay)
+ register struct Lisp_Overlay *tail, **prev = &list;
+
+ for (tail = list; tail; prev = &tail->next, tail = *prev)
+ if (tail == overlay)
{
- if (prev)
- prev->next = tmp->next;
- else
- list = tmp->next;
+ *prev = overlay->next;
overlay->next = NULL;
break;
}
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);
+
+ set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
+ set_buffer_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.
buffer. */)
(Lisp_Object overlay, Lisp_Object beg, Lisp_Object end, Lisp_Object buffer)
{
- struct buffer *b, *ob;
+ struct buffer *b, *ob = 0;
Lisp_Object obuffer;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t n_beg, n_end, o_beg IF_LINT (= 0), o_end IF_LINT (= 0);
CHECK_OVERLAY (overlay);
if (NILP (buffer))
XSETBUFFER (buffer, current_buffer);
CHECK_BUFFER (buffer);
+ if (NILP (Fbuffer_live_p (buffer)))
+ error ("Attempt to move overlay to a dead buffer");
+
if (MARKERP (beg)
&& ! EQ (Fmarker_buffer (beg), buffer))
error ("Marker points into wrong buffer");
CHECK_NUMBER_COERCE_MARKER (beg);
CHECK_NUMBER_COERCE_MARKER (end);
- if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
- return Fdelete_overlay (overlay);
-
if (XINT (beg) > XINT (end))
{
Lisp_Object temp;
obuffer = Fmarker_buffer (OVERLAY_START (overlay));
b = XBUFFER (buffer);
- ob = BUFFERP (obuffer) ? XBUFFER (obuffer) : (struct buffer *) 0;
+
+ if (!NILP (obuffer))
+ {
+ ob = XBUFFER (obuffer);
+
+ o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
+ o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
+
+ unchain_both (ob, overlay);
+ }
+
+ /* Set the overlay boundaries, which may clip them. */
+ Fset_marker (OVERLAY_START (overlay), beg, buffer);
+ Fset_marker (OVERLAY_END (overlay), end, buffer);
+
+ n_beg = marker_position (OVERLAY_START (overlay));
+ n_end = marker_position (OVERLAY_END (overlay));
/* If the overlay has changed buffers, do a thorough redisplay. */
if (!EQ (buffer, obuffer))
{
/* Redisplay where the overlay was. */
- if (!NILP (obuffer))
- {
- EMACS_INT o_beg;
- EMACS_INT o_end;
-
- o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
- o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- modify_overlay (ob, o_beg, o_end);
- }
+ if (ob)
+ modify_overlay (ob, o_beg, o_end);
/* Redisplay where the overlay is going to be. */
- modify_overlay (b, XINT (beg), XINT (end));
+ modify_overlay (b, n_beg, n_end);
}
else
/* Redisplay the area the overlay has just left, or just enclosed. */
{
- EMACS_INT o_beg, o_end;
-
- o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
- o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- if (o_beg == XINT (beg))
- modify_overlay (b, o_end, XINT (end));
- else if (o_end == XINT (end))
- modify_overlay (b, o_beg, XINT (beg));
+ if (o_beg == n_beg)
+ modify_overlay (b, o_end, n_end);
+ else if (o_end == n_end)
+ modify_overlay (b, o_beg, n_beg);
else
- {
- if (XINT (beg) < o_beg) o_beg = XINT (beg);
- if (XINT (end) > o_end) o_end = XINT (end);
- modify_overlay (b, o_beg, o_end);
- }
+ modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
}
- if (!NILP (obuffer))
- {
- 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);
- }
-
- Fset_marker (OVERLAY_START (overlay), beg, buffer);
- Fset_marker (OVERLAY_END (overlay), end, buffer);
+ /* Delete the overlay if it is empty after clipping and has the
+ evaporate property. */
+ if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
+ return unbind_to (count, Fdelete_overlay (overlay));
- /* Put the overlay on the wrong list. */
- end = OVERLAY_END (overlay);
- if (OVERLAY_POSITION (end) < b->overlay_center)
+ /* Put the overlay into the new buffer's overlay lists, first on the
+ wrong list. */
+ if (n_end < b->overlay_center)
{
XOVERLAY (overlay)->next = b->overlays_after;
- b->overlays_after = XOVERLAY (overlay);
+ set_buffer_overlays_after (b, XOVERLAY (overlay));
}
else
{
XOVERLAY (overlay)->next = b->overlays_before;
- b->overlays_before = XOVERLAY (overlay);
+ set_buffer_overlays_before (b, XOVERLAY (overlay));
}
/* This puts it in the right list, and in the right order. */
{
Lisp_Object buffer;
struct buffer *b;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
CHECK_OVERLAY (overlay);
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);
- modify_overlay (b,
- marker_position (OVERLAY_START (overlay)),
- marker_position (OVERLAY_END (overlay)));
- Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
- Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
+ unchain_both (b, overlay);
+ drop_overlay (b, XOVERLAY (overlay));
/* When deleting an overlay with before or after strings, turn off
display optimizations for the affected buffer, on the basis that
return unbind_to (count, Qnil);
}
+
+DEFUN ("delete-all-overlays", Fdelete_all_overlays, Sdelete_all_overlays, 0, 1, 0,
+ doc: /* Delete all overlays of BUFFER.
+BUFFER omitted or nil means delete all overlays of the current
+buffer. */)
+ (Lisp_Object buffer)
+{
+ register struct buffer *buf;
+
+ if (NILP (buffer))
+ buf = current_buffer;
+ else
+ {
+ CHECK_BUFFER (buffer);
+ buf = XBUFFER (buffer);
+ }
+
+ delete_all_overlays (buf);
+ return Qnil;
+}
\f
/* Overlay dissection functions. */
len = 10;
/* We can't use alloca here because overlays_at can call xrealloc. */
- overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+ overlay_vec = xmalloc (len * sizeof *overlay_vec);
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
- (EMACS_INT *) 0, (EMACS_INT *) 0, 0);
+ 0, 0, 0);
/* Make a list of them all. */
result = Flist (noverlays, overlay_vec);
CHECK_NUMBER_COERCE_MARKER (end);
len = 10;
- overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+ overlay_vec = xmalloc (len * sizeof *overlay_vec);
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
(Lisp_Object pos)
{
ptrdiff_t i, len, noverlays;
- EMACS_INT endpos;
+ ptrdiff_t endpos;
Lisp_Object *overlay_vec;
CHECK_NUMBER_COERCE_MARKER (pos);
len = 10;
- overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+ overlay_vec = xmalloc (len * sizeof *overlay_vec);
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len.
endpos gets the position where the next overlay starts. */
noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
- &endpos, (EMACS_INT *) 0, 1);
+ &endpos, 0, 1);
/* If any of these overlays ends before endpos,
use its ending point instead. */
for (i = 0; i < noverlays; i++)
{
Lisp_Object oend;
- EMACS_INT oendpos;
+ ptrdiff_t oendpos;
oend = OVERLAY_END (overlay_vec[i]);
oendpos = OVERLAY_POSITION (oend);
the value is (point-min). */)
(Lisp_Object pos)
{
- EMACS_INT prevpos;
+ ptrdiff_t prevpos;
Lisp_Object *overlay_vec;
ptrdiff_t len;
return pos;
len = 10;
- overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+ overlay_vec = xmalloc (len * sizeof *overlay_vec);
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len.
prevpos gets the position of the previous change. */
overlays_at (XINT (pos), 1, &overlay_vec, &len,
- (EMACS_INT *) 0, &prevpos, 1);
+ 0, &prevpos, 1);
xfree (overlay_vec);
return make_number (prevpos);
{
struct Lisp_Overlay *ol;
Lisp_Object before = Qnil, after = Qnil, tmp;
+
for (ol = current_buffer->overlays_before; ol; ol = ol->next)
{
XSETMISC (tmp, ol);
XSETMISC (tmp, ol);
after = Fcons (tmp, after);
}
+
return Fcons (Fnreverse (before), Fnreverse (after));
}
for positions far away from POS). */)
(Lisp_Object pos)
{
+ ptrdiff_t p;
CHECK_NUMBER_COERCE_MARKER (pos);
- recenter_overlay_lists (current_buffer, XINT (pos));
+ p = clip_to_bounds (PTRDIFF_MIN, XINT (pos), PTRDIFF_MAX);
+ recenter_overlay_lists (current_buffer, p);
return Qnil;
}
\f
(Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
{
Lisp_Object tail, buffer;
- int changed;
+ bool changed;
CHECK_OVERLAY (overlay);
}
/* It wasn't in the list, so add it to the front. */
changed = !NILP (value);
- XOVERLAY (overlay)->plist
- = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
+ set_overlay_plist
+ (overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
found:
if (! NILP (buffer))
{
static Lisp_Object last_overlay_modification_hooks;
/* Number of elements actually used in last_overlay_modification_hooks. */
-static int last_overlay_modification_hooks_used;
+static ptrdiff_t last_overlay_modification_hooks_used;
/* Add one functionlist/overlay pair
to the end of last_overlay_modification_hooks. */
static void
add_overlay_mod_hooklist (Lisp_Object functionlist, Lisp_Object overlay)
{
- int oldsize = ASIZE (last_overlay_modification_hooks);
+ ptrdiff_t oldsize = ASIZE (last_overlay_modification_hooks);
- if (last_overlay_modification_hooks_used == oldsize)
- last_overlay_modification_hooks = larger_vector
- (last_overlay_modification_hooks, oldsize * 2, Qnil);
+ if (oldsize - 1 <= last_overlay_modification_hooks_used)
+ last_overlay_modification_hooks =
+ larger_vector (last_overlay_modification_hooks, 2, -1);
ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
functionlist); last_overlay_modification_hooks_used++;
ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
and the insert-after-hooks of overlay ending at START.
This is called both before and after the modification.
- AFTER is nonzero when we call after the modification.
+ AFTER is true when we call after the modification.
ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
When AFTER is nonzero, they are the start position,
and the length of deleted or replaced old text. */
void
-report_overlay_modification (Lisp_Object start, Lisp_Object end, int after,
+report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
Lisp_Object prop, overlay;
struct Lisp_Overlay *tail;
- /* 1 if this change is an insertion. */
- int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
+ /* True if this change is an insertion. */
+ bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
overlay = Qnil;
last_overlay_modification_hooks_used = 0;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
Lisp_Object ostart, oend;
XSETMISC (overlay, tail);
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
Lisp_Object ostart, oend;
XSETMISC (overlay, tail);
/* Call the functions recorded in last_overlay_modification_hooks.
First copy the vector contents, in case some of these hooks
do subsequent modification of the buffer. */
- int size = last_overlay_modification_hooks_used;
- Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
- int i;
+ ptrdiff_t size = last_overlay_modification_hooks_used;
+ Lisp_Object *copy = alloca (size * sizeof *copy);
+ ptrdiff_t i;
memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents,
- size * sizeof (Lisp_Object));
+ size * word_size);
gcpro1.var = copy;
gcpro1.nvars = size;
}
static void
-call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, int after,
+call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Delete any zero-sized overlays at position POS, if the `evaporate'
property is set. */
void
-evaporate_overlays (EMACS_INT pos)
+evaporate_overlays (ptrdiff_t pos)
{
Lisp_Object overlay, hit_list;
struct Lisp_Overlay *tail;
if (pos <= current_buffer->overlay_center)
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- EMACS_INT endpos;
+ ptrdiff_t endpos;
XSETMISC (overlay, tail);
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
if (endpos < pos)
else
for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- EMACS_INT startpos;
+ ptrdiff_t startpos;
XSETMISC (overlay, tail);
startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
if (startpos > pos)
case_Lisp_Int: predicate = Qintegerp; break;
case Lisp_String: predicate = Qstringp; break;
case Lisp_Symbol: predicate = Qsymbolp; break;
- default: abort ();
+ default: emacs_abort ();
}
wrong_type_argument (predicate, newval);
/* Pointer to the location holding the address of the memory
allocated with the mmap'd block. The variable actually points
after this structure. */
- POINTER_TYPE **var;
+ void **var;
/* Next and previous in list of all mmap'd regions. */
struct mmap_region *next, *prev;
/* 1 means mmap has been initialized. */
-static int mmap_initialized_p;
+static bool mmap_initialized_p;
/* Value is X rounded up to the next multiple of N. */
to the start of the user-visible part of the region. */
#define MMAP_USER_AREA(P) \
- ((POINTER_TYPE *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
+ ((void *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
#define MEM_ALIGN sizeof (double)
is at END - 1. */
static struct mmap_region *
-mmap_find (POINTER_TYPE *start, POINTER_TYPE *end)
+mmap_find (void *start, void *end)
{
struct mmap_region *r;
char *s = (char *) start, *e = (char *) end;
/* Unmap a region. P is a pointer to the start of the user-araa of
- the region. Value is non-zero if successful. */
+ the region. */
-static int
+static void
mmap_free_1 (struct mmap_region *r)
{
if (r->next)
else
mmap_regions = r->next;
- if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
- {
- fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
- return 0;
- }
-
- return 1;
+ if (munmap (r, r->nbytes_mapped) == -1)
+ fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
}
/* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
- Value is non-zero if successful. */
+ Value is true if successful. */
-static int
+static bool
mmap_enlarge (struct mmap_region *r, int npages)
{
char *region_end = (char *) r + r->nbytes_mapped;
size_t nbytes;
- int success = 0;
+ bool success = 0;
if (npages < 0)
{
I'm not sure this is worth doing, let's see. */
if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
{
- POINTER_TYPE *p;
+ void *p;
p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
if (p == MAP_FAILED)
; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
- else if (p != (POINTER_TYPE *) region_end)
+ else if (p != region_end)
{
/* Kernels are free to choose a different address. In
that case, unmap what we've mapped above; we have
}
-/* Set or reset variables holding references to mapped regions. If
- RESTORE_P is zero, set all variables to null. If RESTORE_P is
- non-zero, set all variables to the start of the user-areas
- of mapped regions.
+/* Set or reset variables holding references to mapped regions.
+ If not RESTORE_P, set all variables to null. If RESTORE_P, set all
+ variables to the start of the user-areas of mapped regions.
This function is called from Fdump_emacs to ensure that the dumped
Emacs doesn't contain references to memory that won't be mapped
when Emacs starts. */
void
-mmap_set_vars (int restore_p)
+mmap_set_vars (bool restore_p)
{
struct mmap_region *r;
If we can't allocate the necessary memory, set *VAR to null, and
return null. */
-static POINTER_TYPE *
-mmap_alloc (POINTER_TYPE **var, size_t nbytes)
+static void *
+mmap_alloc (void **var, size_t nbytes)
{
void *p;
size_t map;
PTR. Store 0 in *PTR to show there's no block allocated. */
static void
-mmap_free (POINTER_TYPE **var)
+mmap_free (void **var)
{
mmap_init ();
and return this value. If more memory cannot be allocated, then
leave *VAR unchanged, and return null. */
-static POINTER_TYPE *
-mmap_realloc (POINTER_TYPE **var, size_t nbytes)
+static void *
+mmap_realloc (void **var, size_t nbytes)
{
- POINTER_TYPE *result;
+ void *result;
mmap_init ();
if (room < nbytes)
{
/* Must enlarge. */
- POINTER_TYPE *old_ptr = *var;
+ void *old_ptr = *var;
/* Try to map additional pages at the end of the region.
If that fails, allocate a new region, copy data
static void
alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes)
{
- POINTER_TYPE *p;
+ void *p;
- BLOCK_INPUT;
+ block_input ();
#if defined USE_MMAP_FOR_BUFFERS
- p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
+ p = mmap_alloc ((void **) &b->text->beg, nbytes);
#elif defined REL_ALLOC
- p = r_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
+ p = r_alloc ((void **) &b->text->beg, nbytes);
#else
p = xmalloc (nbytes);
#endif
if (p == NULL)
{
- UNBLOCK_INPUT;
+ unblock_input ();
memory_full (nbytes);
}
b->text->beg = (unsigned char *) p;
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
shrink it. */
void
-enlarge_buffer_text (struct buffer *b, EMACS_INT delta)
+enlarge_buffer_text (struct buffer *b, ptrdiff_t delta)
{
- POINTER_TYPE *p;
+ void *p;
ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
+ delta);
- BLOCK_INPUT;
+ block_input ();
#if defined USE_MMAP_FOR_BUFFERS
- p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes);
+ p = mmap_realloc ((void **) &b->text->beg, nbytes);
#elif defined REL_ALLOC
- p = r_re_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
+ p = r_re_alloc ((void **) &b->text->beg, nbytes);
#else
p = xrealloc (b->text->beg, nbytes);
#endif
if (p == NULL)
{
- UNBLOCK_INPUT;
+ unblock_input ();
memory_full (nbytes);
}
BUF_BEG_ADDR (b) = (unsigned char *) p;
- UNBLOCK_INPUT;
+ unblock_input ();
}
static void
free_buffer_text (struct buffer *b)
{
- BLOCK_INPUT;
+ block_input ();
#if defined USE_MMAP_FOR_BUFFERS
- mmap_free ((POINTER_TYPE **) &b->text->beg);
+ mmap_free ((void **) &b->text->beg);
#elif defined REL_ALLOC
- r_alloc_free ((POINTER_TYPE **) &b->text->beg);
+ r_alloc_free ((void **) &b->text->beg);
#else
xfree (b->text->beg);
#endif
BUF_BEG_ADDR (b) = NULL;
- UNBLOCK_INPUT;
+ unblock_input ();
}
init_buffer_once (void)
{
int idx;
+ /* If you add, remove, or reorder Lisp_Objects in a struct buffer, make
+ 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) - header_size) / word_size;
memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
/* Prevent GC from getting confused. */
buffer_defaults.text = &buffer_defaults.own_text;
buffer_local_symbols.text = &buffer_local_symbols.own_text;
- BUF_INTERVALS (&buffer_defaults) = 0;
- BUF_INTERVALS (&buffer_local_symbols) = 0;
- XSETPVECTYPESIZE (&buffer_defaults, PVEC_BUFFER, 0);
- XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
- XSETPVECTYPESIZE (&buffer_local_symbols, PVEC_BUFFER, 0);
- XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
+ /* No one will share the text with these buffers, but let's play it safe. */
+ buffer_defaults.indirections = 0;
+ buffer_local_symbols.indirections = 0;
+ set_buffer_intervals (&buffer_defaults, NULL);
+ set_buffer_intervals (&buffer_local_symbols, NULL);
+ /* This is not strictly necessary, but let's make them initialized. */
+ bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
+ bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
+ XSETPVECTYPESIZE (&buffer_defaults, PVEC_BUFFER, pvecsize);
+ XSETPVECTYPESIZE (&buffer_local_symbols, PVEC_BUFFER, pvecsize);
/* Set up the default values of various buffer slots. */
/* Must do these before making the first buffer! */
/* real setup is done in bindings.el */
- BVAR (&buffer_defaults, mode_line_format) = make_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;
-#ifndef old
- BVAR (&buffer_defaults, selective_display_ellipses) = Qt;
-#endif
- 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_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
+ bset_header_line_format (&buffer_defaults, Qnil);
+ bset_abbrev_mode (&buffer_defaults, Qnil);
+ bset_overwrite_mode (&buffer_defaults, Qnil);
+ bset_case_fold_search (&buffer_defaults, Qt);
+ bset_auto_fill_function (&buffer_defaults, Qnil);
+ bset_selective_display (&buffer_defaults, Qnil);
+ bset_selective_display_ellipses (&buffer_defaults, Qt);
+ bset_abbrev_table (&buffer_defaults, Qnil);
+ bset_display_table (&buffer_defaults, Qnil);
+ bset_undo_list (&buffer_defaults, Qnil);
+ bset_mark_active (&buffer_defaults, Qnil);
+ bset_file_format (&buffer_defaults, Qnil);
+ bset_auto_save_file_format (&buffer_defaults, Qt);
+ set_buffer_overlays_before (&buffer_defaults, NULL);
+ set_buffer_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;
-
- BVAR (&buffer_defaults, enable_multibyte_characters) = Qt;
- BVAR (&buffer_defaults, buffer_file_coding_system) = Qnil;
+ bset_truncate_lines (&buffer_defaults, Qnil);
+ bset_word_wrap (&buffer_defaults, Qnil);
+ bset_ctl_arrow (&buffer_defaults, Qt);
+ bset_bidi_display_reordering (&buffer_defaults, Qt);
+ bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
+ bset_cursor_type (&buffer_defaults, Qt);
+ bset_extra_line_spacing (&buffer_defaults, Qnil);
+ bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
+
+ bset_enable_multibyte_characters (&buffer_defaults, Qt);
+ bset_buffer_file_coding_system (&buffer_defaults, 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_cache_long_line_scans (&buffer_defaults, Qnil);
+ bset_file_truename (&buffer_defaults, 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_left_fringe_width (&buffer_defaults, Qnil);
+ bset_right_fringe_width (&buffer_defaults, Qnil);
+ bset_fringes_outside_margins (&buffer_defaults, Qnil);
+ bset_scroll_bar_width (&buffer_defaults, Qnil);
+ bset_vertical_scroll_bar_type (&buffer_defaults, Qt);
+ bset_indicate_empty_lines (&buffer_defaults, Qnil);
+ bset_indicate_buffer_boundaries (&buffer_defaults, Qnil);
+ bset_fringe_indicator_alist (&buffer_defaults, Qnil);
+ bset_fringe_cursor_alist (&buffer_defaults, Qnil);
+ bset_scroll_up_aggressively (&buffer_defaults, Qnil);
+ bset_scroll_down_aggressively (&buffer_defaults, Qnil);
+ bset_display_time (&buffer_defaults, Qnil);
/* Assign the local-flags to the slots that have default values.
The local flag is a bit that is used in the buffer
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_filename (&buffer_local_flags, make_number (-1));
+ bset_directory (&buffer_local_flags, make_number (-1));
+ bset_backed_up (&buffer_local_flags, make_number (-1));
+ bset_save_length (&buffer_local_flags, make_number (-1));
+ bset_auto_save_file_name (&buffer_local_flags, make_number (-1));
+ bset_read_only (&buffer_local_flags, make_number (-1));
+ bset_major_mode (&buffer_local_flags, make_number (-1));
+ bset_mode_name (&buffer_local_flags, make_number (-1));
+ bset_undo_list (&buffer_local_flags, make_number (-1));
+ bset_mark_active (&buffer_local_flags, make_number (-1));
+ bset_point_before_scroll (&buffer_local_flags, make_number (-1));
+ bset_file_truename (&buffer_local_flags, make_number (-1));
+ bset_invisibility_spec (&buffer_local_flags, make_number (-1));
+ bset_file_format (&buffer_local_flags, make_number (-1));
+ bset_auto_save_file_format (&buffer_local_flags, make_number (-1));
+ bset_display_count (&buffer_local_flags, make_number (-1));
+ bset_display_time (&buffer_local_flags, make_number (-1));
+ bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1));
idx = 1;
XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
-#ifndef old
XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
-#endif
XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
/* Need more room? */
if (idx >= MAX_PER_BUFFER_VARS)
- abort ();
+ emacs_abort ();
last_per_buffer_idx = idx;
Vbuffer_alist = Qnil;
current_buffer = 0;
all_buffers = 0;
- QSFundamental = make_pure_c_string ("Fundamental");
+ QSFundamental = build_pure_c_string ("Fundamental");
Qfundamental_mode = intern_c_string ("fundamental-mode");
- BVAR (&buffer_defaults, major_mode) = Qfundamental_mode;
+ bset_major_mode (&buffer_defaults, Qfundamental_mode);
Qmode_class = intern_c_string ("mode-class");
Qkill_buffer_hook = intern_c_string ("kill-buffer-hook");
Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
- Qucs_set_table_for_input = intern_c_string ("ucs-set-table-for-input");
-
/* super-magic invisible buffer */
- Vprin1_to_string_buffer = Fget_buffer_create (make_pure_c_string (" prin1"));
+ Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
Vbuffer_alist = Qnil;
- Fset_buffer (Fget_buffer_create (make_pure_c_string ("*scratch*")));
+ Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
inhibit_modification_hooks = 0;
}
Map new memory. */
struct buffer *b;
- for (b = all_buffers; b; b = b->header.next.buffer)
+ FOR_EACH_BUFFER (b)
if (b->text->beg == NULL)
enlarge_buffer_text (b, 0);
}
if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
{
/* Grow buffer to add directory separator and '\0'. */
- pwd = (char *) realloc (pwd, len + 2);
+ pwd = realloc (pwd, len + 2);
if (!pwd)
fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
pwd[len] = DIRECTORY_SEP;
pwd[len + 1] = '\0';
+ len++;
}
- BVAR (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd));
+ bset_directory (current_buffer, 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_directory
+ (current_buffer, string_to_multibyte (BVAR (current_buffer, directory)));
/* Add /: to the front of the name
if it would otherwise be treated as magic. */
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_directory
+ (current_buffer,
+ concat2 (build_string ("/:"), BVAR (current_buffer, directory)));
temp = get_minibuffer (0);
- BVAR (XBUFFER (temp), directory) = BVAR (current_buffer, directory);
+ bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
free (pwd);
}
if (PER_BUFFER_IDX (offset) == 0)
/* Did a DEFVAR_PER_BUFFER without initializing the corresponding
slot of buffer_local_flags */
- abort ();
+ emacs_abort ();
}
last_overlay_modification_hooks
= Fmake_vector (make_number (10), Qnil);
- staticpro (&Vbuffer_defaults);
- staticpro (&Vbuffer_local_symbols);
staticpro (&Qfundamental_mode);
staticpro (&Qmode_class);
staticpro (&QSFundamental);
DEFSYM (Qafter_change_functions, "after-change-functions");
DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
- /* The next one is initialized in init_buffer_once. */
- staticpro (&Qucs_set_table_for_input);
-
Fput (Qprotected_field, Qerror_conditions,
- pure_cons (Qprotected_field, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
Fput (Qprotected_field, Qerror_message,
- make_pure_c_string ("Attempt to modify a protected field"));
+ build_pure_c_string ("Attempt to modify a protected field"));
DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format",
mode_line_format,
DEFVAR_BUFFER_DEFAULTS ("default-enable-multibyte-characters",
enable_multibyte_characters,
- doc: /* *Default value of `enable-multibyte-characters' for buffers not overriding it.
+ doc: /* Default value of `enable-multibyte-characters' for buffers not overriding it.
This is the same as (default-value 'enable-multibyte-characters). */);
DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system",
DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format),
Qnil,
doc: /* Template for displaying mode line for current buffer.
-Each buffer has its own value of this variable.
-Value may be nil, a string, a symbol or a list or cons cell.
+
+The value may be nil, a string, a symbol or a list.
+
A value of nil means don't display a mode line.
-For a symbol, its value is used (but it is ignored if t or nil).
- A string appearing directly as the value of a symbol is processed verbatim
- in that the %-constructs below are not recognized.
- Note that unless the symbol is marked as a `risky-local-variable', all
- properties in any strings, as well as all :eval and :propertize forms
- in the value of that symbol will be ignored.
-For a list of the form `(:eval FORM)', FORM is evaluated and the result
- is used as a mode line element. Be careful--FORM should not load any files,
- because that can cause an infinite recursion.
-For a list of the form `(:propertize ELT PROPS...)', ELT is displayed
- with the specified properties PROPS applied.
-For a list whose car is a symbol, the symbol's value is taken,
- and if that is non-nil, the cadr of the list is processed recursively.
- Otherwise, the caddr of the list (if there is one) is processed.
-For a list whose car is a string or list, each element is processed
- recursively and the results are effectively concatenated.
-For a list whose car is an integer, the cdr of the list is processed
- and padded (if the number is positive) or truncated (if negative)
- to the width specified by that number.
+
+For any symbol other than t or nil, the symbol's value is processed as
+ a mode line construct. As a special exception, if that value is a
+ string, the string is processed verbatim, without handling any
+ %-constructs (see below). Also, unless the symbol has a non-nil
+ `risky-local-variable' property, all properties in any strings, as
+ well as all :eval and :propertize forms in the value, are ignored.
+
+A list whose car is a string or list is processed by processing each
+ of the list elements recursively, as separate mode line constructs,
+ and concatenating the results.
+
+A list of the form `(:eval FORM)' is processed by evaluating FORM and
+ using the result as a mode line construct. Be careful--FORM should
+ not load any files, because that can cause an infinite recursion.
+
+A list of the form `(:propertize ELT PROPS...)' is processed by
+ processing ELT as the mode line construct, and adding the text
+ properties PROPS to the result.
+
+A list whose car is a symbol is processed by examining the symbol's
+ value, and, if that value is non-nil, processing the cadr of the list
+ recursively; and if that value is nil, processing the caddr of the
+ list recursively.
+
+A list whose car is an integer is processed by processing the cadr of
+ the list, and padding (if the number is positive) or truncating (if
+ negative) to the width specified by that number.
+
A string is printed verbatim in the mode line except for %-constructs:
- (%-constructs are allowed when the string is the entire mode-line-format
- or when it is found in a cons-cell or a list)
%b -- print buffer name. %f -- print visited file name.
%F -- print frame name.
%* -- print %, * or hyphen. %+ -- print *, % or hyphen.
Decimal digits after the % specify field width to which to pad. */);
DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode,
- doc: /* *Value of `major-mode' for new buffers. */);
+ doc: /* Value of `major-mode' for new buffers. */);
DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
make_number (Lisp_Symbol),
DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search),
Qnil,
- doc: /* *Non-nil if searches and matches should ignore case. */);
+ doc: /* Non-nil if searches and matches should ignore case. */);
DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
- make_number (LISP_INT_TAG),
- doc: /* *Column beyond which automatic line-wrapping should happen.
+ make_number (Lisp_Int0),
+ doc: /* Column beyond which automatic line-wrapping should happen.
Interactively, you can set the buffer local value using \\[set-fill-column]. */);
DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
- make_number (LISP_INT_TAG),
- doc: /* *Column for the default `indent-line-function' to indent to.
+ make_number (Lisp_Int0),
+ doc: /* Column for the default `indent-line-function' to indent to.
Linefeed indents to this column in Fundamental mode. */);
DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
- make_number (LISP_INT_TAG),
- doc: /* *Distance between tab stops (for display of tab characters), in columns.
+ make_number (Lisp_Int0),
+ doc: /* Distance between tab stops (for display of tab characters), in columns.
This should be an integer greater than zero. */);
DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
- doc: /* *Non-nil means display control chars with uparrow.
+ doc: /* Non-nil means display control chars with uparrow.
A value of nil means use backslash and octal digits.
This variable does not apply to characters whose display is specified
in the current display table (if there is one). */);
DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
&BVAR (current_buffer, bidi_paragraph_direction), Qnil,
- doc: /* *If non-nil, forces directionality of text paragraphs in the buffer.
+ doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
If this is nil (the default), the direction of each paragraph is
determined by the first strong directional character of its text.
\`bidi-display-reordering' is non-nil. */);
DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil,
- doc: /* *Non-nil means do not display continuation lines.
+ doc: /* Non-nil means do not display continuation lines.
Instead, give each line of text just one screen line.
Note that this is overridden by the variable
Minibuffers set this variable to nil. */);
DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil,
- doc: /* *Non-nil means to use word-wrapping for continuation lines.
+ doc: /* Non-nil means to use word-wrapping for continuation lines.
When word-wrapping is on, continuation lines are wrapped at the space
or tab character nearest to the right window edge.
If nil, continuation lines are wrapped at the right screen edge.
`truncate-lines' and `truncate-partial-width-windows'). If you use
word-wrapping, you might want to reduce the value of
`truncate-partial-width-windows', since wrapping can make text readable
-in narrower windows. */);
+in narrower windows.
+
+Instead of setting this variable directly, most users should use
+Visual Line mode . Visual Line mode, when enabled, sets `word-wrap'
+to t, and additionally redefines simple editing commands to act on
+visual lines rather than logical lines. See the documentation of
+`visual-line-mode'. */);
DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory),
make_number (Lisp_String),
Backing up is done before the first time the file is saved. */);
DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length),
- make_number (LISP_INT_TAG),
+ make_number (Lisp_Int0),
doc: /* Length of current buffer when last read in, saved or auto-saved.
0 initially.
-1 means auto-saving turned off until next real save.
all the rest of the line invisible; also, when saving the buffer
in a file, save the ^M as a newline. */);
-#ifndef old
DEFVAR_PER_BUFFER ("selective-display-ellipses",
&BVAR (current_buffer, selective_display_ellipses),
Qnil,
doc: /* Non-nil means display ... on previous line when a line is invisible. */);
-#endif
DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil,
doc: /* Non-nil if self-insertion should replace existing text.
DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols),
Qnil,
- doc: /* *Width of left marginal area for display of a buffer.
+ doc: /* Width of left marginal area for display of a buffer.
A value of nil means no marginal area. */);
DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols),
Qnil,
- doc: /* *Width of right marginal area for display of a buffer.
+ doc: /* Width of right marginal area for display of a buffer.
A value of nil means no marginal area. */);
DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width),
Qnil,
- doc: /* *Width of this buffer's left fringe (in pixels).
+ doc: /* Width of this buffer's left fringe (in pixels).
A value of 0 means no left fringe is shown in this buffer's window.
A value of nil means to use the left fringe width from the window's frame. */);
DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width),
Qnil,
- doc: /* *Width of this buffer's right fringe (in pixels).
+ doc: /* Width of this buffer's right fringe (in pixels).
A value of 0 means no right fringe is shown in this buffer's window.
A value of nil means to use the right fringe width from the window's frame. */);
DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins),
Qnil,
- doc: /* *Non-nil means to display fringes outside display margins.
+ doc: /* Non-nil means to display fringes outside display margins.
A value of nil means to display fringes between margins and buffer text. */);
DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width),
Qnil,
- doc: /* *Width of this buffer's scroll bars in pixels.
+ doc: /* Width of this buffer's scroll bars in pixels.
A value of nil means to use the scroll bar width from the window's frame. */);
DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type),
Qnil,
- doc: /* *Position of this buffer's vertical scroll bar.
+ doc: /* Position of this buffer's vertical scroll bar.
The value takes effect whenever you tell a window to display this buffer;
for instance, with `set-window-buffer' or when `display-buffer' displays it.
DEFVAR_PER_BUFFER ("indicate-empty-lines",
&BVAR (current_buffer, indicate_empty_lines), Qnil,
- doc: /* *Visually indicate empty lines after the buffer end.
+ doc: /* Visually indicate empty lines after the buffer end.
If non-nil, a bitmap is displayed in the left fringe of a window on
window-systems. */);
DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
&BVAR (current_buffer, indicate_buffer_boundaries), Qnil,
- doc: /* *Visually indicate buffer boundaries and scrolling.
+ doc: /* Visually indicate buffer boundaries and scrolling.
If non-nil, the first and last line of the buffer are marked in the fringe
of a window on window-systems with angle bitmaps, or if the window can be
scrolled, the top and bottom line of the window are marked with up and down
DEFVAR_PER_BUFFER ("fringe-indicator-alist",
&BVAR (current_buffer, fringe_indicator_alist), Qnil,
- doc: /* *Mapping from logical to physical fringe indicator bitmaps.
+ doc: /* Mapping from logical to physical fringe indicator bitmaps.
The value is an alist where each element (INDICATOR . BITMAPS)
specifies the fringe bitmaps used to display a specific logical
fringe indicator.
DEFVAR_PER_BUFFER ("fringe-cursor-alist",
&BVAR (current_buffer, fringe_cursor_alist), Qnil,
- doc: /* *Mapping from logical to physical fringe cursor bitmaps.
+ doc: /* Mapping from logical to physical fringe cursor bitmaps.
The value is an alist where each element (CURSOR . BITMAP)
specifies the fringe bitmaps used to display a specific logical
cursor type in the fringe.
from (abs POSITION). If POSITION is positive, point was at the front
of the text being deleted; if negative, point was at the end.
-An entry (t HIGH . LOW) indicates that the buffer previously had
-\"unmodified\" status. HIGH and LOW are the high and low 16-bit portions
-of the visited file's modification time, as of that time. If the
+An entry (t HIGH LOW USEC PSEC) indicates that the buffer was previously
+unmodified; (HIGH LOW USEC PSEC) is in the same style as (current-time)
+and is the visited file's modification time, as of that time. If the
modification time of the most recent save is different, this entry is
obsolete.
DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
&BVAR (current_buffer, auto_save_file_format), Qnil,
- doc: /* *Format in which to write auto-save files.
+ doc: /* Format in which to write auto-save files.
Should be a list of symbols naming formats that are defined in `format-alist'.
If it is t, which is the default, auto-save files are written in the
same format as a regular save would use. */);
Vtransient_mark_mode = Qnil;
DEFVAR_LISP ("inhibit-read-only", Vinhibit_read_only,
- doc: /* *Non-nil means disregard read-only status of buffers or characters.
+ doc: /* Non-nil means disregard read-only status of buffers or characters.
If the value is t, disregard `buffer-read-only' and all `read-only'
text properties. If the value is a list, disregard `buffer-read-only'
and disregard a `read-only' text property if the property value
DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
&BVAR (current_buffer, cursor_in_non_selected_windows), Qnil,
- doc: /* *Non-nil means show a cursor in non-selected windows.
+ doc: /* Non-nil means show a cursor in non-selected windows.
If nil, only shows a cursor in the selected window.
If t, displays a cursor related to the usual cursor type
\(a solid box becomes hollow, a bar becomes a narrower bar).
DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
doc: /* List of functions called with no args to query before killing a buffer.
The buffer being killed will be current while the functions are running.
-If any of them returns nil, the buffer is not killed. */);
+
+If any of them returns nil, the buffer is not killed. Functions run by
+this hook are supposed to not change the current buffer. */);
Vkill_buffer_query_functions = Qnil;
DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
defsubr (&Smake_indirect_buffer);
defsubr (&Sgenerate_new_buffer_name);
defsubr (&Sbuffer_name);
-/*defsubr (&Sbuffer_number);*/
defsubr (&Sbuffer_file_name);
defsubr (&Sbuffer_base_buffer);
defsubr (&Sbuffer_local_value);
defsubr (&Soverlayp);
defsubr (&Smake_overlay);
defsubr (&Sdelete_overlay);
+ defsubr (&Sdelete_all_overlays);
defsubr (&Smove_overlay);
defsubr (&Soverlay_start);
defsubr (&Soverlay_end);
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/types.h> /* 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. */
/* 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)
#define BUF_TEMP_SET_PT(buffer, position) \
(temp_set_point ((buffer), (position)))
-extern void set_point (EMACS_INT);
-extern void temp_set_point (struct buffer *, EMACS_INT);
-extern void set_point_both (EMACS_INT, EMACS_INT);
+extern void set_point (ptrdiff_t);
+extern void temp_set_point (struct buffer *, ptrdiff_t);
+extern void set_point_both (ptrdiff_t, ptrdiff_t);
extern void temp_set_point_both (struct buffer *,
- EMACS_INT, EMACS_INT);
-extern void enlarge_buffer_text (struct buffer *, EMACS_INT);
+ ptrdiff_t, ptrdiff_t);
+extern void enlarge_buffer_text (struct buffer *, ptrdiff_t);
\f
/* Macros for setting the BEGV, ZV or PT of a given buffer.
#define FETCH_BYTE(n) *(BYTE_POS_ADDR ((n)))
-/* Variables used locally in FETCH_MULTIBYTE_CHAR. */
-extern unsigned char *_fetch_multibyte_char_p;
-
-/* 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.
-
- WARNING: The character returned by this macro could be "unified"
- inside STRING_CHAR, if the original character in the buffer belongs
- to one of the Private Use Areas (PUAs) of codepoints that Emacs
- uses to support non-unified CJK characters. If that happens,
- CHAR_BYTES will return a value that is different from the length of
- the original multibyte sequence stored in the buffer. Therefore,
- do _not_ use FETCH_MULTIBYTE_CHAR if you need to advance through
- the buffer to the next character after fetching this one. Instead,
- use either FETCH_CHAR_ADVANCE or STRING_CHAR_AND_LENGTH. */
-
-#define FETCH_MULTIBYTE_CHAR(pos) \
- (_fetch_multibyte_char_p = (((pos) >= GPT_BYTE ? GAP_SIZE : 0) \
- + (pos) + BEG_ADDR - BEG_BYTE), \
- STRING_CHAR (_fetch_multibyte_char_p))
-
/* Return character at byte position POS. If the current buffer is unibyte
and the character is not ASCII, make the returning character
multibyte. */
#define BUF_FETCH_BYTE(buf, n) \
*(BUF_BYTE_ADDRESS ((buf), (n)))
-
-/* Return character code of multi-byte form at byte position POS in BUF.
- If POS doesn't point the head of valid multi-byte form, only the byte at
- POS is returned. No range checking. */
-
-#define BUF_FETCH_MULTIBYTE_CHAR(buf, pos) \
- (_fetch_multibyte_char_p \
- = (((pos) >= BUF_GPT_BYTE (buf) ? BUF_GAP_SIZE (buf) : 0) \
- + (pos) + BUF_BEG_ADDR (buf) - BEG_BYTE), \
- STRING_CHAR (_fetch_multibyte_char_p))
\f
/* Define the actual buffer data structures. */
into a buffer's text to functions that malloc. */
unsigned char *beg;
- EMACS_INT gpt; /* Char pos of gap in buffer. */
- EMACS_INT z; /* Char pos of end of buffer. */
- EMACS_INT gpt_byte; /* Byte pos of gap in buffer. */
- EMACS_INT z_byte; /* Byte pos of end of buffer. */
- EMACS_INT gap_size; /* Size of buffer's gap. */
- int modiff; /* This counts buffer-modification events
+ ptrdiff_t gpt; /* Char pos of gap in buffer. */
+ ptrdiff_t z; /* Char pos of end of buffer. */
+ ptrdiff_t gpt_byte; /* Byte pos of gap in buffer. */
+ ptrdiff_t z_byte; /* Byte pos of end of buffer. */
+ ptrdiff_t gap_size; /* Size of buffer's gap. */
+ EMACS_INT modiff; /* This counts buffer-modification events
for this buffer. It is incremented for
each such event, and never otherwise
changed. */
- int chars_modiff; /* This is modified with character change
+ EMACS_INT chars_modiff; /* This is modified with character change
events for this buffer. It is set to
modiff for each such event, and never
otherwise changed. */
- int save_modiff; /* Previous value of modiff, as of last
+ EMACS_INT save_modiff; /* Previous value of modiff, as of last
time buffer visited or saved a file. */
- int overlay_modiff; /* Counts modifications to overlays. */
+ EMACS_INT overlay_modiff; /* Counts modifications to overlays. */
+
+ EMACS_INT compact; /* Set to modiff each time when compact_buffer
+ is called for this buffer. */
/* Minimum value of GPT - BEG since last redisplay that finished. */
- EMACS_INT beg_unchanged;
+ ptrdiff_t beg_unchanged;
/* Minimum value of Z - GPT since last redisplay that finished. */
- EMACS_INT end_unchanged;
+ ptrdiff_t end_unchanged;
/* MODIFF as of last redisplay that finished; if it matches MODIFF,
beg_unchanged and end_unchanged contain no useful information. */
- int unchanged_modified;
+ EMACS_INT unchanged_modified;
/* BUF_OVERLAY_MODIFF of current buffer, as of last redisplay that
finished; if it matches BUF_OVERLAY_MODIFF, beg_unchanged and
end_unchanged contain no useful information. */
- int overlay_unchanged_modified;
+ EMACS_INT overlay_unchanged_modified;
/* Properties of this buffer's text. */
INTERVAL intervals;
/* Usually 0. Temporarily set to 1 in decode_coding_gap to
prevent Fgarbage_collect from shrinking the gap and losing
not-yet-decoded bytes. */
- int inhibit_shrinking;
+ bool inhibit_shrinking;
};
-/* Lisp fields in struct buffer are hidden from most code and accessed
- via the BVAR macro, below. Only select pieces of code, like the GC,
- are allowed to use BUFFER_INTERNAL_FIELD. */
-#define BUFFER_INTERNAL_FIELD(field) field ## _
+/* Most code should use this macro to access Lisp fields in struct buffer. */
-/* Most code should use this macro to access Lisp fields in struct
- buffer. */
-#define BVAR(buf, field) ((buf)->BUFFER_INTERNAL_FIELD (field))
+#define BVAR(buf, field) ((buf)->INTERNAL_FIELD (field))
/* This is the structure that the buffer Lisp object points to. */
struct buffer
{
- /* Everything before the `name' slot must be of a non-Lisp_Object type,
- and every slot after `name' must be a Lisp_Object.
-
- Check out mark_buffer (alloc.c) to see why. */
-
- /* HEADER.NEXT is the next buffer, in chain of all buffers,
- including killed buffers.
- This chain is used only for garbage collection, in order to
- collect killed buffers properly.
- Note that vectors and most pseudovectors are all on one chain,
- but buffers are on a separate chain of their own. */
+ /* HEADER.NEXT is the next buffer, in chain of all buffers, including killed
+ buffers. This chain, starting from all_buffers, is used only for garbage
+ collection, in order to collect killed buffers properly. Note that large
+ vectors and large pseudo-vector objects are all on another chain starting
+ from large_vectors. */
struct vectorlike_header header;
- /* This structure holds the coordinates of the buffer contents
- in ordinary buffers. In indirect buffers, this is not used. */
- struct buffer_text own_text;
-
- /* This points to the `struct buffer_text' that used for this buffer.
- In an ordinary buffer, this is the own_text field above.
- In an indirect buffer, this is the own_text field of another buffer. */
- struct buffer_text *text;
-
- /* Char position of point in buffer. */
- EMACS_INT pt;
- /* Byte position of point in buffer. */
- EMACS_INT pt_byte;
- /* Char position of beginning of accessible range. */
- EMACS_INT begv;
- /* Byte position of beginning of accessible range. */
- EMACS_INT begv_byte;
- /* Char position of end of accessible range. */
- EMACS_INT zv;
- /* Byte position of end of accessible range. */
- EMACS_INT zv_byte;
-
- /* In an indirect buffer, this points to the base buffer.
- In an ordinary buffer, it is 0. */
- struct buffer *base_buffer;
-
- /* 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
- for a buffer-local variable is stored in that variable's slot
- in buffer_local_flags as a Lisp integer. If the index is -1,
- this means the variable is always local in all buffers. */
-#define MAX_PER_BUFFER_VARS 50
- char local_flags[MAX_PER_BUFFER_VARS];
-
- /* Set to the modtime of the visited file when read or written.
- -1 means visited file was nonexistent.
- 0 means visited file modtime unknown; in no case complain
- about any mismatch on next save attempt. */
- time_t modtime;
- /* Size of the file when modtime was set. This is used to detect the
- case where the file grew while we were reading it, so the modtime
- is still the same (since it's rounded up to seconds) but we're actually
- not up-to-date. -1 means the size is unknown. Only meaningful if
- modtime is actually set. */
- off_t modtime_size;
- /* The value of text->modiff at the last auto-save. */
- int auto_save_modified;
- /* The value of text->modiff at the last display error.
- Redisplay of this buffer is inhibited until it changes again. */
- int display_error_modiff;
- /* The time at which we detected a failure to auto-save,
- Or 0 if we didn't have a failure. */
- time_t auto_save_failure_time;
- /* Position in buffer at which display started
- the last time this buffer was displayed. */
- EMACS_INT last_window_start;
-
- /* Set nonzero whenever the narrowing is changed in this buffer. */
- int clip_changed;
-
- /* If the long line scan cache is enabled (i.e. the buffer-local
- variable cache-long-line-scans is non-nil), newline_cache
- points to the newline cache, and width_run_cache points to the
- width run cache.
-
- The newline cache records which stretches of the buffer are
- known *not* to contain newlines, so that they can be skipped
- quickly when we search for newlines.
-
- The width run cache records which stretches of the buffer are
- known to contain characters whose widths are all the same. If
- the width run cache maps a character to a value > 0, that value is
- the character's width; if it maps a character to zero, we don't
- know what its width is. This allows compute_motion to process
- such regions very quickly, using algebra instead of inspecting
- each character. See also width_table, below. */
- struct region_cache *newline_cache;
- struct region_cache *width_run_cache;
-
- /* Non-zero means don't use redisplay optimizations for
- displaying this buffer. */
- unsigned prevent_redisplay_optimizations_p : 1;
+ /* The name of this buffer. */
+ Lisp_Object INTERNAL_FIELD (name);
- /* List of overlays that end at or before the current center,
- in order of end-position. */
- struct Lisp_Overlay *overlays_before;
+ /* The name of the file visited in this buffer, or nil. */
+ Lisp_Object INTERNAL_FIELD (filename);
- /* List of overlays that end after the current center,
- in order of start-position. */
- struct Lisp_Overlay *overlays_after;
+ /* Directory for expanding relative file names. */
+ Lisp_Object INTERNAL_FIELD (directory);
- /* Position where the overlay lists are centered. */
- EMACS_INT overlay_center;
-
- /* Everything from here down must be a Lisp_Object. */
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- #define FIRST_FIELD_PER_BUFFER undo_list
-
- /* Changes in the buffer are recorded here for undo.
- t means don't record anything.
- This information belongs to the base buffer of an indirect buffer,
- But we can't store it in the struct buffer_text
- because local variables have to be right in the struct buffer.
- So we copy it around in set_buffer_internal.
- This comes before `name' because it is marked in a special way. */
- Lisp_Object BUFFER_INTERNAL_FIELD (undo_list);
+ /* True if this buffer has been backed up (if you write to the visited
+ file and it hasn't been backed up, then a backup will be made). */
+ Lisp_Object INTERNAL_FIELD (backed_up);
- /* The name of this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (name);
-
- /* The name of the file visited in this buffer, or nil. */
- Lisp_Object BUFFER_INTERNAL_FIELD (filename);
- /* Dir for expanding relative file names. */
- Lisp_Object BUFFER_INTERNAL_FIELD (directory);
- /* True if this buffer has been backed up (if you write to the
- visited file and it hasn't been backed up, then a backup will
- be made). */
- /* This isn't really used by the C code, so could be deleted. */
- Lisp_Object BUFFER_INTERNAL_FIELD (backed_up);
/* Length of file when last read or saved.
-1 means auto saving turned off because buffer shrank a lot.
-2 means don't turn off auto saving if buffer shrinks.
(That value is used with buffer-swap-text.)
This is not in the struct buffer_text
because it's not used in indirect buffers at all. */
- Lisp_Object BUFFER_INTERNAL_FIELD (save_length);
+ Lisp_Object INTERNAL_FIELD (save_length);
+
/* File name used for auto-saving this buffer.
This is not in the struct buffer_text
because it's not used in indirect buffers at all. */
- Lisp_Object BUFFER_INTERNAL_FIELD (auto_save_file_name);
+ Lisp_Object INTERNAL_FIELD (auto_save_file_name);
/* Non-nil if buffer read-only. */
- Lisp_Object BUFFER_INTERNAL_FIELD (read_only);
+ Lisp_Object INTERNAL_FIELD (read_only);
+
/* "The mark". This is a marker which may
point into this buffer or may point nowhere. */
- Lisp_Object BUFFER_INTERNAL_FIELD (mark);
+ Lisp_Object INTERNAL_FIELD (mark);
/* Alist of elements (SYMBOL . VALUE-IN-THIS-BUFFER) for all
per-buffer variables of this buffer. For locally unbound
symbols, just the symbol appears as the element. */
- Lisp_Object BUFFER_INTERNAL_FIELD (local_var_alist);
+ Lisp_Object INTERNAL_FIELD (local_var_alist);
+
+ /* Symbol naming major mode (e.g., lisp-mode). */
+ Lisp_Object INTERNAL_FIELD (major_mode);
+
+ /* Pretty name of major mode (e.g., "Lisp"). */
+ Lisp_Object INTERNAL_FIELD (mode_name);
- /* Symbol naming major mode (eg, lisp-mode). */
- Lisp_Object BUFFER_INTERNAL_FIELD (major_mode);
- /* Pretty name of major mode (eg, "Lisp"). */
- Lisp_Object BUFFER_INTERNAL_FIELD (mode_name);
/* Mode line element that controls format of mode line. */
- Lisp_Object BUFFER_INTERNAL_FIELD (mode_line_format);
+ Lisp_Object INTERNAL_FIELD (mode_line_format);
/* Analogous to mode_line_format for the line displayed at the top
of windows. Nil means don't display that line. */
- Lisp_Object BUFFER_INTERNAL_FIELD (header_line_format);
+ Lisp_Object INTERNAL_FIELD (header_line_format);
/* Keys that are bound local to this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (keymap);
+ Lisp_Object INTERNAL_FIELD (keymap);
+
/* This buffer's local abbrev table. */
- Lisp_Object BUFFER_INTERNAL_FIELD (abbrev_table);
+ Lisp_Object INTERNAL_FIELD (abbrev_table);
+
/* This buffer's syntax table. */
- Lisp_Object BUFFER_INTERNAL_FIELD (syntax_table);
+ Lisp_Object INTERNAL_FIELD (syntax_table);
+
/* This buffer's category table. */
- Lisp_Object BUFFER_INTERNAL_FIELD (category_table);
+ Lisp_Object INTERNAL_FIELD (category_table);
/* Values of several buffer-local variables. */
/* tab-width is buffer-local so that redisplay can find it
in buffers that are not current. */
- Lisp_Object BUFFER_INTERNAL_FIELD (case_fold_search);
- Lisp_Object BUFFER_INTERNAL_FIELD (tab_width);
- Lisp_Object BUFFER_INTERNAL_FIELD (fill_column);
- Lisp_Object BUFFER_INTERNAL_FIELD (left_margin);
+ Lisp_Object INTERNAL_FIELD (case_fold_search);
+ Lisp_Object INTERNAL_FIELD (tab_width);
+ Lisp_Object INTERNAL_FIELD (fill_column);
+ Lisp_Object INTERNAL_FIELD (left_margin);
+
/* Function to call when insert space past fill column. */
- Lisp_Object BUFFER_INTERNAL_FIELD (auto_fill_function);
+ Lisp_Object INTERNAL_FIELD (auto_fill_function);
/* Case table for case-conversion in this buffer.
This char-table maps each char into its lower-case version. */
- Lisp_Object BUFFER_INTERNAL_FIELD (downcase_table);
+ Lisp_Object INTERNAL_FIELD (downcase_table);
+
/* Char-table mapping each char to its upper-case version. */
- Lisp_Object BUFFER_INTERNAL_FIELD (upcase_table);
+ Lisp_Object INTERNAL_FIELD (upcase_table);
+
/* Char-table for conversion for case-folding search. */
- Lisp_Object BUFFER_INTERNAL_FIELD (case_canon_table);
+ Lisp_Object INTERNAL_FIELD (case_canon_table);
+
/* Char-table of equivalences for case-folding search. */
- Lisp_Object BUFFER_INTERNAL_FIELD (case_eqv_table);
+ Lisp_Object INTERNAL_FIELD (case_eqv_table);
/* Non-nil means do not display continuation lines. */
- Lisp_Object BUFFER_INTERNAL_FIELD (truncate_lines);
+ Lisp_Object INTERNAL_FIELD (truncate_lines);
+
/* Non-nil means to use word wrapping when displaying continuation lines. */
- Lisp_Object BUFFER_INTERNAL_FIELD (word_wrap);
+ Lisp_Object INTERNAL_FIELD (word_wrap);
+
/* Non-nil means display ctl chars with uparrow. */
- Lisp_Object BUFFER_INTERNAL_FIELD (ctl_arrow);
+ Lisp_Object INTERNAL_FIELD (ctl_arrow);
+
/* Non-nil means reorder bidirectional text for display in the
visual order. */
- Lisp_Object BUFFER_INTERNAL_FIELD (bidi_display_reordering);
+ Lisp_Object INTERNAL_FIELD (bidi_display_reordering);
+
/* If non-nil, specifies which direction of text to force in all the
paragraphs of the buffer. Nil means determine paragraph
direction dynamically for each paragraph. */
- Lisp_Object BUFFER_INTERNAL_FIELD (bidi_paragraph_direction);
+ Lisp_Object INTERNAL_FIELD (bidi_paragraph_direction);
+
/* Non-nil means do selective display;
see doc string in syms_of_buffer (buffer.c) for details. */
- Lisp_Object BUFFER_INTERNAL_FIELD (selective_display);
-#ifndef old
+ Lisp_Object INTERNAL_FIELD (selective_display);
+
/* Non-nil means show ... at end of line followed by invisible lines. */
- Lisp_Object BUFFER_INTERNAL_FIELD (selective_display_ellipses);
-#endif
+ Lisp_Object INTERNAL_FIELD (selective_display_ellipses);
+
/* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (minor_modes);
+ Lisp_Object INTERNAL_FIELD (minor_modes);
+
/* t if "self-insertion" should overwrite; `binary' if it should also
overwrite newlines and tabs - for editing executables and the like. */
- Lisp_Object BUFFER_INTERNAL_FIELD (overwrite_mode);
- /* non-nil means abbrev mode is on. Expand abbrevs automatically. */
- Lisp_Object BUFFER_INTERNAL_FIELD (abbrev_mode);
+ Lisp_Object INTERNAL_FIELD (overwrite_mode);
+
+ /* Non-nil means abbrev mode is on. Expand abbrevs automatically. */
+ Lisp_Object INTERNAL_FIELD (abbrev_mode);
+
/* Display table to use for text in this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (display_table);
+ Lisp_Object INTERNAL_FIELD (display_table);
+
/* t means the mark and region are currently active. */
- Lisp_Object BUFFER_INTERNAL_FIELD (mark_active);
+ Lisp_Object INTERNAL_FIELD (mark_active);
/* Non-nil means the buffer contents are regarded as multi-byte
form of characters, not a binary code. */
- Lisp_Object BUFFER_INTERNAL_FIELD (enable_multibyte_characters);
+ Lisp_Object INTERNAL_FIELD (enable_multibyte_characters);
/* Coding system to be used for encoding the buffer contents on
saving. */
- Lisp_Object BUFFER_INTERNAL_FIELD (buffer_file_coding_system);
+ Lisp_Object INTERNAL_FIELD (buffer_file_coding_system);
/* List of symbols naming the file format used for visited file. */
- Lisp_Object BUFFER_INTERNAL_FIELD (file_format);
+ Lisp_Object INTERNAL_FIELD (file_format);
/* List of symbols naming the file format used for auto-save file. */
- Lisp_Object BUFFER_INTERNAL_FIELD (auto_save_file_format);
+ Lisp_Object INTERNAL_FIELD (auto_save_file_format);
/* True if the newline position cache and width run cache are
enabled. See search.c and indent.c. */
- Lisp_Object BUFFER_INTERNAL_FIELD (cache_long_line_scans);
+ Lisp_Object INTERNAL_FIELD (cache_long_line_scans);
/* If the width run cache is enabled, this table contains the
character widths width_run_cache (see above) assumes. When we
current display table to see whether the display table has
affected the widths of any characters. If it has, we
invalidate the width run cache, and re-initialize width_table. */
- Lisp_Object BUFFER_INTERNAL_FIELD (width_table);
+ Lisp_Object INTERNAL_FIELD (width_table);
/* In an indirect buffer, or a buffer that is the base of an
indirect buffer, this holds a marker that records
PT for this buffer when the buffer is not current. */
- Lisp_Object BUFFER_INTERNAL_FIELD (pt_marker);
+ Lisp_Object INTERNAL_FIELD (pt_marker);
/* In an indirect buffer, or a buffer that is the base of an
indirect buffer, this holds a marker that records
BEGV for this buffer when the buffer is not current. */
- Lisp_Object BUFFER_INTERNAL_FIELD (begv_marker);
+ Lisp_Object INTERNAL_FIELD (begv_marker);
/* In an indirect buffer, or a buffer that is the base of an
indirect buffer, this holds a marker that records
ZV for this buffer when the buffer is not current. */
- Lisp_Object BUFFER_INTERNAL_FIELD (zv_marker);
+ Lisp_Object INTERNAL_FIELD (zv_marker);
/* This holds the point value before the last scroll operation.
Explicitly setting point sets this to nil. */
- Lisp_Object BUFFER_INTERNAL_FIELD (point_before_scroll);
+ Lisp_Object INTERNAL_FIELD (point_before_scroll);
/* Truename of the visited file, or nil. */
- Lisp_Object BUFFER_INTERNAL_FIELD (file_truename);
+ Lisp_Object INTERNAL_FIELD (file_truename);
/* Invisibility spec of this buffer.
t => any non-nil `invisible' property means invisible.
A list => `invisible' property means invisible
if it is memq in that list. */
- Lisp_Object BUFFER_INTERNAL_FIELD (invisibility_spec);
+ Lisp_Object INTERNAL_FIELD (invisibility_spec);
/* This is the last window that was selected with this buffer in it,
or nil if that window no longer displays this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (last_selected_window);
+ Lisp_Object INTERNAL_FIELD (last_selected_window);
/* Incremented each time the buffer is displayed in a window. */
- Lisp_Object BUFFER_INTERNAL_FIELD (display_count);
+ Lisp_Object INTERNAL_FIELD (display_count);
/* Widths of left and right marginal areas for windows displaying
this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (left_margin_cols), BUFFER_INTERNAL_FIELD (right_margin_cols);
+ Lisp_Object INTERNAL_FIELD (left_margin_cols);
+ Lisp_Object INTERNAL_FIELD (right_margin_cols);
/* Widths of left and right fringe areas for windows displaying
this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (left_fringe_width), BUFFER_INTERNAL_FIELD (right_fringe_width);
+ Lisp_Object INTERNAL_FIELD (left_fringe_width);
+ Lisp_Object INTERNAL_FIELD (right_fringe_width);
/* Non-nil means fringes are drawn outside display margins;
othersize draw them between margin areas and text. */
- Lisp_Object BUFFER_INTERNAL_FIELD (fringes_outside_margins);
+ Lisp_Object INTERNAL_FIELD (fringes_outside_margins);
/* Width and type of scroll bar areas for windows displaying
this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (scroll_bar_width), BUFFER_INTERNAL_FIELD (vertical_scroll_bar_type);
+ Lisp_Object INTERNAL_FIELD (scroll_bar_width);
+ Lisp_Object INTERNAL_FIELD (vertical_scroll_bar_type);
/* Non-nil means indicate lines not displaying text (in a style
like vi). */
- Lisp_Object BUFFER_INTERNAL_FIELD (indicate_empty_lines);
+ Lisp_Object INTERNAL_FIELD (indicate_empty_lines);
/* Non-nil means indicate buffer boundaries and scrolling. */
- Lisp_Object BUFFER_INTERNAL_FIELD (indicate_buffer_boundaries);
+ Lisp_Object INTERNAL_FIELD (indicate_buffer_boundaries);
/* Logical to physical fringe bitmap mappings. */
- Lisp_Object BUFFER_INTERNAL_FIELD (fringe_indicator_alist);
+ Lisp_Object INTERNAL_FIELD (fringe_indicator_alist);
/* Logical to physical cursor bitmap mappings. */
- Lisp_Object BUFFER_INTERNAL_FIELD (fringe_cursor_alist);
+ Lisp_Object INTERNAL_FIELD (fringe_cursor_alist);
/* Time stamp updated each time this buffer is displayed in a window. */
- Lisp_Object BUFFER_INTERNAL_FIELD (display_time);
+ Lisp_Object INTERNAL_FIELD (display_time);
/* If scrolling the display because point is below the bottom of a
window showing this buffer, try to choose a window start so
that point ends up this number of lines from the top of the
window. Nil means that scrolling method isn't used. */
- Lisp_Object BUFFER_INTERNAL_FIELD (scroll_up_aggressively);
+ Lisp_Object INTERNAL_FIELD (scroll_up_aggressively);
/* If scrolling the display because point is above the top of a
window showing this buffer, try to choose a window start so
that point ends up this number of lines from the bottom of the
window. Nil means that scrolling method isn't used. */
- Lisp_Object BUFFER_INTERNAL_FIELD (scroll_down_aggressively);
+ Lisp_Object INTERNAL_FIELD (scroll_down_aggressively);
/* Desired cursor type in this buffer. See the doc string of
per-buffer variable `cursor-type'. */
- Lisp_Object BUFFER_INTERNAL_FIELD (cursor_type);
+ Lisp_Object INTERNAL_FIELD (cursor_type);
/* An integer > 0 means put that number of pixels below text lines
in the display of this buffer. */
- Lisp_Object BUFFER_INTERNAL_FIELD (extra_line_spacing);
+ Lisp_Object INTERNAL_FIELD (extra_line_spacing);
- /* *Cursor type to display in non-selected windows.
+ /* Cursor type to display in non-selected windows.
t means to use hollow box cursor.
See `cursor-type' for other values. */
- Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows);
+ Lisp_Object INTERNAL_FIELD (cursor_in_non_selected_windows);
+
+ /* No more Lisp_Object beyond this point. Except undo_list,
+ which is handled specially in Fgarbage_collect . */
+
+ /* This structure holds the coordinates of the buffer contents
+ in ordinary buffers. In indirect buffers, this is not used. */
+ struct buffer_text own_text;
+
+ /* This points to the `struct buffer_text' that used for this buffer.
+ In an ordinary buffer, this is the own_text field above.
+ In an indirect buffer, this is the own_text field of another buffer. */
+ struct buffer_text *text;
+
+ /* Char position of point in buffer. */
+ ptrdiff_t pt;
+
+ /* Byte position of point in buffer. */
+ ptrdiff_t pt_byte;
+
+ /* Char position of beginning of accessible range. */
+ ptrdiff_t begv;
+
+ /* Byte position of beginning of accessible range. */
+ ptrdiff_t begv_byte;
+
+ /* Char position of end of accessible range. */
+ ptrdiff_t zv;
+
+ /* Byte position of end of accessible range. */
+ ptrdiff_t zv_byte;
+
+ /* In an indirect buffer, this points to the base buffer.
+ In an ordinary buffer, it is 0. */
+ struct buffer *base_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. */
+ 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
+ for a buffer-local variable is stored in that variable's slot
+ in buffer_local_flags as a Lisp integer. If the index is -1,
+ this means the variable is always local in all buffers. */
+#define MAX_PER_BUFFER_VARS 50
+ char local_flags[MAX_PER_BUFFER_VARS];
- /* This must be the last field in the above list. */
- #define LAST_FIELD_PER_BUFFER cursor_in_non_selected_windows
+ /* Set to the modtime of the visited file when read or written.
+ EMACS_NSECS (modtime) == NONEXISTENT_MODTIME_NSECS means
+ visited file was nonexistent. EMACS_NSECS (modtime) ==
+ UNKNOWN_MODTIME_NSECS means visited file modtime unknown;
+ in no case complain about any mismatch on next save attempt. */
+#define NONEXISTENT_MODTIME_NSECS (-1)
+#define UNKNOWN_MODTIME_NSECS (-2)
+ EMACS_TIME modtime;
+
+ /* Size of the file when modtime was set. This is used to detect the
+ case where the file grew while we were reading it, so the modtime
+ is still the same (since it's rounded up to seconds) but we're actually
+ not up-to-date. -1 means the size is unknown. Only meaningful if
+ modtime is actually set. */
+ off_t modtime_size;
+
+ /* The value of text->modiff at the last auto-save. */
+ EMACS_INT auto_save_modified;
+
+ /* The value of text->modiff at the last display error.
+ Redisplay of this buffer is inhibited until it changes again. */
+ EMACS_INT display_error_modiff;
+
+ /* The time at which we detected a failure to auto-save,
+ Or 0 if we didn't have a failure. */
+ time_t auto_save_failure_time;
+
+ /* Position in buffer at which display started
+ the last time this buffer was displayed. */
+ ptrdiff_t last_window_start;
+
+ /* If the long line scan cache is enabled (i.e. the buffer-local
+ variable cache-long-line-scans is non-nil), newline_cache
+ points to the newline cache, and width_run_cache points to the
+ width run cache.
+
+ The newline cache records which stretches of the buffer are
+ known *not* to contain newlines, so that they can be skipped
+ quickly when we search for newlines.
+
+ The width run cache records which stretches of the buffer are
+ known to contain characters whose widths are all the same. If
+ the width run cache maps a character to a value > 0, that value is
+ the character's width; if it maps a character to zero, we don't
+ know what its width is. This allows compute_motion to process
+ such regions very quickly, using algebra instead of inspecting
+ each character. See also width_table, below. */
+ struct region_cache *newline_cache;
+ struct region_cache *width_run_cache;
+
+ /* Non-zero means don't use redisplay optimizations for
+ displaying this buffer. */
+ unsigned prevent_redisplay_optimizations_p : 1;
+
+ /* Non-zero whenever the narrowing is changed in this buffer. */
+ unsigned clip_changed : 1;
+
+ /* List of overlays that end at or before the current center,
+ in order of end-position. */
+ struct Lisp_Overlay *overlays_before;
+
+ /* List of overlays that end after the current center,
+ in order of start-position. */
+ struct Lisp_Overlay *overlays_after;
+
+ /* Position where the overlay lists are centered. */
+ ptrdiff_t overlay_center;
+
+ /* Changes in the buffer are recorded here for undo, and t means
+ don't record anything. This information belongs to the base
+ buffer of an indirect buffer. But we can't store it in the
+ struct buffer_text because local variables have to be right in
+ the struct buffer. So we copy it around in set_buffer_internal. */
+ Lisp_Object INTERNAL_FIELD (undo_list);
};
-\f
+/* Most code should use these functions to set Lisp fields in struct
+ buffer. */
+BUFFER_INLINE void
+bset_bidi_paragraph_direction (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (bidi_paragraph_direction) = val;
+}
+BUFFER_INLINE void
+bset_case_canon_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (case_canon_table) = val;
+}
+BUFFER_INLINE void
+bset_case_eqv_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (case_eqv_table) = val;
+}
+BUFFER_INLINE void
+bset_directory (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (directory) = val;
+}
+BUFFER_INLINE void
+bset_display_count (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (display_count) = val;
+}
+BUFFER_INLINE void
+bset_display_time (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (display_time) = val;
+}
+BUFFER_INLINE void
+bset_downcase_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (downcase_table) = val;
+}
+BUFFER_INLINE void
+bset_enable_multibyte_characters (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (enable_multibyte_characters) = val;
+}
+BUFFER_INLINE void
+bset_filename (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (filename) = val;
+}
+BUFFER_INLINE void
+bset_keymap (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (keymap) = val;
+}
+BUFFER_INLINE void
+bset_last_selected_window (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (last_selected_window) = val;
+}
+BUFFER_INLINE void
+bset_local_var_alist (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (local_var_alist) = val;
+}
+BUFFER_INLINE void
+bset_mark_active (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (mark_active) = val;
+}
+BUFFER_INLINE void
+bset_point_before_scroll (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (point_before_scroll) = val;
+}
+BUFFER_INLINE void
+bset_read_only (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (read_only) = val;
+}
+BUFFER_INLINE void
+bset_truncate_lines (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (truncate_lines) = val;
+}
+BUFFER_INLINE void
+bset_undo_list (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (undo_list) = val;
+}
+BUFFER_INLINE void
+bset_upcase_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (upcase_table) = val;
+}
+BUFFER_INLINE void
+bset_width_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (width_table) = val;
+}
+
+/* Convenient check whether buffer B is live. */
+
+#define BUFFER_LIVE_P(b) (!NILP (BVAR (b, name)))
+
+/* Chain of all buffers, including killed ones. */
+
+extern struct buffer *all_buffers;
+
+/* Used to iterate over the chain above. */
+
+#define FOR_EACH_BUFFER(b) \
+ for ((b) = all_buffers; (b); (b) = (b)->header.next.buffer)
+
/* This points to the current buffer. */
extern struct buffer *current_buffer;
\f
extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
-extern void evaporate_overlays (EMACS_INT);
-extern ptrdiff_t overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr,
- ptrdiff_t *len_ptr, EMACS_INT *next_ptr,
- EMACS_INT *prev_ptr, int change_req);
+extern void compact_buffer (struct buffer *);
+extern void evaporate_overlays (ptrdiff_t);
+extern ptrdiff_t overlays_at (EMACS_INT, bool, Lisp_Object **,
+ ptrdiff_t *, ptrdiff_t *, ptrdiff_t *, bool);
extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *);
-extern void recenter_overlay_lists (struct buffer *, EMACS_INT);
-extern EMACS_INT overlay_strings (EMACS_INT, struct window *, unsigned char **);
+extern void recenter_overlay_lists (struct buffer *, ptrdiff_t);
+extern ptrdiff_t overlay_strings (ptrdiff_t, struct window *, unsigned char **);
extern void validate_region (Lisp_Object *, Lisp_Object *);
-extern void set_buffer_internal (struct buffer *);
extern void set_buffer_internal_1 (struct buffer *);
extern void set_buffer_temp (struct buffer *);
+extern Lisp_Object buffer_local_value_1 (Lisp_Object, Lisp_Object);
extern void record_buffer (Lisp_Object);
-extern void buffer_slot_type_mismatch (Lisp_Object, int) NO_RETURN;
-extern void fix_overlays_before (struct buffer *, EMACS_INT, EMACS_INT);
-extern void mmap_set_vars (int);
+extern _Noreturn void buffer_slot_type_mismatch (Lisp_Object, int);
+extern void fix_overlays_before (struct buffer *, ptrdiff_t, ptrdiff_t);
+extern void mmap_set_vars (bool);
+
+/* Set the current buffer to B.
+
+ We previously set windows_or_buffers_changed here to invalidate
+ global unchanged information in beg_unchanged and end_unchanged.
+ This is no longer necessary because we now compute unchanged
+ information on a buffer-basis. Every action affecting other
+ windows than the selected one requires a select_window at some
+ time, and that increments windows_or_buffers_changed. */
+
+BUFFER_INLINE void
+set_buffer_internal (struct buffer *b)
+{
+ if (current_buffer != b)
+ set_buffer_internal_1 (b);
+}
+
+/* Arrange to go back to the original buffer after the next
+ call to unbind_to if the original buffer is still alive. */
+
+BUFFER_INLINE void
+record_unwind_current_buffer (void)
+{
+ record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+}
/* Get overlays at POSN into array OVERLAYS with NOVERLAYS elements.
If NEXTP is non-NULL, return next overlay there.
#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq) \
do { \
- ptrdiff_t maxlen = 40; \
- overlays = (Lisp_Object *) alloca (maxlen * sizeof (Lisp_Object)); \
+ ptrdiff_t maxlen = 40; \
+ overlays = alloca (maxlen * sizeof *overlays); \
noverlays = overlays_at (posn, 0, &overlays, &maxlen, \
- nextp, NULL, chrq); \
+ nextp, NULL, chrq); \
if (noverlays > maxlen) \
{ \
maxlen = noverlays; \
- overlays = (Lisp_Object *) alloca (maxlen * sizeof (Lisp_Object)); \
+ overlays = alloca (maxlen * sizeof *overlays); \
noverlays = overlays_at (posn, 0, &overlays, &maxlen, \
nextp, NULL, chrq); \
} \
} while (0)
-EXFUN (Fbuffer_live_p, 1);
-EXFUN (Fbuffer_name, 1);
-EXFUN (Fnext_overlay_change, 1);
-EXFUN (Fbuffer_local_value, 2);
-
extern Lisp_Object Qbefore_change_functions;
extern Lisp_Object Qafter_change_functions;
extern Lisp_Object Qfirst_change_hook;
-\f
-/* Overlays */
+/* Get text properties of B. */
+
+BUFFER_INLINE INTERVAL
+buffer_intervals (struct buffer *b)
+{
+ eassert (b->text != NULL);
+ return b->text->intervals;
+}
+
+/* Set text properties of B to I. */
+
+BUFFER_INLINE void
+set_buffer_intervals (struct buffer *b, INTERVAL i)
+{
+ eassert (b->text != NULL);
+ b->text->intervals = i;
+}
+
+/* Non-zero if current buffer has overlays. */
+
+BUFFER_INLINE bool
+buffer_has_overlays (void)
+{
+ return current_buffer->overlays_before || current_buffer->overlays_after;
+}
-/* 1 if the OV is an overlay object. */
+/* 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.
-#define OVERLAY_VALID(OV) (OVERLAYP (OV))
+ WARNING: The character returned by this macro could be "unified"
+ inside STRING_CHAR, if the original character in the buffer belongs
+ to one of the Private Use Areas (PUAs) of codepoints that Emacs
+ uses to support non-unified CJK characters. If that happens,
+ CHAR_BYTES will return a value that is different from the length of
+ the original multibyte sequence stored in the buffer. Therefore,
+ do _not_ use FETCH_MULTIBYTE_CHAR if you need to advance through
+ the buffer to the next character after fetching this one. Instead,
+ use either FETCH_CHAR_ADVANCE or STRING_CHAR_AND_LENGTH. */
+
+BUFFER_INLINE int
+FETCH_MULTIBYTE_CHAR (ptrdiff_t pos)
+{
+ unsigned char *p = ((pos >= GPT_BYTE ? GAP_SIZE : 0)
+ + pos + BEG_ADDR - BEG_BYTE);
+ return STRING_CHAR (p);
+}
+
+/* Return character code of multi-byte form at byte position POS in BUF.
+ If POS doesn't point the head of valid multi-byte form, only the byte at
+ POS is returned. No range checking. */
+
+BUFFER_INLINE int
+BUF_FETCH_MULTIBYTE_CHAR (struct buffer *buf, ptrdiff_t pos)
+{
+ unsigned char *p
+ = ((pos >= BUF_GPT_BYTE (buf) ? BUF_GAP_SIZE (buf) : 0)
+ + pos + BUF_BEG_ADDR (buf) - BEG_BYTE);
+ return STRING_CHAR (p);
+}
+\f
+/* Overlays */
/* Return the marker that stands for where OV starts in the buffer. */
-#define OVERLAY_START(OV) (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) (XOVERLAY (OV)->end)
+#define OVERLAY_END(OV) XOVERLAY (OV)->end
/* Return the plist of overlay OV. */
-#define OVERLAY_PLIST(OV) 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. */
#define OVERLAY_POSITION(P) \
- (MARKERP (P) ? marker_position (P) : (abort (), 0))
+ (MARKERP (P) ? marker_position (P) : (emacs_abort (), 0))
\f
/***********************************************************************
from the start of a buffer structure. */
#define PER_BUFFER_VAR_OFFSET(VAR) \
- offsetof (struct buffer, BUFFER_INTERNAL_FIELD (VAR))
+ offsetof (struct buffer, INTERNAL_FIELD (VAR))
+
+/* Used to iterate over normal Lisp_Object fields of struct buffer (all
+ Lisp_Objects except undo_list). If you add, remove, or reorder
+ Lisp_Objects in a struct buffer, make sure that this is still correct. */
+
+#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 += 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
#define PER_BUFFER_VALUE_P(B, IDX) \
(((IDX) < 0 || IDX >= last_per_buffer_idx) \
- ? (abort (), 0) \
+ ? (emacs_abort (), 0) \
: ((B)->local_flags[IDX] != 0))
/* Set whether per-buffer variable with index IDX has a buffer-local
#define SET_PER_BUFFER_VALUE_P(B, IDX, VAL) \
do { \
if ((IDX) < 0 || (IDX) >= last_per_buffer_idx) \
- abort (); \
+ emacs_abort (); \
(B)->local_flags[IDX] = (VAL); \
} while (0)
#define PER_BUFFER_IDX(OFFSET) \
XINT (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags))
-/* Return the default value of the per-buffer variable at offset
- OFFSET in the buffer structure. */
+/* Functions to get and set default value of the per-buffer
+ variable at offset OFFSET in the buffer structure. */
-#define PER_BUFFER_DEFAULT(OFFSET) \
- (*(Lisp_Object *)((OFFSET) + (char *) &buffer_defaults))
+BUFFER_INLINE Lisp_Object
+per_buffer_default (int offset)
+{
+ return *(Lisp_Object *)(offset + (char *) &buffer_defaults);
+}
-/* Return the buffer-local value of the per-buffer variable at offset
- OFFSET in the buffer structure. */
+BUFFER_INLINE void
+set_per_buffer_default (int offset, Lisp_Object value)
+{
+ *(Lisp_Object *)(offset + (char *) &buffer_defaults) = value;
+}
+
+/* Functions to get and set buffer-local value of the per-buffer
+ variable at offset OFFSET in the buffer structure. */
+
+BUFFER_INLINE Lisp_Object
+per_buffer_value (struct buffer *b, int offset)
+{
+ return *(Lisp_Object *)(offset + (char *) b);
+}
+
+BUFFER_INLINE void
+set_per_buffer_value (struct buffer *b, int offset, Lisp_Object value)
+{
+ *(Lisp_Object *)(offset + (char *) b) = value;
+}
-#define PER_BUFFER_VALUE(BUFFER, OFFSET) \
- (*(Lisp_Object *)((OFFSET) + (char *) (BUFFER)))
-\f
/* 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);
}
/* 1 if C is upper case. */
-static inline int uppercasep (int c) { return downcase (c) != c; }
+BUFFER_INLINE bool 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);
}
/* 1 if C is lower case. */
-static inline int lowercasep (int c)
-{ return !uppercasep (c) && upcase1 (c) != c; }
+BUFFER_INLINE bool
+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
*/
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "syntax.h"
#include "window.h"
/* #define BYTE_CODE_SAFE */
/* #define BYTE_CODE_METER */
+/* If BYTE_CODE_THREADED is defined, then the interpreter will be
+ indirect threaded, using GCC's computed goto extension. This code,
+ as currently implemented, is incompatible with BYTE_CODE_SAFE and
+ BYTE_CODE_METER. */
+#if defined (__GNUC__) && !defined (BYTE_CODE_SAFE) && !defined (BYTE_CODE_METER)
+#define BYTE_CODE_THREADED
+#endif
+
\f
#ifdef BYTE_CODE_METER
Lisp_Object Qbyte_code_meter;
-#define METER_2(code1, code2) \
- XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
- ->contents[(code2)])
-
-#define METER_1(code) METER_2 (0, (code))
+#define METER_2(code1, code2) AREF (AREF (Vbyte_code_meter, code1), code2)
+#define METER_1(code) METER_2 (0, code)
#define METER_CODE(last_code, this_code) \
{ \
if (byte_metering_on) \
{ \
- if (METER_1 (this_code) < MOST_POSITIVE_FIXNUM) \
- METER_1 (this_code)++; \
+ if (XFASTINT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \
+ XSETFASTINT (METER_1 (this_code), \
+ XFASTINT (METER_1 (this_code)) + 1); \
if (last_code \
- && METER_2 (last_code, this_code) < MOST_POSITIVE_FIXNUM) \
- METER_2 (last_code, this_code)++; \
+ && (XFASTINT (METER_2 (last_code, this_code)) \
+ < MOST_POSITIVE_FIXNUM)) \
+ XSETFASTINT (METER_2 (last_code, this_code), \
+ XFASTINT (METER_2 (last_code, this_code)) + 1); \
} \
}
/* Byte codes: */
-#define Bstack_ref 0 /* Actually, Bstack_ref+0 is not implemented: use dup. */
-#define Bvarref 010
-#define Bvarset 020
-#define Bvarbind 030
-#define Bcall 040
-#define Bunbind 050
-
-#define Bnth 070
-#define Bsymbolp 071
-#define Bconsp 072
-#define Bstringp 073
-#define Blistp 074
-#define Beq 075
-#define Bmemq 076
-#define Bnot 077
-#define Bcar 0100
-#define Bcdr 0101
-#define Bcons 0102
-#define Blist1 0103
-#define Blist2 0104
-#define Blist3 0105
-#define Blist4 0106
-#define Blength 0107
-#define Baref 0110
-#define Baset 0111
-#define Bsymbol_value 0112
-#define Bsymbol_function 0113
-#define Bset 0114
-#define Bfset 0115
-#define Bget 0116
-#define Bsubstring 0117
-#define Bconcat2 0120
-#define Bconcat3 0121
-#define Bconcat4 0122
-#define Bsub1 0123
-#define Badd1 0124
-#define Beqlsign 0125
-#define Bgtr 0126
-#define Blss 0127
-#define Bleq 0130
-#define Bgeq 0131
-#define Bdiff 0132
-#define Bnegate 0133
-#define Bplus 0134
-#define Bmax 0135
-#define Bmin 0136
-#define Bmult 0137
-
-#define Bpoint 0140
-/* Was Bmark in v17. */
-#define Bsave_current_buffer 0141 /* Obsolete. */
-#define Bgoto_char 0142
-#define Binsert 0143
-#define Bpoint_max 0144
-#define Bpoint_min 0145
-#define Bchar_after 0146
-#define Bfollowing_char 0147
-#define Bpreceding_char 0150
-#define Bcurrent_column 0151
-#define Bindent_to 0152
-#ifdef BYTE_CODE_SAFE
-#define Bscan_buffer 0153 /* No longer generated as of v18. */
-#endif
-#define Beolp 0154
-#define Beobp 0155
-#define Bbolp 0156
-#define Bbobp 0157
-#define Bcurrent_buffer 0160
-#define Bset_buffer 0161
-#define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */
-#if 0
-#define Bread_char 0162 /* No longer generated as of v19 */
-#endif
+#define BYTE_CODES \
+DEFINE (Bstack_ref, 0) /* Actually, Bstack_ref+0 is not implemented: use dup. */ \
+DEFINE (Bstack_ref1, 1) \
+DEFINE (Bstack_ref2, 2) \
+DEFINE (Bstack_ref3, 3) \
+DEFINE (Bstack_ref4, 4) \
+DEFINE (Bstack_ref5, 5) \
+DEFINE (Bstack_ref6, 6) \
+DEFINE (Bstack_ref7, 7) \
+DEFINE (Bvarref, 010) \
+DEFINE (Bvarref1, 011) \
+DEFINE (Bvarref2, 012) \
+DEFINE (Bvarref3, 013) \
+DEFINE (Bvarref4, 014) \
+DEFINE (Bvarref5, 015) \
+DEFINE (Bvarref6, 016) \
+DEFINE (Bvarref7, 017) \
+DEFINE (Bvarset, 020) \
+DEFINE (Bvarset1, 021) \
+DEFINE (Bvarset2, 022) \
+DEFINE (Bvarset3, 023) \
+DEFINE (Bvarset4, 024) \
+DEFINE (Bvarset5, 025) \
+DEFINE (Bvarset6, 026) \
+DEFINE (Bvarset7, 027) \
+DEFINE (Bvarbind, 030) \
+DEFINE (Bvarbind1, 031) \
+DEFINE (Bvarbind2, 032) \
+DEFINE (Bvarbind3, 033) \
+DEFINE (Bvarbind4, 034) \
+DEFINE (Bvarbind5, 035) \
+DEFINE (Bvarbind6, 036) \
+DEFINE (Bvarbind7, 037) \
+DEFINE (Bcall, 040) \
+DEFINE (Bcall1, 041) \
+DEFINE (Bcall2, 042) \
+DEFINE (Bcall3, 043) \
+DEFINE (Bcall4, 044) \
+DEFINE (Bcall5, 045) \
+DEFINE (Bcall6, 046) \
+DEFINE (Bcall7, 047) \
+DEFINE (Bunbind, 050) \
+DEFINE (Bunbind1, 051) \
+DEFINE (Bunbind2, 052) \
+DEFINE (Bunbind3, 053) \
+DEFINE (Bunbind4, 054) \
+DEFINE (Bunbind5, 055) \
+DEFINE (Bunbind6, 056) \
+DEFINE (Bunbind7, 057) \
+ \
+DEFINE (Bnth, 070) \
+DEFINE (Bsymbolp, 071) \
+DEFINE (Bconsp, 072) \
+DEFINE (Bstringp, 073) \
+DEFINE (Blistp, 074) \
+DEFINE (Beq, 075) \
+DEFINE (Bmemq, 076) \
+DEFINE (Bnot, 077) \
+DEFINE (Bcar, 0100) \
+DEFINE (Bcdr, 0101) \
+DEFINE (Bcons, 0102) \
+DEFINE (Blist1, 0103) \
+DEFINE (Blist2, 0104) \
+DEFINE (Blist3, 0105) \
+DEFINE (Blist4, 0106) \
+DEFINE (Blength, 0107) \
+DEFINE (Baref, 0110) \
+DEFINE (Baset, 0111) \
+DEFINE (Bsymbol_value, 0112) \
+DEFINE (Bsymbol_function, 0113) \
+DEFINE (Bset, 0114) \
+DEFINE (Bfset, 0115) \
+DEFINE (Bget, 0116) \
+DEFINE (Bsubstring, 0117) \
+DEFINE (Bconcat2, 0120) \
+DEFINE (Bconcat3, 0121) \
+DEFINE (Bconcat4, 0122) \
+DEFINE (Bsub1, 0123) \
+DEFINE (Badd1, 0124) \
+DEFINE (Beqlsign, 0125) \
+DEFINE (Bgtr, 0126) \
+DEFINE (Blss, 0127) \
+DEFINE (Bleq, 0130) \
+DEFINE (Bgeq, 0131) \
+DEFINE (Bdiff, 0132) \
+DEFINE (Bnegate, 0133) \
+DEFINE (Bplus, 0134) \
+DEFINE (Bmax, 0135) \
+DEFINE (Bmin, 0136) \
+DEFINE (Bmult, 0137) \
+ \
+DEFINE (Bpoint, 0140) \
+/* Was Bmark in v17. */ \
+DEFINE (Bsave_current_buffer, 0141) /* Obsolete. */ \
+DEFINE (Bgoto_char, 0142) \
+DEFINE (Binsert, 0143) \
+DEFINE (Bpoint_max, 0144) \
+DEFINE (Bpoint_min, 0145) \
+DEFINE (Bchar_after, 0146) \
+DEFINE (Bfollowing_char, 0147) \
+DEFINE (Bpreceding_char, 0150) \
+DEFINE (Bcurrent_column, 0151) \
+DEFINE (Bindent_to, 0152) \
+DEFINE (Beolp, 0154) \
+DEFINE (Beobp, 0155) \
+DEFINE (Bbolp, 0156) \
+DEFINE (Bbobp, 0157) \
+DEFINE (Bcurrent_buffer, 0160) \
+DEFINE (Bset_buffer, 0161) \
+DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \
+DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \
+ \
+DEFINE (Bforward_char, 0165) \
+DEFINE (Bforward_word, 0166) \
+DEFINE (Bskip_chars_forward, 0167) \
+DEFINE (Bskip_chars_backward, 0170) \
+DEFINE (Bforward_line, 0171) \
+DEFINE (Bchar_syntax, 0172) \
+DEFINE (Bbuffer_substring, 0173) \
+DEFINE (Bdelete_region, 0174) \
+DEFINE (Bnarrow_to_region, 0175) \
+DEFINE (Bwiden, 0176) \
+DEFINE (Bend_of_line, 0177) \
+ \
+DEFINE (Bconstant2, 0201) \
+DEFINE (Bgoto, 0202) \
+DEFINE (Bgotoifnil, 0203) \
+DEFINE (Bgotoifnonnil, 0204) \
+DEFINE (Bgotoifnilelsepop, 0205) \
+DEFINE (Bgotoifnonnilelsepop, 0206) \
+DEFINE (Breturn, 0207) \
+DEFINE (Bdiscard, 0210) \
+DEFINE (Bdup, 0211) \
+ \
+DEFINE (Bsave_excursion, 0212) \
+DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \
+DEFINE (Bsave_restriction, 0214) \
+DEFINE (Bcatch, 0215) \
+ \
+DEFINE (Bunwind_protect, 0216) \
+DEFINE (Bcondition_case, 0217) \
+DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \
+DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \
+ \
+DEFINE (Bunbind_all, 0222) /* Obsolete. Never used. */ \
+ \
+DEFINE (Bset_marker, 0223) \
+DEFINE (Bmatch_beginning, 0224) \
+DEFINE (Bmatch_end, 0225) \
+DEFINE (Bupcase, 0226) \
+DEFINE (Bdowncase, 0227) \
+ \
+DEFINE (Bstringeqlsign, 0230) \
+DEFINE (Bstringlss, 0231) \
+DEFINE (Bequal, 0232) \
+DEFINE (Bnthcdr, 0233) \
+DEFINE (Belt, 0234) \
+DEFINE (Bmember, 0235) \
+DEFINE (Bassq, 0236) \
+DEFINE (Bnreverse, 0237) \
+DEFINE (Bsetcar, 0240) \
+DEFINE (Bsetcdr, 0241) \
+DEFINE (Bcar_safe, 0242) \
+DEFINE (Bcdr_safe, 0243) \
+DEFINE (Bnconc, 0244) \
+DEFINE (Bquo, 0245) \
+DEFINE (Brem, 0246) \
+DEFINE (Bnumberp, 0247) \
+DEFINE (Bintegerp, 0250) \
+ \
+DEFINE (BRgoto, 0252) \
+DEFINE (BRgotoifnil, 0253) \
+DEFINE (BRgotoifnonnil, 0254) \
+DEFINE (BRgotoifnilelsepop, 0255) \
+DEFINE (BRgotoifnonnilelsepop, 0256) \
+ \
+DEFINE (BlistN, 0257) \
+DEFINE (BconcatN, 0260) \
+DEFINE (BinsertN, 0261) \
+ \
+/* Bstack_ref is code 0. */ \
+DEFINE (Bstack_set, 0262) \
+DEFINE (Bstack_set2, 0263) \
+DEFINE (BdiscardN, 0266) \
+ \
+DEFINE (Bconstant, 0300)
+
+enum byte_code_op
+{
+#define DEFINE(name, value) name = value,
+ BYTE_CODES
+#undef DEFINE
+
#ifdef BYTE_CODE_SAFE
-#define Bset_mark 0163 /* this loser is no longer generated as of v18 */
+ Bscan_buffer = 0153, /* No longer generated as of v18. */
+ Bset_mark = 0163 /* this loser is no longer generated as of v18 */
#endif
-#define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */
-
-#define Bforward_char 0165
-#define Bforward_word 0166
-#define Bskip_chars_forward 0167
-#define Bskip_chars_backward 0170
-#define Bforward_line 0171
-#define Bchar_syntax 0172
-#define Bbuffer_substring 0173
-#define Bdelete_region 0174
-#define Bnarrow_to_region 0175
-#define Bwiden 0176
-#define Bend_of_line 0177
-
-#define Bconstant2 0201
-#define Bgoto 0202
-#define Bgotoifnil 0203
-#define Bgotoifnonnil 0204
-#define Bgotoifnilelsepop 0205
-#define Bgotoifnonnilelsepop 0206
-#define Breturn 0207
-#define Bdiscard 0210
-#define Bdup 0211
-
-#define Bsave_excursion 0212
-#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1. */
-#define Bsave_restriction 0214
-#define Bcatch 0215
-
-#define Bunwind_protect 0216
-#define Bcondition_case 0217
-#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */
-#define Btemp_output_buffer_show 0221 /* Obsolete since Emacs-24.1. */
-
-#define Bunbind_all 0222 /* Obsolete. Never used. */
-
-#define Bset_marker 0223
-#define Bmatch_beginning 0224
-#define Bmatch_end 0225
-#define Bupcase 0226
-#define Bdowncase 0227
-
-#define Bstringeqlsign 0230
-#define Bstringlss 0231
-#define Bequal 0232
-#define Bnthcdr 0233
-#define Belt 0234
-#define Bmember 0235
-#define Bassq 0236
-#define Bnreverse 0237
-#define Bsetcar 0240
-#define Bsetcdr 0241
-#define Bcar_safe 0242
-#define Bcdr_safe 0243
-#define Bnconc 0244
-#define Bquo 0245
-#define Brem 0246
-#define Bnumberp 0247
-#define Bintegerp 0250
-
-#define BRgoto 0252
-#define BRgotoifnil 0253
-#define BRgotoifnonnil 0254
-#define BRgotoifnilelsepop 0255
-#define BRgotoifnonnilelsepop 0256
-
-#define BlistN 0257
-#define BconcatN 0260
-#define BinsertN 0261
-
-/* Bstack_ref is code 0. */
-#define Bstack_set 0262
-#define Bstack_set2 0263
-#define BdiscardN 0266
-
-#define Bconstant 0300
+};
/* Whether to maintain a `top' and `bottom' field in the stack frame. */
#define BYTE_MAINTAIN_TOP (BYTE_CODE_SAFE || BYTE_MARK_STACK)
{
if (stack->byte_string_start != SDATA (stack->byte_string))
{
- int offset = stack->pc - stack->byte_string_start;
+ ptrdiff_t offset = stack->pc - stack->byte_string_start;
stack->byte_string_start = SDATA (stack->byte_string);
stack->pc = stack->byte_string_start + offset;
}
/* Garbage collect if we have consed enough since the last time.
We do this at every branch, to avoid loops that never GC. */
-#define MAYBE_GC() \
- do { \
- if (consing_since_gc > gc_cons_threshold \
- && consing_since_gc > gc_relative_threshold) \
- { \
- BEFORE_POTENTIAL_GC (); \
- Fgarbage_collect (); \
- AFTER_POTENTIAL_GC (); \
- } \
+#define MAYBE_GC() \
+ do { \
+ BEFORE_POTENTIAL_GC (); \
+ maybe_gc (); \
+ AFTER_POTENTIAL_GC (); \
} while (0)
/* Check for jumping out of range. */
#ifdef BYTE_CODE_SAFE
#define CHECK_RANGE(ARG) \
- if (ARG >= bytestr_length) abort ()
+ if (ARG >= bytestr_length) emacs_abort ()
#else /* not BYTE_CODE_SAFE */
Fsignal (Qquit, Qnil); \
AFTER_POTENTIAL_GC (); \
} \
- ELSE_PENDING_SIGNALS \
+ else if (pending_signals) \
+ process_pending_signals (); \
} while (0)
exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
#ifdef BYTE_CODE_METER
int this_op = 0;
int prev_op;
#ifdef BYTE_CODE_SAFE
ptrdiff_t const_length;
Lisp_Object *stacke;
- int bytestr_length;
+ ptrdiff_t bytestr_length;
#endif
struct byte_stack stack;
Lisp_Object *top;
if (FRAME_X_P (f)
&& FRAME_FONT (f)->direction != 0
&& FRAME_FONT (f)->direction != 1)
- abort ();
+ emacs_abort ();
}
#endif
stack.byte_string = bytestr;
stack.pc = stack.byte_string_start = SDATA (bytestr);
stack.constants = vector;
- if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object) < XFASTINT (maxdepth))
+ if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth))
memory_full (SIZE_MAX);
- top = (Lisp_Object *) alloca (XFASTINT (maxdepth)
- * sizeof (Lisp_Object));
+ top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top);
#if BYTE_MAINTAIN_TOP
- stack.bottom = top;
+ stack.bottom = top + 1;
stack.top = NULL;
#endif
- top -= 1;
stack.next = byte_stack_list;
byte_stack_list = &stack;
if (INTEGERP (args_template))
{
ptrdiff_t at = XINT (args_template);
- int rest = at & 128;
+ bool rest = (at & 128) != 0;
int mandatory = at & 127;
ptrdiff_t nonrest = at >> 8;
eassert (mandatory <= nonrest);
{
#ifdef BYTE_CODE_SAFE
if (top > stacke)
- abort ();
+ emacs_abort ();
else if (top < stack.bottom - 1)
- abort ();
+ emacs_abort ();
#endif
#ifdef BYTE_CODE_METER
this_op = op = FETCH;
METER_CODE (prev_op, op);
#else
+#ifndef BYTE_CODE_THREADED
op = FETCH;
#endif
+#endif
+
+ /* The interpreter can be compiled one of two ways: as an
+ ordinary switch-based interpreter, or as a threaded
+ interpreter. The threaded interpreter relies on GCC's
+ computed goto extension, so it is not available everywhere.
+ Threading provides a performance boost. These macros are how
+ we allow the code to be compiled both ways. */
+#ifdef BYTE_CODE_THREADED
+ /* The CASE macro introduces an instruction's body. It is
+ either a label or a case label. */
+#define CASE(OP) insn_ ## OP
+ /* NEXT is invoked at the end of an instruction to go to the
+ next instruction. It is either a computed goto, or a
+ plain break. */
+#define NEXT goto *(targets[op = FETCH])
+ /* FIRST is like NEXT, but is only used at the start of the
+ interpreter body. In the switch-based interpreter it is the
+ switch, so the threaded definition must include a semicolon. */
+#define FIRST NEXT;
+ /* Most cases are labeled with the CASE macro, above.
+ CASE_DEFAULT is one exception; it is used if the interpreter
+ being built requires a default case. The threaded
+ interpreter does not, because the dispatch table is
+ completely filled. */
+#define CASE_DEFAULT
+ /* This introduces an instruction that is known to call abort. */
+#define CASE_ABORT CASE (Bstack_ref): CASE (default)
+#else
+ /* See above for the meaning of the various defines. */
+#define CASE(OP) case OP
+#define NEXT break
+#define FIRST switch (op)
+#define CASE_DEFAULT case 255: default:
+#define CASE_ABORT case 0
+#endif
+
+#ifdef BYTE_CODE_THREADED
+
+ /* A convenience define that saves us a lot of typing and makes
+ the table clearer. */
+#define LABEL(OP) [OP] = &&insn_ ## OP
- switch (op)
+#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic push
+# pragma GCC diagnostic ignored "-Woverride-init"
+#endif
+
+ /* This is the dispatch table for the threaded interpreter. */
+ static const void *const targets[256] =
{
- case Bvarref + 7:
+ [0 ... (Bconstant - 1)] = &&insn_default,
+ [Bconstant ... 255] = &&insn_Bconstant,
+
+#define DEFINE(name, value) LABEL (name) ,
+ BYTE_CODES
+#undef DEFINE
+ };
+
+#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic pop
+#endif
+
+#endif
+
+
+ FIRST
+ {
+ CASE (Bvarref7):
op = FETCH2;
goto varref;
- case Bvarref:
- case Bvarref + 1:
- case Bvarref + 2:
- case Bvarref + 3:
- case Bvarref + 4:
- case Bvarref + 5:
+ CASE (Bvarref):
+ CASE (Bvarref1):
+ CASE (Bvarref2):
+ CASE (Bvarref3):
+ CASE (Bvarref4):
+ CASE (Bvarref5):
op = op - Bvarref;
goto varref;
/* This seems to be the most frequently executed byte-code
among the Bvarref's, so avoid a goto here. */
- case Bvarref+6:
+ CASE (Bvarref6):
op = FETCH;
varref:
{
AFTER_POTENTIAL_GC ();
}
PUSH (v2);
- break;
+ NEXT;
}
- case Bgotoifnil:
+ CASE (Bgotoifnil):
{
Lisp_Object v1;
MAYBE_GC ();
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
- break;
+ NEXT;
}
- case Bcar:
+ CASE (Bcar):
{
Lisp_Object v1;
v1 = TOP;
wrong_type_argument (Qlistp, v1);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Beq:
+ CASE (Beq):
{
Lisp_Object v1;
v1 = POP;
TOP = EQ (v1, TOP) ? Qt : Qnil;
- break;
+ NEXT;
}
- case Bmemq:
+ CASE (Bmemq):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fmemq (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bcdr:
+ CASE (Bcdr):
{
Lisp_Object v1;
v1 = TOP;
wrong_type_argument (Qlistp, v1);
AFTER_POTENTIAL_GC ();
}
- break;
- break;
+ NEXT;
}
- case Bvarset:
- case Bvarset+1:
- case Bvarset+2:
- case Bvarset+3:
- case Bvarset+4:
- case Bvarset+5:
+ CASE (Bvarset):
+ CASE (Bvarset1):
+ CASE (Bvarset2):
+ CASE (Bvarset3):
+ CASE (Bvarset4):
+ CASE (Bvarset5):
op -= Bvarset;
goto varset;
- case Bvarset+7:
+ CASE (Bvarset7):
op = FETCH2;
goto varset;
- case Bvarset+6:
+ CASE (Bvarset6):
op = FETCH;
varset:
{
&& !EQ (val, Qunbound)
&& !XSYMBOL (sym)->redirect
&& !SYMBOL_CONSTANT_P (sym))
- XSYMBOL (sym)->val.value = val;
+ SET_SYMBOL_VAL (XSYMBOL (sym), val);
else
{
BEFORE_POTENTIAL_GC ();
}
}
(void) POP;
- break;
+ NEXT;
- case Bdup:
+ CASE (Bdup):
{
Lisp_Object v1;
v1 = TOP;
PUSH (v1);
- break;
+ NEXT;
}
/* ------------------ */
- case Bvarbind+6:
+ CASE (Bvarbind6):
op = FETCH;
goto varbind;
- case Bvarbind+7:
+ CASE (Bvarbind7):
op = FETCH2;
goto varbind;
- case Bvarbind:
- case Bvarbind+1:
- case Bvarbind+2:
- case Bvarbind+3:
- case Bvarbind+4:
- case Bvarbind+5:
+ CASE (Bvarbind):
+ CASE (Bvarbind1):
+ CASE (Bvarbind2):
+ CASE (Bvarbind3):
+ CASE (Bvarbind4):
+ CASE (Bvarbind5):
op -= Bvarbind;
varbind:
/* Specbind can signal and thus GC. */
BEFORE_POTENTIAL_GC ();
specbind (vectorp[op], POP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bcall+6:
+ CASE (Bcall6):
op = FETCH;
goto docall;
- case Bcall+7:
+ CASE (Bcall7):
op = FETCH2;
goto docall;
- case Bcall:
- case Bcall+1:
- case Bcall+2:
- case Bcall+3:
- case Bcall+4:
- case Bcall+5:
+ CASE (Bcall):
+ CASE (Bcall1):
+ CASE (Bcall2):
+ CASE (Bcall3):
+ CASE (Bcall4):
+ CASE (Bcall5):
op -= Bcall;
docall:
{
#endif
TOP = Ffuncall (op + 1, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bunbind+6:
+ CASE (Bunbind6):
op = FETCH;
goto dounbind;
- case Bunbind+7:
+ CASE (Bunbind7):
op = FETCH2;
goto dounbind;
- case Bunbind:
- case Bunbind+1:
- case Bunbind+2:
- case Bunbind+3:
- case Bunbind+4:
- case Bunbind+5:
+ CASE (Bunbind):
+ CASE (Bunbind1):
+ CASE (Bunbind2):
+ CASE (Bunbind3):
+ CASE (Bunbind4):
+ CASE (Bunbind5):
op -= Bunbind;
dounbind:
BEFORE_POTENTIAL_GC ();
unbind_to (SPECPDL_INDEX () - op, Qnil);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bunbind_all: /* Obsolete. Never used. */
+ CASE (Bunbind_all): /* Obsolete. Never used. */
/* To unbind back to the beginning of this frame. Not used yet,
but will be needed for tail-recursion elimination. */
BEFORE_POTENTIAL_GC ();
unbind_to (count, Qnil);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bgoto:
+ CASE (Bgoto):
MAYBE_GC ();
BYTE_CODE_QUIT;
op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
- break;
+ NEXT;
- case Bgotoifnonnil:
+ CASE (Bgotoifnonnil):
{
Lisp_Object v1;
MAYBE_GC ();
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
- break;
+ NEXT;
}
- case Bgotoifnilelsepop:
+ CASE (Bgotoifnilelsepop):
MAYBE_GC ();
op = FETCH2;
if (NILP (TOP))
stack.pc = stack.byte_string_start + op;
}
else DISCARD (1);
- break;
+ NEXT;
- case Bgotoifnonnilelsepop:
+ CASE (Bgotoifnonnilelsepop):
MAYBE_GC ();
op = FETCH2;
if (!NILP (TOP))
stack.pc = stack.byte_string_start + op;
}
else DISCARD (1);
- break;
+ NEXT;
- case BRgoto:
+ CASE (BRgoto):
MAYBE_GC ();
BYTE_CODE_QUIT;
stack.pc += (int) *stack.pc - 127;
- break;
+ NEXT;
- case BRgotoifnil:
+ CASE (BRgotoifnil):
{
Lisp_Object v1;
MAYBE_GC ();
stack.pc += (int) *stack.pc - 128;
}
stack.pc++;
- break;
+ NEXT;
}
- case BRgotoifnonnil:
+ CASE (BRgotoifnonnil):
{
Lisp_Object v1;
MAYBE_GC ();
stack.pc += (int) *stack.pc - 128;
}
stack.pc++;
- break;
+ NEXT;
}
- case BRgotoifnilelsepop:
+ CASE (BRgotoifnilelsepop):
MAYBE_GC ();
op = *stack.pc++;
if (NILP (TOP))
stack.pc += op - 128;
}
else DISCARD (1);
- break;
+ NEXT;
- case BRgotoifnonnilelsepop:
+ CASE (BRgotoifnonnilelsepop):
MAYBE_GC ();
op = *stack.pc++;
if (!NILP (TOP))
stack.pc += op - 128;
}
else DISCARD (1);
- break;
+ NEXT;
- case Breturn:
+ CASE (Breturn):
result = POP;
goto exit;
- case Bdiscard:
+ CASE (Bdiscard):
DISCARD (1);
- break;
+ NEXT;
- case Bconstant2:
+ CASE (Bconstant2):
PUSH (vectorp[FETCH2]);
- break;
+ NEXT;
- case Bsave_excursion:
+ CASE (Bsave_excursion):
record_unwind_protect (save_excursion_restore,
save_excursion_save ());
- break;
+ NEXT;
- case Bsave_current_buffer: /* Obsolete since ??. */
- case Bsave_current_buffer_1:
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
- break;
+ CASE (Bsave_current_buffer): /* Obsolete since ??. */
+ CASE (Bsave_current_buffer_1):
+ record_unwind_current_buffer ();
+ NEXT;
- case Bsave_window_excursion: /* Obsolete since 24.1. */
+ CASE (Bsave_window_excursion): /* Obsolete since 24.1. */
{
- register int count1 = SPECPDL_INDEX ();
+ register ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_protect (Fset_window_configuration,
Fcurrent_window_configuration (Qnil));
BEFORE_POTENTIAL_GC ();
TOP = Fprogn (TOP);
unbind_to (count1, TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsave_restriction:
+ CASE (Bsave_restriction):
record_unwind_protect (save_restriction_restore,
save_restriction_save ());
- break;
+ NEXT;
- case Bcatch: /* FIXME: ill-suited for lexbind. */
+ CASE (Bcatch): /* FIXME: ill-suited for lexbind. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = internal_catch (TOP, eval_sub, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bunwind_protect: /* FIXME: avoid closure for lexbind. */
+ CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */
record_unwind_protect (Fprogn, POP);
- break;
+ NEXT;
- case Bcondition_case: /* FIXME: ill-suited for lexbind. */
+ CASE (Bcondition_case): /* FIXME: ill-suited for lexbind. */
{
Lisp_Object handlers, body;
handlers = POP;
BEFORE_POTENTIAL_GC ();
TOP = internal_lisp_condition_case (TOP, body, handlers);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Btemp_output_buffer_setup: /* Obsolete since 24.1. */
+ CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1. */
BEFORE_POTENTIAL_GC ();
CHECK_STRING (TOP);
temp_output_buffer_setup (SSDATA (TOP));
AFTER_POTENTIAL_GC ();
TOP = Vstandard_output;
- break;
+ NEXT;
- case Btemp_output_buffer_show: /* Obsolete since 24.1. */
+ CASE (Btemp_output_buffer_show): /* Obsolete since 24.1. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
/* pop binding of standard-output */
unbind_to (SPECPDL_INDEX () - 1, Qnil);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bnth:
+ CASE (Bnth):
{
Lisp_Object v1, v2;
+ EMACS_INT n;
BEFORE_POTENTIAL_GC ();
v1 = POP;
v2 = TOP;
CHECK_NUMBER (v2);
- op = XINT (v2);
+ n = XINT (v2);
immediate_quit = 1;
- while (--op >= 0 && CONSP (v1))
+ while (--n >= 0 && CONSP (v1))
v1 = XCDR (v1);
immediate_quit = 0;
TOP = CAR (v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsymbolp:
+ CASE (Bsymbolp):
TOP = SYMBOLP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Bconsp:
+ CASE (Bconsp):
TOP = CONSP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Bstringp:
+ CASE (Bstringp):
TOP = STRINGP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Blistp:
+ CASE (Blistp):
TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Bnot:
+ CASE (Bnot):
TOP = NILP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
- case Bcons:
+ CASE (Bcons):
{
Lisp_Object v1;
v1 = POP;
TOP = Fcons (TOP, v1);
- break;
+ NEXT;
}
- case Blist1:
+ CASE (Blist1):
TOP = Fcons (TOP, Qnil);
- break;
+ NEXT;
- case Blist2:
+ CASE (Blist2):
{
Lisp_Object v1;
v1 = POP;
TOP = Fcons (TOP, Fcons (v1, Qnil));
- break;
+ NEXT;
}
- case Blist3:
+ CASE (Blist3):
DISCARD (2);
TOP = Flist (3, &TOP);
- break;
+ NEXT;
- case Blist4:
+ CASE (Blist4):
DISCARD (3);
TOP = Flist (4, &TOP);
- break;
+ NEXT;
- case BlistN:
+ CASE (BlistN):
op = FETCH;
DISCARD (op - 1);
TOP = Flist (op, &TOP);
- break;
+ NEXT;
- case Blength:
+ CASE (Blength):
BEFORE_POTENTIAL_GC ();
TOP = Flength (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Baref:
+ CASE (Baref):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Faref (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Baset:
+ CASE (Baset):
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
v2 = POP; v1 = POP;
TOP = Faset (TOP, v1, v2);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsymbol_value:
+ CASE (Bsymbol_value):
BEFORE_POTENTIAL_GC ();
TOP = Fsymbol_value (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bsymbol_function:
+ CASE (Bsymbol_function):
BEFORE_POTENTIAL_GC ();
TOP = Fsymbol_function (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bset:
+ CASE (Bset):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fset (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bfset:
+ CASE (Bfset):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Ffset (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bget:
+ CASE (Bget):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fget (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsubstring:
+ CASE (Bsubstring):
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
v2 = POP; v1 = POP;
TOP = Fsubstring (TOP, v1, v2);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bconcat2:
+ CASE (Bconcat2):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fconcat (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bconcat3:
+ CASE (Bconcat3):
BEFORE_POTENTIAL_GC ();
DISCARD (2);
TOP = Fconcat (3, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bconcat4:
+ CASE (Bconcat4):
BEFORE_POTENTIAL_GC ();
DISCARD (3);
TOP = Fconcat (4, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case BconcatN:
+ CASE (BconcatN):
op = FETCH;
BEFORE_POTENTIAL_GC ();
DISCARD (op - 1);
TOP = Fconcat (op, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bsub1:
+ CASE (Bsub1):
{
Lisp_Object v1;
v1 = TOP;
TOP = Fsub1 (v1);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Badd1:
+ CASE (Badd1):
{
Lisp_Object v1;
v1 = TOP;
TOP = Fadd1 (v1);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Beqlsign:
+ CASE (Beqlsign):
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
}
else
TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
- break;
+ NEXT;
}
- case Bgtr:
+ CASE (Bgtr):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fgtr (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Blss:
+ CASE (Blss):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Flss (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bleq:
+ CASE (Bleq):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fleq (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bgeq:
+ CASE (Bgeq):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fgeq (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bdiff:
+ CASE (Bdiff):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fminus (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bnegate:
+ CASE (Bnegate):
{
Lisp_Object v1;
v1 = TOP;
TOP = Fminus (1, &TOP);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Bplus:
+ CASE (Bplus):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fplus (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bmax:
+ CASE (Bmax):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fmax (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bmin:
+ CASE (Bmin):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fmin (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bmult:
+ CASE (Bmult):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Ftimes (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bquo:
+ CASE (Bquo):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fquo (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Brem:
+ CASE (Brem):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Frem (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bpoint:
+ CASE (Bpoint):
{
Lisp_Object v1;
XSETFASTINT (v1, PT);
PUSH (v1);
- break;
+ NEXT;
}
- case Bgoto_char:
+ CASE (Bgoto_char):
BEFORE_POTENTIAL_GC ();
TOP = Fgoto_char (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Binsert:
+ CASE (Binsert):
BEFORE_POTENTIAL_GC ();
TOP = Finsert (1, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case BinsertN:
+ CASE (BinsertN):
op = FETCH;
BEFORE_POTENTIAL_GC ();
DISCARD (op - 1);
TOP = Finsert (op, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bpoint_max:
+ CASE (Bpoint_max):
{
Lisp_Object v1;
XSETFASTINT (v1, ZV);
PUSH (v1);
- break;
+ NEXT;
}
- case Bpoint_min:
+ CASE (Bpoint_min):
{
Lisp_Object v1;
XSETFASTINT (v1, BEGV);
PUSH (v1);
- break;
+ NEXT;
}
- case Bchar_after:
+ CASE (Bchar_after):
BEFORE_POTENTIAL_GC ();
TOP = Fchar_after (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bfollowing_char:
+ CASE (Bfollowing_char):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = Ffollowing_char ();
AFTER_POTENTIAL_GC ();
PUSH (v1);
- break;
+ NEXT;
}
- case Bpreceding_char:
+ CASE (Bpreceding_char):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = Fprevious_char ();
AFTER_POTENTIAL_GC ();
PUSH (v1);
- break;
+ NEXT;
}
- case Bcurrent_column:
+ CASE (Bcurrent_column):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
XSETFASTINT (v1, current_column ());
AFTER_POTENTIAL_GC ();
PUSH (v1);
- break;
+ NEXT;
}
- case Bindent_to:
+ CASE (Bindent_to):
BEFORE_POTENTIAL_GC ();
TOP = Findent_to (TOP, Qnil);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Beolp:
+ CASE (Beolp):
PUSH (Feolp ());
- break;
+ NEXT;
- case Beobp:
+ CASE (Beobp):
PUSH (Feobp ());
- break;
+ NEXT;
- case Bbolp:
+ CASE (Bbolp):
PUSH (Fbolp ());
- break;
+ NEXT;
- case Bbobp:
+ CASE (Bbobp):
PUSH (Fbobp ());
- break;
+ NEXT;
- case Bcurrent_buffer:
+ CASE (Bcurrent_buffer):
PUSH (Fcurrent_buffer ());
- break;
+ NEXT;
- case Bset_buffer:
+ CASE (Bset_buffer):
BEFORE_POTENTIAL_GC ();
TOP = Fset_buffer (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Binteractive_p: /* Obsolete since 24.1. */
+ CASE (Binteractive_p): /* Obsolete since 24.1. */
PUSH (Finteractive_p ());
- break;
+ NEXT;
- case Bforward_char:
+ CASE (Bforward_char):
BEFORE_POTENTIAL_GC ();
TOP = Fforward_char (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bforward_word:
+ CASE (Bforward_word):
BEFORE_POTENTIAL_GC ();
TOP = Fforward_word (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bskip_chars_forward:
+ CASE (Bskip_chars_forward):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fskip_chars_forward (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bskip_chars_backward:
+ CASE (Bskip_chars_backward):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fskip_chars_backward (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bforward_line:
+ CASE (Bforward_line):
BEFORE_POTENTIAL_GC ();
TOP = Fforward_line (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bchar_syntax:
+ CASE (Bchar_syntax):
{
int c;
MAKE_CHAR_MULTIBYTE (c);
XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]);
}
- break;
+ NEXT;
- case Bbuffer_substring:
+ CASE (Bbuffer_substring):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fbuffer_substring (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bdelete_region:
+ CASE (Bdelete_region):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fdelete_region (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bnarrow_to_region:
+ CASE (Bnarrow_to_region):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fnarrow_to_region (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bwiden:
+ CASE (Bwiden):
BEFORE_POTENTIAL_GC ();
PUSH (Fwiden ());
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bend_of_line:
+ CASE (Bend_of_line):
BEFORE_POTENTIAL_GC ();
TOP = Fend_of_line (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bset_marker:
+ CASE (Bset_marker):
{
Lisp_Object v1, v2;
BEFORE_POTENTIAL_GC ();
v2 = POP;
TOP = Fset_marker (TOP, v2, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bmatch_beginning:
+ CASE (Bmatch_beginning):
BEFORE_POTENTIAL_GC ();
TOP = Fmatch_beginning (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bmatch_end:
+ CASE (Bmatch_end):
BEFORE_POTENTIAL_GC ();
TOP = Fmatch_end (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bupcase:
+ CASE (Bupcase):
BEFORE_POTENTIAL_GC ();
TOP = Fupcase (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bdowncase:
+ CASE (Bdowncase):
BEFORE_POTENTIAL_GC ();
TOP = Fdowncase (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bstringeqlsign:
+ CASE (Bstringeqlsign):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fstring_equal (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bstringlss:
+ CASE (Bstringlss):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fstring_lessp (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bequal:
+ CASE (Bequal):
{
Lisp_Object v1;
v1 = POP;
TOP = Fequal (TOP, v1);
- break;
+ NEXT;
}
- case Bnthcdr:
+ CASE (Bnthcdr):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fnthcdr (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Belt:
+ CASE (Belt):
{
Lisp_Object v1, v2;
if (CONSP (TOP))
{
/* Exchange args and then do nth. */
+ EMACS_INT n;
BEFORE_POTENTIAL_GC ();
v2 = POP;
v1 = TOP;
CHECK_NUMBER (v2);
AFTER_POTENTIAL_GC ();
- op = XINT (v2);
+ n = XINT (v2);
immediate_quit = 1;
- while (--op >= 0 && CONSP (v1))
+ while (--n >= 0 && CONSP (v1))
v1 = XCDR (v1);
immediate_quit = 0;
TOP = CAR (v1);
TOP = Felt (TOP, v1);
AFTER_POTENTIAL_GC ();
}
- break;
+ NEXT;
}
- case Bmember:
+ CASE (Bmember):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fmember (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bassq:
+ CASE (Bassq):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fassq (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bnreverse:
+ CASE (Bnreverse):
BEFORE_POTENTIAL_GC ();
TOP = Fnreverse (TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bsetcar:
+ CASE (Bsetcar):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fsetcar (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bsetcdr:
+ CASE (Bsetcdr):
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fsetcdr (TOP, v1);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
}
- case Bcar_safe:
+ CASE (Bcar_safe):
{
Lisp_Object v1;
v1 = TOP;
TOP = CAR_SAFE (v1);
- break;
+ NEXT;
}
- case Bcdr_safe:
+ CASE (Bcdr_safe):
{
Lisp_Object v1;
v1 = TOP;
TOP = CDR_SAFE (v1);
- break;
+ NEXT;
}
- case Bnconc:
+ CASE (Bnconc):
BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fnconc (2, &TOP);
AFTER_POTENTIAL_GC ();
- break;
+ NEXT;
- case Bnumberp:
+ CASE (Bnumberp):
TOP = (NUMBERP (TOP) ? Qt : Qnil);
- break;
+ NEXT;
- case Bintegerp:
+ CASE (Bintegerp):
TOP = INTEGERP (TOP) ? Qt : Qnil;
- break;
+ NEXT;
#ifdef BYTE_CODE_SAFE
+ /* These are intentionally written using 'case' syntax,
+ because they are incompatible with the threaded
+ interpreter. */
+
case Bset_mark:
BEFORE_POTENTIAL_GC ();
error ("set-mark is an obsolete bytecode");
break;
#endif
- case 0:
+ CASE_ABORT:
/* Actually this is Bstack_ref with offset 0, but we use Bdup
for that instead. */
- /* case Bstack_ref: */
- abort ();
+ /* CASE (Bstack_ref): */
+ error ("Invalid byte opcode");
/* Handy byte-codes for lexical binding. */
- case Bstack_ref+1:
- case Bstack_ref+2:
- case Bstack_ref+3:
- case Bstack_ref+4:
- case Bstack_ref+5:
+ CASE (Bstack_ref1):
+ CASE (Bstack_ref2):
+ CASE (Bstack_ref3):
+ CASE (Bstack_ref4):
+ CASE (Bstack_ref5):
{
Lisp_Object *ptr = top - (op - Bstack_ref);
PUSH (*ptr);
- break;
+ NEXT;
}
- case Bstack_ref+6:
+ CASE (Bstack_ref6):
{
Lisp_Object *ptr = top - (FETCH);
PUSH (*ptr);
- break;
+ NEXT;
}
- case Bstack_ref+7:
+ CASE (Bstack_ref7):
{
Lisp_Object *ptr = top - (FETCH2);
PUSH (*ptr);
- break;
+ NEXT;
}
- case Bstack_set:
+ CASE (Bstack_set):
/* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
{
Lisp_Object *ptr = top - (FETCH);
*ptr = POP;
- break;
+ NEXT;
}
- case Bstack_set2:
+ CASE (Bstack_set2):
{
Lisp_Object *ptr = top - (FETCH2);
*ptr = POP;
- break;
+ NEXT;
}
- case BdiscardN:
+ CASE (BdiscardN):
op = FETCH;
if (op & 0x80)
{
top[-op] = TOP;
}
DISCARD (op);
- break;
+ NEXT;
- case 255:
- default:
+ CASE_DEFAULT
+ CASE (Bconstant):
#ifdef BYTE_CODE_SAFE
if (op < Bconstant)
{
- abort ();
+ emacs_abort ();
}
if ((op -= Bconstant) >= const_length)
{
- abort ();
+ emacs_abort ();
}
PUSH (vectorp[op]);
#else
PUSH (vectorp[op - Bconstant]);
#endif
+ NEXT;
}
}
#ifdef BYTE_CODE_SAFE
error ("binding stack not balanced (serious byte compiler bug)");
#else
- abort ();
+ emacs_abort ();
#endif
return result;
{
int i = 256;
while (i--)
- XVECTOR (Vbyte_code_meter)->contents[i] =
- Fmake_vector (make_number (256), make_number (0));
+ ASET (Vbyte_code_meter, i,
+ Fmake_vector (make_number (256), make_number (0)));
}
#endif
}
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "commands.h"
#include "keyboard.h"
#include "window.h"
#include "keymap.h"
-#include "character.h"
Lisp_Object Qminus, Qplus;
Lisp_Object Qcall_interactively;
s -- Any string. Does not inherit the current input method.
S -- Any symbol.
U -- Mouse up event discarded by a previous k or K argument.
-v -- Variable name: symbol that is user-variable-p.
+v -- Variable name: symbol that is `custom-variable-p'.
x -- Lisp expression read but not evaluated.
X -- Lisp expression read and evaluated.
z -- Coding system.
= {"", "point", "mark", "region-beginning", "region-end"};
static void
-check_mark (int for_region)
+check_mark (bool for_region)
{
Lisp_Object tem;
tem = Fmarker_buffer (BVAR (current_buffer, mark));
if (CONSP (elt))
{
Lisp_Object presflag, carelt;
- carelt = Fcar (elt);
+ carelt = XCAR (elt);
/* If it is (if X Y), look at Y. */
if (EQ (carelt, Qif)
&& EQ (Fnthcdr (make_number (3), elt), Qnil))
Lisp_Object teml;
Lisp_Object up_event;
Lisp_Object enable;
- int speccount = SPECPDL_INDEX ();
+ ptrdiff_t speccount = SPECPDL_INDEX ();
/* The index of the next element of this_command_keys to examine for
the 'e' interactive code. */
- int next_event;
+ ptrdiff_t next_event;
Lisp_Object prefix_arg;
char *string;
signed char *varies;
ptrdiff_t i, nargs;
- int foo;
- int arg_from_tty = 0;
+ ptrdiff_t mark;
+ bool arg_from_tty = 0;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- int key_count;
- int record_then_fail = 0;
+ ptrdiff_t key_count;
+ bool record_then_fail = 0;
Lisp_Object save_this_command, save_last_command;
Lisp_Object save_this_original_command, save_real_this_command;
save_this_command = Vthis_command;
save_this_original_command = Vthis_original_command;
- save_real_this_command = real_this_command;
+ save_real_this_command = Vreal_this_command;
save_last_command = KVAR (current_kboard, Vlast_command);
if (NILP (keys))
key_count = ASIZE (keys);
}
- /* Save this now, since use of minibuffer will clobber it. */
+ /* Save this now, since use of minibuffer will clobber it. */
prefix_arg = Vcurrent_prefix_arg;
if (SYMBOLP (function))
The feature is not fully implemented. */
filter_specs = Qnil;
- /* If k or K discard an up-event, save it here so it can be retrieved with U */
+ /* If k or K discard an up-event, save it here so it can be retrieved with
+ U. */
up_event = Qnil;
/* Set SPECS to the interactive form, or barf if not interactive. */
{
/* Make a copy of string so that if a GC relocates specs,
`string' will still be valid. */
- string = (char *) alloca (SBYTES (specs) + 1);
+ string = alloca (SBYTES (specs) + 1);
memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
}
else
Vthis_command = save_this_command;
Vthis_original_command = save_this_original_command;
- real_this_command= save_real_this_command;
- KVAR (current_kboard, Vlast_command) = save_last_command;
+ Vreal_this_command = save_real_this_command;
+ kset_last_command (current_kboard, save_last_command);
temporarily_switch_to_single_kboard (NULL);
return unbind_to (speccount, apply1 (function, specs));
}
- /* Here if function specifies a string to control parsing the defaults */
+ /* Here if function specifies a string to control parsing the defaults. */
/* Set next_event to point to the first event with parameters. */
for (next_event = 0; next_event < key_count; next_event++)
}
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);
- args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
- visargs = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
- varies = (signed char *) alloca (nargs);
+ args = alloca (nargs * sizeof *args);
+ visargs = alloca (nargs * sizeof *visargs);
+ varies = alloca (nargs * sizeof *varies);
for (i = 0; i < nargs; i++)
{
case 'k': /* Key sequence. */
{
- int speccount1 = SPECPDL_INDEX ();
+ ptrdiff_t speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
/* Prompt in `minibuffer-prompt' face. */
Fput_text_property (make_number (0),
case 'K': /* Key sequence to be defined. */
{
- int speccount1 = SPECPDL_INDEX ();
+ ptrdiff_t speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
/* Prompt in `minibuffer-prompt' face. */
Fput_text_property (make_number (0),
goto have_prefix_arg;
case 'n': /* Read number from minibuffer. */
{
- int first = 1;
+ bool first = 1;
do
{
Lisp_Object str;
check_mark (1);
set_marker_both (point_marker, Qnil, PT, PT_BYTE);
/* visargs[i+1] = Qnil; */
- foo = marker_position (BVAR (current_buffer, mark));
+ mark = marker_position (BVAR (current_buffer, mark));
/* visargs[i] = Qnil; */
- args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
+ args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
varies[i] = 3;
- args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
+ args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
varies[i] = 4;
break;
break;
case 'v': /* Variable name: symbol that is
- user-variable-p. */
+ custom-variable-p. */
args[i] = Fread_variable (callint_message, Qnil);
visargs[i] = last_minibuf_string;
break;
Vthis_command = save_this_command;
Vthis_original_command = save_this_original_command;
- real_this_command= save_real_this_command;
- KVAR (current_kboard, Vlast_command) = save_last_command;
+ Vreal_this_command = save_real_this_command;
+ kset_last_command (current_kboard, save_last_command);
{
Lisp_Object val;
callint_message = Qnil;
staticpro (&callint_message);
- preserved_fns = pure_cons (intern_c_string ("region-beginning"),
- pure_cons (intern_c_string ("region-end"),
- pure_cons (intern_c_string ("point"),
- pure_cons (intern_c_string ("mark"), Qnil))));
+ preserved_fns = listn (CONSTYPE_PURE, 4,
+ intern_c_string ("region-beginning"),
+ intern_c_string ("region-end"),
+ intern_c_string ("point"),
+ intern_c_string ("mark"));
DEFSYM (Qlist, "list");
DEFSYM (Qlet, "let");
Vcommand_debug_status = Qnil;
DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
- doc: /* *Non-nil means you can use the mark even when inactive.
+ doc: /* Non-nil means you can use the mark even when inactive.
This option makes a difference in Transient Mark mode.
When the option is non-nil, deactivation of the mark
turns off region highlighting, but commands that use the mark
#include <config.h>
-#include <signal.h>
#include <errno.h>
#include <stdio.h>
-#include <setjmp.h>
#include <sys/types.h>
#include <unistd.h>
#endif /* MSDOS */
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "ccl.h"
#include "coding.h"
#include "composite.h"
#include "process.h"
#include "syssignal.h"
#include "systty.h"
+#include "syswait.h"
#include "blockinput.h"
#include "frame.h"
#include "termhooks.h"
#include "msdos.h"
#endif
-#ifndef USE_CRT_DLL
-extern char **environ;
+#ifdef HAVE_NS
+#include "nsterm.h"
#endif
#ifdef HAVE_SETPGID
/* True if we are about to fork off a synchronous process or if we
are waiting for it. */
-int synch_process_alive;
+bool synch_process_alive;
/* Nonzero => this is a string explaining death of synchronous subprocess. */
const char *synch_process_death;
On MSDOS, delete the temporary file on any kind of termination.
On Unix, kill the process and any children on termination by signal. */
-/* Nonzero if this is termination due to exit. */
-static int call_process_exited;
-
-static Lisp_Object Fgetenv_internal (Lisp_Object, Lisp_Object);
+/* True if this is termination due to exit. */
+static bool call_process_exited;
static Lisp_Object
call_process_kill (Lisp_Object fdpid)
{
- emacs_close (XFASTINT (Fcar (fdpid)));
- EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
+ int fd;
+ pid_t pid;
+ CONS_TO_INTEGER (Fcar (fdpid), int, fd);
+ CONS_TO_INTEGER (Fcdr (fdpid), pid_t, pid);
+ emacs_close (fd);
+ EMACS_KILLPG (pid, SIGKILL);
synch_process_alive = 0;
return Qnil;
}
call_process_cleanup (Lisp_Object arg)
{
Lisp_Object fdpid = Fcdr (arg);
+ int fd;
#if defined (MSDOS)
Lisp_Object file;
- int fd;
#else
- int pid;
+ pid_t pid;
#endif
Fset_buffer (Fcar (arg));
+ CONS_TO_INTEGER (Fcar (fdpid), int, fd);
#if defined (MSDOS)
/* for MSDOS fdpid is really (fd . tempfile) */
- fd = XFASTINT (Fcar (fdpid));
file = Fcdr (fdpid);
/* FD is -1 and FILE is "" when we didn't actually create a
temporary file in call-process. */
if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0'))
unlink (SDATA (file));
#else /* not MSDOS */
- pid = XFASTINT (Fcdr (fdpid));
+ CONS_TO_INTEGER (Fcdr (fdpid), pid_t, pid);
if (call_process_exited)
{
- emacs_close (XFASTINT (Fcar (fdpid)));
+ emacs_close (fd);
return Qnil;
}
if (EMACS_KILLPG (pid, SIGINT) == 0)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (call_process_kill, fdpid);
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
immediate_quit = 1;
message1 ("Waiting for process to die...done");
}
synch_process_alive = 0;
- emacs_close (XFASTINT (Fcar (fdpid)));
+ emacs_close (fd);
#endif /* not MSDOS */
return Qnil;
}
usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object infile, buffer, current_dir, path;
- volatile int display_p_volatile;
+ Lisp_Object infile, buffer, current_dir, path, cleanup_info_tail;
+ bool display_p;
int fd[2];
int filefd;
- register int pid;
#define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
#define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
char buf[CALLPROC_BUFFER_SIZE_MAX];
int bufsize = CALLPROC_BUFFER_SIZE_MIN;
- int count = SPECPDL_INDEX ();
- volatile USE_SAFE_ALLOCA;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ USE_SAFE_ALLOCA;
register const unsigned char **new_argv;
/* File to use for stderr in the child.
#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
char *outf, *tempfile = NULL;
int outfilefd;
+ int pid;
+#else
+ pid_t pid;
#endif
int fd_output = -1;
struct coding_system process_coding; /* coding-system of process output */
struct coding_system argument_coding; /* coding-system of arguments */
/* Set to the return value of Ffind_operation_coding_system. */
Lisp_Object coding_systems;
- int output_to_buffer = 1;
+ bool output_to_buffer = 1;
/* Qt denotes that Ffind_operation_coding_system is not yet called. */
coding_systems = Qt;
/* If arguments are supplied, we may have to encode them. */
if (nargs >= 5)
{
- int must_encode = 0;
+ bool must_encode = 0;
Lisp_Object coding_attrs;
for (i = 4; i < nargs; i++)
UNGCPRO;
}
- display_p_volatile = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
+ display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
if (filefd < 0)
&& 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;
register char **save_environ = environ;
register int fd1 = fd[1];
int fd_error = fd1;
-#ifdef HAVE_WORKING_VFORK
- sigset_t procmask;
- sigset_t blocked;
- struct sigaction sigpipe_action;
-#endif
if (fd_output >= 0)
fd1 = fd_output;
-#if 0 /* Some systems don't have sigblock. */
- mask = sigblock (sigmask (SIGCHLD));
-#endif
/* Record that we're about to create a synchronous process. */
synch_process_alive = 1;
0, current_dir);
#else /* not WINDOWSNT */
-#ifdef HAVE_WORKING_VFORK
- /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
- this sets the parent's signal handlers as well as the child's.
- So delay all interrupts whose handlers the child might munge,
- and record the current handlers so they can be restored later. */
- sigemptyset (&blocked);
- sigaddset (&blocked, SIGPIPE);
- sigaction (SIGPIPE, 0, &sigpipe_action);
- pthread_sigmask (SIG_BLOCK, &blocked, &procmask);
-#endif
-
- BLOCK_INPUT;
+ block_input ();
/* vfork, and prevent local vars from being clobbered by the vfork. */
{
Lisp_Object volatile buffer_volatile = buffer;
Lisp_Object volatile coding_systems_volatile = coding_systems;
Lisp_Object volatile current_dir_volatile = current_dir;
+ bool volatile display_p_volatile = display_p;
+ bool volatile output_to_buffer_volatile = output_to_buffer;
+ bool volatile sa_must_free_volatile = sa_must_free;
int volatile fd1_volatile = fd1;
int volatile fd_error_volatile = fd_error;
int volatile fd_output_volatile = fd_output;
- int volatile output_to_buffer_volatile = output_to_buffer;
+ ptrdiff_t volatile sa_count_volatile = sa_count;
unsigned char const **volatile new_argv_volatile = new_argv;
pid = vfork ();
buffer = buffer_volatile;
coding_systems = coding_systems_volatile;
current_dir = current_dir_volatile;
+ display_p = display_p_volatile;
fd1 = fd1_volatile;
fd_error = fd_error_volatile;
fd_output = fd_output_volatile;
output_to_buffer = output_to_buffer_volatile;
+ sa_must_free = sa_must_free_volatile;
+ sa_count = sa_count_volatile;
new_argv = new_argv_volatile;
}
setpgrp (pid, pid);
#endif /* USG */
- /* GConf causes us to ignore SIGPIPE, make sure it is restored
- in the child. */
+ /* Emacs ignores SIGPIPE, but the child should not. */
signal (SIGPIPE, SIG_DFL);
-#ifdef HAVE_WORKING_VFORK
- pthread_sigmask (SIG_SETMASK, &procmask, 0);
-#endif
child_setup (filefd, fd1, fd_error, (char **) new_argv,
0, current_dir);
}
- UNBLOCK_INPUT;
-
-#ifdef HAVE_WORKING_VFORK
- /* Restore the signal state. */
- sigaction (SIGPIPE, &sigpipe_action, 0);
- pthread_sigmask (SIG_SETMASK, &procmask, 0);
-#endif
+ unblock_input ();
#endif /* not WINDOWSNT */
#if defined (MSDOS)
/* MSDOS needs different cleanup information. */
- record_unwind_protect (call_process_cleanup,
- Fcons (Fcurrent_buffer (),
- Fcons (make_number (fd[0]),
- build_string (tempfile ? tempfile : ""))));
+ cleanup_info_tail = build_string (tempfile ? tempfile : "");
#else
+ cleanup_info_tail = INTEGER_TO_CONS (pid);
+#endif /* not MSDOS */
record_unwind_protect (call_process_cleanup,
Fcons (Fcurrent_buffer (),
- Fcons (make_number (fd[0]), make_number (pid))));
-#endif /* not MSDOS */
-
+ Fcons (INTEGER_TO_CONS (fd[0]),
+ cleanup_info_tail)));
if (BUFFERP (buffer))
Fset_buffer (buffer);
if (output_to_buffer)
{
- register EMACS_INT nread;
- int first = 1;
+ int nread;
+ bool first = 1;
EMACS_INT total_read = 0;
int carryover = 0;
- int display_p = display_p_volatile;
- int display_on_the_fly = display_p;
+ bool display_on_the_fly = display_p;
struct coding_system saved_coding;
saved_coding = process_coding;
else
{ /* We have to decode the input. */
Lisp_Object curbuf;
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
XSETBUFFER (curbuf, current_buffer);
/* We cannot allow after-change-functions be run
delete_temp_file (Lisp_Object name)
{
/* Suppress jka-compr handling, etc. */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (intern ("file-name-handler-alist"), Qnil);
internal_delete_file (name);
unbind_to (count, Qnil);
struct gcpro gcpro1;
Lisp_Object filename_string;
register Lisp_Object start, end;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
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;
{
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;
{
int fd;
- BLOCK_INPUT;
+ block_input ();
fd = mkstemp (tempfile);
- UNBLOCK_INPUT;
+ unblock_input ();
if (fd == -1)
report_file_error ("Failed to open temporary file",
- Fcons (Vtemp_file_name_pattern, Qnil));
+ Fcons (build_string (tempfile), Qnil));
else
close (fd);
}
val = complement_process_encoding_system (val);
{
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
specbind (intern ("coding-system-for-write"), val);
/* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
add_env (char **env, char **new_env, char *string)
{
char **ep;
- int ok = 1;
+ bool ok = 1;
if (string == NULL)
return new_env;
Therefore, the superior process must save and restore the value
of environ around the vfork and the call to this function.
- SET_PGRP is nonzero if we should put the subprocess into a separate
- process group.
+ If SET_PGRP, put the subprocess into a separate process group.
CURRENT_DIR is an elisp string giving the path of the current
directory the subprocess should have. Since we can't really signal
executable directory by the parent. */
int
-child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, Lisp_Object current_dir)
+child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
+ Lisp_Object current_dir)
{
char **env;
char *pwd_var;
HANDLE handles[3];
#endif /* WINDOWSNT */
- int pid = getpid ();
+ pid_t pid = getpid ();
/* Close Emacs's descriptors that this process should not have. */
close_process_descs ();
/* MSDOS must have all environment variables malloc'ed, because
low-level libc functions that launch subsidiary processes rely
on that. */
- pwd_var = (char *) xmalloc (i + 6);
+ pwd_var = xmalloc (i + 6);
#else
- pwd_var = (char *) alloca (i + 6);
+ pwd_var = alloca (i + 6);
#endif
temp = pwd_var + 4;
memcpy (pwd_var, "PWD=", 4);
}
/* new_length + 2 to include PWD and terminating 0. */
- env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
+ env = new_env = alloca ((new_length + 2) * sizeof *env);
/* If we have a PWD envvar, pass one down,
but with corrected value. */
if (egetenv ("PWD"))
if (STRINGP (display))
{
- char *vdata = (char *) alloca (sizeof "DISPLAY=" + SBYTES (display));
+ char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display));
strcpy (vdata, "DISPLAY=");
strcat (vdata, SSDATA (display));
new_env = add_env (env, new_env, vdata);
}
#endif /* not WINDOWSNT */
-static int
+static bool
getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
ptrdiff_t *valuelen, Lisp_Object env)
{
return 0;
}
-static int
+static bool
getenv_internal (const char *var, ptrdiff_t varlen, char **value,
ptrdiff_t *valuelen, Lisp_Object frame)
{
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
- : PATH_DATA));
- Vdoc_directory
- = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
- : PATH_DOC));
+ Vdata_directory = decode_env_path ("EMACSDATA",
+#ifdef HAVE_NS
+ etc_dir ? etc_dir :
+#endif
+ PATH_DATA);
+ Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
+
+ Vdoc_directory = decode_env_path ("EMACSDOC",
+#ifdef HAVE_NS
+ 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. */
- Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
+ Vexec_path = decode_env_path ("EMACSPATH",
+#ifdef HAVE_NS
+ path_exec ? path_exec :
+#endif
+ PATH_EXEC);
Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
+ /* FIXME? For ns, path_exec should go at the front? */
Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
}
register char * sh;
Lisp_Object tempdir;
+#ifdef HAVE_NS
+ if (data_dir == 0)
+ {
+ const char *etc_dir = ns_etc_directory ();
+ if (etc_dir)
+ {
+ data_dir = alloca (strlen (etc_dir) + 1);
+ strcpy (data_dir, etc_dir);
+ }
+ }
+#endif
if (!NILP (Vinstallation_directory))
{
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)))
{
- Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
+#ifdef HAVE_NS
+ const char *path_exec = ns_exec_path ();
+#endif
+ Vexec_path = decode_env_path ("EMACSPATH",
+#ifdef HAVE_NS
+ path_exec ? path_exec :
+#endif
+ PATH_EXEC);
Vexec_path = Fcons (tem, Vexec_path);
Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
}
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)
staticpro (&Vtemp_file_name_pattern);
DEFVAR_LISP ("shell-file-name", Vshell_file_name,
- doc: /* *File name to load inferior shells from.
+ doc: /* File name to load inferior shells from.
Initialized from the SHELL environment variable, or to a system-dependent
default if SHELL is not set. */);
DEFVAR_LISP ("exec-path", Vexec_path,
- doc: /* *List of directories to search programs to run in subprocesses.
+ doc: /* List of directories to search programs to run in subprocesses.
Each element is a string (directory name) or nil (try default directory). */);
DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
- doc: /* *List of suffixes to try to find executable file names.
+ doc: /* List of suffixes to try to find executable file names.
Each element is a string. */);
Vexec_suffixes = Qnil;
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "commands.h"
#include "syntax.h"
#include "composite.h"
static Lisp_Object
casify_object (enum case_action flag, Lisp_Object obj)
{
- register int c, c1;
- register int inword = flag == CASE_DOWN;
+ int c, c1;
+ bool inword = flag == CASE_DOWN;
/* If the case table is flagged as modified, rescan it. */
if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1]))
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META);
int flags = XINT (obj) & flagbits;
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool multibyte = ! NILP (BVAR (current_buffer,
+ enable_multibyte_characters));
/* If the character has higher bits set
above the flags, return it unchanged.
wrong_type_argument (Qchar_or_string_p, obj);
else if (!STRING_MULTIBYTE (obj))
{
- EMACS_INT i;
- EMACS_INT size = SCHARS (obj);
+ ptrdiff_t i;
+ ptrdiff_t size = SCHARS (obj);
obj = Fcopy_sequence (obj);
for (i = 0; i < size; i++)
}
else
{
- EMACS_INT i, i_byte, size = SCHARS (obj);
+ ptrdiff_t i, i_byte, size = SCHARS (obj);
int len;
USE_SAFE_ALLOCA;
- unsigned char *dst, *o;
- /* Over-allocate by 12%: this is a minor overhead, but should be
- sufficient in 99.999% of the cases to avoid a reallocation. */
- EMACS_INT o_size = SBYTES (obj) + SBYTES (obj) / 8 + MAX_MULTIBYTE_LENGTH;
- SAFE_ALLOCA (dst, void *, o_size);
- o = dst;
+ ptrdiff_t o_size = (size < STRING_BYTES_BOUND / MAX_MULTIBYTE_LENGTH
+ ? size * MAX_MULTIBYTE_LENGTH
+ : STRING_BYTES_BOUND);
+ unsigned char *dst = SAFE_ALLOCA (o_size);
+ unsigned char *o = dst;
for (i = i_byte = 0; i < size; i++, i_byte += len)
{
- if ((o - dst) + MAX_MULTIBYTE_LENGTH > o_size)
- { /* Not enough space for the next char: grow the destination. */
- unsigned char *old_dst = dst;
- o_size += o_size; /* Probably overkill, but extremely rare. */
- SAFE_ALLOCA (dst, void *, o_size);
- memcpy (dst, old_dst, o - old_dst);
- o = dst + (o - old_dst);
- }
+ if (o_size - (o - dst) < MAX_MULTIBYTE_LENGTH)
+ string_overflow ();
c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, len);
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
static void
casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
{
- register int c;
- register int inword = flag == CASE_DOWN;
- register int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
- EMACS_INT start, end;
- EMACS_INT start_byte;
+ int c;
+ bool inword = flag == CASE_DOWN;
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t start, end;
+ ptrdiff_t start_byte;
/* Position of first and last changes. */
- EMACS_INT first = -1, last IF_LINT (= 0);
+ ptrdiff_t first = -1, last IF_LINT (= 0);
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
if (EQ (b, e))
/* Not modifying because nothing marked */
}
\f
static Lisp_Object
-operate_on_word (Lisp_Object arg, EMACS_INT *newpoint)
+operate_on_word (Lisp_Object arg, ptrdiff_t *newpoint)
{
Lisp_Object val;
- EMACS_INT farend;
+ ptrdiff_t farend;
EMACS_INT iarg;
CHECK_NUMBER (arg);
(Lisp_Object arg)
{
Lisp_Object beg, end;
- EMACS_INT newpoint;
+ ptrdiff_t newpoint;
XSETFASTINT (beg, PT);
end = operate_on_word (arg, &newpoint);
casify_region (CASE_UP, beg, end);
(Lisp_Object arg)
{
Lisp_Object beg, end;
- EMACS_INT newpoint;
+ ptrdiff_t newpoint;
XSETFASTINT (beg, PT);
end = operate_on_word (arg, &newpoint);
casify_region (CASE_DOWN, beg, end);
(Lisp_Object arg)
{
Lisp_Object beg, end;
- EMACS_INT newpoint;
+ ptrdiff_t newpoint;
XSETFASTINT (beg, PT);
end = operate_on_word (arg, &newpoint);
casify_region (CASE_CAPITALIZE, beg, end);
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
static Lisp_Object Qcase_table_p, Qcase_table;
Lisp_Object Vascii_downcase_table;
return Vascii_downcase_table;
}
-static Lisp_Object set_case_table (Lisp_Object table, int standard);
+static Lisp_Object set_case_table (Lisp_Object, bool);
DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0,
doc: /* Select a new case table for the current buffer.
}
static Lisp_Object
-set_case_table (Lisp_Object table, int standard)
+set_case_table (Lisp_Object table, bool standard)
{
Lisp_Object up, canon, eqv;
up = Fmake_char_table (Qcase_table, Qnil);
map_char_table (set_identity, Qnil, table, up);
map_char_table (shuffle, Qnil, table, up);
- XCHAR_TABLE (table)->extras[0] = up;
+ set_char_table_extras (table, 0, up);
}
if (NILP (canon))
{
canon = Fmake_char_table (Qcase_table, Qnil);
- XCHAR_TABLE (table)->extras[1] = canon;
+ set_char_table_extras (table, 1, canon);
map_char_table (set_canon, Qnil, table, table);
}
eqv = Fmake_char_table (Qcase_table, Qnil);
map_char_table (set_identity, Qnil, canon, eqv);
map_char_table (shuffle, Qnil, canon, eqv);
- XCHAR_TABLE (table)->extras[2] = eqv;
+ set_char_table_extras (table, 2, eqv);
}
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
- XCHAR_TABLE (canon)->extras[2] = eqv;
+ set_char_table_extras (canon, 2, eqv);
if (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_downcase_table (current_buffer, table);
+ bset_upcase_table (current_buffer, up);
+ bset_case_canon_table (current_buffer, canon);
+ bset_case_eqv_table (current_buffer, eqv);
}
return table;
{
if (NATNUMP (elt))
{
- int from;
- unsigned to;
+ int from, to;
if (CONSP (c))
{
}
else
from = to = XINT (c);
- for (to++; from < to; from++)
+
+ to++;
+ lint_assume (to <= MAX_CHAR + 1);
+ for (; from < to; from++)
CHAR_TABLE_SET (table, from, make_number (from));
}
}
{
if (NATNUMP (elt))
{
- int from;
- unsigned to;
+ int from, to;
if (CONSP (c))
{
else
from = to = XINT (c);
- for (to++; from < to; from++)
+ to++;
+ lint_assume (to <= MAX_CHAR + 1);
+ for (; from < to; from++)
{
Lisp_Object tem = Faref (table, elt);
Faset (table, elt, make_number (from));
down = Fmake_char_table (Qcase_table, Qnil);
Vascii_downcase_table = down;
- XCHAR_TABLE (down)->purpose = Qcase_table;
+ set_char_table_purpose (down, Qcase_table);
for (i = 0; i < 128; i++)
{
CHAR_TABLE_SET (down, i, make_number (c));
}
- XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down);
+ set_char_table_extras (down, 1, Fcopy_sequence (down));
up = Fmake_char_table (Qcase_table, Qnil);
- XCHAR_TABLE (down)->extras[0] = up;
+ set_char_table_extras (down, 0, up);
for (i = 0; i < 128; i++)
{
CHAR_TABLE_SET (up, i, make_number (c));
}
- XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up);
+ set_char_table_extras (down, 2, Fcopy_sequence (up));
/* Fill in what isn't filled in. */
set_case_table (down, 1);
table. Read comments in the file category.h to understand them. */
#include <config.h>
-#include <ctype.h>
-#include <setjmp.h>
+
+#define CATEGORY_INLINE EXTERN_INLINE
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "category.h"
#include "keymap.h"
+/* This setter is used only in this file, so it can be private. */
+static inline void
+bset_category_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (category_table) = val;
+}
+
/* The version number of the latest category table. Each category
table has a unique version number. It is assigned a new number
also when it is modified. When a regular expression is compiled
static Lisp_Object Qcategory_table, Qcategoryp, Qcategorysetp, Qcategory_table_p;
-/* Temporary internal variable used in macro CHAR_HAS_CATEGORY. */
-Lisp_Object _temp_category_set;
-
/* Make CATEGORY_SET includes (if VAL is t) or excludes (if VAL is
nil) CATEGORY. */
#define SET_CATEGORY_SET(category_set, category, val) \
EMACS_UINT hash;
if (NILP (XCHAR_TABLE (table)->extras[1]))
- XCHAR_TABLE (table)->extras[1]
- = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
- make_float (DEFAULT_REHASH_SIZE),
- make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil, Qnil, Qnil);
+ set_char_table_extras
+ (table, 1,
+ make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil, Qnil, Qnil));
h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
i = hash_lookup (h, category_set, &hash);
if (i >= 0)
error ("Category `%c' is already defined", (int) XFASTINT (category));
if (!NILP (Vpurify_flag))
docstring = Fpurecopy (docstring);
- CATEGORY_DOCSTRING (table, XFASTINT (category)) = docstring;
+ SET_CATEGORY_DOCSTRING (table, XFASTINT (category), docstring);
return Qnil;
}
table = copy_char_table (table);
if (! NILP (XCHAR_TABLE (table)->defalt))
- XCHAR_TABLE (table)->defalt
- = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
- XCHAR_TABLE (table)->extras[0]
- = Fcopy_sequence (XCHAR_TABLE (table)->extras[0]);
+ set_char_table_defalt (table,
+ Fcopy_sequence (XCHAR_TABLE (table)->defalt));
+ set_char_table_extras
+ (table, 0, Fcopy_sequence (XCHAR_TABLE (table)->extras[0]));
map_char_table (copy_category_entry, Qnil, table, table);
return table;
int i;
val = Fmake_char_table (Qcategory_table, Qnil);
- XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET;
+ set_char_table_defalt (val, MAKE_CATEGORY_SET);
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
- XCHAR_TABLE (val)->contents[i] = MAKE_CATEGORY_SET;
+ set_char_table_contents (val, i, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (val, make_number (0),
Fmake_vector (make_number (95), Qnil));
return val;
{
int idx;
table = check_category_table (table);
- BVAR (current_buffer, category_table) = table;
+ bset_category_table (current_buffer, 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);
usage: (char-category-set CHAR) */)
(Lisp_Object ch)
{
- CHECK_NUMBER (ch);
+ CHECK_CHARACTER (ch);
return CATEGORY_SET (XFASTINT (ch));
}
return Qnil;
}
\f
-/* Return 1 if there is a word boundary between two word-constituent
- characters C1 and C2 if they appear in this order, else return 0.
+/* Return true if there is a word boundary between two word-constituent
+ characters C1 and C2 if they appear in this order.
Use the macro WORD_BOUNDARY_P instead of calling this function
directly. */
-int
+bool
word_boundary_p (int c1, int c2)
{
Lisp_Object category_set1, category_set2;
Lisp_Object tail;
- int default_result;
+ bool default_result;
if (EQ (CHAR_TABLE_REF (Vchar_script_table, c1),
CHAR_TABLE_REF (Vchar_script_table, c2)))
Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
/* Set a category set which contains nothing to the default. */
- XCHAR_TABLE (Vstandard_category_table)->defalt = MAKE_CATEGORY_SET;
+ set_char_table_defalt (Vstandard_category_table, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),
Fmake_vector (make_number (95), Qnil));
}
/* Declarations having to do with Emacs category tables.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
Copyright (C) 2003
The second extra slot is a version number of the category table.
But, for the moment, we are not using this slot. */
-#define CATEGORYP(x) \
- (INTEGERP ((x)) && XFASTINT ((x)) >= 0x20 && XFASTINT ((x)) <= 0x7E)
+INLINE_HEADER_BEGIN
+#ifndef CATEGORY_INLINE
+# define CATEGORY_INLINE INLINE
+#endif
+
+#define CATEGORYP(x) RANGED_INTEGERP (0x20, x, 0x7E)
#define CHECK_CATEGORY(x) \
CHECK_TYPE (CATEGORYP (x), Qcategoryp, x)
#define CHECK_CATEGORY_SET(x) \
CHECK_TYPE (CATEGORY_SET_P (x), Qcategorysetp, x)
-/* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
+/* Return the category set of character C in the current category table. */
+#define CATEGORY_SET(c) char_category_set (c)
+
+/* Return true if CATEGORY_SET contains CATEGORY.
The faster version of `!NILP (Faref (category_set, category))'. */
#define CATEGORY_MEMBER(category, category_set) \
- (XCATEGORY_SET (category_set)->data[(category) / 8] \
- & (1 << ((category) % 8)))
-
-/* Temporary internal variable used in macro CHAR_HAS_CATEGORY. */
-extern Lisp_Object _temp_category_set;
+ ((XCATEGORY_SET (category_set)->data[(category) / 8] \
+ >> ((category) % 8)) & 1)
-/* Return 1 if category set of CH contains CATEGORY, elt return 0. */
-#define CHAR_HAS_CATEGORY(ch, category) \
- (_temp_category_set = CATEGORY_SET (ch), \
- CATEGORY_MEMBER (category, _temp_category_set))
+/* Return true if category set of CH contains CATEGORY. */
+CATEGORY_INLINE bool
+CHAR_HAS_CATEGORY (int ch, int category)
+{
+ Lisp_Object category_set = CATEGORY_SET (ch);
+ return CATEGORY_MEMBER (category, category_set);
+}
/* The standard category table is stored where it will automatically
be used in all new buffers. */
#define Vstandard_category_table BVAR (&buffer_defaults, category_table)
-/* Return the category set of character C in the current category table. */
-#define CATEGORY_SET(c) char_category_set (c)
-
/* Return the doc string of CATEGORY in category table TABLE. */
-#define CATEGORY_DOCSTRING(table, category) \
- XVECTOR (Fchar_table_extra_slot (table, make_number (0)))->contents[(category) - ' ']
+#define CATEGORY_DOCSTRING(table, category) \
+ AREF (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' '))
+
+/* Set the doc string of CATEGORY to VALUE in category table TABLE. */
+#define SET_CATEGORY_DOCSTRING(table, category, value) \
+ ASET (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' '), value)
/* Return the version number of category table TABLE. Not used for
the moment. */
#define CATEGORY_TABLE_VERSION (table) \
Fchar_table_extra_slot (table, make_number (1))
-/* Return 1 if there is a word boundary between two word-constituent
- characters C1 and C2 if they appear in this order, else return 0.
+/* Return true if there is a word boundary between two
+ word-constituent characters C1 and C2 if they appear in this order.
There is no word boundary between two word-constituent ASCII and
Latin-1 characters. */
#define WORD_BOUNDARY_P(c1, c2) \
(!(SINGLE_BYTE_CHAR_P (c1) && SINGLE_BYTE_CHAR_P (c2)) \
&& word_boundary_p (c1, c2))
-extern int word_boundary_p (int, int);
+extern bool word_boundary_p (int, int);
+
+INLINE_HEADER_END
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <limits.h>
#include "lisp.h"
/* Return a hash table of id number ID. */
#define GET_HASH_TABLE(id) \
- (XHASH_TABLE (XCDR (XVECTOR (Vtranslation_hash_table_vector)->contents[(id)])))
+ (XHASH_TABLE (XCDR (AREF (Vtranslation_hash_table_vector, (id)))))
/* CCL (Code Conversion Language) is a simple language which has
operations on one input buffer, one output buffer, and 7 registers.
#define GET_CCL_CODE(code, ccl_prog, ic) \
GET_CCL_RANGE (code, ccl_prog, ic, CCL_CODE_MIN, CCL_CODE_MAX)
-#define GET_CCL_INT(var, ccl_prog, ic) \
- GET_CCL_RANGE (var, ccl_prog, ic, INT_MIN, INT_MAX)
-
#define IN_INT_RANGE(val) ASCENDING_ORDER (INT_MIN, val, INT_MAX)
/* Encode one character CH to multibyte form and write to the current
break;
case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
- GET_CCL_INT (reg[rrr], ccl_prog, ic++);
+ reg[rrr] = XINT (ccl_prog[ic++]);
break;
case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
i = reg[RRR];
j = field1 >> 3;
if (0 <= i && i < j)
- GET_CCL_INT (reg[rrr], ccl_prog, ic + i);
+ reg[rrr] = XINT (ccl_prog[ic + i]);
ic += j;
break;
break;
case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
- GET_CCL_INT (i, ccl_prog, ic);
+ i = XINT (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic += ADDR;
break;
case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
- GET_CCL_INT (i, ccl_prog, ic);
+ i = XINT (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic++;
CCL_READ_CHAR (reg[rrr]);
break;
case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
- GET_CCL_INT (j, ccl_prog, ic++);
+ j = XINT (ccl_prog[ic++]);
CCL_WRITE_STRING (j);
ic += ADDR - 1;
break;
case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
- GET_CCL_INT (j, ccl_prog, ic);
+ j = XINT (ccl_prog[ic]);
if (0 <= i && i < j)
{
- GET_CCL_INT (i, ccl_prog, ic + 1 + i);
+ i = XINT (ccl_prog[ic + 1 + i]);
CCL_WRITE_CHAR (i);
}
ic += j + 2;
/* fall through ... */
case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
{
- int incr;
- GET_CCL_INT (incr, ccl_prog,
- ic + (0 <= reg[rrr] && reg[rrr] < field1
- ? reg[rrr]
- : field1));
+ int ioff = 0 <= reg[rrr] && reg[rrr] < field1 ? reg[rrr] : field1;
+ int incr = XINT (ccl_prog[ic + ioff]);
ic += incr;
}
break;
case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
rrr = 7;
i = reg[RRR];
- GET_CCL_INT (j, ccl_prog, ic);
+ j = XINT (ccl_prog[ic]);
op = field1 >> 6;
jump_address = ic + 1;
goto ccl_set_expr;
/* If FFF is nonzero, the CCL program ID is in the
following code. */
if (rrr)
- GET_CCL_INT (prog_id, ccl_prog, ic++);
+ prog_id = XINT (ccl_prog[ic++]);
else
prog_id = field1;
i = reg[rrr];
if (0 <= i && i < field1)
{
- GET_CCL_INT (j, ccl_prog, ic + i);
+ j = XINT (ccl_prog[ic + i]);
CCL_WRITE_CHAR (j);
}
ic += field1;
CCL_SUCCESS;
case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
- GET_CCL_INT (i, ccl_prog, ic++);
+ i = XINT (ccl_prog[ic++]);
op = field1 >> 6;
goto ccl_expr_self;
case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
i = reg[RRR];
- GET_CCL_INT (j, ccl_prog, ic++);
+ j = XINT (ccl_prog[ic++]);
op = field1 >> 6;
jump_address = ic;
goto ccl_set_expr;
case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
jump_address = ic + ADDR;
- GET_CCL_INT (op, ccl_prog, ic++);
- GET_CCL_INT (j, ccl_prog, ic++);
+ op = XINT (ccl_prog[ic++]);
+ j = XINT (ccl_prog[ic++]);
rrr = 7;
goto ccl_set_expr;
case CCL_JumpCondExprReg:
i = reg[rrr];
jump_address = ic + ADDR;
- GET_CCL_INT (op, ccl_prog, ic++);
+ op = XINT (ccl_prog[ic++]);
GET_CCL_RANGE (j, ccl_prog, ic++, 0, 7);
j = reg[j];
rrr = 7;
case CCL_TranslateCharacterConstTbl:
{
- EMACS_INT eop;
+ ptrdiff_t eop;
GET_CCL_RANGE (eop, ccl_prog, ic++, 0,
(VECTORP (Vtranslation_table_vector)
? ASIZE (Vtranslation_table_vector)
case CCL_IterateMultipleMap:
{
Lisp_Object map, content, attrib, value;
- EMACS_INT point, size;
+ EMACS_INT point;
+ ptrdiff_t size;
int fin_ic;
- GET_CCL_INT (j, ccl_prog, ic++); /* number of maps. */
+ j = XINT (ccl_prog[ic++]); /* number of maps. */
fin_ic = ic + j;
op = reg[rrr];
if ((j > reg[RRR]) && (j >= 0))
for (;i < j;i++)
{
-
+ if (!VECTORP (Vcode_conversion_map_vector)) continue;
size = ASIZE (Vcode_conversion_map_vector);
point = XINT (ccl_prog[ic++]);
if (! (0 <= point && point < size)) continue;
case CCL_MapMultiple:
{
Lisp_Object map, content, attrib, value;
- int point, size, map_vector_size;
+ EMACS_INT point;
+ ptrdiff_t size, map_vector_size;
int map_set_rest_length, fin_ic;
int current_ic = this_ic;
stack_idx_of_map_multiple = 0;
/* Get number of maps and separators. */
- GET_CCL_INT (map_set_rest_length, ccl_prog, ic++);
+ map_set_rest_length = XINT (ccl_prog[ic++]);
fin_ic = ic + map_set_rest_length;
op = reg[rrr];
break;
}
}
+ if (!VECTORP (Vcode_conversion_map_vector))
+ CCL_INVALID_CMD;
map_vector_size = ASIZE (Vcode_conversion_map_vector);
do {
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
{
- GET_CCL_INT (point, ccl_prog, ic);
+ point = XINT (ccl_prog[ic]);
if (point < 0)
{
/* +1 is for including separator. */
int point;
j = XINT (ccl_prog[ic++]); /* map_id */
op = reg[rrr];
- if (j >= ASIZE (Vcode_conversion_map_vector))
+ if (! (VECTORP (Vcode_conversion_map_vector)
+ && j < ASIZE (Vcode_conversion_map_vector)))
{
reg[RRR] = -1;
break;
}
map = XCDR (map);
if (! (VECTORP (map)
+ && 0 < ASIZE (map)
&& INTEGERP (AREF (map, 0))
&& XINT (AREF (map, 0)) <= op
&& op - XINT (AREF (map, 0)) + 1 < ASIZE (map)))
reg[RRR] = -1;
break;
}
- point = XINT (AREF (map, 0));
- point = op - point + 1;
+ point = op - XINT (AREF (map, 0)) + 1;
reg[RRR] = 0;
content = AREF (map, point);
if (NILP (content))
reg[RRR] = -1;
- else if (INTEGERP (content))
+ else if (TYPE_RANGED_INTEGERP (int, content))
reg[rrr] = XINT (content);
else if (EQ (content, Qt));
else if (CONSP (content))
{
attrib = XCAR (content);
value = XCDR (content);
- if (!INTEGERP (attrib) || !INTEGERP (value))
+ if (!INTEGERP (attrib)
+ || !TYPE_RANGED_INTEGERP (int, value))
continue;
reg[rrr] = XINT (value);
break;
switch (ccl->status)
{
case CCL_STAT_INVALID_CMD:
- sprintf (msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
- code & 0x1F, code, this_ic);
+ msglen = sprintf (msg,
+ "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
+ code & 0x1F, code, this_ic);
#ifdef CCL_DEBUG
{
int i = ccl_backtrace_idx - 1;
int j;
- msglen = strlen (msg);
if (dst + msglen <= (dst_bytes ? dst_end : src))
{
memcpy (dst, msg, msglen);
if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
if (ccl_backtrace_table[i] == 0)
break;
- sprintf (msg, " %d", ccl_backtrace_table[i]);
- msglen = strlen (msg);
+ msglen = sprintf (msg, " %d", ccl_backtrace_table[i]);
if (dst + msglen > (dst_bytes ? dst_end : src))
break;
memcpy (dst, msg, msglen);
break;
case CCL_STAT_QUIT:
- if (! ccl->quit_silently)
- sprintf (msg, "\nCCL: Quitted.");
+ msglen = ccl->quit_silently ? 0 : sprintf (msg, "\nCCL: Quitted.");
break;
default:
- sprintf (msg, "\nCCL: Unknown error type (%d)", ccl->status);
+ msglen = sprintf (msg, "\nCCL: Unknown error type (%d)", ccl->status);
}
- msglen = strlen (msg);
if (msglen <= dst_end - dst)
{
for (i = 0; i < msglen; i++)
function converts symbols of code conversion maps and character
translation tables embedded in the CCL code into their ID numbers.
- The return value is a vector (CCL itself or a new vector in which
- all symbols are resolved), Qt if resolving of some symbol failed,
+ The return value is a new vector in which all symbols are resolved,
+ Qt if resolving of some symbol failed,
or nil if CCL contains invalid data. */
static Lisp_Object
int i, veclen, unresolved = 0;
Lisp_Object result, contents, val;
- result = ccl;
+ if (! (CCL_HEADER_MAIN < ASIZE (ccl) && ASIZE (ccl) <= INT_MAX))
+ return Qnil;
+ result = Fcopy_sequence (ccl);
veclen = ASIZE (result);
for (i = 0; i < veclen; i++)
{
contents = AREF (result, i);
- if (INTEGERP (contents))
+ if (TYPE_RANGED_INTEGERP (int, contents))
continue;
else if (CONSP (contents)
&& SYMBOLP (XCAR (contents))
/* This is the new style for embedding symbols. The form is
(SYMBOL . PROPERTY). (get SYMBOL PROPERTY) should give
an index number. */
-
- if (EQ (result, ccl))
- result = Fcopy_sequence (ccl);
-
val = Fget (XCAR (contents), XCDR (contents));
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
unresolved = 1;
/* This is the old style for embedding symbols. This style
may lead to a bug if, for instance, a translation table
and a code conversion map have the same name. */
- if (EQ (result, ccl))
- result = Fcopy_sequence (ccl);
-
val = Fget (contents, Qtranslation_table_id);
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
{
val = Fget (contents, Qcode_conversion_map_id);
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
{
val = Fget (contents, Qccl_program_idx);
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
unresolved = 1;
return Qnil;
}
+ if (! (0 <= XINT (AREF (result, CCL_HEADER_BUF_MAG))
+ && ASCENDING_ORDER (0, XINT (AREF (result, CCL_HEADER_EOF)),
+ ASIZE (ccl))))
+ return Qnil;
+
return (unresolved ? Qt : result);
}
symbols, return Qnil. */
static Lisp_Object
-ccl_get_compiled_code (Lisp_Object ccl_prog, int *idx)
+ccl_get_compiled_code (Lisp_Object ccl_prog, ptrdiff_t *idx)
{
Lisp_Object val, slot;
error ("Length of vector REGISTERS is not 8");
for (i = 0; i < 8; i++)
- ccl.reg[i] = (INTEGERP (AREF (reg, i))
+ ccl.reg[i] = (TYPE_RANGED_INTEGERP (int, AREF (reg, i))
? XINT (AREF (reg, i))
: 0);
{
if (NILP (AREF (status, i)))
ASET (status, i, make_number (0));
- if (INTEGERP (AREF (status, i)))
+ if (TYPE_RANGED_INTEGERP (int, AREF (status, i)))
ccl.reg[i] = XINT (AREF (status, i));
}
if (INTEGERP (AREF (status, i)))
outbufsize = (ccl.buf_magnification
? str_bytes * ccl.buf_magnification + 256
: str_bytes + 256);
- outp = outbuf = (unsigned char *) xmalloc (outbufsize);
+ outp = outbuf = xmalloc (outbufsize);
consumed_chars = consumed_bytes = 0;
produced_chars = 0;
Return index number of the registered CCL program. */)
(Lisp_Object name, Lisp_Object ccl_prog)
{
- int len = ASIZE (Vccl_program_table);
- int idx;
+ ptrdiff_t len = ASIZE (Vccl_program_table);
+ ptrdiff_t idx;
Lisp_Object resolved;
CHECK_SYMBOL (name);
if (idx == len)
/* Extend the table. */
- Vccl_program_table = larger_vector (Vccl_program_table, len * 2, Qnil);
+ Vccl_program_table = larger_vector (Vccl_program_table, 1, -1);
{
Lisp_Object elt;
Return index number of the registered map. */)
(Lisp_Object symbol, Lisp_Object map)
{
- int len = ASIZE (Vcode_conversion_map_vector);
- int i;
+ ptrdiff_t len;
+ ptrdiff_t i;
Lisp_Object idx;
CHECK_SYMBOL (symbol);
CHECK_VECTOR (map);
+ if (! VECTORP (Vcode_conversion_map_vector))
+ error ("Invalid code-conversion-map-vector");
+
+ len = ASIZE (Vcode_conversion_map_vector);
for (i = 0; i < len; i++)
{
if (i == len)
Vcode_conversion_map_vector = larger_vector (Vcode_conversion_map_vector,
- len * 2, Qnil);
+ 1, -1);
idx = make_number (i);
Fput (symbol, Qcode_conversion_map, map);
/* Header for CCL (Code Conversion Language) interpreter.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
Copyright (C) 2003
#ifndef EMACS_CCL_H
#define EMACS_CCL_H
+#include "character.h" /* For MAX_MULTIBYTE_LENGTH */
+
/* Macros for exit status of CCL program. */
#define CCL_STAT_SUCCESS 0 /* Terminated successfully. */
#define CCL_STAT_SUSPEND_BY_SRC 1 /* Terminated by empty input. */
/* Structure to hold information about running CCL code. Read
comments in the file ccl.c for the detail of each field. */
struct ccl_program {
- int idx; /* Index number of the CCL program.
+ ptrdiff_t idx; /* Index number of the CCL program.
-1 means that the program was given
by a vector, not by a program
name. */
extern Lisp_Object Qccl, Qcclp;
-EXFUN (Fccl_program_p, 1);
-
#define CHECK_CCL_PROGRAM(x) \
do { \
if (NILP (Fccl_program_p (x))) \
#include <config.h>
#endif
+#define CHARACTER_INLINE EXTERN_INLINE
+
#include <stdio.h>
#ifdef emacs
#include <sys/types.h>
-#include <setjmp.h>
#include <intprops.h>
#include "lisp.h"
#include "character.h"
Unicode character. Mainly used by the macro MAYBE_UNIFY_CHAR. */
Lisp_Object Vchar_unify_table;
-/* Variable used locally in the macro FETCH_MULTIBYTE_CHAR. */
-unsigned char *_fetch_multibyte_char_p;
-
static Lisp_Object Qchar_script_table;
\f
/* If character code C has modifier masks, reflect them to the
character code if possible. Return the resulting code. */
-int
-char_resolve_modifier_mask (int c)
+EMACS_INT
+char_resolve_modifier_mask (EMACS_INT c)
{
/* A non-ASCII character can't reflect modifier bits to the code. */
if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
c &= ~CHAR_MODIFIER_MASK;
}
- MAYBE_UNIFY_CHAR (c);
-
if (c <= MAX_3_BYTE_CHAR)
{
bytes = CHAR_STRING (c, p);
p += 5;
}
- MAYBE_UNIFY_CHAR (c);
-
if (len)
*len = p - saved_p;
if (advanced)
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)
{
/* Return width (columns) of C considering the buffer display table DP. */
-static EMACS_INT
+static ptrdiff_t
char_width (int c, struct Lisp_Char_Table *dp)
{
- EMACS_INT width = CHAR_WIDTH (c);
+ ptrdiff_t width = CHAR_WIDTH (c);
if (dp)
{
(Lisp_Object ch)
{
int c;
- EMACS_INT width;
+ ptrdiff_t width;
CHECK_CHARACTER (ch);
c = XINT (ch);
characters and bytes of the substring in *NCHARS and *NBYTES
respectively. */
-EMACS_INT
-c_string_width (const unsigned char *str, EMACS_INT len, int precision,
- EMACS_INT *nchars, EMACS_INT *nbytes)
+ptrdiff_t
+c_string_width (const unsigned char *str, ptrdiff_t len, int precision,
+ ptrdiff_t *nchars, ptrdiff_t *nbytes)
{
- EMACS_INT i = 0, i_byte = 0;
- EMACS_INT width = 0;
+ ptrdiff_t i = 0, i_byte = 0;
+ ptrdiff_t width = 0;
struct Lisp_Char_Table *dp = buffer_display_table ();
while (i_byte < len)
{
int bytes;
int c = STRING_CHAR_AND_LENGTH (str + i_byte, bytes);
- EMACS_INT thiswidth = char_width (c, dp);
+ ptrdiff_t thiswidth = char_width (c, dp);
if (precision <= 0)
{
current buffer. The width is measured by how many columns it
occupies on the screen. */
-EMACS_INT
-strwidth (const char *str, EMACS_INT len)
+ptrdiff_t
+strwidth (const char *str, ptrdiff_t len)
{
return c_string_width ((const unsigned char *) str, len, -1, NULL, NULL);
}
PRECISION, and set number of characters and bytes of the substring
in *NCHARS and *NBYTES respectively. */
-EMACS_INT
-lisp_string_width (Lisp_Object string, EMACS_INT precision,
- EMACS_INT *nchars, EMACS_INT *nbytes)
+ptrdiff_t
+lisp_string_width (Lisp_Object string, ptrdiff_t precision,
+ ptrdiff_t *nchars, ptrdiff_t *nbytes)
{
- EMACS_INT len = SCHARS (string);
+ ptrdiff_t len = SCHARS (string);
/* This set multibyte to 0 even if STRING is multibyte when it
contains only ascii and eight-bit-graphic, but that's
intentional. */
- int multibyte = len < SBYTES (string);
+ bool multibyte = len < SBYTES (string);
unsigned char *str = SDATA (string);
- EMACS_INT i = 0, i_byte = 0;
- EMACS_INT width = 0;
+ ptrdiff_t i = 0, i_byte = 0;
+ ptrdiff_t width = 0;
struct Lisp_Char_Table *dp = buffer_display_table ();
while (i < len)
{
- EMACS_INT chars, bytes, thiswidth;
+ ptrdiff_t chars, bytes, thiswidth;
Lisp_Object val;
ptrdiff_t cmp_id;
- EMACS_INT ignore, end;
+ ptrdiff_t ignore, end;
if (find_composition (i, -1, &ignore, &end, &val, string)
&& ((cmp_id = get_composition_id (i, i_byte, end - i, val, string))
However, if the current buffer has enable-multibyte-characters =
nil, we treat each byte as a character. */
-EMACS_INT
-chars_in_text (const unsigned char *ptr, EMACS_INT nbytes)
+ptrdiff_t
+chars_in_text (const unsigned char *ptr, ptrdiff_t nbytes)
{
/* current_buffer is null at early stages of Emacs initialization. */
if (current_buffer == 0
sequences while assuming that there's no invalid sequence. It
ignores enable-multibyte-characters. */
-EMACS_INT
-multibyte_chars_in_text (const unsigned char *ptr, EMACS_INT nbytes)
+ptrdiff_t
+multibyte_chars_in_text (const unsigned char *ptr, ptrdiff_t nbytes)
{
const unsigned char *endp = ptr + nbytes;
- EMACS_INT chars = 0;
+ ptrdiff_t chars = 0;
while (ptr < endp)
{
- EMACS_INT len = MULTIBYTE_LENGTH (ptr, endp);
+ int len = MULTIBYTE_LENGTH (ptr, endp);
if (len == 0)
- abort ();
+ emacs_abort ();
ptr += len;
chars++;
}
represented by 2-byte in a multibyte text. */
void
-parse_str_as_multibyte (const unsigned char *str, EMACS_INT len,
- EMACS_INT *nchars, EMACS_INT *nbytes)
+parse_str_as_multibyte (const unsigned char *str, ptrdiff_t len,
+ ptrdiff_t *nchars, ptrdiff_t *nbytes)
{
const unsigned char *endp = str + len;
- EMACS_INT n, chars = 0, bytes = 0;
+ int n;
+ ptrdiff_t chars = 0, bytes = 0;
if (len >= MAX_MULTIBYTE_LENGTH)
{
area and that is enough. Return the number of bytes of the
resulting text. */
-EMACS_INT
-str_as_multibyte (unsigned char *str, EMACS_INT len, EMACS_INT nbytes,
- EMACS_INT *nchars)
+ptrdiff_t
+str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes,
+ ptrdiff_t *nchars)
{
unsigned char *p = str, *endp = str + nbytes;
unsigned char *to;
- EMACS_INT chars = 0;
+ ptrdiff_t chars = 0;
int n;
if (nbytes >= MAX_MULTIBYTE_LENGTH)
bytes it may occupy when converted to multibyte string by
`str_to_multibyte'. */
-EMACS_INT
-count_size_as_multibyte (const unsigned char *str, EMACS_INT len)
+ptrdiff_t
+count_size_as_multibyte (const unsigned char *str, ptrdiff_t len)
{
const unsigned char *endp = str + len;
- EMACS_INT bytes;
+ ptrdiff_t bytes;
for (bytes = 0; str < endp; str++)
{
that we can use LEN bytes at STR as a work area and that is
enough. */
-EMACS_INT
-str_to_multibyte (unsigned char *str, EMACS_INT len, EMACS_INT bytes)
+ptrdiff_t
+str_to_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t bytes)
{
unsigned char *p = str, *endp = str + bytes;
unsigned char *to;
actually converts characters in the range 0x80..0xFF to
unibyte. */
-EMACS_INT
-str_as_unibyte (unsigned char *str, EMACS_INT bytes)
+ptrdiff_t
+str_as_unibyte (unsigned char *str, ptrdiff_t bytes)
{
const unsigned char *p = str, *endp = str + bytes;
unsigned char *to;
corresponding byte and store in DST. CHARS is the number of
characters in SRC. The value is the number of bytes stored in DST.
Usually, the value is the same as CHARS, but is less than it if SRC
- contains a non-ASCII, non-eight-bit character. If ACCEPT_LATIN_1
- is nonzero, a Latin-1 character is accepted and converted to a byte
- of that character code.
- Note: Currently the arg ACCEPT_LATIN_1 is not used. */
+ contains a non-ASCII, non-eight-bit character. */
-EMACS_INT
-str_to_unibyte (const unsigned char *src, unsigned char *dst, EMACS_INT chars, int accept_latin_1)
+ptrdiff_t
+str_to_unibyte (const unsigned char *src, unsigned char *dst, ptrdiff_t chars)
{
- EMACS_INT i;
+ ptrdiff_t i;
for (i = 0; i < chars; i++)
{
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
- else if (! ASCII_CHAR_P (c)
- && (! accept_latin_1 || c >= 0x100))
+ else if (! ASCII_CHAR_P (c))
return i;
*dst++ = c;
}
}
-static EMACS_INT
+static ptrdiff_t
string_count_byte8 (Lisp_Object string)
{
- int multibyte = STRING_MULTIBYTE (string);
- EMACS_INT nbytes = SBYTES (string);
+ bool multibyte = STRING_MULTIBYTE (string);
+ ptrdiff_t nbytes = SBYTES (string);
unsigned char *p = SDATA (string);
unsigned char *pend = p + nbytes;
- EMACS_INT count = 0;
+ ptrdiff_t count = 0;
int c, len;
if (multibyte)
Lisp_Object
string_escape_byte8 (Lisp_Object string)
{
- EMACS_INT nchars = SCHARS (string);
- EMACS_INT nbytes = SBYTES (string);
- int multibyte = STRING_MULTIBYTE (string);
- EMACS_INT byte8_count;
+ ptrdiff_t nchars = SCHARS (string);
+ ptrdiff_t nbytes = SBYTES (string);
+ bool multibyte = STRING_MULTIBYTE (string);
+ ptrdiff_t byte8_count;
const unsigned char *src, *src_end;
unsigned char *dst;
Lisp_Object val;
{
c = STRING_CHAR_ADVANCE (src);
c = CHAR_TO_BYTE8 (c);
- sprintf ((char *) dst, "\\%03o", c);
- dst += 4;
+ dst += sprintf ((char *) dst, "\\%03o", c);
}
else
while (len--) *dst++ = *src++;
{
c = *src++;
if (c >= 0x80)
- {
- sprintf ((char *) dst, "\\%03o", c);
- dst += 4;
- }
+ dst += sprintf ((char *) dst, "\\%03o", c);
else
*dst++ = c;
}
(ptrdiff_t n, Lisp_Object *args)
{
ptrdiff_t i;
- int c;
- 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++)
{
- CHECK_NATNUM (args[i]);
- c = XFASTINT (args[i]);
- if (c >= 256)
- args_out_of_range_3 (args[i], make_number (0), make_number (255));
- *p++ = c;
+ CHECK_RANGED_INTEGER (args[i], 0, 255);
+ *p++ = XINT (args[i]);
}
str = make_string_from_bytes ((char *) buf, n, p - buf);
usage: (char-resolve-modifiers CHAR) */)
(Lisp_Object character)
{
- int c;
+ EMACS_INT c;
CHECK_NUMBER (character);
c = XINT (character);
(Lisp_Object position, Lisp_Object string)
{
int c;
- EMACS_INT pos;
+ ptrdiff_t pos;
unsigned char *p;
if (NILP (string))
return make_number (c);
}
-
-void
-init_character_once (void)
-{
-}
-
#ifdef emacs
void
#include <verify.h>
+INLINE_HEADER_BEGIN
+#ifndef CHARACTER_INLINE
+# define CHARACTER_INLINE INLINE
+#endif
+
/* character code 1st byte byte sequence
-------------- -------- -------------
0-7F 00..7F 0xxxxxxx
Note: This macro returns the actual length of the character's
multibyte sequence as it is stored in a buffer or string. The
character it returns might have a different codepoint that has a
- different multibyte sequence of a different legth, due to possible
+ different multibyte sequence of a different length, due to possible
unification of CJK characters inside string_char. Therefore do NOT
assume that the length returned by this macro is identical to the
length of the multibyte sequence of the character it returns. */
unsigned char *chp = BYTE_POS_ADDR (BYTEIDX); \
int chlen; \
\
- OUTPUT= STRING_CHAR_AND_LENGTH (chp, chlen); \
+ OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
BYTEIDX += chlen; \
} \
else \
} while (0)
-/* If C is a character to be unified with a Unicode character, return
- the unified Unicode character. */
-
-#define MAYBE_UNIFY_CHAR(c) \
- do { \
- if (c > MAX_UNICODE_CHAR && c <= MAX_5_BYTE_CHAR) \
- { \
- Lisp_Object val; \
- val = CHAR_TABLE_REF (Vchar_unify_table, c); \
- if (INTEGERP (val)) \
- c = XFASTINT (val); \
- else if (! NILP (val)) \
- c = maybe_unify_char (c, val); \
- } \
- } while (0)
-
-
/* Return a non-outlandish value for the tab width. */
#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;
/* 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;
UNICODE_CATEGORY_Cn
} unicode_category_t;
-extern int char_resolve_modifier_mask (int);
+extern EMACS_INT char_resolve_modifier_mask (EMACS_INT) ATTRIBUTE_CONST;
extern int char_string (unsigned, unsigned char *);
extern int string_char (const unsigned char *,
const unsigned char **, int *);
extern int translate_char (Lisp_Object, int c);
-extern int char_printable_p (int c);
extern void parse_str_as_multibyte (const unsigned char *,
- EMACS_INT, EMACS_INT *, EMACS_INT *);
-extern EMACS_INT count_size_as_multibyte (const unsigned char *, EMACS_INT);
-extern EMACS_INT str_as_multibyte (unsigned char *, EMACS_INT, EMACS_INT,
- EMACS_INT *);
-extern EMACS_INT str_to_multibyte (unsigned char *, EMACS_INT, EMACS_INT);
-extern EMACS_INT str_as_unibyte (unsigned char *, EMACS_INT);
-extern EMACS_INT str_to_unibyte (const unsigned char *, unsigned char *,
- EMACS_INT, int);
-extern EMACS_INT strwidth (const char *, EMACS_INT);
-extern EMACS_INT c_string_width (const unsigned char *, EMACS_INT, int,
- EMACS_INT *, EMACS_INT *);
-extern EMACS_INT lisp_string_width (Lisp_Object, EMACS_INT,
- EMACS_INT *, EMACS_INT *);
+ ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
+extern ptrdiff_t count_size_as_multibyte (const unsigned char *, ptrdiff_t);
+extern ptrdiff_t str_as_multibyte (unsigned char *, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t *);
+extern ptrdiff_t str_to_multibyte (unsigned char *, ptrdiff_t, ptrdiff_t);
+extern ptrdiff_t str_as_unibyte (unsigned char *, ptrdiff_t);
+extern ptrdiff_t str_to_unibyte (const unsigned char *, unsigned char *,
+ ptrdiff_t);
+extern ptrdiff_t strwidth (const char *, ptrdiff_t);
+extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int,
+ ptrdiff_t *, ptrdiff_t *);
+extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t,
+ ptrdiff_t *, ptrdiff_t *);
extern Lisp_Object Qcharacterp;
extern Lisp_Object Vchar_unify_table;
#define GET_TRANSLATION_TABLE(id) \
(XCDR(XVECTOR(Vtranslation_table_vector)->contents[(id)]))
+INLINE_HEADER_END
+
#endif /* EMACS_CHARACTER_H */
#include <config.h>
+#define CHARSET_INLINE EXTERN_INLINE
+
#include <stdio.h>
#include <unistd.h>
-#include <ctype.h>
#include <limits.h>
#include <sys/types.h>
-#include <setjmp.h>
+#include <c-ctype.h>
#include "lisp.h"
#include "character.h"
#include "charset.h"
#define CODE_POINT_TO_INDEX(charset, code) \
((charset)->code_linear_p \
- ? (code) - (charset)->min_code \
+ ? (int) ((code) - (charset)->min_code) \
: (((charset)->code_space_mask[(code) >> 24] & 0x8) \
&& ((charset)->code_space_mask[((code) >> 16) & 0xFF] & 0x4) \
&& ((charset)->code_space_mask[((code) >> 8) & 0xFF] & 0x2) \
&& ((charset)->code_space_mask[(code) & 0xFF] & 0x1)) \
- ? (((((code) >> 24) - (charset)->code_space[12]) \
- * (charset)->code_space[11]) \
- + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
- * (charset)->code_space[7]) \
- + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
- * (charset)->code_space[3]) \
- + (((code) & 0xFF) - (charset)->code_space[0]) \
- - ((charset)->char_index_offset)) \
+ ? (int) (((((code) >> 24) - (charset)->code_space[12]) \
+ * (charset)->code_space[11]) \
+ + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
+ * (charset)->code_space[7]) \
+ + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
+ * (charset)->code_space[3]) \
+ + (((code) & 0xFF) - (charset)->code_space[0]) \
+ - ((charset)->char_index_offset)) \
: -1)
-/* Convert the character index IDX to code-point CODE for CHARSET.
- It is assumed that IDX is in a valid range. */
+/* Return the code-point for the character index IDX in CHARSET.
+ IDX should be an unsigned int variable in a valid range (which is
+ always in nonnegative int range too). IDX contains garbage afterwards. */
#define INDEX_TO_CODE_POINT(charset, idx) \
((charset)->code_linear_p \
/* Set to 1 to warn that a charset map is loaded and thus a buffer
text and a string data may be relocated. */
-int charset_map_loaded;
+bool charset_map_loaded;
struct charset_map_entries
{
{
Lisp_Object vec IF_LINT (= Qnil), table IF_LINT (= Qnil);
unsigned max_code = CHARSET_MAX_CODE (charset);
- int ascii_compatible_p = charset->ascii_compatible_p;
+ bool ascii_compatible_p = charset->ascii_compatible_p;
int min_char, max_char, nonascii_min_char;
int i;
unsigned char *fast_map = charset->fast_map;
{
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
{
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
{
if (! temp_charset_work)
- temp_charset_work = xmalloc (sizeof (*temp_charset_work));
+ temp_charset_work = xmalloc (sizeof *temp_charset_work);
if (control_flag == 1)
{
memset (temp_charset_work->table.decoder, -1,
&& CHARSET_COMPACT_CODES_P (charset))
for (; from_index < lim_index; from_index++, from_c++)
{
- unsigned code = INDEX_TO_CODE_POINT (charset, from_index);
+ unsigned code = from_index;
+ code = INDEX_TO_CODE_POINT (charset, code);
if (NILP (CHAR_TABLE_REF (table, from_c)))
CHAR_TABLE_SET (table, from_c, make_number (code));
paying attention to comment character '#'. */
static inline unsigned
-read_hex (FILE *fp, int *eof, int *overflow)
+read_hex (FILE *fp, bool *eof, bool *overflow)
{
int c;
unsigned n;
return 0;
}
n = 0;
- while (isxdigit (c = getc (fp)))
+ while (c_isxdigit (c = getc (fp)))
{
if (UINT_MAX >> 4 < n)
*overflow = 1;
FILE *fp;
Lisp_Object suffixes;
struct charset_map_entries *head, *entries;
- int n_entries, count;
+ int n_entries;
+ ptrdiff_t count;
USE_SAFE_ALLOCA;
suffixes = Fcons (build_string (".map"),
/* 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));
{
unsigned from, to, c;
int idx;
- int eof = 0, overflow = 0;
+ bool eof = 0, overflow = 0;
from = read_hex (fp, &eof, &overflow);
if (eof)
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;
}
- idx = n_entries % 0x10000;
+ idx = n_entries;
entries->entry[idx].from = from;
entries->entry[idx].to = to;
entries->entry[idx].c = c;
/* 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));
{
Lisp_Object val, val2;
unsigned from, to;
- int c;
+ EMACS_INT c;
int idx;
val = AREF (vec, i);
{
val2 = XCDR (val);
val = XCAR (val);
- CHECK_NATNUM (val);
- CHECK_NATNUM (val2);
from = XFASTINT (val);
to = XFASTINT (val2);
}
else
- {
- CHECK_NATNUM (val);
- from = to = XFASTINT (val);
- }
+ from = to = XFASTINT (val);
val = AREF (vec, i + 1);
CHECK_NATNUM (val);
c = XFASTINT (val);
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));
}
else
{
if (! CHARSET_UNIFIED_P (charset))
- abort ();
+ emacs_abort ();
map = CHARSET_UNIFY_MAP (charset);
}
if (STRINGP (map))
Lisp_Object arg, struct charset *charset, unsigned from, unsigned to)
{
Lisp_Object range;
- int partial;
-
- partial = (from > CHARSET_MIN_CODE (charset)
- || to < CHARSET_MAX_CODE (charset));
+ bool partial = (from > CHARSET_MIN_CODE (charset)
+ || to < CHARSET_MAX_CODE (charset));
if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET)
{
from = CHARSET_MIN_CODE (cs);
else
{
- CHECK_NATNUM (from_code);
from = XINT (from_code);
if (from < CHARSET_MIN_CODE (cs))
from = CHARSET_MIN_CODE (cs);
to = CHARSET_MAX_CODE (cs);
else
{
- CHECK_NATNUM (to_code);
to = XINT (to_code);
if (to > CHARSET_MAX_CODE (cs))
to = CHARSET_MAX_CODE (cs);
struct charset charset;
int id;
int dimension;
- int new_definition_p;
+ bool new_definition_p;
int nchars;
if (nargs != charset_arg_max)
val = args[charset_arg_code_space];
for (i = 0, dimension = 0, nchars = 1; ; i++)
{
+ Lisp_Object min_byte_obj, max_byte_obj;
int min_byte, max_byte;
- min_byte = XINT (Faref (val, make_number (i * 2)));
- max_byte = XINT (Faref (val, make_number (i * 2 + 1)));
- if (min_byte < 0 || min_byte > max_byte || max_byte >= 256)
- error ("Invalid :code-space value");
+ min_byte_obj = Faref (val, make_number (i * 2));
+ max_byte_obj = Faref (val, make_number (i * 2 + 1));
+ CHECK_RANGED_INTEGER (min_byte_obj, 0, 255);
+ min_byte = XINT (min_byte_obj);
+ CHECK_RANGED_INTEGER (max_byte_obj, min_byte, 255);
+ max_byte = XINT (max_byte_obj);
charset.code_space[i * 4] = min_byte;
charset.code_space[i * 4 + 1] = max_byte;
charset.code_space[i * 4 + 2] = max_byte - min_byte + 1;
charset.dimension = dimension;
else
{
- CHECK_NATNUM (val);
+ CHECK_RANGED_INTEGER (val, 1, 4);
charset.dimension = XINT (val);
- if (charset.dimension < 1 || charset.dimension > 4)
- args_out_of_range_3 (val, make_number (1), make_number (4));
}
charset.code_linear_p
if (! charset.code_linear_p)
{
- charset.code_space_mask = (unsigned char *) xmalloc (256);
- memset (charset.code_space_mask, 0, 256);
+ charset.code_space_mask = xzalloc (256);
for (i = 0; i < 4; i++)
for (j = charset.code_space[i * 4]; j <= charset.code_space[i * 4 + 1];
j++)
charset.min_code = (charset.code_space[0]
| (charset.code_space[4] << 8)
| (charset.code_space[8] << 16)
- | (charset.code_space[12] << 24));
+ | ((unsigned) charset.code_space[12] << 24));
charset.max_code = (charset.code_space[1]
| (charset.code_space[5] << 8)
| (charset.code_space[9] << 16)
- | (charset.code_space[13] << 24));
+ | ((unsigned) charset.code_space[13] << 24));
charset.char_index_offset = 0;
val = args[charset_arg_min_code];
if (code < charset.min_code
|| code > charset.max_code)
- args_out_of_range_3 (make_number (charset.min_code),
- make_number (charset.max_code), val);
+ args_out_of_range_3 (make_fixnum_or_float (charset.min_code),
+ make_fixnum_or_float (charset.max_code), val);
charset.char_index_offset = CODE_POINT_TO_INDEX (&charset, code);
charset.min_code = code;
}
if (code < charset.min_code
|| code > charset.max_code)
- args_out_of_range_3 (make_number (charset.min_code),
- make_number (charset.max_code), val);
+ args_out_of_range_3 (make_fixnum_or_float (charset.min_code),
+ make_fixnum_or_float (charset.max_code), val);
charset.max_code = code;
}
charset.invalid_code = 0;
else
{
- XSETINT (val, charset.max_code + 1);
- if (XINT (val) == charset.max_code + 1)
+ if (charset.max_code < UINT_MAX)
charset.invalid_code = charset.max_code + 1;
else
error ("Attribute :invalid-code must be specified");
}
}
else
- {
- CHECK_NATNUM (val);
- charset.invalid_code = XFASTINT (val);
- }
+ charset.invalid_code = cons_to_unsigned (val, UINT_MAX);
val = args[charset_arg_iso_final];
if (NILP (val))
charset.iso_revision = -1;
else
{
- CHECK_NUMBER (val);
- if (XINT (val) > 63)
- args_out_of_range (make_number (63), val);
+ CHECK_RANGED_INTEGER (val, -1, 63);
charset.iso_revision = XINT (val);
}
if (! NILP (args[charset_arg_code_offset]))
{
val = args[charset_arg_code_offset];
- CHECK_NUMBER (val);
+ CHECK_CHARACTER (val);
charset.method = CHARSET_METHOD_OFFSET;
charset.code_offset = XINT (val);
- i = CODE_POINT_TO_INDEX (&charset, charset.min_code);
- charset.min_char = i + charset.code_offset;
i = CODE_POINT_TO_INDEX (&charset, charset.max_code);
- charset.max_char = i + charset.code_offset;
- if (charset.max_char > MAX_CHAR)
+ if (MAX_CHAR - charset.code_offset < i)
error ("Unsupported max char: %d", charset.max_char);
+ charset.max_char = i + charset.code_offset;
+ i = CODE_POINT_TO_INDEX (&charset, charset.min_code);
+ charset.min_char = i + charset.code_offset;
i = (charset.min_char >> 7) << 7;
for (; i < 0x10000 && i <= charset.max_char; i += 128)
car_part = XCAR (elt);
cdr_part = XCDR (elt);
CHECK_CHARSET_GET_ID (car_part, this_id);
- CHECK_NUMBER (cdr_part);
+ CHECK_TYPE_RANGED_INTEGER (int, cdr_part);
offset = XINT (cdr_part);
}
else
{
new_definition_p = 0;
id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name]));
- HASH_VALUE (hash_table, charset.hash_index) = attrs;
+ set_hash_value_slot (hash_table, charset.hash_index, attrs);
}
else
{
const char *code_space_chars,
unsigned min_code, unsigned max_code,
int iso_final, int iso_revision, int emacs_mule_id,
- int ascii_compatible, int supplementary,
+ bool ascii_compatible, bool supplementary,
int code_offset)
{
const unsigned char *code_space = (const unsigned char *) code_space_chars;
Lisp_Object args[charset_arg_max];
- Lisp_Object plist[14];
Lisp_Object val;
int i;
args[charset_arg_superset] = Qnil;
args[charset_arg_unify_map] = Qnil;
- plist[0] = intern_c_string (":name");
- plist[1] = args[charset_arg_name];
- plist[2] = intern_c_string (":dimension");
- plist[3] = args[charset_arg_dimension];
- plist[4] = intern_c_string (":code-space");
- plist[5] = args[charset_arg_code_space];
- plist[6] = intern_c_string (":iso-final-char");
- plist[7] = args[charset_arg_iso_final];
- plist[8] = intern_c_string (":emacs-mule-id");
- plist[9] = args[charset_arg_emacs_mule_id];
- plist[10] = intern_c_string (":ascii-compatible-p");
- plist[11] = args[charset_arg_ascii_compatible_p];
- plist[12] = intern_c_string (":code-offset");
- plist[13] = args[charset_arg_code_offset];
-
- args[charset_arg_plist] = Flist (14, plist);
+ args[charset_arg_plist] =
+ listn (CONSTYPE_HEAP, 14,
+ intern_c_string (":name"),
+ args[charset_arg_name],
+ intern_c_string (":dimension"),
+ args[charset_arg_dimension],
+ intern_c_string (":code-space"),
+ args[charset_arg_code_space],
+ intern_c_string (":iso-final-char"),
+ args[charset_arg_iso_final],
+ intern_c_string (":emacs-mule-id"),
+ args[charset_arg_emacs_mule_id],
+ intern_c_string (":ascii-compatible-p"),
+ args[charset_arg_ascii_compatible_p],
+ intern_c_string (":code-offset"),
+ args[charset_arg_code_offset]);
Fdefine_charset_internal (charset_arg_max, args);
return XINT (CHARSET_SYMBOL_ID (name));
Lisp_Object attrs;
CHECK_CHARSET_GET_ATTR (charset, attrs);
- CHARSET_ATTR_PLIST (attrs) = plist;
+ ASET (attrs, charset_plist, plist);
return plist;
}
{
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);
}
else if (CHAR_TABLE_P (Vchar_unify_table))
{
- int min_code = CHARSET_MIN_CODE (cs);
- int max_code = CHARSET_MAX_CODE (cs);
+ unsigned min_code = CHARSET_MIN_CODE (cs);
+ unsigned max_code = CHARSET_MAX_CODE (cs);
int min_char = DECODE_CHAR (cs, min_code);
int max_char = DECODE_CHAR (cs, max_code);
(Lisp_Object dimension, Lisp_Object chars, Lisp_Object final_char, Lisp_Object charset)
{
int id;
- int chars_flag;
+ bool chars_flag;
CHECK_CHARSET_GET_ID (charset, id);
check_iso_charset_parameter (dimension, chars, final_char);
It may lookup a translation table TABLE if supplied. */
static void
-find_charsets_in_text (const unsigned char *ptr, EMACS_INT nchars, EMACS_INT nbytes, Lisp_Object charsets, Lisp_Object table, int multibyte)
+find_charsets_in_text (const unsigned char *ptr, ptrdiff_t nchars,
+ ptrdiff_t nbytes, Lisp_Object charsets,
+ Lisp_Object table, bool multibyte)
{
const unsigned char *pend = ptr + nbytes;
(Lisp_Object beg, Lisp_Object end, Lisp_Object table)
{
Lisp_Object charsets;
- EMACS_INT from, from_byte, to, stop, stop_byte;
+ ptrdiff_t from, from_byte, to, stop, stop_byte;
int i;
Lisp_Object val;
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
validate_region (&beg, &end);
from = XFASTINT (beg);
/* Return a unified character code for C (>= 0x110000). VAL is a
value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
charset symbol. */
-int
+static int
maybe_unify_char (int c, Lisp_Object val)
{
struct charset *charset;
CHECK_CHARSET_GET_CHARSET (val, charset);
#ifdef REL_ALLOC
- /* The call to load_charset below can allocate memory, whcih screws
+ /* The call to load_charset below can allocate memory, which screws
callers of this function through STRING_CHAR_* macros that hold C
pointers to buffer text, if REL_ALLOC is used. */
r_alloc_inhibit_buffer_relocation (1);
{
c = char_index + CHARSET_CODE_OFFSET (charset);
if (CHARSET_UNIFIED_P (charset)
- && c > MAX_UNICODE_CHAR)
- MAYBE_UNIFY_CHAR (c);
+ && MAX_UNICODE_CHAR < c && c <= MAX_5_BYTE_CHAR)
+ {
+ /* Unify C with a Unicode character if possible. */
+ Lisp_Object val = CHAR_TABLE_REF (Vchar_unify_table, c);
+ c = maybe_unify_char (c, val);
+ }
}
}
/* Variable used temporarily by the macro ENCODE_CHAR. */
Lisp_Object charset_work;
-/* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to
+/* Return a code-point of C in CHARSET. If C doesn't belong to
CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
use CHARSET's strict_max_char instead of max_char. */
}
else /* method == CHARSET_METHOD_OFFSET */
{
- int code_index = c - CHARSET_CODE_OFFSET (charset);
+ unsigned code_index = c - CHARSET_CODE_OFFSET (charset);
code = INDEX_TO_CODE_POINT (charset, code_index);
}
struct charset *
char_charset (int c, Lisp_Object charset_list, unsigned int *code_return)
{
- int maybe_null = 0;
+ bool maybe_null = 0;
if (NILP (charset_list))
charset_list = Vcharset_ordered_list;
c = XFASTINT (ch);
charset = CHAR_CHARSET (c);
if (! charset)
- abort ();
+ emacs_abort ();
code = ENCODE_CHAR (charset, c);
if (code == CHARSET_INVALID_CODE (charset))
- abort ();
+ emacs_abort ();
dimension = CHARSET_DIMENSION (charset);
for (val = Qnil; dimension > 0; dimension--)
{
(Lisp_Object dimension, Lisp_Object chars, Lisp_Object final_char)
{
int id;
- int chars_flag;
+ bool chars_flag;
check_iso_charset_parameter (dimension, chars, final_char);
chars_flag = XFASTINT (chars) == 96;
defsubr (&Ssort_charsets);
DEFVAR_LISP ("charset-map-path", Vcharset_map_path,
- doc: /* *List of directories to search for charset map files. */);
+ doc: /* List of directories to search for charset map files. */);
Vcharset_map_path = Qnil;
DEFVAR_BOOL ("inhibit-load-charset-map", inhibit_load_charset_map,
#include <verify.h>
+INLINE_HEADER_BEGIN
+#ifndef CHARSET_INLINE
+# define CHARSET_INLINE INLINE
+#endif
+
/* Index to arguments of Fdefine_charset_internal. */
enum define_charset_arg_index
check if a code-point is in a valid range. */
unsigned char *code_space_mask;
- /* 1 if there's no gap in code-points. */
- int code_linear_p;
+ /* True if there's no gap in code-points. */
+ unsigned code_linear_p : 1;
+
+ /* True if the charset is treated as 96 chars in ISO-2022
+ as opposed to 94 chars. */
+ unsigned iso_chars_96 : 1;
+
+ /* True if the charset is compatible with ASCII. */
+ unsigned ascii_compatible_p : 1;
- /* If the charset is treated as 94-chars in ISO-2022, the value is 0.
- If the charset is treated as 96-chars in ISO-2022, the value is 1. */
- int iso_chars_96;
+ /* True if the charset is supplementary. */
+ unsigned supplementary_p : 1;
+
+ /* True if all the code points are representable by Lisp_Int. */
+ unsigned compact_codes_p : 1;
+
+ /* True if the charset is unified with Unicode. */
+ unsigned unified_p : 1;
/* ISO final byte of the charset: 48..127. It may be -1 if the
charset doesn't conform to ISO-2022. */
version. Otherwise, -1. */
int emacs_mule_id;
- /* Nonzero if the charset is compatible with ASCII. */
- int ascii_compatible_p;
-
- /* Nonzero if the charset is supplementary. */
- int supplementary_p;
-
- /* Nonzero if all the code points are representable by Lisp_Int. */
- int compact_codes_p;
-
/* The method for encoding/decoding characters of the charset. */
enum charset_method method;
/* Offset value to calculate a character code from code-point, and
visa versa. */
int code_offset;
-
- int unified_p;
};
/* Hash table of charset symbols vs. the corresponding attribute
#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)
? decode_char ((charset), (code)) \
: (charset)->method == CHARSET_METHOD_OFFSET \
? ((charset)->code_linear_p \
- ? (code) - (charset)->min_code + (charset)->code_offset \
+ ? (int) ((code) - (charset)->min_code) + (charset)->code_offset \
: decode_char ((charset), (code))) \
: (charset)->method == CHARSET_METHOD_MAP \
? (((charset)->code_linear_p \
: decode_char ((charset), (code))) \
: decode_char ((charset), (code)))
-
-/* If CHARSET is a simple offset base charset, return it's offset,
- otherwise return -1. */
-#define CHARSET_OFFSET(charset) \
- (((charset)->method == CHARSET_METHOD_OFFSET \
- && (charset)->code_linear_p \
- && ! (charset)->unified_p) \
- ? (charset)->code_offset - (charset)->min_code \
- : -1)
-
extern Lisp_Object charset_work;
/* Return a code point of CHAR in CHARSET.
(verify_expr \
(sizeof (c) <= sizeof (int), \
(ASCII_CHAR_P (c) && (charset)->ascii_compatible_p \
- ? (c) \
+ ? (unsigned) (c) \
: ((charset)->unified_p \
|| (charset)->method == CHARSET_METHOD_SUBSET \
|| (charset)->method == CHARSET_METHOD_SUPERSET) \
? (charset)->invalid_code \
: (charset)->method == CHARSET_METHOD_OFFSET \
? ((charset)->code_linear_p \
- ? (c) - (charset)->code_offset + (charset)->min_code \
+ ? (unsigned) ((c) - (charset)->code_offset) + (charset)->min_code \
: encode_char (charset, c)) \
: (charset)->method == CHARSET_METHOD_MAP \
? (((charset)->compact_codes_p \
? (charset_work = CHAR_TABLE_REF (CHARSET_ENCODER (charset), c), \
(NILP (charset_work) \
? (charset)->invalid_code \
- : XFASTINT (charset_work))) \
+ : (unsigned) XFASTINT (charset_work))) \
: encode_char (charset, c)) \
: encode_char (charset, c))))
/* Set to 1 when a charset map is loaded to warn that a buffer text
and a string data may be relocated. */
-extern int charset_map_loaded;
+extern bool charset_map_loaded;
/* Set CHARSET to the charset highest priority of C, CODE to the
macro ISO_CHARSET_TABLE (DIMENSION, CHARS, FINAL_CHAR). */
extern int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL];
-/* A charset of type iso2022 who has DIMENSION, CHARS, and FINAL
+/* A charset of type iso2022 who has DIMENSION, CHARS_96, and FINAL
(final character). */
#define ISO_CHARSET_TABLE(dimension, chars_96, final) \
- iso_charset_table[(dimension) - 1][(chars_96)][(final)]
+ iso_charset_table[(dimension) - 1][chars_96][final]
/* Nonzero if the charset who has FAST_MAP may contain C. */
#define CHARSET_FAST_MAP_REF(c, fast_map) \
-/* 1 if CHARSET may contain the character C. */
+/* True if CHARSET may contain the character C. */
#define CHAR_CHARSET_P(c, charset) \
((ASCII_CHAR_P (c) && (charset)->ascii_compatible_p) \
|| ((CHARSET_UNIFIED_P (charset) \
extern struct charset *char_charset (int, Lisp_Object, unsigned *);
extern Lisp_Object charset_attributes (int);
-extern int maybe_unify_char (int, Lisp_Object);
extern int decode_char (struct charset *, unsigned);
extern unsigned encode_char (struct charset *, int);
extern int string_xstring_p (Lisp_Object);
Lisp_Object, Lisp_Object,
struct charset *, unsigned, unsigned);
+INLINE_HEADER_END
+
#endif /* EMACS_CHARSET_H */
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "character.h"
#include "charset.h"
else
{
CHECK_NATNUM (n);
- n_extras = XINT (n);
- if (n_extras > 10)
+ if (XINT (n) > 10)
args_out_of_range (n, Qnil);
+ n_extras = XINT (n);
}
size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras;
vector = Fmake_vector (make_number (size), init);
XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
- XCHAR_TABLE (vector)->parent = Qnil;
- XCHAR_TABLE (vector)->purpose = purpose;
+ set_char_table_parent (vector, Qnil);
+ set_char_table_purpose (vector, purpose);
XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
return vector;
}
static Lisp_Object
copy_sub_char_table (Lisp_Object table)
{
- Lisp_Object copy;
int depth = XINT (XSUB_CHAR_TABLE (table)->depth);
int min_char = XINT (XSUB_CHAR_TABLE (table)->min_char);
- Lisp_Object val;
+ Lisp_Object copy = make_sub_char_table (depth, min_char, Qnil);
int i;
- copy = make_sub_char_table (depth, min_char, Qnil);
/* Recursively copy any sub char-tables. */
for (i = 0; i < chartab_size[depth]; i++)
{
- val = XSUB_CHAR_TABLE (table)->contents[i];
- if (SUB_CHAR_TABLE_P (val))
- XSUB_CHAR_TABLE (copy)->contents[i] = copy_sub_char_table (val);
- else
- XSUB_CHAR_TABLE (copy)->contents[i] = val;
+ Lisp_Object val = XSUB_CHAR_TABLE (table)->contents[i];
+ set_sub_char_table_contents
+ (copy, i, SUB_CHAR_TABLE_P (val) ? copy_sub_char_table (val) : val);
}
return copy;
copy = Fmake_vector (make_number (size), Qnil);
XSETPVECTYPE (XVECTOR (copy), PVEC_CHAR_TABLE);
- XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (table)->defalt;
- XCHAR_TABLE (copy)->parent = XCHAR_TABLE (table)->parent;
- XCHAR_TABLE (copy)->purpose = XCHAR_TABLE (table)->purpose;
+ set_char_table_defalt (copy, XCHAR_TABLE (table)->defalt);
+ set_char_table_parent (copy, XCHAR_TABLE (table)->parent);
+ set_char_table_purpose (copy, XCHAR_TABLE (table)->purpose);
for (i = 0; i < chartab_size[0]; i++)
- XCHAR_TABLE (copy)->contents[i]
- = (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
- ? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
- : XCHAR_TABLE (table)->contents[i]);
- XCHAR_TABLE (copy)->ascii = char_table_ascii (copy);
+ set_char_table_contents
+ (copy, i,
+ (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
+ ? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
+ : XCHAR_TABLE (table)->contents[i]));
+ set_char_table_ascii (copy, char_table_ascii (copy));
size -= VECSIZE (struct Lisp_Char_Table) - 1;
for (i = 0; i < size; i++)
- XCHAR_TABLE (copy)->extras[i] = XCHAR_TABLE (table)->extras[i];
+ set_char_table_extras (copy, i, XCHAR_TABLE (table)->extras[i]);
XSETCHAR_TABLE (copy, XCHAR_TABLE (copy));
return copy;
}
static Lisp_Object
-sub_char_table_ref (Lisp_Object table, int c, int is_uniprop)
+sub_char_table_ref (Lisp_Object table, int c, bool is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
static Lisp_Object
sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
- Lisp_Object defalt, int is_uniprop)
+ Lisp_Object defalt, bool is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
int chartab_idx = CHARTAB_IDX (c, 0, 0), idx;
Lisp_Object val;
- int is_uniprop = UNIPROP_TABLE_P (table);
+ bool is_uniprop = UNIPROP_TABLE_P (table);
val = tbl->contents[chartab_idx];
if (*from < 0)
static void
-sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, int is_uniprop)
+sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, bool is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT ((tbl)->depth);
Lisp_Object sub;
if (depth == 3)
- tbl->contents[i] = val;
+ set_sub_char_table_contents (table, i, val);
else
{
sub = tbl->contents[i];
sub = make_sub_char_table (depth + 1,
min_char + i * chartab_chars[depth],
sub);
- tbl->contents[i] = sub;
+ set_sub_char_table_contents (table, i, sub);
}
}
sub_char_table_set (sub, c, val, is_uniprop);
}
}
-Lisp_Object
+void
char_table_set (Lisp_Object table, int c, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
if (ASCII_CHAR_P (c)
&& SUB_CHAR_TABLE_P (tbl->ascii))
- {
- XSUB_CHAR_TABLE (tbl->ascii)->contents[c] = val;
- }
+ set_sub_char_table_contents (tbl->ascii, c, val);
else
{
int i = CHARTAB_IDX (c, 0, 0);
if (! SUB_CHAR_TABLE_P (sub))
{
sub = make_sub_char_table (1, i * chartab_chars[0], sub);
- tbl->contents[i] = sub;
+ set_char_table_contents (table, i, sub);
}
sub_char_table_set (sub, c, val, UNIPROP_TABLE_P (table));
if (ASCII_CHAR_P (c))
- tbl->ascii = char_table_ascii (table);
+ set_char_table_ascii (table, char_table_ascii (table));
}
- return val;
}
static void
sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val,
- int is_uniprop)
+ bool is_uniprop)
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT ((tbl)->depth);
if (c > to)
break;
if (from <= c && c + chars_in_block - 1 <= to)
- tbl->contents[i] = val;
+ set_sub_char_table_contents (table, i, val);
else
{
Lisp_Object sub = tbl->contents[i];
else
{
sub = make_sub_char_table (depth + 1, c, sub);
- tbl->contents[i] = sub;
+ set_sub_char_table_contents (table, i, sub);
}
}
sub_char_table_set_range (sub, from, to, val, is_uniprop);
}
-Lisp_Object
+void
char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
char_table_set (table, from, val);
else
{
- int is_uniprop = UNIPROP_TABLE_P (table);
+ bool is_uniprop = UNIPROP_TABLE_P (table);
int lim = CHARTAB_IDX (to, 0, 0);
int i, c;
if (c > to)
break;
if (from <= c && c + chartab_chars[0] - 1 <= to)
- tbl->contents[i] = val;
+ set_char_table_contents (table, i, val);
else
{
Lisp_Object sub = tbl->contents[i];
if (! SUB_CHAR_TABLE_P (sub))
{
sub = make_sub_char_table (1, i * chartab_chars[0], sub);
- tbl->contents[i] = sub;
+ set_char_table_contents (table, i, sub);
}
sub_char_table_set_range (sub, from, to, val, is_uniprop);
}
}
if (ASCII_CHAR_P (from))
- tbl->ascii = char_table_ascii (table);
+ set_char_table_ascii (table, char_table_ascii (table));
}
- return val;
}
\f
error ("Attempt to make a chartable be its own parent");
}
- XCHAR_TABLE (char_table)->parent = parent;
+ set_char_table_parent (char_table, parent);
return parent;
}
|| XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
args_out_of_range (char_table, n);
- return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
+ set_char_table_extras (char_table, XINT (n), value);
+ return value;
}
\f
DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
{
int i;
- XCHAR_TABLE (char_table)->ascii = value;
+ set_char_table_ascii (char_table, value);
for (i = 0; i < chartab_size[0]; i++)
- XCHAR_TABLE (char_table)->contents[i] = value;
+ set_char_table_contents (char_table, i, value);
}
else if (EQ (range, Qnil))
- XCHAR_TABLE (char_table)->defalt = value;
- else if (INTEGERP (range))
+ set_char_table_defalt (char_table, value);
+ else if (CHARACTERP (range))
char_table_set (char_table, XINT (range), value);
else if (CONSP (range))
{
return value;
}
-DEFUN ("set-char-table-default", Fset_char_table_default,
- Sset_char_table_default, 3, 3, 0,
- doc: /*
-This function is obsolete and has no effect. */)
- (Lisp_Object char_table, Lisp_Object ch, Lisp_Object value)
-{
- return Qnil;
-}
-
/* Look up the element in TABLE at index CH, and return it as an
integer. If the element is not a character, return CH itself. */
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
Lisp_Object elt, this;
- int i, optimizable;
+ int i;
+ bool optimizable;
elt = XSUB_CHAR_TABLE (table)->contents[0];
if (SUB_CHAR_TABLE_P (elt))
- elt = XSUB_CHAR_TABLE (table)->contents[0]
- = optimize_sub_char_table (elt, test);
+ {
+ elt = optimize_sub_char_table (elt, test);
+ set_sub_char_table_contents (table, 0, elt);
+ }
optimizable = SUB_CHAR_TABLE_P (elt) ? 0 : 1;
for (i = 1; i < chartab_size[depth]; i++)
{
this = XSUB_CHAR_TABLE (table)->contents[i];
if (SUB_CHAR_TABLE_P (this))
- this = XSUB_CHAR_TABLE (table)->contents[i]
- = optimize_sub_char_table (this, test);
+ {
+ this = optimize_sub_char_table (this, test);
+ set_sub_char_table_contents (table, i, this);
+ }
if (optimizable
&& (NILP (test) ? NILP (Fequal (this, elt)) /* defaults to `equal'. */
: EQ (test, Qeq) ? !EQ (this, elt) /* Optimize `eq' case. */
{
elt = XCHAR_TABLE (char_table)->contents[i];
if (SUB_CHAR_TABLE_P (elt))
- XCHAR_TABLE (char_table)->contents[i]
- = optimize_sub_char_table (elt, test);
+ set_char_table_contents
+ (char_table, i, optimize_sub_char_table (elt, test));
}
/* Reset the `ascii' cache, in case it got optimized away. */
- XCHAR_TABLE (char_table)->ascii = char_table_ascii (char_table);
+ set_char_table_ascii (char_table, char_table_ascii (char_table));
return Qnil;
}
int chars_in_block;
int from = XINT (XCAR (range)), to = XINT (XCDR (range));
int i, c;
- int is_uniprop = UNIPROP_TABLE_P (top);
+ bool is_uniprop = UNIPROP_TABLE_P (top);
uniprop_decoder_t decoder = UNIPROP_GET_DECODER (top);
if (SUB_CHAR_TABLE_P (table))
this = XCHAR_TABLE (top)->defalt;
if (!EQ (val, this))
{
- int different_value = 1;
+ bool different_value = 1;
if (NILP (val))
{
/* This is to get a value of FROM in PARENT
without checking the parent of PARENT. */
- XCHAR_TABLE (parent)->parent = Qnil;
+ set_char_table_parent (parent, Qnil);
val = CHAR_TABLE_REF (parent, from);
- XCHAR_TABLE (parent)->parent = temp;
+ set_char_table_parent (parent, temp);
XSETCDR (range, make_number (c - 1));
val = map_sub_char_table (c_function, function,
parent, arg, val, range,
temp = XCHAR_TABLE (parent)->parent;
/* This is to get a value of FROM in PARENT without checking the
parent of PARENT. */
- XCHAR_TABLE (parent)->parent = Qnil;
+ set_char_table_parent (parent, Qnil);
val = CHAR_TABLE_REF (parent, from);
- XCHAR_TABLE (parent)->parent = temp;
+ set_char_table_parent (parent, temp);
val = map_sub_char_table (c_function, function, parent, arg, val, range,
parent);
table = parent;
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);
int min_char = (XINT (XSUB_CHAR_TABLE (table)->min_char)
+ chartab_chars[2] * idx);
Lisp_Object sub = make_sub_char_table (3, min_char, Qnil);
- struct Lisp_Sub_Char_Table *subtbl = XSUB_CHAR_TABLE (sub);
const unsigned char *p, *pend;
- XSUB_CHAR_TABLE (table)->contents[idx] = sub;
+ set_sub_char_table_contents (table, idx, sub);
p = SDATA (val), pend = p + SBYTES (val);
if (*p == 1)
{
while (p < pend && idx < chartab_chars[2])
{
int v = STRING_CHAR_ADVANCE (p);
- subtbl->contents[idx++] = v > 0 ? make_number (v) : Qnil;
+ set_sub_char_table_contents
+ (sub, idx++, v > 0 ? make_number (v) : Qnil);
}
}
else if (*p == 2)
}
}
while (count-- > 0)
- subtbl->contents[idx++] = make_number (v);
+ set_sub_char_table_contents (sub, idx++, make_number (v));
}
}
/* It seems that we don't need this function because C code won't need
static uniprop_decoder_t
uniprop_get_decoder (Lisp_Object table)
{
- int i;
+ EMACS_INT i;
if (! INTEGERP (XCHAR_TABLE (table)->extras[1]))
return NULL;
args[0] = XCHAR_TABLE (table)->extras[4];
args[1] = Fmake_vector (make_number (1), value);
- XCHAR_TABLE (table)->extras[4] = Fvconcat (2, args);
+ set_char_table_extras (table, 4, Fvconcat (2, args));
}
return make_number (i);
}
static uniprop_decoder_t
uniprop_get_encoder (Lisp_Object table)
{
- int i;
+ EMACS_INT i;
if (! INTEGERP (XCHAR_TABLE (table)->extras[2]))
return NULL;
: ! NILP (val))
return Qnil;
/* Prepare ASCII values in advance for CHAR_TABLE_REF. */
- XCHAR_TABLE (table)->ascii = char_table_ascii (table);
+ set_char_table_ascii (table, char_table_ascii (table));
return table;
}
defsubr (&Sset_char_table_extra_slot);
defsubr (&Schar_table_range);
defsubr (&Sset_char_table_range);
- defsubr (&Sset_char_table_default);
defsubr (&Soptimize_char_table);
defsubr (&Smap_char_table);
defsubr (&Sunicode_property_table_internal);
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "frame.h"
if (curX (tty) == FrameCols (tty))
{
if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1)
- abort ();
+ emacs_abort ();
if (tty->termscript)
putc ('\r', tty->termscript);
putc ('\r', tty->output);
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "syntax.h"
#include "window.h"
#include "keyboard.h"
return make_number (PT + XINT (n));
}
+/* Add N to point; or subtract N if FORWARD is false. N defaults to 1.
+ Validate the new location. Return nil. */
+static Lisp_Object
+move_point (Lisp_Object n, bool forward)
+{
+ /* This used to just set point to point + XINT (n), and then check
+ to see if it was within boundaries. But now that SET_PT can
+ potentially do a lot of stuff (calling entering and exiting
+ hooks, etcetera), that's not a good approach. So we validate the
+ proposed position, then set point. */
+
+ EMACS_INT new_point;
+
+ if (NILP (n))
+ XSETFASTINT (n, 1);
+ else
+ CHECK_NUMBER (n);
+
+ new_point = PT + (forward ? XINT (n) : - XINT (n));
+
+ if (new_point < BEGV)
+ {
+ SET_PT (BEGV);
+ xsignal0 (Qbeginning_of_buffer);
+ }
+ if (new_point > ZV)
+ {
+ SET_PT (ZV);
+ xsignal0 (Qend_of_buffer);
+ }
+
+ SET_PT (new_point);
+ return Qnil;
+}
+
DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "^p",
doc: /* Move point N characters forward (backward if N is negative).
On reaching end or beginning of buffer, stop and signal error.
+Interactively, N is the numeric prefix argument.
Depending on the bidirectional context, the movement may be to the
right or to the left on the screen. This is in contrast with
\\[right-char], which see. */)
(Lisp_Object n)
{
- if (NILP (n))
- XSETFASTINT (n, 1);
- else
- CHECK_NUMBER (n);
-
- /* This used to just set point to point + XINT (n), and then check
- to see if it was within boundaries. But now that SET_PT can
- potentially do a lot of stuff (calling entering and exiting
- hooks, etcetera), that's not a good approach. So we validate the
- proposed position, then set point. */
- {
- EMACS_INT new_point = PT + XINT (n);
-
- if (new_point < BEGV)
- {
- SET_PT (BEGV);
- xsignal0 (Qbeginning_of_buffer);
- }
- if (new_point > ZV)
- {
- SET_PT (ZV);
- xsignal0 (Qend_of_buffer);
- }
-
- SET_PT (new_point);
- }
-
- return Qnil;
+ return move_point (n, 1);
}
DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "^p",
doc: /* Move point N characters backward (forward if N is negative).
On attempt to pass beginning or end of buffer, stop and signal error.
+Interactively, N is the numeric prefix argument.
Depending on the bidirectional context, the movement may be to the
right or to the left on the screen. This is in contrast with
\\[left-char], which see. */)
(Lisp_Object n)
{
- if (NILP (n))
- XSETFASTINT (n, 1);
- else
- CHECK_NUMBER (n);
-
- XSETINT (n, - XINT (n));
- return Fforward_char (n);
+ return move_point (n, 0);
}
DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
successfully moved (for the return value). */)
(Lisp_Object n)
{
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
- EMACS_INT pos, pos_byte;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t pos, pos_byte;
EMACS_INT count, shortage;
if (NILP (n))
to t. */)
(Lisp_Object n)
{
- EMACS_INT newpos;
+ ptrdiff_t newpos;
if (NILP (n))
XSETFASTINT (n, 1);
At the end, it runs `post-self-insert-hook'. */)
(Lisp_Object n)
{
- int remove_boundary = 1;
+ bool remove_boundary = 1;
CHECK_NATNUM (n);
if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command)))
if (remove_boundary
&& CONSP (BVAR (current_buffer, undo_list))
- && NILP (XCAR (BVAR (current_buffer, undo_list))))
+ && NILP (XCAR (BVAR (current_buffer, undo_list)))
+ /* Only remove auto-added boundaries, not boundaries
+ 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_undo_list (current_buffer, XCDR (BVAR (current_buffer, undo_list)));
/* Barf if the key that invoked this was not a character. */
if (!CHARACTERP (last_command_event))
bitch_at_user ();
{
int character = translate_char (Vtranslation_table_for_input,
- (int) XINT (last_command_event));
+ XINT (last_command_event));
int val = internal_self_insert (character, XFASTINT (n));
if (val == 2)
nonundocount = 0;
int len;
/* Working buffer and pointer for multi-byte form of C. */
unsigned char str[MAX_MULTIBYTE_LENGTH];
- EMACS_INT chars_to_delete = 0;
- EMACS_INT spaces_to_insert = 0;
+ ptrdiff_t chars_to_delete = 0;
+ ptrdiff_t spaces_to_insert = 0;
overwrite = BVAR (current_buffer, overwrite_mode);
if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
/* This is the character after point. */
int c2 = FETCH_CHAR (PT_BYTE);
+ int cwidth;
+
/* Overwriting in binary-mode always replaces C2 by C.
Overwriting in textual-mode doesn't always do that.
It inserts newlines in the usual way,
and inserts any character at end of line
or before a tab if it doesn't use the whole width of the tab. */
if (EQ (overwrite, Qoverwrite_mode_binary))
- chars_to_delete = n;
- else if (c != '\n' && c2 != '\n')
+ chars_to_delete = min (n, PTRDIFF_MAX);
+ else if (c != '\n' && c2 != '\n'
+ && (cwidth = XFASTINT (Fchar_width (make_number (c)))) != 0)
{
- EMACS_INT pos = PT;
- EMACS_INT pos_byte = PT_BYTE;
-
- /* FIXME: Check for integer overflow when calculating
- target_clm and actual_clm. */
-
- /* Column the cursor should be placed at after this insertion.
- The correct value should be calculated only when necessary. */
- EMACS_INT target_clm = (current_column ()
- + n * XINT (Fchar_width (make_number (c))));
+ ptrdiff_t pos = PT;
+ ptrdiff_t pos_byte = PT_BYTE;
+ ptrdiff_t curcol = current_column ();
- /* The actual cursor position after the trial of moving
- to column TARGET_CLM. It is greater than TARGET_CLM
- if the TARGET_CLM is middle of multi-column
- character. In that case, the new point is set after
- that character. */
- EMACS_INT actual_clm
- = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
-
- chars_to_delete = PT - pos;
-
- if (actual_clm > target_clm)
+ if (n <= (min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX) - curcol) / cwidth)
{
- /* We will delete too many columns. Let's fill columns
- by spaces so that the remaining text won't move. */
- EMACS_INT actual = PT_BYTE;
- DEC_POS (actual);
- if (FETCH_CHAR (actual) == '\t')
- /* Rather than add spaces, let's just keep the tab. */
- chars_to_delete--;
- else
- spaces_to_insert = actual_clm - target_clm;
+ /* Column the cursor should be placed at after this insertion.
+ The value should be calculated only when necessary. */
+ ptrdiff_t target_clm = curcol + n * cwidth;
+
+ /* The actual cursor position after the trial of moving
+ to column TARGET_CLM. It is greater than TARGET_CLM
+ if the TARGET_CLM is middle of multi-column
+ character. In that case, the new point is set after
+ that character. */
+ ptrdiff_t actual_clm
+ = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
+
+ chars_to_delete = PT - pos;
+
+ if (actual_clm > target_clm)
+ {
+ /* We will delete too many columns. Let's fill columns
+ by spaces so that the remaining text won't move. */
+ ptrdiff_t actual = PT_BYTE;
+ DEC_POS (actual);
+ if (FETCH_CHAR (actual) == '\t')
+ /* Rather than add spaces, let's just keep the tab. */
+ chars_to_delete--;
+ else
+ spaces_to_insert = actual_clm - target_clm;
+ }
+
+ SET_PT_BOTH (pos, pos_byte);
}
-
- SET_PT_BOTH (pos, pos_byte);
}
hairy = 2;
}
: UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
== Sword))
{
- int modiff = MODIFF;
+ EMACS_INT modiff = MODIFF;
Lisp_Object sym;
sym = call0 (Qexpand_abbrev);
/* If we expanded an abbrev which has a hook,
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 (XSYMBOL (sym)->function)
+ if (SYMBOLP (sym) && ! NILP (sym)
+ && ! NILP (XSYMBOL (sym)->function)
&& SYMBOLP (XSYMBOL (sym)->function))
{
Lisp_Object prop;
CODING conforms to the format of XXX, and update the members of
DETECT_INFO.
- Return 1 if the byte sequence conforms to XXX, otherwise return 0.
+ Return true if the byte sequence conforms to XXX.
Below is the template of these functions. */
#if 0
-static int
+static bool
detect_coding_XXX (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int found = 0;
...;
/* A buffer to produce decoded characters. */
int *charbuf = coding->charbuf + coding->charbuf_used;
int *charbuf_end = coding->charbuf + coding->charbuf_size;
- int multibytep = coding->src_multibyte;
+ bool multibytep = coding->src_multibyte;
while (1)
{
static void
encode_coding_XXX (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf->charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
unsigned char *adjusted_dst_end = dst_end - _MAX_BYTES_PRODUCED_IN_LOOP_;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
for (; charbuf < charbuf_end && dst < adjusted_dst_end; charbuf++)
{
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "ccl.h"
#include "composite.h"
/* Safely get one byte from the source text pointed by SRC which ends
at SRC_END, and set C to that byte. If there are not enough bytes
- in the source, it jumps to `no_more_source'. If multibytep is
- nonzero, and a multibyte character is found at SRC, set C to the
+ in the source, it jumps to 'no_more_source'. If MULTIBYTEP,
+ and a multibyte character is found at SRC, set C to the
negative value of the character code. The caller should declare
and set these variables appropriately in advance:
src, src_end, multibytep */
/* Safely get two bytes from the source text pointed by SRC which ends
at SRC_END, and set C1 and C2 to those bytes while skipping the
heading multibyte characters. If there are not enough bytes in the
- source, it jumps to `no_more_source'. If multibytep is nonzero and
+ source, it jumps to 'no_more_source'. If MULTIBYTEP and
a multibyte character is found for C2, set C2 to the negative value
of the character code. The caller should declare and set these
variables appropriately in advance:
/* Store a byte C in the place pointed by DST and increment DST to the
- next free point, and increment PRODUCED_CHARS. If MULTIBYTEP is
- nonzero, store in an appropriate multibyte from. The caller should
+ next free point, and increment PRODUCED_CHARS. If MULTIBYTEP,
+ store in an appropriate multibyte form. The caller should
declare and set the variables `dst' and `multibytep' appropriately
in advance. */
} while (0)
-/* Prototypes for static functions. */
-static void record_conversion_result (struct coding_system *coding,
- enum coding_result_code result);
-static int detect_coding_utf_8 (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_utf_8 (struct coding_system *);
-static int encode_coding_utf_8 (struct coding_system *);
-
-static int detect_coding_utf_16 (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_utf_16 (struct coding_system *);
-static int encode_coding_utf_16 (struct coding_system *);
-
-static int detect_coding_iso_2022 (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_iso_2022 (struct coding_system *);
-static int encode_coding_iso_2022 (struct coding_system *);
-
-static int detect_coding_emacs_mule (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_emacs_mule (struct coding_system *);
-static int encode_coding_emacs_mule (struct coding_system *);
-
-static int detect_coding_sjis (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_sjis (struct coding_system *);
-static int encode_coding_sjis (struct coding_system *);
-
-static int detect_coding_big5 (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_big5 (struct coding_system *);
-static int encode_coding_big5 (struct coding_system *);
-
-static int detect_coding_ccl (struct coding_system *,
- struct coding_detection_info *info);
-static void decode_coding_ccl (struct coding_system *);
-static int encode_coding_ccl (struct coding_system *);
-
-static void decode_coding_raw_text (struct coding_system *);
-static int encode_coding_raw_text (struct coding_system *);
-
-static EMACS_INT coding_set_source (struct coding_system *);
-static EMACS_INT coding_set_destination (struct coding_system *);
-static void coding_alloc_by_realloc (struct coding_system *, EMACS_INT);
-static void coding_alloc_by_making_gap (struct coding_system *,
- EMACS_INT, EMACS_INT);
-static unsigned char *alloc_destination (struct coding_system *,
- EMACS_INT, unsigned char *);
-static void setup_iso_safe_charsets (Lisp_Object);
-static EMACS_INT encode_designation_at_bol (struct coding_system *,
- int *, int *, unsigned char *);
-static int detect_eol (const unsigned char *,
- EMACS_INT, enum coding_category);
-static Lisp_Object adjust_coding_eol_type (struct coding_system *, int);
-static void decode_eol (struct coding_system *);
-static Lisp_Object get_translation_table (Lisp_Object, int, int *);
-static Lisp_Object get_translation (Lisp_Object, int *, int *);
-static int produce_chars (struct coding_system *, Lisp_Object, int);
-static inline void produce_charset (struct coding_system *, int *,
- EMACS_INT);
-static void produce_annotation (struct coding_system *, EMACS_INT);
-static int decode_coding (struct coding_system *);
-static inline int *handle_composition_annotation (EMACS_INT, EMACS_INT,
- struct coding_system *,
- int *, EMACS_INT *);
-static inline int *handle_charset_annotation (EMACS_INT, EMACS_INT,
- struct coding_system *,
- int *, EMACS_INT *);
-static void consume_chars (struct coding_system *, Lisp_Object, int);
-static int encode_coding (struct coding_system *);
-static Lisp_Object make_conversion_work_buffer (int);
-static Lisp_Object code_conversion_restore (Lisp_Object);
-static inline int char_encodable_p (int, Lisp_Object);
-static Lisp_Object make_subsidiaries (Lisp_Object);
-
static void
record_conversion_result (struct coding_system *coding,
enum coding_result_code result)
#define CODING_DECODE_CHAR(coding, src, src_base, src_end, charset, code, c) \
do { \
- EMACS_INT offset; \
+ ptrdiff_t offset; \
\
charset_map_loaded = 0; \
c = DECODE_CHAR (charset, code); \
if (charset_map_loaded \
- && (offset = coding_set_source (coding))) \
+ && (offset = coding_change_source (coding))) \
{ \
src += offset; \
src_base += offset; \
#define CODING_ENCODE_CHAR(coding, dst, dst_end, charset, c, code) \
do { \
- EMACS_INT offset; \
+ ptrdiff_t offset; \
\
charset_map_loaded = 0; \
code = ENCODE_CHAR (charset, c); \
if (charset_map_loaded \
- && (offset = coding_set_destination (coding))) \
+ && (offset = coding_change_destination (coding))) \
{ \
dst += offset; \
dst_end += offset; \
#define CODING_CHAR_CHARSET(coding, dst, dst_end, c, charset_list, code_return, charset) \
do { \
- EMACS_INT offset; \
+ ptrdiff_t offset; \
\
charset_map_loaded = 0; \
charset = char_charset (c, charset_list, code_return); \
if (charset_map_loaded \
- && (offset = coding_set_destination (coding))) \
+ && (offset = coding_change_destination (coding))) \
{ \
dst += offset; \
dst_end += offset; \
#define CODING_CHAR_CHARSET_P(coding, dst, dst_end, c, charset, result) \
do { \
- EMACS_INT offset; \
+ ptrdiff_t offset; \
\
charset_map_loaded = 0; \
result = CHAR_CHARSET_P (c, charset); \
if (charset_map_loaded \
- && (offset = coding_set_destination (coding))) \
+ && (offset = coding_change_destination (coding))) \
{ \
dst += offset; \
dst_end += offset; \
do { \
if (dst + (bytes) >= dst_end) \
{ \
- EMACS_INT more_bytes = charbuf_end - charbuf + (bytes); \
+ ptrdiff_t more_bytes = charbuf_end - charbuf + (bytes); \
\
dst = alloc_destination (coding, more_bytes, dst); \
dst_end = coding->destination + coding->dst_bytes; \
/* Store multibyte form of the character C in P, and advance P to the
- end of the multibyte form. This is like CHAR_STRING_ADVANCE but it
- never calls MAYBE_UNIFY_CHAR. */
-
-#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) \
- do { \
- if ((c) <= MAX_1_BYTE_CHAR) \
- *(p)++ = (c); \
- else if ((c) <= MAX_2_BYTE_CHAR) \
- *(p)++ = (0xC0 | ((c) >> 6)), \
- *(p)++ = (0x80 | ((c) & 0x3F)); \
- else if ((c) <= MAX_3_BYTE_CHAR) \
- *(p)++ = (0xE0 | ((c) >> 12)), \
- *(p)++ = (0x80 | (((c) >> 6) & 0x3F)), \
- *(p)++ = (0x80 | ((c) & 0x3F)); \
- else if ((c) <= MAX_4_BYTE_CHAR) \
- *(p)++ = (0xF0 | (c >> 18)), \
- *(p)++ = (0x80 | ((c >> 12) & 0x3F)), \
- *(p)++ = (0x80 | ((c >> 6) & 0x3F)), \
- *(p)++ = (0x80 | (c & 0x3F)); \
- else if ((c) <= MAX_5_BYTE_CHAR) \
- *(p)++ = 0xF8, \
- *(p)++ = (0x80 | ((c >> 18) & 0x0F)), \
- *(p)++ = (0x80 | ((c >> 12) & 0x3F)), \
- *(p)++ = (0x80 | ((c >> 6) & 0x3F)), \
- *(p)++ = (0x80 | (c & 0x3F)); \
- else \
- (p) += BYTE8_STRING ((c) - 0x3FFF80, p); \
- } while (0)
+ end of the multibyte form. This used to be like CHAR_STRING_ADVANCE
+ without ever calling MAYBE_UNIFY_CHAR, but nowadays we don't call
+ MAYBE_UNIFY_CHAR in CHAR_STRING_ADVANCE. */
+#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) CHAR_STRING_ADVANCE(c, p)
/* Return the character code of character whose multibyte form is at
- P, and advance P to the end of the multibyte form. This is like
- STRING_CHAR_ADVANCE, but it never calls MAYBE_UNIFY_CHAR. */
-
-#define STRING_CHAR_ADVANCE_NO_UNIFY(p) \
- (!((p)[0] & 0x80) \
- ? *(p)++ \
- : ! ((p)[0] & 0x20) \
- ? ((p) += 2, \
- ((((p)[-2] & 0x1F) << 6) \
- | ((p)[-1] & 0x3F) \
- | ((unsigned char) ((p)[-2]) < 0xC2 ? 0x3FFF80 : 0))) \
- : ! ((p)[0] & 0x10) \
- ? ((p) += 3, \
- ((((p)[-3] & 0x0F) << 12) \
- | (((p)[-2] & 0x3F) << 6) \
- | ((p)[-1] & 0x3F))) \
- : ! ((p)[0] & 0x08) \
- ? ((p) += 4, \
- ((((p)[-4] & 0xF) << 18) \
- | (((p)[-3] & 0x3F) << 12) \
- | (((p)[-2] & 0x3F) << 6) \
- | ((p)[-1] & 0x3F))) \
- : ((p) += 5, \
- ((((p)[-4] & 0x3F) << 18) \
- | (((p)[-3] & 0x3F) << 12) \
- | (((p)[-2] & 0x3F) << 6) \
- | ((p)[-1] & 0x3F))))
-
-
-/* Update coding->source from coding->src_object, and return how many
- bytes coding->source was changed. */
+ P, and advance P to the end of the multibyte form. This used to be
+ like STRING_CHAR_ADVANCE without ever calling MAYBE_UNIFY_CHAR, but
+ nowadays STRING_CHAR_ADVANCE doesn't call MAYBE_UNIFY_CHAR. */
+
+#define STRING_CHAR_ADVANCE_NO_UNIFY(p) STRING_CHAR_ADVANCE(p)
+
+/* Set coding->source from coding->src_object. */
-static EMACS_INT
+static void
coding_set_source (struct coding_system *coding)
{
- const unsigned char *orig = coding->source;
-
if (BUFFERP (coding->src_object))
{
struct buffer *buf = XBUFFER (coding->src_object);
/* Otherwise, the source is C string and is never relocated
automatically. Thus we don't have to update anything. */
}
+}
+
+
+/* Set coding->source from coding->src_object, and return how many
+ bytes coding->source was changed. */
+
+static ptrdiff_t
+coding_change_source (struct coding_system *coding)
+{
+ const unsigned char *orig = coding->source;
+ coding_set_source (coding);
return coding->source - orig;
}
-/* Update coding->destination from coding->dst_object, and return how
- many bytes coding->destination was changed. */
+/* Set coding->destination from coding->dst_object. */
-static EMACS_INT
+static void
coding_set_destination (struct coding_system *coding)
{
- const unsigned char *orig = coding->destination;
-
if (BUFFERP (coding->dst_object))
{
if (BUFFERP (coding->src_object) && coding->src_pos < 0)
/* Otherwise, the destination is C string and is never relocated
automatically. Thus we don't have to update anything. */
}
+}
+
+
+/* Set coding->destination from coding->dst_object, and return how
+ many bytes coding->destination was changed. */
+
+static ptrdiff_t
+coding_change_destination (struct coding_system *coding)
+{
+ const unsigned char *orig = coding->destination;
+ coding_set_destination (coding);
return coding->destination - orig;
}
static void
-coding_alloc_by_realloc (struct coding_system *coding, EMACS_INT bytes)
+coding_alloc_by_realloc (struct coding_system *coding, ptrdiff_t bytes)
{
if (STRING_BYTES_BOUND - coding->dst_bytes < bytes)
string_overflow ();
- coding->destination = (unsigned char *) xrealloc (coding->destination,
- coding->dst_bytes + bytes);
+ coding->destination = xrealloc (coding->destination,
+ coding->dst_bytes + bytes);
coding->dst_bytes += bytes;
}
static void
coding_alloc_by_making_gap (struct coding_system *coding,
- EMACS_INT gap_head_used, EMACS_INT bytes)
+ ptrdiff_t gap_head_used, ptrdiff_t bytes)
{
if (EQ (coding->src_object, coding->dst_object))
{
consumed data at the tail. To preserve those data, we at
first make the gap size to zero, then increase the gap
size. */
- EMACS_INT add = GAP_SIZE;
+ ptrdiff_t add = GAP_SIZE;
GPT += gap_head_used, GPT_BYTE += gap_head_used;
GAP_SIZE = 0; ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add;
static unsigned char *
-alloc_destination (struct coding_system *coding, EMACS_INT nbytes,
+alloc_destination (struct coding_system *coding, ptrdiff_t nbytes,
unsigned char *dst)
{
- EMACS_INT offset = dst - coding->destination;
+ ptrdiff_t offset = dst - coding->destination;
if (BUFFERP (coding->dst_object))
{
/*** 3. UTF-8 ***/
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in UTF-8. If it is, return 1, else
- return 0. */
+ Return true if a text is encoded in UTF-8. */
#define UTF_8_1_OCTET_P(c) ((c) < 0x80)
#define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80)
#define UTF_8_BOM_2 0xBB
#define UTF_8_BOM_3 0xBF
-static int
+static bool
detect_coding_utf_8 (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
- int bom_found = 0;
- int found = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
+ bool bom_found = 0;
+ bool found = 0;
detect_info->checked |= CATEGORY_MASK_UTF_8;
/* A coding system of this category is always ASCII compatible. */
const unsigned char *src_base;
int *charbuf = coding->charbuf + coding->charbuf_used;
int *charbuf_end = coding->charbuf + coding->charbuf_size;
- EMACS_INT consumed_chars = 0, consumed_chars_base = 0;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base = 0;
+ bool multibytep = coding->src_multibyte;
enum utf_bom_type bom = CODING_UTF_8_BOM (coding);
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
if (bom != utf_without_bom)
}
-static int
+static bool
encode_coding_utf_8 (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
int c;
if (CODING_UTF_8_BOM (coding) == utf_with_bom)
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in one of UTF-16 based coding systems.
- If it is, return 1, else return 0. */
+ Return true if a text is encoded in one of UTF-16 based coding systems. */
#define UTF_16_HIGH_SURROGATE_P(val) \
(((val) & 0xFC00) == 0xD800)
(((val) & 0xFC00) == 0xDC00)
-static int
+static bool
detect_coding_utf_16 (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
+ bool multibytep = coding->src_multibyte;
int c1, c2;
detect_info->checked |= CATEGORY_MASK_UTF_16;
int *charbuf = coding->charbuf + coding->charbuf_used;
/* We may produces at most 3 chars in one loop. */
int *charbuf_end = coding->charbuf + coding->charbuf_size - 2;
- EMACS_INT consumed_chars = 0, consumed_chars_base = 0;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base = 0;
+ bool multibytep = coding->src_multibyte;
enum utf_bom_type bom = CODING_UTF_16_BOM (coding);
enum utf_16_endian_type endian = CODING_UTF_16_ENDIAN (coding);
int surrogate = CODING_UTF_16_SURROGATE (coding);
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr1 = -1, byte_after_cr2 = -1;
if (bom == utf_with_bom)
coding->charbuf_used = charbuf - coding->charbuf;
}
-static int
+static bool
encode_coding_utf_16 (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 8;
enum utf_bom_type bom = CODING_UTF_16_BOM (coding);
- int big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian;
- EMACS_INT produced_chars = 0;
+ bool big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian;
+ ptrdiff_t produced_chars = 0;
int c;
if (bom != utf_without_bom)
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in `emacs-mule'. If it is, return 1,
- else return 0. */
+ Return true if a text is encoded in 'emacs-mule'. */
-static int
+static bool
detect_coding_emacs_mule (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int c;
int found = 0;
{
const unsigned char *src_end = coding->source + coding->src_bytes;
const unsigned char *src_base = src;
- int multibytep = coding->src_multibyte;
+ bool multibytep = coding->src_multibyte;
int charset_ID;
unsigned code;
int c;
int consumed_chars = 0;
- int mseq_found = 0;
+ bool mseq_found = 0;
ONE_MORE_BYTE (c);
if (c < 0)
break;
default:
- abort ();
+ emacs_abort ();
}
CODING_DECODE_CHAR (coding, src, src_base, src_end,
CHARSET_FROM_ID (charset_ID), code, c);
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 3)
/* We can produce up to 2 characters in a loop. */
- 1;
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
struct composition_status *cmp_status = &coding->spec.emacs_mule.cmp_status;
int i;
if (charbuf_end - charbuf < cmp_status->length)
- abort ();
+ emacs_abort ();
for (i = 0; i < cmp_status->length; i++)
*charbuf++ = cmp_status->carryover[i];
coding->annotated = 1;
original pointer to buffer text, and fix up all related
pointers after the call. */
const unsigned char *orig = coding->source;
- EMACS_INT offset;
+ ptrdiff_t offset;
c = emacs_mule_char (coding, src_base, &nbytes, &nchars, &id,
cmp_status);
} while (0);
-static int
+static bool
encode_coding_emacs_mule (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 8;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, charset_list;
int c;
int preferred_charset_id = -1;
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)
preferred_charset_id = -1;
break;
default:
- abort ();
+ emacs_abort ();
}
charbuf += -c - 1;
continue;
if (preferred_charset_id >= 0)
{
- int result;
+ bool result;
charset = CHARSET_FROM_ID (preferred_charset_id);
CODING_CHAR_CHARSET_P (coding, dst, dst_end, c, charset, result);
Lisp_Object request;
Lisp_Object reg_usage;
Lisp_Object tail;
- int reg94, reg96;
+ EMACS_INT reg94, reg96;
int flags = XINT (AREF (attrs, coding_attr_iso_flags));
int max_charset_id;
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);
}
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in one of ISO-2022 based coding systems.
- If it is, return 1, else return 0. */
+ Return true if a text is encoded in one of ISO-2022 based coding
+ systems. */
-static int
+static bool
detect_coding_iso_2022 (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base = src;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- int single_shifting = 0;
+ bool multibytep = coding->src_multibyte;
+ bool single_shifting = 0;
int id;
int c, c1;
- EMACS_INT consumed_chars = 0;
+ ptrdiff_t consumed_chars = 0;
int i;
int rejected = 0;
int found = 0;
break;
check_extra_latin:
if (! VECTORP (Vlatin_extra_code_table)
- || NILP (XVECTOR (Vlatin_extra_code_table)->contents[c]))
+ || NILP (AREF (Vlatin_extra_code_table, c)))
{
rejected = CATEGORY_MASK_ISO;
break;
/* Finish the current composition as invalid. */
-static int finish_composition (int *, struct composition_status *);
-
static int
finish_composition (int *charbuf, struct composition_status *cmp_status)
{
loop and one more charset annotation at the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 3);
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
/* Charsets invoked to graphic plane 0 and 1 respectively. */
int charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
int charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
int c;
struct composition_status *cmp_status = CODING_ISO_CMP_STATUS (coding);
Lisp_Object attrs = CODING_ID_ATTRS (coding->id);
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
int i;
if (cmp_status->state != COMPOSING_NO)
{
if (charbuf_end - charbuf < cmp_status->length)
- abort ();
+ emacs_abort ();
for (i = 0; i < cmp_status->length; i++)
*charbuf++ = cmp_status->carryover[i];
coding->annotated = 1;
break;
default:
- abort ();
+ emacs_abort ();
}
if (cmp_status->state == COMPOSING_NO
#define ENCODE_ISO_CHARACTER(charset, c) \
do { \
- int code; \
+ unsigned code; \
CODING_ENCODE_CHAR (coding, dst, dst_end, (charset), (c), code); \
\
if (CHARSET_DIMENSION (charset) == 1) \
static unsigned char *
encode_invocation_designation (struct charset *charset,
struct coding_system *coding,
- unsigned char *dst, EMACS_INT *p_nchars)
+ unsigned char *dst, ptrdiff_t *p_nchars)
{
- int multibytep = coding->dst_multibyte;
- EMACS_INT produced_chars = *p_nchars;
+ bool multibytep = coding->dst_multibyte;
+ ptrdiff_t produced_chars = *p_nchars;
int reg; /* graphic register number */
int id = CHARSET_ID (charset);
If the current block ends before any end-of-line, we may fail to
find all the necessary designations. */
-static EMACS_INT
+static ptrdiff_t
encode_designation_at_bol (struct coding_system *coding,
int *charbuf, int *charbuf_end,
unsigned char *dst)
/* Table of charsets to be designated to each graphic register. */
int r[4];
int c, found = 0, reg;
- EMACS_INT produced_chars = 0;
- int multibytep = coding->dst_multibyte;
+ ptrdiff_t produced_chars = 0;
+ bool multibytep = coding->dst_multibyte;
Lisp_Object attrs;
Lisp_Object charset_list;
/* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions". */
-static int
+static bool
encode_coding_iso_2022 (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 16;
- int bol_designation
+ bool bol_designation
= (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL
&& CODING_ISO_BOL (coding));
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, eol_type, charset_list;
- int ascii_compatible;
+ bool ascii_compatible;
int c;
int preferred_charset_id = -1;
/* We have to produce designation sequences if any now. */
unsigned char desig_buf[16];
int nbytes;
- EMACS_INT offset;
+ ptrdiff_t offset;
charset_map_loaded = 0;
nbytes = encode_designation_at_bol (coding, charbuf, charbuf_end,
desig_buf);
if (charset_map_loaded
- && (offset = coding_set_destination (coding)))
+ && (offset = coding_change_destination (coding)))
{
dst += offset;
dst_end += offset;
preferred_charset_id = -1;
break;
default:
- abort ();
+ emacs_abort ();
}
charbuf += -c - 1;
continue;
CODING_ISO_DESIGNATION (coding, i)
= CODING_ISO_INITIAL (coding, i);
}
- bol_designation
- = CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL;
+ bol_designation = ((CODING_ISO_FLAGS (coding)
+ & CODING_ISO_FLAG_DESIGNATE_AT_BOL)
+ != 0);
}
else if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_CNTL)
ENCODE_RESET_PLANE_AND_REGISTER ();
if (preferred_charset_id >= 0)
{
- int result;
+ bool result;
charset = CHARSET_FROM_ID (preferred_charset_id);
CODING_CHAR_CHARSET_P (coding, dst, dst_end, c, charset, result);
*/
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in SJIS. If it is, return
- CATEGORY_MASK_SJIS, else return 0. */
+ Return true if a text is encoded in SJIS. */
-static int
+static bool
detect_coding_sjis (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int found = 0;
int c;
Lisp_Object attrs, charset_list;
}
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in BIG5. If it is, return
- CATEGORY_MASK_BIG5, else return 0. */
+ Return true if a text is encoded in BIG5. */
-static int
+static bool
detect_coding_big5 (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int found = 0;
int c;
return 1;
}
-/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
- If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */
+/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
static void
decode_coding_sjis (struct coding_system *coding)
the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
struct charset *charset_roman, *charset_kanji, *charset_kana;
struct charset *charset_kanji2;
Lisp_Object attrs, charset_list, val;
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
CODING_GET_INFO (coding, attrs, charset_list);
the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
struct charset *charset_roman, *charset_big5;
Lisp_Object attrs, charset_list, val;
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
CODING_GET_INFO (coding, attrs, charset_list);
`japanese-jisx0208', `chinese-big5-1', and `chinese-big5-2'. We
are sure that all these charsets are registered as official charset
(i.e. do not have extended leading-codes). Characters of other
- charsets are produced without any encoding. If SJIS_P is 1, encode
- SJIS text, else encode BIG5 text. */
+ charsets are produced without any encoding. */
-static int
+static bool
encode_coding_sjis (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 4;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, charset_list, val;
- int ascii_compatible;
+ bool ascii_compatible;
struct charset *charset_kanji, *charset_kana;
struct charset *charset_kanji2;
int c;
}
}
if (code == CHARSET_INVALID_CODE (charset))
- abort ();
+ emacs_abort ();
if (charset == charset_kanji)
{
int c1, c2;
return 0;
}
-static int
+static bool
encode_coding_big5 (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 4;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, charset_list, val;
- int ascii_compatible;
+ bool ascii_compatible;
struct charset *charset_big5;
int c;
}
}
if (code == CHARSET_INVALID_CODE (charset))
- abort ();
+ emacs_abort ();
if (charset == charset_big5)
{
int c1, c2;
/*** 10. CCL handlers ***/
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in a coding system of which
- encoder/decoder are written in CCL program. If it is, return
- CATEGORY_MASK_CCL, else return 0. */
+ Return true if a text is encoded in a coding system of which
+ encoder/decoder are written in CCL program. */
-static int
+static bool
detect_coding_ccl (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
int found = 0;
unsigned char *valids;
- EMACS_INT head_ascii = coding->head_ascii;
+ ptrdiff_t head_ascii = coding->head_ascii;
Lisp_Object attrs;
detect_info->checked |= CATEGORY_MASK_CCL;
const unsigned char *src_end = coding->source + coding->src_bytes;
int *charbuf = coding->charbuf + coding->charbuf_used;
int *charbuf_end = coding->charbuf + coding->charbuf_size;
- EMACS_INT consumed_chars = 0;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
struct ccl_program *ccl = &coding->spec.ccl->ccl;
int source_charbuf[1024];
int source_byteidx[1025];
coding->charbuf_used = charbuf - coding->charbuf;
}
-static int
+static bool
encode_coding_ccl (struct coding_system *coding)
{
struct ccl_program *ccl = &coding->spec.ccl->ccl;
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int destination_charbuf[1024];
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
int i;
Lisp_Object attrs, charset_list;
return 0;
}
-
\f
/*** 10, 11. no-conversion handlers ***/
static void
decode_coding_raw_text (struct coding_system *coding)
{
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
coding->chars_at_source = 1;
coding->consumed_char = coding->src_chars;
record_conversion_result (coding, CODING_RESULT_SUCCESS);
}
-static int
+static bool
encode_coding_raw_text (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = coding->charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
int c;
if (multibytep)
}
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in a charset-based coding system. If it
- is, return 1, else return 0. */
+ Return true if a text is encoded in a charset-based coding system. */
-static int
+static bool
detect_coding_charset (struct coding_system *coding,
struct coding_detection_info *detect_info)
{
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
- int multibytep = coding->src_multibyte;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0;
Lisp_Object attrs, valids, name;
int found = 0;
- EMACS_INT head_ascii = coding->head_ascii;
- int check_latin_extra = 0;
+ ptrdiff_t head_ascii = coding->head_ascii;
+ bool check_latin_extra = 0;
detect_info->checked |= CATEGORY_MASK_CHARSET;
if (c < 0xA0
&& check_latin_extra
&& (!VECTORP (Vlatin_extra_code_table)
- || NILP (XVECTOR (Vlatin_extra_code_table)->contents[c])))
+ || NILP (AREF (Vlatin_extra_code_table, c))))
break;
found = CATEGORY_MASK_CHARSET;
}
the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
- EMACS_INT consumed_chars = 0, consumed_chars_base;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t consumed_chars = 0, consumed_chars_base;
+ bool multibytep = coding->src_multibyte;
Lisp_Object attrs = CODING_ID_ATTRS (coding->id);
Lisp_Object valids;
- EMACS_INT char_offset = coding->produced_char;
- EMACS_INT last_offset = char_offset;
+ ptrdiff_t char_offset = coding->produced_char;
+ ptrdiff_t last_offset = char_offset;
int last_id = charset_ascii;
- int eol_dos =
- !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
+ bool eol_dos
+ = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
int byte_after_cr = -1;
valids = AREF (attrs, coding_attr_charset_valids);
coding->charbuf_used = charbuf - coding->charbuf;
}
-static int
+static bool
encode_coding_charset (struct coding_system *coding)
{
- int multibytep = coding->dst_multibyte;
+ bool multibytep = coding->dst_multibyte;
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = MAX_MULTIBYTE_LENGTH;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced_chars = 0;
Lisp_Object attrs, charset_list;
- int ascii_compatible;
+ bool ascii_compatible;
int c;
CODING_GET_INFO (coding, attrs, charset_list);
coding->encoder = encode_coding_emacs_mule;
coding->common_flags
|= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
- coding->spec.emacs_mule.full_support = 1;
if (! NILP (AREF (attrs, coding_attr_emacs_mule_full))
&& ! EQ (CODING_ATTR_CHARSET_LIST (attrs), Vemacs_mule_charset_list))
{
SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
coding->max_charset_id = max_charset_id;
coding->safe_charsets = SDATA (safe_charsets);
- coding->spec.emacs_mule.full_support = 1;
}
coding->spec.emacs_mule.cmp_status.state = COMPOSING_NO;
coding->spec.emacs_mule.cmp_status.method = COMPOSITION_NO;
#define MAX_EOL_CHECK_COUNT 3
static int
-detect_eol (const unsigned char *source, EMACS_INT src_bytes,
+detect_eol (const unsigned char *source, ptrdiff_t src_bytes,
enum coding_category category)
{
const unsigned char *src = source, *src_end = src + src_bytes;
if ((1 << category) & CATEGORY_MASK_UTF_16)
{
- int msb, lsb;
-
- msb = category == (coding_category_utf_16_le
- | coding_category_utf_16_le_nosig);
- lsb = 1 - msb;
+ bool msb = category == (coding_category_utf_16_le
+ | coding_category_utf_16_le_nosig);
+ bool lsb = !msb;
while (src + 1 < src_end)
{
detect_coding (struct coding_system *coding)
{
const unsigned char *src, *src_end;
- int saved_mode = coding->mode;
+ unsigned int saved_mode = coding->mode;
coding->consumed = coding->consumed_char = 0;
coding->produced = coding->produced_char = 0;
{
int c, i;
struct coding_detection_info detect_info;
- int null_byte_found = 0, eight_bit_found = 0;
+ bool null_byte_found = 0, eight_bit_found = 0;
detect_info.checked = detect_info.found = detect_info.rejected = 0;
for (src = coding->source; src < src_end; src++)
}
else if (EQ (eol_type, Qdos))
{
- EMACS_INT n = 0;
+ ptrdiff_t n = 0;
if (NILP (coding->dst_object))
{
}
else
{
- EMACS_INT pos_byte = coding->dst_pos_byte;
- EMACS_INT pos = coding->dst_pos;
- EMACS_INT pos_end = pos + coding->produced_char - 1;
+ ptrdiff_t pos_byte = coding->dst_pos_byte;
+ ptrdiff_t pos = coding->dst_pos;
+ ptrdiff_t pos_end = pos + coding->produced_char - 1;
while (pos < pos_end)
{
/* Return a translation table (or list of them) from coding system
- attribute vector ATTRS for encoding (ENCODEP is nonzero) or
- decoding (ENCODEP is zero). */
+ attribute vector ATTRS for encoding (if ENCODEP) or decoding (if
+ not ENCODEP). */
static Lisp_Object
-get_translation_table (Lisp_Object attrs, int encodep, int *max_lookup)
+get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup)
{
Lisp_Object standard, translation_table;
Lisp_Object val;
{
Lisp_Object val = XCAR (trans);
Lisp_Object from = XCAR (val);
- int len = ASIZE (from);
- int i;
+ ptrdiff_t len = ASIZE (from);
+ ptrdiff_t i;
for (i = 0; i < len; i++)
{
static int
produce_chars (struct coding_system *coding, Lisp_Object translation_table,
- int last_block)
+ bool last_block)
{
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
- EMACS_INT produced;
- EMACS_INT produced_chars = 0;
+ ptrdiff_t produced;
+ ptrdiff_t produced_chars = 0;
int carryover = 0;
if (! coding->chars_at_source)
while (buf < buf_end)
{
- int c = *buf, i;
+ int c = *buf;
+ ptrdiff_t i;
if (c >= 0)
{
- EMACS_INT from_nchars = 1, to_nchars = 1;
+ ptrdiff_t from_nchars = 1, to_nchars = 1;
Lisp_Object trans = Qnil;
LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);
{
if (coding->src_multibyte)
{
- int multibytep = 1;
- EMACS_INT consumed_chars = 0;
+ bool multibytep = 1;
+ ptrdiff_t consumed_chars = 0;
while (1)
{
dst_end = (unsigned char *) src;
if (dst == dst_end)
{
- EMACS_INT offset = src - coding->source;
+ ptrdiff_t offset = src - coding->source;
dst = alloc_destination (coding, src_end - src + 1,
dst);
else
while (src < src_end)
{
- int multibytep = 1;
+ bool multibytep = 1;
int c = *src++;
if (dst >= dst_end - 1)
dst_end = (unsigned char *) src;
if (dst >= dst_end - 1)
{
- EMACS_INT offset = src - coding->source;
- EMACS_INT more_bytes;
+ ptrdiff_t offset = src - coding->source;
+ ptrdiff_t more_bytes;
if (EQ (coding->src_object, coding->dst_object))
more_bytes = ((src_end - src) / 2) + 2;
{
if (!EQ (coding->src_object, coding->dst_object))
{
- EMACS_INT require = coding->src_bytes - coding->dst_bytes;
+ ptrdiff_t require = coding->src_bytes - coding->dst_bytes;
if (require > 0)
{
- EMACS_INT offset = src - coding->source;
+ ptrdiff_t offset = src - coding->source;
dst = alloc_destination (coding, require, dst);
coding_set_source (coding);
*/
static inline void
-produce_composition (struct coding_system *coding, int *charbuf, EMACS_INT pos)
+produce_composition (struct coding_system *coding, int *charbuf, ptrdiff_t pos)
{
int len;
- EMACS_INT to;
+ ptrdiff_t to;
enum composition_method method;
Lisp_Object components;
*/
static inline void
-produce_charset (struct coding_system *coding, int *charbuf, EMACS_INT pos)
+produce_charset (struct coding_system *coding, int *charbuf, ptrdiff_t pos)
{
- EMACS_INT from = pos - charbuf[2];
+ ptrdiff_t from = pos - charbuf[2];
struct charset *charset = CHARSET_FROM_ID (charbuf[3]);
Fput_text_property (make_number (from), make_number (pos),
coding->charbuf = NULL; \
while (size > 1024) \
{ \
- coding->charbuf = (int *) alloca (sizeof (int) * size); \
+ coding->charbuf = alloca (sizeof (int) * size); \
if (coding->charbuf) \
break; \
size >>= 1; \
if (! coding->charbuf) \
{ \
record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_MEM); \
- return coding->result; \
+ return; \
} \
coding->charbuf_size = size; \
} while (0)
static void
-produce_annotation (struct coding_system *coding, EMACS_INT pos)
+produce_annotation (struct coding_system *coding, ptrdiff_t pos)
{
int *charbuf = coding->charbuf;
int *charbuf_end = charbuf + coding->charbuf_used;
CODING->dst_object.
*/
-static int
+static void
decode_coding (struct coding_system *coding)
{
Lisp_Object attrs;
undo_list = Qt;
if (BUFFERP (coding->dst_object))
{
- if (current_buffer != XBUFFER (coding->dst_object))
- set_buffer_internal (XBUFFER (coding->dst_object));
+ 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_undo_list (current_buffer, Qt);
}
coding->consumed = coding->consumed_char = 0;
}
do
{
- EMACS_INT pos = coding->dst_pos + coding->produced_char;
+ ptrdiff_t pos = coding->dst_pos + coding->produced_char;
coding_set_source (coding);
coding->annotated = 0;
decode_eol (coding);
if (BUFFERP (coding->dst_object))
{
- BVAR (current_buffer, undo_list) = undo_list;
+ bset_undo_list (current_buffer, undo_list);
record_insert (coding->dst_pos, coding->produced_char);
}
- return coding->result;
}
return BUF. */
static inline int *
-handle_composition_annotation (EMACS_INT pos, EMACS_INT limit,
+handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit,
struct coding_system *coding, int *buf,
- EMACS_INT *stop)
+ ptrdiff_t *stop)
{
- EMACS_INT start, end;
+ ptrdiff_t start, end;
Lisp_Object prop;
if (! find_composition (pos, limit, &start, &end, &prop, coding->src_object)
if (method != COMPOSITION_RELATIVE)
{
Lisp_Object components;
- int len, i, i_byte;
+ ptrdiff_t i, len, i_byte;
components = COMPOSITION_COMPONENTS (prop);
if (VECTORP (components))
*buf++ = XINT (XCAR (components));
}
else
- abort ();
+ emacs_abort ();
*head -= len;
}
}
property value is non-nil (limiting by LIMIT), and return BUF. */
static inline int *
-handle_charset_annotation (EMACS_INT pos, EMACS_INT limit,
+handle_charset_annotation (ptrdiff_t pos, ptrdiff_t limit,
struct coding_system *coding, int *buf,
- EMACS_INT *stop)
+ ptrdiff_t *stop)
{
Lisp_Object val, next;
int id;
int *buf_end = coding->charbuf + coding->charbuf_size;
const unsigned char *src = coding->source + coding->consumed;
const unsigned char *src_end = coding->source + coding->src_bytes;
- EMACS_INT pos = coding->src_pos + coding->consumed_char;
- EMACS_INT end_pos = coding->src_pos + coding->src_chars;
- int multibytep = coding->src_multibyte;
+ ptrdiff_t pos = coding->src_pos + coding->consumed_char;
+ ptrdiff_t end_pos = coding->src_pos + coding->src_chars;
+ bool multibytep = coding->src_multibyte;
Lisp_Object eol_type;
int c;
- EMACS_INT stop, stop_composition, stop_charset;
+ ptrdiff_t stop, stop_composition, stop_charset;
int *lookup_buf = NULL;
if (! NILP (translation_table))
if (! multibytep)
{
- EMACS_INT bytes;
+ int bytes;
if (coding->encoder == encode_coding_raw_text
|| coding->encoder == encode_coding_ccl)
*buf++ = c;
else
{
- int from_nchars = 1, to_nchars = 1;
+ ptrdiff_t from_nchars = 1, to_nchars = 1;
int *lookup_buf_end;
const unsigned char *p = src;
int i;
else
{
to_nchars = ASIZE (trans);
- if (buf + to_nchars > buf_end)
+ if (buf_end - buf < to_nchars)
break;
c = XINT (AREF (trans, 0));
}
If CODING->dst_object is nil, the encoded data is placed at the
memory area specified by CODING->destination. */
-static int
+static void
encode_coding (struct coding_system *coding)
{
Lisp_Object attrs;
if (BUFFERP (coding->dst_object) && coding->produced_char > 0)
insert_from_gap (coding->produced_char, coding->produced);
-
- return (coding->result);
}
versions of Vcode_conversion_workbuf_name. */
static Lisp_Object Vcode_conversion_reused_workbuf;
-/* 1 iff Vcode_conversion_reused_workbuf is already in use. */
-static int reused_workbuf_in_use;
+/* True iff Vcode_conversion_reused_workbuf is already in use. */
+static bool reused_workbuf_in_use;
/* Return a working buffer of code conversion. MULTIBYTE specifies the
multibyteness of returning buffer. */
static Lisp_Object
-make_conversion_work_buffer (int multibyte)
+make_conversion_work_buffer (bool multibyte)
{
Lisp_Object name, workbuf;
struct buffer *current;
- if (reused_workbuf_in_use++)
+ if (reused_workbuf_in_use)
{
name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil);
workbuf = Fget_buffer_create (name);
}
else
{
+ reused_workbuf_in_use = 1;
if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf)))
Vcode_conversion_reused_workbuf
= Fget_buffer_create (Vcode_conversion_workbuf_name);
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_undo_list (current_buffer, Qt);
+ bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil);
set_buffer_internal (current);
return workbuf;
}
{
if (EQ (workbuf, Vcode_conversion_reused_workbuf))
reused_workbuf_in_use = 0;
- else if (! NILP (Fbuffer_live_p (workbuf)))
+ else
Fkill_buffer (workbuf);
}
set_buffer_internal (XBUFFER (current));
}
Lisp_Object
-code_conversion_save (int with_work_buf, int multibyte)
+code_conversion_save (bool with_work_buf, bool multibyte)
{
Lisp_Object workbuf = Qnil;
return workbuf;
}
-int
+void
decode_coding_gap (struct coding_system *coding,
- EMACS_INT chars, EMACS_INT bytes)
+ ptrdiff_t chars, ptrdiff_t bytes)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object attrs;
code_conversion_save (0, 0);
attrs = CODING_ID_ATTRS (coding->id);
if (! NILP (CODING_ATTR_POST_READ (attrs)))
{
- EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
+ ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE;
Lisp_Object val;
TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
}
unbind_to (count, Qnil);
- return coding->result;
}
void
decode_coding_object (struct coding_system *coding,
Lisp_Object src_object,
- EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte,
+ ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte,
Lisp_Object dst_object)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
unsigned char *destination IF_LINT (= NULL);
- EMACS_INT dst_bytes IF_LINT (= 0);
- EMACS_INT chars = to - from;
- EMACS_INT bytes = to_byte - from_byte;
+ ptrdiff_t dst_bytes IF_LINT (= 0);
+ ptrdiff_t chars = to - from;
+ ptrdiff_t bytes = to_byte - from_byte;
Lisp_Object attrs;
- int saved_pt = -1, saved_pt_byte IF_LINT (= 0);
- int need_marker_adjustment = 0;
+ ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0);
+ bool need_marker_adjustment = 0;
Lisp_Object old_deactivate_mark;
old_deactivate_mark = Vdeactivate_mark;
if (! NILP (CODING_ATTR_POST_READ (attrs)))
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
+ ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE;
Lisp_Object val;
TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
void
encode_coding_object (struct coding_system *coding,
Lisp_Object src_object,
- EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte,
+ ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte,
Lisp_Object dst_object)
{
- int count = SPECPDL_INDEX ();
- EMACS_INT chars = to - from;
- EMACS_INT bytes = to_byte - from_byte;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t chars = to - from;
+ ptrdiff_t bytes = to_byte - from_byte;
Lisp_Object attrs;
- int saved_pt = -1, saved_pt_byte IF_LINT (= 0);
- int need_marker_adjustment = 0;
- int kill_src_buffer = 0;
+ ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0);
+ bool need_marker_adjustment = 0;
+ bool kill_src_buffer = 0;
Lisp_Object old_deactivate_mark;
old_deactivate_mark = Vdeactivate_mark;
}
{
- Lisp_Object args[3];
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
GCPRO5 (coding->src_object, coding->dst_object, src_object, dst_object,
old_deactivate_mark);
- args[0] = CODING_ATTR_PRE_WRITE (attrs);
- args[1] = make_number (BEG);
- args[2] = make_number (Z);
- safe_call (3, args);
+ safe_call2 (CODING_ATTR_PRE_WRITE (attrs),
+ make_number (BEG), make_number (Z));
UNGCPRO;
}
if (XBUFFER (coding->src_object) != current_buffer)
{
ptrdiff_t dst_bytes = max (1, coding->src_chars);
coding->dst_object = Qnil;
- coding->destination = (unsigned char *) xmalloc (dst_bytes);
+ coding->destination = xmalloc (dst_bytes);
coding->dst_bytes = dst_bytes;
coding->dst_multibyte = 0;
}
(Lisp_Object prompt, Lisp_Object default_coding_system)
{
Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (SYMBOLP (default_coding_system))
default_coding_system = SYMBOL_NAME (default_coding_system);
\f
/* Detect how the bytes at SRC of length SRC_BYTES are encoded. If
- HIGHEST is nonzero, return the coding system of the highest
+ HIGHEST, return the coding system of the highest
priority among the detected coding systems. Otherwise return a
list of detected coding systems sorted by their priorities. If
- MULTIBYTEP is nonzero, it is assumed that the bytes are in correct
+ MULTIBYTEP, it is assumed that the bytes are in correct
multibyte form but contains only ASCII and eight-bit chars.
Otherwise, the bytes are raw bytes.
Lisp_Object
detect_coding_system (const unsigned char *src,
- EMACS_INT src_chars, EMACS_INT src_bytes,
- int highest, int multibytep,
+ ptrdiff_t src_chars, ptrdiff_t src_bytes,
+ bool highest, bool multibytep,
Lisp_Object coding_system)
{
const unsigned char *src_end = src + src_bytes;
ptrdiff_t id;
struct coding_detection_info detect_info;
enum coding_category base_category;
- int null_byte_found = 0, eight_bit_found = 0;
+ bool null_byte_found = 0, eight_bit_found = 0;
if (NILP (coding_system))
coding_system = Qundecided;
highest priority. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object highest)
{
- int from, to;
- int from_byte, to_byte;
+ ptrdiff_t from, to;
+ ptrdiff_t from_byte, to_byte;
CHECK_NUMBER_COERCE_MARKER (start);
CHECK_NUMBER_COERCE_MARKER (end);
}
-static inline int
+static inline bool
char_encodable_p (int c, Lisp_Object attrs)
{
Lisp_Object tail;
(Lisp_Object start, Lisp_Object end, Lisp_Object exclude)
{
Lisp_Object coding_attrs_list, safe_codings;
- EMACS_INT start_byte, end_byte;
+ ptrdiff_t start_byte, end_byte;
const unsigned char *p, *pbeg, *pend;
int c;
Lisp_Object tail, elt, work_table;
}
if (charset_map_loaded)
{
- EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
+ ptrdiff_t p_offset = p - pbeg, pend_offset = pend - pbeg;
if (STRINGP (start))
pbeg = SDATA (start);
to the string. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object count, Lisp_Object string)
{
- int n;
+ EMACS_INT n;
struct coding_system coding;
Lisp_Object attrs, charset_list, translation_table;
Lisp_Object positions;
- int from, to;
+ ptrdiff_t from, to;
const unsigned char *p, *stop, *pend;
- int ascii_compatible;
+ bool ascii_compatible;
setup_coding_system (Fcheck_coding_system (coding_system), &coding);
attrs = CODING_ID_ATTRS (coding.id);
CHECK_STRING (string);
CHECK_NATNUM (start);
CHECK_NATNUM (end);
+ if (! (XINT (start) <= XINT (end) && XINT (end) <= SCHARS (string)))
+ args_out_of_range_3 (string, start, end);
from = XINT (start);
to = XINT (end);
- if (from > to
- || to > SCHARS (string))
- args_out_of_range_3 (string, start, end);
if (! STRING_MULTIBYTE (string))
return Qnil;
p = SDATA (string) + string_char_to_byte (string, from);
(Lisp_Object start, Lisp_Object end, Lisp_Object coding_system_list)
{
Lisp_Object list;
- EMACS_INT start_byte, end_byte;
- int pos;
+ ptrdiff_t start_byte, end_byte;
+ ptrdiff_t pos;
const unsigned char *p, *pbeg, *pend;
int c;
Lisp_Object tail, elt, attrs;
}
if (charset_map_loaded)
{
- EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
+ ptrdiff_t p_offset = p - pbeg, pend_offset = pend - pbeg;
if (STRINGP (start))
pbeg = SDATA (start);
static Lisp_Object
code_convert_region (Lisp_Object start, Lisp_Object end,
Lisp_Object coding_system, Lisp_Object dst_object,
- int encodep, int norecord)
+ bool encodep, bool norecord)
{
struct coding_system coding;
- EMACS_INT from, from_byte, to, to_byte;
+ ptrdiff_t from, from_byte, to, to_byte;
Lisp_Object src_object;
CHECK_NUMBER_COERCE_MARKER (start);
Lisp_Object
code_convert_string (Lisp_Object string, Lisp_Object coding_system,
- Lisp_Object dst_object, int encodep, int nocopy, int norecord)
+ Lisp_Object dst_object, bool encodep, bool nocopy,
+ bool norecord)
{
struct coding_system coding;
- EMACS_INT chars, bytes;
+ ptrdiff_t chars, bytes;
CHECK_STRING (string);
if (NILP (coding_system))
Lisp_Object
code_convert_string_norecord (Lisp_Object string, Lisp_Object coding_system,
- int encodep)
+ bool encodep)
{
return code_convert_string (string, coding_system, Qt, encodep, 0, 1);
}
terminal_coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
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);
- else
- term->charset_list = Fcons (make_number (charset_ascii), Qnil);
+ tset_charset_list
+ (term, (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK
+ ? coding_charset_list (terminal_coding)
+ : Fcons (make_number (charset_ascii), Qnil)));
return Qnil;
}
error ("Too few arguments");
operation = args[0];
if (!SYMBOLP (operation)
- || !NATNUMP (target_idx = Fget (operation, Qtarget_idx)))
+ || (target_idx = Fget (operation, Qtarget_idx), !NATNUMP (target_idx)))
error ("Invalid first argument");
- if (nargs < 1 + XFASTINT (target_idx))
+ if (nargs <= 1 + XFASTINT (target_idx))
error ("Too few arguments for operation `%s'",
SDATA (SYMBOL_NAME (operation)));
target = args[XFASTINT (target_idx) + 1];
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t i, j;
- int changed[coding_category_max];
+ bool changed[coding_category_max];
enum coding_category priorities[coding_category_max];
memset (changed, 0, sizeof changed);
&& changed[coding_priorities[j]])
j++;
if (j == coding_category_max)
- abort ();
+ emacs_abort ();
priorities[i] = coding_priorities[j];
}
{
Lisp_Object subsidiaries;
ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base));
- char *buf = (char *) alloca (base_name_len + 6);
+ char *buf = alloca (base_name_len + 6);
int i;
memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len);
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))
charset_list = Vemacs_mule_charset_list;
}
for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
- if (max_charset_id < XFASTINT (XCAR (tail)))
- max_charset_id = XFASTINT (XCAR (tail));
+ {
+ if (! RANGED_INTEGERP (0, XCAR (tail), INT_MAX - 1))
+ error ("Invalid charset-list");
+ if (max_charset_id < XFASTINT (XCAR (tail)))
+ max_charset_id = XFASTINT (XCAR (tail));
+ }
}
else
{
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))
{
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++)
val = args[coding_arg_ccl_valids];
valids = Fmake_string (make_number (256), make_number (0));
- for (tail = val; !NILP (tail); tail = Fcdr (tail))
+ for (tail = val; CONSP (tail); tail = XCDR (tail))
{
int from, to;
- val = Fcar (tail);
+ val = XCAR (tail);
if (INTEGERP (val))
{
- from = to = XINT (val);
- if (from < 0 || from > 255)
+ if (! (0 <= XINT (val) && XINT (val) <= 255))
args_out_of_range_3 (val, make_number (0), make_number (255));
+ from = to = XINT (val);
}
else
{
CHECK_CONS (val);
CHECK_NATNUM_CAR (val);
- CHECK_NATNUM_CDR (val);
- from = XINT (XCAR (val));
- if (from > 255)
+ CHECK_NUMBER_CDR (val);
+ if (XINT (XCAR (val)) > 255)
args_out_of_range_3 (XCAR (val),
make_number (0), make_number (255));
- to = XINT (XCDR (val));
- if (to < from || to > 255)
+ from = XINT (XCAR (val));
+ if (! (from <= XINT (XCDR (val)) && XINT (XCDR (val)) <= 255))
args_out_of_range_3 (XCDR (val),
XCAR (val), make_number (255));
+ to = XINT (XCDR (val));
}
for (i = from; i <= to; i++)
SSET (valids, i, 1);
{
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;
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));
CHECK_NUMBER_CDR (reg_usage);
request = Fcopy_sequence (args[coding_arg_iso2022_request]);
- for (tail = request; ! NILP (tail); tail = Fcdr (tail))
+ for (tail = request; CONSP (tail); tail = XCDR (tail))
{
int id;
Lisp_Object tmp1;
- val = Fcar (tail);
+ val = XCAR (tail);
CHECK_CONS (val);
tmp1 = XCAR (val);
CHECK_CHARSET_GET_ID (tmp1, id);
flags = args[coding_arg_iso2022_flags];
CHECK_NATNUM (flags);
- i = XINT (flags);
+ i = XINT (flags) & INT_MAX;
if (EQ (args[coding_arg_charset_list], Qiso_2022))
- flags = make_number (i | CODING_ISO_FLAG_FULL_SUPPORT);
+ i |= CODING_ISO_FLAG_FULL_SUPPORT;
+ flags = make_number (i);
ASET (attrs, coding_attr_iso_initial, initial);
ASET (attrs, coding_attr_iso_usage, reg_usage);
}
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))
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)));
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)));
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))
{
}
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
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)
{
if (! STRINGP (val))
CHECK_CHARACTER (val);
- CODING_ATTR_MNEMONIC (attrs) = val;
+ ASET (attrs, coding_attr_mnemonic, val);
}
else if (EQ (prop, QCdefault_char))
{
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;
}
Vcode_conversion_reused_workbuf = Qnil;
staticpro (&Vcode_conversion_workbuf_name);
- Vcode_conversion_workbuf_name = make_pure_c_string (" *code-conversion-work*");
+ Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*");
reused_workbuf_in_use = 0;
DEFSYM (Qcoding_system_error, "coding-system-error");
Fput (Qcoding_system_error, Qerror_conditions,
- pure_cons (Qcoding_system_error, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qcoding_system_error, Qerror));
Fput (Qcoding_system_error, Qerror_message,
- make_pure_c_string ("Invalid coding system"));
+ build_pure_c_string ("Invalid coding system"));
/* Intern this now in case it isn't already done.
Setting this variable twice is harmless.
Vcoding_category_list = Qnil;
for (i = coding_category_max - 1; i >= 0; i--)
Vcoding_category_list
- = Fcons (XVECTOR (Vcoding_category_table)->contents[i],
+ = Fcons (AREF (Vcoding_category_table, i),
Vcoding_category_list);
}
DEFVAR_LISP ("eol-mnemonic-unix", eol_mnemonic_unix,
doc: /*
*String displayed in mode line for UNIX-like (LF) end-of-line format. */);
- eol_mnemonic_unix = make_pure_c_string (":");
+ eol_mnemonic_unix = build_pure_c_string (":");
DEFVAR_LISP ("eol-mnemonic-dos", eol_mnemonic_dos,
doc: /*
*String displayed in mode line for DOS-like (CRLF) end-of-line format. */);
- eol_mnemonic_dos = make_pure_c_string ("\\");
+ eol_mnemonic_dos = build_pure_c_string ("\\");
DEFVAR_LISP ("eol-mnemonic-mac", eol_mnemonic_mac,
doc: /*
*String displayed in mode line for MAC-like (CR) end-of-line format. */);
- eol_mnemonic_mac = make_pure_c_string ("/");
+ eol_mnemonic_mac = build_pure_c_string ("/");
DEFVAR_LISP ("eol-mnemonic-undecided", eol_mnemonic_undecided,
doc: /*
*String displayed in mode line when end-of-line format is not yet determined. */);
- eol_mnemonic_undecided = make_pure_c_string (":");
+ eol_mnemonic_undecided = build_pure_c_string (":");
DEFVAR_LISP ("enable-character-translation", Venable_character_translation,
doc: /*
plist[10] = intern_c_string (":for-unibyte");
plist[11] = args[coding_arg_for_unibyte] = Qt;
plist[12] = intern_c_string (":docstring");
- plist[13] = make_pure_c_string ("Do no conversion.\n\
+ plist[13] = build_pure_c_string ("Do no conversion.\n\
\n\
When you visit a file with this coding, the file is read into a\n\
unibyte buffer as is, thus each byte of a file is treated as a\n\
plist[8] = intern_c_string (":charset-list");
plist[9] = args[coding_arg_charset_list] = Fcons (Qascii, Qnil);
plist[11] = args[coding_arg_for_unibyte] = Qnil;
- plist[13] = make_pure_c_string ("No conversion on encoding, automatic conversion on decoding.");
+ plist[13] = build_pure_c_string ("No conversion on encoding, automatic conversion on decoding.");
plist[15] = args[coding_arg_eol_type] = Qnil;
args[coding_arg_plist] = Flist (16, plist);
Fdefine_coding_system_internal (coding_arg_max, args);
#define CODING_ATTR_PRE_WRITE(attrs) AREF (attrs, coding_attr_pre_write)
#define CODING_ATTR_DEFAULT_CHAR(attrs) AREF (attrs, coding_attr_default_char)
#define CODING_ATTR_FOR_UNIBYTE(attrs) AREF (attrs, coding_attr_for_unibyte)
-#define CODING_ATTR_FLUSHING(attrs) AREF (attrs, coding_attr_flushing)
#define CODING_ATTR_PLIST(attrs) AREF (attrs, coding_attr_plist)
#define CODING_ATTR_CATEGORY(attrs) AREF (attrs, coding_attr_category)
#define CODING_ATTR_SAFE_CHARSETS(attrs)AREF (attrs, coding_attr_safe_charsets)
{
enum composition_state state;
enum composition_method method;
- int old_form; /* 0:pre-21 form, 1:post-21 form */
+ bool old_form; /* true if pre-21 form */
int length; /* number of elements produced in charbuf */
int nchars; /* number of characters composed */
int ncomps; /* number of composition components */
there was an invalid designation previously. */
int current_designation[4];
- /* Set to 1 temporarily only when graphic register 2 or 3 is invoked
- by single-shift while encoding. */
- int single_shifting;
-
- /* Set to 1 temporarily only when processing at beginning of line. */
- int bol;
-
/* If positive, we are now scanning CTEXT extended segment. */
int ctext_extended_segment_len;
- /* If nonzero, we are now scanning embedded UTF-8 sequence. */
- int embedded_utf_8;
+ /* True temporarily only when graphic register 2 or 3 is invoked by
+ single-shift while encoding. */
+ unsigned single_shifting : 1;
+
+ /* True temporarily only when processing at beginning of line. */
+ unsigned bol : 1;
+
+ /* If true, we are now scanning embedded UTF-8 sequence. */
+ unsigned embedded_utf_8 : 1;
/* The current composition. */
struct composition_status cmp_status;
struct emacs_mule_spec
{
- int full_support;
struct composition_status cmp_status;
};
-1 in setup_coding_system, and updated by detect_coding. So,
when this is equal to the byte length of the text being
converted, we can skip the actual conversion process. */
- EMACS_INT head_ascii;
+ ptrdiff_t head_ascii;
/* The following members are set by encoding/decoding routine. */
- EMACS_INT produced, produced_char, consumed, consumed_char;
+ ptrdiff_t produced, produced_char, consumed, consumed_char;
/* Number of error source data found in a decoding routine. */
int errors;
/* Store the positions of error source data. */
- EMACS_INT *error_positions;
+ ptrdiff_t *error_positions;
/* Finish status of code conversion. */
enum coding_result_code result;
- EMACS_INT src_pos, src_pos_byte, src_chars, src_bytes;
+ ptrdiff_t src_pos, src_pos_byte, src_chars, src_bytes;
Lisp_Object src_object;
const unsigned char *source;
- EMACS_INT dst_pos, dst_pos_byte, dst_bytes;
+ ptrdiff_t dst_pos, dst_pos_byte, dst_bytes;
Lisp_Object dst_object;
unsigned char *destination;
- /* Set to 1 if the source of conversion is not in the member
- `charbuf', but at `src_object'. */
- int chars_at_source;
-
/* If an element is non-negative, it is a character code.
If it is in the range -128..-1, it is a 8-bit character code
int *charbuf;
int charbuf_size, charbuf_used;
+ /* True if the source of conversion is not in the member
+ `charbuf', but at `src_object'. */
+ unsigned chars_at_source : 1;
+
/* Set to 1 if charbuf contains an annotation. */
- int annotated;
+ unsigned annotated : 1;
unsigned char carryover[64];
int carryover_bytes;
int default_char;
- int (*detector) (struct coding_system *,
- struct coding_detection_info *);
+ bool (*detector) (struct coding_system *, struct coding_detection_info *);
void (*decoder) (struct coding_system *);
- int (*encoder) (struct coding_system *);
+ bool (*encoder) (struct coding_system *);
};
/* Meanings of bits in the member `common_flags' of the structure
#define ENCODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 1)
/* Extern declarations. */
-extern Lisp_Object code_conversion_save (int, int);
-extern int decoding_buffer_size (struct coding_system *, int);
-extern int encoding_buffer_size (struct coding_system *, int);
+extern Lisp_Object code_conversion_save (bool, bool);
extern void setup_coding_system (Lisp_Object, struct coding_system *);
extern Lisp_Object coding_charset_list (struct coding_system *);
extern Lisp_Object coding_system_charset_list (Lisp_Object);
extern Lisp_Object code_convert_string (Lisp_Object, Lisp_Object,
- Lisp_Object, int, int, int);
+ Lisp_Object, bool, bool, bool);
extern Lisp_Object code_convert_string_norecord (Lisp_Object, Lisp_Object,
- int);
+ bool);
extern Lisp_Object raw_text_coding_system (Lisp_Object);
extern Lisp_Object coding_inherit_eol_type (Lisp_Object, Lisp_Object);
extern Lisp_Object complement_process_encoding_system (Lisp_Object);
-extern int decode_coding_gap (struct coding_system *,
- EMACS_INT, EMACS_INT);
+extern void decode_coding_gap (struct coding_system *,
+ ptrdiff_t, ptrdiff_t);
extern void decode_coding_object (struct coding_system *,
- Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, Lisp_Object);
+ Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, Lisp_Object);
extern void encode_coding_object (struct coding_system *,
- Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, Lisp_Object);
+ Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, Lisp_Object);
/* Macros for backward compatibility. */
extern Lisp_Object Qcoding_system_error;
extern char emacs_mule_bytes[256];
-extern int emacs_mule_string_char (unsigned char *);
#endif /* EMACS_CODING_H */
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
+#define COMPOSITE_INLINE EXTERN_INLINE
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "intervals.h"
#include "window.h"
auto-compositions. */
#define MAX_AUTO_COMPOSITION_LOOKBACK 3
-static Lisp_Object Fcomposition_get_gstring (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
-
/* Temporary variable used in macros COMPOSITION_XXX. */
Lisp_Object composition_temp;
If the composition is invalid, return -1. */
ptrdiff_t
-get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars,
+get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
Lisp_Object prop, Lisp_Object string)
{
Lisp_Object id, length, components, key, *key_contents;
EMACS_UINT hash_code;
enum composition_method method;
struct composition *cmp;
- EMACS_INT i;
+ ptrdiff_t i;
int ch;
/* Maximum length of a string of glyphs. XftGlyphExtents limits
for (i = 0; i < nchars; i++)
{
FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
- XVECTOR (key)->contents[i] = make_number (ch);
+ ASET (key, i, make_number (ch));
}
else
for (i = 0; i < nchars; i++)
{
FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
- XVECTOR (key)->contents[i] = make_number (ch);
+ ASET (key, i, make_number (ch));
}
}
else
&& VECTORP (AREF (components, 0)))
{
/* COMPONENTS is a glyph-string. */
- EMACS_INT len = ASIZE (key);
+ ptrdiff_t len = ASIZE (key);
for (i = 1; i < len; i++)
if (! VECTORP (AREF (key, i)))
}
else if (VECTORP (components) || CONSP (components))
{
- EMACS_INT len = ASIZE (key);
+ ptrdiff_t len = ASIZE (key);
/* The number of elements should be odd. */
if ((len % 2) == 0)
memory_full (SIZE_MAX);
/* Register the composition in composition_table. */
- cmp = (struct composition *) xmalloc (sizeof (struct composition));
+ cmp = xmalloc (sizeof *cmp);
cmp->method = method;
cmp->hash_index = hash_index;
else
{
/* Rule-base composition. */
- float leftmost = 0.0, rightmost;
+ double leftmost = 0.0, rightmost;
ch = XINT (key_contents[0]);
rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
{
int rule, gref, nref;
int this_width;
- float this_left;
+ double this_left;
rule = XINT (key_contents[i]);
ch = XINT (key_contents[i + 1]);
This doesn't check the validity of composition. */
-int
-find_composition (EMACS_INT pos, EMACS_INT limit,
- EMACS_INT *start, EMACS_INT *end,
+bool
+find_composition (ptrdiff_t pos, ptrdiff_t limit,
+ ptrdiff_t *start, ptrdiff_t *end,
Lisp_Object *prop, Lisp_Object object)
{
Lisp_Object val;
FROM and TO with property PROP. */
static void
-run_composition_function (EMACS_INT from, EMACS_INT to, Lisp_Object prop)
+run_composition_function (ptrdiff_t from, ptrdiff_t to, Lisp_Object prop)
{
Lisp_Object func;
- EMACS_INT start, end;
+ ptrdiff_t start, end;
func = COMPOSITION_MODIFICATION_FUNC (prop);
/* If an invalid composition precedes or follows, try to make them
change is deletion, FROM == TO. Otherwise, FROM < TO. */
void
-update_compositions (EMACS_INT from, EMACS_INT to, int check_mask)
+update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask)
{
Lisp_Object prop;
- EMACS_INT start, end;
+ ptrdiff_t start, end;
/* The beginning and end of the region to set the property
`auto-composed' to nil. */
- EMACS_INT min_pos = from, max_pos = to;
+ ptrdiff_t min_pos = from, max_pos = to;
if (inhibit_modification_hooks)
return;
}
if (min_pos < max_pos)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
indices START and END in STRING. */
void
-compose_text (EMACS_INT start, EMACS_INT end, Lisp_Object components,
+compose_text (ptrdiff_t start, ptrdiff_t end, Lisp_Object components,
Lisp_Object modification_func, Lisp_Object string)
{
Lisp_Object prop;
}
-static Lisp_Object autocmp_chars (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, struct window *,
+static Lisp_Object autocmp_chars (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, struct window *,
struct face *, Lisp_Object);
\f
}
Lisp_Object
-composition_gstring_put_cache (Lisp_Object gstring, EMACS_INT len)
+composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
{
struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
EMACS_UINT hash;
Lisp_Object header, copy;
- EMACS_INT i;
+ ptrdiff_t i;
header = LGSTRING_HEADER (gstring);
hash = h->hashfn (h, header);
if (len < 0)
{
- EMACS_INT j, glyph_len = LGSTRING_GLYPH_LEN (gstring);
+ ptrdiff_t j, glyph_len = LGSTRING_GLYPH_LEN (gstring);
for (j = 0; j < glyph_len; j++)
if (NILP (LGSTRING_GLYPH (gstring, j)))
break;
len = j;
}
- lint_assume (len <= TYPE_MAXIMUM (EMACS_INT) - 2);
+ lint_assume (len <= TYPE_MAXIMUM (ptrdiff_t) - 2);
copy = Fmake_vector (make_number (len + 2), Qnil);
LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
for (i = 0; i < len; i++)
Lisp_Object, Lisp_Object,
Lisp_Object);
-int
+bool
composition_gstring_p (Lisp_Object gstring)
{
Lisp_Object header;
- EMACS_INT i;
+ ptrdiff_t i;
if (! VECTORP (gstring) || ASIZE (gstring) < 2)
return 0;
}
int
-composition_gstring_width (Lisp_Object gstring, EMACS_INT from, EMACS_INT to,
+composition_gstring_width (Lisp_Object gstring, ptrdiff_t from, ptrdiff_t to,
struct font_metrics *metrics)
{
Lisp_Object *glyph;
}
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;
static Lisp_Object
fill_gstring_header (Lisp_Object header, Lisp_Object start, Lisp_Object end, Lisp_Object font_object, Lisp_Object string)
{
- EMACS_INT from, to, from_byte;
- EMACS_INT len, i;
+ ptrdiff_t from, to, from_byte;
+ ptrdiff_t len, i;
if (NILP (string))
{
CHECK_STRING (string);
if (! STRING_MULTIBYTE (string))
error ("Attempt to shape unibyte text");
- /* FROM and TO are checked by the caller. */
+ /* The caller checks that START and END are nonnegative integers. */
+ if (! (XINT (start) <= XINT (end) && XINT (end) <= SCHARS (string)))
+ args_out_of_range_3 (string, start, end);
from = XINT (start);
to = XINT (end);
- if (from < 0 || from > to || to > SCHARS (string))
- args_out_of_range_3 (string, start, end);
from_byte = string_char_to_byte (string, from);
}
{
Lisp_Object font_object = LGSTRING_FONT (gstring);
Lisp_Object header = AREF (gstring, 0);
- EMACS_INT len = LGSTRING_CHAR_LEN (gstring);
- EMACS_INT i;
+ ptrdiff_t len = LGSTRING_CHAR_LEN (gstring);
+ ptrdiff_t i;
for (i = 0; i < len; i++)
{
object. Otherwise return nil. */
static Lisp_Object
-autocmp_chars (Lisp_Object rule, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT limit, struct window *win, struct face *face, Lisp_Object string)
+autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t limit, struct window *win, struct face *face, Lisp_Object string)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
FRAME_PTR f = XFRAME (win->frame);
Lisp_Object pos = make_number (charpos);
- EMACS_INT to;
- EMACS_INT pt = PT, pt_byte = PT_BYTE;
+ ptrdiff_t to;
+ ptrdiff_t pt = PT, pt_byte = PT_BYTE;
Lisp_Object re, font_object, lgstring;
- EMACS_INT len;
+ ptrdiff_t len;
record_unwind_save_match_data ();
re = AREF (rule, 0);
string);
if (NILP (LGSTRING_ID (lgstring)))
{
- Lisp_Object args[6];
-
/* Save point as marker before calling out to lisp. */
if (NILP (string))
- {
- Lisp_Object m = Fmake_marker ();
- set_marker_both (m, Qnil, pt, pt_byte);
- record_unwind_protect (restore_point_unwind, m);
- }
-
- args[0] = Vauto_composition_function;
- args[1] = AREF (rule, 2);
- args[2] = pos;
- args[3] = make_number (to);
- args[4] = font_object;
- args[5] = string;
- lgstring = safe_call (6, args);
+ record_unwind_protect (restore_point_unwind,
+ build_marker (current_buffer, pt, pt_byte));
+ lgstring = safe_call (6, Vauto_composition_function, AREF (rule, 2),
+ pos, make_number (to), font_object, string);
}
return unbind_to (count, lgstring);
}
composition. */
void
-composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT endpos, Lisp_Object string)
+composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t endpos, Lisp_Object string)
{
- EMACS_INT start, end;
+ ptrdiff_t start, end;
int c;
Lisp_Object prop, val;
/* This is from forward_to_next_line_start in xdisp.c. */
int len;
/* Limit byte position used in fast_looking_at. This is the
byte position of the character after START. */
- EMACS_INT limit;
+ ptrdiff_t limit;
if (NILP (string))
p = BYTE_POS_ADDR (bytepos);
if (! NILP (val))
{
Lisp_Object elt;
- int ridx, back, blen;
+ int ridx, blen;
for (ridx = 0; CONSP (val); val = XCDR (val), ridx++)
{
elt = XCAR (val);
if (VECTORP (elt) && ASIZE (elt) == 3
&& NATNUMP (AREF (elt, 1))
- && charpos - (back = XFASTINT (AREF (elt, 1))) > endpos)
+ && charpos - XFASTINT (AREF (elt, 1)) > endpos)
{
- EMACS_INT cpos = charpos - back, bpos;
+ ptrdiff_t back = XFASTINT (AREF (elt, 1));
+ ptrdiff_t cpos = charpos - back, bpos;
if (back == 0)
bpos = bytepos;
string. In that case, FACE must not be NULL.
If the character is composed, setup members of CMP_IT (id, nglyphs,
- from, to, reversed_p), and return 1. Otherwise, update
- CMP_IT->stop_pos, and return 0. */
+ from, to, reversed_p), and return true. Otherwise, update
+ CMP_IT->stop_pos, and return false. */
-int
-composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT endpos, struct window *w, struct face *face, Lisp_Object string)
+bool
+composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
+ ptrdiff_t bytepos, ptrdiff_t endpos, struct window *w,
+ struct face *face, Lisp_Object string)
{
- if (endpos < 0)
- endpos = NILP (string) ? BEGV : 0;
-
if (cmp_it->ch == -2)
{
composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
return 0;
}
+ if (endpos < 0)
+ endpos = NILP (string) ? BEGV : 0;
+
if (cmp_it->ch < 0)
{
/* We are looking at a static composition. */
- EMACS_INT start, end;
+ ptrdiff_t start, end;
Lisp_Object prop;
find_composition (charpos, -1, &start, &end, &prop, string);
{
Lisp_Object lgstring = Qnil;
Lisp_Object val, elt;
- EMACS_INT i;
+ ptrdiff_t i;
val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val));
}
else
{
- EMACS_INT cpos = charpos, bpos = bytepos;
+ ptrdiff_t cpos = charpos, bpos = bytepos;
- while (1)
+ cmp_it->reversed_p = 1;
+ elt = XCAR (val);
+ if (cmp_it->lookback > 0)
{
- elt = XCAR (val);
- if (cmp_it->lookback > 0)
- {
- cpos = charpos - cmp_it->lookback;
- if (STRINGP (string))
- bpos = string_char_to_byte (string, cpos);
- else
- bpos = CHAR_TO_BYTE (cpos);
- }
- lgstring = autocmp_chars (elt, cpos, bpos, charpos + 1, w, face,
- string);
- if (composition_gstring_p (lgstring)
- && cpos + LGSTRING_CHAR_LEN (lgstring) - 1 == charpos)
- break;
- /* Composition failed or didn't cover the current
- character. */
- if (cmp_it->lookback == 0)
- goto no_composition;
- lgstring = Qnil;
- /* Try to find a shorter composition that starts after CPOS. */
- composition_compute_stop_pos (cmp_it, charpos, bytepos, cpos,
- string);
- if (cmp_it->ch == -2 || cmp_it->stop_pos < charpos)
- goto no_composition;
- val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
- for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val));
+ cpos = charpos - cmp_it->lookback;
+ if (STRINGP (string))
+ bpos = string_char_to_byte (string, cpos);
+ else
+ bpos = CHAR_TO_BYTE (cpos);
}
- cmp_it->reversed_p = 1;
+ lgstring = autocmp_chars (elt, cpos, bpos, charpos + 1, w, face,
+ string);
+ if (! composition_gstring_p (lgstring)
+ || cpos + LGSTRING_CHAR_LEN (lgstring) - 1 != charpos)
+ /* Composition failed or didn't cover the current
+ character. */
+ goto no_composition;
}
if (NILP (lgstring))
goto no_composition;
/* BYTEPOS is calculated in composition_compute_stop_pos */
bytepos = -1;
}
+ if (cmp_it->reversed_p)
+ endpos = -1;
composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
return 0;
}
the cluster, or -1 if the composition is somehow broken. */
int
-composition_update_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_INT bytepos, Lisp_Object string)
+composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, Lisp_Object string)
{
int i, c IF_LINT (= 0);
/* automatic composition */
Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
Lisp_Object glyph;
- EMACS_INT from;
+ ptrdiff_t from;
if (cmp_it->nglyphs == 0)
{
struct position_record
{
- EMACS_INT pos, pos_byte;
+ ptrdiff_t pos, pos_byte;
unsigned char *p;
};
/* This is like find_composition, but find an automatic composition
instead. It is assured that POS is not within a static
composition. If found, set *GSTRING to the glyph-string
- representing the composition, and return 1. Otherwise, *GSTRING to
- Qnil, and return 0. */
+ representing the composition, and return true. Otherwise, *GSTRING to
+ Qnil, and return false. */
-static int
-find_automatic_composition (EMACS_INT pos, EMACS_INT limit,
- EMACS_INT *start, EMACS_INT *end,
+static bool
+find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
+ ptrdiff_t *start, ptrdiff_t *end,
Lisp_Object *gstring, Lisp_Object string)
{
- EMACS_INT head, tail, stop;
+ ptrdiff_t head, tail, stop;
/* Forward limit position of checking a composition taking a
looking-back count into account. */
- EMACS_INT fore_check_limit;
+ ptrdiff_t fore_check_limit;
struct position_record cur, prev;
int c;
Lisp_Object window;
struct window *w;
- int need_adjustment = 0;
+ bool need_adjustment = 0;
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
if (NILP (window))
/* Return the adjusted point provided that point is moved from LAST_PT
to NEW_PT. */
-EMACS_INT
-composition_adjust_point (EMACS_INT last_pt, EMACS_INT new_pt)
+ptrdiff_t
+composition_adjust_point (ptrdiff_t last_pt, ptrdiff_t new_pt)
{
- EMACS_INT i, beg, end;
+ ptrdiff_t i, beg, end;
Lisp_Object val;
if (new_pt == BEGV || new_pt == ZV)
return new_pt;
/* Next check the automatic composition. */
- if (! find_automatic_composition (new_pt, (EMACS_INT) -1, &beg, &end, &val,
+ if (! find_automatic_composition (new_pt, (ptrdiff_t) -1, &beg, &end, &val,
Qnil)
|| beg == new_pt)
return new_pt;
(Lisp_Object from, Lisp_Object to, Lisp_Object font_object, Lisp_Object string)
{
Lisp_Object gstring, header;
- EMACS_INT frompos, topos;
+ ptrdiff_t frompos, topos;
CHECK_NATNUM (from);
CHECK_NATNUM (to);
(Lisp_Object pos, Lisp_Object limit, Lisp_Object string, Lisp_Object detail_p)
{
Lisp_Object prop, tail, gstring;
- EMACS_INT start, end, from, to;
+ ptrdiff_t start, end, from, to;
int id;
CHECK_NUMBER_COERCE_MARKER (pos);
- from = XINT (pos);
if (!NILP (limit))
{
CHECK_NUMBER_COERCE_MARKER (limit);
- to = XINT (limit);
+ to = min (XINT (limit), ZV);
}
else
to = -1;
if (XINT (pos) < BEGV || XINT (pos) > ZV)
args_out_of_range (Fcurrent_buffer (), pos);
}
+ from = XINT (pos);
if (!find_composition (from, to, &start, &end, &prop, string))
{
}
if ((end <= XINT (pos) || start > XINT (pos)))
{
- EMACS_INT s, e;
+ ptrdiff_t s, e;
if (find_automatic_composition (from, to, &s, &e, &gstring, string)
&& (e <= XINT (pos) ? e > end : s < start))
id = COMPOSITION_ID (prop);
else
{
- EMACS_INT start_byte = (NILP (string)
+ ptrdiff_t start_byte = (NILP (string)
? CHAR_TO_BYTE (start)
: string_char_to_byte (string, start));
id = get_composition_id (start, start_byte, end - start, prop, string);
#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. */
&& (end - start) == COMPOSITION_LENGTH (prop))
/* Return the Nth glyph of composition specified by CMP. CMP is a
- pointer to `struct composition'. */
+ pointer to `struct composition'. */
#define COMPOSITION_GLYPH(cmp, n) \
XINT (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \
->key_and_value) \
enum composition_method method;
/* Index to the composition hash table. */
- EMACS_INT hash_index;
+ ptrdiff_t hash_index;
/* For which font we have calculated the remaining members. The
actual type is device dependent. */
extern Lisp_Object Qcomposition;
extern Lisp_Object composition_hash_table;
-extern ptrdiff_t get_composition_id (EMACS_INT, EMACS_INT, EMACS_INT,
+extern ptrdiff_t get_composition_id (ptrdiff_t, ptrdiff_t, ptrdiff_t,
Lisp_Object, Lisp_Object);
-extern int find_composition (EMACS_INT, EMACS_INT, EMACS_INT *, EMACS_INT *,
- Lisp_Object *, Lisp_Object);
-extern void update_compositions (EMACS_INT, EMACS_INT, int);
+extern bool find_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t *, ptrdiff_t *,
+ Lisp_Object *, Lisp_Object);
+extern void update_compositions (ptrdiff_t, ptrdiff_t, int);
extern void make_composition_value_copy (Lisp_Object);
extern void compose_region (int, int, Lisp_Object, Lisp_Object,
Lisp_Object);
extern void syms_of_composite (void);
-extern void compose_text (EMACS_INT, EMACS_INT, Lisp_Object, Lisp_Object,
+extern void compose_text (ptrdiff_t, ptrdiff_t, Lisp_Object, Lisp_Object,
Lisp_Object);
/* Macros for lispy glyph-string. This is completely different from
#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
struct face;
struct font_metrics;
-extern Lisp_Object composition_gstring_put_cache (Lisp_Object, EMACS_INT);
+extern Lisp_Object composition_gstring_put_cache (Lisp_Object, ptrdiff_t);
extern Lisp_Object composition_gstring_from_id (ptrdiff_t);
-extern int composition_gstring_p (Lisp_Object);
-extern int composition_gstring_width (Lisp_Object, EMACS_INT, EMACS_INT,
+extern bool composition_gstring_p (Lisp_Object);
+extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t,
struct font_metrics *);
extern void composition_compute_stop_pos (struct composition_it *,
- EMACS_INT, EMACS_INT, EMACS_INT,
+ ptrdiff_t, ptrdiff_t, ptrdiff_t,
Lisp_Object);
-extern int composition_reseat_it (struct composition_it *,
- EMACS_INT, EMACS_INT, EMACS_INT,
- struct window *, struct face *,
- Lisp_Object);
+extern bool composition_reseat_it (struct composition_it *, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, struct window *,
+ struct face *, Lisp_Object);
extern int composition_update_it (struct composition_it *,
- EMACS_INT, EMACS_INT, Lisp_Object);
+ ptrdiff_t, ptrdiff_t, Lisp_Object);
+
+extern ptrdiff_t composition_adjust_point (ptrdiff_t, ptrdiff_t);
-extern EMACS_INT composition_adjust_point (EMACS_INT, EMACS_INT);
+INLINE_HEADER_END
#endif /* not EMACS_COMPOSITE_H */
--- /dev/null
+/* conf_post.h --- configure.ac includes this via AH_BOTTOM
+
+Copyright (C) 1988, 1993-1994, 1999-2002, 2004-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 <http://www.gnu.org/licenses/>. */
+
+/* Commentary:
+
+ Rather than writing this code directly in AH_BOTTOM, we include it
+ via this file. This is so that it does not get processed by
+ autoheader. Eg, any undefs here would otherwise be commented out.
+*/
+
+/* Code: */
+
+/* Include any platform specific configuration file. */
+#ifdef config_opsysfile
+# include config_opsysfile
+#endif
+
+#ifndef WINDOWSNT
+/* On AIX 3 this must be included before any other include file. */
+#include <alloca.h>
+#if ! HAVE_ALLOCA
+# error "alloca not available on this machine"
+#endif
+#endif
+
+/* This silences a few compilation warnings on FreeBSD. */
+#ifdef BSD_SYSTEM_AHB
+#undef BSD_SYSTEM_AHB
+#undef BSD_SYSTEM
+#if __FreeBSD__ == 1
+#define BSD_SYSTEM 199103
+#elif __FreeBSD__ == 2
+#define BSD_SYSTEM 199306
+#elif __FreeBSD__ >= 3
+#define BSD_SYSTEM 199506
+#endif
+#endif
+
+#ifdef DARWIN_OS
+#ifdef emacs
+#define malloc unexec_malloc
+#define realloc unexec_realloc
+#define free unexec_free
+/* Don't use posix_memalign because it is not compatible with unexmacosx.c. */
+#undef HAVE_POSIX_MEMALIGN
+#endif
+/* The following solves the problem that Emacs hangs when evaluating
+ (make-comint "test0" "/nodir/nofile" nil "") when /nodir/nofile
+ does not exist. Also, setsid is not allowed in the vfork child's
+ context as of Darwin 9/Mac OS X 10.5. */
+#undef HAVE_WORKING_VFORK
+#define vfork fork
+#endif /* DARWIN_OS */
+
+/* We have to go this route, rather than the old hpux9 approach of
+ renaming the functions via macros. The system's stdlib.h has fully
+ prototyped declarations, which yields a conflicting definition of
+ srand48; it tries to redeclare what was once srandom to be srand48.
+ So we go with HAVE_LRAND48 being defined. */
+#ifdef HPUX
+#undef srandom
+#undef random
+/* We try to avoid checking for random and rint on hpux in
+ configure.ac, but some other configure test might check for them as
+ a dependency, so to be safe we also undefine them here.
+ */
+#undef HAVE_RANDOM
+#undef HAVE_RINT
+#endif /* HPUX */
+
+#ifdef IRIX6_5
+#ifdef emacs
+char *_getpty();
+#endif
+
+#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 */
+
+/* Mac OS X / GNUstep need a bit more pure memory. Of the existing knobs,
+ SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. */
+#ifdef HAVE_NS
+#if defined NS_IMPL_GNUSTEP
+# define SYSTEM_PURESIZE_EXTRA 30000
+#elif defined DARWIN_OS
+# define SYSTEM_PURESIZE_EXTRA 200000
+#endif
+#endif
+
+#ifdef emacs /* Don't do this for lib-src. */
+/* Tell regex.c to use a type compatible with Emacs. */
+#define RE_TRANSLATE_TYPE Lisp_Object
+#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C)
+#ifdef make_number
+/* If make_number is a macro, use it. */
+#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0)))
+#else
+/* If make_number is a function, avoid it. */
+#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0))
+#endif
+#endif
+
+#include <string.h>
+#include <stdlib.h>
+
+#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
+#define NO_INLINE __attribute__((noinline))
+#else
+#define NO_INLINE
+#endif
+
+#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1))
+#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
+#else
+#define EXTERNALLY_VISIBLE
+#endif
+
+#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
+#else
+# define ATTRIBUTE_FORMAT(spec) /* empty */
+#endif
+
+#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
+# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
+ ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
+#else
+# define ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
+ ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
+#endif
+
+#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
+
+/* Some versions of GNU/Linux define noinline in their headers. */
+#ifdef noinline
+#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 */
#include <config.h>
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
#include <intprops.h>
#include "syssignal.h"
#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
#include "font.h"
-
-#include <float.h>
-/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
-#ifndef IEEE_FLOATING_POINT
-#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
- && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
-#define IEEE_FLOATING_POINT 1
-#else
-#define IEEE_FLOATING_POINT 0
-#endif
-#endif
-
-#include <math.h>
+#include "keymap.h"
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
static Lisp_Object Qsubr;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
-Lisp_Object Qerror, Qquit, Qargs_out_of_range;
+Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
static Lisp_Object Qwrong_type_argument;
Lisp_Object Qvoid_variable, Qvoid_function;
static Lisp_Object Qcyclic_function_indirection;
Lisp_Object Qcdr;
static Lisp_Object Qad_advice_info, Qad_activate_internal;
-Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
-Lisp_Object Qoverflow_error, Qunderflow_error;
+static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error;
+Lisp_Object Qrange_error, Qoverflow_error;
Lisp_Object Qfloatp;
Lisp_Object Qnumberp, Qnumber_or_marker_p;
-Lisp_Object Qinteger;
-static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
+Lisp_Object Qinteger, Qsymbol;
+static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector;
Lisp_Object Qwindow;
-static Lisp_Object Qfloat, Qwindow_configuration;
-static Lisp_Object Qprocess;
-static Lisp_Object Qcompiled_function, Qframe, Qvector;
+static Lisp_Object Qoverlay, Qwindow_configuration;
+static Lisp_Object Qprocess, Qmarker;
+static Lisp_Object Qcompiled_function, Qframe;
Lisp_Object Qbuffer;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
static Lisp_Object Qsubrp, Qmany, Qunevalled;
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
+static Lisp_Object Qdefun;
Lisp_Object Qinteractive_form;
to try and do that by checking the tagbits, but nowadays all
tagbits are potentially valid. */
/* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
- * abort (); */
+ * emacs_abort (); */
xsignal2 (Qwrong_type_argument, predicate, value);
}
}
\f
-/* Data type predicates */
+/* Data type predicates. */
DEFUN ("eq", Feq, Seq, 2, 2, 0,
doc: /* Return t if the two args are the same Lisp object. */)
case Lisp_Misc_Float:
return Qfloat;
}
- abort ();
+ emacs_abort ();
case Lisp_Vectorlike:
if (WINDOW_CONFIGURATIONP (object))
return Qfloat;
default:
- abort ();
+ emacs_abort ();
}
}
return newcdr;
}
\f
-/* Extract and set components of symbols */
+/* Extract and set components of symbols. */
DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
doc: /* Return t if SYMBOL's value is not void. */)
else
{
swap_in_symval_forwarding (sym, blv);
- valcontents = BLV_VALUE (blv);
+ valcontents = blv_value (blv);
}
break;
}
/* In set_internal, we un-forward vars when their value is
set to Qunbound. */
return Qt;
- default: abort ();
+ default: emacs_abort ();
}
return (EQ (valcontents, Qunbound) ? Qnil : Qt);
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt);
+ return EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt;
}
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
CHECK_SYMBOL (symbol);
if (NILP (symbol) || EQ (symbol, Qt))
xsignal1 (Qsetting_constant, symbol);
- XSYMBOL (symbol)->function = Qunbound;
+ set_symbol_function (symbol, Qunbound);
return symbol;
}
if (CONSP (function) && EQ (XCAR (function), Qautoload))
Fput (symbol, Qautoload, XCDR (function));
- XSYMBOL (symbol)->function = definition;
- /* Handle automatic advice activation */
- if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
+ set_symbol_function (symbol, definition);
+ /* Handle automatic advice activation. */
+ if (CONSP (XSYMBOL (symbol)->plist)
+ && !NILP (Fget (symbol, Qad_advice_info)))
{
call2 (Qad_activate_internal, symbol, Qnil);
definition = XSYMBOL (symbol)->function;
}
DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
- doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
+ doc: /* Set SYMBOL's function definition to DEFINITION.
Associates the function with the current load file, if any.
The optional third argument DOCSTRING specifies the documentation string
for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
-determined by DEFINITION. */)
+determined by DEFINITION.
+The return value is undefined. */)
(register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
{
CHECK_SYMBOL (symbol);
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. */
+ && !KEYMAPP (definition))
+ definition = Fpurecopy (definition);
definition = Ffset (symbol, definition);
LOADHIST_ATTACH (Fcons (Qdefun, symbol));
if (!NILP (docstring))
Fput (symbol, Qfunction_documentation, docstring);
- return definition;
+ /* We used to return `definition', but now that `defun' and `defmacro' expand
+ to a call to `defalias', we return `symbol' for backward compatibility
+ (bug#11686). */
+ return symbol;
}
DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
(register Lisp_Object symbol, Lisp_Object newplist)
{
CHECK_SYMBOL (symbol);
- XSYMBOL (symbol)->plist = newplist;
+ set_symbol_plist (symbol, newplist);
return newplist;
}
{
struct gcpro gcpro1;
GCPRO1 (cmd);
- do_autoload (fun, cmd);
+ Fautoload_do_load (fun, cmd, Qnil);
UNGCPRO;
return Finteractive_form (cmd);
}
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))
return *XOBJFWD (valcontents)->objvar;
case Lisp_Fwd_Buffer_Obj:
- return PER_BUFFER_VALUE (current_buffer,
+ return per_buffer_value (current_buffer,
XBUFFER_OBJFWD (valcontents)->offset);
case Lisp_Fwd_Kboard_Obj:
don't think anything will break. --lorentey */
return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
+ (char *)FRAME_KBOARD (SELECTED_FRAME ()));
- default: abort ();
+ default: emacs_abort ();
}
}
b = XBUFFER (lbuf);
if (! PER_BUFFER_VALUE_P (b, idx))
- PER_BUFFER_VALUE (b, offset) = newval;
+ set_per_buffer_value (b, offset, newval);
}
}
break;
Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
if (!(NILP (type) || NILP (newval)
- || (XINT (type) == LISP_INT_TAG
+ || (XINT (type) == Lisp_Int0
? INTEGERP (newval)
: XTYPE (newval) == XINT (type))))
buffer_slot_type_mismatch (newval, XINT (type));
if (buf == NULL)
buf = current_buffer;
- PER_BUFFER_VALUE (buf, offset) = newval;
+ set_per_buffer_value (buf, offset, newval);
}
break;
break;
default:
- abort (); /* goto def; */
+ emacs_abort (); /* goto def; */
}
}
-/* Set up SYMBOL to refer to its global binding.
- This makes it safe to alter the status of other bindings. */
+/* Set up SYMBOL to refer to its global binding. This makes it safe
+ to alter the status of other bindings. BEWARE: this may be called
+ during the mark phase of GC, where we assume that Lisp_Object slots
+ of BLV are marked after this function has changed them. */
void
swap_in_global_binding (struct Lisp_Symbol *symbol)
/* Unload the previously loaded binding. */
if (blv->fwd)
- SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
+ set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Select the global binding in the symbol. */
- blv->valcell = blv->defcell;
+ set_blv_valcell (blv, blv->defcell);
if (blv->fwd)
store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
/* Indicate that the global binding is set up now. */
- blv->where = Qnil;
- SET_BLV_FOUND (blv, 0);
+ set_blv_where (blv, Qnil);
+ set_blv_found (blv, 0);
}
/* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
/* Unload the previously loaded binding. */
tem1 = blv->valcell;
if (blv->fwd)
- SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
+ set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Choose the new binding. */
{
Lisp_Object var;
if (blv->frame_local)
{
tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist);
- blv->where = selected_frame;
+ set_blv_where (blv, selected_frame);
}
else
{
tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist));
- XSETBUFFER (blv->where, current_buffer);
+ set_blv_where (blv, Fcurrent_buffer ());
}
}
if (!(blv->found = !NILP (tem1)))
tem1 = blv->defcell;
/* Load the new binding. */
- blv->valcell = tem1;
+ set_blv_valcell (blv, tem1);
if (blv->fwd)
- store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL);
+ store_symval_forwarding (blv->fwd, blv_value (blv), NULL);
}
}
\f
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
swap_in_symval_forwarding (sym, blv);
- return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv);
+ return blv->fwd ? do_symval_forwarding (blv->fwd) : blv_value (blv);
}
/* FALLTHROUGH */
case SYMBOL_FORWARDED:
return do_symval_forwarding (SYMBOL_FWD (sym));
- default: abort ();
+ default: emacs_abort ();
}
}
return newval;
}
-/* Return 1 if SYMBOL currently has a let-binding
+/* Return true if SYMBOL currently has a let-binding
which was made in the buffer that is now current. */
-static int
+static bool
let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
{
struct specbinding *p;
- for (p = specpdl_ptr - 1; p >= specpdl; p--)
- if (p->func == NULL
+ for (p = specpdl_ptr; p > specpdl; )
+ if ((--p)->func == NULL
&& CONSP (p->symbol))
{
struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
if (symbol == let_bound_symbol
&& XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
- break;
+ return 1;
}
- return p >= specpdl;
+ return 0;
}
-static int
+static bool
let_shadows_global_binding_p (Lisp_Object symbol)
{
struct specbinding *p;
- for (p = specpdl_ptr - 1; p >= specpdl; p--)
- if (p->func == NULL && EQ (p->symbol, symbol))
- break;
+ for (p = specpdl_ptr; p > specpdl; )
+ if ((--p)->func == NULL && EQ (p->symbol, symbol))
+ return 1;
- return p >= specpdl;
+ return 0;
}
/* Store the value NEWVAL into SYMBOL.
If buffer/frame-locality is an issue, WHERE specifies which context to use.
(nil stands for the current buffer/frame).
- If BINDFLAG is zero, then if this symbol is supposed to become
+ If BINDFLAG is false, then if this symbol is supposed to become
local in every buffer where it is set, then we make it local.
- If BINDFLAG is nonzero, we don't do that. */
+ If BINDFLAG is true, we don't do that. */
void
-set_internal (register Lisp_Object symbol, register Lisp_Object newval, register Lisp_Object where, int bindflag)
+set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
+ bool bindflag)
{
- int voide = EQ (newval, Qunbound);
+ bool voide = EQ (newval, Qunbound);
struct Lisp_Symbol *sym;
Lisp_Object tem1;
the default binding is loaded, the loaded binding may be the
wrong one. */
if (!EQ (blv->where, where)
- /* Also unload a global binding (if the var is local_if_set). */
+ /* Also unload a global binding (if the var is local_if_set). */
|| (EQ (blv->valcell, blv->defcell)))
{
/* The currently loaded binding is not necessarily valid.
/* Write out `realvalue' to the old loaded binding. */
if (blv->fwd)
- SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
+ set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Find the new binding. */
XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
(blv->frame_local
? XFRAME (where)->param_alist
: BVAR (XBUFFER (where), local_var_alist)));
- blv->where = where;
+ set_blv_where (blv, where);
blv->found = 1;
if (NILP (tem1))
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_local_var_alist
+ (XBUFFER (where),
+ Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)));
}
}
/* Record which binding is now loaded. */
- blv->valcell = tem1;
+ set_blv_valcell (blv, tem1);
}
/* Store the new value in the cons cell. */
- SET_BLV_VALUE (blv, newval);
+ set_blv_value (blv, newval);
if (blv->fwd)
{
store_symval_forwarding (/* sym, */ innercontents, newval, buf);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
return;
}
{
int offset = XBUFFER_OBJFWD (valcontents)->offset;
if (PER_BUFFER_IDX (offset) != 0)
- return PER_BUFFER_DEFAULT (offset);
+ return per_buffer_default (offset);
}
/* For other variables, get the current value. */
return do_symval_forwarding (valcontents);
}
- default: abort ();
+ default: emacs_abort ();
}
}
int offset = XBUFFER_OBJFWD (valcontents)->offset;
int idx = PER_BUFFER_IDX (offset);
- PER_BUFFER_DEFAULT (offset) = value;
+ set_per_buffer_default (offset, value);
/* If this variable is not always local in all buffers,
set it in the buffers that don't nominally have a local value. */
{
struct buffer *b;
- for (b = all_buffers; b; b = b->header.next.buffer)
+ FOR_EACH_BUFFER (b)
if (!PER_BUFFER_VALUE_P (b, idx))
- PER_BUFFER_VALUE (b, offset) = value;
+ set_per_buffer_value (b, offset, value);
}
return value;
}
else
return Fset (symbol, value);
}
- default: abort ();
+ default: emacs_abort ();
}
}
};
static struct Lisp_Buffer_Local_Value *
-make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents)
+make_blv (struct Lisp_Symbol *sym, bool forwarded,
+ union Lisp_Val_Fwd valcontents)
{
- struct Lisp_Buffer_Local_Value *blv
- = xmalloc (sizeof (struct Lisp_Buffer_Local_Value));
+ struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv);
Lisp_Object symbol;
Lisp_Object tem;
eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd)));
eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd)));
blv->fwd = forwarded ? valcontents.fwd : NULL;
- blv->where = Qnil;
+ set_blv_where (blv, Qnil);
blv->frame_local = 0;
blv->local_if_set = 0;
- blv->defcell = tem;
- blv->valcell = tem;
- SET_BLV_FOUND (blv, 0);
+ set_blv_defcell (blv, tem);
+ set_blv_valcell (blv, tem);
+ set_blv_found (blv, 0);
return blv;
}
{
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
- union Lisp_Val_Fwd valcontents IF_LINT (= {0});
- int forwarded IF_LINT (= 0);
+ union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
+ bool forwarded IF_LINT (= 0);
CHECK_SYMBOL (variable);
sym = XSYMBOL (variable);
else if (BUFFER_OBJFWDP (valcontents.fwd))
return variable;
break;
- default: abort ();
+ default: emacs_abort ();
}
if (sym->constant)
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument. */)
- (register Lisp_Object variable)
+ (Lisp_Object variable)
{
- register Lisp_Object tem;
- int forwarded IF_LINT (= 0);
- union Lisp_Val_Fwd valcontents IF_LINT (= {0});
+ Lisp_Object tem;
+ bool forwarded IF_LINT (= 0);
+ union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
error ("Symbol %s may not be buffer-local",
SDATA (SYMBOL_NAME (variable)));
break;
- default: abort ();
+ default: emacs_abort ();
}
if (sym->constant)
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_local_var_alist
+ (current_buffer,
+ 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. */
if (current_buffer == XBUFFER (blv->where))
- blv->where = Qnil;
- /* blv->valcell = blv->defcell;
- * SET_BLV_FOUND (blv, 0); */
- blv->found = 0;
+ set_blv_where (blv, Qnil);
+ set_blv_found (blv, 0);
}
/* If the symbol forwards into a C variable, then load the binding
if (idx > 0)
{
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
- PER_BUFFER_VALUE (current_buffer, offset)
- = PER_BUFFER_DEFAULT (offset);
+ set_per_buffer_value (current_buffer, offset,
+ per_buffer_default (offset));
}
}
return variable;
if (blv->frame_local)
return variable;
break;
- default: abort ();
+ default: emacs_abort ();
}
/* Get rid of this buffer's alist element, if any. */
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_local_var_alist
+ (current_buffer,
+ 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
Lisp_Object buf; XSETBUFFER (buf, current_buffer);
if (EQ (buf, blv->where))
{
- blv->where = Qnil;
- /* blv->valcell = blv->defcell;
- * SET_BLV_FOUND (blv, 0); */
+ set_blv_where (blv, Qnil);
blv->found = 0;
find_symbol_value (variable);
}
Note that since Emacs 23.1, variables cannot be both buffer-local and
frame-local any more (buffer-local bindings used to take precedence over
frame-local bindings). */)
- (register Lisp_Object variable)
+ (Lisp_Object variable)
{
- int forwarded;
+ bool forwarded;
union Lisp_Val_Fwd valcontents;
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
error ("Symbol %s may not be frame-local",
SDATA (SYMBOL_NAME (variable)));
break;
- default: abort ();
+ default: emacs_abort ();
}
if (sym->constant)
if (EQ (variable, XCAR (elt)))
{
eassert (!blv->frame_local);
- eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp));
+ eassert (blv_found (blv) || !EQ (blv->where, tmp));
return Qt;
}
}
- eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp));
+ eassert (!blv_found (blv) || !EQ (blv->where, tmp));
return Qnil;
}
case SYMBOL_FORWARDED:
}
return Qnil;
}
- default: abort ();
+ default: emacs_abort ();
}
}
DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
1, 2, 0,
- doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there.
-More precisely, this means that setting the variable \(with `set' or`setq'),
-while it does not have a `let'-style binding that was made in BUFFER,
-will produce a buffer local binding. See Info node
-`(elisp)Creating Buffer-Local'.
-BUFFER defaults to the current buffer. */)
+ doc: /* Non-nil if VARIABLE is local in buffer BUFFER when set there.
+BUFFER defaults to the current buffer.
+
+More precisely, return non-nil if either VARIABLE already has a local
+value in BUFFER, or if VARIABLE is automatically buffer-local (see
+`make-variable-buffer-local'). */)
(register Lisp_Object variable, Lisp_Object buffer)
{
struct Lisp_Symbol *sym;
case SYMBOL_FORWARDED:
/* All BUFFER_OBJFWD slots become local if they are set. */
return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil);
- default: abort ();
+ default: emacs_abort ();
}
}
if (!NILP (Flocal_variable_p (variable, Qnil)))
return Fcurrent_buffer ();
else if (sym->redirect == SYMBOL_LOCALIZED
- && BLV_FOUND (SYMBOL_BLV (sym)))
+ && blv_found (SYMBOL_BLV (sym)))
return SYMBOL_BLV (sym)->where;
else
return Qnil;
- default: abort ();
+ default: emacs_abort ();
}
}
return Qnil;
}
\f
-/* Extract and set vector and string elements */
+/* Extract and set vector and string elements. */
DEFUN ("aref", Faref, Saref, 2, 2, 0,
doc: /* Return the element of ARRAY at index IDX.
if (STRINGP (array))
{
int c;
- EMACS_INT idxval_byte;
+ ptrdiff_t idxval_byte;
if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
}
else
{
- int size = 0;
+ ptrdiff_t size = 0;
if (VECTORP (array))
size = ASIZE (array);
else if (COMPILEDP (array))
{
if (idxval < 0 || idxval >= ASIZE (array))
args_out_of_range (array, idx);
- XVECTOR (array)->contents[idxval] = newelt;
+ ASET (array, idxval, newelt);
}
else if (BOOL_VECTOR_P (array))
{
if (STRING_MULTIBYTE (array))
{
- EMACS_INT idxval_byte, prev_bytes, new_bytes, nbytes;
+ ptrdiff_t idxval_byte, nbytes;
+ int prev_bytes, new_bytes;
unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
nbytes = SBYTES (array);
if (prev_bytes != new_bytes)
{
/* We must relocate the string data. */
- EMACS_INT nchars = SCHARS (array);
- unsigned char *str;
+ ptrdiff_t nchars = SCHARS (array);
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);
arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
{
double f1 = 0, f2 = 0;
- int floatp = 0;
+ bool floatp = 0;
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1);
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2);
return Qnil;
default:
- abort ();
+ emacs_abort ();
}
}
uintmax_t
cons_to_unsigned (Lisp_Object c, uintmax_t max)
{
- int valid = 0;
+ bool valid = 0;
uintmax_t val IF_LINT (= 0);
if (INTEGERP (c))
{
intmax_t
cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
{
- int valid = 0;
+ bool valid = 0;
intmax_t val IF_LINT (= 0);
if (INTEGERP (c))
{
NUMBER may be an integer or a floating point number. */)
(Lisp_Object number)
{
- char buffer[VALBITS];
+ char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))];
+ int len;
CHECK_NUMBER_OR_FLOAT (number);
if (FLOATP (number))
- {
- char pigbuf[FLOAT_TO_STRING_BUFSIZE];
-
- float_to_string (pigbuf, XFLOAT_DATA (number));
- return build_string (pigbuf);
- }
+ len = float_to_string (buffer, XFLOAT_DATA (number));
+ else
+ len = sprintf (buffer, "%"pI"d", XINT (number));
- sprintf (buffer, "%"pI"d", XINT (number));
- return build_string (buffer);
+ return make_unibyte_string (buffer, len);
}
DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
else
{
CHECK_NUMBER (base);
- b = XINT (base);
- if (b < 2 || b > 16)
+ if (! (2 <= XINT (base) && XINT (base) <= 16))
xsignal1 (Qargs_out_of_range, base);
+ b = XINT (base);
}
p = SSDATA (string);
static Lisp_Object
arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
{
- register Lisp_Object val;
- ptrdiff_t argnum;
- register EMACS_INT accum = 0;
- register EMACS_INT next;
-
- int overflow = 0;
- ptrdiff_t ok_args;
- EMACS_INT ok_accum;
+ Lisp_Object val;
+ ptrdiff_t argnum, ok_args;
+ EMACS_INT accum = 0;
+ EMACS_INT next, ok_accum;
+ bool overflow = 0;
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Alogior:
case Alogxor:
nargs, args);
args[argnum] = val;
next = XINT (args[argnum]);
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Aadd:
if (INT_ADD_OVERFLOW (accum, next))
args[argnum] = val; /* runs into a compiler bug. */
next = XINT (args[argnum]);
}
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Aadd:
accum += next;
CHECK_NUMBER_COERCE_MARKER (x);
CHECK_NUMBER_COERCE_MARKER (y);
- if (XFASTINT (y) == 0)
+ if (XINT (y) == 0)
xsignal0 (Qarith_error);
XSETINT (val, XINT (x) % XINT (y));
return val;
}
-#ifndef HAVE_FMOD
-double
-fmod (double f1, double f2)
-{
- double r = f1;
-
- if (f2 < 0.0)
- f2 = -f2;
-
- /* If the magnitude of the result exceeds that of the divisor, or
- the sign of the result does not agree with that of the dividend,
- iterate with the reduced value. This does not yield a
- particularly accurate result, but at least it will be in the
- range promised by fmod. */
- do
- r -= f2 * floor (r / f2);
- while (f2 <= (r < 0 ? -r : r) || ((r < 0) != (f1 < 0) && ! isnan (r)));
-
- return r;
-}
-#endif /* ! HAVE_FMOD */
-
DEFUN ("mod", Fmod, Smod, 2, 2, 0,
doc: /* Return X modulo Y.
The result falls between zero (inclusive) and Y (exclusive).
DEFSYM (Qtop_level, "top-level");
DEFSYM (Qerror, "error");
+ DEFSYM (Quser_error, "user-error");
DEFSYM (Qquit, "quit");
DEFSYM (Qwrong_type_argument, "wrong-type-argument");
DEFSYM (Qargs_out_of_range, "args-out-of-range");
Fput (Qerror, Qerror_conditions,
error_tail);
Fput (Qerror, Qerror_message,
- make_pure_c_string ("error"));
-
- Fput (Qquit, Qerror_conditions,
- pure_cons (Qquit, Qnil));
- Fput (Qquit, Qerror_message,
- make_pure_c_string ("Quit"));
-
- Fput (Qwrong_type_argument, Qerror_conditions,
- pure_cons (Qwrong_type_argument, error_tail));
- Fput (Qwrong_type_argument, Qerror_message,
- make_pure_c_string ("Wrong type argument"));
-
- Fput (Qargs_out_of_range, Qerror_conditions,
- pure_cons (Qargs_out_of_range, error_tail));
- Fput (Qargs_out_of_range, Qerror_message,
- make_pure_c_string ("Args out of range"));
-
- Fput (Qvoid_function, Qerror_conditions,
- pure_cons (Qvoid_function, error_tail));
- Fput (Qvoid_function, Qerror_message,
- make_pure_c_string ("Symbol's function definition is void"));
-
- Fput (Qcyclic_function_indirection, Qerror_conditions,
- pure_cons (Qcyclic_function_indirection, error_tail));
- Fput (Qcyclic_function_indirection, Qerror_message,
- make_pure_c_string ("Symbol's chain of function indirections contains a loop"));
-
- Fput (Qcyclic_variable_indirection, Qerror_conditions,
- pure_cons (Qcyclic_variable_indirection, error_tail));
- Fput (Qcyclic_variable_indirection, Qerror_message,
- make_pure_c_string ("Symbol's chain of variable indirections contains a loop"));
-
+ build_pure_c_string ("error"));
+
+#define PUT_ERROR(sym, tail, msg) \
+ Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \
+ Fput (sym, Qerror_message, build_pure_c_string (msg))
+
+ PUT_ERROR (Qquit, Qnil, "Quit");
+
+ PUT_ERROR (Quser_error, error_tail, "");
+ PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument");
+ PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range");
+ PUT_ERROR (Qvoid_function, error_tail,
+ "Symbol's function definition is void");
+ PUT_ERROR (Qcyclic_function_indirection, error_tail,
+ "Symbol's chain of function indirections contains a loop");
+ PUT_ERROR (Qcyclic_variable_indirection, error_tail,
+ "Symbol's chain of variable indirections contains a loop");
DEFSYM (Qcircular_list, "circular-list");
- Fput (Qcircular_list, Qerror_conditions,
- pure_cons (Qcircular_list, error_tail));
- Fput (Qcircular_list, Qerror_message,
- make_pure_c_string ("List contains a loop"));
-
- Fput (Qvoid_variable, Qerror_conditions,
- pure_cons (Qvoid_variable, error_tail));
- Fput (Qvoid_variable, Qerror_message,
- make_pure_c_string ("Symbol's value as variable is void"));
-
- Fput (Qsetting_constant, Qerror_conditions,
- pure_cons (Qsetting_constant, error_tail));
- Fput (Qsetting_constant, Qerror_message,
- make_pure_c_string ("Attempt to set a constant symbol"));
-
- Fput (Qinvalid_read_syntax, Qerror_conditions,
- pure_cons (Qinvalid_read_syntax, error_tail));
- Fput (Qinvalid_read_syntax, Qerror_message,
- make_pure_c_string ("Invalid read syntax"));
-
- Fput (Qinvalid_function, Qerror_conditions,
- pure_cons (Qinvalid_function, error_tail));
- Fput (Qinvalid_function, Qerror_message,
- make_pure_c_string ("Invalid function"));
-
- Fput (Qwrong_number_of_arguments, Qerror_conditions,
- pure_cons (Qwrong_number_of_arguments, error_tail));
- Fput (Qwrong_number_of_arguments, Qerror_message,
- make_pure_c_string ("Wrong number of arguments"));
-
- Fput (Qno_catch, Qerror_conditions,
- pure_cons (Qno_catch, error_tail));
- Fput (Qno_catch, Qerror_message,
- make_pure_c_string ("No catch for tag"));
-
- Fput (Qend_of_file, Qerror_conditions,
- pure_cons (Qend_of_file, error_tail));
- Fput (Qend_of_file, Qerror_message,
- make_pure_c_string ("End of file during parsing"));
+ PUT_ERROR (Qcircular_list, error_tail, "List contains a loop");
+ PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void");
+ PUT_ERROR (Qsetting_constant, error_tail,
+ "Attempt to set a constant symbol");
+ PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax");
+ PUT_ERROR (Qinvalid_function, error_tail, "Invalid function");
+ PUT_ERROR (Qwrong_number_of_arguments, error_tail,
+ "Wrong number of arguments");
+ PUT_ERROR (Qno_catch, error_tail, "No catch for tag");
+ PUT_ERROR (Qend_of_file, error_tail, "End of file during parsing");
arith_tail = pure_cons (Qarith_error, error_tail);
- Fput (Qarith_error, Qerror_conditions,
- arith_tail);
- Fput (Qarith_error, Qerror_message,
- make_pure_c_string ("Arithmetic error"));
-
- Fput (Qbeginning_of_buffer, Qerror_conditions,
- pure_cons (Qbeginning_of_buffer, error_tail));
- Fput (Qbeginning_of_buffer, Qerror_message,
- make_pure_c_string ("Beginning of buffer"));
-
- Fput (Qend_of_buffer, Qerror_conditions,
- pure_cons (Qend_of_buffer, error_tail));
- Fput (Qend_of_buffer, Qerror_message,
- make_pure_c_string ("End of buffer"));
-
- Fput (Qbuffer_read_only, Qerror_conditions,
- pure_cons (Qbuffer_read_only, error_tail));
- Fput (Qbuffer_read_only, Qerror_message,
- make_pure_c_string ("Buffer is read-only"));
-
- Fput (Qtext_read_only, Qerror_conditions,
- pure_cons (Qtext_read_only, error_tail));
- Fput (Qtext_read_only, Qerror_message,
- make_pure_c_string ("Text is read-only"));
+ Fput (Qarith_error, Qerror_conditions, arith_tail);
+ Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error"));
+
+ PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer");
+ PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer");
+ PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only");
+ PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail),
+ "Text is read-only");
DEFSYM (Qrange_error, "range-error");
DEFSYM (Qdomain_error, "domain-error");
DEFSYM (Qoverflow_error, "overflow-error");
DEFSYM (Qunderflow_error, "underflow-error");
- Fput (Qdomain_error, Qerror_conditions,
- pure_cons (Qdomain_error, arith_tail));
- Fput (Qdomain_error, Qerror_message,
- make_pure_c_string ("Arithmetic domain error"));
-
- Fput (Qrange_error, Qerror_conditions,
- pure_cons (Qrange_error, arith_tail));
- Fput (Qrange_error, Qerror_message,
- make_pure_c_string ("Arithmetic range error"));
+ PUT_ERROR (Qdomain_error, arith_tail, "Arithmetic domain error");
- Fput (Qsingularity_error, Qerror_conditions,
- pure_cons (Qsingularity_error, Fcons (Qdomain_error, arith_tail)));
- Fput (Qsingularity_error, Qerror_message,
- make_pure_c_string ("Arithmetic singularity error"));
+ PUT_ERROR (Qrange_error, arith_tail, "Arithmetic range error");
- Fput (Qoverflow_error, Qerror_conditions,
- pure_cons (Qoverflow_error, Fcons (Qdomain_error, arith_tail)));
- Fput (Qoverflow_error, Qerror_message,
- make_pure_c_string ("Arithmetic overflow error"));
+ PUT_ERROR (Qsingularity_error, Fcons (Qdomain_error, arith_tail),
+ "Arithmetic singularity error");
- Fput (Qunderflow_error, Qerror_conditions,
- pure_cons (Qunderflow_error, Fcons (Qdomain_error, arith_tail)));
- Fput (Qunderflow_error, Qerror_message,
- make_pure_c_string ("Arithmetic underflow error"));
+ PUT_ERROR (Qoverflow_error, Fcons (Qdomain_error, arith_tail),
+ "Arithmetic overflow error");
+ PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail),
+ "Arithmetic underflow error");
staticpro (&Qnil);
staticpro (&Qt);
DEFSYM (Qwindow_configuration, "window-configuration");
DEFSYM (Qprocess, "process");
DEFSYM (Qwindow, "window");
- /* DEFSYM (Qsubr, "subr"); */
DEFSYM (Qcompiled_function, "compiled-function");
DEFSYM (Qbuffer, "buffer");
DEFSYM (Qframe, "frame");
DEFSYM (Qchar_table, "char-table");
DEFSYM (Qbool_vector, "bool-vector");
DEFSYM (Qhash_table, "hash-table");
+ DEFSYM (Qmisc, "misc");
+
+ DEFSYM (Qdefun, "defun");
DEFSYM (Qfont_spec, "font-spec");
DEFSYM (Qfont_entity, "font-entity");
defsubr (&Ssubr_arity);
defsubr (&Ssubr_name);
- XSYMBOL (Qwholenump)->function = 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. */);
Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
}
-
-#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
-static void arith_error (int) NO_RETURN;
-#endif
-
-static void
-arith_error (int signo)
-{
- sigsetmask (SIGEMPTYMASK);
-
- SIGNAL_THREAD_CHECK (signo);
- xsignal0 (Qarith_error);
-}
-
-void
-init_data (void)
-{
- /* Don't do this if just dumping out.
- We don't want to call `signal' in this case
- so that we don't have trouble with dumping
- signal-delivering routines in an inconsistent state. */
-#ifndef CANNOT_DUMP
- if (!initialized)
- return;
-#endif /* CANNOT_DUMP */
- signal (SIGFPE, arith_error);
-}
#ifdef HAVE_DBUS
#include <stdio.h>
#include <dbus/dbus.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "frame.h"
#include "termhooks.h"
#include "keyboard.h"
#include "process.h"
+#ifndef DBUS_NUM_MESSAGE_TYPES
+#define DBUS_NUM_MESSAGE_TYPES 5
+#endif
+
\f
/* Subroutines. */
static Lisp_Object Qdbus_init_bus;
-static Lisp_Object Qdbus_close_bus;
static Lisp_Object Qdbus_get_unique_name;
-static Lisp_Object Qdbus_call_method;
-static Lisp_Object Qdbus_call_method_asynchronously;
-static Lisp_Object Qdbus_method_return_internal;
-static Lisp_Object Qdbus_method_error_internal;
-static Lisp_Object Qdbus_send_signal;
-static Lisp_Object Qdbus_register_service;
-static Lisp_Object Qdbus_register_signal;
-static Lisp_Object Qdbus_register_method;
+static Lisp_Object Qdbus_message_internal;
/* D-Bus error symbol. */
static Lisp_Object Qdbus_error;
/* Lisp symbol for method call timeout. */
static Lisp_Object QCdbus_timeout;
-/* Lisp symbols for name request flags. */
-static Lisp_Object QCdbus_request_name_allow_replacement;
-static Lisp_Object QCdbus_request_name_replace_existing;
-static Lisp_Object QCdbus_request_name_do_not_queue;
-
-/* Lisp symbols for name request replies. */
-static Lisp_Object QCdbus_request_name_reply_primary_owner;
-static Lisp_Object QCdbus_request_name_reply_in_queue;
-static Lisp_Object QCdbus_request_name_reply_exists;
-static Lisp_Object QCdbus_request_name_reply_already_owner;
-
/* Lisp symbols of D-Bus types. */
static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
+/* Lisp symbols of objects in `dbus-registered-objects-table'. */
+static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
+static Lisp_Object QCdbus_registered_signal;
+
+/* Alist of D-Bus buses we are polling for messages.
+ The key is the symbol or string of the bus, and the value is the
+ connection address. */
+static Lisp_Object xd_registered_buses;
+
/* Whether we are reading a D-Bus event. */
-static int xd_in_read_queued_messages = 0;
+static bool xd_in_read_queued_messages = 0;
\f
/* We use "xd_" and "XD_" as prefix for all internal symbols, because
} while (0)
/* Macros for debugging. In order to enable them, build with
- "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
+ "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
#ifdef DBUS_DEBUG
-#define XD_DEBUG_MESSAGE(...) \
- do { \
- char s[1024]; \
- snprintf (s, sizeof s, __VA_ARGS__); \
- printf ("%s: %s\n", __func__, s); \
- message ("%s: %s", __func__, s); \
+#define XD_DEBUG_MESSAGE(...) \
+ do { \
+ char s[1024]; \
+ snprintf (s, sizeof s, __VA_ARGS__); \
+ if (!noninteractive) \
+ printf ("%s: %s\n", __func__, s); \
+ message ("%s: %s", __func__, s); \
} while (0)
#define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
do { \
if (!NILP (Vdbus_debug)) \
{ \
char s[1024]; \
- snprintf (s, 1023, __VA_ARGS__); \
+ snprintf (s, sizeof s, __VA_ARGS__); \
message ("%s: %s", __func__, s); \
} \
} while (0)
#endif
/* Check whether TYPE is a basic DBusType. */
+#ifdef HAVE_DBUS_TYPE_IS_VALID
+#define XD_BASIC_DBUS_TYPE(type) \
+ (dbus_type_is_valid (type) && dbus_type_is_basic (type))
+#else
#ifdef DBUS_TYPE_UNIX_FD
#define XD_BASIC_DBUS_TYPE(type) \
((type == DBUS_TYPE_BYTE) \
|| (type == DBUS_TYPE_OBJECT_PATH) \
|| (type == DBUS_TYPE_SIGNATURE))
#endif
+#endif
/* This was a macro. On Solaris 2.11 it was said to compile for
hours, when optimization is enabled. So we have transferred it into
#define XD_NEXT_VALUE(object) \
((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
-/* Check whether X is a valid dbus serial number. If valid, set
- SERIAL to its value. Otherwise, signal an error. */
-#define CHECK_DBUS_SERIAL_GET_SERIAL(x, serial) \
- do \
- { \
- dbus_uint32_t DBUS_SERIAL_MAX = -1; \
- if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX) \
- serial = XINT (x); \
- else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX \
- && FLOATP (x) \
- && 0 <= XFLOAT_DATA (x) \
- && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX) \
- serial = XFLOAT_DATA (x); \
- else \
- XD_SIGNAL2 (build_string ("Invalid dbus serial"), x); \
- } \
- while (0)
+/* Transform the message type to its string representation for debug
+ messages. */
+#define XD_MESSAGE_TYPE_TO_STRING(mtype) \
+ ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
+ ? "DBUS_MESSAGE_TYPE_INVALID" \
+ : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
+ ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
+ : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
+ ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
+ : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
+ ? "DBUS_MESSAGE_TYPE_ERROR" \
+ : "DBUS_MESSAGE_TYPE_SIGNAL")
+
+/* Transform the object to its string representation for debug
+ messages. */
+#define XD_OBJECT_TO_STRING(object) \
+ SDATA (format2 ("%s", object, Qnil))
+
+#define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
+ do { \
+ char const *session_bus_address = getenv ("DBUS_SESSION_BUS_ADDRESS"); \
+ if (STRINGP (bus)) \
+ { \
+ DBusAddressEntry **entries; \
+ int len; \
+ DBusError derror; \
+ dbus_error_init (&derror); \
+ if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
+ XD_ERROR (derror); \
+ /* Cleanup. */ \
+ dbus_error_free (&derror); \
+ dbus_address_entries_free (entries); \
+ /* Canonicalize session bus address. */ \
+ if ((session_bus_address != NULL) \
+ && (!NILP (Fstring_equal \
+ (bus, build_string (session_bus_address))))) \
+ bus = QCdbus_session_bus; \
+ } \
+ \
+ else \
+ { \
+ CHECK_SYMBOL (bus); \
+ if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
+ XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
+ /* We do not want to have an autolaunch for the session bus. */ \
+ if (EQ (bus, QCdbus_session_bus) && session_bus_address == NULL) \
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
+ } \
+ } while (0)
+
+#if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
+ || XD_DBUS_VALIDATE_OBJECT || HAVE_DBUS_VALIDATE_MEMBER)
+#define XD_DBUS_VALIDATE_OBJECT(object, func) \
+ do { \
+ if (!NILP (object)) \
+ { \
+ DBusError derror; \
+ CHECK_STRING (object); \
+ dbus_error_init (&derror); \
+ if (!func (SSDATA (object), &derror)) \
+ XD_ERROR (derror); \
+ /* Cleanup. */ \
+ dbus_error_free (&derror); \
+ } \
+ } while (0)
+#endif
+
+#if HAVE_DBUS_VALIDATE_BUS_NAME
+#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
+ XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
+#else
+#define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
+ if (!NILP (bus_name)) CHECK_STRING (bus_name);
+#endif
+
+#if HAVE_DBUS_VALIDATE_PATH
+#define XD_DBUS_VALIDATE_PATH(path) \
+ XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
+#else
+#define XD_DBUS_VALIDATE_PATH(path) \
+ if (!NILP (path)) CHECK_STRING (path);
+#endif
+
+#if HAVE_DBUS_VALIDATE_INTERFACE
+#define XD_DBUS_VALIDATE_INTERFACE(interface) \
+ XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
+#else
+#define XD_DBUS_VALIDATE_INTERFACE(interface) \
+ if (!NILP (interface)) CHECK_STRING (interface);
+#endif
+
+#if HAVE_DBUS_VALIDATE_MEMBER
+#define XD_DBUS_VALIDATE_MEMBER(member) \
+ XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
+#else
+#define XD_DBUS_VALIDATE_MEMBER(member) \
+ if (!NILP (member)) CHECK_STRING (member);
+#endif
/* Append to SIGNATURE a copy of X, making sure SIGNATURE does
not become too long. */
signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
static void
-xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lisp_Object object)
+xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
{
- unsigned int subtype;
+ int subtype;
Lisp_Object elt;
char const *subsig;
int subsiglen;
{
case DBUS_TYPE_BYTE:
case DBUS_TYPE_UINT16:
- case DBUS_TYPE_UINT32:
- case DBUS_TYPE_UINT64:
-#ifdef DBUS_TYPE_UNIX_FD
- case DBUS_TYPE_UNIX_FD:
-#endif
CHECK_NATNUM (object);
sprintf (signature, "%c", dtype);
break;
break;
case DBUS_TYPE_INT16:
- case DBUS_TYPE_INT32:
- case DBUS_TYPE_INT64:
CHECK_NUMBER (object);
sprintf (signature, "%c", dtype);
break;
+ case DBUS_TYPE_UINT32:
+ case DBUS_TYPE_UINT64:
+#ifdef DBUS_TYPE_UNIX_FD
+ case DBUS_TYPE_UNIX_FD:
+#endif
+ case DBUS_TYPE_INT32:
+ case DBUS_TYPE_INT64:
case DBUS_TYPE_DOUBLE:
- CHECK_FLOAT (object);
+ CHECK_NUMBER_OR_FLOAT (object);
sprintf (signature, "%c", dtype);
break;
}
/* If the element type is DBUS_TYPE_SIGNATURE, and this is the
- only element, the value of this element is used as he array's
- element signature. */
+ only element, the value of this element is used as the
+ array's element signature. */
if ((subtype == DBUS_TYPE_SIGNATURE)
&& STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
&& NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
XD_DEBUG_MESSAGE ("%s", signature);
}
+/* Convert X to a signed integer with bounds LO and HI. */
+static intmax_t
+xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
+{
+ CHECK_NUMBER_OR_FLOAT (x);
+ if (INTEGERP (x))
+ {
+ if (lo <= XINT (x) && XINT (x) <= hi)
+ return XINT (x);
+ }
+ else
+ {
+ double d = XFLOAT_DATA (x);
+ if (lo <= d && d <= hi)
+ {
+ intmax_t n = d;
+ if (n == d)
+ return n;
+ }
+ }
+ if (xd_in_read_queued_messages)
+ Fthrow (Qdbus_error, Qnil);
+ else
+ args_out_of_range_3 (x,
+ make_fixnum_or_float (lo),
+ make_fixnum_or_float (hi));
+}
+
+/* Convert X to an unsigned integer with bounds 0 and HI. */
+static uintmax_t
+xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
+{
+ CHECK_NUMBER_OR_FLOAT (x);
+ if (INTEGERP (x))
+ {
+ if (0 <= XINT (x) && XINT (x) <= hi)
+ return XINT (x);
+ }
+ else
+ {
+ double d = XFLOAT_DATA (x);
+ if (0 <= d && d <= hi)
+ {
+ uintmax_t n = d;
+ if (n == d)
+ return n;
+ }
+ }
+ if (xd_in_read_queued_messages)
+ Fthrow (Qdbus_error, Qnil);
+ else
+ args_out_of_range_3 (x, make_number (0), make_fixnum_or_float (hi));
+}
+
/* Append C value, extracted from Lisp OBJECT, to iteration ITER.
DTYPE must be a valid DBusType. It is used to convert Lisp
objects, being arguments of `dbus-call-method' or
`dbus-send-signal', into corresponding C values appended as
arguments to a D-Bus message. */
static void
-xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
+xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
{
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
DBusMessageIter subiter;
CHECK_NATNUM (object);
{
unsigned char val = XFASTINT (object) & 0xFF;
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ XD_DEBUG_MESSAGE ("%c %u", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_INT16:
- CHECK_NUMBER (object);
{
- dbus_int16_t val = XINT (object);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ dbus_int16_t val =
+ xd_extract_signed (object,
+ TYPE_MINIMUM (dbus_int16_t),
+ TYPE_MAXIMUM (dbus_int16_t));
+ int pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_UINT16:
- CHECK_NATNUM (object);
{
- dbus_uint16_t val = XFASTINT (object);
- XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
+ dbus_uint16_t val =
+ xd_extract_unsigned (object,
+ TYPE_MAXIMUM (dbus_uint16_t));
+ unsigned int pval = val;
+ XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_INT32:
- CHECK_NUMBER (object);
{
- dbus_int32_t val = XINT (object);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ dbus_int32_t val =
+ xd_extract_signed (object,
+ TYPE_MINIMUM (dbus_int32_t),
+ TYPE_MAXIMUM (dbus_int32_t));
+ int pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
#ifdef DBUS_TYPE_UNIX_FD
case DBUS_TYPE_UNIX_FD:
#endif
- CHECK_NATNUM (object);
{
- dbus_uint32_t val = XFASTINT (object);
- XD_DEBUG_MESSAGE ("%c %u", dtype, val);
+ dbus_uint32_t val =
+ xd_extract_unsigned (object,
+ TYPE_MAXIMUM (dbus_uint32_t));
+ unsigned int pval = val;
+ XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_INT64:
- CHECK_NUMBER (object);
{
- dbus_int64_t val = XINT (object);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ dbus_int64_t val =
+ xd_extract_signed (object,
+ TYPE_MINIMUM (dbus_int64_t),
+ TYPE_MAXIMUM (dbus_int64_t));
+ printmax_t pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_UINT64:
- CHECK_NATNUM (object);
{
- dbus_uint64_t val = XFASTINT (object);
- XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object));
+ dbus_uint64_t val =
+ xd_extract_unsigned (object,
+ TYPE_MAXIMUM (dbus_uint64_t));
+ uprintmax_t pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
case DBUS_TYPE_DOUBLE:
- CHECK_FLOAT (object);
{
- double val = XFLOAT_DATA (object);
+ double val = extract_float (object);
XD_DEBUG_MESSAGE ("%c %f", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
- SDATA (format2 ("%s", object, Qnil)));
+ XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
XD_SIGNAL3 (build_string ("Cannot open container"),
dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
- SDATA (format2 ("%s", object, Qnil)));
+ XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
XD_SIGNAL3 (build_string ("Cannot open container"),
case DBUS_TYPE_STRUCT:
case DBUS_TYPE_DICT_ENTRY:
/* These containers do not require a signature. */
- XD_DEBUG_MESSAGE ("%c %s", dtype,
- SDATA (format2 ("%s", object, Qnil)));
+ XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
XD_SIGNAL2 (build_string ("Cannot open container"),
make_number (dtype));
D-Bus message must be a valid DBusType. Compound D-Bus types
result always in a Lisp list. */
static Lisp_Object
-xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
+xd_retrieve_arg (int dtype, DBusMessageIter *iter)
{
switch (dtype)
unsigned int val;
dbus_message_iter_get_basic (iter, &val);
val = val & 0xFF;
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ XD_DEBUG_MESSAGE ("%c %u", dtype, val);
return make_number (val);
}
case DBUS_TYPE_INT16:
{
dbus_int16_t val;
+ int pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_number (val);
}
case DBUS_TYPE_UINT16:
{
dbus_uint16_t val;
+ int pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_number (val);
}
case DBUS_TYPE_INT32:
{
dbus_int32_t val;
+ int pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_fixnum_or_float (val);
}
#endif
{
dbus_uint32_t val;
+ unsigned int pval = val;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
return make_fixnum_or_float (val);
}
case DBUS_TYPE_INT64:
{
dbus_int64_t val;
+ printmax_t pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
return make_fixnum_or_float (val);
}
case DBUS_TYPE_UINT64:
{
dbus_uint64_t val;
+ uprintmax_t pval;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+ pval = val;
+ XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
return make_fixnum_or_float (val);
}
result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
dbus_message_iter_next (&subiter);
}
- XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
+ XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
RETURN_UNGCPRO (Fnreverse (result));
}
}
}
-/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system
- or :session, or a string denoting the bus address. It tells which
- D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error
- when the connection cannot be initialized. */
+/* Return the number of references of the shared CONNECTION. */
+static ptrdiff_t
+xd_get_connection_references (DBusConnection *connection)
+{
+ ptrdiff_t *refcount;
+
+ /* We cannot access the DBusConnection structure, it is not public.
+ But we know, that the reference counter is the first field in
+ that structure. */
+ refcount = (void *) &connection;
+ refcount = (void *) *refcount;
+ return *refcount;
+}
+
+/* Return D-Bus connection address. BUS is either a Lisp symbol,
+ :system or :session, or a string denoting the bus address. */
static DBusConnection *
-xd_initialize (Lisp_Object bus, int raise_error)
+xd_get_connection_address (Lisp_Object bus)
{
DBusConnection *connection;
- DBusError derror;
-
- /* Parameter check. */
- if (!STRINGP (bus))
- {
- CHECK_SYMBOL (bus);
- if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
- {
- if (raise_error)
- XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
- else
- return NULL;
- }
+ Lisp_Object val;
- /* We do not want to have an autolaunch for the session bus. */
- if (EQ (bus, QCdbus_session_bus)
- && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
- {
- if (raise_error)
- XD_SIGNAL2 (build_string ("No connection to bus"), bus);
- else
- return NULL;
- }
- }
-
- /* Open a connection to the bus. */
- dbus_error_init (&derror);
-
- if (STRINGP (bus))
- connection = dbus_connection_open (SSDATA (bus), &derror);
+ val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
+ if (NILP (val))
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus);
else
- if (EQ (bus, QCdbus_system_bus))
- connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
- else
- connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
-
- if (dbus_error_is_set (&derror))
- {
- if (raise_error)
- XD_ERROR (derror);
- else
- connection = NULL;
- }
-
- /* If it is not the system or session bus, we must register
- ourselves. Otherwise, we have called dbus_bus_get, which has
- configured us to exit if the connection closes - we undo this
- setting. */
- if (connection != NULL)
- {
- if (STRINGP (bus))
- dbus_bus_register (connection, &derror);
- else
- dbus_connection_set_exit_on_disconnect (connection, FALSE);
- }
-
- if (dbus_error_is_set (&derror))
- {
- if (raise_error)
- XD_ERROR (derror);
- else
- connection = NULL;
- }
+ connection = (DBusConnection *) (intptr_t) XFASTINT (val);
- if (connection == NULL && raise_error)
+ if (!dbus_connection_get_is_connected (connection))
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
- /* Cleanup. */
- dbus_error_free (&derror);
-
- /* Return the result. */
return connection;
}
xd_find_watch_fd (DBusWatch *watch)
{
#if HAVE_DBUS_WATCH_GET_UNIX_FD
- /* TODO: Reverse these on Win32, which prefers the opposite. */
+ /* TODO: Reverse these on w32, which prefers the opposite. */
int fd = dbus_watch_get_unix_fd (watch);
if (fd == -1)
fd = dbus_watch_get_socket (watch);
}
/* Prototype. */
-static void
-xd_read_queued_messages (int fd, void *data, int for_read);
+static void xd_read_queued_messages (int fd, void *data);
/* Start monitoring WATCH for possible I/O. */
static dbus_bool_t
int fd = xd_find_watch_fd (watch);
XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
- fd, flags & DBUS_WATCH_WRITABLE,
- dbus_watch_get_enabled (watch));
+ fd, flags & DBUS_WATCH_WRITABLE,
+ dbus_watch_get_enabled (watch));
if (fd == -1)
return FALSE;
return;
/* Unset session environment. */
+#if 0
if (XSYMBOL (QCdbus_session_bus) == data)
{
XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
unsetenv ("DBUS_SESSION_BUS_ADDRESS");
}
+#endif
if (flags & DBUS_WATCH_WRITABLE)
delete_write_fd (fd);
xd_remove_watch (watch, data);
}
-DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
- doc: /* Initialize connection to D-Bus BUS. */)
- (Lisp_Object bus)
+/* Close connection to D-Bus BUS. */
+static void
+xd_close_bus (Lisp_Object bus)
{
DBusConnection *connection;
- void *busp;
+ Lisp_Object val;
- /* Check parameter. */
- if (SYMBOLP (bus))
- busp = XSYMBOL (bus);
- else if (STRINGP (bus))
- busp = XSTRING (bus);
- else
- wrong_type_argument (intern ("D-Bus"), bus);
+ /* Check whether we are connected. */
+ val = Fassoc (bus, xd_registered_buses);
+ if (NILP (val))
+ return;
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
+ /* Retrieve bus address. */
+ connection = xd_get_connection_address (bus);
- /* Add the watch functions. We pass also the bus as data, in order
- to distinguish between the buses in xd_remove_watch. */
- if (!dbus_connection_set_watch_functions (connection,
- xd_add_watch,
- xd_remove_watch,
- xd_toggle_watch,
- busp, NULL))
- XD_SIGNAL1 (build_string ("Cannot add watch functions"));
+ if (xd_get_connection_references (connection) == 1)
+ {
+ /* Close connection, if there isn't another shared application. */
+ XD_DEBUG_MESSAGE ("Close connection to bus %s",
+ XD_OBJECT_TO_STRING (bus));
+ dbus_connection_close (connection);
- /* Add bus to list of registered buses. */
- Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses);
+ xd_registered_buses = Fdelete (val, xd_registered_buses);
+ }
- /* We do not want to abort. */
- putenv ((char *) "DBUS_FATAL_WARNINGS=0");
+ else
+ /* Decrement reference count. */
+ dbus_connection_unref (connection);
/* Return. */
- return Qnil;
+ return;
}
-DEFUN ("dbus-close-bus", Fdbus_close_bus, Sdbus_close_bus, 1, 1, 0,
- doc: /* Close connection to D-Bus BUS. */)
- (Lisp_Object bus)
+DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0,
+ doc: /* Establish the connection to D-Bus BUS.
+
+BUS can be either the symbol `:system' or the symbol `:session', or it
+can be a string denoting the address of the corresponding bus. For
+the system and session buses, this function is called when loading
+`dbus.el', there is no need to call it again.
+
+The function returns a number, which counts the connections this Emacs
+session has established to the BUS under the same unique name (see
+`dbus-get-unique-name'). It depends on the libraries Emacs is linked
+with, and on the environment Emacs is running. For example, if Emacs
+is linked with the gtk toolkit, and it runs in a GTK-aware environment
+like Gnome, another connection might already be established.
+
+When PRIVATE is non-nil, a new connection is established instead of
+reusing an existing one. It results in a new unique name at the bus.
+This can be used, if it is necessary to distinguish from another
+connection used in the same Emacs process, like the one established by
+GTK+. It should be used with care for at least the `:system' and
+`:session' buses, because other Emacs Lisp packages might already use
+this connection to those buses. */)
+ (Lisp_Object bus, Lisp_Object private)
{
DBusConnection *connection;
+ DBusError derror;
+ Lisp_Object val;
+ ptrdiff_t refcount;
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
+ /* Check parameter. */
+ XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
- /* Decrement reference count to the bus. */
- dbus_connection_unref (connection);
+ /* Close bus if it is already open. */
+ xd_close_bus (bus);
- /* Remove bus from list of registered buses. */
- Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses);
+ /* Check, whether we are still connected. */
+ val = Fassoc (bus, xd_registered_buses);
+ if (!NILP (val))
+ {
+ connection = xd_get_connection_address (bus);
+ dbus_connection_ref (connection);
+ }
- /* Return. */
- return Qnil;
+ else
+ {
+ /* Initialize. */
+ dbus_error_init (&derror);
+
+ /* Open the connection. */
+ if (STRINGP (bus))
+ if (NILP (private))
+ connection = dbus_connection_open (SSDATA (bus), &derror);
+ else
+ connection = dbus_connection_open_private (SSDATA (bus), &derror);
+
+ else
+ if (NILP (private))
+ connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
+ &derror);
+ else
+ connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
+ &derror);
+
+ if (dbus_error_is_set (&derror))
+ XD_ERROR (derror);
+
+ if (connection == NULL)
+ XD_SIGNAL2 (build_string ("No connection to bus"), bus);
+
+ /* If it is not the system or session bus, we must register
+ ourselves. Otherwise, we have called dbus_bus_get, which has
+ configured us to exit if the connection closes - we undo this
+ setting. */
+ if (STRINGP (bus))
+ dbus_bus_register (connection, &derror);
+ else
+ dbus_connection_set_exit_on_disconnect (connection, FALSE);
+
+ if (dbus_error_is_set (&derror))
+ XD_ERROR (derror);
+
+ /* Add the watch functions. We pass also the bus as data, in
+ order to distinguish between the buses in xd_remove_watch. */
+ if (!dbus_connection_set_watch_functions (connection,
+ xd_add_watch,
+ xd_remove_watch,
+ xd_toggle_watch,
+ SYMBOLP (bus)
+ ? (void *) XSYMBOL (bus)
+ : (void *) XSTRING (bus),
+ NULL))
+ XD_SIGNAL1 (build_string ("Cannot add watch functions"));
+
+ /* Add bus to list of registered buses. */
+ XSETFASTINT (val, (intptr_t) connection);
+ xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
+
+ /* We do not want to abort. */
+ putenv ((char *) "DBUS_FATAL_WARNINGS=0");
+
+ /* Cleanup. */
+ dbus_error_free (&derror);
+ }
+
+ /* Return reference counter. */
+ refcount = xd_get_connection_references (connection);
+ XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d",
+ XD_OBJECT_TO_STRING (bus), refcount);
+ return make_number (refcount);
}
DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
DBusConnection *connection;
const char *name;
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
+ /* Check parameter. */
+ XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
+
+ /* Retrieve bus address. */
+ connection = xd_get_connection_address (bus);
/* Request the name. */
name = dbus_bus_get_unique_name (connection);
return build_string (name);
}
-DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
- doc: /* Call METHOD on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name to be used. PATH is the D-Bus
-object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE. It must provide METHOD.
-
-If the parameter `:timeout' is given, the following integer TIMEOUT
-specifies the maximum number of milliseconds the method call must
-return. The default value is 25,000. If the method call doesn't
-return in time, a D-Bus error is raised.
-
-All other arguments ARGS are passed to METHOD as arguments. They are
-converted into D-Bus types via the following rules:
-
- t and nil => DBUS_TYPE_BOOLEAN
- number => DBUS_TYPE_UINT32
- integer => DBUS_TYPE_INT32
- float => DBUS_TYPE_DOUBLE
- string => DBUS_TYPE_STRING
- list => DBUS_TYPE_ARRAY
-
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
-
-`dbus-call-method' returns the resulting values of METHOD as a list of
-Lisp objects. The type conversion happens the other direction as for
-input arguments. It follows the mapping rules:
-
- DBUS_TYPE_BOOLEAN => t or nil
- DBUS_TYPE_BYTE => number
- DBUS_TYPE_UINT16 => number
- DBUS_TYPE_INT16 => integer
- DBUS_TYPE_UINT32 => number or float
- DBUS_TYPE_UNIX_FD => number or float
- DBUS_TYPE_INT32 => integer or float
- DBUS_TYPE_UINT64 => number or float
- DBUS_TYPE_INT64 => integer or float
- DBUS_TYPE_DOUBLE => float
- DBUS_TYPE_STRING => string
- DBUS_TYPE_OBJECT_PATH => string
- DBUS_TYPE_SIGNATURE => string
- DBUS_TYPE_ARRAY => list
- DBUS_TYPE_VARIANT => list
- DBUS_TYPE_STRUCT => list
- DBUS_TYPE_DICT_ENTRY => list
-
-Example:
-
-\(dbus-call-method
- :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
- "org.gnome.seahorse.Keys" "GetKeyField"
- "openpgp:657984B8C7A966DD" "simple-name")
-
- => (t ("Philip R. Zimmermann"))
-
-If the result of the METHOD call is just one value, the converted Lisp
-object is returned instead of a list containing this single Lisp object.
-
-\(dbus-call-method
- :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
- "org.freedesktop.Hal.Device" "GetPropertyString"
- "system.kernel.machine")
-
- => "i686"
-
-usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
+DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
+ 4, MANY, 0,
+ doc: /* Send a D-Bus message.
+This is an internal function, it shall not be used outside dbus.el.
+
+The following usages are expected:
+
+`dbus-call-method', `dbus-call-method-asynchronously':
+ \(dbus-message-internal
+ dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
+ &optional :timeout TIMEOUT &rest ARGS)
+
+`dbus-send-signal':
+ \(dbus-message-internal
+ dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
+
+`dbus-method-return-internal':
+ \(dbus-message-internal
+ dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
+
+`dbus-method-error-internal':
+ \(dbus-message-internal
+ dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
+
+usage: (dbus-message-internal &rest REST) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object bus, service, path, interface, method;
+ Lisp_Object message_type, bus, service, handler;
+ Lisp_Object path = Qnil;
+ Lisp_Object interface = Qnil;
+ Lisp_Object member = Qnil;
Lisp_Object result;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
DBusConnection *connection;
DBusMessage *dmessage;
- DBusMessage *reply;
DBusMessageIter iter;
- DBusError derror;
- unsigned int dtype;
+ int dtype;
+ int mtype;
+ dbus_uint32_t serial = 0;
+ unsigned int ui_serial;
int timeout = -1;
- ptrdiff_t i = 5;
+ ptrdiff_t count;
char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+ /* Initialize parameters. */
+ message_type = args[0];
+ bus = args[1];
+ service = args[2];
+ handler = Qnil;
+
+ CHECK_NATNUM (message_type);
+ if (! (DBUS_MESSAGE_TYPE_INVALID < XFASTINT (message_type)
+ && XFASTINT (message_type) < DBUS_NUM_MESSAGE_TYPES))
+ XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
+ mtype = XFASTINT (message_type);
+
+ if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
+ {
+ path = args[3];
+ interface = args[4];
+ member = args[5];
+ if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ handler = args[6];
+ count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
+ }
+ else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ {
+ serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t));
+ count = 4;
+ }
+
/* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- method = args[4];
-
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (method);
- GCPRO5 (bus, service, path, interface, method);
-
- XD_DEBUG_MESSAGE ("%s %s %s %s",
- SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (method));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new_method_call (SSDATA (service),
- SSDATA (path),
- SSDATA (interface),
- SSDATA (method));
- UNGCPRO;
- if (dmessage == NULL)
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
+ XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
+ XD_DBUS_VALIDATE_BUS_NAME (service);
+ if (nargs < count)
+ xsignal2 (Qwrong_number_of_arguments,
+ Qdbus_message_internal,
+ make_number (nargs));
+
+ if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
+ {
+ XD_DBUS_VALIDATE_PATH (path);
+ XD_DBUS_VALIDATE_INTERFACE (interface);
+ XD_DBUS_VALIDATE_MEMBER (member);
+ if (!NILP (handler) && (!FUNCTIONP (handler)))
+ wrong_type_argument (Qinvalid_function, handler);
+ }
- /* Check for timeout parameter. */
- if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
+ /* Protect Lisp variables. */
+ GCPRO6 (bus, service, path, interface, member, handler);
+
+ /* Trace parameters. */
+ switch (mtype)
{
- CHECK_NATNUM (args[i+1]);
- timeout = XFASTINT (args[i+1]);
- i = i+2;
+ case DBUS_MESSAGE_TYPE_METHOD_CALL:
+ XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ XD_OBJECT_TO_STRING (path),
+ XD_OBJECT_TO_STRING (interface),
+ XD_OBJECT_TO_STRING (member),
+ XD_OBJECT_TO_STRING (handler));
+ break;
+ case DBUS_MESSAGE_TYPE_SIGNAL:
+ XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ XD_OBJECT_TO_STRING (path),
+ XD_OBJECT_TO_STRING (interface),
+ XD_OBJECT_TO_STRING (member));
+ break;
+ default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ ui_serial = serial;
+ XD_DEBUG_MESSAGE ("%s %s %s %u",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
+ XD_OBJECT_TO_STRING (bus),
+ XD_OBJECT_TO_STRING (service),
+ ui_serial);
}
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
+ /* Retrieve bus address. */
+ connection = xd_get_connection_address (bus);
- /* Append parameters to the message. */
- for (; i < nargs; ++i)
+ /* Create the D-Bus message. */
+ dmessage = dbus_message_new (mtype);
+ if (dmessage == NULL)
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
+ }
+
+ if (STRINGP (service))
{
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
+ if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
+ /* Set destination. */
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
+ if (!dbus_message_set_destination (dmessage, SSDATA (service)))
+ {
+ UNGCPRO;
+ XD_SIGNAL2 (build_string ("Unable to set the destination"),
+ service);
+ }
}
+
else
+ /* Set destination for unicast signals. */
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
+ Lisp_Object uname;
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
+ /* If it is the same unique name as we are registered at the
+ bus or an unknown name, we regard it as broadcast message
+ due to backward compatibility. */
+ if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
+ uname = call2 (intern ("dbus-get-name-owner"), bus, service);
+ else
+ uname = Qnil;
- xd_append_arg (dtype, args[i], &iter);
+ if (STRINGP (uname)
+ && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
+ != 0)
+ && (!dbus_message_set_destination (dmessage, SSDATA (service))))
+ {
+ UNGCPRO;
+ XD_SIGNAL2 (build_string ("Unable to set signal destination"),
+ service);
+ }
+ }
}
- /* Send the message. */
- dbus_error_init (&derror);
- reply = dbus_connection_send_with_reply_and_block (connection,
- dmessage,
- timeout,
- &derror);
-
- if (dbus_error_is_set (&derror))
- XD_ERROR (derror);
-
- if (reply == NULL)
- XD_SIGNAL1 (build_string ("No reply"));
-
- XD_DEBUG_MESSAGE ("Message sent");
-
- /* Collect the results. */
- result = Qnil;
- GCPRO1 (result);
-
- if (dbus_message_iter_init (reply, &iter))
+ /* Set message parameters. */
+ if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
{
- /* Loop over the parameters of the D-Bus reply message. Construct a
- Lisp list, which is returned by `dbus-call-method'. */
- while ((dtype = dbus_message_iter_get_arg_type (&iter))
- != DBUS_TYPE_INVALID)
+ if ((!dbus_message_set_path (dmessage, SSDATA (path)))
+ || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
+ || (!dbus_message_set_member (dmessage, SSDATA (member))))
{
- result = Fcons (xd_retrieve_arg (dtype, &iter), result);
- dbus_message_iter_next (&iter);
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
}
}
- else
- {
- /* No arguments: just return nil. */
- }
-
- /* Cleanup. */
- dbus_error_free (&derror);
- dbus_message_unref (dmessage);
- dbus_message_unref (reply);
-
- /* Return the result. If there is only one single Lisp object,
- return it as-it-is, otherwise return the reversed list. */
- if (XFASTINT (Flength (result)) == 1)
- RETURN_UNGCPRO (CAR_SAFE (result));
- else
- RETURN_UNGCPRO (Fnreverse (result));
-}
-
-DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
- Sdbus_call_method_asynchronously, 6, MANY, 0,
- doc: /* Call METHOD on the D-Bus BUS asynchronously.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name to be used. PATH is the D-Bus
-object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE. It must provide METHOD.
-
-HANDLER is a Lisp function, which is called when the corresponding
-return message has arrived. If HANDLER is nil, no return message will
-be expected.
-
-If the parameter `:timeout' is given, the following integer TIMEOUT
-specifies the maximum number of milliseconds the method call must
-return. The default value is 25,000. If the method call doesn't
-return in time, a D-Bus error is raised.
-
-All other arguments ARGS are passed to METHOD as arguments. They are
-converted into D-Bus types via the following rules:
-
- t and nil => DBUS_TYPE_BOOLEAN
- number => DBUS_TYPE_UINT32
- integer => DBUS_TYPE_INT32
- float => DBUS_TYPE_DOUBLE
- string => DBUS_TYPE_STRING
- list => DBUS_TYPE_ARRAY
-
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
-
-Unless HANDLER is nil, the function returns a key into the hash table
-`dbus-registered-objects-table'. The corresponding entry in the hash
-table is removed, when the return message has been arrived, and
-HANDLER is called.
-
-Example:
-
-\(dbus-call-method-asynchronously
- :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
- "org.freedesktop.Hal.Device" "GetPropertyString" 'message
- "system.kernel.machine")
-
- => (:system 2)
-
- -| i686
-
-usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service, path, interface, method, handler;
- Lisp_Object result;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- unsigned int dtype;
- dbus_uint32_t serial;
- int timeout = -1;
- ptrdiff_t i = 6;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+ else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
+ {
+ if (!dbus_message_set_reply_serial (dmessage, serial))
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to create a return message"));
+ }
- /* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- method = args[4];
- handler = args[5];
-
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (method);
- if (!NILP (handler) && !FUNCTIONP (handler))
- wrong_type_argument (Qinvalid_function, handler);
- GCPRO6 (bus, service, path, interface, method, handler);
-
- XD_DEBUG_MESSAGE ("%s %s %s %s",
- SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (method));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new_method_call (SSDATA (service),
- SSDATA (path),
- SSDATA (interface),
- SSDATA (method));
- if (dmessage == NULL)
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
+ if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
+ && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Unable to create a error message"));
+ }
+ }
/* Check for timeout parameter. */
- if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
+ if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
{
- CHECK_NATNUM (args[i+1]);
- timeout = XFASTINT (args[i+1]);
- i = i+2;
+ CHECK_NATNUM (args[count+1]);
+ timeout = min (XFASTINT (args[count+1]), INT_MAX);
+ count = count+2;
}
/* Initialize parameter list of message. */
dbus_message_iter_init_append (dmessage, &iter);
/* Append parameters to the message. */
- for (; i < nargs; ++i)
+ for (; count < nargs; ++count)
{
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
+ dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
+ if (XD_DBUS_TYPE_P (args[count]))
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
+ XD_OBJECT_TO_STRING (args[count]),
+ XD_OBJECT_TO_STRING (args[count+1]));
+ ++count;
}
else
{
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)));
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
+ XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
+ XD_OBJECT_TO_STRING (args[count]));
}
/* Check for valid signature. We use DBUS_TYPE_INVALID as
indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
+ xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
- xd_append_arg (dtype, args[i], &iter);
+ xd_append_arg (dtype, args[count], &iter);
}
if (!NILP (handler))
message queue. */
if (!dbus_connection_send_with_reply (connection, dmessage,
NULL, timeout))
- XD_SIGNAL1 (build_string ("Cannot send message"));
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Cannot send message"));
+ }
/* The result is the key in Vdbus_registered_objects_table. */
serial = dbus_message_get_serial (dmessage);
- result = list2 (bus, make_fixnum_or_float (serial));
+ result = list3 (QCdbus_registered_serial,
+ bus, make_fixnum_or_float (serial));
/* Create a hash table entry. */
Fputhash (result, handler, Vdbus_registered_objects_table);
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
+ {
+ UNGCPRO;
+ XD_SIGNAL1 (build_string ("Cannot send message"));
+ }
result = Qnil;
}
- XD_DEBUG_MESSAGE ("Message sent");
+ XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
/* Cleanup. */
dbus_message_unref (dmessage);
RETURN_UNGCPRO (result);
}
-DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
- Sdbus_method_return_internal,
- 3, MANY, 0,
- doc: /* Return for message SERIAL on the D-Bus BUS.
-This is an internal function, it shall not be used outside dbus.el.
-
-usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service;
- struct gcpro gcpro1, gcpro2;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- dbus_uint32_t serial;
- unsigned int ui_serial, dtype;
- ptrdiff_t i;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-
- /* Check parameters. */
- bus = args[0];
- service = args[2];
-
- CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
- CHECK_STRING (service);
- GCPRO2 (bus, service);
-
- ui_serial = serial;
- XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
- if ((dmessage == NULL)
- || (!dbus_message_set_reply_serial (dmessage, serial))
- || (!dbus_message_set_destination (dmessage, SSDATA (service))))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a return message"));
- }
-
- UNGCPRO;
-
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
-
- /* Append parameters to the message. */
- for (i = 3; i < nargs; ++i)
- {
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
- }
- else
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
-
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
-
- xd_append_arg (dtype, args[i], &iter);
- }
-
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
-
- XD_DEBUG_MESSAGE ("Message sent");
-
- /* Cleanup. */
- dbus_message_unref (dmessage);
-
- /* Return. */
- return Qt;
-}
-
-DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
- Sdbus_method_error_internal,
- 3, MANY, 0,
- doc: /* Return error message for message SERIAL on the D-Bus BUS.
-This is an internal function, it shall not be used outside dbus.el.
-
-usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service;
- struct gcpro gcpro1, gcpro2;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- dbus_uint32_t serial;
- unsigned int ui_serial, dtype;
- ptrdiff_t i;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-
- /* Check parameters. */
- bus = args[0];
- service = args[2];
-
- CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
- CHECK_STRING (service);
- GCPRO2 (bus, service);
-
- ui_serial = serial;
- XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
- if ((dmessage == NULL)
- || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
- || (!dbus_message_set_reply_serial (dmessage, serial))
- || (!dbus_message_set_destination (dmessage, SSDATA (service))))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a error message"));
- }
-
- UNGCPRO;
-
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
-
- /* Append parameters to the message. */
- for (i = 3; i < nargs; ++i)
- {
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
- }
- else
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
-
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
-
- xd_append_arg (dtype, args[i], &iter);
- }
-
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
-
- XD_DEBUG_MESSAGE ("Message sent");
-
- /* Cleanup. */
- dbus_message_unref (dmessage);
-
- /* Return. */
- return Qt;
-}
-
-DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
- doc: /* Send signal SIGNAL on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the
-D-Bus object path SERVICE is registered at. INTERFACE is an interface
-offered by SERVICE. It must provide signal SIGNAL.
-
-All other arguments ARGS are passed to SIGNAL as arguments. They are
-converted into D-Bus types via the following rules:
-
- t and nil => DBUS_TYPE_BOOLEAN
- number => DBUS_TYPE_UINT32
- integer => DBUS_TYPE_INT32
- float => DBUS_TYPE_DOUBLE
- string => DBUS_TYPE_STRING
- list => DBUS_TYPE_ARRAY
-
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
-
-Example:
-
-\(dbus-send-signal
- :session "org.gnu.Emacs" "/org/gnu/Emacs"
- "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
-
-usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service, path, interface, signal;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- DBusConnection *connection;
- DBusMessage *dmessage;
- DBusMessageIter iter;
- unsigned int dtype;
- ptrdiff_t i;
- char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-
- /* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- signal = args[4];
-
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (signal);
- GCPRO5 (bus, service, path, interface, signal);
-
- XD_DEBUG_MESSAGE ("%s %s %s %s",
- SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (signal));
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create the message. */
- dmessage = dbus_message_new_signal (SSDATA (path),
- SSDATA (interface),
- SSDATA (signal));
- UNGCPRO;
- if (dmessage == NULL)
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
-
- /* Initialize parameter list of message. */
- dbus_message_iter_init_append (dmessage, &iter);
-
- /* Append parameters to the message. */
- for (i = 5; i < nargs; ++i)
- {
- dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
- if (XD_DBUS_TYPE_P (args[i]))
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)),
- SDATA (format2 ("%s", args[i+1], Qnil)));
- ++i;
- }
- else
- {
- XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
- XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
- SDATA (format2 ("%s", args[i], Qnil)));
- }
-
- /* Check for valid signature. We use DBUS_TYPE_INVALID as
- indication that there is no parent type. */
- xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
-
- xd_append_arg (dtype, args[i], &iter);
- }
-
- /* Send the message. The message is just added to the outgoing
- message queue. */
- if (!dbus_connection_send (connection, dmessage, NULL))
- XD_SIGNAL1 (build_string ("Cannot send message"));
-
- XD_DEBUG_MESSAGE ("Signal sent");
-
- /* Cleanup. */
- dbus_message_unref (dmessage);
-
- /* Return. */
- return Qt;
-}
-
/* Read one queued incoming message of the D-Bus BUS.
BUS is either a Lisp symbol, :system or :session, or a string denoting
the bus address. */
struct input_event event;
DBusMessage *dmessage;
DBusMessageIter iter;
- unsigned int dtype;
+ int dtype;
int mtype;
dbus_uint32_t serial;
unsigned int ui_serial;
member = dbus_message_get_member (dmessage);
XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
- (mtype == DBUS_MESSAGE_TYPE_INVALID)
- ? "DBUS_MESSAGE_TYPE_INVALID"
- : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
- ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
- : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
- ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
- : (mtype == DBUS_MESSAGE_TYPE_ERROR)
- ? "DBUS_MESSAGE_TYPE_ERROR"
- : "DBUS_MESSAGE_TYPE_SIGNAL",
+ XD_MESSAGE_TYPE_TO_STRING (mtype),
ui_serial, uname, path, interface, member,
- SDATA (format2 ("%s", args, Qnil)));
+ XD_OBJECT_TO_STRING (args));
- if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
- || (mtype == DBUS_MESSAGE_TYPE_ERROR))
+ if (mtype == DBUS_MESSAGE_TYPE_INVALID)
+ goto cleanup;
+
+ else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
+ || (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
/* Search for a registered function of the message. */
- key = list2 (bus, make_fixnum_or_float (serial));
+ key = list3 (QCdbus_registered_serial, bus,
+ make_fixnum_or_float (serial));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* There shall be exactly one entry. Construct an event. */
event.arg = Fcons (value, args);
}
- else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN) */
+ else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
{
/* Vdbus_registered_objects_table requires non-nil interface and
member. */
goto cleanup;
/* Search for a registered function of the message. */
- key = list3 (bus, build_string (interface), build_string (member));
+ key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
+ ? QCdbus_registered_method
+ : QCdbus_registered_signal,
+ bus, build_string (interface), build_string (member));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* Loop over the registered functions. Construct an event. */
/* Store it into the input event queue. */
kbd_buffer_store_event (&event);
- XD_DEBUG_MESSAGE ("Event stored: %s",
- SDATA (format2 ("%s", event.arg, Qnil)));
+ XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
/* Cleanup. */
cleanup:
static Lisp_Object
xd_read_message (Lisp_Object bus)
{
- /* Open a connection to the bus. */
- DBusConnection *connection = xd_initialize (bus, TRUE);
+ /* Retrieve bus address. */
+ DBusConnection *connection = xd_get_connection_address (bus);
/* Non blocking read of the next available message. */
dbus_connection_read_write (connection, 0);
/* Callback called when something is ready to read or write. */
static void
-xd_read_queued_messages (int fd, void *data, int for_read)
+xd_read_queued_messages (int fd, void *data)
{
- Lisp_Object busp = Vdbus_registered_buses;
+ Lisp_Object busp = xd_registered_buses;
Lisp_Object bus = Qnil;
+ Lisp_Object key;
/* Find bus related to fd. */
if (data != NULL)
while (!NILP (busp))
{
- if ((SYMBOLP (CAR_SAFE (busp)) && XSYMBOL (CAR_SAFE (busp)) == data)
- || (STRINGP (CAR_SAFE (busp)) && XSTRING (CAR_SAFE (busp)) == data))
- bus = CAR_SAFE (busp);
+ key = CAR_SAFE (CAR_SAFE (busp));
+ if ((SYMBOLP (key) && XSYMBOL (key) == data)
+ || (STRINGP (key) && XSTRING (key) == data))
+ bus = key;
busp = CDR_SAFE (busp);
}
xd_in_read_queued_messages = 0;
}
-DEFUN ("dbus-register-service", Fdbus_register_service, Sdbus_register_service,
- 2, MANY, 0,
- doc: /* Register known name SERVICE on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name that should be registered. It must
-be a known name.
-
-FLAGS are keywords, which control how the service name is registered.
-The following keywords are recognized:
-
-`:allow-replacement': Allow another service to become the primary
-owner if requested.
-
-`:replace-existing': Request to replace the current primary owner.
-
-`:do-not-queue': If we can not become the primary owner do not place
-us in the queue.
-
-The function returns a keyword, indicating the result of the
-operation. One of the following keywords is returned:
-
-`:primary-owner': Service has become the primary owner of the
-requested name.
-
-`:in-queue': Service could not become the primary owner and has been
-placed in the queue.
-
-`:exists': Service is already in the queue.
-
-`:already-owner': Service is already the primary owner.
-
-Example:
-
-\(dbus-register-service :session dbus-service-emacs)
-
- => :primary-owner.
-
-\(dbus-register-service
- :session "org.freedesktop.TextEditor"
- dbus-service-allow-replacement dbus-service-replace-existing)
-
- => :already-owner.
-
-usage: (dbus-register-service BUS SERVICE &rest FLAGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service;
- DBusConnection *connection;
- ptrdiff_t i;
- unsigned int value;
- unsigned int flags = 0;
- int result;
- DBusError derror;
-
- bus = args[0];
- service = args[1];
-
- /* Check parameters. */
- CHECK_STRING (service);
-
- /* Process flags. */
- for (i = 2; i < nargs; ++i) {
- value = ((EQ (args[i], QCdbus_request_name_replace_existing))
- ? DBUS_NAME_FLAG_REPLACE_EXISTING
- : (EQ (args[i], QCdbus_request_name_allow_replacement))
- ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
- : (EQ (args[i], QCdbus_request_name_do_not_queue))
- ? DBUS_NAME_FLAG_DO_NOT_QUEUE
- : -1);
- if (value == -1)
- XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]);
- flags |= value;
- }
-
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Request the known name from the bus. */
- dbus_error_init (&derror);
- result = dbus_bus_request_name (connection, SSDATA (service), flags,
- &derror);
- if (dbus_error_is_set (&derror))
- XD_ERROR (derror);
-
- /* Cleanup. */
- dbus_error_free (&derror);
-
- /* Return object. */
- switch (result)
- {
- case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER:
- return QCdbus_request_name_reply_primary_owner;
- case DBUS_REQUEST_NAME_REPLY_IN_QUEUE:
- return QCdbus_request_name_reply_in_queue;
- case DBUS_REQUEST_NAME_REPLY_EXISTS:
- return QCdbus_request_name_reply_exists;
- case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER:
- return QCdbus_request_name_reply_already_owner;
- default:
- /* This should not happen. */
- XD_SIGNAL2 (build_string ("Could not register service"), service);
- }
-}
-
-DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
- 6, MANY, 0,
- doc: /* Register for signal SIGNAL on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name used by the sending D-Bus object.
-It can be either a known name or the unique name of the D-Bus object
-sending the signal. When SERVICE is nil, related signals from all
-D-Bus objects shall be accepted.
-
-PATH is the D-Bus object path SERVICE is registered. It can also be
-nil if the path name of incoming signals shall not be checked.
-
-INTERFACE is an interface offered by SERVICE. It must provide SIGNAL.
-HANDLER is a Lisp function to be called when the signal is received.
-It must accept as arguments the values SIGNAL is sending.
-
-All other arguments ARGS, if specified, must be strings. They stand
-for the respective arguments of the signal in their order, and are
-used for filtering as well. A nil argument might be used to preserve
-the order.
-
-INTERFACE, SIGNAL and HANDLER must not be nil. Example:
-
-\(defun my-signal-handler (device)
- (message "Device %s added" device))
-
-\(dbus-register-signal
- :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
- "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
-
- => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
- ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
-
-`dbus-register-signal' returns an object, which can be used in
-`dbus-unregister-object' for removing the registration.
-
-usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
- (ptrdiff_t nargs, Lisp_Object *args)
-{
- Lisp_Object bus, service, path, interface, signal, handler;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
- Lisp_Object uname, key, key1, value;
- DBusConnection *connection;
- ptrdiff_t i;
- char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
- int rulelen;
- DBusError derror;
-
- /* Check parameters. */
- bus = args[0];
- service = args[1];
- path = args[2];
- interface = args[3];
- signal = args[4];
- handler = args[5];
-
- if (!NILP (service)) CHECK_STRING (service);
- if (!NILP (path)) CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (signal);
- if (!FUNCTIONP (handler))
- wrong_type_argument (Qinvalid_function, handler);
- GCPRO6 (bus, service, path, interface, signal, handler);
-
- /* Retrieve unique name of service. If service is a known name, we
- will register for the corresponding unique name, if any. Signals
- are sent always with the unique name as sender. Note: the unique
- name of "org.freedesktop.DBus" is that string itself. */
- if ((STRINGP (service))
- && (SBYTES (service) > 0)
- && (strcmp (SSDATA (service), DBUS_SERVICE_DBUS) != 0)
- && (strncmp (SSDATA (service), ":", 1) != 0))
- uname = call2 (intern ("dbus-get-name-owner"), bus, service);
- else
- uname = service;
-
- /* Create a matching rule if the unique name exists (when no
- wildcard). */
- if (NILP (uname) || (SBYTES (uname) > 0))
- {
- /* Open a connection to the bus. */
- connection = xd_initialize (bus, TRUE);
-
- /* Create a rule to receive related signals. */
- rulelen = snprintf (rule, sizeof rule,
- "type='signal',interface='%s',member='%s'",
- SDATA (interface),
- SDATA (signal));
- if (! (0 <= rulelen && rulelen < sizeof rule))
- string_overflow ();
-
- /* Add unique name and path to the rule if they are non-nil. */
- if (!NILP (uname))
- {
- int len = snprintf (rule + rulelen, sizeof rule - rulelen,
- ",sender='%s'", SDATA (uname));
- if (! (0 <= len && len < sizeof rule - rulelen))
- string_overflow ();
- rulelen += len;
- }
-
- if (!NILP (path))
- {
- int len = snprintf (rule + rulelen, sizeof rule - rulelen,
- ",path='%s'", SDATA (path));
- if (! (0 <= len && len < sizeof rule - rulelen))
- string_overflow ();
- rulelen += len;
- }
-
- /* Add arguments to the rule if they are non-nil. */
- for (i = 6; i < nargs; ++i)
- if (!NILP (args[i]))
- {
- int len;
- CHECK_STRING (args[i]);
- len = snprintf (rule + rulelen, sizeof rule - rulelen,
- ",arg%"pD"d='%s'", i - 6, SDATA (args[i]));
- if (! (0 <= len && len < sizeof rule - rulelen))
- string_overflow ();
- rulelen += len;
- }
-
- /* Add the rule to the bus. */
- dbus_error_init (&derror);
- dbus_bus_add_match (connection, rule, &derror);
- if (dbus_error_is_set (&derror))
- {
- UNGCPRO;
- XD_ERROR (derror);
- }
-
- /* Cleanup. */
- dbus_error_free (&derror);
-
- XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
- }
-
- /* Create a hash table entry. */
- key = list3 (bus, interface, signal);
- key1 = list5 (uname, service, path, handler, build_string (rule));
- value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
-
- if (NILP (Fmember (key1, value)))
- Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
-
- /* Return object. */
- RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
-}
-
-DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
- 6, 7, 0,
- doc: /* Register for method METHOD on the D-Bus BUS.
-
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
-
-SERVICE is the D-Bus service name of the D-Bus object METHOD is
-registered for. It must be a known name (See discussion of
-DONT-REGISTER-SERVICE below).
-
-PATH is the D-Bus object path SERVICE is registered (See discussion of
-DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
-SERVICE. It must provide METHOD.
-
-HANDLER is a Lisp function to be called when a method call is
-received. It must accept the input arguments of METHOD. The return
-value of HANDLER is used for composing the returning D-Bus message.
-In case HANDLER shall return a reply message with an empty argument
-list, HANDLER must return the symbol `:ignore'.
-
-When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
-registered. This means that other D-Bus clients have no way of
-noticing the newly registered method. When interfaces are constructed
-incrementally by adding single methods or properties at a time,
-DONT-REGISTER-SERVICE can be used to prevent other clients from
-discovering the still incomplete interface.*/)
- (Lisp_Object bus, Lisp_Object service, Lisp_Object path,
- Lisp_Object interface, Lisp_Object method, Lisp_Object handler,
- Lisp_Object dont_register_service)
-{
- Lisp_Object key, key1, value;
- Lisp_Object args[2] = { bus, service };
-
- /* Check parameters. */
- CHECK_STRING (service);
- CHECK_STRING (path);
- CHECK_STRING (interface);
- CHECK_STRING (method);
- if (!FUNCTIONP (handler))
- wrong_type_argument (Qinvalid_function, handler);
- /* TODO: We must check for a valid service name, otherwise there is
- a segmentation fault. */
-
- /* Request the name. */
- if (NILP (dont_register_service))
- Fdbus_register_service (2, args);
-
- /* Create a hash table entry. We use nil for the unique name,
- because the method might be called from anybody. */
- key = list3 (bus, interface, method);
- key1 = list4 (Qnil, service, path, handler);
- value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
-
- if (NILP (Fmember (key1, value)))
- Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
-
- /* Return object. */
- return list2 (key, list3 (service, path, handler));
-}
-
\f
void
syms_of_dbusbind (void)
DEFSYM (Qdbus_init_bus, "dbus-init-bus");
defsubr (&Sdbus_init_bus);
- DEFSYM (Qdbus_close_bus, "dbus-close-bus");
- defsubr (&Sdbus_close_bus);
-
DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
defsubr (&Sdbus_get_unique_name);
- DEFSYM (Qdbus_call_method, "dbus-call-method");
- defsubr (&Sdbus_call_method);
-
- DEFSYM (Qdbus_call_method_asynchronously, "dbus-call-method-asynchronously");
- defsubr (&Sdbus_call_method_asynchronously);
-
- DEFSYM (Qdbus_method_return_internal, "dbus-method-return-internal");
- defsubr (&Sdbus_method_return_internal);
-
- DEFSYM (Qdbus_method_error_internal, "dbus-method-error-internal");
- defsubr (&Sdbus_method_error_internal);
-
- DEFSYM (Qdbus_send_signal, "dbus-send-signal");
- defsubr (&Sdbus_send_signal);
-
- DEFSYM (Qdbus_register_service, "dbus-register-service");
- defsubr (&Sdbus_register_service);
-
- DEFSYM (Qdbus_register_signal, "dbus-register-signal");
- defsubr (&Sdbus_register_signal);
-
- DEFSYM (Qdbus_register_method, "dbus-register-method");
- defsubr (&Sdbus_register_method);
+ DEFSYM (Qdbus_message_internal, "dbus-message-internal");
+ defsubr (&Sdbus_message_internal);
DEFSYM (Qdbus_error, "dbus-error");
Fput (Qdbus_error, Qerror_conditions,
list2 (Qdbus_error, Qerror));
Fput (Qdbus_error, Qerror_message,
- make_pure_c_string ("D-Bus error"));
+ build_pure_c_string ("D-Bus error"));
DEFSYM (QCdbus_system_bus, ":system");
DEFSYM (QCdbus_session_bus, ":session");
- DEFSYM (QCdbus_request_name_allow_replacement, ":allow-replacement");
- DEFSYM (QCdbus_request_name_replace_existing, ":replace-existing");
- DEFSYM (QCdbus_request_name_do_not_queue, ":do-not-queue");
- DEFSYM (QCdbus_request_name_reply_primary_owner, ":primary-owner");
- DEFSYM (QCdbus_request_name_reply_exists, ":exists");
- DEFSYM (QCdbus_request_name_reply_in_queue, ":in-queue");
- DEFSYM (QCdbus_request_name_reply_already_owner, ":already-owner");
DEFSYM (QCdbus_timeout, ":timeout");
DEFSYM (QCdbus_type_byte, ":byte");
DEFSYM (QCdbus_type_boolean, ":boolean");
DEFSYM (QCdbus_type_string, ":string");
DEFSYM (QCdbus_type_object_path, ":object-path");
DEFSYM (QCdbus_type_signature, ":signature");
-
#ifdef DBUS_TYPE_UNIX_FD
DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
#endif
-
DEFSYM (QCdbus_type_array, ":array");
DEFSYM (QCdbus_type_variant, ":variant");
DEFSYM (QCdbus_type_struct, ":struct");
DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
+ DEFSYM (QCdbus_registered_serial, ":serial");
+ DEFSYM (QCdbus_registered_method, ":method");
+ DEFSYM (QCdbus_registered_signal, ":signal");
+
+ DEFVAR_LISP ("dbus-compiled-version",
+ Vdbus_compiled_version,
+ doc: /* The version of D-Bus Emacs is compiled against. */);
+#ifdef DBUS_VERSION_STRING
+ Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING);
+#else
+ Vdbus_compiled_version = Qnil;
+#endif
+
+ DEFVAR_LISP ("dbus-runtime-version",
+ Vdbus_runtime_version,
+ doc: /* The version of D-Bus Emacs runs with. */);
+ {
+#ifdef DBUS_VERSION
+ int major, minor, micro;
+ char s[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
+ dbus_get_version (&major, &minor, µ);
+ Vdbus_runtime_version
+ = make_formatted_string (s, "%d.%d.%d", major, minor, micro);
+#else
+ Vdbus_runtime_version = Qnil;
+#endif
+ }
+
+ DEFVAR_LISP ("dbus-message-type-invalid",
+ Vdbus_message_type_invalid,
+ doc: /* This value is never a valid message type. */);
+ Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
- DEFVAR_LISP ("dbus-registered-buses",
- Vdbus_registered_buses,
- doc: /* List of D-Bus buses we are polling for messages. */);
- Vdbus_registered_buses = Qnil;
+ DEFVAR_LISP ("dbus-message-type-method-call",
+ Vdbus_message_type_method_call,
+ doc: /* Message type of a method call message. */);
+ Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
+
+ DEFVAR_LISP ("dbus-message-type-method-return",
+ Vdbus_message_type_method_return,
+ doc: /* Message type of a method return message. */);
+ Vdbus_message_type_method_return
+ = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
+
+ DEFVAR_LISP ("dbus-message-type-error",
+ Vdbus_message_type_error,
+ doc: /* Message type of an error reply message. */);
+ Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
+
+ DEFVAR_LISP ("dbus-message-type-signal",
+ Vdbus_message_type_signal,
+ doc: /* Message type of a signal message. */);
+ Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
DEFVAR_LISP ("dbus-registered-objects-table",
Vdbus_registered_objects_table,
registered interfaces properties, targeted by signals or method calls,
and for calling handlers in case of non-blocking method call returns.
-In the first case, the key in the hash table is the list (BUS
-INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or
+In the first case, the key in the hash table is the list (TYPE BUS
+INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
+`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
`:session', or a string denoting the bus address. INTERFACE is a
string which denotes a D-Bus interface, and MEMBER, also a string, is
either a method, a signal or a property INTERFACE is offering. All
arguments but BUS must not be nil.
-The value in the hash table is a list of quadruple lists
-\((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
-SERVICE is the service name as registered, UNAME is the corresponding
-unique name. In case of registered methods and properties, UNAME is
-nil. PATH is the object path of the sending object. All of them can
-be nil, which means a wildcard then. OBJECT is either the handler to
-be called when a D-Bus message, which matches the key criteria,
-arrives (methods and signals), or a cons cell containing the value of
-the property.
+The value in the hash table is a list of quadruple lists \((UNAME
+SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
+registered, UNAME is the corresponding unique name. In case of
+registered methods and properties, UNAME is nil. PATH is the object
+path of the sending object. All of them can be nil, which means a
+wildcard then. OBJECT is either the handler to be called when a D-Bus
+message, which matches the key criteria, arrives (TYPE `:method' and
+`:signal'), or a cons cell containing the value of the property (TYPE
+`:property').
-For signals, there is also a fifth element RULE, which keeps the match
-string the signal is registered with.
+For entries of type `:signal', there is also a fifth element RULE,
+which keeps the match string the signal is registered with.
-In the second case, the key in the hash table is the list (BUS
+In the second case, the key in the hash table is the list (:serial BUS
SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
string denoting the bus address. SERIAL is the serial number of the
non-blocking method call, a reply is expected. Both arguments must
Vdbus_debug = Qnil;
#endif
+ /* Initialize internal objects. */
+ xd_registered_buses = Qnil;
+ staticpro (&xd_registered_buses);
+
Fprovide (intern_c_string ("dbusbind"), Qnil);
}
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
-#include <setjmp.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
#endif /* HAVE_DIRENT_H */
#include <filemode.h>
+#include <stat-time.h>
#ifdef MSDOS
#define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
#include "lisp.h"
#include "systime.h"
+#include "character.h"
#include "buffer.h"
#include "commands.h"
-#include "character.h"
#include "charset.h"
#include "coding.h"
#include "regex.h"
static Lisp_Object Qfile_attributes;
static Lisp_Object Qfile_attributes_lessp;
-static int scmp (const char *, const char *, int);
-static Lisp_Object Ffile_attributes (Lisp_Object, Lisp_Object);
+static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
\f
#ifdef WINDOWSNT
Lisp_Object
directory_files_internal_unwind (Lisp_Object dh)
{
DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
- BLOCK_INPUT;
+ block_input ();
closedir (d);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
/* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
- When ATTRS is zero, return a list of directory filenames; when
- non-zero, return a list of directory filenames and their attributes.
+ If not ATTRS, return a list of directory filenames;
+ if ATTRS, return a list of directory filenames and their attributes.
In the latter case, ID_FORMAT is passed to Ffile_attributes. */
Lisp_Object
-directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, int attrs, Lisp_Object id_format)
+directory_files_internal (Lisp_Object directory, Lisp_Object full,
+ Lisp_Object match, Lisp_Object nosort, bool attrs,
+ Lisp_Object id_format)
{
DIR *d;
- int directory_nbytes;
+ ptrdiff_t directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
struct re_pattern_buffer *bufp = NULL;
- int needsep = 0;
- int count = SPECPDL_INDEX ();
+ bool needsep = 0;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
DIRENTRY *dp;
#ifdef WINDOWSNT
/* Now *bufp is the compiled form of MATCH; don't call anything
which might compile a new regexp until we're done with the loop! */
- BLOCK_INPUT;
+ block_input ();
d = opendir (SSDATA (dirfilename));
- UNBLOCK_INPUT;
+ unblock_input ();
if (d == NULL)
report_file_error ("Opening directory", Fcons (directory, Qnil));
if (DIRENTRY_NONEMPTY (dp))
{
- int len;
- int wanted = 0;
+ ptrdiff_t len;
+ bool wanted = 0;
Lisp_Object name, finalname;
struct gcpro gcpro1, gcpro2;
if (!NILP (full))
{
Lisp_Object fullname;
- int nbytes = len + directory_nbytes + needsep;
- int nchars;
+ ptrdiff_t nbytes = len + directory_nbytes + needsep;
+ ptrdiff_t nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
memcpy (SDATA (fullname), SDATA (directory),
/* Some bug somewhere. */
if (nchars > nbytes)
- abort ();
+ emacs_abort ();
STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
}
}
- BLOCK_INPUT;
+ block_input ();
closedir (d);
- UNBLOCK_INPUT;
+ unblock_input ();
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
}
\f
-static Lisp_Object file_name_completion
- (Lisp_Object file, Lisp_Object dirname, int all_flag, int ver_flag,
- Lisp_Object predicate);
+static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
+ Lisp_Object);
DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
2, 3, 0,
if (!NILP (handler))
return call4 (handler, Qfile_name_completion, file, directory, predicate);
- return file_name_completion (file, directory, 0, 0, predicate);
+ return file_name_completion (file, directory, 0, predicate);
}
DEFUN ("file-name-all-completions", Ffile_name_all_completions,
if (!NILP (handler))
return call3 (handler, Qfile_name_all_completions, file, directory);
- return file_name_completion (file, directory, 1, 0, Qnil);
+ return file_name_completion (file, directory, 1, Qnil);
}
static int file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr);
static Lisp_Object Qdefault_directory;
static Lisp_Object
-file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int ver_flag, Lisp_Object predicate)
+file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
+ Lisp_Object predicate)
{
DIR *d;
- int bestmatchsize = 0;
+ ptrdiff_t bestmatchsize = 0;
int matchcount = 0;
/* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
If ALL_FLAG is 0, BESTMATCH is either nil
Lisp_Object encoded_file;
Lisp_Object encoded_dir;
struct stat st;
- int directoryp;
- /* If includeall is zero, exclude files in completion-ignored-extensions as
+ bool directoryp;
+ /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
well as "." and "..". Until shown otherwise, assume we can't exclude
anything. */
- int includeall = 1;
- int count = SPECPDL_INDEX ();
+ bool includeall = 1;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
elt = Qnil;
encoded_dir = ENCODE_FILE (dirname);
- BLOCK_INPUT;
+ block_input ();
d = opendir (SSDATA (Fdirectory_file_name (encoded_dir)));
- UNBLOCK_INPUT;
+ unblock_input ();
if (!d)
report_file_error ("Opening directory", Fcons (dirname, Qnil));
while (1)
{
DIRENTRY *dp;
- int len;
- int canexclude = 0;
+ ptrdiff_t len;
+ bool canexclude = 0;
errno = 0;
dp = readdir (d);
if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
continue;
- directoryp = S_ISDIR (st.st_mode);
+ directoryp = S_ISDIR (st.st_mode) != 0;
tem = Qnil;
/* If all_flag is set, always include all.
It would not actually be helpful to the user to ignore any possible
completions when making a list of them. */
if (!all_flag)
{
- int skip;
+ ptrdiff_t skip;
#if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
/* If this entry matches the current bestmatch, the only
for (tem = Vcompletion_ignored_extensions;
CONSP (tem); tem = XCDR (tem))
{
- int elt_len;
+ ptrdiff_t elt_len;
char *p1;
elt = XCAR (tem);
/* Suitably record this match. */
- matchcount++;
+ matchcount += matchcount <= 1;
if (all_flag)
bestmatch = Fcons (name, bestmatch);
{
Lisp_Object zero = make_number (0);
/* FIXME: This is a copy of the code in Ftry_completion. */
- int compare = min (bestmatchsize, SCHARS (name));
+ ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
Lisp_Object cmp
= Fcompare_strings (bestmatch, zero,
make_number (compare),
name, zero,
make_number (compare),
completion_ignore_case ? Qt : Qnil);
- int matchsize
+ ptrdiff_t matchsize
= (EQ (cmp, Qt) ? compare
: XINT (cmp) < 0 ? - XINT (cmp) - 1
: XINT (cmp) - 1);
/* This tests that the current file is an exact match
but BESTMATCH is not (it is too long). */
if ((matchsize == SCHARS (name)
- && matchsize + !!directoryp < SCHARS (bestmatch))
+ && matchsize + directoryp < SCHARS (bestmatch))
||
/* If there is no exact match ignoring case,
prefer a match that does not change the case
either both or neither are exact. */
(((matchsize == SCHARS (name))
==
- (matchsize + !!directoryp == SCHARS (bestmatch)))
+ (matchsize + directoryp == SCHARS (bestmatch)))
&& (cmp = Fcompare_strings (name, zero,
make_number (SCHARS (file)),
file, zero,
Return -1 if strings match,
else number of chars that match at the beginning. */
-static int
-scmp (const char *s1, const char *s2, int len)
+static ptrdiff_t
+scmp (const char *s1, const char *s2, ptrdiff_t len)
{
- register int l = len;
+ register ptrdiff_t l = len;
if (completion_ignore_case)
{
static int
file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr)
{
- int len = NAMLEN (dp);
- int pos = SCHARS (dirname);
+ ptrdiff_t len = NAMLEN (dp);
+ ptrdiff_t pos = SCHARS (dirname);
int value;
- char *fullname = (char *) alloca (len + pos + 2);
+ USE_SAFE_ALLOCA;
+ char *fullname = SAFE_ALLOCA (len + pos + 2);
#ifdef MSDOS
/* Some fields of struct stat are *very* expensive to compute on MS-DOS,
#ifdef MSDOS
_djstat_flags = save_djstat_flags;
#endif /* MSDOS */
+ SAFE_FREE ();
return value;
}
\f
2. File uid as a string or a number. If a string value cannot be
looked up, a numeric value, either an integer or a float, is returned.
3. File gid, likewise.
- 4. Last access time, as a list of two integers.
- First integer has high-order 16 bits of time, second has low 16 bits.
+ 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
+ same style as (current-time).
(See a note below about access time on FAT-based filesystems.)
5. Last modification time, likewise. This is the time of the last
change to the file's contents.
if (!(NILP (id_format) || EQ (id_format, Qinteger)))
{
- BLOCK_INPUT;
+ block_input ();
uname = stat_uname (&s);
gname = stat_gname (&s);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (uname)
values[2] = DECODE_SYSTEM (build_string (uname));
else
values[3] = make_fixnum_or_float (s.st_gid);
- values[4] = make_time (s.st_atime);
- values[5] = make_time (s.st_mtime);
- values[6] = make_time (s.st_ctime);
+ values[4] = make_lisp_time (get_stat_atime (&s));
+ values[5] = make_lisp_time (get_stat_mtime (&s));
+ values[6] = make_lisp_time (get_stat_ctime (&s));
/* If the file size is a 4-byte type, assume that files of sizes in
the 2-4 GiB range wrap around to negative values, as this is a
return Fstring_lessp (Fcar (f1), Fcar (f2));
}
\f
+
+DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
+ doc: /* Return a list of user names currently registered in the system.
+If we don't know how to determine that on this platform, just
+return a list with one element, taken from `user-real-login-name'. */)
+ (void)
+{
+ Lisp_Object users = Qnil;
+#if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
+ struct passwd *pw;
+
+ while ((pw = getpwent ()))
+ users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
+
+ endpwent ();
+#endif
+ if (EQ (users, Qnil))
+ /* At least current user is always known. */
+ users = Fcons (Vuser_real_login_name, Qnil);
+ return users;
+}
+
+DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
+ doc: /* Return a list of user group names currently registered in the system.
+The value may be nil if not supported on this platform. */)
+ (void)
+{
+ Lisp_Object groups = Qnil;
+#if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
+ struct group *gr;
+
+ while ((gr = getgrent ()))
+ groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
+
+ endgrent ();
+#endif
+ return groups;
+}
+
void
syms_of_dired (void)
{
defsubr (&Sfile_name_all_completions);
defsubr (&Sfile_attributes);
defsubr (&Sfile_attributes_lessp);
+ defsubr (&Ssystem_users);
+ defsubr (&Ssystem_groups);
DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
doc: /* Completion ignores file names ending in any string in this list.
#include "msdos.h"
#endif
+INLINE_HEADER_BEGIN
+#ifndef DISPEXTERN_INLINE
+# define DISPEXTERN_INLINE INLINE
+#endif
+
+#include <c-strcase.h>
+DISPEXTERN_INLINE int
+xstrcasecmp (char const *a, char const *b)
+{
+ return c_strcasecmp (a, b);
+}
+
#ifdef HAVE_X_WINDOWS
typedef struct x_display_info Display_Info;
typedef XImage * XImagePtr;
typedef XImagePtr XImagePtr_or_DC;
#endif
+#ifdef HAVE_WINDOW_SYSTEM
+# include "systime.h"
+#endif
+
#ifndef HAVE_WINDOW_SYSTEM
typedef int Cursor;
#define No_Cursor (0)
Debugging
***********************************************************************/
-/* If GLYPH_DEBUG is non-zero, additional checks are activated. Turn
- it off by defining the macro GLYPH_DEBUG to zero. */
-
-#ifndef GLYPH_DEBUG
-#define GLYPH_DEBUG 0
-#endif
-
-/* If XASSERTS is non-zero, additional consistency checks are activated.
- Turn it off by defining the macro XASSERTS to zero. */
-
-#ifndef XASSERTS
-#define XASSERTS 0
-#endif
+/* If GLYPH_DEBUG is defined, additional checks are activated. */
-/* Macros to include code only if GLYPH_DEBUG != 0. */
+/* Macros to include code only if GLYPH_DEBUG is defined. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
#define IF_DEBUG(X) X
#else
#define IF_DEBUG(X) (void) 0
#endif
-#if XASSERTS
-#define xassert(X) do {if (!(X)) abort ();} while (0)
-#else
-#define xassert(X) (void) 0
-#endif
-
/* Macro for displaying traces of redisplay. If Emacs was compiled
- with GLYPH_DEBUG != 0, the variable trace_redisplay_p can be set to
+ with GLYPH_DEBUG defined, the variable trace_redisplay_p can be set to
a non-zero value in debugging sessions to activate traces. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
extern int trace_redisplay_p EXTERNALLY_VISIBLE;
#include <stdio.h>
else \
(void) 0
-#else /* GLYPH_DEBUG == 0 */
+#else /* not GLYPH_DEBUG */
#define TRACE(X) (void) 0
-#endif /* GLYPH_DEBUG == 0 */
+#endif /* GLYPH_DEBUG */
\f
struct text_pos
{
/* Character position. */
- EMACS_INT charpos;
+ ptrdiff_t charpos;
/* Corresponding byte position. */
- EMACS_INT bytepos;
+ ptrdiff_t bytepos;
};
/* Access character and byte position of POS in a functional form. */
is the index of that overlay string in the sequence of overlay
strings at `pos' in the order redisplay processes them. A value
< 0 means that this is not a position in an overlay string. */
- int overlay_string_index;
+ ptrdiff_t overlay_string_index;
/* If this is a position in an overlay string, string_pos is the
position within that string. */
buffer, this is a position in that buffer. A value of -1
together with a null object means glyph is a truncation glyph at
the start of a row. */
- EMACS_INT charpos;
+ ptrdiff_t charpos;
/* Lisp object source of this glyph. Currently either a buffer or
a string, if the glyph was produced from characters which came from
line. */
unsigned header_line_p : 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* A string identifying the method used to display the matrix. */
char method[512];
#endif
/* Values of BEGV and ZV as of last redisplay. Set in
mark_window_display_accurate_1. */
- int begv, zv;
+ ptrdiff_t begv, zv;
};
/* Check that glyph pointers stored in glyph rows of MATRIX are okay.
This aborts if any pointer is found twice. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
void check_matrix_pointer_lossage (struct glyph_matrix *);
#define CHECK_MATRIX(MATRIX) check_matrix_pointer_lossage ((MATRIX))
#else
/* Get a pointer to row number ROW in matrix MATRIX. If GLYPH_DEBUG
- is defined to a non-zero value, the function matrix_row checks that
- we don't try to access rows that are out of bounds. */
+ is defined, the function matrix_row checks that we don't try to
+ access rows that are out of bounds. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
struct glyph_row *matrix_row (struct glyph_matrix *, int);
#define MATRIX_ROW(MATRIX, ROW) matrix_row ((MATRIX), (ROW))
#else
((ROW)->phys_height - (ROW)->phys_ascent \
> (ROW)->height - (ROW)->ascent)
-/* Non-zero means that fonts have been loaded since the last glyph
+/* True means that fonts have been loaded since the last glyph
matrix adjustments. The function redisplay_internal adjusts glyph
- matrices when this flag is non-zero. */
+ matrices when this flag is true. */
-extern int fonts_changed_p;
+extern bool fonts_changed_p;
/* A glyph for a space. */
/* Non-zero means last display completed. Zero means it was
preempted. */
-extern int display_completed;
+extern bool display_completed;
\f
? current_mode_line_height \
: (MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \
? MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \
- : estimate_mode_line_height (XFRAME ((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
? current_header_line_height \
: (MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \
? MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \
- : estimate_mode_line_height (XFRAME ((W)->frame), \
+ : estimate_mode_line_height (XFRAME (W->frame),\
HEADER_LINE_FACE_ID)))
/* Return the height of the desired mode line of window W. */
(!MINI_WINDOW_P ((W)) \
&& !(W)->pseudo_window_p \
&& FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \
- && BUFFERP ((W)->buffer) \
- && !NILP (BVAR (XBUFFER ((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. */
+/* Value is true if window W wants a header line. */
#define WINDOW_WANTS_HEADER_LINE_P(W) \
(!MINI_WINDOW_P ((W)) \
&& !(W)->pseudo_window_p \
&& FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \
- && BUFFERP ((W)->buffer) \
- && !NILP (BVAR (XBUFFER ((W)->buffer), header_line_format)) \
- && WINDOW_TOTAL_LINES (W) > 1 + !NILP (BVAR (XBUFFER ((W)->buffer), mode_line_format)))
+ && BUFFERP (W->buffer) \
+ && !NILP (BVAR (XBUFFER (W->buffer), header_line_format)) \
+ && WINDOW_TOTAL_LINES (W) > 1 \
+ + !NILP (BVAR (XBUFFER (W->buffer), mode_line_format)))
/* Return proper value to be used as baseline offset of font that has
FACE_SUNKEN_BOX
};
+/* Underline type. */
+
+enum face_underline_type
+{
+ FACE_UNDER_LINE,
+ FACE_UNDER_WAVE
+};
/* Structure describing a realized face.
drawing shadows. */
unsigned use_box_color_for_shadows_p : 1;
+ /* Style of underlining. */
+ enum face_underline_type underline_type;
+
/* Non-zero if text in this face should be underlined, overlined,
strike-through or have a box drawn around it. */
unsigned underline_p : 1;
unsigned strike_through_color_defaulted_p : 1;
unsigned box_color_defaulted_p : 1;
- /* TTY appearances. Blinking is not yet implemented. Colors are
- found in `lface' with empty color string meaning the default
- color of the TTY. */
+ /* TTY appearances. Colors are found in `lface' with empty color
+ string meaning the default color of the TTY. */
unsigned tty_bold_p : 1;
- unsigned tty_dim_p : 1;
+ unsigned tty_italic_p : 1;
unsigned tty_underline_p : 1;
- unsigned tty_alt_charset_p : 1;
unsigned tty_reverse_p : 1;
- unsigned tty_blinking_p : 1;
/* 1 means that colors of this face may not be freed because they
have been copied bitwise from a base face (see
/* Data type for storing information about characters we need to
remember. */
struct bidi_saved_info {
- EMACS_INT bytepos, charpos; /* character's buffer position */
+ ptrdiff_t bytepos, charpos; /* character's buffer position */
bidi_type_t type; /* character's resolved bidi type */
bidi_type_t type_after_w1; /* original type of the character, after W1 */
bidi_type_t orig_type; /* type as we found it in the buffer */
struct bidi_string_data {
Lisp_Object lstring; /* Lisp string to reorder, or nil */
const unsigned char *s; /* string data, or NULL if reordering buffer */
- EMACS_INT schars; /* the number of characters in the string,
+ ptrdiff_t schars; /* the number of characters in the string,
excluding the terminating null */
- EMACS_INT bufpos; /* buffer position of lstring, or 0 if N/A */
+ ptrdiff_t bufpos; /* buffer position of lstring, or 0 if N/A */
unsigned from_disp_str : 1; /* 1 means the string comes from a
display property */
unsigned unibyte : 1; /* 1 means the string is unibyte */
/* Data type for reordering bidirectional text. */
struct bidi_it {
- EMACS_INT bytepos; /* iterator's position in buffer/string */
- EMACS_INT charpos;
+ ptrdiff_t bytepos; /* iterator's position in buffer/string */
+ ptrdiff_t charpos;
int ch; /* character at that position, or u+FFFC
("object replacement character") for a run
of characters covered by a display string */
- EMACS_INT nchars; /* its "length", usually 1; it's > 1 for a run
+ ptrdiff_t nchars; /* its "length", usually 1; it's > 1 for a run
of characters covered by a display string */
- EMACS_INT ch_len; /* its length in bytes */
+ ptrdiff_t ch_len; /* its length in bytes */
bidi_type_t type; /* bidi type of this character, after
resolving weak and neutral types */
bidi_type_t type_after_w1; /* original type, after overrides and W1 */
int resolved_level; /* final resolved level of this character */
int invalid_levels; /* how many PDFs to ignore */
int invalid_rl_levels; /* how many PDFs from RLE/RLO to ignore */
- int prev_was_pdf; /* if non-zero, previous char was PDF */
struct bidi_saved_info prev; /* info about previous character */
struct bidi_saved_info last_strong; /* last-seen strong directional char */
struct bidi_saved_info next_for_neutral; /* surrounding characters for... */
struct bidi_saved_info prev_for_neutral; /* ...resolving neutrals */
struct bidi_saved_info next_for_ws; /* character after sequence of ws */
- EMACS_INT next_en_pos; /* pos. of next char for determining ET type */
+ ptrdiff_t next_en_pos; /* pos. of next char for determining ET type */
bidi_type_t next_en_type; /* type of char at next_en_pos */
- EMACS_INT ignore_bn_limit; /* position until which to ignore BNs */
+ ptrdiff_t ignore_bn_limit; /* position until which to ignore BNs */
bidi_dir_t sor; /* direction of start-of-run in effect */
int scan_dir; /* direction of text scan, 1: forw, -1: back */
- EMACS_INT disp_pos; /* position of display string after ch */
+ ptrdiff_t disp_pos; /* position of display string after ch */
int disp_prop; /* if non-zero, there really is a
`display' property/string at disp_pos;
if 2, the property is a `space' spec */
struct bidi_stack level_stack[BIDI_MAXLEVEL]; /* stack of embedding levels */
struct bidi_string_data string; /* string to reorder */
bidi_dir_t paragraph_dir; /* current paragraph direction */
- EMACS_INT separator_limit; /* where paragraph separator should end */
+ ptrdiff_t separator_limit; /* where paragraph separator should end */
+ unsigned prev_was_pdf : 1; /* if non-zero, previous char was PDF */
unsigned first_elt : 1; /* if non-zero, examine current char first */
unsigned new_paragraph : 1; /* if non-zero, we expect a new paragraph */
unsigned frame_window_p : 1; /* non-zero if displaying on a GUI frame */
struct composition_it
{
/* Next position at which to check the composition. */
- EMACS_INT stop_pos;
+ ptrdiff_t stop_pos;
/* ID number of the composition or glyph-string. If negative, we
are not iterating over a composition now. */
ptrdiff_t id;
/* If this is an automatic composition, how many characters to look
back from the position where a character triggering the
composition exists. */
- int lookback;
+ ptrdiff_t lookback;
/* If non-negative, number of glyphs of the glyph-string. */
int nglyphs;
- /* Nonzero iff the composition is created while buffer is scanned in
+ /* True iff the composition is created while buffer is scanned in
reverse order, and thus the grapheme clusters must be rendered
from the last to the first. */
- int reversed_p;
+ bool reversed_p;
/** The following members contain information about the current
grapheme cluster. */
/* Position of the first character of the current grapheme cluster. */
- EMACS_INT charpos;
+ ptrdiff_t charpos;
/* Number of characters and bytes of the current grapheme cluster. */
int nchars, nbytes;
/* Indices of the glyphs for the current grapheme cluster. */
/* The next position at which to check for face changes, invisible
text, overlay strings, end of text etc., which see. */
- EMACS_INT stop_charpos;
+ ptrdiff_t stop_charpos;
/* Previous stop position, i.e. the last one before the current
iterator position in `current'. */
- EMACS_INT prev_stop;
+ ptrdiff_t prev_stop;
/* Last stop position iterated across whose bidi embedding level is
equal to the current paragraph's base embedding level. */
- EMACS_INT base_level_stop;
+ ptrdiff_t base_level_stop;
/* Maximum string or buffer position + 1. ZV when iterating over
current_buffer. */
- EMACS_INT end_charpos;
+ ptrdiff_t end_charpos;
/* C string to iterate over. Non-null means get characters from
this string, otherwise characters are read from current_buffer
const unsigned char *s;
/* Number of characters in the string (s, or it->string) we iterate
- over. */
- EMACS_INT string_nchars;
+ over. Used only in display_string and its subroutines; never
+ used for overlay strings and strings from display properties. */
+ ptrdiff_t string_nchars;
/* Start and end of a visible region; -1 if the region is not
visible in the window. */
- EMACS_INT region_beg_charpos, region_end_charpos;
+ ptrdiff_t region_beg_charpos, region_end_charpos;
/* Position at which redisplay end trigger functions should be run. */
- EMACS_INT redisplay_end_trigger_charpos;
+ ptrdiff_t redisplay_end_trigger_charpos;
/* 1 means multibyte characters are enabled. */
unsigned multibyte_p : 1;
whether an overlay string is being iterated over, because
n_overlay_strings can be positive even when we are not rendering
an overlay string. */
- int n_overlay_strings;
+ ptrdiff_t n_overlay_strings;
/* The charpos where n_overlay_strings was calculated. This should
be set at the same time as n_overlay_strings. It is needed
because we show before-strings at the start of invisible text;
see handle_invisible_prop in xdisp.c. */
- EMACS_INT overlay_strings_charpos;
+ ptrdiff_t overlay_strings_charpos;
/* Vector of overlays to process. Overlay strings are processed
OVERLAY_STRING_CHUNK_SIZE at a time. */
/* If non-nil, a Lisp string being processed. If
current.overlay_string_index >= 0, this is an overlay string from
- pos. Use STRINGP(it.string) as a test for whether we are
- rendering a string or something else; do NOT use BUFFERP(it.object). */
+ pos. Use STRINGP (it.string) to test whether we are rendering a
+ string or something else; do NOT use BUFFERP (it.object). */
Lisp_Object string;
/* If non-nil, we are processing a string that came
{
Lisp_Object string;
int string_nchars;
- EMACS_INT end_charpos;
- EMACS_INT stop_charpos;
- EMACS_INT prev_stop;
- EMACS_INT base_level_stop;
+ ptrdiff_t end_charpos;
+ ptrdiff_t stop_charpos;
+ ptrdiff_t prev_stop;
+ ptrdiff_t base_level_stop;
struct composition_it cmp_it;
int face_id;
/* -1 means selective display hides everything between a \r and the
next newline; > 0 means hide lines indented more than that value. */
- EMACS_INT selective;
+ ptrdiff_t selective;
/* An enumeration describing what the next display element is
after a call to get_next_display_element. */
Lisp_Object *type;
/* Check that SPEC is a valid image specification for the given
- image type. Value is non-zero if SPEC is valid. */
- int (* valid_p) (Lisp_Object spec);
+ image type. Value is true if SPEC is valid. */
+ bool (* valid_p) (Lisp_Object spec);
/* Load IMG which is used on frame F from information contained in
- IMG->spec. Value is non-zero if successful. */
- int (* load) (struct frame *f, struct image *img);
+ IMG->spec. Value is true if successful. */
+ bool (* load) (struct frame *f, struct image *img);
/* Free resources of image IMG which is used on frame F. */
void (* free) (struct frame *f, struct image *img);
+ /* Initialization function (used for dynamic loading of image
+ libraries on Windows), or NULL if none. */
+ bool (* init) (void);
+
/* Next in list of all supported image types. */
struct image_type *next;
};
{
/* The time in seconds at which the image was last displayed. Set
in prepare_image_for_display. */
- time_t timestamp;
+ EMACS_TIME timestamp;
/* Pixmaps of the image. */
Pixmap pixmap, mask;
#define TTY_CAP_UNDERLINE 0x02
#define TTY_CAP_BOLD 0x04
#define TTY_CAP_DIM 0x08
-#define TTY_CAP_BLINK 0x10
-#define TTY_CAP_ALT_CHARSET 0x20
+#define TTY_CAP_ITALIC 0x10
\f
/***********************************************************************
/* Defined in bidi.c */
-extern void bidi_init_it (EMACS_INT, EMACS_INT, int, struct bidi_it *);
+extern void bidi_init_it (ptrdiff_t, ptrdiff_t, bool, struct bidi_it *);
extern void bidi_move_to_visually_next (struct bidi_it *);
-extern void bidi_paragraph_init (bidi_dir_t, struct bidi_it *, int);
+extern void bidi_paragraph_init (bidi_dir_t, struct bidi_it *, bool);
extern int bidi_mirror_char (int);
extern void bidi_push_it (struct bidi_it *);
extern void bidi_pop_it (struct bidi_it *);
extern void *bidi_shelve_cache (void);
-extern void bidi_unshelve_cache (void *, int);
+extern void bidi_unshelve_cache (void *, bool);
/* Defined in xdisp.c */
-struct glyph_row *row_containing_pos (struct window *, EMACS_INT,
+struct glyph_row *row_containing_pos (struct window *, ptrdiff_t,
struct glyph_row *,
struct glyph_row *, int);
int line_bottom_y (struct it *);
-int display_prop_intangible_p (Lisp_Object, Lisp_Object, EMACS_INT, EMACS_INT);
+int display_prop_intangible_p (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
void resize_echo_area_exactly (void);
int resize_mini_window (struct window *, int);
#if defined USE_TOOLKIT_SCROLL_BARS && !defined USE_GTK
void mark_window_display_accurate (Lisp_Object, int);
void redisplay_preserve_echo_area (int);
-void init_iterator (struct it *, struct window *, EMACS_INT,
- EMACS_INT, struct glyph_row *, enum face_id);
+void init_iterator (struct it *, struct window *, ptrdiff_t,
+ ptrdiff_t, struct glyph_row *, enum face_id);
void init_iterator_to_row_start (struct it *, struct window *,
struct glyph_row *);
void start_display (struct it *, struct window *, struct text_pos);
-void move_it_to (struct it *, EMACS_INT, int, int, int, int);
+void move_it_to (struct it *, ptrdiff_t, int, int, int, int);
void move_it_vertically (struct it *, int);
void move_it_vertically_backward (struct it *, int);
-void move_it_by_lines (struct it *, int);
+void move_it_by_lines (struct it *, ptrdiff_t);
void move_it_past_eol (struct it *);
void move_it_in_display_line (struct it *it,
- EMACS_INT to_charpos, int to_x,
+ ptrdiff_t to_charpos, int to_x,
enum move_operation_enum op);
int in_display_vector_p (struct it *);
int frame_mode_line_height (struct frame *);
extern Lisp_Object Qtool_bar;
-extern int redisplaying_p;
+extern bool redisplaying_p;
extern int help_echo_showing_p;
extern int current_mode_line_height, current_header_line_height;
extern Lisp_Object help_echo_string, help_echo_window;
extern Lisp_Object help_echo_object, previous_help_echo_string;
-extern EMACS_INT help_echo_pos;
+extern ptrdiff_t help_echo_pos;
extern struct frame *last_mouse_frame;
extern int last_tool_bar_item;
extern void reseat_at_previous_visible_line_start (struct it *);
extern Lisp_Object lookup_glyphless_char_display (int, struct it *);
-extern EMACS_INT compute_display_string_pos (struct text_pos *,
+extern ptrdiff_t compute_display_string_pos (struct text_pos *,
struct bidi_string_data *,
int, int *);
-extern EMACS_INT compute_display_string_end (EMACS_INT,
+extern ptrdiff_t compute_display_string_end (ptrdiff_t,
struct bidi_string_data *);
extern void produce_stretch_glyph (struct it *);
-
#ifdef HAVE_WINDOW_SYSTEM
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
extern void dump_glyph_string (struct glyph_string *) EXTERNALLY_VISIBLE;
#endif
extern Lisp_Object find_hot_spot (Lisp_Object, int, int);
extern void handle_tool_bar_click (struct frame *,
- int, int, int, unsigned int);
+ int, int, int, int);
extern void expose_frame (struct frame *, int, int, int, int);
extern int x_intersect_rectangles (XRectangle *, XRectangle *,
extern void x_destroy_bitmap (struct frame *, ptrdiff_t);
#endif
extern void x_destroy_all_bitmaps (Display_Info *);
-extern int x_create_bitmap_mask (struct frame *, ptrdiff_t);
+extern void x_create_bitmap_mask (struct frame *, ptrdiff_t);
extern Lisp_Object x_find_image_file (Lisp_Object);
void x_kill_gs_process (Pixmap, struct frame *);
void free_image_cache (struct frame *);
void clear_image_caches (Lisp_Object);
void mark_image_cache (struct image_cache *);
-int valid_image_p (Lisp_Object);
+bool valid_image_p (Lisp_Object);
void prepare_image_for_display (struct frame *, struct image *);
ptrdiff_t lookup_image (struct frame *, Lisp_Object);
int tabs_safe_p (int);
void init_baud_rate (int);
void init_sigio (int);
+void ignore_sigio (void);
/* Defined in xfaces.c */
char *choose_face_font (struct frame *, Lisp_Object *, Lisp_Object,
int *);
void prepare_face_for_display (struct frame *, struct face *);
-int xstrcasecmp (const char *, const char *);
int lookup_named_face (struct frame *, Lisp_Object, int);
int lookup_basic_face (struct frame *, int);
int smaller_face (struct frame *, int, int);
void init_frame_faces (struct frame *);
void free_frame_faces (struct frame *);
void recompute_basic_faces (struct frame *);
-int face_at_buffer_position (struct window *w, EMACS_INT pos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, EMACS_INT limit,
+int face_at_buffer_position (struct window *w, ptrdiff_t pos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, int base_face_id);
-int face_for_overlay_string (struct window *w, EMACS_INT pos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, EMACS_INT limit,
+int face_for_overlay_string (struct window *w, ptrdiff_t pos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, Lisp_Object overlay);
int face_at_string_position (struct window *w, Lisp_Object string,
- EMACS_INT pos, EMACS_INT bufpos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, enum face_id, int mouse);
-int merge_faces (struct frame *, Lisp_Object, EMACS_INT, int);
+ ptrdiff_t pos, ptrdiff_t bufpos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, enum face_id, int mouse);
+int merge_faces (struct frame *, Lisp_Object, int, int);
int compute_char_face (struct frame *, int, Lisp_Object);
void free_all_realized_faces (Lisp_Object);
extern Lisp_Object Qforeground_color, Qbackground_color;
extern Lisp_Object tip_frame;
extern Window tip_window;
-EXFUN (Fx_hide_tip, 0);
+extern frame_parm_handler x_frame_parm_handlers[];
+
extern void start_hourglass (void);
extern void cancel_hourglass (void);
-extern int hourglass_started (void);
extern int hourglass_shown_p;
+
struct atimer; /* Defined in atimer.h. */
/* If non-null, an asynchronous timer that, when it expires, displays
an hourglass cursor on all frames. */
Lisp_Object *,
int *, int *, int *, int *);
extern Lisp_Object mode_line_string (struct window *, enum window_part,
- int *, int *, EMACS_INT *,
+ int *, int *, ptrdiff_t *,
Lisp_Object *,
int *, int *, int *, int *);
extern Lisp_Object marginal_area_string (struct window *, enum window_part,
- int *, int *, EMACS_INT *,
+ int *, int *, ptrdiff_t *,
Lisp_Object *,
int *, int *, int *, int *);
extern void redraw_frame (struct frame *);
extern void cancel_line (int, struct frame *);
extern void init_desired_glyphs (struct frame *);
-extern int update_frame (struct frame *, int, int);
+extern bool update_frame (struct frame *, bool, bool);
extern void bitch_at_user (void);
void adjust_glyphs (struct frame *);
void free_glyphs (struct frame *);
int, int, int);
void rotate_matrix (struct glyph_matrix *, int, int, int);
void increment_matrix_positions (struct glyph_matrix *,
- int, int, EMACS_INT, EMACS_INT);
+ int, int, ptrdiff_t, ptrdiff_t);
void blank_row (struct window *, struct glyph_row *, int);
-void enable_glyph_matrix_rows (struct glyph_matrix *, int, int, int);
+void clear_glyph_matrix_rows (struct glyph_matrix *, int, int);
void clear_glyph_row (struct glyph_row *);
void prepare_desired_row (struct glyph_row *);
-void set_window_update_flags (struct window *, int);
-void update_single_window (struct window *, int);
-void do_pending_window_change (int);
-void change_frame_size (struct frame *, int, int, int, int, int);
+void set_window_update_flags (struct window *, bool);
+void update_single_window (struct window *, bool);
+void do_pending_window_change (bool);
+void change_frame_size (struct frame *, int, int, bool, bool, bool);
void init_display (void);
void syms_of_display (void);
extern Lisp_Object Qredisplay_dont_pause;
extern int per_line_cost (const char *);
extern void calculate_costs (struct frame *);
extern void produce_glyphs (struct it *);
-extern void produce_special_glyphs (struct it *, enum display_element_type);
extern int tty_capable_p (struct tty_display_info *, unsigned, unsigned long, unsigned long);
extern void set_tty_color_mode (struct tty_display_info *, struct frame *);
extern struct terminal *get_named_tty (const char *);
-EXFUN (Ftty_type, 1);
-EXFUN (Fcontrolling_tty_p, 1);
extern void create_tty_output (struct frame *);
extern struct terminal *init_tty (const char *, const char *, int);
extern void tty_append_glyph (struct it *);
#endif /* HAVE_WINDOW_SYSTEM */
+INLINE_HEADER_END
+
#endif /* not DISPEXTERN_H_INCLUDED */
/* Updating of data structures for redisplay.
- Copyright (C) 1985-1988, 1993-1995, 1997-2012 Free Software Foundation, Inc.
+
+Copyright (C) 1985-1988, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <signal.h>
+
+#define DISPEXTERN_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <ctype.h>
-#include <setjmp.h>
#include <unistd.h>
#include "lisp.h"
/* cm.h must come after dispextern.h on Windows. */
#include "dispextern.h"
#include "cm.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "keyboard.h"
#include "frame.h"
#include "termhooks.h"
#include "syssignal.h"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif /* HAVE_X_WINDOWS */
-
-#ifdef HAVE_NTGUI
-#include "w32term.h"
-#endif /* HAVE_NTGUI */
-
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
/* Include systime.h after xterm.h to avoid double inclusion of time.h. */
#include "systime.h"
#include <errno.h>
-/* 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
-#else /* not __GNU_LIBRARY__ */
-#if !defined (PENDING_OUTPUT_COUNT) && HAVE_STDIO_EXT_H && HAVE___FPENDING
+#ifdef DISPNEW_NEEDS_STDIO_EXT
#include <stdio_ext.h>
-#define PENDING_OUTPUT_COUNT(FILE) __fpending (FILE)
-#endif
-#ifndef PENDING_OUTPUT_COUNT
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)
#endif
-#endif /* not __GNU_LIBRARY__ */
-#if defined (HAVE_TERM_H) && defined (GNU_LINUX) && defined (HAVE_LIBNCURSES)
+#if defined (HAVE_TERM_H) && defined (GNU_LINUX)
#include <term.h> /* for tgetent */
#endif
\f
static int required_matrix_height (struct window *);
static int required_matrix_width (struct window *);
static void adjust_frame_glyphs (struct frame *);
-static void change_frame_size_1 (struct frame *, int, int, int, int, int);
-static void increment_row_positions (struct glyph_row *, EMACS_INT, EMACS_INT);
+static void change_frame_size_1 (struct frame *, int, int, bool, bool, bool);
+static void increment_row_positions (struct glyph_row *, ptrdiff_t, ptrdiff_t);
static void fill_up_frame_row_with_spaces (struct glyph_row *, int);
static void build_frame_matrix_from_window_tree (struct glyph_matrix *,
struct window *);
static void adjust_frame_message_buffer (struct frame *);
static void adjust_decode_mode_spec_buffer (struct frame *);
static void fill_up_glyph_row_with_spaces (struct glyph_row *);
-static void clear_window_matrices (struct window *, int);
+static void clear_window_matrices (struct window *, bool);
static void fill_up_glyph_row_area_with_spaces (struct glyph_row *, int);
-static int scrolling_window (struct window *, int);
-static int update_window_line (struct window *, int, int *);
+static int scrolling_window (struct window *, bool);
+static bool update_window_line (struct window *, int, bool *);
static void mirror_make_current (struct window *, int);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static void check_matrix_pointers (struct glyph_matrix *,
struct glyph_matrix *);
#endif
static void mirror_line_dance (struct window *, int, int, int *, char *);
-static int update_window_tree (struct window *, int);
-static int update_window (struct window *, int);
-static int update_frame_1 (struct frame *, int, int);
-static int scrolling (struct frame *);
+static bool update_window_tree (struct window *, bool);
+static bool update_window (struct window *, bool);
+static bool update_frame_1 (struct frame *, bool, bool);
+static bool scrolling (struct frame *);
static void set_window_cursor_after_update (struct window *);
static void adjust_frame_glyphs_for_window_redisplay (struct frame *);
static void adjust_frame_glyphs_for_frame_redisplay (struct frame *);
\f
-/* Define PERIODIC_PREEMPTION_CHECKING to 1, if micro-second timers
- are supported, so we can check for input during redisplay at
- regular intervals. */
-#ifdef EMACS_HAS_USECS
-#define PERIODIC_PREEMPTION_CHECKING 1
-#else
-#define PERIODIC_PREEMPTION_CHECKING 0
-#endif
-
-#if PERIODIC_PREEMPTION_CHECKING
-
/* Redisplay preemption timers. */
static EMACS_TIME preemption_period;
static EMACS_TIME preemption_next_check;
-#endif
-
-/* Nonzero upon entry to redisplay means do not assume anything about
+/* True upon entry to redisplay means do not assume anything about
current contents of actual terminal frame; clear and redraw it. */
-int frame_garbaged;
+bool frame_garbaged;
-/* Nonzero means last display completed. Zero means it was preempted. */
+/* True means last display completed. False means it was preempted. */
-int display_completed;
+bool display_completed;
Lisp_Object Qdisplay_table, Qredisplay_dont_pause;
struct frame *last_nonminibuf_frame;
-/* 1 means SIGWINCH happened when not safe. */
+/* True means SIGWINCH happened when not safe. */
-static int delayed_size_change;
+static bool delayed_size_change;
/* 1 means glyph initialization has been completed at startup. */
-static int glyphs_initialized_initially_p;
+static bool glyphs_initialized_initially_p;
/* Updated window if != 0. Set by update_window. */
static struct frame *frame_matrix_frame;
-/* Non-zero means that fonts have been loaded since the last glyph
+/* True means that fonts have been loaded since the last glyph
matrix adjustments. Redisplay must stop, and glyph matrices must
- be adjusted when this flag becomes non-zero during display. The
+ be adjusted when this flag becomes true during display. The
reason fonts can be loaded so late is that fonts of fontsets are
loaded on demand. Another reason is that a line contains many
characters displayed by zero width or very narrow glyphs of
variable-width fonts. */
-int fonts_changed_p;
+bool fonts_changed_p;
/* Convert vpos and hpos from frame to window and vice versa.
This may only be used for terminal frames. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static int window_to_frame_vpos (struct window *, int);
static int window_to_frame_hpos (struct window *, int);
history. */
static uprintmax_t history_tick;
-
-static void add_frame_display_history (struct frame *, int);
\f
/* Add to the redisplay history how window W has been displayed.
MSG is a trace containing the information how W's glyph matrix
- has been constructed. PAUSED_P non-zero means that the update
+ has been constructed. PAUSED_P means that the update
has been interrupted for pending input. */
static void
-add_window_display_history (struct window *w, const char *msg, int paused_p)
+add_window_display_history (struct window *w, const char *msg, bool paused_p)
{
char *buf;
/* Add to the redisplay history that frame F has been displayed.
- PAUSED_P non-zero means that the update has been interrupted for
+ PAUSED_P means that the update has been interrupted for
pending input. */
static void
-add_frame_display_history (struct frame *f, int paused_p)
+add_frame_display_history (struct frame *f, bool paused_p)
{
char *buf;
}
-#else /* GLYPH_DEBUG == 0 */
+#else /* not GLYPH_DEBUG */
#define WINDOW_TO_FRAME_VPOS(W, VPOS) ((VPOS) + WINDOW_TOP_EDGE_LINE (W))
#define WINDOW_TO_FRAME_HPOS(W, HPOS) ((HPOS) + WINDOW_LEFT_EDGE_COL (W))
-#endif /* GLYPH_DEBUG == 0 */
-
+#endif /* GLYPH_DEBUG */
-#if defined PROFILING && !HAVE___EXECUTABLE_START
-/* FIXME: only used to find text start for profiling. */
+#if (defined PROFILING \
+ && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__) \
+ && !HAVE___EXECUTABLE_START)
+/* This function comes first in the Emacs executable and is used only
+ to estimate the text start for profiling. */
void
-safe_bcopy (const char *from, char *to, int size)
+__executable_start (void)
{
- abort ();
+ emacs_abort ();
}
#endif
\f
static struct glyph_matrix *
new_glyph_matrix (struct glyph_pool *pool)
{
- struct glyph_matrix *result;
-
- /* Allocate and clear. */
- result = (struct glyph_matrix *) xmalloc (sizeof *result);
- memset (result, 0, sizeof *result);
+ struct glyph_matrix *result = xzalloc (sizeof *result);
/* Increment number of allocated matrices. This count is used
to detect memory leaks. */
/* Detect the case that more matrices are freed than were
allocated. */
if (--glyph_matrix_count < 0)
- abort ();
+ emacs_abort ();
/* Free glyph memory if MATRIX owns it. */
if (matrix->pool == NULL)
return n;
}
-#if XASSERTS
-/* Return non-zero if ROW's hash value is correct, zero if not. */
-int
+/* Return true if ROW's hash value is correct.
+ Optimized away if ENABLE_CHECKING is not defined. */
+
+static bool
verify_row_hash (struct glyph_row *row)
{
return row->hash == row_hash (row);
}
-#endif
/* Adjust glyph matrix MATRIX on window W or on a frame to changed
window sizes.
{
int i;
int new_rows;
- int marginal_areas_changed_p = 0;
- int header_line_changed_p = 0;
- int header_line_p = 0;
+ bool marginal_areas_changed_p = 0;
+ bool header_line_changed_p = 0;
+ bool header_line_p = 0;
int left = -1, right = -1;
int window_width = -1, window_height = -1;
{
left = margin_glyphs_to_reserve (w, dim.width, w->left_margin_cols);
right = margin_glyphs_to_reserve (w, dim.width, w->right_margin_cols);
- xassert (left >= 0 && right >= 0);
+ eassert (left >= 0 && right >= 0);
marginal_areas_changed_p = (left != matrix->left_margin_glyphs
|| right != matrix->right_margin_glyphs);
each row into the glyph pool. */
if (matrix->pool)
{
- xassert (matrix->pool->glyphs);
+ eassert (matrix->pool->glyphs);
if (w)
{
}
}
- xassert (left >= 0 && right >= 0);
+ eassert (left >= 0 && right >= 0);
matrix->left_margin_glyphs = left;
matrix->right_margin_glyphs = right;
}
/* Number of rows to be used by MATRIX. */
matrix->nrows = dim.height;
- xassert (matrix->nrows >= 0);
+ eassert (matrix->nrows >= 0);
if (w)
{
are invalidated below. */
if (INTEGERP (w->window_end_vpos)
&& XFASTINT (w->window_end_vpos) >= i)
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
while (i < matrix->nrows)
matrix->rows[i++].enabled_p = 0;
void
increment_matrix_positions (struct glyph_matrix *matrix, int start, int end,
- EMACS_INT delta, EMACS_INT delta_bytes)
+ ptrdiff_t delta, ptrdiff_t delta_bytes)
{
/* Check that START and END are reasonable values. */
- xassert (start >= 0 && start <= matrix->nrows);
- xassert (end >= 0 && end <= matrix->nrows);
- xassert (start <= end);
+ eassert (start >= 0 && start <= matrix->nrows);
+ eassert (end >= 0 && end <= matrix->nrows);
+ eassert (start <= end);
for (; start < end; ++start)
increment_row_positions (matrix->rows + start, delta, delta_bytes);
}
-/* Enable a range of rows in glyph matrix MATRIX. START and END are
- the row indices of the first and last + 1 row to enable. If
- ENABLED_P is non-zero, enabled_p flags in rows will be set to 1. */
+/* Clear the enable_p flags in a range of rows in glyph matrix MATRIX.
+ START and END are the row indices of the first and last + 1 row to clear. */
void
-enable_glyph_matrix_rows (struct glyph_matrix *matrix, int start, int end, int enabled_p)
+clear_glyph_matrix_rows (struct glyph_matrix *matrix, int start, int end)
{
- xassert (start <= end);
- xassert (start >= 0 && start < matrix->nrows);
- xassert (end >= 0 && end <= matrix->nrows);
+ eassert (start <= end);
+ eassert (start >= 0 && start < matrix->nrows);
+ eassert (end >= 0 && end <= matrix->nrows);
for (; start < end; ++start)
- matrix->rows[start].enabled_p = enabled_p != 0;
+ matrix->rows[start].enabled_p = 0;
}
/* Clear MATRIX.
- This empties all rows in MATRIX by setting the enabled_p flag for
- all rows of the matrix to zero. The function prepare_desired_row
- will eventually really clear a row when it sees one with a zero
- enabled_p flag.
+ Empty all rows in MATRIX by clearing their enabled_p flags.
+ The function prepare_desired_row will eventually really clear a row
+ when it sees one with a false enabled_p flag.
- Resets update hints to defaults value. The only update hint
+ Reset update hints to default values. The only update hint
currently present is the flag MATRIX->no_scrolling_p. */
void
{
if (matrix)
{
- enable_glyph_matrix_rows (matrix, 0, matrix->nrows, 0);
+ clear_glyph_matrix_rows (matrix, 0, matrix->nrows);
matrix->no_scrolling_p = 0;
}
}
{
int min_y, max_y;
- xassert (start <= end);
- xassert (start >= 0 && start < matrix->nrows);
- xassert (end >= 0 && end <= matrix->nrows);
+ eassert (start <= end);
+ eassert (start >= 0 && start < matrix->nrows);
+ eassert (end >= 0 && end <= matrix->nrows);
min_y = WINDOW_HEADER_LINE_HEIGHT (w);
max_y = WINDOW_BOX_HEIGHT_NO_MODE_LINE (w);
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
/* Clear current window matrices. */
- xassert (WINDOWP (FRAME_ROOT_WINDOW (f)));
+ eassert (WINDOWP (FRAME_ROOT_WINDOW (f)));
clear_window_matrices (XWINDOW (FRAME_ROOT_WINDOW (f)), 0);
}
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->desired_matrix);
/* Do it for window matrices. */
- xassert (WINDOWP (FRAME_ROOT_WINDOW (f)));
+ eassert (WINDOWP (FRAME_ROOT_WINDOW (f)));
clear_window_matrices (XWINDOW (FRAME_ROOT_WINDOW (f)), 1);
}
-/* Clear matrices in window tree rooted in W. If DESIRED_P is
- non-zero clear desired matrices, otherwise clear current matrices. */
+/* Clear matrices in window tree rooted in W. If DESIRED_P,
+ clear desired matrices, otherwise clear current matrices. */
static void
-clear_window_matrices (struct window *w, int desired_p)
+clear_window_matrices (struct window *w, bool desired_p)
{
while (w)
{
if (!NILP (w->hchild))
{
- xassert (WINDOWP (w->hchild));
+ eassert (WINDOWP (w->hchild));
clear_window_matrices (XWINDOW (w->hchild), desired_p);
}
else if (!NILP (w->vchild))
{
- xassert (WINDOWP (w->vchild));
+ eassert (WINDOWP (w->vchild));
clear_window_matrices (XWINDOW (w->vchild), desired_p);
}
else
else
{
clear_glyph_matrix (w->current_matrix);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
}
}
static void
increment_row_positions (struct glyph_row *row,
- EMACS_INT delta, EMACS_INT delta_bytes)
+ ptrdiff_t delta, ptrdiff_t delta_bytes)
{
int area, i;
/* Test whether the glyph memory of the glyph row WINDOW_ROW, which is
a row in a window matrix, is a slice of the glyph memory of the
glyph row FRAME_ROW which is a row in a frame glyph matrix. Value
- is non-zero if the glyph memory of WINDOW_ROW is part of the glyph
+ is true if the glyph memory of WINDOW_ROW is part of the glyph
memory of FRAME_ROW. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
-static int
+static bool
glyph_row_slice_p (struct glyph_row *window_row, struct glyph_row *frame_row)
{
struct glyph *window_glyph_start = window_row->glyphs[0];
{
int i;
- xassert (row >= 0 && row < frame_matrix->nrows);
+ eassert (row >= 0 && row < frame_matrix->nrows);
for (i = 0; i < window_matrix->nrows; ++i)
if (glyph_row_slice_p (window_matrix->rows + i,
{
if (!row->enabled_p)
{
- int rp = row->reversed_p;
+ bool rp = row->reversed_p;
clear_glyph_row (row);
row->enabled_p = 1;
}
-/* Test two glyph rows A and B for equality. Value is non-zero if A
- and B have equal contents. MOUSE_FACE_P non-zero means compare the
- mouse_face_p flags of A and B, too. */
+/* Return true if the glyph rows A and B have equal contents.
+ MOUSE_FACE_P means compare the mouse_face_p flags of A and B, too. */
-static inline int
-row_equal_p (struct glyph_row *a, struct glyph_row *b, int mouse_face_p)
+static inline bool
+row_equal_p (struct glyph_row *a, struct glyph_row *b, bool mouse_face_p)
{
- xassert (verify_row_hash (a));
- xassert (verify_row_hash (b));
+ eassert (verify_row_hash (a));
+ eassert (verify_row_hash (b));
if (a == b)
return 1;
static struct glyph_pool *
new_glyph_pool (void)
{
- struct glyph_pool *result;
-
- /* Allocate a new glyph_pool and clear it. */
- result = (struct glyph_pool *) xmalloc (sizeof *result);
- memset (result, 0, sizeof *result);
+ struct glyph_pool *result = xzalloc (sizeof *result);
/* For memory leak and double deletion checking. */
++glyph_pool_count;
{
/* More freed than allocated? */
--glyph_pool_count;
- xassert (glyph_pool_count >= 0);
+ eassert (glyph_pool_count >= 0);
xfree (pool->glyphs);
xfree (pool);
is changed from a large value to a smaller one. But, if someone
does it once, we can expect that he will do it again.
- Value is non-zero if the pool changed in a way which makes
+ Return true if the pool changed in a way which makes
re-adjusting window glyph matrices necessary. */
-static int
+static bool
realloc_glyph_pool (struct glyph_pool *pool, struct dim matrix_dim)
{
ptrdiff_t needed;
- int changed_p;
+ bool changed_p;
changed_p = (pool->glyphs == 0
|| matrix_dim.height != pool->nrows
Debug Code
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Flush standard output. This is sometimes useful to call from the debugger.
for (i = 0; i < matrix->nrows; ++i)
for (j = 0; j < matrix->nrows; ++j)
- xassert (i == j
+ eassert (i == j
|| (matrix->rows[i].glyphs[TEXT_AREA]
!= matrix->rows[j].glyphs[TEXT_AREA]));
}
struct glyph_row *
matrix_row (struct glyph_matrix *matrix, int row)
{
- xassert (matrix && matrix->rows);
- xassert (row >= 0 && row < matrix->nrows);
+ eassert (matrix && matrix->rows);
+ eassert (row >= 0 && row < matrix->nrows);
/* That's really too slow for normal testing because this function
is called almost everywhere. Although---it's still astonishingly
last_text_row = row;
/* Check that character and byte positions are in sync. */
- xassert (MATRIX_ROW_START_BYTEPOS (row)
+ eassert (MATRIX_ROW_START_BYTEPOS (row)
== CHAR_TO_BYTE (MATRIX_ROW_START_CHARPOS (row)));
- xassert (BYTEPOS (row->start.pos)
+ eassert (BYTEPOS (row->start.pos)
== CHAR_TO_BYTE (CHARPOS (row->start.pos)));
/* CHAR_TO_BYTE aborts when invoked for a position > Z. We can
displaying something like `[Sole completion]' at its end. */
if (MATRIX_ROW_END_CHARPOS (row) < BUF_ZV (current_buffer))
{
- xassert (MATRIX_ROW_END_BYTEPOS (row)
+ eassert (MATRIX_ROW_END_BYTEPOS (row)
== CHAR_TO_BYTE (MATRIX_ROW_END_CHARPOS (row)));
- xassert (BYTEPOS (row->end.pos)
+ eassert (BYTEPOS (row->end.pos)
== CHAR_TO_BYTE (CHARPOS (row->end.pos)));
}
of next row. */
if (next->enabled_p && MATRIX_ROW_DISPLAYS_TEXT_P (next))
{
- xassert (MATRIX_ROW_END_CHARPOS (row)
+ eassert (MATRIX_ROW_END_CHARPOS (row)
== MATRIX_ROW_START_CHARPOS (next));
- xassert (MATRIX_ROW_END_BYTEPOS (row)
+ eassert (MATRIX_ROW_END_BYTEPOS (row)
== MATRIX_ROW_START_BYTEPOS (next));
- xassert (CHARPOS (row->end.pos) == CHARPOS (next->start.pos));
- xassert (BYTEPOS (row->end.pos) == BYTEPOS (next->start.pos));
+ eassert (CHARPOS (row->end.pos) == CHARPOS (next->start.pos));
+ eassert (BYTEPOS (row->end.pos) == BYTEPOS (next->start.pos));
}
row = next;
}
- xassert (w->current_matrix->nrows == w->desired_matrix->nrows);
- xassert (w->desired_matrix->rows != NULL);
+ eassert (w->current_matrix->nrows == w->desired_matrix->nrows);
+ eassert (w->desired_matrix->rows != NULL);
set_buffer_temp (saved);
}
#endif /* 0 */
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
\f
X and Y are column/row within the frame glyph matrix where
sub-matrices for the window tree rooted at WINDOW must be
- allocated. DIM_ONLY_P non-zero means that the caller of this
+ allocated. DIM_ONLY_P means that the caller of this
function is only interested in the result matrix dimension, and
matrix adjustments should not be performed.
static struct dim
allocate_matrices_for_frame_redisplay (Lisp_Object window, int x, int y,
- int dim_only_p, int *window_change_flags)
+ bool dim_only_p, int *window_change_flags)
{
struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
int x0 = x, y0 = y;
struct dim total;
struct dim dim;
struct window *w;
- int in_horz_combination_p;
+ bool in_horz_combination_p;
/* What combination is WINDOW part of? Compute this once since the
result is the same for all windows in the `next' chain. The
/* Actually change matrices, if allowed. Do not consider
CHANGED_LEAF_MATRIX computed above here because the pool
may have been changed which we don't now here. We trust
- that we only will be called with DIM_ONLY_P != 0 when
+ that we only will be called with DIM_ONLY_P when
necessary. */
if (!dim_only_p)
{
{
/* Block input so that expose events and other events that access
glyph matrices are not processed while we are changing them. */
- BLOCK_INPUT;
+ block_input ();
if (f)
adjust_frame_glyphs (f);
adjust_frame_glyphs (XFRAME (lisp_frame));
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
int top_margin = FRAME_TOP_MARGIN (sf);
/* Do it for the root window. */
- XSETFASTINT (root->top_line, top_margin);
- XSETFASTINT (root->total_lines, frame_lines - 1 - top_margin);
- XSETFASTINT (root->total_cols, frame_cols);
+ wset_top_line (root, make_number (top_margin));
+ wset_total_lines (root, make_number (frame_lines - 1 - top_margin));
+ wset_total_cols (root, make_number (frame_cols));
/* Do it for the mini-buffer window. */
- XSETFASTINT (mini->top_line, frame_lines - 1);
- XSETFASTINT (mini->total_lines, 1);
- XSETFASTINT (mini->total_cols, frame_cols);
+ wset_top_line (mini, make_number (frame_lines - 1));
+ wset_total_lines (mini, make_number (1));
+ wset_total_cols (mini, make_number (frame_cols));
adjust_frame_glyphs (sf);
glyphs_initialized_initially_p = 1;
f->glyphs_initialized_p = 1;
}
-/* Return 1 if any window in the tree has nonzero window margins. See
+/* Return true if any window in the tree has nonzero window margins. See
the hack at the end of adjust_frame_glyphs_for_frame_redisplay. */
-static int
+static bool
showing_window_margins_p (struct window *w)
{
while (w)
struct glyph_matrix *m = w->current_matrix;
struct glyph_matrix *fm = f->current_matrix;
- xassert (m->matrix_h == WINDOW_TOTAL_LINES (w));
- xassert (m->matrix_w == WINDOW_TOTAL_COLS (w));
+ eassert (m->matrix_h == WINDOW_TOTAL_LINES (w));
+ eassert (m->matrix_w == WINDOW_TOTAL_COLS (w));
for (i = 0; i < m->matrix_h; ++i)
{
struct glyph_row *r = m->rows + i;
struct glyph_row *fr = fm->rows + i + WINDOW_TOP_EDGE_LINE (w);
- xassert (r->glyphs[TEXT_AREA] >= fr->glyphs[TEXT_AREA]
+ eassert (r->glyphs[TEXT_AREA] >= fr->glyphs[TEXT_AREA]
&& r->glyphs[LAST_AREA] <= fr->glyphs[LAST_AREA]);
r->enabled_p = fr->enabled_p;
save_current_matrix (struct frame *f)
{
int i;
- struct glyph_matrix *saved;
-
- saved = (struct glyph_matrix *) xmalloc (sizeof *saved);
- memset (saved, 0, sizeof *saved);
+ struct glyph_matrix *saved = xzalloc (sizeof *saved);
saved->nrows = f->current_matrix->nrows;
- saved->rows = (struct glyph_row *) xmalloc (saved->nrows
- * sizeof *saved->rows);
- memset (saved->rows, 0, saved->nrows * sizeof *saved->rows);
+ saved->rows = xzalloc (saved->nrows * sizeof *saved->rows);
for (i = 0; i < saved->nrows; ++i)
{
struct glyph_row *from = f->current_matrix->rows + i;
struct glyph_row *to = saved->rows + i;
ptrdiff_t nbytes = from->used[TEXT_AREA] * sizeof (struct glyph);
- to->glyphs[TEXT_AREA] = (struct glyph *) xmalloc (nbytes);
+ to->glyphs[TEXT_AREA] = xmalloc (nbytes);
memcpy (to->glyphs[TEXT_AREA], from->glyphs[TEXT_AREA], nbytes);
to->used[TEXT_AREA] = from->used[TEXT_AREA];
}
adjust_frame_glyphs_for_frame_redisplay (struct frame *f)
{
struct dim matrix_dim;
- int pool_changed_p;
+ bool pool_changed_p;
int window_change_flags;
int top_window_y;
/* Size of frame matrices must equal size of frame. Note
that we are called for X frames with window widths NOT equal
to the frame width (from CHANGE_FRAME_SIZE_1). */
- xassert (matrix_dim.width == FRAME_COLS (f)
+ eassert (matrix_dim.width == FRAME_COLS (f)
&& matrix_dim.height == FRAME_LINES (f));
/* Pointers to glyph memory in glyph rows are exchanged during
static void
adjust_frame_glyphs_for_window_redisplay (struct frame *f)
{
- xassert (FRAME_WINDOW_P (f) && FRAME_LIVE_P (f));
+ eassert (FRAME_WINDOW_P (f) && FRAME_LIVE_P (f));
/* Allocate/reallocate window matrices. */
allocate_matrices_for_window_redisplay (XWINDOW (FRAME_ROOT_WINDOW (f)));
struct window *w;
if (NILP (f->menu_bar_window))
{
- f->menu_bar_window = make_window ();
+ Lisp_Object frame;
+ fset_menu_bar_window (f, make_window ());
w = XWINDOW (f->menu_bar_window);
- XSETFRAME (w->frame, f);
+ XSETFRAME (frame, f);
+ wset_frame (w, frame);
w->pseudo_window_p = 1;
}
else
/* Set window dimensions to frame dimensions and allocate or
adjust glyph matrices of W. */
- XSETFASTINT (w->top_line, 0);
- XSETFASTINT (w->left_col, 0);
- XSETFASTINT (w->total_lines, FRAME_MENU_BAR_LINES (f));
- XSETFASTINT (w->total_cols, FRAME_TOTAL_COLS (f));
+ wset_top_line (w, make_number (0));
+ wset_left_col (w, make_number (0));
+ wset_total_lines (w, make_number (FRAME_MENU_BAR_LINES (f)));
+ wset_total_cols (w, make_number (FRAME_TOTAL_COLS (f)));
allocate_matrices_for_window_redisplay (w);
}
#endif /* not USE_X_TOOLKIT && not USE_GTK */
struct window *w;
if (NILP (f->tool_bar_window))
{
- f->tool_bar_window = make_window ();
+ Lisp_Object frame;
+ fset_tool_bar_window (f, make_window ());
w = XWINDOW (f->tool_bar_window);
- XSETFRAME (w->frame, f);
+ XSETFRAME (frame, f);
+ wset_frame (w, frame);
w->pseudo_window_p = 1;
}
else
w = XWINDOW (f->tool_bar_window);
- XSETFASTINT (w->top_line, FRAME_MENU_BAR_LINES (f));
- XSETFASTINT (w->left_col, 0);
- XSETFASTINT (w->total_lines, FRAME_TOOL_BAR_LINES (f));
- XSETFASTINT (w->total_cols, FRAME_TOTAL_COLS (f));
+ wset_top_line (w, make_number (FRAME_MENU_BAR_LINES (f)));
+ wset_left_col (w, make_number (0));
+ wset_total_lines (w, make_number (FRAME_TOOL_BAR_LINES (f)));
+ wset_total_cols (w, make_number (FRAME_TOTAL_COLS (f)));
allocate_matrices_for_window_redisplay (w);
}
#endif
static void
adjust_frame_message_buffer (struct frame *f)
{
- ptrdiff_t size = FRAME_MESSAGE_BUF_SIZE (f) + 1;
-
- if (FRAME_MESSAGE_BUF (f))
- {
- char *buffer = FRAME_MESSAGE_BUF (f);
- char *new_buffer = (char *) xrealloc (buffer, size);
- FRAME_MESSAGE_BUF (f) = new_buffer;
- }
- else
- FRAME_MESSAGE_BUF (f) = (char *) xmalloc (size);
+ FRAME_MESSAGE_BUF (f) = xrealloc (FRAME_MESSAGE_BUF (f),
+ FRAME_MESSAGE_BUF_SIZE (f) + 1);
}
static void
adjust_decode_mode_spec_buffer (struct frame *f)
{
- f->decode_mode_spec_buffer
- = (char *) xrealloc (f->decode_mode_spec_buffer,
- FRAME_MESSAGE_BUF_SIZE (f) + 1);
+ f->decode_mode_spec_buffer = xrealloc (f->decode_mode_spec_buffer,
+ FRAME_MESSAGE_BUF_SIZE (f) + 1);
}
{
/* Block interrupt input so that we don't get surprised by an X
event while we're in an inconsistent state. */
- BLOCK_INPUT;
+ block_input ();
f->glyphs_initialized_p = 0;
/* Release window sub-matrices. */
free_glyph_matrix (w->desired_matrix);
free_glyph_matrix (w->current_matrix);
w->desired_matrix = w->current_matrix = NULL;
- f->menu_bar_window = Qnil;
+ fset_menu_bar_window (f, Qnil);
}
/* Free the tool bar window and its glyph matrices. */
free_glyph_matrix (w->desired_matrix);
free_glyph_matrix (w->current_matrix);
w->desired_matrix = w->current_matrix = NULL;
- f->tool_bar_window = Qnil;
+ fset_tool_bar_window (f, Qnil);
}
/* Release frame glyph matrices. Reset fields to zero in
f->desired_pool = f->current_pool = NULL;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
/* Check that nothing is left allocated. */
if (glyph_matrix_count)
- abort ();
+ emacs_abort ();
if (glyph_pool_count)
- abort ();
+ emacs_abort ();
}
int i;
/* F must have a frame matrix when this function is called. */
- xassert (!FRAME_WINDOW_P (f));
+ eassert (!FRAME_WINDOW_P (f));
/* Clear all rows in the frame matrix covered by window matrices.
Menu bar lines are not covered by windows. */
desired frame matrix built. W is a leaf window whose desired or
current matrix is to be added to FRAME_MATRIX. W's flag
must_be_updated_p determines which matrix it contributes to
- FRAME_MATRIX. If must_be_updated_p is non-zero, W's desired matrix
+ FRAME_MATRIX. If W->must_be_updated_p, W's desired matrix
is added to FRAME_MATRIX, otherwise W's current matrix is added.
Adding a desired matrix means setting up used counters and such in
frame rows, while adding a current window matrix to FRAME_MATRIX
SET_GLYPH_FROM_CHAR (right_border_glyph, '|');
if (dp
- && (gc = DISP_BORDER_GLYPH (dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
+ && (gc = DISP_BORDER_GLYPH (dp), GLYPH_CODE_P (gc)))
{
SET_GLYPH_FROM_GLYPH_CODE (right_border_glyph, gc);
spec_glyph_lookup_face (w, &right_border_glyph);
{
struct glyph_row *frame_row = frame_matrix->rows + frame_y;
struct glyph_row *window_row = window_matrix->rows + window_y;
- int current_row_p = window_matrix == w->current_matrix;
+ bool current_row_p = window_matrix == w->current_matrix;
/* Fill up the frame row with spaces up to the left margin of the
window row. */
}
else
{
- xassert (window_row->enabled_p);
+ eassert (window_row->enabled_p);
/* Only when a desired row has been displayed, we want
the corresponding frame row to be updated. */
SET_CHAR_GLYPH_FROM_GLYPH (*border, right_border_glyph);
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Window row window_y must be a slice of frame row
frame_y. */
- xassert (glyph_row_slice_p (window_row, frame_row));
+ eassert (glyph_row_slice_p (window_row, frame_row));
/* If rows are in sync, we don't have to copy glyphs because
frame and window share glyphs. */
{
struct glyph_row *current_row = MATRIX_ROW (current_matrix, row);
struct glyph_row *desired_row = MATRIX_ROW (desired_matrix, row);
- int mouse_face_p = current_row->mouse_face_p;
+ bool mouse_face_p = current_row->mouse_face_p;
/* Do current_row = desired_row. This exchanges glyph pointers
between both rows, and does a structure assignment otherwise. */
int i;
/* Make a copy of the original rows. */
- old_rows = (struct glyph_row *) alloca (nlines * sizeof *old_rows);
+ old_rows = alloca (nlines * sizeof *old_rows);
memcpy (old_rows, new_rows, nlines * sizeof *old_rows);
/* Assign new rows, maybe clear lines. */
for (i = 0; i < nlines; ++i)
{
- int enabled_before_p = new_rows[i].enabled_p;
+ bool enabled_before_p = new_rows[i].enabled_p;
- xassert (i + unchanged_at_top < matrix->nrows);
- xassert (unchanged_at_top + copy_from[i] < matrix->nrows);
+ eassert (i + unchanged_at_top < matrix->nrows);
+ eassert (unchanged_at_top + copy_from[i] < matrix->nrows);
new_rows[i] = old_rows[copy_from[i]];
new_rows[i].enabled_p = enabled_before_p;
int left, right, x, width;
/* Preconditions: W must be a leaf window on a tty frame. */
- xassert (NILP (w->hchild) && NILP (w->vchild));
- xassert (!FRAME_WINDOW_P (f));
+ eassert (NILP (w->hchild) && NILP (w->vchild));
+ eassert (!FRAME_WINDOW_P (f));
left = margin_glyphs_to_reserve (w, 1, w->left_margin_cols);
right = margin_glyphs_to_reserve (w, 1, w->right_margin_cols);
/* W is a leaf window, and we are working on its current
matrix m. */
struct glyph_matrix *m = w->current_matrix;
- int i, sync_p = 0;
+ int i;
+ bool sync_p = 0;
struct glyph_row *old_rows;
/* Make a copy of the original rows of matrix m. */
- old_rows = (struct glyph_row *) alloca (m->nrows * sizeof *old_rows);
+ old_rows = alloca (m->nrows * sizeof *old_rows);
memcpy (old_rows, m->rows, m->nrows * sizeof *old_rows);
for (i = 0; i < nlines; ++i)
int window_from = frame_from - m->matrix_y;
/* Is assigned line inside window? */
- int from_inside_window_p
+ bool from_inside_window_p
= window_from >= 0 && window_from < m->matrix_h;
/* Is assigned to line inside window? */
- int to_inside_window_p
+ bool to_inside_window_p
= window_to >= 0 && window_to < m->matrix_h;
if (from_inside_window_p && to_inside_window_p)
{
- /* Enabled setting before assignment. */
- int enabled_before_p;
-
/* Do the assignment. The enabled_p flag is saved
over the assignment because the old redisplay did
that. */
- enabled_before_p = m->rows[window_to].enabled_p;
+ bool enabled_before_p = m->rows[window_to].enabled_p;
m->rows[window_to] = old_rows[window_from];
m->rows[window_to].enabled_p = enabled_before_p;
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that window and frame matrices agree about their
understanding where glyphs of the rows are to find. For each
{
if (!glyph_row_slice_p (window_matrix->rows + i,
frame_matrix->rows + j))
- abort ();
+ emacs_abort ();
++i, ++j;
}
}
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
\f
VPOS and HPOS translations
**********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Translate vertical position VPOS which is relative to window W to a
vertical position relative to W's frame. */
static int
window_to_frame_vpos (struct window *w, int vpos)
{
- xassert (!FRAME_WINDOW_P (XFRAME (w->frame)));
- xassert (vpos >= 0 && vpos <= w->desired_matrix->nrows);
+ eassert (!FRAME_WINDOW_P (XFRAME (w->frame)));
+ eassert (vpos >= 0 && vpos <= w->desired_matrix->nrows);
vpos += WINDOW_TOP_EDGE_LINE (w);
- xassert (vpos >= 0 && vpos <= FRAME_LINES (XFRAME (w->frame)));
+ eassert (vpos >= 0 && vpos <= FRAME_LINES (XFRAME (w->frame)));
return vpos;
}
static int
window_to_frame_hpos (struct window *w, int hpos)
{
- xassert (!FRAME_WINDOW_P (XFRAME (w->frame)));
+ eassert (!FRAME_WINDOW_P (XFRAME (w->frame)));
hpos += WINDOW_LEFT_EDGE_COL (w);
return hpos;
}
/* Update frame F based on the data in desired matrices.
- If FORCE_P is non-zero, don't let redisplay be stopped by detecting
- pending input. If INHIBIT_HAIRY_ID_P is non-zero, don't try
- scrolling.
+ If FORCE_P, don't let redisplay be stopped by detecting pending input.
+ If INHIBIT_HAIRY_ID_P, don't try scrolling.
- Value is non-zero if redisplay was stopped due to pending input. */
+ Value is true if redisplay was stopped due to pending input. */
-int
-update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p)
+bool
+update_frame (struct frame *f, bool force_p, bool inhibit_hairy_id_p)
{
- /* 1 means display has been paused because of pending input. */
- int paused_p;
+ /* True means display has been paused because of pending input. */
+ bool paused_p;
struct window *root_window = XWINDOW (f->root_window);
if (redisplay_dont_pause)
force_p = 1;
-#if PERIODIC_PREEMPTION_CHECKING
else if (NILP (Vredisplay_preemption_period))
force_p = 1;
else if (!force_p && NUMBERP (Vredisplay_preemption_period))
{
- EMACS_TIME tm;
double p = XFLOATINT (Vredisplay_preemption_period);
- int sec, usec;
if (detect_input_pending_ignore_squeezables ())
{
goto do_pause;
}
- sec = (int) p;
- usec = (p - sec) * 1000000;
-
- EMACS_GET_TIME (tm);
- EMACS_SET_SECS_USECS (preemption_period, sec, usec);
- EMACS_ADD_TIME (preemption_next_check, tm, preemption_period);
+ preemption_period = EMACS_TIME_FROM_DOUBLE (p);
+ preemption_next_check = add_emacs_time (current_emacs_time (),
+ preemption_period);
}
-#endif
if (FRAME_WINDOW_P (f))
{
/* Swap tool-bar strings. We swap because we want to
reuse strings. */
tem = f->current_tool_bar_string;
- f->current_tool_bar_string = f->desired_tool_bar_string;
- f->desired_tool_bar_string = tem;
+ fset_current_tool_bar_string (f, f->desired_tool_bar_string);
+ fset_desired_tool_bar_string (f, tem);
}
}
}
/* Check window matrices for lost pointers. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
check_window_matrix_pointers (root_window);
add_frame_display_history (f, paused_p);
#endif
}
-#if PERIODIC_PREEMPTION_CHECKING
do_pause:
-#endif
/* Reset flags indicating that a window should be updated. */
set_window_update_flags (root_window, 0);
Window-based updates
************************************************************************/
-/* Perform updates in window tree rooted at W. FORCE_P non-zero means
- don't stop updating when input is pending. */
+/* Perform updates in window tree rooted at W.
+ If FORCE_P, don't stop updating if input is pending. */
-static int
-update_window_tree (struct window *w, int force_p)
+static bool
+update_window_tree (struct window *w, bool force_p)
{
- int paused_p = 0;
+ bool paused_p = 0;
while (w && !paused_p)
{
}
-/* Update window W if its flag must_be_updated_p is non-zero. If
- FORCE_P is non-zero, don't stop updating if input is pending. */
+/* Update window W if its flag must_be_updated_p is set.
+ If FORCE_P, don't stop updating if input is pending. */
void
-update_single_window (struct window *w, int force_p)
+update_single_window (struct window *w, bool force_p)
{
if (w->must_be_updated_p)
{
if (redisplay_dont_pause)
force_p = 1;
-#if PERIODIC_PREEMPTION_CHECKING
else if (NILP (Vredisplay_preemption_period))
force_p = 1;
else if (!force_p && NUMBERP (Vredisplay_preemption_period))
{
- EMACS_TIME tm;
double p = XFLOATINT (Vredisplay_preemption_period);
- int sec, usec;
-
- sec = (int) p;
- usec = (p - sec) * 1000000;
-
- EMACS_GET_TIME (tm);
- EMACS_SET_SECS_USECS (preemption_period, sec, usec);
- EMACS_ADD_TIME (preemption_next_check, tm, preemption_period);
+ preemption_period = EMACS_TIME_FROM_DOUBLE (p);
+ preemption_next_check = add_emacs_time (current_emacs_time (),
+ preemption_period);
}
-#endif
/* Update W. */
update_begin (f);
static void
check_current_matrix_flags (struct window *w)
{
- int last_seen_p = 0;
+ bool last_seen_p = 0;
int i, yb = window_text_bottom_y (w);
for (i = 0; i < w->current_matrix->nrows - 1; ++i)
if (!last_seen_p && MATRIX_ROW_BOTTOM_Y (row) >= yb)
last_seen_p = 1;
else if (last_seen_p && row->enabled_p)
- abort ();
+ emacs_abort ();
}
}
#endif /* GLYPH_DEBUG */
-/* Update display of window W. FORCE_P non-zero means that we should
- not stop when detecting pending input. */
+/* Update display of window W.
+ If FORCE_P, don't stop updating when input is pending. */
-static int
-update_window (struct window *w, int force_p)
+static bool
+update_window (struct window *w, bool force_p)
{
struct glyph_matrix *desired_matrix = w->desired_matrix;
- int paused_p;
+ bool paused_p;
#if !PERIODIC_PREEMPTION_CHECKING
int preempt_count = baud_rate / 2400 + 1;
#endif
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that W's frame doesn't have glyph matrices. */
- xassert (FRAME_WINDOW_P (XFRAME (WINDOW_FRAME (w))));
+ eassert (FRAME_WINDOW_P (XFRAME (WINDOW_FRAME (w))));
#endif
/* Check pending input the first time so that we can quickly return. */
struct glyph_row *row, *end;
struct glyph_row *mode_line_row;
struct glyph_row *header_line_row;
- int yb, changed_p = 0, mouse_face_overwritten_p = 0;
+ int yb;
+ bool changed_p = 0, mouse_face_overwritten_p = 0;
#if ! PERIODIC_PREEMPTION_CHECKING
int n_updated = 0;
#endif
#if PERIODIC_PREEMPTION_CHECKING
if (!force_p)
{
- EMACS_TIME tm, dif;
- EMACS_GET_TIME (tm);
- EMACS_SUB_TIME (dif, preemption_next_check, tm);
- if (EMACS_TIME_NEG_P (dif))
+ EMACS_TIME tm = current_emacs_time ();
+ if (EMACS_TIME_LT (preemption_next_check, tm))
{
- EMACS_ADD_TIME (preemption_next_check, tm, preemption_period);
+ preemption_next_check = add_emacs_time (tm,
+ preemption_period);
if (detect_input_pending_ignore_squeezables ())
break;
}
#endif
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Remember the redisplay method used to display the matrix. */
strcpy (w->current_matrix->method, w->desired_matrix->method);
#endif
else
paused_p = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* check_current_matrix_flags (w); */
add_window_display_history (w, w->current_matrix->method, paused_p);
#endif
/* Update the display of the text area of row VPOS in window W.
- Value is non-zero if display has changed. */
+ Value is true if display has changed. */
-static int
+static bool
update_text_area (struct window *w, int vpos)
{
struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos);
struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos);
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
- int changed_p = 0;
+ bool changed_p = 0;
/* Let functions in xterm.c know what area subsequent X positions
will be relative to. */
int stop, i, x;
struct glyph *current_glyph = current_row->glyphs[TEXT_AREA];
struct glyph *desired_glyph = desired_row->glyphs[TEXT_AREA];
- int overlapping_glyphs_p = current_row->contains_overlapping_glyphs_p;
+ bool overlapping_glyphs_p = current_row->contains_overlapping_glyphs_p;
int desired_stop_pos = desired_row->used[TEXT_AREA];
- int abort_skipping = 0;
+ bool abort_skipping = 0;
/* If the desired row extends its face to the text area end, and
unless the current row also does so at the same position,
in common. */
while (i < stop)
{
- int can_skip_p = !abort_skipping;
+ bool can_skip_p = !abort_skipping;
/* Skip over glyphs that both rows have in common. These
don't have to be written. We can't skip if the last
{
int left, right;
- rif->get_glyph_overhangs (current_glyph, XFRAME (w->frame),
+ rif->get_glyph_overhangs (current_glyph,
+ XFRAME (w->frame),
&left, &right);
while (left > 0 && i > 0)
{
int start_x = x, start_hpos = i;
struct glyph *start = desired_glyph;
int current_x = x;
- int skip_first_p = !can_skip_p;
+ bool skip_first_p = !can_skip_p;
/* Find the next glyph that's equal again. */
while (i < stop
has to be cleared, if and only if we did a write_glyphs
above. This is made sure by setting desired_stop_pos
appropriately above. */
- xassert (i < desired_row->used[TEXT_AREA]
+ eassert (i < desired_row->used[TEXT_AREA]
|| ((desired_row->used[TEXT_AREA]
== current_row->used[TEXT_AREA])
&& MATRIX_ROW_EXTENDS_FACE_P (current_row)));
}
-/* Update row VPOS in window W. Value is non-zero if display has been
- changed. */
+/* Update row VPOS in window W. Value is true if display has been changed. */
-static int
-update_window_line (struct window *w, int vpos, int *mouse_face_overwritten_p)
+static bool
+update_window_line (struct window *w, int vpos, bool *mouse_face_overwritten_p)
{
struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos);
struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos);
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
- int changed_p = 0;
+ bool changed_p = 0;
/* Set the row being updated. This is important to let xterm.c
know what line height values are in effect. */
if (desired_row->mode_line_p
|| desired_row->visible_height > 0)
{
- xassert (desired_row->enabled_p);
+ eassert (desired_row->enabled_p);
/* Update display of the left margin area, if there is one. */
if (!desired_row->full_width_p
{
changed_p = 1;
update_marginal_area (w, LEFT_MARGIN_AREA, vpos);
+ /* Setting this flag will ensure the vertical border, if
+ any, between this window and the one on its left will be
+ redrawn. This is necessary because updating the left
+ margin area can potentially draw over the border. */
+ current_row->redraw_fringe_bitmaps_p = 1;
}
/* Update the display of the text area. */
int cx, cy, vpos, hpos;
/* Not intended for frame matrix updates. */
- xassert (FRAME_WINDOW_P (f));
+ eassert (FRAME_WINDOW_P (f));
if (cursor_in_echo_area
&& !NILP (echo_area_buffer[0])
tree rooted at W. */
void
-set_window_update_flags (struct window *w, int on_p)
+set_window_update_flags (struct window *w, bool on_p)
{
while (w)
{
ptrdiff_t i = row->hash % row_table_size;
entry = row_table[i];
- xassert (entry || verify_row_hash (row));
+ eassert (entry || verify_row_hash (row));
while (entry && !row_equal_p (entry->row, row, 1))
entry = entry->next;
/* Try to reuse part of the current display of W by scrolling lines.
- HEADER_LINE_P non-zero means W has a header line.
+ HEADER_LINE_P means W has a header line.
The algorithm is taken from Communications of the ACM, Apr78 "A
Technique for Isolating Differences Between Files." It should take
1 if we did scroll. */
static int
-scrolling_window (struct window *w, int header_line_p)
+scrolling_window (struct window *w, bool header_line_p)
{
struct glyph_matrix *desired_matrix = w->desired_matrix;
struct glyph_matrix *current_matrix = w->current_matrix;
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
/* Skip over rows equal at the start. */
- for (i = header_line_p ? 1 : 0; i < current_matrix->nrows - 1; ++i)
+ for (i = header_line_p; i < current_matrix->nrows - 1; ++i)
{
struct glyph_row *d = MATRIX_ROW (desired_matrix, i);
struct glyph_row *c = MATRIX_ROW (current_matrix, i);
for (i = first_new; i < last_new; ++i)
{
- xassert (MATRIX_ROW_ENABLED_P (desired_matrix, i));
+ eassert (MATRIX_ROW_ENABLED_P (desired_matrix, i));
entry = add_row_entry (MATRIX_ROW (desired_matrix, i));
++entry->new_uses;
entry->new_line_number = i;
for (j = nruns - 1; j > i; --j)
{
struct run *p = runs[j];
- int truncated_p = 0;
+ bool truncated_p = 0;
if (p->nrows > 0
&& p->desired_y < r->desired_y + r->height
for (j = 0; j < r->nrows; ++j)
{
struct glyph_row *from, *to;
- int to_overlapped_p;
+ bool to_overlapped_p;
to = MATRIX_ROW (current_matrix, r->desired_vpos + j);
from = MATRIX_ROW (desired_matrix, r->desired_vpos + j);
row. But thanks to the truncation code in the
preceding for-loop, we no longer have such an overlap,
and thus the assigned row should always be enabled. */
- xassert (to->enabled_p);
+ eassert (to->enabled_p);
from->enabled_p = 0;
to->overlapped_p = to_overlapped_p;
}
/* Update the desired frame matrix of frame F.
- FORCE_P non-zero means that the update should not be stopped by
- pending input. INHIBIT_HAIRY_ID_P non-zero means that scrolling
- should not be tried.
+ FORCE_P means that the update should not be stopped by pending input.
+ INHIBIT_HAIRY_ID_P means that scrolling should not be tried.
- Value is non-zero if update was stopped due to pending input. */
+ Value is true if update was stopped due to pending input. */
-static int
-update_frame_1 (struct frame *f, int force_p, int inhibit_id_p)
+static bool
+update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p)
{
/* Frame matrices to work on. */
struct glyph_matrix *current_matrix = f->current_matrix;
struct glyph_matrix *desired_matrix = f->desired_matrix;
int i;
- int pause_p;
+ bool pause_p;
int preempt_count = baud_rate / 2400 + 1;
- xassert (current_matrix && desired_matrix);
+ eassert (current_matrix && desired_matrix);
if (baud_rate != FRAME_COST_BAUD_RATE (f))
calculate_costs (f);
#if PERIODIC_PREEMPTION_CHECKING
if (!force_p)
{
- EMACS_TIME tm, dif;
- EMACS_GET_TIME (tm);
- EMACS_SUB_TIME (dif, preemption_next_check, tm);
- if (EMACS_TIME_NEG_P (dif))
+ EMACS_TIME tm = current_emacs_time ();
+ if (EMACS_TIME_LT (preemption_next_check, tm))
{
- EMACS_ADD_TIME (preemption_next_check, tm, preemption_period);
+ preemption_next_check = add_emacs_time (tm, preemption_period);
if (detect_input_pending_ignore_squeezables ())
break;
}
}
}
- pause_p = (i < FRAME_LINES (f) - 1) ? i : 0;
+ lint_assume (0 <= FRAME_LINES (f));
+ pause_p = 0 < i && i < FRAME_LINES (f) - 1;
/* Now just clean up termcap drivers and set cursor, etc. */
if (!pause_p)
/* Do line insertions/deletions on frame F for frame-based redisplay. */
-static int
+static bool
scrolling (struct frame *frame)
{
int unchanged_at_top, unchanged_at_bottom;
int window_size;
int changed_lines;
- int *old_hash = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
- int *new_hash = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
- int *draw_cost = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
- int *old_draw_cost = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
+ int *old_hash = alloca (FRAME_LINES (frame) * sizeof (int));
+ int *new_hash = alloca (FRAME_LINES (frame) * sizeof (int));
+ int *draw_cost = alloca (FRAME_LINES (frame) * sizeof (int));
+ int *old_draw_cost = alloca (FRAME_LINES (frame) * sizeof (int));
register int i;
int free_at_end_vpos = FRAME_LINES (frame);
struct glyph_matrix *current_matrix = frame->current_matrix;
struct glyph_matrix *desired_matrix = frame->desired_matrix;
if (!current_matrix)
- abort ();
+ emacs_abort ();
/* Compute hash codes of all the lines. Also calculate number of
changed lines, number of unchanged lines at the beginning, and
struct glyph_matrix *desired_matrix = f->desired_matrix;
struct glyph_row *current_row = MATRIX_ROW (current_matrix, vpos);
struct glyph_row *desired_row = MATRIX_ROW (desired_matrix, vpos);
- int must_write_whole_line_p;
- int write_spaces_p = FRAME_MUST_WRITE_SPACES (f);
- int colored_spaces_p = (FACE_FROM_ID (f, DEFAULT_FACE_ID)->background
- != FACE_TTY_DEFAULT_BG_COLOR);
+ bool must_write_whole_line_p;
+ bool write_spaces_p = FRAME_MUST_WRITE_SPACES (f);
+ bool colored_spaces_p = (FACE_FROM_ID (f, DEFAULT_FACE_ID)->background
+ != FACE_TTY_DEFAULT_BG_COLOR);
if (colored_spaces_p)
write_spaces_p = 1;
/* start_display takes into account the header-line row, but IT's
vpos still counts from the glyph row that includes the window's
start position. Adjust for a possible header-line row. */
- it.vpos += WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0;
+ it.vpos += WINDOW_WANTS_HEADER_LINE_P (w);
x0 = *x;
Lisp_Object
mode_line_string (struct window *w, enum window_part part,
- int *x, int *y, EMACS_INT *charpos, Lisp_Object *object,
+ int *x, int *y, ptrdiff_t *charpos, Lisp_Object *object,
int *dx, int *dy, int *width, int *height)
{
struct glyph_row *row;
Lisp_Object
marginal_area_string (struct window *w, enum window_part part,
- int *x, int *y, EMACS_INT *charpos, Lisp_Object *object,
+ int *x, int *y, ptrdiff_t *charpos, Lisp_Object *object,
int *dx, int *dy, int *width, int *height)
{
struct glyph_row *row = w->current_matrix->rows;
else if (part == ON_RIGHT_MARGIN)
area = RIGHT_MARGIN_AREA;
else
- abort ();
+ emacs_abort ();
for (i = 0; row->enabled_p && i < w->current_matrix->nrows; ++i, ++row)
if (wy >= row->y && wy < MATRIX_ROW_BOTTOM_Y (row))
#ifdef SIGWINCH
+static void deliver_window_change_signal (int);
+
static void
-window_change_signal (int signalnum) /* If we don't have an argument, */
- /* some compilers complain in signal calls. */
+handle_window_change_signal (int sig)
{
int width, height;
- int old_errno = errno;
-
struct tty_display_info *tty;
- signal (SIGWINCH, window_change_signal);
- SIGNAL_THREAD_CHECK (signalnum);
-
/* The frame size change obviously applies to a single
termcap-controlled terminal, but we can't decide which.
Therefore, we resize the frames corresponding to each tty.
change_frame_size (XFRAME (frame), height, width, 0, 1, 0);
}
}
+}
- errno = old_errno;
+static void
+deliver_window_change_signal (int sig)
+{
+ deliver_process_signal (sig, handle_window_change_signal);
}
#endif /* SIGWINCH */
-/* Do any change in frame size that was requested by a signal. SAFE
- non-zero means this function is called from a place where it is
- safe to change frame sizes while a redisplay is in progress. */
+/* Do any change in frame size that was requested by a signal.
+ SAFE means this function is called from a place where it is
+ safe to change frame sizes while a redisplay is in progress. */
void
-do_pending_window_change (int safe)
+do_pending_window_change (bool safe)
{
- /* If window_change_signal should have run before, run it now. */
+ /* If window change signal handler should have run before, run it now. */
if (redisplaying_p && !safe)
return;
/* Change the frame height and/or width. Values may be given as zero to
indicate no change is to take place.
- If DELAY is non-zero, then assume we're being called from a signal
- handler, and queue the change for later - perhaps the next
- redisplay. Since this tries to resize windows, we can't call it
+ If DELAY, assume we're being called from a signal handler, and
+ queue the change for later - perhaps the next redisplay.
+ Since this tries to resize windows, we can't call it
from a signal handler.
- SAFE non-zero means this function is called from a place where it's
+ SAFE means this function is called from a place where it's
safe to change frame sizes while a redisplay is in progress. */
void
-change_frame_size (register struct frame *f, int newheight, int newwidth, int pretend, int delay, int safe)
+change_frame_size (struct frame *f, int newheight, int newwidth,
+ bool pretend, bool delay, bool safe)
{
Lisp_Object tail, frame;
}
static void
-change_frame_size_1 (register struct frame *f, int newheight, int newwidth, int pretend, int delay, int safe)
+change_frame_size_1 (struct frame *f, int newheight, int newwidth,
+ bool pretend, bool delay, bool safe)
{
int new_frame_total_cols;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* If we can't deal with the change now, queue it for later. */
if (delay || (redisplaying_p && !safe))
&& new_frame_total_cols == FRAME_TOTAL_COLS (f))
return;
- BLOCK_INPUT;
+ block_input ();
#ifdef MSDOS
/* We only can set screen dimensions to certain values supported
FrameCols (FRAME_TTY (f)) = newwidth;
if (WINDOWP (f->tool_bar_window))
- XSETFASTINT (XWINDOW (f->tool_bar_window)->total_cols, newwidth);
+ wset_total_cols (XWINDOW (f->tool_bar_window), make_number (newwidth));
}
FRAME_LINES (f) = newheight;
SET_FRAME_GARBAGED (f);
f->resized_p = 1;
- UNBLOCK_INPUT;
+ unblock_input ();
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
run_window_configuration_change_hook (f);
if (tty->termscript != 0)
{
- BLOCK_INPUT;
+ block_input ();
fclose (tty->termscript);
- UNBLOCK_INPUT;
+ unblock_input ();
}
tty->termscript = 0;
/* ??? Perhaps we should do something special for multibyte strings here. */
CHECK_STRING (string);
- BLOCK_INPUT;
+ block_input ();
if (!t)
error ("Unknown terminal device");
}
fwrite (SDATA (string), 1, SBYTES (string), out);
fflush (out);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
doc: /* Pause, without updating display, for SECONDS seconds.
SECONDS may be a floating-point value, meaning that you can wait for a
fraction of a second. Optional second arg MILLISECONDS specifies an
-additional wait period, in milliseconds; this may be useful if your
-Emacs was built without floating point support.
+additional wait period, in milliseconds; this is for backwards compatibility.
\(Not all operating systems support waiting for a fraction of a second.) */)
(Lisp_Object seconds, Lisp_Object milliseconds)
{
- int sec, usec;
+ double duration = extract_float (seconds);
- if (NILP (milliseconds))
- XSETINT (milliseconds, 0);
- else
- CHECK_NUMBER (milliseconds);
- usec = XINT (milliseconds) * 1000;
-
- {
- double duration = extract_float (seconds);
- sec = (int) duration;
- usec += (duration - sec) * 1000000;
- }
-
-#ifndef EMACS_HAS_USECS
- if (sec == 0 && usec != 0)
- error ("Millisecond `sleep-for' not supported on %s", SYSTEM_TYPE);
-#endif
-
- /* Assure that 0 <= usec < 1000000. */
- if (usec < 0)
+ if (!NILP (milliseconds))
{
- /* We can't rely on the rounding being correct if usec is negative. */
- if (-1000000 < usec)
- sec--, usec += 1000000;
- else
- sec -= -usec / 1000000, usec = 1000000 - (-usec % 1000000);
+ CHECK_NUMBER (milliseconds);
+ duration += XINT (milliseconds) / 1000.0;
}
- else
- sec += usec / 1000000, usec %= 1000000;
-
- if (sec < 0 || (sec == 0 && usec == 0))
- return Qnil;
- wait_reading_process_output (sec, usec, 0, 0, Qnil, NULL, 0);
+ if (0 < duration)
+ {
+ EMACS_TIME t = EMACS_TIME_FROM_DOUBLE (duration);
+ wait_reading_process_output (min (EMACS_SECS (t), WAIT_READING_MAX),
+ EMACS_NSECS (t), 0, 0, Qnil, NULL, 0);
+ }
return Qnil;
}
TIMEOUT is number of seconds to wait (float or integer),
or t to wait forever.
- READING is 1 if reading input.
+ READING is true if reading input.
If DO_DISPLAY is >0 display process output while waiting.
If DO_DISPLAY is >1 perform an initial redisplay before waiting.
*/
Lisp_Object
-sit_for (Lisp_Object timeout, int reading, int do_display)
+sit_for (Lisp_Object timeout, bool reading, int do_display)
{
- int sec, usec;
+ intmax_t sec;
+ int nsec;
swallow_events (do_display);
if (INTEGERP (timeout))
{
sec = XINT (timeout);
- usec = 0;
+ if (! (0 < sec))
+ return Qt;
+ nsec = 0;
}
else if (FLOATP (timeout))
{
double seconds = XFLOAT_DATA (timeout);
- sec = (int) seconds;
- usec = (int) ((seconds - sec) * 1000000);
+ if (! (0 < seconds))
+ return Qt;
+ else
+ {
+ EMACS_TIME t = EMACS_TIME_FROM_DOUBLE (seconds);
+ sec = min (EMACS_SECS (t), WAIT_READING_MAX);
+ nsec = EMACS_NSECS (t);
+ }
}
else if (EQ (timeout, Qt))
{
sec = 0;
- usec = 0;
+ nsec = 0;
}
else
wrong_type_argument (Qnumberp, timeout);
- if (sec == 0 && usec == 0 && !EQ (timeout, Qt))
- return Qt;
-#ifdef SIGIO
- gobble_input (0);
+#ifdef USABLE_SIGIO
+ gobble_input ();
#endif
- wait_reading_process_output (sec, usec, reading ? -1 : 1, do_display,
+ wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display,
Qnil, NULL, 0);
return detect_input_pending () ? Qnil : Qt;
immediately by pending input. */)
(Lisp_Object force)
{
- int count;
+ ptrdiff_t count;
swallow_events (1);
if ((detect_input_pending_run_timers (1)
(Lisp_Object variable)
{
Lisp_Object state, tail, frame, buf;
- Lisp_Object *vecp, *end;
- int n;
+ ptrdiff_t n, idx;
if (! NILP (variable))
{
else
state = frame_and_buffer_state;
- vecp = XVECTOR (state)->contents;
- end = vecp + ASIZE (state);
-
+ idx = 0;
FOR_EACH_FRAME (tail, frame)
{
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, frame))
+ if (!EQ (AREF (state, idx++), frame))
goto changed;
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, XFRAME (frame)->name))
+ if (!EQ (AREF (state, idx++), XFRAME (frame)->name))
goto changed;
}
/* Check that the buffer info matches. */
/* Ignore buffers that aren't included in buffer lists. */
if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ')
continue;
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, buf))
+ if (!EQ (AREF (state, idx++), buf))
goto changed;
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, BVAR (XBUFFER (buf), read_only)))
+ if (!EQ (AREF (state, idx++), BVAR (XBUFFER (buf), read_only)))
goto changed;
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
- if (!EQ (*vecp++, Fbuffer_modified_p (buf)))
+ if (!EQ (AREF (state, idx++), Fbuffer_modified_p (buf)))
goto changed;
}
- if (vecp == end)
+ if (idx == ASIZE (state))
goto changed;
/* Detect deletion of a buffer at the end of the list. */
- if (EQ (*vecp, Qlambda))
+ if (EQ (AREF (state, idx), Qlambda))
return Qnil;
/* Come here if we decide the data has changed. */
}
/* Record the new data in the (possibly reallocated) vector. */
- vecp = XVECTOR (state)->contents;
+ idx = 0;
FOR_EACH_FRAME (tail, frame)
{
- *vecp++ = frame;
- *vecp++ = XFRAME (frame)->name;
+ ASET (state, idx, frame);
+ idx++;
+ ASET (state, idx, XFRAME (frame)->name);
+ idx++;
}
for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
{
/* Ignore buffers that aren't included in buffer lists. */
if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ')
continue;
- *vecp++ = buf;
- *vecp++ = BVAR (XBUFFER (buf), read_only);
- *vecp++ = Fbuffer_modified_p (buf);
+ ASET (state, idx, buf);
+ idx++;
+ ASET (state, idx, BVAR (XBUFFER (buf), read_only));
+ idx++;
+ ASET (state, idx, Fbuffer_modified_p (buf));
+ idx++;
}
/* Fill up the vector with lambdas (always at least one). */
- *vecp++ = Qlambda;
- while (vecp - XVECTOR (state)->contents
- < ASIZE (state))
- *vecp++ = Qlambda;
+ ASET (state, idx, Qlambda);
+ idx++;
+ while (idx < ASIZE (state))
+ {
+ ASET (state, idx, Qlambda);
+ idx++;
+ }
/* Make sure we didn't overflow the vector. */
- if (vecp - XVECTOR (state)->contents
- > ASIZE (state))
- abort ();
+ eassert (idx <= ASIZE (state));
return Qt;
}
#ifndef CANNOT_DUMP
if (initialized)
#endif /* CANNOT_DUMP */
- signal (SIGWINCH, window_change_signal);
+ {
+ struct sigaction action;
+ emacs_sigaction_init (&action, deliver_window_change_signal);
+ sigaction (SIGWINCH, &action, 0);
+ }
#endif /* SIGWINCH */
/* If running as a daemon, no need to initialize any frames/terminal. */
#ifdef HAVE_X11
Vwindow_system_version = make_number (11);
#endif
-#if defined (GNU_LINUX) && defined (HAVE_LIBNCURSES)
+#ifdef GNU_LINUX
/* In some versions of ncurses,
tputs crashes if we have not called tgetent.
So call tgetent. */
/* Convert the initial frame to use the new display. */
if (f->output_method != output_initial)
- abort ();
+ emacs_abort ();
f->output_method = t->type;
f->terminal = t;
defsubr (&Sinternal_show_cursor_p);
defsubr (&Slast_nonminibuf_frame);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
defsubr (&Sdump_redisplay_history);
#endif
/* Record indices of function doc strings stored in a file.
- Copyright (C) 1985-1986, 1993-1995, 1997-2012
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1986, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <sys/types.h>
#include <sys/file.h> /* Must be after sys/types.h for USG*/
-#include <ctype.h>
-#include <setjmp.h>
#include <fcntl.h>
#include <unistd.h>
+#include <c-ctype.h>
+
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "keyboard.h"
-#include "character.h"
#include "keymap.h"
#include "buildobj.h"
Lisp_Object Qfunction_documentation;
-extern Lisp_Object Qclosure;
/* Buffer used for reading from documentation file. */
static char *get_doc_string_buffer;
static ptrdiff_t get_doc_string_buffer_size;
static unsigned char *read_bytecode_pointer;
-static Lisp_Object Fdocumentation_property (Lisp_Object, Lisp_Object,
- Lisp_Object);
-static Lisp_Object Fsnarf_documentation (Lisp_Object);
/* readchar in lread.c calls back here to fetch the next byte.
If UNREADFLAG is 1, we unread a byte. */
int
-read_bytecode_char (int unreadflag)
+read_bytecode_char (bool unreadflag)
{
if (unreadflag)
{
(e.g. because the file has been modified and the location is stale),
return nil.
- If UNIBYTE is nonzero, always make a unibyte string.
+ If UNIBYTE, always make a unibyte string.
- If DEFINITION is nonzero, assume this is for reading
+ If DEFINITION, assume this is for reading
a dynamic function definition; convert the bytestring
and the constants vector with appropriate byte handling,
and return a cons cell. */
Lisp_Object
-get_doc_string (Lisp_Object filepos, int unibyte, int definition)
+get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
- char *from, *to;
- register int fd;
- register char *name;
- register char *p, *p1;
- EMACS_INT minsize;
- EMACS_INT offset, position;
+ char *from, *to, *name, *p, *p1;
+ int fd;
+ ptrdiff_t minsize;
+ int offset;
+ EMACS_INT position;
Lisp_Object file, tem;
+ USE_SAFE_ALLOCA;
if (INTEGERP (filepos))
{
/* sizeof ("../etc/") == 8 */
if (minsize < 8)
minsize = 8;
- name = (char *) alloca (minsize + SCHARS (file) + 8);
+ name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
strcpy (name, SSDATA (docdir));
strcat (name, SSDATA (file));
}
/* Make sure we read at least 1024 bytes before `position'
so we can check the leading text for consistency. */
offset = min (position, max (1024, position % (8 * 1024)));
- if (0 > lseek (fd, position - offset, 0))
+ if (TYPE_MAXIMUM (off_t) < position
+ || lseek (fd, position - offset, 0) < 0)
{
emacs_close (fd);
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
}
+ SAFE_FREE ();
+
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
else
{
/* The data determines whether the string is multibyte. */
- EMACS_INT nchars =
+ ptrdiff_t nchars =
multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
+ offset),
to - (get_doc_string_buffer + offset));
return get_doc_string (filepos, 0, 1);
}
-static int
+static bool
reread_doc_file (Lisp_Object file)
{
#if 0
Lisp_Object fun;
Lisp_Object funcar;
Lisp_Object doc;
- int try_reload = 1;
+ bool try_reload = 1;
documentation:
}
else if (CONSP (fun))
{
- funcar = Fcar (fun);
+ funcar = XCAR (fun);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, fun);
else if (EQ (funcar, Qkeymap))
aren't strings. */)
(Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
{
- int try_reload = 1;
+ bool try_reload = 1;
Lisp_Object tem;
documentation_property:
/* Scanning the DOC files and placing docstring offsets into functions. */
static void
-store_function_docstring (Lisp_Object obj, EMACS_INT offset)
-/* Use EMACS_INT because we get offset from pointer subtraction. */
+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). */
{
int fd;
char buf[1024 + 1];
- register EMACS_INT filled;
- register EMACS_INT pos;
- register char *p;
+ int filled;
+ EMACS_INT pos;
Lisp_Object sym;
- char *name;
- int skip_file = 0;
+ char *p, *name;
+ bool skip_file = 0;
CHECK_STRING (filename);
(0)
#endif /* CANNOT_DUMP */
{
- name = (char *) alloca (SCHARS (filename) + 14);
+ name = alloca (SCHARS (filename) + 14);
strcpy (name, "../etc/");
}
else
{
CHECK_STRING (Vdoc_directory);
- name = (char *) alloca (SCHARS (filename)
- + SCHARS (Vdoc_directory) + 1);
+ name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
strcpy (name, SSDATA (Vdoc_directory));
}
strcat (name, SSDATA (filename)); /*** Add this line ***/
for (beg = buildobj; *beg; beg = end)
{
- EMACS_INT len;
+ ptrdiff_t len;
- while (*beg && isspace (*beg)) ++beg;
+ while (*beg && c_isspace (*beg)) ++beg;
- for (end = beg; *end && ! isspace (*end); ++end)
+ for (end = beg; *end && ! c_isspace (*end); ++end)
if (*end == '/') beg = end+1; /* skip directory part */
len = end - beg;
if (end - p > 4 && end[-2] == '.'
&& (end[-1] == 'o' || end[-1] == 'c'))
{
- EMACS_INT len = end - p - 2;
+ ptrdiff_t len = end - p - 2;
char *fromfile = alloca (len + 1);
- strncpy (fromfile, &p[2], len);
+ memcpy (fromfile, &p[2], len);
fromfile[len] = 0;
if (fromfile[len-1] == 'c')
fromfile[len-1] = 'o';
/* Install file-position as variable-documentation property
and make it negative for a user-variable
(doc starts with a `*'). */
- Fput (sym, Qvariable_documentation,
- make_number ((pos + end + 1 - buf)
- * (end[1] == '*' ? -1 : 1)));
+ if (!NILP (Fboundp (sym)))
+ Fput (sym, Qvariable_documentation,
+ make_number ((pos + end + 1 - buf)
+ * (end[1] == '*' ? -1 : 1)));
}
/* Attach a docstring to a function? */
else if (p[1] == 'F')
- store_function_docstring (sym, pos + end + 1 - buf);
-
+ {
+ if (!NILP (Ffboundp (sym)))
+ store_function_docstring (sym, pos + end + 1 - buf);
+ }
else if (p[1] == 'S')
; /* Just a source file name boundary marker. Ignore it. */
(Lisp_Object string)
{
char *buf;
- int changed = 0;
- register unsigned char *strp;
- register char *bufp;
+ bool changed = 0;
+ unsigned char *strp;
+ char *bufp;
ptrdiff_t idx;
ptrdiff_t bsize;
Lisp_Object tem;
ptrdiff_t length, length_byte;
Lisp_Object name;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int multibyte;
+ bool multibyte;
ptrdiff_t nchars;
if (NILP (string))
keymap = Voverriding_local_map;
bsize = SBYTES (string);
- bufp = buf = (char *) xmalloc (bsize);
+ bufp = buf = xmalloc (bsize);
strp = SDATA (string);
while (strp < SDATA (string) + SBYTES (string))
else if (strp[0] == '\\' && strp[1] == '[')
{
ptrdiff_t start_idx;
- int follow_remap = 1;
+ bool follow_remap = 1;
changed = 1;
strp += 2; /* skip \[ */
ptrdiff_t offset = bufp - buf;
if (STRING_BYTES_BOUND - 4 < bsize)
string_overflow ();
- buf = (char *) xrealloc (buf, bsize += 4);
+ buf = xrealloc (buf, bsize += 4);
bufp = buf + offset;
memcpy (bufp, "M-x ", 4);
bufp += 4;
if (NILP (tem))
{
name = Fsymbol_name (name);
- insert_string ("\nUses keymap \"");
+ insert_string ("\nUses keymap `");
insert_from_string (name, 0, 0,
SCHARS (name),
SBYTES (name), 1);
- insert_string ("\", which is not currently defined.\n");
+ insert_string ("', which is not currently defined.\n");
if (start[-1] == '<') keymap = Qnil;
}
else if (start[-1] == '<')
ptrdiff_t offset = bufp - buf;
if (STRING_BYTES_BOUND - length_byte < bsize)
string_overflow ();
- buf = (char *) xrealloc (buf, bsize += length_byte);
+ buf = xrealloc (buf, bsize += length_byte);
bufp = buf + offset;
memcpy (bufp, start, length_byte);
bufp += length_byte;
#include <config.h>
#include <stdio.h>
-#include <ctype.h>
-#include <setjmp.h>
#include <float.h>
#include <unistd.h>
#include <limits.h>
another macro. */
#include "character.h"
-#ifndef DBL_MAX_10_EXP
-#define DBL_MAX_10_EXP 308 /* IEEE double */
-#endif
-
/* Generate output from a format-spec FORMAT,
terminated at position FORMAT_END.
(*FORMAT_END is not part of the format, but must exist and be readable.)
doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
const char *format_end, va_list ap)
{
- const char *fmt = format; /* Pointer into format string */
- register char *bufptr = buffer; /* Pointer into output buffer.. */
+ const char *fmt = format; /* Pointer into format string. */
+ char *bufptr = buffer; /* Pointer into output buffer. */
/* Use this for sprintf unless we need something really big. */
char tembuf[DBL_MAX_10_EXP + 100];
/* Buffer we have got with malloc. */
char *big_buffer = NULL;
- register size_t tem;
+ ptrdiff_t tem = -1;
char *string;
char fixed_buffer[20]; /* Default buffer for small formatting. */
char *fmtcpy;
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--;
if (*fmt == '%') /* Check for a '%' character */
{
ptrdiff_t size_bound = 0;
- EMACS_INT width; /* Columns occupied by STRING on display. */
+ ptrdiff_t width; /* Columns occupied by STRING on display. */
enum {
pDlen = sizeof pD - 1,
pIlen = sizeof pI - 1,
{
if (big_buffer)
xfree (big_buffer);
- big_buffer = (char *) xmalloc (size_bound);
+ big_buffer = xmalloc (size_bound);
sprintf_buffer = big_buffer;
size_allocated = size_bound;
}
case no_modifier:
{
int v = va_arg (ap, int);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case long_modifier:
{
long v = va_arg (ap, long);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pD_modifier:
signed_pD_modifier:
{
ptrdiff_t v = va_arg (ap, ptrdiff_t);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pI_modifier:
{
EMACS_INT v = va_arg (ap, EMACS_INT);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pM_modifier:
{
intmax_t v = va_arg (ap, intmax_t);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
}
case no_modifier:
{
unsigned v = va_arg (ap, unsigned);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case long_modifier:
{
unsigned long v = va_arg (ap, unsigned long);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pD_modifier:
case pI_modifier:
{
EMACS_UINT v = va_arg (ap, EMACS_UINT);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pM_modifier:
{
uintmax_t v = va_arg (ap, uintmax_t);
- sprintf (sprintf_buffer, fmtcpy, v);
+ tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
}
case 'g':
{
double d = va_arg (ap, double);
- sprintf (sprintf_buffer, fmtcpy, d);
+ tem = sprintf (sprintf_buffer, fmtcpy, d);
/* Now copy into final output, truncating as necessary. */
string = sprintf_buffer;
goto doit;
/* Copy string into final output, truncating if no room. */
doit:
+ eassert (0 <= tem);
/* Coming here means STRING contains ASCII only. */
- tem = strlen (string);
if (STRING_BYTES_BOUND < tem)
error ("Format width or precision too large");
width = tem;
{
/* Truncate the string at character boundary. */
tem = bufsize;
- while (!CHAR_HEAD_P (string[tem - 1])) tem--;
- /* If the multibyte sequence of this character is
- too long for the space we have left in the
- buffer, truncate before it. */
- if (tem > 0
- && BYTES_BY_CHAR_HEAD (string[tem - 1]) > bufsize)
- tem--;
- if (tem > 0)
- memcpy (bufptr, string, tem);
+ do
+ {
+ tem--;
+ if (CHAR_HEAD_P (string[tem]))
+ {
+ if (BYTES_BY_CHAR_HEAD (string[tem]) <= bufsize - tem)
+ tem = bufsize;
+ break;
+ }
+ }
+ while (tem != 0);
+
+ memcpy (bufptr, string, tem);
bufptr[tem] = 0;
/* Trigger exit from the loop, but make sure we
return to the caller a value which will indicate
bufsize = 0;
continue;
}
- else
- memcpy (bufptr, string, tem);
+ memcpy (bufptr, string, tem);
bufptr += tem;
bufsize -= tem;
if (minlen < 0)
/* The entire file is within this conditional */
#include <stdio.h>
+/* gettime and settime in dos.h clash with their namesakes from
+ gnulib, so we move out of our way the prototypes in dos.h. */
+#define gettime dos_h_gettime_
+#define settime dos_h_settime_
#include <dos.h>
-#include <setjmp.h>
+#undef gettime
+#undef settime
+
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "termchar.h"
#include "frame.h"
#include "dosfns.h"
#include "msdos.h"
#include "dispextern.h"
-#include "character.h"
#include "coding.h"
#include "process.h"
#include <dpmi.h>
if (no < 0 || no > 0xff || ASIZE (registers) != 8)
return Qnil;
for (i = 0; i < 8; i++)
- CHECK_NUMBER (XVECTOR (registers)->contents[i]);
+ CHECK_NUMBER (AREF (registers, i));
- inregs.x.ax = (unsigned long) XFASTINT (XVECTOR (registers)->contents[0]);
- inregs.x.bx = (unsigned long) XFASTINT (XVECTOR (registers)->contents[1]);
- inregs.x.cx = (unsigned long) XFASTINT (XVECTOR (registers)->contents[2]);
- inregs.x.dx = (unsigned long) XFASTINT (XVECTOR (registers)->contents[3]);
- inregs.x.si = (unsigned long) XFASTINT (XVECTOR (registers)->contents[4]);
- inregs.x.di = (unsigned long) XFASTINT (XVECTOR (registers)->contents[5]);
- inregs.x.cflag = (unsigned long) XFASTINT (XVECTOR (registers)->contents[6]);
- inregs.x.flags = (unsigned long) XFASTINT (XVECTOR (registers)->contents[7]);
+ inregs.x.ax = (unsigned long) XFASTINT (AREF (registers, 0));
+ inregs.x.bx = (unsigned long) XFASTINT (AREF (registers, 1));
+ inregs.x.cx = (unsigned long) XFASTINT (AREF (registers, 2));
+ inregs.x.dx = (unsigned long) XFASTINT (AREF (registers, 3));
+ inregs.x.si = (unsigned long) XFASTINT (AREF (registers, 4));
+ inregs.x.di = (unsigned long) XFASTINT (AREF (registers, 5));
+ inregs.x.cflag = (unsigned long) XFASTINT (AREF (registers, 6));
+ inregs.x.flags = (unsigned long) XFASTINT (AREF (registers, 7));
int86 (no, &inregs, &outregs);
- XVECTOR (registers)->contents[0] = make_number (outregs.x.ax);
- XVECTOR (registers)->contents[1] = make_number (outregs.x.bx);
- XVECTOR (registers)->contents[2] = make_number (outregs.x.cx);
- XVECTOR (registers)->contents[3] = make_number (outregs.x.dx);
- XVECTOR (registers)->contents[4] = make_number (outregs.x.si);
- XVECTOR (registers)->contents[5] = make_number (outregs.x.di);
- XVECTOR (registers)->contents[6] = make_number (outregs.x.cflag);
- XVECTOR (registers)->contents[7] = make_number (outregs.x.flags);
+ ASET (registers, 0, make_number (outregs.x.ax));
+ ASET (registers, 1, make_number (outregs.x.bx));
+ ASET (registers, 2, make_number (outregs.x.cx));
+ ASET (registers, 3, make_number (outregs.x.dx));
+ ASET (registers, 4, make_number (outregs.x.si));
+ ASET (registers, 5, make_number (outregs.x.di));
+ ASET (registers, 6, make_number (outregs.x.cflag));
+ ASET (registers, 7, make_number (outregs.x.flags));
return registers;
}
dosmemget (offs, len, buf);
for (i = 0; i < len; i++)
- XVECTOR (vector)->contents[i] = make_number (buf[i]);
+ ASET (vector, i, make_number (buf[i]));
return vector;
}
for (i = 0; i < len; i++)
{
- CHECK_NUMBER (XVECTOR (vector)->contents[i]);
- buf[i] = (unsigned char) XFASTINT (XVECTOR (vector)->contents[i]) & 0xFF;
+ CHECK_NUMBER (AREF (vector, i));
+ buf[i] = (unsigned char) XFASTINT (AREF (vector, i)) & 0xFF;
}
dosmemput (buf, len, offs);
update_mode_lines = 1;
- f->title = name;
+ fset_title (f, name);
if (NILP (name))
name = f->name;
if (FRAME_MSDOS_P (f))
{
- BLOCK_INPUT;
+ block_input ();
w95_set_virtual_machine_title (SDATA (name));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
#endif /* !HAVE_X_WINDOWS */
int i;
Lisp_Object cmd_str, decoded_cmd, tem;
double pmem;
- EXFUN (Fget_internal_run_time, 0);
#ifndef SYSTEM_MALLOC
extern unsigned long ret_lim_data ();
#endif
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
strcpy (cmd, basename (__crt0_argv[0]));
/* Command name is encoded in locale-coding-system; decode it. */
- cmd_str = make_unibyte_string (cmd, strlen (cmd));
+ cmd_str = build_unibyte_string (cmd);
decoded_cmd = code_convert_string_norecord (cmd_str,
Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
q[-1] = '\0';
/* Command line is encoded in locale-coding-system; decode it. */
- cmd_str = make_unibyte_string (cmdline, strlen (cmdline));
+ cmd_str = build_unibyte_string (cmdline);
decoded_cmd = code_convert_string_norecord (cmd_str,
Vlocale_coding_system, 0);
xfree (cmdline);
#endif
DEFVAR_LISP ("dos-display-scancodes", Vdos_display_scancodes,
- doc: /* *Controls whether DOS raw keyboard events are displayed as you type.
+ doc: /* Whether DOS raw keyboard events are displayed as you type.
When non-nil, the keyboard scan-codes are displayed at the bottom right
corner of the display (typically at the end of the mode line).
The output format is: scan code:char code*modifiers. */);
Vdos_display_scancodes = Qnil;
DEFVAR_INT ("dos-hyper-key", dos_hyper_key,
- doc: /* *If set to 1, use right ALT key as hyper key.
+ doc: /* If set to 1, use right ALT key as hyper key.
If set to 2, use right CTRL key as hyper key. */);
dos_hyper_key = 0;
DEFVAR_INT ("dos-super-key", dos_super_key,
- doc: /* *If set to 1, use right ALT key as super key.
+ doc: /* If set to 1, use right ALT key as super key.
If set to 2, use right CTRL key as super key. */);
dos_super_key = 0;
DEFVAR_INT ("dos-keypad-mode", dos_keypad_mode,
- doc: /* *Controls what key code is returned by a key in the numeric keypad.
+ doc: /* Controls what key code is returned by a key in the numeric keypad.
The `numlock ON' action is only taken if no modifier keys are pressed.
The value is an integer constructed by adding the following bits together:
dos_decimal_point = 0;
}
#endif /* MSDOS */
-
#include <config.h>
#include <sys/types.h>
#include <stdio.h>
-#include <setjmp.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
#include <sys/resource.h>
#endif
-#include <ctype.h>
#include <float.h>
#include <limits.h>
#include <intprops.h>
#include <verify.h>
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "frame.h"
#include "window.h"
#include "blockinput.h"
-#ifndef NULL
-#define NULL 0
-#endif
-
-#ifndef USER_FULL_NAME
-#define USER_FULL_NAME pw->pw_gecos
-#endif
-
-#ifndef USE_CRT_DLL
-extern char **environ;
-#endif
-
#define TM_YEAR_BASE 1900
-/* Nonzero if TM_YEAR is a struct tm's tm_year value that causes
- asctime to have well-defined behavior. */
-#ifndef TM_YEAR_IN_ASCTIME_RANGE
-# define TM_YEAR_IN_ASCTIME_RANGE(tm_year) \
- (1000 - TM_YEAR_BASE <= (tm_year) && (tm_year) <= 9999 - TM_YEAR_BASE)
-#endif
-
#ifdef WINDOWSNT
extern Lisp_Object w32_get_internal_run_time (void);
#endif
-static void time_overflow (void) NO_RETURN;
-static Lisp_Object format_time_string (char const *, ptrdiff_t, Lisp_Object,
- int, time_t *, struct tm **);
+static Lisp_Object format_time_string (char const *, ptrdiff_t, EMACS_TIME,
+ bool, struct tm *);
static int tm_diff (struct tm *, struct tm *);
-static void update_buffer_properties (EMACS_INT, EMACS_INT);
+static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
static Lisp_Object Qbuffer_access_fontify_functions;
-static Lisp_Object Fuser_full_name (Lisp_Object);
/* Symbol for the text property used to mark fields. */
/* If the user name claimed in the environment vars differs from
the real uid, use the claimed name to find the full name. */
tem = Fstring_equal (Vuser_login_name, Vuser_real_login_name);
- Vuser_full_name = Fuser_full_name (NILP (tem)? make_number (geteuid ())
- : Vuser_login_name);
+ if (! NILP (tem))
+ tem = Vuser_login_name;
+ else
+ {
+ uid_t euid = geteuid ();
+ tem = make_fixnum_or_float (euid);
+ }
+ Vuser_full_name = Fuser_full_name (tem);
p = getenv ("NAME");
if (p)
XSETFASTINT (val, 0);
return val;
}
-\f
-static Lisp_Object
-buildmark (EMACS_INT charpos, EMACS_INT bytepos)
-{
- register Lisp_Object mark;
- mark = Fmake_marker ();
- set_marker_both (mark, Qnil, charpos, bytepos);
- return mark;
-}
DEFUN ("point", Fpoint, Spoint, 0, 0, 0,
doc: /* Return value of point, as an integer.
doc: /* Return value of point, as a marker object. */)
(void)
{
- return buildmark (PT, PT_BYTE);
-}
-
-EMACS_INT
-clip_to_bounds (EMACS_INT lower, EMACS_INT num, EMACS_INT upper)
-{
- if (num < lower)
- return lower;
- else if (num > upper)
- return upper;
- else
- return num;
+ return build_marker (current_buffer, PT, PT_BYTE);
}
DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
The return value is POSITION. */)
(register Lisp_Object position)
{
- EMACS_INT pos;
+ ptrdiff_t pos;
if (MARKERP (position)
&& current_buffer == XMARKER (position)->buffer)
/* Return the start or end position of the region.
- BEGINNINGP non-zero means return the start.
+ BEGINNINGP means return the start.
If there is no region active, signal an error. */
static Lisp_Object
-region_limit (int beginningp)
+region_limit (bool beginningp)
{
Lisp_Object m;
if (NILP (m))
error ("The mark is not set now, so there is no region");
- if ((PT < XFASTINT (m)) == (beginningp != 0))
- m = make_number (PT);
- return m;
+ /* Clip to the current narrowing (bug#11770). */
+ return make_number ((PT < XFASTINT (m)) == beginningp
+ ? PT
+ : clip_to_bounds (BEGV, XFASTINT (m), ZV));
}
DEFUN ("region-beginning", Fregion_beginning, Sregion_beginning, 0, 0, 0,
{
Lisp_Object overlay, start, end;
struct Lisp_Overlay *tail;
- EMACS_INT startpos, endpos;
+ ptrdiff_t startpos, endpos;
ptrdiff_t idx = 0;
for (tail = current_buffer->overlays_before; tail; tail = tail->next)
/* First try with room for 40 overlays. */
noverlays = 40;
- overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
+ overlay_vec = alloca (noverlays * sizeof *overlay_vec);
noverlays = overlays_around (posn, overlay_vec, noverlays);
/* If there are more than 40,
make enough space for all, and try again. */
if (noverlays > 40)
{
- overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
+ overlay_vec = alloca (noverlays * sizeof *overlay_vec);
noverlays = overlays_around (posn, overlay_vec, noverlays);
}
noverlays = sort_overlays (overlay_vec, noverlays, NULL);
BEG_LIMIT and END_LIMIT serve to limit the ranged of the returned
results; they do not effect boundary behavior.
- If MERGE_AT_BOUNDARY is nonzero, then if POS is at the very first
+ If MERGE_AT_BOUNDARY is non-nil, then if POS is at the very first
position of a field, then the beginning of the previous field is
returned instead of the beginning of POS's field (since the end of a
field is actually also the beginning of the next input field, this
behavior is sometimes useful). Additionally in the MERGE_AT_BOUNDARY
- true case, if two fields are separated by a field with the special
+ non-nil case, if two fields are separated by a field with the special
value `boundary', and POS lies within it, then the two separated
fields are considered to be adjacent, and POS between them, when
finding the beginning and ending of the "merged" field.
static void
find_field (Lisp_Object pos, Lisp_Object merge_at_boundary,
Lisp_Object beg_limit,
- EMACS_INT *beg, Lisp_Object end_limit, EMACS_INT *end)
+ ptrdiff_t *beg, Lisp_Object end_limit, ptrdiff_t *end)
{
/* Fields right before and after the point. */
Lisp_Object before_field, after_field;
- /* 1 if POS counts as the start of a field. */
- int at_field_start = 0;
- /* 1 if POS counts as the end of a field. */
- int at_field_end = 0;
+ /* True if POS counts as the start of a field. */
+ bool at_field_start = 0;
+ /* True if POS counts as the end of a field. */
+ bool at_field_end = 0;
if (NILP (pos))
XSETFASTINT (pos, PT);
xxxx.yyyy
- In this situation, if merge_at_boundary is true, we consider the
+ In this situation, if merge_at_boundary is non-nil, consider the
`x' and `y' fields as forming one big merged field, and so the end
of the field is the end of `y'.
However, if `x' and `y' are separated by a special `boundary' field
- (a field with a `field' char-property of 'boundary), then we ignore
+ (a field with a `field' char-property of 'boundary), then ignore
this special field when merging adjacent fields. Here's the same
situation, but with a `boundary' field between the `x' and `y' fields:
xxx.BBBByyyy
Here, if point is at the end of `x', the beginning of `y', or
- anywhere in-between (within the `boundary' field), we merge all
+ anywhere in-between (within the `boundary' field), merge all
three fields and consider the beginning as being the beginning of
the `x' field, and the end as being the end of the `y' field. */
If POS is nil, the value of point is used for POS. */)
(Lisp_Object pos)
{
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
if (beg != end)
del_range (beg, end);
If POS is nil, the value of point is used for POS. */)
(Lisp_Object pos)
{
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
return make_buffer_string (beg, end, 1);
}
If POS is nil, the value of point is used for POS. */)
(Lisp_Object pos)
{
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
find_field (pos, Qnil, Qnil, &beg, Qnil, &end);
return make_buffer_string (beg, end, 0);
}
is before LIMIT, then LIMIT will be returned instead. */)
(Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit)
{
- EMACS_INT beg;
+ ptrdiff_t beg;
find_field (pos, escape_from_edge, limit, &beg, Qnil, 0);
return make_number (beg);
}
is after LIMIT, then LIMIT will be returned instead. */)
(Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit)
{
- EMACS_INT end;
+ ptrdiff_t end;
find_field (pos, escape_from_edge, Qnil, 0, limit, &end);
return make_number (end);
}
(Lisp_Object new_pos, Lisp_Object old_pos, Lisp_Object escape_from_edge, Lisp_Object only_in_line, Lisp_Object inhibit_capture_property)
{
/* If non-zero, then the original point, before re-positioning. */
- EMACS_INT orig_point = 0;
- int fwd;
+ ptrdiff_t orig_point = 0;
+ bool fwd;
Lisp_Object prev_old, prev_new;
if (NILP (new_pos))
CHECK_NUMBER_COERCE_MARKER (new_pos);
CHECK_NUMBER_COERCE_MARKER (old_pos);
- fwd = (XFASTINT (new_pos) > XFASTINT (old_pos));
+ fwd = (XINT (new_pos) > XINT (old_pos));
- prev_old = make_number (XFASTINT (old_pos) - 1);
- prev_new = make_number (XFASTINT (new_pos) - 1);
+ prev_old = make_number (XINT (old_pos) - 1);
+ prev_new = make_number (XINT (new_pos) - 1);
if (NILP (Vinhibit_field_text_motion)
&& !EQ (new_pos, old_pos)
/* It is possible that NEW_POS is not within the same field as
OLD_POS; try to move NEW_POS so that it is. */
{
- EMACS_INT shortage;
+ ptrdiff_t shortage;
Lisp_Object field_bound;
if (fwd)
DEFUN ("line-beginning-position",
Fline_beginning_position, Sline_beginning_position, 0, 1, 0,
doc: /* Return the character position of the first character on the current line.
-With argument N not nil or 1, move forward N - 1 lines first.
-If scan reaches end of buffer, return that position.
+With optional argument N, scan forward N - 1 lines first.
+If the scan reaches the end of the buffer, return that position.
-The returned position is of the first character in the logical order,
-i.e. the one that has the smallest character position.
+This function ignores text display directionality; it returns the
+position of the first character in logical order, i.e. the smallest
+character position on the line.
This function constrains the returned position to the current field
-unless that would be on a different line than the original,
+unless that position would be on a different line than the original,
unconstrained result. If N is nil or 1, and a front-sticky field
starts at point, the scan stops as soon as it starts. To ignore field
-boundaries bind `inhibit-field-text-motion' to t.
+boundaries, bind `inhibit-field-text-motion' to t.
This function does not move point. */)
(Lisp_Object n)
{
- EMACS_INT orig, orig_byte, end;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t orig, orig_byte, end;
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_point_motion_hooks, Qt);
if (NILP (n))
With argument N not nil or 1, move forward N - 1 lines first.
If scan reaches end of buffer, return that position.
-The returned position is of the last character in the logical order,
-i.e. the character whose buffer position is the largest one.
+This function ignores text display directionality; it returns the
+position of the last character in logical order, i.e. the largest
+character position on the line.
This function constrains the returned position to the current field
unless that would be on a different line than the original,
This function does not move point. */)
(Lisp_Object n)
{
- EMACS_INT end_pos;
- EMACS_INT orig = PT;
+ ptrdiff_t clipped_n;
+ ptrdiff_t end_pos;
+ ptrdiff_t orig = PT;
if (NILP (n))
XSETFASTINT (n, 1);
else
CHECK_NUMBER (n);
- end_pos = find_before_next_newline (orig, 0, XINT (n) - (XINT (n) <= 0));
+ clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XINT (n), PTRDIFF_MAX);
+ end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0));
/* Return END_POS constrained to the current input field. */
return Fconstrain_to_field (make_number (end_pos), make_number (orig),
Lisp_Object
save_excursion_save (void)
{
- int visible = (XBUFFER (XWINDOW (selected_window)->buffer)
- == current_buffer);
+ bool visible = (XBUFFER (XWINDOW (selected_window)->buffer)
+ == current_buffer);
return Fcons (Fpoint_marker (),
Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil),
{
Lisp_Object tem, tem1, omark, nmark;
struct gcpro gcpro1, gcpro2, gcpro3;
- int visible_p;
+ bool visible_p;
tem = Fmarker_buffer (XCAR (info));
/* If buffer being returned to is now deleted, avoid error */
info = XCDR (info);
tem = XCAR (info);
tem1 = BVAR (current_buffer, mark_active);
- BVAR (current_buffer, mark_active) = tem;
+ bset_mark_active (current_buffer, tem);
/* If mark is active now, and either was not active
or was at a different place, run the activate hook. */
(Lisp_Object args)
{
register Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (save_excursion_restore, save_excursion_save ());
}
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)
{
- Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
-
- val = Fprogn (args);
- return unbind_to (count, val);
+ record_unwind_current_buffer ();
+ return unbind_to (count, Fprogn (args));
}
\f
DEFUN ("buffer-size", Fbufsize, Sbufsize, 0, 1, 0,
This is the beginning, unless narrowing (a buffer restriction) is in effect. */)
(void)
{
- return buildmark (BEGV, BEGV_BYTE);
+ return build_marker (current_buffer, BEGV, BEGV_BYTE);
}
DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0,
is in effect, in which case it is less. */)
(void)
{
- return buildmark (ZV, ZV_BYTE);
+ return build_marker (current_buffer, ZV, ZV_BYTE);
}
DEFUN ("gap-position", Fgap_position, Sgap_position, 0, 0, 0,
XSETFASTINT (temp, 0);
else if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- EMACS_INT pos = PT_BYTE;
+ ptrdiff_t pos = PT_BYTE;
DEC_POS (pos);
XSETFASTINT (temp, FETCH_CHAR (pos));
}
If POS is out of range, the value is nil. */)
(Lisp_Object pos)
{
- register EMACS_INT pos_byte;
+ register ptrdiff_t pos_byte;
if (NILP (pos))
{
(Lisp_Object pos)
{
register Lisp_Object val;
- register EMACS_INT pos_byte;
+ register ptrdiff_t pos_byte;
if (NILP (pos))
{
if (NILP (uid))
return Vuser_login_name;
- id = XFLOATINT (uid);
- BLOCK_INPUT;
+ CONS_TO_INTEGER (uid, uid_t, id);
+ block_input ();
pw = getpwuid (id);
- UNBLOCK_INPUT;
+ unblock_input ();
return (pw ? build_string (pw->pw_name) : Qnil);
}
Value is an integer or a float, depending on the value. */)
(void)
{
- /* Assignment to EMACS_INT stops GCC whining about limited range of
- data type. */
- EMACS_INT euid = geteuid ();
-
- /* Make sure we don't produce a negative UID due to signed integer
- overflow. */
- if (euid < 0)
- return make_float (geteuid ());
+ uid_t euid = geteuid ();
return make_fixnum_or_float (euid);
}
Value is an integer or a float, depending on the value. */)
(void)
{
- /* Assignment to EMACS_INT stops GCC whining about limited range of
- data type. */
- EMACS_INT uid = getuid ();
-
- /* Make sure we don't produce a negative UID due to signed integer
- overflow. */
- if (uid < 0)
- return make_float (getuid ());
+ uid_t uid = getuid ();
return make_fixnum_or_float (uid);
}
return Vuser_full_name;
else if (NUMBERP (uid))
{
- uid_t u = XFLOATINT (uid);
- BLOCK_INPUT;
+ uid_t u;
+ CONS_TO_INTEGER (uid, uid_t, u);
+ block_input ();
pw = getpwuid (u);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else if (STRINGP (uid))
{
- BLOCK_INPUT;
+ block_input ();
pw = getpwnam (SSDATA (uid));
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
error ("Invalid UID specification");
Lisp_Object login;
login = Fuser_login_name (make_number (pw->pw_uid));
- r = (char *) alloca (strlen (p) + SCHARS (login) + 1);
+ r = alloca (strlen (p) + SCHARS (login) + 1);
memcpy (r, p, q - p);
r[q - p] = 0;
strcat (r, SSDATA (login));
}
DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
- doc: /* Return the process ID of Emacs, as an integer. */)
+ doc: /* Return the process ID of Emacs, as a number. */)
(void)
{
- return make_number (getpid ());
+ pid_t pid = getpid ();
+ return make_fixnum_or_float (pid);
}
\f
#endif
/* Report that a time value is out of range for Emacs. */
-static void
+void
time_overflow (void)
{
error ("Specified time is not representable");
}
-/* Return the upper part of the time T (everything but the bottom 16 bits),
- making sure that it is representable. */
+/* Return the upper part of the time T (everything but the bottom 16 bits). */
static EMACS_INT
hi_time (time_t t)
{
}
/* Return the bottom 16 bits of the time T. */
-static EMACS_INT
+static int
lo_time (time_t t)
{
return t & ((1 << 16) - 1);
DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0,
doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00.
-The time is returned as a list of three integers. The first has the
-most significant 16 bits of the seconds, while the second has the
-least significant 16 bits. The third integer gives the microsecond
-count.
-
-The microsecond count is zero on systems that do not provide
-resolution finer than a second. */)
+The time is returned as a list of integers (HIGH LOW USEC PSEC).
+HIGH has the most significant bits of the seconds, while LOW has the
+least significant 16 bits. USEC and PSEC are the microsecond and
+picosecond counts. */)
(void)
{
- EMACS_TIME t;
-
- EMACS_GET_TIME (t);
- return list3 (make_number (hi_time (EMACS_SECS (t))),
- make_number (lo_time (EMACS_SECS (t))),
- make_number (EMACS_USECS (t)));
+ return make_lisp_time (current_emacs_time ());
}
DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
0, 0, 0,
doc: /* Return the current run time used by Emacs.
-The time is returned as a list of three integers. The first has the
-most significant 16 bits of the seconds, while the second has the
-least significant 16 bits. The third integer gives the microsecond
-count.
+The time is returned as a list (HIGH LOW USEC PSEC), using the same
+style as (current-time).
On systems that can't determine the run time, `get-internal-run-time'
-does the same thing as `current-time'. The microsecond count is zero
-on systems that do not provide resolution finer than a second. */)
+does the same thing as `current-time'. */)
(void)
{
#ifdef HAVE_GETRUSAGE
usecs -= 1000000;
secs++;
}
-
- return list3 (make_number (hi_time (secs)),
- make_number (lo_time (secs)),
- make_number (usecs));
+ return make_lisp_time (make_emacs_time (secs, usecs * 1000));
#else /* ! HAVE_GETRUSAGE */
#ifdef WINDOWSNT
return w32_get_internal_run_time ();
}
\f
-/* Make a Lisp list that represents the time T. */
-Lisp_Object
+/* Make a Lisp list that represents the time T with fraction TAIL. */
+static Lisp_Object
+make_time_tail (time_t t, Lisp_Object tail)
+{
+ return Fcons (make_number (hi_time (t)),
+ Fcons (make_number (lo_time (t)), tail));
+}
+
+/* Make a Lisp list that represents the system time T. */
+static Lisp_Object
make_time (time_t t)
{
- return list2 (make_number (hi_time (t)),
- make_number (lo_time (t)));
+ return make_time_tail (t, Qnil);
+}
+
+/* Make a Lisp list that represents the Emacs time T. T may be an
+ invalid time, with a slightly negative tv_nsec value such as
+ UNKNOWN_MODTIME_NSECS; in that case, the Lisp list contains a
+ correspondingly negative picosecond count. */
+Lisp_Object
+make_lisp_time (EMACS_TIME t)
+{
+ int ns = EMACS_NSECS (t);
+ return make_time_tail (EMACS_SECS (t),
+ list2 (make_number (ns / 1000),
+ make_number (ns % 1000 * 1000)));
}
/* Decode a Lisp list SPECIFIED_TIME that represents a time.
- If SPECIFIED_TIME is nil, use the current time.
- Set *RESULT to seconds since the Epoch.
- If USEC is not null, set *USEC to the microseconds component.
- Return nonzero if successful. */
-int
-lisp_time_argument (Lisp_Object specified_time, time_t *result, int *usec)
+ Set *PHIGH, *PLOW, *PUSEC, *PPSEC to its parts; do not check their values.
+ Return true if successful. */
+static bool
+disassemble_lisp_time (Lisp_Object specified_time, Lisp_Object *phigh,
+ Lisp_Object *plow, Lisp_Object *pusec,
+ Lisp_Object *ppsec)
{
- if (NILP (specified_time))
+ if (CONSP (specified_time))
{
- if (usec)
- {
- EMACS_TIME t;
+ Lisp_Object low = XCDR (specified_time);
+ Lisp_Object usec = make_number (0);
+ Lisp_Object psec = make_number (0);
+ if (CONSP (low))
+ {
+ Lisp_Object low_tail = XCDR (low);
+ low = XCAR (low);
+ if (CONSP (low_tail))
+ {
+ usec = XCAR (low_tail);
+ low_tail = XCDR (low_tail);
+ if (CONSP (low_tail))
+ psec = XCAR (low_tail);
+ }
+ else if (!NILP (low_tail))
+ usec = low_tail;
+ }
- EMACS_GET_TIME (t);
- *usec = EMACS_USECS (t);
- *result = EMACS_SECS (t);
- return 1;
- }
+ *phigh = XCAR (specified_time);
+ *plow = low;
+ *pusec = usec;
+ *ppsec = psec;
+ return 1;
+ }
+
+ return 0;
+}
+
+/* From the time components HIGH, LOW, USEC and PSEC taken from a Lisp
+ list, generate the corresponding time value.
+
+ If RESULT is not null, store into *RESULT the converted time;
+ this can fail if the converted time does not fit into EMACS_TIME.
+ If *DRESULT is not null, store into *DRESULT the number of
+ seconds since the start of the POSIX Epoch.
+
+ Return true if successful. */
+bool
+decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
+ Lisp_Object psec,
+ EMACS_TIME *result, double *dresult)
+{
+ EMACS_INT hi, lo, us, ps;
+ if (! (INTEGERP (high) && INTEGERP (low)
+ && INTEGERP (usec) && INTEGERP (psec)))
+ return 0;
+ hi = XINT (high);
+ lo = XINT (low);
+ us = XINT (usec);
+ ps = XINT (psec);
+
+ /* Normalize out-of-range lower-order components by carrying
+ each overflow into the next higher-order component. */
+ us += ps / 1000000 - (ps % 1000000 < 0);
+ lo += us / 1000000 - (us % 1000000 < 0);
+ hi += lo >> 16;
+ ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0);
+ us = us % 1000000 + 1000000 * (us % 1000000 < 0);
+ lo &= (1 << 16) - 1;
+
+ if (result)
+ {
+ if ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> 16 <= hi : 0 <= hi)
+ && hi <= TIME_T_MAX >> 16)
+ {
+ /* Return the greatest representable time that is not greater
+ than the requested time. */
+ time_t sec = hi;
+ *result = make_emacs_time ((sec << 16) + lo, us * 1000 + ps / 1000);
+ }
else
- return time (result) != -1;
+ {
+ /* Overflow in the highest-order component. */
+ return 0;
+ }
}
+
+ if (dresult)
+ *dresult = (us * 1e6 + ps) / 1e12 + lo + hi * 65536.0;
+
+ return 1;
+}
+
+/* Decode a Lisp list SPECIFIED_TIME that represents a time.
+ If SPECIFIED_TIME is nil, use the current time.
+
+ Round the time down to the nearest EMACS_TIME value.
+ Return seconds since the Epoch.
+ Signal an error if unsuccessful. */
+EMACS_TIME
+lisp_time_argument (Lisp_Object specified_time)
+{
+ EMACS_TIME t;
+ if (NILP (specified_time))
+ t = current_emacs_time ();
else
{
- Lisp_Object high, low;
- EMACS_INT hi;
- high = Fcar (specified_time);
- CHECK_NUMBER (high);
- low = Fcdr (specified_time);
- if (CONSP (low))
- {
- if (usec)
- {
- Lisp_Object usec_l = Fcdr (low);
- if (CONSP (usec_l))
- usec_l = Fcar (usec_l);
- if (NILP (usec_l))
- *usec = 0;
- else
- {
- CHECK_NUMBER (usec_l);
- *usec = XINT (usec_l);
- }
- }
- low = Fcar (low);
- }
- else if (usec)
- *usec = 0;
- CHECK_NUMBER (low);
- hi = XINT (high);
-
- /* Check for overflow, helping the compiler for common cases
- where no runtime check is needed, and taking care not to
- convert negative numbers to unsigned before comparing them. */
- if (! ((TYPE_SIGNED (time_t)
- ? (TIME_T_MIN >> 16 <= MOST_NEGATIVE_FIXNUM
- || TIME_T_MIN >> 16 <= hi)
- : 0 <= hi)
- && (MOST_POSITIVE_FIXNUM <= TIME_T_MAX >> 16
- || hi <= TIME_T_MAX >> 16)))
- return 0;
-
- *result = (hi << 16) + (XINT (low) & 0xffff);
- return 1;
+ Lisp_Object high, low, usec, psec;
+ if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
+ && decode_time_components (high, low, usec, psec, &t, 0)))
+ error ("Invalid time specification");
+ }
+ return t;
+}
+
+/* Like lisp_time_argument, except decode only the seconds part,
+ do not allow out-of-range time stamps, do not check the subseconds part,
+ and always round down. */
+static time_t
+lisp_seconds_argument (Lisp_Object specified_time)
+{
+ if (NILP (specified_time))
+ return time (NULL);
+ else
+ {
+ Lisp_Object high, low, usec, psec;
+ EMACS_TIME t;
+ if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
+ && decode_time_components (high, low, make_number (0),
+ make_number (0), &t, 0)))
+ error ("Invalid time specification");
+ return EMACS_SECS (t);
}
}
doc: /* Return the current time, as a float number of seconds since the epoch.
If SPECIFIED-TIME is given, it is the time to convert to float
instead of the current time. The argument should have the form
-(HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
-`current-time' and from `file-attributes'. SPECIFIED-TIME can also
-have the form (HIGH . LOW), but this is considered obsolete.
+(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus,
+you can use times from `current-time' and from `file-attributes'.
+SPECIFIED-TIME can also have the form (HIGH . LOW), but this is
+considered obsolete.
WARNING: Since the result is floating point, it may not be exact.
If precise time stamps are required, use either `current-time',
or (if you need time as a string) `format-time-string'. */)
(Lisp_Object specified_time)
{
- time_t sec;
- int usec;
-
- if (! lisp_time_argument (specified_time, &sec, &usec))
- error ("Invalid time specification");
-
- return make_float ((sec * 1e6 + usec) / 1e6);
+ double t;
+ if (NILP (specified_time))
+ {
+ EMACS_TIME now = current_emacs_time ();
+ t = EMACS_SECS (now) + EMACS_NSECS (now) / 1e9;
+ }
+ else
+ {
+ Lisp_Object high, low, usec, psec;
+ if (! (disassemble_lisp_time (specified_time, &high, &low, &usec, &psec)
+ && decode_time_components (high, low, usec, psec, 0, &t)))
+ error ("Invalid time specification");
+ }
+ return make_float (t);
}
/* Write information into buffer S of size MAXSIZE, according to the
FORMAT of length FORMAT_LEN, using time information taken from *TP.
- Default to Universal Time if UT is nonzero, local time otherwise.
+ Default to Universal Time if UT, local time otherwise.
Use NS as the number of nanoseconds in the %N directive.
Return the number of bytes written, not including the terminating
'\0'. If S is NULL, nothing will be written anywhere; so to
bytes in FORMAT and it does not support nanoseconds. */
static size_t
emacs_nmemftime (char *s, size_t maxsize, const char *format,
- size_t format_len, const struct tm *tp, int ut, int ns)
+ size_t format_len, const struct tm *tp, bool ut, int ns)
{
size_t total = 0;
DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
-TIME is specified as (HIGH LOW . IGNORED), as returned by
+TIME is specified as (HIGH LOW USEC PSEC), as returned by
`current-time' or `file-attributes'. The obsolete form (HIGH . LOW)
is also still accepted.
The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
usage: (format-time-string FORMAT-STRING &optional TIME UNIVERSAL) */)
(Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal)
{
- time_t t;
- struct tm *tm;
+ EMACS_TIME t = lisp_time_argument (timeval);
+ struct tm tm;
CHECK_STRING (format_string);
format_string = code_convert_string_norecord (format_string,
Vlocale_coding_system, 1);
return format_time_string (SSDATA (format_string), SBYTES (format_string),
- timeval, ! NILP (universal), &t, &tm);
+ t, ! NILP (universal), &tm);
}
static Lisp_Object
format_time_string (char const *format, ptrdiff_t formatlen,
- Lisp_Object timeval, int ut, time_t *tval, struct tm **tmp)
+ EMACS_TIME t, bool ut, struct tm *tmp)
{
- ptrdiff_t size;
- int usec;
- int ns;
+ char buffer[4000];
+ char *buf = buffer;
+ ptrdiff_t size = sizeof buffer;
+ size_t len;
+ Lisp_Object bufstring;
+ int ns = EMACS_NSECS (t);
struct tm *tm;
-
- if (! (lisp_time_argument (timeval, tval, &usec)
- && 0 <= usec && usec < 1000000))
- error ("Invalid time specification");
- ns = usec * 1000;
-
- /* This is probably enough. */
- size = formatlen;
- if (size <= (STRING_BYTES_BOUND - 50) / 6)
- size = size * 6 + 50;
-
- BLOCK_INPUT;
- tm = ut ? gmtime (tval) : localtime (tval);
- UNBLOCK_INPUT;
- if (! tm)
- time_overflow ();
- *tmp = tm;
-
- synchronize_system_time_locale ();
+ USE_SAFE_ALLOCA;
while (1)
{
- char *buf = (char *) alloca (size + 1);
- size_t result;
+ time_t *taddr = emacs_secs_addr (&t);
+ block_input ();
+
+ synchronize_system_time_locale ();
+
+ tm = ut ? gmtime (taddr) : localtime (taddr);
+ if (! tm)
+ {
+ unblock_input ();
+ time_overflow ();
+ }
+ *tmp = *tm;
buf[0] = '\1';
- BLOCK_INPUT;
- result = emacs_nmemftime (buf, size, format, formatlen, tm, ut, ns);
- UNBLOCK_INPUT;
- if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0'))
- return code_convert_string_norecord (make_unibyte_string (buf, result),
- Vlocale_coding_system, 0);
-
- /* If buffer was too small, make it bigger and try again. */
- BLOCK_INPUT;
- result = emacs_nmemftime (NULL, (size_t) -1, format, formatlen,
- tm, ut, ns);
- UNBLOCK_INPUT;
- if (STRING_BYTES_BOUND <= result)
+ len = emacs_nmemftime (buf, size, format, formatlen, tm, ut, ns);
+ if ((0 < len && len < size) || (len == 0 && buf[0] == '\0'))
+ break;
+
+ /* Buffer was too small, so make it bigger and try again. */
+ len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tm, ut, ns);
+ unblock_input ();
+ if (STRING_BYTES_BOUND <= len)
string_overflow ();
- size = result + 1;
+ size = len + 1;
+ buf = SAFE_ALLOCA (size);
}
+
+ unblock_input ();
+ bufstring = make_unibyte_string (buf, len);
+ SAFE_FREE ();
+ return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0);
}
DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0,
DOW and ZONE.) */)
(Lisp_Object specified_time)
{
- time_t time_spec;
+ time_t time_spec = lisp_seconds_argument (specified_time);
struct tm save_tm;
struct tm *decoded_time;
Lisp_Object list_args[9];
- if (! lisp_time_argument (specified_time, &time_spec, NULL))
- error ("Invalid time specification");
-
- BLOCK_INPUT;
+ block_input ();
decoded_time = localtime (&time_spec);
- UNBLOCK_INPUT;
+ if (decoded_time)
+ save_tm = *decoded_time;
+ unblock_input ();
if (! (decoded_time
- && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= decoded_time->tm_year
- && decoded_time->tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
+ && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= save_tm.tm_year
+ && save_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE))
time_overflow ();
- XSETFASTINT (list_args[0], decoded_time->tm_sec);
- XSETFASTINT (list_args[1], decoded_time->tm_min);
- XSETFASTINT (list_args[2], decoded_time->tm_hour);
- XSETFASTINT (list_args[3], decoded_time->tm_mday);
- XSETFASTINT (list_args[4], decoded_time->tm_mon + 1);
+ XSETFASTINT (list_args[0], save_tm.tm_sec);
+ XSETFASTINT (list_args[1], save_tm.tm_min);
+ XSETFASTINT (list_args[2], save_tm.tm_hour);
+ XSETFASTINT (list_args[3], save_tm.tm_mday);
+ XSETFASTINT (list_args[4], save_tm.tm_mon + 1);
/* On 64-bit machines an int is narrower than EMACS_INT, thus the
cast below avoids overflow in int arithmetics. */
- XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) decoded_time->tm_year);
- XSETFASTINT (list_args[6], decoded_time->tm_wday);
- list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
+ XSETINT (list_args[5], TM_YEAR_BASE + (EMACS_INT) save_tm.tm_year);
+ XSETFASTINT (list_args[6], save_tm.tm_wday);
+ list_args[7] = save_tm.tm_isdst ? Qt : Qnil;
- /* Make a copy, in case gmtime modifies the struct. */
- save_tm = *decoded_time;
- BLOCK_INPUT;
+ block_input ();
decoded_time = gmtime (&time_spec);
- UNBLOCK_INPUT;
if (decoded_time == 0)
list_args[8] = Qnil;
else
XSETINT (list_args[8], tm_diff (&save_tm, decoded_time));
+ unblock_input ();
return Flist (9, list_args);
}
tm.tm_isdst = -1;
if (CONSP (zone))
- zone = Fcar (zone);
+ zone = XCAR (zone);
if (NILP (zone))
{
- BLOCK_INPUT;
+ block_input ();
value = mktime (&tm);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
{
tzstring = SSDATA (zone);
else if (INTEGERP (zone))
{
- int abszone = eabs (XINT (zone));
- sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
- abszone / (60*60), (abszone/60) % 60, abszone % 60);
+ EMACS_INT abszone = eabs (XINT (zone));
+ EMACS_INT zone_hr = abszone / (60*60);
+ int zone_min = (abszone/60) % 60;
+ int zone_sec = abszone % 60;
+ sprintf (tzbuf, "XXX%s%"pI"d:%02d:%02d", "-" + (XINT (zone) < 0),
+ zone_hr, zone_min, zone_sec);
tzstring = tzbuf;
}
else
error ("Invalid time zone specification");
+ block_input ();
+
/* Set TZ before calling mktime; merely adjusting mktime's returned
value doesn't suffice, since that would mishandle leap seconds. */
set_time_zone_rule (tzstring);
- BLOCK_INPUT;
value = mktime (&tm);
- UNBLOCK_INPUT;
/* Restore TZ to previous value. */
newenv = environ;
environ = oldenv;
- xfree (newenv);
#ifdef LOCALTIME_CACHE
tzset ();
#endif
+ unblock_input ();
+
+ xfree (newenv);
}
if (value == (time_t) -1)
but this is considered obsolete. */)
(Lisp_Object specified_time)
{
- time_t value;
+ time_t value = lisp_seconds_argument (specified_time);
struct tm *tm;
- register char *tem;
-
- if (! lisp_time_argument (specified_time, &value, NULL))
- error ("Invalid time specification");
-
- /* Convert to a string, checking for out-of-range time stamps.
- Don't use 'ctime', as that might dump core if VALUE is out of
- range. */
- BLOCK_INPUT;
+ char buf[sizeof "Mon Apr 30 12:49:17 " + INT_STRLEN_BOUND (int) + 1];
+ int len IF_LINT (= 0);
+
+ /* Convert to a string in ctime format, except without the trailing
+ newline, and without the 4-digit year limit. Don't use asctime
+ or ctime, as they might dump core if the year is outside the
+ range -999 .. 9999. */
+ block_input ();
tm = localtime (&value);
- UNBLOCK_INPUT;
- if (! (tm && TM_YEAR_IN_ASCTIME_RANGE (tm->tm_year) && (tem = asctime (tm))))
+ if (tm)
+ {
+ static char const wday_name[][4] =
+ { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" };
+ static char const mon_name[][4] =
+ { "Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
+ printmax_t year_base = TM_YEAR_BASE;
+
+ len = sprintf (buf, "%s %s%3d %02d:%02d:%02d %"pMd,
+ wday_name[tm->tm_wday], mon_name[tm->tm_mon], tm->tm_mday,
+ tm->tm_hour, tm->tm_min, tm->tm_sec,
+ tm->tm_year + year_base);
+ }
+ unblock_input ();
+ if (! tm)
time_overflow ();
- /* Remove the trailing newline. */
- tem[strlen (tem) - 1] = '\0';
-
- return build_string (tem);
+ return make_unibyte_string (buf, len);
}
/* Yield A - B, measured in seconds.
the data it can't find. */)
(Lisp_Object specified_time)
{
- time_t value;
+ EMACS_TIME value;
+ int offset;
struct tm *t;
struct tm localtm;
- struct tm *localt;
Lisp_Object zone_offset, zone_name;
zone_offset = Qnil;
- zone_name = format_time_string ("%Z", sizeof "%Z" - 1, specified_time,
- 0, &value, &localt);
- localtm = *localt;
- BLOCK_INPUT;
- t = gmtime (&value);
- UNBLOCK_INPUT;
+ value = make_emacs_time (lisp_seconds_argument (specified_time), 0);
+ zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, 0, &localtm);
+ block_input ();
+ t = gmtime (emacs_secs_addr (&value));
+ if (t)
+ offset = tm_diff (&localtm, t);
+ unblock_input ();
if (t)
{
- int offset = tm_diff (&localtm, t);
zone_offset = make_number (offset);
if (SCHARS (zone_name) == 0)
{
int m = offset / 60;
int am = offset < 0 ? - m : m;
char buf[sizeof "+00" + INT_STRLEN_BOUND (int)];
- sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
- zone_name = build_string (buf);
+ zone_name = make_formatted_string (buf, "%c%02d%02d",
+ (offset < 0 ? '-' : '+'),
+ am / 60, am % 60);
}
}
(Lisp_Object tz)
{
const char *tzstring;
+ char **old_environbuf;
+
+ if (! (NILP (tz) || EQ (tz, Qt)))
+ CHECK_STRING (tz);
+
+ block_input ();
/* When called for the first time, save the original TZ. */
- if (!environbuf)
+ old_environbuf = environbuf;
+ if (!old_environbuf)
initial_tz = (char *) getenv ("TZ");
if (NILP (tz))
else if (EQ (tz, Qt))
tzstring = "UTC0";
else
- {
- CHECK_STRING (tz);
- tzstring = SSDATA (tz);
- }
+ tzstring = SSDATA (tz);
set_time_zone_rule (tzstring);
- xfree (environbuf);
environbuf = environ;
+ unblock_input ();
+
+ xfree (old_environbuf);
return Qnil;
}
for (from = environ; *from; from++)
continue;
envptrs = from - environ + 2;
- newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
- + (tzstring ? strlen (tzstring) + 4 : 0));
+ newenv = to = xmalloc (envptrs * sizeof *newenv
+ + (tzstring ? strlen (tzstring) + 4 : 0));
/* Add TZSTRING to the end of environ, as a value for TZ. */
if (tzstring)
static void
general_insert_function (void (*insert_func)
- (const char *, EMACS_INT),
+ (const char *, ptrdiff_t),
void (*insert_from_string_func)
- (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, int),
- int inherit, ptrdiff_t nargs, Lisp_Object *args)
+ (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, bool),
+ bool inherit, ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t argnum;
- register Lisp_Object val;
+ Lisp_Object val;
for (argnum = 0; argnum < nargs; argnum++)
{
return Qnil;
}
\f
-DEFUN ("insert-char", Finsert_char, Sinsert_char, 2, 3, 0,
+DEFUN ("insert-char", Finsert_char, Sinsert_char, 1, 3,
+ "(list (read-char-by-name \"Insert character (Unicode name or hex): \")\
+ (prefix-numeric-value current-prefix-arg)\
+ t))",
doc: /* Insert COUNT copies of CHARACTER.
-Point, and before-insertion markers, are relocated as in the function `insert'.
-The optional third arg INHERIT, if non-nil, says to inherit text properties
-from adjoining text, if those properties are sticky. */)
+Interactively, prompt for CHARACTER. You can specify CHARACTER in one
+of these ways:
+
+ - As its Unicode character name, e.g. \"LATIN SMALL LETTER A\".
+ Completion is available; if you type a substring of the name
+ preceded by an asterisk `*', Emacs shows all names which include
+ that substring, not necessarily at the beginning of the name.
+
+ - As a hexadecimal code point, e.g. 263A. Note that code points in
+ Emacs are equivalent to Unicode up to 10FFFF (which is the limit of
+ the Unicode code space).
+
+ - As a code point with a radix specified with #, e.g. #o21430
+ (octal), #x2318 (hex), or #10r8984 (decimal).
+
+If called interactively, COUNT is given by the prefix argument. If
+omitted or nil, it defaults to 1.
+
+Inserting the character(s) relocates point and before-insertion
+markers in the same ways as the function `insert'.
+
+The optional third argument INHERIT, if non-nil, says to inherit text
+properties from adjoining text, if those properties are sticky. If
+called interactively, INHERIT is t. */)
(Lisp_Object character, Lisp_Object count, Lisp_Object inherit)
{
int i, stringlen;
- register EMACS_INT n;
+ register ptrdiff_t n;
int c, len;
unsigned char str[MAX_MULTIBYTE_LENGTH];
char string[4000];
CHECK_CHARACTER (character);
+ if (NILP (count))
+ XSETFASTINT (count, 1);
CHECK_NUMBER (count);
c = XFASTINT (character);
/* Return a Lisp_String containing the text of the current buffer from
START to END. If text properties are in use and the current buffer
has properties in the range specified, the resulting string will also
- have them, if PROPS is nonzero.
+ have them, if PROPS is true.
We don't want to use plain old make_string here, because it calls
make_uninit_string, which can cause the buffer arena to be
buffer substrings. */
Lisp_Object
-make_buffer_string (EMACS_INT start, EMACS_INT end, int props)
+make_buffer_string (ptrdiff_t start, ptrdiff_t end, bool props)
{
- EMACS_INT start_byte = CHAR_TO_BYTE (start);
- EMACS_INT end_byte = CHAR_TO_BYTE (end);
+ ptrdiff_t start_byte = CHAR_TO_BYTE (start);
+ ptrdiff_t end_byte = CHAR_TO_BYTE (end);
return make_buffer_string_both (start, start_byte, end, end_byte, props);
}
If text properties are in use and the current buffer
has properties in the range specified, the resulting string will also
- have them, if PROPS is nonzero.
+ have them, if PROPS is true.
We don't want to use plain old make_string here, because it calls
make_uninit_string, which can cause the buffer arena to be
buffer substrings. */
Lisp_Object
-make_buffer_string_both (EMACS_INT start, EMACS_INT start_byte,
- EMACS_INT end, EMACS_INT end_byte, int props)
+make_buffer_string_both (ptrdiff_t start, ptrdiff_t start_byte,
+ ptrdiff_t end, ptrdiff_t end_byte, bool props)
{
Lisp_Object result, tem, tem1;
in the current buffer, if necessary. */
static void
-update_buffer_properties (EMACS_INT start, EMACS_INT end)
+update_buffer_properties (ptrdiff_t start, ptrdiff_t end)
{
/* If this buffer has some access functions,
call them, specifying the range of the buffer being accessed. */
use `buffer-substring-no-properties' instead. */)
(Lisp_Object start, Lisp_Object end)
{
- register EMACS_INT b, e;
+ register ptrdiff_t b, e;
validate_region (&start, &end);
b = XINT (start);
they can be in either order. */)
(Lisp_Object start, Lisp_Object end)
{
- register EMACS_INT b, e;
+ register ptrdiff_t b, e;
validate_region (&start, &end);
b = XINT (start);
if (NILP (buf))
nsberror (buffer);
bp = XBUFFER (buf);
- if (NILP (BVAR (bp, name)))
+ if (!BUFFER_LIVE_P (bp))
error ("Selecting deleted buffer");
if (NILP (start))
register Lisp_Object trt
= (!NILP (BVAR (current_buffer, case_fold_search))
? BVAR (current_buffer, case_canon_table) : Qnil);
- EMACS_INT chars = 0;
- EMACS_INT i1, i2, i1_byte, i2_byte;
+ ptrdiff_t chars = 0;
+ ptrdiff_t i1, i2, i1_byte, i2_byte;
/* Find the first buffer and its substring. */
if (NILP (buf1))
nsberror (buffer1);
bp1 = XBUFFER (buf1);
- if (NILP (BVAR (bp1, name)))
+ if (!BUFFER_LIVE_P (bp1))
error ("Selecting deleted buffer");
}
if (NILP (buf2))
nsberror (buffer2);
bp2 = XBUFFER (buf2);
- if (NILP (BVAR (bp2, name)))
+ if (!BUFFER_LIVE_P (bp2))
error ("Selecting deleted buffer");
}
if (!NILP (trt))
{
- c1 = CHAR_TABLE_TRANSLATE (trt, c1);
- c2 = CHAR_TABLE_TRANSLATE (trt, c2);
+ c1 = char_table_translate (trt, c1);
+ c2 = char_table_translate (trt, c2);
}
if (c1 < c2)
return make_number (- 1 - chars);
static Lisp_Object
subst_char_in_region_unwind (Lisp_Object arg)
{
- return BVAR (current_buffer, undo_list) = arg;
+ bset_undo_list (current_buffer, arg);
+ return arg;
}
static Lisp_Object
subst_char_in_region_unwind_1 (Lisp_Object arg)
{
- return BVAR (current_buffer, filename) = arg;
+ bset_filename (current_buffer, arg);
+ return arg;
}
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
Both characters must have the same length of multi-byte form. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object fromchar, Lisp_Object tochar, Lisp_Object noundo)
{
- register EMACS_INT pos, pos_byte, stop, i, len, end_byte;
+ register ptrdiff_t pos, pos_byte, stop, i, len, end_byte;
/* Keep track of the first change in the buffer:
if 0 we haven't found it yet.
if < 0 we've found it and we've run the before-change-function.
if > 0 we've actually performed it and the value is its position. */
- EMACS_INT changed = 0;
+ ptrdiff_t changed = 0;
unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH];
unsigned char *p;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
#define COMBINING_NO 0
#define COMBINING_BEFORE 1
#define COMBINING_AFTER 2
#define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER)
int maybe_byte_combining = COMBINING_NO;
- EMACS_INT last_changed = 0;
- int multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t last_changed = 0;
+ bool multibyte_p
+ = !NILP (BVAR (current_buffer, enable_multibyte_characters));
int fromc, toc;
restart:
{
record_unwind_protect (subst_char_in_region_unwind,
BVAR (current_buffer, undo_list));
- BVAR (current_buffer, undo_list) = Qt;
+ bset_undo_list (current_buffer, 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_filename (current_buffer, Qnil);
}
if (pos_byte < GPT_BYTE)
stop = min (stop, GPT_BYTE);
while (1)
{
- EMACS_INT pos_byte_next = pos_byte;
+ ptrdiff_t pos_byte_next = pos_byte;
if (pos_byte >= stop)
{
INC_POS (pos_byte_next);
if (! NILP (noundo))
- BVAR (current_buffer, undo_list) = tem;
+ bset_undo_list (current_buffer, tem);
UNGCPRO;
}
}
-static Lisp_Object check_translation (EMACS_INT, EMACS_INT, EMACS_INT,
+static Lisp_Object check_translation (ptrdiff_t, ptrdiff_t, ptrdiff_t,
Lisp_Object);
/* Helper function for Ftranslate_region_internal.
element is found, return it. Otherwise return Qnil. */
static Lisp_Object
-check_translation (EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT end,
+check_translation (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t end,
Lisp_Object val)
{
int buf_size = 16, buf_used = 0;
for (; CONSP (val); val = XCDR (val))
{
Lisp_Object elt;
- EMACS_INT len, i;
+ ptrdiff_t len, i;
elt = XCAR (val);
if (! CONSP (elt))
register unsigned char *tt; /* Trans table. */
register int nc; /* New character. */
int cnt; /* Number of changes made. */
- EMACS_INT size; /* Size of translate table. */
- EMACS_INT pos, pos_byte, end_pos;
- int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
- int string_multibyte IF_LINT (= 0);
+ ptrdiff_t size; /* Size of translate table. */
+ ptrdiff_t pos, pos_byte, end_pos;
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool string_multibyte IF_LINT (= 0);
validate_region (&start, &end);
if (CHAR_TABLE_P (table))
{
Lisp_Object beg, end;
- beg = buildmark (BEGV, BEGV_BYTE);
- end = buildmark (ZV, ZV_BYTE);
+ beg = build_marker (current_buffer, BEGV, BEGV_BYTE);
+ end = build_marker (current_buffer, ZV, ZV_BYTE);
/* END must move forward if text is inserted at its exact location. */
XMARKER (end)->insertion_type = 1;
/* The restriction has changed from the saved one, so restore
the saved restriction. */
{
- EMACS_INT pt = BUF_PT (buf);
+ ptrdiff_t pt = BUF_PT (buf);
SET_BUF_BEGV_BOTH (buf, beg->charpos, beg->bytepos);
SET_BUF_ZV_BOTH (buf, end->charpos, end->bytepos);
buf->clip_changed = 1; /* Remember that the narrowing changed. */
}
+ /* These aren't needed anymore, so don't wait for GC. */
+ free_marker (XCAR (data));
+ free_marker (XCDR (data));
+ free_cons (XCONS (data));
}
else
/* A buffer, which means that there was no old restriction. */
(Lisp_Object body)
{
register Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (save_restriction_restore, save_restriction_save ());
val = Fprogn (body);
}
#endif /* HAVE_MENUS */
/* Copy the data so that it won't move when we GC. */
- if (! message_text)
- {
- message_text = (char *)xmalloc (80);
- message_length = 80;
- }
if (SBYTES (val) > message_length)
{
- message_text = (char *) xrealloc (message_text, SBYTES (val));
- message_length = SBYTES (val);
+ ptrdiff_t new_length = SBYTES (val) + 80;
+ message_text = xrealloc (message_text, new_length);
+ message_length = new_length;
}
memcpy (message_text, SDATA (val), SBYTES (val));
message2 (message_text, SBYTES (val),
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
ptrdiff_t n; /* The number of the next arg to substitute */
char initial_buffer[4000];
char *buf = initial_buffer;
- EMACS_INT bufsize = sizeof initial_buffer;
- EMACS_INT max_bufsize = STRING_BYTES_BOUND + 1;
+ ptrdiff_t bufsize = sizeof initial_buffer;
+ ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1;
char *p;
Lisp_Object buf_save_value IF_LINT (= {0});
- register char *format, *end, *format_start;
- EMACS_INT formatlen, nchars;
- /* Nonzero if the format is multibyte. */
- int multibyte_format = 0;
- /* Nonzero if the output should be a multibyte string,
+ char *format, *end, *format_start;
+ ptrdiff_t formatlen, nchars;
+ /* True if the format is multibyte. */
+ bool multibyte_format = 0;
+ /* True if the output should be a multibyte string,
which is true if any of the inputs is one. */
- int multibyte = 0;
+ bool multibyte = 0;
/* When we make a multibyte string, we must pay attention to the
byte combining problem, i.e., a byte may be combined with a
multibyte character of the previous string. This flag tells if we
must consider such a situation or not. */
- int maybe_combine_byte;
+ bool maybe_combine_byte;
Lisp_Object val;
- int arg_intervals = 0;
+ bool arg_intervals = 0;
USE_SAFE_ALLOCA;
/* discarded[I] is 1 if byte I of the format
info[0] is unused. Unused elements have -1 for start. */
struct info
{
- EMACS_INT start, end;
- int converted_to_string;
- int intervals;
+ ptrdiff_t start, end;
+ unsigned converted_to_string : 1;
+ unsigned intervals : 1;
} *info = 0;
/* It should not be necessary to GCPRO ARGS, because
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++)
{
char *format0 = format;
/* Bytes needed to represent the output of this conversion. */
- EMACS_INT convbytes;
+ ptrdiff_t convbytes;
if (*format == '%')
{
digits to print after the '.' for floats, or the max.
number of chars to print from a string. */
- int minus_flag = 0;
- int plus_flag = 0;
- int space_flag = 0;
- int sharp_flag = 0;
- int zero_flag = 0;
- EMACS_INT field_width;
- int precision_given;
+ bool minus_flag = 0;
+ bool plus_flag = 0;
+ bool space_flag = 0;
+ bool sharp_flag = 0;
+ bool zero_flag = 0;
+ ptrdiff_t field_width;
+ bool precision_given;
uintmax_t precision = UINTMAX_MAX;
char *num_end;
char conversion;
{
/* handle case (precision[n] >= 0) */
- EMACS_INT width, padding, nbytes;
- EMACS_INT nchars_string;
+ ptrdiff_t width, padding, nbytes;
+ ptrdiff_t nchars_string;
- EMACS_INT prec = -1;
- if (precision_given && precision <= TYPE_MAXIMUM (EMACS_INT))
+ ptrdiff_t prec = -1;
+ if (precision_given && precision <= TYPE_MAXIMUM (ptrdiff_t))
prec = precision;
/* lisp_string_width ignores a precision of 0, but GNU
width = nchars_string = nbytes = 0;
else
{
- EMACS_INT nch, nby;
+ ptrdiff_t nch, nby;
width = lisp_string_width (args[n], prec, &nch, &nby);
if (prec < 0)
{
/* If this argument has text properties, record where
in the result string it appears. */
- if (STRING_INTERVALS (args[n]))
+ if (string_intervals (args[n]))
info[n].intervals = arg_intervals = 1;
continue;
verify (0 < USEFUL_PRECISION_MAX);
int prec;
- EMACS_INT padding, sprintf_bytes;
+ ptrdiff_t padding, sprintf_bytes;
uintmax_t excess_precision, numwidth;
uintmax_t leading_zeros = 0, trailing_zeros = 0;
char *src = sprintf_buf;
char src0 = src[0];
int exponent_bytes = 0;
- int signedp = src0 == '-' || src0 == '+' || src0 == ' ';
+ bool signedp = src0 == '-' || src0 == '+' || src0 == ' ';
int significand_bytes;
if (zero_flag
&& ((src[signedp] >= '0' && src[signedp] <= '9')
}
if (bufsize < p - buf)
- abort ();
+ emacs_abort ();
if (maybe_combine_byte)
nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
arguments has text properties, set up text properties of the
result string. */
- if (STRING_INTERVALS (args[0]) || arg_intervals)
+ if (string_intervals (args[0]) || arg_intervals)
{
Lisp_Object len, new_len, props;
struct gcpro gcpro1;
if (CONSP (props))
{
- EMACS_INT bytepos = 0, position = 0, translated = 0;
- EMACS_INT argn = 1;
+ ptrdiff_t bytepos = 0, position = 0, translated = 0;
+ ptrdiff_t argn = 1;
Lisp_Object list;
/* Adjust the bounds of each text property
for (list = props; CONSP (list); list = XCDR (list))
{
Lisp_Object item;
- EMACS_INT pos;
+ ptrdiff_t pos;
item = XCAR (list);
It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */
static void
-transpose_markers (EMACS_INT start1, EMACS_INT end1,
- EMACS_INT start2, EMACS_INT end2,
- EMACS_INT start1_byte, EMACS_INT end1_byte,
- EMACS_INT start2_byte, EMACS_INT end2_byte)
+transpose_markers (ptrdiff_t start1, ptrdiff_t end1,
+ ptrdiff_t start2, ptrdiff_t end2,
+ ptrdiff_t start1_byte, ptrdiff_t end1_byte,
+ ptrdiff_t start2_byte, ptrdiff_t end2_byte)
{
- register EMACS_INT amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos;
+ register ptrdiff_t amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos;
register struct Lisp_Marker *marker;
/* Update point as if it were a marker. */
Transposing beyond buffer boundaries is an error. */)
(Lisp_Object startr1, Lisp_Object endr1, Lisp_Object startr2, Lisp_Object endr2, Lisp_Object leave_markers)
{
- register EMACS_INT start1, end1, start2, end2;
- EMACS_INT start1_byte, start2_byte, len1_byte, len2_byte;
- EMACS_INT gap, len1, len_mid, len2;
+ register ptrdiff_t start1, end1, start2, end2;
+ ptrdiff_t start1_byte, start2_byte, len1_byte, len2_byte;
+ ptrdiff_t gap, len1, len_mid, len2;
unsigned char *start1_addr, *start2_addr, *temp;
INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2, tmp_interval3;
Lisp_Object buf;
XSETBUFFER (buf, current_buffer);
- cur_intv = BUF_INTERVALS (current_buffer);
+ cur_intv = buffer_intervals (current_buffer);
validate_region (&startr1, &endr1);
validate_region (&startr2, &endr2);
/* Swap the regions if they're reversed. */
if (start2 < end1)
{
- register EMACS_INT glumph = start1;
+ register ptrdiff_t glumph = start1;
start1 = start2;
start2 = glumph;
glumph = end1;
len1_byte, end2, start2_byte + len2_byte)
|| count_combining_after (BYTE_POS_ADDR (start1_byte),
len1_byte, end2, start2_byte + len2_byte))
- abort ();
+ emacs_abort ();
}
else
{
len2_byte, end1, start1_byte + len1_byte)
|| count_combining_after (BYTE_POS_ADDR (start1_byte),
len1_byte, end2, start2_byte + len2_byte))
- abort ();
+ emacs_abort ();
}
#endif
/* 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. */
{
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
{
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);
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);
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);
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);
#include <config.h>
-#include <signal.h>
#include <errno.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/file.h>
-#include <setjmp.h>
#include <unistd.h>
+#include <ignore-value.h>
+
#include "lisp.h"
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
+
#ifdef WINDOWSNT
#include <fcntl.h>
#include <windows.h> /* just for w32.h */
#include "commands.h"
#include "intervals.h"
+#include "character.h"
#include "buffer.h"
#include "window.h"
#include "systty.h"
+#include "atimer.h"
#include "blockinput.h"
#include "syssignal.h"
#include "process.h"
#include "gnutls.h"
#endif
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
-
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
+#if (defined PROFILING \
+ && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__))
+# include <sys/gmon.h>
+extern void moncontrol (int mode);
#endif
#ifdef HAVE_SETLOCALE
#include <sys/personality.h>
#endif
-#ifdef HAVE_LIBXML2
-#include <libxml/parser.h>
-#endif
-
#ifndef O_RDWR
#define O_RDWR 2
#endif
-#ifdef HAVE_SETPGID
-#if !defined (USG)
-#undef setpgrp
-#define setpgrp setpgid
-#endif
-#endif
-
static const char emacs_version[] = VERSION;
-static const char emacs_copyright[] = "Copyright (C) 2012 Free Software Foundation, Inc.";
-
-/* Make these values available in GDB, which doesn't see macros. */
-
-#ifdef USE_LSB_TAG
-int gdb_use_lsb EXTERNALLY_VISIBLE = 1;
-#else
-int gdb_use_lsb EXTERNALLY_VISIBLE = 0;
-#endif
-#ifndef USE_LISP_UNION_TYPE
-int gdb_use_union EXTERNALLY_VISIBLE = 0;
-#else
-int gdb_use_union EXTERNALLY_VISIBLE = 1;
-#endif
-EMACS_INT gdb_valbits EXTERNALLY_VISIBLE = VALBITS;
-EMACS_INT gdb_gctypebits EXTERNALLY_VISIBLE = GCTYPEBITS;
-#if defined (DATA_SEG_BITS) && ! defined (USE_LSB_TAG)
-EMACS_INT gdb_data_seg_bits EXTERNALLY_VISIBLE = DATA_SEG_BITS;
-#else
-EMACS_INT gdb_data_seg_bits EXTERNALLY_VISIBLE = 0;
-#endif
-EMACS_INT PVEC_FLAG EXTERNALLY_VISIBLE = PSEUDOVECTOR_FLAG;
-EMACS_INT gdb_array_mark_flag EXTERNALLY_VISIBLE = ARRAY_MARK_FLAG;
-/* GDB might say "No enum type named pvec_type" if we don't have at
- least one symbol with that type, and then xbacktrace could fail. */
-enum pvec_type gdb_pvec_type EXTERNALLY_VISIBLE = PVEC_TYPE_MASK;
+static const char emacs_copyright[] = COPYRIGHT;
/* Empty lisp strings. To avoid having to build any others. */
Lisp_Object empty_unibyte_string, empty_multibyte_string;
-/* Set nonzero after Emacs has started up the first time.
- Prevents reinitialization of the Lisp world and keymaps
- on subsequent starts. */
-int initialized;
+#ifdef WINDOWSNT
+/* Cache for externally loaded libraries. */
+Lisp_Object Vlibrary_cache;
+#endif
+
+/* Set after Emacs has started up the first time.
+ Prevents reinitialization of the Lisp world and keymaps
+ on subsequent starts. */
+bool initialized;
#ifdef DARWIN_OS
extern void unexec_init_emacs_zone (void);
extern void *malloc_get_state (void);
/* From glibc, a routine that overwrites the malloc internal state. */
extern int malloc_set_state (void*);
-/* Non-zero if the MALLOC_CHECK_ environment variable was set while
+/* True if the MALLOC_CHECK_ environment variable was set while
dumping. Used to work around a bug in glibc's malloc. */
-static int malloc_using_checking;
+static bool malloc_using_checking;
#endif
Lisp_Object Qfile_name_handler_alist;
Lisp_Object Qkill_emacs;
-/* If non-zero, Emacs should not attempt to use a window-specific code,
+/* If true, Emacs should not attempt to use a window-specific code,
but instead should use the virtual terminal under which it was started. */
-int inhibit_window_system;
+bool inhibit_window_system;
-/* If non-zero, a filter or a sentinel is running. Tested to save the match
+/* If true, a filter or a sentinel is running. Tested to save the match
data on the first attempt to change it inside asynchronous code. */
-int running_asynch_code;
+bool running_asynch_code;
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
-/* If non-zero, -d was specified, meaning we're using some window system. */
-int display_arg;
+/* If true, -d was specified, meaning we're using some window system. */
+bool display_arg;
#endif
/* An address near the bottom of the stack.
static uprintmax_t heap_bss_diff;
#endif
-/* Nonzero means running Emacs without interactive terminal. */
-int noninteractive;
+/* True means running Emacs without interactive terminal. */
+bool noninteractive;
-/* Nonzero means remove site-lisp directories from load-path. */
-int no_site_lisp;
+/* True means remove site-lisp directories from load-path. */
+bool no_site_lisp;
/* Name for the server started by the daemon.*/
static char *daemon_name;
section of the Emacs manual or the file BUGS.\n"
\f
-/* Signal code for the fatal signal that was received. */
-static int fatal_error_code;
-
-/* Nonzero if handling a fatal error already. */
-int fatal_error_in_progress;
-
-/* If non-null, call this function from fatal_error_signal before
- committing suicide. */
-
-static void (*fatal_error_signal_hook) (void);
-
-#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
-/* When compiled with GTK and running under Gnome,
- multiple threads may be created. Keep track of our main
- thread to make sure signals are delivered to it (see syssignal.h). */
-
-pthread_t main_thread;
-#endif
+/* True if handling a fatal error already. */
+bool fatal_error_in_progress;
#ifdef HAVE_NS
/* NS autrelease pool, for memory management. */
static void *ns_pool;
-#endif
+#endif
-
-/* Handle bus errors, invalid instruction, etc. */
-#ifndef FLOAT_CATCH_SIGILL
-static
-#endif
-void
-fatal_error_signal (int sig)
+
+/* Report a fatal error due to signal SIG, output a backtrace of at
+ most BACKTRACE_LIMIT lines, and exit. */
+_Noreturn void
+terminate_due_to_signal (int sig, int backtrace_limit)
{
- SIGNAL_THREAD_CHECK (sig);
- fatal_error_code = sig;
signal (sig, SIG_DFL);
-
- TOTALLY_UNBLOCK_INPUT;
+ totally_unblock_input ();
/* If fatal error occurs in code below, avoid infinite recursion. */
if (! fatal_error_in_progress)
if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
Fkill_emacs (make_number (sig));
- shut_down_emacs (sig, 0, Qnil);
+ shut_down_emacs (sig, Qnil);
+ emacs_backtrace (backtrace_limit);
}
/* Signal the same code; this time it will really be fatal.
- Remember that since we're in a signal handler, the signal we're
- going to send is probably blocked, so we have to unblock it if we
- want to really receive it. */
+ Since we're in a signal handler, the signal is blocked, so we
+ have to unblock it if we want to really receive it. */
#ifndef MSDOS
- sigunblock (sigmask (fatal_error_code));
+ {
+ sigset_t unblocked;
+ sigemptyset (&unblocked);
+ sigaddset (&unblocked, sig);
+ pthread_sigmask (SIG_UNBLOCK, &unblocked, 0);
+ }
#endif
- if (fatal_error_signal_hook)
- fatal_error_signal_hook ();
+ emacs_raise (sig);
- kill (getpid (), fatal_error_code);
+ /* This shouldn't be executed, but it prevents a warning. */
+ exit (1);
}
#ifdef SIGDANGER
/* Handler for SIGDANGER. */
-void
-memory_warning_signal (int sig)
+static void
+handle_danger_signal (int sig)
{
- signal (sig, memory_warning_signal);
- SIGNAL_THREAD_CHECK (sig);
-
malloc_warning ("Operating system warns that virtual memory is running low.\n");
/* It might be unsafe to call do_auto_save now. */
force_auto_save_soon ();
}
-#endif
-
-/* We define abort, rather than using it from the library,
- so that GDB can return from a breakpoint here.
- MSDOS has its own definition in msdos.c. */
-#if ! defined (DOS_NT) && ! defined (NO_ABORT)
-
-void
-abort (void)
+static void
+deliver_danger_signal (int sig)
{
- kill (getpid (), SIGABRT);
- /* This shouldn't be executed, but it prevents a warning. */
- exit (1);
+ deliver_process_signal (sig, handle_danger_signal);
}
#endif
-
\f
/* Code for dealing with Lisp access to the Unix command line. */
{
register int i;
Lisp_Object name, dir, handler;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object raw_name;
initial_argv = argv;
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)
{
/* Define a dummy function F. Declare F too, to pacify gcc
-Wmissing-prototypes. */
#define DEFINE_DUMMY_FUNCTION(f) \
- void f (void) EXTERNALLY_VISIBLE; void f (void) {}
+ void f (void) ATTRIBUTE_CONST EXTERNALLY_VISIBLE; void f (void) {}
#ifndef GCC_CTORS_IN_LIBC
DEFINE_DUMMY_FUNCTION (__do_global_ctors)
Too bad we can't just use getopt for all of this, but we don't have
enough information to do it right. */
-static int
+static bool
argmatch (char **argv, int argc, const char *sstr, const char *lstr,
int minlen, char **valptr, int *skipptr)
{
static void
malloc_initialize_hook (void)
{
-#ifndef USE_CRT_DLL
- extern char **environ;
-#endif
-
if (initialized)
{
if (!malloc_using_checking)
Lisp_Object dummy;
#endif
char stack_bottom_variable;
- int do_initial_setlocale;
+ bool do_initial_setlocale;
+ bool dumping;
int skip_args = 0;
#ifdef HAVE_SETRLIMIT
struct rlimit rlim;
#endif
- int no_loadup = 0;
+ bool no_loadup = 0;
char *junk = 0;
char *dname_arg = 0;
#ifdef NS_IMPL_COCOA
exit (1);
}
+ dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0
+ || strcmp (argv[argc - 1], "bootstrap") == 0);
#ifdef HAVE_PERSONALITY_LINUX32
- if (!initialized
- && (strcmp (argv[argc-1], "dump") == 0
- || strcmp (argv[argc-1], "bootstrap") == 0)
- && ! getenv ("EMACS_HEAP_EXEC"))
+ if (dumping && ! getenv ("EMACS_HEAP_EXEC"))
{
static char heapexec[] = "EMACS_HEAP_EXEC=true";
/* Set this so we only do this once. */
/* Arrange to get warning messages as memory fills up. */
memory_warnings (0, malloc_warning);
- /* Call malloc at least once, to run the initial __malloc_hook.
+ /* Call malloc at least once, to run malloc_initialize_hook.
Also call realloc and free for consistency. */
free (realloc (malloc (4), 4));
-# ifndef SYNC_INPUT
- /* Arrange to disable interrupt input inside malloc etc. */
- uninterrupt_malloc ();
-# endif /* not SYNC_INPUT */
#endif /* not SYSTEM_MALLOC */
-#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
- main_thread = pthread_self ();
-#endif /* FORWARD_SIGNAL_TO_MAIN_THREAD */
-
#if defined (MSDOS) || defined (WINDOWSNT)
/* We do all file input/output as binary files. When we need to translate
newlines, we do that manually. */
#endif
}
- init_signals ();
-
- /* Don't catch SIGHUP if dumping. */
- if (1
-#ifndef CANNOT_DUMP
- && initialized
-#endif
- )
- {
- sigblock (sigmask (SIGHUP));
- /* In --batch mode, don't catch SIGHUP if already ignored.
- That makes nohup work. */
- if (! noninteractive
- || signal (SIGHUP, SIG_IGN) != SIG_IGN)
- signal (SIGHUP, fatal_error_signal);
- sigunblock (sigmask (SIGHUP));
- }
-
- if (
-#ifndef CANNOT_DUMP
- ! noninteractive || initialized
-#else
- 1
-#endif
- )
- {
- /* Don't catch these signals in batch mode if dumping.
- On some machines, this sets static data that would make
- signal fail to work right when the dumped Emacs is run. */
- signal (SIGQUIT, fatal_error_signal);
- signal (SIGILL, fatal_error_signal);
- signal (SIGTRAP, fatal_error_signal);
-#ifdef SIGUSR1
- add_user_signal (SIGUSR1, "sigusr1");
-#endif
-#ifdef SIGUSR2
- add_user_signal (SIGUSR2, "sigusr2");
-#endif
-#ifdef SIGABRT
- signal (SIGABRT, fatal_error_signal);
-#endif
-#ifdef SIGHWE
- signal (SIGHWE, fatal_error_signal);
-#endif
-#ifdef SIGPRE
- signal (SIGPRE, fatal_error_signal);
-#endif
-#ifdef SIGORE
- signal (SIGORE, fatal_error_signal);
-#endif
-#ifdef SIGUME
- signal (SIGUME, fatal_error_signal);
-#endif
-#ifdef SIGDLK
- signal (SIGDLK, fatal_error_signal);
-#endif
-#ifdef SIGCPULIM
- signal (SIGCPULIM, fatal_error_signal);
-#endif
-#ifdef SIGIOT
- /* This is missing on some systems - OS/2, for example. */
- signal (SIGIOT, fatal_error_signal);
-#endif
-#ifdef SIGEMT
- signal (SIGEMT, fatal_error_signal);
-#endif
- signal (SIGFPE, fatal_error_signal);
-#ifdef SIGBUS
- signal (SIGBUS, fatal_error_signal);
-#endif
- signal (SIGSEGV, fatal_error_signal);
-#ifdef SIGSYS
- signal (SIGSYS, fatal_error_signal);
-#endif
- /* May need special treatment on MS-Windows. See
- http://lists.gnu.org/archive/html/emacs-devel/2010-09/msg01062.html
- Please update the doc of kill-emacs, kill-emacs-hook, and
- NEWS if you change this.
- */
- if (noninteractive) signal (SIGINT, fatal_error_signal);
- signal (SIGTERM, fatal_error_signal);
-#ifdef SIGXCPU
- signal (SIGXCPU, fatal_error_signal);
-#endif
-#ifdef SIGXFSZ
- signal (SIGXFSZ, fatal_error_signal);
-#endif /* SIGXFSZ */
-
-#ifdef SIGDANGER
- /* This just means available memory is getting low. */
- signal (SIGDANGER, memory_warning_signal);
-#endif
-
-#ifdef AIX
-/* 20 is SIGCHLD, 21 is SIGTTIN, 22 is SIGTTOU. */
- signal (SIGXCPU, fatal_error_signal);
- signal (SIGIOINT, fatal_error_signal);
- signal (SIGGRANT, fatal_error_signal);
- signal (SIGRETRACT, fatal_error_signal);
- signal (SIGSOUND, fatal_error_signal);
- signal (SIGMSG, fatal_error_signal);
-#endif /* AIX */
- }
+ init_signals (dumping);
noninteractive1 = noninteractive;
init_alloc_once ();
init_obarray ();
init_eval_once ();
- init_character_once ();
init_charset_once ();
init_coding_once ();
init_syntax_once (); /* Create standard syntax table. */
}
init_eval ();
- init_data ();
-#ifdef CLASH_DETECTION
- init_filelock ();
-#endif
init_atimer ();
running_asynch_code = 0;
+ init_random ();
no_loadup
= argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args);
globals_of_w32 ();
/* Initialize environment from registry settings. */
init_environment (argv);
- init_ntproc (); /* must precede init_editfns. */
-#endif
-
-#ifdef HAVE_NS
-#ifndef CANNOT_DUMP
- if (initialized)
-#endif
- ns_init_paths ();
+ init_ntproc (dumping); /* must precede init_editfns. */
#endif
/* Initialize and GC-protect Vinitial_environment and
/* egetenv is a pretty low-level facility, which may get called in
many circumstances; it seems flimsy to put off initializing it
until calling init_callproc. Do not do it when dumping. */
- if (initialized || ((strcmp (argv[argc-1], "dump") != 0
- && strcmp (argv[argc-1], "bootstrap") != 0)))
+ if (! dumping)
set_initial_environment ();
/* AIX crashes are reported in system versions 3.2.3 and 3.2.4
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. */
syms_of_ntterm ();
#endif /* WINDOWSNT */
+ syms_of_profiler ();
+
keys_of_casefiddle ();
keys_of_cmds ();
keys_of_buffer ();
init_charset ();
- init_editfns (); /* init_process uses Voperating_system_release. */
- init_process (); /* init_display uses add_keyboard_wait_descriptor. */
+ init_editfns (); /* init_process_emacs uses Voperating_system_release. */
+ init_process_emacs (); /* init_display uses add_keyboard_wait_descriptor. */
init_keyboard (); /* This too must precede init_sys_modes. */
if (!noninteractive)
init_display (); /* Determine terminal type. Calls init_sys_modes. */
- init_fns ();
init_xdisp ();
#ifdef HAVE_WINDOW_SYSTEM
init_fringe ();
- init_image ();
#endif /* HAVE_WINDOW_SYSTEM */
init_macros ();
- init_floatfns ();
-#ifdef HAVE_SOUND
- init_sound ();
-#endif
init_window ();
init_font ();
#ifdef PROFILING
if (initialized)
{
- extern void _mcleanup ();
#ifdef __MINGW32__
extern unsigned char etext asm ("etext");
#else
extern char etext;
#endif
-#ifdef HAVE___EXECUTABLE_START
- /* This symbol is defined by GNU ld to the start of the text
- segment. */
- extern char __executable_start[];
-#else
- extern void safe_bcopy ();
-#endif
atexit (_mcleanup);
-#ifdef HAVE___EXECUTABLE_START
- monstartup (__executable_start, &etext);
-#else
- /* This uses safe_bcopy because that function comes first in the
- Emacs executable. It might be better to use something that
- gives the start of the text segment, but start_of_text is not
- defined on all systems now. */
- /* FIXME: Does not work on architectures with function
- descriptors. */
- monstartup (safe_bcopy, &etext);
-#endif
+ monstartup ((uintptr_t) __executable_start, (uintptr_t) &etext);
}
else
moncontrol (0);
static void
sort_args (int argc, char **argv)
{
- char **new = (char **) xmalloc (sizeof (char *) * argc);
+ char **new = xmalloc (argc * sizeof *new);
/* For each element of argv,
the corresponding element of options is:
0 for an option that takes no arguments,
}
if (best < 0)
- abort ();
+ emacs_abort ();
/* Copy the highest priority remaining option, with its args, to NEW.
Unless it is a duplicate of the previous one. */
x_clipboard_manager_save_all ();
#endif
- shut_down_emacs (0, 0, STRINGP (arg) ? arg : Qnil);
+ shut_down_emacs (0, STRINGP (arg) ? arg : Qnil);
#ifdef HAVE_NS
ns_release_autorelease_pool (ns_pool);
if (STRINGP (Vauto_save_list_file_name))
unlink (SSDATA (Vauto_save_list_file_name));
- exit_code = EXIT_SUCCESS;
- if (noninteractive && (fflush (stdout) || ferror (stdout)))
+ if (INTEGERP (arg))
+ exit_code = (XINT (arg) < 0
+ ? XINT (arg) | INT_MIN
+ : XINT (arg) & INT_MAX);
+ else if (noninteractive && (fflush (stdout) || ferror (stdout)))
exit_code = EXIT_FAILURE;
- exit (INTEGERP (arg) ? XINT (arg) : exit_code);
+ else
+ exit_code = EXIT_SUCCESS;
+ exit (exit_code);
}
and Fkill_emacs. */
void
-shut_down_emacs (int sig, int no_x, Lisp_Object stuff)
+shut_down_emacs (int sig, Lisp_Object stuff)
{
/* Prevent running of hooks from now on. */
Vrun_hooks = Qnil;
{
reset_all_sys_modes ();
if (sig && sig != SIGTERM)
- fprintf (stderr, "Fatal error (%d)", sig);
+ {
+ static char const format[] = "Fatal error %d: ";
+ char buf[sizeof format - 2 + INT_STRLEN_BOUND (int)];
+ int buflen = sprintf (buf, format, sig);
+ char const *sig_desc = strsignal (sig);
+ ignore_value (write (STDERR_FILENO, buf, buflen));
+ ignore_value (write (STDERR_FILENO, sig_desc, strlen (sig_desc)));
+ }
}
}
#else
unlock_all_files ();
#endif
-#if 0 /* This triggers a bug in XCloseDisplay and is not needed. */
-#ifdef HAVE_X_WINDOWS
- /* It's not safe to call intern here. Maybe we are crashing. */
- if (!noninteractive && SYMBOLP (Vinitial_window_system)
- && SCHARS (SYMBOL_NAME (Vinitial_window_system)) == 1
- && SREF (SYMBOL_NAME (Vinitial_window_system), 0) == 'x'
- && ! no_x)
- Fx_close_current_connection ();
-#endif /* HAVE_X_WINDOWS */
-#endif
-
-#ifdef SIGIO
/* There is a tendency for a SIGIO signal to arrive within exit,
and cause a SIGHUP because the input descriptor is already closed. */
unrequest_sigio ();
- signal (SIGIO, SIG_IGN);
-#endif
+ ignore_sigio ();
#ifdef WINDOWSNT
- term_ntproc ();
+ term_ntproc (0);
#endif
/* Do this only if terminating normally, we want glyph matrices
#endif
#ifdef HAVE_LIBXML2
- xmlCleanupParser ();
+ xml_cleanup_parser ();
#endif
}
{
Lisp_Object tem;
Lisp_Object symbol;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
check_pure_size ();
memory_warnings (my_edata, malloc_warning);
}
#endif /* not WINDOWSNT */
-#if defined (HAVE_PTHREAD) && !defined SYNC_INPUT
- /* Pthread may call malloc before main, and then we will get an endless
- loop, because pthread_self (see alloc.c) calls malloc the first time
- it is called on some systems. */
- reset_malloc_hooks ();
-#endif
#endif /* not SYSTEM_MALLOC */
#ifdef DOUG_LEA_MALLOC
malloc_state_ptr = malloc_get_state ();
free (malloc_state_ptr);
#endif
+#ifdef WINDOWSNT
+ Vlibrary_cache = Qnil;
+#endif
+#ifdef HAVE_WINDOW_SYSTEM
+ reset_image_types ();
+#endif
+
Vpurify_flag = tem;
return unbind_to (count, Qnil);
}
#endif /* HAVE_SETLOCALE */
\f
-#ifndef SEPCHAR
-#define SEPCHAR ':'
-#endif
Lisp_Object
decode_env_path (const char *evarname, const char *defalt)
{
const char *path, *p;
Lisp_Object lpath, element, tem;
+#ifdef WINDOWSNT
+ bool 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
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)
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. */
(void)
{
int nfd;
- int err = 0;
+ bool err = 0;
if (!IS_DAEMON)
error ("This function can only be called if emacs is run as a daemon");
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.
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,
Vdynamic_library_alist = Qnil;
Fput (intern_c_string ("dynamic-library-alist"), Qrisky_local_variable, Qt);
+#ifdef WINDOWSNT
+ Vlibrary_cache = Qnil;
+ staticpro (&Vlibrary_cache);
+#endif
+
/* Make sure IS_DAEMON starts up as false. */
daemon_pipe[1] = 0;
}
#include <config.h>
#include "emacsgtkfixed.h"
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "frame.h"
#include "xterm.h"
+/* Silence a bogus diagnostic; see GNOME bug 683906. */
+#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic push
+# pragma GCC diagnostic ignored "-Wunused-local-typedefs"
+#endif
+
+#define EMACS_TYPE_FIXED emacs_fixed_get_type ()
+#define EMACS_FIXED(obj) \
+ G_TYPE_CHECK_INSTANCE_CAST (obj, EMACS_TYPE_FIXED, EmacsFixed)
+
+typedef struct _EmacsFixed EmacsFixed;
+typedef struct _EmacsFixedPrivate EmacsFixedPrivate;
+typedef struct _EmacsFixedClass EmacsFixedClass;
+
+struct _EmacsFixed
+{
+ GtkFixed container;
+
+ /*< private >*/
+ EmacsFixedPrivate *priv;
+};
+
+struct _EmacsFixedClass
+{
+ GtkFixedClass parent_class;
+};
+
struct _EmacsFixedPrivate
{
struct frame *f;
static void emacs_fixed_get_preferred_height (GtkWidget *widget,
gint *minimum,
gint *natural);
+static GType emacs_fixed_get_type (void);
G_DEFINE_TYPE (EmacsFixed, emacs_fixed, GTK_TYPE_FIXED)
static void
emacs_fixed_class_init (EmacsFixedClass *klass)
{
GtkWidgetClass *widget_class;
- GtkFixedClass *fixed_class;
widget_class = (GtkWidgetClass*) klass;
- fixed_class = (GtkFixedClass*) klass;
widget_class->get_preferred_width = emacs_fixed_get_preferred_width;
widget_class->get_preferred_height = emacs_fixed_get_preferred_height;
g_type_class_add_private (klass, sizeof (EmacsFixedPrivate));
}
-static GType
-emacs_fixed_child_type (GtkFixed *container)
-{
- return GTK_TYPE_WIDGET;
-}
-
static void
emacs_fixed_init (EmacsFixed *fixed)
{
struct frame;
-#define EMACS_TYPE_FIXED (emacs_fixed_get_type ())
-#define EMACS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), EMACS_TYPE_FIXED, EmacsFixed))
-#define EMACS_FIXED_CLASS(klass) (G_TYPE_CHECK_CLASS_CAST ((klass), EMACS_TYPE_FIXED, EmacsFixedClass))
-#define EMACS_IS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), EMACS_TYPE_FIXED))
-#define EMACS_IS_FIXED_CLASS(klass) (G_TYPE_CHECK_CLASS_TYPE ((klass), EMACS_TYPE_FIXED))
-#define EMACS_FIXED_GET_CLASS(obj) (G_TYPE_INSTANCE_GET_CLASS ((obj), EMACS_TYPE_FIXED, EmacsFixedClass))
-
-typedef struct _EmacsFixed EmacsFixed;
-typedef struct _EmacsFixedPrivate EmacsFixedPrivate;
-typedef struct _EmacsFixedClass EmacsFixedClass;
-
-struct _EmacsFixed
-{
- GtkFixed container;
-
- /*< private >*/
- EmacsFixedPrivate *priv;
-};
-
-
-struct _EmacsFixedClass
-{
- GtkFixedClass parent_class;
-};
-
extern GtkWidget *emacs_fixed_new (struct frame *f);
-extern GType emacs_fixed_get_type (void);
G_END_DECLS
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-/* The default value of load-path, which is the search path for
- the Lisp function "load". Configure (using "make epaths-force")
- sets this to $lisppath, which typically has a value like:
- <datadir>/emacs/VERSION/site-lisp:<datadir>/emacs/site-lisp:
+/* Together with PATH_SITELOADSEARCH, this gives the default value of
+ load-path, which is the search path for the Lisp function "load".
+ Configure (using "make epaths-force") sets this to
+ ${standardlisppath}, which typically has a value like:
<datadir>/emacs/VERSION/lisp:<datadir>/emacs/VERSION/leim
where datadir is eg /usr/local/share.
+*/
+#define PATH_LOADSEARCH "/usr/local/share/emacs/lisp"
+
+
+/* Like PATH_LOADSEARCH, but contains the non-standard pieces.
+ These are the site-lisp directories, typically something like
+ <datadir>/emacs/VERSION/site-lisp:<datadir>/emacs/site-lisp
Configure prepends any $locallisppath, as set by the
--enable-locallisppath argument.
+ This is combined with PATH_LOADSEARCH to make the default load-path.
+ If the --no-site-lisp option is used, this piece is excluded.
*/
-#define PATH_LOADSEARCH "/usr/local/share/emacs/lisp"
+#define PATH_SITELOADSEARCH "/usr/local/share/emacs/site-lisp"
+
/* Like PATH_LOADSEARCH, but used only during the build process
when Emacs is dumping. Configure (using "make epaths-force") sets
#include <config.h>
#include <limits.h>
-#include <setjmp.h>
#include <stdio.h>
#include "lisp.h"
#include "blockinput.h"
#include "xterm.h"
#endif
-struct backtrace
-{
- struct backtrace *next;
- Lisp_Object *function;
- Lisp_Object *args; /* Points to vector of args. */
- ptrdiff_t nargs; /* Length of vector. */
- /* Nonzero means call value of debugger when done with this operation. */
- unsigned int debug_on_exit : 1;
-};
-
-static struct backtrace *backtrace_list;
+struct backtrace *backtrace_list;
#if !BYTE_MARK_STACK
static
int gcpro_level;
#endif
-Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
+Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp;
Lisp_Object Qinhibit_quit;
Lisp_Object Qand_rest;
static Lisp_Object Qand_optional;
-static Lisp_Object Qdebug_on_error;
+static Lisp_Object Qinhibit_debugger;
static Lisp_Object Qdeclare;
Lisp_Object Qinternal_interpreter_environment, Qclosure;
/* Current number of specbindings allocated in specpdl. */
-EMACS_INT specpdl_size;
+ptrdiff_t specpdl_size;
/* Pointer to beginning of specpdl. */
signal the error instead of entering an infinite loop of debugger
invocations. */
-static int when_entered_debugger;
+static EMACS_INT when_entered_debugger;
/* The function from which the last `signal' was called. Set in
Fsignal. */
Lisp_Object Vsignaling_function;
-/* Set to non-zero while processing X events. Checked in Feval to
- make sure the Lisp interpreter isn't called from a signal handler,
- which is unsafe because the interpreter isn't reentrant. */
-
-int handling_signal;
-
/* If non-nil, Lisp code must not be run since some part of Emacs is
in an inconsistent state. Currently, x-create-frame uses this to
avoid triggering window-configuration-change-hook while the new
Lisp_Object inhibit_lisp_code;
static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
-static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
-static int interactive_p (int);
+static bool interactive_p (void);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
-static Lisp_Object Ffetch_bytecode (Lisp_Object);
-\f
+
+/* Functions to set Lisp_Object slots of struct specbinding. */
+
+static inline void
+set_specpdl_symbol (Lisp_Object symbol)
+{
+ specpdl_ptr->symbol = symbol;
+}
+
+static inline void
+set_specpdl_old_value (Lisp_Object oldval)
+{
+ specpdl_ptr->old_value = oldval;
+}
+
void
init_eval_once (void)
{
enum { size = 50 };
- specpdl = (struct specbinding *) xmalloc (size * sizeof (struct specbinding));
+ specpdl = xmalloc (size * sizeof *specpdl);
specpdl_size = size;
specpdl_ptr = specpdl;
/* Don't forget to update docs (lispref node "Local Variables"). */
/* Call the Lisp debugger, giving it argument ARG. */
-static Lisp_Object
+Lisp_Object
call_debugger (Lisp_Object arg)
{
- int debug_while_redisplaying;
- int count = SPECPDL_INDEX ();
+ bool debug_while_redisplaying;
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
EMACS_INT old_max = max_specpdl_size;
specbind (intern ("debugger-may-continue"),
debug_while_redisplaying ? Qnil : Qt);
specbind (Qinhibit_redisplay, Qnil);
- specbind (Qdebug_on_error, Qnil);
+ specbind (Qinhibit_debugger, Qt);
#if 0 /* Binding this prevents execution of Lisp code during
redisplay, which necessarily leads to display problems. */
Lisp_Object val;
register Lisp_Object args_left;
struct gcpro gcpro1, gcpro2;
- register int argnum = 0;
-
- if (NILP (args))
- return Qnil;
args_left = args;
val = Qnil;
GCPRO2 (args, val);
- do
- {
- Lisp_Object tem = eval_sub (XCAR (args_left));
- if (!(argnum++))
- val = tem;
- args_left = XCDR (args_left);
- }
- while (CONSP (args_left));
+ val = eval_sub (XCAR (args_left));
+ while (CONSP (args_left = XCDR (args_left)))
+ eval_sub (XCAR (args_left));
UNGCPRO;
return val;
usage: (prog2 FORM1 FORM2 BODY...) */)
(Lisp_Object args)
{
- Lisp_Object val;
- register Lisp_Object args_left;
- struct gcpro gcpro1, gcpro2;
- register int argnum = -1;
-
- val = Qnil;
-
- if (NILP (args))
- return Qnil;
-
- args_left = args;
- val = Qnil;
- GCPRO2 (args, val);
-
- do
- {
- Lisp_Object tem = eval_sub (XCAR (args_left));
- if (!(argnum++))
- val = tem;
- args_left = XCDR (args_left);
- }
- while (CONSP (args_left));
+ struct gcpro gcpro1;
+ GCPRO1 (args);
+ eval_sub (XCAR (args));
UNGCPRO;
- return val;
+ return Fprog1 (XCDR (args));
}
DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
use `called-interactively-p'. */)
(void)
{
- return interactive_p (1) ? Qt : Qnil;
+ return interactive_p () ? Qt : Qnil;
}
\(not (or executing-kbd-macro noninteractive)). */)
(Lisp_Object kind)
{
- return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
- && interactive_p (1)) ? Qt : Qnil;
+ return (((INTERACTIVE || !EQ (kind, intern ("interactive")))
+ && interactive_p ())
+ ? Qt : Qnil);
}
-/* Return 1 if function in which this appears was called using
- call-interactively.
+/* Return true if function in which this appears was called using
+ call-interactively and is not a built-in. */
- EXCLUDE_SUBRS_P non-zero means always return 0 if the function
- called is a built-in. */
-
-static int
-interactive_p (int exclude_subrs_p)
+static bool
+interactive_p (void)
{
struct backtrace *btp;
Lisp_Object fun;
/* `btp' now points at the frame of the innermost function that isn't
a special form, ignoring frames for Finteractive_p and/or
Fbytecode at the top. If this frame is for a built-in function
- (such as load or eval-region) return nil. */
+ (such as load or eval-region) return false. */
fun = Findirect_function (*btp->function, Qnil);
- if (exclude_subrs_p && SUBRP (fun))
+ if (SUBRP (fun))
return 0;
/* `btp' points to the frame of a Lisp function that called interactive-p.
}
-DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
- doc: /* Define NAME as a function.
-The definition is (lambda ARGLIST [DOCSTRING] BODY...).
-See also the function `interactive'.
-usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
- (Lisp_Object args)
-{
- register Lisp_Object fn_name;
- register Lisp_Object defn;
-
- fn_name = Fcar (args);
- CHECK_SYMBOL (fn_name);
- defn = Fcons (Qlambda, Fcdr (args));
- if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */
- defn = Ffunction (Fcons (defn, Qnil));
- if (!NILP (Vpurify_flag))
- defn = Fpurecopy (defn);
- if (CONSP (XSYMBOL (fn_name)->function)
- && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
- LOADHIST_ATTACH (Fcons (Qt, fn_name));
- Ffset (fn_name, defn);
- LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
- return fn_name;
-}
-
-DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
- doc: /* Define NAME as a macro.
-The actual definition looks like
- (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
-When the macro is called, as in (NAME ARGS...),
-the function (lambda ARGLIST BODY...) is applied to
-the list ARGS... as it appears in the expression,
-and the result should be a form to be evaluated instead of the original.
-
-DECL is a declaration, optional, which can specify how to indent
-calls to this macro, how Edebug should handle it, and which argument
-should be treated as documentation. It looks like this:
- (declare SPECS...)
-The elements can look like this:
- (indent INDENT)
- Set NAME's `lisp-indent-function' property to INDENT.
-
- (debug DEBUG)
- Set NAME's `edebug-form-spec' property to DEBUG. (This is
- equivalent to writing a `def-edebug-spec' for the macro.)
-
- (doc-string ELT)
- Set NAME's `doc-string-elt' property to ELT.
-
-usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
- (Lisp_Object args)
-{
- register Lisp_Object fn_name;
- register Lisp_Object defn;
- Lisp_Object lambda_list, doc, tail;
-
- fn_name = Fcar (args);
- CHECK_SYMBOL (fn_name);
- lambda_list = Fcar (Fcdr (args));
- tail = Fcdr (Fcdr (args));
-
- doc = Qnil;
- if (STRINGP (Fcar (tail)))
- {
- doc = XCAR (tail);
- tail = XCDR (tail);
- }
-
- if (CONSP (Fcar (tail))
- && EQ (Fcar (Fcar (tail)), Qdeclare))
- {
- if (!NILP (Vmacro_declaration_function))
- {
- struct gcpro gcpro1;
- GCPRO1 (args);
- call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
- UNGCPRO;
- }
-
- tail = Fcdr (tail);
- }
-
- if (NILP (doc))
- tail = Fcons (lambda_list, tail);
- else
- tail = Fcons (lambda_list, Fcons (doc, tail));
-
- defn = Fcons (Qlambda, tail);
- if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */
- defn = Ffunction (Fcons (defn, Qnil));
- defn = Fcons (Qmacro, defn);
-
- if (!NILP (Vpurify_flag))
- defn = Fpurecopy (defn);
- if (CONSP (XSYMBOL (fn_name)->function)
- && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
- LOADHIST_ATTACH (Fcons (Qt, fn_name));
- Ffset (fn_name, defn);
- LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
- return fn_name;
-}
-
-
DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
Aliased variables always have the same value; setting one sets the other.
{
struct specbinding *p;
- for (p = specpdl_ptr - 1; p >= specpdl; p--)
- if (p->func == NULL
+ for (p = specpdl_ptr; p > specpdl; )
+ if ((--p)->func == NULL
&& (EQ (new_alias,
CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
error ("Don't know how to make a let-bound variable an alias");
variable.
To define a user option, use `defcustom' instead of `defvar'.
-The function `user-variable-p' also identifies a variable as a user
-option if its DOCSTRING starts with *, but this behavior is obsolete.
usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
(Lisp_Object args)
{
/* Do it before evaluating the initial value, for self-references. */
XSYMBOL (sym)->declared_special = 1;
- if (SYMBOL_CONSTANT_P (sym))
- {
- /* For upward compatibility, allow (defvar :foo (quote :foo)). */
- Lisp_Object tem1 = Fcar (tail);
- if (! (CONSP (tem1)
- && EQ (XCAR (tem1), Qquote)
- && CONSP (XCDR (tem1))
- && EQ (XCAR (XCDR (tem1)), sym)))
- error ("Constant symbol `%s' specified in defvar",
- SDATA (SYMBOL_NAME (sym)));
- }
-
if (NILP (tem))
Fset_default (sym, eval_sub (Fcar (tail)));
else
{ /* Check if there is really a global binding rather than just a let
binding that shadows the global unboundness of the var. */
- volatile struct specbinding *pdl = specpdl_ptr;
- while (--pdl >= specpdl)
+ struct specbinding *pdl = specpdl_ptr;
+ while (pdl > specpdl)
{
- if (EQ (pdl->symbol, sym) && !pdl->func
+ if (EQ ((--pdl)->symbol, sym) && !pdl->func
&& EQ (pdl->old_value, Qunbound))
{
message_with_string ("Warning: defvar ignored because %s is let-bound",
return sym;
}
-/* Error handler used in Fuser_variable_p. */
-static Lisp_Object
-user_variable_p_eh (Lisp_Object ignore)
+/* Make SYMBOL lexically scoped. */
+DEFUN ("internal-make-var-non-special", Fmake_var_non_special,
+ Smake_var_non_special, 1, 1, 0,
+ doc: /* Internal function. */)
+ (Lisp_Object symbol)
{
+ CHECK_SYMBOL (symbol);
+ XSYMBOL (symbol)->declared_special = 0;
return Qnil;
}
-static Lisp_Object
-lisp_indirect_variable (Lisp_Object sym)
-{
- struct Lisp_Symbol *s = indirect_variable (XSYMBOL (sym));
- XSETSYMBOL (sym, s);
- return sym;
-}
-
-DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
- doc: /* Return t if VARIABLE is intended to be set and modified by users.
-\(The alternative is a variable used internally in a Lisp program.)
-
-This function returns t if (i) the first character of its
-documentation is `*', or (ii) it is customizable (its property list
-contains a non-nil value of `standard-value' or `custom-autoload'), or
-\(iii) it is an alias for a user variable.
-
-But condition (i) is considered obsolete, so for most purposes this is
-equivalent to `custom-variable-p'. */)
- (Lisp_Object variable)
-{
- Lisp_Object documentation;
-
- if (!SYMBOLP (variable))
- return Qnil;
-
- /* If indirect and there's an alias loop, don't check anything else. */
- if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
- && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
- Qt, user_variable_p_eh)))
- return Qnil;
-
- while (1)
- {
- documentation = Fget (variable, Qvariable_documentation);
- if (INTEGERP (documentation) && XINT (documentation) < 0)
- return Qt;
- if (STRINGP (documentation)
- && ((unsigned char) SREF (documentation, 0) == '*'))
- return Qt;
- /* If it is (STRING . INTEGER), a negative integer means a user variable. */
- if (CONSP (documentation)
- && STRINGP (XCAR (documentation))
- && INTEGERP (XCDR (documentation))
- && XINT (XCDR (documentation)) < 0)
- return Qt;
- /* Customizable? See `custom-variable-p'. */
- if ((!NILP (Fget (variable, intern ("standard-value"))))
- || (!NILP (Fget (variable, intern ("custom-autoload")))))
- return Qt;
-
- if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
- return Qnil;
-
- /* An indirect variable? Let's follow the chain. */
- XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
- }
-}
\f
DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
doc: /* Bind variables according to VARLIST then eval BODY.
(Lisp_Object args)
{
Lisp_Object varlist, var, val, elt, lexenv;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (args, elt, varlist);
{
Lisp_Object *temps, tem, lexenv;
register Lisp_Object elt, varlist;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t argnum;
struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
{
/* SYM is not mentioned in ENVIRONMENT.
Look at its function definition. */
+ struct gcpro gcpro1;
+ GCPRO1 (form);
+ def = Fautoload_do_load (def, sym, Qmacro);
+ UNGCPRO;
if (EQ (def, Qunbound) || !CONSP (def))
/* Not defined or definition not suitable. */
break;
- if (EQ (XCAR (def), Qautoload))
- {
- /* Autoloading function: will it be a macro when loaded? */
- tem = Fnth (make_number (4), def);
- if (EQ (tem, Qt) || EQ (tem, Qmacro))
- /* Yes, load it and try again. */
- {
- struct gcpro gcpro1;
- GCPRO1 (form);
- do_autoload (def, sym);
- UNGCPRO;
- continue;
- }
- else
- break;
- }
- else if (!EQ (XCAR (def), Qmacro))
+ if (!EQ (XCAR (def), Qmacro))
break;
else expander = XCDR (def);
}
if (NILP (expander))
break;
}
- form = apply1 (expander, XCDR (form));
+ {
+ Lisp_Object newform = apply1 (expander, XCDR (form));
+ if (EQ (form, newform))
+ break;
+ else
+ form = newform;
+ }
}
return form;
}
catchlist = &c;
/* Call FUNC. */
- if (! _setjmp (c.jmp))
+ if (! sys_setjmp (c.jmp))
c.val = (*func) (arg);
/* Throw works by a longjmp that comes right here. */
/* Unwind the specbind, catch, and handler stacks back to CATCH, and
jump to that CATCH, returning VALUE as the value of that catch.
- This is the guts Fthrow and Fsignal; they differ only in the way
+ This is the guts of Fthrow and Fsignal; they differ only in the way
they choose the catch tag to throw to. A catch tag for a
condition-case form has a TAG of Qnil.
the handler stack as we go, so that the proper handlers are in
effect for each unwind-protect clause we run. At the end, restore
some static info saved in CATCH, and longjmp to the location
- specified in the
+ specified there.
This is used for correct unwinding in Fthrow and Fsignal. */
-static void
+static _Noreturn void
unwind_to_catch (struct catchtag *catch, Lisp_Object value)
{
- register int last_time;
+ bool last_time;
/* Save the value in the tag. */
catch->val = value;
/* Restore certain special C variables. */
set_poll_suppress_count (catch->poll_suppress_count);
- UNBLOCK_INPUT_TO (catch->interrupt_input_blocked);
- handling_signal = 0;
+ unblock_input_to (catch->interrupt_input_blocked);
immediate_quit = 0;
do
}
while (! last_time);
-#if HAVE_X_WINDOWS
- /* If x_catch_errors was done, turn it off now.
- (First we give unbind_to a chance to do that.) */
-#if 0 /* This would disable x_catch_errors after x_connection_closed.
- The catch must remain in effect during that delicate
- state. --lorentey */
- x_fully_uncatch_errors ();
-#endif
-#endif
-
byte_stack_list = catch->byte_stack;
gcprolist = catch->gcpro;
#ifdef DEBUG_GCPRO
backtrace_list = catch->backlist;
lisp_eval_depth = catch->lisp_eval_depth;
- _longjmp (catch->jmp, 1);
+ sys_longjmp (catch->jmp, 1);
}
DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
(Lisp_Object args)
{
Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (Fprogn, Fcdr (args));
val = eval_sub (Fcar (args));
usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
(Lisp_Object args)
{
- register Lisp_Object bodyform, handlers;
- volatile Lisp_Object var;
-
- var = Fcar (args);
- bodyform = Fcar (Fcdr (args));
- handlers = Fcdr (Fcdr (args));
+ Lisp_Object var = Fcar (args);
+ Lisp_Object bodyform = Fcar (Fcdr (args));
+ Lisp_Object handlers = Fcdr (Fcdr (args));
return internal_lisp_condition_case (var, bodyform, handlers);
}
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
if (!NILP (h.var))
specbind (h.var, c.val);
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
return (*hfun) (c.val);
}
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;
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
- if (_setjmp (c.jmp))
+ if (sys_setjmp (c.jmp))
{
- return (*hfun) (c.val);
+ return (*hfun) (c.val, nargs, args);
}
c.next = catchlist;
catchlist = &c;
\f
static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
-static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
- Lisp_Object data);
+static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
+ Lisp_Object data);
void
process_quit_flag (void)
struct handler *h;
struct backtrace *bp;
- immediate_quit = handling_signal = 0;
+ immediate_quit = 0;
abort_on_gc = 0;
if (gc_in_progress || waiting_for_input)
- abort ();
+ emacs_abort ();
#if 0 /* rms: I don't know why this was here,
but it is surely wrong for an error that is handled. */
if requested". */
|| EQ (h->handler, Qerror)))
{
- int debugger_called
+ bool debugger_called
= maybe_call_debugger (conditions, error_symbol, data);
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
xsignal (Lisp_Object error_symbol, Lisp_Object data)
{
Fsignal (error_symbol, data);
- abort ();
+ emacs_abort ();
}
/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
}
-/* Return nonzero if LIST is a non-nil atom or
+/* Return true if LIST is a non-nil atom or
a list containing one of CONDITIONS. */
-static int
+static bool
wants_debugger (Lisp_Object list, Lisp_Object conditions)
{
if (NILP (list))
return 0;
}
-/* Return 1 if an error with condition-symbols CONDITIONS,
+/* Return true if an error with condition-symbols CONDITIONS,
and described by SIGNAL-DATA, should skip the debugger
according to debugger-ignored-errors. */
-static int
+static bool
skip_debugger (Lisp_Object conditions, Lisp_Object data)
{
Lisp_Object tail;
- int first_string = 1;
+ bool first_string = 1;
Lisp_Object error_message;
error_message = Qnil;
= SIG is the error symbol, and DATA is the rest of the data.
= SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
This is for memory-full errors only. */
-static int
+static bool
maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
{
Lisp_Object combined_data;
if (
/* Don't try to run the debugger with interrupts blocked.
The editing loop would return anyway. */
- ! INPUT_BLOCKED_P
+ ! input_blocked_p ()
+ && NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
&& (EQ (sig, Qquit)
? debug_on_quit
/* Only add entries after dumping, because the ones before are
not useful and else we get loads of them from the loaddefs.el. */
LOADHIST_ATTACH (Fcons (Qautoload, function));
- else
- /* We don't want the docstring in purespace (instead,
- Snarf-documentation should (hopefully) overwrite it).
- We used to use 0 here, but that leads to accidental sharing in
- purecopy's hash-consing, so we use a (hopefully) unique integer
- instead. */
- docstring = make_number (XPNTR (function));
+ else if (EQ (docstring, make_number (0)))
+ /* `read1' in lread.c has found the docstring starting with "\
+ and assumed the docstring will be provided by Snarf-documentation, so it
+ passed us 0 instead. But that leads to accidental sharing in purecopy's
+ hash-consing, so we use a (hopefully) unique integer instead. */
+ docstring = make_number (XUNTAG (function, Lisp_Symbol));
return Ffset (function,
Fpurecopy (list5 (Qautoload, file, docstring,
interactive, type)));
FUNNAME is the symbol which is the function's name.
FUNDEF is the autoload definition (a list). */
-void
-do_autoload (Lisp_Object fundef, Lisp_Object funname)
+DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0,
+ doc: /* Load FUNDEF which should be an autoload.
+If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
+in which case the function returns the new autoloaded function value.
+If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
+it is defines a macro. */)
+ (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
{
- int count = SPECPDL_INDEX ();
- Lisp_Object fun;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
+ if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
+ return fundef;
+
+ if (EQ (macro_only, Qmacro))
+ {
+ Lisp_Object kind = Fnth (make_number (4), fundef);
+ if (! (EQ (kind, Qt) || EQ (kind, Qmacro)))
+ return fundef;
+ }
+
/* This is to make sure that loadup.el gives a clear picture
of what files are preloaded and when. */
if (! NILP (Vpurify_flag))
error ("Attempt to autoload %s while preparing to dump",
SDATA (SYMBOL_NAME (funname)));
- fun = funname;
CHECK_SYMBOL (funname);
- GCPRO3 (fun, funname, fundef);
+ GCPRO3 (funname, fundef, macro_only);
/* Preserve the match data. */
record_unwind_save_match_data ();
The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
- Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt);
+ /* If `macro_only', assume this autoload to be a "best-effort",
+ so don't signal an error if autoloading fails. */
+ Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt);
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
unbind_to (count, Qnil);
- fun = Findirect_function (fun, Qnil);
-
- if (!NILP (Fequal (fun, fundef)))
- error ("Autoloading failed to define function %s",
- SDATA (SYMBOL_NAME (funname)));
UNGCPRO;
+
+ if (NILP (funname))
+ return Qnil;
+ else
+ {
+ Lisp_Object fun = Findirect_function (funname, Qnil);
+
+ if (!NILP (Fequal (fun, fundef)))
+ error ("Autoloading failed to define function %s",
+ SDATA (SYMBOL_NAME (funname)));
+ else
+ return fun;
+ }
}
\f
If LEXICAL is t, evaluate using lexical scoping. */)
(Lisp_Object form, Lisp_Object lexical)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinternal_interpreter_environment,
NILP (lexical) ? Qnil : Fcons (Qt, Qnil));
return unbind_to (count, eval_sub (form));
struct backtrace backtrace;
struct gcpro gcpro1, gcpro2, gcpro3;
- if (handling_signal)
- abort ();
-
if (SYMBOLP (form))
{
/* Look up its binding in the lexical environment.
return form;
QUIT;
- if ((consing_since_gc > gc_cons_threshold
- && consing_since_gc > gc_relative_threshold)
- ||
- (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
- {
- GCPRO1 (form);
- Fgarbage_collect ();
- UNGCPRO;
- }
+ maybe_gc ();
if (++lisp_eval_depth > max_lisp_eval_depth)
{
error ("Lisp nesting exceeds `max-lisp-eval-depth'");
}
- original_fun = Fcar (form);
- original_args = Fcdr (form);
+ original_fun = XCAR (form);
+ original_args = XCDR (form);
backtrace.next = backtrace_list;
- backtrace_list = &backtrace;
backtrace.function = &original_fun; /* This also protects them from gc. */
backtrace.args = &original_args;
backtrace.nargs = UNEVALLED;
backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
if (debug_on_next_call)
do_debug_on_call (Qt);
args_left = original_args;
numargs = Flength (args_left);
- CHECK_CONS_LIST ();
+ check_cons_list ();
if (XINT (numargs) < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0
is supported by this code. We need to either rewrite the
subr to use a different argument protocol, or add more
cases to this switch. */
- abort ();
+ emacs_abort ();
}
}
}
xsignal1 (Qinvalid_function, original_fun);
if (EQ (funcar, Qautoload))
{
- do_autoload (fun, original_fun);
+ Fautoload_do_load (fun, original_fun, Qnil);
goto retry;
}
if (EQ (funcar, Qmacro))
- val = eval_sub (apply1 (Fcdr (fun), original_args));
+ {
+ ptrdiff_t count = SPECPDL_INDEX ();
+ Lisp_Object exp;
+ /* Bind lexical-binding during expansion of the macro, so the
+ macro can know reliably if the code it outputs will be
+ interpreted using lexical-binding or not. */
+ specbind (Qlexical_binding,
+ NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
+ exp = apply1 (Fcdr (fun), original_args);
+ unbind_to (count, Qnil);
+ val = eval_sub (exp);
+ }
else if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
val = apply_lambda (fun, original_args);
else
xsignal1 (Qinvalid_function, original_fun);
}
- CHECK_CONS_LIST ();
+ check_cons_list ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
return val;
}
\f
-DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
+DEFUN ("apply", Fapply, Sapply, 1, MANY, 0,
doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
Then return the value FUNCTION returns.
Thus, (apply '+ 1 2 '(3 4)) returns 10.
usage: (apply FUNCTION &rest ARGUMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t i, numargs;
+ ptrdiff_t i;
+ EMACS_INT numargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun, retval;
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;
doc: /* Non-nil if OBJECT is a function. */)
(Lisp_Object object)
{
- if (SYMBOLP (object) && !NILP (Ffboundp (object)))
- {
- object = Findirect_function (object, Qt);
-
- if (CONSP (object) && EQ (XCAR (object), Qautoload))
- {
- /* Autoloaded symbols are functions, except if they load
- macros or keymaps. */
- int i;
- for (i = 0; i < 4 && CONSP (object); i++)
- object = XCDR (object);
-
- return (CONSP (object) && !NILP (XCAR (object))) ? Qnil : Qt;
- }
- }
-
- if (SUBRP (object))
- return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil;
- else if (COMPILEDP (object))
+ if (FUNCTIONP (object))
return Qt;
- else if (CONSP (object))
- {
- Lisp_Object car = XCAR (object);
- return (EQ (car, Qlambda) || EQ (car, Qclosure)) ? Qt : Qnil;
- }
- else
- return Qnil;
+ return Qnil;
}
DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
ptrdiff_t i;
QUIT;
- if ((consing_since_gc > gc_cons_threshold
- && consing_since_gc > gc_relative_threshold)
- ||
- (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
- Fgarbage_collect ();
if (++lisp_eval_depth > max_lisp_eval_depth)
{
}
backtrace.next = backtrace_list;
- backtrace_list = &backtrace;
backtrace.function = &args[0];
- backtrace.args = &args[1];
+ backtrace.args = &args[1]; /* This also GCPROs them. */
backtrace.nargs = nargs - 1;
backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
+
+ /* Call GC after setting up the backtrace, so the latter GCPROs the args. */
+ maybe_gc ();
if (debug_on_next_call)
do_debug_on_call (Qlambda);
- CHECK_CONS_LIST ();
+ check_cons_list ();
original_fun = args[0];
{
if (XSUBR (fun)->max_args > numargs)
{
- internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
- memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object));
+ internal_args = alloca (XSUBR (fun)->max_args
+ * sizeof *internal_args);
+ memcpy (internal_args, args + 1, numargs * word_size);
for (i = numargs; i < XSUBR (fun)->max_args; i++)
internal_args[i] = Qnil;
}
/* If a subr takes more than 8 arguments without using MANY
or UNEVALLED, we need to extend this function to support it.
Until this is done, there is no way to call the function. */
- abort ();
+ emacs_abort ();
}
}
}
val = funcall_lambda (fun, numargs, args + 1);
else if (EQ (funcar, Qautoload))
{
- do_autoload (fun, original_fun);
- CHECK_CONS_LIST ();
+ Fautoload_do_load (fun, original_fun, Qnil);
+ check_cons_list ();
goto retry;
}
else
xsignal1 (Qinvalid_function, original_fun);
}
- CHECK_CONS_LIST ();
+ check_cons_list ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
apply_lambda (Lisp_Object fun, Lisp_Object args)
{
Lisp_Object args_left;
- ptrdiff_t i, numargs;
+ ptrdiff_t i;
+ EMACS_INT numargs;
register Lisp_Object *arg_vector;
struct gcpro gcpro1, gcpro2, gcpro3;
register Lisp_Object tem;
register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next, lexenv;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t i;
- int optional, rest;
+ bool optional, rest;
if (CONSP (fun))
{
lexenv = Qnil;
}
else
- abort ();
+ emacs_abort ();
i = optional = rest = 0;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
static void
grow_specpdl (void)
{
- register int count = SPECPDL_INDEX ();
- int max_size =
- min (max_specpdl_size,
- min (max (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct specbinding),
- INT_MAX));
- int size;
+ register ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
if (max_size <= specpdl_size)
{
if (max_specpdl_size < 400)
if (max_size <= specpdl_size)
signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
}
- size = specpdl_size < max_size / 2 ? 2 * specpdl_size : max_size;
- specpdl = xnrealloc (specpdl, size, sizeof *specpdl);
- specpdl_size = size;
+ specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl);
specpdl_ptr = specpdl + count;
}
{
struct Lisp_Symbol *sym;
- eassert (!handling_signal);
-
CHECK_SYMBOL (symbol);
sym = XSYMBOL (symbol);
if (specpdl_ptr == specpdl + specpdl_size)
case SYMBOL_PLAINVAL:
/* The most common case is that of a non-constant symbol with a
trivial value. Make that as fast as we can. */
- specpdl_ptr->symbol = symbol;
- specpdl_ptr->old_value = SYMBOL_VAL (sym);
+ set_specpdl_symbol (symbol);
+ set_specpdl_old_value (SYMBOL_VAL (sym));
specpdl_ptr->func = NULL;
++specpdl_ptr;
if (!sym->constant)
{
Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
- specpdl_ptr->old_value = ovalue;
+ set_specpdl_old_value (ovalue);
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (EQ (SYMBOL_BLV (sym)->where,
if (!NILP (Flocal_variable_p (symbol, Qnil)))
{
eassert (sym->redirect != SYMBOL_LOCALIZED
- || (BLV_FOUND (SYMBOL_BLV (sym))
+ || (blv_found (SYMBOL_BLV (sym))
&& EQ (cur_buf, SYMBOL_BLV (sym)->where)));
where = cur_buf;
}
else if (sym->redirect == SYMBOL_LOCALIZED
- && BLV_FOUND (SYMBOL_BLV (sym)))
+ && blv_found (SYMBOL_BLV (sym)))
where = SYMBOL_BLV (sym)->where;
else
where = Qnil;
let_shadows_buffer_binding_p which is itself only used
in set_internal for local_if_set. */
eassert (NILP (where) || EQ (where, cur_buf));
- specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
+ set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf)));
/* If SYMBOL is a per-buffer variable which doesn't have a
buffer-local value here, make the `let' change the global
}
}
else
- specpdl_ptr->symbol = symbol;
+ set_specpdl_symbol (symbol);
specpdl_ptr++;
set_internal (symbol, value, Qnil, 1);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
}
void
record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
{
- eassert (!handling_signal);
-
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->func = function;
- specpdl_ptr->symbol = Qnil;
- specpdl_ptr->old_value = arg;
+ set_specpdl_symbol (Qnil);
+ set_specpdl_old_value (arg);
specpdl_ptr++;
}
Lisp_Object
-unbind_to (int count, Lisp_Object value)
+unbind_to (ptrdiff_t count, Lisp_Object value)
{
Lisp_Object quitf = Vquit_flag;
struct gcpro gcpro1, gcpro2;
(Lisp_Object level, Lisp_Object flag)
{
register struct backtrace *backlist = backtrace_list;
- register int i;
+ register EMACS_INT i;
CHECK_NUMBER (level);
write_string ("(", -1);
if (backlist->nargs == MANY)
{ /* FIXME: Can this happen? */
- int i;
- for (tail = *backlist->args, i = 0;
- !NILP (tail);
- tail = Fcdr (tail), i = 1)
+ bool later_arg = 0;
+ for (tail = *backlist->args; !NILP (tail); tail = Fcdr (tail))
{
- if (i) write_string (" ", -1);
+ if (later_arg)
+ write_string (" ", -1);
Fprin1 (Fcar (tail), Qnil);
+ later_arg = 1;
}
}
else
syms_of_eval (void)
{
DEFVAR_INT ("max-specpdl-size", max_specpdl_size,
- doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
+ doc: /* Limit on number of Lisp variable bindings and `unwind-protect's.
If Lisp code tries to increase the total number past this amount,
an error is signaled.
You can safely use a value considerably larger than the default value,
Emacs could run out of memory trying to make the stack bigger. */);
DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth,
- doc: /* *Limit on depth in `eval', `apply' and `funcall' before error.
+ doc: /* Limit on depth in `eval', `apply' and `funcall' before error.
This limit serves to catch infinite recursions for you before they cause
actual stack overflow in C, which would be fatal for Emacs.
DEFSYM (Qinhibit_quit, "inhibit-quit");
DEFSYM (Qautoload, "autoload");
- DEFSYM (Qdebug_on_error, "debug-on-error");
+ DEFSYM (Qinhibit_debugger, "inhibit-debugger");
DEFSYM (Qmacro, "macro");
DEFSYM (Qdeclare, "declare");
DEFSYM (Qinteractive, "interactive");
DEFSYM (Qcommandp, "commandp");
- DEFSYM (Qdefun, "defun");
DEFSYM (Qand_rest, "&rest");
DEFSYM (Qand_optional, "&optional");
DEFSYM (Qclosure, "closure");
DEFSYM (Qdebug, "debug");
+ DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
+ doc: /* Non-nil means never enter the debugger.
+Normally set while the debugger is already active, to avoid recursive
+invocations. */);
+ Vinhibit_debugger = Qnil;
+
DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
- doc: /* *Non-nil means enter debugger if an error is signaled.
+ doc: /* Non-nil means enter debugger if an error is signaled.
Does not apply to errors handled by `condition-case' or those
matched by `debug-ignored-errors'.
If the value is a list, an error only means to enter the debugger
When you evaluate an expression interactively, this variable
is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
The command `toggle-debug-on-error' toggles this.
-See also the variable `debug-on-quit'. */);
+See also the variable `debug-on-quit' and `inhibit-debugger'. */);
Vdebug_on_error = Qnil;
DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
- doc: /* *List of errors for which the debugger should not be called.
+ doc: /* List of errors for which the debugger should not be called.
Each element may be a condition-name or a regexp that matches error messages.
If any element applies to a given error, that error skips the debugger
and just returns to top level.
Vdebug_ignored_errors = Qnil;
DEFVAR_BOOL ("debug-on-quit", debug_on_quit,
- doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
+ doc: /* Non-nil means enter debugger if quit is signaled (C-g, for example).
Does not apply if quit is handled by a `condition-case'. */);
debug_on_quit = 0;
Vsignal_hook_function = Qnil;
DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal,
- doc: /* *Non-nil means call the debugger regardless of condition handlers.
+ doc: /* Non-nil means call the debugger regardless of condition handlers.
Note that `debug-on-error', `debug-on-quit' and friends
still determine whether to handle the particular condition. */);
Vdebug_on_signal = Qnil;
- DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function,
- doc: /* Function to process declarations in a macro definition.
-The function will be called with two args MACRO and DECL.
-MACRO is the name of the macro being defined.
-DECL is a list `(declare ...)' containing the declarations.
-The value the function returns is not used. */);
- Vmacro_declaration_function = Qnil;
-
/* When lexical binding is being used,
- vinternal_interpreter_environment is non-nil, and contains an alist
+ Vinternal_interpreter_environment is non-nil, and contains an alist
of lexically-bound variable, or (t), indicating an empty
environment. The lisp name of this variable would be
`internal-interpreter-environment' if it weren't hidden.
Every element of this list can be either a cons (VAR . VAL)
specifying a lexical binding, or a single symbol VAR indicating
that this variable should use dynamic scoping. */
- DEFSYM (Qinternal_interpreter_environment, "internal-interpreter-environment");
+ DEFSYM (Qinternal_interpreter_environment,
+ "internal-interpreter-environment");
DEFVAR_LISP ("internal-interpreter-environment",
Vinternal_interpreter_environment,
doc: /* If non-nil, the current lexical environment of the lisp interpreter.
defsubr (&Ssetq);
defsubr (&Squote);
defsubr (&Sfunction);
- defsubr (&Sdefun);
- defsubr (&Sdefmacro);
defsubr (&Sdefvar);
defsubr (&Sdefvaralias);
defsubr (&Sdefconst);
- defsubr (&Suser_variable_p);
+ defsubr (&Smake_var_non_special);
defsubr (&Slet);
defsubr (&SletX);
defsubr (&Swhile);
defsubr (&Scalled_interactively_p);
defsubr (&Scommandp);
defsubr (&Sautoload);
+ defsubr (&Sautoload_do_load);
defsubr (&Seval);
defsubr (&Sapply);
defsubr (&Sfuncall);
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
-#include <setjmp.h>
#include <unistd.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
-#include <ctype.h>
#include <errno.h>
#ifdef HAVE_LIBSELINUX
#include <selinux/context.h>
#endif
+#include <c-ctype.h>
+
#include "lisp.h"
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "window.h"
#include "blockinput.h"
#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
#endif
#ifdef WINDOWSNT
-#define IS_DRIVE(x) isalpha ((unsigned char) (x))
+#define IS_DRIVE(x) c_isalpha (x)
#endif
/* Need to lower-case the drive letter, or else expanded
filenames will sometimes compare unequal, because
`expand-file-name' doesn't always down-case the drive letter. */
-#define DRIVE_LETTER(x) (tolower ((unsigned char) (x)))
+#define DRIVE_LETTER(x) c_tolower (x)
#endif
#include "systime.h"
+#include <stat-time.h>
#ifdef HPUX
#include <netio.h>
#include "commands.h"
-/* Nonzero during writing of auto-save files */
-static int auto_saving;
+/* True during writing of auto-save files. */
+static bool auto_saving;
-/* Nonzero umask during creation of auto-save directories */
-static int auto_saving_dir_umask;
+/* Nonzero umask during creation of auto-save directories. */
+static mode_t auto_saving_dir_umask;
/* Set by auto_save_1 to mode of original file so Fwrite_region will create
- a new file with the same mode as the original */
-static int auto_save_mode_bits;
+ a new file with the same mode as the original. */
+static mode_t auto_save_mode_bits;
-/* Set by auto_save_1 if an error occurred during the last auto-save. */
-static int auto_save_error_occurred;
+/* Set by auto_save_1 if an error occurred during the last auto-save. */
+static bool auto_save_error_occurred;
/* The symbol bound to coding-system-for-read when
insert-file-contents is called for recovering a file. This is not
which gives a list of operations it handles.. */
static Lisp_Object Qoperations;
-/* Lisp functions for translating file formats */
+/* Lisp functions for translating file formats. */
static Lisp_Object Qformat_decode, Qformat_annotate_function;
/* Lisp function for setting buffer-file-coding-system and the
static Lisp_Object Qcar_less_than_car;
-static Lisp_Object Fmake_symbolic_link (Lisp_Object, Lisp_Object, Lisp_Object);
-static int a_write (int, Lisp_Object, EMACS_INT, EMACS_INT,
- Lisp_Object *, struct coding_system *);
-static int e_write (int, Lisp_Object, EMACS_INT, EMACS_INT,
- struct coding_system *);
+static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
+ Lisp_Object *, struct coding_system *);
+static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
+ struct coding_system *);
\f
void
synchronize_system_messages_locale ();
str = strerror (errorno);
- errstring = code_convert_string_norecord (make_unibyte_string (str,
- strlen (str)),
+ errstring = code_convert_string_norecord (build_unibyte_string (str),
Vlocale_coding_system, 0);
while (1)
{
/* This function must not munge the match data. */
Lisp_Object chain, inhibited_handlers, result;
- int pos = -1;
+ ptrdiff_t pos = -1;
result = Qnil;
CHECK_STRING (filename);
if (CONSP (elt))
{
Lisp_Object string = XCAR (elt);
- EMACS_INT match_pos;
+ ptrdiff_t match_pos;
Lisp_Object handler = XCDR (elt);
Lisp_Object operations = Qnil;
}
#ifdef DOS_NT
- beg = (char *) alloca (SBYTES (filename) + 1);
+ beg = alloca (SBYTES (filename) + 1);
memcpy (beg, SSDATA (filename), SBYTES (filename) + 1);
#else
beg = SSDATA (filename);
if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
{
- strncpy (res, beg, 2);
+ memcpy (res, beg, 2);
beg += 2;
r += 2;
}
- if (getdefdir (toupper ((unsigned char) *beg) - 'A' + 1, r))
+ if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
{
if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
strcat (res, "/");
return Ffile_name_directory (filename);
}
-\f
-static char *
-file_name_as_directory (char *out, const char *in)
-{
- ptrdiff_t len = strlen (in);
+/* Convert from file name SRC of length SRCLEN to directory name
+ in DST. On UNIX, just make sure there is a terminating /.
+ Return the length of DST. */
- if (len == 0)
+static ptrdiff_t
+file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen)
+{
+ if (srclen == 0)
{
- out[0] = '.';
- out[1] = '/';
- out[2] = 0;
- return out;
+ dst[0] = '.';
+ dst[1] = '/';
+ dst[2] = '\0';
+ return 2;
}
- strcpy (out, in);
+ strcpy (dst, src);
- /* For Unix syntax, Append a slash if necessary */
- if (!IS_DIRECTORY_SEP (out[len - 1]))
+ if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
{
- out[len] = DIRECTORY_SEP;
- out[len + 1] = '\0';
+ dst[srclen] = DIRECTORY_SEP;
+ dst[srclen + 1] = '\0';
+ srclen++;
}
#ifdef DOS_NT
- dostounix_filename (out);
+ dostounix_filename (dst);
#endif
- return out;
+ return srclen;
}
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
(Lisp_Object file)
{
char *buf;
+ ptrdiff_t length;
Lisp_Object handler;
CHECK_STRING (file);
error ("Invalid handler in `file-name-handler-alist'");
}
- buf = (char *) alloca (SBYTES (file) + 10);
- file_name_as_directory (buf, SSDATA (file));
- return make_specified_string (buf, -1, strlen (buf),
- STRING_MULTIBYTE (file));
+ buf = alloca (SBYTES (file) + 10);
+ length = file_name_as_directory (buf, SSDATA (file), SBYTES (file));
+ return make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
}
\f
-/*
- * Convert from directory name to filename.
- * On UNIX, it's simple: just make sure there isn't a terminating /
+/* Convert from directory name SRC of length SRCLEN to
+ file name in DST. On UNIX, just make sure there isn't
+ a terminating /. Return the length of DST. */
- * Value is nonzero if the string output is different from the input.
- */
-
-static int
-directory_file_name (char *src, char *dst)
+static ptrdiff_t
+directory_file_name (char *dst, char *src, ptrdiff_t srclen)
{
- ptrdiff_t slen;
-
- slen = strlen (src);
-
/* Process as Unix format: just remove any final slash.
But leave "/" unchanged; do not change it to "". */
strcpy (dst, src);
- if (slen > 1
- && IS_DIRECTORY_SEP (dst[slen - 1])
+ if (srclen > 1
+ && IS_DIRECTORY_SEP (dst[srclen - 1])
#ifdef DOS_NT
- && !IS_ANY_SEP (dst[slen - 2])
+ && !IS_ANY_SEP (dst[srclen - 2])
#endif
)
- dst[slen - 1] = 0;
+ {
+ dst[srclen - 1] = 0;
+ srclen--;
+ }
#ifdef DOS_NT
dostounix_filename (dst);
#endif
- return 1;
+ return srclen;
}
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
(Lisp_Object directory)
{
char *buf;
+ ptrdiff_t length;
Lisp_Object handler;
CHECK_STRING (directory);
error ("Invalid handler in `file-name-handler-alist'");
}
- buf = (char *) alloca (SBYTES (directory) + 20);
- directory_file_name (SSDATA (directory), buf);
- return make_specified_string (buf, -1, strlen (buf),
- STRING_MULTIBYTE (directory));
+ buf = alloca (SBYTES (directory) + 20);
+ length = directory_file_name (buf, SSDATA (directory), SBYTES (directory));
+ return make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
}
static const char make_temp_name_tbl[64] =
which has no existing file. To make this work, PREFIX should be
an absolute file name.
- BASE64_P non-zero means add the pid as 3 characters in base64
+ BASE64_P means add the pid as 3 characters in base64
encoding. In this case, 6 characters will be added to PREFIX to
form the file name. Otherwise, if Emacs is running on a system
with long file names, add the pid as a decimal number.
generated. */
Lisp_Object
-make_temp_name (Lisp_Object prefix, int base64_p)
+make_temp_name (Lisp_Object prefix, bool base64_p)
{
Lisp_Object val;
int len, clen;
struct passwd *pw;
#ifdef DOS_NT
int drive = 0;
- int collapse_newdir = 1;
- int is_escaped = 0;
+ bool collapse_newdir = 1;
+ bool is_escaped = 0;
#endif /* DOS_NT */
ptrdiff_t length;
Lisp_Object handler, result, handled_name;
- int multibyte;
+ bool multibyte;
Lisp_Object hdir;
CHECK_STRING (name);
}
}
- /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
- nm = (char *) alloca (SBYTES (name) + 1);
+ /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
+ nm = alloca (SBYTES (name) + 1);
memcpy (nm, SSDATA (name), SBYTES (name) + 1);
#ifdef DOS_NT
if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
nm++;
- /* Discard any previous drive specifier if nm is now in UNC format. */
+ /* Discard any previous drive specifier if nm is now in UNC format. */
if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
{
drive = 0;
/* If it turns out that the filename we want to return is just a
suffix of FILENAME, we don't need to go through and edit
things; we just need to construct a new string using data
- starting at the middle of FILENAME. If we set lose to a
- non-zero value, that means we've discovered that we can't do
- that cool trick. */
- int lose = 0;
+ starting at the middle of FILENAME. If we set LOSE, that
+ means we've discovered that we can't do that cool trick. */
+ bool lose = 0;
char *p = nm;
while (*p)
}
else
#endif
- /* drive must be set, so this is okay */
+ /* Drive must be set, so this is okay. */
if (strcmp (nm - 2, SSDATA (name)) != 0)
{
char temp[] = " :";
if (!(newdir = egetenv ("HOME")))
newdir = "";
nm++;
- /* egetenv may return a unibyte string, which will bite us since
+ /* `egetenv' may return a unibyte string, which will bite us since
we expect the directory to be multibyte. */
tem = build_string (newdir);
if (!STRING_MULTIBYTE (tem))
memcpy (o, nm, p - nm);
o [p - nm] = 0;
- BLOCK_INPUT;
+ block_input ();
pw = (struct passwd *) getpwnam (o + 1);
- UNBLOCK_INPUT;
+ unblock_input ();
if (pw)
{
newdir = pw->pw_dir;
use the drive's current directory as the prefix if needed. */
if (!newdir && drive)
{
- /* Get default directory if needed to make nm absolute. */
+ /* Get default directory if needed to make nm absolute. */
char *adir = NULL;
if (!IS_DIRECTORY_SEP (nm[0]))
{
adir = alloca (MAXPATHLEN + 1);
- if (!getdefdir (toupper (drive) - 'A' + 1, adir))
+ if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
adir = NULL;
}
if (!adir)
{
- /* Either nm starts with /, or drive isn't mounted. */
+ /* Either nm starts with /, or drive isn't mounted. */
adir = alloca (4);
adir[0] = DRIVE_LETTER (drive);
adir[1] = ':';
#endif /* DOS_NT */
/* Finally, if no prefix has been specified and nm is not absolute,
- then it must be expanded relative to default_directory. */
+ then it must be expanded relative to default_directory. */
if (1
#ifndef DOS_NT
- /* /... alone is not absolute on DOS and Windows. */
+ /* /... alone is not absolute on DOS and Windows. */
&& !IS_DIRECTORY_SEP (nm[0])
#endif
#ifdef WINDOWSNT
#ifdef DOS_NT
if (newdir)
{
- /* First ensure newdir is an absolute name. */
+ /* First ensure newdir is an absolute name. */
if (
/* Detect MSDOS file names with drive specifiers. */
! (IS_DRIVE (newdir[0])
Because of the admonition against calling expand-file-name
when we have pointers into lisp strings, we accomplish this
indirectly by prepending newdir to nm if necessary, and using
- cwd (or the wd of newdir's drive) as the new newdir. */
+ cwd (or the wd of newdir's drive) as the new newdir. */
char *adir;
if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
}
if (!IS_DIRECTORY_SEP (nm[0]))
{
- char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
- file_name_as_directory (tmp, newdir);
+ ptrdiff_t newlen = strlen (newdir);
+ char *tmp = alloca (newlen + strlen (nm) + 2);
+ file_name_as_directory (tmp, newdir, newlen);
strcat (tmp, nm);
nm = tmp;
}
adir = alloca (MAXPATHLEN + 1);
if (drive)
{
- if (!getdefdir (toupper (drive) - 'A' + 1, adir))
+ if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
newdir = "/";
}
else
newdir = adir;
}
- /* Strip off drive name from prefix, if present. */
+ /* Strip off drive name from prefix, if present. */
if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
drive = newdir[0];
/* Get rid of any slash at the end of newdir, unless newdir is
just / or // (an incomplete UNC name). */
length = strlen (newdir);
+ tlen = length + 1;
if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
#ifdef WINDOWSNT
&& !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
#endif
)
{
- char *temp = (char *) alloca (length);
+ char *temp = alloca (length);
memcpy (temp, newdir, length - 1);
temp[length - 1] = 0;
+ length--;
newdir = temp;
}
- tlen = length + 1;
}
else
- tlen = 0;
+ {
+ length = 0;
+ tlen = 0;
+ }
- /* Now concatenate the directory and name to new space in the stack frame */
+ /* Now concatenate the directory and name to new space in the stack frame. */
tlen += strlen (nm) + 1;
#ifdef DOS_NT
/* Reserve space for drive specifier and escape prefix, since either
or both may need to be inserted. (The Microsoft x86 compiler
produces incorrect code if the following two lines are combined.) */
- target = (char *) alloca (tlen + 4);
+ target = alloca (tlen + 4);
target += 4;
#else /* not DOS_NT */
- target = (char *) alloca (tlen);
+ target = alloca (tlen);
#endif /* not DOS_NT */
*target = 0;
strcpy (target, newdir);
}
else
- file_name_as_directory (target, newdir);
+ file_name_as_directory (target, newdir, length);
}
strcat (target, nm);
}
#ifdef DOS_NT
- /* At last, set drive name. */
+ /* At last, set drive name. */
#ifdef WINDOWSNT
/* Except for network file name. */
if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
#endif /* WINDOWSNT */
{
- if (!drive) abort ();
+ if (!drive) emacs_abort ();
target -= 2;
target[0] = DRIVE_LETTER (drive);
target[1] = ':';
and perhaps call the corresponding file handler. This is needed
for filenames such as "/foo/../user@host:/bar/../baz". Expanding
the ".." component gives us "/user@host:/bar/../baz" which needs
- to be expanded again. */
+ to be expanded again. */
handler = Ffind_file_name_handler (result, Qexpand_file_name);
if (!NILP (handler))
{
ptrdiff_t tlen;
unsigned char *target;
struct passwd *pw;
- int lose;
CHECK_STRING (name);
nm = SDATA (name);
If no /./ or /../ we can return right away. */
if (nm[0] == '/')
{
+ bool lose = 0;
p = nm;
- lose = 0;
while (*p)
{
if (p[0] == '/' && p[1] == '/'
}
}
- /* Now determine directory to start with and put it in NEWDIR */
+ /* Now determine directory to start with and put it in NEWDIR. */
newdir = 0;
}
else /* ~user/filename */
{
- /* Get past ~ to user */
+ /* Get past ~ to user. */
unsigned char *user = nm + 1;
- /* Find end of name. */
+ /* Find end of name. */
unsigned char *ptr = (unsigned char *) strchr (user, '/');
ptrdiff_t len = ptr ? ptr - user : strlen (user);
- /* Copy the user name into temp storage. */
- o = (unsigned char *) alloca (len + 1);
+ /* Copy the user name into temp storage. */
+ o = alloca (len + 1);
memcpy (o, user, len);
o[len] = 0;
- /* Look up the user name. */
- BLOCK_INPUT;
+ /* Look up the user name. */
+ block_input ();
pw = (struct passwd *) getpwnam (o + 1);
- UNBLOCK_INPUT;
+ unblock_input ();
if (!pw)
error ("\"%s\" isn't a registered user", o + 1);
newdir = SDATA (defalt);
}
- /* Now concatenate the directory and name to new space in the stack frame */
+ /* Now concatenate the directory and name to new space in the stack frame. */
tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
- target = (unsigned char *) alloca (tlen);
+ target = alloca (tlen);
*target = 0;
if (newdir)
strcat (target, nm);
- /* Now canonicalize by removing /. and /foo/.. if they appear */
+ /* Now canonicalize by removing /. and /foo/.. if they appear. */
p = target;
o = target;
#endif
\f
/* If /~ or // appears, discard everything through first slash. */
-static int
+static bool
file_name_absolute_p (const char *filename)
{
return
)
{
for (s = p; *s && (!IS_DIRECTORY_SEP (*s)); s++);
- if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
+ if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
{
char *o = alloca (s - p + 1);
struct passwd *pw;
/* If we have ~user and `user' exists, discard
everything up to ~. But if `user' does not exist, leave
~user alone, it might be a literal file name. */
- BLOCK_INPUT;
+ block_input ();
pw = getpwnam (o + 1);
- UNBLOCK_INPUT;
+ unblock_input ();
if (pw)
return p;
}
those `/' is discarded. */)
(Lisp_Object filename)
{
- char *nm;
-
- register char *s, *p, *o, *x, *endp;
+ char *nm, *s, *p, *o, *x, *endp;
char *target = NULL;
int total = 0;
- int substituted = 0;
- int multibyte;
+ bool substituted = 0;
+ bool multibyte;
char *xnm;
Lisp_Object handler;
/* Always work on a copy of the string, in case GC happens during
decode of environment variables, causing the original Lisp_String
data to be relocated. */
- nm = (char *) alloca (SBYTES (filename) + 1);
+ nm = alloca (SBYTES (filename) + 1);
memcpy (nm, SDATA (filename), SBYTES (filename) + 1);
#ifdef DOS_NT
(make_specified_string (p, -1, endp - p, multibyte));
/* See if any variables are substituted into the string
- and find the total length of their values in `total' */
+ and find the total length of their values in `total'. */
for (p = nm; p != endp;)
if (*p != '$')
goto badsubst;
else if (*p == '$')
{
- /* "$$" means a single "$" */
+ /* "$$" means a single "$". */
p++;
total -= 1;
substituted = 1;
else
{
o = p;
- while (p != endp && (isalnum (*p) || *p == '_')) p++;
+ while (p != endp && (c_isalnum (*p) || *p == '_')) p++;
s = p;
}
- /* Copy out the variable name */
- target = (char *) alloca (s - o + 1);
- strncpy (target, o, s - o);
+ /* Copy out the variable name. */
+ target = alloca (s - o + 1);
+ memcpy (target, o, s - o);
target[s - o] = 0;
#ifdef DOS_NT
strupr (target); /* $home == $HOME etc. */
#endif /* DOS_NT */
- /* Get variable value */
+ /* Get variable value. */
o = egetenv (target);
if (o)
{
env variables twice should be acceptable. Note that
decoding may cause a garbage collect. */
Lisp_Object orig, decoded;
- orig = make_unibyte_string (o, strlen (o));
+ orig = build_unibyte_string (o);
decoded = DECODE_FILE (orig);
total += SBYTES (decoded);
substituted = 1;
if (!substituted)
return filename;
- /* If substitution required, recopy the string and do it */
- /* Make space in stack frame for the new copy */
- xnm = (char *) alloca (SBYTES (filename) + total + 1);
+ /* If substitution required, recopy the string and do it. */
+ /* Make space in stack frame for the new copy. */
+ xnm = alloca (SBYTES (filename) + total + 1);
x = xnm;
- /* Copy the rest of the name through, replacing $ constructs with values */
+ /* Copy the rest of the name through, replacing $ constructs with values. */
for (p = nm; *p;)
if (*p != '$')
*x++ = *p++;
else
{
o = p;
- while (p != endp && (isalnum (*p) || *p == '_')) p++;
+ while (p != endp && (c_isalnum (*p) || *p == '_')) p++;
s = p;
}
- /* Copy out the variable name */
- target = (char *) alloca (s - o + 1);
- strncpy (target, o, s - o);
+ /* Copy out the variable name. */
+ target = alloca (s - o + 1);
+ memcpy (target, o, s - o);
target[s - o] = 0;
#ifdef DOS_NT
strupr (target); /* $home == $HOME etc. */
#endif /* DOS_NT */
- /* Get variable value */
+ /* Get variable value. */
o = egetenv (target);
if (!o)
{
orig = make_unibyte_string (o, orig_length);
decoded = DECODE_FILE (orig);
decoded_length = SBYTES (decoded);
- strncpy (x, SSDATA (decoded), decoded_length);
+ memcpy (x, SDATA (decoded), decoded_length);
x += decoded_length;
/* If environment variable needed decoding, return value
needs to be multibyte. */
if (decoded_length != orig_length
- || strncmp (SSDATA (decoded), o, orig_length))
+ || memcmp (SDATA (decoded), o, orig_length))
multibyte = 1;
}
}
stat behaves differently depending! */
if (SCHARS (absname) > 1
&& IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
- && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
+ && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
/* We cannot take shortcuts; they might be wrong for magic file names. */
absname = Fdirectory_file_name (absname);
return absname;
}
\f
/* Signal an error if the file ABSNAME already exists.
- If INTERACTIVE is nonzero, ask the user whether to proceed,
+ If INTERACTIVE, ask the user whether to proceed,
and bypass the error if the user says to go ahead.
QUERYSTRING is a name for the action that is being considered
to alter the file.
If the file does not exist, STATPTR->st_mode is set to 0.
If STATPTR is null, we don't store into it.
- If QUICK is nonzero, we ask for y or n, not yes or no. */
+ If QUICK, ask for y or n, not yes or no. */
static void
barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
- int interactive, struct stat *statptr, int quick)
+ bool interactive, struct stat *statptr,
+ bool quick)
{
- register Lisp_Object tem, encoded_filename;
+ Lisp_Object tem, encoded_filename;
struct stat statbuf;
struct gcpro gcpro1;
encoded_filename = ENCODE_FILE (absname);
- /* stat is a good way to tell whether the file exists,
+ /* `stat' is a good way to tell whether the file exists,
regardless of what access permissions it has. */
if (lstat (SSDATA (encoded_filename), &statbuf) >= 0)
{
(Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists, Lisp_Object keep_time, Lisp_Object preserve_uid_gid, Lisp_Object preserve_selinux_context)
{
int ifd, ofd;
- EMACS_INT n;
+ int n;
char buf[16 * 1024];
struct stat st, out_st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int count = SPECPDL_INDEX ();
- int input_file_statable_p;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ bool input_file_statable_p;
Lisp_Object encoded_file, encoded_newname;
#if HAVE_LIBSELINUX
security_context_t con;
- int fail, conlength = 0;
+ int conlength = 0;
#endif
encoded_file = encoded_newname = Qnil;
DWORD attributes;
char * filename;
- EMACS_GET_TIME (now);
filename = SDATA (encoded_newname);
/* Ensure file is writable while its modified time is set. */
attributes = GetFileAttributes (filename);
SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
- if (set_file_times (filename, now, now))
+ now = current_emacs_time ();
+ if (set_file_times (-1, filename, now, now))
{
/* Restore original attributes. */
SetFileAttributes (filename, attributes);
S_IREAD | S_IWRITE);
#else /* not MSDOS */
{
- int new_mask = 0666;
+ mode_t new_mask = 0666;
if (input_file_statable_p)
{
if (!NILP (preserve_uid_gid))
owner and group. */
if (input_file_statable_p)
{
- int mode_mask = 07777;
+ mode_t mode_mask = 07777;
if (!NILP (preserve_uid_gid))
{
/* Attempt to change owner and group. If that doesn't work
if (conlength > 0)
{
/* Set the modified context back to the file. */
- fail = fsetfilecon (ofd, con);
+ bool fail = fsetfilecon (ofd, con) != 0;
/* See http://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil));
}
#endif
- /* Closing the output clobbers the file times on some systems. */
- if (emacs_close (ofd) < 0)
- report_file_error ("I/O error", Fcons (newname, Qnil));
-
if (input_file_statable_p)
{
if (!NILP (keep_time))
{
- EMACS_TIME atime, mtime;
- EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
- EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- if (set_file_times (SSDATA (encoded_newname),
- atime, mtime))
+ EMACS_TIME atime = get_stat_atime (&st);
+ EMACS_TIME mtime = get_stat_mtime (&st);
+ if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime))
xsignal2 (Qfile_date_error,
build_string ("Cannot set file date"), newname);
}
}
+ if (emacs_close (ofd) < 0)
+ report_file_error ("I/O error", Fcons (newname, Qnil));
+
emacs_close (ifd);
#ifdef MSDOS
return Qt;
}
-/* Delete file FILENAME, returning 1 if successful and 0 if failed.
+/* Delete file FILENAME.
This ignores `delete-by-moving-to-trash'. */
-int
+void
internal_delete_file (Lisp_Object filename)
{
- Lisp_Object tem;
-
- tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
- Qt, internal_delete_file_1);
- return NILP (tem);
+ internal_condition_case_2 (Fdelete_file, filename, Qnil,
+ Qt, internal_delete_file_1);
}
\f
DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
{
if (errno == EXDEV)
{
- int count;
+ ptrdiff_t count;
symlink_target = Ffile_symlink_p (file);
if (! NILP (symlink_target))
Fmake_symbolic_link (symlink_target, newname,
return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
}
\f
-/* Return nonzero if file FILENAME exists and can be executed. */
+/* Return true if file FILENAME exists and can be executed. */
-static int
+static bool
check_executable (char *filename)
{
#ifdef DOS_NT
#endif /* not DOS_NT */
}
-/* Return nonzero if file FILENAME exists and can be written. */
+/* Return true if file FILENAME exists and can be written. */
-static int
+static bool
check_writable (const char *filename)
{
#ifdef MSDOS
return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
#else /* not MSDOS */
#ifdef HAVE_EUIDACCESS
- int res = (euidaccess (filename, 2) >= 0);
+ bool res = (euidaccess (filename, 2) >= 0);
#ifdef CYGWIN
/* euidaccess may have returned failure because Cygwin couldn't
determine the file's UID or GID; if so, we return success. */
(Lisp_Object filename)
{
Lisp_Object handler;
- int tem;
+ bool tem;
struct gcpro gcpro1;
/* If the file name has special constructs in it,
Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
security_context_t con;
- int fail, conlength;
+ bool fail;
+ int conlength;
context_t parsed_con;
#endif
}
/* Set the modified context back to the file. */
- fail = lsetfilecon (SSDATA (encoded_absname),
- context_str (parsed_con));
+ fail = (lsetfilecon (SSDATA (encoded_absname),
+ context_str (parsed_con))
+ != 0);
/* See http://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil));
The value is an integer. */)
(void)
{
- int realmask;
+ mode_t realmask;
Lisp_Object value;
+ block_input ();
realmask = umask (0);
umask (realmask);
+ unblock_input ();
XSETINT (value, (~ realmask) & 0777);
return value;
{
Lisp_Object absname, encoded_absname;
Lisp_Object handler;
- time_t sec;
- int usec;
-
- if (! lisp_time_argument (timestamp, &sec, &usec))
- error ("Invalid time specification");
+ EMACS_TIME t = lisp_time_argument (timestamp);
absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
encoded_absname = ENCODE_FILE (absname);
{
- EMACS_TIME t;
-
- EMACS_SET_SECS (t, sec);
- EMACS_SET_USECS (t, usec);
-
- if (set_file_times (SSDATA (encoded_absname), t, t))
+ if (set_file_times (-1, SSDATA (encoded_absname), t, t))
{
#ifdef DOS_NT
struct stat st;
(Lisp_Object file1, Lisp_Object file2)
{
Lisp_Object absname1, absname2;
- struct stat st;
- int mtime1;
+ struct stat st1, st2;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
absname2 = ENCODE_FILE (absname2);
UNGCPRO;
- if (stat (SSDATA (absname1), &st) < 0)
+ if (stat (SSDATA (absname1), &st1) < 0)
return Qnil;
- mtime1 = st.st_mtime;
-
- if (stat (SSDATA (absname2), &st) < 0)
+ if (stat (SSDATA (absname2), &st2) < 0)
return Qt;
- return (mtime1 > st.st_mtime) ? Qt : Qnil;
+ return (EMACS_TIME_GT (get_stat_mtime (&st1), get_stat_mtime (&st2))
+ ? Qt : Qnil);
}
\f
#ifndef READ_BUF_SIZE
#define READ_BUF_SIZE (64 << 10)
#endif
+/* Some buffer offsets are stored in 'int' variables. */
+verify (READ_BUF_SIZE <= INT_MAX);
/* This function is called after Lisp functions to decide a coding
system are called, or when they cause an error. Before they are
undo_list = XCAR (unwind_data);
buffer = XCDR (unwind_data);
- if (current_buffer != XBUFFER (buffer))
- set_buffer_internal (XBUFFER (buffer));
+ 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;
+ set_buffer_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_enable_multibyte_characters (current_buffer, multibyte);
+ bset_undo_list (current_buffer, undo_list);
return Qnil;
}
/* Used to pass values from insert-file-contents to read_non_regular. */
static int non_regular_fd;
-static EMACS_INT non_regular_inserted;
-static EMACS_INT non_regular_nbytes;
+static ptrdiff_t non_regular_inserted;
+static int non_regular_nbytes;
/* Read from a non-regular file.
static Lisp_Object
read_non_regular (Lisp_Object ignore)
{
- EMACS_INT nbytes;
+ int nbytes;
immediate_quit = 1;
QUIT;
return lseek (fd, offset, whence);
}
+/* Return a special time value indicating the error number ERRNUM. */
+static EMACS_TIME
+time_error_value (int errnum)
+{
+ int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
+ ? NONEXISTENT_MODTIME_NSECS
+ : UNKNOWN_MODTIME_NSECS);
+ return make_emacs_time (0, ns);
+}
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 5, 0,
(Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
{
struct stat st;
- register int fd;
- EMACS_INT inserted = 0;
- int nochange = 0;
- register EMACS_INT how_much;
+ int file_status;
+ EMACS_TIME mtime;
+ int fd;
+ ptrdiff_t inserted = 0;
+ bool nochange = 0;
+ ptrdiff_t how_much;
off_t beg_offset, end_offset;
- register EMACS_INT unprocessed;
- int count = SPECPDL_INDEX ();
+ int unprocessed;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object handler, val, insval, orig_filename, old_undo;
Lisp_Object p;
- EMACS_INT total = 0;
- int not_regular = 0;
+ ptrdiff_t total = 0;
+ bool not_regular = 0;
int save_errno = 0;
char read_buf[READ_BUF_SIZE];
struct coding_system coding;
char buffer[1 << 14];
- int replace_handled = 0;
- int set_coding_system = 0;
+ bool replace_handled = 0;
+ bool set_coding_system = 0;
Lisp_Object coding_system;
- int read_quit = 0;
+ bool read_quit = 0;
Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
- int we_locked_file = 0;
- int deferred_remove_unwind_protect = 0;
+ bool we_locked_file = 0;
+ bool deferred_remove_unwind_protect = 0;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
{
val = call6 (handler, Qinsert_file_contents, filename,
visit, beg, end, replace);
- if (CONSP (val) && CONSP (XCDR (val)))
+ if (CONSP (val) && CONSP (XCDR (val))
+ && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
inserted = XINT (XCAR (XCDR (val)));
goto handled;
}
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- total = stat (SSDATA (filename), &st);
+ file_status = stat (SSDATA (filename), &st);
Vw32_get_true_file_attributes = tem;
}
- if (total < 0)
#else
- if (stat (SSDATA (filename), &st) < 0)
+ file_status = stat (SSDATA (filename), &st);
#endif /* WINDOWSNT */
+
+ if (file_status == 0)
+ mtime = get_stat_mtime (&st);
+ else
{
badopen:
save_errno = errno;
if (NILP (visit))
report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
- st.st_mtime = -1;
+ mtime = time_error_value (save_errno);
st.st_size = -1;
how_much = 0;
if (!NILP (Vcoding_system_for_read))
We assume that the 1K-byte and 3K-byte for heading
and tailing respectively are sufficient for this
purpose. */
- EMACS_INT nread;
+ int nread;
if (st.st_size <= (1024 * 4))
nread = emacs_read (fd, read_buf, 1024 * 4);
Lisp_Object workbuf;
struct buffer *buf;
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
workbuf = Fget_buffer_create (build_string (" *code-converting-work*"));
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_directory (buf, BVAR (current_buffer, directory));
+ bset_read_only (buf, Qnil);
+ bset_filename (buf, Qnil);
+ bset_undo_list (buf, Qt);
eassert (buf->overlays_before == NULL);
eassert (buf->overlays_after == NULL);
set_buffer_internal (buf);
Ferase_buffer ();
- BVAR (buf, enable_multibyte_characters) = Qnil;
+ bset_enable_multibyte_characters (buf, Qnil);
insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
/* same_at_start and same_at_end count bytes,
because file access counts bytes
and BEG and END count bytes. */
- EMACS_INT same_at_start = BEGV_BYTE;
- EMACS_INT same_at_end = ZV_BYTE;
- EMACS_INT overlap;
+ ptrdiff_t same_at_start = BEGV_BYTE;
+ ptrdiff_t same_at_end = ZV_BYTE;
+ ptrdiff_t overlap;
/* There is still a possibility we will find the need to do code
- conversion. If that happens, we set this variable to 1 to
+ conversion. If that happens, set this variable to
give up on handling REPLACE in the optimized way. */
- int giveup_match_end = 0;
+ bool giveup_match_end = 0;
if (beg_offset != 0)
{
match the text at the beginning of the buffer. */
while (1)
{
- EMACS_INT nread, bufpos;
+ int nread, bufpos;
nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
if (! giveup_match_end)
{
- EMACS_INT temp;
+ ptrdiff_t temp;
/* We win! We can handle REPLACE the optimized way. */
/* If display currently starts at beginning of line,
keep it that way. */
if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
- XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+ XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
replace_handled = 1;
}
in a more optimized way. */
if (!NILP (replace) && ! replace_handled && BEGV < ZV)
{
- EMACS_INT same_at_start = BEGV_BYTE;
- EMACS_INT same_at_end = ZV_BYTE;
- EMACS_INT same_at_start_charpos;
- EMACS_INT inserted_chars;
- EMACS_INT overlap;
- EMACS_INT bufpos;
+ ptrdiff_t same_at_start = BEGV_BYTE;
+ ptrdiff_t same_at_end = ZV_BYTE;
+ ptrdiff_t same_at_start_charpos;
+ ptrdiff_t inserted_chars;
+ ptrdiff_t overlap;
+ ptrdiff_t bufpos;
unsigned char *decoded;
- EMACS_INT temp;
- EMACS_INT this = 0;
- int this_count = SPECPDL_INDEX ();
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t temp;
+ ptrdiff_t this = 0;
+ ptrdiff_t this_count = SPECPDL_INDEX ();
+ bool multibyte
+ = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
Lisp_Object conversion_buffer;
struct gcpro gcpro1;
/* We read one bunch by one (READ_BUF_SIZE bytes) to allow
quitting while reading a huge while. */
/* `try'' is reserved in some compilers (Microsoft C). */
- EMACS_INT trytry = min (total - how_much,
- READ_BUF_SIZE - unprocessed);
+ int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
/* If display currently starts at beginning of line,
keep it that way. */
if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
- XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+ XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
/* Replace the chars that we need to replace,
and update INSERTED to equal the number of bytes
/* Here, we don't do code conversion in the loop. It is done by
decode_coding_gap after all data are read into the buffer. */
{
- EMACS_INT gap_size = GAP_SIZE;
+ ptrdiff_t gap_size = GAP_SIZE;
while (how_much < total)
{
/* try is reserved in some compilers (Microsoft C) */
- EMACS_INT trytry = min (total - how_much, READ_BUF_SIZE);
- EMACS_INT this;
+ int trytry = min (total - how_much, READ_BUF_SIZE);
+ ptrdiff_t this;
if (not_regular)
{
care of marker adjustment. By this way, we can run Lisp
program safely before decoding the inserted text. */
Lisp_Object unwind_data;
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
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_enable_multibyte_characters (current_buffer, Qnil);
+ bset_undo_list (current_buffer, Qt);
record_unwind_protect (decide_coding_unwind, unwind_data);
if (inserted > 0 && ! NILP (Vset_auto_coding_function))
&& NILP (replace))
/* Visiting a file with these coding system makes the buffer
unibyte. */
- BVAR (current_buffer, enable_multibyte_characters) = Qnil;
+ bset_enable_multibyte_characters (current_buffer, Qnil);
}
coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
if (!NILP (visit))
{
if (!EQ (BVAR (current_buffer, undo_list), Qt) && !nochange)
- BVAR (current_buffer, undo_list) = Qnil;
+ bset_undo_list (current_buffer, Qnil);
if (NILP (handler))
{
- current_buffer->modtime = st.st_mtime;
+ current_buffer->modtime = mtime;
current_buffer->modtime_size = st.st_size;
- BVAR (current_buffer, filename) = orig_filename;
+ bset_filename (current_buffer, orig_filename);
}
SAVE_MODIFF = MODIFF;
visit);
if (! NILP (insval))
{
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
}
}
if (inserted > 0)
{
/* Don't run point motion or modification hooks when decoding. */
- int count1 = SPECPDL_INDEX ();
- EMACS_INT old_inserted = inserted;
+ ptrdiff_t count1 = SPECPDL_INDEX ();
+ ptrdiff_t old_inserted = inserted;
specbind (Qinhibit_point_motion_hooks, Qt);
specbind (Qinhibit_modification_hooks, Qt);
/* 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_undo_list (current_buffer, Qt);
if (NILP (replace))
{
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
}
else
Hence we temporarily save `point' and `inserted' here and
restore `point' iff format-decode did not insert or delete
any text. Otherwise we leave `point' at point-min. */
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
- EMACS_INT oinserted = ZV - BEGV;
- int ochars_modiff = CHARS_MODIFF;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
+ ptrdiff_t oinserted = ZV - BEGV;
+ EMACS_INT ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call3 (Qformat_decode,
Qnil, make_number (oinserted), visit);
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
if (ochars_modiff == CHARS_MODIFF)
/* format_decode didn't modify buffer's characters => move
point back to position before inserted text and leave
insval = call1 (XCAR (p), make_number (inserted));
if (!NILP (insval))
{
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
}
}
{
/* For the rationale of this see the comment on
format-decode above. */
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
- EMACS_INT oinserted = ZV - BEGV;
- int ochars_modiff = CHARS_MODIFF;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
+ ptrdiff_t oinserted = ZV - BEGV;
+ EMACS_INT ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call1 (XCAR (p), make_number (oinserted));
if (!NILP (insval))
{
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
if (ochars_modiff == CHARS_MODIFF)
/* after_insert_file_functions didn't modify
buffer's characters => move point back to
if (NILP (visit))
{
- BVAR (current_buffer, undo_list) = old_undo;
+ bset_undo_list (current_buffer, old_undo);
if (CONSP (old_undo) && inserted != old_inserted)
{
/* Adjust the last undo record for the size change during
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_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
unbind_to (count1, Qnil);
}
if (!NILP (visit)
- && current_buffer->modtime == -1)
+ && EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS)
{
/* If visiting nonexistent file, return nil. */
errno = save_errno;
If it is not set locally, we anyway have to convert EOL
format if the default value of `buffer-file-coding-system'
tells that it is not Unix-like (LF only) format. */
- int using_default_coding = 0;
- int force_raw_text = 0;
+ bool using_default_coding = 0;
+ bool force_raw_text = 0;
val = BVAR (current_buffer, buffer_file_coding_system);
if (NILP (val)
`write-region-post-annotation-function' at the end. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
{
- register int desc;
- int failure;
+ int desc;
+ bool ok;
int save_errno = 0;
const char *fn;
struct stat st;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int count1;
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;
Lisp_Object encoded_filename;
- int visiting = (EQ (visit, Qt) || STRINGP (visit));
- int quietly = !NILP (visit);
+ bool visiting = (EQ (visit, Qt) || STRINGP (visit));
+ bool quietly = !NILP (visit);
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct buffer *given_buffer;
struct coding_system coding;
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
- BVAR (current_buffer, filename) = visit_file;
+ bset_filename (current_buffer, visit_file);
}
UNGCPRO;
return val;
UNGCPRO;
- failure = 0;
immediate_quit = 1;
if (STRINGP (start))
- {
- failure = 0 > a_write (desc, start, 0, SCHARS (start),
- &annotations, &coding);
- save_errno = errno;
- }
+ ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
else if (XINT (start) != XINT (end))
- {
- failure = 0 > a_write (desc, Qnil,
- XINT (start), XINT (end) - XINT (start),
- &annotations, &coding);
- save_errno = errno;
- }
+ ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
+ &annotations, &coding);
else
{
- /* If file was empty, still need to write the annotations */
+ /* If file was empty, still need to write the annotations. */
coding.mode |= CODING_MODE_LAST_BLOCK;
- failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
- save_errno = errno;
+ ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
}
+ save_errno = errno;
- if (CODING_REQUIRE_FLUSHING (&coding)
- && !(coding.mode & CODING_MODE_LAST_BLOCK)
- && ! failure)
+ if (ok && CODING_REQUIRE_FLUSHING (&coding)
+ && !(coding.mode & CODING_MODE_LAST_BLOCK))
{
/* We have to flush out a data. */
coding.mode |= CODING_MODE_LAST_BLOCK;
- failure = 0 > e_write (desc, Qnil, 1, 1, &coding);
+ ok = e_write (desc, Qnil, 1, 1, &coding);
save_errno = errno;
}
ignore EINVAL which happens when fsync is not supported on this
file. */
if (errno != EINTR && errno != EINVAL)
- failure = 1, save_errno = errno;
+ ok = 0, save_errno = errno;
}
#endif
/* NFS can report a write failure now. */
if (emacs_close (desc) < 0)
- failure = 1, save_errno = errno;
+ ok = 0, save_errno = errno;
stat (fn, &st);
next attempt to save. */
if (visiting)
{
- current_buffer->modtime = st.st_mtime;
+ current_buffer->modtime = get_stat_mtime (&st);
current_buffer->modtime_size = st.st_size;
}
- if (failure)
+ if (! ok)
error ("IO error writing %s: %s", SDATA (filename),
emacs_strerror (save_errno));
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
- BVAR (current_buffer, filename) = visit_file;
+ bset_filename (current_buffer, visit_file);
update_mode_lines++;
}
else if (quietly)
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
- int i, used_global = 0;
+ int i;
+ bool used_global = 0;
XSETBUFFER (original_buffer, current_buffer);
We modify *ANNOT by discarding elements as we use them up.
- The return value is negative in case of system call failure. */
+ Return true if successful. */
-static int
-a_write (int desc, Lisp_Object string, EMACS_INT pos,
- register EMACS_INT nchars, Lisp_Object *annot,
+static bool
+a_write (int desc, Lisp_Object string, ptrdiff_t pos,
+ ptrdiff_t nchars, Lisp_Object *annot,
struct coding_system *coding)
{
Lisp_Object tem;
- EMACS_INT nextpos;
- EMACS_INT lastpos = pos + nchars;
+ ptrdiff_t nextpos;
+ ptrdiff_t lastpos = pos + nchars;
while (NILP (*annot) || CONSP (*annot))
{
/* Output buffer text up to the next annotation's position. */
if (nextpos > pos)
{
- if (0 > e_write (desc, string, pos, nextpos, coding))
- return -1;
+ if (!e_write (desc, string, pos, nextpos, coding))
+ return 0;
pos = nextpos;
}
/* Output the annotation. */
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
- if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))
- return -1;
+ if (!e_write (desc, tem, 0, SCHARS (tem), coding))
+ return 0;
}
*annot = Fcdr (*annot);
}
- return 0;
+ return 1;
}
/* Write text in the range START and END into descriptor DESC,
encoding them with coding system CODING. If STRING is nil, START
and END are character positions of the current buffer, else they
- are indexes to the string STRING. */
+ are indexes to the string STRING. Return true if successful. */
-static int
-e_write (int desc, Lisp_Object string, EMACS_INT start, EMACS_INT end,
+static bool
+e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
struct coding_system *coding)
{
if (STRINGP (string))
}
else
{
- EMACS_INT start_byte = CHAR_TO_BYTE (start);
- EMACS_INT end_byte = CHAR_TO_BYTE (end);
+ ptrdiff_t start_byte = CHAR_TO_BYTE (start);
+ ptrdiff_t end_byte = CHAR_TO_BYTE (end);
coding->src_multibyte = (end - start) < (end_byte - start_byte);
if (CODING_REQUIRE_ENCODING (coding))
coding->produced);
if (coding->produced)
- return -1;
+ return 0;
}
start += coding->consumed_char;
}
- return 0;
+ return 1;
}
\f
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
struct stat st;
Lisp_Object handler;
Lisp_Object filename;
+ EMACS_TIME mtime, diff;
if (NILP (buf))
b = current_buffer;
}
if (!STRINGP (BVAR (b, filename))) return Qt;
- if (b->modtime == 0) return Qt;
+ if (EMACS_NSECS (b->modtime) == UNKNOWN_MODTIME_NSECS) return Qt;
/* If the file name has special constructs in it,
call the corresponding file handler. */
filename = ENCODE_FILE (BVAR (b, filename));
- if (stat (SSDATA (filename), &st) < 0)
- {
- /* If the file doesn't exist now and didn't exist before,
- we say that it isn't modified, provided the error is a tame one. */
- if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
- st.st_mtime = -1;
- else
- st.st_mtime = 0;
- }
- if ((st.st_mtime == b->modtime
- /* If both are positive, accept them if they are off by one second. */
- || (st.st_mtime > 0 && b->modtime > 0
- && (st.st_mtime - 1 == b->modtime
- || st.st_mtime == b->modtime - 1)))
+ mtime = (stat (SSDATA (filename), &st) == 0
+ ? get_stat_mtime (&st)
+ : time_error_value (errno));
+ if ((EMACS_TIME_EQ (mtime, b->modtime)
+ /* If both exist, accept them if they are off by one second. */
+ || (EMACS_TIME_VALID_P (mtime) && EMACS_TIME_VALID_P (b->modtime)
+ && ((diff = (EMACS_TIME_LT (mtime, b->modtime)
+ ? sub_emacs_time (b->modtime, mtime)
+ : sub_emacs_time (mtime, b->modtime))),
+ EMACS_TIME_LE (diff, make_emacs_time (1, 0)))))
&& (st.st_size == b->modtime_size
|| b->modtime_size < 0))
return Qt;
Next attempt to save will certainly not complain of a discrepancy. */)
(void)
{
- current_buffer->modtime = 0;
+ current_buffer->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS);
current_buffer->modtime_size = -1;
return Qnil;
}
DEFUN ("visited-file-modtime", Fvisited_file_modtime,
Svisited_file_modtime, 0, 0, 0,
doc: /* Return the current buffer's recorded visited file modification time.
-The value is a list of the form (HIGH LOW), like the time values that
+The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
`file-attributes' returns. If the current buffer has no recorded file
modification time, this function returns 0. If the visited file
doesn't exist, HIGH will be -1.
See Info node `(elisp)Modification Time' for more details. */)
(void)
{
- if (! current_buffer->modtime)
+ if (EMACS_NSECS (current_buffer->modtime) < 0)
return make_number (0);
- return make_time (current_buffer->modtime);
+ return make_lisp_time (current_buffer->modtime);
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
or if the file itself has been changed for some known benign reason.
An argument specifies the modification time value to use
\(instead of that of the visited file), in the form of a list
-\(HIGH . LOW) or (HIGH LOW). */)
+\(HIGH LOW USEC PSEC) as returned by `current-time'. */)
(Lisp_Object time_list)
{
if (!NILP (time_list))
{
- CONS_TO_INTEGER (time_list, time_t, current_buffer->modtime);
+ current_buffer->modtime = lisp_time_argument (time_list);
current_buffer->modtime_size = -1;
}
else
if (stat (SSDATA (filename), &st) >= 0)
{
- current_buffer->modtime = st.st_mtime;
+ current_buffer->modtime = get_stat_mtime (&st);
current_buffer->modtime_size = st.st_size;
}
}
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)
auto_saving = 0;
if (stream != NULL)
{
- BLOCK_INPUT;
+ block_input ();
fclose (stream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
return Qnil;
}
{
struct buffer *old = current_buffer, *b;
Lisp_Object tail, buf, hook;
- int auto_saved = 0;
+ bool auto_saved = 0;
int do_handled_files;
Lisp_Object oquit;
FILE *stream = NULL;
- int count = SPECPDL_INDEX ();
- int orig_minibuffer_auto_raise = minibuffer_auto_raise;
- int old_message_p = 0;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
+ bool old_message_p = 0;
struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)
if (STRINGP (BVAR (b, auto_save_file_name))
&& stream != NULL && do_handled_files == 0)
{
- BLOCK_INPUT;
+ block_input ();
if (!NILP (BVAR (b, filename)))
{
fwrite (SDATA (BVAR (b, filename)), 1,
fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
SBYTES (BVAR (b, auto_save_file_name)), stream);
putc ('\n', stream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (!NILP (current_only)
|| NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
Qwrite_region))))
{
- EMACS_TIME before_time, after_time;
-
- EMACS_GET_TIME (before_time);
+ EMACS_TIME before_time = current_emacs_time ();
+ EMACS_TIME after_time;
/* If we had a failure, don't try again for 20 minutes. */
if (b->auto_save_failure_time > 0
if (!auto_saved && NILP (no_message))
message1 ("Auto-saving...");
internal_condition_case (auto_save_1, Qt, auto_save_error);
- auto_saved++;
+ auto_saved = 1;
BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
set_buffer_internal (old);
- EMACS_GET_TIME (after_time);
+ after_time = current_emacs_time ();
/* If auto-save took more than 60 seconds,
assume it was an NFS failure that got a timeout. */
DEFSYM (Qexcl, "excl");
DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
- doc: /* *Coding system for encoding file names.
+ doc: /* Coding system for encoding file names.
If it is nil, `default-file-name-coding-system' (which see) is used. */);
Vfile_name_coding_system = Qnil;
Fput (Qfile_error, Qerror_conditions,
Fpurecopy (list2 (Qfile_error, Qerror)));
Fput (Qfile_error, Qerror_message,
- make_pure_c_string ("File error"));
+ build_pure_c_string ("File error"));
Fput (Qfile_already_exists, Qerror_conditions,
Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
Fput (Qfile_already_exists, Qerror_message,
- make_pure_c_string ("File already exists"));
+ build_pure_c_string ("File already exists"));
Fput (Qfile_date_error, Qerror_conditions,
Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
Fput (Qfile_date_error, Qerror_message,
- make_pure_c_string ("Cannot set file date"));
+ build_pure_c_string ("Cannot set file date"));
DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
#ifdef HAVE_FSYNC
DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
- doc: /* *Non-nil means don't call fsync in `write-region'.
+ doc: /* Non-nil means don't call fsync in `write-region'.
This variable affects calls to `write-region' as well as save commands.
A non-nil value may result in data loss! */);
write_region_inhibit_fsync = 0;
#include <sys/stat.h>
#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
#include <errno.h>
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "systime.h"
/* Return the time of the last system boot. */
static time_t boot_time;
-static int boot_time_initialized;
+static bool boot_time_initialized;
#ifdef BOOT_TIME
-static void get_boot_time_1 (const char *, int);
+static void get_boot_time_1 (const char *, bool);
#endif
static time_t
{
char cmd_string[sizeof WTMP_FILE ".19.gz"];
Lisp_Object tempname, filename;
- int delete_flag = 0;
+ bool delete_flag = 0;
filename = Qnil;
- sprintf (cmd_string, "%s.%d", WTMP_FILE, counter);
- tempname = build_string (cmd_string);
+ tempname = make_formatted_string
+ (cmd_string, "%s.%d", WTMP_FILE, counter);
if (! NILP (Ffile_exists_p (tempname)))
filename = tempname;
else
{
- sprintf (cmd_string, "%s.%d.gz", WTMP_FILE, counter);
- tempname = build_string (cmd_string);
+ tempname = make_formatted_string (cmd_string, "%s.%d.gz",
+ WTMP_FILE, counter);
if (! NILP (Ffile_exists_p (tempname)))
{
Lisp_Object args[6];
If FILENAME is zero, use the same file as before;
if no FILENAME has ever been specified, this is the utmp file.
- Use the newest reboot record if NEWEST is nonzero,
+ Use the newest reboot record if NEWEST,
the first reboot record otherwise.
Ignore all reboot records on or before BOOT_TIME.
Success is indicated by setting BOOT_TIME to a larger value. */
void
-get_boot_time_1 (const char *filename, int newest)
+get_boot_time_1 (const char *filename, bool newest)
{
struct utmp ut, *utp;
int desc;
trailing period plus one for the digit after it plus one for the
null. */
#define MAKE_LOCK_NAME(lock, file) \
- (lock = (char *) alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
+ (lock = alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
fill_in_lock_file_name (lock, (file)))
static void
fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn)
{
+ ptrdiff_t length = SBYTES (fn);
register char *p;
struct stat st;
int count = 0;
/* Shift the nondirectory part of the file name (including the null)
right two characters. Here is one of the places where we'd have to
do something to support 14-character-max file names. */
- for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
+ for (p = lockfile + length; p != lockfile && *p != '/'; p--)
p[2] = *p;
/* Insert the `.#'. */
p[1] = '.';
p[2] = '#';
- p = p + strlen (p);
+ p = p + length + 2;
while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode))
{
}
/* Lock the lock file named LFNAME.
- If FORCE is nonzero, we do so even if it is already locked.
- Return 1 if successful, 0 if not. */
+ If FORCE, do so even if it is already locked.
+ Return true if successful. */
-static int
-lock_file_1 (char *lfname, int force)
+static bool
+lock_file_1 (char *lfname, bool 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 ();
-
- 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 ();
+ printmax_t boot = get_boot_time ();
+
+ 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);
return err == 0;
}
-/* Return 1 if times A and B are no more than one second apart. */
+/* Return true if times A and B are no more than one second apart. */
-static int
+static bool
within_one_second (time_t a, time_t b)
{
return (a - b >= -1 && a - b <= 1);
return -1;
}
len = at - lfinfo;
- owner->user = (char *) xmalloc (len + 1);
+ owner->user = xmalloc (len + 1);
memcpy (owner->user, lfinfo, len);
owner->user[len] = 0;
/* The host is everything in between. */
len = dot - at - 1;
- owner->host = (char *) xmalloc (len + 1);
+ owner->host = xmalloc (len + 1);
memcpy (owner->host, at + 1, len);
owner->host[len] = 0;
static int
lock_if_free (lock_info_type *clasher, register char *lfname)
{
- while (lock_file_1 (lfname, 0) == 0)
+ while (! lock_file_1 (lfname, 0))
{
int locker;
struct gcpro gcpro1;
USE_SAFE_ALLOCA;
+ /* Don't do locking if the user has opted out. */
+ if (! create_lockfiles)
+ return;
+
/* Don't do locking while dumping Emacs.
Uncompressing wtmp files uses call-process, which does not work
in an uninitialized Emacs. */
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);
return ret;
}
-\f
-/* Initialization functions. */
-
-void
-init_filelock (void)
-{
- boot_time = 0;
- boot_time_initialized = 0;
-}
#endif /* CLASH_DETECTION */
doc: /* The directory for writing temporary files. */);
Vtemporary_file_directory = Qnil;
+ DEFVAR_BOOL ("create-lockfiles", create_lockfiles,
+ doc: /* Non-nil means use lockfiles to avoid editing collisions. */);
+ create_lockfiles = 1;
+
#ifdef CLASH_DETECTION
defsubr (&Sunlock_buffer);
defsubr (&Slock_buffer);
char * my_begbss_static = _my_begbss;
/* Add a dummy reference to ensure emacs.obj is linked in. */
-extern int initialized;
-static int * dummy = &initialized;
+extern int main (int, char **);
+static int (*dummy) (int, char **) = main;
#endif
-
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-/* ANSI C requires only these float functions:
- acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
- frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
-
- Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh.
- Define HAVE_CBRT if you have cbrt.
- Define HAVE_RINT if you have a working rint.
- If you don't define these, then the appropriate routines will be simulated.
-
- Define HAVE_MATHERR if on a system supporting the SysV matherr callback.
- (This should happen automatically.)
-
- Define FLOAT_CHECK_ERRNO if the float library routines set errno.
- This has no effect if HAVE_MATHERR is defined.
-
- Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL.
- (What systems actually do this? Please let us know.)
-
- Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by
- either setting errno, or signaling SIGFPE/SIGILL. Otherwise, domain and
- range checking will happen before calling the float routines. This has
- no effect if HAVE_MATHERR is defined (since matherr will be called when
- a domain error occurs.)
+/* C89 requires only the following math.h functions, and Emacs omits
+ the starred functions since we haven't found a use for them:
+ acos, asin, atan, atan2, ceil, cos, *cosh, exp, fabs, floor, fmod,
+ frexp, ldexp, log, log10, *modf, pow, sin, *sinh, sqrt, tan, *tanh.
*/
#include <config.h>
-#include <signal.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "syssignal.h"
-
-#include <float.h>
-/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
-#ifndef IEEE_FLOATING_POINT
-#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
- && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
-#define IEEE_FLOATING_POINT 1
-#else
-#define IEEE_FLOATING_POINT 0
-#endif
-#endif
#include <math.h>
-/* This declaration is omitted on some systems, like Ultrix. */
-#if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb)
-extern double logb (double);
-#endif /* not HPUX and HAVE_LOGB and no logb macro */
-
-#if defined (DOMAIN) && defined (SING) && defined (OVERFLOW)
- /* If those are defined, then this is probably a `matherr' machine. */
-# ifndef HAVE_MATHERR
-# define HAVE_MATHERR
-# endif
-#endif
-
-#ifdef NO_MATHERR
-#undef HAVE_MATHERR
-#endif
-
-#ifdef HAVE_MATHERR
-# ifdef FLOAT_CHECK_ERRNO
-# undef FLOAT_CHECK_ERRNO
-# endif
-# ifdef FLOAT_CHECK_DOMAIN
-# undef FLOAT_CHECK_DOMAIN
-# endif
+#ifndef isfinite
+# define isfinite(x) ((x) - (x) == 0)
#endif
-
-#ifndef NO_FLOAT_CHECK_ERRNO
-#define FLOAT_CHECK_ERRNO
-#endif
-
-#ifdef FLOAT_CHECK_ERRNO
-# include <errno.h>
-#endif
-
-#ifdef FLOAT_CATCH_SIGILL
-static void float_error ();
-#endif
-
-/* Nonzero while executing in floating point.
- This tells float_error what to do. */
-
-static int in_float;
-
-/* If an argument is out of range for a mathematical function,
- here is the actual argument value to use in the error message.
- These variables are used only across the floating point library call
- so there is no need to staticpro them. */
-
-static Lisp_Object float_error_arg, float_error_arg2;
-
-static const char *float_error_fn_name;
-
-/* Evaluate the floating point expression D, recording NUM
- as the original argument for error messages.
- D is normally an assignment expression.
- Handle errors which may result in signals or may set errno.
-
- Note that float_error may be declared to return void, so you can't
- just cast the zero after the colon to (void) to make the types
- check properly. */
-
-#ifdef FLOAT_CHECK_ERRNO
-#define IN_FLOAT(d, name, num) \
- do { \
- float_error_arg = num; \
- float_error_fn_name = name; \
- in_float = 1; errno = 0; (d); in_float = 0; \
- switch (errno) { \
- case 0: break; \
- case EDOM: domain_error (float_error_fn_name, float_error_arg); \
- case ERANGE: range_error (float_error_fn_name, float_error_arg); \
- default: arith_error (float_error_fn_name, float_error_arg); \
- } \
- } while (0)
-#define IN_FLOAT2(d, name, num, num2) \
- do { \
- float_error_arg = num; \
- float_error_arg2 = num2; \
- float_error_fn_name = name; \
- in_float = 1; errno = 0; (d); in_float = 0; \
- switch (errno) { \
- case 0: break; \
- case EDOM: domain_error (float_error_fn_name, float_error_arg); \
- case ERANGE: range_error (float_error_fn_name, float_error_arg); \
- default: arith_error (float_error_fn_name, float_error_arg); \
- } \
- } while (0)
-#else
-#define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0)
-#define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0)
-#endif
-
-/* Convert float to Lisp_Int if it fits, else signal a range error
- using the given arguments. */
-#define FLOAT_TO_INT(x, i, name, num) \
- do \
- { \
- if (FIXNUM_OVERFLOW_P (x)) \
- range_error (name, num); \
- XSETINT (i, (EMACS_INT)(x)); \
- } \
- while (0)
-#define FLOAT_TO_INT2(x, i, name, num1, num2) \
- do \
- { \
- if (FIXNUM_OVERFLOW_P (x)) \
- range_error2 (name, num1, num2); \
- XSETINT (i, (EMACS_INT)(x)); \
- } \
- while (0)
-
-#define arith_error(op,arg) \
- xsignal2 (Qarith_error, build_string ((op)), (arg))
-#define range_error(op,arg) \
- xsignal2 (Qrange_error, build_string ((op)), (arg))
-#define range_error2(op,a1,a2) \
- xsignal3 (Qrange_error, build_string ((op)), (a1), (a2))
-#define domain_error(op,arg) \
- xsignal2 (Qdomain_error, build_string ((op)), (arg))
-#ifdef FLOAT_CHECK_DOMAIN
-#define domain_error2(op,a1,a2) \
- xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2))
+#ifndef isnan
+# define isnan(x) ((x) != (x))
#endif
/* Extract a Lisp number as a `double', or signal an error. */
DEFUN ("acos", Facos, Sacos, 1, 1, 0,
doc: /* Return the inverse cosine of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 1.0 || d < -1.0)
- domain_error ("acos", arg);
-#endif
- IN_FLOAT (d = acos (d), "acos", arg);
+ d = acos (d);
return make_float (d);
}
DEFUN ("asin", Fasin, Sasin, 1, 1, 0,
doc: /* Return the inverse sine of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 1.0 || d < -1.0)
- domain_error ("asin", arg);
-#endif
- IN_FLOAT (d = asin (d), "asin", arg);
+ d = asin (d);
return make_float (d);
}
If two arguments Y and X are given, return the inverse tangent of Y
divided by X, i.e. the angle in radians between the vector (X, Y)
and the x-axis. */)
- (register Lisp_Object y, Lisp_Object x)
+ (Lisp_Object y, Lisp_Object x)
{
double d = extract_float (y);
if (NILP (x))
- IN_FLOAT (d = atan (d), "atan", y);
+ d = atan (d);
else
{
double d2 = extract_float (x);
-
- IN_FLOAT2 (d = atan2 (d, d2), "atan", y, x);
+ d = atan2 (d, d2);
}
return make_float (d);
}
DEFUN ("cos", Fcos, Scos, 1, 1, 0,
doc: /* Return the cosine of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = cos (d), "cos", arg);
+ d = cos (d);
return make_float (d);
}
DEFUN ("sin", Fsin, Ssin, 1, 1, 0,
doc: /* Return the sine of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = sin (d), "sin", arg);
+ d = sin (d);
return make_float (d);
}
DEFUN ("tan", Ftan, Stan, 1, 1, 0,
doc: /* Return the tangent of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- double c = cos (d);
-#ifdef FLOAT_CHECK_DOMAIN
- if (c == 0.0)
- domain_error ("tan", arg);
-#endif
- IN_FLOAT (d = sin (d) / c, "tan", arg);
+ d = tan (d);
return make_float (d);
}
-#undef isnan
-#define isnan(x) ((x) != (x))
-
DEFUN ("isnan", Fisnan, Sisnan, 1, 1, 0,
doc: /* Return non nil iff argument X is a NaN. */)
(Lisp_Object x)
return make_float (copysign (f1, f2));
}
+#endif
DEFUN ("frexp", Ffrexp, Sfrexp, 1, 1, 0,
doc: /* Get significand and exponent of a floating point number.
(Lisp_Object x)
{
double f = XFLOATINT (x);
-
- if (f == 0.0)
- return Fcons (make_float (0.0), make_number (0));
- else
- {
- int exponent;
- double sgnfcand = frexp (f, &exponent);
- return Fcons (make_float (sgnfcand), make_number (exponent));
- }
+ int exponent;
+ double sgnfcand = frexp (f, &exponent);
+ return Fcons (make_float (sgnfcand), make_number (exponent));
}
DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0,
CHECK_NUMBER (exponent);
return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent)));
}
-#endif
-\f
-#if 0 /* Leave these out unless we find there's a reason for them. */
-
-DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0,
- doc: /* Return the bessel function j0 of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = j0 (d), "bessel-j0", arg);
- return make_float (d);
-}
-
-DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0,
- doc: /* Return the bessel function j1 of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = j1 (d), "bessel-j1", arg);
- return make_float (d);
-}
-
-DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0,
- doc: /* Return the order N bessel function output jn of ARG.
-The first arg (the order) is truncated to an integer. */)
- (register Lisp_Object n, Lisp_Object arg)
-{
- int i1 = extract_float (n);
- double f2 = extract_float (arg);
-
- IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n);
- return make_float (f2);
-}
-
-DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0,
- doc: /* Return the bessel function y0 of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = y0 (d), "bessel-y0", arg);
- return make_float (d);
-}
-
-DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0,
- doc: /* Return the bessel function y1 of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = y1 (d), "bessel-y0", arg);
- return make_float (d);
-}
-
-DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0,
- doc: /* Return the order N bessel function output yn of ARG.
-The first arg (the order) is truncated to an integer. */)
- (register Lisp_Object n, Lisp_Object arg)
-{
- int i1 = extract_float (n);
- double f2 = extract_float (arg);
-
- IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n);
- return make_float (f2);
-}
-
-#endif
-\f
-#if 0 /* Leave these out unless we see they are worth having. */
-
-DEFUN ("erf", Ferf, Serf, 1, 1, 0,
- doc: /* Return the mathematical error function of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = erf (d), "erf", arg);
- return make_float (d);
-}
-
-DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0,
- doc: /* Return the complementary error function of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = erfc (d), "erfc", arg);
- return make_float (d);
-}
-
-DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0,
- doc: /* Return the log gamma of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
- IN_FLOAT (d = lgamma (d), "log-gamma", arg);
- return make_float (d);
-}
-
-DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0,
- doc: /* Return the cube root of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef HAVE_CBRT
- IN_FLOAT (d = cbrt (d), "cube-root", arg);
-#else
- if (d >= 0.0)
- IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg);
- else
- IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg);
-#endif
- return make_float (d);
-}
-
-#endif
\f
DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
doc: /* Return the exponential base e of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 709.7827) /* Assume IEEE doubles here */
- range_error ("exp", arg);
- else if (d < -709.0)
- return make_float (0.0);
- else
-#endif
- IN_FLOAT (d = exp (d), "exp", arg);
+ d = exp (d);
return make_float (d);
}
DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
doc: /* Return the exponential ARG1 ** ARG2. */)
- (register Lisp_Object arg1, Lisp_Object arg2)
+ (Lisp_Object arg1, Lisp_Object arg2)
{
double f1, f2, f3;
&& INTEGERP (arg2) /* don't promote, if both are ints, and */
&& 0 <= XINT (arg2)) /* we are sure the result is not fractional */
{ /* this can be improved by pre-calculating */
- EMACS_INT acc, x, y; /* some binary powers of x then accumulating */
+ EMACS_INT y; /* some binary powers of x then accumulating */
+ EMACS_UINT acc, x; /* Unsigned so that overflow is well defined. */
Lisp_Object val;
x = XINT (arg1);
y = XINT (arg2);
- acc = 1;
+ acc = (y & 1 ? x : 1);
- if (y < 0)
- {
- if (x == 1)
- acc = 1;
- else if (x == -1)
- acc = (y & 1) ? -1 : 1;
- else
- acc = 0;
- }
- else
+ while ((y >>= 1) != 0)
{
- while (y > 0)
- {
- if (y & 1)
- acc *= x;
- x *= x;
- y >>= 1;
- }
+ x *= x;
+ if (y & 1)
+ acc *= x;
}
XSETINT (val, acc);
return val;
}
f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1);
f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2);
- /* Really should check for overflow, too */
- if (f1 == 0.0 && f2 == 0.0)
- f1 = 1.0;
-#ifdef FLOAT_CHECK_DOMAIN
- else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor (f2)))
- domain_error2 ("expt", arg1, arg2);
-#endif
- IN_FLOAT2 (f3 = pow (f1, f2), "expt", arg1, arg2);
- /* Check for overflow in the result. */
- if (f1 != 0.0 && f3 == 0.0)
- range_error ("expt", arg1);
+ f3 = pow (f1, f2);
return make_float (f3);
}
DEFUN ("log", Flog, Slog, 1, 2, 0,
doc: /* Return the natural logarithm of ARG.
If the optional argument BASE is given, return log ARG using that base. */)
- (register Lisp_Object arg, Lisp_Object base)
+ (Lisp_Object arg, Lisp_Object base)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d <= 0.0)
- domain_error2 ("log", arg, base);
-#endif
if (NILP (base))
- IN_FLOAT (d = log (d), "log", arg);
+ d = log (d);
else
{
double b = extract_float (base);
-#ifdef FLOAT_CHECK_DOMAIN
- if (b <= 0.0 || b == 1.0)
- domain_error2 ("log", arg, base);
-#endif
if (b == 10.0)
- IN_FLOAT2 (d = log10 (d), "log", arg, base);
+ d = log10 (d);
else
- IN_FLOAT2 (d = log (d) / log (b), "log", arg, base);
+ d = log (d) / log (b);
}
return make_float (d);
}
DEFUN ("log10", Flog10, Slog10, 1, 1, 0,
doc: /* Return the logarithm base 10 of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d <= 0.0)
- domain_error ("log10", arg);
-#endif
- IN_FLOAT (d = log10 (d), "log10", arg);
+ d = log10 (d);
return make_float (d);
}
DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
doc: /* Return the square root of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d < 0.0)
- domain_error ("sqrt", arg);
-#endif
- IN_FLOAT (d = sqrt (d), "sqrt", arg);
- return make_float (d);
-}
-\f
-#if 0 /* Not clearly worth adding. */
-
-DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0,
- doc: /* Return the inverse hyperbolic cosine of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d < 1.0)
- domain_error ("acosh", arg);
-#endif
-#ifdef HAVE_INVERSE_HYPERBOLIC
- IN_FLOAT (d = acosh (d), "acosh", arg);
-#else
- IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg);
-#endif
- return make_float (d);
-}
-
-DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0,
- doc: /* Return the inverse hyperbolic sine of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef HAVE_INVERSE_HYPERBOLIC
- IN_FLOAT (d = asinh (d), "asinh", arg);
-#else
- IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg);
-#endif
- return make_float (d);
-}
-
-DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0,
- doc: /* Return the inverse hyperbolic tangent of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d >= 1.0 || d <= -1.0)
- domain_error ("atanh", arg);
-#endif
-#ifdef HAVE_INVERSE_HYPERBOLIC
- IN_FLOAT (d = atanh (d), "atanh", arg);
-#else
- IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg);
-#endif
- return make_float (d);
-}
-
-DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0,
- doc: /* Return the hyperbolic cosine of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 710.0 || d < -710.0)
- range_error ("cosh", arg);
-#endif
- IN_FLOAT (d = cosh (d), "cosh", arg);
- return make_float (d);
-}
-
-DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0,
- doc: /* Return the hyperbolic sine of ARG. */)
- (register Lisp_Object arg)
-{
- double d = extract_float (arg);
-#ifdef FLOAT_CHECK_DOMAIN
- if (d > 710.0 || d < -710.0)
- range_error ("sinh", arg);
-#endif
- IN_FLOAT (d = sinh (d), "sinh", arg);
- return make_float (d);
-}
-
-DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0,
- doc: /* Return the hyperbolic tangent of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = tanh (d), "tanh", arg);
+ d = sqrt (d);
return make_float (d);
}
-#endif
\f
DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
doc: /* Return the absolute value of ARG. */)
CHECK_NUMBER_OR_FLOAT (arg);
if (FLOATP (arg))
- IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))), "abs", arg);
+ arg = make_float (fabs (XFLOAT_DATA (arg)));
else if (XINT (arg) < 0)
XSETINT (arg, - XINT (arg));
if (f == 0.0)
value = MOST_NEGATIVE_FIXNUM;
- else
+ else if (isfinite (f))
{
-#ifdef HAVE_LOGB
- IN_FLOAT (value = logb (f), "logb", arg);
-#else
-#ifdef HAVE_FREXP
int ivalue;
- IN_FLOAT (frexp (f, &ivalue), "logb", arg);
+ frexp (f, &ivalue);
value = ivalue - 1;
-#else
- int i;
- double d;
- if (f < 0.0)
- f = -f;
- value = -1;
- while (f < 0.5)
- {
- for (i = 1, d = 0.5; d * d >= f; i += i)
- d *= d;
- f /= d;
- value -= i;
- }
- while (f >= 1.0)
- {
- for (i = 1, d = 2.0; d * d <= f; i += i)
- d *= d;
- f /= d;
- value += i;
- }
-#endif
-#endif
}
+ else
+ value = MOST_POSITIVE_FIXNUM;
+
XSETINT (val, value);
return val;
}
if (! IEEE_FLOATING_POINT && f2 == 0)
xsignal0 (Qarith_error);
- IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor);
- FLOAT_TO_INT2 (f1, arg, name, arg, divisor);
+ f1 = (*double_round) (f1 / f2);
+ if (FIXNUM_OVERFLOW_P (f1))
+ xsignal3 (Qrange_error, build_string (name), arg, divisor);
+ arg = make_number (f1);
return arg;
}
if (FLOATP (arg))
{
- double d;
-
- IN_FLOAT (d = (*double_round) (XFLOAT_DATA (arg)), name, arg);
- FLOAT_TO_INT (d, arg, name, arg);
+ double d = (*double_round) (XFLOAT_DATA (arg));
+ if (FIXNUM_OVERFLOW_P (d))
+ xsignal2 (Qrange_error, build_string (name), arg);
+ arg = make_number (d);
}
return arg;
f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x);
f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y);
- if (! IEEE_FLOATING_POINT && f2 == 0)
- xsignal0 (Qarith_error);
+ f1 = fmod (f1, f2);
/* If the "remainder" comes out with the wrong sign, fix it. */
- IN_FLOAT2 ((f1 = fmod (f1, f2),
- f1 = (f2 < 0 ? f1 > 0 : f1 < 0) ? f1 + f2 : f1),
- "mod", x, y);
+ if (f2 < 0 ? 0 < f1 : f1 < 0)
+ f1 += f2;
+
return make_float (f1);
}
\f
-/* It's not clear these are worth adding. */
-
DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,
doc: /* Return the smallest integer no less than ARG, as a float.
\(Round toward +inf.\) */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = ceil (d), "fceiling", arg);
+ d = ceil (d);
return make_float (d);
}
DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0,
doc: /* Return the largest integer no greater than ARG, as a float.
\(Round towards -inf.\) */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = floor (d), "ffloor", arg);
+ d = floor (d);
return make_float (d);
}
DEFUN ("fround", Ffround, Sfround, 1, 1, 0,
doc: /* Return the nearest integer to ARG, as a float. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
- IN_FLOAT (d = emacs_rint (d), "fround", arg);
+ d = emacs_rint (d);
return make_float (d);
}
DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0,
doc: /* Truncate a floating point number to an integral float value.
Rounds the value toward zero. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
double d = extract_float (arg);
if (d >= 0.0)
- IN_FLOAT (d = floor (d), "ftruncate", arg);
+ d = floor (d);
else
- IN_FLOAT (d = ceil (d), "ftruncate", arg);
+ d = ceil (d);
return make_float (d);
}
\f
-#ifdef FLOAT_CATCH_SIGILL
-static void
-float_error (int signo)
-{
- if (! in_float)
- fatal_error_signal (signo);
-
-#ifdef BSD_SYSTEM
- sigsetmask (SIGEMPTYMASK);
-#else
- /* Must reestablish handler each time it is called. */
- signal (SIGILL, float_error);
-#endif /* BSD_SYSTEM */
-
- SIGNAL_THREAD_CHECK (signo);
- in_float = 0;
-
- xsignal1 (Qarith_error, float_error_arg);
-}
-
-/* Another idea was to replace the library function `infnan'
- where SIGILL is signaled. */
-
-#endif /* FLOAT_CATCH_SIGILL */
-
-#ifdef HAVE_MATHERR
-int
-matherr (struct exception *x)
-{
- Lisp_Object args;
- const char *name = x->name;
-
- if (! in_float)
- /* Not called from emacs-lisp float routines; do the default thing. */
- return 0;
- if (!strcmp (x->name, "pow"))
- name = "expt";
-
- args
- = Fcons (build_string (name),
- Fcons (make_float (x->arg1),
- ((!strcmp (name, "log") || !strcmp (name, "pow"))
- ? Fcons (make_float (x->arg2), Qnil)
- : Qnil)));
- switch (x->type)
- {
- case DOMAIN: xsignal (Qdomain_error, args); break;
- case SING: xsignal (Qsingularity_error, args); break;
- case OVERFLOW: xsignal (Qoverflow_error, args); break;
- case UNDERFLOW: xsignal (Qunderflow_error, args); break;
- default: xsignal (Qarith_error, args); break;
- }
- return (1); /* don't set errno or print a message */
-}
-#endif /* HAVE_MATHERR */
-
-void
-init_floatfns (void)
-{
-#ifdef FLOAT_CATCH_SIGILL
- signal (SIGILL, float_error);
-#endif
- in_float = 0;
-}
-
void
syms_of_floatfns (void)
{
defsubr (&Sisnan);
#ifdef HAVE_COPYSIGN
defsubr (&Scopysign);
+#endif
defsubr (&Sfrexp);
defsubr (&Sldexp);
-#endif
-#if 0
- defsubr (&Sacosh);
- defsubr (&Sasinh);
- defsubr (&Satanh);
- defsubr (&Scosh);
- defsubr (&Ssinh);
- defsubr (&Stanh);
- defsubr (&Sbessel_y0);
- defsubr (&Sbessel_y1);
- defsubr (&Sbessel_yn);
- defsubr (&Sbessel_j0);
- defsubr (&Sbessel_j1);
- defsubr (&Sbessel_jn);
- defsubr (&Serf);
- defsubr (&Serfc);
- defsubr (&Slog_gamma);
- defsubr (&Scube_root);
-#endif
defsubr (&Sfceiling);
defsubr (&Sffloor);
defsubr (&Sfround);
#include <unistd.h>
#include <time.h>
-#include <setjmp.h>
#include <intprops.h>
#endif
#endif /* HAVE_MENUS */
-#ifndef NULL
-#define NULL ((POINTER_TYPE *)0)
-#endif
-
Lisp_Object Qstring_lessp;
static Lisp_Object Qprovide, Qrequire;
static Lisp_Object Qyes_or_no_p_history;
static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;
-static int internal_equal (Lisp_Object , Lisp_Object, int, int);
-
-#ifndef HAVE_UNISTD_H
-extern long time ();
-#endif
+static bool internal_equal (Lisp_Object, Lisp_Object, int, bool);
\f
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
doc: /* Return the argument unchanged. */)
(Lisp_Object limit)
{
EMACS_INT val;
- Lisp_Object lispy_val;
if (EQ (limit, Qt))
- {
- EMACS_TIME t;
- EMACS_GET_TIME (t);
- seed_random (getpid () ^ EMACS_SECS (t) ^ EMACS_USECS (t));
- }
+ init_random ();
+ else if (STRINGP (limit))
+ seed_random (SSDATA (limit), SBYTES (limit));
+ val = get_random ();
if (NATNUMP (limit) && XFASTINT (limit) != 0)
- {
- /* Try to take our random number from the higher bits of VAL,
- not the lower, since (says Gentzel) the low bits of `random'
- are less random than the higher ones. We do this by using the
- quotient rather than the remainder. At the high end of the RNG
- it's possible to get a quotient larger than n; discarding
- these values eliminates the bias that would otherwise appear
- when using a large n. */
- EMACS_INT denominator = (INTMASK + 1) / XFASTINT (limit);
- do
- val = get_random () / denominator;
- while (val >= XFASTINT (limit));
- }
- else
- val = get_random ();
- XSETINT (lispy_val, val);
- return lispy_val;
+ val %= XFASTINT (limit);
+ return make_number (val);
}
\f
/* Heuristic on how many iterations of a tight loop can be safely done
N - 1 is the number of characters that match at the beginning. */)
(Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case)
{
- register EMACS_INT end1_char, end2_char;
- register EMACS_INT i1, i1_byte, i2, i2_byte;
+ register ptrdiff_t end1_char, end2_char;
+ register ptrdiff_t i1, i1_byte, i2, i2_byte;
CHECK_STRING (str1);
CHECK_STRING (str2);
if (! NILP (end2))
CHECK_NATNUM (end2);
- i1 = XINT (start1);
- i2 = XINT (start2);
-
- i1_byte = string_char_to_byte (str1, i1);
- i2_byte = string_char_to_byte (str2, i2);
-
end1_char = SCHARS (str1);
if (! NILP (end1) && end1_char > XINT (end1))
end1_char = XINT (end1);
+ if (end1_char < XINT (start1))
+ args_out_of_range (str1, start1);
end2_char = SCHARS (str2);
if (! NILP (end2) && end2_char > XINT (end2))
end2_char = XINT (end2);
+ if (end2_char < XINT (start2))
+ args_out_of_range (str2, start2);
+
+ i1 = XINT (start1);
+ i2 = XINT (start2);
+
+ i1_byte = string_char_to_byte (str1, i1);
+ i2_byte = string_char_to_byte (str2, i2);
while (i1 < end1_char && i2 < end2_char)
{
Symbols are also allowed; their print names are used instead. */)
(register Lisp_Object s1, Lisp_Object s2)
{
- register EMACS_INT end;
- register EMACS_INT i1, i1_byte, i2, i2_byte;
+ register ptrdiff_t end;
+ register ptrdiff_t i1, i1_byte, i2, i2_byte;
if (SYMBOLP (s1))
s1 = SYMBOL_NAME (s1);
}
\f
static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
- enum Lisp_Type target_type, int last_special);
+ enum Lisp_Type target_type, bool last_special);
/* ARGSUSED */
Lisp_Object
struct textprop_rec
{
ptrdiff_t argnum; /* refer to ARGS (arguments of `concat') */
- EMACS_INT from; /* refer to ARGS[argnum] (argument string) */
- EMACS_INT to; /* refer to VAL (the target string) */
+ ptrdiff_t from; /* refer to ARGS[argnum] (argument string) */
+ ptrdiff_t to; /* refer to VAL (the target string) */
};
static Lisp_Object
concat (ptrdiff_t nargs, Lisp_Object *args,
- enum Lisp_Type target_type, int last_special)
+ enum Lisp_Type target_type, bool last_special)
{
Lisp_Object val;
- register Lisp_Object tail;
- register Lisp_Object this;
- EMACS_INT toindex;
- EMACS_INT toindex_byte = 0;
- register EMACS_INT result_len;
- register EMACS_INT result_len_byte;
+ Lisp_Object tail;
+ Lisp_Object this;
+ ptrdiff_t toindex;
+ ptrdiff_t toindex_byte = 0;
+ EMACS_INT result_len;
+ EMACS_INT result_len_byte;
ptrdiff_t argnum;
Lisp_Object last_tail;
Lisp_Object prev;
- int some_multibyte;
+ bool some_multibyte;
/* When we make a multibyte string, we can't copy text properties
while concatenating each string because the length of resulting
string can't be decided until we finish the whole concatenation.
{
/* We must count the number of bytes needed in the string
as well as the number of characters. */
- EMACS_INT i;
+ ptrdiff_t i;
Lisp_Object ch;
int c;
- EMACS_INT this_len_byte;
+ ptrdiff_t this_len_byte;
if (VECTORP (this) || COMPILEDP (this))
for (i = 0; i < len; i++)
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
this_len_byte = CHAR_BYTES (c);
+ if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
+ string_overflow ();
result_len_byte += this_len_byte;
if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
some_multibyte = 1;
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
this_len_byte = CHAR_BYTES (c);
+ if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
+ string_overflow ();
result_len_byte += this_len_byte;
if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
some_multibyte = 1;
if (STRING_MULTIBYTE (this))
{
some_multibyte = 1;
- result_len_byte += SBYTES (this);
+ this_len_byte = SBYTES (this);
}
else
- result_len_byte += count_size_as_multibyte (SDATA (this),
- SCHARS (this));
+ this_len_byte = count_size_as_multibyte (SDATA (this),
+ SCHARS (this));
+ if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
+ string_overflow ();
+ result_len_byte += this_len_byte;
}
}
result_len += len;
- if (STRING_BYTES_BOUND < result_len)
- string_overflow ();
+ if (MOST_POSITIVE_FIXNUM < result_len)
+ memory_full (SIZE_MAX);
}
if (! some_multibyte)
for (argnum = 0; argnum < nargs; argnum++)
{
Lisp_Object thislen;
- EMACS_INT thisleni = 0;
- register EMACS_INT thisindex = 0;
- register EMACS_INT thisindex_byte = 0;
+ ptrdiff_t thisleni = 0;
+ register ptrdiff_t thisindex = 0;
+ register ptrdiff_t thisindex_byte = 0;
this = args[argnum];
if (!CONSP (this))
if (STRINGP (this) && STRINGP (val)
&& STRING_MULTIBYTE (this) == some_multibyte)
{
- EMACS_INT thislen_byte = SBYTES (this);
+ ptrdiff_t thislen_byte = SBYTES (this);
memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this));
- if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
+ if (string_intervals (this))
{
textprops[num_textprops].argnum = argnum;
textprops[num_textprops].from = 0;
/* Copy a single-byte string to a multibyte string. */
else if (STRINGP (this) && STRINGP (val))
{
- if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
+ if (string_intervals (this))
{
textprops[num_textprops].argnum = argnum;
textprops[num_textprops].from = 0;
if (num_textprops > 0)
{
Lisp_Object props;
- EMACS_INT last_to_end = -1;
+ ptrdiff_t last_to_end = -1;
for (argnum = 0; argnum < num_textprops; argnum++)
{
}
\f
static Lisp_Object string_char_byte_cache_string;
-static EMACS_INT string_char_byte_cache_charpos;
-static EMACS_INT string_char_byte_cache_bytepos;
+static ptrdiff_t string_char_byte_cache_charpos;
+static ptrdiff_t string_char_byte_cache_bytepos;
void
clear_string_char_byte_cache (void)
/* Return the byte index corresponding to CHAR_INDEX in STRING. */
-EMACS_INT
-string_char_to_byte (Lisp_Object string, EMACS_INT char_index)
+ptrdiff_t
+string_char_to_byte (Lisp_Object string, ptrdiff_t char_index)
{
- EMACS_INT i_byte;
- EMACS_INT best_below, best_below_byte;
- EMACS_INT best_above, best_above_byte;
+ ptrdiff_t i_byte;
+ ptrdiff_t best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
best_below = best_below_byte = 0;
best_above = SCHARS (string);
\f
/* Return the character index corresponding to BYTE_INDEX in STRING. */
-EMACS_INT
-string_byte_to_char (Lisp_Object string, EMACS_INT byte_index)
+ptrdiff_t
+string_byte_to_char (Lisp_Object string, ptrdiff_t byte_index)
{
- EMACS_INT i, i_byte;
- EMACS_INT best_below, best_below_byte;
- EMACS_INT best_above, best_above_byte;
+ ptrdiff_t i, i_byte;
+ ptrdiff_t best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
best_below = best_below_byte = 0;
best_above = SCHARS (string);
string_make_multibyte (Lisp_Object string)
{
unsigned char *buf;
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
Lisp_Object ret;
USE_SAFE_ALLOCA;
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);
string_to_multibyte (Lisp_Object string)
{
unsigned char *buf;
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
Lisp_Object ret;
USE_SAFE_ALLOCA;
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));
Lisp_Object
string_make_unibyte (Lisp_Object string)
{
- EMACS_INT nchars;
+ ptrdiff_t nchars;
unsigned char *buf;
Lisp_Object ret;
USE_SAFE_ALLOCA;
nchars = SCHARS (string);
- SAFE_ALLOCA (buf, unsigned char *, nchars);
+ buf = SAFE_ALLOCA (nchars);
copy_text (SDATA (string), buf, SBYTES (string),
1, 0);
if (STRING_MULTIBYTE (string))
{
- EMACS_INT bytes = SBYTES (string);
- unsigned char *str = (unsigned char *) xmalloc (bytes);
+ ptrdiff_t bytes = SBYTES (string);
+ unsigned char *str = xmalloc (bytes);
memcpy (str, SDATA (string), bytes);
bytes = str_as_unibyte (str, bytes);
if (! STRING_MULTIBYTE (string))
{
Lisp_Object new_string;
- EMACS_INT nchars, nbytes;
+ ptrdiff_t nchars, nbytes;
parse_str_as_multibyte (SDATA (string),
SBYTES (string),
str_as_multibyte (SDATA (new_string), nbytes,
SBYTES (string), NULL);
string = new_string;
- STRING_SET_INTERVALS (string, NULL_INTERVAL);
+ set_string_intervals (string, NULL);
}
return string;
}
if (STRING_MULTIBYTE (string))
{
- EMACS_INT chars = SCHARS (string);
- unsigned char *str = (unsigned char *) xmalloc (chars);
- EMACS_INT converted = str_to_unibyte (SDATA (string), str, chars, 0);
+ ptrdiff_t chars = SCHARS (string);
+ unsigned char *str = xmalloc (chars);
+ ptrdiff_t converted = str_to_unibyte (SDATA (string), str, chars);
if (converted < chars)
- error ("Can't convert the %"pI"dth character to unibyte", converted);
+ error ("Can't convert the %"pD"dth character to unibyte", converted);
string = make_unibyte_string ((char *) str, chars);
xfree (str);
}
(Lisp_Object string, register Lisp_Object from, Lisp_Object to)
{
Lisp_Object res;
- EMACS_INT size;
- EMACS_INT size_byte = 0;
+ ptrdiff_t size;
EMACS_INT from_char, to_char;
- EMACS_INT from_byte = 0, to_byte = 0;
CHECK_VECTOR_OR_STRING (string);
CHECK_NUMBER (from);
if (STRINGP (string))
- {
- size = SCHARS (string);
- size_byte = SBYTES (string);
- }
+ size = SCHARS (string);
else
size = ASIZE (string);
if (NILP (to))
- {
- to_char = size;
- to_byte = size_byte;
- }
+ to_char = size;
else
{
CHECK_NUMBER (to);
to_char = XINT (to);
if (to_char < 0)
to_char += size;
-
- if (STRINGP (string))
- to_byte = string_char_to_byte (string, to_char);
}
from_char = XINT (from);
if (from_char < 0)
from_char += size;
- if (STRINGP (string))
- from_byte = string_char_to_byte (string, from_char);
-
if (!(0 <= from_char && from_char <= to_char && to_char <= size))
args_out_of_range_3 (string, make_number (from_char),
make_number (to_char));
if (STRINGP (string))
{
+ ptrdiff_t to_byte =
+ (NILP (to) ? SBYTES (string) : string_char_to_byte (string, to_char));
+ ptrdiff_t from_byte = string_char_to_byte (string, from_char);
res = make_specified_string (SSDATA (string) + from_byte,
to_char - from_char, to_byte - from_byte,
STRING_MULTIBYTE (string));
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;
}
With one argument, just copy STRING without its properties. */)
(Lisp_Object string, register Lisp_Object from, Lisp_Object to)
{
- EMACS_INT size, size_byte;
+ ptrdiff_t size;
EMACS_INT from_char, to_char;
- EMACS_INT from_byte, to_byte;
+ ptrdiff_t from_byte, to_byte;
CHECK_STRING (string);
size = SCHARS (string);
- size_byte = SBYTES (string);
if (NILP (from))
- from_char = from_byte = 0;
+ from_char = 0;
else
{
CHECK_NUMBER (from);
from_char = XINT (from);
if (from_char < 0)
from_char += size;
-
- from_byte = string_char_to_byte (string, from_char);
}
if (NILP (to))
- {
- to_char = size;
- to_byte = size_byte;
- }
+ to_char = size;
else
{
CHECK_NUMBER (to);
-
to_char = XINT (to);
if (to_char < 0)
to_char += size;
-
- to_byte = string_char_to_byte (string, to_char);
}
if (!(0 <= from_char && from_char <= to_char && to_char <= size))
args_out_of_range_3 (string, make_number (from_char),
make_number (to_char));
+ from_byte = NILP (from) ? 0 : string_char_to_byte (string, from_char);
+ to_byte =
+ NILP (to) ? SBYTES (string) : string_char_to_byte (string, to_char);
return make_specified_string (SSDATA (string) + from_byte,
to_char - from_char, to_byte - from_byte,
STRING_MULTIBYTE (string));
both in characters and in bytes. */
Lisp_Object
-substring_both (Lisp_Object string, EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte)
+substring_both (Lisp_Object string, ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte)
{
Lisp_Object res;
- EMACS_INT size;
+ ptrdiff_t size;
CHECK_VECTOR_OR_STRING (string);
string, make_number (0), res, Qnil);
}
else
- res = Fvector (to - from, &AREF (string, from));
+ res = Fvector (to - from, aref_addr (string, from));
return res;
}
}
\f
DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
- doc: /* Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `eq'.
-If the first member of LIST is ELT, there is no way to remove it by side effect;
-therefore, write `(setq foo (delq element foo))'
-to be sure of changing the value of `foo'. */)
+ doc: /* Delete members of LIST which are `eq' to ELT, and return the result.
+More precisely, this function skips any members `eq' to ELT at the
+front of LIST, then removes members `eq' to ELT from the remaining
+sublist by modifying its list structure, then returns the resulting
+list.
+
+Write `(setq foo (delq element foo))' to be sure of correctly changing
+the value of a list `foo'. */)
(register Lisp_Object elt, Lisp_Object list)
{
register Lisp_Object tail, prev;
}
DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
- doc: /* Delete by side effect any occurrences of ELT as a member of SEQ.
-SEQ must be a list, a vector, or a string.
-The modified SEQ is returned. Comparison is done with `equal'.
-If SEQ is not a list, or the first member of SEQ is ELT, deleting it
-is not a side effect; it is simply using a different sequence.
-Therefore, write `(setq foo (delete element foo))'
-to be sure of changing the value of `foo'. */)
+ doc: /* Delete members of SEQ which are `equal' to ELT, and return the result.
+SEQ must be a sequence (i.e. a list, a vector, or a string).
+The return value is a sequence of the same type.
+
+If SEQ is a list, this behaves like `delq', except that it compares
+with `equal' instead of `eq'. In particular, it may remove elements
+by altering the list structure.
+
+If SEQ is not a list, deletion is never performed destructively;
+instead this function creates and returns a new vector or string.
+
+Write `(setq foo (delete element foo))' to be sure of correctly
+changing the value of a sequence `foo'. */)
(Lisp_Object elt, Lisp_Object seq)
{
if (VECTORP (seq))
{
- EMACS_INT i, n;
+ ptrdiff_t i, n;
for (i = n = 0; i < ASIZE (seq); ++i)
if (NILP (Fequal (AREF (seq, i), elt)))
}
else if (STRINGP (seq))
{
- EMACS_INT i, ibyte, nchars, nbytes, cbytes;
+ ptrdiff_t i, ibyte, nchars, nbytes, cbytes;
int c;
for (i = nchars = nbytes = ibyte = 0;
{
unsigned char *from = SDATA (seq) + ibyte;
unsigned char *to = SDATA (tem) + nbytes;
- EMACS_INT n;
+ ptrdiff_t n;
++nchars;
nbytes += cbytes;
halftail = XCDR (halftail);
if (EQ (tail, halftail))
break;
-
-#if 0 /* Unsafe version. */
- /* This function can be called asynchronously
- (setup_coding_system). Don't QUIT in that case. */
- if (!interrupt_input_blocked)
- QUIT;
-#endif
}
return Qnil;
(Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
{
CHECK_SYMBOL (symbol);
- XSYMBOL (symbol)->plist
- = Fplist_put (XSYMBOL (symbol)->plist, propname, value);
+ set_symbol_plist
+ (symbol, Fplist_put (XSYMBOL (symbol)->plist, propname, value));
return value;
}
\f
/* DEPTH is current depth of recursion. Signal an error if it
gets too deep.
- PROPS, if non-nil, means compare string text properties too. */
+ PROPS means compare string text properties too. */
-static int
-internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int props)
+static bool
+internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props)
{
if (depth > 200)
error ("Stack overflow in equal");
case Lisp_Vectorlike:
{
register int i;
- EMACS_INT size = ASIZE (o1);
+ ptrdiff_t size = ASIZE (o1);
/* Pseudovectors have the type encoded in the size field, so this test
actually checks that the objects have the same type as well as the
same size. */
are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
- if (!(size & (PVEC_COMPILED
- | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT)))
+ if (!(size & ((PVEC_COMPILED | PVEC_CHAR_TABLE
+ | PVEC_SUB_CHAR_TABLE | PVEC_FONT)
+ << PSEUDOVECTOR_SIZE_BITS)))
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
ARRAY is a vector, string, char-table, or bool-vector. */)
(Lisp_Object array, Lisp_Object item)
{
- register EMACS_INT size, idx;
+ register ptrdiff_t size, idx;
if (VECTORP (array))
- {
- register Lisp_Object *p = XVECTOR (array)->contents;
- size = ASIZE (array);
- for (idx = 0; idx < size; idx++)
- p[idx] = item;
- }
+ for (idx = 0, size = ASIZE (array); idx < size; idx++)
+ ASET (array, idx, item);
else if (CHAR_TABLE_P (array))
{
int i;
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
- XCHAR_TABLE (array)->contents[i] = item;
- XCHAR_TABLE (array)->defalt = item;
+ set_char_table_contents (array, i, item);
+ set_char_table_defalt (array, item);
}
else if (STRINGP (array))
{
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (charval, str);
- EMACS_INT size_byte = SBYTES (array);
+ ptrdiff_t size_byte = SBYTES (array);
if (INT_MULTIPLY_OVERFLOW (SCHARS (array), len)
|| SCHARS (array) * len != size_byte)
else if (BOOL_VECTOR_P (array))
{
register unsigned char *p = XBOOL_VECTOR (array)->data;
- EMACS_INT size_in_chars;
- size = XBOOL_VECTOR (array)->size;
- size_in_chars
- = ((size + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
+ size =
+ ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
- if (size_in_chars)
+ if (size)
{
- memset (p, ! NILP (item) ? -1 : 0, size_in_chars);
+ memset (p, ! NILP (item) ? -1 : 0, size);
/* Clear any extraneous bits in the last byte. */
- p[size_in_chars - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ p[size - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
}
}
else
This makes STRING unibyte and may change its length. */)
(Lisp_Object string)
{
- EMACS_INT len;
+ ptrdiff_t len;
CHECK_STRING (string);
len = SBYTES (string);
memset (SDATA (string), 0, len);
}
else if (STRINGP (seq))
{
- EMACS_INT i_byte;
+ ptrdiff_t i_byte;
for (i = 0, i_byte = 0; i < leni;)
{
int c;
- EMACS_INT i_before = i;
+ ptrdiff_t i_before = i;
FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
XSETFASTINT (dummy, c);
{
Lisp_Object len;
register EMACS_INT leni;
- ptrdiff_t i, nargs;
+ EMACS_INT nargs;
+ ptrdiff_t i;
register Lisp_Object *args;
struct gcpro gcpro1;
Lisp_Object ret;
The normal messages at start and end of loading FILENAME are suppressed. */)
(Lisp_Object feature, Lisp_Object filename, Lisp_Object noerror)
{
- register Lisp_Object tem;
+ Lisp_Object tem;
struct gcpro gcpro1, gcpro2;
- int from_file = load_in_progress;
+ bool from_file = load_in_progress;
CHECK_SYMBOL (feature);
if (NILP (tem))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int nesting = 0;
/* This is to make sure that loadup.el gives a clear picture
for (i = 0; i < 7; i++)
{
str = nl_langinfo (days[i]);
- val = make_unibyte_string (str, strlen (str));
+ val = build_unibyte_string (str);
/* Fixme: Is this coding system necessarily right, even if
it is consistent with CODESET? If not, what to do? */
Faset (v, make_number (i),
for (i = 0; i < 12; i++)
{
str = nl_langinfo (months[i]);
- val = make_unibyte_string (str, strlen (str));
+ val = build_unibyte_string (str);
Faset (v, make_number (i),
code_convert_string_norecord (val, Vlocale_coding_system, 0));
}
base64 characters. */
-static EMACS_INT base64_encode_1 (const char *, char *, EMACS_INT, int, int);
-static EMACS_INT base64_decode_1 (const char *, char *, EMACS_INT, int,
- EMACS_INT *);
+static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool);
+static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
+ ptrdiff_t *);
DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
2, 3, "r",
(Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break)
{
char *encoded;
- EMACS_INT allength, length;
- EMACS_INT ibeg, iend, encoded_length;
- EMACS_INT old_pos = PT;
+ ptrdiff_t allength, length;
+ ptrdiff_t ibeg, iend, encoded_length;
+ ptrdiff_t old_pos = PT;
USE_SAFE_ALLOCA;
validate_region (&beg, &end);
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)));
if (encoded_length > allength)
- abort ();
+ emacs_abort ();
if (encoded_length < 0)
{
into shorter lines. */)
(Lisp_Object string, Lisp_Object no_line_break)
{
- EMACS_INT allength, length, encoded_length;
+ ptrdiff_t allength, length, encoded_length;
char *encoded;
Lisp_Object encoded_string;
USE_SAFE_ALLOCA;
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),
STRING_MULTIBYTE (string));
if (encoded_length > allength)
- abort ();
+ emacs_abort ();
if (encoded_length < 0)
{
return encoded_string;
}
-static EMACS_INT
-base64_encode_1 (const char *from, char *to, EMACS_INT length,
- int line_break, int multibyte)
+static ptrdiff_t
+base64_encode_1 (const char *from, char *to, ptrdiff_t length,
+ bool line_break, bool multibyte)
{
int counter = 0;
- EMACS_INT i = 0;
+ ptrdiff_t i = 0;
char *e = to;
int c;
unsigned int value;
If the region can't be decoded, signal an error and don't modify the buffer. */)
(Lisp_Object beg, Lisp_Object end)
{
- EMACS_INT ibeg, iend, length, allength;
+ ptrdiff_t ibeg, iend, length, allength;
char *decoded;
- EMACS_INT old_pos = PT;
- EMACS_INT decoded_length;
- EMACS_INT inserted_chars;
- int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ ptrdiff_t old_pos = PT;
+ ptrdiff_t decoded_length;
+ ptrdiff_t inserted_chars;
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
USE_SAFE_ALLOCA;
validate_region (&beg, &end);
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),
decoded, length,
multibyte, &inserted_chars);
if (decoded_length > allength)
- abort ();
+ emacs_abort ();
if (decoded_length < 0)
{
(Lisp_Object string)
{
char *decoded;
- EMACS_INT length, decoded_length;
+ ptrdiff_t length, decoded_length;
Lisp_Object decoded_string;
USE_SAFE_ALLOCA;
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,
0, NULL);
if (decoded_length > length)
- abort ();
+ emacs_abort ();
else if (decoded_length >= 0)
decoded_string = make_unibyte_string (decoded, decoded_length);
else
}
/* Base64-decode the data at FROM of LENGTH bytes into TO. If
- MULTIBYTE is nonzero, the decoded result should be in multibyte
+ MULTIBYTE, the decoded result should be in multibyte
form. If NCHARS_RETURN is not NULL, store the number of produced
characters in *NCHARS_RETURN. */
-static EMACS_INT
-base64_decode_1 (const char *from, char *to, EMACS_INT length,
- int multibyte, EMACS_INT *nchars_return)
+static ptrdiff_t
+base64_decode_1 (const char *from, char *to, ptrdiff_t length,
+ bool multibyte, ptrdiff_t *nchars_return)
{
- EMACS_INT i = 0; /* Used inside READ_QUADRUPLET_BYTE */
+ ptrdiff_t i = 0; /* Used inside READ_QUADRUPLET_BYTE */
char *e = to;
unsigned char c;
unsigned long value;
- EMACS_INT nchars = 0;
+ ptrdiff_t nchars = 0;
while (1)
{
static struct Lisp_Hash_Table *check_hash_table (Lisp_Object);
static ptrdiff_t get_key_arg (Lisp_Object, ptrdiff_t, Lisp_Object *, char *);
static void maybe_resize_hash_table (struct Lisp_Hash_Table *);
-static int sweep_weak_table (struct Lisp_Hash_Table *, int);
+static bool sweep_weak_table (struct Lisp_Hash_Table *, bool);
\f
/* Return a Lisp vector which has the same contents as VEC but has
- size NEW_SIZE, NEW_SIZE >= VEC->size. Entries in the resulting
- vector that are not copied from VEC are set to INIT. */
+ at least INCR_MIN more entries, where INCR_MIN is positive.
+ If NITEMS_MAX is not -1, do not grow the vector to be any larger
+ than NITEMS_MAX. Entries in the resulting
+ vector that are not copied from VEC are set to nil. */
Lisp_Object
-larger_vector (Lisp_Object vec, EMACS_INT new_size, Lisp_Object init)
+larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
{
struct Lisp_Vector *v;
- EMACS_INT i, old_size;
-
- xassert (VECTORP (vec));
+ ptrdiff_t i, incr, incr_max, old_size, new_size;
+ ptrdiff_t C_language_max = min (PTRDIFF_MAX, SIZE_MAX) / sizeof *v->contents;
+ ptrdiff_t n_max = (0 <= nitems_max && nitems_max < C_language_max
+ ? nitems_max : C_language_max);
+ eassert (VECTORP (vec));
+ eassert (0 < incr_min && -1 <= nitems_max);
old_size = ASIZE (vec);
- xassert (new_size >= old_size);
-
+ incr_max = n_max - old_size;
+ incr = max (incr_min, min (old_size >> 1, incr_max));
+ if (incr_max < incr)
+ memory_full (SIZE_MAX);
+ new_size = old_size + incr;
v = allocate_vector (new_size);
memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof *v->contents);
for (i = old_size; i < new_size; ++i)
- v->contents[i] = init;
+ v->contents[i] = Qnil;
XSETVECTOR (vec, v);
return vec;
}
***********************************************************************/
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
- HASH2 in hash table H using `eql'. Value is non-zero if KEY1 and
+ HASH2 in hash table H using `eql'. Value is true if KEY1 and
KEY2 are the same. */
-static int
+static bool
cmpfn_eql (struct Lisp_Hash_Table *h,
Lisp_Object key1, EMACS_UINT hash1,
Lisp_Object key2, EMACS_UINT hash2)
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
- HASH2 in hash table H using `equal'. Value is non-zero if KEY1 and
+ HASH2 in hash table H using `equal'. Value is true if KEY1 and
KEY2 are the same. */
-static int
+static bool
cmpfn_equal (struct Lisp_Hash_Table *h,
Lisp_Object key1, EMACS_UINT hash1,
Lisp_Object key2, EMACS_UINT hash2)
/* Compare KEY1 which has hash code HASH1, and KEY2 with hash code
- HASH2 in hash table H using H->user_cmp_function. Value is non-zero
+ HASH2 in hash table H using H->user_cmp_function. Value is true
if KEY1 and KEY2 are the same. */
-static int
+static bool
cmpfn_user_defined (struct Lisp_Hash_Table *h,
Lisp_Object key1, EMACS_UINT hash1,
Lisp_Object key2, EMACS_UINT hash2)
hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash = XUINT (key) ^ XTYPE (key);
- xassert ((hash & ~INTMASK) == 0);
+ eassert ((hash & ~INTMASK) == 0);
return hash;
}
hash = sxhash (key, 0);
else
hash = XUINT (key) ^ XTYPE (key);
- xassert ((hash & ~INTMASK) == 0);
+ eassert ((hash & ~INTMASK) == 0);
return hash;
}
hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash = sxhash (key, 0);
- xassert ((hash & ~INTMASK) == 0);
+ eassert ((hash & ~INTMASK) == 0);
return hash;
}
return XUINT (hash);
}
+/* 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 / word_size))
/* Create and initialize a new hash table.
{
struct Lisp_Hash_Table *h;
Lisp_Object table;
- EMACS_INT index_size, i, sz;
+ EMACS_INT index_size, sz;
+ ptrdiff_t i;
double index_float;
/* Preconditions. */
- xassert (SYMBOLP (test));
- xassert (INTEGERP (size) && XINT (size) >= 0);
- xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
+ eassert (SYMBOLP (test));
+ eassert (INTEGERP (size) && XINT (size) >= 0);
+ eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
|| (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size)));
- xassert (FLOATP (rehash_threshold)
+ eassert (FLOATP (rehash_threshold)
&& 0 < XFLOAT_DATA (rehash_threshold)
&& XFLOAT_DATA (rehash_threshold) <= 1.0);
sz = XFASTINT (size);
index_float = sz / XFLOAT_DATA (rehash_threshold);
- index_size = (index_float < MOST_POSITIVE_FIXNUM + 1
+ index_size = (index_float < INDEX_SIZE_BOUND + 1
? next_almost_prime (index_float)
- : MOST_POSITIVE_FIXNUM + 1);
- if (MOST_POSITIVE_FIXNUM < max (index_size, 2 * sz))
+ : INDEX_SIZE_BOUND + 1);
+ if (INDEX_SIZE_BOUND < max (index_size, 2 * sz))
error ("Hash table too large");
/* Allocate a table and initialize it. */
/* Set up the free list. */
for (i = 0; i < sz - 1; ++i)
- HASH_NEXT (h, i) = make_number (i + 1);
+ set_hash_next_slot (h, i, make_number (i + 1));
h->next_free = make_number (0);
XSET_HASH_TABLE (table, h);
- xassert (HASH_TABLE_P (table));
- xassert (XHASH_TABLE (table) == h);
+ eassert (HASH_TABLE_P (table));
+ eassert (XHASH_TABLE (table) == h);
/* Maybe add this hash table to the list of all weak hash tables. */
if (NILP (h->weak))
h2 = allocate_hash_table ();
next = h2->header.next.vector;
- memcpy (h2, h1, sizeof *h2);
+ *h2 = *h1;
h2->header.next.vector = next;
h2->key_and_value = Fcopy_sequence (h1->key_and_value);
h2->hash = Fcopy_sequence (h1->hash);
{
if (NILP (h->next_free))
{
- EMACS_INT old_size = HASH_TABLE_SIZE (h);
- EMACS_INT i, new_size, index_size;
- EMACS_INT nsize;
+ ptrdiff_t old_size = HASH_TABLE_SIZE (h);
+ EMACS_INT new_size, index_size, nsize;
+ ptrdiff_t i;
double index_float;
if (INTEGERP (h->rehash_size))
else
{
double float_new_size = old_size * XFLOAT_DATA (h->rehash_size);
- if (float_new_size < MOST_POSITIVE_FIXNUM + 1)
+ if (float_new_size < INDEX_SIZE_BOUND + 1)
{
new_size = float_new_size;
if (new_size <= old_size)
new_size = old_size + 1;
}
else
- new_size = MOST_POSITIVE_FIXNUM + 1;
+ new_size = INDEX_SIZE_BOUND + 1;
}
index_float = new_size / XFLOAT_DATA (h->rehash_threshold);
- index_size = (index_float < MOST_POSITIVE_FIXNUM + 1
+ index_size = (index_float < INDEX_SIZE_BOUND + 1
? next_almost_prime (index_float)
- : MOST_POSITIVE_FIXNUM + 1);
+ : INDEX_SIZE_BOUND + 1);
nsize = max (index_size, 2 * new_size);
- if (nsize > MOST_POSITIVE_FIXNUM)
+ if (INDEX_SIZE_BOUND < nsize)
error ("Hash table too large to resize");
- h->key_and_value = larger_vector (h->key_and_value, 2 * new_size, Qnil);
- h->next = larger_vector (h->next, new_size, Qnil);
- h->hash = larger_vector (h->hash, new_size, Qnil);
- h->index = Fmake_vector (make_number (index_size), Qnil);
+#ifdef ENABLE_CHECKING
+ if (HASH_TABLE_P (Vpurify_flag)
+ && XHASH_TABLE (Vpurify_flag) == h)
+ {
+ Lisp_Object args[2];
+ args[0] = build_string ("Growing hash table to: %d");
+ args[1] = make_number (new_size);
+ Fmessage (2, args);
+ }
+#endif
+
+ set_hash_key_and_value (h, larger_vector (h->key_and_value,
+ 2 * (new_size - old_size), -1));
+ set_hash_next (h, larger_vector (h->next, new_size - old_size, -1));
+ set_hash_hash (h, larger_vector (h->hash, new_size - old_size, -1));
+ set_hash_index (h, Fmake_vector (make_number (index_size), Qnil));
/* Update the free list. Do it so that new entries are added at
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_slot (h, i, make_number (i + 1));
if (!NILP (h->next_free))
{
!NILP (next))
last = next;
- HASH_NEXT (h, XFASTINT (last)) = make_number (old_size);
+ set_hash_next_slot (h, XFASTINT (last), make_number (old_size));
}
else
XSETFASTINT (h->next_free, old_size);
if (!NILP (HASH_HASH (h, i)))
{
EMACS_UINT hash_code = XUINT (HASH_HASH (h, i));
- EMACS_INT 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);
+ ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
+ set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, make_number (i));
}
}
}
/* We need not gcpro idx since it's either an integer or nil. */
while (!NILP (idx))
{
- EMACS_INT i = XFASTINT (idx);
+ ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
|| (h->cmpfn
&& h->cmpfn (h, key, hash_code,
{
ptrdiff_t start_of_bucket, i;
- xassert ((hash & ~INTMASK) == 0);
+ eassert ((hash & ~INTMASK) == 0);
/* Increment count after resizing because resizing may fail. */
maybe_resize_hash_table (h);
/* 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_slot (h, i, key);
+ set_hash_value_slot (h, i, value);
/* Remember its hash code. */
- HASH_HASH (h, i) = make_number (hash);
+ set_hash_hash_slot (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_slot (h, i, HASH_INDEX (h, start_of_bucket));
+ set_hash_index_slot (h, start_of_bucket, make_number (i));
return i;
}
hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
EMACS_UINT hash_code;
- EMACS_INT start_of_bucket;
+ ptrdiff_t start_of_bucket;
Lisp_Object idx, prev;
hash_code = h->hashfn (h, key);
/* We need not gcpro idx, prev since they're either integers or nil. */
while (!NILP (idx))
{
- EMACS_INT i = XFASTINT (idx);
+ ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i))
|| (h->cmpfn
{
/* Take entry out of collision chain. */
if (NILP (prev))
- HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i);
+ set_hash_index_slot (h, start_of_bucket, HASH_NEXT (h, i));
else
- HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i);
+ set_hash_next_slot (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_slot (h, i, Qnil);
+ set_hash_value_slot (h, i, Qnil);
+ set_hash_hash_slot (h, i, Qnil);
+ set_hash_next_slot (h, i, h->next_free);
h->next_free = make_number (i);
h->count--;
- xassert (h->count >= 0);
+ eassert (h->count >= 0);
break;
}
else
{
if (h->count > 0)
{
- EMACS_INT i, size = HASH_TABLE_SIZE (h);
+ ptrdiff_t i, size = HASH_TABLE_SIZE (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_slot (h, i, i < size - 1 ? make_number (i + 1) : Qnil);
+ set_hash_key_slot (h, i, Qnil);
+ set_hash_value_slot (h, i, Qnil);
+ set_hash_hash_slot (h, i, Qnil);
}
for (i = 0; i < ASIZE (h->index); ++i)
Weak Hash Tables
************************************************************************/
-void
-init_weak_hash_tables (void)
-{
- weak_hash_tables = NULL;
-}
-
-/* Sweep weak hash table H. REMOVE_ENTRIES_P non-zero means remove
+/* Sweep weak hash table H. REMOVE_ENTRIES_P means remove
entries from the table that don't survive the current GC.
- REMOVE_ENTRIES_P zero means mark entries that are in use. Value is
- non-zero if anything was marked. */
+ !REMOVE_ENTRIES_P means mark entries that are in use. Value is
+ true if anything was marked. */
-static int
-sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p)
+static bool
+sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
{
- EMACS_INT bucket, n;
- int marked;
+ ptrdiff_t bucket, n;
+ bool marked;
n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
marked = 0;
prev = Qnil;
for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
{
- EMACS_INT i = XFASTINT (idx);
- int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
- int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
- int remove_p;
+ ptrdiff_t i = XFASTINT (idx);
+ bool key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
+ bool value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
+ bool remove_p;
if (EQ (h->weak, Qkey))
remove_p = !key_known_to_survive_p;
else if (EQ (h->weak, Qkey_and_value))
remove_p = !(key_known_to_survive_p && value_known_to_survive_p);
else
- abort ();
+ emacs_abort ();
next = HASH_NEXT (h, i);
{
/* Take out of collision chain. */
if (NILP (prev))
- HASH_INDEX (h, bucket) = next;
+ set_hash_index_slot (h, bucket, next);
else
- HASH_NEXT (h, XFASTINT (prev)) = next;
+ set_hash_next_slot (h, XFASTINT (prev), next);
/* Add to free list. */
- HASH_NEXT (h, i) = h->next_free;
+ set_hash_next_slot (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_slot (h, i, Qnil);
+ set_hash_value_slot (h, i, Qnil);
+ set_hash_hash_slot (h, i, Qnil);
h->count--;
}
sweep_weak_hash_tables (void)
{
struct Lisp_Hash_Table *h, *used, *next;
- int marked;
+ bool marked;
/* Mark all keys and values that are in use. Keep on marking until
there is no more change. This is necessary for cases like
break;
default:
- abort ();
+ emacs_abort ();
}
return hash;
/* The vector `used' is used to keep track of arguments that
have been consumed. */
- used = (char *) alloca (nargs * sizeof *used);
+ used = alloca (nargs * sizeof *used);
memset (used, 0, nargs * sizeof *used);
/* See if there's a `:test TEST' among the arguments. */
i = hash_lookup (h, key, &hash);
if (i >= 0)
- HASH_VALUE (h, i) = value;
+ set_hash_value_slot (h, i, value);
else
hash_put (h, key, value, hash);
{
struct Lisp_Hash_Table *h = check_hash_table (table);
Lisp_Object args[3];
- EMACS_INT i;
+ ptrdiff_t i;
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i)))
secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary)
{
int i;
- EMACS_INT size;
- EMACS_INT size_byte = 0;
+ ptrdiff_t size;
EMACS_INT start_char = 0, end_char = 0;
- EMACS_INT start_byte = 0, end_byte = 0;
+ ptrdiff_t start_byte, end_byte;
register EMACS_INT b, e;
register struct buffer *bp;
EMACS_INT temp;
object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
size = SCHARS (object);
- size_byte = SBYTES (object);
if (!NILP (start))
{
if (start_char < 0)
start_char += size;
-
- start_byte = string_char_to_byte (object, start_char);
}
if (NILP (end))
- {
- end_char = size;
- end_byte = size_byte;
- }
+ end_char = size;
else
{
CHECK_NUMBER (end);
if (end_char < 0)
end_char += size;
-
- end_byte = string_char_to_byte (object, end_char);
}
if (!(0 <= start_char && start_char <= end_char && end_char <= size))
args_out_of_range_3 (object, make_number (start_char),
make_number (end_char));
+
+ start_byte = NILP (start) ? 0 : string_char_to_byte (object, start_char);
+ end_byte =
+ NILP (end) ? SBYTES (object) : string_char_to_byte (object, end_char);
}
else
{
struct buffer *prev = current_buffer;
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
CHECK_BUFFER (object);
bp = XBUFFER (object);
- if (bp != current_buffer)
- set_buffer_internal (bp);
+ set_buffer_internal (bp);
if (NILP (start))
b = BEGV;
coding_system = Vcoding_system_for_write;
else
{
- int force_raw_text = 0;
+ bool force_raw_text = 0;
coding_system = BVAR (XBUFFER (object), buffer_file_coding_system);
if (NILP (coding_system)
}
object = make_buffer_string (b, e, 0);
- if (prev != current_buffer)
- set_buffer_internal (prev);
+ set_buffer_internal (prev);
/* Discard the unwind protect for recovering the current
buffer. */
specpdl_ptr--;
if (STRING_MULTIBYTE (object))
object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
+ start_byte = 0;
+ end_byte = SBYTES (object);
}
if (EQ (algorithm, Qmd5))
digest = make_uninit_string (digest_size * 2);
hash_func (SSDATA (object) + start_byte,
- SBYTES (object) - (size_byte - end_byte),
+ end_byte - start_byte,
SSDATA (digest));
if (NILP (binary))
#endif /* HAVE_LANGINFO_CODESET */
DEFVAR_BOOL ("use-dialog-box", use_dialog_box,
- doc: /* *Non-nil means mouse commands use dialog boxes to ask questions.
+ doc: /* Non-nil means mouse commands use dialog boxes to ask questions.
This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands
invoked by mouse clicks and mouse menu items.
use_dialog_box = 1;
DEFVAR_BOOL ("use-file-dialog", use_file_dialog,
- doc: /* *Non-nil means mouse commands use a file dialog to ask for files.
+ doc: /* Non-nil means mouse commands use a file dialog to ask for files.
This applies to commands from menus and tool bar buttons even when
they are initiated from the keyboard. If `use-dialog-box' is nil,
that disables the use of a file dialog, regardless of the value of
defsubr (&Ssecure_hash);
defsubr (&Slocale_info);
}
-
-
-void
-init_fns (void)
-{
-}
#include <config.h>
#include <float.h>
#include <stdio.h>
-#include <ctype.h>
-#include <setjmp.h>
+
+#include <c-ctype.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "frame.h"
#include "window.h"
#include "dispextern.h"
#include "charset.h"
-#include "character.h"
#include "composite.h"
#include "fontset.h"
#include "font.h"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif /* HAVE_X_WINDOWS */
-
-#ifdef HAVE_NTGUI
-#include "w32term.h"
-#endif /* HAVE_NTGUI */
-
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif /* HAVE_NS */
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
Lisp_Object Qopentype;
/* Unicode category `Cf'. */
static Lisp_Object QCf;
-/* Special vector of zero length. This is repeatedly used by (struct
- font_driver *)->list when a specified font is not found. */
-static Lisp_Object null_vector;
-
/* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
static Lisp_Object font_style_table;
/* Return a Lispy value of a font property value at STR and LEN bytes.
- If STR is "*", return nil.
- If FORCE_SYMBOL is zero and all characters in STR are digits,
- return an integer. Otherwise, return a symbol interned from
- STR. */
+ If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
+ consist entirely of one or more digits, return a symbol interned
+ from STR. Otherwise, return an integer. */
Lisp_Object
-font_intern_prop (const char *str, ptrdiff_t len, int force_symbol)
+font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
{
ptrdiff_t i;
Lisp_Object tem;
Lisp_Object obarray;
- EMACS_INT nbytes, nchars;
+ ptrdiff_t nbytes, nchars;
if (len == 1 && *str == '*')
return Qnil;
}
}
- /* The following code is copied from the function intern (in
- lread.c), and modified to suit our purpose. */
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
+ /* This code is similar to intern function from lread.c. */
+ obarray = check_obarray (Vobarray);
parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
- if (len == nchars || len != nbytes)
- /* CONTENTS contains no multibyte sequences or contains an invalid
- multibyte sequence. We'll make a unibyte string. */
- tem = oblookup (obarray, str, len, len);
- else
- tem = oblookup (obarray, str, nchars, len);
+ tem = oblookup (obarray, str,
+ (len == nchars || len != nbytes) ? len : nchars, len);
+
if (SYMBOLP (tem))
return tem;
if (len == nchars || len != nbytes)
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))
VAL is an integer. */
int
-font_style_to_value (enum font_property_index prop, Lisp_Object val, int noerror)
+font_style_to_value (enum font_property_index prop, Lisp_Object val,
+ bool noerror)
{
Lisp_Object table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
- int len = ASIZE (table);
+ int len;
+
+ CHECK_VECTOR (table);
+ len = ASIZE (table);
if (SYMBOLP (val))
{
/* At first try exact match. */
for (i = 0; i < len; i++)
- for (j = 1; j < ASIZE (AREF (table, i)); j++)
- if (EQ (val, AREF (AREF (table, i), j)))
- return ((XINT (AREF (AREF (table, i), 0)) << 8)
- | (i << 4) | (j - 1));
+ {
+ CHECK_VECTOR (AREF (table, i));
+ for (j = 1; j < ASIZE (AREF (table, i)); j++)
+ if (EQ (val, AREF (AREF (table, i), j)))
+ {
+ CHECK_NUMBER (AREF (AREF (table, i), 0));
+ return ((XINT (AREF (AREF (table, i), 0)) << 8)
+ | (i << 4) | (j - 1));
+ }
+ }
/* Try also with case-folding match. */
s = SSDATA (SYMBOL_NAME (val));
for (i = 0; i < len; i++)
{
elt = AREF (AREF (table, i), j);
if (xstrcasecmp (s, SSDATA (SYMBOL_NAME (elt))) == 0)
- return ((XINT (AREF (AREF (table, i), 0)) << 8)
- | (i << 4) | (j - 1));
+ {
+ CHECK_NUMBER (AREF (AREF (table, i), 0));
+ return ((XINT (AREF (AREF (table, i), 0)) << 8)
+ | (i << 4) | (j - 1));
+ }
}
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;
else
{
int i, last_n;
- int numeric = XINT (val);
+ EMACS_INT numeric = XINT (val);
for (i = 0, last_n = -1; i < len; i++)
{
- int n = XINT (AREF (AREF (table, i), 0));
+ int n;
+ CHECK_VECTOR (AREF (table, i));
+ CHECK_NUMBER (AREF (AREF (table, i), 0));
+ n = XINT (AREF (AREF (table, i), 0));
if (numeric == n)
return (n << 8) | (i << 4);
if (numeric < n)
}
Lisp_Object
-font_style_symbolic (Lisp_Object font, enum font_property_index prop, int for_face)
+font_style_symbolic (Lisp_Object font, enum font_property_index prop,
+ bool for_face)
{
Lisp_Object val = AREF (font, prop);
Lisp_Object table, elt;
if (NILP (val))
return Qnil;
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));
- font_assert ((i & 0xF) + 1 < ASIZE (elt));
- return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
+ CHECK_VECTOR (elt);
+ eassert ((i & 0xF) + 1 < ASIZE (elt));
+ elt = (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
+ CHECK_SYMBOL (elt);
+ return elt;
}
/* Return ENCODING or a cons of ENCODING and REPERTORY of the font
: FONT_WIDTH_INDEX);
if (INTEGERP (val))
{
- int n = XINT (val);
+ EMACS_INT n = XINT (val);
+ CHECK_VECTOR (AREF (font_style_table, prop - FONT_WEIGHT_INDEX));
if (((n >> 4) & 0xF)
>= ASIZE (AREF (font_style_table, prop - FONT_WEIGHT_INDEX)))
val = Qerror;
{
Lisp_Object elt = AREF (AREF (font_style_table, prop - FONT_WEIGHT_INDEX), (n >> 4) & 0xF);
+ CHECK_VECTOR (elt);
if ((n & 0xF) + 1 >= ASIZE (elt))
val = Qerror;
- else if (XINT (AREF (elt, 0)) != (n >> 8))
- val = Qerror;
+ else
+ {
+ CHECK_NUMBER (AREF (elt, 0));
+ if (XINT (AREF (elt, 0)) != (n >> 8))
+ val = Qerror;
+ }
}
}
else if (SYMBOLP (val))
static int parse_matrix (const char *);
static int font_expand_wildcards (Lisp_Object *, int);
-static int font_parse_name (char *, Lisp_Object);
+static int font_parse_name (char *, ptrdiff_t, Lisp_Object);
/* An enumerator for each field of an XLFD font name. */
enum xlfd_field_index
if (INTEGERP (val))
{
- int numeric = XINT (val);
+ EMACS_INT numeric = XINT (val);
if (i + 1 == n)
from = to = XLFD_ENCODING_INDEX,
a fully specified XLFD. */
int
-font_parse_xlfd (char *name, Lisp_Object font)
+font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
{
- ptrdiff_t len = strlen (name);
int i, j, n;
char *f[XLFD_LAST_INDEX + 1];
Lisp_Object val;
{
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);
- else if (isdigit (*p))
+ else if (c_isdigit (*p))
point_size = atoi (p), point_size /= 10;
if (point_size >= 0)
ASET (font, FONT_SIZE_INDEX, make_float (point_size));
}
else
{
- int wild_card_found = 0;
+ bool wild_card_found = 0;
Lisp_Object prop[XLFD_LAST_INDEX];
if (FONT_ENTITY_P (font))
length), and return the name length. If FONT_SIZE_INDEX of FONT is
0, use PIXEL_SIZE instead. */
-int
+ptrdiff_t
font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
{
char *p;
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++)
}
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);
This function tries to guess which format it is. */
static int
-font_parse_fcname (char *name, Lisp_Object font)
+font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font)
{
char *p, *q;
char *size_beg = NULL, *size_end = NULL;
char *props_beg = NULL, *family_end = NULL;
- ptrdiff_t len = strlen (name);
if (len == 0)
return -1;
}
else if (*p == '-')
{
- int decimal = 0, size_found = 1;
+ bool decimal = 0, size_found = 1;
for (q = p + 1; *q && *q != ':'; q++)
- if (! isdigit (*q))
+ if (! c_isdigit (*q))
{
if (*q != '.' || decimal)
{
/* Scan backwards from the end, looking for a size. */
for (p = name + len - 1; p >= name; p--)
- if (!isdigit (*p))
+ if (!c_isdigit (*p))
break;
if ((p < name + len - 1) && ((p + 1 == name) || *p == ' '))
}
else
{
- if (! FLOATP (val))
- abort ();
+ eassert (FLOATP (val));
pixel_size = -1;
point_size = (int) XFLOAT_DATA (val);
}
0. Otherwise return -1. */
static int
-font_parse_name (char *name, Lisp_Object font)
+font_parse_name (char *name, ptrdiff_t namelen, Lisp_Object font)
{
if (name[0] == '-' || strchr (name, '*') || strchr (name, '?'))
- return font_parse_xlfd (name, font);
- return font_parse_fcname (name, font);
+ return font_parse_xlfd (name, namelen, font);
+ return font_parse_fcname (name, namelen, font);
}
check_gstring (Lisp_Object gstring)
{
Lisp_Object val;
- int i, j;
+ ptrdiff_t i;
+ int j;
CHECK_VECTOR (gstring);
val = AREF (gstring, 0);
CHECK_CONS (otf_features);
CHECK_SYMBOL (XCAR (otf_features));
otf_features = XCDR (otf_features);
- for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
+ for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
{
- CHECK_SYMBOL (Fcar (val));
+ CHECK_SYMBOL (XCAR (val));
if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
error ("Invalid OTF GSUB feature: %s",
SDATA (SYMBOL_NAME (XCAR (val))));
}
otf_features = XCDR (otf_features);
- for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
+ for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
{
- CHECK_SYMBOL (Fcar (val));
+ CHECK_SYMBOL (XCAR (val));
if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
error ("Invalid OTF GPOS feature: %s",
SDATA (SYMBOL_NAME (XCAR (val))));
{
Lisp_Object val;
char *p;
- int asterisk;
+ bool asterisk;
p = features;
*p = '\0';
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))
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;
}
}
-static int
-font_check_otf_features (Lisp_Object script, Lisp_Object langsys, Lisp_Object features, Lisp_Object table)
+static bool
+font_check_otf_features (Lisp_Object script, Lisp_Object langsys,
+ Lisp_Object features, Lisp_Object table)
{
Lisp_Object val;
- int negative;
+ bool negative;
table = assq_no_quit (script, table);
if (NILP (table))
/* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
-static int
+static bool
font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
{
Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
/* Check if FONT (font-entity or font-object) matches with the font
specification SPEC. */
-int
+bool
font_match_p (Lisp_Object spec, Lisp_Object font)
{
Lisp_Object prop[FONT_SPEC_MAX], *props;
/* All characters in the list must be supported. */
for (; CONSP (val2); val2 = XCDR (val2))
{
- if (! NATNUMP (XCAR (val2)))
+ if (! CHARACTERP (XCAR (val2)))
continue;
if (font_encode_char (font, XFASTINT (XCAR (val2)))
== FONT_INVALID_CODE)
/* At most one character in the vector must be supported. */
for (i = 0; i < ASIZE (val2); i++)
{
- if (! NATNUMP (AREF (val2, i)))
+ if (! CHARACTERP (AREF (val2, i)))
continue;
if (font_encode_char (font, XFASTINT (AREF (val2, i)))
!= FONT_INVALID_CODE)
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)
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;
if (! NILP (AREF (val, FONT_TYPE_INDEX)))
{
- font_assert (font && driver == font->driver);
+ eassert (font && driver == font->driver);
driver->close (f, font);
num_fonts--;
}
if (! NILP (Vface_ignored_fonts))
{
char name[256];
+ ptrdiff_t namelen;
Lisp_Object tail, regexp;
- if (font_unparse_xlfd (entity, 0, name, 256) >= 0)
+ namelen = font_unparse_xlfd (entity, 0, name, 256);
+ if (namelen >= 0)
{
for (tail = Vface_ignored_fonts; CONSP (tail); tail = XCDR (tail))
{
regexp = XCAR (tail);
if (STRINGP (regexp)
- && fast_c_string_match_ignore_case (regexp, name) >= 0)
+ && fast_c_string_match_ignore_case (regexp, name,
+ namelen) >= 0)
break;
}
if (CONSP (tail))
Lisp_Object ftype, val;
Lisp_Object list = Qnil;
int size;
- int need_filtering = 0;
+ bool 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));
val = driver_list->driver->list (frame, scratch_font_spec);
if (NILP (val))
- val = null_vector;
+ val = zero_vector;
else
val = Fvconcat (1, &val);
copy = copy_font_spec (scratch_font_spec);
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);
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--;
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)
{
{
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);
}
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);
}
Lisp_Object spec = Ffont_spec (0, NULL);
CHECK_STRING (font_name);
- if (font_parse_name (SSDATA (font_name), spec) == -1)
+ if (font_parse_name (SSDATA (font_name), SBYTES (font_name), spec) == -1)
return Qnil;
font_put_extra (spec, QCname, font_name);
font_put_extra (spec, QCuser_spec, font_name);
{
Lisp_Object font_entity;
Lisp_Object prefer;
- int result, i;
+ int i;
FRAME_PTR f = XFRAME (frame);
if (NILP (XCDR (entities))
&& ASIZE (XCAR (entities)) == 1)
{
font_entity = AREF (XCAR (entities), 0);
- if (c < 0
- || (result = font_has_char (f, font_entity, c)) > 0)
+ if (c < 0 || font_has_char (f, font_entity, c) > 0)
return font_entity;
return Qnil;
}
Lisp_Object foundry[3], *family, registry[3], adstyle[3];
int pixel_size;
int i, j, k, l;
+ USE_SAFE_ALLOCA;
registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
if (NILP (registry[0]))
{
registry[0] = DEFAULT_ENCODING;
registry[1] = Qascii_0;
- registry[2] = null_vector;
+ registry[2] = zero_vector;
}
else
- registry[1] = null_vector;
+ registry[1] = zero_vector;
if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
{
ASET (work, FONT_SIZE_INDEX, Qnil);
foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
if (! NILP (foundry[0]))
- foundry[1] = null_vector;
+ foundry[1] = zero_vector;
else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
{
val = attrs[LFACE_FOUNDRY_INDEX];
foundry[0] = font_intern_prop (SSDATA (val), SBYTES (val), 1);
foundry[1] = Qnil;
- foundry[2] = null_vector;
+ foundry[2] = zero_vector;
}
else
- foundry[0] = Qnil, foundry[1] = null_vector;
+ foundry[0] = Qnil, foundry[1] = zero_vector;
adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
if (! NILP (adstyle[0]))
- adstyle[1] = null_vector;
+ adstyle[1] = zero_vector;
else if (FONTP (attrs[LFACE_FONT_INDEX]))
{
Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
{
adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
adstyle[1] = Qnil;
- adstyle[2] = null_vector;
+ adstyle[2] = zero_vector;
}
else
- adstyle[0] = Qnil, adstyle[1] = null_vector;
+ adstyle[0] = Qnil, adstyle[1] = zero_vector;
}
else
- adstyle[0] = Qnil, adstyle[1] = null_vector;
+ adstyle[0] = Qnil, adstyle[1] = zero_vector;
val = AREF (work, FONT_FAMILY_INDEX);
{
family = alloca ((sizeof family[0]) * 2);
family[0] = Qnil;
- family[1] = null_vector; /* terminator. */
+ family[1] = zero_vector; /* terminator. */
}
else
{
if (! NILP (alters))
{
- family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
+ EMACS_INT alterslen = XFASTINT (Flength (alters));
+ SAFE_ALLOCA_LISP (family, alterslen + 2);
for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
family[i] = XCAR (alters);
if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
family[i++] = Qnil;
- family[i] = null_vector;
+ family[i] = zero_vector;
}
else
{
family[i++] = val;
if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
family[i++] = Qnil;
- family[i] = null_vector;
+ family[i] = zero_vector;
}
}
}
}
}
+
+ SAFE_FREE ();
return Qnil;
}
{
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;
found, return Qnil. */
Lisp_Object
-font_open_by_name (FRAME_PTR f, const char *name)
+font_open_by_name (FRAME_PTR f, Lisp_Object name)
{
Lisp_Object args[2];
Lisp_Object spec, ret;
args[0] = QCname;
- args[1] = make_unibyte_string (name, strlen (name));
+ args[1] = name;
spec = Ffont_spec (2, args);
ret = font_open_by_spec (f, spec);
/* Do not lose name originally put in. */
if (EQ (list->driver->type, driver->type))
error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
- list = xmalloc (sizeof (struct font_driver_list));
+ list = xmalloc (sizeof *list);
list->on = 0;
list->driver = driver;
list->next = NULL;
if (! list)
{
- list = xmalloc (sizeof (struct font_data_list));
+ list = xmalloc (sizeof *list);
list->driver = driver;
list->next = f->font_data_list;
f->font_data_list = list;
STRING. */
static Lisp_Object
-font_at (int c, EMACS_INT pos, struct face *face, struct window *w,
+font_at (int c, ptrdiff_t pos, struct face *face, struct window *w,
Lisp_Object string)
{
FRAME_PTR f;
- int multibyte;
+ bool multibyte;
Lisp_Object font_object;
multibyte = (NILP (string)
{
if (multibyte)
{
- EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
+ ptrdiff_t pos_byte = CHAR_TO_BYTE (pos);
c = FETCH_CHAR (pos_byte);
}
multibyte = STRING_MULTIBYTE (string);
if (multibyte)
{
- EMACS_INT pos_byte = string_char_to_byte (string, pos);
+ ptrdiff_t pos_byte = string_char_to_byte (string, pos);
str = SDATA (string) + pos_byte;
c = STRING_CHAR (str);
if (! face)
{
int face_id;
- EMACS_INT endptr;
+ ptrdiff_t endptr;
if (STRINGP (string))
face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
It is assured that the current buffer (or STRING) is multibyte. */
Lisp_Object
-font_range (EMACS_INT pos, EMACS_INT *limit, struct window *w, struct face *face, Lisp_Object string)
+font_range (ptrdiff_t pos, ptrdiff_t *limit, struct window *w, struct face *face, Lisp_Object string)
{
- EMACS_INT pos_byte, ignore;
+ ptrdiff_t pos_byte, ignore;
int c;
Lisp_Object font_object = Qnil;
}
else
{
- font_assert (face);
+ eassert (face);
pos_byte = string_char_to_byte (string, pos);
}
if (EQ (key, QCname))
{
CHECK_STRING (val);
- font_parse_name (SSDATA (val), spec);
+ font_parse_name (SSDATA (val), SBYTES (val), spec);
font_put_extra (spec, key, val);
}
else
(Lisp_Object font_spec, Lisp_Object frame, Lisp_Object num, Lisp_Object prefer)
{
Lisp_Object vec, list;
- int n = 0;
+ EMACS_INT n = 0;
if (NILP (frame))
frame = selected_frame;
(Lisp_Object font, Lisp_Object fold_wildcards)
{
char name[256];
- int pixel_size = 0;
+ int namelen, pixel_size = 0;
CHECK_FONT (font);
if (NILP (fold_wildcards))
return font_name;
strcpy (name, SSDATA (font_name));
+ namelen = SBYTES (font_name);
goto done;
}
pixel_size = XFONT_OBJECT (font)->pixel_size;
}
- if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
+ namelen = font_unparse_xlfd (font, pixel_size, name, 256);
+ if (namelen < 0)
return Qnil;
done:
if (! NILP (fold_wildcards))
while ((p1 = strstr (p0, "-*-*")))
{
strcpy (p1, p1 + 2);
+ namelen -= 2;
p0 = p1;
}
}
- return build_string (name);
+ return make_string (name, namelen);
}
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)
{
font_fill_lglyph_metrics (Lisp_Object glyph, Lisp_Object font_object)
{
struct font *font = XFONT_OBJECT (font_object);
- unsigned code;
- /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
- EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
+ unsigned code = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
struct font_metrics metrics;
- LGLYPH_SET_CODE (glyph, ecode);
- code = ecode;
+ LGLYPH_SET_CODE (glyph, code);
font->driver->text_extents (font, &code, 1, &metrics);
LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
header of the glyph-string.
If the shaping was successful, the value is GSTRING itself or a newly
-created glyph-string. Otherwise, the value is nil. */)
+created glyph-string. Otherwise, the value is nil.
+
+See the documentation of `composition-get-gstring' for the format of
+GSTRING. */)
(Lisp_Object gstring)
{
struct font *font;
Lisp_Object font_object, n, glyph;
- EMACS_INT i, j, from, to;
+ ptrdiff_t i, from, to;
if (! composition_gstring_p (gstring))
signal_error ("Invalid glyph-string: ", gstring);
if (INTEGERP (n))
break;
gstring = larger_vector (gstring,
- ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
- Qnil);
+ LGSTRING_GLYPH_LEN (gstring), -1);
}
if (i == 3 || XINT (n) == 0)
return Qnil;
if (XINT (n) < LGSTRING_GLYPH_LEN (gstring))
LGSTRING_SET_GLYPH (gstring, XINT (n), Qnil);
+ /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
+ GLYPHS covers all characters (except for the last few ones) in
+ GSTRING. More formally, provided that NCHARS is the number of
+ characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
+ and TO_IDX of each glyph must satisfy these conditions:
+
+ GLYPHS[0].FROM_IDX == 0
+ GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
+ if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
+ ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
+ GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
+ else
+ ;; Be sure to cover all characters.
+ GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
glyph = LGSTRING_GLYPH (gstring, 0);
from = LGLYPH_FROM (glyph);
to = LGLYPH_TO (glyph);
- for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
+ if (from != 0 || to < from)
+ goto shaper_error;
+ for (i = 1; i < LGSTRING_GLYPH_LEN (gstring); i++)
{
- Lisp_Object this = LGSTRING_GLYPH (gstring, i);
-
- if (NILP (this))
+ glyph = LGSTRING_GLYPH (gstring, i);
+ if (NILP (glyph))
break;
- if (NILP (LGLYPH_ADJUSTMENT (this)))
- {
- if (j < i - 1)
- for (; j < i; j++)
- {
- glyph = LGSTRING_GLYPH (gstring, j);
- LGLYPH_SET_FROM (glyph, from);
- LGLYPH_SET_TO (glyph, to);
- }
- from = LGLYPH_FROM (this);
- to = LGLYPH_TO (this);
- j = i;
- }
- else
- {
- if (from > LGLYPH_FROM (this))
- from = LGLYPH_FROM (this);
- if (to < LGLYPH_TO (this))
- to = LGLYPH_TO (this);
- }
+ if (! (LGLYPH_FROM (glyph) <= LGLYPH_TO (glyph)
+ && (LGLYPH_FROM (glyph) == from
+ ? LGLYPH_TO (glyph) == to
+ : LGLYPH_FROM (glyph) == to + 1)))
+ goto shaper_error;
+ from = LGLYPH_FROM (glyph);
+ to = LGLYPH_TO (glyph);
}
- if (j < i - 1)
- for (; j < i; j++)
- {
- glyph = LGSTRING_GLYPH (gstring, j);
- LGLYPH_SET_FROM (glyph, from);
- LGLYPH_SET_TO (glyph, to);
- }
return composition_gstring_put_cache (gstring, XINT (n));
+
+ shaper_error:
+ return Qnil;
}
DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs,
doc: /* Open FONT-ENTITY. */)
(Lisp_Object font_entity, Lisp_Object size, Lisp_Object frame)
{
- int isize;
+ EMACS_INT isize;
CHECK_FONT_ENTITY (font_entity);
if (NILP (frame))
isize = POINT_TO_PIXEL (XFLOAT_DATA (size), XFRAME (frame)->resy);
else
isize = XINT (size);
+ if (! (INT_MIN <= isize && isize <= INT_MAX))
+ args_out_of_range (font_entity, size);
if (isize == 0)
isize = 120;
}
Lisp_Object object)
{
struct font *font;
- int i, len;
+ ptrdiff_t i, len;
Lisp_Object *chars, vec;
USE_SAFE_ALLOCA;
CHECK_FONT_GET_OBJECT (font_object, font);
if (NILP (object))
{
- EMACS_INT charpos, bytepos;
+ ptrdiff_t charpos, bytepos;
validate_region (&from, &to);
if (EQ (from, to))
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);
(Lisp_Object position, Lisp_Object window, Lisp_Object string)
{
struct window *w;
- EMACS_INT pos;
+ ptrdiff_t pos;
if (NILP (string))
{
CHECK_NUMBER_COERCE_MARKER (position);
- pos = XINT (position);
- if (pos < BEGV || pos >= ZV)
+ if (! (BEGV <= XINT (position) && XINT (position) < ZV))
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
+ pos = XINT (position);
}
else
{
CHECK_NUMBER (position);
CHECK_STRING (string);
- pos = XINT (position);
- if (pos < 0 || pos >= SCHARS (string))
+ if (! (0 < XINT (position) && XINT (position) < SCHARS (string)))
args_out_of_range (string, position);
+ pos = XINT (position);
}
if (NILP (window))
window = selected_window;
if (fontset >= 0)
name = fontset_ascii (fontset);
- font_object = font_open_by_name (f, SSDATA (name));
+ font_object = font_open_by_name (f, name);
}
else if (FONT_OBJECT_P (name))
font_object = name;
font = XFONT_OBJECT (font_object);
info = Fmake_vector (make_number (7), Qnil);
- XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
- XVECTOR (info)->contents[1] = AREF (font_object, FONT_FULLNAME_INDEX);
- XVECTOR (info)->contents[2] = make_number (font->pixel_size);
- XVECTOR (info)->contents[3] = make_number (font->height);
- XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
- XVECTOR (info)->contents[5] = make_number (font->relative_compose);
- XVECTOR (info)->contents[6] = make_number (font->default_ascent);
+ ASET (info, 0, AREF (font_object, FONT_NAME_INDEX));
+ ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX));
+ ASET (info, 2, make_number (font->pixel_size));
+ ASET (info, 3, make_number (font->height));
+ ASET (info, 4, make_number (font->baseline_offset));
+ ASET (info, 5, make_number (font->relative_compose));
+ ASET (info, 6, make_number (font->default_ascent));
#if 0
/* As font_object is still in FONT_OBJLIST of the entity, we can't
DEFSYM (QCuser_spec, "user-spec");
- staticpro (&null_vector);
- null_vector = Fmake_vector (make_number (0), Qnil);
-
staticpro (&scratch_font_spec);
scratch_font_spec = Ffont_spec (0, NULL);
staticpro (&scratch_font_prefer);
/* Beyond here, there should be no more Lisp_Object components. */
- /* Maximum bound width over all existing characters of the font. On
- X window, this is same as (font->max_bounds.width). */
+ /* Minimum and maximum glyph widths, in pixels. Some font backends,
+ such as xft, lack the information to easily compute minimum and
+ maximum widths over all characters; in that case, these values
+ are approximate. */
+ int min_width;
int max_width;
/* By which pixel size the font is opened. */
/* Average width of glyphs in the font. If the font itself doesn't
have that information but has glyphs of ASCII characters, the
- value is the average with of those glyphs. Otherwise, the value
+ value is the average width of those glyphs. Otherwise, the value
is 0. */
int average_width;
- /* Minimum glyph width (in pixels). */
- int min_width;
-
/* Ascent and descent of the font (in pixels). */
int ascent, descent;
negative if that information is not in the font. */
int underline_position;
- /* 1 if `vertical-centering-font-regexp' matches this font name.
+ /* True if `vertical-centering-font-regexp' matches this font name.
In this case, we render characters at vertical center positions
of lines. */
- int vertical_centering;
-
- /* Encoding type of the font. The value is one of
- 0, 1, 2, or 3:
- 0: code points 0x20..0x7F or 0x2020..0x7F7F are used
- 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used
- 2: code points 0x20A0..0x7FFF are used
- 3: code points 0xA020..0xFF7F are used
- If the member `font_encoder' is not NULL, this member is ignored. */
- unsigned char encoding_type;
+ bool vertical_centering;
/* The baseline position of a font is normally `ascent' value of the
font. However, there exist many fonts which don't set `ascent' to
} while (0)
#define XFONT_SPEC(p) \
- (eassert (FONT_SPEC_P(p)), (struct font_spec *) XPNTR (p))
+ (eassert (FONT_SPEC_P (p)), (struct font_spec *) XUNTAG (p, Lisp_Vectorlike))
#define XFONT_ENTITY(p) \
- (eassert (FONT_ENTITY_P(p)), (struct font_entity *) XPNTR (p))
+ (eassert (FONT_ENTITY_P (p)), \
+ (struct font_entity *) XUNTAG (p, Lisp_Vectorlike))
#define XFONT_OBJECT(p) \
- (eassert (FONT_OBJECT_P(p)), (struct font *) XPNTR (p))
+ (eassert (FONT_OBJECT_P (p)), (struct font *) XUNTAG (p, Lisp_Vectorlike))
#define XSETFONT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FONT))
/* Number of pt per inch (from the TeXbook). */
/* Symbol indicating the type of the font-driver. */
Lisp_Object type;
- /* 1 iff the font's foundry, family, and adstyle names are case
+ /* True iff the font's foundry, family, and adstyle names are case
sensitive. */
- int case_sensitive;
+ bool case_sensitive;
/* Return a cache of font-entities on frame F. The cache must be a
cons whose cdr part is the actual cache area. */
/* Optional.
Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
- position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
- is nonzero, fill the background in advance. It is assured that
- WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars). */
+ position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
+ fill the background in advance. It is assured that WITH_BACKGROUND
+ is false when (FROM > 0 || TO < S->nchars). */
int (*draw) (struct glyph_string *s, int from, int to,
- int x, int y, int with_background);
+ int x, int y, bool with_background);
/* Optional.
Store bitmap data for glyph-code CODE of FONT in BITMAP. It is
short, return -1. */
int (*otf_drive) (struct font *font, Lisp_Object features,
Lisp_Object gstring_in, int from, int to,
- Lisp_Object gstring_out, int idx, int alternate_subst);
+ Lisp_Object gstring_out, int idx, bool alternate_subst);
/* Optional.
Make the font driver ready for frame F. Usually this function
Return non-zero if FONT_OBJECT can be used as a (cached) font
for ENTITY on frame F. */
- int (*cached_font_ok) (struct frame *f,
- Lisp_Object font_object,
- Lisp_Object entity);
+ bool (*cached_font_ok) (struct frame *f,
+ Lisp_Object font_object,
+ Lisp_Object entity);
};
struct font_driver_list
{
- /* 1 iff this driver is currently used. It is ignored in the global
+ /* True iff this driver is currently used. It is ignored in the global
font driver list.*/
- int on;
+ bool on;
/* Pointer to the font driver. */
struct font_driver *driver;
/* Pointer to the next element of the chain. */
struct font_data_list *next;
};
-EXFUN (Ffont_spec, MANY);
extern Lisp_Object copy_font_spec (Lisp_Object);
extern Lisp_Object merge_font_spec (Lisp_Object, Lisp_Object);
-EXFUN (Ffont_get, 2);
-EXFUN (Ffont_put, 3);
-EXFUN (Flist_fonts, 4);
-EXFUN (Ffont_xlfd_name, 2);
extern Lisp_Object font_make_entity (void);
extern Lisp_Object font_make_object (int, Lisp_Object, int);
extern int font_registry_charsets (Lisp_Object, struct charset **,
struct charset **);
extern int font_style_to_value (enum font_property_index prop,
- Lisp_Object name, int noerror);
+ Lisp_Object name, bool noerror);
extern Lisp_Object font_style_symbolic (Lisp_Object font,
enum font_property_index prop,
- int for_face);
+ bool for_face);
-extern int font_match_p (Lisp_Object spec, Lisp_Object font);
+extern bool font_match_p (Lisp_Object spec, Lisp_Object font);
extern Lisp_Object font_list_entities (Lisp_Object frame,
Lisp_Object spec);
extern void font_done_for_face (FRAME_PTR f, struct face *face);
extern Lisp_Object font_open_by_spec (FRAME_PTR f, Lisp_Object spec);
-extern Lisp_Object font_open_by_name (FRAME_PTR f, const char *name);
+extern Lisp_Object font_open_by_name (FRAME_PTR f, Lisp_Object name);
extern Lisp_Object font_intern_prop (const char *str, ptrdiff_t len,
- int force_symbol);
+ bool force_symbol);
extern void font_update_sort_order (int *order);
extern void font_parse_family_registry (Lisp_Object family,
Lisp_Object registry,
Lisp_Object spec);
-extern int font_parse_xlfd (char *name, Lisp_Object font);
-extern int font_unparse_xlfd (Lisp_Object font, int pixel_size,
- char *name, int bytes);
+extern int font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font);
+extern ptrdiff_t font_unparse_xlfd (Lisp_Object font, int pixel_size,
+ char *name, int bytes);
extern int font_unparse_fcname (Lisp_Object font, int pixel_size,
char *name, int bytes);
extern void register_font_driver (struct font_driver *driver, FRAME_PTR f);
extern void free_font_driver_list (FRAME_PTR f);
extern Lisp_Object font_update_drivers (FRAME_PTR f, Lisp_Object list);
-extern Lisp_Object font_range (EMACS_INT, EMACS_INT *,
+extern Lisp_Object font_range (ptrdiff_t, ptrdiff_t *,
struct window *, struct face *,
Lisp_Object);
extern void font_fill_lglyph_metrics (Lisp_Object, Lisp_Object);
extern void syms_of_xfont (void);
extern void syms_of_ftxfont (void);
#ifdef HAVE_XFT
+extern Lisp_Object Qxft;
extern struct font_driver xftfont_driver;
extern void syms_of_xftfont (void);
#elif defined HAVE_FREETYPE
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 */
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-/* #define FONTSET_DEBUG */
-
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "blockinput.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "ccl.h"
#include "keyboard.h"
#include "font.h"
-#undef xassert
-#ifdef FONTSET_DEBUG
-#define xassert(X) do {if (!(X)) abort ();} while (0)
-#else /* not FONTSET_DEBUG */
-#define xassert(X) (void) 0
-#endif /* not FONTSET_DEBUG */
-
/* FONTSET
A fontset is a collection of font related information to give
/* Prototype declarations for static functions. */
-static Lisp_Object fontset_add (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
-static Lisp_Object fontset_find_font (Lisp_Object, int, struct face *,
- int, int);
-static void reorder_font_vector (Lisp_Object, struct font *);
-static Lisp_Object fontset_font (Lisp_Object, int, struct face *, int);
static Lisp_Object make_fontset (Lisp_Object, Lisp_Object, Lisp_Object);
-static Lisp_Object fontset_pattern_regexp (Lisp_Object);
-static void accumulate_script_ranges (Lisp_Object, Lisp_Object,
- Lisp_Object);
-static void set_fontset_font (Lisp_Object, Lisp_Object);
-
-#ifdef FONTSET_DEBUG
-/* Return 1 if ID is a valid fontset id, else return 0. */
+/* Return true if ID is a valid fontset id.
+ Optimized away if ENABLE_CHECKING is not defined. */
-static int
+static bool
fontset_id_valid_p (int id)
{
return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
}
-#endif
-
\f
/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
/* Return the fontset with ID. No check of ID's validness. */
#define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
-/* Macros to access special values of FONTSET. */
-#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
+/* Access special values of FONTSET. */
+
+#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
+static void
+set_fontset_id (Lisp_Object fontset, Lisp_Object id)
+{
+ set_char_table_extras (fontset, 0, id);
+}
+
+/* Access special values of (base) FONTSET. */
+
+#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
+static void
+set_fontset_name (Lisp_Object fontset, Lisp_Object name)
+{
+ set_char_table_extras (fontset, 1, name);
+}
+
+#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
+static void
+set_fontset_ascii (Lisp_Object fontset, Lisp_Object ascii)
+{
+ set_char_table_extras (fontset, 4, ascii);
+}
+
+/* Access special values of (realized) FONTSET. */
+
+#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
+static void
+set_fontset_base (Lisp_Object fontset, Lisp_Object base)
+{
+ set_char_table_extras (fontset, 2, base);
+}
+
+#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
+static void
+set_fontset_frame (Lisp_Object fontset, Lisp_Object frame)
+{
+ set_char_table_extras (fontset, 3, frame);
+}
-/* Macros to access special values of (base) FONTSET. */
-#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
-#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
-/* #define FONTSET_SPEC(fontset) XCHAR_TABLE (fontset)->extras[5] */
+#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
+static void
+set_fontset_nofont_face (Lisp_Object fontset, Lisp_Object face)
+{
+ set_char_table_extras (fontset, 5, face);
+}
-/* Macros to access special values of (realized) FONTSET. */
-#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
-#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
-/* #define FONTSET_OBJLIST(fontset) XCHAR_TABLE (fontset)->extras[4] */
-#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
-/* #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6] */
-#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
+#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
+static void
+set_fontset_default (Lisp_Object fontset, Lisp_Object def)
+{
+ set_char_table_extras (fontset, 7, def);
+}
/* For both base and realized fontset. */
-#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
-#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
+#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
+static void
+set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
+{
+ set_char_table_extras (fontset, 8, fallback);
+}
+#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
/* Macros for FONT-DEF and RFONT-DEF of fontset. */
#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
#define RFONT_DEF_NEW(rfont_def, font_def) \
do { \
(rfont_def) = Fmake_vector (make_number (4), Qnil); \
- ASET ((rfont_def), 1, (font_def)); \
+ ASET ((rfont_def), 1, (font_def)); \
RFONT_DEF_SET_SCORE ((rfont_def), 0); \
} while (0)
replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
append ELT. */
-#define FONTSET_ADD(fontset, range, elt, add) \
- (NILP (add) \
- ? (NILP (range) \
- ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
- : Fset_char_table_range ((fontset), (range), \
- Fmake_vector (make_number (1), (elt)))) \
+#define FONTSET_ADD(fontset, range, elt, add) \
+ (NILP (add) \
+ ? (NILP (range) \
+ ? (set_fontset_fallback \
+ (fontset, Fmake_vector (make_number (1), (elt)))) \
+ : ((void) \
+ Fset_char_table_range (fontset, range, \
+ Fmake_vector (make_number (1), elt)))) \
: fontset_add ((fontset), (range), (elt), (add)))
-static Lisp_Object
+static void
fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
{
Lisp_Object args[2];
else
{
args[idx] = FONTSET_FALLBACK (fontset);
- FONTSET_FALLBACK (fontset)
- = NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args);
+ set_fontset_fallback
+ (fontset, NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args));
}
- return Qnil;
}
static int
Lisp_Object vec, font_object;
int size;
int i;
- int score_changed = 0;
+ bool score_changed = 0;
if (font)
XSETFONT (font_object, font);
for (tail = Vcharset_ordered_list;
! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
- score += 0x100, tail = XCDR (tail))
+ tail = XCDR (tail))
if (EQ (encoding, XCAR (tail)))
break;
+ else if (score <= min (INT_MAX, MOST_POSITIVE_FIXNUM) - 0x100)
+ score += 0x100;
}
else
{
}
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));
}
Lisp_Object base_fontset;
int from = 0, to = MAX_CHAR, i;
- xassert (! BASE_FONTSET_P (fontset));
+ eassert (! BASE_FONTSET_P (fontset));
if (c >= 0)
font_group = CHAR_TABLE_REF (fontset, c);
else
if (c >= 0)
char_table_set_range (fontset, from, to, font_group);
else
- FONTSET_FALLBACK (fontset) = font_group;
+ set_fontset_fallback (fontset, font_group);
return font_group;
}
ID is a charset-id that must be preferred, or -1 meaning no
preference.
- If FALLBACK is nonzero, search only fallback fonts. */
+ If FALLBACK, search only fallback fonts. */
static Lisp_Object
-fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, int fallback)
+fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
+ bool fallback)
{
Lisp_Object vec, font_group;
int i, charset_matched = 0, found_index;
if (! EQ (base_fontset, Vdefault_fontset))
{
if (NILP (FONTSET_DEFAULT (fontset)))
- FONTSET_DEFAULT (fontset)
- = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
+ set_fontset_default
+ (fontset,
+ make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
default_rfont_def
= fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
while (!NILP (AREF (Vfontset_table, id))) id++;
if (id + 1 == size)
- Vfontset_table = larger_vector (Vfontset_table, size + 32, Qnil);
+ Vfontset_table = larger_vector (Vfontset_table, 1, -1);
fontset = Fmake_char_table (Qfontset, Qnil);
- FONTSET_ID (fontset) = make_number (id);
+ set_fontset_id (fontset, make_number (id));
if (NILP (base))
- {
- FONTSET_NAME (fontset) = name;
- }
+ set_fontset_name (fontset, name);
else
{
- FONTSET_NAME (fontset) = Qnil;
- FONTSET_FRAME (fontset) = frame;
- FONTSET_BASE (fontset) = base;
+ set_fontset_name (fontset, Qnil);
+ set_fontset_frame (fontset, frame);
+ set_fontset_base (fontset, base);
}
ASET (Vfontset_table, id, fontset);
if (0)
for (tail = FONTSET_OBJLIST (fontset); CONSP (tail); tail = XCDR (tail))
{
- xassert (FONT_OBJECT_P (XCAR (tail)));
+ eassert (FONT_OBJECT_P (XCAR (tail)));
font_close_object (f, XCAR (tail));
}
#endif
fontset = FONTSET_FROM_ID (face->fontset);
if (NILP (fontset))
return;
- xassert (! BASE_FONTSET_P (fontset));
- xassert (f == XFRAME (FONTSET_FRAME (fontset)));
+ eassert (! BASE_FONTSET_P (fontset));
+ eassert (f == XFRAME (FONTSET_FRAME (fontset)));
free_realized_fontset (f, fontset);
ASET (Vfontset_table, face->fontset, Qnil);
if (face->fontset < next_fontset_id)
int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
fontset = AREF (Vfontset_table, id);
- xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
- xassert (f == XFRAME (FONTSET_FRAME (fontset)));
+ eassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
+ eassert (f == XFRAME (FONTSET_FRAME (fontset)));
free_realized_fontset (f, fontset);
ASET (Vfontset_table, id, Qnil);
if (id < next_fontset_id)
#if 0
-/* Return 1 if FACE is suitable for displaying character C.
- Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
+/* Return true if FACE is suitable for displaying character C.
+ Called from the macro FACE_SUITABLE_FOR_CHAR_P
when C is not an ASCII character. */
-int
+bool
face_suitable_for_char_p (struct face *face, int c)
{
Lisp_Object fontset, rfont_def;
if (ASCII_CHAR_P (c) || face->fontset < 0)
return face->ascii_face->id;
- xassert (fontset_id_valid_p (face->fontset));
+ eassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
- xassert (!BASE_FONTSET_P (fontset));
+ eassert (!BASE_FONTSET_P (fontset));
if (pos < 0)
{
else
{
face_id = face_for_font (f, Qnil, face);
- FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
+ set_fontset_nofont_face (fontset, make_number (face_id));
}
}
- xassert (face_id >= 0);
+ eassert (face_id >= 0);
return face_id;
}
return font_object;
}
- xassert (fontset_id_valid_p (face->fontset));
+ eassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
- xassert (!BASE_FONTSET_P (fontset));
+ eassert (!BASE_FONTSET_P (fontset));
if (pos < 0)
{
id = -1;
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;
we convert "*" to "[^-]*" which is much faster in regular
expression matching. */
if (ndashes < 14)
- p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
+ p1 = regex = alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
else
- p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
+ p1 = regex = alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
*p1++ = '^';
for (p0 = SDATA (pattern); *p0; p0++)
doesn't remove FACE from a cache. Until we find a solution, we
suppress this code, and simply use Fclear_face_cache even though
that is not efficient. */
- BLOCK_INPUT;
+ block_input ();
for (id = 0; id < ASIZE (Vfontset_table); id++)
{
Lisp_Object this = AREF (Vfontset_table, id);
}
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
#else /* not 0 */
/* But, we don't have to call Fclear_face_cache if no fontset has
been realized from BASE. */
Lisp_Object range_list;
struct charset *charset = NULL;
Lisp_Object fontname;
- int ascii_changed = 0;
+ bool ascii_changed = 0;
fontset = check_fontset_name (name, &frame);
Lisp_Object tail, fr, alist;
int fontset_id = XINT (FONTSET_ID (fontset));
- FONTSET_ASCII (fontset) = fontname;
+ set_fontset_ascii (fontset, fontname);
name = FONTSET_NAME (fontset);
FOR_EACH_FRAME (tail, fr)
{
char xlfd[256];
int len;
- if (font_parse_xlfd (SSDATA (name), font_spec) < 0)
+ if (font_parse_xlfd (SSDATA (name), SBYTES (name), font_spec) < 0)
error ("Fontset name must be in XLFD format");
short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
if (len < 0)
error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
- FONTSET_ASCII (fontset) = make_unibyte_string (xlfd, len);
+ set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
}
else
{
Fset_char_table_range (fontset, Qt, Qnil);
}
- for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
+ for (; CONSP (fontlist); fontlist = XCDR (fontlist))
{
Lisp_Object elt, script;
- elt = Fcar (fontlist);
+ elt = XCAR (fontlist);
script = Fcar (elt);
elt = Fcdr (elt);
if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
static Lisp_Object auto_fontset_alist;
/* Number of automatically created fontsets. */
-static printmax_t num_auto_fontsets;
+static ptrdiff_t num_auto_fontsets;
/* Return a fontset synthesized from FONT-OBJECT. This is called from
x_new_font when FONT-OBJECT is used for the default ASCII font of a
alias = intern ("fontset-startup");
else
{
- char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (printmax_t)];
+ char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
- sprintf (temp, "fontset-auto%"pMd, num_auto_fontsets - 1);
+ sprintf (temp, "fontset-auto%"pD"d", num_auto_fontsets - 1);
alias = intern (temp);
}
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);
Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
}
- FONTSET_ASCII (fontset) = font_name;
+ set_fontset_ascii (fontset, font_name);
return XINT (FONTSET_ID (fontset));
}
doc: /* For internal use only. */)
(Lisp_Object position, Lisp_Object ch)
{
- EMACS_INT pos, pos_byte, dummy;
+ ptrdiff_t pos, pos_byte, dummy;
int face_id;
int c;
struct frame *f;
struct window *w;
CHECK_NUMBER_COERCE_MARKER (position);
- pos = XINT (position);
- if (pos < BEGV || pos >= ZV)
+ if (! (BEGV <= XINT (position) && XINT (position) < ZV))
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
+ pos = XINT (position);
pos_byte = CHAR_TO_BYTE (pos);
if (NILP (ch))
c = FETCH_CHAR (pos_byte);
/* Recode fontsets realized on FRAME from the base fontset FONTSET
in the table `realized'. */
- realized[0] = (Lisp_Object *) 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);
}
realized[0][j] = Qnil;
- realized[1] = (Lisp_Object *) 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]);
if (!EQ (fontset, Vdefault_fontset))
{
tables[1] = Fmake_char_table (Qnil, Qnil);
- XCHAR_TABLE (tables[0])->extras[0] = tables[1];
+ set_char_table_extras (tables[0], 0, tables[1]);
fontsets[1] = Vdefault_fontset;
}
if (c <= MAX_5_BYTE_CHAR)
char_table_set_range (tables[k], c, to, alist);
else
- XCHAR_TABLE (tables[k])->defalt = alist;
+ set_char_table_defalt (tables[k], alist);
/* At last, change each elements to font names. */
for (; CONSP (alist); alist = XCDR (alist))
}
-#ifdef FONTSET_DEBUG
+#ifdef ENABLE_CHECKING
Lisp_Object dump_fontset (Lisp_Object) EXTERNALLY_VISIBLE;
if (FRAME_LIVE_P (f))
ASET (vec, 1,
- Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), f->name));
+ Fcons (FONTSET_NAME (FONTSET_BASE (fontset)),
+ f->name));
else
ASET (vec, 1,
Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
return (Fnreverse (val));
}
-#endif /* FONTSET_DEBUG */
+#endif /* ENABLE_CHECKING */
void
syms_of_fontset (void)
Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
staticpro (&Vdefault_fontset);
- FONTSET_ID (Vdefault_fontset) = make_number (0);
- FONTSET_NAME (Vdefault_fontset)
- = make_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
+ set_fontset_id (Vdefault_fontset, make_number (0));
+ set_fontset_name
+ (Vdefault_fontset,
+ build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
ASET (Vfontset_table, 0, Vdefault_fontset);
next_fontset_id = 1;
DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
doc: /* Alist of fontset names vs the aliases. */);
Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
- make_pure_c_string ("fontset-default")),
+ build_pure_c_string ("fontset-default")),
Qnil);
DEFVAR_LISP ("vertical-centering-font-regexp",
Vvertical_centering_font_regexp,
- doc: /* *Regexp matching font names that require vertical centering on display.
+ doc: /* Regexp matching font names that require vertical centering on display.
When a character is displayed with such fonts, the character is displayed
at the vertical center of lines. */);
Vvertical_centering_font_regexp = Qnil;
defsubr (&Sfontset_info);
defsubr (&Sfontset_font);
defsubr (&Sfontset_list);
-#ifdef FONTSET_DEBUG
+#ifdef ENABLE_CHECKING
defsubr (&Sfontset_list_all);
#endif
}
extern int make_fontset_for_ascii_face (FRAME_PTR, int, struct face *);
extern int fontset_from_font (Lisp_Object);
extern int fs_query_fontset (Lisp_Object, int);
-EXFUN (Fquery_fontset, 2);
extern Lisp_Object list_fontsets (struct frame *, Lisp_Object, int);
extern Lisp_Object Qlatin;
#include <config.h>
+#define FRAME_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <ctype.h>
#include <errno.h>
#include <limits.h>
-#include <setjmp.h>
+
+#include <c-ctype.h>
+
#include "lisp.h"
#include "character.h"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif
-#ifdef WINDOWSNT
-#include "w32term.h"
-#endif
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
+
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
+
#include "buffer.h"
/* These help us bind and responding to switch-frame events. */
#include "commands.h"
#include "dosfns.h"
#endif
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-#endif
-
#ifdef HAVE_NS
Lisp_Object Qns_parse_geometry;
#endif
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;
static void x_report_frame_params (struct frame *, Lisp_Object *);
#endif
+/* These setters are used only in this file, so they can be private. */
+static inline void
+fset_buffer_predicate (struct frame *f, Lisp_Object val)
+{
+ f->buffer_predicate = val;
+}
+static inline void
+fset_minibuffer_window (struct frame *f, Lisp_Object val)
+{
+ f->minibuffer_window = val;
+}
+
\f
static void
set_menu_bar_lines_1 (Lisp_Object window, int n)
{
struct window *w = XWINDOW (window);
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
- XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
+ w->last_modified = 0;
+ wset_top_line (w, make_number (XFASTINT (w->top_line) + n));
+ wset_total_lines (w, make_number (XFASTINT (w->total_lines) - n));
/* Handle just the top child in a vertical split. */
if (!NILP (w->vchild))
case output_ns:
return Qns;
default:
- abort ();
+ emacs_abort ();
}
}
f = allocate_frame ();
XSETFRAME (frame, f);
- f->desired_matrix = 0;
- f->current_matrix = 0;
- f->desired_pool = 0;
- f->current_pool = 0;
- f->glyphs_initialized_p = 0;
- f->decode_mode_spec_buffer = 0;
- f->visible = 0;
- f->async_visible = 0;
- f->output_data.nothing = 0;
- f->iconified = 0;
- f->async_iconified = 0;
+ /* Initialize Lisp data. Note that allocate_frame initializes all
+ Lisp data to nil, so do it only for slots which should not be nil. */
+ fset_tool_bar_position (f, 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.
+ To avoid subtle bugs and for the sake of readability, it's better to
+ initialize enum members explicitly even if their values are zero. */
f->wants_modeline = 1;
- f->auto_raise = 0;
- f->auto_lower = 0;
- f->no_split = 0;
f->garbaged = 1;
f->has_minibuffer = mini_p;
- f->focus_frame = Qnil;
- f->explicit_name = 0;
- f->can_have_scroll_bars = 0;
f->vertical_scroll_bar_type = vertical_scroll_bar_none;
- f->param_alist = Qnil;
- f->scroll_bars = Qnil;
- f->condemned_scroll_bars = Qnil;
- f->face_alist = Qnil;
- f->face_cache = NULL;
- f->menu_bar_items = Qnil;
- f->menu_bar_vector = Qnil;
- f->menu_bar_items_used = 0;
- f->buffer_predicate = Qnil;
- f->buffer_list = Qnil;
- f->buried_buffer_list = Qnil;
- f->namebuf = 0;
- f->title = Qnil;
- f->menu_bar_window = Qnil;
- f->tool_bar_window = Qnil;
- f->tool_bar_items = Qnil;
- f->tool_bar_position = Qtop;
- f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
- f->n_tool_bar_items = 0;
- f->left_fringe_width = f->right_fringe_width = 0;
- f->fringe_cols = 0;
- f->menu_bar_lines = 0;
- f->tool_bar_lines = 0;
- f->scroll_bar_actual_width = 0;
- f->border_width = 0;
- f->internal_border_width = 0;
f->column_width = 1; /* !FRAME_WINDOW_P value */
f->line_height = 1; /* !FRAME_WINDOW_P value */
- f->x_pixels_diff = f->y_pixels_diff = 0;
#ifdef HAVE_WINDOW_SYSTEM
f->want_fullscreen = FULLSCREEN_NONE;
#endif
- f->size_hint_flags = 0;
- f->win_gravity = 0;
- f->font_driver_list = NULL;
- f->font_data_list = NULL;
root_window = make_window ();
if (mini_p)
{
mini_window = make_window ();
- XWINDOW (root_window)->next = mini_window;
- XWINDOW (mini_window)->prev = root_window;
- XWINDOW (mini_window)->mini_p = Qt;
- XWINDOW (mini_window)->frame = frame;
- f->minibuffer_window = mini_window;
+ wset_next (XWINDOW (root_window), mini_window);
+ wset_prev (XWINDOW (mini_window), root_window);
+ XWINDOW (mini_window)->mini = 1;
+ wset_frame (XWINDOW (mini_window), frame);
+ fset_minibuffer_window (f, mini_window);
}
else
{
mini_window = Qnil;
- XWINDOW (root_window)->next = Qnil;
- f->minibuffer_window = Qnil;
+ wset_next (XWINDOW (root_window), Qnil);
+ fset_minibuffer_window (f, Qnil);
}
- XWINDOW (root_window)->frame = frame;
+ wset_frame (XWINDOW (root_window), frame);
/* 10 is arbitrary,
just so that there is "something there."
SET_FRAME_COLS (f, 10);
FRAME_LINES (f) = 10;
- XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
- XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
+ wset_total_cols (XWINDOW (root_window), make_number (10));
+ wset_total_lines (XWINDOW (root_window), make_number (mini_p ? 9 : 10));
if (mini_p)
{
- XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
- XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
- XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
+ wset_total_cols (XWINDOW (mini_window), make_number (10));
+ wset_top_line (XWINDOW (mini_window), make_number (9));
+ wset_total_lines (XWINDOW (mini_window), make_number (1));
}
/* Choose a buffer for the frame's root window. */
{
Lisp_Object buf;
- XWINDOW (root_window)->buffer = Qt;
+ wset_buffer (XWINDOW (root_window), Qt);
buf = Fcurrent_buffer ();
/* If buf is a 'hidden' buffer (i.e. one whose name starts with
a space), try to find another one. */
etc. Running Lisp functions at this point surely ends in a
SEGV. */
set_window_buffer (root_window, buf, 0, 0);
- f->buffer_list = Fcons (buf, Qnil);
+ fset_buffer_list (f, Fcons (buf, Qnil));
}
if (mini_p)
{
- XWINDOW (mini_window)->buffer = Qt;
+ wset_buffer (XWINDOW (mini_window), Qt);
set_window_buffer (mini_window,
(NILP (Vminibuffer_list)
? get_minibuffer (0)
0, 0);
}
- f->root_window = root_window;
- f->selected_window = root_window;
+ fset_root_window (f, root_window);
+ fset_selected_window (f, root_window);
/* Make sure this window seems more recently used than
a newly-created, never-selected window. */
- ++window_select_count;
- XSETFASTINT (XWINDOW (f->selected_window)->use_time, window_select_count);
-
- f->default_face_done_p = 0;
+ XWINDOW (f->selected_window)->use_time = ++window_select_count;
return f;
}
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_default_minibuffer_frame
+ (kb, call1 (intern ("make-initial-minibuffer-frame"), display));
UNGCPRO;
}
- mini_window = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
+ mini_window
+ = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window;
}
- f->minibuffer_window = mini_window;
+ fset_minibuffer_window (f, mini_window);
/* Make the chosen minibuffer window display the proper minibuffer,
unless it is already showing a minibuffer. */
if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list)))
- 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;
}
Avoid infinite looping on the window chain by marking next pointer
as nil. */
- mini_window = f->minibuffer_window = f->root_window;
- XWINDOW (mini_window)->mini_p = Qt;
- XWINDOW (mini_window)->next = Qnil;
- XWINDOW (mini_window)->prev = Qnil;
- XWINDOW (mini_window)->frame = frame;
+ mini_window = f->root_window;
+ fset_minibuffer_window (f, mini_window);
+ XWINDOW (mini_window)->mini = 1;
+ wset_next (XWINDOW (mini_window), Qnil);
+ wset_prev (XWINDOW (mini_window), Qnil);
+ wset_frame (XWINDOW (mini_window), 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 */
Vframe_list = Fcons (frame, Vframe_list);
tty_frame_count = 1;
- f->name = make_pure_c_string ("F1");
+ fset_name (f, build_pure_c_string ("F1"));
f->visible = 1;
f->async_visible = 1;
XSETFRAME (frame, f);
Vframe_list = Fcons (frame, Vframe_list);
- tty_frame_count++;
- sprintf (name, "F%"pMd, tty_frame_count);
- f->name = build_string (name);
+ fset_name (f, 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. */
doc: /* Create an additional terminal frame, possibly on another terminal.
This function takes one argument, an alist specifying frame parameters.
-You can create multiple frames on a single text-only terminal, but
-only one of them (the selected terminal frame) is actually displayed.
+You can create multiple frames on a single text terminal, but only one
+of them (the selected terminal frame) is actually displayed.
In practice, generally you don't need to specify any parameters,
except when you want to create a new frame on another terminal.
#ifdef MSDOS
if (sf->output_method != output_msdos_raw
&& sf->output_method != output_termcap)
- abort ();
+ emacs_abort ();
#else /* not MSDOS */
#ifdef WINDOWSNT /* This should work now! */
: NULL));
if (!NILP (tty))
{
- name = (char *) alloca (SBYTES (tty) + 1);
- strncpy (name, SSDATA (tty), SBYTES (tty));
+ name = alloca (SBYTES (tty) + 1);
+ memcpy (name, SSDATA (tty), SBYTES (tty));
name[SBYTES (tty)] = 0;
}
: NULL));
if (!NILP (tty_type))
{
- type = (char *) alloca (SBYTES (tty_type) + 1);
- strncpy (type, SSDATA (tty_type), SBYTES (tty_type));
+ type = alloca (SBYTES (tty_type) + 1);
+ memcpy (type, SSDATA (tty_type), SBYTES (tty_type));
type[SBYTES (tty_type)] = 0;
}
/* Make the frame face alist be frame-specific, so that each
frame could change its face definitions independently. */
- f->face_alist = Fcopy_alist (sf->face_alist);
+ fset_face_alist (f, 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. */
Lisp_Object focus;
if (!FRAMEP (XCAR (tail)))
- abort ();
+ emacs_abort ();
focus = FRAME_FOCUS_FRAME (XFRAME (XCAR (tail)));
this function is called. If you are using a window system, the
previously selected frame may be restored as the selected frame
when returning to the command loop, because it still may have
-the window system's input focus. On a text-only terminal, the
-next redisplay will display FRAME.
+the window system's input focus. On a text terminal, the next
+redisplay will display FRAME.
This function returns FRAME, or nil if FRAME has been deleted. */)
(Lisp_Object frame, Lisp_Object norecord)
(Lisp_Object event)
{
/* Preserve prefix arg that the command loop just cleared. */
- KVAR (current_kboard, Vprefix_arg) = Vcurrent_prefix_arg;
+ kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
Frun_hooks (1, &Qmouse_leave_buffer_hook);
return do_switch_frame (event, 0, 0, Qnil);
}
/* There must always be at least one frame in Vframe_list. */
if (! CONSP (Vframe_list))
- abort ();
+ emacs_abort ();
/* If this frame is dead, it won't be in Vframe_list, and we'll loop
forever. Forestall that. */
/* There must always be at least one frame in Vframe_list. */
if (! CONSP (Vframe_list))
- abort ();
+ emacs_abort ();
prev = Qnil;
for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
f = XCAR (tail);
if (!FRAMEP (f))
- abort ();
+ emacs_abort ();
if (EQ (frame, f) && !NILP (prev))
return prev;
described for Fdelete_frame. */
Lisp_Object
delete_frame (Lisp_Object frame, Lisp_Object force)
- /* If we use `register' here, gcc-4.0.2 on amd64 using
- -DUSE_LISP_UNION_TYPE complains further down that we're getting the
- address of `force'. Go figure. */
-
{
struct frame *f;
struct frame *sf = SELECTED_FRAME ();
FOR_EACH_FRAME (tail, frame1)
{
if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
- break;
+ {
+ /* Do not change a text terminal's top-frame. */
+ struct frame *f1 = XFRAME (frame1);
+ if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1))
+ {
+ Lisp_Object top_frame = FRAME_TTY (f1)->top_frame;
+ if (!EQ (top_frame, frame))
+ frame1 = top_frame;
+ }
+ break;
+ }
}
}
#ifdef NS_IMPL_COCOA
/* Don't allow minibuf_window to remain on a deleted frame. */
if (EQ (f->minibuffer_window, minibuf_window))
{
- Fset_window_buffer (sf->minibuffer_window,
- XWINDOW (minibuf_window)->buffer, Qnil);
+ /* 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,
/* Mark all the windows that used to be on FRAME as deleted, and then
remove the reference to them. */
delete_all_child_windows (f->root_window);
- f->root_window = Qnil;
+ fset_root_window (f, Qnil);
Vframe_list = Fdelq (frame, Vframe_list);
FRAME_SET_VISIBLE (f, 0);
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. */
- f->menu_bar_vector = Qnil;
+ fset_menu_bar_vector (f, Qnil);
+
+ /* If FRAME's buffer lists contains killed
+ buffers, this helps GC to reclaim them. */
+ fset_buffer_list (f, Qnil);
+ fset_buried_buffer_list (f, Qnil);
free_font_driver_list (f);
xfree (f->namebuf);
this = XCAR (frames);
if (!FRAMEP (this))
- abort ();
+ emacs_abort ();
f1 = XFRAME (this);
if (kb == FRAME_KBOARD (f1))
this = XCAR (frames);
if (!FRAMEP (this))
- abort ();
+ emacs_abort ();
f1 = XFRAME (this);
/* Consider only frames on the same kboard
that is prohibited at the top; you can't delete surrogate
minibuffer frames. */
if (NILP (frame_with_minibuf))
- abort ();
+ emacs_abort ();
- KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf;
+ kset_default_minibuffer_frame (kb, frame_with_minibuf);
}
else
/* No frames left on this kboard--say no minibuffer either. */
- KVAR (kb, Vdefault_minibuffer_frame) = Qnil;
+ kset_default_minibuffer_frame (kb, Qnil);
}
/* Cause frame titles to update--necessary if we now have just one frame. */
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
CHECK_LIVE_FRAME (frame);
- CHECK_NUMBER (x);
- CHECK_NUMBER (y);
+ CHECK_TYPE_RANGED_INTEGER (int, x);
+ CHECK_TYPE_RANGED_INTEGER (int, y);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
(Lisp_Object frame, Lisp_Object x, Lisp_Object y)
{
CHECK_LIVE_FRAME (frame);
- CHECK_NUMBER (x);
- CHECK_NUMBER (y);
+ CHECK_TYPE_RANGED_INTEGER (int, x);
+ CHECK_TYPE_RANGED_INTEGER (int, y);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
w = XWINDOW (window);
if (!NILP (w->buffer))
- BVAR (XBUFFER (w->buffer), display_time) = Fcurrent_time ();
+ bset_display_time (XBUFFER (w->buffer), Fcurrent_time ());
if (!NILP (w->vchild))
make_frame_visible_1 (w->vchild);
Normally you may not make FRAME invisible if all other frames are invisible,
but if the second optional argument FORCE is non-nil, you may do so.
-This function has no effect on text-only terminal frames. Such frames
-are always considered visible, whether or not they are currently being
+This function has no effect on text terminal frames. Such frames are
+always considered visible, whether or not they are currently being
displayed in the terminal. */)
(Lisp_Object frame, Lisp_Object force)
{
if (NILP (force) && !other_visible_frames (XFRAME (frame)))
error ("Attempt to make invisible the sole visible or iconified frame");
-#if 0 /* This isn't logically necessary, and it can do GC. */
- /* Don't let the frame remain selected. */
- if (EQ (frame, selected_frame))
- do_switch_frame (next_frame (frame, Qt), 0, 0, Qnil)
-#endif
-
/* Don't allow minibuf_window to remain on a deleted frame. */
if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window))
{
struct frame *sf = XFRAME (selected_frame);
- Fset_window_buffer (sf->minibuffer_window,
- XWINDOW (minibuf_window)->buffer, Qnil);
+ /* 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;
}
Fhandle_switch_frame (next_frame (frame, Qt));
#endif
- /* Don't allow minibuf_window to remain on a deleted frame. */
+ /* 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 (sf->minibuffer_window,
- XWINDOW (minibuf_window)->buffer, Qnil);
+ /* 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;
}
On graphical displays, invisible frames are not updated and are
usually not displayed at all, even in a window system's \"taskbar\".
-If FRAME is a text-only terminal frame, this always returns t.
+If FRAME is a text terminal frame, this always returns t.
Such frames are always considered visible, whether or not they are
currently being displayed on the terminal. */)
(Lisp_Object frame)
f = XFRAME (frame);
if (FRAME_TERMCAP_P (f))
- /* On a text-only terminal select FRAME. */
+ /* On a text terminal select FRAME. */
Fselect_frame (frame, Qnil);
else
/* Do like the documentation says. */
request a switch to FOCUS-FRAME, and `last-event-frame' will be
FOCUS-FRAME after reading an event typed at FRAME.
-If FOCUS-FRAME is omitted or nil, any existing redirection is
-canceled, and the frame again receives its own keystrokes.
+If FOCUS-FRAME is nil, any existing redirection is canceled, and the
+frame again receives its own keystrokes.
Focus redirection is useful for temporarily redirecting keystrokes to
a surrogate minibuffer frame when a frame doesn't have its own
f = XFRAME (frame);
- f->focus_frame = focus_frame;
+ fset_focus_frame (f, focus_frame);
if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
(*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f);
\f
/* Return the value of frame parameter PROP in frame FRAME. */
+#ifdef HAVE_WINDOW_SYSTEM
#if !HAVE_NS
static
#endif
return tem;
return Fcdr (tem);
}
+#endif
/* Return the buffer-predicate of the selected frame. */
FOR_EACH_FRAME (tail, frame)
{
- XFRAME (frame)->buffer_list
- = Fdelq (buffer, XFRAME (frame)->buffer_list);
- XFRAME (frame)->buried_buffer_list
- = Fdelq (buffer, XFRAME (frame)->buried_buffer_list);
+ fset_buffer_list
+ (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buffer_list));
+ fset_buried_buffer_list
+ (XFRAME (frame), Fdelq (buffer, XFRAME (frame)->buried_buffer_list));
}
}
}
static int
-frame_name_fnn_p (char *str, EMACS_INT len)
+frame_name_fnn_p (char *str, ptrdiff_t len)
{
if (len > 1 && str[0] == 'F' && '0' <= str[1] && str[1] <= '9')
{
/* Check for no change needed in this very common case
before we do any consing. */
- if (frame_name_fnn_p (SSDATA (f->name),
- SBYTES (f->name)))
+ if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name)))
return;
- tty_frame_count++;
- sprintf (namebuf, "F%"pMd, tty_frame_count);
- name = build_string (namebuf);
+ name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count);
}
else
{
error ("Frame names of the form F<num> are usurped by Emacs");
}
- f->name = name;
+ fset_name (f, name);
update_mode_lines = 1;
}
for (; CONSP (val); val = XCDR (val))
if (!NILP (Fbuffer_live_p (XCAR (val))))
list = Fcons (XCAR (val), list);
- f->buffer_list = Fnreverse (list);
+ fset_buffer_list (f, Fnreverse (list));
return;
}
if (EQ (prop, Qburied_buffer_list))
for (; CONSP (val); val = XCDR (val))
if (!NILP (Fbuffer_live_p (XCAR (val))))
list = Fcons (XCAR (val), list);
- f->buried_buffer_list = Fnreverse (list);
+ fset_buried_buffer_list (f, Fnreverse (list));
return;
}
case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
case SYMBOL_LOCALIZED:
{ struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
- if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
+ if (blv->frame_local && blv_found (blv) && XFRAME (blv->where) == f)
swap_in_global_binding (sym);
break;
}
- default: abort ();
+ default: emacs_abort ();
}
}
/* Update the frame parameter alist. */
old_alist_elt = Fassq (prop, f->param_alist);
if (EQ (old_alist_elt, Qnil))
- f->param_alist = Fcons (Fcons (prop, val), f->param_alist);
+ fset_param_alist (f, Fcons (Fcons (prop, val), f->param_alist));
else
Fsetcdr (old_alist_elt, val);
in addition to the alist. */
if (EQ (prop, Qbuffer_predicate))
- f->buffer_predicate = val;
+ fset_buffer_predicate (f, val);
if (! FRAME_WINDOW_P (f))
{
error ("Can't change the surrogate minibuffer of a frame with its own minibuffer");
/* Install the chosen minibuffer window, with proper buffer. */
- f->minibuffer_window = val;
+ fset_minibuffer_window (f, val);
}
}
: FRAME_MINIBUF_WINDOW (f)));
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, XFRAME (frame)->buried_buffer_list);
+ store_in_alist (&alist, Qburied_buffer_list,
+ XFRAME (frame)->buried_buffer_list);
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
if (STRINGP (value) && !FRAME_WINDOW_P (f))
{
const char *color_name;
- EMACS_INT csz;
+ ptrdiff_t csz;
if (EQ (parameter, Qbackground_color))
{
#endif
{
- int length = XINT (Flength (alist));
- int i;
- Lisp_Object *parms
- = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
- Lisp_Object *values
- = (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
+ EMACS_INT length = XFASTINT (Flength (alist));
+ ptrdiff_t i;
+ Lisp_Object *parms;
+ Lisp_Object *values;
+ USE_SAFE_ALLOCA;
+ SAFE_ALLOCA_LISP (parms, 2 * length);
+ values = parms + length;
/* Extract parm names and values into those vectors. */
|| EQ (prop, Qbackground_color))
update_face_from_frame_parameter (f, prop, val);
}
+
+ SAFE_FREE ();
}
return Qnil;
}
In a graphical version with no toolkit, it includes both the tool bar
and menu bar.
-For a text-only terminal, it includes the menu bar. In this case, the
+For a text terminal, it includes the menu bar. In this case, the
result is really in characters rather than pixels (i.e., is identical
to `frame-height'). */)
(Lisp_Object frame)
used. */)
(Lisp_Object frame)
{
- struct frame *f;
-
if (NILP (frame))
frame = selected_frame;
CHECK_FRAME (frame);
- f = XFRAME (frame);
#ifdef FRAME_TOOLBAR_WIDTH
- if (FRAME_WINDOW_P (f))
- return make_number (FRAME_TOOLBAR_WIDTH (f));
+ if (FRAME_WINDOW_P (XFRAME (frame)))
+ return make_number (FRAME_TOOLBAR_WIDTH (XFRAME (frame)));
#endif
return make_number (0);
}
{
register struct frame *f;
- CHECK_NUMBER (lines);
+ CHECK_TYPE_RANGED_INTEGER (int, lines);
if (NILP (frame))
frame = selected_frame;
CHECK_LIVE_FRAME (frame);
(Lisp_Object frame, Lisp_Object cols, Lisp_Object pretend)
{
register struct frame *f;
- CHECK_NUMBER (cols);
+ CHECK_TYPE_RANGED_INTEGER (int, cols);
if (NILP (frame))
frame = selected_frame;
CHECK_LIVE_FRAME (frame);
register struct frame *f;
CHECK_LIVE_FRAME (frame);
- CHECK_NUMBER (cols);
- CHECK_NUMBER (rows);
+ CHECK_TYPE_RANGED_INTEGER (int, cols);
+ CHECK_TYPE_RANGED_INTEGER (int, rows);
f = XFRAME (frame);
/* I think this should be done with a hook. */
register struct frame *f;
CHECK_LIVE_FRAME (frame);
- CHECK_NUMBER (xoffset);
- CHECK_NUMBER (yoffset);
+ CHECK_TYPE_RANGED_INTEGER (int, xoffset);
+ CHECK_TYPE_RANGED_INTEGER (int, yoffset);
f = XFRAME (frame);
/* I think this should be done with a hook. */
struct gcpro gcpro1, gcpro2;
i = 0;
- for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+ for (tail = alist; CONSP (tail); tail = XCDR (tail))
i++;
- parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
- values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
+ parms = alloca (i * sizeof *parms);
+ values = alloca (i * sizeof *values);
/* Extract parm names and values into those vectors. */
prop = parms[i];
val = values[i];
- if (EQ (prop, Qwidth) && NATNUMP (val))
+ if (EQ (prop, Qwidth) && RANGED_INTEGERP (0, val, INT_MAX))
{
size_changed = 1;
width = XFASTINT (val);
}
- else if (EQ (prop, Qheight) && NATNUMP (val))
+ else if (EQ (prop, Qheight) && RANGED_INTEGERP (0, val, INT_MAX))
{
size_changed = 1;
height = XFASTINT (val);
}
/* If one of the icon positions was not set, preserve or default it. */
- if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
+ if (! TYPE_RANGED_INTEGERP (int, icon_left))
{
icon_left_no_change = 1;
icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
if (NILP (icon_left))
XSETINT (icon_left, 0);
}
- if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
+ if (! TYPE_RANGED_INTEGERP (int, icon_top))
{
icon_top_no_change = 1;
icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
actually a pointer. Explicit casting avoids compiler
warnings. */
w = (unsigned long) FRAME_X_WINDOW (f);
- sprintf (buf, "%lu", w);
store_in_alist (alistptr, Qwindow_id,
- build_string (buf));
+ make_formatted_string (buf, "%lu", w));
#ifdef HAVE_X_WINDOWS
#ifdef USE_X_TOOLKIT
/* Tooltip frame may not have this widget. */
if (FRAME_X_OUTPUT (f)->widget)
#endif
- {
- w = (unsigned long) FRAME_OUTER_WINDOW (f);
- sprintf (buf, "%lu", w);
- }
+ w = (unsigned long) FRAME_OUTER_WINDOW (f);
store_in_alist (alistptr, Qouter_window_id,
- build_string (buf));
+ make_formatted_string (buf, "%lu", w));
#endif
store_in_alist (alistptr, Qicon_name, f->icon_name);
FRAME_SAMPLE_VISIBILITY (f);
{
if (NILP (new_value))
f->extra_line_spacing = 0;
- else if (NATNUMP (new_value))
+ else if (RANGED_INTEGERP (0, new_value, INT_MAX))
f->extra_line_spacing = XFASTINT (new_value);
else
signal_error ("Invalid line-spacing", new_value);
void
x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- Lisp_Object font_object, font_param = Qnil;
+ Lisp_Object font_object;
int fontset = -1;
+#ifdef HAVE_X_WINDOWS
+ Lisp_Object font_param = arg;
+#endif
/* Set the frame parameter back to the old value because we may
fail to use ARG as the new parameter value. */
never fail. */
if (STRINGP (arg))
{
- font_param = arg;
fontset = fs_query_fontset (arg, 0);
if (fontset < 0)
{
- font_object = font_open_by_name (f, SSDATA (arg));
+ font_object = font_open_by_name (f, arg);
if (NILP (font_object))
error ("Font `%s' is not defined", SSDATA (arg));
arg = AREF (font_object, FONT_NAME_INDEX);
}
else if (fontset > 0)
{
- Lisp_Object ascii_font = fontset_ascii (fontset);
-
- font_object = font_open_by_name (f, SSDATA (ascii_font));
+ font_object = font_open_by_name (f, fontset_ascii (fontset));
if (NILP (font_object))
error ("Font `%s' is not defined", SDATA (arg));
arg = AREF (font_object, FONT_NAME_INDEX);
error ("Unknown fontset: %s", SDATA (XCAR (arg)));
font_object = XCDR (arg);
arg = AREF (font_object, FONT_NAME_INDEX);
+#ifdef HAVE_X_WINDOWS
font_param = Ffont_get (font_object, QCname);
+#endif
}
else if (FONT_OBJECT_P (arg))
{
font_object = arg;
+#ifdef HAVE_X_WINDOWS
font_param = Ffont_get (font_object, QCname);
+#endif
/* This is to store the XLFD font name in the frame parameter for
backward compatibility. We should store the font-object
itself in the future. */
new_value = Qnil;
while (*p0)
{
- while (*p1 && ! isspace (*p1) && *p1 != ',') p1++;
+ while (*p1 && ! c_isspace (*p1) && *p1 != ',') p1++;
if (p0 < p1)
new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
new_value);
{
int c;
- while ((c = *++p1) && isspace (c));
+ while ((c = *++p1) && c_isspace (c));
}
p0 = p1;
}
void
x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- CHECK_NUMBER (arg);
+ CHECK_TYPE_RANGED_INTEGER (int, arg);
if (XINT (arg) == f->border_width)
return;
{
int old = FRAME_INTERNAL_BORDER_WIDTH (f);
- CHECK_NUMBER (arg);
+ CHECK_TYPE_RANGED_INTEGER (int, arg);
FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
f->alpha[i] = newval[i];
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA)
- BLOCK_INPUT;
+ block_input ();
x_set_frame_alpha (f);
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
return;
/* Allocate space for the components, the dots which separate them,
and the final '\0'. Make them big enough for the worst case. */
- name_key = (char *) alloca (SBYTES (Vx_resource_name)
- + (STRINGP (component)
- ? SBYTES (component) : 0)
- + SBYTES (attribute)
- + 3);
-
- class_key = (char *) alloca (SBYTES (Vx_resource_class)
- + SBYTES (class)
- + (STRINGP (subclass)
- ? SBYTES (subclass) : 0)
- + 3);
+ name_key = alloca (SBYTES (Vx_resource_name)
+ + (STRINGP (component)
+ ? SBYTES (component) : 0)
+ + SBYTES (attribute)
+ + 3);
+
+ class_key = alloca (SBYTES (Vx_resource_class)
+ + SBYTES (class)
+ + (STRINGP (subclass)
+ ? SBYTES (subclass) : 0)
+ + 3);
/* Start with emacs.FRAMENAME for the name (the specific one)
and with `Emacs' for the class key (the general one). */
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);
/* 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 = (char *) 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);
}
default:
- abort ();
+ emacs_abort ();
}
}
else
}
+#if !defined (HAVE_X_WINDOWS) && defined (NoValue)
+
+/*
+ * XParseGeometry parses strings of the form
+ * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
+ * width, height, xoffset, and yoffset are unsigned integers.
+ * Example: "=80x24+300-49"
+ * The equal sign is optional.
+ * It returns a bitmask that indicates which of the four values
+ * were actually found in the string. For each value found,
+ * the corresponding argument is updated; for each value
+ * not found, the corresponding argument is left unchanged.
+ */
+
+static int
+XParseGeometry (char *string,
+ int *x, int *y,
+ unsigned int *width, unsigned int *height)
+{
+ int mask = NoValue;
+ char *strind;
+ unsigned long int tempWidth, tempHeight;
+ long int tempX, tempY;
+ char *nextCharacter;
+
+ if (string == NULL || *string == '\0')
+ return mask;
+ if (*string == '=')
+ string++; /* ignore possible '=' at beg of geometry spec */
+
+ strind = string;
+ if (*strind != '+' && *strind != '-' && *strind != 'x')
+ {
+ tempWidth = strtoul (strind, &nextCharacter, 10);
+ if (strind == nextCharacter)
+ return 0;
+ strind = nextCharacter;
+ mask |= WidthValue;
+ }
+
+ if (*strind == 'x' || *strind == 'X')
+ {
+ strind++;
+ tempHeight = strtoul (strind, &nextCharacter, 10);
+ if (strind == nextCharacter)
+ return 0;
+ strind = nextCharacter;
+ mask |= HeightValue;
+ }
+
+ if (*strind == '+' || *strind == '-')
+ {
+ if (*strind == '-')
+ mask |= XNegative;
+ tempX = strtol (strind, &nextCharacter, 10);
+ if (strind == nextCharacter)
+ return 0;
+ strind = nextCharacter;
+ mask |= XValue;
+ if (*strind == '+' || *strind == '-')
+ {
+ if (*strind == '-')
+ mask |= YNegative;
+ tempY = strtol (strind, &nextCharacter, 10);
+ if (strind == nextCharacter)
+ return 0;
+ strind = nextCharacter;
+ mask |= YValue;
+ }
+ }
+
+ /* If strind isn't at the end of the string then it's an invalid
+ geometry specification. */
+
+ if (*strind != '\0')
+ return 0;
+
+ if (mask & XValue)
+ *x = clip_to_bounds (INT_MIN, tempX, INT_MAX);
+ if (mask & YValue)
+ *y = clip_to_bounds (INT_MIN, tempY, INT_MAX);
+ if (mask & WidthValue)
+ *width = min (tempWidth, UINT_MAX);
+ if (mask & HeightValue)
+ *height = min (tempHeight, UINT_MAX);
+ return mask;
+}
+
+#endif /* !defined (HAVE_X_WINDOWS) && defined (NoValue) */
\f
/* NS used to define x-parse-geometry in ns-win.el, but that confused
On Nextstep, this just calls `ns-parse-geometry'. */)
(Lisp_Object string)
{
-#ifdef HAVE_NS
- call1 (Qns_parse_geometry, string);
-#else
int geometry, x, y;
unsigned int width, height;
Lisp_Object result;
CHECK_STRING (string);
+#ifdef HAVE_NS
+ if (strchr (SSDATA (string), ' ') != NULL)
+ return call1 (Qns_parse_geometry, string);
+#endif
geometry = XParseGeometry (SSDATA (string),
&x, &y, &width, &height);
result = Qnil;
result = Fcons (Fcons (Qheight, make_number (height)), result);
return result;
-#endif /* HAVE_NS */
}
f->top_pos = 0;
else
{
- CHECK_NUMBER (tem0);
+ CHECK_TYPE_RANGED_INTEGER (int, tem0);
f->top_pos = XINT (tem0);
if (f->top_pos < 0)
window_prompting |= YNegative;
f->left_pos = 0;
else
{
- CHECK_NUMBER (tem1);
+ CHECK_TYPE_RANGED_INTEGER (int, tem1);
f->left_pos = XINT (tem1);
if (f->left_pos < 0)
window_prompting |= XNegative;
DEFSYM (Qminibuffer, "minibuffer");
DEFSYM (Qmodeline, "modeline");
DEFSYM (Qonly, "only");
+ DEFSYM (Qnone, "none");
DEFSYM (Qwidth, "width");
DEFSYM (Qgeometry, "geometry");
DEFSYM (Qicon_left, "icon-left");
DEFSYM (Qx, "x");
DEFSYM (Qw32, "w32");
DEFSYM (Qpc, "pc");
- DEFSYM (Qmac, "mac");
DEFSYM (Qns, "ns");
DEFSYM (Qvisible, "visible");
DEFSYM (Qbuffer_predicate, "buffer-predicate");
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'.
#include "dispextern.h"
+INLINE_HEADER_BEGIN
+#ifndef FRAME_INLINE
+# define FRAME_INLINE INLINE
+#endif
+
\f
/* Miscellanea. */
/* Nonzero means there is at least one garbaged frame. */
-extern int frame_garbaged;
+extern bool frame_garbaged;
\f
/* The structure representing a frame. */
#define FRAME_FOREGROUND_PIXEL(f) ((f)->foreground_pixel)
#define FRAME_BACKGROUND_PIXEL(f) ((f)->background_pixel)
-struct terminal;
-
-struct font_driver_list;
struct frame
{
Lisp_Object tool_bar_position;
/* Desired and current contents displayed in tool_bar_window. */
- Lisp_Object desired_tool_bar_string, 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. */
struct x_output *x; /* xterm.h */
struct w32_output *w32; /* w32term.h */
struct ns_output *ns; /* nsterm.h */
- EMACS_INT nothing;
+ intptr_t nothing;
}
output_data;
#endif
/* Nonzero if last attempt at redisplay on this frame was preempted. */
- unsigned char display_preempted : 1;
+ unsigned display_preempted : 1;
/* visible is nonzero if the frame is currently displayed; we check
it to see if we should bother updating the frame's contents.
These two are mutually exclusive. They might both be zero, if the
frame has been made invisible without an icon. */
- unsigned char visible : 2;
- unsigned char iconified : 1;
+ unsigned visible : 2;
+ unsigned iconified : 1;
/* Let's not use bitfields for volatile variables. */
/* True if frame actually has a minibuffer window on it.
0 if using a minibuffer window that isn't on this frame. */
- unsigned char has_minibuffer : 1;
+ unsigned has_minibuffer : 1;
/* 0 means, if this frame has just one window,
show no modeline for that window. */
- unsigned char wants_modeline : 1;
+ unsigned wants_modeline : 1;
/* Non-zero if the hardware device this frame is displaying on can
support scroll bars. */
char can_have_scroll_bars;
/* Non-0 means raise this frame to the top of the heap when selected. */
- unsigned char auto_raise : 1;
+ unsigned auto_raise : 1;
/* Non-0 means lower this frame to the bottom of the stack when left. */
- unsigned char auto_lower : 1;
+ unsigned auto_lower : 1;
/* True if frame's root window can't be split. */
- unsigned char no_split : 1;
+ unsigned no_split : 1;
/* If this is set, then Emacs won't change the frame name to indicate
the current buffer, etcetera. If the user explicitly sets the frame
name, this gets set. If the user sets the name to Qnil, this is
cleared. */
- unsigned char explicit_name : 1;
+ unsigned explicit_name : 1;
/* Nonzero if size of some window on this frame has changed. */
- unsigned char window_sizes_changed : 1;
+ unsigned window_sizes_changed : 1;
/* Nonzero if the mouse has moved on this display device
since the last time we checked. */
- unsigned char mouse_moved :1;
+ unsigned mouse_moved :1;
/* Nonzero means that the pointer is invisible. */
- unsigned char pointer_invisible :1;
+ unsigned pointer_invisible :1;
/* If can_have_scroll_bars is non-zero, this is non-zero if we should
actually display them on this frame. */
unsigned long foreground_pixel;
};
+/* Most code should use these functions to set Lisp fields in struct frame. */
+
+FRAME_INLINE void
+fset_buffer_list (struct frame *f, Lisp_Object val)
+{
+ f->buffer_list = val;
+}
+FRAME_INLINE void
+fset_buried_buffer_list (struct frame *f, Lisp_Object val)
+{
+ f->buried_buffer_list = val;
+}
+FRAME_INLINE void
+fset_condemned_scroll_bars (struct frame *f, Lisp_Object val)
+{
+ f->condemned_scroll_bars = val;
+}
+FRAME_INLINE void
+fset_current_tool_bar_string (struct frame *f, Lisp_Object val)
+{
+ f->current_tool_bar_string = val;
+}
+FRAME_INLINE void
+fset_desired_tool_bar_string (struct frame *f, Lisp_Object val)
+{
+ f->desired_tool_bar_string = val;
+}
+FRAME_INLINE void
+fset_face_alist (struct frame *f, Lisp_Object val)
+{
+ f->face_alist = val;
+}
+FRAME_INLINE void
+fset_focus_frame (struct frame *f, Lisp_Object val)
+{
+ f->focus_frame = val;
+}
+FRAME_INLINE void
+fset_icon_name (struct frame *f, Lisp_Object val)
+{
+ f->icon_name = val;
+}
+FRAME_INLINE void
+fset_menu_bar_items (struct frame *f, Lisp_Object val)
+{
+ f->menu_bar_items = val;
+}
+FRAME_INLINE void
+fset_menu_bar_vector (struct frame *f, Lisp_Object val)
+{
+ f->menu_bar_vector = val;
+}
+FRAME_INLINE void
+fset_menu_bar_window (struct frame *f, Lisp_Object val)
+{
+ f->menu_bar_window = val;
+}
+FRAME_INLINE void
+fset_name (struct frame *f, Lisp_Object val)
+{
+ f->name = val;
+}
+FRAME_INLINE void
+fset_param_alist (struct frame *f, Lisp_Object val)
+{
+ f->param_alist = val;
+}
+FRAME_INLINE void
+fset_root_window (struct frame *f, Lisp_Object val)
+{
+ f->root_window = val;
+}
+FRAME_INLINE void
+fset_scroll_bars (struct frame *f, Lisp_Object val)
+{
+ f->scroll_bars = val;
+}
+FRAME_INLINE void
+fset_selected_window (struct frame *f, Lisp_Object val)
+{
+ f->selected_window = val;
+}
+FRAME_INLINE void
+fset_title (struct frame *f, Lisp_Object val)
+{
+ f->title = val;
+}
+FRAME_INLINE void
+fset_tool_bar_items (struct frame *f, Lisp_Object val)
+{
+ f->tool_bar_items = val;
+}
+FRAME_INLINE void
+fset_tool_bar_position (struct frame *f, Lisp_Object val)
+{
+ f->tool_bar_position = val;
+}
+FRAME_INLINE void
+fset_tool_bar_window (struct frame *f, Lisp_Object val)
+{
+ f->tool_bar_window = val;
+}
+
#define FRAME_KBOARD(f) ((f)->terminal->kboard)
/* Return a pointer to the image cache of frame F. */
typedef struct frame *FRAME_PTR;
-#define XFRAME(p) (eassert (FRAMEP(p)),(struct frame *) XPNTR (p))
+#define XFRAME(p) \
+ (eassert (FRAMEP (p)), (struct frame *) XUNTAG (p, Lisp_Vectorlike))
#define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME))
/* Given a window, return its frame as a Lisp_Object. */
-#define WINDOW_FRAME(w) (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)
#define FRAME_TERMCAP_P(f) ((f)->output_method == output_termcap)
#define FRAME_X_P(f) ((f)->output_method == output_x_window)
+#ifndef WINDOWSNT
+#define FRAME_W32_P(f) (0)
+#else
#define FRAME_W32_P(f) ((f)->output_method == output_w32)
+#endif
+#ifndef MSDOS
+#define FRAME_MSDOS_P(f) (0)
+#else
#define FRAME_MSDOS_P(f) ((f)->output_method == output_msdos_raw)
-#define FRAME_MAC_P(f) ((f)->output_method == output_mac)
+#endif
+#ifndef HAVE_NS
+#define FRAME_NS_P(f) (0)
+#else
#define FRAME_NS_P(f) ((f)->output_method == output_ns)
-
+#endif
/* FRAME_WINDOW_P tests whether the frame is a window, and is
defined to be the predicate for the window system being used. */
#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) (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) (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) (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
#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) (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
/* Nonzero if frame F has scroll bars. */
-#define FRAME_SCROLL_BARS(f) ((f)->scroll_bars)
+#define FRAME_SCROLL_BARS(f) (f->scroll_bars)
-#define FRAME_CONDEMNED_SCROLL_BARS(f) ((f)->condemned_scroll_bars)
-#define FRAME_MENU_BAR_ITEMS(f) ((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)
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))
((FRAMEP (selected_frame) \
&& FRAME_LIVE_P (XFRAME (selected_frame))) \
? XFRAME (selected_frame) \
- : (abort (), (struct frame *) 0))
+ : (emacs_abort (), (struct frame *) 0))
\f
/***********************************************************************
extern void x_set_scroll_bar_default_width (struct frame *);
extern void x_set_offset (struct frame *, int, int, int);
extern void x_wm_set_icon_position (struct frame *, int, int);
+extern void x_wm_set_size_hint (FRAME_PTR f, long flags, bool user_position);
extern Lisp_Object x_new_font (struct frame *, Lisp_Object, int);
Lisp_Object component,
Lisp_Object subclass);
+extern void set_frame_menubar (struct frame *f, bool first_time, bool deep_p);
+extern void x_set_window_size (struct frame *f, int change_grav,
+ int cols, int rows);
+extern void x_sync (struct frame *);
+extern Lisp_Object x_get_focus_frame (struct frame *);
+extern void x_set_mouse_position (struct frame *f, int h, int v);
+extern void x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y);
+extern void x_make_frame_visible (struct frame *f);
+extern void x_make_frame_invisible (struct frame *f);
+extern void x_iconify_frame (struct frame *f);
+extern int x_char_width (struct frame *f);
+extern int x_char_height (struct frame *f);
+extern int x_pixel_width (struct frame *f);
+extern int x_pixel_height (struct frame *f);
+extern void x_set_frame_alpha (struct frame *f);
+extern void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
+extern void x_set_tool_bar_lines (struct frame *f,
+ Lisp_Object value,
+ Lisp_Object oldval);
+extern void x_activate_menubar (struct frame *);
+extern void x_real_positions (struct frame *, int *, int *);
+extern int x_bitmap_icon (struct frame *, Lisp_Object);
+extern void x_set_menu_bar_lines (struct frame *,
+ Lisp_Object,
+ Lisp_Object);
+extern void free_frame_menubar (struct frame *);
+extern void x_free_frame_resources (struct frame *);
+
#if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
extern char *x_get_resource_string (const char *, const char *);
#endif
-/* In xmenu.c */
-extern void set_frame_menubar (FRAME_PTR, int, int);
+extern void x_query_colors (struct frame *f, XColor *, int);
#endif /* HAVE_WINDOW_SYSTEM */
+INLINE_HEADER_END
+
#endif /* not EMACS_FRAME_H */
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "frame.h"
#include "window.h"
#include "dispextern.h"
+#include "character.h"
#include "buffer.h"
#include "blockinput.h"
#include "termhooks.h"
static unsigned short question_mark_bits[] = {
0x3c, 0x7e, 0x7e, 0x0c, 0x18, 0x18, 0x00, 0x18, 0x18};
+/* An exclamation mark. */
+/*
+ ...XX...
+ ...XX...
+ ...XX...
+ ...XX...
+ ...XX...
+ ...XX...
+ ...XX...
+ ........
+ ...XX...
+ ...XX...
+*/
+static unsigned short exclamation_mark_bits[] = {
+ 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x00, 0x18};
+
/* An arrow like this: `<-'. */
/*
...xx...
{
{ NULL, 0, 0, 0, 0, 0 }, /* NO_FRINGE_BITMAP */
{ FRBITS (question_mark_bits), 8, 0, ALIGN_BITMAP_CENTER, 0 },
+ { FRBITS (exclamation_mark_bits), 8, 0, ALIGN_BITMAP_CENTER, 0 },
{ FRBITS (left_arrow_bits), 8, 0, ALIGN_BITMAP_CENTER, 0 },
{ FRBITS (right_arrow_bits), 8, 0, ALIGN_BITMAP_CENTER, 0 },
{ FRBITS (up_arrow_bits), 8, 0, ALIGN_BITMAP_TOP, 0 },
int
lookup_fringe_bitmap (Lisp_Object bitmap)
{
- int bn;
+ EMACS_INT bn;
bitmap = Fget (bitmap, Qfringe);
if (!INTEGERP (bitmap))
{
/* If W has a vertical border to its left, don't draw over it. */
wd -= ((!WINDOW_LEFTMOST_P (w)
- && !WINDOW_HAS_VERTICAL_SCROLL_BAR (w))
+ && !WINDOW_HAS_VERTICAL_SCROLL_BAR (w)
+ /* But don't reduce the fringe width if the window
+ has a left margin, because that means we are not
+ in danger of drawing over the vertical border,
+ and OTOH leaving out that one pixel leaves behind
+ traces of the cursor, if it was in column zero
+ before drawing non-empty margin area. */
+ && NILP (w->left_margin_cols))
? 1 : 0);
p.bx = x - wd;
p.nx = wd;
get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, int partial_p)
{
Lisp_Object cmap, bm1 = Qnil, bm2 = Qnil, bm;
- int ln1 = 0, ln2 = 0;
+ EMACS_INT ln1 = 0, ln2 = 0;
int ix1 = right_p;
int ix2 = ix1 + (partial_p ? 2 : 0);
void
draw_row_fringe_bitmaps (struct window *w, struct glyph_row *row)
{
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
/* If row is completely invisible, because of vscrolling, we
don't have to draw anything. */
else
{
CHECK_NUMBER (height);
- fb.height = min (XINT (height), 255);
+ fb.height = max (0, min (XINT (height), 255));
if (fb.height > h)
{
fill1 = (fb.height - h) / 2;
else
{
CHECK_NUMBER (width);
- fb.width = min (XINT (width), 255);
+ fb.width = max (0, min (XINT (width), 255));
}
fb.period = 0;
error ("No free fringe bitmap slots");
i = max_fringe_bitmaps;
- fringe_bitmaps
- = ((struct fringe_bitmap **)
- xrealloc (fringe_bitmaps, bitmaps * sizeof *fringe_bitmaps));
- fringe_faces
- = (Lisp_Object *) xrealloc (fringe_faces,
- bitmaps * sizeof *fringe_faces);
+ fringe_bitmaps = xrealloc (fringe_bitmaps,
+ bitmaps * sizeof *fringe_bitmaps);
+ fringe_faces = xrealloc (fringe_faces,
+ bitmaps * sizeof *fringe_faces);
for (i = max_fringe_bitmaps; i < bitmaps; i++)
{
fb.dynamic = 1;
- xfb = (struct fringe_bitmap *) xmalloc (sizeof fb
- + fb.height * BYTES_PER_BITMAP_ROW);
+ xfb = xmalloc (sizeof fb + fb.height * BYTES_PER_BITMAP_ROW);
fb.bits = b = (unsigned short *) (xfb + 1);
memset (b, 0, fb.height);
(Lisp_Object bitmap, Lisp_Object face)
{
int n;
- int face_id;
CHECK_SYMBOL (bitmap);
n = lookup_fringe_bitmap (bitmap);
if (!n)
error ("Undefined fringe bitmap");
+ /* The purpose of the following code is to signal an error if FACE
+ is not a face. This is for the caller's convenience only; the
+ redisplay code should be able to fail gracefully. Skip the check
+ if FRINGE_FACE_ID is unrealized (as in batch mode and during
+ daemon startup). */
if (!NILP (face))
{
- face_id = lookup_derived_face (SELECTED_FRAME (), face,
- FRINGE_FACE_ID, 1);
- if (face_id < 0)
+ struct frame *f = SELECTED_FRAME ();
+
+ if (FACE_FROM_ID (f, FRINGE_FACE_ID)
+ && lookup_derived_face (f, face, FRINGE_FACE_ID, 1) < 0)
error ("No such face");
}
fringe_faces[n] = face;
-
return Qnil;
}
{
struct window *w;
struct glyph_row *row;
- int textpos;
+ ptrdiff_t textpos;
if (NILP (window))
window = selected_window;
if (!NILP (pos))
{
CHECK_NUMBER_COERCE_MARKER (pos);
+ if (! (BEGV <= XINT (pos) && XINT (pos) <= ZV))
+ args_out_of_range (window, pos);
textpos = XINT (pos);
}
else if (w == XWINDOW (selected_window))
defsubr (&Sset_fringe_bitmap_face);
DEFVAR_LISP ("overflow-newline-into-fringe", Voverflow_newline_into_fringe,
- doc: /* *Non-nil means that newline may flow into the right fringe.
+ doc: /* Non-nil means that newline may flow into the right fringe.
This means that display lines which are exactly as wide as the window
(not counting the final newline) will only occupy one screen line, by
showing (or hiding) the final newline in the right fringe; when point
max_fringe_bitmaps = MAX_STANDARD_FRINGE_BITMAPS + 20;
- fringe_bitmaps
- = (struct fringe_bitmap **) xmalloc (max_fringe_bitmaps * sizeof (struct fringe_bitmap *));
- fringe_faces
- = (Lisp_Object *) xmalloc (max_fringe_bitmaps * sizeof (Lisp_Object));
+ fringe_bitmaps = xzalloc (max_fringe_bitmaps * sizeof *fringe_bitmaps);
+ fringe_faces = xmalloc (max_fringe_bitmaps * sizeof *fringe_faces);
for (i = 0; i < max_fringe_bitmaps; i++)
- {
- fringe_bitmaps[i] = NULL;
- fringe_faces[i] = Qnil;
- }
+ fringe_faces[i] = Qnil;
}
#ifdef HAVE_NTGUI
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
-
#include <fontconfig/fontconfig.h>
#include <fontconfig/fcfreetype.h>
static Lisp_Object Qmonospace, Qsans_serif, Qserif, Qmono, Qsans, Qsans__serif;
/* Flag to tell if FcInit is already called or not. */
-static int fc_initialized;
+static bool fc_initialized;
/* Handle to a FreeType library instance. */
static FT_Library ft_library;
#ifdef HAVE_LIBOTF
/* The following four members must be here in this order to be
compatible with struct xftfont_info (in xftfont.c). */
- int maybe_otf; /* Flag to tell if this may be OTF or not. */
+ bool maybe_otf; /* Flag to tell if this may be OTF or not. */
OTF *otf;
#endif /* HAVE_LIBOTF */
FT_Size ft_size;
return Qnil;
file = (char *) str;
- key = Fcons (make_unibyte_string (file, strlen (file)), make_number (idx));
+ key = Fcons (build_unibyte_string (file), make_number (idx));
cache = ftfont_lookup_cache (key, FTFONT_CACHE_FOR_ENTITY);
entity = XCAR (cache);
if (! NILP (entity))
{
entity = key;
val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX));
- xassert (CONSP (val));
+ eassert (CONSP (val));
key = XCDR (val);
}
else
args[1] = Qequal;
ft_face_cache = Fmake_hash_table (2, args);
}
- cache_data = xmalloc (sizeof (struct ftfont_cache_data));
+ cache_data = xmalloc (sizeof *cache_data);
cache_data->ft_face = NULL;
cache_data->fc_charset = NULL;
val = make_save_value (NULL, 0);
struct font_driver ftfont_driver =
{
- 0, /* Qfreetype */
+ LISP_INITIALLY_ZERO, /* Qfreetype */
0, /* case insensitive */
ftfont_get_cache,
ftfont_list,
/* We can't draw a text without device dependent functions. */
NULL, /* draw */
ftfont_get_bitmap,
- NULL, /* get_bitmap */
NULL, /* free_bitmap */
NULL, /* get_outline */
+ NULL, /* free_outline */
ftfont_anchor_point,
#ifdef HAVE_LIBOTF
ftfont_otf_capability,
re[j] = '\0';
regexp = make_unibyte_string (re, j);
for (i = 0; fc_charset_table[i].name; i++)
- if (fast_c_string_match_ignore_case (regexp, fc_charset_table[i].name) >= 0)
+ if (fast_c_string_match_ignore_case
+ (regexp, fc_charset_table[i].name,
+ strlen (fc_charset_table[i].name)) >= 0)
break;
if (! fc_charset_table[i].name)
return -1;
static struct OpenTypeSpec *
ftfont_get_open_type_spec (Lisp_Object otf_spec)
{
- struct OpenTypeSpec *spec = malloc (sizeof (struct OpenTypeSpec));
+ struct OpenTypeSpec *spec = malloc (sizeof *spec);
Lisp_Object val;
- int i, j, negative;
+ int i, j;
+ bool negative;
if (! spec)
return NULL;
spec->features[i] =
(min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XINT (len)
? 0
- : malloc (sizeof (int) * XINT (len)));
+ : malloc (XINT (len) * sizeof *spec->features[i]));
if (! spec->features[i])
{
if (i > 0 && spec->features[0])
#endif /* HAVE_LIBOTF */
if (VECTORP (chars))
{
- int j;
+ ptrdiff_t j;
if (FcPatternGetCharSet (fontset->fonts[i], FC_CHARSET, 0, &charset)
!= FcResultMatch)
continue;
for (j = 0; j < ASIZE (chars); j++)
- if (NATNUMP (AREF (chars, j))
+ if (TYPE_RANGED_INTEGERP (FcChar32, AREF (chars, j))
&& FcCharSetHasChar (charset, XFASTINT (AREF (chars, j))))
break;
if (j == ASIZE (chars))
FT_Size ft_size;
FT_UInt size;
Lisp_Object val, filename, idx, cache, font_object;
- int scalable;
+ bool scalable;
int spacing;
char name[256];
int i, len;
ftfont_info->ft_size = ft_face->size;
ftfont_info->index = XINT (idx);
#ifdef HAVE_LIBOTF
- ftfont_info->maybe_otf = ft_face->face_flags & FT_FACE_FLAG_SFNT;
+ ftfont_info->maybe_otf = (ft_face->face_flags & FT_FACE_FLAG_SFNT) != 0;
ftfont_info->otf = NULL;
#endif /* HAVE_LIBOTF */
/* This means that there's no need of transformation. */
val = Fcons (font->props[FONT_FILE_INDEX], make_number (ftfont_info->index));
cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE);
- xassert (CONSP (cache));
+ eassert (CONSP (cache));
val = XCDR (cache);
(XSAVE_VALUE (val)->integer)--;
if (XSAVE_VALUE (val)->integer == 0)
struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
FT_Face ft_face = ftfont_info->ft_size->face;
int width = 0;
- int i, first;
+ int i;
+ bool first;
if (ftfont_info->ft_size != ft_face->size)
FT_Activate_Size (ftfont_info->ft_size);
FT_Glyph_Metrics *m;
if (FT_Load_Glyph (ft_face, g->code, FT_LOAD_DEFAULT) != 0)
- abort ();
+ emacs_abort ();
m = &ft_face->glyph->metrics;
if (flt_font_ft->matrix)
{
struct MFLTFontFT *flt_font_ft = (struct MFLTFontFT *) font;
OTF *otf = flt_font_ft->otf;
OTF_Tag *tags;
- int i, n, negative;
+ int i, n;
+ bool negative;
if (FEATURE_ANY (0) && FEATURE_ANY (1))
- /* Return 1 iff any of GSUB or GPOS support the script (and language). */
+ /* Return true iff any of GSUB or GPOS support the script (and
+ language). */
return (otf
&& (OTF_check_features (otf, 0, spec->script, spec->langsys,
NULL, 0) > 0
static MFLTGlyphString gstring;
-static int m17n_flt_initialized;
+static bool m17n_flt_initialized;
static Lisp_Object
ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
FT_Face ft_face, OTF *otf, FT_Matrix *matrix)
{
- EMACS_INT len = LGSTRING_GLYPH_LEN (lgstring);
- EMACS_INT i;
+ ptrdiff_t len = LGSTRING_GLYPH_LEN (lgstring);
+ ptrdiff_t i;
struct MFLTFontFT flt_font_ft;
MFLT *flt = NULL;
- int with_variation_selector = 0;
+ bool with_variation_selector = 0;
if (! m17n_flt_initialized)
{
break;
c = LGLYPH_CHAR (g);
if (CHAR_VARIATION_SELECTOR_P (c))
- with_variation_selector++;
+ with_variation_selector = 1;
}
len = i;
- lint_assume (len <= TYPE_MAXIMUM (EMACS_INT) - 2);
+ lint_assume (len <= STRING_BYTES_BOUND);
if (with_variation_selector)
{
if (gstring.allocated == 0)
{
gstring.glyph_size = sizeof (MFLTGlyph);
- gstring.glyphs = xnmalloc (len * 2, sizeof (MFLTGlyph));
+ gstring.glyphs = xnmalloc (len * 2, sizeof *gstring.glyphs);
gstring.allocated = len * 2;
}
else if (gstring.allocated < len * 2)
{
- gstring.glyphs = xnrealloc (gstring.glyphs, len * 2, sizeof (MFLTGlyph));
+ gstring.glyphs = xnrealloc (gstring.glyphs, len * 2,
+ sizeof *gstring.glyphs);
gstring.allocated = len * 2;
}
- memset (gstring.glyphs, 0, sizeof (MFLTGlyph) * len);
+ memset (gstring.glyphs, 0, len * sizeof *gstring.glyphs);
for (i = 0; i < len; i++)
{
Lisp_Object g = LGSTRING_GLYPH (lgstring, i);
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <X11/Xlib.h>
#include "lisp.h"
#endif
struct font_driver ftxfont_driver;
-/* Prototypes for helper function. */
-static GC *ftxfont_get_gcs (FRAME_PTR, unsigned long, unsigned long);
-static int ftxfont_draw_bitmap (FRAME_PTR, GC, GC *, struct font *,
- unsigned, int, int, XPoint *, int, int *,
- int);
-static void ftxfont_draw_background (FRAME_PTR, struct font *, GC,
- int, int, int);
-
struct ftxfont_frame_data
{
/* Background and foreground colors. */
}
}
- new = malloc (sizeof (struct ftxfont_frame_data));
+ new = malloc (sizeof *new);
if (! new)
return NULL;
new->next = this;
new->colors[0].pixel = background;
new->colors[1].pixel = foreground;
- BLOCK_INPUT;
+ block_input ();
XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), new->colors, 2);
for (i = 1; i < 7; i++)
{
new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
GCForeground, &xgcv);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (i < 7)
{
- BLOCK_INPUT;
+ block_input ();
for (i--; i >= 0; i--)
XFreeGC (FRAME_X_DISPLAY (f), new->gcs[i]);
- UNBLOCK_INPUT;
+ unblock_input ();
if (prev)
prev->next = new->next;
else if (data)
}
static int
-ftxfont_draw_bitmap (FRAME_PTR f, GC gc_fore, GC *gcs, struct font *font, unsigned int code, int x, int y, XPoint *p, int size, int *n, int flush)
+ftxfont_draw_bitmap (FRAME_PTR f, GC gc_fore, GC *gcs, struct font *font,
+ unsigned int code, int x, int y, XPoint *p, int size,
+ int *n, bool flush)
{
struct font_bitmap bitmap;
unsigned char *b;
XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground);
}
-/* Prototypes for font-driver methods. */
-static Lisp_Object ftxfont_list (Lisp_Object, Lisp_Object);
-static Lisp_Object ftxfont_match (Lisp_Object, Lisp_Object);
-static Lisp_Object ftxfont_open (FRAME_PTR, Lisp_Object, int);
-static void ftxfont_close (FRAME_PTR, struct font *);
-static int ftxfont_draw (struct glyph_string *, int, int, int, int, int);
-
static Lisp_Object
ftxfont_list (Lisp_Object frame, Lisp_Object spec)
{
}
static int
-ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
+ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y,
+ bool with_background)
{
FRAME_PTR f = s->f;
struct face *face = s->face;
n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0;
- BLOCK_INPUT;
+ block_input ();
if (with_background)
ftxfont_draw_background (f, font, s->gc, x, y, s->width);
code = alloca (sizeof (unsigned) * len);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return len;
}
{
struct ftxfont_frame_data *data = font_get_frame_data (f, &ftxfont_driver);
- BLOCK_INPUT;
+ block_input ();
while (data)
{
struct ftxfont_frame_data *next = data->next;
free (data);
data = next;
}
- UNBLOCK_INPUT;
+ unblock_input ();
font_put_frame_data (f, &ftxfont_driver, NULL);
return 0;
}
-/* This file is no longer automatically generated from libc. */
-
-#define _MALLOC_INTERNAL
-
-/* The malloc headers and source files from the C library follow here. */
-
/* Declarations for `malloc' and friends.
Copyright (C) 1990, 1991, 1992, 1993, 1995, 1996, 1999, 2002, 2003, 2004,
2005, 2006, 2007 Free Software Foundation, Inc.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_H
-
-#define _MALLOC_H 1
-
-#ifdef _MALLOC_INTERNAL
-
-#ifdef HAVE_CONFIG_H
#include <config.h>
-#endif
#ifdef HAVE_PTHREAD
#define USE_PTHREAD
#endif
-#undef PP
-#define PP(args) args
-#undef __ptr_t
-#define __ptr_t void *
-
#include <string.h>
#include <limits.h>
+#include <stdint.h>
#include <unistd.h>
#ifdef USE_PTHREAD
#include <pthread.h>
#endif
-#endif /* _MALLOC_INTERNAL. */
-
-
#ifdef __cplusplus
extern "C"
{
#endif
#include <stddef.h>
-#define __malloc_size_t size_t
-#define __malloc_ptrdiff_t ptrdiff_t
/* Allocate SIZE bytes of memory. */
-extern __ptr_t malloc PP ((__malloc_size_t __size));
+extern void *malloc (size_t size);
/* Re-allocate the previously allocated block
- in __ptr_t, making the new block SIZE bytes long. */
-extern __ptr_t realloc PP ((__ptr_t __ptr, __malloc_size_t __size));
+ in ptr, making the new block SIZE bytes long. */
+extern void *realloc (void *ptr, size_t size);
/* Allocate NMEMB elements of SIZE bytes each, all initialized to 0. */
-extern __ptr_t calloc PP ((__malloc_size_t __nmemb, __malloc_size_t __size));
+extern void *calloc (size_t nmemb, size_t size);
/* Free a block allocated by `malloc', `realloc' or `calloc'. */
-extern void free PP ((__ptr_t __ptr));
+extern void free (void *ptr);
/* Allocate SIZE bytes allocated to ALIGNMENT bytes. */
-#if !defined (_MALLOC_INTERNAL) || defined (MSDOS) /* Avoid conflict. */
-extern __ptr_t memalign PP ((__malloc_size_t __alignment,
- __malloc_size_t __size));
-extern int posix_memalign PP ((__ptr_t *, __malloc_size_t,
- __malloc_size_t size));
-#endif
-
-/* Allocate SIZE bytes on a page boundary. */
-#if ! (defined (_MALLOC_INTERNAL) && defined (GMALLOC_INHIBIT_VALLOC))
-extern __ptr_t valloc PP ((__malloc_size_t __size));
+#ifdef MSDOS
+extern void *memalign (size_t, size_t);
+extern int posix_memalign (void **, size_t, size_t);
#endif
#ifdef USE_PTHREAD
/* Set up mutexes and make malloc etc. thread-safe. */
-extern void malloc_enable_thread PP ((void));
+extern void malloc_enable_thread (void);
#endif
-#ifdef _MALLOC_INTERNAL
-
/* The allocator divides the heap into blocks of fixed size; large
requests receive one or more whole blocks, and small requests
receive a fragment of a block. Fragment sizes are powers of two,
{
struct
{
- __malloc_size_t nfree; /* Free frags in a fragmented block. */
- __malloc_size_t first; /* First free fragment of the block. */
+ size_t nfree; /* Free frags in a fragmented block. */
+ size_t first; /* First free fragment of the block. */
} frag;
/* For a large object, in its first block, this has the number
of blocks in the object. In the other blocks, this has a
negative number which says how far back the first block is. */
- __malloc_ptrdiff_t size;
+ ptrdiff_t size;
} info;
} busy;
/* Heap information for a free block
(that may be the first of a free cluster). */
struct
{
- __malloc_size_t size; /* Size (in blocks) of a free cluster. */
- __malloc_size_t next; /* Index of next free cluster. */
- __malloc_size_t prev; /* Index of previous free cluster. */
+ size_t size; /* Size (in blocks) of a free cluster. */
+ size_t next; /* Index of next free cluster. */
+ size_t prev; /* Index of previous free cluster. */
} free;
} malloc_info;
/* Address to block number and vice versa. */
#define BLOCK(A) (((char *) (A) - _heapbase) / BLOCKSIZE + 1)
-#define ADDRESS(B) ((__ptr_t) (((B) - 1) * BLOCKSIZE + _heapbase))
+#define ADDRESS(B) ((void *) (((B) - 1) * BLOCKSIZE + _heapbase))
/* Current search index for the heap table. */
-extern __malloc_size_t _heapindex;
+extern size_t _heapindex;
/* Limit of valid info table indices. */
-extern __malloc_size_t _heaplimit;
+extern size_t _heaplimit;
/* Doubly linked lists of free fragments. */
struct list
struct alignlist
{
struct alignlist *next;
- __ptr_t aligned; /* The address that memaligned returned. */
- __ptr_t exact; /* The address that malloc returned. */
+ void *aligned; /* The address that memaligned returned. */
+ void *exact; /* The address that malloc returned. */
};
extern struct alignlist *_aligned_blocks;
/* Instrumentation. */
-extern __malloc_size_t _chunks_used;
-extern __malloc_size_t _bytes_used;
-extern __malloc_size_t _chunks_free;
-extern __malloc_size_t _bytes_free;
+extern size_t _chunks_used;
+extern size_t _bytes_used;
+extern size_t _chunks_free;
+extern size_t _bytes_free;
/* Internal versions of `malloc', `realloc', and `free'
used when these functions need to call each other.
They are the same but don't call the hooks. */
-extern __ptr_t _malloc_internal PP ((__malloc_size_t __size));
-extern __ptr_t _realloc_internal PP ((__ptr_t __ptr, __malloc_size_t __size));
-extern void _free_internal PP ((__ptr_t __ptr));
-extern __ptr_t _malloc_internal_nolock PP ((__malloc_size_t __size));
-extern __ptr_t _realloc_internal_nolock PP ((__ptr_t __ptr, __malloc_size_t __size));
-extern void _free_internal_nolock PP ((__ptr_t __ptr));
+extern void *_malloc_internal (size_t);
+extern void *_realloc_internal (void *, size_t);
+extern void _free_internal (void *);
+extern void *_malloc_internal_nolock (size_t);
+extern void *_realloc_internal_nolock (void *, size_t);
+extern void _free_internal_nolock (void *);
#ifdef USE_PTHREAD
extern pthread_mutex_t _malloc_mutex, _aligned_blocks_mutex;
#define UNLOCK_ALIGNED_BLOCKS()
#endif
-#endif /* _MALLOC_INTERNAL. */
-
/* Given an address in the middle of a malloc'd object,
return the address of the beginning of the object. */
-extern __ptr_t malloc_find_object_address PP ((__ptr_t __ptr));
+extern void *malloc_find_object_address (void *ptr);
/* Underlying allocation function; successive calls should
return contiguous pieces of memory. */
-extern __ptr_t (*__morecore) PP ((__malloc_ptrdiff_t __size));
+extern void *(*__morecore) (ptrdiff_t size);
/* Default value of `__morecore'. */
-extern __ptr_t __default_morecore PP ((__malloc_ptrdiff_t __size));
+extern void *__default_morecore (ptrdiff_t size);
/* If not NULL, this function is called after each time
`__morecore' is called to increase the data size. */
-extern void (*__after_morecore_hook) PP ((void));
+extern void (*__after_morecore_hook) (void);
/* Number of extra blocks to get each time we ask for more core.
This reduces the frequency of calling `(*__morecore)'. */
-extern __malloc_size_t __malloc_extra_blocks;
+extern size_t __malloc_extra_blocks;
/* Nonzero if `malloc' has been called and done its initialization. */
extern int __malloc_initialized;
/* Function called to initialize malloc data structures. */
-extern int __malloc_initialize PP ((void));
+extern int __malloc_initialize (void);
/* Hooks for debugging versions. */
-extern void (*__malloc_initialize_hook) PP ((void));
-extern void (*__free_hook) PP ((__ptr_t __ptr));
-extern __ptr_t (*__malloc_hook) PP ((__malloc_size_t __size));
-extern __ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size));
-extern __ptr_t (*__memalign_hook) PP ((__malloc_size_t __size,
- __malloc_size_t __alignment));
+extern void (*__malloc_initialize_hook) (void);
+extern void (*__free_hook) (void *ptr);
+extern void *(*__malloc_hook) (size_t size);
+extern void *(*__realloc_hook) (void *ptr, size_t size);
+extern void *(*__memalign_hook) (size_t size, size_t alignment);
/* Return values for `mprobe': these are the kinds of inconsistencies that
`mcheck' enables detection of. */
before `malloc' is ever called. ABORTFUNC is called with an error code
(see enum above) when an inconsistency is detected. If ABORTFUNC is
null, the standard function prints on stderr and then calls `abort'. */
-extern int mcheck PP ((void (*__abortfunc) PP ((enum mcheck_status))));
+extern int mcheck (void (*abortfunc) (enum mcheck_status));
/* Check for aberrations in a particular malloc'd block. You must have
called `mcheck' already. These are the same checks that `mcheck' does
when you free or reallocate a block. */
-extern enum mcheck_status mprobe PP ((__ptr_t __ptr));
+extern enum mcheck_status mprobe (void *ptr);
/* Activate a standard collection of tracing hooks. */
-extern void mtrace PP ((void));
-extern void muntrace PP ((void));
+extern void mtrace (void);
+extern void muntrace (void);
/* Statistics available to the user. */
struct mstats
{
- __malloc_size_t bytes_total; /* Total size of the heap. */
- __malloc_size_t chunks_used; /* Chunks allocated by the user. */
- __malloc_size_t bytes_used; /* Byte total of user-allocated chunks. */
- __malloc_size_t chunks_free; /* Chunks in the free list. */
- __malloc_size_t bytes_free; /* Byte total of chunks in the free list. */
+ size_t bytes_total; /* Total size of the heap. */
+ size_t chunks_used; /* Chunks allocated by the user. */
+ size_t bytes_used; /* Byte total of user-allocated chunks. */
+ size_t chunks_free; /* Chunks in the free list. */
+ size_t bytes_free; /* Byte total of chunks in the free list. */
};
/* Pick up the current statistics. */
-extern struct mstats mstats PP ((void));
+extern struct mstats mstats (void);
/* Call WARNFUN with a warning message when memory usage is high. */
-extern void memory_warnings PP ((__ptr_t __start,
- void (*__warnfun) PP ((const char *))));
-
-
-/* Relocating allocator. */
-
-/* Allocate SIZE bytes, and store the address in *HANDLEPTR. */
-extern __ptr_t r_alloc PP ((__ptr_t *__handleptr, __malloc_size_t __size));
-
-/* Free the storage allocated in HANDLEPTR. */
-extern void r_alloc_free PP ((__ptr_t *__handleptr));
-
-/* Adjust the block at HANDLEPTR to be SIZE bytes long. */
-extern __ptr_t r_re_alloc PP ((__ptr_t *__handleptr, __malloc_size_t __size));
-
+extern void memory_warnings (void *start, void (*warnfun) (const char *));
#ifdef __cplusplus
}
#endif
-#endif /* malloc.h */
/* Memory allocator `malloc'.
Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
Written May 1989 by Mike Haertel.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
#include <errno.h>
/* On Cygwin there are two heaps. temacs uses the static heap
this is changed in the future, we'll have to similarly deal with
reinitializing ralloc. */
#ifdef CYGWIN
-extern __ptr_t bss_sbrk PP ((ptrdiff_t __size));
+extern void *bss_sbrk (ptrdiff_t size);
extern int bss_sbrk_did_unexec;
char *bss_sbrk_heapbase; /* _heapbase for static heap */
malloc_info *bss_sbrk_heapinfo; /* _heapinfo for static heap */
#endif
-__ptr_t (*__morecore) PP ((__malloc_ptrdiff_t __size)) = __default_morecore;
+void *(*__morecore) (ptrdiff_t size) = __default_morecore;
/* Debugging hook for `malloc'. */
-__ptr_t (*__malloc_hook) PP ((__malloc_size_t __size));
+void *(*__malloc_hook) (size_t size);
/* Pointer to the base of the first block. */
char *_heapbase;
malloc_info *_heapinfo;
/* Number of info entries. */
-static __malloc_size_t heapsize;
+static size_t heapsize;
/* Search index in the info table. */
-__malloc_size_t _heapindex;
+size_t _heapindex;
/* Limit of valid info table indices. */
-__malloc_size_t _heaplimit;
+size_t _heaplimit;
/* Free lists for each fragment size. */
struct list _fraghead[BLOCKLOG];
/* Instrumentation. */
-__malloc_size_t _chunks_used;
-__malloc_size_t _bytes_used;
-__malloc_size_t _chunks_free;
-__malloc_size_t _bytes_free;
+size_t _chunks_used;
+size_t _bytes_used;
+size_t _chunks_free;
+size_t _bytes_free;
/* Are you experienced? */
int __malloc_initialized;
-__malloc_size_t __malloc_extra_blocks;
+size_t __malloc_extra_blocks;
-void (*__malloc_initialize_hook) PP ((void));
-void (*__after_morecore_hook) PP ((void));
+void (*__malloc_initialize_hook) (void);
+void (*__after_morecore_hook) (void);
#if defined GC_MALLOC_CHECK && defined GC_PROTECT_MALLOC_STATE
#include <sys/mman.h>
static int state_protected_p;
-static __malloc_size_t last_state_size;
+static size_t last_state_size;
static malloc_info *last_heapinfo;
void
-protect_malloc_state (protect_p)
- int protect_p;
+protect_malloc_state (int protect_p)
{
/* If _heapinfo has been relocated, make sure its old location
isn't left read-only; it will be reused by malloc. */
/* Aligned allocation. */
-static __ptr_t align PP ((__malloc_size_t));
-static __ptr_t
-align (size)
- __malloc_size_t size;
+static void *
+align (size_t size)
{
- __ptr_t result;
- unsigned long int adj;
+ void *result;
+ ptrdiff_t adj;
/* align accepts an unsigned argument, but __morecore accepts a
- signed one. This could lead to trouble if SIZE overflows a
- signed int type accepted by __morecore. We just punt in that
+ signed one. This could lead to trouble if SIZE overflows the
+ ptrdiff_t type accepted by __morecore. We just punt in that
case, since they are requesting a ludicrous amount anyway. */
- if ((__malloc_ptrdiff_t)size < 0)
+ if (PTRDIFF_MAX < size)
result = 0;
else
result = (*__morecore) (size);
- adj = (unsigned long int) ((unsigned long int) ((char *) result -
- (char *) NULL)) % BLOCKSIZE;
+ adj = (uintptr_t) result % BLOCKSIZE;
if (adj != 0)
{
- __ptr_t new;
adj = BLOCKSIZE - adj;
- new = (*__morecore) (adj);
+ (*__morecore) (adj);
result = (char *) result + adj;
}
/* Get SIZE bytes, if we can get them starting at END.
Return the address of the space we got.
If we cannot get space at END, fail and return 0. */
-static __ptr_t get_contiguous_space PP ((__malloc_ptrdiff_t, __ptr_t));
-static __ptr_t
-get_contiguous_space (size, position)
- __malloc_ptrdiff_t size;
- __ptr_t position;
+static void *
+get_contiguous_space (ptrdiff_t size, void *position)
{
- __ptr_t before;
- __ptr_t after;
+ void *before;
+ void *after;
before = (*__morecore) (0);
/* If we can tell in advance that the break is at the wrong place,
static inline void
register_heapinfo (void)
{
- __malloc_size_t block, blocks;
+ size_t block, blocks;
block = BLOCK (_heapinfo);
blocks = BLOCKIFY (heapsize * sizeof (malloc_info));
int _malloc_thread_enabled_p;
static void
-malloc_atfork_handler_prepare ()
+malloc_atfork_handler_prepare (void)
{
LOCK ();
LOCK_ALIGNED_BLOCKS ();
}
static void
-malloc_atfork_handler_parent ()
+malloc_atfork_handler_parent (void)
{
UNLOCK_ALIGNED_BLOCKS ();
UNLOCK ();
}
static void
-malloc_atfork_handler_child ()
+malloc_atfork_handler_child (void)
{
UNLOCK_ALIGNED_BLOCKS ();
UNLOCK ();
/* Set up mutexes and make malloc etc. thread-safe. */
void
-malloc_enable_thread ()
+malloc_enable_thread (void)
{
if (_malloc_thread_enabled_p)
return;
#endif
static void
-malloc_initialize_1 ()
+malloc_initialize_1 (void)
{
#ifdef GC_MCHECK
mcheck (NULL);
(*__malloc_initialize_hook) ();
heapsize = HEAP / BLOCKSIZE;
- _heapinfo = (malloc_info *) align (heapsize * sizeof (malloc_info));
+ _heapinfo = align (heapsize * sizeof (malloc_info));
if (_heapinfo == NULL)
return;
memset (_heapinfo, 0, heapsize * sizeof (malloc_info));
main will call malloc which calls this function. That is before any threads
or signal handlers has been set up, so we don't need thread protection. */
int
-__malloc_initialize ()
+__malloc_initialize (void)
{
if (__malloc_initialized)
return 0;
/* Get neatly aligned memory, initializing or
growing the heap info table as necessary. */
-static __ptr_t morecore_nolock PP ((__malloc_size_t));
-static __ptr_t
-morecore_nolock (size)
- __malloc_size_t size;
+static void *
+morecore_nolock (size_t size)
{
- __ptr_t result;
+ void *result;
malloc_info *newinfo, *oldinfo;
- __malloc_size_t newsize;
+ size_t newsize;
if (morecore_recursing)
/* Avoid recursion. The caller will know how to handle a null return. */
PROTECT_MALLOC_STATE (0);
/* Check if we need to grow the info table. */
- if ((__malloc_size_t) BLOCK ((char *) result + size) > heapsize)
+ if ((size_t) BLOCK ((char *) result + size) > heapsize)
{
/* Calculate the new _heapinfo table size. We do not account for the
added blocks in the table itself, as we hope to place them in
newsize = heapsize;
do
newsize *= 2;
- while ((__malloc_size_t) BLOCK ((char *) result + size) > newsize);
+ while ((size_t) BLOCK ((char *) result + size) > newsize);
/* We must not reuse existing core for the new info table when called
from realloc in the case of growing a large block, because the
`morecore_recursing' flag and return null. */
int save = errno; /* Don't want to clobber errno with ENOMEM. */
morecore_recursing = 1;
- newinfo = (malloc_info *) _realloc_internal_nolock
- (_heapinfo, newsize * sizeof (malloc_info));
+ newinfo = _realloc_internal_nolock (_heapinfo,
+ newsize * sizeof (malloc_info));
morecore_recursing = 0;
if (newinfo == NULL)
errno = save;
/* Allocate new space for the malloc info table. */
while (1)
{
- newinfo = (malloc_info *) align (newsize * sizeof (malloc_info));
+ newinfo = align (newsize * sizeof (malloc_info));
/* Did it fail? */
if (newinfo == NULL)
/* Is it big enough to record status for its own space?
If so, we win. */
- if ((__malloc_size_t) BLOCK ((char *) newinfo
- + newsize * sizeof (malloc_info))
+ if ((size_t) BLOCK ((char *) newinfo
+ + newsize * sizeof (malloc_info))
< newsize)
break;
}
/* Allocate memory from the heap. */
-__ptr_t
-_malloc_internal_nolock (size)
- __malloc_size_t size;
+void *
+_malloc_internal_nolock (size_t size)
{
- __ptr_t result;
- __malloc_size_t block, blocks, lastblocks, start;
- register __malloc_size_t i;
+ void *result;
+ size_t block, blocks, lastblocks, start;
+ register size_t i;
struct list *next;
/* ANSI C allows `malloc (0)' to either return NULL, or to return a
{
/* Small allocation to receive a fragment of a block.
Determine the logarithm to base two of the fragment size. */
- register __malloc_size_t log = 1;
+ register size_t log = 1;
--size;
while ((size /= 2) != 0)
++log;
/* There are free fragments of this size.
Pop a fragment out of the fragment list and return it.
Update the block's nfree and first counters. */
- result = (__ptr_t) next;
+ result = next;
next->prev->next = next->next;
if (next->next != NULL)
next->next->prev = next->prev;
block = BLOCK (result);
if (--_heapinfo[block].busy.info.frag.nfree != 0)
- _heapinfo[block].busy.info.frag.first = (unsigned long int)
- ((unsigned long int) ((char *) next->next - (char *) NULL)
- % BLOCKSIZE) >> log;
+ _heapinfo[block].busy.info.frag.first =
+ (uintptr_t) next->next % BLOCKSIZE >> log;
/* Update the statistics. */
++_chunks_used;
next->prev = &_fraghead[log];
_fraghead[log].next = next;
- for (i = 2; i < (__malloc_size_t) (BLOCKSIZE >> log); ++i)
+ for (i = 2; i < (size_t) (BLOCKSIZE >> log); ++i)
{
next = (struct list *) ((char *) result + (i << log));
next->next = _fraghead[log].next;
if (block == start)
{
/* Need to get more from the system. Get a little extra. */
- __malloc_size_t wantblocks = blocks + __malloc_extra_blocks;
+ size_t wantblocks = blocks + __malloc_extra_blocks;
block = _heapinfo[0].free.prev;
lastblocks = _heapinfo[block].free.size;
/* Check to see if the new core will be contiguous with the
return result;
}
-__ptr_t
-_malloc_internal (size)
- __malloc_size_t size;
+void *
+_malloc_internal (size_t size)
{
- __ptr_t result;
+ void *result;
LOCK ();
result = _malloc_internal_nolock (size);
return result;
}
-__ptr_t
-malloc (size)
- __malloc_size_t size;
+void *
+malloc (size_t size)
{
- __ptr_t (*hook) (__malloc_size_t);
+ void *(*hook) (size_t);
if (!__malloc_initialized && !__malloc_initialize ())
return NULL;
/* On some ANSI C systems, some libc functions call _malloc, _free
and _realloc. Make them use the GNU functions. */
-__ptr_t
-_malloc (size)
- __malloc_size_t size;
+extern void *_malloc (size_t);
+extern void _free (void *);
+extern void *_realloc (void *, size_t);
+
+void *
+_malloc (size_t size)
{
return malloc (size);
}
void
-_free (ptr)
- __ptr_t ptr;
+_free (void *ptr)
{
free (ptr);
}
-__ptr_t
-_realloc (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+_realloc (void *ptr, size_t size)
{
return realloc (ptr, size);
}
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
/* Debugging hook for free. */
-void (*__free_hook) PP ((__ptr_t __ptr));
+void (*__free_hook) (void *__ptr);
/* List of blocks allocated by memalign. */
struct alignlist *_aligned_blocks = NULL;
/* Return memory to the heap.
Like `_free_internal' but don't lock mutex. */
void
-_free_internal_nolock (ptr)
- __ptr_t ptr;
+_free_internal_nolock (void *ptr)
{
int type;
- __malloc_size_t block, blocks;
- register __malloc_size_t i;
+ size_t block, blocks;
+ register size_t i;
struct list *prev, *next;
- __ptr_t curbrk;
- const __malloc_size_t lesscore_threshold
+ void *curbrk;
+ const size_t lesscore_threshold
/* Threshold of free space at which we will return some to the system. */
= FINAL_FREE_BLOCKS + 2 * __malloc_extra_blocks;
return;
#ifdef CYGWIN
- if (ptr < _heapbase)
+ if ((char *) ptr < _heapbase)
/* We're being asked to free something in the static heap. */
return;
#endif
It's possible that moving _heapinfo will allow us to
return some space to the system. */
- __malloc_size_t info_block = BLOCK (_heapinfo);
- __malloc_size_t info_blocks = _heapinfo[info_block].busy.info.size;
- __malloc_size_t prev_block = _heapinfo[block].free.prev;
- __malloc_size_t prev_blocks = _heapinfo[prev_block].free.size;
- __malloc_size_t next_block = _heapinfo[block].free.next;
- __malloc_size_t next_blocks = _heapinfo[next_block].free.size;
+ size_t info_block = BLOCK (_heapinfo);
+ size_t info_blocks = _heapinfo[info_block].busy.info.size;
+ size_t prev_block = _heapinfo[block].free.prev;
+ size_t prev_blocks = _heapinfo[prev_block].free.size;
+ size_t next_block = _heapinfo[block].free.next;
+ size_t next_blocks = _heapinfo[next_block].free.size;
if (/* Win if this block being freed is last in core, the info table
is just before it, the previous free block is just before the
)
{
malloc_info *newinfo;
- __malloc_size_t oldlimit = _heaplimit;
+ size_t oldlimit = _heaplimit;
/* Free the old info table, clearing _heaplimit to avoid
recursion into this code. We don't want to return the
_heapindex = 0;
/* Allocate new space for the info table and move its data. */
- newinfo = (malloc_info *) _malloc_internal_nolock (info_blocks
- * BLOCKSIZE);
+ newinfo = _malloc_internal_nolock (info_blocks * BLOCKSIZE);
PROTECT_MALLOC_STATE (0);
memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE);
_heapinfo = newinfo;
/* Now see if we can return stuff to the system. */
if (block + blocks == _heaplimit && blocks >= lesscore_threshold)
{
- register __malloc_size_t bytes = blocks * BLOCKSIZE;
+ register size_t bytes = blocks * BLOCKSIZE;
_heaplimit -= blocks;
(*__morecore) (-bytes);
_heapinfo[_heapinfo[block].free.prev].free.next
/* If all fragments of this block are free, remove them
from the fragment list and free the whole block. */
next = prev;
- for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> type); ++i)
+ for (i = 1; i < (size_t) (BLOCKSIZE >> type); ++i)
next = next->next;
prev->prev->next = next;
if (next != NULL)
/* If some fragments of this block are free, link this
fragment into the fragment list after the first free
fragment of this block. */
- next = (struct list *) ptr;
+ next = ptr;
next->next = prev->next;
next->prev = prev;
prev->next = next;
/* No fragments of this block are free, so link this
fragment into the fragment list and announce that
it is the first free fragment of this block. */
- prev = (struct list *) ptr;
+ prev = ptr;
_heapinfo[block].busy.info.frag.nfree = 1;
- _heapinfo[block].busy.info.frag.first = (unsigned long int)
- ((unsigned long int) ((char *) ptr - (char *) NULL)
- % BLOCKSIZE >> type);
+ _heapinfo[block].busy.info.frag.first =
+ (uintptr_t) ptr % BLOCKSIZE >> type;
prev->next = _fraghead[type].next;
prev->prev = &_fraghead[type];
prev->prev->next = prev;
/* Return memory to the heap.
Like `free' but don't call a __free_hook if there is one. */
void
-_free_internal (ptr)
- __ptr_t ptr;
+_free_internal (void *ptr)
{
LOCK ();
_free_internal_nolock (ptr);
/* Return memory to the heap. */
void
-free (ptr)
- __ptr_t ptr;
+free (void *ptr)
{
- void (*hook) (__ptr_t) = __free_hook;
+ void (*hook) (void *) = __free_hook;
if (hook != NULL)
(*hook) (ptr);
weak_alias (free, cfree)
#else
void
-cfree (ptr)
- __ptr_t ptr;
+cfree (void *ptr)
{
free (ptr);
}
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
-
#define min(A, B) ((A) < (B) ? (A) : (B))
/* On Cygwin the dumped emacs may try to realloc storage allocated in
the static heap. We just malloc space in the new heap and copy the
data. */
#ifdef CYGWIN
-__ptr_t
-special_realloc (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+special_realloc (void *ptr, size_t size)
{
- __ptr_t result;
+ void *result;
int type;
- __malloc_size_t block, oldsize;
+ size_t block, oldsize;
block = ((char *) ptr - bss_sbrk_heapbase) / BLOCKSIZE + 1;
type = bss_sbrk_heapinfo[block].busy.type;
oldsize =
type == 0 ? bss_sbrk_heapinfo[block].busy.info.size * BLOCKSIZE
- : (__malloc_size_t) 1 << type;
+ : (size_t) 1 << type;
result = _malloc_internal_nolock (size);
if (result != NULL)
memcpy (result, ptr, min (oldsize, size));
#endif
/* Debugging hook for realloc. */
-__ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size));
+void *(*__realloc_hook) (void *ptr, size_t size);
/* Resize the given region to the new size, returning a pointer
to the (possibly moved) region. This is optimized for speed;
achieved by unconditionally allocating and copying to a
new region. This module has incestuous knowledge of the
internals of both free and malloc. */
-__ptr_t
-_realloc_internal_nolock (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+_realloc_internal_nolock (void *ptr, size_t size)
{
- __ptr_t result;
+ void *result;
int type;
- __malloc_size_t block, blocks, oldlimit;
+ size_t block, blocks, oldlimit;
if (size == 0)
{
return _malloc_internal_nolock (size);
#ifdef CYGWIN
- if (ptr < _heapbase)
+ if ((char *) ptr < _heapbase)
/* ptr points into the static heap */
return special_realloc (ptr, size);
#endif
(void) _malloc_internal_nolock (blocks * BLOCKSIZE);
else
{
- __ptr_t previous
+ void *previous
= _malloc_internal_nolock ((block - _heapindex) * BLOCKSIZE);
(void) _malloc_internal_nolock (blocks * BLOCKSIZE);
_free_internal_nolock (previous);
default:
/* Old size is a fragment; type is logarithm
to base two of the fragment size. */
- if (size > (__malloc_size_t) (1 << (type - 1)) &&
- size <= (__malloc_size_t) (1 << type))
+ if (size > (size_t) (1 << (type - 1)) &&
+ size <= (size_t) (1 << type))
/* The new size is the same kind of fragment. */
result = ptr;
else
result = _malloc_internal_nolock (size);
if (result == NULL)
goto out;
- memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type));
+ memcpy (result, ptr, min (size, (size_t) 1 << type));
_free_internal_nolock (ptr);
}
break;
return result;
}
-__ptr_t
-_realloc_internal (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+_realloc_internal (void *ptr, size_t size)
{
- __ptr_t result;
+ void *result;
LOCK ();
result = _realloc_internal_nolock (ptr, size);
return result;
}
-__ptr_t
-realloc (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+void *
+realloc (void *ptr, size_t size)
{
- __ptr_t (*hook) (__ptr_t, __malloc_size_t);
+ void *(*hook) (void *, size_t);
if (!__malloc_initialized && !__malloc_initialize ())
return NULL;
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
/* Allocate an array of NMEMB elements each SIZE bytes long.
The entire array is initialized to zeros. */
-__ptr_t
-calloc (nmemb, size)
- register __malloc_size_t nmemb;
- register __malloc_size_t size;
+void *
+calloc (register size_t nmemb, register size_t size)
{
- register __ptr_t result = malloc (nmemb * size);
+ register void *result = malloc (nmemb * size);
if (result != NULL)
(void) memset (result, 0, nmemb * size);
the Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
MA 02110-1301, USA. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
/* uClibc defines __GNU_LIBRARY__, but it is not completely
compatible. */
#if !defined (__GNU_LIBRARY__) || defined (__UCLIBC__)
/* It is best not to declare this and cast its result on foreign operating
systems with potentially hostile include files. */
-#include <stddef.h>
-extern __ptr_t __sbrk PP ((ptrdiff_t increment));
+extern void *__sbrk (ptrdiff_t increment);
#endif /* __GNU_LIBRARY__ && ! defined (__UCLIBC__) */
-#ifndef NULL
-#define NULL 0
-#endif
-
/* Allocate INCREMENT more bytes of data space,
and return the start of data space, or NULL on errors.
If INCREMENT is negative, shrink data space. */
-__ptr_t
-__default_morecore (increment)
- __malloc_ptrdiff_t increment;
+void *
+__default_morecore (ptrdiff_t increment)
{
- __ptr_t result;
+ void *result;
#if defined (CYGWIN)
if (!bss_sbrk_did_unexec)
{
return bss_sbrk (increment);
}
#endif
- result = (__ptr_t) __sbrk (increment);
- if (result == (__ptr_t) -1)
+ result = (void *) __sbrk (increment);
+ if (result == (void *) -1)
return NULL;
return result;
}
not, write to the Free Software Foundation, Inc., 51 Franklin Street,
Fifth Floor, Boston, MA 02110-1301, USA. */
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
-#endif
-
-__ptr_t (*__memalign_hook) PP ((__malloc_size_t __size,
- __malloc_size_t __alignment));
+void *(*__memalign_hook) (size_t size, size_t alignment);
-__ptr_t
-memalign (alignment, size)
- __malloc_size_t alignment;
- __malloc_size_t size;
+void *
+memalign (size_t alignment, size_t size)
{
- __ptr_t result;
- unsigned long int adj, lastadj;
- __ptr_t (*hook) (__malloc_size_t, __malloc_size_t) = __memalign_hook;
+ void *result;
+ size_t adj, lastadj;
+ void *(*hook) (size_t, size_t) = __memalign_hook;
if (hook)
return (*hook) (alignment, size);
/* Figure out how much we will need to pad this particular block
to achieve the required alignment. */
- adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment;
+ adj = (uintptr_t) result % alignment;
do
{
return NULL;
lastadj = adj;
- adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment;
+ adj = (uintptr_t) result % alignment;
/* It's conceivable we might have been so unlucky as to get a
different block with weaker alignment. If so, this block is too
short to contain SIZE after alignment correction. So we must
break;
if (l == NULL)
{
- l = (struct alignlist *) malloc (sizeof (struct alignlist));
+ l = malloc (sizeof *l);
if (l != NULL)
{
l->next = _aligned_blocks;
#endif
int
-posix_memalign (memptr, alignment, size)
- __ptr_t *memptr;
- __malloc_size_t alignment;
- __malloc_size_t size;
+posix_memalign (void **memptr, size_t alignment, size_t size)
{
- __ptr_t mem;
+ void *mem;
if (alignment == 0
- || alignment % sizeof (__ptr_t) != 0
+ || alignment % sizeof (void *) != 0
|| (alignment & (alignment - 1)) != 0)
return EINVAL;
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#if defined (_MALLOC_INTERNAL) && defined (GMALLOC_INHIBIT_VALLOC)
-
-/* Emacs defines GMALLOC_INHIBIT_VALLOC to avoid this definition
- on MSDOS, where it conflicts with a system header file. */
-
-#define ELIDE_VALLOC
-
-#endif
-
-#ifndef ELIDE_VALLOC
-
-#if defined (__GNU_LIBRARY__) || defined (_LIBC)
-#include <stddef.h>
-#include <sys/cdefs.h>
-#if defined (__GLIBC__) && __GLIBC__ >= 2
-/* __getpagesize is already declared in <unistd.h> with return type int */
-#else
-extern size_t __getpagesize PP ((void));
-#endif
-#else
-#include "getpagesize.h"
-#define __getpagesize() getpagesize ()
-#endif
+/* Allocate SIZE bytes on a page boundary. */
+extern void *valloc (size_t);
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
+#if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE
+# include "getpagesize.h"
+#elif !defined getpagesize
+extern int getpagesize (void);
#endif
-static __malloc_size_t pagesize;
+static size_t pagesize;
-__ptr_t
-valloc (size)
- __malloc_size_t size;
+void *
+valloc (size_t size)
{
if (pagesize == 0)
- pagesize = __getpagesize ();
+ pagesize = getpagesize ();
return memalign (pagesize, size);
}
-#endif /* Not ELIDE_VALLOC. */
-
#ifdef GC_MCHECK
/* Standard debugging hooks for `malloc'.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
-#ifdef emacs
-#include <stdio.h>
-#else
-#ifndef _MALLOC_INTERNAL
-#define _MALLOC_INTERNAL
-#include <malloc.h>
#include <stdio.h>
-#endif
-#endif
/* Old hook values. */
-static void (*old_free_hook) (__ptr_t ptr);
-static __ptr_t (*old_malloc_hook) (__malloc_size_t size);
-static __ptr_t (*old_realloc_hook) (__ptr_t ptr, __malloc_size_t size);
+static void (*old_free_hook) (void *ptr);
+static void *(*old_malloc_hook) (size_t size);
+static void *(*old_realloc_hook) (void *ptr, size_t size);
/* Function to call when something awful happens. */
static void (*abortfunc) (enum mcheck_status);
/* Arbitrary magical numbers. */
-#define MAGICWORD 0xfedabeeb
-#define MAGICFREE 0xd8675309
+#define MAGICWORD (SIZE_MAX / 11 ^ SIZE_MAX / 13 << 3)
+#define MAGICFREE (SIZE_MAX / 17 ^ SIZE_MAX / 19 << 4)
#define MAGICBYTE ((char) 0xd7)
#define MALLOCFLOOD ((char) 0x93)
#define FREEFLOOD ((char) 0x95)
struct hdr
{
- __malloc_size_t size; /* Exact size requested by user. */
- unsigned long int magic; /* Magic number to check header integrity. */
+ size_t size; /* Exact size requested by user. */
+ size_t magic; /* Magic number to check header integrity. */
};
-static enum mcheck_status checkhdr (const struct hdr *);
static enum mcheck_status
-checkhdr (hdr)
- const struct hdr *hdr;
+checkhdr (const struct hdr *hdr)
{
enum mcheck_status status;
switch (hdr->magic)
return status;
}
-static void freehook (__ptr_t);
static void
-freehook (ptr)
- __ptr_t ptr;
+freehook (void *ptr)
{
struct hdr *hdr;
__free_hook = freehook;
}
-static __ptr_t mallochook (__malloc_size_t);
-static __ptr_t
-mallochook (size)
- __malloc_size_t size;
+static void *
+mallochook (size_t size)
{
struct hdr *hdr;
__malloc_hook = old_malloc_hook;
- hdr = (struct hdr *) malloc (sizeof (struct hdr) + size + 1);
+ hdr = malloc (sizeof *hdr + size + 1);
__malloc_hook = mallochook;
if (hdr == NULL)
return NULL;
hdr->size = size;
hdr->magic = MAGICWORD;
((char *) &hdr[1])[size] = MAGICBYTE;
- memset ((__ptr_t) (hdr + 1), MALLOCFLOOD, size);
- return (__ptr_t) (hdr + 1);
+ memset (hdr + 1, MALLOCFLOOD, size);
+ return hdr + 1;
}
-static __ptr_t reallochook (__ptr_t, __malloc_size_t);
-static __ptr_t
-reallochook (ptr, size)
- __ptr_t ptr;
- __malloc_size_t size;
+static void *
+reallochook (void *ptr, size_t size)
{
struct hdr *hdr = NULL;
- __malloc_size_t osize = 0;
+ size_t osize = 0;
if (ptr)
{
__free_hook = old_free_hook;
__malloc_hook = old_malloc_hook;
__realloc_hook = old_realloc_hook;
- hdr = (struct hdr *) realloc ((__ptr_t) hdr, sizeof (struct hdr) + size + 1);
+ hdr = realloc (hdr, sizeof *hdr + size + 1);
__free_hook = freehook;
__malloc_hook = mallochook;
__realloc_hook = reallochook;
((char *) &hdr[1])[size] = MAGICBYTE;
if (size > osize)
memset ((char *) (hdr + 1) + osize, MALLOCFLOOD, size - osize);
- return (__ptr_t) (hdr + 1);
+ return hdr + 1;
}
static void
-mabort (status)
- enum mcheck_status status;
+mabort (enum mcheck_status status)
{
const char *msg;
switch (status)
static int mcheck_used = 0;
int
-mcheck (func)
- void (*func) (enum mcheck_status);
+mcheck (void (*func) (enum mcheck_status))
{
abortfunc = (func != NULL) ? func : &mabort;
}
enum mcheck_status
-mprobe (__ptr_t ptr)
+mprobe (void *ptr)
{
return mcheck_used ? checkhdr (ptr) : MCHECK_DISABLED;
}
#include <config.h>
#include <errno.h>
-#include <setjmp.h>
#include "lisp.h"
#include "process.h"
#include "w32.h"
#endif
-static int
-emacs_gnutls_handle_error (gnutls_session_t, int err);
+static bool emacs_gnutls_handle_error (gnutls_session_t, int);
static Lisp_Object Qgnutls_dll;
static Lisp_Object Qgnutls_code;
static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-static int gnutls_global_initialized;
+static bool gnutls_global_initialized;
/* The following are for the property list of `gnutls-boot'. */
static Lisp_Object QCgnutls_bootprop_priority;
gnutls_x509_crt_fmt_t));
DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
-static int
-init_gnutls_functions (Lisp_Object libraries)
+static bool
+init_gnutls_functions (void)
{
HMODULE library;
int max_log_level = 1;
- if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
+ if (!(library = w32_delayed_load (Qgnutls_dll)))
{
GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
return 0;
max_log_level = global_gnutls_log_level;
- GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
- SDATA (Fget (Qgnutls_dll, QCloaded_from)));
+ {
+ Lisp_Object name = CAR_SAFE (Fget (Qgnutls_dll, QCloaded_from));
+ GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
+ STRINGP (name) ? (const char *) SDATA (name) : "unknown");
+ }
+
return 1;
}
fn_gnutls_transport_set_errno (state, err);
}
-EMACS_INT
-emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
{
ssize_t rtnval = 0;
- EMACS_INT bytes_written;
+ ptrdiff_t bytes_written;
gnutls_session_t state = proc->gnutls_state;
if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
return (bytes_written);
}
-EMACS_INT
-emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
{
ssize_t rtnval;
gnutls_session_t state = proc->gnutls_state;
{
proc->gnutls_handshakes_tried++;
emacs_gnutls_handshake (proc);
- GNUTLS_LOG2i (5, log_level, "Retried handshake",
+ GNUTLS_LOG2i (5, log_level, "Retried handshake",
proc->gnutls_handshakes_tried);
return -1;
}
else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
/* The peer closed the connection. */
return 0;
- else if (emacs_gnutls_handle_error (state, rtnval) == 0)
+ else if (emacs_gnutls_handle_error (state, rtnval))
/* non-fatal error */
return -1;
else {
}
}
-/* report a GnuTLS error to the user.
- Returns zero if the error code was successfully handled. */
-static int
+/* Report a GnuTLS error to the user.
+ Return true if the error code was successfully handled. */
+static bool
emacs_gnutls_handle_error (gnutls_session_t session, int err)
{
int max_log_level = 0;
- int ret;
+ bool ret;
const char *str;
/* TODO: use a Lisp_Object generated by gnutls_make_error? */
if (err >= 0)
- return 0;
+ return 1;
max_log_level = global_gnutls_log_level;
if (fn_gnutls_error_is_fatal (err))
{
- ret = err;
+ ret = 0;
GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
}
else
{
- ret = 0;
+ ret = 1;
GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
/* TODO: EAGAIN AKA Qgnutls_e_again should be level 2. */
}
}
}
- if (!NUMBERP (err))
+ if (! TYPE_RANGED_INTEGERP (int, err))
error ("Not an error symbol or code");
if (0 == fn_gnutls_error_is_fatal (XINT (err)))
}
}
- if (!NUMBERP (err))
+ if (! TYPE_RANGED_INTEGERP (int, err))
return build_string ("Not an error symbol or code");
return build_string (fn_gnutls_strerror (XINT (err)));
else
{
Lisp_Object status;
- status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
+ status = init_gnutls_functions () ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
return status;
}
error ("gnutls-boot: invalid :hostname parameter");
c_hostname = SSDATA (hostname);
- if (NUMBERP (loglevel))
+ state = XPROCESS (proc)->gnutls_state;
+ XPROCESS (proc)->gnutls_p = 1;
+
+ if (TYPE_RANGED_INTEGERP (int, loglevel))
{
fn_gnutls_global_set_log_function (gnutls_log_function);
fn_gnutls_global_set_log_level (XINT (loglevel));
XPROCESS (proc)->gnutls_state = NULL;
XPROCESS (proc)->gnutls_x509_cred = NULL;
XPROCESS (proc)->gnutls_anon_cred = NULL;
- XPROCESS (proc)->gnutls_cred_type = type;
+ pset_gnutls_cred_type (XPROCESS (proc), type);
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
GNUTLS_LOG (1, max_log_level, "allocating credentials");
int file_format = GNUTLS_X509_FMT_PEM;
Lisp_Object tail;
- for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
+ for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object trustfile = Fcar (tail);
+ Lisp_Object trustfile = XCAR (tail);
if (STRINGP (trustfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
}
}
- for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
+ for (tail = crlfiles; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object crlfile = Fcar (tail);
+ Lisp_Object crlfile = XCAR (tail);
if (STRINGP (crlfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
}
}
- for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
+ for (tail = keylist; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object keyfile = Fcar (Fcar (tail));
- Lisp_Object certfile = Fcar (Fcdr (tail));
+ Lisp_Object keyfile = Fcar (XCAR (tail));
+ Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
if (STRINGP (keyfile) && STRINGP (certfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
#define GNUTLS_LOG2i(level, max, string, extra) do { if (level <= max) { gnutls_log_function2i (level, "(Emacs) " string, extra); } } while (0)
-extern EMACS_INT
-emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte);
-extern EMACS_INT
-emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte);
+extern ptrdiff_t
+emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte);
+extern ptrdiff_t
+emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte);
extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
#ifdef USE_GTK
#include <float.h>
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
+
+#include <c-ctype.h>
+
#include "lisp.h"
#include "xterm.h"
#include "blockinput.h"
#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)
gdk_window_get_geometry (w, a, b, c, d, 0)
#define gdk_x11_window_lookup_for_display(d, w) \
gdk_xid_table_lookup_for_display (d, w)
+#define gtk_box_new(ori, spacing) \
+ ((ori) == GTK_ORIENTATION_HORIZONTAL \
+ ? gtk_hbox_new (FALSE, (spacing)) : gtk_vbox_new (FALSE, (spacing)))
+#define gtk_scrollbar_new(ori, spacing) \
+ ((ori) == GTK_ORIENTATION_HORIZONTAL \
+ ? gtk_hscrollbar_new ((spacing)) : gtk_vscrollbar_new ((spacing)))
#ifndef GDK_KEY_g
#define GDK_KEY_g GDK_g
#endif
-#endif
+#endif /* HAVE_GTK3 */
#define XG_BIN_CHILD(x) gtk_bin_get_child (GTK_BIN (x))
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;
+};
+
\f
/***********************************************************************
Display handling functions
}
else
{
- wv = (widget_value *) xmalloc (sizeof (widget_value));
+ wv = xmalloc (sizeof *wv);
malloc_cpt++;
}
memset (wv, 0, sizeof (widget_value));
free_widget_value (widget_value *wv)
{
if (wv->free_list)
- abort ();
+ emacs_abort ();
if (malloc_cpt > 25)
{
&bytes_written, &err))
&& err->code == G_CONVERT_ERROR_ILLEGAL_SEQUENCE)
{
- strncpy (up, (char *)p, bytes_written);
+ memcpy (up, p, bytes_written);
sprintf (up + bytes_written, "\\%03o", p[bytes_written]);
- up[bytes_written+4] = '\0';
up += bytes_written+4;
p += bytes_written+1;
g_error_free (err);
/* Check for special colors used in face spec for region face.
The colors are fetched from the Gtk+ theme.
- Return 1 if color was found, 0 if not. */
+ Return true if color was found, false if not. */
-int
+bool
xg_check_special_colors (struct frame *f,
const char *color_name,
XColor *color)
{
- int success_p = 0;
- int get_bg = strcmp ("gtk_selection_bg_color", color_name) == 0;
- int get_fg = !get_bg && strcmp ("gtk_selection_fg_color", color_name) == 0;
+ bool success_p = 0;
+ bool get_bg = strcmp ("gtk_selection_bg_color", color_name) == 0;
+ bool get_fg = !get_bg && strcmp ("gtk_selection_fg_color", color_name) == 0;
if (! FRAME_GTK_WIDGET (f) || ! (get_bg || get_fg))
return success_p;
- BLOCK_INPUT;
+ block_input ();
{
#ifdef HAVE_GTK3
GtkStyleContext *gsty
gtk_style_context_get_background_color (gsty, state, &col);
sprintf (buf, "rgbi:%lf/%lf/%lf", col.red, col.green, col.blue);
- success_p = XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
- buf, color);
+ success_p = (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
+ buf, color)
+ != 0);
#else
GtkStyle *gsty = gtk_widget_get_style (FRAME_GTK_WIDGET (f));
GdkColor *grgb = get_bg
#endif
}
- UNBLOCK_INPUT;
+ unblock_input ();
return success_p;
}
#endif /* USE_GTK_TOOLTIP */
/* Prepare a tooltip to be shown, i.e. calculate WIDTH and HEIGHT.
- Return zero if no system tooltip available, non-zero otherwise. */
+ Return true if a system tooltip is available. */
-int
+bool
xg_prepare_tooltip (FRAME_PTR f,
Lisp_Object string,
int *width,
if (!x->ttip_lbl) return 0;
- BLOCK_INPUT;
+ block_input ();
encoded_string = ENCODE_UTF_8 (string);
widget = GTK_WIDGET (x->ttip_lbl);
gwin = gtk_widget_get_window (GTK_WIDGET (x->ttip_window));
if (width) *width = req.width;
if (height) *height = req.height;
- UNBLOCK_INPUT;
+ unblock_input ();
return 1;
#endif /* USE_GTK_TOOLTIP */
struct x_output *x = f->output_data.x;
if (x->ttip_window)
{
- BLOCK_INPUT;
+ block_input ();
gtk_window_move (x->ttip_window, root_x, root_y);
gtk_widget_show_all (GTK_WIDGET (x->ttip_window));
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
}
/* Hide tooltip if shown. Do nothing if not shown.
- Return non-zero if tip was hidden, non-zero if not (i.e. not using
+ Return true if tip was hidden, false if not (i.e. not using
system tooltips). */
-int
+bool
xg_hide_tooltip (FRAME_PTR f)
{
- int ret = 0;
+ bool ret = 0;
#ifdef USE_GTK_TOOLTIP
if (f->output_data.x->ttip_window)
{
GtkWindow *win = f->output_data.x->ttip_window;
- BLOCK_INPUT;
+ block_input ();
gtk_widget_hide (GTK_WIDGET (win));
if (g_object_get_data (G_OBJECT (win), "restore-tt"))
GtkSettings *settings = gtk_settings_get_for_screen (screen);
g_object_set (settings, "gtk-enable-tooltips", TRUE, NULL);
}
- UNBLOCK_INPUT;
+ unblock_input ();
ret = 1;
}
gpointer gdkwin;
GtkWidget *gwdesc = 0;
- BLOCK_INPUT;
+ block_input ();
gdkwin = gdk_x11_window_lookup_for_display (gdk_x11_lookup_xdisplay (dpy),
wdesc);
gwdesc = gtk_get_event_widget (&event);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return gwdesc;
}
}
/* Create and set up the GTK widgets for frame F.
- Return 0 if creation failed, non-zero otherwise. */
+ Return true if creation succeeded. */
-int
+bool
xg_create_frame_widgets (FRAME_PTR f)
{
GtkWidget *wtop;
GtkWidget *wvbox, *whbox;
GtkWidget *wfixed;
+#ifndef HAVE_GTK3
GtkRcStyle *style;
+#endif
char *title = 0;
- BLOCK_INPUT;
+ block_input ();
if (FRAME_X_EMBEDDED_P (f))
- wtop = gtk_plug_new (f->output_data.x->parent_desc);
+ {
+ GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f));
+ wtop = gtk_plug_new_for_display (gdpy, f->output_data.x->parent_desc);
+ }
else
wtop = gtk_window_new (GTK_WINDOW_TOPLEVEL);
xg_set_screen (wtop, f);
- wvbox = gtk_vbox_new (FALSE, 0);
- whbox = gtk_hbox_new (FALSE, 0);
+ wvbox = gtk_box_new (GTK_ORIENTATION_VERTICAL, 0);
+ whbox = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (wvbox), FALSE);
+ gtk_box_set_homogeneous (GTK_BOX (whbox), FALSE);
#ifdef HAVE_GTK3
wfixed = emacs_fixed_new (f);
if (whbox) gtk_widget_destroy (whbox);
if (wfixed) gtk_widget_destroy (wfixed);
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
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 (f->title)) title = SSDATA (ENCODE_UTF_8 (f->title));
- else if (! NILP (f->name)) title = SSDATA (ENCODE_UTF_8 (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);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return 1;
}
#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;
/* Set the normal size hints for the window manager, for frame F.
FLAGS is the flags word to use--or 0 meaning preserve the flags
that the window now has.
- If USER_POSITION is nonzero, we set the User Position
+ If USER_POSITION, set the User Position
flag (this is useful when FLAGS is 0). */
void
-x_wm_set_size_hint (FRAME_PTR f, long int flags, int user_position)
+x_wm_set_size_hint (FRAME_PTR f, long int flags, bool user_position)
{
/* Must use GTK routines here, otherwise GTK resets the size hints
to its own defaults. */
size_hints.height_inc = FRAME_LINE_HEIGHT (f);
hint_flags |= GDK_HINT_BASE_SIZE;
- /* Use one row here so base_height does not become zero.
+ /* Use one row/col here so base_height/width does not become zero.
Gtk+ and/or Unity on Ubuntu 12.04 can't handle it. */
base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 1) + FRAME_TOOLBAR_WIDTH (f);
base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 1)
&f->output_data.x->size_hints,
sizeof (size_hints)) != 0)
{
- BLOCK_INPUT;
+ block_input ();
gtk_window_set_geometry_hints (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
NULL, &size_hints, hint_flags);
f->output_data.x->size_hints = size_hints;
f->output_data.x->hint_flags = hint_flags;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
{
if (FRAME_GTK_WIDGET (f))
{
- BLOCK_INPUT;
+ block_input ();
xg_set_widget_bg (f, FRAME_GTK_WIDGET (f), FRAME_BACKGROUND_PIXEL (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
/* If the number of buttons is greater than 4, make two rows of buttons
instead. This looks better. */
- int make_two_rows = total_buttons > 4;
+ bool make_two_rows = total_buttons > 4;
if (right_buttons == 0) right_buttons = total_buttons/2;
left_buttons = total_buttons - right_buttons;
if (make_two_rows)
{
- GtkWidget *wvbox = gtk_vbox_new (TRUE, button_spacing);
- GtkWidget *whbox_up = gtk_hbox_new (FALSE, 0);
- whbox_down = gtk_hbox_new (FALSE, 0);
+ GtkWidget *wvbox = gtk_box_new (GTK_ORIENTATION_VERTICAL, button_spacing);
+ GtkWidget *whbox_up = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (wvbox), TRUE);
+ gtk_box_set_homogeneous (GTK_BOX (whbox_up), FALSE);
+ whbox_down = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (whbox_down), FALSE);
gtk_box_pack_start (cur_box, wvbox, FALSE, FALSE, 0);
gtk_box_pack_start (GTK_BOX (wvbox), whbox_up, FALSE, FALSE, 0);
struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
struct xg_dialog_data *dd = (struct xg_dialog_data *) p->pointer;
- BLOCK_INPUT;
+ block_input ();
if (dd->w) gtk_widget_destroy (dd->w);
if (dd->timerid != 0) g_source_remove (dd->timerid);
g_main_loop_quit (dd->loop);
g_main_loop_unref (dd->loop);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
{
struct xg_dialog_data *dd = (struct xg_dialog_data *) data;
EMACS_TIME next_time = timer_check ();
- long secs = EMACS_SECS (next_time);
- long usecs = EMACS_USECS (next_time);
dd->timerid = 0;
- if (secs >= 0 && usecs >= 0 && secs < ((guint)-1)/1000)
+ if (EMACS_TIME_VALID_P (next_time))
{
- dd->timerid = g_timeout_add (secs * 1000 + usecs/1000,
- xg_maybe_add_timer,
- dd);
+ time_t s = EMACS_SECS (next_time);
+ int per_ms = EMACS_TIME_RESOLUTION / 1000;
+ int ms = (EMACS_NSECS (next_time) + per_ms - 1) / per_ms;
+ if (s <= ((guint) -1 - ms) / 1000)
+ dd->timerid = g_timeout_add (s * 1000 + ms, xg_maybe_add_timer, dd);
}
return FALSE;
}
static int
xg_dialog_run (FRAME_PTR f, GtkWidget *w)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct xg_dialog_data dd;
xg_set_screen (w, f);
/***********************************************************************
File dialog functions
***********************************************************************/
-/* Return non-zero if the old file selection dialog is being used.
- Return zero if not. */
+/* Return true if the old file selection dialog is being used. */
-int
+bool
xg_uses_old_file_dialog (void)
{
#ifdef HAVE_GTK_FILE_SELECTION_NEW
F is the current frame.
PROMPT is a prompt to show to the user. May not be NULL.
DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
- If MUSTMATCH_P is non-zero, the returned file name must be an existing
+ If MUSTMATCH_P, the returned file name must be an existing
file. (Actually, this only has cosmetic effects, the user can
still enter a non-existing file.) *FUNC is set to a function that
can be used to retrieve the selected file name from the returned widget.
xg_get_file_with_chooser (FRAME_PTR f,
char *prompt,
char *default_filename,
- int mustmatch_p, int only_dir_p,
+ bool mustmatch_p, bool only_dir_p,
xg_get_file_func *func)
{
char msgbuf[1024];
NULL);
gtk_file_chooser_set_local_only (GTK_FILE_CHOOSER (filewin), TRUE);
- wbox = gtk_vbox_new (FALSE, 0);
+ wbox = gtk_box_new (GTK_ORIENTATION_VERTICAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (wbox), FALSE);
gtk_widget_show (wbox);
wtoggle = gtk_check_button_new_with_label ("Show hidden files.");
F is the current frame.
PROMPT is a prompt to show to the user. May not be NULL.
DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
- If MUSTMATCH_P is non-zero, the returned file name must be an existing
+ If MUSTMATCH_P, the returned file name must be an existing
file. *FUNC is set to a function that can be used to retrieve the
selected file name from the returned widget.
xg_get_file_with_selection (FRAME_PTR f,
char *prompt,
char *default_filename,
- int mustmatch_p, int only_dir_p,
+ bool mustmatch_p, bool only_dir_p,
xg_get_file_func *func)
{
GtkWidget *filewin;
F is the current frame.
PROMPT is a prompt to show to the user. May not be NULL.
DEFAULT_FILENAME is a default selection to be displayed. May be NULL.
- If MUSTMATCH_P is non-zero, the returned file name must be an existing
+ If MUSTMATCH_P, the returned file name must be an existing
file.
Returns a file name or NULL if no file was selected.
xg_get_file_name (FRAME_PTR f,
char *prompt,
char *default_filename,
- int mustmatch_p,
- int only_dir_p)
+ bool mustmatch_p,
+ bool only_dir_p)
{
GtkWidget *w = 0;
char *fn = 0;
int filesel_done = 0;
xg_get_file_func func;
-#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN)
- /* I really don't know why this is needed, but without this the GLIBC add on
- library linuxthreads hangs when the Gnome file chooser backend creates
- threads. */
- sigblock (sigmask (__SIGRTMIN));
-#endif /* HAVE_PTHREAD */
-
#ifdef HAVE_GTK_FILE_SELECTION_NEW
if (xg_uses_old_file_dialog ())
gtk_widget_set_name (w, "emacs-filedialog");
filesel_done = xg_dialog_run (f, w);
-
-#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN)
- sigunblock (sigmask (__SIGRTMIN));
-#endif
-
if (filesel_done == GTK_RESPONSE_OK)
fn = (*func) (w);
return fn;
}
+/***********************************************************************
+ GTK font chooser
+ ***********************************************************************/
+
#ifdef HAVE_FREETYPE
+
+#if USE_NEW_GTK_FONT_CHOOSER
+
+#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;
+extern Lisp_Object Qxft;
+
/* 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:
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_chooser_dialog_new
+ ("Pick a font", GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
- 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);
+ 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 (c_isdigit (*ep))
+ ++ep;
+ if (*ep == '\0') *p = ' ';
+ }
+ }
+ else if (x_last_font_name)
+ default_name = x_last_font_name;
- gtk_widget_set_name (w, "emacs-fontdialog");
+ 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 (done == GTK_RESPONSE_OK)
+ {
+#if USE_NEW_GTK_FONT_CHOOSER
+ /* Use the GTK3 font chooser. */
+ PangoFontDescription *desc
+ = gtk_font_chooser_get_font_desc (GTK_FONT_CHOOSER (w));
-#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN)
- sigunblock (sigmask (__SIGRTMIN));
-#endif
+ if (desc)
+ {
+ Lisp_Object args[10];
+ 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);
- if (done == GTK_RESPONSE_OK)
- fontname = gtk_font_selection_dialog_get_font_name
- (GTK_FONT_SELECTION_DIALOG (w));
+ 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);
+
+ args[8] = QCtype;
+ args[9] = Qxft;
+
+ 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 */
{
if (! cl_data)
{
- cl_data = (xg_menu_cb_data*) xmalloc (sizeof (*cl_data));
+ cl_data = xmalloc (sizeof *cl_data);
cl_data->f = f;
cl_data->menu_bar_vector = f->menu_bar_vector;
cl_data->menu_bar_items_used = f->menu_bar_items_used;
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);
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);
+ }
+ }
+ }
}
GtkWidget *wkey;
GtkWidget *wbox;
- wbox = gtk_hbox_new (FALSE, 0);
+ wbox = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 0);
+ gtk_box_set_homogeneous (GTK_BOX (wbox), FALSE);
wlbl = gtk_label_new (utf8_label);
wkey = gtk_label_new (utf8_key);
static int xg_detached_menus;
-/* Returns non-zero if there are detached menus. */
+/* Return true if there are detached menus. */
-int
+bool
xg_have_tear_offs (void)
{
return xg_detached_menus > 0;
if (utf8_label) g_free (utf8_label);
if (utf8_key) g_free (utf8_key);
- cb_data = xmalloc (sizeof (xg_menu_item_cb_data));
+ cb_data = xmalloc (sizeof *cb_data);
xg_list_insert (&xg_menu_item_cb_list, &cb_data->ptrs);
SELECT_CB is the callback to use when a menu item is selected.
DEACTIVATE_CB is the callback to use when a sub menu is not shown anymore.
HIGHLIGHT_CB is the callback to call when entering/leaving menu items.
- POP_UP_P is non-zero if we shall create a popup menu.
- MENU_BAR_P is non-zero if we shall create a menu bar.
- ADD_TEAROFF_P is non-zero if we shall add a tearoff menu item. Ignored
- if MENU_BAR_P is non-zero.
+ If POP_UP_P, create a popup menu.
+ If MENU_BAR_P, create a menu bar.
+ If ADD_TEAROFF_P, add a tearoff menu item. Ignored if MENU_BAR_P.
TOPMENU is the topmost GtkWidget that others shall be placed under.
It may be NULL, in that case we create the appropriate widget
(menu bar or menu item depending on POP_UP_P and MENU_BAR_P)
GCallback select_cb,
GCallback deactivate_cb,
GCallback highlight_cb,
- int pop_up_p,
- int menu_bar_p,
- int add_tearoff_p,
+ bool pop_up_p,
+ bool menu_bar_p,
+ bool add_tearoff_p,
GtkWidget *topmenu,
xg_menu_cb_data *cl_data,
const char *name)
GCallback highlight_cb)
{
GtkWidget *w = 0;
- int menu_bar_p = strcmp (type, "menubar") == 0;
- int pop_up_p = strcmp (type, "popup") == 0;
+ bool menu_bar_p = strcmp (type, "menubar") == 0;
+ bool pop_up_p = strcmp (type, "popup") == 0;
if (strcmp (type, "dialog") == 0)
{
return gtk_label_get_label (wlabel);
}
-/* Return non-zero if the menu item WITEM has the text LABEL. */
+/* Return true if the menu item WITEM has the text LABEL. */
-static int
+static bool
xg_item_label_same_p (GtkMenuItem *witem, const char *label)
{
- int is_same = 0;
+ bool is_same = 0;
char *utf8_label = get_utf8_string (label);
const char *old_label = witem ? xg_get_menu_item_label (witem) : 0;
{
GtkMenuItem *witem = GTK_MENU_ITEM (iter->data);
GtkMenuItem *witem2 = 0;
- int val_in_menubar = 0;
- int iter_in_new_menubar = 0;
+ bool val_in_menubar = 0;
+ bool iter_in_new_menubar = 0;
GList *iter2;
widget_value *cur;
utf8_key = get_utf8_string (val->key);
/* See if W is a menu item with a key. See make_menu_item above. */
- if (GTK_IS_HBOX (wchild))
+ if (GTK_IS_BOX (wchild))
{
GList *list = gtk_container_get_children (GTK_CONTAINER (wchild));
GList *list = 0;
GList *iter;
widget_value *cur;
- int has_tearoff_p = 0;
+ bool has_tearoff_p = 0;
GList *first_radio = 0;
if (submenu)
/* Update the MENUBAR.
F is the frame the menu bar belongs to.
VAL describes the contents of the menu bar.
- If DEEP_P is non-zero, rebuild all but the top level menu names in
+ If DEEP_P, rebuild all but the top level menu names in
the MENUBAR. If DEEP_P is zero, just rebuild the names in the menubar.
SELECT_CB is the callback to use when a menu item is selected.
DEACTIVATE_CB is the callback to use when a sub menu is not shown anymore.
void
xg_modify_menubar_widgets (GtkWidget *menubar, FRAME_PTR f, widget_value *val,
- int deep_p,
+ bool deep_p,
GCallback select_cb, GCallback deactivate_cb,
GCallback highlight_cb)
{
}
/* Recompute all the widgets of frame F, when the menu bar has been
- changed. Value is non-zero if widgets were updated. */
+ changed. */
-int
+void
xg_update_frame_menubar (FRAME_PTR f)
{
struct x_output *x = f->output_data.x;
GtkRequisition req;
if (!x->menubar_widget || gtk_widget_get_mapped (x->menubar_widget))
- return 0;
+ return;
if (x->menubar_widget && gtk_widget_get_parent (x->menubar_widget))
- return 0; /* Already done this, happens for frames created invisible. */
+ return; /* Already done this, happens for frames created invisible. */
- BLOCK_INPUT;
+ block_input ();
gtk_box_pack_start (GTK_BOX (x->vbox_widget), x->menubar_widget,
FALSE, FALSE, 0);
FRAME_MENUBAR_HEIGHT (f) = req.height;
xg_height_or_width_changed (f);
}
- UNBLOCK_INPUT;
-
- return 1;
+ unblock_input ();
}
/* Get rid of the menu bar of frame F, and free its storage.
if (x->menubar_widget)
{
- BLOCK_INPUT;
+ block_input ();
gtk_container_remove (GTK_CONTAINER (x->vbox_widget), x->menubar_widget);
/* The menubar and its children shall be deleted when removed from
x->menubar_widget = 0;
FRAME_MENUBAR_HEIGHT (f) = 0;
xg_height_or_width_changed (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
-int
+bool
xg_event_is_for_menubar (FRAME_PTR f, XEvent *event)
{
struct x_output *x = f->output_data.x;
break;
}
g_list_free (list);
- return iter == 0 ? 0 : 1;
+ return iter != 0;
}
/* Setting scroll bar values invokes the callback. Use this variable
to indicate that callback should do nothing. */
-int xg_ignore_gtk_scrollbar;
+bool xg_ignore_gtk_scrollbar;
/* The width of the scroll bar for the current theme. */
}
/* Should never end up here */
- abort ();
+ emacs_abort ();
}
/* Remove pointer at IDX from id_to_widget.
int w = 0, b = 0;
vadj = gtk_adjustment_new (XG_SB_MIN, XG_SB_MIN, XG_SB_MAX, 0.1, 0.1, 0.1);
- wscroll = gtk_vscrollbar_new (GTK_ADJUSTMENT (vadj));
+ wscroll = gtk_scrollbar_new (GTK_ORIENTATION_VERTICAL, GTK_ADJUSTMENT (vadj));
g_object_ref_sink (G_OBJECT (wscroll));
gtk_widget_style_get (wscroll, "slider-width", &w, "trough-border", &b, NULL);
gtk_widget_destroy (wscroll);
vadj = gtk_adjustment_new (XG_SB_MIN, XG_SB_MIN, XG_SB_MAX,
0.1, 0.1, 0.1);
- wscroll = gtk_vscrollbar_new (GTK_ADJUSTMENT (vadj));
+ wscroll = gtk_scrollbar_new (GTK_ORIENTATION_VERTICAL, GTK_ADJUSTMENT (vadj));
webox = gtk_event_box_new ();
gtk_widget_set_name (wscroll, scroll_bar_name);
#ifndef HAVE_GTK3
int size, value;
int old_size;
int new_step;
- int changed = 0;
+ bool changed = 0;
adj = gtk_range_get_adjustment (GTK_RANGE (wscroll));
if (changed || int_gtk_range_get_value (GTK_RANGE (wscroll)) != value)
{
- BLOCK_INPUT;
+ block_input ();
/* gtk_range_set_value invokes the callback. Set
ignore_gtk_scrollbar to make the callback do nothing */
xg_ignore_gtk_scrollbar = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
}
-/* Return non-zero if EVENT is for a scroll bar in frame F.
+/* Return true if EVENT is for a scroll bar in frame F.
When the same X window is used for several Gtk+ widgets, we cannot
say for sure based on the X window alone if an event is for the
- frame. This function does additional checks.
+ frame. This function does additional checks. */
- Return non-zero if the event is for a scroll bar, zero otherwise. */
-
-int
+bool
xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event)
{
- int retval = 0;
+ bool retval = 0;
if (f && event->type == ButtonPress && event->xbutton.button < 4)
{
/* Check if press occurred outside the edit widget. */
GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f));
- retval = gdk_display_get_window_at_pointer (gdpy, NULL, NULL)
- != gtk_widget_get_window (f->output_data.x->edit_widget);
+ GdkWindow *gwin;
+#ifdef HAVE_GTK3
+ GdkDevice *gdev = gdk_device_manager_get_client_pointer
+ (gdk_display_get_device_manager (gdpy));
+ gwin = gdk_device_get_window_at_position (gdev, NULL, NULL);
+#else
+ gwin = gdk_display_get_window_at_pointer (gdpy, NULL, NULL);
+#endif
+ retval = gwin != gtk_widget_get_window (f->output_data.x->edit_widget);
}
else if (f
&& ((event->type == ButtonRelease && event->xbutton.button < 4)
else
{
fprintf (stderr, "internal error: GTK_IMAGE_PIXBUF failed\n");
- abort ();
+ emacs_abort ();
}
}
else if (store_type == GTK_IMAGE_ICON_NAME)
else
{
fprintf (stderr, "internal error: store_type is %d\n", store_type);
- abort ();
+ emacs_abort ();
}
}
if (wmenuimage)
xg_pack_tool_bar (FRAME_PTR f, Lisp_Object pos)
{
struct x_output *x = f->output_data.x;
- int into_hbox = EQ (pos, Qleft) || EQ (pos, Qright);
+ bool into_hbox = EQ (pos, Qleft) || EQ (pos, Qright);
toolbar_set_orientation (x->toolbar_widget,
into_hbox
}
else
{
- int vbox_pos = x->menubar_widget ? 1 : 0;
+ bool vbox_pos = x->menubar_widget != 0;
gtk_handle_box_set_handle_position (GTK_HANDLE_BOX (x->handlebox_widget),
GTK_POS_LEFT);
gtk_box_pack_start (GTK_BOX (x->vbox_widget), x->handlebox_widget,
xg_create_tool_bar (FRAME_PTR f)
{
struct x_output *x = f->output_data.x;
+#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;
gtk_toolbar_set_style (GTK_TOOLBAR (x->toolbar_widget), GTK_TOOLBAR_ICONS);
toolbar_set_orientation (x->toolbar_widget, GTK_ORIENTATION_HORIZONTAL);
+#if GTK_CHECK_VERSION (3, 3, 6)
+ gsty = gtk_widget_get_style_context (x->toolbar_widget);
+ gtk_style_context_add_class (gsty, "primary-toolbar");
+#endif
}
{
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;
GtkWidget *wimage,
GtkWidget **wbutton,
const char *label,
- int i, int horiz, int text_image)
+ int i, bool horiz, bool text_image)
{
GtkToolItem *ti = gtk_tool_item_new ();
- GtkWidget *vb = horiz ? gtk_hbox_new (FALSE, 0) : gtk_vbox_new (FALSE, 0);
+ GtkWidget *vb = gtk_box_new (horiz
+ ? GTK_ORIENTATION_HORIZONTAL
+ : GTK_ORIENTATION_VERTICAL,
+ 0);
GtkWidget *wb = gtk_button_new ();
/* The eventbox is here so we can have tooltips on disabled items. */
GtkWidget *weventbox = gtk_event_box_new ();
+#if GTK_CHECK_VERSION (3, 3, 6)
+ GtkCssProvider *css_prov = gtk_css_provider_new ();
+ GtkStyleContext *gsty;
+
+ gtk_css_provider_load_from_data (css_prov,
+ "GtkEventBox {"
+ " background-color: transparent;"
+ "}",
+ -1, NULL);
+
+ gsty = gtk_widget_get_style_context (weventbox);
+ gtk_style_context_add_provider (gsty,
+ GTK_STYLE_PROVIDER (css_prov),
+ GTK_STYLE_PROVIDER_PRIORITY_USER);
+ g_object_unref (css_prov);
+#endif
+
+ gtk_box_set_homogeneous (GTK_BOX (vb), FALSE);
if (wimage && !text_image)
gtk_box_pack_start (GTK_BOX (vb), wimage, TRUE, TRUE, 0);
rather than the GtkButton specific signals "enter" and
"leave", so we can have only one callback. The event
will tell us what kind of event it is. */
- /* The EMACS_INT cast avoids a warning. */
g_signal_connect (G_OBJECT (weventbox),
"enter-notify-event",
G_CALLBACK (xg_tool_bar_help_callback),
return ti;
}
-static int
+static bool
+is_box_type (GtkWidget *vb, bool is_horizontal)
+{
+#ifdef HAVE_GTK3
+ bool ret = 0;
+ if (GTK_IS_BOX (vb))
+ {
+ GtkOrientation ori = gtk_orientable_get_orientation (GTK_ORIENTABLE (vb));
+ ret = (ori == GTK_ORIENTATION_HORIZONTAL && is_horizontal)
+ || (ori == GTK_ORIENTATION_VERTICAL && ! is_horizontal);
+ }
+ return ret;
+#else
+ return is_horizontal ? GTK_IS_VBOX (vb) : GTK_IS_HBOX (vb);
+#endif
+}
+
+
+static bool
xg_tool_item_stale_p (GtkWidget *wbutton, const char *stock_name,
const char *icon_name, const struct image *img,
- const char *label, int horiz)
+ const char *label, bool horiz)
{
gpointer old;
GtkWidget *wimage;
else if (wimage)
{
gpointer gold_img = g_object_get_data (G_OBJECT (wimage),
- XG_TOOL_BAR_IMAGE_DATA);
+ XG_TOOL_BAR_IMAGE_DATA);
Pixmap old_img = (Pixmap) gold_img;
if (old_img != img->pixmap)
return 1;
}
/* Check button configuration and label. */
- if ((horiz ? GTK_IS_VBOX (vb) : GTK_IS_HBOX (vb))
+ if (is_box_type (vb, horiz)
|| (label ? (wlbl == NULL) : (wlbl != NULL)))
return 1;
return 0;
}
-static int
+static bool
xg_update_tool_bar_sizes (FRAME_PTR f)
{
struct x_output *x = f->output_data.x;
GtkToolbar *wtoolbar;
GtkToolItem *ti;
GtkTextDirection dir;
- int pack_tool_bar = x->handlebox_widget == NULL;
+ bool pack_tool_bar = x->handlebox_widget == NULL;
Lisp_Object style;
- int text_image, horiz;
+ bool text_image, horiz;
+ struct xg_frame_tb_info *tbinfo;
if (! FRAME_GTK_WIDGET (f))
return;
- BLOCK_INPUT;
+ block_input ();
- if (INTEGERP (Vtool_bar_button_margin)
- && XINT (Vtool_bar_button_margin) > 0)
+ if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
{
hmargin = XFASTINT (Vtool_bar_button_margin);
vmargin = XFASTINT (Vtool_bar_button_margin);
}
else if (CONSP (Vtool_bar_button_margin))
{
- if (INTEGERP (XCAR (Vtool_bar_button_margin))
- && XINT (XCAR (Vtool_bar_button_margin)) > 0)
+ if (RANGED_INTEGERP (1, XCAR (Vtool_bar_button_margin), INT_MAX))
hmargin = XFASTINT (XCAR (Vtool_bar_button_margin));
- if (INTEGERP (XCDR (Vtool_bar_button_margin))
- && XINT (XCDR (Vtool_bar_button_margin)) > 0)
+ if (RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
vmargin = XFASTINT (XCDR (Vtool_bar_button_margin));
}
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;
for (i = j = 0; i < f->n_tool_bar_items; ++i)
{
- int enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P));
- int selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P));
+ bool enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P));
+ bool selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P));
int idx;
ptrdiff_t img_id;
int icon_size = 0;
Lisp_Object rtl;
GtkWidget *wbutton = NULL;
Lisp_Object specified_file;
- int vert_only = ! NILP (PROP (TOOL_BAR_ITEM_VERT_ONLY));
+ bool vert_only = ! NILP (PROP (TOOL_BAR_ITEM_VERT_ONLY));
const char *label
= (EQ (style, Qimage) || (vert_only && horiz)) ? NULL
: STRINGP (PROP (TOOL_BAR_ITEM_LABEL))
? TOOL_BAR_IMAGE_DISABLED_SELECTED
: TOOL_BAR_IMAGE_DISABLED_DESELECTED);
- xassert (ASIZE (image) >= idx);
+ eassert (ASIZE (image) >= idx);
image = AREF (image, idx);
}
else
xg_height_or_width_changed (f);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Deallocate all resources for the tool bar on frame F.
if (x->toolbar_widget)
{
- int is_packed = x->handlebox_widget != 0;
- BLOCK_INPUT;
+ struct xg_frame_tb_info *tbinfo;
+ bool is_packed = x->handlebox_widget != 0;
+ block_input ();
/* We may have created the toolbar_widget in xg_create_tool_bar, but
not the x->handlebox_widget which is created in xg_pack_tool_bar. */
if (is_packed)
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;
+ unblock_input ();
}
}
-int
+void
xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos)
{
struct x_output *x = f->output_data.x;
if (! x->toolbar_widget || ! x->handlebox_widget)
- return 1;
+ return;
- BLOCK_INPUT;
+ block_input ();
g_object_ref (x->handlebox_widget);
if (x->toolbar_in_hbox)
gtk_container_remove (GTK_CONTAINER (x->hbox_widget),
if (xg_update_tool_bar_sizes (f))
xg_height_or_width_changed (f);
- UNBLOCK_INPUT;
- return 1;
+ unblock_input ();
}
xg_initialize (void)
{
GtkBindingSet *binding_set;
+ GtkSettings *settings;
#if HAVE_XFT
/* Work around a bug with corrupted data if libXft gets unloaded. This way
id_to_widget.max_size = id_to_widget.used = 0;
id_to_widget.widgets = 0;
+ settings = gtk_settings_get_for_screen (gdk_display_get_default_screen
+ (gdk_display_get_default ()));
/* Remove F10 as a menu accelerator, it does not mix well with Emacs key
bindings. It doesn't seem to be any way to remove properties,
so we set it to VoidSymbol which in X means "no key". */
- gtk_settings_set_string_property (gtk_settings_get_default (),
+ gtk_settings_set_string_property (settings,
"gtk-menu-bar-accel",
"VoidSymbol",
EMACS_CLASS);
/* Make GTK text input widgets use Emacs style keybindings. This is
Emacs after all. */
- gtk_settings_set_string_property (gtk_settings_get_default (),
+ gtk_settings_set_string_property (settings,
"gtk-key-theme-name",
"Emacs",
EMACS_CLASS);
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 */
#include <gtk/gtk.h>
#include "frame.h"
+#include "xterm.h"
/* Minimum and maximum values used for GTK scroll bars */
} xg_menu_item_cb_data;
-
-#ifdef HAVE_GTK_FILE_SELECTION_NEW
-extern int use_old_gtk_file_dialog;
-#endif
struct _widget_value;
extern struct _widget_value *malloc_widget_value (void);
extern void free_widget_value (struct _widget_value *);
-extern int xg_uses_old_file_dialog (void);
+extern bool xg_uses_old_file_dialog (void) ATTRIBUTE_CONST;
extern char *xg_get_file_name (FRAME_PTR f,
char *prompt,
char *default_filename,
- int mustmatch_p,
- int only_dir_p);
+ bool mustmatch_p,
+ bool 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,
extern void xg_modify_menubar_widgets (GtkWidget *menubar,
FRAME_PTR f,
struct _widget_value *val,
- int deep_p,
+ bool deep_p,
GCallback select_cb,
GCallback deactivate_cb,
GCallback highlight_cb);
-extern int xg_update_frame_menubar (FRAME_PTR f);
+extern void xg_update_frame_menubar (FRAME_PTR f);
-extern int xg_event_is_for_menubar (FRAME_PTR f, XEvent *event);
+extern bool xg_event_is_for_menubar (FRAME_PTR f, XEvent *event);
-extern int xg_have_tear_offs (void);
+extern bool xg_have_tear_offs (void);
extern ptrdiff_t xg_get_scroll_id_for_window (Display *dpy, Window wid);
int portion,
int position,
int whole);
-extern int xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event);
+extern bool xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event);
extern int xg_get_default_scrollbar_width (void);
extern void update_frame_tool_bar (FRAME_PTR f);
extern void free_frame_tool_bar (FRAME_PTR f);
-extern int xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos);
+extern void xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos);
extern void xg_frame_resized (FRAME_PTR f,
int pixelwidth,
extern void xg_display_close (Display *dpy);
extern GdkCursor * xg_create_default_cursor (Display *dpy);
-extern int xg_create_frame_widgets (FRAME_PTR f);
+extern bool xg_create_frame_widgets (FRAME_PTR f);
extern void xg_free_frame_widgets (FRAME_PTR f);
-extern void x_wm_set_size_hint (FRAME_PTR f,
- long flags,
- int user_position);
extern void xg_set_background_color (FRAME_PTR f, unsigned long bg);
-extern int xg_check_special_colors (struct frame *f,
- const char *color_name,
- XColor *color);
+extern bool xg_check_special_colors (struct frame *f,
+ const char *color_name,
+ XColor *color);
extern void xg_set_frame_icon (FRAME_PTR f,
Pixmap icon_pixmap,
Pixmap icon_mask);
-extern int xg_prepare_tooltip (FRAME_PTR f,
- Lisp_Object string,
- int *width,
- int *height);
+extern bool xg_prepare_tooltip (FRAME_PTR f,
+ Lisp_Object string,
+ int *width,
+ int *height);
extern void xg_show_tooltip (FRAME_PTR f, int root_x, int root_y);
-extern int xg_hide_tooltip (FRAME_PTR f);
+extern bool xg_hide_tooltip (FRAME_PTR f);
/* Mark all callback data that are Lisp_object:s during GC. */
/* Setting scrollbar values invokes the callback. Use this variable
to indicate that the callback should do nothing. */
-extern int xg_ignore_gtk_scrollbar;
+extern bool xg_ignore_gtk_scrollbar;
#endif /* USE_GTK */
#endif /* GTKUTIL_H */
/* Functions for image support on window system.
- Copyright (C) 1989, 1992-2012 Free Software Foundation, Inc.
+
+Copyright (C) 1989, 1992-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include <stdio.h>
-#include <math.h>
-#include <ctype.h>
#include <unistd.h>
#ifdef HAVE_PNG
#include <setjmp.h>
+#include <c-ctype.h>
+
/* This makes the fields of a Display accessible, in Xlib header files. */
#define XLIB_ILLEGAL_ACCESS
#include "termhooks.h"
#include "font.h"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#include <sys/types.h>
+#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
+#endif /* HAVE_SYS_STAT_H */
+
+#ifdef HAVE_SYS_TYPES_H
+#include <sys/types.h>
+#endif /* HAVE_SYS_TYPES_H */
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
+
+#ifdef HAVE_X_WINDOWS
#define COLOR_TABLE_SUPPORT 1
typedef struct x_bitmap_record Bitmap_Record;
#define PIX_MASK_DRAW 1
#endif /* HAVE_X_WINDOWS */
-
#ifdef HAVE_NTGUI
#include "w32.h"
-#include "w32term.h"
-
/* W32_TODO : Color tables on W32. */
#undef COLOR_TABLE_SUPPORT
#define PIX_MASK_RETAIN 0
#define PIX_MASK_DRAW 1
-#define FRAME_X_VISUAL(f) FRAME_X_DISPLAY_INFO (f)->visual
#define x_defined_color w32_defined_color
#define DefaultDepthOfScreen(screen) (one_w32_display_info.n_cbits)
-/* Functions from w32term.c that depend on XColor (so can't go in w32term.h
- without modifying lots of files). */
-extern void x_query_colors (struct frame *f, XColor *colors, int ncolors);
-extern void x_query_color (struct frame *f, XColor *color);
-
/* Version of libpng that we were compiled with, or -1 if no PNG
support was compiled in. This is tested by w32-win.el to correctly
set up the alist used to search for PNG libraries. */
#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
-#include "nsterm.h"
-#include <sys/types.h>
-#include <sys/stat.h>
-
#undef COLOR_TABLE_SUPPORT
typedef struct ns_bitmap_record Bitmap_Record;
#define PIX_MASK_RETAIN 0
#define PIX_MASK_DRAW 1
-#define FRAME_X_VISUAL FRAME_NS_DISPLAY_INFO (f)->visual
#define x_defined_color(f, name, color_def, alloc) \
ns_defined_color (f, name, color_def, alloc, 0)
-#define FRAME_X_SCREEN(f) 0
#define DefaultDepthOfScreen(screen) x_display_list->n_planes
#endif /* HAVE_NS */
static void free_color_table (void);
static unsigned long *colors_in_color_table (int *n);
#endif
-static Lisp_Object Finit_image_library (Lisp_Object, Lisp_Object);
/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
id, which is just an int that this section returns. Bitmaps are
id = x_allocate_bitmap_record (f);
dpyinfo->bitmaps[id - 1].img = bitmap;
dpyinfo->bitmaps[id - 1].refcount = 1;
- dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (SBYTES (file) + 1);
+ dpyinfo->bitmaps[id - 1].file = xmalloc (SBYTES (file) + 1);
dpyinfo->bitmaps[id - 1].depth = 1;
dpyinfo->bitmaps[id - 1].height = ns_image_width (bitmap);
dpyinfo->bitmaps[id - 1].width = ns_image_height (bitmap);
- strcpy (dpyinfo->bitmaps[id - 1].file, SDATA (file));
+ strcpy (dpyinfo->bitmaps[id - 1].file, SSDATA (file));
return id;
#endif
dpyinfo->bitmaps[id - 1].pixmap = bitmap;
dpyinfo->bitmaps[id - 1].have_mask = 0;
dpyinfo->bitmaps[id - 1].refcount = 1;
- dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (SBYTES (file) + 1);
+ dpyinfo->bitmaps[id - 1].file = xmalloc (SBYTES (file) + 1);
dpyinfo->bitmaps[id - 1].depth = 1;
dpyinfo->bitmaps[id - 1].height = height;
dpyinfo->bitmaps[id - 1].width = width;
if (--bm->refcount == 0)
{
- BLOCK_INPUT;
+ block_input ();
free_bitmap_record (dpyinfo, bm);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
}
dpyinfo->bitmaps_last = 0;
}
+static bool x_create_x_image_and_pixmap (struct frame *, int, int, int,
+ XImagePtr *, Pixmap *);
+static void x_destroy_x_image (XImagePtr ximg);
#ifdef HAVE_X_WINDOWS
unsigned long width,
unsigned long height);
-static int x_create_x_image_and_pixmap (struct frame *f, int width, int height,
- int depth, XImagePtr *ximg,
- Pixmap *pixmap);
-
-static void x_destroy_x_image (XImagePtr ximg);
-
/* Create a mask of a bitmap. Note is this not a perfect mask.
It's nicer with some borders in this context */
-int
+void
x_create_bitmap_mask (struct frame *f, ptrdiff_t id)
{
Pixmap pixmap, mask;
XImagePtr ximg, mask_img;
unsigned long width, height;
- int result;
+ bool result;
unsigned long bg;
unsigned long x, y, xp, xm, yp, ym;
GC gc;
Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
if (!(id > 0))
- return -1;
+ return;
pixmap = x_bitmap_pixmap (f, id);
width = x_bitmap_width (f, id);
height = x_bitmap_height (f, id);
- BLOCK_INPUT;
+ block_input ();
ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height,
~0, ZPixmap);
if (!ximg)
{
- UNBLOCK_INPUT;
- return -1;
+ unblock_input ();
+ return;
}
result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask);
- UNBLOCK_INPUT;
+ unblock_input ();
if (!result)
{
XDestroyImage (ximg);
- return -1;
+ return;
}
bg = four_corners_best (ximg, NULL, width, height);
}
}
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL);
XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0,
width, height);
XDestroyImage (ximg);
x_destroy_x_image (mask_img);
-
- return 0;
}
#endif /* HAVE_X_WINDOWS */
static Lisp_Object Qcount, Qextension_data, Qdelay;
static Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
-/* Function prototypes. */
+/* Forward function prototypes. */
-static Lisp_Object define_image_type (struct image_type *type, int loaded);
-static struct image_type *lookup_image_type (Lisp_Object symbol);
-static void image_error (const char *format, Lisp_Object, Lisp_Object);
+static struct image_type *lookup_image_type (Lisp_Object);
static void x_laplace (struct frame *, struct image *);
static void x_emboss (struct frame *, struct image *);
-static int x_build_heuristic_mask (struct frame *, struct image *,
- Lisp_Object);
+static void x_build_heuristic_mask (struct frame *, struct image *,
+ Lisp_Object);
#ifdef HAVE_NTGUI
#define CACHE_IMAGE_TYPE(type, status) \
do { Vlibrary_cache = Fcons (Fcons (type, status), Vlibrary_cache); } while (0)
/* Define a new image type from TYPE. This adds a copy of TYPE to
image_types and caches the loading status of TYPE. */
-static Lisp_Object
-define_image_type (struct image_type *type, int loaded)
+static struct image_type *
+define_image_type (struct image_type *type)
{
- Lisp_Object success;
+ struct image_type *p = NULL;
+ Lisp_Object target_type = *type->type;
+ bool type_valid = 1;
- if (!loaded)
- success = Qnil;
- else
+ block_input ();
+
+ for (p = image_types; p; p = p->next)
+ if (EQ (*p->type, target_type))
+ goto done;
+
+ if (type->init)
{
- struct image_type *p;
- Lisp_Object target_type = *(type->type);
- for (p = image_types; p; p = p->next)
- if (EQ (*(p->type), target_type))
- return Qt;
+#ifdef HAVE_NTGUI
+ /* If we failed to load the library before, don't try again. */
+ Lisp_Object tested = Fassq (target_type, Vlibrary_cache);
+ if (CONSP (tested) && NILP (XCDR (tested)))
+ type_valid = 0;
+ else
+#endif
+ {
+ type_valid = type->init ();
+ CACHE_IMAGE_TYPE (target_type, type_valid ? Qt : Qnil);
+ }
+ }
+ if (type_valid)
+ {
/* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
The initialized data segment is read-only. */
- p = (struct image_type *) xmalloc (sizeof *p);
- memcpy (p, type, sizeof *p);
+ p = xmalloc (sizeof *p);
+ *p = *type;
p->next = image_types;
image_types = p;
- success = Qt;
}
- CACHE_IMAGE_TYPE (*type->type, success);
- return success;
-}
-
-
-/* Look up image type SYMBOL, and return a pointer to its image_type
- structure. Value is null if SYMBOL is not a known image type. */
-
-static inline struct image_type *
-lookup_image_type (Lisp_Object symbol)
-{
- struct image_type *type;
-
- /* We must initialize the image-type if it hasn't been already. */
- if (NILP (Finit_image_library (symbol, Vdynamic_library_alist)))
- return 0; /* unimplemented */
-
- for (type = image_types; type; type = type->next)
- if (EQ (symbol, *type->type))
- break;
-
- return type;
+ done:
+ unblock_input ();
+ return p;
}
-/* Value is non-zero if OBJECT is a valid Lisp image specification. A
+/* Value is true if OBJECT is a valid Lisp image specification. A
valid image specification is a list whose car is the symbol
`image', and whose rest is a property list. The property list must
contain a value for key `:type'. That value must be the name of a
supported image type. The rest of the property list depends on the
image type. */
-int
+bool
valid_image_p (Lisp_Object object)
{
- int valid_p = 0;
+ bool valid_p = 0;
if (IMAGEP (object))
{
/* The type of value allowed. */
enum image_value_type type;
- /* Non-zero means key must be present. */
- int mandatory_p;
+ /* True means key must be present. */
+ bool mandatory_p;
/* Used to recognize duplicate keywords in a property list. */
int count;
};
-static int parse_image_spec (Lisp_Object, struct image_keyword *,
- int, Lisp_Object);
-static Lisp_Object image_spec_value (Lisp_Object, Lisp_Object, int *);
-
-
/* Parse image spec SPEC according to KEYWORDS. A valid image spec
has the format (image KEYWORD VALUE ...). One of the keyword/
value pairs must be `:type TYPE'. KEYWORDS is a vector of
image_keywords structures of size NKEYWORDS describing other
- allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
+ allowed keyword/value pairs. Value is true if SPEC is valid. */
-static int
+static bool
parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
int nkeywords, Lisp_Object type)
{
/* Record that we recognized the keyword. If a keywords
was found more than once, it's an error. */
keywords[i].value = value;
- ++keywords[i].count;
-
if (keywords[i].count > 1)
return 0;
+ ++keywords[i].count;
/* Check type of value against allowed type. */
switch (keywords[i].type)
break;
default:
- abort ();
+ emacs_abort ();
break;
}
/* Return the value of KEY in image specification SPEC. Value is nil
- if KEY is not present in SPEC. if FOUND is not null, set *FOUND
- to 1 if KEY was found in SPEC, set it to 0 otherwise. */
+ if KEY is not present in SPEC. Set *FOUND depending on whether KEY
+ was found in SPEC. */
static Lisp_Object
-image_spec_value (Lisp_Object spec, Lisp_Object key, int *found)
+image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found)
{
Lisp_Object tail;
- xassert (valid_image_p (spec));
+ eassert (valid_image_p (spec));
for (tail = XCDR (spec);
CONSP (tail) && CONSP (XCDR (tail));
Image type independent image structures
***********************************************************************/
-static void free_image (struct frame *f, struct image *img);
-
#define MAX_IMAGE_SIZE 10.0
/* Allocate and return a new image structure for image specification
SPEC. SPEC has a hash value of HASH. */
static struct image *
make_image (Lisp_Object spec, EMACS_UINT hash)
{
- struct image *img = (struct image *) xmalloc (sizeof *img);
+ struct image *img = xzalloc (sizeof *img);
Lisp_Object file = image_spec_value (spec, QCfile, NULL);
- xassert (valid_image_p (spec));
- memset (img, 0, sizeof *img);
+ eassert (valid_image_p (spec));
img->dependencies = NILP (file) ? Qnil : list1 (file);
img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
- xassert (img->type != NULL);
+ eassert (img->type != NULL);
img->spec = spec;
img->lisp_data = Qnil;
img->ascent = DEFAULT_IMAGE_ASCENT;
}
}
-/* Return 1 if the given widths and heights are valid for display;
- otherwise, return 0. */
+/* Return true if the given widths and heights are valid for display. */
-static int
+static bool
check_image_size (struct frame *f, int width, int height)
{
int w, h;
void
prepare_image_for_display (struct frame *f, struct image *img)
{
- EMACS_TIME t;
-
/* We're about to display IMG, so set its timestamp to `now'. */
- EMACS_GET_TIME (t);
- img->timestamp = EMACS_SECS (t);
+ img->timestamp = current_emacs_time ();
/* If IMG doesn't have a pixmap yet, load it now, using the image
type dependent loader function. */
if (img->pixmap == NO_PIXMAP && !img->load_failed_p)
- img->load_failed_p = img->type->load (f, img) == 0;
+ img->load_failed_p = ! img->type->load (f, img);
}
if (! img->background_valid)
/* IMG doesn't have a background yet, try to guess a reasonable value. */
{
- int free_ximg = !ximg;
+ bool free_ximg = !ximg;
#ifdef HAVE_NTGUI
HGDIOBJ prev;
#endif /* HAVE_NTGUI */
{
if (img->mask)
{
- int free_mask = !mask;
+ bool free_mask = !mask;
#ifdef HAVE_NTGUI
HGDIOBJ prev;
#endif /* HAVE_NTGUI */
Helper functions for X image types
***********************************************************************/
-static void x_clear_image_1 (struct frame *, struct image *, int,
- int, int);
-static void x_clear_image (struct frame *f, struct image *img);
-static unsigned long x_alloc_image_color (struct frame *f,
- struct image *img,
- Lisp_Object color_name,
- unsigned long dflt);
-
-
-/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
- free the pixmap if any. MASK_P non-zero means clear the mask
- pixmap if any. COLORS_P non-zero means free colors allocated for
- the image, if any. */
+/* Clear X resources of image IMG on frame F. PIXMAP_P means free the
+ pixmap if any. MASK_P means clear the mask pixmap if any.
+ COLORS_P means free colors allocated for the image, if any. */
static void
-x_clear_image_1 (struct frame *f, struct image *img, int pixmap_p, int mask_p,
- int colors_p)
+x_clear_image_1 (struct frame *f, struct image *img, bool pixmap_p,
+ bool mask_p, bool colors_p)
{
if (pixmap_p && img->pixmap)
{
static void
x_clear_image (struct frame *f, struct image *img)
{
- BLOCK_INPUT;
+ block_input ();
x_clear_image_1 (f, img, 1, 1, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
}
XColor color;
unsigned long result;
- xassert (STRINGP (color_name));
+ eassert (STRINGP (color_name));
if (x_defined_color (f, SSDATA (color_name), &color, 1)
&& img->ncolors < min (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *img->colors,
/* This isn't called frequently so we get away with simply
reallocating the color vector to the needed size, here. */
ptrdiff_t ncolors = img->ncolors + 1;
- img->colors =
- (unsigned long *) xrealloc (img->colors,
- ncolors * sizeof *img->colors);
+ img->colors = xrealloc (img->colors, ncolors * sizeof *img->colors);
img->colors[ncolors - 1] = color.pixel;
img->ncolors = ncolors;
result = color.pixel;
***********************************************************************/
static void cache_image (struct frame *f, struct image *img);
-static void postprocess_image (struct frame *, struct image *);
/* Return a new, initialized image cache that is allocated from the
heap. Call free_image_cache to free an image cache. */
struct image_cache *
make_image_cache (void)
{
- struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
+ struct image_cache *c = xzalloc (sizeof *c);
int size;
- memset (c, 0, sizeof *c);
size = 50;
- c->images = (struct image **) xmalloc (size * sizeof *c->images);
+ c->images = xmalloc (size * sizeof *c->images);
c->size = size;
size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
- c->buckets = (struct image **) xmalloc (size);
- memset (c->buckets, 0, size);
+ c->buckets = xzalloc (size);
return c;
}
ptrdiff_t i;
/* Cache should not be referenced by any frame when freed. */
- xassert (c->refcount == 0);
+ eassert (c->refcount == 0);
for (i = 0; i < c->used; ++i)
free_image (f, c->images[i]);
/* Block input so that we won't be interrupted by a SIGIO
while being in an inconsistent state. */
- BLOCK_INPUT;
+ block_input ();
if (!NILP (filter))
{
else if (INTEGERP (Vimage_cache_eviction_delay))
{
/* Free cache based on timestamp. */
- EMACS_TIME t;
- double old, delay;
+ EMACS_TIME old, t;
+ double delay;
ptrdiff_t nimages = 0;
for (i = 0; i < c->used; ++i)
delay = 1600 * delay / nimages / nimages;
delay = max (delay, 1);
- EMACS_GET_TIME (t);
- old = EMACS_SECS (t) - delay;
+ t = current_emacs_time ();
+ old = sub_emacs_time (t, EMACS_TIME_FROM_DOUBLE (delay));
for (i = 0; i < c->used; ++i)
{
struct image *img = c->images[i];
- if (img && img->timestamp < old)
+ if (img && EMACS_TIME_LT (img->timestamp, old))
{
free_image (f, img);
++nfreed;
++windows_or_buffers_changed;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
x_build_heuristic_mask (f, img, mask);
else
{
- int found_p;
+ bool found_p;
mask = image_spec_value (spec, QCmask, &found_p);
{
struct image *img;
EMACS_UINT hash;
- EMACS_TIME now;
/* F must be a window-system frame, and SPEC must be a valid image
specification. */
- xassert (FRAME_WINDOW_P (f));
- xassert (valid_image_p (spec));
+ eassert (FRAME_WINDOW_P (f));
+ eassert (valid_image_p (spec));
/* Look up SPEC in the hash table of the image cache. */
hash = sxhash (spec, 0);
/* If not found, create a new image and cache it. */
if (img == NULL)
{
- BLOCK_INPUT;
+ block_input ();
img = make_image (spec, hash);
cache_image (f, img);
- img->load_failed_p = img->type->load (f, img) == 0;
+ img->load_failed_p = ! img->type->load (f, img);
img->frame_foreground = FRAME_FOREGROUND_PIXEL (f);
img->frame_background = FRAME_BACKGROUND_PIXEL (f);
`:ascent ASCENT', `:margin MARGIN', `:relief RELIEF',
`:background COLOR'. */
Lisp_Object ascent, margin, relief, bg;
+ int relief_bound;
ascent = image_spec_value (spec, QCascent, NULL);
if (INTEGERP (ascent))
}
relief = image_spec_value (spec, QCrelief, NULL);
- if (INTEGERP (relief))
+ relief_bound = INT_MAX - max (img->hmargin, img->vmargin);
+ if (RANGED_INTEGERP (- relief_bound, relief, relief_bound))
{
img->relief = XINT (relief);
img->hmargin += eabs (img->relief);
postprocess_image (f, img);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* We're using IMG, so set its timestamp to `now'. */
- EMACS_GET_TIME (now);
- img->timestamp = EMACS_SECS (now);
+ img->timestamp = current_emacs_time ();
/* Value is the image id. */
return img->id;
#endif /* HAVE_NTGUI */
-static int x_create_x_image_and_pixmap (struct frame *, int, int, int,
- XImagePtr *, Pixmap *);
-static void x_destroy_x_image (XImagePtr);
-static void x_put_x_image (struct frame *, XImagePtr, Pixmap, int, int);
-
-/* Return nonzero if XIMG's size WIDTH x HEIGHT doesn't break the
+/* Return true if XIMG's size WIDTH x HEIGHT doesn't break the
windowing system.
WIDTH and HEIGHT must both be positive.
If XIMG is null, assume it is a bitmap. */
-static int
+static bool
x_check_image_size (XImagePtr ximg, int width, int height)
{
#ifdef HAVE_X_WINDOWS
frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
via xmalloc. Print error messages via image_error if an error
- occurs. Value is non-zero if successful.
+ occurs. Value is true if successful.
On W32, a DEPTH of zero signifies a 24 bit image, otherwise DEPTH
should indicate the bit depth of the image. */
-static int
+static bool
x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
XImagePtr *ximg, Pixmap *pixmap)
{
Window window = FRAME_X_WINDOW (f);
Screen *screen = FRAME_X_SCREEN (f);
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
if (depth <= 0)
depth = DefaultDepthOfScreen (screen);
}
/* Allocate image raster. */
- (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
+ (*ximg)->data = xmalloc ((*ximg)->bytes_per_line * height);
/* Allocate a pixmap of the same size. */
*pixmap = XCreatePixmap (display, window, width, height, depth);
static void
x_destroy_x_image (XImagePtr ximg)
{
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
if (ximg)
{
#ifdef HAVE_X_WINDOWS
#ifdef HAVE_X_WINDOWS
GC gc;
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
XFreeGC (FRAME_X_DISPLAY (f), gc);
#endif /* HAVE_NTGUI */
#ifdef HAVE_NS
- xassert (ximg == pixmap);
+ eassert (ximg == pixmap);
ns_retain_object (ximg);
#endif
}
if (stat (file, &st) == 0
&& (fp = fopen (file, "rb")) != NULL
&& 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX)
- && (buf = (unsigned char *) xmalloc (st.st_size),
+ && (buf = xmalloc (st.st_size),
fread (buf, 1, st.st_size, fp) == st.st_size))
{
*size = st.st_size;
XBM images
***********************************************************************/
-static int xbm_scan (unsigned char **, unsigned char *, char *, int *);
-static int xbm_load (struct frame *f, struct image *img);
-static int xbm_load_image (struct frame *f, struct image *img,
- unsigned char *, unsigned char *);
-static int xbm_image_p (Lisp_Object object);
-static int xbm_read_bitmap_data (struct frame *f,
- unsigned char *, unsigned char *,
- int *, int *, char **, int);
-static int xbm_file_p (Lisp_Object);
+static bool xbm_load (struct frame *f, struct image *img);
+static bool xbm_image_p (Lisp_Object object);
+static bool xbm_file_p (Lisp_Object);
/* Indices of image specification fields in xbm_format, below. */
xbm_image_p,
xbm_load,
x_clear_image,
+ NULL,
NULL
};
};
-/* Return non-zero if OBJECT is a valid XBM-type image specification.
+/* Return true if OBJECT is a valid XBM-type image specification.
A valid specification is a list starting with the symbol `image'
The rest of the list is a property list which must contain an
- entry `:type xbm..
+ entry `:type xbm'.
If the specification specifies a file to load, it must contain
an entry `:file FILENAME' where FILENAME is a string.
foreground and background of the frame on which the image is
displayed is used. */
-static int
+static bool
xbm_image_p (Lisp_Object object)
{
struct image_keyword kw[XBM_LAST];
if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
return 0;
- xassert (EQ (kw[XBM_TYPE].value, Qxbm));
+ eassert (EQ (kw[XBM_TYPE].value, Qxbm));
if (kw[XBM_FILE].count)
{
for one line of the image. */
for (i = 0; i < height; ++i)
{
- Lisp_Object elt = XVECTOR (data)->contents[i];
+ Lisp_Object elt = AREF (data, i);
if (STRINGP (elt))
{
loop:
/* Skip white space. */
- while (*s < end && (c = *(*s)++, isspace (c)))
+ while (*s < end && (c = *(*s)++, c_isspace (c)))
;
if (*s >= end)
c = 0;
- else if (isdigit (c))
+ else if (c_isdigit (c))
{
int value = 0, digit;
while (*s < end)
{
c = *(*s)++;
- if (isdigit (c))
+ if (c_isdigit (c))
digit = c - '0';
else if (c >= 'a' && c <= 'f')
digit = c - 'a' + 10;
value = 16 * value + digit;
}
}
- else if (isdigit (c))
+ else if (c_isdigit (c))
{
value = c - '0';
while (*s < end
- && (c = *(*s)++, isdigit (c)))
+ && (c = *(*s)++, c_isdigit (c)))
value = 8 * value + c - '0';
}
}
{
value = c - '0';
while (*s < end
- && (c = *(*s)++, isdigit (c)))
+ && (c = *(*s)++, c_isdigit (c)))
value = 10 * value + c - '0';
}
*ival = value;
c = XBM_TK_NUMBER;
}
- else if (isalpha (c) || c == '_')
+ else if (c_isalpha (c) || c == '_')
{
*sval++ = c;
while (*s < end
- && (c = *(*s)++, (isalnum (c) || c == '_')))
+ && (c = *(*s)++, (c_isalnum (c) || c == '_')))
*sval++ = c;
*sval = 0;
if (*s < end)
w1 = (width + 7) / 8; /* nb of 8bits elt in X bitmap */
w2 = ((width + 15) / 16) * 2; /* nb of 16bits elt in W32 bitmap */
- bits = (unsigned char *) alloca (height * w2);
+ bits = alloca (height * w2);
memset (bits, 0, height * w2);
for (i = 0; i < height; i++)
{
static void
Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data,
RGB_PIXEL_COLOR fg, RGB_PIXEL_COLOR bg,
- int non_default_colors)
+ bool non_default_colors)
{
#ifdef HAVE_NTGUI
img->pixmap
X versions. CONTENTS is a pointer to a buffer to parse; END is the
buffer's end. Set *WIDTH and *HEIGHT to the width and height of
the image. Return in *DATA the bitmap data allocated with xmalloc.
- Value is non-zero if successful. DATA null means just test if
- CONTENTS looks like an in-memory XBM file. If INHIBIT_IMAGE_ERROR
- is non-zero, inhibit the call to image_error when the image size is
- invalid (the bitmap remains unread). */
+ Value is true if successful. DATA null means just test if
+ CONTENTS looks like an in-memory XBM file. If INHIBIT_IMAGE_ERROR,
+ inhibit the call to image_error when the image size is invalid (the
+ bitmap remains unread). */
-static int
+static bool
xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *end,
int *width, int *height, char **data,
- int inhibit_image_error)
+ bool inhibit_image_error)
{
unsigned char *s = contents;
char buffer[BUFSIZ];
- int padding_p = 0;
- int v10 = 0;
+ bool padding_p = 0;
+ bool v10 = 0;
int bytes_per_line, i, nbytes;
char *p;
int value;
}
bytes_per_line = (*width + 7) / 8 + padding_p;
nbytes = bytes_per_line * *height;
- p = *data = (char *) xmalloc (nbytes);
+ p = *data = xmalloc (nbytes);
if (v10)
{
/* Load XBM image IMG which will be displayed on frame F from buffer
- CONTENTS. END is the end of the buffer. Value is non-zero if
+ CONTENTS. END is the end of the buffer. Value is true if
successful. */
-static int
+static bool
xbm_load_image (struct frame *f, struct image *img, unsigned char *contents,
unsigned char *end)
{
- int rc;
+ bool rc;
char *data;
- int success_p = 0;
+ bool success_p = 0;
rc = xbm_read_bitmap_data (f, contents, end, &img->width, &img->height,
&data, 0);
{
unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
unsigned long background = FRAME_BACKGROUND_PIXEL (f);
- int non_default_colors = 0;
+ bool non_default_colors = 0;
Lisp_Object value;
- xassert (img->width > 0 && img->height > 0);
+ eassert (img->width > 0 && img->height > 0);
/* Get foreground and background colors, maybe allocate colors. */
value = image_spec_value (img->spec, QCforeground, NULL);
}
-/* Value is non-zero if DATA looks like an in-memory XBM file. */
+/* Value is true if DATA looks like an in-memory XBM file. */
-static int
+static bool
xbm_file_p (Lisp_Object data)
{
int w, h;
/* Fill image IMG which is used on frame F with pixmap data. Value is
- non-zero if successful. */
+ true if successful. */
-static int
+static bool
xbm_load (struct frame *f, struct image *img)
{
- int success_p = 0;
+ bool success_p = 0;
Lisp_Object file_name;
- xassert (xbm_image_p (img->spec));
+ eassert (xbm_image_p (img->spec));
/* If IMG->spec specifies a file name, create a non-file spec from it. */
file_name = image_spec_value (img->spec, QCfile, NULL);
Lisp_Object data;
unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
unsigned long background = FRAME_BACKGROUND_PIXEL (f);
- int non_default_colors = 0;
+ bool non_default_colors = 0;
char *bits;
- int parsed_p;
- int in_memory_file_p = 0;
+ bool parsed_p;
+ bool in_memory_file_p = 0;
/* See if data looks like an in-memory XBM file. */
data = image_spec_value (img->spec, QCdata, NULL);
/* Parse the image specification. */
memcpy (fmt, xbm_format, sizeof fmt);
parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
- (void) parsed_p;
- xassert (parsed_p);
+ eassert (parsed_p);
/* Get specified width, and height. */
if (!in_memory_file_p)
{
img->width = XFASTINT (fmt[XBM_WIDTH].value);
img->height = XFASTINT (fmt[XBM_HEIGHT].value);
- xassert (img->width > 0 && img->height > 0);
+ eassert (img->width > 0 && img->height > 0);
if (!check_image_size (f, img->width, img->height))
{
image_error ("Invalid image size (see `max-image-size')",
char *p;
int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
- p = bits = (char *) alloca (nbytes * img->height);
+ p = bits = alloca (nbytes * img->height);
for (i = 0; i < img->height; ++i, p += nbytes)
{
- Lisp_Object line = XVECTOR (data)->contents[i];
+ Lisp_Object line = AREF (data, i);
if (STRINGP (line))
memcpy (p, SDATA (line), nbytes);
else
invertedBits = bits;
nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR
* img->height;
- bits = (char *) alloca (nbytes);
+ bits = alloca (nbytes);
for (i = 0; i < nbytes; i++)
bits[i] = XBM_BIT_SHUFFLE (invertedBits[i]);
}
#if defined (HAVE_XPM) || defined (HAVE_NS)
-static int xpm_image_p (Lisp_Object object);
-static int xpm_load (struct frame *f, struct image *img);
-static int xpm_valid_color_symbols_p (Lisp_Object);
+static bool xpm_image_p (Lisp_Object object);
+static bool xpm_load (struct frame *f, struct image *img);
#endif /* HAVE_XPM || HAVE_NS */
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#ifdef HAVE_NTGUI
+static bool init_xpm_functions (void);
+#else
+#define init_xpm_functions NULL
+#endif
+
/* Structure describing the image type XPM. */
static struct image_type xpm_type =
xpm_image_p,
xpm_load,
x_clear_image,
+ init_xpm_functions,
NULL
};
#ifdef ALLOC_XPM_COLORS
-static void xpm_init_color_cache (struct frame *, XpmAttributes *);
-static void xpm_free_color_cache (void);
-static int xpm_lookup_color (struct frame *, char *, XColor *);
-static int xpm_color_bucket (char *);
static struct xpm_cached_color *xpm_cache_color (struct frame *, char *,
XColor *, int);
xpm_init_color_cache (struct frame *f, XpmAttributes *attrs)
{
size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
- xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
- memset (xpm_color_cache, 0, nbytes);
+ xpm_color_cache = xzalloc (nbytes);
init_color_table ();
if (attrs->valuemask & XpmColorSymbols)
bucket = xpm_color_bucket (color_name);
nbytes = offsetof (struct xpm_cached_color, name) + strlen (color_name) + 1;
- p = (struct xpm_cached_color *) xmalloc (nbytes);
+ p = xmalloc (nbytes);
strcpy (p->name, color_name);
p->color = *color;
p->next = xpm_color_cache[bucket];
/* Look up color COLOR_NAME for frame F in the color cache. If found,
return the cached definition in *COLOR. Otherwise, make a new
- entry in the cache and allocate the color. Value is zero if color
+ entry in the cache and allocate the color. Value is false if color
allocation failed. */
-static int
+static bool
xpm_lookup_color (struct frame *f, char *color_name, XColor *color)
{
struct xpm_cached_color *p;
xpm_XImage **, XpmAttributes *));
DEF_IMGLIB_FN (void, XImageFree, (xpm_XImage *));
-static int
-init_xpm_functions (Lisp_Object libraries)
+static bool
+init_xpm_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qxpm)))
+ if (!(library = w32_delayed_load (Qxpm)))
return 0;
LOAD_IMGLIB_FN (library, XpmFreeAttributes);
#endif /* HAVE_NTGUI */
-/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
+/* Value is true if COLOR_SYMBOLS is a valid color symbols list
for XPM images. Such a list must consist of conses whose car and
cdr are strings. */
-static int
+static bool
xpm_valid_color_symbols_p (Lisp_Object color_symbols)
{
while (CONSP (color_symbols))
}
-/* Value is non-zero if OBJECT is a valid XPM image specification. */
+/* Value is true if OBJECT is a valid XPM image specification. */
-static int
+static bool
xpm_image_p (Lisp_Object object)
{
struct image_keyword fmt[XPM_LAST];
#endif /* defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) */
/* Load image IMG which will be displayed on frame F. Value is
- non-zero if successful. */
+ true if successful. */
#ifdef HAVE_XPM
-static int
+static bool
xpm_load (struct frame *f, struct image *img)
{
int rc;
/* Allocate an XpmColorSymbol array. */
size = attrs.numsymbols * sizeof *xpm_syms;
- xpm_syms = (XpmColorSymbol *) alloca (size);
+ xpm_syms = alloca (size);
memset (xpm_syms, 0, size);
attrs.colorsymbols = xpm_syms;
color = XCDR (XCAR (tail));
if (STRINGP (name))
{
- xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
+ xpm_syms[i].name = alloca (SCHARS (name) + 1);
strcpy (xpm_syms[i].name, SSDATA (name));
}
else
xpm_syms[i].name = empty_string;
if (STRINGP (color))
{
- xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
+ xpm_syms[i].value = alloca (SCHARS (color) + 1);
strcpy (xpm_syms[i].value, SSDATA (color));
}
else
img->width = attrs.width;
img->height = attrs.height;
- xassert (img->width > 0 && img->height > 0);
+ eassert (img->width > 0 && img->height > 0);
/* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
#ifdef HAVE_NTGUI
while (*s < end)
{
/* Skip white-space. */
- while (*s < end && (c = *(*s)++, isspace (c)))
+ while (*s < end && (c = *(*s)++, c_isspace (c)))
;
/* gnus-pointer.xpm uses '-' in its identifier.
sb-dir-plus.xpm uses '+' in its identifier. */
- if (isalpha (c) || c == '_' || c == '-' || c == '+')
+ if (c_isalpha (c) || c == '_' || c == '-' || c == '+')
{
*beg = *s - 1;
while (*s < end
- && (c = **s, isalnum (c) || c == '_' || c == '-' || c == '+'))
+ && (c = **s, c_isalnum (c)
+ || c == '_' || c == '-' || c == '+'))
++*s;
*len = *s - *beg;
return XPM_TK_IDENT;
int chars_len,
Lisp_Object color)
{
- XVECTOR (color_table)->contents[*chars_start] = color;
+ ASET (color_table, *chars_start, color);
}
static Lisp_Object
const unsigned char *chars_start,
int chars_len)
{
- return XVECTOR (color_table)->contents[*chars_start];
+ return AREF (color_table, *chars_start);
}
static Lisp_Object
return -1;
}
-static int
+static bool
xpm_load_image (struct frame *f,
struct image *img,
const unsigned char *contents,
void (*put_color_table) (Lisp_Object, const unsigned char *, int, Lisp_Object);
Lisp_Object (*get_color_table) (Lisp_Object, const unsigned char *, int);
Lisp_Object frame, color_symbols, color_table;
- int best_key, have_mask = 0;
+ int best_key;
+ bool have_mask = 0;
XImagePtr ximg = NULL, mask_img = NULL;
#define match() \
{
if (xstrcasecmp (SSDATA (XCDR (specified_color)), "None") == 0)
color_val = Qt;
- else if (x_defined_color (f, SDATA (XCDR (specified_color)),
+ else if (x_defined_color (f, SSDATA (XCDR (specified_color)),
&cdef, 0))
color_val = make_number (cdef.pixel);
}
failure:
image_error ("Invalid XPM file (%s)", img->spec, Qnil);
- error:
x_destroy_x_image (ximg);
x_destroy_x_image (mask_img);
x_clear_image (f, img);
#undef expect_ident
}
-static int
+static bool
xpm_load (struct frame *f,
struct image *img)
{
- int success_p = 0;
+ bool success_p = 0;
Lisp_Object file_name;
/* If IMG->spec specifies a file name, create a non-file spec from it. */
return 0;
}
- contents = slurp_file (SDATA (file), &size);
+ contents = slurp_file (SSDATA (file), &size);
if (contents == NULL)
{
image_error ("Error loading XPM image `%s'", img->spec, Qnil);
init_color_table (void)
{
int size = CT_SIZE * sizeof (*ct_table);
- ct_table = (struct ct_color **) xmalloc (size);
- memset (ct_table, 0, size);
+ ct_table = xzalloc (size);
ct_colors_allocated = 0;
}
#ifdef HAVE_X_WINDOWS
XColor color;
Colormap cmap;
- int rc;
+ bool rc;
#else
COLORREF color;
#endif
if (rc)
{
++ct_colors_allocated;
- p = (struct ct_color *) xmalloc (sizeof *p);
+ p = xmalloc (sizeof *p);
p->r = r;
p->g = g;
p->b = b;
color = RGB_TO_ULONG (r, g, b);
#endif /* HAVE_NTGUI */
++ct_colors_allocated;
- p = (struct ct_color *) xmalloc (sizeof *p);
+ p = xmalloc (sizeof *p);
p->r = r;
p->g = g;
p->b = b;
{
XColor color;
Colormap cmap;
- int rc;
+ bool rc;
if (ct_colors_allocated_max <= ct_colors_allocated)
return FRAME_FOREGROUND_PIXEL (f);
x_query_color (f, &color);
rc = x_alloc_nearest_color (f, cmap, &color);
#else
- BLOCK_INPUT;
+ block_input ();
cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
color.pixel = pixel;
XQueryColor (NULL, cmap, &color);
rc = x_alloc_nearest_color (f, cmap, &color);
- UNBLOCK_INPUT;
+ unblock_input ();
#endif /* HAVE_X_WINDOWS */
if (rc)
{
++ct_colors_allocated;
- p = (struct ct_color *) xmalloc (sizeof *p);
+ p = xmalloc (sizeof *p);
p->r = color.red;
p->g = color.green;
p->b = color.blue;
}
else
{
- colors = (unsigned long *) xmalloc (ct_colors_allocated
- * sizeof *colors);
+ colors = xmalloc (ct_colors_allocated * sizeof *colors);
*n = ct_colors_allocated;
for (i = j = 0; i < CT_SIZE; ++i)
Algorithms
***********************************************************************/
-static XColor *x_to_xcolors (struct frame *, struct image *, int);
-static void x_from_xcolors (struct frame *, struct image *, XColor *);
-static void x_detect_edges (struct frame *, struct image *, int[9], int);
-
-#ifdef HAVE_NTGUI
-static void XPutPixel (XImagePtr , int, int, COLORREF);
-#endif /* HAVE_NTGUI */
-
/* Edge detection matrices for different edge-detection
strategies. */
/* On frame F, return an array of XColor structures describing image
IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
- non-zero means also fill the red/green/blue members of the XColor
+ means also fill the red/green/blue members of the XColor
structures. Value is a pointer to the array of XColors structures,
allocated with xmalloc; it must be freed by the caller. */
static XColor *
-x_to_xcolors (struct frame *f, struct image *img, int rgb_p)
+x_to_xcolors (struct frame *f, struct image *img, bool rgb_p)
{
int x, y;
XColor *colors, *p;
if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *colors / img->width < img->height)
memory_full (SIZE_MAX);
- colors = (XColor *) xmalloc (sizeof *colors * img->width * img->height);
+ colors = xmalloc (sizeof *colors * img->width * img->height);
#ifndef HAVE_NTGUI
/* Get the X image IMG->pixmap. */
p = colors;
for (y = 0; y < img->height; ++y)
{
- XColor *row = p;
-
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI)
+ XColor *row = p;
for (x = 0; x < img->width; ++x, ++p)
p->pixel = GET_PIXEL (ximg, x, y);
if (rgb_p)
if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *new / img->width < img->height)
memory_full (SIZE_MAX);
- new = (XColor *) xmalloc (sizeof *new * img->width * img->height);
+ new = xmalloc (sizeof *new * img->width * img->height);
for (y = 0; y < img->height; ++y)
{
if (n_planes < 2 || cross_disabled_images)
{
#ifndef HAVE_NTGUI
- Display *dpy = FRAME_X_DISPLAY (f);
- GC gc;
-
#ifndef HAVE_NS /* TODO: NS support, however this not needed for toolbars */
#define MaskForeground(f) WHITE_PIX_DEFAULT (f)
- gc = XCreateGC (dpy, img->pixmap, 0, NULL);
+ Display *dpy = FRAME_X_DISPLAY (f);
+ GC gc = XCreateGC (dpy, img->pixmap, 0, NULL);
XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
XDrawLine (dpy, img->pixmap, gc, 0, 0,
img->width - 1, img->height - 1);
determine the background color of IMG. If it is a list '(R G B)',
with R, G, and B being integers >= 0, take that as the color of the
background. Otherwise, determine the background color of IMG
- heuristically. Value is non-zero if successful. */
+ heuristically. */
-static int
+static void
x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how)
{
XImagePtr_or_DC ximg;
char *mask_img;
int row_width;
#endif /* HAVE_NTGUI */
- int x, y, rc, use_img_background;
+ int x, y;
+ bool rc, use_img_background;
unsigned long bg = 0;
if (img->mask)
rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
&mask_img, &img->mask);
if (!rc)
- return 0;
+ return;
#endif /* !HAVE_NS */
/* Get the X image of IMG->pixmap. */
#else
/* Create the bit array serving as mask. */
row_width = (img->width + 7) / 8;
- mask_img = xmalloc (row_width * img->height);
- memset (mask_img, 0, row_width * img->height);
+ mask_img = xzalloc (row_width * img->height);
/* Create a memory device context for IMG->pixmap. */
frame_dc = get_frame_dc (f);
#endif /* HAVE_NTGUI */
Destroy_Image (ximg, prev);
-
- return 1;
}
\f
PBM (mono, gray, color)
***********************************************************************/
-static int pbm_image_p (Lisp_Object object);
-static int pbm_load (struct frame *f, struct image *img);
-static int pbm_scan_number (unsigned char **, unsigned char *);
+static bool pbm_image_p (Lisp_Object object);
+static bool pbm_load (struct frame *f, struct image *img);
/* The symbol `pbm' identifying images of this type. */
pbm_image_p,
pbm_load,
x_clear_image,
+ NULL,
NULL
};
-/* Return non-zero if OBJECT is a valid PBM image specification. */
+/* Return true if OBJECT is a valid PBM image specification. */
-static int
+static bool
pbm_image_p (Lisp_Object object)
{
struct image_keyword fmt[PBM_LAST];
while (*s < end)
{
/* Skip white-space. */
- while (*s < end && (c = *(*s)++, isspace (c)))
+ while (*s < end && (c = *(*s)++, c_isspace (c)))
;
if (c == '#')
while (*s < end && (c = *(*s)++, c != '\n'))
;
}
- else if (isdigit (c))
+ else if (c_isdigit (c))
{
/* Read decimal number. */
val = c - '0';
- while (*s < end && (c = *(*s)++, isdigit (c)))
+ while (*s < end && (c = *(*s)++, c_isdigit (c)))
val = 10 * val + c - '0';
break;
}
if (stat (SDATA (file), &st) == 0
&& (fp = fopen (SDATA (file), "rb")) != NULL
&& 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX)
- && (buf = (char *) xmalloc (st.st_size),
+ && (buf = xmalloc (st.st_size),
fread (buf, 1, st.st_size, fp) == st.st_size))
{
*size = st.st_size;
/* Load PBM image IMG for use on frame F. */
-static int
+static bool
pbm_load (struct frame *f, struct image *img)
{
- int raw_p, x, y;
+ bool raw_p;
+ int x, y;
int width, height, max_color_idx = 0;
XImagePtr ximg;
Lisp_Object file, specified_file;
/* Function prototypes. */
-static int png_image_p (Lisp_Object object);
-static int png_load (struct frame *f, struct image *img);
+static bool png_image_p (Lisp_Object object);
+static bool png_load (struct frame *f, struct image *img);
/* The symbol `png' identifying images of this type. */
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#ifdef HAVE_NTGUI
+static bool init_png_functions (void);
+#else
+#define init_png_functions NULL
+#endif
+
/* Structure describing the image type `png'. */
static struct image_type png_type =
png_image_p,
png_load,
x_clear_image,
+ init_png_functions,
NULL
};
-/* Return non-zero if OBJECT is a valid PNG image specification. */
+/* Return true if OBJECT is a valid PNG image specification. */
-static int
+static bool
png_image_p (Lisp_Object object)
{
struct image_keyword fmt[PNG_LAST];
DEF_IMGLIB_FN (jmp_buf *, png_set_longjmp_fn, (png_structp, png_longjmp_ptr, size_t));
#endif /* libpng version >= 1.5 */
-static int
-init_png_functions (Lisp_Object libraries)
+static bool
+init_png_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qpng)))
+ if (!(library = w32_delayed_load (Qpng)))
return 0;
LOAD_IMGLIB_FN (library, png_get_io_ptr);
#endif /* HAVE_NTGUI */
+/* Possibly inefficient/inexact substitutes for _setjmp and _longjmp.
+ Do not use sys_setjmp, as PNG supports only jmp_buf. The _longjmp
+ substitute may munge the signal mask, but that should be OK here.
+ MinGW (MS-Windows) uses _setjmp and defines setjmp to _setjmp in
+ the system header setjmp.h; don't mess up that. */
+#ifndef HAVE__SETJMP
+# define _setjmp(j) setjmp (j)
+# define _longjmp longjmp
+#endif
#if (PNG_LIBPNG_VER < 10500)
-#define PNG_LONGJMP(ptr) (longjmp ((ptr)->jmpbuf, 1))
+#define PNG_LONGJMP(ptr) (_longjmp ((ptr)->jmpbuf, 1))
#define PNG_JMPBUF(ptr) ((ptr)->jmpbuf)
#else
/* In libpng version 1.5, the jmpbuf member is hidden. (Bug#7908) */
#define PNG_LONGJMP(ptr) (fn_png_longjmp ((ptr), 1))
#define PNG_JMPBUF(ptr) \
- (*fn_png_set_longjmp_fn ((ptr), longjmp, sizeof (jmp_buf)))
+ (*fn_png_set_longjmp_fn ((ptr), _longjmp, sizeof (jmp_buf)))
#endif
/* Error and warning handlers installed when the PNG library
is initialized. */
-static void my_png_error (png_struct *, const char *) NO_RETURN;
-static void
+static _Noreturn void
my_png_error (png_struct *png_ptr, const char *msg)
{
- xassert (png_ptr != NULL);
+ eassert (png_ptr != NULL);
/* Avoid compiler warning about deprecated direct access to
png_ptr's fields in libpng versions 1.4.x. */
image_error ("PNG error: %s", build_string (msg), Qnil);
static void
my_png_warning (png_struct *png_ptr, const char *msg)
{
- xassert (png_ptr != NULL);
+ eassert (png_ptr != NULL);
image_error ("PNG warning: %s", build_string (msg), Qnil);
}
}
-/* Load PNG image IMG for use on frame F. Value is non-zero if
+/* Load PNG image IMG for use on frame F. Value is true if
successful. */
-static int
-png_load (struct frame *f, struct image *img)
+struct png_load_context
+{
+ /* These are members so that longjmp doesn't munge local variables. */
+ png_struct *png_ptr;
+ png_info *info_ptr;
+ png_info *end_info;
+ FILE *fp;
+ png_byte *pixels;
+ png_byte **rows;
+};
+
+static bool
+png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
{
Lisp_Object file, specified_file;
Lisp_Object specified_data;
int x, y;
ptrdiff_t i;
XImagePtr ximg, mask_img = NULL;
- png_struct *png_ptr = NULL;
+ png_struct *png_ptr;
png_info *info_ptr = NULL, *end_info = NULL;
- FILE *volatile fp = NULL;
+ FILE *fp = NULL;
png_byte sig[8];
- png_byte * volatile pixels = NULL;
- png_byte ** volatile rows = NULL;
+ png_byte *pixels = NULL;
+ png_byte **rows = NULL;
png_uint_32 width, height;
int bit_depth, color_type, interlace_type;
png_byte channels;
png_uint_32 row_bytes;
- int transparent_p;
+ bool transparent_p;
struct png_memory_storage tbr; /* Data to be read */
/* Find out what file to load. */
png_ptr = fn_png_create_read_struct (PNG_LIBPNG_VER_STRING,
NULL, my_png_error,
my_png_warning);
- if (!png_ptr)
+ if (png_ptr)
{
- if (fp) fclose (fp);
- return 0;
+ info_ptr = fn_png_create_info_struct (png_ptr);
+ end_info = fn_png_create_info_struct (png_ptr);
}
- info_ptr = fn_png_create_info_struct (png_ptr);
- if (!info_ptr)
+ c->png_ptr = png_ptr;
+ c->info_ptr = info_ptr;
+ c->end_info = end_info;
+ c->fp = fp;
+ c->pixels = pixels;
+ c->rows = rows;
+
+ if (! (info_ptr && end_info))
{
- fn_png_destroy_read_struct (&png_ptr, NULL, NULL);
- if (fp) fclose (fp);
- return 0;
+ fn_png_destroy_read_struct (&c->png_ptr, &c->info_ptr, &c->end_info);
+ png_ptr = 0;
}
-
- end_info = fn_png_create_info_struct (png_ptr);
- if (!end_info)
+ if (! png_ptr)
{
- fn_png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
if (fp) fclose (fp);
return 0;
}
/* Set error jump-back. We come back here when the PNG library
detects an error. */
- if (setjmp (PNG_JMPBUF (png_ptr)))
+ if (_setjmp (PNG_JMPBUF (png_ptr)))
{
error:
- if (png_ptr)
- fn_png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
- xfree (pixels);
- xfree (rows);
- if (fp) fclose (fp);
+ if (c->png_ptr)
+ fn_png_destroy_read_struct (&c->png_ptr, &c->info_ptr, &c->end_info);
+ xfree (c->pixels);
+ xfree (c->rows);
+ if (c->fp)
+ fclose (c->fp);
return 0;
}
+ /* Silence a bogus diagnostic; see GCC bug 54561. */
+ IF_LINT (fp = c->fp);
+
/* Read image info. */
if (!NILP (specified_data))
fn_png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
images with alpha channel, i.e. RGBA. If conversions above were
sufficient we should only have 3 or 4 channels here. */
channels = fn_png_get_channels (png_ptr, info_ptr);
- xassert (channels == 3 || channels == 4);
+ eassert (channels == 3 || channels == 4);
/* Number of bytes needed for one row of the image. */
row_bytes = fn_png_get_rowbytes (png_ptr, info_ptr);
if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *rows < height
|| min (PTRDIFF_MAX, SIZE_MAX) / sizeof *pixels / height < row_bytes)
memory_full (SIZE_MAX);
- pixels = (png_byte *) xmalloc (sizeof *pixels * row_bytes * height);
- rows = (png_byte **) xmalloc (height * sizeof *rows);
+ c->pixels = pixels = xmalloc (sizeof *pixels * row_bytes * height);
+ c->rows = rows = xmalloc (height * sizeof *rows);
for (i = 0; i < height; ++i)
rows[i] = pixels + i * row_bytes;
if (fp)
{
fclose (fp);
- fp = NULL;
+ c->fp = NULL;
}
/* Create an image and pixmap serving as mask if the PNG image
#endif /* COLOR_TABLE_SUPPORT */
/* Clean up. */
- fn_png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
+ fn_png_destroy_read_struct (&c->png_ptr, &c->info_ptr, &c->end_info);
xfree (rows);
xfree (pixels);
return 1;
}
+static bool
+png_load (struct frame *f, struct image *img)
+{
+ struct png_load_context c;
+ return png_load_body (f, img, &c);
+}
+
#else /* HAVE_PNG */
#ifdef HAVE_NS
-static int
+static bool
png_load (struct frame *f, struct image *img)
{
return ns_load_image (f, img,
#if defined (HAVE_JPEG) || defined (HAVE_NS)
-static int jpeg_image_p (Lisp_Object object);
-static int jpeg_load (struct frame *f, struct image *img);
+static bool jpeg_image_p (Lisp_Object object);
+static bool jpeg_load (struct frame *f, struct image *img);
/* The symbol `jpeg' identifying images of this type. */
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#ifdef HAVE_NTGUI
+static bool init_jpeg_functions (void);
+#else
+#define init_jpeg_functions NULL
+#endif
+
/* Structure describing the image type `jpeg'. */
static struct image_type jpeg_type =
jpeg_image_p,
jpeg_load,
x_clear_image,
+ init_jpeg_functions,
NULL
};
-/* Return non-zero if OBJECT is a valid JPEG image specification. */
+/* Return true if OBJECT is a valid JPEG image specification. */
-static int
+static bool
jpeg_image_p (Lisp_Object object)
{
struct image_keyword fmt[JPEG_LAST];
DEF_IMGLIB_FN (struct jpeg_error_mgr *, jpeg_std_error, (struct jpeg_error_mgr *));
DEF_IMGLIB_FN (boolean, jpeg_resync_to_restart, (j_decompress_ptr, int));
-static int
-init_jpeg_functions (Lisp_Object libraries)
+static bool
+init_jpeg_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qjpeg)))
+ if (!(library = w32_delayed_load (Qjpeg)))
return 0;
LOAD_IMGLIB_FN (library, jpeg_finish_decompress);
struct my_jpeg_error_mgr
{
struct jpeg_error_mgr pub;
- jmp_buf setjmp_buffer;
+ sys_jmp_buf setjmp_buffer;
+
+ /* The remaining members are so that longjmp doesn't munge local
+ variables. */
+ struct jpeg_decompress_struct cinfo;
+ enum
+ {
+ MY_JPEG_ERROR_EXIT,
+ MY_JPEG_INVALID_IMAGE_SIZE,
+ MY_JPEG_CANNOT_CREATE_X
+ } failure_code;
+#ifdef lint
+ FILE *fp;
+#endif
};
-static void my_error_exit (j_common_ptr) NO_RETURN;
-static void
+static _Noreturn void
my_error_exit (j_common_ptr cinfo)
{
struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
- longjmp (mgr->setjmp_buffer, 1);
+ mgr->failure_code = MY_JPEG_ERROR_EXIT;
+ sys_longjmp (mgr->setjmp_buffer, 1);
}
reading the image. */
static void
-jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data, unsigned int len)
+jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data, ptrdiff_t len)
{
struct jpeg_source_mgr *src;
/* Load image IMG for use on frame F. Patterned after example.c
from the JPEG lib. */
-static int
-jpeg_load (struct frame *f, struct image *img)
+static bool
+jpeg_load_body (struct frame *f, struct image *img,
+ struct my_jpeg_error_mgr *mgr)
{
- struct jpeg_decompress_struct cinfo;
- struct my_jpeg_error_mgr mgr;
Lisp_Object file, specified_file;
Lisp_Object specified_data;
- FILE * volatile fp = NULL;
+ FILE *fp = NULL;
JSAMPARRAY buffer;
int row_stride, x, y;
XImagePtr ximg = NULL;
- int rc;
unsigned long *colors;
int width, height;
return 0;
}
+ IF_LINT (mgr->fp = fp);
+
/* Customize libjpeg's error handling to call my_error_exit when an
error is detected. This function will perform a longjmp. */
- cinfo.err = fn_jpeg_std_error (&mgr.pub);
- mgr.pub.error_exit = my_error_exit;
-
- if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
+ mgr->cinfo.err = fn_jpeg_std_error (&mgr->pub);
+ mgr->pub.error_exit = my_error_exit;
+ if (sys_setjmp (mgr->setjmp_buffer))
{
- if (rc == 1)
+ switch (mgr->failure_code)
{
- /* Called from my_error_exit. Display a JPEG error. */
- char buf[JMSG_LENGTH_MAX];
- cinfo.err->format_message ((j_common_ptr) &cinfo, buf);
- image_error ("Error reading JPEG image `%s': %s", img->spec,
- build_string (buf));
+ case MY_JPEG_ERROR_EXIT:
+ {
+ char buf[JMSG_LENGTH_MAX];
+ mgr->cinfo.err->format_message ((j_common_ptr) &mgr->cinfo, buf);
+ image_error ("Error reading JPEG image `%s': %s", img->spec,
+ build_string (buf));
+ break;
+ }
+
+ case MY_JPEG_INVALID_IMAGE_SIZE:
+ image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil);
+ break;
+
+ case MY_JPEG_CANNOT_CREATE_X:
+ break;
}
/* Close the input file and destroy the JPEG object. */
if (fp)
- fclose ((FILE *) fp);
- fn_jpeg_destroy_decompress (&cinfo);
+ fclose (fp);
+ fn_jpeg_destroy_decompress (&mgr->cinfo);
/* If we already have an XImage, free that. */
x_destroy_x_image (ximg);
return 0;
}
+ /* Silence a bogus diagnostic; see GCC bug 54561. */
+ IF_LINT (fp = mgr->fp);
+
/* Create the JPEG decompression object. Let it read from fp.
Read the JPEG image header. */
- fn_jpeg_CreateDecompress (&cinfo, JPEG_LIB_VERSION, sizeof (cinfo));
+ fn_jpeg_CreateDecompress (&mgr->cinfo, JPEG_LIB_VERSION, sizeof *&mgr->cinfo);
if (NILP (specified_data))
- jpeg_file_src (&cinfo, (FILE *) fp);
+ jpeg_file_src (&mgr->cinfo, fp);
else
- jpeg_memory_src (&cinfo, SDATA (specified_data),
+ jpeg_memory_src (&mgr->cinfo, SDATA (specified_data),
SBYTES (specified_data));
- fn_jpeg_read_header (&cinfo, 1);
+ fn_jpeg_read_header (&mgr->cinfo, 1);
/* Customize decompression so that color quantization will be used.
Start decompression. */
- cinfo.quantize_colors = 1;
- fn_jpeg_start_decompress (&cinfo);
- width = img->width = cinfo.output_width;
- height = img->height = cinfo.output_height;
+ mgr->cinfo.quantize_colors = 1;
+ fn_jpeg_start_decompress (&mgr->cinfo);
+ width = img->width = mgr->cinfo.output_width;
+ height = img->height = mgr->cinfo.output_height;
if (!check_image_size (f, width, height))
{
- image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil);
- longjmp (mgr.setjmp_buffer, 2);
+ mgr->failure_code = MY_JPEG_INVALID_IMAGE_SIZE;
+ sys_longjmp (mgr->setjmp_buffer, 1);
}
/* Create X image and pixmap. */
if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
- longjmp (mgr.setjmp_buffer, 2);
+ {
+ mgr->failure_code = MY_JPEG_CANNOT_CREATE_X;
+ sys_longjmp (mgr->setjmp_buffer, 1);
+ }
/* Allocate colors. When color quantization is used,
- cinfo.actual_number_of_colors has been set with the number of
- colors generated, and cinfo.colormap is a two-dimensional array
- of color indices in the range 0..cinfo.actual_number_of_colors.
+ mgr->cinfo.actual_number_of_colors has been set with the number of
+ colors generated, and mgr->cinfo.colormap is a two-dimensional array
+ of color indices in the range 0..mgr->cinfo.actual_number_of_colors.
No more than 255 colors will be generated. */
{
int i, ir, ig, ib;
- if (cinfo.out_color_components > 2)
+ if (mgr->cinfo.out_color_components > 2)
ir = 0, ig = 1, ib = 2;
- else if (cinfo.out_color_components > 1)
+ else if (mgr->cinfo.out_color_components > 1)
ir = 0, ig = 1, ib = 0;
else
ir = 0, ig = 0, ib = 0;
a default color, and we don't have to care about which colors
can be freed safely, and which can't. */
init_color_table ();
- colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
- * sizeof *colors);
+ colors = alloca (mgr->cinfo.actual_number_of_colors * sizeof *colors);
- for (i = 0; i < cinfo.actual_number_of_colors; ++i)
+ for (i = 0; i < mgr->cinfo.actual_number_of_colors; ++i)
{
/* Multiply RGB values with 255 because X expects RGB values
in the range 0..0xffff. */
- int r = cinfo.colormap[ir][i] << 8;
- int g = cinfo.colormap[ig][i] << 8;
- int b = cinfo.colormap[ib][i] << 8;
+ int r = mgr->cinfo.colormap[ir][i] << 8;
+ int g = mgr->cinfo.colormap[ig][i] << 8;
+ int b = mgr->cinfo.colormap[ib][i] << 8;
colors[i] = lookup_rgb_color (f, r, g, b);
}
}
/* Read pixels. */
- row_stride = width * cinfo.output_components;
- buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
- row_stride, 1);
+ row_stride = width * mgr->cinfo.output_components;
+ buffer = mgr->cinfo.mem->alloc_sarray ((j_common_ptr) &mgr->cinfo,
+ JPOOL_IMAGE, row_stride, 1);
for (y = 0; y < height; ++y)
{
- fn_jpeg_read_scanlines (&cinfo, buffer, 1);
- for (x = 0; x < cinfo.output_width; ++x)
+ fn_jpeg_read_scanlines (&mgr->cinfo, buffer, 1);
+ for (x = 0; x < mgr->cinfo.output_width; ++x)
XPutPixel (ximg, x, y, colors[buffer[0][x]]);
}
/* Clean up. */
- fn_jpeg_finish_decompress (&cinfo);
- fn_jpeg_destroy_decompress (&cinfo);
+ fn_jpeg_finish_decompress (&mgr->cinfo);
+ fn_jpeg_destroy_decompress (&mgr->cinfo);
if (fp)
- fclose ((FILE *) fp);
+ fclose (fp);
/* Maybe fill in the background field while we have ximg handy. */
if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
return 1;
}
+static bool
+jpeg_load (struct frame *f, struct image *img)
+{
+ struct my_jpeg_error_mgr mgr;
+ return jpeg_load_body (f, img, &mgr);
+}
+
#else /* HAVE_JPEG */
#ifdef HAVE_NS
-static int
+static bool
jpeg_load (struct frame *f, struct image *img)
{
return ns_load_image (f, img,
#if defined (HAVE_TIFF) || defined (HAVE_NS)
-static int tiff_image_p (Lisp_Object object);
-static int tiff_load (struct frame *f, struct image *img);
+static bool tiff_image_p (Lisp_Object object);
+static bool tiff_load (struct frame *f, struct image *img);
/* The symbol `tiff' identifying images of this type. */
{":index", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
};
+#ifdef HAVE_NTGUI
+static bool init_tiff_functions (void);
+#else
+#define init_tiff_functions NULL
+#endif
+
/* Structure describing the image type `tiff'. */
static struct image_type tiff_type =
tiff_image_p,
tiff_load,
x_clear_image,
+ init_tiff_functions,
NULL
};
-/* Return non-zero if OBJECT is a valid TIFF image specification. */
+/* Return true if OBJECT is a valid TIFF image specification. */
-static int
+static bool
tiff_image_p (Lisp_Object object)
{
struct image_keyword fmt[TIFF_LAST];
DEF_IMGLIB_FN (void, TIFFClose, (TIFF *));
DEF_IMGLIB_FN (int, TIFFSetDirectory, (TIFF *, tdir_t));
-static int
-init_tiff_functions (Lisp_Object libraries)
+static bool
+init_tiff_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qtiff)))
+ if (!(library = w32_delayed_load (Qtiff)))
return 0;
LOAD_IMGLIB_FN (library, TIFFSetErrorHandler);
}
-/* Load TIFF image IMG for use on frame F. Value is non-zero if
+/* Load TIFF image IMG for use on frame F. Value is true if
successful. */
-static int
+static bool
tiff_load (struct frame *f, struct image *img)
{
Lisp_Object file, specified_file;
return 0;
}
- buf = (uint32 *) xmalloc (sizeof *buf * width * height);
+ buf = xmalloc (sizeof *buf * width * height);
rc = fn_TIFFReadRGBAImage (tiff, width, height, buf, 0);
#else /* HAVE_TIFF */
#ifdef HAVE_NS
-static int
+static bool
tiff_load (struct frame *f, struct image *img)
{
return ns_load_image (f, img,
#if defined (HAVE_GIF) || defined (HAVE_NS)
-static int gif_image_p (Lisp_Object object);
-static int gif_load (struct frame *f, struct image *img);
+static bool gif_image_p (Lisp_Object object);
+static bool gif_load (struct frame *f, struct image *img);
static void gif_clear_image (struct frame *f, struct image *img);
/* The symbol `gif' identifying images of this type. */
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#ifdef HAVE_NTGUI
+static bool init_gif_functions (void);
+#else
+#define init_gif_functions NULL
+#endif
+
/* Structure describing the image type `gif'. */
static struct image_type gif_type =
gif_image_p,
gif_load,
gif_clear_image,
+ init_gif_functions,
NULL
};
x_clear_image (f, img);
}
-/* Return non-zero if OBJECT is a valid GIF image specification. */
+/* Return true if OBJECT is a valid GIF image specification. */
-static int
+static bool
gif_image_p (Lisp_Object object)
{
struct image_keyword fmt[GIF_LAST];
DEF_IMGLIB_FN (GifFileType *, DGifOpen, (void *, InputFunc));
DEF_IMGLIB_FN (GifFileType *, DGifOpenFileName, (const char *));
-static int
-init_gif_functions (Lisp_Object libraries)
+static bool
+init_gif_functions (void)
{
HMODULE library;
- if (!(library = w32_delayed_load (libraries, Qgif)))
+ if (!(library = w32_delayed_load (Qgif)))
return 0;
LOAD_IMGLIB_FN (library, DGifCloseFile);
}
-/* Load GIF image IMG for use on frame F. Value is non-zero if
+/* Load GIF image IMG for use on frame F. Value is true if
successful. */
static const int interlace_start[] = {0, 4, 2, 1};
#define GIF_LOCAL_DESCRIPTOR_EXTENSION 249
-static int
+static bool
gif_load (struct frame *f, struct image *img)
{
Lisp_Object file;
#else /* !HAVE_GIF */
#ifdef HAVE_NS
-static int
+static bool
gif_load (struct frame *f, struct image *img)
{
return ns_load_image (f, img,
static Lisp_Object Qimagemagick;
-static int imagemagick_image_p (Lisp_Object);
-static int imagemagick_load (struct frame *, struct image *);
+static bool imagemagick_image_p (Lisp_Object);
+static bool imagemagick_load (struct frame *, struct image *);
static void imagemagick_clear_image (struct frame *, struct image *);
/* Indices of image specification fields in imagemagick_format. */
{":crop", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
+#ifdef HAVE_NTGUI
+static bool init_imagemagick_functions (void);
+#else
+#define init_imagemagick_functions NULL
+#endif
+
/* Structure describing the image type for any image handled via
ImageMagick. */
imagemagick_image_p,
imagemagick_load,
imagemagick_clear_image,
+ init_imagemagick_functions,
NULL
};
x_clear_image (f, img);
}
-/* Return non-zero if OBJECT is a valid IMAGEMAGICK image specification. Do
+/* Return true if OBJECT is a valid IMAGEMAGICK image specification. Do
this by calling parse_image_spec and supplying the keywords that
identify the IMAGEMAGICK format. */
-static int
+static bool
imagemagick_image_p (Lisp_Object object)
{
struct image_keyword fmt[IMAGEMAGICK_LAST];
description = MagickGetException (wand, &severity);
image_error ("ImageMagick error: %s",
- make_string (description, strlen (description)),
+ build_string (description),
Qnil);
description = (char *) MagickRelinquishMemory (description);
}
be parsed; SIZE is the number of bytes of data; and FILENAME is
either the file name or the image data.
- Return non-zero if successful. */
+ Return true if successful. */
-static int
+static bool
imagemagick_load_image (struct frame *f, struct image *img,
unsigned char *contents, unsigned int size,
char *filename)
{
- size_t width;
- size_t height;
-
+ size_t width, height;
MagickBooleanType status;
-
XImagePtr ximg;
- int x;
- int y;
-
- MagickWand *image_wand;
- MagickWand *ping_wand;
+ int x, y;
+ MagickWand *image_wand;
+ MagickWand *ping_wand;
PixelIterator *iterator;
- PixelWand **pixels;
+ PixelWand **pixels, *bg_wand = NULL;
MagickPixelPacket pixel;
Lisp_Object image;
Lisp_Object value;
int desired_width, desired_height;
double rotation;
int pixelwidth;
- ImageInfo *image_info;
- ExceptionInfo *exception;
- Image * im_image;
-
/* Handle image index for image types who can contain more than one image.
Interface :index is same as for GIF. First we "ping" the image to see how
ping_wand = NewMagickWand ();
/* MagickSetResolution (ping_wand, 2, 2); (Bug#10112) */
- if (filename != NULL)
- {
- status = MagickPingImage (ping_wand, filename);
- }
- else
- {
- status = MagickPingImageBlob (ping_wand, contents, size);
- }
+ status = filename
+ ? MagickPingImage (ping_wand, filename)
+ : MagickPingImageBlob (ping_wand, contents, size);
if (status == MagickFalse)
{
return 0;
}
- if (! (0 <= ino && ino < MagickGetNumberImages (ping_wand)))
+ if (ino < 0 || ino >= MagickGetNumberImages (ping_wand))
{
image_error ("Invalid image number `%s' in image `%s'",
image, img->spec);
DestroyMagickWand (ping_wand);
/* Now we know how many images are inside the file. If it's not a
- bundle, the number is one. */
+ bundle, the number is one. Load the image data. */
- if (filename != NULL)
- {
- image_info = CloneImageInfo ((ImageInfo *) NULL);
- (void) strcpy (image_info->filename, filename);
- image_info->number_scenes = 1;
- image_info->scene = ino;
- exception = AcquireExceptionInfo ();
-
- im_image = ReadImage (image_info, exception);
- DestroyExceptionInfo (exception);
+ image_wand = NewMagickWand ();
- if (im_image == NULL)
- goto imagemagick_no_wand;
- image_wand = NewMagickWandFromImage (im_image);
- DestroyImage (im_image);
- }
- else
+ if ((filename
+ ? MagickReadImage (image_wand, filename)
+ : MagickReadImageBlob (image_wand, contents, size))
+ == MagickFalse)
{
- image_wand = NewMagickWand ();
- if (MagickReadImageBlob (image_wand, contents, size) == MagickFalse)
- {
- imagemagick_error (image_wand);
- goto imagemagick_error;
- }
+ imagemagick_error (image_wand);
+ goto imagemagick_error;
}
+ /* Retrieve the frame's background color, for use later. */
+ {
+ XColor bgcolor;
+ Lisp_Object specified_bg;
+
+ specified_bg = image_spec_value (img->spec, QCbackground, NULL);
+ if (!STRINGP (specified_bg)
+ || !x_defined_color (f, SSDATA (specified_bg), &bgcolor, 0))
+ {
+#ifndef HAVE_NS
+ bgcolor.pixel = FRAME_BACKGROUND_PIXEL (f);
+ x_query_color (f, &bgcolor);
+#else
+ ns_query_color (FRAME_BACKGROUND_COLOR (f), &bgcolor, 1);
+#endif
+ }
+
+ bg_wand = NewPixelWand ();
+ PixelSetRed (bg_wand, (double) bgcolor.red / 65535);
+ PixelSetGreen (bg_wand, (double) bgcolor.green / 65535);
+ PixelSetBlue (bg_wand, (double) bgcolor.blue / 65535);
+ }
+
/* If width and/or height is set in the display spec assume we want
to scale to those values. If either h or w is unspecified, the
unspecified should be calculated from the specified to preserve
aspect ratio. */
-
value = image_spec_value (img->spec, QCwidth, NULL);
desired_width = (INTEGERP (value) ? XFASTINT (value) : -1);
value = image_spec_value (img->spec, QCheight, NULL);
value = image_spec_value (img->spec, QCrotation, NULL);
if (FLOATP (value))
{
- PixelWand* background = NewPixelWand ();
- PixelSetColor (background, "#ffffff");/*TODO remove hardcode*/
-
rotation = extract_float (value);
-
- status = MagickRotateImage (image_wand, background, rotation);
- DestroyPixelWand (background);
+ status = MagickRotateImage (image_wand, bg_wand, rotation);
if (status == MagickFalse)
{
image_error ("Imagemagick image rotate failed", Qnil, Qnil);
height = MagickGetImageHeight (image_wand);
width = MagickGetImageWidth (image_wand);
+ /* Set the canvas background color to the frame or specified
+ background, and flatten the image. Note: as of ImageMagick
+ 6.6.0, SVG image transparency is not handled properly
+ (e.g. etc/images/splash.svg shows a white background always). */
+ {
+ MagickWand *new_wand;
+ MagickSetImageBackgroundColor (image_wand, bg_wand);
+#ifdef HAVE_MAGICKMERGEIMAGELAYERS
+ new_wand = MagickMergeImageLayers (image_wand, MergeLayer);
+#else
+ new_wand = MagickFlattenImages (image_wand);
+#endif
+ DestroyMagickWand (image_wand);
+ image_wand = new_wand;
+ }
+
if (! (width <= INT_MAX && height <= INT_MAX
&& check_image_size (f, width, height)))
{
init_color_table ();
- if (imagemagick_render_type == 0)
+#ifdef HAVE_MAGICKEXPORTIMAGEPIXELS
+ if (imagemagick_render_type != 0)
+ {
+ /* Magicexportimage is normally faster than pixelpushing. This
+ method is also well tested. Some aspects of this method are
+ ad-hoc and needs to be more researched. */
+ int imagedepth = 24; /*MagickGetImageDepth(image_wand);*/
+ const char *exportdepth = imagedepth <= 8 ? "I" : "BGRP"; /*"RGBP";*/
+ /* Try to create a x pixmap to hold the imagemagick pixmap. */
+ if (!x_create_x_image_and_pixmap (f, width, height, imagedepth,
+ &ximg, &img->pixmap))
+ {
+#ifdef COLOR_TABLE_SUPPORT
+ free_color_table ();
+#endif
+ image_error ("Imagemagick X bitmap allocation failure", Qnil, Qnil);
+ goto imagemagick_error;
+ }
+
+ /* Oddly, the below code doesn't seem to work:*/
+ /* switch(ximg->bitmap_unit){ */
+ /* case 8: */
+ /* pixelwidth=CharPixel; */
+ /* break; */
+ /* case 16: */
+ /* pixelwidth=ShortPixel; */
+ /* break; */
+ /* case 32: */
+ /* pixelwidth=LongPixel; */
+ /* break; */
+ /* } */
+ /*
+ Here im just guessing the format of the bitmap.
+ happens to work fine for:
+ - bw djvu images
+ on rgb display.
+ seems about 3 times as fast as pixel pushing(not carefully measured)
+ */
+ pixelwidth = CharPixel; /*??? TODO figure out*/
+ MagickExportImagePixels (image_wand, 0, 0, width, height,
+ exportdepth, pixelwidth, ximg->data);
+ }
+ else
+#endif /* HAVE_MAGICKEXPORTIMAGEPIXELS */
{
size_t image_height;
}
DestroyPixelIterator (iterator);
}
- else /* imagemagick_render_type != 0 */
- {
- /* Magicexportimage is normally faster than pixelpushing. This
- method is also well tested. Some aspects of this method are
- ad-hoc and needs to be more researched. */
- int imagedepth = 24;/*MagickGetImageDepth(image_wand);*/
- const char *exportdepth = imagedepth <= 8 ? "I" : "BGRP";/*"RGBP";*/
- /* Try to create a x pixmap to hold the imagemagick pixmap. */
- if (!x_create_x_image_and_pixmap (f, width, height, imagedepth,
- &ximg, &img->pixmap))
- {
-#ifdef COLOR_TABLE_SUPPORT
- free_color_table ();
-#endif
- image_error ("Imagemagick X bitmap allocation failure", Qnil, Qnil);
- goto imagemagick_error;
- }
-
-
- /* Oddly, the below code doesn't seem to work:*/
- /* switch(ximg->bitmap_unit){ */
- /* case 8: */
- /* pixelwidth=CharPixel; */
- /* break; */
- /* case 16: */
- /* pixelwidth=ShortPixel; */
- /* break; */
- /* case 32: */
- /* pixelwidth=LongPixel; */
- /* break; */
- /* } */
- /*
- Here im just guessing the format of the bitmap.
- happens to work fine for:
- - bw djvu images
- on rgb display.
- seems about 3 times as fast as pixel pushing(not carefully measured)
- */
- pixelwidth = CharPixel;/*??? TODO figure out*/
-#ifdef HAVE_MAGICKEXPORTIMAGEPIXELS
- MagickExportImagePixels (image_wand,
- 0, 0,
- width, height,
- exportdepth,
- pixelwidth,
- /*&(img->pixmap));*/
- ximg->data);
-#else
- image_error ("You don't have MagickExportImagePixels, upgrade ImageMagick!",
- Qnil, Qnil);
-#endif
- }
-
#ifdef COLOR_TABLE_SUPPORT
/* Remember colors allocated for this image. */
free_color_table ();
#endif /* COLOR_TABLE_SUPPORT */
-
img->width = width;
img->height = height;
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
-
/* Final cleanup. image_wand should be the only resource left. */
DestroyMagickWand (image_wand);
+ if (bg_wand) DestroyPixelWand (bg_wand);
+
/* `MagickWandTerminus' terminates the imagemagick environment. */
MagickWandTerminus ();
imagemagick_error:
DestroyMagickWand (image_wand);
- imagemagick_no_wand:
+ if (bg_wand) DestroyPixelWand (bg_wand);
+
MagickWandTerminus ();
/* TODO more cleanup. */
image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec, Qnil);
}
-/* Load IMAGEMAGICK image IMG for use on frame F. Value is non-zero if
+/* Load IMAGEMAGICK image IMG for use on frame F. Value is true if
successful. this function will go into the imagemagick_type structure, and
the prototype thus needs to be compatible with that structure. */
-static int
+static bool
imagemagick_load (struct frame *f, struct image *img)
{
- int success_p = 0;
+ bool success_p = 0;
Lisp_Object file_name;
/* If IMG->spec specifies a file name, create a non-file spec from it. */
You can also try the shell command: `identify -list format'.
Note that ImageMagick recognizes many file-types that Emacs does not
-recognize as images, such as C. See `imagemagick-types-inhibit'. */)
+recognize as images, such as C. See `imagemagick-types-enable'
+and `imagemagick-types-inhibit'. */)
(void)
{
Lisp_Object typelist = Qnil;
size_t numf = 0;
ExceptionInfo ex;
- char **imtypes = GetMagickList ("*", &numf, &ex);
+ char **imtypes;
size_t i;
Lisp_Object Qimagemagicktype;
+
+ GetExceptionInfo(&ex);
+ imtypes = GetMagickList ("*", &numf, &ex);
+ DestroyExceptionInfo(&ex);
+
for (i = 0; i < numf; i++)
{
Qimagemagicktype = intern (imtypes[i]);
/* Function prototypes. */
-static int svg_image_p (Lisp_Object object);
-static int svg_load (struct frame *f, struct image *img);
+static bool svg_image_p (Lisp_Object object);
+static bool svg_load (struct frame *f, struct image *img);
-static int svg_load_image (struct frame *, struct image *,
- unsigned char *, ptrdiff_t);
+static bool svg_load_image (struct frame *, struct image *,
+ unsigned char *, ptrdiff_t);
/* The symbol `svg' identifying images of this type. */
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#ifdef HAVE_NTGUI
+static bool init_svg_functions (void);
+#else
+#define init_svg_functions NULL
+#endif
+
/* Structure describing the image type `svg'. Its the same type of
structure defined for all image formats, handled by emacs image
functions. See struct image_type in dispextern.h. */
static struct image_type svg_type =
{
- /* An identifier showing that this is an image structure for the SVG format. */
&Qsvg,
- /* Handle to a function that can be used to identify a SVG file. */
svg_image_p,
- /* Handle to function used to load a SVG file. */
svg_load,
- /* Handle to function to free sresources for SVG. */
x_clear_image,
- /* An internal field to link to the next image type in a list of
- image types, will be filled in when registering the format. */
+ init_svg_functions,
NULL
};
-/* Return non-zero if OBJECT is a valid SVG image specification. Do
+/* Return true if OBJECT is a valid SVG image specification. Do
this by calling parse_image_spec and supplying the keywords that
identify the SVG format. */
-static int
+static bool
svg_image_p (Lisp_Object object)
{
struct image_keyword fmt[SVG_LAST];
Lisp_Object Qgdk_pixbuf, Qglib, Qgobject;
-static int
-init_svg_functions (Lisp_Object libraries)
+static bool
+init_svg_functions (void)
{
HMODULE library, gdklib, glib, gobject;
- if (!(glib = w32_delayed_load (libraries, Qglib))
- || !(gobject = w32_delayed_load (libraries, Qgobject))
- || !(gdklib = w32_delayed_load (libraries, Qgdk_pixbuf))
- || !(library = w32_delayed_load (libraries, Qsvg)))
+ if (!(glib = w32_delayed_load (Qglib))
+ || !(gobject = w32_delayed_load (Qgobject))
+ || !(gdklib = w32_delayed_load (Qgdk_pixbuf))
+ || !(library = w32_delayed_load (Qsvg)))
return 0;
LOAD_IMGLIB_FN (library, rsvg_handle_new);
#define fn_g_error_free g_error_free
#endif /* !HAVE_NTGUI */
-/* Load SVG image IMG for use on frame F. Value is non-zero if
- successful. this function will go into the svg_type structure, and
- the prototype thus needs to be compatible with that structure. */
+/* Load SVG image IMG for use on frame F. Value is true if
+ successful. */
-static int
+static bool
svg_load (struct frame *f, struct image *img)
{
- int success_p = 0;
+ bool success_p = 0;
Lisp_Object file_name;
/* If IMG->spec specifies a file name, create a non-file spec from it. */
Uses librsvg to do most of the image processing.
- Returns non-zero when successful. */
-static int
+ Returns true when successful. */
+static bool
svg_load_image (struct frame *f, /* Pointer to emacs frame structure. */
struct image *img, /* Pointer to emacs image structure. */
unsigned char *contents, /* String containing the SVG XML data to be parsed. */
#ifdef HAVE_GHOSTSCRIPT
-static int gs_image_p (Lisp_Object object);
-static int gs_load (struct frame *f, struct image *img);
+static bool gs_image_p (Lisp_Object object);
+static bool gs_load (struct frame *f, struct image *img);
static void gs_clear_image (struct frame *f, struct image *img);
/* Keyword symbols. */
gs_image_p,
gs_load,
gs_clear_image,
+ NULL,
NULL
};
}
-/* Return non-zero if OBJECT is a valid Ghostscript image
+/* Return true if OBJECT is a valid Ghostscript image
specification. */
-static int
+static bool
gs_image_p (Lisp_Object object)
{
struct image_keyword fmt[GS_LAST];
if (ASIZE (tem) != 4)
return 0;
for (i = 0; i < 4; ++i)
- if (!INTEGERP (XVECTOR (tem)->contents[i]))
+ if (!INTEGERP (AREF (tem, i)))
return 0;
}
else
}
-/* Load Ghostscript image IMG for use on frame F. Value is non-zero
+/* Load Ghostscript image IMG for use on frame F. Value is true
if successful. */
-static int
+static bool
gs_load (struct frame *f, struct image *img)
{
uprintmax_t printnum1, printnum2;
img->height = in_height;
/* Create the pixmap. */
- xassert (img->pixmap == NO_PIXMAP);
+ eassert (img->pixmap == NO_PIXMAP);
if (x_check_image_size (0, img->width, img->height))
{
/* Only W32 version did BLOCK_INPUT here. ++kfs */
- BLOCK_INPUT;
+ block_input ();
img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
img->width, img->height,
DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (!img->pixmap)
don't either. Let the Lisp loader use `unwind-protect' instead. */
printnum1 = FRAME_X_WINDOW (f);
printnum2 = img->pixmap;
- sprintf (buffer, "%"pMu" %"pMu, printnum1, printnum2);
- window_and_pixmap_id = build_string (buffer);
+ window_and_pixmap_id
+ = make_formatted_string (buffer, "%"pMu" %"pMu, printnum1, printnum2);
printnum1 = FRAME_FOREGROUND_PIXEL (f);
printnum2 = FRAME_BACKGROUND_PIXEL (f);
- sprintf (buffer, "%"pMu" %"pMu, printnum1, printnum2);
- pixel_colors = build_string (buffer);
+ pixel_colors
+ = make_formatted_string (buffer, "%"pMu" %"pMu, printnum1, printnum2);
XSETFRAME (frame, f);
loader = image_spec_value (img->spec, QCloader, NULL);
/* Kill the GS process. We should have found PIXMAP in the image
cache and its image should contain a process object. */
img = c->images[i];
- xassert (PROCESSP (img->lisp_data));
+ eassert (PROCESSP (img->lisp_data));
Fkill_process (img->lisp_data, Qnil);
img->lisp_data = Qnil;
{
XImagePtr ximg;
- BLOCK_INPUT;
+ block_input ();
/* Try to get an XImage for img->pixmep. */
ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
image_error ("Cannot get X image of `%s'; colors will not be freed",
img->spec, Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_X_WINDOWS */
/* Now that we have the pixmap, compute mask and transform the
image if requested. */
- BLOCK_INPUT;
+ block_input ();
postprocess_image (f, img);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_GHOSTSCRIPT */
Tests
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
doc: /* Value is non-nil if SPEC is a valid image specification. */)
return make_number (id);
}
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
/***********************************************************************
Initialization
***********************************************************************/
-#ifdef HAVE_NTGUI
-/* Image types that rely on external libraries are loaded dynamically
- if the library is available. */
-#define CHECK_LIB_AVAILABLE(image_type, init_lib_fn, libraries) \
- define_image_type (image_type, init_lib_fn (libraries))
-#else
-#define CHECK_LIB_AVAILABLE(image_type, init_lib_fn, libraries) \
- define_image_type (image_type, 1)
-#endif /* HAVE_NTGUI */
-
-DEFUN ("init-image-library", Finit_image_library, Sinit_image_library, 2, 2, 0,
+DEFUN ("init-image-library", Finit_image_library, Sinit_image_library, 1, 1, 0,
doc: /* Initialize image library implementing image type TYPE.
Return non-nil if TYPE is a supported image type.
-Image types pbm and xbm are prebuilt; other types are loaded here.
-Libraries to load are specified in alist LIBRARIES (usually, the value
-of `dynamic-library-alist', which see). */)
- (Lisp_Object type, Lisp_Object libraries)
+If image libraries are loaded dynamically (currently only the case on
+MS-Windows), load the library for TYPE if it is not yet loaded, using
+the library file(s) specified by `dynamic-library-alist'. */)
+ (Lisp_Object type)
{
-#ifdef HAVE_NTGUI
- /* Don't try to reload the library. */
- Lisp_Object tested = Fassq (type, Vlibrary_cache);
- if (CONSP (tested))
- return XCDR (tested);
-#endif
+ return lookup_image_type (type) ? Qt : Qnil;
+}
+
+/* Look up image type TYPE, and return a pointer to its image_type
+ structure. Return 0 if TYPE is not a known image type. */
+static struct image_type *
+lookup_image_type (Lisp_Object type)
+{
/* Types pbm and xbm are built-in and always available. */
- if (EQ (type, Qpbm) || EQ (type, Qxbm))
- return Qt;
+ if (EQ (type, Qpbm))
+ return define_image_type (&pbm_type);
+
+ if (EQ (type, Qxbm))
+ return define_image_type (&xbm_type);
#if defined (HAVE_XPM) || defined (HAVE_NS)
if (EQ (type, Qxpm))
- return CHECK_LIB_AVAILABLE (&xpm_type, init_xpm_functions, libraries);
+ return define_image_type (&xpm_type);
#endif
#if defined (HAVE_JPEG) || defined (HAVE_NS)
if (EQ (type, Qjpeg))
- return CHECK_LIB_AVAILABLE (&jpeg_type, init_jpeg_functions, libraries);
+ return define_image_type (&jpeg_type);
#endif
#if defined (HAVE_TIFF) || defined (HAVE_NS)
if (EQ (type, Qtiff))
- return CHECK_LIB_AVAILABLE (&tiff_type, init_tiff_functions, libraries);
+ return define_image_type (&tiff_type);
#endif
#if defined (HAVE_GIF) || defined (HAVE_NS)
if (EQ (type, Qgif))
- return CHECK_LIB_AVAILABLE (&gif_type, init_gif_functions, libraries);
+ return define_image_type (&gif_type);
#endif
#if defined (HAVE_PNG) || defined (HAVE_NS)
if (EQ (type, Qpng))
- return CHECK_LIB_AVAILABLE (&png_type, init_png_functions, libraries);
+ return define_image_type (&png_type);
#endif
#if defined (HAVE_RSVG)
if (EQ (type, Qsvg))
- return CHECK_LIB_AVAILABLE (&svg_type, init_svg_functions, libraries);
+ return define_image_type (&svg_type);
#endif
#if defined (HAVE_IMAGEMAGICK)
if (EQ (type, Qimagemagick))
- return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions,
- libraries);
+ return define_image_type (&imagemagick_type);
#endif
#ifdef HAVE_GHOSTSCRIPT
if (EQ (type, Qpostscript))
- return CHECK_LIB_AVAILABLE (&gs_type, init_gs_functions, libraries);
+ return define_image_type (&gs_type);
#endif
- /* If the type is not recognized, avoid testing it ever again. */
- CACHE_IMAGE_TYPE (type, Qnil);
- return Qnil;
+ return NULL;
+}
+
+/* Reset image_types before dumping.
+ Called from Fdump_emacs. */
+
+void
+reset_image_types (void)
+{
+ while (image_types)
+ {
+ struct image_type *next = image_types->next;
+ xfree (image_types);
+ image_types = next;
+ }
}
void
syms_of_image (void)
{
- /* Initialize this only once, since that's what we do with Vimage_types
- and they are supposed to be in sync. Initializing here gives correct
- operation on GNU/Linux of calling dump-emacs after loading some images. */
+ /* Initialize this only once; it will be reset before dumping. */
image_types = NULL;
/* Must be defined now because we're going to update it below, while
non-numeric, there is no explicit limit on the size of images. */);
Vmax_image_size = make_float (MAX_IMAGE_SIZE);
- DEFSYM (Qpbm, "pbm");
- ADD_IMAGE_TYPE (Qpbm);
-
- DEFSYM (Qxbm, "xbm");
- ADD_IMAGE_TYPE (Qxbm);
-
- define_image_type (&xbm_type, 1);
- define_image_type (&pbm_type, 1);
-
DEFSYM (Qcount, "count");
DEFSYM (Qextension_data, "extension-data");
DEFSYM (Qdelay, "delay");
);
#endif
+ DEFSYM (Qpbm, "pbm");
+ ADD_IMAGE_TYPE (Qpbm);
+
+ DEFSYM (Qxbm, "xbm");
+ ADD_IMAGE_TYPE (Qxbm);
+
#if defined (HAVE_XPM) || defined (HAVE_NS)
DEFSYM (Qxpm, "xpm");
ADD_IMAGE_TYPE (Qxpm);
defsubr (&Simage_mask_p);
defsubr (&Simage_metadata);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
defsubr (&Simagep);
defsubr (&Slookup_image);
#endif
#endif
}
-
-void
-init_image (void)
-{
-}
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "category.h"
#include "composite.h"
#include "indent.h"
Some things in set last_known_column_point to -1
to mark the memorized value as invalid. */
-static EMACS_INT last_known_column;
+static ptrdiff_t last_known_column;
/* Value of point when current_column was called. */
-EMACS_INT last_known_column_point;
+ptrdiff_t last_known_column_point;
/* Value of MODIFF when current_column was called. */
-static int last_known_column_modified;
+static EMACS_INT last_known_column_modified;
-static EMACS_INT current_column_1 (void);
-static EMACS_INT position_indentation (ptrdiff_t);
+static ptrdiff_t current_column_1 (void);
+static ptrdiff_t position_indentation (ptrdiff_t);
/* Cache of beginning of line found by the last call of
current_column. */
-static EMACS_INT current_column_bol_cache;
+static ptrdiff_t current_column_bol_cache;
/* Get the display table to use for the current buffer. */
for characters as WIDTHTAB. We use this to decide when to
invalidate the buffer's width_run_cache. */
-int
+bool
disptab_matches_widthtab (struct Lisp_Char_Table *disptab, struct Lisp_Vector *widthtab)
{
int i;
if (widthtab->header.size != 256)
- abort ();
+ emacs_abort ();
for (i = 0; i < 256; i++)
if (character_width (i, disptab)
struct Lisp_Vector *widthtab;
if (!VECTORP (BVAR (buf, width_table)))
- BVAR (buf, width_table) = Fmake_vector (make_number (256), make_number (0));
+ bset_width_table (buf, Fmake_vector (make_number (256), make_number (0)));
widthtab = XVECTOR (BVAR (buf, width_table));
if (widthtab->header.size != 256)
- abort ();
+ emacs_abort ();
for (i = 0; i < 256; i++)
XSETFASTINT (widthtab->contents[i], character_width (i, disptab));
{
free_region_cache (current_buffer->width_run_cache);
current_buffer->width_run_cache = 0;
- BVAR (current_buffer, width_table) = Qnil;
+ bset_width_table (current_buffer, Qnil);
}
}
else
characters immediately following, then *NEXT_BOUNDARY_P
will equal the return value. */
-EMACS_INT
-skip_invisible (EMACS_INT pos, EMACS_INT *next_boundary_p, EMACS_INT to, Lisp_Object window)
+ptrdiff_t
+skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p, ptrdiff_t to, Lisp_Object window)
{
Lisp_Object prop, position, overlay_limit, proplimit;
Lisp_Object buffer, tmp;
- EMACS_INT end;
+ ptrdiff_t end;
int inv_p;
XSETFASTINT (position, pos);
last_known_column_point = 0;
}
-EMACS_INT
+ptrdiff_t
current_column (void)
{
- register EMACS_INT col;
- register unsigned char *ptr, *stop;
- register int tab_seen;
- EMACS_INT post_tab;
- register int c;
+ ptrdiff_t col;
+ unsigned char *ptr, *stop;
+ bool tab_seen;
+ ptrdiff_t post_tab;
+ int c;
int tab_width = SANE_TAB_WIDTH (current_buffer);
- int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
- register struct Lisp_Char_Table *dp = buffer_display_table ();
+ bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
+ struct Lisp_Char_Table *dp = buffer_display_table ();
if (PT == last_known_column_point
&& MODIFF == last_known_column_modified)
/* 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_intervals (current_buffer)
+ || buffer_has_overlays ()
|| Z != Z_BYTE)
return current_column_1 ();
while (1)
{
- EMACS_INT i, n;
+ ptrdiff_t i, n;
Lisp_Object charvec;
if (ptr == stop)
next_element_from_display_vector does it. */
Lisp_Object entry = AREF (charvec, i);
- if (GLYPH_CODE_P (entry)
- && GLYPH_CODE_CHAR_VALID_P (entry))
+ if (GLYPH_CODE_P (entry))
c = GLYPH_CODE_CHAR (entry);
else
c = ' ';
in ENDPOS.
Otherwise just return -1. */
static int
-check_display_width (EMACS_INT pos, EMACS_INT col, EMACS_INT *endpos)
+check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos)
{
Lisp_Object val, overlay;
{ /* FIXME: Use calc_pixel_width_or_height. */
Lisp_Object plist = XCDR (val), prop;
int width = -1;
+ EMACS_INT align_to_max =
+ (col < MOST_POSITIVE_FIXNUM - INT_MAX
+ ? (EMACS_INT) INT_MAX + col
+ : MOST_POSITIVE_FIXNUM);
- if ((prop = Fplist_get (plist, QCwidth), NATNUMP (prop)))
+ if ((prop = Fplist_get (plist, QCwidth),
+ RANGED_INTEGERP (0, prop, INT_MAX)))
width = XINT (prop);
- else if (FLOATP (prop))
+ else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop)
+ && XFLOAT_DATA (prop) <= INT_MAX)
width = (int)(XFLOAT_DATA (prop) + 0.5);
- else if ((prop = Fplist_get (plist, QCalign_to), NATNUMP (prop)))
+ else if ((prop = Fplist_get (plist, QCalign_to),
+ RANGED_INTEGERP (col, prop, align_to_max)))
width = XINT (prop) - col;
- else if (FLOATP (prop))
+ else if (FLOATP (prop) && col <= XFLOAT_DATA (prop)
+ && (XFLOAT_DATA (prop) <= align_to_max))
width = (int)(XFLOAT_DATA (prop) + 0.5) - col;
if (width >= 0)
{
- EMACS_INT start;
+ ptrdiff_t start;
if (OVERLAYP (overlay))
*endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
else
PREVCOL gets set to the column of the previous position (it's always
strictly smaller than the goal column). */
static void
-scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol)
+scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol)
{
int tab_width = SANE_TAB_WIDTH (current_buffer);
- register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
- register struct Lisp_Char_Table *dp = buffer_display_table ();
- int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
+ struct Lisp_Char_Table *dp = buffer_display_table ();
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
struct composition_it cmp_it;
Lisp_Object window;
struct window *w;
/* Start the scan at the beginning of this line with column number 0. */
- register EMACS_INT col = 0, prev_col = 0;
+ register ptrdiff_t col = 0, prev_col = 0;
EMACS_INT goal = goalcol ? *goalcol : MOST_POSITIVE_FIXNUM;
- EMACS_INT end = endpos ? *endpos : PT;
- EMACS_INT scan, scan_byte;
- EMACS_INT next_boundary;
+ ptrdiff_t end = endpos ? *endpos : PT;
+ ptrdiff_t scan, scan_byte;
+ ptrdiff_t next_boundary;
{
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1);
current_column_bol_cache = PT;
scan = PT, scan_byte = PT_BYTE;
/* Occasionally we may need to skip invisible text. */
while (scan == next_boundary)
{
- EMACS_INT old_scan = scan;
+ ptrdiff_t old_scan = scan;
/* This updates NEXT_BOUNDARY to the next place
where we might need to skip more invisible text. */
scan = skip_invisible (scan, &next_boundary, end, Qnil);
prev_col = col;
{ /* Check display property. */
- EMACS_INT endp;
+ ptrdiff_t endp;
int width = check_display_width (scan, col, &endp);
if (width >= 0)
{
&& VECTORP (DISP_CHAR_VECTOR (dp, c)))
{
Lisp_Object charvec;
- EMACS_INT i, n;
+ ptrdiff_t i, n;
/* This character is displayed using a vector of glyphs.
Update the column/position based on those glyphs. */
next_element_from_display_vector does it. */
Lisp_Object entry = AREF (charvec, i);
- if (GLYPH_CODE_P (entry)
- && GLYPH_CODE_CHAR_VALID_P (entry))
+ if (GLYPH_CODE_P (entry))
c = GLYPH_CODE_CHAR (entry);
else
c = ' ';
This function handles characters that are invisible
due to text properties or overlays. */
-static EMACS_INT
+static ptrdiff_t
current_column_1 (void)
{
EMACS_INT col = MOST_POSITIVE_FIXNUM;
- EMACS_INT opoint = PT;
+ ptrdiff_t opoint = PT;
scan_for_column (&opoint, &col, NULL);
return col;
static double
string_display_width (Lisp_Object string, Lisp_Object beg, Lisp_Object end)
{
- register int col;
- register unsigned char *ptr, *stop;
- register int tab_seen;
+ int col;
+ unsigned char *ptr, *stop;
+ bool tab_seen;
int post_tab;
- register int c;
+ int c;
int tab_width = SANE_TAB_WIDTH (current_buffer);
- int ctl_arrow = !NILP (current_buffer->ctl_arrow);
- register struct Lisp_Char_Table *dp = buffer_display_table ();
+ bool ctl_arrow = !NILP (current_buffer->ctl_arrow);
+ struct Lisp_Char_Table *dp = buffer_display_table ();
int b, e;
if (NILP (end))
(Lisp_Object column, Lisp_Object minimum)
{
EMACS_INT mincol;
- register EMACS_INT fromcol;
+ register ptrdiff_t fromcol;
int tab_width = SANE_TAB_WIDTH (current_buffer);
CHECK_NUMBER (column);
(void)
{
Lisp_Object val;
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1);
return val;
}
-static EMACS_INT
+static ptrdiff_t
position_indentation (ptrdiff_t pos_byte)
{
- register EMACS_INT column = 0;
+ register ptrdiff_t column = 0;
int tab_width = SANE_TAB_WIDTH (current_buffer);
register unsigned char *p;
register unsigned char *stop;
unsigned char *start;
- EMACS_INT next_boundary_byte = pos_byte;
- EMACS_INT ceiling = next_boundary_byte;
+ ptrdiff_t next_boundary_byte = pos_byte;
+ ptrdiff_t ceiling = next_boundary_byte;
p = BYTE_POS_ADDR (pos_byte);
/* STOP records the value of P at which we will need
{
while (p == stop)
{
- EMACS_INT stop_pos_byte;
+ ptrdiff_t stop_pos_byte;
/* If we have updated P, set POS_BYTE to match.
The first time we enter the loop, POS_BYTE is already right. */
return column;
if (pos_byte == next_boundary_byte)
{
- EMACS_INT next_boundary;
- EMACS_INT pos = BYTE_TO_CHAR (pos_byte);
+ ptrdiff_t next_boundary;
+ ptrdiff_t pos = BYTE_TO_CHAR (pos_byte);
pos = skip_invisible (pos, &next_boundary, ZV, Qnil);
pos_byte = CHAR_TO_BYTE (pos);
next_boundary_byte = CHAR_TO_BYTE (next_boundary);
Blank lines are treated as if they had the same indentation as the
preceding line. */
-int
-indented_beyond_p (EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT column)
+bool
+indented_beyond_p (ptrdiff_t pos, ptrdiff_t pos_byte, EMACS_INT column)
{
- EMACS_INT val;
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t val;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
SET_PT_BOTH (pos, pos_byte);
while (PT > BEGV && FETCH_BYTE (PT_BYTE) == '\n')
return val >= column;
}
\f
-DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2, "p",
+DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2,
+ "NMove to column: ",
doc: /* Move point to column COLUMN in the current line.
Interactively, COLUMN is the value of prefix numeric argument.
The column of a character is calculated by adding together the widths
The return value is the current column. */)
(Lisp_Object column, Lisp_Object force)
{
- EMACS_INT pos;
- EMACS_INT col, prev_col;
+ ptrdiff_t pos, prev_col;
+ EMACS_INT col;
EMACS_INT goal;
CHECK_NATNUM (column);
if (!NILP (force) && col > goal)
{
int c;
- EMACS_INT pos_byte = PT_BYTE;
+ ptrdiff_t pos_byte = PT_BYTE;
DEC_POS (pos_byte);
c = FETCH_CHAR (pos_byte);
if (c == '\t' && prev_col < goal)
{
- EMACS_INT goal_pt, goal_pt_byte;
+ ptrdiff_t goal_pt, goal_pt_byte;
/* Insert spaces in front of the tab to reach GOAL. Do this
first so that a marker at the end of the tab gets
can't hit the requested column exactly (because of a tab or other
multi-column character), overshoot.
- DID_MOTION is 1 if FROMHPOS has already accounted for overlay strings
+ DID_MOTION is true if FROMHPOS has already accounted for overlay strings
at FROM. This is the case if FROMVPOS and FROMVPOS came from an
earlier call to compute_motion. The other common case is that FROMHPOS
is zero and FROM is a position that "belongs" at column zero, but might
- be shifted by overlay strings; in this case DID_MOTION should be 0.
+ be shifted by overlay strings; in this case DID_MOTION should be false.
WIDTH is the number of columns available to display text;
compute_motion uses this to handle continuation lines and such.
the scroll bars if they are turned on. */
struct position *
-compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_motion, EMACS_INT to, EMACS_INT tovpos, EMACS_INT tohpos, EMACS_INT width, EMACS_INT hscroll, EMACS_INT tab_offset, struct window *win)
+compute_motion (ptrdiff_t from, EMACS_INT fromvpos, EMACS_INT fromhpos,
+ bool did_motion, ptrdiff_t to,
+ EMACS_INT tovpos, EMACS_INT tohpos, EMACS_INT width,
+ ptrdiff_t hscroll, int tab_offset, struct window *win)
{
- register EMACS_INT hpos = fromhpos;
- register EMACS_INT vpos = fromvpos;
+ EMACS_INT hpos = fromhpos;
+ EMACS_INT vpos = fromvpos;
- register EMACS_INT pos;
- EMACS_INT pos_byte;
- register int c = 0;
+ ptrdiff_t pos;
+ ptrdiff_t pos_byte;
+ int c = 0;
int tab_width = SANE_TAB_WIDTH (current_buffer);
- register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
- register struct Lisp_Char_Table *dp = window_display_table (win);
+ bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
+ struct Lisp_Char_Table *dp = window_display_table (win);
EMACS_INT selective
= (INTEGERP (BVAR (current_buffer, selective_display))
? XINT (BVAR (current_buffer, selective_display))
: !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0);
- int selective_rlen
+ ptrdiff_t selective_rlen
= (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp))
? ASIZE (DISP_INVIS_VECTOR (dp)) : 0);
/* The next location where the `invisible' property changes, or an
overlay starts or ends. */
- EMACS_INT next_boundary = from;
+ ptrdiff_t next_boundary = from;
/* For computing runs of characters with similar widths.
Invariant: width_run_width is zero, or all the characters
from width_run_start to width_run_end have a fixed width of
width_run_width. */
- EMACS_INT width_run_start = from;
- EMACS_INT width_run_end = from;
- EMACS_INT width_run_width = 0;
+ ptrdiff_t width_run_start = from;
+ ptrdiff_t width_run_end = from;
+ ptrdiff_t width_run_width = 0;
Lisp_Object *width_table;
- Lisp_Object buffer;
/* The next buffer pos where we should consult the width run cache. */
- EMACS_INT next_width_run = from;
+ ptrdiff_t next_width_run = from;
Lisp_Object window;
- int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
/* If previous char scanned was a wide character,
this is the column where it ended. Otherwise, this is 0. */
EMACS_INT wide_column_end_hpos = 0;
- EMACS_INT prev_pos; /* Previous buffer position. */
- EMACS_INT prev_pos_byte; /* Previous buffer position. */
+ ptrdiff_t prev_pos; /* Previous buffer position. */
+ ptrdiff_t prev_pos_byte; /* Previous buffer position. */
EMACS_INT prev_hpos = 0;
EMACS_INT prev_vpos = 0;
EMACS_INT contin_hpos; /* HPOS of last column of continued line. */
- EMACS_INT prev_tab_offset; /* Previous tab offset. */
- EMACS_INT continuation_glyph_width;
+ int prev_tab_offset; /* Previous tab offset. */
+ int continuation_glyph_width;
struct composition_it cmp_it;
- XSETBUFFER (buffer, current_buffer);
XSETWINDOW (window, win);
width_run_cache_on_off ();
{
while (pos == next_boundary)
{
- EMACS_INT pos_here = pos;
- EMACS_INT newpos;
+ ptrdiff_t pos_here = pos;
+ ptrdiff_t newpos;
/* Don't skip invisible if we are already at the margin. */
if (vpos > tovpos || (vpos == tovpos && hpos >= tohpos))
to be changed here. */
{
unsigned char *ovstr;
- EMACS_INT ovlen = overlay_strings (pos, win, &ovstr);
+ ptrdiff_t ovlen = overlay_strings (pos, win, &ovstr);
hpos += ((multibyte && ovlen > 0)
? strwidth ((char *) ovstr, ovlen) : ovlen);
}
if (hpos > width)
{
- int total_width = width + continuation_glyph_width;
- int truncate = 0;
+ EMACS_INT total_width = width + continuation_glyph_width;
+ bool truncate = 0;
if (!NILP (Vtruncate_partial_width_windows)
&& (total_width < FRAME_COLS (XFRAME (WINDOW_FRAME (win)))))
want to skip over it for some other reason. */
if (common_width != 0)
{
- EMACS_INT run_end_hpos;
+ ptrdiff_t run_end_hpos;
/* Don't go past the final buffer posn the user
requested. */
/* We have to scan the text character-by-character. */
else
{
- EMACS_INT i, n;
+ ptrdiff_t i, n;
Lisp_Object charvec;
/* Check composition sequence. */
next_element_from_display_vector does it. */
Lisp_Object entry = AREF (charvec, i);
- if (GLYPH_CODE_P (entry)
- && GLYPH_CODE_CHAR_VALID_P (entry))
+ if (GLYPH_CODE_P (entry))
c = GLYPH_CODE_CHAR (entry);
else
c = ' ';
val_compute_motion.prevhpos = contin_hpos;
else
val_compute_motion.prevhpos = prev_hpos;
- /* We always handle all of them here; none of them remain to do. */
- val_compute_motion.ovstring_chars_done = 0;
/* Nonzero if have just continued a line */
val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
struct window *w;
Lisp_Object bufpos, hpos, vpos, prevhpos;
struct position *pos;
- EMACS_INT hscroll, tab_offset;
+ ptrdiff_t hscroll;
+ int tab_offset;
CHECK_NUMBER_COERCE_MARKER (from);
CHECK_CONS (frompos);
CHECK_CONS (offsets);
CHECK_NUMBER_CAR (offsets);
CHECK_NUMBER_CDR (offsets);
+ if (! (0 <= XINT (XCAR (offsets)) && XINT (XCAR (offsets)) <= PTRDIFF_MAX
+ && 0 <= XINT (XCDR (offsets)) && XINT (XCDR (offsets)) <= INT_MAX))
+ args_out_of_range (XCAR (offsets), XCDR (offsets));
hscroll = XINT (XCAR (offsets));
tab_offset = XINT (XCDR (offsets));
}
static struct position val_vmotion;
struct position *
-vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w)
+vmotion (register ptrdiff_t from, register EMACS_INT vtarget, struct window *w)
{
- EMACS_INT hscroll = XINT (w->hscroll);
+ ptrdiff_t hscroll = w->hscroll;
struct position pos;
/* vpos is cumulative vertical position, changed as from is changed */
- register int vpos = 0;
- EMACS_INT prevline;
- register EMACS_INT first;
- EMACS_INT from_byte;
- EMACS_INT lmargin = hscroll > 0 ? 1 - hscroll : 0;
- EMACS_INT selective
+ register EMACS_INT vpos = 0;
+ ptrdiff_t prevline;
+ register ptrdiff_t first;
+ ptrdiff_t from_byte;
+ ptrdiff_t lmargin = hscroll > 0 ? 1 - hscroll : 0;
+ ptrdiff_t selective
= (INTEGERP (BVAR (current_buffer, selective_display))
- ? XINT (BVAR (current_buffer, selective_display))
+ ? clip_to_bounds (-1, XINT (BVAR (current_buffer, selective_display)),
+ PTRDIFF_MAX)
: !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0);
Lisp_Object window;
- EMACS_INT start_hpos = 0;
- int did_motion;
+ bool did_motion;
/* This is the object we use for fetching character properties. */
Lisp_Object text_prop_object;
TEXT_PROP_MEANS_INVISIBLE (propval))))
prevline = find_next_newline_no_quit (prevline - 1, -1);
pos = *compute_motion (prevline, 0,
- lmargin + (prevline == BEG ? start_hpos : 0),
+ lmargin,
0,
from,
/* Don't care for VPOS... */
/* ... nor HPOS. */
1 << (BITS_PER_SHORT - 1),
-1, hscroll,
- /* This compensates for start_hpos
- so that a tab as first character
- still occupies 8 columns. */
- (prevline == BEG ? -start_hpos : 0),
+ 0,
w);
vpos -= pos.vpos;
first = 0;
val_vmotion.hpos = lmargin;
val_vmotion.contin = 0;
val_vmotion.prevhpos = 0;
- val_vmotion.ovstring_chars_done = 0;
- val_vmotion.tab_offset = 0; /* For accumulating tab offset. */
return &val_vmotion;
}
TEXT_PROP_MEANS_INVISIBLE (propval))))
prevline = find_next_newline_no_quit (prevline - 1, -1);
pos = *compute_motion (prevline, 0,
- lmargin + (prevline == BEG
- ? start_hpos : 0),
+ lmargin,
0,
from,
/* Don't care for VPOS... */
/* ... nor HPOS. */
1 << (BITS_PER_SHORT - 1),
-1, hscroll,
- (prevline == BEG ? -start_hpos : 0),
+ 0,
w);
did_motion = 1;
}
else
{
- pos.hpos = lmargin + (from == BEG ? start_hpos : 0);
+ pos.hpos = lmargin;
pos.vpos = 0;
- pos.tab_offset = 0;
did_motion = 0;
}
return compute_motion (from, vpos, pos.hpos, did_motion,
ZV, vtarget, - (1 << (BITS_PER_SHORT - 1)),
-1, hscroll,
- pos.tab_offset - (from == BEG ? start_hpos : 0),
+ 0,
w);
}
old_buffer = w->buffer;
old_charpos = XMARKER (w->pointm)->charpos;
old_bytepos = XMARKER (w->pointm)->bytepos;
- XSETBUFFER (w->buffer, current_buffer);
- set_marker_both
- (w->pointm, w->buffer, BUF_PT (current_buffer), BUF_PT_BYTE (current_buffer));
+ wset_buffer (w, Fcurrent_buffer ());
+ set_marker_both (w->pointm, w->buffer,
+ BUF_PT (current_buffer), BUF_PT_BYTE (current_buffer));
}
if (noninteractive)
}
else
{
- EMACS_INT it_start;
- int first_x, it_overshoot_count = 0;
- int overshoot_handled = 0;
+ ptrdiff_t it_start, it_overshoot_count = 0;
+ int first_x;
+ bool overshoot_handled = 0;
+ bool disp_string_at_start_p = 0;
itdata = bidi_shelve_cache ();
SET_TEXT_POS (pt, PT, PT_BYTE);
{
const char *s = SSDATA (it.string);
const char *e = s + SBYTES (it.string);
+
+ disp_string_at_start_p = it.string_from_display_prop_p;
while (s < e)
{
if (*s++ == '\n')
/* IT may move too far if truncate-lines is on and PT lies
beyond the right margin. IT may also move too far if the
starting point is on a Lisp string that has embedded
- newlines. In these cases, backtrack. */
+ newlines, or spans several screen lines. In these cases,
+ backtrack. */
if (IT_CHARPOS (it) > it_start)
{
/* We need to backtrack also if the Lisp string contains no
&& it.method == GET_FROM_BUFFER
&& it.c == '\n')
it_overshoot_count = 1;
+ else if (disp_string_at_start_p && it.vpos > 0)
+ {
+ /* This is the case of a display string that spans
+ several screen lines. In that case, we end up at the
+ end of the string, and it.vpos tells us how many
+ screen lines we need to backtrack. */
+ it_overshoot_count = it.vpos;
+ }
if (it_overshoot_count > 0)
move_it_by_lines (&it, -it_overshoot_count);
/* Do this even if LINES is 0, so that we move back to the
beginning of the current line as we ought. */
if (XINT (lines) == 0 || IT_CHARPOS (it) > 0)
- move_it_by_lines (&it, max (INT_MIN, XINT (lines)));
+ move_it_by_lines (&it, max (PTRDIFF_MIN, XINT (lines)));
}
else if (overshoot_handled)
{
it.vpos = 0;
- move_it_by_lines (&it, min (INT_MAX, XINT (lines)));
+ move_it_by_lines (&it, min (PTRDIFF_MAX, XINT (lines)));
}
else
{
move_it_by_lines (&it, 1);
}
if (XINT (lines) > 1)
- move_it_by_lines (&it, min (INT_MAX, XINT (lines) - 1));
+ move_it_by_lines (&it, min (PTRDIFF_MAX, XINT (lines) - 1));
}
else
{
it.vpos = 0;
- move_it_by_lines (&it, min (INT_MAX, XINT (lines)));
+ move_it_by_lines (&it, min (PTRDIFF_MAX, XINT (lines)));
}
}
if (BUFFERP (old_buffer))
{
- w->buffer = old_buffer;
- set_marker_both (w->pointm, w->buffer, old_charpos, old_bytepos);
+ wset_buffer (w, old_buffer);
+ set_marker_both (w->pointm, w->buffer,
+ old_charpos, old_bytepos);
}
RETURN_UNGCPRO (make_number (it.vpos));
syms_of_indent (void)
{
DEFVAR_BOOL ("indent-tabs-mode", indent_tabs_mode,
- doc: /* *Indentation can insert tabs if this is non-nil. */);
+ doc: /* Indentation can insert tabs if this is non-nil. */);
indent_tabs_mode = 1;
defsubr (&Scurrent_indentation);
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-/* We introduce new member `tab_offset'. We need it because of the
- existence of wide-column characters. There is a case that the
- line-break occurs at a wide-column character and the number of
- columns of the line gets less than width.
-
- Example (where W_ stands for a wide-column character):
- ----------
- abcdefgh\\
- W_
- ----------
-
- To handle this case, we should not calculate the tab offset by
- tab_offset += width;
-
- Instead, we must remember tab_offset of the line.
-
- */
-
struct position
{
- EMACS_INT bufpos;
- EMACS_INT bytepos;
+ ptrdiff_t bufpos;
+ ptrdiff_t bytepos;
EMACS_INT hpos;
EMACS_INT vpos;
EMACS_INT prevhpos;
- EMACS_INT contin;
- /* Number of characters we have already handled
- from the before and after strings at this position. */
- EMACS_INT ovstring_chars_done;
- EMACS_INT tab_offset;
+ int contin;
};
-struct position *compute_motion (EMACS_INT from, EMACS_INT fromvpos,
- EMACS_INT fromhpos, int did_motion,
- EMACS_INT to, EMACS_INT tovpos,
+struct position *compute_motion (ptrdiff_t from, EMACS_INT fromvpos,
+ EMACS_INT fromhpos, bool did_motion,
+ ptrdiff_t to, EMACS_INT tovpos,
EMACS_INT tohpos,
- EMACS_INT width, EMACS_INT hscroll,
- EMACS_INT tab_offset, struct window *);
-struct position *vmotion (EMACS_INT from, EMACS_INT vtarget,
+ EMACS_INT width, ptrdiff_t hscroll,
+ int tab_offset, struct window *);
+struct position *vmotion (ptrdiff_t from, EMACS_INT vtarget,
struct window *);
-EMACS_INT skip_invisible (EMACS_INT pos, EMACS_INT *next_boundary_p,
- EMACS_INT to, Lisp_Object window);
+ptrdiff_t skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p,
+ ptrdiff_t to, Lisp_Object window);
/* Value of point when current_column was called */
-extern EMACS_INT last_known_column_point;
+extern ptrdiff_t last_known_column_point;
/* Functions for dealing with the column cache. */
/* Return true if the display table DISPTAB specifies the same widths
for characters as WIDTHTAB. We use this to decide when to
invalidate the buffer's column_cache. */
-int disptab_matches_widthtab (struct Lisp_Char_Table *disptab,
- struct Lisp_Vector *widthtab);
+bool disptab_matches_widthtab (struct Lisp_Char_Table *disptab,
+ struct Lisp_Vector *widthtab);
/* Recompute BUF's width table, using the display table DISPTAB. */
void recompute_width_table (struct buffer *buf,
#include <config.h>
-#include <setjmp.h>
#include <intprops.h>
#include "lisp.h"
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "window.h"
#include "blockinput.h"
#include "region-cache.h"
-#ifndef NULL
-#define NULL 0
-#endif
-
-static void insert_from_string_1 (Lisp_Object string,
- EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT nchars, EMACS_INT nbytes,
- int inherit, int before_markers);
-static void insert_from_buffer_1 (struct buffer *buf,
- EMACS_INT from, EMACS_INT nchars,
- int inherit);
-static void gap_left (EMACS_INT charpos, EMACS_INT bytepos, int newgap);
-static void gap_right (EMACS_INT charpos, EMACS_INT bytepos);
-
-static Lisp_Object Fcombine_after_change_execute (void);
+static void insert_from_string_1 (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, bool, bool);
+static void insert_from_buffer_1 (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
+static void gap_left (ptrdiff_t, ptrdiff_t, bool);
+static void gap_right (ptrdiff_t, ptrdiff_t);
/* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
describing changes which happened while combine_after_change_calls
- was nonzero. We use this to decide how to call them
+ was non-nil. We use this to decide how to call them
once the deferral ends.
In each element.
Lisp_Object Qinhibit_modification_hooks;
-static void signal_before_change (EMACS_INT, EMACS_INT, EMACS_INT *);
-\f
-#define CHECK_MARKERS() \
- do \
- { \
- if (check_markers_debug_flag) \
- check_markers (); \
- } \
- while (0)
+static void signal_before_change (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
+
+/* Also used in marker.c to enable expensive marker checks. */
+
+#ifdef MARKER_DEBUG
static void
check_markers (void)
{
- register struct Lisp_Marker *tail;
- int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ struct Lisp_Marker *tail;
+ bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
{
if (tail->buffer->text != current_buffer->text)
- abort ();
+ emacs_abort ();
if (tail->charpos > Z)
- abort ();
+ emacs_abort ();
if (tail->bytepos > Z_BYTE)
- abort ();
+ emacs_abort ();
if (multibyte && ! CHAR_HEAD_P (FETCH_BYTE (tail->bytepos)))
- abort ();
+ emacs_abort ();
}
}
-\f
+
+#else /* not MARKER_DEBUG */
+
+#define check_markers() do { } while (0)
+
+#endif /* MARKER_DEBUG */
+
/* Move gap to position CHARPOS.
Note that this can quit! */
void
-move_gap (EMACS_INT charpos)
+move_gap (ptrdiff_t charpos)
{
move_gap_both (charpos, charpos_to_bytepos (charpos));
}
Note that this can quit! */
void
-move_gap_both (EMACS_INT charpos, EMACS_INT bytepos)
+move_gap_both (ptrdiff_t charpos, ptrdiff_t bytepos)
{
if (bytepos < GPT_BYTE)
gap_left (charpos, bytepos, 0);
/* Move the gap to a position less than the current GPT.
BYTEPOS describes the new position as a byte position,
and CHARPOS is the corresponding char position.
- If NEWGAP is nonzero, then don't update beg_unchanged and end_unchanged. */
+ If NEWGAP, then don't update beg_unchanged and end_unchanged. */
static void
-gap_left (EMACS_INT charpos, EMACS_INT bytepos, int newgap)
+gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap)
{
- register unsigned char *to, *from;
- register EMACS_INT i;
- EMACS_INT new_s1;
+ unsigned char *to, *from;
+ ptrdiff_t i;
+ ptrdiff_t new_s1;
if (!newgap)
BUF_COMPUTE_UNCHANGED (current_buffer, charpos, GPT);
was specified or may be where a quit was detected. */
GPT_BYTE = bytepos;
GPT = charpos;
- if (bytepos < charpos)
- abort ();
+ eassert (charpos <= bytepos);
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
QUIT;
}
and CHARPOS is the corresponding char position. */
static void
-gap_right (EMACS_INT charpos, EMACS_INT bytepos)
+gap_right (ptrdiff_t charpos, ptrdiff_t bytepos)
{
register unsigned char *to, *from;
- register EMACS_INT i;
- EMACS_INT new_s1;
+ register ptrdiff_t i;
+ ptrdiff_t new_s1;
BUF_COMPUTE_UNCHANGED (current_buffer, charpos, GPT);
GPT = charpos;
GPT_BYTE = bytepos;
- if (bytepos < charpos)
- abort ();
+ eassert (charpos <= bytepos);
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
QUIT;
}
or inside of the range being deleted. */
void
-adjust_markers_for_delete (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte)
+adjust_markers_for_delete (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte)
{
Lisp_Object marker;
register struct Lisp_Marker *m;
- register EMACS_INT charpos;
+ register ptrdiff_t charpos;
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
charpos = m->charpos;
-
- if (charpos > Z)
- abort ();
+ eassert (charpos <= Z);
/* If the marker is after the deletion,
relocate by number of chars / bytes deleted. */
or BEFORE_MARKERS is true. */
static void
-adjust_markers_for_insert (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte, int before_markers)
+adjust_markers_for_insert (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte, bool before_markers)
{
struct Lisp_Marker *m;
- int adjusted = 0;
- EMACS_INT nchars = to - from;
- EMACS_INT nbytes = to_byte - from_byte;
+ bool adjusted = 0;
+ ptrdiff_t nchars = to - from;
+ ptrdiff_t nbytes = to_byte - from_byte;
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
intervals. */
static void
-adjust_point (EMACS_INT nchars, EMACS_INT nbytes)
+adjust_point (ptrdiff_t nchars, ptrdiff_t nbytes)
{
SET_BUF_PT_BOTH (current_buffer, PT + nchars, PT_BYTE + nbytes);
/* In a single-byte buffer, the two positions must be equal. */
an insertion. */
static void
-adjust_markers_for_replace (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT old_chars, EMACS_INT old_bytes,
- EMACS_INT new_chars, EMACS_INT new_bytes)
+adjust_markers_for_replace (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t old_chars, ptrdiff_t old_bytes,
+ ptrdiff_t new_chars, ptrdiff_t new_bytes)
{
register struct Lisp_Marker *m;
- EMACS_INT prev_to_byte = from_byte + old_bytes;
- EMACS_INT diff_chars = new_chars - old_chars;
- EMACS_INT diff_bytes = new_bytes - old_bytes;
+ ptrdiff_t prev_to_byte = from_byte + old_bytes;
+ ptrdiff_t diff_chars = new_chars - old_chars;
+ ptrdiff_t diff_bytes = new_bytes - old_bytes;
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
}
}
- CHECK_MARKERS ();
+ check_markers ();
}
\f
/* Make the gap NBYTES_ADDED bytes longer. */
static void
-make_gap_larger (EMACS_INT nbytes_added)
+make_gap_larger (ptrdiff_t nbytes_added)
{
Lisp_Object tem;
- EMACS_INT real_gap_loc;
- EMACS_INT real_gap_loc_byte;
- EMACS_INT old_gap_size;
- EMACS_INT current_size = Z_BYTE - BEG_BYTE + GAP_SIZE;
+ ptrdiff_t real_gap_loc;
+ ptrdiff_t real_gap_loc_byte;
+ ptrdiff_t old_gap_size;
+ ptrdiff_t current_size = Z_BYTE - BEG_BYTE + GAP_SIZE;
enum { enough_for_a_while = 2000 };
if (BUF_BYTES_MAX - current_size < nbytes_added)
/* Make the gap NBYTES_REMOVED bytes shorter. */
static void
-make_gap_smaller (EMACS_INT nbytes_removed)
+make_gap_smaller (ptrdiff_t nbytes_removed)
{
Lisp_Object tem;
- EMACS_INT real_gap_loc;
- EMACS_INT real_gap_loc_byte;
- EMACS_INT real_Z;
- EMACS_INT real_Z_byte;
- EMACS_INT real_beg_unchanged;
- EMACS_INT new_gap_size;
+ ptrdiff_t real_gap_loc;
+ ptrdiff_t real_gap_loc_byte;
+ ptrdiff_t real_Z;
+ ptrdiff_t real_Z_byte;
+ ptrdiff_t real_beg_unchanged;
+ ptrdiff_t new_gap_size;
/* Make sure the gap is at least 20 bytes. */
if (GAP_SIZE - nbytes_removed < 20)
#endif /* USE_MMAP_FOR_BUFFERS || REL_ALLOC || DOUG_LEA_MALLOC */
void
-make_gap (EMACS_INT nbytes_added)
+make_gap (ptrdiff_t nbytes_added)
{
if (nbytes_added >= 0)
make_gap_larger (nbytes_added);
Return the number of bytes stored at TO_ADDR. */
-EMACS_INT
+ptrdiff_t
copy_text (const unsigned char *from_addr, unsigned char *to_addr,
- EMACS_INT nbytes, int from_multibyte, int to_multibyte)
+ ptrdiff_t nbytes, bool from_multibyte, bool to_multibyte)
{
if (from_multibyte == to_multibyte)
{
}
else if (from_multibyte)
{
- EMACS_INT nchars = 0;
- EMACS_INT bytes_left = nbytes;
+ ptrdiff_t nchars = 0;
+ ptrdiff_t bytes_left = nbytes;
while (bytes_left > 0)
{
prepare_to_modify_buffer could relocate the text. */
void
-insert (const char *string, EMACS_INT nbytes)
+insert (const char *string, ptrdiff_t nbytes)
{
if (nbytes > 0)
{
- EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
+ ptrdiff_t len = chars_in_text ((unsigned char *) string, nbytes), opoint;
insert_1_both (string, len, nbytes, 0, 1, 0);
opoint = PT - len;
signal_after_change (opoint, 0, len);
/* Likewise, but inherit text properties from neighboring characters. */
void
-insert_and_inherit (const char *string, EMACS_INT nbytes)
+insert_and_inherit (const char *string, ptrdiff_t nbytes)
{
if (nbytes > 0)
{
- EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
+ ptrdiff_t len = chars_in_text ((unsigned char *) string, nbytes), opoint;
insert_1_both (string, len, nbytes, 1, 1, 0);
opoint = PT - len;
signal_after_change (opoint, 0, len);
since gc could happen and relocate it. */
void
-insert_before_markers (const char *string, EMACS_INT nbytes)
+insert_before_markers (const char *string, ptrdiff_t nbytes)
{
if (nbytes > 0)
{
- EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
+ ptrdiff_t len = chars_in_text ((unsigned char *) string, nbytes), opoint;
insert_1_both (string, len, nbytes, 0, 1, 1);
opoint = PT - len;
signal_after_change (opoint, 0, len);
void
insert_before_markers_and_inherit (const char *string,
- EMACS_INT nbytes)
+ ptrdiff_t nbytes)
{
if (nbytes > 0)
{
- EMACS_INT len = chars_in_text ((unsigned char *) string, nbytes), opoint;
+ ptrdiff_t len = chars_in_text ((unsigned char *) string, nbytes), opoint;
insert_1_both (string, len, nbytes, 1, 1, 1);
opoint = PT - len;
signal_after_change (opoint, 0, len);
/* Subroutine used by the insert functions above. */
void
-insert_1 (const char *string, EMACS_INT nbytes,
- int inherit, int prepare, int before_markers)
+insert_1 (const char *string, ptrdiff_t nbytes,
+ bool inherit, bool prepare, bool before_markers)
{
insert_1_both (string, chars_in_text ((unsigned char *) string, nbytes),
nbytes, inherit, prepare, before_markers);
which combine in this way. Otherwise, return 0. */
int
-count_combining_before (const unsigned char *string, EMACS_INT length,
- EMACS_INT pos, EMACS_INT pos_byte)
+count_combining_before (const unsigned char *string, ptrdiff_t length,
+ ptrdiff_t pos, ptrdiff_t pos_byte)
{
int len, combining_bytes;
const unsigned char *p;
int
count_combining_after (const unsigned char *string,
- EMACS_INT length, EMACS_INT pos, EMACS_INT pos_byte)
+ ptrdiff_t length, ptrdiff_t pos, ptrdiff_t pos_byte)
{
- EMACS_INT opos_byte = pos_byte;
- EMACS_INT i;
- EMACS_INT bytes;
+ ptrdiff_t opos_byte = pos_byte;
+ ptrdiff_t i;
+ ptrdiff_t bytes;
unsigned char *bufp;
if (NILP (current_buffer->enable_multibyte_characters))
void
insert_1_both (const char *string,
- EMACS_INT nchars, EMACS_INT nbytes,
- int inherit, int prepare, int before_markers)
+ ptrdiff_t nchars, ptrdiff_t nbytes,
+ bool inherit, bool prepare, bool before_markers)
{
if (nchars == 0)
return;
#ifdef BYTE_COMBINING_DEBUG
if (count_combining_before (string, nbytes, PT, PT_BYTE)
|| count_combining_after (string, nbytes, PT, PT_BYTE))
- abort ();
+ emacs_abort ();
#endif
/* Record deletion of the surrounding text that combines with
Z_BYTE += nbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
/* The insert may have been in the unchanged region, so check again. */
if (Z - GPT < END_UNCHANGED)
PT + nchars, PT_BYTE + nbytes,
before_markers);
- if (BUF_INTERVALS (current_buffer) != 0)
- offset_intervals (current_buffer, PT, nchars);
+ offset_intervals (current_buffer, PT, nchars);
- if (!inherit && BUF_INTERVALS (current_buffer) != 0)
+ if (!inherit && buffer_intervals (current_buffer))
set_text_properties (make_number (PT), make_number (PT + nchars),
Qnil, Qnil, Qnil);
adjust_point (nchars, nbytes);
- CHECK_MARKERS ();
+ check_markers ();
}
\f
/* Insert the part of the text of STRING, a Lisp object assumed to be
without insert noticing. */
void
-insert_from_string (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT length, EMACS_INT length_byte, int inherit)
+insert_from_string (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t length, ptrdiff_t length_byte, bool inherit)
{
- EMACS_INT opoint = PT;
+ ptrdiff_t opoint = PT;
if (SCHARS (string) == 0)
return;
void
insert_from_string_before_markers (Lisp_Object string,
- EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT length, EMACS_INT length_byte,
- int inherit)
+ ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t length, ptrdiff_t length_byte,
+ bool inherit)
{
- EMACS_INT opoint = PT;
+ ptrdiff_t opoint = PT;
if (SCHARS (string) == 0)
return;
/* Subroutine of the insertion functions above. */
static void
-insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT nchars, EMACS_INT nbytes,
- int inherit, int before_markers)
+insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t nchars, ptrdiff_t nbytes,
+ bool inherit, bool before_markers)
{
struct gcpro gcpro1;
- EMACS_INT outgoing_nbytes = nbytes;
+ ptrdiff_t outgoing_nbytes = nbytes;
INTERVAL intervals;
/* Make OUTGOING_NBYTES describe the text
the text that has been stored by copy_text. */
if (count_combining_before (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE)
|| count_combining_after (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE))
- abort ();
+ emacs_abort ();
#endif
record_insert (PT, nchars);
Z_BYTE += outgoing_nbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
/* The insert may have been in the unchanged region, so check again. */
if (Z - GPT < END_UNCHANGED)
offset_intervals (current_buffer, PT, nchars);
- intervals = STRING_INTERVALS (string);
+ intervals = string_intervals (string);
/* Get the intervals for the part of the string we are inserting. */
if (nbytes < SBYTES (string))
intervals = copy_intervals (intervals, pos, nchars);
adjust_point (nchars, outgoing_nbytes);
- CHECK_MARKERS ();
+ check_markers ();
}
\f
/* Insert a sequence of NCHARS chars which occupy NBYTES bytes
starting at GPT_ADDR. */
void
-insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes)
+insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes)
{
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
nchars = nbytes;
Z_BYTE += nbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
adjust_overlays_for_insert (GPT - nchars, nchars);
adjust_markers_for_insert (GPT - nchars, GPT_BYTE - nbytes,
GPT, GPT_BYTE, 0);
- if (BUF_INTERVALS (current_buffer) != 0)
+ if (buffer_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);
}
if (GPT - nchars < PT)
adjust_point (nchars, nbytes);
- CHECK_MARKERS ();
+ check_markers ();
}
\f
/* Insert text from BUF, NCHARS characters starting at CHARPOS, into the
void
insert_from_buffer (struct buffer *buf,
- EMACS_INT charpos, EMACS_INT nchars, int inherit)
+ ptrdiff_t charpos, ptrdiff_t nchars, bool inherit)
{
- EMACS_INT opoint = PT;
+ ptrdiff_t opoint = PT;
insert_from_buffer_1 (buf, charpos, nchars, inherit);
signal_after_change (opoint, 0, PT - opoint);
static void
insert_from_buffer_1 (struct buffer *buf,
- EMACS_INT from, EMACS_INT nchars, int inherit)
+ ptrdiff_t from, ptrdiff_t nchars, bool inherit)
{
- EMACS_INT chunk, chunk_expanded;
- EMACS_INT from_byte = buf_charpos_to_bytepos (buf, from);
- EMACS_INT to_byte = buf_charpos_to_bytepos (buf, from + nchars);
- EMACS_INT incoming_nbytes = to_byte - from_byte;
- EMACS_INT outgoing_nbytes = incoming_nbytes;
+ ptrdiff_t chunk, chunk_expanded;
+ ptrdiff_t from_byte = buf_charpos_to_bytepos (buf, from);
+ ptrdiff_t to_byte = buf_charpos_to_bytepos (buf, from + nchars);
+ ptrdiff_t incoming_nbytes = to_byte - from_byte;
+ ptrdiff_t outgoing_nbytes = incoming_nbytes;
INTERVAL intervals;
/* Make OUTGOING_NBYTES describe the text
outgoing_nbytes = nchars;
else if (NILP (BVAR (buf, enable_multibyte_characters)))
{
- EMACS_INT outgoing_before_gap = 0;
- EMACS_INT outgoing_after_gap = 0;
+ ptrdiff_t outgoing_before_gap = 0;
+ ptrdiff_t outgoing_after_gap = 0;
if (from < BUF_GPT (buf))
{
the text that has been stored by copy_text. */
if (count_combining_before (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE)
|| count_combining_after (GPT_ADDR, outgoing_nbytes, PT, PT_BYTE))
- abort ();
+ emacs_abort ();
#endif
record_insert (PT, nchars);
Z_BYTE += outgoing_nbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
/* The insert may have been in the unchanged region, so check again. */
if (Z - GPT < END_UNCHANGED)
PT_BYTE + outgoing_nbytes,
0);
- if (BUF_INTERVALS (current_buffer) != 0)
- offset_intervals (current_buffer, PT, nchars);
+ offset_intervals (current_buffer, PT, nchars);
/* Get the intervals for the part of the string we are inserting. */
- intervals = BUF_INTERVALS (buf);
+ intervals = buffer_intervals (buf);
if (nchars < BUF_Z (buf) - BUF_BEG (buf))
{
if (buf == current_buffer && PT <= from)
PREV_TEXT nil means the new text was just inserted. */
static void
-adjust_after_replace (EMACS_INT from, EMACS_INT from_byte,
- Lisp_Object prev_text, EMACS_INT len, EMACS_INT len_byte)
+adjust_after_replace (ptrdiff_t from, ptrdiff_t from_byte,
+ Lisp_Object prev_text, ptrdiff_t len, ptrdiff_t len_byte)
{
- EMACS_INT nchars_del = 0, nbytes_del = 0;
+ ptrdiff_t nchars_del = 0, nbytes_del = 0;
#ifdef BYTE_COMBINING_DEBUG
if (count_combining_before (GPT_ADDR, len_byte, from, from_byte)
|| count_combining_after (GPT_ADDR, len_byte, from, from_byte))
- abort ();
+ emacs_abort ();
#endif
if (STRINGP (prev_text))
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);
- }
+
+ offset_intervals (current_buffer, from, len - nchars_del);
if (from < PT)
adjust_point (len - nchars_del, len_byte - nbytes_del);
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- CHECK_MARKERS ();
+ check_markers ();
if (len == 0)
evaporate_overlays (from);
- FROM) may be incorrect, the correct length is NEWLEN. */
void
-adjust_after_insert (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte, EMACS_INT newlen)
+adjust_after_insert (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte, ptrdiff_t newlen)
{
- EMACS_INT len = to - from, len_byte = to_byte - from_byte;
+ ptrdiff_t len = to - from, len_byte = to_byte - from_byte;
if (GPT != to)
move_gap_both (to, to_byte);
}
\f
/* Replace the text from character positions FROM to TO with NEW,
- If PREPARE is nonzero, call prepare_to_modify_buffer.
+ If PREPARE, call prepare_to_modify_buffer.
If INHERIT, the newly inserted text should inherit text properties
from the surrounding non-deleted text. */
But if MARKERS is 0, don't relocate markers. */
void
-replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new,
- int prepare, int inherit, int markers)
+replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
+ bool prepare, bool inherit, bool markers)
{
- EMACS_INT inschars = SCHARS (new);
- EMACS_INT insbytes = SBYTES (new);
- EMACS_INT from_byte, to_byte;
- EMACS_INT nbytes_del, nchars_del;
+ ptrdiff_t inschars = SCHARS (new);
+ ptrdiff_t insbytes = SBYTES (new);
+ ptrdiff_t from_byte, to_byte;
+ ptrdiff_t nbytes_del, nchars_del;
struct gcpro gcpro1;
INTERVAL intervals;
- EMACS_INT outgoing_insbytes = insbytes;
+ ptrdiff_t outgoing_insbytes = insbytes;
Lisp_Object deletion;
- CHECK_MARKERS ();
+ check_markers ();
GCPRO1 (new);
deletion = Qnil;
if (prepare)
{
- EMACS_INT range_length = to - from;
+ ptrdiff_t range_length = to - from;
prepare_to_modify_buffer (from, to, &from);
to = from + range_length;
}
GPT_BYTE = from_byte;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
if (GPT - BEG < BEG_UNCHANGED)
BEG_UNCHANGED = GPT - BEG;
the text that has been stored by copy_text. */
if (count_combining_before (GPT_ADDR, outgoing_insbytes, from, from_byte)
|| count_combining_after (GPT_ADDR, outgoing_insbytes, from, from_byte))
- abort ();
+ emacs_abort ();
#endif
if (! EQ (BVAR (current_buffer, undo_list), Qt))
Z_BYTE += outgoing_insbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
-
- /* Adjust the overlay center as needed. This must be done after
- adjusting the markers that bound the overlays. */
- adjust_overlays_for_delete (from, nchars_del);
- adjust_overlays_for_insert (from, inschars);
+ eassert (GPT <= GPT_BYTE);
/* Adjust markers for the deletion and the insertion. */
if (markers)
adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
inschars, outgoing_insbytes);
+ /* Adjust the overlay center as needed. This must be done after
+ adjusting the markers that bound the overlays. */
+ adjust_overlays_for_delete (from, nchars_del);
+ adjust_overlays_for_insert (from, inschars);
+
offset_intervals (current_buffer, from, inschars - nchars_del);
/* Get the intervals for the part of the string we are inserting--
not including the combined-before bytes. */
- intervals = STRING_INTERVALS (new);
+ intervals = string_intervals (new);
/* Insert those intervals. */
graft_intervals_into_buffer (intervals, from, inschars,
current_buffer, inherit);
if (outgoing_insbytes == 0)
evaporate_overlays (from);
- CHECK_MARKERS ();
+ check_markers ();
MODIFF++;
CHARS_MODIFF = MODIFF;
Note that this does not yet handle markers quite right.
- If MARKERS is nonzero, relocate markers.
+ If MARKERS, relocate markers.
Unlike most functions at this level, never call
prepare_to_modify_buffer and never call signal_after_change. */
void
-replace_range_2 (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte,
- const char *ins, EMACS_INT inschars, EMACS_INT insbytes,
- int markers)
+replace_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte,
+ const char *ins, ptrdiff_t inschars, ptrdiff_t insbytes,
+ bool markers)
{
- EMACS_INT nbytes_del, nchars_del;
+ ptrdiff_t nbytes_del, nchars_del;
- CHECK_MARKERS ();
+ check_markers ();
nchars_del = to - from;
nbytes_del = to_byte - from_byte;
GPT_BYTE = from_byte;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
if (GPT - BEG < BEG_UNCHANGED)
BEG_UNCHANGED = GPT - BEG;
the text that has been stored by copy_text. */
if (count_combining_before (GPT_ADDR, insbytes, from, from_byte)
|| count_combining_after (GPT_ADDR, insbytes, from, from_byte))
- abort ();
+ emacs_abort ();
#endif
GAP_SIZE -= insbytes;
Z_BYTE += insbytes;
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
+
+ /* Adjust markers for the deletion and the insertion. */
+ if (markers
+ && ! (nchars_del == 1 && inschars == 1 && nbytes_del == insbytes))
+ adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
+ inschars, insbytes);
/* Adjust the overlay center as needed. This must be done after
adjusting the markers that bound the overlays. */
adjust_overlays_for_delete (from + inschars, nchars_del);
}
- /* Adjust markers for the deletion and the insertion. */
- if (markers
- && ! (nchars_del == 1 && inschars == 1 && nbytes_del == insbytes))
- adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del,
- inschars, insbytes);
-
offset_intervals (current_buffer, from, inschars - nchars_del);
/* Relocate point as if it were a marker. */
if (insbytes == 0)
evaporate_overlays (from);
- CHECK_MARKERS ();
+ check_markers ();
MODIFF++;
CHARS_MODIFF = MODIFF;
If TO comes before FROM, we delete nothing. */
void
-del_range (EMACS_INT from, EMACS_INT to)
+del_range (ptrdiff_t from, ptrdiff_t to)
{
del_range_1 (from, to, 1, 0);
}
RET_STRING says to return the deleted text. */
Lisp_Object
-del_range_1 (EMACS_INT from, EMACS_INT to, int prepare, int ret_string)
+del_range_1 (ptrdiff_t from, ptrdiff_t to, bool prepare, bool ret_string)
{
- EMACS_INT from_byte, to_byte;
+ ptrdiff_t from_byte, to_byte;
Lisp_Object deletion;
struct gcpro gcpro1;
if (prepare)
{
- EMACS_INT range_length = to - from;
+ ptrdiff_t range_length = to - from;
prepare_to_modify_buffer (from, to, &from);
to = min (ZV, from + range_length);
}
/* Like del_range_1 but args are byte positions, not char positions. */
void
-del_range_byte (EMACS_INT from_byte, EMACS_INT to_byte, int prepare)
+del_range_byte (ptrdiff_t from_byte, ptrdiff_t to_byte, bool prepare)
{
- EMACS_INT from, to;
+ ptrdiff_t from, to;
/* Make args be valid */
if (from_byte < BEGV_BYTE)
if (prepare)
{
- EMACS_INT old_from = from, old_to = Z - to;
- EMACS_INT range_length = to - from;
+ ptrdiff_t old_from = from, old_to = Z - to;
+ ptrdiff_t range_length = to - from;
prepare_to_modify_buffer (from, to, &from);
to = from + range_length;
and bytepos. */
void
-del_range_both (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte, int prepare)
+del_range_both (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte, bool prepare)
{
/* Make args be valid */
if (from_byte < BEGV_BYTE)
if (prepare)
{
- EMACS_INT old_from = from, old_to = Z - to;
- EMACS_INT range_length = to - from;
+ ptrdiff_t old_from = from, old_to = Z - to;
+ ptrdiff_t range_length = to - from;
prepare_to_modify_buffer (from, to, &from);
to = from + range_length;
/* Delete a range of text, specified both as character positions
and byte positions. FROM and TO are character positions,
while FROM_BYTE and TO_BYTE are byte positions.
- If RET_STRING is true, the deleted area is returned as a string. */
+ If RET_STRING, the deleted area is returned as a string. */
Lisp_Object
-del_range_2 (EMACS_INT from, EMACS_INT from_byte,
- EMACS_INT to, EMACS_INT to_byte, int ret_string)
+del_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, ptrdiff_t to_byte, bool ret_string)
{
- register EMACS_INT nbytes_del, nchars_del;
+ ptrdiff_t nbytes_del, nchars_del;
Lisp_Object deletion;
- CHECK_MARKERS ();
+ check_markers ();
nchars_del = to - from;
nbytes_del = to_byte - from_byte;
#ifdef BYTE_COMBINING_DEBUG
if (count_combining_before (BUF_BYTE_ADDRESS (current_buffer, to_byte),
Z_BYTE - to_byte, from, from_byte))
- abort ();
+ emacs_abort ();
#endif
if (ret_string || ! EQ (BVAR (current_buffer, undo_list), Qt))
needs to access the previous gap contents. */
*(GPT_ADDR) = 0;
- if (GPT_BYTE < GPT)
- abort ();
+ eassert (GPT <= GPT_BYTE);
if (GPT - BEG < BEG_UNCHANGED)
BEG_UNCHANGED = GPT - BEG;
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- CHECK_MARKERS ();
+ check_markers ();
evaporate_overlays (from);
and warns the next redisplay that it should pay attention to that
area.
- If PRESERVE_CHARS_MODIFF is non-zero, do not update CHARS_MODIFF.
+ If PRESERVE_CHARS_MODIFF, do not update CHARS_MODIFF.
Otherwise set CHARS_MODIFF to the new value of MODIFF. */
void
-modify_region (struct buffer *buffer, EMACS_INT start, EMACS_INT end,
- int preserve_chars_modiff)
+modify_region (struct buffer *buffer, ptrdiff_t start, ptrdiff_t end,
+ bool preserve_chars_modiff)
{
struct buffer *old_buffer = current_buffer;
- if (buffer != old_buffer)
- set_buffer_internal (buffer);
+ set_buffer_internal (buffer);
prepare_to_modify_buffer (start, end, NULL);
if (! preserve_chars_modiff)
CHARS_MODIFF = MODIFF;
- BVAR (buffer, point_before_scroll) = Qnil;
+ bset_point_before_scroll (buffer, Qnil);
- if (buffer != old_buffer)
- set_buffer_internal (old_buffer);
+ set_buffer_internal (old_buffer);
}
\f
/* Check that it is okay to modify the buffer between START and END,
by holding its value temporarily in a marker. */
void
-prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end,
- EMACS_INT *preserve_ptr)
+prepare_to_modify_buffer (ptrdiff_t start, ptrdiff_t end,
+ ptrdiff_t *preserve_ptr)
{
struct buffer *base_buffer;
if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
++windows_or_buffers_changed;
- if (BUF_INTERVALS (current_buffer) != 0)
+ if (buffer_intervals (current_buffer))
{
if (preserve_ptr)
{
: (!NILP (Vselect_active_regions)
&& !NILP (Vtransient_mark_mode))))
{
- EMACS_INT b = XMARKER (BVAR (current_buffer, mark))->charpos;
- EMACS_INT e = PT;
+ ptrdiff_t b = XMARKER (BVAR (current_buffer, mark))->charpos;
+ ptrdiff_t e = PT;
if (b < e)
Vsaved_region_selection = make_buffer_string (b, e, 0);
else if (b > e)
by holding its value temporarily in a marker. */
static void
-signal_before_change (EMACS_INT start_int, EMACS_INT end_int,
- EMACS_INT *preserve_ptr)
+signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
+ ptrdiff_t *preserve_ptr)
{
Lisp_Object start, end;
Lisp_Object start_marker, end_marker;
Lisp_Object preserve_marker;
struct gcpro gcpro1, gcpro2, gcpro3;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (inhibit_modification_hooks)
return;
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,
after the change. */
void
-signal_after_change (EMACS_INT charpos, EMACS_INT lendel, EMACS_INT lenins)
+signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (inhibit_modification_hooks)
return;
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;
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,
doc: /* This function is for use internally in `combine-after-change-calls'. */)
(void)
{
- int count = SPECPDL_INDEX ();
- EMACS_INT beg, end, change;
- EMACS_INT begpos, endpos;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t beg, end, change;
+ ptrdiff_t begpos, endpos;
Lisp_Object tail;
if (NILP (combine_after_change_list))
non-nil, and insertion calls a file handler (e.g. through
lock_file) which scribbles into a temp file -- cyd */
if (!BUFFERP (combine_after_change_buffer)
- || NILP (BVAR (XBUFFER (combine_after_change_buffer), name)))
+ || !BUFFER_LIVE_P (XBUFFER (combine_after_change_buffer)))
{
combine_after_change_list = Qnil;
return Qnil;
}
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (combine_after_change_buffer);
tail = XCDR (tail))
{
Lisp_Object elt;
- EMACS_INT thisbeg, thisend, thischange;
+ ptrdiff_t thisbeg, thisend, thischange;
/* Extract the info from the next element. */
elt = XCAR (tail);
combine_after_change_list = Qnil;
combine_after_change_buffer = Qnil;
- DEFVAR_BOOL ("check-markers-debug-flag", check_markers_debug_flag,
- doc: /* Non-nil means enable debugging checks for invalid marker positions. */);
- check_markers_debug_flag = 0;
DEFVAR_LISP ("combine-after-change-calls", Vcombine_after_change_calls,
doc: /* Used internally by the `combine-after-change-calls' macro. */);
Vcombine_after_change_calls = Qnil;
#include <config.h>
-#include <setjmp.h>
+
+#define INTERVALS_INLINE EXTERN_INLINE
+
#include <intprops.h>
#include "lisp.h"
#include "intervals.h"
+#include "character.h"
#include "buffer.h"
#include "puresize.h"
#include "keyboard.h"
static Lisp_Object merge_properties_sticky (Lisp_Object, Lisp_Object);
static INTERVAL merge_interval_right (INTERVAL);
static INTERVAL reproduce_tree (INTERVAL, INTERVAL);
-static INTERVAL reproduce_tree_obj (INTERVAL, Lisp_Object);
\f
/* Utility functions for intervals. */
+/* Use these functions to set Lisp_Object
+ or pointer slots of struct interval. */
+
+static inline void
+set_interval_object (INTERVAL i, Lisp_Object obj)
+{
+ eassert (BUFFERP (obj) || STRINGP (obj));
+ i->up_obj = 1;
+ i->up.obj = obj;
+}
+
+static inline void
+set_interval_left (INTERVAL i, INTERVAL left)
+{
+ i->left = left;
+}
+
+static inline void
+set_interval_right (INTERVAL i, INTERVAL right)
+{
+ i->right = right;
+}
+
+/* Make the parent of D be whatever the parent of S is, regardless
+ of the type. This is used when balancing an interval tree. */
+
+static inline void
+copy_interval_parent (INTERVAL d, INTERVAL s)
+{
+ d->up = s->up;
+ d->up_obj = s->up_obj;
+}
/* Create the root interval of some object, a buffer or string. */
{
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));
+ set_buffer_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));
+ set_string_intervals (parent, new);
new->position = 0;
}
- SET_INTERVAL_OBJECT (new, parent);
+ set_interval_object (new, parent);
return new;
}
return;
COPY_INTERVAL_CACHE (source, target);
- target->plist = Fcopy_sequence (source->plist);
+ set_interval_plist (target, Fcopy_sequence (source->plist));
}
/* Merge the properties of interval SOURCE into the properties
if (NILP (val))
{
val = XCAR (o);
- target->plist = Fcons (sym, Fcons (val, target->plist));
+ set_interval_plist (target, Fcons (sym, Fcons (val, target->plist)));
}
o = XCDR (o);
}
}
-/* Return 1 if the two intervals have the same properties,
- 0 otherwise. */
+/* Return true if the two intervals have the same properties. */
-int
+bool
intervals_equal (INTERVAL i0, INTERVAL i1)
{
- register Lisp_Object i0_cdr, i0_sym;
- register Lisp_Object i1_cdr, i1_val;
+ Lisp_Object i0_cdr, i0_sym;
+ Lisp_Object i1_cdr, i1_val;
if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
return 1;
i0_sym = XCAR (i0_cdr);
i0_cdr = XCDR (i0_cdr);
if (!CONSP (i0_cdr))
- return 0; /* abort (); */
+ return 0;
i1_val = i1->plist;
while (CONSP (i1_val) && !EQ (XCAR (i1_val), i0_sym))
{
i1_val = XCDR (i1_val);
if (!CONSP (i1_val))
- return 0; /* abort (); */
+ return 0;
i1_val = XCDR (i1_val);
}
i1_cdr = XCDR (i1_cdr);
if (!CONSP (i1_cdr))
- return 0; /* abort (); */
+ return 0;
i1_cdr = XCDR (i1_cdr);
}
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
{
Pass FUNCTION two args: an interval, and ARG. */
void
-traverse_intervals (INTERVAL tree, EMACS_INT position,
+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);
{
icount = 0;
search_interval = i;
- found_interval = NULL_INTERVAL;
+ found_interval = NULL;
traverse_intervals_noorder (tree, &check_for_interval, Qnil);
return found_interval;
}
{
INTERVAL i;
INTERVAL B = interval->left;
- EMACS_INT old_total = interval->total_length;
+ ptrdiff_t old_total = interval->total_length;
/* Deal with any Parent of A; make it point to B. */
if (! ROOT_INTERVAL_P (interval))
{
if (AM_LEFT_CHILD (interval))
- INTERVAL_PARENT (interval)->left = B;
+ set_interval_left (INTERVAL_PARENT (interval), B);
else
- INTERVAL_PARENT (interval)->right = B;
+ set_interval_right (INTERVAL_PARENT (interval), B);
}
- COPY_INTERVAL_PARENT (B, interval);
+ copy_interval_parent (B, interval);
/* Make B the parent of A */
i = B->right;
- B->right = interval;
- SET_INTERVAL_PARENT (interval, B);
+ set_interval_right (B, interval);
+ set_interval_parent (interval, B);
/* Make A point to c */
- interval->left = i;
- if (! NULL_INTERVAL_P (i))
- SET_INTERVAL_PARENT (i, interval);
+ set_interval_left (interval, i);
+ if (i)
+ set_interval_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;
}
{
INTERVAL i;
INTERVAL B = interval->right;
- EMACS_INT old_total = interval->total_length;
+ ptrdiff_t old_total = interval->total_length;
/* Deal with any parent of A; make it point to B. */
if (! ROOT_INTERVAL_P (interval))
{
if (AM_LEFT_CHILD (interval))
- INTERVAL_PARENT (interval)->left = B;
+ set_interval_left (INTERVAL_PARENT (interval), B);
else
- INTERVAL_PARENT (interval)->right = B;
+ set_interval_right (INTERVAL_PARENT (interval), B);
}
- COPY_INTERVAL_PARENT (B, interval);
+ copy_interval_parent (B, interval);
/* Make B the parent of A */
i = B->left;
- B->left = interval;
- SET_INTERVAL_PARENT (interval, B);
+ set_interval_left (B, interval);
+ set_interval_parent (interval, B);
/* Make A point to c */
- interval->right = i;
- if (! NULL_INTERVAL_P (i))
- SET_INTERVAL_PARENT (i, interval);
+ set_interval_right (interval, i);
+ if (i)
+ set_interval_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;
}
static INTERVAL
balance_an_interval (INTERVAL i)
{
- register EMACS_INT old_diff, new_diff;
+ register ptrdiff_t old_diff, new_diff;
while (1)
{
Lisp Object. */
static inline INTERVAL
-balance_possible_root_interval (register INTERVAL interval)
+balance_possible_root_interval (INTERVAL interval)
{
Lisp_Object parent;
- int have_parent = 0;
+ bool have_parent = 0;
if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
return interval;
if (have_parent)
{
if (BUFFERP (parent))
- BUF_INTERVALS (XBUFFER (parent)) = interval;
+ set_buffer_intervals (XBUFFER (parent), interval);
else if (STRINGP (parent))
- STRING_SET_INTERVALS (parent, interval);
+ set_string_intervals (parent, interval);
}
return interval;
INTERVAL
balance_intervals (INTERVAL tree)
{
- if (tree == NULL_INTERVAL)
- return NULL_INTERVAL;
+ return tree ? balance_intervals_internal (tree) : NULL;
+}
+
+/* Rebalance text properties of B. */
+
+static void
+buffer_balance_intervals (struct buffer *b)
+{
+ INTERVAL i;
- return balance_intervals_internal (tree);
+ eassert (b != NULL);
+ i = buffer_intervals (b);
+ if (i)
+ set_buffer_intervals (b, balance_an_interval (i));
}
-\f
+
/* 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
it is still a root after this operation. */
INTERVAL
-split_interval_right (INTERVAL interval, EMACS_INT offset)
+split_interval_right (INTERVAL interval, ptrdiff_t offset)
{
INTERVAL new = make_interval ();
- EMACS_INT position = interval->position;
- EMACS_INT new_length = LENGTH (interval) - offset;
+ ptrdiff_t position = interval->position;
+ ptrdiff_t new_length = LENGTH (interval) - offset;
new->position = position + offset;
- SET_INTERVAL_PARENT (new, interval);
+ set_interval_parent (new, interval);
if (NULL_RIGHT_CHILD (interval))
{
- interval->right = new;
+ set_interval_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;
+ set_interval_right (new, interval->right);
+ set_interval_parent (interval->right, new);
+ set_interval_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);
}
it is still a root after this operation. */
INTERVAL
-split_interval_left (INTERVAL interval, EMACS_INT offset)
+split_interval_left (INTERVAL interval, ptrdiff_t offset)
{
INTERVAL new = make_interval ();
- EMACS_INT new_length = offset;
+ ptrdiff_t new_length = offset;
new->position = interval->position;
interval->position = interval->position + offset;
- SET_INTERVAL_PARENT (new, interval);
+ set_interval_parent (new, interval);
if (NULL_LEFT_CHILD (interval))
{
- interval->left = new;
+ set_interval_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;
+ set_interval_left (new, interval->left);
+ set_interval_parent (new->left, new);
+ set_interval_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);
}
{
Lisp_Object parent;
- if (NULL_INTERVAL_P (source))
+ if (!source)
return 0;
if (! INTERVAL_HAS_OBJECT (source))
will update this cache based on the result of find_interval. */
INTERVAL
-find_interval (register INTERVAL tree, register EMACS_INT position)
+find_interval (register INTERVAL tree, register ptrdiff_t position)
{
/* The distance from the left edge of the subtree at TREE
to POSITION. */
- register EMACS_INT relative_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))
relative_position -= BUF_BEG (XBUFFER (parent));
}
- if (relative_position > TOTAL_LENGTH (tree))
- abort (); /* Paranoia */
+ eassert (relative_position <= TOTAL_LENGTH (tree));
- if (!handling_signal)
- tree = balance_possible_root_interval (tree);
+ tree = balance_possible_root_interval (tree);
while (1)
{
next_interval (register INTERVAL interval)
{
register INTERVAL i = interval;
- register EMACS_INT next_position;
+ 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))
i = INTERVAL_PARENT (i);
}
- return NULL_INTERVAL;
+ return NULL;
}
/* Find the preceding interval (lexicographically) to INTERVAL.
{
register INTERVAL i;
- if (NULL_INTERVAL_P (interval))
- return NULL_INTERVAL;
+ if (!interval)
+ return NULL;
if (! NULL_LEFT_CHILD (interval))
{
i = INTERVAL_PARENT (i);
}
- return NULL_INTERVAL;
+ return NULL;
}
/* Find the interval containing POS given some non-NULL INTERVAL
To speed up the process, we assume that the ->position of
I and all its parents is already uptodate. */
INTERVAL
-update_interval (register INTERVAL i, EMACS_INT pos)
+update_interval (register INTERVAL i, ptrdiff_t pos)
{
- if (NULL_INTERVAL_P (i))
- return NULL_INTERVAL;
+ if (!i)
+ return NULL;
while (1)
{
i = i->right; /* Move to the right child */
}
else if (NULL_PARENT (i))
- error ("Point %"pI"d after end of properties", pos);
+ error ("Point %"pD"d after end of properties", pos);
else
i = INTERVAL_PARENT (i);
continue;
}
}
-\f
-#if 0
-/* Traverse a path down the interval tree TREE to the interval
- containing POSITION, adjusting all nodes on the path for
- an addition of LENGTH characters. Insertion between two intervals
- (i.e., point == i->position, where i is second interval) means
- text goes into second interval.
-
- Modifications are needed to handle the hungry bits -- after simply
- finding the interval at position (don't add length going down),
- if it's the beginning of the interval, get the previous interval
- and check the hungry bits of both. Then add the length going back up
- to the root. */
-
-static INTERVAL
-adjust_intervals_for_insertion (INTERVAL tree, EMACS_INT position,
- EMACS_INT length)
-{
- register EMACS_INT relative_position;
- register INTERVAL this;
-
- if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
- abort ();
-
- /* If inserting at point-max of a buffer, that position
- will be out of range */
- if (position > TOTAL_LENGTH (tree))
- position = TOTAL_LENGTH (tree);
- relative_position = position;
- this = tree;
-
- while (1)
- {
- if (relative_position <= LEFT_TOTAL_LENGTH (this))
- {
- this->total_length += length;
- CHECK_TOTAL_LENGTH (this);
- this = this->left;
- }
- else if (relative_position > (TOTAL_LENGTH (this)
- - RIGHT_TOTAL_LENGTH (this)))
- {
- relative_position -= (TOTAL_LENGTH (this)
- - RIGHT_TOTAL_LENGTH (this));
- this->total_length += length;
- CHECK_TOTAL_LENGTH (this);
- this = this->right;
- }
- else
- {
- /* If we are to use zero-length intervals as buffer pointers,
- then this code will have to change. */
- this->total_length += length;
- CHECK_TOTAL_LENGTH (this);
- this->position = LEFT_TOTAL_LENGTH (this)
- + position - relative_position + 1;
- return tree;
- }
- }
-}
-#endif
-
/* Effect an adjustment corresponding to the addition of LENGTH characters
of text. Do this by finding the interval containing POSITION in the
interval tree TREE, and then adjusting all of its ancestors by adding
static INTERVAL
adjust_intervals_for_insertion (INTERVAL tree,
- EMACS_INT position, EMACS_INT length)
+ ptrdiff_t position, ptrdiff_t length)
{
- register INTERVAL i;
- register INTERVAL temp;
- int eobp = 0;
+ INTERVAL i;
+ INTERVAL temp;
+ bool eobp = 0;
Lisp_Object parent;
- EMACS_INT offset;
+ ptrdiff_t offset;
- if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
- abort ();
+ eassert (TOTAL_LENGTH (tree) > 0);
GET_INTERVAL_OBJECT (parent, tree);
offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
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);
}
Lisp_Object pleft, pright;
struct 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);
+ RESET_INTERVAL (&newi);
+ pleft = prev ? prev->plist : Qnil;
+ pright = i ? i->plist : Qnil;
+ set_interval_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;
+ set_interval_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);
+ set_interval_plist (prev, newi.plist);
+ if (i && intervals_equal (prev, i))
merge_interval_right (prev);
}
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);
}
}
static Lisp_Object
merge_properties_sticky (Lisp_Object pleft, Lisp_Object pright)
{
- register Lisp_Object props, front, rear;
+ Lisp_Object props, front, rear;
Lisp_Object lfront, lrear, rfront, rrear;
- register Lisp_Object tail1, tail2, sym, lval, rval, cat;
- int use_left, use_right;
- int lpresent;
+ Lisp_Object tail1, tail2, sym, lval, rval, cat;
+ bool use_left, use_right, lpresent;
props = Qnil;
front = Qnil;
delete_node (register INTERVAL i)
{
register INTERVAL migrate, this;
- register EMACS_INT migrate_amt;
+ 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));
+ set_interval_left (this, migrate);
+ set_interval_parent (migrate, this);
return i->right;
}
delete_interval (register INTERVAL i)
{
register INTERVAL parent;
- EMACS_INT amt = LENGTH (i);
+ ptrdiff_t amt = LENGTH (i);
- if (amt > 0) /* Only used on zero-length intervals now. */
- abort ();
+ eassert (amt == 0); /* Only used on zero-length intervals now. */
if (ROOT_INTERVAL_P (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)
+ set_interval_object (parent, owner);
if (BUFFERP (owner))
- BUF_INTERVALS (XBUFFER (owner)) = parent;
+ set_buffer_intervals (XBUFFER (owner), parent);
else if (STRINGP (owner))
- STRING_SET_INTERVALS (owner, parent);
+ set_string_intervals (owner, parent);
else
- abort ();
+ emacs_abort ();
return;
}
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);
+ set_interval_left (parent, delete_node (i));
+ if (parent->left)
+ set_interval_parent (parent->left, parent);
}
else
{
- parent->right = delete_node (i);
- if (! NULL_INTERVAL_P (parent->right))
- SET_INTERVAL_PARENT (parent->right, parent);
+ set_interval_right (parent, delete_node (i));
+ if (parent->right)
+ set_interval_parent (parent->right, parent);
}
}
\f
Do this by recursing down TREE to the interval in question, and
deleting the appropriate amount of text. */
-static EMACS_INT
-interval_deletion_adjustment (register INTERVAL tree, register EMACS_INT from,
- register EMACS_INT amount)
+static ptrdiff_t
+interval_deletion_adjustment (register INTERVAL tree, register ptrdiff_t from,
+ register ptrdiff_t amount)
{
- register EMACS_INT relative_position = from;
+ register ptrdiff_t relative_position = from;
- if (NULL_INTERVAL_P (tree))
+ if (!tree)
return 0;
/* Left branch. */
if (relative_position < LEFT_TOTAL_LENGTH (tree))
{
- EMACS_INT subtract = interval_deletion_adjustment (tree->left,
+ ptrdiff_t subtract = interval_deletion_adjustment (tree->left,
relative_position,
amount);
tree->total_length -= subtract;
- CHECK_TOTAL_LENGTH (tree);
+ eassert (0 <= TOTAL_LENGTH (tree));
return subtract;
}
/* Right branch. */
else if (relative_position >= (TOTAL_LENGTH (tree)
- RIGHT_TOTAL_LENGTH (tree)))
{
- EMACS_INT subtract;
+ ptrdiff_t subtract;
relative_position -= (tree->total_length
- RIGHT_TOTAL_LENGTH (tree));
relative_position,
amount);
tree->total_length -= subtract;
- CHECK_TOTAL_LENGTH (tree);
+ eassert (0 <= TOTAL_LENGTH (tree));
return subtract;
}
/* Here -- this node. */
else
{
/* How much can we delete from this interval? */
- EMACS_INT my_amount = ((tree->total_length
+ ptrdiff_t my_amount = ((tree->total_length
- RIGHT_TOTAL_LENGTH (tree))
- relative_position);
amount = my_amount;
tree->total_length -= amount;
- CHECK_TOTAL_LENGTH (tree);
+ eassert (0 <= TOTAL_LENGTH (tree));
if (LENGTH (tree) == 0)
delete_interval (tree);
static void
adjust_intervals_for_deletion (struct buffer *buffer,
- EMACS_INT start, EMACS_INT length)
+ ptrdiff_t start, ptrdiff_t length)
{
- register EMACS_INT left_to_delete = length;
- register INTERVAL tree = BUF_INTERVALS (buffer);
+ ptrdiff_t left_to_delete = length;
+ INTERVAL tree = buffer_intervals (buffer);
Lisp_Object parent;
- EMACS_INT offset;
+ ptrdiff_t offset;
GET_INTERVAL_OBJECT (parent, tree);
offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);
- if (NULL_INTERVAL_P (tree))
+ if (!tree)
return;
- if (start > offset + TOTAL_LENGTH (tree)
- || start + length > offset + TOTAL_LENGTH (tree))
- abort ();
+ eassert (start <= offset + TOTAL_LENGTH (tree)
+ && start + length <= offset + TOTAL_LENGTH (tree));
if (length == TOTAL_LENGTH (tree))
{
- BUF_INTERVALS (buffer) = NULL_INTERVAL;
+ set_buffer_intervals (buffer, NULL);
return;
}
if (ONLY_INTERVAL_P (tree))
{
tree->total_length -= length;
- CHECK_TOTAL_LENGTH (tree);
+ eassert (0 <= TOTAL_LENGTH (tree));
return;
}
{
left_to_delete -= interval_deletion_adjustment (tree, start - offset,
left_to_delete);
- tree = BUF_INTERVALS (buffer);
+ tree = buffer_intervals (buffer);
if (left_to_delete == tree->total_length)
{
- BUF_INTERVALS (buffer) = NULL_INTERVAL;
+ set_buffer_intervals (buffer, NULL);
return;
}
}
/* 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, EMACS_INT start, EMACS_INT length)
+offset_intervals (struct buffer *buffer, ptrdiff_t start, ptrdiff_t length)
{
- if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
+ if (!buffer_intervals (buffer) || length == 0)
return;
if (length > 0)
- adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
+ adjust_intervals_for_insertion (buffer_intervals (buffer),
+ start, length);
else
{
- IF_LINT (if (length < - TYPE_MAXIMUM (EMACS_INT)) abort ();)
+ lint_assume (- TYPE_MAXIMUM (ptrdiff_t) <= length);
adjust_intervals_for_deletion (buffer, start, -length);
}
}
static INTERVAL
merge_interval_right (register INTERVAL i)
{
- register EMACS_INT absorb = LENGTH (i);
+ register ptrdiff_t absorb = LENGTH (i);
register INTERVAL successor;
- /* Zero out this interval. */
- i->total_length -= absorb;
- CHECK_TOTAL_LENGTH (i);
-
/* Find the succeeding interval. */
if (! NULL_RIGHT_CHILD (i)) /* It's below us. Add absorb
as we descend. */
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;
+ eassert (0 <= TOTAL_LENGTH (i));
+
successor = i;
while (! NULL_PARENT (successor)) /* It's above us. Subtract as
we ascend. */
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
be merged right. The caller should have known. */
- abort ();
+ emacs_abort ();
}
\f
/* Merge interval I with its lexicographic predecessor. The resulting
INTERVAL
merge_interval_left (register INTERVAL i)
{
- register EMACS_INT absorb = LENGTH (i);
+ register ptrdiff_t absorb = LENGTH (i);
register INTERVAL predecessor;
- /* Zero out this interval. */
- i->total_length -= absorb;
- CHECK_TOTAL_LENGTH (i);
-
/* Find the preceding interval. */
if (! NULL_LEFT_CHILD (i)) /* It's below us. Go down,
adding ABSORB as we go. */
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;
+ eassert (0 <= TOTAL_LENGTH (i));
+
predecessor = i;
while (! NULL_PARENT (predecessor)) /* It's above us. Go up,
- subtracting ABSORB. */
+ subtracting ABSORB. */
{
if (AM_RIGHT_CHILD (predecessor))
{
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
be merged left. The caller should have known. */
- abort ();
+ emacs_abort ();
}
\f
-/* Make an exact copy of interval tree SOURCE which descends from
- PARENT. This is done by recursing through SOURCE, copying
- the current interval and its properties, and then adjusting
- the pointers of the copy. */
+/* Create a copy of SOURCE but with the default value of UP. */
static INTERVAL
-reproduce_tree (INTERVAL source, INTERVAL parent)
+reproduce_interval (INTERVAL source)
{
- register INTERVAL t = make_interval ();
+ register INTERVAL target = make_interval ();
- memcpy (t, source, INTERVAL_SIZE);
- copy_properties (source, t);
- SET_INTERVAL_PARENT (t, parent);
- if (! NULL_LEFT_CHILD (source))
- t->left = reproduce_tree (source->left, t);
- if (! NULL_RIGHT_CHILD (source))
- t->right = reproduce_tree (source->right, t);
+ target->total_length = source->total_length;
+ target->position = source->position;
- return t;
-}
+ copy_properties (source, target);
-static INTERVAL
-reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
-{
- register INTERVAL t = make_interval ();
-
- memcpy (t, source, INTERVAL_SIZE);
- copy_properties (source, t);
- SET_INTERVAL_OBJECT (t, parent);
if (! NULL_LEFT_CHILD (source))
- t->left = reproduce_tree (source->left, t);
+ set_interval_left (target, reproduce_tree (source->left, target));
if (! NULL_RIGHT_CHILD (source))
- t->right = reproduce_tree (source->right, t);
+ set_interval_right (target, reproduce_tree (source->right, target));
- return t;
+ return target;
}
-#if 0
-/* Nobody calls this. Perhaps it's a vestige of an earlier design. */
-
-/* Make a new interval of length LENGTH starting at START in the
- group of intervals INTERVALS, which is actually an interval tree.
- Returns the new interval.
-
- Generate an error if the new positions would overlap an existing
- interval. */
+/* Make an exact copy of interval tree SOURCE which descends from
+ PARENT. This is done by recursing through SOURCE, copying
+ the current interval and its properties, and then adjusting
+ the pointers of the copy. */
static INTERVAL
-make_new_interval (INTERVAL intervals, EMACS_INT start, EMACS_INT length)
+reproduce_tree (INTERVAL source, INTERVAL parent)
{
- INTERVAL slot;
-
- slot = find_interval (intervals, start);
- if (start + length > slot->position + LENGTH (slot))
- error ("Interval would overlap");
-
- if (start == slot->position && length == LENGTH (slot))
- return slot;
-
- if (slot->position == start)
- {
- /* New right node. */
- split_interval_right (slot, length);
- return slot;
- }
-
- if (slot->position + LENGTH (slot) == start + length)
- {
- /* New left node. */
- split_interval_left (slot, LENGTH (slot) - length);
- return slot;
- }
+ INTERVAL target = reproduce_interval (source);
+ set_interval_parent (target, parent);
+ return target;
+}
- /* Convert interval SLOT into three intervals. */
- split_interval_left (slot, start - slot->position);
- split_interval_right (slot, length);
- return slot;
+static INTERVAL
+reproduce_tree_obj (INTERVAL source, Lisp_Object parent)
+{
+ INTERVAL target = reproduce_interval (source);
+ set_interval_object (target, parent);
+ return target;
}
-#endif
\f
/* Insert the intervals of SOURCE into BUFFER at POSITION.
LENGTH is the length of the text in SOURCE.
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),
text... */
void
-graft_intervals_into_buffer (INTERVAL source, EMACS_INT position,
- EMACS_INT length, struct buffer *buffer,
- int inherit)
+graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position,
+ ptrdiff_t length, struct buffer *buffer,
+ bool inherit)
{
- register INTERVAL under, over, this;
- register INTERVAL tree;
- EMACS_INT over_used;
-
- tree = BUF_INTERVALS (buffer);
+ INTERVAL tree = buffer_intervals (buffer);
+ INTERVAL under, over, this;
+ ptrdiff_t over_used;
/* 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);
+ set_buffer_intervals (buffer, reproduce_tree_obj (source, buf));
+ buffer_intervals (buffer)->position = BUF_BEG (buffer);
+ eassert (buffer_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. */
- else if (TOTAL_LENGTH (tree) == 0)
- abort ();
+ }
+ /* 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);
- if (NULL_INTERVAL_P (under)) /* Paranoia. */
- abort ();
+ eassert (under);
over = find_interval (source, interval_start_pos (source));
/* Here for insertion in the middle of an interval.
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))
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,
}
Lisp_Object
-lookup_char_property (Lisp_Object plist, register Lisp_Object prop, int textprop)
+lookup_char_property (Lisp_Object plist, Lisp_Object prop, bool textprop)
{
- register Lisp_Object tail, fallback = Qnil;
+ Lisp_Object tail, fallback = Qnil;
for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
{
void
temp_set_point_both (struct buffer *buffer,
- EMACS_INT charpos, EMACS_INT bytepos)
+ ptrdiff_t charpos, ptrdiff_t bytepos)
{
/* In a single-byte buffer, the two positions must be equal. */
- if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)
- && charpos != bytepos)
- abort ();
-
- if (charpos > bytepos)
- abort ();
+ if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer))
+ eassert (charpos == bytepos);
- if (charpos > BUF_ZV (buffer) || charpos < BUF_BEGV (buffer))
- abort ();
+ eassert (charpos <= bytepos);
+ eassert (charpos <= BUF_ZV (buffer) || BUF_BEGV (buffer) <= charpos);
SET_BUF_PT_BOTH (buffer, charpos, bytepos);
}
/* Set point "temporarily", without checking any text properties. */
void
-temp_set_point (struct buffer *buffer, EMACS_INT charpos)
+temp_set_point (struct buffer *buffer, ptrdiff_t charpos)
{
temp_set_point_both (buffer, charpos,
buf_charpos_to_bytepos (buffer, charpos));
before an intangible character, move to an ok place. */
void
-set_point (EMACS_INT charpos)
+set_point (ptrdiff_t charpos)
{
set_point_both (charpos, buf_charpos_to_bytepos (current_buffer, charpos));
}
/* If there's an invisible character at position POS + TEST_OFFS in the
current buffer, and the invisible property has a `stickiness' such that
inserting a character at position POS would inherit the property it,
- return POS + ADJ, otherwise return POS. If TEST_INTANG is non-zero,
- then intangibility is required as well as invisibility.
+ return POS + ADJ, otherwise return POS. If TEST_INTANG, intangibility
+ is required as well as invisibility.
TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
Note that `stickiness' is determined by overlay marker insertion types,
if the invisible property comes from an overlay. */
-static EMACS_INT
-adjust_for_invis_intang (EMACS_INT pos, EMACS_INT test_offs, EMACS_INT adj,
- int test_intang)
+static ptrdiff_t
+adjust_for_invis_intang (ptrdiff_t pos, ptrdiff_t test_offs, ptrdiff_t adj,
+ bool test_intang)
{
Lisp_Object invis_propval, invis_overlay;
Lisp_Object test_pos;
before an intangible character, move to an ok place. */
void
-set_point_both (EMACS_INT charpos, EMACS_INT bytepos)
+set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos)
{
register INTERVAL to, from, toprev, fromprev;
- EMACS_INT buffer_point;
- EMACS_INT old_position = PT;
+ ptrdiff_t buffer_point;
+ ptrdiff_t old_position = PT;
/* This ensures that we move forward past intangible text when the
initial position is the same as the destination, in the rare
instances where this is important, e.g. in line-move-finish
(simple.el). */
- int backwards = (charpos < old_position ? 1 : 0);
- int have_overlays;
- EMACS_INT original_position;
+ bool backwards = charpos < old_position;
+ bool have_overlays;
+ ptrdiff_t original_position;
- BVAR (current_buffer, point_before_scroll) = Qnil;
+ bset_point_before_scroll (current_buffer, Qnil);
if (charpos == PT)
return;
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_intervals (current_buffer) && ! have_overlays)
{
temp_set_point_both (current_buffer, charpos, bytepos);
return;
/* 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_intervals (current_buffer), charpos);
if (charpos == BEGV)
toprev = 0;
else if (to && to->position == charpos)
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_intervals (current_buffer), buffer_point);
if (buffer_point == BEGV)
fromprev = 0;
else if (from && from->position == PT)
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. */
/* 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_intervals (current_buffer), charpos);
if (charpos == BEGV)
toprev = 0;
else if (to && to->position == charpos)
segment that reaches all the way to point. */
void
-move_if_not_intangible (EMACS_INT position)
+move_if_not_intangible (ptrdiff_t position)
{
Lisp_Object pos;
Lisp_Object intangible_propval;
\f
/* If text at position POS has property PROP, set *VAL to the property
value, *START and *END to the beginning and end of a region that
- has the same property, and return 1. Otherwise return 0.
+ has the same property, and return true. Otherwise return false.
OBJECT is the string or buffer to look for the property in;
nil means the current buffer. */
-int
-get_property_and_range (EMACS_INT pos, Lisp_Object prop, Lisp_Object *val,
- EMACS_INT *start, EMACS_INT *end, Lisp_Object object)
+bool
+get_property_and_range (ptrdiff_t pos, Lisp_Object prop, Lisp_Object *val,
+ ptrdiff_t *start, ptrdiff_t *end, Lisp_Object object)
{
INTERVAL i, prev, next;
if (NILP (object))
- i = find_interval (BUF_INTERVALS (current_buffer), pos);
+ i = find_interval (buffer_intervals (current_buffer), pos);
else if (BUFFERP (object))
- i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
+ i = find_interval (buffer_intervals (XBUFFER (object)), pos);
else if (STRINGP (object))
- i = find_interval (STRING_INTERVALS (object), pos);
+ i = find_interval (string_intervals (object), pos);
else
- abort ();
+ emacs_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))
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);
POSITION must be in the accessible part of BUFFER. */
Lisp_Object
-get_local_map (register EMACS_INT position, register struct buffer *buffer,
+get_local_map (register ptrdiff_t position, register struct buffer *buffer,
Lisp_Object type)
{
Lisp_Object prop, lispy_position, lispy_buffer;
- EMACS_INT old_begv, old_zv, old_begv_byte, old_zv_byte;
+ ptrdiff_t old_begv, old_zv, old_begv_byte, old_zv_byte;
/* Perhaps we should just change `position' to the limit. */
if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer))
- abort ();
+ emacs_abort ();
/* Ignore narrowing, so that a local map continues to be valid even if
the visible region contains no characters and hence no properties. */
The new interval tree has no parent and has a starting-position of 0. */
INTERVAL
-copy_intervals (INTERVAL tree, EMACS_INT start, EMACS_INT length)
+copy_intervals (INTERVAL tree, ptrdiff_t start, ptrdiff_t length)
{
register INTERVAL i, new, t;
- register EMACS_INT got, prevlen;
+ 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);
- if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
- abort ();
+ 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;
void
copy_intervals_to_string (Lisp_Object string, struct buffer *buffer,
- EMACS_INT position, EMACS_INT length)
+ ptrdiff_t position, ptrdiff_t length)
{
- INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
+ INTERVAL interval_copy = copy_intervals (buffer_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);
+ set_interval_object (interval_copy, string);
+ set_string_intervals (string, interval_copy);
}
\f
-/* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
+/* Return true if strings S1 and S2 have identical properties.
Assume they have identical characters. */
-int
+bool
compare_string_intervals (Lisp_Object s1, Lisp_Object s2)
{
INTERVAL i1, i2;
- EMACS_INT pos = 0;
- EMACS_INT end = SCHARS (s1);
+ 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_intervals (s1), 0);
+ i2 = find_interval (string_intervals (s2), 0);
while (pos < end)
{
/* Determine how far we can go before we reach the end of I1 or I2. */
- EMACS_INT len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
- EMACS_INT len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
- EMACS_INT distance = min (len1, len2);
+ ptrdiff_t len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos;
+ ptrdiff_t len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos;
+ ptrdiff_t distance = min (len1, len2);
/* If we ever find a mismatch between the strings,
they differ. */
START_BYTE ... END_BYTE in bytes. */
static void
-set_intervals_multibyte_1 (INTERVAL i, int multi_flag,
- EMACS_INT start, EMACS_INT start_byte,
- EMACS_INT end, EMACS_INT end_byte)
+set_intervals_multibyte_1 (INTERVAL i, bool multi_flag,
+ ptrdiff_t start, ptrdiff_t start_byte,
+ ptrdiff_t end, ptrdiff_t end_byte)
{
/* Fix the length of this interval. */
if (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)
{
/* Recursively fix the length of the subintervals. */
if (i->left)
{
- EMACS_INT left_end, left_end_byte;
+ ptrdiff_t left_end, left_end_byte;
if (multi_flag)
{
- EMACS_INT temp;
+ ptrdiff_t temp;
left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i);
left_end = BYTE_TO_CHAR (left_end_byte);
}
if (i->right)
{
- EMACS_INT right_start_byte, right_start;
+ ptrdiff_t right_start_byte, right_start;
if (multi_flag)
{
- EMACS_INT temp;
+ ptrdiff_t temp;
right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i);
right_start = BYTE_TO_CHAR (right_start_byte);
{
if ((i)->left)
{
- (i)->plist = (i)->left->plist;
+ set_interval_plist (i, i->left->plist);
(i)->left->total_length = 0;
delete_interval ((i)->left);
}
else
{
- (i)->plist = (i)->right->plist;
+ set_interval_plist (i, i->right->plist);
(i)->right->total_length = 0;
delete_interval ((i)->right);
}
}
/* Update the intervals of the current buffer
- to fit the contents as multibyte (if MULTI_FLAG is 1)
- or to fit them as non-multibyte (if MULTI_FLAG is 0). */
+ to fit the contents as multibyte (if MULTI_FLAG)
+ or to fit them as non-multibyte (if not MULTI_FLAG). */
void
-set_intervals_multibyte (int multi_flag)
+set_intervals_multibyte (bool 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_intervals (current_buffer);
+
+ if (i)
+ set_intervals_multibyte_1 (i, multi_flag, BEG, BEG_BYTE, Z, Z_BYTE);
}
#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. */
{
/* The first group of entries deal with the tree structure. */
- EMACS_INT total_length; /* Length of myself and both children. */
- EMACS_INT position; /* Cache of interval's character position. */
+ ptrdiff_t total_length; /* Length of myself and both children. */
+ ptrdiff_t position; /* Cache of interval's character position. */
/* This field is usually updated
simultaneously with an interval
traversal, there is no guarantee
unsigned int front_sticky : 1; /* Non-zero means text inserted just
before this interval goes into it. */
unsigned int rear_sticky : 1; /* Likewise for just after it. */
-
- /* Properties of this interval.
- The mark bit on this field says whether this particular interval
- tree node has been visited. Since intervals should never be
- shared, GC aborts if it seems to have visited an interval twice. */
- Lisp_Object plist;
+ Lisp_Object plist; /* Other properties. */
};
/* 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))
#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. */
/* 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
+set_interval_parent (INTERVAL i, INTERVAL parent)
+{
+ i->up_obj = 0;
+ i->up.interval = parent;
+}
+
+INTERVALS_INLINE void
+set_interval_plist (INTERVAL i, Lisp_Object plist)
+{
+ i->plist = plist;
+}
/* 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; \
+ set_interval_parent (i, NULL); \
+ (i)->write_protect = 0; \
+ (i)->visible = 0; \
+ (i)->front_sticky = (i)->rear_sticky = 0; \
+ set_interval_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. */
extern INTERVAL create_root_interval (Lisp_Object);
extern void copy_properties (INTERVAL, INTERVAL);
-extern int intervals_equal (INTERVAL, INTERVAL);
-extern void traverse_intervals (INTERVAL, EMACS_INT,
+extern bool intervals_equal (INTERVAL, INTERVAL);
+extern void traverse_intervals (INTERVAL, ptrdiff_t,
void (*) (INTERVAL, Lisp_Object),
Lisp_Object);
extern void traverse_intervals_noorder (INTERVAL,
void (*) (INTERVAL, Lisp_Object),
Lisp_Object);
-extern INTERVAL split_interval_right (INTERVAL, EMACS_INT);
-extern INTERVAL split_interval_left (INTERVAL, EMACS_INT);
-extern INTERVAL find_interval (INTERVAL, EMACS_INT);
+extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t);
+extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t);
+extern INTERVAL find_interval (INTERVAL, ptrdiff_t);
extern INTERVAL next_interval (INTERVAL);
extern INTERVAL previous_interval (INTERVAL);
extern INTERVAL merge_interval_left (INTERVAL);
-extern void offset_intervals (struct buffer *, EMACS_INT, EMACS_INT);
-extern void graft_intervals_into_buffer (INTERVAL, EMACS_INT, EMACS_INT,
- struct buffer *, int);
+extern void offset_intervals (struct buffer *, ptrdiff_t, ptrdiff_t);
+extern void graft_intervals_into_buffer (INTERVAL, ptrdiff_t, ptrdiff_t,
+ struct buffer *, bool);
extern void verify_interval_modification (struct buffer *,
- EMACS_INT, EMACS_INT);
+ ptrdiff_t, ptrdiff_t);
extern INTERVAL balance_intervals (INTERVAL);
extern void copy_intervals_to_string (Lisp_Object, struct buffer *,
- EMACS_INT, EMACS_INT);
-extern INTERVAL copy_intervals (INTERVAL, EMACS_INT, EMACS_INT);
-extern int compare_string_intervals (Lisp_Object, Lisp_Object);
+ ptrdiff_t, ptrdiff_t);
+extern INTERVAL copy_intervals (INTERVAL, ptrdiff_t, ptrdiff_t);
+extern bool compare_string_intervals (Lisp_Object, Lisp_Object);
extern Lisp_Object textget (Lisp_Object, Lisp_Object);
-extern Lisp_Object lookup_char_property (Lisp_Object, Lisp_Object, int);
-extern void move_if_not_intangible (EMACS_INT);
-extern int get_property_and_range (EMACS_INT, Lisp_Object, Lisp_Object *,
- EMACS_INT *, EMACS_INT *, Lisp_Object);
-extern Lisp_Object get_local_map (EMACS_INT, struct buffer *, Lisp_Object);
-extern INTERVAL update_interval (INTERVAL, EMACS_INT);
-extern void set_intervals_multibyte (int);
+extern Lisp_Object lookup_char_property (Lisp_Object, Lisp_Object, bool);
+extern void move_if_not_intangible (ptrdiff_t);
+extern bool get_property_and_range (ptrdiff_t, Lisp_Object, Lisp_Object *,
+ ptrdiff_t *, ptrdiff_t *, Lisp_Object);
+extern Lisp_Object get_local_map (ptrdiff_t, struct buffer *, Lisp_Object);
+extern INTERVAL update_interval (INTERVAL, ptrdiff_t);
+extern void set_intervals_multibyte (bool);
extern INTERVAL validate_interval_range (Lisp_Object, Lisp_Object *,
Lisp_Object *, int);
-extern INTERVAL interval_of (EMACS_INT, Lisp_Object);
+extern INTERVAL interval_of (ptrdiff_t, Lisp_Object);
/* Defined in xdisp.c. */
extern int invisible_p (Lisp_Object, Lisp_Object);
/* Sticky properties. */
extern Lisp_Object Qfront_sticky, Qrear_nonsticky;
-EXFUN (Fget_char_property, 3);
-EXFUN (Fget_text_property, 3);
-EXFUN (Ftext_properties_at, 2);
-EXFUN (Fnext_property_change, 3);
-EXFUN (Fadd_text_properties, 4);
-EXFUN (Fset_text_properties, 4);
-EXFUN (Fremove_text_properties, 4);
-EXFUN (Fremove_list_of_text_properties, 4);
-EXFUN (Ftext_property_any, 5);
-EXFUN (Fprevious_single_char_property_change, 4);
extern Lisp_Object copy_text_properties (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
extern void syms_of_textprop (void);
#include "composite.h"
+
+INLINE_HEADER_END
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <signal.h>
+
+#define BLOCKINPUT_INLINE EXTERN_INLINE
+#define KEYBOARD_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "termchar.h"
#include "termopts.h"
#include "keyboard.h"
#include "window.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "disptab.h"
#include "dispextern.h"
#include "syntax.h"
#include <sys/ioctl.h>
#endif /* not MSDOS */
+#if defined USABLE_FIONREAD && defined USG5_4
+# include <sys/filio.h>
+#endif
+
#include "syssignal.h"
#include <sys/types.h>
#include <unistd.h>
#include <fcntl.h>
-/* This is to get the definitions of the XK_ symbols. */
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif
-
-#ifdef HAVE_NTGUI
-#include "w32term.h"
-#endif /* HAVE_NTGUI */
-
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
-/* Variables for blockinput.h: */
+/* Variables for blockinput.h: */
-/* Non-zero if interrupt input is blocked right now. */
+/* Positive if interrupt input is blocked right now. */
volatile int interrupt_input_blocked;
-/* Nonzero means an input interrupt has arrived
- during the current critical section. */
-int interrupt_input_pending;
-
-/* This var should be (interrupt_input_pending || pending_atimers).
- The QUIT macro checks this instead of interrupt_input_pending and
- pending_atimers separately, to reduce code size. So, any code that
- changes interrupt_input_pending or pending_atimers should update
- this too. */
-#ifdef SYNC_INPUT
-int pending_signals;
-#endif
+/* Nonzero means an input interrupt or alarm signal has arrived.
+ The QUIT macro checks this. */
+volatile int pending_signals;
#define KBD_BUFFER_SIZE 4096
actually mean something.
It's easier to staticpro a single Lisp_Object than an array. */
Lisp_Object this_command_keys;
-int this_command_key_count;
+ptrdiff_t this_command_key_count;
/* 1 after calling Freset_this_command_lengths.
Usually it is 0. */
#define GROW_RAW_KEYBUF \
if (raw_keybuf_count == ASIZE (raw_keybuf)) \
- raw_keybuf = larger_vector (raw_keybuf, raw_keybuf_count * 2, Qnil) \
+ raw_keybuf = larger_vector (raw_keybuf, 1, -1)
/* Number of elements of this_command_keys
that precede this key sequence. */
-static int this_single_command_key_start;
+static ptrdiff_t this_single_command_key_start;
/* Record values of this_command_key_count and echo_length ()
before this command was read. */
-static int before_command_key_count;
-static int before_command_echo_length;
+static ptrdiff_t before_command_key_count;
+static ptrdiff_t before_command_echo_length;
/* For longjmp to where kbd input is being done. */
-static jmp_buf getcjmp;
+static sys_jmp_buf getcjmp;
/* True while doing kbd input. */
int waiting_for_input;
Lisp_Object unread_switch_frame;
/* Last size recorded for a current buffer which is not a minibuffer. */
-static EMACS_INT last_non_minibuf_size;
+static ptrdiff_t last_non_minibuf_size;
/* Total number of times read_char has returned, modulo UINTMAX_MAX + 1. */
uintmax_t num_input_events;
/* Value of num_nonmacro_input_events as of last auto save. */
-static int last_auto_save;
-
-/* This is like Vthis_command, except that commands never set it. */
-Lisp_Object real_this_command;
+static EMACS_INT last_auto_save;
/* The value of point when the last command was started. */
-static EMACS_INT last_point_position;
+static ptrdiff_t last_point_position;
/* The buffer that was current when the last command was started. */
static Lisp_Object last_point_position_buffer;
last event came from a macro. We use this to determine when to
generate switch-frame events. This may be cleared by functions
like Fselect_frame, to make sure that a switch-frame event is
- generated by the next character. */
+ generated by the next character.
+
+ FIXME: This is modified by a signal handler so it should be volatile.
+ It's exported to Lisp, though, so it can't simply be marked
+ 'volatile' here. */
Lisp_Object internal_last_event_frame;
/* The timestamp of the last input event we received from the X server.
static void record_menu_key (Lisp_Object c);
static void echo_now (void);
-static int echo_length (void);
+static ptrdiff_t echo_length (void);
static Lisp_Object Qpolling_period;
/* Nonzero while interrupts are temporarily deferred during redisplay. */
int interrupts_deferred;
-/* Allow m- file to inhibit use of FIONREAD. */
-#ifdef BROKEN_FIONREAD
-#undef FIONREAD
-#endif
-
-/* We are unable to use interrupts if FIONREAD is not available,
- so flush SIGIO so we won't try. */
-#if !defined (FIONREAD)
-#ifdef SIGIO
-#undef SIGIO
-#endif
-#endif
-
/* If we support a window system, turn on the code to poll periodically
to detect C-g. It isn't actually used when doing interrupt input. */
-#if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_ASYNC_EVENTS)
+#ifdef HAVE_WINDOW_SYSTEM
#define POLL_FOR_INPUT
#endif
/* Function for init_keyboard to call with no args (if nonzero). */
static void (*keyboard_init_hook) (void);
-static int read_avail_input (int);
static void get_input_pending (int *, int);
static int readable_events (int);
static Lisp_Object read_char_x_menu_prompt (ptrdiff_t, Lisp_Object *,
Lisp_Object, Lisp_Object,
Time);
#endif
-static Lisp_Object modify_event_symbol (EMACS_INT, unsigned, Lisp_Object,
+static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
Lisp_Object, const char *const *,
- Lisp_Object *, EMACS_INT);
+ Lisp_Object *, ptrdiff_t);
static Lisp_Object make_lispy_switch_frame (Lisp_Object);
static int help_char_p (Lisp_Object);
-static void save_getcjmp (jmp_buf);
-static void restore_getcjmp (jmp_buf);
+static void save_getcjmp (sys_jmp_buf);
+static void restore_getcjmp (sys_jmp_buf);
static Lisp_Object apply_modifiers (int, Lisp_Object);
static void clear_event (struct input_event *);
static Lisp_Object restore_kboard_configuration (Lisp_Object);
-static void interrupt_signal (int signalnum);
-#ifdef SIGIO
-static void input_available_signal (int signo);
+#ifdef USABLE_SIGIO
+static void deliver_input_available_signal (int signo);
#endif
-static Lisp_Object (Fcommand_execute) (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
-static void handle_interrupt (void);
-static void quit_throw_to_read_char (int) NO_RETURN;
+static void handle_interrupt (bool);
+static _Noreturn void quit_throw_to_read_char (int);
static void process_special_events (void);
static void timer_start_idle (void);
static void timer_stop_idle (void);
static void timer_resume_idle (void);
-static void handle_user_signal (int);
+static void deliver_user_signal (int);
static char *find_user_signal_name (int);
-static int store_user_signal_events (void);
+static void store_user_signal_events (void);
+
+/* These setters are used only in this file, so they can be private. */
+static inline void
+kset_echo_string (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (echo_string) = val;
+}
+static inline void
+kset_kbd_queue (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (kbd_queue) = val;
+}
+static inline void
+kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vkeyboard_translate_table) = val;
+}
+static inline void
+kset_last_prefix_arg (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlast_prefix_arg) = val;
+}
+static inline void
+kset_last_repeatable_command (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlast_repeatable_command) = val;
+}
+static inline void
+kset_local_function_key_map (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlocal_function_key_map) = val;
+}
+static inline void
+kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Voverriding_terminal_local_map) = val;
+}
+static inline void
+kset_real_last_command (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vreal_last_command) = val;
+}
+static inline void
+kset_system_key_syms (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (system_key_syms) = val;
+}
\f
/* Add C to the echo string, if echoing is going on.
if (current_kboard->immediate_echo)
{
int size = KEY_DESCRIPTION_SIZE + 100;
- char *buffer = (char *) alloca (size);
+ char *buffer = alloca (size);
char *ptr = buffer;
Lisp_Object echo_string;
{
int offset = ptr - buffer;
size = max (2 * size, size + nbytes);
- buffer = (char *) alloca (size);
+ buffer = alloca (size);
ptr = buffer + offset;
}
{
int offset = ptr - buffer;
size += len;
- buffer = (char *) alloca (size);
+ buffer = alloca (size);
ptr = buffer + offset;
}
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_echo_string
+ (current_kboard,
+ concat2 (echo_string, make_string (buffer, ptr - buffer)));
echo_now ();
}
/* 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_echo_string
+ (current_kboard,
+ concat2 (KVAR (current_kboard, echo_string), build_string ("-")));
echo_now ();
}
{
if (!current_kboard->immediate_echo)
{
- int i;
+ ptrdiff_t i;
current_kboard->immediate_echo = 1;
for (i = 0; i < this_command_key_count; i++)
if (i == this_single_command_key_start)
before_command_echo_length = echo_length ();
- c = XVECTOR (this_command_keys)->contents[i];
+ c = AREF (this_command_keys, i);
if (! (EVENT_HAS_PARAMETERS (c)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
echo_char (c);
{
current_kboard->immediate_echo = 0;
current_kboard->echo_after_prompt = -1;
- KVAR (current_kboard, echo_string) = Qnil;
+ kset_echo_string (current_kboard, Qnil);
ok_to_echo_at_next_pause = NULL;
echo_kboard = NULL;
echo_message_buffer = Qnil;
/* Return the length of the current echo string. */
-static int
+static ptrdiff_t
echo_length (void)
{
return (STRINGP (KVAR (current_kboard, echo_string))
switches frames while entering a key sequence. */
static void
-echo_truncate (EMACS_INT nchars)
+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_echo_string (current_kboard,
+ Fsubstring (KVAR (current_kboard, echo_string),
+ make_number (0), make_number (nchars)));
truncate_echo_area (nchars);
}
#endif
if (this_command_key_count >= ASIZE (this_command_keys))
- this_command_keys = larger_vector (this_command_keys,
- 2 * ASIZE (this_command_keys),
- Qnil);
+ this_command_keys = larger_vector (this_command_keys, 1, -1);
ASET (this_command_keys, this_command_key_count, key);
++this_command_key_count;
Lisp_Object
recursive_edit_1 (void)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
if (command_loop_level > 0)
This function is called by the editor initialization to begin editing. */)
(void)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object buffer;
/* If we enter while input is blocked, don't lock up here.
This may happen through the debugger during redisplay. */
- if (INPUT_BLOCKED_P)
+ if (input_blocked_p ())
return Qnil;
command_loop_level++;
void
push_kboard (struct kboard *k)
{
- struct kboard_stack *p
- = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
+ struct kboard_stack *p = xmalloc (sizeof *p);
p->next = kboard_stack;
p->kboard = current_kboard;
pop_kboard ();
/* The pop should not change the kboard. */
if (single_kboard && current_kboard != prev)
- abort ();
+ emacs_abort ();
}
return Qnil;
}
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_prefix_arg (current_kboard, Qnil);
+ kset_last_prefix_arg (current_kboard, Qnil);
cancel_echoing ();
/* Avoid unquittable loop if data contains a circular list. */
/* Unblock input if we enter with input blocked. This may happen if
redisplay traps e.g. during tool-bar update with input blocked. */
- while (INPUT_BLOCKED_P)
- UNBLOCK_INPUT;
+ totally_unblock_input ();
Fthrow (Qtop_level, Qnil);
}
-static Lisp_Object Fexit_recursive_edit (void) NO_RETURN;
+static _Noreturn void
+user_error (const char *msg)
+{
+ xsignal1 (Quser_error, build_string (msg));
+}
+
+_Noreturn
DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
doc: /* Exit from the innermost recursive edit or minibuffer. */)
(void)
if (command_loop_level > 0 || minibuf_level > 0)
Fthrow (Qexit, Qnil);
- error ("No recursive edit is in progress");
+ user_error ("No recursive edit is in progress");
}
-static Lisp_Object Fabort_recursive_edit (void) NO_RETURN;
+_Noreturn
DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
(void)
if (command_loop_level > 0 || minibuf_level > 0)
Fthrow (Qexit, Qt);
- error ("No recursive edit is in progress");
+ user_error ("No recursive edit is in progress");
}
\f
#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
usage: (track-mouse BODY...) */)
(Lisp_Object args)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
record_unwind_protect (tracking_off, do_mouse_tracking);
static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
int, int, int);
void safe_run_hooks (Lisp_Object);
-static void adjust_point_for_property (EMACS_INT, int);
+static void adjust_point_for_property (ptrdiff_t, int);
/* Cancel hourglass from protect_unwind.
ARG is not used. */
}
#endif
+/* The last boundary auto-added to buffer-undo-list. */
+Lisp_Object last_undo_boundary;
+
/* FIXME: This is wrong rather than test window-system, we should call
a new set-selection, which will then dispatch to x-set-selection, or
tty-set-selection, or w32-set-selection, ... */
-EXFUN (Fwindow_system, 1);
Lisp_Object
command_loop_1 (void)
Lisp_Object cmd;
Lisp_Object keybuf[30];
int i;
- int prev_modiff = 0;
+ EMACS_INT prev_modiff = 0;
struct buffer *prev_buffer = NULL;
#if 0 /* This shouldn't be necessary anymore. --lorentey */
int was_locked = single_kboard;
#endif
int already_adjusted = 0;
- KVAR (current_kboard, Vprefix_arg) = Qnil;
- KVAR (current_kboard, Vlast_prefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
+ kset_last_prefix_arg (current_kboard, Qnil);
Vdeactivate_mark = Qnil;
waiting_for_input = 0;
cancel_echoing ();
}
/* Do this after running Vpost_command_hook, for consistency. */
- KVAR (current_kboard, Vlast_command) = Vthis_command;
- KVAR (current_kboard, Vreal_last_command) = real_this_command;
+ kset_last_command (current_kboard, Vthis_command);
+ kset_real_last_command (current_kboard, Vreal_this_command);
if (!CONSP (last_command_event))
- KVAR (current_kboard, Vlast_repeatable_command) = real_this_command;
+ kset_last_repeatable_command (current_kboard, Vreal_this_command);
while (1)
{
Fkill_emacs (Qnil);
/* Make sure the current window's buffer is selected. */
- if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
- set_buffer_internal (XBUFFER (XWINDOW (selected_window)->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. */
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. */
{
/* Bind inhibit-quit to t so that C-g gets read in
rather than quitting back to the minibuffer. */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
sit_for (Vminibuffer_message_timeout, 0, 2);
}
}
-#if 0
- /* Select the frame that the last event came from. Usually,
- switch-frame events will take care of this, but if some lisp
- code swallows a switch-frame event, we'll fix things up here.
- Is this a good idea? */
- if (FRAMEP (internal_last_event_frame)
- && !EQ (internal_last_event_frame, selected_frame))
- Fselect_frame (internal_last_event_frame, Qnil);
-#endif
/* If it has changed current-menubar from previous value,
really recompute the menubar from the value. */
if (! NILP (Vlucid_menu_bar_dirty_flag)
before_command_echo_length = echo_length ();
Vthis_command = Qnil;
- real_this_command = Qnil;
+ Vreal_this_command = Qnil;
Vthis_original_command = Qnil;
Vthis_command_keys_shift_translated = Qnil;
/* A filter may have run while we were reading the input. */
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
Fkill_emacs (Qnil);
- if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
- set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
+ set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
++num_input_keys;
from that position. But also throw away beg_unchanged and
end_unchanged information in that case, so that redisplay will
update the whole window properly. */
- if (!NILP (XWINDOW (selected_window)->force_start))
+ if (XWINDOW (selected_window)->force_start)
{
struct buffer *b;
- XWINDOW (selected_window)->force_start = Qnil;
+ XWINDOW (selected_window)->force_start = 0;
b = XBUFFER (XWINDOW (selected_window)->buffer);
BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
}
/* Execute the command. */
Vthis_command = cmd;
- real_this_command = cmd;
+ Vreal_this_command = cmd;
safe_run_hooks (Qpre_command_hook);
already_adjusted = 0;
keys = Fkey_description (keys, Qnil);
bitch_at_user ();
message_with_string ("%s is undefined", keys, 0);
- KVAR (current_kboard, defining_kbd_macro) = Qnil;
+ kset_defining_kbd_macro (current_kboard, 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. */
= parse_modifiers (EVENT_HEAD (last_command_event));
int modifiers = XINT (XCAR (XCDR (breakdown)));
if (!(modifiers & down_modifier))
- KVAR (current_kboard, Vprefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
}
else
- KVAR (current_kboard, Vprefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
}
else
{
/* Here for a command that isn't executed directly. */
#ifdef HAVE_WINDOW_SYSTEM
- int scount = SPECPDL_INDEX ();
+ ptrdiff_t scount = SPECPDL_INDEX ();
if (display_hourglass_p
&& NILP (Vexecuting_kbd_macro))
#endif
if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */
- Fundo_boundary ();
+ {
+ Lisp_Object undo = BVAR (current_buffer, undo_list);
+ Fundo_boundary ();
+ last_undo_boundary
+ = (EQ (undo, BVAR (current_buffer, undo_list))
+ ? Qnil : BVAR (current_buffer, undo_list));
+ }
Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
#ifdef HAVE_WINDOW_SYSTEM
unbind_to (scount, Qnil);
#endif
}
- KVAR (current_kboard, Vlast_prefix_arg) = Vcurrent_prefix_arg;
+ kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
safe_run_hooks (Qpost_command_hook);
If the command didn't actually create a prefix arg,
but is merely a frame event that is transparent to prefix args,
then the above doesn't apply. */
- if (NILP (KVAR (current_kboard, Vprefix_arg)) || CONSP (last_command_event))
+ if (NILP (KVAR (current_kboard, Vprefix_arg))
+ || CONSP (last_command_event))
{
- KVAR (current_kboard, Vlast_command) = Vthis_command;
- KVAR (current_kboard, Vreal_last_command) = real_this_command;
+ kset_last_command (current_kboard, Vthis_command);
+ kset_real_last_command (current_kboard, Vreal_this_command);
if (!CONSP (last_command_event))
- KVAR (current_kboard, Vlast_repeatable_command) = real_this_command;
+ kset_last_repeatable_command (current_kboard, Vreal_this_command);
cancel_echoing ();
this_command_key_count = 0;
this_command_key_count_reset = 0;
&& NILP (Fmemq (Vthis_command,
Vselection_inhibit_update_commands)))
{
- EMACS_INT beg =
+ ptrdiff_t beg =
XINT (Fmarker_position (BVAR (current_buffer, mark)));
- EMACS_INT end = PT;
+ ptrdiff_t end = PT;
if (beg < end)
call2 (Qx_set_selection, QPRIMARY,
make_buffer_string (beg, end, 0));
LAST_PT is the last position of point. */
static void
-adjust_point_for_property (EMACS_INT last_pt, int modified)
+adjust_point_for_property (ptrdiff_t last_pt, int modified)
{
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
Lisp_Object val, overlay, tmp;
/* When called after buffer modification, we should temporarily
suppress the point adjustment for automatic composition so that a
user can keep inserting another character at point or keep
deleting characters around point. */
int check_composition = ! modified, check_display = 1, check_invisible = 1;
- EMACS_INT orig_pt = PT;
+ ptrdiff_t orig_pt = PT;
/* FIXME: cycling is probably not necessary because these properties
can't be usefully combined anyway. */
&& (beg < PT /* && end > PT <- It's always the case. */
|| (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
{
- xassert (end > PT);
+ eassert (end > PT);
SET_PT (PT < last_pt
? (STRINGP (val) && SCHARS (val) == 0
? max (beg - 1, BEGV)
#if 0 /* This assertion isn't correct, because SET_PT may end up setting
the point to something other than its argument, due to
point-motion hooks, intangibility, etc. */
- xassert (PT == beg || PT == end);
+ eassert (PT == beg || PT == end);
#endif
/* Pretend the area doesn't exist if the buffer is not
/* FIXME: our `internal_condition_case' does not provide any way to pass data
to its body or to its handlers other than via globals such as
dynamically-bound variables ;-) */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, hook);
run_hook_with_args (1, &hook, safe_run_hook_funcall);
void
poll_for_input_1 (void)
{
-/* Tell ns_read_socket() it is being called asynchronously so it can avoid
- doing anything dangerous. */
-#ifdef HAVE_NS
- ++handling_signal;
-#endif
- if (interrupt_input_blocked == 0
+ if (! input_blocked_p ()
&& !waiting_for_input)
- read_avail_input (0);
-#ifdef HAVE_NS
- --handling_signal;
-#endif
+ gobble_input ();
}
/* Timer callback function for poll_timer. TIMER is equal to
poll_for_input (struct atimer *timer)
{
if (poll_suppress_count == 0)
- {
-#ifdef SYNC_INPUT
- interrupt_input_pending = 1;
- pending_signals = 1;
-#else
- poll_for_input_1 ();
-#endif
- }
+ pending_signals = 1;
}
#endif /* POLL_FOR_INPUT */
if (poll_timer == NULL
|| EMACS_SECS (poll_timer->interval) != polling_period)
{
- EMACS_TIME interval;
+ time_t period = max (1, min (polling_period, TYPE_MAXIMUM (time_t)));
+ EMACS_TIME interval = make_emacs_time (period, 0);
if (poll_timer)
cancel_atimer (poll_timer);
- EMACS_SET_SECS_USECS (interval, polling_period, 0);
poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
poll_for_input, NULL);
}
bind_polling_period (int n)
{
#ifdef POLL_FOR_INPUT
- int new = polling_period;
+ EMACS_INT new = polling_period;
if (n > new)
new = n;
if (!NILP (help) && !STRINGP (help))
{
if (FUNCTIONP (help))
- {
- Lisp_Object args[4];
- args[0] = help;
- args[1] = window;
- args[2] = object;
- args[3] = pos;
- help = safe_call (4, args);
- }
+ help = safe_call (4, help, window, object, pos);
else
help = safe_eval (help);
/* Input of single characters from keyboard */
static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, int *used_mouse_menu,
- struct timeval *end_time);
+ EMACS_TIME *end_time);
static void record_char (Lisp_Object c);
static Lisp_Object help_form_saved_window_configs;
Lisp_Object
read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps,
Lisp_Object prev_event,
- int *used_mouse_menu, struct timeval *end_time)
+ int *used_mouse_menu, EMACS_TIME *end_time)
{
volatile Lisp_Object c;
- int jmpcount;
- jmp_buf local_getcjmp;
- jmp_buf save_jump;
+ ptrdiff_t jmpcount;
+ sys_jmp_buf local_getcjmp;
+ sys_jmp_buf save_jump;
volatile int key_already_recorded = 0;
Lisp_Object tem, save;
volatile Lisp_Object previous_echo_area_message;
goto reread_first;
}
- if (unread_command_char != -1)
- {
- XSETINT (c, unread_command_char);
- unread_command_char = -1;
-
- reread = 1;
- goto reread_first;
- }
-
if (CONSP (Vunread_command_events))
{
int was_disabled = 0;
&& !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
/* Don't bring up a menu if we already have another event. */
&& NILP (Vunread_command_events)
- && unread_command_char < 0
&& !detect_input_pending_run_timers (0))
{
c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
it *must not* be in effect when we call redisplay. */
jmpcount = SPECPDL_INDEX ();
- if (_setjmp (local_getcjmp))
+ if (sys_setjmp (local_getcjmp))
{
/* Handle quits while reading the keyboard. */
/* We must have saved the outer value of getcjmp here,
Lisp_Object last = KVAR (kb, kbd_queue);
/* We shouldn't get here if we were in single-kboard mode! */
if (single_kboard)
- abort ();
+ emacs_abort ();
if (CONSP (last))
{
while (CONSP (XCDR (last)))
last = XCDR (last);
if (!NILP (XCDR (last)))
- abort ();
+ emacs_abort ();
}
if (!CONSP (last))
- KVAR (kb, kbd_queue) = Fcons (c, Qnil);
+ kset_kbd_queue (kb, Fcons (c, Qnil));
else
XSETCDR (last, Fcons (c, Qnil));
kb->kbd_queue_has_data = 1;
&& !EQ (XCAR (prev_event), Qmenu_bar)
&& !EQ (XCAR (prev_event), Qtool_bar)
/* Don't bring up a menu if we already have another event. */
- && NILP (Vunread_command_events)
- && unread_command_char < 0)
+ && NILP (Vunread_command_events))
{
c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
if (INTERACTIVE && NILP (c))
{
int delay_level;
- EMACS_INT buffer_size;
+ ptrdiff_t buffer_size;
/* Slow down auto saves logarithmically in size of current buffer,
and garbage collect while we're at it. */
&& XINT (Vauto_save_timeout) > 0)
{
Lisp_Object tem0;
- int timeout = delay_level * XFASTINT (Vauto_save_timeout) / 4;
-
+ EMACS_INT timeout = (delay_level
+ * min (XFASTINT (Vauto_save_timeout) / 4,
+ MOST_POSITIVE_FIXNUM / delay_level));
save_getcjmp (save_jump);
restore_getcjmp (local_getcjmp);
tem0 = sit_for (make_number (timeout), 1, 1);
&& ! CONSP (Vunread_command_events))
{
Fdo_auto_save (Qnil, Qnil);
-
- /* If we have auto-saved and there is still no input
- available, garbage collect if there has been enough
- consing going on to make it worthwhile. */
- if (!detect_input_pending_run_timers (0)
- && consing_since_gc > gc_cons_threshold / 2)
- Fgarbage_collect ();
-
redisplay ();
}
}
+
+ /* If there is still no input available, ask for GC. */
+ if (!detect_input_pending_run_timers (0))
+ maybe_gc ();
}
/* Notify the caller if an autosave hook, or a timer, sentinel or
if (current_kboard->kbd_queue_has_data)
{
if (!CONSP (KVAR (current_kboard, kbd_queue)))
- abort ();
+ emacs_abort ();
c = XCAR (KVAR (current_kboard, kbd_queue));
- KVAR (current_kboard, kbd_queue)
- = XCDR (KVAR (current_kboard, kbd_queue));
+ kset_kbd_queue (current_kboard,
+ 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);
{
KBOARD *kb IF_LINT (= NULL);
- if (end_time)
- {
- EMACS_TIME now;
- EMACS_GET_TIME (now);
- if (EMACS_TIME_GE (now, *end_time))
- goto exit;
- }
+ if (end_time && EMACS_TIME_LE (*end_time, current_emacs_time ()))
+ goto exit;
/* Actually read a character, waiting if necessary. */
save_getcjmp (save_jump);
while (CONSP (XCDR (last)))
last = XCDR (last);
if (!NILP (XCDR (last)))
- abort ();
+ emacs_abort ();
}
if (!CONSP (last))
- KVAR (kb, kbd_queue) = Fcons (c, Qnil);
+ kset_kbd_queue (kb, Fcons (c, Qnil));
else
XSETCDR (last, Fcons (c, Qnil));
kb->kbd_queue_has_data = 1;
struct buffer *prev_buffer = current_buffer;
#if 0 /* This shouldn't be necessary anymore. --lorentey */
int was_locked = single_kboard;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
record_single_kboard_state ();
#endif
own stuff with the echo area. */
if (!CONSP (c)
|| (!(EQ (Qhelp_echo, XCAR (c)))
- && !(EQ (Qswitch_frame, XCAR (c)))))
+ && !(EQ (Qswitch_frame, XCAR (c)))
+ /* Don't wipe echo area for select window events: These might
+ get delayed via `mouse-autoselect-window' (Bug#11304). */
+ && !(EQ (Qselect_window, XCAR (c)))))
{
if (!NILP (echo_area_buffer[0]))
- safe_run_hooks (Qecho_area_clear_hook);
- clear_message (1, 0);
+ {
+ safe_run_hooks (Qecho_area_clear_hook);
+ clear_message (1, 0);
+ }
}
reread_for_input_method:
&& ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
{
Lisp_Object keys;
- int key_count, key_count_reset;
+ ptrdiff_t key_count;
+ int key_count_reset;
struct gcpro gcpro1;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* Save the echo status. */
int saved_immediate_echo = current_kboard->immediate_echo;
cancel_echoing ();
ok_to_echo_at_next_pause = saved_ok_to_echo;
- KVAR (current_kboard, echo_string) = saved_echo_string;
+ kset_echo_string (current_kboard, saved_echo_string);
current_kboard->echo_after_prompt = saved_echo_after_prompt;
if (saved_immediate_echo)
echo_now ();
/* Process the help character specially if enabled */
if (!NILP (Vhelp_form) && help_char_p (c))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
help_form_saved_window_configs
= Fcons (Fcurrent_window_configuration (Qnil),
if (!recorded)
{
- total_keys++;
+ total_keys += total_keys < NUM_RECENT_KEYS;
ASET (recent_keys, recent_keys_index, c);
if (++recent_keys_index >= NUM_RECENT_KEYS)
recent_keys_index = 0;
If you, dear reader, have a better idea, you've got the source. :-) */
if (dribble)
{
- BLOCK_INPUT;
+ block_input ();
if (INTEGERP (c))
{
if (XUINT (c) < 0x100)
}
fflush (dribble);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
See read_process_output. */
static void
-save_getcjmp (jmp_buf temp)
+save_getcjmp (sys_jmp_buf temp)
{
memcpy (temp, getcjmp, sizeof getcjmp);
}
static void
-restore_getcjmp (jmp_buf temp)
+restore_getcjmp (sys_jmp_buf temp)
{
memcpy (getcjmp, temp, sizeof getcjmp);
}
Else, if EVENT is a quit event, store the quit event
in HOLD_QUIT, and return (thus ignoring further events).
- This is used in read_avail_input to postpone the processing
- of the quit event until all subsequent input events have been
- parsed (and discarded).
- */
+ This is used to postpone the processing of the quit event until all
+ subsequent input events have been parsed (and discarded). */
void
kbd_buffer_store_event_hold (register struct input_event *event,
struct input_event *hold_quit)
{
if (event->kind == NO_EVENT)
- abort ();
+ emacs_abort ();
if (hold_quit && hold_quit->kind != NO_EVENT)
return;
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_kbd_queue
+ (kb, 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++)
{
if (hold_quit)
{
- memcpy (hold_quit, event, sizeof (*event));
+ *hold_quit = *event;
return;
}
}
last_event_timestamp = event->timestamp;
- handle_interrupt ();
+
+ handle_interrupt (0);
return;
}
/* Don't read keyboard input until we have processed kbd_buffer.
This happens when pasting text longer than KBD_BUFFER_SIZE/2. */
hold_keyboard_input ();
-#ifdef SIGIO
if (!noninteractive)
- signal (SIGIO, SIG_IGN);
-#endif
+ ignore_sigio ();
stop_polling ();
}
#endif /* subprocesses */
if (immediate_quit && NILP (Vinhibit_quit))
{
immediate_quit = 0;
- sigfree ();
QUIT;
}
}
void
gen_help_event (Lisp_Object help, Lisp_Object frame, Lisp_Object window,
- Lisp_Object object, EMACS_INT pos)
+ Lisp_Object object, ptrdiff_t pos)
{
struct input_event event;
static Lisp_Object
kbd_buffer_get_event (KBOARD **kbp,
int *used_mouse_menu,
- struct timeval *end_time)
+ EMACS_TIME *end_time)
{
- register int c;
Lisp_Object obj;
#ifdef subprocesses
/* Start reading input again, we have processed enough so we can
accept new events again. */
unhold_keyboard_input ();
-#ifdef SIGIO
- if (!noninteractive)
- signal (SIGIO, input_available_signal);
-#endif /* SIGIO */
start_polling ();
}
#endif /* subprocesses */
+#ifndef HAVE_DBUS /* We want to read D-Bus events in batch mode. */
if (noninteractive
/* In case we are running as a daemon, only do this before
detaching from the terminal. */
|| (IS_DAEMON && daemon_pipe[1] >= 0))
{
- c = getchar ();
+ int c = getchar ();
XSETINT (obj, c);
*kbp = current_kboard;
return obj;
}
+#endif /* ! HAVE_DBUS */
/* Wait until there is input available. */
for (;;)
/* One way or another, wait until input is available; then, if
interrupt handlers have not read it, read it now. */
-/* Note SIGIO has been undef'd if FIONREAD is missing. */
-#ifdef SIGIO
- gobble_input (0);
-#endif /* SIGIO */
+#ifdef USABLE_SIGIO
+ gobble_input ();
+#endif
if (kbd_fetch_ptr != kbd_store_ptr)
break;
#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
#endif
if (end_time)
{
- EMACS_TIME duration;
- EMACS_GET_TIME (duration);
- if (EMACS_TIME_GE (duration, *end_time))
- return Qnil; /* finished waiting */
+ EMACS_TIME now = current_emacs_time ();
+ if (EMACS_TIME_LE (*end_time, now))
+ return Qnil; /* Finished waiting. */
else
{
- EMACS_SUB_TIME (duration, *end_time, duration);
- wait_reading_process_output (EMACS_SECS (duration),
- EMACS_USECS (duration),
+ EMACS_TIME duration = sub_emacs_time (*end_time, now);
+ wait_reading_process_output (min (EMACS_SECS (duration),
+ WAIT_READING_MAX),
+ EMACS_NSECS (duration),
-1, 1, Qnil, NULL, 0);
}
}
wait_reading_process_output (0, 0, -1, 1, Qnil, NULL, 0);
if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
- /* Pass 1 for EXPECT since we just waited to have input. */
- read_avail_input (1);
+ gobble_input ();
}
if (CONSP (Vunread_command_events))
#else
/* We're getting selection request events, but we don't have
a window system. */
- abort ();
+ emacs_abort ();
#endif
}
#if defined (WINDOWSNT)
else if (event->kind == LANGUAGE_CHANGE_EVENT)
{
- /* Make an event (language-change (FRAME CHARSET LCID)). */
- obj = Fcons (event->frame_or_window, Qnil);
- obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
+ /* Make an event (language-change (FRAME CODEPAGE LANGUAGE-ID)). */
+ obj = Fcons (Qlanguage_change,
+ list3 (event->frame_or_window,
+ make_number (event->code),
+ make_number (event->modifiers)));
kbd_fetch_ptr = event + 1;
}
#endif
*used_mouse_menu = 1;
#endif
#ifdef HAVE_NS
- /* certain system events are non-key events */
+ /* Certain system events are non-key events. */
if (used_mouse_menu
&& event->kind == NS_NONKEY_EVENT)
*used_mouse_menu = 1;
so x remains nil. */
x = Qnil;
- /* XXX Can f or mouse_position_hook be NULL here? */
+ /* XXX Can f or mouse_position_hook be NULL here? */
if (f && FRAME_TERMINAL (f)->mouse_position_hook)
(*FRAME_TERMINAL (f)->mouse_position_hook) (&f, 0, &bar_window,
&part, &x, &y, &t);
else
/* We were promised by the above while loop that there was
something for us to read! */
- abort ();
+ emacs_abort ();
input_pending = readable_events (0);
#else
/* We're getting selection request events, but we don't have
a window system. */
- abort ();
+ emacs_abort ();
#endif
}
}
Lisp_Object timers;
/* If we are already in the idle state, do nothing. */
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
+ if (EMACS_TIME_VALID_P (timer_idleness_start_time))
return;
- EMACS_GET_TIME (timer_idleness_start_time);
-
+ timer_idleness_start_time = current_emacs_time ();
timer_last_idleness_start_time = timer_idleness_start_time;
/* Mark all idle-time timers as once again candidates for running. */
timer = XCAR (timers);
- if (!VECTORP (timer) || ASIZE (timer) != 8)
+ if (!VECTORP (timer) || ASIZE (timer) != 9)
continue;
- XVECTOR (timer)->contents[0] = Qnil;
+ ASET (timer, 0, Qnil);
}
}
static void
timer_stop_idle (void)
{
- EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
+ timer_idleness_start_time = invalid_emacs_time ();
}
/* Resume idle timer from last idle start time. */
static void
timer_resume_idle (void)
{
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
+ if (EMACS_TIME_VALID_P (timer_idleness_start_time))
return;
timer_idleness_start_time = timer_last_idleness_start_time;
...). Each element has the form (FUN . ARGS). */
Lisp_Object pending_funcalls;
+/* Return true if TIMER is a valid timer, placing its value into *RESULT. */
+static bool
+decode_timer (Lisp_Object timer, EMACS_TIME *result)
+{
+ Lisp_Object *vector;
+
+ if (! (VECTORP (timer) && ASIZE (timer) == 9))
+ return 0;
+ vector = XVECTOR (timer)->contents;
+ if (! NILP (vector[0]))
+ return 0;
+
+ return decode_time_components (vector[1], vector[2], vector[3], vector[8],
+ result, 0);
+}
+
+
/* Check whether a timer has fired. To prevent larger problems we simply
disregard elements that are not proper timers. Do not make a circular
timer list for the time being.
should be done. */
static EMACS_TIME
-timer_check_2 (void)
+timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
{
EMACS_TIME nexttime;
EMACS_TIME now;
- EMACS_TIME idleness_now IF_LINT (= {0});
- Lisp_Object timers, idle_timers, chosen_timer;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ EMACS_TIME idleness_now;
+ Lisp_Object chosen_timer;
+ struct gcpro gcpro1;
- EMACS_SET_SECS (nexttime, -1);
- EMACS_SET_USECS (nexttime, -1);
+ nexttime = invalid_emacs_time ();
- /* Always consider the ordinary timers. */
- timers = Vtimer_list;
- /* Consider the idle timers only if Emacs is idle. */
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
- idle_timers = Vtimer_idle_list;
- else
- idle_timers = Qnil;
chosen_timer = Qnil;
- GCPRO3 (timers, idle_timers, chosen_timer);
+ GCPRO1 (chosen_timer);
/* First run the code that was delayed. */
while (CONSP (pending_funcalls))
if (CONSP (timers) || CONSP (idle_timers))
{
- EMACS_GET_TIME (now);
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
- EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
+ now = current_emacs_time ();
+ idleness_now = (EMACS_TIME_VALID_P (timer_idleness_start_time)
+ ? sub_emacs_time (now, timer_idleness_start_time)
+ : make_emacs_time (0, 0));
}
while (CONSP (timers) || CONSP (idle_timers))
{
- Lisp_Object *vector;
Lisp_Object timer = Qnil, idle_timer = Qnil;
EMACS_TIME timer_time, idle_timer_time;
EMACS_TIME difference;
- EMACS_TIME timer_difference IF_LINT (= {0});
- EMACS_TIME idle_timer_difference IF_LINT (= {0});
+ EMACS_TIME timer_difference = invalid_emacs_time ();
+ EMACS_TIME idle_timer_difference = invalid_emacs_time ();
+ int ripe, timer_ripe = 0, idle_timer_ripe = 0;
- /* Skip past invalid timers and timers already handled. */
+ /* Set TIMER and TIMER_DIFFERENCE
+ based on the next ordinary timer.
+ TIMER_DIFFERENCE is the distance in time from NOW to when
+ this timer becomes ripe (negative if it's already ripe).
+ Skip past invalid timers and timers already handled. */
if (CONSP (timers))
{
timer = XCAR (timers);
- if (!VECTORP (timer) || ASIZE (timer) != 8)
+ if (! decode_timer (timer, &timer_time))
{
timers = XCDR (timers);
continue;
}
- vector = XVECTOR (timer)->contents;
- if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
- || !INTEGERP (vector[3])
- || ! NILP (vector[0]))
- {
- timers = XCDR (timers);
- continue;
- }
+ timer_ripe = EMACS_TIME_LE (timer_time, now);
+ timer_difference = (timer_ripe
+ ? sub_emacs_time (now, timer_time)
+ : sub_emacs_time (timer_time, now));
}
+
+ /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE
+ based on the next idle timer. */
if (CONSP (idle_timers))
{
- timer = XCAR (idle_timers);
- if (!VECTORP (timer) || ASIZE (timer) != 8)
- {
- idle_timers = XCDR (idle_timers);
- continue;
- }
- vector = XVECTOR (timer)->contents;
-
- if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
- || !INTEGERP (vector[3])
- || ! NILP (vector[0]))
+ idle_timer = XCAR (idle_timers);
+ if (! decode_timer (idle_timer, &idle_timer_time))
{
idle_timers = XCDR (idle_timers);
continue;
}
- }
- /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
- based on the next ordinary timer.
- TIMER_DIFFERENCE is the distance in time from NOW to when
- this timer becomes ripe (negative if it's already ripe). */
- if (CONSP (timers))
- {
- timer = XCAR (timers);
- vector = XVECTOR (timer)->contents;
- EMACS_SET_SECS (timer_time,
- (XINT (vector[1]) << 16) | (XINT (vector[2])));
- EMACS_SET_USECS (timer_time, XINT (vector[3]));
- EMACS_SUB_TIME (timer_difference, timer_time, now);
- }
-
- /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
- based on the next idle timer. */
- if (CONSP (idle_timers))
- {
- idle_timer = XCAR (idle_timers);
- vector = XVECTOR (idle_timer)->contents;
- EMACS_SET_SECS (idle_timer_time,
- (XINT (vector[1]) << 16) | (XINT (vector[2])));
- EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
- EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
+ idle_timer_ripe = EMACS_TIME_LE (idle_timer_time, idleness_now);
+ idle_timer_difference =
+ (idle_timer_ripe
+ ? sub_emacs_time (idleness_now, idle_timer_time)
+ : sub_emacs_time (idle_timer_time, idleness_now));
}
/* Decide which timer is the next timer,
- and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
+ and set CHOSEN_TIMER, DIFFERENCE, and RIPE accordingly.
Also step down the list where we found that timer. */
- if (CONSP (timers) && CONSP (idle_timers))
- {
- EMACS_TIME temp;
- EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
- if (EMACS_TIME_NEG_P (temp))
- {
- chosen_timer = timer;
- timers = XCDR (timers);
- difference = timer_difference;
- }
- else
- {
- chosen_timer = idle_timer;
- idle_timers = XCDR (idle_timers);
- difference = idle_timer_difference;
- }
- }
- else if (CONSP (timers))
+ if (EMACS_TIME_VALID_P (timer_difference)
+ && (! EMACS_TIME_VALID_P (idle_timer_difference)
+ || idle_timer_ripe < timer_ripe
+ || (idle_timer_ripe == timer_ripe
+ && (timer_ripe
+ ? EMACS_TIME_LT (idle_timer_difference,
+ timer_difference)
+ : EMACS_TIME_LT (timer_difference,
+ idle_timer_difference)))))
{
chosen_timer = timer;
timers = XCDR (timers);
difference = timer_difference;
+ ripe = timer_ripe;
}
else
{
chosen_timer = idle_timer;
idle_timers = XCDR (idle_timers);
difference = idle_timer_difference;
+ ripe = idle_timer_ripe;
}
- vector = XVECTOR (chosen_timer)->contents;
/* If timer is ripe, run it if it hasn't been run. */
- if (EMACS_TIME_NEG_P (difference)
- || (EMACS_SECS (difference) == 0
- && EMACS_USECS (difference) == 0))
+ if (ripe)
{
- if (NILP (vector[0]))
+ if (NILP (AREF (chosen_timer, 0)))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object old_deactivate_mark = Vdeactivate_mark;
/* Mark the timer as triggered to prevent problems if the lisp
code fails to reschedule it right. */
- vector[0] = Qt;
+ ASET (chosen_timer, 0, Qt);
specbind (Qinhibit_quit, Qt);
return 0 to indicate that. */
}
- EMACS_SET_SECS (nexttime, 0);
- EMACS_SET_USECS (nexttime, 0);
+ nexttime = make_emacs_time (0, 0);
+ break;
}
else
/* When we encounter a timer that is still waiting,
timer list for the time being.
Returns the time to wait until the next timer fires.
- If no timer is active, return -1.
+ If no timer is active, return an invalid value.
As long as any timer is ripe, we run it. */
timer_check (void)
{
EMACS_TIME nexttime;
+ Lisp_Object timers, idle_timers;
+ struct gcpro gcpro1, gcpro2;
+
+ Lisp_Object tem = Vinhibit_quit;
+ Vinhibit_quit = Qt;
+
+ /* We use copies of the timers' lists to allow a timer to add itself
+ again, without locking up Emacs if the newly added timer is
+ already ripe when added. */
+
+ /* Always consider the ordinary timers. */
+ timers = Fcopy_sequence (Vtimer_list);
+ /* Consider the idle timers only if Emacs is idle. */
+ if (EMACS_TIME_VALID_P (timer_idleness_start_time))
+ idle_timers = Fcopy_sequence (Vtimer_idle_list);
+ else
+ idle_timers = Qnil;
+
+ Vinhibit_quit = tem;
+
+ GCPRO2 (timers, idle_timers);
do
{
- nexttime = timer_check_2 ();
+ nexttime = timer_check_2 (timers, idle_timers);
}
- while (EMACS_SECS (nexttime) == 0 && EMACS_USECS (nexttime) == 0);
+ while (EMACS_SECS (nexttime) == 0 && EMACS_NSECS (nexttime) == 0);
+ UNGCPRO;
return nexttime;
}
DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
doc: /* Return the current length of Emacs idleness, or nil.
-The value when Emacs is idle is a list of three integers. The first has
-the most significant 16 bits of the seconds, while the second has the least
-significant 16 bits. The third integer gives the microsecond count.
+The value when Emacs is idle is a list of four integers (HIGH LOW USEC PSEC)
+in the same style as (current-time).
The value when Emacs is not idle is nil.
-The microsecond count is zero on systems that do not provide
-resolution finer than a second. */)
+PSEC is a multiple of the system clock resolution. */)
(void)
{
- if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
- {
- EMACS_TIME now, idleness_now;
-
- EMACS_GET_TIME (now);
- EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
-
- return list3 (make_number ((EMACS_SECS (idleness_now) >> 16) & 0xffff),
- make_number ((EMACS_SECS (idleness_now) >> 0) & 0xffff),
- make_number (EMACS_USECS (idleness_now)));
- }
+ if (EMACS_TIME_VALID_P (timer_idleness_start_time))
+ return make_lisp_time (sub_emacs_time (current_emacs_time (),
+ timer_idleness_start_time));
return Qnil;
}
/* It's a click in window WINDOW at frame coordinates (X,Y) */
struct window *w = XWINDOW (window);
Lisp_Object string_info = Qnil;
- EMACS_INT textpos = -1;
+ ptrdiff_t textpos = -1;
int col = -1, row = -1;
int dx = -1, dy = -1;
int width = -1, height = -1;
else if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
{
Lisp_Object string;
- EMACS_INT charpos;
+ ptrdiff_t charpos;
posn = (part == ON_MODE_LINE) ? Qmode_line : Qheader_line;
/* Note that mode_line_string takes COL, ROW as pixels and
else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
{
Lisp_Object string;
- EMACS_INT charpos;
+ ptrdiff_t charpos;
posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
col = wx;
{
int i;
- switch (SWITCH_ENUM_CAST (event->kind))
+ switch (event->kind)
{
/* A simple keystroke. */
case ASCII_KEYSTROKE_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_system_key_syms (current_kboard, Fcons (Qnil, Qnil));
return modify_event_symbol (event->code,
event->modifiers,
Qfunction_key,
KVAR (current_kboard, Vsystem_key_alist),
0, &KVAR (current_kboard, system_key_syms),
- TYPE_MAXIMUM (EMACS_INT));
+ PTRDIFF_MAX);
}
return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
if (button >= ASIZE (button_down_location))
{
+ ptrdiff_t incr = button - ASIZE (button_down_location) + 1;
button_down_location = larger_vector (button_down_location,
- button + 1, Qnil);
- mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
+ incr, -1);
+ 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;
else if (FRAMEP (event->frame_or_window))
f = XFRAME (event->frame_or_window);
else
- abort ();
+ emacs_abort ();
if (FRAME_WINDOW_P (f))
fuzz = double_click_fuzz;
else
/* Every mouse event should either have the down_modifier or
the up_modifier set. */
- abort ();
+ emacs_abort ();
{
/* Get the symbol we should use for the mouse click. */
else if (FRAMEP (event->frame_or_window))
fr = XFRAME (event->frame_or_window);
else
- abort ();
+ emacs_abort ();
fuzz = FRAME_WINDOW_P (fr)
? double_click_fuzz : double_click_fuzz / 8;
else
/* Every wheel event should either have the down_modifier or
the up_modifier set. */
- abort ();
+ emacs_abort ();
if (event->kind == HORIZ_WHEEL_EVENT)
symbol_num += 2;
event->modifiers &= ~up_modifier;
if (event->code >= ASIZE (mouse_syms))
- mouse_syms = larger_vector (mouse_syms, event->code + 1, Qnil);
+ mouse_syms = larger_vector (mouse_syms,
+ event->code - ASIZE (mouse_syms) + 1,
+ -1);
/* Get the symbol we should use for the mouse click. */
head = modify_event_symbol (event->code,
{
char *name = find_user_signal_name (event->code);
if (!name)
- abort ();
+ emacs_abort ();
return intern (name);
}
if (button >= ASIZE (button_down_location))
{
+ ptrdiff_t incr = button - ASIZE (button_down_location) + 1;
button_down_location = larger_vector (button_down_location,
- button + 1, Qnil);
- mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
+ incr, -1);
+ 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,
/* The 'kind' field of the event is something we don't recognize. */
default:
- abort ();
+ emacs_abort ();
}
}
This doesn't use any caches. */
static int
-parse_modifiers_uncached (Lisp_Object symbol, EMACS_INT *modifier_end)
+parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end)
{
Lisp_Object name;
- EMACS_INT i;
+ ptrdiff_t i;
int modifiers;
CHECK_SYMBOL (symbol);
modifiers = 0;
name = SYMBOL_NAME (symbol);
- for (i = 0; i+2 <= SBYTES (name); )
+ for (i = 0; i < SBYTES (name) - 1; )
{
- EMACS_INT this_mod_end = 0;
+ ptrdiff_t this_mod_end = 0;
int this_mod = 0;
/* See if the name continues with a modifier word.
#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
if (i + LEN + 1 <= SBYTES (name) \
- && ! strncmp (SSDATA (name) + i, NAME, LEN)) \
+ && ! memcmp (SDATA (name) + i, NAME, LEN)) \
{ \
this_mod_end = i + LEN; \
this_mod = BIT; \
if (! (modifiers & (down_modifier | drag_modifier
| double_modifier | triple_modifier))
&& i + 7 == SBYTES (name)
- && strncmp (SSDATA (name) + i, "mouse-", 6) == 0
+ && memcmp (SDATA (name) + i, "mouse-", 6) == 0
&& ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
modifiers |= click_modifier;
if (! (modifiers & (double_modifier | triple_modifier))
&& i + 6 < SBYTES (name)
- && strncmp (SSDATA (name) + i, "wheel-", 6) == 0)
+ && memcmp (SDATA (name) + i, "wheel-", 6) == 0)
modifiers |= click_modifier;
if (modifier_end)
/* Since BASE could contain nulls, we can't use intern here; we have
to use Fintern, which expects a genuine Lisp_String, and keeps a
reference to it. */
- char *new_mods
- = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
+ char new_mods[sizeof "A-C-H-M-S-s-down-drag-double-triple-"];
int mod_len;
{
/* Only the event queue may use the `up' modifier; it should always
be turned into a click or drag event before presented to lisp code. */
if (modifiers & up_modifier)
- abort ();
+ emacs_abort ();
if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
modifier_list = Qnil;
for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
if (modifiers & (1<<i))
- modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
+ modifier_list = Fcons (AREF (modifier_symbols, i),
modifier_list);
return modifier_list;
return elements;
else
{
- EMACS_INT end;
+ ptrdiff_t end;
int modifiers = parse_modifiers_uncached (symbol, &end);
Lisp_Object unmodified;
Lisp_Object mask;
Qnil);
if (modifiers & ~INTMASK)
- abort ();
+ emacs_abort ();
XSETFASTINT (mask, modifiers);
elements = Fcons (unmodified, Fcons (mask, Qnil));
in the symbol's name. */
static Lisp_Object
-modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object symbol_kind,
+modify_event_symbol (ptrdiff_t symbol_num, int modifiers, Lisp_Object symbol_kind,
Lisp_Object name_alist_or_stem, const char *const *name_table,
- Lisp_Object *symbol_table, EMACS_INT table_size)
+ Lisp_Object *symbol_table, ptrdiff_t table_size)
{
Lisp_Object value;
Lisp_Object symbol_int;
*symbol_table = Fmake_vector (size, Qnil);
}
- value = XVECTOR (*symbol_table)->contents[symbol_num];
+ value = AREF (*symbol_table, symbol_num);
}
/* Have we already used this symbol before? */
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);
if (NILP (value))
{
char buf[sizeof "key-" + INT_STRLEN_BOUND (EMACS_INT)];
- sprintf (buf, "key-%"pI"d", symbol_num);
+ sprintf (buf, "key-%"pD"d", symbol_num);
value = intern (buf);
}
if (CONSP (*symbol_table))
*symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
else
- XVECTOR (*symbol_table)->contents[symbol_num] = value;
+ ASET (*symbol_table, symbol_num, value);
/* Fill in the cache entries for this symbol; this also
builds the Qevent_symbol_elements property, which the user
#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
if (LEN == SBYTES (name) \
- && ! strncmp (SSDATA (name), NAME, LEN)) \
+ && ! memcmp (SDATA (name), NAME, LEN)) \
return BIT;
case 'A':
return;
/* Try to read some input and see how much we get. */
- gobble_input (0);
+ gobble_input ();
*addr = (!NILP (Vquit_flag) || readable_events (flags));
}
-/* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
-
-void
-gobble_input (int expected)
-{
-#ifdef SIGIO
- if (interrupt_input)
- {
- SIGMASKTYPE mask;
- mask = sigblock (sigmask (SIGIO));
- read_avail_input (expected);
- sigsetmask (mask);
- }
- else
-#ifdef POLL_FOR_INPUT
- /* XXX This condition was (read_socket_hook && !interrupt_input),
- but read_socket_hook is not global anymore. Let's pretend that
- it's always set. */
- if (!interrupt_input && poll_suppress_count == 0)
- {
- SIGMASKTYPE mask;
- mask = sigblock (sigmask (SIGALRM));
- read_avail_input (expected);
- sigsetmask (mask);
- }
- else
-#endif
-#endif
- read_avail_input (expected);
-}
-
/* Put a BUFFER_SWITCH_EVENT in the buffer
so that read_key_sequence will notice the new current buffer. */
return;
/* Make sure no interrupt happens while storing the event. */
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
if (interrupt_input)
- {
- SIGMASKTYPE mask;
- mask = sigblock (sigmask (SIGIO));
- kbd_buffer_store_event (&event);
- sigsetmask (mask);
- }
+ kbd_buffer_store_event (&event);
else
#endif
{
/* Read any terminal input already buffered up by the system
into the kbd_buffer, but do not wait.
- EXPECTED should be nonzero if the caller knows there is some input.
-
- Returns the number of keyboard chars read, or -1 meaning
+ Return the number of keyboard chars read, or -1 meaning
this is a bad time to try to read input. */
-static int
-read_avail_input (int expected)
+int
+gobble_input (void)
{
int nread = 0;
int err = 0;
struct terminal *t;
/* Store pending user signal events, if any. */
- if (store_user_signal_events ())
- expected = 0;
+ store_user_signal_events ();
/* Loop through the available terminals, and call their input hooks. */
t = terminal_list;
int nr;
struct input_event hold_quit;
+ if (input_blocked_p ())
+ {
+ pending_signals = 1;
+ break;
+ }
+
EVENT_INIT (hold_quit);
hold_quit.kind = NO_EVENT;
/* No need for FIONREAD or fcntl; just say don't wait. */
- while (nr = (*t->read_socket_hook) (t, expected, &hold_quit), nr > 0)
- {
- nread += nr;
- expected = 0;
- }
+ while (0 < (nr = (*t->read_socket_hook) (t, &hold_quit)))
+ nread += nr;
if (nr == -1) /* Not OK to read input now. */
{
this process rather than to the whole process
group? Perhaps on systems with FIONREAD Emacs is
alone in its group. */
- kill (getpid (), SIGHUP);
+ terminate_due_to_signal (SIGHUP, 10);
/* XXX Is calling delete_terminal safe here? It calls delete_frame. */
{
int
tty_read_avail_input (struct terminal *terminal,
- int expected,
struct input_event *hold_quit)
{
/* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
if (terminal->type != output_termcap
&& terminal->type != output_msdos_raw)
- abort ();
+ emacs_abort ();
/* XXX I think the following code should be moved to separate hook
functions in system-dependent files. */
#endif /* HAVE_GPM */
/* Determine how many characters we should *try* to read. */
-#ifdef FIONREAD
+#ifdef USABLE_FIONREAD
/* Find out how much input is available. */
if (ioctl (fileno (tty->input), FIONREAD, &n_to_read) < 0)
{
return 0;
if (n_to_read > sizeof cbuf)
n_to_read = sizeof cbuf;
-#else /* no FIONREAD */
-#if defined (USG) || defined (CYGWIN)
+#elif defined USG || defined CYGWIN
/* Read some input if available, but don't wait. */
n_to_read = sizeof cbuf;
fcntl (fileno (tty->input), F_SETFL, O_NDELAY);
#else
- you lose;
-#endif
+# error "Cannot read without possibly delaying"
#endif
#ifdef subprocesses
#endif
);
-#ifndef FIONREAD
+#ifndef USABLE_FIONREAD
#if defined (USG) || defined (CYGWIN)
fcntl (fileno (tty->input), F_SETFL, 0);
#endif /* USG or CYGWIN */
static void
handle_async_input (void)
{
- interrupt_input_pending = 0;
-#ifdef SYNC_INPUT
- pending_signals = pending_atimers;
-#endif
-/* Tell ns_read_socket() it is being called asynchronously so it can avoid
- doing anything dangerous. */
-#ifdef HAVE_NS
- ++handling_signal;
-#endif
+#ifdef USABLE_SIGIO
while (1)
{
- int nread;
- nread = read_avail_input (1);
+ int nread = gobble_input ();
/* -1 means it's not ok to read the input now.
UNBLOCK_INPUT will read it later; now, avoid infinite loop.
0 means there was no keyboard input available. */
if (nread <= 0)
break;
}
-#ifdef HAVE_NS
- --handling_signal;
#endif
}
void
process_pending_signals (void)
{
- if (interrupt_input_pending)
- handle_async_input ();
+ pending_signals = 0;
+ handle_async_input ();
do_pending_atimers ();
}
-#ifdef SIGIO /* for entire page */
-/* Note SIGIO has been undef'd if FIONREAD is missing. */
+/* Undo any number of BLOCK_INPUT calls down to level LEVEL,
+ and also (if the level is now 0) reinvoke any pending signal. */
-static void
-input_available_signal (int signo)
+void
+unblock_input_to (int level)
{
- /* Must preserve main program's value of errno. */
- int old_errno = errno;
- SIGNAL_THREAD_CHECK (signo);
+ interrupt_input_blocked = level;
+ if (level == 0)
+ {
+ if (pending_signals)
+ process_pending_signals ();
+ }
+ else if (level < 0)
+ emacs_abort ();
+}
-#ifdef SYNC_INPUT
- interrupt_input_pending = 1;
- pending_signals = 1;
-#endif
+/* End critical section.
- if (input_available_clear_time)
- EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
+ If doing signal-driven input, and a signal came in when input was
+ blocked, reinvoke the signal handler now to deal with it. */
-#ifndef SYNC_INPUT
- handle_async_input ();
-#endif
+void
+unblock_input (void)
+{
+ unblock_input_to (interrupt_input_blocked - 1);
+}
+
+/* Undo any number of BLOCK_INPUT calls,
+ and also reinvoke any pending signal. */
- errno = old_errno;
+void
+totally_unblock_input (void)
+{
+ unblock_input_to (0);
}
-#endif /* SIGIO */
-/* Send ourselves a SIGIO.
+#ifdef USABLE_SIGIO
- This function exists so that the UNBLOCK_INPUT macro in
- blockinput.h can have some way to take care of input we put off
- dealing with, without assuming that every file which uses
- UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
void
-reinvoke_input_signal (void)
+handle_input_available_signal (int sig)
{
-#ifdef SIGIO
- handle_async_input ();
-#endif
+ pending_signals = 1;
+
+ if (input_available_clear_time)
+ *input_available_clear_time = make_emacs_time (0, 0);
}
+static void
+deliver_input_available_signal (int sig)
+{
+ deliver_process_signal (sig, handle_input_available_signal);
+}
+#endif /* USABLE_SIGIO */
\f
/* User signal events. */
void
add_user_signal (int sig, const char *name)
{
+ struct sigaction action;
struct user_signal_info *p;
for (p = user_signals; p; p = p->next)
/* Already added. */
return;
- p = xmalloc (sizeof (struct user_signal_info));
+ p = xmalloc (sizeof *p);
p->sig = sig;
p->name = xstrdup (name);
p->npending = 0;
p->next = user_signals;
user_signals = p;
- signal (sig, handle_user_signal);
+ emacs_sigaction_init (&action, deliver_user_signal);
+ sigaction (sig, &action, 0);
}
static void
handle_user_signal (int sig)
{
- int old_errno = errno;
struct user_signal_info *p;
const char *special_event_name = NULL;
- SIGNAL_THREAD_CHECK (sig);
-
if (SYMBOLP (Vdebug_on_event))
special_event_name = SSDATA (SYMBOL_NAME (Vdebug_on_event));
for (p = user_signals; p; p = p->next)
if (p->sig == sig)
{
- if (special_event_name &&
- strcmp (special_event_name, p->name) == 0)
+ if (special_event_name
+ && strcmp (special_event_name, p->name) == 0)
{
/* Enter the debugger in many ways. */
debug_on_next_call = 1;
}
p->npending++;
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
if (interrupt_input)
- kill (getpid (), SIGIO);
+ handle_input_available_signal (sig);
else
#endif
{
/* Tell wait_reading_process_output that it needs to wake
up and look around. */
if (input_available_clear_time)
- EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
+ *input_available_clear_time = make_emacs_time (0, 0);
}
break;
}
+}
- errno = old_errno;
+static void
+deliver_user_signal (int sig)
+{
+ deliver_process_signal (sig, handle_user_signal);
}
static char *
return NULL;
}
-static int
+static void
store_user_signal_events (void)
{
struct user_signal_info *p;
struct input_event buf;
- int nstored = 0;
+ bool buf_initialized = 0;
for (p = user_signals; p; p = p->next)
if (p->npending > 0)
{
- SIGMASKTYPE mask;
-
- if (nstored == 0)
+ if (! buf_initialized)
{
memset (&buf, 0, sizeof buf);
buf.kind = USER_SIGNAL_EVENT;
buf.frame_or_window = selected_frame;
+ buf_initialized = 1;
}
- nstored += p->npending;
- mask = sigblock (sigmask (p->sig));
do
{
buf.code = p->sig;
p->npending--;
}
while (p->npending > 0);
- sigsetmask (mask);
}
-
- return nstored;
}
\f
if (!label)
return 0;
else if (strlen (label) > 3
- && strncmp (label, "--", 2) == 0
+ && memcmp (label, "--", 2) == 0
&& label[2] != '-')
{
int i;
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);
Lisp_Object tem;
ptrdiff_t nminor;
nminor = current_minor_maps (NULL, &tmaps);
- maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
+ maps = alloca ((nminor + 3) * sizeof *maps);
nmaps = 0;
if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
maps[nmaps++] = tem;
int end = menu_bar_items_index;
for (i = 0; i < end; i += 4)
- if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
+ if (EQ (XCAR (tail), AREF (menu_bar_items_vector, i)))
{
Lisp_Object tem0, tem1, tem2, tem3;
/* Move the item at index I to the end,
shifting all the others forward. */
- tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
- tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
- tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
- tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
+ tem0 = AREF (menu_bar_items_vector, i + 0);
+ tem1 = AREF (menu_bar_items_vector, i + 1);
+ tem2 = AREF (menu_bar_items_vector, i + 2);
+ tem3 = AREF (menu_bar_items_vector, i + 3);
if (end > i + 4)
- memmove (&XVECTOR (menu_bar_items_vector)->contents[i],
- &XVECTOR (menu_bar_items_vector)->contents[i + 4],
- (end - i - 4) * sizeof (Lisp_Object));
- XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
- XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
- XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
- XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
+ 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);
+ ASET (menu_bar_items_vector, end - 1, tem3);
break;
}
}
int i = menu_bar_items_index;
if (i + 4 > ASIZE (menu_bar_items_vector))
menu_bar_items_vector =
- larger_vector (menu_bar_items_vector, 2 * i, Qnil);
+ larger_vector (menu_bar_items_vector, 4, -1);
/* Add this item. */
- XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
- XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
- XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
- XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
+ ASET (menu_bar_items_vector, i, Qnil); i++;
+ ASET (menu_bar_items_vector, i, Qnil); i++;
+ ASET (menu_bar_items_vector, i, Qnil); i++;
+ ASET (menu_bar_items_vector, i, Qnil); i++;
menu_bar_items_index = i;
}
discard any previously made menu bar item. */
for (i = 0; i < menu_bar_items_index; i += 4)
- if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
+ if (EQ (key, AREF (menu_bar_items_vector, i)))
{
if (menu_bar_items_index > i + 4)
- memmove (&XVECTOR (menu_bar_items_vector)->contents[i],
- &XVECTOR (menu_bar_items_vector)->contents[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;
}
}
if (!i)
return;
- item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
+ item = AREF (item_properties, ITEM_PROPERTY_DEF);
/* Find any existing item for this KEY. */
for (i = 0; i < menu_bar_items_index; i += 4)
- if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
+ if (EQ (key, AREF (menu_bar_items_vector, i)))
break;
/* If we did not find this KEY, add it at the end. */
{
/* If vector is too small, get a bigger one. */
if (i + 4 > ASIZE (menu_bar_items_vector))
- menu_bar_items_vector = larger_vector (menu_bar_items_vector, 2 * i, Qnil);
+ menu_bar_items_vector = larger_vector (menu_bar_items_vector, 4, -1);
/* Add this item. */
- XVECTOR (menu_bar_items_vector)->contents[i++] = key;
- XVECTOR (menu_bar_items_vector)->contents[i++]
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
- XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
- XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
+ ASET (menu_bar_items_vector, i, key); i++;
+ ASET (menu_bar_items_vector, i,
+ AREF (item_properties, ITEM_PROPERTY_NAME)); i++;
+ ASET (menu_bar_items_vector, i, Fcons (item, Qnil)); i++;
+ ASET (menu_bar_items_vector, i, make_number (0)); i++;
menu_bar_items_index = i;
}
/* We did find an item for this KEY. Add ITEM to its list of maps. */
else
{
Lisp_Object old;
- old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
+ old = AREF (menu_bar_items_vector, i + 2);
/* If the new and the old items are not both keymaps,
the lookup will only find `item'. */
item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
- XVECTOR (menu_bar_items_vector)->contents[i + 2] = item;
+ ASET (menu_bar_items_vector, i + 2, item);
}
}
\f
Lisp_Object
menu_item_eval_property (Lisp_Object sexpr)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
specbind (Qinhibit_redisplay, Qt);
val = internal_condition_case_1 (eval_dyn, sexpr, Qerror,
/* If the command is an alias for another
(such as lmenu.el set it up), check if the
original command matches the cached command. */
- && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
+ && !(SYMBOLP (def)
+ && EQ (tem, XSYMBOL (def)->function))))
keys = Qnil;
}
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);
nmaps = 0;
if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
Lisp_Object tem;
ptrdiff_t nminor;
nminor = current_minor_maps (NULL, &tmaps);
- maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
+ maps = alloca ((nminor + 3) * sizeof *maps);
nmaps = 0;
if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
maps[nmaps++] = tem;
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;
}
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
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) XVECTOR (tool_bar_item_properties)->contents[IDX]
-
Lisp_Object filter = Qnil;
Lisp_Object caption;
int i, have_label = 0;
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
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. */
{
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. */
}
/* 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. */
{
/* `: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))
{
}
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))
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)
|| (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);
}
const char *capt = STRINGP (tcapt) ? SSDATA (tcapt) : "";
ptrdiff_t max_lbl =
2 * max (0, min (tool_bar_max_label_size, STRING_BYTES_BOUND / 2));
- char *buf = (char *) xmalloc (max_lbl + 1);
+ char *buf = xmalloc (max_lbl + 1);
Lisp_Object new_lbl;
ptrdiff_t caption_len = strlen (capt);
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) = make_string ("", 0);
+ 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)))
/* 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;
static void
append_tool_bar_item (void)
{
- Lisp_Object *to, *from;
+ ptrdiff_t incr =
+ (ntool_bar_items
+ - (ASIZE (tool_bar_items_vector) - TOOL_BAR_ITEM_NSLOTS));
/* Enlarge tool_bar_items_vector if necessary. */
- if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
- >= ASIZE (tool_bar_items_vector))
+ if (0 < incr)
tool_bar_items_vector
- = larger_vector (tool_bar_items_vector,
- 2 * ASIZE (tool_bar_items_vector), Qnil);
+ = larger_vector (tool_bar_items_vector, incr, -1);
/* Append entries from tool_bar_item_properties to the end of
tool_bar_items_vector. */
- to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
- from = XVECTOR (tool_bar_item_properties)->contents;
- memcpy (to, from, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
+ vcopy (tool_bar_items_vector, ntool_bar_items,
+ XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS);
ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
}
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;
&& !EQ (XCAR (prev_event), Qtool_bar))
{
/* Display the menu and get the selection. */
- Lisp_Object *realmaps
- = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
+ Lisp_Object *realmaps = alloca (nmaps * sizeof *realmaps);
Lisp_Object value;
ptrdiff_t nmaps1 = 0;
if (width + 4 > read_char_minibuf_menu_width)
{
read_char_minibuf_menu_text
- = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
+ = xrealloc (read_char_minibuf_menu_text, width + 4);
read_char_minibuf_menu_width = width + 4;
}
menu = read_char_minibuf_menu_text;
/* Look at the next element of the map. */
if (idx >= 0)
- elt = XVECTOR (vector)->contents[idx];
+ elt = AREF (vector, idx);
else
elt = Fcar_safe (rest);
Lisp_Object upcased_event, downcased_event;
Lisp_Object desc = Qnil;
Lisp_Object s
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+ = AREF (item_properties, ITEM_PROPERTY_NAME);
upcased_event = Fupcase (event);
downcased_event = Fdowncase (event);
s = concat2 (s, tem);
#endif
tem
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
+ = AREF (item_properties, ITEM_PROPERTY_TYPE);
if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
{
/* Insert button prefix. */
Lisp_Object selected
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
+ = AREF (item_properties, ITEM_PROPERTY_SELECTED);
if (EQ (tem, QCradio))
tem = build_string (NILP (selected) ? "(*) " : "( ) ");
else
is not used on replay.
*/
orig_defn_macro = KVAR (current_kboard, defining_kbd_macro);
- KVAR (current_kboard, defining_kbd_macro) = Qnil;
+ kset_defining_kbd_macro (current_kboard, Qnil);
do
obj = read_char (commandflag, 0, 0, Qt, 0, NULL);
while (BUFFERP (obj));
- KVAR (current_kboard, defining_kbd_macro) = orig_defn_macro;
+ kset_defining_kbd_macro (current_kboard, orig_defn_macro);
if (!INTEGERP (obj))
return obj;
next = access_keymap (map, key, 1, 0, 1);
- /* Handle symbol with autoload definition. */
- if (SYMBOLP (next) && !NILP (Ffboundp (next))
- && CONSP (XSYMBOL (next)->function)
- && EQ (XCAR (XSYMBOL (next)->function), Qautoload))
- do_autoload (XSYMBOL (next)->function, next);
-
/* Handle a symbol whose function definition is a keymap
or an array. */
if (SYMBOLP (next) && !NILP (Ffboundp (next))
&& (ARRAYP (XSYMBOL (next)->function)
|| KEYMAPP (XSYMBOL (next)->function)))
- next = 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;
int fix_current_buffer)
{
Lisp_Object from_string;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* How many keys there are in the current key sequence. */
int t;
/* The length of the echo buffer when we started reading, and
the length of this_command_keys when we started reading. */
- int echo_start IF_LINT (= 0);
- int keys_start;
+ ptrdiff_t echo_start IF_LINT (= 0);
+ ptrdiff_t keys_start;
/* The number of keymaps we're scanning right now, and the number of
keymaps we have allocated space for. */
/* 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_echo_string (current_kboard, prompt);
current_kboard->echo_after_prompt = SCHARS (prompt);
echo_now ();
}
{
if (2 > nmaps_allocated)
{
- submaps = (Lisp_Object *) alloca (2 * sizeof (submaps[0]));
- defs = (Lisp_Object *) alloca (2 * sizeof (defs[0]));
+ submaps = alloca (2 * sizeof *submaps);
+ defs = alloca (2 * sizeof *defs);
nmaps_allocated = 2;
}
submaps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
{
if (2 > nmaps_allocated)
{
- submaps = (Lisp_Object *) alloca (2 * sizeof (submaps[0]));
- defs = (Lisp_Object *) alloca (2 * sizeof (defs[0]));
+ submaps = alloca (2 * sizeof *submaps);
+ defs = alloca (2 * sizeof *defs);
nmaps_allocated = 2;
}
submaps[nmaps++] = Voverriding_local_map;
if (total > nmaps_allocated)
{
- submaps = (Lisp_Object *) alloca (total * sizeof (submaps[0]));
- defs = (Lisp_Object *) alloca (total * sizeof (defs[0]));
+ submaps = alloca (total * sizeof *submaps);
+ defs = alloca (total * sizeof *defs);
nmaps_allocated = total;
}
while those allow us to restart the entire key sequence,
echo_local_start and keys_local_start allow us to throw away
just one key. */
- int echo_local_start IF_LINT (= 0);
+ ptrdiff_t echo_local_start IF_LINT (= 0);
int keys_local_start;
ptrdiff_t local_first_binding;
if (!NILP (delayed_switch_frame))
{
- KVAR (interrupted_kboard, kbd_queue)
- = Fcons (delayed_switch_frame,
- KVAR (interrupted_kboard, kbd_queue));
+ kset_kbd_queue
+ (interrupted_kboard,
+ 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_kbd_queue
+ (interrupted_kboard,
+ 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. */
{
Lisp_Object frame;
XSETFRAME (frame, interrupted_frame);
- KVAR (interrupted_kboard, kbd_queue)
- = Fcons (make_lispy_switch_frame (frame),
- KVAR (interrupted_kboard, kbd_queue));
+ kset_kbd_queue
+ (interrupted_kboard,
+ 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);
&& current_buffer != starting_buffer)
{
GROW_RAW_KEYBUF;
- XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
+ ASET (raw_keybuf, raw_keybuf_count, key);
+ raw_keybuf_count++;
keybuf[t++] = key;
mock_input = t;
Vquit_flag = Qnil;
&& BUFFERP (XWINDOW (window)->buffer)
&& XBUFFER (XWINDOW (window)->buffer) != current_buffer)
{
- XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
+ ASET (raw_keybuf, raw_keybuf_count, key);
+ raw_keybuf_count++;
keybuf[t] = key;
mock_input = t + 1;
because we may get input from a subprocess which
wants to change the selected window and stuff (say,
emacsclient). */
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
Fkill_emacs (Qnil);
Lisp_Object keybuf[30];
register int i;
struct gcpro gcpro1;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (!NILP (prompt))
CHECK_STRING (prompt);
Lisp_Object keybuf[30];
register int i;
struct gcpro gcpro1;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (!NILP (prompt))
CHECK_STRING (prompt);
memset (keybuf, 0, sizeof keybuf);
GCPRO1 (keybuf[0]);
- gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
+ gcpro1.nvars = (sizeof keybuf / sizeof (keybuf[0]));
if (NILP (continue_echo))
{
cancel_hourglass ();
#endif
- i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
+ i = read_key_sequence (keybuf, (sizeof keybuf / sizeof (keybuf[0])),
prompt, ! NILP (dont_downcase_last),
! NILP (can_return_switch_frame), 0);
{
prefixarg = KVAR (current_kboard, Vprefix_arg);
Vcurrent_prefix_arg = prefixarg;
- KVAR (current_kboard, Vprefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
}
else
prefixarg = Qnil;
struct gcpro gcpro1, gcpro2;
GCPRO2 (cmd, prefixarg);
- do_autoload (final, cmd);
+ Fautoload_do_load (final, cmd, Qnil);
UNGCPRO;
}
else
}
-\f
-DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
- 1, 1, "P",
- doc: /* Read function name, then read its arguments and call it.
-
-To pass a numeric argument to the command you are invoking with, specify
-the numeric argument to this command.
-
-Noninteractively, the argument PREFIXARG is the prefix argument to
-give to the command you invoke, if it asks for an argument. */)
- (Lisp_Object prefixarg)
-{
- Lisp_Object function;
- EMACS_INT saved_last_point_position;
- Lisp_Object saved_keys, saved_last_point_position_buffer;
- Lisp_Object bindings, value;
- struct gcpro gcpro1, gcpro2, gcpro3;
-#ifdef HAVE_WINDOW_SYSTEM
- /* The call to Fcompleting_read will start and cancel the hourglass,
- but if the hourglass was already scheduled, this means that no
- hourglass will be shown for the actual M-x command itself.
- So we restart it if it is already scheduled. Note that checking
- hourglass_shown_p is not enough, normally the hourglass is not shown,
- just scheduled to be shown. */
- int hstarted = hourglass_started ();
-#endif
-
- saved_keys = Fvector (this_command_key_count,
- XVECTOR (this_command_keys)->contents);
- saved_last_point_position_buffer = last_point_position_buffer;
- saved_last_point_position = last_point_position;
- GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
-
- function = call0 (intern ("read-extended-command"));
-
-#ifdef HAVE_WINDOW_SYSTEM
- if (hstarted) start_hourglass ();
-#endif
-
- if (STRINGP (function) && SCHARS (function) == 0)
- error ("No command name given");
-
- /* Set this_command_keys to the concatenation of saved_keys and
- function, followed by a RET. */
- {
- Lisp_Object *keys;
- int i;
-
- this_command_key_count = 0;
- this_command_key_count_reset = 0;
- this_single_command_key_start = 0;
-
- keys = XVECTOR (saved_keys)->contents;
- for (i = 0; i < ASIZE (saved_keys); i++)
- add_command_key (keys[i]);
-
- for (i = 0; i < SCHARS (function); i++)
- add_command_key (Faref (function, make_number (i)));
-
- add_command_key (make_number ('\015'));
- }
-
- last_point_position = saved_last_point_position;
- last_point_position_buffer = saved_last_point_position_buffer;
-
- UNGCPRO;
-
- function = Fintern (function, Qnil);
- KVAR (current_kboard, Vprefix_arg) = prefixarg;
- Vthis_command = function;
- real_this_command = function;
-
- /* If enabled, show which key runs this command. */
- if (!NILP (Vsuggest_key_bindings)
- && NILP (Vexecuting_kbd_macro)
- && SYMBOLP (function))
- bindings = Fwhere_is_internal (function, Voverriding_local_map,
- Qt, Qnil, Qnil);
- else
- bindings = Qnil;
-
- value = Qnil;
- GCPRO3 (bindings, value, function);
- value = Fcommand_execute (function, Qt, Qnil, Qnil);
-
- /* If the command has a key binding, print it now. */
- if (!NILP (bindings)
- && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
- Qmouse_movement)))
- {
- /* But first wait, and skip the message if there is input. */
- Lisp_Object waited;
-
- /* If this command displayed something in the echo area;
- wait a few seconds, then display our suggestion message. */
- if (NILP (echo_area_buffer[0]))
- waited = sit_for (make_number (0), 0, 2);
- else if (NUMBERP (Vsuggest_key_bindings))
- waited = sit_for (Vsuggest_key_bindings, 0, 2);
- else
- waited = sit_for (make_number (2), 0, 2);
-
- if (!NILP (waited) && ! CONSP (Vunread_command_events))
- {
- Lisp_Object binding;
- char *newmessage;
- int message_p = push_message ();
- int count = SPECPDL_INDEX ();
- ptrdiff_t newmessage_len, newmessage_alloc;
- USE_SAFE_ALLOCA;
-
- record_unwind_protect (pop_message_unwind, Qnil);
- binding = Fkey_description (bindings, Qnil);
- newmessage_alloc =
- (sizeof "You can run the command `' with "
- + SBYTES (SYMBOL_NAME (function)) + SBYTES (binding));
- SAFE_ALLOCA (newmessage, char *, newmessage_alloc);
- newmessage_len =
- esprintf (newmessage, "You can run the command `%s' with %s",
- SDATA (SYMBOL_NAME (function)),
- SDATA (binding));
- message2 (newmessage,
- newmessage_len,
- STRING_MULTIBYTE (binding));
- if (NUMBERP (Vsuggest_key_bindings))
- waited = sit_for (Vsuggest_key_bindings, 0, 2);
- else
- waited = sit_for (make_number (2), 0, 2);
-
- if (!NILP (waited) && message_p)
- restore_message ();
-
- SAFE_FREE ();
- unbind_to (count, Qnil);
- }
- }
-
- RETURN_UNGCPRO (value);
-}
-
\f
/* Return nonzero if input events are pending. */
int
requeued_events_pending_p (void)
{
- return (!NILP (Vunread_command_events) || unread_command_char != -1);
+ return (!NILP (Vunread_command_events));
}
if there is a doubt, the value is t. */)
(void)
{
- if (!NILP (Vunread_command_events) || unread_command_char != -1
+ if (!NILP (Vunread_command_events)
|| !NILP (Vunread_post_input_method_events)
|| !NILP (Vunread_input_method_events))
return (Qt);
else
{
val = Fvector (NUM_RECENT_KEYS, keys);
- memcpy (XVECTOR (val)->contents, keys + recent_keys_index,
- (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
- memcpy (XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
- keys, recent_keys_index * sizeof (Lisp_Object));
+ vcopy (val, 0, keys + recent_keys_index,
+ NUM_RECENT_KEYS - recent_keys_index);
+ vcopy (val, NUM_RECENT_KEYS - recent_keys_index,
+ keys, recent_keys_index);
return val;
}
}
if (NILP (keep_record))
{
for (i = 0; i < ASIZE (recent_keys); ++i)
- XVECTOR (recent_keys)->contents[i] = Qnil;
+ ASET (recent_keys, i, Qnil);
total_keys = 0;
recent_keys_index = 0;
}
{
if (dribble)
{
- BLOCK_INPUT;
+ block_input ();
fclose (dribble);
- UNBLOCK_INPUT;
+ unblock_input ();
dribble = 0;
}
if (!NILP (file))
update_mode_lines++;
Vunread_command_events = Qnil;
- unread_command_char = -1;
discard_tty_input ();
On such systems, Emacs starts a subshell instead of suspending. */)
(Lisp_Object stuffstring)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int old_height, old_width;
int width, height;
struct gcpro gcpro1;
if (STRINGP (stuffstring))
{
- register EMACS_INT count;
+ register ptrdiff_t count;
p = SDATA (stuffstring);
count = SBYTES (stuffstring);
}
\f
void
-set_waiting_for_input (struct timeval *time_to_clear)
+set_waiting_for_input (EMACS_TIME *time_to_clear)
{
input_available_clear_time = time_to_clear;
Otherwise, tell QUIT to kill Emacs. */
static void
-interrupt_signal (int signalnum) /* If we don't have an argument, some */
- /* compilers complain in signal calls. */
+handle_interrupt_signal (int sig)
{
- /* Must preserve main program's value of errno. */
- int old_errno = errno;
- struct terminal *terminal;
-
- SIGNAL_THREAD_CHECK (signalnum);
-
/* See if we have an active terminal on our controlling tty. */
- terminal = get_named_tty ("/dev/tty");
+ struct terminal *terminal = get_named_tty ("/dev/tty");
if (!terminal)
{
/* If there are no frames there, let's pretend that we are a
from the controlling tty. */
internal_last_event_frame = terminal->display_info.tty->top_frame;
- handle_interrupt ();
+ handle_interrupt (1);
}
+}
- errno = old_errno;
+static void
+deliver_interrupt_signal (int sig)
+{
+ deliver_process_signal (sig, handle_interrupt_signal);
}
+
+/* If Emacs is stuck because `inhibit-quit' is true, then keep track
+ of the number of times C-g has been requested. If C-g is pressed
+ enough times, then quit anyway. See bug#6585. */
+static int volatile force_quit_count;
+
/* This routine is called at interrupt level in response to C-g.
It is called from the SIGINT handler or kbd_buffer_store_event.
non-nil, it stops the job right away. */
static void
-handle_interrupt (void)
+handle_interrupt (bool in_signal_handler)
{
char c;
/* XXX This code needs to be revised for multi-tty support. */
if (!NILP (Vquit_flag) && get_named_tty ("/dev/tty"))
{
- /* If SIGINT isn't blocked, don't let us be interrupted by
- another SIGINT, it might be harmful due to non-reentrancy
- in I/O functions. */
- sigblock (sigmask (SIGINT));
+ if (! in_signal_handler)
+ {
+ /* If SIGINT isn't blocked, don't let us be interrupted by
+ a SIGINT. It might be harmful due to non-reentrancy
+ in I/O functions. */
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGINT);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
+ }
fflush (stdout);
reset_all_sys_modes ();
#endif /* not MSDOS */
fflush (stdout);
if (((c = getchar ()) & ~040) == 'Y')
- abort ();
+ emacs_abort ();
while (c != '\n') c = getchar ();
#ifdef MSDOS
printf ("\r\nContinuing...\r\n");
#endif /* not MSDOS */
fflush (stdout);
init_all_sys_modes ();
- sigfree ();
}
else
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
immediate_quit = 0;
- sigfree ();
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
saved = gl_state;
GCPRO4 (saved.object, saved.global_code,
saved.current_syntax_table, saved.old_prop);
Fsignal (Qquit, Qnil);
- /* FIXME: AFAIK, `quit' can never return, so this code is dead! */
gl_state = saved;
UNGCPRO;
}
else
- /* Else request quit when it's safe */
- Vquit_flag = Qt;
+ { /* Else request quit when it's safe. */
+ int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
+ force_quit_count = count;
+ if (count == 3)
+ {
+ immediate_quit = 1;
+ Vinhibit_quit = Qnil;
+ }
+ Vquit_flag = Qt;
+ }
}
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
+
/* TODO: The longjmp in this call throws the NS event loop integration off,
and it seems to do fine without this. Probably some attention
needs to be paid to the setting of waiting_for_input in
separate event loop thread like W32. */
#ifndef HAVE_NS
if (waiting_for_input && !echoing)
- quit_throw_to_read_char (1);
+ quit_throw_to_read_char (in_signal_handler);
#endif
}
if (!from_signal && EQ (Vquit_flag, Qkill_emacs))
Fkill_emacs (Qnil);
- sigfree ();
/* Prevent another signal from doing this before we finish. */
clear_waiting_for_input ();
input_pending = 0;
Vunread_command_events = Qnil;
- unread_command_char = -1;
-#if 0 /* Currently, sit_for is called from read_char without turning
- off polling. And that can call set_waiting_for_input.
- It seems to be harmless. */
-#ifdef POLL_FOR_INPUT
- /* May be > 1 if in recursive minibuffer. */
- if (poll_suppress_count == 0)
- abort ();
-#endif
-#endif
if (FRAMEP (internal_last_event_frame)
&& !EQ (internal_last_event_frame, selected_frame))
do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
0, 0, Qnil);
- _longjmp (getcjmp, 1);
+ sys_longjmp (getcjmp, 1);
}
\f
DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,
(Lisp_Object interrupt)
{
int new_interrupt_input;
-#ifdef SIGIO
-/* Note SIGIO has been undef'd if FIONREAD is missing. */
+#ifdef USABLE_SIGIO
#ifdef HAVE_X_WINDOWS
if (x_display_list != NULL)
{
else
#endif /* HAVE_X_WINDOWS */
new_interrupt_input = !NILP (interrupt);
-#else /* not SIGIO */
+#else /* not USABLE_SIGIO */
new_interrupt_input = 0;
-#endif /* not SIGIO */
+#endif /* not USABLE_SIGIO */
if (new_interrupt_input != interrupt_input)
{
if (WINDOWP (frame_or_window))
{
- struct window *w;
-
- CHECK_LIVE_WINDOW (frame_or_window);
+ struct window *w = decode_live_window (frame_or_window);
- w = XWINDOW (frame_or_window);
XSETINT (x, (XINT (x)
+ WINDOW_LEFT_EDGE_X (w)
+ (NILP (whole)
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_overriding_terminal_local_map (kb, Qnil);
+ kset_last_command (kb, Qnil);
+ kset_real_last_command (kb, Qnil);
+ kset_keyboard_translate_table (kb, Qnil);
+ kset_last_repeatable_command (kb, Qnil);
+ kset_prefix_arg (kb, Qnil);
+ kset_last_prefix_arg (kb, Qnil);
+ kset_kbd_queue (kb, Qnil);
kb->kbd_queue_has_data = 0;
kb->immediate_echo = 0;
- KVAR (kb, echo_string) = Qnil;
+ kset_echo_string (kb, 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_defining_kbd_macro (kb, Qnil);
+ kset_last_kbd_macro (kb, 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_system_key_alist (kb, Qnil);
+ kset_system_key_syms (kb, Qnil);
+ kset_window_system (kb, Qt); /* Unset. */
+ kset_input_decode_map (kb, Fmake_sparse_keymap (Qnil));
+ kset_local_function_key_map (kb, Fmake_sparse_keymap (Qnil));
Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map);
- KVAR (kb, Vdefault_minibuffer_frame) = Qnil;
+ kset_default_minibuffer_frame (kb, Qnil);
}
/*
for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
if (*kbp == NULL)
- abort ();
+ emacs_abort ();
*kbp = kb->next_kboard;
/* Prevent a dangling reference to KB. */
current_kboard = FRAME_KBOARD (XFRAME (selected_frame));
single_kboard = 0;
if (current_kboard == kb)
- abort ();
+ emacs_abort ();
}
wipe_kboard (kb);
void
init_keyboard (void)
{
- /* This is correct before outermost invocation of the editor loop */
+ /* This is correct before outermost invocation of the editor loop. */
command_loop_level = -1;
immediate_quit = 0;
quit_char = Ctl ('g');
Vunread_command_events = Qnil;
- unread_command_char = -1;
- EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
+ timer_idleness_start_time = invalid_emacs_time ();
total_keys = 0;
recent_keys_index = 0;
kbd_fetch_ptr = kbd_buffer;
#endif
input_pending = 0;
interrupt_input_blocked = 0;
- interrupt_input_pending = 0;
-#ifdef SYNC_INPUT
pending_signals = 0;
-#endif
/* This means that command_loop_1 won't try to select anything the first
time through. */
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_window_system (current_kboard, Qnil);
if (!noninteractive)
{
/* Before multi-tty support, these handlers used to be installed
only if the current session was a tty session. Now an Emacs
session may have multiple display types, so we always handle
- SIGINT. There is special code in interrupt_signal to exit
+ SIGINT. There is special code in handle_interrupt_signal to exit
Emacs on SIGINT when there are no termcap frames on the
controlling terminal. */
- signal (SIGINT, interrupt_signal);
+ struct sigaction action;
+ emacs_sigaction_init (&action, deliver_interrupt_signal);
+ sigaction (SIGINT, &action, 0);
#ifndef DOS_NT
/* For systems with SysV TERMIO, C-g is set up for both SIGINT and
SIGQUIT and we can't tell which one it will give us. */
- signal (SIGQUIT, interrupt_signal);
+ sigaction (SIGQUIT, &action, 0);
#endif /* not DOS_NT */
}
-/* Note SIGIO has been undef'd if FIONREAD is missing. */
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
if (!noninteractive)
- signal (SIGIO, input_available_signal);
-#endif /* SIGIO */
+ {
+ struct sigaction action;
+ emacs_sigaction_init (&action, deliver_input_available_signal);
+ sigaction (SIGIO, &action, 0);
+ }
+#endif
/* Use interrupt input by default, if it works and noninterrupt input
has deficiencies. */
interrupt_input = 0;
#endif
- sigfree ();
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
dribble = 0;
if (keyboard_init_hook)
pending_funcalls = Qnil;
staticpro (&pending_funcalls);
- Vlispy_mouse_stem = make_pure_c_string ("mouse");
+ Vlispy_mouse_stem = build_pure_c_string ("mouse");
staticpro (&Vlispy_mouse_stem);
/* Tool-bars. */
staticpro (&tool_bar_items_vector);
tool_bar_items_vector = Qnil;
- staticpro (&real_this_command);
- real_this_command = Qnil;
-
DEFSYM (Qtimer_event_handler, "timer-event-handler");
DEFSYM (Qdisabled_command_function, "disabled-command-function");
DEFSYM (Qself_insert_command, "self-insert-command");
modifier_symbols = Fmake_vector (make_number (len), Qnil);
for (i = 0; i < len; i++)
if (modifier_names[i])
- XVECTOR (modifier_symbols)->contents[i] = intern_c_string (modifier_names[i]);
+ ASET (modifier_symbols, i, intern_c_string (modifier_names[i]));
staticpro (&modifier_symbols);
}
defsubr (&Sset_quit_char);
defsubr (&Sset_input_mode);
defsubr (&Scurrent_input_mode);
- defsubr (&Sexecute_extended_command);
defsubr (&Sposn_at_point);
defsubr (&Sposn_at_x_y);
An element of the form (t . EVENT) forces EVENT to be added to that list. */);
Vunread_command_events = Qnil;
- DEFVAR_INT ("unread-command-char", unread_command_char,
- doc: /* If not -1, an object to be read as next command input event. */);
-
DEFVAR_LISP ("unread-post-input-method-events", Vunread_post_input_method_events,
doc: /* List of events to be processed as input by input methods.
These events are processed before `unread-command-events'
See Info node `(elisp)Multiple Terminals'. */);
DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
- doc: /* Same as `last-command', but never altered by Lisp code. */);
+ doc: /* Same as `last-command', but never altered by Lisp code.
+Taken from the previous value of `real-this-command'. */);
DEFVAR_KBOARD ("last-repeatable-command", Vlast_repeatable_command,
doc: /* Last command that may be repeated.
The last command executed that was not bound to an input event.
-This is the command `repeat' will try to repeat. */);
+This is the command `repeat' will try to repeat.
+Taken from a previous value of `real-this-command'. */);
DEFVAR_LISP ("this-command", Vthis_command,
doc: /* The command now being executed.
will be in `last-command' during the following command. */);
Vthis_command = Qnil;
+ DEFVAR_LISP ("real-this-command", Vreal_this_command,
+ doc: /* This is like `this-command', except that commands should never modify it. */);
+ Vreal_this_command = Qnil;
+
DEFVAR_LISP ("this-command-keys-shift-translated",
Vthis_command_keys_shift_translated,
doc: /* Non-nil if the key sequence activating this command was shift-translated.
immediately after running `post-command-hook'. */);
Vdelayed_warnings_list = Qnil;
- DEFVAR_LISP ("suggest-key-bindings", Vsuggest_key_bindings,
- doc: /* Non-nil means show the equivalent key-binding when M-x command has one.
-The value can be a length of time to show the message for.
-If the value is non-nil and not a number, we wait 2 seconds. */);
- Vsuggest_key_bindings = Qt;
-
DEFVAR_LISP ("timer-list", Vtimer_list,
doc: /* List of active absolute time timers in order of increasing time. */);
Vtimer_list = Qnil;
Vdebug_on_event = intern_c_string ("sigusr2");
/* Create the initial keyboard. */
- initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ initial_kboard = xmalloc (sizeof *initial_kboard);
init_kboard (initial_kboard);
/* Vwindow_system is left at t for now. */
initial_kboard->next_kboard = all_kboards;
initial_define_lispy_key (Vspecial_event_map, "config-changed-event",
"ignore");
+#if defined (WINDOWSNT)
+ initial_define_lispy_key (Vspecial_event_map, "language-change",
+ "ignore");
+#endif
}
/* Mark the pointers in the kboard objects.
- Called by the Fgarbage_collector. */
+ Called by Fgarbage_collect. */
void
mark_kboards (void)
{
#include "systime.h" /* for EMACS_TIME, Time */
#include "coding.h" /* for ENCODE_UTF_8 and ENCODE_SYSTEM */
-/* Lisp fields in struct keyboard are hidden from most code and accessed
- via the KVAR macro, below. Only select pieces of code, like the GC,
- are allowed to use KBOARD_INTERNAL_FIELD. */
-#define KBOARD_INTERNAL_FIELD(field) field ## _
+INLINE_HEADER_BEGIN
+#ifndef KEYBOARD_INLINE
+# define KEYBOARD_INLINE INLINE
+#endif
+
+/* Most code should use this macro to access Lisp fields in struct kboard. */
-/* Most code should use this macro to access Lisp fields in struct
- kboard. */
-#define KVAR(kboard, field) ((kboard)->KBOARD_INTERNAL_FIELD (field))
+#define KVAR(kboard, field) ((kboard)->INTERNAL_FIELD (field))
/* Each KBOARD represents one logical input stream from which Emacs
gets input. If we are using ordinary terminals, it has one KBOARD
can effectively wait for input in the any-kboard state, and hence
avoid blocking out the other KBOARDs. See universal-argument in
lisp/simple.el for an example. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Voverriding_terminal_local_map);
+ Lisp_Object INTERNAL_FIELD (Voverriding_terminal_local_map);
/* Last command executed by the editor command loop, not counting
commands that set the prefix argument. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_command);
+ Lisp_Object INTERNAL_FIELD (Vlast_command);
/* Normally same as last-command, but never modified by other commands. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vreal_last_command);
+ Lisp_Object INTERNAL_FIELD (Vreal_last_command);
/* User-supplied table to translate input characters through. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vkeyboard_translate_table);
+ Lisp_Object INTERNAL_FIELD (Vkeyboard_translate_table);
/* Last command that may be repeated by `repeat'. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_repeatable_command);
+ Lisp_Object INTERNAL_FIELD (Vlast_repeatable_command);
/* The prefix argument for the next command, in raw form. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vprefix_arg);
+ Lisp_Object INTERNAL_FIELD (Vprefix_arg);
/* Saved prefix argument for the last command, in raw form. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_prefix_arg);
+ Lisp_Object INTERNAL_FIELD (Vlast_prefix_arg);
/* Unread events specific to this kboard. */
- Lisp_Object KBOARD_INTERNAL_FIELD (kbd_queue);
+ Lisp_Object INTERNAL_FIELD (kbd_queue);
/* Non-nil while a kbd macro is being defined. */
- Lisp_Object KBOARD_INTERNAL_FIELD (defining_kbd_macro);
+ Lisp_Object INTERNAL_FIELD (defining_kbd_macro);
/* The start of storage for the current keyboard macro. */
Lisp_Object *kbd_macro_buffer;
ptrdiff_t kbd_macro_bufsize;
/* Last anonymous kbd macro defined. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_kbd_macro);
+ Lisp_Object INTERNAL_FIELD (Vlast_kbd_macro);
/* Alist of system-specific X windows key symbols. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vsystem_key_alist);
+ Lisp_Object INTERNAL_FIELD (Vsystem_key_alist);
/* Cache for modify_event_symbol. */
- Lisp_Object KBOARD_INTERNAL_FIELD (system_key_syms);
+ Lisp_Object INTERNAL_FIELD (system_key_syms);
/* The kind of display: x, w32, ... */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vwindow_system);
+ Lisp_Object INTERNAL_FIELD (Vwindow_system);
/* Keymap mapping keys to alternative preferred forms.
See the DEFVAR for more documentation. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vlocal_function_key_map);
+ Lisp_Object INTERNAL_FIELD (Vlocal_function_key_map);
/* Keymap mapping ASCII function key sequences onto their preferred
forms. Initialized by the terminal-specific lisp files. See the
DEFVAR for more documentation. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vinput_decode_map);
+ Lisp_Object INTERNAL_FIELD (Vinput_decode_map);
/* Minibufferless frames on this display use this frame's minibuffer. */
- Lisp_Object KBOARD_INTERNAL_FIELD (Vdefault_minibuffer_frame);
+ Lisp_Object INTERNAL_FIELD (Vdefault_minibuffer_frame);
/* Number of displays using this KBOARD. Normally 1, but can be
larger when you have multiple screens on a single X display. */
/* The text we're echoing in the modeline - partial key sequences,
usually. This is nil when not echoing. */
- Lisp_Object KBOARD_INTERNAL_FIELD (echo_string);
+ Lisp_Object INTERNAL_FIELD (echo_string);
/* This flag indicates that events were put into kbd_queue
while Emacs was running for some other KBOARD.
char echo_after_prompt;
};
+KEYBOARD_INLINE void
+kset_default_minibuffer_frame (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vdefault_minibuffer_frame) = val;
+}
+KEYBOARD_INLINE void
+kset_defining_kbd_macro (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (defining_kbd_macro) = val;
+}
+KEYBOARD_INLINE void
+kset_input_decode_map (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vinput_decode_map) = val;
+}
+KEYBOARD_INLINE void
+kset_last_command (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlast_command) = val;
+}
+KEYBOARD_INLINE void
+kset_last_kbd_macro (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vlast_kbd_macro) = val;
+}
+KEYBOARD_INLINE void
+kset_prefix_arg (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vprefix_arg) = val;
+}
+KEYBOARD_INLINE void
+kset_system_key_alist (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vsystem_key_alist) = val;
+}
+KEYBOARD_INLINE void
+kset_window_system (struct kboard *kb, Lisp_Object val)
+{
+ kb->INTERNAL_FIELD (Vwindow_system) = val;
+}
+
/* Temporarily used before a frame has been opened. */
extern KBOARD *initial_kboard;
sequence; this_command_key_count indicates how many elements
actually mean something. */
extern Lisp_Object this_command_keys;
-extern int this_command_key_count;
+extern ptrdiff_t this_command_key_count;
/* The frame in which the last input event occurred, or Qmacro if the
last event came from a macro. We use this to determine when to
extern void start_polling (void);
extern void stop_polling (void);
extern void set_poll_suppress_count (int);
-extern void gobble_input (int);
+extern int gobble_input (void);
extern int input_polling_used (void);
extern void clear_input_pending (void);
extern int requeued_events_pending_p (void);
extern void bind_polling_period (int);
-extern int make_ctrl_char (int);
+extern int make_ctrl_char (int) ATTRIBUTE_CONST;
extern void stuff_buffered_input (Lisp_Object);
extern void clear_waiting_for_input (void);
extern void swallow_events (int);
extern void show_help_echo (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
extern void gen_help_event (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object, EMACS_INT);
+ Lisp_Object, ptrdiff_t);
extern void kbd_buffer_store_help_event (Lisp_Object, Lisp_Object);
extern Lisp_Object menu_item_eval_property (Lisp_Object);
extern int kbd_buffer_events_waiting (int);
extern void add_user_signal (int, const char *);
-extern int tty_read_avail_input (struct terminal *, int,
- struct input_event *);
+extern int tty_read_avail_input (struct terminal *, struct input_event *);
extern EMACS_TIME timer_check (void);
extern void mark_kboards (void);
#ifdef WINDOWSNT
extern const char *const lispy_function_keys[];
#endif
+
+INLINE_HEADER_END
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
/* Which keymaps are reverse-stored in the cache. */
static Lisp_Object where_is_cache_keymaps;
-static Lisp_Object Flookup_key (Lisp_Object, Lisp_Object, Lisp_Object);
static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
Fdefine_key should cause keymaps to be autoloaded.
This function can GC when AUTOLOAD is non-zero, because it calls
- do_autoload which can GC. */
+ Fautoload_do_load which can GC. */
Lisp_Object
get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload)
struct gcpro gcpro1, gcpro2;
GCPRO2 (tem, object);
- do_autoload (tem, object);
+ Fautoload_do_load (tem, object, Qnil);
UNGCPRO;
goto autoload_retry;
return def;
}
-static Lisp_Object Fcopy_keymap (Lisp_Object);
-
static Lisp_Object
copy_keymap_item (Lisp_Object elt)
{
binding KEY to DEF is added at the front of KEYMAP. */)
(Lisp_Object keymap, Lisp_Object key, Lisp_Object def)
{
- register int idx;
+ register ptrdiff_t idx;
register Lisp_Object c;
register Lisp_Object cmd;
int metized = 0;
int meta_bit;
- int length;
+ ptrdiff_t length;
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (keymap, key, def);
if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
{ /* DEF is apparently an XEmacs-style keyboard macro. */
Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
- int i = ASIZE (def);
+ ptrdiff_t i = ASIZE (def);
while (--i >= 0)
{
Lisp_Object defi = AREF (def, i);
recognize the default bindings, just as `read-key-sequence' does. */)
(Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
{
- register int idx;
+ register ptrdiff_t idx;
register Lisp_Object cmd;
register Lisp_Object c;
- int length;
+ ptrdiff_t length;
int t_ok = !NILP (accept_default);
struct gcpro gcpro1, gcpro2;
/* Use malloc here. See the comment above this function.
Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
- BLOCK_INPUT;
- newmodes = (Lisp_Object *) malloc (allocsize);
+ block_input ();
+ newmodes = malloc (allocsize);
if (newmodes)
{
if (cmm_modes)
cmm_modes = newmodes;
}
- newmaps = (Lisp_Object *) malloc (allocsize);
+ newmaps = malloc (allocsize);
if (newmaps)
{
if (cmm_maps)
}
cmm_maps = newmaps;
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (newmodes == NULL || newmaps == NULL)
break;
return i;
}
+/* Return the offset of POSITION, a click position, in the style of
+ the respective argument of Fkey_binding. */
+static ptrdiff_t
+click_position (Lisp_Object position)
+{
+ EMACS_INT pos = (INTEGERP (position) ? XINT (position)
+ : MARKERP (position) ? marker_position (position)
+ : PT);
+ if (! (BEGV <= pos && pos <= ZV))
+ args_out_of_range (Fcurrent_buffer (), position);
+ return pos;
+}
+
DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
0, 2, 0,
doc: /* Return a list of the currently active keymaps.
like in the respective argument of `key-binding'. */)
(Lisp_Object olp, Lisp_Object position)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object keymaps = Fcons (current_global_map, Qnil);
would not be a problem here, but it is easier to keep
things the same.
*/
-
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
-
+ record_unwind_current_buffer ();
set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
}
}
{
Lisp_Object *maps;
int nmaps, i;
- EMACS_INT pt
- = INTEGERP (position) ? XINT (position)
- : MARKERP (position) ? marker_position (position)
- : PT;
+ ptrdiff_t pt = click_position (position);
/* This usually returns the buffer's local map,
but that can be overridden by a `local-map' property. */
Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map);
if (!NILP (keymap))
keymap = get_keymap (keymap, 1, 1);
- BVAR (current_buffer, keymap) = keymap;
+ bset_keymap (current_buffer, keymap);
return Qnil;
}
while (!NILP (tem = Frassq (cmd, maps)))
{
Lisp_Object prefix = XCAR (tem);
- int lim = XINT (Flength (XCAR (tem)));
+ ptrdiff_t lim = XINT (Flength (XCAR (tem)));
if (lim <= XINT (Flength (thisseq)))
{ /* This keymap was already seen with a smaller prefix. */
- int i = 0;
+ ptrdiff_t i = 0;
while (i < lim && EQ (Faref (prefix, make_number (i)),
Faref (thisseq, make_number (i))))
i++;
(Lisp_Object keymap, Lisp_Object prefix)
{
Lisp_Object maps, tail;
- int prefixlen = XINT (Flength (prefix));
+ EMACS_INT prefixlen = XFASTINT (Flength (prefix));
/* no need for gcpro because we don't autoload any keymaps. */
return Qnil;
}
else
- maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
- get_keymap (keymap, 1, 0)),
- Qnil);
+ maps = Fcons (Fcons (zero_vector, get_keymap (keymap, 1, 0)), Qnil);
/* For each map in the list maps,
look at any other maps it points to,
The `kbd' macro is an approximate inverse of this. */)
(Lisp_Object keys, Lisp_Object prefix)
{
- int len = 0;
- int i, i_byte;
+ ptrdiff_t len = 0;
+ EMACS_INT i;
+ ptrdiff_t i_byte;
Lisp_Object *args;
- int size = XINT (Flength (keys));
+ EMACS_INT size = XINT (Flength (keys));
Lisp_Object list;
Lisp_Object sep = build_string (" ");
Lisp_Object key;
+ Lisp_Object result;
int add_meta = 0;
+ USE_SAFE_ALLOCA;
if (!NILP (prefix))
size += XINT (Flength (prefix));
/* This has one extra element at the end that we don't pass to Fconcat. */
- args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
+ if (min (PTRDIFF_MAX, SIZE_MAX) / word_size / 4 < size)
+ memory_full (SIZE_MAX);
+ SAFE_ALLOCA_LISP (args, size * 4);
/* In effect, this computes
(mapconcat 'single-key-description keys " ")
if (add_meta)
{
args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
- len += 2;
+ result = Fconcat (len + 1, args);
}
else if (len == 0)
- return empty_unibyte_string;
- return Fconcat (len - 1, args);
+ result = empty_unibyte_string;
+ else
+ result = Fconcat (len - 1, args);
+ SAFE_FREE ();
+ return result;
}
if (STRINGP (list))
continue;
}
else
- XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
+ XSETINT (key, XINT (key) | meta_modifier);
add_meta = 0;
}
else if (EQ (key, meta_prefix_char))
char *
push_key_description (EMACS_INT ch, char *p, int force_multibyte)
{
- int c, c2;
+ int c, c2, tab_as_ci;
/* Clear all the meaningless bits above the meta bit. */
c = ch & (meta_modifier | ~ - meta_modifier);
return p;
}
+ tab_as_ci = (c2 == '\t' && (c & meta_modifier));
+
if (c & alt_modifier)
{
*p++ = 'A';
c -= alt_modifier;
}
if ((c & ctrl_modifier) != 0
- || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
+ || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M'))
+ || tab_as_ci)
{
*p++ = 'C';
*p++ = '-';
*p++ = 'S';
*p++ = 'C';
}
+ else if (tab_as_ci)
+ {
+ *p++ = 'i';
+ }
else if (c == '\t')
{
*p++ = 'T';
{
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 ();
char str[6];
int c;
- CHECK_NUMBER (character);
+ CHECK_CHARACTER (character);
c = XINT (character);
if (!ASCII_CHAR_P (c))
static int
preferred_sequence_p (Lisp_Object seq)
{
- int i;
- int len = XINT (Flength (seq));
+ EMACS_INT i;
+ EMACS_INT len = XFASTINT (Flength (seq));
int result = 1;
for (i = 0; i < len; i++)
char *title, *p;
if (!SYMBOLP (modes[i]))
- abort ();
+ emacs_abort ();
- p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
+ p = title = alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
*p++ = '\f';
*p++ = '\n';
*p++ = '`';
describe_command (Lisp_Object definition, Lisp_Object args)
{
register Lisp_Object tem1;
- EMACS_INT column = current_column ();
+ ptrdiff_t column = current_column ();
int description_column;
/* If column 16 is no good, go to col 32;
DESCRIBER is the output function used; nil means use `princ'. */)
(Lisp_Object vector, Lisp_Object describer)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (NILP (describer))
describer = intern ("princ");
specbind (Qstandard_output, Fcurrent_buffer ());
Fset (intern_c_string ("ctl-x-map"), control_x_map);
Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
- exclude_keys
- = pure_cons (pure_cons (make_pure_c_string ("DEL"), make_pure_c_string ("\\d")),
- pure_cons (pure_cons (make_pure_c_string ("TAB"), make_pure_c_string ("\\t")),
- pure_cons (pure_cons (make_pure_c_string ("RET"), make_pure_c_string ("\\r")),
- pure_cons (pure_cons (make_pure_c_string ("ESC"), make_pure_c_string ("\\e")),
- pure_cons (pure_cons (make_pure_c_string ("SPC"), make_pure_c_string (" ")),
- Qnil)))));
+ exclude_keys = listn (CONSTYPE_PURE, 5,
+ pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")),
+ pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")),
+ pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")),
+ pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")),
+ pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")));
staticpro (&exclude_keys);
DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands,
where_is_preferred_modifier = 0;
staticpro (&Vmouse_events);
- Vmouse_events = pure_cons (intern_c_string ("menu-bar"),
- pure_cons (intern_c_string ("tool-bar"),
- pure_cons (intern_c_string ("header-line"),
- pure_cons (intern_c_string ("mode-line"),
- pure_cons (intern_c_string ("mouse-1"),
- pure_cons (intern_c_string ("mouse-2"),
- pure_cons (intern_c_string ("mouse-3"),
- pure_cons (intern_c_string ("mouse-4"),
- pure_cons (intern_c_string ("mouse-5"),
- Qnil)))))))));
+ Vmouse_events = listn (CONSTYPE_PURE, 9,
+ intern_c_string ("menu-bar"),
+ intern_c_string ("tool-bar"),
+ intern_c_string ("header-line"),
+ intern_c_string ("mode-line"),
+ intern_c_string ("mouse-1"),
+ intern_c_string ("mouse-2"),
+ intern_c_string ("mouse-3"),
+ intern_c_string ("mouse-4"),
+ intern_c_string ("mouse-5"));
DEFSYM (Qsingle_key_description, "single-key-description");
DEFSYM (Qkey_description, "key-description");
extern Lisp_Object Qremap;
extern Lisp_Object Qmenu_item;
extern Lisp_Object current_global_map;
-EXFUN (Fmake_sparse_keymap, 1);
-EXFUN (Fkeymap_prompt, 1);
-EXFUN (Fdefine_key, 3);
-EXFUN (Fcommand_remapping, 3);
-EXFUN (Fkey_binding, 4);
-EXFUN (Fkey_description, 2);
extern char *push_key_description (EMACS_INT, char *, int);
-EXFUN (Fsingle_key_description, 2);
-EXFUN (Fwhere_is_internal, 5);
-EXFUN (Fcurrent_active_maps, 2);
extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, int, int, int);
extern Lisp_Object get_keymap (Lisp_Object, int, int);
-EXFUN (Fset_keymap_parent, 2);
extern void describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object,
const char *, int, int, int, int);
extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **);
/* Fundamental definitions for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1987, 1993-1995, 1997-2012
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1987, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#ifndef EMACS_LISP_H
#define EMACS_LISP_H
+#include <setjmp.h>
+#include <stdalign.h>
#include <stdarg.h>
+#include <stdbool.h>
#include <stddef.h>
+#include <float.h>
#include <inttypes.h>
#include <limits.h>
#include <intprops.h>
-/* Use the configure flag --enable-checking[=LIST] to enable various
- types of run time checks for Lisp objects. */
-
-#ifdef GC_CHECK_CONS_LIST
-extern void check_cons_list (void);
-#define CHECK_CONS_LIST() check_cons_list ()
-#else
-#define CHECK_CONS_LIST() ((void) 0)
+INLINE_HEADER_BEGIN
+#ifndef LISP_INLINE
+# define LISP_INLINE INLINE
#endif
-/* Temporarily disable wider-than-pointer integers until they're tested more.
- Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */
-/* #undef WIDE_EMACS_INT */
-
-/* These are default choices for the types to use. */
-#ifndef EMACS_INT
-# if BITS_PER_LONG < BITS_PER_LONG_LONG && defined WIDE_EMACS_INT
-# define EMACS_INT long long
-# define BITS_PER_EMACS_INT BITS_PER_LONG_LONG
+/* The ubiquitous max and min macros. */
+#undef min
+#undef max
+#define max(a, b) ((a) > (b) ? (a) : (b))
+#define min(a, b) ((a) < (b) ? (a) : (b))
+
+/* EMACS_INT - signed integer wide enough to hold an Emacs value
+ EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
+ pI - printf length modifier for EMACS_INT
+ EMACS_UINT - unsigned variant of EMACS_INT */
+#ifndef EMACS_INT_MAX
+# if LONG_MAX < LLONG_MAX && defined WIDE_EMACS_INT
+typedef long long int EMACS_INT;
+typedef unsigned long long int EMACS_UINT;
+# define EMACS_INT_MAX LLONG_MAX
# define pI "ll"
-# elif BITS_PER_INT < BITS_PER_LONG
-# define EMACS_INT long
-# define BITS_PER_EMACS_INT BITS_PER_LONG
+# elif INT_MAX < LONG_MAX
+typedef long int EMACS_INT;
+typedef unsigned long int EMACS_UINT;
+# define EMACS_INT_MAX LONG_MAX
# define pI "l"
# else
-# define EMACS_INT int
-# define BITS_PER_EMACS_INT BITS_PER_INT
+typedef int EMACS_INT;
+typedef unsigned int EMACS_UINT;
+# define EMACS_INT_MAX INT_MAX
# define pI ""
# endif
#endif
-#ifndef EMACS_UINT
-# define EMACS_UINT unsigned EMACS_INT
-#endif
+
+/* Number of bits in some machine integer types. */
+enum
+ {
+ BITS_PER_CHAR = CHAR_BIT,
+ BITS_PER_SHORT = CHAR_BIT * sizeof (short),
+ BITS_PER_INT = CHAR_BIT * sizeof (int),
+ BITS_PER_LONG = CHAR_BIT * sizeof (long int),
+ BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
+ };
/* printmax_t and uprintmax_t are types for printing large integers.
These are the widest integers that are supported for printing.
/* Extra internal type checking? */
-#ifdef ENABLE_CHECKING
+/* Define an Emacs version of 'assert (COND)', since some
+ system-defined 'assert's are flaky. COND should be free of side
+ effects; it may or may not be evaluated. */
+#ifndef ENABLE_CHECKING
+# define eassert(X) ((void) (0 && (X))) /* Check that X compiles. */
+#else /* ENABLE_CHECKING */
-extern void die (const char *, const char *, int) NO_RETURN;
+extern _Noreturn void die (const char *, const char *, int);
/* The suppress_checking variable is initialized to 0 in alloc.c. Set
it to 1 using a debugger to temporarily disable aborting on
detected internal inconsistencies or error conditions.
- Testing suppress_checking after the supplied condition ensures that
- the side effects produced by CHECK will be consistent, independent
- of whether ENABLE_CHECKING is defined, or whether the checks are
- suppressed at run time.
-
In some cases, a good compiler may be able to optimize away the
- CHECK macro altogether, e.g., if XSTRING (x) uses CHECK to test
+ eassert macro altogether, e.g., if XSTRING (x) uses eassert to test
STRINGP (x), but a particular use of XSTRING is invoked only after
testing that STRINGP (x) is true, making the test redundant. */
+extern bool suppress_checking EXTERNALLY_VISIBLE;
-extern int suppress_checking EXTERNALLY_VISIBLE;
-
-#define CHECK(check,msg) (((check) || suppress_checking \
- ? (void) 0 \
- : die ((msg), __FILE__, __LINE__)), \
- 0)
-#else
-
-/* Produce same side effects and result, but don't complain. */
-#define CHECK(check,msg) ((check),0)
-
-#endif
-
-/* Define an Emacs version of "assert", since some system ones are
- flaky. */
-#ifndef ENABLE_CHECKING
-#define eassert(X) ((void) (0 && (X))) /* Check that X compiles. */
-#else /* ENABLE_CHECKING */
-#if defined (__GNUC__) && __GNUC__ >= 2 && defined (__STDC__)
-#define eassert(cond) CHECK (cond, "assertion failed: " #cond)
-#else
-#define eassert(cond) CHECK (cond, "assertion failed")
-#endif
+# define eassert(cond) \
+ ((cond) || suppress_checking \
+ ? (void) 0 \
+ : die ("assertion failed: " # cond, __FILE__, __LINE__))
#endif /* ENABLE_CHECKING */
\f
-/* Use the configure flag --enable-use-lisp-union-type to make
- Lisp_Object use a union type instead of the default int. The flag
- causes USE_LISP_UNION_TYPE to be defined. */
+/* Use the configure flag --enable-check-lisp-object-type to make
+ Lisp_Object use a struct type instead of the default int. The flag
+ causes CHECK_LISP_OBJECT_TYPE to be defined. */
/***** Select the tagging scheme. *****/
-/* There are basically two options that control the tagging scheme:
- - USE_LISP_UNION_TYPE says that Lisp_Object should be a union instead
- of an integer.
+/* The following option controls the tagging scheme:
- USE_LSB_TAG means that we can assume the least 3 bits of pointers are
always 0, and we can thus use them to hold tag bits, without
restricting our addressing space.
- If USE_LSB_TAG is not set, then we use the top 3 bits for tagging, thus
- restricting our possible address range. Currently USE_LSB_TAG is not
- allowed together with a union. This is not due to any fundamental
- technical (or political ;-) problem: nobody wrote the code to do it yet.
+ If ! USE_LSB_TAG, then use the top 3 bits for tagging, thus
+ restricting our possible address range.
USE_LSB_TAG not only requires the least 3 bits of pointers returned by
malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
on the few static Lisp_Objects used: all the defsubr as well
as the two special buffers buffer_defaults and buffer_local_symbols. */
-/* First, try and define DECL_ALIGN(type,var) which declares a static
- variable VAR of type TYPE with the added requirement that it be
- TYPEBITS-aligned. */
-
-#ifndef GCTYPEBITS
+enum Lisp_Bits
+ {
+ /* Number of bits in a Lisp_Object tag. This can be used in #if,
+ and for GDB's sake also as a regular symbol. */
+ GCTYPEBITS =
#define GCTYPEBITS 3
-#endif
+ GCTYPEBITS,
-#ifndef VALBITS
-#define VALBITS (BITS_PER_EMACS_INT - GCTYPEBITS)
-#endif
+ /* 2**GCTYPEBITS. This must also be a macro that expands to a
+ literal integer constant, for MSVC. */
+ GCALIGNMENT =
+#define GCALIGNMENT 8
+ GCALIGNMENT,
-#ifndef NO_DECL_ALIGN
-# ifndef DECL_ALIGN
-# if HAVE_ATTRIBUTE_ALIGNED
-# define DECL_ALIGN(type, var) \
- type __attribute__ ((__aligned__ (1 << GCTYPEBITS))) var
-# elif defined(_MSC_VER)
-# define ALIGN_GCTYPEBITS 8
-# if (1 << GCTYPEBITS) != ALIGN_GCTYPEBITS
-# error ALIGN_GCTYPEBITS is wrong!
-# endif
-# define DECL_ALIGN(type, var) \
- type __declspec(align(ALIGN_GCTYPEBITS)) var
-# else
- /* What directives do other compilers use? */
-# endif
-# endif
+ /* Number of bits in a Lisp_Object value, not counting the tag. */
+ VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS,
+
+ /* Number of bits in a Lisp fixnum tag. */
+ INTTYPEBITS = GCTYPEBITS - 1,
+
+ /* Number of bits in a Lisp fixnum value, not counting the tag. */
+ FIXNUM_BITS = VALBITS + 1
+ };
+
+#if GCALIGNMENT != 1 << GCTYPEBITS
+# error "GCALIGNMENT and GCTYPEBITS are inconsistent"
#endif
-/* Let's USE_LSB_TAG on systems where we know malloc returns mult-of-8. */
-#if (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \
- || defined DARWIN_OS || defined __sun)
-/* We also need to be able to specify mult-of-8 alignment on static vars. */
-# if defined DECL_ALIGN
-/* On hosts where VALBITS is greater than the pointer width in bits,
- USE_LSB_TAG is:
+/* The maximum value that can be stored in a EMACS_INT, assuming all
+ bits other than the type bits contribute to a nonnegative signed value.
+ This can be used in #if, e.g., '#if VAL_MAX < UINTPTR_MAX' below. */
+#define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
+
+/* Unless otherwise specified, use USE_LSB_TAG on systems where: */
+#ifndef USE_LSB_TAG
+/* 1. We know malloc returns a multiple of 8. */
+# if (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \
+ || defined DARWIN_OS || defined __sun)
+/* 2. We can specify multiple-of-8 alignment on static variables. */
+# ifdef alignas
+/* 3. Pointers-as-ints exceed VAL_MAX.
+ On hosts where pointers-as-ints do not exceed VAL_MAX, USE_LSB_TAG is:
a. unnecessary, because the top bits of an EMACS_INT are unused, and
b. slower, because it typically requires extra masking.
- So, define USE_LSB_TAG only on hosts where it might be useful. */
-# if UINTPTR_MAX >> VALBITS != 0
-# define USE_LSB_TAG
+ So, default USE_LSB_TAG to 1 only on hosts where it might be useful. */
+# if VAL_MAX < UINTPTR_MAX
+# define USE_LSB_TAG 1
+# endif
# endif
# endif
#endif
+#ifdef USE_LSB_TAG
+# undef USE_LSB_TAG
+enum enum_USE_LSB_TAG { USE_LSB_TAG = 1 };
+# define USE_LSB_TAG 1
+#else
+enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 };
+# define USE_LSB_TAG 0
+#endif
-/* If we cannot use 8-byte alignment, make DECL_ALIGN a no-op. */
-#ifndef DECL_ALIGN
-# ifdef USE_LSB_TAG
-# error "USE_LSB_TAG used without defining DECL_ALIGN"
+#ifndef alignas
+# define alignas(alignment) /* empty */
+# if USE_LSB_TAG
+# error "USE_LSB_TAG requires alignas"
# endif
-# define DECL_ALIGN(type, var) type var
#endif
/* Define the fundamental Lisp data structures. */
-/* If USE_2_TAGBITS_FOR_INTS is defined, then Lisp integers use
- 2 tags, to give them one extra bit, thus extending their range from
- e.g -2^28..2^28-1 to -2^29..2^29-1. */
-#define USE_2_TAGS_FOR_INTS
-
-/* Making it work for the union case is too much trouble. */
-#ifdef USE_LISP_UNION_TYPE
-# undef USE_2_TAGS_FOR_INTS
-#endif
-
/* This is the set of Lisp data types. */
-#if !defined USE_2_TAGS_FOR_INTS
-# define LISP_INT_TAG Lisp_Int
-# define case_Lisp_Int case Lisp_Int
-# define LISP_STRING_TAG 4
-# define LISP_INT_TAG_P(x) ((x) == Lisp_Int)
-#else
-# define LISP_INT_TAG Lisp_Int0
-# define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
-# ifdef USE_LSB_TAG
-# define LISP_INT1_TAG 4
-# define LISP_STRING_TAG 1
-# define LISP_INT_TAG_P(x) (((x) & 3) == 0)
-# else
-# define LISP_INT1_TAG 1
-# define LISP_STRING_TAG 4
-# define LISP_INT_TAG_P(x) (((x) & 6) == 0)
-# endif
-#endif
+/* Lisp integers use 2 tags, to give them one extra bit, thus
+ extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */
+static EMACS_INT const INTMASK = EMACS_INT_MAX >> (INTTYPEBITS - 1);
+#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
+#define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0)
/* Stolen from GDB. The only known compiler that doesn't support
enums in bitfields is MSVC. */
enum Lisp_Type
{
/* Integer. XINT (obj) is the integer value. */
-#ifdef USE_2_TAGS_FOR_INTS
Lisp_Int0 = 0,
- Lisp_Int1 = LISP_INT1_TAG,
-#else
- Lisp_Int = 0,
-#endif
+ Lisp_Int1 = USE_LSB_TAG ? 1 << INTTYPEBITS : 1,
/* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
Lisp_Symbol = 2,
/* String. XSTRING (object) points to a struct Lisp_String.
The length of the string, and its contents, are stored therein. */
- Lisp_String = LISP_STRING_TAG,
+ Lisp_String = USE_LSB_TAG ? 1 : 1 << INTTYPEBITS,
/* Vector of Lisp objects, or something resembling it.
XVECTOR (object) points to a struct Lisp_Vector, which contains
Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
};
-#ifdef USE_LISP_UNION_TYPE
-
-#ifndef WORDS_BIGENDIAN
+#ifdef CHECK_LISP_OBJECT_TYPE
-/* Definition of Lisp_Object for little-endian machines. */
+typedef struct { EMACS_INT i; } Lisp_Object;
-typedef
-union Lisp_Object
- {
- /* Used for comparing two Lisp_Objects;
- also, positive integers can be accessed fast this way. */
- EMACS_INT i;
-
- struct
- {
- /* Use explicit signed, the signedness of a bit-field of type
- int is implementation defined. */
- signed EMACS_INT val : VALBITS;
- ENUM_BF (Lisp_Type) type : GCTYPEBITS;
- } s;
- struct
- {
- EMACS_UINT val : VALBITS;
- ENUM_BF (Lisp_Type) type : GCTYPEBITS;
- } u;
- }
-Lisp_Object;
-
-#else /* If WORDS_BIGENDIAN */
-
-typedef
-union Lisp_Object
- {
- /* Used for comparing two Lisp_Objects;
- also, positive integers can be accessed fast this way. */
- EMACS_INT i;
-
- struct
- {
- ENUM_BF (Lisp_Type) type : GCTYPEBITS;
- /* Use explicit signed, the signedness of a bit-field of type
- int is implementation defined. */
- signed EMACS_INT val : VALBITS;
- } s;
- struct
- {
- ENUM_BF (Lisp_Type) type : GCTYPEBITS;
- EMACS_UINT val : VALBITS;
- } u;
- }
-Lisp_Object;
-
-#endif /* WORDS_BIGENDIAN */
+#define XLI(o) (o).i
+LISP_INLINE Lisp_Object
+XIL (EMACS_INT i)
+{
+ Lisp_Object o = { i };
+ return o;
+}
-#ifdef __GNUC__
-static inline Lisp_Object
+LISP_INLINE Lisp_Object
LISP_MAKE_RVALUE (Lisp_Object o)
{
return o;
}
-#else
-/* This is more portable to pre-C99 non-GCC compilers, but for
- backwards compatibility GCC still accepts an old GNU extension
- which caused this to only generate a warning. */
-#define LISP_MAKE_RVALUE(o) (0 ? (o) : (o))
-#endif
-#else /* USE_LISP_UNION_TYPE */
+#define LISP_INITIALLY_ZERO {0}
+
+#undef CHECK_LISP_OBJECT_TYPE
+enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 1 };
+#else /* CHECK_LISP_OBJECT_TYPE */
-/* If union type is not wanted, define Lisp_Object as just a number. */
+/* If a struct type is not wanted, define Lisp_Object as just a number. */
typedef EMACS_INT Lisp_Object;
-#define LISP_MAKE_RVALUE(o) (0+(o))
-#endif /* USE_LISP_UNION_TYPE */
+#define XLI(o) (o)
+#define XIL(i) (i)
+#define LISP_MAKE_RVALUE(o) (0 + (o))
+#define LISP_INITIALLY_ZERO 0
+enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 };
+#endif /* CHECK_LISP_OBJECT_TYPE */
-/* In the size word of a vector, this bit means the vector has been marked.
- (Shift -1 left, not 1, to avoid provoking overflow diagnostics.) */
+/* In the size word of a vector, this bit means the vector has been marked. */
-#define ARRAY_MARK_FLAG ((EMACS_INT) -1 << (BITS_PER_EMACS_INT - 1))
+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. */
-#define PSEUDOVECTOR_FLAG ((EMACS_INT) 1 << (BITS_PER_EMACS_INT - 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
It is not crucial, but there are plenty of bits here, so why not do it? */
enum pvec_type
{
- PVEC_NORMAL_VECTOR = 0,
- PVEC_PROCESS = 0x200,
- PVEC_FRAME = 0x400,
- PVEC_COMPILED = 0x800,
- PVEC_WINDOW = 0x1000,
- PVEC_WINDOW_CONFIGURATION = 0x2000,
- PVEC_SUBR = 0x4000,
- PVEC_CHAR_TABLE = 0x8000,
- PVEC_BOOL_VECTOR = 0x10000,
- PVEC_BUFFER = 0x20000,
- PVEC_HASH_TABLE = 0x40000,
- PVEC_TERMINAL = 0x80000,
- PVEC_SUB_CHAR_TABLE = 0x100000,
- PVEC_FONT = 0x200000,
- PVEC_OTHER = 0x400000,
- PVEC_TYPE_MASK = 0x7ffe00
-
-#if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
- GDB. It doesn't work on OS Alpha. Moved to a variable in
- emacs.c. */
- PVEC_FLAG = PSEUDOVECTOR_FLAG
-#endif
+ PVEC_NORMAL_VECTOR = 0, /* Unused! */
+ PVEC_FREE,
+ PVEC_PROCESS,
+ PVEC_FRAME,
+ PVEC_WINDOW,
+ PVEC_BOOL_VECTOR,
+ PVEC_BUFFER,
+ PVEC_HASH_TABLE,
+ PVEC_TERMINAL,
+ PVEC_WINDOW_CONFIGURATION,
+ PVEC_SUBR,
+ PVEC_OTHER,
+ /* These last 4 are special because we OR them in fns.c:internal_equal,
+ so they have to use a disjoint bit pattern:
+ if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE
+ | PVEC_SUB_CHAR_TABLE | PVEC_FONT))) */
+ PVEC_COMPILED = 0x10,
+ PVEC_CHAR_TABLE = 0x20,
+ PVEC_SUB_CHAR_TABLE = 0x30,
+ PVEC_FONT = 0x40
};
-/* For convenience, we also store the number of elements in these bits.
- Note that this size is not necessarily the memory-footprint size, but
- only the number of Lisp_Object fields (that need to be traced by the GC).
- The distinction is used e.g. by Lisp_Process which places extra
- non-Lisp_Object fields at the end of the structure. */
-#define PSEUDOVECTOR_SIZE_MASK 0x1ff
+/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
+ which were stored in a Lisp_Object. */
+#ifndef DATA_SEG_BITS
+# define DATA_SEG_BITS 0
+#endif
+enum { gdb_DATA_SEG_BITS = DATA_SEG_BITS };
+#undef DATA_SEG_BITS
-/* Number of bits to put in each character in the internal representation
- of bool vectors. This should not vary across implementations. */
-#define BOOL_VECTOR_BITS_PER_CHAR 8
+enum More_Lisp_Bits
+ {
+ DATA_SEG_BITS = gdb_DATA_SEG_BITS,
+
+ /* For convenience, we also store the number of elements in these bits.
+ Note that this size is not necessarily the memory-footprint size, but
+ only the number of Lisp_Object fields (that need to be traced by GC).
+ The distinction is used, e.g., by Lisp_Process, which places extra
+ non-Lisp_Object fields at the end of the structure. */
+ PSEUDOVECTOR_SIZE_BITS = 16,
+ PSEUDOVECTOR_SIZE_MASK = (1 << PSEUDOVECTOR_SIZE_BITS) - 1,
+ PVEC_TYPE_MASK = 0x0fff << PSEUDOVECTOR_SIZE_BITS,
+
+ /* Number of bits to put in each character in the internal representation
+ of bool vectors. This should not vary across implementations. */
+ BOOL_VECTOR_BITS_PER_CHAR = 8
+ };
\f
/* These macros extract various sorts of values from a Lisp_Object.
For example, if tem is a Lisp_Object whose type is Lisp_Cons,
XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
-#ifndef USE_LISP_UNION_TYPE
-
/* Return a perfect hash of the Lisp_Object representation. */
-#define XHASH(a) (a)
+#define XHASH(a) XLI (a)
-#ifdef USE_LSB_TAG
+#if USE_LSB_TAG
-#define TYPEMASK ((((EMACS_INT) 1) << GCTYPEBITS) - 1)
-#define XTYPE(a) ((enum Lisp_Type) ((a) & TYPEMASK))
-#ifdef USE_2_TAGS_FOR_INTS
-# define XINT(a) (((EMACS_INT) (a)) >> (GCTYPEBITS - 1))
-# define XUINT(a) (((EMACS_UINT) (a)) >> (GCTYPEBITS - 1))
-# define make_number(N) (((EMACS_INT) (N)) << (GCTYPEBITS - 1))
-#else
-# define XINT(a) (((EMACS_INT) (a)) >> GCTYPEBITS)
-# define XUINT(a) (((EMACS_UINT) (a)) >> GCTYPEBITS)
-# define make_number(N) (((EMACS_INT) (N)) << GCTYPEBITS)
-#endif
-#define XSET(var, type, ptr) \
- (eassert (XTYPE ((intptr_t) (ptr)) == 0), /* Check alignment. */ \
- (var) = (type) | (intptr_t) (ptr))
+enum lsb_bits
+ {
+ TYPEMASK = (1 << GCTYPEBITS) - 1,
+ VALMASK = ~ TYPEMASK
+ };
+#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK))
+#define XINT(a) (XLI (a) >> INTTYPEBITS)
+#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS)
+#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS)
+#define make_lisp_ptr(ptr, type) \
+ (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \
+ XIL ((type) | (intptr_t) (ptr)))
-#define XPNTR(a) ((intptr_t) ((a) & ~TYPEMASK))
+#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK))
+#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type)))
#else /* not USE_LSB_TAG */
-#define VALMASK ((((EMACS_INT) 1) << VALBITS) - 1)
+static EMACS_INT const VALMASK
+#define VALMASK VAL_MAX
+ = VALMASK;
-/* One need to override this if there must be high bits set in data space
- (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work
- on all machines, but would penalize machines which don't need it)
- */
-#define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) (a)) >> VALBITS))
+#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS))
/* For integers known to be positive, XFASTINT provides fast retrieval
and XSETFASTINT provides fast storage. This takes advantage of the
- fact that Lisp_Int is 0. */
-#define XFASTINT(a) ((a) + 0)
-#define XSETFASTINT(a, b) ((a) = (b))
+ fact that Lisp integers have zero-bits in their tags. */
+#define XFASTINT(a) (XLI (a) + 0)
+#define XSETFASTINT(a, b) ((a) = XIL (b))
/* Extract the value of a Lisp_Object as a (un)signed integer. */
-#ifdef USE_2_TAGS_FOR_INTS
-# define XINT(a) ((((EMACS_INT) (a)) << (GCTYPEBITS - 1)) >> (GCTYPEBITS - 1))
-# define XUINT(a) ((EMACS_UINT) ((a) & (1 + (VALMASK << 1))))
-# define make_number(N) ((((EMACS_INT) (N)) & (1 + (VALMASK << 1))))
-#else
-# define XINT(a) ((((EMACS_INT) (a)) << (BITS_PER_EMACS_INT - VALBITS)) \
- >> (BITS_PER_EMACS_INT - VALBITS))
-# define XUINT(a) ((EMACS_UINT) ((a) & VALMASK))
-# define make_number(N) \
- ((((EMACS_INT) (N)) & VALMASK) | ((EMACS_INT) Lisp_Int) << VALBITS)
-#endif
+#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS)
+#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK))
+#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK)
-#define XSET(var, type, ptr) \
- ((var) = ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
- + ((intptr_t) (ptr) & VALMASK)))
+#define make_lisp_ptr(ptr, type) \
+ (XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
+ + ((intptr_t) (ptr) & VALMASK)))
-#ifdef DATA_SEG_BITS
+#if DATA_SEG_BITS
/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
- which were stored in a Lisp_Object */
-#define XPNTR(a) ((uintptr_t) (((a) & VALMASK)) | DATA_SEG_BITS))
+ which were stored in a Lisp_Object. */
+#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK)) | DATA_SEG_BITS))
#else
-#define XPNTR(a) ((uintptr_t) ((a) & VALMASK))
+#define XPNTR(a) ((uintptr_t) (XLI (a) & VALMASK))
#endif
#endif /* not USE_LSB_TAG */
-#else /* USE_LISP_UNION_TYPE */
-
-#ifdef USE_2_TAGS_FOR_INTS
-# error "USE_2_TAGS_FOR_INTS is not supported with USE_LISP_UNION_TYPE"
-#endif
-
-#define XHASH(a) ((a).i)
-#define XTYPE(a) ((enum Lisp_Type) (a).u.type)
-#define XINT(a) ((EMACS_INT) (a).s.val)
-#define XUINT(a) ((EMACS_UINT) (a).u.val)
-
-#ifdef USE_LSB_TAG
-
-# define XSET(var, vartype, ptr) \
- (eassert ((((uintptr_t) (ptr)) & ((1 << GCTYPEBITS) - 1)) == 0), \
- (var).u.val = ((uintptr_t) (ptr)) >> GCTYPEBITS, \
- (var).u.type = ((char) (vartype)))
-
-/* Some versions of gcc seem to consider the bitfield width when issuing
- the "cast to pointer from integer of different size" warning, so the
- cast is here to widen the value back to its natural size. */
-# define XPNTR(v) ((intptr_t) (v).s.val << GCTYPEBITS)
-
-#else /* !USE_LSB_TAG */
-
-/* For integers known to be positive, XFASTINT provides fast retrieval
- and XSETFASTINT provides fast storage. This takes advantage of the
- fact that Lisp_Int is 0. */
-# define XFASTINT(a) ((a).i + 0)
-# define XSETFASTINT(a, b) ((a).i = (b))
-
-# define XSET(var, vartype, ptr) \
- (((var).s.val = ((intptr_t) (ptr))), ((var).s.type = ((char) (vartype))))
-
-#ifdef DATA_SEG_BITS
-/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
- which were stored in a Lisp_Object */
-#define XPNTR(a) ((intptr_t) (XUINT (a) | DATA_SEG_BITS))
-#else
-#define XPNTR(a) ((intptr_t) XUINT (a))
-#endif
-
-#endif /* !USE_LSB_TAG */
-
-#if __GNUC__ >= 2 && defined (__OPTIMIZE__)
-#define make_number(N) \
- (__extension__ ({ Lisp_Object _l; _l.s.val = (N); _l.s.type = Lisp_Int; _l; }))
-#else
-extern Lisp_Object make_number (EMACS_INT);
-#endif
-
-#endif /* USE_LISP_UNION_TYPE */
-
/* For integers known to be positive, XFASTINT sometimes provides
faster retrieval and XSETFASTINT provides faster storage.
If not, fallback on the non-accelerated path. */
# define XSETFASTINT(a, b) (XSETINT (a, b))
#endif
-#define EQ(x, y) (XHASH (x) == XHASH (y))
-
-/* Number of bits in a fixnum, including the sign bit. */
-#ifdef USE_2_TAGS_FOR_INTS
-# define FIXNUM_BITS (VALBITS + 1)
-#else
-# define FIXNUM_BITS VALBITS
+/* Extract the pointer value of the Lisp object A, under the
+ assumption that A's type is TYPE. This is a fallback
+ implementation if nothing faster is available. */
+#ifndef XUNTAG
+# define XUNTAG(a, type) XPNTR (a)
#endif
-/* Mask indicating the significant bits of a fixnum. */
-#define INTMASK (((EMACS_INT) 1 << FIXNUM_BITS) - 1)
+#define EQ(x, y) (XHASH (x) == XHASH (y))
/* Largest and smallest representable fixnum values. These are the C
- values. */
-#define MOST_POSITIVE_FIXNUM (INTMASK / 2)
+ values. They are macros for use in static initializers, and
+ constants for visibility to GDB. */
+static EMACS_INT const MOST_POSITIVE_FIXNUM =
+#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
+ MOST_POSITIVE_FIXNUM;
+static EMACS_INT const MOST_NEGATIVE_FIXNUM =
#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
+ MOST_NEGATIVE_FIXNUM;
/* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
written this way so that it also works if I is of unsigned
#define FIXNUM_OVERFLOW_P(i) \
(! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
+LISP_INLINE ptrdiff_t
+clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
+{
+ return num < lower ? lower : num <= upper ? num : upper;
+}
+
/* Extract a value or address from a Lisp_Object. */
-#define XCONS(a) (eassert (CONSP (a)), (struct Lisp_Cons *) XPNTR (a))
-#define XVECTOR(a) (eassert (VECTORLIKEP (a)), (struct Lisp_Vector *) XPNTR (a))
-#define XSTRING(a) (eassert (STRINGP (a)), (struct Lisp_String *) XPNTR (a))
-#define XSYMBOL(a) (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XPNTR (a))
-#define XFLOAT(a) (eassert (FLOATP (a)), (struct Lisp_Float *) XPNTR (a))
+#define XCONS(a) (eassert (CONSP (a)), \
+ (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
+#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \
+ (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike))
+#define XSTRING(a) (eassert (STRINGP (a)), \
+ (struct Lisp_String *) XUNTAG (a, Lisp_String))
+#define XSYMBOL(a) (eassert (SYMBOLP (a)), \
+ (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
+#define XFLOAT(a) (eassert (FLOATP (a)), \
+ (struct Lisp_Float *) XUNTAG (a, Lisp_Float))
/* Misc types. */
-#define XMISC(a) ((union Lisp_Misc *) XPNTR (a))
+#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc))
#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any))
#define XMISCTYPE(a) (XMISCANY (a)->type)
#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker))
/* Pseudovector types. */
-#define XPROCESS(a) (eassert (PROCESSP (a)), (struct Lisp_Process *) XPNTR (a))
-#define XWINDOW(a) (eassert (WINDOWP (a)), (struct window *) XPNTR (a))
-#define XTERMINAL(a) (eassert (TERMINALP (a)), (struct terminal *) XPNTR (a))
-#define XSUBR(a) (eassert (SUBRP (a)), (struct Lisp_Subr *) XPNTR (a))
-#define XBUFFER(a) (eassert (BUFFERP (a)), (struct buffer *) XPNTR (a))
-#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR (a))
-#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR (a))
-#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR (a))
+#define XPROCESS(a) (eassert (PROCESSP (a)), \
+ (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike))
+#define XWINDOW(a) (eassert (WINDOWP (a)), \
+ (struct window *) XUNTAG (a, Lisp_Vectorlike))
+#define XTERMINAL(a) (eassert (TERMINALP (a)), \
+ (struct terminal *) XUNTAG (a, Lisp_Vectorlike))
+#define XSUBR(a) (eassert (SUBRP (a)), \
+ (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike))
+#define XBUFFER(a) (eassert (BUFFERP (a)), \
+ (struct buffer *) XUNTAG (a, Lisp_Vectorlike))
+#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \
+ (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike))
+#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \
+ ((struct Lisp_Sub_Char_Table *) \
+ XUNTAG (a, Lisp_Vectorlike)))
+#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \
+ ((struct Lisp_Bool_Vector *) \
+ XUNTAG (a, Lisp_Vectorlike)))
/* Construct a Lisp_Object from a value or address. */
-#define XSETINT(a, b) (a) = make_number (b)
-#define XSETCONS(a, b) XSET (a, Lisp_Cons, b)
-#define XSETVECTOR(a, b) XSET (a, Lisp_Vectorlike, b)
-#define XSETSTRING(a, b) XSET (a, Lisp_String, b)
-#define XSETSYMBOL(a, b) XSET (a, Lisp_Symbol, b)
-#define XSETFLOAT(a, b) XSET (a, Lisp_Float, b)
+#define XSETINT(a, b) ((a) = make_number (b))
+#define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons))
+#define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike))
+#define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String))
+#define XSETSYMBOL(a, b) ((a) = make_lisp_ptr (b, Lisp_Symbol))
+#define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float))
/* Misc types. */
-#define XSETMISC(a, b) XSET (a, Lisp_Misc, b)
+#define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc))
#define XSETMARKER(a, b) (XSETMISC (a, b), XMISCTYPE (a) = Lisp_Misc_Marker)
/* Pseudovector types. */
#define XSETPVECTYPE(v, code) XSETTYPED_PVECTYPE (v, header.size, code)
#define XSETTYPED_PVECTYPE(v, size_member, code) \
- ((v)->size_member |= PSEUDOVECTOR_FLAG | (code))
+ ((v)->size_member |= PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS))
#define XSETPVECTYPESIZE(v, code, sizeval) \
- ((v)->header.size = PSEUDOVECTOR_FLAG | (code) | (sizeval))
+ ((v)->header.size = (PSEUDOVECTOR_FLAG \
+ | ((code) << PSEUDOVECTOR_SIZE_BITS) \
+ | (sizeval)))
/* The cast to struct vectorlike_header * avoids aliasing issues. */
#define XSETPSEUDOVECTOR(a, b, code) \
- XSETTYPED_PSEUDOVECTOR(a, b, \
- ((struct vectorlike_header *) XPNTR (a))->size, \
- code)
+ XSETTYPED_PSEUDOVECTOR (a, b, \
+ (((struct vectorlike_header *) \
+ XUNTAG (a, Lisp_Vectorlike)) \
+ ->size), \
+ code)
#define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \
(XSETVECTOR (a, b), \
eassert ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
- == (PSEUDOVECTOR_FLAG | (code))))
+ == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_SIZE_BITS))))
#define XSETWINDOW_CONFIGURATION(a, b) \
(XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX]
#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size
-/* The IDX==IDX tries to detect when the macro argument is side-effecting. */
#define ASET(ARRAY, IDX, VAL) \
- (eassert ((IDX) == (IDX)), \
- eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \
- AREF ((ARRAY), (IDX)) = (VAL))
+ (eassert (0 <= (IDX) && (IDX) < ASIZE (ARRAY)), \
+ XVECTOR (ARRAY)->contents[IDX] = (VAL))
/* Convenience macros for dealing with Lisp strings. */
#define CHECK_TYPE(ok, Qxxxp, x) \
do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0)
+/* Deprecated and will be removed soon. */
+
+#define INTERNAL_FIELD(field) field ## _
-\f
/* See the macros in intervals.h. */
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)
-\f
-/* In a cons, the markbit of the car is the gc mark bit */
-
struct Lisp_Cons
{
- /* Please do not use the names of these elements in code other
- than the core lisp implementation. Use XCAR and XCDR below. */
-#ifdef HIDE_LISP_IMPLEMENTATION
- Lisp_Object car_;
- union
- {
- Lisp_Object cdr_;
- struct Lisp_Cons *chain;
- } u;
-#else
+ /* Car of this cons cell. */
Lisp_Object car;
+
union
{
+ /* Cdr of this cons cell. */
Lisp_Object cdr;
+
+ /* Used to chain conses on a free list. */
struct Lisp_Cons *chain;
} u;
-#endif
};
/* Take the car or cdr of something known to be a cons cell. */
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.) */
-#ifdef HIDE_LISP_IMPLEMENTATION
-#define XCAR_AS_LVALUE(c) (XCONS ((c))->car_)
-#define XCDR_AS_LVALUE(c) (XCONS ((c))->u.cdr_)
-#else
-#define XCAR_AS_LVALUE(c) (XCONS ((c))->car)
-#define XCDR_AS_LVALUE(c) (XCONS ((c))->u.cdr)
-#endif
+#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))
#define CDR_SAFE(c) \
(CONSP ((c)) ? XCDR ((c)) : Qnil)
-/* Nonzero if STR is a multibyte string. */
+/* True if STR is a multibyte string. */
#define STRING_MULTIBYTE(STR) \
(XSTRING (STR)->size_byte >= 0)
#ifdef GC_CHECK_STRING_BYTES
struct Lisp_String;
-extern EMACS_INT string_bytes (struct Lisp_String *);
+extern ptrdiff_t string_bytes (struct Lisp_String *);
#define STRING_BYTES(S) string_bytes ((S))
#else /* not GC_CHECK_STRING_BYTES */
Although the actual size limit (see STRING_BYTES_MAX in alloc.c)
may be a bit smaller than STRING_BYTES_BOUND, calculating it here
would expose alloc.c internal details that we'd rather keep
- private. The cast to ptrdiff_t ensures that STRING_BYTES_BOUND is
- signed. */
+ private.
+
+ This is a macro for use in static initializers, and a constant for
+ visibility to GDB. The cast to ptrdiff_t ensures that
+ the macro is signed. */
+static ptrdiff_t const STRING_BYTES_BOUND =
#define STRING_BYTES_BOUND \
- min (MOST_POSITIVE_FIXNUM, (ptrdiff_t) min (SIZE_MAX, PTRDIFF_MAX) - 1)
+ ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, min (SIZE_MAX, PTRDIFF_MAX) - 1))
+ STRING_BYTES_BOUND;
/* Mark STR as a unibyte string. */
#define STRING_SET_UNIBYTE(STR) \
(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 */
+/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
struct Lisp_String
{
- EMACS_INT size;
- EMACS_INT size_byte;
- INTERVAL intervals; /* text properties in this string */
+ ptrdiff_t size;
+ ptrdiff_t size_byte;
+ INTERVAL intervals; /* Text properties in this string. */
unsigned char *data;
};
<http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */
struct vectorlike_header
{
- EMACS_INT size;
-
- /* Pointer to the next vector-like object. It is generally a buffer or a
+ /* This field contains various pieces of information:
+ - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
+ - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
+ vector (0) or a pseudovector (1).
+ - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number
+ of slots) of the vector.
+ - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into
+ a "pvec type" tag held in PVEC_TYPE_MASK and a size held in the lowest
+ PSEUDOVECTOR_SIZE_BITS. That size normally indicates the number of
+ Lisp_Object slots at the beginning of the object that need to be
+ traced by the GC, tho some types use it slightly differently.
+ - E.g. if the pvec type is PVEC_FREE it means this is an unallocated
+ vector on a free-list and PSEUDOVECTOR_SIZE_BITS indicates its size
+ in bytes. */
+ ptrdiff_t size;
+
+ /* When the vector is allocated from a vector block, NBYTES is used
+ if the vector is not on a free list, and VECTOR is used otherwise.
+ For large vector-like objects, BUFFER or VECTOR is used as a pointer
+ to the next vector-like object. It is generally a buffer or a
Lisp_Vector alias, so for convenience it is a union instead of a
pointer: this way, one can write P->next.vector instead of ((struct
Lisp_Vector *) P->next). */
union {
+ /* This is only needed for small vectors that are not free because the
+ `size' field only gives us the number of Lisp_Object slots, whereas we
+ need to know the total size, including non-Lisp_Object data.
+ FIXME: figure out a way to store this info elsewhere so we can
+ finally get rid of this extra word of overhead. */
+ ptrdiff_t nbytes;
struct buffer *buffer;
+ /* FIXME: This can be removed: For large vectors, this field could be
+ placed *before* the vector itself. And for small vectors on a free
+ list, this field could be stored in the vector's bytes, since the
+ empty vector is handled specially anyway. */
struct Lisp_Vector *vector;
} 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
of a char-table, and there's no way to access it directly from
Emacs Lisp program. */
-/* This is the number of slots that every char table must have. This
- counts the ordinary slots and the top, defalt, parent, and purpose
- slots. */
-#define CHAR_TABLE_STANDARD_SLOTS (VECSIZE (struct Lisp_Char_Table) - 1)
-
-/* Return the number of "extra" slots in the char table CT. */
-
-#define CHAR_TABLE_EXTRA_SLOTS(CT) \
- (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
-
#ifdef __GNUC__
#define CHAR_TABLE_REF_ASCII(CT, IDX) \
(ASCII_CHAR_P (IDX) ? CHAR_TABLE_REF_ASCII ((CT), (IDX)) \
: char_table_ref ((CT), (IDX)))
-/* Almost equivalent to Faref (CT, IDX). However, if the result is
- not a character, return IDX.
-
- For these characters, do not check validity of CT
- and do not follow parent. */
-#define CHAR_TABLE_TRANSLATE(CT, IDX) \
- char_table_translate (CT, IDX)
-
/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
8-bit European characters. Do not check validity of CT. */
#define CHAR_TABLE_SET(CT, IDX, VAL) \
(ASCII_CHAR_P (IDX) && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
- ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] = VAL \
+ ? set_sub_char_table_contents (XCHAR_TABLE (CT)->ascii, IDX, VAL) \
: char_table_set (CT, IDX, VAL))
-#define CHARTAB_SIZE_BITS_0 6
-#define CHARTAB_SIZE_BITS_1 4
-#define CHARTAB_SIZE_BITS_2 5
-#define CHARTAB_SIZE_BITS_3 7
+enum CHARTAB_SIZE_BITS
+ {
+ CHARTAB_SIZE_BITS_0 = 6,
+ CHARTAB_SIZE_BITS_1 = 4,
+ CHARTAB_SIZE_BITS_2 = 5,
+ CHARTAB_SIZE_BITS_3 = 7
+ };
extern const int chartab_size[4];
-struct Lisp_Sub_Char_Table;
-
struct Lisp_Char_Table
{
/* HEADER.SIZE is the vector's size field, which also holds the
/* Minimum character covered by the sub char-table. */
Lisp_Object min_char;
+ /* Use set_sub_char_table_contents to set this. */
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.
struct Lisp_Subr
{
- EMACS_INT size;
+ ptrdiff_t size;
union {
Lisp_Object (*a0) (void);
Lisp_Object (*a1) (Lisp_Object);
const char *doc;
};
+/* This is the number of slots that every char table must have. This
+ counts the ordinary slots and the top, defalt, parent, and purpose
+ slots. */
+enum CHAR_TABLE_STANDARD_SLOTS
+ {
+ CHAR_TABLE_STANDARD_SLOTS = VECSIZE (struct Lisp_Char_Table) - 1
+ };
+
+/* Return the number of "extra" slots in the char table CT. */
+
+#define CHAR_TABLE_EXTRA_SLOTS(CT) \
+ (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
+
\f
/***********************************************************************
Symbols
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 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. */
/* Value is name of symbol. */
-#define SYMBOL_VAL(sym) \
- (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (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) \
+#define SET_SYMBOL_VAL(sym, v) \
(eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
-#define SET_SYMBOL_ALIAS(sym, 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 (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)
\f
a special way (e.g. because of weakness). */
/* Number of key/value entries in the table. */
- EMACS_INT count;
+ ptrdiff_t count;
/* Vector of keys and values. The key of item I is found at index
2 * I, the value is found at index 2 * I + 1.
struct Lisp_Hash_Table *next_weak;
/* C function to compare two keys. */
- int (*cmpfn) (struct Lisp_Hash_Table *,
- Lisp_Object, EMACS_UINT,
- Lisp_Object, EMACS_UINT);
+ bool (*cmpfn) (struct Lisp_Hash_Table *,
+ Lisp_Object, EMACS_UINT,
+ Lisp_Object, EMACS_UINT);
/* C function to compute hash code. */
EMACS_UINT (*hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
#define XHASH_TABLE(OBJ) \
- ((struct Lisp_Hash_Table *) XPNTR (OBJ))
+ ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike))
#define XSET_HASH_TABLE(VAR, PTR) \
(XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
/* Default size for hash tables if not specified. */
-#define DEFAULT_HASH_SIZE 65
+enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 };
/* Default threshold specifying when to resize a hash table. The
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
+static double const DEFAULT_REHASH_SIZE = 1.5;
-\f
/* These structures are used for various misc types. */
struct Lisp_Misc_Any /* Supertype of all Misc types. */
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */
unsigned gcmarkbit : 1;
int spacer : 15;
- /* Make it as long as "Lisp_Free without padding". */
- void *fill;
};
struct Lisp_Marker
That would also allow to preserve it ordered. */
struct Lisp_Marker *next;
/* This is the char position where the marker points. */
- EMACS_INT charpos;
+ ptrdiff_t charpos;
/* This is the byte position.
It's mostly used as a charpos<->bytepos cache (i.e. it's not directly
used to implement the functionality of markers, but rather to (ab)use
markers as a cache for char<->byte mappings). */
- EMACS_INT bytepos;
+ ptrdiff_t bytepos;
};
+/* START and END are markers in the overlay's buffer, and
+ PLIST is the overlay's property list. */
+struct Lisp_Overlay
+/* An overlay's real data content is:
+ - plist
+ - buffer (really there are two buffer pointers, one per marker,
+ and both points to the same buffer)
+ - insertion type of both ends (per-marker fields)
+ - start & start byte (of start marker)
+ - end & end byte (of end marker)
+ - next (singly linked list of overlays)
+ - next fields of start and end markers (singly linked list of markers).
+ I.e. 9words plus 2 bits, 3words of which are for external linked lists.
+*/
+ {
+ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
+ struct Lisp_Overlay *next;
+ Lisp_Object start;
+ Lisp_Object end;
+ Lisp_Object plist;
+ };
+
+/* Hold a C pointer for later use.
+ This type of object is used in the arg to record_unwind_protect. */
+struct Lisp_Save_Value
+ {
+ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
+ unsigned gcmarkbit : 1;
+ int spacer : 14;
+ /* If DOGC is set, POINTER is the address of a memory
+ area containing INTEGER potential Lisp_Objects. */
+ unsigned int dogc : 1;
+ void *pointer;
+ ptrdiff_t integer;
+ };
+
+
+/* A miscellaneous object, when it's on the free list. */
+struct Lisp_Free
+ {
+ ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
+ union Lisp_Misc *chain;
+ };
+
+/* To get the type field of a union Lisp_Misc, use XMISCTYPE.
+ It uses one of these struct subtypes to get the type field. */
+
+union Lisp_Misc
+ {
+ struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */
+ struct Lisp_Free u_free;
+ struct Lisp_Marker u_marker;
+ struct Lisp_Overlay u_overlay;
+ struct Lisp_Save_Value u_save_value;
+ };
+
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
and it means that the symbol's value really lives in the
struct Lisp_Boolfwd
{
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
- int *boolvar;
+ bool *boolvar;
};
/* Forwarding pointer to a Lisp_Object variable.
struct Lisp_Buffer_Local_Value
{
/* 1 means that merely setting the variable creates a local
- binding for the current buffer */
+ binding for the current buffer. */
unsigned int local_if_set : 1;
/* 1 means this variable can have frame-local bindings, otherwise, it is
can have buffer-local bindings. The two cannot be combined. */
unsigned int frame_local : 1;
/* 1 means that the binding now loaded was found.
- Presumably equivalent to (defcell!=valcell) */
+ Presumably equivalent to (defcell!=valcell). */
unsigned int found : 1;
/* If non-NULL, a forwarding to the C var where it should also be set. */
union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
Lisp_Object valcell;
};
-#define BLV_FOUND(blv) \
- (eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found)
-#define SET_BLV_FOUND(blv, v) \
- (eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v))
-
-#define BLV_VALUE(blv) (XCDR ((blv)->valcell))
-#define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v))
-
-/* START and END are markers in the overlay's buffer, and
- PLIST is the overlay's property list. */
-struct Lisp_Overlay
-/* An overlay's real data content is:
- - plist
- - buffer
- - insertion type of both ends
- - start & start_byte
- - end & end_byte
- - next (singly linked list of overlays).
- - start_next and end_next (singly linked list of markers).
- I.e. 9words plus 2 bits, 3words of which are for external linked lists.
-*/
- {
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */
- unsigned gcmarkbit : 1;
- int spacer : 15;
- struct Lisp_Overlay *next;
- Lisp_Object start, end, plist;
- };
-
/* Like Lisp_Objfwd except that value lives in a slot in the
current kboard. */
struct Lisp_Kboard_Objfwd
int offset;
};
-/* Hold a C pointer for later use.
- This type of object is used in the arg to record_unwind_protect. */
-struct Lisp_Save_Value
- {
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
- unsigned gcmarkbit : 1;
- int spacer : 14;
- /* If DOGC is set, POINTER is the address of a memory
- area containing INTEGER potential Lisp_Objects. */
- unsigned int dogc : 1;
- void *pointer;
- ptrdiff_t integer;
- };
-
-
-/* A miscellaneous object, when it's on the free list. */
-struct Lisp_Free
- {
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */
- unsigned gcmarkbit : 1;
- int spacer : 15;
- union Lisp_Misc *chain;
-#ifdef USE_LSB_TAG
- /* Try to make sure that sizeof(Lisp_Misc) preserves TYPEBITS-alignment.
- This assumes that Lisp_Marker is the largest of the alternatives and
- that Lisp_Misc_Any has the same size as "Lisp_Free w/o padding". */
- char padding[((((sizeof (struct Lisp_Marker) - 1) >> GCTYPEBITS) + 1)
- << GCTYPEBITS) - sizeof (struct Lisp_Misc_Any)];
-#endif
- };
-
-/* To get the type field of a union Lisp_Misc, use XMISCTYPE.
- It uses one of these struct subtypes to get the type field. */
-
-union Lisp_Misc
- {
- struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */
- struct Lisp_Free u_free; /* Includes padding to force alignment. */
- struct Lisp_Marker u_marker; /* 5 */
- struct Lisp_Overlay u_overlay; /* 5 */
- struct Lisp_Save_Value u_save_value; /* 3 */
- };
-
union Lisp_Fwd
{
- struct Lisp_Intfwd u_intfwd; /* 2 */
- struct Lisp_Boolfwd u_boolfwd; /* 2 */
- struct Lisp_Objfwd u_objfwd; /* 2 */
- struct Lisp_Buffer_Objfwd u_buffer_objfwd; /* 2 */
- struct Lisp_Kboard_Objfwd u_kboard_objfwd; /* 2 */
+ struct Lisp_Intfwd u_intfwd;
+ struct Lisp_Boolfwd u_boolfwd;
+ struct Lisp_Objfwd u_objfwd;
+ struct Lisp_Buffer_Objfwd u_buffer_objfwd;
+ struct Lisp_Kboard_Objfwd u_kboard_objfwd;
};
\f
-/* Lisp floating point type */
+/* Lisp floating point type. */
struct Lisp_Float
{
union
{
-#ifdef HIDE_LISP_IMPLEMENTATION
- double data_;
-#else
double data;
-#endif
struct Lisp_Float *chain;
} u;
};
-#ifdef HIDE_LISP_IMPLEMENTATION
-#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data_ : XFLOAT (f)->u.data_)
-#else
-#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data)
-/* This should be used only in alloc.c, which always disables
- HIDE_LISP_IMPLEMENTATION. */
-#define XFLOAT_INIT(f,n) (XFLOAT (f)->u.data = (n))
-#endif
+#define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data)
+#define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n))
+
+/* Most hosts nowadays use IEEE floating point, so they use IEC 60559
+ representations, have infinities and NaNs, and do not trap on
+ exceptions. Define IEEE_FLOATING_POINT if this host is one of the
+ typical ones. The C11 macro __STDC_IEC_559__ is close to what is
+ wanted here, but is not quite right because Emacs does not require
+ all the features of C11 Annex F (and does not require C11 at all,
+ for that matter). */
+#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
+ && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
/* A character, declared with the following typedef, is a member
of some character set associated with the current buffer. */
/* Meanings of slots in a Lisp_Compiled: */
-#define COMPILED_ARGLIST 0
-#define COMPILED_BYTECODE 1
-#define COMPILED_CONSTANTS 2
-#define COMPILED_STACK_DEPTH 3
-#define COMPILED_DOC_STRING 4
-#define COMPILED_INTERACTIVE 5
+enum Lisp_Compiled
+ {
+ COMPILED_ARGLIST = 0,
+ COMPILED_BYTECODE = 1,
+ COMPILED_CONSTANTS = 2,
+ COMPILED_STACK_DEPTH = 3,
+ COMPILED_DOC_STRING = 4,
+ COMPILED_INTERACTIVE = 5
+ };
/* Flag bits in a character. These also get used in termhooks.h.
Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
(MUlti-Lingual Emacs) might need 22 bits for the character value
itself, so we probably shouldn't use any bits lower than 0x0400000. */
-#define CHAR_ALT (0x0400000)
-#define CHAR_SUPER (0x0800000)
-#define CHAR_HYPER (0x1000000)
-#define CHAR_SHIFT (0x2000000)
-#define CHAR_CTL (0x4000000)
-#define CHAR_META (0x8000000)
-
-#define CHAR_MODIFIER_MASK \
- (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META)
+enum char_bits
+ {
+ CHAR_ALT = 0x0400000,
+ CHAR_SUPER = 0x0800000,
+ CHAR_HYPER = 0x1000000,
+ CHAR_SHIFT = 0x2000000,
+ CHAR_CTL = 0x4000000,
+ CHAR_META = 0x8000000,
+
+ CHAR_MODIFIER_MASK =
+ CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META,
+
+ /* Actually, the current Emacs uses 22 bits for the character value
+ itself. */
+ CHARACTERBITS = 22
+ };
-/* Actually, the current Emacs uses 22 bits for the character value
- itself. */
-#define CHARACTERBITS 22
\f
/* The glyph datatype, used to represent characters on the display.
encodes a char code in the lower CHARACTERBITS bits and a (very small)
face-id in the upper bits, or it may be a cons (CHAR . FACE-ID). */
-#define GLYPH_CODE_CHAR(gc) \
- (CONSP (gc) ? XINT (XCAR (gc)) : INTEGERP (gc) ? (XINT (gc) & ((1 << CHARACTERBITS)-1)) : 0)
+#define GLYPH_CODE_P(gc) \
+ (CONSP (gc) \
+ ? (CHARACTERP (XCAR (gc)) \
+ && RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID)) \
+ : (RANGED_INTEGERP \
+ (0, gc, \
+ (MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS \
+ ? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR \
+ : TYPE_MAXIMUM (EMACS_INT)))))
-#define GLYPH_CODE_FACE(gc) \
- (CONSP (gc) ? XINT (XCDR (gc)) : INTEGERP (gc) ? (XINT (gc) >> CHARACTERBITS) : DEFAULT_FACE_ID)
+/* The following are valid only if GLYPH_CODE_P (gc). */
-/* Return 1 if glyph code from display vector contains valid character code. */
-#define GLYPH_CODE_CHAR_VALID_P(gc) CHAR_VALID_P (GLYPH_CODE_CHAR (gc))
+#define GLYPH_CODE_CHAR(gc) \
+ (CONSP (gc) ? XINT (XCAR (gc)) : XINT (gc) & ((1 << CHARACTERBITS) - 1))
-#define GLYPH_CODE_P(gc) ((CONSP (gc) && INTEGERP (XCAR (gc)) && INTEGERP (XCDR (gc))) || INTEGERP (gc))
+#define GLYPH_CODE_FACE(gc) \
+ (CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS)
-/* Only called when GLYPH_CODE_P (gc) is true. */
#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \
do \
{ \
(XINT (gc) >> CHARACTERBITS)); \
} \
while (0)
-
-/* The ID of the mode line highlighting face. */
-#define GLYPH_MODE_LINE_FACE 1
\f
/* Structure to hold mouse highlight data. This is here because other
header files need it for defining struct x_output etc. */
int mouse_face_image_state;
} Mouse_HLInfo;
\f
-/* Data type checking */
+/* Data type checking. */
#define NILP(x) EQ (x, Qnil)
#define RANGED_INTEGERP(lo, x, hi) \
(INTEGERP (x) && (lo) <= XINT (x) && XINT (x) <= (hi))
#define TYPE_RANGED_INTEGERP(type, x) \
- RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type))
+ (TYPE_SIGNED (type) \
+ ? RANGED_INTEGERP (TYPE_MINIMUM (type), x, TYPE_MAXIMUM (type)) \
+ : RANGED_INTEGERP (0, x, TYPE_MAXIMUM (type)))
#define INTEGERP(x) (LISP_INT_TAG_P (XTYPE ((x))))
#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol)
/* True if object X is a pseudovector whose code is CODE. The cast to struct
vectorlike_header * avoids aliasing issues. */
#define PSEUDOVECTORP(x, code) \
- TYPED_PSEUDOVECTORP(x, vectorlike_header, code)
+ TYPED_PSEUDOVECTORP (x, vectorlike_header, code)
+
+#define PSEUDOVECTOR_TYPEP(v, code) \
+ (((v)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
+ == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_SIZE_BITS)))
/* True if object X, with internal type struct T *, is a pseudovector whose
code is CODE. */
#define TYPED_PSEUDOVECTORP(x, t, code) \
(VECTORLIKEP (x) \
- && (((((struct t *) XPNTR (x))->size \
- & (PSEUDOVECTOR_FLAG | (code)))) \
- == (PSEUDOVECTOR_FLAG | (code))))
+ && PSEUDOVECTOR_TYPEP ((struct t *) XUNTAG (x, Lisp_Vectorlike), code))
/* Test for specific pseudovector types. */
#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION)
#define CHECK_WINDOW_CONFIGURATION(x) \
CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x)
-/* This macro rejects windows on the interior of the window tree as
- "dead", which is what we want; this is an argument-checking macro, and
- the user should never get access to interior windows.
-
- A window of any sort, leaf or interior, is dead if the buffer,
- vchild, and hchild members are all nil. */
+/* A window of any sort, leaf or interior, is "valid" if one of its
+ buffer, vchild, or hchild members is non-nil. */
+#define CHECK_VALID_WINDOW(x) \
+ CHECK_TYPE (WINDOWP (x) \
+ && (!NILP (XWINDOW (x)->buffer) \
+ || !NILP (XWINDOW (x)->vchild) \
+ || !NILP (XWINDOW (x)->hchild)), \
+ Qwindow_valid_p, x)
-#define CHECK_LIVE_WINDOW(x) \
- CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x)
+/* A window is "live" if and only if it shows a buffer. */
+#define CHECK_LIVE_WINDOW(x) \
+ CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), \
+ Qwindow_live_p, x)
#define CHECK_PROCESS(x) \
CHECK_TYPE (PROCESSP (x), Qprocessp, x)
#define CHECK_NATNUM(x) \
CHECK_TYPE (NATNUMP (x), Qwholenump, x)
+#define CHECK_RANGED_INTEGER(x, lo, hi) \
+ do { \
+ CHECK_NUMBER (x); \
+ if (! ((lo) <= XINT (x) && XINT (x) <= (hi))) \
+ args_out_of_range_3 \
+ (x, \
+ make_number ((lo) < 0 && (lo) < MOST_NEGATIVE_FIXNUM \
+ ? MOST_NEGATIVE_FIXNUM \
+ : (lo)), \
+ make_number (min (hi, MOST_POSITIVE_FIXNUM))); \
+ } while (0)
+#define CHECK_TYPE_RANGED_INTEGER(type, x) \
+ do { \
+ if (TYPE_SIGNED (type)) \
+ CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \
+ else \
+ CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
+ } while (0)
+
#define CHECK_MARKER(x) \
CHECK_TYPE (MARKERP (x), Qmarkerp, x)
#ifdef _MSC_VER
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
- static DECL_ALIGN (struct Lisp_Subr, sname) = \
- { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
+ static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
+ { (PVEC_SUBR << PSEUDOVECTOR_SIZE_BITS) \
+ | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
{ (Lisp_Object (__cdecl *)(void))fnname }, \
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
#else /* not _MSC_VER */
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
- static DECL_ALIGN (struct Lisp_Subr, sname) = \
- { PVEC_SUBR, \
+ static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
+ { PVEC_SUBR << PSEUDOVECTOR_SIZE_BITS, \
{ .a ## maxargs = fnname }, \
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
/* Non-zero if OBJ is a Lisp function. */
-#define FUNCTIONP(OBJ) \
- ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \
- || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
- || COMPILEDP (OBJ) \
- || SUBRP (OBJ))
+#define FUNCTIONP(OBJ) functionp(OBJ)
/* defsubr (Sname);
is how we define the symbol for function `name' at start-up time. */
extern void defsubr (struct Lisp_Subr *);
-#define MANY -2
-#define UNEVALLED -1
+enum maxargs
+ {
+ MANY = -2,
+ UNEVALLED = -1
+ };
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);
static struct Lisp_Kboard_Objfwd ko_fwd; \
defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \
} while (0)
-
+\f
+/* Save and restore the instruction and environment pointers,
+ without affecting the signal mask. */
+
+#ifdef HAVE__SETJMP
+typedef jmp_buf sys_jmp_buf;
+# define sys_setjmp(j) _setjmp (j)
+# define sys_longjmp(j, v) _longjmp (j, v)
+#elif defined HAVE_SIGSETJMP
+typedef sigjmp_buf sys_jmp_buf;
+# define sys_setjmp(j) sigsetjmp (j, 0)
+# define sys_longjmp(j, v) siglongjmp (j, v)
+#else
+/* A platform that uses neither _longjmp nor siglongjmp; assume
+ longjmp does not affect the sigmask. */
+typedef jmp_buf sys_jmp_buf;
+# define sys_setjmp(j) setjmp (j)
+# define sys_longjmp(j, v) longjmp (j, v)
+#endif
\f
/* Structure for recording Lisp call stack for backtrace purposes. */
{
Lisp_Object symbol, old_value;
specbinding_func func;
- Lisp_Object unused; /* Dividing by 16 is faster than by 12 */
+ Lisp_Object unused; /* Dividing by 16 is faster than by 12. */
};
extern struct specbinding *specpdl;
extern struct specbinding *specpdl_ptr;
-extern EMACS_INT specpdl_size;
+extern ptrdiff_t specpdl_size;
+
+#define SPECPDL_INDEX() (specpdl_ptr - specpdl)
-#define SPECPDL_INDEX() ((int) (specpdl_ptr - specpdl))
+struct backtrace
+{
+ struct backtrace *next;
+ Lisp_Object *function;
+ Lisp_Object *args; /* Points to vector of args. */
+ ptrdiff_t nargs; /* Length of vector. */
+ /* Nonzero means call value of debugger when done with this operation. */
+ unsigned int debug_on_exit : 1;
+};
+
+extern struct backtrace *backtrace_list;
+
+/* Everything needed to describe an active condition case.
-/* Everything needed to describe an active condition case. */
+ Members are volatile if their values need to survive _longjmp when
+ a 'struct handler' is a local variable. */
struct handler
{
/* The handler clauses and variable from the condition-case form. */
error: handle all conditions, and errors can run the debugger
or display a backtrace. */
Lisp_Object handler;
- Lisp_Object var;
+
+ Lisp_Object volatile var;
+
/* Fsignal stores here the condition-case clause that applies,
and Fcondition_case thus knows which clause to run. */
- Lisp_Object chosen_clause;
+ Lisp_Object volatile chosen_clause;
/* Used to effect the longjump out to the handler. */
struct catchtag *tag;
of the catch form.
All the other members are concerned with restoring the interpreter
- state. */
+ state.
+ Members are volatile if their values need to survive _longjmp when
+ a 'struct catchtag' is a local variable. */
struct catchtag
{
Lisp_Object tag;
- Lisp_Object val;
- struct catchtag *next;
+ Lisp_Object volatile val;
+ struct catchtag *volatile next;
struct gcpro *gcpro;
- jmp_buf jmp;
+ sys_jmp_buf jmp;
struct backtrace *backlist;
struct handler *handlerlist;
- int lisp_eval_depth;
- int pdlcount;
+ EMACS_INT lisp_eval_depth;
+ ptrdiff_t volatile pdlcount;
int poll_suppress_count;
int interrupt_input_blocked;
struct byte_stack *byte_stack;
If quit-flag is set to `kill-emacs' the SIGINT handler has received
a request to exit Emacs when it is safe to do. */
-#ifdef SYNC_INPUT
extern void process_pending_signals (void);
-extern int pending_signals;
-#define ELSE_PENDING_SIGNALS \
- else if (pending_signals) \
- process_pending_signals ();
-#else /* not SYNC_INPUT */
-#define ELSE_PENDING_SIGNALS
-#endif /* not SYNC_INPUT */
+extern int volatile pending_signals;
extern void process_quit_flag (void);
#define QUIT \
do { \
if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
process_quit_flag (); \
- ELSE_PENDING_SIGNALS \
+ else if (pending_signals) \
+ process_pending_signals (); \
} while (0)
extern Lisp_Object Vascii_downcase_table;
extern Lisp_Object Vascii_canon_table;
\f
-/* Number of bytes of structure consed since last GC. */
-
-extern EMACS_INT consing_since_gc;
-
-extern EMACS_INT gc_relative_threshold;
-
-extern EMACS_INT memory_full_cons_threshold;
-
/* Structure for recording stack slots that need marking. */
/* This is a chain of structures, each of which points at a Lisp_Object
#define GC_USE_GCPROS_CHECK_ZOMBIES 3
#ifndef GC_MARK_STACK
-#define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE
+#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
#endif
/* Whether we do the stack marking manually. */
#define UNGCPRO \
((--gcpro_level != gcpro1.level) \
- ? (abort (), 0) \
+ ? (emacs_abort (), 0) \
: ((gcprolist = gcpro1.next), 0))
#endif /* DEBUG_GCPRO */
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;
+}
+
+/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
+
+LISP_INLINE void
+vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
+{
+ eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
+ memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
+}
+
+/* Functions to modify hash tables. */
+
+LISP_INLINE void
+set_hash_key_and_value (struct Lisp_Hash_Table *h, Lisp_Object key_and_value)
+{
+ h->key_and_value = key_and_value;
+}
+
+LISP_INLINE void
+set_hash_key_slot (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_slot (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, Lisp_Object next)
+{
+ h->next = next;
+}
+
+LISP_INLINE void
+set_hash_next_slot (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, Lisp_Object hash)
+{
+ h->hash = hash;
+}
+
+LISP_INLINE void
+set_hash_hash_slot (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, Lisp_Object index)
+{
+ h->index = index;
+}
+
+LISP_INLINE void
+set_hash_index_slot (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;
+}
+
+/* Buffer-local (also frame-local) variable access functions. */
+
+LISP_INLINE int
+blv_found (struct Lisp_Buffer_Local_Value *blv)
+{
+ eassert (blv->found == !EQ (blv->defcell, blv->valcell));
+ return blv->found;
+}
+
+LISP_INLINE void
+set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
+{
+ eassert (found == !EQ (blv->defcell, blv->valcell));
+ blv->found = found;
+}
+
+LISP_INLINE Lisp_Object
+blv_value (struct Lisp_Buffer_Local_Value *blv)
+{
+ return XCDR (blv->valcell);
+}
+
+LISP_INLINE void
+set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ XSETCDR (blv->valcell, val);
+}
+
+LISP_INLINE void
+set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->where = val;
+}
+
+LISP_INLINE void
+set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->defcell = val;
+}
+
+LISP_INLINE void
+set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
+{
+ blv->valcell = val;
+}
+
+/* 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_intervals (Lisp_Object s)
+{
+ return XSTRING (s)->intervals;
+}
+
+/* Set text properties of S to I. */
+
+LISP_INLINE void
+set_string_intervals (Lisp_Object s, INTERVAL i)
+{
+ XSTRING (s)->intervals = i;
+}
+
+/* Set a Lisp slot in TABLE to VAL. Most code should use this instead
+ of setting slots directly. */
+
+LISP_INLINE void
+set_char_table_ascii (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->ascii = val;
+}
+LISP_INLINE void
+set_char_table_defalt (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->defalt = val;
+}
+LISP_INLINE void
+set_char_table_parent (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->parent = val;
+}
+LISP_INLINE void
+set_char_table_purpose (Lisp_Object table, Lisp_Object val)
+{
+ XCHAR_TABLE (table)->purpose = val;
+}
+
+/* Set different slots in (sub)character tables. */
+
+LISP_INLINE void
+set_char_table_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
+{
+ eassert (0 <= idx && idx < CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (table)));
+ XCHAR_TABLE (table)->extras[idx] = val;
+}
+
+LISP_INLINE void
+set_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
+{
+ eassert (0 <= idx && idx < (1 << CHARTAB_SIZE_BITS_0));
+ XCHAR_TABLE (table)->contents[idx] = val;
+}
+
+LISP_INLINE void
+set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
+{
+ XSUB_CHAR_TABLE (table)->contents[idx] = val;
+}
+
/* Defined in data.c. */
extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
extern Lisp_Object Qvoid_variable, Qvoid_function;
extern Lisp_Object Qinvalid_read_syntax;
extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
-extern Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
+extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive;
extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
extern Lisp_Object Qtext_read_only;
extern Lisp_Object Qinteractive_form;
extern Lisp_Object Qcdr;
-extern Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
-extern Lisp_Object Qoverflow_error, Qunderflow_error;
+extern Lisp_Object Qrange_error, Qoverflow_error;
extern Lisp_Object Qfloatp;
extern Lisp_Object Qnumberp, Qnumber_or_marker_p;
-extern Lisp_Object Qinteger;
+extern Lisp_Object Qbuffer, Qinteger, Qsymbol;
extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
-EXFUN (Finteractive_form, 1);
-EXFUN (Fbyteorder, 0);
+EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
-/* Defined in frame.c */
+/* Defined in frame.c. */
extern Lisp_Object Qframep;
-/* Defined in data.c */
-EXFUN (Fcar, 1);
-EXFUN (Fcar_safe, 1);
-EXFUN (Fcdr, 1);
-EXFUN (Fcdr_safe, 1);
-EXFUN (Fsetcar, 2);
-EXFUN (Fsetcdr, 2);
-EXFUN (Fboundp, 1);
-EXFUN (Ffboundp, 1);
-EXFUN (Fsymbol_function, 1);
-EXFUN (Fsymbol_name, 1);
+/* Defined in data.c. */
extern Lisp_Object indirect_function (Lisp_Object);
-EXFUN (Findirect_function, 2);
-EXFUN (Ffset, 2);
-EXFUN (Fsymbol_value, 1);
extern Lisp_Object find_symbol_value (Lisp_Object);
-EXFUN (Fset, 2);
-EXFUN (Fdefault_value, 1);
-EXFUN (Fset_default, 2);
-EXFUN (Fdefault_boundp, 1);
-EXFUN (Fmake_local_variable, 1);
-EXFUN (Flocal_variable_p, 2);
-
-EXFUN (Faref, 2);
-EXFUN (Faset, 3);
-
-EXFUN (Fstring_to_number, 2);
-EXFUN (Fnumber_to_string, 1);
-EXFUN (Fgtr, 2);
-EXFUN (Flss, 2);
-EXFUN (Fgeq, 2);
-EXFUN (Fleq, 2);
-EXFUN (Fzerop, 1);
-EXFUN (Fplus, MANY);
-EXFUN (Fminus, MANY);
-EXFUN (Ftimes, MANY);
-EXFUN (Fquo, MANY);
-EXFUN (Frem, 2);
-EXFUN (Fmax, MANY);
-EXFUN (Fmin, MANY);
-
-EXFUN (Fadd1, 1);
-EXFUN (Fsub1, 1);
-EXFUN (Fmake_variable_buffer_local, 1);
/* Convert the integer I to an Emacs representation, either the integer
itself, or a cons of two or three integers, or if all else fails a float.
extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
-extern void args_out_of_range (Lisp_Object, Lisp_Object) NO_RETURN;
-extern void args_out_of_range_3 (Lisp_Object, Lisp_Object,
- Lisp_Object) NO_RETURN;
-extern Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object) NO_RETURN;
+extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
+extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
+ Lisp_Object);
+extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
-extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, int);
+extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
extern void syms_of_data (void);
-extern void init_data (void);
extern void swap_in_global_binding (struct Lisp_Symbol *);
/* Defined in cmds.c */
-EXFUN (Fend_of_line, 1);
-EXFUN (Fforward_char, 1);
-EXFUN (Fforward_line, 1);
extern void syms_of_cmds (void);
extern void keys_of_cmds (void);
-/* Defined in coding.c */
+/* Defined in coding.c. */
extern Lisp_Object Qcharset;
-EXFUN (Fcoding_system_p, 1);
-EXFUN (Fcoding_system_base, 1);
-EXFUN (Fcoding_system_eol_type, 1);
-EXFUN (Fcheck_coding_system, 1);
-EXFUN (Fread_coding_system, 2);
-EXFUN (Fread_non_nil_coding_system, 1);
-EXFUN (Ffind_operation_coding_system, MANY);
-EXFUN (Fdecode_coding_string, 4);
-extern Lisp_Object detect_coding_system (const unsigned char *, EMACS_INT,
- EMACS_INT, int, int, Lisp_Object);
+extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
+ ptrdiff_t, bool, bool, Lisp_Object);
extern void init_coding (void);
extern void init_coding_once (void);
extern void syms_of_coding (void);
-/* Defined in character.c */
-EXFUN (Fchar_width, 1);
-EXFUN (Fstring, MANY);
-extern EMACS_INT chars_in_text (const unsigned char *, EMACS_INT);
-extern EMACS_INT multibyte_chars_in_text (const unsigned char *, EMACS_INT);
-extern int multibyte_char_to_unibyte (int);
-extern int multibyte_char_to_unibyte_safe (int);
-extern void init_character_once (void);
+/* Defined in character.c. */
+EXFUN (Fmax_char, 0) ATTRIBUTE_CONST;
+extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t);
+extern ptrdiff_t multibyte_chars_in_text (const unsigned char *, ptrdiff_t);
+extern int multibyte_char_to_unibyte (int) ATTRIBUTE_CONST;
+extern int multibyte_char_to_unibyte_safe (int) ATTRIBUTE_CONST;
extern void syms_of_character (void);
-/* Defined in charset.c */
+/* Defined in charset.c. */
extern void init_charset (void);
extern void init_charset_once (void);
extern void syms_of_charset (void);
/* Structure forward declarations. */
struct charset;
-/* Defined in composite.c */
+/* Defined in composite.c. */
extern void syms_of_composite (void);
-/* Defined in syntax.c */
-EXFUN (Fforward_word, 1);
-EXFUN (Fskip_chars_forward, 2);
-EXFUN (Fskip_chars_backward, 2);
+/* Defined in syntax.c. */
extern void init_syntax_once (void);
extern void syms_of_syntax (void);
-/* Defined in fns.c */
+/* Defined in fns.c. */
extern Lisp_Object QCrehash_size, QCrehash_threshold;
enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
-extern EMACS_INT next_almost_prime (EMACS_INT);
-extern Lisp_Object larger_vector (Lisp_Object, EMACS_INT, Lisp_Object);
+EXFUN (Fidentity, 1) ATTRIBUTE_CONST;
+extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
+extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
extern void sweep_weak_hash_tables (void);
extern Lisp_Object Qcursor_in_echo_area;
extern Lisp_Object Qstring_lessp;
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
EMACS_UINT);
-void init_weak_hash_tables (void);
-extern void init_fns (void);
-EXFUN (Fmake_hash_table, MANY);
-EXFUN (Fgethash, 3);
-EXFUN (Fputhash, 3);
-EXFUN (Fremhash, 2);
-
-EXFUN (Fidentity, 1);
-EXFUN (Flength, 1);
-EXFUN (Fappend, MANY);
-EXFUN (Fconcat, MANY);
-EXFUN (Fvconcat, MANY);
-EXFUN (Fcopy_sequence, 1);
-EXFUN (Fstring_make_multibyte, 1);
-EXFUN (Fstring_make_unibyte, 1);
-EXFUN (Fstring_as_multibyte, 1);
-EXFUN (Fstring_as_unibyte, 1);
-EXFUN (Fstring_to_multibyte, 1);
-EXFUN (Fsubstring, 3);
-extern Lisp_Object substring_both (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT);
-EXFUN (Fnth, 2);
-EXFUN (Fnthcdr, 2);
-EXFUN (Fmemq, 2);
-EXFUN (Fassq, 2);
-EXFUN (Fassoc, 2);
-EXFUN (Felt, 2);
-EXFUN (Fmember, 2);
-EXFUN (Frassq, 2);
-EXFUN (Fdelq, 2);
-EXFUN (Fdelete, 2);
-EXFUN (Fsort, 2);
-EXFUN (Freverse, 1);
-EXFUN (Fnreverse, 1);
-EXFUN (Fget, 2);
-EXFUN (Fput, 3);
-EXFUN (Fequal, 2);
-EXFUN (Fnconc, MANY);
-EXFUN (Fmapcar, 2);
-EXFUN (Fmapconcat, 3);
+
+extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t);
extern Lisp_Object do_yes_or_no_p (Lisp_Object);
-EXFUN (Fprovide, 2);
extern Lisp_Object concat2 (Lisp_Object, Lisp_Object);
extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
extern void clear_string_char_byte_cache (void);
-extern EMACS_INT string_char_to_byte (Lisp_Object, EMACS_INT);
-extern EMACS_INT string_byte_to_char (Lisp_Object, EMACS_INT);
+extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
+extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t);
extern Lisp_Object string_to_multibyte (Lisp_Object);
extern Lisp_Object string_make_unibyte (Lisp_Object);
-EXFUN (Fcopy_alist, 1);
-EXFUN (Fplist_get, 2);
-EXFUN (Fplist_put, 3);
-EXFUN (Fplist_member, 2);
-EXFUN (Frassoc, 2);
-EXFUN (Fstring_equal, 2);
-EXFUN (Fcompare_strings, 7);
-EXFUN (Fstring_lessp, 2);
extern void syms_of_fns (void);
-/* Defined in floatfns.c */
+/* Defined in floatfns.c. */
extern double extract_float (Lisp_Object);
-EXFUN (Ffloat, 1);
-EXFUN (Ftruncate, 2);
-extern void init_floatfns (void);
extern void syms_of_floatfns (void);
extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y);
-/* Defined in fringe.c */
+/* Defined in fringe.c. */
extern void syms_of_fringe (void);
extern void init_fringe (void);
#ifdef HAVE_WINDOW_SYSTEM
extern void init_fringe_once (void);
#endif /* HAVE_WINDOW_SYSTEM */
-/* Defined in image.c */
+/* Defined in image.c. */
extern Lisp_Object QCascent, QCmargin, QCrelief;
extern Lisp_Object QCconversion;
extern int x_bitmap_mask (struct frame *, ptrdiff_t);
+extern void reset_image_types (void);
extern void syms_of_image (void);
-extern void init_image (void);
-/* Defined in insdel.c */
+/* Defined in insdel.c. */
extern Lisp_Object Qinhibit_modification_hooks;
-extern void move_gap (EMACS_INT);
-extern void move_gap_both (EMACS_INT, EMACS_INT);
-extern void buffer_overflow (void) NO_RETURN;
-extern void make_gap (EMACS_INT);
-extern EMACS_INT copy_text (const unsigned char *, unsigned char *,
- EMACS_INT, int, int);
+extern void move_gap (ptrdiff_t);
+extern void move_gap_both (ptrdiff_t, ptrdiff_t);
+extern _Noreturn void buffer_overflow (void);
+extern void make_gap (ptrdiff_t);
+extern ptrdiff_t copy_text (const unsigned char *, unsigned char *,
+ ptrdiff_t, bool, bool);
extern int count_combining_before (const unsigned char *,
- EMACS_INT, EMACS_INT, EMACS_INT);
+ ptrdiff_t, ptrdiff_t, ptrdiff_t);
extern int count_combining_after (const unsigned char *,
- EMACS_INT, EMACS_INT, EMACS_INT);
-extern void insert (const char *, EMACS_INT);
-extern void insert_and_inherit (const char *, EMACS_INT);
-extern void insert_1 (const char *, EMACS_INT, int, int, int);
-extern void insert_1_both (const char *, EMACS_INT, EMACS_INT,
- int, int, int);
-extern void insert_from_gap (EMACS_INT, EMACS_INT);
-extern void insert_from_string (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, int);
-extern void insert_from_buffer (struct buffer *, EMACS_INT, EMACS_INT, int);
+ ptrdiff_t, ptrdiff_t, ptrdiff_t);
+extern void insert (const char *, ptrdiff_t);
+extern void insert_and_inherit (const char *, ptrdiff_t);
+extern void insert_1 (const char *, ptrdiff_t, bool, bool, bool);
+extern void insert_1_both (const char *, ptrdiff_t, ptrdiff_t,
+ bool, bool, bool);
+extern void insert_from_gap (ptrdiff_t, ptrdiff_t);
+extern void insert_from_string (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, bool);
+extern void insert_from_buffer (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
extern void insert_char (int);
extern void insert_string (const char *);
-extern void insert_before_markers (const char *, EMACS_INT);
-extern void insert_before_markers_and_inherit (const char *, EMACS_INT);
-extern void insert_from_string_before_markers (Lisp_Object, EMACS_INT,
- EMACS_INT, EMACS_INT,
- EMACS_INT, int);
-extern void del_range (EMACS_INT, EMACS_INT);
-extern Lisp_Object del_range_1 (EMACS_INT, EMACS_INT, int, int);
-extern void del_range_byte (EMACS_INT, EMACS_INT, int);
-extern void del_range_both (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT, int);
-extern Lisp_Object del_range_2 (EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, int);
-extern void modify_region (struct buffer *, EMACS_INT, EMACS_INT, int);
-extern void prepare_to_modify_buffer (EMACS_INT, EMACS_INT, EMACS_INT *);
-extern void signal_after_change (EMACS_INT, EMACS_INT, EMACS_INT);
-extern void adjust_after_insert (EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT);
-extern void adjust_markers_for_delete (EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT);
-extern void replace_range (EMACS_INT, EMACS_INT, Lisp_Object, int, int, int);
-extern void replace_range_2 (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT,
- const char *, EMACS_INT, EMACS_INT, int);
+extern void insert_before_markers (const char *, ptrdiff_t);
+extern void insert_before_markers_and_inherit (const char *, ptrdiff_t);
+extern void insert_from_string_before_markers (Lisp_Object, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, bool);
+extern void del_range (ptrdiff_t, ptrdiff_t);
+extern Lisp_Object del_range_1 (ptrdiff_t, ptrdiff_t, bool, bool);
+extern void del_range_byte (ptrdiff_t, ptrdiff_t, bool);
+extern void del_range_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool);
+extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, bool);
+extern void modify_region (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
+extern void prepare_to_modify_buffer (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
+extern void signal_after_change (ptrdiff_t, ptrdiff_t, ptrdiff_t);
+extern void adjust_after_insert (ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t);
+extern void adjust_markers_for_delete (ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t);
+extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, bool);
+extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ const char *, ptrdiff_t, ptrdiff_t, bool);
extern void syms_of_insdel (void);
-/* Defined in dispnew.c */
+/* Defined in dispnew.c. */
+#if (defined PROFILING \
+ && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__))
+_Noreturn void __executable_start (void);
+#endif
extern Lisp_Object selected_frame;
extern Lisp_Object Vwindow_system;
-EXFUN (Fding, 1);
-EXFUN (Fredraw_frame, 1);
-EXFUN (Fsleep_for, 2);
-EXFUN (Fredisplay, 1);
-extern Lisp_Object sit_for (Lisp_Object, int, int);
+extern Lisp_Object sit_for (Lisp_Object, bool, int);
extern void init_display (void);
extern void syms_of_display (void);
-/* Defined in xdisp.c */
+/* Defined in xdisp.c. */
extern Lisp_Object Qinhibit_point_motion_hooks;
extern Lisp_Object Qinhibit_redisplay, Qdisplay;
extern Lisp_Object Qmenu_bar_update_hook;
extern Lisp_Object QCmap;
extern Lisp_Object Qrisky_local_variable;
extern struct frame *last_glyphless_glyph_frame;
-extern unsigned last_glyphless_glyph_face_id;
+extern int last_glyphless_glyph_face_id;
extern int last_glyphless_glyph_merged_face_id;
extern int noninteractive_need_newline;
extern Lisp_Object echo_area_buffer[2];
extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
extern void check_message_stack (void);
extern void setup_echo_area_for_printing (int);
-extern int push_message (void);
+extern bool push_message (void);
extern Lisp_Object pop_message_unwind (Lisp_Object);
extern Lisp_Object restore_message_unwind (Lisp_Object);
extern void restore_message (void);
extern void message (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
extern void message1 (const char *);
extern void message1_nolog (const char *);
-extern void message2 (const char *, EMACS_INT, int);
-extern void message2_nolog (const char *, EMACS_INT, int);
-extern void message3 (Lisp_Object, EMACS_INT, int);
-extern void message3_nolog (Lisp_Object, EMACS_INT, int);
-extern void message_dolog (const char *, EMACS_INT, int, int);
+extern void message2 (const char *, ptrdiff_t, int);
+extern void message2_nolog (const char *, ptrdiff_t, int);
+extern void message3 (Lisp_Object, ptrdiff_t, int);
+extern void message3_nolog (Lisp_Object, ptrdiff_t, int);
+extern void message_dolog (const char *, ptrdiff_t, int, int);
extern void message_with_string (const char *, Lisp_Object, int);
extern void message_log_maybe_newline (void);
extern void update_echo_area (void);
-extern void truncate_echo_area (EMACS_INT);
+extern void truncate_echo_area (ptrdiff_t);
extern void redisplay (void);
extern void redisplay_preserve_echo_area (int);
extern void prepare_menu_bars (void);
extern void syms_of_xdisp (void);
extern void init_xdisp (void);
extern Lisp_Object safe_eval (Lisp_Object);
-extern int pos_visible_p (struct window *, EMACS_INT, int *,
+extern int pos_visible_p (struct window *, ptrdiff_t, int *,
int *, int *, int *, int *, int *);
-/* Defined in xsettings.c */
+/* Defined in xsettings.c. */
extern void syms_of_xsettings (void);
/* Defined in vm-limit.c. */
-extern void memory_warnings (POINTER_TYPE *, void (*warnfun) (const char *));
+extern void memory_warnings (void *, void (*warnfun) (const char *));
-/* Defined in alloc.c */
+/* Defined in alloc.c. */
extern void check_pure_size (void);
extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
-extern void reset_malloc_hooks (void);
-extern void uninterrupt_malloc (void);
extern void malloc_warning (const char *);
-extern void memory_full (size_t) NO_RETURN;
-extern void buffer_memory_full (EMACS_INT) NO_RETURN;
-extern int survives_gc_p (Lisp_Object);
+extern _Noreturn void memory_full (size_t);
+extern _Noreturn void buffer_memory_full (ptrdiff_t);
+extern bool survives_gc_p (Lisp_Object);
extern void mark_object (Lisp_Object);
#if defined REL_ALLOC && !defined SYSTEM_MALLOC
extern void refill_memory_reserve (void);
#endif
extern const char *pending_malloc_warning;
+extern Lisp_Object zero_vector;
extern Lisp_Object *stack_base;
-EXFUN (Fcons, 2);
+extern EMACS_INT consing_since_gc;
+extern EMACS_INT gc_relative_threshold;
+extern EMACS_INT memory_full_cons_threshold;
extern Lisp_Object list1 (Lisp_Object);
extern Lisp_Object list2 (Lisp_Object, Lisp_Object);
extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
-EXFUN (Flist, MANY);
-EXFUN (Fmake_list, 2);
-extern Lisp_Object allocate_misc (void);
-EXFUN (Fmake_vector, 2);
-EXFUN (Fvector, MANY);
-EXFUN (Fmake_symbol, 1);
-EXFUN (Fmake_marker, 0);
-extern void string_overflow (void) NO_RETURN;
-EXFUN (Fmake_string, 2);
-extern Lisp_Object build_string (const char *);
-extern Lisp_Object make_string (const char *, EMACS_INT);
-extern Lisp_Object make_unibyte_string (const char *, EMACS_INT);
-extern Lisp_Object make_multibyte_string (const char *, EMACS_INT, EMACS_INT);
+enum constype {CONSTYPE_HEAP, CONSTYPE_PURE};
+extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...);
+extern _Noreturn void string_overflow (void);
+extern Lisp_Object make_string (const char *, ptrdiff_t);
+extern Lisp_Object make_formatted_string (char *, const char *, ...)
+ ATTRIBUTE_FORMAT_PRINTF (2, 3);
+extern Lisp_Object make_unibyte_string (const char *, ptrdiff_t);
+
+/* Make unibyte string from C string when the length isn't known. */
+
+LISP_INLINE Lisp_Object
+build_unibyte_string (const char *str)
+{
+ return make_unibyte_string (str, strlen (str));
+}
+
+extern Lisp_Object make_multibyte_string (const char *, ptrdiff_t, ptrdiff_t);
extern Lisp_Object make_event_array (int, Lisp_Object *);
extern Lisp_Object make_uninit_string (EMACS_INT);
extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT);
-extern Lisp_Object make_string_from_bytes (const char *, EMACS_INT, EMACS_INT);
+extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t);
extern Lisp_Object make_specified_string (const char *,
- EMACS_INT, EMACS_INT, int);
-EXFUN (Fpurecopy, 1);
-extern Lisp_Object make_pure_string (const char *, EMACS_INT, EMACS_INT, int);
-extern Lisp_Object make_pure_c_string (const char *data);
+ ptrdiff_t, ptrdiff_t, bool);
+extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool);
+extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t);
+
+/* Make a string allocated in pure space, use STR as string data. */
+
+LISP_INLINE Lisp_Object
+build_pure_c_string (const char *str)
+{
+ return make_pure_c_string (str, strlen (str));
+}
+
+/* Make a string from the data at STR, treating it as multibyte if the
+ data warrants. */
+
+LISP_INLINE Lisp_Object
+build_string (const char *str)
+{
+ return make_string (str, strlen (str));
+}
+
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
-extern Lisp_Object make_pure_vector (EMACS_INT);
-EXFUN (Fgarbage_collect, 0);
-EXFUN (Fmake_byte_code, MANY);
-EXFUN (Fmake_bool_vector, 2);
+extern void make_byte_code (struct Lisp_Vector *);
+extern Lisp_Object Qautomatic_gc;
extern Lisp_Object Qchar_table_extra_slots;
extern struct Lisp_Vector *allocate_vector (EMACS_INT);
-extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag);
+extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, int tag);
#define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \
((typ*) \
allocate_pseudovector \
extern struct frame *allocate_frame (void);
extern struct Lisp_Process *allocate_process (void);
extern struct terminal *allocate_terminal (void);
-extern int gc_in_progress;
-extern int abort_on_gc;
+extern bool gc_in_progress;
+extern bool abort_on_gc;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
-extern int inhibit_garbage_collection (void);
+extern ptrdiff_t inhibit_garbage_collection (void);
extern Lisp_Object make_save_value (void *, ptrdiff_t);
+extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_marker (Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern void init_alloc_once (void);
extern void syms_of_alloc (void);
extern struct buffer * allocate_buffer (void);
extern int valid_lisp_object_p (Lisp_Object);
+#ifdef GC_CHECK_CONS_LIST
+extern void check_cons_list (void);
+#else
+#define check_cons_list() ((void) 0)
+#endif
-/* Defined in chartab.c */
-EXFUN (Fmake_char_table, 2);
-EXFUN (Fset_char_table_parent, 2);
-EXFUN (Fchar_table_extra_slot, 2);
-EXFUN (Fset_char_table_extra_slot, 3);
-EXFUN (Fset_char_table_range, 3);
-EXFUN (Foptimize_char_table, 2);
+#ifdef REL_ALLOC
+/* Defined in ralloc.c. */
+extern void *r_alloc (void **, size_t);
+extern void r_alloc_free (void **);
+extern void *r_re_alloc (void **, size_t);
+extern void r_alloc_reset_variable (void **, void **);
+extern void r_alloc_inhibit_buffer_relocation (int);
+#endif
+
+/* Defined in chartab.c. */
extern Lisp_Object copy_char_table (Lisp_Object);
extern Lisp_Object char_table_ref (Lisp_Object, int);
extern Lisp_Object char_table_ref_and_range (Lisp_Object, int,
int *, int *);
-extern Lisp_Object char_table_set (Lisp_Object, int, Lisp_Object);
-extern Lisp_Object char_table_set_range (Lisp_Object, int, int,
- Lisp_Object);
+extern void char_table_set (Lisp_Object, int, Lisp_Object);
+extern void char_table_set_range (Lisp_Object, int, int, Lisp_Object);
extern int char_table_translate (Lisp_Object, int);
extern void map_char_table (void (*) (Lisp_Object, Lisp_Object,
Lisp_Object),
extern Lisp_Object uniprop_table (Lisp_Object);
extern void syms_of_chartab (void);
-/* Defined in print.c */
+/* Defined in print.c. */
extern Lisp_Object Vprin1_to_string_buffer;
extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
-EXFUN (Fprin1, 2);
-EXFUN (Fprin1_to_string, 2);
-EXFUN (Fterpri, 1);
-EXFUN (Fprint, 2);
-EXFUN (Ferror_message_string, 1);
extern Lisp_Object Qstandard_output;
extern Lisp_Object Qexternal_debugging_output;
extern void temp_output_buffer_setup (const char *);
Lisp_Object);
extern Lisp_Object internal_with_output_to_temp_buffer
(const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object);
-#define FLOAT_TO_STRING_BUFSIZE 350
-extern void float_to_string (char *, double);
+enum FLOAT_TO_STRING_BUFSIZE { FLOAT_TO_STRING_BUFSIZE = 350 };
+extern int float_to_string (char *, double);
extern void syms_of_print (void);
-/* Defined in doprnt.c */
+/* Defined in doprnt.c. */
extern ptrdiff_t doprnt (char *, ptrdiff_t, const char *, const char *,
va_list);
extern ptrdiff_t esprintf (char *, char const *, ...)
/* Defined in lread.c. */
extern Lisp_Object Qvariable_documentation, Qstandard_input;
extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
-EXFUN (Fread, 1);
-EXFUN (Fread_from_string, 3);
-EXFUN (Fintern, 2);
-EXFUN (Fintern_soft, 2);
-EXFUN (Funintern, 2);
-EXFUN (Fload, 5);
-EXFUN (Fget_load_suffixes, 0);
-EXFUN (Fread_char, 3);
-EXFUN (Fread_event, 3);
+extern Lisp_Object Qlexical_binding;
extern Lisp_Object check_obarray (Lisp_Object);
-extern Lisp_Object intern (const char *);
-extern Lisp_Object intern_c_string (const char *);
-extern Lisp_Object oblookup (Lisp_Object, const char *, EMACS_INT, EMACS_INT);
+extern Lisp_Object intern_1 (const char *, ptrdiff_t);
+extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
+extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
#define LOADHIST_ATTACH(x) \
do { \
if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \
extern void init_lread (void);
extern void syms_of_lread (void);
+LISP_INLINE Lisp_Object
+intern (const char *str)
+{
+ return intern_1 (str, strlen (str));
+}
+
+LISP_INLINE Lisp_Object
+intern_c_string (const char *str)
+{
+ return intern_c_string_1 (str, strlen (str));
+}
+
/* Defined in eval.c. */
-extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
-extern Lisp_Object Qinhibit_quit, Qclosure;
+extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro;
+extern Lisp_Object Qinhibit_quit, Qinternal_interpreter_environment, Qclosure;
extern Lisp_Object Qand_rest;
extern Lisp_Object Vautoload_queue;
extern Lisp_Object Vsignaling_function;
extern Lisp_Object inhibit_lisp_code;
-extern int handling_signal;
#if BYTE_MARK_STACK
extern struct catchtag *catchlist;
extern struct handler *handlerlist;
should no longer be used. */
extern Lisp_Object Vrun_hooks;
-EXFUN (Frun_hooks, MANY);
-EXFUN (Frun_hook_with_args, MANY);
-EXFUN (Frun_hook_with_args_until_failure, MANY);
extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
Lisp_Object (*funcall)
(ptrdiff_t nargs, Lisp_Object *args));
-EXFUN (Fprogn, UNEVALLED);
-EXFUN (Finteractive_p, 0);
-EXFUN (Fthrow, 2) NO_RETURN;
-EXFUN (Fsignal, 2);
-extern void xsignal (Lisp_Object, Lisp_Object) NO_RETURN;
-extern void xsignal0 (Lisp_Object) NO_RETURN;
-extern void xsignal1 (Lisp_Object, Lisp_Object) NO_RETURN;
-extern void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN;
-extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN;
-extern void signal_error (const char *, Lisp_Object) NO_RETURN;
-EXFUN (Fcommandp, 2);
-EXFUN (Ffunctionp, 1);
-EXFUN (Feval, 2);
+extern _Noreturn void xsignal (Lisp_Object, Lisp_Object);
+extern _Noreturn void xsignal0 (Lisp_Object);
+extern _Noreturn void xsignal1 (Lisp_Object, Lisp_Object);
+extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
+extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+extern _Noreturn void signal_error (const char *, Lisp_Object);
extern Lisp_Object eval_sub (Lisp_Object form);
-EXFUN (Fapply, MANY);
-EXFUN (Ffuncall, MANY);
extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
extern Lisp_Object call0 (Lisp_Object);
extern Lisp_Object call1 (Lisp_Object, Lisp_Object);
extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-EXFUN (Fdo_auto_save, 2);
extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object);
extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object);
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 (int, Lisp_Object);
-extern void error (const char *, ...) NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 2);
-extern void verror (const char *, va_list)
- NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 0);
-extern void do_autoload (Lisp_Object, Lisp_Object);
+extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
+extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
+extern _Noreturn void verror (const char *, va_list)
+ ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern Lisp_Object un_autoload (Lisp_Object);
+extern Lisp_Object call_debugger (Lisp_Object arg);
extern void init_eval_once (void);
-extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object *);
+extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void init_eval (void);
#endif
extern void syms_of_eval (void);
-/* Defined in editfns.c */
+/* Defined in editfns.c. */
extern Lisp_Object Qfield;
-EXFUN (Fcurrent_message, 0);
-EXFUN (Fgoto_char, 1);
-EXFUN (Fpoint_max_marker, 0);
-EXFUN (Fpoint, 0);
-EXFUN (Fpoint_marker, 0);
-EXFUN (Fline_beginning_position, 1);
-EXFUN (Fline_end_position, 1);
-EXFUN (Ffollowing_char, 0);
-EXFUN (Fprevious_char, 0);
-EXFUN (Fchar_after, 1);
-EXFUN (Finsert, MANY);
-EXFUN (Finsert_char, 3);
extern void insert1 (Lisp_Object);
-EXFUN (Feolp, 0);
-EXFUN (Feobp, 0);
-EXFUN (Fbolp, 0);
-EXFUN (Fbobp, 0);
-EXFUN (Fformat, MANY);
-EXFUN (Fmessage, MANY);
extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
-EXFUN (Fbuffer_substring, 2);
-EXFUN (Fbuffer_string, 0);
extern Lisp_Object save_excursion_save (void);
extern Lisp_Object save_restriction_save (void);
extern Lisp_Object save_excursion_restore (Lisp_Object);
extern Lisp_Object save_restriction_restore (Lisp_Object);
-EXFUN (Fchar_to_string, 1);
-EXFUN (Fdelete_region, 2);
-EXFUN (Fnarrow_to_region, 2);
-EXFUN (Fwiden, 0);
-EXFUN (Fuser_login_name, 1);
-EXFUN (Fsystem_name, 0);
-EXFUN (Fcurrent_time, 0);
-EXFUN (Fget_internal_run_time, 0);
-extern EMACS_INT clip_to_bounds (EMACS_INT, EMACS_INT, EMACS_INT);
-extern Lisp_Object make_buffer_string (EMACS_INT, EMACS_INT, int);
-extern Lisp_Object make_buffer_string_both (EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT, int);
+extern _Noreturn void time_overflow (void);
+extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
+extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, bool);
extern void init_editfns (void);
const char *get_system_name (void);
extern void syms_of_editfns (void);
-EXFUN (Fconstrain_to_field, 5);
-EXFUN (Ffield_end, 3);
extern void set_time_zone_rule (const char *);
-/* Defined in buffer.c */
-extern int mouse_face_overlay_overlaps (Lisp_Object);
-extern void nsberror (Lisp_Object) NO_RETURN;
-EXFUN (Fset_buffer_multibyte, 1);
-EXFUN (Foverlay_start, 1);
-EXFUN (Foverlay_end, 1);
-extern void adjust_overlays_for_insert (EMACS_INT, EMACS_INT);
-extern void adjust_overlays_for_delete (EMACS_INT, EMACS_INT);
-extern void fix_start_end_in_overlays (EMACS_INT, EMACS_INT);
-extern void report_overlay_modification (Lisp_Object, Lisp_Object, int,
+/* Defined in buffer.c. */
+extern bool mouse_face_overlay_overlaps (Lisp_Object);
+extern _Noreturn void nsberror (Lisp_Object);
+extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
+extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
+extern void fix_start_end_in_overlays (ptrdiff_t, ptrdiff_t);
+extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
Lisp_Object, Lisp_Object, Lisp_Object);
-extern int overlay_touches_p (EMACS_INT);
+extern bool overlay_touches_p (ptrdiff_t);
extern Lisp_Object Vbuffer_alist;
-EXFUN (Fget_buffer, 1);
-EXFUN (Fget_buffer_create, 1);
-EXFUN (Fgenerate_new_buffer_name, 2);
-EXFUN (Fset_buffer, 1);
extern Lisp_Object set_buffer_if_live (Lisp_Object);
-EXFUN (Fbarf_if_buffer_read_only, 0);
-EXFUN (Fcurrent_buffer, 0);
-EXFUN (Fother_buffer, 3);
extern Lisp_Object other_buffer_safely (Lisp_Object);
-EXFUN (Foverlay_get, 2);
-EXFUN (Fbuffer_modified_p, 1);
-EXFUN (Fset_buffer_modified_p, 1);
-EXFUN (Fkill_buffer, 1);
-EXFUN (Fkill_all_local_variables, 0);
-EXFUN (Fbuffer_enable_undo, 1);
-EXFUN (Ferase_buffer, 0);
extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string;
extern Lisp_Object get_truename_buffer (Lisp_Object);
-extern struct buffer *all_buffers;
-EXFUN (Fprevious_overlay_change, 1);
-EXFUN (Fbuffer_file_name, 1);
extern void init_buffer_once (void);
extern void init_buffer (void);
extern void syms_of_buffer (void);
extern void keys_of_buffer (void);
-/* Defined in marker.c */
+/* Defined in marker.c. */
-EXFUN (Fmarker_position, 1);
-EXFUN (Fmarker_buffer, 1);
-EXFUN (Fcopy_marker, 2);
-EXFUN (Fset_marker, 3);
-extern EMACS_INT marker_position (Lisp_Object);
-extern EMACS_INT marker_byte_position (Lisp_Object);
+extern ptrdiff_t marker_position (Lisp_Object);
+extern ptrdiff_t marker_byte_position (Lisp_Object);
extern void clear_charpos_cache (struct buffer *);
-extern EMACS_INT charpos_to_bytepos (EMACS_INT);
-extern EMACS_INT buf_charpos_to_bytepos (struct buffer *, EMACS_INT);
-extern EMACS_INT buf_bytepos_to_charpos (struct buffer *, EMACS_INT);
+extern ptrdiff_t charpos_to_bytepos (ptrdiff_t);
+extern ptrdiff_t buf_charpos_to_bytepos (struct buffer *, ptrdiff_t);
+extern ptrdiff_t buf_bytepos_to_charpos (struct buffer *, ptrdiff_t);
extern void unchain_marker (struct Lisp_Marker *marker);
extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
-extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, EMACS_INT, EMACS_INT);
+extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
- EMACS_INT, EMACS_INT);
+ ptrdiff_t, ptrdiff_t);
+extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
extern void syms_of_marker (void);
-/* Defined in fileio.c */
+/* Defined in fileio.c. */
extern Lisp_Object Qfile_error;
extern Lisp_Object Qfile_exists_p;
extern Lisp_Object Qfile_directory_p;
extern Lisp_Object Qinsert_file_contents;
extern Lisp_Object Qfile_name_history;
-EXFUN (Ffind_file_name_handler, 2);
-EXFUN (Ffile_name_as_directory, 1);
-EXFUN (Fexpand_file_name, 2);
-EXFUN (Ffile_name_nondirectory, 1);
-EXFUN (Fsubstitute_in_file_name, 1);
-EXFUN (Ffile_symlink_p, 1);
-EXFUN (Fverify_visited_file_modtime, 1);
-EXFUN (Ffile_exists_p, 1);
-EXFUN (Ffile_name_absolute_p, 1);
-EXFUN (Fdirectory_file_name, 1);
-EXFUN (Ffile_name_directory, 1);
extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
-EXFUN (Ffile_accessible_directory_p, 1);
-EXFUN (Funhandled_file_name_directory, 1);
-EXFUN (Ffile_directory_p, 1);
-EXFUN (Fwrite_region, 7);
-EXFUN (Ffile_readable_p, 1);
-EXFUN (Fread_file_name, 6);
+EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */
extern Lisp_Object close_file_unwind (Lisp_Object);
extern Lisp_Object restore_point_unwind (Lisp_Object);
-extern void report_file_error (const char *, Lisp_Object) NO_RETURN;
-extern int internal_delete_file (Lisp_Object);
+extern _Noreturn void report_file_error (const char *, Lisp_Object);
+extern void internal_delete_file (Lisp_Object);
extern void syms_of_fileio (void);
-extern Lisp_Object make_temp_name (Lisp_Object, int);
+extern Lisp_Object make_temp_name (Lisp_Object, bool);
extern Lisp_Object Qdelete_file;
-/* Defined in search.c */
+/* Defined in search.c. */
extern void shrink_regexp_cache (void);
-EXFUN (Fstring_match, 3);
extern void restore_search_regs (void);
-EXFUN (Fmatch_data, 3);
-EXFUN (Fset_match_data, 2);
-EXFUN (Fmatch_beginning, 1);
-EXFUN (Fmatch_end, 1);
extern void record_unwind_save_match_data (void);
struct re_registers;
extern struct re_pattern_buffer *compile_pattern (Lisp_Object,
struct re_registers *,
Lisp_Object, int, int);
-extern EMACS_INT fast_string_match (Lisp_Object, Lisp_Object);
-extern EMACS_INT fast_c_string_match_ignore_case (Lisp_Object, const char *);
-extern EMACS_INT fast_string_match_ignore_case (Lisp_Object, Lisp_Object);
-extern EMACS_INT fast_looking_at (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, Lisp_Object);
-extern EMACS_INT scan_buffer (int, EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT *, int);
-extern EMACS_INT scan_newline (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT,
+extern ptrdiff_t fast_string_match (Lisp_Object, Lisp_Object);
+extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *,
+ ptrdiff_t);
+extern ptrdiff_t fast_string_match_ignore_case (Lisp_Object, Lisp_Object);
+extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, Lisp_Object);
+extern ptrdiff_t scan_buffer (int, ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t *, int);
+extern EMACS_INT scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
EMACS_INT, int);
-extern EMACS_INT find_next_newline (EMACS_INT, int);
-extern EMACS_INT find_next_newline_no_quit (EMACS_INT, EMACS_INT);
-extern EMACS_INT find_before_next_newline (EMACS_INT, EMACS_INT, EMACS_INT);
+extern ptrdiff_t find_next_newline (ptrdiff_t, int);
+extern ptrdiff_t find_next_newline_no_quit (ptrdiff_t, ptrdiff_t);
+extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t);
extern void syms_of_search (void);
extern void clear_regexp_cache (void);
-/* Defined in minibuf.c */
+/* Defined in minibuf.c. */
extern Lisp_Object Qcompletion_ignore_case;
extern Lisp_Object Vminibuffer_list;
extern Lisp_Object last_minibuf_string;
-EXFUN (Fcompleting_read, 8);
-EXFUN (Fread_from_minibuffer, 7);
-EXFUN (Fread_variable, 2);
-EXFUN (Fread_buffer, 3);
-EXFUN (Fread_minibuffer, 2);
-EXFUN (Feval_minibuffer, 2);
-EXFUN (Fread_string, 5);
-EXFUN (Fassoc_string, 3);
extern Lisp_Object get_minibuffer (EMACS_INT);
extern void init_minibuf_once (void);
extern void syms_of_minibuf (void);
-/* Defined in callint.c */
+/* Defined in callint.c. */
extern Lisp_Object Qminus, Qplus;
extern Lisp_Object Qwhen;
extern Lisp_Object Qcall_interactively, Qmouse_leave_buffer_hook;
-EXFUN (Fprefix_numeric_value, 1);
extern void syms_of_callint (void);
-/* Defined in casefiddle.c */
+/* Defined in casefiddle.c. */
extern Lisp_Object Qidentity;
-EXFUN (Fdowncase, 1);
-EXFUN (Fupcase, 1);
-EXFUN (Fupcase_region, 2);
-EXFUN (Fupcase_initials, 1);
-EXFUN (Fupcase_initials_region, 2);
extern void syms_of_casefiddle (void);
extern void keys_of_casefiddle (void);
-/* Defined in casetab.c */
+/* Defined in casetab.c. */
-EXFUN (Fset_case_table, 1);
-EXFUN (Fset_standard_case_table, 1);
extern void init_casetab_once (void);
extern void syms_of_casetab (void);
-/* Defined in keyboard.c */
+/* Defined in keyboard.c. */
extern Lisp_Object echo_message_buffer;
extern struct kboard *echo_kboard;
extern Lisp_Object Qdisabled, QCfilter;
extern Lisp_Object Qup, Qdown, Qbottom;
extern Lisp_Object Qtop;
+extern Lisp_Object last_undo_boundary;
extern int input_pending;
-EXFUN (Fdiscard_input, 0);
-EXFUN (Frecursive_edit, 0);
-EXFUN (Ftop_level, 0) NO_RETURN;
extern Lisp_Object menu_bar_items (Lisp_Object);
extern Lisp_Object tool_bar_items (Lisp_Object, int *);
extern void discard_mouse_events (void);
-EXFUN (Fevent_convert_list, 1);
-EXFUN (Fread_key_sequence, 5);
-EXFUN (Fset_input_interrupt_mode, 1);
-EXFUN (Fset_input_mode, 4);
+#ifdef USABLE_SIGIO
+void handle_input_available_signal (int);
+#endif
extern Lisp_Object pending_funcalls;
extern int detect_input_pending (void);
extern int detect_input_pending_ignore_squeezables (void);
extern Lisp_Object command_loop_1 (void);
extern Lisp_Object recursive_edit_1 (void);
extern void record_auto_save (void);
-#ifdef SIGDANGER
extern void force_auto_save_soon (void);
-#endif
extern void init_keyboard (void);
extern void syms_of_keyboard (void);
extern void keys_of_keyboard (void);
-/* Defined in indent.c */
-EXFUN (Fvertical_motion, 2);
-EXFUN (Findent_to, 2);
-EXFUN (Fmove_to_column, 2);
-extern EMACS_INT current_column (void);
+/* Defined in indent.c. */
+extern ptrdiff_t current_column (void);
extern void invalidate_current_column (void);
-extern int indented_beyond_p (EMACS_INT, EMACS_INT, EMACS_INT);
+extern bool indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT);
extern void syms_of_indent (void);
-/* Defined in frame.c */
-#ifdef HAVE_WINDOW_SYSTEM
-#endif /* HAVE_WINDOW_SYSTEM */
-extern Lisp_Object Qonly;
+/* Defined in frame.c. */
+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);
extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
#endif
extern Lisp_Object frame_buffer_predicate (Lisp_Object);
-EXFUN (Fselect_frame, 2);
-EXFUN (Fselected_frame, 0);
-EXFUN (Fmake_frame_visible, 1);
-EXFUN (Ficonify_frame, 1);
-EXFUN (Fframe_parameter, 2);
-EXFUN (Fmodify_frame_parameters, 2);
-EXFUN (Fraise_frame, 1);
-EXFUN (Fredirect_frame_focus, 2);
extern void frames_discard_buffer (Lisp_Object);
extern void syms_of_frame (void);
-/* Defined in emacs.c */
+/* Defined in emacs.c. */
extern char **initial_argv;
extern int initial_argc;
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
-extern int display_arg;
+extern bool display_arg;
#endif
extern Lisp_Object decode_env_path (const char *, const char *);
extern Lisp_Object empty_unibyte_string, empty_multibyte_string;
extern Lisp_Object Qfile_name_handler_alist;
-#ifdef FLOAT_CATCH_SIGILL
-extern void fatal_error_signal (int);
-#endif
+extern _Noreturn void terminate_due_to_signal (int, int);
extern Lisp_Object Qkill_emacs;
-EXFUN (Fkill_emacs, 1) NO_RETURN;
+#ifdef WINDOWSNT
+extern Lisp_Object Vlibrary_cache;
+#endif
#if HAVE_SETLOCALE
void fixup_locale (void);
void synchronize_system_messages_locale (void);
#define synchronize_system_messages_locale()
#define synchronize_system_time_locale()
#endif
-void shut_down_emacs (int, int, Lisp_Object);
-/* Nonzero means don't do interactive redisplay and don't change tty modes. */
-extern int noninteractive;
+extern void shut_down_emacs (int, Lisp_Object);
-/* Nonzero means remove site-lisp directories from load-path. */
-extern int no_site_lisp;
+/* True means don't do interactive redisplay and don't change tty modes. */
+extern bool noninteractive;
+
+/* True means remove site-lisp directories from load-path. */
+extern bool no_site_lisp;
/* Pipe used to send exit notification to the daemon parent at
startup. */
extern int daemon_pipe[2];
#define IS_DAEMON (daemon_pipe[1] != 0)
-/* Nonzero means don't do use window-system-specific display code. */
-extern int inhibit_window_system;
-/* Nonzero means that a filter or a sentinel is running. */
-extern int running_asynch_code;
+/* True if handling a fatal error already. */
+extern bool fatal_error_in_progress;
+
+/* True means don't do use window-system-specific display code. */
+extern bool inhibit_window_system;
+/* True means that a filter or a sentinel is running. */
+extern bool running_asynch_code;
/* Defined in process.c. */
extern Lisp_Object QCtype, Qlocal;
-EXFUN (Fget_buffer_process, 1);
-EXFUN (Fprocess_status, 1);
-EXFUN (Fkill_process, 2);
-EXFUN (Fwaiting_for_user_input_p, 0);
extern Lisp_Object Qprocessp;
extern void kill_buffer_processes (Lisp_Object);
-extern int wait_reading_process_output (int, int, int, int,
+extern int wait_reading_process_output (intmax_t, int, int, int,
Lisp_Object,
struct Lisp_Process *,
int);
+/* Max value for the first argument of wait_reading_process_output. */
+#if __GNUC__ == 3 || (__GNUC__ == 4 && __GNUC_MINOR__ <= 5)
+/* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.3.
+ The bug merely causes a bogus warning, but the warning is annoying. */
+# define WAIT_READING_MAX min (TYPE_MAXIMUM (time_t), INTMAX_MAX)
+#else
+# define WAIT_READING_MAX INTMAX_MAX
+#endif
extern void add_keyboard_wait_descriptor (int);
extern void delete_keyboard_wait_descriptor (int);
#ifdef HAVE_GPM
extern void delete_gpm_wait_descriptor (int);
#endif
extern void close_process_descs (void);
-extern void init_process (void);
+extern void init_process_emacs (void);
extern void syms_of_process (void);
extern void setup_process_coding_systems (Lisp_Object);
-EXFUN (Fcall_process, MANY);
-extern int child_setup (int, int, int, char **, int, Lisp_Object)
#ifndef DOS_NT
- NO_RETURN
+ _Noreturn
#endif
- ;
+extern int child_setup (int, int, int, char **, bool, Lisp_Object);
extern void init_callproc_1 (void);
extern void init_callproc (void);
extern void set_initial_environment (void);
extern void syms_of_callproc (void);
-/* Defined in doc.c */
+/* Defined in doc.c. */
extern Lisp_Object Qfunction_documentation;
-EXFUN (Fsubstitute_command_keys, 1);
extern Lisp_Object read_doc_string (Lisp_Object);
-extern Lisp_Object get_doc_string (Lisp_Object, int, int);
+extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
extern void syms_of_doc (void);
-extern int read_bytecode_char (int);
+extern int read_bytecode_char (bool);
-/* Defined in bytecode.c */
+/* Defined in bytecode.c. */
extern Lisp_Object Qbytecode;
extern void syms_of_bytecode (void);
extern struct byte_stack *byte_stack_list;
extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, ptrdiff_t, Lisp_Object *);
-/* Defined in macros.c */
+/* Defined in macros.c. */
extern Lisp_Object Qexecute_kbd_macro;
-EXFUN (Fexecute_kbd_macro, 3);
-EXFUN (Fcancel_kbd_macro_events, 0);
extern void init_macros (void);
extern void syms_of_macros (void);
-/* Defined in undo.c */
+/* Defined in undo.c. */
extern Lisp_Object Qapply;
extern Lisp_Object Qinhibit_read_only;
-EXFUN (Fundo_boundary, 0);
extern void truncate_undo_list (struct buffer *);
-extern void record_marker_adjustment (Lisp_Object, EMACS_INT);
-extern void record_insert (EMACS_INT, EMACS_INT);
-extern void record_delete (EMACS_INT, Lisp_Object);
+extern void record_marker_adjustment (Lisp_Object, ptrdiff_t);
+extern void record_insert (ptrdiff_t, ptrdiff_t);
+extern void record_delete (ptrdiff_t, Lisp_Object);
extern void record_first_change (void);
-extern void record_change (EMACS_INT, EMACS_INT);
-extern void record_property_change (EMACS_INT, EMACS_INT,
+extern void record_change (ptrdiff_t, ptrdiff_t);
+extern void record_property_change (ptrdiff_t, ptrdiff_t,
Lisp_Object, Lisp_Object,
Lisp_Object);
extern void syms_of_undo (void);
-/* Defined in textprop.c */
+/* Defined in textprop.c. */
extern Lisp_Object Qfont, Qmouse_face;
extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
extern Lisp_Object Qfront_sticky, Qrear_nonsticky;
extern Lisp_Object Qminibuffer_prompt;
-EXFUN (Fnext_single_property_change, 4);
-EXFUN (Fnext_single_char_property_change, 4);
-EXFUN (Fprevious_single_property_change, 4);
-EXFUN (Fget_text_property, 3);
-EXFUN (Fput_text_property, 5);
-EXFUN (Fprevious_char_property_change, 2);
-EXFUN (Fnext_char_property_change, 2);
extern void report_interval_modification (Lisp_Object, Lisp_Object);
-/* Defined in menu.c */
+/* Defined in menu.c. */
extern void syms_of_menu (void);
-/* Defined in xmenu.c */
-EXFUN (Fx_popup_menu, 2);
-EXFUN (Fx_popup_dialog, 3);
+/* Defined in xmenu.c. */
extern void syms_of_xmenu (void);
-/* Defined in termchar.h */
+/* Defined in termchar.h. */
struct tty_display_info;
-/* Defined in termhooks.h */
+/* Defined in termhooks.h. */
struct terminal;
-/* Defined in sysdep.c */
+/* Defined in sysdep.c. */
#ifndef HAVE_GET_CURRENT_DIR_NAME
extern char *get_current_dir_name (void);
#endif
extern void reset_sys_modes (struct tty_display_info *);
extern void init_all_sys_modes (void);
extern void reset_all_sys_modes (void);
-extern void wait_for_termination (int);
-extern void interruptible_wait_for_termination (int);
-extern void flush_pending_output (int);
+extern void flush_pending_output (int) ATTRIBUTE_CONST;
extern void child_setup_tty (int);
extern void setup_pty (int);
extern int set_window_size (int, int, int);
extern EMACS_INT get_random (void);
-extern void seed_random (long);
+extern void seed_random (void *, ptrdiff_t);
+extern void init_random (void);
+extern void emacs_backtrace (int);
+extern _Noreturn void emacs_abort (void) NO_INLINE;
extern int emacs_open (const char *, int, int);
extern int emacs_close (int);
-extern EMACS_INT emacs_read (int, char *, EMACS_INT);
-extern EMACS_INT emacs_write (int, const char *, EMACS_INT);
+extern ptrdiff_t emacs_read (int, char *, ptrdiff_t);
+extern ptrdiff_t emacs_write (int, const char *, ptrdiff_t);
enum { READLINK_BUFSIZE = 1024 };
extern char *emacs_readlink (const char *, char [READLINK_BUFSIZE]);
-EXFUN (Funlock_buffer, 0);
extern void unlock_all_files (void);
extern void lock_file (Lisp_Object);
extern void unlock_file (Lisp_Object);
extern void unlock_buffer (struct buffer *);
extern void syms_of_filelock (void);
-extern void init_filelock (void);
-/* Defined in sound.c */
+/* Defined in sound.c. */
extern void syms_of_sound (void);
-extern void init_sound (void);
-/* Defined in category.c */
+/* Defined in category.c. */
extern void init_category_once (void);
extern Lisp_Object char_category_set (int);
extern void syms_of_category (void);
-/* Defined in ccl.c */
+/* Defined in ccl.c. */
extern void syms_of_ccl (void);
-/* Defined in dired.c */
+/* Defined in dired.c. */
extern void syms_of_dired (void);
extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
- int, Lisp_Object);
+ bool, Lisp_Object);
-/* Defined in term.c */
+/* Defined in term.c. */
extern int *char_ins_del_vector;
-extern void mark_ttys (void);
extern void syms_of_term (void);
-extern void fatal (const char *msgid, ...)
- NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 2);
+extern _Noreturn void fatal (const char *msgid, ...)
+ ATTRIBUTE_FORMAT_PRINTF (1, 2);
-/* Defined in terminal.c */
-EXFUN (Fframe_terminal, 1);
-EXFUN (Fdelete_terminal, 2);
+/* Defined in terminal.c. */
extern void syms_of_terminal (void);
-/* Defined in font.c */
+/* Defined in font.c. */
extern void syms_of_font (void);
extern void init_font (void);
#ifdef HAVE_WINDOW_SYSTEM
-/* Defined in fontset.c */
+/* Defined in fontset.c. */
extern void syms_of_fontset (void);
-/* Defined in xfns.c, w32fns.c, or macfns.c */
+/* Defined in xfns.c, w32fns.c, or macfns.c. */
extern Lisp_Object Qfont_param;
-EXFUN (Fxw_display_color_p, 1);
-EXFUN (Fx_focus_frame, 1);
#endif
-/* Defined in xfaces.c */
+/* Defined in xfaces.c. */
extern Lisp_Object Qdefault, Qtool_bar, Qfringe;
extern Lisp_Object Qheader_line, Qscroll_bar, Qcursor;
extern Lisp_Object Qmode_line_inactive;
extern Lisp_Object Qnormal;
extern Lisp_Object QCfamily, QCweight, QCslant;
extern Lisp_Object QCheight, QCname, QCwidth, QCforeground, QCbackground;
+extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold;
+extern Lisp_Object Qbold, Qextra_bold, Qultra_bold;
+extern Lisp_Object Qoblique, Qitalic;
extern Lisp_Object Vface_alternative_font_family_alist;
extern Lisp_Object Vface_alternative_font_registry_alist;
-EXFUN (Fclear_face_cache, 1);
-EXFUN (Fx_load_color_file, 1);
extern void syms_of_xfaces (void);
#ifdef HAVE_X_WINDOWS
-/* Defined in xfns.c */
+/* Defined in xfns.c. */
extern void syms_of_xfns (void);
-/* Defined in xsmfns.c */
+/* Defined in xsmfns.c. */
extern void syms_of_xsmfns (void);
-/* Defined in xselect.c */
+/* Defined in xselect.c. */
extern void syms_of_xselect (void);
-/* Defined in xterm.c */
+/* Defined in xterm.c. */
extern void syms_of_xterm (void);
#endif /* HAVE_X_WINDOWS */
#ifdef HAVE_WINDOW_SYSTEM
-/* Defined in xterm.c, nsterm.m, w32term.c */
+/* Defined in xterm.c, nsterm.m, w32term.c. */
extern char *x_get_keysym_name (int);
#endif /* HAVE_WINDOW_SYSTEM */
-#ifdef MSDOS
-/* Defined in msdos.c */
-EXFUN (Fmsdos_downcase_filename, 1);
-#endif
-
#ifdef HAVE_LIBXML2
-/* Defined in xml.c */
+/* Defined in xml.c. */
extern void syms_of_xml (void);
+extern void xml_cleanup_parser (void);
#endif
#ifdef HAVE_MENUS
#endif
#ifdef HAVE_DBUS
-/* Defined in dbusbind.c */
+/* Defined in dbusbind.c. */
void syms_of_dbusbind (void);
#endif
+
+/* Defined in profiler.c. */
+extern bool profiler_memory_running;
+extern void malloc_probe (size_t);
+extern void syms_of_profiler (void);
+
+
#ifdef DOS_NT
-/* Defined in msdos.c, w32.c */
+/* Defined in msdos.c, w32.c. */
extern char *emacs_root_dir (void);
#endif /* DOS_NT */
-
-#ifdef REL_ALLOC
-/* Defined in ralloc.c */
-extern void r_alloc_reset_variable (POINTER_TYPE **, POINTER_TYPE **);
-extern POINTER_TYPE *r_alloc (POINTER_TYPE **, size_t);
-extern POINTER_TYPE *r_re_alloc (POINTER_TYPE **, size_t);
-extern void r_alloc_free (POINTER_TYPE **ptr);
-extern void r_alloc_inhibit_buffer_relocation (int);
-#endif /* REL_ALLOC */
\f
-/* Nonzero means Emacs has already been initialized.
+/* True means Emacs has already been initialized.
Used during startup to detect startup of dumped Emacs. */
-extern int initialized;
+extern bool initialized;
-extern int immediate_quit; /* Nonzero means ^G can quit instantly */
+extern int immediate_quit; /* Nonzero means ^G can quit instantly. */
-extern POINTER_TYPE *xmalloc (size_t);
-extern POINTER_TYPE *xrealloc (POINTER_TYPE *, size_t);
-extern void xfree (POINTER_TYPE *);
+extern void *xmalloc (size_t);
+extern void *xzalloc (size_t);
+extern void *xrealloc (void *, size_t);
+extern void xfree (void *);
extern void *xnmalloc (ptrdiff_t, ptrdiff_t);
extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t);
extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
/* Set up the name of the machine we're running on. */
extern void init_system_name (void);
-/* Some systems (e.g., NT) use a different path separator than Unix,
- in addition to a device separator. Set the path separator
- to '/', and don't test for a device separator in IS_ANY_SEP. */
-
-#define DIRECTORY_SEP '/'
-#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
-#ifndef IS_ANY_SEP
-#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_))
-#endif
-
-#define SWITCH_ENUM_CAST(x) (x)
-
-/* 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
-
-/* The ubiquitous min and max macros. */
-
-#ifdef max
-#undef max
-#undef min
-#endif
-#define min(a, b) ((a) < (b) ? (a) : (b))
-#define max(a, b) ((a) > (b) ? (a) : (b))
-
/* 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. */
#define make_fixnum_or_float(val) \
(FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val))
-
-/* Checks the `cycle check' variable CHECK to see if it indicates that
- EL is part of a cycle; CHECK must be either Qnil or a value returned
- by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
- elements after which a cycle might be suspected; after that many
- elements, this macro begins consing in order to keep more precise
- track of elements.
-
- Returns nil if a cycle was detected, otherwise a new value for CHECK
- that includes EL.
-
- CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
- the caller should make sure that's ok. */
-
-#define CYCLE_CHECK(check, el, suspicious) \
- (NILP (check) \
- ? make_number (0) \
- : (INTEGERP (check) \
- ? (XFASTINT (check) < (suspicious) \
- ? make_number (XFASTINT (check) + 1) \
- : Fcons (el, Qnil)) \
- : (!NILP (Fmemq ((el), (check))) \
- ? Qnil \
- : Fcons ((el), (check)))))
-
-
/* SAFE_ALLOCA normally allocates memory on the stack, but if size is
larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */
-#define MAX_ALLOCA 16*1024
+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 \
- int sa_count = (int) SPECPDL_INDEX (), sa_must_free = 0
+ ptrdiff_t sa_count = SPECPDL_INDEX (); bool 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 = (type) 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
/* 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 = (Lisp_Object *) 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)
#include "globals.h"
+/* Check whether it's time for GC, and run it if so. */
+
+LISP_INLINE void
+maybe_gc (void)
+{
+ if ((consing_since_gc > gc_cons_threshold
+ && consing_since_gc > gc_relative_threshold)
+ || (!NILP (Vmemory_full)
+ && consing_since_gc > memory_full_cons_threshold))
+ Fgarbage_collect ();
+}
+
+LISP_INLINE int
+functionp (Lisp_Object object)
+{
+ if (SYMBOLP (object) && !NILP (Ffboundp (object)))
+ {
+ object = Findirect_function (object, Qt);
+
+ if (CONSP (object) && EQ (XCAR (object), Qautoload))
+ {
+ /* Autoloaded symbols are functions, except if they load
+ macros or keymaps. */
+ int i;
+ for (i = 0; i < 4 && CONSP (object); i++)
+ object = XCDR (object);
+
+ return ! (CONSP (object) && !NILP (XCAR (object)));
+ }
+ }
+
+ if (SUBRP (object))
+ return XSUBR (object)->max_args != UNEVALLED;
+ else if (COMPILEDP (object))
+ return 1;
+ else if (CONSP (object))
+ {
+ Lisp_Object car = XCAR (object);
+ return EQ (car, Qlambda) || EQ (car, Qclosure);
+ }
+ else
+ return 0;
+}
+
+INLINE_HEADER_END
+
#endif /* EMACS_LISP_H */
## sed -e 's/"[ )].*//' -n -e '/(load "/ s/.*load "//p' loadup.el | \
## grep -vE 'site-|ldefs-boot'
## minus any duplicates.
-## Note that you cannot just add a ".elc" extension to every file,
-## since some of them are no-byte-compile (eg some language/ ones).
+## Note that you can generally just add a ".elc" extension to every file
+## that does not have an explicit .el extension, but beware of any
+## no-byte-compile ones.
## Confusingly, term/internal is not in loadup, but is unconditionally
## loaded by pc-win, which is.
$(lispsource)/emacs-lisp/byte-run.elc \
$(lispsource)/emacs-lisp/backquote.elc \
$(lispsource)/subr.elc \
- $(lispsource)/version.el \
+ $(lispsource)/version.elc \
$(lispsource)/widget.elc \
$(lispsource)/custom.elc \
$(lispsource)/emacs-lisp/map-ynp.elc \
$(lispsource)/format.elc \
$(lispsource)/bindings.elc \
$(lispsource)/files.elc \
+ $(lispsource)/emacs-lisp/macroexp.elc \
$(lispsource)/cus-face.elc \
$(lispsource)/faces.elc \
$(lispsource)/button.elc \
$(lispsource)/language/chinese.elc \
$(lispsource)/language/cyrillic.elc \
$(lispsource)/language/indian.elc \
- $(lispsource)/language/sinhala.el \
- $(lispsource)/language/english.el \
+ $(lispsource)/language/sinhala.elc \
+ $(lispsource)/language/english.elc \
$(lispsource)/language/ethiopic.elc \
$(lispsource)/language/european.elc \
- $(lispsource)/language/czech.el \
- $(lispsource)/language/slovak.el \
- $(lispsource)/language/romanian.el \
- $(lispsource)/language/greek.el \
+ $(lispsource)/language/czech.elc \
+ $(lispsource)/language/slovak.elc \
+ $(lispsource)/language/romanian.elc \
+ $(lispsource)/language/greek.elc \
$(lispsource)/language/hebrew.elc \
- $(lispsource)/language/japanese.el \
- $(lispsource)/language/korean.el \
- $(lispsource)/language/lao.el \
- $(lispsource)/language/tai-viet.el \
- $(lispsource)/language/thai.el \
+ $(lispsource)/language/japanese.elc \
+ $(lispsource)/language/korean.elc \
+ $(lispsource)/language/lao.elc \
+ $(lispsource)/language/tai-viet.elc \
+ $(lispsource)/language/thai.elc \
$(lispsource)/language/tibetan.elc \
$(lispsource)/language/vietnamese.elc \
- $(lispsource)/language/misc-lang.el \
- $(lispsource)/language/utf-8-lang.el \
- $(lispsource)/language/georgian.el \
- $(lispsource)/language/khmer.el \
- $(lispsource)/language/burmese.el \
- $(lispsource)/language/cham.el \
+ $(lispsource)/language/misc-lang.elc \
+ $(lispsource)/language/utf-8-lang.elc \
+ $(lispsource)/language/georgian.elc \
+ $(lispsource)/language/khmer.elc \
+ $(lispsource)/language/burmese.elc \
+ $(lispsource)/language/cham.elc \
$(lispsource)/indent.elc \
$(lispsource)/window.elc \
$(lispsource)/frame.elc \
$(lispsource)/isearch.elc \
$(lispsource)/rfn-eshadow.elc \
$(lispsource)/menu-bar.elc \
- $(lispsource)/paths.el \
$(lispsource)/emacs-lisp/lisp.elc \
$(lispsource)/textmodes/page.elc \
$(lispsource)/register.elc \
$(lispsource)/emacs-lisp/lisp-mode.elc \
$(lispsource)/textmodes/text-mode.elc \
$(lispsource)/textmodes/fill.elc \
+ $(lispsource)/newcomment.elc \
$(lispsource)/replace.elc \
+ $(lispsource)/emacs-lisp/tabulated-list.elc \
$(lispsource)/buff-menu.elc \
$(lispsource)/fringe.elc \
+ $(lispsource)/emacs-lisp/regexp-opt.elc \
$(lispsource)/image.elc \
$(lispsource)/international/fontset.elc \
$(lispsource)/dnd.elc \
#include <sys/stat.h>
#include <sys/file.h>
#include <errno.h>
-#include <limits.h> /* for CHAR_BIT */
-#include <setjmp.h>
+#include <limits.h> /* For CHAR_BIT. */
+#include <stat-time.h>
#include "lisp.h"
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include <epaths.h>
#include "msdos.h"
#endif
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif
+
#include <unistd.h>
-#include <math.h>
#ifdef HAVE_SETLOCALE
#include <locale.h>
#define file_tell ftell
#endif
-/* hash table read constants */
+/* Hash table read constants. */
static Lisp_Object Qhash_table, Qdata;
static Lisp_Object Qtest, Qsize;
static Lisp_Object Qweakness;
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
static Lisp_Object Qinhibit_file_name_operation;
static Lisp_Object Qeval_buffer_list;
-static Lisp_Object Qlexical_binding;
+Lisp_Object Qlexical_binding;
static Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
/* Used instead of Qget_file_char while loading *.elc files compiled
static Lisp_Object Qload_force_doc_strings;
-extern Lisp_Object Qinternal_interpreter_environment;
-
static Lisp_Object Qload_in_progress;
/* The association list of objects read with the #n=object form.
/* File for get_file_char to read from. Use by load. */
static FILE *instream;
-/* When nonzero, read conses in pure space */
-static int read_pure;
-
/* For use within read-from-string (this reader is non-reentrant!!) */
-static EMACS_INT read_from_string_index;
-static EMACS_INT read_from_string_index_byte;
-static EMACS_INT read_from_string_limit;
+static ptrdiff_t read_from_string_index;
+static ptrdiff_t read_from_string_index_byte;
+static ptrdiff_t read_from_string_limit;
/* Number of characters read in the current call to Fread or
- Fread_from_string. */
+ Fread_from_string. */
static EMACS_INT readchar_count;
/* This contains the last string skipped with #@. */
Lisp_Object, Lisp_Object);
static Lisp_Object load_unwind (Lisp_Object);
static Lisp_Object load_descriptor_unwind (Lisp_Object);
-
-static void invalid_syntax (const char *) NO_RETURN;
-static void end_of_file_error (void) NO_RETURN;
-
\f
/* Functions that read one byte from the current source READCHARFUN
or unreads one byte. If the integer argument C is -1, it returns
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Qlambda, or a cons, we use this to keep an unread character because
a file stream can't handle multibyte-char unreading. The value -1
- means that there's no unread character. */
+ means that there's no unread character. */
static int unread_char;
static int
-readchar (Lisp_Object readcharfun, int *multibyte)
+readchar (Lisp_Object readcharfun, bool *multibyte)
{
Lisp_Object tem;
register int c;
{
register struct buffer *inbuffer = XBUFFER (readcharfun);
- EMACS_INT pt_byte = BUF_PT_BYTE (inbuffer);
+ ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
if (pt_byte >= BUF_ZV_BYTE (inbuffer))
return -1;
{
register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
- EMACS_INT bytepos = marker_byte_position (readcharfun);
+ ptrdiff_t bytepos = marker_byte_position (readcharfun);
if (bytepos >= BUF_ZV_BYTE (inbuffer))
return -1;
else if (BUFFERP (readcharfun))
{
struct buffer *b = XBUFFER (readcharfun);
- EMACS_INT charpos = BUF_PT (b);
- EMACS_INT bytepos = BUF_PT_BYTE (b);
+ ptrdiff_t charpos = BUF_PT (b);
+ ptrdiff_t bytepos = BUF_PT_BYTE (b);
if (! NILP (BVAR (b, enable_multibyte_characters)))
BUF_DEC_POS (b, bytepos);
else if (MARKERP (readcharfun))
{
struct buffer *b = XMARKER (readcharfun)->buffer;
- EMACS_INT bytepos = XMARKER (readcharfun)->bytepos;
+ ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
XMARKER (readcharfun)->charpos--;
if (! NILP (BVAR (b, enable_multibyte_characters)))
{
if (load_each_byte)
{
- BLOCK_INPUT;
+ block_input ();
ungetc (c, instream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
unread_char = c;
{
if (c >= 0)
{
- BLOCK_INPUT;
+ block_input ();
ungetc (c, instream);
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
- BLOCK_INPUT;
+ block_input ();
c = getc (instream);
#ifdef EINTR
- /* Interrupted reads have been observed while reading over the network */
+ /* Interrupted reads have been observed while reading over the network. */
while (c == EOF && ferror (instream) && errno == EINTR)
{
- UNBLOCK_INPUT;
+ unblock_input ();
QUIT;
- BLOCK_INPUT;
+ block_input ();
clearerr (instream);
c = getc (instream);
}
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
return (c == EOF ? -1 : c);
}
/* Compute timeout. */
if (NUMBERP (seconds))
{
- EMACS_TIME wait_time;
- int sec, usec;
double duration = extract_float (seconds);
-
- sec = (int) duration;
- usec = (duration - sec) * 1000000;
- EMACS_GET_TIME (end_time);
- EMACS_SET_SECS_USECS (wait_time, sec, usec);
- EMACS_ADD_TIME (end_time, end_time, wait_time);
+ EMACS_TIME wait_time = EMACS_TIME_FROM_DOUBLE (duration);
+ end_time = add_emacs_time (current_emacs_time (), wait_time);
}
/* Read until we get an acceptable event. */
(void)
{
register Lisp_Object val;
- BLOCK_INPUT;
+ block_input ();
XSETINT (val, getc (instream));
- UNBLOCK_INPUT;
+ unblock_input ();
return val;
}
/* Return true if the lisp code read using READCHARFUN defines a non-nil
`lexical-binding' file variable. After returning, the stream is
- positioned following the first line, if it is a comment, otherwise
- nothing is read. */
+ positioned following the first line, if it is a comment or #! line,
+ otherwise nothing is read. */
static int
lisp_file_lexically_bound_p (Lisp_Object readcharfun)
{
int ch = READCHAR;
+
+ if (ch == '#')
+ {
+ ch = READCHAR;
+ if (ch != '!')
+ {
+ UNREAD (ch);
+ UNREAD ('#');
+ return 0;
+ }
+ while (ch != '\n' && ch != EOF)
+ ch = READCHAR;
+ if (ch == '\n') ch = READCHAR;
+ /* It is OK to leave the position after a #! line, since
+ that is what read1 does. */
+ }
+
if (ch != ';')
/* The first line isn't a comment, just give up. */
{
if (i >= nbytes
|| fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
- buf + i) < 0)
+ buf + i, nbytes - i) < 0)
safe_p = 0;
}
if (safe_p)
{
register FILE *stream;
register int fd = -1;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
/* 1 means we printed the ".el is newer" message. */
/* Avoid weird lossage with null string as arg,
- since it would try to load a directory as a Lisp file */
+ since it would try to load a directory as a Lisp file. */
if (SBYTES (file) > 0)
{
ptrdiff_t size = SBYTES (file);
Vload_source_file_function. */
specbind (Qlexical_binding, Qnil);
- /* Get the name for load-history. */
+ /* Get the name for load-history. */
hist_file_name = (! NILP (Vpurify_flag)
? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
tmp[1] = Ffile_name_nondirectory (found),
SSET (efound, SBYTES (efound) - 1, 'c');
}
- if (result == 0 && s1.st_mtime < s2.st_mtime)
+ if (result == 0
+ && EMACS_TIME_LT (get_stat_mtime (&s1), get_stat_mtime (&s2)))
{
/* Make the progress messages mention that source is newer. */
newer = 1;
}
unbind_to (count, Qnil);
- /* Run any eval-after-load forms for this file */
+ /* Run any eval-after-load forms for this file. */
if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
call1 (Qdo_after_load_evaluation, hist_file_name) ;
}
static Lisp_Object
-load_unwind (Lisp_Object arg) /* used as unwind-protect function in load */
+load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */
{
FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
if (stream != NULL)
{
- BLOCK_INPUT;
+ block_input ();
fclose (stream);
- UNBLOCK_INPUT;
+ unblock_input ();
}
return Qnil;
}
openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
{
register int fd;
- EMACS_INT fn_size = 100;
+ ptrdiff_t fn_size = 100;
char buf[100];
register char *fn = buf;
int absolute = 0;
- EMACS_INT want_length;
+ ptrdiff_t want_length;
Lisp_Object filename;
struct stat st;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
Lisp_Object string, tail, encoded_fn;
- EMACS_INT max_suffix_len = 0;
+ ptrdiff_t max_suffix_len = 0;
CHECK_STRING (str);
{
filename = Fexpand_file_name (str, XCAR (path));
if (!complete_filename_p (filename))
- /* If there are non-absolute elts in PATH (eg ".") */
+ /* If there are non-absolute elts in PATH (eg "."). */
/* Of course, this could conceivably lose if luser sets
- default-directory to be something non-absolute... */
+ default-directory to be something non-absolute... */
{
filename = Fexpand_file_name (filename, BVAR (current_buffer, directory));
if (!complete_filename_p (filename))
- /* Give up on this path element! */
+ /* Give up on this path element! */
continue;
}
this path element/specified file name and any possible suffix. */
want_length = max_suffix_len + SBYTES (filename);
if (fn_size <= want_length)
- fn = (char *) alloca (fn_size = 100 + want_length);
+ fn = alloca (fn_size = 100 + want_length);
/* Loop over suffixes. */
for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
CONSP (tail); tail = XCDR (tail))
{
- ptrdiff_t lsuffix = SBYTES (XCAR (tail));
+ ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
Lisp_Object handler;
int exists;
/* Concatenate path element/specified name with the suffix.
If the directory starts with /:, remove that. */
- if (SCHARS (filename) > 2
- && SREF (filename, 0) == '/'
- && SREF (filename, 1) == ':')
- {
- strncpy (fn, SSDATA (filename) + 2,
- SBYTES (filename) - 2);
- fn[SBYTES (filename) - 2] = 0;
- }
- else
- {
- strncpy (fn, SSDATA (filename),
- SBYTES (filename));
- fn[SBYTES (filename)] = 0;
- }
-
- if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
- strncat (fn, SSDATA (XCAR (tail)), lsuffix);
-
+ int prefixlen = ((SCHARS (filename) > 2
+ && SREF (filename, 0) == '/'
+ && SREF (filename, 1) == ':')
+ ? 2 : 0);
+ fnlen = SBYTES (filename) - prefixlen;
+ memcpy (fn, SDATA (filename) + prefixlen, fnlen);
+ memcpy (fn + fnlen, SDATA (XCAR (tail)), lsuffix + 1);
+ fnlen += lsuffix;
/* Check that the file exists and is not a directory. */
/* We used to only check for handlers on non-absolute file names:
if (absolute)
handler = Ffind_file_name_handler (filename, Qfile_exists_p);
It's not clear why that was the case and it breaks things like
(load "/bar.el") where the file is actually "/bar.el.gz". */
- string = build_string (fn);
+ string = make_string (fn, fnlen);
handler = Ffind_file_name_handler (string, Qfile_exists_p);
if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{
{
/* Check that we can access or open it. */
if (NATNUMP (predicate))
- fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
+ fd = (((XFASTINT (predicate) & ~INT_MAX) == 0
+ && access (pfn, XFASTINT (predicate)) == 0)
+ ? 1 : -1);
else
fd = emacs_open (pfn, O_RDONLY, 0);
{
tem = XCAR (tail);
- /* Find the feature's previous assoc list... */
+ /* Find the feature's previous assoc list... */
if (!NILP (Fequal (filename, Fcar (tem))))
{
foundit = 1;
- /* If we're loading the entire file, remove old data. */
+ /* If we're loading the entire file, remove old data. */
if (entire)
{
if (NILP (prev))
Vload_history);
}
-static Lisp_Object
-unreadpure (Lisp_Object junk) /* Used as unwind-protect function in readevalloop */
-{
- read_pure = 0;
- return Qnil;
-}
-
static Lisp_Object
readevalloop_1 (Lisp_Object old)
{
/* Signal an `end-of-file' error, if possible with file name
information. */
-static void
+static _Noreturn void
end_of_file_error (void)
{
if (STRINGP (Vload_file_name))
{
register int c;
register Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct buffer *b = 0;
int continue_reading_p;
int whole_buffer = 0;
/* 1 on the first time around. */
int first_sexp = 1;
+ Lisp_Object macroexpand = intern ("internal-macroexpand-for-load");
+
+ if (NILP (Ffboundp (macroexpand))
+ /* Don't macroexpand in .elc files, since it should have been done
+ already. We actually don't know whether we're in a .elc file or not,
+ so we use circumstancial evidence: .el files normally go through
+ Vload_source_file_function -> load-with-code-conversion
+ -> eval-buffer. */
+ || EQ (readcharfun, Qget_file_char)
+ || EQ (readcharfun, Qget_emacs_mule_file_char))
+ macroexpand = Qnil;
if (MARKERP (readcharfun))
{
/* We assume START is nil when input is not from a buffer. */
if (! NILP (start) && !b)
- abort ();
+ emacs_abort ();
specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
specbind (Qcurrent_load_list, Qnil);
GCPRO4 (sourcename, readfun, start, end);
- /* Try to ensure sourcename is a truename, except whilst preloading. */
+ /* Try to ensure sourcename is a truename, except whilst preloading. */
if (NILP (Vpurify_flag)
&& !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
&& !NILP (Ffboundp (Qfile_truename)))
continue_reading_p = 1;
while (continue_reading_p)
{
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
- if (b != 0 && NILP (BVAR (b, name)))
+ if (b != 0 && !BUFFER_LIVE_P (b))
error ("Reading from killed buffer");
if (!NILP (start))
if (!NILP (Vpurify_flag) && c == '(')
{
- record_unwind_protect (unreadpure, Qnil);
- val = read_list (-1, readcharfun);
+ val = read_list (0, readcharfun);
}
else
{
unbind_to (count1, Qnil);
/* Now eval what we just read. */
+ if (!NILP (macroexpand))
+ val = call1 (macroexpand, val);
val = eval_sub (val);
if (printflag)
This function preserves the position of point. */)
(Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object tem, buf;
if (NILP (buffer))
(Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
{
/* FIXME: Do the eval-sexp-add-defvars dance! */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object tem, cbuf;
cbuf = Fcurrent_buffer ();
specbind (Qstandard_output, tem);
specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
- /* readevalloop calls functions which check the type of start and end. */
+ /* `readevalloop' calls functions which check the type of start and end. */
readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename),
!NILP (printflag), Qnil, read_function,
start, end);
{
Lisp_Object ret;
CHECK_STRING (string);
- /* read_internal_start sets read_from_string_index. */
+ /* `read_internal_start' sets `read_from_string_index'. */
ret = read_internal_start (string, start, end);
return Fcons (ret, make_number (read_from_string_index));
}
/* Function to set up the global context we need in toplevel read
- calls. */
+ calls. */
static Lisp_Object
read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
-/* start, end only used when stream is a string. */
+/* `start', `end' only used when stream is a string. */
{
Lisp_Object retval;
if (STRINGP (stream)
|| ((CONSP (stream) && STRINGP (XCAR (stream)))))
{
- EMACS_INT startval, endval;
+ ptrdiff_t startval, endval;
Lisp_Object string;
if (STRINGP (stream))
else
{
CHECK_NUMBER (end);
- endval = XINT (end);
- if (endval < 0 || endval > SCHARS (string))
+ if (! (0 <= XINT (end) && XINT (end) <= SCHARS (string)))
args_out_of_range (string, end);
+ endval = XINT (end);
}
if (NILP (start))
else
{
CHECK_NUMBER (start);
- startval = XINT (start);
- if (startval < 0 || startval > endval)
+ if (! (0 <= XINT (start) && XINT (start) <= endval))
args_out_of_range (string, start);
+ startval = XINT (start);
}
read_from_string_index = startval;
read_from_string_index_byte = string_char_to_byte (string, startval);
/* Signal Qinvalid_read_syntax error.
S is error string of length N (if > 0) */
-static void
+static _Noreturn void
invalid_syntax (const char *s)
{
xsignal1 (Qinvalid_read_syntax, build_string (s));
/* Use this for recursive reads, in contexts where internal tokens
- are not allowed. */
+ are not allowed. */
static Lisp_Object
read0 (Lisp_Object readcharfun)
{
register int c = READCHAR;
/* \u allows up to four hex digits, \U up to eight. Default to the
- behavior for \u, and change this value in the case that \U is seen. */
+ behavior for \u, and change this value in the case that \U is seen. */
int unicode_hex_count = 4;
switch (c)
while (++count <= unicode_hex_count)
{
c = READCHAR;
- /* isdigit and isalpha may be locale-specific, which we don't
- want. */
+ /* `isdigit' and `isalpha' may be locale-specific, which we don't
+ want. */
if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
static Lisp_Object
read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
- register int c;
- unsigned uninterned_symbol = 0;
- int multibyte;
+ int c;
+ bool uninterned_symbol = 0;
+ bool multibyte;
*pch = 0;
load_each_byte = 0;
{
/* Accept extended format for hashtables (extensible to
other types), e.g.
- #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
+ #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
Lisp_Object tmp = read_list (0, readcharfun);
Lisp_Object head = CAR_SAFE (tmp);
Lisp_Object data = Qnil;
Lisp_Object val = Qnil;
/* The size is 2 * number of allowed keywords to
- make-hash-table. */
+ make-hash-table. */
Lisp_Object params[10];
Lisp_Object ht;
Lisp_Object key = Qnil;
tmp = CDR_SAFE (tmp);
- /* This is repetitive but fast and simple. */
+ /* This is repetitive but fast and simple. */
params[param_count] = QCsize;
- params[param_count+1] = Fplist_get (tmp, Qsize);
+ params[param_count + 1] = Fplist_get (tmp, Qsize);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCtest;
- params[param_count+1] = Fplist_get (tmp, Qtest);
+ params[param_count + 1] = Fplist_get (tmp, Qtest);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCweakness;
- params[param_count+1] = Fplist_get (tmp, Qweakness);
+ params[param_count + 1] = Fplist_get (tmp, Qweakness);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCrehash_size;
- params[param_count+1] = Fplist_get (tmp, Qrehash_size);
+ params[param_count + 1] = Fplist_get (tmp, Qrehash_size);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCrehash_threshold;
- params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
+ params[param_count + 1] = Fplist_get (tmp, Qrehash_threshold);
if (!NILP (params[param_count + 1]))
param_count += 2;
- /* This is the hashtable data. */
+ /* This is the hashtable data. */
data = Fplist_get (tmp, Qdata);
- /* Now use params to make a new hashtable and fill it. */
+ /* Now use params to make a new hashtable and fill it. */
ht = Fmake_hash_table (param_count, params);
while (CONSP (data))
if (c == '[')
{
Lisp_Object tmp;
- EMACS_INT depth, size;
+ int depth;
+ ptrdiff_t size;
tmp = read_vector (readcharfun, 0);
- if (!INTEGERP (AREF (tmp, 0)))
+ size = ASIZE (tmp);
+ if (size == 0)
+ error ("Invalid size char-table");
+ if (! RANGED_INTEGERP (1, AREF (tmp, 0), 3))
error ("Invalid depth in char-table");
depth = XINT (AREF (tmp, 0));
- if (depth < 1 || depth > 3)
- error ("Invalid depth in char-table");
- size = ASIZE (tmp) - 2;
- if (chartab_size [depth] != size)
+ if (chartab_size[depth] != size - 2)
error ("Invalid size char-table");
XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
return tmp;
build them using function calls. */
Lisp_Object tmp;
tmp = read_vector (readcharfun, 1);
- return Fmake_byte_code (ASIZE (tmp),
- XVECTOR (tmp)->contents);
+ make_byte_code (XVECTOR (tmp));
+ return tmp;
}
if (c == '(')
{
if (saved_doc_string_size == 0)
{
- saved_doc_string = (char *) xmalloc (nskip + extra);
+ saved_doc_string = xmalloc (nskip + extra);
saved_doc_string_size = nskip + extra;
}
if (nskip > saved_doc_string_size)
{
- saved_doc_string = (char *) xrealloc (saved_doc_string,
- nskip + extra);
+ saved_doc_string = xrealloc (saved_doc_string, nskip + extra);
saved_doc_string_size = nskip + extra;
}
/* No symbol character follows, this is the empty
symbol. */
UNREAD (c);
- return Fmake_symbol (build_string (""));
+ return Fmake_symbol (empty_unibyte_string);
}
goto read_symbol;
}
/* ## is the empty symbol. */
if (c == '#')
- return Fintern (build_string (""), Qnil);
+ return Fintern (empty_unibyte_string, Qnil);
/* Reader forms that can reuse previously read objects. */
if (c >= '0' && c <= '9')
{
n for #n#. */
if (c == '=')
{
- /* Make a placeholder for #n# to use temporarily */
+ /* Make a placeholder for #n# to use temporarily. */
Lisp_Object placeholder;
Lisp_Object cell;
cell = Fcons (make_number (n), placeholder);
read_objects = Fcons (cell, read_objects);
- /* Read the object itself. */
+ /* Read the object itself. */
tem = read0 (readcharfun);
- /* Now put it everywhere the placeholder was... */
+ /* Now put it everywhere the placeholder was... */
substitute_object_in_subtree (tem, placeholder);
/* ...and #n# will use the real value from now on. */
ptrdiff_t offset = p - read_buffer;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
memory_full (SIZE_MAX);
- read_buffer = (char *) xrealloc (read_buffer,
- read_buffer_size * 2);
+ read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
read_buffer_size *= 2;
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
ch = read_escape (readcharfun, 1);
- /* CH is -1 if \ newline has just been seen */
+ /* CH is -1 if \ newline has just been seen. */
if (ch == -1)
{
if (p == read_buffer)
force_singlebyte = 1;
else if (! ASCII_CHAR_P (ch))
force_multibyte = 1;
- else /* i.e. ASCII_CHAR_P (ch) */
+ else /* I.e. ASCII_CHAR_P (ch). */
{
/* Allow `\C- ' and `\C-?'. */
if (modifiers == CHAR_CTL)
/* If purifying, and string starts with \ newline,
return zero instead. This is for doc strings
- that we are really going to find in etc/DOC.nn.nn */
+ that we are really going to find in etc/DOC.nn.nn. */
if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
return make_number (0);
- if (force_multibyte)
- /* READ_BUFFER already contains valid multibyte forms. */
- ;
- else if (force_singlebyte)
+ if (! force_multibyte && force_singlebyte)
{
+ /* READ_BUFFER contains raw 8-bit bytes and no multibyte
+ forms. Convert it to unibyte. */
nchars = str_as_unibyte ((unsigned char *) read_buffer,
p - read_buffer);
p = read_buffer + nchars;
}
- else
- {
- /* Otherwise, READ_BUFFER contains only ASCII. */
- }
- if (read_pure)
- return make_pure_string (read_buffer, nchars, p - read_buffer,
- (force_multibyte
- || (p - read_buffer != nchars)));
return make_specified_string (read_buffer, nchars, p - read_buffer,
(force_multibyte
|| (p - read_buffer != nchars)));
ptrdiff_t offset = p - read_buffer;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
memory_full (SIZE_MAX);
- read_buffer = (char *) xrealloc (read_buffer,
- read_buffer_size * 2);
+ read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
read_buffer_size *= 2;
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
ptrdiff_t offset = p - read_buffer;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
memory_full (SIZE_MAX);
- read_buffer = (char *) xrealloc (read_buffer,
- read_buffer_size * 2);
+ read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
read_buffer_size *= 2;
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
{
Lisp_Object name, result;
- EMACS_INT nbytes = p - read_buffer;
- EMACS_INT nchars
+ ptrdiff_t nbytes = p - read_buffer;
+ ptrdiff_t nchars
= (multibyte
? multibyte_chars_in_text ((unsigned char *) read_buffer,
nbytes)
: nbytes);
- if (uninterned_symbol && ! NILP (Vpurify_flag))
- name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
- else
- name = make_specified_string (read_buffer, nchars, nbytes, multibyte);
+ name = ((uninterned_symbol && ! NILP (Vpurify_flag)
+ ? make_pure_string : make_specified_string)
+ (read_buffer, nchars, nbytes, multibyte));
result = (uninterned_symbol ? Fmake_symbol (name)
: Fintern (name, Qnil));
if (EQ (Vread_with_symbol_positions, Qt)
|| EQ (Vread_with_symbol_positions, readcharfun))
- Vread_symbol_positions_list =
- Fcons (Fcons (result, make_number (start_position)),
- Vread_symbol_positions_list);
+ Vread_symbol_positions_list
+ = Fcons (Fcons (result, make_number (start_position)),
+ Vread_symbol_positions_list);
return result;
}
}
}
\f
-/* List of nodes we've seen during substitute_object_in_subtree. */
+/* List of nodes we've seen during substitute_object_in_subtree. */
static Lisp_Object seen_list;
static void
{
Lisp_Object check_object;
- /* We haven't seen any objects when we start. */
+ /* We haven't seen any objects when we start. */
seen_list = Qnil;
- /* Make all the substitutions. */
+ /* Make all the substitutions. */
check_object
= substitute_object_recurse (object, placeholder, object);
- /* Clear seen_list because we're done with it. */
+ /* Clear seen_list because we're done with it. */
seen_list = Qnil;
/* The returned object here is expected to always eq the
- original. */
+ original. */
if (!EQ (check_object, object))
error ("Unexpected mutation error in reader");
}
-/* Feval doesn't get called from here, so no gc protection is needed. */
+/* Feval doesn't get called from here, so no gc protection is needed. */
#define SUBSTITUTE(get_val, set_val) \
do { \
Lisp_Object old_value = get_val; \
static Lisp_Object
substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree)
{
- /* If we find the placeholder, return the target object. */
+ /* If we find the placeholder, return the target object. */
if (EQ (placeholder, subtree))
return object;
- /* If we've been to this node before, don't explore it again. */
+ /* If we've been to this node before, don't explore it again. */
if (!EQ (Qnil, Fmemq (subtree, seen_list)))
return subtree;
case Lisp_String:
{
/* Check for text properties in each interval.
- substitute_in_interval contains part of the logic. */
+ substitute_in_interval contains part of the logic. */
- INTERVAL root_interval = STRING_INTERVALS (subtree);
- Lisp_Object arg = Fcons (object, placeholder);
+ INTERVAL root_interval = string_intervals (subtree);
+ Lisp_Object arg = Fcons (object, placeholder);
traverse_intervals_noorder (root_interval,
&substitute_in_interval, arg);
return subtree;
}
- /* Other types don't recurse any further. */
+ /* Other types don't recurse any further. */
default:
return subtree;
}
Lisp_Object object = Fcar (arg);
Lisp_Object placeholder = Fcdr (arg);
- SUBSTITUTE (interval->plist, interval->plist = true_value);
+ SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value));
}
\f
tem = read_list (1, readcharfun);
len = Flength (tem);
- vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
+ vector = Fmake_vector (len, Qnil);
size = ASIZE (vector);
ptr = XVECTOR (vector)->contents;
/* Delay handling the bytecode slot until we know whether
it is lazily-loaded (we can tell by whether the
constants slot is nil). */
- ptr[COMPILED_CONSTANTS] = item;
+ ASET (vector, COMPILED_CONSTANTS, item);
item = Qnil;
}
else if (i == COMPILED_CONSTANTS)
}
/* Now handle the bytecode slot. */
- ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
+ ASET (vector, COMPILED_BYTECODE, bytestr);
}
else if (i == COMPILED_DOC_STRING
&& STRINGP (item)
item = Fstring_as_multibyte (item);
}
}
- ptr[i] = read_pure ? Fpurecopy (item) : item;
+ ASET (vector, i, item);
otem = XCONS (tem);
tem = Fcdr (tem);
free_cons (otem);
return vector;
}
-/* FLAG = 1 means check for ] to terminate rather than ) and .
- FLAG = -1 means check for starting with defun
- and make structure pure. */
+/* FLAG = 1 means check for ] to terminate rather than ) and . */
static Lisp_Object
read_list (int flag, register Lisp_Object readcharfun)
{
- /* -1 means check next element for defun,
- 0 means don't check,
- 1 means already checked and found defun. */
- int defunflag = flag < 0 ? -1 : 0;
Lisp_Object val, tail;
register Lisp_Object elt, tem;
struct gcpro gcpro1, gcpro2;
We don't use Fexpand_file_name because that would make
the directory absolute now. */
elt = concat2 (build_string ("../lisp/"),
- Ffile_name_nondirectory (elt));
+ Ffile_name_nondirectory (elt));
}
else if (EQ (elt, Vload_file_name)
&& ! NILP (elt)
}
invalid_syntax ("] in a list");
}
- tem = (read_pure && flag <= 0
- ? pure_cons (elt, Qnil)
- : Fcons (elt, Qnil));
+ tem = Fcons (elt, Qnil);
if (!NILP (tail))
XSETCDR (tail, tem);
else
val = tem;
tail = tem;
- if (defunflag < 0)
- defunflag = EQ (elt, Qdefun);
- else if (defunflag > 0)
- read_pure = 1;
}
}
\f
static Lisp_Object initial_obarray;
-/* oblookup stores the bucket number here, for the sake of Funintern. */
+/* `oblookup' stores the bucket number here, for the sake of Funintern. */
static size_t oblookup_last_bucket_number;
interned in the current obarray. */
Lisp_Object
-intern (const char *str)
+intern_1 (const char *str, ptrdiff_t len)
{
- Lisp_Object tem;
- ptrdiff_t len = strlen (str);
- Lisp_Object obarray;
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, str, len, len);
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, str, len, len);
- if (SYMBOLP (tem))
- return tem;
- return Fintern (make_string (str, len), obarray);
+ return SYMBOLP (tem) ? tem : Fintern (make_string (str, len), obarray);
}
Lisp_Object
-intern_c_string (const char *str)
+intern_c_string_1 (const char *str, ptrdiff_t len)
{
- Lisp_Object tem;
- ptrdiff_t len = strlen (str);
- Lisp_Object obarray;
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, str, len, len);
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, str, len, len);
if (SYMBOLP (tem))
return tem;
/* Creating a non-pure string from a string literal not
implemented yet. We could just use make_string here and live
with the extra copy. */
- abort ();
+ emacs_abort ();
- return Fintern (make_pure_c_string (str), obarray);
+ return Fintern (make_pure_c_string (str, len), obarray);
}
\f
DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
SET_SYMBOL_VAL (XSYMBOL (sym), sym);
}
- ptr = &XVECTOR (obarray)->contents[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;
}
hash = oblookup_last_bucket_number;
- if (EQ (XVECTOR (obarray)->contents[hash], tem))
+ if (EQ (AREF (obarray, hash), tem))
{
if (XSYMBOL (tem)->next)
- XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
+ {
+ Lisp_Object sym;
+ XSETSYMBOL (sym, XSYMBOL (tem)->next);
+ ASET (obarray, hash, sym);
+ }
else
- XSETINT (XVECTOR (obarray)->contents[hash], 0);
+ ASET (obarray, hash, make_number (0));
}
else
{
Lisp_Object tail, following;
- for (tail = XVECTOR (obarray)->contents[hash];
+ for (tail = AREF (obarray, hash);
XSYMBOL (tail)->next;
tail = following)
{
XSETSYMBOL (following, XSYMBOL (tail)->next);
if (EQ (following, tem))
{
- XSYMBOL (tail)->next = XSYMBOL (following)->next;
+ set_symbol_next (tail, XSYMBOL (following)->next);
break;
}
}
Also store the bucket number in oblookup_last_bucket_number. */
Lisp_Object
-oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_INT size_byte)
+oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte)
{
size_t hash;
size_t obsize;
register Lisp_Object tail;
Lisp_Object bucket, tem;
- if (!VECTORP (obarray)
- || (obsize = ASIZE (obarray)) == 0)
- {
- obarray = check_obarray (obarray);
- obsize = ASIZE (obarray);
- }
+ obarray = check_obarray (obarray);
+ obsize = ASIZE (obarray);
+
/* This is sometimes needed in the middle of GC. */
obsize &= ~ARRAY_MARK_FLAG;
hash = hash_string (ptr, size_byte) % obsize;
- bucket = XVECTOR (obarray)->contents[hash];
+ bucket = AREF (obarray, hash);
oblookup_last_bucket_number = hash;
if (EQ (bucket, make_number (0)))
;
else if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray"); /* Like CADR error message */
+ error ("Bad data in guts of obarray"); /* Like CADR error message. */
else
for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
{
CHECK_VECTOR (obarray);
for (i = ASIZE (obarray) - 1; i >= 0; i--)
{
- tail = XVECTOR (obarray)->contents[i];
+ tail = AREF (obarray, i);
if (SYMBOLP (tail))
while (1)
{
initial_obarray = Vobarray;
staticpro (&initial_obarray);
- Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
+ Qunbound = Fmake_symbol (build_pure_c_string ("unbound"));
/* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
NILP (Vpurify_flag) check in intern_c_string. */
Qnil = make_number (-1); Vpurify_flag = make_number (1);
/* 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);
- XSYMBOL (Qunbound)->function = Qunbound;
- 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)->plist = Qnil;
+ XSYMBOL (Qnil)->declared_special = 1;
+ set_symbol_plist (Qnil, Qnil);
Qt = intern_c_string ("t");
SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
+ XSYMBOL (Qnil)->declared_special = 1;
XSYMBOL (Qt)->constant = 1;
/* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
DEFSYM (Qvariable_documentation, "variable-documentation");
- read_buffer = (char *) xmalloc (size);
+ read_buffer = xmalloc (size);
read_buffer_size = size;
}
\f
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 (XSYMBOL (sym)->function, sname);
+ XSETSUBR (tem, sname);
+ set_symbol_function (sym, tem);
}
-#ifdef NOTDEF /* use fset in subr.el now */
+#ifdef NOTDEF /* Use fset in subr.el now! */
void
defalias (struct Lisp_Subr *sname, char *string)
{
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);
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
}
\f
+/* Check that the elements of Vload_path exist. */
+
+static void
+load_path_check (void)
+{
+ Lisp_Object path_tail;
+
+ /* The only elements that might not exist are those from
+ PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
+ it exists. */
+ for (path_tail = Vload_path; !NILP (path_tail); path_tail = XCDR (path_tail))
+ {
+ Lisp_Object dirfile;
+ dirfile = Fcar (path_tail);
+ if (STRINGP (dirfile))
+ {
+ dirfile = Fdirectory_file_name (dirfile);
+ if (access (SSDATA (dirfile), 0) < 0)
+ dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
+ XCAR (path_tail));
+ }
+ }
+}
+
/* Record the value of load-path used at the start of dumping
so we can see if the site changed it later during dumping. */
static Lisp_Object dump_path;
+/* Compute the default Vload_path, with the following logic:
+ If CANNOT_DUMP:
+ use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
+ prepending PATH_SITELOADSEARCH unless --no-site-lisp.
+ The remainder is what happens when dumping works:
+ If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
+ Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
+
+ If !initialized, then just set both Vload_path and dump_path.
+ If initialized, then if Vload_path != dump_path, do nothing.
+ (Presumably the load-path has already been changed by something.
+ This can only be from a site-load file during dumping,
+ or because EMACSLOADPATH is set.)
+ If Vinstallation_directory is not nil (ie, running uninstalled):
+ If installation-dir/lisp exists and not already a member,
+ we must be running uninstalled. Reset the load-path
+ to just installation-dir/lisp. (The default PATH_LOADSEARCH
+ refers to the eventual installation directories. Since we
+ are not yet installed, we should not use them, even if they exist.)
+ If installation-dir/lisp does not exist, just add dump_path at the
+ end instead.
+ Add installation-dir/leim (if exists and not already a member) at the front.
+ Add installation-dir/site-lisp (if !no_site_lisp, and exists
+ and not already a member) at the front.
+ If installation-dir != source-dir (ie running an uninstalled,
+ out-of-tree build) AND install-dir/src/Makefile exists BUT
+ install-dir/src/Makefile.in does NOT exist (this is a sanity
+ check), then repeat the above steps for source-dir/lisp,
+ leim and site-lisp.
+ Finally, add the site-lisp directories at the front (if !no_site_lisp).
+*/
+
void
init_lread (void)
{
const char *normal;
- int turn_off_warning = 0;
-
- /* Compute the default Vload-path, with the following logic:
- If CANNOT_DUMP just use PATH_LOADSEARCH.
- Else if purify-flag (ie dumping) start from PATH_DUMPLOADSEARCH;
- otherwise start from PATH_LOADSEARCH.
- If !initialized, then just set both Vload_path and dump_path.
- If initialized, then if Vload_path != dump_path, do nothing.
- (Presumably the load-path has already been changed by something.)
- Also do nothing if Vinstallation_directory is nil.
- Otherwise:
- Remove site-lisp directories from the front of load-path.
- Add installation-dir/lisp (if exists and not already a member),
- at the front, and turn off warnings about missing directories
- (because we are presumably running uninstalled).
- If it does not exist, add dump_path at the end instead.
- Add installation-dir/leim (if exists and not already a member)
- at the front.
- Add installation-dir/site-lisp (if !no_site_lisp, and exists
- and not already a member) at the front.
- If installation-dir != source-dir (ie running an uninstalled,
- out-of-tree build) AND install-dir/src/Makefile exists BUT
- install-dir/src/Makefile.in does NOT exist (this is a sanity
- check), then repeat the above steps for source-dir/lisp,
- leim and site-lisp.
- Finally, add the previously removed site-lisp directories back
- at the front (if !no_site_lisp).
-
- We then warn about any of the load-path elements that do not
- exist. The only ones that might not exist are those from
- PATH_LOADSEARCH, and perhaps dump_path.
-
- Having done all this, we then throw it all away if purify-flag is
- nil (ie, not dumping) and EMACSLOADPATH is set, and just
- unconditionally use the latter value instead.
- So AFAICS the only net results of all the previous steps will be
- possibly to issue some irrelevant warnings.
-
- FIXME? There's a case for saying that if we are running
- uninstalled, the eventual installation directories should not yet
- be included in load-path.
- */
+
#ifdef CANNOT_DUMP
+#ifdef HAVE_NS
+ const char *loadpath = ns_load_path ();
+#endif
+
normal = PATH_LOADSEARCH;
- Vload_path = decode_env_path (0, normal);
+#ifdef HAVE_NS
+ Vload_path = decode_env_path ("EMACSLOADPATH", loadpath ? loadpath : normal);
#else
+ Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+#endif
+
+ load_path_check ();
+
+ /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
+ to their load-path too, AFAICS. I don't think we can tell the
+ difference between initialized and !initialized in this case,
+ so we'll have to do it unconditionally when Vinstallation_directory
+ is non-nil. */
+ if (!no_site_lisp && !egetenv ("EMACSLOADPATH"))
+ {
+ Lisp_Object sitelisp;
+ sitelisp = decode_env_path (0, PATH_SITELOADSEARCH);
+ if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
+ }
+#else /* !CANNOT_DUMP */
if (NILP (Vpurify_flag))
- normal = PATH_LOADSEARCH;
+ {
+ normal = PATH_LOADSEARCH;
+ /* If the EMACSLOADPATH environment variable is set, use its value.
+ This doesn't apply if we're dumping. */
+ if (egetenv ("EMACSLOADPATH"))
+ Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+ }
else
normal = PATH_DUMPLOADSEARCH;
the source directory, instead of the path of the installed elisp
libraries. However, if it appears that Vload_path has already been
changed from the default that was saved before dumping, don't
- change it further. */
+ change it further. Changes can only be due to EMACSLOADPATH, or
+ site-lisp files that were processed during dumping. */
if (initialized)
{
- if (! NILP (Fequal (dump_path, Vload_path)))
+ if (NILP (Fequal (dump_path, Vload_path)))
+ {
+ /* Do not make any changes, just check the elements exist. */
+ /* Note: --no-site-lisp is ignored.
+ I don't know what to do about this. */
+ load_path_check ();
+ }
+ else
{
+#ifdef HAVE_NS
+ const char *loadpath = ns_load_path ();
+ Vload_path = decode_env_path (0, loadpath ? loadpath : normal);
+#else
Vload_path = decode_env_path (0, normal);
- if (no_site_lisp || !NILP (Vinstallation_directory))
+#endif
+ if (!NILP (Vinstallation_directory))
{
- Lisp_Object tem, tem1, sitelisp;
-
- /* Remove "site-lisp" dirs from front of path temporarily
- and store them in sitelisp, then conc them on at the
- end so they're always first in path.
- Note that this won't work if you used a
- --enable-locallisppath element that does not happen
- to contain "site-lisp" in its name.
- */
- sitelisp = Qnil;
- while (1)
- {
- tem = Fcar (Vload_path);
- tem1 = Fstring_match (build_string ("site-lisp"),
- tem, Qnil);
- if (!NILP (tem1))
- {
- Vload_path = Fcdr (Vload_path);
- sitelisp = Fcons (tem, sitelisp);
- }
- else
- break;
- }
-
- if (!NILP (Vinstallation_directory))
- {
- /* Add to the path the lisp subdir of the
- installation dir, if it exists. */
- tem = Fexpand_file_name (build_string ("lisp"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- {
- turn_off_warning = 1;
- Vload_path = Fcons (tem, Vload_path);
- }
- }
- else
- /* That dir doesn't exist, so add the build-time
- Lisp dirs instead. */
- Vload_path = nconc2 (Vload_path, dump_path);
-
- /* Add leim under the installation dir, if it exists. */
- tem = Fexpand_file_name (build_string ("leim"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
-
- /* Add site-lisp under the installation dir, if it exists. */
- if (!no_site_lisp)
- {
- tem = Fexpand_file_name (build_string ("site-lisp"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
- }
-
- /* If Emacs was not built in the source directory,
- and it is run from where it was built, add to load-path
- the lisp, leim and site-lisp dirs under that directory. */
-
- if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
- {
- Lisp_Object tem2;
-
- tem = Fexpand_file_name (build_string ("src/Makefile"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
-
- /* Don't be fooled if they moved the entire source tree
- AFTER dumping Emacs. If the build directory is indeed
- different from the source dir, src/Makefile.in and
- src/Makefile will not be found together. */
- tem = Fexpand_file_name (build_string ("src/Makefile.in"),
- Vinstallation_directory);
- tem2 = Ffile_exists_p (tem);
- if (!NILP (tem1) && NILP (tem2))
- {
- tem = Fexpand_file_name (build_string ("lisp"),
- Vsource_directory);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
-
- tem = Fexpand_file_name (build_string ("leim"),
- Vsource_directory);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
-
- if (!no_site_lisp)
- {
- tem = Fexpand_file_name (build_string ("site-lisp"),
- Vsource_directory);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
- }
- } /* Vinstallation_directory != Vsource_directory */
- } /* if Vinstallation_directory */
- if (!NILP (sitelisp) && !no_site_lisp)
- Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
- } /* if Vinstallation_directory || no_site_lisp */
- } /* if dump_path == Vload_path */
+ Lisp_Object tem, tem1;
+
+ /* Add to the path the lisp subdir of the installation
+ dir, if it exists. Note: in out-of-tree builds,
+ this directory is empty save for Makefile. */
+ tem = Fexpand_file_name (build_string ("lisp"),
+ Vinstallation_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ {
+ /* We are running uninstalled. The default load-path
+ points to the eventual installed lisp, leim
+ directories. We should not use those now, even
+ if they exist, so start over from a clean slate. */
+ Vload_path = Fcons (tem, Qnil);
+ }
+ }
+ else
+ /* That dir doesn't exist, so add the build-time
+ Lisp dirs instead. */
+ Vload_path = nconc2 (Vload_path, dump_path);
+
+ /* Add leim under the installation dir, if it exists. */
+ tem = Fexpand_file_name (build_string ("leim"),
+ Vinstallation_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
+
+ /* Add site-lisp under the installation dir, if it exists. */
+ if (!no_site_lisp)
+ {
+ tem = Fexpand_file_name (build_string ("site-lisp"),
+ Vinstallation_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
+ }
+
+ /* If Emacs was not built in the source directory,
+ and it is run from where it was built, add to load-path
+ the lisp, leim and site-lisp dirs under that directory. */
+
+ if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
+ {
+ Lisp_Object tem2;
+
+ tem = Fexpand_file_name (build_string ("src/Makefile"),
+ Vinstallation_directory);
+ tem1 = Ffile_exists_p (tem);
+
+ /* Don't be fooled if they moved the entire source tree
+ AFTER dumping Emacs. If the build directory is indeed
+ different from the source dir, src/Makefile.in and
+ src/Makefile will not be found together. */
+ tem = Fexpand_file_name (build_string ("src/Makefile.in"),
+ Vinstallation_directory);
+ tem2 = Ffile_exists_p (tem);
+ if (!NILP (tem1) && NILP (tem2))
+ {
+ tem = Fexpand_file_name (build_string ("lisp"),
+ Vsource_directory);
+
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+
+ tem = Fexpand_file_name (build_string ("leim"),
+ Vsource_directory);
+
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+
+ if (!no_site_lisp)
+ {
+ tem = Fexpand_file_name (build_string ("site-lisp"),
+ Vsource_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
+ }
+ }
+ } /* Vinstallation_directory != Vsource_directory */
+
+ } /* if Vinstallation_directory */
+
+ /* Check before adding the site-lisp directories.
+ The install should have created them, but they are not
+ required, so no need to warn if they are absent.
+ Or we might be running before installation. */
+ load_path_check ();
+
+ /* Add the site-lisp directories at the front. */
+ if (!no_site_lisp)
+ {
+ Lisp_Object sitelisp;
+ sitelisp = decode_env_path (0, PATH_SITELOADSEARCH);
+ if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
+ }
+ } /* if dump_path == Vload_path */
}
else /* !initialized */
{
- /* NORMAL refers to the lisp dir in the source directory. */
- /* We used to add ../lisp at the front here, but
- that caused trouble because it was copied from dump_path
- into Vload_path, above, when Vinstallation_directory was non-nil.
- It should be unnecessary. */
+ /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
+ source directory. We used to add ../lisp (ie the lisp dir in
+ the build directory) at the front here, but that caused trouble
+ because it was copied from dump_path into Vload_path, above,
+ when Vinstallation_directory was non-nil. It should not be
+ necessary, since in out of tree builds lisp/ is empty, save
+ for Makefile. */
Vload_path = decode_env_path (0, normal);
dump_path = Vload_path;
+ /* No point calling load_path_check; load-path only contains essential
+ elements from the source directory at this point. They cannot
+ be missing unless something went extremely (and improbably)
+ wrong, in which case the build will fail in obvious ways. */
}
-#endif /* CANNOT_DUMP */
-
-#if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
- /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
- almost never correct, thereby causing a warning to be printed out that
- confuses users. Since PATH_LOADSEARCH is always overridden by the
- EMACSLOADPATH environment variable below, disable the warning on NT. */
-
- /* HAVE_NS also uses EMACSLOADPATH. */
-
- /* Warn if dirs in the *standard* path don't exist. */
- if (!turn_off_warning)
- {
- Lisp_Object path_tail;
-
- for (path_tail = Vload_path;
- !NILP (path_tail);
- path_tail = XCDR (path_tail))
- {
- Lisp_Object dirfile;
- dirfile = Fcar (path_tail);
- if (STRINGP (dirfile))
- {
- dirfile = Fdirectory_file_name (dirfile);
- /* Do we really need to warn about missing site-lisp dirs?
- It's true that the installation should have created
- them and added subdirs.el, but it's harmless if they
- are not there. */
- if (access (SSDATA (dirfile), 0) < 0)
- dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
- XCAR (path_tail));
- }
- }
- }
-#endif /* !(WINDOWSNT || HAVE_NS) */
-
- /* If the EMACSLOADPATH environment variable is set, use its value.
- This doesn't apply if we're dumping. */
-#ifndef CANNOT_DUMP
- if (NILP (Vpurify_flag)
- && egetenv ("EMACSLOADPATH"))
-#endif
- Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+#endif /* !CANNOT_DUMP */
Vvalues = Qnil;
{
fprintf (stderr, format, SDATA (dirname));
- /* Don't log the warning before we've initialized!! */
+ /* 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 ();
}
DEFVAR_LISP ("values", Vvalues,
doc: /* List of values of all expressions which were read, evaluated and printed.
-Order is reverse chronological. */);
+ Order is reverse chronological. */);
+ XSYMBOL (intern ("values"))->declared_special = 0;
DEFVAR_LISP ("standard-input", Vstandard_input,
doc: /* Stream for read to get input from.
The positions are relative to the last call to `read' or
`read-from-string'. It is probably a bad idea to set this variable at
-the toplevel; bind it instead. */);
+the toplevel; bind it instead. */);
Vread_with_symbol_positions = Qnil;
DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list,
Note that a symbol will appear multiple times in this list, if it was
read multiple times. The list is in the same order as the symbols
-were read in. */);
+were read in. */);
Vread_symbol_positions_list = Qnil;
DEFVAR_LISP ("read-circle", Vread_circle,
Vread_circle = Qt;
DEFVAR_LISP ("load-path", Vload_path,
- doc: /* *List of directories to search for files to load.
+ doc: /* List of directories to search for files to load.
Each element is a string (directory name) or nil (try default directory).
Initialized based on EMACSLOADPATH environment variable, if any,
otherwise to default specified by file `epaths.h' when Emacs was built. */);
This list should not include the empty string.
`load' and related functions try to append these suffixes, in order,
to the specified file name if a Lisp suffix is allowed or required. */);
- Vload_suffixes = Fcons (make_pure_c_string (".elc"),
- Fcons (make_pure_c_string (".el"), Qnil));
+ Vload_suffixes = Fcons (build_pure_c_string (".elc"),
+ Fcons (build_pure_c_string (".el"), Qnil));
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
When the regular expression matches, the file is considered to be safe
to load. See also `load-dangerous-libraries'. */);
Vbytecomp_version_regexp
- = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
+ = 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
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,
+++ /dev/null
-This directory contains C header files containing machine-specific
-definitions. Each file describes a particular machine. The emacs
-configuration script edits ../config.h to include the appropriate one of
-these files, and then each emacs source file includes config.h.
-
-template.h is a generic template for machine descriptions; it
-describes the parameters a machine file can specify.
+++ /dev/null
-/* Machine description file for the alpha chip.
-
-Copyright (C) 1994, 1997, 1999, 2001-2012 Free Software Foundation, Inc.
-
-Author: Rainer Schoepf
-(according to authors.el)
-
-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 <http://www.gnu.org/licenses/>. */
-
-#ifndef _LP64
-#define _LP64 /* This doesn't appear to be necessary on OSF 4/5 -- fx. */
-#endif
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically. */
-/* __alpha defined automatically */
-
-
-#ifdef __ELF__
-
-#if !defined (GNU_LINUX) && !defined (__NetBSD__)
-#define DATA_START 0x140000000
-#endif
-
-#else /* not __ELF__ */
-
-/* Describe layout of the address space in an executing process. */
-#define DATA_START 0x140000000
-
-#endif /* __ELF__ */
-
-/* On the Alpha it's best to avoid including TERMIO since struct
- termio and struct termios are mutually incompatible. */
-#define NO_TERMIO
-
-/* Many Alpha implementations (e.g. gas 2.8) can't handle DBL_MIN:
- they generate code that uses a signaling NaN instead of DBL_MIN.
- Define DBL_MIN_REPLACEMENT to be the next value larger than DBL_MIN:
- this avoids the assembler bug. */
-#define DBL_MIN_REPLACEMENT 2.2250738585072019e-308
+++ /dev/null
-/* machine description file for AMD x86-64.
-
-Copyright (C) 2002-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 <http://www.gnu.org/licenses/>. */
-
-#define BITS_PER_LONG 64
-#define BITS_PER_EMACS_INT 64
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically:
- Ones defined so far include vax, m68000, ns16000, pyramid,
- orion, tahoe, APOLLO and many others */
-/* __x86_64 defined automatically. */
-
-/* Define the type to use. */
-#define EMACS_INT long
-#define pI "l"
-#define EMACS_UINT unsigned long
-
-/* Define XPNTR to avoid or'ing with DATA_SEG_BITS */
-#undef DATA_SEG_BITS
+++ /dev/null
-/* machine description file for the IA-64 architecture.
-
-Copyright (C) 2000-2012 Free Software Foundation, Inc.
-
- Contributed by David Mosberger <davidm@hpl.hp.com>
-
-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 <http://www.gnu.org/licenses/>. */
-
-#define BITS_PER_LONG 64
-#define BITS_PER_EMACS_INT 64
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically. */
-/* __ia64__ defined automatically */
-
-/* Define the type to use. */
-#define EMACS_INT long
-#define pI "l"
-#define EMACS_UINT unsigned long
-
-#ifdef REL_ALLOC
-#ifndef _MALLOC_INTERNAL
-/* "char *" because ralloc.c defines it that way. gmalloc.c thinks it
- is allowed to prototype these as "void *" so we don't prototype in
- that case. You're right: it stinks! */
-extern char *r_alloc (), *r_re_alloc ();
-extern void r_alloc_free ();
-#endif /* not _MALLOC_INTERNAL */
-#endif /* REL_ALLOC */
+++ /dev/null
-/* R2 AIX machine/system dependent defines
-
-Copyright (C) 1988, 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 <http://www.gnu.org/licenses/>. */
-
-
-/* The data segment in this machine always starts at address 0x20000000.
- An address of data cannot be stored correctly in a Lisp object;
- we always lose the high bits. We must tell XPNTR to add them back. */
-#define DATA_START 0x20000000
-#define DATA_SEG_BITS 0x20000000
-
-#ifndef NLIST_STRUCT
-/* AIX supposedly doesn't use this interface, but on the RS/6000
- it apparently does. */
-#define NLIST_STRUCT
-#endif
-
-#undef ADDR_CORRECT
-#define ADDR_CORRECT(x) ((int)(x))
-
-/*** BUILD 9008 - FIONREAD problem still exists in X-Windows. ***/
-#define BROKEN_FIONREAD
-/* As we define BROKEN_FIONREAD, SIGIO will be undefined in systty.h.
- But, on AIX, SIGAIO, SIGPTY, and SIGPOLL are defined as SIGIO,
- which causes compilation error at init_signals in sysdep.c. So, we
- define these macros so that syssignal.h detects them and undefine
- SIGAIO, SIGPTY and SIGPOLL. */
-#define BROKEN_SIGAIO
-#define BROKEN_SIGPTY
-#define BROKEN_SIGPOLL
-
+++ /dev/null
-/* Machine description file for IBM S390 in 64-bit mode
-
-Copyright (C) 2002-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 <http://www.gnu.org/licenses/>. */
-
-#define BITS_PER_LONG 64
-#define BITS_PER_EMACS_INT 64
-
-/* Define the type to use. */
-#define EMACS_INT long
-#define pI "l"
-#define EMACS_UINT unsigned long
-
-/* On the 64 bit architecture, we can use 60 bits for addresses */
-#define VALBITS 60
-
-/* Define XPNTR to avoid or'ing with DATA_SEG_BITS */
-#define XPNTR(a) XUINT (a)
+++ /dev/null
-/* Machine description file for intel 386.
-
-Copyright (C) 1987, 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 <http://www.gnu.org/licenses/>. */
-
-
-#ifdef WINDOWSNT
-#define DATA_START get_data_start ()
-#endif
-
-#ifdef GNU_LINUX
-/* libc-linux/sysdeps/linux/i386/ulimit.c says that due to shared library, */
-/* we cannot get the maximum address for brk */
-#define ULIMIT_BREAK_VALUE (32*1024*1024)
-#endif
+++ /dev/null
-/* Machine description file for generic Motorola 68k.
-
-Copyright (C) 1985, 1995, 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 <http://www.gnu.org/licenses/>. */
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically. */
-#ifndef m68k
-#define m68k
-#endif
-
-#ifdef GNU_LINUX
-#ifdef __ELF__
-#define DATA_SEG_BITS 0x80000000
-#endif
-
-#endif
-
+++ /dev/null
-/* machine description file For the powerpc Macintosh.
-
-Copyright (C) 1994, 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 <http://www.gnu.org/licenses/>. */
-
-#ifdef _ARCH_PPC64
-#ifndef _LP64
-#define _LP64
-#endif
-#endif
+++ /dev/null
-/* machine description file for Sun 4 SPARC.
-
-Copyright (C) 1987, 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 <http://www.gnu.org/licenses/>. */
-
-/* __sparc__ is defined by the compiler by default. */
-
-#ifdef __arch64__ /* GCC, 64-bit ABI. */
-
-#define BITS_PER_LONG 64
-
-#ifndef _LP64
-#define _LP64 /* Done on Alpha -- not sure if it should be here. -- fx */
-#endif
-
-#endif /* __arch64__ */
+++ /dev/null
-/* machine description file template.
-
-Copyright (C) 1985-1986, 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 <http://www.gnu.org/licenses/>. */
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically.
- Ones defined so far include m68k and many others */
-
-/* After adding support for a new machine, modify the large case
- statement in configure.in to recognize reasonable
- configuration names, and add a description of the system to
- `etc/MACHINES'.
-
- Check for any tests of $machine in configure.in, and add an entry
- for the new machine if needed.
-
- If you've just fixed a problem in an existing configuration file,
- you should also check `etc/MACHINES' to make sure its descriptions
- of known problems in that configuration should be updated. */
+++ /dev/null
-/* machine description file for vax.
-
-Copyright (C) 1985-1986, 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 <http://www.gnu.org/licenses/>. */
-
-
-/* #define vax -- appears to be done automatically */
-
-#define HAVE_FTIME
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "macros.h"
#include "commands.h"
+#include "character.h"
#include "buffer.h"
#include "window.h"
#include "keyboard.h"
if (!current_kboard->kbd_macro_buffer)
{
- current_kboard->kbd_macro_buffer
- = (Lisp_Object *)xmalloc (30 * sizeof (Lisp_Object));
+ current_kboard->kbd_macro_buffer = xmalloc (30 * word_size);
current_kboard->kbd_macro_bufsize = 30;
}
update_mode_lines++;
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;
has put another macro there. */
if (current_kboard->kbd_macro_bufsize < len + 30)
{
- if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object) - 30
- < current_kboard->kbd_macro_bufsize)
+ if (PTRDIFF_MAX < MOST_POSITIVE_FIXNUM + 30
+ && PTRDIFF_MAX < len + 30)
memory_full (SIZE_MAX);
- current_kboard->kbd_macro_buffer
- = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer,
- (len + 30) * sizeof (Lisp_Object));
- current_kboard->kbd_macro_bufsize = len + 30;
+ current_kboard->kbd_macro_buffer =
+ xpalloc (current_kboard->kbd_macro_buffer,
+ ¤t_kboard->kbd_macro_bufsize,
+ len + 30 - current_kboard->kbd_macro_bufsize, -1,
+ sizeof *current_kboard->kbd_macro_buffer);
}
/* Must convert meta modifier when copying string to vector. */
message ("Appending to kbd macro...");
}
- KVAR (current_kboard, defining_kbd_macro) = Qt;
+ kset_defining_kbd_macro (current_kboard, Qt);
return Qnil;
}
void
end_kbd_macro (void)
{
- KVAR (current_kboard, defining_kbd_macro) = Qnil;
+ kset_defining_kbd_macro (current_kboard, 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_last_kbd_macro
+ (current_kboard,
+ 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",
< kb->kbd_macro_bufsize)
memory_full (SIZE_MAX);
nbytes = kb->kbd_macro_bufsize * (2 * sizeof *kb->kbd_macro_buffer);
- kb->kbd_macro_buffer
- = (Lisp_Object *) xrealloc (kb->kbd_macro_buffer, nbytes);
+ kb->kbd_macro_buffer = xrealloc (kb->kbd_macro_buffer, nbytes);
kb->kbd_macro_bufsize *= 2;
kb->kbd_macro_ptr = kb->kbd_macro_buffer + ptr_offset;
kb->kbd_macro_end = kb->kbd_macro_buffer + end_offset;
from before this macro started. */
Vthis_command = KVAR (current_kboard, Vlast_command);
/* C-x z after the macro should repeat the macro. */
- real_this_command = KVAR (current_kboard, Vlast_kbd_macro);
+ Vreal_this_command = KVAR (current_kboard, Vlast_kbd_macro);
if (! NILP (KVAR (current_kboard, defining_kbd_macro)))
error ("Can't execute anonymous macro while defining one");
Vexecuting_kbd_macro = XCAR (info);
tem = XCDR (info);
executing_kbd_macro_index = XINT (XCAR (tem));
- real_this_command = XCDR (tem);
+ Vreal_this_command = XCDR (tem);
Frun_hooks (1, &Qkbd_macro_termination_hook);
return Qnil;
}
{
Lisp_Object final;
Lisp_Object tem;
- int pdlcount = SPECPDL_INDEX ();
+ ptrdiff_t pdlcount = SPECPDL_INDEX ();
EMACS_INT repeat = 1;
struct gcpro gcpro1, gcpro2;
EMACS_INT success_count = 0;
tem = Fcons (Vexecuting_kbd_macro,
Fcons (make_number (executing_kbd_macro_index),
- real_this_command));
+ Vreal_this_command));
record_unwind_protect (pop_kbd_macro, tem);
GCPRO2 (final, loopfunc);
executing_kbd_macro = final;
executing_kbd_macro_index = 0;
- KVAR (current_kboard, Vprefix_arg) = Qnil;
+ kset_prefix_arg (current_kboard, Qnil);
if (!NILP (loopfunc))
{
executing_kbd_macro = Qnil;
- real_this_command = Vexecuting_kbd_macro;
+ Vreal_this_command = Vexecuting_kbd_macro;
UNGCPRO;
return unbind_to (pdlcount, Qnil);
-# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
+# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
# Copyright (C) 2000-2012 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
# Size in MBs of the static heap in temacs.exe.
HEAPSIZE = 27
-#
-# HAVE_CONFIG_H is required by some generic gnu sources stuck into
-# the emacs source tree.
-#
-LOCAL_FLAGS = -Demacs=1 -DHAVE_CONFIG_H -I../lib -I../nt/inc -DHAVE_NTGUI=1 $(EMACS_EXTRA_C_FLAGS)
+LOCAL_FLAGS = -Demacs=1 -I../lib -I../nt/inc -DHAVE_NTGUI=1 $(EMACS_EXTRA_C_FLAGS)
SRC = .
EMACS = $(BLD)/emacs.exe
$(BLD)/image.$(O) \
$(BLD)/terminal.$(O) \
$(BLD)/menu.$(O) \
+ $(BLD)/xml.$(O) \
+ $(BLD)/profiler.$(O) \
$(BLD)/w32term.$(O) \
$(BLD)/w32xfns.$(O) \
$(BLD)/w32fns.$(O) \
process.c callproc.c unexw32.c \
region-cache.c sound.c atimer.c \
doprnt.c intervals.c textprop.c composite.c \
- gnutls.c
+ gnutls.c xml.c profiler.c
SOME_MACHINE_OBJECTS = dosfns.o msdos.o \
xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o dbusbind.o
obj = $(GLOBAL_SOURCES:.c=.o)
##
## This works only with GNU Make.
-TAGS: $(OBJ0) $(OBJ1) $(OBJ2) $(CURDIR)/m/intel386.h $(CURDIR)/s/ms-w32.h
+TAGS: $(OBJ0) $(OBJ1) $(OBJ2) $(CURDIR)/../nt/inc/ms-w32.h
$(MAKE) $(MFLAGS) TAGS-$(MAKETYPE)
TAGS-LISP: $(OBJ0) $(OBJ1) $(OBJ2)
$(OBJ1_c)
../lib-src/$(BLD)/etags.exe -a --regex=@../nt/emacs-src.tags \
$(OBJ2_c) \
- $(CURDIR)/*.h $(CURDIR)/m/intel386.h $(CURDIR)/s/ms-w32.h
+ $(CURDIR)/*.h $(CURDIR)/../nt/inc/ms-w32.h
TAGS-nmake:
echo This target is not supported with NMake
NT_INC = $(EMACS_ROOT)/nt/inc
SYSTIME_H = $(SRC)/systime.h \
- $(NT_INC)/sys/time.h
+ $(NT_INC)/sys/time.h \
+ $(GNU_LIB)/timespec.h
ATIMER_H = $(SRC)/atimer.h \
+ $(NT_INC)/stdbool.h \
+ $(SYSTIME_H)
+BUFFER_H = $(SRC)/buffer.h \
$(SYSTIME_H)
-BLOCKINPUT_H = $(SRC)/blockinput.h \
- $(ATIMER_H)
+C_CTYPE_H = $(GNU_LIB)/c-ctype.h \
+ $(NT_INC)/stdbool.h
CAREADLINKAT_H = $(GNU_LIB)/careadlinkat.h \
$(NT_INC)/unistd.h
CHARACTER_H = $(SRC)/character.h \
$(GNU_LIB)/verify.h
+CCL_H = $(SRC)/ccl.h \
+ $(CHARACTER_H)
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
-CONFIG_H = $(SRC)/config.h \
- $(SRC)/m/intel386.h \
+CONF_POST_H = $(SRC)/conf_post.h \
$(MS_W32_H)
+CONFIG_H = $(SRC)/config.h \
+ $(CONF_POST_H)
DIR_H = $(NT_INC)/sys/dir.h \
$(SRC)/ndir.h
W32GUI_H = $(SRC)/w32gui.h \
$(SYSTIME_H)
DISPEXTERN_H = $(SRC)/dispextern.h \
+ $(GNU_LIB)/c-strcase.h \
+ $(SYSTIME_H) \
$(W32GUI_H)
FILEMODE_H = $(GNU_LIB)/filemode.h \
$(NT_INC)/sys/stat.h
FONT_H = $(SRC)/font.h \
- $(SRC)/ccl.h
+ $(CCL_H)
FRAME_H = $(SRC)/frame.h \
$(DISPEXTERN_H)
FTOASTR_H = $(GNU_LIB)/ftoastr.h \
LISP_H = $(SRC)/lisp.h \
$(SRC)/globals.h \
$(GNU_LIB)/intprops.h \
- $(INTTYPES_H)
+ $(INTTYPES_H) \
+ $(NT_INC)/stdalign.h \
+ $(NT_INC)/stdbool.h
MD5_H = $(GNU_LIB)/md5.h \
$(NT_INC)/stdint.h
MENU_H = $(SRC)/menu.h \
$(U64_H)
SOCKET_H = $(NT_INC)/sys/socket.h \
$(SRC)/w32.h
+STAT_TIME_H = $(GNU_LIB)/stat-time.h \
+ $(NT_INC)/sys/stat.h
+SYSSIGNAL_H = $(SRC)/syssignal.h \
+ $(NT_INC)/stdbool.h
SYSTTY_H = $(SRC)/systty.h \
$(NT_INC)/sys/ioctl.h \
$(NT_INC)/unistd.h
TERMHOOKS_H = $(SRC)/termhooks.h \
$(SYSTIME_H)
+W32FONT_H = $(SRC)/w32font.h \
+ $(FONT_H)
W32TERM_H = $(SRC)/w32term.h \
$(W32GUI_H)
WINDOW_H = $(SRC)/window.h \
$(BLD)/alloc.$(O) : \
$(SRC)/alloc.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/puresize.h \
- $(SRC)/syssignal.h \
$(SRC)/w32.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/verify.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(FRAME_H) \
$(BLD)/atimer.$(O) : \
$(SRC)/atimer.c \
- $(SRC)/syssignal.h \
- $(NT_INC)/sys/time.h \
+ $(SRC)/blockinput.h \
$(NT_INC)/unistd.h \
$(ATIMER_H) \
- $(BLOCKINPUT_H) \
$(CONFIG_H) \
$(LISP_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H)
$(BLD)/bidi.$(O) : \
$(SRC)/bidi.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(BLD)/buffer.$(O) : \
$(SRC)/buffer.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/indent.h \
$(SRC)/keymap.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/verify.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(FRAME_H) \
$(BLD)/bytecode.$(O) : \
$(SRC)/bytecode.c \
- $(SRC)/buffer.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H) \
$(BLD)/callint.$(O) : \
$(SRC)/callint.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(KEYBOARD_H) \
$(BLD)/callproc.$(O) : \
$(SRC)/callproc.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/epaths.h \
- $(SRC)/syssignal.h \
+ $(SRC)/syswait.h \
$(SRC)/w32.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
$(FRAME_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H)
$(BLD)/casefiddle.$(O) : \
$(SRC)/casefiddle.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/keymap.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/casetab.$(O) : \
$(SRC)/casetab.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/category.$(O) : \
$(SRC)/category.c \
- $(SRC)/buffer.h \
$(SRC)/category.h \
$(SRC)/keymap.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(BLD)/ccl.$(O) : \
$(SRC)/ccl.c \
- $(SRC)/ccl.h \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(BLD)/character.$(O) : \
$(SRC)/character.c \
- $(SRC)/buffer.h \
$(SRC)/composite.h \
$(SRC)/disptab.h \
$(GNU_LIB)/intprops.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(BLD)/charset.$(O) : \
$(SRC)/charset.c \
- $(SRC)/buffer.h \
$(SRC)/disptab.h \
$(NT_INC)/unistd.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(LISP_H)
$(BLD)/chartab.$(O) : \
$(SRC)/chartab.c \
- $(SRC)/ccl.h \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(BLD)/cmds.$(O) : \
$(SRC)/cmds.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(BLD)/coding.$(O) : \
$(SRC)/coding.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
$(SRC)/composite.h \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(BLD)/composite.$(O) : \
$(SRC)/composite.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
$(BLD)/data.$(O) : \
$(SRC)/data.c \
- $(SRC)/buffer.h \
+ $(SRC)/keymap.h \
$(SRC)/puresize.h \
- $(SRC)/syssignal.h \
$(GNU_LIB)/intprops.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(FONT_H) \
$(FRAME_H) \
$(KEYBOARD_H) \
$(LISP_H) \
+ $(SYSSIGNAL_H) \
$(TERMHOOKS_H)
$(BLD)/dired.$(O) : \
$(SRC)/dired.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/regex.h \
$(NT_INC)/pwd.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(FILEMODE_H) \
$(GRP_H) \
$(LISP_H) \
+ $(STAT_TIME_H) \
$(SYSTIME_H)
$(BLD)/dispnew.$(O) : \
$(SRC)/dispnew.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/cm.h \
$(SRC)/commands.h \
$(SRC)/disptab.h \
$(SRC)/indent.h \
- $(SRC)/syssignal.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(KEYBOARD_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(TERMHOOKS_H) \
$(W32TERM_H) \
$(BLD)/doc.$(O) : \
$(SRC)/doc.c \
- $(SRC)/buffer.h \
$(SRC)/buildobj.h \
$(SRC)/keymap.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/unistd.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(KEYBOARD_H) \
$(LISP_H)
$(BLD)/editfns.$(O) : \
$(SRC)/editfns.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(NT_INC)/pwd.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/intprops.h \
$(GNU_LIB)/strftime.h \
$(GNU_LIB)/verify.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
$(BLD)/emacs.$(O) : \
$(SRC)/emacs.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/gnutls.h \
$(SRC)/keymap.h \
- $(SRC)/syssignal.h \
$(SRC)/unexec.h \
$(SRC)/w32.h \
$(SRC)/w32heap.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(GNU_LIB)/ignore-value.h \
+ $(ATIMER_H) \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(FRAME_H) \
$(INTERVALS_H) \
$(KEYBOARD_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H) \
+ $(W32TERM_H) \
$(WINDOW_H)
$(BLD)/eval.$(O) : \
$(SRC)/eval.c \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
- $(BLOCKINPUT_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(BLD)/fileio.$(O) : \
$(SRC)/fileio.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(NT_INC)/pwd.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(INTERVALS_H) \
$(LISP_H) \
+ $(STAT_TIME_H) \
$(SYSTIME_H) \
$(WINDOW_H)
$(BLD)/filelock.$(O) : \
$(SRC)/filelock.c \
- $(SRC)/buffer.h \
$(NT_INC)/pwd.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
$(BLD)/floatfns.$(O) : \
$(SRC)/floatfns.c \
- $(SRC)/syssignal.h \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/fns.$(O) : \
$(SRC)/fns.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/intprops.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
$(BLD)/font.$(O) : \
$(SRC)/font.c \
- $(SRC)/buffer.h \
$(SRC)/composite.h \
$(SRC)/fontset.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FONT_H) \
$(FRAME_H) \
$(BLD)/fontset.$(O) : \
$(SRC)/fontset.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
+ $(SRC)/blockinput.h \
$(SRC)/fontset.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(BLD)/frame.$(O) : \
$(SRC)/frame.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/fontset.h \
$(SRC)/termchar.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FONT_H) \
$(FRAME_H) \
$(BLD)/fringe.$(O) : \
$(SRC)/fringe.c \
- $(SRC)/buffer.h \
- $(BLOCKINPUT_H) \
+ $(SRC)/blockinput.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(BLD)/gmalloc.$(O) : \
$(SRC)/gmalloc.c \
- $(SRC)/getpagesize.h \
+ $(NT_INC)/stdint.h \
$(NT_INC)/unistd.h \
$(CONFIG_H)
$(LISP_H) \
$(PROCESS_H)
+$(BLD)/xml.$(O) : \
+ $(SRC)/xml.c \
+ $(SRC)/w32.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
+ $(CONFIG_H) \
+ $(LISP_H)
+
+$(BLD)/profiler.$(O) : \
+ $(SRC)/profiler.c \
+ $(NT_INC)/sys/time.h \
+ $(CONFIG_H) \
+ $(LISP_H)
+
$(BLD)/image.$(O) : \
$(SRC)/image.c \
+ $(SRC)/blockinput.h \
$(SRC)/epaths.h \
$(SRC)/w32.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FONT_H) \
$(FRAME_H) \
$(BLD)/indent.$(O) : \
$(SRC)/indent.c \
- $(SRC)/buffer.h \
$(SRC)/category.h \
$(SRC)/composite.h \
$(SRC)/disptab.h \
$(SRC)/region-cache.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(BLD)/insdel.$(O) : \
$(SRC)/insdel.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/region-cache.h \
$(GNU_LIB)/intprops.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(INTERVALS_H) \
$(BLD)/intervals.$(O) : \
$(SRC)/intervals.c \
- $(SRC)/buffer.h \
$(SRC)/keymap.h \
$(SRC)/puresize.h \
$(GNU_LIB)/intprops.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(INTERVALS_H) \
$(KEYBOARD_H) \
$(BLD)/keyboard.$(O) : \
$(SRC)/keyboard.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/disptab.h \
$(SRC)/keymap.h \
$(SRC)/macros.h \
$(SRC)/puresize.h \
$(SRC)/syntax.h \
- $(SRC)/syssignal.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
$(NT_INC)/sys/ioctl.h \
$(NT_INC)/unistd.h \
$(ATIMER_H) \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(KEYBOARD_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(TERMHOOKS_H) \
$(W32TERM_H) \
$(BLD)/keymap.$(O) : \
$(SRC)/keymap.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(SRC)/puresize.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(BLD)/lread.$(O) : \
$(SRC)/lread.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/epaths.h \
$(NT_INC)/sys/file.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(INTERVALS_H) \
$(KEYBOARD_H) \
$(LISP_H) \
+ $(STAT_TIME_H) \
$(TERMHOOKS_H)
$(BLD)/macros.$(O) : \
$(SRC)/macros.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/macros.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(KEYBOARD_H) \
$(LISP_H) \
$(BLD)/marker.$(O) : \
$(SRC)/marker.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/menu.$(O) : \
$(SRC)/menu.c \
+ $(SRC)/blockinput.h \
$(SRC)/keymap.h \
- $(BLOCKINPUT_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(BLD)/minibuf.$(O) : \
$(SRC)/minibuf.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(BLD)/w32inevt.$(O) : \
$(SRC)/w32inevt.c \
+ $(SRC)/blockinput.h \
+ $(SRC)/termchar.h \
$(SRC)/w32heap.h \
- $(BLOCKINPUT_H) \
+ $(SRC)/w32inevt.h \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(KEYBOARD_H) \
$(LISP_H) \
$(TERMHOOKS_H) \
- $(W32TERM_H)
+ $(W32TERM_H) \
+ $(WINDOW_H)
$(BLD)/w32proc.$(O) : \
$(SRC)/w32proc.c \
- $(SRC)/syssignal.h \
$(SRC)/syswait.h \
$(SRC)/w32.h \
$(SRC)/w32heap.h \
$(LANGINFO_H) \
$(LISP_H) \
$(PROCESS_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(W32TERM_H)
$(SRC)/w32console.c \
$(SRC)/disptab.h \
$(SRC)/termchar.h \
+ $(SRC)/w32heap.h \
$(SRC)/w32inevt.h \
$(CHARACTER_H) \
$(CODING_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(LISP_H) \
- $(TERMHOOKS_H)
+ $(TERMHOOKS_H) \
+ $(WINDOW_H)
$(BLD)/print.$(O) : \
$(SRC)/print.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/termchar.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(BLD)/process.$(O) : \
$(SRC)/process.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/gnutls.h \
$(SRC)/sysselect.h \
- $(SRC)/syssignal.h \
$(SRC)/syswait.h \
$(SRC)/termopts.h \
$(NT_INC)/arpa/inet.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
$(ATIMER_H) \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CODING_H) \
$(CONFIG_H) \
$(LISP_H) \
$(PROCESS_H) \
$(SOCKET_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H) \
+ $(W32TERM_H) \
$(WINDOW_H)
$(BLD)/ralloc.$(O) : \
$(SRC)/ralloc.c \
+ $(SRC)/blockinput.h \
$(SRC)/getpagesize.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/regex.$(O) : \
$(SRC)/regex.c \
- $(SRC)/buffer.h \
$(SRC)/category.h \
$(SRC)/regex.h \
$(SRC)/syntax.h \
- $(NT_INC)/unistd.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/region-cache.$(O) : \
$(SRC)/region-cache.c \
- $(SRC)/buffer.h \
$(SRC)/region-cache.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/search.$(O) : \
$(SRC)/search.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/category.h \
$(SRC)/commands.h \
$(SRC)/regex.h \
$(SRC)/region-cache.h \
$(SRC)/syntax.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(BLD)/sound.$(O) : \
$(SRC)/sound.c \
- $(SRC)/syssignal.h \
$(NT_INC)/unistd.h \
$(ATIMER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
- $(LISP_H)
+ $(LISP_H) \
+ $(SYSSIGNAL_H)
$(BLD)/syntax.$(O) : \
$(SRC)/syntax.c \
- $(SRC)/buffer.h \
$(SRC)/category.h \
$(SRC)/commands.h \
$(SRC)/keymap.h \
$(SRC)/regex.h \
$(SRC)/syntax.h \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CONFIG_H) \
$(INTERVALS_H) \
$(BLD)/sysdep.$(O) : \
$(SRC)/sysdep.c \
+ $(SRC)/blockinput.h \
$(SRC)/cm.h \
$(SRC)/sysselect.h \
- $(SRC)/syssignal.h \
$(SRC)/syswait.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
$(NT_INC)/sys/stat.h \
$(NT_INC)/unistd.h \
$(GNU_LIB)/allocator.h \
+ $(GNU_LIB)/execinfo.h \
$(GNU_LIB)/ignore-value.h \
- $(BLOCKINPUT_H) \
+ $(GNU_LIB)/utimens.h \
$(CAREADLINKAT_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(GRP_H) \
$(LISP_H) \
$(PROCESS_H) \
$(SOCKET_H) \
+ $(SYSSIGNAL_H) \
$(SYSTIME_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H) \
$(BLD)/term.$(O) : \
$(SRC)/term.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/cm.h \
$(SRC)/composite.h \
$(SRC)/disptab.h \
$(SRC)/keymap.h \
- $(SRC)/syssignal.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
$(SRC)/tparam.h \
$(NT_INC)/sys/file.h \
+ $(NT_INC)/sys/time.h \
$(NT_INC)/unistd.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(INTERVALS_H) \
$(KEYBOARD_H) \
$(LISP_H) \
+ $(SYSSIGNAL_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H) \
$(WINDOW_H)
$(BLD)/textprop.$(O) : \
$(SRC)/textprop.c \
- $(SRC)/buffer.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(INTERVALS_H) \
$(LISP_H) \
$(BLD)/undo.$(O) : \
$(SRC)/undo.c \
- $(SRC)/buffer.h \
$(SRC)/commands.h \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(LISP_H) \
$(WINDOW_H)
$(BLD)/vm-limit.$(O) : \
$(SRC)/vm-limit.c \
$(SRC)/mem-limits.h \
+ $(NT_INC)/unistd.h \
$(CONFIG_H) \
$(LISP_H)
$(BLD)/window.$(O) : \
$(SRC)/window.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/disptab.h \
$(SRC)/indent.h \
$(SRC)/keymap.h \
$(SRC)/termchar.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CONFIG_H) \
$(DISPEXTERN_H) \
$(FRAME_H) \
$(BLD)/xdisp.$(O) : \
$(SRC)/xdisp.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/commands.h \
$(SRC)/disptab.h \
$(SRC)/fontset.h \
$(SRC)/region-cache.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
- $(BLOCKINPUT_H) \
+ $(ATIMER_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(BLD)/xfaces.$(O) : \
$(SRC)/xfaces.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/fontset.h \
$(SRC)/termchar.h \
$(NT_INC)/sys/stat.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
+ $(C_CTYPE_H) \
$(DISPEXTERN_H) \
$(FONT_H) \
$(FRAME_H) \
$(BLD)/w32fns.$(O) : \
$(SRC)/w32fns.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
+ $(SRC)/blockinput.h \
$(SRC)/epaths.h \
$(SRC)/fontset.h \
$(SRC)/w32.h \
- $(SRC)/w32font.h \
$(SRC)/w32heap.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(LISP_H) \
$(SYSTIME_H) \
$(TERMHOOKS_H) \
+ $(W32FONT_H) \
$(W32TERM_H) \
$(WINDOW_H)
$(BLD)/w32menu.$(O) : \
$(SRC)/w32menu.c \
- $(SRC)/buffer.h \
+ $(SRC)/blockinput.h \
$(SRC)/keymap.h \
$(SRC)/w32heap.h \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(CONFIG_H) \
$(BLD)/w32term.$(O) : \
$(SRC)/w32term.c \
- $(SRC)/buffer.h \
- $(SRC)/ccl.h \
+ $(SRC)/blockinput.h \
$(SRC)/disptab.h \
$(SRC)/fontset.h \
$(SRC)/keymap.h \
$(SRC)/termchar.h \
$(SRC)/termopts.h \
- $(SRC)/w32font.h \
$(SRC)/w32heap.h \
$(NT_INC)/sys/stat.h \
$(ATIMER_H) \
- $(BLOCKINPUT_H) \
+ $(BUFFER_H) \
+ $(CCL_H) \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(SYSTIME_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H) \
+ $(W32FONT_H) \
$(W32TERM_H) \
$(WINDOW_H)
$(BLD)/w32select.$(O) : \
$(SRC)/w32select.c \
+ $(SRC)/blockinput.h \
$(SRC)/composite.h \
$(SRC)/w32heap.h \
- $(BLOCKINPUT_H) \
$(CHARSET_H) \
$(CODING_H) \
$(CONFIG_H) \
$(BLD)/w32reg.$(O) : \
$(SRC)/w32reg.c \
- $(BLOCKINPUT_H) \
+ $(SRC)/blockinput.h \
$(CONFIG_H) \
$(LISP_H) \
$(W32TERM_H)
$(BLD)/w32xfns.$(O) : \
$(SRC)/w32xfns.c \
+ $(SRC)/blockinput.h \
$(SRC)/fontset.h \
- $(BLOCKINPUT_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(FRAME_H) \
$(BLD)/w32font.$(O) : \
$(SRC)/w32font.c \
$(SRC)/fontset.h \
- $(SRC)/w32font.h \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CODING_H) \
$(FONT_H) \
$(FRAME_H) \
$(LISP_H) \
+ $(W32FONT_H) \
$(W32TERM_H)
$(BLD)/w32uniscribe.$(O) : \
$(SRC)/w32uniscribe.c \
$(SRC)/composite.h \
$(SRC)/fontset.h \
- $(SRC)/w32font.h \
$(CHARACTER_H) \
$(CHARSET_H) \
$(CONFIG_H) \
$(FONT_H) \
$(FRAME_H) \
$(LISP_H) \
+ $(W32FONT_H) \
$(W32TERM_H)
# Each object file depends on stamp_BLD, because in parallel builds we must
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
/* Record one cached position found recently by
buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
-static EMACS_INT cached_charpos;
-static EMACS_INT cached_bytepos;
+static ptrdiff_t cached_charpos;
+static ptrdiff_t cached_bytepos;
static struct buffer *cached_buffer;
static int cached_modiff;
-static void byte_char_debug_check (struct buffer *, EMACS_INT, EMACS_INT);
+/* Juanma Barranquero <lekktu@gmail.com> reported ~3x increased
+ bootstrap time when byte_char_debug_check is enabled; so this
+ is never turned on by --enable-checking configure option. */
+
+#ifdef MARKER_DEBUG
+
+extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
+extern ptrdiff_t verify_bytepos (ptrdiff_t charpos) EXTERNALLY_VISIBLE;
+
+static void
+byte_char_debug_check (struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos)
+{
+ ptrdiff_t nchars;
+
+ if (NILP (BVAR (b, enable_multibyte_characters)))
+ return;
+
+ if (bytepos > BUF_GPT_BYTE (b))
+ nchars
+ = multibyte_chars_in_text (BUF_BEG_ADDR (b),
+ BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b))
+ + multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
+ bytepos - BUF_GPT_BYTE (b));
+ else
+ nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
+ bytepos - BUF_BEG_BYTE (b));
+
+ if (charpos - 1 != nchars)
+ emacs_abort ();
+}
+
+#else /* not MARKER_DEBUG */
+
+#define byte_char_debug_check(b, charpos, bytepos) do { } while (0)
+
+#endif /* MARKER_DEBUG */
void
clear_charpos_cache (struct buffer *b)
#define CONSIDER(CHARPOS, BYTEPOS) \
{ \
- EMACS_INT this_charpos = (CHARPOS); \
+ ptrdiff_t this_charpos = (CHARPOS); \
int changed = 0; \
\
if (this_charpos == charpos) \
{ \
- EMACS_INT value = (BYTEPOS); \
- if (byte_debug_flag) \
- byte_char_debug_check (b, charpos, value); \
+ ptrdiff_t value = (BYTEPOS); \
+ \
+ byte_char_debug_check (b, charpos, value); \
return value; \
} \
else if (this_charpos > charpos) \
{ \
if (best_above - best_below == best_above_byte - best_below_byte) \
{ \
- EMACS_INT value = best_below_byte + (charpos - best_below); \
- if (byte_debug_flag) \
- byte_char_debug_check (b, charpos, value); \
+ ptrdiff_t value = best_below_byte + (charpos - best_below); \
+ \
+ byte_char_debug_check (b, charpos, value); \
return value; \
} \
} \
}
-static void
-byte_char_debug_check (struct buffer *b, EMACS_INT charpos, EMACS_INT bytepos)
-{
- EMACS_INT nchars = 0;
-
- if (bytepos > BUF_GPT_BYTE (b))
- {
- nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
- BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b));
- nchars += multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
- bytepos - BUF_GPT_BYTE (b));
- }
- else
- nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
- bytepos - BUF_BEG_BYTE (b));
-
- if (charpos - 1 != nchars)
- abort ();
-}
-
-EMACS_INT
-charpos_to_bytepos (EMACS_INT charpos)
+ptrdiff_t
+charpos_to_bytepos (ptrdiff_t charpos)
{
return buf_charpos_to_bytepos (current_buffer, charpos);
}
-EMACS_INT
-buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos)
+ptrdiff_t
+buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
{
struct Lisp_Marker *tail;
- EMACS_INT best_above, best_above_byte;
- EMACS_INT best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
+ ptrdiff_t best_below, best_below_byte;
if (charpos < BUF_BEG (b) || charpos > BUF_Z (b))
- abort ();
+ emacs_abort ();
best_above = BUF_Z (b);
best_above_byte = BUF_Z_BYTE (b);
cache the correspondence by creating a marker here.
It will last until the next GC. */
if (record)
- {
- Lisp_Object marker, buffer;
- marker = Fmake_marker ();
- XSETBUFFER (buffer, b);
- set_marker_both (marker, buffer, best_below, best_below_byte);
- }
+ build_marker (b, best_below, best_below_byte);
- if (byte_debug_flag)
- byte_char_debug_check (b, charpos, best_below_byte);
+ byte_char_debug_check (b, best_below, best_below_byte);
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
cache the correspondence by creating a marker here.
It will last until the next GC. */
if (record)
- {
- Lisp_Object marker, buffer;
- marker = Fmake_marker ();
- XSETBUFFER (buffer, b);
- set_marker_both (marker, buffer, best_above, best_above_byte);
- }
+ build_marker (b, best_above, best_above_byte);
- if (byte_debug_flag)
- byte_char_debug_check (b, charpos, best_above_byte);
+ byte_char_debug_check (b, best_above, best_above_byte);
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
#undef CONSIDER
-/* Used for debugging: recompute the bytepos corresponding to CHARPOS
- in the simplest, most reliable way. */
-
-extern EMACS_INT verify_bytepos (EMACS_INT charpos) EXTERNALLY_VISIBLE;
-EMACS_INT
-verify_bytepos (EMACS_INT charpos)
-{
- EMACS_INT below = 1;
- EMACS_INT below_byte = 1;
-
- while (below != charpos)
- {
- below++;
- BUF_INC_POS (current_buffer, below_byte);
- }
-
- return below_byte;
-}
-\f
/* buf_bytepos_to_charpos returns the char position corresponding to
BYTEPOS. */
#define CONSIDER(BYTEPOS, CHARPOS) \
{ \
- EMACS_INT this_bytepos = (BYTEPOS); \
+ ptrdiff_t this_bytepos = (BYTEPOS); \
int changed = 0; \
\
if (this_bytepos == bytepos) \
{ \
- EMACS_INT value = (CHARPOS); \
- if (byte_debug_flag) \
- byte_char_debug_check (b, value, bytepos); \
+ ptrdiff_t value = (CHARPOS); \
+ \
+ byte_char_debug_check (b, value, bytepos); \
return value; \
} \
else if (this_bytepos > bytepos) \
{ \
if (best_above - best_below == best_above_byte - best_below_byte) \
{ \
- EMACS_INT value = best_below + (bytepos - best_below_byte); \
- if (byte_debug_flag) \
- byte_char_debug_check (b, value, bytepos); \
+ ptrdiff_t value = best_below + (bytepos - best_below_byte); \
+ \
+ byte_char_debug_check (b, value, bytepos); \
return value; \
} \
} \
}
-EMACS_INT
-buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos)
+ptrdiff_t
+buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
{
struct Lisp_Marker *tail;
- EMACS_INT best_above, best_above_byte;
- EMACS_INT best_below, best_below_byte;
+ ptrdiff_t best_above, best_above_byte;
+ ptrdiff_t best_below, best_below_byte;
if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
- abort ();
+ emacs_abort ();
best_above = BUF_Z (b);
best_above_byte = BUF_Z_BYTE (b);
But don't do it if BUF_MARKERS is nil;
that is a signal from Fset_buffer_multibyte. */
if (record && BUF_MARKERS (b))
- {
- Lisp_Object marker, buffer;
- marker = Fmake_marker ();
- XSETBUFFER (buffer, b);
- set_marker_both (marker, buffer, best_below, best_below_byte);
- }
+ build_marker (b, best_below, best_below_byte);
- if (byte_debug_flag)
- byte_char_debug_check (b, best_below, bytepos);
+ byte_char_debug_check (b, best_below, best_below_byte);
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
But don't do it if BUF_MARKERS is nil;
that is a signal from Fset_buffer_multibyte. */
if (record && BUF_MARKERS (b))
- {
- Lisp_Object marker, buffer;
- marker = Fmake_marker ();
- XSETBUFFER (buffer, b);
- set_marker_both (marker, buffer, best_above, best_above_byte);
- }
+ build_marker (b, best_above, best_above_byte);
- if (byte_debug_flag)
- byte_char_debug_check (b, best_above, bytepos);
+ byte_char_debug_check (b, best_above, best_above_byte);
cached_buffer = b;
cached_modiff = BUF_MODIFF (b);
does not preserve the buffer from being GC'd (it's weak), so
markers have to be unlinked from their buffer as soon as the buffer
is killed. */
- eassert (!NILP (BVAR (XBUFFER (buf), name)));
+ eassert (BUFFER_LIVE_P (XBUFFER (buf)));
return buf;
}
return Qnil;
return Qnil;
}
-\f
-DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
- doc: /* Position MARKER before character number POSITION in BUFFER.
-BUFFER defaults to the current buffer.
-If POSITION is nil, makes marker point nowhere.
-Then it no longer slows down editing in any buffer.
-Returns MARKER. */)
- (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
-{
- register EMACS_INT charno, bytepos;
- register struct buffer *b;
- register struct Lisp_Marker *m;
-
- CHECK_MARKER (marker);
- m = XMARKER (marker);
- /* If position is nil or a marker that points nowhere,
- make this marker point nowhere. */
- if (NILP (position)
- || (MARKERP (position) && !XMARKER (position)->buffer))
- {
- unchain_marker (m);
- return marker;
- }
+/* Change M so it points to B at CHARPOS and BYTEPOS. */
- if (NILP (buffer))
- b = current_buffer;
+static inline void
+attach_marker (struct Lisp_Marker *m, struct buffer *b,
+ ptrdiff_t charpos, ptrdiff_t bytepos)
+{
+ /* In a single-byte buffer, two positions must be equal.
+ Otherwise, every character is at least one byte. */
+ if (BUF_Z (b) == BUF_Z_BYTE (b))
+ eassert (charpos == bytepos);
else
- {
- CHECK_BUFFER (buffer);
- b = XBUFFER (buffer);
- /* If buffer is dead, set marker to point nowhere. */
- if (EQ (BVAR (b, name), Qnil))
- {
- unchain_marker (m);
- return marker;
- }
- }
-
- /* Optimize the special case where we are copying the position
- of an existing marker, and MARKER is already in the same buffer. */
- if (MARKERP (position) && b == XMARKER (position)->buffer
- && b == m->buffer)
- {
- m->bytepos = XMARKER (position)->bytepos;
- m->charpos = XMARKER (position)->charpos;
- return marker;
- }
-
- CHECK_NUMBER_COERCE_MARKER (position);
-
- charno = XINT (position);
-
- if (charno < BUF_BEG (b))
- charno = BUF_BEG (b);
- if (charno > BUF_Z (b))
- charno = BUF_Z (b);
-
- bytepos = buf_charpos_to_bytepos (b, charno);
-
- /* Every character is at least one byte. */
- if (charno > bytepos)
- abort ();
+ eassert (charpos <= bytepos);
+ m->charpos = charpos;
m->bytepos = bytepos;
- m->charpos = charno;
if (m->buffer != b)
{
m->next = BUF_MARKERS (b);
BUF_MARKERS (b) = m;
}
-
- return marker;
}
-/* This version of Fset_marker won't let the position
- be outside the visible part. */
+/* If BUFFER is nil, return current buffer pointer. Next, check
+ whether BUFFER is a buffer object and return buffer pointer
+ corresponding to BUFFER if BUFFER is live, or NULL otherwise. */
-Lisp_Object
-set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
+static inline struct buffer *
+live_buffer (Lisp_Object buffer)
{
- register EMACS_INT charno, bytepos;
- register struct buffer *b;
- register struct Lisp_Marker *m;
-
- CHECK_MARKER (marker);
- m = XMARKER (marker);
+ struct buffer *b;
- /* If position is nil or a marker that points nowhere,
- make this marker point nowhere. */
- if (NILP (pos)
- || (MARKERP (pos) && !XMARKER (pos)->buffer))
+ if (NILP (buffer))
{
- unchain_marker (m);
- return marker;
+ b = current_buffer;
+ eassert (BUFFER_LIVE_P (b));
}
-
- if (NILP (buffer))
- b = current_buffer;
else
{
CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
- /* If buffer is dead, set marker to point nowhere. */
- if (EQ (BVAR (b, name), Qnil))
- {
- unchain_marker (m);
- return marker;
- }
+ if (!BUFFER_LIVE_P (b))
+ b = NULL;
}
+ return b;
+}
- /* Optimize the special case where we are copying the position
- of an existing marker, and MARKER is already in the same buffer. */
- if (MARKERP (pos) && b == XMARKER (pos)->buffer
- && b == m->buffer)
- {
- m->bytepos = XMARKER (pos)->bytepos;
- m->charpos = XMARKER (pos)->charpos;
- return marker;
- }
-
- CHECK_NUMBER_COERCE_MARKER (pos);
-
- charno = XINT (pos);
-
- if (charno < BUF_BEGV (b))
- charno = BUF_BEGV (b);
- if (charno > BUF_ZV (b))
- charno = BUF_ZV (b);
-
- bytepos = buf_charpos_to_bytepos (b, charno);
+/* Internal function to set MARKER in BUFFER at POSITION. Non-zero
+ RESTRICTED means limit the POSITION by the visible part of BUFFER. */
- /* Every character is at least one byte. */
- if (charno > bytepos)
- abort ();
+static inline Lisp_Object
+set_marker_internal (Lisp_Object marker, Lisp_Object position,
+ Lisp_Object buffer, int restricted)
+{
+ register struct Lisp_Marker *m;
+ register struct buffer *b = live_buffer (buffer);
- m->bytepos = bytepos;
- m->charpos = charno;
+ CHECK_MARKER (marker);
+ m = XMARKER (marker);
- if (m->buffer != b)
+ /* Set MARKER to point nowhere if BUFFER is dead, or
+ POSITION is nil or a marker points to nowhere. */
+ if (NILP (position)
+ || (MARKERP (position) && !XMARKER (position)->buffer)
+ || !b)
+ unchain_marker (m);
+
+ /* Optimize the special case where we are copying the position of
+ an existing marker, and MARKER is already in the same buffer. */
+ else if (MARKERP (position) && b == XMARKER (position)->buffer
+ && b == m->buffer)
{
- unchain_marker (m);
- m->buffer = b;
- m->next = BUF_MARKERS (b);
- BUF_MARKERS (b) = m;
+ m->bytepos = XMARKER (position)->bytepos;
+ m->charpos = XMARKER (position)->charpos;
}
+ else
+ {
+ register ptrdiff_t charpos, bytepos;
+
+ CHECK_NUMBER_COERCE_MARKER (position);
+ charpos = clip_to_bounds (restricted ? BUF_BEGV (b) : BUF_BEG (b),
+ XINT (position),
+ restricted ? BUF_ZV (b) : BUF_Z (b));
+ bytepos = buf_charpos_to_bytepos (b, charpos);
+ attach_marker (m, b, charpos, bytepos);
+ }
return marker;
}
-\f
+
+DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
+ doc: /* Position MARKER before character number POSITION in BUFFER,
+which defaults to the current buffer. If POSITION is nil,
+makes marker point nowhere so it no longer slows down
+editing in any buffer. Returns MARKER. */)
+ (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
+{
+ return set_marker_internal (marker, position, buffer, 0);
+}
+
+/* Like the above, but won't let the position be outside the visible part. */
+
+Lisp_Object
+set_marker_restricted (Lisp_Object marker, Lisp_Object position,
+ Lisp_Object buffer)
+{
+ return set_marker_internal (marker, position, buffer, 1);
+}
+
/* Set the position of MARKER, specifying both the
character position and the corresponding byte position. */
Lisp_Object
-set_marker_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
+set_marker_both (Lisp_Object marker, Lisp_Object buffer,
+ ptrdiff_t charpos, ptrdiff_t bytepos)
{
- register struct buffer *b;
register struct Lisp_Marker *m;
+ register struct buffer *b = live_buffer (buffer);
CHECK_MARKER (marker);
m = XMARKER (marker);
- if (NILP (buffer))
- b = current_buffer;
+ if (b)
+ attach_marker (m, b, charpos, bytepos);
else
- {
- CHECK_BUFFER (buffer);
- b = XBUFFER (buffer);
- /* If buffer is dead, set marker to point nowhere. */
- if (EQ (BVAR (b, name), Qnil))
- {
- unchain_marker (m);
- return marker;
- }
- }
-
- /* In a single-byte buffer, the two positions must be equal. */
- if (BUF_Z (b) == BUF_Z_BYTE (b)
- && charpos != bytepos)
- abort ();
- /* Every character is at least one byte. */
- if (charpos > bytepos)
- abort ();
-
- m->bytepos = bytepos;
- m->charpos = charpos;
-
- if (m->buffer != b)
- {
- unchain_marker (m);
- m->buffer = b;
- m->next = BUF_MARKERS (b);
- BUF_MARKERS (b) = m;
- }
-
+ unchain_marker (m);
return marker;
}
-/* This version of set_marker_both won't let the position
- be outside the visible part. */
+/* Like the above, but won't let the position be outside the visible part. */
Lisp_Object
-set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos)
+set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer,
+ ptrdiff_t charpos, ptrdiff_t bytepos)
{
- register struct buffer *b;
register struct Lisp_Marker *m;
+ register struct buffer *b = live_buffer (buffer);
CHECK_MARKER (marker);
m = XMARKER (marker);
- if (NILP (buffer))
- b = current_buffer;
- else
- {
- CHECK_BUFFER (buffer);
- b = XBUFFER (buffer);
- /* If buffer is dead, set marker to point nowhere. */
- if (EQ (BVAR (b, name), Qnil))
- {
- unchain_marker (m);
- return marker;
- }
- }
-
- if (charpos < BUF_BEGV (b))
- charpos = BUF_BEGV (b);
- if (charpos > BUF_ZV (b))
- charpos = BUF_ZV (b);
- if (bytepos < BUF_BEGV_BYTE (b))
- bytepos = BUF_BEGV_BYTE (b);
- if (bytepos > BUF_ZV_BYTE (b))
- bytepos = BUF_ZV_BYTE (b);
-
- /* In a single-byte buffer, the two positions must be equal. */
- if (BUF_Z (b) == BUF_Z_BYTE (b)
- && charpos != bytepos)
- abort ();
- /* Every character is at least one byte. */
- if (charpos > bytepos)
- abort ();
-
- m->bytepos = bytepos;
- m->charpos = charpos;
-
- if (m->buffer != b)
+ if (b)
{
- unchain_marker (m);
- m->buffer = b;
- m->next = BUF_MARKERS (b);
- BUF_MARKERS (b) = m;
+ attach_marker
+ (m, b,
+ clip_to_bounds (BUF_BEGV (b), charpos, BUF_ZV (b)),
+ clip_to_bounds (BUF_BEGV_BYTE (b), bytepos, BUF_ZV_BYTE (b)));
}
-
+ else
+ unchain_marker (m);
return marker;
}
-\f
-/* Remove MARKER from the chain of whatever buffer it is in.
- Leave it "in no buffer".
- This is called during garbage collection,
- so we must be careful to ignore and preserve mark bits,
- including those in chain fields of markers. */
+/* Remove MARKER from the chain of whatever buffer it is in,
+ leaving it points to nowhere. This is called during garbage
+ collection, so we must be careful to ignore and preserve
+ mark bits, including those in chain fields of markers. */
void
unchain_marker (register struct Lisp_Marker *marker)
{
- register struct Lisp_Marker *tail, *prev, *next;
- register struct buffer *b;
+ register struct buffer *b = marker->buffer;
- b = marker->buffer;
- if (b == 0)
- return;
-
- if (EQ (BVAR (b, name), Qnil))
- abort ();
-
- marker->buffer = 0;
-
- tail = BUF_MARKERS (b);
- prev = NULL;
- while (tail)
+ if (b)
{
- next = tail->next;
-
- if (marker == tail)
- {
- if (!prev)
- {
- BUF_MARKERS (b) = next;
- /* Deleting first marker from the buffer's chain. Crash
- if new first marker in chain does not say it belongs
- to the same buffer, or at least that they have the same
- base buffer. */
- if (next && b->text != next->buffer->text)
- abort ();
- }
- else
- prev->next = next;
- /* We have removed the marker from the chain;
- no need to scan the rest of the chain. */
- return;
- }
- else
- prev = tail;
- tail = next;
+ register struct Lisp_Marker *tail, **prev;
+
+ /* No dead buffers here. */
+ eassert (BUFFER_LIVE_P (b));
+
+ marker->buffer = NULL;
+ prev = &BUF_MARKERS (b);
+
+ for (tail = BUF_MARKERS (b); tail; prev = &tail->next, tail = *prev)
+ if (marker == tail)
+ {
+ if (*prev == BUF_MARKERS (b))
+ {
+ /* Deleting first marker from the buffer's chain. Crash
+ if new first marker in chain does not say it belongs
+ to the same buffer, or at least that they have the same
+ base buffer. */
+ if (tail->next && b->text != tail->next->buffer->text)
+ emacs_abort ();
+ }
+ *prev = tail->next;
+ /* We have removed the marker from the chain;
+ no need to scan the rest of the chain. */
+ break;
+ }
+
+ /* Error if marker was not in it's chain. */
+ eassert (tail != NULL);
}
-
- /* Marker was not in its chain. */
- abort ();
}
/* Return the char position of marker MARKER, as a C integer. */
-EMACS_INT
+ptrdiff_t
marker_position (Lisp_Object marker)
{
register struct Lisp_Marker *m = XMARKER (marker);
if (!buf)
error ("Marker does not point anywhere");
+ eassert (BUF_BEG (buf) <= m->charpos && m->charpos <= BUF_Z (buf));
+
return m->charpos;
}
/* Return the byte position of marker MARKER, as a C integer. */
-EMACS_INT
+ptrdiff_t
marker_byte_position (Lisp_Object marker)
{
register struct Lisp_Marker *m = XMARKER (marker);
register struct buffer *buf = m->buffer;
- register EMACS_INT i = m->bytepos;
if (!buf)
error ("Marker does not point anywhere");
- if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
- abort ();
+ eassert (BUF_BEG_BYTE (buf) <= m->bytepos && m->bytepos <= BUF_Z_BYTE (buf));
- return i;
+ return m->bytepos;
}
\f
DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
(Lisp_Object position)
{
register struct Lisp_Marker *tail;
- register EMACS_INT charno;
-
- charno = XINT (position);
+ register ptrdiff_t charpos;
- if (charno < BEG)
- charno = BEG;
- if (charno > Z)
- charno = Z;
+ charpos = clip_to_bounds (BEG, XINT (position), Z);
for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
- if (tail->charpos == charno)
+ if (tail->charpos == charpos)
return Qt;
return Qnil;
}
+#ifdef MARKER_DEBUG
+
/* For debugging -- count the markers in buffer BUF. */
-extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
int
count_markers (struct buffer *buf)
{
return total;
}
+
+/* For debugging -- recompute the bytepos corresponding
+ to CHARPOS in the simplest, most reliable way. */
+
+ptrdiff_t
+verify_bytepos (ptrdiff_t charpos)
+{
+ ptrdiff_t below = 1;
+ ptrdiff_t below_byte = 1;
+
+ while (below != charpos)
+ {
+ below++;
+ BUF_INC_POS (current_buffer, below_byte);
+ }
+
+ return below_byte;
+}
+
+#endif /* MARKER_DEBUG */
\f
void
syms_of_marker (void)
defsubr (&Smarker_insertion_type);
defsubr (&Sset_marker_insertion_type);
defsubr (&Sbuffer_has_markers_at);
-
- DEFVAR_BOOL ("byte-debug-flag", byte_debug_flag,
- doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
- byte_debug_flag = 0;
}
# endif
#endif
-extern char *start_of_data (void);
-#if defined USE_LSB_TAG || UINTPTR_MAX >> VALBITS == 0
+extern char *start_of_data (void) ATTRIBUTE_CONST;
+#if USE_LSB_TAG || UINTPTR_MAX <= VAL_MAX
#define EXCEEDS_LISP_PTR(ptr) 0
-#elif defined DATA_SEG_BITS
+#else
#define EXCEEDS_LISP_PTR(ptr) \
(((uintptr_t) (ptr) & ~DATA_SEG_BITS) >> VALBITS)
-#else
-#define EXCEEDS_LISP_PTR(ptr) ((uintptr_t) (ptr) >> VALBITS)
#endif
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <limits.h> /* for INT_MAX */
#include "lisp.h"
#include "../lwlib/lwlib.h"
#endif
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif
-
-#ifdef HAVE_NS
-#include "nsterm.h"
-#endif
-
-#ifdef USE_GTK
-#include "gtkutil.h"
-#endif
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
#ifdef HAVE_NTGUI
-#include "w32term.h"
-
extern AppendMenuW_Proc unicode_append_menu;
extern HMENU current_popup_menu;
-
#endif /* HAVE_NTGUI */
#include "menu.h"
menu_items = Qnil;
menu_items_allocated = 0;
}
- xassert (NILP (menu_items_inuse));
+ eassert (NILP (menu_items_inuse));
}
#ifdef HAVE_NS
}
\f
-/* Make the menu_items vector twice as large. */
+/* Ensure that there is room for ITEMS items in the menu_items vector. */
static void
-grow_menu_items (void)
+ensure_menu_items (int items)
{
- if ((INT_MAX - MENU_ITEMS_PANE_LENGTH) / 2 < menu_items_allocated)
- memory_full (SIZE_MAX);
- menu_items_allocated *= 2;
- menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
+ int incr = items - (menu_items_allocated - menu_items_used);
+ if (0 < incr)
+ {
+ menu_items = larger_vector (menu_items, incr, INT_MAX);
+ menu_items_allocated = ASIZE (menu_items);
+ }
}
#if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
static void
push_submenu_start (void)
{
- if (menu_items_used + 1 > menu_items_allocated)
- grow_menu_items ();
-
- XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
+ ensure_menu_items (1);
+ ASET (menu_items, menu_items_used, Qnil);
+ menu_items_used++;
menu_items_submenu_depth++;
}
static void
push_submenu_end (void)
{
- if (menu_items_used + 1 > menu_items_allocated)
- grow_menu_items ();
-
- XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
+ ensure_menu_items (1);
+ ASET (menu_items, menu_items_used, Qlambda);
+ menu_items_used++;
menu_items_submenu_depth--;
}
static void
push_left_right_boundary (void)
{
- if (menu_items_used + 1 > menu_items_allocated)
- grow_menu_items ();
-
- XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
+ ensure_menu_items (1);
+ ASET (menu_items, menu_items_used, Qquote);
+ menu_items_used++;
}
/* Start a new menu pane in menu_items.
static void
push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
{
- if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
- grow_menu_items ();
-
+ ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
if (menu_items_submenu_depth == 0)
menu_items_n_panes++;
- XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
- XVECTOR (menu_items)->contents[menu_items_used++] = name;
- XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
+ ASET (menu_items, menu_items_used, Qt);
+ menu_items_used++;
+ ASET (menu_items, menu_items_used, name);
+ menu_items_used++;
+ ASET (menu_items, menu_items_used, prefix_vec);
+ menu_items_used++;
}
/* Push one menu item into the current pane. NAME is the string to
static void
push_menu_item (Lisp_Object name, Lisp_Object enable, Lisp_Object key, Lisp_Object def, Lisp_Object equiv, Lisp_Object type, Lisp_Object selected, Lisp_Object help)
{
- if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
- grow_menu_items ();
+ ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
if (!res)
return; /* Not a menu item. */
- map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
+ map = AREF (item_properties, ITEM_PROPERTY_MAP);
- enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
- item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+ enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
+ item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
if (!NILP (map) && SREF (item_string, 0) == '@')
{
front of them. */
{
Lisp_Object prefix = Qnil;
- Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
+ Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
if (!NILP (type))
{
Lisp_Object selected
- = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
+ = AREF (item_properties, ITEM_PROPERTY_SELECTED);
if (skp->notbuttons)
/* The first button. Line up previous items in this menu. */
while (idx < menu_items_used)
{
tem
- = XVECTOR (menu_items)->contents[idx + MENU_ITEMS_ITEM_NAME];
+ = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
if (NILP (tem))
{
idx++;
{
if (!submenu && SREF (tem, 0) != '\0'
&& SREF (tem, 0) != '-')
- XVECTOR (menu_items)->contents[idx + MENU_ITEMS_ITEM_NAME]
- = concat2 (build_string (" "), tem);
+ ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
+ concat2 (build_string (" "), tem));
idx += MENU_ITEMS_ITEM_LENGTH;
}
}
#endif /* HAVE_X_WINDOWS || MSDOS */
push_menu_item (item_string, enabled, key,
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
- XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
+ AREF (item_properties, ITEM_PROPERTY_DEF),
+ AREF (item_properties, ITEM_PROPERTY_KEYEQ),
+ AREF (item_properties, ITEM_PROPERTY_TYPE),
+ AREF (item_properties, ITEM_PROPERTY_SELECTED),
+ AREF (item_properties, ITEM_PROPERTY_HELP));
#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
/* Display a submenu using the toolkit. */
and generate menu panes for them in menu_items. */
static void
-keymap_panes (Lisp_Object *keymaps, int nmaps)
+keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
{
- int mapno;
+ ptrdiff_t mapno;
init_menu_items ();
parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
{
Lisp_Object length;
- int len;
+ EMACS_INT len;
Lisp_Object *mapvec;
- int i;
+ ptrdiff_t i;
int top_level_items = 0;
+ USE_SAFE_ALLOCA;
length = Flength (maps);
len = XINT (length);
/* Convert the list MAPS into a vector MAPVEC. */
- mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
+ SAFE_ALLOCA_LISP (mapvec, len);
for (i = 0; i < len; i++)
{
mapvec[i] = Fcar (maps);
}
}
+ SAFE_FREE ();
return top_level_items;
}
{
widget_value *value;
- BLOCK_INPUT;
+ block_input ();
value = malloc_widget_value ();
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
free_menubar_widget_value_tree (wv->next);
wv->next = (widget_value *) 0xDEADBEEF;
}
- BLOCK_INPUT;
+ block_input ();
free_widget_value (wv);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Create a tree of widget_value objects
widget_value **submenu_stack;
int panes_seen = 0;
- submenu_stack
- = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
+ submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
wv = xmalloc_widget_value ();
wv->name = "menu";
wv->value = 0;
i = start;
while (i < end)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ if (EQ (AREF (menu_items, i), Qnil))
{
submenu_stack[submenu_depth++] = save_wv;
save_wv = prev_wv;
prev_wv = 0;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ else if (EQ (AREF (menu_items, i), Qlambda))
{
prev_wv = save_wv;
save_wv = submenu_stack[--submenu_depth];
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
+ else if (EQ (AREF (menu_items, i), Qt)
&& submenu_depth != 0)
i += MENU_ITEMS_PANE_LENGTH;
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ else if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name;
panes_seen++;
- pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
+ pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
#ifdef HAVE_NTGUI
if (STRINGP (pane_name))
/* All items should be contained in panes. */
if (panes_seen == 0)
- abort ();
+ emacs_abort ();
item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
else if (EQ (type, QCtoggle))
wv->button_type = BUTTON_TYPE_TOGGLE;
else
- abort ();
+ emacs_abort ();
wv->selected = !NILP (selected);
if (! STRINGP (help))
int i;
entry = Qnil;
- subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
+ subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
prefix = Qnil;
i = 0;
while (i < menu_bar_items_used)
{
- if (EQ (XVECTOR (vector)->contents[i], Qnil))
+ if (EQ (AREF (vector, i), Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
- else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
+ else if (EQ (AREF (vector, i), Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
- else if (EQ (XVECTOR (vector)->contents[i], Qt))
+ else if (EQ (AREF (vector, i), Qt))
{
- prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
i += MENU_ITEMS_PANE_LENGTH;
}
else
{
- entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
+ entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
/* Treat the pointer as an integer. There's no problem
as long as pointers have enough bits to hold small integers. */
if ((intptr_t) client_data == i)
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)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ if (EQ (AREF (menu_items, i), Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ else if (EQ (AREF (menu_items, i), Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ else if (EQ (AREF (menu_items, i), Qt))
{
prefix
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
i += MENU_ITEMS_PANE_LENGTH;
}
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
else
{
entry
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
- if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
+ if (aref_addr (menu_items, i) == client_data)
{
if (keymaps != 0)
{
Lisp_Object x, y, window;
int keymaps = 0;
int for_click = 0;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
struct gcpro gcpro1;
if (NILP (position))
}
}
- CHECK_NUMBER (x);
- CHECK_NUMBER (y);
-
/* Decode where to put the menu. */
if (FRAMEP (window))
but I don't want to make one now. */
CHECK_WINDOW (window);
+ CHECK_RANGED_INTEGER (x,
+ (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
+ ? (EMACS_INT) INT_MIN - xpos
+ : MOST_NEGATIVE_FIXNUM),
+ INT_MAX - xpos);
+ CHECK_RANGED_INTEGER (y,
+ (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
+ ? (EMACS_INT) INT_MIN - ypos
+ : MOST_NEGATIVE_FIXNUM),
+ INT_MAX - ypos);
xpos += XINT (x);
ypos += XINT (y);
else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
{
/* We were given a list of keymaps. */
- int nmaps = XFASTINT (Flength (menu));
- Lisp_Object *maps
- = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
- int i;
+ EMACS_INT nmaps = XFASTINT (Flength (menu));
+ Lisp_Object *maps;
+ ptrdiff_t i;
+ USE_SAFE_ALLOCA;
+ SAFE_ALLOCA_LISP (maps, nmaps);
title = Qnil;
/* The first keymap that has a prompt string
ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
keymaps = 1;
+
+ SAFE_FREE ();
}
else
{
#endif
/* Display them in a menu. */
- BLOCK_INPUT;
+ block_input ();
/* FIXME: Use a terminal hook! */
#if defined HAVE_NTGUI
last_event_timestamp);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
#ifdef HAVE_NS
unbind_to (specpdl_count, Qnil);
Lisp_Object oldval);
extern void init_menu_items (void);
-extern void finish_menu_items (void);
+extern void finish_menu_items (void) ATTRIBUTE_CONST;
extern void discard_menu_items (void);
extern void save_menu_items (void);
extern int parse_single_submenu (Lisp_Object, Lisp_Object, Lisp_Object);
#include <config.h>
#include <errno.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "commands.h"
+#include "character.h"
#include "buffer.h"
#include "dispextern.h"
#include "keyboard.h"
static Lisp_Object Qminibuffer_completion_table;
static Lisp_Object Qminibuffer_completion_predicate;
static Lisp_Object Qminibuffer_completion_confirm;
-static Lisp_Object Quser_variable_p;
+static Lisp_Object Qcustom_variable_p;
static Lisp_Object Qminibuffer_default;
/* Width of current mini-buffer prompt. Only set after display_line
of the line that contains the prompt. */
-static EMACS_INT minibuf_prompt_width;
+static ptrdiff_t minibuf_prompt_width;
\f
/* Put minibuf on currently selected frame's minibuffer.
/* I don't think that any frames may validly have a null minibuffer
window anymore. */
if (NILP (sf->minibuffer_window))
- abort ();
+ emacs_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 = XWINDOW (minibuf_window)->buffer;
if (BUFFERP (buffer))
- Fset_window_buffer (sf->minibuffer_window, buffer, Qnil);
+ /* 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;
}
static Lisp_Object read_minibuf_unwind (Lisp_Object);
static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
static Lisp_Object read_minibuf (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object,
+ Lisp_Object,
int, Lisp_Object,
Lisp_Object, Lisp_Object,
int, int);
{
struct gcpro gcpro1, gcpro2;
Lisp_Object expr_and_pos;
- EMACS_INT pos;
+ ptrdiff_t pos;
GCPRO2 (val, defalt);
{
/* Ignore trailing whitespace; any other trailing junk
is an error. */
- EMACS_INT i;
+ ptrdiff_t i;
pos = string_char_to_byte (val, pos);
for (i = pos; i < SBYTES (val); i++)
{
val = Qnil;
size = 100;
len = 0;
- line = (char *) xmalloc (size);
+ line = xmalloc (size);
while ((c = getchar ()) != '\n')
{
if (STRING_BYTES_BOUND / 2 < size)
memory_full (SIZE_MAX);
size *= 2;
- line = (char *) xrealloc (line, size);
+ line = xrealloc (line, size);
}
line[len++] = c;
}
If the current buffer is not a minibuffer, return its entire contents. */)
(void)
{
- EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ());
+ ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ());
return make_buffer_string (prompt_end, ZV, 1);
}
If the current buffer is not a minibuffer, return its entire contents. */)
(void)
{
- EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ());
+ ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ());
return make_buffer_string (prompt_end, ZV, 0);
}
If the current buffer is not a minibuffer, return its entire contents. */)
(void)
{
- EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ());
+ ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ());
if (PT < prompt_end)
error ("Cannot do completion in the prompt");
return make_buffer_string (prompt_end, PT, 1);
static Lisp_Object
read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
- Lisp_Object backup_n, int expflag,
+ int expflag,
Lisp_Object histvar, Lisp_Object histpos, Lisp_Object defalt,
int allow_props, int inherit_input_method)
{
Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object enable_multibyte;
- int pos = INTEGERP (backup_n) ? XINT (backup_n) : 0;
+ EMACS_INT pos = 0;
/* String to add to the history. */
Lisp_Object histstring;
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
{
if (CONSP (initial))
{
- backup_n = Fcdr (initial);
- initial = Fcar (initial);
+ Lisp_Object backup_n = XCDR (initial);
+ initial = XCAR (initial);
CHECK_STRING (initial);
if (!NILP (backup_n))
{
/* 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_truncate_lines (current_buffer, Qnil);
/* If appropriate, copy enable-multibyte-characters into the minibuffer. */
if (inherit_input_method)
- BVAR (current_buffer, enable_multibyte_characters) = enable_multibyte;
+ bset_enable_multibyte_characters (current_buffer, 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
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_directory (current_buffer, ambient_dir);
else
{
Lisp_Object buf_list;
other_buf = XCDR (XCAR (buf_list));
if (STRINGP (BVAR (XBUFFER (other_buf), directory)))
{
- BVAR (current_buffer, directory) = BVAR (XBUFFER (other_buf), directory);
+ bset_directory (current_buffer,
+ BVAR (XBUFFER (other_buf), directory));
break;
}
}
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);
- XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
+ XWINDOW (minibuf_window)->hscroll = 0;
Fmake_local_variable (Qprint_escape_newlines);
print_escape_newlines = 1;
/* Erase the buffer. */
{
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
}
clear_message (1, 1);
- BVAR (current_buffer, keymap) = map;
+ bset_keymap (current_buffer, map);
/* Turn on an input method stored in INPUT_METHOD if any. */
if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method)))
Frun_hooks (1, &Qminibuffer_setup_hook);
/* Don't allow the user to undo past this point. */
- BVAR (current_buffer, undo_list) = Qnil;
+ bset_undo_list (current_buffer, Qnil);
recursive_edit_1 ();
Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
}
buf = Fcar (tail);
- if (NILP (buf) || NILP (BVAR (XBUFFER (buf), name)))
+ if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf)))
{
- sprintf (name, " *Minibuf-%"pI"d*", depth);
- buf = Fget_buffer_create (build_string (name));
+ buf = Fget_buffer_create
+ (make_formatted_string (name, " *Minibuf-%"pI"d*", depth));
/* Although the buffer's name starts with a space, undo should be
enabled in it. */
}
else
{
- int count = SPECPDL_INDEX ();
- /* `reset_buffer' blindly sets the list of overlays to NULL, so we
- have to empty the list, otherwise we end up with overlays that
- think they belong to this buffer while the buffer doesn't know about
- them any more. */
+ ptrdiff_t count = SPECPDL_INDEX ();
+ /* We have to empty both overlay lists. Otherwise we end
+ up with overlays that think they belong to this buffer
+ while the buffer doesn't know about them any more. */
delete_all_overlays (XBUFFER (buf));
reset_buffer (XBUFFER (buf));
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (buf);
if (!NILP (Ffboundp (intern ("minibuffer-inactive-mode"))))
call0 (intern ("minibuffer-inactive-mode"));
/* Erase the minibuffer we were using at this level. */
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* Prevent error in erase-buffer. */
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
/* Make sure minibuffer window is erased, not ignored. */
windows_or_buffers_changed++;
- XSETFASTINT (XWINDOW (window)->last_modified, 0);
- XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
+ XWINDOW (window)->last_modified = 0;
+ XWINDOW (window)->last_overlay_modified = 0;
/* In case the previous minibuffer displayed in this miniwindow is
dead, we may keep displaying this buffer (tho it's inactive), so reset it,
GCPRO1 (default_value);
val = read_minibuf (keymap, initial_contents, prompt,
- Qnil, !NILP (read),
+ !NILP (read),
histvar, histpos, default_value,
minibuffer_allow_text_properties,
!NILP (inherit_input_method));
{
CHECK_STRING (prompt);
return read_minibuf (Vminibuffer_local_map, initial_contents,
- prompt, Qnil, 1, Qminibuffer_history,
+ prompt, 1, Qminibuffer_history,
make_number (0), Qnil, 0, 0);
}
(Lisp_Object prompt, Lisp_Object initial_contents)
{
return Feval (read_minibuf (Vread_expression_map, initial_contents,
- prompt, Qnil, 1, Qread_expression_history,
+ prompt, 1, Qread_expression_history,
make_number (0), Qnil, 0, 0),
Qnil);
}
(Lisp_Object prompt, Lisp_Object initial_input, Lisp_Object history, Lisp_Object default_value, Lisp_Object inherit_input_method)
{
Lisp_Object val;
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ /* Just in case we're in a recursive minibuffer, make it clear that the
+ previous minibuffer's completion table does not apply to the new
+ minibuffer.
+ FIXME: `minibuffer-completion-table' should be buffer-local instead. */
+ specbind (Qminibuffer_completion_table, Qnil);
+
val = Fread_from_minibuffer (prompt, initial_input, Qnil,
Qnil, history, default_value,
inherit_input_method);
if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
val = CONSP (default_value) ? XCAR (default_value) : default_value;
- return val;
+ return unbind_to (count, val);
}
DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0,
(Lisp_Object prompt, Lisp_Object initial, Lisp_Object inherit_input_method)
{
CHECK_STRING (prompt);
- return read_minibuf (Vminibuffer_local_ns_map, initial, prompt, Qnil,
+ return read_minibuf (Vminibuffer_local_ns_map, initial, prompt,
0, Qminibuffer_history, make_number (0), Qnil, 0,
!NILP (inherit_input_method));
}
#endif /* NOTDEF */
DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
- doc: /* Read the name of a user variable and return it as a symbol.
+ doc: /* Read the name of a user option and return it as a symbol.
Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element
if it is a list.
-A user variable is one for which `user-variable-p' returns non-nil. */)
+A user option, or customizable variable, is one for which
+`custom-variable-p' returns non-nil. */)
(Lisp_Object prompt, Lisp_Object default_value)
{
Lisp_Object name, default_string;
default_string = default_value;
name = Fcompleting_read (prompt, Vobarray,
- Quser_variable_p, Qt,
+ Qcustom_variable_p, Qt,
Qnil, Qnil, default_string, Qnil);
if (NILP (name))
return name;
Lisp_Object args[4], result;
char *s;
ptrdiff_t len;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (BUFFERP (def))
def = BVAR (XBUFFER (def), name);
{
Lisp_Object bestmatch, tail, elt, eltstring;
/* Size in bytes of BESTMATCH. */
- int bestmatchsize = 0;
+ ptrdiff_t bestmatchsize = 0;
/* These are in bytes, too. */
- int compare, matchsize;
+ ptrdiff_t compare, matchsize;
enum { function_table, list_table, obarray_table, hash_table}
type = (HASH_TABLE_P (collection) ? hash_table
: VECTORP (collection) ? obarray_table
&& (!SYMBOLP (XCAR (collection))
|| NILP (XCAR (collection)))))
? list_table : function_table));
- EMACS_INT idx = 0, obsize = 0;
+ ptrdiff_t idx = 0, obsize = 0;
int matchcount = 0;
- int bindcount = -1;
+ ptrdiff_t bindcount = -1;
Lisp_Object bucket, zero, end, tem;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
{
collection = check_obarray (collection);
obsize = ASIZE (collection);
- bucket = XVECTOR (collection)->contents[idx];
+ bucket = AREF (collection, idx);
}
while (1)
break;
else
{
- bucket = XVECTOR (collection)->contents[idx];
+ bucket = AREF (collection, idx);
continue;
}
}
: NILP (collection) || (CONSP (collection)
&& (!SYMBOLP (XCAR (collection))
|| NILP (XCAR (collection))));
- EMACS_INT idx = 0, obsize = 0;
- int bindcount = -1;
+ ptrdiff_t idx = 0, obsize = 0;
+ ptrdiff_t bindcount = -1;
Lisp_Object bucket, tem, zero;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
{
collection = check_obarray (collection);
obsize = ASIZE (collection);
- bucket = XVECTOR (collection)->contents[idx];
+ bucket = AREF (collection, idx);
}
while (1)
break;
else
{
- bucket = XVECTOR (collection)->contents[idx];
+ bucket = AREF (collection, idx);
continue;
}
}
return Ffuncall (9, args);
}
\f
-Lisp_Object Fassoc_string (register Lisp_Object key, Lisp_Object list, Lisp_Object case_fold);
-
/* Test whether TXT is an exact completion. */
DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
doc: /* Return non-nil if STRING is a valid completion.
{
for (i = ASIZE (collection) - 1; i >= 0; i--)
{
- tail = XVECTOR (collection)->contents[i];
+ tail = AREF (collection, i);
if (SYMBOLP (tail))
while (1)
{
/* Reject this element if it fails to match all the regexps. */
if (CONSP (Vcompletion_regexp_list))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
for (regexps = Vcompletion_regexp_list; CONSP (regexps);
regexps = XCDR (regexps))
}
static Lisp_Object Qmetadata;
-extern Lisp_Object Qbuffer;
DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0,
doc: /* Perform completion on buffer names.
-If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
-`all-completions', otherwise invoke `test-completion'.
+STRING and PREDICATE have the same meanings as in `try-completion',
+`all-completions', and `test-completion'.
-The arguments STRING and PREDICATE are as in `try-completion',
-`all-completions', and `test-completion'. */)
+If FLAG is nil, invoke `try-completion'; if it is t, invoke
+`all-completions'; otherwise invoke `test-completion'. */)
(Lisp_Object string, Lisp_Object predicate, Lisp_Object flag)
{
if (NILP (flag))
staticpro (&last_minibuf_string);
last_minibuf_string = Qnil;
- DEFSYM (Quser_variable_p, "user-variable-p");
DEFSYM (Qminibuffer_history, "minibuffer-history");
DEFSYM (Qbuffer_name_history, "buffer-name-history");
Fset (Qbuffer_name_history, Qnil);
+ DEFSYM (Qcustom_variable_p, "custom-variable-p");
DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook");
DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook");
DEFSYM (Qhistory_length, "history-length");
#include <time.h>
#include <sys/param.h>
#include <sys/time.h>
+/* gettime and settime in dos.h clash with their namesakes from
+ gnulib, so we move out of our way the prototypes in dos.h. */
+#define gettime dos_h_gettime_
+#define settime dos_h_settime_
#include <dos.h>
+#undef gettime
+#undef settime
#include <errno.h>
#include <sys/stat.h> /* for _fixpath */
#include <unistd.h> /* for chdir, dup, dup2, etc. */
#endif /* not SYSTEM_MALLOC */
+/* Return the current timestamp in milliseconds since midnight. */
static unsigned long
event_timestamp (void)
{
- struct time t;
+ struct timespec t;
unsigned long s;
gettime (&t);
- s = t.ti_min;
- s *= 60;
- s += t.ti_sec;
+ s = t.tv_sec;
+ s %= 86400;
s *= 1000;
- s += t.ti_hund * 10;
+ s += t.tv_nsec * 1000000;
return s;
}
/* If the user specified a special video mode for these dimensions,
use that mode. */
- sprintf (video_name, "screen-dimensions-%dx%d", *rows, *cols);
- video_mode = Fsymbol_value (Fintern_soft (build_string (video_name), Qnil));
+ video_mode
+ = Fsymbol_value (Fintern_soft (make_formatted_string
+ (video_name, "screen-dimensions-%dx%d",
+ *rows, *cols), Qnil));
if (INTEGERP (video_mode)
&& (video_mode_value = XINT (video_mode)) > 0)
/* The default face for the frame should always be realized and
cached. */
if (!fp)
- abort ();
+ emacs_abort ();
}
screen_face = face;
fg = fp->foreground;
{
char *spaces, *sp;
int i, j, offset = 2 * (new_pos_X + screen_size_X * new_pos_Y);
- extern int fatal_error_in_progress;
struct tty_display_info *tty = FRAME_TTY (f);
if (new_pos_X >= first_unused || fatal_error_in_progress)
if (display_info->termscript)
fprintf (display_info->termscript, "\n\n<UPDATE_BEGIN");
- BLOCK_INPUT;
+ block_input ();
if (f && f == mouse_face_frame)
{
hlinfo->mouse_face_mouse_frame = NULL;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
static void
if (hlinfo->mouse_face_deferred_gc
|| (f && f == hlinfo->mouse_face_mouse_frame))
{
- BLOCK_INPUT;
+ block_input ();
if (hlinfo->mouse_face_mouse_frame)
note_mouse_highlight (hlinfo->mouse_face_mouse_frame,
hlinfo->mouse_face_mouse_x,
hlinfo->mouse_face_mouse_y);
hlinfo->mouse_face_deferred_gc = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Set the cursor type to whatever they wanted. In a minibuffer
static void
IT_delete_glyphs (struct frame *f, int n)
{
- abort ();
+ emacs_abort ();
}
/* set-window-configuration on window.c needs this. */
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;
/* Extract parm names and values into those vectors. */
i = 0;
- for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+ for (tail = alist; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object elt;
-
- elt = Fcar (tail);
+ Lisp_Object elt = XCAR (tail);
parms[i] = Fcar (elt);
CHECK_SYMBOL (parms[i]);
values[i] = Fcdr (elt);
}
tty = FRAME_TTY (sf);
- KVAR (current_kboard, Vwindow_system) = Qpc;
+ kset_window_system (current_kboard, Qpc);
sf->output_method = output_msdos_raw;
if (init_needed)
{
else
{
val = Fvector (NUM_RECENT_DOSKEYS, keys);
- memcpy (XVECTOR (val)->contents, keys + recent_doskeys_index,
- (NUM_RECENT_DOSKEYS - recent_doskeys_index) * sizeof (Lisp_Object));
- memcpy (XVECTOR (val)->contents + NUM_RECENT_DOSKEYS - recent_doskeys_index,
- keys, recent_doskeys_index * sizeof (Lisp_Object));
+ vcopy (val, 0, keys + recent_doskeys_index,
+ NUM_RECENT_DOSKEYS - recent_doskeys_index);
+ vcopy (val, NUM_RECENT_DOSKEYS - recent_doskeys_index,
+ keys, recent_doskeys_index);
return val;
}
}
sc = regs.h.ah;
total_doskeys += 2;
- XVECTOR (recent_doskeys)->contents[recent_doskeys_index++]
- = make_number (c);
+ ASET (recent_doskeys, recent_doskeys_index, make_number (c));
+ recent_doskeys_index++;
if (recent_doskeys_index == NUM_RECENT_DOSKEYS)
recent_doskeys_index = 0;
- XVECTOR (recent_doskeys)->contents[recent_doskeys_index++]
- = make_number (sc);
+ ASET (recent_doskeys, recent_doskeys_index, make_number (sc));
+ recent_doskeys_index++;
if (recent_doskeys_index == NUM_RECENT_DOSKEYS)
recent_doskeys_index = 0;
{
XMenu *menu;
- menu = (XMenu *) xmalloc (sizeof (XMenu));
+ menu = xmalloc (sizeof (XMenu));
menu->allocated = menu->count = menu->panecount = menu->width = 0;
return menu;
}
if (menu->allocated == 0)
{
int count = menu->allocated = 10;
- menu->text = (char **) xmalloc (count * sizeof (char *));
- menu->submenu = (XMenu **) xmalloc (count * sizeof (XMenu *));
- menu->panenumber = (int *) xmalloc (count * sizeof (int));
- menu->help_text = (const char **) xmalloc (count * sizeof (char *));
+ menu->text = xmalloc (count * sizeof (char *));
+ menu->submenu = xmalloc (count * sizeof (XMenu *));
+ menu->panenumber = xmalloc (count * sizeof (int));
+ menu->help_text = xmalloc (count * sizeof (char *));
}
else if (menu->allocated == menu->count)
{
width = menu->width;
/* We multiply width by 2 to account for possible control characters.
FIXME: cater to non-ASCII characters in menus. */
- text = (struct glyph *) xmalloc ((width * 2 + 2) * sizeof (struct glyph));
+ text = xmalloc ((width * 2 + 2) * sizeof (struct glyph));
ScreenGetCursor (&row, &col);
mouse_get_xy (&mx, &my);
IT_update_begin (sf);
const char *p;
if (!enable)
- abort ();
+ emacs_abort ();
IT_menu_make_room (menu);
menu->submenu[menu->count] = IT_menu_create ();
#ifndef HAVE_SELECT
#include "sysselect.h"
-#ifndef EMACS_TIME_ZERO_OR_NEG_P
-#define EMACS_TIME_ZERO_OR_NEG_P(time) \
- ((long)(time).tv_sec < 0 \
- || ((time).tv_sec == 0 \
- && (long)(time).tv_usec <= 0))
-#endif
-
/* This yields the rest of the current time slice to the task manager.
It should be called by any code which knows that it has nothing
useful to do except idle.
because wait_reading_process_output takes care of that. */
int
sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
- EMACS_TIME *timeout)
+ EMACS_TIME *timeout, void *ignored)
{
int check_input;
- struct time t;
+ struct timespec t;
check_input = 0;
if (rfds)
FD_ZERO (efds);
if (nfds != 1)
- abort ();
+ emacs_abort ();
/* If we are looking only for the terminal, with no timeout,
just read it and wait -- that's more efficient. */
EMACS_TIME clnow, cllast, cldiff;
gettime (&t);
- EMACS_SET_SECS_USECS (cllast, t.ti_sec, t.ti_hund * 10000L);
+ cllast = make_emacs_time (t.tv_sec, t.tv_nsec);
while (!check_input || !detect_input_pending ())
{
gettime (&t);
- EMACS_SET_SECS_USECS (clnow, t.ti_sec, t.ti_hund * 10000L);
- EMACS_SUB_TIME (cldiff, clnow, cllast);
-
- /* When seconds wrap around, we assume that no more than
- 1 minute passed since last `gettime'. */
- if (EMACS_TIME_NEG_P (cldiff))
- EMACS_SET_SECS (cldiff, EMACS_SECS (cldiff) + 60);
- EMACS_SUB_TIME (*timeout, *timeout, cldiff);
+ clnow = make_emacs_time (t.tv_sec, t.tv_nsec);
+ cldiff = sub_emacs_time (clnow, cllast);
+ *timeout = sub_emacs_time (*timeout, cldiff);
/* Stop when timeout value crosses zero. */
- if (EMACS_TIME_ZERO_OR_NEG_P (*timeout))
+ if (EMACS_TIME_SIGN (*timeout) <= 0)
return 0;
cllast = clnow;
dos_yield_time_slice ();
}
#endif
-#ifdef abort
-#undef abort
void
-dos_abort (char *file, int line)
-{
- char buffer1[200], buffer2[400];
- int i, j;
-
- sprintf (buffer1, "<EMACS FATAL ERROR IN %s LINE %d>", file, line);
- for (i = j = 0; buffer1[i]; i++) {
- buffer2[j++] = buffer1[i];
- buffer2[j++] = 0x70;
- }
- dosmemput (buffer2, j, (int)ScreenPrimary);
- ScreenSetCursor (2, 0);
- abort ();
-}
-#else
-void
-abort (void)
+emacs_abort (void)
{
dos_ttcooked ();
ScreenSetCursor (10, 0);
#endif /* __DJGPP_MINOR__ >= 2 */
exit (2);
}
-#endif
void
syms_of_msdos (void)
DEFSYM (Qreverse, "reverse");
DEFVAR_LISP ("dos-unsupported-char-glyph", Vdos_unsupported_char_glyph,
- doc: /* *Glyph to display instead of chars not supported by current codepage.
+ doc: /* Glyph to display instead of chars not supported by current codepage.
This variable is used only by MS-DOS terminals. */);
Vdos_unsupported_char_glyph = make_number ('\177');
+++ /dev/null
-### autodeps.mk --- src/Makefile fragment for GNU Emacs
-
-## Copyright (C) 2008-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 <http://www.gnu.org/licenses/>.
-
-### Commentary:
-
-## This is inserted in src/Makefile if HAVE_NS.
-
-## The only reason this is in a separate file is because $ns_appdir,
-## which appears as a target, is empty on non-NS builds. Some makes
-## do not like empty targets, even if they are never used.
-
-${ns_appdir}: ${ns_appsrc}
- rm -fr ${ns_appdir}
- mkdir -p ${ns_appdir}
- ( cd ${ns_appsrc} ; tar cfh - . ) | ( cd ${ns_appdir} ; umask 022; tar xf - )
-
-${ns_appbindir}Emacs: emacs${EXEEXT}
- mkdir -p ${ns_appbindir}
- cp -f emacs${EXEEXT} ${ns_appbindir}Emacs
-
-ns-app: ${ns_appdir} ${ns_appbindir}Emacs
-
-### ns.mk ends here
interpretation of even the system includes. */
#include <config.h>
-#include <signal.h>
#include <math.h>
-#include <setjmp.h>
+#include <c-strcase.h>
#include "lisp.h"
#include "blockinput.h"
#include "nsterm.h"
#include "window.h"
+#include "character.h"
#include "buffer.h"
#include "keyboard.h"
#include "termhooks.h"
#include "fontset.h"
-#include "character.h"
#include "font.h"
#if 0
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;
static Lisp_Object as_script, *as_result;
static int as_status;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static ptrdiff_t image_cache_refcount;
#endif
struct terminal *t = get_terminal (frame, 1);
if (t->type != output_ns)
- error ("Terminal %ld is not a Nextstep display", (long) XINT (frame));
+ error ("Terminal %"pI"d is not a Nextstep display", XINT (frame));
return t->display_info.ns;
}
else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
return;
- f->icon_name = arg;
+ fset_icon_name (f, arg);
if (NILP (arg))
{
if ([[view window] miniwindowTitle] &&
([[[view window] miniwindowTitle]
isEqualToString: [NSString stringWithUTF8String:
- SDATA (arg)]]))
+ SSDATA (arg)]]))
return;
[[view window] setMiniwindowTitle:
- [NSString stringWithUTF8String: SDATA (arg)]];
+ [NSString stringWithUTF8String: SSDATA (arg)]];
}
static void
encoded_name = ENCODE_UTF_8 (name);
UNGCPRO;
- str = [NSString stringWithUTF8String: SDATA (encoded_name)];
+ str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
/* Don't change the name if it's already NAME. */
if (! [[[view window] title] isEqualToString: str])
else
encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
- str = [NSString stringWithUTF8String: SDATA (encoded_icon_name)];
+ str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
if ([[view window] miniwindowTitle] &&
! [[[view window] miniwindowTitle] isEqualToString: str])
static void
ns_set_name (struct frame *f, Lisp_Object name, int explicit)
{
- NSView *view;
NSTRACE (ns_set_name);
if (ns_in_resize)
if (! NILP (Fstring_equal (name, f->name)))
return;
- f->name = name;
+ fset_name (f, name);
/* title overrides explicit name */
if (! NILP (f->title))
update_mode_lines = 1;
- f->title = name;
+ fset_title (f, name);
if (NILP (name))
name = f->name;
if (f->explicit_name || ! NILP (f->title) || ns_in_resize)
return;
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
filename = BVAR (XBUFFER (buf), filename);
name = BVAR (XBUFFER (buf), name);
title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
: [[[view window] title] UTF8String];
- if (title && (! strcmp (title, SDATA (encoded_name))))
+ if (title && (! strcmp (title, SSDATA (encoded_name))))
{
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
- str = [NSString stringWithUTF8String: SDATA (encoded_name)];
+ str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
if (str == nil) str = @"Bad coding";
if (FRAME_ICONIFIED_P (f))
encoded_filename = ENCODE_UTF_8 (filename);
UNGCPRO;
- fstr = [NSString stringWithUTF8String: SDATA (encoded_filename)];
+ fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
if (fstr == nil) fstr = @"";
#ifdef NS_IMPL_COCOA
/* work around a bug observed on 10.3 and later where
[[view window] setRepresentedFilename: fstr];
[[view window] setTitle: str];
- f->name = name;
+ fset_name (f, name);
}
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
NSAutoreleasePool *pool;
if (!MINI_WINDOW_P (XWINDOW (f->selected_window)))
{
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
[[view window] setDocumentEdited: !NILP (arg)];
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
int nlines;
- int olines = FRAME_MENU_BAR_LINES (f);
if (FRAME_MINIBUF_ONLY_P (f))
return;
- if (INTEGERP (value))
+ if (TYPE_RANGED_INTEGERP (int, value))
nlines = XINT (value);
else
nlines = 0;
x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
int nlines;
- Lisp_Object root_window;
if (FRAME_MINIBUF_ONLY_P (f))
return;
- if (INTEGERP (value) && XINT (value) >= 0)
+ if (RANGED_INTEGERP (0, value, INT_MAX))
nlines = XFASTINT (value);
else
nlines = 0;
NSTRACE (ns_implicitly_set_icon_type);
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
if (f->output_data.ns->miniimage
- && [[NSString stringWithUTF8String: SDATA (f->name)]
+ && [[NSString stringWithUTF8String: SSDATA (f->name)]
isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
{
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
if (CONSP (tem) && ! NILP (XCDR (tem)))
{
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
{
elt = XCAR (chain);
/* special case: 't' means go by file type */
- if (SYMBOLP (elt) && EQ (elt, Qt) && SDATA (f->name)[0] == '/')
+ if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
{
NSString *str
- = [NSString stringWithUTF8String: SDATA (f->name)];
+ = [NSString stringWithUTF8String: SSDATA (f->name)];
if ([[NSFileManager defaultManager] fileExistsAtPath: str])
image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
}
if (image == nil)
image = [[NSImage imageNamed:
[NSString stringWithUTF8String:
- SDATA (XCDR (elt))]] retain];
+ SSDATA (XCDR (elt))]] retain];
}
}
f->output_data.ns->miniimage = image;
[view setMiniwindowImage: setMini];
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (!NILP (arg) && SYMBOLP (arg))
{
- arg =build_string (SDATA (SYMBOL_NAME (arg)));
+ arg =build_string (SSDATA (SYMBOL_NAME (arg)));
store_frame_param (f, Qicon_type, arg);
}
image = [EmacsImage allocInitFromFile: arg];
if (image == nil)
image =[NSImage imageNamed: [NSString stringWithUTF8String:
- SDATA (arg)]];
+ SSDATA (arg)]];
if (image == nil)
{
}
-/* Xism; we stub out (we do implement this in ns-win.el) */
-int
-XParseGeometry (char *string, int *x, int *y,
- unsigned int *width, unsigned int *height)
-{
- message1 ("Warning: XParseGeometry not supported under NS.\n");
- return 0;
-}
-
-
/* TODO: move to nsterm? */
int
ns_lisp_to_cursor_type (Lisp_Object arg)
{
char *str;
if (XTYPE (arg) == Lisp_String)
- str = SDATA (arg);
+ str = SSDATA (arg);
else if (XTYPE (arg) == Lisp_Symbol)
- str = SDATA (SYMBOL_NAME (arg));
+ str = SSDATA (SYMBOL_NAME (arg));
else return -1;
if (!strcmp (str, "box")) return FILLED_BOX_CURSOR;
if (!strcmp (str, "hollow")) return HOLLOW_BOX_CURSOR;
/* If frame is ``official'', nothing to do. */
if (NILP (Fmemq (frame, Vframe_list)))
{
-#if GLYPH_DEBUG && XASSERTS
+#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
struct ns_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
#endif
x_free_frame_resources (f);
free_glyphs (f);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that reference counts are indeed correct. */
- xassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
+ eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
#endif
return Qt;
}
int minibuffer_only = 0;
int window_prompting = 0;
int width, height;
- int count = specpdl_ptr - specpdl;
+ ptrdiff_t count = specpdl_ptr - specpdl;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct ns_display_info *dpyinfo = NULL;
f->terminal = dpyinfo->terminal;
f->output_method = output_ns;
- f->output_data.ns = (struct ns_output *)xmalloc (sizeof *(f->output_data.ns));
- memset (f->output_data.ns, 0, sizeof *(f->output_data.ns));
+ f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
FRAME_FONTSET (f) = -1;
- f->icon_name = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
- RES_TYPE_STRING);
+ fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
+ "iconName", "Title",
+ RES_TYPE_STRING));
if (! STRINGP (f->icon_name))
- f->icon_name = Qnil;
+ fset_icon_name (f, Qnil);
FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
record_unwind_protect (unwind_create_frame, frame);
f->output_data.ns->window_desc = desc_ctr++;
- if (!NILP (parent))
+ if (TYPE_RANGED_INTEGERP (Window, parent))
{
- f->output_data.ns->parent_desc = (Window) XFASTINT (parent);
+ f->output_data.ns->parent_desc = XFASTINT (parent);
f->output_data.ns->explicit_parent = 1;
}
else
be set. */
if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
{
- f->name = build_string ([ns_app_name UTF8String]);
+ fset_name (f, build_string ([ns_app_name UTF8String]));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
specbind (Qx_resource_name, name);
}
f->resx = dpyinfo->resx;
f->resy = dpyinfo->resy;
- BLOCK_INPUT;
+ block_input ();
register_font_driver (&nsfont_driver, f);
x_default_parameter (f, parms, Qfont_backend, Qnil,
"fontBackend", "FontBackend", RES_TYPE_STRING);
build_string ([[font fontName] UTF8String]),
"font", "Font", RES_TYPE_STRING);
}
- UNBLOCK_INPUT;
+ unblock_input ();
x_default_parameter (f, parms, Qborder_width, make_number (0),
"borderwidth", "BorderWidth", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qright_fringe, Qnil,
"rightFringe", "RightFringe", RES_TYPE_NUMBER);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
#endif
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_default_minibuffer_frame (kb, 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))))
- f->param_alist = Fcons (XCAR (tem), f->param_alist);
+ fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
UNGCPRO;
+ if (window_prompting & USPosition)
+ x_set_offset (f, f->left_pos, f->top_pos, 1);
+
/* Make sure windows on this frame appear in calls to next-window
and similar functions. */
Vwindow_list = Qnil;
if (dpyinfo->x_focus_frame != f)
{
EmacsView *view = FRAME_NS_VIEW (f);
- BLOCK_INPUT;
+ block_input ();
[NSApp activateIgnoringOtherApps: YES];
[[view window] makeKeyAndOrderFront: view];
- UNBLOCK_INPUT;
+ unblock_input ();
}
return Qnil;
Lisp_Object fname;
NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
- [NSString stringWithUTF8String: SDATA (prompt)];
+ [NSString stringWithUTF8String: SSDATA (prompt)];
NSString *dirS = NILP (dir) || !STRINGP (dir) ?
- [NSString stringWithUTF8String: SDATA (BVAR (current_buffer, directory))] :
- [NSString stringWithUTF8String: SDATA (dir)];
+ [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
+ [NSString stringWithUTF8String: SSDATA (dir)];
NSString *initS = NILP (init) || !STRINGP (init) ? nil :
- [NSString stringWithUTF8String: SDATA (init)];
+ [NSString stringWithUTF8String: SSDATA (init)];
check_ns ();
[panel setDelegate: fileDelegate];
panelOK = 0;
- BLOCK_INPUT;
+ block_input ();
if (NILP (mustmatch))
{
ret = [panel runModalForDirectory: dirS file: initS];
fname = build_string ([[panel filename] UTF8String]);
[[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
- UNBLOCK_INPUT;
+ unblock_input ();
return ret ? fname : Qnil;
}
if (NILP (owner))
owner = build_string([ns_app_name UTF8String]);
CHECK_STRING (name);
-/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SDATA (name)); */
+/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SSDATA (name)); */
- value = ns_get_defaults_value (SDATA (name));
+ value = ns_get_defaults_value (SSDATA (name));
if (value)
return build_string (value);
if (NILP (value))
{
[[NSUserDefaults standardUserDefaults] removeObjectForKey:
- [NSString stringWithUTF8String: SDATA (name)]];
+ [NSString stringWithUTF8String: SSDATA (name)]];
}
else
{
CHECK_STRING (value);
[[NSUserDefaults standardUserDefaults] setObject:
- [NSString stringWithUTF8String: SDATA (value)]
+ [NSString stringWithUTF8String: SSDATA (value)]
forKey: [NSString stringWithUTF8String:
- SDATA (name)]];
+ SSDATA (name)]];
}
return Qnil;
{
if (!NILP (must_succeed))
fatal ("OpenStep on %s not responding.\n",
- SDATA (display));
+ SSDATA (display));
else
error ("OpenStep on %s not responding.\n",
- SDATA (display));
+ SSDATA (display));
}
- /* Register our external input/output types, used for determining
- applicable services and also drag/drop eligibility. */
- ns_send_types = [[NSArray arrayWithObjects: NSStringPboardType, nil] retain];
- ns_return_types = [[NSArray arrayWithObjects: NSStringPboardType, nil]
- retain];
- ns_drag_types = [[NSArray arrayWithObjects:
- NSStringPboardType,
- NSTabularTextPboardType,
- NSFilenamesPboardType,
- NSURLPboardType,
- NSColorPboardType,
- NSFontPboardType, nil] retain];
-
return Qnil;
}
{
char *nm;
CHECK_STRING (name);
- nm = SDATA (name);
+ nm = SSDATA (name);
if (nm[0] != '-')
return name;
if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
return name;
- return build_string (ns_xlfd_to_fontname (SDATA (name)));
+ return build_string (ns_xlfd_to_fontname (SSDATA (name)));
}
error ("non-Nextstep frame used in `ns-list-colors'");
}
- BLOCK_INPUT;
+ block_input ();
colorlists = [[NSColorList availableColorLists] objectEnumerator];
- while (clist = [colorlists nextObject])
+ while ((clist = [colorlists nextObject]))
{
if ([[clist name] length] < 7 ||
[[clist name] rangeOfString: @"PANTONE"].location == 0)
{
NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
NSString *cname;
- while (cname = [cnames nextObject])
+ while ((cname = [cnames nextObject]))
list = Fcons (build_string ([cname UTF8String]), list);
/* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return list;
}
id pb;
NSString *svcName;
char *utfStr;
- int len;
CHECK_STRING (service);
check_ns ();
- utfStr = SDATA (service);
+ utfStr = SSDATA (service);
svcName = [NSString stringWithUTF8String: utfStr];
pb =[NSPasteboard pasteboardWithUniqueName];
NSString *utfStr;
CHECK_STRING (str);
- utfStr = [NSString stringWithUTF8String: SDATA (str)];
+ utfStr = [NSString stringWithUTF8String: SSDATA (str)];
if (![utfStr respondsToSelector:
@selector (precomposedStringWithCanonicalMapping)])
{
NSAppleScript* scriptObject =
[[NSAppleScript alloc] initWithSource:
- [NSString stringWithUTF8String: SDATA (script)]];
+ [NSString stringWithUTF8String: SSDATA (script)]];
returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
[scriptObject release];
CHECK_STRING (script);
check_ns ();
- BLOCK_INPUT;
+ block_input ();
as_script = script;
as_result = &result;
as_status = 0;
as_script = Qnil;
as_result = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
if (status == 0)
return result;
else if (!STRINGP (result))
error ("AppleScript error %d", status);
else
- error ("%s", SDATA (result));
+ error ("%s", SSDATA (result));
}
#endif
res = ns_get_defaults_value (toCheck);
return !res ? NULL :
- (!strncasecmp (res, "YES", 3) ? "true" :
- (!strncasecmp (res, "NO", 2) ? "false" : res));
+ (!c_strncasecmp (res, "YES", 3) ? "true" :
+ (!c_strncasecmp (res, "NO", 2) ? "false" : res));
}
that stands for the selected frame's display. */)
(Lisp_Object display)
{
- int top;
NSScreen *screen;
NSRect vScreen;
{
int root_x, root_y;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct frame *f;
char *str;
NSSize size;
GCPRO4 (string, parms, frame, timeout);
CHECK_STRING (string);
- str = SDATA (string);
+ str = SSDATA (string);
f = check_x_frame (frame);
if (NILP (timeout))
timeout = make_number (5);
else
CHECK_NUMBER (dy);
- BLOCK_INPUT;
+ block_input ();
if (ns_tooltip == nil)
ns_tooltip = [[EmacsTooltip alloc] init];
else
&root_x, &root_y);
[ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
- UNBLOCK_INPUT;
+ unblock_input ();
UNGCPRO;
return unbind_to (count, Qnil);
void
syms_of_nsfns (void)
{
- int i;
-
Qfontsize = intern_c_string ("fontsize");
staticpro (&Qfontsize);
/* This should be the first include, as it may set up #defines affecting
interpretation of even the system includes. */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "dispextern.h"
return nil;
else
{
- char *tmp = xstrdup (SDATA (SYMBOL_NAME (tem)));
+ char *tmp = xstrdup (SSDATA (SYMBOL_NAME (tem)));
NSString *family;
ns_unescape_name (tmp);
family = [NSString stringWithUTF8String: tmp];
[fdAttrs setObject: tdict forKey: NSFontTraitsAttribute];
fdesc = [NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs];
- if (family != nil)
+ if (family != nil)
{
fdesc = [fdesc fontDescriptorWithFamily: family];
}
}
-/* Utility: get width of a char c in screen font sfont */
+/* Utility: get width of a char c in screen font SFONT */
static float
ns_char_width (NSFont *sfont, int c)
{
- float w;
- NSString *cstr = [NSString stringWithFormat: @"%c", c];
+ float w = -1.0;
+ NSString *cstr = [NSString stringWithFormat: @"%c", c];
+
#ifdef NS_IMPL_COCOA
- NSGlyph glyph = [sfont glyphWithName: cstr];
- if (glyph)
- {
- float w = [sfont advancementForGlyph: glyph].width;
- if (w >= 1.5)
- return w;
- }
+ NSGlyph glyph = [sfont glyphWithName: cstr];
+ if (glyph)
+ w = [sfont advancementForGlyph: glyph].width;
#endif
+
+ if (w < 0.0)
{
NSDictionary *attrsDictionary =
[NSDictionary dictionaryWithObject: sfont forKey: NSFontAttributeName];
w = [cstr sizeWithAttributes: attrsDictionary].width;
}
- return max (w, 2.0);
+
+ return max (w, 1.0);
+}
+
+/* Return average width over ASCII printable characters for SFONT. */
+
+static NSString *ascii_printable;
+
+static int
+ns_ascii_average_width (NSFont *sfont)
+{
+ float w = -1.0;
+
+ if (!ascii_printable)
+ {
+ char chars[96];
+ int ch;
+ for (ch = 0; ch < 95; ch++)
+ chars[ch] = ' ' + ch;
+ chars[95] = '\0';
+
+ ascii_printable = [[NSString alloc] initWithFormat: @"%s", chars];
+ }
+
+#ifdef NS_IMPL_COCOA
+ NSGlyph glyph = [sfont glyphWithName: ascii_printable];
+ if (glyph)
+ w = [sfont advancementForGlyph: glyph].width;
+#endif
+
+ if (w < 0.0)
+ {
+ NSDictionary *attrsDictionary =
+ [NSDictionary dictionaryWithObject: sfont forKey: NSFontAttributeName];
+ w = [ascii_printable sizeWithAttributes: attrsDictionary].width;
+ }
+
+ return lrint (w / 95.0);
}
const unsigned short *bytes2 = [[set2 bitmapRepresentation] bytes];
int i, off = 0, tot = 0;
+ /* Work around what appears to be a GNUstep bug.
+ See <http://bugs.gnu.org/11853>. */
+ if (! (bytes1 && bytes2))
+ return NO;
+
for (i=0; i<4096; i++, bytes1++, bytes2++)
if (*bytes2)
{
static NSString
*ns_lang_to_script (Lisp_Object lang)
{
- if (!strcmp (SDATA (SYMBOL_NAME (lang)), "ja"))
+ if (!strcmp (SSDATA (SYMBOL_NAME (lang)), "ja"))
return @"han";
/* NOTE: ja given for any hanzi that's also a kanji, but Chinese fonts
have more characters. */
- else if (!strcmp (SDATA (SYMBOL_NAME (lang)), "zh"))
+ else if (!strcmp (SSDATA (SYMBOL_NAME (lang)), "zh"))
return @"han";
- else if (!strcmp (SDATA (SYMBOL_NAME (lang)), "ko"))
+ else if (!strcmp (SSDATA (SYMBOL_NAME (lang)), "ko"))
return @"hangul";
else
return @"";
{
Lisp_Object script = assq_no_quit (XCAR (otf), Votf_script_alist);
return CONSP (script)
- ? [NSString stringWithUTF8String: SDATA (SYMBOL_NAME (XCDR ((script))))]
+ ? [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (XCDR ((script))))]
: @"";
}
while CONSP (rts)
{
r = XCAR (XCAR (rts));
- if (!strncmp(SDATA(r), reg, strlen(SDATA(r))))
+ if (!strncmp(SSDATA(r), reg, strlen(SSDATA(r))))
{
script = XCDR (XCAR (rts));
- return [NSString stringWithUTF8String: SDATA (SYMBOL_NAME (script))];
+ return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (script))];
}
rts = XCDR (rts);
}
Lisp_Object key = XCAR (tmp), val = XCDR (tmp);
if (EQ (key, QCscript) && SYMBOLP (val))
return [NSString stringWithUTF8String:
- SDATA (SYMBOL_NAME (val))];
+ SSDATA (SYMBOL_NAME (val))];
if (EQ (key, QClang) && SYMBOLP (val))
return ns_lang_to_script (val);
if (EQ (key, QCotf) && CONSP (val) && SYMBOLP (XCAR (val)))
if (EQ (reg, Qiso10646_1))
reg = Qiso8859_1;
#endif
- return ns_registry_to_script (SDATA (SYMBOL_NAME (reg)));
+ return ns_registry_to_script (SSDATA (SYMBOL_NAME (reg)));
}
return @"";
while (1)
{
NSEnumerator *allFamiliesEnum = [allFamilies objectEnumerator];
- while (family = [allFamiliesEnum nextObject])
+ while ((family = [allFamiliesEnum nextObject]))
{
NSCharacterSet *fset = [[fontMgr fontWithFamily: family
traits: 0 weight: 5 size: 12.0] coveredCharacterSet];
NSLog(@"Got desc %@ and found %d matching fonts from it: ", fdesc,
[matchingDescs count]);
- for (dEnum = [matchingDescs objectEnumerator]; desc = [dEnum nextObject]; )
+ for (dEnum = [matchingDescs objectEnumerator]; (desc = [dEnum nextObject]);)
{
if (![cFamilies containsObject:
[desc objectForKey: NSFontFamilyAttribute]])
return ns_fallback_entity ();
if (NSFONT_TRACE)
- fprintf (stderr, " Returning %ld entities.\n",
- (long) XINT (Flength (list)));
+ fprintf (stderr, " Returning %"pI"d entities.\n",
+ XINT (Flength (list)));
return list;
}
static int nsfont_text_extents (struct font *font, unsigned int *code,
int nglyphs, struct font_metrics *metrics);
static int nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
- int with_background);
+ bool with_background);
struct font_driver nsfont_driver =
{
[[[NSFontManager sharedFontManager] availableFontFamilies]
objectEnumerator];
NSString *family;
- while (family = [families nextObject])
+ while ((family = [families nextObject]))
list = Fcons (intern ([family UTF8String]), list);
/* FIXME: escape the name? */
if (NSFONT_TRACE)
- fprintf (stderr, "nsfont: list families returning %ld entries\n",
- (long) XINT (Flength (list)));
+ fprintf (stderr, "nsfont: list families returning %"pI"d entries\n",
+ XINT (Flength (list)));
return list;
}
Lisp_Object tem;
NSRect brect;
Lisp_Object font_object;
- int i;
int fixLeopardBug;
static NSMutableDictionary *fontCache = nil;
NSNumber *cached;
}
tem = AREF (font_entity, FONT_ADSTYLE_INDEX);
- synthItal = !NILP (tem) && !strncmp ("synthItal", SDATA (SYMBOL_NAME (tem)),
+ synthItal = !NILP (tem) && !strncmp ("synthItal", SSDATA (SYMBOL_NAME (tem)),
9);
family = ns_get_family (font_entity);
if (family == nil)
if (!font)
return Qnil; /* FIXME: other terms do, but return Qnil causes segfault */
- font_info->glyphs = (unsigned short **)
- xmalloc (0x100 * sizeof (unsigned short *));
- font_info->metrics = (struct font_metrics **)
- xmalloc (0x100 * sizeof (struct font_metrics *));
- if (!font_info->glyphs || !font_info->metrics)
- return Qnil;
- memset (font_info->glyphs, 0, 0x100 * sizeof (unsigned short *));
- memset (font_info->metrics, 0, 0x100 * sizeof (struct font_metrics *));
+ font_info->glyphs = xzalloc (0x100 * sizeof *font_info->glyphs);
+ font_info->metrics = xzalloc (0x100 * sizeof *font_info->metrics);
- BLOCK_INPUT;
+ block_input ();
/* for metrics */
sfont = [nsfont screenFont];
font = (struct font *) font_info;
font->pixel_size = [sfont pointSize];
font->driver = &nsfont_driver;
- font->encoding_type = FONT_ENCODING_NOT_DECIDED;
font->encoding_charset = -1;
font->repertory_charset = -1;
font->default_ascent = 0;
{
const char *fontName = [[nsfont fontName] UTF8String];
- int len = strlen (fontName);
/* The values specified by fonts are not always exact. For
* example, a 6x8 font could specify that the descender is
[font_info->nsfont retain];
/* set up ns_font (defined in nsgui.h) */
- font_info->name = (char *)xmalloc (strlen (fontName)+1);
- strcpy (font_info->name, fontName);
+ font_info->name = xstrdup (fontName);
font_info->bold = [fontMgr traitsOfFont: nsfont] & NSBoldFontMask;
font_info->ital =
synthItal || ([fontMgr traitsOfFont: nsfont] & NSItalicFontMask);
/* set up metrics portion of font struct */
font->ascent = lrint([sfont ascender]);
font->descent = -lrint(floor(adjusted_descender));
- font->min_width = ns_char_width(sfont, '|');
font->space_width = lrint (ns_char_width (sfont, ' '));
- font->average_width = lrint (font_info->width);
font->max_width = lrint (font_info->max_bounds.width);
+ font->min_width = font->space_width; /* Approximate. */
+ font->average_width = ns_ascii_average_width (sfont);
+
font->height = lrint (font_info->height);
font->underline_position = lrint (font_info->underpos);
font->underline_thickness = lrint (font_info->underwidth);
font->props[FONT_FULLNAME_INDEX] =
make_unibyte_string (font_info->name, strlen (font_info->name));
}
- UNBLOCK_INPUT;
+ unblock_input ();
return font_object;
}
/* Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
- position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
- is nonzero, fill the background in advance. It is assured that
- WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars). */
+ position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
+ fill the background in advance. It is assured that WITH_BACKGROUND
+ is false when (FROM > 0 || TO < S->nchars). */
static int
nsfont_draw (struct glyph_string *s, int from, int to, int x, int y,
- int with_background)
+ bool with_background)
/* NOTE: focus and clip must be set
also, currently assumed (true in nsterm.m call) from ==0, to ==nchars */
{
NS to render the string, it will come out differently from the individual
character widths added up because of layout processing. */
{
- XCharStruct *cs;
int cwidth, twidth = 0;
int hi, lo;
/* FIXME: composition: no vertical displacement is considered. */
fprintf (stderr, "%p\tFinding glyphs for glyphs in block %d\n",
font_info, block);
- BLOCK_INPUT;
+ block_input ();
#ifdef NS_IMPL_COCOA
if (firstTime)
font_info->glyphs[block] = xmalloc (0x100 * sizeof (unsigned short));
if (!unichars || !(font_info->glyphs[block]))
- abort ();
+ emacs_abort ();
/* create a string containing all Unicode characters in this block */
for (idx = block<<8, i = 0; i < 0x100; idx++, i++)
#endif
}
- UNBLOCK_INPUT;
+ unblock_input ();
xfree (unichars);
}
numGlyphs = 0x10000;
#endif
- BLOCK_INPUT;
+ block_input ();
sfont = [font_info->nsfont screenFont];
- font_info->metrics[block] = xmalloc (0x100 * sizeof (struct font_metrics));
- memset (font_info->metrics[block], 0, 0x100 * sizeof (struct font_metrics));
+ font_info->metrics[block] = xzalloc (0x100 * sizeof (struct font_metrics));
if (!(font_info->metrics[block]))
- abort ();
+ emacs_abort ();
metrics = font_info->metrics[block];
for (g = block<<8, i =0; i<0x100 && g < numGlyphs; g++, i++, metrics++)
metrics->ascent = r.size.height - metrics->descent;
/*-lrint (hshrink* [sfont descender] - expand * hd/2); */
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
maxChar = 0;
maxGlyph = 0;
dict = [NSMutableDictionary new];
- cglyphs = (CGGlyph *)xmalloc (c * sizeof (CGGlyph));
+ cglyphs = xmalloc (c * sizeof (CGGlyph));
return self;
}
DEFSYM (Qmedium, "medium");
DEFVAR_LISP ("ns-reg-to-script", Vns_reg_to_script,
doc: /* Internal use: maps font registry to Unicode script. */);
+
+ ascii_printable = NULL;
}
#warning "Z is defined. If you get a later parse error in a header, check that buffer.h or other files #define-ing Z are not included."
#endif /* Z */
#define Cursor FooFoo
-#undef init_process
#endif /* NS_IMPL_COCOA */
#undef verify
#ifdef NS_IMPL_COCOA
#undef Cursor
-#define init_process emacs_init_process
#endif /* NS_IMPL_COCOA */
#import <Foundation/NSDistantObject.h>
/* This should be the first include, as it may set up #defines affecting
interpretation of even the system includes. */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "dispextern.h"
return [EmacsImage allocInitFromFile: file];
}
-int
+bool
ns_load_image (struct frame *f, struct image *img,
Lisp_Object spec_file, Lisp_Object spec_data)
{
{
NSData *data;
- data = [NSData dataWithBytes: SDATA (spec_data)
+ data = [NSData dataWithBytes: SSDATA (spec_data)
length: SBYTES (spec_data)];
eImg = [[EmacsImage alloc] initWithData: data];
[eImg setPixmapData];
/* look for an existing image of the same name */
while (image != nil &&
- [[image name] compare: [NSString stringWithUTF8String: SDATA (file)]]
+ [[image name] compare: [NSString stringWithUTF8String: SSDATA (file)]]
!= NSOrderedSame)
image = [image imageListNext];
return nil;
image = [[EmacsImage alloc] initByReferencingFile:
- [NSString stringWithUTF8String: SDATA (found)]];
+ [NSString stringWithUTF8String: SSDATA (found)]];
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
imgRep = [NSBitmapImageRep imageRepWithData:[image TIFFRepresentation]];
[image setScalesWhenResized: YES];
[image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])];
- [image setName: [NSString stringWithUTF8String: SDATA (file)]];
+ [image setName: [NSString stringWithUTF8String: SSDATA (file)]];
[image reference];
ImageList = [image imageListSetNext: ImageList];
[bmRep release];
return nil;
}
-#define hexchar(x) (isdigit (x) ? x - '0' : x - 'a' + 10)
+#define hexchar(x) ('0' <= (x) && (x) <= '9' ? (x) - '0' : (x) - 'a' + 10)
s1 = *s++;
s2 = *s++;
c = hexchar (s1) * 0x10 + hexchar (s2);
- setXBMColor: (NSColor *)color
{
NSSize s = [self size];
- int len = (int) s.width * s.height;
unsigned char *planes[5];
CGFloat r, g, b, a;
NSColor *rgbColor;
NSImageRep *rep;
reps = [[self representations] objectEnumerator];
- while (rep = (NSImageRep *) [reps nextObject])
+ while ((rep = (NSImageRep *) [reps nextObject]))
{
if ([rep respondsToSelector: @selector (getBitmapDataPlanes:)])
{
}
@end
-
/* This should be the first include, as it may set up #defines affecting
interpretation of even the system includes. */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "window.h"
+#include "character.h"
#include "buffer.h"
#include "keymap.h"
#include "coding.h"
/* 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;
/* --------------------------------------------------------------------------
Update menubar. Three cases:
- 1) deep_p = 0, submenu = nil: Fresh switch onto a frame -- either set up
+ 1) ! deep_p, submenu = nil: Fresh switch onto a frame -- either set up
just top-level menu strings (OS X), or goto case (2) (GNUstep).
- 2) deep_p = 1, submenu = nil: Recompute all submenus.
- 3) deep_p = 1, submenu = non-nil: Update contents of a single submenu.
+ 2) deep_p, submenu = nil: Recompute all submenus.
+ 3) deep_p, submenu = non-nil: Update contents of a single submenu.
-------------------------------------------------------------------------- */
void
-ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu)
+ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
{
NSAutoreleasePool *pool;
id menu = [NSApp mainMenu];
XSETFRAME (Vmenu_updating_frame, f);
/*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
/* Menu may have been created automatically; if so, discard it. */
int *submenu_top_level_items, *submenu_n_panes;
struct buffer *prev = current_buffer;
Lisp_Object buffer;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
int previous_menu_items_used = f->menu_bar_items_used;
Lisp_Object *previous_items
- = (Lisp_Object *) alloca (previous_menu_items_used
- * sizeof (Lisp_Object));
+ = alloca (previous_menu_items_used * sizeof *previous_items);
/* lisp preliminaries */
buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
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_menu_bar_items (f, 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 (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 */
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 *));
- submenu_n_panes = (int *) alloca (ASIZE (items) * sizeof (int));
- submenu_top_level_items
- = (int *) alloca (ASIZE (items) * sizeof (int *));
+ submenu_start = alloca (ASIZE (items) * sizeof *submenu_start);
+ submenu_end = alloca (ASIZE (items) * sizeof *submenu_end);
+ submenu_n_panes = alloca (ASIZE (items) * sizeof *submenu_n_panes);
+ submenu_top_level_items = alloca (ASIZE (items)
+ * sizeof *submenu_top_level_items);
init_menu_items ();
for (i = 0; i < ASIZE (items); i += 4)
{
/* FIXME: we'd like to only parse the needed submenu, but this
was causing crashes in the _common parsing code.. need to make
sure proper initialization done.. */
-/* if (submenu && strcmp (submenuTitle, SDATA (string)))
+/* if (submenu && strcmp (submenuTitle, SSDATA (string)))
continue; */
submenu_start[i] = menu_items_used;
discard_menu_items ();
unbind_to (specpdl_count, Qnil);
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
if (!EQ (previous_items[i], AREF (menu_items, i)))
if (!(STRINGP (previous_items[i])
&& STRINGP (AREF (menu_items, i))
- && !strcmp (SDATA (previous_items[i]),
- SDATA (AREF (menu_items, i)))))
+ && !strcmp (SSDATA (previous_items[i]),
+ SSDATA (AREF (menu_items, i)))))
break;
if (i == previous_menu_items_used)
{
discard_menu_items ();
unbind_to (specpdl_count, Qnil);
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
}
/* The menu items are different, so store them in the frame */
/* FIXME: this is not correct for single-submenu case */
- f->menu_bar_vector = menu_items;
+ fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
/* Calls restore_menu_items, etc., as they were outside */
string = AREF (items, i + 1);
if (NILP (string))
break;
-/* if (submenu && strcmp (submenuTitle, SDATA (string)))
+/* if (submenu && strcmp (submenuTitle, SSDATA (string)))
continue; */
wv->name = SSDATA (string);
{
free_menubar_widget_value_tree (first_wv);
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
else
continue;
}
- else if (strncmp (previous_strings[i], SDATA (string), 10))
+ else if (memcmp (previous_strings[i], SDATA (string),
+ min (10, SBYTES (string) + 1)))
break;
}
{
free_menubar_widget_value_tree (first_wv);
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
}
break;
if (n < 100)
- strncpy (previous_strings[i/4], SDATA (string), 10);
+ memcpy (previous_strings[i/4], SDATA (string),
+ min (10, SBYTES (string) + 1));
wv = xmalloc_widget_value ();
wv->name = SSDATA (string);
wv->enabled = 1;
wv->button_type = BUTTON_TYPE_NONE;
wv->help = Qnil;
- wv->call_data = (void *) (EMACS_INT) (-1);
+ wv->call_data = (void *) (intptr_t) (-1);
#ifdef NS_IMPL_COCOA
/* we'll update the real copy under app menu when time comes */
[NSApp setMainMenu: menu];
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
frame's menus have changed, and the *step representation should be updated
from Lisp. */
void
-set_frame_menubar (struct frame *f, int first_time, int deep_p)
+set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
{
ns_update_menubar (f, deep_p, nil);
}
/* override designated initializer */
- initWithTitle: (NSString *)title
{
- if (self = [super initWithTitle: title])
+ if ((self = [super initWithTitle: title]))
[self setAutoenablesItems: NO];
return self;
}
From 10.6 on, we could also use -[NSMenu propertiesToUpdate]: In the
key press case, NSMenuPropertyItemImage (e.g.) won't be set.
*/
- if (trackingMenu == 0
- /* Also, don't try this if from an event picked up asynchronously,
- as lots of lisp evaluation happens in ns_update_menubar. */
- || handling_signal != 0)
+ if (trackingMenu == 0)
return;
/*fprintf (stderr, "Updating menu '%s'\n", [[self title] UTF8String]); NSLog (@"%@\n", event); */
ns_update_menubar (frame, 1, self);
{
EmacsMenu *pmenu;
NSPoint p;
- Lisp_Object window, tem, keymap;
- int specpdl_count = SPECPDL_INDEX ();
+ Lisp_Object tem;
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
widget_value *wv, *first_wv = 0;
p.x = x; p.y = y;
{
widget_value *save_wv = 0, *prev_wv = 0;
widget_value **submenu_stack
- = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
+ = alloca (menu_items_used * sizeof *submenu_stack);
/* Lisp_Object *subprefix_stack
- = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object)); */
+ = alloca (menu_items_used * sizeof *subprefix_stack); */
int submenu_depth = 0;
int first_pane = 1;
int i;
/* 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))
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else
- abort ();
+ emacs_abort ();
wv->selected = !NILP (selected);
}
pmenu = [[EmacsMenu alloc] initWithTitle:
- [NSString stringWithUTF8String: SDATA (title)]];
+ [NSString stringWithUTF8String: SSDATA (title)]];
[pmenu fillWithWidgetValue: first_wv->contents];
free_menubar_widget_value_tree (first_wv);
unbind_to (specpdl_count, Qnil);
Under NS we just hide the toolbar until it might be needed again.
-------------------------------------------------------------------------- */
{
- BLOCK_INPUT;
+ block_input ();
[[FRAME_NS_VIEW (f) toolbar] setVisible: NO];
FRAME_TOOLBAR_HEIGHT (f) = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
void
NSWindow *window = [view window];
EmacsToolbar *toolbar = [view toolbar];
- BLOCK_INPUT;
+ block_input ();
[toolbar clearActive];
/* update EmacsToolbar as in GtkUtils, build items list */
i * TOOL_BAR_ITEM_NSLOTS + (IDX))
BOOL enabled_p = !NILP (TOOLPROP (TOOL_BAR_ITEM_ENABLED_P));
- BOOL selected_p = !NILP (TOOLPROP (TOOL_BAR_ITEM_SELECTED_P));
int idx;
ptrdiff_t img_id;
struct image *img;
{
/* NS toolbar auto-computes disabled and selected images */
idx = TOOL_BAR_IMAGE_ENABLED_SELECTED;
- xassert (ASIZE (image) >= idx);
+ eassert (ASIZE (image) >= idx);
image = AREF (image, idx);
}
else
NSDictionary *dict = [toolbar configurationDictionary];
NSMutableDictionary *newDict = [dict mutableCopy];
NSEnumerator *keys = [[dict allKeys] objectEnumerator];
- NSObject *key;
+ id key;
while ((key = [keys nextObject]) != nil)
{
NSObject *val = [dict objectForKey: key];
FRAME_TOOLBAR_HEIGHT (f) =
NSHeight ([window frameRectForContentRect: NSMakeRect (0, 0, 0, 0)])
- FRAME_NS_TITLEBAR_HEIGHT (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
struct Popdown_data *unwind_data = (struct Popdown_data *) p->pointer;
- BLOCK_INPUT;
+ block_input ();
if (popup_activated_flag)
{
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];
}
xfree (unwind_data);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
the dialog. */
contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil));
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
dialog = [[EmacsDialogPanel alloc] initFromContents: contents
isQuestion: isQ];
+
{
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
struct Popdown_data *unwind_data = xmalloc (sizeof (*unwind_data));
unwind_data->pool = pool;
tem = [dialog runDialogAt: p];
unbind_to (specpdl_count, Qnil); /* calls pop_down_menu */
}
- UNBLOCK_INPUT;
+
+ unblock_input ();
return tem;
}
{
NSSize spacing = {SPACER, SPACER};
NSRect area;
- char this_cmd_name[80];
id cell;
NSImageView *imgView;
FlippedView *contentView;
NSImage *img;
+ dialog_return = Qundefined;
+ button_values = NULL;
area.origin.x = 3*SPACER;
area.origin.y = 2*SPACER;
area.size.width = ICONSIZE;
prototype: cell
numberOfRows: 0
numberOfColumns: 1];
- [[self contentView] addSubview: matrix];
- [matrix autorelease];
[matrix setFrameOrigin: NSMakePoint (area.origin.x,
area.origin.y + (TEXTHEIGHT+3*SPACER))];
[matrix setIntercellSpacing: spacing];
+ [matrix autorelease];
+ [[self contentView] addSubview: matrix];
[self setOneShot: YES];
[self setReleasedWhenClosed: YES];
[self setHidesOnDeactivate: YES];
+ [self setStyleMask:
+ NSTitledWindowMask|NSClosableWindowMask|NSUtilityWindowMask];
+
return self;
}
- (BOOL)windowShouldClose: (id)sender
{
- [NSApp stopModalWithCode: XHASH (Qnil)]; // FIXME: BIG UGLY HACK!!
+ window_closed = YES;
+ [NSApp stop:self];
return NO;
}
+- (void)dealloc
+{
+ xfree (button_values);
+ [super dealloc];
+}
-void process_dialog (id window, Lisp_Object list)
+- (void)process_dialog: (Lisp_Object) list
{
- Lisp_Object item;
+ Lisp_Object item, lst = list;
int row = 0;
+ int buttons = 0, btnnr = 0;
+
+ for (; XTYPE (lst) == Lisp_Cons; lst = XCDR (lst))
+ {
+ item = XCAR (list);
+ if (XTYPE (item) == Lisp_Cons)
+ ++buttons;
+ }
+
+ if (buttons > 0)
+ button_values = (Lisp_Object *) xmalloc (buttons * sizeof (*button_values));
for (; XTYPE (list) == Lisp_Cons; list = XCDR (list))
{
item = XCAR (list);
if (XTYPE (item) == Lisp_String)
{
- [window addString: SDATA (item) row: row++];
+ [self addString: SSDATA (item) row: row++];
}
else if (XTYPE (item) == Lisp_Cons)
{
- [window addButton: SDATA (XCAR (item))
- value: XCDR (item) row: row++];
+ button_values[btnnr] = XCDR (item);
+ [self addButton: SSDATA (XCAR (item)) value: btnnr row: row++];
+ ++btnnr;
}
else if (NILP (item))
{
- [window addSplit];
+ [self addSplit];
row = 0;
}
}
}
-- addButton: (char *)str value: (Lisp_Object)val row: (int)row
+- (void)addButton: (char *)str value: (int)tag row: (int)row
{
id cell;
[cell setTarget: self];
[cell setAction: @selector (clicked: )];
[cell setTitle: [NSString stringWithUTF8String: str]];
- [cell setTag: XHASH (val)]; // FIXME: BIG UGLY HACK!!
+ [cell setTag: tag];
[cell setBordered: YES];
[cell setEnabled: YES];
-
- return self;
}
-- addString: (char *)str row: (int)row
+- (void)addString: (char *)str row: (int)row
{
id cell;
[cell setTitle: [NSString stringWithUTF8String: str]];
[cell setBordered: YES];
[cell setEnabled: NO];
-
- return self;
}
-- addSplit
+- (void)addSplit
{
[matrix addColumn];
cols++;
- return self;
}
-- clicked: sender
+- (void)clicked: sender
{
NSArray *sellist = nil;
EMACS_INT seltag;
sellist = [sender selectedCells];
- if ([sellist count]<1)
- return self;
+ if ([sellist count] < 1)
+ return;
seltag = [[sellist objectAtIndex: 0] tag];
- if (seltag != XHASH (Qundefined)) // FIXME: BIG UGLY HACK!!
- [NSApp stopModalWithCode: seltag];
- return self;
+ dialog_return = button_values[seltag];
+ [NSApp stop:self];
}
if (XTYPE (contents) == Lisp_Cons)
{
head = Fcar (contents);
- process_dialog (self, Fcdr (contents));
+ [self process_dialog: Fcdr (contents)];
}
else
head = contents;
if (XTYPE (head) == Lisp_String)
[title setStringValue:
- [NSString stringWithUTF8String: SDATA (head)]];
+ [NSString stringWithUTF8String: SSDATA (head)]];
else if (isQ == YES)
[title setStringValue: @"Question"];
else
if (cols == 1 && rows > 1) /* Never told where to split */
{
[matrix addColumn];
- for (i = 0; i<rows/2; i++)
+ for (i = 0; i < rows/2; i++)
{
[matrix putCell: [matrix cellAtRow: (rows+1)/2 column: 0]
atRow: i column: 1];
}
-- (void)dealloc
+
+- (void)timeout_handler: (NSTimer *)timedEntry
{
- { [super dealloc]; return; };
+ NSEvent *nxev = [NSEvent otherEventWithType: NSApplicationDefined
+ location: NSMakePoint (0, 0)
+ modifierFlags: 0
+ timestamp: 0
+ windowNumber: [[NSApp mainWindow] windowNumber]
+ context: [NSApp context]
+ subtype: 0
+ data1: 0
+ data2: 0];
+
+ timer_fired = YES;
+ /* We use sto because stopModal/abortModal out of the main loop does not
+ seem to work in 10.6. But as we use stop we must send a real event so
+ the stop is seen and acted upon. */
+ [NSApp stop:self];
+ [NSApp postEvent: nxev atStart: NO];
}
-
- (Lisp_Object)runDialogAt: (NSPoint)p
{
- NSInteger ret;
+ Lisp_Object ret = Qundefined;
- /* 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 = NO;
+ dialog_return = Qundefined;
+ [NSApp runModalForWindow: self];
+ ret = dialog_return;
+ if (! timer_fired)
+ {
+ if (tmo != nil) [tmo invalidate]; /* Cancels timer */
+ break;
+ }
}
- { /* FIXME: BIG UGLY HACK!!! */
- Lisp_Object tmp;
- *(EMACS_INT*)(&tmp) = ret;
- return tmp;
- }
+ if (EQ (ret, Qundefined) && window_closed)
+ /* Make close button pressed equivalent to C-g. */
+ Fsignal (Qquit, Qnil);
+
+ return ret;
}
@end
/* This should be the first include, as it may set up #defines affecting
interpretation of even the system includes. */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "nsterm.h"
if (EQ (sym, QPRIMARY)) return NXPrimaryPboard;
if (EQ (sym, QSECONDARY)) return NXSecondaryPboard;
if (EQ (sym, QTEXT)) return NSStringPboardType;
- return [NSString stringWithUTF8String: SDATA (XSYMBOL (sym)->xname)];
+ return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (sym))];
}
static NSPasteboard *
if (VECTORP (obj))
{
- int i;
- int size = ASIZE (obj);
+ ptrdiff_t i;
+ ptrdiff_t size = ASIZE (obj);
Lisp_Object copy;
if (size == 1)
CHECK_STRING (str);
- utfStr = SDATA (str);
+ utfStr = SSDATA (str);
nsStr = [[NSString alloc] initWithBytesNoCopy: utfStr
length: SBYTES (str)
encoding: NSUTF8StringEncoding
{
Lisp_Object local_value;
Lisp_Object handler_fn, value, type, check;
- int count;
+ ptrdiff_t count;
local_value = assq_no_quit (selection_name, Vselection_alist);
length = [mstr lengthOfBytesUsingEncoding: NSUTF8StringEncoding];
#if ! defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_4
- if (!utfStr)
+ if (!utfStr)
{
utfStr = [mstr cString];
length = strlen (utfStr);
for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest))
call3 (Fcar (rest), selection, target_symbol, successful_p);
}
-
+
return value;
}
if (EQ (selection, Qt)) selection = QSECONDARY;
pb = ns_symbol_to_pb (selection);
if (pb == nil) return Qnil;
-
+
types = [pb types];
return ([types count] == 0) ? Qnil : Qt;
}
Qforeign_selection = intern_c_string ("foreign-selection");
staticpro (&Qforeign_selection);
}
-
- (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
}
/* AppKit-side interface */
-- menuDown: sender;
+- menuDown: (id)sender;
- toolbarClicked: (id)item;
- toggleToolbar: (id)sender;
- (void)keyDown: (NSEvent *)theEvent;
- (void) setWindowClosing: (BOOL)closing;
- (EmacsToolbar *) toolbar;
- (void) deleteWorkingText;
+- (void) updateFrameSize: (BOOL) delay;
#ifdef NS_IMPL_GNUSTEP
/* Not declared, but useful. */
NSTextField *title;
NSMatrix *matrix;
int rows, cols;
+ BOOL timer_fired, window_closed;
+ Lisp_Object dialog_return;
+ Lisp_Object *button_values;
}
- initFromContents: (Lisp_Object)menu isQuestion: (BOOL)isQ;
-- addButton: (char *)str value: (Lisp_Object)val row: (int)row;
-- addString: (char *)str row: (int)row;
-- addSplit;
+- (void)process_dialog: (Lisp_Object)list;
+- (void)addButton: (char *)str value: (int)tag row: (int)row;
+- (void)addString: (char *)str row: (int)row;
+- (void)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
struct font font;
char *name; /* PostScript name, uniquely identifies on NS systems */
- float width; /* this and following metrics stored as float rather than int */
+
+ /* The following metrics are stored as float rather than int. */
+
+ float width; /* Maximum advance for the font. */
float height;
float underpos;
float underwidth;
extern struct ns_display_info *x_display_list;
extern Lisp_Object ns_display_name_list;
-extern struct ns_display_info *ns_display_info_for_name ();
+extern struct ns_display_info *ns_display_info_for_name (Lisp_Object name);
struct ns_display_info *check_x_display_info (Lisp_Object frame);
FRAME_PTR check_x_frame (Lisp_Object frame);
/* This is the `Display *' which frame F is on. */
#define FRAME_NS_DISPLAY(f) (0)
#define FRAME_X_DISPLAY(f) (0)
+#define FRAME_X_SCREEN(f) (0)
+#define FRAME_X_VISUAL(f) FRAME_NS_DISPLAY_INFO(f)->visual
#define FRAME_FOREGROUND_COLOR(f) ((f)->output_data.ns->foreground_color)
#define FRAME_BACKGROUND_COLOR(f) ((f)->output_data.ns->background_color)
(! (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f)) ? 0 \
: FRAME_SCROLL_BAR_COLS (f))
-extern struct ns_display_info *ns_term_init ();
+extern struct ns_display_info *ns_term_init (Lisp_Object display_name);
extern void ns_term_shutdown (int sig);
/* constants for text rendering */
#define NS_DUMPGLYPH_MOUSEFACE 3
-EXFUN (Fx_display_grayscale_p, 1);
-EXFUN (Fx_display_planes, 1);
/* In nsfont, called from fontset.c */
extern void nsfont_make_fontset_for_font (Lisp_Object name,
extern const char *ns_xlfd_to_fontname (const char *xlfd);
extern void check_ns (void);
-extern Lisp_Object ns_map_event_to_object ();
-extern Lisp_Object ns_string_from_pasteboard ();
-extern void ns_string_to_pasteboard ();
+extern Lisp_Object ns_map_event_to_object (void);
+#ifdef __OBJC__
+extern Lisp_Object ns_string_from_pasteboard (id pb);
+extern void ns_string_to_pasteboard (id pb, Lisp_Object str);
+#endif
extern Lisp_Object ns_get_local_selection (Lisp_Object selection_name,
Lisp_Object target_type);
-extern void nxatoms_of_nsselect ();
-extern int ns_lisp_to_cursor_type ();
+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);
-extern int
+extern bool
ns_defined_color (struct frame *f,
const char *name,
- XColor *color_def, int alloc,
- char makeIndex);
+ XColor *color_def, bool alloc,
+ bool makeIndex);
extern void
ns_query_color (void *col, XColor *color_def, int setPixel);
/* C access to ObjC functionality */
extern void ns_release_object (void *obj);
extern void ns_retain_object (void *obj);
-extern void *ns_alloc_autorelease_pool ();
-extern void ns_release_autorelease_pool ();
-extern const char *ns_get_defaults_value ();
+extern void *ns_alloc_autorelease_pool (void);
+extern void ns_release_autorelease_pool (void *);
+extern const char *ns_get_defaults_value (const char *key);
/* in nsmenu */
extern void update_frame_tool_bar (FRAME_PTR f);
extern Lisp_Object ns_popup_dialog (Lisp_Object position, Lisp_Object contents,
Lisp_Object header);
-/* More prototypes that should be moved to a more general include file */
-extern void set_frame_menubar (struct frame *f, int first_time, int deep_p);
-extern void x_set_window_size (struct frame *f, int change_grav,
- int cols, int rows);
-extern void x_sync (struct frame *);
-extern Lisp_Object x_get_focus_frame (struct frame *);
-extern void x_set_mouse_position (struct frame *f, int h, int v);
-extern void x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y);
-extern void x_make_frame_visible (struct frame *f);
-extern void x_make_frame_invisible (struct frame *f);
-extern void x_iconify_frame (struct frame *f);
-extern int x_char_width (struct frame *f);
-extern int x_char_height (struct frame *f);
-extern int x_pixel_width (struct frame *f);
-extern int x_pixel_height (struct frame *f);
-extern void x_set_frame_alpha (struct frame *f);
-extern void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
-extern void x_set_tool_bar_lines (struct frame *f,
- Lisp_Object value,
- Lisp_Object oldval);
-extern void x_activate_menubar (struct frame *);
-extern void free_frame_menubar (struct frame *);
-extern void x_free_frame_resources (struct frame *);
-
#define NSAPP_DATA2_RUNASSCRIPT 10
extern void ns_run_ascript (void);
-extern void ns_init_paths (void);
+extern const char *ns_etc_directory (void);
+extern const char *ns_exec_path (void);
+extern const char *ns_load_path (void);
extern void syms_of_nsterm (void);
extern void syms_of_nsfns (void);
extern void syms_of_nsmenu (void);
extern void *ns_image_from_XBM (unsigned char *bits, int width, int height);
extern void *ns_image_for_XPM (int width, int height, int depth);
extern void *ns_image_from_file (Lisp_Object file);
-extern int ns_load_image (struct frame *f, struct image *img,
- Lisp_Object spec_file, Lisp_Object spec_data);
+extern bool ns_load_image (struct frame *f, struct image *img,
+ Lisp_Object spec_file, Lisp_Object spec_data);
extern int ns_image_width (void *img);
extern int ns_image_height (void *img);
extern unsigned long ns_get_pixel (void *img, int x, int y);
/* This in nsterm.m */
extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timeval *timeout);
+ fd_set *exceptfds, EMACS_TIME *timeout,
+ sigset_t *sigmask);
extern unsigned long ns_get_rgb_color (struct frame *f,
float r, float g, float b, float a);
extern NSPoint last_mouse_motion_position;
#include <time.h>
#include <signal.h>
#include <unistd.h>
-#include <setjmp.h>
+
+#include <c-ctype.h>
+#include <c-strcase.h>
+#include <ftoastr.h>
+
+#ifdef HAVE_FCNTL_H
+#include <fcntl.h>
+#endif
#include "lisp.h"
#include "blockinput.h"
#include "window.h"
#include "keyboard.h"
-
+#include "buffer.h"
#include "font.h"
/* call tracing */
};
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;
static struct frame *ns_updating_frame;
static NSView *focus_view = NULL;
static int ns_window_num = 0;
+#ifdef NS_IMPL_GNUSTEP
static NSRect uRect;
+#endif
static BOOL gsaved = NO;
BOOL ns_in_resize = NO;
static BOOL ns_fake_keydown = NO;
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 struct timeval select_timeout;
-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. */
#define NS_FUNCTION_KEY_MASK 0x800000
/* 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);
}
-void
-ns_init_paths (void)
-/* --------------------------------------------------------------------------
- Used to allow emacs to find its resources under Emacs.app
- Called from emacs.c at startup.
- -------------------------------------------------------------------------- */
+const char *
+ns_etc_directory (void)
+/* If running as a self-contained app bundle, return as a string the
+ filename of the etc directory, if present; else nil. */
+{
+ NSBundle *bundle = [NSBundle mainBundle];
+ NSString *resourceDir = [bundle resourcePath];
+ NSString *resourcePath;
+ NSFileManager *fileManager = [NSFileManager defaultManager];
+ BOOL isDir;
+
+ resourcePath = [resourceDir stringByAppendingPathComponent: @"etc"];
+ if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
+ {
+ if (isDir) return [resourcePath UTF8String];
+ }
+ return NULL;
+}
+
+
+const char *
+ns_exec_path (void)
+/* If running as a self-contained app bundle, return as a path string
+ the filenames of the libexec and bin directories, ie libexec:bin.
+ Otherwise, return nil.
+ Normally, Emacs does not add its own bin/ directory to the PATH.
+ However, a self-contained NS build has a different layout, with
+ bin/ and libexec/ subdirectories in the directory that contains
+ Emacs.app itself.
+ We put libexec first, because init_callproc_1 uses the first
+ element to initialize exec-directory. An alternative would be
+ for init_callproc to check for invocation-directory/libexec.
+*/
{
NSBundle *bundle = [NSBundle mainBundle];
- NSString *binDir = [bundle bundlePath], *resourceDir = [bundle resourcePath];
+ NSString *resourceDir = [bundle resourcePath];
+ NSString *binDir = [bundle bundlePath];
NSString *resourcePath, *resourcePaths;
NSRange range;
- BOOL onWindows = NO; /* how do I determine this? */
- NSString *pathSeparator = onWindows ? @";" : @":";
+ NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR];
NSFileManager *fileManager = [NSFileManager defaultManager];
+ NSArray *paths;
+ NSEnumerator *pathEnum;
BOOL isDir;
-/*NSLog (@"ns_init_paths: '%@'\n%@\n", [[NSBundle mainBundle] bundlePath], [[NSBundle mainBundle] resourcePath]); */
- /* get bindir from base */
range = [resourceDir rangeOfString: @"Contents"];
if (range.location != NSNotFound)
{
#endif
}
- /* the following based on Andrew Choi's init_mac_osx_environment () */
- if (!getenv ("EMACSLOADPATH"))
- {
- NSArray *paths = [resourceDir stringsByAppendingPaths:
- [NSArray arrayWithObjects:
- @"site-lisp", @"lisp", @"leim", nil]];
- NSEnumerator *pathEnum = [paths objectEnumerator];
- resourcePaths = @"";
- while (resourcePath = [pathEnum nextObject])
- {
- if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
- if (isDir)
- {
- if ([resourcePaths length] > 0)
- resourcePaths
- = [resourcePaths stringByAppendingString: pathSeparator];
- resourcePaths
- = [resourcePaths stringByAppendingString: resourcePath];
- }
- }
- if ([resourcePaths length] > 0)
- setenv ("EMACSLOADPATH", [resourcePaths UTF8String], 1);
-/*NSLog (@"loadPath: '%@'\n", resourcePaths); */
- }
-
- if (!getenv ("EMACSPATH"))
- {
- NSArray *paths = [binDir stringsByAppendingPaths:
- [NSArray arrayWithObjects: @"bin",
- @"lib-exec", nil]];
- NSEnumerator *pathEnum = [paths objectEnumerator];
- resourcePaths = @"";
- while (resourcePath = [pathEnum nextObject])
- {
- if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
- if (isDir)
- {
- if ([resourcePaths length] > 0)
- resourcePaths
- = [resourcePaths stringByAppendingString: pathSeparator];
- resourcePaths
- = [resourcePaths stringByAppendingString: resourcePath];
- }
- }
- if ([resourcePaths length] > 0)
- setenv ("EMACSPATH", [resourcePaths UTF8String], 1);
- }
-
- resourcePath = [resourceDir stringByAppendingPathComponent: @"etc"];
- if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
- {
- if (isDir)
- {
- if (!getenv ("EMACSDATA"))
- setenv ("EMACSDATA", [resourcePath UTF8String], 1);
- if (!getenv ("EMACSDOC"))
- setenv ("EMACSDOC", [resourcePath UTF8String], 1);
- }
- }
+ paths = [binDir stringsByAppendingPaths:
+ [NSArray arrayWithObjects: @"libexec", @"bin", nil]];
+ pathEnum = [paths objectEnumerator];
+ resourcePaths = @"";
- if (!getenv ("INFOPATH"))
+ while ((resourcePath = [pathEnum nextObject]))
{
- resourcePath = [resourceDir stringByAppendingPathComponent: @"info"];
if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
if (isDir)
- setenv ("INFOPATH", [[resourcePath stringByAppendingString: @":"]
- UTF8String], 1);
- /* Note, extra colon needed to cause merge w/later user additions. */
+ {
+ if ([resourcePaths length] > 0)
+ resourcePaths
+ = [resourcePaths stringByAppendingString: pathSeparator];
+ resourcePaths
+ = [resourcePaths stringByAppendingString: resourcePath];
+ }
}
+ if ([resourcePaths length] > 0) return [resourcePaths UTF8String];
+
+ return NULL;
}
-static int
-timeval_subtract (struct timeval *result, struct timeval x, struct timeval y)
-/* --------------------------------------------------------------------------
- Subtract the `struct timeval' values X and Y, storing the result in RESULT.
- Return 1 if the difference is negative, otherwise 0.
- -------------------------------------------------------------------------- */
+const char *
+ns_load_path (void)
+/* If running as a self-contained app bundle, return as a path string
+ the filenames of the site-lisp, lisp and leim directories.
+ Ie, site-lisp:lisp:leim. Otherwise, return nil. */
{
- /* Perform the carry for the later subtraction by updating y.
- This is safer because on some systems
- the tv_sec member is unsigned. */
- if (x.tv_usec < y.tv_usec)
- {
- int nsec = (y.tv_usec - x.tv_usec) / 1000000 + 1;
- y.tv_usec -= 1000000 * nsec;
- y.tv_sec += nsec;
- }
- if (x.tv_usec - y.tv_usec > 1000000)
+ NSBundle *bundle = [NSBundle mainBundle];
+ NSString *resourceDir = [bundle resourcePath];
+ NSString *resourcePath, *resourcePaths;
+ NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR];
+ NSFileManager *fileManager = [NSFileManager defaultManager];
+ BOOL isDir;
+ NSArray *paths = [resourceDir stringsByAppendingPaths:
+ [NSArray arrayWithObjects:
+ @"site-lisp", @"lisp", @"leim", nil]];
+ NSEnumerator *pathEnum = [paths objectEnumerator];
+ resourcePaths = @"";
+
+ /* Hack to skip site-lisp. */
+ if (no_site_lisp) resourcePath = [pathEnum nextObject];
+
+ while ((resourcePath = [pathEnum nextObject]))
{
- int nsec = (y.tv_usec - x.tv_usec) / 1000000;
- y.tv_usec += 1000000 * nsec;
- y.tv_sec -= nsec;
+ if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
+ if (isDir)
+ {
+ if ([resourcePaths length] > 0)
+ resourcePaths
+ = [resourcePaths stringByAppendingString: pathSeparator];
+ resourcePaths
+ = [resourcePaths stringByAppendingString: resourcePath];
+ }
}
+ if ([resourcePaths length] > 0) return [resourcePaths UTF8String];
- /* Compute the time remaining to wait. tv_usec is certainly positive. */
- result->tv_sec = x.tv_sec - y.tv_sec;
- result->tv_usec = x.tv_usec - y.tv_usec;
-
- /* Return indication of whether the result should be considered negative. */
- return x.tv_sec < y.tv_sec;
+ return NULL;
}
static void
Blocking timer utility used by ns_ring_bell
-------------------------------------------------------------------------- */
{
- struct timeval wakeup;
-
- EMACS_GET_TIME (wakeup);
-
- /* Compute time to wait until, propagating carry from usecs. */
- wakeup.tv_usec += usecs;
- wakeup.tv_sec += (wakeup.tv_usec / 1000000);
- wakeup.tv_usec %= 1000000;
+ EMACS_TIME wakeup = add_emacs_time (current_emacs_time (),
+ make_emacs_time (0, usecs * 1000));
/* Keep waiting until past the time wakeup. */
while (1)
{
- struct timeval timeout;
-
- EMACS_GET_TIME (timeout);
-
- /* In effect, timeout = wakeup - timeout.
- Break if result would be negative. */
- if (timeval_subtract (&timeout, wakeup, timeout))
+ EMACS_TIME timeout, now = current_emacs_time ();
+ if (EMACS_TIME_LE (wakeup, now))
break;
+ timeout = sub_emacs_time (wakeup, now);
/* Try to wait that long--but we might wake up sooner. */
- select (0, NULL, NULL, NULL, &timeout);
+ pselect (0, NULL, NULL, NULL, &timeout, NULL);
}
}
#endif
#ifdef NS_IMPL_COCOA
#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
- BLOCK_INPUT;
+ block_input ();
NSTRACE (ns_update_auto_hide_menu_bar);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
#endif
}
-------------------------------------------------------------------------- */
{
NSView *view = FRAME_NS_VIEW (f);
+ NSRect r = [view frame];
+ NSBezierPath *bp;
NSTRACE (ns_update_begin);
ns_update_auto_hide_menu_bar ();
ns_updating_frame = f;
[view lockFocus];
+ /* drawRect may have been called for say the minibuffer, and then clip path
+ is for the minibuffer. But the display engine may draw more because
+ we have set the frame as garbaged. So reset clip path to the whole
+ view. */
+ bp = [[NSBezierPath bezierPathWithRect: r] retain];
+ [bp setClip];
+ [bp release];
+
#ifdef NS_IMPL_GNUSTEP
uRect = NSMakeRect (0, 0, 0, 0);
#endif
struct frame *f = XFRAME (WINDOW_FRAME (w));
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
NSTRACE (ns_update_window_begin);
-
updated_window = w;
set_output_cursor (&w->cursor);
- BLOCK_INPUT;
+ block_input ();
if (f == hlinfo->mouse_face_mouse_frame)
{
/* (further code for mouse faces ifdef'd out in other terms elided) */
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* note: this fn is nearly identical in all terms */
if (!w->pseudo_window_p)
{
- BLOCK_INPUT;
+ block_input ();
if (cursor_on_p)
display_and_set_cursor (w, 1,
if (draw_window_fringes (w, 1))
x_draw_vertical_border (w);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If a row with mouse-face was overwritten, arrange for
/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
- BLOCK_INPUT;
+ block_input ();
#ifdef NS_IMPL_GNUSTEP
/* trigger flush only in the rectangle we tracked as being drawn */
[view unlockFocus];
[[view window] flushWindow];
- UNBLOCK_INPUT;
+ unblock_input ();
ns_updating_frame = NULL;
NSTRACE (ns_update_end);
}
window_box (w, area, &window_x, &window_y, &window_width, 0);
- clip_rect.origin.x = window_x - FRAME_INTERNAL_BORDER_WIDTH (f);
+ clip_rect.origin.x = window_x;
clip_rect.origin.y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, row->y));
clip_rect.origin.y = max (clip_rect.origin.y, window_y);
- clip_rect.size.width = window_width + 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
+ clip_rect.size.width = window_width;
clip_rect.size.height = row->visible_height;
- /* allow a full-height row at the top when requested
- (used to draw fringe all the way through internal border area) */
- if (gc && clip_rect.origin.y < 5)
- {
- clip_rect.origin.y -= FRAME_INTERNAL_BORDER_WIDTH (f);
- clip_rect.size.height += FRAME_INTERNAL_BORDER_WIDTH (f);
- }
-
- /* likewise at bottom */
- if (gc &&
- FRAME_PIXEL_HEIGHT (f) - (clip_rect.origin.y + clip_rect.size.height) < 5)
- clip_rect.size.height += FRAME_INTERNAL_BORDER_WIDTH (f);
-
ns_focus (f, &clip_rect, 1);
}
struct frame *frame = SELECTED_FRAME ();
NSView *view;
- BLOCK_INPUT;
+ block_input ();
pool = [[NSAutoreleasePool alloc] init];
view = FRAME_NS_VIEW (frame);
ns_unfocus (frame);
}
[pool release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
{
{
NSView *view = FRAME_NS_VIEW (f);
check_ns ();
- BLOCK_INPUT;
+ block_input ();
FRAME_SAMPLE_VISIBILITY (f);
if (FRAME_VISIBLE_P (f))
{
[[view window] makeKeyAndOrderFront: NSApp];
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
{
NSView *view = FRAME_NS_VIEW (f);
check_ns ();
- BLOCK_INPUT;
+ block_input ();
[[view window] orderBack: NSApp];
- UNBLOCK_INPUT;
+ unblock_input ();
}
: dpyinfo->x_focus_frame);
if (!FRAME_LIVE_P (dpyinfo->x_highlight_frame))
{
- FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame) = Qnil;
+ fset_focus_frame (dpyinfo->x_focus_frame, Qnil);
dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame;
}
}
NSView *view = FRAME_NS_VIEW (f);
struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
- NSTRACE (x_destroy_window);
+ NSTRACE (x_free_frame_resources);
check_ns ();
[(EmacsView *)view setWindowClosing: YES]; /* may not have been informed */
- BLOCK_INPUT;
+ block_input ();
free_frame_menubar (f);
xfree (f->output_data.ns);
- UNBLOCK_INPUT;
+ unblock_input ();
}
void
NSTRACE (x_set_offset);
- BLOCK_INPUT;
+ block_input ();
f->left_pos = xoff;
f->top_pos = yoff;
f->size_hint_flags &= ~(XNegative|YNegative);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
-------------------------------------------------------------------------- */
{
EmacsView *view = FRAME_NS_VIEW (f);
- EmacsToolbar *toolbar = [view toolbar];
NSWindow *window = [view window];
NSRect wr = [window frame];
int tb = FRAME_EXTERNAL_TOOL_BAR (f);
int pixelwidth, pixelheight;
- static int oldRows, oldCols, oldFontWidth, oldFontHeight;
- static int oldTB;
- static struct frame *oldF;
NSTRACE (x_set_window_size);
- if (view == nil ||
- (f == oldF
- && rows == oldRows && cols == oldCols
- && oldFontWidth == FRAME_COLUMN_WIDTH (f)
- && oldFontHeight == FRAME_LINE_HEIGHT (f)
- && oldTB == tb))
+ if (view == nil)
return;
/*fprintf (stderr, "\tsetWindowSize: %d x %d, font size %d x %d\n", cols, rows, FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f)); */
- BLOCK_INPUT;
+ block_input ();
check_frame_size (f, &rows, &cols);
- oldF = f;
- oldRows = rows;
- oldCols = cols;
- oldFontWidth = FRAME_COLUMN_WIDTH (f);
- oldFontHeight = FRAME_LINE_HEIGHT (f);
- oldTB = tb;
f->scroll_bar_actual_width = NS_SCROLL_BAR_WIDTH (f);
compute_fringe_widths (f, 0);
mark_window_cursors_off (XWINDOW (f->root_window));
cancel_mouse_face (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
{
color_table->size = NS_COLOR_CAPACITY;
color_table->avail = 1; /* skip idx=0 as marker */
- color_table->colors
- = (NSColor **)xmalloc (color_table->size * sizeof (NSColor *));
+ color_table->colors = xmalloc (color_table->size * sizeof (NSColor *));
color_table->colors[0] = nil;
color_table->empty_indices = [[NSMutableSet alloc] init];
}
NSString *nsname = [NSString stringWithUTF8String: name];
/*fprintf (stderr, "ns_get_color: '%s'\n", name); */
- BLOCK_INPUT;
+ block_input ();
if ([nsname isEqualToString: @"ns_selection_color"])
{
[scanner scanFloat: &b];
}
else if (!strncmp(name, "rgb:", 4)) /* A newer X11 format -- rgb:r/g/b */
- {
- strncpy (hex, name + 4, 19);
- hex[19] = '\0';
- scaling = (strlen(hex) - 2) / 3;
- }
+ scaling = (snprintf (hex, sizeof hex, "%s", name + 4) - 2) / 3;
else if (name[0] == '#') /* An old X11 format; convert to newer */
{
int len = (strlen(name) - 1);
int start = (len % 3 == 0) ? 1 : len / 4 + 1;
int i;
scaling = strlen(name+start) / 3;
- for (i=0; i<3; i++) {
- strncpy(hex + i * (scaling + 1), name + start + i * scaling, scaling);
- hex[(i+1) * (scaling + 1) - 1] = '/';
- }
+ for (i = 0; i < 3; i++)
+ sprintf (hex + i * (scaling + 1), "%.*s/", scaling,
+ name + start + i * scaling);
hex[3 * (scaling + 1) - 1] = '\0';
}
if (r >= 0.0)
{
*col = [NSColor colorWithCalibratedRed: r green: g blue: b alpha: 1.0];
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
if (new)
*col = [new colorUsingColorSpaceName: NSCalibratedRGBColorSpace];
- UNBLOCK_INPUT;
+ unblock_input ();
return new ? 0 : 1;
}
-static NSColor *
-ns_get_color_default (const char *name, NSColor *dflt)
-/* --------------------------------------------------------------------------
- Parse a color or use a default value
- -------------------------------------------------------------------------- */
-{
- NSColor * col;
-
- if (ns_get_color (name, &col))
- return dflt;
- else
- return col;
-}
-
-
int
ns_lisp_to_color (Lisp_Object color, NSColor **col)
/* --------------------------------------------------------------------------
{
NSTRACE (ns_lisp_to_color);
if (STRINGP (color))
- return ns_get_color (SDATA (color), col);
+ return ns_get_color (SSDATA (color), col);
else if (SYMBOLP (color))
- return ns_get_color (SDATA (SYMBOL_NAME (color)), col);
+ return ns_get_color (SSDATA (SYMBOL_NAME (color)), col);
return 1;
}
const char *str;
NSTRACE (ns_color_to_lisp);
- BLOCK_INPUT;
+ block_input ();
if ([[col colorSpaceName] isEqualToString: NSNamedColorSpace])
if ((str =[[col colorNameComponent] UTF8String]))
{
- UNBLOCK_INPUT;
+ unblock_input ();
return build_string ((char *)str);
}
getWhite: &gray alpha: &alpha];
snprintf (buf, sizeof (buf), "#%2.2lx%2.2lx%2.2lx",
lrint (gray * 0xff), lrint (gray * 0xff), lrint (gray * 0xff));
- UNBLOCK_INPUT;
+ unblock_input ();
return build_string (buf);
}
snprintf (buf, sizeof (buf), "#%2.2lx%2.2lx%2.2lx",
lrint (red*0xff), lrint (green*0xff), lrint (blue*0xff));
- UNBLOCK_INPUT;
+ unblock_input ();
return build_string (buf);
}
}
-int
+bool
ns_defined_color (struct frame *f,
const char *name,
XColor *color_def,
- int alloc,
- char makeIndex)
+ bool alloc,
+ bool makeIndex)
/* --------------------------------------------------------------------------
- Return 1 if named color found, and set color_def rgb accordingly.
+ Return true if named color found, and set color_def rgb accordingly.
If makeIndex and alloc are nonzero put the color in the color_table,
and set color_def pixel to the resulting index.
If makeIndex is zero, set color_def pixel to ARGB.
- Return 0 if not found
+ Return false if not found
-------------------------------------------------------------------------- */
{
NSColor *col;
NSTRACE (ns_defined_color);
- BLOCK_INPUT;
+ block_input ();
if (ns_get_color (name, &col) != 0) /* Color not found */
{
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
if (makeIndex && alloc)
color_def->pixel = ns_index_color (col, f);
ns_query_color (col, color_def, !makeIndex);
- UNBLOCK_INPUT;
+ unblock_input ();
return 1;
}
{
id view;
NSPoint position;
- int xchar, ychar;
Lisp_Object frame, tail;
struct frame *f;
struct ns_display_info *dpyinfo;
dpyinfo = FRAME_NS_DISPLAY_INFO (*fp);
- BLOCK_INPUT;
+ block_input ();
if (last_mouse_scroll_bar != nil && insist == 0)
{
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
if ((hlinfo->mouse_face_deferred_gc || f ==hlinfo->mouse_face_mouse_frame)
/*&& hlinfo->mouse_face_mouse_frame*/)
{
- BLOCK_INPUT;
+ block_input ();
ns_update_begin(f);
if (hlinfo->mouse_face_mouse_frame)
note_mouse_highlight (hlinfo->mouse_face_mouse_frame,
hlinfo->mouse_face_mouse_y);
hlinfo->mouse_face_deferred_gc = 0;
ns_update_end(f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
}
-void
+static void
ns_define_frame_cursor (struct frame *f, Cursor cursor)
/* --------------------------------------------------------------------------
External (RIF): set frame mouse pointer type.
int i;
id view;
NSArray *subviews = [[FRAME_NS_VIEW (f) superview] subviews];
- NSTRACE (ns_judge_scroll_bars);
+ NSTRACE (ns_redraw_scroll_bars);
for (i =[subviews count]-1; i >= 0; i--)
{
view = [subviews objectAtIndex: i];
r = [view bounds];
- BLOCK_INPUT;
+ block_input ();
ns_focus (f, &r, 1);
[ns_lookup_indexed_color (NS_FACE_BACKGROUND (FRAME_DEFAULT_FACE (f)), f) set];
NSRectFill (r);
/* as of 2006/11 or so this is now needed */
ns_redraw_scroll_bars (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
-void
+static void
ns_clear_frame_area (struct frame *f, int x, int y, int width, int height)
/* --------------------------------------------------------------------------
External (RIF): Clear section of frame
if (height == 0)
return;
- BLOCK_INPUT;
+ block_input ();
updated_window = w;
x_clear_cursor (w);
ns_unfocus (f);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
NSTRACE (ns_after_update_window_line);
/* begin copy from other terms */
- xassert (w);
+ eassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p)
desired_row->redraw_fringe_bitmaps_p = 1;
/* When a window has disappeared, make sure that no rest of
- full-width rows stays visible in the internal border.
- Under NS this is drawn inside the fringes. */
+ full-width rows stays visible in the internal border. */
if (windows_or_buffers_changed
+ && desired_row->full_width_p
&& (f = XFRAME (w->frame),
width = FRAME_INTERNAL_BORDER_WIDTH (f),
width != 0)
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
- /* Internal border is drawn below the tool bar. */
- if (WINDOWP (f->tool_bar_window)
- && w == XWINDOW (f->tool_bar_window))
- y -= width;
- /* end copy from other terms */
-
- BLOCK_INPUT;
- if (!desired_row->full_width_p)
- {
- int x1 = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w)
- + WINDOW_LEFT_FRINGE_WIDTH (w);
- int x2 = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w)
- + FRAME_PIXEL_WIDTH (f) - NS_SCROLL_BAR_WIDTH (f)
- - WINDOW_RIGHT_FRINGE_WIDTH (w)
- - FRAME_INTERNAL_BORDER_WIDTH (f);
- ns_clear_frame_area (f, x1, y, width, height);
- ns_clear_frame_area (f, x2, y, width, height);
- }
- UNBLOCK_INPUT;
+ block_input ();
+ ns_clear_frame_area (f, 0, y, width, height);
+ ns_clear_frame_area (f,
+ FRAME_PIXEL_WIDTH (f) - width,
+ y, width, height);
+ unblock_input ();
}
}
External (RIF); compute left/right overhang of whole string and set in s
-------------------------------------------------------------------------- */
{
- struct face *face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
- struct font *font = s->font; /*face->font; */
+ struct font *font = s->font;
if (s->char2b)
{
int rowY;
static EmacsImage **bimgs = NULL;
static int nBimgs = 0;
- /* NS-specific: move internal border inside fringe */
- int x = p->bx < 0 ? p->x : p->bx;
- int wd = p->bx < 0 ? p->wd : p->nx;
- BOOL fringeOnVeryLeft
- = x - WINDOW_LEFT_SCROLL_BAR_COLS (w) * WINDOW_FRAME_COLUMN_WIDTH (w)
- - FRAME_INTERNAL_BORDER_WIDTH (f) < 10;
- BOOL fringeOnVeryRight
- = FRAME_PIXEL_WIDTH (f) - x - wd - FRAME_INTERNAL_BORDER_WIDTH (f)
- - WINDOW_RIGHT_SCROLL_BAR_COLS (w) * WINDOW_FRAME_COLUMN_WIDTH (w) < 10;
- int xAdjust = FRAME_INTERNAL_BORDER_WIDTH (f) *
- (fringeOnVeryLeft ? -1 : (fringeOnVeryRight ? 1 : 0));
/* grow bimgs if needed */
if (nBimgs < max_used_fringe_bitmap)
{
- EmacsImage **newBimgs
- = xmalloc (max_used_fringe_bitmap * sizeof (EmacsImage *));
- memset (newBimgs, 0, max_used_fringe_bitmap * sizeof (EmacsImage *));
-
- if (nBimgs)
- {
- memcpy (newBimgs, bimgs, nBimgs * sizeof (EmacsImage *));
- xfree (bimgs);
- }
-
- bimgs = newBimgs;
+ bimgs = xrealloc (bimgs, max_used_fringe_bitmap * sizeof *bimgs);
+ memset (bimgs + nBimgs, 0,
+ (max_used_fringe_bitmap - nBimgs) * sizeof *bimgs);
nBimgs = max_used_fringe_bitmap;
}
rowY = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
ns_clip_to_row (w, row, -1, YES);
- if (p->bx >= 0 && !p->overlay_p)
+ if (!p->overlay_p)
{
- int yAdjust = rowY - FRAME_INTERNAL_BORDER_WIDTH (f) < 5 ?
- -FRAME_INTERNAL_BORDER_WIDTH (f) : 0;
- int yIncr = FRAME_PIXEL_HEIGHT (f) - (p->by+yAdjust + p->ny) < 5 ?
- FRAME_INTERNAL_BORDER_WIDTH (f) : 0
- + (yAdjust ? FRAME_INTERNAL_BORDER_WIDTH (f) : 0);
- NSRect r = NSMakeRect (p->bx+xAdjust, p->by+yAdjust, p->nx, p->ny+yIncr);
- NSRectClip (r);
- [ns_lookup_indexed_color(face->background, f) set];
- NSRectFill (r);
+ int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny;
+
+ /* If the fringe is adjacent to the left (right) scroll bar of a
+ leftmost (rightmost, respectively) window, then extend its
+ background to the gap between the fringe and the bar. */
+ if ((WINDOW_LEFTMOST_P (w)
+ && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w))
+ || (WINDOW_RIGHTMOST_P (w)
+ && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w)))
+ {
+ int sb_width = WINDOW_CONFIG_SCROLL_BAR_WIDTH (w);
+
+ if (sb_width > 0)
+ {
+ int bar_area_x = WINDOW_SCROLL_BAR_AREA_X (w);
+ int bar_area_width = (WINDOW_CONFIG_SCROLL_BAR_COLS (w)
+ * FRAME_COLUMN_WIDTH (f));
+
+ if (bx < 0)
+ {
+ /* Bitmap fills the fringe. */
+ if (bar_area_x + bar_area_width == p->x)
+ bx = bar_area_x + sb_width;
+ else if (p->x + p->wd == bar_area_x)
+ bx = bar_area_x;
+ if (bx >= 0)
+ {
+ int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w);
+
+ nx = bar_area_width - sb_width;
+ by = WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height,
+ row->y));
+ ny = row->visible_height;
+ }
+ }
+ else
+ {
+ if (bar_area_x + bar_area_width == bx)
+ {
+ bx = bar_area_x + sb_width;
+ nx += bar_area_width - sb_width;
+ }
+ else if (bx + nx == bar_area_x)
+ nx += bar_area_width - sb_width;
+ }
+ }
+ }
+
+ if (bx >= 0 && nx > 0)
+ {
+ NSRect r = NSMakeRect (bx, by, nx, ny);
+ NSRectClip (r);
+ [ns_lookup_indexed_color (face->background, f) set];
+ NSRectFill (r);
+ }
}
if (p->which)
{
- NSRect r = NSMakeRect (p->x+xAdjust, p->y, p->wd, p->h);
- NSPoint pt = r.origin;
+ NSRect r = NSMakeRect (p->x, p->y, p->wd, p->h);
EmacsImage *img = bimgs[p->which - 1];
if (!img)
int i;
unsigned char *cbits = xmalloc (len);
- for (i =0; i<len; i++)
+ for (i = 0; i < len; i++)
cbits[i] = ~(bits[i] & 0xff);
img = [[EmacsImage alloc] initFromXBM: cbits width: 8 height: p->h
flip: NO];
to erase the whole background. */
[ns_lookup_indexed_color(face->background, f) set];
NSRectFill (r);
- pt.y += p->h;
[img setXBMColor: ns_lookup_indexed_color(face->foreground, f)];
- [img compositeToPoint: pt operation: NSCompositeSourceOver];
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+ [img drawInRect: r
+ fromRect: NSZeroRect
+ operation: NSCompositeSourceOver
+ fraction: 1.0
+ respectFlipped: YES
+ hints: nil];
+#else
+ {
+ NSPoint pt = r.origin;
+ pt.y += p->h;
+ [img compositeToPoint: pt operation: NSCompositeSourceOver];
+ }
+#endif
}
ns_unfocus (f);
}
-void
+static void
ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
int x, int y, int cursor_type, int cursor_width,
int on_p, int active_p)
r.size.height = h;
r.size.width = w->phys_cursor_width;
- /* FIXME: if we overwrite the internal border area, it does not get erased;
- fix by truncating cursor, but better would be to erase properly */
- overspill = r.origin.x + r.size.width -
- WINDOW_TEXT_TO_FRAME_PIXEL_X (w, WINDOW_BOX_RIGHT_EDGE_X (w)
- - WINDOW_TOTAL_FRINGE_WIDTH (w) - FRAME_INTERNAL_BORDER_WIDTH (f));
- if (overspill > 0)
- r.size.width -= overspill;
-
/* TODO: only needed in rare cases with last-resort font in HELLO..
should we do this more efficiently? */
ns_clip_to_row (w, glyph_row, -1, NO); /* do ns_focus(f, &r, 1); if remove */
if (hourglass_shown_p)
return;
- BLOCK_INPUT;
+ block_input ();
/* TODO: add NSProgressIndicator to selected frame (see macfns.c) */
hourglass_shown_p = 1;
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (!hourglass_shown_p)
return;
- BLOCK_INPUT;
+ block_input ();
/* TODO: remove NSProgressIndicator from all frames */
hourglass_shown_p = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
========================================================================== */
-
-static inline NSRect
-ns_fix_rect_ibw (NSRect r, int fibw, int frame_pixel_width)
-/* --------------------------------------------------------------------------
- Under NS we draw internal borders inside fringes, and want full-width
- rendering to go all the way to edge. This function makes that correction.
- -------------------------------------------------------------------------- */
-{
- if (r.origin.y <= fibw+1)
- {
- r.size.height += r.origin.y;
- r.origin.y = 0;
- }
- if (r.origin.x <= fibw+1)
- {
- r.size.width += r.origin.x;
- r.origin.x = 0;
- }
- if (frame_pixel_width - (r.origin.x+r.size.width) <= fibw+1)
- r.size.width += fibw;
-
- return r;
-}
-
-
static int
ns_get_glyph_string_clip_rect (struct glyph_string *s, NativeRectangle *nr)
/* --------------------------------------------------------------------------
-------------------------------------------------------------------------- */
{
int n = get_glyph_string_clip_rects (s, nr, 2);
- if (s->row->full_width_p)
+ return n;
+}
+
+/* --------------------------------------------------------------------
+ Draw a wavy line under glyph string s. The wave fills wave_height
+ pixels from y.
+
+ x wave_length = 3
+ --
+ y * * * * *
+ |* * * * * * * * *
+ wave_height = 3 | * * * *
+ --------------------------------------------------------------------- */
+
+static void
+ns_draw_underwave (struct glyph_string *s, CGFloat width, CGFloat x)
+{
+ int wave_height = 3, wave_length = 3;
+ int y, dx, dy, odd, xmax;
+ NSPoint a, b;
+ NSRect waveClip;
+
+ dx = wave_length;
+ dy = wave_height - 1;
+ y = s->ybase + 1;
+ xmax = x + width;
+
+ /* Find and set clipping rectangle */
+ waveClip = NSMakeRect (x, y, width, wave_height);
+ [[NSGraphicsContext currentContext] saveGraphicsState];
+ NSRectClip (waveClip);
+
+ /* Draw the waves */
+ a.x = x - ((int)(x) % dx);
+ b.x = a.x + dx;
+ odd = (int)(a.x/dx) % 2;
+ a.y = b.y = y;
+
+ if (odd)
+ a.y += dy;
+ else
+ b.y += dy;
+
+ while (a.x <= xmax)
{
- *nr = ns_fix_rect_ibw (*nr, FRAME_INTERNAL_BORDER_WIDTH (s->f),
- FRAME_PIXEL_WIDTH (s->f));
- if (n == 2)
- *nr = ns_fix_rect_ibw (*(nr+1), FRAME_INTERNAL_BORDER_WIDTH (s->f),
- FRAME_PIXEL_WIDTH (s->f));
+ [NSBezierPath strokeLineFromPoint:a toPoint:b];
+ a.x = b.x, a.y = b.y;
+ b.x += dx, b.y = y + odd*dy;
+ odd = !odd;
}
- return n;
+
+ /* Restore previous clipping rectangle(s) */
+ [[NSGraphicsContext currentContext] restoreGraphicsState];
}
+
+
void
ns_draw_text_decoration (struct glyph_string *s, struct face *face,
NSColor *defaultCol, CGFloat width, CGFloat x)
/* Do underline. */
if (face->underline_p)
{
- NSRect r;
- unsigned long thickness, position;
-
- /* If the prev was underlined, match its appearance. */
- if (s->prev && s->prev->face->underline_p
- && s->prev->underline_thickness > 0)
+ if (s->face->underline_type == FACE_UNDER_WAVE)
{
- thickness = s->prev->underline_thickness;
- position = s->prev->underline_position;
+ if (face->underline_defaulted_p)
+ [defaultCol set];
+ else
+ [ns_lookup_indexed_color (face->underline_color, s->f) set];
+
+ ns_draw_underwave (s, width, x);
}
- else
+ else if (s->face->underline_type == FACE_UNDER_LINE)
{
- struct font *font;
- unsigned long descent;
-
- font=s->font;
- descent = s->y + s->height - s->ybase;
-
- /* Use underline thickness of font, defaulting to 1. */
- thickness = (font && font->underline_thickness > 0)
- ? font->underline_thickness : 1;
-
- /* Determine the offset of underlining from the baseline. */
- if (x_underline_at_descent_line)
- position = descent - thickness;
- else if (x_use_underline_position_properties
- && font && font->underline_position >= 0)
- position = font->underline_position;
- else if (font)
- position = lround (font->descent / 2);
- else
- position = underline_minimum_offset;
- position = max (position, underline_minimum_offset);
+ NSRect r;
+ unsigned long thickness, position;
- /* Ensure underlining is not cropped. */
- if (descent <= position)
+ /* If the prev was underlined, match its appearance. */
+ if (s->prev && s->prev->face->underline_p
+ && s->prev->underline_thickness > 0)
{
- position = descent - 1;
- thickness = 1;
+ thickness = s->prev->underline_thickness;
+ position = s->prev->underline_position;
}
- else if (descent < position + thickness)
- thickness = 1;
- }
+ else
+ {
+ struct font *font;
+ unsigned long descent;
+
+ font=s->font;
+ descent = s->y + s->height - s->ybase;
+
+ /* Use underline thickness of font, defaulting to 1. */
+ thickness = (font && font->underline_thickness > 0)
+ ? font->underline_thickness : 1;
+
+ /* Determine the offset of underlining from the baseline. */
+ if (x_underline_at_descent_line)
+ position = descent - thickness;
+ else if (x_use_underline_position_properties
+ && font && font->underline_position >= 0)
+ position = font->underline_position;
+ else if (font)
+ position = lround (font->descent / 2);
+ else
+ position = underline_minimum_offset;
- s->underline_thickness = thickness;
- s->underline_position = position;
+ position = max (position, underline_minimum_offset);
- r = NSMakeRect (x, s->ybase + position, width, thickness);
+ /* Ensure underlining is not cropped. */
+ if (descent <= position)
+ {
+ position = descent - 1;
+ thickness = 1;
+ }
+ else if (descent < position + thickness)
+ thickness = 1;
+ }
- if (face->underline_defaulted_p)
- [defaultCol set];
- else
- [ns_lookup_indexed_color (face->underline_color, s->f) set];
- NSRectFill (r);
- }
+ s->underline_thickness = thickness;
+ s->underline_position = position;
+
+ r = NSMakeRect (x, s->ybase + position, width, thickness);
+ if (face->underline_defaulted_p)
+ [defaultCol set];
+ else
+ [ns_lookup_indexed_color (face->underline_color, s->f) set];
+ NSRectFill (r);
+ }
+ }
/* Do overline. We follow other terms in using a thickness of 1
and ignoring overline_margin. */
if (face->overline_p)
r = NSMakeRect (s->x, s->y, right_x - s->x + 1, s->height);
- /* expand full-width row over internal borders */
- if (s->row->full_width_p)
- r = ns_fix_rect_ibw (r, FRAME_INTERNAL_BORDER_WIDTH (s->f),
- FRAME_PIXEL_WIDTH (s->f));
-
/* TODO: Sometimes box_color is 0 and this seems wrong; should investigate. */
if (s->face->box == FACE_SIMPLE_BOX && s->face->box_color)
{
NSRect r = NSMakeRect (s->x, s->y + box_line_width,
s->background_width,
s->height-2*box_line_width);
-
- /* expand full-width row over internal borders */
- if (s->row->full_width_p)
- {
- int fibw = FRAME_INTERNAL_BORDER_WIDTH (s->f);
- if (r.origin.y <= fibw+1 + box_line_width)
- {
- r.size.height += r.origin.y;
- r.origin.y = 0;
- }
- if (r.origin.x <= fibw+1)
- {
- r.size.width += 2*r.origin.x;
- r.origin.x = 0;
- }
- if (FRAME_PIXEL_WIDTH (s->f) - (r.origin.x + r.size.width)
- <= fibw+1)
- r.size.width += fibw;
- }
-
NSRectFill (r);
}
br = NSMakeRect (x, y, s->slice.width, s->slice.height);
}
- /* expand full-width row over internal borders */
- if (s->row->full_width_p)
- {
- int fibw = FRAME_INTERNAL_BORDER_WIDTH (s->f);
- if (br.origin.y <= fibw+1 + box_line_vwidth)
- {
- br.size.height += br.origin.y;
- br.origin.y = 0;
- }
- if (br.origin.x <= fibw+1 + box_line_vwidth)
- {
- br.size.width += br.origin.x;
- br.origin.x = 0;
- }
- if (FRAME_PIXEL_WIDTH (s->f) - (br.origin.x + br.size.width) <= fibw+1)
- br.size.width += fibw;
- }
-
NSRectFill (br);
/* Draw the image.. do we need to draw placeholder if img ==nil? */
if (img != nil)
- [img compositeToPoint: NSMakePoint (x, y + s->slice.height)
- operation: NSCompositeSourceOver];
+ {
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
+ NSRect dr = NSMakeRect (x, y, s->slice.width, s->slice.height);
+ [img drawInRect: dr
+ fromRect: NSZeroRect
+ operation: NSCompositeSourceOver
+ fraction: 1.0
+ respectFlipped: YES
+ hints: nil];
+#else
+ [img compositeToPoint: NSMakePoint (x, y + s->slice.height)
+ operation: NSCompositeSourceOver];
+#endif
+ }
if (s->hl == DRAW_CURSOR)
{
bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f);
fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f);
- for (i=0; i<n; i++)
+ for (i = 0; i < n; ++i)
{
if (!s->row->full_width_p)
{
r[i].size.height = min (s->height, s->row->visible_height);
}
- /* expand full-width rows over internal borders */
- else
- {
- r[i] = ns_fix_rect_ibw (r[i], FRAME_INTERNAL_BORDER_WIDTH (s->f),
- FRAME_PIXEL_WIDTH (s->f));
- }
-
[bgCol set];
/* NOTE: under NS this is NOT used to draw cursors, but we must avoid
break;
default:
- abort ();
+ emacs_abort ();
}
/* Draw box if not done already. */
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
}
}
-
static int
-ns_read_socket (struct terminal *terminal, int expected,
- struct input_event *hold_quit)
+ns_read_socket (struct terminal *terminal, struct input_event *hold_quit)
/* --------------------------------------------------------------------------
External (hook): Post an event to ourself and keep reading events until
we read it back again. In effect process all events which were waiting.
if ([NSApp modalWindow] != nil)
return -1;
- if (interrupt_input_blocked)
- {
- interrupt_input_pending = 1;
-#ifdef SYNC_INPUT
- pending_signals = 1;
-#endif
- return -1;
- }
-
- interrupt_input_pending = 0;
-#ifdef SYNC_INPUT
- pending_signals = pending_atimers;
-#endif
-
- BLOCK_INPUT;
+ block_input ();
n_emacs_events_pending = 0;
EVENT_INIT (ev);
emacs_event = &ev;
/* 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);
+ emacs_abort ();
}
-
[NSApp run];
+ --apploopnr;
}
nevents = n_emacs_events_pending;
n_emacs_events_pending = 0;
emacs_event = q_event_ptr = NULL;
- UNBLOCK_INPUT;
+ unblock_input ();
return nevents;
}
int
ns_select (int nfds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timeval *timeout)
+ fd_set *exceptfds, EMACS_TIME *timeout, sigset_t *sigmask)
/* --------------------------------------------------------------------------
Replacement for select, checking for events
-------------------------------------------------------------------------- */
{
int result;
- double time;
NSEvent *ev;
+ 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) */)
- return select (nfds, readfds, writefds, exceptfds, timeout);
+ 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);
+
+ [outerpool release];
+ outerpool = [[NSAutoreleasePool alloc] init];
+
- /* 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)
+ 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
- select_nfds = 0;
-
- /* Try an initial select for pending data on input files */
- select_timeout.tv_sec = select_timeout.tv_usec = 0;
- result = select (nfds, readfds, writefds, exceptfds, &select_timeout);
- if (result)
- return result;
-
- /* 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 = ((double) timeout->tv_sec) + ((double) timeout->tv_usec)/1000000.0;
- 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 select () 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);
+ 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);
+ }
+
+ EVENT_INIT (event);
+ block_input ();
+ emacs_event = &event;
+ if (++apploopnr != 1)
+ {
+ emacs_abort ();
+ }
+ [NSApp run];
+ --apploopnr;
+ emacs_event = NULL;
+ if (nr > 0 && readfds)
+ {
+ c = 's';
+ write (selfds[1], &c, 1);
+ }
+ unblock_input ();
+
ev = last_appdefined_event;
- inNsSelect = 0;
if (ev)
{
int t;
if ([ev type] != NSApplicationDefined)
- abort ();
+ emacs_abort ();
t = [ev data1];
last_appdefined_event = 0;
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 select () in fd_handler; copy the results */
- if (readfds)
- memcpy (readfds, &select_readfds, sizeof (fd_set));
- return t;
+ 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;
}
struct frame *f = XFRAME (WINDOW_FRAME (window));
EmacsView *view = FRAME_NS_VIEW (f);
int window_y, window_height;
- BOOL barOnVeryLeft, barOnVeryRight;
int top, left, height, width, sb_width, sb_left;
EmacsScroller *bar;
-static int count = 0;
+ BOOL fringe_extended_p;
/* optimization; display engine sends WAY too many of these.. */
if (!NILP (window->vertical_scroll_bar))
width = WINDOW_CONFIG_SCROLL_BAR_COLS (window) * FRAME_COLUMN_WIDTH (f);
left = WINDOW_SCROLL_BAR_AREA_X (window);
- if (top < 5) /* top scrollbar adjustment */
- {
- top -= FRAME_INTERNAL_BORDER_WIDTH (f);
- height += FRAME_INTERNAL_BORDER_WIDTH (f);
- }
-
/* allow for displaying a skinnier scrollbar than char area allotted */
sb_width = (WINDOW_CONFIG_SCROLL_BAR_WIDTH (window) > 0) ?
WINDOW_CONFIG_SCROLL_BAR_WIDTH (window) : width;
-
- barOnVeryLeft = left < 5;
- barOnVeryRight = FRAME_PIXEL_WIDTH (f) - left - width < 5;
- sb_left = left + FRAME_INTERNAL_BORDER_WIDTH (f)
- * (barOnVeryLeft ? -1 : (barOnVeryRight ? 1 : 0));
+ sb_left = left;
r = NSMakeRect (sb_left, top, sb_width, height);
/* the parent view is flipped, so we need to flip y value */
v = [view frame];
r.origin.y = (v.size.height - r.size.height - r.origin.y);
+ if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (window))
+ fringe_extended_p = (WINDOW_LEFTMOST_P (window)
+ && WINDOW_LEFT_FRINGE_WIDTH (window)
+ && (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (window)
+ || WINDOW_LEFT_MARGIN_COLS (window) == 0));
+ else
+ fringe_extended_p = (WINDOW_RIGHTMOST_P (window)
+ && WINDOW_RIGHT_FRINGE_WIDTH (window)
+ && (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (window)
+ || WINDOW_RIGHT_MARGIN_COLS (window) == 0));
+
XSETWINDOW (win, window);
- BLOCK_INPUT;
+ block_input ();
/* we want at least 5 lines to display a scrollbar */
if (WINDOW_TOTAL_LINES (window) < 5)
{
bar = XNS_SCROLL_BAR (window->vertical_scroll_bar);
[bar removeFromSuperview];
- window->vertical_scroll_bar = Qnil;
+ wset_vertical_scroll_bar (window, Qnil);
}
ns_clear_frame_area (f, sb_left, top, width, height);
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
if (NILP (window->vertical_scroll_bar))
{
- ns_clear_frame_area (f, sb_left, top, width, height);
+ if (width > 0 && height > 0)
+ {
+ if (fringe_extended_p)
+ ns_clear_frame_area (f, sb_left, top, sb_width, height);
+ else
+ ns_clear_frame_area (f, left, top, width, height);
+ }
+
bar = [[EmacsScroller alloc] initFrame: r window: win];
- window->vertical_scroll_bar = make_save_value (bar, 0);
+ wset_vertical_scroll_bar (window, make_save_value (bar, 0));
}
else
{
}
[bar setPosition: position portion: portion whole: whole];
- UNBLOCK_INPUT;
+ unblock_input ();
}
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];
}
}
{
int i;
id view;
- NSArray *subviews = [[FRAME_NS_VIEW (f) superview] subviews];
+ EmacsView *eview = FRAME_NS_VIEW (f);
+ NSArray *subviews = [[eview superview] subviews];
+ BOOL removed = NO;
+
NSTRACE (ns_judge_scroll_bars);
- for (i =[subviews count]-1; i >= 0; i--)
+ for (i = [subviews count]-1; i >= 0; --i)
{
view = [subviews objectAtIndex: i];
if (![view isKindOfClass: [EmacsScroller class]]) continue;
[view judge];
+ removed = YES;
}
+
+ if (removed)
+ [eview updateFrameSize: NO];
}
Convert modifier name to lisp symbol
-------------------------------------------------------------------------- */
{
- if (!strncmp (SDATA (SYMBOL_NAME (Qmeta)), s, 10))
+ if (!strncmp (SSDATA (SYMBOL_NAME (Qmeta)), s, 10))
return Qmeta;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qsuper)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qsuper)), s, 10))
return Qsuper;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qcontrol)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qcontrol)), s, 10))
return Qcontrol;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qalt)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qalt)), s, 10))
return Qalt;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qhyper)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qhyper)), s, 10))
return Qhyper;
- else if (!strncmp (SDATA (SYMBOL_NAME (Qnone)), s, 10))
+ else if (!strncmp (SSDATA (SYMBOL_NAME (Qnone)), s, 10))
return Qnone;
else
return Qnil;
}
-static Lisp_Object ns_mod_to_lisp (int m)
-/* --------------------------------------------------------------------------
- Convert modifier code (see lisp.h) to lisp symbol
- -------------------------------------------------------------------------- */
-{
- if (m == CHAR_META)
- return Qmeta;
- else if (m == CHAR_SUPER)
- return Qsuper;
- else if (m == CHAR_CTL)
- return Qcontrol;
- else if (m == CHAR_ALT)
- return Qalt;
- else if (m == CHAR_HYPER)
- return Qhyper;
- else /* if (m == 0) */
- return Qnone;
-}
-
-
static void
ns_default (const char *parameter, Lisp_Object *result,
Lisp_Object yesval, Lisp_Object noval,
{
double f;
char *pos;
- if (strcasecmp (value, "YES") == 0)
+ if (c_strcasecmp (value, "YES") == 0)
*result = yesval;
- else if (strcasecmp (value, "NO") == 0)
+ else if (c_strcasecmp (value, "NO") == 0)
*result = noval;
else if (is_float && (f = strtod (value, &pos), pos != value))
*result = make_float (f);
}
-void
+static void
ns_initialize_display_info (struct ns_display_info *dpyinfo)
/* --------------------------------------------------------------------------
Initialize global info and storage for display.
NSColorSpaceFromDepth (depth)];
dpyinfo->n_planes = NSBitsPerPixelFromDepth (depth);
dpyinfo->image_cache = make_image_cache ();
- dpyinfo->color_table
- = (struct ns_color_table *)xmalloc (sizeof (struct ns_color_table));
+ dpyinfo->color_table = xmalloc (sizeof *dpyinfo->color_table);
dpyinfo->color_table->colors = NULL;
dpyinfo->root_window = 42; /* a placeholder.. */
ns_delete_terminal (struct terminal *terminal)
{
struct ns_display_info *dpyinfo = terminal->display_info.ns;
- int i;
/* Protect against recursive calls. delete_frame in
delete_terminal calls us back when it deletes our last frame. */
if (!terminal->name)
return;
- BLOCK_INPUT;
+ block_input ();
x_destroy_all_bitmaps (dpyinfo);
ns_delete_display (dpyinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static int ns_initialized = 0;
Lisp_Object tmp;
+ if (ns_initialized) return x_display_list;
+ ns_initialized = 1;
+
NSTRACE (ns_term_init);
+ [outerpool release];
+ outerpool = [[NSAutoreleasePool alloc] init];
+
/* count object allocs (About, click icon); on OS X use ObjectAlloc tool */
/*GSDebugAllocationActive (YES); */
- BLOCK_INPUT;
- handling_signal = 0;
+ block_input ();
+
+ baud_rate = 38400;
+ Fset_input_interrupt_mode (Qnil);
- if (!ns_initialized)
+ if (selfds[0] == -1)
{
- baud_rate = 38400;
- Fset_input_interrupt_mode (Qnil);
- ns_initialized = 1;
+ if (pipe (selfds) == -1)
+ {
+ fprintf (stderr, "Failed to create pipe: %s\n",
+ emacs_strerror (errno));
+ emacs_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_pending_files = [[NSMutableArray alloc] init];
ns_pending_service_names = [[NSMutableArray alloc] init];
ns_pending_service_args = [[NSMutableArray alloc] init];
- /* Start app and create the main menu, window, view.
+/* Start app and create the main menu, window, view.
Needs to be here because ns_initialize_display_info () uses AppKit classes.
The view will then ask the NSApp to stop and return to Emacs. */
[EmacsApp sharedApplication];
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:)
name: nil object: nil]; */
- dpyinfo = (struct ns_display_info *)xmalloc (sizeof (struct ns_display_info));
- memset (dpyinfo, 0, sizeof (struct ns_display_info));
+ dpyinfo = xzalloc (sizeof *dpyinfo);
ns_initialize_display_info (dpyinfo);
terminal = ns_create_terminal (dpyinfo);
- terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ terminal->kboard = xmalloc (sizeof *terminal->kboard);
init_kboard (terminal->kboard);
- KVAR (terminal->kboard, Vwindow_system) = Qns;
+ kset_window_system (terminal->kboard, Qns);
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
/* Don't let the initial kboard remain current longer than necessary.
ns_display_name_list);
dpyinfo->name_list_element = XCAR (ns_display_name_list);
- /* Set the name of the terminal. */
- terminal->name = (char *) xmalloc (SBYTES (display_name) + 1);
- strncpy (terminal->name, SDATA (display_name), SBYTES (display_name));
- terminal->name[SBYTES (display_name)] = 0;
+ terminal->name = xstrdup (SSDATA (display_name));
- UNBLOCK_INPUT;
+ unblock_input ();
if (!inhibit_x_resources)
{
if ( cl == nil )
{
Lisp_Object color_file, color_map, color;
- int r,g,b;
unsigned long c;
char *name;
for ( ; CONSP (color_map); color_map = XCDR (color_map))
{
color = XCAR (color_map);
- name = SDATA (XCAR (color));
+ name = SSDATA (XCAR (color));
c = XINT (XCDR (color));
[cl setColor:
[NSColor colorWithCalibratedRed: RED_FROM_ULONG (c) / 255.0
}
{
- char c[128];
#ifdef NS_IMPL_GNUSTEP
- strncpy (c, gnustep_base_version, sizeof (c));
+ Vwindow_system_version = build_string (gnustep_base_version);
#else
/*PSnextrelease (128, c); */
- snprintf (c, sizeof (c), "%g", NSAppKitVersionNumber);
+ char c[DBL_BUFSIZE_BOUND];
+ int len = dtoastr (c, sizeof c, 0, 0, NSAppKitVersionNumber);
+ Vwindow_system_version = make_unibyte_string (c, len);
#endif
- Vwindow_system_version = build_string (c);
}
delete_keyboard_wait_descriptor (0);
}
#endif /* MAC OS X menu setup */
- [NSApp run];
+ /* Register our external input/output types, used for determining
+ applicable services and also drag/drop eligibility. */
+ ns_send_types = [[NSArray arrayWithObjects: NSStringPboardType, nil] retain];
+ ns_return_types = [[NSArray arrayWithObjects: NSStringPboardType, nil]
+ retain];
+ ns_drag_types = [[NSArray arrayWithObjects:
+ NSStringPboardType,
+ NSTabularTextPboardType,
+ NSFilenamesPboardType,
+ NSURLPboardType,
+ NSColorPboardType,
+ NSFontPboardType, nil] retain];
+
+ [NSApp run];
+ ns_do_open_file = YES;
return dpyinfo;
}
/* code not reached in emacs.c after this is called by shut_down_emacs: */
if (STRINGP (Vauto_save_list_file_name))
- unlink (SDATA (Vauto_save_list_file_name));
+ unlink (SSDATA (Vauto_save_list_file_name));
if (sig == 0 || sig == SIGTERM)
{
}
else // force a stack trace to happen
{
- abort();
+ emacs_abort ();
}
}
return NSTerminateNow;
ret = NSRunAlertPanel(ns_app_name,
- [NSString stringWithUTF8String:"Exit requested. Would you like to Save Buffers and Exit, or Cancel the request?"],
+ @"Exit requested. Would you like to Save Buffers and Exit, or Cancel the request?",
@"Save Buffers and Exit", @"Cancel", nil);
if (ret == NSAlertDefaultReturn)
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
{
- [ns_pending_files addObject: file];
+ if (ns_do_open_file || not_in_argv (file))
+ [ns_pending_files addObject: file];
return YES;
}
/* Open a file as a temporary file */
- (BOOL)application: sender openTempFile: (NSString *)file
{
- [ns_pending_files addObject: file];
+ if (ns_do_open_file || not_in_argv (file))
+ [ns_pending_files addObject: file];
return YES;
}
/* Notification from the Workspace to open a file noninteractively (?) */
- (BOOL)application: sender openFileWithoutUI: (NSString *)file
{
- [ns_pending_files addObject: 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
{
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)
- [ns_pending_files addObject: file];
+ if (ns_do_open_file || not_in_argv (file))
+ [ns_pending_files addObject: file];
[self replyToOpenOrPrint: NSApplicationDelegateReplySuccess];
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;
- /* NSTRACE (fd_handler); */
+ int waiting = 1, nfds;
+ char c;
- if (select_nfds == 0)
- return;
+ SELECT_TYPE readfds, writefds, *wfds;
+ EMACS_TIME timeout, *tmo;
+ NSAutoreleasePool *pool = nil;
- memcpy (&t_readfds, &select_readfds, sizeof (fd_set));
+ /* NSTRACE (fd_handler); */
- select_timeout.tv_sec = select_timeout.tv_usec = 0;
- result = select (select_nfds, &t_readfds, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &select_timeout);
- if (result)
+ for (;;)
{
- memcpy (&select_readfds, &t_readfds, sizeof (fd_set));
- ns_send_appdefined (result);
+ [pool release];
+ pool = [[NSAutoreleasePool alloc] init];
+
+ 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;
+ }
}
}
{
[ns_pending_service_names addObject: userData];
[ns_pending_service_args addObject: [NSString stringWithUTF8String:
- SDATA (ns_string_from_pasteboard (pboard))]];
+ SSDATA (ns_string_from_pasteboard (pboard))]];
}
if (!emacs_event)
return;
- if (newFont = [sender convertFont:
- ((struct nsfont_info *)face->font)->nsfont])
+ if ((newFont = [sender convertFont:
+ ((struct nsfont_info *)face->font)->nsfont]))
{
SET_FRAME_GARBAGED (emacsframe); /* now needed as of 2008/10 */
if (!processingCompose)
{
+ /* When using screen sharing, no left or right information is sent,
+ so use Left key in those cases. */
int is_left_key, is_right_key;
code = ([[theEvent charactersIgnoringModifiers] length] == 0) ?
0 : [[theEvent charactersIgnoringModifiers] characterAtIndex: 0];
+
/* (Carbon way: [theEvent keyCode]) */
/* is it a "function key"? */
/* TODO: still need this? */
if (code == 0x2DC)
code = '~'; /* 0x7E */
- emacs_event->modifiers = 0;
+ if (code != 32) /* Space */
+ emacs_event->modifiers = 0;
emacs_event->kind
= code > 0xFF ? MULTIBYTE_CHAR_KEYSTROKE_EVENT : ASCII_KEYSTROKE_EVENT;
emacs_event->code = code;
}
-- (long)conversationIdentifier
+- (NSInteger)conversationIdentifier
{
- return (long)self;
+ return (NSInteger)self;
}
- (void)mouseDown: (NSEvent *)theEvent
{
NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil];
- Lisp_Object window;
NSTRACE (mouseDown);
return NO;
}
+- (void) updateFrameSize: (BOOL) delay;
+{
+ NSWindow *window = [self window];
+ NSRect wr = [window frame];
+#ifdef NS_IMPL_GNUSTEP
+ int extra = 3;
+#else
+ int extra = 0;
+#endif
+
+ int oldc = cols, oldr = rows;
+ int oldw = FRAME_PIXEL_WIDTH (emacsframe),
+ oldh = FRAME_PIXEL_HEIGHT (emacsframe);
+ int neww, newh;
+
+ cols = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (emacsframe, wr.size.width + extra);
+
+ if (cols < MINWIDTH)
+ cols = MINWIDTH;
+
+ rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES
+ (emacsframe, wr.size.height
+ - FRAME_NS_TITLEBAR_HEIGHT (emacsframe) + extra
+ - FRAME_TOOLBAR_HEIGHT (emacsframe));
+
+ if (rows < MINHEIGHT)
+ rows = MINHEIGHT;
+
+ neww = (int)wr.size.width - emacsframe->border_width;
+ newh = ((int)wr.size.height
+ - FRAME_NS_TITLEBAR_HEIGHT (emacsframe)
+ - FRAME_TOOLBAR_HEIGHT (emacsframe));
+
+ if (oldr != rows || oldc != cols || neww != oldw || newh != oldh)
+ {
+ NSView *view = FRAME_NS_VIEW (emacsframe);
+ FRAME_PIXEL_WIDTH (emacsframe) = neww;
+ FRAME_PIXEL_HEIGHT (emacsframe) = newh;
+ change_frame_size (emacsframe, rows, cols, 0, delay, 0);
+ SET_FRAME_GARBAGED (emacsframe);
+ cancel_mouse_face (emacsframe);
+ [view setFrame: NSMakeRect (0, 0, neww, newh)];
+ }
+}
- (NSSize)windowWillResize: (NSWindow *)sender toSize: (NSSize)frameSize
/* normalize frame to gridded text size */
char *pos = strstr (t, " — ");
if (pos)
*pos = '\0';
- old_title = (char *) xmalloc (strlen (t) + 1);
- strcpy (old_title, t);
+ old_title = xstrdup (t);
}
size_title = xmalloc (strlen (old_title) + 40);
esprintf (size_title, "%s — (%d x %d)", old_title, cols, rows);
- (void)windowDidResize: (NSNotification *)notification
{
+#ifdef NS_IMPL_GNUSTEP
NSWindow *theWindow = [notification object];
-#ifdef NS_IMPL_GNUSTEP
/* in GNUstep, at least currently, it's possible to get a didResize
without getting a willResize.. therefore we need to act as if we got
the willResize now */
x_set_window_size (emacsframe, 0, cols, rows);
else
{
- NSWindow *window = [self window];
- NSRect wr = [window frame];
- FRAME_PIXEL_WIDTH (emacsframe) = (int)wr.size.width
- - emacsframe->border_width;
- FRAME_PIXEL_HEIGHT (emacsframe) = (int)wr.size.height
- - FRAME_NS_TITLEBAR_HEIGHT (emacsframe)
- - FRAME_TOOLBAR_HEIGHT (emacsframe);
- change_frame_size (emacsframe, rows, cols, 0, 0, 1);
- SET_FRAME_GARBAGED (emacsframe);
- cancel_mouse_face (emacsframe);
+ [self updateFrameSize: YES];
}
}
#endif
Lisp_Object tem;
NSWindow *win;
NSButton *toggleButton;
- int vbextra = NS_SCROLL_BAR_WIDTH (f);
NSSize sz;
NSColor *col;
NSString *name;
tem = f->name;
name = [NSString stringWithUTF8String:
- NILP (tem) ? (unsigned char *)"Emacs" : SDATA (tem)];
+ NILP (tem) ? "Emacs" : SSDATA (tem)];
[win setTitle: name];
/* toolbar support */
tem = f->icon_name;
if (!NILP (tem))
[win setMiniwindowTitle:
- [NSString stringWithUTF8String: SDATA (tem)]];
+ [NSString stringWithUTF8String: SSDATA (tem)]];
{
NSScreen *screen = [win screen];
- (void)mouseEntered: (NSEvent *)theEvent
{
- NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil];
- struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (emacsframe);
NSTRACE (mouseEntered);
-
last_mouse_movement_time = EV_TIMESTAMP (theEvent);
}
- (void)mouseExited: (NSEvent *)theEvent
{
- NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil];
- NSRect r;
Mouse_HLInfo *hlinfo = emacsframe ? MOUSE_HL_INFO (emacsframe) : NULL;
NSTRACE (mouseExited);
if (context_menu_value == -1)
context_menu_value = [sender tag];
else
- find_and_call_menu_selection (emacsframe, emacsframe->menu_bar_items_used,
- emacsframe->menu_bar_vector,
- (void *)[sender tag]);
+ {
+ NSInteger tag = [sender tag];
+ find_and_call_menu_selection (emacsframe, emacsframe->menu_bar_items_used,
+ emacsframe->menu_bar_vector,
+ (void *)tag);
+ }
+
ns_send_appdefined (-1);
return self;
}
emacs_event->kind = TOOL_BAR_EVENT;
/* XSETINT (emacs_event->code, 0); */
emacs_event->arg = AREF (emacsframe->tool_bar_items,
- idx + TOOL_BAR_ITEM_KEY);
+ idx + TOOL_BAR_ITEM_KEY);
emacs_event->modifiers = EV_MODIFIERS (theEvent);
EV_TRAILER (theEvent);
return self;
@implementation EmacsWindow
+#ifdef NS_IMPL_COCOA
+- (id)accessibilityAttributeValue:(NSString *)attribute
+{
+ Lisp_Object str = Qnil;
+ struct frame *f = SELECTED_FRAME ();
+ struct buffer *curbuf = XBUFFER (XWINDOW (f->selected_window)->buffer);
+
+ if ([attribute isEqualToString:NSAccessibilityRoleAttribute])
+ return NSAccessibilityTextFieldRole;
+
+ if ([attribute isEqualToString:NSAccessibilitySelectedTextAttribute]
+ && curbuf && ! NILP (BVAR (curbuf, mark_active)))
+ {
+ str = ns_get_local_selection (QPRIMARY, QUTF8_STRING);
+ }
+ else if (curbuf && [attribute isEqualToString:NSAccessibilityValueAttribute])
+ {
+ if (! NILP (BVAR (curbuf, mark_active)))
+ str = ns_get_local_selection (QPRIMARY, QUTF8_STRING);
+
+ if (NILP (str))
+ {
+ ptrdiff_t start_byte = BUF_BEGV_BYTE (curbuf);
+ ptrdiff_t byte_range = BUF_ZV_BYTE (curbuf) - start_byte;
+ ptrdiff_t range = BUF_ZV (curbuf) - BUF_BEGV (curbuf);
+
+ if (! NILP (BVAR (curbuf, enable_multibyte_characters)))
+ str = make_uninit_multibyte_string (range, byte_range);
+ else
+ str = make_uninit_string (range);
+ /* To check: This returns emacs-utf-8, which is a superset of utf-8.
+ Is this a problem? */
+ memcpy (SDATA (str), BYTE_POS_ADDR (start_byte), byte_range);
+ }
+ }
+
+
+ if (! NILP (str))
+ {
+ if (CONSP (str) && SYMBOLP (XCAR (str)))
+ {
+ str = XCDR (str);
+ if (CONSP (str) && NILP (XCDR (str)))
+ str = XCAR (str);
+ }
+ if (STRINGP (str))
+ {
+ const char *utfStr = SSDATA (str);
+ NSString *nsStr = [NSString stringWithUTF8String: utfStr];
+ return nsStr;
+ }
+ }
+
+ return [super accessibilityAttributeValue:attribute];
+}
+#endif /* NS_IMPL_COCOA */
+
/* If we have multiple monitors, one above the other, we don't want to
restrict the height to just one monitor. So we override this. */
- (NSRect)constrainFrameRect:(NSRect)frameRect toScreen:(NSScreen *)screen
NSTRACE (constrainFrameRect);
if (nr_screens == 1)
- return [super constrainFrameRect:frameRect toScreen:screen];
-
+ {
+ NSRect r = [super constrainFrameRect:frameRect toScreen:screen];
+ return r;
+ }
+
if (f->output_data.ns->dont_constrain
|| ns_menu_bar_should_be_hidden ())
return frameRect;
- (void)setFrame: (NSRect)newRect
{
NSTRACE (EmacsScroller_setFrame);
-/* BLOCK_INPUT; */
+/* block_input (); */
pixel_height = NSHeight (newRect);
if (pixel_height == 0) pixel_height = 1;
min_portion = 20 / pixel_height;
[super setFrame: newRect];
[self display];
-/* UNBLOCK_INPUT; */
+/* unblock_input (); */
}
{
NSTRACE (EmacsScroller_dealloc);
if (!NILP (win))
- XWINDOW (win)->vertical_scroll_bar = Qnil;
+ wset_vertical_scroll_bar (XWINDOW (win), Qnil);
[super dealloc];
}
if (condemned)
{
EmacsView *view;
- BLOCK_INPUT;
+ block_input ();
/* ensure other scrollbar updates after deletion */
view = (EmacsView *)FRAME_NS_VIEW (frame);
if (view != nil)
view->scrollbarsNeedingUpdate++;
[self removeFromSuperview];
[self release];
- UNBLOCK_INPUT;
+ unblock_input ();
}
return self;
}
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);
}
/* undo hack in ns_fontname_to_xlfd, converting '$' to '-', '_' to ' '
also uppercase after '-' or ' ' */
- name[0] = toupper (name[0]);
+ name[0] = c_toupper (name[0]);
for (len =strlen (name), i =0; i<len; i++)
{
if (name[i] == '$')
{
name[i] = '-';
if (i+1<len)
- name[i+1] = toupper (name[i+1]);
+ name[i+1] = c_toupper (name[i+1]);
}
else if (name[i] == '_')
{
name[i] = ' ';
if (i+1<len)
- name[i+1] = toupper (name[i+1]);
+ name[i+1] = c_toupper (name[i+1]);
}
}
/*fprintf (stderr, "converted '%s' to '%s'\n",xlfd,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));
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
static Lisp_Object Qfloat_output_format;
-#include <math.h>
#include <float.h>
#include <ftoastr.h>
-/* Default to values appropriate for IEEE floating point. */
-#ifndef DBL_DIG
-#define DBL_DIG 15
-#endif
-
/* Avoid actual stack overflow in print. */
-static int print_depth;
+static ptrdiff_t print_depth;
/* Level of nesting inside outputting backquote in new style. */
-static int new_backquote_output;
+static ptrdiff_t new_backquote_output;
/* Detect most circularities to print finite output. */
#define PRINT_CIRCLE 200
static char *print_buffer;
/* Size allocated in print_buffer. */
-static EMACS_INT print_buffer_size;
+static ptrdiff_t print_buffer_size;
/* Chars stored in print_buffer. */
-static EMACS_INT print_buffer_pos;
+static ptrdiff_t print_buffer_pos;
/* Bytes stored in print_buffer. */
-static EMACS_INT print_buffer_pos_byte;
+static ptrdiff_t print_buffer_pos_byte;
Lisp_Object Qprint_escape_newlines;
static Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
N the object has been printed so we can refer to it as #N#.
print_number_index holds the largest N already used.
N has to be striclty larger than 0 since we need to distinguish -N. */
-static int print_number_index;
+static ptrdiff_t print_number_index;
static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
/* GDB resets this to zero on W32 to disable OutputDebugString calls. */
int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
\f
-/* Low level output routines for characters and strings */
+/* Low level output routines for characters and strings. */
/* Lisp functions to do output using a stream
must have the stream in a variable called printcharfun
and must start with PRINTPREPARE, end with PRINTFINISH,
and use PRINTDECLARE to declare common variables.
Use PRINTCHAR to output one character,
- or call strout to output a block of characters. */
+ or call strout to output a block of characters. */
#define PRINTDECLARE \
struct buffer *old = current_buffer; \
- EMACS_INT old_point = -1, start_point = -1; \
- EMACS_INT old_point_byte = -1, start_point_byte = -1; \
- int specpdl_count = SPECPDL_INDEX (); \
+ ptrdiff_t old_point = -1, start_point = -1; \
+ ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
+ ptrdiff_t specpdl_count = SPECPDL_INDEX (); \
int free_print_buffer = 0; \
int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
Lisp_Object original
} \
if (MARKERP (printcharfun)) \
{ \
- EMACS_INT marker_pos; \
+ ptrdiff_t marker_pos; \
if (! XMARKER (printcharfun)->buffer) \
error ("Marker does not point anywhere"); \
if (XMARKER (printcharfun)->buffer != current_buffer) \
} \
else \
{ \
- ptrdiff_t new_size = 1000; \
- print_buffer = (char *) xmalloc (new_size); \
+ int new_size = 1000; \
+ print_buffer = xmalloc (new_size); \
print_buffer_size = new_size; \
free_print_buffer = 1; \
} \
if (print_buffer_pos != print_buffer_pos_byte \
&& NILP (BVAR (current_buffer, enable_multibyte_characters))) \
{ \
- unsigned char *temp \
- = (unsigned char *) alloca (print_buffer_pos + 1); \
+ unsigned char *temp = alloca (print_buffer_pos + 1); \
copy_text ((unsigned char *) print_buffer, temp, \
print_buffer_pos_byte, 1, 0); \
insert_1_both ((char *) temp, print_buffer_pos, \
? PT - start_point : 0), \
old_point_byte + (old_point_byte >= start_point_byte \
? PT_BYTE - start_point_byte : 0)); \
- if (old != current_buffer) \
- set_buffer_internal (old);
+ set_buffer_internal (old);
#define PRINTCHAR(ch) printchar (ch, printcharfun)
if (NILP (fun))
{
- if (print_buffer_size - len <= print_buffer_pos_byte)
- {
- ptrdiff_t new_size;
- if (STRING_BYTES_BOUND / 2 < print_buffer_size)
- string_overflow ();
- new_size = print_buffer_size * 2;
- print_buffer = (char *) xrealloc (print_buffer, new_size);
- print_buffer_size = new_size;
- }
+ ptrdiff_t incr = len - (print_buffer_size - print_buffer_pos_byte);
+ if (0 < incr)
+ print_buffer =
+ xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
memcpy (print_buffer + print_buffer_pos_byte, str, len);
print_buffer_pos += 1;
print_buffer_pos_byte += len;
to data in a Lisp string. Otherwise that is not safe. */
static void
-strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte,
+strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
Lisp_Object printcharfun)
{
if (size < 0)
if (NILP (printcharfun))
{
- if (print_buffer_size - size_byte < print_buffer_pos_byte)
- {
- ptrdiff_t new_size;
- if (STRING_BYTES_BOUND / 2 - size_byte < print_buffer_size)
- string_overflow ();
- new_size = print_buffer_size * 2 + size_byte;
- print_buffer = (char *) xrealloc (print_buffer, new_size);
- print_buffer_size = new_size;
- }
+ ptrdiff_t incr = size_byte - (print_buffer_size - print_buffer_pos_byte);
+ if (0 < incr)
+ print_buffer = xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
print_buffer_pos += size;
print_buffer_pos_byte += size_byte;
else
{
/* PRINTCHARFUN is a Lisp function. */
- EMACS_INT i = 0;
+ ptrdiff_t i = 0;
if (size == size_byte)
{
{
if (EQ (printcharfun, Qt) || NILP (printcharfun))
{
- EMACS_INT chars;
+ ptrdiff_t chars;
if (print_escape_nonascii)
string = string_escape_byte8 (string);
convert STRING to a multibyte string containing the same
character codes. */
Lisp_Object newstr;
- EMACS_INT bytes;
+ ptrdiff_t bytes;
chars = SBYTES (string);
bytes = count_size_as_multibyte (SDATA (string), chars);
if (EQ (printcharfun, Qt))
{
/* Output to echo area. */
- EMACS_INT nbytes = SBYTES (string);
- char *buffer;
+ ptrdiff_t nbytes = SBYTES (string);
/* 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 ();
}
{
/* Otherwise, string may be relocated by printing one char.
So re-fetch the string address for each character. */
- EMACS_INT i;
- EMACS_INT size = SCHARS (string);
- EMACS_INT size_byte = SBYTES (string);
+ ptrdiff_t i;
+ ptrdiff_t size = SCHARS (string);
+ ptrdiff_t size_byte = SBYTES (string);
struct gcpro gcpro1;
GCPRO1 (string);
if (size == size_byte)
void
temp_output_buffer_setup (const char *bufname)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
register struct buffer *old = current_buffer;
register Lisp_Object buf;
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (Fget_buffer_create (build_string (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_directory (current_buffer, BVAR (old, directory));
+ bset_read_only (current_buffer, Qnil);
+ bset_filename (current_buffer, Qnil);
+ bset_undo_list (current_buffer, 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_enable_multibyte_characters
+ (current_buffer, BVAR (&buffer_defaults, enable_multibyte_characters));
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
(Lisp_Object object, Lisp_Object noescape)
{
Lisp_Object printcharfun;
+ bool prev_abort_on_gc;
/* struct gcpro gcpro1, gcpro2; */
Lisp_Object save_deactivate_mark;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct buffer *previous;
specbind (Qinhibit_modification_hooks, Qt);
No need for specbind, since errors deactivate the mark. */
save_deactivate_mark = Vdeactivate_mark;
/* GCPRO2 (object, save_deactivate_mark); */
- abort_on_gc++;
+ prev_abort_on_gc = abort_on_gc;
+ abort_on_gc = 1;
printcharfun = Vprin1_to_string_buffer;
PRINTPREPARE;
Vdeactivate_mark = save_deactivate_mark;
/* UNGCPRO; */
- abort_on_gc--;
+ abort_on_gc = prev_abort_on_gc;
return unbind_to (count, object);
}
(Lisp_Object character)
{
CHECK_NUMBER (character);
- putc ((int) XINT (character), stderr);
+ putc (XINT (character) & 0xFF, stderr);
#ifdef WINDOWSNT
/* Send the output to a debugger (nothing happens if there isn't one). */
{
if (initial_stderr_stream != NULL)
{
- BLOCK_INPUT;
+ block_input ();
fclose (stderr);
- UNBLOCK_INPUT;
+ unblock_input ();
}
stderr = initial_stderr_stream;
initial_stderr_stream = NULL;
{
Lisp_Object errname, errmsg, file_error, tail;
struct gcpro gcpro1;
- int i;
if (context != 0)
write_string_1 (context, -1, stream);
if (!NILP (caller) && SYMBOLP (caller))
{
Lisp_Object cname = SYMBOL_NAME (caller);
- char *name = alloca (SBYTES (cname));
- memcpy (name, SDATA (cname), SBYTES (cname));
- message_dolog (name, SBYTES (cname), 0, 0);
+ ptrdiff_t cnamelen = SBYTES (cname);
+ USE_SAFE_ALLOCA;
+ char *name = SAFE_ALLOCA (cnamelen);
+ memcpy (name, SDATA (cname), cnamelen);
+ message_dolog (name, cnamelen, 0, 0);
message_dolog (": ", 2, 0, 0);
+ SAFE_FREE ();
}
errname = Fcar (data);
}
else
{
- Lisp_Object error_conditions;
+ Lisp_Object error_conditions = Fget (errname, Qerror_conditions);
errmsg = Fget (errname, Qerror_message);
- error_conditions = Fget (errname, Qerror_conditions);
file_error = Fmemq (Qfile_error, error_conditions);
}
if (!NILP (file_error) && CONSP (tail))
errmsg = XCAR (tail), tail = XCDR (tail);
- if (STRINGP (errmsg))
- Fprinc (errmsg, stream);
- else
- write_string_1 ("peculiar error", -1, stream);
+ {
+ const char *sep = ": ";
- for (i = 0; CONSP (tail); tail = XCDR (tail), i = 1)
- {
- Lisp_Object obj;
+ if (!STRINGP (errmsg))
+ write_string_1 ("peculiar error", -1, stream);
+ else if (SCHARS (errmsg))
+ Fprinc (errmsg, stream);
+ else
+ sep = NULL;
- write_string_1 (i ? ", " : ": ", 2, stream);
- obj = XCAR (tail);
- if (!NILP (file_error) || EQ (errname, Qend_of_file))
- Fprinc (obj, stream);
- else
- Fprin1 (obj, stream);
- }
+ for (; CONSP (tail); tail = XCDR (tail), sep = ", ")
+ {
+ Lisp_Object obj;
+
+ if (sep)
+ write_string_1 (sep, 2, stream);
+ obj = XCAR (tail);
+ if (!NILP (file_error)
+ || EQ (errname, Qend_of_file) || EQ (errname, Quser_error))
+ Fprinc (obj, stream);
+ else
+ Fprin1 (obj, stream);
+ }
+ }
UNGCPRO;
}
* Given the above, the buffer must be least FLOAT_TO_STRING_BUFSIZE bytes.
*/
-void
+int
float_to_string (char *buf, double data)
{
char *cp;
int width;
+ int len;
/* Check for plus infinity in a way that won't lose
if there is no plus infinity. */
if (data == data / 2 && data > 1.0)
{
- strcpy (buf, "1.0e+INF");
- return;
+ static char const infinity_string[] = "1.0e+INF";
+ strcpy (buf, infinity_string);
+ return sizeof infinity_string - 1;
}
/* Likewise for minus infinity. */
if (data == data / 2 && data < -1.0)
{
- strcpy (buf, "-1.0e+INF");
- return;
+ static char const minus_infinity_string[] = "-1.0e+INF";
+ strcpy (buf, minus_infinity_string);
+ return sizeof minus_infinity_string - 1;
}
/* Check for NaN in a way that won't fail if there are no NaNs. */
if (! (data * 0.0 >= 0.0))
{
/* Prepend "-" if the NaN's sign bit is negative.
The sign bit of a double is the bit that is 1 in -0.0. */
+ static char const NaN_string[] = "0.0e+NaN";
int i;
union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
+ int negative = 0;
u_data.d = data;
u_minus_zero.d = - 0.0;
for (i = 0; i < sizeof (double); i++)
if (u_data.c[i] & u_minus_zero.c[i])
{
- *buf++ = '-';
+ *buf = '-';
+ negative = 1;
break;
}
- strcpy (buf, "0.0e+NaN");
- return;
+ strcpy (buf + negative, NaN_string);
+ return negative + sizeof NaN_string - 1;
}
if (NILP (Vfloat_output_format)
{
/* Generate the fewest number of digits that represent the
floating point value without losing information. */
- dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data);
+ len = dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data);
/* The decimal point must be printed, or the byte compiler can
get confused (Bug#8033). */
width = 1;
if (cp[1] != 0)
goto lose;
- sprintf (buf, SSDATA (Vfloat_output_format), data);
+ len = sprintf (buf, SSDATA (Vfloat_output_format), data);
}
/* Make sure there is a decimal point with digit after, or an
{
cp[1] = '0';
cp[2] = 0;
+ len++;
}
else if (*cp == 0)
{
*cp++ = '.';
*cp++ = '0';
*cp++ = 0;
+ len += 2;
}
}
+
+ return len;
}
\f
if (HASH_TABLE_P (Vprint_number_table))
{ /* Remove unnecessary objects, which appear only once in OBJ;
- that is, whose status is Qt.
- Maybe a better way to do that is to copy elements to
- a new hash table. */
+ that is, whose status is Qt. */
struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
- EMACS_INT i;
+ ptrdiff_t i;
for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i))
print_preprocess (Lisp_Object obj)
{
int i;
- EMACS_INT size;
+ ptrdiff_t size;
int loop_count = 0;
Lisp_Object halftail;
- /* Give up if we go so deep that print_object will get an error. */
- /* See similar code in print_object. */
- if (print_depth >= PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-
/* Avoid infinite recursion for circular nested structure
in the case where Vprint_circle is nil. */
if (NILP (Vprint_circle))
{
+ /* Give up if we go so deep that print_object will get an error. */
+ /* See similar code in print_object. */
+ if (print_depth >= PRINT_CIRCLE)
+ error ("Apparently circular structure being printed");
+
for (i = 0; i < print_depth; i++)
if (EQ (obj, being_printed[i]))
return;
{
case Lisp_String:
/* A string may have text properties, which can be circular. */
- traverse_intervals_noorder (STRING_INTERVALS (obj),
+ traverse_intervals_noorder (string_intervals (obj),
print_preprocess_string, Qnil);
break;
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++)
- print_preprocess (XVECTOR (obj)->contents[i]);
+ print_preprocess (AREF (obj, i));
if (HASH_TABLE_P (obj))
{ /* For hash tables, the key_and_value slot is past
`size' because it needs to be marked specially in case
#define PRINT_STRING_NON_CHARSET_FOUND 1
#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
-/* Bitwise or of the above macros. */
+/* Bitwise or of the above macros. */
static int print_check_string_result;
static void
|| ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
int i, c;
- EMACS_INT charpos = interval->position;
- EMACS_INT bytepos = string_char_to_byte (string, charpos);
+ ptrdiff_t charpos = interval->position;
+ ptrdiff_t bytepos = string_char_to_byte (string, charpos);
Lisp_Object charset;
charset = XCAR (XCDR (val));
print_prune_string_charset (Lisp_Object string)
{
print_check_string_result = 0;
- traverse_intervals (STRING_INTERVALS (string), 0,
+ traverse_intervals (string_intervals (string), 0,
print_check_string_charset_prop, string);
if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
QUIT;
- /* See similar code in print_preprocess. */
- if (print_depth >= PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-
/* Detect circularities and truncate them. */
- if (PRINT_CIRCLE_CANDIDATE_P (obj))
+ if (NILP (Vprint_circle))
{
- if (NILP (Vprint_circle) && NILP (Vprint_gensym))
- {
- /* Simple but incomplete way. */
- int i;
- for (i = 0; i < print_depth; i++)
- if (EQ (obj, being_printed[i]))
- {
- sprintf (buf, "#%d", i);
- strout (buf, -1, -1, printcharfun);
- return;
- }
- being_printed[print_depth] = obj;
- }
- else
+ /* Simple but incomplete way. */
+ int i;
+
+ /* See similar code in print_preprocess. */
+ if (print_depth >= PRINT_CIRCLE)
+ error ("Apparently circular structure being printed");
+
+ for (i = 0; i < print_depth; i++)
+ if (EQ (obj, being_printed[i]))
+ {
+ int len = sprintf (buf, "#%d", i);
+ strout (buf, len, len, printcharfun);
+ return;
+ }
+ being_printed[print_depth] = obj;
+ }
+ else if (PRINT_CIRCLE_CANDIDATE_P (obj))
+ {
+ /* With the print-circle feature. */
+ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+ if (INTEGERP (num))
{
- /* With the print-circle feature. */
- Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
- if (INTEGERP (num))
+ EMACS_INT n = XINT (num);
+ if (n < 0)
+ { /* Add a prefix #n= if OBJ has not yet been printed;
+ that is, its status field is nil. */
+ int len = sprintf (buf, "#%"pI"d=", -n);
+ strout (buf, len, len, printcharfun);
+ /* OBJ is going to be printed. Remember that fact. */
+ Fputhash (obj, make_number (- n), Vprint_number_table);
+ }
+ else
{
- EMACS_INT n = XINT (num);
- if (n < 0)
- { /* Add a prefix #n= if OBJ has not yet been printed;
- that is, its status field is nil. */
- sprintf (buf, "#%"pI"d=", -n);
- strout (buf, -1, -1, printcharfun);
- /* OBJ is going to be printed. Remember that fact. */
- Fputhash (obj, make_number (- n), Vprint_number_table);
- }
- else
- {
- /* Just print #n# if OBJ has already been printed. */
- sprintf (buf, "#%"pI"d#", n);
- strout (buf, -1, -1, printcharfun);
- return;
- }
+ /* Just print #n# if OBJ has already been printed. */
+ int len = sprintf (buf, "#%"pI"d#", n);
+ strout (buf, len, len, printcharfun);
+ return;
}
}
}
switch (XTYPE (obj))
{
case_Lisp_Int:
- sprintf (buf, "%"pI"d", XINT (obj));
- strout (buf, -1, -1, printcharfun);
+ {
+ int len = sprintf (buf, "%"pI"d", XINT (obj));
+ strout (buf, len, len, printcharfun);
+ }
break;
case Lisp_Float:
{
char pigbuf[FLOAT_TO_STRING_BUFSIZE];
-
- float_to_string (pigbuf, XFLOAT_DATA (obj));
- strout (pigbuf, -1, -1, printcharfun);
+ int len = float_to_string (pigbuf, XFLOAT_DATA (obj));
+ strout (pigbuf, len, len, printcharfun);
}
break;
print_string (obj, printcharfun);
else
{
- register EMACS_INT i_byte;
+ register ptrdiff_t i_byte;
struct gcpro gcpro1;
unsigned char *str;
- EMACS_INT size_byte;
+ ptrdiff_t size_byte;
/* 1 means we must ensure that the next character we output
cannot be taken as part of a hex character escape. */
int need_nonhex = 0;
if (! EQ (Vprint_charset_text_property, Qt))
obj = print_prune_string_charset (obj);
- if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
+ if (string_intervals (obj))
{
PRINTCHAR ('#');
PRINTCHAR ('(');
when found in a multibyte string, always use a hex escape
so it reads back as multibyte. */
char outbuf[50];
+ int len;
if (CHAR_BYTE8_P (c))
- sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
+ len = sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
else
{
- sprintf (outbuf, "\\x%04x", c);
+ len = sprintf (outbuf, "\\x%04x", c);
need_nonhex = 1;
}
- strout (outbuf, -1, -1, printcharfun);
+ strout (outbuf, len, len, printcharfun);
}
else if (! multibyte
&& SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
print single-byte non-ASCII string chars
using octal escapes. */
char outbuf[5];
- sprintf (outbuf, "\\%03o", c);
- strout (outbuf, -1, -1, printcharfun);
+ int len = sprintf (outbuf, "\\%03o", c);
+ strout (outbuf, len, len, printcharfun);
}
else
{
}
PRINTCHAR ('\"');
- if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
+ if (string_intervals (obj))
{
- traverse_intervals (STRING_INTERVALS (obj),
+ traverse_intervals (string_intervals (obj),
0, print_interval, printcharfun);
PRINTCHAR (')');
}
register unsigned char *p = SDATA (SYMBOL_NAME (obj));
register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
register int c;
- int i, i_byte;
- EMACS_INT size_byte;
+ ptrdiff_t i, i_byte;
+ ptrdiff_t size_byte;
Lisp_Object name;
name = SYMBOL_NAME (obj);
/* Simple but incomplete way. */
if (i != 0 && EQ (obj, halftail))
{
- sprintf (buf, " . #%"pMd, i / 2);
- strout (buf, -1, -1, printcharfun);
+ int len = sprintf (buf, " . #%"pMd, i / 2);
+ strout (buf, len, len, printcharfun);
goto end_of_list;
}
}
else if (BOOL_VECTOR_P (obj))
{
ptrdiff_t i;
- register unsigned char c;
+ int len;
+ unsigned char c;
struct gcpro gcpro1;
- EMACS_INT size_in_chars
+ ptrdiff_t size_in_chars
= ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
PRINTCHAR ('#');
PRINTCHAR ('&');
- sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size);
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size);
+ strout (buf, len, len, printcharfun);
PRINTCHAR ('\"');
/* Don't print more characters than the specified maximum.
}
else if (WINDOWP (obj))
{
+ int len;
strout ("#<window ", -1, -1, printcharfun);
- sprintf (buf, "%"pI"d", XFASTINT (XWINDOW (obj)->sequence_number));
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "%d", XWINDOW (obj)->sequence_number);
+ strout (buf, len, len, printcharfun);
if (!NILP (XWINDOW (obj)->buffer))
{
strout (" on ", -1, -1, printcharfun);
- print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun);
+ print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name),
+ printcharfun);
}
PRINTCHAR ('>');
}
else if (TERMINALP (obj))
{
+ int len;
struct terminal *t = XTERMINAL (obj);
strout ("#<terminal ", -1, -1, printcharfun);
- sprintf (buf, "%d", t->id);
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "%d", t->id);
+ strout (buf, len, len, printcharfun);
if (t->name)
{
strout (" on ", -1, -1, printcharfun);
else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- int i;
- EMACS_INT real_size, size;
+ ptrdiff_t i;
+ ptrdiff_t real_size, size;
+ int len;
#if 0
strout ("#<hash-table", -1, -1, printcharfun);
if (SYMBOLP (h->test))
PRINTCHAR (' ');
strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun);
PRINTCHAR (' ');
- sprintf (buf, "%"pI"d/%"pI"d", h->count, ASIZE (h->next));
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "%"pD"d/%"pD"d", h->count, ASIZE (h->next));
+ strout (buf, len, len, printcharfun);
}
- sprintf (buf, " %p", h);
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, " %p", h);
+ strout (buf, len, len, printcharfun);
PRINTCHAR ('>');
#endif
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
/* Always print the size. */
- sprintf (buf, "#s(hash-table size %"pI"d", ASIZE (h->next));
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next));
+ strout (buf, len, len, printcharfun);
if (!NILP (h->test))
{
}
else if (BUFFERP (obj))
{
- if (NILP (BVAR (XBUFFER (obj), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (obj)))
strout ("#<killed buffer>", -1, -1, printcharfun);
else if (escapeflag)
{
}
else if (FRAMEP (obj))
{
+ int len;
+ Lisp_Object frame_name = XFRAME (obj)->name;
+
strout ((FRAME_LIVE_P (XFRAME (obj))
? "#<frame " : "#<dead frame "),
-1, -1, printcharfun);
- print_string (XFRAME (obj)->name, printcharfun);
- sprintf (buf, " %p", XFRAME (obj));
- strout (buf, -1, -1, printcharfun);
+ if (!STRINGP (frame_name))
+ {
+ /* A frame could be too young and have no name yet;
+ don't crash. */
+ if (SYMBOLP (frame_name))
+ frame_name = Fsymbol_name (frame_name);
+ else /* can't happen: name should be either nil or string */
+ frame_name = build_string ("*INVALID*FRAME*NAME*");
+ }
+ print_string (frame_name, printcharfun);
+ len = sprintf (buf, " %p", XFRAME (obj));
+ strout (buf, len, len, printcharfun);
PRINTCHAR ('>');
}
else if (FONTP (obj))
{
- EMACS_INT i;
+ int i;
if (! FONT_OBJECT_P (obj))
{
}
else
{
- EMACS_INT size = ASIZE (obj);
+ ptrdiff_t size = ASIZE (obj);
if (COMPILEDP (obj))
{
PRINTCHAR ('#');
{
register int i;
register Lisp_Object tem;
- EMACS_INT real_size = size;
+ ptrdiff_t real_size = size;
/* Don't print more elements than the specified maximum. */
if (NATNUMP (Vprint_length)
for (i = 0; i < size; i++)
{
if (i) PRINTCHAR (' ');
- tem = XVECTOR (obj)->contents[i];
+ tem = AREF (obj, i);
print_object (tem, printcharfun, escapeflag);
}
if (size < real_size)
strout ("in no buffer", -1, -1, printcharfun);
else
{
- sprintf (buf, "at %"pI"d", marker_position (obj));
- strout (buf, -1, -1, printcharfun);
+ int len = sprintf (buf, "at %"pD"d", marker_position (obj));
+ strout (buf, len, len, printcharfun);
strout (" in ", -1, -1, printcharfun);
print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
}
strout ("in no buffer", -1, -1, printcharfun);
else
{
- sprintf (buf, "from %"pI"d to %"pI"d in ",
- marker_position (OVERLAY_START (obj)),
- marker_position (OVERLAY_END (obj)));
- strout (buf, -1, -1, printcharfun);
+ int len = sprintf (buf, "from %"pD"d to %"pD"d in ",
+ marker_position (OVERLAY_START (obj)),
+ marker_position (OVERLAY_END (obj)));
+ strout (buf, len, len, printcharfun);
print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
printcharfun);
}
case Lisp_Misc_Save_Value:
strout ("#<save_value ", -1, -1, printcharfun);
- sprintf (buf, "ptr=%p int=%"pD"d",
- XSAVE_VALUE (obj)->pointer,
- XSAVE_VALUE (obj)->integer);
- strout (buf, -1, -1, printcharfun);
+ {
+ int len = sprintf (buf, "ptr=%p int=%"pD"d",
+ XSAVE_VALUE (obj)->pointer,
+ XSAVE_VALUE (obj)->integer);
+ strout (buf, len, len, printcharfun);
+ }
PRINTCHAR ('>');
break;
default:
badtype:
{
+ int len;
/* We're in trouble if this happens!
- Probably should just abort () */
+ Probably should just emacs_abort (). */
strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun);
if (MISCP (obj))
- sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
+ len = sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
else if (VECTORLIKEP (obj))
- sprintf (buf, "(PVEC 0x%08"pI"x)", ASIZE (obj));
+ len = sprintf (buf, "(PVEC 0x%08"pD"x)", ASIZE (obj));
else
- sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
- strout (buf, -1, -1, printcharfun);
+ len = sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
+ strout (buf, len, len, printcharfun);
strout (" Save your buffers immediately and please report this bug>",
-1, -1, printcharfun);
}
Vprint_gensym = Qnil;
DEFVAR_LISP ("print-circle", Vprint_circle,
- doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
+ doc: /* Non-nil means print recursive structures using #N= and #N# syntax.
If nil, printing proceeds recursively and may lead to
`max-lisp-eval-depth' being exceeded or an error may occur:
\"Apparently circular structure being printed.\" Also see
Vprint_circle = Qnil;
DEFVAR_LISP ("print-continuous-numbering", Vprint_continuous_numbering,
- doc: /* *Non-nil means number continuously across print calls.
+ doc: /* Non-nil means number continuously across print calls.
This affects the numbers printed for #N= labels and #M# references.
See also `print-circle', `print-gensym', and `print-number-table'.
This variable should not be set with `setq'; bind it with a `let' instead. */);
#include <config.h>
-#include <signal.h>
+
+#define PROCESS_INLINE EXTERN_INLINE
+
#include <stdio.h>
#include <errno.h>
-#include <setjmp.h>
#include <sys/types.h> /* Some typedefs are used in sys/file.h. */
#include <sys/file.h>
#include <sys/stat.h>
-#include <setjmp.h>
-
#include <unistd.h>
#include <fcntl.h>
#include <bsdtty.h>
#endif
+#ifdef USG5_4
+# include <sys/stream.h>
+# include <sys/stropts.h>
+#endif
+
#ifdef HAVE_RES_INIT
#include <netinet/in.h>
#include <arpa/nameser.h>
#include "systty.h"
#include "window.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "process.h"
#include "frame.h"
#include "gnutls.h"
#endif
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
+
#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
#include "xgselect.h"
#endif
-#ifdef HAVE_NS
-#include "nsterm.h"
+
+#ifndef WNOHANG
+# undef waitpid
+# define waitpid(pid, status, options) wait (status)
+#endif
+#ifndef WUNTRACED
+# define WUNTRACED 0
+#endif
+
+/* Work around GCC 4.7.0 bug with strict overflow checking; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
+ These lines can be removed once the GCC bug is fixed. */
+#if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wstrict-overflow"
#endif
Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
static Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
static Lisp_Object Qlast_nonmenu_event;
-/* QCfamily is declared and initialized in xfaces.c,
- QCfilter in keyboard.c. */
-extern Lisp_Object QCfamily, QCfilter;
-
-/* Qexit is declared and initialized in eval.c. */
-
-/* QCfamily is defined in xfaces.c. */
-extern Lisp_Object QCfamily;
-/* QCfilter is defined in keyboard.c. */
-extern Lisp_Object QCfilter;
#define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
-#define NETCONN1_P(p) (EQ ((p)->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))
+#define SERIALCONN1_P(p) (EQ (p->type, Qserial))
#ifndef HAVE_H_ERRNO
extern int h_errno;
#endif
/* Number of events of change of status of a process. */
-static int process_tick;
+static EMACS_INT process_tick;
/* Number of events for which the user or sentinel has been notified. */
-static int update_tick;
+static EMACS_INT update_tick;
/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
"non-destructive" select. So we require either native select,
or emulation of select using FIONREAD. */
-#ifdef BROKEN_DATAGRAM_SOCKETS
-#undef DATAGRAM_SOCKETS
-#else
-#ifndef DATAGRAM_SOCKETS
-#if defined (HAVE_SELECT) || defined (FIONREAD)
-#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
-#define DATAGRAM_SOCKETS
-#endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
-#endif /* HAVE_SELECT || FIONREAD */
-#endif /* DATAGRAM_SOCKETS */
-#endif /* BROKEN_DATAGRAM_SOCKETS */
+#ifndef BROKEN_DATAGRAM_SOCKETS
+# if defined HAVE_SELECT || defined USABLE_FIONREAD
+# if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
+# define DATAGRAM_SOCKETS
+# endif
+# endif
+#endif
#if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
# define HAVE_SEQPACKET
#endif
#if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
-#ifdef EMACS_HAS_USECS
#define ADAPTIVE_READ_BUFFERING
#endif
-#endif
#ifdef ADAPTIVE_READ_BUFFERING
-#define READ_OUTPUT_DELAY_INCREMENT 10000
+#define READ_OUTPUT_DELAY_INCREMENT (EMACS_TIME_RESOLUTION / 100)
#define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
#define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
#define process_output_delay_count 0
#endif
-static Lisp_Object Fget_process (Lisp_Object);
static void create_process (Lisp_Object, char **, Lisp_Object);
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
static int keyboard_bit_set (SELECT_TYPE *);
#endif
static void deactivate_process (Lisp_Object);
static void status_notify (struct Lisp_Process *);
static int read_process_output (Lisp_Object, int);
+static void handle_child_signal (int);
static void create_pty (Lisp_Object);
/* If we support a window system, turn on the code to poll periodically
to detect C-g. It isn't actually used when doing interrupt input. */
-#if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_ASYNC_EVENTS)
+#ifdef HAVE_WINDOW_SYSTEM
#define POLL_FOR_INPUT
#endif
/* Maximum number of bytes to send to a pty without an eof. */
static int pty_max_bytes;
+/* These setters are used only in this file, so they can be private. */
+static inline void
+pset_buffer (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->buffer = val;
+}
+static inline void
+pset_command (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->command = val;
+}
+static inline void
+pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->decode_coding_system = val;
+}
+static inline void
+pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->decoding_buf = val;
+}
+static inline void
+pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->encode_coding_system = val;
+}
+static inline void
+pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->encoding_buf = val;
+}
+static inline void
+pset_filter (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->filter = val;
+}
+static inline void
+pset_log (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->log = val;
+}
+static inline void
+pset_mark (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->mark = val;
+}
+static inline void
+pset_name (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->name = val;
+}
+static inline void
+pset_plist (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->plist = val;
+}
+static inline void
+pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->sentinel = val;
+}
+static inline void
+pset_status (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->status = val;
+}
+static inline void
+pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->tty_name = val;
+}
+static inline void
+pset_type (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->type = val;
+}
+static inline void
+pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->write_queue = val;
+}
+
\f
static struct fd_callback_data
void
add_read_fd (int fd, fd_callback func, void *data)
{
- xassert (fd < MAXDESC);
+ eassert (fd < MAXDESC);
add_keyboard_wait_descriptor (fd);
fd_callback_info[fd].func = func;
void
delete_read_fd (int fd)
{
- xassert (fd < MAXDESC);
+ eassert (fd < MAXDESC);
delete_keyboard_wait_descriptor (fd);
fd_callback_info[fd].condition &= ~FOR_READ;
void
add_write_fd (int fd, fd_callback func, void *data)
{
- xassert (fd < MAXDESC);
+ eassert (fd < MAXDESC);
FD_SET (fd, &write_mask);
if (fd > max_input_desc)
max_input_desc = fd;
{
int lim = max_input_desc;
- xassert (fd < MAXDESC);
+ eassert (fd < MAXDESC);
FD_CLR (fd, &write_mask);
fd_callback_info[fd].condition &= ~FOR_WRITE;
if (fd_callback_info[fd].condition == 0)
update_status (struct Lisp_Process *p)
{
eassert (p->raw_status_new);
- p->status = status_convert (p->raw_status);
+ pset_status (p, status_convert (p->raw_status));
p->raw_status_new = 0;
}
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)),
{
int c1, c2;
- string = make_unibyte_string (signame, strlen (signame));
+ string = build_unibyte_string (signame);
if (! NILP (Vlocale_coding_system))
string = (code_convert_string_norecord
(string, Vlocale_coding_system, 0));
printmax_t i;
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. */
+ pset_status (p, Qrun);
+ pset_mark (p, 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. */
p->infd = -1;
p->outfd = -1;
- p->tick = 0;
- p->update_tick = 0;
- p->pid = 0;
- p->pty_flag = 0;
- p->raw_status_new = 0;
- p->status = Qrun;
- p->mark = Fmake_marker ();
- p->kill_without_query = 0;
-
-#ifdef ADAPTIVE_READ_BUFFERING
- p->adaptive_read_buffering = 0;
- p->read_output_delay = 0;
- p->read_output_skip = 0;
-#endif
#ifdef HAVE_GNUTLS
p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
- /* Default log level. */
- p->gnutls_log_level = 0;
- /* GnuTLS handshakes attempted for this connection. */
- p->gnutls_handshakes_tried = 0;
- p->gnutls_p = 0;
- p->gnutls_state = NULL;
- p->gnutls_x509_cred = NULL;
- p->gnutls_anon_cred = NULL;
#endif
/* If name is already in use, modify it until it is unused. */
{
tem = Fget_process (name1);
if (NILP (tem)) break;
- sprintf (suffix, "<%"pMd">", i);
- name1 = concat2 (name, build_string (suffix));
+ name1 = concat2 (name, make_formatted_string (suffix, "<%"pMd">", i));
}
name = name1;
- p->name = name;
+ pset_name (p, name);
XSETPROCESS (val, p);
Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
return val;
#ifdef SIGCHLD
/* Fdelete_process promises to immediately forget about the process, but in
reality, Emacs needs to remember those processes until they have been
- treated by sigchld_handler; otherwise this handler would consider the
+ treated by the SIGCHLD handler; otherwise this handler would consider the
process as being synchronous and say that the synchronous process is
dead. */
static Lisp_Object deleted_pid_list;
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
- p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
+ pset_status (p, Fcons (Qexit, Fcons (make_number (0), Qnil)));
p->tick = ++process_tick;
status_notify (p);
redisplay_preserve_echo_area (13);
{
#ifdef SIGCHLD
Lisp_Object symbol;
- /* Assignment to EMACS_INT stops GCC whining about limited range
- of data type. */
- EMACS_INT pid = p->pid;
+ pid_t pid = p->pid;
/* No problem storing the pid here, as it is still in Vprocess_alist. */
deleted_pid_list = Fcons (make_fixnum_or_float (pid),
#endif
{
Fkill_process (process, Qnil);
- /* Do this now, since remove_process will make sigchld_handler do nothing. */
- p->status
- = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
+ /* Do this now, since remove_process will make the
+ SIGCHLD handler do nothing. */
+ pset_status (p, Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)));
p->tick = ++process_tick;
status_notify (p);
redisplay_preserve_echo_area (13);
For a network connection, this value is nil. */)
(register Lisp_Object process)
{
- /* Assignment to EMACS_INT stops GCC whining about limited range of
- data type. */
- EMACS_INT pid;
+ pid_t pid;
CHECK_PROCESS (process);
pid = XPROCESS (process)->pid;
if (!NILP (buffer))
CHECK_BUFFER (buffer);
p = XPROCESS (process);
- p->buffer = buffer;
+ pset_buffer (p, buffer);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
- p->childp = Fplist_put (p->childp, QCbuffer, buffer);
+ pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
setup_process_coding_systems (process);
return buffer;
}
}
}
- p->filter = filter;
+ pset_filter (p, filter);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
- p->childp = Fplist_put (p->childp, QCfilter, filter);
+ pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
setup_process_coding_systems (process);
return filter;
}
CHECK_PROCESS (process);
p = XPROCESS (process);
- p->sentinel = sentinel;
+ pset_sentinel (p, sentinel);
if (NETCONN1_P (p) || SERIALCONN1_P (p))
- p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
+ pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
return sentinel;
}
(register Lisp_Object process, Lisp_Object height, Lisp_Object width)
{
CHECK_PROCESS (process);
- CHECK_NATNUM (height);
- CHECK_NATNUM (width);
+ CHECK_RANGED_INTEGER (height, 0, INT_MAX);
+ CHECK_RANGED_INTEGER (width, 0, INT_MAX);
if (XPROCESS (process)->infd < 0
|| set_window_size (XPROCESS (process)->infd,
return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
}
-#ifdef DATAGRAM_SOCKETS
-static Lisp_Object Fprocess_datagram_address (Lisp_Object);
-#endif
-
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1, 2, 0,
doc: /* Return the contact info of PROCESS; t for a real child.
CHECK_PROCESS (process);
CHECK_LIST (plist);
- XPROCESS (process)->plist = plist;
+ pset_plist (XPROCESS (process), plist);
return plist;
}
if (VECTORP (address)) /* AF_INET or AF_INET6 */
{
register struct Lisp_Vector *p = XVECTOR (address);
- EMACS_INT size = p->header.size;
+ ptrdiff_t size = p->header.size;
Lisp_Object args[10];
int nargs, i;
for (i = 0; i < nargs; i++)
{
- EMACS_INT element = XINT (p->contents[i]);
-
- if (element < 0 || element > 65535)
+ if (! RANGED_INTEGERP (0, p->contents[i], 65535))
return Qnil;
if (nargs <= 5 /* IPv4 */
&& i < 4 /* host, not port */
- && element > 255)
+ && XINT (p->contents[i]) > 255)
return Qnil;
args[i+1] = p->contents[i];
Lisp_Object buffer, name, program, proc, current_dir, tem;
register unsigned char **new_argv;
ptrdiff_t i;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
buffer = args[1];
if (!NILP (buffer))
itself; it's all taken care of here. */
record_unwind_protect (start_process_unwind, proc);
- XPROCESS (proc)->childp = Qt;
- XPROCESS (proc)->plist = Qnil;
- XPROCESS (proc)->type = Qreal;
- XPROCESS (proc)->buffer = buffer;
- XPROCESS (proc)->sentinel = Qnil;
- XPROCESS (proc)->filter = Qnil;
- XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
+ pset_childp (XPROCESS (proc), Qt);
+ pset_plist (XPROCESS (proc), Qnil);
+ pset_type (XPROCESS (proc), Qreal);
+ pset_buffer (XPROCESS (proc), buffer);
+ pset_sentinel (XPROCESS (proc), Qnil);
+ pset_filter (XPROCESS (proc), Qnil);
+ pset_command (XPROCESS (proc), 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_gnutls_cred_type (XPROCESS (proc), Qnil);
#endif
#ifdef ADAPTIVE_READ_BUFFERING
val = Vcoding_system_for_read;
if (NILP (val))
{
- args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
+ args2 = alloca ((nargs + 1) * sizeof *args2);
args2[0] = Qstart_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
GCPRO2 (proc, current_dir);
else if (CONSP (Vdefault_process_coding_system))
val = XCAR (Vdefault_process_coding_system);
}
- XPROCESS (proc)->decode_coding_system = val;
+ pset_decode_coding_system (XPROCESS (proc), val);
val = Vcoding_system_for_write;
if (NILP (val))
{
if (EQ (coding_systems, Qt))
{
- args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
+ args2 = alloca ((nargs + 1) * sizeof *args2);
args2[0] = Qstart_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
GCPRO2 (proc, current_dir);
else if (CONSP (Vdefault_process_coding_system))
val = XCDR (Vdefault_process_coding_system);
}
- XPROCESS (proc)->encode_coding_system = val;
+ pset_encode_coding_system (XPROCESS (proc), 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
}
- XPROCESS (proc)->decoding_buf = empty_unibyte_string;
+ pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
XPROCESS (proc)->decoding_carryover = 0;
- XPROCESS (proc)->encoding_buf = empty_unibyte_string;
+ pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
XPROCESS (proc)->inherit_coding_system_flag
= !(NILP (buffer) || !inherit_process_coding_system);
/* Now that everything is encoded we can collect the strings into
NEW_ARGV. */
- new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
+ new_argv = alloca ((nargs - 1) * sizeof *new_argv);
new_argv[nargs - 2] = 0;
for (i = nargs - 2; i-- != 0; )
start_process_unwind (Lisp_Object proc)
{
if (!PROCESSP (proc))
- abort ();
+ emacs_abort ();
/* Was PROC started successfully?
-2 is used for a pty with no process, eg for gdb. */
#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
int wait_child_setup[2];
#endif
- sigset_t procmask;
+#ifdef SIGCHLD
sigset_t blocked;
- struct sigaction sigint_action;
- struct sigaction sigquit_action;
- struct sigaction sigpipe_action;
-#ifdef AIX
- struct sigaction sighup_action;
#endif
- /* Use volatile to protect variables from being clobbered by longjmp. */
+ /* Use volatile to protect variables from being clobbered by vfork. */
volatile int forkin, forkout;
volatile int pty_flag = 0;
-#ifndef USE_CRT_DLL
- extern char **environ;
+ volatile Lisp_Object lisp_pty_name = Qnil;
+ volatile Lisp_Object encoded_current_dir;
+#if HAVE_WORKING_VFORK
+ char **volatile save_environ;
#endif
inchannel = outchannel = -1;
forkin = forkout = -1;
#endif /* not USG, or USG_SUBTTY_WORKS */
pty_flag = 1;
+ lisp_pty_name = build_string (pty_name);
}
else
#endif /* HAVE_PTYS */
more portable (see USG_SUBTTY_WORKS above). */
XPROCESS (process)->pty_flag = pty_flag;
- XPROCESS (process)->status = Qrun;
-
- /* Delay interrupts until we have a chance to store
- the new fork's pid in its process structure */
- sigemptyset (&blocked);
-#ifdef SIGCHLD
- sigaddset (&blocked, SIGCHLD);
-#endif
-#ifdef HAVE_WORKING_VFORK
- /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
- this sets the parent's signal handlers as well as the child's.
- So delay all interrupts whose handlers the child might munge,
- and record the current handlers so they can be restored later. */
- sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
- sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
- sigaddset (&blocked, SIGPIPE); sigaction (SIGPIPE, 0, &sigpipe_action);
-#ifdef AIX
- sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
-#endif
-#endif /* HAVE_WORKING_VFORK */
- pthread_sigmask (SIG_BLOCK, &blocked, &procmask);
+ pset_status (XPROCESS (process), Qrun);
FD_SET (inchannel, &input_wait_mask);
FD_SET (inchannel, &non_keyboard_wait_mask);
if (inchannel > max_process_desc)
max_process_desc = inchannel;
- /* Until we store the proper pid, enable sigchld_handler
+ /* Until we store the proper pid, enable the SIGCHLD handler
to recognize an unknown pid as standing for this process.
It is very important not to let this `marker' value stay
in the table after this function has returned; if it does
error. */
setup_process_coding_systems (process);
- BLOCK_INPUT;
+ encoded_current_dir = ENCODE_FILE (current_dir);
- {
- /* child_setup must clobber environ on systems with true vfork.
- Protect it from permanent change. */
- char **save_environ = environ;
- volatile Lisp_Object encoded_current_dir = ENCODE_FILE (current_dir);
+ block_input ();
-#ifndef WINDOWSNT
- pid = vfork ();
- if (pid == 0)
-#endif /* not WINDOWSNT */
- {
- int xforkin = forkin;
- int xforkout = forkout;
+#ifdef SIGCHLD
+ /* Block SIGCHLD until we have a chance to store the new fork's
+ pid in its process structure. */
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGCHLD);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
+#endif
-#if 0 /* This was probably a mistake--it duplicates code later on,
- but fails to handle all the cases. */
- /* Make sure SIGCHLD is not blocked in the child. */
- sigsetmask (SIGEMPTYMASK);
+#if HAVE_WORKING_VFORK
+ /* child_setup must clobber environ on systems with true vfork.
+ Protect it from permanent change. */
+ save_environ = environ;
#endif
- /* Make the pty be the controlling terminal of the process. */
+#ifndef WINDOWSNT
+ pid = vfork ();
+ if (pid == 0)
+#endif /* not WINDOWSNT */
+ {
+ int xforkin = forkin;
+ int xforkout = forkout;
+
+ /* Make the pty be the controlling terminal of the process. */
#ifdef HAVE_PTYS
- /* First, disconnect its current controlling terminal. */
+ /* First, disconnect its current controlling terminal. */
#ifdef HAVE_SETSID
- /* We tried doing setsid only if pty_flag, but it caused
- process_set_signal to fail on SGI when using a pipe. */
- setsid ();
- /* Make the pty's terminal the controlling terminal. */
- if (pty_flag && xforkin >= 0)
- {
+ /* We tried doing setsid only if pty_flag, but it caused
+ process_set_signal to fail on SGI when using a pipe. */
+ setsid ();
+ /* Make the pty's terminal the controlling terminal. */
+ if (pty_flag && xforkin >= 0)
+ {
#ifdef TIOCSCTTY
- /* We ignore the return value
- because faith@cs.unc.edu says that is necessary on Linux. */
- ioctl (xforkin, TIOCSCTTY, 0);
+ /* We ignore the return value
+ because faith@cs.unc.edu says that is necessary on Linux. */
+ ioctl (xforkin, TIOCSCTTY, 0);
#endif
- }
+ }
#else /* not HAVE_SETSID */
#ifdef USG
- /* It's very important to call setpgrp here and no time
- afterwards. Otherwise, we lose our controlling tty which
- is set when we open the pty. */
- setpgrp ();
+ /* It's very important to call setpgrp here and no time
+ afterwards. Otherwise, we lose our controlling tty which
+ is set when we open the pty. */
+ setpgrp ();
#endif /* USG */
#endif /* not HAVE_SETSID */
#if defined (LDISC1)
- if (pty_flag && xforkin >= 0)
- {
- struct termios t;
- tcgetattr (xforkin, &t);
- t.c_lflag = LDISC1;
- if (tcsetattr (xforkin, TCSANOW, &t) < 0)
- emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
- }
+ if (pty_flag && xforkin >= 0)
+ {
+ struct termios t;
+ tcgetattr (xforkin, &t);
+ t.c_lflag = LDISC1;
+ if (tcsetattr (xforkin, TCSANOW, &t) < 0)
+ emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
+ }
#else
#if defined (NTTYDISC) && defined (TIOCSETD)
- if (pty_flag && xforkin >= 0)
- {
- /* Use new line discipline. */
- int ldisc = NTTYDISC;
- ioctl (xforkin, TIOCSETD, &ldisc);
- }
+ if (pty_flag && xforkin >= 0)
+ {
+ /* Use new line discipline. */
+ int ldisc = NTTYDISC;
+ ioctl (xforkin, TIOCSETD, &ldisc);
+ }
#endif
#endif
#ifdef TIOCNOTTY
- /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
- can do TIOCSPGRP only to the process's controlling tty. */
- if (pty_flag)
- {
- /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
- I can't test it since I don't have 4.3. */
- int j = emacs_open ("/dev/tty", O_RDWR, 0);
- if (j >= 0)
- {
- ioctl (j, TIOCNOTTY, 0);
- emacs_close (j);
- }
+ /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
+ can do TIOCSPGRP only to the process's controlling tty. */
+ if (pty_flag)
+ {
+ /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
+ I can't test it since I don't have 4.3. */
+ int j = emacs_open ("/dev/tty", O_RDWR, 0);
+ if (j >= 0)
+ {
+ ioctl (j, TIOCNOTTY, 0);
+ emacs_close (j);
+ }
#ifndef USG
- /* In order to get a controlling terminal on some versions
- of BSD, it is necessary to put the process in pgrp 0
- before it opens the terminal. */
+ /* In order to get a controlling terminal on some versions
+ of BSD, it is necessary to put the process in pgrp 0
+ before it opens the terminal. */
#ifdef HAVE_SETPGID
- setpgid (0, 0);
+ setpgid (0, 0);
#else
- setpgrp (0, 0);
+ setpgrp (0, 0);
#endif
#endif
- }
+ }
#endif /* TIOCNOTTY */
#if !defined (DONT_REOPEN_PTY)
both HAVE_SETSID and TIOCSCTTY are defined. */
/* Now close the pty (if we had it open) and reopen it.
This makes the pty the controlling terminal of the subprocess. */
- if (pty_flag)
- {
+ if (pty_flag)
+ {
- /* I wonder if emacs_close (emacs_open (pty_name, ...))
- would work? */
- if (xforkin >= 0)
- emacs_close (xforkin);
- xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
+ /* I wonder if emacs_close (emacs_open (pty_name, ...))
+ would work? */
+ if (xforkin >= 0)
+ emacs_close (xforkin);
+ xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
- if (xforkin < 0)
- {
- emacs_write (1, "Couldn't open the pty terminal ", 31);
- emacs_write (1, pty_name, strlen (pty_name));
- emacs_write (1, "\n", 1);
- _exit (1);
- }
+ if (xforkin < 0)
+ {
+ emacs_write (1, "Couldn't open the pty terminal ", 31);
+ emacs_write (1, pty_name, strlen (pty_name));
+ emacs_write (1, "\n", 1);
+ _exit (1);
+ }
- }
+ }
#endif /* not DONT_REOPEN_PTY */
#ifdef SETUP_SLAVE_PTY
- if (pty_flag)
- {
- SETUP_SLAVE_PTY;
- }
+ if (pty_flag)
+ {
+ SETUP_SLAVE_PTY;
+ }
#endif /* SETUP_SLAVE_PTY */
#ifdef AIX
- /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
- Now reenable it in the child, so it will die when we want it to. */
- if (pty_flag)
- signal (SIGHUP, SIG_DFL);
+ /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
+ Now reenable it in the child, so it will die when we want it to. */
+ if (pty_flag)
+ signal (SIGHUP, SIG_DFL);
#endif
#endif /* HAVE_PTYS */
- signal (SIGINT, SIG_DFL);
- signal (SIGQUIT, SIG_DFL);
- /* GConf causes us to ignore SIGPIPE, make sure it is restored
- in the child. */
- signal (SIGPIPE, SIG_DFL);
+ signal (SIGINT, SIG_DFL);
+ signal (SIGQUIT, SIG_DFL);
+
+ /* Emacs ignores SIGPIPE, but the child should not. */
+ signal (SIGPIPE, SIG_DFL);
+#ifdef SIGCHLD
/* Stop blocking signals in the child. */
- pthread_sigmask (SIG_SETMASK, &procmask, 0);
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
+#endif
- if (pty_flag)
- child_setup_tty (xforkout);
+ if (pty_flag)
+ child_setup_tty (xforkout);
#ifdef WINDOWSNT
- pid = child_setup (xforkin, xforkout, xforkout,
- new_argv, 1, encoded_current_dir);
+ pid = child_setup (xforkin, xforkout, xforkout,
+ new_argv, 1, encoded_current_dir);
#else /* not WINDOWSNT */
#ifdef FD_CLOEXEC
- emacs_close (wait_child_setup[0]);
+ emacs_close (wait_child_setup[0]);
#endif
- child_setup (xforkin, xforkout, xforkout,
- new_argv, 1, encoded_current_dir);
+ child_setup (xforkin, xforkout, xforkout,
+ new_argv, 1, encoded_current_dir);
#endif /* not WINDOWSNT */
- }
- environ = save_environ;
- }
+ }
+
+ /* Back in the parent process. */
+
+#if HAVE_WORKING_VFORK
+ environ = save_environ;
+#endif
- UNBLOCK_INPUT;
+ XPROCESS (process)->pid = pid;
+
+ /* Stop blocking signals in the parent. */
+#ifdef SIGCHLD
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
+#endif
+ unblock_input ();
- /* This runs in the Emacs process. */
if (pid < 0)
{
if (forkin >= 0)
else
{
/* vfork succeeded. */
- XPROCESS (process)->pid = pid;
#ifdef WINDOWSNT
register_child (pid, inchannel);
So have an interrupt jar it loose. */
{
struct atimer *timer;
- EMACS_TIME offset;
+ EMACS_TIME offset = make_emacs_time (1, 0);
stop_polling ();
- EMACS_SET_SECS_USECS (offset, 1, 0);
timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
if (forkin >= 0)
if (forkin != forkout && forkout >= 0)
emacs_close (forkout);
-#ifdef HAVE_PTYS
- if (pty_flag)
- XPROCESS (process)->tty_name = build_string (pty_name);
- else
-#endif
- XPROCESS (process)->tty_name = Qnil;
+ pset_tty_name (XPROCESS (process), lisp_pty_name);
#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
/* Wait for child_setup to complete in case that vfork is
#endif
}
- /* Restore the signal state whether vfork succeeded or not.
- (We will signal an error, below, if it failed.) */
-#ifdef HAVE_WORKING_VFORK
- /* Restore the parent's signal handlers. */
- sigaction (SIGINT, &sigint_action, 0);
- sigaction (SIGQUIT, &sigquit_action, 0);
- sigaction (SIGPIPE, &sigpipe_action, 0);
-#ifdef AIX
- sigaction (SIGHUP, &sighup_action, 0);
-#endif
-#endif /* HAVE_WORKING_VFORK */
- /* Stop blocking signals in the parent. */
- pthread_sigmask (SIG_SETMASK, &procmask, 0);
-
/* Now generate the error if vfork failed. */
if (pid < 0)
report_file_error ("Doing vfork", Qnil);
more portable (see USG_SUBTTY_WORKS above). */
XPROCESS (process)->pty_flag = pty_flag;
- XPROCESS (process)->status = Qrun;
+ pset_status (XPROCESS (process), Qrun);
setup_process_coding_systems (process);
FD_SET (inchannel, &input_wait_mask);
XPROCESS (process)->pid = -2;
#ifdef HAVE_PTYS
if (pty_flag)
- XPROCESS (process)->tty_name = build_string (pty_name);
+ pset_tty_name (XPROCESS (process), build_string (pty_name));
else
#endif
- XPROCESS (process)->tty_name = Qnil;
+ pset_tty_name (XPROCESS (process), Qnil);
}
\f
return sizeof (struct sockaddr_un);
}
#endif
- else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
+ else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address))
+ && VECTORP (XCDR (address)))
{
struct sockaddr *sa;
*familyp = XINT (XCAR (address));
register struct Lisp_Vector *p;
register unsigned char *cp = NULL;
register int i;
+ EMACS_INT hostport;
memset (sa, 0, len);
{
struct sockaddr_in *sin = (struct sockaddr_in *) sa;
len = sizeof (sin->sin_addr) + 1;
- i = XINT (p->contents[--len]);
- sin->sin_port = htons (i);
+ hostport = XINT (p->contents[--len]);
+ sin->sin_port = htons (hostport);
cp = (unsigned char *)&sin->sin_addr;
sa->sa_family = family;
}
struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
len = sizeof (sin6->sin6_addr) + 1;
- i = XINT (p->contents[--len]);
- sin6->sin6_port = htons (i);
+ hostport = XINT (p->contents[--len]);
+ sin6->sin6_port = htons (hostport);
for (i = 0; i < len; i++)
if (INTEGERP (p->contents[i]))
{
case SOPT_INT:
{
int optval;
- if (INTEGERP (val))
+ if (TYPE_RANGED_INTEGERP (int, val))
optval = XINT (val);
else
error ("Bad option value for %s", name);
linger.l_onoff = 1;
linger.l_linger = 0;
- if (INTEGERP (val))
+ if (TYPE_RANGED_INTEGERP (int, val))
linger.l_linger = XINT (val);
else
linger.l_onoff = NILP (val) ? 0 : 1;
if (set_socket_option (s, option, value))
{
- p->childp = Fplist_put (p->childp, option, value);
+ pset_childp (p, Fplist_put (p->childp, option, value));
return Qt;
}
make_serial_process_unwind (Lisp_Object proc)
{
if (!PROCESSP (proc))
- abort ();
+ emacs_abort ();
remove_process (proc);
return Qnil;
}
struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem, val;
- int specpdl_count = -1;
+ ptrdiff_t specpdl_count = -1;
if (nargs == 0)
return Qnil;
if (NILP (buffer))
buffer = name;
buffer = Fget_buffer_create (buffer);
- p->buffer = buffer;
-
- p->childp = contact;
- p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
- p->type = Qserial;
- p->sentinel = Fplist_get (contact, QCsentinel);
- p->filter = Fplist_get (contact, QCfilter);
- p->log = Qnil;
+ pset_buffer (p, buffer);
+
+ pset_childp (p, contact);
+ pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
+ pset_type (p, Qserial);
+ pset_sentinel (p, Fplist_get (contact, QCsentinel));
+ pset_filter (p, Fplist_get (contact, QCfilter));
+ pset_log (p, Qnil);
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
- p->command = Qt;
+ pset_command (p, Qt);
p->pty_flag = 0;
if (!EQ (p->command, Qt))
else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
|| (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
val = Qnil;
- p->decode_coding_system = val;
+ pset_decode_coding_system (p, val);
val = Qnil;
if (!NILP (tem))
else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
|| (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
val = Qnil;
- p->encode_coding_system = val;
+ pset_encode_coding_system (p, val);
setup_process_coding_systems (proc);
- p->decoding_buf = empty_unibyte_string;
+ pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
- p->encoding_buf = empty_unibyte_string;
+ pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
int xerrno = 0;
int s = -1, outch, inch;
struct gcpro gcpro1;
- int count = SPECPDL_INDEX ();
- int count1;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t count1;
Lisp_Object QCaddress; /* one of QClocal or QCremote */
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
error ("Network servers not supported");
#else
is_server = 1;
- if (INTEGERP (tem))
+ if (TYPE_RANGED_INTEGERP (int, tem))
backlog = XINT (tem);
#endif
}
#endif
else if (EQ (tem, Qipv4))
family = AF_INET;
- else if (INTEGERP (tem))
+ else if (TYPE_RANGED_INTEGERP (int, tem))
family = XINT (tem);
else
error ("Unknown address family");
CHECK_STRING (service);
memset (&address_un, 0, sizeof address_un);
address_un.sun_family = AF_LOCAL;
- strncpy (address_un.sun_path, SSDATA (service), sizeof address_un.sun_path);
+ if (sizeof address_un.sun_path <= SBYTES (service))
+ error ("Service name too long");
+ strcpy (address_un.sun_path, SSDATA (service));
ai.ai_addr = (struct sockaddr *) &address_un;
ai.ai_addrlen = sizeof address_un;
goto open_socket;
{
/* Unlike most other syscalls connect() cannot be called
again. (That would return EALREADY.) The proper way to
- wait for completion is select(). */
+ wait for completion is pselect(). */
int sc;
socklen_t len;
SELECT_TYPE fdset;
FD_ZERO (&fdset);
FD_SET (s, &fdset);
QUIT;
- sc = select (s + 1, (SELECT_TYPE *)0, &fdset, (SELECT_TYPE *)0,
- (EMACS_TIME *)0);
+ sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
if (sc == -1)
{
if (errno == EINTR)
if (socktype == SOCK_DGRAM)
{
if (datagram_address[s].sa)
- abort ();
- datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
+ emacs_abort ();
+ datagram_address[s].sa = xmalloc (lres->ai_addrlen);
datagram_address[s].len = lres->ai_addrlen;
if (is_server)
{
#ifdef HAVE_GETADDRINFO
if (res != &ai)
{
- BLOCK_INPUT;
+ block_input ();
freeaddrinfo (res);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
p = XPROCESS (proc);
- p->childp = contact;
- p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
- p->type = Qnetwork;
+ pset_childp (p, contact);
+ pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
+ pset_type (p, Qnetwork);
- p->buffer = buffer;
- p->sentinel = sentinel;
- p->filter = filter;
- p->log = Fplist_get (contact, QClog);
+ pset_buffer (p, buffer);
+ pset_sentinel (p, sentinel);
+ pset_filter (p, filter);
+ pset_log (p, 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)))
- p->command = Qt;
+ pset_command (p, Qt);
p->pid = 0;
p->infd = inch;
p->outfd = outch;
if (is_server && socktype != SOCK_DGRAM)
- p->status = Qlisten;
+ pset_status (p, Qlisten);
/* Make the process marker point into the process buffer (if any). */
if (BUFFERP (buffer))
/* We may get here if connect did succeed immediately. However,
in that case, we still need to signal this like a non-blocking
connection. */
- p->status = Qconnect;
+ pset_status (p, Qconnect);
if (!FD_ISSET (inch, &connect_wait_mask))
{
FD_SET (inch, &connect_wait_mask);
else
val = Qnil;
}
- p->decode_coding_system = val;
+ pset_decode_coding_system (p, val);
if (!NILP (tem))
{
else
val = Qnil;
}
- p->encode_coding_system = val;
+ pset_encode_coding_system (p, val);
}
setup_process_coding_systems (proc);
- p->decoding_buf = empty_unibyte_string;
+ pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
- p->encoding_buf = empty_unibyte_string;
+ pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
CHECK_STRING (ifname);
- memset (rq.ifr_name, 0, sizeof rq.ifr_name);
- strncpy (rq.ifr_name, SSDATA (ifname), sizeof (rq.ifr_name));
+ if (sizeof rq.ifr_name <= SBYTES (ifname))
+ error ("interface name too long");
+ strcpy (rq.ifr_name, SSDATA (ifname));
s = socket (AF_INET, SOCK_STREAM, 0);
if (s < 0)
FD_CLR (inchannel, &connect_wait_mask);
FD_CLR (inchannel, &write_mask);
if (--num_pending_connects < 0)
- abort ();
+ emacs_abort ();
}
#endif
if (inchannel == max_process_desc)
Return non-nil if we received any output before the timeout expired. */)
(register Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec, Lisp_Object just_this_one)
{
- int secs, usecs = 0;
+ intmax_t secs;
+ int nsecs;
if (! NILP (process))
CHECK_PROCESS (process);
}
}
+ secs = 0;
+ nsecs = -1;
+
if (!NILP (seconds))
{
if (INTEGERP (seconds))
- secs = XINT (seconds);
+ {
+ if (0 < XINT (seconds))
+ {
+ secs = XINT (seconds);
+ nsecs = 0;
+ }
+ }
else if (FLOATP (seconds))
{
- double timeout = XFLOAT_DATA (seconds);
- secs = (int) timeout;
- usecs = (int) ((timeout - (double) secs) * 1000000);
+ if (0 < XFLOAT_DATA (seconds))
+ {
+ EMACS_TIME t = EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (seconds));
+ secs = min (EMACS_SECS (t), WAIT_READING_MAX);
+ nsecs = EMACS_NSECS (t);
+ }
}
else
wrong_type_argument (Qnumberp, seconds);
-
- if (secs < 0 || (secs == 0 && usecs == 0))
- secs = -1, usecs = 0;
}
- else
- secs = NILP (process) ? -1 : 0;
+ else if (! NILP (process))
+ nsecs = 0;
return
- (wait_reading_process_output (secs, usecs, 0, 0,
+ (wait_reading_process_output (secs, nsecs, 0, 0,
Qnil,
!NILP (process) ? XPROCESS (process) : NULL,
NILP (just_this_one) ? 0 :
conv_sockaddr_to_lisp (&saddr.sa, len));
#endif
- p->childp = contact;
- p->plist = Fcopy_sequence (ps->plist);
- p->type = Qnetwork;
+ pset_childp (p, contact);
+ pset_plist (p, Fcopy_sequence (ps->plist));
+ pset_type (p, Qnetwork);
- p->buffer = buffer;
- p->sentinel = ps->sentinel;
- p->filter = ps->filter;
- p->command = Qnil;
+ pset_buffer (p, buffer);
+ pset_sentinel (p, ps->sentinel);
+ pset_filter (p, ps->filter);
+ pset_command (p, Qnil);
p->pid = 0;
p->infd = s;
p->outfd = s;
- p->status = Qrun;
+ pset_status (p, Qrun);
/* Client processes for accepted connections are not stopped initially. */
if (!EQ (p->filter, Qt))
of the new process should reflect the settings at the time the
server socket was opened; not the current settings. */
- p->decode_coding_system = ps->decode_coding_system;
- p->encode_coding_system = ps->encode_coding_system;
+ pset_decode_coding_system (p, ps->decode_coding_system);
+ pset_encode_coding_system (p, ps->encode_coding_system);
setup_process_coding_systems (proc);
- p->decoding_buf = empty_unibyte_string;
+ pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
- p->encoding_buf = empty_unibyte_string;
+ pset_encoding_buf (p, empty_unibyte_string);
p->inherit_coding_system_flag
= (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
{
}
-/* Use a wrapper around select to work around a bug in gdb 5.3.
- Normally, the wrapper is optimized away by inlining.
-
- If emacs is stopped inside select, the gdb backtrace doesn't
- show the function which called select, so it is practically
- impossible to step through wait_reading_process_output. */
-
-#ifndef select
-static inline int
-select_wrapper (int n, fd_set *rfd, fd_set *wfd, fd_set *xfd, struct timeval *tmo)
-{
- return select (n, rfd, wfd, xfd, tmo);
-}
-#define select select_wrapper
-#endif
-
/* Read and dispose of subprocess output while waiting for timeout to
elapse and/or keyboard input to be available.
TIME_LIMIT is:
- timeout in seconds, or
- zero for no limit, or
- -1 means gobble data immediately available but don't wait for any.
+ timeout in seconds
+ If negative, gobble data immediately available but don't wait for any.
- MICROSECS is:
- an additional duration to wait, measured in microseconds.
- If this is nonzero and time_limit is 0, then the timeout
- consists of MICROSECS only.
+ NSECS is:
+ an additional duration to wait, measured in nanoseconds
+ If TIME_LIMIT is zero, then:
+ If NSECS == 0, there is no limit.
+ If NSECS > 0, the timeout consists of NSECS only.
+ If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
- READ_KBD is a lisp value:
+ READ_KBD is:
0 to ignore keyboard input, or
1 to return when input is available, or
-1 meaning caller will actually read the input, so don't throw to
Otherwise, return true if we received input from any process. */
int
-wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
+wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
int do_display,
Lisp_Object wait_for_cell,
struct Lisp_Process *wait_proc, int just_wait_proc)
EMACS_TIME timeout, end_time;
int wait_channel = -1;
int got_some_input = 0;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
FD_ZERO (&Available);
FD_ZERO (&Writeok);
- if (time_limit == 0 && microsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
- && !(CONSP (wait_proc->status) && EQ (XCAR (wait_proc->status), Qexit)))
+ if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
+ && !(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. */
make_number (waiting_for_user_input_p));
waiting_for_user_input_p = read_kbd;
+ if (time_limit < 0)
+ {
+ time_limit = 0;
+ nsecs = -1;
+ }
+ else if (TYPE_MAXIMUM (time_t) < time_limit)
+ time_limit = TYPE_MAXIMUM (time_t);
+
/* Since we may need to wait several times,
compute the absolute time to return at. */
- if (time_limit || microsecs)
+ if (time_limit || 0 < nsecs)
{
- EMACS_GET_TIME (end_time);
- EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
- EMACS_ADD_TIME (end_time, end_time, timeout);
+ timeout = make_emacs_time (time_limit, nsecs);
+ end_time = add_emacs_time (current_emacs_time (), timeout);
}
while (1)
Otherwise, do pending quit if requested. */
if (read_kbd >= 0)
QUIT;
-#ifdef SYNC_INPUT
- else
+ else if (pending_signals)
process_pending_signals ();
-#endif
/* Exit now if the cell we're waiting for became non-nil. */
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
/* Compute time from now till when time limit is up */
/* Exit if already run out */
- if (time_limit == -1)
+ if (nsecs < 0)
{
- /* -1 specified for timeout means
+ /* A negative timeout means
gobble output available now
but don't wait at all. */
- EMACS_SET_SECS_USECS (timeout, 0, 0);
+ timeout = make_emacs_time (0, 0);
}
- else if (time_limit || microsecs)
+ else if (time_limit || 0 < nsecs)
{
- EMACS_GET_TIME (timeout);
- EMACS_SUB_TIME (timeout, end_time, timeout);
- if (EMACS_TIME_NEG_P (timeout))
+ EMACS_TIME now = current_emacs_time ();
+ if (EMACS_TIME_LE (end_time, now))
break;
+ timeout = sub_emacs_time (end_time, now);
}
else
{
- EMACS_SET_SECS_USECS (timeout, 100000, 0);
+ timeout = make_emacs_time (100000, 0);
}
/* Normally we run timers here.
&& requeued_events_pending_p ())
break;
- if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
+ /* A negative timeout means do not wait at all. */
+ if (0 <= nsecs)
{
- EMACS_TIME difference;
- EMACS_SUB_TIME (difference, timer_delay, timeout);
- if (EMACS_TIME_NEG_P (difference))
+ if (EMACS_TIME_VALID_P (timer_delay))
{
- timeout = timer_delay;
- timeout_reduced_for_timers = 1;
+ if (EMACS_TIME_LT (timer_delay, timeout))
+ {
+ timeout = timer_delay;
+ timeout_reduced_for_timers = 1;
+ }
+ }
+ else
+ {
+ /* This is so a breakpoint can be put here. */
+ wait_reading_process_output_1 ();
}
- }
- /* If time_limit is -1, we are not going to wait at all. */
- else if (time_limit != -1)
- {
- /* This is so a breakpoint can be put here. */
- wait_reading_process_output_1 ();
}
}
Atemp = input_wait_mask;
Ctemp = write_mask;
- EMACS_SET_SECS_USECS (timeout, 0, 0);
- if ((select (max (max_process_desc, max_input_desc) + 1,
- &Atemp,
+ timeout = make_emacs_time (0, 0);
+ if ((pselect (max (max_process_desc, max_input_desc) + 1,
+ &Atemp,
#ifdef NON_BLOCKING_CONNECT
- (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
+ (num_pending_connects > 0 ? &Ctemp : NULL),
#else
- (SELECT_TYPE *)0,
+ NULL,
#endif
- (SELECT_TYPE *)0, &timeout)
+ NULL, &timeout, NULL)
<= 0))
{
/* It's okay for us to do this and then continue with
Vprocess_adaptive_read_buffering is nil. */
if (process_output_skip && check_delay > 0)
{
- int usecs = EMACS_USECS (timeout);
- if (EMACS_SECS (timeout) > 0 || usecs > READ_OUTPUT_DELAY_MAX)
- usecs = READ_OUTPUT_DELAY_MAX;
+ int nsecs = EMACS_NSECS (timeout);
+ if (EMACS_SECS (timeout) > 0 || nsecs > READ_OUTPUT_DELAY_MAX)
+ nsecs = READ_OUTPUT_DELAY_MAX;
for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
{
proc = chan_process[channel];
continue;
FD_CLR (channel, &Available);
XPROCESS (proc)->read_output_skip = 0;
- if (XPROCESS (proc)->read_output_delay < usecs)
- usecs = XPROCESS (proc)->read_output_delay;
+ if (XPROCESS (proc)->read_output_delay < nsecs)
+ nsecs = XPROCESS (proc)->read_output_delay;
}
}
- EMACS_SET_SECS_USECS (timeout, 0, usecs);
+ timeout = make_emacs_time (0, nsecs);
process_output_skip = 0;
}
#endif
#elif defined (HAVE_NS)
nfds = ns_select
#else
- nfds = select
+ nfds = pselect
#endif
(max (max_process_desc, max_input_desc) + 1,
&Available,
(check_write ? &Writeok : (SELECT_TYPE *)0),
- (SELECT_TYPE *)0, &timeout);
+ NULL, &timeout, NULL);
#ifdef HAVE_GNUTLS
/* GnuTLS buffers data internally. In lowat mode it leaves
/* If we woke up due to SIGWINCH, actually change size now. */
do_pending_window_change (0);
- if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
- /* We wanted the full specified time, so return now. */
+ if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers)
+ /* We waited the full specified time, so return now. */
break;
if (nfds < 0)
{
Cleanup occurs c/o status_notify after SIGCLD. */
no_avail = 1; /* Cannot depend on values returned */
#else
- abort ();
+ emacs_abort ();
#endif
}
else
check_write = 0;
}
-#if 0 /* When polling is used, interrupt_input is 0,
- so get_input_pending should read the input.
- So this should not be needed. */
- /* If we are using polling for input,
- and we see input available, make it get read now.
- Otherwise it might not actually get read for a second.
- And on hpux, since we turn off polling in wait_reading_process_output,
- it might never get read at all if we don't spend much time
- outside of wait_reading_process_output. */
- if (read_kbd && interrupt_input
- && keyboard_bit_set (&Available)
- && input_polling_used ())
- kill (getpid (), SIGALRM);
-#endif
-
/* Check for keyboard input */
/* If there is any, return immediately
to give it higher priority than subprocesses */
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
/* If we think we have keyboard input waiting, but didn't get SIGIO,
go read it. This can happen with X on BSD after logging out.
In that case, there really is no input and no SIGIO,
if (read_kbd && interrupt_input
&& keyboard_bit_set (&Available) && ! noninteractive)
- kill (getpid (), SIGIO);
+ handle_input_available_signal (SIGIO);
#endif
if (! wait_proc)
for (channel = 0; channel <= max_input_desc; ++channel)
{
struct fd_callback_data *d = &fd_callback_info[channel];
- if (FD_ISSET (channel, &Available)
- && d->func != 0
- && (d->condition & FOR_READ) != 0)
- d->func (channel, d->data, 1);
- if (FD_ISSET (channel, &write_mask)
- && d->func != 0
- && (d->condition & FOR_WRITE) != 0)
- d->func (channel, d->data, 0);
- }
+ if (d->func
+ && ((d->condition & FOR_READ
+ && FD_ISSET (channel, &Available))
+ || (d->condition & FOR_WRITE
+ && FD_ISSET (channel, &write_mask))))
+ d->func (channel, d->data);
+ }
for (channel = 0; channel <= max_process_desc; channel++)
{
if (wait_channel == channel)
{
wait_channel = -1;
- time_limit = -1;
+ nsecs = -1;
got_some_input = 1;
}
proc = chan_process[channel];
if (p->pid == -2)
{
- /* If the EIO occurs on a pty, sigchld_handler's
- wait3() will not find the process object to
+ /* If the EIO occurs on a pty, the SIGCHLD handler's
+ waitpid call will not find the process object to
delete. Do it here. */
p->tick = ++process_tick;
- p->status = Qfailed;
+ pset_status (p, Qfailed);
}
else
- kill (getpid (), SIGCHLD);
+ handle_child_signal (SIGCHLD);
}
#endif /* HAVE_PTYS */
/* If we can detect process termination, don't consider the
if (XPROCESS (proc)->raw_status_new)
update_status (XPROCESS (proc));
if (EQ (XPROCESS (proc)->status, Qrun))
- XPROCESS (proc)->status
- = Fcons (Qexit, Fcons (make_number (256), Qnil));
+ pset_status (XPROCESS (proc),
+ list2 (Qexit, make_number (256)));
}
}
#ifdef NON_BLOCKING_CONNECT
FD_CLR (channel, &connect_wait_mask);
FD_CLR (channel, &write_mask);
if (--num_pending_connects < 0)
- abort ();
+ emacs_abort ();
proc = chan_process[channel];
if (NILP (proc))
if (xerrno)
{
p->tick = ++process_tick;
- p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
+ pset_status (p, list2 (Qfailed, make_number (xerrno)));
deactivate_process (proc);
}
else
{
- p->status = Qrun;
+ pset_status (p, 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. */
char *chars;
register Lisp_Object outstream;
register struct Lisp_Process *p = XPROCESS (proc);
- register EMACS_INT opoint;
+ register ptrdiff_t opoint;
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = p->decoding_carryover;
int readmax = 4096;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object odeactivate;
- chars = (char *) alloca (carryover + readmax);
+ chars = alloca (carryover + readmax);
if (carryover)
/* See the comment above. */
memcpy (chars, SDATA (p->decoding_buf), carryover);
/* There's no good reason to let process filters change the current
buffer, and many callers of accept-process-output, sit-for, and
friends don't expect current-buffer to be changed from under them. */
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
/* Read and dispose of the process output. */
outstream = p->filter;
if (!NILP (outstream))
{
Lisp_Object text;
- int outer_running_asynch_code = running_asynch_code;
+ bool outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
/* No need to gcpro these, because all we do with them later
/* A new coding system might be found. */
if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
{
- p->decode_coding_system = Vlast_coding_system_used;
+ pset_decode_coding_system (p, Vlast_coding_system_used);
/* Don't call setup_coding_system for
proc_decode_coding_system[channel] here. It is done in
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[p->outfd])
{
- p->encode_coding_system
- = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
+ pset_encode_coding_system
+ (p, 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 (p->decoding_buf) < coding->carryover_bytes)
- p->decoding_buf = make_uninit_string (coding->carryover_bytes);
+ pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
memcpy (SDATA (p->decoding_buf), coding->carryover,
coding->carryover_bytes);
p->decoding_carryover = coding->carryover_bytes;
}
/* If no filter, write into buffer if it isn't dead. */
- else if (!NILP (p->buffer) && !NILP (BVAR (XBUFFER (p->buffer), name)))
+ else if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
{
Lisp_Object old_read_only;
- EMACS_INT old_begv, old_zv;
- EMACS_INT old_begv_byte, old_zv_byte;
- EMACS_INT before, before_byte;
- EMACS_INT opoint_byte;
+ ptrdiff_t old_begv, old_zv;
+ ptrdiff_t old_begv_byte, old_zv_byte;
+ ptrdiff_t before, before_byte;
+ ptrdiff_t opoint_byte;
Lisp_Object text;
struct buffer *b;
old_begv_byte = BEGV_BYTE;
old_zv_byte = ZV_BYTE;
- BVAR (current_buffer, read_only) = Qnil;
+ bset_read_only (current_buffer, Qnil);
/* Insert new output into buffer
at the current end-of-output marker,
thus preserving logical ordering of input and output. */
if (XMARKER (p->mark)->buffer)
- SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
- clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
+ SET_PT_BOTH (clip_to_bounds (BEGV,
+ marker_position (p->mark), ZV),
+ clip_to_bounds (BEGV_BYTE,
+ marker_byte_position (p->mark),
ZV_BYTE));
else
SET_PT_BOTH (ZV, ZV_BYTE);
similar code in the previous `if' block. */
if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
{
- p->decode_coding_system = Vlast_coding_system_used;
+ pset_decode_coding_system (p, Vlast_coding_system_used);
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[p->outfd])
{
- p->encode_coding_system
- = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
+ pset_encode_coding_system
+ (p, 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 (p->decoding_buf) < coding->carryover_bytes)
- p->decoding_buf = make_uninit_string (coding->carryover_bytes);
+ pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
memcpy (SDATA (p->decoding_buf), coding->carryover,
coding->carryover_bytes);
p->decoding_carryover = coding->carryover_bytes;
Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
- BVAR (current_buffer, read_only) = old_read_only;
+ bset_read_only (current_buffer, old_read_only);
SET_PT_BOTH (opoint, opoint_byte);
}
/* Handling the process output should not deactivate the mark. */
\f
/* Sending data to subprocess */
-static jmp_buf send_process_frame;
-static Lisp_Object process_sent_to;
+/* In send_process, when a write fails temporarily,
+ wait_reading_process_output is called. It may execute user code,
+ e.g. timers, that attempts to write new data to the same process.
+ We must ensure that data is sent in the right order, and not
+ interspersed half-completed with other writes (Bug#10815). This is
+ handled by the write_queue element of struct process. It is a list
+ with each entry having the form
-#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
-static void send_process_trap (int) NO_RETURN;
-#endif
+ (string . (offset . length))
+
+ where STRING is a lisp string, OFFSET is the offset into the
+ string's byte sequence from which we should begin to send, and
+ LENGTH is the number of bytes left to send. */
+
+/* Create a new entry in write_queue.
+ INPUT_OBJ should be a buffer, string Qt, or Qnil.
+ BUF is a pointer to the string sequence of the input_obj or a C
+ string in case of Qt or Qnil. */
static void
-send_process_trap (int ignore)
+write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
+ const char *buf, ptrdiff_t len, int front)
{
- SIGNAL_THREAD_CHECK (SIGPIPE);
- sigunblock (sigmask (SIGPIPE));
- longjmp (send_process_frame, 1);
+ ptrdiff_t offset;
+ Lisp_Object entry, obj;
+
+ if (STRINGP (input_obj))
+ {
+ offset = buf - SSDATA (input_obj);
+ obj = input_obj;
+ }
+ else
+ {
+ offset = 0;
+ obj = make_unibyte_string (buf, len);
+ }
+
+ entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
+
+ if (front)
+ pset_write_queue (p, Fcons (entry, p->write_queue));
+ else
+ pset_write_queue (p, nconc2 (p->write_queue, Fcons (entry, Qnil)));
+}
+
+/* Remove the first element in the write_queue of process P, put its
+ contents in OBJ, BUF and LEN, and return non-zero. If the
+ write_queue is empty, return zero. */
+
+static int
+write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
+ const char **buf, ptrdiff_t *len)
+{
+ Lisp_Object entry, offset_length;
+ ptrdiff_t offset;
+
+ if (NILP (p->write_queue))
+ return 0;
+
+ entry = XCAR (p->write_queue);
+ pset_write_queue (p, XCDR (p->write_queue));
+
+ *obj = XCAR (entry);
+ offset_length = XCDR (entry);
+
+ *len = XINT (XCDR (offset_length));
+ offset = XINT (XCAR (offset_length));
+ *buf = SSDATA (*obj) + offset;
+
+ return 1;
}
/* Send some data to process PROC.
This function can evaluate Lisp code and can garbage collect. */
static void
-send_process (volatile Lisp_Object proc, const char *volatile buf,
- volatile EMACS_INT len, volatile Lisp_Object object)
+send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
+ Lisp_Object object)
{
- /* Use volatile to protect variables from being clobbered by longjmp. */
struct Lisp_Process *p = XPROCESS (proc);
ssize_t rv;
struct coding_system *coding;
- struct gcpro gcpro1;
- void (*volatile old_sigpipe) (int);
-
- GCPRO1 (object);
if (p->raw_status_new)
update_status (p);
&& !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
|| EQ (object, Qt))
{
- p->encode_coding_system
- = complement_process_encoding_system (p->encode_coding_system);
+ pset_encode_coding_system
+ (p, 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
coding->dst_object = Qt;
if (BUFFERP (object))
{
- EMACS_INT from_byte, from, to;
- EMACS_INT save_pt, save_pt_byte;
+ ptrdiff_t from_byte, from, to;
+ ptrdiff_t save_pt, save_pt_byte;
struct buffer *cur = current_buffer;
set_buffer_internal (XBUFFER (object));
pty_max_bytes--;
}
- /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
- CFLAGS="-g -O": The value of the parameter `proc' is clobbered
- when returning with longjmp despite being declared volatile. */
- if (!setjmp (send_process_frame))
+ /* If there is already data in the write_queue, put the new data
+ in the back of queue. Otherwise, ignore it. */
+ if (!NILP (p->write_queue))
+ write_queue_push (p, object, buf, len, 0);
+
+ do /* while !NILP (p->write_queue) */
{
- p = XPROCESS (proc); /* Repair any setjmp clobbering. */
+ ptrdiff_t cur_len = -1;
+ const char *cur_buf;
+ Lisp_Object cur_object;
- process_sent_to = proc;
- while (len > 0)
+ /* If write_queue is empty, ignore it. */
+ if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
{
- EMACS_INT this = len;
+ cur_len = len;
+ cur_buf = buf;
+ cur_object = object;
+ }
+ while (cur_len > 0)
+ {
/* Send this batch, using one or more write calls. */
- while (this > 0)
- {
- EMACS_INT written = 0;
- int outfd = p->outfd;
- old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap);
+ ptrdiff_t written = 0;
+ int outfd = p->outfd;
#ifdef DATAGRAM_SOCKETS
- if (DATAGRAM_CHAN_P (outfd))
- {
- rv = sendto (outfd, buf, this,
- 0, datagram_address[outfd].sa,
- datagram_address[outfd].len);
- if (0 <= rv)
- written = rv;
- else if (errno == EMSGSIZE)
- {
- signal (SIGPIPE, old_sigpipe);
- report_file_error ("sending datagram",
- Fcons (proc, Qnil));
- }
- }
- else
+ if (DATAGRAM_CHAN_P (outfd))
+ {
+ rv = sendto (outfd, cur_buf, cur_len,
+ 0, datagram_address[outfd].sa,
+ datagram_address[outfd].len);
+ if (0 <= rv)
+ written = rv;
+ else if (errno == EMSGSIZE)
+ report_file_error ("sending datagram", Fcons (proc, Qnil));
+ }
+ else
#endif
- {
+ {
#ifdef HAVE_GNUTLS
- if (p->gnutls_p)
- written = emacs_gnutls_write (p, buf, this);
- else
+ if (p->gnutls_p)
+ written = emacs_gnutls_write (p, cur_buf, cur_len);
+ else
#endif
- written = emacs_write (outfd, buf, this);
- rv = (written ? 0 : -1);
+ written = emacs_write (outfd, cur_buf, cur_len);
+ rv = (written ? 0 : -1);
#ifdef ADAPTIVE_READ_BUFFERING
- if (p->read_output_delay > 0
- && p->adaptive_read_buffering == 1)
- {
- p->read_output_delay = 0;
- process_output_delay_count--;
- p->read_output_skip = 0;
- }
-#endif
+ if (p->read_output_delay > 0
+ && p->adaptive_read_buffering == 1)
+ {
+ p->read_output_delay = 0;
+ process_output_delay_count--;
+ p->read_output_skip = 0;
}
- signal (SIGPIPE, old_sigpipe);
+#endif
+ }
- if (rv < 0)
- {
- if (0
+ if (rv < 0)
+ {
+ if (0
#ifdef EWOULDBLOCK
- || errno == EWOULDBLOCK
+ || errno == EWOULDBLOCK
#endif
#ifdef EAGAIN
- || errno == EAGAIN
+ || errno == EAGAIN
#endif
- )
- /* Buffer is full. Wait, accepting input;
- that may allow the program
- to finish doing output and read more. */
- {
- EMACS_INT offset = 0;
-
+ )
+ /* Buffer is full. Wait, accepting input;
+ that may allow the program
+ to finish doing output and read more. */
+ {
#ifdef BROKEN_PTY_READ_AFTER_EAGAIN
- /* A gross hack to work around a bug in FreeBSD.
- In the following sequence, read(2) returns
- bogus data:
-
- write(2) 1022 bytes
- write(2) 954 bytes, get EAGAIN
- read(2) 1024 bytes in process_read_output
- read(2) 11 bytes in process_read_output
-
- That is, read(2) returns more bytes than have
- ever been written successfully. The 1033 bytes
- read are the 1022 bytes written successfully
- after processing (for example with CRs added if
- the terminal is set up that way which it is
- here). The same bytes will be seen again in a
- later read(2), without the CRs. */
-
- if (errno == EAGAIN)
- {
- int flags = FWRITE;
- ioctl (p->outfd, TIOCFLUSH, &flags);
- }
+ /* A gross hack to work around a bug in FreeBSD.
+ In the following sequence, read(2) returns
+ bogus data:
+
+ write(2) 1022 bytes
+ write(2) 954 bytes, get EAGAIN
+ read(2) 1024 bytes in process_read_output
+ read(2) 11 bytes in process_read_output
+
+ That is, read(2) returns more bytes than have
+ ever been written successfully. The 1033 bytes
+ read are the 1022 bytes written successfully
+ after processing (for example with CRs added if
+ the terminal is set up that way which it is
+ here). The same bytes will be seen again in a
+ later read(2), without the CRs. */
+
+ if (errno == EAGAIN)
+ {
+ int flags = FWRITE;
+ ioctl (p->outfd, TIOCFLUSH, &flags);
+ }
#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
- /* Running filters might relocate buffers or strings.
- Arrange to relocate BUF. */
- if (BUFFERP (object))
- offset = BUF_PTR_BYTE_POS (XBUFFER (object),
- (unsigned char *) buf);
- else if (STRINGP (object))
- offset = buf - SSDATA (object);
-
-#ifdef EMACS_HAS_USECS
- wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
-#else
- wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
-#endif
-
- if (BUFFERP (object))
- buf = (char *) BUF_BYTE_ADDRESS (XBUFFER (object),
- offset);
- else if (STRINGP (object))
- buf = offset + SSDATA (object);
- }
- else
- /* This is a real error. */
- report_file_error ("writing to process", Fcons (proc, Qnil));
+ /* Put what we should have written in wait_queue. */
+ write_queue_push (p, cur_object, cur_buf, cur_len, 1);
+ wait_reading_process_output (0, 20 * 1000 * 1000,
+ 0, 0, Qnil, NULL, 0);
+ /* Reread queue, to see what is left. */
+ break;
+ }
+ else if (errno == EPIPE)
+ {
+ p->raw_status_new = 0;
+ pset_status (p, list2 (Qexit, make_number (256)));
+ p->tick = ++process_tick;
+ deactivate_process (proc);
+ error ("process %s no longer connected to pipe; closed it",
+ SDATA (p->name));
}
- buf += written;
- len -= written;
- this -= written;
+ else
+ /* This is a real error. */
+ report_file_error ("writing to process", Fcons (proc, Qnil));
}
+ cur_buf += written;
+ cur_len -= written;
}
}
- else
- {
- signal (SIGPIPE, old_sigpipe);
- proc = process_sent_to;
- p = XPROCESS (proc);
- p->raw_status_new = 0;
- 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 (p->name));
- }
-
- UNGCPRO;
+ while (!NILP (p->write_queue));
}
DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
(Lisp_Object process, Lisp_Object start, Lisp_Object end)
{
Lisp_Object proc;
- EMACS_INT start1, end1;
+ ptrdiff_t start1, end1;
proc = get_process (process);
validate_region (&start, &end);
\f
/* Return the foreground process group for the tty/pty that
the process P uses. */
-static int
+static pid_t
emacs_get_tty_pgrp (struct Lisp_Process *p)
{
- int gid = -1;
+ pid_t gid = -1;
#ifdef TIOCGPGRP
if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
{
/* Initialize in case ioctl doesn't exist or gives an error,
in a way that will cause returning t. */
- int gid;
+ pid_t gid;
Lisp_Object proc;
struct Lisp_Process *p;
{
Lisp_Object proc;
register struct Lisp_Process *p;
- int gid;
+ pid_t gid;
int no_pgrp = 0;
proc = get_process (process);
#ifdef SIGCONT
case SIGCONT:
p->raw_status_new = 0;
- p->status = Qrun;
+ pset_status (p, Qrun);
p->tick = ++process_tick;
if (!nomsg)
{
FD_CLR (p->infd, &input_wait_mask);
FD_CLR (p->infd, &non_keyboard_wait_mask);
}
- p->command = Qt;
+ pset_command (p, Qt);
return process;
}
#ifndef SIGTSTP
tcflush (p->infd, TCIFLUSH);
#endif /* not WINDOWSNT */
}
- p->command = Qnil;
+ pset_command (p, Qnil);
return process;
}
#ifdef SIGCONT
{
pid_t pid;
- if (INTEGERP (process))
- {
- pid = XINT (process);
- goto got_it;
- }
-
- if (FLOATP (process))
- {
- pid = (pid_t) XFLOAT_DATA (process);
- goto got_it;
- }
-
if (STRINGP (process))
{
- Lisp_Object tem;
- if (tem = Fget_process (process), NILP (tem))
+ Lisp_Object tem = Fget_process (process);
+ if (NILP (tem))
{
- pid = XINT (Fstring_to_number (process, make_number (10)));
- if (pid > 0)
- goto got_it;
+ Lisp_Object process_number =
+ string_to_number (SSDATA (process), 10, 1);
+ if (INTEGERP (process_number) || FLOATP (process_number))
+ tem = process_number;
}
process = tem;
}
- else
+ else if (!NUMBERP (process))
process = get_process (process);
if (NILP (process))
return process;
- CHECK_PROCESS (process);
- pid = XPROCESS (process)->pid;
- if (pid <= 0)
- error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
-
- got_it:
+ if (NUMBERP (process))
+ CONS_TO_INTEGER (process, pid_t, pid);
+ else
+ {
+ CHECK_PROCESS (process);
+ pid = XPROCESS (process)->pid;
+ if (pid <= 0)
+ error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
+ }
#define parse_signal(NAME, VALUE) \
else if (!xstrcasecmp (name, NAME)) \
XSETINT (sigcode, VALUE)
if (INTEGERP (sigcode))
- ;
+ CHECK_TYPE_RANGED_INTEGER (int, sigcode);
else
{
char *name;
#ifdef SIGUSR2
parse_signal ("usr2", SIGUSR2);
#endif
-#ifdef SIGTERM
parse_signal ("term", SIGTERM);
-#endif
#ifdef SIGHUP
parse_signal ("hup", SIGHUP);
#endif
-#ifdef SIGINT
parse_signal ("int", SIGINT);
-#endif
#ifdef SIGQUIT
parse_signal ("quit", SIGQUIT);
#endif
-#ifdef SIGILL
parse_signal ("ill", SIGILL);
-#endif
-#ifdef SIGABRT
parse_signal ("abrt", SIGABRT);
-#endif
#ifdef SIGEMT
parse_signal ("emt", SIGEMT);
#endif
#ifdef SIGKILL
parse_signal ("kill", SIGKILL);
#endif
-#ifdef SIGFPE
parse_signal ("fpe", SIGFPE);
-#endif
#ifdef SIGBUS
parse_signal ("bus", SIGBUS);
#endif
-#ifdef SIGSEGV
parse_signal ("segv", SIGSEGV);
-#endif
#ifdef SIGSYS
parse_signal ("sys", SIGSYS);
#endif
#endif /* not HAVE_SHUTDOWN */
new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
if (new_outfd < 0)
- abort ();
+ emacs_abort ();
old_outfd = XPROCESS (proc)->outfd;
if (!proc_encode_coding_system[new_outfd])
proc_encode_coding_system[new_outfd]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- memcpy (proc_encode_coding_system[new_outfd],
- proc_encode_coding_system[old_outfd],
- sizeof (struct coding_system));
+ = xmalloc (sizeof (struct coding_system));
+ *proc_encode_coding_system[new_outfd]
+ = *proc_encode_coding_system[old_outfd];
memset (proc_encode_coding_system[old_outfd], 0,
sizeof (struct coding_system));
** Malloc WARNING: This should never call malloc either directly or
indirectly; if it does, that is a bug */
-#ifdef SIGCHLD
-static void
-sigchld_handler (int signo)
+/* Record the changed status of the child process PID with wait status W. */
+void
+record_child_status_change (pid_t pid, int w)
{
- int old_errno = errno;
+#ifdef SIGCHLD
Lisp_Object proc;
struct Lisp_Process *p;
+ Lisp_Object tail;
- SIGNAL_THREAD_CHECK (signo);
+ /* Find the process that signaled us, and record its status. */
- while (1)
+ /* The process can have been deleted by Fdelete_process. */
+ for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
{
- pid_t pid;
- int w;
- Lisp_Object tail;
-
-#ifdef WNOHANG
-#ifndef WUNTRACED
-#define WUNTRACED 0
-#endif /* no WUNTRACED */
- /* Keep trying to get a status until we get a definitive result. */
- do
+ Lisp_Object xpid = XCAR (tail);
+ if ((INTEGERP (xpid) && pid == XINT (xpid))
+ || (FLOATP (xpid) && pid == XFLOAT_DATA (xpid)))
{
- errno = 0;
- pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
- }
- while (pid < 0 && errno == EINTR);
-
- if (pid <= 0)
- {
- /* PID == 0 means no processes found, PID == -1 means a real
- failure. We have done all our job, so return. */
-
- errno = old_errno;
+ XSETCAR (tail, Qnil);
return;
}
-#else
- pid = wait (&w);
-#endif /* no WNOHANG */
-
- /* Find the process that signaled us, and record its status. */
-
- /* The process can have been deleted by Fdelete_process. */
- for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object xpid = XCAR (tail);
- if ((INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
- || (FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
- {
- XSETCAR (tail, Qnil);
- goto sigchld_end_of_loop;
- }
- }
+ }
- /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
+ /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
+ p = 0;
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ proc = XCDR (XCAR (tail));
+ p = XPROCESS (proc);
+ if (EQ (p->type, Qreal) && p->pid == pid)
+ break;
p = 0;
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
- {
- proc = XCDR (XCAR (tail));
- p = XPROCESS (proc);
- if (EQ (p->type, Qreal) && p->pid == pid)
- break;
- p = 0;
- }
-
- /* Look for an asynchronous process whose pid hasn't been filled
- in yet. */
- if (p == 0)
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
- {
- proc = XCDR (XCAR (tail));
- p = XPROCESS (proc);
- if (p->pid == -1)
- break;
- p = 0;
- }
-
- /* Change the status of the process that was found. */
- if (p != 0)
- {
- int clear_desc_flag = 0;
+ }
- p->tick = ++process_tick;
- p->raw_status = w;
- p->raw_status_new = 1;
+ /* Look for an asynchronous process whose pid hasn't been filled
+ in yet. */
+ if (! p)
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ proc = XCDR (XCAR (tail));
+ p = XPROCESS (proc);
+ if (p->pid == -1)
+ break;
+ p = 0;
+ }
- /* If process has terminated, stop waiting for its output. */
- if ((WIFSIGNALED (w) || WIFEXITED (w))
- && p->infd >= 0)
- clear_desc_flag = 1;
+ /* Change the status of the process that was found. */
+ if (p)
+ {
+ int clear_desc_flag = 0;
- /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
- if (clear_desc_flag)
- {
- FD_CLR (p->infd, &input_wait_mask);
- FD_CLR (p->infd, &non_keyboard_wait_mask);
- }
+ p->tick = ++process_tick;
+ p->raw_status = w;
+ p->raw_status_new = 1;
- /* Tell wait_reading_process_output that it needs to wake up and
- look around. */
- if (input_available_clear_time)
- EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
- }
+ /* If process has terminated, stop waiting for its output. */
+ if ((WIFSIGNALED (w) || WIFEXITED (w))
+ && p->infd >= 0)
+ clear_desc_flag = 1;
- /* There was no asynchronous process found for that pid: we have
- a synchronous process. */
- else
+ /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
+ if (clear_desc_flag)
{
- synch_process_alive = 0;
-
- /* Report the status of the synchronous process. */
- if (WIFEXITED (w))
- synch_process_retcode = WRETCODE (w);
- else if (WIFSIGNALED (w))
- synch_process_termsig = WTERMSIG (w);
-
- /* Tell wait_reading_process_output that it needs to wake up and
- look around. */
- if (input_available_clear_time)
- EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
+ FD_CLR (p->infd, &input_wait_mask);
+ FD_CLR (p->infd, &non_keyboard_wait_mask);
}
- sigchld_end_of_loop:
- ;
+ /* Tell wait_reading_process_output that it needs to wake up and
+ look around. */
+ if (input_available_clear_time)
+ *input_available_clear_time = make_emacs_time (0, 0);
+ }
+ /* There was no asynchronous process found for that pid: we have
+ a synchronous process. */
+ else
+ {
+ synch_process_alive = 0;
+
+ /* Report the status of the synchronous process. */
+ if (WIFEXITED (w))
+ synch_process_retcode = WEXITSTATUS (w);
+ else if (WIFSIGNALED (w))
+ synch_process_termsig = WTERMSIG (w);
+
+ /* Tell wait_reading_process_output that it needs to wake up and
+ look around. */
+ if (input_available_clear_time)
+ *input_available_clear_time = make_emacs_time (0, 0);
+ }
+#endif
+}
- /* On some systems, we must return right away.
- If any more processes want to signal us, we will
- get another signal.
- Otherwise (on systems that have WNOHANG), loop around
- to use up all the processes that have something to tell us. */
+#ifdef SIGCHLD
+
+/* On some systems, the SIGCHLD handler must return right away. If
+ any more processes want to signal us, we will get another signal.
+ Otherwise, loop around to use up all the processes that have
+ something to tell us. */
#if (defined WINDOWSNT \
|| (defined USG && !defined GNU_LINUX \
&& !(defined HPUX && defined WNOHANG)))
- errno = old_errno;
- return;
-#endif /* USG, but not HPUX with WNOHANG */
+enum { CAN_HANDLE_MULTIPLE_CHILDREN = 0 };
+#else
+enum { CAN_HANDLE_MULTIPLE_CHILDREN = 1 };
+#endif
+
+static void
+handle_child_signal (int sig)
+{
+ do
+ {
+ pid_t pid;
+ int status;
+
+ do
+ pid = waitpid (-1, &status, WNOHANG | WUNTRACED);
+ while (pid < 0 && errno == EINTR);
+
+ /* PID == 0 means no processes found, PID == -1 means a real failure.
+ Either way, we have done all our job. */
+ if (pid <= 0)
+ break;
+
+ record_child_status_change (pid, status);
}
+ while (CAN_HANDLE_MULTIPLE_CHILDREN);
}
+
+static void
+deliver_child_signal (int sig)
+{
+ deliver_process_signal (sig, handle_child_signal);
+}
+
#endif /* SIGCHLD */
\f
static Lisp_Object
exec_sentinel_unwind (Lisp_Object data)
{
- XPROCESS (XCAR (data))->sentinel = XCDR (data);
+ pset_sentinel (XPROCESS (XCAR (data)), XCDR (data));
return Qnil;
}
exec_sentinel (Lisp_Object proc, Lisp_Object reason)
{
Lisp_Object sentinel, odeactivate;
- register struct Lisp_Process *p = XPROCESS (proc);
- int count = SPECPDL_INDEX ();
- int outer_running_asynch_code = running_asynch_code;
+ struct Lisp_Process *p = XPROCESS (proc);
+ ptrdiff_t count = SPECPDL_INDEX ();
+ bool outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
if (inhibit_sentinels)
/* There's no good reason to let sentinels change the current
buffer, and many callers of accept-process-output, sit-for, and
friends don't expect current-buffer to be changed from under them. */
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
sentinel = p->sentinel;
if (NILP (sentinel))
/* Zilch the sentinel while it's running, to avoid recursive invocations;
assure that it gets restored no matter how the sentinel exits. */
- p->sentinel = Qnil;
+ pset_sentinel (p, 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);
{
Lisp_Object tem;
struct buffer *old = current_buffer;
- EMACS_INT opoint, opoint_byte;
- EMACS_INT before, before_byte;
+ ptrdiff_t opoint, opoint_byte;
+ ptrdiff_t before, before_byte;
/* Avoid error if buffer is deleted
(probably that's why the process is dead, too) */
- if (NILP (BVAR (XBUFFER (buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (buffer)))
continue;
Fset_buffer (buffer);
before_byte = PT_BYTE;
tem = BVAR (current_buffer, read_only);
- BVAR (current_buffer, read_only) = Qnil;
+ bset_read_only (current_buffer, Qnil);
insert_string ("\nProcess ");
- Finsert (1, &p->name);
+ { /* FIXME: temporary kludge */
+ Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
insert_string (" ");
Finsert (1, &msg);
- BVAR (current_buffer, read_only) = tem;
+ bset_read_only (current_buffer, tem);
set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
if (opoint >= before)
Fcheck_coding_system (decoding);
Fcheck_coding_system (encoding);
encoding = coding_inherit_eol_type (encoding, Qnil);
- p->decode_coding_system = decoding;
- p->encode_coding_system = encoding;
+ pset_decode_coding_system (p, decoding);
+ pset_encode_coding_system (p, encoding);
setup_process_coding_systems (process);
return Qnil;
CHECK_PROCESS (process);
p = XPROCESS (process);
if (NILP (flag))
- p->decode_coding_system = raw_text_coding_system (p->decode_coding_system);
+ pset_decode_coding_system
+ (p, raw_text_coding_system (p->decode_coding_system));
setup_process_coding_systems (process);
return Qnil;
# endif
-# ifdef SIGIO
+# ifdef USABLE_SIGIO
/* Return nonzero if *MASK has a bit set
that corresponds to one of the keyboard input descriptors. */
/* Defined on msdos.c. */
extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
- EMACS_TIME *);
+ EMACS_TIME *, void *);
/* Implementation of wait_reading_process_output, assuming that there
are no subprocesses. Used only by the MS-DOS build.
Wait for timeout to elapse and/or keyboard input to be available.
- time_limit is:
- timeout in seconds, or
- zero for no limit, or
- -1 means gobble data immediately available but don't wait for any.
+ TIME_LIMIT is:
+ timeout in seconds
+ If negative, gobble data immediately available but don't wait for any.
+
+ NSECS is:
+ an additional duration to wait, measured in nanoseconds
+ If TIME_LIMIT is zero, then:
+ If NSECS == 0, there is no limit.
+ If NSECS > 0, the timeout consists of NSECS only.
+ If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
- read_kbd is a Lisp_Object:
+ READ_KBD is:
0 to ignore keyboard input, or
1 to return when input is available, or
-1 means caller will actually read the input, so don't throw to
see full version for other parameters. We know that wait_proc will
always be NULL, since `subprocesses' isn't defined.
- do_display != 0 means redisplay should be done to show subprocess
+ DO_DISPLAY != 0 means redisplay should be done to show subprocess
output that arrives.
Return true if we received input from any process. */
int
-wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
+wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
int do_display,
Lisp_Object wait_for_cell,
struct Lisp_Process *wait_proc, int just_wait_proc)
{
register int nfds;
EMACS_TIME end_time, timeout;
- SELECT_TYPE waitchannels;
- int xerrno;
+
+ if (time_limit < 0)
+ {
+ time_limit = 0;
+ nsecs = -1;
+ }
+ else if (TYPE_MAXIMUM (time_t) < time_limit)
+ time_limit = TYPE_MAXIMUM (time_t);
/* What does time_limit really mean? */
- if (time_limit || microsecs)
+ if (time_limit || 0 < nsecs)
{
- EMACS_GET_TIME (end_time);
- EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
- EMACS_ADD_TIME (end_time, end_time, timeout);
+ timeout = make_emacs_time (time_limit, nsecs);
+ end_time = add_emacs_time (current_emacs_time (), timeout);
}
/* Turn off periodic alarms (in case they are in use)
while (1)
{
int timeout_reduced_for_timers = 0;
+ SELECT_TYPE waitchannels;
+ int xerrno;
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
/* Compute time from now till when time limit is up */
/* Exit if already run out */
- if (time_limit == -1)
+ if (nsecs < 0)
{
- /* -1 specified for timeout means
+ /* A negative timeout means
gobble output available now
but don't wait at all. */
- EMACS_SET_SECS_USECS (timeout, 0, 0);
+ timeout = make_emacs_time (0, 0);
}
- else if (time_limit || microsecs)
+ else if (time_limit || 0 < nsecs)
{
- EMACS_GET_TIME (timeout);
- EMACS_SUB_TIME (timeout, end_time, timeout);
- if (EMACS_TIME_NEG_P (timeout))
+ EMACS_TIME now = current_emacs_time ();
+ if (EMACS_TIME_LE (end_time, now))
break;
+ timeout = sub_emacs_time (end_time, now);
}
else
{
- EMACS_SET_SECS_USECS (timeout, 100000, 0);
+ timeout = make_emacs_time (100000, 0);
}
/* If our caller will not immediately handle keyboard events,
&& requeued_events_pending_p ())
break;
- if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
+ if (EMACS_TIME_VALID_P (timer_delay) && 0 <= nsecs)
{
- EMACS_TIME difference;
- EMACS_SUB_TIME (difference, timer_delay, timeout);
- if (EMACS_TIME_NEG_P (difference))
+ if (EMACS_TIME_LT (timer_delay, timeout))
{
timeout = timer_delay;
timeout_reduced_for_timers = 1;
if (read_kbd < 0)
set_waiting_for_input (&timeout);
- /* Wait till there is something to do. */
-
- if (! read_kbd && NILP (wait_for_cell))
- FD_ZERO (&waitchannels);
- else
- FD_SET (0, &waitchannels);
-
/* If a frame has been newly mapped and needs updating,
reprocess its display stuff. */
if (frame_garbaged && do_display)
set_waiting_for_input (&timeout);
}
+ /* Wait till there is something to do. */
+ FD_ZERO (&waitchannels);
if (read_kbd && detect_input_pending ())
+ nfds = 0;
+ else
{
- nfds = 0;
- FD_ZERO (&waitchannels);
+ if (read_kbd || !NILP (wait_for_cell))
+ FD_SET (0, &waitchannels);
+ nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
}
- else
- nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &timeout);
xerrno = errno;
/* If we woke up due to SIGWINCH, actually change size now. */
do_pending_window_change (0);
- if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
+ if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers)
/* We waited the full specified time, so return now. */
break;
return;
if (!proc_decode_coding_system[inch])
- proc_decode_coding_system[inch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
coding_system = p->decode_coding_system;
if (! NILP (p->filter))
;
setup_coding_system (coding_system, proc_decode_coding_system[inch]);
if (!proc_encode_coding_system[outch])
- proc_encode_coding_system[outch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[outch]);
#endif
majflt -- number of major page faults (number)
cminflt -- cumulative number of minor page faults (number)
cmajflt -- cumulative number of major page faults (number)
- utime -- user time used by the process, in the (HIGH LOW USEC) format
- stime -- system time used by the process, in the (HIGH LOW USEC) format
- time -- sum of utime and stime, in the (HIGH LOW USEC) format
- cutime -- user time used by the process and its children, (HIGH LOW USEC)
- cstime -- system time used by the process and its children, (HIGH LOW USEC)
- ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
+ utime -- user time used by the process, in (current-time) format,
+ which is a list of integers (HIGH LOW USEC PSEC)
+ stime -- system time used by the process (current-time)
+ time -- sum of utime and stime (current-time)
+ cutime -- user time used by the process and its children (current-time)
+ cstime -- system time used by the process and its children (current-time)
+ ctime -- sum of cutime and cstime (current-time)
pri -- priority of the process (number)
nice -- nice value of the process (number)
thcount -- process thread count (number)
- start -- time the process started, in the (HIGH LOW USEC) format
+ start -- time the process started (current-time)
vsize -- virtual memory size of the process in KB's (number)
rss -- resident set size of the process in KB's (number)
- etime -- elapsed time the process is running, in (HIGH LOW USEC) format
+ etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
pcpu -- percents of CPU time used by the process (floating-point number)
pmem -- percents of total physical memory used by process's resident set
(floating-point number)
}
\f
+/* This is not called "init_process" because that is the name of a
+ Mach system call, so it would cause problems on Darwin systems. */
void
-init_process (void)
+init_process_emacs (void)
{
#ifdef subprocesses
register int i;
#ifndef CANNOT_DUMP
if (! noninteractive || initialized)
#endif
- signal (SIGCHLD, sigchld_handler);
+ {
+ struct sigaction action;
+ emacs_sigaction_init (&action, deliver_child_signal);
+ sigaction (SIGCHLD, &action, 0);
+ }
#endif
FD_ZERO (&input_wait_mask);
char const *release = (STRINGP (Voperating_system_release)
? SSDATA (Voperating_system_release)
: 0);
- if (!release || !release[0] || (release[0] < MIN_PTY_KERNEL_VERSION
- && release[1] == '.')) {
+ if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) {
Vprocess_connection_type = Qnil;
}
}
DEFSYM (Qargs, "args");
DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
- doc: /* *Non-nil means delete processes immediately when they exit.
+ doc: /* Non-nil means delete processes immediately when they exit.
A value of nil means don't delete them until `list-processes' is run. */);
delete_exited_processes = 1;
#include "gnutls.h"
#endif
-/* This structure records information about a subprocess
- or network connection.
+INLINE_HEADER_BEGIN
+#ifndef PROCESS_INLINE
+# define PROCESS_INLINE INLINE
+#endif
- Every field in this structure except for the header
- must be a Lisp_Object, for GC's sake. */
+/* This structure records information about a subprocess
+ or network connection. */
struct Lisp_Process
{
/* Name of subprocess terminal. */
Lisp_Object tty_name;
+
/* Name of this process */
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 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 filter;
+
/* (funcall SENTINEL PROCESS) when process state changes */
Lisp_Object sentinel;
+
/* (funcall LOG SERVER CLIENT MESSAGE) when a server process
accepts a connection from a client. */
Lisp_Object log;
+
/* Buffer that output is going to */
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 childp;
+
/* Plist for programs to keep per-process state information, parameters, etc. */
Lisp_Object plist;
+
/* Symbol indicating the type of process: real, network, serial */
Lisp_Object type;
+
/* Marker set to end of last buffer-inserted output from this process */
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 status;
+
/* Coding-system for decoding the input from this process. */
Lisp_Object decode_coding_system;
+
/* Working buffer for decoding. */
Lisp_Object decoding_buf;
+
/* Coding-system for encoding the output to this process. */
Lisp_Object encode_coding_system;
+
/* Working buffer for encoding. */
Lisp_Object encoding_buf;
+ /* Queue for storing waiting writes */
+ Lisp_Object write_queue;
+
#ifdef HAVE_GNUTLS
Lisp_Object gnutls_cred_type;
#endif
/* Descriptor by which we write to this process */
int outfd;
/* Event-count of last event in which this process changed status. */
- int tick;
+ EMACS_INT tick;
/* Event-count of last such event reported. */
- int update_tick;
+ EMACS_INT update_tick;
/* Size of carryover in decoding. */
int decoding_carryover;
/* Hysteresis to try to read process output in larger blocks.
On some systems, e.g. GNU/Linux, Emacs is seen as
an interactive app also when reading process output, meaning
that process output can be read in as little as 1 byte at a
- time. Value is micro-seconds to delay reading output from
- this process. Range is 0 .. 50000. */
+ time. Value is nanoseconds to delay reading output from
+ this process. Range is 0 .. 50 * 1000 * 1000. */
int read_output_delay;
/* Should we delay reading output from this process.
Initialized from `Vprocess_adaptive_read_buffering'.
#define ChannelMask(n) (1 << (n))
+/* Most code should use these functions to set Lisp fields in struct
+ process. */
+
+PROCESS_INLINE void
+pset_childp (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->childp = val;
+}
+
+#ifdef HAVE_GNUTLS
+PROCESS_INLINE void
+pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->gnutls_cred_type = val;
+}
+#endif
+
/* True if we are about to fork off a synchronous process or if we
are waiting for it. */
-extern int synch_process_alive;
+extern bool synch_process_alive;
/* Communicate exit status of sync process to from sigchld_handler
to Fcall_process. */
this is exit code of synchronous subprocess. */
extern int synch_process_retcode;
-/* The name of the file open to get a null file, or a data sink.
- MS-DOS, and OS/2 redefine this. */
-#ifndef NULL_DEVICE
-#define NULL_DEVICE "/dev/null"
-#endif
-
/* Nonzero means don't run process sentinels. This is used
when exiting. */
extern int inhibit_sentinels;
extern void unhold_keyboard_input (void);
extern int kbd_on_hold_p (void);
-typedef void (*fd_callback)(int fd, void *data, int for_read);
+typedef void (*fd_callback) (int fd, void *data);
extern void add_read_fd (int fd, fd_callback func, void *data);
extern void delete_read_fd (int fd);
extern void add_write_fd (int fd, fd_callback func, void *data);
extern void delete_write_fd (int fd);
+
+INLINE_HEADER_END
--- /dev/null
+/* Profiler implementation.
+
+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 <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include <stdio.h>
+#include <limits.h>
+#include <sys/time.h>
+#include <signal.h>
+#include <setjmp.h>
+#include "lisp.h"
+#include "syssignal.h"
+
+/* Logs. */
+
+typedef struct Lisp_Hash_Table log_t;
+
+static Lisp_Object
+make_log (int heap_size, int max_stack_depth)
+{
+ /* We use a standard Elisp hash-table object, but we use it in
+ a special way. This is OK as long as the object is not exposed
+ to Elisp, i.e. until it is returned by *-profiler-log, after which
+ it can't be used any more. */
+ Lisp_Object log = make_hash_table (Qequal, make_number (heap_size),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil, Qnil, Qnil);
+ struct Lisp_Hash_Table *h = XHASH_TABLE (log);
+
+ /* What is special about our hash-tables is that the keys are pre-filled
+ with the vectors we'll put in them. */
+ int i = ASIZE (h->key_and_value) / 2;
+ while (0 < i)
+ set_hash_key_slot (h, --i,
+ Fmake_vector (make_number (max_stack_depth), Qnil));
+ return log;
+}
+
+/* Evict the least used half of the hash_table.
+
+ When the table is full, we have to evict someone.
+ The easiest and most efficient is to evict the value we're about to add
+ (i.e. once the table is full, stop sampling).
+
+ We could also pick the element with the lowest count and evict it,
+ but finding it is O(N) and for that amount of work we get very
+ little in return: for the next sample, this latest sample will have
+ count==1 and will hence be a prime candidate for eviction :-(
+
+ So instead, we take O(N) time to eliminate more or less half of the
+ entries (the half with the lowest counts). So we get an amortized
+ cost of O(1) and we get O(N) time for a new entry to grow larger
+ than the other least counts before a new round of eviction. */
+
+static EMACS_INT approximate_median (log_t *log,
+ ptrdiff_t start, ptrdiff_t size)
+{
+ eassert (size > 0);
+ if (size < 2)
+ return XINT (HASH_VALUE (log, start));
+ if (size < 3)
+ /* Not an actual median, but better for our application than
+ choosing either of the two numbers. */
+ return ((XINT (HASH_VALUE (log, start))
+ + XINT (HASH_VALUE (log, start + 1)))
+ / 2);
+ else
+ {
+ ptrdiff_t newsize = size / 3;
+ ptrdiff_t start2 = start + newsize;
+ EMACS_INT i1 = approximate_median (log, start, newsize);
+ EMACS_INT i2 = approximate_median (log, start2, newsize);
+ EMACS_INT i3 = approximate_median (log, start2 + newsize,
+ size - 2 * newsize);
+ return (i1 < i2
+ ? (i2 < i3 ? i2 : (i1 < i3 ? i3 : i1))
+ : (i1 < i3 ? i1 : (i2 < i3 ? i3 : i2)));
+ }
+}
+
+static void evict_lower_half (log_t *log)
+{
+ ptrdiff_t size = ASIZE (log->key_and_value) / 2;
+ EMACS_INT median = approximate_median (log, 0, size);
+ ptrdiff_t i;
+
+ for (i = 0; i < size; i++)
+ /* Evict not only values smaller but also values equal to the median,
+ so as to make sure we evict something no matter what. */
+ if (XINT (HASH_VALUE (log, i)) <= median)
+ {
+ Lisp_Object key = HASH_KEY (log, i);
+ { /* FIXME: we could make this more efficient. */
+ Lisp_Object tmp;
+ XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */
+ Fremhash (key, tmp);
+ }
+ eassert (EQ (log->next_free, make_number (i)));
+ {
+ int j;
+ eassert (VECTORP (key));
+ for (j = 0; j < ASIZE (key); j++)
+ ASET (key, j, Qnil);
+ }
+ set_hash_key_slot (log, i, key);
+ }
+}
+
+/* Record the current backtrace in LOG. BASE is a special name for
+ describing which the backtrace come from. BASE can be nil. COUNT is
+ a number how many times the profiler sees the backtrace at the
+ time. ELAPSED is a elapsed time in millisecond that the backtrace
+ took. */
+
+static void
+record_backtrace (log_t *log, size_t count)
+{
+ struct backtrace *backlist = backtrace_list;
+ Lisp_Object backtrace;
+ ptrdiff_t index, i = 0;
+ ptrdiff_t asize;
+
+ if (!INTEGERP (log->next_free))
+ /* FIXME: transfer the evicted counts to a special entry rather
+ than dropping them on the floor. */
+ evict_lower_half (log);
+ index = XINT (log->next_free);
+
+ /* Get a "working memory" vector. */
+ backtrace = HASH_KEY (log, index);
+ asize = ASIZE (backtrace);
+
+ /* Copy the backtrace contents into working memory. */
+ for (; i < asize && backlist; i++, backlist = backlist->next)
+ /* FIXME: For closures we should ignore the environment. */
+ ASET (backtrace, i, *backlist->function);
+
+ /* Make sure that unused space of working memory is filled with nil. */
+ for (; i < asize; i++)
+ ASET (backtrace, i, Qnil);
+
+ { /* We basically do a `gethash+puthash' here, except that we have to be
+ careful to avoid memory allocation since we're in a signal
+ handler, and we optimize the code to try and avoid computing the
+ hash+lookup twice. See fns.c:Fputhash for reference. */
+ EMACS_UINT hash;
+ ptrdiff_t j = hash_lookup (log, backtrace, &hash);
+ if (j >= 0)
+ set_hash_value_slot (log, j,
+ make_number (count + XINT (HASH_VALUE (log, j))));
+ else
+ { /* BEWARE! hash_put in general can allocate memory.
+ But currently it only does that if log->next_free is nil. */
+ int j;
+ eassert (!NILP (log->next_free));
+ j = hash_put (log, backtrace, make_number (count), hash);
+ /* Let's make sure we've put `backtrace' right where it
+ already was to start with. */
+ eassert (index == j);
+
+ /* FIXME: If the hash-table is almost full, we should set
+ some global flag so that some Elisp code can offload its
+ data elsewhere, so as to avoid the eviction code.
+ There are 2 ways to do that, AFAICT:
+ - Set a flag checked in QUIT, such that QUIT can then call
+ Fprofiler_cpu_log and stash the full log for later use.
+ - Set a flag check in post-gc-hook, so that Elisp code can call
+ profiler-cpu-log. That gives us more flexibility since that
+ Elisp code can then do all kinds of fun stuff like write
+ the log to disk. Or turn it right away into a call tree.
+ Of course, using Elisp is generally preferable, but it may
+ take longer until we get a chance to run the Elisp code, so
+ there's more risk that the table will get full before we
+ get there. */
+ }
+ }
+}
+\f
+/* Sample profiler. */
+
+/* FIXME: Add support for the CPU profiler in W32. */
+/* FIXME: the sigprof_handler suffers from race-conditions if the signal
+ is delivered to a thread other than the main Emacs thread. */
+
+#if defined SIGPROF && defined HAVE_SETITIMER
+#define PROFILER_CPU_SUPPORT
+
+/* True if sampling profiler is running. */
+static bool profiler_cpu_running;
+
+static Lisp_Object cpu_log;
+/* Separate counter for the time spent in the GC. */
+static EMACS_INT cpu_gc_count;
+
+/* The current sample interval in millisecond. */
+
+static int current_sample_interval;
+
+/* Signal handler for sample profiler. */
+
+static void
+sigprof_handler_1 (int signal)
+{
+ eassert (HASH_TABLE_P (cpu_log));
+ if (backtrace_list && EQ (*backtrace_list->function, Qautomatic_gc))
+ /* Special case the time-count inside GC because the hash-table
+ code is not prepared to be used while the GC is running.
+ More specifically it uses ASIZE at many places where it does
+ not expect the ARRAY_MARK_FLAG to be set. We could try and
+ harden the hash-table code, but it doesn't seem worth the
+ effort. */
+ cpu_gc_count += current_sample_interval;
+ else
+ record_backtrace (XHASH_TABLE (cpu_log), current_sample_interval);
+}
+
+static void
+sigprof_handler (int signal)
+{
+ deliver_process_signal (signal, sigprof_handler_1);
+}
+
+DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start,
+ 1, 1, 0,
+ doc: /* Start or restart the cpu profiler.
+The cpu profiler will take call-stack samples each SAMPLE-INTERVAL (expressed in milliseconds).
+See also `profiler-log-size' and `profiler-max-stack-depth'. */)
+ (Lisp_Object sample_interval)
+{
+ struct sigaction sa;
+ struct itimerval timer;
+
+ if (profiler_cpu_running)
+ error ("Sample profiler is already running");
+
+ if (NILP (cpu_log))
+ {
+ cpu_gc_count = 0;
+ cpu_log = make_log (profiler_log_size,
+ profiler_max_stack_depth);
+ }
+
+ current_sample_interval = XINT (sample_interval);
+
+ sa.sa_handler = sigprof_handler;
+ sa.sa_flags = SA_RESTART;
+ sigemptyset (&sa.sa_mask);
+ sigaction (SIGPROF, &sa, 0);
+
+ timer.it_interval.tv_sec = 0;
+ timer.it_interval.tv_usec = current_sample_interval * 1000;
+ timer.it_value = timer.it_interval;
+ setitimer (ITIMER_PROF, &timer, 0);
+
+ profiler_cpu_running = true;
+
+ return Qt;
+}
+
+DEFUN ("profiler-cpu-stop", Fprofiler_cpu_stop, Sprofiler_cpu_stop,
+ 0, 0, 0,
+ doc: /* Stop the cpu profiler. The profiler log is not affected.
+Return non-nil if the profiler was running. */)
+ (void)
+{
+ if (!profiler_cpu_running)
+ return Qnil;
+ profiler_cpu_running = false;
+
+ setitimer (ITIMER_PROF, 0, 0);
+
+ return Qt;
+}
+
+DEFUN ("profiler-cpu-running-p",
+ Fprofiler_cpu_running_p, Sprofiler_cpu_running_p,
+ 0, 0, 0,
+ doc: /* Return non-nil iff cpu profiler is running. */)
+ (void)
+{
+ return profiler_cpu_running ? Qt : Qnil;
+}
+
+DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log,
+ 0, 0, 0,
+ doc: /* Return the current cpu profiler log.
+The log is a hash-table mapping backtraces to counters which represent
+the amount of time spent at those points. Every backtrace is a vector
+of functions, where the last few elements may be nil.
+Before returning, a new log is allocated for future samples. */)
+ (void)
+{
+ Lisp_Object result = cpu_log;
+ /* Here we're making the log visible to Elisp , so it's not safe any
+ more for our use afterwards since we can't rely on its special
+ pre-allocated keys anymore. So we have to allocate a new one. */
+ cpu_log = (profiler_cpu_running
+ ? make_log (profiler_log_size, profiler_max_stack_depth)
+ : Qnil);
+ Fputhash (Fmake_vector (make_number (1), Qautomatic_gc),
+ make_number (cpu_gc_count),
+ result);
+ cpu_gc_count = 0;
+ return result;
+}
+#endif /* not defined PROFILER_CPU_SUPPORT */
+\f
+/* Memory profiler. */
+
+/* True if memory profiler is running. */
+bool profiler_memory_running;
+
+static Lisp_Object memory_log;
+
+DEFUN ("profiler-memory-start", Fprofiler_memory_start, Sprofiler_memory_start,
+ 0, 0, 0,
+ doc: /* Start/restart the memory profiler.
+The memory profiler will take samples of the call-stack whenever a new
+allocation takes place. Note that most small allocations only trigger
+the profiler occasionally.
+See also `profiler-log-size' and `profiler-max-stack-depth'. */)
+ (void)
+{
+ if (profiler_memory_running)
+ error ("Memory profiler is already running");
+
+ if (NILP (memory_log))
+ memory_log = make_log (profiler_log_size,
+ profiler_max_stack_depth);
+
+ profiler_memory_running = true;
+
+ return Qt;
+}
+
+DEFUN ("profiler-memory-stop",
+ Fprofiler_memory_stop, Sprofiler_memory_stop,
+ 0, 0, 0,
+ doc: /* Stop the memory profiler. The profiler log is not affected.
+Return non-nil if the profiler was running. */)
+ (void)
+{
+ if (!profiler_memory_running)
+ return Qnil;
+ profiler_memory_running = false;
+ return Qt;
+}
+
+DEFUN ("profiler-memory-running-p",
+ Fprofiler_memory_running_p, Sprofiler_memory_running_p,
+ 0, 0, 0,
+ doc: /* Return non-nil if memory profiler is running. */)
+ (void)
+{
+ return profiler_memory_running ? Qt : Qnil;
+}
+
+DEFUN ("profiler-memory-log",
+ Fprofiler_memory_log, Sprofiler_memory_log,
+ 0, 0, 0,
+ doc: /* Return the current memory profiler log.
+The log is a hash-table mapping backtraces to counters which represent
+the amount of memory allocated at those points. Every backtrace is a vector
+of functions, where the last few elements may be nil.
+Before returning, a new log is allocated for future samples. */)
+ (void)
+{
+ Lisp_Object result = memory_log;
+ /* Here we're making the log visible to Elisp , so it's not safe any
+ more for our use afterwards since we can't rely on its special
+ pre-allocated keys anymore. So we have to allocate a new one. */
+ memory_log = (profiler_memory_running
+ ? make_log (profiler_log_size, profiler_max_stack_depth)
+ : Qnil);
+ return result;
+}
+
+\f
+/* Signals and probes. */
+
+/* Record that the current backtrace allocated SIZE bytes. */
+void
+malloc_probe (size_t size)
+{
+ eassert (HASH_TABLE_P (memory_log));
+ record_backtrace (XHASH_TABLE (memory_log), size);
+}
+
+void
+syms_of_profiler (void)
+{
+ DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth,
+ doc: /* Number of elements from the call-stack recorded in the log. */);
+ profiler_max_stack_depth = 16;
+ DEFVAR_INT ("profiler-log-size", profiler_log_size,
+ doc: /* Number of distinct call-stacks that can be recorded in a profiler log.
+If the log gets full, some of the least-seen call-stacks will be evicted
+to make room for new entries. */);
+ profiler_log_size = 10000;
+
+#ifdef PROFILER_CPU_SUPPORT
+ profiler_cpu_running = false;
+ cpu_log = Qnil;
+ staticpro (&cpu_log);
+ defsubr (&Sprofiler_cpu_start);
+ defsubr (&Sprofiler_cpu_stop);
+ defsubr (&Sprofiler_cpu_running_p);
+ defsubr (&Sprofiler_cpu_log);
+#endif
+ profiler_memory_running = false;
+ memory_log = Qnil;
+ staticpro (&memory_log);
+ defsubr (&Sprofiler_memory_start);
+ defsubr (&Sprofiler_memory_stop);
+ defsubr (&Sprofiler_memory_running_p);
+ defsubr (&Sprofiler_memory_log);
+}
/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */
#ifndef PURESIZE_RATIO
-#if BITS_PER_EMACS_INT > 32
-#define PURESIZE_RATIO 10/6 /* Don't surround with `()'. */
+#if EMACS_INT_MAX >> 31 != 0
+#if PTRDIFF_MAX >> 31 != 0
+#define PURESIZE_RATIO 10 / 6 /* Don't surround with `()'. */
+#else
+#define PURESIZE_RATIO 8 / 6 /* Don't surround with `()'. */
+#endif
#else
#define PURESIZE_RATIO 1
#endif
/* ENABLE_CHECKING somehow increases the purespace used, probably because
it tends to cause some macro arguments to be evaluated twice. This is
a bug, but it's difficult to track it down. */
-#define PURESIZE_CHECKING_RATIO 12/10 /* Don't surround with `()'. */
+#define PURESIZE_CHECKING_RATIO 12 / 10 /* Don't surround with `()'. */
#else
#define PURESIZE_CHECKING_RATIO 1
#endif
{ if (PURE_P (obj)) \
pure_write_error (); }
-extern void pure_write_error (void) NO_RETURN;
+extern _Noreturn void pure_write_error (void);
\f
/* Define PURE_P. */
#ifdef emacs
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h" /* Needed for VALBITS. */
#include "blockinput.h"
#include <unistd.h>
-typedef POINTER_TYPE *POINTER;
-typedef size_t SIZE;
-
#ifdef DOUG_LEA_MALLOC
#define M_TOP_PAD -2
extern int mallopt (int, int);
#include <stddef.h>
-typedef size_t SIZE;
-typedef void *POINTER;
-
#include <unistd.h>
#include <malloc.h>
#include "getpagesize.h"
+typedef size_t SIZE;
+typedef void *POINTER;
#define NIL ((POINTER) 0)
/* A flag to indicate whether we have initialized ralloc yet. For
/* Macros for rounding. Note that rounding to any value is possible
by changing the definition of PAGE. */
#define PAGE (getpagesize ())
-#define ALIGNED(addr) (((unsigned long int) (addr) & (page_size - 1)) == 0)
#define ROUNDUP(size) (((unsigned long int) (size) + page_size - 1) \
& ~(page_size - 1))
-#define ROUND_TO_PAGE(addr) (addr & (~(page_size - 1)))
#define MEM_ALIGN sizeof (double)
#define MEM_ROUNDUP(addr) (((unsigned long int)(addr) + MEM_ALIGN - 1) \
} *heap_ptr;
#define NIL_HEAP ((heap_ptr) 0)
-#define HEAP_PTR_SIZE (sizeof (struct heap))
/* This is the first heap object.
If we need additional heap objects, each one resides at the beginning of
}
if (! heap)
- abort ();
+ emacs_abort ();
/* If we can't fit SIZE bytes in that heap,
try successive later heaps. */
/* This heap should have no blocs in it. */
if (last_heap->first_bloc != NIL_BLOC
|| last_heap->last_bloc != NIL_BLOC)
- abort ();
+ emacs_abort ();
/* Return the last heap, with its header, to the system. */
excess = (char *)last_heap->end - (char *)last_heap->start;
which returns the entire last heap to the system, seems
unlikely to trigger this mode of failure. */
if (last_heap->end != (*real_morecore) (0))
- abort ();
+ emacs_abort ();
}
}
}
-
-/* Return the total size in use by relocating allocator,
- above where malloc gets space. */
-
-long
-r_alloc_size_in_use (void)
-{
- return (char *) break_value - (char *) virtual_break_value;
-}
\f
/* The meat - allocating, freeing, and relocating blocs. */
register bloc_ptr new_bloc;
register heap_ptr heap;
- if (! (new_bloc = (bloc_ptr) malloc (BLOC_PTR_SIZE))
+ if (! (new_bloc = malloc (BLOC_PTR_SIZE))
|| ! (new_bloc->data = obtain (break_value, size)))
{
free (new_bloc);
/* No need to ever call this if arena is frozen, bug somewhere! */
if (r_alloc_freeze_level)
- abort ();
+ emacs_abort ();
while (b)
{
/* No need to ever call this if arena is frozen, bug somewhere! */
if (r_alloc_freeze_level)
- abort ();
+ emacs_abort ();
if (bloc == NIL_BLOC || size == bloc->size)
return 1;
}
if (heap == NIL_HEAP)
- abort ();
+ emacs_abort ();
old_size = bloc->size;
bloc->size = size;
__morecore hook values - in particular, __default_morecore in the
GNU malloc package. */
-POINTER
+static POINTER
r_alloc_sbrk (long int size)
{
register bloc_ptr b;
dead_bloc = find_bloc (ptr);
if (dead_bloc == NIL_BLOC)
- abort (); /* Double free? PTR not originally used to allocate? */
+ emacs_abort (); /* Double free? PTR not originally used to allocate? */
free_bloc (dead_bloc);
*ptr = 0;
bloc = find_bloc (ptr);
if (bloc == NIL_BLOC)
- abort (); /* Already freed? PTR not originally used to allocate? */
+ emacs_abort (); /* Already freed? PTR not originally used to allocate? */
if (size < bloc->size)
{
return *ptr;
}
-/* Disable relocations, after making room for at least SIZE bytes
- of non-relocatable heap if possible. The relocatable blocs are
- guaranteed to hold still until thawed, even if this means that
- malloc must return a null pointer. */
-
-void
-r_alloc_freeze (long int size)
-{
- if (! r_alloc_initialized)
- r_alloc_init ();
-
- /* If already frozen, we can't make any more room, so don't try. */
- if (r_alloc_freeze_level > 0)
- size = 0;
- /* If we can't get the amount requested, half is better than nothing. */
- while (size > 0 && r_alloc_sbrk (size) == 0)
- size /= 2;
- ++r_alloc_freeze_level;
- if (size > 0)
- r_alloc_sbrk (-size);
-}
-
-void
-r_alloc_thaw (void)
-{
-
- if (! r_alloc_initialized)
- r_alloc_init ();
-
- if (--r_alloc_freeze_level < 0)
- abort ();
-
- /* This frees all unused blocs. It is not too inefficient, as the resize
- and memcpy is done only once. Afterwards, all unreferenced blocs are
- already shrunk to zero size. */
- if (!r_alloc_freeze_level)
- {
- bloc_ptr *b = &first_bloc;
- while (*b)
- if (!(*b)->variable)
- free_bloc (*b);
- else
- b = &(*b)->next;
- }
-}
-
#if defined (emacs) && defined (DOUG_LEA_MALLOC)
}
if (bloc == NIL_BLOC || bloc->variable != old)
- abort (); /* Already freed? OLD not originally used to allocate? */
+ emacs_abort (); /* Already freed? OLD not originally used to allocate? */
/* Update variable to point to the new location. */
bloc->variable = new;
first_heap->start = first_heap->bloc_start
= virtual_break_value = break_value = (*real_morecore) (0);
if (break_value == NIL)
- abort ();
+ emacs_abort ();
extra_bytes = ROUNDUP (50000);
#endif
#ifdef DOUG_LEA_MALLOC
- BLOCK_INPUT;
+ block_input ();
mallopt (M_TOP_PAD, 64 * 4096);
- UNBLOCK_INPUT;
+ unblock_input ();
#else
#ifndef SYSTEM_MALLOC
- /* Give GNU malloc's morecore some hysteresis
- so that we move all the relocatable blocks much less often. */
- __malloc_extra_blocks = 64;
+ /* Give GNU malloc's morecore some hysteresis so that we move all
+ the relocatable blocks much less often. The number used to be
+ 64, but alloc.c would override that with 32 in code that was
+ removed when SYNC_INPUT became the only input handling mode.
+ That code was conditioned on !DOUG_LEA_MALLOC, so the call to
+ mallopt above is left unchanged. (Actually, I think there's no
+ system nowadays that uses DOUG_LEA_MALLOC and also uses
+ REL_ALLOC.) */
+ __malloc_extra_blocks = 32;
#endif
#endif
#pragma alloca
#endif
-#ifdef HAVE_CONFIG_H
-# include <config.h>
+/* Ignore some GCC warnings for now. This section should go away
+ once the Emacs and Gnulib regex code is merged. */
+#if (__GNUC__ == 4 && 5 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wstrict-overflow"
+# ifndef emacs
+# pragma GCC diagnostic ignored "-Wunused-but-set-variable"
+# pragma GCC diagnostic ignored "-Wunused-function"
+# pragma GCC diagnostic ignored "-Wunused-macros"
+# pragma GCC diagnostic ignored "-Wunused-result"
+# pragma GCC diagnostic ignored "-Wunused-variable"
+# endif
#endif
+#include <config.h>
+
#include <stddef.h>
#ifdef emacs
that make sense only in Emacs. */
#ifdef emacs
-# include <setjmp.h>
# include "lisp.h"
+# include "character.h"
# include "buffer.h"
/* Make syntax table lookup grant data in gl_state. */
# define SYNTAX_ENTRY_VIA_PROPERTY
# include "syntax.h"
-# include "character.h"
# include "category.h"
# ifdef malloc
/* When used in Emacs's lib-src, we need xmalloc and xrealloc. */
-void *
+static void *
xmalloc (size_t size)
{
- register void *val;
- val = (void *) malloc (size);
+ void *val = malloc (size);
if (!val && size)
{
write (2, "virtual memory exhausted\n", 25);
return val;
}
-void *
+static void *
xrealloc (void *block, size_t size)
{
- register void *val;
+ void *val;
/* We must call malloc explicitly when BLOCK is 0, since some
reallocs don't do this. */
if (! block)
- val = (void *) malloc (size);
+ val = malloc (size);
else
- val = (void *) realloc (block, size);
+ val = realloc (block, size);
if (!val && size)
{
write (2, "virtual memory exhausted\n", 25);
# endif
# define realloc xrealloc
+# include <stdbool.h>
# include <string.h>
/* Define the syntax stuff for \<, \>, etc. */
/* Sword must be nonzero for the wordchar pattern commands in re_match_2. */
enum syntaxcode { Swhitespace = 0, Sword = 1, Ssymbol = 2 };
-# define SWITCH_ENUM_CAST(x) (x)
-
/* Dummy macros for non-Emacs environments. */
# define CHAR_CHARSET(c) 0
# define CHARSET_LEADING_CODE_BASE(c) 0
#endif /* not emacs */
\f
-/* We remove any previous definition of `SIGN_EXTEND_CHAR',
- since ours (we hope) works properly with all combinations of
- machines, compilers, `char' and `unsigned char' argument types.
- (Per Bothner suggested the basic approach.) */
-#undef SIGN_EXTEND_CHAR
-#if __STDC__
-# define SIGN_EXTEND_CHAR(c) ((signed char) (c))
-#else /* not __STDC__ */
-/* As in Harbison and Steele. */
-# define SIGN_EXTEND_CHAR(c) ((((unsigned char) (c)) ^ 128) - 128)
-#endif
+#define SIGN_EXTEND_CHAR(c) ((signed char) (c))
\f
/* Should we use malloc or alloca? If REGEX_MALLOC is not defined, we
use `alloca' instead of `malloc'. This is because using malloc in
#endif
typedef char boolean;
-#define false 0
-#define true 1
-
-static regoff_t re_match_2_internal _RE_ARGS ((struct re_pattern_buffer *bufp,
- re_char *string1, size_t size1,
- re_char *string2, size_t size2,
- ssize_t pos,
- struct re_registers *regs,
- ssize_t stop));
+
+static regoff_t re_match_2_internal (struct re_pattern_buffer *bufp,
+ re_char *string1, size_t size1,
+ re_char *string2, size_t size2,
+ ssize_t pos,
+ struct re_registers *regs,
+ ssize_t stop);
\f
/* These are the command codes that appear in compiled regular
expressions. Some opcodes are followed by argument bytes. A
} while (0)
#ifdef DEBUG
-static void extract_number _RE_ARGS ((int *dest, re_char *source));
static void
-extract_number (dest, source)
- int *dest;
- re_char *source;
+extract_number (int *dest, re_char *source)
{
int temp = SIGN_EXTEND_CHAR (*(source + 1));
*dest = *source & 0377;
} while (0)
#ifdef DEBUG
-static void extract_number_and_incr _RE_ARGS ((int *destination,
- re_char **source));
static void
-extract_number_and_incr (destination, source)
- int *destination;
- re_char **source;
+extract_number_and_incr (int *destination, re_char **source)
{
extract_number (destination, *source);
*source += 2;
#ifdef MATCH_MAY_ALLOCATE
# define INIT_FAIL_STACK() \
do { \
- fail_stack.stack = (fail_stack_elt_t *) \
+ fail_stack.stack = \
REGEX_ALLOCATE_STACK (INIT_FAILURE_ALLOC * TYPICAL_FAILURE_SIZE \
* sizeof (fail_stack_elt_t)); \
\
>= re_max_failures * TYPICAL_FAILURE_SIZE) \
? 0 \
: ((fail_stack).stack \
- = (fail_stack_elt_t *) \
- REGEX_REALLOCATE_STACK ((fail_stack).stack, \
+ = REGEX_REALLOCATE_STACK ((fail_stack).stack, \
(fail_stack).size * sizeof (fail_stack_elt_t), \
MIN (re_max_failures * TYPICAL_FAILURE_SIZE, \
((fail_stack).size * sizeof (fail_stack_elt_t) \
\f
/* Subroutine declarations and macros for regex_compile. */
-static reg_errcode_t regex_compile _RE_ARGS ((re_char *pattern, size_t size,
- reg_syntax_t syntax,
- struct re_pattern_buffer *bufp));
-static void store_op1 _RE_ARGS ((re_opcode_t op, unsigned char *loc, int arg));
-static void store_op2 _RE_ARGS ((re_opcode_t op, unsigned char *loc,
- int arg1, int arg2));
-static void insert_op1 _RE_ARGS ((re_opcode_t op, unsigned char *loc,
- int arg, unsigned char *end));
-static void insert_op2 _RE_ARGS ((re_opcode_t op, unsigned char *loc,
- int arg1, int arg2, unsigned char *end));
-static boolean at_begline_loc_p _RE_ARGS ((re_char *pattern,
- re_char *p,
- reg_syntax_t syntax));
-static boolean at_endline_loc_p _RE_ARGS ((re_char *p,
- re_char *pend,
- reg_syntax_t syntax));
-static re_char *skip_one_char _RE_ARGS ((re_char *p));
-static int analyse_first _RE_ARGS ((re_char *p, re_char *pend,
- char *fastmap, const int multibyte));
+static reg_errcode_t regex_compile (re_char *pattern, size_t size,
+ reg_syntax_t syntax,
+ struct re_pattern_buffer *bufp);
+static void store_op1 (re_opcode_t op, unsigned char *loc, int arg);
+static void store_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2);
+static void insert_op1 (re_opcode_t op, unsigned char *loc,
+ int arg, unsigned char *end);
+static void insert_op2 (re_opcode_t op, unsigned char *loc,
+ int arg1, int arg2, unsigned char *end);
+static boolean at_begline_loc_p (re_char *pattern, re_char *p,
+ reg_syntax_t syntax);
+static boolean at_endline_loc_p (re_char *p, re_char *pend,
+ reg_syntax_t syntax);
+static re_char *skip_one_char (re_char *p);
+static int analyse_first (re_char *p, re_char *pend,
+ char *fastmap, const int multibyte);
/* Fetch the next character in the uncompiled pattern, with no
translation. */
be too small, many things would have to change. */
# define MAX_BUF_SIZE (1L << 15)
-#if 0 /* This is when we thought it could be 2^16 bytes. */
-/* Any other compiler which, like MSC, has allocation limit below 2^16
- bytes will have to use approach similar to what was done below for
- MSC and drop MAX_BUF_SIZE a bit. Otherwise you may end up
- reallocating to 0 bytes. Such thing is not going to work too well.
- You have been warned!! */
-#if defined _MSC_VER && !defined WIN32
-/* Microsoft C 16-bit versions limit malloc to approx 65512 bytes. */
-# define MAX_BUF_SIZE 65500L
-#else
-# define MAX_BUF_SIZE (1L << 16)
-#endif
-#endif /* 0 */
-
/* Extend the buffer by twice its current size via realloc and
reset the pointers that pointed into the old block to point to the
correct places in the new one. If extending the buffer results in it
/* The next available element. */
#define COMPILE_STACK_TOP (compile_stack.stack[compile_stack.avail])
-/* Explicit quit checking is only used on NTemacs and whenever we
- use polling to process input events. */
-#if defined emacs && (defined WINDOWSNT || defined SYNC_INPUT) && defined QUIT
+/* Explicit quit checking is needed for Emacs, which uses polling to
+ process input events. */
+#ifdef emacs
extern int immediate_quit;
# define IMMEDIATE_QUIT_CHECK \
do { \
extend_range_table_work_area (struct range_table_work_area *work_area)
{
work_area->allocated += 16 * sizeof (int);
- if (work_area->table)
- work_area->table
- = (int *) realloc (work_area->table, work_area->allocated);
- else
- work_area->table
- = (int *) malloc (work_area->allocated);
+ work_area->table = realloc (work_area->table, work_area->allocated);
}
#if 0
#endif /* not MATCH_MAY_ALLOCATE */
\f
-static boolean group_in_compile_stack _RE_ARGS ((compile_stack_type
- compile_stack,
- regnum_t regnum));
+static boolean group_in_compile_stack (compile_stack_type compile_stack,
+ regnum_t regnum);
/* `regex_compile' compiles PATTERN (of length SIZE) according to SYNTAX.
Returns one of error codes defined in `regex.h', or zero for success.
if (fail_stack.size < re_max_failures * TYPICAL_FAILURE_SIZE)
{
fail_stack.size = re_max_failures * TYPICAL_FAILURE_SIZE;
-
- if (! fail_stack.stack)
- fail_stack.stack
- = (fail_stack_elt_t *) malloc (fail_stack.size
- * sizeof (fail_stack_elt_t));
- else
- fail_stack.stack
- = (fail_stack_elt_t *) realloc (fail_stack.stack,
- (fail_stack.size
- * sizeof (fail_stack_elt_t)));
+ falk_stack.stack = realloc (fail_stack.stack,
+ fail_stack.size * sizeof *falk_stack.stack);
}
regex_grow_registers (num_regs);
at_begline_loc_p (const re_char *pattern, const re_char *p, reg_syntax_t syntax)
{
re_char *prev = p - 2;
- boolean prev_prev_backslash = prev > pattern && prev[-1] == '\\';
+ boolean odd_backslashes;
- return
- /* After a subexpression? */
- (*prev == '(' && (syntax & RE_NO_BK_PARENS || prev_prev_backslash))
- /* After an alternative? */
- || (*prev == '|' && (syntax & RE_NO_BK_VBAR || prev_prev_backslash))
- /* After a shy subexpression? */
- || ((syntax & RE_SHY_GROUPS) && prev - 2 >= pattern
- && prev[-1] == '?' && prev[-2] == '('
- && (syntax & RE_NO_BK_PARENS
- || (prev - 3 >= pattern && prev[-3] == '\\')));
+ /* After a subexpression? */
+ if (*prev == '(')
+ odd_backslashes = (syntax & RE_NO_BK_PARENS) == 0;
+
+ /* After an alternative? */
+ else if (*prev == '|')
+ odd_backslashes = (syntax & RE_NO_BK_VBAR) == 0;
+
+ /* After a shy subexpression? */
+ else if (*prev == ':' && (syntax & RE_SHY_GROUPS))
+ {
+ /* Skip over optional regnum. */
+ while (prev - 1 >= pattern && prev[-1] >= '0' && prev[-1] <= '9')
+ --prev;
+
+ if (!(prev - 2 >= pattern
+ && prev[-1] == '?' && prev[-2] == '('))
+ return false;
+ prev -= 2;
+ odd_backslashes = (syntax & RE_NO_BK_PARENS) == 0;
+ }
+ else
+ return false;
+
+ /* Count the number of preceding backslashes. */
+ p = prev;
+ while (prev - 1 >= pattern && prev[-1] == '\\')
+ --prev;
+ return (p - prev) & odd_backslashes;
}
as used for the *? operator. */
re_char *p1 = p;
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *p++))
+ switch (*p++)
{
case succeed:
return 1;
visited. `re_compile' should make sure this is true. */
break;
p += j;
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *p))
+ switch (*p)
{
case on_failure_jump:
case on_failure_keep_string_jump:
\f
/* Declarations and macros for re_match_2. */
-static int bcmp_translate _RE_ARGS ((re_char *s1, re_char *s2,
- register ssize_t len,
- RE_TRANSLATE_TYPE translate,
- const int multibyte));
+static int bcmp_translate (re_char *s1, re_char *s2,
+ register ssize_t len,
+ RE_TRANSLATE_TYPE translate,
+ const int multibyte);
/* This converts PTR, a pointer into one of the search strings `string1'
and `string2' into an offset from the beginning of that string. */
static re_char *
skip_one_char (const re_char *p)
{
- switch (SWITCH_ENUM_CAST (*p++))
+ switch (*p++)
{
case anychar:
break;
int mcnt;
while (p < pend)
{
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *p))
+ switch (*p)
{
case start_memory:
case stop_memory:
op2 = p2 == pend ? succeed : *p2;
- switch (SWITCH_ENUM_CAST (op2))
+ switch (op2)
{
case succeed:
case endbuf:
break;
case charset_not:
- switch (SWITCH_ENUM_CAST (*p1))
+ switch (*p1)
{
case exactn:
case charset:
}
/* Otherwise match next pattern command. */
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *p++))
+ switch (*p++)
{
/* Ignore these. Used to ignore the n of succeed_n's which
currently have n == 0. */
/* A restart point is known. Restore to that state. */
DEBUG_PRINT1 ("\nFAIL:\n");
POP_FAILURE_POINT (str, pat);
- switch (SWITCH_ENUM_CAST ((re_opcode_t) *pat++))
+ switch (*pat++)
{
case on_failure_keep_string_jump:
assert (str == NULL);
if (!re_comp_buf.buffer)
{
- re_comp_buf.buffer = (unsigned char *) malloc (200);
+ re_comp_buf.buffer = malloc (200);
if (re_comp_buf.buffer == NULL)
/* Yes, we're discarding `const' here if !HAVE_LIBINTL. */
return (char *) gettext (re_error_msgid[(int) REG_ESPACE]);
re_comp_buf.allocated = 200;
- re_comp_buf.fastmap = (char *) malloc (1 << BYTEWIDTH);
+ re_comp_buf.fastmap = malloc (1 << BYTEWIDTH);
if (re_comp_buf.fastmap == NULL)
/* Yes, we're discarding `const' here if !HAVE_LIBINTL. */
return (char *) gettext (re_error_msgid[(int) REG_ESPACE]);
preg->used = 0;
/* Try to allocate space for the fastmap. */
- preg->fastmap = (char *) malloc (1 << BYTEWIDTH);
+ preg->fastmap = malloc (1 << BYTEWIDTH);
if (cflags & REG_ICASE)
{
unsigned i;
- preg->translate
- = (RE_TRANSLATE_TYPE) malloc (CHAR_SET_SIZE
- * sizeof (*(RE_TRANSLATE_TYPE)0));
+ preg->translate = malloc (CHAR_SET_SIZE * sizeof *preg->translate);
if (preg->translate == NULL)
return (int) REG_ESPACE;
{
if (msg_size > errbuf_size)
{
- strncpy (errbuf, msg, errbuf_size - 1);
+ memcpy (errbuf, msg, errbuf_size - 1);
errbuf[errbuf_size - 1] = 0;
}
else
\f
/* Declarations for routines. */
-/* To avoid duplicating every routine declaration -- once with a
- prototype (if we are ANSI), and once without (if we aren't) -- we
- use the following macro to declare argument types. This
- unfortunately clutters up the declarations a bit, but I think it's
- worth it. */
-
-#if defined __STDC__ || defined PROTOTYPES
-
-# define _RE_ARGS(args) args
-
-#else /* not __STDC__ || PROTOTYPES */
-
-# define _RE_ARGS(args) ()
-
-#endif /* not __STDC__ || PROTOTYPES */
-
/* Sets the current default syntax to SYNTAX, and return the old syntax.
You can also simply assign to the `re_syntax_options' variable. */
-extern reg_syntax_t re_set_syntax _RE_ARGS ((reg_syntax_t syntax));
+extern reg_syntax_t re_set_syntax (reg_syntax_t __syntax);
/* Compile the regular expression PATTERN, with length LENGTH
and syntax given by the global `re_syntax_options', into the buffer
BUFFER. Return NULL if successful, and an error string if not. */
-extern const char *re_compile_pattern
- _RE_ARGS ((const char *pattern, size_t length,
- struct re_pattern_buffer *buffer));
+extern const char *re_compile_pattern (const char *__pattern, size_t __length,
+ struct re_pattern_buffer *__buffer);
/* Compile a fastmap for the compiled pattern in BUFFER; used to
accelerate searches. Return 0 if successful and -2 if was an
internal error. */
-extern int re_compile_fastmap _RE_ARGS ((struct re_pattern_buffer *buffer));
+extern int re_compile_fastmap (struct re_pattern_buffer *__buffer);
/* Search in the string STRING (with length LENGTH) for the pattern
characters. Return the starting position of the match, -1 for no
match, or -2 for an internal error. Also return register
information in REGS (if REGS and BUFFER->no_sub are nonzero). */
-extern regoff_t re_search
- _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string,
- size_t length, ssize_t start, ssize_t range,
- struct re_registers *regs));
+extern regoff_t re_search (struct re_pattern_buffer *__buffer,
+ const char *__string, size_t __length,
+ ssize_t __start, ssize_t __range,
+ struct re_registers *__regs);
/* Like `re_search', but search in the concatenation of STRING1 and
STRING2. Also, stop searching at index START + STOP. */
-extern regoff_t re_search_2
- _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string1,
- size_t length1, const char *string2, size_t length2,
- ssize_t start, ssize_t range, struct re_registers *regs,
- ssize_t stop));
+extern regoff_t re_search_2 (struct re_pattern_buffer *__buffer,
+ const char *__string1, size_t __length1,
+ const char *__string2, size_t __length2,
+ ssize_t __start, ssize_t __range,
+ struct re_registers *__regs,
+ ssize_t __stop);
/* Like `re_search', but return how many characters in STRING the regexp
in BUFFER matched, starting at position START. */
-extern regoff_t re_match
- _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string,
- size_t length, ssize_t start, struct re_registers *regs));
+extern regoff_t re_match (struct re_pattern_buffer *__buffer,
+ const char *__string, size_t __length,
+ ssize_t __start, struct re_registers *__regs);
/* Relates to `re_match' as `re_search_2' relates to `re_search'. */
-extern regoff_t re_match_2
- _RE_ARGS ((struct re_pattern_buffer *buffer, const char *string1,
- size_t length1, const char *string2, size_t length2,
- ssize_t start, struct re_registers *regs, ssize_t stop));
+extern regoff_t re_match_2 (struct re_pattern_buffer *__buffer,
+ const char *__string1, size_t __length1,
+ const char *__string2, size_t __length2,
+ ssize_t __start, struct re_registers *__regs,
+ ssize_t __stop);
/* Set REGS to hold NUM_REGS registers, storing them in STARTS and
Unless this function is called, the first search or match using
PATTERN_BUFFER will allocate its own register data, without
freeing the old data. */
-extern void re_set_registers
- _RE_ARGS ((struct re_pattern_buffer *buffer, struct re_registers *regs,
- unsigned num_regs, regoff_t *starts, regoff_t *ends));
+extern void re_set_registers (struct re_pattern_buffer *__buffer,
+ struct re_registers *__regs,
+ unsigned __num_regs,
+ regoff_t *__starts, regoff_t *__ends);
#if defined _REGEX_RE_COMP || defined _LIBC
# ifndef _CRAY
/* 4.2 bsd compatibility. */
-extern char *re_comp _RE_ARGS ((const char *));
-extern int re_exec _RE_ARGS ((const char *));
+extern char *re_comp (const char *);
+extern int re_exec (const char *);
# endif
#endif
#endif
/* POSIX compatibility. */
-extern reg_errcode_t regcomp _RE_ARGS ((regex_t *__restrict __preg,
- const char *__restrict __pattern,
- int __cflags));
+extern reg_errcode_t regcomp (regex_t *__restrict __preg,
+ const char *__restrict __pattern,
+ int __cflags);
-extern reg_errcode_t regexec _RE_ARGS ((const regex_t *__restrict __preg,
- const char *__restrict __string,
- size_t __nmatch,
- regmatch_t __pmatch[__restrict_arr],
- int __eflags));
+extern reg_errcode_t regexec (const regex_t *__restrict __preg,
+ const char *__restrict __string, size_t __nmatch,
+ regmatch_t __pmatch[__restrict_arr],
+ int __eflags);
-extern size_t regerror _RE_ARGS ((int __errcode, const regex_t *__preg,
- char *__errbuf, size_t __errbuf_size));
+extern size_t regerror (int __errcode, const regex_t * __preg,
+ char *__errbuf, size_t __errbuf_size);
-extern void regfree _RE_ARGS ((regex_t *__preg));
+extern void regfree (regex_t *__preg);
#ifdef __cplusplus
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "region-cache.h"
struct region_cache *
new_region_cache (void)
{
- struct region_cache *c
- = (struct region_cache *) xmalloc (sizeof (struct region_cache));
+ struct region_cache *c = xmalloc (sizeof *c);
c->gap_start = 0;
c->gap_len = NEW_CACHE_GAP;
c->cache_len = 0;
- c->boundaries =
- (struct boundary *) xmalloc ((c->gap_len + c->cache_len)
- * sizeof (*c->boundaries));
+ c->boundaries = xmalloc ((c->gap_len + c->cache_len)
+ * sizeof (*c->boundaries));
c->beg_unchanged = 0;
c->end_unchanged = 0;
if (BOUNDARY_POS (c, low) > pos
|| (low + 1 < c->cache_len
&& BOUNDARY_POS (c, low + 1) <= pos))
- abort ();
+ emacs_abort ();
return low;
}
if (pos < 0
|| pos > c->cache_len)
- abort ();
+ emacs_abort ();
/* We mustn't ever try to put the gap before the dummy start
boundary. That must always be start-relative. */
if (pos == 0)
- abort ();
+ emacs_abort ();
/* Need we move the gap right? */
while (gap_start < pos)
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;
{
/* i must be a valid cache index. */
if (i < 0 || i > c->cache_len)
- abort ();
+ emacs_abort ();
/* We must never want to insert something before the dummy first
boundary. */
if (i == 0)
- abort ();
+ emacs_abort ();
/* We must only be inserting things in order. */
if (! (BOUNDARY_POS (c, i - 1) < pos
&& (i == c->cache_len
|| pos < BOUNDARY_POS (c, i))))
- abort ();
+ emacs_abort ();
/* The value must be different from the ones around it. However, we
temporarily create boundaries that establish the same value as
the subsequent boundary, so we're not going to flag that case. */
if (BOUNDARY_VALUE (c, i - 1) == value)
- abort ();
+ emacs_abort ();
move_cache_gap (c, i, 1);
/* Gotta be in range. */
if (start < 0
|| end > c->cache_len)
- abort ();
+ emacs_abort ();
/* Gotta be in order. */
if (start > end)
- abort ();
+ emacs_abort ();
/* Can't delete the dummy entry. */
if (start == 0
&& end >= 1)
- abort ();
+ emacs_abort ();
/* Minimize gap motion. If we're deleting nothing, do nothing. */
if (len == 0)
ptrdiff_t start, ptrdiff_t end, int value)
{
if (start > end)
- abort ();
+ emacs_abort ();
if (start < c->buffer_beg
|| end > c->buffer_end)
- abort ();
+ emacs_abort ();
/* Eliminate this case; then we can assume that start and end-1 are
both the locations of real characters in the buffer. */
+++ /dev/null
-This directory contains C header files containing
-operating-system-specific definitions. Each file describes a
-particular operating system. The emacs configuration script edits
-../config.h to include the appropriate one of these files, and then
-each emacs source file includes config.h.
-
-template.h is a generic template for system descriptions; it describes
-the parameters a system file can specify.
+++ /dev/null
-/*
-Copyright (C) 1999, 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 <http://www.gnu.org/licenses/>. */
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-#define USG /* System III, System V, etc */
-#define USG5
-
-/* This symbol should be defined on AIX Version 3 ??????? */
-#ifndef _AIX
-#define _AIX
-#endif
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "aix"
-
-/* In AIX, you allocate a pty by opening /dev/ptc to get the master side.
- To get the name of the slave side, you just ttyname() the master side. */
-#define PTY_ITERATION int c; for (c = 0; !c ; c++)
-#define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptc");
-#define PTY_TTY_NAME_SPRINTF strcpy (pty_name, ttyname (fd));
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */
-#define HAVE_SOCKETS
-\f
-/* Special items needed to make Emacs run on this system. */
-
-/* AIX doesn't define this. */
-#define unix 1
-
-/* Perry Smith <pedz@ddivt1.austin.ibm.com> says these are correct. */
-#define SIGNALS_VIA_CHARACTERS
-#define CLASH_DETECTION
-
-/* Perry Smith <pedz@ddivt1.austin.ibm.com> says these are correct. */
-#undef sigmask
-
-#ifndef HAVE_LIBXMU
-/* Unfortunately without libXmu we cannot support EditRes. */
-#define NO_EDITRES
-#endif
-
-/* On AIX Emacs uses the gmalloc.c malloc implementation. But given
- the way this system works, libc functions that return malloced
- memory use the libc malloc implementation. Calling xfree or
- xrealloc on the results of such functions results in a crash.
-
- One solution for this could be to define SYSTEM_MALLOC in configure,
- but that does not currently work on this system.
-
- It is possible to completely override the malloc implementation on
- AIX, but that involves putting the malloc functions in a shared
- library and setting the MALLOCTYPE environment variable to point to
- that shared library.
-
- Emacs currently calls xrealloc on the results of get_current_dir name,
- to avoid a crash just use the Emacs implementation for that function. */
-#define BROKEN_GET_CURRENT_DIR_NAME 1
+++ /dev/null
-/* Definitions file for GNU Emacs running on bsd 4.3
-
-Copyright (C) 1985-1986, 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 <http://www.gnu.org/licenses/>. */
-
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-
-/* We give these symbols the numeric values found in <sys/param.h> to
- avoid warnings about redefined macros. */
-#ifndef BSD4_3
-#define BSD4_3 1
-#endif /* BSD4_3 */
-
-#ifndef BSD_SYSTEM
-#define BSD_SYSTEM 43
-#endif /* BSD_SYSTEM */
-
-/* For mem-limits.h. */
-#define BSD4_2
-
-#define TABDLY OXTABS
-#define TAB3 OXTABS
-
-#define NO_TERMIO
-
-/* If the system's imake configuration file defines `NeedWidePrototypes'
- as `NO', we must define NARROWPROTO manually. Such a define is
- generated in the Makefile generated by `xmkmf'. If we don't
- define NARROWPROTO, we will see the wrong function prototypes
- for X functions taking float or double parameters. */
-#define NARROWPROTO 1
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "berkeley-unix"
-
-/* Do not use interrupt_input = 1 by default, because in 4.3
- we can make noninterrupt input work properly. */
-#undef INTERRUPT_INPUT
-
-/* First pty name is /dev/ptyp0. */
-#define FIRST_PTY_LETTER 'p'
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */
-#define HAVE_SOCKETS
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* Send signals to subprocesses by "typing" special chars at them. */
-#define SIGNALS_VIA_CHARACTERS
+++ /dev/null
-/* System description header file for Cygwin.
-
-Copyright (C) 1985-1986, 1992, 1999, 2002-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 <http://www.gnu.org/licenses/>. */
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "cygwin"
-
-/* Emacs can read input using SIGIO and buffering characters itself,
- or using CBREAK mode and making C-g cause SIGINT.
- The choice is controlled by the variable interrupt_input.
-
- Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO)
-
- Emacs uses the presence or absence of the SIGIO and BROKEN_SIGIO macros
- to indicate whether or not signal-driven I/O is possible. It uses
- INTERRUPT_INPUT to decide whether to use it by default.
-
- SIGIO can be used only on systems that implement it (4.2 and 4.3).
- CBREAK mode has two disadvantages
- 1) At least in 4.2, it is impossible to handle the Meta key properly.
- I hear that in system V this problem does not exist.
- 2) Control-G causes output to be discarded.
- I do not know whether this can be fixed in system V.
-
- Another method of doing input is planned but not implemented.
- It would have Emacs fork off a separate process
- to read the input and send it to the true Emacs process
- through a pipe. */
-#undef INTERRUPT_INPUT
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-#define PTY_ITERATION int i; for (i = 0; i < 1; i++) /* ick */
-#define PTY_NAME_SPRINTF /* none */
-#define PTY_TTY_NAME_SPRINTF /* none */
-#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); \
- emacs_close (dummy); \
- } \
- while (0)
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* If the system's imake configuration file defines `NeedWidePrototypes'
- as `NO', we must define NARROWPROTO manually. Such a define is
- generated in the Makefile generated by `xmkmf'. If we don't
- define NARROWPROTO, we will see the wrong function prototypes
- for X functions taking float or double parameters. */
-#define NARROWPROTO 1
-
-/* Used in various places to enable cygwin-specific code changes. */
-#define CYGWIN 1
-
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)
-
-#define HAVE_SOCKETS
-
-/* vfork() interacts badly with setsid(), causing ptys to fail to
- change their controlling terminal */
-#define vfork fork
-
-/* This should work (at least when compiling with gcc). But I have no way
- or intention to verify or even test it. If you encounter a problem with
- it, feel free to change this setting, but please add a comment here about
- why it needed to be changed. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
-
-/* Emacs supplies its own malloc, but glib (part of Gtk+) calls
- memalign and on Cygwin, that becomes the Cygwin-supplied memalign.
- As malloc is not the Cygwin malloc, the Cygwin memalign always
- returns ENOSYS. A workaround is to set G_SLICE=always-malloc. */
-#define G_SLICE_ALWAYS_MALLOC
-
-/* Send signals to subprocesses by "typing" special chars at them. */
-#define SIGNALS_VIA_CHARACTERS
+++ /dev/null
-/* System description header file for Darwin (Mac OS X).
-
-Copyright (C) 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 <http://www.gnu.org/licenses/>. */
-
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-#define BSD4_2
-/* BSD4_3 and BSD4_4 are already defined in sys/param.h */
-#define BSD_SYSTEM
-
-/* More specific than the above two. We cannot use __APPLE__ as this
- may not be defined on non-OSX Darwin, and we cannot define DARWIN
- here because Panther and lower CoreFoundation.h uses DARWIN to
- distinguish OS X from pure Darwin. */
-#define DARWIN_OS
-
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "darwin"
-
-/* Emacs can read input using SIGIO and buffering characters itself,
- or using CBREAK mode and making C-g cause SIGINT.
- The choice is controlled by the variable interrupt_input.
-
- Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO)
-
- Emacs uses the presence or absence of the SIGIO and BROKEN_SIGIO macros
- to indicate whether or not signal-driven I/O is possible. It uses
- INTERRUPT_INPUT to decide whether to use it by default.
-
- SIGIO can be used only on systems that implement it (4.2 and 4.3).
- CBREAK mode has two disadvantages
- 1) At least in 4.2, it is impossible to handle the Meta key properly.
- I hear that in system V this problem does not exist.
- 2) Control-G causes output to be discarded.
- I do not know whether this can be fixed in system V.
-
- Another method of doing input is planned but not implemented.
- It would have Emacs fork off a separate process
- to read the input and send it to the true Emacs process
- through a pipe. */
-#define INTERRUPT_INPUT
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'a' means it is /dev/ptya0 */
-#define FIRST_PTY_LETTER 'p'
-
-#define NO_TERMIO
-
-/* Define HAVE_PTYS if the system supports pty devices.
- Note: PTYs are broken on darwin <6. Use at your own risk. */
-#define HAVE_PTYS
-/* Run only once. We need a `for'-loop because the code uses `continue'. */
-#define PTY_ITERATION int i; for (i = 0; i < 1; i++)
-#define PTY_NAME_SPRINTF /* none */
-#define PTY_TTY_NAME_SPRINTF /* none */
-/* Note that openpty may fork via grantpt on Mac OS X 10.4/Darwin 8.
- But we don't have to block SIGCHLD because it is blocked in the
- implementation of grantpt. */
-#define PTY_OPEN \
- do \
- { \
- int slave; \
- if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) \
- fd = -1; \
- else \
- emacs_close (slave); \
- } \
- while (0)
-
-/* PTYs only work correctly on Darwin 7 or higher. So make the default
- for process-connection-type dependent on the kernel version. */
-#define MIN_PTY_KERNEL_VERSION '7'
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* Avoid the use of the name init_process (process.c) because it is
- also the name of a Mach system call. */
-#define init_process emacs_init_process
-
-/* Used in dispnew.c. Copied from freebsd.h. */
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)
-
-/* System uses OXTABS instead of the expected TAB3. (Copied from bsd386.h.) */
-#define TAB3 OXTABS
-
-/* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */
-#define HAVE_SOCKETS
-
-/* Definitions for how to compile & link. */
-#ifdef HAVE_NS
-#define SYSTEM_PURESIZE_EXTRA 200000
-#endif
-
-/* On Darwin, res_init appears not to be useful: see bug#562 and
- http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html */
-#undef HAVE_RES_INIT
-#undef HAVE_LIBRESOLV
-
-#ifdef emacs
-#define malloc unexec_malloc
-#define realloc unexec_realloc
-#define free unexec_free
-/* Don't use posix_memalign because it is not compatible with unexmacosx.c. */
-#undef HAVE_POSIX_MEMALIGN
-#endif
-
-/* Define the following so emacs symbols will not conflict with those
- in the System framework. Otherwise -prebind will not work. */
-
-/* Do not define abort in emacs.c. */
-#define NO_ABORT
-
-/* Do not define matherr in floatfns.c. */
-#define NO_MATHERR
-
-/* The following solves the problem that Emacs hangs when evaluating
- (make-comint "test0" "/nodir/nofile" nil "") when /nodir/nofile
- does not exist. Also, setsid is not allowed in the vfork child's
- context as of Darwin 9/Mac OS X 10.5. */
-#undef HAVE_WORKING_VFORK
-#define vfork fork
-
-/* Don't close pty in process.c to make it as controlling terminal.
- It is already a controlling terminal of subprocess, because we did
- ioctl TIOCSCTTY. */
-#define DONT_REOPEN_PTY
-
-/* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method for marking the stack. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
+++ /dev/null
-/* System description header for FreeBSD systems.
-
-Copyright (C) 1994-2012 Free Software Foundation, Inc.
-
-Author: Shawn M. Carey
-(according to authors.el)
-
-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 <http://www.gnu.org/licenses/>. */
-
-/* Get most of the stuff from bsd-common */
-#include "bsd-common.h"
-
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)
-
-/* This silences a few compilation warnings. */
-#undef BSD_SYSTEM
-#if __FreeBSD__ == 1
-#define BSD_SYSTEM 199103
-#elif __FreeBSD__ == 2
-#define BSD_SYSTEM 199306
-#elif __FreeBSD__ >= 3
-#define BSD_SYSTEM 199506
-#endif
-
-/* Don't close pty in process.c to make it as controlling terminal.
- It is already a controlling terminal of subprocess, because we did
- ioctl TIOCSCTTY. */
-#define DONT_REOPEN_PTY
-
-/* Circumvent a bug in FreeBSD. In the following sequence of
- writes/reads on a PTY, read(2) returns bogus data:
-
- write(2) 1022 bytes
- write(2) 954 bytes, get EAGAIN
- read(2) 1024 bytes in process_read_output
- read(2) 11 bytes in process_read_output
-
- That is, read(2) returns more bytes than have ever been written
- successfully. The 1033 bytes read are the 1022 bytes written
- successfully after processing (for example with CRs added if the
- terminal is set up that way which it is here). The same bytes will
- be seen again in a later read(2), without the CRs. */
-#define BROKEN_PTY_READ_AFTER_EAGAIN 1
-
-/* Tell that garbage collector that setjmp is known to save all
- registers relevant for conservative garbage collection in the jmp_buf. */
-#define GC_SETJMP_WORKS 1
-
-/* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method for marking the stack. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
+++ /dev/null
-#include "gnu-linux.h"
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#undef SYSTEM_TYPE
-#define SYSTEM_TYPE "gnu/kfreebsd" /* All the best software is free */
-
-#define NO_TERMIO /* use only <termios.h> */
-
+++ /dev/null
-/* This file is the configuration file for Linux-based GNU systems
-
-Copyright (C) 1985-1986, 1992, 1994, 1996, 1999, 2001-2012
- Free Software Foundation, Inc.
-
-This file was put together by Michael K. Johnson and Rik Faith.
-
-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 <http://www.gnu.org/licenses/>. */
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-#define USG
-#define GNU_LINUX
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "gnu/linux" /* All the best software is free. */
-
-#ifdef emacs
-#ifdef HAVE_LINUX_VERSION_H
-#include <linux/version.h>
-
-#if LINUX_VERSION_CODE >= 0x20400
-/* 21 Jun 06: Eric Hanchrow <offby1@blarg.net> says this works. */
-#define SIGNALS_VIA_CHARACTERS
-#endif /* LINUX_VERSION_CODE >= 0x20400 */
-#endif /* HAVE_LINUX_VERSION_H */
-#endif /* emacs */
-
-#if defined HAVE_GRANTPT
-#define UNIX98_PTYS
-
-/* Run only once. We need a `for'-loop because the code uses `continue'. */
-#define PTY_ITERATION int i; for (i = 0; i < 1; i++)
-
-#ifdef HAVE_GETPT
-#define PTY_NAME_SPRINTF
-#define PTY_OPEN fd = getpt ()
-#else /* not HAVE_GETPT */
-#define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptmx");
-#endif /* not HAVE_GETPT */
-
-/* Note that grantpt and unlockpt may fork. We must block SIGCHLD to
- prevent sigchld_handler from intercepting the child's death. */
-#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; \
- } \
- strncpy (pty_name, ptyname, sizeof (pty_name)); \
- pty_name[sizeof (pty_name) - 1] = 0; \
- sigunblock (sigmask (SIGCHLD)); \
- }
-
-#else /* not HAVE_GRANTPT */
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'p' means it is /dev/ptyp0 */
-#define FIRST_PTY_LETTER 'p'
-
-#endif /* not HAVE_GRANTPT */
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-#define HAVE_SOCKETS
-
-/* This is used in list_system_processes. */
-#define HAVE_PROCFS 1
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* 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). */
-\f
-/* This is needed for dispnew.c:update_frame. */
-#ifdef emacs
-#include <stdio.h> /* Get the definition of _IO_STDIO_H. */
-#if defined (_IO_STDIO_H) || defined (_STDIO_USES_IOSTREAM)
-/* New C libio names. */
-#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \
- ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)
-#elif defined (__UCLIBC__)
-/* Using the uClibc library. */
-#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \
- ((FILE)->__bufpos - (FILE)->__bufstart)
-#else /* !_IO_STDIO_H && ! __UCLIBC__ */
-/* Old C++ iostream names. */
-#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \
- ((FILE)->_pptr - (FILE)->_pbase)
-#endif /* !_IO_STDIO_H && ! __UCLIBC__ */
-
-#define INTERRUPT_INPUT
-#endif /* emacs */
-
-#define POSIX /* affects getpagesize.h and systty.h */
-
-/* This is to work around mysterious gcc failures in some system versions.
- It is unlikely that Emacs changes will work around this problem;
- therefore, this should remain permanently. */
-#ifndef HAVE_XRMSETDATABASE
-#define HAVE_XRMSETDATABASE
-#endif
-
-#define NARROWPROTO 1
-
-/* Tell that garbage collector that setjmp is known to save all
- registers relevant for conservative garbage collection in the jmp_buf. */
-/* Not all the architectures are tested, but there are Debian packages
- for SCM and/or Guile on them, so the technique must work. See also
- comments in alloc.c concerning setjmp and gcc. Fixme: it's
- probably safe to make this conditional just on GCC, except for ia64
- register window-flushing. */
-/* Don't use #cpu here since in newest development versions of GCC,
- we must call cpp with -traditional, and that disables #cpu. */
-#if defined __i386__ || defined __sparc__ || defined __mc68000__ \
- || defined __alpha__ || defined __mips__ || defined __s390__ \
- || defined __arm__ || defined __powerpc__ || defined __amd64__ \
- || defined __ia64__ || defined __sh__
-#define GC_SETJMP_WORKS 1
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
-#ifdef __mc68000__
-#define GC_LISP_OBJECT_ALIGNMENT 2
-#endif
-#ifdef __ia64__
-#define GC_MARK_SECONDARY_STACK() \
- do { \
- extern void *__libc_ia64_register_backing_store_base; \
- __builtin_ia64_flushrs (); \
- mark_memory (__libc_ia64_register_backing_store_base, \
- __builtin_ia64_bsp ()); \
- } while (0)
-#endif
-#endif
+++ /dev/null
-/* Definitions file for GNU Emacs running on the GNU Hurd.
-
-Copyright (C) 1994-1996, 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 <http://www.gnu.org/licenses/>. */
-
-
-/* Get most of the stuff from bsd-common */
-#include "bsd-common.h"
-
-#undef SYSTEM_TYPE
-#define SYSTEM_TYPE "gnu"
-
-#undef NLIST_STRUCT
-
-#define SIGNALS_VIA_CHARACTERS
-
-/* libc defines data_start. */
-#define DATA_START ({ extern int data_start; (char *) &data_start; })
-
-/* Some losing code fails to include this and then assumes
- that because it is braindead that O_RDONLY==0. */
-#include <fcntl.h>
-
-#ifdef emacs
-#include <stdio.h> /* Get the definition of _IO_STDIO_H. */
-#if defined (_IO_STDIO_H) || defined (_STDIO_USES_IOSTREAM)
-/* new C libio names */
-#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \
- ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)
-#endif /* !_IO_STDIO_H */
-#endif /* emacs */
-
-#define POSIX_SIGNALS 1
-
-/* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method for marking the stack. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
+++ /dev/null
-/* System description file for hpux version 10.20.
-
-Copyright (C) 1999, 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 <http://www.gnu.org/licenses/>. */
-
-
-#define RUN_TIME_REMAP
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-#define USG /* System III, System V, etc */
-#define USG5
-#define HPUX
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "hpux"
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'p' means it is /dev/ptym/ptyp0 */
-#define FIRST_PTY_LETTER 'p'
-
-#define NO_TERMIO
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */
-#define HAVE_SOCKETS
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* Special hacks needed to make Emacs run on this system. */
-
-/* In hpux, the symbol SIGIO is defined, but the feature
- doesn't work in the way Emacs needs it to. */
-#define BROKEN_SIGIO
-
-/* Some additional system facilities exist. */
-#define HAVE_PERROR /* Delete this line for version 6. */
-
-/* This is how to get the device name of the tty end of a pty. */
-#define PTY_TTY_NAME_SPRINTF \
- sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
-
-/* This is how to get the device name of the control end of a pty. */
-#define PTY_NAME_SPRINTF \
- sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
-
-/* This triggers a conditional in xfaces.c. */
-#define XOS_NEEDS_TIME_H
-
-/* Assar Westerlund <assar@sics.se> says this is necessary for
- HP-UX 10.20, and that it works for HP-UX 0 as well. */
-#define NO_EDITRES
-
-/* Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines
- has a broken `rint' in some library versions including math library
- version number A.09.05.
-
- You can fix the math library by installing patch number PHSS_4630.
- But we can fix it more reliably for Emacs like this. */
-#undef HAVE_RINT
-
-/* We have to go this route, rather than hpux9's approach of renaming the
- functions via macros. The system's stdlib.h has fully prototyped
- declarations, which yields a conflicting definition of srand48; it
- tries to redeclare what was once srandom to be srand48. So we go
- with HAVE_LRAND48 being defined. */
-#undef srandom
-#undef random
-#undef HAVE_RANDOM
-
-
-/* Rainer Malzbender <rainer@displaytech.com> says defining
- HAVE_XRMSETDATABASE allows Emacs to compile on HP-UX 10.20 using GCC. */
-#ifndef HAVE_XRMSETDATABASE
-#define HAVE_XRMSETDATABASE
-#endif
-
-/* 2000-11-21: Temporarily disable Unix 98 large file support found by
- configure. It fails on HPUX 11, at least, because it enables
- header sections which lose when `static' is defined away, as it is
- on HP-UX. (You get duplicate symbol errors on linking). */
-#undef _FILE_OFFSET_BITS
-\f
-/* The data segment on this machine always starts at address 0x40000000. */
-#define DATA_SEG_BITS 0x40000000
-
-#define DATA_START 0x40000000
+++ /dev/null
-#include "hpux10-20.h"
-
-/* SA_RESTART resets the timeout of `select', so don't use it. */
-#define BROKEN_SA_RESTART
-
-/* It does work on HPUX to open the pty's tty in the parent (Emacs),
- then close and reopen it in the child. */
-#define USG_SUBTTY_WORKS
-
+++ /dev/null
-/* Definitions file for GNU Emacs running on Silicon Graphics Irix system 6.5.
-
-Copyright (C) 1999-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 <http://www.gnu.org/licenses/>. */
-
-
-#define IRIX6_5 /* used in m/iris4d */
-#include "usg5-4-common.h"
-
-#undef _longjmp /* use system versions, not conservative aliases */
-#undef _setjmp
-
-#define SETPGRP_RELEASES_CTTY
-
-#ifdef SYSTEM_TYPE
-#undef SYSTEM_TYPE
-#endif
-#define SYSTEM_TYPE "irix"
-
-#ifdef SETUP_SLAVE_PTY
-#undef SETUP_SLAVE_PTY
-#endif
-
-/* thomas@mathematik.uni-bremen.de says this is needed. */
-/* Make process_send_signal work by "typing" a signal character on the pty. */
-#define SIGNALS_VIA_CHARACTERS
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'a' means it is /dev/ptya0 */
-#undef FIRST_PTY_LETTER
-#define FIRST_PTY_LETTER 'q'
-
-/* No need to use sprintf to get the tty name--we get that from _getpty. */
-#define PTY_TTY_NAME_SPRINTF
-/* No need to get the pty name at all. */
-#ifdef PTY_NAME_SPRINTF
-#undef PTY_NAME_SPRINTF
-#endif
-#define PTY_NAME_SPRINTF
-#ifdef emacs
-char *_getpty();
-#endif
-/* We need only try once to open a pty. */
-#define PTY_ITERATION
-/* Here is how to do it. */
-#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); \
-}
-
-/* Ulimit(UL_GMEMLIM) is busted... */
-#define ULIMIT_BREAK_VALUE 0x14000000
-
-/* Tell process_send_signal to use VSUSP instead of VSWTCH. */
-#define PREFER_VSUSP
-
-#define NARROWPROTO 1
-
-#if _MIPS_SZLONG == 64 /* -mabi=64 (gcc) or -64 (MIPSpro) */
-#define _LP64 /* lisp.h takes care of the rest */
-#endif /* _MIPS_SZLONG */
-
-#undef SA_RESTART
-
-#undef TIOCSIGSEND /* defined in usg5-4-common.h */
-
-/* Tested on Irix 6.5. SCM worked on earlier versions. */
-#define GC_SETJMP_WORKS 1
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
-
-
-/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers which
- were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for
- the value field of a LISP_OBJECT). */
-#define DATA_START 0x10000000
-#define DATA_SEG_BITS 0x10000000
+++ /dev/null
-/* 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 <http://www.gnu.org/licenses/>. */
-
-/* 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 */
-#undef BSD_SYSTEM
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "ms-dos"
-
-/* 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). */
-\f
-/* Avoid incompatibilities between gmalloc.c and system header files
- in how to declare valloc. */
-#define GMALLOC_INHIBIT_VALLOC
-
-/* 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 DATA_START (&etext + 1)
-
-#define _NAIVE_DOS_REGS
-
-/* command.com does not understand `...` so we define this. */
-#define SEPCHAR ';'
-
-#define NULL_DEVICE "nul"
-
-#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=<CM>:cl=<CL>:ce=<CE>:\
-:se=</SO>:so=<SO>:us=<UL>:ue=</UL>:md=<BD>:mh=<DIM>:mb=<BL>:mr=<RV>:me=<NV>:\
-:AB=<BG %d>:AF=<FG %d>:op=<DefC>:"
-
-/* Define this to be the separator between devices and paths. */
-#define DEVICE_SEP ':'
-
-/* We'll support either convention on MSDOG. */
-#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\')
-#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_))
-
-
-/* Mode line description of a buffer's type. */
-#define MODE_LINE_BINARY_TEXT(buf) (NILP(B_(buf,buffer_file_type)) ? "T" : "B")
-
-/* We have (the code to control) a mouse. */
-#define HAVE_MOUSE
-
-/* We can use mouse menus. */
-#define HAVE_MENUS
-
-/* 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
-
-/* Tell the garbage collector that setjmp is known to save all
- registers relevant for conservative garbage collection in the jmp_buf. */
-#define GC_SETJMP_WORKS 1
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
+++ /dev/null
-/* s/ file for netbsd system.
-
-Copyright (C) 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 <http://www.gnu.org/licenses/>. */
-
-
-/* Get most of the stuff from bsd-common. */
-#include "bsd-common.h"
-
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)
-
-#define DEFAULT_SOUND_DEVICE "/dev/audio"
-
-/* Greg A. Woods <woods@weird.com> says we must include signal.h
- before syssignal.h is included, to work around interface conflicts
- that are handled with CPP __RENAME() macro in signal.h. */
-#include <signal.h>
-
-/* Don't close pty in process.c to make it as controlling terminal.
- It is already a controlling terminal of subprocess, because we did
- ioctl TIOCSCTTY. */
-#define DONT_REOPEN_PTY
-
-/* Tell that garbage collector that setjmp is known to save all
- registers relevant for conservative garbage collection in the jmp_buf. */
-#define GC_SETJMP_WORKS 1
-
-/* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method. */
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
+++ /dev/null
-/* System file for openbsd. */
-
-/* Nearly the same as NetBSD. Note there are differences in configure. */
-#include "netbsd.h"
-
-/* The symbol SIGIO is defined, but the feature doesn't work in the
- way Emacs needs it to. See
- <http://article.gmane.org/gmane.os.openbsd.ports/46831>. */
-#define BROKEN_SIGIO
+++ /dev/null
-/* Handle Solaris 2.10. */
-
-#include "sol2-6.h"
-
-/* This is used in list_system_processes. */
-#define HAVE_PROCFS 1
-
-/* This is needed for the system_process_attributes implementation. */
-#define _STRUCTURED_PROC 1
-
+++ /dev/null
-/* Definitions file for GNU Emacs running on Solaris 2.6.
-
-Copyright (C) 1999-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 <http://www.gnu.org/licenses/>. */
-
-#include "usg5-4-common.h"
-
-#define SOLARIS2
-
-/* This triggers a conditional in xfaces.c. */
-#define XOS_NEEDS_TIME_H
-
-#define POSIX
-
-/* Prefer kstat over kvm in getloadavg.c, kstat doesn't require root.
- ghazi@caip.rutgers.edu, 7/21/97. Don't redefine if already defined
- (e.g., by config.h). */
-#ifndef HAVE_LIBKSTAT
-#define HAVE_LIBKSTAT
-#endif
-
-/* This is the same definition as in usg5-4-common.h, but with sigblock/sigunblock
- rather than sighold/sigrelse, which appear to be BSD4.1 specific.
- It may also be appropriate for SVR4.x
- (x<2) but I'm not sure. fnf@cygnus.com */
-/* This sets the name of the slave side of the PTY. On SysVr4,
- grantpt(3) forks a subprocess, so keep sigchld_handler() from
- intercepting that death. If any child but grantpt's should die
- within, it should be caught after sigrelse(2). */
-
-#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; } \
- strncpy (pty_name, ptyname, sizeof (pty_name)); \
- pty_name[sizeof (pty_name) - 1] = 0; \
- }
-
-#define GC_SETJMP_WORKS 1
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
+++ /dev/null
-/* Template for system description header files.
- This file describes the parameters that system description files
- should define or not.
-
-Copyright (C) 1985-1986, 1992, 1999, 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 <http://www.gnu.org/licenses/>. */
-
-
-/* Define symbols to identify the version of Unix this is.
- Define all the symbols that apply correctly. */
-
-/* #define USG5 */
-/* #define USG */
-/* #define HPUX */
-/* #define BSD4_2 */
-/* #define BSD4_3 */
-/* #define BSD_SYSTEM */
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-
-#define SYSTEM_TYPE "berkeley-unix"
-
-/* Emacs can read input using SIGIO and buffering characters itself,
- or using CBREAK mode and making C-g cause SIGINT.
- The choice is controlled by the variable interrupt_input.
-
- Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO)
-
- Emacs uses the presence or absence of the SIGIO and BROKEN_SIGIO macros
- to indicate whether or not signal-driven I/O is possible. It uses
- INTERRUPT_INPUT to decide whether to use it by default.
-
- SIGIO can be used only on systems that implement it (4.2 and 4.3).
- CBREAK mode has two disadvantages
- 1) At least in 4.2, it is impossible to handle the Meta key properly.
- I hear that in system V this problem does not exist.
- 2) Control-G causes output to be discarded.
- I do not know whether this can be fixed in system V.
-
- Another method of doing input is planned but not implemented.
- It would have Emacs fork off a separate process
- to read the input and send it to the true Emacs process
- through a pipe. */
-#define INTERRUPT_INPUT
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'a' means it is /dev/ptya0. */
-#define FIRST_PTY_LETTER 'a'
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* subprocesses should be undefined if you do NOT want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- Currently only MSDOS does not support this. */
-
-/* #undef subprocesses */
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-#define CLASH_DETECTION
-
-/* If the character used to separate elements of the executable path
- is not ':', #define this to be the appropriate character constant. */
-/* #define SEPCHAR ':' */
-
-/* ============================================================ */
-
-/* Here, 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). */
-
-/* If the system's imake configuration file defines `NeedWidePrototypes'
- as `NO', we must define NARROWPROTO manually. Such a define is
- generated in the Makefile generated by `xmkmf'. If we don't
- define NARROWPROTO, we will see the wrong function prototypes
- for X functions taking float or double parameters. */
-
-/* #define NARROWPROTO 1 */
-
-/* ============================================================ */
-
-/* After adding support for a new system, modify the large case
- statement in configure.in to recognize reasonable
- configuration names, and add a description of the system to
- `etc/MACHINES'.
-
- Check for any tests of $opsys in configure.in, and add an entry
- for the new system if needed.
-
- If you've just fixed a problem in an existing configuration file,
- you should also check `etc/MACHINES' to make sure its descriptions
- of known problems in that configuration should be updated. */
-
+++ /dev/null
-/* s/ file for Unixware.
-
-Copyright (C) 1999-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 <http://www.gnu.org/licenses/>. */
-
-
-#include "usg5-4-common.h"
-
-/* #define HAVE_GETWD (appears to be buggy on SVR4.2) */
-#undef HAVE_GETWD
-
-#undef HAVE_SYSV_SIGPAUSE
-
-/* This is the same definition as in usg5-4-common.h, but with sigblock/sigunblock
- rather than sighold/sigrelse, which appear to be BSD4.1 specific.
- It may also be appropriate for SVR4.x
- (x<2) but I'm not sure. fnf@cygnus.com */
-/* This sets the name of the slave side of the PTY. On SysVr4,
- grantpt(3) forks a subprocess, so keep sigchld_handler() from
- intercepting that death. If any child but grantpt's should die
- within, it should be caught after sigrelse(2). */
-#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"); \
- strncpy(pty_name, ptyname, sizeof(pty_name)); \
- pty_name[sizeof(pty_name) - 1] = 0; \
- }
-
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base)
+++ /dev/null
-/* Definitions file for GNU Emacs running on AT&T's System V Release 4
-
-Copyright (C) 1987, 1990, 1999-2012 Free Software Foundation, Inc.
-
-Written by James Van Artsdalen of Dell Computer Corp. james@bigtex.cactus.org.
-Subsequently improved for Dell 2.2 by Eric S. Raymond <esr@snark.thyrsus.com>.
-
-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 <http://www.gnu.org/licenses/>. */
-
-/* Use the SysVr3 file for at least base configuration. */
-#define USG /* System III, System V, etc */
-
-#define USG5
-#define USG5_4
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-#define SYSTEM_TYPE "usg-unix-v"
-
-/* setjmp and longjmp can safely replace _setjmp and _longjmp,
- but they will run slower. */
-#define _setjmp setjmp
-#define _longjmp longjmp
-
-/* The docs for system V/386 suggest v.3 has sigpause, so let's try it. */
-#define HAVE_SYSV_SIGPAUSE
-
-/* Get FIONREAD from <sys/filio.h>. Get <sys/ttold.h> to get struct tchars.
- But get <termio.h> first to make sure ttold.h doesn't interfere.
- And don't try to use SIGIO yet. */
-#include <sys/wait.h>
-
-#ifdef emacs
-#include <sys/filio.h>
-#include <termio.h>
-#include <sys/ttold.h>
-#include <signal.h>
-#include <sys/stream.h>
-#include <sys/stropts.h>
-#include <sys/termios.h>
-#define BROKEN_SIGIO
-#endif
-
-/* Some SVr4s don't define NSIG in sys/signal.h for ANSI environments;
- instead, there's a system variable _sys_nsig. Unfortunately, we need the
- constant to dimension an array. So wire in the appropriate value here. */
-#define NSIG_MINIMUM 32
-
-/* We can support this. */
-#define CLASH_DETECTION
-
-/* Define HAVE_PTYS if the system supports pty devices. */
-#define HAVE_PTYS
-
-/* It is possible to receive SIGCHLD when there are no children
- waiting, because a previous waitsys(2) cleaned up the carcass of child
- without clearing the SIGCHLD pending info. So, use a non-blocking
- wait3 instead, which maps to waitpid(2) in SysVr4. */
-#define wait3(status, options, rusage) \
- waitpid ((pid_t) -1, (status), (options))
-#define WRETCODE(w) (w >> 8)
-
-/* TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY
- subprocesses the usual way. But TIOCSIGNAL does work for PTYs, and
- this is all we need. */
-#define TIOCSIGSEND TIOCSIGNAL
-
-/* This change means that we don't loop through allocate_pty too many
- times in the (rare) event of a failure. */
-#define FIRST_PTY_LETTER 'z'
-
-/* This sets the name of the master side of the PTY. */
-#define PTY_NAME_SPRINTF strcpy (pty_name, "/dev/ptmx");
-
-/* Push various streams modules onto a PTY channel. */
-#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");
-
-/* This definition was suggested for next release. So give it a try. */
-#define HAVE_SOCKETS
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "termchar.h"
#include "dispextern.h"
int free_at_end)
{
register int i, j;
- EMACS_INT frame_lines = FRAME_LINES (frame);
+ int frame_lines = FRAME_LINES (frame);
register struct matrix_elt *p, *p1;
register int cost, cost1;
{
cost = p1->writecost + first_insert_cost[i];
if ((int) p1->insertcount > i)
- abort ();
+ emacs_abort ();
cost1 = p1->insertcost + next_insert_cost[i - p1->insertcount];
}
p->insertcost = min (cost, cost1) + draw_cost[i] + extra_cost;
p->insertcount = (cost < cost1) ? 1 : p1->insertcount + 1;
if ((int) p->insertcount > i)
- abort ();
+ emacs_abort ();
/* Calculate the cost if we do a delete line after
outputting this line.
/* A queue for line insertions to be done. */
struct queue { int count, pos; };
struct queue *queue_start
- = (struct queue *) alloca (current_matrix->nrows * sizeof (struct queue));
+ = alloca (current_matrix->nrows * sizeof *queue_start);
struct queue *queue = queue_start;
- char *retained_p = (char *) alloca (window_size * sizeof (char));
- int *copy_from = (int *) alloca (window_size * sizeof (int));
+ char *retained_p = alloca (window_size * sizeof *retained_p);
+ int *copy_from = alloca (window_size * sizeof *copy_from);
/* Zero means line is empty. */
memset (retained_p, 0, window_size * sizeof (char));
for (k = 0; k < window_size; ++k)
copy_from[k] = -1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
# define CHECK_BOUNDS \
do \
{ \
int ck; \
for (ck = 0; ck < window_size; ++ck) \
- xassert (copy_from[ck] == -1 \
+ eassert (copy_from[ck] == -1 \
|| (copy_from[ck] >= 0 && copy_from[ck] < window_size)); \
} \
while (0);
{
/* Best thing done here is no insert or delete, i.e. a write. */
--i, --j;
- xassert (i >= 0 && i < window_size);
- xassert (j >= 0 && j < window_size);
+ eassert (i >= 0 && i < window_size);
+ eassert (j >= 0 && j < window_size);
copy_from[i] = j;
retained_p[j] = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
CHECK_BOUNDS;
#endif
}
}
for (k = 0; k < window_size; ++k)
- xassert (copy_from[k] >= 0 && copy_from[k] < window_size);
+ eassert (copy_from[k] >= 0 && copy_from[k] < window_size);
/* Perform the row swizzling. */
mirrored_line_dance (current_matrix, unchanged_at_top, window_size,
copy_from, retained_p);
- /* Some sanity checks if GLYPH_DEBUG != 0. */
+ /* Some sanity checks if GLYPH_DEBUG is defined. */
CHECK_MATRIX (current_matrix);
if (terminal_window_p)
int free_at_end)
{
register int i, j;
- EMACS_INT frame_lines = FRAME_LINES (frame);
+ int frame_lines = FRAME_LINES (frame);
register struct matrix_elt *p, *p1;
register int cost, cost1, delta;
int write_follows_p = 1;
/* For each row in the new matrix what row of the old matrix it is. */
- int *copy_from = (int *) alloca (window_size * sizeof (int));
+ int *copy_from = alloca (window_size * sizeof *copy_from);
/* Non-zero for each row in the new matrix that is retained from the
old matrix. Lines not retained are empty. */
- char *retained_p = (char *) alloca (window_size * sizeof (char));
+ char *retained_p = alloca (window_size * sizeof *retained_p);
memset (retained_p, 0, window_size * sizeof (char));
place they belong. */
int n_to_write = p->writecount;
write_follows_p = 1;
- xassert (n_to_write > 0);
+ eassert (n_to_write > 0);
if (i > j)
{
line_ins_del (FRAME_PTR frame, int ov1, int pf1, int ovn, int pfn,
register int *ov, register int *mf)
{
- register EMACS_INT i;
- register EMACS_INT frame_lines = FRAME_LINES (frame);
+ register int i;
+ register int frame_lines = FRAME_LINES (frame);
register int insert_overhead = ov1 * 10;
register int next_insert_cost = ovn * 10;
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "syntax.h"
#include "category.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "region-cache.h"
#include "commands.h"
/* Error condition used for failing searches. */
static Lisp_Object Qsearch_failed;
-static void set_search_regs (EMACS_INT, EMACS_INT);
+static void set_search_regs (ptrdiff_t, ptrdiff_t);
static void save_search_regs (void);
-static EMACS_INT simple_search (EMACS_INT, unsigned char *, EMACS_INT,
- EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT);
-static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, EMACS_INT,
- Lisp_Object, Lisp_Object, EMACS_INT,
- EMACS_INT, int);
-static EMACS_INT search_buffer (Lisp_Object, EMACS_INT, EMACS_INT,
- EMACS_INT, EMACS_INT, EMACS_INT, int,
+static EMACS_INT simple_search (EMACS_INT, unsigned char *, ptrdiff_t,
+ ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t);
+static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, ptrdiff_t,
+ Lisp_Object, Lisp_Object, ptrdiff_t,
+ ptrdiff_t, int);
+static EMACS_INT search_buffer (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t, EMACS_INT, int,
Lisp_Object, Lisp_Object, int);
-static void matcher_overflow (void) NO_RETURN;
-static void
+static _Noreturn void
matcher_overflow (void)
{
error ("Stack overflow in regexp matcher");
re_set_whitespace_regexp (NULL);
re_set_syntax (old);
- /* UNBLOCK_INPUT; */
+ /* unblock_input (); */
if (val)
xsignal1 (Qinvalid_regexp, build_string (val));
for (cp = searchbuf_head; cp != 0; cp = cp->next)
{
cp->buf.allocated = cp->buf.used;
- cp->buf.buffer
- = (unsigned char *) xrealloc (cp->buf.buffer, cp->buf.used);
+ cp->buf.buffer = xrealloc (cp->buf.buffer, cp->buf.used);
}
}
{
Lisp_Object val;
unsigned char *p1, *p2;
- EMACS_INT s1, s2;
- register EMACS_INT i;
+ ptrdiff_t s1, s2;
+ register ptrdiff_t i;
struct re_pattern_buffer *bufp;
if (running_asynch_code)
save_search_regs ();
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
- XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2]
- = BVAR (current_buffer, case_eqv_table);
+ set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
+ BVAR (current_buffer, case_eqv_table));
CHECK_STRING (string);
bufp = compile_pattern (string,
static Lisp_Object
string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, int posix)
{
- EMACS_INT val;
+ ptrdiff_t val;
struct re_pattern_buffer *bufp;
- EMACS_INT pos, pos_byte;
- int i;
+ EMACS_INT pos;
+ ptrdiff_t pos_byte, i;
if (running_asynch_code)
save_search_regs ();
pos = 0, pos_byte = 0;
else
{
- EMACS_INT len = SCHARS (string);
+ ptrdiff_t len = SCHARS (string);
CHECK_NUMBER (start);
pos = XINT (start);
}
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
- XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2]
- = BVAR (current_buffer, case_eqv_table);
+ set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
+ BVAR (current_buffer, case_eqv_table));
bufp = compile_pattern (regexp,
(NILP (Vinhibit_changing_match_data)
and return the index of the match, or negative on failure.
This does not clobber the match data. */
-EMACS_INT
+ptrdiff_t
fast_string_match (Lisp_Object regexp, Lisp_Object string)
{
- EMACS_INT val;
+ ptrdiff_t val;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (regexp, 0, Qnil,
This does not clobber the match data.
We assume that STRING contains single-byte characters. */
-EMACS_INT
-fast_c_string_match_ignore_case (Lisp_Object regexp, const char *string)
+ptrdiff_t
+fast_c_string_match_ignore_case (Lisp_Object regexp,
+ const char *string, ptrdiff_t len)
{
- EMACS_INT val;
+ ptrdiff_t val;
struct re_pattern_buffer *bufp;
- size_t len = strlen (string);
regexp = string_make_unibyte (regexp);
re_match_object = Qt;
/* Like fast_string_match but ignore case. */
-EMACS_INT
+ptrdiff_t
fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string)
{
- EMACS_INT val;
+ ptrdiff_t val;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (regexp, 0, Vascii_canon_table,
indices into the string. This function doesn't modify the match
data. */
-EMACS_INT
-fast_looking_at (Lisp_Object regexp, EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT limit, EMACS_INT limit_byte, Lisp_Object string)
+ptrdiff_t
+fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t limit, ptrdiff_t limit_byte, Lisp_Object string)
{
int multibyte;
struct re_pattern_buffer *buf;
unsigned char *p1, *p2;
- EMACS_INT s1, s2;
- EMACS_INT len;
+ ptrdiff_t s1, s2;
+ ptrdiff_t len;
if (STRINGP (string))
{
If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do
except when inside redisplay. */
-EMACS_INT
-scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
- EMACS_INT count, EMACS_INT *shortage, int allow_quit)
+ptrdiff_t
+scan_buffer (register int target, ptrdiff_t start, ptrdiff_t end,
+ ptrdiff_t count, ptrdiff_t *shortage, int allow_quit)
{
struct region_cache *newline_cache;
int direction;
the position of the last character before the next such
obstacle --- the last character the dumb search loop should
examine. */
- EMACS_INT ceiling_byte = CHAR_TO_BYTE (end) - 1;
- EMACS_INT start_byte = CHAR_TO_BYTE (start);
- EMACS_INT tem;
+ ptrdiff_t ceiling_byte = CHAR_TO_BYTE (end) - 1;
+ ptrdiff_t start_byte;
+ ptrdiff_t tem;
/* If we're looking for a newline, consult the newline cache
to see where we can avoid some scanning. */
ptrdiff_t next_change;
immediate_quit = 0;
while (region_cache_forward
- (current_buffer, newline_cache, start_byte, &next_change))
- start_byte = next_change;
+ (current_buffer, newline_cache, start, &next_change))
+ start = next_change;
immediate_quit = allow_quit;
+ start_byte = CHAR_TO_BYTE (start);
+
/* START should never be after END. */
if (start_byte > ceiling_byte)
start_byte = ceiling_byte;
/* Now the text after start is an unknown region, and
next_change is the position of the next known region. */
- ceiling_byte = min (next_change - 1, ceiling_byte);
+ ceiling_byte = min (CHAR_TO_BYTE (next_change) - 1, ceiling_byte);
}
+ else
+ start_byte = CHAR_TO_BYTE (start);
/* The dumb loop can only scan text stored in contiguous
bytes. BUFFER_CEILING_OF returns the last character
while (start > end)
{
/* The last character to check before the next obstacle. */
- EMACS_INT ceiling_byte = CHAR_TO_BYTE (end);
- EMACS_INT start_byte = CHAR_TO_BYTE (start);
- EMACS_INT tem;
+ ptrdiff_t ceiling_byte = CHAR_TO_BYTE (end);
+ ptrdiff_t start_byte;
+ ptrdiff_t tem;
/* Consult the newline cache, if appropriate. */
if (target == '\n' && newline_cache)
ptrdiff_t next_change;
immediate_quit = 0;
while (region_cache_backward
- (current_buffer, newline_cache, start_byte, &next_change))
- start_byte = next_change;
+ (current_buffer, newline_cache, start, &next_change))
+ start = next_change;
immediate_quit = allow_quit;
+ start_byte = CHAR_TO_BYTE (start);
+
/* Start should never be at or before end. */
if (start_byte <= ceiling_byte)
start_byte = ceiling_byte + 1;
/* Now the text before start is an unknown region, and
next_change is the position of the next known region. */
- ceiling_byte = max (next_change, ceiling_byte);
+ ceiling_byte = max (CHAR_TO_BYTE (next_change), ceiling_byte);
}
+ else
+ start_byte = CHAR_TO_BYTE (start);
/* Stop scanning before the gap. */
tem = BUFFER_FLOOR_OF (start_byte - 1);
except in special cases. */
EMACS_INT
-scan_newline (EMACS_INT start, EMACS_INT start_byte,
- EMACS_INT limit, EMACS_INT limit_byte,
+scan_newline (ptrdiff_t start, ptrdiff_t start_byte,
+ ptrdiff_t limit, ptrdiff_t limit_byte,
register EMACS_INT count, int allow_quit)
{
int direction = ((count > 0) ? 1 : -1);
register unsigned char *cursor;
unsigned char *base;
- EMACS_INT ceiling;
+ ptrdiff_t ceiling;
register unsigned char *ceiling_addr;
int old_immediate_quit = immediate_quit;
return count * direction;
}
-EMACS_INT
-find_next_newline_no_quit (EMACS_INT from, EMACS_INT cnt)
+ptrdiff_t
+find_next_newline_no_quit (ptrdiff_t from, ptrdiff_t cnt)
{
- return scan_buffer ('\n', from, 0, cnt, (EMACS_INT *) 0, 0);
+ return scan_buffer ('\n', from, 0, cnt, (ptrdiff_t *) 0, 0);
}
/* Like find_next_newline, but returns position before the newline,
not after, and only search up to TO. This isn't just
find_next_newline (...)-1, because you might hit TO. */
-EMACS_INT
-find_before_next_newline (EMACS_INT from, EMACS_INT to, EMACS_INT cnt)
+ptrdiff_t
+find_before_next_newline (ptrdiff_t from, ptrdiff_t to, ptrdiff_t cnt)
{
- EMACS_INT shortage;
- EMACS_INT pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
+ ptrdiff_t shortage;
+ ptrdiff_t pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
if (shortage == 0)
pos--;
Lisp_Object count, int direction, int RE, int posix)
{
register EMACS_INT np;
- EMACS_INT lim, lim_byte;
+ EMACS_INT lim;
+ ptrdiff_t lim_byte;
EMACS_INT n = direction;
if (!NILP (count))
}
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
- XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2]
- = BVAR (current_buffer, case_eqv_table);
+ set_char_table_extras (BVAR (current_buffer, case_canon_table), 2,
+ BVAR (current_buffer, case_eqv_table));
np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE,
(!NILP (BVAR (current_buffer, case_fold_search))
if (!EQ (noerror, Qt))
{
if (lim < BEGV || lim > ZV)
- abort ();
+ emacs_abort ();
SET_PT_BOTH (lim, lim_byte);
return Qnil;
#if 0 /* This would be clean, but maybe programs depend on
}
if (np < BEGV || np > ZV)
- abort ();
+ emacs_abort ();
SET_PT (np);
static int
trivial_regexp_p (Lisp_Object regexp)
{
- EMACS_INT len = SBYTES (regexp);
+ ptrdiff_t len = SBYTES (regexp);
unsigned char *s = SDATA (regexp);
while (--len >= 0)
{
static struct re_registers search_regs_1;
static EMACS_INT
-search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT lim, EMACS_INT lim_byte, EMACS_INT n,
+search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t lim, ptrdiff_t lim_byte, EMACS_INT n,
int RE, Lisp_Object trt, Lisp_Object inverse_trt, int posix)
{
- EMACS_INT len = SCHARS (string);
- EMACS_INT len_byte = SBYTES (string);
- register int i;
+ ptrdiff_t len = SCHARS (string);
+ ptrdiff_t len_byte = SBYTES (string);
+ register ptrdiff_t i;
if (running_asynch_code)
save_search_regs ();
if (RE && !(trivial_regexp_p (string) && NILP (Vsearch_spaces_regexp)))
{
unsigned char *p1, *p2;
- EMACS_INT s1, s2;
+ ptrdiff_t s1, s2;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (string,
while (n < 0)
{
- EMACS_INT val;
+ ptrdiff_t val;
val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
pos_byte - BEGV_BYTE, lim_byte - pos_byte,
}
while (n > 0)
{
- EMACS_INT val;
+ ptrdiff_t val;
val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2,
pos_byte - BEGV_BYTE, lim_byte - pos_byte,
else /* non-RE case */
{
unsigned char *raw_pattern, *pat;
- EMACS_INT raw_pattern_size;
- EMACS_INT raw_pattern_size_byte;
+ ptrdiff_t raw_pattern_size;
+ ptrdiff_t raw_pattern_size_byte;
unsigned char *patbuf;
int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
unsigned char *base_pat;
raw_pattern_size_byte
= count_size_as_multibyte (SDATA (string),
raw_pattern_size);
- raw_pattern = (unsigned char *) alloca (raw_pattern_size_byte + 1);
+ raw_pattern = alloca (raw_pattern_size_byte + 1);
copy_text (SDATA (string), raw_pattern,
SCHARS (string), 0, 1);
}
the chosen single-byte character set can possibly match. */
raw_pattern_size = SCHARS (string);
raw_pattern_size_byte = SCHARS (string);
- raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
+ raw_pattern = alloca (raw_pattern_size + 1);
copy_text (SDATA (string), raw_pattern,
SBYTES (string), 1, 0);
}
/* Copy and optionally translate the pattern. */
len = raw_pattern_size;
len_byte = raw_pattern_size_byte;
- patbuf = (unsigned char *) alloca (len * MAX_MULTIBYTE_LENGTH);
+ patbuf = alloca (len * MAX_MULTIBYTE_LENGTH);
pat = patbuf;
base_pat = raw_pattern;
if (multibyte)
static EMACS_INT
simple_search (EMACS_INT n, unsigned char *pat,
- EMACS_INT len, EMACS_INT len_byte, Lisp_Object trt,
- EMACS_INT pos, EMACS_INT pos_byte,
- EMACS_INT lim, EMACS_INT lim_byte)
+ ptrdiff_t len, ptrdiff_t len_byte, Lisp_Object trt,
+ ptrdiff_t pos, ptrdiff_t pos_byte,
+ ptrdiff_t lim, ptrdiff_t lim_byte)
{
int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
int forward = n > 0;
/* Number of buffer bytes matched. Note that this may be different
from len_byte in a multibyte buffer. */
- EMACS_INT match_byte;
+ ptrdiff_t match_byte = PTRDIFF_MIN;
if (lim > pos && multibyte)
while (n > 0)
while (1)
{
/* Try matching at position POS. */
- EMACS_INT this_pos = pos;
- EMACS_INT this_pos_byte = pos_byte;
- EMACS_INT this_len = len;
+ ptrdiff_t this_pos = pos;
+ ptrdiff_t this_pos_byte = pos_byte;
+ ptrdiff_t this_len = len;
unsigned char *p = pat;
if (pos + len > lim || pos_byte + len_byte > lim_byte)
goto stop;
while (1)
{
/* Try matching at position POS. */
- EMACS_INT this_pos = pos;
- EMACS_INT this_len = len;
+ ptrdiff_t this_pos = pos;
+ ptrdiff_t this_len = len;
unsigned char *p = pat;
if (pos + len > lim)
while (1)
{
/* Try matching at position POS. */
- EMACS_INT this_pos = pos;
- EMACS_INT this_pos_byte = pos_byte;
- EMACS_INT this_len = len;
+ ptrdiff_t this_pos = pos;
+ ptrdiff_t this_pos_byte = pos_byte;
+ ptrdiff_t this_len = len;
const unsigned char *p = pat + len_byte;
if (this_pos - len < lim || (pos_byte - len_byte) < lim_byte)
while (1)
{
/* Try matching at position POS. */
- EMACS_INT this_pos = pos - len;
- EMACS_INT this_len = len;
+ ptrdiff_t this_pos = pos - len;
+ ptrdiff_t this_len = len;
unsigned char *p = pat;
if (this_pos < lim)
stop:
if (n == 0)
{
+ eassert (match_byte != PTRDIFF_MIN);
if (forward)
set_search_regs ((multibyte ? pos_byte : pos) - match_byte, match_byte);
else
static EMACS_INT
boyer_moore (EMACS_INT n, unsigned char *base_pat,
- EMACS_INT len_byte,
+ ptrdiff_t len_byte,
Lisp_Object trt, Lisp_Object inverse_trt,
- EMACS_INT pos_byte, EMACS_INT lim_byte,
+ ptrdiff_t pos_byte, ptrdiff_t lim_byte,
int char_base)
{
int direction = ((n > 0) ? 1 : -1);
- register EMACS_INT dirlen;
- EMACS_INT limit;
+ register ptrdiff_t dirlen;
+ ptrdiff_t limit;
int stride_for_teases = 0;
int BM_tab[0400];
register unsigned char *cursor, *p_limit;
- register EMACS_INT i;
+ register ptrdiff_t i;
register int j;
unsigned char *pat, *pat_end;
int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
char if reverse) of pattern would align in a possible match. */
while (n != 0)
{
- EMACS_INT tail_end;
+ ptrdiff_t tail_end;
unsigned char *tail_end_ptr;
/* It's been reported that some (broken) compiler thinks that
cursor += dirlen - i - direction; /* fix cursor */
if (i + direction == 0)
{
- EMACS_INT position, start, end;
+ ptrdiff_t position, start, end;
cursor -= direction;
pos_byte += dirlen - i - direction;
if (i + direction == 0)
{
- EMACS_INT position, start, end;
+ ptrdiff_t position, start, end;
pos_byte -= direction;
position = pos_byte + ((direction > 0) ? 1 - len_byte : 0);
Also clear out the match data for registers 1 and up. */
static void
-set_search_regs (EMACS_INT beg_byte, EMACS_INT nbytes)
+set_search_regs (ptrdiff_t beg_byte, ptrdiff_t nbytes)
{
- int i;
+ ptrdiff_t i;
if (!NILP (Vinhibit_changing_match_data))
return;
the match position. */
if (search_regs.num_regs == 0)
{
- search_regs.start = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
- search_regs.end = (regoff_t *) xmalloc (2 * sizeof (regoff_t));
+ search_regs.start = xmalloc (2 * sizeof (regoff_t));
+ search_regs.end = xmalloc (2 * sizeof (regoff_t));
search_regs.num_regs = 2;
}
XSETBUFFER (last_thing_searched, current_buffer);
}
\f
-DEFUN ("word-search-regexp", Fword_search_regexp, Sword_search_regexp, 1, 2, 0,
- doc: /* Return a regexp which matches words, ignoring punctuation.
-Given STRING, a string of words separated by word delimiters,
-compute a regexp that matches those exact words separated by
-arbitrary punctuation. If LAX is non-nil, the end of the string
-need not match a word boundary unless it ends in whitespace.
-
-Used in `word-search-forward', `word-search-backward',
-`word-search-forward-lax', `word-search-backward-lax'. */)
- (Lisp_Object string, Lisp_Object lax)
-{
- register unsigned char *o;
- register EMACS_INT i, i_byte, len, punct_count = 0, word_count = 0;
- Lisp_Object val;
- int prev_c = 0;
- EMACS_INT adjust;
- int whitespace_at_end;
-
- CHECK_STRING (string);
- len = SCHARS (string);
-
- for (i = 0, i_byte = 0; i < len; )
- {
- int c;
-
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
-
- if (SYNTAX (c) != Sword)
- {
- punct_count++;
- if (SYNTAX (prev_c) == Sword)
- word_count++;
- }
-
- prev_c = c;
- }
-
- if (SYNTAX (prev_c) == Sword)
- {
- word_count++;
- whitespace_at_end = 0;
- }
- else
- {
- whitespace_at_end = 1;
- if (!word_count)
- return empty_unibyte_string;
- }
-
- adjust = - punct_count + 5 * (word_count - 1)
- + ((!NILP (lax) && !whitespace_at_end) ? 2 : 4);
- if (STRING_MULTIBYTE (string))
- val = make_uninit_multibyte_string (len + adjust,
- SBYTES (string)
- + adjust);
- else
- val = make_uninit_string (len + adjust);
-
- o = SDATA (val);
- *o++ = '\\';
- *o++ = 'b';
- prev_c = 0;
-
- for (i = 0, i_byte = 0; i < len; )
- {
- int c;
- EMACS_INT i_byte_orig = i_byte;
-
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
-
- if (SYNTAX (c) == Sword)
- {
- memcpy (o, SDATA (string) + i_byte_orig, i_byte - i_byte_orig);
- o += i_byte - i_byte_orig;
- }
- else if (SYNTAX (prev_c) == Sword && --word_count)
- {
- *o++ = '\\';
- *o++ = 'W';
- *o++ = '\\';
- *o++ = 'W';
- *o++ = '*';
- }
-
- prev_c = c;
- }
-
- if (NILP (lax) || whitespace_at_end)
- {
- *o++ = '\\';
- *o++ = 'b';
- }
-
- return val;
-}
-\f
DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
"MSearch backward: ",
doc: /* Search backward from point for STRING.
return search_command (string, bound, noerror, count, 1, 0, 0);
}
-DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
- "sWord search backward: ",
- doc: /* Search backward from point for STRING, ignoring differences in punctuation.
-Set point to the beginning of the occurrence found, and return point.
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend before that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qnil), bound, noerror, count, -1, 1, 0);
-}
-
-DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
- "sWord search: ",
- doc: /* Search forward from point for STRING, ignoring differences in punctuation.
-Set point to the end of the occurrence found, and return point.
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend after that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qnil), bound, noerror, count, 1, 1, 0);
-}
-
-DEFUN ("word-search-backward-lax", Fword_search_backward_lax, Sword_search_backward_lax, 1, 4,
- "sWord search backward: ",
- doc: /* Search backward from point for STRING, ignoring differences in punctuation.
-Set point to the beginning of the occurrence found, and return point.
-
-Unlike `word-search-backward', the end of STRING need not match a word
-boundary, unless STRING ends in whitespace.
-
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend before that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qt), bound, noerror, count, -1, 1, 0);
-}
-
-DEFUN ("word-search-forward-lax", Fword_search_forward_lax, Sword_search_forward_lax, 1, 4,
- "sWord search: ",
- doc: /* Search forward from point for STRING, ignoring differences in punctuation.
-Set point to the end of the occurrence found, and return point.
-
-Unlike `word-search-forward', the end of STRING need not match a word
-boundary, unless STRING ends in whitespace.
-
-An optional second argument bounds the search; it is a buffer position.
-The match found must not extend after that position.
-Optional third argument, if t, means if fail just return nil (no error).
- If not nil and not t, move to limit of search and return nil.
-Optional fourth argument is repeat count--search for successive occurrences.
-
-Relies on the function `word-search-regexp' to convert a sequence
-of words in STRING to a regexp used to search words without regard
-to punctuation. */)
- (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count)
-{
- return search_command (Fword_search_regexp (string, Qt), bound, noerror, count, 1, 1, 0);
-}
-
DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
"sRE search backward: ",
doc: /* Search backward from point for match for regular expression REGEXP.
doc: /* Replace text matched by last search with NEWTEXT.
Leave point at the end of the replacement text.
-If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
-Otherwise maybe capitalize the whole text, or maybe just word initials,
-based on the replaced text.
-If the replaced text has only capital letters
-and has at least one multiletter word, convert NEWTEXT to all caps.
-Otherwise if all words are capitalized in the replaced text,
-capitalize each word in NEWTEXT.
+If optional second arg FIXEDCASE is non-nil, do not alter the case of
+the replacement text. Otherwise, maybe capitalize the whole text, or
+maybe just word initials, based on the replaced text. If the replaced
+text has only capital letters and has at least one multiletter word,
+convert NEWTEXT to all caps. Otherwise if all words are capitalized
+in the replaced text, capitalize each word in NEWTEXT.
-If third arg LITERAL is non-nil, insert NEWTEXT literally.
+If optional third arg LITERAL is non-nil, insert NEWTEXT literally.
Otherwise treat `\\' as special:
`\\&' in NEWTEXT means substitute original matched text.
`\\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.
-
-The optional fourth argument STRING can be a string to modify.
-This is meaningful when the previous match was done against STRING,
-using `string-match'. When used this way, `replace-match'
-creates and returns a new string made by copying STRING and replacing
-the part of STRING that was matched.
+If optional fourth argument STRING is non-nil, it should be a string
+to act on; this should be the string on which the previous match was
+done via `string-match'. In this case, `replace-match' creates and
+returns a new string, made by copying STRING and replacing the part of
+STRING that was matched (the original STRING itself is not altered).
The optional fifth argument SUBEXP specifies a subexpression;
it says to replace just that subexpression with NEWTEXT,
(Lisp_Object newtext, Lisp_Object fixedcase, Lisp_Object literal, Lisp_Object string, Lisp_Object subexp)
{
enum { nochange, all_caps, cap_initial } case_action;
- register EMACS_INT pos, pos_byte;
+ register ptrdiff_t pos, pos_byte;
int some_multiletter_word;
int some_lowercase;
int some_uppercase;
int some_nonuppercase_initial;
register int c, prevc;
ptrdiff_t sub;
- EMACS_INT opoint, newpoint;
+ ptrdiff_t opoint, newpoint;
CHECK_STRING (newtext);
if (NILP (fixedcase))
{
/* Decide how to casify by examining the matched text. */
- EMACS_INT last;
+ ptrdiff_t last;
pos = search_regs.start[sub];
last = search_regs.end[sub];
if desired. */
if (NILP (literal))
{
- EMACS_INT lastpos = 0;
- EMACS_INT lastpos_byte = 0;
+ ptrdiff_t lastpos = 0;
+ ptrdiff_t lastpos_byte = 0;
/* We build up the substituted string in ACCUM. */
Lisp_Object accum;
Lisp_Object middle;
- EMACS_INT length = SBYTES (newtext);
+ ptrdiff_t length = SBYTES (newtext);
accum = Qnil;
for (pos_byte = 0, pos = 0; pos_byte < length;)
{
- EMACS_INT substart = -1;
- EMACS_INT subend = 0;
+ ptrdiff_t substart = -1;
+ ptrdiff_t subend = 0;
int delbackslash = 0;
FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
}
else if (c >= '1' && c <= '9')
{
- if (search_regs.start[c - '0'] >= 0
- && c <= search_regs.num_regs + '0')
+ if (c - '0' < search_regs.num_regs
+ && 0 <= search_regs.start[c - '0'])
{
substart = search_regs.start[c - '0'];
subend = search_regs.end[c - '0'];
}
else if (c == '\\')
delbackslash = 1;
- else
+ else if (c != '?')
error ("Invalid use of `\\' in replacement text");
}
if (substart >= 0)
substed_alloc_size = ((STRING_BYTES_BOUND - 100) / 2 < length
? STRING_BYTES_BOUND
: length * 2 + 100);
- substed = (unsigned char *) xmalloc (substed_alloc_size);
+ substed = xmalloc (substed_alloc_size);
substed_len = 0;
/* Go thru NEWTEXT, producing the actual text to insert in
if (c == '&')
idx = sub;
- else if (c >= '1' && c <= '9' && c <= search_regs.num_regs + '0')
+ else if (c >= '1' && c <= '9' && c - '0' < search_regs.num_regs)
{
if (search_regs.start[c - '0'] >= 1)
idx = c - '0';
{
if (buf_multibyte)
{
- EMACS_INT nchars =
+ ptrdiff_t nchars =
multibyte_chars_in_text (substed, substed_len);
newtext = make_multibyte_string ((char *) substed, nchars,
/* Adjust search data for this change. */
{
- EMACS_INT oldend = search_regs.end[sub];
- EMACS_INT oldstart = search_regs.start[sub];
- EMACS_INT change = newpoint - search_regs.end[sub];
- int i;
+ ptrdiff_t oldend = search_regs.end[sub];
+ ptrdiff_t oldstart = search_regs.start[sub];
+ ptrdiff_t change = newpoint - search_regs.end[sub];
+ ptrdiff_t i;
for (i = 0; i < search_regs.num_regs; i++)
{
{
Lisp_Object tail, prev;
Lisp_Object *data;
- int i, len;
+ ptrdiff_t i, len;
if (!NILP (reseat))
for (tail = reuse; CONSP (tail); tail = XCDR (tail))
prev = Qnil;
- data = (Lisp_Object *) alloca ((2 * search_regs.num_regs + 1)
- * sizeof (Lisp_Object));
+ data = alloca ((2 * search_regs.num_regs + 1) * sizeof *data);
len = 0;
for (i = 0; i < search_regs.num_regs; i++)
{
- EMACS_INT start = search_regs.start[i];
+ ptrdiff_t start = search_regs.start[i];
if (start >= 0)
{
if (EQ (last_thing_searched, Qt)
}
else
/* last_thing_searched must always be Qt, a buffer, or Qnil. */
- abort ();
+ emacs_abort ();
len = 2 * i + 2;
}
/* Allocate registers if they don't already exist. */
{
- ptrdiff_t length = XFASTINT (Flength (list)) / 2;
+ EMACS_INT length = XFASTINT (Flength (list)) / 2;
if (length > search_regs.num_regs)
{
ptrdiff_t num_regs = search_regs.num_regs;
+ if (PTRDIFF_MAX < length)
+ memory_full (SIZE_MAX);
search_regs.start =
xpalloc (search_regs.start, &num_regs, length - num_regs,
min (PTRDIFF_MAX, UINT_MAX), sizeof (regoff_t));
}
else
{
- EMACS_INT from;
+ Lisp_Object from;
Lisp_Object m;
m = marker;
}
CHECK_NUMBER_COERCE_MARKER (marker);
- from = XINT (marker);
+ from = marker;
if (!NILP (reseat) && MARKERP (m))
{
XSETFASTINT (marker, 0);
CHECK_NUMBER_COERCE_MARKER (marker);
- search_regs.start[i] = from;
- search_regs.end[i] = XINT (marker);
+ if ((XINT (from) < 0
+ ? TYPE_MINIMUM (regoff_t) <= XINT (from)
+ : XINT (from) <= TYPE_MAXIMUM (regoff_t))
+ && (XINT (marker) < 0
+ ? TYPE_MINIMUM (regoff_t) <= XINT (marker)
+ : XINT (marker) <= TYPE_MAXIMUM (regoff_t)))
+ {
+ search_regs.start[i] = XINT (from);
+ search_regs.end[i] = XINT (marker);
+ }
+ else
+ {
+ search_regs.start[i] = -1;
+ }
if (!NILP (reseat) && MARKERP (m))
{
CHECK_STRING (string);
- temp = (char *) alloca (SBYTES (string) * 2);
+ temp = alloca (SBYTES (string) * 2);
/* Now copy the data into the new string, inserting escapes. */
for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
{
searchbufs[i].buf.allocated = 100;
- searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
+ searchbufs[i].buf.buffer = xmalloc (100);
searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
searchbufs[i].regexp = Qnil;
searchbufs[i].whitespace_regexp = Qnil;
DEFSYM (Qinvalid_regexp, "invalid-regexp");
Fput (Qsearch_failed, Qerror_conditions,
- pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qsearch_failed, Qerror));
Fput (Qsearch_failed, Qerror_message,
- make_pure_c_string ("Search failed"));
+ build_pure_c_string ("Search failed"));
Fput (Qinvalid_regexp, Qerror_conditions,
- pure_cons (Qinvalid_regexp, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qinvalid_regexp, Qerror));
Fput (Qinvalid_regexp, Qerror_message,
- make_pure_c_string ("Invalid regexp"));
+ build_pure_c_string ("Invalid regexp"));
last_thing_searched = Qnil;
staticpro (&last_thing_searched);
defsubr (&Sposix_string_match);
defsubr (&Ssearch_forward);
defsubr (&Ssearch_backward);
- defsubr (&Sword_search_regexp);
- defsubr (&Sword_search_forward);
- defsubr (&Sword_search_backward);
- defsubr (&Sword_search_forward_lax);
- defsubr (&Sword_search_backward_lax);
defsubr (&Sre_search_forward);
defsubr (&Sre_search_backward);
defsubr (&Sposix_search_forward);
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include <unistd.h>
bss_sbrk_ptr - bss_sbrk_buffer, STATIC_HEAP_SIZE);
message ("%s", buf);
}
-
/* sound.c -- sound support.
- Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
+
+Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
cause an error to be generated.
The Windows implementation of play-sound is implemented via the
- Win32 API functions mciSendString, waveOutGetVolume, and
+ Windows API functions mciSendString, waveOutGetVolume, and
waveOutSetVolume which are exported by Winmm.dll.
*/
#include <unistd.h>
#include <sys/types.h>
#include <errno.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "dispextern.h"
#include "atimer.h"
-#include <signal.h>
#include "syssignal.h"
/* END: Common Includes */
SOUND_ATTR_SENTINEL
};
-#ifdef HAVE_ALSA
-static void alsa_sound_perror (const char *, int) NO_RETURN;
-#endif
-static void sound_perror (const char *) NO_RETURN;
-static void sound_warning (const char *);
-static int parse_sound (Lisp_Object, Lisp_Object *);
-
/* END: Common Definitions */
/* BEGIN: Non Windows Definitions */
#ifndef WINDOWSNT
-#ifndef DEFAULT_SOUND_DEVICE
-#define DEFAULT_SOUND_DEVICE "/dev/dsp"
-#endif
-#ifndef DEFAULT_ALSA_SOUND_DEVICE
-#define DEFAULT_ALSA_SOUND_DEVICE "default"
-#endif
-
-
/* Structure forward declarations. */
struct sound;
/* Return a preferred data size in bytes to be sent to write (below)
each time. 2048 is used if this is NULL. */
- EMACS_INT (* period_size) (struct sound_device *sd);
+ ptrdiff_t (* period_size) (struct sound_device *sd);
/* Write NYBTES bytes from BUFFER to device SD. */
void (* write) (struct sound_device *sd, const char *buffer,
- EMACS_INT nbytes);
+ ptrdiff_t nbytes);
/* A place for devices to store additional data. */
void *data;
static void vox_close (struct sound_device *sd);
static void vox_choose_format (struct sound_device *, struct sound *);
static int vox_init (struct sound_device *);
-static void vox_write (struct sound_device *, const char *, EMACS_INT);
+static void vox_write (struct sound_device *, const char *, ptrdiff_t);
static void find_sound_type (struct sound *);
static u_int32_t le2hl (u_int32_t);
static u_int16_t le2hs (u_int16_t);
/* Like perror, but signals an error. */
-static void
+static _Noreturn void
sound_perror (const char *msg)
{
int saved_errno = errno;
turn_on_atimers (1);
-#ifdef SIGIO
- sigunblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ {
+ sigset_t unblocked;
+ sigemptyset (&unblocked);
+ sigaddset (&unblocked, SIGIO);
+ pthread_sigmask (SIG_UNBLOCK, &unblocked, 0);
+ }
#endif
if (saved_errno != 0)
error ("%s: %s", msg, strerror (saved_errno));
else
{
char *buffer;
- EMACS_INT nbytes = 0;
- EMACS_INT blksize = sd->period_size ? sd->period_size (sd) : 2048;
- EMACS_INT data_left = header->data_length;
+ ptrdiff_t nbytes = 0;
+ ptrdiff_t blksize = sd->period_size ? sd->period_size (sd) : 2048;
+ ptrdiff_t data_left = header->data_length;
- buffer = (char *) alloca (blksize);
+ buffer = alloca (blksize);
lseek (s->fd, sizeof *header, SEEK_SET);
while (data_left > 0
&& (nbytes = emacs_read (s->fd, buffer, blksize)) > 0)
SBYTES (s->data) - header->data_offset);
else
{
- EMACS_INT blksize = sd->period_size ? sd->period_size (sd) : 2048;
+ ptrdiff_t blksize = sd->period_size ? sd->period_size (sd) : 2048;
char *buffer;
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
/* Seek */
lseek (s->fd, header->data_offset, SEEK_SET);
/* Copy sound data to the device. */
- buffer = (char *) alloca (blksize);
+ buffer = alloca (blksize);
while ((nbytes = emacs_read (s->fd, buffer, blksize)) > 0)
sd->write (sd, buffer, nbytes);
{
const char *file;
- /* Open the sound device. Default is /dev/dsp. */
+ /* Open the sound device (eg /dev/dsp). */
if (sd->file)
file = sd->file;
else
vox_configure (struct sound_device *sd)
{
int val;
+#ifdef USABLE_SIGIO
+ sigset_t blocked;
+#endif
- xassert (sd->fd >= 0);
+ eassert (sd->fd >= 0);
/* On GNU/Linux, it seems that the device driver doesn't like to be
interrupted by a signal. Block the ones we know to cause
troubles. */
turn_on_atimers (0);
-#ifdef SIGIO
- sigblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGIO);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
#endif
val = sd->format;
}
turn_on_atimers (1);
-#ifdef SIGIO
- sigunblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
#endif
}
/* On GNU/Linux, it seems that the device driver doesn't like to
be interrupted by a signal. Block the ones we know to cause
troubles. */
-#ifdef SIGIO
- sigblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGIO);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
#endif
turn_on_atimers (0);
ioctl (sd->fd, SNDCTL_DSP_SYNC, NULL);
turn_on_atimers (1);
-#ifdef SIGIO
- sigunblock (sigmask (SIGIO));
+#ifdef USABLE_SIGIO
+ pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
#endif
/* Close the device. */
}
}
else
- abort ();
+ emacs_abort ();
}
const char *file;
int fd;
- /* Open the sound device. Default is /dev/dsp. */
+ /* Open the sound device (eg /dev/dsp). */
if (sd->file)
file = sd->file;
else
/* Write NBYTES bytes from BUFFER to device SD. */
static void
-vox_write (struct sound_device *sd, const char *buffer, EMACS_INT nbytes)
+vox_write (struct sound_device *sd, const char *buffer, ptrdiff_t nbytes)
{
if (emacs_write (sd->fd, buffer, nbytes) != nbytes)
sound_perror ("Error writing to sound device");
/* This driver is available on GNU/Linux. */
-static void
+#ifndef DEFAULT_ALSA_SOUND_DEVICE
+#define DEFAULT_ALSA_SOUND_DEVICE "default"
+#endif
+
+static _Noreturn void
alsa_sound_perror (const char *msg, int err)
{
error ("%s: %s", msg, snd_strerror (err));
else
file = DEFAULT_ALSA_SOUND_DEVICE;
- p = xmalloc (sizeof (*p));
+ p = xmalloc (sizeof *p);
p->handle = NULL;
p->hwparams = NULL;
p->swparams = NULL;
alsa_sound_perror (file, err);
}
-static EMACS_INT
+static ptrdiff_t
alsa_period_size (struct sound_device *sd)
{
struct alsa_params *p = (struct alsa_params *) sd->data;
struct alsa_params *p = (struct alsa_params *) sd->data;
snd_pcm_uframes_t buffer_size;
- xassert (p->handle != 0);
+ eassert (p->handle != 0);
err = snd_pcm_hw_params_malloc (&p->hwparams);
if (err < 0)
}
}
else
- abort ();
+ emacs_abort ();
}
/* Write NBYTES bytes from BUFFER to device SD. */
static void
-alsa_write (struct sound_device *sd, const char *buffer, EMACS_INT nbytes)
+alsa_write (struct sound_device *sd, const char *buffer, ptrdiff_t nbytes)
{
struct alsa_params *p = (struct alsa_params *) sd->data;
/* The the third parameter to snd_pcm_writei is frames, not bytes. */
int fact = snd_pcm_format_size (sd->format, 1) * sd->channels;
- EMACS_INT nwritten = 0;
+ ptrdiff_t nwritten = 0;
int err;
while (nwritten < nbytes)
(Lisp_Object sound)
{
Lisp_Object attrs[SOUND_ATTR_SENTINEL];
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
#ifndef WINDOWSNT
Lisp_Object file;
#ifndef WINDOWSNT
file = Qnil;
GCPRO2 (sound, file);
- current_sound_device = (struct sound_device *) xmalloc (sizeof (struct sound_device));
- memset (current_sound_device, 0, sizeof (struct sound_device));
- current_sound = (struct sound *) xmalloc (sizeof (struct sound));
- memset (current_sound, 0, sizeof (struct sound));
+ current_sound_device = xzalloc (sizeof *current_sound_device);
+ current_sound = xzalloc (sizeof *current_sound);
record_unwind_protect (sound_cleanup, Qnil);
- current_sound->header = (char *) alloca (MAX_SOUND_HEADER_BYTES);
+ current_sound->header = alloca (MAX_SOUND_HEADER_BYTES);
if (STRINGP (attrs[SOUND_FILE]))
{
if (STRINGP (attrs[SOUND_DEVICE]))
{
int len = SCHARS (attrs[SOUND_DEVICE]);
- current_sound_device->file = (char *) alloca (len + 1);
+ current_sound_device->file = alloca (len + 1);
strcpy (current_sound_device->file, SSDATA (attrs[SOUND_DEVICE]));
}
lo_file = Fexpand_file_name (attrs[SOUND_FILE], Qnil);
len = XSTRING (lo_file)->size;
- psz_file = (char *) alloca (len + 1);
+ psz_file = alloca (len + 1);
strcpy (psz_file, XSTRING (lo_file)->data);
if (INTEGERP (attrs[SOUND_VOLUME]))
{
defsubr (&Splay_sound_internal);
}
-
-void
-init_sound (void)
-{
-}
-
#endif /* HAVE_SOUND */
#include <config.h>
-#include <ctype.h>
#include <sys/types.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "commands.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "keymap.h"
#include "regex.h"
struct lisp_parse_state
{
- int depth; /* Depth at end of parsing. */
+ EMACS_INT depth; /* Depth at end of parsing. */
int instring; /* -1 if not within string, else desired terminator. */
- int incomment; /* -1 if in unnestable comment else comment nesting */
+ EMACS_INT incomment; /* -1 if in unnestable comment else comment nesting */
int comstyle; /* comment style a=0, or b=1, or ST_COMMENT_STYLE. */
int quoted; /* Nonzero if just after an escape char at end of parsing */
- int mindepth; /* Minimum depth seen while scanning. */
+ EMACS_INT mindepth; /* Minimum depth seen while scanning. */
/* Char number of most recent start-of-expression at current level */
- EMACS_INT thislevelstart;
+ ptrdiff_t thislevelstart;
/* Char number of start of containing expression */
- EMACS_INT prevlevelstart;
- EMACS_INT location; /* Char number at which parsing stopped. */
- EMACS_INT comstr_start; /* Position of last comment/string starter. */
+ ptrdiff_t prevlevelstart;
+ ptrdiff_t location; /* Char number at which parsing stopped. */
+ ptrdiff_t comstr_start; /* Position of last comment/string starter. */
Lisp_Object levelstarts; /* Char numbers of starts-of-expression
of levels (starting from outermost). */
};
find_start_begv is the BEGV value when it was found.
find_start_modiff is the value of MODIFF when it was found. */
-static EMACS_INT find_start_pos;
-static EMACS_INT find_start_value;
-static EMACS_INT find_start_value_byte;
+static ptrdiff_t find_start_pos;
+static ptrdiff_t find_start_value;
+static ptrdiff_t find_start_value_byte;
static struct buffer *find_start_buffer;
-static EMACS_INT find_start_begv;
-static int find_start_modiff;
+static ptrdiff_t find_start_begv;
+static EMACS_INT find_start_modiff;
-static Lisp_Object Fsyntax_table_p (Lisp_Object);
static Lisp_Object skip_chars (int, Lisp_Object, Lisp_Object, int);
static Lisp_Object skip_syntaxes (int, Lisp_Object, Lisp_Object);
static Lisp_Object scan_lists (EMACS_INT, EMACS_INT, EMACS_INT, int);
static void scan_sexps_forward (struct lisp_parse_state *,
- EMACS_INT, EMACS_INT, EMACS_INT, int,
+ ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT,
int, Lisp_Object, int);
static int in_classes (int, Lisp_Object);
+
+/* This setter is used only in this file, so it can be private. */
+static inline void
+bset_syntax_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (syntax_table) = val;
+}
\f
/* Whether the syntax of the character C has the prefix flag set. */
int syntax_prefix_flag_p (int c)
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. */
void
-update_syntax_table (EMACS_INT charpos, EMACS_INT count, int init,
+update_syntax_table (ptrdiff_t charpos, EMACS_INT count, int init,
Lisp_Object object)
{
Lisp_Object tmp_table;
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. */
/* 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. */
{
}
}
- while (!NULL_INTERVAL_P (i))
+ while (i)
{
if (cnt && !EQ (tmp_table, textget (i->plist, Qsyntax_table)))
{
/* 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
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
or after. On return global syntax data is good for lookup at CHARPOS. */
static int
-char_quoted (EMACS_INT charpos, EMACS_INT bytepos)
+char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos)
{
register enum syntaxcode code;
- register EMACS_INT beg = BEGV;
+ register ptrdiff_t beg = BEGV;
register int quoted = 0;
- EMACS_INT orig = charpos;
+ ptrdiff_t orig = charpos;
while (charpos > beg)
{
/* Return the bytepos one character before BYTEPOS.
We assume that BYTEPOS is not at the start of the buffer. */
-static inline EMACS_INT
-dec_bytepos (EMACS_INT bytepos)
+static inline ptrdiff_t
+dec_bytepos (ptrdiff_t bytepos)
{
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
return bytepos - 1;
valid on return from the subroutine, so the caller should explicitly
update the global data. */
-static EMACS_INT
-find_defun_start (EMACS_INT pos, EMACS_INT pos_byte)
+static ptrdiff_t
+find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
{
- EMACS_INT opoint = PT, opoint_byte = PT_BYTE;
+ ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
if (!open_paren_in_column_0_is_defun_start)
{
/* Return the SYNTAX_COMEND_FIRST of the character before POS, POS_BYTE. */
static int
-prev_char_comend_first (EMACS_INT pos, EMACS_INT pos_byte)
+prev_char_comend_first (ptrdiff_t pos, ptrdiff_t pos_byte)
{
int c, val;
the returned value (or at FROM, if the search was not successful). */
static int
-back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested, int comstyle, EMACS_INT *charpos_ptr, EMACS_INT *bytepos_ptr)
+back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, int comnested, int comstyle, ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr)
{
/* Look back, counting the parity of string-quotes,
and recording the comment-starters seen.
inside another comment).
Test case: { a (* b } c (* d *) */
int comment_lossage = 0;
- EMACS_INT comment_end = from;
- EMACS_INT comment_end_byte = from_byte;
- EMACS_INT comstart_pos = 0;
- EMACS_INT comstart_byte IF_LINT (= 0);
+ ptrdiff_t comment_end = from;
+ ptrdiff_t comment_end_byte = from_byte;
+ ptrdiff_t comstart_pos = 0;
+ ptrdiff_t comstart_byte IF_LINT (= 0);
/* Place where the containing defun starts,
or 0 if we didn't come across it yet. */
- EMACS_INT defun_start = 0;
- EMACS_INT defun_start_byte = 0;
+ ptrdiff_t defun_start = 0;
+ ptrdiff_t defun_start_byte = 0;
register enum syntaxcode code;
int nesting = 1; /* current comment nesting */
int c;
that determines quote parity to the comment-end. */
while (from != stop)
{
- EMACS_INT temp_byte;
+ ptrdiff_t temp_byte;
int prev_syntax, com2start, com2end;
int comstart;
have %..\n and %{..}%. */
if (from > stop && (com2end || comstart))
{
- EMACS_INT next = from, next_byte = from_byte;
+ ptrdiff_t next = from, next_byte = from_byte;
int next_c, next_syntax;
DEC_BOTH (next, next_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (next);
{
scan_sexps_forward (&state,
defun_start, defun_start_byte,
- comment_end, -10000, 0, Qnil, 0);
+ comment_end, TYPE_MINIMUM (EMACS_INT),
+ 0, Qnil, 0);
defun_start = comment_end;
if (state.incomment == (comnested ? 1 : -1)
&& state.comstyle == comstyle)
/* Only the standard syntax table should have a default element.
Other syntax tables should inherit from parents instead. */
- XCHAR_TABLE (copy)->defalt = Qnil;
+ set_char_table_defalt (copy, Qnil);
/* Copied syntax tables should all have parents.
If we copied one with no parent, such as the standard syntax table,
{
int idx;
check_syntax_table (table);
- BVAR (current_buffer, syntax_table) = table;
+ bset_syntax_table (current_buffer, 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);
}
DEFUN ("string-to-syntax", Fstring_to_syntax, Sstring_to_syntax, 1, 1, 0,
- doc: /* Convert a syntax specification STRING into syntax cell form.
-STRING should be a string as it is allowed as argument of
-`modify-syntax-entry'. Value is the equivalent cons cell
-\(CODE . MATCHING-CHAR) that can be used as value of a `syntax-table'
-text property. */)
+ doc: /* Convert a syntax descriptor STRING into a raw syntax descriptor.
+STRING should be a string of the form allowed as argument of
+`modify-syntax-entry'. The return value is a raw syntax descriptor: a
+cons cell \(CODE . MATCHING-CHAR) which can be used, for example, as
+the value of a `syntax-table' text property. */)
(Lisp_Object string)
{
register const unsigned char *p;
}
if (val < ASIZE (Vsyntax_code_object) && NILP (match))
- return XVECTOR (Vsyntax_code_object)->contents[val];
+ return AREF (Vsyntax_code_object, val);
else
/* Since we can't use a shared object, let's make a new one. */
return Fcons (make_number (val), match);
" 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.
first = XCAR (value);
match_lisp = XCDR (value);
- if (!INTEGERP (first) || !(NILP (match_lisp) || INTEGERP (match_lisp)))
+ if (!INTEGERP (first) || !(NILP (match_lisp) || CHARACTERP (match_lisp)))
{
insert_string ("invalid");
return syntax;
}
- syntax_code = XINT (first);
+ syntax_code = XINT (first) & INT_MAX;
code = (enum syntaxcode) (syntax_code & 0377);
start1 = SYNTAX_FLAGS_COMSTART_FIRST (syntax_code);
start2 = SYNTAX_FLAGS_COMSTART_SECOND (syntax_code);;
insert_string ("\twhich means: ");
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Swhitespace:
insert_string ("whitespace"); break;
If that many words cannot be found before the end of the buffer, return 0.
COUNT negative means scan backward and stop at word beginning. */
-EMACS_INT
-scan_words (register EMACS_INT from, register EMACS_INT count)
+ptrdiff_t
+scan_words (register ptrdiff_t from, register EMACS_INT count)
{
- register EMACS_INT beg = BEGV;
- register EMACS_INT end = ZV;
- register EMACS_INT from_byte = CHAR_TO_BYTE (from);
+ register ptrdiff_t beg = BEGV;
+ register ptrdiff_t end = ZV;
+ register ptrdiff_t from_byte = CHAR_TO_BYTE (from);
register enum syntaxcode code;
int ch0, ch1;
Lisp_Object func, pos;
if (! NILP (Ffboundp (func)))
{
pos = call2 (func, make_number (from - 1), make_number (end));
- if (INTEGERP (pos) && XINT (pos) > from)
+ if (INTEGERP (pos) && from < XINT (pos) && XINT (pos) <= ZV)
{
from = XINT (pos);
from_byte = CHAR_TO_BYTE (from);
if (! NILP (Ffboundp (func)))
{
pos = call2 (func, make_number (from), make_number (beg));
- if (INTEGERP (pos) && XINT (pos) < from)
+ if (INTEGERP (pos) && BEGV <= XINT (pos) && XINT (pos) < from)
{
from = XINT (pos);
from_byte = CHAR_TO_BYTE (from);
(Lisp_Object arg)
{
Lisp_Object tmp;
- int orig_val, val;
+ ptrdiff_t orig_val, val;
if (NILP (arg))
XSETFASTINT (arg, 1);
int *char_ranges IF_LINT (= NULL);
int n_char_ranges = 0;
int negate = 0;
- register EMACS_INT i, i_byte;
+ register ptrdiff_t i, i_byte;
/* Set to 1 if the current buffer is multibyte and the region
contains non-ASCII chars. */
int multibyte;
/* Set to 1 if STRING is multibyte and it contains non-ASCII
chars. */
int string_multibyte;
- EMACS_INT size_byte;
+ ptrdiff_t size_byte;
const unsigned char *str;
int len;
Lisp_Object iso_classes;
fastmap[CHAR_LEADING_CODE (c)] = 1;
range_start_byte = i;
range_start_char = c;
- char_ranges = (int *) alloca (sizeof (int) * 128 * 2);
+ char_ranges = alloca (sizeof *char_ranges * 128 * 2);
for (i = 129; i < 0400; i++)
{
c = BYTE8_TO_CHAR (i);
}
else /* STRING is multibyte */
{
- char_ranges = (int *) alloca (sizeof (int) * SCHARS (string) * 2);
+ char_ranges = alloca (sizeof *char_ranges * SCHARS (string) * 2);
while (i_byte < size_byte)
{
}
{
- EMACS_INT start_point = PT;
- EMACS_INT pos = PT;
- EMACS_INT pos_byte = PT_BYTE;
+ ptrdiff_t start_point = PT;
+ ptrdiff_t pos = PT;
+ ptrdiff_t pos_byte = PT_BYTE;
unsigned char *p = PT_ADDR, *endp, *stop;
if (forwardp)
register unsigned int c;
unsigned char fastmap[0400];
int negate = 0;
- register EMACS_INT i, i_byte;
+ register ptrdiff_t i, i_byte;
int multibyte;
- EMACS_INT size_byte;
+ ptrdiff_t size_byte;
unsigned char *str;
CHECK_STRING (string);
fastmap[i] ^= 1;
{
- EMACS_INT start_point = PT;
- EMACS_INT pos = PT;
- EMACS_INT pos_byte = PT_BYTE;
+ ptrdiff_t start_point = PT;
+ ptrdiff_t pos = PT;
+ ptrdiff_t pos_byte = PT_BYTE;
unsigned char *p = PT_ADDR, *endp, *stop;
if (forwardp)
remains valid for forward search starting at the returned position. */
static int
-forw_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop,
- int nesting, int style, int prev_syntax,
- EMACS_INT *charpos_ptr, EMACS_INT *bytepos_ptr,
- int *incomment_ptr)
+forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
+ EMACS_INT nesting, int style, int prev_syntax,
+ ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
+ EMACS_INT *incomment_ptr)
{
register int c, c1;
register enum syntaxcode code;
between them, return t; otherwise return nil. */)
(Lisp_Object count)
{
- register EMACS_INT from;
- EMACS_INT from_byte;
- register EMACS_INT stop;
+ register ptrdiff_t from;
+ ptrdiff_t from_byte;
+ register ptrdiff_t stop;
register int c, c1;
register enum syntaxcode code;
int comstyle = 0; /* style of comment encountered */
int comnested = 0; /* whether the comment is nestable or not */
int found;
EMACS_INT count1;
- EMACS_INT out_charpos, out_bytepos;
- int dummy;
+ ptrdiff_t out_charpos, out_bytepos;
+ EMACS_INT dummy;
CHECK_NUMBER (count);
count1 = XINT (count);
{
/* Skip until first preceding unquoted comment_fence. */
int fence_found = 0;
- EMACS_INT ini = from, ini_byte = from_byte;
+ ptrdiff_t ini = from, ini_byte = from_byte;
while (1)
{
scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpflag)
{
Lisp_Object val;
- register EMACS_INT stop = count > 0 ? ZV : BEGV;
+ register ptrdiff_t stop = count > 0 ? ZV : BEGV;
register int c, c1;
int stringterm;
int quoted;
int mathexit = 0;
register enum syntaxcode code, temp_code;
- int min_depth = depth; /* Err out if depth gets less than this. */
+ EMACS_INT min_depth = depth; /* Err out if depth gets less than this. */
int comstyle = 0; /* style of comment encountered */
int comnested = 0; /* whether the comment is nestable or not */
- EMACS_INT temp_pos;
+ ptrdiff_t temp_pos;
EMACS_INT last_good = from;
int found;
- EMACS_INT from_byte;
- EMACS_INT out_bytepos, out_charpos;
- int temp, dummy;
+ ptrdiff_t from_byte;
+ ptrdiff_t out_bytepos, out_charpos;
+ int temp;
+ EMACS_INT dummy;
int multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
if (depth > 0) min_depth = 0;
if (prefix)
continue;
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Sescape:
case Scharquote:
else if (SYNTAX_FLAGS_PREFIX (syntax))
continue;
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Sword:
case Ssymbol:
This includes chars with "quote" or "prefix" syntax (' or p). */)
(void)
{
- EMACS_INT beg = BEGV;
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
- EMACS_INT pos = PT;
- EMACS_INT pos_byte = PT_BYTE;
+ ptrdiff_t beg = BEGV;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
+ ptrdiff_t pos = PT;
+ ptrdiff_t pos_byte = PT_BYTE;
int c;
if (pos <= beg)
static void
scan_sexps_forward (struct lisp_parse_state *stateptr,
- EMACS_INT from, EMACS_INT from_byte, EMACS_INT end,
- int targetdepth, int stopbefore,
+ ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t end,
+ EMACS_INT targetdepth, int stopbefore,
Lisp_Object oldstate, int commentstop)
{
struct lisp_parse_state state;
register enum syntaxcode code;
int c1;
int comnested;
- struct level { int last, prev; };
+ struct level { ptrdiff_t last, prev; };
struct level levelstart[100];
register struct level *curlevel = levelstart;
struct level *endlevel = levelstart + 100;
- register int depth; /* Paren depth of current scanning location.
+ register EMACS_INT depth; /* Paren depth of current scanning location.
level - levelstart equals this except
when the depth becomes negative. */
- int mindepth; /* Lowest DEPTH value seen. */
+ EMACS_INT mindepth; /* Lowest DEPTH value seen. */
int start_quoted = 0; /* Nonzero means starting after a char quote */
Lisp_Object tem;
- EMACS_INT prev_from; /* Keep one character before FROM. */
- EMACS_INT prev_from_byte;
+ ptrdiff_t prev_from; /* Keep one character before FROM. */
+ ptrdiff_t prev_from_byte;
int prev_from_syntax;
int boundary_stop = commentstop == -1;
int nofence;
int found;
- EMACS_INT out_bytepos, out_charpos;
+ ptrdiff_t out_bytepos, out_charpos;
int temp;
prev_from = from;
tem = Fcar (oldstate);
/* Check whether we are inside string_fence-style string: */
state.instring = (!NILP (tem)
- ? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE)
+ ? (CHARACTERP (tem) ? XFASTINT (tem) : ST_STRING_STYLE)
: -1);
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
state.comstyle = (NILP (tem)
? 0
- : (EQ (tem, Qsyntax_table)
- ? ST_COMMENT_STYLE
- : INTEGERP (tem) ? XINT (tem) : 1));
+ : (RANGED_INTEGERP (0, tem, ST_COMMENT_STYLE)
+ ? XINT (tem)
+ : ST_COMMENT_STYLE));
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
- state.comstr_start = NILP (tem) ? -1 : XINT (tem) ;
+ state.comstr_start =
+ RANGED_INTEGERP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XINT (tem) : -1;
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
while (!NILP (tem)) /* >= second enclosing sexps. */
{
- /* curlevel++->last ran into compiler bug on Apollo */
- curlevel->last = XINT (Fcar (tem));
+ Lisp_Object temhd = Fcar (tem);
+ if (RANGED_INTEGERP (PTRDIFF_MIN, temhd, PTRDIFF_MAX))
+ curlevel->last = XINT (temhd);
if (++curlevel == endlevel)
curlevel--; /* error ("Nesting too deep for parser"); */
curlevel->prev = -1;
if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
continue;
- switch (SWITCH_ENUM_CAST (code))
+ switch (code)
{
case Sescape:
case Scharquote:
any character that starts a sexp.
Fifth arg OLDSTATE is a list like what this function returns.
It is used to initialize the state of the parse. Elements number 1, 2, 6
- and 8 are ignored.
+ are ignored.
Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
If it is symbol `syntax-table', stop after the start of a comment or a
string, or after end of a comment or a string. */)
(Lisp_Object from, Lisp_Object to, Lisp_Object targetdepth, Lisp_Object stopbefore, Lisp_Object oldstate, Lisp_Object commentstop)
{
struct lisp_parse_state state;
- int target;
+ EMACS_INT target;
if (!NILP (targetdepth))
{
target = XINT (targetdepth);
}
else
- target = -100000; /* We won't reach this depth */
+ target = TYPE_MINIMUM (EMACS_INT); /* We won't reach this depth */
validate_region (&from, &to);
scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)),
/* Create objects which can be shared among syntax tables. */
Vsyntax_code_object = Fmake_vector (make_number (Smax), Qnil);
for (i = 0; i < ASIZE (Vsyntax_code_object); i++)
- XVECTOR (Vsyntax_code_object)->contents[i]
- = Fcons (make_number (i), Qnil);
+ ASET (Vsyntax_code_object, i, Fcons (make_number (i), Qnil));
/* Now we are ready to set up this property, so we can
create syntax tables. */
Fput (Qsyntax_table, Qchar_table_extra_slots, make_number (0));
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Swhitespace];
+ temp = AREF (Vsyntax_code_object, (int) Swhitespace);
Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp);
/* Control characters should not be whitespace. */
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Spunct];
+ temp = AREF (Vsyntax_code_object, (int) Spunct);
for (i = 0; i <= ' ' - 1; i++)
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 0177, temp);
/* Except that a few really are whitespace. */
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Swhitespace];
+ temp = AREF (Vsyntax_code_object, (int) Swhitespace);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ' ', temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\t', temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\n', temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 015, temp);
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 014, temp);
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
+ temp = AREF (Vsyntax_code_object, (int) Sword);
for (i = 'a'; i <= 'z'; i++)
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
for (i = 'A'; i <= 'Z'; i++)
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\\',
Fcons (make_number ((int) Sescape), Qnil));
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Ssymbol];
+ temp = AREF (Vsyntax_code_object, (int) Ssymbol);
for (i = 0; i < 10; i++)
{
c = "_-+*/&|<>="[i];
SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
}
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Spunct];
+ temp = AREF (Vsyntax_code_object, (int) Spunct);
for (i = 0; i < 12; i++)
{
c = ".,;:?!#@~^'`"[i];
}
/* All multibyte characters have syntax `word' by default. */
- temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
+ temp = AREF (Vsyntax_code_object, (int) Sword);
char_table_set_range (Vstandard_syntax_table, 0x80, MAX_CHAR, temp);
}
DEFSYM (Qscan_error, "scan-error");
Fput (Qscan_error, Qerror_conditions,
- pure_cons (Qscan_error, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qscan_error, Qerror));
Fput (Qscan_error, Qerror_message,
- make_pure_c_string ("Scan error"));
+ build_pure_c_string ("Scan error"));
DEFVAR_BOOL ("parse-sexp-ignore-comments", parse_sexp_ignore_comments,
doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */);
DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start",
open_paren_in_column_0_is_defun_start,
- doc: /* *Non-nil means an open paren in column 0 denotes the start of a defun. */);
+ doc: /* Non-nil means an open paren in column 0 denotes the start of a defun. */);
open_paren_in_column_0_is_defun_start = 1;
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-extern void update_syntax_table (EMACS_INT, EMACS_INT, int, Lisp_Object);
+extern void update_syntax_table (ptrdiff_t, EMACS_INT, int, Lisp_Object);
/* The standard syntax table is stored where it will automatically
be used in all new buffers. */
else if (EQ (gl_state.object, Qt)) \
{ \
gl_state.b_property = 0; \
- gl_state.e_property = MOST_POSITIVE_FIXNUM; \
+ gl_state.e_property = PTRDIFF_MAX; \
gl_state.offset = 0; \
} \
else \
struct gl_state_s
{
Lisp_Object object; /* The object we are scanning. */
- EMACS_INT start; /* Where to stop. */
- EMACS_INT stop; /* Where to stop. */
+ ptrdiff_t start; /* Where to stop. */
+ ptrdiff_t stop; /* Where to stop. */
int use_global; /* Whether to use global_code
or c_s_t. */
Lisp_Object global_code; /* Syntax code of current char. */
Lisp_Object current_syntax_table; /* Syntax table for current pos. */
Lisp_Object old_prop; /* Syntax-table prop at prev pos. */
- EMACS_INT b_property; /* First index where c_s_t is valid. */
- EMACS_INT e_property; /* First index where c_s_t is
+ ptrdiff_t b_property; /* First index where c_s_t is valid. */
+ ptrdiff_t e_property; /* First index where c_s_t is
not valid. */
INTERVAL forward_i; /* Where to start lookup on forward */
INTERVAL backward_i; /* or backward movement. The
intervals too, depending
on: */
/* Offset for positions specified to UPDATE_SYNTAX_TABLE. */
- EMACS_INT offset;
+ ptrdiff_t offset;
};
extern struct gl_state_s gl_state;
-extern EMACS_INT scan_words (EMACS_INT, EMACS_INT);
+extern ptrdiff_t scan_words (ptrdiff_t, EMACS_INT);
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <ctype.h>
-#include <signal.h>
+
+#define SYSTIME_INLINE EXTERN_INLINE
+
+#include <execinfo.h>
#include <stdio.h>
-#include <setjmp.h>
#ifdef HAVE_PWD_H
#include <pwd.h>
#include <grp.h>
#include <unistd.h>
#include <allocator.h>
+#include <c-ctype.h>
#include <careadlinkat.h>
#include <ignore-value.h>
+#include <utimens.h>
#include "lisp.h"
#include "sysselect.h"
#include "blockinput.h"
+#ifdef BSD_SYSTEM
+#include <sys/param.h>
+#include <sys/sysctl.h>
+#endif
+
+#ifdef __FreeBSD__
+#include <sys/user.h>
+#include <sys/resource.h>
+#include <math.h>
+#endif
+
#ifdef WINDOWSNT
#define read sys_read
#define write sys_write
#include <windows.h>
-#ifndef NULL
-#define NULL 0
-#endif
#endif /* not WINDOWSNT */
#include <sys/types.h>
#include <sys/stat.h>
#include <errno.h>
-#ifdef HAVE_SETPGID
-#if !defined (USG)
-#undef setpgrp
-#define setpgrp setpgid
-#endif
-#endif
-
/* Get SI_SRPC_DOMAIN, if it is available. */
#ifdef HAVE_SYS_SYSTEMINFO_H
#include <sys/systeminfo.h>
#endif
#ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */
-#include <dos.h>
-#include "dosfns.h"
#include "msdos.h"
#include <sys/param.h>
#endif
#include "syssignal.h"
#include "systime.h"
-#ifdef HAVE_UTIME_H
-#include <utime.h>
-#endif
-
-#ifndef HAVE_UTIMES
-#ifndef HAVE_STRUCT_UTIMBUF
-/* We want to use utime rather than utimes, but we couldn't find the
- structure declaration. We'll use the traditional one. */
-struct utimbuf {
- long actime;
- long modtime;
-};
-#endif
-#endif
static int emacs_get_tty (int, struct emacs_tty *);
static int emacs_set_tty (int, struct emacs_tty *, int);
-#if defined TIOCNOTTY || defined USG5 || defined CYGWIN
-static void croak (char *) NO_RETURN;
+
+/* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */
+#ifndef ULLONG_MAX
+#define ULLONG_MAX TYPE_MAXIMUM (unsigned long long int)
#endif
/* Declare here, including term.h is problematic on some systems. */
#endif
)
{
- buf = (char *) malloc (strlen (pwd) + 1);
+ buf = malloc (strlen (pwd) + 1);
if (!buf)
return NULL;
strcpy (buf, pwd);
else
{
size_t buf_size = 1024;
- buf = (char *) malloc (buf_size);
+ buf = malloc (buf_size);
if (!buf)
return NULL;
for (;;)
return NULL;
}
buf_size *= 2;
- buf = (char *) realloc (buf, buf_size);
+ buf = realloc (buf, buf_size);
if (!buf)
return NULL;
}
else
{
/* We need MAXPATHLEN here. */
- buf = (char *) malloc (MAXPATHLEN + 1);
+ buf = malloc (MAXPATHLEN + 1);
if (!buf)
return NULL;
if (getwd (buf) == NULL)
\f
-/* Set nonzero to make following function work under dbx
- (at least for bsd). */
-int wait_debugging EXTERNALLY_VISIBLE;
-
#ifndef MSDOS
static void
-wait_for_termination_1 (int pid, int interruptible)
+wait_for_termination_1 (pid_t pid, int interruptible)
{
while (1)
{
-#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. */
- /* 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
- if that causes the problem to go away or get worse. */
- sigsetmask (sigmask (SIGCHLD));
- if (0 > kill (pid, 0))
- {
- sigsetmask (SIGEMPTYMASK);
- kill (getpid (), SIGCHLD);
- break;
- }
- if (wait_debugging)
- sleep (1);
- else
- sigpause (SIGEMPTYMASK);
-#else /* not BSD_SYSTEM, and not HPUX version >= 6 */
#ifdef WINDOWSNT
wait (0);
break;
#else /* not WINDOWSNT */
- sigblock (sigmask (SIGCHLD));
- errno = 0;
- if (kill (pid, 0) == -1 && errno == ESRCH)
+ int status;
+ int wait_result = waitpid (pid, &status, 0);
+ if (wait_result < 0)
+ {
+ if (errno != EINTR)
+ break;
+ }
+ else
{
- sigunblock (sigmask (SIGCHLD));
+ record_child_status_change (wait_result, status);
break;
}
- sigsuspend (&empty_mask);
#endif /* not WINDOWSNT */
-#endif /* not BSD_SYSTEM, and not HPUX version >= 6 */
if (interruptible)
QUIT;
}
make sure it will get eliminated (not remain forever as a zombie) */
void
-wait_for_termination (int pid)
+wait_for_termination (pid_t pid)
{
wait_for_termination_1 (pid, 0);
}
/* Like the above, but allow keyboard interruption. */
void
-interruptible_wait_for_termination (int pid)
+interruptible_wait_for_termination (pid_t pid)
{
wait_for_termination_1 (pid, 1);
}
#endif /* not MSDOS */
\f
-/* Record a signal code and the handler for it. */
+/* Record a signal code and the action for it. */
struct save_signal
{
int code;
- void (*handler) (int);
+ struct sigaction action;
};
static void save_signal_handlers (struct save_signal *);
saved_handlers[0].code = SIGINT;
saved_handlers[1].code = SIGQUIT;
saved_handlers[2].code = SIGTERM;
-#ifdef SIGIO
+#ifdef USABLE_SIGIO
saved_handlers[3].code = SIGIO;
saved_handlers[4].code = 0;
#else
goto xyzzy;
dir = expand_and_dir_to_file (Funhandled_file_name_directory (dir), Qnil);
- str_volatile = str = (unsigned char *) alloca (SCHARS (dir) + 2);
+ str_volatile = str = alloca (SCHARS (dir) + 2);
len = SCHARS (dir);
memcpy (str, SDATA (dir), len);
if (str[len - 1] != '/') str[len++] = '/';
{
while (saved_handlers->code)
{
- saved_handlers->handler
- = (void (*) (int)) signal (saved_handlers->code, SIG_IGN);
+ struct sigaction action;
+ emacs_sigaction_init (&action, SIG_IGN);
+ sigaction (saved_handlers->code, &action, &saved_handlers->action);
saved_handlers++;
}
}
{
while (saved_handlers->code)
{
- signal (saved_handlers->code, saved_handlers->handler);
+ sigaction (saved_handlers->code, &saved_handlers->action, 0);
saved_handlers++;
}
}
\f
-#ifndef SIGIO
-/* If SIGIO is broken, don't do anything. */
-void
-init_sigio (int fd)
-{
-}
-
-static void
-reset_sigio (int fd)
-{
-}
-
-void
-request_sigio (void)
-{
-}
-
-void
-unrequest_sigio (void)
-{
-}
-
-#else
-#ifdef F_SETFL
-
+#ifdef USABLE_SIGIO
static int old_fcntl_flags[MAXDESC];
+#endif
void
init_sigio (int fd)
{
-#ifdef FASYNC
+#ifdef USABLE_SIGIO
old_fcntl_flags[fd] = fcntl (fd, F_GETFL, 0) & ~FASYNC;
fcntl (fd, F_SETFL, old_fcntl_flags[fd] | FASYNC);
-#endif
interrupts_deferred = 0;
+#endif
}
static void
reset_sigio (int fd)
{
-#ifdef FASYNC
+#ifdef USABLE_SIGIO
fcntl (fd, F_SETFL, old_fcntl_flags[fd]);
#endif
}
-#ifdef FASYNC /* F_SETFL does not imply existence of FASYNC */
-/* XXX Uhm, FASYNC is not used anymore here. */
-/* XXX Yeah, but you need it for SIGIO, don't you? */
-
void
request_sigio (void)
{
+#ifdef USABLE_SIGIO
+ sigset_t unblocked;
+
if (noninteractive)
return;
-#ifdef SIGWINCH
- sigunblock (sigmask (SIGWINCH));
-#endif
- sigunblock (sigmask (SIGIO));
+ sigemptyset (&unblocked);
+# ifdef SIGWINCH
+ sigaddset (&unblocked, SIGWINCH);
+# endif
+ sigaddset (&unblocked, SIGIO);
+ pthread_sigmask (SIG_UNBLOCK, &unblocked, 0);
interrupts_deferred = 0;
+#endif
}
void
unrequest_sigio (void)
{
- if (noninteractive)
- return;
+#ifdef USABLE_SIGIO
+ sigset_t blocked;
-#if 0 /* XXX What's wrong with blocking SIGIO under X? */
- if (x_display_list)
+ if (noninteractive)
return;
-#endif
-#ifdef SIGWINCH
- sigblock (sigmask (SIGWINCH));
-#endif
- sigblock (sigmask (SIGIO));
+ sigemptyset (&blocked);
+# ifdef SIGWINCH
+ sigaddset (&blocked, SIGWINCH);
+# endif
+ sigaddset (&blocked, SIGIO);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
interrupts_deferred = 1;
-}
-
-#else /* no FASYNC */
-#ifndef MSDOS
-
-void
-request_sigio (void)
-{
- if (noninteractive || read_socket_hook)
- return;
-
- croak ("request_sigio");
+#endif
}
void
-unrequest_sigio (void)
+ignore_sigio (void)
{
- if (noninteractive || read_socket_hook)
- return;
-
- croak ("unrequest_sigio");
+#ifdef USABLE_SIGIO
+ signal (SIGIO, SIG_IGN);
+#endif
}
-#endif /* MSDOS */
-#endif /* FASYNC */
-#endif /* F_SETFL */
-#endif /* SIGIO */
-
\f
/* Getting and setting emacs_tty structures. */
return; /* The tty is suspended. */
if (! tty_out->old_tty)
- tty_out->old_tty = (struct emacs_tty *) xmalloc (sizeof (struct emacs_tty));
+ tty_out->old_tty = xmalloc (sizeof *tty_out->old_tty);
emacs_get_tty (fileno (tty_out->input), tty_out->old_tty);
Vsystem_name = build_string (uts.nodename);
#else /* HAVE_GETHOSTNAME */
unsigned int hostname_size = 256;
- char *hostname = (char *) alloca (hostname_size);
+ char *hostname = alloca (hostname_size);
/* Try to get the host name; if the buffer is too short, try
again. Apparently, the only indication gethostname gives of
break;
hostname_size <<= 1;
- hostname = (char *) alloca (hostname_size);
+ hostname = alloca (hostname_size);
}
#ifdef HAVE_SOCKETS
/* Turn the hostname into the official, fully-qualified hostname.
}
}
\f
-/* POSIX signals support - DJB */
-/* Anyone with POSIX signals should have ANSI C declarations */
-
sigset_t empty_mask;
-#ifndef WINDOWSNT
+static struct sigaction process_fatal_action;
-signal_handler_t
-sys_signal (int signal_number, signal_handler_t action)
-{
- struct sigaction new_action, old_action;
- sigemptyset (&new_action.sa_mask);
- new_action.sa_handler = action;
- new_action.sa_flags = 0;
-#if defined (SA_RESTART)
- /* Emacs mostly works better with restartable system services. If this
- flag exists, we probably want to turn it on here.
- However, on some systems this resets the timeout of `select'
- which means that `select' never finishes if it keeps getting signals.
- BROKEN_SA_RESTART is defined on those systems. */
- /* It's not clear why the comment above says "mostly works better". --Stef
- When SYNC_INPUT is set, we don't want SA_RESTART because we need to poll
+static int
+emacs_sigaction_flags (void)
+{
+#ifdef SA_RESTART
+ /* SA_RESTART causes interruptible functions with timeouts (e.g.,
+ 'select') to reset their timeout on some platforms (e.g.,
+ HP-UX 11), which is not what we want. Also, when Emacs is
+ interactive, we don't want SA_RESTART because we need to poll
for pending input so we need long-running syscalls to be interrupted
- after a signal that sets the interrupt_input_pending flag. */
- /* Non-interactive keyboard input goes through stdio, where we always
- want restartable system calls. */
-# if defined (BROKEN_SA_RESTART) || defined (SYNC_INPUT)
+ after a signal that sets pending_signals.
+
+ Non-interactive keyboard input goes through stdio, where we
+ always want restartable system calls. */
if (noninteractive)
-# endif
- new_action.sa_flags = SA_RESTART;
+ return SA_RESTART;
#endif
- sigaction (signal_number, &new_action, &old_action);
- return (old_action.sa_handler);
+ return 0;
}
-#endif /* WINDOWSNT */
-
-#ifndef __GNUC__
-/* If we're compiling with GCC, we don't need this function, since it
- can be written as a macro. */
-sigset_t
-sys_sigmask (int sig)
+/* Store into *ACTION a signal action suitable for Emacs, with handler
+ HANDLER. */
+void
+emacs_sigaction_init (struct sigaction *action, signal_handler_t handler)
{
- sigset_t mask;
- sigemptyset (&mask);
- sigaddset (&mask, sig);
- return mask;
-}
+ sigemptyset (&action->sa_mask);
+
+ /* When handling a signal, block nonfatal system signals that are caught
+ by Emacs. This makes race conditions less likely. */
+ sigaddset (&action->sa_mask, SIGALRM);
+#ifdef SIGCHLD
+ sigaddset (&action->sa_mask, SIGCHLD);
+#endif
+#ifdef SIGDANGER
+ sigaddset (&action->sa_mask, SIGDANGER);
+#endif
+#ifdef SIGWINCH
+ sigaddset (&action->sa_mask, SIGWINCH);
#endif
+ if (! noninteractive)
+ {
+ sigaddset (&action->sa_mask, SIGINT);
+ sigaddset (&action->sa_mask, SIGQUIT);
+#ifdef USABLE_SIGIO
+ sigaddset (&action->sa_mask, SIGIO);
+#endif
+ }
-/* I'd like to have these guys return pointers to the mask storage in here,
- but there'd be trouble if the code was saving multiple masks. I'll be
- safe and pass the structure. It normally won't be more than 2 bytes
- anyhow. - DJB */
+ if (! IEEE_FLOATING_POINT)
+ sigaddset (&action->sa_mask, SIGFPE);
-sigset_t
-sys_sigblock (sigset_t new_mask)
-{
- sigset_t old_mask;
- pthread_sigmask (SIG_BLOCK, &new_mask, &old_mask);
- return (old_mask);
+ action->sa_handler = handler;
+ action->sa_flags = emacs_sigaction_flags ();
}
-sigset_t
-sys_sigunblock (sigset_t new_mask)
+#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
+static pthread_t main_thread;
+#endif
+
+/* SIG has arrived at the current process. Deliver it to the main
+ thread, which should handle it with HANDLER.
+
+ If we are on the main thread, handle the signal SIG with HANDLER.
+ Otherwise, redirect the signal to the main thread, blocking it from
+ this thread. POSIX says any thread can receive a signal that is
+ associated with a process, process group, or asynchronous event.
+ On GNU/Linux that is not true, but for other systems (FreeBSD at
+ least) it is. */
+void
+deliver_process_signal (int sig, signal_handler_t handler)
{
- sigset_t old_mask;
- pthread_sigmask (SIG_UNBLOCK, &new_mask, &old_mask);
- return (old_mask);
+ /* Preserve errno, to avoid race conditions with signal handlers that
+ might change errno. Races can occur even in single-threaded hosts. */
+ int old_errno = errno;
+
+ bool on_main_thread = true;
+#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
+ if (! pthread_equal (pthread_self (), main_thread))
+ {
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, sig);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
+ pthread_kill (main_thread, sig);
+ on_main_thread = false;
+ }
+#endif
+ if (on_main_thread)
+ handler (sig);
+
+ errno = old_errno;
}
-sigset_t
-sys_sigsetmask (sigset_t new_mask)
+/* Static location to save a fatal backtrace in a thread.
+ FIXME: If two subsidiary threads fail simultaneously, the resulting
+ backtrace may be garbage. */
+enum { BACKTRACE_LIMIT_MAX = 500 };
+static void *thread_backtrace_buffer[BACKTRACE_LIMIT_MAX + 1];
+static int thread_backtrace_npointers;
+
+/* SIG has arrived at the current thread.
+ If we are on the main thread, handle the signal SIG with HANDLER.
+ Otherwise, this is a fatal error in the handling thread. */
+static void
+deliver_thread_signal (int sig, signal_handler_t handler)
{
- sigset_t old_mask;
- pthread_sigmask (SIG_SETMASK, &new_mask, &old_mask);
- return (old_mask);
-}
+ int old_errno = errno;
+
+#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
+ if (! pthread_equal (pthread_self (), main_thread))
+ {
+ thread_backtrace_npointers
+ = backtrace (thread_backtrace_buffer, BACKTRACE_LIMIT_MAX);
+ sigaction (sig, &process_fatal_action, 0);
+ pthread_kill (main_thread, sig);
+
+ /* Avoid further damage while the main thread is exiting. */
+ while (1)
+ sigsuspend (&empty_mask);
+ }
+#endif
+ handler (sig);
+ errno = old_errno;
+}
\f
#if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST
static char *my_sys_siglist[NSIG];
# define sys_siglist my_sys_siglist
#endif
+/* Handle bus errors, invalid instruction, etc. */
+static void
+handle_fatal_signal (int sig)
+{
+ terminate_due_to_signal (sig, 10);
+}
+
+static void
+deliver_fatal_signal (int sig)
+{
+ deliver_process_signal (sig, handle_fatal_signal);
+}
+
+static void
+deliver_fatal_thread_signal (int sig)
+{
+ deliver_thread_signal (sig, handle_fatal_signal);
+}
+
+static _Noreturn void
+handle_arith_signal (int sig)
+{
+ pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
+ xsignal0 (Qarith_error);
+}
+
+static void
+deliver_arith_signal (int sig)
+{
+ deliver_thread_signal (sig, handle_arith_signal);
+}
+
+/* Treat SIG as a terminating signal, unless it is already ignored and
+ we are in --batch mode. Among other things, this makes nohup work. */
+static void
+maybe_fatal_sig (int sig)
+{
+ bool catch_sig = !noninteractive;
+ if (!catch_sig)
+ {
+ struct sigaction old_action;
+ sigaction (sig, 0, &old_action);
+ catch_sig = old_action.sa_handler != SIG_IGN;
+ }
+ if (catch_sig)
+ sigaction (sig, &process_fatal_action, 0);
+}
+
void
-init_signals (void)
+init_signals (bool dumping)
{
+ struct sigaction thread_fatal_action;
+ struct sigaction action;
+
sigemptyset (&empty_mask);
+#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
+ main_thread = pthread_self ();
+#endif
+
#if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST
if (! initialized)
{
-# ifdef SIGABRT
sys_siglist[SIGABRT] = "Aborted";
-# endif
# ifdef SIGAIO
sys_siglist[SIGAIO] = "LAN I/O interrupt";
# endif
# ifdef SIGEMT
sys_siglist[SIGEMT] = "Emulation trap";
# endif
-# ifdef SIGFPE
sys_siglist[SIGFPE] = "Arithmetic exception";
-# endif
# ifdef SIGFREEZE
sys_siglist[SIGFREEZE] = "SIGFREEZE";
# endif
# ifdef SIGHUP
sys_siglist[SIGHUP] = "Hangup";
# endif
-# ifdef SIGILL
sys_siglist[SIGILL] = "Illegal instruction";
-# endif
-# ifdef SIGINT
sys_siglist[SIGINT] = "Interrupt";
-# endif
# ifdef SIGIO
sys_siglist[SIGIO] = "I/O possible";
# endif
# ifdef SIGSAK
sys_siglist[SIGSAK] = "Secure attention";
# endif
-# ifdef SIGSEGV
sys_siglist[SIGSEGV] = "Segmentation violation";
-# endif
# ifdef SIGSOUND
sys_siglist[SIGSOUND] = "Sound completed";
# endif
# ifdef SIGSYS
sys_siglist[SIGSYS] = "Bad argument to system call";
# endif
-# ifdef SIGTERM
sys_siglist[SIGTERM] = "Terminated";
-# endif
# ifdef SIGTHAW
sys_siglist[SIGTHAW] = "SIGTHAW";
# endif
# endif
}
#endif /* !defined HAVE_STRSIGNAL && !defined HAVE_DECL_SYS_SIGLIST */
+
+ /* Don't alter signal handlers if dumping. On some machines,
+ changing signal handlers sets static data that would make signals
+ fail to work right when the dumped Emacs is run. */
+ if (dumping)
+ return;
+
+ sigfillset (&process_fatal_action.sa_mask);
+ process_fatal_action.sa_handler = deliver_fatal_signal;
+ process_fatal_action.sa_flags = emacs_sigaction_flags ();
+
+ sigfillset (&thread_fatal_action.sa_mask);
+ thread_fatal_action.sa_handler = deliver_fatal_thread_signal;
+ thread_fatal_action.sa_flags = process_fatal_action.sa_flags;
+
+ /* SIGINT may need special treatment on MS-Windows. See
+ http://lists.gnu.org/archive/html/emacs-devel/2010-09/msg01062.html
+ Please update the doc of kill-emacs, kill-emacs-hook, and
+ NEWS if you change this. */
+
+ maybe_fatal_sig (SIGHUP);
+ maybe_fatal_sig (SIGINT);
+ maybe_fatal_sig (SIGTERM);
+
+ /* Emacs checks for write errors, so it can safely ignore SIGPIPE.
+ However, in batch mode leave SIGPIPE alone, as that causes Emacs
+ to behave more like typical batch applications do. */
+ if (! noninteractive)
+ signal (SIGPIPE, SIG_IGN);
+
+ sigaction (SIGQUIT, &process_fatal_action, 0);
+ sigaction (SIGILL, &thread_fatal_action, 0);
+ sigaction (SIGTRAP, &thread_fatal_action, 0);
+
+ /* Typically SIGFPE is thread-specific and is fatal, like SIGILL.
+ But on a non-IEEE host SIGFPE can come from a trap in the Lisp
+ interpreter's floating point operations, so treat SIGFPE as an
+ arith-error if it arises in the main thread. */
+ if (IEEE_FLOATING_POINT)
+ sigaction (SIGFPE, &thread_fatal_action, 0);
+ else
+ {
+ emacs_sigaction_init (&action, deliver_arith_signal);
+ sigaction (SIGFPE, &action, 0);
+ }
+
+#ifdef SIGUSR1
+ add_user_signal (SIGUSR1, "sigusr1");
+#endif
+#ifdef SIGUSR2
+ add_user_signal (SIGUSR2, "sigusr2");
+#endif
+ sigaction (SIGABRT, &thread_fatal_action, 0);
+#ifdef SIGPRE
+ sigaction (SIGPRE, &thread_fatal_action, 0);
+#endif
+#ifdef SIGORE
+ sigaction (SIGORE, &thread_fatal_action, 0);
+#endif
+#ifdef SIGUME
+ sigaction (SIGUME, &thread_fatal_action, 0);
+#endif
+#ifdef SIGDLK
+ sigaction (SIGDLK, &process_fatal_action, 0);
+#endif
+#ifdef SIGCPULIM
+ sigaction (SIGCPULIM, &process_fatal_action, 0);
+#endif
+#ifdef SIGIOT
+ sigaction (SIGIOT, &thread_fatal_action, 0);
+#endif
+#ifdef SIGEMT
+ sigaction (SIGEMT, &thread_fatal_action, 0);
+#endif
+#ifdef SIGBUS
+ sigaction (SIGBUS, &thread_fatal_action, 0);
+#endif
+ sigaction (SIGSEGV, &thread_fatal_action, 0);
+#ifdef SIGSYS
+ sigaction (SIGSYS, &thread_fatal_action, 0);
+#endif
+ sigaction (SIGTERM, &process_fatal_action, 0);
+#ifdef SIGPROF
+ sigaction (SIGPROF, &process_fatal_action, 0);
+#endif
+#ifdef SIGVTALRM
+ sigaction (SIGVTALRM, &process_fatal_action, 0);
+#endif
+#ifdef SIGXCPU
+ sigaction (SIGXCPU, &process_fatal_action, 0);
+#endif
+#ifdef SIGXFSZ
+ sigaction (SIGXFSZ, &process_fatal_action, 0);
+#endif
+
+#ifdef SIGDANGER
+ /* This just means available memory is getting low. */
+ emacs_sigaction_init (&action, deliver_danger_signal);
+ sigaction (SIGDANGER, &action, 0);
+#endif
+
+ /* AIX-specific signals. */
+#ifdef SIGGRANT
+ sigaction (SIGGRANT, &process_fatal_action, 0);
+#endif
+#ifdef SIGMIGRATE
+ sigaction (SIGMIGRATE, &process_fatal_action, 0);
+#endif
+#ifdef SIGMSG
+ sigaction (SIGMSG, &process_fatal_action, 0);
+#endif
+#ifdef SIGRETRACT
+ sigaction (SIGRETRACT, &process_fatal_action, 0);
+#endif
+#ifdef SIGSAK
+ sigaction (SIGSAK, &process_fatal_action, 0);
+#endif
+#ifdef SIGSOUND
+ sigaction (SIGSOUND, &process_fatal_action, 0);
+#endif
+#ifdef SIGTALRM
+ sigaction (SIGTALRM, &thread_fatal_action, 0);
+#endif
}
\f
#ifndef HAVE_RANDOM
#endif /* !RAND_BITS */
void
-seed_random (long int arg)
+seed_random (void *seed, ptrdiff_t seed_size)
{
+#if defined HAVE_RANDOM || ! defined HAVE_LRAND48
+ unsigned int arg = 0;
+#else
+ long int arg = 0;
+#endif
+ unsigned char *argp = (unsigned char *) &arg;
+ unsigned char *seedp = seed;
+ ptrdiff_t i;
+ for (i = 0; i < seed_size; i++)
+ argp[i % sizeof arg] ^= seedp[i];
#ifdef HAVE_RANDOM
- srandom ((unsigned int)arg);
+ srandom (arg);
#else
# ifdef HAVE_LRAND48
srand48 (arg);
# else
- srand ((unsigned int)arg);
+ srand (arg);
# endif
#endif
}
+void
+init_random (void)
+{
+ EMACS_TIME t = current_emacs_time ();
+ uintmax_t v = getpid () ^ EMACS_SECS (t) ^ EMACS_NSECS (t);
+ seed_random (&v, sizeof v);
+}
+
/*
* Return a nonnegative random integer out of whatever we've got.
* It contains enough bits to make a random (signed) Emacs fixnum.
return val & INTMASK;
}
-#ifndef HAVE_STRERROR
-#ifndef WINDOWSNT
-char *
-strerror (int errnum)
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-#endif /* not WINDOWSNT */
-#endif /* ! HAVE_STRERROR */
-
#ifndef HAVE_SNPRINTF
/* Approximate snprintf as best we can on ancient hosts that lack it. */
int
}
#endif
\f
+/* If a backtrace is available, output the top lines of it to stderr.
+ Do not output more than BACKTRACE_LIMIT or BACKTRACE_LIMIT_MAX lines.
+ This function may be called from a signal handler, so it should
+ not invoke async-unsafe functions like malloc. */
+void
+emacs_backtrace (int backtrace_limit)
+{
+ void *main_backtrace_buffer[BACKTRACE_LIMIT_MAX + 1];
+ int bounded_limit = min (backtrace_limit, BACKTRACE_LIMIT_MAX);
+ void *buffer;
+ int npointers;
+
+ if (thread_backtrace_npointers)
+ {
+ buffer = thread_backtrace_buffer;
+ npointers = thread_backtrace_npointers;
+ }
+ else
+ {
+ buffer = main_backtrace_buffer;
+ npointers = backtrace (buffer, bounded_limit + 1);
+ }
+
+ if (npointers)
+ {
+ ignore_value (write (STDERR_FILENO, "\nBacktrace:\n", 12));
+ backtrace_symbols_fd (buffer, npointers, STDERR_FILENO);
+ if (bounded_limit < npointers)
+ ignore_value (write (STDERR_FILENO, "...\n", 4));
+ }
+}
+\f
+#ifndef HAVE_NTGUI
+void
+emacs_abort (void)
+{
+ terminate_due_to_signal (SIGABRT, 10);
+}
+#endif
+
int
emacs_open (const char *path, int oflag, int mode)
{
/* Read from FILEDESC to a buffer BUF with size NBYTE, retrying if interrupted.
Return the number of bytes read, which might be less than NBYTE.
On error, set errno and return -1. */
-EMACS_INT
-emacs_read (int fildes, char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_read (int fildes, char *buf, ptrdiff_t nbyte)
{
register ssize_t rtnval;
/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted
or if a partial write occurs. Return the number of bytes written, setting
errno if this is less than NBYTE. */
-EMACS_INT
-emacs_write (int fildes, const char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_write (int fildes, const char *buf, ptrdiff_t nbyte)
{
ssize_t rtnval;
- EMACS_INT bytes_written;
+ ptrdiff_t bytes_written;
bytes_written = 0;
{
if (errno == EINTR)
{
-#ifdef SYNC_INPUT
/* I originally used `QUIT' but that might causes files to
be truncated if you hit C-g in the middle of it. --Stef */
- process_pending_signals ();
-#endif
+ if (pending_signals)
+ process_pending_signals ();
continue;
}
else
* under error conditions.
*/
-#ifndef HAVE_GETWD
+#if !defined (HAVE_GETWD) || defined (BROKEN_GETWD)
#ifndef MAXPATHLEN
/* In 4.1, param.h fails to define this. */
char *npath, *spath;
extern char *getcwd (char *, size_t);
- BLOCK_INPUT; /* getcwd uses malloc */
+ block_input (); /* getcwd uses malloc */
spath = npath = getcwd ((char *) 0, MAXPATHLEN);
if (spath == 0)
{
- UNBLOCK_INPUT;
+ unblock_input ();
return spath;
}
/* On Altos 3068, getcwd can return @hostname/dir, so discard
npath++;
strcpy (pathname, npath);
free (spath); /* getcwd uses malloc */
- UNBLOCK_INPUT;
+ unblock_input ();
return pathname;
}
-#endif /* HAVE_GETWD */
-
-/*
- * Emulate rename using unlink/link. Note that this is
- * only partially correct. Also, doesn't enforce restriction
- * that files be of same type (regular->regular, dir->dir, etc).
- */
-
-#ifndef HAVE_RENAME
-
-int
-rename (const char *from, const char *to)
-{
- if (access (from, 0) == 0)
- {
- unlink (to);
- if (link (from, to) == 0)
- if (unlink (from) == 0)
- return (0);
- }
- return (-1);
-}
-
-#endif
-
-
-#if defined (HPUX) && !defined (HAVE_PERROR)
-
-/* HPUX curses library references perror, but as far as we know
- it won't be called. Anyway this definition will do for now. */
-
-void
-perror (void)
-{
-}
-#endif /* HPUX and not HAVE_PERROR */
-
-/*
- * Gettimeofday. Simulate as much as possible. Only accurate
- * to nearest second. Emacs doesn't use tzp so ignore it for now.
- * Only needed when subprocesses are defined.
- */
-
-#ifndef HAVE_GETTIMEOFDAY
-#ifdef HAVE_TIMEVAL
-
-int
-gettimeofday (struct timeval *tp, struct timezone *tzp)
-{
- extern long time (long);
-
- tp->tv_sec = time ((long *)0);
- tp->tv_usec = 0;
- if (tzp != 0)
- tzp->tz_minuteswest = -1;
- return 0;
-}
-
-#endif
-#endif /* !HAVE_GETTIMEOFDAY && HAVE_TIMEVAL */
-
-/*
- * This function will go away as soon as all the stubs fixed. (fnf)
- */
-
-void
-croak (char *badfunc)
-{
- printf ("%s not yet implemented\r\n", badfunc);
- reset_all_sys_modes ();
- exit (1);
-}
-
+#endif /* !defined (HAVE_GETWD) || defined (BROKEN_GETWD) */
#endif /* USG */
\f
/* Directory routines for systems that don't have them. */
int rtnval;
rtnval = emacs_close (dirp->dd_fd);
- xfree ((char *) dirp);
+ xfree (dirp);
return rtnval;
}
#endif /* HAVE_DIRENT_H */
\f
-int
-set_file_times (const char *filename, EMACS_TIME atime, EMACS_TIME mtime)
-{
-#ifdef HAVE_UTIMES
- struct timeval tv[2];
- tv[0] = atime;
- tv[1] = mtime;
- return utimes (filename, tv);
-#else /* not HAVE_UTIMES */
- struct utimbuf utb;
- utb.actime = EMACS_SECS (atime);
- utb.modtime = EMACS_SECS (mtime);
- return utime (filename, &utb);
-#endif /* not HAVE_UTIMES */
-}
-\f
-/* mkdir and rmdir functions, for systems which don't have them. */
-
-#ifndef HAVE_MKDIR
-/*
- * Written by Robert Rother, Mariah Corporation, August 1985.
- *
- * If you want it, it's yours. All I ask in return is that if you
- * figure out how to do this in a Bourne Shell script you send me
- * a copy.
- * sdcsvax!rmr or rmr@uscd
- *
- * Severely hacked over by John Gilmore to make a 4.2BSD compatible
- * subroutine. 11Mar86; hoptoad!gnu
- *
- * Modified by rmtodd@uokmax 6-28-87 -- when making an already existing dir,
- * subroutine didn't return EEXIST. It does now.
- */
-
-/*
- * Make a directory.
- */
-int
-mkdir (char *dpath, int dmode)
+/* Return a struct timeval that is roughly equivalent to T.
+ Use the least timeval not less than T.
+ Return an extremal value if the result would overflow. */
+struct timeval
+make_timeval (EMACS_TIME t)
{
- int cpid, status, fd;
- struct stat statbuf;
-
- if (stat (dpath, &statbuf) == 0)
- {
- errno = EEXIST; /* Stat worked, so it already exists */
- return -1;
- }
-
- /* If stat fails for a reason other than non-existence, return error */
- if (errno != ENOENT)
- return -1;
+ struct timeval tv;
+ tv.tv_sec = t.tv_sec;
+ tv.tv_usec = t.tv_nsec / 1000;
- synch_process_alive = 1;
- switch (cpid = fork ())
+ if (t.tv_nsec % 1000 != 0)
{
-
- case -1: /* Error in fork */
- return (-1); /* Errno is set already */
-
- case 0: /* Child process */
- /*
- * Cheap hack to set mode of new directory. Since this
- * child process is going away anyway, we zap its umask.
- * FIXME, this won't suffice to set SUID, SGID, etc. on this
- * directory. Does anybody care?
- */
- status = umask (0); /* Get current umask */
- status = umask (status | (0777 & ~dmode)); /* Set for mkdir */
- fd = emacs_open ("/dev/null", O_RDWR, 0);
- if (fd >= 0)
- {
- dup2 (fd, 0);
- dup2 (fd, 1);
- dup2 (fd, 2);
- }
- execl ("/bin/mkdir", "mkdir", dpath, (char *) 0);
- _exit (-1); /* Can't exec /bin/mkdir */
-
- default: /* Parent process */
- wait_for_termination (cpid);
- }
-
- if (synch_process_death != 0 || synch_process_retcode != 0
- || synch_process_termsig != 0)
- {
- errno = EIO; /* We don't know why, but */
- return -1; /* /bin/mkdir failed */
+ if (tv.tv_usec < 999999)
+ tv.tv_usec++;
+ else if (tv.tv_sec < TYPE_MAXIMUM (time_t))
+ {
+ tv.tv_sec++;
+ tv.tv_usec = 0;
+ }
}
- return 0;
+ return tv;
}
-#endif /* not HAVE_MKDIR */
-#ifndef HAVE_RMDIR
+/* Set the access and modification time stamps of FD (a.k.a. FILE) to be
+ ATIME and MTIME, respectively.
+ FD must be either negative -- in which case it is ignored --
+ or a file descriptor that is open on FILE.
+ If FD is nonnegative, then FILE can be NULL. */
int
-rmdir (char *dpath)
+set_file_times (int fd, const char *filename,
+ EMACS_TIME atime, EMACS_TIME mtime)
{
- int cpid, status, fd;
- struct stat statbuf;
-
- if (stat (dpath, &statbuf) != 0)
- {
- /* Stat just set errno. We don't have to */
- return -1;
- }
-
- synch_process_alive = 1;
- switch (cpid = fork ())
- {
-
- case -1: /* Error in fork */
- return (-1); /* Errno is set already */
-
- case 0: /* Child process */
- fd = emacs_open ("/dev/null", O_RDWR, 0);
- if (fd >= 0)
- {
- dup2 (fd, 0);
- dup2 (fd, 1);
- dup2 (fd, 2);
- }
- execl ("/bin/rmdir", "rmdir", dpath, (char *) 0);
- _exit (-1); /* Can't exec /bin/rmdir */
-
- default: /* Parent process */
- wait_for_termination (cpid);
- }
-
- if (synch_process_death != 0 || synch_process_retcode != 0
- || synch_process_termsig != 0)
- {
- errno = EIO; /* We don't know why, but */
- return -1; /* /bin/rmdir failed */
- }
-
- return 0;
+ struct timespec timespec[2];
+ timespec[0] = atime;
+ timespec[1] = mtime;
+ return fdutimens (fd, filename, timespec);
}
-#endif /* !HAVE_RMDIR */
-
\f
#ifndef HAVE_STRSIGNAL
char *
error ("tcsetattr() failed: %s", emacs_strerror (errno));
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
- p->childp = childp2;
-
+ pset_childp (p, childp2);
}
#endif /* not DOS_NT */
\f
return proclist;
}
+#elif defined BSD_SYSTEM
+
+Lisp_Object
+list_system_processes (void)
+{
+#if defined DARWIN_OS || defined __NetBSD__ || defined __OpenBSD__
+ int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL};
+#else
+ int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_PROC};
+#endif
+ size_t len;
+ struct kinfo_proc *procs;
+ size_t i;
+
+ struct gcpro gcpro1;
+ Lisp_Object proclist = Qnil;
+
+ if (sysctl (mib, 3, NULL, &len, NULL, 0) != 0)
+ return proclist;
+
+ procs = xmalloc (len);
+ if (sysctl (mib, 3, procs, &len, NULL, 0) != 0)
+ {
+ xfree (procs);
+ return proclist;
+ }
+
+ GCPRO1 (proclist);
+ len /= sizeof (struct kinfo_proc);
+ for (i = 0; i < len; i++)
+ {
+#if defined DARWIN_OS || defined __NetBSD__
+ proclist = Fcons (make_fixnum_or_float (procs[i].kp_proc.p_pid), proclist);
+#elif defined __OpenBSD__
+ proclist = Fcons (make_fixnum_or_float (procs[i].p_pid), proclist);
+#else
+ proclist = Fcons (make_fixnum_or_float (procs[i].ki_pid), proclist);
+#endif
+ }
+ UNGCPRO;
+
+ xfree (procs);
+
+ return proclist;
+}
+
/* The WINDOWSNT implementation is in w32.c.
The MSDOS implementation is in dosfns.c. */
#elif !defined (WINDOWSNT) && !defined (MSDOS)
#endif /* !defined (WINDOWSNT) */
#ifdef GNU_LINUX
-static void
-time_from_jiffies (unsigned long long tval, long hz,
- time_t *sec, unsigned *usec)
-{
- unsigned long long ullsec;
-
- *sec = tval / hz;
- ullsec = *sec;
- tval -= ullsec * hz;
- /* Careful: if HZ > 1 million, then integer division by it yields zero. */
- if (hz <= 1000000)
- *usec = tval * 1000000 / hz;
+static EMACS_TIME
+time_from_jiffies (unsigned long long tval, long hz)
+{
+ unsigned long long s = tval / hz;
+ unsigned long long frac = tval % hz;
+ int ns;
+
+ if (TYPE_MAXIMUM (time_t) < s)
+ time_overflow ();
+ if (LONG_MAX - 1 <= ULLONG_MAX / EMACS_TIME_RESOLUTION
+ || frac <= ULLONG_MAX / EMACS_TIME_RESOLUTION)
+ ns = frac * EMACS_TIME_RESOLUTION / hz;
else
- *usec = tval / (hz / 1000000);
+ {
+ /* This is reachable only in the unlikely case that HZ * HZ
+ exceeds ULLONG_MAX. It calculates an approximation that is
+ guaranteed to be in range. */
+ long hz_per_ns = (hz / EMACS_TIME_RESOLUTION
+ + (hz % EMACS_TIME_RESOLUTION != 0));
+ ns = frac / hz_per_ns;
+ }
+
+ return make_emacs_time (s, ns);
}
static Lisp_Object
ltime_from_jiffies (unsigned long long tval, long hz)
{
- time_t sec;
- unsigned usec;
-
- time_from_jiffies (tval, hz, &sec, &usec);
-
- return list3 (make_number ((sec >> 16) & 0xffff),
- make_number (sec & 0xffff),
- make_number (usec));
+ EMACS_TIME t = time_from_jiffies (tval, hz);
+ return make_lisp_time (t);
}
-static void
-get_up_time (time_t *sec, unsigned *usec)
+static EMACS_TIME
+get_up_time (void)
{
FILE *fup;
+ EMACS_TIME up = make_emacs_time (0, 0);
- *sec = *usec = 0;
-
- BLOCK_INPUT;
+ block_input ();
fup = fopen ("/proc/uptime", "r");
if (fup)
{
- double uptime, idletime;
+ unsigned long long upsec, upfrac, idlesec, idlefrac;
+ int upfrac_start, upfrac_end, idlefrac_start, idlefrac_end;
- /* The numbers in /proc/uptime use C-locale decimal point, but
- we already set ourselves to the C locale (see `fixup_locale'
- in emacs.c). */
- if (2 <= fscanf (fup, "%lf %lf", &uptime, &idletime))
+ if (fscanf (fup, "%llu.%n%llu%n %llu.%n%llu%n",
+ &upsec, &upfrac_start, &upfrac, &upfrac_end,
+ &idlesec, &idlefrac_start, &idlefrac, &idlefrac_end)
+ == 4)
{
- *sec = uptime;
- *usec = (uptime - *sec) * 1000000;
+ if (TYPE_MAXIMUM (time_t) < upsec)
+ {
+ upsec = TYPE_MAXIMUM (time_t);
+ upfrac = EMACS_TIME_RESOLUTION - 1;
+ }
+ else
+ {
+ int upfraclen = upfrac_end - upfrac_start;
+ for (; upfraclen < LOG10_EMACS_TIME_RESOLUTION; upfraclen++)
+ upfrac *= 10;
+ for (; LOG10_EMACS_TIME_RESOLUTION < upfraclen; upfraclen--)
+ upfrac /= 10;
+ upfrac = min (upfrac, EMACS_TIME_RESOLUTION - 1);
+ }
+ up = make_emacs_time (upsec, upfrac);
}
fclose (fup);
}
- UNBLOCK_INPUT;
+ unblock_input ();
+
+ return up;
}
#define MAJOR(d) (((unsigned)(d) >> 8) & 0xfff)
FILE *fdev = NULL;
char name[PATH_MAX];
- BLOCK_INPUT;
+ block_input ();
fdev = fopen ("/proc/tty/drivers", "r");
if (fdev)
}
fclose (fdev);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return build_string (name);
}
FILE *fmem = NULL;
unsigned long retval = 2 * 1024 * 1024; /* default: 2GB */
- BLOCK_INPUT;
+ block_input ();
fmem = fopen ("/proc/meminfo", "r");
if (fmem)
}
fclose (fmem);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return retval;
}
char procbuf[1025], *p, *q;
int fd;
ssize_t nread;
- const char *cmd = NULL;
+ static char const default_cmd[] = "???";
+ const char *cmd = default_cmd;
+ int cmdsize = sizeof default_cmd - 1;
char *cmdline = NULL;
- ptrdiff_t cmdsize = 0, cmdline_size;
+ ptrdiff_t cmdline_size;
unsigned char c;
- int proc_id, ppid, uid, gid, pgrp, sess, tty, tpgid, thcount;
+ printmax_t proc_id;
+ int ppid, pgrp, sess, tty, tpgid, thcount;
+ uid_t uid;
+ gid_t gid;
unsigned long long u_time, s_time, cutime, cstime, start;
long priority, niceness, rss;
unsigned long minflt, majflt, cminflt, cmajflt, vsize;
- time_t sec;
- unsigned usec;
- EMACS_TIME tnow, tstart, tboot, telapsed;
+ EMACS_TIME tnow, tstart, tboot, telapsed, us_time;
double pcpu, pmem;
Lisp_Object attrs = Qnil;
Lisp_Object cmd_str, decoded_cmd, tem;
struct gcpro gcpro1, gcpro2;
- EMACS_INT uid_eint, gid_eint;
CHECK_NUMBER_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
- sprintf (procfn, "/proc/%u", proc_id);
+ CONS_TO_INTEGER (pid, pid_t, proc_id);
+ sprintf (procfn, "/proc/%"pMd, proc_id);
if (stat (procfn, &st) < 0)
return attrs;
/* euid egid */
uid = st.st_uid;
- /* Use of EMACS_INT stops GCC whining about limited range of data type. */
- uid_eint = uid;
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid_eint)), attrs);
- BLOCK_INPUT;
+ attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
+ block_input ();
pw = getpwuid (uid);
- UNBLOCK_INPUT;
+ unblock_input ();
if (pw)
attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
gid = st.st_gid;
- gid_eint = gid;
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid_eint)), attrs);
- BLOCK_INPUT;
+ attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs);
+ block_input ();
gr = getgrgid (gid);
- UNBLOCK_INPUT;
+ unblock_input ();
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
}
else
q = NULL;
- if (cmd == NULL)
- {
- cmd = "???";
- cmdsize = 3;
- }
/* Command name is encoded in locale-coding-system; decode it. */
cmd_str = make_unibyte_string (cmd, cmdsize);
decoded_cmd = code_convert_string_norecord (cmd_str,
attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs);
attrs = Fcons (Fcons (Qnice, make_number (niceness)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount_eint)), attrs);
- EMACS_GET_TIME (tnow);
- get_up_time (&sec, &usec);
- EMACS_SET_SECS (telapsed, sec);
- EMACS_SET_USECS (telapsed, usec);
- EMACS_SUB_TIME (tboot, tnow, telapsed);
- time_from_jiffies (start, clocks_per_sec, &sec, &usec);
- EMACS_SET_SECS (tstart, sec);
- EMACS_SET_USECS (tstart, usec);
- EMACS_ADD_TIME (tstart, tboot, tstart);
- attrs = Fcons (Fcons (Qstart,
- list3 (make_number
- ((EMACS_SECS (tstart) >> 16) & 0xffff),
- make_number
- (EMACS_SECS (tstart) & 0xffff),
- make_number
- (EMACS_USECS (tstart)))),
- attrs);
+ tnow = current_emacs_time ();
+ telapsed = get_up_time ();
+ tboot = sub_emacs_time (tnow, telapsed);
+ tstart = time_from_jiffies (start, clocks_per_sec);
+ tstart = add_emacs_time (tboot, tstart);
+ attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs);
attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize/1024)), attrs);
attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4*rss)), attrs);
- EMACS_SUB_TIME (telapsed, tnow, tstart);
- attrs = Fcons (Fcons (Qetime,
- list3 (make_number
- ((EMACS_SECS (telapsed) >> 16) & 0xffff),
- make_number
- (EMACS_SECS (telapsed) & 0xffff),
- make_number
- (EMACS_USECS (telapsed)))),
- attrs);
- time_from_jiffies (u_time + s_time, clocks_per_sec, &sec, &usec);
- pcpu = (sec + usec / 1000000.0) / (EMACS_SECS (telapsed) + EMACS_USECS (telapsed) / 1000000.0);
+ telapsed = sub_emacs_time (tnow, tstart);
+ attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs);
+ us_time = time_from_jiffies (u_time + s_time, clocks_per_sec);
+ pcpu = (EMACS_TIME_TO_DOUBLE (us_time)
+ / EMACS_TIME_TO_DOUBLE (telapsed));
if (pcpu > 1.0)
pcpu = 1.0;
attrs = Fcons (Fcons (Qpcpu, make_float (100 * pcpu)), attrs);
if (emacs_read (fd, &ch, 1) != 1)
break;
c = ch;
- if (isspace (c) || c == '\\')
+ if (c_isspace (c) || c == '\\')
cmdline_size++; /* for later quoting, see below */
}
if (cmdline_size)
for (p = cmdline; p < cmdline + nread; p++)
{
/* Escape-quote whitespace and backslashes. */
- if (isspace (*p) || *p == '\\')
+ if (c_isspace (*p) || *p == '\\')
{
memmove (p + 1, p, nread - (p - cmdline));
nread++;
}
if (!cmdline_size)
{
- if (!cmd)
- cmd = "???";
- if (!cmdsize)
- cmdsize = strlen (cmd);
cmdline_size = cmdsize + 2;
cmdline = xmalloc (cmdline_size + 1);
- strcpy (cmdline, "[");
- strcat (strncat (cmdline, cmd, cmdsize), "]");
+ sprintf (cmdline, "[%.*s]", cmdsize, cmd);
}
emacs_close (fd);
/* Command line is encoded in locale-coding-system; decode it. */
struct psinfo pinfo;
int fd;
ssize_t nread;
- int proc_id, uid, gid;
+ printmax_t proc_id;
+ uid_t uid;
+ gid_t gid;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_cmd, tem;
struct gcpro gcpro1, gcpro2;
- EMACS_INT uid_eint, gid_eint;
CHECK_NUMBER_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
- sprintf (procfn, "/proc/%u", proc_id);
+ CONS_TO_INTEGER (pid, pid_t, proc_id);
+ sprintf (procfn, "/proc/%"pMd, proc_id);
if (stat (procfn, &st) < 0)
return attrs;
/* euid egid */
uid = st.st_uid;
- /* Use of EMACS_INT stops GCC whining about limited range of data type. */
- uid_eint = uid;
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid_eint)), attrs);
- BLOCK_INPUT;
+ attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
+ block_input ();
pw = getpwuid (uid);
- UNBLOCK_INPUT;
+ unblock_input ();
if (pw)
attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
gid = st.st_gid;
- gid_eint = gid;
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid_eint)), attrs);
- BLOCK_INPUT;
+ attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs);
+ block_input ();
gr = getgrgid (gid);
- UNBLOCK_INPUT;
+ unblock_input ();
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
Qcstime
Are they available? */
- attrs = Fcons (Fcons (Qtime,
- list3 (make_number (pinfo.pr_time.tv_sec >> 16),
- make_number (pinfo.pr_time.tv_sec & 0xffff),
- make_number (pinfo.pr_time.tv_nsec))),
- attrs);
-
- attrs = Fcons (Fcons (Qctime,
- list3 (make_number (pinfo.pr_ctime.tv_sec >> 16),
- make_number (pinfo.pr_ctime.tv_sec & 0xffff),
- make_number (pinfo.pr_ctime.tv_nsec))),
- attrs);
-
+ attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs);
+ attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs);
attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs);
attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), attrs);
- attrs = Fcons (Fcons (Qstart,
- list3 (make_number (pinfo.pr_start.tv_sec >> 16),
- make_number (pinfo.pr_start.tv_sec & 0xffff),
- make_number (pinfo.pr_start.tv_nsec))),
- attrs);
+ attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs);
attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), attrs);
attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), attrs);
- /* pr_pctcpu and pr_pctmem are encoded as a fixed point 16 bit number in [0 ... 1]. */
- attrs = Fcons (Fcons (Qpcpu, (pinfo.pr_pctcpu * 100.0) / (double)0x8000), attrs);
- attrs = Fcons (Fcons (Qpmem, (pinfo.pr_pctmem * 100.0) / (double)0x8000), attrs);
+ /* pr_pctcpu and pr_pctmem are unsigned integers in the
+ range 0 .. 2**15, representing 0.0 .. 1.0. */
+ attrs = Fcons (Fcons (Qpcpu, make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)), attrs);
+ attrs = Fcons (Fcons (Qpmem, make_float (100.0 / 0x8000 * pinfo.pr_pctmem)), attrs);
decoded_cmd
= code_convert_string_norecord (make_unibyte_string (pinfo.pr_fname,
return attrs;
}
+#elif defined __FreeBSD__
+
+static EMACS_TIME
+timeval_to_EMACS_TIME (struct timeval t)
+{
+ return make_emacs_time (t.tv_sec, t.tv_usec * 1000);
+}
+
+static Lisp_Object
+make_lisp_timeval (struct timeval t)
+{
+ return make_lisp_time (timeval_to_EMACS_TIME (t));
+}
+
+Lisp_Object
+system_process_attributes (Lisp_Object pid)
+{
+ int proc_id;
+ int pagesize = getpagesize ();
+ int npages;
+ int fscale;
+ struct passwd *pw;
+ struct group *gr;
+ char *ttyname;
+ size_t len;
+ char args[MAXPATHLEN];
+ EMACS_TIME t, now;
+
+ int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID};
+ struct kinfo_proc proc;
+ size_t proclen = sizeof proc;
+
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object attrs = Qnil;
+ Lisp_Object decoded_comm;
+
+ CHECK_NUMBER_OR_FLOAT (pid);
+ CONS_TO_INTEGER (pid, int, proc_id);
+ mib[3] = proc_id;
+
+ if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0)
+ return attrs;
+
+ GCPRO2 (attrs, decoded_comm);
+
+ attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (proc.ki_uid)), attrs);
+
+ block_input ();
+ pw = getpwuid (proc.ki_uid);
+ unblock_input ();
+ if (pw)
+ attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
+
+ attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (proc.ki_svgid)), attrs);
+
+ block_input ();
+ gr = getgrgid (proc.ki_svgid);
+ unblock_input ();
+ if (gr)
+ attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
+
+ decoded_comm = code_convert_string_norecord
+ (make_unibyte_string (proc.ki_comm, strlen (proc.ki_comm)),
+ Vlocale_coding_system, 0);
+
+ attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
+ {
+ char state[2] = {'\0', '\0'};
+ switch (proc.ki_stat)
+ {
+ case SRUN:
+ state[0] = 'R';
+ break;
+
+ case SSLEEP:
+ state[0] = 'S';
+ break;
+
+ case SLOCK:
+ state[0] = 'D';
+ break;
+
+ case SZOMB:
+ state[0] = 'Z';
+ break;
+
+ case SSTOP:
+ state[0] = 'T';
+ break;
+ }
+ attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
+ }
+
+ attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (proc.ki_ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (proc.ki_pgid)), attrs);
+ attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (proc.ki_sid)), attrs);
+
+ block_input ();
+ ttyname = proc.ki_tdev == NODEV ? NULL : devname (proc.ki_tdev, S_IFCHR);
+ unblock_input ();
+ if (ttyname)
+ attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs);
+
+ attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (proc.ki_tpgid)), attrs);
+ attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (proc.ki_rusage.ru_minflt)), attrs);
+ attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (proc.ki_rusage.ru_majflt)), attrs);
+ attrs = Fcons (Fcons (Qcminflt, make_number (proc.ki_rusage_ch.ru_minflt)), attrs);
+ attrs = Fcons (Fcons (Qcmajflt, make_number (proc.ki_rusage_ch.ru_majflt)), attrs);
+
+ attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.ki_rusage.ru_utime)),
+ attrs);
+ attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.ki_rusage.ru_stime)),
+ attrs);
+ t = add_emacs_time (timeval_to_EMACS_TIME (proc.ki_rusage.ru_utime),
+ timeval_to_EMACS_TIME (proc.ki_rusage.ru_stime));
+ attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs);
+
+ attrs = Fcons (Fcons (Qcutime,
+ make_lisp_timeval (proc.ki_rusage_ch.ru_utime)),
+ attrs);
+ attrs = Fcons (Fcons (Qcstime,
+ make_lisp_timeval (proc.ki_rusage_ch.ru_utime)),
+ attrs);
+ t = add_emacs_time (timeval_to_EMACS_TIME (proc.ki_rusage_ch.ru_utime),
+ timeval_to_EMACS_TIME (proc.ki_rusage_ch.ru_stime));
+ attrs = Fcons (Fcons (Qctime, make_lisp_time (t)), attrs);
+
+ attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (proc.ki_numthreads)),
+ attrs);
+ attrs = Fcons (Fcons (Qpri, make_number (proc.ki_pri.pri_native)), attrs);
+ attrs = Fcons (Fcons (Qnice, make_number (proc.ki_nice)), attrs);
+ attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.ki_start)), attrs);
+ attrs = Fcons (Fcons (Qvsize, make_number (proc.ki_size >> 10)), attrs);
+ attrs = Fcons (Fcons (Qrss, make_number (proc.ki_rssize * pagesize >> 10)),
+ attrs);
+
+ now = current_emacs_time ();
+ t = sub_emacs_time (now, timeval_to_EMACS_TIME (proc.ki_start));
+ attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
+
+ len = sizeof fscale;
+ if (sysctlbyname ("kern.fscale", &fscale, &len, NULL, 0) == 0)
+ {
+ double pcpu;
+ fixpt_t ccpu;
+ len = sizeof ccpu;
+ if (sysctlbyname ("kern.ccpu", &ccpu, &len, NULL, 0) == 0)
+ {
+ pcpu = (100.0 * proc.ki_pctcpu / fscale
+ / (1 - exp (proc.ki_swtime * log ((double) ccpu / fscale))));
+ attrs = Fcons (Fcons (Qpcpu, make_fixnum_or_float (pcpu)), attrs);
+ }
+ }
+
+ len = sizeof npages;
+ if (sysctlbyname ("hw.availpages", &npages, &len, NULL, 0) == 0)
+ {
+ double pmem = (proc.ki_flag & P_INMEM
+ ? 100.0 * proc.ki_rssize / npages
+ : 0);
+ attrs = Fcons (Fcons (Qpmem, make_fixnum_or_float (pmem)), attrs);
+ }
+
+ mib[2] = KERN_PROC_ARGS;
+ len = MAXPATHLEN;
+ if (sysctl (mib, 4, args, &len, NULL, 0) == 0)
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ {
+ if (! args[i] && i < len - 1)
+ args[i] = ' ';
+ }
+
+ decoded_comm =
+ (code_convert_string_norecord
+ (build_unibyte_string (args),
+ Vlocale_coding_system, 0));
+
+ attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
+ }
+
+ UNGCPRO;
+ return attrs;
+}
+
/* The WINDOWSNT implementation is in w32.c.
The MSDOS implementation is in dosfns.c. */
#elif !defined (WINDOWSNT) && !defined (MSDOS)
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-#ifdef HAVE_SYS_SELECT_H
-#if defined (DARWIN_OS)
-#undef init_process
-#endif
+#ifndef DOS_NT
#include <sys/select.h>
-#if defined (DARWIN_OS)
-#define init_process emacs_init_process
-#endif
#endif
/* The w32 build defines select stuff in w32.h, which is included
#define select sys_select
#endif
+#ifdef MSDOS
+#define pselect sys_select
+#endif
/* syssignal.h - System-dependent definitions for signals.
- Copyright (C) 1993, 1999, 2001-2012 Free Software Foundation, Inc.
+
+Copyright (C) 1993, 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-extern void init_signals (void);
+#include <signal.h>
+#include <stdbool.h>
+
+extern void init_signals (bool);
#ifdef HAVE_PTHREAD
#include <pthread.h>
#define FORWARD_SIGNAL_TO_MAIN_THREAD
#endif
-/* Don't #include <signal.h>. That header should always be #included
- before "config.h", because some configuration files (like s/hpux.h)
- indicate that SIGIO doesn't work by #undef-ing SIGIO. If this file
- #includes <signal.h>, then that will re-#define SIGIO and confuse
- things. */
-/* XXX This is not correct anymore, there is a BROKEN_SIGIO macro. */
-
-#define SIGMASKTYPE sigset_t
-
-#define SIGEMPTYMASK (empty_mask)
extern sigset_t empty_mask;
-/* POSIX pretty much destroys any possibility of writing sigmask as a
- macro in standard C. We always define our own version because the
- predefined macro in Glibc 2.1 is only provided for compatibility for old
- programs that use int as signal mask type. */
-#undef sigmask
-#ifdef __GNUC__
-#define sigmask(SIG) \
- ({ \
- sigset_t _mask; \
- sigemptyset (&_mask); \
- sigaddset (&_mask, SIG); \
- _mask; \
- })
-#else /* ! defined (__GNUC__) */
-extern sigset_t sys_sigmask ();
-#define sigmask(SIG) (sys_sigmask (SIG))
-#endif /* ! defined (__GNUC__) */
-
-#undef sigpause
-#define sigpause(MASK) sigsuspend (&(MASK))
-
-#define sigblock(SIG) sys_sigblock (SIG)
-#define sigunblock(SIG) sys_sigunblock (SIG)
-#ifndef sigsetmask
-#define sigsetmask(SIG) sys_sigsetmask (SIG)
-#endif
-#undef signal
-#define signal(SIG,ACT) sys_signal(SIG,ACT)
-
-/* Whether this is what all systems want or not, this is what
- appears to be assumed in the source, for example data.c:arith_error. */
typedef void (*signal_handler_t) (int);
-signal_handler_t sys_signal (int signal_number, signal_handler_t action);
-sigset_t sys_sigblock (sigset_t new_mask);
-sigset_t sys_sigunblock (sigset_t new_mask);
-sigset_t sys_sigsetmask (sigset_t new_mask);
-#if ! (defined TIOCNOTTY || defined USG5 || defined CYGWIN)
-void croak (char *) NO_RETURN;
-#endif
-
-#define sys_sigdel(MASK,SIG) sigdelset (&MASK,SIG)
-
-#define sigfree() sigsetmask (SIGEMPTYMASK)
-
-#if defined (SIGINFO) && defined (BROKEN_SIGINFO)
-#undef SIGINFO
-#endif
-#if defined (SIGIO) && defined (BROKEN_SIGIO)
-# undef SIGIO
-#endif
-#if defined (SIGPOLL) && defined (BROKEN_SIGPOLL)
-#undef SIGPOLL
-#endif
-#if defined (SIGTSTP) && defined (BROKEN_SIGTSTP)
-#undef SIGTSTP
-#endif
-#if defined (SIGURG) && defined (BROKEN_SIGURG)
-#undef SIGURG
-#endif
-#if defined (SIGAIO) && defined (BROKEN_SIGAIO)
-#undef SIGAIO
-#endif
-#if defined (SIGPTY) && defined (BROKEN_SIGPTY)
-#undef SIGPTY
-#endif
-
+extern void emacs_sigaction_init (struct sigaction *, signal_handler_t);
#if NSIG < NSIG_MINIMUM
-# ifdef NSIG
-# undef NSIG
-# endif
+# undef NSIG
# define NSIG NSIG_MINIMUM
#endif
+#ifndef emacs_raise
+# define emacs_raise(sig) raise (sig)
+#endif
+
/* On bsd, [man says] kill does not accept a negative number to kill a pgrp.
Must do that using the killpg call. */
#ifdef BSD_SYSTEM
char *strsignal (int);
#endif
-#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
-extern pthread_t main_thread;
-#define SIGNAL_THREAD_CHECK(signo) \
- do { \
- if (!pthread_equal (pthread_self (), main_thread)) \
- { \
- /* POSIX says any thread can receive the signal. On GNU/Linux \
- that is not true, but for other systems (FreeBSD at least) \
- it is. So direct the signal to the correct thread and block \
- it from this thread. */ \
- sigset_t new_mask; \
- \
- sigemptyset (&new_mask); \
- sigaddset (&new_mask, signo); \
- pthread_sigmask (SIG_BLOCK, &new_mask, 0); \
- pthread_kill (main_thread, signo); \
- return; \
- } \
- } while (0)
-
-#else /* not FORWARD_SIGNAL_TO_MAIN_THREAD */
-#define SIGNAL_THREAD_CHECK(signo)
-#endif /* not FORWARD_SIGNAL_TO_MAIN_THREAD */
+void deliver_process_signal (int, signal_handler_t);
#ifndef EMACS_SYSTIME_H
#define EMACS_SYSTIME_H
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
+#include <timespec.h>
+
+INLINE_HEADER_BEGIN
+#ifndef SYSTIME_INLINE
+# define SYSTIME_INLINE INLINE
#endif
#ifdef emacs
#endif
#endif
#endif
-\f
-/* EMACS_TIME is the type to use to represent temporal intervals -
- struct timeval on some systems, int on others. It can be passed as
- the timeout argument to the select system call.
-
- EMACS_SECS (TIME) is an rvalue for the seconds component of TIME.
- EMACS_SET_SECS (TIME, SECONDS) sets that to SECONDS.
-
- EMACS_HAS_USECS is defined if EMACS_TIME has a usecs component.
- EMACS_USECS (TIME) is an rvalue for the microseconds component of TIME.
- This returns zero if EMACS_TIME doesn't have a microseconds component.
- EMACS_SET_USECS (TIME, MICROSECONDS) sets that to MICROSECONDS.
- This does nothing if EMACS_TIME doesn't have a microseconds component.
-
- EMACS_SET_SECS_USECS (TIME, SECS, USECS) sets both components of TIME.
-
- EMACS_GET_TIME (TIME) stores the current system time in TIME, which
- should be an lvalue.
-
- EMACS_ADD_TIME (DEST, SRC1, SRC2) adds SRC1 to SRC2 and stores the
- result in DEST. SRC should not be negative.
-
- EMACS_SUB_TIME (DEST, SRC1, SRC2) subtracts SRC2 from SRC1 and
- stores the result in DEST. SRC should not be negative.
- EMACS_TIME_NEG_P (TIME) is true if TIME is negative.
-
-*/
-
-#ifdef HAVE_TIMEVAL
-
-#define EMACS_HAS_USECS
-
-#define EMACS_TIME struct timeval
-#define EMACS_SECS(time) ((time).tv_sec + 0)
-#define EMACS_USECS(time) ((time).tv_usec + 0)
-#define EMACS_SET_SECS(time, seconds) ((time).tv_sec = (seconds))
-#define EMACS_SET_USECS(time, microseconds) ((time).tv_usec = (microseconds))
-/* On SVR4, the compiler may complain if given this extra BSD arg. */
-#ifdef GETTIMEOFDAY_ONE_ARGUMENT
-#define EMACS_GET_TIME(time) gettimeofday (&(time))
-#else /* not GETTIMEOFDAY_ONE_ARGUMENT */
-/* Presumably the second arg is ignored. */
-#define EMACS_GET_TIME(time) gettimeofday (&(time), NULL)
-#endif /* not GETTIMEOFDAY_ONE_ARGUMENT */
-
-#define EMACS_ADD_TIME(dest, src1, src2) \
- do { \
- (dest).tv_sec = (src1).tv_sec + (src2).tv_sec; \
- (dest).tv_usec = (src1).tv_usec + (src2).tv_usec; \
- if ((dest).tv_usec > 1000000) \
- (dest).tv_usec -= 1000000, (dest).tv_sec++; \
- } while (0)
-
-#define EMACS_SUB_TIME(dest, src1, src2) \
- do { \
- (dest).tv_sec = (src1).tv_sec - (src2).tv_sec; \
- (dest).tv_usec = (src1).tv_usec - (src2).tv_usec; \
- if ((dest).tv_usec < 0) \
- (dest).tv_usec += 1000000, (dest).tv_sec--; \
- } while (0)
-
-#define EMACS_TIME_NEG_P(time) \
- ((long)(time).tv_sec < 0 \
- || ((time).tv_sec == 0 \
- && (long)(time).tv_usec < 0))
-
-#else /* ! defined (HAVE_TIMEVAL) */
-
-#define EMACS_TIME int
-#define EMACS_SECS(time) (time)
-#define EMACS_USECS(time) 0
-#define EMACS_SET_SECS(time, seconds) ((time) = (seconds))
-#define EMACS_SET_USECS(time, usecs) 0
-
-#define EMACS_GET_TIME(t) ((t) = time ((long *) 0))
-#define EMACS_ADD_TIME(dest, src1, src2) ((dest) = (src1) + (src2))
-#define EMACS_SUB_TIME(dest, src1, src2) ((dest) = (src1) - (src2))
-#define EMACS_TIME_NEG_P(t) ((t) < 0)
-
-#endif /* ! defined (HAVE_TIMEVAL) */
-
-#define EMACS_SET_SECS_USECS(time, secs, usecs) \
- (EMACS_SET_SECS (time, secs), EMACS_SET_USECS (time, usecs))
-
-extern int set_file_times (const char *, EMACS_TIME, EMACS_TIME);
+#include <sys/time.h> /* for 'struct timeval' */
+\f
+/* The type to use to represent non-negative temporal intervals. Its
+ address can be passed as the timeout argument to the pselect system
+ call. */
+typedef struct timespec EMACS_TIME;
+
+/* Resolution of EMACS_TIME time stamps (in units per second), and log
+ base 10 of the resolution. The log must be a positive integer. */
+enum { EMACS_TIME_RESOLUTION = 1000000000 };
+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. */
+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. */
+SYSTIME_INLINE EMACS_TIME
+make_emacs_time (time_t s, int ns)
+{
+ EMACS_TIME r = { s, ns };
+ return r;
+}
+
+/* Return an invalid Emacs time. */
+SYSTIME_INLINE EMACS_TIME
+invalid_emacs_time (void)
+{
+ EMACS_TIME r = { 0, -1 };
+ return r;
+}
+
+/* Return current system time. */
+SYSTIME_INLINE EMACS_TIME
+current_emacs_time (void)
+{
+ EMACS_TIME r;
+ gettime (&r);
+ return r;
+}
+
+/* Return the result of adding A to B, or of subtracting B from A.
+ On overflow, store an extremal value: ergo, if time_t is unsigned,
+ return 0 if the true answer would be negative.
+
+ WARNING: These are NOT general-purpose macros for adding or
+ subtracting arbitrary time values! They are generally intended to
+ 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. */
+SYSTIME_INLINE EMACS_TIME
+add_emacs_time (EMACS_TIME a, EMACS_TIME b)
+{
+ return timespec_add (a, b);
+}
+SYSTIME_INLINE EMACS_TIME
+sub_emacs_time (EMACS_TIME a, EMACS_TIME b)
+{
+ return timespec_sub (a, 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. */
+SYSTIME_INLINE int
+EMACS_TIME_SIGN (EMACS_TIME t)
+{
+ return timespec_sign (t);
+}
+
+/* Return 1 if TIME is a valid time stamp. */
+SYSTIME_INLINE int
+EMACS_TIME_VALID_P (EMACS_TIME t)
+{
+ return 0 <= t.tv_nsec;
+}
+
+/* Convert the double D to the greatest EMACS_TIME not greater than D.
+ 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. */
+SYSTIME_INLINE EMACS_TIME
+EMACS_TIME_FROM_DOUBLE (double d)
+{
+ return dtotimespec (d);
+}
+
+/* Convert the Emacs time T to an approximate double value D. */
+SYSTIME_INLINE double
+EMACS_TIME_TO_DOUBLE (EMACS_TIME t)
+{
+ return timespectod (t);
+}
+
+/* defined in sysdep.c */
+extern int set_file_times (int, const char *, EMACS_TIME, EMACS_TIME);
+extern struct timeval make_timeval (EMACS_TIME);
/* defined in keyboard.c */
extern void set_waiting_for_input (EMACS_TIME *);
happen when this files is used outside the src directory).
Use GCPRO1 to determine if lisp.h was included. */
#ifdef GCPRO1
-/* defined in editfns.c*/
-extern Lisp_Object make_time (time_t);
-extern int lisp_time_argument (Lisp_Object, time_t *, int *);
+/* defined in editfns.c */
+extern Lisp_Object make_lisp_time (EMACS_TIME);
+extern bool decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, EMACS_TIME *, double *);
+extern EMACS_TIME lisp_time_argument (Lisp_Object);
#endif
-/* Compare times T1 and T2. Value is 0 if T1 and T2 are the same.
- Value is < 0 if T1 is less than T2. Value is > 0 otherwise. */
-
-#define EMACS_TIME_CMP(T1, T2) \
- (EMACS_SECS (T1) == EMACS_SECS (T2) \
- ? EMACS_USECS (T1) - EMACS_USECS (T2) \
- : (EMACS_SECS (T1) < EMACS_SECS (T2) ? -1 : 1))
-
/* Compare times T1 and T2 for equality, inequality etc. */
-
-#define EMACS_TIME_EQ(T1, T2) (EMACS_TIME_CMP (T1, T2) == 0)
-#define EMACS_TIME_NE(T1, T2) (EMACS_TIME_CMP (T1, T2) != 0)
-#define EMACS_TIME_GT(T1, T2) (EMACS_TIME_CMP (T1, T2) > 0)
-#define EMACS_TIME_GE(T1, T2) (EMACS_TIME_CMP (T1, T2) >= 0)
-#define EMACS_TIME_LT(T1, T2) (EMACS_TIME_CMP (T1, T2) < 0)
-#define EMACS_TIME_LE(T1, T2) (EMACS_TIME_CMP (T1, T2) <= 0)
+SYSTIME_INLINE int
+EMACS_TIME_EQ (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) == 0;
+}
+SYSTIME_INLINE int
+EMACS_TIME_NE (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) != 0;
+}
+SYSTIME_INLINE int
+EMACS_TIME_GT (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) > 0;
+}
+SYSTIME_INLINE int
+EMACS_TIME_GE (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) >= 0;
+}
+SYSTIME_INLINE int
+EMACS_TIME_LT (EMACS_TIME t1, EMACS_TIME t2)
+{
+ return timespec_cmp (t1, t2) < 0;
+}
+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 */
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Include the proper files. */
+
#ifndef DOS_NT
-#ifndef NO_TERMIO
-#include <termio.h>
-#endif /* not NO_TERMIO */
#include <termios.h>
#include <fcntl.h>
#endif /* not DOS_NT */
#include <unistd.h>
-\f
-/* Special cases - inhibiting the use of certain features. */
-
-/* Allow m- file to inhibit use of FIONREAD. */
-#ifdef BROKEN_FIONREAD
-#undef FIONREAD
-#undef ASYNC
-#endif
-
-/* Interrupt input is not used if there is no FIONREAD. */
-#ifndef FIONREAD
-#undef SIGIO
-#endif
-
\f
/* Try to establish the correct character to disable terminal functions
in a system-independent manner. Note that USG (at least) define
#define WTERMSIG(status) ((status) & 0x7f)
#endif
-#undef WRETCODE
-#define WRETCODE(status) WEXITSTATUS (status)
+/* Defined in process.c. */
+extern void record_child_status_change (pid_t, int);
+/* Defined in sysdep.c. */
+extern void wait_for_termination (pid_t);
+extern void interruptible_wait_for_termination (pid_t);
#endif /* EMACS_SYSWAIT_H */
-
#include <config.h>
#include <stdio.h>
-#include <ctype.h>
#include <errno.h>
#include <sys/file.h>
+#include <sys/time.h>
#include <unistd.h>
-#include <signal.h>
-#include <setjmp.h>
#include "lisp.h"
#include "termchar.h"
#include "termopts.h"
#include "tparam.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include "composite.h"
static void set_tty_hooks (struct terminal *terminal);
static void dissociate_if_controlling_tty (int fd);
static void delete_tty (struct terminal *);
-static void maybe_fatal (int must_succeed, struct terminal *terminal,
- const char *str1, const char *str2, ...)
- NO_RETURN ATTRIBUTE_FORMAT_PRINTF (3, 5) ATTRIBUTE_FORMAT_PRINTF (4, 5);
-static void vfatal (const char *str, va_list ap)
- NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 0);
+static _Noreturn void maybe_fatal (int must_succeed, struct terminal *terminal,
+ const char *str1, const char *str2, ...)
+ ATTRIBUTE_FORMAT_PRINTF (3, 5) ATTRIBUTE_FORMAT_PRINTF (4, 5);
+static _Noreturn void vfatal (const char *str, va_list ap)
+ ATTRIBUTE_FORMAT_PRINTF (1, 0);
#define OUTPUT(tty, a) \
NC_STANDOUT = 1 << 0,
NC_UNDERLINE = 1 << 1,
NC_REVERSE = 1 << 2,
- NC_BLINK = 1 << 3,
+ NC_ITALIC = 1 << 3,
NC_DIM = 1 << 4,
NC_BOLD = 1 << 5,
NC_INVIS = 1 << 6,
- NC_PROTECT = 1 << 7,
- NC_ALT_CHARSET = 1 << 8
+ NC_PROTECT = 1 << 7
};
/* internal state */
conversion_buffer = encode_terminal_code (string, n, coding);
if (coding->produced > 0)
{
- BLOCK_INPUT;
+ block_input ();
fwrite (conversion_buffer, 1, coding->produced, tty->output);
if (ferror (tty->output))
clearerr (tty->output);
if (tty->termscript)
fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
- UNBLOCK_INPUT;
+ unblock_input ();
}
string += n;
conversion_buffer = encode_terminal_code (string, len, coding);
if (coding->produced > 0)
{
- BLOCK_INPUT;
+ block_input ();
fwrite (conversion_buffer, 1, coding->produced, tty->output);
if (ferror (tty->output))
clearerr (tty->output);
if (tty->termscript)
fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Turn appearance modes off. */
if (coding->produced > 0)
{
- BLOCK_INPUT;
+ block_input ();
fwrite (conversion_buffer, 1, coding->produced, tty->output);
if (ferror (tty->output))
clearerr (tty->output);
if (tty->termscript)
fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
- UNBLOCK_INPUT;
+ unblock_input ();
}
OUTPUT1_IF (tty, tty->TS_pad_inserted_char);
/* 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_input_decode_map (kboard, Fmake_sparse_keymap (Qnil));
for (i = 0; i < (sizeof (keys)/sizeof (keys[0])); i++)
{
struct glyph *glyph, *end;
int i;
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
glyph = (it->glyph_row->glyphs[it->area]
+ it->glyph_row->used[it->area]);
end = it->glyph_row->glyphs[1 + it->area];
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
/* If a hook is installed, let it do the work. */
/* Nothing but characters are supported on terminal frames. */
- xassert (it->what == IT_CHARACTER
+ eassert (it->what == IT_CHARACTER
|| it->what == IT_COMPOSITION
|| it->what == IT_STRETCH
|| it->what == IT_GLYPHLESS);
{
Lisp_Object acronym = lookup_glyphless_char_display (-1, it);
- xassert (it->what == IT_GLYPHLESS);
+ eassert (it->what == IT_GLYPHLESS);
produce_glyphless_glyph (it, 1, acronym);
}
}
{
struct glyph *glyph;
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
glyph = it->glyph_row->glyphs[it->area] + it->glyph_row->used[it->area];
if (glyph < it->glyph_row->glyphs[1 + it->area])
{
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
struct glyph *glyph, *end;
int i;
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
glyph = it->glyph_row->glyphs[it->area] + it->glyph_row->used[it->area];
end = it->glyph_row->glyphs[1 + it->area];
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
len = 1;
else if (len > 4)
len = 4;
- sprintf (buf, "[%.*s]", len, str);
- len += 2;
+ len = sprintf (buf, "[%.*s]", len, str);
str = buf;
}
else
}
else
{
- xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE);
+ eassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE);
len = (it->c < 0x10000 ? sprintf (buf, "\\u%04X", it->c)
: it->c <= MAX_UNICODE_CHAR ? sprintf (buf, "\\U%06X", it->c)
: sprintf (buf, "\\x%06X", it->c));
append_glyphless_glyph (it, face_id, str);
}
-
-/* Get information about special display element WHAT in an
- environment described by IT. WHAT is one of IT_TRUNCATION or
- IT_CONTINUATION. Maybe produce glyphs for WHAT if IT has a
- non-null glyph_row member. This function ensures that fields like
- face_id, c, len of IT are left untouched. */
-
-void
-produce_special_glyphs (struct it *it, enum display_element_type what)
-{
- struct it temp_it;
- Lisp_Object gc;
- GLYPH glyph;
-
- temp_it = *it;
- temp_it.dp = NULL;
- temp_it.what = IT_CHARACTER;
- temp_it.len = 1;
- temp_it.object = make_number (0);
- memset (&temp_it.current, 0, sizeof temp_it.current);
-
- if (what == IT_CONTINUATION)
- {
- /* Continuation glyph. For R2L lines, we mirror it by hand. */
- if (it->bidi_it.paragraph_dir == R2L)
- SET_GLYPH_FROM_CHAR (glyph, '/');
- else
- SET_GLYPH_FROM_CHAR (glyph, '\\');
- if (it->dp
- && (gc = DISP_CONTINUE_GLYPH (it->dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
- {
- /* FIXME: Should we mirror GC for R2L lines? */
- SET_GLYPH_FROM_GLYPH_CODE (glyph, gc);
- spec_glyph_lookup_face (XWINDOW (it->window), &glyph);
- }
- }
- else if (what == IT_TRUNCATION)
- {
- /* Truncation glyph. */
- SET_GLYPH_FROM_CHAR (glyph, '$');
- if (it->dp
- && (gc = DISP_TRUNC_GLYPH (it->dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
- {
- /* FIXME: Should we mirror GC for R2L lines? */
- SET_GLYPH_FROM_GLYPH_CODE (glyph, gc);
- spec_glyph_lookup_face (XWINDOW (it->window), &glyph);
- }
- }
- else
- abort ();
-
- temp_it.c = temp_it.char_to_display = GLYPH_CHAR (glyph);
- temp_it.face_id = GLYPH_FACE (glyph);
- temp_it.len = CHAR_BYTES (temp_it.c);
-
- produce_glyphs (&temp_it);
- it->pixel_width = temp_it.pixel_width;
- it->nglyphs = temp_it.pixel_width;
-}
-
-
\f
/***********************************************************************
Faces
if (face->tty_bold_p && MAY_USE_WITH_COLORS_P (tty, NC_BOLD))
OUTPUT1_IF (tty, tty->TS_enter_bold_mode);
- if (face->tty_dim_p && MAY_USE_WITH_COLORS_P (tty, NC_DIM))
- OUTPUT1_IF (tty, tty->TS_enter_dim_mode);
-
- /* Alternate charset and blinking not yet used. */
- if (face->tty_alt_charset_p
- && MAY_USE_WITH_COLORS_P (tty, NC_ALT_CHARSET))
- OUTPUT1_IF (tty, tty->TS_enter_alt_charset_mode);
-
- if (face->tty_blinking_p
- && MAY_USE_WITH_COLORS_P (tty, NC_BLINK))
- OUTPUT1_IF (tty, tty->TS_enter_blink_mode);
+ if (face->tty_italic_p && MAY_USE_WITH_COLORS_P (tty, NC_ITALIC))
+ {
+ if (tty->TS_enter_italic_mode)
+ OUTPUT1 (tty, tty->TS_enter_italic_mode);
+ else
+ /* Italics mode is unavailable on many terminals. In that
+ case, map slant to dimmed text; we want italic text to
+ appear different and dimming is not otherwise used. */
+ OUTPUT1 (tty, tty->TS_enter_dim_mode);
+ }
if (face->tty_underline_p && MAY_USE_WITH_COLORS_P (tty, NC_UNDERLINE))
OUTPUT1_IF (tty, tty->TS_enter_underline_mode);
struct face *face = FACE_FROM_ID (f, face_id);
struct tty_display_info *tty = FRAME_TTY (f);
- xassert (face != NULL);
+ eassert (face != NULL);
if (tty->TS_exit_attribute_mode)
{
half-bright, reverse-video, standout, underline. It may or
may not turn off alt-char-mode. */
if (face->tty_bold_p
- || face->tty_dim_p
+ || face->tty_italic_p
|| face->tty_reverse_p
- || face->tty_alt_charset_p
- || face->tty_blinking_p
|| face->tty_underline_p)
{
OUTPUT1_IF (tty, tty->TS_exit_attribute_mode);
if (strcmp (tty->TS_exit_attribute_mode, tty->TS_end_standout_mode) == 0)
tty->standout_mode = 0;
}
-
- if (face->tty_alt_charset_p)
- OUTPUT_IF (tty, tty->TS_exit_alt_charset_mode);
}
else
{
/* If we don't have "me" we can only have those appearances
that have exit sequences defined. */
- if (face->tty_alt_charset_p)
- OUTPUT_IF (tty, tty->TS_exit_alt_charset_mode);
-
if (face->tty_underline_p)
OUTPUT_IF (tty, tty->TS_exit_underline_mode);
}
TTY_CAPABLE_P_TRY (tty, TTY_CAP_UNDERLINE, tty->TS_enter_underline_mode, NC_UNDERLINE);
TTY_CAPABLE_P_TRY (tty, TTY_CAP_BOLD, tty->TS_enter_bold_mode, NC_BOLD);
TTY_CAPABLE_P_TRY (tty, TTY_CAP_DIM, tty->TS_enter_dim_mode, NC_DIM);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_BLINK, tty->TS_enter_blink_mode, NC_BLINK);
- TTY_CAPABLE_P_TRY (tty, TTY_CAP_ALT_CHARSET, tty->TS_enter_alt_charset_mode, NC_ALT_CHARSET);
+ TTY_CAPABLE_P_TRY (tty, TTY_CAP_ITALIC, tty->TS_enter_italic_mode, NC_ITALIC);
/* We can do it! */
return 1;
TERMINAL can be a terminal object, a frame, or nil (meaning the
selected frame's terminal). This function always returns nil if
-TERMINAL does not refer to a text-only terminal. */)
+TERMINAL does not refer to a text terminal. */)
(Lisp_Object terminal)
{
struct terminal *t = get_tty_terminal (terminal, 0);
TERMINAL can be a terminal object, a frame, or nil (meaning the
selected frame's terminal). This function always returns 0 if
-TERMINAL does not refer to a text-only terminal. */)
+TERMINAL does not refer to a text terminal. */)
(Lisp_Object terminal)
{
struct terminal *t = get_tty_terminal (terminal, 0);
else
color_mode = Qnil;
- mode = INTEGERP (color_mode) ? XINT (color_mode) : 0;
+ mode = TYPE_RANGED_INTEGERP (int, color_mode) ? XINT (color_mode) : 0;
if (mode != tty->previous_color_mode)
{
- Lisp_Object funsym = intern ("tty-set-up-initial-frame-faces");
tty->previous_color_mode = mode;
tty_setup_colors (tty , mode);
/* This recomputes all the faces given the new color definitions. */
- safe_call (1, &funsym);
+ safe_call (1, intern ("tty-set-up-initial-frame-faces"));
}
}
struct terminal *t;
if (!name)
- abort ();
+ emacs_abort ();
for (t = terminal_list; t; t = t->next_terminal)
{
TERMINAL can be a terminal object, a frame or nil (meaning the
selected frame's terminal). This function always returns nil if
-TERMINAL does not refer to a text-only terminal. */)
+TERMINAL does not refer to a text terminal. */)
(Lisp_Object terminal)
{
struct terminal *t = get_terminal (terminal, 1);
return Qnil;
}
+DEFUN ("tty-top-frame", Ftty_top_frame, Stty_top_frame, 0, 1, 0,
+ doc: /* Return the topmost terminal frame on TERMINAL.
+TERMINAL can be a terminal object, a frame or nil (meaning the
+selected frame's terminal). This function returns nil if TERMINAL
+does not refer to a text terminal. Otherwise, it returns the
+top-most frame on the text terminal. */)
+ (Lisp_Object terminal)
+{
+ struct terminal *t = get_terminal (terminal, 1);
+
+ if (t->type == output_termcap)
+ return t->display_info.tty->top_frame;
+ return Qnil;
+}
+
\f
DEFUN ("suspend-tty", Fsuspend_tty, Ssuspend_tty, 0, 1, 0,
return 0;
}
+/* Return the Time that corresponds to T. Wrap around on overflow. */
+static Time
+timeval_to_Time (struct timeval const *t)
+{
+ Time s_1000, ms;
+
+ s_1000 = t->tv_sec;
+ s_1000 *= 1000;
+ ms = t->tv_usec / 1000;
+ return s_1000 + ms;
+}
+
/* Return the current position of the mouse.
Set *f to the frame the mouse is in, or zero if the mouse is in no
Lisp_Object *y, Time *timeptr)
{
struct timeval now;
- Time sec, usec;
*fp = SELECTED_FRAME ();
(*fp)->mouse_moved = 0;
XSETINT (*x, last_mouse_x);
XSETINT (*y, last_mouse_y);
gettimeofday(&now, 0);
- sec = now.tv_sec;
- usec = now.tv_usec;
- *timeptr = (sec * 1000) + (usec / 1000);
+ *timeptr = timeval_to_Time (&now);
}
/* Prepare a mouse-event in *RESULT for placement in the input queue.
}
}
gettimeofday(&now, 0);
- result->timestamp = (now.tv_sec * 1000) + (now.tv_usec / 1000);
+ result->timestamp = timeval_to_Time (&now);
if (event->type & GPM_UP)
result->modifiers = up_modifier;
void
create_tty_output (struct frame *f)
{
- struct tty_output *t;
+ struct tty_output *t = xzalloc (sizeof *t);
if (! FRAME_TERMCAP_P (f))
- abort ();
-
- t = xmalloc (sizeof (struct tty_output));
- memset (t, 0, sizeof (struct tty_output));
+ emacs_abort ();
t->display_info = FRAME_TERMINAL (f)->display_info.tty;
tty_free_frame_resources (struct frame *f)
{
if (! FRAME_TERMCAP_P (f))
- abort ();
+ emacs_abort ();
if (FRAME_FACE_CACHE (f))
free_frame_faces (f);
tty_free_frame_resources (struct frame *f)
{
if (! FRAME_TERMCAP_P (f) && ! FRAME_MSDOS_P (f))
- abort ();
+ emacs_abort ();
if (FRAME_FACE_CACHE (f))
free_frame_faces (f);
no_controlling_tty = 1;
#else
#ifdef TIOCNOTTY /* Try BSD ioctls. */
- sigblock (sigmask (SIGTTOU));
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGTTOU);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
fd = emacs_open (DEV_TTY, O_RDWR, 0);
if (fd != -1 && ioctl (fd, TIOCNOTTY, 0) != -1)
{
}
if (fd != -1)
emacs_close (fd);
- sigunblock (sigmask (SIGTTOU));
+ pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
#else
- /* Unknown system. */
- croak ();
+# error "Unknown system."
#endif /* ! TIOCNOTTY */
#endif /* ! USG */
}
been_here = 1;
tty = &the_only_display_info;
#else
- tty = (struct tty_display_info *) xmalloc (sizeof (struct tty_display_info));
+ tty = xzalloc (sizeof *tty);
#endif
- memset (tty, 0, sizeof (struct tty_display_info));
+ tty->top_frame = Qnil;
tty->next = tty_list;
tty_list = tty;
terminal->display_info.tty = tty;
tty->terminal = terminal;
- tty->Wcm = (struct cm *) xmalloc (sizeof (struct cm));
+ tty->Wcm = xmalloc (sizeof *tty->Wcm);
Wcm_clear (tty);
encode_terminal_src_size = 0;
Wcm_clear (tty);
- tty->termcap_term_buffer = (char *) xmalloc (buffer_size);
+ tty->termcap_term_buffer = xmalloc (buffer_size);
/* On some systems, tgetent tries to access the controlling
terminal. */
- sigblock (sigmask (SIGTTOU));
- status = tgetent (tty->termcap_term_buffer, terminal_type);
- sigunblock (sigmask (SIGTTOU));
+ {
+ sigset_t blocked;
+ sigemptyset (&blocked);
+ sigaddset (&blocked, SIGTTOU);
+ pthread_sigmask (SIG_BLOCK, &blocked, 0);
+ status = tgetent (tty->termcap_term_buffer, terminal_type);
+ pthread_sigmask (SIG_UNBLOCK, &blocked, 0);
+ }
if (status < 0)
{
#ifndef TERMINFO
if (strlen (tty->termcap_term_buffer) >= buffer_size)
- abort ();
+ emacs_abort ();
buffer_size = strlen (tty->termcap_term_buffer);
#endif
- tty->termcap_strings_buffer = area = (char *) xmalloc (buffer_size);
+ tty->termcap_strings_buffer = area = xmalloc (buffer_size);
tty->TS_ins_line = tgetstr ("al", address);
tty->TS_ins_multi_lines = tgetstr ("AL", address);
tty->TS_bell = tgetstr ("bl", address);
tty->TS_enter_underline_mode = tgetstr ("us", address);
tty->TS_exit_underline_mode = tgetstr ("ue", address);
tty->TS_enter_bold_mode = tgetstr ("md", address);
+ tty->TS_enter_italic_mode = tgetstr ("ZH", address);
tty->TS_enter_dim_mode = tgetstr ("mh", address);
- tty->TS_enter_blink_mode = tgetstr ("mb", address);
tty->TS_enter_reverse_mode = tgetstr ("mr", address);
tty->TS_enter_alt_charset_mode = tgetstr ("as", address);
tty->TS_exit_alt_charset_mode = tgetstr ("ae", address);
tty->mouse_highlight.mouse_face_window = Qnil;
#endif
- terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ terminal->kboard = xmalloc (sizeof *terminal->kboard);
init_kboard (terminal->kboard);
- KVAR (terminal->kboard, Vwindow_system) = Qnil;
+ kset_window_system (terminal->kboard, Qnil);
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
terminal->kboard->reference_count++;
verror (str1, ap);
va_end (ap);
- abort ();
+ emacs_abort ();
}
void
return;
if (terminal->type != output_termcap)
- abort ();
+ emacs_abort ();
tty = terminal->display_info.tty;
if (! p)
/* This should not happen. */
- abort ();
+ emacs_abort ();
p->next = tty->next;
tty->next = 0;
xfree (tty->termcap_strings_buffer);
xfree (tty->termcap_term_buffer);
- memset (tty, 0, sizeof (struct tty_display_info));
xfree (tty);
}
-\f
-
-/* Mark the pointers in the tty_display_info objects.
- Called by the Fgarbage_collector. */
-
-void
-mark_ttys (void)
-{
- struct tty_display_info *tty;
-
- for (tty = tty_list; tty; tty = tty->next)
- mark_object (tty->top_frame);
-}
-
-\f
-
void
syms_of_term (void)
{
#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;
defsubr (&Stty_no_underline);
defsubr (&Stty_type);
defsubr (&Scontrolling_tty_p);
+ defsubr (&Stty_top_frame);
defsubr (&Ssuspend_tty);
defsubr (&Sresume_tty);
#ifdef HAVE_GPM
/* Emacs config.h may rename various library functions such as malloc. */
#include <config.h>
-#include <setjmp.h>
#include <sys/file.h>
#include <fcntl.h>
#include <unistd.h>
#include "msdos.h"
#endif
-#ifndef NULL
-#define NULL (char *) 0
-#endif
-
/* BUFSIZE is the initial size allocated for the buffer
for reading the termcap file.
It is not a limit.
p = ptr;
while ((c = *p++) && c != ':' && c != '\n')
;
- ret = (char *) xmalloc (p - ptr + 1);
+ ret = xmalloc (p - ptr + 1);
}
else
ret = *area;
if (!bp)
{
malloc_size = 1 + strlen (term);
- bp = (char *) xmalloc (malloc_size);
+ bp = xmalloc (malloc_size);
}
strcpy (bp, term);
goto ret;
buf.size = BUFSIZE;
/* Add 1 to size to ensure room for terminating null. */
- buf.beg = (char *) xmalloc (buf.size + 1);
+ buf.beg = xmalloc (buf.size + 1);
term = indirect ? indirect : (char *)name;
if (!bp)
{
malloc_size = indirect ? strlen (tcenv) + 1 : buf.size;
- bp = (char *) xmalloc (malloc_size);
+ bp = xmalloc (malloc_size);
}
tc_search_point = bp1 = bp;
{
ptrdiff_t offset1 = bp1 - bp, offset2 = tc_search_point - bp;
malloc_size = offset1 + buf.size;
- bp = termcap_name = (char *) xrealloc (bp, malloc_size);
+ bp = termcap_name = xrealloc (bp, malloc_size);
bp1 = termcap_name + offset1;
tc_search_point = termcap_name + offset2;
}
xfree (buf.beg);
if (malloc_size)
- bp = (char *) xrealloc (bp, bp1 - bp + 1);
+ bp = xrealloc (bp, bp1 - bp + 1);
ret:
term_entry = bp;
\f
#ifdef TEST
-#ifdef NULL
-#undef NULL
-#endif
-
#include <stdio.h>
static void
each as vpos and hpos) */
const char *TS_enter_bold_mode; /* "md" -- turn on bold (extra bright mode). */
+ const char *TS_enter_italic_mode; /* "ZH" -- turn on italics mode. */
const char *TS_enter_dim_mode; /* "mh" -- turn on half-bright mode. */
- const char *TS_enter_blink_mode; /* "mb" -- enter blinking mode. */
const char *TS_enter_reverse_mode; /* "mr" -- enter reverse video mode. */
const char *TS_exit_underline_mode; /* "us" -- start underlining. */
const char *TS_enter_underline_mode; /* "ue" -- end underlining. */
(((f)->output_method == output_termcap \
|| (f)->output_method == output_msdos_raw) \
? (f)->terminal->display_info.tty \
- : (abort (), (struct tty_display_info *) 0))
+ : (emacs_abort (), (struct tty_display_info *) 0))
#define CURTTY() FRAME_TTY (SELECTED_FRAME())
#include "systime.h" /* for Time */
+INLINE_HEADER_BEGIN
+#ifndef TERMHOOKS_INLINE
+# define TERMHOOKS_INLINE INLINE
+#endif
+
struct glyph;
struct frame;
\f
For a HELP_EVENT, this is the position within the object
(stored in ARG below) where the help was found. */
/* In WindowsNT, for a mouse wheel event, this is the delta. */
- EMACS_INT code;
+ ptrdiff_t code;
enum scroll_bar_part part;
int modifiers; /* See enum below for interpretation. */
/* Called to read input events.
TERMINAL indicates which terminal device to read from. Input
- events should be read into BUF, the size of which is given in
- SIZE. EXPECTED is non-zero if the caller suspects that new input
- is available.
+ events should be read into HOLD_QUIT.
A positive return value indicates that that many input events
- where read into BUF.
+ were read into BUF.
Zero means no events were immediately available.
A value of -1 means a transient read error, while -2 indicates
- that the device was closed (hangup), and it should be deleted.
-
- XXX Please note that a non-zero value of EXPECTED only means that
- there is available input on at least one of the currently opened
- terminal devices -- but not necessarily on this device.
- Therefore, in most cases EXPECTED should be simply ignored.
-
- XXX This documentation needs to be updated. */
+ that the device was closed (hangup), and it should be deleted. */
int (*read_socket_hook) (struct terminal *terminal,
- int expected,
struct input_event *hold_quit);
/* Called when a frame's display becomes entirely up to date. */
void (*delete_terminal_hook) (struct terminal *);
};
+/* Most code should use these functions to set Lisp fields in struct
+ terminal. */
+TERMHOOKS_INLINE void
+tset_charset_list (struct terminal *t, Lisp_Object val)
+{
+ t->charset_list = val;
+}
+TERMHOOKS_INLINE void
+tset_selection_alist (struct terminal *t, Lisp_Object val)
+{
+ t->Vselection_alist = val;
+}
/* Chain of all terminal devices currently in use. */
extern struct terminal *terminal_list;
#ifdef HAVE_GPM
extern void close_gpm (int gpm_fd);
#endif
+
+INLINE_HEADER_END
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+
+#define TERMHOOKS_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "frame.h"
static void delete_initial_terminal (struct terminal *);
+/* This setter is used only in this file, so it can be private. */
+static inline void
+tset_param_alist (struct terminal *t, Lisp_Object val)
+{
+ t->param_alist = val;
+}
+
\f
void
struct terminal *terminal = allocate_terminal ();
Lisp_Object terminal_coding, keyboard_coding;
- terminal->name = NULL;
terminal->next_terminal = terminal_list;
terminal_list = terminal;
terminal->id = next_terminal_id++;
- terminal->keyboard_coding =
- (struct coding_system *) xmalloc (sizeof (struct coding_system));
- terminal->terminal_coding =
- (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ terminal->keyboard_coding = xmalloc (sizeof (struct coding_system));
+ terminal->terminal_coding = xmalloc (sizeof (struct coding_system));
/* If default coding systems for the terminal and the keyboard are
already defined, use them in preference to the defaults. This is
setup_coding_system (keyboard_coding, terminal->keyboard_coding);
setup_coding_system (terminal_coding, terminal->terminal_coding);
- terminal->param_alist = Qnil;
- terminal->charset_list = Qnil;
- terminal->Vselection_alist = Qnil;
return terminal;
}
for (tp = &terminal_list; *tp != terminal; tp = &(*tp)->next_terminal)
if (! *tp)
- abort ();
+ emacs_abort ();
*tp = terminal->next_terminal;
xfree (terminal->keyboard_coding);
case output_ns:
return Qns;
default:
- abort ();
+ emacs_abort ();
}
}
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_param_alist (t, Fcons (Fcons (parameter, value), t->param_alist));
return Qnil;
}
else
init_initial_terminal (void)
{
if (initialized || terminal_list || tty_list)
- abort ();
+ emacs_abort ();
initial_terminal = create_terminal ();
initial_terminal->type = output_initial;
delete_initial_terminal (struct terminal *terminal)
{
if (terminal != initial_terminal)
- abort ();
+ emacs_abort ();
delete_terminal (terminal);
initial_terminal = NULL;
#include <config.h>
#include "tparam.h"
-#include <setjmp.h>
#include "lisp.h"
/* Define these variables that serve as global parameters to termcap,
/* Emacs always should pass a null OUTSTRING and zero LEN. */
if (outstring || len)
- abort ();
+ emacs_abort ();
temp = tparm (string, arg1, arg2, arg3, arg4);
return xstrdup (temp);
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "intervals.h"
+#include "character.h"
#include "buffer.h"
#include "window.h"
-#ifndef NULL
-#define NULL (void *)0
-#endif
-
/* Test for membership, allowing for t (actually any non-cons) to mean the
universal set. */
static Lisp_Object interval_insert_behind_hooks;
static Lisp_Object interval_insert_in_front_hooks;
-static void text_read_only (Lisp_Object) NO_RETURN;
-static Lisp_Object Fprevious_property_change (Lisp_Object, Lisp_Object,
- Lisp_Object);
-
/* Signal a `text-read-only' error. This function makes it easier
to capture that error in GDB by putting a breakpoint on it. */
-static void
+static _Noreturn void
text_read_only (Lisp_Object propval)
{
if (STRINGP (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. */
validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *end, int force)
{
register INTERVAL i;
- EMACS_INT searchpos;
+ ptrdiff_t searchpos;
CHECK_STRING_OR_BUFFER (object);
CHECK_NUMBER_COERCE_MARKER (*begin);
/* 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))
{
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_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);
}
else
{
- EMACS_INT len = SCHARS (object);
+ ptrdiff_t len = SCHARS (object);
if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
&& XINT (*end) <= len))
XSETFASTINT (*begin, XFASTINT (*begin));
if (begin != end)
XSETFASTINT (*end, XFASTINT (*end));
- i = STRING_INTERVALS (object);
+ i = string_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);
/* Go through each element of LIST. */
for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
{
- sym = Fcar (tail1);
+ sym = XCAR (tail1);
/* Go through i's plist, looking for tail1 */
for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
}
/* Store new properties. */
- interval->plist = Fcopy_sequence (properties);
+ set_interval_plist (interval, Fcopy_sequence (properties));
}
/* Add the properties of PLIST to the interval I, or set
record_property_change (i->position, LENGTH (i),
sym1, Qnil, object);
}
- i->plist = Fcons (sym1, Fcons (val1, i->plist));
+ set_interval_plist (i, Fcons (sym1, Fcons (val1, i->plist)));
changed++;
}
}
}
if (changed)
- i->plist = current_plist;
+ set_interval_plist (i, current_plist);
return changed;
}
-
-#if 0
-/* Remove all properties from interval I. Return non-zero
- if this changes the interval. */
-
-static inline int
-erase_properties (INTERVAL i)
-{
- if (NILP (i->plist))
- return 0;
-
- i->plist = Qnil;
- return 1;
-}
-#endif
\f
/* Returns the interval of POSITION in OBJECT.
POSITION is BEG-based. */
INTERVAL
-interval_of (EMACS_INT position, Lisp_Object object)
+interval_of (ptrdiff_t position, Lisp_Object object)
{
register INTERVAL i;
- EMACS_INT beg, end;
+ ptrdiff_t beg, end;
if (NILP (object))
XSETBUFFER (object, current_buffer);
else if (EQ (object, Qt))
- return NULL_INTERVAL;
+ return NULL;
CHECK_STRING_OR_BUFFER (object);
beg = BUF_BEGV (b);
end = BUF_ZV (b);
- i = BUF_INTERVALS (b);
+ i = buffer_intervals (b);
}
else
{
beg = 0;
end = SCHARS (object);
- i = STRING_INTERVALS (object);
+ i = string_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);
}
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.
DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0,
doc: /* Return the value of POSITION's property PROP, in OBJECT.
-OBJECT is optional and defaults to the current buffer.
+OBJECT should be a buffer or a string; if omitted or nil, it defaults
+to the current buffer.
If POSITION is at the end of OBJECT, the value is nil. */)
(Lisp_Object position, Lisp_Object prop, Lisp_Object object)
{
else
{
Lisp_Object initial_value, value;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (! NILP (object))
CHECK_BUFFER (object);
if (BUFFERP (object) && current_buffer != XBUFFER (object))
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (object);
}
}
else
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (! NILP (object))
CHECK_BUFFER (object);
if (BUFFERP (object) && current_buffer != XBUFFER (object))
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (object);
}
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))));
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)
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)
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. */
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)
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)
(Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
{
register INTERVAL i, unchanged;
- register EMACS_INT s, len;
+ register ptrdiff_t s, len;
register int modified = 0;
struct gcpro gcpro1;
XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, hard);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return Qnil;
s = XINT (start);
skip it. */
if (interval_has_all_properties (properties, i))
{
- EMACS_INT got = (LENGTH (i) - (s - i->position));
+ ptrdiff_t got = (LENGTH (i) - (s - i->position));
if (got >= len)
RETURN_UNGCPRO (Qnil);
len -= got;
/* We are at the beginning of interval I, with LEN chars to scan. */
for (;;)
{
- if (i == 0)
- abort ();
+ eassert (i != 0);
if (LENGTH (i) >= len)
{
&& XFASTINT (start) == 0
&& XFASTINT (end) == SCHARS (object))
{
- if (! STRING_INTERVALS (object))
+ if (!string_intervals (object))
return Qnil;
- STRING_SET_INTERVALS (object, NULL_INTERVAL);
+ set_string_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))
i = validate_interval_range (object, &start, &end, hard);
/* This can return if start == end. */
- if (NULL_INTERVAL_P (i))
+ if (!i)
return Qnil;
}
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 EMACS_INT s, len;
+ register INTERVAL prev_changed = NULL;
+ register ptrdiff_t s, len;
INTERVAL unchanged;
if (XINT (start) < XINT (end))
else
return;
- if (i == 0)
- i = find_interval (BUF_INTERVALS (XBUFFER (buffer)), s);
+ if (i == NULL)
+ i = find_interval (buffer_intervals (XBUFFER (buffer)), s);
if (i->position != s)
{
/* We are starting at the beginning of an interval I. LEN is positive. */
do
{
- if (i == 0)
- abort ();
+ eassert (i != 0);
if (LENGTH (i) >= len)
{
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;
}
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);
(Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object)
{
register INTERVAL i, unchanged;
- register EMACS_INT s, len;
+ register ptrdiff_t s, len;
register int modified = 0;
if (NILP (object))
XSETBUFFER (object, current_buffer);
i = validate_interval_range (object, &start, &end, soft);
- if (NULL_INTERVAL_P (i))
+ if (!i)
return Qnil;
s = XINT (start);
it covers the entire region. */
if (! interval_has_some_properties (properties, i))
{
- EMACS_INT got = (LENGTH (i) - (s - i->position));
+ ptrdiff_t got = (LENGTH (i) - (s - i->position));
if (got >= len)
return Qnil;
len -= got;
/* We are at the beginning of an interval, with len to scan */
for (;;)
{
- if (i == 0)
- abort ();
+ eassert (i != 0);
if (LENGTH (i) >= len)
{
(Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object)
{
register INTERVAL i, unchanged;
- register EMACS_INT s, len;
+ register ptrdiff_t s, len;
register int modified = 0;
Lisp_Object properties;
properties = list_of_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);
it covers the entire region. */
if (! interval_has_some_properties_list (properties, i))
{
- EMACS_INT got = (LENGTH (i) - (s - i->position));
+ ptrdiff_t got = (LENGTH (i) - (s - i->position));
if (got >= len)
return Qnil;
len -= got;
and we call signal_after_change before returning if modified != 0. */
for (;;)
{
- if (i == 0)
- abort ();
+ eassert (i != 0);
if (LENGTH (i) >= len)
{
(Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
{
register INTERVAL i;
- register EMACS_INT e, pos;
+ register ptrdiff_t e, pos;
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;
(Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
{
register INTERVAL i;
- register EMACS_INT s, e;
+ register ptrdiff_t s, e;
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;
Lisp_Object res;
Lisp_Object stuff;
Lisp_Object plist;
- EMACS_INT s, e, e2, p, len;
+ ptrdiff_t s, e, e2, p, len;
int modified = 0;
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);
{
Lisp_Object dest_start, dest_end;
+ e = XINT (pos) + (XINT (end) - XINT (start));
+ if (MOST_POSITIVE_FIXNUM < e)
+ args_out_of_range (pos, end);
dest_start = pos;
- XSETFASTINT (dest_end, XINT (dest_start) + (XINT (end) - XINT (start)));
+ XSETFASTINT (dest_end, e);
/* Apply this to a copy of pos; it will try to increment its arguments,
which we don't want. */
validate_interval_range (dest, &dest_start, &dest_end, soft);
}
i = next_interval (i);
- if (NULL_INTERVAL_P (i))
+ if (!i)
break;
p += len;
result = Qnil;
i = validate_interval_range (object, &start, &end, soft);
- if (!NULL_INTERVAL_P (i))
+ if (i)
{
- EMACS_INT s = XINT (start);
- EMACS_INT e = XINT (end);
+ ptrdiff_t s = XINT (start);
+ ptrdiff_t e = XINT (end);
while (s < e)
{
- EMACS_INT interval_end, len;
+ ptrdiff_t interval_end, len;
Lisp_Object plist;
interval_end = i->position + LENGTH (i);
result);
i = next_interval (i);
- if (NULL_INTERVAL_P (i))
+ if (!i)
break;
s = i->position;
}
extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
{
Lisp_Object prev = Qnil, head = list;
- EMACS_INT max = XINT (new_end);
+ ptrdiff_t max = XINT (new_end);
for (; CONSP (list); prev = list, list = XCDR (list))
{
void
verify_interval_modification (struct buffer *buf,
- EMACS_INT start, EMACS_INT end)
+ ptrdiff_t start, ptrdiff_t end)
{
- register INTERVAL intervals = BUF_INTERVALS (buf);
- register INTERVAL i;
+ INTERVAL intervals = buffer_intervals (buf);
+ INTERVAL i;
Lisp_Object hooks;
- register Lisp_Object prev_mod_hooks;
+ Lisp_Object prev_mod_hooks;
Lisp_Object mod_hooks;
struct gcpro gcpro1;
interval_insert_behind_hooks = Qnil;
interval_insert_in_front_hooks = Qnil;
- if (NULL_INTERVAL_P (intervals))
+ if (!intervals)
return;
if (start > end)
{
- EMACS_INT temp = start;
+ ptrdiff_t temp = start;
start = end;
end = temp;
}
indirectly defined via the category property. */
if (i != prev)
{
- if (! NULL_INTERVAL_P (i))
+ if (i)
{
after = textget (i->plist, Qread_only);
}
}
- if (! NULL_INTERVAL_P (prev))
+ if (prev)
{
before = textget (prev->plist, Qread_only);
}
}
}
- else if (! NULL_INTERVAL_P (i))
+ else if (i)
{
after = textget (i->plist, Qread_only);
}
/* 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);
}
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)
{
/* Emacs config.h may rename various library functions such as malloc. */
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h" /* for xmalloc */
#include "tparam.h"
-
-#ifndef NULL
-#define NULL (char *) 0
-#endif
\f
/* Assuming STRING is the value of a termcap string entry
containing `%' constructs to expand parameters,
if (outlen == 0)
{
outlen = len + 40;
- new = (char *) xmalloc (outlen);
+ new = xmalloc (outlen);
memcpy (new, outstring, offset);
}
else
break;
default:
- abort ();
+ emacs_abort ();
}
}
else
#include <config.h>
-#include <setjmp.h>
+
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "commands.h"
#include "window.h"
/* Position of point last time we inserted a boundary. */
static struct buffer *last_boundary_buffer;
-static EMACS_INT last_boundary_position;
+static ptrdiff_t last_boundary_position;
Lisp_Object Qinhibit_read_only;
undo record that will be added just after this command terminates. */
static void
-record_point (EMACS_INT pt)
+record_point (ptrdiff_t pt)
{
int at_boundary;
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_undo_list (current_buffer,
+ Fcons (make_number (last_boundary_position),
+ BVAR (current_buffer, undo_list)));
}
/* Record an insertion that just happened or is about to happen,
because we don't need to record the contents.) */
void
-record_insert (EMACS_INT beg, EMACS_INT length)
+record_insert (ptrdiff_t beg, ptrdiff_t length)
{
Lisp_Object lbeg, lend;
XSETFASTINT (lbeg, beg);
XSETINT (lend, beg + length);
- BVAR (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend),
- BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer,
+ Fcons (Fcons (lbeg, lend), BVAR (current_buffer, undo_list)));
}
/* Record that a deletion is about to take place,
of the characters in STRING, at location BEG. */
void
-record_delete (EMACS_INT beg, Lisp_Object string)
+record_delete (ptrdiff_t beg, Lisp_Object string)
{
Lisp_Object sbeg;
record_point (beg);
}
- BVAR (current_buffer, undo_list)
- = Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list));
+ bset_undo_list
+ (current_buffer,
+ Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)));
}
/* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
won't be inverted automatically by undoing the buffer modification. */
void
-record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment)
+record_marker_adjustment (Lisp_Object marker, ptrdiff_t adjustment)
{
if (EQ (BVAR (current_buffer, undo_list), Qt))
return;
Fundo_boundary ();
last_undo_buffer = current_buffer;
- BVAR (current_buffer, undo_list)
- = Fcons (Fcons (marker, make_number (adjustment)),
- BVAR (current_buffer, undo_list));
+ bset_undo_list
+ (current_buffer,
+ Fcons (Fcons (marker, make_number (adjustment)),
+ BVAR (current_buffer, undo_list)));
}
/* Record that a replacement is about to take place,
The replacement must not change the number of characters. */
void
-record_change (EMACS_INT beg, EMACS_INT length)
+record_change (ptrdiff_t beg, ptrdiff_t length)
{
record_delete (beg, make_buffer_string (beg, beg + length, 1));
record_insert (beg, length);
if (base_buffer->base_buffer)
base_buffer = base_buffer->base_buffer;
- BVAR (current_buffer, undo_list) =
- Fcons (Fcons (Qt, INTEGER_TO_CONS (base_buffer->modtime)),
- BVAR (current_buffer, undo_list));
+ bset_undo_list
+ (current_buffer,
+ 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)
for LENGTH characters starting at position BEG in BUFFER. */
void
-record_property_change (EMACS_INT beg, EMACS_INT length,
+record_property_change (ptrdiff_t beg, ptrdiff_t length,
Lisp_Object prop, Lisp_Object value,
Lisp_Object buffer)
{
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_undo_list (current_buffer,
+ Fcons (entry, BVAR (current_buffer, undo_list)));
current_buffer = obuf;
}
/* 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_undo_list (current_buffer, pending_boundary);
pending_boundary = Qnil;
}
else
- BVAR (current_buffer, undo_list) = Fcons (Qnil, BVAR (current_buffer, undo_list));
+ bset_undo_list (current_buffer,
+ Fcons (Qnil, BVAR (current_buffer, undo_list)));
}
last_boundary_position = PT;
last_boundary_buffer = current_buffer;
{
Lisp_Object list;
Lisp_Object prev, next, last_boundary;
- int size_so_far = 0;
+ EMACS_INT size_so_far = 0;
/* Make sure that calling undo-outer-limit-function
won't cause another GC. */
- int count = inhibit_garbage_collection ();
+ ptrdiff_t count = inhibit_garbage_collection ();
/* Make the buffer current to get its local values of variables such
as undo_limit. Also so that Vundo_outer_limit_function can
tell which buffer to operate on. */
- record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
set_buffer_internal (b);
list = BVAR (b, undo_list);
XSETCDR (last_boundary, Qnil);
/* There's nothing we decided to keep, so clear it out. */
else
- BVAR (b, undo_list) = Qnil;
+ bset_undo_list (b, Qnil);
unbind_to (count, Qnil);
}
+
+static _Noreturn void
+user_error (const char *msg)
+{
+ xsignal1 (Quser_error, build_string (msg));
+}
+
\f
DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
doc: /* Undo N records from the front of the list LIST.
{
struct gcpro gcpro1, gcpro2;
Lisp_Object next;
- int count = SPECPDL_INDEX ();
- register int arg;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ register EMACS_INT arg;
Lisp_Object oldlist;
int did_apply = 0;
cdr = XCDR (next);
if (EQ (car, Qt))
{
- /* Element (t high . low) records previous modtime. */
+ /* Element (t . TIME) records previous modtime.
+ Preserve any flag of NONEXISTENT_MODTIME_NSECS or
+ UNKNOWN_MODTIME_NSECS. */
struct buffer *base_buffer = current_buffer;
- time_t mod_time;
- CONS_TO_INTEGER (cdr, time_t, mod_time);
+ EMACS_TIME mod_time;
+
+ if (CONSP (cdr)
+ && CONSP (XCDR (cdr))
+ && CONSP (XCDR (XCDR (cdr)))
+ && CONSP (XCDR (XCDR (XCDR (cdr))))
+ && INTEGERP (XCAR (XCDR (XCDR (XCDR (cdr)))))
+ && XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) < 0)
+ mod_time =
+ (make_emacs_time
+ (0, XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) / 1000));
+ else
+ mod_time = lisp_time_argument (cdr);
if (current_buffer->base_buffer)
base_buffer = current_buffer->base_buffer;
/* If this records an obsolete save
(not matching the actual disk file)
then don't mark unmodified. */
- if (mod_time != base_buffer->modtime)
+ if (EMACS_TIME_NE (mod_time, base_buffer->modtime))
continue;
#ifdef CLASH_DETECTION
Funlock_buffer ();
end = Fcdr (cdr);
if (XINT (beg) < BEGV || XINT (end) > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
Fput_text_property (beg, end, prop, val, Qnil);
}
else if (INTEGERP (car) && INTEGERP (cdr))
if (XINT (car) < BEGV
|| XINT (cdr) > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
/* Set point first thing, so that undoing this undo
does not send point back to where it is now. */
Fgoto_char (car);
if (pos < 0)
{
if (-pos < BEGV || -pos > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
SET_PT (-pos);
Finsert (1, &membuf);
}
else
{
if (pos < BEGV || pos > ZV)
- error ("Changes to be undone are outside visible portion of buffer");
+ user_error ("Changes to be undone are outside visible portion of buffer");
SET_PT (pos);
/* Now that we record marker adjustments
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_undo_list
+ (current_buffer,
+ Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list)));
UNGCPRO;
return unbind_to (count, list);
#include <unistd.h>
#include <fcntl.h>
+#include "mem-limits.h"
+
char *start_of_text (void); /* Start of text */
-extern char *start_of_data (void); /* Start of initialized data */
extern int _data;
extern int _text;
static long load_scnptr;
static long orig_load_scnptr;
static long orig_data_scnptr;
-static int unrelocate_symbols (int, int, char *, char *);
+static int unrelocate_symbols (int, int, const char *, const char *);
#ifndef MAX_SECTIONS
#define MAX_SECTIONS 10
#endif
-static int adjust_lnnoptrs (int, int, char *);
+static int adjust_lnnoptrs (int, int, const char *);
static int pagemask;
-#include <setjmp.h>
#include "lisp.h"
static void
-report_error (char *file, int fd)
+report_error (const char *file, int fd)
{
if (fd)
close (fd);
#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1
static void
-report_error_1 (int fd, char *msg, int a1, int a2)
+report_error_1 (int fd, const char *msg, int a1, int a2)
{
close (fd);
error (msg, a1, a2);
}
-static int make_hdr (int, int, char *, char *);
-static void mark_x (char *);
+static int make_hdr (int, int, const char *, const char *);
+static void mark_x (const char *);
static int copy_text_and_data (int);
-static int copy_sym (int, int, char *, char *);
+static int copy_sym (int, int, const char *, const char *);
static void write_segment (int, char *, char *);
\f
/* ****************************************************************
*/
static int
make_hdr (int new, int a_out,
- char *a_name, char *new_name)
+ const char *a_name, const char *new_name)
{
int scns;
unsigned int bss_start;
* Copy the relocation information and symbol table from the a.out to the new
*/
static int
-copy_sym (int new, int a_out, char *a_name, char *new_name)
+copy_sym (int new, int a_out, const char *a_name, const char *new_name)
{
char page[UnexBlockSz];
int n;
* After successfully building the new a.out, mark it executable
*/
static void
-mark_x (char *name)
+mark_x (const char *name)
{
struct stat sbuf;
int um;
}
\f
static int
-adjust_lnnoptrs (int writedesc, int readdesc, char *new_name)
+adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name)
{
int nsyms;
int naux;
}
static int
-unrelocate_symbols (int new, int a_out, char *a_name, char *new_name)
+unrelocate_symbols (int new, int a_out,
+ const char *a_name, const char *new_name)
{
int i;
LDHDR ldhdr;
#include <sys/file.h>
-extern char *start_of_data (void); /* Start of initialized data */
+#include "mem-limits.h"
static long block_copy_start; /* Old executable start point */
static struct filehdr f_hdr; /* File header */
#define ADDR_CORRECT(x) ((char *)(x) - (char*)0)
-#include <setjmp.h>
#include "lisp.h"
static void
#include <config.h>
#include "unexec.h"
-#include <setjmp.h>
#include <lisp.h>
#include <stdio.h>
#include <fcntl.h>
#endif
#ifndef ElfW
-# ifdef __STDC__
-# define ElfBitsW(bits, type) Elf##bits##_##type
-# else
-# define ElfBitsW(bits, type) Elf/**/bits/**/_/**/type
-# endif
+# define ElfBitsW(bits, type) Elf##bits##_##type
# ifdef _LP64
# define ELFSIZE 64
# else
static struct segment_command *data_segment_scp;
-static void unexec_error (const char *format, ...) NO_RETURN;
-
/* Read N bytes from infd into memory starting at address DEST.
Return true if successful, false otherwise. */
static int
/* Debugging and informational messages routines. */
-static void
+static _Noreturn void
unexec_error (const char *format, ...)
{
va_list ap;
}
else
{
- r = (struct region_t *) malloc (sizeof (struct region_t));
+ r = malloc (sizeof *r);
if (!r)
unexec_error ("cannot allocate region structure");
#endif
nlc = mh.ncmds;
- lca = (struct load_command **) malloc (nlc * sizeof (struct load_command *));
+ lca = malloc (nlc * sizeof *lca);
for (i = 0; i < nlc; i++)
{
size first and then read the rest. */
if (!unexec_read (&lc, sizeof (struct load_command)))
unexec_error ("cannot read load command");
- lca[i] = (struct load_command *) malloc (lc.cmdsize);
+ lca[i] = malloc (lc.cmdsize);
memcpy (lca[i], &lc, sizeof (struct load_command));
if (!unexec_read (lca[i] + 1, lc.cmdsize - sizeof (struct load_command)))
unexec_error ("cannot read content of load command");
{
sectp->flags = S_REGULAR;
if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size))
- unexec_error ("cannot write section %s", sectp->sectname);
+ unexec_error ("cannot write section %.16s", sectp->sectname);
if (!unexec_write (header_offset, sectp, sizeof (struct section)))
- unexec_error ("cannot write section %s's header", sectp->sectname);
+ unexec_error ("cannot write section %.16s's header", sectp->sectname);
}
else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0)
{
my_size = (unsigned long)my_endbss_static - sectp->addr;
if (!(sectp->addr <= (unsigned long)my_endbss_static
&& my_size <= sectp->size))
- unexec_error ("my_endbss_static is not in section %s",
+ unexec_error ("my_endbss_static is not in section %.16s",
sectp->sectname);
if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size))
- unexec_error ("cannot write section %s", sectp->sectname);
+ unexec_error ("cannot write section %.16s", sectp->sectname);
if (!unexec_write_zero (sectp->offset + my_size,
sectp->size - my_size))
- unexec_error ("cannot write section %s", sectp->sectname);
+ unexec_error ("cannot write section %.16s", sectp->sectname);
if (!unexec_write (header_offset, sectp, sizeof (struct section)))
- unexec_error ("cannot write section %s's header", sectp->sectname);
+ unexec_error ("cannot write section %.16s's header", sectp->sectname);
}
else if (strncmp (sectp->sectname, "__la_symbol_ptr", 16) == 0
|| strncmp (sectp->sectname, "__nl_symbol_ptr", 16) == 0
|| strncmp (sectp->sectname, "__cfstring", 16) == 0
|| strncmp (sectp->sectname, "__gcc_except_tab", 16) == 0
|| strncmp (sectp->sectname, "__program_vars", 16) == 0
+ || strncmp (sectp->sectname, "__mod_init_func", 16) == 0
+ || strncmp (sectp->sectname, "__mod_term_func", 16) == 0
|| strncmp (sectp->sectname, "__objc_", 7) == 0)
{
if (!unexec_copy (sectp->offset, old_file_offset, sectp->size))
- unexec_error ("cannot copy section %s", sectp->sectname);
+ unexec_error ("cannot copy section %.16s", sectp->sectname);
if (!unexec_write (header_offset, sectp, sizeof (struct section)))
- unexec_error ("cannot write section %s's header", sectp->sectname);
+ unexec_error ("cannot write section %.16s's header", sectp->sectname);
}
else
- unexec_error ("unrecognized section name in __DATA segment");
+ unexec_error ("unrecognized section %.16s in __DATA segment",
+ sectp->sectname);
printf (" section %-16.16s at %#8lx - %#8lx (sz: %#8lx)\n",
sectp->sectname, (long) (sectp->offset),
size_t old_size = ((unexec_malloc_header_t *) old_ptr)[-1].u.size;
size_t size = new_size > old_size ? old_size : new_size;
- p = (size_t *) malloc (new_size);
+ p = malloc (new_size);
if (size)
memcpy (p, old_ptr, size);
}
#include "unexec.h"
#include <dlfcn.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
-#include <setjmp.h>
+#include <unistd.h> /* for 'environ', on AIX */
#include "lisp.h"
#include "mem-limits.h"
enum warnlevel { not_warned, warned_75, warned_85, warned_95 };
static enum warnlevel warnlevel;
-typedef POINTER_TYPE *POINTER;
+typedef void *POINTER;
/* Function to call to issue a warning;
0 means don't issue them. */
* is known to live at or near the start of the system crt0.c, and
* we don't sweat the handful of bytes that might lose.
*/
- extern char **environ;
return ((POINTER) &environ);
#else
extern int data_start;
#include <dpmi.h>
#include <go32.h>
#include <sys/farptr.h>
-#include <setjmp.h>
#include "lisp.h"
#include "dispextern.h" /* frame.h seems to want this */
#include "frame.h" /* Need this to get the X window of selected_frame */
#include "blockinput.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "composite.h"
if ( !FRAME_MSDOS_P (XFRAME (frame)))
goto done;
- BLOCK_INPUT;
+ block_input ();
if (!open_clipboard ())
goto error;
setup_coding_system (Fcheck_coding_system (coding_system), &coding);
coding.dst_bytes = nbytes * 4;
- coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+ coding.destination = xmalloc (coding.dst_bytes);
Vnext_selection_coding_system = Qnil;
coding.mode |= CODING_MODE_LAST_BLOCK;
dst = coding.destination;
unblock:
xfree (dst);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Notify user if the text is too large to fit into DOS memory.
(This will happen somewhere after 600K bytes (470K in DJGPP v1.x),
if ( !FRAME_MSDOS_P (XFRAME (frame)))
goto done;
- BLOCK_INPUT;
+ block_input ();
if (!open_clipboard ())
goto unblock;
if ((data_size = get_clipboard_data_size (CF_OEMTEXT)) == 0 ||
- (htext = (unsigned char *)xmalloc (data_size)) == 0)
+ (htext = xmalloc (data_size)) == 0)
goto closeclip;
/* need to know final size after '\r' chars are removed because
close_clipboard ();
unblock:
- UNBLOCK_INPUT;
+ unblock_input ();
done:
-/* Utility and Unix shadow routines for GNU Emacs on the Microsoft W32 API.
+/* Utility and Unix shadow routines for GNU Emacs on the Microsoft Windows API.
Copyright (C) 1994-1995, 2000-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <sys/utime.h>
#include <mbstring.h> /* for _mbspbrk */
#include <math.h>
-#include <setjmp.h>
#include <time.h>
/* must include CRT headers *before* config.h */
} PROCESS_MEMORY_COUNTERS_EX,*PPROCESS_MEMORY_COUNTERS_EX;
#endif
+#include <winioctl.h>
+#include <aclapi.h>
+
+#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 <sys/socket.h>
#undef socket
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);
\f
/* Initialization states.
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;
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
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,
LPFILETIME lpIdleTime,
LPFILETIME lpKernelTime,
LPFILETIME lpUserTime);
+typedef BOOLEAN (WINAPI *CreateSymbolicLink_Proc) (
+ LPTSTR lpSymlinkFileName,
+ LPTSTR lpTargetFileName,
+ DWORD dwFlags);
/* ** A utility function ** */
static BOOL
return s_b_ret;
}
+static Lisp_Object ltime (ULONGLONG);
+
/* Get total user and system times for get-internal-run-time.
- Returns a list of three integers if the times are provided by the OS
+ Returns a list of integers if the times are provided by the OS
(NT derivatives), otherwise it returns the result of current-time. */
Lisp_Object
w32_get_internal_run_time (void)
if ((*get_process_times_fn) (proc, &create, &exit, &kernel, &user))
{
LARGE_INTEGER user_int, kernel_int, total;
- int microseconds;
user_int.LowPart = user.dwLowDateTime;
user_int.HighPart = user.dwHighDateTime;
kernel_int.LowPart = kernel.dwLowDateTime;
kernel_int.HighPart = kernel.dwHighDateTime;
total.QuadPart = user_int.QuadPart + kernel_int.QuadPart;
- /* FILETIME is 100 nanosecond increments, Emacs only wants
- microsecond resolution. */
- total.QuadPart /= 10;
- microseconds = total.QuadPart % 1000000;
- total.QuadPart /= 1000000;
-
- /* Sanity check to make sure we can represent the result. */
- if (total.HighPart == 0)
- {
- int secs = total.LowPart;
-
- return list3 (make_number ((secs >> 16) & 0xffff),
- make_number (secs & 0xffff),
- make_number (microseconds));
- }
+ return ltime (total.QuadPart);
}
}
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,
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;
+}
\f
/* Equivalent of strerror for W32 error codes. */
char *
return dir;
return NULL;
#else
- /* Emacs doesn't actually change directory itself, and we want to
- force our real wd to be where emacs.exe is to avoid unnecessary
- conflicts when trying to rename or delete directories. */
+ /* Emacs doesn't actually change directory itself, it stays in the
+ same directory where it was started. */
strcpy (dir, startup_dir);
return dir;
#endif
/* Ensure HOME and SHELL are defined. */
if (getenv ("HOME") == NULL)
- abort ();
+ emacs_abort ();
if (getenv ("SHELL") == NULL)
- abort ();
+ emacs_abort ();
/* Set dir and shell from environment variables. */
strcpy (dflt_passwd.pw_dir, getenv ("HOME"));
}
/* Routines that are no-ops on NT but are defined to get Emacs to compile. */
-
-int
-sigsetmask (int signal_mask)
-{
- return 0;
-}
-
-int
-sigmask (int sig)
-{
- return 0;
-}
-
-int
-sigblock (int sig)
-{
- return 0;
-}
-
-int
-sigunblock (int sig)
-{
- return 0;
-}
-
int
sigemptyset (sigset_t *set)
{
+ *set = 0;
return 0;
}
lpvalue = NULL;
if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS
- && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL
+ && (lpvalue = xmalloc (cbData)) != NULL
&& RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS)
{
RegCloseKey (hrootkey);
lpvalue = NULL;
if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS
- && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL
+ && (lpvalue = xmalloc (cbData)) != NULL
&& RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS)
{
RegCloseKey (hrootkey);
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. */
-#ifdef _MSC_VER
- /* MSVC's _access crashes with D_OK. */
+
+ /* MSVCRT's _access crashes with D_OK. */
if (tmp && sys_access (tmp, D_OK) == 0)
-#else
- if (tmp && _access (tmp, D_OK) == 0)
-#endif
{
char * var = alloca (strlen (tmp) + 8);
sprintf (var, "TMPDIR=%s", tmp);
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},
};
}
}
- /* 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];
if (!GetModuleFileName (NULL, modname, MAX_PATH))
- abort ();
+ emacs_abort ();
if ((p = strrchr (modname, '\\')) == NULL)
- abort ();
+ emacs_abort ();
*p = 0;
if ((p = strrchr (modname, '\\')) && xstrcasecmp (p, "\\bin") == 0)
dwType = REG_EXPAND_SZ;
dont_free = 1;
if (!strcmp (env_vars[i].name, "HOME") && !appdata)
- {
- Lisp_Object warning[2];
- warning[0] = intern ("initialization");
- warning[1] = build_string ("Setting HOME to C:\\ by default is deprecated");
- Vdelayed_warnings_list = Fcons (Flist (2, warning),
- Vdelayed_warnings_list);
- }
+ Vdelayed_warnings_list
+ = Fcons (listn (CONSTYPE_HEAP, 2,
+ intern ("initialization"),
+ build_string ("Setting HOME to C:\\ by default is deprecated")),
+ Vdelayed_warnings_list);
}
if (lpval)
memcpy (*envp, "COMSPEC=", 8);
}
- /* Remember the initial working directory for getwd, then make the
- real wd be the location of emacs.exe to avoid conflicts when
- renaming or deleting directories. (We also don't call chdir when
- running subprocesses for the same reason.) */
+ /* 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 ();
+ emacs_abort ();
{
- char *p;
static char modname[MAX_PATH];
if (!GetModuleFileName (NULL, modname, MAX_PATH))
- abort ();
- if ((p = strrchr (modname, '\\')) == NULL)
- abort ();
- *p = 0;
-
- SetCurrentDirectory (modname);
-
- /* Ensure argv[0] has the full path to Emacs. */
- *p = '\\';
+ emacs_abort ();
argv[0] = modname;
}
init_user_info ();
}
+/* Called from expand-file-name when default-directory is not a string. */
+
char *
emacs_root_dir (void)
{
p = getenv ("emacs_dir");
if (p == NULL)
- abort ();
+ emacs_abort ();
strcpy (root_dir, p);
root_dir[parse_root (root_dir, NULL)] = '\0';
dostounix_filename (root_dir);
changed. We could fix that by using GetSystemTime and
GetTimeZoneInformation, but that doesn't seem necessary, since
Emacs always calls gettimeofday with the 2nd argument NULL (see
- EMACS_GET_TIME). */
+ current_emacs_time). */
if (tz)
{
tz->tz_minuteswest = tb.timezone; /* minutes west of Greenwich */
}
}
+/* Emulate fdutimens. */
+
+/* Set the access and modification time stamps of FD (a.k.a. FILE) to be
+ TIMESPEC[0] and TIMESPEC[1], respectively.
+ FD must be either negative -- in which case it is ignored --
+ or a file descriptor that is open on FILE.
+ If FD is nonnegative, then FILE can be NULL, which means
+ use just futimes instead of utimes.
+ If TIMESPEC is null, FAIL.
+ Return 0 on success, -1 (setting errno) on failure. */
+
+int
+fdutimens (int fd, char const *file, struct timespec const timespec[2])
+{
+ struct _utimbuf ut;
+
+ if (!timespec)
+ {
+ errno = ENOSYS;
+ return -1;
+ }
+ if (fd < 0 && !file)
+ {
+ errno = EBADF;
+ return -1;
+ }
+ ut.actime = timespec[0].tv_sec;
+ ut.modtime = timespec[1].tv_sec;
+ if (fd >= 0)
+ return _futime (fd, &ut);
+ else
+ return _utime (file, &ut);
+}
+
+
/* ------------------------------------------------------------------------- */
-/* IO support and wrapper functions for W32 API. */
+/* IO support and wrapper functions for the Windows API. */
/* ------------------------------------------------------------------------- */
/* Place a wrapper around the MSVC version of ctime. It returns NULL
entry if present. */
if (info == NULL)
{
- info = (volume_info_data *) xmalloc (sizeof (volume_info_data));
+ info = xmalloc (sizeof (volume_info_data));
add_volume_info (root_dir, info);
}
else
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)
{
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;
}
/* 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)
{
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)
{
{
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 */
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);
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;
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)
{
DWORD attributes;
- /* MSVC implementation doesn't recognize D_OK. */
+ /* 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)
{
- /* Should try mapping GetLastError to errno; for now just indicate
- that path doesn't exist. */
- errno = EACCES;
+ 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:
+ errno = EACCES;
+ break;
+ }
return -1;
}
if ((mode & X_OK) != 0 && !is_exec (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
/* volume_info is set indirectly by map_w32_filename. */
oldname_dev = volume_info.serialnum;
- if (os_subtype == OS_WIN95)
+ if (os_subtype == OS_9X)
{
char * o;
char * p;
if (result < 0)
{
+ DWORD w32err = GetLastError ();
if (errno == EACCES
&& newname_dev != oldname_dev)
DWORD attributes;
if ((attributes = GetFileAttributes (temp)) != -1
- && attributes & FILE_ATTRIBUTE_DIRECTORY)
+ && (attributes & FILE_ATTRIBUTE_DIRECTORY))
errno = EXDEV;
}
else if (errno == EEXIST)
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;
doesn't resolve aliasing due to subst commands, or recognize hard
links. */
if (!w32_get_long_filename ((char *)name, fullname, MAX_PATH))
- abort ();
+ emacs_abort ();
parse_root (fullname, &p);
/* Normal W32 filesystems are still case insensitive. */
#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;
/* 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)
{
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
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);
-
- if (attrs == -1)
- return -1;
-
- 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;
-
- /* (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);
- }
- }
-
+ /* 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);
+
+ /* Plan A: Open the file and get all the necessary information via
+ the resulting handle. This solves several issues in one blow:
+
+ . 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
+
+ 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
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;
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. */
}
#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
}
\f
-/* 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 kludgy 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, especially
+ 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;
}
}
static Lisp_Object
-ltime (long time_sec, long time_usec)
+ltime (ULONGLONG time_100ns)
{
- return list3 (make_number ((time_sec >> 16) & 0xffff),
+ ULONGLONG time_sec = time_100ns / 10000000;
+ int subsec = time_100ns % 10000000;
+ return list4 (make_number (time_sec >> 16),
make_number (time_sec & 0xffff),
- make_number (time_usec));
+ make_number (subsec / 10),
+ make_number (subsec % 10 * 100000));
}
-#define U64_TO_LISP_TIME(time) ltime ((time) / 1000000L, (time) % 1000000L)
+#define U64_TO_LISP_TIME(time) ltime (time)
static int
process_times (HANDLE h_proc, Lisp_Object *ctime, Lisp_Object *etime,
GetSystemTimeAsFileTime (&ft_current);
FILETIME_TO_U64 (tem1, ft_kernel);
- tem1 /= 10L;
*stime = U64_TO_LISP_TIME (tem1);
FILETIME_TO_U64 (tem2, ft_user);
- tem2 /= 10L;
*utime = U64_TO_LISP_TIME (tem2);
tem3 = tem1 + tem2;
FILETIME_TO_U64 (tem, ft_creation);
/* Process no 4 (System) returns zero creation time. */
if (tem)
- tem = (tem - utc_base) / 10L;
+ tem -= utc_base;
*ctime = U64_TO_LISP_TIME (tem);
if (tem)
{
FILETIME_TO_U64 (tem3, ft_current);
- tem = (tem3 - utc_base) / 10L - tem;
+ tem = (tem3 - utc_base) - tem;
}
*etime = U64_TO_LISP_TIME (tem);
if (fd_info[ fd ].cp != NULL)
{
DebPrint (("sys_socket: fd_info[%d] apparently in use!\n", fd));
- abort ();
+ emacs_abort ();
}
fd_info[ fd ].cp = cp;
{
if (fd_info[fd].flags & FILE_SOCKET)
{
- if (winsock_lib == NULL) abort ();
+ if (winsock_lib == NULL) emacs_abort ();
pfn_shutdown (SOCK_HANDLE (fd), 2);
rc = pfn_closesocket (SOCK_HANDLE (fd));
|| (fd_info[fd].flags & FILE_READ) == 0)
{
DebPrint (("_sys_read_ahead: internal error: fd %d is not a pipe, serial port, or socket!\n", fd));
- abort ();
+ emacs_abort ();
}
cp->status = STATUS_READ_IN_PROGRESS;
/* re-read CR carried over from last read */
if (fd_info[fd].flags & FILE_LAST_CR)
{
- if (fd_info[fd].flags & FILE_BINARY) abort ();
+ if (fd_info[fd].flags & FILE_BINARY) emacs_abort ();
*buffer++ = 0x0d;
count--;
nchars++;
}
else /* FILE_SOCKET */
{
- if (winsock_lib == NULL) abort ();
+ if (winsock_lib == NULL) emacs_abort ();
/* do the equivalent of a non-blocking read */
pfn_ioctlsocket (SOCK_HANDLE (fd), FIONREAD, &waiting);
else if (fd < MAXDESC && fd_info[fd].flags & FILE_SOCKET)
{
unsigned long nblock = 0;
- if (winsock_lib == NULL) abort ();
+ if (winsock_lib == NULL) emacs_abort ();
/* TODO: implement select() properly so non-blocking I/O works. */
/* For now, make sure the write blocks. */
\f
-/* Delayed loading of libraries. */
-
-Lisp_Object Vlibrary_cache;
-
-/* The argument LIBRARIES is an alist that associates a symbol
- LIBRARY_ID, identifying an external DLL library known to Emacs, to
- a list of filenames under which the library is usually found. In
- most cases, the argument passed as LIBRARIES is the variable
- `dynamic-library-alist', which is initialized to a list of common
- library names. If the function loads the library successfully, it
- returns the handle of the DLL, and records the filename in the
- property :loaded-from of LIBRARY_ID; it returns NULL if the library
- could not be found, or when it was already loaded (because the
- handle is not recorded anywhere, and so is lost after use). It
- would be trivial to save the handle too in :loaded-from, but
- currently there's no use case for it. */
+/* Try loading LIBRARY_ID from the file(s) specified in
+ Vdynamic_library_alist. If the library is loaded successfully,
+ return the handle of the DLL, and record the filename in the
+ property :loaded-from of LIBRARY_ID. If the library could not be
+ found, or when it was already loaded (because the handle is not
+ recorded anywhere, and so is lost after use), return NULL.
+
+ We could also save the handle in :loaded-from, but currently
+ there's no use case for it. */
HMODULE
-w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
+w32_delayed_load (Lisp_Object library_id)
{
HMODULE library_dll = NULL;
CHECK_SYMBOL (library_id);
- if (CONSP (libraries) && NILP (Fassq (library_id, Vlibrary_cache)))
+ if (CONSP (Vdynamic_library_alist)
+ && NILP (Fassq (library_id, Vlibrary_cache)))
{
Lisp_Object found = Qnil;
- Lisp_Object dlls = Fassq (library_id, libraries);
+ Lisp_Object dlls = Fassq (library_id, Vdynamic_library_alist);
if (CONSP (dlls))
for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
CHECK_STRING_CAR (dlls);
if ((library_dll = LoadLibrary (SDATA (XCAR (dlls)))))
{
- found = XCAR (dlls);
+ char name[MAX_PATH];
+ DWORD len;
+
+ len = GetModuleFileNameA (library_dll, name, sizeof (name));
+ found = Fcons (XCAR (dlls),
+ (len > 0)
+ /* Possibly truncated */
+ ? make_specified_string (name, -1, len, 1)
+ : Qnil);
break;
}
}
}
\f
-static void
+void
check_windows_init_file (void)
{
/* A common indication that Emacs is not installed properly is when
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
buffer,
"Emacs Abort Dialog",
MB_OK | MB_ICONEXCLAMATION | MB_TASKMODAL);
- /* Use the low-level Emacs abort. */
-#undef abort
+ /* Use the low-level system abort. */
abort ();
}
else
}
void
-term_ntproc (void)
+term_ntproc (int ignored)
{
+ (void)ignored;
/* shutdown the socket interface if necessary */
term_winsock ();
}
void
-init_ntproc (void)
+init_ntproc (int dumping)
{
/* Initialize the socket interface now if available and requested by
the user by defining PRELOAD_WINSOCK; otherwise loading will be
/* unfortunately, atexit depends on implementation of malloc */
/* atexit (term_ntproc); */
- signal (SIGABRT, term_ntproc);
+ if (!dumping)
+ signal (SIGABRT, term_ntproc);
/* determine which drives are fixed, for GetCachedVolumeInformation */
{
/* Reset the volume info cache. */
volume_cache = NULL;
}
-
- /* Check to see if Emacs has been installed correctly. */
- check_windows_init_file ();
}
/*
|| type == CTRL_SHUTDOWN_EVENT) /* User shutsdown. */
{
/* Shut down cleanly, making sure autosave files are up to date. */
- shut_down_emacs (0, 0, Qnil);
+ shut_down_emacs (0, Qnil);
}
/* Allow other handlers to handle this signal. */
DEFSYM (QCloaded_from, ":loaded-from");
- Vlibrary_cache = Qnil;
- staticpro (&Vlibrary_cache);
-
g_b_init_is_windows_9x = 0;
g_b_init_open_process_token = 0;
g_b_init_get_token_information = 0;
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;
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
error ("SetCommState() failed");
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
- p->childp = childp2;
+ pset_childp (p, childp2);
}
#ifdef HAVE_GNUTLS
{
int n, sc, err;
SELECT_TYPE fdset;
- EMACS_TIME timeout;
+ struct timeval timeout;
struct Lisp_Process *process = (struct Lisp_Process *)p;
int fd = process->infd;
if (err == EWOULDBLOCK)
{
/* Set a small timeout. */
- EMACS_SET_SECS_USECS (timeout, 1, 0);
+ timeout.tv_sec = 1;
+ timeout.tv_usec = 0;
FD_ZERO (&fdset);
FD_SET ((int)fd, &fdset);
/* Use select with the timeout to poll the selector. */
sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &timeout);
+ &timeout, NULL);
if (sc > 0)
continue; /* Try again. */
/* Return the string resource associated with KEY of type TYPE. */
extern LPBYTE w32_get_resource (char * key, LPDWORD type);
-extern void init_ntproc (void);
-extern void term_ntproc (void);
+extern void init_ntproc (int);
+extern void term_ntproc (int);
extern void globals_of_w32 (void);
extern void syms_of_w32term (void);
extern void syms_of_w32fns (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);
-extern Lisp_Object Vlibrary_cache, QCloaded_from;
-extern HMODULE w32_delayed_load (Lisp_Object, Lisp_Object);
+extern Lisp_Object QCloaded_from;
+extern HMODULE w32_delayed_load (Lisp_Object);
#ifdef HAVE_GNUTLS
#include <gnutls/gnutls.h>
-/* Terminal hooks for GNU Emacs on the Microsoft W32 API.
+/* Terminal hooks for GNU Emacs on the Microsoft Windows API.
Copyright (C) 1992, 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <stdio.h>
#include <windows.h>
-#include <setjmp.h>
#include "lisp.h"
#include "character.h"
#include "coding.h"
#include "disptab.h"
#include "frame.h"
+#include "window.h"
#include "termhooks.h"
#include "termchar.h"
#include "dispextern.h"
+#include "w32heap.h" /* for os_subtype */
#include "w32inevt.h"
/* from window.c */
#endif
HANDLE keyboard_handle;
+int w32_console_unicode_input;
/* Setting this as the ctrl handler prevents emacs from being killed when
}
}
+/* Used for mouse highlight. */
+static void
+w32con_write_glyphs_with_face (struct frame *f, register int x, register int y,
+ register struct glyph *string, register int len,
+ register int face_id)
+{
+ unsigned char *conversion_buffer;
+ struct coding_system *coding;
+
+ if (len <= 0)
+ return;
+
+ /* If terminal_coding does any conversion, use it, otherwise use
+ safe_terminal_coding. We can't use CODING_REQUIRE_ENCODING here
+ because it always return 1 if the member src_multibyte is 1. */
+ coding = (FRAME_TERMINAL_CODING (f)->common_flags & CODING_REQUIRE_ENCODING_MASK
+ ? FRAME_TERMINAL_CODING (f) : &safe_terminal_coding);
+ /* We are going to write the entire block of glyphs in one go, as
+ they all have the same face. So this _is_ the last block. */
+ coding->mode |= CODING_MODE_LAST_BLOCK;
+
+ conversion_buffer = encode_terminal_code (string, len, coding);
+ if (coding->produced > 0)
+ {
+ DWORD filled, written;
+ /* Compute the character attributes corresponding to the face. */
+ DWORD char_attr = w32_face_attributes (f, face_id);
+ COORD start_coords;
+
+ start_coords.X = x;
+ start_coords.Y = y;
+ /* Set the attribute for these characters. */
+ if (!FillConsoleOutputAttribute (cur_screen, char_attr,
+ coding->produced, start_coords,
+ &filled))
+ DebPrint (("Failed writing console attributes: %d\n", GetLastError ()));
+ else
+ {
+ /* Write the characters. */
+ if (!WriteConsoleOutputCharacter (cur_screen, conversion_buffer,
+ filled, start_coords, &written))
+ DebPrint (("Failed writing console characters: %d\n",
+ GetLastError ()));
+ }
+ }
+}
+
+/* Implementation of draw_row_with_mouse_face for W32 console. */
+void
+tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row,
+ int start_hpos, int end_hpos,
+ enum draw_glyphs_face draw)
+{
+ int nglyphs = end_hpos - start_hpos;
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
+ struct tty_display_info *tty = FRAME_TTY (f);
+ int face_id = tty->mouse_highlight.mouse_face_face_id;
+ int pos_x, pos_y;
+
+ if (end_hpos >= row->used[TEXT_AREA])
+ nglyphs = row->used[TEXT_AREA] - start_hpos;
+
+ pos_y = row->y + WINDOW_TOP_EDGE_Y (w);
+ pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w);
+
+ if (draw == DRAW_MOUSE_FACE)
+ w32con_write_glyphs_with_face (f, pos_x, pos_y,
+ row->glyphs[TEXT_AREA] + start_hpos,
+ nglyphs, face_id);
+ else if (draw == DRAW_NORMAL_TEXT)
+ {
+ COORD save_coords = cursor_coords;
+
+ w32con_move_cursor (f, pos_y, pos_x);
+ write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs);
+ w32con_move_cursor (f, save_coords.Y, save_coords.X);
+ }
+}
static void
w32con_delete_glyphs (struct frame *f, int n)
{
CONSOLE_CURSOR_INFO cci;
- /* make cursor big and visible (100 on Win95 makes it disappear) */
+ /* make cursor big and visible (100 on Windows 95 makes it disappear) */
cci.dwSize = 99;
cci.bVisible = TRUE;
(void) SetConsoleCursorInfo (cur_screen, &cci);
WORD char_attr;
struct face *face = FACE_FROM_ID (f, face_id);
- xassert (face != NULL);
+ eassert (face != NULL);
char_attr = char_attr_normal;
initialize_w32_display (struct terminal *term)
{
CONSOLE_SCREEN_BUFFER_INFO info;
+ Mouse_HLInfo *hlinfo;
term->rif = 0; /* No window based redisplay on the console. */
term->cursor_to_hook = w32con_move_cursor;
term->judge_scroll_bars_hook = 0;
term->frame_up_to_date_hook = 0;
+ /* Initialize the mouse-highlight data. */
+ hlinfo = &term->display_info.tty->mouse_highlight;
+ hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1;
+ hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1;
+ hlinfo->mouse_face_face_id = DEFAULT_FACE_ID;
+ hlinfo->mouse_face_mouse_frame = NULL;
+ hlinfo->mouse_face_window = Qnil;
+ hlinfo->mouse_face_hidden = 0;
+
/* Initialize interrupt_handle. */
init_crit ();
info.srWindow.Left);
}
+ if (os_subtype == OS_NT)
+ w32_console_unicode_input = 1;
+ else
+ w32_console_unicode_input = 0;
+
/* Setup w32_display_info structure for this frame. */
w32_initialize_display_info (build_string ("Console"));
-/* Graphical user interface functions for the Microsoft W32 API.
+/* Graphical user interface functions for the Microsoft Windows API.
Copyright (C) 1989, 1992-2012 Free Software Foundation, Inc.
#include <limits.h>
#include <errno.h>
#include <math.h>
-#include <setjmp.h>
#include "lisp.h"
#include "w32term.h"
#include "frame.h"
#include "window.h"
+#include "character.h"
#include "buffer.h"
#include "intervals.h"
#include "dispextern.h"
#include "keyboard.h"
#include "blockinput.h"
#include "epaths.h"
-#include "character.h"
#include "charset.h"
#include "coding.h"
#include "ccl.h"
static int w32_in_use;
-Lisp_Object Qnone;
Lisp_Object Qsuppress_icon;
Lisp_Object Qundefined_color;
Lisp_Object Qcancel_timer;
#define MENU_FREE_DELAY 1000
static unsigned menu_free_timer = 0;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static int image_cache_refcount, dpyinfo_refcount;
#endif
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;
XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
- BLOCK_INPUT;
+ block_input ();
/* replace existing entry in w32-color-map or add new entry. */
entry = Fassoc (name, Vw32_color_map);
Fsetcdr (entry, rgb);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return (oldrgb);
}
colormap_t *pc = w32_color_map;
Lisp_Object cmap;
- BLOCK_INPUT;
+ block_input ();
cmap = Qnil;
make_number (pc->colorref)),
cmap);
- UNBLOCK_INPUT;
+ unblock_input ();
return (cmap);
}
{
Lisp_Object tail, ret = Qnil;
- BLOCK_INPUT;
+ block_input ();
for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
{
elt = XCAR (tail);
if (!CONSP (elt)) continue;
- tem = Fcar (elt);
+ tem = XCAR (elt);
if (lstrcmpi (SDATA (tem), colorname) == 0)
{
QUIT;
}
- UNBLOCK_INPUT;
+ unblock_input ();
return ret;
}
HKEY colors_key;
/* Other registry operations are done with input blocked. */
- BLOCK_INPUT;
+ block_input ();
/* Look for "Control Panel/Colors" under User and Machine registry
settings. */
RegCloseKey (colors_key);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
{
register Lisp_Object ret = Qnil;
- BLOCK_INPUT;
+ block_input ();
if (colorname[0] == '#')
{
pos += 0x8;
if (i == 2)
{
- UNBLOCK_INPUT;
+ unblock_input ();
XSETINT (ret, colorval);
return ret;
}
{
if (*end != '\0')
break;
- UNBLOCK_INPUT;
+ unblock_input ();
XSETINT (ret, colorval);
return ret;
}
{
if (*end != '\0')
break;
- UNBLOCK_INPUT;
+ unblock_input ();
XSETINT (ret, colorval);
return ret;
}
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return ret;
}
}
/* not already mapped, so add to list and recreate Windows palette */
- list = (struct w32_palette_entry *)
- xmalloc (sizeof (struct w32_palette_entry));
+ list = xmalloc (sizeof (struct w32_palette_entry));
SET_W32_COLOR (list->entry, color);
list->refcount = 1;
list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
if (entry == NULL && alloc)
{
/* not already mapped, so add to list */
- entry = (struct w32_palette_entry *)
- xmalloc (sizeof (struct w32_palette_entry));
+ entry = xmalloc (sizeof (struct w32_palette_entry));
SET_W32_COLOR (entry->entry, XUINT (tem));
entry->next = NULL;
*prev = entry;
f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
#if 0 /* TODO : Mouse cursor customization. */
- BLOCK_INPUT;
+ block_input ();
/* It's not okay to crash if the user selects a screwy cursor. */
count = x_catch_errors (FRAME_W32_DISPLAY (f));
f->output_data.w32->hand_cursor = hand_cursor;
XFlush (FRAME_W32_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
update_face_from_frame_parameter (f, Qmouse_color, arg);
#endif /* TODO */
if (FRAME_W32_WINDOW (f) != 0)
{
- BLOCK_INPUT;
+ block_input ();
/* Update frame's cursor_gc. */
f->output_data.w32->cursor_gc->foreground = fore_pixel;
f->output_data.w32->cursor_gc->background = pixel;
- UNBLOCK_INPUT;
+ unblock_input ();
if (FRAME_VISIBLE_P (f))
{
if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
return;
- BLOCK_INPUT;
+ block_input ();
result = x_bitmap_icon (f, arg);
if (result)
{
- UNBLOCK_INPUT;
+ unblock_input ();
error ("No icon window available");
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
void
else if (!NILP (arg) || NILP (oldval))
return;
- f->icon_name = arg;
+ fset_icon_name (f, arg);
#if 0
if (f->output_data.w32->icon_bitmap != 0)
return;
- BLOCK_INPUT;
+ block_input ();
result = x_text_icon (f,
SSDATA ((!NILP (f->icon_name)
if (result)
{
- UNBLOCK_INPUT;
+ unblock_input ();
error ("No icon window available");
}
}
XFlush (FRAME_W32_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
}
int width = FRAME_PIXEL_WIDTH (f);
int y = nlines * FRAME_LINE_HEIGHT (f);
- BLOCK_INPUT;
+ block_input ();
{
HDC hdc = get_frame_dc (f);
w32_clear_area (f, hdc, 0, y, width, height);
release_frame_dc (f, hdc);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (WINDOWP (f->tool_bar_window))
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
if (! NILP (Fstring_equal (name, f->name)))
return;
- f->name = name;
+ fset_name (f, name);
/* For setting the frame title, the title parameter should override
the name parameter. */
if (STRING_MULTIBYTE (name))
name = ENCODE_SYSTEM (name);
- BLOCK_INPUT;
+ block_input ();
SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
update_mode_lines = 1;
- f->title = name;
+ fset_title (f, name);
if (NILP (name))
name = f->name;
if (STRING_MULTIBYTE (name))
name = ENCODE_SYSTEM (name);
- BLOCK_INPUT;
+ block_input ();
SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
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 RegisterClassW (&uwc);
+ }
+ else
+ {
+ WNDCLASS wc;
+ INIT_WINDOW_CLASS(wc);
+ wc.lpszClassName = EMACS_CLASS;
- return (RegisterClass (&wc));
+ return RegisterClassA (&wc);
+ }
}
static HWND
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)
{
CoInitialize (NULL);
w32_createwindow ((struct frame *) msg.wParam);
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
- abort ();
+ emacs_abort ();
break;
case WM_EMACS_SETLOCALE:
SetThreadLocale (msg.wParam);
result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
result, 0))
- abort ();
+ emacs_abort ();
break;
case WM_EMACS_REGISTER_HOT_KEY:
focus_window = GetFocus ();
GC. */
XSETCAR ((Lisp_Object) ((EMACS_INT) msg.lParam), Qnil);
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
- abort ();
+ emacs_abort ();
break;
case WM_EMACS_TOGGLE_LOCK_KEY:
{
}
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
cur_state, 0))
- abort ();
+ emacs_abort ();
}
break;
#ifdef MSG_DEBUG
}
else
{
- DispatchMessage (&msg);
+ if (w32_unicode_gui)
+ DispatchMessageW (&msg);
+ else
+ DispatchMessageA (&msg);
}
/* Exit nested loop when our deferred message has completed. */
{
/* Only input thread can send deferred messages. */
if (GetCurrentThreadId () != dwWindowsThreadId)
- abort ();
+ emacs_abort ();
/* It is an error to send a message that is already deferred. */
if (find_deferred_msg (hwnd, msg) != NULL)
- abort ();
+ emacs_abort ();
/* Enforced synchronization is not needed because this is the only
function that alters deferred_msg_head, and the following critical
PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
- abort ();
+ emacs_abort ();
memset (&dummy_buf, 0, sizeof (dummy_buf));
dummy_buf.w32msg.msg.hwnd = NULL;
woken up if blocked in sys_select, but we do NOT want to post
the quit_char message itself (because it will usually be as if
the user had typed quit_char twice). Instead, we post a dummy
- message that has no particular effect. */
+ message that has no particular effect. */
{
int c = wParam;
if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
c = make_ctrl_char (c) & 0377;
if (c == quit_char
- || (wmsg.dwModifiers == 0 &&
- w32_quit_key && wParam == w32_quit_key))
+ || (wmsg.dwModifiers == 0
+ && w32_quit_key && wParam == w32_quit_key))
{
Vquit_flag = Qt;
/* The choice of message is somewhat arbitrary, as long as
- the main thread handler just ignores it. */
+ the main thread handler just ignores it. */
msg = WM_NULL;
/* Interrupt any blocking system calls. */
key.uChar.AsciiChar = 0;
key.dwControlKeyState = modifiers;
- add = w32_kbd_patch_key (&key);
+ add = w32_kbd_patch_key (&key, w32_keyboard_codepage);
/* 0 means an unrecognized keycode, negative means
dead key. Ignore both. */
while (--add >= 0)
(hwnd, WM_CHAR,
(unsigned char) key.uChar.AsciiChar, lParam,
w32_get_key_modifiers (wParam, lParam));
- w32_kbd_patch_key (&key);
+ w32_kbd_patch_key (&key, w32_keyboard_codepage);
}
return 0;
}
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:
msg = WM_MBUTTONUP;
button_state &= ~MMOUSE;
- if (button_state) abort ();
+ if (button_state) emacs_abort ();
}
else
return 0;
/* Detect if message has already been deferred; in this case
we cannot return any sensible value to ignore this. */
if (find_deferred_msg (hwnd, msg) != NULL)
- abort ();
+ emacs_abort ();
menubar_in_use = 1;
case WM_EMACS_SHOWWINDOW:
return ShowWindow ((HWND) wParam, (WPARAM) lParam);
+ case WM_EMACS_BRINGTOTOP:
case WM_EMACS_SETFOREGROUND:
{
HWND foreground_window;
foreground_thread = 0;
retval = SetForegroundWindow ((HWND) wParam);
+ if (msg == WM_EMACS_BRINGTOTOP)
+ retval = BringWindowToTop ((HWND) wParam);
/* Detach from the previous foreground thread. */
if (foreground_thread)
}
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. */
MSG msg;
if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
- abort ();
+ emacs_abort ();
GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
}
static void
w32_window (struct frame *f, long window_prompting, int minibuffer_only)
{
- BLOCK_INPUT;
+ block_input ();
/* Use the resource name as the top-level window name
for looking up resources. Make a non-Lisp copy
{
char *str = SSDATA (Vx_resource_name);
- f->namebuf = (char *) xmalloc (strlen (str) + 1);
+ f->namebuf = xmalloc (strlen (str) + 1);
strcpy (f->namebuf, str);
}
f->explicit_name = 0;
name = f->name;
- f->name = Qnil;
+ fset_name (f, Qnil);
x_set_name (f, name, explicit);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
initialize_frame_menubar (f);
else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
error ("Both left and top icon corners of icon must be specified");
- BLOCK_INPUT;
+ block_input ();
if (! EQ (icon_x, Qunbound))
x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
: f->name)));
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
}
{
XGCValues gc_values;
- BLOCK_INPUT;
+ block_input ();
/* Create the GC's of this frame.
Note that many default values are used. */
f->output_data.w32->white_relief.gc = 0;
f->output_data.w32->black_relief.gc = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If frame is ``official'', nothing to do. */
if (NILP (Fmemq (frame, Vframe_list)))
{
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
#endif
x_free_frame_resources (f);
free_glyphs (f);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that reference counts are indeed correct. */
- xassert (dpyinfo->reference_count == dpyinfo_refcount);
- xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
+ eassert (dpyinfo->reference_count == dpyinfo_refcount);
+ eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
#endif
return Qt;
}
for (i = 0; names[i]; i++)
{
- font = font_open_by_name (f, names[i]);
+ font = font_open_by_name (f, build_unibyte_string (names[i]));
if (! NILP (font))
break;
}
int minibuffer_only = 0;
long window_prompting = 0;
int width, height;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct w32_display_info *dpyinfo = NULL;
f->terminal = dpyinfo->terminal;
f->output_method = output_w32;
- f->output_data.w32 =
- (struct w32_output *) xmalloc (sizeof (struct w32_output));
- memset (f->output_data.w32, 0, sizeof (struct w32_output));
+ f->output_data.w32 = xzalloc (sizeof (struct w32_output));
FRAME_FONTSET (f) = -1;
- f->icon_name
- = x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
- RES_TYPE_STRING);
+ fset_icon_name
+ (f, x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title",
+ RES_TYPE_STRING));
if (! STRINGP (f->icon_name))
- f->icon_name = Qnil;
+ fset_icon_name (f, Qnil);
/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
/* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
record_unwind_protect (unwind_create_frame, frame);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
dpyinfo_refcount = dpyinfo->reference_count;
be set. */
if (EQ (name, Qunbound) || NILP (name))
{
- f->name = build_string (dpyinfo->w32_id_name);
+ fset_name (f, build_string (dpyinfo->w32_id_name));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
/* Tell the server what size and position, etc, we want, and how
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
- BLOCK_INPUT;
+ block_input ();
x_wm_set_size_hint (f, window_prompting, 0);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Make the window appear on the frame and enable display, unless
the caller says not to. However, with explicit parent, Emacs
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_default_minibuffer_frame (kb, 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))))
- f->param_alist = Fcons (XCAR (tem), f->param_alist);
+ fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
UNGCPRO;
CHECK_STRING (name);
for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
- dpyinfo;
+ dpyinfo && !NILP (w32_display_name_list);
dpyinfo = dpyinfo->next, names = XCDR (names))
{
Lisp_Object tem;
if (dpyinfo->reference_count > 0)
error ("Display still has frames on it");
- BLOCK_INPUT;
+ block_input ();
x_destroy_all_bitmaps (dpyinfo);
x_delete_display (dpyinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
FORMAT gives the size in bits of each element if VALUE is a list.
It must be one of 8, 16 or 32.
If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
-If OUTER_P is non-nil, the property is changed for the outer X window of
+If OUTER-P is non-nil, the property is changed for the outer X window of
FRAME. Default is to change on the edit X window. */)
- (Lisp_Object prop, Lisp_Object value, Lisp_Object frame, Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
+ (Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
+ Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
CHECK_STRING (prop);
CHECK_STRING (value);
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
prop_atom, XA_STRING, 8, PropModeReplace,
/* Make sure the property is set when we return. */
XFlush (FRAME_W32_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
Atom prop_atom;
CHECK_STRING (prop);
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
/* Make sure the property is removed when we return. */
XFlush (FRAME_W32_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
return prop;
}
DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
- 1, 2, 0,
+ 1, 6, 0,
doc: /* Value is the value of window property PROP on FRAME.
If FRAME is nil or omitted, use the selected frame.
-On MS Windows, this function only accepts the PROP and FRAME arguments.
-
On X Windows, the following optional arguments are also accepted:
If TYPE is nil or omitted, get the property as a string.
Otherwise TYPE is the name of the atom that denotes the type expected.
If SOURCE is non-nil, get the property on that window instead of from
FRAME. The number 0 denotes the root window.
-If DELETE_P is non-nil, delete the property after retrieving it.
-If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
+If DELETE-P is non-nil, delete the property after retrieving it.
+If VECTOR-RET-P is non-nil, don't return a string but a vector of values.
+
+On MS Windows, this function accepts but ignores those optional arguments.
Value is nil if FRAME hasn't a property with name PROP or if PROP has
no value of TYPE (always string in the MS Windows case). */)
- (Lisp_Object prop, Lisp_Object frame)
+ (Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
+ Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
unsigned long actual_size, bytes_remaining;
CHECK_STRING (prop);
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
prop_atom, 0, 0, False, XA_STRING,
XFree (tmp_data);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return prop_value;
cursor. Duplicated from xdisp.c, but cannot use the version there
due to lack of atimers on w32. */
#define DEFAULT_HOURGLASS_DELAY 1
-/* Return non-zero if hourglass timer has been started or hourglass is
- shown. */
-/* PENDING: if W32 can use atimers (atimer.[hc]) then the common impl in
- xdisp.c could be used. */
-
-int
-hourglass_started (void)
-{
- return hourglass_shown_p || hourglass_timer;
-}
/* Cancel a currently active hourglass timer, and start a new one. */
Lisp_Object name;
long window_prompting = 0;
int width, height;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
struct kboard *kb;
int face_change_count_before = face_change_count;
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_truncate_lines (current_buffer, Qnil);
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
counts etc. */
f->terminal = dpyinfo->terminal;
f->output_method = output_w32;
- f->output_data.w32 =
- (struct w32_output *) xmalloc (sizeof (struct w32_output));
- memset (f->output_data.w32, 0, sizeof (struct w32_output));
+ f->output_data.w32 = xzalloc (sizeof (struct w32_output));
FRAME_FONTSET (f) = -1;
- f->icon_name = Qnil;
+ fset_icon_name (f, Qnil);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
- FRAME_IMAGE_CACHE ? FRAME_IMAGE_CACHE (f)->refcount : 0;
+ FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
dpyinfo_refcount = dpyinfo->reference_count;
#endif /* GLYPH_DEBUG */
FRAME_KBOARD (f) = kb;
be set. */
if (EQ (name, Qunbound) || NILP (name))
{
- f->name = build_string (dpyinfo->w32_id_name);
+ fset_name (f, build_string (dpyinfo->w32_id_name));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
f->left_fringe_width = 0;
f->right_fringe_width = 0;
- BLOCK_INPUT;
+ block_input ();
my_create_tip_window (f);
- UNBLOCK_INPUT;
+ unblock_input ();
x_make_gc (f);
max_x = x_display_pixel_width (FRAME_W32_DISPLAY_INFO (f));
max_y = x_display_pixel_height (FRAME_W32_DISPLAY_INFO (f));
- BLOCK_INPUT;
+ block_input ();
GetCursorPos (&pt);
*root_x = pt.x;
*root_y = pt.y;
- UNBLOCK_INPUT;
+ unblock_input ();
/* If multiple monitor support is available, constrain the tip onto
the current monitor. This improves the above by allowing negative
int i, width, height, seen_reversed_p;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_redisplay, Qt);
call1 (Qcancel_timer, timer);
}
- BLOCK_INPUT;
+ block_input ();
compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
0, 0, 0, 0,
SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
- UNBLOCK_INPUT;
+ unblock_input ();
goto start_timer;
}
}
/* Block input until the tip has been fully drawn, to avoid crashes
when drawing tips in menus. */
- BLOCK_INPUT;
+ block_input ();
/* Create a frame for the tooltip, and record it in the global
variable tip_frame. */
/* Set up the frame's root window. */
w = XWINDOW (FRAME_ROOT_WINDOW (f));
- w->left_col = w->top_line = make_number (0);
+ wset_left_col (w, make_number (0));
+ wset_top_line (w, make_number (0));
if (CONSP (Vx_max_tooltip_size)
&& INTEGERP (XCAR (Vx_max_tooltip_size))
&& INTEGERP (XCDR (Vx_max_tooltip_size))
&& XINT (XCDR (Vx_max_tooltip_size)) > 0)
{
- w->total_cols = XCAR (Vx_max_tooltip_size);
- w->total_lines = XCDR (Vx_max_tooltip_size);
+ wset_total_cols (w, XCAR (Vx_max_tooltip_size));
+ wset_total_lines (w, XCDR (Vx_max_tooltip_size));
}
else
{
- w->total_cols = make_number (80);
- w->total_lines = make_number (40);
+ wset_total_cols (w, make_number (80));
+ wset_total_lines (w, make_number (40));
}
FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
/* Display the tooltip text in a temporary buffer. */
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
clear_glyph_matrix (w->desired_matrix);
clear_glyph_matrix (w->current_matrix);
SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
/* w->total_cols and FRAME_TOTAL_COLS want the width in columns,
not in pixels. */
width /= WINDOW_FRAME_COLUMN_WIDTH (w);
- w->total_cols = make_number (width);
+ wset_total_cols (w, make_number (width));
FRAME_TOTAL_COLS (f) = width;
adjust_glyphs (f);
w->pseudo_window_p = 1;
w->must_be_updated_p = 1;
update_single_window (w, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Restore original current buffer. */
set_buffer_internal_1 (old_buffer);
Value is t if tooltip was open, nil otherwise. */)
(void)
{
- int count;
+ ptrdiff_t count;
Lisp_Object deleted, frame, timer;
struct gcpro gcpro1, gcpro2;
{
struct frame *f = SELECTED_FRAME ();
Lisp_Object file = Qnil;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
char filename[MAX_PATH + 1];
char init_dir[MAX_PATH + 1];
/* Prevent redisplay. */
specbind (Qinhibit_redisplay, Qt);
- BLOCK_INPUT;
+ block_input ();
memset (&new_file_details, 0, sizeof (new_file_details));
/* Apparently NT4 crashes if you give it an unexpected size.
file_opened = GetOpenFileName (file_details);
- UNBLOCK_INPUT;
+ unblock_input ();
if (file_opened)
{
if (!NILP (Vlocale_coding_system))
{
Lisp_Object decoded =
- code_convert_string_norecord (make_unibyte_string (errstr,
- strlen (errstr)),
+ code_convert_string_norecord (build_unibyte_string (errstr),
Vlocale_coding_system, 0);
errstr = SSDATA (decoded);
}
lisp_modifiers = XINT (Fcar (Fcdr (c)));
c = Fcar (c);
if (!SYMBOLP (c))
- abort ();
+ emacs_abort ();
vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
}
else if (INTEGERP (c))
/* Notify input thread about new hot-key definition, so that it
takes effect without needing to switch focus. */
-#ifdef USE_LISP_UNION_TYPE
- PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
- (WPARAM) key.i, 0);
-#else
PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
- (WPARAM) key, 0);
-#endif
+ (WPARAM) XLI (key), 0);
}
return key;
{
/* Notify input thread about hot-key definition being removed, so
that it takes effect without needing focus switch. */
-#ifdef USE_LISP_UNION_TYPE
- if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
- (WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
-#else
if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
- (WPARAM) XINT (XCAR (item)), (LPARAM) item))
-#endif
+ (WPARAM) XINT (XCAR (item)), (LPARAM) XLI (item)))
{
MSG msg;
GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
if (!dwWindowsThreadId)
return make_number (w32_console_toggle_lock_key (vk_code, new_state));
-#ifdef USE_LISP_UNION_TYPE
if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
- (WPARAM) vk_code, (LPARAM) new_state.i))
-#else
- if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
- (WPARAM) vk_code, (LPARAM) new_state))
-#endif
+ (WPARAM) vk_code, (LPARAM) XLI (new_state)))
{
MSG msg;
GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
{
Lisp_Object line_status, battery_status, battery_status_symbol;
Lisp_Object load_percentage, seconds, minutes, hours, remain;
- Lisp_Object sequences[8];
long seconds_left = (long) system_status.BatteryLifeTime;
_snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60);
remain = build_string (buffer);
}
- sequences[0] = Fcons (make_number ('L'), line_status);
- sequences[1] = Fcons (make_number ('B'), battery_status);
- sequences[2] = Fcons (make_number ('b'), battery_status_symbol);
- sequences[3] = Fcons (make_number ('p'), load_percentage);
- sequences[4] = Fcons (make_number ('s'), seconds);
- sequences[5] = Fcons (make_number ('m'), minutes);
- sequences[6] = Fcons (make_number ('h'), hours);
- sequences[7] = Fcons (make_number ('t'), remain);
-
- status = Flist (8, sequences);
+
+ status = listn (CONSTYPE_HEAP, 8,
+ Fcons (make_number ('L'), line_status),
+ Fcons (make_number ('B'), battery_status),
+ Fcons (make_number ('b'), battery_status_symbol),
+ Fcons (make_number ('p'), load_percentage),
+ Fcons (make_number ('s'), seconds),
+ Fcons (make_number ('m'), minutes),
+ Fcons (make_number ('h'), hours),
+ Fcons (make_number ('t'), remain));
}
return status;
}
value = Qnil;
/* Determining the required information on Windows turns out, sadly,
- to be more involved than one would hope. The original Win32 api
+ to be more involved than one would hope. The original Windows API
call for this will return bogus information on some systems, but we
must dynamically probe for the replacement api, since that was
added rather late on. */
return Qnil;
}
/* Allocate memory for the PRINTER_INFO_2 struct */
- ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded);
+ ppi2 = xmalloc (dwNeeded);
if (!ppi2)
{
ClosePrinter (hPrn);
w32_visible_system_caret_hwnd = NULL;
- DEFSYM (Qnone, "none");
DEFSYM (Qsuppress_icon, "suppress-icon");
DEFSYM (Qundefined_color, "undefined-color");
DEFSYM (Qcancel_timer, "cancel-timer");
Fput (Qundefined_color, Qerror_conditions,
- pure_cons (Qundefined_color, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
Fput (Qundefined_color, Qerror_message,
- make_pure_c_string ("Undefined color"));
+ build_pure_c_string ("Undefined color"));
staticpro (&w32_grabbed_keys);
w32_grabbed_keys = Qnil;
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 ();
syms_of_w32uniscribe ();
}
-#undef abort
-
void
-w32_abort (void)
+emacs_abort (void)
{
int button;
button = MessageBox (NULL,
-/* Font backend for the Microsoft W32 API.
+/* Font backend for the Microsoft Windows API.
Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <math.h>
#include <ctype.h>
#include <commdlg.h>
-#include <setjmp.h>
#include "lisp.h"
#include "w32term.h"
static Lisp_Object Qraster, Qoutline, Qunknown;
/* antialiasing */
-extern Lisp_Object Qnone; /* reuse from w32fns.c */
static Lisp_Object Qstandard, Qsubpixel, Qnatural;
/* languages */
static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
-static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan;
+static Lisp_Object Qkhmer, Qmongolian, Qbraille, Qhan;
static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic;
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);
}
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);
}
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);
}
Lisp_Object
intern_font_name (char * string)
{
- Lisp_Object obarray, tem, str;
- int len;
-
- str = DECODE_SYSTEM (build_string (string));
- len = SCHARS (str);
-
- /* The following code is copied from the function intern (in lread.c). */
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, SDATA (str), len, len);
- if (SYMBOLP (tem))
- return tem;
- return Fintern (str, obarray);
+ Lisp_Object str = DECODE_SYSTEM (build_string (string));
+ int len = SCHARS (str);
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, SDATA (str), len, len);
+ /* This code is similar to intern function from lread.c. */
+ return SYMBOLP (tem) ? tem : Fintern (str, obarray);
}
/* w32 implementation of get_cache for font backend.
if (!w32_font->cached_metrics[block])
{
w32_font->cached_metrics[block]
- = xmalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
- memset (w32_font->cached_metrics[block], 0,
- CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
+ = xzalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
}
char_metric = w32_font->cached_metrics[block] + pos_in_block;
/* w32 implementation of draw for font backend.
Optional.
Draw glyphs between FROM and TO of S->char2b at (X Y) pixel
- position of frame F with S->FACE and S->GC. If WITH_BACKGROUND
- is nonzero, fill the background in advance. It is assured that
- WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars).
+ position of frame F with S->FACE and S->GC. If WITH_BACKGROUND,
+ fill the background in advance. It is assured that WITH_BACKGROUND
+ is false when (FROM > 0 || TO < S->nchars).
TODO: Currently this assumes that the colors and fonts are already
set in the DC. This seems to be true now, but maybe only due to
int
w32font_draw (struct glyph_string *s, int from, int to,
- int x, int y, int with_background)
+ int x, int y, bool with_background)
{
UINT options;
HRGN orig_clip = NULL;
w32font_otf_drive (struct font *font, Lisp_Object features,
Lisp_Object gstring_in, int from, int to,
Lisp_Object gstring_out, int idx,
- int alternate_subst);
+ bool alternate_subst);
*/
/* Internal implementation of w32font_list.
font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
font->vertical_centering = 0;
- font->encoding_type = 0;
font->baseline_offset = 0;
font->relative_compose = 0;
font->default_ascent = w32_font->metrics.tmAscent;
currently appear in fontset.el, so it isn't worth
creating a mapping table of codepages/scripts to languages
or opening the font to see if there are any language tags
- in it that the W32 API does not expose. Fontset
+ in it that the Windows API does not expose. Fontset
spec should have a fallback, as some backends do
not recognize language at all. */
return 0;
DEFSYM (Qrunic, "runic");
DEFSYM (Qkhmer, "khmer");
DEFSYM (Qmongolian, "mongolian");
- DEFSYM (Qsymbol, "symbol");
DEFSYM (Qbraille, "braille");
DEFSYM (Qhan, "han");
DEFSYM (Qideographic_description, "ideographic-description");
-/* Shared GDI and Uniscribe Font backend declarations for the W32 API.
+/* Shared GDI and Uniscribe Font backend declarations for the Windows API.
Copyright (C) 2007-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#ifndef EMACS_W32FONT_H
#define EMACS_W32FONT_H
+#include "font.h"
/* Bit 17 of ntmFlags in NEWTEXTMETRIC is set for PostScript OpenType fonts,
bit 18 for TrueType OpenType fonts, bit 20 for Type1 fonts. */
int w32font_text_extents (struct font *font, unsigned *code, int nglyphs,
struct font_metrics *metrics);
int w32font_draw (struct glyph_string *s, int from, int to,
- int x, int y, int with_background);
+ int x, int y, bool with_background);
int uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec);
Lisp_Object intern_font_name (char *);
+extern void syms_of_w32font (void);
+extern void globals_of_w32font (void);
+
#endif
-/* Definitions and headers for communication on the Microsoft W32 API.
+/* Definitions and headers for communication on the Microsoft Windows API.
Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#define PBaseSize (1L << 8) /* program specified base for incrementing */
#define PWinGravity (1L << 9) /* program specified window gravity */
-extern int XParseGeometry (char *, int *, int *, unsigned *, unsigned *);
-
-
typedef struct {
int x, y;
unsigned width, height;
-/* Heap management routines for GNU Emacs on the Microsoft W32 API.
+/* Heap management routines for GNU Emacs on the Microsoft Windows API.
Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include "w32heap.h"
#include "lisp.h" /* for VALMASK */
w32_minor_version = version.info.minor;
if (version.info.platform & 0x8000)
- os_subtype = OS_WIN95;
+ os_subtype = OS_9X;
else
os_subtype = OS_NT;
GetVersionEx (&osinfo_cache);
w32_build_number = osinfo_cache.dwBuildNumber;
- if (os_subtype == OS_WIN95)
+ if (os_subtype == OS_9X)
w32_build_number &= 0xffff;
}
return data_region_end;
}
-#if !defined (USE_LISP_UNION_TYPE) && !defined (USE_LSB_TAG)
+#if !USE_LSB_TAG
static char *
allocate_heap (void)
{
return ptr;
}
-#else /* USE_LISP_UNION_TYPE || USE_LSB_TAG */
+#else /* USE_LSB_TAG */
static char *
allocate_heap (void)
{
return ptr;
}
-#endif /* USE_LISP_UNION_TYPE || USE_LSB_TAG */
+#endif /* USE_LSB_TAG */
/* Emulate Unix sbrk. Note that ralloc.c expects the return value to
exit (1);
}
-#if !defined (USE_LISP_UNION_TYPE) && !defined (USE_LSB_TAG)
+#if !USE_LSB_TAG
/* Ensure that the addresses don't use the upper tag bits since
the Lisp type goes there. */
if (((unsigned long) data_region_base & ~VALMASK) != 0)
extern int w32_build_number;
enum {
- OS_WIN95 = 1,
+ OS_9X = 1,
OS_NT
};
IMAGE_SECTION_HEADER * rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header);
#endif /* NTHEAP_H_ */
-
-/* Input event support for Emacs on the Microsoft W32 API.
+/* Input event support for Emacs on the Microsoft Windows API.
Copyright (C) 1992-1993, 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include <stdio.h>
#include <windows.h>
-#include <setjmp.h>
#ifndef MOUSE_MOVED
#define MOUSE_MOVED 1
#include "keyboard.h"
#include "frame.h"
#include "dispextern.h"
+#include "window.h"
#include "blockinput.h"
#include "termhooks.h"
+#include "termchar.h"
#include "w32heap.h"
#include "w32term.h"
+#include "w32inevt.h"
/* stdin, from w32console.c */
extern HANDLE keyboard_handle;
/* Temporarily store lead byte of DBCS input sequences. */
static char dbcs_lead = 0;
+static inline BOOL
+w32_read_console_input (HANDLE h, INPUT_RECORD *rec, DWORD recsize,
+ DWORD *waiting)
+{
+ return (w32_console_unicode_input
+ ? ReadConsoleInputW (h, rec, recsize, waiting)
+ : ReadConsoleInputA (h, rec, recsize, waiting));
+}
+
static int
fill_queue (BOOL block)
{
return 0;
}
- rc = ReadConsoleInput (keyboard_handle, event_queue, EVENT_QUEUE_SIZE,
- &events_waiting);
+ rc = w32_read_console_input (keyboard_handle, event_queue, EVENT_QUEUE_SIZE,
+ &events_waiting);
if (!rc)
return -1;
queue_ptr = event_queue;
}
#endif
-/* The return code indicates key code size. */
+/* The return code indicates key code size. cpID is the codepage to
+ use for translation to Unicode; -1 means use the current console
+ input codepage. */
int
-w32_kbd_patch_key (KEY_EVENT_RECORD *event)
+w32_kbd_patch_key (KEY_EVENT_RECORD *event, int cpId)
{
unsigned int key_code = event->wVirtualKeyCode;
unsigned int mods = event->dwControlKeyState;
#endif
/* On NT, call ToUnicode instead and then convert to the current
- locale's default codepage. */
+ console input codepage. */
if (os_subtype == OS_NT)
{
WCHAR buf[128];
keystate, buf, 128, 0);
if (isdead > 0)
{
- char cp[20];
- int cpId;
+ /* When we are called from the GUI message processing code,
+ we are passed the current keyboard codepage, a positive
+ number, to use below. */
+ if (cpId == -1)
+ cpId = GetConsoleCP ();
event->uChar.UnicodeChar = buf[isdead - 1];
-
- GetLocaleInfo (GetThreadLocale (),
- LOCALE_IDEFAULTANSICODEPAGE, cp, 20);
- cpId = atoi (cp);
isdead = WideCharToMultiByte (cpId, 0, buf, isdead,
ansi_code, 4, NULL, NULL);
}
base character (ie. translating the base key plus shift
modifier). */
else if (event->uChar.AsciiChar == 0)
- w32_kbd_patch_key (event);
+ w32_kbd_patch_key (event, -1);
}
if (event->uChar.AsciiChar == 0)
}
else if (event->uChar.AsciiChar > 0)
{
+ /* Pure ASCII characters < 128. */
emacs_ev->kind = ASCII_KEYSTROKE_EVENT;
emacs_ev->code = event->uChar.AsciiChar;
}
- else if (event->uChar.UnicodeChar > 0)
+ else if (event->uChar.UnicodeChar > 0
+ && w32_console_unicode_input)
{
+ /* Unicode codepoint; only valid if we are using Unicode
+ console input mode. */
emacs_ev->kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
emacs_ev->code = event->uChar.UnicodeChar;
}
else
{
- /* Fallback for non-Unicode versions of Windows. */
+ /* Fallback handling of non-ASCII characters for non-Unicode
+ versions of Windows, and for non-Unicode input on NT
+ family of Windows. Only characters in the current
+ console codepage are supported by this fallback. */
wchar_t code;
char dbcs[2];
- char cp[20];
int cpId;
- /* Get the codepage to interpret this key with. */
- GetLocaleInfo (GetThreadLocale (),
- LOCALE_IDEFAULTANSICODEPAGE, cp, 20);
- cpId = atoi (cp);
+ /* Get the current console input codepage to interpret this
+ key with. Note that the system defaults for the OEM
+ codepage could have been changed by calling SetConsoleCP
+ or w32-set-console-codepage, so using GetLocaleInfo to
+ get LOCALE_IDEFAULTCODEPAGE is not TRT here. */
+ cpId = GetConsoleCP ();
dbcs[0] = dbcs_lead;
dbcs[1] = event->uChar.AsciiChar;
}
else
{
+ /* Function keys and other non-character keys. */
emacs_ev->kind = NON_ASCII_KEYSTROKE_EVENT;
emacs_ev->code = event->wVirtualKeyCode;
}
Lisp_Object *y,
Time *time)
{
- BLOCK_INPUT;
+ block_input ();
insist = insist;
XSETINT (*y, movement_pos.Y);
*time = movement_time;
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Remember mouse motion and notify emacs. */
static void
mouse_moved_to (int x, int y)
{
- /* If we're in the same place, ignore it */
+ /* If we're in the same place, ignore it. */
if (x != movement_pos.X || y != movement_pos.Y)
{
SELECTED_FRAME ()->mouse_moved = 1;
struct input_event *emacs_ev)
{
static DWORD button_state = 0;
+ static Lisp_Object last_mouse_window;
DWORD but_change, mask;
int i;
if (event->dwEventFlags == MOUSE_MOVED)
{
- /* For movement events we just note that the mouse has moved
- so that emacs will generate drag events. */
- mouse_moved_to (event->dwMousePosition.X, event->dwMousePosition.Y);
+ FRAME_PTR f = SELECTED_FRAME ();
+ Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
+ int mx = event->dwMousePosition.X, my = event->dwMousePosition.Y;
+
+ mouse_moved_to (mx, my);
+
+ if (f->mouse_moved)
+ {
+ if (hlinfo->mouse_face_hidden)
+ {
+ hlinfo->mouse_face_hidden = 0;
+ clear_mouse_face (hlinfo);
+ }
+
+ /* Generate SELECT_WINDOW_EVENTs when needed. */
+ if (!NILP (Vmouse_autoselect_window))
+ {
+ Lisp_Object mouse_window = window_from_coordinates (f, mx, my,
+ 0, 0);
+ /* A window will be selected only when it is not
+ selected now, and the last mouse movement event was
+ not in it. A minibuffer window will be selected iff
+ it is active. */
+ if (WINDOWP (mouse_window)
+ && !EQ (mouse_window, last_mouse_window)
+ && !EQ (mouse_window, selected_window))
+ {
+ struct input_event event;
+
+ EVENT_INIT (event);
+ event.kind = SELECT_WINDOW_EVENT;
+ event.frame_or_window = mouse_window;
+ event.arg = Qnil;
+ event.timestamp = movement_time;
+ kbd_buffer_store_event (&event);
+ }
+ last_mouse_window = mouse_window;
+ }
+ else
+ last_mouse_window = Qnil;
+
+ previous_help_echo_string = help_echo_string;
+ help_echo_string = help_echo_object = help_echo_window = Qnil;
+ help_echo_pos = -1;
+ note_mouse_highlight (f, mx, my);
+ /* If the contents of the global variable help_echo has
+ changed (inside note_mouse_highlight), generate a HELP_EVENT. */
+ if (!NILP (help_echo_string) || !NILP (previous_help_echo_string))
+ gen_help_event (help_echo_string, selected_frame, help_echo_window,
+ help_echo_object, help_echo_pos);
+ }
return 0;
}
int
w32_console_read_socket (struct terminal *terminal,
- int expected,
struct input_event *hold_quit)
{
- int nev, ret = 0, add;
+ int nev, add;
int isdead;
- if (interrupt_input_blocked)
- {
- interrupt_input_pending = 1;
- return -1;
- }
-
- interrupt_input_pending = 0;
- BLOCK_INPUT;
+ block_input ();
for (;;)
{
/* If nev == -1, there was some kind of error
If nev == 0 then waitp must be zero and no events were available
so return. */
- UNBLOCK_INPUT;
- return nev;
+ break;
}
while (nev > 0)
queue_ptr++;
nev--;
}
-
- if (ret > 0 || expected == 0)
- break;
}
/* We don't get told about changes in the window size (only the buffer
if (!w32_use_full_screen_buffer)
maybe_generate_resize_event ();
- UNBLOCK_INPUT;
- return ret;
+ unblock_input ();
+ return nev;
}
-/* Input routines for GNU Emacs on the Microsoft W32 API.
+/* Input routines for GNU Emacs on the Microsoft Windows API.
Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#ifndef EMACS_W32INEVT_H
#define EMACS_W32INEVT_H
-extern int w32_console_read_socket (struct terminal *term, int numchars,
+extern int w32_console_unicode_input;
+
+extern int w32_console_read_socket (struct terminal *term,
struct input_event *hold_quit);
extern void w32_console_mouse_position (FRAME_PTR *f, int insist,
Lisp_Object *bar_window,
unsigned long *time);
#endif /* EMACS_W32INEVT_H */
-
-/* Menu support for GNU Emacs on the Microsoft W32 API.
+/* Menu support for GNU Emacs on the Microsoft Windows API.
Copyright (C) 1986, 1988, 1993-1994, 1996, 1998-1999, 2001-2012
Free Software Foundation, Inc.
#include <signal.h>
#include <stdio.h>
#include <mbstring.h>
-#include <setjmp.h>
#include "lisp.h"
#include "keyboard.h"
#include "termhooks.h"
#include "window.h"
#include "blockinput.h"
+#include "character.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
if this is not done before the other system files. */
#include "w32term.h"
-#include "w32heap.h"
-
/* Load sys/types.h if not already loaded.
In some systems loading it twice is suicidal. */
#ifndef makedev
#include "dispextern.h"
+#include "w32heap.h" /* for osinfo_cache */
+
#undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
#ifndef TRUE
Lisp_Object Qdebug_on_next_call;
-void set_frame_menubar (FRAME_PTR, int, int);
+void set_frame_menubar (FRAME_PTR, bool, bool);
#ifdef HAVE_DIALOGS
static Lisp_Object w32_dialog_show (FRAME_PTR, int, Lisp_Object, char**);
}
else if (CONSP (position))
{
- Lisp_Object tem;
- tem = Fcar (position);
+ Lisp_Object tem = XCAR (position);
if (CONSP (tem))
- window = Fcar (Fcdr (position));
+ window = Fcar (XCDR (position));
else
{
- tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
+ tem = Fcar (XCDR (position)); /* EVENT_START (position) */
window = Fcar (tem); /* POSN_WINDOW (tem) */
}
}
list_of_panes (Fcons (contents, Qnil));
/* Display them in a dialog box. */
- BLOCK_INPUT;
+ block_input ();
selection = w32_dialog_show (f, 0, title, header, &error_name);
- UNBLOCK_INPUT;
+ unblock_input ();
discard_menu_items ();
FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
if (!f)
return;
entry = Qnil;
- subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
+ subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * word_size);
vector = f->menu_bar_vector;
prefix = Qnil;
i = 0;
it is set the first time this is called, from initialize_frame_menubar. */
void
-set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
+set_frame_menubar (FRAME_PTR f, bool first_time, bool deep_p)
{
HMENU menubar_widget = f->output_data.w32->menubar_widget;
Lisp_Object items;
struct buffer *prev = current_buffer;
Lisp_Object buffer;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
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. */
/* 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_menu_bar_items (f, 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 (f->menu_bar_vector)->contents,
- previous_menu_items_used * sizeof (Lisp_Object));
+ previous_menu_items_used * word_size);
/* Fill in menu_items with the current menu bar contents.
This can evaluate Lisp code. */
return;
}
- f->menu_bar_vector = menu_items;
+ fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
/* This undoes save_menu_items. */
/* Create or update the menu bar widget. */
- BLOCK_INPUT;
+ block_input ();
if (menubar_widget)
{
x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Called from Fx_create_frame to create the initial menubar of a frame
{
/* 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_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
set_frame_menubar (f, 1, 1);
}
void
free_frame_menubar (FRAME_PTR f)
{
- BLOCK_INPUT;
+ block_input ();
{
HMENU old = GetMenu (FRAME_W32_WINDOW (f));
DestroyMenu (old);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
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;
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else
- abort ();
+ emacs_abort ();
wv->selected = !NILP (selected);
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;
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
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);
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)
{
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,
until it is ready to be displayed, since GC can happen while
menus are active. */
if (!NILP (wv->help))
-#ifdef USE_LISP_UNION_TYPE
- info.dwItemData = (DWORD) (wv->help).i;
-#else
- info.dwItemData = (DWORD) (wv->help);
-#endif
+ {
+ /* As of Jul-2012, w32api headers say that dwItemData
+ has DWORD type, but that's a bug: it should actually
+ be ULONG_PTR, which is correct for 32-bit and 64-bit
+ Windows alike. MSVC headers get it right; hopefully,
+ MinGW headers will, too. */
+ info.dwItemData = (ULONG_PTR) XLI (wv->help);
+ }
if (wv->button_type == BUTTON_TYPE_RADIO)
{
/* CheckMenuRadioItem allows us to differentiate TOGGLE and
info.fMask = MIIM_DATA;
get_menu_item_info (menu, item, FALSE, &info);
-#ifdef USE_LISP_UNION_TYPE
- help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
- : Qnil;
-#else
- help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
-#endif
+ help = info.dwItemData ? XIL (info.dwItemData) : Qnil;
}
/* Store the help echo in the keyboard buffer as the X toolkit
-/* Process support for GNU Emacs on the Microsoft W32 API.
+/* Process support for GNU Emacs on the Microsoft Windows API.
Copyright (C) 1992, 1995, 1999-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <fcntl.h>
#include <signal.h>
#include <sys/file.h>
-#include <setjmp.h>
/* must include CRT headers *before* config.h */
#include <config.h>
/* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
static signal_handler sig_handlers[NSIG];
-/* Fake signal implementation to record the SIGCHLD handler. */
+/* Improve on the CRT 'signal' implementation so that we could record
+ the SIGCHLD handler. */
signal_handler
sys_signal (int sig, signal_handler handler)
{
signal_handler old;
- if (sig != SIGCHLD)
+ /* SIGCHLD is needed for supporting subprocesses, see sys_kill
+ below. All the others are the only ones supported by the MS
+ runtime. */
+ if (!(sig == SIGCHLD || sig == SIGSEGV || sig == SIGILL
+ || sig == SIGFPE || sig == SIGABRT || sig == SIGTERM))
{
errno = EINVAL;
return SIG_ERR;
}
old = sig_handlers[sig];
- sig_handlers[sig] = handler;
+ /* SIGABRT is treated specially because w32.c installs term_ntproc
+ as its handler, so we don't want to override that afterwards.
+ Aborting Emacs works specially anyway: either by calling
+ emacs_abort directly or through terminate_due_to_signal, which
+ calls emacs_abort through emacs_raise. */
+ if (!(sig == SIGABRT && old == term_ntproc))
+ {
+ sig_handlers[sig] = handler;
+ if (sig != SIGCHLD)
+ signal (sig, handler);
+ }
return old;
}
+/* Emulate sigaction. */
+int
+sigaction (int sig, const struct sigaction *act, struct sigaction *oact)
+{
+ signal_handler old = SIG_DFL;
+ int retval = 0;
+
+ if (act)
+ old = sys_signal (sig, act->sa_handler);
+ else if (oact)
+ old = sig_handlers[sig];
+
+ if (old == SIG_ERR)
+ {
+ errno = EINVAL;
+ retval = -1;
+ }
+ if (oact)
+ {
+ oact->sa_handler = old;
+ oact->sa_flags = 0;
+ oact->sa_mask = empty_mask;
+ }
+ return retval;
+}
+
/* Defined in <process.h> which conflicts with the local copy */
#define _P_NOWAIT 1
/* Should not be deleting a child that is still needed. */
for (i = 0; i < MAXDESC; i++)
if (fd_info[i].cp == cp)
- abort ();
+ emacs_abort ();
if (!CHILD_ACTIVE (cp))
return;
DWORD flags;
char dir[ MAXPATHLEN ];
- if (cp == NULL) abort ();
+ if (cp == NULL) emacs_abort ();
memset (&start, 0, sizeof (start));
start.cb = sizeof (start);
if (fd_info[fd].cp != NULL)
{
DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd));
- abort ();
+ emacs_abort ();
}
fd_info[fd].cp = cp;
/* We want to wait for a specific child */
wait_hnd[nh] = dead_child->procinfo.hProcess;
cps[nh] = dead_child;
- if (!wait_hnd[nh]) abort ();
+ if (!wait_hnd[nh]) emacs_abort ();
nh++;
active = 0;
goto get_result;
active -= WAIT_ABANDONED_0;
}
else
- abort ();
+ emacs_abort ();
get_result:
if (!GetExitCodeProcess (wait_hnd[active], &retval))
/* 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);
}
/* Handle executable names without an executable suffix. */
- program = make_string (cmdname, strlen (cmdname));
+ program = build_string (cmdname);
if (NILP (Ffile_executable_p (program)))
{
struct gcpro gcpro1;
unixtodos_filename (cmdname);
argv[0] = cmdname;
- /* Determine whether program is a 16-bit DOS executable, or a w32
+ /* Determine whether program is a 16-bit DOS executable, or a 32-bit Windows
executable that is implicitly linked to the Cygnus dll (implying it
was compiled with the Cygnus GNU toolchain and hence relies on
cygwin.dll to parse the command line - we use this to decide how to
int
sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
- EMACS_TIME *timeout)
+ EMACS_TIME *timeout, void *ignored)
{
SELECT_TYPE orfds;
DWORD timeout_ms, start_time;
HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */
- timeout_ms = timeout ? (timeout->tv_sec * 1000 + timeout->tv_usec / 1000) : INFINITE;
+ timeout_ms =
+ timeout ? (timeout->tv_sec * 1000 + timeout->tv_nsec / 1000000) : INFINITE;
/* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
#endif
wait_hnd[nh] = cp->char_avail;
fdindex[nh] = i;
- if (!wait_hnd[nh]) abort ();
+ if (!wait_hnd[nh]) emacs_abort ();
nh++;
#ifdef FULL_DEBUG
DebPrint (("select waiting on child %d fd %d\n",
active -= WAIT_ABANDONED_0;
}
else
- abort ();
+ emacs_abort ();
/* Loop over all handles after active (now officially documented as
being the first signaled handle in the array). We do this to
GetClassName (hwnd, window_class, sizeof (window_class));
if (strcmp (window_class,
- (os_subtype == OS_WIN95)
+ (os_subtype == OS_9X)
? "tty"
: "ConsoleWindowClass") == 0)
{
return TRUE;
}
+/* Emulate 'kill', but only for other processes. */
int
sys_kill (int pid, int sig)
{
cp = find_child_pid (pid);
if (cp == NULL)
{
+ /* We were passed a PID of something other than our subprocess.
+ If that is our own PID, we will send to ourself a message to
+ close the selected frame, which does not necessarily
+ terminates Emacs. But then we are not supposed to call
+ sys_kill with our own PID. */
proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
if (proc_hand == NULL)
{
if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
{
#if 1
- if (os_subtype == OS_WIN95)
+ if (os_subtype == OS_9X)
{
/*
Another possibility is to try terminating the VDM out-right by
*/
#if 0
- /* On Win95, posting WM_QUIT causes the 16-bit subsystem
+ /* On Windows 95, posting WM_QUIT causes the 16-bit subsystem
to hang when cmdproxy is used in conjunction with
command.com for an interactive shell. Posting
WM_CLOSE pops up a dialog that, when Yes is selected,
CHECK_NUMBER (process);
/* Allow pid to be an internally generated one, or one obtained
- externally. This is necessary because real pids on Win95 are
+ externally. This is necessary because real pids on Windows 95 are
negative. */
pid = XINT (process);
got_full = GetLocaleInfo (XINT (lcid),
XINT (longform),
full_name, sizeof (full_name));
+ /* GetLocaleInfo's return value includes the terminating null
+ character, when the returned information is a string, whereas
+ make_unibyte_string needs the string length without the
+ terminating null. */
if (got_full)
- return make_unibyte_string (full_name, got_full);
+ return make_unibyte_string (full_name, got_full - 1);
}
return Qnil;
/* Written by Kevin Gallo */
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "w32term.h"
#include "blockinput.h"
trykey:
- BLOCK_INPUT;
+ block_input ();
/* Check both the current user and the local machine to see if we have
any resources */
}
ok = (keyname
- && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL
+ && (lpvalue = xmalloc (cbData)) != NULL
&& RegQueryValueEx (hrootkey, keyname, NULL, NULL, lpvalue, &cbData) == ERROR_SUCCESS);
RegCloseKey (hrootkey);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (!ok)
{
-/* Selection processing for Emacs on the Microsoft W32 API.
+/* Selection processing for Emacs on the Microsoft Windows API.
Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc.
*/
#include <config.h>
-#include <setjmp.h>
#include "lisp.h"
#include "w32term.h" /* for all of the w32 includes */
#include "w32heap.h" /* os_subtype */
setup_windows_coding_system (coding_system, &coding);
coding.dst_bytes = SBYTES (current_text) * 2;
- coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+ coding.destination = xmalloc (coding.dst_bytes);
encode_coding_object (&coding, current_text, 0, 0,
SCHARS (current_text), SBYTES (current_text), Qnil);
extern int waiting_for_input; /* from keyboard.c */
int owfi;
- BLOCK_INPUT;
+ block_input ();
- /* Fsignal calls abort() if it sees that waiting_for_input is
+ /* Fsignal calls emacs_abort () if it sees that waiting_for_input is
set. */
owfi = waiting_for_input;
waiting_for_input = 0;
waiting_for_input = owfi;
- UNBLOCK_INPUT;
+ unblock_input ();
}
static Lisp_Object
{
/* This is needed to trigger WM_RENDERALLFORMATS. */
if (clipboard_owner != NULL)
- DestroyWindow (clipboard_owner);
+ {
+ DestroyWindow (clipboard_owner);
+ clipboard_owner = NULL;
+ }
}
static void
current_num_nls = 0;
current_requires_encoding = 0;
- BLOCK_INPUT;
+ block_input ();
/* Check for non-ASCII characters. While we are at it, count the
number of LFs, so we know how many CRs we will have to add later
current_coding_system = Qnil;
done:
- UNBLOCK_INPUT;
+ unblock_input ();
return (ok ? string : Qnil);
}
setup_config ();
actual_clipboard_type = cfg_clipboard_type;
- BLOCK_INPUT;
+ block_input ();
if (!OpenClipboard (clipboard_owner))
goto done;
CloseClipboard ();
done:
- UNBLOCK_INPUT;
+ unblock_input ();
return (ret);
}
-/* Implementation of GUI terminal on the Microsoft W32 API.
+/* Implementation of GUI terminal on the Microsoft Windows API.
Copyright (C) 1989, 1993-2012 Free Software Foundation, Inc.
#include <config.h>
#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "blockinput.h"
#include "w32term.h"
int last_scroll_bar_drag_pos;
+/* Keyboard code page - may be changed by language-change events. */
+int w32_keyboard_codepage;
+
/* Mouse movement. */
/* Where the mouse was last time we reported a mouse event. */
static int input_signal_count;
#endif
-/* Keyboard code page - may be changed by language-change events. */
-static int keyboard_codepage;
-
static void x_update_window_end (struct window *, int, int);
static void w32_handle_tool_bar_click (struct frame *,
struct input_event *);
void x_lower_frame (struct frame *);
void x_scroll_bar_clear (struct frame *);
-void x_wm_set_size_hint (struct frame *, long, int);
+void x_wm_set_size_hint (struct frame *, long, bool);
void x_raise_frame (struct frame *);
void x_set_window_size (struct frame *, int, int, int);
void x_wm_set_window_state (struct frame *, int);
static void my_set_foreground_window (HWND);
static void my_destroy_window (struct frame *, HWND);
+#ifdef GLYPH_DEBUG
+static void x_check_font (struct frame *, struct font *);
+#endif
+
static Lisp_Object Qvendor_specific_keysyms;
\f
XGCValues *
XCreateGC (void *ignore, Window window, unsigned long mask, XGCValues *xgcv)
{
- XGCValues *gc = (XGCValues *) xmalloc (sizeof (XGCValues));
- memset (gc, 0, sizeof (XGCValues));
+ XGCValues *gc = xzalloc (sizeof (XGCValues));
XChangeGC (ignore, gc, mask, xgcv);
SelectClipRgn (hdc, NULL);
}
+/* Restore clipping rectangle in S */
+static void
+w32_restore_glyph_string_clip (struct glyph_string *s)
+{
+ RECT *r = s->clip;
+ int n = s->num_clips;
+
+ if (n == 1)
+ w32_set_clip_rectangle (s->hdc, r);
+ else if (n > 1)
+ {
+ HRGN clip1 = CreateRectRgnIndirect (r);
+ HRGN clip2 = CreateRectRgnIndirect (r + 1);
+ if (CombineRgn (clip1, clip1, clip2, RGN_OR) != ERROR)
+ SelectClipRgn (s->hdc, clip1);
+ DeleteObject (clip1);
+ DeleteObject (clip2);
+ }
+}
+
+/*
+ Draw a wavy line under S. The wave fills wave_height pixels from y0.
+
+ x0 wave_length = 2
+ --
+ y0 * * * * *
+ |* * * * * * * * *
+ wave_height = 3 | * * * *
+
+*/
+
+void
+w32_draw_underwave (struct glyph_string *s, COLORREF color)
+{
+ int wave_height = 2, wave_length = 3;
+ int dx, dy, x0, y0, width, x1, y1, x2, y2, odd, xmax;
+ XRectangle wave_clip, string_clip, final_clip;
+ RECT w32_final_clip, w32_string_clip;
+ HPEN hp, oldhp;
+
+ dx = wave_length;
+ dy = wave_height - 1;
+ x0 = s->x;
+ y0 = s->ybase + 1;
+ width = s->width;
+ xmax = x0 + width;
+
+ /* Find and set clipping rectangle */
+
+ wave_clip = (XRectangle){ x0, y0, width, wave_height };
+ get_glyph_string_clip_rect (s, &w32_string_clip);
+ CONVERT_TO_XRECT (string_clip, w32_string_clip);
+
+ if (!x_intersect_rectangles (&wave_clip, &string_clip, &final_clip))
+ return;
+
+ hp = CreatePen (PS_SOLID, 0, color);
+ oldhp = SelectObject (s->hdc, hp);
+ CONVERT_FROM_XRECT (final_clip, w32_final_clip);
+ w32_set_clip_rectangle (s->hdc, &w32_final_clip);
+
+ /* Draw the waves */
+
+ x1 = x0 - (x0 % dx);
+ x2 = x1 + dx;
+ odd = (x1/dx) % 2;
+ y1 = y2 = y0;
+
+ if (odd)
+ y1 += dy;
+ else
+ y2 += dy;
+
+ MoveToEx (s->hdc, x1, y1, NULL);
+
+ while (x1 <= xmax)
+ {
+ LineTo (s->hdc, x2, y2);
+ x1 = x2, y1 = y2;
+ x2 += dx, y2 = y0 + odd*dy;
+ odd = !odd;
+ }
+
+ /* Restore previous pen and clipping rectangle(s) */
+ w32_restore_glyph_string_clip (s);
+ SelectObject (s->hdc, oldhp);
+ DeleteObject (hp);
+}
/* Draw a hollow rectangle at the specified position. */
void
updated_window = w;
set_output_cursor (&w->cursor);
- BLOCK_INPUT;
+ block_input ();
if (f == hlinfo->mouse_face_mouse_frame)
{
#endif /* 0 */
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Draw a vertical window border from (x,y0) to (x,y1) */
if (!w->pseudo_window_p)
{
- BLOCK_INPUT;
+ block_input ();
if (cursor_on_p)
display_and_set_cursor (w, 1, output_cursor.hpos,
if (draw_window_fringes (w, 1))
x_draw_vertical_border (w);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If a row with mouse-face was overwritten, arrange for
if (hlinfo->mouse_face_deferred_gc
|| f == hlinfo->mouse_face_mouse_frame)
{
- BLOCK_INPUT;
+ block_input ();
if (hlinfo->mouse_face_mouse_frame)
note_mouse_highlight (hlinfo->mouse_face_mouse_frame,
hlinfo->mouse_face_mouse_x,
hlinfo->mouse_face_mouse_y);
hlinfo->mouse_face_deferred_gc = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
}
struct frame *f;
int width, height;
- xassert (w);
+ eassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p)
desired_row->redraw_fringe_bitmaps_p = 1;
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
- BLOCK_INPUT;
+ block_input ();
{
HDC hdc = get_frame_dc (f);
w32_clear_area (f, hdc, 0, y, width, height);
y, width, height);
release_frame_dc (f, hdc);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
s->gc = FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
- xassert (s->gc != 0);
+ eassert (s->gc != 0);
}
}
/* GC must have been set. */
- xassert (s->gc != 0);
+ eassert (s->gc != 0);
}
delta /= 256;
/* Change RGB values by specified FACTOR. Avoid overflow! */
- xassert (factor >= 0);
+ eassert (factor >= 0);
new = PALETTERGB (min (0xff, factor * GetRValue (*color)),
min (0xff, factor * GetGValue (*color)),
min (0xff, factor * GetBValue (*color)));
static void
x_draw_stretch_glyph_string (struct glyph_string *s)
{
- xassert (s->first_glyph->type == STRETCH_GLYPH);
+ eassert (s->first_glyph->type == STRETCH_GLYPH);
if (s->hl == DRAW_CURSOR
&& !x_stretch_cursor_p)
break;
default:
- abort ();
+ emacs_abort ();
}
if (!s->for_overlaps)
/* Draw underline. */
if (s->face->underline_p)
{
- unsigned long thickness, position;
- int y;
-
- if (s->prev && s->prev->face->underline_p)
+ if (s->face->underline_type == FACE_UNDER_WAVE)
{
- /* We use the same underline style as the previous one. */
- thickness = s->prev->underline_thickness;
- position = s->prev->underline_position;
+ COLORREF color;
+
+ if (s->face->underline_defaulted_p)
+ color = s->gc->foreground;
+ else
+ color = s->face->underline_color;
+
+ w32_draw_underwave (s, color);
}
- else
+ else if (s->face->underline_type == FACE_UNDER_LINE)
{
- /* Get the underline thickness. Default is 1 pixel. */
- if (s->font && s->font->underline_thickness > 0)
- thickness = s->font->underline_thickness;
+ unsigned long thickness, position;
+ int y;
+
+ if (s->prev && s->prev->face->underline_p)
+ {
+ /* We use the same underline style as the previous one. */
+ thickness = s->prev->underline_thickness;
+ position = s->prev->underline_position;
+ }
else
- thickness = 1;
- if (x_underline_at_descent_line)
- position = (s->height - thickness) - (s->ybase - s->y);
+ {
+ /* Get the underline thickness. Default is 1 pixel. */
+ if (s->font && s->font->underline_thickness > 0)
+ thickness = s->font->underline_thickness;
+ else
+ thickness = 1;
+ if (x_underline_at_descent_line)
+ position = (s->height - thickness) - (s->ybase - s->y);
+ else
+ {
+ /* Get the underline position. This is the recommended
+ vertical offset in pixels from the baseline to the top of
+ the underline. This is a signed value according to the
+ specs, and its default is
+
+ ROUND ((maximum_descent) / 2), with
+ ROUND (x) = floor (x + 0.5) */
+
+ if (x_use_underline_position_properties
+ && s->font && s->font->underline_position >= 0)
+ position = s->font->underline_position;
+ else if (s->font)
+ position = (s->font->descent + 1) / 2;
+ }
+ position = max (position, underline_minimum_offset);
+ }
+ /* Check the sanity of thickness and position. We should
+ avoid drawing underline out of the current line area. */
+ if (s->y + s->height <= s->ybase + position)
+ position = (s->height - 1) - (s->ybase - s->y);
+ if (s->y + s->height < s->ybase + position + thickness)
+ thickness = (s->y + s->height) - (s->ybase + position);
+ s->underline_thickness = thickness;
+ s->underline_position =position;
+ y = s->ybase + position;
+ if (s->face->underline_defaulted_p)
+ {
+ w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
+ y, s->width, 1);
+ }
else
{
- /* Get the underline position. This is the recommended
- vertical offset in pixels from the baseline to the top of
- the underline. This is a signed value according to the
- specs, and its default is
-
- ROUND ((maximum_descent) / 2), with
- ROUND (x) = floor (x + 0.5) */
-
- if (x_use_underline_position_properties
- && s->font && s->font->underline_position >= 0)
- position = s->font->underline_position;
- else if (s->font)
- position = (s->font->descent + 1) / 2;
+ w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
+ y, s->width, 1);
}
- position = max (position, underline_minimum_offset);
- }
- /* Check the sanity of thickness and position. We should
- avoid drawing underline out of the current line area. */
- if (s->y + s->height <= s->ybase + position)
- position = (s->height - 1) - (s->ybase - s->y);
- if (s->y + s->height < s->ybase + position + thickness)
- thickness = (s->y + s->height) - (s->ybase + position);
- s->underline_thickness = thickness;
- s->underline_position =position;
- y = s->ybase + position;
- if (s->face->underline_defaulted_p)
- {
- w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
- y, s->width, 1);
- }
- else
- {
- w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
- y, s->width, 1);
}
}
/* Draw overline. */
w32_set_clip_rectangle (next->hdc, NULL);
next->hl = save;
next->num_clips = 0;
+ next->clip_head = s->next;
}
}
}
if (! FRAME_W32_P (f))
return;
- abort ();
+ emacs_abort ();
}
/* We don't set the output cursor here because there will always
follow an explicit cursor_to. */
- BLOCK_INPUT;
+ block_input ();
w32_clear_window (f);
colors or something like that, then they should be notified. */
x_scroll_bar_clear (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
static void
w32_ring_bell (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
if (FRAME_W32_P (f) && visible_bell)
{
else
w32_sys_ring_bell (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
if (! FRAME_W32_P (f))
return;
- abort ();
+ emacs_abort ();
}
expect_dirty = CreateRectRgn (x, y, x + width, to_y);
}
- BLOCK_INPUT;
+ block_input ();
/* Cursor off. Will be switched on again in x_update_window_end. */
updated_window = w;
DeleteObject (combined);
}
- UNBLOCK_INPUT;
+ unblock_input ();
DeleteObject (expect_dirty);
}
: dpyinfo->w32_focus_frame);
if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame))
{
- FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame) = Qnil;
+ fset_focus_frame (dpyinfo->w32_focus_frame, Qnil);
dpyinfo->x_highlight_frame = dpyinfo->w32_focus_frame;
}
}
/* Make static so we can always return it */
static char value[100];
- BLOCK_INPUT;
+ block_input ();
GetKeyNameText (keysym, value, 100);
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
{
FRAME_PTR f1;
- BLOCK_INPUT;
+ block_input ();
if (! NILP (last_mouse_scroll_bar) && insist == 0)
x_scroll_bar_report_motion (fp, bar_window, part, x, y, time);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
frame = XCAR (tail);
/* All elements of Vframe_list should be frames. */
if (! FRAMEP (frame))
- abort ();
+ emacs_abort ();
/* Scan this frame's scroll bar list for a scroll bar with the
right window ID. */
if (draggingp)
{
int near_bottom_p;
- BLOCK_INPUT;
+ block_input ();
si.cbSize = sizeof (si);
si.fMask = SIF_POS | SIF_PAGE;
GetScrollInfo (w, SB_CTL, &si);
near_bottom_p = si.nPos + si.nPage >= range;
- UNBLOCK_INPUT;
+ unblock_input ();
if (!near_bottom_p)
return;
}
sb_page = max (sb_page, VERTICAL_SCROLL_BAR_MIN_HANDLE);
- BLOCK_INPUT;
+ block_input ();
si.cbSize = sizeof (si);
si.fMask = SIF_PAGE | SIF_POS;
SetScrollInfo (w, SB_CTL, &si, TRUE);
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
(WPARAM) hwnd, 0);
}
+static void
+my_bring_window_to_top (HWND hwnd)
+{
+ SendMessage (hwnd, WM_EMACS_BRINGTOTOP, (WPARAM) hwnd, 0);
+}
+
/* Create a scroll bar and return the scroll bar vector for it. W is
the Emacs window on which to create the scroll bar. TOP, LEFT,
WIDTH and HEIGHT are the pixel coordinates and dimensions of the
SCROLLINFO si;
struct scroll_bar *bar
= XSCROLL_BAR (Fmake_vector (make_number (SCROLL_BAR_VEC_SIZE), Qnil));
+ Lisp_Object barobj;
- BLOCK_INPUT;
+ block_input ();
XSETWINDOW (bar->window, w);
XSETINT (bar->top, top);
/* 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_scroll_bars (f, barobj);
if (! NILP (bar->next))
XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
- UNBLOCK_INPUT;
+ unblock_input ();
return bar;
}
{
FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
- BLOCK_INPUT;
+ block_input ();
/* Destroy the window. */
my_destroy_window (f, SCROLL_BAR_W32_WINDOW (bar));
/* Dissociate this scroll bar from its window. */
- XWINDOW (bar->window)->vertical_scroll_bar = Qnil;
+ wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Set the handle of the vertical scroll bar for WINDOW to indicate
int portion, int whole, int position)
{
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;
if (NILP (w->vertical_scroll_bar))
{
HDC hdc;
- BLOCK_INPUT;
+ block_input ();
if (width > 0 && height > 0)
{
hdc = get_frame_dc (f);
w32_clear_area (f, hdc, left, top, width, height);
release_frame_dc (f, hdc);
}
- UNBLOCK_INPUT;
+ unblock_input ();
bar = x_scroll_bar_create (w, top, sb_left, sb_width, height);
}
HDC hdc;
SCROLLINFO si;
- BLOCK_INPUT;
+ block_input ();
if (width && height)
{
hdc = get_frame_dc (f);
XSETINT (bar->width, sb_width);
XSETINT (bar->height, height);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
bar->fringe_extended_p = fringe_extended_p ? Qt : Qnil;
w32_set_scroll_bar_thumb (bar, portion, position, whole);
-
- XSETVECTOR (w->vertical_scroll_bar, bar);
+ XSETVECTOR (barobj, bar);
+ wset_vertical_scroll_bar (w, barobj);
}
{
Lisp_Object bar;
bar = FRAME_SCROLL_BARS (frame);
- FRAME_SCROLL_BARS (frame) = XSCROLL_BAR (bar)->next;
+ fset_scroll_bars (frame, 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_condemned_scroll_bars (frame, bar);
}
}
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 (window->vertical_scroll_bar))
- abort ();
+ emacs_abort ();
bar = XSCROLL_BAR (window->vertical_scroll_bar);
return;
else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f),
window->vertical_scroll_bar))
- FRAME_CONDEMNED_SCROLL_BARS (f) = bar->next;
+ fset_condemned_scroll_bars (f, bar->next);
else
/* If its prev pointer is nil, it must be at the front of
one or the other! */
- abort ();
+ emacs_abort ();
}
else
XSCROLL_BAR (bar->prev)->next = bar->next;
bar->next = FRAME_SCROLL_BARS (f);
bar->prev = Qnil;
- XSETVECTOR (FRAME_SCROLL_BARS (f), bar);
+ XSETVECTOR (barobj, bar);
+ fset_scroll_bars (f, barobj);
if (! NILP (bar->next))
XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
}
/* 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_condemned_scroll_bars (f, Qnil);
for (; ! NILP (bar); bar = next)
{
struct input_event *emacs_event)
{
if (! WINDOWP (bar->window))
- abort ();
+ emacs_abort ();
emacs_event->kind = SCROLL_BAR_CLICK_EVENT;
emacs_event->code = 0;
int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (f, XINT (bar->height));
SCROLLINFO si;
- BLOCK_INPUT;
+ block_input ();
*fp = f;
*bar_window = bar->window;
*time = last_mouse_movement_time;
- UNBLOCK_INPUT;
+ unblock_input ();
}
We return the number of characters stored into the buffer,
thus pretending to be `read'.
- EXPECTED is nonzero if the caller knows input is available.
-
Some of these messages are reposted back to the message queue since the
system calls the windows proc directly in a context where we cannot return
the data nor can we guarantee the state we are in. So if we dispatch them
*/
static int
-w32_read_socket (struct terminal *terminal, int expected,
+w32_read_socket (struct terminal *terminal,
struct input_event *hold_quit)
{
int count = 0;
struct w32_display_info *dpyinfo = &one_w32_display_info;
Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight;
- if (interrupt_input_blocked)
- {
- interrupt_input_pending = 1;
- return -1;
- }
-
- interrupt_input_pending = 0;
- BLOCK_INPUT;
+ block_input ();
/* So people can tell when we have read the available input. */
input_signal_count++;
/* Generate a language change event. */
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
- /* lParam contains the input lang ID. Use it to update our
- record of the keyboard codepage. */
- keyboard_codepage = codepage_for_locale ((LCID)(msg.msg.lParam
- & 0xffff));
+ /* lParam contains the input language ID in its low 16 bits.
+ Use it to update our record of the keyboard codepage. */
+ w32_keyboard_codepage = codepage_for_locale ((LCID)(msg.msg.lParam
+ & 0xffff));
if (f)
{
inev.kind = LANGUAGE_CHANGE_EVENT;
XSETFRAME (inev.frame_or_window, f);
- inev.code = msg.msg.wParam;
+ inev.code = w32_keyboard_codepage;
inev.modifiers = msg.msg.lParam & 0xffff;
}
break;
{
dbcs[0] = dbcs_lead;
dbcs_lead = 0;
- if (!MultiByteToWideChar (keyboard_codepage, 0,
+ if (!MultiByteToWideChar (w32_keyboard_codepage, 0,
dbcs, 2, &code, 1))
{
/* Garbage */
break;
}
}
- else if (IsDBCSLeadByteEx (keyboard_codepage,
+ else if (IsDBCSLeadByteEx (w32_keyboard_codepage,
(BYTE) msg.msg.wParam))
{
dbcs_lead = (char) msg.msg.wParam;
}
else
{
- if (!MultiByteToWideChar (keyboard_codepage, 0,
+ if (!MultiByteToWideChar (w32_keyboard_codepage, 0,
&dbcs[1], 1, &code, 1))
{
/* What to do with garbage? */
/* If the contents of the global variable help_echo_string
has changed, generate a HELP_EVENT. */
-#if 0 /* The below is an invalid comparison when USE_LISP_UNION_TYPE.
+#if 0 /* The below is an invalid comparison when CHECK_LISP_OBJECT_TYPE.
But it was originally changed to this to fix a bug, so I have
not removed it completely in case the bug is still there. */
if (help_echo_string != previous_help_echo_string ||
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return count;
}
break;
default:
- abort ();
+ emacs_abort ();
}
}
}
}
x_calc_absolute_position (f);
- BLOCK_INPUT;
+ block_input ();
x_wm_set_size_hint (f, (long) 0, 0);
modified_left = f->left_pos;
modified_left, modified_top,
0, 0,
SWP_NOZORDER | SWP_NOSIZE | SWP_NOACTIVATE);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* 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)
{
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;
}
}
{
int pixelwidth, pixelheight;
- BLOCK_INPUT;
+ block_input ();
check_frame_size (f, &rows, &cols);
f->scroll_bar_actual_width
cancel_mouse_face (f);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
/* Mouse warping. */
RECT rect;
POINT pt;
- BLOCK_INPUT;
+ block_input ();
GetClientRect (FRAME_W32_WINDOW (f), &rect);
pt.x = rect.left + pix_x;
SetCursorPos (pt.x, pt.y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
struct w32_display_info *dpyinfo = &one_w32_display_info;
/* Give input focus to frame. */
- BLOCK_INPUT;
+ block_input ();
#if 0
/* Try not to change its Z-order if possible. */
if (x_window_to_frame (dpyinfo, GetForegroundWindow ()))
else
#endif
my_set_foreground_window (FRAME_W32_WINDOW (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
void
void
x_raise_frame (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
/* Strictly speaking, raise-frame should only change the frame's Z
order, leaving input focus unchanged. This is reasonable behavior
HDWP handle = BeginDeferWindowPos (2);
if (handle)
{
- DeferWindowPos (handle,
- FRAME_W32_WINDOW (f),
- HWND_TOP,
- 0, 0, 0, 0,
- SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE);
-
- DeferWindowPos (handle,
- GetForegroundWindow (),
- FRAME_W32_WINDOW (f),
- 0, 0, 0, 0,
- SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE);
-
- EndDeferWindowPos (handle);
+ handle = DeferWindowPos (handle,
+ FRAME_W32_WINDOW (f),
+ HWND_TOP,
+ 0, 0, 0, 0,
+ SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE);
+ if (handle)
+ {
+ handle = DeferWindowPos (handle,
+ GetForegroundWindow (),
+ FRAME_W32_WINDOW (f),
+ 0, 0, 0, 0,
+ SWP_NOSIZE | SWP_NOMOVE |
+ SWP_NOACTIVATE);
+ if (handle)
+ EndDeferWindowPos (handle);
+ }
}
}
else
{
- my_set_foreground_window (FRAME_W32_WINDOW (f));
+ my_bring_window_to_top (FRAME_W32_WINDOW (f));
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Lower frame F. */
void
x_lower_frame (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
my_set_window_pos (FRAME_W32_WINDOW (f),
HWND_BOTTOM,
0, 0, 0, 0,
SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static void
{
Lisp_Object type;
- BLOCK_INPUT;
+ block_input ();
type = x_icon_type (f);
if (!NILP (type))
int count;
/* This must come after we set COUNT. */
- UNBLOCK_INPUT;
+ unblock_input ();
XSETFRAME (frame, f);
if (FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame == f)
FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame = 0;
- BLOCK_INPUT;
+ block_input ();
my_show_window (f, FRAME_W32_WINDOW (f), SW_HIDE);
f->async_visible = 0;
f->async_iconified = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Change window state from mapped to iconified. */
if (f->async_iconified)
return;
- BLOCK_INPUT;
+ block_input ();
type = x_icon_type (f);
if (!NILP (type))
/* Simulate the user minimizing the frame. */
SendMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, SC_MINIMIZE, 0);
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
- BLOCK_INPUT;
+ block_input ();
/* We must free faces before destroying windows because some
font-driver (e.g. xft) access a window while finishing a
hlinfo->mouse_face_mouse_frame = 0;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Set the normal size hints for the window manager, for frame F.
FLAGS is the flags word to use--or 0 meaning preserve the flags
that the window now has.
- If USER_POSITION is nonzero, we set the USPosition
+ If USER_POSITION, set the USPosition
flag (this is useful when FLAGS is 0). */
void
-x_wm_set_size_hint (struct frame *f, long flags, int user_position)
+x_wm_set_size_hint (struct frame *f, long flags, bool user_position)
{
Window window = FRAME_W32_WINDOW (f);
#endif
}
+\f
+/***********************************************************************
+ Fonts
+ ***********************************************************************/
+
+#ifdef GLYPH_DEBUG
+
+/* Check that FONT is valid on frame F. It is if it can be found in F's
+ font table. */
+
+static void
+x_check_font (struct frame *f, struct font *font)
+{
+ eassert (font != NULL && ! NILP (font->props[FONT_TYPE_INDEX]));
+ if (font->driver->check)
+ eassert (font->driver->check (f, font) == 0);
+}
+
+#endif /* GLYPH_DEBUG */
+
+
\f
/***********************************************************************
Initialization
w32_display_name_list);
dpyinfo->name_list_element = XCAR (w32_display_name_list);
- dpyinfo->w32_id_name
- = (char *) xmalloc (SCHARS (Vinvocation_name)
- + SCHARS (Vsystem_name)
- + 2);
+ dpyinfo->w32_id_name = xmalloc (SCHARS (Vinvocation_name)
+ + SCHARS (Vsystem_name) + 2);
sprintf (dpyinfo->w32_id_name, "%s@%s",
SDATA (Vinvocation_name), SDATA (Vsystem_name));
/* We don't yet support separate terminals on W32, so don't try to share
keyboards between virtual terminals that are on the same physical
terminal like X does. */
- terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ terminal->kboard = xmalloc (sizeof (KBOARD));
init_kboard (terminal->kboard);
- KVAR (terminal->kboard, Vwindow_system) = intern ("w32");
+ kset_window_system (terminal->kboard, intern ("w32"));
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
/* Don't let the initial kboard remain current longer than necessary.
if (!terminal->name)
return;
- BLOCK_INPUT;
+ block_input ();
x_delete_display (dpyinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
}
struct w32_display_info *
struct terminal *terminal;
HDC hdc;
- BLOCK_INPUT;
+ block_input ();
if (!w32_initialized)
{
terminal = w32_create_terminal (dpyinfo);
/* Set the name of the terminal. */
- terminal->name = (char *) xmalloc (SBYTES (display_name) + 1);
+ terminal->name = xmalloc (SBYTES (display_name) + 1);
strncpy (terminal->name, SDATA (display_name), SBYTES (display_name));
terminal->name[SBYTES (display_name)] = 0;
init_sigio (connection);
#endif /* ! defined (SIGIO) */
- UNBLOCK_INPUT;
+ unblock_input ();
return dpyinfo;
}
{
DWORD input_locale_id = (DWORD) GetKeyboardLayout (0);
- keyboard_codepage = codepage_for_locale ((LCID) (input_locale_id & 0xffff));
+ w32_keyboard_codepage =
+ codepage_for_locale ((LCID) (input_locale_id & 0xffff));
}
/* Create the window thread - it will terminate itself when the app
from cus-start.el and other places, like "M-x set-variable". */
DEFVAR_BOOL ("x-use-underline-position-properties",
x_use_underline_position_properties,
- doc: /* *Non-nil means make use of UNDERLINE_POSITION font properties.
+ doc: /* Non-nil means make use of UNDERLINE_POSITION font properties.
A value of nil means ignore them. If you encounter fonts with bogus
UNDERLINE_POSITION font properties, for example 7x13 on XFree prior
to 4.1, set this to nil. You can also use `underline-minimum-offset'
DEFVAR_BOOL ("x-underline-at-descent-line",
x_underline_at_descent_line,
- doc: /* *Non-nil means to draw the underline at the same place as the descent line.
+ doc: /* Non-nil means to draw the underline at the same place as the descent line.
A value of nil means to draw the underline according to the value of the
variable `x-use-underline-position-properties', which is usually at the
baseline level. The default value is nil. */);
-/* Definitions and headers for communication on the Microsoft W32 API.
+/* Definitions and headers for communication on the Microsoft Windows API.
Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Non-hourglass cursor that is currently active. */
Cursor current_cursor;
- /* Flag to set when the window needs to be completely repainted. */
- int needs_exposure;
-
DWORD dwStyle;
/* This is the Emacs structure for the display this frame is on. */
/* Return the window associated with the frame F. */
#define FRAME_W32_WINDOW(f) ((f)->output_data.w32->window_desc)
-#define FRAME_X_WINDOW(f) ((f)->output_data.w32->window_desc)
+#define FRAME_X_WINDOW(f) FRAME_W32_WINDOW (f)
#define FRAME_FONT(f) ((f)->output_data.w32->font)
#define FRAME_FONTSET(f) ((f)->output_data.w32->fontset)
#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))
#define WM_EMACS_HIDE_CARET (WM_EMACS_START + 18)
#define WM_EMACS_SETCURSOR (WM_EMACS_START + 19)
#define WM_EMACS_PAINT (WM_EMACS_START + 20)
-#define WM_EMACS_END (WM_EMACS_START + 21)
+#define WM_EMACS_BRINGTOTOP (WM_EMACS_START + 21)
+#define WM_EMACS_END (WM_EMACS_START + 22)
#define WND_FONTWIDTH_INDEX (0)
#define WND_LINEHEIGHT_INDEX (4)
#define RIGHT_WIN_PRESSED 0x4000
#define APPS_PRESSED 0x2000
+/* The current ANSI input codepage for GUI sessions. */
+extern int w32_keyboard_codepage;
+
/* When compiling on Windows 9x/ME and NT 3.x, the following are not defined
(even though they are supported on 98 and ME. */
#ifndef WM_MOUSELEAVE
XGCValues *XCreateGC (void *, Window, unsigned long, XGCValues *);
struct frame * check_x_frame (Lisp_Object);
-EXFUN (Fx_display_color_p, 1);
-EXFUN (Fx_display_grayscale_p, 1);
-
typedef DWORD (WINAPI * ClipboardSequence_Proc) (void);
typedef BOOL (WINAPI * AppendMenuW_Proc) (
IN HMENU,
#define _WIN32_WINNT 0x500
#include <windows.h>
#include <usp10.h>
-#include <setjmp.h>
#include "lisp.h"
#include "w32term.h"
/* First we need to break up the glyph string into runs of glyphs that
can be treated together. First try a single run. */
max_items = 2;
- items = (SCRIPT_ITEM *) xmalloc (sizeof (SCRIPT_ITEM) * max_items + 1);
+ items = xmalloc (sizeof (SCRIPT_ITEM) * max_items + 1);
while ((result = ScriptItemize (chars, nchars, max_items, NULL, NULL,
items, &nitems)) == E_OUTOFMEMORY)
}
if (SUCCEEDED (result))
{
- int j, from, to;
+ int j, from, to, adj_offset = 0;
from = 0;
to = from;
}
}
}
+
+ /* For RTL text, the Uniscribe shaper prepares
+ the values in ADVANCES array for layout in
+ reverse order, whereby "advance width" is
+ applied to move the pen in reverse direction
+ and _before_ drawing the glyph. Since we
+ draw glyphs in their normal left-to-right
+ order, we need to adjust the coordinates of
+ each non-base glyph in a grapheme cluster via
+ X-OFF component of the gstring's ADJUSTMENT
+ sub-vector. This loop computes, for each
+ grapheme cluster, the initial value of the
+ adjustment for the base character, which is
+ then updated for each successive glyph in the
+ grapheme cluster. */
+ if (items[i].a.fRTL)
+ {
+ int j1 = j;
+
+ adj_offset = 0;
+ while (j1 < nglyphs && !attributes[j1].fClusterStart)
+ {
+ adj_offset += advances[j1];
+ j1++;
+ }
+ }
}
LGLYPH_SET_CHAR (lglyph, chars[items[i].iCharPos
if (SUCCEEDED (result))
{
- LGLYPH_SET_LBEARING (lglyph, char_metric.abcA);
- LGLYPH_SET_RBEARING (lglyph, (char_metric.abcA
- + char_metric.abcB));
+ int lbearing = char_metric.abcA;
+ int rbearing = char_metric.abcA + char_metric.abcB;
+
+ LGLYPH_SET_LBEARING (lglyph, lbearing);
+ LGLYPH_SET_RBEARING (lglyph, rbearing);
}
else
{
LGLYPH_SET_RBEARING (lglyph, advances[j]);
}
- if (offsets[j].du || offsets[j].dv)
+ if (offsets[j].du || offsets[j].dv
+ /* For non-base glyphs of RTL grapheme clusters,
+ adjust the X offset even if both DU and DV
+ are zero. */
+ || (!attributes[j].fClusterStart && items[i].a.fRTL))
{
Lisp_Object vec;
vec = Fmake_vector (make_number (3), Qnil);
- ASET (vec, 0, make_number (offsets[j].du));
- ASET (vec, 1, make_number (offsets[j].dv));
+ if (items[i].a.fRTL)
+ {
+ /* Empirically, it looks like Uniscribe
+ interprets DU in reverse direction for
+ RTL clusters. E.g., if we don't reverse
+ the direction, the Hebrew point HOLAM is
+ drawn above the right edge of the base
+ consonant, instead of above the left edge. */
+ ASET (vec, 0, make_number (-offsets[j].du
+ + adj_offset));
+ /* Update the adjustment value for the width
+ advance of the glyph we just emitted. */
+ adj_offset -= 2 * advances[j];
+ }
+ else
+ ASET (vec, 0, make_number (offsets[j].du + adj_offset));
+ /* In the font definition coordinate system, the
+ Y coordinate points up, while in our screen
+ coordinates Y grows downwards. So we need to
+ reverse the sign of Y-OFFSET here. */
+ ASET (vec, 1, make_number (-offsets[j].dv));
/* Based on what ftfont.c does... */
ASET (vec, 2, make_number (advances[j]));
LGLYPH_SET_ADJUSTMENT (lglyph, vec);
}
else
- LGLYPH_SET_ADJUSTMENT (lglyph, Qnil);
+ {
+ LGLYPH_SET_ADJUSTMENT (lglyph, Qnil);
+ /* Update the adjustment value to compensate for
+ the width of the base character. */
+ if (items[i].a.fRTL)
+ adj_offset -= advances[j];
+ }
}
}
}
-/* Functions taken directly from X sources for use with the Microsoft W32 API.
+/* Functions taken directly from X sources for use with the Microsoft Windows API.
Copyright (C) 1989, 1992-1995, 1999, 2001-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "keyboard.h"
#include "frame.h"
HDC hdc;
if (f->output_method != output_w32)
- abort ();
+ emacs_abort ();
enter_crit ();
}
}
-
-/*
- * XParseGeometry parses strings of the form
- * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
- * width, height, xoffset, and yoffset are unsigned integers.
- * Example: "=80x24+300-49"
- * The equal sign is optional.
- * It returns a bitmask that indicates which of the four values
- * were actually found in the string. For each value found,
- * the corresponding argument is updated; for each value
- * not found, the corresponding argument is left unchanged.
- */
-
-static int
-read_integer (register char *string, char **NextString)
-{
- register int Result = 0;
- int Sign = 1;
-
- if (*string == '+')
- string++;
- else if (*string == '-')
- {
- string++;
- Sign = -1;
- }
- for (; (*string >= '0') && (*string <= '9'); string++)
- {
- Result = (Result * 10) + (*string - '0');
- }
- *NextString = string;
- if (Sign >= 0)
- return (Result);
- else
- return (-Result);
-}
-
-int
-XParseGeometry (char *string,
- int *x, int *y,
- unsigned int *width, unsigned int *height)
-{
- int mask = NoValue;
- register char *strind;
- unsigned int tempWidth, tempHeight;
- int tempX, tempY;
- char *nextCharacter;
-
- if ((string == NULL) || (*string == '\0')) return (mask);
- if (*string == '=')
- string++; /* ignore possible '=' at beg of geometry spec */
-
- strind = (char *)string;
- if (*strind != '+' && *strind != '-' && *strind != 'x')
- {
- tempWidth = read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- mask |= WidthValue;
- }
-
- if (*strind == 'x' || *strind == 'X')
- {
- strind++;
- tempHeight = read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- mask |= HeightValue;
- }
-
- if ((*strind == '+') || (*strind == '-'))
- {
- if (*strind == '-')
- {
- strind++;
- tempX = -read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- mask |= XNegative;
-
- }
- else
- {
- strind++;
- tempX = read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- }
- mask |= XValue;
- if ((*strind == '+') || (*strind == '-'))
- {
- if (*strind == '-')
- {
- strind++;
- tempY = -read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- mask |= YNegative;
- }
- else
- {
- strind++;
- tempY = read_integer (strind, &nextCharacter);
- if (strind == nextCharacter)
- return (0);
- strind = nextCharacter;
- }
- mask |= YValue;
- }
- }
-
- /* If strind isn't at the end of the string then it's an invalid
- geometry specification. */
-
- if (*strind != '\0') return (0);
-
- if (mask & XValue)
- *x = tempX;
- if (mask & YValue)
- *y = tempY;
- if (mask & WidthValue)
- *width = tempWidth;
- if (mask & HeightValue)
- *height = tempHeight;
- return (mask);
-}
-
/* x_sync is a no-op on W32. */
void
-x_sync (void *f)
+x_sync (struct frame *f)
{
}
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+
#include "lisp.h"
#include "xterm.h"
#include <X11/ShellP.h>
#include "../lwlib/lwlib.h"
-#include <signal.h>
-#include "syssignal.h"
-
#include "character.h"
#include "font.h"
static void
mark_shell_size_user_specified (Widget wmshell)
{
- if (! XtIsWMShell (wmshell)) abort ();
+ if (! XtIsWMShell (wmshell)) emacs_abort ();
/* This is kind of sleazy, but I can't see how else to tell it to make it
mark the WM_SIZE_HINTS size as user specified when appropriate. */
((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
Widget wmshell = get_wm_shell ((Widget) ew);
/* Each Emacs shell is now independent and top-level. */
- if (! XtIsSubclass (wmshell, shellWidgetClass)) abort ();
+ if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
/* We don't need this for the moment. The geometry is computed in
xfns.c. */
{
/* the tricky things with the sign is to make sure that
-0 is printed -0. */
- int len;
- char *tem;
sprintf (shell_position, "=%c%d%c%d",
flags & XNegative ? '-' : '+', x < 0 ? -x : x,
flags & YNegative ? '-' : '+', y < 0 ? -y : y);
- len = strlen (shell_position) + 1;
- tem = (char *) xmalloc (len);
- strncpy (tem, shell_position, len);
- XtVaSetValues (wmshell, XtNgeometry, tem, NULL);
+ XtVaSetValues (wmshell, XtNgeometry, xstrdup (shell_position), NULL);
}
else if (flags & (WidthValue | HeightValue))
{
- int len;
- char *tem;
sprintf (shell_position, "=%dx%d", pixel_width, pixel_height);
- len = strlen (shell_position) + 1;
- tem = (char *) xmalloc (len);
- strncpy (tem, shell_position, len);
- XtVaSetValues (wmshell, XtNgeometry, tem, NULL);
+ XtVaSetValues (wmshell, XtNgeometry, xstrdup (shell_position), NULL);
}
/* If the geometry spec we're using has W/H components, mark the size
update_wm_hints (ew);
}
-extern void free_frame_faces (struct frame *);
-
static void
EmacsFrameDestroy (Widget widget)
{
EmacsFrame ew = (EmacsFrame) widget;
struct frame* s = ew->emacs_frame.frame;
- if (! s) abort ();
- if (! s->output_data.x) abort ();
+ if (! s) emacs_abort ();
+ if (! s->output_data.x) emacs_abort ();
- BLOCK_INPUT;
+ block_input ();
x_free_gcs (s);
if (s->output_data.x->white_relief.gc)
XFreeGC (XtDisplay (widget), s->output_data.x->white_relief.gc);
if (s->output_data.x->black_relief.gc)
XFreeGC (XtDisplay (widget), s->output_data.x->black_relief.gc);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static void
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+
+#define WINDOW_INLINE EXTERN_INLINE
+
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "keyboard.h"
#include "keymap.h"
#endif
Lisp_Object Qwindowp, Qwindow_live_p;
+static Lisp_Object Qwindow_valid_p;
static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer;
static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer;
static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window;
static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically;
static Lisp_Object Qscroll_up, Qscroll_down, Qscroll_command;
-static Lisp_Object Qsafe, Qabove, Qbelow;
-static Lisp_Object Qauto_buffer_name, Qclone_of;
+static Lisp_Object Qsafe, Qabove, Qbelow, Qtemp_buffer_resize, Qclone_of;
static int displayed_window_lines (struct window *);
-static struct window *decode_window (Lisp_Object);
static int count_windows (struct window *);
static int get_leaf_windows (struct window *, struct window **, int);
-static void window_scroll (Lisp_Object, int, int, int);
+static void window_scroll (Lisp_Object, EMACS_INT, int, int);
static void window_scroll_pixel_based (Lisp_Object, int, int, int);
static void window_scroll_line_based (Lisp_Object, int, int, int);
static int freeze_window_start (struct window *, void *);
static int window_scroll_pixel_based_preserve_y;
/* Same for window_scroll_line_based. */
-static int window_scroll_preserve_hpos;
-static int window_scroll_preserve_vpos;
+static EMACS_INT window_scroll_preserve_hpos;
+static EMACS_INT window_scroll_preserve_vpos;
\f
-static struct window *
-decode_window (register Lisp_Object window)
+/* These setters are used only in this file, so they can be private. */
+static inline void
+wset_combination_limit (struct window *w, Lisp_Object val)
+{
+ w->combination_limit = val;
+}
+static inline void
+wset_dedicated (struct window *w, Lisp_Object val)
+{
+ w->dedicated = val;
+}
+static inline void
+wset_display_table (struct window *w, Lisp_Object val)
+{
+ w->display_table = val;
+}
+static inline void
+wset_hchild (struct window *w, Lisp_Object val)
+{
+ w->hchild = val;
+}
+static inline void
+wset_left_fringe_width (struct window *w, Lisp_Object val)
+{
+ w->left_fringe_width = val;
+}
+static inline void
+wset_left_margin_cols (struct window *w, Lisp_Object val)
+{
+ w->left_margin_cols = val;
+}
+static inline void
+wset_new_normal (struct window *w, Lisp_Object val)
+{
+ w->new_normal = val;
+}
+static inline void
+wset_new_total (struct window *w, Lisp_Object val)
+{
+ w->new_total = val;
+}
+static inline void
+wset_normal_cols (struct window *w, Lisp_Object val)
+{
+ w->normal_cols = val;
+}
+static inline void
+wset_normal_lines (struct window *w, Lisp_Object val)
+{
+ w->normal_lines = val;
+}
+static inline void
+wset_parent (struct window *w, Lisp_Object val)
+{
+ w->parent = val;
+}
+static inline void
+wset_pointm (struct window *w, Lisp_Object val)
+{
+ w->pointm = val;
+}
+static inline void
+wset_right_fringe_width (struct window *w, Lisp_Object val)
+{
+ w->right_fringe_width = val;
+}
+static inline void
+wset_right_margin_cols (struct window *w, Lisp_Object val)
+{
+ w->right_margin_cols = val;
+}
+static inline void
+wset_scroll_bar_width (struct window *w, Lisp_Object val)
+{
+ w->scroll_bar_width = val;
+}
+static inline void
+wset_start (struct window *w, Lisp_Object val)
+{
+ w->start = val;
+}
+static inline void
+wset_temslot (struct window *w, Lisp_Object val)
+{
+ w->temslot = val;
+}
+static inline void
+wset_vchild (struct window *w, Lisp_Object val)
+{
+ w->vchild = val;
+}
+static inline void
+wset_vertical_scroll_bar_type (struct window *w, Lisp_Object val)
+{
+ w->vertical_scroll_bar_type = val;
+}
+static inline void
+wset_window_parameters (struct window *w, Lisp_Object val)
+{
+ w->window_parameters = val;
+}
+
+struct window *
+decode_live_window (register Lisp_Object window)
{
if (NILP (window))
return XWINDOW (selected_window);
static struct window *
decode_any_window (register Lisp_Object window)
{
+ struct window *w;
+
if (NILP (window))
return XWINDOW (selected_window);
CHECK_WINDOW (window);
- return XWINDOW (window);
+ w = XWINDOW (window);
+ return w;
+}
+
+static struct window *
+decode_valid_window (register Lisp_Object window)
+{
+ struct window *w;
+
+ if (NILP (window))
+ return XWINDOW (selected_window);
+
+ CHECK_VALID_WINDOW (window);
+ w = XWINDOW (window);
+ return w;
}
DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0,
return WINDOWP (object) ? Qt : Qnil;
}
+DEFUN ("window-valid-p", Fwindow_valid_p, Swindow_valid_p, 1, 1, 0,
+ doc: /* Return t if OBJECT is a valid window and nil otherwise.
+A valid window is either a window that displays a buffer or an internal
+window. Deleted windows are not live. */)
+ (Lisp_Object object)
+{
+ return WINDOW_VALID_P (object) ? Qt : Qnil;
+}
+
DEFUN ("window-live-p", Fwindow_live_p, Swindow_live_p, 1, 1, 0,
doc: /* Return t if OBJECT is a live window and nil otherwise.
A live window is a window that displays a buffer.
/* Frames and windows. */
DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0,
doc: /* Return the frame that window WINDOW is on.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->frame;
+ return decode_valid_window (window)->frame;
}
DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0,
if (NILP (frame_or_window))
window = SELECTED_FRAME ()->root_window;
- else if (WINDOWP (frame_or_window))
- window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->root_window;
+ else if (WINDOW_VALID_P (frame_or_window))
+ window = XFRAME (XWINDOW (frame_or_window)->frame)->root_window;
else
{
CHECK_LIVE_FRAME (frame_or_window);
DEFUN ("window-minibuffer-p", Fwindow_minibuffer_p,
Swindow_minibuffer_p, 0, 1, 0,
doc: /* Return non-nil if WINDOW is a minibuffer window.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return MINI_WINDOW_P (decode_any_window (window)) ? Qt : Qnil;
+ return MINI_WINDOW_P (decode_valid_window (window)) ? Qt : Qnil;
}
/* Don't move this to window.el - this must be a safe routine. */
DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0,
doc: /* Return the topmost, leftmost live window on FRAME-OR-WINDOW.
If omitted, FRAME-OR-WINDOW defaults to the currently selected frame.
-Else if FRAME-OR-WINDOW denotes any window, return the first window of
-that window's frame. If FRAME-OR-WINDOW denotes a live frame, return
+Else if FRAME-OR-WINDOW denotes a valid window, return the first window
+of that window's frame. If FRAME-OR-WINDOW denotes a live frame, return
the first window of that frame. */)
(Lisp_Object frame_or_window)
{
if (NILP (frame_or_window))
window = SELECTED_FRAME ()->root_window;
- else if (WINDOWP (frame_or_window))
+ else if (WINDOW_VALID_P (frame_or_window))
window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->root_window;
else
{
else if (! NILP (XWINDOW (window)->vchild))
window = XWINDOW (window)->vchild;
else
- abort ();
+ emacs_abort ();
}
return window;
Sframe_selected_window, 0, 1, 0,
doc: /* Return the selected window of FRAME-OR-WINDOW.
If omitted, FRAME-OR-WINDOW defaults to the currently selected frame.
-Else if FRAME-OR-WINDOW denotes any window, return the selected window
-of that window's frame. If FRAME-OR-WINDOW denotes a live frame, return
-the selected window of that frame. */)
+Else if FRAME-OR-WINDOW denotes a valid window, return the selected
+window of that window's frame. If FRAME-OR-WINDOW denotes a live frame,
+return the selected window of that frame. */)
(Lisp_Object frame_or_window)
{
Lisp_Object window;
if (NILP (frame_or_window))
window = SELECTED_FRAME ()->selected_window;
- else if (WINDOWP (frame_or_window))
+ else if (WINDOW_VALID_P (frame_or_window))
window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->selected_window;
else
{
if (EQ (frame, selected_frame))
return Fselect_window (window, norecord);
else
- return XFRAME (frame)->selected_window = window;
+ {
+ fset_selected_window (XFRAME (frame), window);
+ return window;
+ }
}
DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0,
if (NILP (norecord))
{
- ++window_select_count;
- XSETFASTINT (w->use_time, window_select_count);
+ w->use_time = ++window_select_count;
record_buffer (w->buffer);
}
+ /* Make the selected window's buffer current. */
+ Fset_buffer (w->buffer);
+
if (EQ (window, selected_window) && !inhibit_point_swap)
return window;
sf = SELECTED_FRAME ();
if (XFRAME (WINDOW_FRAME (w)) != sf)
{
- XFRAME (WINDOW_FRAME (w))->selected_window = window;
+ fset_selected_window (XFRAME (WINDOW_FRAME (w)), 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
return window;
}
else
- sf->selected_window = window;
+ fset_selected_window (sf, window);
- /* Store the current buffer's actual point into the
- old selected window. It belongs to that window,
- and when the window is not selected, must be in the window. */
+ /* Store the old selected window's buffer's point in pointm of the old
+ selected window. It belongs to that window, and when the window is
+ not selected, must be in the window. */
if (!inhibit_point_swap)
{
ow = XWINDOW (selected_window);
}
selected_window = window;
-
- Fset_buffer (w->buffer);
-
- BVAR (XBUFFER (w->buffer), last_selected_window) = window;
+ bset_last_selected_window (XBUFFER (w->buffer), window);
/* Go to the point recorded in the window.
This is important when the buffer is in more
redisplay_window has altered point after scrolling,
because it makes the change only in the window. */
{
- register EMACS_INT new_point = marker_position (w->pointm);
+ register ptrdiff_t new_point = marker_position (w->pointm);
if (new_point < BEGV)
SET_PT (BEGV);
else if (new_point > ZV)
DEFUN ("window-parent", Fwindow_parent, Swindow_parent, 0, 1, 0,
doc: /* Return the parent window of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
Return nil for a window with no parent (e.g. a root window). */)
(Lisp_Object window)
{
- return decode_any_window (window)->parent;
+ return decode_valid_window (window)->parent;
}
DEFUN ("window-top-child", Fwindow_top_child, Swindow_top_child, 1, 1, 0,
doc: /* Return the topmost child window of window WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW is a live window (live windows have no children).
Return nil if WINDOW is an internal window whose children form a
horizontal combination. */)
(Lisp_Object window)
{
CHECK_WINDOW (window);
- return decode_any_window (window)->vchild;
+ return decode_valid_window (window)->vchild;
}
DEFUN ("window-left-child", Fwindow_left_child, Swindow_left_child, 1, 1, 0,
doc: /* Return the leftmost child window of window WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW is a live window (live windows have no children).
Return nil if WINDOW is an internal window whose children form a
vertical combination. */)
(Lisp_Object window)
{
CHECK_WINDOW (window);
- return decode_any_window (window)->hchild;
+ return decode_valid_window (window)->hchild;
}
DEFUN ("window-next-sibling", Fwindow_next_sibling, Swindow_next_sibling, 0, 1, 0,
doc: /* Return the next sibling window of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW has no next sibling. */)
(Lisp_Object window)
{
- return decode_any_window (window)->next;
+ return decode_valid_window (window)->next;
}
DEFUN ("window-prev-sibling", Fwindow_prev_sibling, Swindow_prev_sibling, 0, 1, 0,
doc: /* Return the previous sibling window of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
Return nil if WINDOW has no previous sibling. */)
(Lisp_Object window)
{
- return decode_any_window (window)->prev;
+ return decode_valid_window (window)->prev;
}
DEFUN ("window-combination-limit", Fwindow_combination_limit, Swindow_combination_limit, 1, 1, 0,
doc: /* Return combination limit of window WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
If the return value is nil, child windows of WINDOW can be recombined with
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 decode_any_window (window)->combination_limit;
+ return decode_valid_window (window)->combination_limit;
}
DEFUN ("set-window-combination-limit", Fset_window_combination_limit, Sset_window_combination_limit, 2, 2, 0,
doc: /* Set combination limit of window WINDOW to LIMIT; return LIMIT.
-If LIMIT is nil, child windows of WINDOW can be recombined with
-WINDOW's siblings. LIMIT t means that child windows of WINDOW are
-never \(re-)combined with WINDOW's siblings. Other values are reserved
-for future use. */)
+WINDOW must be a valid window and defaults to the selected one.
+If LIMIT is nil, child windows of WINDOW can be recombined with WINDOW's
+siblings. LIMIT t means that child windows of WINDOW are 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);
- w->combination_limit = limit;
- return w->combination_limit;
+ wset_combination_limit (decode_valid_window (window), limit);
+ return limit;
}
DEFUN ("window-use-time", Fwindow_use_time, Swindow_use_time, 0, 1, 0,
doc: /* Return the use time of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
The window with the highest use time is the most recently selected
one. The window with the lowest use time is the least recently
selected one. */)
(Lisp_Object window)
{
- return decode_window (window)->use_time;
+ return make_number (decode_live_window (window)->use_time);
}
\f
DEFUN ("window-total-height", Fwindow_total_height, Swindow_total_height, 0, 1, 0,
doc: /* Return the total height, in lines, of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
The return value includes the mode line and header line, if any.
If WINDOW is an internal window, the total height is the height
integer multiple of the default character height. */)
(Lisp_Object window)
{
- return decode_any_window (window)->total_lines;
+ return decode_valid_window (window)->total_lines;
}
DEFUN ("window-total-width", Fwindow_total_width, Swindow_total_width, 0, 1, 0,
doc: /* Return the total width, in columns, of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
The return value includes any vertical dividers or scroll bars
belonging to WINDOW. If WINDOW is an internal window, the total width
integer multiple of the default character width. */)
(Lisp_Object window)
{
- return decode_any_window (window)->total_cols;
+ return decode_valid_window (window)->total_cols;
}
DEFUN ("window-new-total", Fwindow_new_total, Swindow_new_total, 0, 1, 0,
doc: /* Return the new total size of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->new_total;
+ return decode_valid_window (window)->new_total;
}
DEFUN ("window-normal-size", Fwindow_normal_size, Swindow_normal_size, 0, 2, 0,
doc: /* Return the normal height of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a valid window and defaults to the selected one.
If HORIZONTAL is non-nil, return the normal width of WINDOW. */)
(Lisp_Object window, Lisp_Object horizontal)
{
- if (NILP (horizontal))
- return decode_any_window (window)->normal_lines;
- else
- return decode_any_window (window)->normal_cols;
+ struct window *w = decode_valid_window (window);
+
+ return NILP (horizontal) ? w->normal_lines : w->normal_cols;
}
DEFUN ("window-new-normal", Fwindow_new_normal, Swindow_new_normal, 0, 1, 0,
doc: /* Return new normal size of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->new_normal;
+ return decode_valid_window (window)->new_normal;
}
DEFUN ("window-left-column", Fwindow_left_column, Swindow_left_column, 0, 1, 0,
the left edge of the frame's window area. For instance, the return
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. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->left_col;
+ return decode_valid_window (window)->left_col;
}
DEFUN ("window-top-line", Fwindow_top_line, Swindow_top_line, 0, 1, 0,
of the frame's window area. For instance, the return value is 0 if
there is no window above WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window. */)
+WINDOW must be a valid window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_any_window (window)->top_line;
+ return decode_valid_window (window)->top_line;
}
/* Return the number of lines of W's body. Don't count any mode or
DEFUN ("window-body-height", Fwindow_body_height, Swindow_body_height, 0, 1, 0,
doc: /* Return the height, in lines, of WINDOW's text area.
-If WINDOW is omitted or nil, it defaults to the selected window.
-Signal an error if the window is not live.
+WINDOW must be a live window and defaults to the selected one.
The returned height does not include the mode line or header line.
On a graphical display, the height is expressed as an integer multiple
exclude partially-visible lines, use `window-text-height'. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
return make_number (window_body_lines (w));
}
DEFUN ("window-body-width", Fwindow_body_width, Swindow_body_width, 0, 1, 0,
doc: /* Return the width, in columns, of WINDOW's text area.
-If WINDOW is omitted or nil, it defaults to the selected window.
-Signal an error if the window is not live.
+WINDOW must be a live window and defaults to the selected one.
The return value does not include any vertical dividers, fringe or
marginal areas, or scroll bars. On a graphical display, the width is
expressed as an integer multiple of the default character width. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
return make_number (window_body_cols (w));
}
WINDOW must be a live window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_window (window)->hscroll;
+ return make_number (decode_live_window (window)->hscroll);
+}
+
+/* Set W's horizontal scroll amount to HSCROLL clipped to a reasonable
+ range, returning the new amount as a fixnum. */
+static Lisp_Object
+set_window_hscroll (struct window *w, EMACS_INT hscroll)
+{
+ /* Horizontal scrolling has problems with large scroll amounts.
+ It's too slow with long lines, and even with small lines the
+ display can be messed up. For now, though, impose only the limits
+ required by the internal representation: horizontal scrolling must
+ fit in fixnum (since it's visible to Elisp) and into ptrdiff_t
+ (since it's stored in a ptrdiff_t). */
+ ptrdiff_t hscroll_max = min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX);
+ ptrdiff_t new_hscroll = clip_to_bounds (0, hscroll, hscroll_max);
+
+ /* Prevent redisplay shortcuts when changing the hscroll. */
+ if (w->hscroll != new_hscroll)
+ XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1;
+
+ w->hscroll = new_hscroll;
+ return make_number (new_hscroll);
}
DEFUN ("set-window-hscroll", Fset_window_hscroll, Sset_window_hscroll, 2, 2, 0,
doc: /* Set number of columns WINDOW is scrolled from left margin to NCOL.
-If WINDOW is nil, the selected window is used.
-Return NCOL. NCOL should be zero or positive.
+WINDOW must be a live window and defaults to the selected one.
+Clip the number to a reasonable value if out of range.
+Return the new number. NCOL should be zero or positive.
Note that if `automatic-hscrolling' is non-nil, you cannot scroll the
window so that the location of point moves off-window. */)
(Lisp_Object window, Lisp_Object ncol)
{
- struct window *w = decode_window (window);
- int hscroll;
+ struct window *w = decode_live_window (window);
CHECK_NUMBER (ncol);
- hscroll = max (0, XINT (ncol));
-
- /* Prevent redisplay shortcuts when changing the hscroll. */
- if (XINT (w->hscroll) != hscroll)
- XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1;
-
- w->hscroll = make_number (hscroll);
- return ncol;
+ return set_window_hscroll (w, XINT (ncol));
}
DEFUN ("window-redisplay-end-trigger", Fwindow_redisplay_end_trigger,
Swindow_redisplay_end_trigger, 0, 1, 0,
doc: /* Return WINDOW's redisplay end trigger value.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
See `set-window-redisplay-end-trigger' for more information. */)
(Lisp_Object window)
{
- return decode_window (window)->redisplay_end_trigger;
+ return decode_live_window (window)->redisplay_end_trigger;
}
DEFUN ("set-window-redisplay-end-trigger", Fset_window_redisplay_end_trigger,
Sset_window_redisplay_end_trigger, 2, 2, 0,
doc: /* Set WINDOW's redisplay end trigger value to VALUE.
-VALUE should be a buffer position (typically a marker) or nil.
-If it is a buffer position, then if redisplay in WINDOW reaches a position
-beyond VALUE, the functions in `redisplay-end-trigger-functions' are called
-with two arguments: WINDOW, and the end trigger value.
-Afterwards the end-trigger value is reset to nil. */)
+WINDOW must be a live window and defaults to the selected one. VALUE
+should be a buffer position (typically a marker) or nil. If it is a
+buffer position, then if redisplay in WINDOW reaches a position beyond
+VALUE, the functions in `redisplay-end-trigger-functions' are called
+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);
- w->redisplay_end_trigger = value;
+ wset_redisplay_end_trigger (decode_live_window (window), value);
return value;
}
DEFUN ("window-edges", Fwindow_edges, Swindow_edges, 0, 1, 0,
doc: /* Return a list of the edge coordinates of WINDOW.
-The list has the form (LEFT TOP RIGHT BOTTOM).
-TOP and BOTTOM count by lines, and LEFT and RIGHT count by columns,
-all relative to 0, 0 at top left corner of frame.
-
-RIGHT is one more than the rightmost column occupied by WINDOW.
-BOTTOM is one more than the bottommost row occupied by WINDOW.
-The edges include the space used by WINDOW's scroll bar, display
-margins, fringes, header line, and/or mode line. For the edges of
-just the text area, use `window-inside-edges'. */)
+WINDOW must be a valid window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM). TOP and BOTTOM
+count by lines, and LEFT and RIGHT count by columns, all relative to 0,
+0 at top left corner of frame.
+
+RIGHT is one more than the rightmost column occupied by WINDOW. BOTTOM
+is one more than the bottommost row occupied by WINDOW. The edges
+include the space used by WINDOW's scroll bar, display margins, fringes,
+header line, and/or mode line. For the edges of just the text area, use
+`window-inside-edges'. */)
(Lisp_Object window)
{
- register struct window *w = decode_any_window (window);
+ register struct window *w = decode_valid_window (window);
return Fcons (make_number (WINDOW_LEFT_EDGE_COL (w)),
Fcons (make_number (WINDOW_TOP_EDGE_LINE (w)),
DEFUN ("window-pixel-edges", Fwindow_pixel_edges, Swindow_pixel_edges, 0, 1, 0,
doc: /* Return a list of the edge pixel coordinates of WINDOW.
-The list has the form (LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at
-the top left corner of the frame.
+WINDOW must be a valid window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to
+0, 0 at the top left corner of the frame.
RIGHT is one more than the rightmost x position occupied by WINDOW.
BOTTOM is one more than the bottommost y position occupied by WINDOW.
of just the text area, use `window-inside-pixel-edges'. */)
(Lisp_Object window)
{
- register struct window *w = decode_any_window (window);
+ register struct window *w = decode_valid_window (window);
return Fcons (make_number (WINDOW_LEFT_EDGE_X (w)),
Fcons (make_number (WINDOW_TOP_EDGE_Y (w)),
DEFUN ("window-absolute-pixel-edges", Fwindow_absolute_pixel_edges,
Swindow_absolute_pixel_edges, 0, 1, 0,
doc: /* Return a list of the edge pixel coordinates of WINDOW.
-The list has the form (LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at
-the top left corner of the display.
+WINDOW must be a valid window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to
+0, 0 at the top left corner of the display.
RIGHT is one more than the rightmost x position occupied by WINDOW.
BOTTOM is one more than the bottommost y position occupied by WINDOW.
of just the text area, use `window-inside-absolute-pixel-edges'. */)
(Lisp_Object window)
{
- register struct window *w = decode_any_window (window);
+ register struct window *w = decode_valid_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),
DEFUN ("window-inside-edges", Fwindow_inside_edges, Swindow_inside_edges, 0, 1, 0,
doc: /* Return a list of the edge coordinates of WINDOW.
-The list has the form (LEFT TOP RIGHT BOTTOM).
-TOP and BOTTOM count by lines, and LEFT and RIGHT count by columns,
-all relative to 0, 0 at top left corner of frame.
+WINDOW must be a live window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM). TOP and BOTTOM
+count by lines, and LEFT and RIGHT count by columns, all relative to 0,
+0 at top left corner of frame.
RIGHT is one more than the rightmost column of WINDOW's text area.
-BOTTOM is one more than the bottommost row of WINDOW's text area.
-The inside edges do not include the space used by the WINDOW's scroll
-bar, display margins, fringes, header line, and/or mode line. */)
+BOTTOM is one more than the bottommost row of WINDOW's text area. The
+inside edges do not include the space used by the WINDOW's scroll bar,
+display margins, fringes, header line, and/or mode line. */)
(Lisp_Object window)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
return list4 (make_number (WINDOW_BOX_LEFT_EDGE_COL (w)
+ WINDOW_LEFT_MARGIN_COLS (w)
DEFUN ("window-inside-pixel-edges", Fwindow_inside_pixel_edges, Swindow_inside_pixel_edges, 0, 1, 0,
doc: /* Return a list of the edge pixel coordinates of WINDOW's text area.
-The list has the form (LEFT TOP RIGHT BOTTOM), all relative to (0,0)
-at the top left corner of the frame's window area.
+WINDOW must be a live window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to
+(0,0) at the top left corner of the frame's window area.
RIGHT is one more than the rightmost x position of WINDOW's text area.
BOTTOM is one more than the bottommost y position of WINDOW's text area.
display margins, fringes, header line, and/or mode line. */)
(Lisp_Object window)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
return list4 (make_number (WINDOW_BOX_LEFT_EDGE_X (w)
+ WINDOW_LEFT_MARGIN_WIDTH (w)
Fwindow_inside_absolute_pixel_edges,
Swindow_inside_absolute_pixel_edges, 0, 1, 0,
doc: /* Return a list of the edge pixel coordinates of WINDOW's text area.
-The list has the form (LEFT TOP RIGHT BOTTOM), all relative to (0,0)
-at the top left corner of the frame's window area.
+WINDOW must be a live window and defaults to the selected one.
+
+The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to
+(0,0) at the top left corner of the frame's window area.
RIGHT is one more than the rightmost x position of WINDOW's text area.
BOTTOM is one more than the bottommost y position of WINDOW's text area.
display margins, fringes, header line, and/or mode line. */)
(Lisp_Object window)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
int add_x, add_y;
calc_absolute_offset (w, &add_x, &add_y);
DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p,
Scoordinates_in_window_p, 2, 2, 0,
doc: /* Return non-nil if COORDINATES are in WINDOW.
-WINDOW must be a live window.
+WINDOW must be a live window and defaults to the selected one.
COORDINATES is a cons of the form (X . Y), X and Y being distances
measured in characters from the upper-left corner of the frame.
\(0 . 0) denotes the character in the upper left corner of the
int x, y;
Lisp_Object lx, ly;
- CHECK_LIVE_WINDOW (window);
- w = XWINDOW (window);
+ w = decode_live_window (window);
f = XFRAME (w->frame);
CHECK_CONS (coordinates);
lx = Fcar (coordinates);
return Qnil;
default:
- abort ();
+ emacs_abort ();
}
}
doc: /* Return current value of point in WINDOW.
WINDOW must be a live window and defaults to the selected one.
-For a nonselected window, this is the value point would have
-if that window were selected.
+For a nonselected window, this is the value point would have if that
+window were selected.
-Note that, when WINDOW is the selected window and its buffer
-is also currently selected, the value returned is the same as (point).
-It would be more strictly correct to return the `top-level' value
-of point, outside of any save-excursion forms.
-But that is hard to define. */)
+Note that, when WINDOW is selected, the value returned is the same as
+that returned by `point' for WINDOW's buffer. It would be more strictly
+correct to return the `top-level' value of `point', outside of any
+`save-excursion' forms. But that is hard to define. */)
(Lisp_Object window)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
- if (w == XWINDOW (selected_window)
- && current_buffer == XBUFFER (w->buffer))
- return Fpoint ();
- return Fmarker_position (w->pointm);
+ if (w == XWINDOW (selected_window))
+ return make_number (BUF_PT (XBUFFER (w->buffer)));
+ else
+ return Fmarker_position (w->pointm);
}
DEFUN ("window-start", Fwindow_start, Swindow_start, 0, 1, 0,
This is updated by redisplay or by calling `set-window-start'. */)
(Lisp_Object window)
{
- return Fmarker_position (decode_window (window)->start);
+ return Fmarker_position (decode_live_window (window)->start);
}
/* This is text temporarily removed from the doc string below.
(Lisp_Object window, Lisp_Object update)
{
Lisp_Object value;
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
Lisp_Object buf;
struct buffer *b;
if (! NILP (update)
&& ! (! NILP (w->window_end_valid)
- && XFASTINT (w->last_modified) >= BUF_MODIFF (b)
- && XFASTINT (w->last_overlay_modified) >= BUF_OVERLAY_MODIFF (b))
+ && w->last_modified >= BUF_MODIFF (b)
+ && w->last_overlay_modified >= BUF_OVERLAY_MODIFF (b))
&& !noninteractive)
{
struct text_pos startp;
DEFUN ("set-window-point", Fset_window_point, Sset_window_point, 2, 2, 0,
doc: /* Make point value in WINDOW be at position POS in WINDOW's buffer.
+WINDOW must be a live window and defaults to the selected one.
Return POS. */)
(Lisp_Object window, Lisp_Object pos)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
CHECK_NUMBER_COERCE_MARKER (pos);
- if (w == XWINDOW (selected_window)
- && XBUFFER (w->buffer) == current_buffer)
- Fgoto_char (pos);
- else
- 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. */
- if (!EQ (window, selected_window))
- ++windows_or_buffers_changed;
+ if (w == XWINDOW (selected_window))
+ {
+ if (XBUFFER (w->buffer) == current_buffer)
+ Fgoto_char (pos);
+ else
+ {
+ struct buffer *old_buffer = current_buffer;
+
+ set_buffer_internal (XBUFFER (w->buffer));
+ Fgoto_char (pos);
+ set_buffer_internal (old_buffer);
+ }
+ }
+ else
+ {
+ 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. */
+ ++windows_or_buffers_changed;
+ }
return pos;
}
DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0,
doc: /* Make display in WINDOW start at position POS in WINDOW's buffer.
-If WINDOW is nil, the selected window is used. Return POS.
-Optional third arg NOFORCE non-nil inhibits next redisplay from
+WINDOW must be a live window and defaults to the selected one. Return
+POS. Optional third arg NOFORCE non-nil inhibits next redisplay from
overriding motion of point in order to display at this exact start. */)
(Lisp_Object window, Lisp_Object pos, Lisp_Object noforce)
{
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
CHECK_NUMBER_COERCE_MARKER (pos);
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 = Qnil;
+ w->start_at_line_beg = 0;
if (NILP (noforce))
- w->force_start = Qt;
- w->update_mode_line = Qt;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->force_start = 1;
+ w->update_mode_line = 1;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
if (!EQ (window, selected_window))
windows_or_buffers_changed++;
DEFUN ("pos-visible-in-window-p", Fpos_visible_in_window_p,
Spos_visible_in_window_p, 0, 3, 0,
doc: /* Return non-nil if position POS is currently on the frame in WINDOW.
-Return nil if that position is scrolled vertically out of view.
-If a character is only partially visible, nil is returned, unless the
-optional argument PARTIALLY is non-nil.
-If POS is only out of view because of horizontal scrolling, return non-nil.
-If POS is t, it specifies the position of the last visible glyph in WINDOW.
-POS defaults to point in WINDOW; WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
+
+Return nil if that position is scrolled vertically out of view. If a
+character is only partially visible, nil is returned, unless the
+optional argument PARTIALLY is non-nil. If POS is only out of view
+because of horizontal scrolling, return non-nil. If POS is t, it
+specifies the position of the last visible glyph in WINDOW. POS
+defaults to point in WINDOW; WINDOW defaults to the selected window.
If POS is visible, return t if PARTIALLY is nil; if PARTIALLY is non-nil,
return value is a list of 2 or 6 elements (X Y [RTOP RBOT ROWH VPOS]),
int rtop, rbot, rowh, vpos, fully_p = 1;
int x, y;
- w = decode_window (window);
+ w = decode_live_window (window);
buf = XBUFFER (w->buffer);
SET_TEXT_POS_FROM_MARKER (top, w->start);
DEFUN ("window-line-height", Fwindow_line_height,
Swindow_line_height, 0, 2, 0,
doc: /* Return height in pixels of text line LINE in window WINDOW.
-WINDOW defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
Return height of current line if LINE is omitted or nil. Return height of
header or mode line if LINE is `header-line' or `mode-line'.
register struct window *w;
register struct buffer *b;
struct glyph_row *row, *end_row;
- int max_y, crop, i, n;
+ int max_y, crop, i;
+ EMACS_INT n;
- w = decode_window (window);
+ w = decode_live_window (window);
if (noninteractive || w->pseudo_window_p)
return Qnil;
if (NILP (w->window_end_valid)
|| current_buffer->clip_changed
|| current_buffer->prevent_redisplay_optimizations_p
- || XFASTINT (w->last_modified) < BUF_MODIFF (b)
- || XFASTINT (w->last_overlay_modified) < BUF_OVERLAY_MODIFF (b))
+ || w->last_modified < BUF_MODIFF (b)
+ || w->last_overlay_modified < BUF_OVERLAY_MODIFF (b))
return Qnil;
if (NILP (line))
More precisely, return the value assigned by the last call of
`set-window-dedicated-p' for WINDOW. Return nil if that function was
never called with WINDOW as its argument, or the value set by that
-function was internally reset since its last call. WINDOW defaults to
-the selected window.
+function was internally reset since its last call. WINDOW must be a
+live window and defaults to the selected one.
When a window is dedicated to its buffer, `display-buffer' will refrain
from displaying another buffer in it. `get-lru-window' and
is the value returned by `window-dedicated-p' is t. */)
(Lisp_Object window)
{
- return decode_window (window)->dedicated;
+ return decode_live_window (window)->dedicated;
}
DEFUN ("set-window-dedicated-p", Fset_window_dedicated_p,
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);
-
- w->dedicated = flag;
- return w->dedicated;
+ wset_dedicated (decode_live_window (window), flag);
+ return flag;
}
DEFUN ("window-prev-buffers", Fwindow_prev_buffers, Swindow_prev_buffers,
window for that buffer, and POS is a window-specific point value. */)
(Lisp_Object window)
{
- return decode_window (window)->prev_buffers;
+ return decode_live_window (window)->prev_buffers;
}
DEFUN ("set-window-prev-buffers", Fset_window_prev_buffers,
window for that buffer, and POS is a window-specific point value. */)
(Lisp_Object window, Lisp_Object prev_buffers)
{
- return decode_window (window)->prev_buffers = prev_buffers;
+ wset_prev_buffers (decode_live_window (window), prev_buffers);
+ return prev_buffers;
}
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 decode_window (window)->next_buffers;
+ return decode_live_window (window)->next_buffers;
}
DEFUN ("set-window-next-buffers", Fset_window_next_buffers,
NEXT-BUFFERS should be a list of buffers. */)
(Lisp_Object window, Lisp_Object next_buffers)
{
- return decode_window (window)->next_buffers = next_buffers;
+ wset_next_buffers (decode_live_window (window), next_buffers);
+ return next_buffers;
}
DEFUN ("window-parameters", Fwindow_parameters, Swindow_parameters,
0, 1, 0,
doc: /* Return the parameters of WINDOW and their values.
-WINDOW defaults to the selected window. The return value is a list of
-elements of the form (PARAMETER . VALUE). */)
+WINDOW must be a valid window and defaults to the selected one. The
+return value is a list of elements of the form (PARAMETER . VALUE). */)
(Lisp_Object window)
{
- return Fcopy_alist (decode_any_window (window)->window_parameters);
+ return Fcopy_alist (decode_valid_window (window)->window_parameters);
}
DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter,
2, 2, 0,
doc: /* Return WINDOW's value for PARAMETER.
-WINDOW defaults to the selected window. */)
+WINDOW can be any window and defaults to the selected one. */)
(Lisp_Object window, Lisp_Object parameter)
{
Lisp_Object result;
DEFUN ("set-window-parameter", Fset_window_parameter,
Sset_window_parameter, 3, 3, 0,
doc: /* Set WINDOW's value of PARAMETER to VALUE.
-WINDOW defaults to the selected window. Return VALUE. */)
+WINDOW can be any window and defaults to the selected one.
+Return VALUE. */)
(Lisp_Object window, Lisp_Object parameter, Lisp_Object value)
{
register struct window *w = decode_any_window (window);
old_alist_elt = Fassq (parameter, w->window_parameters);
if (NILP (old_alist_elt))
- w->window_parameters = Fcons (Fcons (parameter, value), w->window_parameters);
+ wset_window_parameters
+ (w, Fcons (Fcons (parameter, value), w->window_parameters));
else
Fsetcdr (old_alist_elt, value);
return value;
DEFUN ("window-display-table", Fwindow_display_table, Swindow_display_table,
0, 1, 0,
doc: /* Return the display-table that WINDOW is using.
-WINDOW defaults to the selected window. */)
+WINDOW must be a live window and defaults to the selected one. */)
(Lisp_Object window)
{
- return decode_window (window)->display_table;
+ return decode_live_window (window)->display_table;
}
/* Get the display table for use on window W. This is either W's
}
DEFUN ("set-window-display-table", Fset_window_display_table, Sset_window_display_table, 2, 2, 0,
- doc: /* Set WINDOW's display-table to TABLE. */)
+ doc: /* Set WINDOW's display-table to TABLE.
+WINDOW must be a live window and defaults to the selected one. */)
(register Lisp_Object window, Lisp_Object table)
{
- register struct window *w;
-
- w = decode_window (window);
- w->display_table = table;
+ wset_display_table (decode_live_window (window), table);
return table;
}
\f
buf = w->buffer;
b = XBUFFER (buf);
if (b != XMARKER (w->pointm)->buffer)
- abort ();
+ emacs_abort ();
#if 0
if (w == XWINDOW (selected_window)
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, XWINDOW (selected_window)->buffer)
+ /* Don't clobber point in current buffer either (this could be
+ useful in connection with bug#12208).
+ && XBUFFER (buf) != current_buffer */
/* This line helps to fix Horsley's testbug.el bug. */
&& !(WINDOWP (BVAR (b, last_selected_window))
&& w != XWINDOW (BVAR (b, last_selected_window))
if (WINDOWP (BVAR (b, last_selected_window))
&& w == XWINDOW (BVAR (b, last_selected_window)))
- BVAR (b, last_selected_window) = Qnil;
+ bset_last_selected_window (b, Qnil);
}
/* Put NEW into the window structure in place of OLD. SETFLAG zero
/* 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 (o->frame))))
- FRAME_ROOT_WINDOW (XFRAME (o->frame)) = new;
-
- if (setflag)
- {
- n->left_col = o->left_col;
- n->top_line = o->top_line;
- n->total_cols = o->total_cols;
- n->total_lines = o->total_lines;
- n->normal_cols = o->normal_cols;
- o->normal_cols = make_float (1.0);
- n->normal_lines = o->normal_lines;
- o->normal_lines = make_float (1.0);
+ fset_root_window (XFRAME (o->frame), new);
+
+ if (setflag)
+ {
+ wset_left_col (n, o->left_col);
+ wset_top_line (n, o->top_line);
+ wset_total_cols (n, o->total_cols);
+ wset_total_lines (n, o->total_lines);
+ wset_normal_cols (n, o->normal_cols);
+ wset_normal_cols (o, make_float (1.0));
+ wset_normal_lines (n, o->normal_lines);
+ wset_normal_lines (o, make_float (1.0));
n->desired_matrix = n->current_matrix = 0;
n->vscroll = 0;
memset (&n->cursor, 0, sizeof (n->cursor));
n->phys_cursor_width = -1;
n->must_be_updated_p = 0;
n->pseudo_window_p = 0;
- XSETFASTINT (n->window_end_vpos, 0);
- XSETFASTINT (n->window_end_pos, 0);
- n->window_end_valid = Qnil;
+ wset_window_end_vpos (n, make_number (0));
+ wset_window_end_pos (n, make_number (0));
+ wset_window_end_valid (n, Qnil);
n->frozen_window_start_p = 0;
}
- n->next = tem = o->next;
+ tem = o->next;
+ wset_next (n, tem);
if (!NILP (tem))
- XWINDOW (tem)->prev = new;
+ wset_prev (XWINDOW (tem), new);
- n->prev = tem = o->prev;
+ tem = o->prev;
+ wset_prev (n, tem);
if (!NILP (tem))
- XWINDOW (tem)->next = new;
+ wset_next (XWINDOW (tem), new);
- n->parent = tem = o->parent;
+ tem = o->parent;
+ wset_parent (n, tem);
if (!NILP (tem))
{
if (EQ (XWINDOW (tem)->vchild, old))
- XWINDOW (tem)->vchild = new;
+ wset_vchild (XWINDOW (tem), new);
if (EQ (XWINDOW (tem)->hchild, old))
- XWINDOW (tem)->hchild = new;
+ wset_hchild (XWINDOW (tem), new);
}
}
assign new normal sizes. */
if (NILP (w->prev))
if (horflag)
- p->hchild = child;
+ wset_hchild (p, child);
else
- p->vchild = child;
+ wset_vchild (p, child);
else
{
- c->prev = w->prev;
- XWINDOW (w->prev)->next = child;
+ wset_prev (c, w->prev);
+ wset_next (XWINDOW (w->prev), child);
}
while (c)
{
- c->parent = parent;
+ wset_parent (c, parent);
if (horflag)
- c->normal_cols
- = make_float (XFLOATINT (c->total_cols)
- / XFLOATINT (p->total_cols));
+ wset_normal_cols (c,
+ make_float (XFLOATINT (c->total_cols)
+ / XFLOATINT (p->total_cols)));
else
- c->normal_lines
- = make_float (XFLOATINT (c->total_lines)
- / XFLOATINT (p->total_lines));
+ wset_normal_lines (c,
+ make_float (XFLOATINT (c->total_lines)
+ / XFLOATINT (p->total_lines)));
if (NILP (c->next))
{
if (!NILP (w->next))
{
- c->next = w->next;
- XWINDOW (c->next)->prev = child;
+ wset_next (c, w->next);
+ wset_prev (XWINDOW (c->next), child);
}
c = 0;
}
/* WINDOW can be deleted now. */
- w->vchild = w->hchild = Qnil;
+ wset_vchild (w, Qnil);
+ wset_hchild (w, Qnil);
}
}
}
candidate_p = 1;
else if (NILP (all_frames))
{
- xassert (WINDOWP (owindow));
+ eassert (WINDOWP (owindow));
candidate_p = EQ (w->frame, XWINDOW (owindow)->frame);
}
else if (EQ (all_frames, Qvisible))
/* ALL_FRAMES nil doesn't specify which frames to include. */
if (NILP (*all_frames))
- *all_frames = (!EQ (*minibuf, Qlambda)
- ? FRAME_MINIBUF_WINDOW (XFRAME (XWINDOW (*window)->frame))
- : Qnil);
+ *all_frames
+ = (!EQ (*minibuf, Qlambda)
+ ? FRAME_MINIBUF_WINDOW (XFRAME (XWINDOW (*window)->frame))
+ : Qnil);
else if (EQ (*all_frames, Qvisible))
;
else if (EQ (*all_frames, make_number (0)))
if (EQ (w->buffer, obj))
{
/* Undedicate WINDOW. */
- w->dedicated = Qnil;
+ wset_dedicated (w, Qnil);
/* Make WINDOW show the buffer returned by
other_buffer_safely, don't run any hooks. */
set_window_buffer
if (EQ (w->buffer, obj))
{
mark_window_display_accurate (window, 0);
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
XBUFFER (obj)->prevent_redisplay_optimizations_p = 1;
++update_mode_lines;
best_window = window;
/* Check for a window that has a killed buffer. */
case CHECK_ALL_WINDOWS:
if (! NILP (w->buffer)
- && NILP (BVAR (XBUFFER (w->buffer), name)))
- abort ();
+ && !BUFFER_LIVE_P (XBUFFER (w->buffer)))
+ emacs_abort ();
break;
case WINDOW_LOOP_UNUSED:
DEFUN ("delete-other-windows-internal", Fdelete_other_windows_internal,
Sdelete_other_windows_internal, 0, 2, "",
doc: /* Make WINDOW fill its frame.
-Only the frame WINDOW is on is affected. WINDOW may be any window and
-defaults to the selected one.
+Only the frame WINDOW is on is affected. WINDOW must be a valid window
+and defaults to the selected one.
Optional argument ROOT, if non-nil, must specify an internal window such
that WINDOW is in its window subtree. If this is the case, replace ROOT
struct window *w, *r, *s;
struct frame *f;
Lisp_Object sibling, pwindow, swindow IF_LINT (= Qnil), delta;
- EMACS_INT startpos IF_LINT (= 0);
+ ptrdiff_t startpos IF_LINT (= 0);
int top IF_LINT (= 0), new_top, resize_failed;
- w = decode_any_window (window);
- CHECK_LIVE_FRAME (w->frame);
+ w = decode_valid_window (window);
XSETWINDOW (window, w);
f = XFRAME (w->frame);
else
/* ROOT must be an ancestor of WINDOW. */
{
- r = decode_any_window (root);
- CHECK_LIVE_FRAME (r->frame);
+ r = decode_valid_window (root);
pwindow = XWINDOW (window)->parent;
while (!NILP (pwindow))
if (EQ (pwindow, root))
if (EQ (selected_frame, w->frame))
Fselect_window (window, Qnil);
else
- FRAME_SELECTED_WINDOW (f) = window;
+ fset_selected_window (f, window);
}
}
else
if (EQ (selected_frame, w->frame))
Fselect_window (swindow, Qnil);
else
- FRAME_SELECTED_WINDOW (f) = swindow;
+ fset_selected_window (f, swindow);
}
}
- BLOCK_INPUT;
+ block_input ();
if (!FRAME_INITIAL_P (f))
{
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
if (NILP (w->buffer))
{
/* Resize child windows vertically. */
- XSETINT (delta, XINT (r->total_lines) - XINT (w->total_lines));
- w->top_line = r->top_line;
+ XSETINT (delta, XINT (r->total_lines)
+ - XINT (w->total_lines));
+ wset_top_line (w, r->top_line);
resize_root_window (window, delta, Qnil, Qnil);
if (window_resize_check (w, 0))
window_resize_apply (w, 0);
/* Resize child windows horizontally. */
if (!resize_failed)
{
- w->left_col = r->left_col;
- XSETINT (delta, XINT (r->total_cols) - XINT (w->total_cols));
- w->left_col = r->left_col;
+ wset_left_col (w, r->left_col);
+ XSETINT (delta,
+ XINT (r->total_cols) - XINT (w->total_cols));
+ wset_left_col (w, r->left_col);
resize_root_window (window, delta, Qt, Qnil);
if (window_resize_check (w, 1))
window_resize_apply (w, 1);
{
sibling = w->prev;
s = XWINDOW (sibling);
- s->next = w->next;
+ wset_next (s, w->next);
if (!NILP (s->next))
- XWINDOW (s->next)->prev = sibling;
+ wset_prev (XWINDOW (s->next), sibling);
}
else
/* Get SIBLING below (on the right of) WINDOW. */
{
sibling = w->next;
s = XWINDOW (sibling);
- s->prev = Qnil;
+ wset_prev (s, Qnil);
if (!NILP (XWINDOW (w->parent)->vchild))
- XWINDOW (w->parent)->vchild = sibling;
+ wset_vchild (XWINDOW (w->parent), sibling);
else
- XWINDOW (w->parent)->hchild = sibling;
+ wset_hchild (XWINDOW (w->parent), sibling);
}
/* Delete ROOT and all child windows of ROOT. */
if (!NILP (r->vchild))
{
delete_all_child_windows (r->vchild);
- r->vchild = Qnil;
+ wset_vchild (r, Qnil);
}
else if (!NILP (r->hchild))
{
delete_all_child_windows (r->hchild);
- r->hchild = Qnil;
+ wset_hchild (r, Qnil);
}
replace_window (root, window, 1);
pos = *vmotion (startpos, -top, w);
set_marker_both (w->start, w->buffer, pos.bufpos, pos.bytepos);
- w->window_end_valid = Qnil;
- w->start_at_line_beg = ((pos.bytepos == BEGV_BYTE
- || FETCH_BYTE (pos.bytepos - 1) == '\n') ? Qt
- : Qnil);
+ wset_window_end_valid (w, 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
get called. */
- w->optional_new_start = Qt;
+ w->optional_new_start = 1;
set_buffer_internal (obuf);
}
}
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
run_window_configuration_change_hook (f);
if (WINDOW_RIGHT_MARGIN_COLS (w) > 0)
{
if (WINDOW_LEFT_MARGIN_COLS (w) > 0)
- w->left_margin_cols = w->right_margin_cols
- = make_number (margin_cols/2);
+ {
+ wset_left_margin_cols (w, make_number (margin_cols / 2));
+ wset_right_margin_cols (w, make_number (margin_cols / 2));
+ }
else
- w->right_margin_cols = make_number (margin_cols);
+ wset_right_margin_cols (w, make_number (margin_cols));
}
else
- w->left_margin_cols = make_number (margin_cols);
+ wset_left_margin_cols (w, make_number (margin_cols));
return 1;
}
\f
-static Lisp_Object Fset_window_margins (Lisp_Object, Lisp_Object, Lisp_Object);
-static Lisp_Object Fset_window_fringes (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object);
-static Lisp_Object Fset_window_scroll_bars (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
-static Lisp_Object Fset_window_vscroll (Lisp_Object, Lisp_Object, Lisp_Object);
-
/* The following three routines are needed for running a window's
configuration change hook. */
static void
void
run_window_configuration_change_hook (struct frame *f)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object frame, global_wcch
= Fdefault_value (Qwindow_configuration_change_hook);
XSETFRAME (frame, f);
/* Use the right buffer. Matters when running the local hooks. */
if (current_buffer != XBUFFER (Fwindow_buffer (Qnil)))
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (Fwindow_buffer (Qnil));
}
if (!NILP (Flocal_variable_p (Qwindow_configuration_change_hook,
buffer)))
{
- int inner_count = SPECPDL_INDEX ();
+ ptrdiff_t inner_count = SPECPDL_INDEX ();
record_unwind_protect (select_window_norecord, Fselected_window ());
select_window_norecord (window);
run_funs (Fbuffer_local_value (Qwindow_configuration_change_hook,
DEFUN ("run-window-configuration-change-hook", Frun_window_configuration_change_hook,
Srun_window_configuration_change_hook, 1, 1, 0,
doc: /* Run `window-configuration-change-hook' for FRAME. */)
- (Lisp_Object frame)
+ (Lisp_Object frame)
{
CHECK_LIVE_FRAME (frame);
run_window_configuration_change_hook (XFRAME (frame));
{
struct window *w = XWINDOW (window);
struct buffer *b = XBUFFER (buffer);
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int samebuf = EQ (buffer, w->buffer);
- w->buffer = buffer;
+ wset_buffer (w, buffer);
if (EQ (window, selected_window))
- BVAR (b, last_selected_window) = window;
+ bset_last_selected_window (b, 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_display_count (b, make_number (XINT (BVAR (b, display_count)) + 1));
+ bset_display_time (b, Fcurrent_time ());
- XSETFASTINT (w->window_end_pos, 0);
- XSETFASTINT (w->window_end_vpos, 0);
+ wset_window_end_pos (w, make_number (0));
+ wset_window_end_vpos (w, make_number (0));
memset (&w->last_cursor, 0, sizeof w->last_cursor);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, 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
Resetting hscroll and vscroll here is problematic for things like
image-mode and doc-view-mode since it resets the image's position
whenever we resize the frame. */
- w->hscroll = w->min_hscroll = make_number (0);
+ w->hscroll = w->min_hscroll = 0;
w->vscroll = 0;
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 = Qnil;
- w->force_start = Qnil;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->start_at_line_beg = 0;
+ w->force_start = 0;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
}
/* Maybe we could move this into the `if' but it's not obviously safe and
I doubt it's worth the trouble. */
because that might itself be a local variable. */
if (window_initialized)
{
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_current_buffer ();
Fset_buffer (buffer);
}
Lisp_Object save_left = w->left_margin_cols;
Lisp_Object save_right = w->right_margin_cols;
- w->left_margin_cols = w->right_margin_cols = Qnil;
+ wset_left_margin_cols (w, Qnil);
+ wset_right_margin_cols (w, Qnil);
Fset_window_fringes (window,
BVAR (b, left_fringe_width), BVAR (b, right_fringe_width),
BVAR (b, scroll_bar_width),
BVAR (b, vertical_scroll_bar_type), Qnil);
- w->left_margin_cols = save_left;
- w->right_margin_cols = save_right;
+ wset_left_margin_cols (w, save_left);
+ wset_right_margin_cols (w, save_right);
Fset_window_margins (window,
BVAR (b, left_margin_cols), BVAR (b, right_margin_cols));
DEFUN ("set-window-buffer", Fset_window_buffer, Sset_window_buffer, 2, 3, 0,
doc: /* Make WINDOW display BUFFER-OR-NAME as its contents.
-WINDOW has to be a live window and defaults to the selected one.
+WINDOW must be a live window and defaults to the selected one.
BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
Optional third argument KEEP-MARGINS non-nil means that WINDOW's current
(register Lisp_Object window, Lisp_Object buffer_or_name, Lisp_Object keep_margins)
{
register Lisp_Object tem, buffer;
- register struct window *w = decode_window (window);
+ register struct window *w = decode_live_window (window);
XSETWINDOW (window, w);
buffer = Fget_buffer (buffer_or_name);
CHECK_BUFFER (buffer);
- if (NILP (BVAR (XBUFFER (buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (buffer)))
error ("Attempt to display deleted buffer");
tem = w->buffer;
else
/* WINDOW is weakly dedicated to its buffer, reset
dedication. */
- w->dedicated = Qnil;
+ wset_dedicated (w, Qnil);
call1 (Qrecord_window_buffer, window);
}
{
struct window *w = XWINDOW (object);
mark_window_display_accurate (object, 0);
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
if (BUFFERP (w->buffer))
XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1;
++update_mode_lines;
if (STRINGP (object))
object = Fget_buffer (object);
- if (BUFFERP (object) && !NILP (BVAR (XBUFFER (object), name)))
+ if (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
{
/* Walk all windows looking for buffer, and force update
of each of those windows. */
register Lisp_Object window;
register struct window *w;
- BVAR (XBUFFER (buf), directory) = BVAR (current_buffer, directory);
+ bset_directory (XBUFFER (buf), BVAR (current_buffer, directory));
Fset_buffer (buf);
BUF_SAVE_MODIFF (XBUFFER (buf)) = MODIFF;
Fmake_frame_visible (WINDOW_FRAME (XWINDOW (window)));
Vminibuf_scroll_window = window;
w = XWINDOW (window);
- XSETFASTINT (w->hscroll, 0);
- XSETFASTINT (w->min_hscroll, 0);
+ w->hscroll = 0;
+ w->min_hscroll = 0;
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. */
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object prev_window, prev_buffer;
prev_window = selected_window;
XSETBUFFER (prev_buffer, old);
{
Lisp_Object parent;
register struct window *o, *p;
- int i;
o = XWINDOW (window);
p = allocate_window ();
- for (i = 0; i < VECSIZE (struct window); ++i)
- ((struct Lisp_Vector *) p)->contents[i]
- = ((struct Lisp_Vector *) o)->contents[i];
+ memcpy ((char *) p + sizeof (struct vectorlike_header),
+ (char *) o + sizeof (struct vectorlike_header),
+ word_size * VECSIZE (struct window));
XSETWINDOW (parent, p);
- ++sequence_number;
- XSETFASTINT (p->sequence_number, sequence_number);
+ p->sequence_number = ++sequence_number;
replace_window (window, parent, 1);
- o->next = Qnil;
- o->prev = Qnil;
- o->parent = parent;
+ wset_next (o, Qnil);
+ wset_prev (o, Qnil);
+ wset_parent (o, parent);
- p->hchild = horflag ? window : Qnil;
- p->vchild = horflag ? Qnil : window;
- p->start = Qnil;
- p->pointm = Qnil;
- p->buffer = Qnil;
- p->combination_limit = Qnil;
- p->window_parameters = Qnil;
+ wset_hchild (p, horflag ? window : Qnil);
+ wset_vchild (p, horflag ? Qnil : window);
+ wset_start (p, Qnil);
+ wset_pointm (p, Qnil);
+ wset_buffer (p, Qnil);
+ wset_combination_limit (p, Qnil);
+ wset_window_parameters (p, Qnil);
}
/* Make new window from scratch. */
register struct window *w;
w = allocate_window ();
- /* Initialize all Lisp data. */
- w->frame = w->mini_p = Qnil;
- w->next = w->prev = w->hchild = w->vchild = w->parent = Qnil;
- XSETFASTINT (w->left_col, 0);
- XSETFASTINT (w->top_line, 0);
- XSETFASTINT (w->total_lines, 0);
- XSETFASTINT (w->total_cols, 0);
- w->normal_lines = make_float (1.0);
- w->normal_cols = make_float (1.0);
- XSETFASTINT (w->new_total, 0);
- XSETFASTINT (w->new_normal, 0);
- w->buffer = Qnil;
- w->start = Fmake_marker ();
- w->pointm = Fmake_marker ();
- w->force_start = w->optional_new_start = Qnil;
- XSETFASTINT (w->hscroll, 0);
- XSETFASTINT (w->min_hscroll, 0);
- XSETFASTINT (w->use_time, 0);
- ++sequence_number;
- XSETFASTINT (w->sequence_number, sequence_number);
- w->temslot = w->last_modified = w->last_overlay_modified = Qnil;
- XSETFASTINT (w->last_point, 0);
- w->last_had_star = w->vertical_scroll_bar = Qnil;
- w->left_margin_cols = w->right_margin_cols = Qnil;
- w->left_fringe_width = w->right_fringe_width = Qnil;
- w->fringes_outside_margins = Qnil;
- w->scroll_bar_width = Qnil;
- w->vertical_scroll_bar_type = Qt;
- w->last_mark_x = w->last_mark_y = Qnil;
- XSETFASTINT (w->window_end_pos, 0);
- XSETFASTINT (w->window_end_vpos, 0);
- w->window_end_valid = w->update_mode_line = Qnil;
- w->start_at_line_beg = w->display_table = w->dedicated = Qnil;
- w->base_line_number = w->base_line_pos = w->region_showing = Qnil;
- w->column_number_displayed = w->redisplay_end_trigger = Qnil;
- w->combination_limit = w->window_parameters = Qnil;
- w->prev_buffers = w->next_buffers = Qnil;
- /* Initialize non-Lisp data. */
- w->desired_matrix = w->current_matrix = 0;
+ /* Initialize Lisp data. Note that allocate_window initializes all
+ Lisp data to nil, so do it only for slots which should not be nil. */
+ wset_left_col (w, make_number (0));
+ wset_top_line (w, make_number (0));
+ wset_total_lines (w, make_number (0));
+ wset_total_cols (w, make_number (0));
+ wset_normal_lines (w, make_float (1.0));
+ wset_normal_cols (w, make_float (1.0));
+ wset_new_total (w, make_number (0));
+ wset_new_normal (w, make_number (0));
+ wset_start (w, Fmake_marker ());
+ wset_pointm (w, Fmake_marker ());
+ wset_vertical_scroll_bar_type (w, Qt);
+ wset_window_end_pos (w, make_number (0));
+ wset_window_end_vpos (w, make_number (0));
+ /* These Lisp fields are marked specially so they're not set to nil by
+ allocate_window. */
+ wset_prev_buffers (w, Qnil);
+ wset_next_buffers (w, Qnil);
+
+ /* 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. */
w->nrows_scale_factor = w->ncols_scale_factor = 1;
- memset (&w->cursor, 0, sizeof (w->cursor));
- memset (&w->last_cursor, 0, sizeof (w->last_cursor));
- memset (&w->phys_cursor, 0, sizeof (w->phys_cursor));
w->phys_cursor_type = -1;
w->phys_cursor_width = -1;
- w->phys_cursor_on_p = 0;
- w->last_cursor_off_p = w->cursor_off_p = 0;
- w->must_be_updated_p = 0;
- w->pseudo_window_p = 0;
- w->frozen_window_start_p = 0;
- w->vscroll = 0;
+ w->sequence_number = ++sequence_number;
+
/* Reset window_list. */
Vwindow_list = Qnil;
/* Return window. */
\f
DEFUN ("set-window-new-total", Fset_window_new_total, Sset_window_new_total, 2, 3, 0,
doc: /* Set new total size of WINDOW to SIZE.
+WINDOW must be a valid window and defaults to the selected one.
Return SIZE.
Optional argument ADD non-nil means add SIZE to the new total size of
Note: This function does not operate on any child windows of WINDOW. */)
(Lisp_Object window, Lisp_Object size, Lisp_Object add)
{
- struct window *w = decode_any_window (window);
+ struct window *w = decode_valid_window (window);
CHECK_NUMBER (size);
if (NILP (add))
- XSETINT (w->new_total, XINT (size));
+ wset_new_total (w, size);
else
- XSETINT (w->new_total, XINT (w->new_total) + XINT (size));
+ wset_new_total (w, make_number (XINT (w->new_total) + XINT (size)));
return w->new_total;
}
DEFUN ("set-window-new-normal", Fset_window_new_normal, Sset_window_new_normal, 1, 2, 0,
doc: /* Set new normal size of WINDOW to SIZE.
+WINDOW must be a valid window and defaults to the selected one.
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);
-
- w->new_normal = size;
- return w->new_normal;
+ wset_new_normal (decode_valid_window (window), size);
+ return size;
}
/* Return 1 if setting w->total_lines (w->total_cols if HORFLAG is
parent window has been set *before*. */
if (horflag)
{
- w->total_cols = w->new_total;
+ wset_total_cols (w, w->new_total);
if (NUMBERP (w->new_normal))
- w->normal_cols = w->new_normal;
+ wset_normal_cols (w, w->new_normal);
pos = XINT (w->left_col);
}
else
{
- w->total_lines = w->new_total;
+ wset_total_lines (w, w->new_total);
if (NUMBERP (w->new_normal))
- w->normal_lines = w->new_normal;
+ wset_normal_lines (w, w->new_normal);
pos = XINT (w->top_line);
}
while (c)
{
if (horflag)
- XSETFASTINT (c->left_col, pos);
+ wset_left_col (c, make_number (pos));
else
- XSETFASTINT (c->top_line, pos);
+ wset_top_line (c, make_number (pos));
window_resize_apply (c, horflag);
if (!horflag)
pos = pos + XINT (c->total_lines);
while (c)
{
if (horflag)
- XSETFASTINT (c->left_col, pos);
+ wset_left_col (c, make_number (pos));
else
- XSETFASTINT (c->top_line, pos);
+ wset_top_line (c, make_number (pos));
window_resize_apply (c, horflag);
if (horflag)
pos = pos + XINT (c->total_cols);
}
/* Clear out some redisplay caches. */
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
}
r = XWINDOW (FRAME_ROOT_WINDOW (f));
if (!window_resize_check (r, horflag)
- || ! EQ (r->new_total, (horflag ? r->total_cols : r->total_lines)))
+ || ! EQ (r->new_total,
+ (horflag ? r->total_cols : r->total_lines)))
return Qnil;
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (r, horflag);
windows_or_buffers_changed++;
FRAME_WINDOW_SIZES_CHANGED (f) = 1;
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
run_window_configuration_change_hook (f);
- ((FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f))
? 1 : 0)));
- XSETFASTINT (r->top_line, FRAME_TOP_MARGIN (f));
+ wset_top_line (r, 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 (r->total_cols, new_size);
+ wset_total_cols (r, make_number (new_size));
else
- XSETFASTINT (r->total_lines, new_size);
+ wset_total_lines (r, make_number (new_size));
else
{
/* old_size is the old size of the frame's root window. */
- int old_size = XFASTINT (horflag ? r->total_cols : 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 (r->new_total))
+ if (window_resize_check (r, horflag)
+ && new_size == XINT (r->new_total))
window_resize_apply (r, horflag);
else
{
root = f->selected_window;
Fdelete_other_windows_internal (root, Qnil);
if (horflag)
- XSETFASTINT (XWINDOW (root)->total_cols, new_size);
+ wset_total_cols (XWINDOW (root), make_number (new_size));
else
- XSETFASTINT (XWINDOW (root)->total_lines, new_size);
+ wset_total_lines (XWINDOW (root), make_number (new_size));
}
}
}
{
m = XWINDOW (mini);
if (horflag)
- XSETFASTINT (m->total_cols, size);
+ wset_total_cols (m, make_number (size));
else
{
/* Are we sure we always want 1 line here? */
- XSETFASTINT (m->total_lines, 1);
- XSETFASTINT (m->top_line, XINT (r->top_line) + XINT (r->total_lines));
+ wset_total_lines (m, make_number (1));
+ wset_top_line
+ (m, make_number (XINT (r->top_line) + XINT (r->total_lines)));
}
}
}
We do that if either `window-combination-limit' is t, or OLD has no
parent, or OLD is ortho-combined. */
combination_limit =
- !NILP (Vwindow_combination_limit)
+ EQ (Vwindow_combination_limit, Qt)
|| NILP (o->parent)
|| NILP (horflag
? (XWINDOW (o->parent)->hchild)
{
p = XWINDOW (o->parent);
/* Temporarily pretend we split the parent window. */
- XSETINT (p->new_total,
- XINT (horflag ? p->total_cols : p->total_lines)
- - XINT (total_size));
+ wset_new_total
+ (p, 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. */
- p->new_total = horflag ? p->total_cols : p->total_lines;
+ wset_new_total (p, horflag ? p->total_cols : p->total_lines);
}
else
{
/* Save the old value of o->normal_cols/lines. It gets corrupted
by make_parent_window and we need it below for assigning it to
p->new_normal. */
- Lisp_Object new_normal = horflag ? o->normal_cols : o->normal_lines;
+ Lisp_Object new_normal
+ = horflag ? o->normal_cols : o->normal_lines;
make_parent_window (old, horflag);
p = XWINDOW (o->parent);
- /* Store value of `window-combination-limit' in new parent's
- combination_limit slot. */
- p->combination_limit = Vwindow_combination_limit;
+ /* Store t in the new parent's combination_limit slot to avoid
+ that its children get merged into another window. */
+ wset_combination_limit (p, Qt);
/* These get applied below. */
- p->new_total = horflag ? o->total_cols : o->total_lines;
- p->new_normal = new_normal;
+ wset_new_total (p, horflag ? o->total_cols : o->total_lines);
+ wset_new_normal (p, new_normal);
}
else
p = XWINDOW (o->parent);
FRAME_WINDOW_SIZES_CHANGED (f) = 1;
new = make_window ();
n = XWINDOW (new);
- n->frame = frame;
- n->parent = o->parent;
- n->vchild = n->hchild = Qnil;
+ wset_frame (n, frame);
+ wset_parent (n, o->parent);
+ wset_vchild (n, Qnil);
+ wset_hchild (n, Qnil);
if (EQ (side, Qabove) || EQ (side, Qleft))
{
- n->prev = o->prev;
+ wset_prev (n, o->prev);
if (NILP (n->prev))
if (horflag)
- p->hchild = new;
+ wset_hchild (p, new);
else
- p->vchild = new;
+ wset_vchild (p, new);
else
- XWINDOW (n->prev)->next = new;
- n->next = old;
- o->prev = new;
+ wset_next (XWINDOW (n->prev), new);
+ wset_next (n, old);
+ wset_prev (o, new);
}
else
{
- n->next = o->next;
+ wset_next (n, o->next);
if (!NILP (n->next))
- XWINDOW (n->next)->prev = new;
- n->prev = old;
- o->next = new;
+ wset_prev (XWINDOW (n->next), new);
+ wset_prev (n, old);
+ wset_next (o, new);
}
- n->buffer = Qt;
- n->window_end_valid = Qnil;
+ wset_buffer (n, Qt);
+ wset_window_end_valid (n, Qnil);
memset (&n->last_cursor, 0, sizeof n->last_cursor);
/* Get special geometry settings from reference window. */
- n->left_margin_cols = r->left_margin_cols;
- n->right_margin_cols = r->right_margin_cols;
- n->left_fringe_width = r->left_fringe_width;
- n->right_fringe_width = r->right_fringe_width;
+ wset_left_margin_cols (n, r->left_margin_cols);
+ wset_right_margin_cols (n, r->right_margin_cols);
+ wset_left_fringe_width (n, r->left_fringe_width);
+ wset_right_fringe_width (n, r->right_fringe_width);
n->fringes_outside_margins = r->fringes_outside_margins;
- n->scroll_bar_width = r->scroll_bar_width;
- n->vertical_scroll_bar_type = r->vertical_scroll_bar_type;
+ wset_scroll_bar_width (n, r->scroll_bar_width);
+ wset_vertical_scroll_bar_type (n, r->vertical_scroll_bar_type);
/* Directly assign orthogonal coordinates and sizes. */
if (horflag)
{
- n->top_line = o->top_line;
- n->total_lines = o->total_lines;
+ wset_top_line (n, o->top_line);
+ wset_total_lines (n, o->total_lines);
}
else
{
- n->left_col = o->left_col;
- n->total_cols = o->total_cols;
+ wset_left_col (n, o->left_col);
+ wset_total_cols (n, o->total_cols);
}
/* Iso-coordinates and sizes are assigned by window_resize_apply,
get them ready here. */
- n->new_total = total_size;
- n->new_normal = normal_size;
+ wset_new_total (n, total_size);
+ wset_new_normal (n, normal_size);
- BLOCK_INPUT;
+ 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, r->buffer, 0, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Maybe we should run the scroll functions in Elisp (which already
runs the configuration change hook). */
w = decode_any_window (window);
XSETWINDOW (window, w);
- if (NILP (w->buffer) && NILP (w->hchild) && NILP (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;
before_sibling = 1;
sibling = w->next;
s = XWINDOW (sibling);
- s->prev = Qnil;
+ wset_prev (s, Qnil);
if (horflag)
- p->hchild = sibling;
+ wset_hchild (p, sibling);
else
- p->vchild = sibling;
+ wset_vchild (p, sibling);
}
else
/* Get SIBLING above (on the left of) WINDOW. */
{
sibling = w->prev;
s = XWINDOW (sibling);
- s->next = w->next;
+ wset_next (s, w->next);
if (!NILP (s->next))
- XWINDOW (s->next)->prev = sibling;
+ wset_prev (XWINDOW (s->next), sibling);
}
if (window_resize_check (r, horflag)
- && EQ (r->new_total, (horflag ? r->total_cols : r->total_lines)))
+ && EQ (r->new_total,
+ (horflag ? r->total_cols : r->total_lines)))
/* We can delete WINDOW now. */
{
/* Block input. */
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (p, horflag);
/* If this window is referred to by the dpyinfo's mouse
Vwindow_list = Qnil;
FRAME_WINDOW_SIZES_CHANGED (f) = 1;
- w->next = Qnil; /* Don't delete w->next too. */
+ wset_next (w, Qnil); /* Don't delete w->next too. */
free_window_matrices (w);
if (!NILP (w->vchild))
{
delete_all_child_windows (w->vchild);
- w->vchild = Qnil;
+ wset_vchild (w, Qnil);
}
else if (!NILP (w->hchild))
{
delete_all_child_windows (w->hchild);
- w->hchild = Qnil;
+ wset_hchild (w, Qnil);
}
else if (!NILP (w->buffer))
{
unshow_buffer (w);
unchain_marker (XMARKER (w->pointm));
unchain_marker (XMARKER (w->start));
- w->buffer = Qnil;
+ wset_buffer (w, Qnil);
}
if (NILP (s->prev) && NILP (s->next))
replace_window (parent, sibling, 0);
/* Have SIBLING inherit the following three slot values from
PARENT (the combination_limit slot is not inherited). */
- s->normal_cols = p->normal_cols;
- s->normal_lines = p->normal_lines;
+ wset_normal_cols (s, p->normal_cols);
+ wset_normal_lines (s, p->normal_lines);
/* Mark PARENT as deleted. */
- p->vchild = p->hchild = Qnil;
+ wset_vchild (p, Qnil);
+ wset_hchild (p, Qnil);
/* Try to merge SIBLING into its new parent. */
recombine_windows (sibling);
}
if (EQ (FRAME_SELECTED_WINDOW (f), selected_window))
Fselect_window (new_selected_window, Qt);
else
- FRAME_SELECTED_WINDOW (f) = new_selected_window;
+ fset_selected_window (f, new_selected_window);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Now look whether `get-mru-window' gets us something. */
mru_window = call1 (Qget_mru_window, frame);
if (EQ (FRAME_SELECTED_WINDOW (f), selected_window))
Fselect_window (new_selected_window, Qnil);
else
- FRAME_SELECTED_WINDOW (f) = new_selected_window;
+ fset_selected_window (f, new_selected_window);
}
else
- UNBLOCK_INPUT;
+ unblock_input ();
/* Must be run by the caller:
run_window_configuration_change_hook (f); */
{
if (before_sibling)
{
- s->prev = window;
+ wset_prev (s, window);
if (horflag)
- p->hchild = window;
+ wset_hchild (p, window);
else
- p->vchild = window;
+ wset_vchild (p, window);
}
else
{
- s->next = window;
+ wset_next (s, window);
if (!NILP (w->next))
- XWINDOW (w->next)->prev = window;
+ wset_prev (XWINDOW (w->next), window);
}
error ("Deletion failed");
}
struct window *r;
Lisp_Object root, value;
- xassert (MINI_WINDOW_P (w));
- xassert (delta >= 0);
+ eassert (MINI_WINDOW_P (w));
+ eassert (delta >= 0);
root = FRAME_ROOT_WINDOW (f);
r = XWINDOW (root);
root, make_number (- delta));
if (INTEGERP (value) && window_resize_check (r, 0))
{
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (r, 0);
/* Grow the mini-window. */
- XSETFASTINT (w->top_line, XFASTINT (r->top_line) + XFASTINT (r->total_lines));
- XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - XINT (value));
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ wset_top_line
+ (w, make_number (XFASTINT (r->top_line) + XFASTINT (r->total_lines)));
+ wset_total_lines
+ (w, make_number (XFASTINT (w->total_lines) - XINT (value)));
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
Lisp_Object root, value;
EMACS_INT size;
- xassert (MINI_WINDOW_P (w));
+ eassert (MINI_WINDOW_P (w));
size = XINT (w->total_lines);
if (size > 1)
root, make_number (size - 1));
if (INTEGERP (value) && window_resize_check (r, 0))
{
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (r, 0);
/* Shrink the mini-window. */
- XSETFASTINT (w->top_line, XFASTINT (r->top_line) + XFASTINT (r->total_lines));
- XSETFASTINT (w->total_lines, 1);
+ wset_top_line (w, make_number (XFASTINT (r->top_line)
+ + XFASTINT (r->total_lines)));
+ wset_total_lines (w, make_number (1));
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If the above failed for whatever strange reason we must make a
one window frame here. The same routine will be needed when
&& XINT (w->new_total) > 0
&& height == XINT (r->new_total) + XINT (w->new_total))
{
- BLOCK_INPUT;
+ block_input ();
window_resize_apply (r, 0);
- w->total_lines = w->new_total;
- XSETFASTINT (w->top_line, XINT (r->top_line) + XINT (r->total_lines));
+ wset_total_lines (w, w->new_total);
+ wset_top_line (w, make_number (XINT (r->top_line)
+ + XINT (r->total_lines)));
windows_or_buffers_changed++;
FRAME_WINDOW_SIZES_CHANGED (f) = 1;
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
run_window_configuration_change_hook (f);
return Qt;
respectively. */
static void
-window_scroll (Lisp_Object window, int n, int whole, int noerror)
+window_scroll (Lisp_Object window, EMACS_INT n, int whole, int noerror)
{
immediate_quit = 1;
+ n = clip_to_bounds (INT_MIN, n, INT_MAX);
/* If we must, use the pixel-based version which is much slower than
the line-based one but can handle varying line heights. */
/* Maybe modify window start instead of scrolling. */
if (rbot > 0 || w->vscroll < 0)
{
- EMACS_INT spos;
+ ptrdiff_t spos;
Fset_window_vscroll (window, make_number (0), Qt);
/* If there are other text lines above the current row,
spos = min (XINT (Fline_end_position (Qnil)) + 1, ZV);
set_marker_restricted (w->start, make_number (spos),
w->buffer);
- w->start_at_line_beg = Qt;
- w->update_mode_line = Qt;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->start_at_line_beg = 1;
+ w->update_mode_line = 1;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Set force_start so that redisplay_window will run the
window-scroll-functions. */
- w->force_start = Qt;
+ w->force_start = 1;
return;
}
}
start_display (&it, w, start);
if (whole)
{
- EMACS_INT start_pos = IT_CHARPOS (it);
+ ptrdiff_t start_pos = IT_CHARPOS (it);
int dy = WINDOW_FRAME_LINE_HEIGHT (w);
dy = max ((window_box_height (w)
- next_screen_context_lines * dy),
if (! vscrolled)
{
- EMACS_INT pos = IT_CHARPOS (it);
- EMACS_INT bytepos;
+ ptrdiff_t pos = IT_CHARPOS (it);
+ ptrdiff_t bytepos;
/* If in the middle of a multi-glyph character move forward to
the next character. */
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')
- ? Qt : Qnil);
- w->update_mode_line = Qt;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->start_at_line_beg = (pos == BEGV || FETCH_BYTE (bytepos - 1) == '\n');
+ w->update_mode_line = 1;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Set force_start so that redisplay_window will run the
window-scroll-functions. */
- w->force_start = Qt;
+ w->force_start = 1;
}
/* The rest of this function uses current_y in a nonstandard way,
This code wants current_y to be zero at the window start position
even if there is a header line. */
this_scroll_margin = max (0, scroll_margin);
- this_scroll_margin = min (this_scroll_margin, XFASTINT (w->total_lines) / 4);
+ this_scroll_margin
+ = min (this_scroll_margin, XFASTINT (w->total_lines) / 4);
this_scroll_margin *= FRAME_LINE_HEIGHT (it.f);
if (n > 0)
}
else if (n < 0)
{
- EMACS_INT charpos, bytepos;
+ ptrdiff_t charpos, bytepos;
int partial_p;
/* Save our position, for the
in `grep-mode-font-lock-keywords'). So we use a marker to record
the old point position, to prevent crashes in SET_PT_BOTH. */
Lisp_Object opoint_marker = Fpoint_marker ();
- register EMACS_INT pos, pos_byte;
+ register ptrdiff_t pos, pos_byte;
register int ht = window_internal_height (w);
register Lisp_Object tem;
int lose;
Lisp_Object bolp;
- EMACS_INT startpos;
+ ptrdiff_t startpos;
Lisp_Object original_pos = Qnil;
/* If scrolling screen-fulls, compute the number of lines to
struct position posit
= *compute_motion (startpos, 0, 0, 0,
PT, ht, 0,
- -1, XINT (w->hscroll),
+ -1, w->hscroll,
0, w);
window_scroll_preserve_vpos = posit.vpos;
- window_scroll_preserve_hpos = posit.hpos + XINT (w->hscroll);
+ window_scroll_preserve_hpos = posit.hpos + w->hscroll;
}
original_pos = Fcons (make_number (window_scroll_preserve_hpos),
max (0, min (scroll_margin, XINT (w->total_lines) / 4));
set_marker_restricted_both (w->start, w->buffer, pos, pos_byte);
- w->start_at_line_beg = bolp;
- w->update_mode_line = Qt;
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->start_at_line_beg = !NILP (bolp);
+ w->update_mode_line = 1;
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Set force_start so that redisplay_window will run
the window-scroll-functions. */
- w->force_start = Qt;
+ w->force_start = 1;
if (!NILP (Vscroll_preserve_screen_position)
&& (whole || !EQ (Vscroll_preserve_screen_position, Qt)))
static void
scroll_command (Lisp_Object n, int direction)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
- xassert (eabs (direction) == 1);
+ eassert (eabs (direction) == 1);
/* 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. */
{
Lisp_Object window;
struct window *w;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
window = Fother_window_for_scrolling ();
w = XWINDOW (window);
else
{
if (CONSP (arg))
- arg = Fcar (arg);
+ arg = XCAR (arg);
CHECK_NUMBER (arg);
window_scroll (window, XINT (arg), 0, 1);
}
by this function. This happens in an interactive call. */)
(register Lisp_Object arg, Lisp_Object set_minimum)
{
- Lisp_Object result;
- int hscroll;
struct window *w = XWINDOW (selected_window);
-
- if (NILP (arg))
- XSETFASTINT (arg, window_body_cols (w) - 2);
- else
- arg = Fprefix_numeric_value (arg);
-
- hscroll = XINT (w->hscroll) + XINT (arg);
- result = Fset_window_hscroll (selected_window, make_number (hscroll));
+ EMACS_INT requested_arg = (NILP (arg)
+ ? window_body_cols (w) - 2
+ : XINT (Fprefix_numeric_value (arg)));
+ Lisp_Object result = set_window_hscroll (w, w->hscroll + requested_arg);
if (!NILP (set_minimum))
w->min_hscroll = w->hscroll;
by this function. This happens in an interactive call. */)
(register Lisp_Object arg, Lisp_Object set_minimum)
{
- Lisp_Object result;
- int hscroll;
struct window *w = XWINDOW (selected_window);
-
- if (NILP (arg))
- XSETFASTINT (arg, window_body_cols (w) - 2);
- else
- arg = Fprefix_numeric_value (arg);
-
- hscroll = XINT (w->hscroll) - XINT (arg);
- result = Fset_window_hscroll (selected_window, make_number (hscroll));
+ EMACS_INT requested_arg = (NILP (arg)
+ ? window_body_cols (w) - 2
+ : XINT (Fprefix_numeric_value (arg)));
+ Lisp_Object result = set_window_hscroll (w, w->hscroll - requested_arg);
if (!NILP (set_minimum))
w->min_hscroll = w->hscroll;
struct buffer *buf = XBUFFER (w->buffer);
struct buffer *obuf = current_buffer;
int center_p = 0;
- EMACS_INT charpos, bytepos;
+ ptrdiff_t charpos, bytepos;
EMACS_INT iarg IF_LINT (= 0);
int this_scroll_margin;
{
struct it it;
struct text_pos pt;
- int nlines = min (INT_MAX, -iarg);
+ ptrdiff_t nlines = min (PTRDIFF_MAX, -iarg);
int extra_line_spacing;
int h = window_box_height (w);
void *itdata = bidi_shelve_cache ();
/* Set the new window start. */
set_marker_both (w->start, w->buffer, charpos, bytepos);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
- w->optional_new_start = Qt;
+ w->optional_new_start = 1;
- if (bytepos == BEGV_BYTE || FETCH_BYTE (bytepos - 1) == '\n')
- w->start_at_line_beg = Qt;
- else
- w->start_at_line_beg = Qnil;
+ w->start_at_line_beg = (bytepos == BEGV_BYTE ||
+ FETCH_BYTE (bytepos - 1) == '\n');
set_buffer_internal (obuf);
return Qnil;
DEFUN ("window-text-height", Fwindow_text_height, Swindow_text_height,
0, 1, 0,
doc: /* Return the height in lines of the text display area of WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
The returned height does not include the mode line, any header line,
nor any partial-height lines at the bottom of the text area. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
int pixel_height = window_box_height (w);
int line_height = pixel_height / FRAME_LINE_HEIGHT (XFRAME (w->frame));
return make_number (line_height);
int height = window_internal_height (w);
Fvertical_motion (make_number (- (height / 2)), window);
set_marker_both (w->start, w->buffer, PT, PT_BYTE);
- w->start_at_line_beg = Fbolp ();
- w->force_start = Qt;
+ w->start_at_line_beg = !NILP (Fbolp ());
+ w->force_start = 1;
}
else
Fgoto_char (w->start);
struct Lisp_Vector *saved_windows;
Lisp_Object new_current_buffer;
Lisp_Object frame;
- Lisp_Object auto_buffer_name;
FRAME_PTR f;
- EMACS_INT old_point = -1;
+ ptrdiff_t old_point = -1;
CHECK_WINDOW_CONFIGURATION (configuration);
saved_windows = XVECTOR (data->saved_windows);
new_current_buffer = data->current_buffer;
- if (NILP (BVAR (XBUFFER (new_current_buffer), name)))
+ if (!BUFFER_LIVE_P (XBUFFER (new_current_buffer)))
new_current_buffer = Qnil;
else
{
int previous_frame_menu_bar_lines = FRAME_MENU_BAR_LINES (f);
int previous_frame_tool_bar_lines = FRAME_TOOL_BAR_LINES (f);
+ /* Don't do this within the main loop below: This may call Lisp
+ code and is thus potentially unsafe while input is blocked. */
+ for (k = 0; k < saved_windows->header.size; k++)
+ {
+ p = SAVED_WINDOW_N (saved_windows, k);
+ window = p->window;
+ w = XWINDOW (window);
+ if (!NILP (w->buffer)
+ && !EQ (w->buffer, p->buffer)
+ && BUFFER_LIVE_P (XBUFFER (p->buffer)))
+ /* If a window we restore gets another buffer, record the
+ window's old buffer. */
+ call1 (Qrecord_window_buffer, window);
+ }
+
/* The mouse highlighting code could get screwed up
if it runs during this. */
- BLOCK_INPUT;
+ block_input ();
if (data->frame_lines != previous_frame_lines
|| data->frame_cols != previous_frame_cols)
really like to do is to free only those matrices not reused
below. */
root_window = XWINDOW (FRAME_ROOT_WINDOW (f));
- leaf_windows
- = (struct window **) alloca (count_windows (root_window)
- * sizeof (struct window *));
+ leaf_windows = alloca (count_windows (root_window)
+ * sizeof *leaf_windows);
n_leaf_windows = get_leaf_windows (root_window, leaf_windows, 0);
/* Kludge Alert!
p = SAVED_WINDOW_N (saved_windows, k);
window = p->window;
w = XWINDOW (window);
- w->next = Qnil;
+ wset_next (w, Qnil);
if (!NILP (p->parent))
- w->parent = SAVED_WINDOW_N (saved_windows,
- XFASTINT (p->parent))->window;
+ wset_parent
+ (w, SAVED_WINDOW_N (saved_windows, XFASTINT (p->parent))->window);
else
- w->parent = Qnil;
+ wset_parent (w, Qnil);
if (!NILP (p->prev))
{
- w->prev = SAVED_WINDOW_N (saved_windows,
- XFASTINT (p->prev))->window;
- XWINDOW (w->prev)->next = p->window;
+ wset_prev
+ (w, SAVED_WINDOW_N (saved_windows, XFASTINT (p->prev))->window);
+ wset_next (XWINDOW (w->prev), p->window);
}
else
{
- w->prev = Qnil;
+ wset_prev (w, Qnil);
if (!NILP (w->parent))
{
if (EQ (p->total_cols, XWINDOW (w->parent)->total_cols))
{
- XWINDOW (w->parent)->vchild = p->window;
- XWINDOW (w->parent)->hchild = Qnil;
+ wset_vchild (XWINDOW (w->parent), p->window);
+ wset_hchild (XWINDOW (w->parent), Qnil);
}
else
{
- XWINDOW (w->parent)->hchild = p->window;
- XWINDOW (w->parent)->vchild = Qnil;
+ wset_hchild (XWINDOW (w->parent), p->window);
+ wset_vchild (XWINDOW (w->parent), Qnil);
}
}
}
/* If we squirreled away the buffer in the window's height,
restore it now. */
if (BUFFERP (w->total_lines))
- w->buffer = w->total_lines;
- w->left_col = p->left_col;
- w->top_line = p->top_line;
- w->total_cols = p->total_cols;
- w->total_lines = p->total_lines;
- w->normal_cols = p->normal_cols;
- w->normal_lines = p->normal_lines;
- w->hscroll = p->hscroll;
- w->min_hscroll = p->min_hscroll;
- w->display_table = p->display_table;
- w->left_margin_cols = p->left_margin_cols;
- w->right_margin_cols = p->right_margin_cols;
- w->left_fringe_width = p->left_fringe_width;
- w->right_fringe_width = p->right_fringe_width;
- w->fringes_outside_margins = p->fringes_outside_margins;
- w->scroll_bar_width = p->scroll_bar_width;
- w->vertical_scroll_bar_type = p->vertical_scroll_bar_type;
- w->dedicated = p->dedicated;
- w->combination_limit = p->combination_limit;
+ wset_buffer (w, w->total_lines);
+ wset_left_col (w, p->left_col);
+ wset_top_line (w, p->top_line);
+ wset_total_cols (w, p->total_cols);
+ wset_total_lines (w, p->total_lines);
+ wset_normal_cols (w, p->normal_cols);
+ wset_normal_lines (w, p->normal_lines);
+ w->hscroll = XFASTINT (p->hscroll);
+ w->min_hscroll = XFASTINT (p->min_hscroll);
+ wset_display_table (w, p->display_table);
+ wset_left_margin_cols (w, p->left_margin_cols);
+ wset_right_margin_cols (w, p->right_margin_cols);
+ wset_left_fringe_width (w, p->left_fringe_width);
+ wset_right_fringe_width (w, p->right_fringe_width);
+ w->fringes_outside_margins = !NILP (p->fringes_outside_margins);
+ wset_scroll_bar_width (w, p->scroll_bar_width);
+ wset_vertical_scroll_bar_type (w, p->vertical_scroll_bar_type);
+ wset_dedicated (w, p->dedicated);
+ wset_combination_limit (w, 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))
}
}
- XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->last_overlay_modified, 0);
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Reinstall the saved buffer and pointers into it. */
if (NILP (p->buffer))
/* An internal window. */
- w->buffer = p->buffer;
- else if (!NILP (BVAR (XBUFFER (p->buffer), name)))
+ wset_buffer (w, p->buffer);
+ else if (BUFFER_LIVE_P (XBUFFER (p->buffer)))
/* If saved buffer is alive, install it. */
{
- w->buffer = p->buffer;
- w->start_at_line_beg = p->start_at_line_beg;
+ wset_buffer (w, 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);
+ set_marker_restricted (w->pointm, p->pointm,
+ w->buffer);
Fset_marker (BVAR (XBUFFER (w->buffer), mark),
p->mark, w->buffer);
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 = Qt;
- }
- else if (STRINGP (auto_buffer_name =
- Fwindow_parameter (window, Qauto_buffer_name))
- && SCHARS (auto_buffer_name) != 0
- && !NILP (w->buffer = Fget_buffer_create (auto_buffer_name)))
- {
- 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 = Qt;
- }
+ }
+ else if (!NILP (w->buffer)
+ && BUFFER_LIVE_P (XBUFFER (w->buffer)))
+ /* 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
/* Window has no live buffer, get one. */
{
avoid showing an unimportant buffer and, if necessary, to
recreate *scratch* in the course (part of Juanma's bs-show
scenario from March 2011). */
- w->buffer = other_buffer_safely (Fcurrent_buffer ());
+ wset_buffer (w, other_buffer_safely (Fcurrent_buffer ()));
/* This will set the markers to beginning of visible
range. */
- 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 = Qt;
+ 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 (w->dedicated))
/* Record this window as dead. */
dead_windows = Fcons (window, dead_windows);
/* Make sure window is no more dedicated. */
- w->dedicated = Qnil;
+ wset_dedicated (w, Qnil);
}
}
- FRAME_ROOT_WINDOW (f) = data->root_window;
+ fset_root_window (f, data->root_window);
/* Arrange *not* to restore point in the buffer that was
current when the window configuration was saved. */
if (EQ (XWINDOW (data->current_window)->buffer, new_current_buffer))
if (NILP (leaf_windows[i]->buffer))
{
/* Assert it's not reused as a combination. */
- xassert (NILP (leaf_windows[i]->hchild)
+ eassert (NILP (leaf_windows[i]->hchild)
&& NILP (leaf_windows[i]->vchild));
free_window_matrices (leaf_windows[i]);
}
}
adjust_glyphs (f);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Scan dead buffer windows. */
for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows))
}
if (!NILP (new_current_buffer))
- Fset_buffer (new_current_buffer);
+ {
+ Fset_buffer (new_current_buffer);
+ /* If the new current buffer doesn't appear in the selected
+ window, go to its old point (see bug#12208). */
+ if (!EQ (XWINDOW (data->current_window)->buffer, new_current_buffer))
+ Fgoto_char (make_number (old_point));
+ }
Vminibuf_scroll_window = data->minibuf_scroll_window;
minibuf_selected_window = data->minibuf_selected_window;
/* Delete WINDOW's siblings (we traverse postorderly). */
delete_all_child_windows (w->next);
- w->total_lines = w->buffer; /* See Fset_window_configuration for excuse. */
+ /* See Fset_window_configuration for excuse. */
+ wset_total_lines (w, w->buffer);
if (!NILP (w->vchild))
{
delete_all_child_windows (w->vchild);
- w->vchild = Qnil;
+ wset_vchild (w, Qnil);
}
else if (!NILP (w->hchild))
{
delete_all_child_windows (w->hchild);
- w->hchild = Qnil;
+ wset_hchild (w, Qnil);
}
else if (!NILP (w->buffer))
{
unshow_buffer (w);
unchain_marker (XMARKER (w->pointm));
unchain_marker (XMARKER (w->start));
- w->buffer = Qnil;
+ wset_buffer (w, Qnil);
}
Vwindow_list = Qnil;
if (!row->enabled_p)
return NULL;
- if (XINT (w->hscroll))
+ if (w->hscroll)
{
/* When the window is hscrolled, cursor hpos can legitimately be
out of bounds, but we draw the cursor at the corresponding
p = SAVED_WINDOW_N (vector, i);
w = XWINDOW (window);
- XSETFASTINT (w->temslot, i); i++;
+ wset_temslot (w, make_number (i)); i++;
p->window = window;
p->buffer = w->buffer;
p->left_col = w->left_col;
p->total_lines = w->total_lines;
p->normal_cols = w->normal_cols;
p->normal_lines = w->normal_lines;
- p->hscroll = w->hscroll;
- p->min_hscroll = w->min_hscroll;
+ XSETFASTINT (p->hscroll, w->hscroll);
+ XSETFASTINT (p->min_hscroll, w->min_hscroll);
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;
+ p->fringes_outside_margins = w->fringes_outside_margins ? Qt : Qnil;
p->scroll_bar_width = w->scroll_bar_width;
p->vertical_scroll_bar_type = w->vertical_scroll_bar_type;
p->dedicated = w->dedicated;
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 = Fmake_marker ();
- set_marker_both (p->pointm, w->buffer,
- BUF_PT (XBUFFER (w->buffer)),
- BUF_PT_BYTE (XBUFFER (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 (w->pointm, Qnil);
+ XMARKER (p->pointm)->insertion_type
+ = !NILP (Vwindow_point_insertion_type);
p->start = Fcopy_marker (w->start, Qnil);
- p->start_at_line_beg = w->start_at_line_beg;
+ p->start_at_line_beg = w->start_at_line_beg ? Qt : Qnil;
tem = BVAR (XBUFFER (w->buffer), mark);
p->mark = Fcopy_marker (tem, Qnil);
tem = Fmake_vector (make_number (n_windows), Qnil);
data->saved_windows = tem;
for (i = 0; i < n_windows; i++)
- XVECTOR (tem)->contents[i]
- = Fmake_vector (make_number (VECSIZE (struct saved_window)), Qnil);
+ ASET (tem, i,
+ Fmake_vector (make_number (VECSIZE (struct saved_window)), Qnil));
save_window_save (FRAME_ROOT_WINDOW (f), XVECTOR (tem), 0);
XSETWINDOW_CONFIGURATION (tem, data);
return (tem);
DEFUN ("set-window-margins", Fset_window_margins, Sset_window_margins,
2, 3, 0,
doc: /* Set width of marginal areas of window WINDOW.
-If WINDOW is nil, set margins of the currently selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Second arg LEFT-WIDTH specifies the number of character cells to
reserve for the left marginal area. Optional third arg RIGHT-WIDTH
does the same for the right marginal area. A nil width parameter
means no margin. */)
(Lisp_Object window, Lisp_Object left_width, Lisp_Object right_width)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
/* Translate negative or zero widths to nil.
Margins that are too wide have to be checked elsewhere. */
if (!EQ (w->left_margin_cols, left_width)
|| !EQ (w->right_margin_cols, right_width))
{
- w->left_margin_cols = left_width;
- w->right_margin_cols = right_width;
+ wset_left_margin_cols (w, left_width);
+ wset_right_margin_cols (w, right_width);
adjust_window_margins (w);
DEFUN ("window-margins", Fwindow_margins, Swindow_margins,
0, 1, 0,
doc: /* Get width of marginal areas of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Value is a cons of the form (LEFT-WIDTH . RIGHT-WIDTH).
If a marginal area does not exist, its width will be returned
as nil. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
return Fcons (w->left_margin_cols, w->right_margin_cols);
}
DEFUN ("set-window-fringes", Fset_window_fringes, Sset_window_fringes,
2, 4, 0,
doc: /* Set the fringe widths of window WINDOW.
-If WINDOW is nil, set the fringe widths of the currently selected
-window.
+WINDOW must be a live window and defaults to the selected one.
+
Second arg LEFT-WIDTH specifies the number of pixels to reserve for
the left fringe. Optional third arg RIGHT-WIDTH specifies the right
fringe width. If a fringe width arg is nil, that means to use the
display marginal areas and the text area. */)
(Lisp_Object window, Lisp_Object left_width, Lisp_Object right_width, Lisp_Object outside_margins)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
+ int outside = !NILP (outside_margins);
if (!NILP (left_width))
CHECK_NATNUM (left_width);
if (FRAME_WINDOW_P (WINDOW_XFRAME (w))
&& (!EQ (w->left_fringe_width, left_width)
|| !EQ (w->right_fringe_width, right_width)
- || !EQ (w->fringes_outside_margins, outside_margins)))
+ || w->fringes_outside_margins != outside))
{
- w->left_fringe_width = left_width;
- w->right_fringe_width = right_width;
- w->fringes_outside_margins = outside_margins;
+ wset_left_fringe_width (w, left_width);
+ wset_right_fringe_width (w, right_width);
+ w->fringes_outside_margins = outside;
adjust_window_margins (w);
clear_glyph_matrix (w->current_matrix);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
++windows_or_buffers_changed;
adjust_glyphs (XFRAME (WINDOW_FRAME (w)));
DEFUN ("window-fringes", Fwindow_fringes, Swindow_fringes,
0, 1, 0,
doc: /* Get width of fringes of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Value is a list of the form (LEFT-WIDTH RIGHT-WIDTH OUTSIDE-MARGINS). */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
return Fcons (make_number (WINDOW_LEFT_FRINGE_WIDTH (w)),
Fcons (make_number (WINDOW_RIGHT_FRINGE_WIDTH (w)),
DEFUN ("set-window-scroll-bars", Fset_window_scroll_bars,
Sset_window_scroll_bars, 2, 4, 0,
doc: /* Set width and type of scroll bars of window WINDOW.
-If window is nil, set scroll bars of the currently selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Second parameter WIDTH specifies the pixel width for the scroll bar;
this is automatically adjusted to a multiple of the frame column width.
Third parameter VERTICAL-TYPE specifies the type of the vertical scroll
Fourth parameter HORIZONTAL-TYPE is currently unused. */)
(Lisp_Object window, Lisp_Object width, Lisp_Object vertical_type, Lisp_Object horizontal_type)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
if (!NILP (width))
{
- CHECK_NATNUM (width);
+ CHECK_RANGED_INTEGER (width, 0, INT_MAX);
if (XINT (width) == 0)
vertical_type = Qnil;
if (!EQ (w->scroll_bar_width, width)
|| !EQ (w->vertical_scroll_bar_type, vertical_type))
{
- w->scroll_bar_width = width;
- w->vertical_scroll_bar_type = vertical_type;
+ wset_scroll_bar_width (w, width);
+ wset_vertical_scroll_bar_type (w, vertical_type);
adjust_window_margins (w);
clear_glyph_matrix (w->current_matrix);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
++windows_or_buffers_changed;
adjust_glyphs (XFRAME (WINDOW_FRAME (w)));
DEFUN ("window-scroll-bars", Fwindow_scroll_bars, Swindow_scroll_bars,
0, 1, 0,
doc: /* Get width and type of scroll bars of window WINDOW.
-If WINDOW is omitted or nil, it defaults to the selected window.
+WINDOW must be a live window and defaults to the selected one.
+
Value is a list of the form (WIDTH COLS VERTICAL-TYPE HORIZONTAL-TYPE).
If WIDTH is nil or TYPE is t, the window is using the frame's corresponding
value. */)
(Lisp_Object window)
{
- struct window *w = decode_window (window);
+ struct window *w = decode_live_window (window);
return Fcons (make_number ((WINDOW_CONFIG_SCROLL_BAR_WIDTH (w)
? WINDOW_CONFIG_SCROLL_BAR_WIDTH (w)
: WINDOW_SCROLL_BAR_AREA_WIDTH (w))),
/* Return 1 if window configurations CONFIGURATION1 and CONFIGURATION2
describe the same state of affairs. This is used by Fequal.
- ignore_positions non-zero means ignore non-matching scroll positions
+ IGNORE_POSITIONS means ignore non-matching scroll positions
and the like.
This ignores a couple of things like the dedication status of
window, combination_limit and the like. This might have to be
fixed. */
-int
-compare_window_configurations (Lisp_Object configuration1, Lisp_Object configuration2, int ignore_positions)
+bool
+compare_window_configurations (Lisp_Object configuration1,
+ Lisp_Object configuration2,
+ bool ignore_positions)
{
register struct save_window_data *d1, *d2;
struct Lisp_Vector *sws1, *sws2;
DEFSYM (Qwindowp, "windowp");
DEFSYM (Qwindow_configuration_p, "window-configuration-p");
DEFSYM (Qwindow_live_p, "window-live-p");
+ DEFSYM (Qwindow_valid_p, "window-valid-p");
DEFSYM (Qwindow_deletable_p, "window-deletable-p");
DEFSYM (Qdelete_window, "delete-window");
DEFSYM (Qwindow_resize_root_window, "window--resize-root-window");
DEFSYM (Qreplace_buffer_in_windows, "replace-buffer-in-windows");
DEFSYM (Qrecord_window_buffer, "record-window-buffer");
DEFSYM (Qget_mru_window, "get-mru-window");
+ DEFSYM (Qtemp_buffer_resize, "temp-buffer-resize");
DEFSYM (Qtemp_buffer_show_hook, "temp-buffer-show-hook");
DEFSYM (Qabove, "above");
DEFSYM (Qbelow, "below");
- DEFSYM (Qauto_buffer_name, "auto-buffer-name");
DEFSYM (Qclone_of, "clone-of");
staticpro (&Vwindow_list);
Vwindow_combination_resize = Qnil;
DEFVAR_LISP ("window-combination-limit", Vwindow_combination_limit,
- doc: /* If t, splitting a window makes a new parent window.
-If this variable is nil, splitting a window will create a new parent
-window only if the window has no parent window or the window shall
-become a combination orthogonal to the one it is part of.
+ doc: /* If non-nil, splitting a window makes a new parent window.
+The following values are recognized:
-If this variable is t, splitting a window always creates a new parent
-window. If all splits behave this way, each frame's window tree is a
-binary tree and every window but the frame's root window has exactly one
-sibling.
+nil means splitting a window will create a new parent window only if the
+ window has no parent window or the window shall become a combination
+ orthogonal to the one it is part of.
-Other values are reserved for future use.
+`temp-buffer-resize' means that splitting a window for displaying a
+ temporary buffer makes a new parent window provided
+ `temp-buffer-resize-mode' is enabled. Otherwise, this value is
+ handled like nil.
+
+`temp-buffer' means that splitting a window for displaying a temporary
+ buffer always makes a new parent window. Otherwise, this value is
+ handled like nil.
+
+
+`display-buffer' means that splitting a window for displaying a buffer
+ always makes a new parent window. Since temporary buffers are
+ displayed by the function `display-buffer', this value is stronger
+ than `temp-buffer'. Splitting a window for other purpose makes a
+ new parent window only if needed.
+
+t means that splitting a window always creates a new parent window. If
+ all splits behave this way, each frame's window tree is a binary
+ tree and every window but the frame's root window has exactly one
+ sibling.
-The value of this variable is also assigned to the combination limit of
-the new parent window. The combination limit of a window can be
-retrieved via the function `window-combination-limit' and altered by the
-function `set-window-combination-limit'. */);
- Vwindow_combination_limit = Qnil;
+Other values are reserved for future use. */);
+ Vwindow_combination_limit = Qtemp_buffer_resize;
DEFVAR_LISP ("window-persistent-parameters", Vwindow_persistent_parameters,
doc: /* Alist of persistent window parameters.
defsubr (&Sminibuffer_window);
defsubr (&Swindow_minibuffer_p);
defsubr (&Swindowp);
+ defsubr (&Swindow_valid_p);
defsubr (&Swindow_live_p);
defsubr (&Swindow_frame);
defsubr (&Sframe_root_window);
#include "dispextern.h"
-extern Lisp_Object Qleft, Qright;
+INLINE_HEADER_BEGIN
+#ifndef WINDOW_INLINE
+# define WINDOW_INLINE INLINE
+#endif
/* Windows are allocated as if they were vectors, but then the
Lisp data type is changed to Lisp_Window. They are garbage
/* The frame this window is on. */
Lisp_Object frame;
- /* t if this window is a minibuffer window. */
- Lisp_Object mini_p;
-
/* Following (to right or down) and preceding (to left or up) child
at same level of tree. */
- Lisp_Object next, 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 hchild, vchild;
+ Lisp_Object hchild;
+ Lisp_Object vchild;
/* The window this one is a child of. */
Lisp_Object parent;
each one can have its own value of point. */
Lisp_Object pointm;
- /* Non-nil means next redisplay must use the value of start
- set up for it in advance. Set by scrolling commands. */
- Lisp_Object force_start;
- /* Non-nil means we have explicitly changed the value of start,
- but that the next redisplay is not obliged to use the new value.
- This is used in Fdelete_other_windows to force a call to
- Vwindow_scroll_functions; also by Frecenter with argument. */
- Lisp_Object optional_new_start;
-
- /* Number of columns display within the window is scrolled to the left. */
- Lisp_Object hscroll;
- /* Minimum hscroll for automatic hscrolling. This is the value
- the user has set, by set-window-hscroll for example. */
- Lisp_Object min_hscroll;
-
- /* Number saying how recently window was selected. */
- Lisp_Object use_time;
-
- /* Unique number of window assigned when it was created. */
- Lisp_Object sequence_number;
-
/* No permanent meaning; used by save-window-excursion's
bookkeeping. */
Lisp_Object temslot;
- /* text.modified of displayed buffer as of last time display
- completed. */
- Lisp_Object last_modified;
- /* BUF_OVERLAY_MODIFIED of displayed buffer as of last complete update. */
- Lisp_Object last_overlay_modified;
- /* Value of point at that time. */
- Lisp_Object last_point;
- /* Non-nil if the buffer was "modified" when the window
- was last updated. */
- Lisp_Object last_had_star;
-
/* 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
/* Width of left and right marginal areas. A value of nil means
no margin. */
- Lisp_Object left_margin_cols, 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 left_fringe_width, right_fringe_width;
- /* Non-nil means fringes are drawn outside display margins;
- othersize draw them between margin areas and text. */
- Lisp_Object fringes_outside_margins;
+ 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. */
no scroll bar. A value of t means use frame value. */
Lisp_Object vertical_scroll_bar_type;
- /* Frame coords of mark as of last time display completed */
- /* May be nil if mark does not exist or was not on frame */
- Lisp_Object last_mark_x;
- Lisp_Object last_mark_y;
-
/* 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 window_end_pos;
did not get onto the frame. */
Lisp_Object window_end_valid;
- /* Non-nil means must regenerate mode line of this window */
- Lisp_Object update_mode_line;
-
- /* Non-nil means current value of `start'
- was the beginning of a line when it was chosen. */
- Lisp_Object start_at_line_beg;
-
/* Display-table to use for displaying chars in this window.
Nil means use the buffer's own display-table. */
Lisp_Object display_table;
- /* Non-nil means window is marked as dedicated. */
+ /* 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 dedicated;
/* Line number and position of a line somewhere above the top of the
/* t means this window's child windows are not (re-)combined. */
Lisp_Object combination_limit;
- /* Alist of <buffer, window-start, window-point> triples listing
- buffers previously shown in this window. */
- Lisp_Object prev_buffers;
-
- /* List of buffers re-shown in this window. */
- Lisp_Object next_buffers;
-
/* An alist with parameters. */
Lisp_Object window_parameters;
struct glyph_matrix *current_matrix;
struct glyph_matrix *desired_matrix;
+ /* The two Lisp_Object fields below are marked in a special way,
+ which is why they're placed after `current_matrix'. */
+ /* Alist of <buffer, window-start, window-point> triples listing
+ buffers previously shown in this window. */
+ Lisp_Object prev_buffers;
+ /* List of buffers re-shown in this window. */
+ Lisp_Object next_buffers;
+
+ /* Number saying how recently window was selected. */
+ int use_time;
+
+ /* Unique number of window assigned when it was created. */
+ int sequence_number;
+
+ /* Number of columns display within the window is scrolled to the left. */
+ ptrdiff_t hscroll;
+
+ /* Minimum hscroll for automatic hscrolling. This is the value
+ the user has set, by set-window-hscroll for example. */
+ ptrdiff_t min_hscroll;
+
+ /* Displayed buffer's text modification events counter as of last time
+ display completed. */
+ EMACS_INT last_modified;
+
+ /* Displayed buffer's overlays modification events counter as of last
+ complete update. */
+ EMACS_INT last_overlay_modified;
+
+ /* Value of point at that time. Since this is a position in a buffer,
+ it should be positive. */
+ ptrdiff_t last_point;
+
/* Scaling factor for the glyph_matrix size calculation in this window.
Used if window contains many small images or uses proportional fonts,
as the normal may yield a matrix which is too small. */
/* This is handy for undrawing the cursor. */
int phys_cursor_ascent, phys_cursor_height;
+ /* Non-zero if this window is a minibuffer window. */
+ unsigned mini : 1;
+
+ /* Non-zero means must regenerate mode line of this window */
+ unsigned update_mode_line : 1;
+
+ /* Non-nil if the buffer was "modified" when the window
+ was last updated. */
+ unsigned last_had_star : 1;
+
+ /* Non-zero means current value of `start'
+ was the beginning of a line when it was chosen. */
+ unsigned start_at_line_beg : 1;
+
+ /* Non-zero means next redisplay must use the value of start
+ set up for it in advance. Set by scrolling commands. */
+ unsigned force_start : 1;
+
+ /* Non-zero means we have explicitly changed the value of start,
+ but that the next redisplay is not obliged to use the new value.
+ This is used in Fdelete_other_windows to force a call to
+ Vwindow_scroll_functions; also by Frecenter with argument. */
+ unsigned optional_new_start : 1;
+
/* Non-zero means the cursor is currently displayed. This can be
set to zero by functions overpainting the cursor image. */
unsigned phys_cursor_on_p : 1;
accept that. */
unsigned frozen_window_start_p : 1;
+ /* Non-zero means fringes are drawn outside display margins.
+ Otherwise draw them between margin areas and text. */
+ unsigned fringes_outside_margins : 1;
+
/* Amount by which lines of this window are scrolled in
y-direction (smooth scrolling). */
int vscroll;
- /* Z_BYTE - the buffer position of the last glyph in the current matrix
- of W. Only valid if WINDOW_END_VALID is not nil. */
- int window_end_bytepos;
+ /* Z_BYTE - the buffer position of the last glyph in the current matrix of W.
+ Should be nonnegative, and only valid if window_end_valid is not nil. */
+ ptrdiff_t window_end_bytepos;
};
+/* Most code should use these functions to set Lisp fields in struct
+ window. */
+WINDOW_INLINE void
+wset_buffer (struct window *w, Lisp_Object val)
+{
+ w->buffer = val;
+}
+WINDOW_INLINE void
+wset_frame (struct window *w, Lisp_Object val)
+{
+ w->frame = val;
+}
+WINDOW_INLINE void
+wset_left_col (struct window *w, Lisp_Object val)
+{
+ w->left_col = val;
+}
+WINDOW_INLINE void
+wset_next (struct window *w, Lisp_Object val)
+{
+ w->next = val;
+}
+WINDOW_INLINE void
+wset_prev (struct window *w, Lisp_Object val)
+{
+ w->prev = val;
+}
+WINDOW_INLINE void
+wset_redisplay_end_trigger (struct window *w, Lisp_Object val)
+{
+ w->redisplay_end_trigger = val;
+}
+WINDOW_INLINE void
+wset_top_line (struct window *w, Lisp_Object val)
+{
+ w->top_line = val;
+}
+WINDOW_INLINE void
+wset_total_cols (struct window *w, Lisp_Object val)
+{
+ w->total_cols = val;
+}
+WINDOW_INLINE void
+wset_total_lines (struct window *w, Lisp_Object val)
+{
+ w->total_lines = val;
+}
+WINDOW_INLINE void
+wset_vertical_scroll_bar (struct window *w, Lisp_Object val)
+{
+ w->vertical_scroll_bar = val;
+}
+WINDOW_INLINE void
+wset_window_end_pos (struct window *w, Lisp_Object val)
+{
+ w->window_end_pos = val;
+}
+WINDOW_INLINE void
+wset_window_end_valid (struct window *w, Lisp_Object val)
+{
+ w->window_end_valid = val;
+}
+WINDOW_INLINE void
+wset_window_end_vpos (struct window *w, Lisp_Object val)
+{
+ w->window_end_vpos = val;
+}
+WINDOW_INLINE void
+wset_prev_buffers (struct window *w, Lisp_Object val)
+{
+ w->prev_buffers = val;
+}
+WINDOW_INLINE void
+wset_next_buffers (struct window *w, Lisp_Object val)
+{
+ w->next_buffers = val;
+}
+
/* 1 if W is a minibuffer window. */
-#define MINI_WINDOW_P(W) (!NILP ((W)->mini_p))
+#define MINI_WINDOW_P(W) ((W)->mini)
/* General window layout:
This includes scroll bars and fringes. */
#define WINDOW_TOTAL_COLS(W) \
- (XFASTINT ((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 ((W)->total_lines))
+ (XFASTINT (W->total_lines))
/* Return the total pixel width of window W. */
This includes a left-hand scroll bar, if any. */
#define WINDOW_LEFT_EDGE_COL(W) \
- (XFASTINT ((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. */
This includes a header line, if any. */
#define WINDOW_TOP_EDGE_LINE(W) \
- (XFASTINT ((W)->top_line))
+ (XFASTINT (W->top_line))
/* Return the canonical frame line before which window W ends.
This includes a mode line, if any. */
/* Width of left margin area in columns. */
-#define WINDOW_LEFT_MARGIN_COLS(W) \
- (NILP ((W)->left_margin_cols) \
- ? 0 \
- : XINT ((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 ((W)->right_margin_cols) \
- ? 0 \
- : XINT ((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 ((W)->left_margin_cols) \
- ? 0 \
- : (XINT ((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 ((W)->right_margin_cols) \
- ? 0 \
- : (XINT ((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,
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 ((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)) \
+#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 ((W)->left_fringe_width) \
- ? XFASTINT ((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 ((W)->right_fringe_width) \
- ? XFASTINT ((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. */
/* Are fringes outside display margins in window W. */
#define WINDOW_HAS_FRINGES_OUTSIDE_MARGINS(W) \
- (!NILP ((W)->fringes_outside_margins))
+ ((W)->fringes_outside_margins)
/* Say whether scroll bars are currently enabled for window W,
and which side they are on. */
#define WINDOW_VERTICAL_SCROLL_BAR_TYPE(w) \
- (EQ ((w)->vertical_scroll_bar_type, Qt) \
+ (EQ (w->vertical_scroll_bar_type, Qt) \
? FRAME_VERTICAL_SCROLL_BAR_TYPE (WINDOW_XFRAME (w)) \
- : EQ ((w)->vertical_scroll_bar_type, Qleft) \
+ : EQ (w->vertical_scroll_bar_type, Qleft) \
? vertical_scroll_bar_left \
- : EQ ((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 ((w)->vertical_scroll_bar_type, Qt) \
+ (EQ (w->vertical_scroll_bar_type, Qt) \
? FRAME_HAS_VERTICAL_SCROLL_BARS (WINDOW_XFRAME (w)) \
- : !NILP ((w)->vertical_scroll_bar_type))
+ : !NILP (w->vertical_scroll_bar_type))
#define WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT(w) \
- (EQ ((w)->vertical_scroll_bar_type, Qt) \
+ (EQ (w->vertical_scroll_bar_type, Qt) \
? FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (WINDOW_XFRAME (w)) \
- : EQ ((w)->vertical_scroll_bar_type, Qleft))
+ : EQ (w->vertical_scroll_bar_type, Qleft))
-#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))
+#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 ((w)->scroll_bar_width) \
- ? XFASTINT ((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.
this is still nonzero. */
#define WINDOW_CONFIG_SCROLL_BAR_COLS(w) \
- (INTEGERP ((w)->scroll_bar_width) \
- ? ((XFASTINT ((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)))
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)
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)
/* 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)
? 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.
? 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. */
/* 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
extern Lisp_Object Vmouse_event;
-EXFUN (Fnext_window, 3);
-EXFUN (Fselect_window, 2);
-EXFUN (Fset_window_buffer, 3);
-EXFUN (Fset_window_point, 2);
extern Lisp_Object make_window (void);
extern Lisp_Object window_from_coordinates (struct frame *, int, int,
enum window_part *, int);
-EXFUN (Fwindow_dedicated_p, 1);
extern void resize_frame_windows (struct frame *, int, int);
extern void delete_all_child_windows (Lisp_Object);
extern void freeze_window_starts (struct frame *, int);
extern int update_mode_lines;
-/* Nonzero if BEGV - BEG or Z - ZV of current buffer has changed since
- last redisplay that finished. */
-
-extern int clip_changed;
-
/* Nonzero if window sizes or contents have changed since last
redisplay that finished */
struct glyph *get_phys_cursor_glyph (struct window *w);
-/* Value is non-zero if WINDOW is a live window. */
+/* Value is non-zero if WINDOW is a valid window. */
+#define WINDOW_VALID_P(WINDOW) \
+ (WINDOWP (WINDOW) \
+ && (!NILP (XWINDOW (WINDOW)->buffer) \
+ || !NILP (XWINDOW (WINDOW)->vchild) \
+ || !NILP (XWINDOW (WINDOW)->hchild)))
-#define WINDOW_LIVE_P(WINDOW) \
- (WINDOWP ((WINDOW)) && !NILP (XWINDOW ((WINDOW))->buffer))
+/* Value is non-zero if WINDOW is a live window. */
+#define WINDOW_LIVE_P(WINDOW) \
+ (WINDOWP (WINDOW) && !NILP (XWINDOW (WINDOW)->buffer))
/* These used to be in lisp.h. */
extern Lisp_Object Qwindowp, Qwindow_live_p;
extern Lisp_Object Vwindow_list;
-EXFUN (Fwindow_buffer, 1);
-EXFUN (Fget_buffer_window, 2);
-EXFUN (Fwindow_minibuffer_p, 1);
-EXFUN (Fselected_window, 0);
-EXFUN (Fframe_root_window, 1);
-EXFUN (Fframe_first_window, 1);
-EXFUN (Fset_frame_selected_window, 3);
-EXFUN (Fset_window_configuration, 1);
-EXFUN (Fcurrent_window_configuration, 1);
-extern int compare_window_configurations (Lisp_Object, Lisp_Object, int);
-EXFUN (Fpos_visible_in_window_p, 3);
+extern struct window *decode_live_window (Lisp_Object);
+extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
extern void mark_window_cursors_off (struct window *);
extern int window_internal_height (struct window *);
extern int window_body_cols (struct window *w);
-EXFUN (Frecenter, 1);
extern void temp_output_buffer_show (Lisp_Object);
extern void replace_buffer_in_windows (Lisp_Object);
extern void replace_buffer_in_windows_safely (Lisp_Object);
extern void syms_of_window (void);
extern void keys_of_window (void);
+INLINE_HEADER_END
+
#endif /* not WINDOW_H_INCLUDED */
/* Display generation from window structure and buffer text.
-Copyright (C) 1985-1988, 1993-1995, 1997-2012 Free Software Foundation, Inc.
+Copyright (C) 1985-1988, 1993-1995, 1997-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include <stdio.h>
#include <limits.h>
-#include <setjmp.h>
#include "lisp.h"
+#include "atimer.h"
#include "keyboard.h"
#include "frame.h"
#include "window.h"
#include "termchar.h"
#include "dispextern.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "indent.h"
#include "commands.h"
static Lisp_Object Qbuffer_position, Qposition, Qobject;
static Lisp_Object Qright_to_left, Qleft_to_right;
-/* Cursor shapes */
+/* Cursor shapes. */
Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
-/* Pointer shapes */
+/* Pointer shapes. */
static Lisp_Object Qarrow, Qhand;
Lisp_Object Qtext;
static Lisp_Object Qwrap_prefix;
static Lisp_Object Qline_prefix;
+static Lisp_Object Qredisplay_internal;
/* Non-nil means don't actually do any redisplay. */
static Lisp_Object Qmargin, Qpointer;
static Lisp_Object Qline_height;
+/* These setters are used only in this file, so they can be private. */
+static inline void
+wset_base_line_number (struct window *w, Lisp_Object val)
+{
+ w->base_line_number = val;
+}
+static inline void
+wset_base_line_pos (struct window *w, Lisp_Object val)
+{
+ w->base_line_pos = val;
+}
+static inline void
+wset_column_number_displayed (struct window *w, Lisp_Object val)
+{
+ w->column_number_displayed = val;
+}
+static inline void
+wset_region_showing (struct window *w, Lisp_Object val)
+{
+ w->region_showing = val;
+}
+
#ifdef HAVE_WINDOW_SYSTEM
/* Test if overflow newline into fringe. Called with iterator IT
#define IT_OVERFLOW_NEWLINE_INTO_FRINGE(it) 0
#endif /* HAVE_WINDOW_SYSTEM */
-/* Test if the display element loaded in IT is a space or tab
- character. This is used to determine word wrapping. */
-
-#define IT_DISPLAYING_WHITESPACE(it) \
- (it->what == IT_CHARACTER && (it->c == ' ' || it->c == '\t'))
+/* Test if the display element loaded in IT, or the underlying buffer
+ or string character, is a space or a TAB character. This is used
+ to determine where word wrapping can occur. */
+
+#define IT_DISPLAYING_WHITESPACE(it) \
+ ((it->what == IT_CHARACTER && (it->c == ' ' || it->c == '\t')) \
+ || ((STRINGP (it->string) \
+ && (SREF (it->string, IT_STRING_BYTEPOS (*it)) == ' ' \
+ || SREF (it->string, IT_STRING_BYTEPOS (*it)) == '\t')) \
+ || (it->s \
+ && (it->s[IT_BYTEPOS (*it)] == ' ' \
+ || it->s[IT_BYTEPOS (*it)] == '\t')) \
+ || (IT_BYTEPOS (*it) < ZV_BYTE \
+ && (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \
+ || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) \
/* Name of the face used to highlight trailing whitespace. */
CACHE = NULL; \
} while (0)
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Non-zero means print traces of redisplay if compiled with
- GLYPH_DEBUG != 0. */
+ GLYPH_DEBUG defined. */
int trace_redisplay_p;
static struct glyph_slice null_glyph_slice = { 0, 0, 0, 0 };
#endif
-/* Non-zero while redisplay_internal is in progress. */
+/* True while redisplay_internal is in progress. */
-int redisplaying_p;
+bool redisplaying_p;
static Lisp_Object Qinhibit_free_realized_faces;
+static Lisp_Object Qmode_line_default_help_echo;
/* If a string, XTread_socket generates an event to display that string.
(The display is done in read_char.) */
Lisp_Object help_echo_string;
Lisp_Object help_echo_window;
Lisp_Object help_echo_object;
-EMACS_INT help_echo_pos;
+ptrdiff_t help_echo_pos;
/* Temporary variable for XTread_socket. */
static void handle_line_prefix (struct it *);
-static void pint2str (char *, int, EMACS_INT);
-static void pint2hrstr (char *, int, EMACS_INT);
+static void pint2str (char *, int, ptrdiff_t);
+static void pint2hrstr (char *, int, ptrdiff_t);
static struct text_pos run_window_scroll_functions (Lisp_Object,
struct text_pos);
static void reconsider_clip_changes (struct window *, struct buffer *);
static int text_outside_line_unchanged_p (struct window *,
- EMACS_INT, EMACS_INT);
+ ptrdiff_t, ptrdiff_t);
static void store_mode_line_noprop_char (char);
static int store_mode_line_noprop (const char *, int, int);
static void handle_stop (struct it *);
-static void handle_stop_backwards (struct it *, EMACS_INT);
+static void handle_stop_backwards (struct it *, ptrdiff_t);
static void vmessage (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
static void ensure_echo_area_buffers (void);
static Lisp_Object unwind_with_echo_area_buffer (Lisp_Object);
static Lisp_Object with_echo_area_buffer_unwind_data (struct window *);
static int with_echo_area_buffer (struct window *, int,
- int (*) (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT),
- EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
+ int (*) (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t),
+ ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
static void clear_garbaged_frames (void);
-static int current_message_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
+static int current_message_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
static void pop_message (void);
-static int truncate_message_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
-static void set_message (const char *, Lisp_Object, EMACS_INT, int);
-static int set_message_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
+static int truncate_message_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
+static void set_message (const char *, Lisp_Object, ptrdiff_t, int);
+static int set_message_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
static int display_echo_area (struct window *);
-static int display_echo_area_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
-static int resize_mini_window_1 (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT);
+static int display_echo_area_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
+static int resize_mini_window_1 (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t);
static Lisp_Object unwind_redisplay (Lisp_Object);
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);
static void extend_face_to_end_of_line (struct it *);
static int append_space_for_newline (struct it *, int);
static int cursor_row_fully_visible_p (struct window *, int, int);
-static int try_scrolling (Lisp_Object, int, EMACS_INT, EMACS_INT, int, int);
+static int try_scrolling (Lisp_Object, int, ptrdiff_t, ptrdiff_t, int, int);
static int try_cursor_movement (Lisp_Object, struct text_pos, int *);
-static int trailing_whitespace_p (EMACS_INT);
-static intmax_t message_log_check_duplicate (EMACS_INT, EMACS_INT);
+static int trailing_whitespace_p (ptrdiff_t);
+static intmax_t message_log_check_duplicate (ptrdiff_t, ptrdiff_t);
static void push_it (struct it *, struct text_pos *);
static void iterate_out_of_display_property (struct it *);
static void pop_it (struct it *);
static Lisp_Object redisplay_window_0 (Lisp_Object);
static Lisp_Object redisplay_window_1 (Lisp_Object);
static int set_cursor_from_row (struct window *, struct glyph_row *,
- struct glyph_matrix *, EMACS_INT, EMACS_INT,
+ struct glyph_matrix *, ptrdiff_t, ptrdiff_t,
int, int);
static int update_menu_bar (struct frame *, int, int);
static int try_window_reusing_current_matrix (struct window *);
static int store_mode_line_string (const char *, Lisp_Object, int, int, int, Lisp_Object);
static const char *decode_mode_spec (struct window *, int, int, Lisp_Object *);
static void display_menu_bar (struct window *);
-static EMACS_INT display_count_lines (EMACS_INT, EMACS_INT, EMACS_INT,
- EMACS_INT *);
+static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t *);
static int display_string (const char *, Lisp_Object, Lisp_Object,
- EMACS_INT, EMACS_INT, struct it *, int, int, int, int);
+ ptrdiff_t, ptrdiff_t, struct it *, int, int, int, int);
static void compute_line_metrics (struct it *);
static void run_redisplay_end_trigger_hook (struct it *);
-static int get_overlay_strings (struct it *, EMACS_INT);
-static int get_overlay_strings_1 (struct it *, EMACS_INT, int);
+static int get_overlay_strings (struct it *, ptrdiff_t);
+static int get_overlay_strings_1 (struct it *, ptrdiff_t, int);
static void next_overlay_string (struct it *);
static void reseat (struct it *, struct text_pos, int);
static void reseat_1 (struct it *, struct text_pos, int);
static int next_element_from_composition (struct it *);
static int next_element_from_image (struct it *);
static int next_element_from_stretch (struct it *);
-static void load_overlay_strings (struct it *, EMACS_INT);
+static void load_overlay_strings (struct it *, ptrdiff_t);
static int init_from_display_pos (struct it *, struct window *,
struct display_pos *);
static void reseat_to_string (struct it *, const char *,
- Lisp_Object, EMACS_INT, EMACS_INT, int, int);
+ Lisp_Object, ptrdiff_t, ptrdiff_t, int, int);
static int get_next_display_element (struct it *);
static enum move_it_result
- move_it_in_display_line_to (struct it *, EMACS_INT, int,
+ move_it_in_display_line_to (struct it *, ptrdiff_t, int,
enum move_operation_enum);
void move_it_vertically_backward (struct it *, int);
static void init_to_row_start (struct it *, struct window *,
static void back_to_previous_line_start (struct it *);
static int forward_to_next_line_start (struct it *, int *, struct bidi_it *);
static struct text_pos string_pos_nchars_ahead (struct text_pos,
- Lisp_Object, EMACS_INT);
-static struct text_pos string_pos (EMACS_INT, Lisp_Object);
-static struct text_pos c_string_pos (EMACS_INT, const char *, int);
-static EMACS_INT number_of_chars (const char *, int);
+ Lisp_Object, ptrdiff_t);
+static struct text_pos string_pos (ptrdiff_t, Lisp_Object);
+static struct text_pos c_string_pos (ptrdiff_t, const char *, int);
+static ptrdiff_t number_of_chars (const char *, int);
static void compute_stop_pos (struct it *);
static void compute_string_pos (struct text_pos *, struct text_pos,
Lisp_Object);
static int face_before_or_after_it_pos (struct it *, int);
-static EMACS_INT next_overlay_change (EMACS_INT);
+static ptrdiff_t next_overlay_change (ptrdiff_t);
static int handle_display_spec (struct it *, Lisp_Object, Lisp_Object,
- Lisp_Object, struct text_pos *, EMACS_INT, int);
+ Lisp_Object, struct text_pos *, ptrdiff_t, int);
static int handle_single_display_spec (struct it *, Lisp_Object,
Lisp_Object, Lisp_Object,
- struct text_pos *, EMACS_INT, int, int);
+ struct text_pos *, ptrdiff_t, int, int);
static int underlying_face_id (struct it *);
static int in_ellipses_for_invisible_text_p (struct display_pos *,
struct window *);
#endif /* HAVE_WINDOW_SYSTEM */
+static void produce_special_glyphs (struct it *, enum display_element_type);
static void show_mouse_face (Mouse_HLInfo *, enum draw_glyphs_face);
static int coords_in_mouse_face_p (struct window *, int, int);
struct frame *f = XFRAME (w->frame);
int height = WINDOW_TOTAL_HEIGHT (w);
- xassert (height >= 0);
+ eassert (height >= 0);
/* Note: the code below that determines the mode-line/header-line
height is essentially the same as that contained in the macro
return spec;
}
+
+/* Limit insanely large values of W->hscroll on frame F to the largest
+ value that will still prevent first_visible_x and last_visible_x of
+ 'struct it' from overflowing an int. */
+static inline int
+window_hscroll_limited (struct window *w, struct frame *f)
+{
+ ptrdiff_t window_hscroll = w->hscroll;
+ int window_text_width = window_box_width (w, TEXT_AREA);
+ int colwidth = FRAME_COLUMN_WIDTH (f);
+
+ if (window_hscroll > (INT_MAX - window_text_width) / colwidth - 1)
+ window_hscroll = (INT_MAX - window_text_width) / colwidth - 1;
+
+ return window_hscroll;
+}
+
/* Return 1 if position CHARPOS is visible in window W.
CHARPOS < 0 means return info about WINDOW_END position.
If visible, set *X and *Y to pixel coordinates of top left corner.
Set *ROWH and *VPOS to row's visible height and VPOS (row number). */
int
-pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y,
+pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
int *rtop, int *rbot, int *rowh, int *vpos)
{
struct it it;
if (WINDOW_WANTS_HEADER_LINE_P (w))
current_header_line_height
= display_mode_line (w, HEADER_LINE_FACE_ID,
- BVAR (current_buffer, header_line_format));
+ BVAR (current_buffer, header_line_format));
start_display (&it, w, top);
move_it_to (&it, charpos, -1, it.last_visible_y-1, -1,
--g;
top_x -= g->pixel_width;
}
- xassert (g < it3.glyph_row->glyphs[TEXT_AREA]
+ eassert (g < it3.glyph_row->glyphs[TEXT_AREA]
+ it3.glyph_row->used[TEXT_AREA]);
}
}
current_header_line_height = current_mode_line_height = -1;
- if (visible_p && XFASTINT (w->hscroll) > 0)
- *x -= XFASTINT (w->hscroll) * WINDOW_FRAME_COLUMN_WIDTH (w);
+ if (visible_p && w->hscroll > 0)
+ *x -=
+ window_hscroll_limited (w, WINDOW_XFRAME (w))
+ * WINDOW_FRAME_COLUMN_WIDTH (w);
#if 0
/* Debugging code. */
in STRING, return the position NCHARS ahead (NCHARS >= 0). */
static struct text_pos
-string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, EMACS_INT nchars)
+string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, ptrdiff_t nchars)
{
- xassert (STRINGP (string) && nchars >= 0);
+ eassert (STRINGP (string) && nchars >= 0);
if (STRING_MULTIBYTE (string))
{
for character position CHARPOS in STRING. */
static inline struct text_pos
-string_pos (EMACS_INT charpos, Lisp_Object string)
+string_pos (ptrdiff_t charpos, Lisp_Object string)
{
struct text_pos pos;
- xassert (STRINGP (string));
- xassert (charpos >= 0);
+ eassert (STRINGP (string));
+ eassert (charpos >= 0);
SET_TEXT_POS (pos, charpos, string_char_to_byte (string, charpos));
return pos;
}
means recognize multibyte characters. */
static struct text_pos
-c_string_pos (EMACS_INT charpos, const char *s, int multibyte_p)
+c_string_pos (ptrdiff_t charpos, const char *s, int multibyte_p)
{
struct text_pos pos;
- xassert (s != NULL);
- xassert (charpos >= 0);
+ eassert (s != NULL);
+ eassert (charpos >= 0);
if (multibyte_p)
{
/* Value is the number of characters in C string S. MULTIBYTE_P
non-zero means recognize multibyte characters. */
-static EMACS_INT
+static ptrdiff_t
number_of_chars (const char *s, int multibyte_p)
{
- EMACS_INT nchars;
+ ptrdiff_t nchars;
if (multibyte_p)
{
- EMACS_INT rest = strlen (s);
+ ptrdiff_t rest = strlen (s);
int len;
const unsigned char *p = (const unsigned char *) s;
static void
compute_string_pos (struct text_pos *newpos, struct text_pos pos, Lisp_Object string)
{
- xassert (STRINGP (string));
- xassert (CHARPOS (*newpos) >= CHARPOS (pos));
+ eassert (STRINGP (string));
+ eassert (CHARPOS (*newpos) >= CHARPOS (pos));
if (STRING_MULTIBYTE (string))
*newpos = string_pos_nchars_ahead (pos, string,
/* 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 signaled %S",
+ Flist (nargs, args), arg);
return Qnil;
}
-
-/* Evaluate SEXPR and return the result, or nil if something went
+/* Call function FUNC with the rest of NARGS - 1 arguments
+ following. Return the result, or nil if something went
wrong. Prevent redisplay during the evaluation. */
-/* Call function ARGS[0] with arguments ARGS[1] to ARGS[NARGS - 1].
- Return the result, or nil if something went wrong. Prevent
- redisplay during the evaluation. */
-
Lisp_Object
-safe_call (ptrdiff_t nargs, Lisp_Object *args)
+safe_call (ptrdiff_t nargs, Lisp_Object func, ...)
{
Lisp_Object val;
val = Qnil;
else
{
- int count = SPECPDL_INDEX ();
+ va_list ap;
+ ptrdiff_t i;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1;
+ Lisp_Object *args = alloca (nargs * word_size);
+
+ args[0] = func;
+ va_start (ap, func);
+ for (i = 1; i < nargs; i++)
+ args[i] = va_arg (ap, Lisp_Object);
+ va_end (ap);
GCPRO1 (args[0]);
gcpro1.nvars = nargs;
Lisp_Object
safe_call1 (Lisp_Object fn, Lisp_Object arg)
{
- Lisp_Object args[2];
- args[0] = fn;
- args[1] = arg;
- return safe_call (2, args);
+ return safe_call (2, fn, arg);
}
static Lisp_Object Qeval;
return safe_call1 (Qeval, sexpr);
}
-/* Call function FN with one argument ARG.
+/* Call function FN with two arguments ARG1 and ARG2.
Return the result, or nil if something went wrong. */
Lisp_Object
safe_call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
{
- Lisp_Object args[3];
- args[0] = fn;
- args[1] = arg1;
- args[2] = arg2;
- return safe_call (3, args);
+ return safe_call (3, fn, arg1, arg2);
}
{
if (it->method == GET_FROM_STRING)
{
- xassert (STRINGP (it->string));
- xassert (IT_STRING_CHARPOS (*it) >= 0);
+ eassert (STRINGP (it->string));
+ eassert (IT_STRING_CHARPOS (*it) >= 0);
}
else
{
- xassert (IT_STRING_CHARPOS (*it) < 0);
+ eassert (IT_STRING_CHARPOS (*it) < 0);
if (it->method == GET_FROM_BUFFER)
{
/* Check that character and byte positions agree. */
- xassert (IT_CHARPOS (*it) == BYTE_TO_CHAR (IT_BYTEPOS (*it)));
+ eassert (IT_CHARPOS (*it) == BYTE_TO_CHAR (IT_BYTEPOS (*it)));
}
}
if (it->dpvec)
- xassert (it->current.dpvec_index >= 0);
+ eassert (it->current.dpvec_index >= 0);
else
- xassert (it->current.dpvec_index < 0);
+ eassert (it->current.dpvec_index < 0);
}
#define CHECK_IT(IT) check_it ((IT))
#endif /* not 0 */
-#if GLYPH_DEBUG && XASSERTS
+#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
/* Check that the window end of window W is what we expect it
to be---the last row in the current matrix displaying text. */
&& !NILP (w->window_end_valid))
{
struct glyph_row *row;
- xassert ((row = MATRIX_ROW (w->current_matrix,
+ eassert ((row = MATRIX_ROW (w->current_matrix,
XFASTINT (w->window_end_vpos)),
!row->enabled_p
|| MATRIX_ROW_DISPLAYS_TEXT_P (row)
#define CHECK_WINDOW_END(W) (void) 0
-#endif
+#endif /* GLYPH_DEBUG and ENABLE_CHECKING */
\f
void
init_iterator (struct it *it, struct window *w,
- EMACS_INT charpos, EMACS_INT bytepos,
+ ptrdiff_t charpos, ptrdiff_t bytepos,
struct glyph_row *row, enum face_id base_face_id)
{
int highlight_region_p;
enum face_id remapped_base_face_id = base_face_id;
/* Some precondition checks. */
- xassert (w != NULL && it != NULL);
- xassert (charpos < 0 || (charpos >= BUF_BEG (current_buffer)
+ eassert (w != NULL && it != NULL);
+ eassert (charpos < 0 || (charpos >= BUF_BEG (current_buffer)
&& charpos <= ZV));
/* If face attributes have been changed since the last redisplay,
/* Perhaps remap BASE_FACE_ID to a user-specified alternative. */
if (! NILP (Vface_remapping_alist))
- remapped_base_face_id = lookup_basic_face (XFRAME (w->frame), base_face_id);
+ remapped_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. */
is invisible. >0 means lines indented more than this value are
invisible. */
it->selective = (INTEGERP (BVAR (current_buffer, selective_display))
- ? XINT (BVAR (current_buffer, selective_display))
+ ? (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
&& WINDOWP (minibuf_selected_window)
&& w == XWINDOW (minibuf_selected_window))))
{
- EMACS_INT markpos = marker_position (BVAR (current_buffer, mark));
+ ptrdiff_t markpos = marker_position (BVAR (current_buffer, mark));
it->region_beg_charpos = min (PT, markpos);
it->region_end_charpos = max (PT, markpos);
}
it->redisplay_end_trigger_charpos
= marker_position (w->redisplay_end_trigger);
else if (INTEGERP (w->redisplay_end_trigger))
- it->redisplay_end_trigger_charpos = XINT (w->redisplay_end_trigger);
+ it->redisplay_end_trigger_charpos =
+ clip_to_bounds (PTRDIFF_MIN, XINT (w->redisplay_end_trigger), PTRDIFF_MAX);
it->tab_width = SANE_TAB_WIDTH (current_buffer);
/* Are lines in the display truncated? */
if (base_face_id != DEFAULT_FACE_ID
- || XINT (it->w->hscroll)
+ || it->w->hscroll
|| (! WINDOW_FULL_WIDTH_P (it->w)
&& ((!NILP (Vtruncate_partial_width_windows)
&& !INTEGERP (Vtruncate_partial_width_windows))
it->line_wrap = TRUNCATE;
/* Get dimensions of truncation and continuation glyphs. These are
- displayed as fringe bitmaps under X, so we don't need them for such
- frames. */
- if (!FRAME_WINDOW_P (it->f))
+ displayed as fringe bitmaps under X, but we need them for such
+ frames when the fringes are turned off. But leave the dimensions
+ zero for tooltip frames, as these glyphs look ugly there and also
+ sabotage calculations of tooltip dimensions in x-show-tip. */
+#ifdef HAVE_WINDOW_SYSTEM
+ if (!(FRAME_WINDOW_P (it->f)
+ && FRAMEP (tip_frame)
+ && it->f == XFRAME (tip_frame)))
+#endif
{
if (it->line_wrap == TRUNCATE)
{
/* We will need the truncation glyph. */
- xassert (it->glyph_row == NULL);
+ eassert (it->glyph_row == NULL);
produce_special_glyphs (it, IT_TRUNCATION);
it->truncation_pixel_width = it->pixel_width;
}
else
{
/* We will need the continuation glyph. */
- xassert (it->glyph_row == NULL);
+ eassert (it->glyph_row == NULL);
produce_special_glyphs (it, IT_CONTINUATION);
it->continuation_pixel_width = it->pixel_width;
}
-
- /* Reset these values to zero because the produce_special_glyphs
- above has changed them. */
- it->pixel_width = it->ascent = it->descent = 0;
- it->phys_ascent = it->phys_descent = 0;
}
+ /* Reset these values to zero because the produce_special_glyphs
+ above has changed them. */
+ it->pixel_width = it->ascent = it->descent = 0;
+ it->phys_ascent = it->phys_descent = 0;
+
/* Set this after getting the dimensions of truncation and
continuation glyphs, so that we don't produce glyphs when calling
produce_special_glyphs, above. */
}
else
{
- it->first_visible_x
- = XFASTINT (it->w->hscroll) * FRAME_COLUMN_WIDTH (it->f);
+ it->first_visible_x =
+ window_hscroll_limited (it->w, it->f) * FRAME_COLUMN_WIDTH (it->f);
it->last_visible_x = (it->first_visible_x
+ window_box_width (w, TEXT_AREA));
- /* If we truncate lines, leave room for the truncator glyph(s) at
+ /* If we truncate lines, leave room for the truncation glyph(s) at
the right margin. Otherwise, leave room for the continuation
- glyph(s). Truncation and continuation glyphs are not inserted
- for window-based redisplay. */
- if (!FRAME_WINDOW_P (it->f))
+ glyph(s). Done only if the window has no fringes. Since we
+ don't know at this point whether there will be any R2L lines in
+ the window, we reserve space for truncation/continuation glyphs
+ even if only one of the fringes is absent. */
+ if (WINDOW_RIGHT_FRINGE_WIDTH (it->w) == 0
+ || (it->bidi_p && WINDOW_LEFT_FRINGE_WIDTH (it->w) == 0))
{
if (it->line_wrap == TRUNCATE)
it->last_visible_x -= it->truncation_pixel_width;
/* Or it fits exactly and we're on a window
system frame. */
|| (new_x == it->last_visible_x
- && FRAME_WINDOW_P (it->f))))
+ && FRAME_WINDOW_P (it->f)
+ && ((it->bidi_p && it->bidi_it.paragraph_dir == R2L)
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))
{
if ((it->current.dpvec_index >= 0
|| it->current.overlay_string_index >= 0)
{
Lisp_Object prop, window;
int ellipses_p = 0;
- EMACS_INT charpos = CHARPOS (pos->pos);
+ ptrdiff_t charpos = CHARPOS (pos->pos);
/* If POS specifies a position in a display vector, this might
be for an ellipsis displayed for invisible text. We won't
static int
init_from_display_pos (struct it *it, struct window *w, struct display_pos *pos)
{
- EMACS_INT charpos = CHARPOS (pos->pos), bytepos = BYTEPOS (pos->pos);
+ ptrdiff_t charpos = CHARPOS (pos->pos), bytepos = BYTEPOS (pos->pos);
int i, overlay_strings_with_newlines = 0;
/* If POS specifies a position in a display vector, this might
pos->overlay_string_index is in IT->overlay_strings. */
if (pos->overlay_string_index >= OVERLAY_STRING_CHUNK_SIZE)
{
- int n = pos->overlay_string_index / OVERLAY_STRING_CHUNK_SIZE;
+ ptrdiff_t n = pos->overlay_string_index / OVERLAY_STRING_CHUNK_SIZE;
it->current.overlay_string_index = 0;
while (n--)
{
relative_index = (it->current.overlay_string_index
% OVERLAY_STRING_CHUNK_SIZE);
it->string = it->overlay_strings[relative_index];
- xassert (STRINGP (it->string));
+ eassert (STRINGP (it->string));
it->current.string_pos = pos->string_pos;
it->method = GET_FROM_STRING;
}
string. This can only be a string from a `display' property.
IT should already be filled with that string. */
it->current.string_pos = pos->string_pos;
- xassert (STRINGP (it->string));
+ eassert (STRINGP (it->string));
}
/* Restore position in display vector translations, control
{
if (it->dpvec == NULL)
get_next_display_element (it);
- xassert (it->dpvec && it->current.dpvec_index == 0);
+ eassert (it->dpvec && it->current.dpvec_index == 0);
it->current.dpvec_index = pos->dpvec_index;
}
{
register INTERVAL iv, next_iv;
Lisp_Object object, limit, position;
- EMACS_INT charpos, bytepos;
+ ptrdiff_t charpos, bytepos;
if (STRINGP (it->string))
{
}
else
{
- EMACS_INT pos;
+ ptrdiff_t pos;
/* If end_charpos is out of range for some reason, such as a
misbehaving display function, rationalize it (Bug#5984). */
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;
/* 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))
break;
}
- if (!NULL_INTERVAL_P (next_iv))
+ if (next_iv)
{
if (INTEGERP (limit)
&& next_iv->position >= XFASTINT (limit))
if (it->cmp_it.id < 0)
{
- EMACS_INT stoppos = it->end_charpos;
+ ptrdiff_t stoppos = it->end_charpos;
if (it->bidi_p && it->bidi_it.scan_dir < 0)
stoppos = -1;
stoppos, it->string);
}
- xassert (STRINGP (it->string)
+ eassert (STRINGP (it->string)
|| (it->stop_charpos >= BEGV
&& it->stop_charpos >= IT_CHARPOS (*it)));
}
follows. This is like `next-overlay-change' but doesn't use
xmalloc. */
-static EMACS_INT
-next_overlay_change (EMACS_INT pos)
+static ptrdiff_t
+next_overlay_change (ptrdiff_t pos)
{
ptrdiff_t i, noverlays;
- EMACS_INT endpos;
+ ptrdiff_t endpos;
Lisp_Object *overlays;
/* Get all overlays at the given position. */
for (i = 0; i < noverlays; ++i)
{
Lisp_Object oend;
- EMACS_INT oendpos;
+ ptrdiff_t oendpos;
oend = OVERLAY_END (overlays[i]);
oendpos = OVERLAY_POSITION (oend);
strings, non-zero otherwise. It is set to 2 if the display string
uses any kind of `(space ...)' spec that will produce a stretch of
white space in the text area. */
-EMACS_INT
+ptrdiff_t
compute_display_string_pos (struct text_pos *position,
struct bidi_string_data *string,
int frame_window_p, int *disp_prop)
(string && STRINGP (string->lstring)) ? string->lstring : Qnil;
Lisp_Object pos, spec, limpos;
int string_p = (string && (STRINGP (string->lstring) || string->s));
- EMACS_INT eob = string_p ? string->schars : ZV;
- EMACS_INT begb = string_p ? 0 : BEGV;
- EMACS_INT bufpos, charpos = CHARPOS (*position);
- EMACS_INT lim =
+ ptrdiff_t eob = string_p ? string->schars : ZV;
+ ptrdiff_t begb = string_p ? 0 : BEGV;
+ ptrdiff_t bufpos, charpos = CHARPOS (*position);
+ ptrdiff_t lim =
(charpos < eob - MAX_DISP_SCAN) ? charpos + MAX_DISP_SCAN : eob;
struct text_pos tpos;
int rv = 0;
return -1. A display string is either an overlay with `display'
property whose value is a string or a `display' text property whose
value is a string. */
-EMACS_INT
-compute_display_string_end (EMACS_INT charpos, struct bidi_string_data *string)
+ptrdiff_t
+compute_display_string_end (ptrdiff_t charpos, struct bidi_string_data *string)
{
/* OBJECT = nil means current buffer. */
Lisp_Object object =
(string && STRINGP (string->lstring)) ? string->lstring : Qnil;
Lisp_Object pos = make_number (charpos);
- EMACS_INT eob =
+ ptrdiff_t eob =
(STRINGP (object) || (string && string->s)) ? string->schars : ZV;
if (charpos >= eob || (string->s && !STRINGP (object)))
no amount of fontifying will be able to change it. */
NILP (prop) && IT_CHARPOS (*it) < Z))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object val;
struct buffer *obuf = current_buffer;
int begv = BEGV, zv = ZV;
val = Vfontification_functions;
specbind (Qfontification_functions, Qnil);
- xassert (it->end_charpos == ZV);
+ eassert (it->end_charpos == ZV);
if (!CONSP (val) || EQ (XCAR (val), Qlambda))
safe_call1 (val, pos);
}
/* There isn't much we can reasonably do to protect against
misbehaving fontification, but here's a fig leaf. */
- else if (!NILP (BVAR (obuf, name)))
+ else if (BUFFER_LIVE_P (obuf))
set_buffer_internal_1 (obuf);
/* The fontification code may have added/removed text.
handle_face_prop (struct it *it)
{
int new_face_id;
- EMACS_INT next_stop;
+ ptrdiff_t next_stop;
if (!STRINGP (it->string))
{
else
{
int base_face_id;
- EMACS_INT bufpos;
+ ptrdiff_t bufpos;
int i;
Lisp_Object from_overlay
= (it->current.overlay_string_index >= 0
- ? it->string_overlays[it->current.overlay_string_index]
+ ? it->string_overlays[it->current.overlay_string_index
+ % OVERLAY_STRING_CHUNK_SIZE]
: Qnil);
/* See if we got to this string directly or indirectly from
{
if (it->stack[i].current.overlay_string_index >= 0)
from_overlay
- = it->string_overlays[it->stack[i].current.overlay_string_index];
+ = it->string_overlays[it->stack[i].current.overlay_string_index
+ % OVERLAY_STRING_CHUNK_SIZE];
else if (! NILP (it->stack[i].from_overlay))
from_overlay = it->stack[i].from_overlay;
{
int face_id = it->base_face_id, i;
- xassert (STRINGP (it->string));
+ eassert (STRINGP (it->string));
for (i = it->sp - 1; i >= 0; --i)
if (NILP (it->stack[i].string))
face_before_or_after_it_pos (struct it *it, int before_p)
{
int face_id, limit;
- EMACS_INT next_check_charpos;
+ ptrdiff_t next_check_charpos;
struct it it_copy;
void *it_copy_data = NULL;
- xassert (it->s == NULL);
+ eassert (it->s == NULL);
if (STRINGP (it->string))
{
- EMACS_INT bufpos, charpos;
+ ptrdiff_t bufpos, charpos;
int base_face_id;
/* No face change past the end of the string (for the case
charpos = it_copy.bidi_it.charpos;
}
}
- xassert (0 <= charpos && charpos <= SCHARS (it->string));
+ eassert (0 <= charpos && charpos <= SCHARS (it->string));
if (it->current.overlay_string_index >= 0)
bufpos = IT_CHARPOS (*it);
it_copy.bidi_it.charpos, it_copy.bidi_it.bytepos);
}
}
- xassert (BEGV <= CHARPOS (pos) && CHARPOS (pos) <= ZV);
+ eassert (BEGV <= CHARPOS (pos) && CHARPOS (pos) <= ZV);
/* Determine face for CHARSET_ASCII, or unibyte. */
face_id = face_at_buffer_position (it->w,
handle_invisible_prop (struct it *it)
{
enum prop_handled handled = HANDLED_NORMALLY;
+ int invis_p;
+ Lisp_Object prop;
if (STRINGP (it->string))
{
- Lisp_Object prop, end_charpos, limit, charpos;
+ Lisp_Object end_charpos, limit, charpos;
/* Get the value of the invisible text property at the
current position. Value will be nil if there is no such
property. */
charpos = make_number (IT_STRING_CHARPOS (*it));
prop = Fget_text_property (charpos, Qinvisible, it->string);
+ invis_p = TEXT_PROP_MEANS_INVISIBLE (prop);
- if (!NILP (prop)
- && IT_STRING_CHARPOS (*it) < it->end_charpos)
+ if (invis_p && IT_STRING_CHARPOS (*it) < it->end_charpos)
{
- EMACS_INT endpos;
+ /* Record whether we have to display an ellipsis for the
+ invisible text. */
+ int display_ellipsis_p = (invis_p == 2);
+ ptrdiff_t len, endpos;
handled = HANDLED_RECOMPUTE_PROPS;
- /* Get the position at which the next change of the
- invisible text property can be found in IT->string.
- Value will be nil if the property value is the same for
- all the rest of IT->string. */
- XSETINT (limit, SCHARS (it->string));
- end_charpos = Fnext_single_property_change (charpos, Qinvisible,
- it->string, limit);
-
- /* Text at current position is invisible. The next
- change in the property is at position end_charpos.
- Move IT's current position to that position. */
- if (INTEGERP (end_charpos)
- && (endpos = XFASTINT (end_charpos)) < XFASTINT (limit))
+ /* Get the position at which the next visible text can be
+ found in IT->string, if any. */
+ endpos = len = SCHARS (it->string);
+ XSETINT (limit, len);
+ do
{
+ end_charpos = Fnext_single_property_change (charpos, Qinvisible,
+ it->string, limit);
+ if (INTEGERP (end_charpos))
+ {
+ endpos = XFASTINT (end_charpos);
+ prop = Fget_text_property (end_charpos, Qinvisible, it->string);
+ invis_p = TEXT_PROP_MEANS_INVISIBLE (prop);
+ if (invis_p == 2)
+ display_ellipsis_p = 1;
+ }
+ }
+ while (invis_p && endpos < len);
+
+ if (display_ellipsis_p)
+ it->ellipsis_p = 1;
+
+ if (endpos < len)
+ {
+ /* Text at END_CHARPOS is visible. Move IT there. */
struct text_pos old;
- EMACS_INT oldpos;
+ ptrdiff_t oldpos;
old = it->current.string_pos;
oldpos = CHARPOS (old);
/* The rest of the string is invisible. If this is an
overlay string, proceed with the next overlay string
or whatever comes and return a character from there. */
- if (it->current.overlay_string_index >= 0)
+ if (it->current.overlay_string_index >= 0
+ && !display_ellipsis_p)
{
next_overlay_string (it);
/* Don't check for overlay strings when we just
}
else
{
- int invis_p;
- EMACS_INT newpos, next_stop, start_charpos, tem;
- Lisp_Object pos, prop, overlay;
+ ptrdiff_t newpos, next_stop, start_charpos, tem;
+ Lisp_Object pos, overlay;
/* First of all, is there invisible text at this position? */
tem = start_charpos = IT_CHARPOS (*it);
/* The position newpos is now either ZV or on visible text. */
if (it->bidi_p)
{
- EMACS_INT bpos = CHAR_TO_BYTE (newpos);
+ ptrdiff_t bpos = CHAR_TO_BYTE (newpos);
int on_newline =
bpos == ZV_BYTE || FETCH_BYTE (bpos) == '\n';
int after_newline =
{
Lisp_Object propval, object, overlay;
struct text_pos *position;
- EMACS_INT bufpos;
+ ptrdiff_t bufpos;
/* Nonzero if some property replaces the display of the text itself. */
int display_replaced_p = 0;
static int
handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
Lisp_Object overlay, struct text_pos *position,
- EMACS_INT bufpos, int frame_window_p)
+ ptrdiff_t bufpos, int frame_window_p)
{
int replacing_p = 0;
int rv;
}
else if (VECTORP (spec))
{
- int i;
+ ptrdiff_t i;
for (i = 0; i < ASIZE (spec); ++i)
if ((rv = handle_single_display_spec (it, AREF (spec, i), object,
overlay, position, bufpos,
static int
handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
Lisp_Object overlay, struct text_pos *position,
- EMACS_INT bufpos, int display_replaced_p,
+ ptrdiff_t bufpos, int display_replaced_p,
int frame_window_p)
{
Lisp_Object form;
if (!NILP (form) && !EQ (form, Qt))
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1;
/* Bind `object' to the object having the `display' property, a
&& (EQ (XCAR (it->font_height), Qplus)
|| EQ (XCAR (it->font_height), Qminus))
&& CONSP (XCDR (it->font_height))
- && INTEGERP (XCAR (XCDR (it->font_height))))
+ && RANGED_INTEGERP (0, XCAR (XCDR (it->font_height)), INT_MAX))
{
/* `(+ N)' or `(- N)' where N is an integer. */
int steps = XINT (XCAR (XCDR (it->font_height)));
{
/* Evaluate IT->font_height with `height' bound to the
current specified height to get the new height. */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]);
value = safe_eval (it->font_height);
int
display_prop_intangible_p (Lisp_Object prop, Lisp_Object overlay,
- EMACS_INT charpos, EMACS_INT bytepos)
+ ptrdiff_t charpos, ptrdiff_t bytepos)
{
int frame_window_p = FRAME_WINDOW_P (XFRAME (selected_frame));
struct text_pos position;
else if (VECTORP (prop))
{
/* A vector of sub-properties. */
- int i;
+ ptrdiff_t i;
for (i = 0; i < ASIZE (prop); ++i)
if (single_display_spec_string_p (AREF (prop, i), string))
return 1;
This function may only use code that doesn't eval because it is
called asynchronously from note_mouse_highlight. */
-static EMACS_INT
+static ptrdiff_t
string_buffer_position_lim (Lisp_Object string,
- EMACS_INT from, EMACS_INT to, int back_p)
+ ptrdiff_t from, ptrdiff_t to, int back_p)
{
Lisp_Object limit, prop, pos;
int found = 0;
This function may only use code that doesn't eval because it is
called asynchronously from note_mouse_highlight. */
-static EMACS_INT
-string_buffer_position (Lisp_Object string, EMACS_INT around_charpos)
+static ptrdiff_t
+string_buffer_position (Lisp_Object string, ptrdiff_t around_charpos)
{
const int MAX_DISTANCE = 1000;
- EMACS_INT found = string_buffer_position_lim (string, around_charpos,
+ ptrdiff_t found = string_buffer_position_lim (string, around_charpos,
around_charpos + MAX_DISTANCE,
0);
handle_composition_prop (struct it *it)
{
Lisp_Object prop, string;
- EMACS_INT pos, pos_byte, start, end;
+ ptrdiff_t pos, pos_byte, start, end;
if (STRINGP (it->string))
{
{
Lisp_Object overlay;
Lisp_Object string;
- int priority;
+ EMACS_INT priority;
int after_string_p;
};
it->ellipsis_p = (it->stack[it->sp - 1].display_ellipsis_p != 0);
pop_it (it);
- xassert (it->sp > 0
+ eassert (it->sp > 0
|| (NILP (it->string)
&& it->method == GET_FROM_BUFFER
&& it->stop_charpos >= BEGV
SET_TEXT_POS (it->current.string_pos, 0, 0);
it->method = GET_FROM_STRING;
it->stop_charpos = 0;
+ it->end_charpos = SCHARS (it->string);
if (it->cmp_it.stop_pos >= 0)
it->cmp_it.stop_pos = 0;
it->prev_stop = 0;
else
result = entry1->after_string_p ? -1 : 1;
}
- else if (entry1->after_string_p)
- /* After-strings sorted in order of decreasing priority. */
- result = entry2->priority - entry1->priority;
+ else if (entry1->priority != entry2->priority)
+ {
+ if (entry1->after_string_p)
+ /* After-strings sorted in order of decreasing priority. */
+ result = entry2->priority < entry1->priority ? -1 : 1;
+ else
+ /* Before-strings sorted in order of increasing priority. */
+ result = entry1->priority < entry2->priority ? -1 : 1;
+ }
else
- /* Before-strings sorted in order of increasing priority. */
- result = entry1->priority - entry2->priority;
+ result = 0;
return result;
}
compare_overlay_entries. */
static void
-load_overlay_strings (struct it *it, EMACS_INT charpos)
+load_overlay_strings (struct it *it, ptrdiff_t charpos)
{
Lisp_Object overlay, window, str, invisible;
struct Lisp_Overlay *ov;
- EMACS_INT start, end;
- int size = 20;
- int n = 0, i, j, invis_p;
- struct overlay_entry *entries
- = (struct overlay_entry *) alloca (size * sizeof *entries);
+ ptrdiff_t start, end;
+ ptrdiff_t size = 20;
+ ptrdiff_t n = 0, i, j;
+ int invis_p;
+ struct overlay_entry *entries = alloca (size * sizeof *entries);
+ USE_SAFE_ALLOCA;
if (charpos <= 0)
charpos = IT_CHARPOS (*it);
\
if (n == size) \
{ \
- int new_size = 2 * size; \
struct overlay_entry *old = entries; \
- entries = \
- (struct overlay_entry *) alloca (new_size \
- * sizeof *entries); \
+ SAFE_NALLOCA (entries, 2, size); \
memcpy (entries, old, size * sizeof *entries); \
- size = new_size; \
+ size *= 2; \
} \
\
entries[n].string = (STRING); \
for (ov = current_buffer->overlays_before; ov; ov = ov->next)
{
XSETMISC (overlay, ov);
- xassert (OVERLAYP (overlay));
+ eassert (OVERLAYP (overlay));
start = OVERLAY_POSITION (OVERLAY_START (overlay));
end = OVERLAY_POSITION (OVERLAY_END (overlay));
for (ov = current_buffer->overlays_after; ov; ov = ov->next)
{
XSETMISC (overlay, ov);
- xassert (OVERLAYP (overlay));
+ eassert (OVERLAYP (overlay));
start = OVERLAY_POSITION (OVERLAY_START (overlay));
end = OVERLAY_POSITION (OVERLAY_END (overlay));
}
CHECK_IT (it);
+ SAFE_FREE ();
}
least one overlay string was found. */
static int
-get_overlay_strings_1 (struct it *it, EMACS_INT charpos, int compute_stop_p)
+get_overlay_strings_1 (struct it *it, ptrdiff_t charpos, int compute_stop_p)
{
/* Get the first OVERLAY_STRING_CHUNK_SIZE overlay strings to
process. This fills IT->overlay_strings with strings, and sets
strings. */
if (compute_stop_p)
compute_stop_pos (it);
- xassert (it->face_id >= 0);
+ eassert (it->face_id >= 0);
/* Save IT's settings. They are restored after all overlay
strings have been processed. */
- xassert (!compute_stop_p || it->sp == 0);
+ eassert (!compute_stop_p || it->sp == 0);
/* When called from handle_stop, there might be an empty display
string loaded. In that case, don't bother saving it. But
it->string = it->overlay_strings[0];
it->from_overlay = Qnil;
it->stop_charpos = 0;
- xassert (STRINGP (it->string));
+ eassert (STRINGP (it->string));
it->end_charpos = SCHARS (it->string);
it->prev_stop = 0;
it->base_level_stop = 0;
/* Set up the bidi iterator for this overlay string. */
if (it->bidi_p)
{
- EMACS_INT pos = (charpos > 0 ? charpos : IT_CHARPOS (*it));
+ ptrdiff_t pos = (charpos > 0 ? charpos : IT_CHARPOS (*it));
it->bidi_it.string.lstring = it->string;
it->bidi_it.string.s = NULL;
}
static int
-get_overlay_strings (struct it *it, EMACS_INT charpos)
+get_overlay_strings (struct it *it, ptrdiff_t charpos)
{
it->string = Qnil;
it->method = GET_FROM_BUFFER;
{
struct iterator_stack_entry *p;
- xassert (it->sp < IT_STACK_SIZE);
+ eassert (it->sp < IT_STACK_SIZE);
p = it->stack + it->sp;
p->stop_charpos = it->stop_charpos;
p->prev_stop = it->prev_stop;
p->base_level_stop = it->base_level_stop;
p->cmp_it = it->cmp_it;
- xassert (it->face_id >= 0);
+ eassert (it->face_id >= 0);
p->face_id = it->face_id;
p->string = it->string;
p->method = it->method;
iterate_out_of_display_property (struct it *it)
{
int buffer_p = !STRINGP (it->string);
- EMACS_INT eob = (buffer_p ? ZV : it->end_charpos);
- EMACS_INT bob = (buffer_p ? BEGV : 0);
+ ptrdiff_t eob = (buffer_p ? ZV : it->end_charpos);
+ ptrdiff_t bob = (buffer_p ? BEGV : 0);
- xassert (eob >= CHARPOS (it->position) && CHARPOS (it->position) >= bob);
+ eassert (eob >= CHARPOS (it->position) && CHARPOS (it->position) >= bob);
/* Maybe initialize paragraph direction. If we are at the beginning
of a new paragraph, next_element_from_buffer may not have a
struct iterator_stack_entry *p;
int from_display_prop = it->from_disp_prop_p;
- xassert (it->sp > 0);
+ eassert (it->sp > 0);
--it->sp;
p = it->stack + it->sp;
it->stop_charpos = p->stop_charpos;
&& (it->method == GET_FROM_BUFFER || it->method == GET_FROM_STRING))
iterate_out_of_display_property (it);
- xassert ((BUFFERP (it->object)
+ eassert ((BUFFERP (it->object)
&& IT_CHARPOS (*it) == it->bidi_it.charpos
&& IT_BYTEPOS (*it) == it->bidi_it.bytepos)
|| (STRINGP (it->object)
forward_to_next_line_start (struct it *it, int *skipped_p,
struct bidi_it *bidi_it_prev)
{
- EMACS_INT old_selective;
+ ptrdiff_t old_selective;
int newline_found_p, n;
const int MAX_NEWLINE_DISTANCE = 500;
short-cut. */
if (!newline_found_p)
{
- EMACS_INT start = IT_CHARPOS (*it);
- EMACS_INT limit = find_next_newline_no_quit (start, 1);
+ ptrdiff_t start = IT_CHARPOS (*it);
+ ptrdiff_t limit = find_next_newline_no_quit (start, 1);
Lisp_Object pos;
- xassert (!STRINGP (it->string));
+ eassert (!STRINGP (it->string));
/* If there isn't any `display' property in sight, and no
overlays, we can just use the position of the newline in
{
Lisp_Object prop;
prop = Fget_char_property (make_number (IT_CHARPOS (*it) - 1),
- Qinvisible, it->window);
+ Qinvisible, it->window);
if (TEXT_PROP_MEANS_INVISIBLE (prop))
continue;
}
{
struct it it2;
void *it2data = NULL;
- EMACS_INT pos;
- EMACS_INT beg, end;
+ ptrdiff_t pos;
+ ptrdiff_t beg, end;
Lisp_Object val, overlay;
SAVE_IT (it2, *it, it2data);
it->continuation_lines_width = 0;
- xassert (IT_CHARPOS (*it) >= BEGV);
- xassert (IT_CHARPOS (*it) == BEGV
+ eassert (IT_CHARPOS (*it) >= BEGV);
+ eassert (IT_CHARPOS (*it) == BEGV
|| FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n');
CHECK_IT (it);
}
&& indented_beyond_p (IT_CHARPOS (*it), IT_BYTEPOS (*it),
it->selective))
{
- xassert (IT_BYTEPOS (*it) == BEGV
+ eassert (IT_BYTEPOS (*it) == BEGV
|| FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n');
newline_found_p =
forward_to_next_line_start (it, &skipped_p, &bidi_it_prev);
static void
reseat (struct it *it, struct text_pos pos, int force_p)
{
- EMACS_INT original_pos = IT_CHARPOS (*it);
+ ptrdiff_t original_pos = IT_CHARPOS (*it);
reseat_1 (it, pos, 0);
reseat_1 (struct it *it, struct text_pos pos, int set_stop_p)
{
/* Don't call this function when scanning a C string. */
- xassert (it->s == NULL);
+ eassert (it->s == NULL);
/* POS must be a reasonable value. */
- xassert (CHARPOS (pos) >= BEGV && CHARPOS (pos) <= ZV);
+ eassert (CHARPOS (pos) >= BEGV && CHARPOS (pos) <= ZV);
it->current.pos = it->position = pos;
it->end_charpos = ZV;
static void
reseat_to_string (struct it *it, const char *s, Lisp_Object string,
- EMACS_INT charpos, EMACS_INT precision, int field_width,
+ ptrdiff_t charpos, ptrdiff_t precision, int field_width,
int multibyte)
{
/* No region in strings. */
memset (&it->current, 0, sizeof it->current);
it->current.overlay_string_index = -1;
it->current.dpvec_index = -1;
- xassert (charpos >= 0);
+ eassert (charpos >= 0);
/* If STRING is specified, use its multibyteness, otherwise use the
setting of MULTIBYTE, if specified. */
if (s == NULL)
{
- xassert (STRINGP (string));
+ eassert (STRINGP (string));
it->string = string;
it->s = NULL;
it->end_charpos = it->string_nchars = SCHARS (string);
}
if (s == NULL && it->multibyte_p)
{
- EMACS_INT endpos = SCHARS (it->string);
+ ptrdiff_t endpos = SCHARS (it->string);
if (endpos > it->end_charpos)
endpos = it->end_charpos;
composition_compute_stop_pos (&it->cmp_it, charpos, -1, endpos,
end of buffer (or C string) is reached. */
static struct frame *last_escape_glyph_frame = NULL;
-static unsigned last_escape_glyph_face_id = (1 << FACE_ID_BITS);
+static int last_escape_glyph_face_id = (1 << FACE_ID_BITS);
static int last_escape_glyph_merged_face_id = 0;
struct frame *last_glyphless_glyph_frame = NULL;
-unsigned last_glyphless_glyph_face_id = (1 << FACE_ID_BITS);
+int last_glyphless_glyph_face_id = (1 << FACE_ID_BITS);
int last_glyphless_glyph_merged_face_id = 0;
static int
if (! it->multibyte_p && ! ASCII_CHAR_P (c))
{
- xassert (SINGLE_BYTE_CHAR_P (c));
+ eassert (SINGLE_BYTE_CHAR_P (c));
if (unibyte_display_via_language_environment)
{
c = DECODE_CHAR (unibyte, c);
Lisp_Object gc;
int ctl_len;
int face_id;
- EMACS_INT lface_id = 0;
+ int lface_id = 0;
int escape_glyph;
/* Handle control characters with ^. */
g = '^'; /* default glyph for Control */
/* Set IT->ctl_chars[0] to the glyph for `^'. */
if (it->dp
- && (gc = DISP_CTRL_GLYPH (it->dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
+ && (gc = DISP_CTRL_GLYPH (it->dp), GLYPH_CODE_P (gc)))
{
g = GLYPH_CODE_CHAR (gc);
lface_id = GLYPH_CODE_FACE (gc);
escape_glyph = '\\';
if (it->dp
- && (gc = DISP_ESCAPE_GLYPH (it->dp), GLYPH_CODE_P (gc))
- && GLYPH_CODE_CHAR_VALID_P (gc))
+ && (gc = DISP_ESCAPE_GLYPH (it->dp), GLYPH_CODE_P (gc)))
{
escape_glyph = GLYPH_CODE_CHAR (gc);
lface_id = GLYPH_CODE_FACE (gc);
}
else
{
- EMACS_INT pos = (it->s ? -1
+ ptrdiff_t pos = (it->s ? -1
: STRINGP (it->string) ? IT_STRING_CHARPOS (*it)
: IT_CHARPOS (*it));
int c;
&& (it->current.overlay_string_index
== it->n_overlay_strings - 1))
{
- EMACS_INT ignore;
+ ptrdiff_t ignore;
int next_face_id;
struct text_pos pos = it->current.pos;
INC_TEXT_POS (pos, it->multibyte_p);
{
/* No more grapheme clusters in this composition.
Find the next stop position. */
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
/* Now we are scanning backward and don't know
where to stop. */
{
/* No more grapheme clusters in this composition.
Find the next stop position. */
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
/* Now we are scanning backward and don't know
where to stop. */
}
else
{
- xassert (it->len != 0);
+ eassert (it->len != 0);
if (!it->bidi_p)
{
{
/* As the scan direction was changed, we must
re-compute the stop position for composition. */
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
stop = -1;
composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it),
IT_BYTEPOS (*it), stop, Qnil);
}
}
- xassert (IT_BYTEPOS (*it) == CHAR_TO_BYTE (IT_CHARPOS (*it)));
+ eassert (IT_BYTEPOS (*it) == CHAR_TO_BYTE (IT_CHARPOS (*it)));
}
break;
case GET_FROM_STRING:
/* Current display element is a character from a Lisp string. */
- xassert (it->s == NULL && STRINGP (it->string));
+ eassert (it->s == NULL && STRINGP (it->string));
/* Don't advance past string end. These conditions are true
when set_iterator_to_next is called at the end of
get_next_display_element, in which case the Lisp string is
it->cmp_it.from = it->cmp_it.to;
else
{
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
stop = -1;
composition_compute_stop_pos (&it->cmp_it,
it->cmp_it.to = it->cmp_it.from;
else
{
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
stop = -1;
composition_compute_stop_pos (&it->cmp_it,
IT_STRING_CHARPOS (*it) = it->bidi_it.charpos;
if (prev_scan_dir != it->bidi_it.scan_dir)
{
- EMACS_INT stop = it->end_charpos;
+ ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
stop = -1;
/* The position etc with which we have to proceed are on
the stack. The position may be at the end of a string,
if the `display' property takes up the whole string. */
- xassert (it->sp > 0);
+ eassert (it->sp > 0);
pop_it (it);
if (it->method == GET_FROM_STRING)
goto consider_string_end;
default:
/* There are no other methods defined, so this should be a bug. */
- abort ();
+ emacs_abort ();
}
- xassert (it->method != GET_FROM_STRING
+ eassert (it->method != GET_FROM_STRING
|| (STRINGP (it->string)
&& IT_STRING_CHARPOS (*it) >= 0));
}
Lisp_Object gc;
/* Precondition. */
- xassert (it->dpvec && it->current.dpvec_index >= 0);
+ eassert (it->dpvec && it->current.dpvec_index >= 0);
it->face_id = it->saved_face_id;
That seemed totally bogus - so I changed it... */
gc = it->dpvec[it->current.dpvec_index];
- if (GLYPH_CODE_P (gc) && GLYPH_CODE_CHAR_VALID_P (gc))
+ if (GLYPH_CODE_P (gc))
{
it->c = GLYPH_CODE_CHAR (gc);
it->len = CHAR_BYTES (it->c);
it->face_id = it->dpvec_face_id;
else
{
- EMACS_INT lface_id = GLYPH_CODE_FACE (gc);
+ int lface_id = GLYPH_CODE_FACE (gc);
if (lface_id > 0)
it->face_id = merge_faces (it->f, Qt, lface_id,
it->saved_face_id);
get_visually_first_element (struct it *it)
{
int string_p = STRINGP (it->string) || it->s;
- EMACS_INT eob = (string_p ? it->bidi_it.string.schars : ZV);
- EMACS_INT bob = (string_p ? 0 : BEGV);
+ ptrdiff_t eob = (string_p ? it->bidi_it.string.schars : ZV);
+ ptrdiff_t bob = (string_p ? 0 : BEGV);
if (STRINGP (it->string))
{
}
else
{
- EMACS_INT orig_bytepos = it->bidi_it.bytepos;
+ ptrdiff_t orig_bytepos = it->bidi_it.bytepos;
/* We need to prime the bidi iterator starting at the line's or
string's beginning, before we will be able to produce the
if (STRINGP (it->string) || !it->s)
{
- EMACS_INT stop, charpos, bytepos;
+ ptrdiff_t stop, charpos, bytepos;
if (STRINGP (it->string))
{
- xassert (!it->s);
+ eassert (!it->s);
stop = SCHARS (it->string);
if (stop > it->end_charpos)
stop = it->end_charpos;
{
struct text_pos position;
- xassert (STRINGP (it->string));
- xassert (!it->bidi_p || EQ (it->string, it->bidi_it.string.lstring));
- xassert (IT_STRING_CHARPOS (*it) >= 0);
+ eassert (STRINGP (it->string));
+ eassert (!it->bidi_p || EQ (it->string, it->bidi_it.string.lstring));
+ eassert (IT_STRING_CHARPOS (*it) >= 0);
position = it->current.string_pos;
/* With bidi reordering, the character to display might not be the
{
int success_p = 1;
- xassert (it->s);
- xassert (!it->bidi_p || it->s == it->bidi_it.string.s);
+ eassert (it->s);
+ eassert (!it->bidi_p || it->s == it->bidi_it.string.s);
it->what = IT_CHARACTER;
BYTEPOS (it->position) = CHARPOS (it->position) = 0;
it->object = Qnil;
struct text_pos pos;
struct display_pos save_current = it->current;
struct text_pos save_position = it->position;
- EMACS_INT charpos = IT_CHARPOS (*it);
- EMACS_INT where_we_are = charpos;
- EMACS_INT save_stop_pos = it->stop_charpos;
- EMACS_INT save_end_pos = it->end_charpos;
+ ptrdiff_t charpos = IT_CHARPOS (*it);
+ ptrdiff_t where_we_are = charpos;
+ ptrdiff_t save_stop_pos = it->stop_charpos;
+ ptrdiff_t save_end_pos = it->end_charpos;
- xassert (NILP (it->string) && !it->s);
- xassert (it->bidi_p);
+ eassert (NILP (it->string) && !it->s);
+ eassert (it->bidi_p);
it->bidi_p = 0;
do
{
compute_stop_pos (it);
/* We must advance forward, right? */
if (it->stop_charpos <= charpos)
- abort ();
+ emacs_abort ();
}
while (charpos > BEGV && it->stop_charpos >= it->end_charpos);
position. */
static void
-handle_stop_backwards (struct it *it, EMACS_INT charpos)
+handle_stop_backwards (struct it *it, ptrdiff_t charpos)
{
int bufp = !STRINGP (it->string);
- EMACS_INT where_we_are = (bufp ? IT_CHARPOS (*it) : IT_STRING_CHARPOS (*it));
+ ptrdiff_t where_we_are = (bufp ? IT_CHARPOS (*it) : IT_STRING_CHARPOS (*it));
struct display_pos save_current = it->current;
struct text_pos save_position = it->position;
struct text_pos pos1;
- EMACS_INT next_stop;
+ ptrdiff_t next_stop;
/* Scan in strict logical order. */
- xassert (it->bidi_p);
+ eassert (it->bidi_p);
it->bidi_p = 0;
do
{
compute_stop_pos (it);
/* We must advance forward, right? */
if (it->stop_charpos <= it->prev_stop)
- abort ();
+ emacs_abort ();
charpos = it->stop_charpos;
}
while (charpos <= where_we_are);
{
int success_p = 1;
- xassert (IT_CHARPOS (*it) >= BEGV);
- xassert (NILP (it->string) && !it->s);
- xassert (!it->bidi_p
+ eassert (IT_CHARPOS (*it) >= BEGV);
+ eassert (NILP (it->string) && !it->s);
+ eassert (!it->bidi_p
|| (EQ (it->bidi_it.string.lstring, Qnil)
&& it->bidi_it.string.s == NULL));
/* No face changes, overlays etc. in sight, so just return a
character from current_buffer. */
unsigned char *p;
- EMACS_INT stop;
+ ptrdiff_t stop;
/* Maybe run the redisplay end trigger hook. Performance note:
This doesn't seem to cost measurable time. */
}
/* Value is zero if end of buffer reached. */
- xassert (!success_p || it->what != IT_CHARACTER || it->len > 0);
+ eassert (!success_p || it->what != IT_CHARACTER || it->len > 0);
return success_p;
}
/* IT->glyph_row should be non-null, i.e. we should be actually
displaying something, or otherwise we should not run the hook. */
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
/* Set up hook arguments. */
args[0] = Qredisplay_end_trigger_functions;
/* Since we are *trying* to run these functions, don't try to run
them again, even if they get an error. */
- it->w->redisplay_end_trigger = Qnil;
+ wset_redisplay_end_trigger (it->w, Qnil);
Frun_hook_with_args (3, args);
/* Notice if it changed the face of the character we are on. */
static enum move_it_result
move_it_in_display_line_to (struct it *it,
- EMACS_INT to_charpos, int to_x,
+ ptrdiff_t to_charpos, int to_x,
enum move_operation_enum op)
{
enum move_it_result result = MOVE_UNDEFINED;
void *ppos_data = NULL;
int may_wrap = 0;
enum it_method prev_method = it->method;
- EMACS_INT prev_pos = IT_CHARPOS (*it);
+ ptrdiff_t prev_pos = IT_CHARPOS (*it);
int saw_smaller_pos = prev_pos < to_charpos;
/* Don't produce glyphs in produce_glyphs. */
/* Or it fits exactly and we're on a window
system frame. */
|| (new_x == it->last_visible_x
- && FRAME_WINDOW_P (it->f))))
+ && FRAME_WINDOW_P (it->f)
+ && ((it->bidi_p && it->bidi_it.paragraph_dir == R2L)
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))
{
if (/* IT->hpos == 0 means the very first glyph
doesn't fit on the line, e.g. a wide image. */
/* On graphical terminals, newlines may
"overflow" into the fringe if
overflow-newline-into-fringe is non-nil.
- On text-only terminals, newlines may
- overflow into the last glyph on the
+ On text terminals, and on graphical
+ terminals with no right margin, newlines
+ may overflow into the last glyph on the
display line.*/
if (!FRAME_WINDOW_P (it->f)
+ || ((it->bidi_p
+ && it->bidi_it.paragraph_dir == R2L)
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0
|| IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
if (!get_next_display_element (it))
necessary here because of lines consisting of a line end,
only. The line end will not produce any glyphs and we
would never get MOVE_X_REACHED. */
- xassert (it->nglyphs == 0);
+ eassert (it->nglyphs == 0);
result = MOVE_X_REACHED;
break;
}
&& it->current_x >= it->last_visible_x)
{
if (!FRAME_WINDOW_P (it->f)
+ || ((it->bidi_p && it->bidi_it.paragraph_dir == R2L)
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0
|| IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
int at_eob_p = 0;
/* For external use. */
void
move_it_in_display_line (struct it *it,
- EMACS_INT to_charpos, int to_x,
+ ptrdiff_t to_charpos, int to_x,
enum move_operation_enum op)
{
if (it->line_wrap == WORD_WRAP
displayed to the right of TO_CHARPOS on the screen. */
void
-move_it_to (struct it *it, EMACS_INT to_charpos, int to_x, int to_y, int to_vpos, int op)
+move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos, int op)
{
enum move_it_result skip, skip2 = MOVE_X_REACHED;
int line_height, line_start_x = 0, reached = 0;
break;
default:
- abort ();
+ emacs_abort ();
}
/* Reset/increment for the next run. */
int nlines, h;
struct it it2, it3;
void *it2data = NULL, *it3data = NULL;
- EMACS_INT start_pos;
+ ptrdiff_t start_pos;
move_further_back:
- xassert (dy >= 0);
+ eassert (dy >= 0);
start_pos = IT_CHARPOS (*it);
|| (it2.method == GET_FROM_STRING
&& IT_CHARPOS (it2) == start_pos
&& SREF (it2.string, IT_STRING_BYTEPOS (it2) - 1) == '\n')));
- xassert (IT_CHARPOS (*it) >= BEGV);
+ eassert (IT_CHARPOS (*it) >= BEGV);
SAVE_IT (it3, it2, it3data);
move_it_to (&it2, start_pos, -1, -1, -1, MOVE_TO_POS);
- xassert (IT_CHARPOS (*it) >= BEGV);
+ eassert (IT_CHARPOS (*it) >= BEGV);
/* H is the actual vertical distance from the position in *IT
and the starting position. */
h = it2.current_y - it->current_y;
&& IT_CHARPOS (*it) > BEGV
&& FETCH_BYTE (IT_BYTEPOS (*it) - 1) != '\n')
{
- EMACS_INT nl_pos =
+ ptrdiff_t nl_pos =
find_next_newline_no_quit (IT_CHARPOS (*it) - 1, -1);
move_it_to (it, nl_pos, -1, -1, -1, MOVE_TO_POS);
truncate-lines nil. */
void
-move_it_by_lines (struct it *it, int dvpos)
+move_it_by_lines (struct it *it, ptrdiff_t dvpos)
{
/* The commented-out optimization uses vmotion on terminals. This
{
struct it it2;
void *it2data = NULL;
- EMACS_INT start_charpos, i;
+ ptrdiff_t start_charpos, i;
/* Start at the beginning of the screen line containing IT's
position. This may actually move vertically backwards,
Lisp_Object args[3];
Lisp_Object msg, fmt;
char *buffer;
- EMACS_INT len;
+ ptrdiff_t len;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
USE_SAFE_ALLOCA;
- /* Do nothing if called asynchronously. Inserting text into
- a buffer may call after-change-functions and alike and
- that would means running Lisp asynchronously. */
- if (handling_signal)
- return;
-
fmt = msg = Qnil;
GCPRO4 (fmt, msg, arg1, 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);
so the buffer M must NOT point to a Lisp string. */
void
-message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
+message_dolog (const char *m, ptrdiff_t nbytes, int nlflag, int multibyte)
{
const unsigned char *msg = (const unsigned char *) m;
struct buffer *oldbuf;
Lisp_Object oldpoint, oldbegv, oldzv;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
- EMACS_INT point_at_end = 0;
- EMACS_INT zv_at_end = 0;
+ ptrdiff_t point_at_end = 0;
+ ptrdiff_t zv_at_end = 0;
Lisp_Object old_deactivate_mark, tem;
struct gcpro gcpro1;
old_deactivate_mark = Vdeactivate_mark;
oldbuf = current_buffer;
Fset_buffer (Fget_buffer_create (Vmessages_buffer_name));
- BVAR (current_buffer, undo_list) = Qt;
+ bset_undo_list (current_buffer, Qt);
oldpoint = message_dolog_marker1;
set_marker_restricted (oldpoint, make_number (PT), Qnil);
if (multibyte
&& NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- EMACS_INT i;
+ ptrdiff_t i;
int c, char_bytes;
char work[1];
else if (! multibyte
&& ! NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- EMACS_INT i;
+ ptrdiff_t i;
int c, char_bytes;
unsigned char str[MAX_MULTIBYTE_LENGTH];
/* Convert a single-byte string to multibyte
if (nlflag)
{
- EMACS_INT this_bol, this_bol_byte, prev_bol, prev_bol_byte;
+ ptrdiff_t this_bol, this_bol_byte, prev_bol, prev_bol_byte;
printmax_t dups;
insert_1 ("\n", 1, 1, 0, 0);
{
char dupstr[sizeof " [ times]"
+ INT_STRLEN_BOUND (printmax_t)];
- int duplen;
/* If you change this format, don't forget to also
change message_log_check_duplicate. */
- sprintf (dupstr, " [%"pMd" times]", dups);
- duplen = strlen (dupstr);
+ int duplen = sprintf (dupstr, " [%"pMd" times]", dups);
TEMP_SET_PT_BOTH (Z - 1, Z_BYTE - 1);
insert_1 (dupstr, duplen, 1, 0, 1);
}
value N > 1 if we should also append " [N times]". */
static intmax_t
-message_log_check_duplicate (EMACS_INT prev_bol_byte, EMACS_INT this_bol_byte)
+message_log_check_duplicate (ptrdiff_t prev_bol_byte, ptrdiff_t this_bol_byte)
{
- EMACS_INT i;
- EMACS_INT len = Z_BYTE - 1 - this_bol_byte;
+ ptrdiff_t i;
+ ptrdiff_t len = Z_BYTE - 1 - this_bol_byte;
int seen_dots = 0;
unsigned char *p1 = BUF_BYTE_ADDRESS (current_buffer, prev_bol_byte);
unsigned char *p2 = BUF_BYTE_ADDRESS (current_buffer, this_bol_byte);
This may GC, so the buffer M must NOT point to a Lisp string. */
void
-message2 (const char *m, EMACS_INT nbytes, int multibyte)
+message2 (const char *m, ptrdiff_t nbytes, int multibyte)
{
/* First flush out any partial line written with print. */
message_log_maybe_newline ();
/* The non-logging counterpart of message2. */
void
-message2_nolog (const char *m, EMACS_INT nbytes, int multibyte)
+message2_nolog (const char *m, ptrdiff_t nbytes, int multibyte)
{
struct frame *sf = SELECTED_FRAME ();
message_enable_multibyte = multibyte;
This function cancels echoing. */
void
-message3 (Lisp_Object m, EMACS_INT nbytes, int multibyte)
+message3 (Lisp_Object m, ptrdiff_t nbytes, int multibyte)
{
struct gcpro gcpro1;
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 ();
and make this cancel echoing. */
void
-message3_nolog (Lisp_Object m, EMACS_INT nbytes, int multibyte)
+message3_nolog (Lisp_Object m, ptrdiff_t nbytes, int multibyte)
{
struct frame *sf = SELECTED_FRAME ();
message_enable_multibyte = multibyte;
len = doprnt (FRAME_MESSAGE_BUF (f),
FRAME_MESSAGE_BUF_SIZE (f), m, (char *)0, ap);
- message2 (FRAME_MESSAGE_BUF (f), len, 0);
+ message2 (FRAME_MESSAGE_BUF (f), len, 1);
}
else
message1 (0);
for (i = 0; i < 2; ++i)
if (!BUFFERP (echo_buffer[i])
- || NILP (BVAR (XBUFFER (echo_buffer[i]), name)))
+ || !BUFFER_LIVE_P (XBUFFER (echo_buffer[i])))
{
char name[30];
Lisp_Object old_buffer;
int j;
old_buffer = echo_buffer[i];
- sprintf (name, " *Echo Area %d*", i);
- echo_buffer[i] = Fget_buffer_create (build_string (name));
- BVAR (XBUFFER (echo_buffer[i]), truncate_lines) = Qnil;
+ echo_buffer[i] = Fget_buffer_create
+ (make_formatted_string (name, " *Echo Area %d*", i));
+ bset_truncate_lines (XBUFFER (echo_buffer[i]), Qnil);
/* to force word wrap in echo area -
it was decided to postpone this*/
/* XBUFFER (echo_buffer[i])->word_wrap = Qt; */
static int
with_echo_area_buffer (struct window *w, int which,
- int (*fn) (EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT),
- EMACS_INT a1, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
+ int (*fn) (ptrdiff_t, Lisp_Object, ptrdiff_t, ptrdiff_t),
+ ptrdiff_t a1, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4)
{
Lisp_Object buffer;
int this_one, the_other, clear_buffer_p, rc;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* If buffers aren't live, make new ones. */
ensure_echo_area_buffers ();
set_buffer_internal_1 (XBUFFER (buffer));
if (w)
{
- w->buffer = buffer;
+ wset_buffer (w, buffer);
set_marker_both (w->pointm, buffer, BEG, BEG_BYTE);
}
- BVAR (current_buffer, undo_list) = Qt;
- BVAR (current_buffer, read_only) = Qnil;
+ bset_undo_list (current_buffer, Qt);
+ bset_read_only (current_buffer, Qnil);
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
if (clear_buffer_p && Z > BEG)
del_range (BEG, Z);
- xassert (BEGV >= BEG);
- xassert (ZV <= Z && ZV >= BEGV);
+ eassert (BEGV >= BEG);
+ eassert (ZV <= Z && ZV >= BEGV);
rc = fn (a1, a2, a3, a4);
- xassert (BEGV >= BEG);
- xassert (ZV <= Z && ZV >= BEGV);
+ eassert (BEGV >= BEG);
+ eassert (ZV <= Z && ZV >= BEGV);
unbind_to (count, Qnil);
return rc;
ASET (vector, i, Qnil);
}
- xassert (i == ASIZE (vector));
+ eassert (i == ASIZE (vector));
return vector;
}
charpos = AREF (vector, 5);
bytepos = AREF (vector, 6);
- w->buffer = buffer;
+ wset_buffer (w, buffer);
set_marker_both (w->pointm, buffer,
XFASTINT (charpos), XFASTINT (bytepos));
}
/* Switch to that buffer and clear it. */
set_buffer_internal (XBUFFER (echo_area_buffer[0]));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
if (Z > BEG)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_read_only, Qt);
/* Note that undo recording is always disabled. */
del_range (BEG, Z);
{
/* Someone switched buffers between print requests. */
set_buffer_internal (XBUFFER (echo_area_buffer[0]));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
}
}
}
static int
display_echo_area (struct window *w)
{
- int i, no_message_p, window_height_changed_p, count;
+ int i, no_message_p, window_height_changed_p;
/* Temporarily disable garbage collections while displaying the echo
area. This is done because a GC can print a message itself.
That message would modify the echo area buffer's contents while a
redisplay of the buffer is going on, and seriously confuse
redisplay. */
- count = inhibit_garbage_collection ();
+ ptrdiff_t count = inhibit_garbage_collection ();
/* If there is no message, we must call display_echo_area_1
nevertheless because it resizes the window. But we will have to
Value is non-zero if height of W was changed. */
static int
-display_echo_area_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
+display_echo_area_1 (ptrdiff_t a1, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4)
{
intptr_t i1 = a1;
struct window *w = (struct window *) i1;
resize_mini_window returns. */
static int
-resize_mini_window_1 (EMACS_INT a1, Lisp_Object exactly, EMACS_INT a3, EMACS_INT a4)
+resize_mini_window_1 (ptrdiff_t a1, Lisp_Object exactly, ptrdiff_t a3, ptrdiff_t a4)
{
intptr_t i1 = a1;
return resize_mini_window ((struct window *) i1, !NILP (exactly));
struct frame *f = XFRAME (w->frame);
int window_height_changed_p = 0;
- xassert (MINI_WINDOW_P (w));
+ eassert (MINI_WINDOW_P (w));
/* By default, start display at the beginning. */
set_marker_both (w->start, w->buffer,
struct it it;
struct window *root = XWINDOW (FRAME_ROOT_WINDOW (f));
int total_height = WINDOW_TOTAL_LINES (root) + WINDOW_TOTAL_LINES (w);
- int height, max_height;
+ int height;
+ EMACS_INT max_height;
int unit = FRAME_LINE_HEIGHT (f);
struct text_pos start;
struct buffer *old_current_buffer = NULL;
static int
-current_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
+current_message_1 (ptrdiff_t a1, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4)
{
intptr_t i1 = a1;
Lisp_Object *msg = (Lisp_Object *) i1;
empty. This is a relatively infrequent operation, so it's not
worth optimizing. */
-int
+bool
push_message (void)
{
- Lisp_Object msg;
- msg = current_message ();
+ Lisp_Object msg = current_message ();
Vmessage_stack = Fcons (msg, Vmessage_stack);
return STRINGP (msg);
}
{
Lisp_Object msg;
- xassert (CONSP (Vmessage_stack));
+ eassert (CONSP (Vmessage_stack));
msg = XCAR (Vmessage_stack);
if (STRINGP (msg))
message3_nolog (msg, SBYTES (msg), STRING_MULTIBYTE (msg));
static void
pop_message (void)
{
- xassert (CONSP (Vmessage_stack));
+ eassert (CONSP (Vmessage_stack));
Vmessage_stack = XCDR (Vmessage_stack);
}
check_message_stack (void)
{
if (!NILP (Vmessage_stack))
- abort ();
+ emacs_abort ();
}
time we display it---but don't redisplay it now. */
void
-truncate_echo_area (EMACS_INT nchars)
+truncate_echo_area (ptrdiff_t nchars)
{
if (nchars == 0)
echo_area_buffer[0] = Qnil;
message to at most NCHARS characters. */
static int
-truncate_message_1 (EMACS_INT nchars, Lisp_Object a2, EMACS_INT a3, EMACS_INT a4)
+truncate_message_1 (ptrdiff_t nchars, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4)
{
if (BEG + nchars < Z)
del_range (BEG + nchars, Z);
return 0;
}
-
/* Set the current message to a substring of S or STRING.
If STRING is a Lisp string, set the message to the first NBYTES
static void
set_message (const char *s, Lisp_Object string,
- EMACS_INT nbytes, int multibyte_p)
+ ptrdiff_t nbytes, int multibyte_p)
{
message_enable_multibyte
= ((s && multibyte_p)
(intptr_t) s, string, nbytes, multibyte_p);
message_buf_print = 0;
help_echo_showing_p = 0;
+
+ if (STRINGP (Vdebug_on_message)
+ && fast_string_match (Vdebug_on_message, string) >= 0)
+ call_debugger (list2 (Qerror, string));
}
current. */
static int
-set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multibyte_p)
+set_message_1 (ptrdiff_t a1, Lisp_Object a2, ptrdiff_t nbytes, ptrdiff_t multibyte_p)
{
intptr_t i1 = a1;
const char *s = (const char *) i1;
!= !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_truncate_lines (current_buffer, message_truncate_lines ? Qt : Qnil);
if (!NILP (BVAR (current_buffer, bidi_display_reordering)))
- BVAR (current_buffer, bidi_paragraph_direction) = Qleft_to_right;
+ bset_bidi_paragraph_direction (current_buffer, Qleft_to_right);
/* Insert new message at BEG. */
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
if (STRINGP (string))
{
- EMACS_INT nchars;
+ ptrdiff_t nchars;
if (nbytes == 0)
nbytes = SBYTES (string);
if (multibyte_p && NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
/* Convert from multi-byte to single-byte. */
- EMACS_INT i;
+ ptrdiff_t i;
int c, n;
char work[1];
&& !NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
/* Convert from single-byte to multi-byte. */
- EMACS_INT i;
+ ptrdiff_t i;
int c, n;
unsigned char str[MAX_MULTIBYTE_LENGTH];
/* Must update other windows. Likewise as in other
cases, don't let this update be interrupted by
pending input. */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qredisplay_dont_pause, Qt);
windows_or_buffers_changed = 1;
redisplay_internal ();
static Lisp_Object Vmode_line_unwind_vector;
static Lisp_Object
-format_mode_line_unwind_data (struct buffer *obuf,
+format_mode_line_unwind_data (struct frame *target_frame,
+ struct buffer *obuf,
Lisp_Object owin,
int save_proptrans)
{
Vmode_line_unwind_vector = Qnil;
if (NILP (vector))
- vector = Fmake_vector (make_number (8), Qnil);
+ vector = Fmake_vector (make_number (10), Qnil);
ASET (vector, 0, make_number (mode_line_target));
ASET (vector, 1, make_number (MODE_LINE_NOPROP_LEN (0)));
tmp = Qnil;
ASET (vector, 6, tmp);
ASET (vector, 7, owin);
+ if (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, target_frame->selected_window);
+ if (FRAME_TERMCAP_P (target_frame))
+ ASET (vector, 9, FRAME_TTY (target_frame)->top_frame);
+ }
return vector;
}
static Lisp_Object
unwind_format_mode_line (Lisp_Object vector)
{
+ Lisp_Object old_window = AREF (vector, 7);
+ Lisp_Object target_frame_window = AREF (vector, 8);
+ Lisp_Object old_top_frame = AREF (vector, 9);
+
mode_line_target = XINT (AREF (vector, 0));
mode_line_noprop_ptr = mode_line_noprop_buf + XINT (AREF (vector, 1));
mode_line_string_list = AREF (vector, 2);
mode_line_string_face = AREF (vector, 4);
mode_line_string_face_prop = AREF (vector, 5);
- if (!NILP (AREF (vector, 7)))
- /* Select window before buffer, since it may change the buffer. */
- Fselect_window (AREF (vector, 7), Qt);
+ /* Select window before buffer, since it may change the buffer. */
+ if (!NILP (old_window))
+ {
+ /* If the operation that we are unwinding had selected a window
+ on a different frame, reset its frame-selected-window. For a
+ text terminal, reset its top-frame if necessary. */
+ if (!NILP (target_frame_window))
+ {
+ Lisp_Object frame
+ = WINDOW_FRAME (XWINDOW (target_frame_window));
+
+ if (!EQ (frame, WINDOW_FRAME (XWINDOW (old_window))))
+ Fselect_window (target_frame_window, Qt);
+
+ if (!NILP (old_top_frame) && !EQ (old_top_frame, frame))
+ Fselect_frame (old_top_frame, Qt);
+ }
+
+ Fselect_window (old_window, Qt);
+ }
if (!NILP (AREF (vector, 6)))
{
{
const unsigned char *str = (const unsigned char *) string;
int n = 0;
- EMACS_INT dummy, nbytes;
+ ptrdiff_t dummy, nbytes;
/* Copy at most PRECISION chars from STR. */
nbytes = strlen (string);
char *title;
ptrdiff_t len;
struct it it;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
mode_line_noprop_buf; then display the title. */
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
- (current_buffer, selected_window, 0));
+ (f, current_buffer, selected_window, 0));
Fselect_window (f->selected_window, Qt);
- set_buffer_internal_1 (XBUFFER (XWINDOW (f->selected_window)->buffer));
+ set_buffer_internal_1
+ (XBUFFER (XWINDOW (f->selected_window)->buffer));
fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format;
mode_line_target = MODE_LINE_TITLE;
#endif /* not HAVE_WINDOW_SYSTEM */
-
-
\f
/***********************************************************************
Menu Bars
if (all_windows)
{
Lisp_Object tail, frame;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* 1 means that update_menu_bar has run its hooks
so any further calls to update_menu_bar shouldn't do so again. */
int menu_bar_hooks_run = 0;
#ifdef HAVE_NS
if (windows_or_buffers_changed
&& FRAME_NS_P (f))
- ns_set_doc_edited (f, Fbuffer_modified_p
- (XWINDOW (f->selected_window)->buffer));
+ ns_set_doc_edited
+ (f, Fbuffer_modified_p (XWINDOW (f->selected_window)->buffer));
#endif
UNGCPRO;
}
|| update_mode_lines
|| ((BUF_SAVE_MODIFF (XBUFFER (w->buffer))
< BUF_MODIFF (XBUFFER (w->buffer)))
- != !NILP (w->last_had_star))
+ != w->last_had_star)
|| ((!NILP (Vtransient_mark_mode)
&& !NILP (BVAR (XBUFFER (w->buffer), mark_active)))
!= !NILP (w->region_showing)))
{
struct buffer *prev = current_buffer;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_menubar_update, Qt);
}
XSETFRAME (Vmenu_updating_frame, f);
- FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
+ fset_menu_bar_items (f, 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) \
else
/* On a terminal screen, the menu bar is an ordinary screen
line, and this makes it get updated. */
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
#else /* ! (USE_X_TOOLKIT || HAVE_NTGUI || HAVE_NS || USE_GTK) */
/* In the non-toolkit version, the menu bar is an ordinary screen
line, and this makes it get updated. */
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
#endif /* ! (USE_X_TOOLKIT || HAVE_NTGUI || HAVE_NS || USE_GTK) */
unbind_to (count, Qnil);
This will also set the cursor position of W. */
if (updated_window == NULL)
{
- BLOCK_INPUT;
+ block_input ();
display_and_set_cursor (w, 1, hpos, vpos, x, y);
if (FRAME_RIF (SELECTED_FRAME ())->flush_display_optional)
FRAME_RIF (SELECTED_FRAME ())->flush_display_optional (SELECTED_FRAME ());
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
the rest of the redisplay algorithm is about the same as
windows_or_buffers_changed anyway. */
if (windows_or_buffers_changed
- || !NILP (w->update_mode_line)
+ || w->update_mode_line
|| update_mode_lines
|| ((BUF_SAVE_MODIFF (XBUFFER (w->buffer))
< BUF_MODIFF (XBUFFER (w->buffer)))
- != !NILP (w->last_had_star))
+ != w->last_had_star)
|| ((!NILP (Vtransient_mark_mode)
&& !NILP (BVAR (XBUFFER (w->buffer), mark_active)))
!= !NILP (w->region_showing)))
{
struct buffer *prev = current_buffer;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object frame, new_tool_bar;
int new_n_tool_bar;
struct gcpro gcpro1;
selected_frame = frame;
/* Build desired tool-bar items from keymaps. */
- new_tool_bar = tool_bar_items (Fcopy_sequence (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
/* 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;
- f->tool_bar_items = new_tool_bar;
+ block_input ();
+ fset_tool_bar_items (f, new_tool_bar);
f->n_tool_bar_items = new_n_tool_bar;
- w->update_mode_line = Qt;
- UNBLOCK_INPUT;
+ w->update_mode_line = 1;
+ unblock_input ();
}
UNGCPRO;
/* Reuse f->desired_tool_bar_string, if possible. */
if (size < size_needed || NILP (f->desired_tool_bar_string))
- f->desired_tool_bar_string = Fmake_string (make_number (size_needed),
- make_number (' '));
+ fset_desired_tool_bar_string
+ (f, Fmake_string (make_number (size_needed), make_number (' ')));
else
{
props = list4 (Qdisplay, Qnil, Qmenu_item, Qnil);
is the index of the item in F's tool-bar item vector. */
for (i = 0; i < f->n_tool_bar_items; ++i)
{
-#define PROP(IDX) AREF (f->tool_bar_items, i * TOOL_BAR_ITEM_NSLOTS + (IDX))
+#define PROP(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));
? TOOL_BAR_IMAGE_DISABLED_SELECTED
: TOOL_BAR_IMAGE_DISABLED_DESELECTED);
- xassert (ASIZE (image) >= idx);
+ eassert (ASIZE (image) >= idx);
image = AREF (image, idx);
}
else
: DEFAULT_TOOL_BAR_BUTTON_RELIEF);
hmargin = vmargin = relief;
- if (INTEGERP (Vtool_bar_button_margin)
- && XINT (Vtool_bar_button_margin) > 0)
+ if (RANGED_INTEGERP (1, Vtool_bar_button_margin,
+ INT_MAX - max (hmargin, vmargin)))
{
hmargin += XFASTINT (Vtool_bar_button_margin);
vmargin += XFASTINT (Vtool_bar_button_margin);
}
else if (CONSP (Vtool_bar_button_margin))
{
- if (INTEGERP (XCAR (Vtool_bar_button_margin))
- && XINT (XCAR (Vtool_bar_button_margin)) > 0)
+ if (RANGED_INTEGERP (1, XCAR (Vtool_bar_button_margin),
+ INT_MAX - hmargin))
hmargin += XFASTINT (XCAR (Vtool_bar_button_margin));
- if (INTEGERP (XCDR (Vtool_bar_button_margin))
- && XINT (XCDR (Vtool_bar_button_margin)) > 0)
+ if (RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin),
+ INT_MAX - vmargin))
vmargin += XFASTINT (XCDR (Vtool_bar_button_margin));
}
{
int border, rows, height, extra;
- if (INTEGERP (Vtool_bar_border))
+ if (TYPE_RANGED_INTEGERP (int, Vtool_bar_border))
border = XINT (Vtool_bar_border);
else if (EQ (Vtool_bar_border, Qinternal_border_width))
border = FRAME_INTERNAL_BORDER_WIDTH (f);
void
handle_tool_bar_click (struct frame *f, int x, int y, int down_p,
- unsigned int modifiers)
+ int modifiers)
{
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
struct window *w = XWINDOW (f->tool_bar_window);
hscroll_step_abs = 0;
}
}
- else if (INTEGERP (Vhscroll_step))
+ else if (TYPE_RANGED_INTEGERP (int, Vhscroll_step))
{
hscroll_step_abs = XINT (Vhscroll_step);
if (hscroll_step_abs < 0)
inside the left margin and the window is already
hscrolled. */
&& ((!row_r2l_p
- && ((XFASTINT (w->hscroll)
+ && ((w->hscroll
&& w->cursor.x <= h_margin)
|| (cursor_row->enabled_p
&& cursor_row->truncated_on_right_p
are actually truncated on the left. */
&& cursor_row->truncated_on_right_p
&& w->cursor.x <= h_margin)
- || (XFASTINT (w->hscroll)
+ || (w->hscroll
&& (w->cursor.x >= text_area_width - h_margin))))))
{
struct it it;
- int hscroll;
+ ptrdiff_t hscroll;
struct buffer *saved_current_buffer;
- EMACS_INT pt;
+ ptrdiff_t pt;
int wanted_x;
/* Find point in a display of infinite width. */
hscroll
= max (0, it.current_x - wanted_x) / FRAME_COLUMN_WIDTH (it.f);
}
- hscroll = max (hscroll, XFASTINT (w->min_hscroll));
+ hscroll = max (hscroll, w->min_hscroll);
/* Don't prevent redisplay optimizations if hscroll
hasn't changed, as it will unnecessarily slow down
redisplay. */
- if (XFASTINT (w->hscroll) != hscroll)
+ if (w->hscroll != hscroll)
{
XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1;
- w->hscroll = make_number (hscroll);
+ w->hscroll = hscroll;
hscrolled_p = 1;
}
}
to a non-zero value. This is sometimes handy to have in a debugger
session. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* First and last unchanged row for try_window_id. */
/* Delta in characters and bytes for try_window_id. */
-static EMACS_INT debug_delta, debug_delta_bytes;
+static ptrdiff_t debug_delta, debug_delta_bytes;
/* Values of window_end_pos and window_end_vpos at the end of
try_window_id. */
-static EMACS_INT debug_end_vpos;
+static ptrdiff_t debug_end_vpos;
/* Append a string to W->desired_matrix->method. FMT is a printf
format string. If trace_redisplay_p is non-zero also printf the
static void
debug_method_add (struct window *w, char const *fmt, ...)
{
- char buffer[512];
char *method = w->desired_matrix->method;
int len = strlen (method);
int size = sizeof w->desired_matrix->method;
int remaining = size - len - 1;
va_list ap;
- va_start (ap, fmt);
- vsprintf (buffer, fmt, ap);
- va_end (ap);
if (len && remaining)
{
method[len] = '|';
--remaining, ++len;
}
- strncpy (method + len, buffer, remaining);
+ va_start (ap, fmt);
+ vsnprintf (method + len, remaining + 1, fmt, ap);
+ va_end (ap);
if (trace_redisplay_p)
fprintf (stderr, "%p (%s): %s\n",
&& STRINGP (BVAR (XBUFFER (w->buffer), name)))
? SSDATA (BVAR (XBUFFER (w->buffer), name))
: "no buffer"),
- buffer);
+ method + len);
}
#endif /* GLYPH_DEBUG */
static inline int
text_outside_line_unchanged_p (struct window *w,
- EMACS_INT start, EMACS_INT end)
+ ptrdiff_t start, ptrdiff_t end)
{
int unchanged_p = 1;
/* If text or overlays have changed, see where. */
- if (XFASTINT (w->last_modified) < MODIFF
- || XFASTINT (w->last_overlay_modified) < OVERLAY_MODIFF)
+ if (w->last_modified < MODIFF
+ || w->last_overlay_modified < OVERLAY_MODIFF)
{
/* Gap in the line? */
if (GPT < start || Z - GPT < end)
return make_number (fringe_bitmap);
}
#endif
- return make_number (-1); /* Use default arrow bitmap */
+ return make_number (-1); /* Use default arrow bitmap. */
}
return overlay_arrow_string_or_property (var);
}
position. BUF and PT are the current point buffer and position. */
static int
-check_point_in_composition (struct buffer *prev_buf, EMACS_INT prev_pt,
- struct buffer *buf, EMACS_INT pt)
+check_point_in_composition (struct buffer *prev_buf, ptrdiff_t prev_pt,
+ struct buffer *buf, ptrdiff_t pt)
{
- EMACS_INT start, end;
+ ptrdiff_t start, end;
Lisp_Object prop;
Lisp_Object buffer;
if (!b->clip_changed
&& BUFFERP (w->buffer) && !NILP (w->window_end_valid))
{
- EMACS_INT pt;
+ ptrdiff_t pt;
if (w == XWINDOW (selected_window))
pt = PT;
pt = marker_position (w->pointm);
if ((w->current_matrix->buffer != XBUFFER (w->buffer)
- || pt != XINT (w->last_point))
+ || pt != w->last_point)
&& check_point_in_composition (w->current_matrix->buffer,
- XINT (w->last_point),
+ w->last_point,
XBUFFER (w->buffer), pt))
b->clip_changed = 1;
}
Lisp_Object old = selected_frame;
struct Lisp_Symbol *sym;
- xassert (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)));
+ eassert (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame)));
selected_frame = frame;
do {
- for (tail = XFRAME (frame)->param_alist; CONSP (tail); tail = XCDR (tail))
+ for (tail = XFRAME (frame)->param_alist;
+ CONSP (tail); tail = XCDR (tail))
if (CONSP (XCAR (tail))
&& (tem = XCAR (XCAR (tail)),
SYMBOLP (tem))
int must_finish = 0;
struct text_pos tlbufpos, tlendpos;
int number_of_visible_frames;
- int count, count1;
+ ptrdiff_t count, count1;
struct frame *sf;
int polling_stopped_here = 0;
Lisp_Object old_frame = selected_frame;
+ struct backtrace backtrace;
/* Non-zero means redisplay has to consider all windows on all
frames. Zero means, only selected_window is considered. */
int consider_all_windows_p;
+ /* Non-zero means redisplay has to redisplay the miniwindow. */
+ int update_miniwindow_p = 0;
+
TRACE ((stderr, "redisplay_internal %d\n", redisplaying_p));
/* No redisplay if running in batch mode or frame is not yet fully
if (redisplaying_p)
return;
- /* Record a function that resets redisplaying_p to its old value
+ /* Record a function that clears redisplaying_p
when we leave this function. */
count = SPECPDL_INDEX ();
- record_unwind_protect (unwind_redisplay,
- Fcons (make_number (redisplaying_p), selected_frame));
- ++redisplaying_p;
+ record_unwind_protect (unwind_redisplay, selected_frame);
+ redisplaying_p = 1;
specbind (Qinhibit_free_realized_faces, Qnil);
+ /* Record this function, so it appears on the profiler's backtraces. */
+ backtrace.next = backtrace_list;
+ backtrace.function = &Qredisplay_internal;
+ backtrace.args = &Qredisplay_internal;
+ backtrace.nargs = 0;
+ backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
+
{
Lisp_Object tail, frame;
update_mode_lines++;
/* Detect case that we need to write or remove a star in the mode line. */
- if ((SAVE_MODIFF < MODIFF) != !NILP (w->last_had_star))
+ if ((SAVE_MODIFF < MODIFF) != w->last_had_star)
{
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
if (buffer_shared > 1)
update_mode_lines++;
}
if (!NILP (w->column_number_displayed)
/* This alternative quickly identifies a common case
where no change is needed. */
- && !(PT == XFASTINT (w->last_point)
- && XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF)
+ && !(PT == w->last_point
+ && w->last_modified >= MODIFF
+ && w->last_overlay_modified >= OVERLAY_MODIFF)
&& (XFASTINT (w->column_number_displayed) != current_column ()))
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
unbind_to (count1, Qnil);
&& !MINI_WINDOW_P (XWINDOW (selected_window))))
{
int window_height_changed_p = echo_area_display (0);
+
+ if (message_cleared_p)
+ update_miniwindow_p = 1;
+
must_finish = 1;
/* If we don't display the current message, don't clear the
}
else if (EQ (selected_window, minibuf_window)
&& (current_buffer->clip_changed
- || XFASTINT (w->last_modified) < MODIFF
- || XFASTINT (w->last_overlay_modified) < OVERLAY_MODIFF)
+ || w->last_modified < MODIFF
+ || w->last_overlay_modified < OVERLAY_MODIFF)
&& resize_mini_window (w, 0))
{
/* Resized active mini-window to fit the size of what it is
/* FIXME: this causes all frames to be updated, which seems unnecessary
since only the current frame needs to be considered. This function needs
to be rewritten with two variables, consider_all_windows and
- consider_all_frames. */
+ consider_all_frames. */
consider_all_windows_p = 1;
++windows_or_buffers_changed;
++update_mode_lines;
tlendpos = this_line_end_pos;
if (!consider_all_windows_p
&& CHARPOS (tlbufpos) > 0
- && NILP (w->update_mode_line)
+ && !w->update_mode_line
&& !current_buffer->clip_changed
&& !current_buffer->prevent_redisplay_optimizations_p
&& FRAME_VISIBLE_P (XFRAME (w->frame))
/* Make sure recorded data applies to current buffer, etc. */
&& this_line_buffer == current_buffer
&& current_buffer == XBUFFER (w->buffer)
- && NILP (w->force_start)
- && NILP (w->optional_new_start)
+ && !w->force_start
+ && !w->optional_new_start
/* Point must be on the line that we have info recorded about. */
&& PT >= CHARPOS (tlbufpos)
&& PT <= Z - CHARPOS (tlendpos)
|| FETCH_BYTE (BYTEPOS (tlbufpos)) == '\n'))
/* Former continuation line has disappeared by becoming empty. */
goto cancel;
- else if (XFASTINT (w->last_modified) < MODIFF
- || XFASTINT (w->last_overlay_modified) < OVERLAY_MODIFF
+ else if (w->last_modified < MODIFF
+ || w->last_overlay_modified < OVERLAY_MODIFF
|| MINI_WINDOW_P (w))
{
/* We have to handle the case of continuation around a
{
struct glyph_row *row
= MATRIX_ROW (w->current_matrix, this_line_vpos + 1);
- EMACS_INT delta, delta_bytes;
+ ptrdiff_t delta, delta_bytes;
/* We used to distinguish between two cases here,
conditioned by Z - CHARPOS (tlendpos) == ZV, for
if ((it.glyph_row - 1)->displays_text_p)
{
if (XFASTINT (w->window_end_vpos) < this_line_vpos)
- XSETINT (w->window_end_vpos, this_line_vpos);
+ wset_window_end_vpos (w, make_number (this_line_vpos));
}
else if (XFASTINT (w->window_end_vpos) == this_line_vpos
&& this_line_vpos > 0)
- XSETINT (w->window_end_vpos, this_line_vpos - 1);
- w->window_end_valid = Qnil;
+ wset_window_end_vpos (w, make_number (this_line_vpos - 1));
+ wset_window_end_valid (w, Qnil);
/* Update hint: No need to try to scroll in update_window. */
w->desired_matrix->no_scrolling_p = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
*w->desired_matrix->method = 0;
debug_method_add (w, "optimization 1");
#endif
goto cancel;
}
else if (/* Cursor position hasn't changed. */
- PT == XFASTINT (w->last_point)
+ PT == w->last_point
/* Make sure the cursor was last displayed
in this window. Otherwise we have to reposition it. */
&& 0 <= w->cursor.vpos
then we can't just move the cursor. */
else if (! (!NILP (Vtransient_mark_mode)
&& !NILP (BVAR (current_buffer, mark_active)))
- && (EQ (selected_window, BVAR (current_buffer, last_selected_window))
+ && (EQ (selected_window,
+ BVAR (current_buffer, last_selected_window))
|| highlight_nonselected_windows)
&& NILP (w->region_showing)
&& NILP (Vshow_trailing_whitespace)
&& (row = MATRIX_ROW (w->current_matrix, this_line_vpos),
row->enabled_p))
{
- xassert (this_line_vpos == it.vpos);
- xassert (this_line_y == it.current_y);
+ eassert (this_line_vpos == it.vpos);
+ eassert (this_line_y == it.current_y);
set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
*w->desired_matrix->method = 0;
debug_method_add (w, "optimization 3");
#endif
{
struct frame *f = XFRAME (frame);
+ /* We don't have to do anything for unselected terminal
+ frames. */
+ if ((FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
+ && !EQ (FRAME_TTY (f)->top_frame, frame))
+ continue;
+
if (FRAME_WINDOW_P (f) || FRAME_TERMCAP_P (f) || f == sf)
{
if (! EQ (frame, selected_frame))
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 (XFRAME (selected_frame)->selected_window, selected_window));
+ eassert (EQ (XFRAME (selected_frame)->selected_window,
+ selected_window));
if (!pending)
{
}
else if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf))
{
- Lisp_Object mini_window;
+ Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf);
struct frame *mini_frame;
displayed_buffer = XBUFFER (XWINDOW (selected_window)->buffer);
internal_condition_case_1 (redisplay_window_1, selected_window,
list_of_error,
redisplay_window_error);
+ if (update_miniwindow_p)
+ internal_condition_case_1 (redisplay_window_1, mini_window,
+ list_of_error,
+ redisplay_window_error);
/* Compare desired and current matrices, perform output. */
#endif /* HAVE_WINDOW_SYSTEM */
end_of_redisplay:
+ backtrace_list = backtrace.next;
unbind_to (count, Qnil);
RESUME_POLLING;
}
}
-/* Function registered with record_unwind_protect in
- redisplay_internal. Reset redisplaying_p to the value it had
- before redisplay_internal was called, and clear
- prevent_freeing_realized_faces_p. It also selects the previously
+/* Function registered with record_unwind_protect in redisplay_internal.
+ Clear redisplaying_p. Also, select the previously
selected frame, unless it has been deleted (by an X connection
failure during redisplay, for example). */
static Lisp_Object
-unwind_redisplay (Lisp_Object val)
+unwind_redisplay (Lisp_Object old_frame)
{
- Lisp_Object old_redisplaying_p, old_frame;
-
- old_redisplaying_p = XCAR (val);
- redisplaying_p = XFASTINT (old_redisplaying_p);
- old_frame = XCDR (val);
+ redisplaying_p = 0;
if (! EQ (old_frame, selected_frame)
&& FRAME_LIVE_P (XFRAME (old_frame)))
select_frame_for_redisplay (old_frame);
{
struct buffer *b = XBUFFER (w->buffer);
- w->last_modified
- = make_number (accurate_p ? BUF_MODIFF (b) : 0);
- w->last_overlay_modified
- = make_number (accurate_p ? BUF_OVERLAY_MODIFF (b) : 0);
+ w->last_modified = accurate_p ? BUF_MODIFF(b) : 0;
+ w->last_overlay_modified = accurate_p ? BUF_OVERLAY_MODIFF(b) : 0;
w->last_had_star
- = BUF_MODIFF (b) > BUF_SAVE_MODIFF (b) ? Qt : Qnil;
+ = BUF_MODIFF (b) > BUF_SAVE_MODIFF (b);
if (accurate_p)
{
w->last_cursor_off_p = w->cursor_off_p;
if (w == XWINDOW (selected_window))
- w->last_point = make_number (BUF_PT (b));
+ w->last_point = BUF_PT (b);
else
- w->last_point = make_number (XMARKER (w->pointm)->charpos);
+ w->last_point = XMARKER (w->pointm)->charpos;
}
}
if (accurate_p)
{
- w->window_end_valid = w->buffer;
- w->update_mode_line = Qnil;
+ wset_window_end_valid (w, w->buffer);
+ w->update_mode_line = 0;
}
}
static int
set_cursor_from_row (struct window *w, struct glyph_row *row,
struct glyph_matrix *matrix,
- EMACS_INT delta, EMACS_INT delta_bytes,
+ ptrdiff_t delta, ptrdiff_t delta_bytes,
int dy, int dvpos)
{
struct glyph *glyph = row->glyphs[TEXT_AREA];
struct glyph *end = glyph + row->used[TEXT_AREA];
struct glyph *cursor = NULL;
/* The last known character position in row. */
- EMACS_INT last_pos = MATRIX_ROW_START_CHARPOS (row) + delta;
+ ptrdiff_t last_pos = MATRIX_ROW_START_CHARPOS (row) + delta;
int x = row->x;
- EMACS_INT pt_old = PT - delta;
- EMACS_INT pos_before = MATRIX_ROW_START_CHARPOS (row) + delta;
- EMACS_INT pos_after = MATRIX_ROW_END_CHARPOS (row) + delta;
+ ptrdiff_t pt_old = PT - delta;
+ ptrdiff_t pos_before = MATRIX_ROW_START_CHARPOS (row) + delta;
+ ptrdiff_t pos_after = MATRIX_ROW_END_CHARPOS (row) + delta;
struct glyph *glyph_before = glyph - 1, *glyph_after = end;
/* A glyph beyond the edge of TEXT_AREA which we should never
touch. */
int string_seen = 0;
/* Largest and smallest buffer positions seen so far during scan of
glyph row. */
- EMACS_INT bpos_max = pos_before;
- EMACS_INT bpos_min = pos_after;
+ ptrdiff_t bpos_max = pos_before;
+ ptrdiff_t bpos_min = pos_after;
/* Last buffer position covered by an overlay string with an integer
`cursor' property. */
- EMACS_INT bpos_covered = 0;
+ ptrdiff_t bpos_covered = 0;
/* Non-zero means the display string on which to display the cursor
comes from a text property, not from an overlay. */
int string_from_text_prop = 0;
/* Don't even try doing anything if called for a mode-line or
header-line row, since the rest of the code isn't prepared to
deal with such calamities. */
- xassert (!row->mode_line_p);
+ eassert (!row->mode_line_p);
if (row->mode_line_p)
return 0;
{
if (BUFFERP (glyph->object))
{
- EMACS_INT dpos = glyph->charpos - pt_old;
+ ptrdiff_t dpos = glyph->charpos - pt_old;
if (glyph->charpos > bpos_max)
bpos_max = glyph->charpos;
break;
}
/* See if we've found a better approximation to
- POS_BEFORE or to POS_AFTER. Note that we want the
- first (leftmost) glyph of all those that are the
- closest from below, and the last (rightmost) of all
- those from above. */
+ POS_BEFORE or to POS_AFTER. */
if (0 > dpos && dpos > pos_before - pt_old)
{
pos_before = glyph->charpos;
glyph_before = glyph;
}
- else if (0 < dpos && dpos <= pos_after - pt_old)
+ else if (0 < dpos && dpos < pos_after - pt_old)
{
pos_after = glyph->charpos;
glyph_after = glyph;
else if (STRINGP (glyph->object))
{
Lisp_Object chprop;
- EMACS_INT glyph_pos = glyph->charpos;
+ ptrdiff_t glyph_pos = glyph->charpos;
chprop = Fget_char_property (make_number (glyph_pos), Qcursor,
glyph->object);
text is completely covered by display properties,
so that no glyph with valid buffer positions is
ever seen in the row. */
- EMACS_INT prop_pos =
+ ptrdiff_t prop_pos =
string_buffer_position_lim (glyph->object, pos_before,
pos_after, 0);
{
if (BUFFERP (glyph->object))
{
- EMACS_INT dpos = glyph->charpos - pt_old;
+ ptrdiff_t dpos = glyph->charpos - pt_old;
if (glyph->charpos > bpos_max)
bpos_max = glyph->charpos;
pos_before = glyph->charpos;
glyph_before = glyph;
}
- else if (0 < dpos && dpos <= pos_after - pt_old)
+ else if (0 < dpos && dpos < pos_after - pt_old)
{
pos_after = glyph->charpos;
glyph_after = glyph;
else if (STRINGP (glyph->object))
{
Lisp_Object chprop;
- EMACS_INT glyph_pos = glyph->charpos;
+ ptrdiff_t glyph_pos = glyph->charpos;
chprop = Fget_char_property (make_number (glyph_pos), Qcursor,
glyph->object);
if (!NILP (chprop))
{
- EMACS_INT prop_pos =
+ ptrdiff_t prop_pos =
string_buffer_position_lim (glyph->object, pos_before,
pos_after, 0);
if (row->ends_in_ellipsis_p && pos_after == last_pos)
{
- EMACS_INT ellipsis_pos;
+ ptrdiff_t ellipsis_pos;
/* Scan back over the ellipsis glyphs. */
if (!row->reversed_p)
positioned between POS_BEFORE and POS_AFTER in the
buffer. */
struct glyph *start, *stop;
- EMACS_INT pos = pos_before;
+ ptrdiff_t pos = pos_before;
x = -1;
if (STRINGP (glyph->object))
{
Lisp_Object str;
- EMACS_INT tem;
+ ptrdiff_t tem;
/* If the display property covers the newline, we
need to search for it one position farther. */
- EMACS_INT lim = pos_after
+ ptrdiff_t lim = pos_after
+ (pos_after == MATRIX_ROW_END_CHARPOS (row) + delta);
string_from_text_prop = 0;
|| pos <= tem)
{
/* If the string from which this glyph came is
- found in the buffer at point, then we've
- found the glyph we've been looking for. If
- it comes from an overlay (tem == 0), and it
- has the `cursor' property on one of its
+ found in the buffer at point, or at position
+ that is closer to point than pos_after, then
+ we've found the glyph we've been looking for.
+ If it comes from an overlay (tem == 0), and
+ it has the `cursor' property on one of its
glyphs, record that glyph as a candidate for
displaying the cursor. (As in the
unidirectional version, we will display the
cursor on the last candidate we find.) */
- if (tem == 0 || tem == pt_old)
+ if (tem == 0
+ || tem == pt_old
+ || (tem - pt_old > 0 && tem < pos_after))
{
/* The glyphs from this string could have
been reordered. Find the one with the
be a character in the string with the
`cursor' property, which means display
cursor on that character's glyph. */
- EMACS_INT strpos = glyph->charpos;
+ ptrdiff_t strpos = glyph->charpos;
if (tem)
{
glyph += incr)
{
Lisp_Object cprop;
- EMACS_INT gpos = glyph->charpos;
+ ptrdiff_t gpos = glyph->charpos;
cprop = Fget_char_property (make_number (gpos),
Qcursor,
}
}
- if (tem == pt_old)
+ if (tem == pt_old
+ || (tem - pt_old > 0 && tem < pos_after))
goto compute_x;
}
if (tem)
the cursor is not on this line. */
if (cursor == NULL
&& (row->reversed_p ? glyph <= end : glyph >= end)
+ && (row->reversed_p ? end > glyphs_end : end < glyphs_end)
&& STRINGP (end->object)
&& row->continued_p)
return 0;
compute_x:
if (cursor != NULL)
glyph = cursor;
+ else if (glyph == glyphs_end
+ && pos_before == pos_after
+ && STRINGP ((row->reversed_p
+ ? row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1
+ : row->glyphs[TEXT_AREA])->object))
+ {
+ /* If all the glyphs of this row came from strings, put the
+ cursor on the first glyph of the row. This avoids having the
+ cursor outside of the text area in this very rare and hard
+ use case. */
+ glyph =
+ row->reversed_p
+ ? row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1
+ : row->glyphs[TEXT_AREA];
+ }
if (x < 0)
{
struct glyph *g;
for (g = row->glyphs[TEXT_AREA], x = row->x; g < glyph; g++)
{
if (g >= row->glyphs[TEXT_AREA] + row->used[TEXT_AREA])
- abort ();
+ emacs_abort ();
x += g->pixel_width;
}
}
SET_MARKER_FROM_TEXT_POS (w->start, startp);
if (current_buffer != XBUFFER (w->buffer))
- abort ();
+ emacs_abort ();
if (!NILP (Vwindow_scroll_functions))
{
make_number (CHARPOS (startp)));
SET_TEXT_POS_FROM_MARKER (startp, w->start);
/* In case the hook functions switch buffers. */
- if (current_buffer != XBUFFER (w->buffer))
- set_buffer_internal_1 (XBUFFER (w->buffer));
+ set_buffer_internal (XBUFFER (w->buffer));
}
return startp;
static int
try_scrolling (Lisp_Object window, int just_this_one_p,
- EMACS_INT arg_scroll_conservatively, EMACS_INT scroll_step,
+ ptrdiff_t arg_scroll_conservatively, ptrdiff_t scroll_step,
int temp_scroll_step, int last_line_misfit)
{
struct window *w = XWINDOW (window);
/* We will never try scrolling more than this number of lines. */
int scroll_limit = SCROLL_LIMIT;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "try_scrolling");
#endif
if (!just_this_one_p
|| current_buffer->clip_changed
|| BEG_UNCHANGED < CHARPOS (startp))
- w->base_line_number = Qnil;
+ wset_base_line_number (w, Qnil);
/* If cursor ends up on a partially visible line,
treat that as being off the bottom of the screen. */
struct frame *f = XFRAME (w->frame);
int rc = CURSOR_MOVEMENT_CANNOT_BE_USED;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
if (inhibit_try_cursor_movement)
return rc;
#endif
+ /* Previously, there was a check for Lisp integer in the
+ if-statement below. Now, this field is converted to
+ ptrdiff_t, thus zero means invalid position in a buffer. */
+ eassert (w->last_point > 0);
+
/* Handle case where text has not changed, only point, and it has
not moved off the frame. */
if (/* Point may be in this window. */
&& !NILP (BVAR (current_buffer, mark_active)))
&& NILP (w->region_showing)
&& NILP (Vshow_trailing_whitespace)
- /* Right after splitting windows, last_point may be nil. */
- && INTEGERP (w->last_point)
/* This code is not used for mini-buffer for the sake of the case
of redisplaying to replace an echo area message; since in
that case the mini-buffer contents per se are usually
int this_scroll_margin, top_scroll_margin;
struct glyph_row *row = NULL;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "cursor movement");
#endif
int scroll_p = 0, must_scroll = 0;
int last_y = window_text_bottom_y (w) - this_scroll_margin;
- if (PT > XFASTINT (w->last_point))
+ if (PT > w->last_point)
{
/* Point has moved forward. */
while (MATRIX_ROW_END_CHARPOS (row) < PT
&& MATRIX_ROW_BOTTOM_Y (row) < last_y)
{
- xassert (row->enabled_p);
+ eassert (row->enabled_p);
++row;
}
&& !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (row)))
scroll_p = 1;
}
- else if (PT < XFASTINT (w->last_point))
+ else if (PT < w->last_point)
{
/* Cursor has to be moved backward. Note that PT >=
CHARPOS (startp) because of the outer if-statement. */
&& (row->y > top_scroll_margin
|| CHARPOS (startp) == BEGV))
{
- xassert (row->enabled_p);
+ eassert (row->enabled_p);
--row;
}
rc = CURSOR_MOVEMENT_MUST_SCROLL;
break;
}
- xassert (row->enabled_p);
+ eassert (row->enabled_p);
}
}
if (must_scroll)
MATRIX_ROW (w->current_matrix, w->cursor.vpos);
struct glyph *g =
candidate->glyphs[TEXT_AREA] + w->cursor.hpos;
- EMACS_INT endpos = MATRIX_ROW_END_CHARPOS (candidate);
+ ptrdiff_t endpos = MATRIX_ROW_END_CHARPOS (candidate);
exact_match_p =
(BUFFERP (g->object) && g->charpos == PT)
void
set_vertical_scroll_bar (struct window *w)
{
- EMACS_INT start, end, whole;
+ ptrdiff_t start, end, whole;
/* Calculate the start and end positions for the current window.
At some point, it would be nice to choose between scrollbars
selected_window is redisplayed.
We can return without actually redisplaying the window if
- fonts_changed_p is nonzero. In that case, redisplay_internal will
+ fonts_changed_p. In that case, redisplay_internal will
retry. */
static void
It indicates that the buffer contents and narrowing are unchanged. */
int buffer_unchanged_p = 0;
int temp_scroll_step = 0;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int rc;
int centering_position = -1;
int last_line_misfit = 0;
- EMACS_INT beg_unchanged, end_unchanged;
+ ptrdiff_t beg_unchanged, end_unchanged;
SET_TEXT_POS (lpoint, PT, PT_BYTE);
opoint = lpoint;
/* W must be a leaf window here. */
- xassert (!NILP (w->buffer));
-#if GLYPH_DEBUG
+ eassert (!NILP (w->buffer));
+#ifdef GLYPH_DEBUG
*w->desired_matrix->method = 0;
#endif
reconsider_clip_changes (w, buffer);
/* Has the mode line to be updated? */
- update_mode_line = (!NILP (w->update_mode_line)
+ update_mode_line = (w->update_mode_line
|| update_mode_lines
|| buffer->clip_changed
|| buffer->prevent_redisplay_optimizations_p);
= (!NILP (w->window_end_valid)
&& !current_buffer->clip_changed
&& !current_buffer->prevent_redisplay_optimizations_p
- && XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF);
+ && w->last_modified >= MODIFF
+ && w->last_overlay_modified >= OVERLAY_MODIFF);
/* Run the window-bottom-change-functions
if it is possible that the text on the screen has changed
buffer_unchanged_p
= (!NILP (w->window_end_valid)
&& !current_buffer->clip_changed
- && XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF);
+ && w->last_modified >= MODIFF
+ && w->last_overlay_modified >= OVERLAY_MODIFF);
/* When windows_or_buffers_changed is non-zero, we can't rely on
the window end being valid, so set it to nil there. */
if (XMARKER (w->start)->buffer == current_buffer)
compute_window_start_on_continuation_line (w);
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
}
/* Some sanity checks. */
CHECK_WINDOW_END (w);
if (Z == Z_BYTE && CHARPOS (opoint) != BYTEPOS (opoint))
- abort ();
+ emacs_abort ();
if (BYTEPOS (opoint) < CHARPOS (opoint))
- abort ();
+ emacs_abort ();
/* If %c is in mode line, update it if needed. */
if (!NILP (w->column_number_displayed)
/* This alternative quickly identifies a common case
where no change is needed. */
- && !(PT == XFASTINT (w->last_point)
- && XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF)
+ && !(PT == w->last_point
+ && w->last_modified >= MODIFF
+ && w->last_overlay_modified >= OVERLAY_MODIFF)
&& (XFASTINT (w->column_number_displayed) != current_column ()))
update_mode_line = 1;
window, set up appropriate value. */
if (!EQ (window, selected_window))
{
- EMACS_INT new_pt = XMARKER (w->pointm)->charpos;
- EMACS_INT new_pt_byte = marker_byte_position (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;
{
struct Lisp_Char_Table *disptab = buffer_display_table ();
- if (! disptab_matches_widthtab (disptab,
- XVECTOR (BVAR (current_buffer, width_table))))
+ if (! disptab_matches_widthtab
+ (disptab, XVECTOR (BVAR (current_buffer, width_table))))
{
invalidate_region_cache (current_buffer,
current_buffer->width_run_cache,
/* If someone specified a new starting point but did not insist,
check whether it can be used. */
- if (!NILP (w->optional_new_start)
+ if (w->optional_new_start
&& CHARPOS (startp) >= BEGV
&& CHARPOS (startp) <= ZV)
{
- w->optional_new_start = Qnil;
+ w->optional_new_start = 0;
start_display (&it, w, startp);
move_it_to (&it, PT, 0, it.last_visible_y, -1,
MOVE_TO_POS | MOVE_TO_X | MOVE_TO_Y);
if (IT_CHARPOS (it) == PT)
- w->force_start = Qt;
+ w->force_start = 1;
/* IT may overshoot PT if text at PT is invisible. */
else if (IT_CHARPOS (it) > PT && CHARPOS (startp) <= PT)
- w->force_start = Qt;
+ w->force_start = 1;
}
force_start:
/* Handle case where place to start displaying has been specified,
unless the specified location is outside the accessible range. */
- if (!NILP (w->force_start)
- || w->frozen_window_start_p)
+ if (w->force_start || w->frozen_window_start_p)
{
/* We set this later on if we have to adjust point. */
int new_vpos = -1;
- w->force_start = Qnil;
+ w->force_start = 0;
w->vscroll = 0;
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
/* Forget any recorded base line for line number display. */
if (!buffer_unchanged_p)
- w->base_line_number = Qnil;
+ wset_base_line_number (w, Qnil);
/* Redisplay the mode line. Select the buffer properly for that.
Also, run the hook window-scroll-functions
|| ! NILP (Vwindow_scroll_functions))
{
update_mode_line = 1;
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
startp = run_window_scroll_functions (window, startp);
}
- w->last_modified = make_number (0);
- w->last_overlay_modified = make_number (0);
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
if (CHARPOS (startp) < BEGV)
SET_TEXT_POS (startp, BEGV, BEGV_BYTE);
else if (CHARPOS (startp) > ZV)
the scroll margin (bug#148) -- cyd */
if (!try_window (window, startp, 0))
{
- w->force_start = Qt;
+ w->force_start = 1;
clear_glyph_matrix (w->desired_matrix);
goto need_larger_matrices;
}
}
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "forced window start");
#endif
goto done;
goto try_to_scroll;
default:
- abort ();
+ emacs_abort ();
}
}
/* If current starting point was originally the beginning of a line
but no longer is, find a new starting point. */
- else if (!NILP (w->start_at_line_beg)
+ else if (w->start_at_line_beg
&& !(CHARPOS (startp) <= BEGV
|| FETCH_BYTE (BYTEPOS (startp) - 1) == '\n'))
{
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "recenter 1");
#endif
goto recenter;
not work. It is 0 if unsuccessful for some other reason. */
else if ((tem = try_window_id (w)) != 0)
{
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "try_window_id %d", tem);
#endif
&& (CHARPOS (startp) < ZV
/* Avoid starting at end of buffer. */
|| CHARPOS (startp) == BEGV
- || (XFASTINT (w->last_modified) >= MODIFF
- && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF)))
+ || (w->last_modified >= MODIFF
+ && w->last_overlay_modified >= OVERLAY_MODIFF)))
{
int d1, d2, d3, d4, d5, d6;
new window start, since that would change the position under
the mouse, resulting in an unwanted mouse-movement rather
than a simple mouse-click. */
- if (NILP (w->start_at_line_beg)
+ if (!w->start_at_line_beg
&& NILP (do_mouse_tracking)
&& CHARPOS (startp) > BEGV
&& CHARPOS (startp) > BEG + beg_unchanged
See bug#9324. */
&& pos_visible_p (w, PT, &d1, &d2, &d3, &d4, &d5, &d6))
{
- w->force_start = Qt;
+ w->force_start = 1;
SET_TEXT_POS_FROM_MARKER (startp, w->start);
goto force_start;
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "same window start");
#endif
|| current_buffer->clip_changed
|| BEG_UNCHANGED < CHARPOS (startp))
/* Forget any recorded base line for line number display. */
- w->base_line_number = Qnil;
+ wset_base_line_number (w, Qnil);
if (!cursor_row_fully_visible_p (w, 1, 0))
{
try_to_scroll:
- w->last_modified = make_number (0);
- w->last_overlay_modified = make_number (0);
+ w->last_modified = 0;
+ w->last_overlay_modified = 0;
/* Redisplay the mode line. Select the buffer properly for that. */
if (!update_mode_line)
{
update_mode_line = 1;
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
}
/* Try to scroll by specified few lines. */
break;
default:
- abort ();
+ emacs_abort ();
}
}
recenter:
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "recenter");
#endif
/* Forget any previously recorded base line for line number display. */
if (!buffer_unchanged_p)
- w->base_line_number = Qnil;
+ wset_base_line_number (w, Qnil);
/* Determine the window start relative to point. */
init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID);
scroll_margin > 0
? min (scroll_margin, WINDOW_TOTAL_LINES (w) / 4)
: 0;
- EMACS_INT margin_pos = CHARPOS (startp);
+ ptrdiff_t margin_pos = CHARPOS (startp);
Lisp_Object aggressive;
int scrolling_up;
}
move_it_vertically_backward (&it, centering_position);
- xassert (IT_CHARPOS (it) >= BEGV);
+ eassert (IT_CHARPOS (it) >= BEGV);
/* The function move_it_vertically_backward may move over more
than the specified y-distance. If it->w is small, e.g. a
done:
SET_TEXT_POS_FROM_MARKER (startp, w->start);
- w->start_at_line_beg = ((CHARPOS (startp) == BEGV
- || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n')
- ? Qt : Qnil);
+ w->start_at_line_beg = (CHARPOS (startp) == BEGV
+ || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n');
/* Display the mode line, if we must. */
if ((update_mode_line
if (!line_number_displayed
&& !BUFFERP (w->base_line_pos))
{
- w->base_line_pos = Qnil;
- w->base_line_number = Qnil;
+ wset_base_line_pos (w, Qnil);
+ wset_base_line_number (w, Qnil);
}
finish_menu_bars:
|| w->pseudo_window_p)))
{
update_begin (f);
- BLOCK_INPUT;
+ block_input ();
if (draw_window_fringes (w, 1))
x_draw_vertical_border (w);
- UNBLOCK_INPUT;
+ unblock_input ();
update_end (f);
}
#endif /* HAVE_WINDOW_SYSTEM */
- /* We go to this label, with fonts_changed_p nonzero,
+ /* We go to this label, with fonts_changed_p set,
if it is necessary to try again using larger glyph matrices.
We have to redeem the scroll bar even in this case,
because the loop in redisplay_internal expects that. */
/* If bottom moved off end of frame, change mode line percentage. */
if (XFASTINT (w->window_end_pos) <= 0
&& Z != IT_CHARPOS (it))
- w->update_mode_line = Qt;
+ w->update_mode_line = 1;
/* Set window_end_pos to the offset of the last character displayed
on the window from the end of current_buffer. Set
window_end_vpos to its row number. */
if (last_text_row)
{
- xassert (MATRIX_ROW_DISPLAYS_TEXT_P (last_text_row));
+ eassert (MATRIX_ROW_DISPLAYS_TEXT_P (last_text_row));
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row);
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row));
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix));
- xassert (MATRIX_ROW (w->desired_matrix, XFASTINT (w->window_end_vpos))
- ->displays_text_p);
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)));
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix)));
+ eassert
+ (MATRIX_ROW (w->desired_matrix,
+ XFASTINT (w->window_end_vpos))->displays_text_p);
}
else
{
w->window_end_bytepos = Z_BYTE - ZV_BYTE;
- w->window_end_pos = make_number (Z - ZV);
- w->window_end_vpos = make_number (0);
+ wset_window_end_pos (w, make_number (Z - ZV));
+ wset_window_end_vpos (w, make_number (0));
}
/* But that is not valid info until redisplay finishes. */
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
return 1;
}
struct glyph_row *start_row;
int start_vpos, min_y, max_y;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
if (inhibit_try_window_reusing)
return 0;
#endif
{
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_reused_text_row);
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_reused_text_row));
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_reused_text_row,
- w->current_matrix));
+ wset_window_end_pos
+ (w, make_number (Z
+ - MATRIX_ROW_END_CHARPOS (last_reused_text_row)));
+ wset_window_end_vpos
+ (w, 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);
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row));
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix));
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)));
+ wset_window_end_vpos
+ (w, 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;
- w->window_end_pos = make_number (Z - ZV);
- w->window_end_vpos = make_number (0);
+ wset_window_end_pos (w, make_number (Z - ZV));
+ wset_window_end_vpos (w, make_number (0));
}
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
/* Update hint: don't try scrolling again in update_window. */
w->desired_matrix->no_scrolling_p = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "try_window_reusing_current_matrix 1");
#endif
return 1;
}
/* Start displaying at the start of first_row_to_display. */
- xassert (first_row_to_display->y < yb);
+ eassert (first_row_to_display->y < yb);
init_to_row_start (&it, w, first_row_to_display);
nrows_scrolled = (MATRIX_ROW_VPOS (first_reusable_row, w->current_matrix)
}
/* Scroll the current matrix. */
- xassert (nrows_scrolled > 0);
+ eassert (nrows_scrolled > 0);
rotate_matrix (w->current_matrix,
start_vpos,
MATRIX_ROW_VPOS (bottom_row, w->current_matrix),
{
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row);
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row));
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix));
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)));
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (last_text_row,
+ w->desired_matrix)));
}
else
{
- w->window_end_vpos
- = make_number (XFASTINT (w->window_end_vpos) - nrows_scrolled);
+ wset_window_end_vpos
+ (w, make_number (XFASTINT (w->window_end_vpos) - nrows_scrolled));
}
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
w->desired_matrix->no_scrolling_p = 1;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
debug_method_add (w, "try_window_reusing_current_matrix 2");
#endif
return 1;
static struct glyph_row *find_last_unchanged_at_beg_row (struct window *);
static struct glyph_row *find_first_unchanged_at_end_row (struct window *,
- EMACS_INT *, EMACS_INT *);
+ ptrdiff_t *, ptrdiff_t *);
static struct glyph_row *
find_last_row_displaying_text (struct glyph_matrix *, struct it *,
struct glyph_row *);
row = start ? start : MATRIX_FIRST_TEXT_ROW (matrix);
while (MATRIX_ROW_DISPLAYS_TEXT_P (row))
{
- xassert (row->enabled_p);
+ eassert (row->enabled_p);
row_found = row;
if (MATRIX_ROW_BOTTOM_Y (row) >= it->last_visible_y)
break;
static struct glyph_row *
find_last_unchanged_at_beg_row (struct window *w)
{
- EMACS_INT first_changed_pos = BEG + BEG_UNCHANGED;
+ ptrdiff_t first_changed_pos = BEG + BEG_UNCHANGED;
struct glyph_row *row;
struct glyph_row *row_found = NULL;
int yb = window_text_bottom_y (w);
static struct glyph_row *
find_first_unchanged_at_end_row (struct window *w,
- EMACS_INT *delta, EMACS_INT *delta_bytes)
+ ptrdiff_t *delta, ptrdiff_t *delta_bytes)
{
struct glyph_row *row;
struct glyph_row *row_found = NULL;
corresponds to window_end_pos. This allows us to translate
buffer positions in the current matrix to current buffer
positions for characters not in changed text. */
- EMACS_INT Z_old =
+ ptrdiff_t Z_old =
MATRIX_ROW_END_CHARPOS (row) + XFASTINT (w->window_end_pos);
- EMACS_INT Z_BYTE_old =
+ ptrdiff_t Z_BYTE_old =
MATRIX_ROW_END_BYTEPOS (row) + w->window_end_bytepos;
- EMACS_INT last_unchanged_pos, last_unchanged_pos_old;
+ ptrdiff_t last_unchanged_pos, last_unchanged_pos_old;
struct glyph_row *first_text_row
= MATRIX_FIRST_TEXT_ROW (w->current_matrix);
/* Preconditions: W must be a leaf window and full-width. Its frame
must have a frame matrix. */
- xassert (NILP (w->hchild) && NILP (w->vchild));
- xassert (WINDOW_FULL_WIDTH_P (w));
- xassert (!FRAME_WINDOW_P (f));
+ eassert (NILP (w->hchild) && NILP (w->vchild));
+ eassert (WINDOW_FULL_WIDTH_P (w));
+ eassert (!FRAME_WINDOW_P (f));
/* If W is a full-width window, glyph pointers in W's current matrix
have, by definition, to be the same as glyph pointers in the
containing CHARPOS or null. */
struct glyph_row *
-row_containing_pos (struct window *w, EMACS_INT charpos,
+row_containing_pos (struct window *w, ptrdiff_t charpos,
struct glyph_row *start, struct glyph_row *end, int dy)
{
struct glyph_row *row = start;
struct glyph_row *best_row = NULL;
- EMACS_INT mindif = BUF_ZV (XBUFFER (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. */
struct glyph_row *bottom_row;
int bottom_vpos;
struct it it;
- EMACS_INT delta = 0, delta_bytes = 0, stop_pos;
+ ptrdiff_t delta = 0, delta_bytes = 0, stop_pos;
int dvpos, dy;
struct text_pos start_pos;
struct run run;
int first_unchanged_at_end_vpos = 0;
struct glyph_row *last_text_row, *last_text_row_at_end;
struct text_pos start;
- EMACS_INT first_changed_charpos, last_changed_charpos;
+ ptrdiff_t first_changed_charpos, last_changed_charpos;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
if (inhibit_try_window_id)
return 0;
#endif
GIVE_UP (5);
/* Another way to prevent redisplay optimizations. */
- if (XFASTINT (w->last_modified) == 0)
+ if (w->last_modified == 0)
GIVE_UP (6);
/* Verify that window is not hscrolled. */
- if (XFASTINT (w->hscroll) != 0)
+ if (w->hscroll != 0)
GIVE_UP (7);
/* Verify that display wasn't paused. */
|| (last_changed_charpos < CHARPOS (start) - 1
&& FETCH_BYTE (BYTEPOS (start) - 1) == '\n')))
{
- EMACS_INT Z_old, Z_delta, Z_BYTE_old, Z_delta_bytes;
+ ptrdiff_t Z_old, Z_delta, Z_BYTE_old, Z_delta_bytes;
struct glyph_row *r0;
/* Compute how many chars/bytes have been added to or removed
if (row)
set_cursor_from_row (w, row, current_matrix, 0, 0, 0, 0);
else
- abort ();
+ emacs_abort ();
return 1;
}
}
{
/* We have to compute the window end anew since text
could have been added/removed after it. */
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (row));
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (row)));
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (row);
if (row)
set_cursor_from_row (w, row, current_matrix, 0, 0, 0, 0);
else
- abort ();
+ emacs_abort ();
return 2;
}
}
it.glyph_row = MATRIX_ROW (desired_matrix, it.vpos);
it.current_y = MATRIX_ROW_BOTTOM_Y (last_unchanged_at_beg_row);
- xassert (it.hpos == 0 && it.current_x == 0);
+ eassert (it.hpos == 0 && it.current_x == 0);
}
else
{
stop_pos = 0;
if (first_unchanged_at_end_row)
{
- xassert (last_unchanged_at_beg_row == NULL
+ eassert (last_unchanged_at_beg_row == NULL
|| first_unchanged_at_end_row >= last_unchanged_at_beg_row);
/* If this is a continuation line, move forward to the next one
+ delta);
first_unchanged_at_end_vpos
= MATRIX_ROW_VPOS (first_unchanged_at_end_row, current_matrix);
- xassert (stop_pos >= Z - END_UNCHANGED);
+ eassert (stop_pos >= Z - END_UNCHANGED);
}
}
else if (last_unchanged_at_beg_row == NULL)
GIVE_UP (19);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Either there is no unchanged row at the end, or the one we have
now displays text. This is a necessary condition for the window
end pos calculation at the end of this function. */
- xassert (first_unchanged_at_end_row == NULL
+ eassert (first_unchanged_at_end_row == NULL
|| MATRIX_ROW_DISPLAYS_TEXT_P (first_unchanged_at_end_row));
debug_last_unchanged_at_beg_vpos
: -1);
debug_first_unchanged_at_end_vpos = first_unchanged_at_end_vpos;
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
/* Display new lines. Set last_text_row to the last new line
{
rotate_matrix (current_matrix, first_unchanged_at_end_vpos + dvpos,
bottom_vpos, dvpos);
- enable_glyph_matrix_rows (current_matrix, bottom_vpos + dvpos,
- bottom_vpos, 0);
+ clear_glyph_matrix_rows (current_matrix, bottom_vpos + dvpos,
+ bottom_vpos);
}
else if (dvpos > 0)
{
rotate_matrix (current_matrix, first_unchanged_at_end_vpos,
bottom_vpos, dvpos);
- enable_glyph_matrix_rows (current_matrix, first_unchanged_at_end_vpos,
- first_unchanged_at_end_vpos + dvpos, 0);
+ clear_glyph_matrix_rows (current_matrix, first_unchanged_at_end_vpos,
+ first_unchanged_at_end_vpos + dvpos);
}
/* For frame-based redisplay, make sure that current frame and window
struct glyph_row *last_row = MATRIX_ROW (current_matrix, last_vpos);
/* If last_row is the window end line, it should display text. */
- xassert (last_row->displays_text_p);
+ eassert (last_row->displays_text_p);
/* If window end line was partially visible before, begin
displaying at that line. Otherwise begin displaying with the
matrix. Set row to the last row displaying text in current
matrix starting at first_unchanged_at_end_row, after
scrolling. */
- xassert (first_unchanged_at_end_row->displays_text_p);
+ eassert (first_unchanged_at_end_row->displays_text_p);
row = find_last_row_displaying_text (w->current_matrix, &it,
first_unchanged_at_end_row);
- xassert (row && MATRIX_ROW_DISPLAYS_TEXT_P (row));
+ eassert (row && MATRIX_ROW_DISPLAYS_TEXT_P (row));
- w->window_end_pos = make_number (Z - MATRIX_ROW_END_CHARPOS (row));
+ wset_window_end_pos (w, make_number (Z - MATRIX_ROW_END_CHARPOS (row)));
w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (row);
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (row, w->current_matrix));
- xassert (w->window_end_bytepos >= 0);
+ wset_window_end_vpos
+ (w, 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)
{
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row_at_end));
+ wset_window_end_pos
+ (w, 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);
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row_at_end, desired_matrix));
- xassert (w->window_end_bytepos >= 0);
+ wset_window_end_vpos
+ (w, 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"));
}
else if (last_text_row)
/* 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. */
- w->window_end_pos
- = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row));
+ wset_window_end_pos
+ (w, make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)));
w->window_end_bytepos
= Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row);
- w->window_end_vpos
- = make_number (MATRIX_ROW_VPOS (last_text_row, desired_matrix));
- xassert (w->window_end_bytepos >= 0);
+ wset_window_end_vpos
+ (w, make_number (MATRIX_ROW_VPOS (last_text_row, desired_matrix)));
+ eassert (w->window_end_bytepos >= 0);
}
else if (first_unchanged_at_end_row == NULL
&& last_text_row == NULL
row = current_row;
}
- xassert (row != NULL);
- w->window_end_vpos = make_number (vpos + 1);
- w->window_end_pos = make_number (Z - MATRIX_ROW_END_CHARPOS (row));
+ eassert (row != NULL);
+ wset_window_end_vpos (w, make_number (vpos + 1));
+ wset_window_end_pos (w, make_number (Z - MATRIX_ROW_END_CHARPOS (row)));
w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (row);
- xassert (w->window_end_bytepos >= 0);
+ eassert (w->window_end_bytepos >= 0);
IF_DEBUG (debug_method_add (w, "C"));
}
else
- abort ();
+ emacs_abort ();
IF_DEBUG (debug_end_pos = XFASTINT (w->window_end_pos);
debug_end_vpos = XFASTINT (w->window_end_vpos));
/* Record that display has not been completed. */
- w->window_end_valid = Qnil;
+ wset_window_end_valid (w, Qnil);
w->desired_matrix->no_scrolling_p = 1;
return 3;
More debugging support
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
void dump_glyph_row (struct glyph_row *, int, int) EXTERNALLY_VISIBLE;
void dump_glyph_matrix (struct glyph_matrix *, int) EXTERNALLY_VISIBLE;
row->visible_height,
row->ascent,
row->phys_ascent);
- fprintf (stderr, "%9d %5d\t%5d\n", row->start.overlay_string_index,
+ fprintf (stderr, "%9"pD"d %5"pD"d\t%5d\n", row->start.overlay_string_index,
row->end.overlay_string_index,
row->continuation_lines_width);
fprintf (stderr, "%9"pI"d %5"pI"d\n",
for (area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area)
{
- char *s = (char *) alloca (row->used[area] + 1);
+ char *s = alloca (row->used[area] + 1);
int i;
for (i = 0; i < row->used[area]; ++i)
w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos);
fprintf (stderr, "=============================================\n");
dump_glyph_matrix (w->current_matrix,
- NILP (glyphs) ? 0 : XINT (glyphs));
+ TYPE_RANGED_INTEGERP (int, glyphs) ? XINT (glyphs) : 0);
return Qnil;
}
(Lisp_Object row, Lisp_Object glyphs)
{
struct glyph_matrix *matrix;
- int vpos;
+ EMACS_INT vpos;
CHECK_NUMBER (row);
matrix = XWINDOW (selected_window)->current_matrix;
if (vpos >= 0 && vpos < matrix->nrows)
dump_glyph_row (MATRIX_ROW (matrix, vpos),
vpos,
- INTEGERP (glyphs) ? XINT (glyphs) : 2);
+ TYPE_RANGED_INTEGERP (int, glyphs) ? XINT (glyphs) : 2);
return Qnil;
}
{
struct frame *sf = SELECTED_FRAME ();
struct glyph_matrix *m = XWINDOW (sf->tool_bar_window)->current_matrix;
- int vpos;
+ EMACS_INT vpos;
CHECK_NUMBER (row);
vpos = XINT (row);
if (vpos >= 0 && vpos < m->nrows)
dump_glyph_row (MATRIX_ROW (m, vpos), vpos,
- INTEGERP (glyphs) ? XINT (glyphs) : 2);
+ TYPE_RANGED_INTEGERP (int, glyphs) ? XINT (glyphs) : 2);
return Qnil;
}
}
-/* Insert truncation glyphs at the start of IT->glyph_row. Truncation
- glyphs are only inserted for terminal frames since we can't really
- win with truncation glyphs when partially visible glyphs are
- involved. Which glyphs to insert is determined by
- produce_special_glyphs. */
+/* Insert truncation glyphs at the start of IT->glyph_row. Which
+ glyphs to insert is determined by produce_special_glyphs. */
static void
insert_left_trunc_glyphs (struct it *it)
struct it truncate_it;
struct glyph *from, *end, *to, *toend;
- xassert (!FRAME_WINDOW_P (it->f));
+ eassert (!FRAME_WINDOW_P (it->f)
+ || (!it->glyph_row->reversed_p
+ && WINDOW_LEFT_FRINGE_WIDTH (it->w) == 0)
+ || (it->glyph_row->reversed_p
+ && WINDOW_RIGHT_FRINGE_WIDTH (it->w) == 0));
/* Get the truncation glyphs. */
truncate_it = *it;
/* Overwrite glyphs from IT with truncation glyphs. */
if (!it->glyph_row->reversed_p)
{
+ short tused = truncate_it.glyph_row->used[TEXT_AREA];
+
from = truncate_it.glyph_row->glyphs[TEXT_AREA];
- end = from + truncate_it.glyph_row->used[TEXT_AREA];
+ end = from + tused;
to = it->glyph_row->glyphs[TEXT_AREA];
toend = to + it->glyph_row->used[TEXT_AREA];
+ if (FRAME_WINDOW_P (it->f))
+ {
+ /* On GUI frames, when variable-size fonts are displayed,
+ the truncation glyphs may need more pixels than the row's
+ glyphs they overwrite. We overwrite more glyphs to free
+ enough screen real estate, and enlarge the stretch glyph
+ on the right (see display_line), if there is one, to
+ preserve the screen position of the truncation glyphs on
+ the right. */
+ int w = 0;
+ struct glyph *g = to;
+ short used;
+
+ /* The first glyph could be partially visible, in which case
+ it->glyph_row->x will be negative. But we want the left
+ truncation glyphs to be aligned at the left margin of the
+ window, so we override the x coordinate at which the row
+ will begin. */
+ it->glyph_row->x = 0;
+ while (g < toend && w < it->truncation_pixel_width)
+ {
+ w += g->pixel_width;
+ ++g;
+ }
+ if (g - to - tused > 0)
+ {
+ memmove (to + tused, g, (toend - g) * sizeof(*g));
+ it->glyph_row->used[TEXT_AREA] -= g - to - tused;
+ }
+ used = it->glyph_row->used[TEXT_AREA];
+ if (it->glyph_row->truncated_on_right_p
+ && WINDOW_RIGHT_FRINGE_WIDTH (it->w) == 0
+ && it->glyph_row->glyphs[TEXT_AREA][used - 2].type
+ == STRETCH_GLYPH)
+ {
+ int extra = w - it->truncation_pixel_width;
+
+ it->glyph_row->glyphs[TEXT_AREA][used - 2].pixel_width += extra;
+ }
+ }
while (from < end)
*to++ = *from++;
/* There may be padding glyphs left over. Overwrite them too. */
- while (to < toend && CHAR_GLYPH_PADDING_P (*to))
+ if (!FRAME_WINDOW_P (it->f))
{
- from = truncate_it.glyph_row->glyphs[TEXT_AREA];
- while (from < end)
- *to++ = *from++;
+ while (to < toend && CHAR_GLYPH_PADDING_P (*to))
+ {
+ from = truncate_it.glyph_row->glyphs[TEXT_AREA];
+ while (from < end)
+ *to++ = *from++;
+ }
}
if (to > toend)
}
else
{
+ short tused = truncate_it.glyph_row->used[TEXT_AREA];
+
/* In R2L rows, overwrite the last (rightmost) glyphs, and do
that back to front. */
end = truncate_it.glyph_row->glyphs[TEXT_AREA];
from = end + truncate_it.glyph_row->used[TEXT_AREA] - 1;
toend = it->glyph_row->glyphs[TEXT_AREA];
to = toend + it->glyph_row->used[TEXT_AREA] - 1;
+ if (FRAME_WINDOW_P (it->f))
+ {
+ int w = 0;
+ struct glyph *g = to;
+
+ while (g >= toend && w < it->truncation_pixel_width)
+ {
+ w += g->pixel_width;
+ --g;
+ }
+ if (to - g - tused > 0)
+ to = g + tused;
+ if (it->glyph_row->truncated_on_right_p
+ && WINDOW_LEFT_FRINGE_WIDTH (it->w) == 0
+ && it->glyph_row->glyphs[TEXT_AREA][1].type == STRETCH_GLYPH)
+ {
+ int extra = w - it->truncation_pixel_width;
+
+ it->glyph_row->glyphs[TEXT_AREA][1].pixel_width += extra;
+ }
+ }
while (from >= end && to >= toend)
*to-- = *from--;
- while (to >= toend && CHAR_GLYPH_PADDING_P (*to))
+ if (!FRAME_WINDOW_P (it->f))
{
- from =
- truncate_it.glyph_row->glyphs[TEXT_AREA]
- + truncate_it.glyph_row->used[TEXT_AREA] - 1;
- while (from >= end && to >= toend)
- *to-- = *from--;
+ while (to >= toend && CHAR_GLYPH_PADDING_P (*to))
+ {
+ from =
+ truncate_it.glyph_row->glyphs[TEXT_AREA]
+ + truncate_it.glyph_row->used[TEXT_AREA] - 1;
+ while (from >= end && to >= toend)
+ *to-- = *from--;
+ }
}
if (from >= end)
{
for (i = 0; i < row->used[TEXT_AREA]; ++i)
row->pixel_width += row->glyphs[TEXT_AREA][i].pixel_width;
- xassert (row->pixel_width >= 0);
- xassert (row->ascent >= 0 && row->height > 0);
+ eassert (row->pixel_width >= 0);
+ eassert (row->ascent >= 0 && row->height > 0);
row->overlapping_p = (MATRIX_ROW_OVERLAPS_SUCC_P (row)
|| MATRIX_ROW_OVERLAPS_PRED_P (row));
trailing whitespace. */
static int
-trailing_whitespace_p (EMACS_INT charpos)
+trailing_whitespace_p (ptrdiff_t charpos)
{
- EMACS_INT bytepos = CHAR_TO_BYTE (charpos);
+ ptrdiff_t bytepos = CHAR_TO_BYTE (charpos);
int c = 0;
while (bytepos < ZV_BYTE
for ( ; glyph >= beg && EQ (glyph->object, s); --glyph)
{
- EMACS_INT gpos = glyph->charpos;
+ ptrdiff_t gpos = glyph->charpos;
if (!NILP (Fget_char_property (make_number (gpos),
Qcursor, s)))
struct text_pos pos =
STRINGP (it->string) ? it->current.string_pos : it->current.pos;
- xassert (it->method == GET_FROM_BUFFER
+ eassert (it->method == GET_FROM_BUFFER
|| it->method == GET_FROM_DISPLAY_VECTOR
|| it->method == GET_FROM_STRING);
{
struct glyph *glyph, *end;
- xassert (it->glyph_row);
- xassert (it->glyph_row->reversed_p);
- xassert (it->area == TEXT_AREA);
- xassert (n <= it->glyph_row->used[TEXT_AREA]);
+ eassert (it->glyph_row);
+ eassert (it->glyph_row->reversed_p);
+ eassert (it->area == TEXT_AREA);
+ eassert (n <= it->glyph_row->used[TEXT_AREA]);
if (n > it->glyph_row->used[TEXT_AREA])
n = it->glyph_row->used[TEXT_AREA];
and ROW->maxpos. */
static void
find_row_edges (struct it *it, struct glyph_row *row,
- EMACS_INT min_pos, EMACS_INT min_bpos,
- EMACS_INT max_pos, EMACS_INT max_bpos)
+ ptrdiff_t min_pos, ptrdiff_t min_bpos,
+ ptrdiff_t max_pos, ptrdiff_t max_bpos)
{
/* FIXME: Revisit this when glyph ``spilling'' in continuation
lines' rows is implemented for bidi-reordered rows. */
/* A line that is entirely from a string/image/stretch... */
row->maxpos = row->minpos;
else
- abort ();
+ emacs_abort ();
}
else
row->maxpos = it->current.pos;
int wrap_row_ascent IF_LINT (= 0), wrap_row_height IF_LINT (= 0);
int wrap_row_phys_ascent IF_LINT (= 0), wrap_row_phys_height IF_LINT (= 0);
int wrap_row_extra_line_spacing IF_LINT (= 0);
- EMACS_INT wrap_row_min_pos IF_LINT (= 0), wrap_row_min_bpos IF_LINT (= 0);
- EMACS_INT wrap_row_max_pos IF_LINT (= 0), wrap_row_max_bpos IF_LINT (= 0);
+ ptrdiff_t wrap_row_min_pos IF_LINT (= 0), wrap_row_min_bpos IF_LINT (= 0);
+ ptrdiff_t wrap_row_max_pos IF_LINT (= 0), wrap_row_max_bpos IF_LINT (= 0);
int cvpos;
- EMACS_INT min_pos = ZV + 1, max_pos = 0;
- EMACS_INT min_bpos IF_LINT (= 0), max_bpos IF_LINT (= 0);
+ ptrdiff_t min_pos = ZV + 1, max_pos = 0;
+ ptrdiff_t min_bpos IF_LINT (= 0), max_bpos IF_LINT (= 0);
/* We always start displaying at hpos zero even if hscrolled. */
- xassert (it->hpos == 0 && it->current_x == 0);
+ eassert (it->hpos == 0 && it->current_x == 0);
if (MATRIX_ROW_VPOS (row, it->w->desired_matrix)
>= it->w->desired_matrix->nrows)
}
/* Is IT->w showing the region? */
- it->w->region_showing = it->region_beg_charpos > 0 ? Qt : Qnil;
+ wset_region_showing (it->w, it->region_beg_charpos > 0 ? Qt : Qnil);
/* Clear the result glyph row and enable it. */
prepare_desired_row (row);
if the first glyph is partially visible or if we hit a line end. */
if (it->current_x < it->first_visible_x)
{
+ enum move_it_result move_result;
+
this_line_min_pos = row->start.pos;
- move_it_in_display_line_to (it, ZV, it->first_visible_x,
- MOVE_TO_POS | MOVE_TO_X);
+ move_result = move_it_in_display_line_to (it, ZV, it->first_visible_x,
+ MOVE_TO_POS | MOVE_TO_X);
+ /* If we are under a large hscroll, move_it_in_display_line_to
+ could hit the end of the line without reaching
+ it->first_visible_x. Pretend that we did reach it. This is
+ especially important on a TTY, where we will call
+ extend_face_to_end_of_line, which needs to know how many
+ blank glyphs to produce. */
+ if (it->current_x < it->first_visible_x
+ && (move_result == MOVE_NEWLINE_OR_CR
+ || move_result == MOVE_POS_MATCH_OR_ZV))
+ it->current_x = it->first_visible_x;
+
/* Record the smallest positions seen while we moved over
display elements that are not visible. This is needed by
redisplay_internal for optimizing the case where the cursor
{ \
int composition_p = !STRINGP ((IT)->string) \
&& ((IT)->what == IT_COMPOSITION); \
- EMACS_INT current_pos = \
+ ptrdiff_t current_pos = \
composition_p ? (IT)->cmp_it.charpos \
: IT_CHARPOS (*(IT)); \
- EMACS_INT current_bpos = \
+ ptrdiff_t current_bpos = \
composition_p ? CHAR_TO_BYTE (current_pos) \
: IT_BYTEPOS (*(IT)); \
if (current_pos < min_pos) \
new_x > it->last_visible_x
/* Or it fits exactly on a window system frame. */
|| (new_x == it->last_visible_x
- && FRAME_WINDOW_P (it->f))))
+ && FRAME_WINDOW_P (it->f)
+ && (row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))))
{
/* End of a continued line. */
if (it->hpos == 0
|| (new_x == it->last_visible_x
- && FRAME_WINDOW_P (it->f)))
+ && FRAME_WINDOW_P (it->f)
+ && (row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))
{
/* Current glyph is the only one on the line or
fits exactly on the line. We must continue
window system frames. We leave the glyph in
this row and let it fill the row, but don't
consume the TAB. */
+ if ((row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0)
+ produce_special_glyphs (it, IT_CONTINUATION);
it->continuation_lines_width += it->last_visible_x;
row->ends_in_middle_of_char_p = 1;
row->continued_p = 1;
row->used[TEXT_AREA] = n_glyphs_before + i;
/* Display continuation glyphs. */
- if (!FRAME_WINDOW_P (it->f))
+ it->current_x = x_before;
+ it->continuation_lines_width += x;
+ if (!FRAME_WINDOW_P (it->f)
+ || (row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0)
produce_special_glyphs (it, IT_CONTINUATION);
row->continued_p = 1;
- it->current_x = x_before;
- it->continuation_lines_width += x;
extend_face_to_end_of_line (it);
if (nglyphs > 1 && i > 0)
move_it_in_display_line at the start of this
function, unless the text display area of the
window is empty. */
- xassert (it->first_visible_x <= it->last_visible_x);
+ eassert (it->first_visible_x <= it->last_visible_x);
}
}
/* Even if this display element produced no glyphs at all,
/* If we truncate lines, we are done when the last displayed
glyphs reach past the right margin of the window. */
if (it->line_wrap == TRUNCATE
- && (FRAME_WINDOW_P (it->f)
+ && (FRAME_WINDOW_P (it->f) && WINDOW_RIGHT_FRINGE_WIDTH (it->w)
? (it->current_x >= it->last_visible_x)
: (it->current_x > it->last_visible_x)))
{
/* Maybe add truncation glyphs. */
- if (!FRAME_WINDOW_P (it->f))
+ if (!FRAME_WINDOW_P (it->f)
+ || (row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (it->w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0)
{
int i, n;
i = row->used[TEXT_AREA] - (i + 1);
}
- for (n = row->used[TEXT_AREA]; i < n; ++i)
+ it->current_x = x_before;
+ if (!FRAME_WINDOW_P (it->f))
+ {
+ for (n = row->used[TEXT_AREA]; i < n; ++i)
+ {
+ row->used[TEXT_AREA] = i;
+ produce_special_glyphs (it, IT_TRUNCATION);
+ }
+ }
+ else
{
row->used[TEXT_AREA] = i;
produce_special_glyphs (it, IT_TRUNCATION);
row->exact_window_width_line_p = 1;
goto at_end_of_line;
}
+ it->current_x = x_before;
}
row->truncated_on_right_p = 1;
reseat_at_next_visible_line_start (it, 0);
row->ends_at_zv_p = FETCH_BYTE (IT_BYTEPOS (*it) - 1) != '\n';
it->hpos = hpos_before;
- it->current_x = x_before;
break;
}
}
if (it->first_visible_x
&& IT_CHARPOS (*it) != CHARPOS (row->start.pos))
{
- if (!FRAME_WINDOW_P (it->f))
+ if (!FRAME_WINDOW_P (it->f)
+ || (row->reversed_p
+ ? WINDOW_RIGHT_FRINGE_WIDTH (it->w)
+ : WINDOW_LEFT_FRINGE_WIDTH (it->w)) == 0)
insert_left_trunc_glyphs (it);
row->truncated_on_left_p = 1;
}
}
else
{
- xassert (INTEGERP (overlay_arrow_string));
+ eassert (INTEGERP (overlay_arrow_string));
row->overlay_arrow_bitmap = XINT (overlay_arrow_string);
}
overlay_arrow_seen = 1;
use current_matrix if it is up to date, but this seems fast
enough as it is. */
struct bidi_it itb;
- EMACS_INT pos = BUF_PT (buf);
- EMACS_INT bytepos = BUF_PT_BYTE (buf);
+ ptrdiff_t pos = BUF_PT (buf);
+ ptrdiff_t bytepos = BUF_PT_BYTE (buf);
int c;
void *itb_data = bidi_shelve_cache ();
return Qright_to_left;
break;
default:
- abort ();
+ emacs_abort ();
}
}
}
#endif /* HAVE_NS */
#ifdef USE_X_TOOLKIT
- xassert (!FRAME_WINDOW_P (f));
+ eassert (!FRAME_WINDOW_P (f));
init_iterator (&it, w, -1, -1, f->desired_matrix->rows, MENU_FACE_ID);
it.first_visible_x = 0;
it.last_visible_x = FRAME_TOTAL_COLS (f) * FRAME_COLUMN_WIDTH (f);
/* Menu bar lines are displayed in the desired matrix of the
dummy window menu_bar_window. */
struct window *menu_w;
- xassert (WINDOWP (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);
this. */
it.paragraph_embedding = L2R;
- if (! mode_line_inverse_video)
- /* Force the menu-bar to be displayed in the default face. */
- it.base_face_id = it.face_id = DEFAULT_FACE_ID;
-
/* Clear all rows of the menu bar. */
for (i = 0; i < FRAME_MENU_BAR_LINES (f); ++i)
{
/* These will be set while the mode line specs are processed. */
line_number_displayed = 0;
- w->column_number_displayed = Qnil;
+ wset_column_number_displayed (w, Qnil);
if (WINDOW_WANTS_MODELINE_P (w))
{
{
struct it it;
struct face *face;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
init_iterator (&it, w, -1, -1, NULL, face_id);
/* Don't extend on a previously drawn mode-line.
it.glyph_row->mode_line_p = 1;
- if (! mode_line_inverse_video)
- /* Force the mode-line to be displayed in the default face. */
- it.base_face_id = it.face_id = DEFAULT_FACE_ID;
-
/* FIXME: This should be controlled by a user option. But
supporting such an option is not trivial, since the mode line is
made up of many separate strings. */
it.paragraph_embedding = L2R;
record_unwind_protect (unwind_format_mode_line,
- format_mode_line_unwind_data (NULL, Qnil, 0));
+ format_mode_line_unwind_data (NULL, NULL, Qnil, 0));
mode_line_target = MODE_LINE_DISPLAY;
depth++;
- switch (SWITCH_ENUM_CAST (XTYPE (elt)))
+ switch (XTYPE (elt))
{
case Lisp_String:
{
/* A string: output it and check for %-constructs within it. */
unsigned char c;
- EMACS_INT offset = 0;
+ ptrdiff_t offset = 0;
if (SCHARS (elt) > 0
&& (!NILP (props) || risky))
&& (mode_line_target != MODE_LINE_DISPLAY
|| it->current_x < it->last_visible_x))
{
- EMACS_INT last_offset = offset;
+ ptrdiff_t last_offset = offset;
/* Advance to end of string or next format specifier. */
while ((c = SREF (elt, offset++)) != '\0' && c != '%')
if (offset - 1 != last_offset)
{
- EMACS_INT nchars, nbytes;
+ ptrdiff_t nchars, nbytes;
/* Output to end of string or up to '%'. Field width
is length of string. Don't output more than
break;
case MODE_LINE_STRING:
{
- EMACS_INT bytepos = last_offset;
- EMACS_INT charpos = string_byte_to_char (elt, bytepos);
- EMACS_INT endpos = (precision <= 0
+ ptrdiff_t bytepos = last_offset;
+ ptrdiff_t charpos = string_byte_to_char (elt, bytepos);
+ ptrdiff_t endpos = (precision <= 0
? string_byte_to_char (elt, offset)
: charpos + nchars);
break;
case MODE_LINE_DISPLAY:
{
- EMACS_INT bytepos = last_offset;
- EMACS_INT charpos = string_byte_to_char (elt, bytepos);
+ ptrdiff_t bytepos = last_offset;
+ ptrdiff_t charpos = string_byte_to_char (elt, bytepos);
if (precision <= 0)
nchars = string_byte_to_char (elt, offset) - charpos;
}
else /* c == '%' */
{
- EMACS_INT percent_position = offset;
+ ptrdiff_t percent_position = offset;
/* Get the specified minimum width. Zero means
don't pad. */
else if (c != 0)
{
int multibyte;
- EMACS_INT bytepos, charpos;
+ ptrdiff_t bytepos, charpos;
const char *spec;
Lisp_Object string;
store_mode_line_string (const char *string, Lisp_Object lisp_string, int copy_string,
int field_width, int precision, Lisp_Object props)
{
- EMACS_INT len;
+ ptrdiff_t len;
int n = 0;
if (string != NULL)
struct buffer *old_buffer = NULL;
int face_id;
int no_props = INTEGERP (face);
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object str;
int string_start = 0;
: EQ (face, Qtool_bar) ? TOOL_BAR_FACE_ID
: DEFAULT_FACE_ID;
- if (XBUFFER (buffer) != current_buffer)
- old_buffer = current_buffer;
+ old_buffer = current_buffer;
/* Save things including mode_line_proptrans_alist,
and set that to nil so that we don't alter the outer value. */
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
- (old_buffer, selected_window, 1));
+ (XFRAME (WINDOW_FRAME (XWINDOW (window))),
+ old_buffer, selected_window, 1));
mode_line_proptrans_alist = Qnil;
Fselect_window (window, Qt);
- if (old_buffer)
- set_buffer_internal_1 (XBUFFER (buffer));
+ set_buffer_internal_1 (XBUFFER (buffer));
init_iterator (&it, w, -1, -1, NULL, face_id);
the positive integer D to BUF using a minimal field width WIDTH. */
static void
-pint2str (register char *buf, register int width, register EMACS_INT d)
+pint2str (register char *buf, register int width, register ptrdiff_t d)
{
register char *p = buf;
};
static void
-pint2hrstr (char *buf, int width, EMACS_INT d)
+pint2hrstr (char *buf, int width, ptrdiff_t d)
{
/* We aim to represent the nonnegative integer D as
QUOTIENT.TENTHS * 10 ^ (3 * EXPONENT). */
- EMACS_INT quotient = d;
+ ptrdiff_t quotient = d;
int remainder = 0;
/* -1 means: do not use TENTHS. */
int tenths = -1;
if (!VECTORP (val)) /* Not yet decided. */
{
- if (multibyte)
- *buf++ = '-';
+ *buf++ = multibyte ? '-' : ' ';
if (eol_flag)
eoltype = eol_mnemonic_undecided;
/* Don't mention EOL conversion if it isn't decided. */
attrs = AREF (val, 0);
eolvalue = AREF (val, 2);
- if (multibyte)
- *buf++ = XFASTINT (CODING_ATTR_MNEMONIC (attrs));
+ *buf++ = multibyte
+ ? XFASTINT (CODING_ATTR_MNEMONIC (attrs))
+ : ' ';
if (eol_flag)
{
}
else if (CHARACTERP (eoltype))
{
- unsigned char *tmp = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH);
+ unsigned char *tmp = alloca (MAX_MULTIBYTE_LENGTH);
int c = XFASTINT (eoltype);
eol_str_len = CHAR_STRING (c, tmp);
eol_str = tmp;
return "";
else
{
- EMACS_INT col = current_column ();
- w->column_number_displayed = make_number (col);
+ ptrdiff_t col = current_column ();
+ wset_column_number_displayed (w, make_number (col));
pint2str (decode_mode_spec_buf, field_width, col);
return decode_mode_spec_buf;
}
case 'i':
{
- EMACS_INT size = ZV - BEGV;
+ ptrdiff_t size = ZV - BEGV;
pint2str (decode_mode_spec_buf, field_width, size);
return decode_mode_spec_buf;
}
case 'I':
{
- EMACS_INT size = ZV - BEGV;
+ ptrdiff_t size = ZV - BEGV;
pint2hrstr (decode_mode_spec_buf, field_width, size);
return decode_mode_spec_buf;
}
case 'l':
{
- EMACS_INT startpos, startpos_byte, line, linepos, linepos_byte;
- EMACS_INT topline, nlines, height;
- EMACS_INT junk;
+ ptrdiff_t startpos, startpos_byte, line, linepos, linepos_byte;
+ ptrdiff_t topline, nlines, height;
+ ptrdiff_t junk;
/* %c and %l are ignored in `frame-title-format'. */
if (mode_line_target == MODE_LINE_TITLE)
goto no_value;
/* But do forget it, if the window shows a different buffer now. */
else if (BUFFERP (w->base_line_pos))
- w->base_line_pos = Qnil;
+ wset_base_line_pos (w, 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))
{
- w->base_line_pos = Qnil;
- w->base_line_number = Qnil;
+ wset_base_line_pos (w, Qnil);
+ wset_base_line_number (w, Qnil);
goto no_value;
}
go back past it. */
if (startpos == BUF_BEGV (b))
{
- w->base_line_number = make_number (topline);
- w->base_line_pos = make_number (BUF_BEGV (b));
+ wset_base_line_number (w, make_number (topline));
+ wset_base_line_pos (w, make_number (BUF_BEGV (b)));
}
else if (nlines < height + 25 || nlines > height * 3 + 50
|| linepos == BUF_BEGV (b))
{
- EMACS_INT limit = BUF_BEGV (b);
- EMACS_INT limit_byte = BUF_BEGV_BYTE (b);
- EMACS_INT position;
- EMACS_INT distance =
+ ptrdiff_t limit = BUF_BEGV (b);
+ ptrdiff_t limit_byte = BUF_BEGV_BYTE (b);
+ ptrdiff_t position;
+ ptrdiff_t distance =
(height * 2 + 30) * line_number_display_limit_width;
if (startpos - distance > limit)
give up on line numbers for this window. */
if (position == limit_byte && limit == startpos - distance)
{
- w->base_line_pos = w->buffer;
- w->base_line_number = Qnil;
+ wset_base_line_pos (w, w->buffer);
+ wset_base_line_number (w, Qnil);
goto no_value;
}
- w->base_line_number = make_number (topline - nlines);
- w->base_line_pos = make_number (BYTE_TO_CHAR (position));
+ wset_base_line_number (w, make_number (topline - nlines));
+ wset_base_line_pos (w, make_number (BYTE_TO_CHAR (position)));
}
/* Now count lines from the start pos to point. */
case 'p':
{
- EMACS_INT pos = marker_position (w->start);
- EMACS_INT total = BUF_ZV (b) - BUF_BEGV (b);
+ ptrdiff_t pos = marker_position (w->start);
+ ptrdiff_t total = BUF_ZV (b) - BUF_BEGV (b);
if (XFASTINT (w->window_end_pos) <= BUF_Z (b) - BUF_ZV (b))
{
so get us a 2-digit number that is close. */
if (total == 100)
total = 99;
- sprintf (decode_mode_spec_buf, "%2"pI"d%%", total);
+ sprintf (decode_mode_spec_buf, "%2"pD"d%%", total);
return decode_mode_spec_buf;
}
}
/* Display percentage of size above the bottom of the screen. */
case 'P':
{
- EMACS_INT toppos = marker_position (w->start);
- EMACS_INT botpos = BUF_Z (b) - XFASTINT (w->window_end_pos);
- EMACS_INT total = BUF_ZV (b) - BUF_BEGV (b);
+ 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))
{
if (total == 100)
total = 99;
if (toppos <= BUF_BEGV (b))
- sprintf (decode_mode_spec_buf, "Top%2"pI"d%%", total);
+ sprintf (decode_mode_spec_buf, "Top%2"pD"d%%", total);
else
- sprintf (decode_mode_spec_buf, "%2"pI"d%%", total);
+ sprintf (decode_mode_spec_buf, "%2"pD"d%%", total);
return decode_mode_spec_buf;
}
}
case '@':
{
- int count = inhibit_garbage_collection ();
+ ptrdiff_t count = inhibit_garbage_collection ();
Lisp_Object val = call1 (intern ("file-remote-p"),
BVAR (current_buffer, directory));
unbind_to (count, Qnil);
obj = Fget_buffer_process (Fcurrent_buffer ());
if (PROCESSP (obj))
{
- p = decode_mode_spec_coding (XPROCESS (obj)->decode_coding_system,
- p, eol_flag);
- p = decode_mode_spec_coding (XPROCESS (obj)->encode_coding_system,
- p, eol_flag);
+ p = decode_mode_spec_coding
+ (XPROCESS (obj)->decode_coding_system, p, eol_flag);
+ p = decode_mode_spec_coding
+ (XPROCESS (obj)->encode_coding_system, p, eol_flag);
}
#endif /* subprocesses */
#endif /* 0 */
Set *BYTE_POS_PTR to 1 if we found COUNT lines, 0 if we hit LIMIT. */
-static EMACS_INT
-display_count_lines (EMACS_INT start_byte,
- EMACS_INT limit_byte, EMACS_INT count,
- EMACS_INT *byte_pos_ptr)
+static ptrdiff_t
+display_count_lines (ptrdiff_t start_byte,
+ ptrdiff_t limit_byte, ptrdiff_t count,
+ ptrdiff_t *byte_pos_ptr)
{
register unsigned char *cursor;
unsigned char *base;
- register EMACS_INT ceiling;
+ register ptrdiff_t ceiling;
register unsigned char *ceiling_addr;
- EMACS_INT orig_count = count;
+ ptrdiff_t orig_count = count;
/* If we are not in selective display mode,
check only for newlines. */
static int
display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_string,
- EMACS_INT face_string_pos, EMACS_INT start, struct it *it,
+ ptrdiff_t face_string_pos, ptrdiff_t start, struct it *it,
int field_width, int precision, int max_x, int multibyte)
{
int hpos_at_start = it->hpos;
int saved_face_id = it->face_id;
struct glyph_row *row = it->glyph_row;
- EMACS_INT it_charpos;
+ ptrdiff_t it_charpos;
/* Initialize the iterator IT for iteration over STRING beginning
with index START. */
FACE_STRING, if that's given. */
if (STRINGP (face_string))
{
- EMACS_INT endptr;
+ ptrdiff_t endptr;
struct face *face;
it->face_id
{
/* Glyph is off the left margin of the display area.
Should not happen. */
- abort ();
+ emacs_abort ();
}
row->ascent = max (row->ascent, it->max_ascent);
if (it->first_visible_x
&& it_charpos > 0)
{
- if (!FRAME_WINDOW_P (it->f))
+ if (!FRAME_WINDOW_P (it->f)
+ || (row->reversed_p
+ ? WINDOW_RIGHT_FRINGE_WIDTH (it->w)
+ : WINDOW_LEFT_FRINGE_WIDTH (it->w)) == 0)
insert_left_trunc_glyphs (it);
row->truncated_on_left_p = 1;
}
if (NILP (prop))
return OK_PIXELS (0);
- xassert (FRAME_LIVE_P (it->f));
+ eassert (FRAME_LIVE_P (it->f));
if (SYMBOLP (prop))
{
return OK_PIXELS (WINDOW_SCROLL_BAR_AREA_WIDTH (it->w));
}
- prop = Fbuffer_local_value (prop, it->w->buffer);
+ prop = buffer_local_value_1 (prop, it->w->buffer);
+ if (EQ (prop, Qunbound))
+ prop = Qnil;
}
if (INTEGERP (prop) || FLOATP (prop))
return OK_PIXELS (pixels);
}
- car = Fbuffer_local_value (car, it->w->buffer);
+ car = buffer_local_value_1 (car, it->w->buffer);
+ if (EQ (car, Qunbound))
+ car = Qnil;
}
if (INTEGERP (car) || FLOATP (car))
#ifdef HAVE_WINDOW_SYSTEM
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
void
dump_glyph_string (struct glyph_string *s)
if (display_p)
#endif
{
- xassert (face != NULL);
+ eassert (face != NULL);
PREPARE_FACE_FOR_DISPLAY (f, face);
}
{
struct face *face;
- xassert (glyph->type == CHAR_GLYPH);
+ eassert (glyph->type == CHAR_GLYPH);
face = FACE_FROM_ID (f, glyph->face_id);
if (two_byte_p)
}
/* Make sure X resources of the face are allocated. */
- xassert (face != NULL);
+ eassert (face != NULL);
PREPARE_FACE_FOR_DISPLAY (f, face);
return face;
}
glyph that requires the different face, add it to S. */
struct face *face;
- xassert (s);
+ eassert (s);
s->for_overlaps = overlaps;
s->face = NULL;
struct glyph *glyph, *last;
int voffset;
- xassert (s->first_glyph->type == GLYPHLESS_GLYPH);
+ eassert (s->first_glyph->type == GLYPHLESS_GLYPH);
s->for_overlaps = overlaps;
glyph = s->row->glyphs[s->area] + start;
last = s->row->glyphs[s->area] + end;
voffset = glyph->voffset;
s->face = FACE_FROM_ID (s->f, face_id);
- s->font = s->face->font;
+ s->font = s->face->font ? s->face->font : FRAME_FONT (s->f);
s->nchars = 1;
s->width = glyph->pixel_width;
glyph++;
int voffset;
int glyph_not_available_p;
- xassert (s->f == XFRAME (s->w->frame));
- xassert (s->nchars == 0);
- xassert (start >= 0 && end > start);
+ eassert (s->f == XFRAME (s->w->frame));
+ eassert (s->nchars == 0);
+ eassert (start >= 0 && end > start);
s->for_overlaps = overlaps;
glyph = s->row->glyphs[s->area] + start;
&two_byte_p);
s->two_byte_p = two_byte_p;
++s->nchars;
- xassert (s->nchars <= end - start);
+ eassert (s->nchars <= end - start);
s->width += glyph->pixel_width;
if (glyph++->padding_p != s->padding_p)
break;
/* Adjust base line for subscript/superscript text. */
s->ybase += voffset;
- xassert (s->face && s->face->gc);
+ eassert (s->face && s->face->gc);
return glyph - s->row->glyphs[s->area];
}
static void
fill_image_glyph_string (struct glyph_string *s)
{
- xassert (s->first_glyph->type == IMAGE_GLYPH);
+ eassert (s->first_glyph->type == IMAGE_GLYPH);
s->img = IMAGE_FROM_ID (s->f, s->first_glyph->u.img_id);
- xassert (s->img);
+ eassert (s->img);
s->slice = s->first_glyph->slice.img;
s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
s->font = s->face->font;
struct glyph *glyph, *last;
int voffset, face_id;
- xassert (s->first_glyph->type == STRETCH_GLYPH);
+ eassert (s->first_glyph->type == STRETCH_GLYPH);
glyph = s->row->glyphs[s->area] + start;
last = s->row->glyphs[s->area] + end;
/* The case that face->gc == 0 is handled when drawing the glyph
string by calling PREPARE_FACE_FOR_DISPLAY. */
- xassert (s->face);
+ eassert (s->face);
return glyph - s->row->glyphs[s->area];
}
{
int x = 0, i;
struct glyph *glyphs = s->row->glyphs[s->area];
- int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
+ int first = (s->first_glyph - glyphs
+ + (s->first_glyph->type == COMPOSITE_GLYPH ? 1 : s->nchars));
int end = s->row->used[s->area];
for (i = first; i < end && s->right_overhang > x; ++i)
int i, k, x;
int end = s->row->used[s->area];
struct glyph *glyphs = s->row->glyphs[s->area];
- int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
+ int first = (s->first_glyph - glyphs
+ + (s->first_glyph->type == COMPOSITE_GLYPH ? 1 : s->nchars));
k = -1;
x = 0;
#define BUILD_STRETCH_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \
do \
{ \
- s = (struct glyph_string *) alloca (sizeof *s); \
+ s = alloca (sizeof *s); \
INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \
START = fill_stretch_glyph_string (s, START, END); \
append_glyph_string (&HEAD, &TAIL, s); \
#define BUILD_IMAGE_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \
do \
{ \
- s = (struct glyph_string *) alloca (sizeof *s); \
+ s = alloca (sizeof *s); \
INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \
fill_image_glyph_string (s); \
append_glyph_string (&HEAD, &TAIL, s); \
\
face_id = (row)->glyphs[area][START].face_id; \
\
- s = (struct glyph_string *) alloca (sizeof *s); \
- char2b = (XChar2b *) alloca ((END - START) * sizeof *char2b); \
+ s = alloca (sizeof *s); \
+ char2b = alloca ((END - START) * sizeof *char2b); \
INIT_GLYPH_STRING (s, char2b, w, row, area, START, HL); \
append_glyph_string (&HEAD, &TAIL, s); \
s->x = (X); \
struct glyph_string *first_s = NULL; \
int n; \
\
- char2b = (XChar2b *) alloca ((sizeof *char2b) * cmp->glyph_len); \
+ char2b = alloca (cmp->glyph_len * sizeof *char2b); \
\
/* Make glyph_strings for each glyph sequence that is drawable by \
the same face, and append them to HEAD/TAIL. */ \
for (n = 0; n < cmp->glyph_len;) \
{ \
- s = (struct glyph_string *) alloca (sizeof *s); \
+ s = alloca (sizeof *s); \
INIT_GLYPH_STRING (s, char2b, w, row, area, START, HL); \
append_glyph_string (&(HEAD), &(TAIL), s); \
s->cmp = cmp; \
face_id = (row)->glyphs[area][START].face_id; \
gstring = (composition_gstring_from_id \
((row)->glyphs[area][START].u.cmp.id)); \
- s = (struct glyph_string *) alloca (sizeof *s); \
- char2b = (XChar2b *) alloca ((sizeof *char2b) \
- * LGSTRING_GLYPH_LEN (gstring)); \
+ s = alloca (sizeof *s); \
+ char2b = alloca (LGSTRING_GLYPH_LEN (gstring) * sizeof *char2b); \
INIT_GLYPH_STRING (s, char2b, w, row, area, START, HL); \
append_glyph_string (&(HEAD), &(TAIL), s); \
s->x = (X); \
\
face_id = (row)->glyphs[area][START].face_id; \
\
- s = (struct glyph_string *) alloca (sizeof *s); \
+ s = alloca (sizeof *s); \
INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \
append_glyph_string (&HEAD, &TAIL, s); \
s->x = (X); \
break; \
\
default: \
- abort (); \
+ emacs_abort (); \
} \
\
if (s) \
static int
draw_glyphs (struct window *w, int x, struct glyph_row *row,
- enum glyph_row_area area, EMACS_INT start, EMACS_INT end,
+ enum glyph_row_area area, ptrdiff_t start, ptrdiff_t end,
enum draw_glyphs_face hl, int overlaps)
{
struct glyph_string *head, *tail;
struct glyph *glyph;
enum glyph_row_area area = it->area;
- xassert (it->glyph_row);
- xassert (it->char_to_display != '\n' && it->char_to_display != '\t');
+ eassert (it->glyph_row);
+ eassert (it->char_to_display != '\n' && it->char_to_display != '\t');
glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
if (glyph < it->glyph_row->glyphs[area + 1])
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
struct glyph *glyph;
enum glyph_row_area area = it->area;
- xassert (it->glyph_row);
+ eassert (it->glyph_row);
glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
if (glyph < it->glyph_row->glyphs[area + 1])
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
++it->glyph_row->used[area];
int glyph_ascent, crop;
struct glyph_slice slice;
- xassert (it->what == IT_IMAGE);
+ eassert (it->what == IT_IMAGE);
face = FACE_FROM_ID (it->f, it->face_id);
- xassert (face);
+ eassert (face);
/* Make sure X resources of the face is loaded. */
PREPARE_FACE_FOR_DISPLAY (it->f, face);
}
img = IMAGE_FROM_ID (it->f, it->image_id);
- xassert (img);
+ eassert (img);
/* Make sure X resources of the image is loaded. */
prepare_image_for_display (it->f, img);
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
++it->glyph_row->used[area];
struct glyph *glyph;
enum glyph_row_area area = it->area;
- xassert (ascent >= 0 && ascent <= height);
+ eassert (ascent >= 0 && ascent <= height);
glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
if (glyph < it->glyph_row->glyphs[area + 1])
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
else
#endif
/* List should start with `space'. */
- xassert (CONSP (it->object) && EQ (XCAR (it->object), Qspace));
+ eassert (CONSP (it->object) && EQ (XCAR (it->object), Qspace));
plist = XCDR (it->object);
/* Compute the width of the stretch. */
it->nglyphs = width;
}
+/* Get information about special display element WHAT in an
+ environment described by IT. WHAT is one of IT_TRUNCATION or
+ IT_CONTINUATION. Maybe produce glyphs for WHAT if IT has a
+ non-null glyph_row member. This function ensures that fields like
+ face_id, c, len of IT are left untouched. */
+
+static void
+produce_special_glyphs (struct it *it, enum display_element_type what)
+{
+ struct it temp_it;
+ Lisp_Object gc;
+ GLYPH glyph;
+
+ temp_it = *it;
+ temp_it.object = make_number (0);
+ memset (&temp_it.current, 0, sizeof temp_it.current);
+
+ if (what == IT_CONTINUATION)
+ {
+ /* Continuation glyph. For R2L lines, we mirror it by hand. */
+ if (it->bidi_it.paragraph_dir == R2L)
+ SET_GLYPH_FROM_CHAR (glyph, '/');
+ else
+ SET_GLYPH_FROM_CHAR (glyph, '\\');
+ if (it->dp
+ && (gc = DISP_CONTINUE_GLYPH (it->dp), GLYPH_CODE_P (gc)))
+ {
+ /* FIXME: Should we mirror GC for R2L lines? */
+ SET_GLYPH_FROM_GLYPH_CODE (glyph, gc);
+ spec_glyph_lookup_face (XWINDOW (it->window), &glyph);
+ }
+ }
+ else if (what == IT_TRUNCATION)
+ {
+ /* Truncation glyph. */
+ SET_GLYPH_FROM_CHAR (glyph, '$');
+ if (it->dp
+ && (gc = DISP_TRUNC_GLYPH (it->dp), GLYPH_CODE_P (gc)))
+ {
+ /* FIXME: Should we mirror GC for R2L lines? */
+ SET_GLYPH_FROM_GLYPH_CODE (glyph, gc);
+ spec_glyph_lookup_face (XWINDOW (it->window), &glyph);
+ }
+ }
+ else
+ emacs_abort ();
+
+#ifdef HAVE_WINDOW_SYSTEM
+ /* On a GUI frame, when the right fringe (left fringe for R2L rows)
+ is turned off, we precede the truncation/continuation glyphs by a
+ stretch glyph whose width is computed such that these special
+ glyphs are aligned at the window margin, even when very different
+ fonts are used in different glyph rows. */
+ if (FRAME_WINDOW_P (temp_it.f)
+ /* init_iterator calls this with it->glyph_row == NULL, and it
+ wants only the pixel width of the truncation/continuation
+ glyphs. */
+ && temp_it.glyph_row
+ /* insert_left_trunc_glyphs calls us at the beginning of the
+ row, and it has its own calculation of the stretch glyph
+ width. */
+ && temp_it.glyph_row->used[TEXT_AREA] > 0
+ && (temp_it.glyph_row->reversed_p
+ ? WINDOW_LEFT_FRINGE_WIDTH (temp_it.w)
+ : WINDOW_RIGHT_FRINGE_WIDTH (temp_it.w)) == 0)
+ {
+ int stretch_width = temp_it.last_visible_x - temp_it.current_x;
+
+ if (stretch_width > 0)
+ {
+ struct face *face = FACE_FROM_ID (temp_it.f, temp_it.face_id);
+ struct font *font =
+ face->font ? face->font : FRAME_FONT (temp_it.f);
+ int stretch_ascent =
+ (((temp_it.ascent + temp_it.descent)
+ * FONT_BASE (font)) / FONT_HEIGHT (font));
+
+ append_stretch_glyph (&temp_it, make_number (0), stretch_width,
+ temp_it.ascent + temp_it.descent,
+ stretch_ascent);
+ }
+ }
+#endif
+
+ temp_it.dp = NULL;
+ temp_it.what = IT_CHARACTER;
+ temp_it.len = 1;
+ temp_it.c = temp_it.char_to_display = GLYPH_CHAR (glyph);
+ temp_it.face_id = GLYPH_FACE (glyph);
+ temp_it.len = CHAR_BYTES (temp_it.c);
+
+ PRODUCE_GLYPHS (&temp_it);
+ it->pixel_width = temp_it.pixel_width;
+ it->nglyphs = temp_it.pixel_width;
+}
+
#ifdef HAVE_WINDOW_SYSTEM
/* Calculate line-height and line-spacing properties.
{
glyph->resolved_level = it->bidi_it.resolved_level;
if ((it->bidi_it.type & 7) != it->bidi_it.type)
- abort ();
+ emacs_abort ();
glyph->bidi_type = it->bidi_it.type;
}
++it->glyph_row->used[area];
}
else
{
- xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE);
+ eassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE);
sprintf (buf, "%0*X", it->c < 0x10000 ? 4 : 6, it->c);
str = buf;
}
Vglyphless_char_display. */
Lisp_Object acronym = lookup_glyphless_char_display (-1, it);
- xassert (it->what == IT_GLYPHLESS);
+ eassert (it->what == IT_GLYPHLESS);
produce_glyphless_glyph (it, 1, STRINGP (acronym) ? acronym : Qnil);
goto done;
}
XChar2b char2b;
struct font_metrics *pcm;
int font_not_found_p;
- EMACS_INT pos;
+ ptrdiff_t pos;
for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--)
if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t')
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)
done:
/* Accumulate dimensions. Note: can't assume that it->descent > 0
because this isn't true for images with `:ascent 100'. */
- xassert (it->ascent >= 0 && it->descent >= 0);
+ eassert (it->ascent >= 0 && it->descent >= 0);
if (it->area == TEXT_AREA)
it->current_x += it->pixel_width;
{
int x, hpos, chpos = updated_window->phys_cursor.hpos;
- xassert (updated_window && updated_row);
+ eassert (updated_window && updated_row);
/* When the window is hscrolled, cursor hpos can legitimately be out
of bounds, but we draw the cursor at the corresponding window
margin in that case. */
if (updated_row->reversed_p && chpos >= updated_row->used[TEXT_AREA])
chpos = updated_row->used[TEXT_AREA] - 1;
- BLOCK_INPUT;
+ block_input ();
/* Write glyphs. */
&& chpos < hpos + len)
updated_window->phys_cursor_on_p = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
/* Advance the output cursor. */
output_cursor.hpos += len;
struct glyph_row *row;
struct glyph *glyph;
int frame_x, frame_y;
- EMACS_INT hpos;
+ ptrdiff_t hpos;
- xassert (updated_window && updated_row);
- BLOCK_INPUT;
+ eassert (updated_window && updated_row);
+ block_input ();
w = updated_window;
f = XFRAME (WINDOW_FRAME (w));
/* Advance the output cursor. */
output_cursor.hpos += len;
output_cursor.x += shift_by_width;
- UNBLOCK_INPUT;
+ unblock_input ();
}
int max_x, min_y, max_y;
int from_x, from_y, to_y;
- xassert (updated_window && updated_row);
+ eassert (updated_window && updated_row);
f = XFRAME (w->frame);
if (updated_row->full_width_p)
/* Prevent inadvertently clearing to end of the X window. */
if (to_x > from_x && to_y > from_y)
{
- BLOCK_INPUT;
+ block_input ();
FRAME_RIF (f)->clear_frame_area (f, from_x, from_y,
to_x - from_x, to_y - from_y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
if (CONSP (arg)
&& EQ (XCAR (arg), Qbar)
- && INTEGERP (XCDR (arg))
- && XINT (XCDR (arg)) >= 0)
+ && RANGED_INTEGERP (0, XCDR (arg), INT_MAX))
{
*width = XINT (XCDR (arg));
return BAR_CURSOR;
if (CONSP (arg)
&& EQ (XCAR (arg), Qhbar)
- && INTEGERP (XCDR (arg))
- && XINT (XCDR (arg)) >= 0)
+ && RANGED_INTEGERP (0, XCDR (arg), INT_MAX))
{
*width = XINT (XCDR (arg));
return HBAR_CURSOR;
{
int i, x;
- BLOCK_INPUT;
+ block_input ();
x = 0;
for (i = 0; i < row->used[area];)
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
|| (0 <= hpos && hpos < glyph_row->used[TEXT_AREA]))
glyph = glyph_row->glyphs[TEXT_AREA] + hpos;
- xassert (interrupt_input_blocked);
+ eassert (input_blocked_p ());
/* Set new_cursor_type to the cursor we want to be displayed. */
new_cursor_type = get_window_cursor_type (w, glyph,
if (row->reversed_p && hpos >= row->used[TEXT_AREA])
hpos = row->used[TEXT_AREA] - 1;
- BLOCK_INPUT;
+ block_input ();
display_and_set_cursor (w, on, hpos, vpos,
w->phys_cursor.x, w->phys_cursor.y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
return;
}
#endif
-#if defined (HAVE_GPM) || defined (MSDOS)
+#if defined (HAVE_GPM) || defined (MSDOS) || defined (WINDOWSNT)
tty_draw_row_with_mouse_face (w, row, start_hpos, end_hpos, draw);
#endif
}
if (row->reversed_p && hpos >= row->used[TEXT_AREA])
hpos = row->used[TEXT_AREA] - 1;
- BLOCK_INPUT;
+ block_input ();
display_and_set_cursor (w, 1, hpos, w->phys_cursor.vpos,
w->phys_cursor.x, w->phys_cursor.y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_WINDOW_SYSTEM */
}
buffer positions change non-linearly with glyph rows. */
static void
rows_from_pos_range (struct window *w,
- EMACS_INT start_charpos, EMACS_INT end_charpos,
+ ptrdiff_t start_charpos, ptrdiff_t end_charpos,
Lisp_Object disp_string,
struct glyph_row **start, struct glyph_row **end)
{
for ( ; row->enabled_p && MATRIX_ROW_BOTTOM_Y (row) <= last_y; row++)
{
struct glyph_row *next = row + 1;
- EMACS_INT next_start = MATRIX_ROW_START_CHARPOS (next);
+ ptrdiff_t next_start = MATRIX_ROW_START_CHARPOS (next);
if (!next->enabled_p
|| next >= MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)
static void
mouse_face_from_buffer_pos (Lisp_Object window,
Mouse_HLInfo *hlinfo,
- EMACS_INT mouse_charpos,
- EMACS_INT start_charpos,
- EMACS_INT end_charpos,
+ ptrdiff_t mouse_charpos,
+ ptrdiff_t start_charpos,
+ ptrdiff_t end_charpos,
Lisp_Object before_string,
Lisp_Object after_string,
Lisp_Object disp_string)
struct glyph_row *first = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
struct glyph_row *r1, *r2;
struct glyph *glyph, *end;
- EMACS_INT ignore, pos;
+ ptrdiff_t ignore, pos;
int x;
- xassert (NILP (disp_string) || STRINGP (disp_string));
- xassert (NILP (before_string) || STRINGP (before_string));
- xassert (NILP (after_string) || STRINGP (after_string));
+ eassert (NILP (disp_string) || STRINGP (disp_string));
+ eassert (NILP (before_string) || STRINGP (before_string));
+ eassert (NILP (after_string) || STRINGP (after_string));
/* Find the rows corresponding to START_CHARPOS and END_CHARPOS. */
rows_from_pos_range (w, start_charpos, end_charpos, disp_string, &r1, &r2);
Value is non-zero if a glyph was found. */
static int
-fast_find_string_pos (struct window *w, EMACS_INT pos, Lisp_Object object,
+fast_find_string_pos (struct window *w, ptrdiff_t pos, Lisp_Object object,
int *hpos, int *vpos, int *x, int *y, int right_p)
{
int yb = window_text_bottom_y (w);
static void
mouse_face_from_string_pos (struct window *w, Mouse_HLInfo *hlinfo,
Lisp_Object object,
- EMACS_INT startpos, EMACS_INT endpos)
+ ptrdiff_t startpos, ptrdiff_t endpos)
{
int yb = window_text_bottom_y (w);
struct glyph_row *r;
{
struct Lisp_Vector *v = XVECTOR (XCDR (hot_spot));
Lisp_Object *poly = v->contents;
- int n = v->header.size;
- int i;
+ ptrdiff_t n = v->header.size;
+ ptrdiff_t i;
int inside = 0;
Lisp_Object lx, ly;
int x0, y0;
CHECK_NUMBER (x);
CHECK_NUMBER (y);
- return find_hot_spot (map, XINT (x), XINT (y));
+ return find_hot_spot (map,
+ clip_to_bounds (INT_MIN, XINT (x), INT_MAX),
+ clip_to_bounds (INT_MIN, XINT (y), INT_MAX));
}
Cursor cursor = No_Cursor;
Lisp_Object pointer = Qnil;
int dx, dy, width, height;
- EMACS_INT charpos;
+ ptrdiff_t charpos;
Lisp_Object string, object = Qnil;
- Lisp_Object pos, help;
+ Lisp_Object pos IF_LINT (= Qnil), help;
Lisp_Object mouse_face;
int original_x_pixel = x;
struct glyph * glyph = NULL, * row_start_glyph = NULL;
- struct glyph_row *row;
+ struct glyph_row *row IF_LINT (= 0);
if (area == ON_MODE_LINE || area == ON_HEADER_LINE)
{
if (!NILP (help))
{
help_echo_string = help;
- /* Is this correct? ++kfs */
XSETWINDOW (help_echo_window, w);
help_echo_object = w->buffer;
help_echo_pos = charpos;
#endif /* HAVE_WINDOW_SYSTEM */
if (STRINGP (string))
+ pos = make_number (charpos);
+
+ /* Set the help text and mouse pointer. If the mouse is on a part
+ of the mode line without any text (e.g. past the right edge of
+ the mode line text), use the default help text and pointer. */
+ if (STRINGP (string) || area == ON_MODE_LINE)
{
- pos = make_number (charpos);
- /* If we're on a string with `help-echo' text property, arrange
- for the help to be displayed. This is done by setting the
- global variable help_echo_string to the help string. */
+ /* Arrange to display the help by setting the global variables
+ help_echo_string, help_echo_object, and help_echo_pos. */
if (NILP (help))
{
- help = Fget_text_property (pos, Qhelp_echo, string);
+ if (STRINGP (string))
+ help = Fget_text_property (pos, Qhelp_echo, string);
+
if (!NILP (help))
{
help_echo_string = help;
help_echo_object = string;
help_echo_pos = charpos;
}
+ else if (area == ON_MODE_LINE)
+ {
+ Lisp_Object default_help
+ = buffer_local_value_1 (Qmode_line_default_help_echo,
+ w->buffer);
+
+ if (STRINGP (default_help))
+ {
+ help_echo_string = default_help;
+ XSETWINDOW (help_echo_window, w);
+ help_echo_object = Qnil;
+ help_echo_pos = -1;
+ }
+ }
}
#ifdef HAVE_WINDOW_SYSTEM
+ /* Change the mouse pointer according to what is under it. */
if (FRAME_WINDOW_P (f))
{
dpyinfo = FRAME_X_DISPLAY_INFO (f);
- cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
- if (NILP (pointer))
- pointer = Fget_text_property (pos, Qpointer, string);
-
- /* Change the mouse pointer according to what is under X/Y. */
- if (NILP (pointer)
- && ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE)))
+ if (STRINGP (string))
{
- Lisp_Object map;
- map = Fget_text_property (pos, Qlocal_map, string);
- if (!KEYMAPP (map))
- map = Fget_text_property (pos, Qkeymap, string);
- if (!KEYMAPP (map))
- cursor = dpyinfo->vertical_scroll_bar_cursor;
+ cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
+
+ if (NILP (pointer))
+ pointer = Fget_text_property (pos, Qpointer, string);
+
+ /* Change the mouse pointer according to what is under X/Y. */
+ if (NILP (pointer)
+ && ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE)))
+ {
+ Lisp_Object map;
+ map = Fget_text_property (pos, Qlocal_map, string);
+ if (!KEYMAPP (map))
+ map = Fget_text_property (pos, Qkeymap, string);
+ if (!KEYMAPP (map))
+ cursor = dpyinfo->vertical_scroll_bar_cursor;
+ }
}
+ else
+ /* Default mode-line pointer. */
+ cursor = FRAME_X_DISPLAY_INFO (f)->vertical_scroll_bar_cursor;
}
#endif
+ }
- /* Change the mouse face according to what is under X/Y. */
+ /* Change the mouse face according to what is under X/Y. */
+ if (STRINGP (string))
+ {
mouse_face = Fget_text_property (pos, Qmouse_face, string);
if (!NILP (mouse_face)
&& ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE))
int gpos;
int gseq_length;
int total_pixel_width;
- EMACS_INT begpos, endpos, ignore;
+ ptrdiff_t begpos, endpos, ignore;
int vpos, hpos;
b = XBUFFER (w->buffer);
if (part == ON_TEXT
&& EQ (w->window_end_valid, w->buffer)
- && XFASTINT (w->last_modified) == BUF_MODIFF (b)
- && XFASTINT (w->last_overlay_modified) == BUF_OVERLAY_MODIFF (b))
+ && w->last_modified == BUF_MODIFF (b)
+ && w->last_overlay_modified == BUF_OVERLAY_MODIFF (b))
{
int hpos, vpos, dx, dy, area = LAST_AREA;
- EMACS_INT pos;
+ ptrdiff_t pos;
struct glyph *glyph;
Lisp_Object object;
Lisp_Object mouse_face = Qnil, position;
Lisp_Object *overlay_vec = NULL;
ptrdiff_t i, noverlays;
struct buffer *obuf;
- EMACS_INT obegv, ozv;
+ ptrdiff_t obegv, ozv;
int same_region;
/* Find the glyph under X/Y. */
/* The mouse-highlighting comes from a display string
with a mouse-face. */
Lisp_Object s, e;
- EMACS_INT ignore;
+ ptrdiff_t ignore;
s = Fprevious_single_property_change
(make_number (pos + 1), Qmouse_face, object, Qnil);
/* If we are on a display string with no mouse-face,
check if the text under it has one. */
struct glyph_row *r = MATRIX_ROW (w->current_matrix, vpos);
- EMACS_INT start = MATRIX_ROW_START_CHARPOS (r);
+ ptrdiff_t start = MATRIX_ROW_START_CHARPOS (r);
pos = string_buffer_position (object, start);
if (pos > 0)
{
else
{
Lisp_Object obj = glyph->object;
- EMACS_INT charpos = glyph->charpos;
+ ptrdiff_t charpos = glyph->charpos;
/* Try text properties. */
if (STRINGP (obj)
see if the buffer text ``under'' it does. */
struct glyph_row *r
= MATRIX_ROW (w->current_matrix, vpos);
- EMACS_INT start = MATRIX_ROW_START_CHARPOS (r);
- EMACS_INT p = string_buffer_position (obj, start);
+ ptrdiff_t start = MATRIX_ROW_START_CHARPOS (r);
+ ptrdiff_t p = string_buffer_position (obj, start);
if (p > 0)
{
help = Fget_char_property (make_number (p),
if (NILP (pointer))
{
Lisp_Object obj = glyph->object;
- EMACS_INT charpos = glyph->charpos;
+ ptrdiff_t charpos = glyph->charpos;
/* Try text properties. */
if (STRINGP (obj)
see if the buffer text ``under'' it does. */
struct glyph_row *r
= MATRIX_ROW (w->current_matrix, vpos);
- EMACS_INT start = MATRIX_ROW_START_CHARPOS (r);
- EMACS_INT p = string_buffer_position (obj, start);
+ ptrdiff_t start = MATRIX_ROW_START_CHARPOS (r);
+ ptrdiff_t p = string_buffer_position (obj, start);
if (p > 0)
pointer = Fget_char_property (make_number (p),
Qpointer, w->buffer);
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame));
Lisp_Object window;
- BLOCK_INPUT;
+ block_input ();
XSETWINDOW (window, w);
if (EQ (window, hlinfo->mouse_face_window))
clear_mouse_face (hlinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static int
expose_line (struct window *w, struct glyph_row *row, XRectangle *r)
{
- xassert (row->enabled_p);
+ eassert (row->enabled_p);
if (row->mode_line_p || w->pseudo_window_p)
draw_glyphs (w, 0, row, TEXT_AREA,
for (row = first_overlapping_row; row <= last_overlapping_row; ++row)
if (row->overlapping_p)
{
- xassert (row->enabled_p && !row->mode_line_p);
+ eassert (row->enabled_p && !row->mode_line_p);
row->clip = r;
if (row->used[LEFT_MARGIN_AREA])
staticpro (&Vmessage_stack);
DEFSYM (Qinhibit_redisplay, "inhibit-redisplay");
+ DEFSYM (Qredisplay_internal, "redisplay_internal (C function)");
message_dolog_marker1 = Fmake_marker ();
staticpro (&message_dolog_marker1);
message_dolog_marker3 = Fmake_marker ();
staticpro (&message_dolog_marker3);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
defsubr (&Sdump_frame_glyph_matrix);
defsubr (&Sdump_glyph_matrix);
defsubr (&Sdump_glyph_row);
staticpro (&echo_area_buffer[0]);
staticpro (&echo_area_buffer[1]);
- Vmessages_buffer_name = make_pure_c_string ("*Messages*");
+ Vmessages_buffer_name = build_pure_c_string ("*Messages*");
staticpro (&Vmessages_buffer_name);
mode_line_proptrans_alist = Qnil;
Vmode_line_unwind_vector = Qnil;
staticpro (&Vmode_line_unwind_vector);
+ DEFSYM (Qmode_line_default_help_echo, "mode-line-default-help-echo");
+
help_echo_string = Qnil;
staticpro (&help_echo_string);
help_echo_object = Qnil;
#ifdef HAVE_WINDOW_SYSTEM
DEFVAR_BOOL ("x-stretch-cursor", x_stretch_cursor_p,
- doc: /* *Non-nil means draw block cursor as wide as the glyph under it.
+ doc: /* Non-nil means draw block cursor as wide as the glyph under it.
For example, if a block cursor is over a tab, it will be drawn as
wide as that tab on the display. */);
x_stretch_cursor_p = 0;
#endif
DEFVAR_LISP ("show-trailing-whitespace", Vshow_trailing_whitespace,
- doc: /* *Non-nil means highlight trailing whitespace.
+ doc: /* Non-nil means highlight trailing whitespace.
The face used for trailing whitespace is `trailing-whitespace'. */);
Vshow_trailing_whitespace = Qnil;
Vnobreak_char_display = Qt;
DEFVAR_LISP ("void-text-area-pointer", Vvoid_text_area_pointer,
- doc: /* *The pointer shape to show in void text areas.
+ doc: /* The pointer shape to show in void text areas.
A value of nil means to show the text pointer. Other options are `arrow',
`text', `hand', `vdrag', `hdrag', `modeline', and `hourglass'. */);
Vvoid_text_area_pointer = Qarrow;
DEFVAR_LISP ("overlay-arrow-string", Voverlay_arrow_string,
doc: /* String to display as an arrow in non-window frames.
See also `overlay-arrow-position'. */);
- Voverlay_arrow_string = make_pure_c_string ("=>");
+ Voverlay_arrow_string = build_pure_c_string ("=>");
DEFVAR_LISP ("overlay-arrow-variable-list", Voverlay_arrow_variable_list,
doc: /* List of variables (symbols) which hold markers for overlay arrows.
= Fcons (intern_c_string ("overlay-arrow-position"), Qnil);
DEFVAR_INT ("scroll-step", emacs_scroll_step,
- doc: /* *The number of lines to try scrolling a window by when point moves out.
+ doc: /* The number of lines to try scrolling a window by when point moves out.
If that fails to bring point back on frame, point is centered instead.
If this is zero, point is always centered after it moves off frame.
If you want scrolling to always be a line at a time, you should set
`scroll-conservatively' to a large value rather than set this to 1. */);
DEFVAR_INT ("scroll-conservatively", scroll_conservatively,
- doc: /* *Scroll up to this many lines, to bring point back on screen.
+ doc: /* Scroll up to this many lines, to bring point back on screen.
If point moves off-screen, redisplay will scroll by up to
`scroll-conservatively' lines in order to bring point just barely
onto the screen again. If that cannot be done, then redisplay
scroll_conservatively = 0;
DEFVAR_INT ("scroll-margin", scroll_margin,
- doc: /* *Number of lines of margin at the top and bottom of a window.
+ doc: /* Number of lines of margin at the top and bottom of a window.
Recenter the window whenever point gets within this many lines
of the top or bottom of the window. */);
scroll_margin = 0;
Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */);
Vdisplay_pixels_per_inch = make_float (72.0);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
DEFVAR_INT ("debug-end-pos", debug_end_pos, doc: /* Don't ask. */);
#endif
If `word-wrap' is enabled, you might want to reduce this. */);
Vtruncate_partial_width_windows = make_number (50);
- DEFVAR_BOOL ("mode-line-inverse-video", mode_line_inverse_video,
- doc: /* When nil, display the mode-line/header-line/menu-bar in the default face.
-Any other value means to use the appropriate face, `mode-line',
-`header-line', or `menu' respectively. */);
- mode_line_inverse_video = 1;
-
DEFVAR_LISP ("line-number-display-limit", Vline_number_display_limit,
- doc: /* *Maximum buffer size for which line number should be displayed.
+ doc: /* Maximum buffer size for which line number should be displayed.
If the buffer is bigger than this, the line number does not appear
in the mode line. A value of nil means no limit. */);
Vline_number_display_limit = Qnil;
DEFVAR_INT ("line-number-display-limit-width",
line_number_display_limit_width,
- doc: /* *Maximum line width (in characters) for line number display.
+ doc: /* Maximum line width (in characters) for line number display.
If the average length of the lines near point is bigger than this, then the
line number may be omitted from the mode line. */);
line_number_display_limit_width = 200;
DEFVAR_BOOL ("highlight-nonselected-windows", highlight_nonselected_windows,
- doc: /* *Non-nil means highlight region even in nonselected windows. */);
+ doc: /* Non-nil means highlight region even in nonselected windows. */);
highlight_nonselected_windows = 0;
DEFVAR_BOOL ("multiple-frames", multiple_frames,
\(see `modify-frame-parameters'). */);
Vicon_title_format
= Vframe_title_format
- = pure_cons (intern_c_string ("multiple-frames"),
- pure_cons (make_pure_c_string ("%b"),
- pure_cons (pure_cons (empty_unibyte_string,
- pure_cons (intern_c_string ("invocation-name"),
- pure_cons (make_pure_c_string ("@"),
- pure_cons (intern_c_string ("system-name"),
- Qnil)))),
- Qnil)));
+ = listn (CONSTYPE_PURE, 3,
+ intern_c_string ("multiple-frames"),
+ build_pure_c_string ("%b"),
+ listn (CONSTYPE_PURE, 4,
+ empty_unibyte_string,
+ intern_c_string ("invocation-name"),
+ build_pure_c_string ("@"),
+ intern_c_string ("system-name")));
DEFVAR_LISP ("message-log-max", Vmessage_log_max,
doc: /* Maximum number of lines to keep in the message log buffer.
Vredisplay_end_trigger_functions = Qnil;
DEFVAR_LISP ("mouse-autoselect-window", Vmouse_autoselect_window,
- doc: /* *Non-nil means autoselect window with mouse pointer.
+ doc: /* Non-nil means autoselect window with mouse pointer.
If nil, do not autoselect windows.
A positive number means delay autoselection by that many seconds: a
window is autoselected only after the mouse has remained in that
Vmouse_autoselect_window = Qnil;
DEFVAR_LISP ("auto-resize-tool-bars", Vauto_resize_tool_bars,
- doc: /* *Non-nil means automatically resize tool-bars.
+ doc: /* Non-nil means automatically resize tool-bars.
This dynamically changes the tool-bar's height to the minimum height
that is needed to make all tool-bar items visible.
If value is `grow-only', the tool-bar's height is only increased
Vauto_resize_tool_bars = Qt;
DEFVAR_BOOL ("auto-raise-tool-bar-buttons", auto_raise_tool_bar_buttons_p,
- doc: /* *Non-nil means raise tool-bar buttons when the mouse moves over them. */);
+ doc: /* Non-nil means raise tool-bar buttons when the mouse moves over them. */);
auto_raise_tool_bar_buttons_p = 1;
DEFVAR_BOOL ("make-cursor-line-fully-visible", make_cursor_line_fully_visible_p,
- doc: /* *Non-nil means to scroll (recenter) cursor line if it is not fully visible. */);
+ doc: /* Non-nil means to scroll (recenter) cursor line if it is not fully visible. */);
make_cursor_line_fully_visible_p = 1;
DEFVAR_LISP ("tool-bar-border", Vtool_bar_border,
- doc: /* *Border below tool-bar in pixels.
+ doc: /* Border below tool-bar in pixels.
If an integer, use it as the height of the border.
If it is one of `internal-border-width' or `border-width', use the
value of the corresponding frame parameter.
Vtool_bar_border = Qinternal_border_width;
DEFVAR_LISP ("tool-bar-button-margin", Vtool_bar_button_margin,
- doc: /* *Margin around tool-bar buttons in pixels.
+ doc: /* Margin around tool-bar buttons in pixels.
If an integer, use that for both horizontal and vertical margins.
Otherwise, value should be a pair of integers `(HORZ . VERT)' with
HORZ specifying the horizontal margin, and VERT specifying the
Vtool_bar_button_margin = make_number (DEFAULT_TOOL_BAR_BUTTON_MARGIN);
DEFVAR_INT ("tool-bar-button-relief", tool_bar_button_relief,
- doc: /* *Relief thickness of tool-bar buttons. */);
+ doc: /* Relief thickness of tool-bar buttons. */);
tool_bar_button_relief = DEFAULT_TOOL_BAR_BUTTON_RELIEF;
DEFVAR_LISP ("tool-bar-style", Vtool_bar_style,
both - show both, text below image
both-horiz - show text to the right of the image
text-image-horiz - show text to the left of the image
- any other - use system default or image if no system default. */);
+ any other - use system default or image if no system default.
+
+This variable only affects the GTK+ toolkit version of Emacs. */);
Vtool_bar_style = Qnil;
DEFVAR_INT ("tool-bar-max-label-size", tool_bar_max_label_size,
- doc: /* *Maximum number of characters a label can have to be shown.
+ doc: /* Maximum number of characters a label can have to be shown.
The tool bar style must also show labels for this to have any effect, see
`tool-bar-style'. */);
tool_bar_max_label_size = DEFAULT_TOOL_BAR_LABEL_SIZE;
DEFVAR_BOOL ("unibyte-display-via-language-environment",
unibyte_display_via_language_environment,
- doc: /* *Non-nil means display unibyte text according to language environment.
+ doc: /* Non-nil means display unibyte text according to language environment.
Specifically, this means that raw bytes in the range 160-255 decimal
are displayed by converting them to the equivalent multibyte characters
according to the current language environment. As a result, they are
unibyte_display_via_language_environment = 0;
DEFVAR_LISP ("max-mini-window-height", Vmax_mini_window_height,
- doc: /* *Maximum height for resizing mini-windows (the minibuffer and the echo area).
+ doc: /* Maximum height for resizing mini-windows (the minibuffer and the echo area).
If a float, it specifies a fraction of the mini-window frame's height.
If an integer, it specifies a number of lines. */);
Vmax_mini_window_height = make_float (0.25);
DEFSYM (Qauto_hscroll_mode, "auto-hscroll-mode");
DEFVAR_INT ("hscroll-margin", hscroll_margin,
- doc: /* *How many columns away from the window edge point is allowed to get
+ doc: /* How many columns away from the window edge point is allowed to get
before automatic hscrolling will horizontally scroll the window. */);
hscroll_margin = 5;
DEFVAR_LISP ("hscroll-step", Vhscroll_step,
- doc: /* *How many columns to scroll the window when point gets too close to the edge.
+ doc: /* How many columns to scroll the window when point gets too close to the edge.
When point is less than `hscroll-margin' columns from the window
edge, automatic hscrolling will scroll the window by the amount of columns
determined by this variable. If its value is a positive integer, scroll that
doc: /* Non-nil means don't free realized faces. Internal use only. */);
inhibit_free_realized_faces = 0;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
DEFVAR_BOOL ("inhibit-try-window-id", inhibit_try_window_id,
doc: /* Inhibit try_window_id display optimization. */);
inhibit_try_window_id = 0;
#endif /* GLYPH_DEBUG */
DEFVAR_INT ("overline-margin", overline_margin,
- doc: /* *Space between overline and text, in pixels.
+ doc: /* Space between overline and text, in pixels.
The default value is 2: the height of the overline (1 pixel) plus 1 pixel
margin to the character height. */);
overline_margin = 2;
display_hourglass_p = 1;
DEFVAR_LISP ("hourglass-delay", Vhourglass_delay,
- doc: /* *Seconds to wait before displaying an hourglass pointer when Emacs is busy. */);
+ doc: /* Seconds to wait before displaying an hourglass pointer when Emacs is busy. */);
Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
hourglass_atimer = NULL;
Vglyphless_char_display = Fmake_char_table (Qglyphless_char_display, Qnil);
Fset_char_table_extra_slot (Vglyphless_char_display, make_number (0),
Qempty_box);
+
+ DEFVAR_LISP ("debug-on-message", Vdebug_on_message,
+ doc: /* If non-nil, debug if a message matching this regexp is displayed. */);
+ Vdebug_on_message = Qnil;
}
echo_area_window = minibuf_window;
- XSETFASTINT (r->top_line, FRAME_TOP_MARGIN (f));
- XSETFASTINT (r->total_lines, FRAME_LINES (f) - 1 - FRAME_TOP_MARGIN (f));
- XSETFASTINT (r->total_cols, FRAME_COLS (f));
- XSETFASTINT (m->top_line, FRAME_LINES (f) - 1);
- XSETFASTINT (m->total_lines, 1);
- XSETFASTINT (m->total_cols, FRAME_COLS (f));
+ wset_top_line (r, make_number (FRAME_TOP_MARGIN (f)));
+ wset_total_lines
+ (r, make_number (FRAME_LINES (f) - 1 - FRAME_TOP_MARGIN (f)));
+ wset_total_cols (r, make_number (FRAME_COLS (f)));
+ wset_top_line (m, make_number (FRAME_LINES (f) - 1));
+ wset_total_lines (m, make_number (1));
+ wset_total_cols (m, make_number (FRAME_COLS (f)));
scratch_glyph_row.glyphs[TEXT_AREA] = scratch_glyphs;
scratch_glyph_row.glyphs[TEXT_AREA + 1]
/* Allocate the buffer for frame titles.
Also used for `format-mode-line'. */
int size = 100;
- mode_line_noprop_buf = (char *) xmalloc (size);
+ mode_line_noprop_buf = xmalloc (size);
mode_line_noprop_buf_end = mode_line_noprop_buf + size;
mode_line_noprop_ptr = mode_line_noprop_buf;
mode_line_target = MODE_LINE_DISPLAY;
the following three functions in w32fns.c. */
#ifndef WINDOWSNT
-/* Platform-independent portion of hourglass implementation. */
-
-/* Return non-zero if hourglass timer has been started or hourglass is
- shown. */
-int
-hourglass_started (void)
-{
- return hourglass_shown_p || hourglass_atimer != NULL;
-}
+/* Platform-independent portion of hourglass implementation. */
/* Cancel a currently active hourglass timer, and start a new one. */
void
{
#if defined (HAVE_WINDOW_SYSTEM)
EMACS_TIME delay;
- int secs, usecs = 0;
cancel_hourglass ();
if (INTEGERP (Vhourglass_delay)
&& XINT (Vhourglass_delay) > 0)
- secs = XFASTINT (Vhourglass_delay);
+ delay = make_emacs_time (min (XINT (Vhourglass_delay),
+ TYPE_MAXIMUM (time_t)),
+ 0);
else if (FLOATP (Vhourglass_delay)
&& XFLOAT_DATA (Vhourglass_delay) > 0)
- {
- Lisp_Object tem;
- tem = Ftruncate (Vhourglass_delay, Qnil);
- secs = XFASTINT (tem);
- usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
- }
+ delay = EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (Vhourglass_delay));
else
- secs = DEFAULT_HOURGLASS_DELAY;
+ delay = make_emacs_time (DEFAULT_HOURGLASS_DELAY, 0);
- EMACS_SET_SECS_USECS (delay, secs, usecs);
hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
show_hourglass, NULL);
#endif
#include <sys/types.h>
#include <sys/stat.h>
#include <stdio.h> /* This needs to be before termchar.h */
-#include <setjmp.h>
#include "lisp.h"
#include "character.h"
#include "dosfns.h"
#endif
-#ifdef WINDOWSNT
-#include "w32term.h"
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
#include "fontset.h"
-/* Redefine X specifics to W32 equivalents to avoid cluttering the
- code with #ifdef blocks. */
+#ifdef WINDOWSNT
#undef FRAME_X_DISPLAY_INFO
#define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
#define x_display_info w32_display_info
-#define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
#define check_x check_w32
#define GCGraphicsExposures 0
#endif /* WINDOWSNT */
#ifdef HAVE_NS
-#include "nsterm.h"
#undef FRAME_X_DISPLAY_INFO
#define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
#define x_display_info ns_display_info
-#define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
#define check_x check_ns
#define GCGraphicsExposures 0
#endif /* HAVE_NS */
+#endif /* HAVE_WINDOW_SYSTEM */
#include "buffer.h"
#include "dispextern.h"
#include "termchar.h"
#include "font.h"
-#ifdef HAVE_WINDOW_SYSTEM
-#include "fontset.h"
-#endif /* HAVE_WINDOW_SYSTEM */
#ifdef HAVE_X_WINDOWS
#endif /* HAVE_X_WINDOWS */
-#include <ctype.h>
+#include <c-ctype.h>
/* Number of pt per inch (from the TeXbook). */
Lisp_Object Qnormal;
Lisp_Object Qbold;
-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;
+static Lisp_Object Qline, Qwave;
+static Lisp_Object Qultra_light, Qreverse_oblique, Qreverse_italic;
+Lisp_Object Qextra_light, Qlight;
+Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
+Lisp_Object Qoblique;
Lisp_Object Qitalic;
static Lisp_Object Qultra_condensed, Qextra_condensed;
Lisp_Object Qcondensed;
/* The total number of colors currently allocated. */
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static int ncolors_allocated;
static int npixmaps_allocated;
static int ngcs;
struct table_entry;
struct named_merge_point;
-static void map_tty_color (struct frame *, struct face *,
- enum lface_attribute_index, int *);
-static Lisp_Object resolve_face_name (Lisp_Object, int);
static void set_font_frame_param (Lisp_Object, Lisp_Object);
-static int get_lface_attributes (struct frame *, Lisp_Object, Lisp_Object *,
- int, struct named_merge_point *);
-static ptrdiff_t load_pixmap (struct frame *, Lisp_Object,
- unsigned *, unsigned *);
-static struct frame *frame_or_selected_frame (Lisp_Object, int);
-static void load_face_colors (struct frame *, struct face *, Lisp_Object *);
-static void free_face_colors (struct frame *, struct face *);
-static int face_color_gray_p (struct frame *, const char *);
static struct face *realize_face (struct face_cache *, Lisp_Object *,
int);
static struct face *realize_non_ascii_face (struct frame *, Lisp_Object,
static int realize_basic_faces (struct frame *);
static int realize_default_face (struct frame *);
static void realize_named_face (struct frame *, Lisp_Object, int);
-static int lface_fully_specified_p (Lisp_Object *);
-static int lface_equal_p (Lisp_Object *, Lisp_Object *);
-static unsigned hash_string_case_insensitive (Lisp_Object);
-static unsigned lface_hash (Lisp_Object *);
-static int lface_same_font_attributes_p (Lisp_Object *, Lisp_Object *);
static struct face_cache *make_face_cache (struct frame *);
static void clear_face_gcs (struct face_cache *);
static void free_face_cache (struct face_cache *);
-static int face_fontset (Lisp_Object *);
-static void merge_face_vectors (struct frame *, Lisp_Object *, Lisp_Object*,
- struct named_merge_point *);
static int merge_face_ref (struct frame *, Lisp_Object, Lisp_Object *,
int, struct named_merge_point *);
-static int set_lface_from_font (struct frame *, Lisp_Object, Lisp_Object,
- int);
-static Lisp_Object lface_from_face_name (struct frame *, Lisp_Object, int);
-static struct face *make_realized_face (Lisp_Object *);
-static void cache_face (struct face_cache *, struct face *, unsigned);
-static void uncache_face (struct face_cache *, struct face *);
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-static GC x_create_gc (struct frame *, unsigned long, XGCValues *);
-static void x_free_gc (struct frame *, GC);
-
-#ifdef USE_X_TOOLKIT
-static void x_update_menu_appearance (struct frame *);
-
-extern void free_frame_menubar (struct frame *);
-#endif /* USE_X_TOOLKIT */
-
-#endif /* HAVE_WINDOW_SYSTEM */
\f
/***********************************************************************
void
register_color (unsigned long pixel)
{
- xassert (pixel < 256);
+ eassert (pixel < 256);
++color_count[pixel];
}
void
unregister_color (unsigned long pixel)
{
- xassert (pixel < 256);
+ eassert (pixel < 256);
if (color_count[pixel] > 0)
--color_count[pixel];
else
- abort ();
+ emacs_abort ();
}
x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv)
{
GC gc;
- BLOCK_INPUT;
+ block_input ();
gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, xgcv);
- UNBLOCK_INPUT;
+ unblock_input ();
IF_DEBUG (++ngcs);
return gc;
}
static inline void
x_free_gc (struct frame *f, GC gc)
{
- eassert (interrupt_input_blocked);
- IF_DEBUG (xassert (--ngcs >= 0));
+ eassert (input_blocked_p ());
+ IF_DEBUG (eassert (--ngcs >= 0));
XFreeGC (FRAME_X_DISPLAY (f), gc);
}
x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
{
GC gc;
- BLOCK_INPUT;
+ block_input ();
gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, xgcv);
- UNBLOCK_INPUT;
+ unblock_input ();
IF_DEBUG (++ngcs);
return gc;
}
static inline void
x_free_gc (struct frame *f, GC gc)
{
- IF_DEBUG (xassert (--ngcs >= 0));
+ IF_DEBUG (eassert (--ngcs >= 0));
xfree (gc);
}
unsigned long mask,
XGCValues *xgcv)
{
- GC gc = xmalloc (sizeof (*gc));
- if (gc)
- memcpy (gc, xgcv, sizeof (XGCValues));
+ GC gc = xmalloc (sizeof *gc);
+ *gc = *xgcv;
return gc;
}
}
#endif /* HAVE_NS */
-/* Like strcasecmp/stricmp. Used to compare parts of font names which
- are in ISO8859-1. */
-
-int
-xstrcasecmp (const char *s1, const char *s2)
-{
- while (*s1 && *s2)
- {
- unsigned char b1 = *s1;
- unsigned char b2 = *s2;
- unsigned char c1 = tolower (b1);
- unsigned char c2 = tolower (b2);
- if (c1 != c2)
- return c1 < c2 ? -1 : 1;
- ++s1, ++s2;
- }
-
- if (*s1 == 0)
- return *s2 == 0 ? 0 : -1;
- return 1;
-}
-
-
/* If FRAME is nil, return a pointer to the selected frame.
Otherwise, check that FRAME is a live frame, and return a pointer
to it. NPARAM is the parameter number of FRAME, for
if (!FRAME_NS_P (f) || FRAME_NS_WINDOW (f))
#endif
if (!realize_basic_faces (f))
- abort ();
+ emacs_abort ();
}
{
clear_face_cache (0);
if (!realize_basic_faces (f))
- abort ();
+ emacs_abort ();
}
}
else if (CONSP (object))
{
/* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
- HEIGHT must be integers > 0, and DATA must be string large
+ HEIGHT must be ints > 0, and DATA must be string large
enough to hold a bitmap of the specified size. */
Lisp_Object width, height, data;
}
if (STRINGP (data)
- && INTEGERP (width) && 0 < XINT (width)
- && INTEGERP (height) && 0 < XINT (height))
+ && RANGED_INTEGERP (1, width, INT_MAX)
+ && RANGED_INTEGERP (1, height, INT_MAX))
{
- EMACS_INT bytes_per_row = ((XINT (width) + BITS_PER_CHAR - 1)
- / BITS_PER_CHAR);
+ int bytes_per_row = ((XINT (width) + BITS_PER_CHAR - 1)
+ / BITS_PER_CHAR);
if (XINT (height) <= SBYTES (data) / bytes_per_row)
pixmap_p = 1;
}
CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name);
- BLOCK_INPUT;
+ block_input ();
if (CONSP (name))
{
/* Decode a bitmap spec into a bitmap. */
/* It must be a string -- a file name. */
bitmap_id = x_create_bitmap_from_file (f, name);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (bitmap_id < 0)
{
}
else
{
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
++npixmaps_allocated;
#endif
if (w_ptr)
non-zero, then the `standard' definition of the same color is
returned in it. */
-static int
+static bool
tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color,
XColor *std_color)
{
/* A version of defined_color for non-X frames. */
-static int
+static bool
tty_defined_color (struct frame *f, const char *color_name,
- XColor *color_def, int alloc)
+ XColor *color_def, bool alloc)
{
- int status = 1;
+ bool status = 1;
/* Defaults. */
color_def->pixel = FACE_TTY_DEFAULT_COLOR;
/* Decide if color named COLOR_NAME is valid for the display
associated with the frame F; if so, return the rgb values in
- COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
+ COLOR_DEF. If ALLOC, allocate a new colormap cell.
This does the right thing for any type of frame. */
-static int
+static bool
defined_color (struct frame *f, const char *color_name, XColor *color_def,
- int alloc)
+ bool alloc)
{
if (!FRAME_WINDOW_P (f))
return tty_defined_color (f, color_name, color_def, alloc);
return ns_defined_color (f, color_name, color_def, alloc, 1);
#endif
else
- abort ();
+ emacs_abort ();
}
{
XColor color;
- xassert (STRINGP (name));
- xassert (target_index == LFACE_FOREGROUND_INDEX
+ eassert (STRINGP (name));
+ eassert (target_index == LFACE_FOREGROUND_INDEX
|| target_index == LFACE_BACKGROUND_INDEX
|| target_index == LFACE_UNDERLINE_INDEX
|| target_index == LFACE_OVERLINE_INDEX
break;
default:
- abort ();
+ emacs_abort ();
}
}
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
else
++ncolors_allocated;
#endif
#ifdef HAVE_X_WINDOWS
if (pixel != -1)
{
- BLOCK_INPUT;
+ block_input ();
x_free_colors (f, &pixel, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
}
if (face->colors_copied_bitwise_p)
return;
- BLOCK_INPUT;
+ block_input ();
if (!face->foreground_defaulted_p)
{
IF_DEBUG (--ncolors_allocated);
}
- UNBLOCK_INPUT;
+ unblock_input ();
#endif /* HAVE_X_WINDOWS */
}
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++)
else
{
if (INTEGERP (val1))
- result = INTEGERP (val2) ? XINT (val1) - XINT (val2) : -1;
+ result = (INTEGERP (val2) && XINT (val1) >= XINT (val2)
+ ? XINT (val1) > XINT (val2)
+ : -1);
else
result = INTEGERP (val2) ? 1 : 0;
}
(Lisp_Object family, Lisp_Object frame)
{
Lisp_Object font_spec, list, *drivers, vec;
- int i, nfonts, ndrivers;
+ ptrdiff_t i, nfonts;
+ EMACS_INT ndrivers;
Lisp_Object result;
+ USE_SAFE_ALLOCA;
if (NILP (frame))
frame = selected_frame;
font_props_for_sorting[i++] = FONT_REGISTRY_INDEX;
ndrivers = XINT (Flength (list));
- drivers = alloca (sizeof (Lisp_Object) * ndrivers);
+ SAFE_ALLOCA_LISP (drivers, ndrivers);
for (i = 0; i < ndrivers; i++, list = XCDR (list))
drivers[i] = XCAR (list);
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;
result = Fcons (v, result);
}
+ SAFE_FREE ();
return result;
}
#define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
#define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
-#if XASSERTS
/* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
(VECTORP (LFACE) \
&& ASIZE (LFACE) == LFACE_VECTOR_SIZE \
&& EQ (AREF (LFACE, 0), Qface))
-#endif
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check consistency of Lisp face attribute vector ATTRS. */
static void
check_lface_attrs (Lisp_Object *attrs)
{
- xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX])
|| STRINGP (attrs[LFACE_FAMILY_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FOUNDRY_INDEX])
|| STRINGP (attrs[LFACE_FOUNDRY_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_SWIDTH_INDEX])
|| SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX])
|| INTEGERP (attrs[LFACE_HEIGHT_INDEX])
|| FLOATP (attrs[LFACE_HEIGHT_INDEX])
|| FUNCTIONP (attrs[LFACE_HEIGHT_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_WEIGHT_INDEX])
|| SYMBOLP (attrs[LFACE_WEIGHT_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_SLANT_INDEX])
|| SYMBOLP (attrs[LFACE_SLANT_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_UNDERLINE_INDEX])
|| SYMBOLP (attrs[LFACE_UNDERLINE_INDEX])
- || STRINGP (attrs[LFACE_UNDERLINE_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
+ || STRINGP (attrs[LFACE_UNDERLINE_INDEX])
+ || CONSP (attrs[LFACE_UNDERLINE_INDEX]));
+ eassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_OVERLINE_INDEX])
|| SYMBOLP (attrs[LFACE_OVERLINE_INDEX])
|| STRINGP (attrs[LFACE_OVERLINE_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_STRIKE_THROUGH_INDEX])
|| SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX])
|| STRINGP (attrs[LFACE_STRIKE_THROUGH_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_BOX_INDEX])
|| SYMBOLP (attrs[LFACE_BOX_INDEX])
|| STRINGP (attrs[LFACE_BOX_INDEX])
|| INTEGERP (attrs[LFACE_BOX_INDEX])
|| CONSP (attrs[LFACE_BOX_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_INVERSE_INDEX])
|| SYMBOLP (attrs[LFACE_INVERSE_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FOREGROUND_INDEX])
|| STRINGP (attrs[LFACE_FOREGROUND_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_BACKGROUND_INDEX])
|| STRINGP (attrs[LFACE_BACKGROUND_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_INHERIT_INDEX])
|| NILP (attrs[LFACE_INHERIT_INDEX])
|| SYMBOLP (attrs[LFACE_INHERIT_INDEX])
|| CONSP (attrs[LFACE_INHERIT_INDEX]));
#ifdef HAVE_WINDOW_SYSTEM
- xassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_STIPPLE_INDEX])
|| SYMBOLP (attrs[LFACE_STIPPLE_INDEX])
|| !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
- xassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FONT_INDEX])
|| FONTP (attrs[LFACE_FONT_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX])
+ eassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX])
|| STRINGP (attrs[LFACE_FONTSET_INDEX])
|| NILP (attrs[LFACE_FONTSET_INDEX]));
#endif
{
if (!NILP (lface))
{
- xassert (LFACEP (lface));
+ eassert (LFACEP (lface));
check_lface_attrs (XVECTOR (lface)->contents);
}
}
-#else /* GLYPH_DEBUG == 0 */
+#else /* not GLYPH_DEBUG */
#define check_lface_attrs(attrs) (void) 0
#define check_lface(lface) (void) 0
-#endif /* GLYPH_DEBUG == 0 */
+#endif /* GLYPH_DEBUG */
\f
{
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)))
{
int pt = PIXEL_TO_POINT (font->pixel_size * 10, f->resy);
- xassert (pt > 0);
- LFACE_HEIGHT (lface) = make_number (pt);
+ eassert (pt > 0);
+ 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;
}
{
if (INTEGERP (to))
/* relative X absolute => absolute */
- result = make_number ((EMACS_INT)(XFLOAT_DATA (from) * XINT (to)));
+ result = make_number (XFLOAT_DATA (from) * XINT (to));
else if (FLOATP (to))
/* relative X relative => relative */
result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to));
{
/* Call function with current height as argument.
From is the new height. */
- Lisp_Object args[2];
-
- args[0] = from;
- args[1] = to;
- result = safe_call (2, args);
+ result = safe_call1 (from, to);
/* Ensure that if TO was absolute, so is the result. */
if (INTEGERP (to) && !INTEGERP (result))
struct named_merge_point *named_merge_points)
{
int i;
+ Lisp_Object font = Qnil;
/* If FROM inherits from some other faces, merge their attributes into
TO before merging FROM's direct attributes. Note that an :inherit
&& !NILP (from[LFACE_INHERIT_INDEX]))
merge_face_ref (f, from[LFACE_INHERIT_INDEX], to, 0, named_merge_points);
- i = LFACE_FONT_INDEX;
- if (!UNSPECIFIEDP (from[i]))
+ if (FONT_SPEC_P (from[LFACE_FONT_INDEX]))
{
- if (!UNSPECIFIEDP (to[i]))
- to[i] = merge_font_spec (from[i], to[i]);
+ if (!UNSPECIFIEDP (to[LFACE_FONT_INDEX]))
+ font = merge_font_spec (from[LFACE_FONT_INDEX], to[LFACE_FONT_INDEX]);
else
- to[i] = copy_font_spec (from[i]);
- if (! NILP (AREF (to[i], FONT_FOUNDRY_INDEX)))
- to[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FOUNDRY_INDEX));
- if (! NILP (AREF (to[i], FONT_FAMILY_INDEX)))
- to[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FAMILY_INDEX));
- if (! NILP (AREF (to[i], FONT_WEIGHT_INDEX)))
- to[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (to[i]);
- if (! NILP (AREF (to[i], FONT_SLANT_INDEX)))
- to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (to[i]);
- if (! NILP (AREF (to[i], FONT_WIDTH_INDEX)))
- to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (to[i]);
- ASET (to[i], FONT_SIZE_INDEX, Qnil);
+ font = copy_font_spec (from[LFACE_FONT_INDEX]);
+ to[LFACE_FONT_INDEX] = font;
}
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
to[i] = merge_face_heights (from[i], to[i], to[i]);
font_clear_prop (to, FONT_SIZE_INDEX);
}
- else if (i != LFACE_FONT_INDEX
- && ! EQ (to[i], from[i]))
+ else if (i != LFACE_FONT_INDEX && ! EQ (to[i], from[i]))
{
to[i] = from[i];
if (i >= LFACE_FAMILY_INDEX && i <=LFACE_SLANT_INDEX)
}
}
+ /* If FROM specifies a font spec, make its contents take precedence
+ over :family and other attributes. This is needed for face
+ remapping using :font to work. */
+
+ if (!NILP (font))
+ {
+ if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
+ to[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX));
+ if (! NILP (AREF (font, FONT_FAMILY_INDEX)))
+ to[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX));
+ if (! NILP (AREF (font, FONT_WEIGHT_INDEX)))
+ to[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (font);
+ if (! NILP (AREF (font, FONT_SLANT_INDEX)))
+ to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font);
+ if (! NILP (AREF (font, FONT_WIDTH_INDEX)))
+ to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font);
+ ASET (font, FONT_SIZE_INDEX, Qnil);
+ }
+
/* TO is always an absolute face, which should inherit from nothing.
We blindly copy the :inherit attribute above and fix it up here. */
to[LFACE_INHERIT_INDEX] = Qnil;
{
if (EQ (value, Qt)
|| NILP (value)
- || STRINGP (value))
+ || STRINGP (value)
+ || CONSP (value))
to[LFACE_UNDERLINE_INDEX] = value;
else
err = 1;
}
else if (EQ (keyword, QCstipple))
{
-#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
+#if defined (HAVE_WINDOW_SYSTEM)
Lisp_Object pixmap_p = Fbitmap_spec_p (value);
if (!NILP (pixmap_p))
to[LFACE_STIPPLE_INDEX] = value;
else
err = 1;
-#endif
+#endif /* HAVE_WINDOW_SYSTEM */
}
else if (EQ (keyword, QCwidth))
{
else
err = 1;
}
+ else if (EQ (keyword, QCfont))
+ {
+ if (FONTP (value))
+ to[LFACE_FONT_INDEX] = value;
+ else
+ err = 1;
+ }
else if (EQ (keyword, QCinherit))
{
/* This is not really very useful; it's just like a
property `face' of the Lisp face name. */
if (next_lface_id == lface_id_to_name_size)
lface_id_to_name =
- xpalloc (lface_id_to_name, &lface_id_to_name_size, 1,
- min (INT_MAX, MOST_POSITIVE_FIXNUM),
+ xpalloc (lface_id_to_name, &lface_id_to_name_size, 1, MAX_FACE_ID,
sizeof *lface_id_to_name);
lface_id_to_name[next_lface_id] = face;
lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
Qunspecified);
ASET (lface, 0, Qface);
- f->face_alist = Fcons (Fcons (face, lface), f->face_alist);
+ fset_face_alist (f, Fcons (Fcons (face, lface), f->face_alist));
}
else
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
++windows_or_buffers_changed;
}
- xassert (LFACEP (lface));
+ eassert (LFACEP (lface));
check_lface (lface);
return lface;
}
copy = Finternal_make_lisp_face (to, new_frame);
}
- memcpy (XVECTOR (copy)->contents, XVECTOR (lface)->contents,
- LFACE_VECTOR_SIZE * sizeof (Lisp_Object));
+ vcopy (copy, 0, XVECTOR (lface)->contents, LFACE_VECTOR_SIZE);
/* Changing a named face means that all realized faces depending on
that face are invalid. Since we cannot tell which realized faces
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))
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))
}
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))
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))
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))
{
- if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
- if ((SYMBOLP (value)
- && !EQ (value, Qt)
- && !EQ (value, Qnil))
- /* Underline color. */
- || (STRINGP (value)
- && SCHARS (value) == 0))
- signal_error ("Invalid face underline", value);
+ int valid_p = 0;
+
+ if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value))
+ valid_p = 1;
+ else if (NILP (value) || EQ (value, Qt))
+ valid_p = 1;
+ else if (STRINGP (value) && SCHARS (value) > 0)
+ valid_p = 1;
+ else if (CONSP (value))
+ {
+ Lisp_Object key, val, list;
+
+ list = value;
+ valid_p = 1;
+
+ while (!NILP (CAR_SAFE(list)))
+ {
+ key = CAR_SAFE (list);
+ list = CDR_SAFE (list);
+ val = CAR_SAFE (list);
+ list = CDR_SAFE (list);
+
+ if (NILP (key) || NILP (val))
+ {
+ valid_p = 0;
+ break;
+ }
+
+ else if (EQ (key, QCcolor)
+ && !(EQ (val, Qforeground_color)
+ || (STRINGP (val) && SCHARS (val) > 0)))
+ {
+ valid_p = 0;
+ break;
+ }
+
+ else if (EQ (key, QCstyle)
+ && !(EQ (val, Qline) || EQ (val, Qwave)))
+ {
+ valid_p = 0;
+ break;
+ }
+ }
+ }
+
+ if (!valid_p)
+ 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))
{
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))
{
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))
{
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))
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))
{
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))
{
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))
{
-#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
+#if defined (HAVE_WINDOW_SYSTEM)
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)
&& !NILP (value)
&& NILP (Fbitmap_spec_p (value)))
signal_error ("Invalid stipple attribute", value);
old_value = LFACE_STIPPLE (lface);
- LFACE_STIPPLE (lface) = value;
-#endif /* HAVE_X_WINDOWS || HAVE_NS */
+ ASET (lface, LFACE_STIPPLE_INDEX, value);
+#endif /* HAVE_WINDOW_SYSTEM */
}
else if (EQ (attr, QCwidth))
{
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))
set_lface_from_font (f, lface, value, 1);
}
else
- LFACE_FONT (lface) = value;
+ ASET (lface, LFACE_FONT_INDEX, value);
}
#endif /* HAVE_WINDOW_SYSTEM */
}
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 */
}
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
{
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))
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
{
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
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));
CHECK_STRING (resource);
CHECK_STRING (class);
CHECK_LIVE_FRAME (frame);
- BLOCK_INPUT;
+ block_input ();
value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
resource, class, Qnil, Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
{
Lisp_Object result = make_number (0);
- xassert (STRINGP (value));
+ eassert (STRINGP (value));
if (xstrcasecmp (SSDATA (value), "on") == 0
|| xstrcasecmp (SSDATA (value), "true") == 0)
gvec = XVECTOR (global_lface)->contents;
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
if (IGNORE_DEFFACE_P (gvec[i]))
- lvec[i] = Qunspecified;
+ ASET (local_lface, i, Qunspecified);
else if (! UNSPECIFIEDP (gvec[i]))
- lvec[i] = gvec[i];
+ ASET (local_lface, i, AREF (global_lface, i));
/* If the default face was changed, update the face cache and the
`font' frame parameter. */
the previously-cached vector. */
memcpy (attrs, oldface->lface, sizeof attrs);
merge_face_vectors (f, lvec, attrs, 0);
- memcpy (lvec, attrs, sizeof attrs);
+ vcopy (local_lface, 0, attrs, LFACE_VECTOR_SIZE);
newface = realize_face (c, lvec, DEFAULT_FACE_ID);
if ((! UNSPECIFIEDP (gvec[LFACE_FAMILY_INDEX])
{
const unsigned char *s;
unsigned hash = 0;
- xassert (STRINGP (string));
+ eassert (STRINGP (string));
for (s = SDATA (string); *s; ++s)
- hash = (hash << 1) ^ tolower (*s);
+ hash = (hash << 1) ^ c_tolower (*s);
return hash;
}
static inline int
lface_same_font_attributes_p (Lisp_Object *lface1, Lisp_Object *lface2)
{
- xassert (lface_fully_specified_p (lface1)
+ eassert (lface_fully_specified_p (lface1)
&& lface_fully_specified_p (lface2));
return (xstrcasecmp (SSDATA (lface1[LFACE_FAMILY_INDEX]),
SSDATA (lface2[LFACE_FAMILY_INDEX])) == 0
static struct face *
make_realized_face (Lisp_Object *attr)
{
- struct face *face = (struct face *) xmalloc (sizeof *face);
- memset (face, 0, sizeof *face);
+ struct face *face = xzalloc (sizeof *face);
face->ascii_face = face;
memcpy (face->lface, attr, sizeof face->lface);
return face;
free_face_fontset (f, face);
if (face->gc)
{
- BLOCK_INPUT;
+ block_input ();
if (face->font)
font_done_for_face (f, face);
x_free_gc (f, face->gc);
face->gc = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
free_face_colors (f, face);
prepare_face_for_display (struct frame *f, struct face *face)
{
#ifdef HAVE_WINDOW_SYSTEM
- xassert (FRAME_WINDOW_P (f));
+ eassert (FRAME_WINDOW_P (f));
if (face->gc == 0)
{
xgcv.graphics_exposures = False;
#endif
- BLOCK_INPUT;
+ block_input ();
#ifdef HAVE_X_WINDOWS
if (face->stipple)
{
face->gc = x_create_gc (f, mask, &xgcv);
if (face->font)
font_prepare_for_face (f, face);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_WINDOW_SYSTEM */
}
struct face_cache *c;
int size;
- c = (struct face_cache *) xmalloc (sizeof *c);
- memset (c, 0, sizeof *c);
+ c = xzalloc (sizeof *c);
size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
- c->buckets = (struct face **) xmalloc (size);
- memset (c->buckets, 0, size);
+ c->buckets = xzalloc (size);
c->size = 50;
- c->faces_by_id = (struct face **) xmalloc (c->size * sizeof *c->faces_by_id);
+ c->faces_by_id = xmalloc (c->size * sizeof *c->faces_by_id);
c->f = f;
c->menu_face_changed_p = menu_face_changed_default;
return c;
struct face *face = c->faces_by_id[i];
if (face && face->gc)
{
- BLOCK_INPUT;
+ block_input ();
if (face->font)
font_done_for_face (c->f, face);
x_free_gc (c->f, face->gc);
face->gc = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
#endif /* HAVE_WINDOW_SYSTEM */
/* We must block input here because we can't process X events
safely while only some faces are freed, or when the frame's
current matrix still references freed faces. */
- BLOCK_INPUT;
+ block_input ();
for (i = 0; i < c->used; ++i)
{
++windows_or_buffers_changed;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
break;
face->id = i;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that FACE got a unique id. */
{
int j, n;
if (face1->id == i)
++n;
- xassert (n == 1);
+ eassert (n == 1);
}
#endif /* GLYPH_DEBUG */
int i;
struct face *face;
- xassert (cache != NULL);
+ eassert (cache != NULL);
check_lface_attrs (attr);
/* Look up ATTR in the face cache. */
if (face == NULL)
face = realize_face (cache, attr, -1);
-#if GLYPH_DEBUG
- xassert (face == FACE_FROM_ID (f, face->id));
+#ifdef GLYPH_DEBUG
+ eassert (face == FACE_FROM_ID (f, face->id));
#endif /* GLYPH_DEBUG */
return face->id;
int i;
struct face *face;
- xassert (cache != NULL);
+ eassert (cache != NULL);
base_face = base_face->ascii_face;
hash = lface_hash (base_face->lface);
i = hash % FACE_CACHE_BUCKETS_SIZE;
return -1;
default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
if (default_face == NULL)
- abort (); /* realize_basic_faces must have set it up */
+ emacs_abort (); /* realize_basic_faces must have set it up */
}
if (! get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
}
-/* Return the display face-id of the basic face who's canonical face-id
+/* Return the display face-id of the basic face whose canonical face-id
is FACE_ID. The return value will usually simply be FACE_ID, unless that
basic face has bee remapped via Vface_remapping_alist. This function is
conservative: if something goes wrong, it will simply return FACE_ID
case MENU_FACE_ID: name = Qmenu; break;
default:
- abort (); /* the caller is supposed to pass us a basic face id */
+ emacs_abort (); /* the caller is supposed to pass us a basic face id */
}
/* Do a quick scan through Vface_remapping_alist, and return immediately
struct face *default_face = FACE_FROM_ID (f, face_id);
if (!default_face)
- abort ();
+ emacs_abort ();
if (!get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
return -1;
tty_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs,
struct face *def_face)
{
- int weight;
+ int weight, slant;
Lisp_Object val, fg, bg;
XColor fg_tty_color, fg_std_color;
XColor bg_tty_color, bg_std_color;
unsigned test_caps = 0;
Lisp_Object *def_attrs = def_face->lface;
-
/* First check some easy-to-check stuff; ttys support none of the
following attributes, so we can just return false if any are requested
(even if `nominal' values are specified, we should still return false,
|| !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX])
- || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX])
- || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]))
+ || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]))
return 0;
-
/* Test for terminal `capabilities' (non-color character attributes). */
/* font weight (bold/dim) */
return 0; /* same as default */
}
+ /* font slant */
+ val = attrs[LFACE_SLANT_INDEX];
+ if (!UNSPECIFIEDP (val)
+ && (slant = FONT_SLANT_NAME_NUMERIC (val), slant >= 0))
+ {
+ int def_slant = FONT_SLANT_NAME_NUMERIC (def_attrs[LFACE_SLANT_INDEX]);
+ if (slant == 100 || slant == def_slant)
+ return 0; /* same as default */
+ else
+ test_caps |= TTY_CAP_ITALIC;
+ }
+
/* underlining */
val = attrs[LFACE_UNDERLINE_INDEX];
if (!UNSPECIFIEDP (val))
error ("Cannot realize default face");
def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
if (def_face == NULL)
- abort (); /* realize_basic_faces must have set it up */
+ emacs_abort (); /* realize_basic_faces must have set it up */
}
/* Dispatch to the appropriate handler. */
realize_basic_faces (struct frame *f)
{
int success_p = 0;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
/* Block input here so that we won't be surprised by an X expose
event, for instance, without having the faces set up. */
- BLOCK_INPUT;
+ block_input ();
specbind (Qscalable_fonts_allowed, Qt);
if (realize_default_face (f))
}
unbind_to (count, Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
return success_p;
}
/* If the `default' face is not yet known, create it. */
lface = lface_from_face_name (f, Qdefault, 0);
if (NILP (lface))
- {
+ {
Lisp_Object frame;
XSETFRAME (frame, f);
lface = Finternal_make_lisp_face (Qdefault, frame);
- }
+ }
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (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)))
{
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 ();
+ emacs_abort ();
}
if (UNSPECIFIEDP (LFACE_BACKGROUND (lface)))
set in the frame parameter list. */
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 ();
+ emacs_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. */
- xassert (lface_fully_specified_p (XVECTOR (lface)->contents));
+ eassert (lface_fully_specified_p (XVECTOR (lface)->contents));
check_lface (lface);
memcpy (attrs, XVECTOR (lface)->contents, sizeof attrs);
face = realize_face (c, attrs, DEFAULT_FACE_ID);
/* The default face must exist and be fully specified. */
get_lface_attributes_no_remap (f, Qdefault, attrs, 1);
check_lface_attrs (attrs);
- xassert (lface_fully_specified_p (attrs));
+ eassert (lface_fully_specified_p (attrs));
/* If SYMBOL isn't know as a face, create it. */
if (NILP (lface))
struct face *face;
/* LFACE must be fully specified. */
- xassert (cache != NULL);
+ eassert (cache != NULL);
check_lface_attrs (attrs);
if (former_face_id >= 0 && cache->used > former_face_id)
face = make_realized_face (attrs);
}
else
- abort ();
+ emacs_abort ();
/* Insert the new face. */
cache_face (cache, face, lface_hash (attrs));
struct face_cache *cache = FRAME_FACE_CACHE (f);
struct face *face;
- face = (struct face *) xmalloc (sizeof *face);
+ face = xmalloc (sizeof *face);
*face = *base_face;
face->gc = 0;
face->extra = NULL;
#ifdef HAVE_WINDOW_SYSTEM
struct face *default_face;
struct frame *f;
- Lisp_Object stipple, overline, strike_through, box;
+ Lisp_Object stipple, underline, overline, strike_through, box;
- xassert (FRAME_WINDOW_P (cache->f));
+ eassert (FRAME_WINDOW_P (cache->f));
/* Allocate a new realized face. */
face = make_realized_face (attrs);
if (default_face)
fontset = default_face->fontset;
if (fontset == -1)
- abort ();
+ emacs_abort ();
}
if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
attrs[LFACE_FONT_INDEX]
{
/* Simple box of specified line width in foreground color of the
face. */
- xassert (XINT (box) != 0);
+ eassert (XINT (box) != 0);
face->box = FACE_SIMPLE_BOX;
face->box_line_width = XINT (box);
face->box_color = face->foreground;
/* Text underline, overline, strike-through. */
- if (EQ (attrs[LFACE_UNDERLINE_INDEX], Qt))
+ underline = attrs[LFACE_UNDERLINE_INDEX];
+ if (EQ (underline, Qt))
{
/* Use default color (same as foreground color). */
face->underline_p = 1;
+ face->underline_type = FACE_UNDER_LINE;
face->underline_defaulted_p = 1;
face->underline_color = 0;
}
- else if (STRINGP (attrs[LFACE_UNDERLINE_INDEX]))
+ else if (STRINGP (underline))
{
/* Use specified color. */
face->underline_p = 1;
+ face->underline_type = FACE_UNDER_LINE;
face->underline_defaulted_p = 0;
face->underline_color
- = load_color (f, face, attrs[LFACE_UNDERLINE_INDEX],
+ = load_color (f, face, underline,
LFACE_UNDERLINE_INDEX);
}
- else if (NILP (attrs[LFACE_UNDERLINE_INDEX]))
+ else if (NILP (underline))
{
face->underline_p = 0;
face->underline_defaulted_p = 0;
face->underline_color = 0;
}
+ else if (CONSP (underline))
+ {
+ /* `(:color COLOR :style STYLE)'.
+ STYLE being one of `line' or `wave'. */
+ face->underline_p = 1;
+ face->underline_color = 0;
+ face->underline_defaulted_p = 1;
+ face->underline_type = FACE_UNDER_LINE;
+
+ while (CONSP (underline))
+ {
+ Lisp_Object keyword, value;
+
+ keyword = XCAR (underline);
+ underline = XCDR (underline);
+
+ if (!CONSP (underline))
+ break;
+ value = XCAR (underline);
+ underline = XCDR (underline);
+
+ if (EQ (keyword, QCcolor))
+ {
+ if (EQ (value, Qforeground_color))
+ {
+ face->underline_defaulted_p = 1;
+ face->underline_color = 0;
+ }
+ else if (STRINGP (value))
+ {
+ face->underline_defaulted_p = 0;
+ face->underline_color = load_color (f, face, value,
+ LFACE_UNDERLINE_INDEX);
+ }
+ }
+ else if (EQ (keyword, QCstyle))
+ {
+ if (EQ (value, Qline))
+ face->underline_type = FACE_UNDER_LINE;
+ else if (EQ (value, Qwave))
+ face->underline_type = FACE_UNDER_WAVE;
+ }
+ }
+ }
overline = attrs[LFACE_OVERLINE_INDEX];
if (STRINGP (overline))
foreground_p ? FACE_TTY_DEFAULT_BG_COLOR : FACE_TTY_DEFAULT_FG_COLOR;
#endif
- xassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
+ eassert (idx == LFACE_FOREGROUND_INDEX || idx == LFACE_BACKGROUND_INDEX);
XSETFRAME (frame, f);
color = face->lface[idx];
struct frame *f = cache->f;
/* Frame must be a termcap frame. */
- xassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f));
+ eassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f));
/* Allocate a new realized face. */
face = make_realized_face (attrs);
face->font_name = FRAME_MSDOS_P (cache->f) ? "ms-dos" : "tty";
#endif
- /* Map face attributes to TTY appearances. We map slant to
- dimmed text because we want italic text to appear differently
- and because dimmed text is probably used infrequently. */
+ /* Map face attributes to TTY appearances. */
weight = FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]);
slant = FONT_SLANT_NAME_NUMERIC (attrs[LFACE_SLANT_INDEX]);
if (weight > 100)
face->tty_bold_p = 1;
- if (weight < 100 || slant != 100)
- face->tty_dim_p = 1;
+ if (slant != 100)
+ face->tty_italic_p = 1;
if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
face->tty_underline_p = 1;
if (!NILP (attrs[LFACE_INVERSE_INDEX]))
The face returned is suitable for displaying ASCII characters. */
int
-face_at_buffer_position (struct window *w, EMACS_INT pos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, EMACS_INT limit,
+face_at_buffer_position (struct window *w, ptrdiff_t pos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, int base_face_id)
{
struct frame *f = XFRAME (w->frame);
Lisp_Object prop, position;
ptrdiff_t i, noverlays;
Lisp_Object *overlay_vec;
- Lisp_Object frame;
- EMACS_INT endpos;
+ ptrdiff_t endpos;
Lisp_Object propname = mouse ? Qmouse_face : Qface;
Lisp_Object limit1, end;
struct face *default_face;
/* W must display the current buffer. We could write this function
to use the frame and buffer of W, but right now it doesn't. */
- /* xassert (XBUFFER (w->buffer) == current_buffer); */
+ /* eassert (XBUFFER (w->buffer) == current_buffer); */
- XSETFRAME (frame, f);
XSETFASTINT (position, pos);
endpos = ZV;
/* Look at properties from overlays. */
{
- EMACS_INT next_overlay;
+ ptrdiff_t next_overlay;
GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay, 0);
if (next_overlay < endpos)
for (i = 0; i < noverlays; i++)
{
Lisp_Object oend;
- int oendpos;
+ ptrdiff_t oendpos;
prop = Foverlay_get (overlay_vec[i], propname);
if (!NILP (prop))
simply disregards the `face' properties of all overlays. */
int
-face_for_overlay_string (struct window *w, EMACS_INT pos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, EMACS_INT limit,
+face_for_overlay_string (struct window *w, ptrdiff_t pos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, Lisp_Object overlay)
{
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;
/* W must display the current buffer. We could write this function
to use the frame and buffer of W, but right now it doesn't. */
- /* xassert (XBUFFER (w->buffer) == current_buffer); */
+ /* eassert (XBUFFER (w->buffer) == current_buffer); */
- XSETFRAME (frame, f);
XSETFASTINT (position, pos);
endpos = ZV;
*endptr = endpos;
- default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
-
- /* Optimize common cases where we can use the default face. */
+ /* Optimize common case where we can use the default face. */
if (NILP (prop)
- && !(pos >= region_beg && pos < region_end))
+ && !(pos >= region_beg && pos < region_end)
+ && NILP (Vface_remapping_alist))
return DEFAULT_FACE_ID;
/* Begin with attributes from the default face. */
+ default_face = FACE_FROM_ID (f, lookup_basic_face (f, DEFAULT_FACE_ID));
memcpy (attrs, default_face->lface, sizeof attrs);
/* Merge in attributes specified via text properties. */
int
face_at_string_position (struct window *w, Lisp_Object string,
- EMACS_INT pos, EMACS_INT bufpos,
- EMACS_INT region_beg, EMACS_INT region_end,
- EMACS_INT *endptr, enum face_id base_face_id,
+ ptrdiff_t pos, ptrdiff_t bufpos,
+ ptrdiff_t region_beg, ptrdiff_t region_end,
+ ptrdiff_t *endptr, enum face_id base_face_id,
int mouse_p)
{
Lisp_Object prop, position, end, limit;
*endptr = -1;
base_face = FACE_FROM_ID (f, base_face_id);
- xassert (base_face);
+ eassert (base_face);
/* Optimize the default case that there is no face property and we
are not in the region. */
*/
int
-merge_faces (struct frame *f, Lisp_Object face_name, EMACS_INT face_id,
+merge_faces (struct frame *f, Lisp_Object face_name, int face_id,
int base_face_id)
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
CHECK_STRING (filename);
abspath = Fexpand_file_name (filename, Qnil);
- fp = fopen (SDATA (abspath), "rt");
+ fp = fopen (SSDATA (abspath), "rt");
if (fp)
{
char buf[512];
int red, green, blue;
int num;
- BLOCK_INPUT;
+ block_input ();
while (fgets (buf, sizeof (buf), fp) != NULL) {
if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
}
fclose (fp);
- UNBLOCK_INPUT;
+ unblock_input ();
}
return cmap;
Tests
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Print the contents of the realized face FACE to stderr. */
return Qnil;
}
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
\f
DEFSYM (QCcolor, ":color");
DEFSYM (QCline_width, ":line-width");
DEFSYM (QCstyle, ":style");
+ DEFSYM (Qline, "line");
+ DEFSYM (Qwave, "wave");
DEFSYM (Qreleased_button, "released-button");
DEFSYM (Qpressed_button, "pressed-button");
DEFSYM (Qnormal, "normal");
defsubr (&Sinternal_set_alternative_font_family_alist);
defsubr (&Sinternal_set_alternative_font_registry_alist);
defsubr (&Sface_attributes_as_vector);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
defsubr (&Sdump_face);
defsubr (&Sshow_face_resources);
#endif /* GLYPH_DEBUG */
#endif
DEFVAR_LISP ("font-list-limit", Vfont_list_limit,
- doc: /* *Limit for font matching.
+ doc: /* Limit for font matching.
If an integer > 0, font matching functions won't load more than
that number of fonts when searching for a matching font. */);
Vfont_list_limit = make_number (DEFAULT_FONT_LIST_LIMIT);
Vface_new_frame_defaults = Qnil;
DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
- doc: /* *Default stipple pattern used on monochrome displays.
+ doc: /* Default stipple pattern used on monochrome displays.
This stipple pattern is used on monochrome displays
instead of shades of gray for a face background color.
See `set-face-stipple' for possible values for this variable. */);
- Vface_default_stipple = make_pure_c_string ("gray3");
+ Vface_default_stipple = build_pure_c_string ("gray3");
DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist,
doc: /* An alist of defined terminal colors and their RGB values.
#include <config.h>
#include <stdio.h>
#include <math.h>
-#include <setjmp.h>
-#include <ctype.h>
#include <unistd.h>
/* This makes the fields of a Display accessible, in Xlib header files. */
#include "xterm.h"
#include "frame.h"
#include "window.h"
+#include "character.h"
#include "buffer.h"
#include "intervals.h"
#include "dispextern.h"
#include "keyboard.h"
#include "blockinput.h"
#include <epaths.h>
-#include "character.h"
#include "charset.h"
#include "coding.h"
#include "fontset.h"
#ifdef HAVE_X_WINDOWS
-#include <ctype.h>
#include <sys/types.h>
#include <sys/stat.h>
#define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
-/* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
- it, and including `bitmaps/gray' more than once is a problem when
- config.h defines `static' as an empty replacement string. */
-
-int gray_bitmap_width = gray_width;
-int gray_bitmap_height = gray_height;
-char *gray_bitmap_bits = gray_bits;
-
/* Nonzero if using X. */
-static int x_in_use;
+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;
Lisp_Object Qfont_param;
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
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);
\f
unsigned char *tmp_data = NULL;
Atom target_type = XA_CARDINAL;
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
if (! success)
break;
- XFree ((char *) tmp_children);
+ XFree (tmp_children);
if (wm_window == rootw || had_errors)
break;
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
if (had_errors) return;
/* Decide if color named COLOR_NAME is valid for use on frame F. If
- so, return the RGB values in COLOR. If ALLOC_P is non-zero,
- allocate the color. Value is zero if COLOR_NAME is invalid, or
+ so, return the RGB values in COLOR. If ALLOC_P,
+ allocate the color. Value is false if COLOR_NAME is invalid, or
no color could be allocated. */
-int
+bool
x_defined_color (struct frame *f, const char *color_name,
- XColor *color, int alloc_p)
+ XColor *color, bool alloc_p)
{
- int success_p = 0;
+ bool success_p = 0;
Display *dpy = FRAME_X_DISPLAY (f);
Colormap cmap = FRAME_X_COLORMAP (f);
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_GTK
success_p = xg_check_special_colors (f, color_name, color);
#endif
if (!success_p)
- success_p = XParseColor (dpy, cmap, color_name, color);
+ success_p = XParseColor (dpy, cmap, color_name, color) != 0;
if (success_p && alloc_p)
success_p = x_alloc_nearest_color (f, cmap, color);
- UNBLOCK_INPUT;
+ unblock_input ();
return success_p;
}
if (EQ (new_value, old_value)) return;
#ifdef USE_GTK
- if (xg_change_toolbar_position (f, new_value))
- f->tool_bar_position = new_value;
+ xg_change_toolbar_position (f, new_value);
+ fset_tool_bar_position (f, new_value);
#endif
}
GdkPixbuf *pixbuf;
GError *err = NULL;
char *filename = SSDATA (found);
- BLOCK_INPUT;
+ block_input ();
pixbuf = gdk_pixbuf_new_from_file (filename, &err);
else
g_error_free (err);
- UNBLOCK_INPUT;
+ unblock_input ();
}
return result;
{
Display *dpy = FRAME_X_DISPLAY (f);
- BLOCK_INPUT;
+ block_input ();
XSetForeground (dpy, x->normal_gc, fg);
XSetBackground (dpy, x->reverse_gc, fg);
XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
}
- UNBLOCK_INPUT;
+ unblock_input ();
update_face_from_frame_parameter (f, Qforeground_color, arg);
{
Display *dpy = FRAME_X_DISPLAY (f);
- BLOCK_INPUT;
+ block_input ();
XSetBackground (dpy, x->normal_gc, bg);
XSetForeground (dpy, x->reverse_gc, bg);
XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
}
#endif /* USE_TOOLKIT_SCROLL_BARS */
- UNBLOCK_INPUT;
+ unblock_input ();
update_face_from_frame_parameter (f, Qbackground_color, arg);
if (FRAME_VISIBLE_P (f))
unload_color (f, x->mouse_pixel);
x->mouse_pixel = pixel;
- BLOCK_INPUT;
+ block_input ();
/* It's not okay to crash if the user selects a screwy cursor. */
x_catch_errors (dpy);
x->horizontal_drag_cursor = horizontal_drag_cursor;
XFlush (dpy);
- UNBLOCK_INPUT;
+ unblock_input ();
update_face_from_frame_parameter (f, Qmouse_color, arg);
}
if (FRAME_X_WINDOW (f) != 0)
{
- BLOCK_INPUT;
+ block_input ();
XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
- UNBLOCK_INPUT;
+ unblock_input ();
if (FRAME_VISIBLE_P (f))
{
if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
{
- BLOCK_INPUT;
+ block_input ();
XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), pix);
- UNBLOCK_INPUT;
+ unblock_input ();
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
return;
- BLOCK_INPUT;
+ block_input ();
if (NILP (arg))
result = x_text_icon (f,
SSDATA ((!NILP (f->icon_name)
if (result)
{
- UNBLOCK_INPUT;
+ unblock_input ();
error ("No icon window available");
}
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
static void
else if (!NILP (arg) || NILP (oldval))
return;
- f->icon_name = arg;
+ fset_icon_name (f, arg);
if (f->output_data.x->icon_bitmap != 0)
return;
- BLOCK_INPUT;
+ block_input ();
result = x_text_icon (f,
SSDATA ((!NILP (f->icon_name)
if (result)
{
- UNBLOCK_INPUT;
+ unblock_input ();
error ("No icon window available");
}
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
if (FRAME_MINIBUF_ONLY_P (f))
return;
- if (INTEGERP (value))
+ if (TYPE_RANGED_INTEGERP (int, value))
nlines = XINT (value);
else
nlines = 0;
FRAME_EXTERNAL_MENU_BAR (f) = 1;
if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
/* Make sure next redisplay shows the menu bar. */
- XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
+ XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = 1;
}
else
{
{
y = FRAME_TOP_MARGIN_HEIGHT (f);
- BLOCK_INPUT;
+ block_input ();
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (nlines > 1 && nlines > olines)
y = (olines == 0 ? 1 : olines) * FRAME_LINE_HEIGHT (f);
height = nlines * FRAME_LINE_HEIGHT (f) - y;
- BLOCK_INPUT;
+ block_input ();
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (nlines == 0 && WINDOWP (f->menu_bar_window))
if (FRAME_MINIBUF_ONLY_P (f))
return;
- /* Use VALUE only if an integer >= 0. */
- if (INTEGERP (value) && XINT (value) >= 0)
+ /* Use VALUE only if an int >= 0. */
+ if (RANGED_INTEGERP (0, value, INT_MAX))
nlines = XFASTINT (value);
else
nlines = 0;
FRAME_EXTERNAL_TOOL_BAR (f) = 1;
if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
/* Make sure next redisplay shows the tool bar. */
- XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
+ XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = 1;
update_frame_tool_bar (f);
}
else
/* height can be zero here. */
if (height > 0 && width > 0)
{
- BLOCK_INPUT;
+ block_input ();
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (WINDOWP (f->tool_bar_window))
{
if (FRAME_X_WINDOW (f))
{
- BLOCK_INPUT;
+ block_input ();
{
XTextProperty text, icon;
ptrdiff_t bytes;
if (do_free_text_value)
xfree (text.value);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
if (! NILP (Fstring_equal (name, f->name)))
return;
- f->name = name;
+ fset_name (f, name);
/* For setting the frame title, the title parameter should override
the name parameter. */
update_mode_lines = 1;
- f->title = name;
+ fset_title (f, name);
if (NILP (name))
name = f->name;
int need_focus = 1;
int need_save = 1;
- BLOCK_INPUT;
+ block_input ();
{
Atom type;
unsigned char *catoms;
XA_ATOM, 32, PropModeAppend,
(unsigned char *) props, count);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
/* Make a fontset name from the base font name. */
if (xic_default_fontset == base_fontname)
- { /* There is no base font name, use the default. */
- ptrdiff_t len = strlen (base_fontname) + 2;
- fontsetname = xmalloc (len);
- memset (fontsetname, 0, len);
+ {
+ /* There is no base font name, use the default. */
+ fontsetname = xmalloc (strlen (base_fontname) + 2);
strcpy (fontsetname, base_fontname);
}
else
for (i = 0; *p; p++)
if (*p == '-') i++;
if (i != 14)
- { /* As the font name doesn't conform to XLFD, we can't
+ {
+ /* As the font name doesn't conform to XLFD, we can't
modify it to generalize it to allcs and allfamilies.
Use the specified font plus the default. */
- ptrdiff_t len =
- strlen (base_fontname) + strlen (xic_default_fontset) + 3;
- fontsetname = xmalloc (len);
- memset (fontsetname, 0, len);
+ fontsetname = xmalloc (strlen (base_fontname)
+ + strlen (xic_default_fontset) + 3);
strcpy (fontsetname, base_fontname);
strcat (fontsetname, sep);
strcat (fontsetname, xic_default_fontset);
/* Build the font spec that matches all charsets. */
len = p - base_fontname + strlen (allcs) + 1;
- font_allcs = (char *) alloca (len);
- memset (font_allcs, 0, len);
+ font_allcs = alloca (len);
memcpy (font_allcs, base_fontname, p - base_fontname);
strcat (font_allcs, allcs);
/* Build the font spec that matches all families and
add-styles. */
len = p - p1 + strlen (allcs) + strlen (allfamilies) + 1;
- font_allfamilies = (char *) alloca (len);
- memset (font_allfamilies, 0, len);
+ font_allfamilies = alloca (len);
strcpy (font_allfamilies, allfamilies);
memcpy (font_allfamilies + strlen (allfamilies), p1, p - p1);
strcat (font_allfamilies, allcs);
/* Build the font spec that matches all. */
len = p - p2 + strlen (allcs) + strlen (all) + strlen (allfamilies) + 1;
- font_all = (char *) alloca (len);
- memset (font_all, 0, len);
+ font_all = alloca (len);
strcpy (font_all, allfamilies);
strcat (font_all, all);
memcpy (font_all + strlen (all) + strlen (allfamilies), p2, p - p2);
len = strlen (base_fontname) + strlen (font_allcs)
+ strlen (font_allfamilies) + strlen (font_all) + 5;
fontsetname = xmalloc (len);
- memset (fontsetname, 0, len);
strcpy (fontsetname, base_fontname);
strcat (fontsetname, sep);
strcat (fontsetname, font_allcs);
Arg al [25];
int ac;
- BLOCK_INPUT;
+ block_input ();
/* Use the resource name as the top-level widget name
for looking up resources. Make a non-Lisp copy
{
char *str = SSDATA (Vx_resource_name);
- f->namebuf = (char *) xmalloc (strlen (str) + 1);
+ f->namebuf = xmalloc (strlen (str) + 1);
strcpy (f->namebuf, str);
}
/* Do some needed geometry management. */
{
- ptrdiff_t len;
char *tem, shell_position[sizeof "=x++" + 4 * INT_STRLEN_BOUND (int)];
Arg gal[10];
int gac = 0;
}
}
- len = strlen (shell_position) + 1;
/* We don't free this because we don't know whether
it is safe to free it while the frame exists.
It isn't worth the trouble of arranging to free it
when the frame is deleted. */
- tem = (char *) xmalloc (len);
- strncpy (tem, shell_position, len);
+ tem = xstrdup (shell_position);
XtSetArg (gal[gac], XtNgeometry, tem); gac++;
XtSetValues (shell_widget, gal, gac);
}
f->explicit_name = 0;
name = f->name;
- f->name = Qnil;
+ fset_name (f, Qnil);
x_set_name (f, name, explicit);
}
f->output_data.x->current_cursor
= f->output_data.x->text_cursor);
- UNBLOCK_INPUT;
+ unblock_input ();
/* This is a no-op, except under Motif. Make sure main areas are
set to something reasonable, in case we get an error later. */
FRAME_XIC (f) = NULL;
if (use_xim)
{
- BLOCK_INPUT;
+ block_input ();
create_frame_xic (f);
if (FRAME_XIC (f))
{
attribute_mask, &attributes);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
}
attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
| CWColormap);
- BLOCK_INPUT;
+ block_input ();
FRAME_X_WINDOW (f)
= XCreateWindow (FRAME_X_DISPLAY (f),
f->output_data.x->parent_desc,
f->explicit_name = 0;
name = f->name;
- f->name = Qnil;
+ fset_name (f, Qnil);
x_set_name (f, name, explicit);
}
f->output_data.x->current_cursor
= f->output_data.x->text_cursor);
- UNBLOCK_INPUT;
+ unblock_input ();
if (FRAME_X_WINDOW (f) == 0)
error ("Unable to create window");
icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
{
- CHECK_NUMBER (icon_x);
- CHECK_NUMBER (icon_y);
+ CHECK_TYPE_RANGED_INTEGER (int, icon_x);
+ CHECK_TYPE_RANGED_INTEGER (int, icon_y);
}
else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
error ("Both left and top icon corners of icon must be specified");
- BLOCK_INPUT;
+ block_input ();
if (! EQ (icon_x, Qunbound))
x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
? f->icon_name
: f->name)));
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Make the GCs needed for this window, setting the
{
XGCValues gc_values;
- BLOCK_INPUT;
+ block_input ();
/* Create the GCs of this frame.
Note that many default values are used. */
FRAME_BACKGROUND_PIXEL (f),
DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
- UNBLOCK_INPUT;
+ unblock_input ();
}
{
Display *dpy = FRAME_X_DISPLAY (f);
- BLOCK_INPUT;
+ block_input ();
if (f->output_data.x->normal_gc)
{
f->output_data.x->border_tile = 0;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If frame is ``official'', nothing to do. */
if (NILP (Fmemq (frame, Vframe_list)))
{
-#if GLYPH_DEBUG && XASSERTS
+#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
#endif
x_free_frame_resources (f);
free_glyphs (f);
-#if GLYPH_DEBUG
+#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
/* Check that reference counts are indeed correct. */
- xassert (dpyinfo->reference_count == dpyinfo_refcount);
- xassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
+ eassert (dpyinfo->reference_count == dpyinfo_refcount);
+ eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
#endif
return Qt;
}
read yet. */
const char *system_font = xsettings_get_system_font ();
if (system_font)
- {
- char *name = xstrdup (system_font);
- font = font_open_by_name (f, name);
- xfree (name);
- }
+ font = font_open_by_name (f, build_unibyte_string (system_font));
}
if (NILP (font))
for (i = 0; names[i]; i++)
{
- font = font_open_by_name (f, names[i]);
+ font = font_open_by_name (f, build_unibyte_string (names[i]));
if (! NILP (font))
break;
}
if (NILP (frame))
frame = selected_frame;
f = XFRAME (frame);
- BLOCK_INPUT;
+ block_input ();
if (FRAME_X_P (f))
x_wm_set_size_hint (f, 0, 0);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
int minibuffer_only = 0;
long window_prompting = 0;
int width, height;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct x_display_info *dpyinfo = NULL;
f->terminal = dpyinfo->terminal;
f->output_method = output_x_window;
- f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
- memset (f->output_data.x, 0, sizeof (struct x_output));
+ f->output_data.x = xzalloc (sizeof *f->output_data.x);
f->output_data.x->icon_bitmap = -1;
FRAME_FONTSET (f) = -1;
f->output_data.x->scroll_bar_foreground_pixel = -1;
f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
#endif /* USE_TOOLKIT_SCROLL_BARS */
- f->icon_name
- = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
- RES_TYPE_STRING);
+ fset_icon_name (f,
+ x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
+ RES_TYPE_STRING));
if (! STRINGP (f->icon_name))
- f->icon_name = Qnil;
+ fset_icon_name (f, Qnil);
FRAME_X_DISPLAY_INFO (f) = dpyinfo;
be set. */
if (EQ (name, Qunbound) || NILP (name))
{
- f->name = build_string (dpyinfo->x_id_name);
+ fset_name (f, build_string (dpyinfo->x_id_name));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
"scrollBarBackground",
"ScrollBarBackground", 0);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
dpyinfo_refcount = dpyinfo->reference_count;
could get an infloop in next_frame since the frame is not yet in
Vframe_list. */
{
- int count2 = SPECPDL_INDEX ();
+ ptrdiff_t count2 = SPECPDL_INDEX ();
record_unwind_protect (unwind_create_frame_1, inhibit_lisp_code);
inhibit_lisp_code = Qt;
/* Tell the server what size and position, etc, we want, and how
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
- BLOCK_INPUT;
+ block_input ();
x_wm_set_size_hint (f, window_prompting, 0);
- UNBLOCK_INPUT;
+ unblock_input ();
/* Make the window appear on the frame and enable display, unless
the caller says not to. However, with explicit parent, Emacs
}
}
- BLOCK_INPUT;
+ block_input ();
/* Set machine name and pid for the purpose of window managers. */
set_machine_and_pid_properties (f);
(unsigned char *) &dpyinfo->client_leader_window, 1);
}
- UNBLOCK_INPUT;
+ unblock_input ();
/* Initialize `default-minibuffer-frame' in case this is the first
frame on this terminal. */
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_default_minibuffer_frame (kb, 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))))
- f->param_alist = Fcons (XCAR (tem), f->param_alist);
+ fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
UNGCPRO;
struct frame *f = check_x_frame (frame);
Display *dpy = FRAME_X_DISPLAY (f);
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
if (FRAME_X_EMBEDDED_P (f))
}
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
/* VALUE should be of the form CLASS-DEPTH, where CLASS is one
of `PseudoColor', `TrueColor' etc. and DEPTH is the color
depth, a decimal number. NAME is compared with case ignored. */
- char *s = (char *) alloca (SBYTES (value) + 1);
+ char *s = alloca (SBYTES (value) + 1);
char *dash;
int i, class = -1;
XVisualInfo vinfo;
fatal ("Can't get proper X visual info");
dpyinfo->n_planes = vinfo->depth;
- XFree ((char *) vinfo);
+ XFree (vinfo);
}
}
void
x_sync (FRAME_PTR f)
{
- BLOCK_INPUT;
+ block_input ();
XSync (FRAME_X_DISPLAY (f), False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
FORMAT gives the size in bits of each element if VALUE is a list.
It must be one of 8, 16 or 32.
If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
-If OUTER_P is non-nil, the property is changed for the outer X window of
+If OUTER-P is non-nil, the property is changed for the outer X window of
FRAME. Default is to change on the edit X window. */)
- (Lisp_Object prop, Lisp_Object value, Lisp_Object frame, Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
+ (Lisp_Object prop, Lisp_Object value, Lisp_Object frame,
+ Lisp_Object type, Lisp_Object format, Lisp_Object outer_p)
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
if (! NILP (format))
{
CHECK_NUMBER (format);
- element_format = XFASTINT (format);
- if (element_format != 8 && element_format != 16
- && element_format != 32)
+ if (XINT (format) != 8 && XINT (format) != 16
+ && XINT (format) != 32)
error ("FORMAT must be one of 8, 16 or 32");
+ element_format = XINT (format);
}
if (CONSP (value))
nelements = SBYTES (value);
}
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False);
if (! NILP (type))
{
/* Make sure the property is set when we return. */
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
Atom prop_atom;
CHECK_STRING (prop);
- BLOCK_INPUT;
+ block_input ();
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False);
XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
/* Make sure the property is removed when we return. */
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
return prop;
}
doc: /* Value is the value of window property PROP on FRAME.
If FRAME is nil or omitted, use the selected frame.
-On MS Windows, this function only accepts the PROP and FRAME arguments.
-
On X Windows, the following optional arguments are also accepted:
If TYPE is nil or omitted, get the property as a string.
Otherwise TYPE is the name of the atom that denotes the type expected.
If SOURCE is non-nil, get the property on that window instead of from
FRAME. The number 0 denotes the root window.
-If DELETE_P is non-nil, delete the property after retrieving it.
-If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
+If DELETE-P is non-nil, delete the property after retrieving it.
+If VECTOR-RET-P is non-nil, don't return a string but a vector of values.
+
+On MS Windows, this function accepts but ignores those optional arguments.
Value is nil if FRAME hasn't a property with name PROP or if PROP has
no value of TYPE (always string in the MS Windows case). */)
- (Lisp_Object prop, Lisp_Object frame, Lisp_Object type, Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
+ (Lisp_Object prop, Lisp_Object frame, Lisp_Object type,
+ Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p)
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
}
- BLOCK_INPUT;
+ block_input ();
if (STRINGP (type))
{
if (strcmp ("AnyPropertyType", SSDATA (type)) == 0)
if (tmp_data) XFree (tmp_data);
}
- UNBLOCK_INPUT;
+ unblock_input ();
UNGCPRO;
return prop_value;
}
{
Lisp_Object rest, frame;
- BLOCK_INPUT;
+ block_input ();
FOR_EACH_FRAME (rest, frame)
{
}
hourglass_shown_p = 1;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
{
Lisp_Object rest, frame;
- BLOCK_INPUT;
+ block_input ();
FOR_EACH_FRAME (rest, frame)
{
struct frame *f = XFRAME (frame);
}
hourglass_shown_p = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
Lisp_Object frame;
Lisp_Object name;
int width, height;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
int face_change_count_before = face_change_count;
Lisp_Object buffer;
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_truncate_lines (current_buffer, Qnil);
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
from this point on, x_destroy_window might screw up reference
counts etc. */
f->output_method = output_x_window;
- f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
- memset (f->output_data.x, 0, sizeof (struct x_output));
+ f->output_data.x = xzalloc (sizeof *f->output_data.x);
f->output_data.x->icon_bitmap = -1;
FRAME_FONTSET (f) = -1;
f->output_data.x->scroll_bar_foreground_pixel = -1;
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 */
- f->icon_name = Qnil;
+ fset_icon_name (f, 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;
be set. */
if (EQ (name, Qunbound) || NILP (name))
{
- f->name = build_string (dpyinfo->x_id_name);
+ fset_name (f, build_string (dpyinfo->x_id_name));
f->explicit_name = 0;
}
else
{
- f->name = name;
+ fset_name (f, name);
f->explicit_name = 1;
/* use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
x_default_parameter (f, parms, Qborder_color, build_string ("black"),
"borderColor", "BorderColor", RES_TYPE_STRING);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
dpyinfo_refcount = dpyinfo->reference_count;
unsigned long mask;
Atom type = FRAME_X_DISPLAY_INFO (f)->Xatom_net_window_type_tooltip;
- BLOCK_INPUT;
+ block_input ();
mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
if (DoesSaveUnders (dpyinfo->screen))
mask |= CWSaveUnder;
FRAME_X_DISPLAY_INFO (f)->Xatom_net_window_type,
XA_ATOM, 32, PropModeReplace,
(unsigned char *)&type, 1);
- UNBLOCK_INPUT;
+ unblock_input ();
}
x_make_gc (f);
show it. */
if (!INTEGERP (left) || !INTEGERP (top))
{
- BLOCK_INPUT;
+ block_input ();
XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
&root, &child, root_x, root_y, &win_x, &win_y, &pmask);
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (INTEGERP (top))
int i, width, height, seen_reversed_p;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_redisplay, Qt);
#ifdef USE_GTK
if (x_gtk_use_system_tooltips)
{
- int ok;
+ bool ok;
/* Hide a previous tip, if any. */
Fx_hide_tip ();
- BLOCK_INPUT;
- if ((ok = xg_prepare_tooltip (f, string, &width, &height)) != 0)
+ block_input ();
+ ok = xg_prepare_tooltip (f, string, &width, &height);
+ if (ok)
{
compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
xg_show_tooltip (f, root_x, root_y);
/* This is used in Fx_hide_tip. */
XSETFRAME (tip_frame, f);
}
- UNBLOCK_INPUT;
+ unblock_input ();
if (ok) goto start_timer;
}
#endif /* USE_GTK */
call1 (Qcancel_timer, timer);
}
- BLOCK_INPUT;
+ block_input ();
compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f),
FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y);
XMoveWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f),
root_x, root_y);
- UNBLOCK_INPUT;
+ unblock_input ();
goto start_timer;
}
}
/* Set up the frame's root window. */
w = XWINDOW (FRAME_ROOT_WINDOW (f));
- w->left_col = w->top_line = make_number (0);
+ wset_left_col (w, make_number (0));
+ wset_top_line (w, make_number (0));
if (CONSP (Vx_max_tooltip_size)
- && INTEGERP (XCAR (Vx_max_tooltip_size))
- && XINT (XCAR (Vx_max_tooltip_size)) > 0
- && INTEGERP (XCDR (Vx_max_tooltip_size))
- && XINT (XCDR (Vx_max_tooltip_size)) > 0)
+ && RANGED_INTEGERP (1, XCAR (Vx_max_tooltip_size), INT_MAX)
+ && RANGED_INTEGERP (1, XCDR (Vx_max_tooltip_size), INT_MAX))
{
- w->total_cols = XCAR (Vx_max_tooltip_size);
- w->total_lines = XCDR (Vx_max_tooltip_size);
+ wset_total_cols (w, XCAR (Vx_max_tooltip_size));
+ wset_total_lines (w, XCDR (Vx_max_tooltip_size));
}
else
{
- w->total_cols = make_number (80);
- w->total_lines = make_number (40);
+ wset_total_cols (w, make_number (80));
+ wset_total_lines (w, make_number (40));
}
FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
/* Display the tooltip text in a temporary buffer. */
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
- BVAR (current_buffer, truncate_lines) = Qnil;
+ bset_truncate_lines (current_buffer, Qnil);
clear_glyph_matrix (w->desired_matrix);
clear_glyph_matrix (w->current_matrix);
SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
/* w->total_cols and FRAME_TOTAL_COLS want the width in columns,
not in pixels. */
width /= WINDOW_FRAME_COLUMN_WIDTH (w);
- w->total_cols = make_number (width);
+ wset_total_cols (w, make_number (width));
FRAME_TOTAL_COLS (f) = width;
adjust_glyphs (f);
clear_glyph_matrix (w->desired_matrix);
show it. */
compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
- BLOCK_INPUT;
+ block_input ();
XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
root_x, root_y, width, height);
XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
- UNBLOCK_INPUT;
+ unblock_input ();
/* Draw into the window. */
w->must_be_updated_p = 1;
Value is t if tooltip was open, nil otherwise. */)
(void)
{
- int count;
+ ptrdiff_t count;
Lisp_Object deleted, frame, timer;
struct gcpro gcpro1, gcpro2;
if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
&& w != NULL)
{
- BLOCK_INPUT;
+ block_input ();
xlwmenu_redisplay (w);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
#endif /* USE_LUCID */
Widget dialog = (Widget) p->pointer;
/* Clean up. */
- BLOCK_INPUT;
+ block_input ();
XtUnmanageChild (dialog);
XtDestroyWidget (dialog);
x_menu_set_in_use (0);
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
Arg al[10];
int ac = 0;
XmString dir_xmstring, pattern_xmstring;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
check_x ();
/* Prevent redisplay. */
specbind (Qinhibit_redisplay, Qt);
- BLOCK_INPUT;
+ block_input ();
/* Create the dialog with PROMPT as title, using DIR as initial
directory and using "*" as pattern. */
dir = Fexpand_file_name (dir, Qnil);
- dir_xmstring = XmStringCreateLocalized (SDATA (dir));
+ dir_xmstring = XmStringCreateLocalized (SSDATA (dir));
pattern_xmstring = XmStringCreateLocalized ("*");
XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
XmTextPosition last_pos = XmTextFieldGetLastPosition (wtext);
XmTextFieldReplace (wtext, 0, last_pos,
- (SDATA (Ffile_name_nondirectory (default_filename))));
+ (SSDATA (Ffile_name_nondirectory (default_filename))));
/* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
must include the path for this to work. */
- default_xmstring = XmStringCreateLocalized (SDATA (default_filename));
+ default_xmstring = XmStringCreateLocalized (SSDATA (default_filename));
if (XmListItemExists (list, default_xmstring))
{
else
file = Qnil;
- UNBLOCK_INPUT;
+ unblock_input ();
UNGCPRO;
/* Make "Cancel" equivalent to C-g. */
char *fn;
Lisp_Object file = Qnil;
Lisp_Object decoded_file;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
char *cdef_file;
specbind (Qinhibit_redisplay, Qt);
record_unwind_protect (clean_up_dialog, Qnil);
- BLOCK_INPUT;
+ block_input ();
if (STRINGP (default_filename))
cdef_file = SSDATA (default_filename);
xfree (fn);
}
- UNBLOCK_INPUT;
+ unblock_input ();
UNGCPRO;
/* Make "Cancel" equivalent to C-g. */
#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;
struct gcpro gcpro1, gcpro2;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
check_x ();
specbind (Qinhibit_redisplay, Qt);
record_unwind_protect (clean_up_dialog, Qnil);
- BLOCK_INPUT;
+ block_input ();
GCPRO2 (font_param, font);
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;
+ unblock_input ();
if (NILP (font))
Fsignal (Qquit, Qnil);
Lisp_Object have_keys;
int major, minor, op, event, error_code;
- BLOCK_INPUT;
+ block_input ();
/* Check library version in case we're dynamically linked. */
major = XkbMajorVersion;
minor = XkbMinorVersion;
if (!XkbLibraryVersion (&major, &minor))
{
- UNBLOCK_INPUT;
+ unblock_input ();
return Qlambda;
}
minor = XkbMinorVersion;
if (!XkbQueryExtension (dpy, &op, &event, &error_code, &major, &minor))
{
- UNBLOCK_INPUT;
+ unblock_input ();
return Qlambda;
}
&& XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
have_keys = Qt;
}
- UNBLOCK_INPUT;
+ unblock_input ();
return have_keys;
#else /* not HAVE_XKBGETKEYBOARD */
return Qlambda;
/* 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");
/* This is the end of symbol initialization. */
Fput (Qundefined_color, Qerror_conditions,
- pure_cons (Qundefined_color, pure_cons (Qerror, Qnil)));
+ listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
Fput (Qundefined_color, Qerror_message,
- make_pure_c_string ("Undefined color"));
+ build_pure_c_string ("Undefined color"));
DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape,
doc: /* The shape of the pointer when over text.
/* This is not ifdef:ed, so other builds than GTK can customize it. */
DEFVAR_BOOL ("x-gtk-use-old-file-dialog", x_gtk_use_old_file_dialog,
- doc: /* *Non-nil means prompt with the old GTK file selection dialog.
+ doc: /* Non-nil means prompt with the old GTK file selection dialog.
If nil or if the file selection dialog is not available, the new GTK file
chooser is used instead. To turn off all file dialogs set the
variable `use-file-dialog'. */);
x_gtk_use_old_file_dialog = 0;
DEFVAR_BOOL ("x-gtk-show-hidden-files", x_gtk_show_hidden_files,
- doc: /* *If non-nil, the GTK file chooser will by default show hidden files.
+ doc: /* If non-nil, the GTK file chooser will by default show hidden files.
Note that this is just the default, there is a toggle button on the file
chooser to show or not show hidden files on a case by case basis. */);
x_gtk_show_hidden_files = 0;
DEFVAR_BOOL ("x-gtk-file-dialog-help-text", x_gtk_file_dialog_help_text,
- doc: /* *If non-nil, the GTK file chooser will show additional help text.
+ doc: /* If non-nil, the GTK file chooser will show additional help text.
If more space for files in the file chooser dialog is wanted, set this to nil
to turn the additional text off. */);
x_gtk_file_dialog_help_text = 1;
DEFVAR_BOOL ("x-gtk-whole-detached-tool-bar", x_gtk_whole_detached_tool_bar,
- doc: /* *If non-nil, a detached tool bar is shown in full.
+ doc: /* If non-nil, a detached tool bar is shown in full.
The default is to just show an arrow and pressing on that arrow shows
the tool bar buttons. */);
x_gtk_whole_detached_tool_bar = 0;
DEFVAR_BOOL ("x-gtk-use-system-tooltips", x_gtk_use_system_tooltips,
- doc: /* *If non-nil with a Gtk+ built Emacs, the Gtk+ tooltip is used.
+ doc: /* If non-nil with a Gtk+ built Emacs, the Gtk+ tooltip is used.
Otherwise use Emacs own tooltip implementation.
When using Gtk+ tooltips, the tooltip face is not used. */);
x_gtk_use_system_tooltips = 1;
DEFVAR_LISP ("gtk-version-string", Vgtk_version_string,
doc: /* Version info for GTK+. */);
{
- char gtk_version[40];
- g_snprintf (gtk_version, sizeof (gtk_version), "%u.%u.%u",
- GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
- Vgtk_version_string = make_pure_string (gtk_version, strlen (gtk_version), strlen (gtk_version), 0);
+ char gtk_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
+ int len = sprintf (gtk_version, "%d.%d.%d",
+ GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
+ Vgtk_version_string = make_pure_string (gtk_version, len, len, 0);
}
#endif /* USE_GTK */
#if defined (USE_GTK) && defined (HAVE_FREETYPE)
defsubr (&Sx_select_font);
- x_last_font_name = NULL;
#endif
}
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <X11/Xlib.h>
#include "lisp.h"
};
/* Prototypes of support functions. */
-extern void x_clear_errors (Display *);
static XCharStruct *xfont_get_pcm (XFontStruct *, XChar2b *);
/* The result metric information. */
XCharStruct *pcm = NULL;
- font_assert (xfont && char2b);
+ eassert (xfont && char2b);
if (xfont->per_char != NULL)
{
static unsigned xfont_encode_char (struct font *, int);
static int xfont_text_extents (struct font *, unsigned *, int,
struct font_metrics *);
-static int xfont_draw (struct glyph_string *, int, int, int, int, int);
+static int xfont_draw (struct glyph_string *, int, int, int, int, bool);
static int xfont_check (FRAME_PTR, struct font *);
struct font_driver xfont_driver =
{
- 0, /* Qx */
+ LISP_INITIALLY_ZERO, /* Qx */
0, /* case insensitive */
xfont_get_cache,
xfont_list,
static int
compare_font_names (const void *name1, const void *name2)
{
- return xstrcasecmp (*(const char **) name1,
- *(const char **) name2);
+ char *const *n1 = name1;
+ char *const *n2 = name2;
+ return xstrcasecmp (*n1, *n2);
}
/* Decode XLFD as iso-8859-1 into OUTPUT, and return the byte length
XLFD is NULL terminated. The caller must assure that OUTPUT is at
least twice (plus 1) as large as XLFD. */
-static int
+static ptrdiff_t
xfont_decode_coding_xlfd (char *xlfd, int len, char *output)
{
char *p0 = xlfd, *p1 = output;
/* Check if CHARS (cons or vector) is supported by XFONT whose
encoding charset is ENCODING (XFONT is NULL) or by a font whose
registry corresponds to ENCODING and REPERTORY.
- Return 1 if supported, return 0 otherwise. */
+ Return true if supported. */
-static int
+static bool
xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont,
struct charset *encoding, struct charset *repertory)
{
}
else if (VECTORP (chars))
{
- int i;
+ ptrdiff_t i;
for (i = ASIZE (chars) - 1; i >= 0; i--)
{
}
}
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (display);
for (limit = 512; ; limit *= 2)
Lisp_Object scripts = Qnil;
for (i = 0; i < ASIZE (xfont_scratch_props); i++)
- props[i] = Qnil;
+ ASET (xfont_scratch_props, i, Qnil);
for (i = 0; i < num_fonts; i++)
indices[i] = names[i];
qsort (indices, num_fonts, sizeof (char *), compare_font_names);
for (i = 0; i < num_fonts; i++)
{
+ ptrdiff_t len;
Lisp_Object entity;
if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
continue;
entity = font_make_entity ();
- xfont_decode_coding_xlfd (indices[i], -1, buf);
- if (font_parse_xlfd (buf, entity) < 0)
+ len = xfont_decode_coding_xlfd (indices[i], -1, buf);
+ if (font_parse_xlfd (buf, len, entity) < 0)
continue;
ASET (entity, FONT_TYPE_INDEX, Qx);
/* Avoid auto-scaled fonts. */
{
elt = XCAR (tail);
if (STRINGP (elt)
- && fast_c_string_match_ignore_case (elt, indices[i]) >= 0)
+ && fast_c_string_match_ignore_case (elt, indices[i],
+ len) >= 0)
break;
}
if (! CONSP (tail))
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);
- props[7] = AREF (entity, FONT_SPACING_INDEX);
+ vcopy (xfont_scratch_props, 0,
+ aref_addr (entity, FONT_FOUNDRY_INDEX), 7);
+ ASET (xfont_scratch_props, 7, AREF (entity, FONT_SPACING_INDEX));
scripts = xfont_supported_scripts (display, indices[i],
xfont_scratch_props, encoding);
}
}
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
FONT_ADD_LOG ("xfont-list", build_string (pattern), list);
return list;
if (xfont_encode_coding_xlfd (name) < 0)
return Qnil;
- BLOCK_INPUT;
+ block_input ();
entity = Qnil;
xfont = XLoadQueryFont (display, name);
if (xfont)
string. We must avoid such a name. */
if (*s)
{
+ ptrdiff_t len;
entity = font_make_entity ();
ASET (entity, FONT_TYPE_INDEX, Qx);
- xfont_decode_coding_xlfd (s, -1, name);
- if (font_parse_xlfd (name, entity) < 0)
+ len = xfont_decode_coding_xlfd (s, -1, name);
+ if (font_parse_xlfd (name, len, entity) < 0)
entity = Qnil;
}
XFree (s);
}
XFreeFont (display, xfont);
}
- UNBLOCK_INPUT;
+ unblock_input ();
FONT_ADD_LOG ("xfont-match", spec, entity);
return entity;
char *last_family IF_LINT (= 0);
int last_len;
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpyinfo->display);
names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*",
0x8000, &num_fonts);
XFreeFontNames (names);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return list;
}
return Qnil;
}
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (display);
xfont = XLoadQueryFont (display, name);
if (x_had_errors_p (display))
XFree (p0);
}
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
if (! xfont)
{
ASET (font_object, FONT_TYPE_INDEX, Qx);
if (STRINGP (fullname))
{
- font_parse_xlfd (SSDATA (fullname), font_object);
+ font_parse_xlfd (SSDATA (fullname), SBYTES (fullname), font_object);
ASET (font_object, FONT_NAME_INDEX, fullname);
}
else
font->descent = xfont->descent;
font->height = font->ascent + font->descent;
font->min_width = xfont->min_bounds.width;
+ font->max_width = xfont->max_bounds.width;
if (xfont->min_bounds.width == xfont->max_bounds.width)
{
/* Fixed width font. */
}
}
- BLOCK_INPUT;
+ block_input ();
font->underline_thickness
= (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value)
? (long) value : 0);
font->default_ascent
= (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value)
? (long) value : 0);
- UNBLOCK_INPUT;
+ unblock_input ();
if (NILP (fullname))
fullname = AREF (font_object, FONT_NAME_INDEX);
static void
xfont_close (FRAME_PTR f, struct font *font)
{
- BLOCK_INPUT;
+ block_input ();
XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static int
xfont_prepare_face (FRAME_PTR f, struct face *face)
{
- BLOCK_INPUT;
+ block_input ();
XSetFont (FRAME_X_DISPLAY (f), face->gc,
((struct xfont_info *) face->font)->xfont->fid);
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
}
static int
-xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
+xfont_draw (struct glyph_string *s, int from, int to, int x, int y,
+ bool with_background)
{
XFontStruct *xfont = ((struct xfont_info *) s->font)->xfont;
int len = to - from;
if (s->gc != s->face->gc)
{
- BLOCK_INPUT;
+ block_input ();
XSetFont (s->display, gc, xfont->fid);
- UNBLOCK_INPUT;
+ unblock_input ();
}
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;
- if (with_background > 0)
+ block_input ();
+ if (with_background)
{
if (s->padding_p)
for (i = 0; i < len; i++)
XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
gc, x, y, str, len);
}
- UNBLOCK_INPUT;
+ unblock_input ();
SAFE_FREE ();
return s->nchars;
}
- BLOCK_INPUT;
- if (with_background > 0)
+ block_input ();
+ if (with_background)
{
if (s->padding_p)
for (i = 0; i < len; i++)
XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f),
gc, x, y, s->char2b + from, len);
}
- UNBLOCK_INPUT;
+ unblock_input ();
return len;
}
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <X11/Xlib.h>
#include <X11/Xft/Xft.h>
/* Xft font driver. */
-static Lisp_Object Qxft;
+Lisp_Object Qxft;
static Lisp_Object QChinting, QCautohint, QChintstyle, QCrgba, QCembolden,
QClcdfilter;
/* The following five members must be here in this order to be
compatible with struct ftfont_info (in ftfont.c). */
#ifdef HAVE_LIBOTF
- int maybe_otf; /* Flag to tell if this may be OTF or not. */
+ bool maybe_otf; /* Flag to tell if this may be OTF or not. */
OTF *otf;
#endif /* HAVE_LIBOTF */
FT_Size ft_size;
else
{
XGCValues xgcv;
- int fg_done = 0, bg_done = 0;
+ bool fg_done = 0, bg_done = 0;
- BLOCK_INPUT;
+ block_input ();
XGetGCValues (FRAME_X_DISPLAY (f), gc,
GCForeground | GCBackground, &xgcv);
if (xftface_info)
*bg = xftface_info->xft_fg, bg_done = 1;
}
- if (fg_done + bg_done < 2)
+ if (! (fg_done & bg_done))
{
XColor colors[2];
bg->color.blue = colors[1].blue;
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
-static Lisp_Object xftfont_list (Lisp_Object, Lisp_Object);
-static Lisp_Object xftfont_match (Lisp_Object, Lisp_Object);
-static Lisp_Object xftfont_open (FRAME_PTR, Lisp_Object, int);
-static void xftfont_close (FRAME_PTR, struct font *);
-static int xftfont_prepare_face (FRAME_PTR, struct face *);
-static void xftfont_done_face (FRAME_PTR, struct face *);
-static int xftfont_has_char (Lisp_Object, int);
-static unsigned xftfont_encode_char (struct font *, int);
-static int xftfont_text_extents (struct font *, unsigned *, int,
- struct font_metrics *);
-static int xftfont_draw (struct glyph_string *, int, int, int, int, int);
-static int xftfont_end_for_frame (FRAME_PTR f);
-
struct font_driver xftfont_driver;
static Lisp_Object
FcPatternAddInteger (pat, FC_INDEX, XINT (idx));
- BLOCK_INPUT;
+ block_input ();
/* Make sure that the Xrender extension is added before the Xft one.
Otherwise, the close-display hook set by Xft is called after the
one for Xrender, and the former tries to re-add the latter. This
xftfont = XftFontOpenPattern (display, match);
if (!xftfont)
{
- UNBLOCK_INPUT;
+ unblock_input ();
XftPatternDestroy (match);
return Qnil;
}
ft_face = XftLockFace (xftfont);
- UNBLOCK_INPUT;
+ unblock_input ();
/* We should not destroy PAT here because it is kept in XFTFONT and
destroyed automatically when XFTFONT is closed. */
for (ch = 0; ch < 95; ch++)
ascii_printable[ch] = ' ' + ch;
}
- BLOCK_INPUT;
+ block_input ();
+
+ /* Unfortunately Xft doesn't provide a way to get minimum char
+ width. So, we set min_width to space_width. */
+
if (spacing != FC_PROPORTIONAL
#ifdef FC_DUAL
&& spacing != FC_DUAL
#endif /* FC_DUAL */
)
{
- font->min_width = font->average_width = font->space_width
- = xftfont->max_advance_width;
+ font->min_width = font->max_width = font->average_width
+ = font->space_width = xftfont->max_advance_width;
XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents);
}
else
{
XftTextExtents8 (display, xftfont, ascii_printable, 1, &extents);
- font->space_width = extents.xOff;
+ font->min_width = font->max_width = font->space_width
+ = extents.xOff;
if (font->space_width <= 0)
/* dirty workaround */
font->space_width = pixel_size;
XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents);
font->average_width = (font->space_width + extents.xOff) / 95;
}
- UNBLOCK_INPUT;
+ unblock_input ();
font->ascent = xftfont->ascent;
font->descent = xftfont->descent;
font->underline_thickness = 0;
}
#ifdef HAVE_LIBOTF
- xftfont_info->maybe_otf = ft_face->face_flags & FT_FACE_FLAG_SFNT;
+ xftfont_info->maybe_otf = (ft_face->face_flags & FT_FACE_FLAG_SFNT) != 0;
xftfont_info->otf = NULL;
#endif /* HAVE_LIBOTF */
xftfont_info->ft_size = ft_face->size;
- /* Unfortunately Xft doesn't provide a way to get minimum char
- width. So, we use space_width instead. */
- font->min_width = font->space_width;
-
font->baseline_offset = 0;
font->relative_compose = 0;
font->default_ascent = 0;
if (xftfont_info->otf)
OTF_close (xftfont_info->otf);
#endif
- BLOCK_INPUT;
+ block_input ();
XftUnlockFace (xftfont_info->xftfont);
XftFontClose (xftfont_info->display, xftfont_info->xftfont);
- UNBLOCK_INPUT;
+ unblock_input ();
}
static int
}
#endif
- xftface_info = malloc (sizeof (struct xftface_info));
+ xftface_info = malloc (sizeof *xftface_info);
if (! xftface_info)
return -1;
xftfont_get_colors (f, face, face->gc, NULL,
struct xftfont_info *xftfont_info = (struct xftfont_info *) font;
XGlyphInfo extents;
- BLOCK_INPUT;
+ block_input ();
XftGlyphExtents (xftfont_info->display, xftfont_info->xftfont, code, nglyphs,
&extents);
- UNBLOCK_INPUT;
+ unblock_input ();
if (metrics)
{
metrics->lbearing = - extents.x;
if (! xft_draw)
{
- BLOCK_INPUT;
+ block_input ();
xft_draw= XftDrawCreate (FRAME_X_DISPLAY (f),
FRAME_X_WINDOW (f),
FRAME_X_VISUAL (f),
FRAME_X_COLORMAP (f));
- UNBLOCK_INPUT;
- if (! xft_draw)
- abort ();
+ unblock_input ();
+ eassert (xft_draw != NULL);
font_put_frame_data (f, &xftfont_driver, xft_draw);
}
return xft_draw;
}
static int
-xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_background)
+xftfont_draw (struct glyph_string *s, int from, int to, int x, int y,
+ bool with_background)
{
FRAME_PTR f = s->f;
struct face *face = s->face;
xftface_info = (struct xftface_info *) face->extra;
xftfont_get_colors (f, face, s->gc, xftface_info,
&fg, with_background ? &bg : NULL);
- BLOCK_INPUT;
+ block_input ();
if (s->num_clips > 0)
XftDrawSetClipRectangles (xft_draw, 0, 0, s->clip, s->num_clips);
else
else
XftDrawGlyphs (xft_draw, &fg, xftfont_info->xftfont,
x, y, code, len);
- UNBLOCK_INPUT;
+ unblock_input ();
return len;
}
if (xft_draw)
{
- BLOCK_INPUT;
+ block_input ();
XftDrawDestroy (xft_draw);
- UNBLOCK_INPUT;
+ unblock_input ();
font_put_frame_data (f, &xftfont_driver, NULL);
}
return 0;
}
-static int
-xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object, Lisp_Object entity)
+static bool
+xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object,
+ Lisp_Object entity)
{
struct xftfont_info *info = (struct xftfont_info *) XFONT_OBJECT (font_object);
FcPattern *oldpat = info->xftfont->pattern;
Display *display = FRAME_X_DISPLAY (f);
FcPattern *pat = FcPatternCreate ();
FcBool b1, b2;
- int ok = 0, i1, i2, r1, r2;
+ bool ok = 0;
+ int i1, i2, r1, r2;
xftfont_add_rendering_parameters (pat, entity);
XftDefaultSubstitute (display, FRAME_X_SCREEN_NUMBER (f), pat);
DEFSYM (QCembolden, ":embolden");
DEFSYM (QClcdfilter, ":lcdfilter");
+ ascii_printable[0] = 0;
+
xftfont_driver = ftfont_driver;
xftfont_driver.type = Qxft;
xftfont_driver.get_cache = xfont_driver.get_cache;
#include <config.h>
-#include <setjmp.h>
#include "xgselect.h"
#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
#include <glib.h>
#include <errno.h>
-#include <setjmp.h>
-
-static GPollFD *gfds;
-static ptrdiff_t gfds_size;
+#include "xterm.h"
int
-xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
- EMACS_TIME *timeout)
+xg_select (int fds_lim, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
+ EMACS_TIME *timeout, sigset_t *sigmask)
{
SELECT_TYPE all_rfds, all_wfds;
EMACS_TIME tmo, *tmop = timeout;
- GMainContext *context = g_main_context_default ();
+ GMainContext *context;
int have_wfds = wfds != NULL;
- int n_gfds = 0, our_tmo = 0, retval = 0, our_fds = 0;
+ GPollFD gfds_buf[128];
+ GPollFD *gfds = gfds_buf;
+ int gfds_size = sizeof gfds_buf / sizeof *gfds_buf;
+ int n_gfds, retval = 0, our_fds = 0, max_fds = fds_lim - 1;
int i, nfds, tmo_in_millisec;
+ USE_SAFE_ALLOCA;
+
+ if (! (x_in_use
+ && g_main_context_pending (context = g_main_context_default ())))
+ return pselect (fds_lim, rfds, wfds, efds, timeout, sigmask);
- if (rfds) memcpy (&all_rfds, rfds, sizeof (all_rfds));
+ if (rfds) all_rfds = *rfds;
else FD_ZERO (&all_rfds);
- if (wfds) memcpy (&all_wfds, wfds, sizeof (all_rfds));
+ if (wfds) all_wfds = *wfds;
else FD_ZERO (&all_wfds);
- /* Update event sources in GLib. */
- g_main_context_pending (context);
-
- do {
- if (n_gfds > gfds_size)
- {
- xfree (gfds);
- gfds = xpalloc (0, &gfds_size, n_gfds - gfds_size, INT_MAX,
- sizeof *gfds);
- }
-
- n_gfds = g_main_context_query (context,
- G_PRIORITY_LOW,
- &tmo_in_millisec,
- gfds,
- gfds_size);
- } while (n_gfds > gfds_size);
+ n_gfds = g_main_context_query (context, G_PRIORITY_LOW, &tmo_in_millisec,
+ gfds, gfds_size);
+ if (gfds_size < n_gfds)
+ {
+ SAFE_NALLOCA (gfds, sizeof *gfds, n_gfds);
+ gfds_size = n_gfds;
+ n_gfds = g_main_context_query (context, G_PRIORITY_LOW, &tmo_in_millisec,
+ gfds, gfds_size);
+ }
for (i = 0; i < n_gfds; ++i)
{
}
}
+ SAFE_FREE ();
+
if (tmo_in_millisec >= 0)
{
- EMACS_SET_SECS_USECS (tmo, tmo_in_millisec/1000,
- 1000 * (tmo_in_millisec % 1000));
- if (!timeout) our_tmo = 1;
- else
- {
- EMACS_TIME difference;
-
- EMACS_SUB_TIME (difference, tmo, *timeout);
- if (EMACS_TIME_NEG_P (difference)) our_tmo = 1;
- }
-
- if (our_tmo) tmop = &tmo;
+ tmo = make_emacs_time (tmo_in_millisec / 1000,
+ 1000 * 1000 * (tmo_in_millisec % 1000));
+ if (!timeout || EMACS_TIME_LT (tmo, *timeout))
+ tmop = &tmo;
}
- nfds = select (max_fds+1, &all_rfds, have_wfds ? &all_wfds : NULL,
- efds, tmop);
+ fds_lim = max_fds + 1;
+ nfds = pselect (fds_lim, &all_rfds, have_wfds ? &all_wfds : NULL,
+ efds, tmop, sigmask);
if (nfds < 0)
retval = nfds;
else if (nfds > 0)
{
- for (i = 0; i < max_fds+1; ++i)
+ for (i = 0; i < fds_lim; ++i)
{
if (FD_ISSET (i, &all_rfds))
{
}
}
- if (our_fds > 0 || (nfds == 0 && our_tmo))
+ if (our_fds > 0 || (nfds == 0 && tmop == &tmo))
{
/* If Gtk+ is in use eventually gtk_main_iteration will be called,
return retval;
}
#endif /* USE_GTK || HAVE_GCONF || HAVE_GSETTINGS */
-
-void
-xgselect_initialize (void)
-{
-#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
- gfds_size = 128;
- gfds = xmalloc (sizeof (*gfds)*gfds_size);
-#endif
-}
SELECT_TYPE *rfds,
SELECT_TYPE *wfds,
SELECT_TYPE *efds,
- EMACS_TIME *timeout);
-
-extern void xgselect_initialize (void);
+ EMACS_TIME *timeout,
+ sigset_t *sigmask);
#endif /* XGSELECT_H */
-
#include <config.h>
-#if 0 /* Why was this included? And without syssignal.h? */
-/* On 4.3 this loses if it comes after xterm.h. */
-#include <signal.h>
-#endif
-
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "keyboard.h"
#include "termhooks.h"
#include "window.h"
#include "blockinput.h"
+#include "character.h"
#include "buffer.h"
#include "charset.h"
#include "coding.h"
int dummy;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
- BLOCK_INPUT;
+ block_input ();
XQueryPointer (FRAME_X_DISPLAY (f),
DefaultRootWindow (FRAME_X_DISPLAY (f)),
we don't care. */
(unsigned int *) &dummy);
- UNBLOCK_INPUT;
+ unblock_input ();
/* xmenu_show expects window coordinates, not root window
coordinates. Translate. */
}
else if (CONSP (position))
{
- Lisp_Object tem;
- tem = Fcar (position);
+ Lisp_Object tem = XCAR (position);
if (CONSP (tem))
- window = Fcar (Fcdr (position));
+ window = Fcar (XCDR (position));
else
{
- tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
+ tem = Fcar (XCDR (position)); /* EVENT_START (position) */
window = Fcar (tem); /* POSN_WINDOW (tem) */
}
}
Lisp_Object title;
const char *error_name;
Lisp_Object selection;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
/* Decode the dialog items from what was specified. */
title = Fcar (contents);
list_of_panes (Fcons (contents, Qnil));
/* Display them in a dialog box. */
- BLOCK_INPUT;
+ block_input ();
selection = xdialog_show (f, 0, title, header, &error_name);
- UNBLOCK_INPUT;
+ unblock_input ();
unbind_to (specpdl_count, Qnil);
discard_menu_items ();
)
{
EMACS_TIME next_time = timer_check (), *ntp;
- long secs = EMACS_SECS (next_time);
- long usecs = EMACS_USECS (next_time);
SELECT_TYPE read_fds;
struct x_display_info *dpyinfo;
int n = 0;
XFlush (dpyinfo->display);
}
- if (secs < 0 && usecs < 0)
+ if (! EMACS_TIME_VALID_P (next_time))
ntp = 0;
else
ntp = &next_time;
#ifdef HAVE_GTK3
- /* Gtk3 have arrows on menus when they don't fit. When the pointer is
- over an arrow, a timeout scrolls it a bit. Use xg_select so that
- timeout gets triggered. */
-
- xg_select (n + 1, &read_fds, (SELECT_TYPE *)0, (SELECT_TYPE *)0, ntp);
+ /* Gtk3 have arrows on menus when they don't fit. When the
+ pointer is over an arrow, a timeout scrolls it a bit. Use
+ xg_select so that timeout gets triggered. */
+ xg_select (n + 1, &read_fds, NULL, NULL, ntp, NULL);
#else
- select (n + 1, &read_fds, (SELECT_TYPE *)0, (SELECT_TYPE *)0, ntp);
+ pselect (n + 1, &read_fds, NULL, NULL, ntp, NULL);
#endif
}
}
XEvent ev;
FRAME_PTR f = check_x_frame (frame);
Widget menubar;
- BLOCK_INPUT;
+ block_input ();
if (FRAME_EXTERNAL_MENU_BAR (f))
set_frame_menubar (f, 0, 1);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
FRAME_PTR f;
/* gcc 2.95 doesn't accept the FRAME_PTR declaration after
- BLOCK_INPUT. */
+ block_input (). */
- BLOCK_INPUT;
+ block_input ();
f = check_x_frame (frame);
if (FRAME_EXTERNAL_MENU_BAR (f))
g_list_free (children);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
x_activate_menubar (FRAME_PTR f)
{
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
if (!f->output_data.x->saved_menu_event->type)
return;
#endif
set_frame_menubar (f, 0, 1);
- BLOCK_INPUT;
+ block_input ();
popup_activated_flag = 1;
#ifdef USE_GTK
XPutBackEvent (f->output_data.x->display_info->display,
#else
XtDispatchEvent (f->output_data.x->saved_menu_event);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
/* Ignore this if we get it a second time. */
f->output_data.x->saved_menu_event->type = 0;
/* This callback is invoked when a dialog or menu is finished being
used and has been unposted. */
-#ifdef USE_GTK
static void
-popup_deactivate_callback (GtkWidget *widget, gpointer client_data)
-{
- popup_activated_flag = 0;
-}
+popup_deactivate_callback (
+#ifdef USE_GTK
+ GtkWidget *widget, gpointer client_data
#else
-static void
-popup_deactivate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
+ Widget widget, LWLIB_ID id, XtPointer client_data
+#endif
+ )
{
popup_activated_flag = 0;
}
-#endif
/* Function that finds the frame for WIDGET and shows the HELP text
sit-for will exit at once if the focus event follows the menu selection
event. */
- BLOCK_INPUT;
+ block_input ();
while (gtk_events_pending ())
gtk_main_iteration ();
- UNBLOCK_INPUT;
+ unblock_input ();
find_and_call_menu_selection (cb_data->cl_data->f,
cb_data->cl_data->menu_bar_items_used,
#endif /* not USE_GTK */
\f
/* Recompute all the widgets of frame F, when the menu bar has been
- changed. Value is non-zero if widgets were updated. */
+ changed. */
-static int
+static void
update_frame_menubar (FRAME_PTR f)
{
#ifdef USE_GTK
- return xg_update_frame_menubar (f);
+ xg_update_frame_menubar (f);
#else
struct x_output *x;
int columns, rows;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
x = f->output_data.x;
if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
- return 0;
+ return;
- BLOCK_INPUT;
+ block_input ();
/* Save the size of the frame because the pane widget doesn't accept
to resize itself. So force it. */
columns = FRAME_COLS (f);
/* Force the pane widget to resize itself with the right values. */
EmacsFrameSetCharSize (x->edit_widget, columns, rows);
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
- return 1;
}
#ifdef USE_LUCID
it is set the first time this is called, from initialize_frame_menubar. */
void
-set_frame_menubar (FRAME_PTR f, int first_time, int deep_p)
+set_frame_menubar (FRAME_PTR f, bool first_time, bool deep_p)
{
xt_or_gtk_widget menubar_widget;
#ifdef USE_X_TOOLKIT
int *submenu_top_level_items, *submenu_n_panes;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
menubar_widget = f->output_data.x->menubar_widget;
else if (!f->output_data.x->saved_menu_event && !deep_p)
{
deep_p = 1;
- f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
+ f->output_data.x->saved_menu_event = xmalloc (sizeof (XEvent));
f->output_data.x->saved_menu_event->type = 0;
}
struct buffer *prev = current_buffer;
Lisp_Object buffer;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
int previous_menu_items_used = f->menu_bar_items_used;
Lisp_Object *previous_items
- = (Lisp_Object *) alloca (previous_menu_items_used
- * sizeof (Lisp_Object));
+ = alloca (previous_menu_items_used * sizeof *previous_items);
int subitems;
/* If we are making a new widget, its contents are empty,
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_menu_bar_items (f, 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 (f->menu_bar_vector)->contents,
- previous_menu_items_used * sizeof (Lisp_Object));
+ previous_menu_items_used * word_size);
/* Fill in menu_items with the current menu bar contents.
This can evaluate Lisp code. */
menu_items = f->menu_bar_vector;
menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
subitems = ASIZE (items) / 4;
- submenu_start = (int *) alloca ((subitems + 1) * sizeof (int));
- submenu_end = (int *) alloca (subitems * sizeof (int));
- submenu_n_panes = (int *) alloca (subitems * sizeof (int));
- submenu_top_level_items = (int *) alloca (subitems * sizeof (int));
+ submenu_start = alloca ((subitems + 1) * sizeof *submenu_start);
+ submenu_end = alloca (subitems * sizeof *submenu_end);
+ submenu_n_panes = alloca (subitems * sizeof *submenu_n_panes);
+ submenu_top_level_items = alloca (subitems
+ * sizeof *submenu_top_level_items);
init_menu_items ();
for (i = 0; i < subitems; i++)
{
Lisp_Object key, string, maps;
- key = XVECTOR (items)->contents[4 * i];
- string = XVECTOR (items)->contents[4 * i + 1];
- maps = XVECTOR (items)->contents[4 * i + 2];
+ key = AREF (items, 4 * i);
+ string = AREF (items, 4 * i + 1);
+ maps = AREF (items, 4 * i + 2);
if (NILP (string))
break;
/* Compare the new menu items with the ones computed last time. */
for (i = 0; i < previous_menu_items_used; i++)
if (menu_items_used == i
- || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
+ || (!EQ (previous_items[i], AREF (menu_items, i))))
break;
if (i == menu_items_used && i == previous_menu_items_used && i != 0)
{
}
/* The menu items are different, so store them in the frame. */
- f->menu_bar_vector = menu_items;
+ fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
/* This undoes save_menu_items. */
for (i = 0; i < ASIZE (items); i += 4)
{
Lisp_Object string;
- string = XVECTOR (items)->contents[i + 1];
+ string = AREF (items, i + 1);
if (NILP (string))
break;
wv->name = SSDATA (string);
{
Lisp_Object string;
- string = XVECTOR (items)->contents[i + 1];
+ string = AREF (items, i + 1);
if (NILP (string))
break;
/* Create or update the menu bar widget. */
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_GTK
xg_crazy_callback_abort = 1;
xg_crazy_callback_abort = 0;
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Called from Fx_create_frame to create the initial menubar of a frame
{
/* 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_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
set_frame_menubar (f, 1, 1);
}
Widget menubar_widget;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
menubar_widget = f->output_data.x->menubar_widget;
Position x0, y0, x1, y1;
#endif
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_MOTIF
if (f->output_data.x->widget)
#endif
x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
#endif /* not USE_GTK */
struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
popup_activated_flag = 0;
- BLOCK_INPUT;
+ block_input ();
gtk_widget_destroy (GTK_WIDGET (p->pointer));
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
GtkWidget *menu;
GtkMenuPositionFunc pos_func = 0; /* Pop up at pointer. */
struct next_popup_x_y popup_x_y;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
int use_pos_func = ! for_click;
#ifdef HAVE_GTK3
#endif
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
xg_crazy_callback_abort = 1;
menu = xg_create_widget ("popup", first_wv->name, f, first_wv,
LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
| XINT (XCDR (arg)));
- BLOCK_INPUT;
+ block_input ();
lw_destroy_all_widgets (id);
- UNBLOCK_INPUT;
+ unblock_input ();
popup_activated_flag = 0;
return Qnil;
Widget menu;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
#ifdef USE_LUCID
apply_systemfont_to_menu (f, f->output_data.x->widget);
{
int fact = 4 * sizeof (LWLIB_ID);
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (pop_down_menu,
Fcons (make_number (menu_id >> (fact)),
make_number (menu_id & ~(-1 << (fact)))));
int i;
widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
widget_value **submenu_stack
- = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
+ = alloca (menu_items_used * sizeof *submenu_stack);
Lisp_Object *subprefix_stack
- = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
+ = alloca (menu_items_used * sizeof *subprefix_stack);
int submenu_depth = 0;
int first_pane;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
*error_name = NULL;
i = 0;
while (i < menu_items_used)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ if (EQ (AREF (menu_items, i), Qnil))
{
submenu_stack[submenu_depth++] = save_wv;
save_wv = prev_wv;
first_pane = 1;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ else if (EQ (AREF (menu_items, i), Qlambda))
{
prev_wv = save_wv;
save_wv = submenu_stack[--submenu_depth];
first_pane = 0;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
+ else if (EQ (AREF (menu_items, i), Qt)
&& submenu_depth != 0)
i += MENU_ITEMS_PANE_LENGTH;
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ else if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name, prefix;
save_wv->next = wv;
else
first_wv->contents = wv;
- wv->name = pane_string;
+ wv->name = (char *) pane_string;
if (keymaps && !NILP (prefix))
wv->name++;
wv->value = 0;
/* 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 *) &XVECTOR (menu_items)->contents[i] : 0);
+ wv->call_data = !NILP (def) ? aref_addr (menu_items, i) : 0;
wv->enabled = !NILP (enable);
if (NILP (type))
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else
- abort ();
+ emacs_abort ();
wv->selected = !NILP (selected);
i = 0;
while (i < menu_items_used)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ if (EQ (AREF (menu_items, i), Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ else if (EQ (AREF (menu_items, i), Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ else if (EQ (AREF (menu_items, i), Qt))
{
prefix
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
i += MENU_ITEMS_PANE_LENGTH;
}
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
else
{
entry
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
- if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
+ if (menu_item_selection == aref_addr (menu_items, i))
{
if (keymaps != 0)
{
GtkWidget *menu;
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
menu = xg_create_widget ("dialog", first_wv->name, f, first_wv,
G_CALLBACK (dialog_selection_callback),
if (menu)
{
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
/* Display the menu. */
if ((intptr_t) client_data != -1)
menu_item_selection = (Lisp_Object *) client_data;
- BLOCK_INPUT;
+ block_input ();
lw_destroy_all_widgets (id);
- UNBLOCK_INPUT;
+ unblock_input ();
popup_activated_flag = 0;
}
LWLIB_ID dialog_id;
if (!FRAME_X_P (f))
- abort ();
+ emacs_abort ();
dialog_id = widget_id_tick++;
#ifdef USE_LUCID
/* Process events that apply to the dialog box.
Also handle timers. */
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int fact = 4 * sizeof (LWLIB_ID);
/* xdialog_show_unwind is responsible for popping the dialog box down. */
/* 1 means we've seen the boundary between left-hand elts and right-hand. */
int boundary_seen = 0;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
if (! FRAME_X_P (f))
- abort ();
+ emacs_abort ();
*error_name = NULL;
{
Lisp_Object pane_name, prefix;
const char *pane_string;
- pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
- prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
+ pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
+ prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
pane_string = (NILP (pane_name)
? "" : SSDATA (pane_name));
prev_wv = xmalloc_widget_value ();
- prev_wv->value = pane_string;
+ prev_wv->value = (char *) pane_string;
if (keymaps && !NILP (prefix))
prev_wv->name++;
prev_wv->enabled = 1;
/* Create a new item within current pane. */
Lisp_Object item_name, enable, descrip;
- item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
- enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
+ item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
+ enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
descrip
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
if (NILP (item_name))
{
if (!NILP (descrip))
wv->key = SSDATA (descrip);
wv->value = SSDATA (item_name);
- wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
+ wv->call_data = aref_addr (menu_items, i);
wv->enabled = !NILP (enable);
wv->help = Qnil;
prev_wv = wv;
{
Lisp_Object entry;
- if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ if (EQ (AREF (menu_items, i), Qt))
{
prefix
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
i += MENU_ITEMS_PANE_LENGTH;
}
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
{
/* This is the boundary between left-side elts and
right-side elts. */
else
{
entry
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
- if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
+ if (menu_item_selection == aref_addr (menu_items, i))
{
if (keymaps != 0)
{
FRAME_PTR f = p1->pointer;
XMenu *menu = p2->pointer;
- BLOCK_INPUT;
+ block_input ();
#ifndef MSDOS
XUngrabPointer (FRAME_X_DISPLAY (f), CurrentTime);
XUngrabKeyboard (FRAME_X_DISPLAY (f), CurrentTime);
#endif /* HAVE_X_WINDOWS */
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
int maxwidth;
int dummy_int;
unsigned int dummy_uint;
- int specpdl_count = SPECPDL_INDEX ();
+ ptrdiff_t specpdl_count = SPECPDL_INDEX ();
if (! FRAME_X_P (f) && ! FRAME_MSDOS_P (f))
- abort ();
+ emacs_abort ();
*error_name = 0;
if (menu_items_n_panes == 0)
lpane = XM_FAILURE;
while (i < menu_items_used)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name, prefix;
maxlines = max (maxlines, lines);
lines = 0;
- pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
- prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
+ prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
pane_string = (NILP (pane_name)
? "" : SSDATA (pane_name));
if (keymaps && !NILP (prefix))
while (j < menu_items_used)
{
Lisp_Object item;
- item = XVECTOR (menu_items)->contents[j];
+ item = AREF (menu_items, j);
if (EQ (item, Qt))
break;
if (NILP (item))
}
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
- else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
else
{
char *item_data;
char const *help_string;
- item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
- enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
+ item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
+ enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
descrip
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
- help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
+ help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
help_string = STRINGP (help) ? SSDATA (help) : NULL;
if (!NILP (descrip))
{
/* if alloca is fast, use that to make the space,
to reduce gc needs. */
- item_data = (char *) alloca (maxwidth + SBYTES (descrip) + 1);
+ item_data = alloca (maxwidth + SBYTES (descrip) + 1);
memcpy (item_data, SSDATA (item_name), SBYTES (item_name));
for (j = SCHARS (item_name); j < maxwidth; j++)
item_data[j] = ' ';
i = 0;
while (i < menu_items_used)
{
- if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ if (EQ (AREF (menu_items, i), Qt))
{
if (pane == 0)
pane_prefix
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
pane--;
i += MENU_ITEMS_PANE_LENGTH;
}
if (selidx == 0)
{
entry
- = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
+ = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
if (keymaps != 0)
{
entry = Fcons (entry, Qnil);
/* 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;
#ifdef HAVE_LIBXML2
-#include <setjmp.h>
#include <libxml/tree.h>
#include <libxml/parser.h>
#include <libxml/HTMLparser.h>
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
+\f
+static Lisp_Object Qlibxml2_dll;
+
+#ifdef WINDOWSNT
+
+#include <windows.h>
+#include "w32.h"
+
+/* Macro for defining functions that will be loaded from the libxml2 DLL. */
+#define DEF_XML2_FN(rettype,func,args) static rettype (FAR CDECL *fn_##func)args
+
+/* Macro for loading libxml2 functions from the library. */
+#define LOAD_XML2_FN(lib,func) { \
+ fn_##func = (void *) GetProcAddress (lib, #func); \
+ if (!fn_##func) goto bad_library; \
+ }
+
+DEF_XML2_FN (htmlDocPtr, htmlReadMemory,
+ (const char *, int, const char *, const char *, int));
+DEF_XML2_FN (xmlDocPtr, xmlReadMemory,
+ (const char *, int, const char *, const char *, int));
+DEF_XML2_FN (xmlNodePtr, xmlDocGetRootElement, (xmlDocPtr));
+DEF_XML2_FN (void, xmlFreeDoc, (xmlDocPtr));
+DEF_XML2_FN (void, xmlCleanupParser, (void));
+DEF_XML2_FN (void, xmlCheckVersion, (int));
+
+static int
+libxml2_loaded_p (void)
+{
+ Lisp_Object found = Fassq (Qlibxml2_dll, Vlibrary_cache);
+
+ if (CONSP (found))
+ return EQ (XCDR (found), Qt) ? 1 : 0;
+ return 0;
+}
+
+#else /* !WINDOWSNT */
+
+#define fn_htmlReadMemory htmlReadMemory
+#define fn_xmlReadMemory xmlReadMemory
+#define fn_xmlDocGetRootElement xmlDocGetRootElement
+#define fn_xmlFreeDoc xmlFreeDoc
+#define fn_xmlCleanupParser xmlCleanupParser
+#define fn_xmlCheckVersion xmlCheckVersion
+
+static inline int
+libxml2_loaded_p (void)
+{
+ return 1;
+}
+
+#endif /* !WINDOWSNT */
+
+static int
+init_libxml2_functions (void)
+{
+#ifdef WINDOWSNT
+ if (libxml2_loaded_p ())
+ return 1;
+ else
+ {
+ HMODULE library;
+
+ if (!(library = w32_delayed_load (Qlibxml2_dll)))
+ {
+ message ("%s", "libxml2 library not found");
+ return 0;
+ }
+
+ /* LOAD_XML2_FN jumps to bad_library if it fails to find the
+ named function. */
+ LOAD_XML2_FN (library, htmlReadMemory);
+ LOAD_XML2_FN (library, xmlReadMemory);
+ LOAD_XML2_FN (library, xmlDocGetRootElement);
+ LOAD_XML2_FN (library, xmlFreeDoc);
+ LOAD_XML2_FN (library, xmlCleanupParser);
+ LOAD_XML2_FN (library, xmlCheckVersion);
+
+ Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qt), Vlibrary_cache);
+ return 1;
+ }
+
+ bad_library:
+ Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qnil), Vlibrary_cache);
+
+ return 0;
+#else /* !WINDOWSNT */
+ return 1;
+#endif /* !WINDOWSNT */
+}
+
static Lisp_Object
make_dom (xmlNode *node)
{
xmlDoc *doc;
Lisp_Object result = Qnil;
const char *burl = "";
- EMACS_INT bytes;
- EMACS_INT istart, iend;
+ ptrdiff_t bytes;
+ ptrdiff_t istart, iend;
- LIBXML_TEST_VERSION;
+ fn_xmlCheckVersion (LIBXML_VERSION);
validate_region (&start, &end);
bytes = CHAR_TO_BYTE (iend) - CHAR_TO_BYTE (istart);
if (htmlp)
- doc = htmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
- bytes, burl, "utf-8",
- HTML_PARSE_RECOVER|HTML_PARSE_NONET|
- HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
- HTML_PARSE_NOBLANKS);
+ doc = fn_htmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
+ bytes, burl, "utf-8",
+ HTML_PARSE_RECOVER|HTML_PARSE_NONET|
+ HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR|
+ HTML_PARSE_NOBLANKS);
else
- doc = xmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
- bytes, burl, "utf-8",
- XML_PARSE_NONET|XML_PARSE_NOWARNING|
- XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
+ doc = fn_xmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
+ bytes, burl, "utf-8",
+ XML_PARSE_NONET|XML_PARSE_NOWARNING|
+ XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
if (doc != NULL)
{
if (NILP (result)) {
/* The document isn't just comments, so get the tree the
proper way. */
- xmlNode *node = xmlDocGetRootElement (doc);
+ xmlNode *node = fn_xmlDocGetRootElement (doc);
if (node != NULL)
result = make_dom (node);
} else
result = Fcons (intern ("top"),
Fcons (Qnil, Fnreverse (Fcons (r, result))));
- xmlFreeDoc (doc);
+ fn_xmlFreeDoc (doc);
}
return result;
}
+void
+xml_cleanup_parser (void)
+{
+ if (libxml2_loaded_p ())
+ fn_xmlCleanupParser ();
+}
+
DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
Slibxml_parse_html_region,
2, 3, 0,
If BASE-URL is non-nil, it is used to expand relative URLs. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
{
- return parse_region (start, end, base_url, 1);
+ if (init_libxml2_functions ())
+ return parse_region (start, end, base_url, 1);
+ return Qnil;
}
DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
If BASE-URL is non-nil, it is used to expand relative URLs. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object base_url)
{
- return parse_region (start, end, base_url, 0);
+ if (init_libxml2_functions ())
+ return parse_region (start, end, base_url, 0);
+ return Qnil;
}
\f
{
defsubr (&Slibxml_parse_html_region);
defsubr (&Slibxml_parse_xml_region);
+
+ DEFSYM (Qlibxml2_dll, "libxml2");
}
#endif /* HAVE_LIBXML2 */
#include <epaths.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
x_get_customization_string (XrmDatabase db, const char *name,
const char *class)
{
- char *full_name
- = (char *) alloca (strlen (name) + sizeof ("customization") + 3);
- char *full_class
- = (char *) alloca (strlen (class) + sizeof ("Customization") + 3);
+ char *full_name = alloca (strlen (name) + sizeof "customization" + 3);
+ char *full_class = alloca (strlen (class) + sizeof "Customization" + 3);
char *result;
sprintf (full_name, "%s.%s", name, "customization");
if (result)
{
- char *copy = (char *) xmalloc (strlen (result) + 1);
+ char *copy = xmalloc (strlen (result) + 1);
strcpy (copy, result);
return copy;
}
Return NULL otherwise. */
static char *
-magic_file_p (const char *string, EMACS_INT string_len, const char *class,
+magic_file_p (const char *string, ptrdiff_t string_len, const char *class,
const char *escaped_suffix)
{
char *lang = getenv ("LANG");
ptrdiff_t path_size = 100;
- char *path = (char *) xmalloc (path_size);
+ char *path = xmalloc (path_size);
ptrdiff_t path_len = 0;
const char *p = string;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 - 1 - path_len < next_len)
memory_full (SIZE_MAX);
path_size = (path_len + next_len + 1) * 2;
- path = (char *) xrealloc (path, path_size);
+ path = xrealloc (path, path_size);
}
memcpy (path + path_len, next, next_len);
if (ptr == NULL)
return xstrdup ("/");
- copy = (char *) xmalloc (strlen (ptr) + 2);
+ copy = xmalloc (strlen (ptr) + 2);
strcpy (copy, ptr);
strcat (copy, "/");
char *xdefault;
home = gethomedir ();
- xdefault = (char *) xmalloc (strlen (home) + sizeof (".Xdefaults"));
+ xdefault = xmalloc (strlen (home) + sizeof ".Xdefaults");
strcpy (xdefault, home);
strcat (xdefault, ".Xdefaults");
db = XrmGetFileDatabase (xdefault);
char *home = gethomedir ();
char const *host = get_system_name ();
ptrdiff_t pathsize = strlen (home) + sizeof xdefaults + strlen (host);
- path = (char *) xrealloc (home, pathsize);
+ path = xrealloc (home, pathsize);
strcat (strcat (path, xdefaults), host);
p = path;
}
#include <config.h>
#include <limits.h>
#include <stdio.h> /* termhooks.h needs this */
-#include <setjmp.h>
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#include "dispextern.h" /* frame.h seems to want this */
#include "frame.h" /* Need this to get the X window of selected_frame */
#include "blockinput.h"
+#include "character.h"
#include "buffer.h"
#include "process.h"
#include "termhooks.h"
#include "keyboard.h"
-#include "character.h"
#include <X11/Xproto.h>
#ifdef TRACE_SELECTION
#define TRACE0(fmt) \
- fprintf (stderr, "%d: " fmt "\n", getpid ())
+ fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid ())
#define TRACE1(fmt, a0) \
- fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
+ fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0)
#define TRACE2(fmt, a0, a1) \
- fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
+ fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1)
#define TRACE3(fmt, a0, a1, a2) \
- fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
+ fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1, a2)
#else
#define TRACE0(fmt) (void) 0
#define TRACE1(fmt, a0) (void) 0
}
}
- queue_tmp
- = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
-
- if (queue_tmp != NULL)
- {
- TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
- queue_tmp->event = *event;
- queue_tmp->next = selection_queue;
- selection_queue = queue_tmp;
- }
+ queue_tmp = xmalloc (sizeof *queue_tmp);
+ TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
+ queue_tmp->event = *event;
+ queue_tmp->next = selection_queue;
+ selection_queue = queue_tmp;
}
/* Start queuing SELECTION_REQUEST_EVENT events. */
x_start_queuing_selection_requests (void)
{
if (x_queue_selection_requests)
- abort ();
+ emacs_abort ();
x_queue_selection_requests++;
TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
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);
}
}
\f
if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
- if (!SYMBOLP (sym)) abort ();
+ if (!SYMBOLP (sym)) emacs_abort ();
TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym)));
- BLOCK_INPUT;
+ block_input ();
val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False);
- UNBLOCK_INPUT;
+ unblock_input ();
return val;
}
if (atom == dpyinfo->Xatom_NULL)
return QNULL;
- BLOCK_INPUT;
+ block_input ();
str = XGetAtomName (dpy, atom);
- UNBLOCK_INPUT;
+ unblock_input ();
TRACE1 ("XGetAtomName --> %s", str);
if (! str) return Qnil;
val = intern (str);
- BLOCK_INPUT;
+ block_input ();
/* This was allocated by Xlib, so use XFree. */
XFree (str);
- UNBLOCK_INPUT;
+ unblock_input ();
return val;
}
\f
Time timestamp = last_event_timestamp;
Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name);
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (display);
XSetSelectionOwner (display, selection_atom, selecting_window, timestamp);
x_check_errors (display, "Can't set selection: %s");
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
/* Now update the local cache */
{
INTEGER_TO_CONS (timestamp), frame);
prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
- dpyinfo->terminal->Vselection_alist
- = Fcons (selection_data, dpyinfo->terminal->Vselection_alist);
+ tset_selection_alist
+ (dpyinfo->terminal,
+ 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. */
{
Lisp_Object local_value;
Lisp_Object handler_fn, value, check;
- int count;
local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
/* Don't allow a quit within the converter.
When the user types C-g, he would be surprised
if by luck it came during a converter. */
- count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
CHECK_SYMBOL (target_type);
/* The reason for the error may be that the receiver has
died in the meantime. Handle that case. */
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (reply->display);
XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base);
XFlush (reply->display);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* This is the selection request currently being processed.
static Lisp_Object
x_catch_errors_unwind (Lisp_Object dummy)
{
- BLOCK_INPUT;
+ block_input ();
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return Qnil;
}
\f
Window window = SELECTION_EVENT_REQUESTOR (event);
ptrdiff_t bytes_remaining;
int max_bytes = selection_quantum (display);
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct selection_data *cs;
reply->type = SelectionNotify;
if (reply->property == None)
reply->property = reply->target;
- BLOCK_INPUT;
+ block_input ();
/* The protected block contains wait_for_property_change, which can
run random lisp code (process handlers) or signal. Therefore, we
put the x_uncatch_errors call in an unwind. */
{
int format_bytes = cs->format / 8;
int had_errors = x_had_errors_p (display);
- UNBLOCK_INPUT;
+ unblock_input ();
bytes_remaining = cs->size;
bytes_remaining *= format_bytes;
int i = ((bytes_remaining < max_bytes)
? bytes_remaining
: max_bytes) / format_bytes;
- BLOCK_INPUT;
+ block_input ();
cs->wait_object
= expect_property_change (display, window, cs->property,
: format_bytes);
XFlush (display);
had_errors = x_had_errors_p (display);
- UNBLOCK_INPUT;
+ unblock_input ();
if (had_errors) break;
/* Now write a zero-length chunk to the property to tell the
requestor that we're done. */
- BLOCK_INPUT;
+ block_input ();
if (! waiting_for_other_props_on_window (display, window))
XSelectInput (display, window, 0L);
/* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
delivered before uncatch errors. */
XSync (display, False);
- UNBLOCK_INPUT;
+ unblock_input ();
/* GTK queues events in addition to the queue in Xlib. So we
UNBLOCK to enter the event loop and get possible errors delivered,
and then BLOCK again because x_uncatch_errors requires it. */
- BLOCK_INPUT;
+ block_input ();
/* This calls x_uncatch_errors. */
unbind_to (count, Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
/* Handle a SelectionRequest event EVENT.
Atom property = SELECTION_EVENT_PROPERTY (event);
Lisp_Object local_selection_data;
int success = 0;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
GCPRO2 (local_selection_data, target_symbol);
if (!dpyinfo) goto DONE;
{
if (for_multiple)
{
- cs = xmalloc (sizeof (struct selection_data));
+ cs = xmalloc (sizeof *cs);
cs->data = (unsigned char *) &conversion_fail_tag;
cs->size = 1;
cs->format = 32;
}
/* Otherwise, record the converted selection to binary. */
- cs = xmalloc (sizeof (struct selection_data));
+ cs = xmalloc (sizeof *cs);
cs->data = NULL;
cs->nofree = 1;
cs->property = property;
break;
}
}
- dpyinfo->terminal->Vselection_alist = Vselection_alist;
+ tset_selection_alist (dpyinfo->terminal, Vselection_alist);
/* Run the `x-lost-selection-functions' abnormal hook. */
{
args[1] = Fcar (Fcar (t->Vselection_alist));
Frun_hook_with_args (2, args);
- t->Vselection_alist = XCDR (t->Vselection_alist);
+ tset_selection_alist (t, XCDR (t->Vselection_alist));
}
/* Delete elements after the beginning of Vselection_alist. */
expect_property_change (Display *display, Window window,
Atom property, int state)
{
- struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
+ struct prop_location *pl = xmalloc (sizeof *pl);
pl->identifier = ++prop_location_identifier;
pl->display = display;
pl->window = window;
static void
wait_for_property_change (struct prop_location *location)
{
- int secs, usecs;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
if (property_change_reply_object)
- abort ();
+ emacs_abort ();
/* Make sure to do unexpect_property_change if we quit or err. */
record_unwind_protect (wait_for_property_change_unwind,
property_change_reply, because property_change_reply_object says so. */
if (! location->arrived)
{
- secs = x_selection_timeout / 1000;
- usecs = (x_selection_timeout % 1000) * 1000;
- TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
- wait_reading_process_output (secs, usecs, 0, 0,
+ EMACS_INT timeout = max (0, x_selection_timeout);
+ EMACS_INT secs = timeout / 1000;
+ int nsecs = (timeout % 1000) * 1000000;
+ TRACE2 (" Waiting %"pI"d secs, %d nsecs", secs, nsecs);
+ wait_reading_process_output (secs, nsecs, 0, 0,
property_change_reply, NULL, 0);
if (NILP (XCAR (property_change_reply)))
Atom type_atom = (CONSP (target_type)
? symbol_to_x_atom (dpyinfo, XCAR (target_type))
: symbol_to_x_atom (dpyinfo, target_type));
- int secs, usecs;
+ EMACS_INT timeout, secs;
+ int nsecs;
if (!FRAME_LIVE_P (f))
return Qnil;
if (! NILP (time_stamp))
CONS_TO_INTEGER (time_stamp, Time, requestor_time);
- BLOCK_INPUT;
+ block_input ();
TRACE2 ("Get selection %s, type %s",
XGetAtomName (display, type_atom),
XGetAtomName (display, target_property));
record_unwind_protect (queue_selection_requests_unwind, Qnil);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
/* This allows quits. Also, don't wait forever. */
- secs = x_selection_timeout / 1000;
- usecs = (x_selection_timeout % 1000) * 1000;
- TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
- wait_reading_process_output (secs, usecs, 0, 0,
+ timeout = max (0, x_selection_timeout);
+ secs = timeout / 1000;
+ nsecs = (timeout % 1000) * 1000000;
+ TRACE1 (" Start waiting %"pI"d secs for SelectionNotify", secs);
+ wait_reading_process_output (secs, nsecs, 0, 0,
reading_selection_reply, NULL, 0);
TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
? min (PTRDIFF_MAX, SIZE_MAX) - 1
: LONG_MAX * x_long_size);
- BLOCK_INPUT;
+ block_input ();
/* First probe the thing to find out how big it is. */
result = XGetWindowProperty (display, window, 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;
break;
bytes_per_item = *actual_format_ret >> 3;
- xassert (*actual_size_ret <= buffer_size / bytes_per_item);
+ eassert (*actual_size_ret <= buffer_size / bytes_per_item);
/* The man page for XGetWindowProperty says:
"If the returned format is 32, the returned data is represented
offset += bytes_gotten;
/* This was allocated by Xlib, so use XFree. */
- XFree ((char *) tmp_data);
+ XFree (tmp_data);
}
XFlush (display);
data[offset] = '\0';
done:
- UNBLOCK_INPUT;
+ unblock_input ();
*data_ret = data;
*bytes_ret = offset;
return;
size_overflow:
free (data);
- UNBLOCK_INPUT;
+ unblock_input ();
memory_full (SIZE_MAX);
memory_exhausted:
free (data);
- UNBLOCK_INPUT;
+ unblock_input ();
memory_full (total_size + 1);
}
\f
struct prop_location *wait_object;
if (min (PTRDIFF_MAX, SIZE_MAX) < min_size_bytes)
memory_full (SIZE_MAX);
- *data_ret = (unsigned char *) xmalloc (min_size_bytes);
+ *data_ret = xmalloc (min_size_bytes);
*size_bytes_ret = min_size_bytes;
TRACE1 ("Read %u bytes incrementally", min_size_bytes);
that property, then reading the property, then deleting it to ack.
We are done when the sender places a property of length 0.
*/
- BLOCK_INPUT;
+ block_input ();
XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
TRACE1 (" Delete property %s",
SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
wait_object = expect_property_change (display, window, property,
PropertyNewValue);
XFlush (display);
- UNBLOCK_INPUT;
+ unblock_input ();
while (1)
{
break;
}
- BLOCK_INPUT;
+ block_input ();
TRACE1 (" ACK by deleting property %s",
XGetAtomName (display, property));
XDeleteProperty (display, window, property);
wait_object = expect_property_change (display, window, property,
PropertyNewValue);
XFlush (display);
- UNBLOCK_INPUT;
+ unblock_input ();
if (*size_bytes_ret - offset < tmp_size_bytes)
*data_ret = xpalloc (*data_ret, size_bytes_ret,
if (! data)
{
int there_is_a_selection_owner;
- BLOCK_INPUT;
+ block_input ();
there_is_a_selection_owner
= XGetSelectionOwner (display, selection_atom);
- UNBLOCK_INPUT;
+ unblock_input ();
if (there_is_a_selection_owner)
signal_error ("Selection owner couldn't convert",
actual_type
/* That wasn't really the data, just the beginning. */
unsigned int min_size_bytes = * ((unsigned int *) data);
- BLOCK_INPUT;
+ block_input ();
/* Use xfree, not XFree, because x_get_window_property
calls xmalloc itself. */
- xfree ((char *) data);
- UNBLOCK_INPUT;
+ xfree (data);
+ unblock_input ();
receive_incremental_selection (display, window, property, target_type,
min_size_bytes, &data, &bytes,
&actual_type, &actual_format,
&actual_size);
}
- BLOCK_INPUT;
+ block_input ();
TRACE1 (" Delete property %s", XGetAtomName (display, property));
XDeleteProperty (display, window, property);
XFlush (display);
- UNBLOCK_INPUT;
+ unblock_input ();
/* It's been read. Now convert it to a lisp object in some semi-rational
manner. */
/* Use xfree, not XFree, because x_get_window_property
calls xmalloc itself. */
- xfree ((char *) data);
+ xfree (data);
return val;
}
\f
v = Fmake_vector (make_number (size / 2), make_number (0));
for (i = 0; i < size / 2; i++)
{
- EMACS_INT j = ((short *) data) [i];
+ short j = ((short *) data) [i];
Faset (v, make_number (i), make_number (j));
}
return v;
}
else if (SYMBOLP (obj))
{
- *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
+ void *data = xmalloc (sizeof (Atom) + 1);
+ Atom *x_atom_ptr = data;
+ *data_ret = data;
*format_ret = 32;
*size_ret = 1;
(*data_ret) [sizeof (Atom)] = 0;
- (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, obj);
+ *x_atom_ptr = symbol_to_x_atom (dpyinfo, obj);
if (NILP (type)) type = QATOM;
}
else if (RANGED_INTEGERP (X_SHRT_MIN, obj, X_SHRT_MAX))
{
- *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
+ void *data = xmalloc (sizeof (short) + 1);
+ short *short_ptr = data;
+ *data_ret = data;
*format_ret = 16;
*size_ret = 1;
(*data_ret) [sizeof (short)] = 0;
- (*(short **) data_ret) [0] = XINT (obj);
+ *short_ptr = XINT (obj);
if (NILP (type)) type = QINTEGER;
}
else if (INTEGERP (obj)
|| (CONSP (XCDR (obj))
&& INTEGERP (XCAR (XCDR (obj)))))))
{
- *data_ret = (unsigned char *) xmalloc (sizeof (unsigned long) + 1);
+ void *data = xmalloc (sizeof (unsigned long) + 1);
+ unsigned long *x_long_ptr = data;
+ *data_ret = data;
*format_ret = 32;
*size_ret = 1;
(*data_ret) [sizeof (unsigned long)] = 0;
- (*(unsigned long **) data_ret) [0] = cons_to_x_long (obj);
+ *x_long_ptr = cons_to_x_long (obj);
if (NILP (type)) type = QINTEGER;
}
else if (VECTORP (obj))
ptrdiff_t i;
ptrdiff_t size = ASIZE (obj);
- if (SYMBOLP (XVECTOR (obj)->contents [0]))
+ if (SYMBOLP (AREF (obj, 0)))
/* This vector is an ATOM set */
{
+ void *data;
+ Atom *x_atoms;
if (NILP (type)) type = QATOM;
for (i = 0; i < size; i++)
- if (!SYMBOLP (XVECTOR (obj)->contents [i]))
+ if (!SYMBOLP (AREF (obj, i)))
signal_error ("All elements of selection vector must have same type", obj);
- *data_ret = xnmalloc (size, sizeof (Atom));
+ *data_ret = data = xnmalloc (size, sizeof *x_atoms);
+ x_atoms = data;
*format_ret = 32;
*size_ret = size;
for (i = 0; i < size; i++)
- (*(Atom **) data_ret) [i]
- = symbol_to_x_atom (dpyinfo, XVECTOR (obj)->contents [i]);
+ x_atoms[i] = symbol_to_x_atom (dpyinfo, AREF (obj, i));
}
else
/* This vector is an INTEGER set, or something like it */
{
int format = 16;
int data_size = sizeof (short);
+ void *data;
+ unsigned long *x_atoms;
+ short *shorts;
if (NILP (type)) type = QINTEGER;
for (i = 0; i < size; i++)
{
- if (! RANGED_INTEGERP (X_SHRT_MIN, XVECTOR (obj)->contents[i],
+ if (! RANGED_INTEGERP (X_SHRT_MIN, AREF (obj, i),
X_SHRT_MAX))
{
/* Use sizeof (long) even if it is more than 32 bits.
break;
}
}
- *data_ret = xnmalloc (size, data_size);
+ *data_ret = data = xnmalloc (size, data_size);
+ x_atoms = data;
+ shorts = data;
*format_ret = format;
*size_ret = size;
for (i = 0; i < size; i++)
{
if (format == 32)
- (*((unsigned long **) data_ret)) [i] =
- cons_to_x_long (XVECTOR (obj)->contents[i]);
+ x_atoms[i] = cons_to_x_long (AREF (obj, i));
else
- (*((short **) data_ret)) [i] =
- XINT (XVECTOR (obj)->contents[i]);
+ shorts[i] = XINT (AREF (obj, i));
}
}
}
ptrdiff_t size = ASIZE (obj);
Lisp_Object copy;
if (size == 1)
- return clean_local_selection_data (XVECTOR (obj)->contents [0]);
+ return clean_local_selection_data (AREF (obj, 0));
copy = Fmake_vector (make_number (size), Qnil);
for (i = 0; i < size; i++)
- XVECTOR (copy)->contents [i]
- = clean_local_selection_data (XVECTOR (obj)->contents [i]);
+ ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
}
return obj;
selection_atom = symbol_to_x_atom (dpyinfo, selection);
- BLOCK_INPUT;
+ block_input ();
if (NILP (time_object))
timestamp = last_event_timestamp;
else
CONS_TO_INTEGER (time_object, Time, timestamp);
XSetSelectionOwner (dpyinfo->display, selection_atom, None, timestamp);
- UNBLOCK_INPUT;
+ unblock_input ();
/* It doesn't seem to be guaranteed that a SelectionClear event will be
generated for a window which owns the selection when that window sets
atom = symbol_to_x_atom (dpyinfo, selection);
if (atom == 0) return Qnil;
- BLOCK_INPUT;
+ block_input ();
owner = XGetSelectionOwner (dpyinfo->display, atom);
- UNBLOCK_INPUT;
+ unblock_input ();
return (owner ? Qt : Qnil);
}
val = cons_to_signed (o, LONG_MIN, LONG_MAX);
else if (STRINGP (o))
{
- BLOCK_INPUT;
+ block_input ();
val = (long) XInternAtom (dpy, SSDATA (o), False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
error ("Wrong type, must be string, number or cons");
Window root, dummy_window;
int dummy;
- BLOCK_INPUT;
+ block_input ();
XQueryPointer (FRAME_X_DISPLAY (f),
DefaultRootWindow (FRAME_X_DISPLAY (f)),
*x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
*y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
DEFUN ("x-get-atom-name", Fx_get_atom_name,
CONS_TO_INTEGER (value, Atom, atom);
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
name = atom ? XGetAtomName (dpy, atom) : empty;
had_errors = x_had_errors_p (dpy);
if (atom && name) XFree (name);
if (NILP (ret)) ret = empty_unibyte_string;
- UNBLOCK_INPUT;
+ unblock_input ();
return ret;
}
x_atom = symbol_to_x_atom (dpyinfo, atom);
else if (STRINGP (atom))
{
- BLOCK_INPUT;
+ block_input ();
x_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (atom), False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
else
error ("ATOM must be a symbol or a string");
if (x_check_property_data (values) == -1)
error ("Bad data in VALUES, must be number, cons or string");
- event.xclient.type = ClientMessage;
- event.xclient.format = XFASTINT (format);
-
- if (event.xclient.format != 8 && event.xclient.format != 16
- && event.xclient.format != 32)
+ if (XINT (format) != 8 && XINT (format) != 16 && XINT (format) != 32)
error ("FORMAT must be one of 8, 16 or 32");
+ event.xclient.type = ClientMessage;
+ event.xclient.format = XINT (format);
+
if (FRAMEP (dest) || NILP (dest))
{
struct frame *fdest = check_x_frame (dest);
if (wdest == 0) wdest = dpyinfo->root_window;
to_root = wdest == dpyinfo->root_window;
- BLOCK_INPUT;
+ block_input ();
event.xclient.message_type = message_type;
event.xclient.display = dpyinfo->display;
XFlush (dpyinfo->display);
}
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
#include <float.h>
#include <limits.h>
-#include <setjmp.h>
#include <fcntl.h>
#include "lisp.h"
#include "xterm.h"
XCAR (dpyinfo->name_list_element));
}
-
+#ifdef HAVE_XFT
#define XSETTINGS_FONT_NAME "Gtk/FontName"
+#endif
#define XSETTINGS_TOOL_BAR_STYLE "Gtk/ToolbarStyle"
enum {
if (send_event_p)
store_config_changed_event (Qfont_render,
XCAR (dpyinfo->name_list_element));
- sprintf (buf, format, oldsettings.aa, oldsettings.hinting,
- oldsettings.rgba, oldsettings.lcdfilter,
- oldsettings.hintstyle, oldsettings.dpi);
- Vxft_settings = build_string (buf);
+ Vxft_settings
+ = make_formatted_string (buf, format,
+ oldsettings.aa, oldsettings.hinting,
+ oldsettings.rgba, oldsettings.lcdfilter,
+ oldsettings.hintstyle, oldsettings.dpi);
+
}
else
FcPatternDestroy (pat);
{
Display *dpy = dpyinfo->display;
- BLOCK_INPUT;
+ block_input ();
/* Select events so we can detect client messages sent when selection
owner changes. */
if (dpyinfo->xsettings_window != None)
read_and_apply_settings (dpyinfo, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
void
defsubr (&Sfont_get_system_normal_font);
DEFVAR_BOOL ("font-use-system-font", use_system_font,
- doc: /* *Non-nil means to apply the system defined font dynamically.
+ doc: /* Non-nil means to apply the system defined font dynamically.
When this is non-nil and the system defined fixed width font changes, we
update frames dynamically.
If this variable is nil, Emacs ignores system font changes. */);
DEFVAR_LISP ("xft-settings", Vxft_settings,
doc: /* Font settings applied to Xft. */);
- Vxft_settings = make_string ("", 0);
+ Vxft_settings = empty_unibyte_string;
#ifdef HAVE_XFT
Fprovide (intern_c_string ("font-render-setting"), Qnil);
#ifndef XSETTINGS_H
#define XSETTINGS_H
-EXFUN (Ftool_bar_get_system_style, 0);
-
extern void xsettings_initialize (struct x_display_info *dpyinfo);
extern void xft_settings_event (struct x_display_info *dpyinfo,
XEvent *);
#include <unistd.h>
#include <sys/param.h>
#include <stdio.h>
-#include <setjmp.h>
#include "lisp.h"
#include "systime.h"
open to a session manager, just return. */
static void
-x_session_check_input (int fd, void *data, int for_read)
+x_session_check_input (int fd, void *data)
{
int ret;
/* Xt features made by Fred Pierresteguy. */
#include <config.h>
-#include <signal.h>
#include <stdio.h>
-#include <setjmp.h>
#ifdef HAVE_X_WINDOWS
#include "lisp.h"
#include "blockinput.h"
-
-/* Need syssignal.h for various externs and definitions that may be required
- by some configurations for calls to signal later in this source file. */
#include "syssignal.h"
/* This may include sys/types.h, and that somehow loses
#include "systime.h"
#include <fcntl.h>
-#include <ctype.h>
#include <errno.h>
-#include <setjmp.h>
#include <sys/stat.h>
/* Caused redefinition of DBL_DIG on Netbsd; seems not to be needed. */
/* #include <sys/param.h> */
#include <X11/Shell.h>
#endif
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#endif
-
#include <unistd.h>
#ifdef USE_GTK
#endif
#endif
+#include "bitmaps/gray.xbm"
+
/* Default to using XIM if available. */
#ifdef USE_XIM
int use_xim = 1;
Lisp_Object x_display_name_list;
-/* Frame being updated by update_frame. This is declared in term.c.
- This is set by update_begin and looked at by all the XT functions.
- It is zero while not inside an update. In that case, the XT
- functions assume that `selected_frame' is the frame to apply to. */
-
-extern struct frame *updating_frame;
-
/* This is a frame waiting to be auto-raised, within XTread_socket. */
static struct frame *pending_autoraise_frame;
/* Incremented by XTread_socket whenever it really tries to read
events. */
-#ifdef __STDC__
static int volatile input_signal_count;
-#else
-static int input_signal_count;
-#endif
/* Used locally within XTread_socket. */
/* Used in x_flush. */
-static int x_alloc_nearest_color_1 (Display *, Colormap, XColor *);
+static bool x_alloc_nearest_color_1 (Display *, Colormap, XColor *);
static void x_set_window_size_1 (struct frame *, int, int, int);
static void x_raise_frame (struct frame *);
static void x_lower_frame (struct frame *);
static void XTset_terminal_modes (struct terminal *);
static void XTreset_terminal_modes (struct terminal *);
static void x_clear_frame (struct frame *);
-static void x_ins_del_lines (struct frame *, int, int) NO_RETURN;
+static _Noreturn void x_ins_del_lines (struct frame *, int, int);
static void frame_highlight (struct frame *);
static void frame_unhighlight (struct frame *);
static void x_new_focus_frame (struct x_display_info *, struct frame *);
#ifdef USE_GTK
static int x_dispatch_event (XEvent *, Display *);
#endif
-/* Don't declare this NO_RETURN because we want no
+/* Don't declare this _Noreturn because we want no
interference with debugging failing X calls. */
static void x_connection_closed (Display *, const char *);
static void x_wm_set_window_state (struct frame *, int);
if (!NILP (Vinhibit_redisplay))
return;
- BLOCK_INPUT;
+ block_input ();
if (f == NULL)
{
Lisp_Object rest, frame;
}
else if (FRAME_X_P (f))
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (rc == Success && actual != None)
{
unsigned long value = *(unsigned long *)data;
- XFree ((void *) data);
+ XFree (data);
if (value == opac)
{
x_uncatch_errors ();
updated_window = w;
set_output_cursor (&w->cursor);
- BLOCK_INPUT;
+ block_input ();
if (f == hlinfo->mouse_face_mouse_frame)
{
hlinfo->mouse_face_window = Qnil;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
if (!w->pseudo_window_p)
{
- BLOCK_INPUT;
+ block_input ();
if (cursor_on_p)
display_and_set_cursor (w, 1, output_cursor.hpos,
if (draw_window_fringes (w, 1))
x_draw_vertical_border (w);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If a row with mouse-face was overwritten, arrange for
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
#ifndef XFlush
- BLOCK_INPUT;
+ block_input ();
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
#endif
}
if (hlinfo->mouse_face_deferred_gc
|| f == hlinfo->mouse_face_mouse_frame)
{
- BLOCK_INPUT;
+ block_input ();
if (hlinfo->mouse_face_mouse_frame)
note_mouse_highlight (hlinfo->mouse_face_mouse_frame,
hlinfo->mouse_face_mouse_x,
hlinfo->mouse_face_mouse_y);
hlinfo->mouse_face_deferred_gc = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
}
struct frame *f;
int width, height;
- xassert (w);
+ eassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p)
desired_row->redraw_fringe_bitmaps_p = 1;
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
- BLOCK_INPUT;
+ block_input ();
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
FRAME_PIXEL_WIDTH (f) - width,
y, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
static void x_draw_composite_glyph_string_foreground (struct glyph_string *);
static void x_draw_glyph_string_box (struct glyph_string *);
static void x_draw_glyph_string (struct glyph_string *);
-static void x_delete_glyphs (struct frame *, int) NO_RETURN;
+static _Noreturn void x_delete_glyphs (struct frame *, int);
static void x_compute_glyph_string_overhangs (struct glyph_string *);
static void x_set_cursor_gc (struct glyph_string *);
static void x_set_mode_line_face_gc (struct glyph_string *);
static void x_set_mouse_face_gc (struct glyph_string *);
-static int x_alloc_lighter_color (struct frame *, Display *, Colormap,
- unsigned long *, double, int);
+static bool x_alloc_lighter_color (struct frame *, Display *, Colormap,
+ unsigned long *, double, int);
static void x_setup_relief_color (struct frame *, struct relief *,
double, int, unsigned long);
static void x_setup_relief_colors (struct glyph_string *);
int, int, int, XRectangle *);
static void x_scroll_bar_clear (struct frame *);
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
static void x_check_font (struct frame *, struct font *);
#endif
s->gc = FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
- xassert (s->gc != 0);
+ eassert (s->gc != 0);
}
}
/* GC must have been set. */
- xassert (s->gc != 0);
+ eassert (s->gc != 0);
}
#ifdef USE_X_TOOLKIT
-static struct frame *x_frame_of_widget (Widget);
static Boolean cvt_string_to_pixel (Display *, XrmValue *, Cardinal *,
XrmValue *, XrmValue *, XtPointer *);
static void cvt_pixel_dtor (XtAppContext, XrmValue *, XtPointer,
XrmValue *, Cardinal *);
+#ifdef USE_LUCID
/* Return the frame on which widget WIDGET is used.. Abort if frame
cannot be determined. */
&& f->output_data.x->widget == widget)
return f;
- abort ();
+ emacs_abort ();
}
-
-#ifdef USE_LUCID
-
/* Allocate a color which is lighter or darker than *PIXEL by FACTOR
or DELTA. Try a color with RGB values multiplied by FACTOR first.
If this produces the same color as PIXEL, try a color where all RGB
values have DELTA added. Return the allocated color in *PIXEL.
DISPLAY is the X display, CMAP is the colormap to operate on.
- Value is non-zero if successful. */
+ Value is true if successful. */
-int
+bool
x_alloc_lighter_color_for_widget (Widget widget, Display *display, Colormap cmap,
unsigned long *pixel, double factor, int delta)
{
return x_alloc_lighter_color (f, display, cmap, pixel, factor, delta);
}
-#endif
+#endif /* USE_LUCID */
/* Structure specifying which arguments should be passed by Xt to
for (i = 0; i < ncolors; ++i)
{
unsigned long pixel = colors[i].pixel;
- xassert (pixel < dpyinfo->ncolor_cells);
- xassert (dpyinfo->color_cells[pixel].pixel == pixel);
+ eassert (pixel < dpyinfo->ncolor_cells);
+ eassert (dpyinfo->color_cells[pixel].pixel == pixel);
colors[i] = dpyinfo->color_cells[pixel];
}
}
/* Allocate the color COLOR->pixel on DISPLAY, colormap CMAP. If an
exact match can't be allocated, try the nearest color available.
- Value is non-zero if successful. Set *COLOR to the color
+ Value is true if successful. Set *COLOR to the color
allocated. */
-static int
+static bool
x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color)
{
- int rc;
+ bool rc;
- rc = XAllocColor (dpy, cmap, color);
+ rc = XAllocColor (dpy, cmap, color) != 0;
if (rc == 0)
{
/* If we got to this point, the colormap is full, so we're going
color->red = cells[nearest].red;
color->green = cells[nearest].green;
color->blue = cells[nearest].blue;
- rc = XAllocColor (dpy, cmap, color);
+ rc = XAllocColor (dpy, cmap, color) != 0;
}
else
{
/* Allocate the color COLOR->pixel on frame F, colormap CMAP. If an
exact match can't be allocated, try the nearest color available.
- Value is non-zero if successful. Set *COLOR to the color
+ Value is true if successful. Set *COLOR to the color
allocated. */
-int
+bool
x_alloc_nearest_color (struct frame *f, Colormap cmap, XColor *color)
{
gamma_correct (f, color);
XColor color;
color.pixel = pixel;
- BLOCK_INPUT;
+ block_input ();
x_query_color (f, &color);
XAllocColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), &color);
- UNBLOCK_INPUT;
+ unblock_input ();
#ifdef DEBUG_X_COLORS
register_color (pixel);
#endif
DISPLAY is the X display, CMAP is the colormap to operate on.
Value is non-zero if successful. */
-static int
+static bool
x_alloc_lighter_color (struct frame *f, Display *display, Colormap cmap, long unsigned int *pixel, double factor, int delta)
{
XColor color, new;
long bright;
- int success_p;
+ bool success_p;
/* Get RGB color values. */
color.pixel = *pixel;
x_query_color (f, &color);
/* Change RGB values by specified FACTOR. Avoid overflow! */
- xassert (factor >= 0);
+ eassert (factor >= 0);
new.red = min (0xffff, factor * color.red);
new.green = min (0xffff, factor * color.green);
new.blue = min (0xffff, factor * color.blue);
static void
x_draw_stretch_glyph_string (struct glyph_string *s)
{
- xassert (s->first_glyph->type == STRETCH_GLYPH);
+ eassert (s->first_glyph->type == STRETCH_GLYPH);
if (s->hl == DRAW_CURSOR
&& !x_stretch_cursor_p)
s->background_filled_p = 1;
}
+/*
+ Draw a wavy line under S. The wave fills wave_height pixels from y0.
+
+ x0 wave_length = 2
+ --
+ y0 * * * * *
+ |* * * * * * * * *
+ wave_height = 3 | * * * *
+
+*/
+
+static void
+x_draw_underwave (struct glyph_string *s)
+{
+ int wave_height = 2, wave_length = 3;
+ int dx, dy, x0, y0, width, x1, y1, x2, y2, odd, xmax;
+ XRectangle wave_clip, string_clip, final_clip;
+
+ dx = wave_length;
+ dy = wave_height - 1;
+ x0 = s->x;
+ y0 = s->ybase + 1;
+ width = s->width;
+ xmax = x0 + width;
+
+ /* Find and set clipping rectangle */
+
+ wave_clip = (XRectangle){ x0, y0, width, wave_height };
+ get_glyph_string_clip_rect (s, &string_clip);
+
+ if (!x_intersect_rectangles (&wave_clip, &string_clip, &final_clip))
+ return;
+
+ XSetClipRectangles (s->display, s->gc, 0, 0, &final_clip, 1, Unsorted);
+
+ /* Draw the waves */
+
+ x1 = x0 - (x0 % dx);
+ x2 = x1 + dx;
+ odd = (x1/dx) % 2;
+ y1 = y2 = y0;
+
+ if (odd)
+ y1 += dy;
+ else
+ y2 += dy;
+
+ if (INT_MAX - dx < xmax)
+ emacs_abort ();
+
+ while (x1 <= xmax)
+ {
+ XDrawLine (s->display, s->window, s->gc, x1, y1, x2, y2);
+ x1 = x2, y1 = y2;
+ x2 += dx, y2 = y0 + odd*dy;
+ odd = !odd;
+ }
+
+ /* Restore previous clipping rectangle(s) */
+ XSetClipRectangles (s->display, s->gc, 0, 0, s->clip, s->num_clips, Unsorted);
+}
+
/* Draw glyph string S. */
break;
default:
- abort ();
+ emacs_abort ();
}
if (!s->for_overlaps)
{
/* Draw underline. */
if (s->face->underline_p)
- {
- unsigned long thickness, position;
- int y;
-
- if (s->prev && s->prev->face->underline_p)
- {
- /* We use the same underline style as the previous one. */
- thickness = s->prev->underline_thickness;
- position = s->prev->underline_position;
- }
- else
- {
- /* Get the underline thickness. Default is 1 pixel. */
- if (s->font && s->font->underline_thickness > 0)
- thickness = s->font->underline_thickness;
- else
- thickness = 1;
- if (x_underline_at_descent_line)
- position = (s->height - thickness) - (s->ybase - s->y);
- else
- {
- /* Get the underline position. This is the recommended
- vertical offset in pixels from the baseline to the top of
- the underline. This is a signed value according to the
- specs, and its default is
-
- ROUND ((maximum descent) / 2), with
- ROUND(x) = floor (x + 0.5) */
-
- if (x_use_underline_position_properties
- && s->font && s->font->underline_position >= 0)
- position = s->font->underline_position;
- else if (s->font)
- position = (s->font->descent + 1) / 2;
- else
- position = underline_minimum_offset;
- }
- position = max (position, underline_minimum_offset);
- }
- /* Check the sanity of thickness and position. We should
- avoid drawing underline out of the current line area. */
- if (s->y + s->height <= s->ybase + position)
- position = (s->height - 1) - (s->ybase - s->y);
- if (s->y + s->height < s->ybase + position + thickness)
- thickness = (s->y + s->height) - (s->ybase + position);
- s->underline_thickness = thickness;
- s->underline_position = position;
- y = s->ybase + position;
- if (s->face->underline_defaulted_p)
- XFillRectangle (s->display, s->window, s->gc,
- s->x, y, s->width, thickness);
- else
- {
- XGCValues xgcv;
- XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
- XSetForeground (s->display, s->gc, s->face->underline_color);
- XFillRectangle (s->display, s->window, s->gc,
- s->x, y, s->width, thickness);
- XSetForeground (s->display, s->gc, xgcv.foreground);
- }
- }
+ {
+ if (s->face->underline_type == FACE_UNDER_WAVE)
+ {
+ if (s->face->underline_defaulted_p)
+ x_draw_underwave (s);
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
+ XSetForeground (s->display, s->gc, s->face->underline_color);
+ x_draw_underwave (s);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ }
+ }
+ else if (s->face->underline_type == FACE_UNDER_LINE)
+ {
+ unsigned long thickness, position;
+ int y;
+ if (s->prev && s->prev->face->underline_p)
+ {
+ /* We use the same underline style as the previous one. */
+ thickness = s->prev->underline_thickness;
+ position = s->prev->underline_position;
+ }
+ else
+ {
+ /* Get the underline thickness. Default is 1 pixel. */
+ if (s->font && s->font->underline_thickness > 0)
+ thickness = s->font->underline_thickness;
+ else
+ thickness = 1;
+ if (x_underline_at_descent_line)
+ position = (s->height - thickness) - (s->ybase - s->y);
+ else
+ {
+ /* Get the underline position. This is the recommended
+ vertical offset in pixels from the baseline to the top of
+ the underline. This is a signed value according to the
+ specs, and its default is
+
+ ROUND ((maximum descent) / 2), with
+ ROUND(x) = floor (x + 0.5) */
+
+ if (x_use_underline_position_properties
+ && s->font && s->font->underline_position >= 0)
+ position = s->font->underline_position;
+ else if (s->font)
+ position = (s->font->descent + 1) / 2;
+ else
+ position = underline_minimum_offset;
+ }
+ position = max (position, underline_minimum_offset);
+ }
+ /* Check the sanity of thickness and position. We should
+ avoid drawing underline out of the current line area. */
+ if (s->y + s->height <= s->ybase + position)
+ position = (s->height - 1) - (s->ybase - s->y);
+ if (s->y + s->height < s->ybase + position + thickness)
+ thickness = (s->y + s->height) - (s->ybase + position);
+ s->underline_thickness = thickness;
+ s->underline_position = position;
+ y = s->ybase + position;
+ if (s->face->underline_defaulted_p)
+ XFillRectangle (s->display, s->window, s->gc,
+ s->x, y, s->width, thickness);
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
+ XSetForeground (s->display, s->gc, s->face->underline_color);
+ XFillRectangle (s->display, s->window, s->gc,
+ s->x, y, s->width, thickness);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ }
+ }
+ }
/* Draw overline. */
if (s->face->overline_p)
{
XSetClipMask (next->display, next->gc, None);
next->hl = save;
next->num_clips = 0;
+ next->clip_head = s->next;
}
}
}
static void
x_delete_glyphs (struct frame *f, register int n)
{
- abort ();
+ emacs_abort ();
}
void
x_clear_area (Display *dpy, Window window, int x, int y, int width, int height, int exposures)
{
- xassert (width > 0 && height > 0);
+ eassert (width > 0 && height > 0);
XClearArea (dpy, window, x, y, width, height, exposures);
}
/* We don't set the output cursor here because there will always
follow an explicit cursor_to. */
- BLOCK_INPUT;
+ block_input ();
XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
/* Invert the middle quarter of the frame for .15 sec. */
-/* We use the select system call to do the waiting, so we have to make
- sure it's available. If it isn't, we just won't do visual bells. */
-
-#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
-
-
-/* Subtract the `struct timeval' values X and Y, storing the result in
- *RESULT. Return 1 if the difference is negative, otherwise 0. */
-
-static int
-timeval_subtract (struct timeval *result, struct timeval x, struct timeval y)
-{
- /* Perform the carry for the later subtraction by updating y. This
- is safer because on some systems the tv_sec member is unsigned. */
- if (x.tv_usec < y.tv_usec)
- {
- int nsec = (y.tv_usec - x.tv_usec) / 1000000 + 1;
- y.tv_usec -= 1000000 * nsec;
- y.tv_sec += nsec;
- }
-
- if (x.tv_usec - y.tv_usec > 1000000)
- {
- int nsec = (y.tv_usec - x.tv_usec) / 1000000;
- y.tv_usec += 1000000 * nsec;
- y.tv_sec -= nsec;
- }
-
- /* Compute the time remaining to wait. tv_usec is certainly
- positive. */
- result->tv_sec = x.tv_sec - y.tv_sec;
- result->tv_usec = x.tv_usec - y.tv_usec;
-
- /* Return indication of whether the result should be considered
- negative. */
- return x.tv_sec < y.tv_sec;
-}
-
static void
XTflash (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
{
#ifdef USE_GTK
x_flush (f);
{
- struct timeval wakeup;
-
- EMACS_GET_TIME (wakeup);
-
- /* Compute time to wait until, propagating carry from usecs. */
- wakeup.tv_usec += 150000;
- wakeup.tv_sec += (wakeup.tv_usec / 1000000);
- wakeup.tv_usec %= 1000000;
+ EMACS_TIME delay = make_emacs_time (0, 150 * 1000 * 1000);
+ EMACS_TIME wakeup = add_emacs_time (current_emacs_time (), delay);
/* Keep waiting until past the time wakeup or any input gets
available. */
while (! detect_input_pending ())
{
- struct timeval current;
- struct timeval timeout;
+ EMACS_TIME current = current_emacs_time ();
+ EMACS_TIME timeout;
- EMACS_GET_TIME (current);
-
- /* Break if result would be negative. */
- if (timeval_subtract (¤t, wakeup, current))
+ /* Break if result would not be positive. */
+ if (EMACS_TIME_LE (wakeup, current))
break;
/* How long `select' should wait. */
- timeout.tv_sec = 0;
- timeout.tv_usec = 10000;
+ timeout = make_emacs_time (0, 10 * 1000 * 1000);
/* Try to wait that long--but we might wake up sooner. */
- select (0, NULL, NULL, NULL, &timeout);
+ pselect (0, NULL, NULL, NULL, &timeout, NULL);
}
}
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
-#endif /* defined (HAVE_TIMEVAL) && defined (HAVE_SELECT) */
-
static void
XTtoggle_invisible_pointer (FRAME_PTR f, int invisible)
{
- BLOCK_INPUT;
+ block_input ();
if (invisible)
{
if (FRAME_X_DISPLAY_INFO (f)->invisible_cursor != 0)
XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f->output_data.x->current_cursor);
f->pointer_invisible = invisible;
- UNBLOCK_INPUT;
+ unblock_input ();
}
{
if (FRAME_X_DISPLAY (f))
{
-#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
if (visible_bell)
XTflash (f);
else
-#endif
{
- BLOCK_INPUT;
+ block_input ();
XBell (FRAME_X_DISPLAY (f), 0);
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
}
static void
x_ins_del_lines (struct frame *f, int vpos, int n)
{
- abort ();
+ emacs_abort ();
}
height = run->height;
}
- BLOCK_INPUT;
+ block_input ();
/* Cursor off. Will be switched on again in x_update_window_end. */
updated_window = w;
width, height,
x, to_y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
the ICCCM (section 4.1.6) says that the window's border pixmap
and border pixel are window attributes which are "private to the
client", so we can always change it to whatever we want. */
- BLOCK_INPUT;
+ block_input ();
/* I recently started to get errors in this XSetWindowBorder, depending on
the window-manager in use, tho something more is at play since I've been
using that same window-manager binary for ever. Let's not crash just
XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f->output_data.x->border_pixel);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
x_update_cursor (f, 1);
x_set_frame_alpha (f);
}
the ICCCM (section 4.1.6) says that the window's border pixmap
and border pixel are window attributes which are "private to the
client", so we can always change it to whatever we want. */
- BLOCK_INPUT;
+ block_input ();
/* Same as above for XSetWindowBorder (bug#9310). */
x_catch_errors (FRAME_X_DISPLAY (f));
XSetWindowBorderPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f->output_data.x->border_tile);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
x_update_cursor (f, 1);
x_set_frame_alpha (f);
}
: dpyinfo->x_focus_frame);
if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame))
{
- FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame) = Qnil;
+ fset_focus_frame (dpyinfo->x_focus_frame, Qnil);
dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame;
}
}
dpyinfo->alt_mod_mask &= ~dpyinfo->meta_mod_mask;
}
- XFree ((char *) syms);
+ XFree (syms);
XFreeModifiermap (mods);
}
/* Convert between the modifier bits X uses and the modifier bits
Emacs uses. */
-EMACS_INT
+int
x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state)
{
- EMACS_INT mod_meta = meta_modifier;
- EMACS_INT mod_alt = alt_modifier;
- EMACS_INT mod_hyper = hyper_modifier;
- EMACS_INT mod_super = super_modifier;
+ int mod_meta = meta_modifier;
+ int mod_alt = alt_modifier;
+ int mod_hyper = hyper_modifier;
+ int mod_super = super_modifier;
Lisp_Object tem;
tem = Fget (Vx_alt_keysym, Qmodifier_value);
- if (INTEGERP (tem)) mod_alt = XINT (tem);
+ if (INTEGERP (tem)) mod_alt = XINT (tem) & INT_MAX;
tem = Fget (Vx_meta_keysym, Qmodifier_value);
- if (INTEGERP (tem)) mod_meta = XINT (tem);
+ if (INTEGERP (tem)) mod_meta = XINT (tem) & INT_MAX;
tem = Fget (Vx_hyper_keysym, Qmodifier_value);
- if (INTEGERP (tem)) mod_hyper = XINT (tem);
+ if (INTEGERP (tem)) mod_hyper = XINT (tem) & INT_MAX;
tem = Fget (Vx_super_keysym, Qmodifier_value);
- if (INTEGERP (tem)) mod_super = XINT (tem);
-
+ if (INTEGERP (tem)) mod_super = XINT (tem) & INT_MAX;
return ( ((state & (ShiftMask | dpyinfo->shift_lock_mask)) ? shift_modifier : 0)
| ((state & ControlMask) ? ctrl_modifier : 0)
static int
x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, EMACS_INT state)
{
- int mod_meta = meta_modifier;
- int mod_alt = alt_modifier;
- int mod_hyper = hyper_modifier;
- int mod_super = super_modifier;
+ EMACS_INT mod_meta = meta_modifier;
+ EMACS_INT mod_alt = alt_modifier;
+ EMACS_INT mod_hyper = hyper_modifier;
+ EMACS_INT mod_super = super_modifier;
Lisp_Object tem;
{
char *value;
- BLOCK_INPUT;
+ block_input ();
value = XKeysymToString (keysym);
- UNBLOCK_INPUT;
+ unblock_input ();
return value;
}
{
FRAME_PTR f1;
- BLOCK_INPUT;
+ block_input ();
if (! NILP (last_mouse_scroll_bar) && insist == 0)
x_scroll_bar_report_motion (fp, bar_window, part, x, y, timestamp);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
frame = XCAR (tail);
/* All elements of Vframe_list should be frames. */
if (! FRAMEP (frame))
- abort ();
+ emacs_abort ();
if (! FRAME_X_P (XFRAME (frame)))
continue;
struct frame *f = XFRAME (w->frame);
ptrdiff_t i;
- BLOCK_INPUT;
+ block_input ();
/* Construct a ClientMessage event to send to the frame. */
ev->type = ClientMessage;
be sent to the client that created the window, and if that
window no longer exists, no event will be sent. */
XSendEvent (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), False, 0, &event);
- UNBLOCK_INPUT;
+ unblock_input ();
}
int slider_size;
/* Get the slider size. */
- BLOCK_INPUT;
+ block_input ();
XtVaGetValues (widget, XmNsliderSize, &slider_size, NULL);
- UNBLOCK_INPUT;
+ unblock_input ();
whole = XM_SB_MAX - slider_size;
portion = min (cs->value, whole);
int part;
/* Get the size of the thumb, a value between 0 and 1. */
- BLOCK_INPUT;
+ block_input ();
XtVaGetValues (widget, XtNshown, &shown, XtNheight, &height, NULL);
- UNBLOCK_INPUT;
+ unblock_input ();
whole = 10000000;
portion = shown < 1 ? top * whole : 0;
- if (shown < 1 && (eabs (top + shown - 1) < 1.0/height))
+ if (shown < 1 && (eabs (top + shown - 1) < 1.0f / height))
/* Some derivatives of Xaw refuse to shrink the thumb when you reach
the bottom, so we force the scrolling whenever we see that we're
too close to the bottom (in x_set_toolkit_scroll_bar_thumb
int part;
/* Get the height of the scroll bar. */
- BLOCK_INPUT;
+ block_input ();
XtVaGetValues (widget, XtNheight, &height, NULL);
- UNBLOCK_INPUT;
+ unblock_input ();
if (eabs (position) >= height)
part = (position < 0) ? scroll_bar_above_handle : scroll_bar_below_handle;
{
const char *scroll_bar_name = SCROLL_BAR_NAME;
- BLOCK_INPUT;
+ block_input ();
xg_create_scroll_bar (f, bar, G_CALLBACK (xg_scroll_callback),
G_CALLBACK (xg_end_scroll_callback),
scroll_bar_name);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#else /* not USE_GTK */
Widget widget;
Arg av[20];
int ac = 0;
- char const *scroll_bar_name = SCROLL_BAR_NAME;
+ const char *scroll_bar_name = SCROLL_BAR_NAME;
unsigned long pixel;
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_MOTIF
/* Set resources. Create the widget. */
}
widget = XmCreateScrollBar (f->output_data.x->edit_widget,
- scroll_bar_name, av, ac);
+ (char *) scroll_bar_name, av, ac);
/* Add one callback for everything that can happen. */
XtAddCallback (widget, XmNdecrementCallback, xm_scroll_callback,
xwindow = XtWindow (widget);
bar->x_window = xwindow;
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* not USE_GTK */
Widget widget = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar);
float top, shown;
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_MOTIF
else
top = old_top;
/* Keep two pixels available for moving the thumb down. */
- shown = max (0, min (1 - top - (2.0 / height), shown));
+ shown = max (0, min (1 - top - (2.0f / height), shown));
/* If the call to XawScrollbarSetThumb below doesn't seem to work,
check that your system's configuration file contains a define
}
#endif /* !USE_MOTIF */
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* not USE_GTK */
struct frame *f = XFRAME (w->frame);
struct scroll_bar *bar
= ALLOCATE_PSEUDOVECTOR (struct scroll_bar, x_window, PVEC_OTHER);
+ Lisp_Object barobj;
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_TOOLKIT_SCROLL_BARS
x_create_toolkit_scroll_bar (f, bar);
/* 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_scroll_bars (f, barobj);
if (!NILP (bar->next))
XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
XMapRaised (FRAME_X_DISPLAY (f), bar->x_window);
#endif /* not USE_TOOLKIT_SCROLL_BARS */
- UNBLOCK_INPUT;
+ unblock_input ();
return bar;
}
&& end == bar->end)
return;
- BLOCK_INPUT;
+ block_input ();
{
int inside_width = VERTICAL_SCROLL_BAR_INSIDE_WIDTH (f, bar->width);
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* !USE_TOOLKIT_SCROLL_BARS */
x_scroll_bar_remove (struct scroll_bar *bar)
{
struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_TOOLKIT_SCROLL_BARS
#ifdef USE_GTK
#endif
/* Dissociate this scroll bar from its window. */
- XWINDOW (bar->window)->vertical_scroll_bar = Qnil;
+ wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil);
- UNBLOCK_INPUT;
+ unblock_input ();
}
XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int position)
{
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;
{
if (width > 0 && height > 0)
{
- BLOCK_INPUT;
+ block_input ();
#ifdef USE_TOOLKIT_SCROLL_BARS
if (fringe_extended_p)
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
#endif
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
left, top, width, height, False);
- UNBLOCK_INPUT;
+ unblock_input ();
}
bar = x_scroll_bar_create (w, top, sb_left, sb_width, height);
bar = XSCROLL_BAR (w->vertical_scroll_bar);
- BLOCK_INPUT;
+ block_input ();
if (sb_left != bar->left)
mask |= CWX;
bar->width = sb_width;
bar->height = height;
- UNBLOCK_INPUT;
+ unblock_input ();
}
#ifdef USE_TOOLKIT_SCROLL_BARS
}
#endif /* not USE_TOOLKIT_SCROLL_BARS */
- XSETVECTOR (w->vertical_scroll_bar, bar);
+ XSETVECTOR (barobj, bar);
+ wset_vertical_scroll_bar (w, barobj);
}
{
Lisp_Object bar;
bar = FRAME_SCROLL_BARS (frame);
- FRAME_SCROLL_BARS (frame) = XSCROLL_BAR (bar)->next;
+ fset_scroll_bars (frame, 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_condemned_scroll_bars (frame, bar);
}
}
{
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 (window->vertical_scroll_bar))
- abort ();
+ emacs_abort ();
bar = XSCROLL_BAR (window->vertical_scroll_bar);
return;
else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f),
window->vertical_scroll_bar))
- FRAME_CONDEMNED_SCROLL_BARS (f) = bar->next;
+ fset_condemned_scroll_bars (f, bar->next);
else
/* If its prev pointer is nil, it must be at the front of
one or the other! */
- abort ();
+ emacs_abort ();
}
else
XSCROLL_BAR (bar->prev)->next = bar->next;
bar->next = FRAME_SCROLL_BARS (f);
bar->prev = Qnil;
- XSETVECTOR (FRAME_SCROLL_BARS (f), bar);
+ XSETVECTOR (barobj, bar);
+ fset_scroll_bars (f, barobj);
if (! NILP (bar->next))
XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
}
/* 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_condemned_scroll_bars (f, Qnil);
for (; ! NILP (bar); bar = next)
{
GC gc = f->output_data.x->normal_gc;
int width_trim = VERTICAL_SCROLL_BAR_WIDTH_TRIM;
- BLOCK_INPUT;
+ block_input ();
x_scroll_bar_set_handle (bar, bar->start, bar->end, 1);
XSetForeground (FRAME_X_DISPLAY (f), gc,
FRAME_FOREGROUND_PIXEL (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* not USE_TOOLKIT_SCROLL_BARS */
x_scroll_bar_handle_click (struct scroll_bar *bar, XEvent *event, struct input_event *emacs_event)
{
if (! WINDOWP (bar->window))
- abort ();
+ emacs_abort ();
emacs_event->kind = SCROLL_BAR_CLICK_EVENT;
emacs_event->code = event->xbutton.button - Button1;
int dummy_coord;
unsigned int dummy_mask;
- BLOCK_INPUT;
+ block_input ();
/* Get the mouse's position relative to the scroll bar window, and
report that. */
*timestamp = last_mouse_movement_time;
- UNBLOCK_INPUT;
+ unblock_input ();
}
do \
{ \
if (f->output_data.x->saved_menu_event == 0) \
- f->output_data.x->saved_menu_event \
- = (XEvent *) xmalloc (sizeof (XEvent)); \
- *f->output_data.x->saved_menu_event = event; \
+ f->output_data.x->saved_menu_event = \
+ xmalloc (sizeof (XEvent)); \
+ *f->output_data.x->saved_menu_event = event; \
inev.ie.kind = MENU_BAR_ACTIVATE_EVENT; \
XSETFRAME (inev.ie.frame_or_window, f); \
} \
{
XEvent *xev = (XEvent *) gxev;
- BLOCK_INPUT;
+ block_input ();
if (current_count >= 0)
{
struct x_display_info *dpyinfo;
&& dpyinfo
&& x_filter_event (dpyinfo, xev))
{
- UNBLOCK_INPUT;
+ unblock_input ();
return GDK_FILTER_REMOVE;
}
#endif
else
current_finish = x_dispatch_event (xev, xev->xany.display);
- UNBLOCK_INPUT;
+ unblock_input ();
if (current_finish == X_EVENT_GOTO_OUT || current_finish == X_EVENT_DROP)
return GDK_FILTER_REMOVE;
if (status_return == XBufferOverflow)
{
copy_bufsiz = nbytes + 1;
- copy_bufptr = (unsigned char *) alloca (copy_bufsiz);
+ copy_bufptr = alloca (copy_bufsiz);
nbytes = XmbLookupString (FRAME_XIC (f),
&event.xkey, (char *) copy_bufptr,
copy_bufsiz, &keysym,
}
else if (status_return != XLookupKeySym
&& status_return != XLookupBoth)
- abort ();
+ emacs_abort ();
}
else
nbytes = XLookupString (&event.xkey, (char *) copy_bufptr,
/* Now non-ASCII. */
if (HASH_TABLE_P (Vx_keysym_table)
- && (NATNUMP (c = Fgethash (make_number (keysym),
- Vx_keysym_table,
- Qnil))))
+ && (c = Fgethash (make_number (keysym),
+ Vx_keysym_table,
+ Qnil),
+ NATNUMP (c)))
{
inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFASTINT (c))
? ASCII_KEYSTROKE_EVENT
default:
OTHER:
#ifdef USE_X_TOOLKIT
- BLOCK_INPUT;
+ block_input ();
if (*finish != X_EVENT_DROP)
XtDispatchEvent (&event);
- UNBLOCK_INPUT;
+ unblock_input ();
#endif /* USE_X_TOOLKIT */
break;
}
/* Read events coming from the X server.
- This routine is called by the SIGIO handler only if SYNC_INPUT is
- not defined.
- We return as soon as there are no more events to be read.
+ Return as soon as there are no more events to be read.
- We return the number of characters stored into the buffer,
+ Return the number of characters stored into the buffer,
thus pretending to be `read' (except the characters we store
in the keyboard buffer can be multibyte, so are not necessarily
- C chars).
-
- EXPECTED is nonzero if the caller knows input is available. */
+ C chars). */
static int
-XTread_socket (struct terminal *terminal, int expected, struct input_event *hold_quit)
+XTread_socket (struct terminal *terminal, struct input_event *hold_quit)
{
int count = 0;
int event_found = 0;
- if (interrupt_input_blocked)
- {
- interrupt_input_pending = 1;
-#ifdef SYNC_INPUT
- pending_signals = 1;
-#endif
- return -1;
- }
-
- interrupt_input_pending = 0;
-#ifdef SYNC_INPUT
- pending_signals = pending_atimers;
-#endif
- BLOCK_INPUT;
+ block_input ();
/* So people can tell when we have read the available input. */
input_signal_count++;
-#ifndef SYNC_INPUT
- ++handling_signal;
-#endif
-
/* For debugging, this gives a way to fake an I/O error. */
if (terminal->display_info.x == XTread_socket_fake_io_error)
{
pending_autoraise_frame = 0;
}
-#ifndef SYNC_INPUT
- --handling_signal;
-#endif
- UNBLOCK_INPUT;
+ unblock_input ();
return count;
}
break;
default:
- abort ();
+ emacs_abort ();
}
}
void
x_catch_errors (Display *dpy)
{
- struct x_error_message_stack *data = xmalloc (sizeof (*data));
+ struct x_error_message_stack *data = xmalloc (sizeof *data);
/* Make sure any errors from previous requests have been dealt with. */
XSync (dpy, False);
{
struct x_error_message_stack *tmp;
- BLOCK_INPUT;
+ block_input ();
/* The display may have been closed before this function is called.
Check if it is still open before calling XSync. */
tmp = x_error_message;
x_error_message = x_error_message->prev;
xfree (tmp);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* If any X protocol errors have arrived since the last call to
}
#endif /* ! 0 */
-\f
-/* Handle SIGPIPE, which can happen when the connection to a server
- simply goes away. SIGPIPE is handled by x_connection_signal.
- Don't need to do anything, because the write which caused the
- SIGPIPE will fail, causing Xlib to invoke the X IO error handler,
- which will do the appropriate cleanup for us. */
-
-static void
-x_connection_signal (int signalnum) /* If we don't have an argument, */
- /* some compilers complain in signal calls. */
-{
-#ifdef USG
- /* USG systems forget handlers when they are used;
- must reestablish each time */
- signal (signalnum, x_connection_signal);
-#endif /* USG */
-}
-
\f
/************************************************************************
Handling X errors
{
struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
Lisp_Object frame, tail;
- int idx = SPECPDL_INDEX ();
+ ptrdiff_t idx = SPECPDL_INDEX ();
- error_msg = (char *) alloca (strlen (error_message) + 1);
+ error_msg = alloca (strlen (error_message) + 1);
strcpy (error_msg, error_message);
- handling_signal = 0;
/* Inhibit redisplay while frames are being deleted. */
specbind (Qinhibit_redisplay, Qt);
{
/* 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_default_minibuffer_frame (FRAME_KBOARD (XFRAME (frame)), Qt);
delete_frame (frame, Qnoelisp);
}
(https://bugzilla.gnome.org/show_bug.cgi?id=85715). Once,
the resulting Glib error message loop filled a user's disk.
To avoid this, kill Emacs unconditionally on disconnect. */
- shut_down_emacs (0, 0, Qnil);
+ shut_down_emacs (0, Qnil);
fprintf (stderr, "%s\n\
When compiled with GTK, Emacs cannot recover from X disconnects.\n\
This is a GTK bug: https://bugzilla.gnome.org/show_bug.cgi?id=85715\n\
For details, see etc/PROBLEMS.\n",
error_msg);
- abort ();
+ emacs_abort ();
#endif /* USE_GTK */
/* Indicate that this display is dead. */
dpyinfo->terminal->reference_count--;
if (dpyinfo->reference_count != 0)
/* We have just closed all frames on this display. */
- abort ();
+ emacs_abort ();
{
Lisp_Object tmp;
/* NOTREACHED */
}
- /* Ordinary stack unwind doesn't deal with these. */
-#ifdef SIGIO
- sigunblock (sigmask (SIGIO));
-#endif
- sigunblock (sigmask (SIGALRM));
- TOTALLY_UNBLOCK_INPUT;
+ totally_unblock_input ();
unbind_to (idx, Qnil);
clear_waiting_for_input ();
if (FRAME_XIC (f)
&& (FRAME_XIC_STYLE (f) & (XIMPreeditPosition | XIMStatusArea)))
{
- BLOCK_INPUT;
+ block_input ();
xic_set_xfontset (f, SSDATA (fontset_ascii (fontset)));
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif
struct x_display_info *dpyinfo = (struct x_display_info *) client_data;
Lisp_Object frame, tail;
- BLOCK_INPUT;
+ block_input ();
/* No need to call XDestroyIC.. */
FOR_EACH_FRAME (tail, frame)
/* No need to call XCloseIM. */
dpyinfo->xim = NULL;
XFree (dpyinfo->xim_styles);
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* HAVE_X11R6 */
{
Lisp_Object tail, frame;
- BLOCK_INPUT;
+ block_input ();
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
}
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
if (use_xim)
{
#ifdef HAVE_X11R6_XIM
- struct xim_inst_t *xim_inst;
+ struct xim_inst_t *xim_inst = xmalloc (sizeof *xim_inst);
ptrdiff_t len;
- xim_inst = (struct xim_inst_t *) xmalloc (sizeof (struct xim_inst_t));
dpyinfo->xim_callback_data = xim_inst;
xim_inst->dpyinfo = dpyinfo;
len = strlen (resource_name);
- xim_inst->resource_name = (char *) xmalloc (len + 1);
+ xim_inst->resource_name = xmalloc (len + 1);
memcpy (xim_inst->resource_name, resource_name, len + 1);
XRegisterIMInstantiateCallback (dpyinfo->display, dpyinfo->xrdb,
resource_name, emacs_class,
}
x_calc_absolute_position (f);
- BLOCK_INPUT;
+ block_input ();
x_wm_set_size_hint (f, (long) 0, 0);
modified_left = f->left_pos;
&& FRAME_X_OUTPUT (f)->move_offset_top == 0))))
x_check_expected_move (f, modified_left, modified_top);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Return non-zero if _NET_SUPPORTING_WM_CHECK window exists and _NET_SUPPORTED
unsigned char *tmp_data = NULL;
Atom target_type = XA_WINDOW;
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
rc = XGetWindowProperty (dpy, target_window,
{
if (tmp_data) XFree (tmp_data);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
if (x_had_errors_p (dpy))
{
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
{
if (tmp_data) XFree (tmp_data);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
rc = dpyinfo->net_supported_atoms[i] == want_atom;
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return rc;
}
*sticky = 0;
*size_state = FULLSCREEN_NONE;
- BLOCK_INPUT;
+ block_input ();
x_catch_errors (dpy);
rc = XGetWindowProperty (dpy, window, dpyinfo->Xatom_net_wm_state,
0, max_len, False, target_type,
{
if (tmp_data) XFree (tmp_data);
x_uncatch_errors ();
- UNBLOCK_INPUT;
+ unblock_input ();
return ! f->iconified;
}
}
if (tmp_data) XFree (tmp_data);
- UNBLOCK_INPUT;
+ unblock_input ();
return ! is_hidden;
}
{
if (f->async_visible)
{
- BLOCK_INPUT;
+ block_input ();
x_check_fullscreen (f);
x_sync (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
/* Set timeout to 0.1 second. Hopefully not noticeable.
Maybe it should be configurable. */
- EMACS_SET_SECS_USECS (tmo, 0, 100000);
- EMACS_GET_TIME (tmo_at);
- EMACS_ADD_TIME (tmo_at, tmo_at, tmo);
+ tmo = make_emacs_time (0, 100 * 1000 * 1000);
+ tmo_at = add_emacs_time (current_emacs_time (), tmo);
while (pending_event_wait.eventtype)
{
- interrupt_input_pending = 1;
- TOTALLY_UNBLOCK_INPUT;
+ pending_signals = 1;
+ totally_unblock_input ();
/* XTread_socket is called after unblock. */
- BLOCK_INPUT;
+ block_input ();
interrupt_input_blocked = level;
FD_ZERO (&fds);
FD_SET (fd, &fds);
- EMACS_GET_TIME (time_now);
- EMACS_SUB_TIME (tmo, tmo_at, time_now);
+ time_now = current_emacs_time ();
+ if (EMACS_TIME_LT (tmo_at, time_now))
+ break;
- if (EMACS_TIME_NEG_P (tmo) || select (fd+1, &fds, NULL, NULL, &tmo) == 0)
+ tmo = sub_emacs_time (tmo_at, time_now);
+ if (pselect (fd + 1, &fds, NULL, NULL, &tmo, NULL) == 0)
break; /* Timeout */
}
pending_event_wait.f = 0;
void
x_set_window_size (struct frame *f, int change_gravity, int cols, int rows)
{
- BLOCK_INPUT;
+ block_input ();
if (NILP (tip_frame) || XFRAME (tip_frame) != f)
{
so don't try--just let the highlighting be done afresh with new size. */
cancel_mouse_face (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
/* Mouse warping. */
if (pix_y < 0) pix_y = 0;
if (pix_y > FRAME_PIXEL_HEIGHT (f)) pix_y = FRAME_PIXEL_HEIGHT (f);
- BLOCK_INPUT;
+ block_input ();
XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f),
0, 0, 0, 0, pix_x, pix_y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Move the mouse to position pixel PIX_X, PIX_Y relative to frame F. */
void
x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
{
- BLOCK_INPUT;
+ block_input ();
XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f),
0, 0, 0, 0, pix_x, pix_y);
- UNBLOCK_INPUT;
+ unblock_input ();
}
\f
/* Raise frame F. */
void
x_raise_frame (struct frame *f)
{
- BLOCK_INPUT;
+ block_input ();
if (f->async_visible)
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Lower frame F. */
{
if (f->async_visible)
{
- BLOCK_INPUT;
+ block_input ();
XLowerWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
}
}
retry:
- BLOCK_INPUT;
+ block_input ();
type = x_icon_type (f);
if (!NILP (type))
original_top = f->top_pos;
/* This must come after we set COUNT. */
- UNBLOCK_INPUT;
+ unblock_input ();
/* We unblock here so that arriving X events are processed. */
int x, y;
unsigned int width, height, border, depth;
- BLOCK_INPUT;
+ block_input ();
/* On some window managers (such as FVWM) moving an existing
window, even to the same place, causes the window manager
XMoveWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
original_left, original_top);
- UNBLOCK_INPUT;
+ unblock_input ();
}
XSETFRAME (frame, f);
if (FRAME_X_DISPLAY_INFO (f)->x_highlight_frame == f)
FRAME_X_DISPLAY_INFO (f)->x_highlight_frame = 0;
- BLOCK_INPUT;
+ block_input ();
/* Before unmapping the window, update the WM_SIZE_HINTS property to claim
that the current position of the window is user-specified, rather than
if (! XWithdrawWindow (FRAME_X_DISPLAY (f), window,
DefaultScreen (FRAME_X_DISPLAY (f))))
{
- UNBLOCK_INPUT_RESIGNAL;
+ unblock_input ();
error ("Can't notify window manager of window withdrawal");
}
}
x_sync (f);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Change window state from mapped to iconified. */
if (f->async_iconified)
return;
- BLOCK_INPUT;
+ block_input ();
FRAME_SAMPLE_VISIBILITY (f);
f->visible = 1;
f->async_iconified = 1;
f->async_visible = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
#endif
f->visible = 1;
f->async_iconified = 1;
f->async_visible = 0;
- UNBLOCK_INPUT;
+ unblock_input ();
return;
}
result = XIconifyWindow (FRAME_X_DISPLAY (f),
XtWindow (f->output_data.x->widget),
DefaultScreen (FRAME_X_DISPLAY (f)));
- UNBLOCK_INPUT;
+ unblock_input ();
if (!result)
error ("Can't notify window manager of iconification");
f->async_visible = 0;
- BLOCK_INPUT;
+ block_input ();
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
#else /* not USE_X_TOOLKIT */
/* Make sure the X server knows where the window should be positioned,
SubstructureRedirectMask | SubstructureNotifyMask,
&msg))
{
- UNBLOCK_INPUT_RESIGNAL;
+ unblock_input ();
error ("Can't notify window manager of iconification");
}
}
f->async_visible = 0;
XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
+ unblock_input ();
#endif /* not USE_X_TOOLKIT */
}
struct scroll_bar *b;
#endif
- BLOCK_INPUT;
+ block_input ();
/* If a display connection is dead, don't try sending more
commands to the X server. */
hlinfo->mouse_face_mouse_frame = 0;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Set the normal size hints for the window manager, for frame F.
FLAGS is the flags word to use--or 0 meaning preserve the flags
that the window now has.
- If USER_POSITION is nonzero, we set the USPosition
+ If USER_POSITION, set the USPosition
flag (this is useful when FLAGS is 0).
- The GTK version is in gtkutils.c */
+ The GTK version is in gtkutils.c. */
#ifndef USE_GTK
void
-x_wm_set_size_hint (struct frame *f, long flags, int user_position)
+x_wm_set_size_hint (struct frame *f, long flags, bool user_position)
{
XSizeHints size_hints;
Window window = FRAME_OUTER_WINDOW (f);
Fonts
***********************************************************************/
-#if GLYPH_DEBUG
+#ifdef GLYPH_DEBUG
/* Check that FONT is valid on frame F. It is if it can be found in F's
font table. */
static void
x_check_font (struct frame *f, struct font *font)
{
- xassert (font != NULL && ! NILP (font->props[FONT_TYPE_INDEX]));
+ eassert (font != NULL && ! NILP (font->props[FONT_TYPE_INDEX]));
if (font->driver->check)
- xassert (font->driver->check (f, font) == 0);
+ eassert (font->driver->check (f, font) == 0);
}
-#endif /* GLYPH_DEBUG != 0 */
+#endif /* GLYPH_DEBUG */
\f
/***********************************************************************
Mouse_HLInfo *hlinfo;
ptrdiff_t lim;
- BLOCK_INPUT;
+ block_input ();
if (!x_initialized)
{
Call before gtk_init so Gtk+ event filters comes after our. */
gdk_window_add_filter (NULL, event_handler_gdk, NULL);
+ /* gtk_init does set_locale. Fix locale before and after. */
+ fixup_locale ();
gtk_init (&argc, &argv2);
+ fixup_locale ();
+
g_log_remove_handler ("GLib", id);
- /* gtk_init does set_locale. We must fix locale after calling it. */
- fixup_locale ();
xg_initialize ();
dpy = DEFAULT_GDK_DISPLAY ();
const char *file = "~/.emacs.d/gtkrc";
Lisp_Object s, abs_file;
- s = make_string (file, strlen (file));
+ s = build_string (file);
abs_file = Fexpand_file_name (s, Qnil);
if (! NILP (abs_file) && !NILP (Ffile_readable_p (abs_file)))
/* Detect failure. */
if (dpy == 0)
{
- UNBLOCK_INPUT;
+ unblock_input ();
return 0;
}
/* We have definitely succeeded. Record the new connection. */
- dpyinfo = (struct x_display_info *) xmalloc (sizeof (struct x_display_info));
- memset (dpyinfo, 0, sizeof *dpyinfo);
+ dpyinfo = xzalloc (sizeof *dpyinfo);
hlinfo = &dpyinfo->mouse_highlight;
terminal = x_create_terminal (dpyinfo);
terminal->kboard = share->terminal->kboard;
else
{
- terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ terminal->kboard = xmalloc (sizeof *terminal->kboard);
init_kboard (terminal->kboard);
- KVAR (terminal->kboard, Vwindow_system) = Qx;
+ kset_window_system (terminal->kboard, Qx);
/* Add the keyboard to the list before running Lisp code (via
Qvendor_specific_keysyms below), since these are not traced
/* 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);
- BLOCK_INPUT;
+ unblock_input ();
+ kset_system_key_alist
+ (terminal->kboard,
+ call1 (Qvendor_specific_keysyms,
+ vendor ? build_string (vendor) : empty_unibyte_string));
+ block_input ();
terminal->next_terminal = terminal_list;
terminal_list = terminal;
UNGCPRO;
dpyinfo->display = dpy;
/* Set the name of the terminal. */
- terminal->name = (char *) xmalloc (SBYTES (display_name) + 1);
- strncpy (terminal->name, SSDATA (display_name), SBYTES (display_name));
+ terminal->name = xmalloc (SBYTES (display_name) + 1);
+ memcpy (terminal->name, SSDATA (display_name), SBYTES (display_name));
terminal->name[SBYTES (display_name)] = 0;
#if 0
lim = min (PTRDIFF_MAX, SIZE_MAX) - sizeof "@";
if (lim - SBYTES (Vinvocation_name) < SBYTES (Vsystem_name))
memory_full (SIZE_MAX);
- dpyinfo->x_id_name
- = (char *) xmalloc (SBYTES (Vinvocation_name)
- + SBYTES (Vsystem_name)
- + 2);
+ dpyinfo->x_id_name = xmalloc (SBYTES (Vinvocation_name)
+ + SBYTES (Vsystem_name) + 2);
strcat (strcat (strcpy (dpyinfo->x_id_name, SSDATA (Vinvocation_name)), "@"),
SSDATA (Vsystem_name));
const int atom_count = sizeof (atom_refs) / sizeof (atom_refs[0]);
/* 1 for _XSETTINGS_SN */
const int total_atom_count = 1 + atom_count;
- Atom *atoms_return = xmalloc (sizeof (Atom) * total_atom_count);
- char **atom_names = xmalloc (sizeof (char *) * total_atom_count);
- char xsettings_atom_name[64];
+ Atom *atoms_return = xmalloc (total_atom_count * sizeof *atoms_return);
+ char **atom_names = xmalloc (total_atom_count * sizeof *atom_names);
+ static char const xsettings_fmt[] = "_XSETTINGS_S%d";
+ char xsettings_atom_name[sizeof xsettings_fmt - 2
+ + INT_STRLEN_BOUND (int)];
for (i = 0; i < atom_count; i++)
atom_names[i] = (char *) atom_refs[i].name;
/* Build _XSETTINGS_SN atom name */
- snprintf (xsettings_atom_name, sizeof (xsettings_atom_name),
- "_XSETTINGS_S%d", XScreenNumberOfScreen (dpyinfo->screen));
+ sprintf (xsettings_atom_name, xsettings_fmt,
+ XScreenNumberOfScreen (dpyinfo->screen));
atom_names[i] = xsettings_atom_name;
XInternAtoms (dpyinfo->display, atom_names, total_atom_count,
dpyinfo->x_dnd_atoms_size = 8;
dpyinfo->x_dnd_atoms_length = 0;
- dpyinfo->x_dnd_atoms = xmalloc (sizeof (*dpyinfo->x_dnd_atoms)
+ dpyinfo->x_dnd_atoms = xmalloc (sizeof *dpyinfo->x_dnd_atoms
* dpyinfo->x_dnd_atoms_size);
dpyinfo->net_supported_atoms = NULL;
connection = ConnectionNumber (dpyinfo->display);
dpyinfo->connection = connection;
-
- {
- dpyinfo->gray
- = XCreatePixmapFromBitmapData (dpyinfo->display, dpyinfo->root_window,
- gray_bitmap_bits,
- gray_bitmap_width, gray_bitmap_height,
- 1, 0, 1);
- }
+ dpyinfo->gray
+ = XCreatePixmapFromBitmapData (dpyinfo->display, dpyinfo->root_window,
+ gray_bits, gray_width, gray_height,
+ 1, 0, 1);
#ifdef HAVE_X_I18N
xim_initialize (dpyinfo, resource_name);
fcntl (connection, F_SETOWN, getpid ());
#endif /* ! defined (F_SETOWN) */
-#ifdef SIGIO
if (interrupt_input)
init_sigio (connection);
-#endif /* ! defined (SIGIO) */
#ifdef USE_LUCID
{
to.addr = (XPointer)&font;
x_catch_errors (dpy);
if (!XtCallConverter (dpy, XtCvtStringToFont, &d, 1, &fr, &to, NULL))
- abort ();
+ emacs_abort ();
if (x_had_errors_p (dpy) || !XQueryFont (dpy, font))
XrmPutLineResource (&xrdb, "Emacs.dialog.*.font: 9x15");
x_uncatch_errors ();
x_session_initialize (dpyinfo);
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
return dpyinfo;
}
static void
x_process_timeouts (struct atimer *timer)
{
- BLOCK_INPUT;
+ block_input ();
x_timeout_atimer_activated_flag = 0;
if (toolkit_scroll_bar_interaction || popup_activated ())
{
/* Reactivate the atimer for next time. */
x_activate_timeout_atimer ();
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Install an asynchronous timer that processes Xt timeout events
void
x_activate_timeout_atimer (void)
{
- BLOCK_INPUT;
+ block_input ();
if (!x_timeout_atimer_activated_flag)
{
- EMACS_TIME interval;
-
- EMACS_SET_SECS_USECS (interval, 0, 100000);
+ EMACS_TIME interval = make_emacs_time (0, 100 * 1000 * 1000);
start_atimer (ATIMER_RELATIVE, interval, x_process_timeouts, 0);
x_timeout_atimer_activated_flag = 1;
}
- UNBLOCK_INPUT;
+ unblock_input ();
}
#endif /* USE_X_TOOLKIT */
\f
/* Set up use of X before we make the first connection. */
-extern frame_parm_handler x_frame_parm_handlers[];
-
static struct redisplay_interface x_redisplay_interface =
{
x_frame_parm_handlers,
if (!terminal->name)
return;
- BLOCK_INPUT;
+ block_input ();
#ifdef HAVE_X_I18N
/* We must close our connection to the XIM server before closing the
X display. */
/* Mark as dead. */
dpyinfo->display = NULL;
x_delete_display (dpyinfo);
- UNBLOCK_INPUT;
+ unblock_input ();
}
/* Create a struct terminal, initialize it with the X11 specific
original error handler. */
XSetErrorHandler (x_error_handler);
XSetIOErrorHandler (x_io_error_quitter);
-
- signal (SIGPIPE, x_connection_signal);
-
- xgselect_initialize ();
}
last_mouse_press_frame = Qnil;
#ifdef USE_GTK
- xg_default_icon_file = make_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg");
+ xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg");
staticpro (&xg_default_icon_file);
DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock");
DEFVAR_BOOL ("x-use-underline-position-properties",
x_use_underline_position_properties,
- doc: /* *Non-nil means make use of UNDERLINE_POSITION font properties.
+ doc: /* Non-nil means make use of UNDERLINE_POSITION font properties.
A value of nil means ignore them. If you encounter fonts with bogus
UNDERLINE_POSITION font properties, for example 7x13 on XFree prior
to 4.1, set this to nil. You can also use `underline-minimum-offset'
DEFVAR_BOOL ("x-underline-at-descent-line",
x_underline_at_descent_line,
- doc: /* *Non-nil means to draw the underline at the same place as the descent line.
+ doc: /* Non-nil means to draw the underline at the same place as the descent line.
A value of nil means to draw the underline according to the value of the
variable `x-use-underline-position-properties', which is usually at the
baseline level. The default value is nil. */);
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+#ifndef XTERM_H
+#define XTERM_H
+
#include <X11/Xlib.h>
#include <X11/cursorfont.h>
extern void check_x (void);
extern struct frame *x_window_to_frame (struct x_display_info *, int);
-
extern struct frame *x_any_window_to_frame (struct x_display_info *, int);
extern struct frame *x_menubar_window_to_frame (struct x_display_info *,
XEvent *);
-
extern struct frame *x_top_window_to_frame (struct x_display_info *, int);
+extern struct frame *x_menubar_window_to_frame (struct x_display_info *,
+ XEvent *);
+
#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
#define x_any_window_to_frame x_window_to_frame
#define x_top_window_to_frame x_window_to_frame
extern Lisp_Object x_display_name_list;
extern struct x_display_info *x_display_info_for_display (Display *);
-extern void x_set_frame_alpha (struct frame *);
extern struct x_display_info *x_term_init (Lisp_Object, char *, char *);
extern int x_display_ok (const char *);
/* Non-zero means hourglass cursor is currently displayed. */
unsigned hourglass_p : 1;
- /* Flag to set when the X window needs to be completely repainted. */
- int needs_exposure;
-
/* These are the current window manager hints. It seems that
XSetWMHints, when presented with an unset bit in the `flags'
member of the hints structure, does not leave the corresponding
/* This is the Colormap which frame F uses. */
#define FRAME_X_COLORMAP(f) FRAME_X_DISPLAY_INFO (f)->cmap
-/* This is the 'font_info *' which frame F has. */
-#define FRAME_X_FONT_TABLE(f) (FRAME_X_DISPLAY_INFO (f)->font_table)
-
/* The difference in pixels between the top left corner of the
Emacs window (including possible window manager decorations)
and FRAME_X_WINDOW (f). */
struct scroll_bar
{
/* These fields are shared by all vectors. */
- EMACS_INT size_from_Lisp_Vector_struct;
- struct Lisp_Vector *next_from_Lisp_Vector_struct;
+ struct vectorlike_header header;
/* The window we're a scroll bar for. */
Lisp_Object window;
unsigned int fringe_extended_p : 1;
};
-/* The number of elements a vector holding a struct scroll_bar needs. */
-#define SCROLL_BAR_VEC_SIZE \
- ((sizeof (struct scroll_bar) \
- - sizeof (EMACS_INT) - sizeof (struct Lisp_Vector *)) \
- / sizeof (Lisp_Object))
-
/* Turning a lisp vector value into a pointer to a struct scroll_bar. */
#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec))
/* From xfns.c. */
struct frame *check_x_frame (Lisp_Object);
-EXFUN (Fx_display_grayscale_p, 1);
extern void x_free_gcs (struct frame *);
-extern int gray_bitmap_width, gray_bitmap_height;
-extern char *gray_bitmap_bits;
/* From xrdb.c. */
/* Defined in xterm.c */
extern int x_text_icon (struct frame *, const char *);
-extern int x_bitmap_icon (struct frame *, Lisp_Object);
extern void x_catch_errors (Display *);
extern void x_check_errors (Display *, const char *)
ATTRIBUTE_FORMAT_PRINTF (2, 0);
extern void x_set_mouse_pixel_position (struct frame *, int, int);
extern void xembed_request_focus (struct frame *);
extern void x_ewmh_activate_frame (struct frame *);
-extern void x_make_frame_visible (struct frame *);
-extern void x_make_frame_invisible (struct frame *);
-extern void x_iconify_frame (struct frame *);
-extern void x_free_frame_resources (struct frame *);
-extern void x_wm_set_size_hint (struct frame *, long, int);
extern void x_delete_terminal (struct terminal *terminal);
extern unsigned long x_copy_color (struct frame *, unsigned long);
#ifdef USE_X_TOOLKIT
extern void x_activate_timeout_atimer (void);
#endif
#ifdef USE_LUCID
-extern int x_alloc_lighter_color_for_widget (Widget, Display *, Colormap,
- unsigned long *,
- double, int);
+extern bool x_alloc_lighter_color_for_widget (Widget, Display *, Colormap,
+ unsigned long *,
+ double, int);
#endif
-extern int x_alloc_nearest_color (struct frame *, Colormap, XColor *);
-extern void x_query_colors (struct frame *f, XColor *, int);
+extern bool x_alloc_nearest_color (struct frame *, Colormap, XColor *);
extern void x_query_color (struct frame *f, XColor *);
extern void x_clear_area (Display *, Window, int, int, int, int, int);
#if defined HAVE_MENUS && !defined USE_X_TOOLKIT && !defined USE_GTK
#ifdef USE_X_TOOLKIT
extern int x_dispatch_event (XEvent *, Display *);
#endif
-extern EMACS_INT x_x_to_emacs_modifiers (struct x_display_info *, int);
+extern int x_x_to_emacs_modifiers (struct x_display_info *, int);
extern int x_display_pixel_height (struct x_display_info *);
extern int x_display_pixel_width (struct x_display_info *);
extern struct x_display_info * check_x_display_info (Lisp_Object);
extern Lisp_Object x_get_focus_frame (struct frame *);
+extern int x_in_use;
#ifdef USE_GTK
extern int xg_set_icon (struct frame *, Lisp_Object);
extern int xg_set_icon_from_xpm_data (struct frame *, const char**);
#endif /* USE_GTK */
-extern void x_real_positions (struct frame *, int *, int *);
-extern void x_set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
extern void x_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
extern void xic_free_xfontset (struct frame *);
extern void create_frame_xic (struct frame *);
extern void xic_set_xfontset (struct frame *, const char *);
extern int x_pixel_width (struct frame *);
extern int x_pixel_height (struct frame *);
-extern int x_char_width (struct frame *);
-extern int x_char_height (struct frame *);
-extern void x_sync (struct frame *);
-extern int x_defined_color (struct frame *, const char *, XColor *, int);
+extern bool x_defined_color (struct frame *, const char *, XColor *, bool);
#ifdef HAVE_X_I18N
extern void free_frame_xic (struct frame *);
# if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
extern char * xic_create_fontsetname (const char *base_fontname, int motif);
# endif
#endif
-extern void x_set_tool_bar_lines (struct frame *, Lisp_Object, Lisp_Object);
/* Defined in xfaces.c */
#ifdef USE_MOTIF
extern void x_menu_wait_for_event (void *data);
#endif
-extern void x_activate_menubar (struct frame *);
extern int popup_activated (void);
extern void initialize_frame_menubar (struct frame *);
-extern void free_frame_menubar (struct frame *);
/* Defined in widget.c */
(nr).y = (ry), \
(nr).width = (rwidth), \
(nr).height = (rheight))
+
+#endif /* XTERM_H */
-2012-08-24 Chong Yidong <cyd@gnu.org>
+2012-09-08 Dmitry Gutov <dgutov@yandex.ru>
- * Version 24.2 released.
+ * automated/ruby-mode-tests.el:
+ (ruby-toggle-block-to-multiline): New test.
+ (ruby-should-indent-buffer, ruby-toggle-block-to-do-end)
+ (ruby-toggle-block-to-brace): Use buffer-string.
-2012-08-14 Chong Yidong <cyd@gnu.org>
+2012-09-07 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el: New tests (Bug#11613).
+
+2012-08-28 Chong Yidong <cyd@gnu.org>
* automated/files.el: Test every combination of values for
enable-local-variables and enable-local-eval.
-2012-08-10 Glenn Morris <rgm@gnu.org>
+2012-08-19 Chong Yidong <cyd@gnu.org>
- * automated/files.el (files-test-disable-local-variables): New test.
+ * redisplay-testsuite.el (test-redisplay): Use switch-to-buffer.
-2012-08-08 Glenn Morris <rgm@gnu.org>
+2012-08-18 Chong Yidong <cyd@gnu.org>
- * automated/files.el: New file.
+ * redisplay-testsuite.el (test-redisplay-4): New test (Bug#3874).
+
+2012-08-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * indent/ruby.rb: Rearrange examples, add new ones.
+
+2012-08-12 Dmitry Gutov <dgutov@yandex.ru>
-2012-08-07 Glenn Morris <rgm@gnu.org>
+ * 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 <rgm@gnu.org>
+
+ * automated/files.el: New file.
* automated/Makefile.in (all): Fix typo.
-2012-06-01 Chong Yidong <cyd@gnu.org>
+2012-08-10 Dmitry Gutov <dgutov@yandex.ru>
+
+ * 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 <nobu@ruby-lang.org>
+
+ Original tests in test_ruby_mode.rb in upstream (author).
+
+2012-08-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el (ruby-should-indent)
+ (ruby-assert-state): New functions.
+ Add new tests.
+
+2012-07-29 David Engster <deng@randomsample.de>
+
+ * 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 <juri@jurta.org>
+
+ * automated/occur-tests.el (occur-test-case): Use predefined
+ buffer name " *test-occur*" instead of a random buffer name.
+
+2012-07-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/ruby-mode-tests.el: New file with one test.
+
+2012-07-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * indent/shell.sh: Add test case for ${#VAR}.
+
+ * indent/latex-mode.tex: New file.
+
+2012-07-11 Stefan Monnier <monnier@iro.umontreal.ca>
- * Version 24.1 released.
+ * eshell.el: Use cl-lib.
+
+2012-07-03 Chong Yidong <cyd@gnu.org>
+
+ * automated/xml-parse-tests.el (xml-parse-tests--bad-data): New.
+
+2012-07-02 Chong Yidong <cyd@gnu.org>
+
+ * automated/xml-parse-tests.el (xml-parse-tests--data):
+ More testcases.
+
+2012-07-01 Chong Yidong <cyd@gnu.org>
+
+ * automated/xml-parse-tests.el: New file.
+
+2012-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/ert-x-tests.el (ert-test-run-tests-interactively-2):
+ Use cl-flet.
+
+2012-06-08 Ulf Jasper <ulf.jasper@web.de>
+
+ * automated/icalendar-tests.el (icalendar--parse-vtimezone):
+ Test escaped commas in TZID (Bug#11473).
+ (icalendar-import-with-timezone): New.
+ (icalendar-real-world): Add new testcase as given in the bugreport
+ of Bug#11473.
+
+2012-05-29 Ulf Jasper <ulf.jasper@web.de>
+
+ * automated/icalendar-tests.el (icalendar-tests--test-import):
+ Include UID in import tests (Bug#11525).
+ (icalendar-import-non-recurring, icalendar-import-rrule)
+ (icalendar-import-duration, icalendar-import-bug-6766): Adjust to
+ UID-import change.
+ (icalendar-import-with-uid): New.
+ (icalendar-tests--test-cycle, icalendar-tests--do-test-cycle):
+ Include UID in cycle tests.
+ (icalendar-cycle, icalendar-real-world): UID-import change.
+
+2012-05-21 Glenn Morris <rgm@gnu.org>
+
+ * automated/Makefile.in (setwins): Scrap superfluous subshell.
+
+2012-05-15 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * automated/url-util-tests.el: New file to test
+ lisp/url/url-util.el. Only `url-build-query-string' and
+ `url-parse-query-string' are tested right now (Bug#8706).
+
+2012-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * indent/shell.sh:
+ * indent/shell.rc: Ad some test cases.
+
+2012-04-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * indent/ruby.rb: New file, to test new syntax-propertize code.
+
+2012-04-11 Glenn Morris <rgm@gnu.org>
+
+ * automated/vc-bzr.el (vc-bzr-test-faulty-bzr-autoloads): New test.
2012-02-13 Teodor Zlatanov <tzz@lifelogs.com>
2009-12-18 Ulf Jasper <ulf.jasper@web.de>
* icalendar-testsuite.el
- (icalendar-testsuite--run-function-tests): Add
- icalendar-testsuite--test-parse-vtimezone.
+ (icalendar-testsuite--run-function-tests):
+ Add icalendar-testsuite--test-parse-vtimezone.
(icalendar-testsuite--test-parse-vtimezone): New.
(icalendar-testsuite--do-test-cycle): Doc changes.
(icalendar-testsuite--run-real-world-tests): Remove trailing
2008-10-31 Ulf Jasper <ulf.jasper@web.de>
* icalendar-testsuite.el (icalendar-testsuite--run-function-tests):
- Added `icalendar-testsuite--test-create-uid'.
+ Add `icalendar-testsuite--test-create-uid'.
(icalendar-testsuite--test-create-uid): New.
2008-06-14 Ulf Jasper <ulf.jasper@web.de>
emacs = EMACSLOADPATH=$(lispsrc):$(test) LC_ALL=C $(EMACS) $(EMACSOPT)
# Common command to find subdirectories
-setwins=subdirs=`(find . -type d -print)`; \
+setwins=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* ) ;; \
*) wins="$$wins $$file" ;; \
;; maven
("FooBar.java:[111,53] no interface expected here"
1 53 111 "FooBar.java")
+ (" [ERROR] /Users/cinsk/hello.java:[651,96] ';' expected"
+ 15 96 651 "/Users/cinsk/hello.java") ;Bug#11517.
;; mips-1 mips-2
("TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation"
11 nil 255 "solomon.c")
(ert-deftest ert-test-run-tests-interactively-2 ()
:tags '(:causes-redisplay)
- (let ((passing-test (make-ert-test :name 'passing-test
- :body (lambda () (ert-pass))))
- (failing-test (make-ert-test :name 'failing-test
- :body (lambda ()
- (ert-info ((propertize "foo\nbar"
- 'a 'b))
- (ert-fail
- "failure message"))))))
- (let ((ert-debug-on-error nil))
- (let* ((buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
- (messages nil)
- (mock-message-fn
- (lambda (format-string &rest args)
- (push (apply #'format format-string args) messages))))
- (flet ((expected-string (with-font-lock-p)
- (ert-propertized-string
-
"Selector: (member <passing-test> <failing-test>)\n"
- "Passed: 1\n"
- "Failed: 1 (1 unexpected)\n"
- "Total: 2/2\n\n"
- "Started at:\n"
- "Finished.\n"
- "Finished at:\n\n"
- `(category ,(button-category-symbol
- 'ert--results-progress-bar-button)
- button (t)
- face ,(if with-font-lock-p
- 'ert-test-result-unexpected
- 'button))
- ".F" nil "\n\n"
- `(category ,(button-category-symbol
- 'ert--results-expand-collapse-button)
- button (t)
- face ,(if with-font-lock-p
- 'ert-test-result-unexpected
- 'button))
- "F" nil " "
- `(category ,(button-category-symbol
- 'ert--test-name-button)
- button (t)
- ert-test-name failing-test)
- "failing-test"
- nil "\n Info: " '(a b) "foo\n"
- nil " " '(a b) "bar"
- nil "\n (ert-test-failed \"failure message\")\n\n\n"
- )))
- (save-window-excursion
- (unwind-protect
- (let ((case-fold-search nil))
- (ert-run-tests-interactively
- `(member ,passing-test ,failing-test) buffer-name
- mock-message-fn)
- (should (equal messages `(,(concat
- "Ran 2 tests, 1 results were "
- "as expected, 1 unexpected"))))
- (with-current-buffer buffer-name
- (font-lock-mode 0)
- (should (ert-equal-including-properties
- (ert-filter-string (buffer-string)
- '("Started at:\\(.*\\)$" 1)
- '("Finished at:\\(.*\\)$" 1))
- (expected-string nil)))
- ;; `font-lock-mode' only works if interactive, so
- ;; pretend we are.
- (let ((noninteractive nil))
- (font-lock-mode 1))
- (should (ert-equal-including-properties
- (ert-filter-string (buffer-string)
- '("Started at:\\(.*\\)$" 1)
- '("Finished at:\\(.*\\)$" 1))
- (expected-string t)))))
- (when (get-buffer buffer-name)
- (kill-buffer buffer-name)))))))))
+ (let* ((passing-test (make-ert-test :name 'passing-test
+ :body (lambda () (ert-pass))))
+ (failing-test (make-ert-test :name 'failing-test
+ :body (lambda ()
+ (ert-info ((propertize "foo\nbar"
+ 'a 'b))
+ (ert-fail
+ "failure message")))))
+ (ert-debug-on-error nil)
+ (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
+ (messages nil)
+ (mock-message-fn
+ (lambda (format-string &rest args)
+ (push (apply #'format format-string args) messages))))
+ (cl-flet ((expected-string (with-font-lock-p)
+ (ert-propertized-string
+ "Selector: (member <passing-test> <failing-test>)\n"
+ "Passed: 1\n"
+ "Failed: 1 (1 unexpected)\n"
+ "Total: 2/2\n\n"
+ "Started at:\n"
+ "Finished.\n"
+ "Finished at:\n\n"
+ `(category ,(button-category-symbol
+ 'ert--results-progress-bar-button)
+ button (t)
+ face ,(if with-font-lock-p
+ 'ert-test-result-unexpected
+ 'button))
+ ".F" nil "\n\n"
+ `(category ,(button-category-symbol
+ 'ert--results-expand-collapse-button)
+ button (t)
+ face ,(if with-font-lock-p
+ 'ert-test-result-unexpected
+ 'button))
+ "F" nil " "
+ `(category ,(button-category-symbol
+ 'ert--test-name-button)
+ button (t)
+ ert-test-name failing-test)
+ "failing-test"
+ nil "\n Info: " '(a b) "foo\n"
+ nil " " '(a b) "bar"
+ nil "\n (ert-test-failed \"failure message\")\n\n\n"
+ )))
+ (save-window-excursion
+ (unwind-protect
+ (let ((case-fold-search nil))
+ (ert-run-tests-interactively
+ `(member ,passing-test ,failing-test) buffer-name
+ mock-message-fn)
+ (should (equal messages `(,(concat
+ "Ran 2 tests, 1 results were "
+ "as expected, 1 unexpected"))))
+ (with-current-buffer buffer-name
+ (font-lock-mode 0)
+ (should (ert-equal-including-properties
+ (ert-filter-string (buffer-string)
+ '("Started at:\\(.*\\)$" 1)
+ '("Finished at:\\(.*\\)$" 1))
+ (expected-string nil)))
+ ;; `font-lock-mode' only works if interactive, so
+ ;; pretend we are.
+ (let ((noninteractive nil))
+ (font-lock-mode 1))
+ (should (ert-equal-including-properties
+ (ert-filter-string (buffer-string)
+ '("Started at:\\(.*\\)$" 1)
+ '("Finished at:\\(.*\\)$" 1))
+ (expected-string t)))))
+ (when (get-buffer buffer-name)
+ (kill-buffer buffer-name)))))))
(ert-deftest ert-test-describe-test ()
"Tests `ert-describe-test'."
(should (string= "STD-02:00DST-03:00,M3.5.0/03:00:00,M10.5.0/04:00:00"
(cdr result)))
(setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE
-TZID:anothername
+TZID:anothername\, with a comma
BEGIN:STANDARD
DTSTART:16010101T040000
TZOFFSETFROM:+0300
END:VTIMEZONE
"))
(setq result (icalendar--parse-vtimezone vtimezone))
- (should (string= "anothername" (car result)))
+ (should (string= "anothername, with a comma" (car result)))
(message (cdr result))
(should (string= "STD-02:00DST-03:00,M3.2.1/03:00:00,M10.2.1/04:00:00"
(cdr result)))))
(unless (eq (char-before) ?\n)
(insert "\n"))
(insert "END:VEVENT\nEND:VCALENDAR\n"))
- (let ((icalendar-import-format "%s%d%l%o%t%u%c")
+ (let ((icalendar-import-format "%s%d%l%o%t%u%c%U")
(icalendar-import-format-summary "%s")
(icalendar-import-format-location "\n Location: %s")
(icalendar-import-format-description "\n Desc: %s")
(icalendar-import-format-status "\n Status: %s")
(icalendar-import-format-url "\n URL: %s")
(icalendar-import-format-class "\n Class: %s")
+ (icalendar-import-format-uid "\n UID: %s")
calendar-date-style)
(when expected-iso
(setq calendar-date-style 'iso)
"&%%(and (diary-block 2004 7 19 2004 8 27)) Sommerferien
Status: TENTATIVE
Class: PRIVATE
+ UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61
"
"&%%(and (diary-block 19 7 2004 27 8 2004)) Sommerferien
Status: TENTATIVE
Class: PRIVATE
+ UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61
"
"&%%(and (diary-block 7 19 2004 8 27 2004)) Sommerferien
Status: TENTATIVE
Class: PRIVATE
+ UID: 748f2da0-0d9b-11d8-97af-b4ec8686ea61
")
(icalendar-tests--test-import
"UID
"
"&2004/11/23 14:00-14:30 folded summary
Status: TENTATIVE
- Class: PRIVATE\n"
+ Class: PRIVATE
+ UID: 04979712-3902-11d9-93dd-8f9f4afe08da\n"
"&23/11/2004 14:00-14:30 folded summary
Status: TENTATIVE
- Class: PRIVATE\n"
+ Class: PRIVATE
+ UID: 04979712-3902-11d9-93dd-8f9f4afe08da\n"
"&11/23/2004 14:00-14:30 folded summary
Status: TENTATIVE
- Class: PRIVATE\n")
+ Class: PRIVATE
+ UID: 04979712-3902-11d9-93dd-8f9f4afe08da\n")
(icalendar-tests--test-import
"UID
"
"&2004/11/23 14:45-15:45 another example
Status: TENTATIVE
- Class: PRIVATE\n"
+ Class: PRIVATE
+ UID: 6161a312-3902-11d9-b512-f764153bb28b\n"
"&23/11/2004 14:45-15:45 another example
Status: TENTATIVE
- Class: PRIVATE\n"
+ Class: PRIVATE
+ UID: 6161a312-3902-11d9-b512-f764153bb28b\n"
"&11/23/2004 14:45-15:45 another example
Status: TENTATIVE
- Class: PRIVATE\n"))
+ Class: PRIVATE
+ UID: 6161a312-3902-11d9-b512-f764153bb28b\n"))
(ert-deftest icalendar-import-rrule ()
(icalendar-tests--test-import
"DTSTART;VALUE=DATE:20040815
DTEND;VALUE=DATE:20040816
SUMMARY:Maria Himmelfahrt
-UID:CC56BEA6-49D2-11D8-8833-00039386D1C2-RID
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=8
"
"&%%(and (diary-anniversary 2004 8 15)) Maria Himmelfahrt\n"
CREATED:20041127T183329
"
"&%%(and (diary-cyclic 1 2001 12 21) (diary-block 2001 12 21 2001 12 29)) Urlaub
- Class: PUBLIC\n"
+ Class: PUBLIC
+ UID: 20041127T183329Z-18215-1001-4536-49109@andromeda\n"
"&%%(and (diary-cyclic 1 21 12 2001) (diary-block 21 12 2001 29 12 2001)) Urlaub
- Class: PUBLIC\n"
+ Class: PUBLIC
+ UID: 20041127T183329Z-18215-1001-4536-49109@andromeda\n"
"&%%(and (diary-cyclic 1 12 21 2001) (diary-block 12 21 2001 12 29 2001)) Urlaub
- Class: PUBLIC\n"))
+ Class: PUBLIC
+ UID: 20041127T183329Z-18215-1001-4536-49109@andromeda\n"))
(ert-deftest icalendar-import-bug-6766 ()
;;bug#6766 -- multiple byday values in a weekly rrule
"&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 2010 4 21)) 11:30-12:00 Scrum
Status: CONFIRMED
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1262
&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 2010 4 22)) Tues + Thurs thinking
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1263
"
"&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 21 4 2010)) 11:30-12:00 Scrum
Status: CONFIRMED
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1262
&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 22 4 2010)) Tues + Thurs thinking
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1263
"
"&%%(and (memq (calendar-day-of-week date) '(1 3 4 5)) (diary-cyclic 1 4 21 2010)) 11:30-12:00 Scrum
Status: CONFIRMED
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1262
&%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 4 22 2010)) Tues + Thurs thinking
Class: PUBLIC
+ UID: 8814e3f9-7482-408f-996c-3bfe486a1263
"))
(ert-deftest icalendar-import-multiple-vcalendars ()
"&23/7/2011 event-1\n&24/7/2011 event-2\n&25/7/2011 event-3a\n&25/7/2011 event-3b\n"
"&7/23/2011 event-1\n&7/24/2011 event-2\n&7/25/2011 event-3a\n&7/25/2011 event-3b\n"))
+(ert-deftest icalendar-import-with-uid ()
+ "Perform import test with uid."
+ (icalendar-tests--test-import
+ "UID:1234567890uid
+SUMMARY:non-recurring
+DTSTART;VALUE=DATE-TIME:20030919T090000
+DTEND;VALUE=DATE-TIME:20030919T113000"
+ "&2003/9/19 09:00-11:30 non-recurring\n UID: 1234567890uid\n"
+ "&19/9/2003 09:00-11:30 non-recurring\n UID: 1234567890uid\n"
+ "&9/19/2003 09:00-11:30 non-recurring\n UID: 1234567890uid\n"))
+
+(ert-deftest icalendar-import-with-timezone ()
+ ;; bug#11473
+ (icalendar-tests--test-import
+ "BEGIN:VCALENDAR
+BEGIN:VTIMEZONE
+TZID:fictional\, nonexistent\, arbitrary
+BEGIN:STANDARD
+DTSTART:20100101T000000
+TZOFFSETFROM:+0200
+TZOFFSETTO:-0200
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=01
+END:STANDARD
+BEGIN:DAYLIGHT
+DTSTART:20101201T000000
+TZOFFSETFROM:-0200
+TZOFFSETTO:+0200
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=1SU;BYMONTH=11
+END:DAYLIGHT
+END:VTIMEZONE
+BEGIN:VEVENT
+SUMMARY:standardtime
+DTSTART;TZID=\"fictional, nonexistent, arbitrary\":20120115T120000
+DTEND;TZID=\"fictional, nonexistent, arbitrary\":20120115T123000
+END:VEVENT
+BEGIN:VEVENT
+SUMMARY:daylightsavingtime
+DTSTART;TZID=\"fictional, nonexistent, arbitrary\":20121215T120000
+DTEND;TZID=\"fictional, nonexistent, arbitrary\":20121215T123000
+END:VEVENT
+END:VCALENDAR"
+ ;; "standardtime" begins first sunday in january and is 4 hours behind CET
+ ;; "daylightsavingtime" begins first sunday in november and is 1 hour before CET
+ "&2012/1/15 15:00-15:30 standardtime
+&2012/12/15 11:00-11:30 daylightsavingtime
+"
+ nil
+ nil)
+ )
;; ======================================================================
;; Cycle
;; ======================================================================
(unless (eq (char-before) ?\n)
(insert "\n"))
(insert "END:VEVENT\nEND:VCALENDAR\n"))
- (let ((icalendar-import-format "%s%d%l%o%t%u%c")
+ (let ((icalendar-import-format "%s%d%l%o%t%u%c%U")
(icalendar-import-format-summary "%s")
(icalendar-import-format-location "\n Location: %s")
(icalendar-import-format-description "\n Desc: %s")
(icalendar-import-format-organizer "\n Organizer: %s")
(icalendar-import-format-status "\n Status: %s")
(icalendar-import-format-url "\n URL: %s")
- (icalendar-import-format-class "\n Class: %s"))
+ (icalendar-import-format-class "\n Class: %s")
+ (icalendar-import-format-class "\n UID: %s"))
(dolist (calendar-date-style '(iso european american))
(icalendar-tests--do-test-cycle)))))
(save-excursion
(find-file temp-ics)
(goto-char (point-min))
- (when (re-search-forward "\nUID:.*\n" nil t)
- (replace-match "\n"))
+ ;;(when (re-search-forward "\nUID:.*\n" nil t)
+ ;;(replace-match "\n"))
(let ((cycled (buffer-substring-no-properties (point-min) (point-max))))
(should (string= org-input cycled)))))
;; clean up
(delete-file temp-ics))))
(ert-deftest icalendar-cycle ()
- "Perform cycling tests."
+ "Perform cycling tests.
+Take care to avoid auto-generated UIDs here."
(icalendar-tests--test-cycle
- "DTSTART;VALUE=DATE-TIME:20030919T090000
+ "UID:dummyuid
+DTSTART;VALUE=DATE-TIME:20030919T090000
DTEND;VALUE=DATE-TIME:20030919T113000
SUMMARY:Cycletest
")
(icalendar-tests--test-cycle
- "DTSTART;VALUE=DATE-TIME:20030919T090000
+ "UID:blah
+DTSTART;VALUE=DATE-TIME:20030919T090000
DTEND;VALUE=DATE-TIME:20030919T113000
SUMMARY:Cycletest
DESCRIPTION:beschreibung!
ORGANIZER:ulf
")
(icalendar-tests--test-cycle
- "DTSTART;VALUE=DATE:19190909
+ "UID:4711
+DTSTART;VALUE=DATE:19190909
DTEND;VALUE=DATE:19190910
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=09
SUMMARY:and diary-anniversary
Location: Cccc
Organizer: MAILTO:aaaaaaa@aaaaaaa.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000010000000DB823520692542408ED02D7023F9DFF9
"
"&5/9/2003 10:30-15:30 On-Site Interview
Desc: 10:30am - Blah
Location: Cccc
Organizer: MAILTO:aaaaaaa@aaaaaaa.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E0080000000080B6DE661216C301000000000000000010000000DB823520692542408ED02D7023F9DFF9
")
;; 2003-06-18 a
Location: 555 or TN 555-5555 ID 5555 & NochWas (see below)
Organizer: MAILTO:xxx@xxxxx.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E
"
"&6/23/2003 11:00-12:00 Dress Rehearsal for XXXX-XXXX
Desc: 753 Zeichen hier radiert
Location: 555 or TN 555-5555 ID 5555 & NochWas (see below)
Organizer: MAILTO:xxx@xxxxx.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E
")
;; 2003-06-18 b -- uses timezone
(icalendar-tests--test-import
Location: 123 or TN 123-1234 ID abcd & SonstWo (see below)
Organizer: MAILTO:bbb@bbbbb.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E
"
"&6/23/2003 17:00-18:00 Updated: Dress Rehearsal for ABC01-15
Desc: Viele Zeichen standen hier früher
Location: 123 or TN 123-1234 ID abcd & SonstWo (see below)
Organizer: MAILTO:bbb@bbbbb.com
Status: CONFIRMED
+ UID: 040000008200E00074C5B7101A82E00800000000608AA7DA9835C3010000000000000000100000007C3A6D65EE726E40B7F3D69A23BD567E
")
;; export 2004-10-28 block entries
(icalendar-tests--test-export
PRODID
:-//Mozilla.org/NONSGML Mozilla Calendar V1.0//EN
BEGIN:VEVENT
-UID
- :04979712-3902-11d9-93dd-8f9f4afe08da
SUMMARY
:Jjjjj & Wwwww
STATUS
:20041118T013640Z
END:VEVENT
BEGIN:VEVENT
-UID
- :6161a312-3902-11d9-b512-f764153bb28b
SUMMARY
:BB Aaaaaaaa Bbbbb
STATUS
:20041118T013641Z
END:VEVENT
BEGIN:VEVENT
-UID
- :943a4d7e-3902-11d9-9ce7-c9addeadf928
SUMMARY
:Hhhhhhhh
STATUS
:20041118T013831Z
END:VEVENT
BEGIN:VEVENT
-UID
- :fe53615e-3902-11d9-9dd8-9d38a155bf41
SUMMARY
:MMM Aaaaaaaaa
STATUS
:20041118T014117Z
END:VEVENT
BEGIN:VEVENT
-UID
- :87c928ee-3901-11d9-b21f-b45042155024
SUMMARY
:Rrrr/Cccccc ii Aaaaaaaa
DESCRIPTION
:20041118T014203Z
END:VEVENT
BEGIN:VEVENT
-UID
- :e8f331ae-3902-11d9-9948-dfdcb66a2872
SUMMARY
:Wwww aa hhhh
STATUS
Desc: abcdef
Status: CONFIRMED
Class: PRIVATE
+ UID: b60d398e-1dd1-11b2-a159-cf8cb05139f4
"
"&%%(and (diary-block 2 6 2005 2 6 2005)) Waitangi Day
Desc: abcdef
Status: CONFIRMED
Class: PRIVATE
+ UID: b60d398e-1dd1-11b2-a159-cf8cb05139f4
")
;; 2005-03-01 lt
DTSTAMP:20050118T210335Z
DURATION:P7D"
nil
- "&%%(and (diary-block 17 2 2005 23 2 2005)) Hhhhhh Aaaaa ii Aaaaaaaa\n"
- "&%%(and (diary-block 2 17 2005 2 23 2005)) Hhhhhh Aaaaa ii Aaaaaaaa\n")
+ "&%%(and (diary-block 17 2 2005 23 2 2005)) Hhhhhh Aaaaa ii Aaaaaaaa
+ UID: 6AFA7558-6994-11D9-8A3A-000A95A0E830-RID\n"
+ "&%%(and (diary-block 2 17 2005 2 23 2005)) Hhhhhh Aaaaa ii Aaaaaaaa
+ UID: 6AFA7558-6994-11D9-8A3A-000A95A0E830-RID\n")
;; 2005-03-23 lt
(icalendar-tests--test-export
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=11;BYMONTHDAY=1
SUMMARY:NNN Wwwwwwww Wwwww - Aaaaaa Pppppppp rrrrrr ddd oo Nnnnnnnn 30
")
- )
+
+ ;; bug#11473
+ (icalendar-tests--test-import
+ "BEGIN:VCALENDAR
+METHOD:REQUEST
+PRODID:Microsoft Exchange Server 2007
+VERSION:2.0
+BEGIN:VTIMEZONE
+TZID:(UTC+01:00) Amsterdam\, Berlin\, Bern\, Rome\, Stockholm\, Vienna
+BEGIN:STANDARD
+DTSTART:16010101T030000
+TZOFFSETFROM:+0200
+TZOFFSETTO:+0100
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=10
+END:STANDARD
+BEGIN:DAYLIGHT
+DTSTART:16010101T020000
+TZOFFSETFROM:+0100
+TZOFFSETTO:+0200
+RRULE:FREQ=YEARLY;INTERVAL=1;BYDAY=-1SU;BYMONTH=3
+END:DAYLIGHT
+END:VTIMEZONE
+BEGIN:VEVENT
+ORGANIZER;CN=\"A. Luser\":MAILTO:a.luser@foo.com
+ATTENDEE;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP=TRUE;CN=\"Luser, Oth
+ er\":MAILTO:other.luser@foo.com
+DESCRIPTION;LANGUAGE=en-US:\nWhassup?\n\n
+SUMMARY;LANGUAGE=en-US:Query
+DTSTART;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna\"
+ :20120515T150000
+DTEND;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, Vienna\":2
+ 0120515T153000
+UID:040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000
+ 010000000575268034ECDB649A15349B1BF240F15
+RECURRENCE-ID;TZID=\"(UTC+01:00) Amsterdam, Berlin, Bern, Rome, Stockholm, V
+ ienna\":20120515T170000
+CLASS:PUBLIC
+PRIORITY:5
+DTSTAMP:20120514T153645Z
+TRANSP:OPAQUE
+STATUS:CONFIRMED
+SEQUENCE:15
+LOCATION;LANGUAGE=en-US:phone
+X-MICROSOFT-CDO-APPT-SEQUENCE:15
+X-MICROSOFT-CDO-OWNERAPPTID:1907632092
+X-MICROSOFT-CDO-BUSYSTATUS:TENTATIVE
+X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY
+X-MICROSOFT-CDO-ALLDAYEVENT:FALSE
+X-MICROSOFT-CDO-IMPORTANCE:1
+X-MICROSOFT-CDO-INSTTYPE:3
+BEGIN:VALARM
+ACTION:DISPLAY
+DESCRIPTION:REMINDER
+TRIGGER;RELATED=START:-PT15M
+END:VALARM
+END:VEVENT
+END:VCALENDAR"
+ nil
+ "&15/5/2012 15:00-15:30 Query
+ Location: phone
+ Organizer: MAILTO:a.luser@foo.com
+ Status: CONFIRMED
+ Class: PUBLIC
+ UID: 040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000010000000575268034ECDB649A15349B1BF240F15
+" nil)
+)
(provide 'icalendar-tests)
;;; icalendar-tests.el ends here
xex
fx
" "\
-5 matches for \"x\" in buffer: *temp*<2>
+5 matches for \"x\" in buffer: *test-occur*
1:xa
3:cx
4:xd
a
a
" "\
-2 matches for \"a^Ja\" in buffer: *temp*<2>
+2 matches for \"a^Ja\" in buffer: *test-occur*
1:a
:a
3:a
a
b
" "\
-2 matches for \"a^Jb\" in buffer: *temp*<2>
+2 matches for \"a^Jb\" in buffer: *test-occur*
1:a
:b
4:a
a
" "\
-2 matches for \"a^J\" in buffer: *temp*<2>
+2 matches for \"a^J\" in buffer: *test-occur*
1:a
:
4:a
ex
fx
" "\
-2 matches for \"x^J.x^J\" in buffer: *temp*<2>
+2 matches for \"x^J.x^J\" in buffer: *test-occur*
1:ax
:bx
:c
g
hx
" "\
-3 matches for \"x\" in buffer: *temp*<2>
+3 matches for \"x\" in buffer: *test-occur*
1:ax
:b
-------
ex
f
" "\
-2 matches for \"x\" in buffer: *temp*<2>
+2 matches for \"x\" in buffer: *test-occur*
:a
2:bx
:c
j
kx
" "\
-5 matches for \"x\" in buffer: *temp*<2>
+5 matches for \"x\" in buffer: *test-occur*
1:ax
2:bx
:c
h
i
" "\
-2 matches for \"x\" in buffer: *temp*<2>
+2 matches for \"x\" in buffer: *test-occur*
:a
:b
3:cx
h
" "\
-2 matches for \"x\" in buffer: *temp*<2>
+2 matches for \"x\" in buffer: *test-occur*
:
:b
3:cx
jx
kx
" "\
-3 matches for \"x^J.x\" in buffer: *temp*<2>
+3 matches for \"x^J.x\" in buffer: *test-occur*
1:ax
:bx
:c
gx
hx
" "\
-2 matches for \"x^J.x\" in buffer: *temp*<2>
+2 matches for \"x^J.x\" in buffer: *test-occur*
1:ax
:bx
:c
h
ix
" "\
-3 matches for \"x\" in buffer: *temp*<2>
+3 matches for \"x\" in buffer: *test-occur*
:a
2:bx
-------
gx
h
" "\
-3 matches for \"x\" in buffer: *temp*<2>
+3 matches for \"x\" in buffer: *test-occur*
:a
2:bx
:c
(let ((regexp (nth 0 test))
(nlines (nth 1 test))
(input-buffer-string (nth 2 test))
- (output-buffer-string (nth 3 test)))
- (save-window-excursion
- (with-temp-buffer
- (insert input-buffer-string)
- (occur regexp nlines)
- (equal output-buffer-string
- (with-current-buffer "*Occur*"
- (buffer-string)))))))
+ (output-buffer-string (nth 3 test))
+ (temp-buffer (get-buffer-create " *test-occur*")))
+ (unwind-protect
+ (save-window-excursion
+ (with-current-buffer temp-buffer
+ (erase-buffer)
+ (insert input-buffer-string)
+ (occur regexp nlines)
+ (equal output-buffer-string
+ (with-current-buffer "*Occur*"
+ (buffer-string)))))
+ (and (buffer-name temp-buffer)
+ (kill-buffer temp-buffer)))))
(ert-deftest occur-tests ()
"Test the functionality of `occur'.
--- /dev/null
+;;; ruby-mode-tests.el --- Test suite for ruby-mode
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ruby-mode)
+
+(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-string))))))
+
+(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)))))
+
+(defun ruby-assert-face (content pos face)
+ (with-temp-buffer
+ (insert content)
+ (ruby-mode)
+ (font-lock-fontify-buffer)
+ (should (eq face (get-text-property pos 'face)))))
+
+(ert-deftest ruby-indent-after-symbol-made-from-string-interpolation ()
+ "It can indent the line after symbol made using string interpolation."
+ (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 <<asd\n" 3 ?\n)
+ (ruby-assert-state "class <<asd\n" 3 nil))
+
+(ert-deftest ruby-deep-indent ()
+ (let ((ruby-deep-arglist nil)
+ (ruby-deep-indent-paren '(?\( ?\{ ?\[ ?\] t)))
+ (ruby-should-indent "foo = [1,\n2" 7)
+ (ruby-should-indent "foo = {a: b,\nc: d" 7)
+ (ruby-should-indent "foo(a,\nb" 4)))
+
+(ert-deftest ruby-deep-indent-disabled ()
+ (let ((ruby-deep-arglist nil)
+ (ruby-deep-indent-paren nil))
+ (ruby-should-indent "foo = [\n1" ruby-indent-level)
+ (ruby-should-indent "foo = {\na: b" ruby-indent-level)
+ (ruby-should-indent "foo(\na" ruby-indent-level)))
+
+(ert-deftest ruby-indent-after-keyword-in-a-string ()
+ (ruby-should-indent "a = \"abc\nif\"\n " 0)
+ (ruby-should-indent "a = %w[abc\n def]\n " 0)
+ (ruby-should-indent "a = \"abc\n def\"\n " 0))
+
+(ert-deftest ruby-indent-simple ()
+ (ruby-should-indent-buffer
+ "if foo
+ | bar
+ |end
+ |zot
+ |"
+ "if foo
+ |bar
+ | end
+ | zot
+ |"))
+
+(ert-deftest ruby-indent-keyword-label ()
+ (ruby-should-indent-buffer
+ "bar(class: XXX) do
+ | foo
+ |end
+ |bar
+ |"
+ "bar(class: XXX) do
+ | foo
+ | end
+ | bar
+ |"))
+
+(ert-deftest ruby-indent-method-with-question-mark ()
+ (ruby-should-indent-buffer
+ "if x.is_a?(XXX)
+ | foo
+ |end
+ |"
+ "if x.is_a?(XXX)
+ | foo
+ | end
+ |"))
+
+(ert-deftest ruby-indent-expr-in-regexp ()
+ (ruby-should-indent-buffer
+ "if /#{foo}/ =~ s
+ | x = 1
+ |end
+ |"
+ "if /#{foo}/ =~ s
+ | x = 1
+ | end
+ |"))
+
+(ert-deftest ruby-indent-singleton-class ()
+ :expected-result :failed ; Doesn't work yet, when no space before "<<".
+ (ruby-should-indent-buffer
+ "class<<bar
+ | foo
+ |end
+ |"
+ "class<<bar
+ |foo
+ | end
+ |"))
+
+(ert-deftest ruby-indent-array-literal ()
+ (let ((ruby-deep-indent-paren nil))
+ (ruby-should-indent-buffer
+ "foo = [
+ | bar
+ |]
+ |"
+ "foo = [
+ | bar
+ | ]
+ |"))
+ (ruby-should-indent-buffer
+ "foo do
+ | [bar]
+ |end
+ |"
+ "foo do
+ |[bar]
+ | end
+ |"))
+
+(ert-deftest ruby-indent-begin-end ()
+ (ruby-should-indent-buffer
+ "begin
+ | a[b]
+ |end
+ |"
+ "begin
+ | a[b]
+ | end
+ |"))
+
+(ert-deftest ruby-indent-array-after-paren-and-space ()
+ (ruby-should-indent-buffer
+ "class A
+ | def foo
+ | foo( [])
+ | end
+ |end
+ |"
+ "class A
+ | def foo
+ |foo( [])
+ |end
+ | end
+ |"))
+
+(ert-deftest ruby-move-to-block-stops-at-opening ()
+ (with-temp-buffer
+ (insert "def f\nend")
+ (beginning-of-line)
+ (ruby-mode)
+ (ruby-move-to-block -1)
+ (should (looking-at "f$"))))
+
+(ert-deftest ruby-toggle-block-to-do-end ()
+ (with-temp-buffer
+ (insert "foo {|b|\n}")
+ (ruby-mode)
+ (beginning-of-line)
+ (ruby-toggle-block)
+ (should (string= "foo do |b|\nend" (buffer-string)))))
+
+(ert-deftest ruby-toggle-block-to-brace ()
+ (let ((pairs '((16 . "foo {|b| b + 2 }")
+ (15 . "foo {|b|\n b + 2\n}"))))
+ (dolist (pair pairs)
+ (with-temp-buffer
+ (let ((fill-column (car pair)))
+ (insert "foo do |b|\n b + 2\nend")
+ (ruby-mode)
+ (beginning-of-line)
+ (ruby-toggle-block)
+ (should (string= (cdr pair) (buffer-string))))))))
+
+(ert-deftest ruby-toggle-block-to-multiline ()
+ (with-temp-buffer
+ (insert "foo {|b| b + 1}")
+ (ruby-mode)
+ (beginning-of-line)
+ (ruby-toggle-block)
+ (should (string= "foo do |b|\n b + 1\nend" (buffer-string)))))
+
+(ert-deftest ruby-recognize-symbols-starting-with-at-character ()
+ (ruby-assert-face ":@abc" 3 'font-lock-constant-face))
+
+(ert-deftest ruby-hash-character-not-interpolation ()
+ (ruby-assert-face "\"This is #{interpolation}\"" 15
+ 'font-lock-variable-name-face)
+ (ruby-assert-face "\"This is \\#{no interpolation} despite the #\""
+ 15 'font-lock-string-face)
+ (ruby-assert-face "\n#@comment, not ruby code" 5 'font-lock-comment-face)
+ (ruby-assert-state "\n#@comment, not ruby code" 4 t)
+ (ruby-assert-face "# A comment cannot have #{an interpolation} in it"
+ 30 'font-lock-comment-face)
+ (ruby-assert-face "# #{comment}\n \"#{interpolation}\"" 16
+ 'font-lock-variable-name-face))
+
+(provide 'ruby-mode-tests)
+
+;;; ruby-mode-tests.el ends here
--- /dev/null
+;;; url-util-tests.el --- Test suite for url-util.
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Keywords: data
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'url-util)
+
+(ert-deftest url-util-tests ()
+ (let ((tests
+ '(("key1=val1&key2=val2&key3=val1&key3=val2&key4&key5"
+ ((key1 val1) (key2 "val2") (key3 val1 val2) (key4) (key5 "")))
+ ("key1=val1;key2=val2;key3=val1;key3=val2;key4;key5"
+ ((key1 "val1") (key2 val2) (key3 val1 val2) ("key4") (key5 "")) t)
+ ("key1=val1;key2=val2;key3=val1;key3=val2;key4=;key5="
+ ((key1 val1) (key2 val2) ("key3" val1 val2) (key4) (key5 "")) t t)))
+ test)
+ (while tests
+ (setq test (car tests)
+ tests (cdr tests))
+ (should (equal (apply 'url-build-query-string (cdr test)) (car test)))))
+ (should (equal (url-parse-query-string
+ "key1=val1&key2=val2&key3=val1&key3=val2&key4=&key5")
+ '(("key5" "")
+ ("key4" "")
+ ("key3" "val2" "val1")
+ ("key2" "val2")
+ ("key1" "val1")))))
+
+(provide 'url-util-tests)
+
+;;; url-util-tests.el ends here
;;; vc-bzr.el --- tests for vc/vc-bzr.el
-;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
(should (get-buffer "*vc-log*")))
(delete-directory tempdir t))))
+;; http://lists.gnu.org/archive/html/help-gnu-emacs/2012-04/msg00145.html
+(ert-deftest vc-bzr-test-faulty-bzr-autoloads ()
+ "Test we can generate autoloads in a bzr directory when bzr is faulty."
+ :expected-result (if (executable-find vc-bzr-program) :passed :failed)
+ (should (executable-find vc-bzr-program))
+ (let* ((tempdir (make-temp-file "vc-bzr-test" t))
+ (file (expand-file-name "foo.el" tempdir))
+ (default-directory (file-name-as-directory tempdir))
+ (generated-autoload-file (expand-file-name "loaddefs.el" tempdir)))
+ (unwind-protect
+ (progn
+ (call-process vc-bzr-program nil nil nil "init")
+ (with-temp-buffer
+ (insert ";;;###autoload
+\(defun foo () \"foo\" (interactive) (message \"foo!\"))")
+ (write-region nil nil file nil 'silent))
+ (call-process vc-bzr-program nil nil nil "add")
+ (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
+ ;; Deleting dirstate ensures both that vc-bzr's status heuristic
+ ;; fails, so it has to call the external bzr status, and
+ ;; causes bzr status to fail. This simulates a broken bzr
+ ;; installation.
+ (delete-file ".bzr/checkout/dirstate")
+ (should (progn (update-directory-autoloads default-directory)
+ t)))
+ (delete-directory tempdir t))))
+
;;; vc-bzr.el ends here
--- /dev/null
+;;; xml-parse-tests.el --- Test suite for XML parsing.
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Chong Yidong <cyd@stupidchicken.com>
+;; Keywords: internal
+;; Human-Keywords: internal
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Type M-x test-xml-parse RET to generate the test buffer.
+
+;;; Code:
+
+(require 'xml)
+
+(defvar xml-parse-tests--data
+ `(;; General entity substitution
+ ("<?xml version=\"1.0\"?><!DOCTYPE foo SYSTEM \"bar.dtd\" [<!ENTITY ent \"AbC\">]><foo a=\"b\"><bar>&ent;;</bar></foo>" .
+ ((foo ((a . "b")) (bar nil "AbC;"))))
+ ("<?xml version=\"1.0\"?><foo>&amp;&apos;'<>"</foo>" .
+ ((foo () "&''<>\"")))
+ ;; Parameter entity substitution
+ ("<?xml version=\"1.0\"?><!DOCTYPE foo SYSTEM \"bar.dtd\" [<!ENTITY % pent \"AbC\"><!ENTITY ent \"%pent;\">]><foo a=\"b\"><bar>&ent;;</bar></foo>" .
+ ((foo ((a . "b")) (bar nil "AbC;"))))
+ ;; Tricky parameter entity substitution (like XML spec Appendix D)
+ ("<?xml version='1.0'?><!DOCTYPE foo [ <!ENTITY % xx '%zz;'><!ENTITY % zz '<!ENTITY ent \"b\" >' > %xx; ]><foo>A&ent;C</foo>" .
+ ((foo () "AbC")))
+ ;; Bug#7172
+ ("<?xml version=\"1.0\"?><!DOCTYPE foo [ <!ELEMENT EXAM_PLE EMPTY> ]><foo></foo>" .
+ ((foo ())))
+ ;; Entities referencing entities, in character data
+ ("<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">]><foo>&abc;</foo>" .
+ ((foo () "aBc")))
+ ;; Entities referencing entities, in attribute values
+ ("<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">]><foo a=\"-&abc;-\">1</foo>" .
+ ((foo ((a . "-aBc-")) "1")))
+ ;; Character references must be treated as character data
+ ("<foo>AT&T;</foo>" . ((foo () "AT&T;")))
+ ("<foo>&amp;</foo>" . ((foo () "&")))
+ ("<foo>&amp;</foo>" . ((foo () "&")))
+ ;; Unusual but valid XML names [5]
+ ("<ÀÖØö.3·-‿⁀>abc</ÀÖØö.3·-‿⁀>" . ((,(intern "ÀÖØö.3·-‿⁀") () "abc")))
+ ("<:>abc</:>" . ((,(intern ":") () "abc"))))
+ "Alist of XML strings and their expected parse trees.")
+
+(defvar xml-parse-tests--bad-data
+ '(;; XML bomb in content
+ "<!DOCTYPE foo [<!ENTITY lol \"lol\"><!ENTITY lol1 \"&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;\"><!ENTITY lol2 \"&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;\">]><foo>&lol2;</foo>"
+ ;; XML bomb in attribute value
+ "<!DOCTYPE foo [<!ENTITY lol \"lol\"><!ENTITY lol1 \"&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;&lol;\"><!ENTITY lol2 \"&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;&lol1;\">]><foo a=\"&lol2;\">!</foo>"
+ ;; Non-terminating DTD
+ "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">"
+ "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">asdf"
+ "<!DOCTYPE foo [ <!ENTITY b \"B\"><!ENTITY abc \"a&b;c\">asdf&abc;"
+ ;; Invalid XML names
+ "<0foo>abc</0foo>"
+ "<‿foo>abc</‿foo>"
+ "<f¿>abc</f¿>")
+ "List of XML strings that should signal an error in the parser")
+
+(defvar xml-parse-tests--qnames
+ '( ;; Test data for name expansion
+ ("<?xml version=\"1.0\" encoding=\"UTF-8\"?><D:multistatus xmlns:D=\"DAV:\"><D:response><D:href>/calendar/events/</D:href><D:propstat><D:status>HTTP/1.1 200 OK</D:status></D:propstat></D:response></D:multistatus>"
+ ;; Result with qnames as cons
+ ((("DAV:" . "multistatus")
+ ((("http://www.w3.org/2000/xmlns/" . "D") . "DAV:"))
+ (("DAV:" . "response") nil (("DAV:" . "href") nil "/calendar/events/")
+ (("DAV:" . "propstat") nil (("DAV:" . "status") nil "HTTP/1.1 200 OK")))))
+ ;; Result with qnames as symbols
+ ((DAV:multistatus
+ ((("http://www.w3.org/2000/xmlns/" . "D") . "DAV:"))
+ (DAV:response nil (DAV:href nil "/calendar/events/")
+ (DAV:propstat nil (DAV:status nil "HTTP/1.1 200 OK"))))))
+ ("<?xml version=\"1.0\" encoding=\"UTF-8\"?><F:something>hi there</F:something>"
+ ((("FOOBAR:" . "something") nil "hi there"))
+ ((FOOBAR:something nil "hi there"))))
+ "List of strings which are parsed using namespace expansion.
+Parser is called with and without 'symbol-qnames argument.")
+
+(ert-deftest xml-parse-tests ()
+ "Test XML parsing."
+ (with-temp-buffer
+ (dolist (test xml-parse-tests--data)
+ (erase-buffer)
+ (insert (car test))
+ (should (equal (cdr test) (xml-parse-region))))
+ (let ((xml-entity-expansion-limit 50))
+ (dolist (test xml-parse-tests--bad-data)
+ (erase-buffer)
+ (insert test)
+ (should-error (xml-parse-region))))
+ (let ((testdata (car xml-parse-tests--qnames)))
+ (erase-buffer)
+ (insert (car testdata))
+ (should (equal (nth 1 testdata)
+ (xml-parse-region nil nil nil nil t)))
+ (should (equal (nth 2 testdata)
+ (xml-parse-region nil nil nil nil 'symbol-qnames))))
+ (let ((testdata (nth 1 xml-parse-tests--qnames)))
+ (erase-buffer)
+ (insert (car testdata))
+ ;; Provide additional namespace-URI mapping
+ (should (equal (nth 1 testdata)
+ (xml-parse-region
+ nil nil nil nil
+ (append xml-default-ns
+ '(("F" . "FOOBAR:"))))))
+ (should (equal (nth 2 testdata)
+ (xml-parse-region
+ nil nil nil nil
+ (cons 'symbol-qnames
+ (append xml-default-ns
+ '(("F" . "FOOBAR:"))))))))))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; xml-parse-tests.el ends here.
;;; Code:
(eval-when-compile
- (require 'cl) ; assert
+ (require 'cl-lib)
(require 'eshell)
(require 'esh-util))
(require 'esh-mode)
(eshell-deftest banner banner-displayed
"Startup banner is displayed at point-min"
- (assert eshell-banner-message)
+ (cl-assert eshell-banner-message)
(let ((msg (eval eshell-banner-message)))
- (assert msg)
+ (cl-assert msg)
(goto-char (point-min))
(looking-at msg)))
--- /dev/null
+\documentclass{article} % -*- eval: (bug-reference-mode 1) -*-
+
+\usepackage[utf8]{inputenc}
+
+\begin{document}
+
+To fix this, remove the \url{sn9c102.ko} from where it appears in
+\url{/lib/modules/$(uname -r)}, %bug#11953.
+and install the appropriate \url{gspca-modules} package.
+
+\end{document}
--- /dev/null
+# Percent literals.
+b = %Q{This is a "string"}
+c = %w!foo
+ bar
+ baz!
+d = %(hello (nested) world)
+
+# Don't propertize percent literals inside strings.
+"(%s, %s)" % [123, 456]
+
+# Or inside comments.
+x = # "tot %q/to"; =
+y = 2 / 3
+
+# Regexp after whitelisted method.
+"abc".sub /b/, 'd'
+
+# Don't mis-match "sub" at the end of words.
+a = asub / aslb + bsub / bslb;
+
+# Highlight the regexp after "if".
+x = toto / foo if /do bar/ =~ "dobar"
+
+# Some Cucumber code:
+Given /toto/ do
+ print "hello"
+end
#!/bin/rc
if (foo) {
- echo 1
+ echo 1 \
+ toto \
+ tutu
+ titi
}
if not {
echo 2
for (i in a b c)
echo "$i" # KNOWN INDENT BUG
echo titi
+ if (foo)
+ echo 3 # KNOWN INDENT BUG
+ if not
+ echo 4 # KNOWN INDENT BUG
case *
echo other
#!/bin/sh
+# -*- eval: (bug-reference-mode 1) -*-
setlock -n /tmp/getmail.lock && echo getmail isn\'t running
# adsgsdg
+declare -a VERSION
+for i in $(ls "$PREFIX/sbin") ; do
+ echo -e $N')' $i
+ VERSION[${#VERSION[*]}]=$i #bug#11946.
+ N=$(($N + 1))
+done
+
foo () {
bar () {
case toto
in a) hello # KNOWN INDENT BUG
;; b) hi # KNOWN INDENT BUG
+ ;; c) hi # KNOWN INDENT BUG
esac
case $toto in
sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
esac |
- cat # KNOWN INDENT BUG
+ grep '.' | # KNOWN INDENT BUG
+ sed 1d
case toto in
-exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
(insert "\n\n"))
(defun test-redisplay-3 ()
- (insert "Test 3: Overlay with before/after strings and images:\n\n")
+ (insert "Test 3: Overlay with strings and images:\n\n")
(let ((img-data "#define x_width 8
#define x_height 8
static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff };"))
(overlay-put ov2 'before-string "C")
(overlay-put ov3 'display `(image :data ,img-data :type xbm))))))
+(defun test-redisplay-4 ()
+ (insert "Test 4: Overlay strings and invisibility:\n\n")
+ ;; Before and after strings with non-nil `invisibility'.
+ (insert " Expected: ABC\n")
+ (insert " Result: ")
+ (let ((opoint (point)))
+ (insert "ABC\n")
+ (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
+ (overlay-put ov 'before-string
+ (propertize "XX" 'invisible
+ 'test-redisplay--simple-invis))
+ (overlay-put ov 'after-string
+ (propertize "XX" 'invisible
+ 'test-redisplay--simple-invis))))
+
+ ;; Before and after strings bogus `invisibility' property (value is
+ ;; not listed in `buffer-invisibility-spec').
+ (insert "\n Expected: ABC")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "B\n")
+ (let ((ov (make-overlay opoint (1+ opoint))))
+ (overlay-put ov 'before-string
+ (propertize "A" 'invisible 'bogus-invis-spec))
+ (overlay-put ov 'after-string
+ (propertize "C" 'invisible 'bogus-invis-spec))))
+
+ ;; Before/after string with ellipsis `invisibility' property.
+ (insert "\n Expected: ...B...")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "B\n")
+ (let ((ov (make-overlay opoint (1+ opoint))))
+ (overlay-put ov 'before-string
+ (propertize "A" 'invisible 'test-redisplay--ellipsis-invis))
+ (overlay-put ov 'after-string
+ (propertize "C" 'invisible 'test-redisplay--ellipsis-invis))))
+
+ ;; Before/after string with partial ellipsis `invisibility' property.
+ (insert "\n Expected: A...ABC...C")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "B\n")
+ (let ((ov (make-overlay opoint (1+ opoint)))
+ (a "AAA")
+ (c "CCC"))
+ (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis a)
+ (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis c)
+ (overlay-put ov 'before-string a)
+ (overlay-put ov 'after-string c)))
+
+ ;; Display string with `invisibility' property.
+ (insert "\n Expected: ABC")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "AYBC\n")
+ (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
+ (overlay-put ov 'display
+ (propertize "XX" 'invisible
+ 'test-redisplay--simple-invis))))
+ ;; Display string with bogus `invisibility' property.
+ (insert "\n Expected: ABC")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "AXC\n")
+ (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
+ (overlay-put ov 'display
+ (propertize "B" 'invisible 'bogus-invis-spec))))
+ ;; Display string with ellipsis `invisibility' property.
+ (insert "\n Expected: A...C")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "AXC\n")
+ (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
+ (overlay-put ov 'display
+ (propertize "B" 'invisible
+ 'test-redisplay--ellipsis-invis))))
+ ;; Display string with partial `invisibility' property.
+ (insert "\n Expected: A...C")
+ (insert "\n Result: ")
+ (let ((opoint (point)))
+ (insert "X\n")
+ (let ((ov (make-overlay opoint (1+ opoint)))
+ (str "ABC"))
+ (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis str)
+ (overlay-put ov 'display str)))
+
+ (insert "\n"))
+
(defun test-redisplay ()
(interactive)
(let ((buf (get-buffer "*Redisplay Test*")))
(if buf
(kill-buffer buf))
- (pop-to-buffer (get-buffer-create "*Redisplay Test*"))
+ (switch-to-buffer (get-buffer-create "*Redisplay Test*"))
(erase-buffer)
+ (setq buffer-invisibility-spec
+ '(test-redisplay--simple-invis
+ (test-redisplay--ellipsis-invis . t)))
(test-redisplay-1)
(test-redisplay-2)
(test-redisplay-3)
+ (test-redisplay-4)
(goto-char (point-min))))
+++ /dev/null
-/^VPATH *=/c\
-# This works only in GNU make. Using the patterns avoids\
-# object files being found by VPATH, and thus permits building\
-# when $srcdir is configured itself.\
-vpath %.c $(srcdir)\
-vpath %.h $(srcdir)\
-\
-
